diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +version 0.6.0.0: + +* switch to mpdecimal for the underlying C library. This allows +higher limits on exponents and precision. All arithmetic is now +(practically speaking) arbitrary precision. This also allows more +operations, such as logarithms and all exponents. As a possible +disadvantage, this might be slower than decNumber (but I have not +benchmarked this.) + version 0.4.0.4: * test with GHC 7.8.2 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,31 +2,27 @@ deka provides correctly rounded decimal arithmetic for Haskell. -The core of deka is a binding to the C library decNumber. As the -author of deka, I have no association with the author of decNumber, -and any errors in this library are mine and should be reported to -omari@smileystation.com or to the Github tracker at +The core of deka is a binding to the C library mpdecimal. You need +to install mpdecimal; otherwise, your executables will not link. +mpdecimal is available here: -http://www.github.com/massysett/deka +http://www.bytereef.org/mpdecimal/index.html -deka uses the decQuad functions in decNumber. This means that deka -is limited to 34 digits of precision. Because 1 quadrillion (that -is, one thousand trillion) has only 16 digits of precision, I figure -that 34 should be sufficient for many uses. Also, you are limited -to exponents no smaller than -6176 and no greater than 6111. deka -will notify you if you perform calculations that must be rounded in -order to fit within the 34 digits of precision or within the size -limits for the exponent. +mpdecimal has also been packaged for some Linux distributions, such +as Debian (libmpdec-dev) and Arch (mpdecimal). deka has been tested +with mpdecimal version 2.4.0. -You will want to understand decNumber and the General Decimal -Arithmetic Specification in order to fully understand deka. The -specification is at +As the author of deka, I have no association with the author of +mpdecimal, and any errors in this library are mine and should be +reported to omari@smileystation.com or to the Github tracker at -http://speleotrove.com/decimal/decarith.html +http://www.github.com/massysett/deka -and decNumber is at +You will want to understand the General Decimal Arithmetic +Specification in order to fully understand deka. The specification +is at -http://speleotrove.com/decimal/decnumber.html +http://speleotrove.com/decimal/decarith.html and more about decimal arithmetic generally at @@ -34,13 +30,22 @@ ## Dependencies -The main deka library depends only on `base` and `bytestring`, so it -shouldn't be difficult to build. The -tests use [tasty](http://documentup.com/feuerbach/tasty) and -[QuickCheck](http://hackage.haskell.org/package/QuickCheck). The -decNumber C library is bundled in; GHC will build it and link it for -you when you install deka. +The main deka library depends only on `base`, `bytestring`, and +`parsec`, so it shouldn't be difficult to build. The tests use +[tasty](http://documentup.com/feuerbach/tasty) and +[QuickCheck](http://hackage.haskell.org/package/QuickCheck). +## Test status + +deka is tested using the tests available on the General Decimal +Arithmetic website: + +http://speleotrove.com/decimal/dectest.html + +Some of these tests currently fail. The failures are in edge cases +that should not affect most usage. Diagnosing these failures is on +the TODO list. + ## More documentation Much more documentation is available in the Haddock comments in the @@ -55,8 +60,4 @@ ## License deka is licensed under the BSD license, see the LICENSE file. - -## Build status - -[![Build Status](https://travis-ci.org/massysett/deka.png?branch=master)](https://travis-ci.org/massysett/deka) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ import Distribution.Simple -main = defaultMainWithHooks autoconfUserHooks +main = defaultMain diff --git a/configure b/configure deleted file mode 100644 --- a/configure +++ /dev/null @@ -1,4449 +0,0 @@ -#! /bin/sh -# Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for libdecnumber 368-4. -# -# Report bugs to . -# -# -# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. -# -# -# This configure script is free software; the Free Software Foundation -# gives unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -# Use a proper internal environment variable to ensure we don't fall - # into an infinite loop, continuously re-executing ourselves. - if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then - _as_can_reexec=no; export _as_can_reexec; - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -as_fn_exit 255 - fi - # We don't want this to propagate to other subprocesses. - { _as_can_reexec=; unset _as_can_reexec;} -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : - -else - exitcode=1; echo positional parameters were not saved. -fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1" - if (eval "$as_required") 2>/dev/null; then : - as_have_required=yes -else - as_have_required=no -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : - -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir/$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : - CONFIG_SHELL=$as_shell as_have_required=yes - if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : - break 2 -fi -fi - done;; - esac - as_found=false -done -$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi; } -IFS=$as_save_IFS - - - if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 -fi - - if test x$as_have_required = xno; then : - $as_echo "$0: This script requires a shell more modern than all" - $as_echo "$0: the shells that I found on your system." - if test x${ZSH_VERSION+set} = xset ; then - $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" - $as_echo "$0: be upgraded to zsh 4.3.4 or later." - else - $as_echo "$0: Please tell bug-autoconf@gnu.org and -$0: omari@smileystation.com about your system, including -$0: any error possibly output before this message. Then -$0: install a modern shell, or manually run the script -$0: under such a shell if you do have one." - fi - exit 1 -fi -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - - - as_lineno_1=$LINENO as_lineno_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | - sed ' - s/[$]LINENO.*/&-/ - t lineno - b - :lineno - N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ - t loop - s/-\n.*// - ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensitive to this). - . "./$as_me.lineno" - # Exit status is that of the last command. - exit -} - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -pR' - fi -else - as_ln_s='cp -pR' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -as_test_x='test -x' -as_executable_p=as_fn_executable_p - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - -test -n "$DJDIR" || exec 7<&0 &1 - -# Name of the host. -# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, -# so uname gets run too. -ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` - -# -# Initializations. -# -ac_default_prefix=/usr/local -ac_clean_files= -ac_config_libobj_dir=. -LIBOBJS= -cross_compiling=no -subdirs= -MFLAGS= -MAKEFLAGS= - -# Identity of this package. -PACKAGE_NAME='libdecnumber' -PACKAGE_TARNAME='libdecnumber' -PACKAGE_VERSION='368-4' -PACKAGE_STRING='libdecnumber 368-4' -PACKAGE_BUGREPORT='omari@smileystation.com' -PACKAGE_URL='' - -# Factoring default headers for most tests. -ac_includes_default="\ -#include -#ifdef HAVE_SYS_TYPES_H -# include -#endif -#ifdef HAVE_SYS_STAT_H -# include -#endif -#ifdef STDC_HEADERS -# include -# include -#else -# ifdef HAVE_STDLIB_H -# include -# endif -#endif -#ifdef HAVE_STRING_H -# if !defined STDC_HEADERS && defined HAVE_MEMORY_H -# include -# endif -# include -#endif -#ifdef HAVE_STRINGS_H -# include -#endif -#ifdef HAVE_INTTYPES_H -# include -#endif -#ifdef HAVE_STDINT_H -# include -#endif -#ifdef HAVE_UNISTD_H -# include -#endif" - -ac_subst_vars='LTLIBOBJS -LIBOBJS -LITEND -EGREP -GREP -CPP -OBJEXT -EXEEXT -ac_ct_CC -CPPFLAGS -LDFLAGS -CFLAGS -CC -target_alias -host_alias -build_alias -LIBS -ECHO_T -ECHO_N -ECHO_C -DEFS -mandir -localedir -libdir -psdir -pdfdir -dvidir -htmldir -infodir -docdir -oldincludedir -includedir -localstatedir -sharedstatedir -sysconfdir -datadir -datarootdir -libexecdir -sbindir -bindir -program_transform_name -prefix -exec_prefix -PACKAGE_URL -PACKAGE_BUGREPORT -PACKAGE_STRING -PACKAGE_VERSION -PACKAGE_TARNAME -PACKAGE_NAME -PATH_SEPARATOR -SHELL' -ac_subst_files='' -ac_user_opts=' -enable_option_checking -' - ac_precious_vars='build_alias -host_alias -target_alias -CC -CFLAGS -LDFLAGS -LIBS -CPPFLAGS -CPP' - - -# Initialize some variables set by options. -ac_init_help= -ac_init_version=false -ac_unrecognized_opts= -ac_unrecognized_sep= -# The variables have the same names as the options, with -# dashes changed to underlines. -cache_file=/dev/null -exec_prefix=NONE -no_create= -no_recursion= -prefix=NONE -program_prefix=NONE -program_suffix=NONE -program_transform_name=s,x,x, -silent= -site= -srcdir= -verbose= -x_includes=NONE -x_libraries=NONE - -# Installation directory options. -# These are left unexpanded so users can "make install exec_prefix=/foo" -# and all the variables that are supposed to be based on exec_prefix -# by default will actually change. -# Use braces instead of parens because sh, perl, etc. also accept them. -# (The list follows the same order as the GNU Coding Standards.) -bindir='${exec_prefix}/bin' -sbindir='${exec_prefix}/sbin' -libexecdir='${exec_prefix}/libexec' -datarootdir='${prefix}/share' -datadir='${datarootdir}' -sysconfdir='${prefix}/etc' -sharedstatedir='${prefix}/com' -localstatedir='${prefix}/var' -includedir='${prefix}/include' -oldincludedir='/usr/include' -docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' -infodir='${datarootdir}/info' -htmldir='${docdir}' -dvidir='${docdir}' -pdfdir='${docdir}' -psdir='${docdir}' -libdir='${exec_prefix}/lib' -localedir='${datarootdir}/locale' -mandir='${datarootdir}/man' - -ac_prev= -ac_dashdash= -for ac_option -do - # If the previous option needs an argument, assign it. - if test -n "$ac_prev"; then - eval $ac_prev=\$ac_option - ac_prev= - continue - fi - - case $ac_option in - *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *=) ac_optarg= ;; - *) ac_optarg=yes ;; - esac - - # Accept the important Cygnus configure options, so we can diagnose typos. - - case $ac_dashdash$ac_option in - --) - ac_dashdash=yes ;; - - -bindir | --bindir | --bindi | --bind | --bin | --bi) - ac_prev=bindir ;; - -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir=$ac_optarg ;; - - -build | --build | --buil | --bui | --bu) - ac_prev=build_alias ;; - -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build_alias=$ac_optarg ;; - - -cache-file | --cache-file | --cache-fil | --cache-fi \ - | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) - ac_prev=cache_file ;; - -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ - | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file=$ac_optarg ;; - - --config-cache | -C) - cache_file=config.cache ;; - - -datadir | --datadir | --datadi | --datad) - ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=*) - datadir=$ac_optarg ;; - - -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ - | --dataroo | --dataro | --datar) - ac_prev=datarootdir ;; - -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ - | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) - datarootdir=$ac_optarg ;; - - -disable-* | --disable-*) - ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=no ;; - - -docdir | --docdir | --docdi | --doc | --do) - ac_prev=docdir ;; - -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) - docdir=$ac_optarg ;; - - -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) - ac_prev=dvidir ;; - -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) - dvidir=$ac_optarg ;; - - -enable-* | --enable-*) - ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=\$ac_optarg ;; - - -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ - | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ - | --exec | --exe | --ex) - ac_prev=exec_prefix ;; - -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ - | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ - | --exec=* | --exe=* | --ex=*) - exec_prefix=$ac_optarg ;; - - -gas | --gas | --ga | --g) - # Obsolete; use --with-gas. - with_gas=yes ;; - - -help | --help | --hel | --he | -h) - ac_init_help=long ;; - -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) - ac_init_help=recursive ;; - -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) - ac_init_help=short ;; - - -host | --host | --hos | --ho) - ac_prev=host_alias ;; - -host=* | --host=* | --hos=* | --ho=*) - host_alias=$ac_optarg ;; - - -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) - ac_prev=htmldir ;; - -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ - | --ht=*) - htmldir=$ac_optarg ;; - - -includedir | --includedir | --includedi | --included | --include \ - | --includ | --inclu | --incl | --inc) - ac_prev=includedir ;; - -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ - | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir=$ac_optarg ;; - - -infodir | --infodir | --infodi | --infod | --info | --inf) - ac_prev=infodir ;; - -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir=$ac_optarg ;; - - -libdir | --libdir | --libdi | --libd) - ac_prev=libdir ;; - -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir=$ac_optarg ;; - - -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ - | --libexe | --libex | --libe) - ac_prev=libexecdir ;; - -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ - | --libexe=* | --libex=* | --libe=*) - libexecdir=$ac_optarg ;; - - -localedir | --localedir | --localedi | --localed | --locale) - ac_prev=localedir ;; - -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) - localedir=$ac_optarg ;; - - -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst | --locals) - ac_prev=localstatedir ;; - -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) - localstatedir=$ac_optarg ;; - - -mandir | --mandir | --mandi | --mand | --man | --ma | --m) - ac_prev=mandir ;; - -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir=$ac_optarg ;; - - -nfp | --nfp | --nf) - # Obsolete; use --without-fp. - with_fp=no ;; - - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c | -n) - no_create=yes ;; - - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) - no_recursion=yes ;; - - -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ - | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ - | --oldin | --oldi | --old | --ol | --o) - ac_prev=oldincludedir ;; - -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ - | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ - | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir=$ac_optarg ;; - - -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) - ac_prev=prefix ;; - -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix=$ac_optarg ;; - - -program-prefix | --program-prefix | --program-prefi | --program-pref \ - | --program-pre | --program-pr | --program-p) - ac_prev=program_prefix ;; - -program-prefix=* | --program-prefix=* | --program-prefi=* \ - | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix=$ac_optarg ;; - - -program-suffix | --program-suffix | --program-suffi | --program-suff \ - | --program-suf | --program-su | --program-s) - ac_prev=program_suffix ;; - -program-suffix=* | --program-suffix=* | --program-suffi=* \ - | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix=$ac_optarg ;; - - -program-transform-name | --program-transform-name \ - | --program-transform-nam | --program-transform-na \ - | --program-transform-n | --program-transform- \ - | --program-transform | --program-transfor \ - | --program-transfo | --program-transf \ - | --program-trans | --program-tran \ - | --progr-tra | --program-tr | --program-t) - ac_prev=program_transform_name ;; - -program-transform-name=* | --program-transform-name=* \ - | --program-transform-nam=* | --program-transform-na=* \ - | --program-transform-n=* | --program-transform-=* \ - | --program-transform=* | --program-transfor=* \ - | --program-transfo=* | --program-transf=* \ - | --program-trans=* | --program-tran=* \ - | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name=$ac_optarg ;; - - -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) - ac_prev=pdfdir ;; - -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) - pdfdir=$ac_optarg ;; - - -psdir | --psdir | --psdi | --psd | --ps) - ac_prev=psdir ;; - -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) - psdir=$ac_optarg ;; - - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - silent=yes ;; - - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) - ac_prev=sbindir ;; - -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ - | --sbi=* | --sb=*) - sbindir=$ac_optarg ;; - - -sharedstatedir | --sharedstatedir | --sharedstatedi \ - | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ - | --sharedst | --shareds | --shared | --share | --shar \ - | --sha | --sh) - ac_prev=sharedstatedir ;; - -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ - | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ - | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ - | --sha=* | --sh=*) - sharedstatedir=$ac_optarg ;; - - -site | --site | --sit) - ac_prev=site ;; - -site=* | --site=* | --sit=*) - site=$ac_optarg ;; - - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) - ac_prev=srcdir ;; - -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir=$ac_optarg ;; - - -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ - | --syscon | --sysco | --sysc | --sys | --sy) - ac_prev=sysconfdir ;; - -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ - | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir=$ac_optarg ;; - - -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target_alias ;; - -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target_alias=$ac_optarg ;; - - -v | -verbose | --verbose | --verbos | --verbo | --verb) - verbose=yes ;; - - -version | --version | --versio | --versi | --vers | -V) - ac_init_version=: ;; - - -with-* | --with-*) - ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=\$ac_optarg ;; - - -without-* | --without-*) - ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=no ;; - - --x) - # Obsolete; use --with-x. - with_x=yes ;; - - -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ - | --x-incl | --x-inc | --x-in | --x-i) - ac_prev=x_includes ;; - -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ - | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes=$ac_optarg ;; - - -x-libraries | --x-libraries | --x-librarie | --x-librari \ - | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) - ac_prev=x_libraries ;; - -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ - | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries=$ac_optarg ;; - - -*) as_fn_error $? "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information" - ;; - - *=*) - ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` - # Reject names that are not valid shell variable names. - case $ac_envvar in #( - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; - esac - eval $ac_envvar=\$ac_optarg - export $ac_envvar ;; - - *) - # FIXME: should be removed in autoconf 3.0. - $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 - expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" - ;; - - esac -done - -if test -n "$ac_prev"; then - ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error $? "missing argument to $ac_option" -fi - -if test -n "$ac_unrecognized_opts"; then - case $enable_option_checking in - no) ;; - fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; - *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; - esac -fi - -# Check all directory arguments for consistency. -for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ - datadir sysconfdir sharedstatedir localstatedir includedir \ - oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir -do - eval ac_val=\$$ac_var - # Remove trailing slashes. - case $ac_val in - */ ) - ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` - eval $ac_var=\$ac_val;; - esac - # Be sure to have absolute directory names. - case $ac_val in - [\\/$]* | ?:[\\/]* ) continue;; - NONE | '' ) case $ac_var in *prefix ) continue;; esac;; - esac - as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" -done - -# There might be people who depend on the old broken behavior: `$host' -# used to hold the argument of --host etc. -# FIXME: To remove some day. -build=$build_alias -host=$host_alias -target=$target_alias - -# FIXME: To remove some day. -if test "x$host_alias" != x; then - if test "x$build_alias" = x; then - cross_compiling=maybe - elif test "x$build_alias" != "x$host_alias"; then - cross_compiling=yes - fi -fi - -ac_tool_prefix= -test -n "$host_alias" && ac_tool_prefix=$host_alias- - -test "$silent" = yes && exec 6>/dev/null - - -ac_pwd=`pwd` && test -n "$ac_pwd" && -ac_ls_di=`ls -di .` && -ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error $? "working directory cannot be determined" -test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error $? "pwd does not report name of working directory" - - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - ac_srcdir_defaulted=yes - # Try the directory containing this script, then the parent directory. - ac_confdir=`$as_dirname -- "$as_myself" || -$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_myself" : 'X\(//\)[^/]' \| \ - X"$as_myself" : 'X\(//\)$' \| \ - X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_myself" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - srcdir=$ac_confdir - if test ! -r "$srcdir/$ac_unique_file"; then - srcdir=.. - fi -else - ac_srcdir_defaulted=no -fi -if test ! -r "$srcdir/$ac_unique_file"; then - test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" -fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" -ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" - pwd)` -# When building in place, set srcdir=. -if test "$ac_abs_confdir" = "$ac_pwd"; then - srcdir=. -fi -# Remove unnecessary trailing slashes from srcdir. -# Double slashes in file names in object file debugging info -# mess up M-x gdb in Emacs. -case $srcdir in -*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; -esac -for ac_var in $ac_precious_vars; do - eval ac_env_${ac_var}_set=\${${ac_var}+set} - eval ac_env_${ac_var}_value=\$${ac_var} - eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} - eval ac_cv_env_${ac_var}_value=\$${ac_var} -done - -# -# Report the --help message. -# -if test "$ac_init_help" = "long"; then - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat <<_ACEOF -\`configure' configures libdecnumber 368-4 to adapt to many kinds of systems. - -Usage: $0 [OPTION]... [VAR=VALUE]... - -To assign environment variables (e.g., CC, CFLAGS...), specify them as -VAR=VALUE. See below for descriptions of some of the useful variables. - -Defaults for the options are specified in brackets. - -Configuration: - -h, --help display this help and exit - --help=short display options specific to this package - --help=recursive display the short help of all the included packages - -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking ...' messages - --cache-file=FILE cache test results in FILE [disabled] - -C, --config-cache alias for \`--cache-file=config.cache' - -n, --no-create do not create output files - --srcdir=DIR find the sources in DIR [configure dir or \`..'] - -Installation directories: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] - -By default, \`make install' will install all the files in -\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify -an installation prefix other than \`$ac_default_prefix' using \`--prefix', -for instance \`--prefix=\$HOME'. - -For better control, use the options below. - -Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] - --datadir=DIR read-only architecture-independent data [DATAROOTDIR] - --infodir=DIR info documentation [DATAROOTDIR/info] - --localedir=DIR locale-dependent data [DATAROOTDIR/locale] - --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/libdecnumber] - --htmldir=DIR html documentation [DOCDIR] - --dvidir=DIR dvi documentation [DOCDIR] - --pdfdir=DIR pdf documentation [DOCDIR] - --psdir=DIR ps documentation [DOCDIR] -_ACEOF - - cat <<\_ACEOF -_ACEOF -fi - -if test -n "$ac_init_help"; then - case $ac_init_help in - short | recursive ) echo "Configuration of libdecnumber 368-4:";; - esac - cat <<\_ACEOF - -Some influential environment variables: - CC C compiler command - CFLAGS C compiler flags - LDFLAGS linker flags, e.g. -L if you have libraries in a - nonstandard directory - LIBS libraries to pass to the linker, e.g. -l - CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if - you have headers in a nonstandard directory - CPP C preprocessor - -Use these variables to override the choices made by `configure' or to help -it to find libraries and programs with nonstandard names/locations. - -Report bugs to . -_ACEOF -ac_status=$? -fi - -if test "$ac_init_help" = "recursive"; then - # If there are subdirs, report their specific --help. - for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d "$ac_dir" || - { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || - continue - ac_builddir=. - -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix - -case $srcdir in - .) # We are building in place. - ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; -esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - cd "$ac_dir" || { ac_status=$?; continue; } - # Check for guested configure. - if test -f "$ac_srcdir/configure.gnu"; then - echo && - $SHELL "$ac_srcdir/configure.gnu" --help=recursive - elif test -f "$ac_srcdir/configure"; then - echo && - $SHELL "$ac_srcdir/configure" --help=recursive - else - $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi || ac_status=$? - cd "$ac_pwd" || { ac_status=$?; break; } - done -fi - -test -n "$ac_init_help" && exit $ac_status -if $ac_init_version; then - cat <<\_ACEOF -libdecnumber configure 368-4 -generated by GNU Autoconf 2.69 - -Copyright (C) 2012 Free Software Foundation, Inc. -This configure script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it. -_ACEOF - exit -fi - -## ------------------------ ## -## Autoconf initialization. ## -## ------------------------ ## - -# ac_fn_c_try_compile LINENO -# -------------------------- -# Try to compile conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext - if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest.$ac_objext; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_compile - -# ac_fn_c_try_run LINENO -# ---------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes -# that executables *can* be run. -ac_fn_c_try_run () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then : - ac_retval=0 -else - $as_echo "$as_me: program exited with status $ac_status" >&5 - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=$ac_status -fi - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_run - -# ac_fn_c_try_cpp LINENO -# ---------------------- -# Try to preprocess conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_cpp () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_cpp conftest.$ac_ext" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } > conftest.i && { - test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || - test ! -s conftest.err - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_cpp - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_compile -cat >config.log <<_ACEOF -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by libdecnumber $as_me 368-4, which was -generated by GNU Autoconf 2.69. Invocation command line was - - $ $0 $@ - -_ACEOF -exec 5>>config.log -{ -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## - -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` - -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - -_ASUNAME - -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - $as_echo "PATH: $as_dir" - done -IFS=$as_save_IFS - -} >&5 - -cat >&5 <<_ACEOF - - -## ----------- ## -## Core tests. ## -## ----------- ## - -_ACEOF - - -# Keep a trace of the command line. -# Strip out --no-create and --no-recursion so they do not pile up. -# Strip out --silent because we don't want to record it for future runs. -# Also quote any args containing shell meta-characters. -# Make two passes to allow for proper duplicate-argument suppression. -ac_configure_args= -ac_configure_args0= -ac_configure_args1= -ac_must_keep_next=false -for ac_pass in 1 2 -do - for ac_arg - do - case $ac_arg in - -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - continue ;; - *\'*) - ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - case $ac_pass in - 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; - 2) - as_fn_append ac_configure_args1 " '$ac_arg'" - if test $ac_must_keep_next = true; then - ac_must_keep_next=false # Got value, back to normal. - else - case $ac_arg in - *=* | --config-cache | -C | -disable-* | --disable-* \ - | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ - | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ - | -with-* | --with-* | -without-* | --without-* | --x) - case "$ac_configure_args0 " in - "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; - esac - ;; - -* ) ac_must_keep_next=true ;; - esac - fi - as_fn_append ac_configure_args " '$ac_arg'" - ;; - esac - done -done -{ ac_configure_args0=; unset ac_configure_args0;} -{ ac_configure_args1=; unset ac_configure_args1;} - -# When interrupted or exit'd, cleanup temporary files, and complete -# config.log. We remove comments because anyway the quotes in there -# would cause problems or look ugly. -# WARNING: Use '\'' to represent an apostrophe within the trap. -# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. -trap 'exit_status=$? - # Save into config.log some information that might help in debugging. - { - echo - - $as_echo "## ---------------- ## -## Cache variables. ## -## ---------------- ##" - echo - # The following way of writing the cache mishandles newlines in values, -( - for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - (set) 2>&1 | - case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - sed -n \ - "s/'\''/'\''\\\\'\'''\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" - ;; #( - *) - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" - ;; - esac | - sort -) - echo - - $as_echo "## ----------------- ## -## Output variables. ## -## ----------------- ##" - echo - for ac_var in $ac_subst_vars - do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" - done | sort - echo - - if test -n "$ac_subst_files"; then - $as_echo "## ------------------- ## -## File substitutions. ## -## ------------------- ##" - echo - for ac_var in $ac_subst_files - do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" - done | sort - echo - fi - - if test -s confdefs.h; then - $as_echo "## ----------- ## -## confdefs.h. ## -## ----------- ##" - echo - cat confdefs.h - echo - fi - test "$ac_signal" != 0 && - $as_echo "$as_me: caught signal $ac_signal" - $as_echo "$as_me: exit $exit_status" - } >&5 - rm -f core *.core core.conftest.* && - rm -f -r conftest* confdefs* conf$$* $ac_clean_files && - exit $exit_status -' 0 -for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal -done -ac_signal=0 - -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -f -r conftest* confdefs.h - -$as_echo "/* confdefs.h */" > confdefs.h - -# Predefined preprocessor variables. - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_NAME "$PACKAGE_NAME" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_TARNAME "$PACKAGE_TARNAME" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_VERSION "$PACKAGE_VERSION" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_STRING "$PACKAGE_STRING" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_URL "$PACKAGE_URL" -_ACEOF - - -# Let the site file select an alternate cache file if it wants to. -# Prefer an explicitly selected file to automatically selected ones. -ac_site_file1=NONE -ac_site_file2=NONE -if test -n "$CONFIG_SITE"; then - # We do not want a PATH search for config.site. - case $CONFIG_SITE in #(( - -*) ac_site_file1=./$CONFIG_SITE;; - */*) ac_site_file1=$CONFIG_SITE;; - *) ac_site_file1=./$CONFIG_SITE;; - esac -elif test "x$prefix" != xNONE; then - ac_site_file1=$prefix/share/config.site - ac_site_file2=$prefix/etc/config.site -else - ac_site_file1=$ac_default_prefix/share/config.site - ac_site_file2=$ac_default_prefix/etc/config.site -fi -for ac_site_file in "$ac_site_file1" "$ac_site_file2" -do - test "x$ac_site_file" = xNONE && continue - if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 -$as_echo "$as_me: loading site script $ac_site_file" >&6;} - sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" \ - || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } - fi -done - -if test -r "$cache_file"; then - # Some versions of bash will fail to source /dev/null (special files - # actually), so we avoid doing that. DJGPP emulates it as a regular file. - if test /dev/null != "$cache_file" && test -f "$cache_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 -$as_echo "$as_me: loading cache $cache_file" >&6;} - case $cache_file in - [\\/]* | ?:[\\/]* ) . "$cache_file";; - *) . "./$cache_file";; - esac - fi -else - { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 -$as_echo "$as_me: creating cache $cache_file" >&6;} - >$cache_file -fi - -# Check that the precious variables saved in the cache have kept the same -# value. -ac_cache_corrupted=false -for ac_var in $ac_precious_vars; do - eval ac_old_set=\$ac_cv_env_${ac_var}_set - eval ac_new_set=\$ac_env_${ac_var}_set - eval ac_old_val=\$ac_cv_env_${ac_var}_value - eval ac_new_val=\$ac_env_${ac_var}_value - case $ac_old_set,$ac_new_set in - set,) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} - ac_cache_corrupted=: ;; - ,set) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} - ac_cache_corrupted=: ;; - ,);; - *) - if test "x$ac_old_val" != "x$ac_new_val"; then - # differences in whitespace do not lead to failure. - ac_old_val_w=`echo x $ac_old_val` - ac_new_val_w=`echo x $ac_new_val` - if test "$ac_old_val_w" != "$ac_new_val_w"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - ac_cache_corrupted=: - else - { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} - eval $ac_var=\$ac_old_val - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} - fi;; - esac - # Pass precious variables to config.status. - if test "$ac_new_set" = set; then - case $ac_new_val in - *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; - *) ac_arg=$ac_var=$ac_new_val ;; - esac - case " $ac_configure_args " in - *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. - *) as_fn_append ac_configure_args " '$ac_arg'" ;; - esac - fi -done -if $ac_cache_corrupted; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 -$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 -fi -## -------------------- ## -## Main body of script. ## -## -------------------- ## - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. -set dummy ${ac_tool_prefix}gcc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CC="${ac_tool_prefix}gcc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_CC"; then - ac_ct_CC=$CC - # Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_CC="gcc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -else - CC="$ac_cv_prog_CC" -fi - -if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. -set dummy ${ac_tool_prefix}cc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CC="${ac_tool_prefix}cc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - fi -fi -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - ac_prog_rejected=no -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# != 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" - fi -fi -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - for ac_prog in cl.exe - do - # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. -set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$CC" && break - done -fi -if test -z "$CC"; then - ac_ct_CC=$CC - for ac_prog in cl.exe -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_CC="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$ac_ct_CC" && break -done - - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -fi - -fi - - -test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } - -# Provide some information about the compiler. -$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 -set X $ac_compile -ac_compiler=$2 -for ac_option in --version -v -V -qversion; do - { { ac_try="$ac_compiler $ac_option >&5" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compiler $ac_option >&5") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - sed '10a\ -... rest of stderr output deleted ... - 10q' conftest.err >conftest.er1 - cat conftest.er1 >&5 - fi - rm -f conftest.er1 conftest.err - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -done - -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" -# Try to create an executable without -o first, disregard a.out. -# It will help us diagnose broken compilers, and finding out an intuition -# of exeext. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 -$as_echo_n "checking whether the C compiler works... " >&6; } -ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` - -# The possible output files: -ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" - -ac_rmfiles= -for ac_file in $ac_files -do - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - * ) ac_rmfiles="$ac_rmfiles $ac_file";; - esac -done -rm -f $ac_rmfiles - -if { { ac_try="$ac_link_default" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link_default") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' -# in a Makefile. We should not override ac_cv_exeext if it was cached, -# so that the user can short-circuit this test for compilers unknown to -# Autoconf. -for ac_file in $ac_files '' -do - test -f "$ac_file" || continue - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) - ;; - [ab].out ) - # We found the default executable, but exeext='' is most - # certainly right. - break;; - *.* ) - if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; - then :; else - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - fi - # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' - # argument, so we may need to know it at that point already. - # Even if this section looks crufty: it has the advantage of - # actually working. - break;; - * ) - break;; - esac -done -test "$ac_cv_exeext" = no && ac_cv_exeext= - -else - ac_file='' -fi -if test -z "$ac_file"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -$as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 -$as_echo_n "checking for C compiler default output file name... " >&6; } -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 -$as_echo "$ac_file" >&6; } -ac_exeext=$ac_cv_exeext - -rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 -$as_echo_n "checking for suffix of executables... " >&6; } -if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # If both `conftest.exe' and `conftest' are `present' (well, observable) -# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will -# work properly (i.e., refer to `conftest.exe'), while it won't with -# `rm'. -for ac_file in conftest.exe conftest conftest.*; do - test -f "$ac_file" || continue - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - break;; - * ) break;; - esac -done -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } -fi -rm -f conftest conftest$ac_cv_exeext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 -$as_echo "$ac_cv_exeext" >&6; } - -rm -f conftest.$ac_ext -EXEEXT=$ac_cv_exeext -ac_exeext=$EXEEXT -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -FILE *f = fopen ("conftest.out", "w"); - return ferror (f) || fclose (f) != 0; - - ; - return 0; -} -_ACEOF -ac_clean_files="$ac_clean_files conftest.out" -# Check that the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 -$as_echo_n "checking whether we are cross compiling... " >&6; } -if test "$cross_compiling" != yes; then - { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if { ac_try='./conftest$ac_cv_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } - fi - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 -$as_echo "$cross_compiling" >&6; } - -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 -$as_echo_n "checking for suffix of object files... " >&6; } -if ${ac_cv_objext+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -rm -f conftest.o conftest.obj -if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - for ac_file in conftest.o conftest.obj conftest.*; do - test -f "$ac_file" || continue; - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; - *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` - break;; - esac -done -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } -fi -rm -f conftest.$ac_cv_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 -$as_echo "$ac_cv_objext" >&6; } -OBJEXT=$ac_cv_objext -ac_objext=$OBJEXT -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 -$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if ${ac_cv_c_compiler_gnu+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -#ifndef __GNUC__ - choke me -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_compiler_gnu=yes -else - ac_compiler_gnu=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -ac_cv_c_compiler_gnu=$ac_compiler_gnu - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 -$as_echo "$ac_cv_c_compiler_gnu" >&6; } -if test $ac_compiler_gnu = yes; then - GCC=yes -else - GCC= -fi -ac_test_CFLAGS=${CFLAGS+set} -ac_save_CFLAGS=$CFLAGS -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 -$as_echo_n "checking whether $CC accepts -g... " >&6; } -if ${ac_cv_prog_cc_g+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_save_c_werror_flag=$ac_c_werror_flag - ac_c_werror_flag=yes - ac_cv_prog_cc_g=no - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -else - CFLAGS="" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - ac_c_werror_flag=$ac_save_c_werror_flag - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 -$as_echo "$ac_cv_prog_cc_g" >&6; } -if test "$ac_test_CFLAGS" = set; then - CFLAGS=$ac_save_CFLAGS -elif test $ac_cv_prog_cc_g = yes; then - if test "$GCC" = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-g" - fi -else - if test "$GCC" = yes; then - CFLAGS="-O2" - else - CFLAGS= - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 -$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if ${ac_cv_prog_cc_c89+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c89=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -struct stat; -/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ -struct buf { int x; }; -FILE * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; -{ - return p[i]; -} -static char *f (char * (*g) (char **, int), char **p, ...) -{ - char *s; - va_list v; - va_start (v,p); - s = g (p, va_arg (v,int)); - va_end (v); - return s; -} - -/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has - function prototypes and stuff, but not '\xHH' hex character constants. - These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std is added to get - proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an - array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std. */ -int osf4_cc_array ['\x00' == 0 ? 1 : -1]; - -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) 'x' -int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; - -int test (int i, double x); -struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);}; -int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); -int argc; -char **argv; -int -main () -{ -return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; - ; - return 0; -} -_ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c89=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c89" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c89" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c89" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno; then : - -fi - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 -$as_echo_n "checking how to run the C preprocessor... " >&6; } -# On Suns, sometimes $CPP names a directory. -if test -n "$CPP" && test -d "$CPP"; then - CPP= -fi -if test -z "$CPP"; then - if ${ac_cv_prog_CPP+:} false; then : - $as_echo_n "(cached) " >&6 -else - # Double quotes because CPP needs to be expanded - for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" - do - ac_preproc_ok=false -for ac_c_preproc_warn_flag in '' yes -do - # Use a header file that comes with gcc, so configuring glibc - # with a fresh cross-compiler works. - # Prefer to if __STDC__ is defined, since - # exists even on freestanding compilers. - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __STDC__ -# include -#else -# include -#endif - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - # Broken: fails on valid input. -continue -fi -rm -f conftest.err conftest.i conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else - # Passes both tests. -ac_preproc_ok=: -break -fi -rm -f conftest.err conftest.i conftest.$ac_ext - -done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - break -fi - - done - ac_cv_prog_CPP=$CPP - -fi - CPP=$ac_cv_prog_CPP -else - ac_cv_prog_CPP=$CPP -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 -$as_echo "$CPP" >&6; } -ac_preproc_ok=false -for ac_c_preproc_warn_flag in '' yes -do - # Use a header file that comes with gcc, so configuring glibc - # with a fresh cross-compiler works. - # Prefer to if __STDC__ is defined, since - # exists even on freestanding compilers. - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __STDC__ -# include -#else -# include -#endif - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - # Broken: fails on valid input. -continue -fi -rm -f conftest.err conftest.i conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else - # Passes both tests. -ac_preproc_ok=: -break -fi -rm -f conftest.err conftest.i conftest.$ac_ext - -done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } -fi - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -$as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if ${ac_cv_path_GREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$GREP"; then - ac_path_GREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in grep ggrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in -*GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_GREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_GREP=$GREP -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -$as_echo "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -$as_echo_n "checking for egrep... " >&6; } -if ${ac_cv_path_EGREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in egrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in -*GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then - as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_EGREP=$EGREP -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -$as_echo "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 -$as_echo_n "checking for ANSI C header files... " >&6; } -if ${ac_cv_header_stdc+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_stdc=yes -else - ac_cv_header_stdc=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -if test $ac_cv_header_stdc = yes; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then : - : -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#if ((' ' & 0x0FF) == 0x020) -# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#else -# define ISLOWER(c) \ - (('a' <= (c) && (c) <= 'i') \ - || ('j' <= (c) && (c) <= 'r') \ - || ('s' <= (c) && (c) <= 'z')) -# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) -#endif - -#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) -int -main () -{ - int i; - for (i = 0; i < 256; i++) - if (XOR (islower (i), ISLOWER (i)) - || toupper (i) != TOUPPER (i)) - return 2; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - -else - ac_cv_header_stdc=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 -$as_echo "$ac_cv_header_stdc" >&6; } -if test $ac_cv_header_stdc = yes; then - -$as_echo "#define STDC_HEADERS 1" >>confdefs.h - -fi - -# On IRIX 5.3, sys/types and inttypes.h are conflicting. -for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ - inttypes.h stdint.h unistd.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default -" -if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 -$as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if ${ac_cv_c_bigendian+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_c_bigendian=unknown - # See if we're dealing with a universal compiler. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifndef __APPLE_CC__ - not a universal capable compiler - #endif - typedef int dummy; - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - - # Check for potential -arch flags. It is not universal unless - # there are at least two -arch flags with different values. - ac_arch= - ac_prev= - for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do - if test -n "$ac_prev"; then - case $ac_word in - i?86 | x86_64 | ppc | ppc64) - if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then - ac_arch=$ac_word - else - ac_cv_c_bigendian=universal - break - fi - ;; - esac - ac_prev= - elif test "x$ac_word" = "x-arch"; then - ac_prev=arch - fi - done -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $ac_cv_c_bigendian = unknown; then - # See if sys/param.h defines the BYTE_ORDER macro. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - -int -main () -{ -#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ - && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ - && LITTLE_ENDIAN) - bogus endian macros - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - # It does; now see whether it defined to BIG_ENDIAN or not. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - -int -main () -{ -#if BYTE_ORDER != BIG_ENDIAN - not big endian - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_bigendian=yes -else - ac_cv_c_bigendian=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) - bogus endian macros - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - # It does; now see whether it defined to _BIG_ENDIAN or not. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -#ifndef _BIG_ENDIAN - not big endian - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_bigendian=yes -else - ac_cv_c_bigendian=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # Compile a test program. - if test "$cross_compiling" = yes; then : - # Try to guess by grepping values from an object file. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -short int ascii_mm[] = - { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; - short int ascii_ii[] = - { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; - int use_ascii (int i) { - return ascii_mm[i] + ascii_ii[i]; - } - short int ebcdic_ii[] = - { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; - short int ebcdic_mm[] = - { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; - int use_ebcdic (int i) { - return ebcdic_mm[i] + ebcdic_ii[i]; - } - extern int foo; - -int -main () -{ -return use_ascii (foo) == use_ebcdic (foo); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then - ac_cv_c_bigendian=yes - fi - if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then - if test "$ac_cv_c_bigendian" = unknown; then - ac_cv_c_bigendian=no - else - # finding both strings is unlikely to happen, but who knows? - ac_cv_c_bigendian=unknown - fi - fi -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ - - /* Are we little or big endian? From Harbison&Steele. */ - union - { - long int l; - char c[sizeof (long int)]; - } u; - u.l = 1; - return u.c[sizeof (long int) - 1] == 1; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_c_bigendian=no -else - ac_cv_c_bigendian=yes -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 -$as_echo "$ac_cv_c_bigendian" >&6; } - case $ac_cv_c_bigendian in #( - yes) - LITEND=0 -;; #( - no) - LITEND=1 - - ;; #( - universal) - as_fn_error $? "Cannot determine endianness" "$LINENO" 5 - ;; #( - *) - as_fn_error $? "Cannot determine endianness" "$LINENO" 5 - ;; - esac - -ac_config_files="$ac_config_files decnumber/src/decNumberLocal.h" - -cat >confcache <<\_ACEOF -# This file is a shell script that caches the results of configure -# tests run on this system so they can be shared between configure -# scripts and configure runs, see configure's option --config-cache. -# It is not useful on other systems. If it contains results you don't -# want to keep, you may remove or edit it. -# -# config.status only pays attention to the cache file if you give it -# the --recheck option to rerun configure. -# -# `ac_cv_env_foo' variables (set or unset) will be overridden when -# loading this file, other *unset* `ac_cv_foo' will be assigned the -# following values. - -_ACEOF - -# The following way of writing the cache mishandles newlines in values, -# but we know of no workaround that is simple, portable, and efficient. -# So, we kill variables containing newlines. -# Ultrix sh set writes to stderr and can't be redirected directly, -# and sets the high bit in the cache file unless we assign to the vars. -( - for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - - (set) 2>&1 | - case $as_nl`(ac_space=' '; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \. - sed -n \ - "s/'/'\\\\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" - ;; #( - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" - ;; - esac | - sort -) | - sed ' - /^ac_cv_env_/b end - t clear - :clear - s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ - t end - s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - :end' >>confcache -if diff "$cache_file" confcache >/dev/null 2>&1; then :; else - if test -w "$cache_file"; then - if test "x$cache_file" != "x/dev/null"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 -$as_echo "$as_me: updating cache $cache_file" >&6;} - if test ! -f "$cache_file" || test -h "$cache_file"; then - cat confcache >"$cache_file" - else - case $cache_file in #( - */* | ?:*) - mv -f confcache "$cache_file"$$ && - mv -f "$cache_file"$$ "$cache_file" ;; #( - *) - mv -f confcache "$cache_file" ;; - esac - fi - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 -$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} - fi -fi -rm -f confcache - -test "x$prefix" = xNONE && prefix=$ac_default_prefix -# Let make expand exec_prefix. -test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' - -# Transform confdefs.h into DEFS. -# Protect against shell expansion while executing Makefile rules. -# Protect against Makefile macro expansion. -# -# If the first sed substitution is executed (which looks for macros that -# take arguments), then branch to the quote section. Otherwise, -# look for a macro that doesn't take arguments. -ac_script=' -:mline -/\\$/{ - N - s,\\\n,, - b mline -} -t clear -:clear -s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g -t quote -s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g -t quote -b any -:quote -s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g -s/\[/\\&/g -s/\]/\\&/g -s/\$/$$/g -H -:any -${ - g - s/^\n// - s/\n/ /g - p -} -' -DEFS=`sed -n "$ac_script" confdefs.h` - - -ac_libobjs= -ac_ltlibobjs= -U= -for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue - # 1. Remove the extension, and $U if already installed. - ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' - ac_i=`$as_echo "$ac_i" | sed "$ac_script"` - # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR - # will be set to the directory where LIBOBJS objects are built. - as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" - as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' -done -LIBOBJS=$ac_libobjs - -LTLIBOBJS=$ac_ltlibobjs - - - -: "${CONFIG_STATUS=./config.status}" -ac_write_fail=0 -ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 -$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} -as_write_fail=0 -cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 -#! $SHELL -# Generated by $as_me. -# Run this file to recreate the current configuration. -# Compiler output produced by configure, useful for debugging -# configure, is in config.log if it exists. - -debug=false -ac_cs_recheck=false -ac_cs_silent=false - -SHELL=\${CONFIG_SHELL-$SHELL} -export SHELL -_ASEOF -cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -pR' - fi -else - as_ln_s='cp -pR' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -as_test_x='test -x' -as_executable_p=as_fn_executable_p - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - -exec 6>&1 -## ----------------------------------- ## -## Main body of $CONFIG_STATUS script. ## -## ----------------------------------- ## -_ASEOF -test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Save the log message, to keep $0 and so on meaningful, and to -# report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. -ac_log=" -This file was extended by libdecnumber $as_me 368-4, which was -generated by GNU Autoconf 2.69. Invocation command line was - - CONFIG_FILES = $CONFIG_FILES - CONFIG_HEADERS = $CONFIG_HEADERS - CONFIG_LINKS = $CONFIG_LINKS - CONFIG_COMMANDS = $CONFIG_COMMANDS - $ $0 $@ - -on `(hostname || uname -n) 2>/dev/null | sed 1q` -" - -_ACEOF - -case $ac_config_files in *" -"*) set x $ac_config_files; shift; ac_config_files=$*;; -esac - - - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# Files that config.status was made for. -config_files="$ac_config_files" - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions -from templates according to the current configuration. Unless the files -and actions are specified as TAGs, all are instantiated by default. - -Usage: $0 [OPTION]... [TAG]... - - -h, --help print this help, then exit - -V, --version print version number and configuration settings, then exit - --config print configuration, then exit - -q, --quiet, --silent - do not print progress messages - -d, --debug don't remove temporary files - --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE - -Configuration files: -$config_files - -Report bugs to ." - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" -ac_cs_version="\\ -libdecnumber config.status 368-4 -configured by $0, generated by GNU Autoconf 2.69, - with options \\"\$ac_cs_config\\" - -Copyright (C) 2012 Free Software Foundation, Inc. -This config.status script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it." - -ac_pwd='$ac_pwd' -srcdir='$srcdir' -test -n "\$AWK" || AWK=awk -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# The default lists apply if the user does not specify any file. -ac_need_defaults=: -while test $# != 0 -do - case $1 in - --*=?*) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` - ac_shift=: - ;; - --*=) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg= - ac_shift=: - ;; - *) - ac_option=$1 - ac_optarg=$2 - ac_shift=shift - ;; - esac - - case $ac_option in - # Handling of the options. - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - ac_cs_recheck=: ;; - --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) - $as_echo "$ac_cs_version"; exit ;; - --config | --confi | --conf | --con | --co | --c ) - $as_echo "$ac_cs_config"; exit ;; - --debug | --debu | --deb | --de | --d | -d ) - debug=: ;; - --file | --fil | --fi | --f ) - $ac_shift - case $ac_optarg in - *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - '') as_fn_error $? "missing file argument" ;; - esac - as_fn_append CONFIG_FILES " '$ac_optarg'" - ac_need_defaults=false;; - --he | --h | --help | --hel | -h ) - $as_echo "$ac_cs_usage"; exit ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil | --si | --s) - ac_cs_silent=: ;; - - # This is an error. - -*) as_fn_error $? "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; - - *) as_fn_append ac_config_targets " $1" - ac_need_defaults=false ;; - - esac - shift -done - -ac_configure_extra_args= - -if $ac_cs_silent; then - exec 6>/dev/null - ac_configure_extra_args="$ac_configure_extra_args --silent" -fi - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -if \$ac_cs_recheck; then - set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion - shift - \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 - CONFIG_SHELL='$SHELL' - export CONFIG_SHELL - exec "\$@" -fi - -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX - $as_echo "$ac_log" -} >&5 - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - -# Handling of arguments. -for ac_config_target in $ac_config_targets -do - case $ac_config_target in - "decnumber/src/decNumberLocal.h") CONFIG_FILES="$CONFIG_FILES decnumber/src/decNumberLocal.h" ;; - - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; - esac -done - - -# If the user did not use the arguments to specify the items to instantiate, -# then the envvar interface is used. Set only those that are not. -# We use the long form for the default assignment because of an extremely -# bizarre bug on SunOS 4.1.3. -if $ac_need_defaults; then - test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files -fi - -# Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason against having it here, and in addition, -# creating and moving files from /tmp can sometimes cause problems. -# Hook for its removal unless debugging. -# Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. -$debug || -{ - tmp= ac_tmp= - trap 'exit_status=$? - : "${ac_tmp:=$tmp}" - { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status -' 0 - trap 'as_fn_exit 1' 1 2 13 15 -} -# Create a (secure) tmp directory for tmp files. - -{ - tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -d "$tmp" -} || -{ - tmp=./conf$$-$RANDOM - (umask 077 && mkdir "$tmp") -} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 -ac_tmp=$tmp - -# Set up the scripts for CONFIG_FILES section. -# No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. -if test -n "$CONFIG_FILES"; then - - -ac_cr=`echo X | tr X '\015'` -# On cygwin, bash can eat \r inside `` if the user requested igncr. -# But we know of no other shell where ac_cr would be empty at this -# point, so we can use a bashism as a fallback. -if test "x$ac_cr" = x; then - eval ac_cr=\$\'\\r\' -fi -ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` -if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\\r' -else - ac_cs_awk_cr=$ac_cr -fi - -echo 'BEGIN {' >"$ac_tmp/subs1.awk" && -_ACEOF - - -{ - echo "cat >conf$$subs.awk <<_ACEOF" && - echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && - echo "_ACEOF" -} >conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` -ac_delim='%!_!# ' -for ac_last_try in false false false false false :; do - . ./conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - - ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` - if test $ac_delim_n = $ac_delim_num; then - break - elif $ac_last_try; then - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done -rm -f conf$$subs.sh - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && -_ACEOF -sed -n ' -h -s/^/S["/; s/!.*/"]=/ -p -g -s/^[^!]*!// -:repl -t repl -s/'"$ac_delim"'$// -t delim -:nl -h -s/\(.\{148\}\)..*/\1/ -t more1 -s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ -p -n -b repl -:more1 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t nl -:delim -h -s/\(.\{148\}\)..*/\1/ -t more2 -s/["\\]/\\&/g; s/^/"/; s/$/"/ -p -b -:more2 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t delim -' >$CONFIG_STATUS || ac_write_fail=1 -rm -f conf$$subs.awk -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACAWK -cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && - for (key in S) S_is_set[key] = 1 - FS = "" - -} -{ - line = $ 0 - nfields = split(line, field, "@") - substed = 0 - len = length(field[1]) - for (i = 2; i < nfields; i++) { - key = field[i] - keylen = length(key) - if (S_is_set[key]) { - value = S[key] - line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) - len += length(value) + length(field[++i]) - substed = 1 - } else - len += 1 + keylen - } - - print line -} - -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then - sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" -else - cat -fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ - || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 -_ACEOF - -# VPATH may cause trouble with some makes, so we remove sole $(srcdir), -# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and -# trailing colons and then remove the whole line if VPATH becomes empty -# (actually we leave an empty line to preserve line numbers). -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ -h -s/// -s/^/:/ -s/[ ]*$/:/ -s/:\$(srcdir):/:/g -s/:\${srcdir}:/:/g -s/:@srcdir@:/:/g -s/^:*// -s/:*$// -x -s/\(=[ ]*\).*/\1/ -G -s/\n// -s/^[^=]*=[ ]*$// -}' -fi - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -fi # test -n "$CONFIG_FILES" - - -eval set X " :F $CONFIG_FILES " -shift -for ac_tag -do - case $ac_tag in - :[FHLC]) ac_mode=$ac_tag; continue;; - esac - case $ac_mode$ac_tag in - :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; - :[FH]-) ac_tag=-:-;; - :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; - esac - ac_save_IFS=$IFS - IFS=: - set x $ac_tag - IFS=$ac_save_IFS - shift - ac_file=$1 - shift - - case $ac_mode in - :L) ac_source=$1;; - :[FH]) - ac_file_inputs= - for ac_f - do - case $ac_f in - -) ac_f="$ac_tmp/stdin";; - *) # Look for the file first in the build tree, then in the source tree - # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. - test -f "$ac_f" || - case $ac_f in - [\\/$]*) false;; - *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; - esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; - esac - case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac - as_fn_append ac_file_inputs " '$ac_f'" - done - - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - configure_input='Generated from '` - $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' - `' by configure.' - if test x"$ac_file" != x-; then - configure_input="$ac_file. $configure_input" - { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 -$as_echo "$as_me: creating $ac_file" >&6;} - fi - # Neutralize special characters interpreted by sed in replacement strings. - case $configure_input in #( - *\&* | *\|* | *\\* ) - ac_sed_conf_input=`$as_echo "$configure_input" | - sed 's/[\\\\&|]/\\\\&/g'`;; #( - *) ac_sed_conf_input=$configure_input;; - esac - - case $ac_tag in - *:-:* | *:-) cat >"$ac_tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; - esac - ;; - esac - - ac_dir=`$as_dirname -- "$ac_file" || -$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_file" : 'X\(//\)[^/]' \| \ - X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir="$ac_dir"; as_fn_mkdir_p - ac_builddir=. - -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix - -case $srcdir in - .) # We are building in place. - ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; -esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - - case $ac_mode in - :F) - # - # CONFIG_FILE - # - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# If the template does not know about datarootdir, expand it. -# FIXME: This hack should be removed a few years after 2.60. -ac_datarootdir_hack=; ac_datarootdir_seen= -ac_sed_dataroot=' -/datarootdir/ { - p - q -} -/@datadir@/p -/@docdir@/p -/@infodir@/p -/@localedir@/p -/@mandir@/p' -case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in -*datarootdir*) ac_datarootdir_seen=yes;; -*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 -$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - ac_datarootdir_hack=' - s&@datadir@&$datadir&g - s&@docdir@&$docdir&g - s&@infodir@&$infodir&g - s&@localedir@&$localedir&g - s&@mandir@&$mandir&g - s&\\\${datarootdir}&$datarootdir&g' ;; -esac -_ACEOF - -# Neutralize VPATH when `$srcdir' = `.'. -# Shell code in configure.ac might set extrasub. -# FIXME: do we really want to maintain this feature? -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_sed_extra="$ac_vpsub -$extrasub -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -:t -/@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s|@configure_input@|$ac_sed_conf_input|;t t -s&@top_builddir@&$ac_top_builddir_sub&;t t -s&@top_build_prefix@&$ac_top_build_prefix&;t t -s&@srcdir@&$ac_srcdir&;t t -s&@abs_srcdir@&$ac_abs_srcdir&;t t -s&@top_srcdir@&$ac_top_srcdir&;t t -s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t -s&@builddir@&$ac_builddir&;t t -s&@abs_builddir@&$ac_abs_builddir&;t t -s&@abs_top_builddir@&$ac_abs_top_builddir&;t t -$ac_datarootdir_hack -" -eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ - >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - -test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ - "$ac_tmp/out"`; test -z "$ac_out"; } && - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined" >&5 -$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined" >&2;} - - rm -f "$ac_tmp/stdin" - case $ac_file in - -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; - *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; - esac \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - ;; - - - - esac - -done # for ac_tag - - -as_fn_exit 0 -_ACEOF -ac_clean_files=$ac_clean_files_save - -test $ac_write_fail = 0 || - as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 - - -# configure is writing to config.log, and then calls config.status. -# config.status does its own redirection, appending to config.log. -# Unfortunately, on DOS this fails, as config.log is still kept open -# by configure, so config.status won't be able to write to it; its -# output is simply discarded. So we exec the FD to /dev/null, -# effectively closing config.log, so it can be properly (re)opened and -# appended to by config.status. When coming back to configure, we -# need to make the FD available again. -if test "$no_create" != yes; then - ac_cs_success=: - ac_config_status_args= - test "$silent" = yes && - ac_config_status_args="$ac_config_status_args --quiet" - exec 5>/dev/null - $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false - exec 5>>config.log - # Use ||, not &&, to avoid exiting from the if with $? = 1, which - # would make configure fail if this is the last instruction. - $ac_cs_success || as_fn_exit 1 -fi -if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 -$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} -fi - diff --git a/current-versions.txt b/current-versions.txt --- a/current-versions.txt +++ b/current-versions.txt @@ -1,7 +1,7 @@ This package was tested to work with these dependency versions and compiler version. These are the default versions fetched by cabal install. -Tested as of: 2014-04-17 19:37:00.007331 UTC +Tested as of: 2014-05-20 16:07:05.864819 UTC Path to compiler: ghc-7.8.2 Compiler description: 7.8.2 @@ -33,24 +33,26 @@ transformers-0.3.0.0 unix-2.7.0.1 -/home/massysett/deka/sunlight-20121/db: +/home/massysett/deka/sunlight-730/db: QuickCheck-2.7.3 ansi-terminal-0.6.1.1 ansi-wl-pprint-0.6.7.1 async-2.0.1.5 - deka-0.4.0.4 + deka-0.6.0.0 + mmorph-1.0.3 mtl-2.1.3.1 - optparse-applicative-0.8.0.1 + optparse-applicative-0.8.1 parsec-3.1.5 - primitive-0.5.2.1 + pipes-4.1.2 + primitive-0.5.3.0 random-1.0.1.1 regex-base-0.93.2 regex-tdfa-1.2.0 stm-2.4.3 - tagged-0.7.1 + tagged-0.7.2 tasty-0.8.0.4 - tasty-quickcheck-0.8.0.3 - text-1.1.0.1 + tasty-quickcheck-0.8.1 + text-1.1.1.2 tf-random-0.5 unbounded-delays-0.1.0.7 diff --git a/decnumber/src/decBasic.c b/decnumber/src/decBasic.c deleted file mode 100644 --- a/decnumber/src/decBasic.c +++ /dev/null @@ -1,3908 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* decBasic.c -- common base code for Basic decimal types */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is included in the package as decNumber.pdf. This */ -/* document is also available in HTML, together with specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* This module comprises code that is shared between decDouble and */ -/* decQuad (but not decSingle). The main arithmetic operations are */ -/* here (Add, Subtract, Multiply, FMA, and Division operators). */ -/* */ -/* Unlike decNumber, parameterization takes place at compile time */ -/* rather than at runtime. The parameters are set in the decDouble.c */ -/* (etc.) files, which then include this one to produce the compiled */ -/* code. The functions here, therefore, are code shared between */ -/* multiple formats. */ -/* */ -/* This must be included after decCommon.c. */ -/* ------------------------------------------------------------------ */ -// Names here refer to decFloat rather than to decDouble, etc., and -// the functions are in strict alphabetical order. - -// The compile-time flags SINGLE, DOUBLE, and QUAD are set up in -// decCommon.c -#if !defined(QUAD) - #error decBasic.c must be included after decCommon.c -#endif -#if SINGLE - #error Routines in decBasic.c are for decDouble and decQuad only -#endif - -/* Private constants */ -#define DIVIDE 0x80000000 // Divide operations [as flags] -#define REMAINDER 0x40000000 // .. -#define DIVIDEINT 0x20000000 // .. -#define REMNEAR 0x10000000 // .. - -/* Private functions (local, used only by routines in this module) */ -static decFloat *decDivide(decFloat *, const decFloat *, - const decFloat *, decContext *, uInt); -static decFloat *decCanonical(decFloat *, const decFloat *); -static void decFiniteMultiply(bcdnum *, uByte *, const decFloat *, - const decFloat *); -static decFloat *decInfinity(decFloat *, const decFloat *); -static decFloat *decInvalid(decFloat *, decContext *); -static decFloat *decNaNs(decFloat *, const decFloat *, const decFloat *, - decContext *); -static Int decNumCompare(const decFloat *, const decFloat *, Flag); -static decFloat *decToIntegral(decFloat *, const decFloat *, decContext *, - enum rounding, Flag); -static uInt decToInt32(const decFloat *, decContext *, enum rounding, - Flag, Flag); - -/* ------------------------------------------------------------------ */ -/* decCanonical -- copy a decFloat, making canonical */ -/* */ -/* result gets the canonicalized df */ -/* df is the decFloat to copy and make canonical */ -/* returns result */ -/* */ -/* This is exposed via decFloatCanonical for Double and Quad only. */ -/* This works on specials, too; no error or exception is possible. */ -/* ------------------------------------------------------------------ */ -static decFloat * decCanonical(decFloat *result, const decFloat *df) { - uInt encode, precode, dpd; // work - uInt inword, uoff, canon; // .. - Int n; // counter (down) - if (df!=result) *result=*df; // effect copy if needed - if (DFISSPECIAL(result)) { - if (DFISINF(result)) return decInfinity(result, df); // clean Infinity - // is a NaN - DFWORD(result, 0)&=~ECONNANMASK; // clear ECON except selector - if (DFISCCZERO(df)) return result; // coefficient continuation is 0 - // drop through to check payload - } - // return quickly if the coefficient continuation is canonical - { // declare block - #if DOUBLE - uInt sourhi=DFWORD(df, 0); - uInt sourlo=DFWORD(df, 1); - if (CANONDPDOFF(sourhi, 8) - && CANONDPDTWO(sourhi, sourlo, 30) - && CANONDPDOFF(sourlo, 20) - && CANONDPDOFF(sourlo, 10) - && CANONDPDOFF(sourlo, 0)) return result; - #elif QUAD - uInt sourhi=DFWORD(df, 0); - uInt sourmh=DFWORD(df, 1); - uInt sourml=DFWORD(df, 2); - uInt sourlo=DFWORD(df, 3); - if (CANONDPDOFF(sourhi, 4) - && CANONDPDTWO(sourhi, sourmh, 26) - && CANONDPDOFF(sourmh, 16) - && CANONDPDOFF(sourmh, 6) - && CANONDPDTWO(sourmh, sourml, 28) - && CANONDPDOFF(sourml, 18) - && CANONDPDOFF(sourml, 8) - && CANONDPDTWO(sourml, sourlo, 30) - && CANONDPDOFF(sourlo, 20) - && CANONDPDOFF(sourlo, 10) - && CANONDPDOFF(sourlo, 0)) return result; - #endif - } // block - - // Loop to repair a non-canonical coefficent, as needed - inword=DECWORDS-1; // current input word - uoff=0; // bit offset of declet - encode=DFWORD(result, inword); - for (n=DECLETS-1; n>=0; n--) { // count down declets of 10 bits - dpd=encode>>uoff; - uoff+=10; - if (uoff>32) { // crossed uInt boundary - inword--; - encode=DFWORD(result, inword); - uoff-=32; - dpd|=encode<<(10-uoff); // get pending bits - } - dpd&=0x3ff; // clear uninteresting bits - if (dpd<0x16e) continue; // must be canonical - canon=BIN2DPD[DPD2BIN[dpd]]; // determine canonical declet - if (canon==dpd) continue; // have canonical declet - // need to replace declet - if (uoff>=10) { // all within current word - encode&=~(0x3ff<<(uoff-10)); // clear the 10 bits ready for replace - encode|=canon<<(uoff-10); // insert the canonical form - DFWORD(result, inword)=encode; // .. and save - continue; - } - // straddled words - precode=DFWORD(result, inword+1); // get previous - precode&=0xffffffff>>(10-uoff); // clear top bits - DFWORD(result, inword+1)=precode|(canon<<(32-(10-uoff))); - encode&=0xffffffff<>(10-uoff); // insert canonical - DFWORD(result, inword)=encode; // .. and save - } // n - return result; - } // decCanonical - -/* ------------------------------------------------------------------ */ -/* decDivide -- divide operations */ -/* */ -/* result gets the result of dividing dfl by dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* op is the operation selector */ -/* returns result */ -/* */ -/* op is one of DIVIDE, REMAINDER, DIVIDEINT, or REMNEAR. */ -/* ------------------------------------------------------------------ */ -#define DIVCOUNT 0 // 1 to instrument subtractions counter -#define DIVBASE ((uInt)BILLION) // the base used for divide -#define DIVOPLEN DECPMAX9 // operand length ('digits' base 10**9) -#define DIVACCLEN (DIVOPLEN*3) // accumulator length (ditto) -static decFloat * decDivide(decFloat *result, const decFloat *dfl, - const decFloat *dfr, decContext *set, uInt op) { - decFloat quotient; // for remainders - bcdnum num; // for final conversion - uInt acc[DIVACCLEN]; // coefficent in base-billion .. - uInt div[DIVOPLEN]; // divisor in base-billion .. - uInt quo[DIVOPLEN+1]; // quotient in base-billion .. - uByte bcdacc[(DIVOPLEN+1)*9+2]; // for quotient in BCD, +1, +1 - uInt *msua, *msud, *msuq; // -> msu of acc, div, and quo - Int divunits, accunits; // lengths - Int quodigits; // digits in quotient - uInt *lsua, *lsuq; // -> current acc and quo lsus - Int length, multiplier; // work - uInt carry, sign; // .. - uInt *ua, *ud, *uq; // .. - uByte *ub; // .. - uInt uiwork; // for macros - uInt divtop; // top unit of div adjusted for estimating - #if DIVCOUNT - static uInt maxcount=0; // worst-seen subtractions count - uInt divcount=0; // subtractions count [this divide] - #endif - - // calculate sign - num.sign=(DFWORD(dfl, 0)^DFWORD(dfr, 0)) & DECFLOAT_Sign; - - if (DFISSPECIAL(dfl) || DFISSPECIAL(dfr)) { // either is special? - // NaNs are handled as usual - if (DFISNAN(dfl) || DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - // one or two infinities - if (DFISINF(dfl)) { - if (DFISINF(dfr)) return decInvalid(result, set); // Two infinities bad - if (op&(REMAINDER|REMNEAR)) return decInvalid(result, set); // as is rem - // Infinity/x is infinite and quiet, even if x=0 - DFWORD(result, 0)=num.sign; - return decInfinity(result, result); - } - // must be x/Infinity -- remainders are lhs - if (op&(REMAINDER|REMNEAR)) return decCanonical(result, dfl); - // divides: return zero with correct sign and exponent depending - // on op (Etiny for divide, 0 for divideInt) - decFloatZero(result); - if (op==DIVIDEINT) DFWORD(result, 0)|=num.sign; // add sign - else DFWORD(result, 0)=num.sign; // zeros the exponent, too - return result; - } - // next, handle zero operands (x/0 and 0/x) - if (DFISZERO(dfr)) { // x/0 - if (DFISZERO(dfl)) { // 0/0 is undefined - decFloatZero(result); - DFWORD(result, 0)=DECFLOAT_qNaN; - set->status|=DEC_Division_undefined; - return result; - } - if (op&(REMAINDER|REMNEAR)) return decInvalid(result, set); // bad rem - set->status|=DEC_Division_by_zero; - DFWORD(result, 0)=num.sign; - return decInfinity(result, result); // x/0 -> signed Infinity - } - num.exponent=GETEXPUN(dfl)-GETEXPUN(dfr); // ideal exponent - if (DFISZERO(dfl)) { // 0/x (x!=0) - // if divide, result is 0 with ideal exponent; divideInt has - // exponent=0, remainders give zero with lower exponent - if (op&DIVIDEINT) { - decFloatZero(result); - DFWORD(result, 0)|=num.sign; // add sign - return result; - } - if (!(op&DIVIDE)) { // a remainder - // exponent is the minimum of the operands - num.exponent=MINI(GETEXPUN(dfl), GETEXPUN(dfr)); - // if the result is zero the sign shall be sign of dfl - num.sign=DFWORD(dfl, 0)&DECFLOAT_Sign; - } - bcdacc[0]=0; - num.msd=bcdacc; // -> 0 - num.lsd=bcdacc; // .. - return decFinalize(result, &num, set); // [divide may clamp exponent] - } // 0/x - // [here, both operands are known to be finite and non-zero] - - // extract the operand coefficents into 'units' which are - // base-billion; the lhs is high-aligned in acc and the msu of both - // acc and div is at the right-hand end of array (offset length-1); - // the quotient can need one more unit than the operands as digits - // in it are not necessarily aligned neatly; further, the quotient - // may not start accumulating until after the end of the initial - // operand in acc if that is small (e.g., 1) so the accumulator - // must have at least that number of units extra (at the ls end) - GETCOEFFBILL(dfl, acc+DIVACCLEN-DIVOPLEN); - GETCOEFFBILL(dfr, div); - // zero the low uInts of acc - acc[0]=0; - acc[1]=0; - acc[2]=0; - acc[3]=0; - #if DOUBLE - #if DIVOPLEN!=2 - #error Unexpected Double DIVOPLEN - #endif - #elif QUAD - acc[4]=0; - acc[5]=0; - acc[6]=0; - acc[7]=0; - #if DIVOPLEN!=4 - #error Unexpected Quad DIVOPLEN - #endif - #endif - - // set msu and lsu pointers - msua=acc+DIVACCLEN-1; // [leading zeros removed below] - msuq=quo+DIVOPLEN; - //[loop for div will terminate because operands are non-zero] - for (msud=div+DIVOPLEN-1; *msud==0;) msud--; - // the initial least-significant unit of acc is set so acc appears - // to have the same length as div. - // This moves one position towards the least possible for each - // iteration - divunits=(Int)(msud-div+1); // precalculate - lsua=msua-divunits+1; // initial working lsu of acc - lsuq=msuq; // and of quo - - // set up the estimator for the multiplier; this is the msu of div, - // plus two bits from the unit below (if any) rounded up by one if - // there are any non-zero bits or units below that [the extra two - // bits makes for a much better estimate when the top unit is small] - divtop=*msud<<2; - if (divunits>1) { - uInt *um=msud-1; - uInt d=*um; - if (d>=750000000) {divtop+=3; d-=750000000;} - else if (d>=500000000) {divtop+=2; d-=500000000;} - else if (d>=250000000) {divtop++; d-=250000000;} - if (d) divtop++; - else for (um--; um>=div; um--) if (*um) { - divtop++; - break; - } - } // >1 unit - - #if DECTRACE - {Int i; - printf("----- div="); - for (i=divunits-1; i>=0; i--) printf("%09ld ", (LI)div[i]); - printf("\n");} - #endif - - // now collect up to DECPMAX+1 digits in the quotient (this may - // need OPLEN+1 uInts if unaligned) - quodigits=0; // no digits yet - for (;; lsua--) { // outer loop -- each input position - #if DECCHECK - if (lsua=lsua;) msua--; - accunits=(Int)(msua-lsua+1); // [maybe 0] - // subtraction is only necessary and possible if there are as - // least as many units remaining in acc for this iteration as - // there are in div - if (accunitsdiv: subtraction necessary at this position - for (ud=msud, ua=msua; ud>div; ud--, ua--) if (*ud!=*ua) break; - // [now at first mismatch or lsu] - if (*ud>*ua) break; // next time... - if (*ud==*ua) { // all compared equal - *lsuq+=1; // increment result - msua=lsua; // collapse acc units - *msua=0; // .. to a zero - break; - } - - // subtraction necessary; estimate multiplier [see above] - // if both *msud and *msua are small it is cost-effective to - // bring in part of the following units (if any) to get a - // better estimate (assume some other non-zero in div) - #define DIVLO 1000000U - #define DIVHI (DIVBASE/DIVLO) - #if DECUSE64 - if (divunits>1) { - // there cannot be a *(msud-2) for DECDOUBLE so next is - // an exact calculation unless DECQUAD (which needs to - // assume bits out there if divunits>2) - uLong mul=(uLong)*msua * DIVBASE + *(msua-1); - uLong div=(uLong)*msud * DIVBASE + *(msud-1); - #if QUAD - if (divunits>2) div++; - #endif - mul/=div; - multiplier=(Int)mul; - } - else multiplier=*msua/(*msud); - #else - if (divunits>1 && *msuadivunits - // msud is one unit 'lower' than msua, so estimate differently - #if DECUSE64 - uLong mul; - // as before, bring in extra digits if possible - if (divunits>1 && *msua>DIVSHIFTA); - carry=(uInt)(((uLong)hop*DIVMAGIC)>>DIVSHIFTB); - // the estimate is now in hi; now calculate sub-hi*10**9 - // to get the remainder (which will be =DIVBASE) { - lo-=DIVBASE; // correct by +1 - carry++; - } - } - #else // 32-bit - uInt hi; - // calculate multiplier*(*ud) into hi and lo - LONGMUL32HI(hi, *ud, multiplier); // get the high word - lo=multiplier*(*ud); // .. and the low - lo+=carry; // add the old hi - carry=hi+(lo=DIVBASE) { // split is needed - hop=(carry<<3)+(lo>>DIVSHIFTA); // hi:lo/2**29 - LONGMUL32HI(carry, hop, DIVMAGIC); // only need the high word - // [DIVSHIFTB is 32, so carry can be used directly] - // the estimate is now in carry; now calculate hi:lo-est*10**9; - // happily the top word of the result is irrelevant because it - // will always be zero so this needs only one multiplication - lo-=(carry*DIVBASE); - // the correction here will be at most +1; do it - if (lo>=DIVBASE) { - lo-=DIVBASE; - carry++; - } - } - #endif - if (lo>*ua) { // borrow needed - *ua+=DIVBASE; - carry++; - } - *ua-=lo; - } // ud loop - if (carry) *ua-=carry; // accdigits>divdigits [cannot borrow] - } // inner loop - - // the outer loop terminates when there is either an exact result - // or enough digits; first update the quotient digit count and - // pointer (if any significant digits) - #if DECTRACE - if (*lsuq || quodigits) printf("*lsuq=%09ld\n", (LI)*lsuq); - #endif - if (quodigits) { - quodigits+=9; // had leading unit earlier - lsuq--; - if (quodigits>DECPMAX+1) break; // have enough - } - else if (*lsuq) { // first quotient digits - const uInt *pow; - for (pow=DECPOWERS; *lsuq>=*pow; pow++) quodigits++; - lsuq--; - // [cannot have >DECPMAX+1 on first unit] - } - - if (*msua!=0) continue; // not an exact result - // acc is zero iff used all of original units and zero down to lsua - // (must also continue to original lsu for correct quotient length) - if (lsua>acc+DIVACCLEN-DIVOPLEN) continue; - for (; msua>lsua && *msua==0;) msua--; - if (*msua==0 && msua==lsua) break; - } // outer loop - - // all of the original operand in acc has been covered at this point - // quotient now has at least DECPMAX+2 digits - // *msua is now non-0 if inexact and sticky bits - // lsuq is one below the last uint of the quotient - lsuq++; // set -> true lsu of quo - if (*msua) *lsuq|=1; // apply sticky bit - - // quo now holds the (unrounded) quotient in base-billion; one - // base-billion 'digit' per uInt. - #if DECTRACE - printf("DivQuo:"); - for (uq=msuq; uq>=lsuq; uq--) printf(" %09ld", (LI)*uq); - printf("\n"); - #endif - - // Now convert to BCD for rounding and cleanup, starting from the - // most significant end [offset by one into bcdacc to leave room - // for a possible carry digit if rounding for REMNEAR is needed] - for (uq=msuq, ub=bcdacc+1; uq>=lsuq; uq--, ub+=9) { - uInt top, mid, rem; // work - if (*uq==0) { // no split needed - UBFROMUI(ub, 0); // clear 9 BCD8s - UBFROMUI(ub+4, 0); // .. - *(ub+8)=0; // .. - continue; - } - // *uq is non-zero -- split the base-billion digit into - // hi, mid, and low three-digits - #define divsplit9 1000000 // divisor - #define divsplit6 1000 // divisor - // The splitting is done by simple divides and remainders, - // assuming the compiler will optimize these [GCC does] - top=*uq/divsplit9; - rem=*uq%divsplit9; - mid=rem/divsplit6; - rem=rem%divsplit6; - // lay out the nine BCD digits (plus one unwanted byte) - UBFROMUI(ub, UBTOUI(&BIN2BCD8[top*4])); - UBFROMUI(ub+3, UBTOUI(&BIN2BCD8[mid*4])); - UBFROMUI(ub+6, UBTOUI(&BIN2BCD8[rem*4])); - } // BCD conversion loop - ub--; // -> lsu - - // complete the bcdnum; quodigits is correct, so the position of - // the first non-zero is known - num.msd=bcdacc+1+(msuq-lsuq+1)*9-quodigits; - num.lsd=ub; - - // make exponent adjustments, etc - if (lsuamaxcount) { // new high-water nark - maxcount=divcount; - printf("DivNewMaxCount: %ld\n", (LI)maxcount); - } - #endif - - if (op&DIVIDE) return decFinalize(result, &num, set); // all done - - // Is DIVIDEINT or a remainder; there is more to do -- first form - // the integer (this is done 'after the fact', unlike as in - // decNumber, so as not to tax DIVIDE) - - // The first non-zero digit will be in the first 9 digits, known - // from quodigits and num.msd, so there is always space for DECPMAX - // digits - - length=(Int)(num.lsd-num.msd+1); - //printf("Length exp: %ld %ld\n", (LI)length, (LI)num.exponent); - - if (length+num.exponent>DECPMAX) { // cannot fit - decFloatZero(result); - DFWORD(result, 0)=DECFLOAT_qNaN; - set->status|=DEC_Division_impossible; - return result; - } - - if (num.exponent>=0) { // already an int, or need pad zeros - for (ub=num.lsd+1; ub<=num.lsd+num.exponent; ub++) *ub=0; - num.lsd+=num.exponent; - } - else { // too long: round or truncate needed - Int drop=-num.exponent; - if (!(op&REMNEAR)) { // simple truncate - num.lsd-=drop; - if (num.lsd re-round digit - uByte reround; // reround value - *(num.msd-1)=0; // in case of left carry, or make 0 - if (drop 0] - reround=*roundat; - for (ub=roundat+1; ub<=num.lsd; ub++) { - if (*ub!=0) { - reround=DECSTICKYTAB[reround]; - break; - } - } // check stickies - if (roundat>num.msd) num.lsd=roundat-1; - else { - num.msd--; // use the 0 .. - num.lsd=num.msd; // .. at the new MSD place - } - if (reround!=0) { // discarding non-zero - uInt bump=0; - // rounding is DEC_ROUND_HALF_EVEN always - if (reround>5) bump=1; // >0.5 goes up - else if (reround==5) // exactly 0.5000 .. - bump=*(num.lsd) & 0x01; // .. up iff [new] lsd is odd - if (bump!=0) { // need increment - // increment the coefficient; this might end up with 1000... - ub=num.lsd; - for (; UBTOUI(ub-3)==0x09090909; ub-=4) UBFROMUI(ub-3, 0); - for (; *ub==9; ub--) *ub=0; // at most 3 more - *ub+=1; - if (ub9 - #error Exponent may overflow when doubled for Multiply -#endif -#if MULACCLEN!=(MULACCLEN/4)*4 - // This assumption is used below only for initialization - #error MULACCLEN is not a multiple of 4 -#endif - -static void decFiniteMultiply(bcdnum *num, uByte *bcdacc, - const decFloat *dfl, const decFloat *dfr) { - uInt bufl[MULOPLEN]; // left coefficient (base-billion) - uInt bufr[MULOPLEN]; // right coefficient (base-billion) - uInt *ui, *uj; // work - uByte *ub; // .. - uInt uiwork; // for macros - - #if DECUSE64 - uLong accl[MULACCLEN]; // lazy accumulator (base-billion+) - uLong *pl; // work -> lazy accumulator - uInt acc[MULACCLEN]; // coefficent in base-billion .. - #else - uInt acc[MULACCLEN*2]; // accumulator in base-billion .. - #endif - uInt *pa; // work -> accumulator - //printf("Base10**9: OpLen=%d MulAcclen=%d\n", OPLEN, MULACCLEN); - - /* Calculate sign and exponent */ - num->sign=(DFWORD(dfl, 0)^DFWORD(dfr, 0)) & DECFLOAT_Sign; - num->exponent=GETEXPUN(dfl)+GETEXPUN(dfr); // [see assertion above] - - /* Extract the coefficients and prepare the accumulator */ - // the coefficients of the operands are decoded into base-billion - // numbers in uInt arrays (bufl and bufr, LSD at offset 0) of the - // appropriate size. - GETCOEFFBILL(dfl, bufl); - GETCOEFFBILL(dfr, bufr); - #if DECTRACE && 0 - printf("CoeffbL:"); - for (ui=bufl+MULOPLEN-1; ui>=bufl; ui--) printf(" %08lx", (LI)*ui); - printf("\n"); - printf("CoeffbR:"); - for (uj=bufr+MULOPLEN-1; uj>=bufr; uj--) printf(" %08lx", (LI)*uj); - printf("\n"); - #endif - - // start the 64-bit/32-bit differing paths... -#if DECUSE64 - - // zero the accumulator - #if MULACCLEN==4 - accl[0]=0; accl[1]=0; accl[2]=0; accl[3]=0; - #else // use a loop - // MULACCLEN is a multiple of four, asserted above - for (pl=accl; pl1 may be - // needed. Values of A and B are chosen to satisfy the constraints - // just mentioned while minimizing the maximum error (and hence the - // maximum correction), as shown in the following table: - // - // Type OPLEN A B maxX maxError maxCorrection - // --------------------------------------------------------- - // DOUBLE 2 29 32 <2*10**18 0.63 1 - // QUAD 4 30 31 <4*10**18 1.17 2 - // - // In the OPLEN==2 case there is most choice, but the value for B - // of 32 has a big advantage as then the calculation of the - // estimate requires no shifting; the compiler can extract the high - // word directly after multiplying magic*hop. - #define MULMAGIC 2305843009U // 2**61/10**9 [both cases] - #if DOUBLE - #define MULSHIFTA 29 - #define MULSHIFTB 32 - #elif QUAD - #define MULSHIFTA 30 - #define MULSHIFTB 31 - #else - #error Unexpected type - #endif - - #if DECTRACE - printf("MulAccl:"); - for (pl=accl+MULACCLEN-1; pl>=accl; pl--) - printf(" %08lx:%08lx", (LI)(*pl>>32), (LI)(*pl&0xffffffff)); - printf("\n"); - #endif - - for (pl=accl, pa=acc; pl=MULTBASE) { - // *pl holds a binary number which needs to be split - hop=(uInt)(*pl>>MULSHIFTA); - est=(uInt)(((uLong)hop*MULMAGIC)>>MULSHIFTB); - // the estimate is now in est; now calculate hi:lo-est*10**9; - // happily the top word of the result is irrelevant because it - // will always be zero so this needs only one multiplication - lo=(uInt)(*pl-((uLong)est*MULTBASE)); // low word of result - // If QUAD, the correction here could be +2 - if (lo>=MULTBASE) { - lo-=MULTBASE; // correct by +1 - est++; - #if QUAD - // may need to correct by +2 - if (lo>=MULTBASE) { - lo-=MULTBASE; - est++; - } - #endif - } - // finally place lo as the new coefficient 'digit' and add est to - // the next place up [this is safe because this path is never - // taken on the final iteration as *pl will fit] - *pa=lo; - *(pl+1)+=est; - } // *pl needed split - else { // *pl1 may be - // needed. Values of A and B are chosen to satisfy the constraints - // just mentioned while minimizing the maximum error (and hence the - // maximum correction), as shown in the following table: - // - // Type OPLEN A B maxX maxError maxCorrection - // --------------------------------------------------------- - // DOUBLE 2 29 32 <2*10**18 0.63 1 - // QUAD 4 30 31 <4*10**18 1.17 2 - // - // In the OPLEN==2 case there is most choice, but the value for B - // of 32 has a big advantage as then the calculation of the - // estimate requires no shifting; the high word is simply - // calculated from multiplying magic*hop. - #define MULMAGIC 2305843009U // 2**61/10**9 [both cases] - #if DOUBLE - #define MULSHIFTA 29 - #define MULSHIFTB 32 - #elif QUAD - #define MULSHIFTA 30 - #define MULSHIFTB 31 - #else - #error Unexpected type - #endif - - #if DECTRACE - printf("MulHiLo:"); - for (pa=acc+MULACCLEN-1; pa>=acc; pa--) - printf(" %08lx:%08lx", (LI)*(pa+MULACCLEN), (LI)*pa); - printf("\n"); - #endif - - for (pa=acc;; pa++) { // each low uInt - uInt hi, lo; // words of exact multiply result - uInt hop, estlo; // work - #if QUAD - uInt esthi; // .. - #endif - - lo=*pa; - hi=*(pa+MULACCLEN); // top 32 bits - // hi and lo now hold a binary number which needs to be split - - #if DOUBLE - hop=(hi<<3)+(lo>>MULSHIFTA); // hi:lo/2**29 - LONGMUL32HI(estlo, hop, MULMAGIC);// only need the high word - // [MULSHIFTB is 32, so estlo can be used directly] - // the estimate is now in estlo; now calculate hi:lo-est*10**9; - // happily the top word of the result is irrelevant because it - // will always be zero so this needs only one multiplication - lo-=(estlo*MULTBASE); - // esthi=0; // high word is ignored below - // the correction here will be at most +1; do it - if (lo>=MULTBASE) { - lo-=MULTBASE; - estlo++; - } - #elif QUAD - hop=(hi<<2)+(lo>>MULSHIFTA); // hi:lo/2**30 - LONGMUL32HI(esthi, hop, MULMAGIC);// shift will be 31 .. - estlo=hop*MULMAGIC; // .. so low word needed - estlo=(esthi<<1)+(estlo>>MULSHIFTB); // [just the top bit] - // esthi=0; // high word is ignored below - lo-=(estlo*MULTBASE); // as above - // the correction here could be +1 or +2 - if (lo>=MULTBASE) { - lo-=MULTBASE; - estlo++; - } - if (lo>=MULTBASE) { - lo-=MULTBASE; - estlo++; - } - #else - #error Unexpected type - #endif - - // finally place lo as the new accumulator digit and add est to - // the next place up; this latter add could cause a carry of 1 - // to the high word of the next place - *pa=lo; - *(pa+1)+=estlo; - // esthi is always 0 for DOUBLE and QUAD so this is skipped - // *(pa+1+MULACCLEN)+=esthi; - if (*(pa+1)=acc; pa--) printf(" %09ld", (LI)*pa); - printf("\n"); - #endif - - // Now convert to BCD for rounding and cleanup, starting from the - // most significant end - pa=acc+MULACCLEN-1; - if (*pa!=0) num->msd=bcdacc+LEADZEROS;// drop known lead zeros - else { // >=1 word of leading zeros - num->msd=bcdacc; // known leading zeros are gone - pa--; // skip first word .. - for (; *pa==0; pa--) if (pa==acc) break; // .. and any more leading 0s - } - for (ub=bcdacc;; pa--, ub+=9) { - if (*pa!=0) { // split(s) needed - uInt top, mid, rem; // work - // *pa is non-zero -- split the base-billion acc digit into - // hi, mid, and low three-digits - #define mulsplit9 1000000 // divisor - #define mulsplit6 1000 // divisor - // The splitting is done by simple divides and remainders, - // assuming the compiler will optimize these where useful - // [GCC does] - top=*pa/mulsplit9; - rem=*pa%mulsplit9; - mid=rem/mulsplit6; - rem=rem%mulsplit6; - // lay out the nine BCD digits (plus one unwanted byte) - UBFROMUI(ub, UBTOUI(&BIN2BCD8[top*4])); - UBFROMUI(ub+3, UBTOUI(&BIN2BCD8[mid*4])); - UBFROMUI(ub+6, UBTOUI(&BIN2BCD8[rem*4])); - } - else { // *pa==0 - UBFROMUI(ub, 0); // clear 9 BCD8s - UBFROMUI(ub+4, 0); // .. - *(ub+8)=0; // .. - } - if (pa==acc) break; - } // BCD conversion loop - - num->lsd=ub+8; // complete the bcdnum .. - - #if DECTRACE - decShowNum(num, "postmult"); - decFloatShow(dfl, "dfl"); - decFloatShow(dfr, "dfr"); - #endif - return; - } // decFiniteMultiply - -/* ------------------------------------------------------------------ */ -/* decFloatAbs -- absolute value, heeding NaNs, etc. */ -/* */ -/* result gets the canonicalized df with sign 0 */ -/* df is the decFloat to abs */ -/* set is the context */ -/* returns result */ -/* */ -/* This has the same effect as decFloatPlus unless df is negative, */ -/* in which case it has the same effect as decFloatMinus. The */ -/* effect is also the same as decFloatCopyAbs except that NaNs are */ -/* handled normally (the sign of a NaN is not affected, and an sNaN */ -/* will signal) and the result will be canonical. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatAbs(decFloat *result, const decFloat *df, - decContext *set) { - if (DFISNAN(df)) return decNaNs(result, df, NULL, set); - decCanonical(result, df); // copy and check - DFBYTE(result, 0)&=~0x80; // zero sign bit - return result; - } // decFloatAbs - -/* ------------------------------------------------------------------ */ -/* decFloatAdd -- add two decFloats */ -/* */ -/* result gets the result of adding dfl and dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -#if QUAD -// Table for testing MSDs for fastpath elimination; returns the MSD of -// a decDouble or decQuad (top 6 bits tested) ignoring the sign. -// Infinities return -32 and NaNs return -128 so that summing the two -// MSDs also allows rapid tests for the Specials (see code below). -const Int DECTESTMSD[64]={ - 0, 1, 2, 3, 4, 5, 6, 7, 0, 1, 2, 3, 4, 5, 6, 7, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 8, 9, 8, 9, -32, -128, - 0, 1, 2, 3, 4, 5, 6, 7, 0, 1, 2, 3, 4, 5, 6, 7, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 8, 9, 8, 9, -32, -128}; -#else -// The table for testing MSDs is shared between the modules -extern const Int DECTESTMSD[64]; -#endif - -decFloat * decFloatAdd(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - bcdnum num; // for final conversion - Int bexpl, bexpr; // left and right biased exponents - uByte *ub, *us, *ut; // work - uInt uiwork; // for macros - #if QUAD - uShort uswork; // .. - #endif - - uInt sourhil, sourhir; // top words from source decFloats - // [valid only through end of - // fastpath code -- before swap] - uInt diffsign; // non-zero if signs differ - uInt carry; // carry: 0 or 1 before add loop - Int overlap; // coefficient overlap (if full) - Int summ; // sum of the MSDs - // the following buffers hold coefficients with various alignments - // (see commentary and diagrams below) - uByte acc[4+2+DECPMAX*3+8]; - uByte buf[4+2+DECPMAX*2]; - uByte *umsd, *ulsd; // local MSD and LSD pointers - - #if DECLITEND - #define CARRYPAT 0x01000000 // carry=1 pattern - #else - #define CARRYPAT 0x00000001 // carry=1 pattern - #endif - - /* Start decoding the arguments */ - // The initial exponents are placed into the opposite Ints to - // that which might be expected; there are two sets of data to - // keep track of (each decFloat and the corresponding exponent), - // and this scheme means that at the swap point (after comparing - // exponents) only one pair of words needs to be swapped - // whichever path is taken (thereby minimising worst-case path). - // The calculated exponents will be nonsense when the arguments are - // Special, but are not used in that path - sourhil=DFWORD(dfl, 0); // LHS top word - summ=DECTESTMSD[sourhil>>26]; // get first MSD for testing - bexpr=DECCOMBEXP[sourhil>>26]; // get exponent high bits (in place) - bexpr+=GETECON(dfl); // .. + continuation - - sourhir=DFWORD(dfr, 0); // RHS top word - summ+=DECTESTMSD[sourhir>>26]; // sum MSDs for testing - bexpl=DECCOMBEXP[sourhir>>26]; - bexpl+=GETECON(dfr); - - // here bexpr has biased exponent from lhs, and vice versa - - diffsign=(sourhil^sourhir)&DECFLOAT_Sign; - - // now determine whether to take a fast path or the full-function - // slow path. The slow path must be taken when: - // -- both numbers are finite, and: - // the exponents are different, or - // the signs are different, or - // the sum of the MSDs is >8 (hence might overflow) - // specialness and the sum of the MSDs can be tested at once using - // the summ value just calculated, so the test for specials is no - // longer on the worst-case path (as of 3.60) - - if (summ<=8) { // MSD+MSD is good, or there is a special - if (summ<0) { // there is a special - // Inf+Inf would give -64; Inf+finite is -32 or higher - if (summ<-64) return decNaNs(result, dfl, dfr, set); // one or two NaNs - // two infinities with different signs is invalid - if (summ==-64 && diffsign) return decInvalid(result, set); - if (DFISINF(dfl)) return decInfinity(result, dfl); // LHS is infinite - return decInfinity(result, dfr); // RHS must be Inf - } - // Here when both arguments are finite; fast path is possible - // (currently only for aligned and same-sign) - if (bexpr==bexpl && !diffsign) { - uInt tac[DECLETS+1]; // base-1000 coefficient - uInt encode; // work - - // Get one coefficient as base-1000 and add the other - GETCOEFFTHOU(dfl, tac); // least-significant goes to [0] - ADDCOEFFTHOU(dfr, tac); - // here the sum of the MSDs (plus any carry) will be <10 due to - // the fastpath test earlier - - // construct the result; low word is the same for both formats - encode =BIN2DPD[tac[0]]; - encode|=BIN2DPD[tac[1]]<<10; - encode|=BIN2DPD[tac[2]]<<20; - encode|=BIN2DPD[tac[3]]<<30; - DFWORD(result, (DECBYTES/4)-1)=encode; - - // collect next two declets (all that remains, for Double) - encode =BIN2DPD[tac[3]]>>2; - encode|=BIN2DPD[tac[4]]<<8; - - #if QUAD - // complete and lay out middling words - encode|=BIN2DPD[tac[5]]<<18; - encode|=BIN2DPD[tac[6]]<<28; - DFWORD(result, 2)=encode; - - encode =BIN2DPD[tac[6]]>>4; - encode|=BIN2DPD[tac[7]]<<6; - encode|=BIN2DPD[tac[8]]<<16; - encode|=BIN2DPD[tac[9]]<<26; - DFWORD(result, 1)=encode; - - // and final two declets - encode =BIN2DPD[tac[9]]>>6; - encode|=BIN2DPD[tac[10]]<<4; - #endif - - // add exponent continuation and sign (from either argument) - encode|=sourhil & (ECONMASK | DECFLOAT_Sign); - - // create lookup index = MSD + top two bits of biased exponent <<4 - tac[DECLETS]|=(bexpl>>DECECONL)<<4; - encode|=DECCOMBFROM[tac[DECLETS]]; // add constructed combination field - DFWORD(result, 0)=encode; // complete - - // decFloatShow(result, ">"); - return result; - } // fast path OK - // drop through to slow path - } // low sum or Special(s) - - /* Slow path required -- arguments are finite and might overflow, */ - /* or require alignment, or might have different signs */ - - // now swap either exponents or argument pointers - if (bexpl<=bexpr) { - // original left is bigger - Int bexpswap=bexpl; - bexpl=bexpr; - bexpr=bexpswap; - // printf("left bigger\n"); - } - else { - const decFloat *dfswap=dfl; - dfl=dfr; - dfr=dfswap; - // printf("right bigger\n"); - } - // [here dfl and bexpl refer to the datum with the larger exponent, - // of if the exponents are equal then the original LHS argument] - - // if lhs is zero then result will be the rhs (now known to have - // the smaller exponent), which also may need to be tested for zero - // for the weird IEEE 754 sign rules - if (DFISZERO(dfl)) { - decCanonical(result, dfr); // clean copy - // "When the sum of two operands with opposite signs is - // exactly zero, the sign of that sum shall be '+' in all - // rounding modes except round toward -Infinity, in which - // mode that sign shall be '-'." - if (diffsign && DFISZERO(result)) { - DFWORD(result, 0)&=~DECFLOAT_Sign; // assume sign 0 - if (set->round==DEC_ROUND_FLOOR) DFWORD(result, 0)|=DECFLOAT_Sign; - } - return result; - } // numfl is zero - // [here, LHS is non-zero; code below assumes that] - - // Coefficients layout during the calculations to follow: - // - // Overlap case: - // +------------------------------------------------+ - // acc: |0000| coeffa | tail B | | - // +------------------------------------------------+ - // buf: |0000| pad0s | coeffb | | - // +------------------------------------------------+ - // - // Touching coefficients or gap: - // +------------------------------------------------+ - // acc: |0000| coeffa | gap | coeffb | - // +------------------------------------------------+ - // [buf not used or needed; gap clamped to Pmax] - - // lay out lhs coefficient into accumulator; this starts at acc+4 - // for decDouble or acc+6 for decQuad so the LSD is word- - // aligned; the top word gap is there only in case a carry digit - // is prefixed after the add -- it does not need to be zeroed - #if DOUBLE - #define COFF 4 // offset into acc - #elif QUAD - UBFROMUS(acc+4, 0); // prefix 00 - #define COFF 6 // offset into acc - #endif - - GETCOEFF(dfl, acc+COFF); // decode from decFloat - ulsd=acc+COFF+DECPMAX-1; - umsd=acc+4; // [having this here avoids - - #if DECTRACE - {bcdnum tum; - tum.msd=umsd; - tum.lsd=ulsd; - tum.exponent=bexpl-DECBIAS; - tum.sign=DFWORD(dfl, 0) & DECFLOAT_Sign; - decShowNum(&tum, "dflx");} - #endif - - // if signs differ, take ten's complement of lhs (here the - // coefficient is subtracted from all-nines; the 1 is added during - // the later add cycle -- zeros to the right do not matter because - // the complement of zero is zero); these are fixed-length inverts - // where the lsd is known to be at a 4-byte boundary (so no borrow - // possible) - carry=0; // assume no carry - if (diffsign) { - carry=CARRYPAT; // for +1 during add - UBFROMUI(acc+ 4, 0x09090909-UBTOUI(acc+ 4)); - UBFROMUI(acc+ 8, 0x09090909-UBTOUI(acc+ 8)); - UBFROMUI(acc+12, 0x09090909-UBTOUI(acc+12)); - UBFROMUI(acc+16, 0x09090909-UBTOUI(acc+16)); - #if QUAD - UBFROMUI(acc+20, 0x09090909-UBTOUI(acc+20)); - UBFROMUI(acc+24, 0x09090909-UBTOUI(acc+24)); - UBFROMUI(acc+28, 0x09090909-UBTOUI(acc+28)); - UBFROMUI(acc+32, 0x09090909-UBTOUI(acc+32)); - UBFROMUI(acc+36, 0x09090909-UBTOUI(acc+36)); - #endif - } // diffsign - - // now process the rhs coefficient; if it cannot overlap lhs then - // it can be put straight into acc (with an appropriate gap, if - // needed) because no actual addition will be needed (except - // possibly to complete ten's complement) - overlap=DECPMAX-(bexpl-bexpr); - #if DECTRACE - printf("exps: %ld %ld\n", (LI)(bexpl-DECBIAS), (LI)(bexpr-DECBIAS)); - printf("Overlap=%ld carry=%08lx\n", (LI)overlap, (LI)carry); - #endif - - if (overlap<=0) { // no overlap possible - uInt gap; // local work - // since a full addition is not needed, a ten's complement - // calculation started above may need to be completed - if (carry) { - for (ub=ulsd; *ub==9; ub--) *ub=0; - *ub+=1; - carry=0; // taken care of - } - // up to DECPMAX-1 digits of the final result can extend down - // below the LSD of the lhs, so if the gap is >DECPMAX then the - // rhs will be simply sticky bits. In this case the gap is - // clamped to DECPMAX and the exponent adjusted to suit [this is - // safe because the lhs is non-zero]. - gap=-overlap; - if (gap>DECPMAX) { - bexpr+=gap-1; - gap=DECPMAX; - } - ub=ulsd+gap+1; // where MSD will go - // Fill the gap with 0s; note that there is no addition to do - ut=acc+COFF+DECPMAX; // start of gap - for (; ut DECPMAX - *ub=(uByte)(!DFISZERO(dfr)); // make sticky digit - } - else { // need full coefficient - GETCOEFF(dfr, ub); // decode from decFloat - ub+=DECPMAX-1; // new LSD... - } - ulsd=ub; // save new LSD - } // no overlap possible - - else { // overlap>0 - // coefficients overlap (perhaps completely, although also - // perhaps only where zeros) - if (overlap==DECPMAX) { // aligned - ub=buf+COFF; // where msd will go - #if QUAD - UBFROMUS(buf+4, 0); // clear quad's 00 - #endif - GETCOEFF(dfr, ub); // decode from decFloat - } - else { // unaligned - ub=buf+COFF+DECPMAX-overlap; // where MSD will go - // Fill the prefix gap with 0s; 8 will cover most common - // unalignments, so start with direct assignments (a loop is - // then used for any remaining -- the loop (and the one in a - // moment) is not then on the critical path because the number - // of additions is reduced by (at least) two in this case) - UBFROMUI(buf+4, 0); // [clears decQuad 00 too] - UBFROMUI(buf+8, 0); - if (ub>buf+12) { - ut=buf+12; // start any remaining - for (; ut=acc+4; ut-=4, us-=4) { // big-endian add loop - // bcd8 add - carry+=UBTOUI(us); // rhs + carry - if (carry==0) continue; // no-op - carry+=UBTOUI(ut); // lhs - // Big-endian BCD adjust (uses internal carry) - carry+=0x76f6f6f6; // note top nibble not all bits - // apply BCD adjust and save - UBFROMUI(ut, (carry & 0x0f0f0f0f) - ((carry & 0x60606060)>>4)); - carry>>=31; // true carry was at far left - } // add loop - #else - for (; ut>=acc+4; ut-=4, us-=4) { // little-endian add loop - // bcd8 add - carry+=UBTOUI(us); // rhs + carry - if (carry==0) continue; // no-op [common if unaligned] - carry+=UBTOUI(ut); // lhs - // Little-endian BCD adjust; inter-digit carry must be manual - // because the lsb from the array will be in the most-significant - // byte of carry - carry+=0x76767676; // note no inter-byte carries - carry+=(carry & 0x80000000)>>15; - carry+=(carry & 0x00800000)>>15; - carry+=(carry & 0x00008000)>>15; - carry-=(carry & 0x60606060)>>4; // BCD adjust back - UBFROMUI(ut, carry & 0x0f0f0f0f); // clear debris and save - // here, final carry-out bit is at 0x00000080; move it ready - // for next word-add (i.e., to 0x01000000) - carry=(carry & 0x00000080)<<17; - } // add loop - #endif - - #if DECTRACE - {bcdnum tum; - printf("Add done, carry=%08lx, diffsign=%ld\n", (LI)carry, (LI)diffsign); - tum.msd=umsd; // acc+4; - tum.lsd=ulsd; - tum.exponent=0; - tum.sign=0; - decShowNum(&tum, "dfadd");} - #endif - } // overlap possible - - // ordering here is a little strange in order to have slowest path - // first in GCC asm listing - if (diffsign) { // subtraction - if (!carry) { // no carry out means RHS=umsd+BNEXT) { // unaligned - // eight will handle most unaligments for Double; 16 for Quad - UBFROMUI(umsd+BNEXT, 0x09090909-UBTOUI(umsd+BNEXT)); - UBFROMUI(umsd+BNEXT+4, 0x09090909-UBTOUI(umsd+BNEXT+4)); - #if DOUBLE - #define BNEXTY (BNEXT+8) - #elif QUAD - UBFROMUI(umsd+BNEXT+8, 0x09090909-UBTOUI(umsd+BNEXT+8)); - UBFROMUI(umsd+BNEXT+12, 0x09090909-UBTOUI(umsd+BNEXT+12)); - #define BNEXTY (BNEXT+16) - #endif - if (ulsd>=umsd+BNEXTY) { // very unaligned - ut=umsd+BNEXTY; // -> continue - for (;;ut+=4) { - UBFROMUI(ut, 0x09090909-UBTOUI(ut)); // invert four digits - if (ut>=ulsd-3) break; // all done - } - } - } - // complete the ten's complement by adding 1 - for (ub=ulsd; *ub==9; ub--) *ub=0; - *ub+=1; - } // borrowed - - else { // carry out means RHS>=LHS - num.sign=DFWORD(dfr, 0) & DECFLOAT_Sign; - // all done except for the special IEEE 754 exact-zero-result - // rule (see above); while testing for zero, strip leading - // zeros (which will save decFinalize doing it) (this is in - // diffsign path, so carry impossible and true umsd is - // acc+COFF) - - // Check the initial coefficient area using the fast macro; - // this will often be all that needs to be done (as on the - // worst-case path when the subtraction was aligned and - // full-length) - if (ISCOEFFZERO(acc+COFF)) { - umsd=acc+COFF+DECPMAX-1; // so far, so zero - if (ulsd>umsd) { // more to check - umsd++; // to align after checked area - for (; UBTOUI(umsd)==0 && umsd+3round==DEC_ROUND_FLOOR) num.sign=DECFLOAT_Sign; - } - } - // [else was not zero, might still have leading zeros] - } // subtraction gave positive result - } // diffsign - - else { // same-sign addition - num.sign=DFWORD(dfl, 0)&DECFLOAT_Sign; - #if DOUBLE - if (carry) { // only possible with decDouble - *(acc+3)=1; // [Quad has leading 00] - umsd=acc+3; - } - #endif - } // same sign - - num.msd=umsd; // set MSD .. - num.lsd=ulsd; // .. and LSD - num.exponent=bexpr-DECBIAS; // set exponent to smaller, unbiassed - - #if DECTRACE - decFloatShow(dfl, "dfl"); - decFloatShow(dfr, "dfr"); - decShowNum(&num, "postadd"); - #endif - return decFinalize(result, &num, set); // round, check, and lay out - } // decFloatAdd - -/* ------------------------------------------------------------------ */ -/* decFloatAnd -- logical digitwise AND of two decFloats */ -/* */ -/* result gets the result of ANDing dfl and dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result, which will be canonical with sign=0 */ -/* */ -/* The operands must be positive, finite with exponent q=0, and */ -/* comprise just zeros and ones; if not, Invalid operation results. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatAnd(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - if (!DFISUINT01(dfl) || !DFISUINT01(dfr) - || !DFISCC01(dfl) || !DFISCC01(dfr)) return decInvalid(result, set); - // the operands are positive finite integers (q=0) with just 0s and 1s - #if DOUBLE - DFWORD(result, 0)=ZEROWORD - |((DFWORD(dfl, 0) & DFWORD(dfr, 0))&0x04009124); - DFWORD(result, 1)=(DFWORD(dfl, 1) & DFWORD(dfr, 1))&0x49124491; - #elif QUAD - DFWORD(result, 0)=ZEROWORD - |((DFWORD(dfl, 0) & DFWORD(dfr, 0))&0x04000912); - DFWORD(result, 1)=(DFWORD(dfl, 1) & DFWORD(dfr, 1))&0x44912449; - DFWORD(result, 2)=(DFWORD(dfl, 2) & DFWORD(dfr, 2))&0x12449124; - DFWORD(result, 3)=(DFWORD(dfl, 3) & DFWORD(dfr, 3))&0x49124491; - #endif - return result; - } // decFloatAnd - -/* ------------------------------------------------------------------ */ -/* decFloatCanonical -- copy a decFloat, making canonical */ -/* */ -/* result gets the canonicalized df */ -/* df is the decFloat to copy and make canonical */ -/* returns result */ -/* */ -/* This works on specials, too; no error or exception is possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCanonical(decFloat *result, const decFloat *df) { - return decCanonical(result, df); - } // decFloatCanonical - -/* ------------------------------------------------------------------ */ -/* decFloatClass -- return the class of a decFloat */ -/* */ -/* df is the decFloat to test */ -/* returns the decClass that df falls into */ -/* ------------------------------------------------------------------ */ -enum decClass decFloatClass(const decFloat *df) { - Int exp; // exponent - if (DFISSPECIAL(df)) { - if (DFISQNAN(df)) return DEC_CLASS_QNAN; - if (DFISSNAN(df)) return DEC_CLASS_SNAN; - // must be an infinity - if (DFISSIGNED(df)) return DEC_CLASS_NEG_INF; - return DEC_CLASS_POS_INF; - } - if (DFISZERO(df)) { // quite common - if (DFISSIGNED(df)) return DEC_CLASS_NEG_ZERO; - return DEC_CLASS_POS_ZERO; - } - // is finite and non-zero; similar code to decFloatIsNormal, here - // [this could be speeded up slightly by in-lining decFloatDigits] - exp=GETEXPUN(df) // get unbiased exponent .. - +decFloatDigits(df)-1; // .. and make adjusted exponent - if (exp>=DECEMIN) { // is normal - if (DFISSIGNED(df)) return DEC_CLASS_NEG_NORMAL; - return DEC_CLASS_POS_NORMAL; - } - // is subnormal - if (DFISSIGNED(df)) return DEC_CLASS_NEG_SUBNORMAL; - return DEC_CLASS_POS_SUBNORMAL; - } // decFloatClass - -/* ------------------------------------------------------------------ */ -/* decFloatClassString -- return the class of a decFloat as a string */ -/* */ -/* df is the decFloat to test */ -/* returns a constant string describing the class df falls into */ -/* ------------------------------------------------------------------ */ -const char *decFloatClassString(const decFloat *df) { - enum decClass eclass=decFloatClass(df); - if (eclass==DEC_CLASS_POS_NORMAL) return DEC_ClassString_PN; - if (eclass==DEC_CLASS_NEG_NORMAL) return DEC_ClassString_NN; - if (eclass==DEC_CLASS_POS_ZERO) return DEC_ClassString_PZ; - if (eclass==DEC_CLASS_NEG_ZERO) return DEC_ClassString_NZ; - if (eclass==DEC_CLASS_POS_SUBNORMAL) return DEC_ClassString_PS; - if (eclass==DEC_CLASS_NEG_SUBNORMAL) return DEC_ClassString_NS; - if (eclass==DEC_CLASS_POS_INF) return DEC_ClassString_PI; - if (eclass==DEC_CLASS_NEG_INF) return DEC_ClassString_NI; - if (eclass==DEC_CLASS_QNAN) return DEC_ClassString_QN; - if (eclass==DEC_CLASS_SNAN) return DEC_ClassString_SN; - return DEC_ClassString_UN; // Unknown - } // decFloatClassString - -/* ------------------------------------------------------------------ */ -/* decFloatCompare -- compare two decFloats; quiet NaNs allowed */ -/* */ -/* result gets the result of comparing dfl and dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result, which may be -1, 0, 1, or NaN (Unordered) */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCompare(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int comp; // work - // NaNs are handled as usual - if (DFISNAN(dfl) || DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - // numeric comparison needed - comp=decNumCompare(dfl, dfr, 0); - decFloatZero(result); - if (comp==0) return result; - DFBYTE(result, DECBYTES-1)=0x01; // LSD=1 - if (comp<0) DFBYTE(result, 0)|=0x80; // set sign bit - return result; - } // decFloatCompare - -/* ------------------------------------------------------------------ */ -/* decFloatCompareSignal -- compare two decFloats; all NaNs signal */ -/* */ -/* result gets the result of comparing dfl and dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result, which may be -1, 0, 1, or NaN (Unordered) */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCompareSignal(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int comp; // work - // NaNs are handled as usual, except that all NaNs signal - if (DFISNAN(dfl) || DFISNAN(dfr)) { - set->status|=DEC_Invalid_operation; - return decNaNs(result, dfl, dfr, set); - } - // numeric comparison needed - comp=decNumCompare(dfl, dfr, 0); - decFloatZero(result); - if (comp==0) return result; - DFBYTE(result, DECBYTES-1)=0x01; // LSD=1 - if (comp<0) DFBYTE(result, 0)|=0x80; // set sign bit - return result; - } // decFloatCompareSignal - -/* ------------------------------------------------------------------ */ -/* decFloatCompareTotal -- compare two decFloats with total ordering */ -/* */ -/* result gets the result of comparing dfl and dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* returns result, which may be -1, 0, or 1 */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCompareTotal(decFloat *result, - const decFloat *dfl, const decFloat *dfr) { - Int comp; // work - uInt uiwork; // for macros - #if QUAD - uShort uswork; // .. - #endif - if (DFISNAN(dfl) || DFISNAN(dfr)) { - Int nanl, nanr; // work - // morph NaNs to +/- 1 or 2, leave numbers as 0 - nanl=DFISSNAN(dfl)+DFISQNAN(dfl)*2; // quiet > signalling - if (DFISSIGNED(dfl)) nanl=-nanl; - nanr=DFISSNAN(dfr)+DFISQNAN(dfr)*2; - if (DFISSIGNED(dfr)) nanr=-nanr; - if (nanl>nanr) comp=+1; - else if (nanl*uc) comp=sigl; // difference found - else comp=-sigl; // .. - break; - } - } - } // same NaN type and sign - } - else { - // numeric comparison needed - comp=decNumCompare(dfl, dfr, 1); // total ordering - } - decFloatZero(result); - if (comp==0) return result; - DFBYTE(result, DECBYTES-1)=0x01; // LSD=1 - if (comp<0) DFBYTE(result, 0)|=0x80; // set sign bit - return result; - } // decFloatCompareTotal - -/* ------------------------------------------------------------------ */ -/* decFloatCompareTotalMag -- compare magnitudes with total ordering */ -/* */ -/* result gets the result of comparing abs(dfl) and abs(dfr) */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* returns result, which may be -1, 0, or 1 */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCompareTotalMag(decFloat *result, - const decFloat *dfl, const decFloat *dfr) { - decFloat a, b; // for copy if needed - // copy and redirect signed operand(s) - if (DFISSIGNED(dfl)) { - decFloatCopyAbs(&a, dfl); - dfl=&a; - } - if (DFISSIGNED(dfr)) { - decFloatCopyAbs(&b, dfr); - dfr=&b; - } - return decFloatCompareTotal(result, dfl, dfr); - } // decFloatCompareTotalMag - -/* ------------------------------------------------------------------ */ -/* decFloatCopy -- copy a decFloat as-is */ -/* */ -/* result gets the copy of dfl */ -/* dfl is the decFloat to copy */ -/* returns result */ -/* */ -/* This is a bitwise operation; no errors or exceptions are possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCopy(decFloat *result, const decFloat *dfl) { - if (dfl!=result) *result=*dfl; // copy needed - return result; - } // decFloatCopy - -/* ------------------------------------------------------------------ */ -/* decFloatCopyAbs -- copy a decFloat as-is and set sign bit to 0 */ -/* */ -/* result gets the copy of dfl with sign bit 0 */ -/* dfl is the decFloat to copy */ -/* returns result */ -/* */ -/* This is a bitwise operation; no errors or exceptions are possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCopyAbs(decFloat *result, const decFloat *dfl) { - if (dfl!=result) *result=*dfl; // copy needed - DFBYTE(result, 0)&=~0x80; // zero sign bit - return result; - } // decFloatCopyAbs - -/* ------------------------------------------------------------------ */ -/* decFloatCopyNegate -- copy a decFloat as-is with inverted sign bit */ -/* */ -/* result gets the copy of dfl with sign bit inverted */ -/* dfl is the decFloat to copy */ -/* returns result */ -/* */ -/* This is a bitwise operation; no errors or exceptions are possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCopyNegate(decFloat *result, const decFloat *dfl) { - if (dfl!=result) *result=*dfl; // copy needed - DFBYTE(result, 0)^=0x80; // invert sign bit - return result; - } // decFloatCopyNegate - -/* ------------------------------------------------------------------ */ -/* decFloatCopySign -- copy a decFloat with the sign of another */ -/* */ -/* result gets the result of copying dfl with the sign of dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* returns result */ -/* */ -/* This is a bitwise operation; no errors or exceptions are possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatCopySign(decFloat *result, - const decFloat *dfl, const decFloat *dfr) { - uByte sign=(uByte)(DFBYTE(dfr, 0)&0x80); // save sign bit - if (dfl!=result) *result=*dfl; // copy needed - DFBYTE(result, 0)&=~0x80; // clear sign .. - DFBYTE(result, 0)=(uByte)(DFBYTE(result, 0)|sign); // .. and set saved - return result; - } // decFloatCopySign - -/* ------------------------------------------------------------------ */ -/* decFloatDigits -- return the number of digits in a decFloat */ -/* */ -/* df is the decFloat to investigate */ -/* returns the number of significant digits in the decFloat; a */ -/* zero coefficient returns 1 as does an infinity (a NaN returns */ -/* the number of digits in the payload) */ -/* ------------------------------------------------------------------ */ -// private macro to extract a declet according to provided formula -// (form), and if it is non-zero then return the calculated digits -// depending on the declet number (n), where n=0 for the most -// significant declet; uses uInt dpd for work -#define dpdlenchk(n, form) dpd=(form)&0x3ff; \ - if (dpd) return (DECPMAX-1-3*(n))-(3-DPD2BCD8[dpd*4+3]) -// next one is used when it is known that the declet must be -// non-zero, or is the final zero declet -#define dpdlendun(n, form) dpd=(form)&0x3ff; \ - if (dpd==0) return 1; \ - return (DECPMAX-1-3*(n))-(3-DPD2BCD8[dpd*4+3]) - -uInt decFloatDigits(const decFloat *df) { - uInt dpd; // work - uInt sourhi=DFWORD(df, 0); // top word from source decFloat - #if QUAD - uInt sourmh, sourml; - #endif - uInt sourlo; - - if (DFISINF(df)) return 1; - // A NaN effectively has an MSD of 0; otherwise if non-zero MSD - // then the coefficient is full-length - if (!DFISNAN(df) && DECCOMBMSD[sourhi>>26]) return DECPMAX; - - #if DOUBLE - if (sourhi&0x0003ffff) { // ends in first - dpdlenchk(0, sourhi>>8); - sourlo=DFWORD(df, 1); - dpdlendun(1, (sourhi<<2) | (sourlo>>30)); - } // [cannot drop through] - sourlo=DFWORD(df, 1); // sourhi not involved now - if (sourlo&0xfff00000) { // in one of first two - dpdlenchk(1, sourlo>>30); // very rare - dpdlendun(2, sourlo>>20); - } // [cannot drop through] - dpdlenchk(3, sourlo>>10); - dpdlendun(4, sourlo); - // [cannot drop through] - - #elif QUAD - if (sourhi&0x00003fff) { // ends in first - dpdlenchk(0, sourhi>>4); - sourmh=DFWORD(df, 1); - dpdlendun(1, ((sourhi)<<6) | (sourmh>>26)); - } // [cannot drop through] - sourmh=DFWORD(df, 1); - if (sourmh) { - dpdlenchk(1, sourmh>>26); - dpdlenchk(2, sourmh>>16); - dpdlenchk(3, sourmh>>6); - sourml=DFWORD(df, 2); - dpdlendun(4, ((sourmh)<<4) | (sourml>>28)); - } // [cannot drop through] - sourml=DFWORD(df, 2); - if (sourml) { - dpdlenchk(4, sourml>>28); - dpdlenchk(5, sourml>>18); - dpdlenchk(6, sourml>>8); - sourlo=DFWORD(df, 3); - dpdlendun(7, ((sourml)<<2) | (sourlo>>30)); - } // [cannot drop through] - sourlo=DFWORD(df, 3); - if (sourlo&0xfff00000) { // in one of first two - dpdlenchk(7, sourlo>>30); // very rare - dpdlendun(8, sourlo>>20); - } // [cannot drop through] - dpdlenchk(9, sourlo>>10); - dpdlendun(10, sourlo); - // [cannot drop through] - #endif - } // decFloatDigits - -/* ------------------------------------------------------------------ */ -/* decFloatDivide -- divide a decFloat by another */ -/* */ -/* result gets the result of dividing dfl by dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -// This is just a wrapper. -decFloat * decFloatDivide(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - return decDivide(result, dfl, dfr, set, DIVIDE); - } // decFloatDivide - -/* ------------------------------------------------------------------ */ -/* decFloatDivideInteger -- integer divide a decFloat by another */ -/* */ -/* result gets the result of dividing dfl by dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatDivideInteger(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - return decDivide(result, dfl, dfr, set, DIVIDEINT); - } // decFloatDivideInteger - -/* ------------------------------------------------------------------ */ -/* decFloatFMA -- multiply and add three decFloats, fused */ -/* */ -/* result gets the result of (dfl*dfr)+dff with a single rounding */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* dff is the final decFloat (fhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatFMA(decFloat *result, const decFloat *dfl, - const decFloat *dfr, const decFloat *dff, - decContext *set) { - - // The accumulator has the bytes needed for FiniteMultiply, plus - // one byte to the left in case of carry, plus DECPMAX+2 to the - // right for the final addition (up to full fhs + round & sticky) - #define FMALEN (ROUNDUP4(1+ (DECPMAX9*18+1) +DECPMAX+2)) - uByte acc[FMALEN]; // for multiplied coefficient in BCD - // .. and for final result - bcdnum mul; // for multiplication result - bcdnum fin; // for final operand, expanded - uByte coe[ROUNDUP4(DECPMAX)]; // dff coefficient in BCD - bcdnum *hi, *lo; // bcdnum with higher/lower exponent - uInt diffsign; // non-zero if signs differ - uInt hipad; // pad digit for hi if needed - Int padding; // excess exponent - uInt carry; // +1 for ten's complement and during add - uByte *ub, *uh, *ul; // work - uInt uiwork; // for macros - - // handle all the special values [any special operand leads to a - // special result] - if (DFISSPECIAL(dfl) || DFISSPECIAL(dfr) || DFISSPECIAL(dff)) { - decFloat proxy; // multiplication result proxy - // NaNs are handled as usual, giving priority to sNaNs - if (DFISSNAN(dfl) || DFISSNAN(dfr)) return decNaNs(result, dfl, dfr, set); - if (DFISSNAN(dff)) return decNaNs(result, dff, NULL, set); - if (DFISNAN(dfl) || DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - if (DFISNAN(dff)) return decNaNs(result, dff, NULL, set); - // One or more of the three is infinite - // infinity times zero is bad - decFloatZero(&proxy); - if (DFISINF(dfl)) { - if (DFISZERO(dfr)) return decInvalid(result, set); - decInfinity(&proxy, &proxy); - } - else if (DFISINF(dfr)) { - if (DFISZERO(dfl)) return decInvalid(result, set); - decInfinity(&proxy, &proxy); - } - // compute sign of multiplication and place in proxy - DFWORD(&proxy, 0)|=(DFWORD(dfl, 0)^DFWORD(dfr, 0))&DECFLOAT_Sign; - if (!DFISINF(dff)) return decFloatCopy(result, &proxy); - // dff is Infinite - if (!DFISINF(&proxy)) return decInfinity(result, dff); - // both sides of addition are infinite; different sign is bad - if ((DFWORD(dff, 0)&DECFLOAT_Sign)!=(DFWORD(&proxy, 0)&DECFLOAT_Sign)) - return decInvalid(result, set); - return decFloatCopy(result, &proxy); - } - - /* Here when all operands are finite */ - - // First multiply dfl*dfr - decFiniteMultiply(&mul, acc+1, dfl, dfr); - // The multiply is complete, exact and unbounded, and described in - // mul with the coefficient held in acc[1...] - - // now add in dff; the algorithm is essentially the same as - // decFloatAdd, but the code is different because the code there - // is highly optimized for adding two numbers of the same size - fin.exponent=GETEXPUN(dff); // get dff exponent and sign - fin.sign=DFWORD(dff, 0)&DECFLOAT_Sign; - diffsign=mul.sign^fin.sign; // note if signs differ - fin.msd=coe; - fin.lsd=coe+DECPMAX-1; - GETCOEFF(dff, coe); // extract the coefficient - - // now set hi and lo so that hi points to whichever of mul and fin - // has the higher exponent and lo points to the other [don't care, - // if the same]. One coefficient will be in acc, the other in coe. - if (mul.exponent>=fin.exponent) { - hi=&mul; - lo=&fin; - } - else { - hi=&fin; - lo=&mul; - } - - // remove leading zeros on both operands; this will save time later - // and make testing for zero trivial (tests are safe because acc - // and coe are rounded up to uInts) - for (; UBTOUI(hi->msd)==0 && hi->msd+3lsd;) hi->msd+=4; - for (; *hi->msd==0 && hi->msdlsd;) hi->msd++; - for (; UBTOUI(lo->msd)==0 && lo->msd+3lsd;) lo->msd+=4; - for (; *lo->msd==0 && lo->msdlsd;) lo->msd++; - - // if hi is zero then result will be lo (which has the smaller - // exponent), which also may need to be tested for zero for the - // weird IEEE 754 sign rules - if (*hi->msd==0) { // hi is zero - // "When the sum of two operands with opposite signs is - // exactly zero, the sign of that sum shall be '+' in all - // rounding modes except round toward -Infinity, in which - // mode that sign shall be '-'." - if (diffsign) { - if (*lo->msd==0) { // lo is zero - lo->sign=0; - if (set->round==DEC_ROUND_FLOOR) lo->sign=DECFLOAT_Sign; - } // diffsign && lo=0 - } // diffsign - return decFinalize(result, lo, set); // may need clamping - } // numfl is zero - // [here, both are minimal length and hi is non-zero] - // (if lo is zero then padding with zeros may be needed, below) - - // if signs differ, take the ten's complement of hi (zeros to the - // right do not matter because the complement of zero is zero); the - // +1 is done later, as part of the addition, inserted at the - // correct digit - hipad=0; - carry=0; - if (diffsign) { - hipad=9; - carry=1; - // exactly the correct number of digits must be inverted - for (uh=hi->msd; uhlsd-3; uh+=4) UBFROMUI(uh, 0x09090909-UBTOUI(uh)); - for (; uh<=hi->lsd; uh++) *uh=(uByte)(0x09-*uh); - } - - // ready to add; note that hi has no leading zeros so gap - // calculation does not have to be as pessimistic as in decFloatAdd - // (this is much more like the arbitrary-precision algorithm in - // Rexx and decNumber) - - // padding is the number of zeros that would need to be added to hi - // for its lsd to be aligned with the lsd of lo - padding=hi->exponent-lo->exponent; - // printf("FMA pad %ld\n", (LI)padding); - - // the result of the addition will be built into the accumulator, - // starting from the far right; this could be either hi or lo, and - // will be aligned - ub=acc+FMALEN-1; // where lsd of result will go - ul=lo->lsd; // lsd of rhs - - if (padding!=0) { // unaligned - // if the msd of lo is more than DECPMAX+2 digits to the right of - // the original msd of hi then it can be reduced to a single - // digit at the right place, as it stays clear of hi digits - // [it must be DECPMAX+2 because during a subtraction the msd - // could become 0 after a borrow from 1.000 to 0.9999...] - - Int hilen=(Int)(hi->lsd-hi->msd+1); // length of hi - Int lolen=(Int)(lo->lsd-lo->msd+1); // and of lo - - if (hilen+padding-lolen > DECPMAX+2) { // can reduce lo to single - // make sure it is virtually at least DECPMAX from hi->msd, at - // least to right of hi->lsd (in case of destructive subtract), - // and separated by at least two digits from either of those - // (the tricky DOUBLE case is when hi is a 1 that will become a - // 0.9999... by subtraction: - // hi: 1 E+16 - // lo: .................1000000000000000 E-16 - // which for the addition pads to: - // hi: 1000000000000000000 E-16 - // lo: .................1000000000000000 E-16 - Int newexp=MINI(hi->exponent, hi->exponent+hilen-DECPMAX)-3; - - // printf("FMA reduce: %ld\n", (LI)reduce); - lo->lsd=lo->msd; // to single digit [maybe 0] - lo->exponent=newexp; // new lowest exponent - padding=hi->exponent-lo->exponent; // recalculate - ul=lo->lsd; // .. and repoint - } - - // padding is still > 0, but will fit in acc (less leading carry slot) - #if DECCHECK - if (padding<=0) printf("FMA low padding: %ld\n", (LI)padding); - if (hilen+padding+1>FMALEN) - printf("FMA excess hilen+padding: %ld+%ld \n", (LI)hilen, (LI)padding); - // printf("FMA padding: %ld\n", (LI)padding); - #endif - - // padding digits can now be set in the result; one or more of - // these will come from lo; others will be zeros in the gap - for (; ul-3>=lo->msd && padding>3; padding-=4, ul-=4, ub-=4) { - UBFROMUI(ub-3, UBTOUI(ul-3)); // [cannot overlap] - } - for (; ul>=lo->msd && padding>0; padding--, ul--, ub--) *ub=*ul; - for (;padding>0; padding--, ub--) *ub=0; // mind the gap - } - - // addition now complete to the right of the rightmost digit of hi - uh=hi->lsd; - - // dow do the add from hi->lsd to the left - // [bytewise, because either operand can run out at any time] - // carry was set up depending on ten's complement above - // first assume both operands have some digits - for (;; ub--) { - if (uhmsd || ulmsd) break; - *ub=(uByte)(carry+(*uh--)+(*ul--)); - carry=0; - if (*ub<10) continue; - *ub-=10; - carry=1; - } // both loop - - if (ulmsd) { // to left of lo - for (;; ub--) { - if (uhmsd) break; - *ub=(uByte)(carry+(*uh--)); // [+0] - carry=0; - if (*ub<10) continue; - *ub-=10; - carry=1; - } // hi loop - } - else { // to left of hi - for (;; ub--) { - if (ulmsd) break; - *ub=(uByte)(carry+hipad+(*ul--)); - carry=0; - if (*ub<10) continue; - *ub-=10; - carry=1; - } // lo loop - } - - // addition complete -- now handle carry, borrow, etc. - // use lo to set up the num (its exponent is already correct, and - // sign usually is) - lo->msd=ub+1; - lo->lsd=acc+FMALEN-1; - // decShowNum(lo, "lo"); - if (!diffsign) { // same-sign addition - if (carry) { // carry out - *ub=1; // place the 1 .. - lo->msd--; // .. and update - } - } // same sign - else { // signs differed (subtraction) - if (!carry) { // no carry out means hisign=hi->sign; // sign is lhs sign - for (ul=lo->msd; ullsd-3; ul+=4) UBFROMUI(ul, 0x09090909-UBTOUI(ul)); - for (; ul<=lo->lsd; ul++) *ul=(uByte)(0x09-*ul); // [leaves ul at lsd+1] - // complete the ten's complement by adding 1 [cannot overrun] - for (ul--; *ul==9; ul--) *ul=0; - *ul+=1; - } // borrowed - else { // carry out means hi>=lo - // sign to use is lo->sign - // all done except for the special IEEE 754 exact-zero-result - // rule (see above); while testing for zero, strip leading - // zeros (which will save decFinalize doing it) - for (; UBTOUI(lo->msd)==0 && lo->msd+3lsd;) lo->msd+=4; - for (; *lo->msd==0 && lo->msdlsd;) lo->msd++; - if (*lo->msd==0) { // must be true zero (and diffsign) - lo->sign=0; // assume + - if (set->round==DEC_ROUND_FLOOR) lo->sign=DECFLOAT_Sign; - } - // [else was not zero, might still have leading zeros] - } // subtraction gave positive result - } // diffsign - - #if DECCHECK - // assert no left underrun - if (lo->msdmsd)); - } - #endif - - return decFinalize(result, lo, set); // round, check, and lay out - } // decFloatFMA - -/* ------------------------------------------------------------------ */ -/* decFloatFromInt -- initialise a decFloat from an Int */ -/* */ -/* result gets the converted Int */ -/* n is the Int to convert */ -/* returns result */ -/* */ -/* The result is Exact; no errors or exceptions are possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatFromInt32(decFloat *result, Int n) { - uInt u=(uInt)n; // copy as bits - uInt encode; // work - DFWORD(result, 0)=ZEROWORD; // always - #if QUAD - DFWORD(result, 1)=0; - DFWORD(result, 2)=0; - #endif - if (n<0) { // handle -n with care - // [This can be done without the test, but is then slightly slower] - u=(~u)+1; - DFWORD(result, 0)|=DECFLOAT_Sign; - } - // Since the maximum value of u now is 2**31, only the low word of - // result is affected - encode=BIN2DPD[u%1000]; - u/=1000; - encode|=BIN2DPD[u%1000]<<10; - u/=1000; - encode|=BIN2DPD[u%1000]<<20; - u/=1000; // now 0, 1, or 2 - encode|=u<<30; - DFWORD(result, DECWORDS-1)=encode; - return result; - } // decFloatFromInt32 - -/* ------------------------------------------------------------------ */ -/* decFloatFromUInt -- initialise a decFloat from a uInt */ -/* */ -/* result gets the converted uInt */ -/* n is the uInt to convert */ -/* returns result */ -/* */ -/* The result is Exact; no errors or exceptions are possible. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatFromUInt32(decFloat *result, uInt u) { - uInt encode; // work - DFWORD(result, 0)=ZEROWORD; // always - #if QUAD - DFWORD(result, 1)=0; - DFWORD(result, 2)=0; - #endif - encode=BIN2DPD[u%1000]; - u/=1000; - encode|=BIN2DPD[u%1000]<<10; - u/=1000; - encode|=BIN2DPD[u%1000]<<20; - u/=1000; // now 0 -> 4 - encode|=u<<30; - DFWORD(result, DECWORDS-1)=encode; - DFWORD(result, DECWORDS-2)|=u>>2; // rarely non-zero - return result; - } // decFloatFromUInt32 - -/* ------------------------------------------------------------------ */ -/* decFloatInvert -- logical digitwise INVERT of a decFloat */ -/* */ -/* result gets the result of INVERTing df */ -/* df is the decFloat to invert */ -/* set is the context */ -/* returns result, which will be canonical with sign=0 */ -/* */ -/* The operand must be positive, finite with exponent q=0, and */ -/* comprise just zeros and ones; if not, Invalid operation results. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatInvert(decFloat *result, const decFloat *df, - decContext *set) { - uInt sourhi=DFWORD(df, 0); // top word of dfs - - if (!DFISUINT01(df) || !DFISCC01(df)) return decInvalid(result, set); - // the operand is a finite integer (q=0) - #if DOUBLE - DFWORD(result, 0)=ZEROWORD|((~sourhi)&0x04009124); - DFWORD(result, 1)=(~DFWORD(df, 1)) &0x49124491; - #elif QUAD - DFWORD(result, 0)=ZEROWORD|((~sourhi)&0x04000912); - DFWORD(result, 1)=(~DFWORD(df, 1)) &0x44912449; - DFWORD(result, 2)=(~DFWORD(df, 2)) &0x12449124; - DFWORD(result, 3)=(~DFWORD(df, 3)) &0x49124491; - #endif - return result; - } // decFloatInvert - -/* ------------------------------------------------------------------ */ -/* decFloatIs -- decFloat tests (IsSigned, etc.) */ -/* */ -/* df is the decFloat to test */ -/* returns 0 or 1 in a uInt */ -/* */ -/* Many of these could be macros, but having them as real functions */ -/* is a little cleaner (and they can be referred to here by the */ -/* generic names) */ -/* ------------------------------------------------------------------ */ -uInt decFloatIsCanonical(const decFloat *df) { - if (DFISSPECIAL(df)) { - if (DFISINF(df)) { - if (DFWORD(df, 0)&ECONMASK) return 0; // exponent continuation - if (!DFISCCZERO(df)) return 0; // coefficient continuation - return 1; - } - // is a NaN - if (DFWORD(df, 0)&ECONNANMASK) return 0; // exponent continuation - if (DFISCCZERO(df)) return 1; // coefficient continuation - // drop through to check payload - } - { // declare block - #if DOUBLE - uInt sourhi=DFWORD(df, 0); - uInt sourlo=DFWORD(df, 1); - if (CANONDPDOFF(sourhi, 8) - && CANONDPDTWO(sourhi, sourlo, 30) - && CANONDPDOFF(sourlo, 20) - && CANONDPDOFF(sourlo, 10) - && CANONDPDOFF(sourlo, 0)) return 1; - #elif QUAD - uInt sourhi=DFWORD(df, 0); - uInt sourmh=DFWORD(df, 1); - uInt sourml=DFWORD(df, 2); - uInt sourlo=DFWORD(df, 3); - if (CANONDPDOFF(sourhi, 4) - && CANONDPDTWO(sourhi, sourmh, 26) - && CANONDPDOFF(sourmh, 16) - && CANONDPDOFF(sourmh, 6) - && CANONDPDTWO(sourmh, sourml, 28) - && CANONDPDOFF(sourml, 18) - && CANONDPDOFF(sourml, 8) - && CANONDPDTWO(sourml, sourlo, 30) - && CANONDPDOFF(sourlo, 20) - && CANONDPDOFF(sourlo, 10) - && CANONDPDOFF(sourlo, 0)) return 1; - #endif - } // block - return 0; // a declet is non-canonical - } - -uInt decFloatIsFinite(const decFloat *df) { - return !DFISSPECIAL(df); - } -uInt decFloatIsInfinite(const decFloat *df) { - return DFISINF(df); - } -uInt decFloatIsInteger(const decFloat *df) { - return DFISINT(df); - } -uInt decFloatIsLogical(const decFloat *df) { - return DFISUINT01(df) & DFISCC01(df); - } -uInt decFloatIsNaN(const decFloat *df) { - return DFISNAN(df); - } -uInt decFloatIsNegative(const decFloat *df) { - return DFISSIGNED(df) && !DFISZERO(df) && !DFISNAN(df); - } -uInt decFloatIsNormal(const decFloat *df) { - Int exp; // exponent - if (DFISSPECIAL(df)) return 0; - if (DFISZERO(df)) return 0; - // is finite and non-zero - exp=GETEXPUN(df) // get unbiased exponent .. - +decFloatDigits(df)-1; // .. and make adjusted exponent - return (exp>=DECEMIN); // < DECEMIN is subnormal - } -uInt decFloatIsPositive(const decFloat *df) { - return !DFISSIGNED(df) && !DFISZERO(df) && !DFISNAN(df); - } -uInt decFloatIsSignaling(const decFloat *df) { - return DFISSNAN(df); - } -uInt decFloatIsSignalling(const decFloat *df) { - return DFISSNAN(df); - } -uInt decFloatIsSigned(const decFloat *df) { - return DFISSIGNED(df); - } -uInt decFloatIsSubnormal(const decFloat *df) { - if (DFISSPECIAL(df)) return 0; - // is finite - if (decFloatIsNormal(df)) return 0; - // it is Use |A| */ -/* A=0 -> -Infinity (Division by zero) */ -/* A=Infinite -> +Infinity (Exact) */ -/* A=1 exactly -> 0 (Exact) */ -/* NaNs are propagated as usual */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatLogB(decFloat *result, const decFloat *df, - decContext *set) { - Int ae; // adjusted exponent - if (DFISNAN(df)) return decNaNs(result, df, NULL, set); - if (DFISINF(df)) { - DFWORD(result, 0)=0; // need +ve - return decInfinity(result, result); // canonical +Infinity - } - if (DFISZERO(df)) { - set->status|=DEC_Division_by_zero; // as per 754 - DFWORD(result, 0)=DECFLOAT_Sign; // make negative - return decInfinity(result, result); // canonical -Infinity - } - ae=GETEXPUN(df) // get unbiased exponent .. - +decFloatDigits(df)-1; // .. and make adjusted exponent - // ae has limited range (3 digits for DOUBLE and 4 for QUAD), so - // it is worth using a special case of decFloatFromInt32 - DFWORD(result, 0)=ZEROWORD; // always - if (ae<0) { - DFWORD(result, 0)|=DECFLOAT_Sign; // -0 so far - ae=-ae; - } - #if DOUBLE - DFWORD(result, 1)=BIN2DPD[ae]; // a single declet - #elif QUAD - DFWORD(result, 1)=0; - DFWORD(result, 2)=0; - DFWORD(result, 3)=(ae/1000)<<10; // is <10, so need no DPD encode - DFWORD(result, 3)|=BIN2DPD[ae%1000]; - #endif - return result; - } // decFloatLogB - -/* ------------------------------------------------------------------ */ -/* decFloatMax -- return maxnum of two operands */ -/* */ -/* result gets the chosen decFloat */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* If just one operand is a quiet NaN it is ignored. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatMax(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int comp; - if (DFISNAN(dfl)) { - // sNaN or both NaNs leads to normal NaN processing - if (DFISNAN(dfr) || DFISSNAN(dfl)) return decNaNs(result, dfl, dfr, set); - return decCanonical(result, dfr); // RHS is numeric - } - if (DFISNAN(dfr)) { - // sNaN leads to normal NaN processing (both NaN handled above) - if (DFISSNAN(dfr)) return decNaNs(result, dfl, dfr, set); - return decCanonical(result, dfl); // LHS is numeric - } - // Both operands are numeric; numeric comparison needed -- use - // total order for a well-defined choice (and +0 > -0) - comp=decNumCompare(dfl, dfr, 1); - if (comp>=0) return decCanonical(result, dfl); - return decCanonical(result, dfr); - } // decFloatMax - -/* ------------------------------------------------------------------ */ -/* decFloatMaxMag -- return maxnummag of two operands */ -/* */ -/* result gets the chosen decFloat */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* Returns according to the magnitude comparisons if both numeric and */ -/* unequal, otherwise returns maxnum */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatMaxMag(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int comp; - decFloat absl, absr; - if (DFISNAN(dfl) || DFISNAN(dfr)) return decFloatMax(result, dfl, dfr, set); - - decFloatCopyAbs(&absl, dfl); - decFloatCopyAbs(&absr, dfr); - comp=decNumCompare(&absl, &absr, 0); - if (comp>0) return decCanonical(result, dfl); - if (comp<0) return decCanonical(result, dfr); - return decFloatMax(result, dfl, dfr, set); - } // decFloatMaxMag - -/* ------------------------------------------------------------------ */ -/* decFloatMin -- return minnum of two operands */ -/* */ -/* result gets the chosen decFloat */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* If just one operand is a quiet NaN it is ignored. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatMin(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int comp; - if (DFISNAN(dfl)) { - // sNaN or both NaNs leads to normal NaN processing - if (DFISNAN(dfr) || DFISSNAN(dfl)) return decNaNs(result, dfl, dfr, set); - return decCanonical(result, dfr); // RHS is numeric - } - if (DFISNAN(dfr)) { - // sNaN leads to normal NaN processing (both NaN handled above) - if (DFISSNAN(dfr)) return decNaNs(result, dfl, dfr, set); - return decCanonical(result, dfl); // LHS is numeric - } - // Both operands are numeric; numeric comparison needed -- use - // total order for a well-defined choice (and +0 > -0) - comp=decNumCompare(dfl, dfr, 1); - if (comp<=0) return decCanonical(result, dfl); - return decCanonical(result, dfr); - } // decFloatMin - -/* ------------------------------------------------------------------ */ -/* decFloatMinMag -- return minnummag of two operands */ -/* */ -/* result gets the chosen decFloat */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* Returns according to the magnitude comparisons if both numeric and */ -/* unequal, otherwise returns minnum */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatMinMag(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int comp; - decFloat absl, absr; - if (DFISNAN(dfl) || DFISNAN(dfr)) return decFloatMin(result, dfl, dfr, set); - - decFloatCopyAbs(&absl, dfl); - decFloatCopyAbs(&absr, dfr); - comp=decNumCompare(&absl, &absr, 0); - if (comp<0) return decCanonical(result, dfl); - if (comp>0) return decCanonical(result, dfr); - return decFloatMin(result, dfl, dfr, set); - } // decFloatMinMag - -/* ------------------------------------------------------------------ */ -/* decFloatMinus -- negate value, heeding NaNs, etc. */ -/* */ -/* result gets the canonicalized 0-df */ -/* df is the decFloat to minus */ -/* set is the context */ -/* returns result */ -/* */ -/* This has the same effect as 0-df where the exponent of the zero is */ -/* the same as that of df (if df is finite). */ -/* The effect is also the same as decFloatCopyNegate except that NaNs */ -/* are handled normally (the sign of a NaN is not affected, and an */ -/* sNaN will signal), the result is canonical, and zero gets sign 0. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatMinus(decFloat *result, const decFloat *df, - decContext *set) { - if (DFISNAN(df)) return decNaNs(result, df, NULL, set); - decCanonical(result, df); // copy and check - if (DFISZERO(df)) DFBYTE(result, 0)&=~0x80; // turn off sign bit - else DFBYTE(result, 0)^=0x80; // flip sign bit - return result; - } // decFloatMinus - -/* ------------------------------------------------------------------ */ -/* decFloatMultiply -- multiply two decFloats */ -/* */ -/* result gets the result of multiplying dfl and dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatMultiply(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - bcdnum num; // for final conversion - uByte bcdacc[DECPMAX9*18+1]; // for coefficent in BCD - - if (DFISSPECIAL(dfl) || DFISSPECIAL(dfr)) { // either is special? - // NaNs are handled as usual - if (DFISNAN(dfl) || DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - // infinity times zero is bad - if (DFISINF(dfl) && DFISZERO(dfr)) return decInvalid(result, set); - if (DFISINF(dfr) && DFISZERO(dfl)) return decInvalid(result, set); - // both infinite; return canonical infinity with computed sign - DFWORD(result, 0)=DFWORD(dfl, 0)^DFWORD(dfr, 0); // compute sign - return decInfinity(result, result); - } - - /* Here when both operands are finite */ - decFiniteMultiply(&num, bcdacc, dfl, dfr); - return decFinalize(result, &num, set); // round, check, and lay out - } // decFloatMultiply - -/* ------------------------------------------------------------------ */ -/* decFloatNextMinus -- next towards -Infinity */ -/* */ -/* result gets the next lesser decFloat */ -/* dfl is the decFloat to start with */ -/* set is the context */ -/* returns result */ -/* */ -/* This is 754 nextdown; Invalid is the only status possible (from */ -/* an sNaN). */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatNextMinus(decFloat *result, const decFloat *dfl, - decContext *set) { - decFloat delta; // tiny increment - uInt savestat; // saves status - enum rounding saveround; // .. and mode - - // +Infinity is the special case - if (DFISINF(dfl) && !DFISSIGNED(dfl)) { - DFSETNMAX(result); - return result; // [no status to set] - } - // other cases are effected by sutracting a tiny delta -- this - // should be done in a wider format as the delta is unrepresentable - // here (but can be done with normal add if the sign of zero is - // treated carefully, because no Inexactitude is interesting); - // rounding to -Infinity then pushes the result to next below - decFloatZero(&delta); // set up tiny delta - DFWORD(&delta, DECWORDS-1)=1; // coefficient=1 - DFWORD(&delta, 0)=DECFLOAT_Sign; // Sign=1 + biased exponent=0 - // set up for the directional round - saveround=set->round; // save mode - set->round=DEC_ROUND_FLOOR; // .. round towards -Infinity - savestat=set->status; // save status - decFloatAdd(result, dfl, &delta, set); - // Add rules mess up the sign when going from +Ntiny to 0 - if (DFISZERO(result)) DFWORD(result, 0)^=DECFLOAT_Sign; // correct - set->status&=DEC_Invalid_operation; // preserve only sNaN status - set->status|=savestat; // restore pending flags - set->round=saveround; // .. and mode - return result; - } // decFloatNextMinus - -/* ------------------------------------------------------------------ */ -/* decFloatNextPlus -- next towards +Infinity */ -/* */ -/* result gets the next larger decFloat */ -/* dfl is the decFloat to start with */ -/* set is the context */ -/* returns result */ -/* */ -/* This is 754 nextup; Invalid is the only status possible (from */ -/* an sNaN). */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatNextPlus(decFloat *result, const decFloat *dfl, - decContext *set) { - uInt savestat; // saves status - enum rounding saveround; // .. and mode - decFloat delta; // tiny increment - - // -Infinity is the special case - if (DFISINF(dfl) && DFISSIGNED(dfl)) { - DFSETNMAX(result); - DFWORD(result, 0)|=DECFLOAT_Sign; // make negative - return result; // [no status to set] - } - // other cases are effected by sutracting a tiny delta -- this - // should be done in a wider format as the delta is unrepresentable - // here (but can be done with normal add if the sign of zero is - // treated carefully, because no Inexactitude is interesting); - // rounding to +Infinity then pushes the result to next above - decFloatZero(&delta); // set up tiny delta - DFWORD(&delta, DECWORDS-1)=1; // coefficient=1 - DFWORD(&delta, 0)=0; // Sign=0 + biased exponent=0 - // set up for the directional round - saveround=set->round; // save mode - set->round=DEC_ROUND_CEILING; // .. round towards +Infinity - savestat=set->status; // save status - decFloatAdd(result, dfl, &delta, set); - // Add rules mess up the sign when going from -Ntiny to -0 - if (DFISZERO(result)) DFWORD(result, 0)^=DECFLOAT_Sign; // correct - set->status&=DEC_Invalid_operation; // preserve only sNaN status - set->status|=savestat; // restore pending flags - set->round=saveround; // .. and mode - return result; - } // decFloatNextPlus - -/* ------------------------------------------------------------------ */ -/* decFloatNextToward -- next towards a decFloat */ -/* */ -/* result gets the next decFloat */ -/* dfl is the decFloat to start with */ -/* dfr is the decFloat to move toward */ -/* set is the context */ -/* returns result */ -/* */ -/* This is 754-1985 nextafter, as modified during revision (dropped */ -/* from 754-2008); status may be set unless the result is a normal */ -/* number. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatNextToward(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - decFloat delta; // tiny increment or decrement - decFloat pointone; // 1e-1 - uInt savestat; // saves status - enum rounding saveround; // .. and mode - uInt deltatop; // top word for delta - Int comp; // work - - if (DFISNAN(dfl) || DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - // Both are numeric, so Invalid no longer a possibility - comp=decNumCompare(dfl, dfr, 0); - if (comp==0) return decFloatCopySign(result, dfl, dfr); // equal - // unequal; do NextPlus or NextMinus but with different status rules - - if (comp<0) { // lhsround; // save mode - set->round=DEC_ROUND_CEILING; // .. round towards +Infinity - deltatop=0; // positive delta - } - else { // lhs>rhs, do NextMinus, see above for commentary - if (DFISINF(dfl) && !DFISSIGNED(dfl)) { // +Infinity special case - DFSETNMAX(result); - return result; - } - saveround=set->round; // save mode - set->round=DEC_ROUND_FLOOR; // .. round towards -Infinity - deltatop=DECFLOAT_Sign; // negative delta - } - savestat=set->status; // save status - // Here, Inexact is needed where appropriate (and hence Underflow, - // etc.). Therefore the tiny delta which is otherwise - // unrepresentable (see NextPlus and NextMinus) is constructed - // using the multiplication of FMA. - decFloatZero(&delta); // set up tiny delta - DFWORD(&delta, DECWORDS-1)=1; // coefficient=1 - DFWORD(&delta, 0)=deltatop; // Sign + biased exponent=0 - decFloatFromString(&pointone, "1E-1", set); // set up multiplier - decFloatFMA(result, &delta, &pointone, dfl, set); - // [Delta is truly tiny, so no need to correct sign of zero] - // use new status unless the result is normal - if (decFloatIsNormal(result)) set->status=savestat; // else goes forward - set->round=saveround; // restore mode - return result; - } // decFloatNextToward - -/* ------------------------------------------------------------------ */ -/* decFloatOr -- logical digitwise OR of two decFloats */ -/* */ -/* result gets the result of ORing dfl and dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result, which will be canonical with sign=0 */ -/* */ -/* The operands must be positive, finite with exponent q=0, and */ -/* comprise just zeros and ones; if not, Invalid operation results. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatOr(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - if (!DFISUINT01(dfl) || !DFISUINT01(dfr) - || !DFISCC01(dfl) || !DFISCC01(dfr)) return decInvalid(result, set); - // the operands are positive finite integers (q=0) with just 0s and 1s - #if DOUBLE - DFWORD(result, 0)=ZEROWORD - |((DFWORD(dfl, 0) | DFWORD(dfr, 0))&0x04009124); - DFWORD(result, 1)=(DFWORD(dfl, 1) | DFWORD(dfr, 1))&0x49124491; - #elif QUAD - DFWORD(result, 0)=ZEROWORD - |((DFWORD(dfl, 0) | DFWORD(dfr, 0))&0x04000912); - DFWORD(result, 1)=(DFWORD(dfl, 1) | DFWORD(dfr, 1))&0x44912449; - DFWORD(result, 2)=(DFWORD(dfl, 2) | DFWORD(dfr, 2))&0x12449124; - DFWORD(result, 3)=(DFWORD(dfl, 3) | DFWORD(dfr, 3))&0x49124491; - #endif - return result; - } // decFloatOr - -/* ------------------------------------------------------------------ */ -/* decFloatPlus -- add value to 0, heeding NaNs, etc. */ -/* */ -/* result gets the canonicalized 0+df */ -/* df is the decFloat to plus */ -/* set is the context */ -/* returns result */ -/* */ -/* This has the same effect as 0+df where the exponent of the zero is */ -/* the same as that of df (if df is finite). */ -/* The effect is also the same as decFloatCopy except that NaNs */ -/* are handled normally (the sign of a NaN is not affected, and an */ -/* sNaN will signal), the result is canonical, and zero gets sign 0. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatPlus(decFloat *result, const decFloat *df, - decContext *set) { - if (DFISNAN(df)) return decNaNs(result, df, NULL, set); - decCanonical(result, df); // copy and check - if (DFISZERO(df)) DFBYTE(result, 0)&=~0x80; // turn off sign bit - return result; - } // decFloatPlus - -/* ------------------------------------------------------------------ */ -/* decFloatQuantize -- quantize a decFloat */ -/* */ -/* result gets the result of quantizing dfl to match dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs), which sets the exponent */ -/* set is the context */ -/* returns result */ -/* */ -/* Unless there is an error or the result is infinite, the exponent */ -/* of result is guaranteed to be the same as that of dfr. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatQuantize(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int explb, exprb; // left and right biased exponents - uByte *ulsd; // local LSD pointer - uByte *ub, *uc; // work - Int drop; // .. - uInt dpd; // .. - uInt encode; // encoding accumulator - uInt sourhil, sourhir; // top words from source decFloats - uInt uiwork; // for macros - #if QUAD - uShort uswork; // .. - #endif - // the following buffer holds the coefficient for manipulation - uByte buf[4+DECPMAX*3+2*QUAD]; // + space for zeros to left or right - #if DECTRACE - bcdnum num; // for trace displays - #endif - - /* Start decoding the arguments */ - sourhil=DFWORD(dfl, 0); // LHS top word - explb=DECCOMBEXP[sourhil>>26]; // get exponent high bits (in place) - sourhir=DFWORD(dfr, 0); // RHS top word - exprb=DECCOMBEXP[sourhir>>26]; - - if (EXPISSPECIAL(explb | exprb)) { // either is special? - // NaNs are handled as usual - if (DFISNAN(dfl) || DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - // one infinity but not both is bad - if (DFISINF(dfl)!=DFISINF(dfr)) return decInvalid(result, set); - // both infinite; return canonical infinity with sign of LHS - return decInfinity(result, dfl); - } - - /* Here when both arguments are finite */ - // complete extraction of the exponents [no need to unbias] - explb+=GETECON(dfl); // + continuation - exprb+=GETECON(dfr); // .. - - // calculate the number of digits to drop from the coefficient - drop=exprb-explb; // 0 if nothing to do - if (drop==0) return decCanonical(result, dfl); // return canonical - - // the coefficient is needed; lay it out into buf, offset so zeros - // can be added before or after as needed -- an extra heading is - // added so can safely pad Quad DECPMAX-1 zeros to the left by - // fours - #define BUFOFF (buf+4+DECPMAX) - GETCOEFF(dfl, BUFOFF); // decode from decFloat - // [now the msd is at BUFOFF and the lsd is at BUFOFF+DECPMAX-1] - - #if DECTRACE - num.msd=BUFOFF; - num.lsd=BUFOFF+DECPMAX-1; - num.exponent=explb-DECBIAS; - num.sign=sourhil & DECFLOAT_Sign; - decShowNum(&num, "dfl"); - #endif - - if (drop>0) { // [most common case] - // (this code is very similar to that in decFloatFinalize, but - // has many differences so is duplicated here -- so any changes - // may need to be made there, too) - uByte *roundat; // -> re-round digit - uByte reround; // reround value - // printf("Rounding; drop=%ld\n", (LI)drop); - - // there is at least one zero needed to the left, in all but one - // exceptional (all-nines) case, so place four zeros now; this is - // needed almost always and makes rounding all-nines by fours safe - UBFROMUI(BUFOFF-4, 0); - - // Three cases here: - // 1. new LSD is in coefficient (almost always) - // 2. new LSD is digit to left of coefficient (so MSD is - // round-for-reround digit) - // 3. new LSD is to left of case 2 (whole coefficient is sticky) - // Note that leading zeros can safely be treated as useful digits - - // [duplicate check-stickies code to save a test] - // [by-digit check for stickies as runs of zeros are rare] - if (dropstatus|=DEC_Inexact; - - // next decide whether to increment the coefficient - if (set->round==DEC_ROUND_HALF_EVEN) { // fastpath slowest case - if (reround>5) bump=1; // >0.5 goes up - else if (reround==5) // exactly 0.5000 .. - bump=*ulsd & 0x01; // .. up iff [new] lsd is odd - } // r-h-e - else switch (set->round) { - case DEC_ROUND_DOWN: { - // no change - break;} // r-d - case DEC_ROUND_HALF_DOWN: { - if (reround>5) bump=1; - break;} // r-h-d - case DEC_ROUND_HALF_UP: { - if (reround>=5) bump=1; - break;} // r-h-u - case DEC_ROUND_UP: { - if (reround>0) bump=1; - break;} // r-u - case DEC_ROUND_CEILING: { - // same as _UP for positive numbers, and as _DOWN for negatives - if (!(sourhil&DECFLOAT_Sign) && reround>0) bump=1; - break;} // r-c - case DEC_ROUND_FLOOR: { - // same as _UP for negative numbers, and as _DOWN for positive - // [negative reround cannot occur on 0] - if (sourhil&DECFLOAT_Sign && reround>0) bump=1; - break;} // r-f - case DEC_ROUND_05UP: { - if (reround>0) { // anything out there is 'sticky' - // bump iff lsd=0 or 5; this cannot carry so it could be - // effected immediately with no bump -- but the code - // is clearer if this is done the same way as the others - if (*ulsd==0 || *ulsd==5) bump=1; - } - break;} // r-r - default: { // e.g., DEC_ROUND_MAX - set->status|=DEC_Invalid_context; - #if DECCHECK - printf("Unknown rounding mode: %ld\n", (LI)set->round); - #endif - break;} - } // switch (not r-h-e) - // printf("ReRound: %ld bump: %ld\n", (LI)reround, (LI)bump); - - if (bump!=0) { // need increment - // increment the coefficient; this could give 1000... (after - // the all nines case) - ub=ulsd; - for (; UBTOUI(ub-3)==0x09090909; ub-=4) UBFROMUI(ub-3, 0); - // now at most 3 digits left to non-9 (usually just the one) - for (; *ub==9; ub--) *ub=0; - *ub+=1; - // [the all-nines case will have carried one digit to the - // left of the original MSD -- just where it is needed] - } // bump needed - } // inexact rounding - - // now clear zeros to the left so exactly DECPMAX digits will be - // available in the coefficent -- the first word to the left was - // cleared earlier for safe carry; now add any more needed - if (drop>4) { - UBFROMUI(BUFOFF-8, 0); // must be at least 5 - for (uc=BUFOFF-12; uc>ulsd-DECPMAX-3; uc-=4) UBFROMUI(uc, 0); - } - } // need round (drop>0) - - else { // drop<0; padding with -drop digits is needed - // This is the case where an error can occur if the padded - // coefficient will not fit; checking for this can be done in the - // same loop as padding for zeros if the no-hope and zero cases - // are checked first - if (-drop>DECPMAX-1) { // cannot fit unless 0 - if (!ISCOEFFZERO(BUFOFF)) return decInvalid(result, set); - // a zero can have any exponent; just drop through and use it - ulsd=BUFOFF+DECPMAX-1; - } - else { // padding will fit (but may still be too long) - // final-word mask depends on endianess - #if DECLITEND - static const uInt dmask[]={0, 0x000000ff, 0x0000ffff, 0x00ffffff}; - #else - static const uInt dmask[]={0, 0xff000000, 0xffff0000, 0xffffff00}; - #endif - // note that here zeros to the right are added by fours, so in - // the Quad case this could write 36 zeros if the coefficient has - // fewer than three significant digits (hence the +2*QUAD for buf) - for (uc=BUFOFF+DECPMAX;; uc+=4) { - UBFROMUI(uc, 0); - if (UBTOUI(uc-DECPMAX)!=0) { // could be bad - // if all four digits should be zero, definitely bad - if (uc<=BUFOFF+DECPMAX+(-drop)-4) - return decInvalid(result, set); - // must be a 1- to 3-digit sequence; check more carefully - if ((UBTOUI(uc-DECPMAX)&dmask[(-drop)%4])!=0) - return decInvalid(result, set); - break; // no need for loop end test - } - if (uc>=BUFOFF+DECPMAX+(-drop)-4) break; // done - } - ulsd=BUFOFF+DECPMAX+(-drop)-1; - } // pad and check leading zeros - } // drop<0 - - #if DECTRACE - num.msd=ulsd-DECPMAX+1; - num.lsd=ulsd; - num.exponent=explb-DECBIAS; - num.sign=sourhil & DECFLOAT_Sign; - decShowNum(&num, "res"); - #endif - - /*------------------------------------------------------------------*/ - /* At this point the result is DECPMAX digits, ending at ulsd, so */ - /* fits the encoding exactly; there is no possibility of error */ - /*------------------------------------------------------------------*/ - encode=((exprb>>DECECONL)<<4) + *(ulsd-DECPMAX+1); // make index - encode=DECCOMBFROM[encode]; // indexed by (0-2)*16+msd - // the exponent continuation can be extracted from the original RHS - encode|=sourhir & ECONMASK; - encode|=sourhil&DECFLOAT_Sign; // add the sign from LHS - - // finally encode the coefficient - // private macro to encode a declet; this version can be used - // because all coefficient digits exist - #define getDPD3q(dpd, n) ub=ulsd-(3*(n))-2; \ - dpd=BCD2DPD[(*ub*256)+(*(ub+1)*16)+*(ub+2)]; - - #if DOUBLE - getDPD3q(dpd, 4); encode|=dpd<<8; - getDPD3q(dpd, 3); encode|=dpd>>2; - DFWORD(result, 0)=encode; - encode=dpd<<30; - getDPD3q(dpd, 2); encode|=dpd<<20; - getDPD3q(dpd, 1); encode|=dpd<<10; - getDPD3q(dpd, 0); encode|=dpd; - DFWORD(result, 1)=encode; - - #elif QUAD - getDPD3q(dpd,10); encode|=dpd<<4; - getDPD3q(dpd, 9); encode|=dpd>>6; - DFWORD(result, 0)=encode; - encode=dpd<<26; - getDPD3q(dpd, 8); encode|=dpd<<16; - getDPD3q(dpd, 7); encode|=dpd<<6; - getDPD3q(dpd, 6); encode|=dpd>>4; - DFWORD(result, 1)=encode; - encode=dpd<<28; - getDPD3q(dpd, 5); encode|=dpd<<18; - getDPD3q(dpd, 4); encode|=dpd<<8; - getDPD3q(dpd, 3); encode|=dpd>>2; - DFWORD(result, 2)=encode; - encode=dpd<<30; - getDPD3q(dpd, 2); encode|=dpd<<20; - getDPD3q(dpd, 1); encode|=dpd<<10; - getDPD3q(dpd, 0); encode|=dpd; - DFWORD(result, 3)=encode; - #endif - return result; - } // decFloatQuantize - -/* ------------------------------------------------------------------ */ -/* decFloatReduce -- reduce finite coefficient to minimum length */ -/* */ -/* result gets the reduced decFloat */ -/* df is the source decFloat */ -/* set is the context */ -/* returns result, which will be canonical */ -/* */ -/* This removes all possible trailing zeros from the coefficient; */ -/* some may remain when the number is very close to Nmax. */ -/* Special values are unchanged and no status is set unless df=sNaN. */ -/* Reduced zero has an exponent q=0. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatReduce(decFloat *result, const decFloat *df, - decContext *set) { - bcdnum num; // work - uByte buf[DECPMAX], *ub; // coefficient and pointer - if (df!=result) *result=*df; // copy, if needed - if (DFISNAN(df)) return decNaNs(result, df, NULL, set); // sNaN - // zeros and infinites propagate too - if (DFISINF(df)) return decInfinity(result, df); // canonical - if (DFISZERO(df)) { - uInt sign=DFWORD(df, 0)&DECFLOAT_Sign; - decFloatZero(result); - DFWORD(result, 0)|=sign; - return result; // exponent dropped, sign OK - } - // non-zero finite - GETCOEFF(df, buf); - ub=buf+DECPMAX-1; // -> lsd - if (*ub) return result; // no trailing zeros - for (ub--; *ub==0;) ub--; // terminates because non-zero - // *ub is the first non-zero from the right - num.sign=DFWORD(df, 0)&DECFLOAT_Sign; // set up number... - num.exponent=GETEXPUN(df)+(Int)(buf+DECPMAX-1-ub); // adjusted exponent - num.msd=buf; - num.lsd=ub; - return decFinalize(result, &num, set); - } // decFloatReduce - -/* ------------------------------------------------------------------ */ -/* decFloatRemainder -- integer divide and return remainder */ -/* */ -/* result gets the remainder of dividing dfl by dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatRemainder(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - return decDivide(result, dfl, dfr, set, REMAINDER); - } // decFloatRemainder - -/* ------------------------------------------------------------------ */ -/* decFloatRemainderNear -- integer divide to nearest and remainder */ -/* */ -/* result gets the remainder of dividing dfl by dfr: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* This is the IEEE remainder, where the nearest integer is used. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatRemainderNear(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - return decDivide(result, dfl, dfr, set, REMNEAR); - } // decFloatRemainderNear - -/* ------------------------------------------------------------------ */ -/* decFloatRotate -- rotate the coefficient of a decFloat left/right */ -/* */ -/* result gets the result of rotating dfl */ -/* dfl is the source decFloat to rotate */ -/* dfr is the count of digits to rotate, an integer (with q=0) */ -/* set is the context */ -/* returns result */ -/* */ -/* The digits of the coefficient of dfl are rotated to the left (if */ -/* dfr is positive) or to the right (if dfr is negative) without */ -/* adjusting the exponent or the sign of dfl. */ -/* */ -/* dfr must be in the range -DECPMAX through +DECPMAX. */ -/* NaNs are propagated as usual. An infinite dfl is unaffected (but */ -/* dfr must be valid). No status is set unless dfr is invalid or an */ -/* operand is an sNaN. The result is canonical. */ -/* ------------------------------------------------------------------ */ -#define PHALF (ROUNDUP(DECPMAX/2, 4)) // half length, rounded up -decFloat * decFloatRotate(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int rotate; // dfr as an Int - uByte buf[DECPMAX+PHALF]; // coefficient + half - uInt digits, savestat; // work - bcdnum num; // .. - uByte *ub; // .. - - if (DFISNAN(dfl)||DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - if (!DFISINT(dfr)) return decInvalid(result, set); - digits=decFloatDigits(dfr); // calculate digits - if (digits>2) return decInvalid(result, set); // definitely out of range - rotate=DPD2BIN[DFWORD(dfr, DECWORDS-1)&0x3ff]; // is in bottom declet - if (rotate>DECPMAX) return decInvalid(result, set); // too big - // [from here on no error or status change is possible] - if (DFISINF(dfl)) return decInfinity(result, dfl); // canonical - // handle no-rotate cases - if (rotate==0 || rotate==DECPMAX) return decCanonical(result, dfl); - // a real rotate is needed: 0 < rotate < DECPMAX - // reduce the rotation to no more than half to reduce copying later - // (for QUAD in fact half + 2 digits) - if (DFISSIGNED(dfr)) rotate=-rotate; - if (abs(rotate)>PHALF) { - if (rotate<0) rotate=DECPMAX+rotate; - else rotate=rotate-DECPMAX; - } - // now lay out the coefficient, leaving room to the right or the - // left depending on the direction of rotation - ub=buf; - if (rotate<0) ub+=PHALF; // rotate right, so space to left - GETCOEFF(dfl, ub); - // copy half the digits to left or right, and set num.msd - if (rotate<0) { - memcpy(buf, buf+DECPMAX, PHALF); - num.msd=buf+PHALF+rotate; - } - else { - memcpy(buf+DECPMAX, buf, PHALF); - num.msd=buf+rotate; - } - // fill in rest of num - num.lsd=num.msd+DECPMAX-1; - num.sign=DFWORD(dfl, 0)&DECFLOAT_Sign; - num.exponent=GETEXPUN(dfl); - savestat=set->status; // record - decFinalize(result, &num, set); - set->status=savestat; // restore - return result; - } // decFloatRotate - -/* ------------------------------------------------------------------ */ -/* decFloatSameQuantum -- test decFloats for same quantum */ -/* */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* returns 1 if the operands have the same quantum, 0 otherwise */ -/* */ -/* No error is possible and no status results. */ -/* ------------------------------------------------------------------ */ -uInt decFloatSameQuantum(const decFloat *dfl, const decFloat *dfr) { - if (DFISSPECIAL(dfl) || DFISSPECIAL(dfr)) { - if (DFISNAN(dfl) && DFISNAN(dfr)) return 1; - if (DFISINF(dfl) && DFISINF(dfr)) return 1; - return 0; // any other special mixture gives false - } - if (GETEXP(dfl)==GETEXP(dfr)) return 1; // biased exponents match - return 0; - } // decFloatSameQuantum - -/* ------------------------------------------------------------------ */ -/* decFloatScaleB -- multiply by a power of 10, as per 754 */ -/* */ -/* result gets the result of the operation */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs), am integer (with q=0) */ -/* set is the context */ -/* returns result */ -/* */ -/* This computes result=dfl x 10**dfr where dfr is an integer in the */ -/* range +/-2*(emax+pmax), typically resulting from LogB. */ -/* Underflow and Overflow (with Inexact) may occur. NaNs propagate */ -/* as usual. */ -/* ------------------------------------------------------------------ */ -#define SCALEBMAX 2*(DECEMAX+DECPMAX) // D=800, Q=12356 -decFloat * decFloatScaleB(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - uInt digits; // work - Int expr; // dfr as an Int - - if (DFISNAN(dfl)||DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - if (!DFISINT(dfr)) return decInvalid(result, set); - digits=decFloatDigits(dfr); // calculate digits - - #if DOUBLE - if (digits>3) return decInvalid(result, set); // definitely out of range - expr=DPD2BIN[DFWORD(dfr, 1)&0x3ff]; // must be in bottom declet - #elif QUAD - if (digits>5) return decInvalid(result, set); // definitely out of range - expr=DPD2BIN[DFWORD(dfr, 3)&0x3ff] // in bottom 2 declets .. - +DPD2BIN[(DFWORD(dfr, 3)>>10)&0x3ff]*1000; // .. - #endif - if (expr>SCALEBMAX) return decInvalid(result, set); // oops - // [from now on no error possible] - if (DFISINF(dfl)) return decInfinity(result, dfl); // canonical - if (DFISSIGNED(dfr)) expr=-expr; - // dfl is finite and expr is valid - *result=*dfl; // copy to target - return decFloatSetExponent(result, set, GETEXPUN(result)+expr); - } // decFloatScaleB - -/* ------------------------------------------------------------------ */ -/* decFloatShift -- shift the coefficient of a decFloat left or right */ -/* */ -/* result gets the result of shifting dfl */ -/* dfl is the source decFloat to shift */ -/* dfr is the count of digits to shift, an integer (with q=0) */ -/* set is the context */ -/* returns result */ -/* */ -/* The digits of the coefficient of dfl are shifted to the left (if */ -/* dfr is positive) or to the right (if dfr is negative) without */ -/* adjusting the exponent or the sign of dfl. */ -/* */ -/* dfr must be in the range -DECPMAX through +DECPMAX. */ -/* NaNs are propagated as usual. An infinite dfl is unaffected (but */ -/* dfr must be valid). No status is set unless dfr is invalid or an */ -/* operand is an sNaN. The result is canonical. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatShift(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - Int shift; // dfr as an Int - uByte buf[DECPMAX*2]; // coefficient + padding - uInt digits, savestat; // work - bcdnum num; // .. - uInt uiwork; // for macros - - if (DFISNAN(dfl)||DFISNAN(dfr)) return decNaNs(result, dfl, dfr, set); - if (!DFISINT(dfr)) return decInvalid(result, set); - digits=decFloatDigits(dfr); // calculate digits - if (digits>2) return decInvalid(result, set); // definitely out of range - shift=DPD2BIN[DFWORD(dfr, DECWORDS-1)&0x3ff]; // is in bottom declet - if (shift>DECPMAX) return decInvalid(result, set); // too big - // [from here on no error or status change is possible] - - if (DFISINF(dfl)) return decInfinity(result, dfl); // canonical - // handle no-shift and all-shift (clear to zero) cases - if (shift==0) return decCanonical(result, dfl); - if (shift==DECPMAX) { // zero with sign - uByte sign=(uByte)(DFBYTE(dfl, 0)&0x80); // save sign bit - decFloatZero(result); // make +0 - DFBYTE(result, 0)=(uByte)(DFBYTE(result, 0)|sign); // and set sign - // [cannot safely use CopySign] - return result; - } - // a real shift is needed: 0 < shift < DECPMAX - num.sign=DFWORD(dfl, 0)&DECFLOAT_Sign; - num.exponent=GETEXPUN(dfl); - num.msd=buf; - GETCOEFF(dfl, buf); - if (DFISSIGNED(dfr)) { // shift right - // edge cases are taken care of, so this is easy - num.lsd=buf+DECPMAX-shift-1; - } - else { // shift left -- zero padding needed to right - UBFROMUI(buf+DECPMAX, 0); // 8 will handle most cases - UBFROMUI(buf+DECPMAX+4, 0); // .. - if (shift>8) memset(buf+DECPMAX+8, 0, 8+QUAD*18); // all other cases - num.msd+=shift; - num.lsd=num.msd+DECPMAX-1; - } - savestat=set->status; // record - decFinalize(result, &num, set); - set->status=savestat; // restore - return result; - } // decFloatShift - -/* ------------------------------------------------------------------ */ -/* decFloatSubtract -- subtract a decFloat from another */ -/* */ -/* result gets the result of subtracting dfr from dfl: */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result */ -/* */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatSubtract(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - decFloat temp; - // NaNs must propagate without sign change - if (DFISNAN(dfr)) return decFloatAdd(result, dfl, dfr, set); - temp=*dfr; // make a copy - DFBYTE(&temp, 0)^=0x80; // flip sign - return decFloatAdd(result, dfl, &temp, set); // and add to the lhs - } // decFloatSubtract - -/* ------------------------------------------------------------------ */ -/* decFloatToInt -- round to 32-bit binary integer (4 flavours) */ -/* */ -/* df is the decFloat to round */ -/* set is the context */ -/* round is the rounding mode to use */ -/* returns a uInt or an Int, rounded according to the name */ -/* */ -/* Invalid will always be signaled if df is a NaN, is Infinite, or is */ -/* outside the range of the target; Inexact will not be signaled for */ -/* simple rounding unless 'Exact' appears in the name. */ -/* ------------------------------------------------------------------ */ -uInt decFloatToUInt32(const decFloat *df, decContext *set, - enum rounding round) { - return decToInt32(df, set, round, 0, 1);} - -uInt decFloatToUInt32Exact(const decFloat *df, decContext *set, - enum rounding round) { - return decToInt32(df, set, round, 1, 1);} - -Int decFloatToInt32(const decFloat *df, decContext *set, - enum rounding round) { - return (Int)decToInt32(df, set, round, 0, 0);} - -Int decFloatToInt32Exact(const decFloat *df, decContext *set, - enum rounding round) { - return (Int)decToInt32(df, set, round, 1, 0);} - -/* ------------------------------------------------------------------ */ -/* decFloatToIntegral -- round to integral value (two flavours) */ -/* */ -/* result gets the result */ -/* df is the decFloat to round */ -/* set is the context */ -/* round is the rounding mode to use */ -/* returns result */ -/* */ -/* No exceptions, even Inexact, are raised except for sNaN input, or */ -/* if 'Exact' appears in the name. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatToIntegralValue(decFloat *result, const decFloat *df, - decContext *set, enum rounding round) { - return decToIntegral(result, df, set, round, 0);} - -decFloat * decFloatToIntegralExact(decFloat *result, const decFloat *df, - decContext *set) { - return decToIntegral(result, df, set, set->round, 1);} - -/* ------------------------------------------------------------------ */ -/* decFloatXor -- logical digitwise XOR of two decFloats */ -/* */ -/* result gets the result of XORing dfl and dfr */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) */ -/* set is the context */ -/* returns result, which will be canonical with sign=0 */ -/* */ -/* The operands must be positive, finite with exponent q=0, and */ -/* comprise just zeros and ones; if not, Invalid operation results. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatXor(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - if (!DFISUINT01(dfl) || !DFISUINT01(dfr) - || !DFISCC01(dfl) || !DFISCC01(dfr)) return decInvalid(result, set); - // the operands are positive finite integers (q=0) with just 0s and 1s - #if DOUBLE - DFWORD(result, 0)=ZEROWORD - |((DFWORD(dfl, 0) ^ DFWORD(dfr, 0))&0x04009124); - DFWORD(result, 1)=(DFWORD(dfl, 1) ^ DFWORD(dfr, 1))&0x49124491; - #elif QUAD - DFWORD(result, 0)=ZEROWORD - |((DFWORD(dfl, 0) ^ DFWORD(dfr, 0))&0x04000912); - DFWORD(result, 1)=(DFWORD(dfl, 1) ^ DFWORD(dfr, 1))&0x44912449; - DFWORD(result, 2)=(DFWORD(dfl, 2) ^ DFWORD(dfr, 2))&0x12449124; - DFWORD(result, 3)=(DFWORD(dfl, 3) ^ DFWORD(dfr, 3))&0x49124491; - #endif - return result; - } // decFloatXor - -/* ------------------------------------------------------------------ */ -/* decInvalid -- set Invalid_operation result */ -/* */ -/* result gets a canonical NaN */ -/* set is the context */ -/* returns result */ -/* */ -/* status has Invalid_operation added */ -/* ------------------------------------------------------------------ */ -static decFloat *decInvalid(decFloat *result, decContext *set) { - decFloatZero(result); - DFWORD(result, 0)=DECFLOAT_qNaN; - set->status|=DEC_Invalid_operation; - return result; - } // decInvalid - -/* ------------------------------------------------------------------ */ -/* decInfinity -- set canonical Infinity with sign from a decFloat */ -/* */ -/* result gets a canonical Infinity */ -/* df is source decFloat (only the sign is used) */ -/* returns result */ -/* */ -/* df may be the same as result */ -/* ------------------------------------------------------------------ */ -static decFloat *decInfinity(decFloat *result, const decFloat *df) { - uInt sign=DFWORD(df, 0); // save source signword - decFloatZero(result); // clear everything - DFWORD(result, 0)=DECFLOAT_Inf | (sign & DECFLOAT_Sign); - return result; - } // decInfinity - -/* ------------------------------------------------------------------ */ -/* decNaNs -- handle NaN argument(s) */ -/* */ -/* result gets the result of handling dfl and dfr, one or both of */ -/* which is a NaN */ -/* dfl is the first decFloat (lhs) */ -/* dfr is the second decFloat (rhs) -- may be NULL for a single- */ -/* operand operation */ -/* set is the context */ -/* returns result */ -/* */ -/* Called when one or both operands is a NaN, and propagates the */ -/* appropriate result to res. When an sNaN is found, it is changed */ -/* to a qNaN and Invalid operation is set. */ -/* ------------------------------------------------------------------ */ -static decFloat *decNaNs(decFloat *result, - const decFloat *dfl, const decFloat *dfr, - decContext *set) { - // handle sNaNs first - if (dfr!=NULL && DFISSNAN(dfr) && !DFISSNAN(dfl)) dfl=dfr; // use RHS - if (DFISSNAN(dfl)) { - decCanonical(result, dfl); // propagate canonical sNaN - DFWORD(result, 0)&=~(DECFLOAT_qNaN ^ DECFLOAT_sNaN); // quiet - set->status|=DEC_Invalid_operation; - return result; - } - // one or both is a quiet NaN - if (!DFISNAN(dfl)) dfl=dfr; // RHS must be NaN, use it - return decCanonical(result, dfl); // propagate canonical qNaN - } // decNaNs - -/* ------------------------------------------------------------------ */ -/* decNumCompare -- numeric comparison of two decFloats */ -/* */ -/* dfl is the left-hand decFloat, which is not a NaN */ -/* dfr is the right-hand decFloat, which is not a NaN */ -/* tot is 1 for total order compare, 0 for simple numeric */ -/* returns -1, 0, or +1 for dfldfr */ -/* */ -/* No error is possible; status and mode are unchanged. */ -/* ------------------------------------------------------------------ */ -static Int decNumCompare(const decFloat *dfl, const decFloat *dfr, Flag tot) { - Int sigl, sigr; // LHS and RHS non-0 signums - Int shift; // shift needed to align operands - uByte *ub, *uc; // work - uInt uiwork; // for macros - // buffers +2 if Quad (36 digits), need double plus 4 for safe padding - uByte bufl[DECPMAX*2+QUAD*2+4]; // for LHS coefficient + padding - uByte bufr[DECPMAX*2+QUAD*2+4]; // for RHS coefficient + padding - - sigl=1; - if (DFISSIGNED(dfl)) { - if (!DFISSIGNED(dfr)) { // -LHS +RHS - if (DFISZERO(dfl) && DFISZERO(dfr) && !tot) return 0; - return -1; // RHS wins - } - sigl=-1; - } - if (DFISSIGNED(dfr)) { - if (!DFISSIGNED(dfl)) { // +LHS -RHS - if (DFISZERO(dfl) && DFISZERO(dfr) && !tot) return 0; - return +1; // LHS wins - } - } - - // signs are the same; operand(s) could be zero - sigr=-sigl; // sign to return if abs(RHS) wins - - if (DFISINF(dfl)) { - if (DFISINF(dfr)) return 0; // both infinite & same sign - return sigl; // inf > n - } - if (DFISINF(dfr)) return sigr; // n < inf [dfl is finite] - - // here, both are same sign and finite; calculate their offset - shift=GETEXP(dfl)-GETEXP(dfr); // [0 means aligned] - // [bias can be ignored -- the absolute exponent is not relevant] - - if (DFISZERO(dfl)) { - if (!DFISZERO(dfr)) return sigr; // LHS=0, RHS!=0 - // both are zero, return 0 if both same exponent or numeric compare - if (shift==0 || !tot) return 0; - if (shift>0) return sigl; - return sigr; // [shift<0] - } - else { // LHS!=0 - if (DFISZERO(dfr)) return sigl; // LHS!=0, RHS=0 - } - // both are known to be non-zero at this point - - // if the exponents are so different that the coefficients do not - // overlap (by even one digit) then a full comparison is not needed - if (abs(shift)>=DECPMAX) { // no overlap - // coefficients are known to be non-zero - if (shift>0) return sigl; - return sigr; // [shift<0] - } - - // decode the coefficients - // (shift both right two if Quad to make a multiple of four) - #if QUAD - UBFROMUI(bufl, 0); - UBFROMUI(bufr, 0); - #endif - GETCOEFF(dfl, bufl+QUAD*2); // decode from decFloat - GETCOEFF(dfr, bufr+QUAD*2); // .. - if (shift==0) { // aligned; common and easy - // all multiples of four, here - for (ub=bufl, uc=bufr; ub*uc) return sigl; // difference found - if (*ub<*uc) return sigr; // .. - } - } - } // aligned - else if (shift>0) { // lhs to left - ub=bufl; // RHS pointer - // pad bufl so right-aligned; most shifts will fit in 8 - UBFROMUI(bufl+DECPMAX+QUAD*2, 0); // add eight zeros - UBFROMUI(bufl+DECPMAX+QUAD*2+4, 0); // .. - if (shift>8) { - // more than eight; fill the rest, and also worth doing the - // lead-in by fours - uByte *up; // work - uByte *upend=bufl+DECPMAX+QUAD*2+shift; - for (up=bufl+DECPMAX+QUAD*2+8; upbufl+shift-4) break; - } - } - // check remaining leading digits - for (; ub*uc) return sigl; // difference found - if (*ub<*uc) return sigr; // .. - } - } // mismatch - if (uc==bufr+QUAD*2+DECPMAX-4) break; // all checked - } - } // shift>0 - - else { // shift<0) .. RHS is to left of LHS; mirror shift>0 - uc=bufr; // RHS pointer - // pad bufr so right-aligned; most shifts will fit in 8 - UBFROMUI(bufr+DECPMAX+QUAD*2, 0); // add eight zeros - UBFROMUI(bufr+DECPMAX+QUAD*2+4, 0); // .. - if (shift<-8) { - // more than eight; fill the rest, and also worth doing the - // lead-in by fours - uByte *up; // work - uByte *upend=bufr+DECPMAX+QUAD*2-shift; - for (up=bufr+DECPMAX+QUAD*2+8; upbufr-shift-4) break; - } - } - // check remaining leading digits - for (; uc*uc) return sigl; // difference found - if (*ub<*uc) return sigr; // .. - } - } // mismatch - if (ub==bufl+QUAD*2+DECPMAX-4) break; // all checked - } - } // shift<0 - - // Here when compare equal - if (!tot) return 0; // numerically equal - // total ordering .. exponent matters - if (shift>0) return sigl; // total order by exponent - if (shift<0) return sigr; // .. - return 0; - } // decNumCompare - -/* ------------------------------------------------------------------ */ -/* decToInt32 -- local routine to effect ToInteger conversions */ -/* */ -/* df is the decFloat to convert */ -/* set is the context */ -/* rmode is the rounding mode to use */ -/* exact is 1 if Inexact should be signalled */ -/* unsign is 1 if the result a uInt, 0 if an Int (cast to uInt) */ -/* returns 32-bit result as a uInt */ -/* */ -/* Invalid is set is df is a NaN, is infinite, or is out-of-range; in */ -/* these cases 0 is returned. */ -/* ------------------------------------------------------------------ */ -static uInt decToInt32(const decFloat *df, decContext *set, - enum rounding rmode, Flag exact, Flag unsign) { - Int exp; // exponent - uInt sourhi, sourpen, sourlo; // top word from source decFloat .. - uInt hi, lo; // .. penultimate, least, etc. - decFloat zero, result; // work - Int i; // .. - - /* Start decoding the argument */ - sourhi=DFWORD(df, 0); // top word - exp=DECCOMBEXP[sourhi>>26]; // get exponent high bits (in place) - if (EXPISSPECIAL(exp)) { // is special? - set->status|=DEC_Invalid_operation; // signal - return 0; - } - - /* Here when the argument is finite */ - if (GETEXPUN(df)==0) result=*df; // already a true integer - else { // need to round to integer - enum rounding saveround; // saver - uInt savestatus; // .. - saveround=set->round; // save rounding mode .. - savestatus=set->status; // .. and status - set->round=rmode; // set mode - decFloatZero(&zero); // make 0E+0 - set->status=0; // clear - decFloatQuantize(&result, df, &zero, set); // [this may fail] - set->round=saveround; // restore rounding mode .. - if (exact) set->status|=savestatus; // include Inexact - else set->status=savestatus; // .. or just original status - } - - // only the last four declets of the coefficient can contain - // non-zero; check for others (and also NaN or Infinity from the - // Quantize) first (see DFISZERO for explanation): - // decFloatShow(&result, "sofar"); - #if DOUBLE - if ((DFWORD(&result, 0)&0x1c03ff00)!=0 - || (DFWORD(&result, 0)&0x60000000)==0x60000000) { - #elif QUAD - if ((DFWORD(&result, 2)&0xffffff00)!=0 - || DFWORD(&result, 1)!=0 - || (DFWORD(&result, 0)&0x1c003fff)!=0 - || (DFWORD(&result, 0)&0x60000000)==0x60000000) { - #endif - set->status|=DEC_Invalid_operation; // Invalid or out of range - return 0; - } - // get last twelve digits of the coefficent into hi & ho, base - // 10**9 (see GETCOEFFBILL): - sourlo=DFWORD(&result, DECWORDS-1); - lo=DPD2BIN0[sourlo&0x3ff] - +DPD2BINK[(sourlo>>10)&0x3ff] - +DPD2BINM[(sourlo>>20)&0x3ff]; - sourpen=DFWORD(&result, DECWORDS-2); - hi=DPD2BIN0[((sourpen<<2) | (sourlo>>30))&0x3ff]; - - // according to request, check range carefully - if (unsign) { - if (hi>4 || (hi==4 && lo>294967295) || (hi+lo!=0 && DFISSIGNED(&result))) { - set->status|=DEC_Invalid_operation; // out of range - return 0; - } - return hi*BILLION+lo; - } - // signed - if (hi>2 || (hi==2 && lo>147483647)) { - // handle the usual edge case - if (lo==147483648 && hi==2 && DFISSIGNED(&result)) return 0x80000000; - set->status|=DEC_Invalid_operation; // truly out of range - return 0; - } - i=hi*BILLION+lo; - if (DFISSIGNED(&result)) i=-i; - return (uInt)i; - } // decToInt32 - -/* ------------------------------------------------------------------ */ -/* decToIntegral -- local routine to effect ToIntegral value */ -/* */ -/* result gets the result */ -/* df is the decFloat to round */ -/* set is the context */ -/* rmode is the rounding mode to use */ -/* exact is 1 if Inexact should be signalled */ -/* returns result */ -/* ------------------------------------------------------------------ */ -static decFloat * decToIntegral(decFloat *result, const decFloat *df, - decContext *set, enum rounding rmode, - Flag exact) { - Int exp; // exponent - uInt sourhi; // top word from source decFloat - enum rounding saveround; // saver - uInt savestatus; // .. - decFloat zero; // work - - /* Start decoding the argument */ - sourhi=DFWORD(df, 0); // top word - exp=DECCOMBEXP[sourhi>>26]; // get exponent high bits (in place) - - if (EXPISSPECIAL(exp)) { // is special? - // NaNs are handled as usual - if (DFISNAN(df)) return decNaNs(result, df, NULL, set); - // must be infinite; return canonical infinity with sign of df - return decInfinity(result, df); - } - - /* Here when the argument is finite */ - // complete extraction of the exponent - exp+=GETECON(df)-DECBIAS; // .. + continuation and unbias - - if (exp>=0) return decCanonical(result, df); // already integral - - saveround=set->round; // save rounding mode .. - savestatus=set->status; // .. and status - set->round=rmode; // set mode - decFloatZero(&zero); // make 0E+0 - decFloatQuantize(result, df, &zero, set); // 'integrate'; cannot fail - set->round=saveround; // restore rounding mode .. - if (!exact) set->status=savestatus; // .. and status, unless exact - return result; - } // decToIntegral diff --git a/decnumber/src/decCommon.c b/decnumber/src/decCommon.c deleted file mode 100644 --- a/decnumber/src/decCommon.c +++ /dev/null @@ -1,1835 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* decCommon.c -- common code for all three fixed-size types */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is included in the package as decNumber.pdf. This */ -/* document is also available in HTML, together with specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* This module comprises code that is shared between all the formats */ -/* (decSingle, decDouble, and decQuad); it includes set and extract */ -/* of format components, widening, narrowing, and string conversions. */ -/* */ -/* Unlike decNumber, parameterization takes place at compile time */ -/* rather than at runtime. The parameters are set in the decDouble.c */ -/* (etc.) files, which then include this one to produce the compiled */ -/* code. The functions here, therefore, are code shared between */ -/* multiple formats. */ -/* ------------------------------------------------------------------ */ -// Names here refer to decFloat rather than to decDouble, etc., and -// the functions are in strict alphabetical order. -// Constants, tables, and debug function(s) are included only for QUAD -// (which will always be compiled if DOUBLE or SINGLE are used). -// -// Whenever a decContext is used, only the status may be set (using -// OR) or the rounding mode read; all other fields are ignored and -// untouched. - -// names for simpler testing and default context -#if DECPMAX==7 - #define SINGLE 1 - #define DOUBLE 0 - #define QUAD 0 - #define DEFCONTEXT DEC_INIT_DECIMAL32 -#elif DECPMAX==16 - #define SINGLE 0 - #define DOUBLE 1 - #define QUAD 0 - #define DEFCONTEXT DEC_INIT_DECIMAL64 -#elif DECPMAX==34 - #define SINGLE 0 - #define DOUBLE 0 - #define QUAD 1 - #define DEFCONTEXT DEC_INIT_DECIMAL128 -#else - #error Unexpected DECPMAX value -#endif - -/* Assertions */ - -#if DECPMAX!=7 && DECPMAX!=16 && DECPMAX!=34 - #error Unexpected Pmax (DECPMAX) value for this module -#endif - -// Assert facts about digit characters, etc. -#if ('9'&0x0f)!=9 - #error This module assumes characters are of the form 0b....nnnn - // where .... are don't care 4 bits and nnnn is 0000 through 1001 -#endif -#if ('9'&0xf0)==('.'&0xf0) - #error This module assumes '.' has a different mask than a digit -#endif - -// Assert ToString lay-out conditions -#if DECSTRING DECSTRING - #error Exponent form can be too long for ToString to lay out safely -#endif -#if DECEMAXD > 4 - #error Exponent form is too long for ToString to lay out - // Note: code for up to 9 digits exists in archives [decOct] -#endif - -/* Private functions used here and possibly in decBasic.c, etc. */ -static decFloat * decFinalize(decFloat *, bcdnum *, decContext *); -static Flag decBiStr(const char *, const char *, const char *); - -/* Macros and private tables; those which are not format-dependent */ -/* are only included if decQuad is being built. */ - -/* ------------------------------------------------------------------ */ -/* Combination field lookup tables (uInts to save measurable work) */ -/* */ -/* DECCOMBEXP - 2 most-significant-bits of exponent (00, 01, or */ -/* 10), shifted left for format, or DECFLOAT_Inf/NaN */ -/* DECCOMBWEXP - The same, for the next-wider format (unless QUAD) */ -/* DECCOMBMSD - 4-bit most-significant-digit */ -/* [0 if the index is a special (Infinity or NaN)] */ -/* DECCOMBFROM - 5-bit combination field from EXP top bits and MSD */ -/* (placed in uInt so no shift is needed) */ -/* */ -/* DECCOMBEXP, DECCOMBWEXP, and DECCOMBMSD are indexed by the sign */ -/* and 5-bit combination field (0-63, the second half of the table */ -/* identical to the first half) */ -/* DECCOMBFROM is indexed by expTopTwoBits*16 + msd */ -/* */ -/* DECCOMBMSD and DECCOMBFROM are not format-dependent and so are */ -/* only included once, when QUAD is being built */ -/* ------------------------------------------------------------------ */ -static const uInt DECCOMBEXP[64]={ - 0, 0, 0, 0, 0, 0, 0, 0, - 1< DPD -#define DEC_BIN2DPD 1 // 0-999 -> DPD -#define DEC_BIN2BCD8 1 // 0-999 -> ddd, len -#define DEC_DPD2BCD8 1 // DPD -> ddd, len -#define DEC_DPD2BIN 1 // DPD -> 0-999 -#define DEC_DPD2BINK 1 // DPD -> 0-999000 -#define DEC_DPD2BINM 1 // DPD -> 0-999000000 -#include "decDPD.h" // source of the lookup tables - -#endif - -/* ----------------------------------------------------------------- */ -/* decBiStr -- compare string with pairwise options */ -/* */ -/* targ is the string to compare */ -/* str1 is one of the strings to compare against (length may be 0) */ -/* str2 is the other; it must be the same length as str1 */ -/* */ -/* returns 1 if strings compare equal, (that is, targ is the same */ -/* length as str1 and str2, and each character of targ is in one */ -/* of str1 or str2 in the corresponding position), or 0 otherwise */ -/* */ -/* This is used for generic caseless compare, including the awkward */ -/* case of the Turkish dotted and dotless Is. Use as (for example): */ -/* if (decBiStr(test, "mike", "MIKE")) ... */ -/* ----------------------------------------------------------------- */ -static Flag decBiStr(const char *targ, const char *str1, const char *str2) { - for (;;targ++, str1++, str2++) { - if (*targ!=*str1 && *targ!=*str2) return 0; - // *targ has a match in one (or both, if terminator) - if (*targ=='\0') break; - } // forever - return 1; - } // decBiStr - -/* ------------------------------------------------------------------ */ -/* decFinalize -- adjust and store a final result */ -/* */ -/* df is the decFloat format number which gets the final result */ -/* num is the descriptor of the number to be checked and encoded */ -/* [its values, including the coefficient, may be modified] */ -/* set is the context to use */ -/* returns df */ -/* */ -/* The num descriptor may point to a bcd8 string of any length; this */ -/* string may have leading insignificant zeros. If it has more than */ -/* DECPMAX digits then the final digit can be a round-for-reround */ -/* digit (i.e., it may include a sticky bit residue). */ -/* */ -/* The exponent (q) may be one of the codes for a special value and */ -/* can be up to 999999999 for conversion from string. */ -/* */ -/* No error is possible, but Inexact, Underflow, and/or Overflow may */ -/* be set. */ -/* ------------------------------------------------------------------ */ -// Constant whose size varies with format; also the check for surprises -static uByte allnines[DECPMAX]= -#if SINGLE - {9, 9, 9, 9, 9, 9, 9}; -#elif DOUBLE - {9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9}; -#elif QUAD - {9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9}; -#endif - -static decFloat * decFinalize(decFloat *df, bcdnum *num, - decContext *set) { - uByte *ub; // work - uInt dpd; // .. - uInt uiwork; // for macros - uByte *umsd=num->msd; // local copy - uByte *ulsd=num->lsd; // .. - uInt encode; // encoding accumulator - Int length; // coefficient length - - #if DECCHECK - Int clen=ulsd-umsd+1; - #if QUAD - #define COEXTRA 2 // extra-long coefficent - #else - #define COEXTRA 0 - #endif - if (clen<1 || clen>DECPMAX*3+2+COEXTRA) - printf("decFinalize: suspect coefficient [length=%ld]\n", (LI)clen); - if (num->sign!=0 && num->sign!=DECFLOAT_Sign) - printf("decFinalize: bad sign [%08lx]\n", (LI)num->sign); - if (!EXPISSPECIAL(num->exponent) - && (num->exponent>1999999999 || num->exponent<-1999999999)) - printf("decFinalize: improbable exponent [%ld]\n", (LI)num->exponent); - // decShowNum(num, "final"); - #endif - - // A special will have an 'exponent' which is very positive and a - // coefficient < DECPMAX - length=(uInt)(ulsd-umsd+1); // coefficient length - - if (!NUMISSPECIAL(num)) { - Int drop; // digits to be dropped - // skip leading insignificant zeros to calculate an exact length - // [this is quite expensive] - if (*umsd==0) { - for (; umsd+3exponent); - // drop can now be > digits for bottom-clamp (subnormal) cases - if (drop>0) { // rounding needed - // (decFloatQuantize has very similar code to this, so any - // changes may need to be made there, too) - uByte *roundat; // -> re-round digit - uByte reround; // reround value - // printf("Rounding; drop=%ld\n", (LI)drop); - - num->exponent+=drop; // always update exponent - - // Three cases here: - // 1. new LSD is in coefficient (almost always) - // 2. new LSD is digit to left of coefficient (so MSD is - // round-for-reround digit) - // 3. new LSD is to left of case 2 (whole coefficient is sticky) - // [duplicate check-stickies code to save a test] - // [by-digit check for stickies as runs of zeros are rare] - if (dropstatus|=DEC_Inexact; - // if adjusted exponent [exp+digits-1] is < EMIN then num is - // subnormal -- so raise Underflow - if (num->exponentexponent+(ulsd-umsd+1)-1)status|=DEC_Underflow; - - // next decide whether increment of the coefficient is needed - if (set->round==DEC_ROUND_HALF_EVEN) { // fastpath slowest case - if (reround>5) bump=1; // >0.5 goes up - else if (reround==5) // exactly 0.5000 .. - bump=*ulsd & 0x01; // .. up iff [new] lsd is odd - } // r-h-e - else switch (set->round) { - case DEC_ROUND_DOWN: { - // no change - break;} // r-d - case DEC_ROUND_HALF_DOWN: { - if (reround>5) bump=1; - break;} // r-h-d - case DEC_ROUND_HALF_UP: { - if (reround>=5) bump=1; - break;} // r-h-u - case DEC_ROUND_UP: { - if (reround>0) bump=1; - break;} // r-u - case DEC_ROUND_CEILING: { - // same as _UP for positive numbers, and as _DOWN for negatives - if (!num->sign && reround>0) bump=1; - break;} // r-c - case DEC_ROUND_FLOOR: { - // same as _UP for negative numbers, and as _DOWN for positive - // [negative reround cannot occur on 0] - if (num->sign && reround>0) bump=1; - break;} // r-f - case DEC_ROUND_05UP: { - if (reround>0) { // anything out there is 'sticky' - // bump iff lsd=0 or 5; this cannot carry so it could be - // effected immediately with no bump -- but the code - // is clearer if this is done the same way as the others - if (*ulsd==0 || *ulsd==5) bump=1; - } - break;} // r-r - default: { // e.g., DEC_ROUND_MAX - set->status|=DEC_Invalid_context; - #if DECCHECK - printf("Unknown rounding mode: %ld\n", (LI)set->round); - #endif - break;} - } // switch (not r-h-e) - // printf("ReRound: %ld bump: %ld\n", (LI)reround, (LI)bump); - - if (bump!=0) { // need increment - // increment the coefficient; this might end up with 1000... - // (after the all nines case) - ub=ulsd; - for(; ub-3>=umsd && UBTOUI(ub-3)==0x09090909; ub-=4) { - UBFROMUI(ub-3, 0); // to 00000000 - } - // [note ub could now be to left of msd, and it is not safe - // to write to the the left of the msd] - // now at most 3 digits left to non-9 (usually just the one) - for (; ub>=umsd; *ub=0, ub--) { - if (*ub==9) continue; // carry - *ub+=1; - break; - } - if (ubexponent++; - } - else { - // if coefficient is shorter than Pmax then num is - // subnormal, so extend it; this is safe as drop>0 - // (or, if the coefficient was supplied above, it could - // not be 9); this may make the result normal. - ulsd++; - *ulsd=0; - // [exponent unchanged] - #if DECCHECK - if (num->exponent!=DECQTINY) // sanity check - printf("decFinalize: bad all-nines extend [^%ld, %ld]\n", - (LI)num->exponent, (LI)(ulsd-umsd+1)); - #endif - } // subnormal extend - } // had all-nines - } // bump needed - } // inexact rounding - - length=ulsd-umsd+1; // recalculate (may be 0) - - // The coefficient will now fit and has final length unless overflow - // decShowNum(num, "rounded"); - - // if exponent is >=emax may have to clamp, overflow, or fold-down - if (num->exponent>DECEMAX-(DECPMAX-1)) { // is edge case - // printf("overflow checks...\n"); - if (*ulsd==0 && ulsd==umsd) { // have zero - num->exponent=DECEMAX-(DECPMAX-1); // clamp to max - } - else if ((num->exponent+length-1)>DECEMAX) { // > Nmax - // Overflow -- these could go straight to encoding, here, but - // instead num is adjusted to keep the code cleaner - Flag needmax=0; // 1 for finite result - set->status|=(DEC_Overflow | DEC_Inexact); - switch (set->round) { - case DEC_ROUND_DOWN: { - needmax=1; // never Infinity - break;} // r-d - case DEC_ROUND_05UP: { - needmax=1; // never Infinity - break;} // r-05 - case DEC_ROUND_CEILING: { - if (num->sign) needmax=1; // Infinity iff non-negative - break;} // r-c - case DEC_ROUND_FLOOR: { - if (!num->sign) needmax=1; // Infinity iff negative - break;} // r-f - default: break; // Infinity in all other cases - } - if (!needmax) { // easy .. set Infinity - num->exponent=DECFLOAT_Inf; - *umsd=0; // be clean: coefficient to 0 - ulsd=umsd; // .. - } - else { // return Nmax - umsd=allnines; // use constant array - ulsd=allnines+DECPMAX-1; - num->exponent=DECEMAX-(DECPMAX-1); - } - } - else { // no overflow but non-zero and may have to fold-down - Int shift=num->exponent-(DECEMAX-(DECPMAX-1)); - if (shift>0) { // fold-down needed - // fold down needed; must copy to buffer in order to pad - // with zeros safely; fortunately this is not the worst case - // path because cannot have had a round - uByte buffer[ROUNDUP(DECPMAX+3, 4)]; // [+3 allows uInt padding] - uByte *s=umsd; // source - uByte *t=buffer; // safe target - uByte *tlsd=buffer+(ulsd-umsd)+shift; // target LSD - // printf("folddown shift=%ld\n", (LI)shift); - for (; s<=ulsd; s+=4, t+=4) UBFROMUI(t, UBTOUI(s)); - for (t=tlsd-shift+1; t<=tlsd; t+=4) UBFROMUI(t, 0); // pad 0s - num->exponent-=shift; - umsd=buffer; - ulsd=tlsd; - } - } // fold-down? - length=ulsd-umsd+1; // recalculate length - } // high-end edge case - } // finite number - - /*------------------------------------------------------------------*/ - /* At this point the result will properly fit the decFloat */ - /* encoding, and it can be encoded with no possibility of error */ - /*------------------------------------------------------------------*/ - // Following code does not alter coefficient (could be allnines array) - - // fast path possible when DECPMAX digits - if (length==DECPMAX) { - return decFloatFromBCD(df, num->exponent, umsd, num->sign); - } // full-length - - // slower path when not a full-length number; must care about length - // [coefficient length here will be < DECPMAX] - if (!NUMISSPECIAL(num)) { // is still finite - // encode the combination field and exponent continuation - uInt uexp=(uInt)(num->exponent+DECBIAS); // biased exponent - uInt code=(uexp>>DECECONL)<<4; // top two bits of exp - // [msd==0] - // look up the combination field and make high word - encode=DECCOMBFROM[code]; // indexed by (0-2)*16+msd - encode|=(uexp<<(32-6-DECECONL)) & 0x03ffffff; // exponent continuation - } - else encode=num->exponent; // special [already in word] - encode|=num->sign; // add sign - - // private macro to extract a declet, n (where 0<=n=umsd) dpd=BCD2DPD[(*ub*256)+(*(ub+1)*16)+*(ub+2)]; \ - else {dpd=*(ub+2); if (ub+1==umsd) dpd+=*(ub+1)*16; dpd=BCD2DPD[dpd];} - - // place the declets in the encoding words and copy to result (df), - // according to endianness; in all cases complete the sign word - // first - #if DECPMAX==7 - getDPDt(dpd, 1); - encode|=dpd<<10; - getDPDt(dpd, 0); - encode|=dpd; - DFWORD(df, 0)=encode; // just the one word - - #elif DECPMAX==16 - getDPDt(dpd, 4); encode|=dpd<<8; - getDPDt(dpd, 3); encode|=dpd>>2; - DFWORD(df, 0)=encode; - encode=dpd<<30; - getDPDt(dpd, 2); encode|=dpd<<20; - getDPDt(dpd, 1); encode|=dpd<<10; - getDPDt(dpd, 0); encode|=dpd; - DFWORD(df, 1)=encode; - - #elif DECPMAX==34 - getDPDt(dpd,10); encode|=dpd<<4; - getDPDt(dpd, 9); encode|=dpd>>6; - DFWORD(df, 0)=encode; - - encode=dpd<<26; - getDPDt(dpd, 8); encode|=dpd<<16; - getDPDt(dpd, 7); encode|=dpd<<6; - getDPDt(dpd, 6); encode|=dpd>>4; - DFWORD(df, 1)=encode; - - encode=dpd<<28; - getDPDt(dpd, 5); encode|=dpd<<18; - getDPDt(dpd, 4); encode|=dpd<<8; - getDPDt(dpd, 3); encode|=dpd>>2; - DFWORD(df, 2)=encode; - - encode=dpd<<30; - getDPDt(dpd, 2); encode|=dpd<<20; - getDPDt(dpd, 1); encode|=dpd<<10; - getDPDt(dpd, 0); encode|=dpd; - DFWORD(df, 3)=encode; - #endif - - // printf("Status: %08lx\n", (LI)set->status); - // decFloatShow(df, "final2"); - return df; - } // decFinalize - -/* ------------------------------------------------------------------ */ -/* decFloatFromBCD -- set decFloat from exponent, BCD8, and sign */ -/* */ -/* df is the target decFloat */ -/* exp is the in-range unbiased exponent, q, or a special value in */ -/* the form returned by decFloatGetExponent */ -/* bcdar holds DECPMAX digits to set the coefficient from, one */ -/* digit in each byte (BCD8 encoding); the first (MSD) is ignored */ -/* if df is a NaN; all are ignored if df is infinite. */ -/* All bytes must be in 0-9; results are undefined otherwise. */ -/* sig is DECFLOAT_Sign to set the sign bit, 0 otherwise */ -/* returns df, which will be canonical */ -/* */ -/* No error is possible, and no status will be set. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatFromBCD(decFloat *df, Int exp, const uByte *bcdar, - Int sig) { - uInt encode, dpd; // work - const uByte *ub; // .. - - if (EXPISSPECIAL(exp)) encode=exp|sig;// specials already encoded - else { // is finite - // encode the combination field and exponent continuation - uInt uexp=(uInt)(exp+DECBIAS); // biased exponent - uInt code=(uexp>>DECECONL)<<4; // top two bits of exp - code+=bcdar[0]; // add msd - // look up the combination field and make high word - encode=DECCOMBFROM[code]|sig; // indexed by (0-2)*16+msd - encode|=(uexp<<(32-6-DECECONL)) & 0x03ffffff; // exponent continuation - } - - // private macro to extract a declet, n (where 0<=n>2; - DFWORD(df, 0)=encode; - encode=dpd<<30; - getDPDb(dpd, 2); encode|=dpd<<20; - getDPDb(dpd, 1); encode|=dpd<<10; - getDPDb(dpd, 0); encode|=dpd; - DFWORD(df, 1)=encode; - - #elif DECPMAX==34 - getDPDb(dpd,10); encode|=dpd<<4; - getDPDb(dpd, 9); encode|=dpd>>6; - DFWORD(df, 0)=encode; - - encode=dpd<<26; - getDPDb(dpd, 8); encode|=dpd<<16; - getDPDb(dpd, 7); encode|=dpd<<6; - getDPDb(dpd, 6); encode|=dpd>>4; - DFWORD(df, 1)=encode; - - encode=dpd<<28; - getDPDb(dpd, 5); encode|=dpd<<18; - getDPDb(dpd, 4); encode|=dpd<<8; - getDPDb(dpd, 3); encode|=dpd>>2; - DFWORD(df, 2)=encode; - - encode=dpd<<30; - getDPDb(dpd, 2); encode|=dpd<<20; - getDPDb(dpd, 1); encode|=dpd<<10; - getDPDb(dpd, 0); encode|=dpd; - DFWORD(df, 3)=encode; - #endif - // decFloatShow(df, "fromB"); - return df; - } // decFloatFromBCD - -/* ------------------------------------------------------------------ */ -/* decFloatFromPacked -- set decFloat from exponent and packed BCD */ -/* */ -/* df is the target decFloat */ -/* exp is the in-range unbiased exponent, q, or a special value in */ -/* the form returned by decFloatGetExponent */ -/* packed holds DECPMAX packed decimal digits plus a sign nibble */ -/* (all 6 codes are OK); the first (MSD) is ignored if df is a NaN */ -/* and all except sign are ignored if df is infinite. For DOUBLE */ -/* and QUAD the first (pad) nibble is also ignored in all cases. */ -/* All coefficient nibbles must be in 0-9 and sign in A-F; results */ -/* are undefined otherwise. */ -/* returns df, which will be canonical */ -/* */ -/* No error is possible, and no status will be set. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatFromPacked(decFloat *df, Int exp, const uByte *packed) { - uByte bcdar[DECPMAX+2]; // work [+1 for pad, +1 for sign] - const uByte *ip; // .. - uByte *op; // .. - Int sig=0; // sign - - // expand coefficient and sign to BCDAR - #if SINGLE - op=bcdar+1; // no pad digit - #else - op=bcdar; // first (pad) digit ignored - #endif - for (ip=packed; ip>4; - *op++=(uByte)(*ip&0x0f); // [final nibble is sign] - } - op--; // -> sign byte - if (*op==DECPMINUS || *op==DECPMINUSALT) sig=DECFLOAT_Sign; - - if (EXPISSPECIAL(exp)) { // Infinity or NaN - if (!EXPISINF(exp)) bcdar[1]=0; // a NaN: ignore MSD - else memset(bcdar+1, 0, DECPMAX); // Infinite: coefficient to 0 - } - return decFloatFromBCD(df, exp, bcdar+1, sig); - } // decFloatFromPacked - -/* ------------------------------------------------------------------ */ -/* decFloatFromPackedChecked -- set from exponent and packed; checked */ -/* */ -/* df is the target decFloat */ -/* exp is the in-range unbiased exponent, q, or a special value in */ -/* the form returned by decFloatGetExponent */ -/* packed holds DECPMAX packed decimal digits plus a sign nibble */ -/* (all 6 codes are OK); the first (MSD) must be 0 if df is a NaN */ -/* and all digits must be 0 if df is infinite. For DOUBLE and */ -/* QUAD the first (pad) nibble must be 0. */ -/* All coefficient nibbles must be in 0-9 and sign in A-F. */ -/* returns df, which will be canonical or NULL if any of the */ -/* requirements are not met (if this case df is unchanged); that */ -/* is, the input data must be as returned by decFloatToPacked, */ -/* except that all six sign codes are acccepted. */ -/* */ -/* No status will be set. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatFromPackedChecked(decFloat *df, Int exp, - const uByte *packed) { - uByte bcdar[DECPMAX+2]; // work [+1 for pad, +1 for sign] - const uByte *ip; // .. - uByte *op; // .. - Int sig=0; // sign - - // expand coefficient and sign to BCDAR - #if SINGLE - op=bcdar+1; // no pad digit - #else - op=bcdar; // first (pad) digit here - #endif - for (ip=packed; ip>4; - if (*op>9) return NULL; - op++; - *op=(uByte)(*ip&0x0f); // [final nibble is sign] - if (*op>9 && ip sign byte - if (*op<=9) return NULL; // bad sign - if (*op==DECPMINUS || *op==DECPMINUSALT) sig=DECFLOAT_Sign; - - #if !SINGLE - if (bcdar[0]!=0) return NULL; // bad pad nibble - #endif - - if (EXPISNAN(exp)) { // a NaN - if (bcdar[1]!=0) return NULL; // bad msd - } // NaN - else if (EXPISINF(exp)) { // is infinite - Int i; - for (i=0; iDECEMAX-DECPMAX+1) return NULL; - if (exp first character of decimal part - const char *c; // work - uByte *ub; // .. - uInt uiwork; // for macros - bcdnum num; // collects data for finishing - uInt error=DEC_Conversion_syntax; // assume the worst - uByte buffer[ROUNDUP(DECSTRING+11, 8)]; // room for most coefficents, - // some common rounding, +3, & pad - #if DECTRACE - // printf("FromString %s ...\n", string); - #endif - - for(;;) { // once-only 'loop' - num.sign=0; // assume non-negative - num.msd=buffer; // MSD is here always - - // detect and validate the coefficient, including any leading, - // trailing, or embedded '.' - // [could test four-at-a-time here (saving 10% for decQuads), - // but that risks storage violation because the position of the - // terminator is unknown] - for (c=string;; c++) { // -> input character - if (((unsigned)(*c-'0'))<=9) continue; // '0' through '9' is good - if (*c=='\0') break; // most common non-digit - if (*c=='.') { - if (dotchar!=NULL) break; // not first '.' - dotchar=c; // record offset into decimal part - continue;} - if (c==string) { // first in string... - if (*c=='-') { // valid - sign - cfirst++; - num.sign=DECFLOAT_Sign; - continue;} - if (*c=='+') { // valid + sign - cfirst++; - continue;} - } - // *c is not a digit, terminator, or a valid +, -, or '.' - break; - } // c loop - - digits=(uInt)(c-cfirst); // digits (+1 if a dot) - - if (digits>0) { // had digits and/or dot - const char *clast=c-1; // note last coefficient char position - Int exp=0; // exponent accumulator - if (*c!='\0') { // something follows the coefficient - uInt edig; // unsigned work - // had some digits and more to come; expect E[+|-]nnn now - const char *firstexp; // exponent first non-zero - if (*c!='E' && *c!='e') break; - c++; // to (optional) sign - if (*c=='-' || *c=='+') c++; // step over sign (c=clast+2) - if (*c=='\0') break; // no digits! (e.g., '1.2E') - for (; *c=='0';) c++; // skip leading zeros [even last] - firstexp=c; // remember start [maybe '\0'] - // gather exponent digits - edig=(uInt)*c-(uInt)'0'; - if (edig<=9) { // [check not bad or terminator] - exp+=edig; // avoid initial X10 - c++; - for (;; c++) { - edig=(uInt)*c-(uInt)'0'; - if (edig>9) break; - exp=exp*10+edig; - } - } - // if not now on the '\0', *c must not be a digit - if (*c!='\0') break; - - // (this next test must be after the syntax checks) - // if definitely more than the possible digits for format then - // the exponent may have wrapped, so simply set it to a certain - // over/underflow value - if (c>firstexp+DECEMAXD) exp=DECEMAX*2; - if (*(clast+2)=='-') exp=-exp; // was negative - } // exponent part - - if (dotchar!=NULL) { // had a '.' - digits--; // remove from digits count - if (digits==0) break; // was dot alone: bad syntax - exp-=(Int)(clast-dotchar); // adjust exponent - // [the '.' can now be ignored] - } - num.exponent=exp; // exponent is good; store it - - // Here when whole string has been inspected and syntax is good - // cfirst->first digit or dot, clast->last digit or dot - error=0; // no error possible now - - // if the number of digits in the coefficient will fit in buffer - // then it can simply be converted to bcd8 and copied -- decFinalize - // will take care of leading zeros and rounding; the buffer is big - // enough for all canonical coefficients, including 0.00000nn... - ub=buffer; - if (digits<=(Int)(sizeof(buffer)-3)) { // [-3 allows by-4s copy] - c=cfirst; - if (dotchar!=NULL) { // a dot to worry about - if (*(c+1)=='.') { // common canonical case - *ub++=(uByte)(*c-'0'); // copy leading digit - c+=2; // prepare to handle rest - } - else for (; c<=clast;) { // '.' could be anywhere - // as usual, go by fours when safe; NB it has been asserted - // that a '.' does not have the same mask as a digit - if (c<=clast-3 // safe for four - && (UBTOUI(c)&0xf0f0f0f0)==CHARMASK) { // test four - UBFROMUI(ub, UBTOUI(c)&0x0f0f0f0f); // to BCD8 - ub+=4; - c+=4; - continue; - } - if (*c=='.') { // found the dot - c++; // step over it .. - break; // .. and handle the rest - } - *ub++=(uByte)(*c++-'0'); - } - } // had dot - // Now no dot; do this by fours (where safe) - for (; c<=clast-3; c+=4, ub+=4) UBFROMUI(ub, UBTOUI(c)&0x0f0f0f0f); - for (; c<=clast; c++, ub++) *ub=(uByte)(*c-'0'); - num.lsd=buffer+digits-1; // record new LSD - } // fits - - else { // too long for buffer - // [This is a rare and unusual case; arbitrary-length input] - // strip leading zeros [but leave final 0 if all 0's] - if (*cfirst=='.') cfirst++; // step past dot at start - if (*cfirst=='0') { // [cfirst always -> digit] - for (; cfirst LSD - for (; c<=clast; c++) { // inspect remaining chars - if (*c!='0') { // sticky bit needed - if (*c=='.') continue; // [ignore] - *ub=DECSTICKYTAB[*ub]; // update round-for-reround - break; // no need to look at more - } - } - num.lsd=ub; // record LSD - // adjust exponent for dropped digits - num.exponent+=digits-(Int)(ub-buffer+1); - } // too long for buffer - } // digits and/or dot - - else { // no digits or dot were found - // only Infinities and NaNs are allowed, here - if (*c=='\0') break; // nothing there is bad - buffer[0]=0; // default a coefficient of 0 - num.lsd=buffer; // .. - if (decBiStr(c, "infinity", "INFINITY") - || decBiStr(c, "inf", "INF")) num.exponent=DECFLOAT_Inf; - else { // should be a NaN - num.exponent=DECFLOAT_qNaN; // assume quiet NaN - if (*c=='s' || *c=='S') { // probably an sNaN - num.exponent=DECFLOAT_sNaN; // effect the 's' - c++; // and step over it - } - if (*c!='N' && *c!='n') break; // check caseless "NaN" - c++; - if (*c!='a' && *c!='A') break; // .. - c++; - if (*c!='N' && *c!='n') break; // .. - c++; - // now either nothing, or nnnn payload (no dots), expected - // -> start of integer, and skip leading 0s [including plain 0] - for (cfirst=c; *cfirst=='0';) cfirst++; - if (*cfirst!='\0') { // not empty or all-0, payload - // payload found; check all valid digits and copy to buffer as bcd8 - ub=buffer; - for (c=cfirst;; c++, ub++) { - if ((unsigned)(*c-'0')>9) break; // quit if not 0-9 - if (c-cfirst==DECPMAX-1) break; // too many digits - *ub=(uByte)(*c-'0'); // good bcd8 - } - if (*c!='\0') break; // not all digits, or too many - num.lsd=ub-1; // record new LSD - } - } // NaN or sNaN - error=0; // syntax is OK - } // digits=0 (special expected) - break; // drop out - } // [for(;;) once-loop] - - // decShowNum(&num, "fromStr"); - - if (error!=0) { - set->status|=error; - num.exponent=DECFLOAT_qNaN; // set up quiet NaN - num.sign=0; // .. with 0 sign - buffer[0]=0; // .. and coefficient - num.lsd=buffer; // .. - // decShowNum(&num, "oops"); - } - - // decShowNum(&num, "dffs"); - decFinalize(result, &num, set); // round, check, and lay out - // decFloatShow(result, "fromString"); - return result; - } // decFloatFromString - -/* ------------------------------------------------------------------ */ -/* decFloatFromWider -- conversion from next-wider format */ -/* */ -/* result is the decFloat format number which gets the result of */ -/* the conversion */ -/* wider is the decFloatWider format number which will be narrowed */ -/* set is the context */ -/* returns result */ -/* */ -/* Narrowing can cause rounding, overflow, etc., but not Invalid */ -/* operation (sNaNs are copied and do not signal). */ -/* ------------------------------------------------------------------ */ -// narrow-to is not possible for decQuad format numbers; simply omit -#if !QUAD -decFloat * decFloatFromWider(decFloat *result, const decFloatWider *wider, - decContext *set) { - bcdnum num; // collects data for finishing - uByte bcdar[DECWPMAX]; // room for wider coefficient - uInt widerhi=DFWWORD(wider, 0); // top word - Int exp; - - GETWCOEFF(wider, bcdar); - - num.msd=bcdar; // MSD is here always - num.lsd=bcdar+DECWPMAX-1; // LSD is here always - num.sign=widerhi&0x80000000; // extract sign [DECFLOAT_Sign=Neg] - - // decode the wider combination field to exponent - exp=DECCOMBWEXP[widerhi>>26]; // decode from wider combination field - // if it is a special there's nothing to do unless sNaN; if it's - // finite then add the (wider) exponent continuation and unbias - if (EXPISSPECIAL(exp)) exp=widerhi&0x7e000000; // include sNaN selector - else exp+=GETWECON(wider)-DECWBIAS; - num.exponent=exp; - - // decShowNum(&num, "dffw"); - return decFinalize(result, &num, set);// round, check, and lay out - } // decFloatFromWider -#endif - -/* ------------------------------------------------------------------ */ -/* decFloatGetCoefficient -- get coefficient as BCD8 */ -/* */ -/* df is the decFloat from which to extract the coefficient */ -/* bcdar is where DECPMAX bytes will be written, one BCD digit in */ -/* each byte (BCD8 encoding); if df is a NaN the first byte will */ -/* be zero, and if it is infinite they will all be zero */ -/* returns the sign of the coefficient (DECFLOAT_Sign if negative, */ -/* 0 otherwise) */ -/* */ -/* No error is possible, and no status will be set. If df is a */ -/* special value the array is set to zeros (for Infinity) or to the */ -/* payload of a qNaN or sNaN. */ -/* ------------------------------------------------------------------ */ -Int decFloatGetCoefficient(const decFloat *df, uByte *bcdar) { - if (DFISINF(df)) memset(bcdar, 0, DECPMAX); - else { - GETCOEFF(df, bcdar); // use macro - if (DFISNAN(df)) bcdar[0]=0; // MSD needs correcting - } - return GETSIGN(df); - } // decFloatGetCoefficient - -/* ------------------------------------------------------------------ */ -/* decFloatGetExponent -- get unbiased exponent */ -/* */ -/* df is the decFloat from which to extract the exponent */ -/* returns the exponent, q. */ -/* */ -/* No error is possible, and no status will be set. If df is a */ -/* special value the first seven bits of the decFloat are returned, */ -/* left adjusted and with the first (sign) bit set to 0 (followed by */ -/* 25 0 bits). e.g., -sNaN would return 0x7e000000 (DECFLOAT_sNaN). */ -/* ------------------------------------------------------------------ */ -Int decFloatGetExponent(const decFloat *df) { - if (DFISSPECIAL(df)) return DFWORD(df, 0)&0x7e000000; - return GETEXPUN(df); - } // decFloatGetExponent - -/* ------------------------------------------------------------------ */ -/* decFloatSetCoefficient -- set coefficient from BCD8 */ -/* */ -/* df is the target decFloat (and source of exponent/special value) */ -/* bcdar holds DECPMAX digits to set the coefficient from, one */ -/* digit in each byte (BCD8 encoding); the first (MSD) is ignored */ -/* if df is a NaN; all are ignored if df is infinite. */ -/* sig is DECFLOAT_Sign to set the sign bit, 0 otherwise */ -/* returns df, which will be canonical */ -/* */ -/* No error is possible, and no status will be set. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatSetCoefficient(decFloat *df, const uByte *bcdar, - Int sig) { - uInt exp; // for exponent - uByte bcdzero[DECPMAX]; // for infinities - - // Exponent/special code is extracted from df - if (DFISSPECIAL(df)) { - exp=DFWORD(df, 0)&0x7e000000; - if (DFISINF(df)) { - memset(bcdzero, 0, DECPMAX); - return decFloatFromBCD(df, exp, bcdzero, sig); - } - } - else exp=GETEXPUN(df); - return decFloatFromBCD(df, exp, bcdar, sig); - } // decFloatSetCoefficient - -/* ------------------------------------------------------------------ */ -/* decFloatSetExponent -- set exponent or special value */ -/* */ -/* df is the target decFloat (and source of coefficient/payload) */ -/* set is the context for reporting status */ -/* exp is the unbiased exponent, q, or a special value in the form */ -/* returned by decFloatGetExponent */ -/* returns df, which will be canonical */ -/* */ -/* No error is possible, but Overflow or Underflow might occur. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatSetExponent(decFloat *df, decContext *set, Int exp) { - uByte bcdcopy[DECPMAX]; // for coefficient - bcdnum num; // work - num.exponent=exp; - num.sign=decFloatGetCoefficient(df, bcdcopy); // extract coefficient - if (DFISSPECIAL(df)) { // MSD or more needs correcting - if (DFISINF(df)) memset(bcdcopy, 0, DECPMAX); - bcdcopy[0]=0; - } - num.msd=bcdcopy; - num.lsd=bcdcopy+DECPMAX-1; - return decFinalize(df, &num, set); - } // decFloatSetExponent - -/* ------------------------------------------------------------------ */ -/* decFloatRadix -- returns the base (10) */ -/* */ -/* df is any decFloat of this format */ -/* ------------------------------------------------------------------ */ -uInt decFloatRadix(const decFloat *df) { - if (df) return 10; // to placate compiler - return 10; - } // decFloatRadix - -/* The following function is not available if DECPRINT=0 */ -#if DECPRINT -/* ------------------------------------------------------------------ */ -/* decFloatShow -- printf a decFloat in hexadecimal and decimal */ -/* df is the decFloat to show */ -/* tag is a tag string displayed with the number */ -/* */ -/* This is a debug aid; the precise format of the string may change. */ -/* ------------------------------------------------------------------ */ -void decFloatShow(const decFloat *df, const char *tag) { - char hexbuf[DECBYTES*2+DECBYTES/4+1]; // NB blank after every fourth - char buff[DECSTRING]; // for value in decimal - Int i, j=0; - - for (i=0; ibytes[DECBYTES-1-i]); - #else - sprintf(&hexbuf[j], "%02x", df->bytes[i]); - #endif - j+=2; - // the next line adds blank (and terminator) after final pair, too - if ((i+1)%4==0) {strcpy(&hexbuf[j], " "); j++;} - } - decFloatToString(df, buff); - printf(">%s> %s [big-endian] %s\n", tag, hexbuf, buff); - return; - } // decFloatShow -#endif - -/* ------------------------------------------------------------------ */ -/* decFloatToBCD -- get sign, exponent, and BCD8 from a decFloat */ -/* */ -/* df is the source decFloat */ -/* exp will be set to the unbiased exponent, q, or to a special */ -/* value in the form returned by decFloatGetExponent */ -/* bcdar is where DECPMAX bytes will be written, one BCD digit in */ -/* each byte (BCD8 encoding); if df is a NaN the first byte will */ -/* be zero, and if it is infinite they will all be zero */ -/* returns the sign of the coefficient (DECFLOAT_Sign if negative, */ -/* 0 otherwise) */ -/* */ -/* No error is possible, and no status will be set. */ -/* ------------------------------------------------------------------ */ -Int decFloatToBCD(const decFloat *df, Int *exp, uByte *bcdar) { - if (DFISINF(df)) { - memset(bcdar, 0, DECPMAX); - *exp=DFWORD(df, 0)&0x7e000000; - } - else { - GETCOEFF(df, bcdar); // use macro - if (DFISNAN(df)) { - bcdar[0]=0; // MSD needs correcting - *exp=DFWORD(df, 0)&0x7e000000; - } - else { // finite - *exp=GETEXPUN(df); - } - } - return GETSIGN(df); - } // decFloatToBCD - -/* ------------------------------------------------------------------ */ -/* decFloatToEngString -- conversion to numeric string, engineering */ -/* */ -/* df is the decFloat format number to convert */ -/* string is the string where the result will be laid out */ -/* */ -/* string must be at least DECPMAX+9 characters (the worst case is */ -/* "-0.00000nnn...nnn\0", which is as long as the exponent form when */ -/* DECEMAXD<=4); this condition is asserted above */ -/* */ -/* No error is possible, and no status will be set */ -/* ------------------------------------------------------------------ */ -char * decFloatToEngString(const decFloat *df, char *string){ - uInt msd; // coefficient MSD - Int exp; // exponent top two bits or full - uInt comb; // combination field - char *cstart; // coefficient start - char *c; // output pointer in string - char *s, *t; // .. (source, target) - Int pre, e; // work - const uByte *u; // .. - uInt uiwork; // for macros [one compiler needs - // volatile here to avoid bug, but - // that doubles execution time] - - // Source words; macro handles endianness - uInt sourhi=DFWORD(df, 0); // word with sign - #if DECPMAX==16 - uInt sourlo=DFWORD(df, 1); - #elif DECPMAX==34 - uInt sourmh=DFWORD(df, 1); - uInt sourml=DFWORD(df, 2); - uInt sourlo=DFWORD(df, 3); - #endif - - c=string; // where result will go - if (((Int)sourhi)<0) *c++='-'; // handle sign - comb=sourhi>>26; // sign+combination field - msd=DECCOMBMSD[comb]; // decode the combination field - exp=DECCOMBEXP[comb]; // .. - - if (EXPISSPECIAL(exp)) { // special - if (exp==DECFLOAT_Inf) { // infinity - strcpy(c, "Inf"); - strcpy(c+3, "inity"); - return string; // easy - } - if (sourhi&0x02000000) *c++='s'; // sNaN - strcpy(c, "NaN"); // complete word - c+=3; // step past - // quick exit if the payload is zero - #if DECPMAX==7 - if ((sourhi&0x000fffff)==0) return string; - #elif DECPMAX==16 - if (sourlo==0 && (sourhi&0x0003ffff)==0) return string; - #elif DECPMAX==34 - if (sourlo==0 && sourml==0 && sourmh==0 - && (sourhi&0x00003fff)==0) return string; - #endif - // otherwise drop through to add integer; set correct exp etc. - exp=0; msd=0; // setup for following code - } - else { // complete exponent; top two bits are in place - exp+=GETECON(df)-DECBIAS; // .. + continuation and unbias - } - - /* convert the digits of the significand to characters */ - cstart=c; // save start of coefficient - if (msd) *c++=(char)('0'+(char)msd); // non-zero most significant digit - - // Decode the declets. After extracting each declet, it is - // decoded to a 4-uByte sequence by table lookup; the four uBytes - // are the three encoded BCD8 digits followed by a 1-byte length - // (significant digits, except that 000 has length 0). This allows - // us to left-align the first declet with non-zero content, then - // the remaining ones are full 3-char length. Fixed-length copies - // are used because variable-length memcpy causes a subroutine call - // in at least two compilers. (The copies are length 4 for speed - // and are safe because the last item in the array is of length - // three and has the length byte following.) - #define dpd2char(dpdin) u=&DPD2BCD8[((dpdin)&0x3ff)*4]; \ - if (c!=cstart) {UBFROMUI(c, UBTOUI(u)|CHARMASK); c+=3;} \ - else if (*(u+3)) { \ - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); c+=*(u+3);} - - #if DECPMAX==7 - dpd2char(sourhi>>10); // declet 1 - dpd2char(sourhi); // declet 2 - - #elif DECPMAX==16 - dpd2char(sourhi>>8); // declet 1 - dpd2char((sourhi<<2) | (sourlo>>30)); // declet 2 - dpd2char(sourlo>>20); // declet 3 - dpd2char(sourlo>>10); // declet 4 - dpd2char(sourlo); // declet 5 - - #elif DECPMAX==34 - dpd2char(sourhi>>4); // declet 1 - dpd2char((sourhi<<6) | (sourmh>>26)); // declet 2 - dpd2char(sourmh>>16); // declet 3 - dpd2char(sourmh>>6); // declet 4 - dpd2char((sourmh<<4) | (sourml>>28)); // declet 5 - dpd2char(sourml>>18); // declet 6 - dpd2char(sourml>>8); // declet 7 - dpd2char((sourml<<2) | (sourlo>>30)); // declet 8 - dpd2char(sourlo>>20); // declet 9 - dpd2char(sourlo>>10); // declet 10 - dpd2char(sourlo); // declet 11 - #endif - - if (c==cstart) *c++='0'; // all zeros, empty -- make "0" - - if (exp==0) { // integer or NaN case -- easy - *c='\0'; // terminate - return string; - } - /* non-0 exponent */ - - e=0; // assume no E - pre=(Int)(c-cstart)+exp; // length+exp [c->LSD+1] - // [here, pre-exp is the digits count (==1 for zero)] - - if (exp>0 || pre<-5) { // need exponential form - e=pre-1; // calculate E value - pre=1; // assume one digit before '.' - if (e!=0) { // engineering: may need to adjust - Int adj; // adjustment - // The C remainder operator is undefined for negative numbers, so - // a positive remainder calculation must be used here - if (e<0) { - adj=(-e)%3; - if (adj!=0) adj=3-adj; - } - else { // e>0 - adj=e%3; - } - e=e-adj; - // if dealing with zero still produce an exponent which is a - // multiple of three, as expected, but there will only be the - // one zero before the E, still. Otherwise note the padding. - if (!DFISZERO(df)) pre+=adj; - else { // is zero - if (adj!=0) { // 0.00Esnn needed - e=e+3; - pre=-(2-adj); - } - } // zero - } // engineering adjustment - } // exponential form - // printf("e=%ld pre=%ld exp=%ld\n", (LI)e, (LI)pre, (LI)exp); - - /* modify the coefficient, adding 0s, '.', and E+nn as needed */ - if (pre>0) { // ddd.ddd (plain), perhaps with E - // or dd00 padding for engineering - char *dotat=cstart+pre; - if (dotat=dotat; s-=4, t-=4) UBFROMUI(t, UBTOUI(s)); - *dotat='.'; - c++; // length increased by one - } // need dot? - else for (; c0 - else { - /* -5<=pre<=0: here for plain 0.ddd or 0.000ddd forms (may have - E, but only for 0.00E+3 kind of case -- with plenty of spare - space in this case */ - pre=-pre+2; // gap width, including "0." - t=cstart+ROUNDDOWN4(c-cstart)+pre; // preferred first target point - // backoff if too far to the right - if (t>string+DECSTRING-5) t=string+DECSTRING-5; // adjust to fit - // now shift the entire coefficient to the right, being careful not - // to access to the left of string [cannot use memcpy] - for (s=t-pre; s>=string; s-=4, t-=4) UBFROMUI(t, UBTOUI(s)); - // for Quads and Singles there may be a character or two left... - s+=3; // where next would come from - for(; s>=cstart; s--, t--) *(t+3)=*(s); - // now have fill 0. through 0.00000; use overlaps to avoid tests - if (pre>=4) { - memcpy(cstart+pre-4, "0000", 4); - memcpy(cstart, "0.00", 4); - } - else { // 2 or 3 - *(cstart+pre-1)='0'; - memcpy(cstart, "0.", 2); - } - c+=pre; // to end - } - - // finally add the E-part, if needed; it will never be 0, and has - // a maximum length of 3 or 4 digits (asserted above) - if (e!=0) { - memcpy(c, "E+", 2); // starts with E, assume + - c++; - if (e<0) { - *c='-'; // oops, need '-' - e=-e; // uInt, please - } - c++; - // Three-character exponents are easy; 4-character a little trickier - #if DECEMAXD<=3 - u=&BIN2BCD8[e*4]; // -> 3 digits + length byte - // copy fixed 4 characters [is safe], starting at non-zero - // and with character mask to convert BCD to char - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); - c+=*(u+3); // bump pointer appropriately - #elif DECEMAXD==4 - if (e<1000) { // 3 (or fewer) digits case - u=&BIN2BCD8[e*4]; // -> 3 digits + length byte - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); // [as above] - c+=*(u+3); // bump pointer appropriately - } - else { // 4-digits - Int thou=((e>>3)*1049)>>17; // e/1000 - Int rem=e-(1000*thou); // e%1000 - *c++=(char)('0'+(char)thou); // the thousands digit - u=&BIN2BCD8[rem*4]; // -> 3 digits + length byte - UBFROMUI(c, UBTOUI(u)|CHARMASK);// copy fixed 3+1 characters [is safe] - c+=3; // bump pointer, always 3 digits - } - #endif - } - *c='\0'; // terminate - //printf("res %s\n", string); - return string; - } // decFloatToEngString - -/* ------------------------------------------------------------------ */ -/* decFloatToPacked -- convert decFloat to Packed decimal + exponent */ -/* */ -/* df is the source decFloat */ -/* exp will be set to the unbiased exponent, q, or to a special */ -/* value in the form returned by decFloatGetExponent */ -/* packed is where DECPMAX nibbles will be written with the sign as */ -/* final nibble (0x0c for +, 0x0d for -); a NaN has a first nibble */ -/* of zero, and an infinity is all zeros. decDouble and decQuad */ -/* have a additional leading zero nibble, leading to result */ -/* lengths of 4, 9, and 18 bytes. */ -/* returns the sign of the coefficient (DECFLOAT_Sign if negative, */ -/* 0 otherwise) */ -/* */ -/* No error is possible, and no status will be set. */ -/* ------------------------------------------------------------------ */ -Int decFloatToPacked(const decFloat *df, Int *exp, uByte *packed) { - uByte bcdar[DECPMAX+2]; // work buffer - uByte *ip=bcdar, *op=packed; // work pointers - if (DFISINF(df)) { - memset(bcdar, 0, DECPMAX+2); - *exp=DECFLOAT_Inf; - } - else { - GETCOEFF(df, bcdar+1); // use macro - if (DFISNAN(df)) { - bcdar[1]=0; // MSD needs clearing - *exp=DFWORD(df, 0)&0x7e000000; - } - else { // finite - *exp=GETEXPUN(df); - } - } - // now pack; coefficient currently at bcdar+1 - #if SINGLE - ip++; // ignore first byte - #else - *ip=0; // need leading zero - #endif - // set final byte to Packed BCD sign value - bcdar[DECPMAX+1]=(DFISSIGNED(df) ? DECPMINUS : DECPPLUS); - // pack an even number of bytes... - for (; op>26; // sign+combination field - msd=DECCOMBMSD[comb]; // decode the combination field - exp=DECCOMBEXP[comb]; // .. - - if (!EXPISSPECIAL(exp)) { // finite - // complete exponent; top two bits are in place - exp+=GETECON(df)-DECBIAS; // .. + continuation and unbias - } - else { // IS special - if (exp==DECFLOAT_Inf) { // infinity - strcpy(c, "Infinity"); - return string; // easy - } - if (sourhi&0x02000000) *c++='s'; // sNaN - strcpy(c, "NaN"); // complete word - c+=3; // step past - // quick exit if the payload is zero - #if DECPMAX==7 - if ((sourhi&0x000fffff)==0) return string; - #elif DECPMAX==16 - if (sourlo==0 && (sourhi&0x0003ffff)==0) return string; - #elif DECPMAX==34 - if (sourlo==0 && sourml==0 && sourmh==0 - && (sourhi&0x00003fff)==0) return string; - #endif - // otherwise drop through to add integer; set correct exp etc. - exp=0; msd=0; // setup for following code - } - - /* convert the digits of the significand to characters */ - cstart=c; // save start of coefficient - if (msd) *c++=(char)('0'+(char)msd); // non-zero most significant digit - - // Decode the declets. After extracting each declet, it is - // decoded to a 4-uByte sequence by table lookup; the four uBytes - // are the three encoded BCD8 digits followed by a 1-byte length - // (significant digits, except that 000 has length 0). This allows - // us to left-align the first declet with non-zero content, then - // the remaining ones are full 3-char length. Fixed-length copies - // are used because variable-length memcpy causes a subroutine call - // in at least two compilers. (The copies are length 4 for speed - // and are safe because the last item in the array is of length - // three and has the length byte following.) - #define dpd2char(dpdin) u=&DPD2BCD8[((dpdin)&0x3ff)*4]; \ - if (c!=cstart) {UBFROMUI(c, UBTOUI(u)|CHARMASK); c+=3;} \ - else if (*(u+3)) { \ - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); c+=*(u+3);} - - #if DECPMAX==7 - dpd2char(sourhi>>10); // declet 1 - dpd2char(sourhi); // declet 2 - - #elif DECPMAX==16 - dpd2char(sourhi>>8); // declet 1 - dpd2char((sourhi<<2) | (sourlo>>30)); // declet 2 - dpd2char(sourlo>>20); // declet 3 - dpd2char(sourlo>>10); // declet 4 - dpd2char(sourlo); // declet 5 - - #elif DECPMAX==34 - dpd2char(sourhi>>4); // declet 1 - dpd2char((sourhi<<6) | (sourmh>>26)); // declet 2 - dpd2char(sourmh>>16); // declet 3 - dpd2char(sourmh>>6); // declet 4 - dpd2char((sourmh<<4) | (sourml>>28)); // declet 5 - dpd2char(sourml>>18); // declet 6 - dpd2char(sourml>>8); // declet 7 - dpd2char((sourml<<2) | (sourlo>>30)); // declet 8 - dpd2char(sourlo>>20); // declet 9 - dpd2char(sourlo>>10); // declet 10 - dpd2char(sourlo); // declet 11 - #endif - - if (c==cstart) *c++='0'; // all zeros, empty -- make "0" - - //[This fast path is valid but adds 3-5 cycles to worst case length] - //if (exp==0) { // integer or NaN case -- easy - // *c='\0'; // terminate - // return string; - // } - - e=0; // assume no E - pre=(Int)(c-cstart)+exp; // length+exp [c->LSD+1] - // [here, pre-exp is the digits count (==1 for zero)] - - if (exp>0 || pre<-5) { // need exponential form - e=pre-1; // calculate E value - pre=1; // assume one digit before '.' - } // exponential form - - /* modify the coefficient, adding 0s, '.', and E+nn as needed */ - if (pre>0) { // ddd.ddd (plain), perhaps with E - char *dotat=cstart+pre; - if (dotat=dotat; s-=4, t-=4) UBFROMUI(t, UBTOUI(s)); - *dotat='.'; - c++; // length increased by one - } // need dot? - - // finally add the E-part, if needed; it will never be 0, and has - // a maximum length of 3 or 4 digits (asserted above) - if (e!=0) { - memcpy(c, "E+", 2); // starts with E, assume + - c++; - if (e<0) { - *c='-'; // oops, need '-' - e=-e; // uInt, please - } - c++; - // Three-character exponents are easy; 4-character a little trickier - #if DECEMAXD<=3 - u=&BIN2BCD8[e*4]; // -> 3 digits + length byte - // copy fixed 4 characters [is safe], starting at non-zero - // and with character mask to convert BCD to char - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); - c+=*(u+3); // bump pointer appropriately - #elif DECEMAXD==4 - if (e<1000) { // 3 (or fewer) digits case - u=&BIN2BCD8[e*4]; // -> 3 digits + length byte - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); // [as above] - c+=*(u+3); // bump pointer appropriately - } - else { // 4-digits - Int thou=((e>>3)*1049)>>17; // e/1000 - Int rem=e-(1000*thou); // e%1000 - *c++=(char)('0'+(char)thou); // the thousands digit - u=&BIN2BCD8[rem*4]; // -> 3 digits + length byte - UBFROMUI(c, UBTOUI(u)|CHARMASK); // copy fixed 3+1 characters [is safe] - c+=3; // bump pointer, always 3 digits - } - #endif - } - *c='\0'; // add terminator - //printf("res %s\n", string); - return string; - } // pre>0 - - /* -5<=pre<=0: here for plain 0.ddd or 0.000ddd forms (can never have E) */ - // Surprisingly, this is close to being the worst-case path, so the - // shift is done by fours; this is a little tricky because the - // rightmost character to be written must not be beyond where the - // rightmost terminator could be -- so backoff to not touch - // terminator position if need be (this can make exact alignments - // for full Doubles, but in some cases needs care not to access too - // far to the left) - - pre=-pre+2; // gap width, including "0." - t=cstart+ROUNDDOWN4(c-cstart)+pre; // preferred first target point - // backoff if too far to the right - if (t>string+DECSTRING-5) t=string+DECSTRING-5; // adjust to fit - // now shift the entire coefficient to the right, being careful not - // to access to the left of string [cannot use memcpy] - for (s=t-pre; s>=string; s-=4, t-=4) UBFROMUI(t, UBTOUI(s)); - // for Quads and Singles there may be a character or two left... - s+=3; // where next would come from - for(; s>=cstart; s--, t--) *(t+3)=*(s); - // now have fill 0. through 0.00000; use overlaps to avoid tests - if (pre>=4) { - memcpy(cstart+pre-4, "0000", 4); - memcpy(cstart, "0.00", 4); - } - else { // 2 or 3 - *(cstart+pre-1)='0'; - memcpy(cstart, "0.", 2); - } - *(c+pre)='\0'; // terminate - return string; - } // decFloatToString - -/* ------------------------------------------------------------------ */ -/* decFloatToWider -- conversion to next-wider format */ -/* */ -/* source is the decFloat format number which gets the result of */ -/* the conversion */ -/* wider is the decFloatWider format number which will be narrowed */ -/* returns wider */ -/* */ -/* Widening is always exact; no status is set (sNaNs are copied and */ -/* do not signal). The result will be canonical if the source is, */ -/* and may or may not be if the source is not. */ -/* ------------------------------------------------------------------ */ -// widening is not possible for decQuad format numbers; simply omit -#if !QUAD -decFloatWider * decFloatToWider(const decFloat *source, decFloatWider *wider) { - uInt msd; - - /* Construct and copy the sign word */ - if (DFISSPECIAL(source)) { - // copy sign, combination, and first bit of exponent (sNaN selector) - DFWWORD(wider, 0)=DFWORD(source, 0)&0xfe000000; - msd=0; - } - else { // is finite number - uInt exp=GETEXPUN(source)+DECWBIAS; // get unbiased exponent and rebias - uInt code=(exp>>DECWECONL)<<29; // set two bits of exp [msd=0] - code|=(exp<<(32-6-DECWECONL)) & 0x03ffffff; // add exponent continuation - code|=DFWORD(source, 0)&0x80000000; // add sign - DFWWORD(wider, 0)=code; // .. and place top word in wider - msd=GETMSD(source); // get source coefficient MSD [0-9] - } - /* Copy the coefficient and clear any 'unused' words to left */ - #if SINGLE - DFWWORD(wider, 1)=(DFWORD(source, 0)&0x000fffff)|(msd<<20); - #elif DOUBLE - DFWWORD(wider, 2)=(DFWORD(source, 0)&0x0003ffff)|(msd<<18); - DFWWORD(wider, 3)=DFWORD(source, 1); - DFWWORD(wider, 1)=0; - #endif - return wider; - } // decFloatToWider -#endif - -/* ------------------------------------------------------------------ */ -/* decFloatVersion -- return package version string */ -/* */ -/* returns a constant string describing this package */ -/* ------------------------------------------------------------------ */ -const char *decFloatVersion(void) { - return DECVERSION; - } // decFloatVersion - -/* ------------------------------------------------------------------ */ -/* decFloatZero -- set to canonical (integer) zero */ -/* */ -/* df is the decFloat format number to integer +0 (q=0, c=+0) */ -/* returns df */ -/* */ -/* No error is possible, and no status can be set. */ -/* ------------------------------------------------------------------ */ -decFloat * decFloatZero(decFloat *df){ - DFWORD(df, 0)=ZEROWORD; // set appropriate top word - #if DOUBLE || QUAD - DFWORD(df, 1)=0; - #if QUAD - DFWORD(df, 2)=0; - DFWORD(df, 3)=0; - #endif - #endif - // decFloatShow(df, "zero"); - return df; - } // decFloatZero - -/* ------------------------------------------------------------------ */ -/* Private generic function (not format-specific) for development use */ -/* ------------------------------------------------------------------ */ -// This is included once only, for all to use -#if QUAD && (DECCHECK || DECTRACE) - /* ---------------------------------------------------------------- */ - /* decShowNum -- display bcd8 number in debug form */ - /* */ - /* num is the bcdnum to display */ - /* tag is a string to label the display */ - /* ---------------------------------------------------------------- */ - void decShowNum(const bcdnum *num, const char *tag) { - const char *csign="+"; // sign character - uByte *ub; // work - uInt uiwork; // for macros - if (num->sign==DECFLOAT_Sign) csign="-"; - - printf(">%s> ", tag); - if (num->exponent==DECFLOAT_Inf) printf("%sInfinity", csign); - else if (num->exponent==DECFLOAT_qNaN) printf("%sqNaN", csign); - else if (num->exponent==DECFLOAT_sNaN) printf("%ssNaN", csign); - else { // finite - char qbuf[10]; // for right-aligned q - char *c; // work - const uByte *u; // .. - Int e=num->exponent; // .. exponent - strcpy(qbuf, "q="); - c=&qbuf[2]; // where exponent will go - // lay out the exponent - if (e<0) { - *c++='-'; // add '-' - e=-e; // uInt, please - } - #if DECEMAXD>4 - #error Exponent form is too long for ShowNum to lay out - #endif - if (e==0) *c++='0'; // 0-length case - else if (e<1000) { // 3 (or fewer) digits case - u=&BIN2BCD8[e*4]; // -> 3 digits + length byte - UBFROMUI(c, UBTOUI(u+3-*(u+3))|CHARMASK); // [as above] - c+=*(u+3); // bump pointer appropriately - } - else { // 4-digits - Int thou=((e>>3)*1049)>>17; // e/1000 - Int rem=e-(1000*thou); // e%1000 - *c++=(char)('0'+(char)thou); // the thousands digit - u=&BIN2BCD8[rem*4]; // -> 3 digits + length byte - UBFROMUI(c, UBTOUI(u)|CHARMASK); // copy fixed 3+1 characters [is safe] - c+=3; // bump pointer, always 3 digits - } - *c='\0'; // add terminator - printf("%7s c=%s", qbuf, csign); - } - - if (!EXPISSPECIAL(num->exponent) || num->msd!=num->lsd || *num->lsd!=0) { - for (ub=num->msd; ub<=num->lsd; ub++) { // coefficient... - printf("%1x", *ub); - if ((num->lsd-ub)%3==0 && ub!=num->lsd) printf(" "); // 4-space - } - } - printf("\n"); - } // decShowNum -#endif diff --git a/decnumber/src/decContext.c b/decnumber/src/decContext.c deleted file mode 100644 --- a/decnumber/src/decContext.c +++ /dev/null @@ -1,437 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* Decimal Context module */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2009. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is called decNumber.pdf. This document is */ -/* available, together with arithmetic and format specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* This module comprises the routines for handling arithmetic */ -/* context structures. */ -/* ------------------------------------------------------------------ */ - -#include // for strcmp -#include // for printf if DECCHECK -#include "decContext.h" // context and base types -#include "decNumberLocal.h" // decNumber local types, etc. - -/* compile-time endian tester [assumes sizeof(Int)>1] */ -static const Int mfcone=1; // constant 1 -static const Flag *mfctop=(const Flag *)&mfcone; // -> top byte -#define LITEND *mfctop // named flag; 1=little-endian - -/* ------------------------------------------------------------------ */ -/* round-for-reround digits */ -/* ------------------------------------------------------------------ */ -const uByte DECSTICKYTAB[10]={1,1,2,3,4,6,6,7,8,9}; /* used if sticky */ - -/* ------------------------------------------------------------------ */ -/* Powers of ten (powers[n]==10**n, 0<=n<=9) */ -/* ------------------------------------------------------------------ */ -const uInt DECPOWERS[10]={1, 10, 100, 1000, 10000, 100000, 1000000, - 10000000, 100000000, 1000000000}; - -/* ------------------------------------------------------------------ */ -/* decContextClearStatus -- clear bits in current status */ -/* */ -/* context is the context structure to be queried */ -/* mask indicates the bits to be cleared (the status bit that */ -/* corresponds to each 1 bit in the mask is cleared) */ -/* returns context */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -decContext *decContextClearStatus(decContext *context, uInt mask) { - context->status&=~mask; - return context; - } // decContextClearStatus - -/* ------------------------------------------------------------------ */ -/* decContextDefault -- initialize a context structure */ -/* */ -/* context is the structure to be initialized */ -/* kind selects the required set of default values, one of: */ -/* DEC_INIT_BASE -- select ANSI X3-274 defaults */ -/* DEC_INIT_DECIMAL32 -- select IEEE 754 defaults, 32-bit */ -/* DEC_INIT_DECIMAL64 -- select IEEE 754 defaults, 64-bit */ -/* DEC_INIT_DECIMAL128 -- select IEEE 754 defaults, 128-bit */ -/* For any other value a valid context is returned, but with */ -/* Invalid_operation set in the status field. */ -/* returns a context structure with the appropriate initial values. */ -/* ------------------------------------------------------------------ */ -decContext * decContextDefault(decContext *context, Int kind) { - // set defaults... - context->digits=9; // 9 digits - context->emax=DEC_MAX_EMAX; // 9-digit exponents - context->emin=DEC_MIN_EMIN; // .. balanced - context->round=DEC_ROUND_HALF_UP; // 0.5 rises - context->traps=DEC_Errors; // all but informational - context->status=0; // cleared - context->clamp=0; // no clamping - #if DECSUBSET - context->extended=0; // cleared - #endif - switch (kind) { - case DEC_INIT_BASE: - // [use defaults] - break; - case DEC_INIT_DECIMAL32: - context->digits=7; // digits - context->emax=96; // Emax - context->emin=-95; // Emin - context->round=DEC_ROUND_HALF_EVEN; // 0.5 to nearest even - context->traps=0; // no traps set - context->clamp=1; // clamp exponents - #if DECSUBSET - context->extended=1; // set - #endif - break; - case DEC_INIT_DECIMAL64: - context->digits=16; // digits - context->emax=384; // Emax - context->emin=-383; // Emin - context->round=DEC_ROUND_HALF_EVEN; // 0.5 to nearest even - context->traps=0; // no traps set - context->clamp=1; // clamp exponents - #if DECSUBSET - context->extended=1; // set - #endif - break; - case DEC_INIT_DECIMAL128: - context->digits=34; // digits - context->emax=6144; // Emax - context->emin=-6143; // Emin - context->round=DEC_ROUND_HALF_EVEN; // 0.5 to nearest even - context->traps=0; // no traps set - context->clamp=1; // clamp exponents - #if DECSUBSET - context->extended=1; // set - #endif - break; - - default: // invalid Kind - // use defaults, and .. - decContextSetStatus(context, DEC_Invalid_operation); // trap - } - - return context;} // decContextDefault - -/* ------------------------------------------------------------------ */ -/* decContextGetRounding -- return current rounding mode */ -/* */ -/* context is the context structure to be queried */ -/* returns the rounding mode */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -enum rounding decContextGetRounding(decContext *context) { - return context->round; - } // decContextGetRounding - -/* ------------------------------------------------------------------ */ -/* decContextGetStatus -- return current status */ -/* */ -/* context is the context structure to be queried */ -/* returns status */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -uInt decContextGetStatus(decContext *context) { - return context->status; - } // decContextGetStatus - -/* ------------------------------------------------------------------ */ -/* decContextRestoreStatus -- restore bits in current status */ -/* */ -/* context is the context structure to be updated */ -/* newstatus is the source for the bits to be restored */ -/* mask indicates the bits to be restored (the status bit that */ -/* corresponds to each 1 bit in the mask is set to the value of */ -/* the correspnding bit in newstatus) */ -/* returns context */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -decContext *decContextRestoreStatus(decContext *context, - uInt newstatus, uInt mask) { - context->status&=~mask; // clear the selected bits - context->status|=(mask&newstatus); // or in the new bits - return context; - } // decContextRestoreStatus - -/* ------------------------------------------------------------------ */ -/* decContextSaveStatus -- save bits in current status */ -/* */ -/* context is the context structure to be queried */ -/* mask indicates the bits to be saved (the status bits that */ -/* correspond to each 1 bit in the mask are saved) */ -/* returns the AND of the mask and the current status */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -uInt decContextSaveStatus(decContext *context, uInt mask) { - return context->status&mask; - } // decContextSaveStatus - -/* ------------------------------------------------------------------ */ -/* decContextSetRounding -- set current rounding mode */ -/* */ -/* context is the context structure to be updated */ -/* newround is the value which will replace the current mode */ -/* returns context */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -decContext *decContextSetRounding(decContext *context, - enum rounding newround) { - context->round=newround; - return context; - } // decContextSetRounding - -/* ------------------------------------------------------------------ */ -/* decContextSetStatus -- set status and raise trap if appropriate */ -/* */ -/* context is the context structure to be updated */ -/* status is the DEC_ exception code */ -/* returns the context structure */ -/* */ -/* Control may never return from this routine, if there is a signal */ -/* handler and it takes a long jump. */ -/* ------------------------------------------------------------------ */ -decContext * decContextSetStatus(decContext *context, uInt status) { - context->status|=status; - if (status & context->traps) raise(SIGFPE); - return context;} // decContextSetStatus - -/* ------------------------------------------------------------------ */ -/* decContextSetStatusFromString -- set status from a string + trap */ -/* */ -/* context is the context structure to be updated */ -/* string is a string exactly equal to one that might be returned */ -/* by decContextStatusToString */ -/* */ -/* The status bit corresponding to the string is set, and a trap */ -/* is raised if appropriate. */ -/* */ -/* returns the context structure, unless the string is equal to */ -/* DEC_Condition_MU or is not recognized. In these cases NULL is */ -/* returned. */ -/* ------------------------------------------------------------------ */ -decContext * decContextSetStatusFromString(decContext *context, - const char *string) { - if (strcmp(string, DEC_Condition_CS)==0) - return decContextSetStatus(context, DEC_Conversion_syntax); - if (strcmp(string, DEC_Condition_DZ)==0) - return decContextSetStatus(context, DEC_Division_by_zero); - if (strcmp(string, DEC_Condition_DI)==0) - return decContextSetStatus(context, DEC_Division_impossible); - if (strcmp(string, DEC_Condition_DU)==0) - return decContextSetStatus(context, DEC_Division_undefined); - if (strcmp(string, DEC_Condition_IE)==0) - return decContextSetStatus(context, DEC_Inexact); - if (strcmp(string, DEC_Condition_IS)==0) - return decContextSetStatus(context, DEC_Insufficient_storage); - if (strcmp(string, DEC_Condition_IC)==0) - return decContextSetStatus(context, DEC_Invalid_context); - if (strcmp(string, DEC_Condition_IO)==0) - return decContextSetStatus(context, DEC_Invalid_operation); - #if DECSUBSET - if (strcmp(string, DEC_Condition_LD)==0) - return decContextSetStatus(context, DEC_Lost_digits); - #endif - if (strcmp(string, DEC_Condition_OV)==0) - return decContextSetStatus(context, DEC_Overflow); - if (strcmp(string, DEC_Condition_PA)==0) - return decContextSetStatus(context, DEC_Clamped); - if (strcmp(string, DEC_Condition_RO)==0) - return decContextSetStatus(context, DEC_Rounded); - if (strcmp(string, DEC_Condition_SU)==0) - return decContextSetStatus(context, DEC_Subnormal); - if (strcmp(string, DEC_Condition_UN)==0) - return decContextSetStatus(context, DEC_Underflow); - if (strcmp(string, DEC_Condition_ZE)==0) - return context; - return NULL; // Multiple status, or unknown - } // decContextSetStatusFromString - -/* ------------------------------------------------------------------ */ -/* decContextSetStatusFromStringQuiet -- set status from a string */ -/* */ -/* context is the context structure to be updated */ -/* string is a string exactly equal to one that might be returned */ -/* by decContextStatusToString */ -/* */ -/* The status bit corresponding to the string is set; no trap is */ -/* raised. */ -/* */ -/* returns the context structure, unless the string is equal to */ -/* DEC_Condition_MU or is not recognized. In these cases NULL is */ -/* returned. */ -/* ------------------------------------------------------------------ */ -decContext * decContextSetStatusFromStringQuiet(decContext *context, - const char *string) { - if (strcmp(string, DEC_Condition_CS)==0) - return decContextSetStatusQuiet(context, DEC_Conversion_syntax); - if (strcmp(string, DEC_Condition_DZ)==0) - return decContextSetStatusQuiet(context, DEC_Division_by_zero); - if (strcmp(string, DEC_Condition_DI)==0) - return decContextSetStatusQuiet(context, DEC_Division_impossible); - if (strcmp(string, DEC_Condition_DU)==0) - return decContextSetStatusQuiet(context, DEC_Division_undefined); - if (strcmp(string, DEC_Condition_IE)==0) - return decContextSetStatusQuiet(context, DEC_Inexact); - if (strcmp(string, DEC_Condition_IS)==0) - return decContextSetStatusQuiet(context, DEC_Insufficient_storage); - if (strcmp(string, DEC_Condition_IC)==0) - return decContextSetStatusQuiet(context, DEC_Invalid_context); - if (strcmp(string, DEC_Condition_IO)==0) - return decContextSetStatusQuiet(context, DEC_Invalid_operation); - #if DECSUBSET - if (strcmp(string, DEC_Condition_LD)==0) - return decContextSetStatusQuiet(context, DEC_Lost_digits); - #endif - if (strcmp(string, DEC_Condition_OV)==0) - return decContextSetStatusQuiet(context, DEC_Overflow); - if (strcmp(string, DEC_Condition_PA)==0) - return decContextSetStatusQuiet(context, DEC_Clamped); - if (strcmp(string, DEC_Condition_RO)==0) - return decContextSetStatusQuiet(context, DEC_Rounded); - if (strcmp(string, DEC_Condition_SU)==0) - return decContextSetStatusQuiet(context, DEC_Subnormal); - if (strcmp(string, DEC_Condition_UN)==0) - return decContextSetStatusQuiet(context, DEC_Underflow); - if (strcmp(string, DEC_Condition_ZE)==0) - return context; - return NULL; // Multiple status, or unknown - } // decContextSetStatusFromStringQuiet - -/* ------------------------------------------------------------------ */ -/* decContextSetStatusQuiet -- set status without trap */ -/* */ -/* context is the context structure to be updated */ -/* status is the DEC_ exception code */ -/* returns the context structure */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -decContext * decContextSetStatusQuiet(decContext *context, uInt status) { - context->status|=status; - return context;} // decContextSetStatusQuiet - -/* ------------------------------------------------------------------ */ -/* decContextStatusToString -- convert status flags to a string */ -/* */ -/* context is a context with valid status field */ -/* */ -/* returns a constant string describing the condition. If multiple */ -/* (or no) flags are set, a generic constant message is returned. */ -/* ------------------------------------------------------------------ */ -const char *decContextStatusToString(const decContext *context) { - Int status=context->status; - - // test the five IEEE first, as some of the others are ambiguous when - // DECEXTFLAG=0 - if (status==DEC_Invalid_operation ) return DEC_Condition_IO; - if (status==DEC_Division_by_zero ) return DEC_Condition_DZ; - if (status==DEC_Overflow ) return DEC_Condition_OV; - if (status==DEC_Underflow ) return DEC_Condition_UN; - if (status==DEC_Inexact ) return DEC_Condition_IE; - - if (status==DEC_Division_impossible ) return DEC_Condition_DI; - if (status==DEC_Division_undefined ) return DEC_Condition_DU; - if (status==DEC_Rounded ) return DEC_Condition_RO; - if (status==DEC_Clamped ) return DEC_Condition_PA; - if (status==DEC_Subnormal ) return DEC_Condition_SU; - if (status==DEC_Conversion_syntax ) return DEC_Condition_CS; - if (status==DEC_Insufficient_storage ) return DEC_Condition_IS; - if (status==DEC_Invalid_context ) return DEC_Condition_IC; - #if DECSUBSET - if (status==DEC_Lost_digits ) return DEC_Condition_LD; - #endif - if (status==0 ) return DEC_Condition_ZE; - return DEC_Condition_MU; // Multiple errors - } // decContextStatusToString - -/* ------------------------------------------------------------------ */ -/* decContextTestEndian -- test whether DECLITEND is set correctly */ -/* */ -/* quiet is 1 to suppress message; 0 otherwise */ -/* returns 0 if DECLITEND is correct */ -/* 1 if DECLITEND is incorrect and should be 1 */ -/* -1 if DECLITEND is incorrect and should be 0 */ -/* */ -/* A message is displayed if the return value is not 0 and quiet==0. */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -Int decContextTestEndian(Flag quiet) { - Int res=0; // optimist - uInt dle=(uInt)DECLITEND; // unsign - if (dle>1) dle=1; // ensure 0 or 1 - - if (LITEND!=DECLITEND) { - if (!quiet) { // always refer to this - #if DECPRINT - const char *adj; - if (LITEND) adj="little"; - else adj="big"; - printf("Warning: DECLITEND is set to %d, but this computer appears to be %s-endian\n", - DECLITEND, adj); - #endif - } - res=(Int)LITEND-dle; - } - return res; - } // decContextTestEndian - -/* ------------------------------------------------------------------ */ -/* decContextTestSavedStatus -- test bits in saved status */ -/* */ -/* oldstatus is the status word to be tested */ -/* mask indicates the bits to be tested (the oldstatus bits that */ -/* correspond to each 1 bit in the mask are tested) */ -/* returns 1 if any of the tested bits are 1, or 0 otherwise */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -uInt decContextTestSavedStatus(uInt oldstatus, uInt mask) { - return (oldstatus&mask)!=0; - } // decContextTestSavedStatus - -/* ------------------------------------------------------------------ */ -/* decContextTestStatus -- test bits in current status */ -/* */ -/* context is the context structure to be updated */ -/* mask indicates the bits to be tested (the status bits that */ -/* correspond to each 1 bit in the mask are tested) */ -/* returns 1 if any of the tested bits are 1, or 0 otherwise */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -uInt decContextTestStatus(decContext *context, uInt mask) { - return (context->status&mask)!=0; - } // decContextTestStatus - -/* ------------------------------------------------------------------ */ -/* decContextZeroStatus -- clear all status bits */ -/* */ -/* context is the context structure to be updated */ -/* returns context */ -/* */ -/* No error is possible. */ -/* ------------------------------------------------------------------ */ -decContext *decContextZeroStatus(decContext *context) { - context->status=0; - return context; - } // decContextZeroStatus - diff --git a/decnumber/src/decContext.h b/decnumber/src/decContext.h deleted file mode 100644 --- a/decnumber/src/decContext.h +++ /dev/null @@ -1,254 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* Decimal Context module header */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is called decNumber.pdf. This document is */ -/* available, together with arithmetic and format specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* */ -/* Context variables must always have valid values: */ -/* */ -/* status -- [any bits may be cleared, but not set, by user] */ -/* round -- must be one of the enumerated rounding modes */ -/* */ -/* The following variables are implied for fixed size formats (i.e., */ -/* they are ignored) but should still be set correctly in case used */ -/* with decNumber functions: */ -/* */ -/* clamp -- must be either 0 or 1 */ -/* digits -- must be in the range 1 through 999999999 */ -/* emax -- must be in the range 0 through 999999999 */ -/* emin -- must be in the range 0 through -999999999 */ -/* extended -- must be either 0 or 1 [present only if DECSUBSET] */ -/* traps -- only defined bits may be set */ -/* */ -/* ------------------------------------------------------------------ */ - -#if !defined(DECCONTEXT) - #define DECCONTEXT - #define DECCNAME "decContext" /* Short name */ - #define DECCFULLNAME "Decimal Context Descriptor" /* Verbose name */ - #define DECCAUTHOR "Mike Cowlishaw" /* Who to blame */ - - #if !defined(int32_t) - #include /* C99 standard integers */ - #endif - #include /* for printf, etc. */ - #include /* for traps */ - - /* Extended flags setting -- set this to 0 to use only IEEE flags */ - #if !defined(DECEXTFLAG) - #define DECEXTFLAG 1 /* 1=enable extended flags */ - #endif - - /* Conditional code flag -- set this to 0 for best performance */ - #if !defined(DECSUBSET) - #define DECSUBSET 0 /* 1=enable subset arithmetic */ - #endif - - /* Context for operations, with associated constants */ - enum rounding { - DEC_ROUND_CEILING, /* round towards +infinity */ - DEC_ROUND_UP, /* round away from 0 */ - DEC_ROUND_HALF_UP, /* 0.5 rounds up */ - DEC_ROUND_HALF_EVEN, /* 0.5 rounds to nearest even */ - DEC_ROUND_HALF_DOWN, /* 0.5 rounds down */ - DEC_ROUND_DOWN, /* round towards 0 (truncate) */ - DEC_ROUND_FLOOR, /* round towards -infinity */ - DEC_ROUND_05UP, /* round for reround */ - DEC_ROUND_MAX /* enum must be less than this */ - }; - #define DEC_ROUND_DEFAULT DEC_ROUND_HALF_EVEN; - - typedef struct { - int32_t digits; /* working precision */ - int32_t emax; /* maximum positive exponent */ - int32_t emin; /* minimum negative exponent */ - enum rounding round; /* rounding mode */ - uint32_t traps; /* trap-enabler flags */ - uint32_t status; /* status flags */ - uint8_t clamp; /* flag: apply IEEE exponent clamp */ - #if DECSUBSET - uint8_t extended; /* flag: special-values allowed */ - #endif - } decContext; - - /* Maxima and Minima for context settings */ - #define DEC_MAX_DIGITS 999999999 - #define DEC_MIN_DIGITS 1 - #define DEC_MAX_EMAX 999999999 - #define DEC_MIN_EMAX 0 - #define DEC_MAX_EMIN 0 - #define DEC_MIN_EMIN -999999999 - #define DEC_MAX_MATH 999999 /* max emax, etc., for math funcs. */ - - /* Classifications for decimal numbers, aligned with 754 (note that */ - /* 'normal' and 'subnormal' are meaningful only with a decContext */ - /* or a fixed size format). */ - enum decClass { - DEC_CLASS_SNAN, - DEC_CLASS_QNAN, - DEC_CLASS_NEG_INF, - DEC_CLASS_NEG_NORMAL, - DEC_CLASS_NEG_SUBNORMAL, - DEC_CLASS_NEG_ZERO, - DEC_CLASS_POS_ZERO, - DEC_CLASS_POS_SUBNORMAL, - DEC_CLASS_POS_NORMAL, - DEC_CLASS_POS_INF - }; - /* Strings for the decClasses */ - #define DEC_ClassString_SN "sNaN" - #define DEC_ClassString_QN "NaN" - #define DEC_ClassString_NI "-Infinity" - #define DEC_ClassString_NN "-Normal" - #define DEC_ClassString_NS "-Subnormal" - #define DEC_ClassString_NZ "-Zero" - #define DEC_ClassString_PZ "+Zero" - #define DEC_ClassString_PS "+Subnormal" - #define DEC_ClassString_PN "+Normal" - #define DEC_ClassString_PI "+Infinity" - #define DEC_ClassString_UN "Invalid" - - /* Trap-enabler and Status flags (exceptional conditions), and */ - /* their names. The top byte is reserved for internal use */ - #if DECEXTFLAG - /* Extended flags */ - #define DEC_Conversion_syntax 0x00000001 - #define DEC_Division_by_zero 0x00000002 - #define DEC_Division_impossible 0x00000004 - #define DEC_Division_undefined 0x00000008 - #define DEC_Insufficient_storage 0x00000010 /* [when malloc fails] */ - #define DEC_Inexact 0x00000020 - #define DEC_Invalid_context 0x00000040 - #define DEC_Invalid_operation 0x00000080 - #if DECSUBSET - #define DEC_Lost_digits 0x00000100 - #endif - #define DEC_Overflow 0x00000200 - #define DEC_Clamped 0x00000400 - #define DEC_Rounded 0x00000800 - #define DEC_Subnormal 0x00001000 - #define DEC_Underflow 0x00002000 - #else - /* IEEE flags only */ - #define DEC_Conversion_syntax 0x00000010 - #define DEC_Division_by_zero 0x00000002 - #define DEC_Division_impossible 0x00000010 - #define DEC_Division_undefined 0x00000010 - #define DEC_Insufficient_storage 0x00000010 /* [when malloc fails] */ - #define DEC_Inexact 0x00000001 - #define DEC_Invalid_context 0x00000010 - #define DEC_Invalid_operation 0x00000010 - #if DECSUBSET - #define DEC_Lost_digits 0x00000000 - #endif - #define DEC_Overflow 0x00000008 - #define DEC_Clamped 0x00000000 - #define DEC_Rounded 0x00000000 - #define DEC_Subnormal 0x00000000 - #define DEC_Underflow 0x00000004 - #endif - - /* IEEE 754 groupings for the flags */ - /* [DEC_Clamped, DEC_Lost_digits, DEC_Rounded, and DEC_Subnormal */ - /* are not in IEEE 754] */ - #define DEC_IEEE_754_Division_by_zero (DEC_Division_by_zero) - #if DECSUBSET - #define DEC_IEEE_754_Inexact (DEC_Inexact | DEC_Lost_digits) - #else - #define DEC_IEEE_754_Inexact (DEC_Inexact) - #endif - #define DEC_IEEE_754_Invalid_operation (DEC_Conversion_syntax | \ - DEC_Division_impossible | \ - DEC_Division_undefined | \ - DEC_Insufficient_storage | \ - DEC_Invalid_context | \ - DEC_Invalid_operation) - #define DEC_IEEE_754_Overflow (DEC_Overflow) - #define DEC_IEEE_754_Underflow (DEC_Underflow) - - /* flags which are normally errors (result is qNaN, infinite, or 0) */ - #define DEC_Errors (DEC_IEEE_754_Division_by_zero | \ - DEC_IEEE_754_Invalid_operation | \ - DEC_IEEE_754_Overflow | DEC_IEEE_754_Underflow) - /* flags which cause a result to become qNaN */ - #define DEC_NaNs DEC_IEEE_754_Invalid_operation - - /* flags which are normally for information only (finite results) */ - #if DECSUBSET - #define DEC_Information (DEC_Clamped | DEC_Rounded | DEC_Inexact \ - | DEC_Lost_digits) - #else - #define DEC_Information (DEC_Clamped | DEC_Rounded | DEC_Inexact) - #endif - - /* IEEE 854 names (for compatibility with older decNumber versions) */ - #define DEC_IEEE_854_Division_by_zero DEC_IEEE_754_Division_by_zero - #define DEC_IEEE_854_Inexact DEC_IEEE_754_Inexact - #define DEC_IEEE_854_Invalid_operation DEC_IEEE_754_Invalid_operation - #define DEC_IEEE_854_Overflow DEC_IEEE_754_Overflow - #define DEC_IEEE_854_Underflow DEC_IEEE_754_Underflow - - /* Name strings for the exceptional conditions */ - #define DEC_Condition_CS "Conversion syntax" - #define DEC_Condition_DZ "Division by zero" - #define DEC_Condition_DI "Division impossible" - #define DEC_Condition_DU "Division undefined" - #define DEC_Condition_IE "Inexact" - #define DEC_Condition_IS "Insufficient storage" - #define DEC_Condition_IC "Invalid context" - #define DEC_Condition_IO "Invalid operation" - #if DECSUBSET - #define DEC_Condition_LD "Lost digits" - #endif - #define DEC_Condition_OV "Overflow" - #define DEC_Condition_PA "Clamped" - #define DEC_Condition_RO "Rounded" - #define DEC_Condition_SU "Subnormal" - #define DEC_Condition_UN "Underflow" - #define DEC_Condition_ZE "No status" - #define DEC_Condition_MU "Multiple status" - #define DEC_Condition_Length 21 /* length of the longest string, */ - /* including terminator */ - - /* Initialization descriptors, used by decContextDefault */ - #define DEC_INIT_BASE 0 - #define DEC_INIT_DECIMAL32 32 - #define DEC_INIT_DECIMAL64 64 - #define DEC_INIT_DECIMAL128 128 - /* Synonyms */ - #define DEC_INIT_DECSINGLE DEC_INIT_DECIMAL32 - #define DEC_INIT_DECDOUBLE DEC_INIT_DECIMAL64 - #define DEC_INIT_DECQUAD DEC_INIT_DECIMAL128 - - /* decContext routines */ - extern decContext * decContextClearStatus(decContext *, uint32_t); - extern decContext * decContextDefault(decContext *, int32_t); - extern enum rounding decContextGetRounding(decContext *); - extern uint32_t decContextGetStatus(decContext *); - extern decContext * decContextRestoreStatus(decContext *, uint32_t, uint32_t); - extern uint32_t decContextSaveStatus(decContext *, uint32_t); - extern decContext * decContextSetRounding(decContext *, enum rounding); - extern decContext * decContextSetStatus(decContext *, uint32_t); - extern decContext * decContextSetStatusFromString(decContext *, const char *); - extern decContext * decContextSetStatusFromStringQuiet(decContext *, const char *); - extern decContext * decContextSetStatusQuiet(decContext *, uint32_t); - extern const char * decContextStatusToString(const decContext *); - extern int32_t decContextTestEndian(uint8_t); - extern uint32_t decContextTestSavedStatus(uint32_t, uint32_t); - extern uint32_t decContextTestStatus(decContext *, uint32_t); - extern decContext * decContextZeroStatus(decContext *); - -#endif diff --git a/decnumber/src/decDPD.h b/decnumber/src/decDPD.h deleted file mode 100644 --- a/decnumber/src/decDPD.h +++ /dev/null @@ -1,1185 +0,0 @@ -/* ------------------------------------------------------------------------ */ -/* Binary Coded Decimal and Densely Packed Decimal conversion lookup tables */ -/* [Automatically generated -- do not edit. 2008.06.21] */ -/* ------------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2008. All rights reserved. */ -/* ------------------------------------------------------------------------ */ -/* For details, see DPDecimal.html on the General Decimal Arithmetic page. */ -/* */ -/* This include file defines several DPD and BCD conversion tables: */ -/* */ -/* uint16_t BCD2DPD[2458]; -- BCD -> DPD (0x999 => 2457) */ -/* uint16_t BIN2DPD[1000]; -- Bin -> DPD (999 => 2457) */ -/* uint8_t BIN2CHAR[4001]; -- Bin -> CHAR (999 => '\3' '9' '9' '9') */ -/* uint8_t BIN2BCD8[4000]; -- Bin -> bytes (999 => 9 9 9 3) */ -/* uint16_t DPD2BCD[1024]; -- DPD -> BCD (0x3FF => 0x999) */ -/* uint16_t DPD2BIN[1024]; -- DPD -> BIN (0x3FF => 999) */ -/* uint32_t DPD2BINK[1024]; -- DPD -> BIN * 1000 (0x3FF => 999000) */ -/* uint32_t DPD2BINM[1024]; -- DPD -> BIN * 1E+6 (0x3FF => 999000000) */ -/* uint8_t DPD2BCD8[4096]; -- DPD -> bytes (x3FF => 9 9 9 3) */ -/* */ -/* In all cases the result (10 bits or 12 bits, or binary) is right-aligned */ -/* in the table entry. BIN2CHAR entries are a single byte length (0 for */ -/* value 0) followed by three digit characters; a trailing terminator is */ -/* included to allow 4-char moves always. BIN2BCD8 and DPD2BCD8 entries */ -/* are similar with the three BCD8 digits followed by a one-byte length */ -/* (again, length=0 for value 0). */ -/* */ -/* To use a table, its name, prefixed with DEC_, must be defined with a */ -/* value of 1 before this header file is included. For example: */ -/* #define DEC_BCD2DPD 1 */ -/* This mechanism allows software to only include tables that are needed. */ -/* ------------------------------------------------------------------------ */ - -#if defined(DEC_BCD2DPD) && DEC_BCD2DPD==1 && !defined(DECBCD2DPD) -#define DECBCD2DPD - -const uint16_t BCD2DPD[2458]={ 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 0, 0, 0, 0, 0, 0, 16, 17, 18, 19, 20, - 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 0, 0, 0, 0, 0, - 0, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 0, 0, - 0, 0, 0, 0, 64, 65, 66, 67, 68, 69, 70, 71, 72, - 73, 0, 0, 0, 0, 0, 0, 80, 81, 82, 83, 84, 85, - 86, 87, 88, 89, 0, 0, 0, 0, 0, 0, 96, 97, 98, - 99, 100, 101, 102, 103, 104, 105, 0, 0, 0, 0, 0, 0, - 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 0, 0, 0, - 0, 0, 0, 10, 11, 42, 43, 74, 75, 106, 107, 78, 79, - 0, 0, 0, 0, 0, 0, 26, 27, 58, 59, 90, 91, 122, - 123, 94, 95, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 0, 0, - 0, 0, 0, 0, 144, 145, 146, 147, 148, 149, 150, 151, 152, - 153, 0, 0, 0, 0, 0, 0, 160, 161, 162, 163, 164, 165, - 166, 167, 168, 169, 0, 0, 0, 0, 0, 0, 176, 177, 178, - 179, 180, 181, 182, 183, 184, 185, 0, 0, 0, 0, 0, 0, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 0, 0, 0, - 0, 0, 0, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, - 0, 0, 0, 0, 0, 0, 224, 225, 226, 227, 228, 229, 230, - 231, 232, 233, 0, 0, 0, 0, 0, 0, 240, 241, 242, 243, - 244, 245, 246, 247, 248, 249, 0, 0, 0, 0, 0, 0, 138, - 139, 170, 171, 202, 203, 234, 235, 206, 207, 0, 0, 0, 0, - 0, 0, 154, 155, 186, 187, 218, 219, 250, 251, 222, 223, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 256, 257, 258, - 259, 260, 261, 262, 263, 264, 265, 0, 0, 0, 0, 0, 0, - 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 0, 0, 0, - 0, 0, 0, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, - 0, 0, 0, 0, 0, 0, 304, 305, 306, 307, 308, 309, 310, - 311, 312, 313, 0, 0, 0, 0, 0, 0, 320, 321, 322, 323, - 324, 325, 326, 327, 328, 329, 0, 0, 0, 0, 0, 0, 336, - 337, 338, 339, 340, 341, 342, 343, 344, 345, 0, 0, 0, 0, - 0, 0, 352, 353, 354, 355, 356, 357, 358, 359, 360, 361, 0, - 0, 0, 0, 0, 0, 368, 369, 370, 371, 372, 373, 374, 375, - 376, 377, 0, 0, 0, 0, 0, 0, 266, 267, 298, 299, 330, - 331, 362, 363, 334, 335, 0, 0, 0, 0, 0, 0, 282, 283, - 314, 315, 346, 347, 378, 379, 350, 351, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 384, 385, 386, 387, 388, 389, 390, - 391, 392, 393, 0, 0, 0, 0, 0, 0, 400, 401, 402, 403, - 404, 405, 406, 407, 408, 409, 0, 0, 0, 0, 0, 0, 416, - 417, 418, 419, 420, 421, 422, 423, 424, 425, 0, 0, 0, 0, - 0, 0, 432, 433, 434, 435, 436, 437, 438, 439, 440, 441, 0, - 0, 0, 0, 0, 0, 448, 449, 450, 451, 452, 453, 454, 455, - 456, 457, 0, 0, 0, 0, 0, 0, 464, 465, 466, 467, 468, - 469, 470, 471, 472, 473, 0, 0, 0, 0, 0, 0, 480, 481, - 482, 483, 484, 485, 486, 487, 488, 489, 0, 0, 0, 0, 0, - 0, 496, 497, 498, 499, 500, 501, 502, 503, 504, 505, 0, 0, - 0, 0, 0, 0, 394, 395, 426, 427, 458, 459, 490, 491, 462, - 463, 0, 0, 0, 0, 0, 0, 410, 411, 442, 443, 474, 475, - 506, 507, 478, 479, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 512, 513, 514, 515, 516, 517, 518, 519, 520, 521, 0, - 0, 0, 0, 0, 0, 528, 529, 530, 531, 532, 533, 534, 535, - 536, 537, 0, 0, 0, 0, 0, 0, 544, 545, 546, 547, 548, - 549, 550, 551, 552, 553, 0, 0, 0, 0, 0, 0, 560, 561, - 562, 563, 564, 565, 566, 567, 568, 569, 0, 0, 0, 0, 0, - 0, 576, 577, 578, 579, 580, 581, 582, 583, 584, 585, 0, 0, - 0, 0, 0, 0, 592, 593, 594, 595, 596, 597, 598, 599, 600, - 601, 0, 0, 0, 0, 0, 0, 608, 609, 610, 611, 612, 613, - 614, 615, 616, 617, 0, 0, 0, 0, 0, 0, 624, 625, 626, - 627, 628, 629, 630, 631, 632, 633, 0, 0, 0, 0, 0, 0, - 522, 523, 554, 555, 586, 587, 618, 619, 590, 591, 0, 0, 0, - 0, 0, 0, 538, 539, 570, 571, 602, 603, 634, 635, 606, 607, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 640, 641, - 642, 643, 644, 645, 646, 647, 648, 649, 0, 0, 0, 0, 0, - 0, 656, 657, 658, 659, 660, 661, 662, 663, 664, 665, 0, 0, - 0, 0, 0, 0, 672, 673, 674, 675, 676, 677, 678, 679, 680, - 681, 0, 0, 0, 0, 0, 0, 688, 689, 690, 691, 692, 693, - 694, 695, 696, 697, 0, 0, 0, 0, 0, 0, 704, 705, 706, - 707, 708, 709, 710, 711, 712, 713, 0, 0, 0, 0, 0, 0, - 720, 721, 722, 723, 724, 725, 726, 727, 728, 729, 0, 0, 0, - 0, 0, 0, 736, 737, 738, 739, 740, 741, 742, 743, 744, 745, - 0, 0, 0, 0, 0, 0, 752, 753, 754, 755, 756, 757, 758, - 759, 760, 761, 0, 0, 0, 0, 0, 0, 650, 651, 682, 683, - 714, 715, 746, 747, 718, 719, 0, 0, 0, 0, 0, 0, 666, - 667, 698, 699, 730, 731, 762, 763, 734, 735, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 768, 769, 770, 771, 772, 773, - 774, 775, 776, 777, 0, 0, 0, 0, 0, 0, 784, 785, 786, - 787, 788, 789, 790, 791, 792, 793, 0, 0, 0, 0, 0, 0, - 800, 801, 802, 803, 804, 805, 806, 807, 808, 809, 0, 0, 0, - 0, 0, 0, 816, 817, 818, 819, 820, 821, 822, 823, 824, 825, - 0, 0, 0, 0, 0, 0, 832, 833, 834, 835, 836, 837, 838, - 839, 840, 841, 0, 0, 0, 0, 0, 0, 848, 849, 850, 851, - 852, 853, 854, 855, 856, 857, 0, 0, 0, 0, 0, 0, 864, - 865, 866, 867, 868, 869, 870, 871, 872, 873, 0, 0, 0, 0, - 0, 0, 880, 881, 882, 883, 884, 885, 886, 887, 888, 889, 0, - 0, 0, 0, 0, 0, 778, 779, 810, 811, 842, 843, 874, 875, - 846, 847, 0, 0, 0, 0, 0, 0, 794, 795, 826, 827, 858, - 859, 890, 891, 862, 863, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 896, 897, 898, 899, 900, 901, 902, 903, 904, 905, - 0, 0, 0, 0, 0, 0, 912, 913, 914, 915, 916, 917, 918, - 919, 920, 921, 0, 0, 0, 0, 0, 0, 928, 929, 930, 931, - 932, 933, 934, 935, 936, 937, 0, 0, 0, 0, 0, 0, 944, - 945, 946, 947, 948, 949, 950, 951, 952, 953, 0, 0, 0, 0, - 0, 0, 960, 961, 962, 963, 964, 965, 966, 967, 968, 969, 0, - 0, 0, 0, 0, 0, 976, 977, 978, 979, 980, 981, 982, 983, - 984, 985, 0, 0, 0, 0, 0, 0, 992, 993, 994, 995, 996, - 997, 998, 999, 1000, 1001, 0, 0, 0, 0, 0, 0, 1008, 1009, - 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017, 0, 0, 0, 0, 0, - 0, 906, 907, 938, 939, 970, 971, 1002, 1003, 974, 975, 0, 0, - 0, 0, 0, 0, 922, 923, 954, 955, 986, 987, 1018, 1019, 990, - 991, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 12, - 13, 268, 269, 524, 525, 780, 781, 46, 47, 0, 0, 0, 0, - 0, 0, 28, 29, 284, 285, 540, 541, 796, 797, 62, 63, 0, - 0, 0, 0, 0, 0, 44, 45, 300, 301, 556, 557, 812, 813, - 302, 303, 0, 0, 0, 0, 0, 0, 60, 61, 316, 317, 572, - 573, 828, 829, 318, 319, 0, 0, 0, 0, 0, 0, 76, 77, - 332, 333, 588, 589, 844, 845, 558, 559, 0, 0, 0, 0, 0, - 0, 92, 93, 348, 349, 604, 605, 860, 861, 574, 575, 0, 0, - 0, 0, 0, 0, 108, 109, 364, 365, 620, 621, 876, 877, 814, - 815, 0, 0, 0, 0, 0, 0, 124, 125, 380, 381, 636, 637, - 892, 893, 830, 831, 0, 0, 0, 0, 0, 0, 14, 15, 270, - 271, 526, 527, 782, 783, 110, 111, 0, 0, 0, 0, 0, 0, - 30, 31, 286, 287, 542, 543, 798, 799, 126, 127, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 140, 141, 396, 397, 652, - 653, 908, 909, 174, 175, 0, 0, 0, 0, 0, 0, 156, 157, - 412, 413, 668, 669, 924, 925, 190, 191, 0, 0, 0, 0, 0, - 0, 172, 173, 428, 429, 684, 685, 940, 941, 430, 431, 0, 0, - 0, 0, 0, 0, 188, 189, 444, 445, 700, 701, 956, 957, 446, - 447, 0, 0, 0, 0, 0, 0, 204, 205, 460, 461, 716, 717, - 972, 973, 686, 687, 0, 0, 0, 0, 0, 0, 220, 221, 476, - 477, 732, 733, 988, 989, 702, 703, 0, 0, 0, 0, 0, 0, - 236, 237, 492, 493, 748, 749, 1004, 1005, 942, 943, 0, 0, 0, - 0, 0, 0, 252, 253, 508, 509, 764, 765, 1020, 1021, 958, 959, - 0, 0, 0, 0, 0, 0, 142, 143, 398, 399, 654, 655, 910, - 911, 238, 239, 0, 0, 0, 0, 0, 0, 158, 159, 414, 415, - 670, 671, 926, 927, 254, 255}; -#endif - -#if defined(DEC_DPD2BCD) && DEC_DPD2BCD==1 && !defined(DECDPD2BCD) -#define DECDPD2BCD - -const uint16_t DPD2BCD[1024]={ 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 128, 129, 2048, 2049, 2176, 2177, 16, 17, 18, 19, 20, - 21, 22, 23, 24, 25, 144, 145, 2064, 2065, 2192, 2193, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 130, 131, 2080, 2081, 2056, - 2057, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 146, 147, - 2096, 2097, 2072, 2073, 64, 65, 66, 67, 68, 69, 70, 71, 72, - 73, 132, 133, 2112, 2113, 136, 137, 80, 81, 82, 83, 84, 85, - 86, 87, 88, 89, 148, 149, 2128, 2129, 152, 153, 96, 97, 98, - 99, 100, 101, 102, 103, 104, 105, 134, 135, 2144, 2145, 2184, 2185, - 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 150, 151, 2160, - 2161, 2200, 2201, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, - 384, 385, 2304, 2305, 2432, 2433, 272, 273, 274, 275, 276, 277, 278, - 279, 280, 281, 400, 401, 2320, 2321, 2448, 2449, 288, 289, 290, 291, - 292, 293, 294, 295, 296, 297, 386, 387, 2336, 2337, 2312, 2313, 304, - 305, 306, 307, 308, 309, 310, 311, 312, 313, 402, 403, 2352, 2353, - 2328, 2329, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 388, - 389, 2368, 2369, 392, 393, 336, 337, 338, 339, 340, 341, 342, 343, - 344, 345, 404, 405, 2384, 2385, 408, 409, 352, 353, 354, 355, 356, - 357, 358, 359, 360, 361, 390, 391, 2400, 2401, 2440, 2441, 368, 369, - 370, 371, 372, 373, 374, 375, 376, 377, 406, 407, 2416, 2417, 2456, - 2457, 512, 513, 514, 515, 516, 517, 518, 519, 520, 521, 640, 641, - 2050, 2051, 2178, 2179, 528, 529, 530, 531, 532, 533, 534, 535, 536, - 537, 656, 657, 2066, 2067, 2194, 2195, 544, 545, 546, 547, 548, 549, - 550, 551, 552, 553, 642, 643, 2082, 2083, 2088, 2089, 560, 561, 562, - 563, 564, 565, 566, 567, 568, 569, 658, 659, 2098, 2099, 2104, 2105, - 576, 577, 578, 579, 580, 581, 582, 583, 584, 585, 644, 645, 2114, - 2115, 648, 649, 592, 593, 594, 595, 596, 597, 598, 599, 600, 601, - 660, 661, 2130, 2131, 664, 665, 608, 609, 610, 611, 612, 613, 614, - 615, 616, 617, 646, 647, 2146, 2147, 2184, 2185, 624, 625, 626, 627, - 628, 629, 630, 631, 632, 633, 662, 663, 2162, 2163, 2200, 2201, 768, - 769, 770, 771, 772, 773, 774, 775, 776, 777, 896, 897, 2306, 2307, - 2434, 2435, 784, 785, 786, 787, 788, 789, 790, 791, 792, 793, 912, - 913, 2322, 2323, 2450, 2451, 800, 801, 802, 803, 804, 805, 806, 807, - 808, 809, 898, 899, 2338, 2339, 2344, 2345, 816, 817, 818, 819, 820, - 821, 822, 823, 824, 825, 914, 915, 2354, 2355, 2360, 2361, 832, 833, - 834, 835, 836, 837, 838, 839, 840, 841, 900, 901, 2370, 2371, 904, - 905, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 916, 917, - 2386, 2387, 920, 921, 864, 865, 866, 867, 868, 869, 870, 871, 872, - 873, 902, 903, 2402, 2403, 2440, 2441, 880, 881, 882, 883, 884, 885, - 886, 887, 888, 889, 918, 919, 2418, 2419, 2456, 2457, 1024, 1025, 1026, - 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1152, 1153, 2052, 2053, 2180, 2181, - 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, 1048, 1049, 1168, 1169, 2068, - 2069, 2196, 2197, 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1063, 1064, 1065, - 1154, 1155, 2084, 2085, 2120, 2121, 1072, 1073, 1074, 1075, 1076, 1077, 1078, - 1079, 1080, 1081, 1170, 1171, 2100, 2101, 2136, 2137, 1088, 1089, 1090, 1091, - 1092, 1093, 1094, 1095, 1096, 1097, 1156, 1157, 2116, 2117, 1160, 1161, 1104, - 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1172, 1173, 2132, 2133, - 1176, 1177, 1120, 1121, 1122, 1123, 1124, 1125, 1126, 1127, 1128, 1129, 1158, - 1159, 2148, 2149, 2184, 2185, 1136, 1137, 1138, 1139, 1140, 1141, 1142, 1143, - 1144, 1145, 1174, 1175, 2164, 2165, 2200, 2201, 1280, 1281, 1282, 1283, 1284, - 1285, 1286, 1287, 1288, 1289, 1408, 1409, 2308, 2309, 2436, 2437, 1296, 1297, - 1298, 1299, 1300, 1301, 1302, 1303, 1304, 1305, 1424, 1425, 2324, 2325, 2452, - 2453, 1312, 1313, 1314, 1315, 1316, 1317, 1318, 1319, 1320, 1321, 1410, 1411, - 2340, 2341, 2376, 2377, 1328, 1329, 1330, 1331, 1332, 1333, 1334, 1335, 1336, - 1337, 1426, 1427, 2356, 2357, 2392, 2393, 1344, 1345, 1346, 1347, 1348, 1349, - 1350, 1351, 1352, 1353, 1412, 1413, 2372, 2373, 1416, 1417, 1360, 1361, 1362, - 1363, 1364, 1365, 1366, 1367, 1368, 1369, 1428, 1429, 2388, 2389, 1432, 1433, - 1376, 1377, 1378, 1379, 1380, 1381, 1382, 1383, 1384, 1385, 1414, 1415, 2404, - 2405, 2440, 2441, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, - 1430, 1431, 2420, 2421, 2456, 2457, 1536, 1537, 1538, 1539, 1540, 1541, 1542, - 1543, 1544, 1545, 1664, 1665, 2054, 2055, 2182, 2183, 1552, 1553, 1554, 1555, - 1556, 1557, 1558, 1559, 1560, 1561, 1680, 1681, 2070, 2071, 2198, 2199, 1568, - 1569, 1570, 1571, 1572, 1573, 1574, 1575, 1576, 1577, 1666, 1667, 2086, 2087, - 2152, 2153, 1584, 1585, 1586, 1587, 1588, 1589, 1590, 1591, 1592, 1593, 1682, - 1683, 2102, 2103, 2168, 2169, 1600, 1601, 1602, 1603, 1604, 1605, 1606, 1607, - 1608, 1609, 1668, 1669, 2118, 2119, 1672, 1673, 1616, 1617, 1618, 1619, 1620, - 1621, 1622, 1623, 1624, 1625, 1684, 1685, 2134, 2135, 1688, 1689, 1632, 1633, - 1634, 1635, 1636, 1637, 1638, 1639, 1640, 1641, 1670, 1671, 2150, 2151, 2184, - 2185, 1648, 1649, 1650, 1651, 1652, 1653, 1654, 1655, 1656, 1657, 1686, 1687, - 2166, 2167, 2200, 2201, 1792, 1793, 1794, 1795, 1796, 1797, 1798, 1799, 1800, - 1801, 1920, 1921, 2310, 2311, 2438, 2439, 1808, 1809, 1810, 1811, 1812, 1813, - 1814, 1815, 1816, 1817, 1936, 1937, 2326, 2327, 2454, 2455, 1824, 1825, 1826, - 1827, 1828, 1829, 1830, 1831, 1832, 1833, 1922, 1923, 2342, 2343, 2408, 2409, - 1840, 1841, 1842, 1843, 1844, 1845, 1846, 1847, 1848, 1849, 1938, 1939, 2358, - 2359, 2424, 2425, 1856, 1857, 1858, 1859, 1860, 1861, 1862, 1863, 1864, 1865, - 1924, 1925, 2374, 2375, 1928, 1929, 1872, 1873, 1874, 1875, 1876, 1877, 1878, - 1879, 1880, 1881, 1940, 1941, 2390, 2391, 1944, 1945, 1888, 1889, 1890, 1891, - 1892, 1893, 1894, 1895, 1896, 1897, 1926, 1927, 2406, 2407, 2440, 2441, 1904, - 1905, 1906, 1907, 1908, 1909, 1910, 1911, 1912, 1913, 1942, 1943, 2422, 2423, - 2456, 2457}; -#endif - -#if defined(DEC_BIN2DPD) && DEC_BIN2DPD==1 && !defined(DECBIN2DPD) -#define DECBIN2DPD - -const uint16_t BIN2DPD[1000]={ 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 48, 49, 50, 51, - 52, 53, 54, 55, 56, 57, 64, 65, 66, 67, 68, 69, 70, - 71, 72, 73, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, - 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 112, 113, 114, - 115, 116, 117, 118, 119, 120, 121, 10, 11, 42, 43, 74, 75, - 106, 107, 78, 79, 26, 27, 58, 59, 90, 91, 122, 123, 94, - 95, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 144, 145, - 146, 147, 148, 149, 150, 151, 152, 153, 160, 161, 162, 163, 164, - 165, 166, 167, 168, 169, 176, 177, 178, 179, 180, 181, 182, 183, - 184, 185, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 208, - 209, 210, 211, 212, 213, 214, 215, 216, 217, 224, 225, 226, 227, - 228, 229, 230, 231, 232, 233, 240, 241, 242, 243, 244, 245, 246, - 247, 248, 249, 138, 139, 170, 171, 202, 203, 234, 235, 206, 207, - 154, 155, 186, 187, 218, 219, 250, 251, 222, 223, 256, 257, 258, - 259, 260, 261, 262, 263, 264, 265, 272, 273, 274, 275, 276, 277, - 278, 279, 280, 281, 288, 289, 290, 291, 292, 293, 294, 295, 296, - 297, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 320, 321, - 322, 323, 324, 325, 326, 327, 328, 329, 336, 337, 338, 339, 340, - 341, 342, 343, 344, 345, 352, 353, 354, 355, 356, 357, 358, 359, - 360, 361, 368, 369, 370, 371, 372, 373, 374, 375, 376, 377, 266, - 267, 298, 299, 330, 331, 362, 363, 334, 335, 282, 283, 314, 315, - 346, 347, 378, 379, 350, 351, 384, 385, 386, 387, 388, 389, 390, - 391, 392, 393, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, - 416, 417, 418, 419, 420, 421, 422, 423, 424, 425, 432, 433, 434, - 435, 436, 437, 438, 439, 440, 441, 448, 449, 450, 451, 452, 453, - 454, 455, 456, 457, 464, 465, 466, 467, 468, 469, 470, 471, 472, - 473, 480, 481, 482, 483, 484, 485, 486, 487, 488, 489, 496, 497, - 498, 499, 500, 501, 502, 503, 504, 505, 394, 395, 426, 427, 458, - 459, 490, 491, 462, 463, 410, 411, 442, 443, 474, 475, 506, 507, - 478, 479, 512, 513, 514, 515, 516, 517, 518, 519, 520, 521, 528, - 529, 530, 531, 532, 533, 534, 535, 536, 537, 544, 545, 546, 547, - 548, 549, 550, 551, 552, 553, 560, 561, 562, 563, 564, 565, 566, - 567, 568, 569, 576, 577, 578, 579, 580, 581, 582, 583, 584, 585, - 592, 593, 594, 595, 596, 597, 598, 599, 600, 601, 608, 609, 610, - 611, 612, 613, 614, 615, 616, 617, 624, 625, 626, 627, 628, 629, - 630, 631, 632, 633, 522, 523, 554, 555, 586, 587, 618, 619, 590, - 591, 538, 539, 570, 571, 602, 603, 634, 635, 606, 607, 640, 641, - 642, 643, 644, 645, 646, 647, 648, 649, 656, 657, 658, 659, 660, - 661, 662, 663, 664, 665, 672, 673, 674, 675, 676, 677, 678, 679, - 680, 681, 688, 689, 690, 691, 692, 693, 694, 695, 696, 697, 704, - 705, 706, 707, 708, 709, 710, 711, 712, 713, 720, 721, 722, 723, - 724, 725, 726, 727, 728, 729, 736, 737, 738, 739, 740, 741, 742, - 743, 744, 745, 752, 753, 754, 755, 756, 757, 758, 759, 760, 761, - 650, 651, 682, 683, 714, 715, 746, 747, 718, 719, 666, 667, 698, - 699, 730, 731, 762, 763, 734, 735, 768, 769, 770, 771, 772, 773, - 774, 775, 776, 777, 784, 785, 786, 787, 788, 789, 790, 791, 792, - 793, 800, 801, 802, 803, 804, 805, 806, 807, 808, 809, 816, 817, - 818, 819, 820, 821, 822, 823, 824, 825, 832, 833, 834, 835, 836, - 837, 838, 839, 840, 841, 848, 849, 850, 851, 852, 853, 854, 855, - 856, 857, 864, 865, 866, 867, 868, 869, 870, 871, 872, 873, 880, - 881, 882, 883, 884, 885, 886, 887, 888, 889, 778, 779, 810, 811, - 842, 843, 874, 875, 846, 847, 794, 795, 826, 827, 858, 859, 890, - 891, 862, 863, 896, 897, 898, 899, 900, 901, 902, 903, 904, 905, - 912, 913, 914, 915, 916, 917, 918, 919, 920, 921, 928, 929, 930, - 931, 932, 933, 934, 935, 936, 937, 944, 945, 946, 947, 948, 949, - 950, 951, 952, 953, 960, 961, 962, 963, 964, 965, 966, 967, 968, - 969, 976, 977, 978, 979, 980, 981, 982, 983, 984, 985, 992, 993, - 994, 995, 996, 997, 998, 999, 1000, 1001, 1008, 1009, 1010, 1011, 1012, - 1013, 1014, 1015, 1016, 1017, 906, 907, 938, 939, 970, 971, 1002, 1003, - 974, 975, 922, 923, 954, 955, 986, 987, 1018, 1019, 990, 991, 12, - 13, 268, 269, 524, 525, 780, 781, 46, 47, 28, 29, 284, 285, - 540, 541, 796, 797, 62, 63, 44, 45, 300, 301, 556, 557, 812, - 813, 302, 303, 60, 61, 316, 317, 572, 573, 828, 829, 318, 319, - 76, 77, 332, 333, 588, 589, 844, 845, 558, 559, 92, 93, 348, - 349, 604, 605, 860, 861, 574, 575, 108, 109, 364, 365, 620, 621, - 876, 877, 814, 815, 124, 125, 380, 381, 636, 637, 892, 893, 830, - 831, 14, 15, 270, 271, 526, 527, 782, 783, 110, 111, 30, 31, - 286, 287, 542, 543, 798, 799, 126, 127, 140, 141, 396, 397, 652, - 653, 908, 909, 174, 175, 156, 157, 412, 413, 668, 669, 924, 925, - 190, 191, 172, 173, 428, 429, 684, 685, 940, 941, 430, 431, 188, - 189, 444, 445, 700, 701, 956, 957, 446, 447, 204, 205, 460, 461, - 716, 717, 972, 973, 686, 687, 220, 221, 476, 477, 732, 733, 988, - 989, 702, 703, 236, 237, 492, 493, 748, 749, 1004, 1005, 942, 943, - 252, 253, 508, 509, 764, 765, 1020, 1021, 958, 959, 142, 143, 398, - 399, 654, 655, 910, 911, 238, 239, 158, 159, 414, 415, 670, 671, - 926, 927, 254, 255}; -#endif - -#if defined(DEC_DPD2BIN) && DEC_DPD2BIN==1 && !defined(DECDPD2BIN) -#define DECDPD2BIN - -const uint16_t DPD2BIN[1024]={ 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 80, 81, 800, 801, 880, 881, 10, 11, 12, 13, 14, - 15, 16, 17, 18, 19, 90, 91, 810, 811, 890, 891, 20, 21, - 22, 23, 24, 25, 26, 27, 28, 29, 82, 83, 820, 821, 808, - 809, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 92, 93, - 830, 831, 818, 819, 40, 41, 42, 43, 44, 45, 46, 47, 48, - 49, 84, 85, 840, 841, 88, 89, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 94, 95, 850, 851, 98, 99, 60, 61, 62, - 63, 64, 65, 66, 67, 68, 69, 86, 87, 860, 861, 888, 889, - 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 96, 97, 870, - 871, 898, 899, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, - 180, 181, 900, 901, 980, 981, 110, 111, 112, 113, 114, 115, 116, - 117, 118, 119, 190, 191, 910, 911, 990, 991, 120, 121, 122, 123, - 124, 125, 126, 127, 128, 129, 182, 183, 920, 921, 908, 909, 130, - 131, 132, 133, 134, 135, 136, 137, 138, 139, 192, 193, 930, 931, - 918, 919, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 184, - 185, 940, 941, 188, 189, 150, 151, 152, 153, 154, 155, 156, 157, - 158, 159, 194, 195, 950, 951, 198, 199, 160, 161, 162, 163, 164, - 165, 166, 167, 168, 169, 186, 187, 960, 961, 988, 989, 170, 171, - 172, 173, 174, 175, 176, 177, 178, 179, 196, 197, 970, 971, 998, - 999, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 280, 281, - 802, 803, 882, 883, 210, 211, 212, 213, 214, 215, 216, 217, 218, - 219, 290, 291, 812, 813, 892, 893, 220, 221, 222, 223, 224, 225, - 226, 227, 228, 229, 282, 283, 822, 823, 828, 829, 230, 231, 232, - 233, 234, 235, 236, 237, 238, 239, 292, 293, 832, 833, 838, 839, - 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 284, 285, 842, - 843, 288, 289, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, - 294, 295, 852, 853, 298, 299, 260, 261, 262, 263, 264, 265, 266, - 267, 268, 269, 286, 287, 862, 863, 888, 889, 270, 271, 272, 273, - 274, 275, 276, 277, 278, 279, 296, 297, 872, 873, 898, 899, 300, - 301, 302, 303, 304, 305, 306, 307, 308, 309, 380, 381, 902, 903, - 982, 983, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 390, - 391, 912, 913, 992, 993, 320, 321, 322, 323, 324, 325, 326, 327, - 328, 329, 382, 383, 922, 923, 928, 929, 330, 331, 332, 333, 334, - 335, 336, 337, 338, 339, 392, 393, 932, 933, 938, 939, 340, 341, - 342, 343, 344, 345, 346, 347, 348, 349, 384, 385, 942, 943, 388, - 389, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 394, 395, - 952, 953, 398, 399, 360, 361, 362, 363, 364, 365, 366, 367, 368, - 369, 386, 387, 962, 963, 988, 989, 370, 371, 372, 373, 374, 375, - 376, 377, 378, 379, 396, 397, 972, 973, 998, 999, 400, 401, 402, - 403, 404, 405, 406, 407, 408, 409, 480, 481, 804, 805, 884, 885, - 410, 411, 412, 413, 414, 415, 416, 417, 418, 419, 490, 491, 814, - 815, 894, 895, 420, 421, 422, 423, 424, 425, 426, 427, 428, 429, - 482, 483, 824, 825, 848, 849, 430, 431, 432, 433, 434, 435, 436, - 437, 438, 439, 492, 493, 834, 835, 858, 859, 440, 441, 442, 443, - 444, 445, 446, 447, 448, 449, 484, 485, 844, 845, 488, 489, 450, - 451, 452, 453, 454, 455, 456, 457, 458, 459, 494, 495, 854, 855, - 498, 499, 460, 461, 462, 463, 464, 465, 466, 467, 468, 469, 486, - 487, 864, 865, 888, 889, 470, 471, 472, 473, 474, 475, 476, 477, - 478, 479, 496, 497, 874, 875, 898, 899, 500, 501, 502, 503, 504, - 505, 506, 507, 508, 509, 580, 581, 904, 905, 984, 985, 510, 511, - 512, 513, 514, 515, 516, 517, 518, 519, 590, 591, 914, 915, 994, - 995, 520, 521, 522, 523, 524, 525, 526, 527, 528, 529, 582, 583, - 924, 925, 948, 949, 530, 531, 532, 533, 534, 535, 536, 537, 538, - 539, 592, 593, 934, 935, 958, 959, 540, 541, 542, 543, 544, 545, - 546, 547, 548, 549, 584, 585, 944, 945, 588, 589, 550, 551, 552, - 553, 554, 555, 556, 557, 558, 559, 594, 595, 954, 955, 598, 599, - 560, 561, 562, 563, 564, 565, 566, 567, 568, 569, 586, 587, 964, - 965, 988, 989, 570, 571, 572, 573, 574, 575, 576, 577, 578, 579, - 596, 597, 974, 975, 998, 999, 600, 601, 602, 603, 604, 605, 606, - 607, 608, 609, 680, 681, 806, 807, 886, 887, 610, 611, 612, 613, - 614, 615, 616, 617, 618, 619, 690, 691, 816, 817, 896, 897, 620, - 621, 622, 623, 624, 625, 626, 627, 628, 629, 682, 683, 826, 827, - 868, 869, 630, 631, 632, 633, 634, 635, 636, 637, 638, 639, 692, - 693, 836, 837, 878, 879, 640, 641, 642, 643, 644, 645, 646, 647, - 648, 649, 684, 685, 846, 847, 688, 689, 650, 651, 652, 653, 654, - 655, 656, 657, 658, 659, 694, 695, 856, 857, 698, 699, 660, 661, - 662, 663, 664, 665, 666, 667, 668, 669, 686, 687, 866, 867, 888, - 889, 670, 671, 672, 673, 674, 675, 676, 677, 678, 679, 696, 697, - 876, 877, 898, 899, 700, 701, 702, 703, 704, 705, 706, 707, 708, - 709, 780, 781, 906, 907, 986, 987, 710, 711, 712, 713, 714, 715, - 716, 717, 718, 719, 790, 791, 916, 917, 996, 997, 720, 721, 722, - 723, 724, 725, 726, 727, 728, 729, 782, 783, 926, 927, 968, 969, - 730, 731, 732, 733, 734, 735, 736, 737, 738, 739, 792, 793, 936, - 937, 978, 979, 740, 741, 742, 743, 744, 745, 746, 747, 748, 749, - 784, 785, 946, 947, 788, 789, 750, 751, 752, 753, 754, 755, 756, - 757, 758, 759, 794, 795, 956, 957, 798, 799, 760, 761, 762, 763, - 764, 765, 766, 767, 768, 769, 786, 787, 966, 967, 988, 989, 770, - 771, 772, 773, 774, 775, 776, 777, 778, 779, 796, 797, 976, 977, - 998, 999}; -#endif - -#if defined(DEC_DPD2BINK) && DEC_DPD2BINK==1 && !defined(DECDPD2BINK) -#define DECDPD2BINK - -const uint32_t DPD2BINK[1024]={ 0, 1000, 2000, 3000, 4000, 5000, - 6000, 7000, 8000, 9000, 80000, 81000, 800000, 801000, 880000, 881000, - 10000, 11000, 12000, 13000, 14000, 15000, 16000, 17000, 18000, 19000, - 90000, 91000, 810000, 811000, 890000, 891000, 20000, 21000, 22000, 23000, - 24000, 25000, 26000, 27000, 28000, 29000, 82000, 83000, 820000, 821000, - 808000, 809000, 30000, 31000, 32000, 33000, 34000, 35000, 36000, 37000, - 38000, 39000, 92000, 93000, 830000, 831000, 818000, 819000, 40000, 41000, - 42000, 43000, 44000, 45000, 46000, 47000, 48000, 49000, 84000, 85000, - 840000, 841000, 88000, 89000, 50000, 51000, 52000, 53000, 54000, 55000, - 56000, 57000, 58000, 59000, 94000, 95000, 850000, 851000, 98000, 99000, - 60000, 61000, 62000, 63000, 64000, 65000, 66000, 67000, 68000, 69000, - 86000, 87000, 860000, 861000, 888000, 889000, 70000, 71000, 72000, 73000, - 74000, 75000, 76000, 77000, 78000, 79000, 96000, 97000, 870000, 871000, - 898000, 899000, 100000, 101000, 102000, 103000, 104000, 105000, 106000, 107000, - 108000, 109000, 180000, 181000, 900000, 901000, 980000, 981000, 110000, 111000, - 112000, 113000, 114000, 115000, 116000, 117000, 118000, 119000, 190000, 191000, - 910000, 911000, 990000, 991000, 120000, 121000, 122000, 123000, 124000, 125000, - 126000, 127000, 128000, 129000, 182000, 183000, 920000, 921000, 908000, 909000, - 130000, 131000, 132000, 133000, 134000, 135000, 136000, 137000, 138000, 139000, - 192000, 193000, 930000, 931000, 918000, 919000, 140000, 141000, 142000, 143000, - 144000, 145000, 146000, 147000, 148000, 149000, 184000, 185000, 940000, 941000, - 188000, 189000, 150000, 151000, 152000, 153000, 154000, 155000, 156000, 157000, - 158000, 159000, 194000, 195000, 950000, 951000, 198000, 199000, 160000, 161000, - 162000, 163000, 164000, 165000, 166000, 167000, 168000, 169000, 186000, 187000, - 960000, 961000, 988000, 989000, 170000, 171000, 172000, 173000, 174000, 175000, - 176000, 177000, 178000, 179000, 196000, 197000, 970000, 971000, 998000, 999000, - 200000, 201000, 202000, 203000, 204000, 205000, 206000, 207000, 208000, 209000, - 280000, 281000, 802000, 803000, 882000, 883000, 210000, 211000, 212000, 213000, - 214000, 215000, 216000, 217000, 218000, 219000, 290000, 291000, 812000, 813000, - 892000, 893000, 220000, 221000, 222000, 223000, 224000, 225000, 226000, 227000, - 228000, 229000, 282000, 283000, 822000, 823000, 828000, 829000, 230000, 231000, - 232000, 233000, 234000, 235000, 236000, 237000, 238000, 239000, 292000, 293000, - 832000, 833000, 838000, 839000, 240000, 241000, 242000, 243000, 244000, 245000, - 246000, 247000, 248000, 249000, 284000, 285000, 842000, 843000, 288000, 289000, - 250000, 251000, 252000, 253000, 254000, 255000, 256000, 257000, 258000, 259000, - 294000, 295000, 852000, 853000, 298000, 299000, 260000, 261000, 262000, 263000, - 264000, 265000, 266000, 267000, 268000, 269000, 286000, 287000, 862000, 863000, - 888000, 889000, 270000, 271000, 272000, 273000, 274000, 275000, 276000, 277000, - 278000, 279000, 296000, 297000, 872000, 873000, 898000, 899000, 300000, 301000, - 302000, 303000, 304000, 305000, 306000, 307000, 308000, 309000, 380000, 381000, - 902000, 903000, 982000, 983000, 310000, 311000, 312000, 313000, 314000, 315000, - 316000, 317000, 318000, 319000, 390000, 391000, 912000, 913000, 992000, 993000, - 320000, 321000, 322000, 323000, 324000, 325000, 326000, 327000, 328000, 329000, - 382000, 383000, 922000, 923000, 928000, 929000, 330000, 331000, 332000, 333000, - 334000, 335000, 336000, 337000, 338000, 339000, 392000, 393000, 932000, 933000, - 938000, 939000, 340000, 341000, 342000, 343000, 344000, 345000, 346000, 347000, - 348000, 349000, 384000, 385000, 942000, 943000, 388000, 389000, 350000, 351000, - 352000, 353000, 354000, 355000, 356000, 357000, 358000, 359000, 394000, 395000, - 952000, 953000, 398000, 399000, 360000, 361000, 362000, 363000, 364000, 365000, - 366000, 367000, 368000, 369000, 386000, 387000, 962000, 963000, 988000, 989000, - 370000, 371000, 372000, 373000, 374000, 375000, 376000, 377000, 378000, 379000, - 396000, 397000, 972000, 973000, 998000, 999000, 400000, 401000, 402000, 403000, - 404000, 405000, 406000, 407000, 408000, 409000, 480000, 481000, 804000, 805000, - 884000, 885000, 410000, 411000, 412000, 413000, 414000, 415000, 416000, 417000, - 418000, 419000, 490000, 491000, 814000, 815000, 894000, 895000, 420000, 421000, - 422000, 423000, 424000, 425000, 426000, 427000, 428000, 429000, 482000, 483000, - 824000, 825000, 848000, 849000, 430000, 431000, 432000, 433000, 434000, 435000, - 436000, 437000, 438000, 439000, 492000, 493000, 834000, 835000, 858000, 859000, - 440000, 441000, 442000, 443000, 444000, 445000, 446000, 447000, 448000, 449000, - 484000, 485000, 844000, 845000, 488000, 489000, 450000, 451000, 452000, 453000, - 454000, 455000, 456000, 457000, 458000, 459000, 494000, 495000, 854000, 855000, - 498000, 499000, 460000, 461000, 462000, 463000, 464000, 465000, 466000, 467000, - 468000, 469000, 486000, 487000, 864000, 865000, 888000, 889000, 470000, 471000, - 472000, 473000, 474000, 475000, 476000, 477000, 478000, 479000, 496000, 497000, - 874000, 875000, 898000, 899000, 500000, 501000, 502000, 503000, 504000, 505000, - 506000, 507000, 508000, 509000, 580000, 581000, 904000, 905000, 984000, 985000, - 510000, 511000, 512000, 513000, 514000, 515000, 516000, 517000, 518000, 519000, - 590000, 591000, 914000, 915000, 994000, 995000, 520000, 521000, 522000, 523000, - 524000, 525000, 526000, 527000, 528000, 529000, 582000, 583000, 924000, 925000, - 948000, 949000, 530000, 531000, 532000, 533000, 534000, 535000, 536000, 537000, - 538000, 539000, 592000, 593000, 934000, 935000, 958000, 959000, 540000, 541000, - 542000, 543000, 544000, 545000, 546000, 547000, 548000, 549000, 584000, 585000, - 944000, 945000, 588000, 589000, 550000, 551000, 552000, 553000, 554000, 555000, - 556000, 557000, 558000, 559000, 594000, 595000, 954000, 955000, 598000, 599000, - 560000, 561000, 562000, 563000, 564000, 565000, 566000, 567000, 568000, 569000, - 586000, 587000, 964000, 965000, 988000, 989000, 570000, 571000, 572000, 573000, - 574000, 575000, 576000, 577000, 578000, 579000, 596000, 597000, 974000, 975000, - 998000, 999000, 600000, 601000, 602000, 603000, 604000, 605000, 606000, 607000, - 608000, 609000, 680000, 681000, 806000, 807000, 886000, 887000, 610000, 611000, - 612000, 613000, 614000, 615000, 616000, 617000, 618000, 619000, 690000, 691000, - 816000, 817000, 896000, 897000, 620000, 621000, 622000, 623000, 624000, 625000, - 626000, 627000, 628000, 629000, 682000, 683000, 826000, 827000, 868000, 869000, - 630000, 631000, 632000, 633000, 634000, 635000, 636000, 637000, 638000, 639000, - 692000, 693000, 836000, 837000, 878000, 879000, 640000, 641000, 642000, 643000, - 644000, 645000, 646000, 647000, 648000, 649000, 684000, 685000, 846000, 847000, - 688000, 689000, 650000, 651000, 652000, 653000, 654000, 655000, 656000, 657000, - 658000, 659000, 694000, 695000, 856000, 857000, 698000, 699000, 660000, 661000, - 662000, 663000, 664000, 665000, 666000, 667000, 668000, 669000, 686000, 687000, - 866000, 867000, 888000, 889000, 670000, 671000, 672000, 673000, 674000, 675000, - 676000, 677000, 678000, 679000, 696000, 697000, 876000, 877000, 898000, 899000, - 700000, 701000, 702000, 703000, 704000, 705000, 706000, 707000, 708000, 709000, - 780000, 781000, 906000, 907000, 986000, 987000, 710000, 711000, 712000, 713000, - 714000, 715000, 716000, 717000, 718000, 719000, 790000, 791000, 916000, 917000, - 996000, 997000, 720000, 721000, 722000, 723000, 724000, 725000, 726000, 727000, - 728000, 729000, 782000, 783000, 926000, 927000, 968000, 969000, 730000, 731000, - 732000, 733000, 734000, 735000, 736000, 737000, 738000, 739000, 792000, 793000, - 936000, 937000, 978000, 979000, 740000, 741000, 742000, 743000, 744000, 745000, - 746000, 747000, 748000, 749000, 784000, 785000, 946000, 947000, 788000, 789000, - 750000, 751000, 752000, 753000, 754000, 755000, 756000, 757000, 758000, 759000, - 794000, 795000, 956000, 957000, 798000, 799000, 760000, 761000, 762000, 763000, - 764000, 765000, 766000, 767000, 768000, 769000, 786000, 787000, 966000, 967000, - 988000, 989000, 770000, 771000, 772000, 773000, 774000, 775000, 776000, 777000, - 778000, 779000, 796000, 797000, 976000, 977000, 998000, 999000}; -#endif - -#if defined(DEC_DPD2BINM) && DEC_DPD2BINM==1 && !defined(DECDPD2BINM) -#define DECDPD2BINM - -const uint32_t DPD2BINM[1024]={0, 1000000, 2000000, 3000000, 4000000, - 5000000, 6000000, 7000000, 8000000, 9000000, 80000000, 81000000, - 800000000, 801000000, 880000000, 881000000, 10000000, 11000000, 12000000, - 13000000, 14000000, 15000000, 16000000, 17000000, 18000000, 19000000, - 90000000, 91000000, 810000000, 811000000, 890000000, 891000000, 20000000, - 21000000, 22000000, 23000000, 24000000, 25000000, 26000000, 27000000, - 28000000, 29000000, 82000000, 83000000, 820000000, 821000000, 808000000, - 809000000, 30000000, 31000000, 32000000, 33000000, 34000000, 35000000, - 36000000, 37000000, 38000000, 39000000, 92000000, 93000000, 830000000, - 831000000, 818000000, 819000000, 40000000, 41000000, 42000000, 43000000, - 44000000, 45000000, 46000000, 47000000, 48000000, 49000000, 84000000, - 85000000, 840000000, 841000000, 88000000, 89000000, 50000000, 51000000, - 52000000, 53000000, 54000000, 55000000, 56000000, 57000000, 58000000, - 59000000, 94000000, 95000000, 850000000, 851000000, 98000000, 99000000, - 60000000, 61000000, 62000000, 63000000, 64000000, 65000000, 66000000, - 67000000, 68000000, 69000000, 86000000, 87000000, 860000000, 861000000, - 888000000, 889000000, 70000000, 71000000, 72000000, 73000000, 74000000, - 75000000, 76000000, 77000000, 78000000, 79000000, 96000000, 97000000, - 870000000, 871000000, 898000000, 899000000, 100000000, 101000000, 102000000, - 103000000, 104000000, 105000000, 106000000, 107000000, 108000000, 109000000, - 180000000, 181000000, 900000000, 901000000, 980000000, 981000000, 110000000, - 111000000, 112000000, 113000000, 114000000, 115000000, 116000000, 117000000, - 118000000, 119000000, 190000000, 191000000, 910000000, 911000000, 990000000, - 991000000, 120000000, 121000000, 122000000, 123000000, 124000000, 125000000, - 126000000, 127000000, 128000000, 129000000, 182000000, 183000000, 920000000, - 921000000, 908000000, 909000000, 130000000, 131000000, 132000000, 133000000, - 134000000, 135000000, 136000000, 137000000, 138000000, 139000000, 192000000, - 193000000, 930000000, 931000000, 918000000, 919000000, 140000000, 141000000, - 142000000, 143000000, 144000000, 145000000, 146000000, 147000000, 148000000, - 149000000, 184000000, 185000000, 940000000, 941000000, 188000000, 189000000, - 150000000, 151000000, 152000000, 153000000, 154000000, 155000000, 156000000, - 157000000, 158000000, 159000000, 194000000, 195000000, 950000000, 951000000, - 198000000, 199000000, 160000000, 161000000, 162000000, 163000000, 164000000, - 165000000, 166000000, 167000000, 168000000, 169000000, 186000000, 187000000, - 960000000, 961000000, 988000000, 989000000, 170000000, 171000000, 172000000, - 173000000, 174000000, 175000000, 176000000, 177000000, 178000000, 179000000, - 196000000, 197000000, 970000000, 971000000, 998000000, 999000000, 200000000, - 201000000, 202000000, 203000000, 204000000, 205000000, 206000000, 207000000, - 208000000, 209000000, 280000000, 281000000, 802000000, 803000000, 882000000, - 883000000, 210000000, 211000000, 212000000, 213000000, 214000000, 215000000, - 216000000, 217000000, 218000000, 219000000, 290000000, 291000000, 812000000, - 813000000, 892000000, 893000000, 220000000, 221000000, 222000000, 223000000, - 224000000, 225000000, 226000000, 227000000, 228000000, 229000000, 282000000, - 283000000, 822000000, 823000000, 828000000, 829000000, 230000000, 231000000, - 232000000, 233000000, 234000000, 235000000, 236000000, 237000000, 238000000, - 239000000, 292000000, 293000000, 832000000, 833000000, 838000000, 839000000, - 240000000, 241000000, 242000000, 243000000, 244000000, 245000000, 246000000, - 247000000, 248000000, 249000000, 284000000, 285000000, 842000000, 843000000, - 288000000, 289000000, 250000000, 251000000, 252000000, 253000000, 254000000, - 255000000, 256000000, 257000000, 258000000, 259000000, 294000000, 295000000, - 852000000, 853000000, 298000000, 299000000, 260000000, 261000000, 262000000, - 263000000, 264000000, 265000000, 266000000, 267000000, 268000000, 269000000, - 286000000, 287000000, 862000000, 863000000, 888000000, 889000000, 270000000, - 271000000, 272000000, 273000000, 274000000, 275000000, 276000000, 277000000, - 278000000, 279000000, 296000000, 297000000, 872000000, 873000000, 898000000, - 899000000, 300000000, 301000000, 302000000, 303000000, 304000000, 305000000, - 306000000, 307000000, 308000000, 309000000, 380000000, 381000000, 902000000, - 903000000, 982000000, 983000000, 310000000, 311000000, 312000000, 313000000, - 314000000, 315000000, 316000000, 317000000, 318000000, 319000000, 390000000, - 391000000, 912000000, 913000000, 992000000, 993000000, 320000000, 321000000, - 322000000, 323000000, 324000000, 325000000, 326000000, 327000000, 328000000, - 329000000, 382000000, 383000000, 922000000, 923000000, 928000000, 929000000, - 330000000, 331000000, 332000000, 333000000, 334000000, 335000000, 336000000, - 337000000, 338000000, 339000000, 392000000, 393000000, 932000000, 933000000, - 938000000, 939000000, 340000000, 341000000, 342000000, 343000000, 344000000, - 345000000, 346000000, 347000000, 348000000, 349000000, 384000000, 385000000, - 942000000, 943000000, 388000000, 389000000, 350000000, 351000000, 352000000, - 353000000, 354000000, 355000000, 356000000, 357000000, 358000000, 359000000, - 394000000, 395000000, 952000000, 953000000, 398000000, 399000000, 360000000, - 361000000, 362000000, 363000000, 364000000, 365000000, 366000000, 367000000, - 368000000, 369000000, 386000000, 387000000, 962000000, 963000000, 988000000, - 989000000, 370000000, 371000000, 372000000, 373000000, 374000000, 375000000, - 376000000, 377000000, 378000000, 379000000, 396000000, 397000000, 972000000, - 973000000, 998000000, 999000000, 400000000, 401000000, 402000000, 403000000, - 404000000, 405000000, 406000000, 407000000, 408000000, 409000000, 480000000, - 481000000, 804000000, 805000000, 884000000, 885000000, 410000000, 411000000, - 412000000, 413000000, 414000000, 415000000, 416000000, 417000000, 418000000, - 419000000, 490000000, 491000000, 814000000, 815000000, 894000000, 895000000, - 420000000, 421000000, 422000000, 423000000, 424000000, 425000000, 426000000, - 427000000, 428000000, 429000000, 482000000, 483000000, 824000000, 825000000, - 848000000, 849000000, 430000000, 431000000, 432000000, 433000000, 434000000, - 435000000, 436000000, 437000000, 438000000, 439000000, 492000000, 493000000, - 834000000, 835000000, 858000000, 859000000, 440000000, 441000000, 442000000, - 443000000, 444000000, 445000000, 446000000, 447000000, 448000000, 449000000, - 484000000, 485000000, 844000000, 845000000, 488000000, 489000000, 450000000, - 451000000, 452000000, 453000000, 454000000, 455000000, 456000000, 457000000, - 458000000, 459000000, 494000000, 495000000, 854000000, 855000000, 498000000, - 499000000, 460000000, 461000000, 462000000, 463000000, 464000000, 465000000, - 466000000, 467000000, 468000000, 469000000, 486000000, 487000000, 864000000, - 865000000, 888000000, 889000000, 470000000, 471000000, 472000000, 473000000, - 474000000, 475000000, 476000000, 477000000, 478000000, 479000000, 496000000, - 497000000, 874000000, 875000000, 898000000, 899000000, 500000000, 501000000, - 502000000, 503000000, 504000000, 505000000, 506000000, 507000000, 508000000, - 509000000, 580000000, 581000000, 904000000, 905000000, 984000000, 985000000, - 510000000, 511000000, 512000000, 513000000, 514000000, 515000000, 516000000, - 517000000, 518000000, 519000000, 590000000, 591000000, 914000000, 915000000, - 994000000, 995000000, 520000000, 521000000, 522000000, 523000000, 524000000, - 525000000, 526000000, 527000000, 528000000, 529000000, 582000000, 583000000, - 924000000, 925000000, 948000000, 949000000, 530000000, 531000000, 532000000, - 533000000, 534000000, 535000000, 536000000, 537000000, 538000000, 539000000, - 592000000, 593000000, 934000000, 935000000, 958000000, 959000000, 540000000, - 541000000, 542000000, 543000000, 544000000, 545000000, 546000000, 547000000, - 548000000, 549000000, 584000000, 585000000, 944000000, 945000000, 588000000, - 589000000, 550000000, 551000000, 552000000, 553000000, 554000000, 555000000, - 556000000, 557000000, 558000000, 559000000, 594000000, 595000000, 954000000, - 955000000, 598000000, 599000000, 560000000, 561000000, 562000000, 563000000, - 564000000, 565000000, 566000000, 567000000, 568000000, 569000000, 586000000, - 587000000, 964000000, 965000000, 988000000, 989000000, 570000000, 571000000, - 572000000, 573000000, 574000000, 575000000, 576000000, 577000000, 578000000, - 579000000, 596000000, 597000000, 974000000, 975000000, 998000000, 999000000, - 600000000, 601000000, 602000000, 603000000, 604000000, 605000000, 606000000, - 607000000, 608000000, 609000000, 680000000, 681000000, 806000000, 807000000, - 886000000, 887000000, 610000000, 611000000, 612000000, 613000000, 614000000, - 615000000, 616000000, 617000000, 618000000, 619000000, 690000000, 691000000, - 816000000, 817000000, 896000000, 897000000, 620000000, 621000000, 622000000, - 623000000, 624000000, 625000000, 626000000, 627000000, 628000000, 629000000, - 682000000, 683000000, 826000000, 827000000, 868000000, 869000000, 630000000, - 631000000, 632000000, 633000000, 634000000, 635000000, 636000000, 637000000, - 638000000, 639000000, 692000000, 693000000, 836000000, 837000000, 878000000, - 879000000, 640000000, 641000000, 642000000, 643000000, 644000000, 645000000, - 646000000, 647000000, 648000000, 649000000, 684000000, 685000000, 846000000, - 847000000, 688000000, 689000000, 650000000, 651000000, 652000000, 653000000, - 654000000, 655000000, 656000000, 657000000, 658000000, 659000000, 694000000, - 695000000, 856000000, 857000000, 698000000, 699000000, 660000000, 661000000, - 662000000, 663000000, 664000000, 665000000, 666000000, 667000000, 668000000, - 669000000, 686000000, 687000000, 866000000, 867000000, 888000000, 889000000, - 670000000, 671000000, 672000000, 673000000, 674000000, 675000000, 676000000, - 677000000, 678000000, 679000000, 696000000, 697000000, 876000000, 877000000, - 898000000, 899000000, 700000000, 701000000, 702000000, 703000000, 704000000, - 705000000, 706000000, 707000000, 708000000, 709000000, 780000000, 781000000, - 906000000, 907000000, 986000000, 987000000, 710000000, 711000000, 712000000, - 713000000, 714000000, 715000000, 716000000, 717000000, 718000000, 719000000, - 790000000, 791000000, 916000000, 917000000, 996000000, 997000000, 720000000, - 721000000, 722000000, 723000000, 724000000, 725000000, 726000000, 727000000, - 728000000, 729000000, 782000000, 783000000, 926000000, 927000000, 968000000, - 969000000, 730000000, 731000000, 732000000, 733000000, 734000000, 735000000, - 736000000, 737000000, 738000000, 739000000, 792000000, 793000000, 936000000, - 937000000, 978000000, 979000000, 740000000, 741000000, 742000000, 743000000, - 744000000, 745000000, 746000000, 747000000, 748000000, 749000000, 784000000, - 785000000, 946000000, 947000000, 788000000, 789000000, 750000000, 751000000, - 752000000, 753000000, 754000000, 755000000, 756000000, 757000000, 758000000, - 759000000, 794000000, 795000000, 956000000, 957000000, 798000000, 799000000, - 760000000, 761000000, 762000000, 763000000, 764000000, 765000000, 766000000, - 767000000, 768000000, 769000000, 786000000, 787000000, 966000000, 967000000, - 988000000, 989000000, 770000000, 771000000, 772000000, 773000000, 774000000, - 775000000, 776000000, 777000000, 778000000, 779000000, 796000000, 797000000, - 976000000, 977000000, 998000000, 999000000}; -#endif - -#if defined(DEC_BIN2CHAR) && DEC_BIN2CHAR==1 && !defined(DECBIN2CHAR) -#define DECBIN2CHAR - -const uint8_t BIN2CHAR[4001]={ - '\0','0','0','0', '\1','0','0','1', '\1','0','0','2', '\1','0','0','3', '\1','0','0','4', - '\1','0','0','5', '\1','0','0','6', '\1','0','0','7', '\1','0','0','8', '\1','0','0','9', - '\2','0','1','0', '\2','0','1','1', '\2','0','1','2', '\2','0','1','3', '\2','0','1','4', - '\2','0','1','5', '\2','0','1','6', '\2','0','1','7', '\2','0','1','8', '\2','0','1','9', - '\2','0','2','0', '\2','0','2','1', '\2','0','2','2', '\2','0','2','3', '\2','0','2','4', - '\2','0','2','5', '\2','0','2','6', '\2','0','2','7', '\2','0','2','8', '\2','0','2','9', - '\2','0','3','0', '\2','0','3','1', '\2','0','3','2', '\2','0','3','3', '\2','0','3','4', - '\2','0','3','5', '\2','0','3','6', '\2','0','3','7', '\2','0','3','8', '\2','0','3','9', - '\2','0','4','0', '\2','0','4','1', '\2','0','4','2', '\2','0','4','3', '\2','0','4','4', - '\2','0','4','5', '\2','0','4','6', '\2','0','4','7', '\2','0','4','8', '\2','0','4','9', - '\2','0','5','0', '\2','0','5','1', '\2','0','5','2', '\2','0','5','3', '\2','0','5','4', - '\2','0','5','5', '\2','0','5','6', '\2','0','5','7', '\2','0','5','8', '\2','0','5','9', - '\2','0','6','0', '\2','0','6','1', '\2','0','6','2', '\2','0','6','3', '\2','0','6','4', - '\2','0','6','5', '\2','0','6','6', '\2','0','6','7', '\2','0','6','8', '\2','0','6','9', - '\2','0','7','0', '\2','0','7','1', '\2','0','7','2', '\2','0','7','3', '\2','0','7','4', - '\2','0','7','5', '\2','0','7','6', '\2','0','7','7', '\2','0','7','8', '\2','0','7','9', - '\2','0','8','0', '\2','0','8','1', '\2','0','8','2', '\2','0','8','3', '\2','0','8','4', - '\2','0','8','5', '\2','0','8','6', '\2','0','8','7', '\2','0','8','8', '\2','0','8','9', - '\2','0','9','0', '\2','0','9','1', '\2','0','9','2', '\2','0','9','3', '\2','0','9','4', - '\2','0','9','5', '\2','0','9','6', '\2','0','9','7', '\2','0','9','8', '\2','0','9','9', - '\3','1','0','0', '\3','1','0','1', '\3','1','0','2', '\3','1','0','3', '\3','1','0','4', - '\3','1','0','5', '\3','1','0','6', '\3','1','0','7', '\3','1','0','8', '\3','1','0','9', - '\3','1','1','0', '\3','1','1','1', '\3','1','1','2', '\3','1','1','3', '\3','1','1','4', - '\3','1','1','5', '\3','1','1','6', '\3','1','1','7', '\3','1','1','8', '\3','1','1','9', - '\3','1','2','0', '\3','1','2','1', '\3','1','2','2', '\3','1','2','3', '\3','1','2','4', - '\3','1','2','5', '\3','1','2','6', '\3','1','2','7', '\3','1','2','8', '\3','1','2','9', - '\3','1','3','0', '\3','1','3','1', '\3','1','3','2', '\3','1','3','3', '\3','1','3','4', - '\3','1','3','5', '\3','1','3','6', '\3','1','3','7', '\3','1','3','8', '\3','1','3','9', - '\3','1','4','0', '\3','1','4','1', '\3','1','4','2', '\3','1','4','3', '\3','1','4','4', - '\3','1','4','5', '\3','1','4','6', '\3','1','4','7', '\3','1','4','8', '\3','1','4','9', - '\3','1','5','0', '\3','1','5','1', '\3','1','5','2', '\3','1','5','3', '\3','1','5','4', - '\3','1','5','5', '\3','1','5','6', '\3','1','5','7', '\3','1','5','8', '\3','1','5','9', - '\3','1','6','0', '\3','1','6','1', '\3','1','6','2', '\3','1','6','3', '\3','1','6','4', - '\3','1','6','5', '\3','1','6','6', '\3','1','6','7', '\3','1','6','8', '\3','1','6','9', - '\3','1','7','0', '\3','1','7','1', '\3','1','7','2', '\3','1','7','3', '\3','1','7','4', - '\3','1','7','5', '\3','1','7','6', '\3','1','7','7', '\3','1','7','8', '\3','1','7','9', - '\3','1','8','0', '\3','1','8','1', '\3','1','8','2', '\3','1','8','3', '\3','1','8','4', - '\3','1','8','5', '\3','1','8','6', '\3','1','8','7', '\3','1','8','8', '\3','1','8','9', - '\3','1','9','0', '\3','1','9','1', '\3','1','9','2', '\3','1','9','3', '\3','1','9','4', - '\3','1','9','5', '\3','1','9','6', '\3','1','9','7', '\3','1','9','8', '\3','1','9','9', - '\3','2','0','0', '\3','2','0','1', '\3','2','0','2', '\3','2','0','3', '\3','2','0','4', - '\3','2','0','5', '\3','2','0','6', '\3','2','0','7', '\3','2','0','8', '\3','2','0','9', - '\3','2','1','0', '\3','2','1','1', '\3','2','1','2', '\3','2','1','3', '\3','2','1','4', - '\3','2','1','5', '\3','2','1','6', '\3','2','1','7', '\3','2','1','8', '\3','2','1','9', - '\3','2','2','0', '\3','2','2','1', '\3','2','2','2', '\3','2','2','3', '\3','2','2','4', - '\3','2','2','5', '\3','2','2','6', '\3','2','2','7', '\3','2','2','8', '\3','2','2','9', - '\3','2','3','0', '\3','2','3','1', '\3','2','3','2', '\3','2','3','3', '\3','2','3','4', - '\3','2','3','5', '\3','2','3','6', '\3','2','3','7', '\3','2','3','8', '\3','2','3','9', - '\3','2','4','0', '\3','2','4','1', '\3','2','4','2', '\3','2','4','3', '\3','2','4','4', - '\3','2','4','5', '\3','2','4','6', '\3','2','4','7', '\3','2','4','8', '\3','2','4','9', - '\3','2','5','0', '\3','2','5','1', '\3','2','5','2', '\3','2','5','3', '\3','2','5','4', - '\3','2','5','5', '\3','2','5','6', '\3','2','5','7', '\3','2','5','8', '\3','2','5','9', - '\3','2','6','0', '\3','2','6','1', '\3','2','6','2', '\3','2','6','3', '\3','2','6','4', - '\3','2','6','5', '\3','2','6','6', '\3','2','6','7', '\3','2','6','8', '\3','2','6','9', - '\3','2','7','0', '\3','2','7','1', '\3','2','7','2', '\3','2','7','3', '\3','2','7','4', - '\3','2','7','5', '\3','2','7','6', '\3','2','7','7', '\3','2','7','8', '\3','2','7','9', - '\3','2','8','0', '\3','2','8','1', '\3','2','8','2', '\3','2','8','3', '\3','2','8','4', - '\3','2','8','5', '\3','2','8','6', '\3','2','8','7', '\3','2','8','8', '\3','2','8','9', - '\3','2','9','0', '\3','2','9','1', '\3','2','9','2', '\3','2','9','3', '\3','2','9','4', - '\3','2','9','5', '\3','2','9','6', '\3','2','9','7', '\3','2','9','8', '\3','2','9','9', - '\3','3','0','0', '\3','3','0','1', '\3','3','0','2', '\3','3','0','3', '\3','3','0','4', - '\3','3','0','5', '\3','3','0','6', '\3','3','0','7', '\3','3','0','8', '\3','3','0','9', - '\3','3','1','0', '\3','3','1','1', '\3','3','1','2', '\3','3','1','3', '\3','3','1','4', - '\3','3','1','5', '\3','3','1','6', '\3','3','1','7', '\3','3','1','8', '\3','3','1','9', - '\3','3','2','0', '\3','3','2','1', '\3','3','2','2', '\3','3','2','3', '\3','3','2','4', - '\3','3','2','5', '\3','3','2','6', '\3','3','2','7', '\3','3','2','8', '\3','3','2','9', - '\3','3','3','0', '\3','3','3','1', '\3','3','3','2', '\3','3','3','3', '\3','3','3','4', - '\3','3','3','5', '\3','3','3','6', '\3','3','3','7', '\3','3','3','8', '\3','3','3','9', - '\3','3','4','0', '\3','3','4','1', '\3','3','4','2', '\3','3','4','3', '\3','3','4','4', - '\3','3','4','5', '\3','3','4','6', '\3','3','4','7', '\3','3','4','8', '\3','3','4','9', - '\3','3','5','0', '\3','3','5','1', '\3','3','5','2', '\3','3','5','3', '\3','3','5','4', - '\3','3','5','5', '\3','3','5','6', '\3','3','5','7', '\3','3','5','8', '\3','3','5','9', - '\3','3','6','0', '\3','3','6','1', '\3','3','6','2', '\3','3','6','3', '\3','3','6','4', - '\3','3','6','5', '\3','3','6','6', '\3','3','6','7', '\3','3','6','8', '\3','3','6','9', - '\3','3','7','0', '\3','3','7','1', '\3','3','7','2', '\3','3','7','3', '\3','3','7','4', - '\3','3','7','5', '\3','3','7','6', '\3','3','7','7', '\3','3','7','8', '\3','3','7','9', - '\3','3','8','0', '\3','3','8','1', '\3','3','8','2', '\3','3','8','3', '\3','3','8','4', - '\3','3','8','5', '\3','3','8','6', '\3','3','8','7', '\3','3','8','8', '\3','3','8','9', - '\3','3','9','0', '\3','3','9','1', '\3','3','9','2', '\3','3','9','3', '\3','3','9','4', - '\3','3','9','5', '\3','3','9','6', '\3','3','9','7', '\3','3','9','8', '\3','3','9','9', - '\3','4','0','0', '\3','4','0','1', '\3','4','0','2', '\3','4','0','3', '\3','4','0','4', - '\3','4','0','5', '\3','4','0','6', '\3','4','0','7', '\3','4','0','8', '\3','4','0','9', - '\3','4','1','0', '\3','4','1','1', '\3','4','1','2', '\3','4','1','3', '\3','4','1','4', - '\3','4','1','5', '\3','4','1','6', '\3','4','1','7', '\3','4','1','8', '\3','4','1','9', - '\3','4','2','0', '\3','4','2','1', '\3','4','2','2', '\3','4','2','3', '\3','4','2','4', - '\3','4','2','5', '\3','4','2','6', '\3','4','2','7', '\3','4','2','8', '\3','4','2','9', - '\3','4','3','0', '\3','4','3','1', '\3','4','3','2', '\3','4','3','3', '\3','4','3','4', - '\3','4','3','5', '\3','4','3','6', '\3','4','3','7', '\3','4','3','8', '\3','4','3','9', - '\3','4','4','0', '\3','4','4','1', '\3','4','4','2', '\3','4','4','3', '\3','4','4','4', - '\3','4','4','5', '\3','4','4','6', '\3','4','4','7', '\3','4','4','8', '\3','4','4','9', - '\3','4','5','0', '\3','4','5','1', '\3','4','5','2', '\3','4','5','3', '\3','4','5','4', - '\3','4','5','5', '\3','4','5','6', '\3','4','5','7', '\3','4','5','8', '\3','4','5','9', - '\3','4','6','0', '\3','4','6','1', '\3','4','6','2', '\3','4','6','3', '\3','4','6','4', - '\3','4','6','5', '\3','4','6','6', '\3','4','6','7', '\3','4','6','8', '\3','4','6','9', - '\3','4','7','0', '\3','4','7','1', '\3','4','7','2', '\3','4','7','3', '\3','4','7','4', - '\3','4','7','5', '\3','4','7','6', '\3','4','7','7', '\3','4','7','8', '\3','4','7','9', - '\3','4','8','0', '\3','4','8','1', '\3','4','8','2', '\3','4','8','3', '\3','4','8','4', - '\3','4','8','5', '\3','4','8','6', '\3','4','8','7', '\3','4','8','8', '\3','4','8','9', - '\3','4','9','0', '\3','4','9','1', '\3','4','9','2', '\3','4','9','3', '\3','4','9','4', - '\3','4','9','5', '\3','4','9','6', '\3','4','9','7', '\3','4','9','8', '\3','4','9','9', - '\3','5','0','0', '\3','5','0','1', '\3','5','0','2', '\3','5','0','3', '\3','5','0','4', - '\3','5','0','5', '\3','5','0','6', '\3','5','0','7', '\3','5','0','8', '\3','5','0','9', - '\3','5','1','0', '\3','5','1','1', '\3','5','1','2', '\3','5','1','3', '\3','5','1','4', - '\3','5','1','5', '\3','5','1','6', '\3','5','1','7', '\3','5','1','8', '\3','5','1','9', - '\3','5','2','0', '\3','5','2','1', '\3','5','2','2', '\3','5','2','3', '\3','5','2','4', - '\3','5','2','5', '\3','5','2','6', '\3','5','2','7', '\3','5','2','8', '\3','5','2','9', - '\3','5','3','0', '\3','5','3','1', '\3','5','3','2', '\3','5','3','3', '\3','5','3','4', - '\3','5','3','5', '\3','5','3','6', '\3','5','3','7', '\3','5','3','8', '\3','5','3','9', - '\3','5','4','0', '\3','5','4','1', '\3','5','4','2', '\3','5','4','3', '\3','5','4','4', - '\3','5','4','5', '\3','5','4','6', '\3','5','4','7', '\3','5','4','8', '\3','5','4','9', - '\3','5','5','0', '\3','5','5','1', '\3','5','5','2', '\3','5','5','3', '\3','5','5','4', - '\3','5','5','5', '\3','5','5','6', '\3','5','5','7', '\3','5','5','8', '\3','5','5','9', - '\3','5','6','0', '\3','5','6','1', '\3','5','6','2', '\3','5','6','3', '\3','5','6','4', - '\3','5','6','5', '\3','5','6','6', '\3','5','6','7', '\3','5','6','8', '\3','5','6','9', - '\3','5','7','0', '\3','5','7','1', '\3','5','7','2', '\3','5','7','3', '\3','5','7','4', - '\3','5','7','5', '\3','5','7','6', '\3','5','7','7', '\3','5','7','8', '\3','5','7','9', - '\3','5','8','0', '\3','5','8','1', '\3','5','8','2', '\3','5','8','3', '\3','5','8','4', - '\3','5','8','5', '\3','5','8','6', '\3','5','8','7', '\3','5','8','8', '\3','5','8','9', - '\3','5','9','0', '\3','5','9','1', '\3','5','9','2', '\3','5','9','3', '\3','5','9','4', - '\3','5','9','5', '\3','5','9','6', '\3','5','9','7', '\3','5','9','8', '\3','5','9','9', - '\3','6','0','0', '\3','6','0','1', '\3','6','0','2', '\3','6','0','3', '\3','6','0','4', - '\3','6','0','5', '\3','6','0','6', '\3','6','0','7', '\3','6','0','8', '\3','6','0','9', - '\3','6','1','0', '\3','6','1','1', '\3','6','1','2', '\3','6','1','3', '\3','6','1','4', - '\3','6','1','5', '\3','6','1','6', '\3','6','1','7', '\3','6','1','8', '\3','6','1','9', - '\3','6','2','0', '\3','6','2','1', '\3','6','2','2', '\3','6','2','3', '\3','6','2','4', - '\3','6','2','5', '\3','6','2','6', '\3','6','2','7', '\3','6','2','8', '\3','6','2','9', - '\3','6','3','0', '\3','6','3','1', '\3','6','3','2', '\3','6','3','3', '\3','6','3','4', - '\3','6','3','5', '\3','6','3','6', '\3','6','3','7', '\3','6','3','8', '\3','6','3','9', - '\3','6','4','0', '\3','6','4','1', '\3','6','4','2', '\3','6','4','3', '\3','6','4','4', - '\3','6','4','5', '\3','6','4','6', '\3','6','4','7', '\3','6','4','8', '\3','6','4','9', - '\3','6','5','0', '\3','6','5','1', '\3','6','5','2', '\3','6','5','3', '\3','6','5','4', - '\3','6','5','5', '\3','6','5','6', '\3','6','5','7', '\3','6','5','8', '\3','6','5','9', - '\3','6','6','0', '\3','6','6','1', '\3','6','6','2', '\3','6','6','3', '\3','6','6','4', - '\3','6','6','5', '\3','6','6','6', '\3','6','6','7', '\3','6','6','8', '\3','6','6','9', - '\3','6','7','0', '\3','6','7','1', '\3','6','7','2', '\3','6','7','3', '\3','6','7','4', - '\3','6','7','5', '\3','6','7','6', '\3','6','7','7', '\3','6','7','8', '\3','6','7','9', - '\3','6','8','0', '\3','6','8','1', '\3','6','8','2', '\3','6','8','3', '\3','6','8','4', - '\3','6','8','5', '\3','6','8','6', '\3','6','8','7', '\3','6','8','8', '\3','6','8','9', - '\3','6','9','0', '\3','6','9','1', '\3','6','9','2', '\3','6','9','3', '\3','6','9','4', - '\3','6','9','5', '\3','6','9','6', '\3','6','9','7', '\3','6','9','8', '\3','6','9','9', - '\3','7','0','0', '\3','7','0','1', '\3','7','0','2', '\3','7','0','3', '\3','7','0','4', - '\3','7','0','5', '\3','7','0','6', '\3','7','0','7', '\3','7','0','8', '\3','7','0','9', - '\3','7','1','0', '\3','7','1','1', '\3','7','1','2', '\3','7','1','3', '\3','7','1','4', - '\3','7','1','5', '\3','7','1','6', '\3','7','1','7', '\3','7','1','8', '\3','7','1','9', - '\3','7','2','0', '\3','7','2','1', '\3','7','2','2', '\3','7','2','3', '\3','7','2','4', - '\3','7','2','5', '\3','7','2','6', '\3','7','2','7', '\3','7','2','8', '\3','7','2','9', - '\3','7','3','0', '\3','7','3','1', '\3','7','3','2', '\3','7','3','3', '\3','7','3','4', - '\3','7','3','5', '\3','7','3','6', '\3','7','3','7', '\3','7','3','8', '\3','7','3','9', - '\3','7','4','0', '\3','7','4','1', '\3','7','4','2', '\3','7','4','3', '\3','7','4','4', - '\3','7','4','5', '\3','7','4','6', '\3','7','4','7', '\3','7','4','8', '\3','7','4','9', - '\3','7','5','0', '\3','7','5','1', '\3','7','5','2', '\3','7','5','3', '\3','7','5','4', - '\3','7','5','5', '\3','7','5','6', '\3','7','5','7', '\3','7','5','8', '\3','7','5','9', - '\3','7','6','0', '\3','7','6','1', '\3','7','6','2', '\3','7','6','3', '\3','7','6','4', - '\3','7','6','5', '\3','7','6','6', '\3','7','6','7', '\3','7','6','8', '\3','7','6','9', - '\3','7','7','0', '\3','7','7','1', '\3','7','7','2', '\3','7','7','3', '\3','7','7','4', - '\3','7','7','5', '\3','7','7','6', '\3','7','7','7', '\3','7','7','8', '\3','7','7','9', - '\3','7','8','0', '\3','7','8','1', '\3','7','8','2', '\3','7','8','3', '\3','7','8','4', - '\3','7','8','5', '\3','7','8','6', '\3','7','8','7', '\3','7','8','8', '\3','7','8','9', - '\3','7','9','0', '\3','7','9','1', '\3','7','9','2', '\3','7','9','3', '\3','7','9','4', - '\3','7','9','5', '\3','7','9','6', '\3','7','9','7', '\3','7','9','8', '\3','7','9','9', - '\3','8','0','0', '\3','8','0','1', '\3','8','0','2', '\3','8','0','3', '\3','8','0','4', - '\3','8','0','5', '\3','8','0','6', '\3','8','0','7', '\3','8','0','8', '\3','8','0','9', - '\3','8','1','0', '\3','8','1','1', '\3','8','1','2', '\3','8','1','3', '\3','8','1','4', - '\3','8','1','5', '\3','8','1','6', '\3','8','1','7', '\3','8','1','8', '\3','8','1','9', - '\3','8','2','0', '\3','8','2','1', '\3','8','2','2', '\3','8','2','3', '\3','8','2','4', - '\3','8','2','5', '\3','8','2','6', '\3','8','2','7', '\3','8','2','8', '\3','8','2','9', - '\3','8','3','0', '\3','8','3','1', '\3','8','3','2', '\3','8','3','3', '\3','8','3','4', - '\3','8','3','5', '\3','8','3','6', '\3','8','3','7', '\3','8','3','8', '\3','8','3','9', - '\3','8','4','0', '\3','8','4','1', '\3','8','4','2', '\3','8','4','3', '\3','8','4','4', - '\3','8','4','5', '\3','8','4','6', '\3','8','4','7', '\3','8','4','8', '\3','8','4','9', - '\3','8','5','0', '\3','8','5','1', '\3','8','5','2', '\3','8','5','3', '\3','8','5','4', - '\3','8','5','5', '\3','8','5','6', '\3','8','5','7', '\3','8','5','8', '\3','8','5','9', - '\3','8','6','0', '\3','8','6','1', '\3','8','6','2', '\3','8','6','3', '\3','8','6','4', - '\3','8','6','5', '\3','8','6','6', '\3','8','6','7', '\3','8','6','8', '\3','8','6','9', - '\3','8','7','0', '\3','8','7','1', '\3','8','7','2', '\3','8','7','3', '\3','8','7','4', - '\3','8','7','5', '\3','8','7','6', '\3','8','7','7', '\3','8','7','8', '\3','8','7','9', - '\3','8','8','0', '\3','8','8','1', '\3','8','8','2', '\3','8','8','3', '\3','8','8','4', - '\3','8','8','5', '\3','8','8','6', '\3','8','8','7', '\3','8','8','8', '\3','8','8','9', - '\3','8','9','0', '\3','8','9','1', '\3','8','9','2', '\3','8','9','3', '\3','8','9','4', - '\3','8','9','5', '\3','8','9','6', '\3','8','9','7', '\3','8','9','8', '\3','8','9','9', - '\3','9','0','0', '\3','9','0','1', '\3','9','0','2', '\3','9','0','3', '\3','9','0','4', - '\3','9','0','5', '\3','9','0','6', '\3','9','0','7', '\3','9','0','8', '\3','9','0','9', - '\3','9','1','0', '\3','9','1','1', '\3','9','1','2', '\3','9','1','3', '\3','9','1','4', - '\3','9','1','5', '\3','9','1','6', '\3','9','1','7', '\3','9','1','8', '\3','9','1','9', - '\3','9','2','0', '\3','9','2','1', '\3','9','2','2', '\3','9','2','3', '\3','9','2','4', - '\3','9','2','5', '\3','9','2','6', '\3','9','2','7', '\3','9','2','8', '\3','9','2','9', - '\3','9','3','0', '\3','9','3','1', '\3','9','3','2', '\3','9','3','3', '\3','9','3','4', - '\3','9','3','5', '\3','9','3','6', '\3','9','3','7', '\3','9','3','8', '\3','9','3','9', - '\3','9','4','0', '\3','9','4','1', '\3','9','4','2', '\3','9','4','3', '\3','9','4','4', - '\3','9','4','5', '\3','9','4','6', '\3','9','4','7', '\3','9','4','8', '\3','9','4','9', - '\3','9','5','0', '\3','9','5','1', '\3','9','5','2', '\3','9','5','3', '\3','9','5','4', - '\3','9','5','5', '\3','9','5','6', '\3','9','5','7', '\3','9','5','8', '\3','9','5','9', - '\3','9','6','0', '\3','9','6','1', '\3','9','6','2', '\3','9','6','3', '\3','9','6','4', - '\3','9','6','5', '\3','9','6','6', '\3','9','6','7', '\3','9','6','8', '\3','9','6','9', - '\3','9','7','0', '\3','9','7','1', '\3','9','7','2', '\3','9','7','3', '\3','9','7','4', - '\3','9','7','5', '\3','9','7','6', '\3','9','7','7', '\3','9','7','8', '\3','9','7','9', - '\3','9','8','0', '\3','9','8','1', '\3','9','8','2', '\3','9','8','3', '\3','9','8','4', - '\3','9','8','5', '\3','9','8','6', '\3','9','8','7', '\3','9','8','8', '\3','9','8','9', - '\3','9','9','0', '\3','9','9','1', '\3','9','9','2', '\3','9','9','3', '\3','9','9','4', - '\3','9','9','5', '\3','9','9','6', '\3','9','9','7', '\3','9','9','8', '\3','9','9','9', '\0'}; -#endif - -#if defined(DEC_DPD2BCD8) && DEC_DPD2BCD8==1 && !defined(DECDPD2BCD8) -#define DECDPD2BCD8 - -const uint8_t DPD2BCD8[4096]={ - 0,0,0,0, 0,0,1,1, 0,0,2,1, 0,0,3,1, 0,0,4,1, 0,0,5,1, 0,0,6,1, 0,0,7,1, 0,0,8,1, - 0,0,9,1, 0,8,0,2, 0,8,1,2, 8,0,0,3, 8,0,1,3, 8,8,0,3, 8,8,1,3, 0,1,0,2, 0,1,1,2, - 0,1,2,2, 0,1,3,2, 0,1,4,2, 0,1,5,2, 0,1,6,2, 0,1,7,2, 0,1,8,2, 0,1,9,2, 0,9,0,2, - 0,9,1,2, 8,1,0,3, 8,1,1,3, 8,9,0,3, 8,9,1,3, 0,2,0,2, 0,2,1,2, 0,2,2,2, 0,2,3,2, - 0,2,4,2, 0,2,5,2, 0,2,6,2, 0,2,7,2, 0,2,8,2, 0,2,9,2, 0,8,2,2, 0,8,3,2, 8,2,0,3, - 8,2,1,3, 8,0,8,3, 8,0,9,3, 0,3,0,2, 0,3,1,2, 0,3,2,2, 0,3,3,2, 0,3,4,2, 0,3,5,2, - 0,3,6,2, 0,3,7,2, 0,3,8,2, 0,3,9,2, 0,9,2,2, 0,9,3,2, 8,3,0,3, 8,3,1,3, 8,1,8,3, - 8,1,9,3, 0,4,0,2, 0,4,1,2, 0,4,2,2, 0,4,3,2, 0,4,4,2, 0,4,5,2, 0,4,6,2, 0,4,7,2, - 0,4,8,2, 0,4,9,2, 0,8,4,2, 0,8,5,2, 8,4,0,3, 8,4,1,3, 0,8,8,2, 0,8,9,2, 0,5,0,2, - 0,5,1,2, 0,5,2,2, 0,5,3,2, 0,5,4,2, 0,5,5,2, 0,5,6,2, 0,5,7,2, 0,5,8,2, 0,5,9,2, - 0,9,4,2, 0,9,5,2, 8,5,0,3, 8,5,1,3, 0,9,8,2, 0,9,9,2, 0,6,0,2, 0,6,1,2, 0,6,2,2, - 0,6,3,2, 0,6,4,2, 0,6,5,2, 0,6,6,2, 0,6,7,2, 0,6,8,2, 0,6,9,2, 0,8,6,2, 0,8,7,2, - 8,6,0,3, 8,6,1,3, 8,8,8,3, 8,8,9,3, 0,7,0,2, 0,7,1,2, 0,7,2,2, 0,7,3,2, 0,7,4,2, - 0,7,5,2, 0,7,6,2, 0,7,7,2, 0,7,8,2, 0,7,9,2, 0,9,6,2, 0,9,7,2, 8,7,0,3, 8,7,1,3, - 8,9,8,3, 8,9,9,3, 1,0,0,3, 1,0,1,3, 1,0,2,3, 1,0,3,3, 1,0,4,3, 1,0,5,3, 1,0,6,3, - 1,0,7,3, 1,0,8,3, 1,0,9,3, 1,8,0,3, 1,8,1,3, 9,0,0,3, 9,0,1,3, 9,8,0,3, 9,8,1,3, - 1,1,0,3, 1,1,1,3, 1,1,2,3, 1,1,3,3, 1,1,4,3, 1,1,5,3, 1,1,6,3, 1,1,7,3, 1,1,8,3, - 1,1,9,3, 1,9,0,3, 1,9,1,3, 9,1,0,3, 9,1,1,3, 9,9,0,3, 9,9,1,3, 1,2,0,3, 1,2,1,3, - 1,2,2,3, 1,2,3,3, 1,2,4,3, 1,2,5,3, 1,2,6,3, 1,2,7,3, 1,2,8,3, 1,2,9,3, 1,8,2,3, - 1,8,3,3, 9,2,0,3, 9,2,1,3, 9,0,8,3, 9,0,9,3, 1,3,0,3, 1,3,1,3, 1,3,2,3, 1,3,3,3, - 1,3,4,3, 1,3,5,3, 1,3,6,3, 1,3,7,3, 1,3,8,3, 1,3,9,3, 1,9,2,3, 1,9,3,3, 9,3,0,3, - 9,3,1,3, 9,1,8,3, 9,1,9,3, 1,4,0,3, 1,4,1,3, 1,4,2,3, 1,4,3,3, 1,4,4,3, 1,4,5,3, - 1,4,6,3, 1,4,7,3, 1,4,8,3, 1,4,9,3, 1,8,4,3, 1,8,5,3, 9,4,0,3, 9,4,1,3, 1,8,8,3, - 1,8,9,3, 1,5,0,3, 1,5,1,3, 1,5,2,3, 1,5,3,3, 1,5,4,3, 1,5,5,3, 1,5,6,3, 1,5,7,3, - 1,5,8,3, 1,5,9,3, 1,9,4,3, 1,9,5,3, 9,5,0,3, 9,5,1,3, 1,9,8,3, 1,9,9,3, 1,6,0,3, - 1,6,1,3, 1,6,2,3, 1,6,3,3, 1,6,4,3, 1,6,5,3, 1,6,6,3, 1,6,7,3, 1,6,8,3, 1,6,9,3, - 1,8,6,3, 1,8,7,3, 9,6,0,3, 9,6,1,3, 9,8,8,3, 9,8,9,3, 1,7,0,3, 1,7,1,3, 1,7,2,3, - 1,7,3,3, 1,7,4,3, 1,7,5,3, 1,7,6,3, 1,7,7,3, 1,7,8,3, 1,7,9,3, 1,9,6,3, 1,9,7,3, - 9,7,0,3, 9,7,1,3, 9,9,8,3, 9,9,9,3, 2,0,0,3, 2,0,1,3, 2,0,2,3, 2,0,3,3, 2,0,4,3, - 2,0,5,3, 2,0,6,3, 2,0,7,3, 2,0,8,3, 2,0,9,3, 2,8,0,3, 2,8,1,3, 8,0,2,3, 8,0,3,3, - 8,8,2,3, 8,8,3,3, 2,1,0,3, 2,1,1,3, 2,1,2,3, 2,1,3,3, 2,1,4,3, 2,1,5,3, 2,1,6,3, - 2,1,7,3, 2,1,8,3, 2,1,9,3, 2,9,0,3, 2,9,1,3, 8,1,2,3, 8,1,3,3, 8,9,2,3, 8,9,3,3, - 2,2,0,3, 2,2,1,3, 2,2,2,3, 2,2,3,3, 2,2,4,3, 2,2,5,3, 2,2,6,3, 2,2,7,3, 2,2,8,3, - 2,2,9,3, 2,8,2,3, 2,8,3,3, 8,2,2,3, 8,2,3,3, 8,2,8,3, 8,2,9,3, 2,3,0,3, 2,3,1,3, - 2,3,2,3, 2,3,3,3, 2,3,4,3, 2,3,5,3, 2,3,6,3, 2,3,7,3, 2,3,8,3, 2,3,9,3, 2,9,2,3, - 2,9,3,3, 8,3,2,3, 8,3,3,3, 8,3,8,3, 8,3,9,3, 2,4,0,3, 2,4,1,3, 2,4,2,3, 2,4,3,3, - 2,4,4,3, 2,4,5,3, 2,4,6,3, 2,4,7,3, 2,4,8,3, 2,4,9,3, 2,8,4,3, 2,8,5,3, 8,4,2,3, - 8,4,3,3, 2,8,8,3, 2,8,9,3, 2,5,0,3, 2,5,1,3, 2,5,2,3, 2,5,3,3, 2,5,4,3, 2,5,5,3, - 2,5,6,3, 2,5,7,3, 2,5,8,3, 2,5,9,3, 2,9,4,3, 2,9,5,3, 8,5,2,3, 8,5,3,3, 2,9,8,3, - 2,9,9,3, 2,6,0,3, 2,6,1,3, 2,6,2,3, 2,6,3,3, 2,6,4,3, 2,6,5,3, 2,6,6,3, 2,6,7,3, - 2,6,8,3, 2,6,9,3, 2,8,6,3, 2,8,7,3, 8,6,2,3, 8,6,3,3, 8,8,8,3, 8,8,9,3, 2,7,0,3, - 2,7,1,3, 2,7,2,3, 2,7,3,3, 2,7,4,3, 2,7,5,3, 2,7,6,3, 2,7,7,3, 2,7,8,3, 2,7,9,3, - 2,9,6,3, 2,9,7,3, 8,7,2,3, 8,7,3,3, 8,9,8,3, 8,9,9,3, 3,0,0,3, 3,0,1,3, 3,0,2,3, - 3,0,3,3, 3,0,4,3, 3,0,5,3, 3,0,6,3, 3,0,7,3, 3,0,8,3, 3,0,9,3, 3,8,0,3, 3,8,1,3, - 9,0,2,3, 9,0,3,3, 9,8,2,3, 9,8,3,3, 3,1,0,3, 3,1,1,3, 3,1,2,3, 3,1,3,3, 3,1,4,3, - 3,1,5,3, 3,1,6,3, 3,1,7,3, 3,1,8,3, 3,1,9,3, 3,9,0,3, 3,9,1,3, 9,1,2,3, 9,1,3,3, - 9,9,2,3, 9,9,3,3, 3,2,0,3, 3,2,1,3, 3,2,2,3, 3,2,3,3, 3,2,4,3, 3,2,5,3, 3,2,6,3, - 3,2,7,3, 3,2,8,3, 3,2,9,3, 3,8,2,3, 3,8,3,3, 9,2,2,3, 9,2,3,3, 9,2,8,3, 9,2,9,3, - 3,3,0,3, 3,3,1,3, 3,3,2,3, 3,3,3,3, 3,3,4,3, 3,3,5,3, 3,3,6,3, 3,3,7,3, 3,3,8,3, - 3,3,9,3, 3,9,2,3, 3,9,3,3, 9,3,2,3, 9,3,3,3, 9,3,8,3, 9,3,9,3, 3,4,0,3, 3,4,1,3, - 3,4,2,3, 3,4,3,3, 3,4,4,3, 3,4,5,3, 3,4,6,3, 3,4,7,3, 3,4,8,3, 3,4,9,3, 3,8,4,3, - 3,8,5,3, 9,4,2,3, 9,4,3,3, 3,8,8,3, 3,8,9,3, 3,5,0,3, 3,5,1,3, 3,5,2,3, 3,5,3,3, - 3,5,4,3, 3,5,5,3, 3,5,6,3, 3,5,7,3, 3,5,8,3, 3,5,9,3, 3,9,4,3, 3,9,5,3, 9,5,2,3, - 9,5,3,3, 3,9,8,3, 3,9,9,3, 3,6,0,3, 3,6,1,3, 3,6,2,3, 3,6,3,3, 3,6,4,3, 3,6,5,3, - 3,6,6,3, 3,6,7,3, 3,6,8,3, 3,6,9,3, 3,8,6,3, 3,8,7,3, 9,6,2,3, 9,6,3,3, 9,8,8,3, - 9,8,9,3, 3,7,0,3, 3,7,1,3, 3,7,2,3, 3,7,3,3, 3,7,4,3, 3,7,5,3, 3,7,6,3, 3,7,7,3, - 3,7,8,3, 3,7,9,3, 3,9,6,3, 3,9,7,3, 9,7,2,3, 9,7,3,3, 9,9,8,3, 9,9,9,3, 4,0,0,3, - 4,0,1,3, 4,0,2,3, 4,0,3,3, 4,0,4,3, 4,0,5,3, 4,0,6,3, 4,0,7,3, 4,0,8,3, 4,0,9,3, - 4,8,0,3, 4,8,1,3, 8,0,4,3, 8,0,5,3, 8,8,4,3, 8,8,5,3, 4,1,0,3, 4,1,1,3, 4,1,2,3, - 4,1,3,3, 4,1,4,3, 4,1,5,3, 4,1,6,3, 4,1,7,3, 4,1,8,3, 4,1,9,3, 4,9,0,3, 4,9,1,3, - 8,1,4,3, 8,1,5,3, 8,9,4,3, 8,9,5,3, 4,2,0,3, 4,2,1,3, 4,2,2,3, 4,2,3,3, 4,2,4,3, - 4,2,5,3, 4,2,6,3, 4,2,7,3, 4,2,8,3, 4,2,9,3, 4,8,2,3, 4,8,3,3, 8,2,4,3, 8,2,5,3, - 8,4,8,3, 8,4,9,3, 4,3,0,3, 4,3,1,3, 4,3,2,3, 4,3,3,3, 4,3,4,3, 4,3,5,3, 4,3,6,3, - 4,3,7,3, 4,3,8,3, 4,3,9,3, 4,9,2,3, 4,9,3,3, 8,3,4,3, 8,3,5,3, 8,5,8,3, 8,5,9,3, - 4,4,0,3, 4,4,1,3, 4,4,2,3, 4,4,3,3, 4,4,4,3, 4,4,5,3, 4,4,6,3, 4,4,7,3, 4,4,8,3, - 4,4,9,3, 4,8,4,3, 4,8,5,3, 8,4,4,3, 8,4,5,3, 4,8,8,3, 4,8,9,3, 4,5,0,3, 4,5,1,3, - 4,5,2,3, 4,5,3,3, 4,5,4,3, 4,5,5,3, 4,5,6,3, 4,5,7,3, 4,5,8,3, 4,5,9,3, 4,9,4,3, - 4,9,5,3, 8,5,4,3, 8,5,5,3, 4,9,8,3, 4,9,9,3, 4,6,0,3, 4,6,1,3, 4,6,2,3, 4,6,3,3, - 4,6,4,3, 4,6,5,3, 4,6,6,3, 4,6,7,3, 4,6,8,3, 4,6,9,3, 4,8,6,3, 4,8,7,3, 8,6,4,3, - 8,6,5,3, 8,8,8,3, 8,8,9,3, 4,7,0,3, 4,7,1,3, 4,7,2,3, 4,7,3,3, 4,7,4,3, 4,7,5,3, - 4,7,6,3, 4,7,7,3, 4,7,8,3, 4,7,9,3, 4,9,6,3, 4,9,7,3, 8,7,4,3, 8,7,5,3, 8,9,8,3, - 8,9,9,3, 5,0,0,3, 5,0,1,3, 5,0,2,3, 5,0,3,3, 5,0,4,3, 5,0,5,3, 5,0,6,3, 5,0,7,3, - 5,0,8,3, 5,0,9,3, 5,8,0,3, 5,8,1,3, 9,0,4,3, 9,0,5,3, 9,8,4,3, 9,8,5,3, 5,1,0,3, - 5,1,1,3, 5,1,2,3, 5,1,3,3, 5,1,4,3, 5,1,5,3, 5,1,6,3, 5,1,7,3, 5,1,8,3, 5,1,9,3, - 5,9,0,3, 5,9,1,3, 9,1,4,3, 9,1,5,3, 9,9,4,3, 9,9,5,3, 5,2,0,3, 5,2,1,3, 5,2,2,3, - 5,2,3,3, 5,2,4,3, 5,2,5,3, 5,2,6,3, 5,2,7,3, 5,2,8,3, 5,2,9,3, 5,8,2,3, 5,8,3,3, - 9,2,4,3, 9,2,5,3, 9,4,8,3, 9,4,9,3, 5,3,0,3, 5,3,1,3, 5,3,2,3, 5,3,3,3, 5,3,4,3, - 5,3,5,3, 5,3,6,3, 5,3,7,3, 5,3,8,3, 5,3,9,3, 5,9,2,3, 5,9,3,3, 9,3,4,3, 9,3,5,3, - 9,5,8,3, 9,5,9,3, 5,4,0,3, 5,4,1,3, 5,4,2,3, 5,4,3,3, 5,4,4,3, 5,4,5,3, 5,4,6,3, - 5,4,7,3, 5,4,8,3, 5,4,9,3, 5,8,4,3, 5,8,5,3, 9,4,4,3, 9,4,5,3, 5,8,8,3, 5,8,9,3, - 5,5,0,3, 5,5,1,3, 5,5,2,3, 5,5,3,3, 5,5,4,3, 5,5,5,3, 5,5,6,3, 5,5,7,3, 5,5,8,3, - 5,5,9,3, 5,9,4,3, 5,9,5,3, 9,5,4,3, 9,5,5,3, 5,9,8,3, 5,9,9,3, 5,6,0,3, 5,6,1,3, - 5,6,2,3, 5,6,3,3, 5,6,4,3, 5,6,5,3, 5,6,6,3, 5,6,7,3, 5,6,8,3, 5,6,9,3, 5,8,6,3, - 5,8,7,3, 9,6,4,3, 9,6,5,3, 9,8,8,3, 9,8,9,3, 5,7,0,3, 5,7,1,3, 5,7,2,3, 5,7,3,3, - 5,7,4,3, 5,7,5,3, 5,7,6,3, 5,7,7,3, 5,7,8,3, 5,7,9,3, 5,9,6,3, 5,9,7,3, 9,7,4,3, - 9,7,5,3, 9,9,8,3, 9,9,9,3, 6,0,0,3, 6,0,1,3, 6,0,2,3, 6,0,3,3, 6,0,4,3, 6,0,5,3, - 6,0,6,3, 6,0,7,3, 6,0,8,3, 6,0,9,3, 6,8,0,3, 6,8,1,3, 8,0,6,3, 8,0,7,3, 8,8,6,3, - 8,8,7,3, 6,1,0,3, 6,1,1,3, 6,1,2,3, 6,1,3,3, 6,1,4,3, 6,1,5,3, 6,1,6,3, 6,1,7,3, - 6,1,8,3, 6,1,9,3, 6,9,0,3, 6,9,1,3, 8,1,6,3, 8,1,7,3, 8,9,6,3, 8,9,7,3, 6,2,0,3, - 6,2,1,3, 6,2,2,3, 6,2,3,3, 6,2,4,3, 6,2,5,3, 6,2,6,3, 6,2,7,3, 6,2,8,3, 6,2,9,3, - 6,8,2,3, 6,8,3,3, 8,2,6,3, 8,2,7,3, 8,6,8,3, 8,6,9,3, 6,3,0,3, 6,3,1,3, 6,3,2,3, - 6,3,3,3, 6,3,4,3, 6,3,5,3, 6,3,6,3, 6,3,7,3, 6,3,8,3, 6,3,9,3, 6,9,2,3, 6,9,3,3, - 8,3,6,3, 8,3,7,3, 8,7,8,3, 8,7,9,3, 6,4,0,3, 6,4,1,3, 6,4,2,3, 6,4,3,3, 6,4,4,3, - 6,4,5,3, 6,4,6,3, 6,4,7,3, 6,4,8,3, 6,4,9,3, 6,8,4,3, 6,8,5,3, 8,4,6,3, 8,4,7,3, - 6,8,8,3, 6,8,9,3, 6,5,0,3, 6,5,1,3, 6,5,2,3, 6,5,3,3, 6,5,4,3, 6,5,5,3, 6,5,6,3, - 6,5,7,3, 6,5,8,3, 6,5,9,3, 6,9,4,3, 6,9,5,3, 8,5,6,3, 8,5,7,3, 6,9,8,3, 6,9,9,3, - 6,6,0,3, 6,6,1,3, 6,6,2,3, 6,6,3,3, 6,6,4,3, 6,6,5,3, 6,6,6,3, 6,6,7,3, 6,6,8,3, - 6,6,9,3, 6,8,6,3, 6,8,7,3, 8,6,6,3, 8,6,7,3, 8,8,8,3, 8,8,9,3, 6,7,0,3, 6,7,1,3, - 6,7,2,3, 6,7,3,3, 6,7,4,3, 6,7,5,3, 6,7,6,3, 6,7,7,3, 6,7,8,3, 6,7,9,3, 6,9,6,3, - 6,9,7,3, 8,7,6,3, 8,7,7,3, 8,9,8,3, 8,9,9,3, 7,0,0,3, 7,0,1,3, 7,0,2,3, 7,0,3,3, - 7,0,4,3, 7,0,5,3, 7,0,6,3, 7,0,7,3, 7,0,8,3, 7,0,9,3, 7,8,0,3, 7,8,1,3, 9,0,6,3, - 9,0,7,3, 9,8,6,3, 9,8,7,3, 7,1,0,3, 7,1,1,3, 7,1,2,3, 7,1,3,3, 7,1,4,3, 7,1,5,3, - 7,1,6,3, 7,1,7,3, 7,1,8,3, 7,1,9,3, 7,9,0,3, 7,9,1,3, 9,1,6,3, 9,1,7,3, 9,9,6,3, - 9,9,7,3, 7,2,0,3, 7,2,1,3, 7,2,2,3, 7,2,3,3, 7,2,4,3, 7,2,5,3, 7,2,6,3, 7,2,7,3, - 7,2,8,3, 7,2,9,3, 7,8,2,3, 7,8,3,3, 9,2,6,3, 9,2,7,3, 9,6,8,3, 9,6,9,3, 7,3,0,3, - 7,3,1,3, 7,3,2,3, 7,3,3,3, 7,3,4,3, 7,3,5,3, 7,3,6,3, 7,3,7,3, 7,3,8,3, 7,3,9,3, - 7,9,2,3, 7,9,3,3, 9,3,6,3, 9,3,7,3, 9,7,8,3, 9,7,9,3, 7,4,0,3, 7,4,1,3, 7,4,2,3, - 7,4,3,3, 7,4,4,3, 7,4,5,3, 7,4,6,3, 7,4,7,3, 7,4,8,3, 7,4,9,3, 7,8,4,3, 7,8,5,3, - 9,4,6,3, 9,4,7,3, 7,8,8,3, 7,8,9,3, 7,5,0,3, 7,5,1,3, 7,5,2,3, 7,5,3,3, 7,5,4,3, - 7,5,5,3, 7,5,6,3, 7,5,7,3, 7,5,8,3, 7,5,9,3, 7,9,4,3, 7,9,5,3, 9,5,6,3, 9,5,7,3, - 7,9,8,3, 7,9,9,3, 7,6,0,3, 7,6,1,3, 7,6,2,3, 7,6,3,3, 7,6,4,3, 7,6,5,3, 7,6,6,3, - 7,6,7,3, 7,6,8,3, 7,6,9,3, 7,8,6,3, 7,8,7,3, 9,6,6,3, 9,6,7,3, 9,8,8,3, 9,8,9,3, - 7,7,0,3, 7,7,1,3, 7,7,2,3, 7,7,3,3, 7,7,4,3, 7,7,5,3, 7,7,6,3, 7,7,7,3, 7,7,8,3, - 7,7,9,3, 7,9,6,3, 7,9,7,3, 9,7,6,3, 9,7,7,3, 9,9,8,3, 9,9,9,3}; -#endif - -#if defined(DEC_BIN2BCD8) && DEC_BIN2BCD8==1 && !defined(DECBIN2BCD8) -#define DECBIN2BCD8 - -const uint8_t BIN2BCD8[4000]={ - 0,0,0,0, 0,0,1,1, 0,0,2,1, 0,0,3,1, 0,0,4,1, 0,0,5,1, 0,0,6,1, 0,0,7,1, 0,0,8,1, - 0,0,9,1, 0,1,0,2, 0,1,1,2, 0,1,2,2, 0,1,3,2, 0,1,4,2, 0,1,5,2, 0,1,6,2, 0,1,7,2, - 0,1,8,2, 0,1,9,2, 0,2,0,2, 0,2,1,2, 0,2,2,2, 0,2,3,2, 0,2,4,2, 0,2,5,2, 0,2,6,2, - 0,2,7,2, 0,2,8,2, 0,2,9,2, 0,3,0,2, 0,3,1,2, 0,3,2,2, 0,3,3,2, 0,3,4,2, 0,3,5,2, - 0,3,6,2, 0,3,7,2, 0,3,8,2, 0,3,9,2, 0,4,0,2, 0,4,1,2, 0,4,2,2, 0,4,3,2, 0,4,4,2, - 0,4,5,2, 0,4,6,2, 0,4,7,2, 0,4,8,2, 0,4,9,2, 0,5,0,2, 0,5,1,2, 0,5,2,2, 0,5,3,2, - 0,5,4,2, 0,5,5,2, 0,5,6,2, 0,5,7,2, 0,5,8,2, 0,5,9,2, 0,6,0,2, 0,6,1,2, 0,6,2,2, - 0,6,3,2, 0,6,4,2, 0,6,5,2, 0,6,6,2, 0,6,7,2, 0,6,8,2, 0,6,9,2, 0,7,0,2, 0,7,1,2, - 0,7,2,2, 0,7,3,2, 0,7,4,2, 0,7,5,2, 0,7,6,2, 0,7,7,2, 0,7,8,2, 0,7,9,2, 0,8,0,2, - 0,8,1,2, 0,8,2,2, 0,8,3,2, 0,8,4,2, 0,8,5,2, 0,8,6,2, 0,8,7,2, 0,8,8,2, 0,8,9,2, - 0,9,0,2, 0,9,1,2, 0,9,2,2, 0,9,3,2, 0,9,4,2, 0,9,5,2, 0,9,6,2, 0,9,7,2, 0,9,8,2, - 0,9,9,2, 1,0,0,3, 1,0,1,3, 1,0,2,3, 1,0,3,3, 1,0,4,3, 1,0,5,3, 1,0,6,3, 1,0,7,3, - 1,0,8,3, 1,0,9,3, 1,1,0,3, 1,1,1,3, 1,1,2,3, 1,1,3,3, 1,1,4,3, 1,1,5,3, 1,1,6,3, - 1,1,7,3, 1,1,8,3, 1,1,9,3, 1,2,0,3, 1,2,1,3, 1,2,2,3, 1,2,3,3, 1,2,4,3, 1,2,5,3, - 1,2,6,3, 1,2,7,3, 1,2,8,3, 1,2,9,3, 1,3,0,3, 1,3,1,3, 1,3,2,3, 1,3,3,3, 1,3,4,3, - 1,3,5,3, 1,3,6,3, 1,3,7,3, 1,3,8,3, 1,3,9,3, 1,4,0,3, 1,4,1,3, 1,4,2,3, 1,4,3,3, - 1,4,4,3, 1,4,5,3, 1,4,6,3, 1,4,7,3, 1,4,8,3, 1,4,9,3, 1,5,0,3, 1,5,1,3, 1,5,2,3, - 1,5,3,3, 1,5,4,3, 1,5,5,3, 1,5,6,3, 1,5,7,3, 1,5,8,3, 1,5,9,3, 1,6,0,3, 1,6,1,3, - 1,6,2,3, 1,6,3,3, 1,6,4,3, 1,6,5,3, 1,6,6,3, 1,6,7,3, 1,6,8,3, 1,6,9,3, 1,7,0,3, - 1,7,1,3, 1,7,2,3, 1,7,3,3, 1,7,4,3, 1,7,5,3, 1,7,6,3, 1,7,7,3, 1,7,8,3, 1,7,9,3, - 1,8,0,3, 1,8,1,3, 1,8,2,3, 1,8,3,3, 1,8,4,3, 1,8,5,3, 1,8,6,3, 1,8,7,3, 1,8,8,3, - 1,8,9,3, 1,9,0,3, 1,9,1,3, 1,9,2,3, 1,9,3,3, 1,9,4,3, 1,9,5,3, 1,9,6,3, 1,9,7,3, - 1,9,8,3, 1,9,9,3, 2,0,0,3, 2,0,1,3, 2,0,2,3, 2,0,3,3, 2,0,4,3, 2,0,5,3, 2,0,6,3, - 2,0,7,3, 2,0,8,3, 2,0,9,3, 2,1,0,3, 2,1,1,3, 2,1,2,3, 2,1,3,3, 2,1,4,3, 2,1,5,3, - 2,1,6,3, 2,1,7,3, 2,1,8,3, 2,1,9,3, 2,2,0,3, 2,2,1,3, 2,2,2,3, 2,2,3,3, 2,2,4,3, - 2,2,5,3, 2,2,6,3, 2,2,7,3, 2,2,8,3, 2,2,9,3, 2,3,0,3, 2,3,1,3, 2,3,2,3, 2,3,3,3, - 2,3,4,3, 2,3,5,3, 2,3,6,3, 2,3,7,3, 2,3,8,3, 2,3,9,3, 2,4,0,3, 2,4,1,3, 2,4,2,3, - 2,4,3,3, 2,4,4,3, 2,4,5,3, 2,4,6,3, 2,4,7,3, 2,4,8,3, 2,4,9,3, 2,5,0,3, 2,5,1,3, - 2,5,2,3, 2,5,3,3, 2,5,4,3, 2,5,5,3, 2,5,6,3, 2,5,7,3, 2,5,8,3, 2,5,9,3, 2,6,0,3, - 2,6,1,3, 2,6,2,3, 2,6,3,3, 2,6,4,3, 2,6,5,3, 2,6,6,3, 2,6,7,3, 2,6,8,3, 2,6,9,3, - 2,7,0,3, 2,7,1,3, 2,7,2,3, 2,7,3,3, 2,7,4,3, 2,7,5,3, 2,7,6,3, 2,7,7,3, 2,7,8,3, - 2,7,9,3, 2,8,0,3, 2,8,1,3, 2,8,2,3, 2,8,3,3, 2,8,4,3, 2,8,5,3, 2,8,6,3, 2,8,7,3, - 2,8,8,3, 2,8,9,3, 2,9,0,3, 2,9,1,3, 2,9,2,3, 2,9,3,3, 2,9,4,3, 2,9,5,3, 2,9,6,3, - 2,9,7,3, 2,9,8,3, 2,9,9,3, 3,0,0,3, 3,0,1,3, 3,0,2,3, 3,0,3,3, 3,0,4,3, 3,0,5,3, - 3,0,6,3, 3,0,7,3, 3,0,8,3, 3,0,9,3, 3,1,0,3, 3,1,1,3, 3,1,2,3, 3,1,3,3, 3,1,4,3, - 3,1,5,3, 3,1,6,3, 3,1,7,3, 3,1,8,3, 3,1,9,3, 3,2,0,3, 3,2,1,3, 3,2,2,3, 3,2,3,3, - 3,2,4,3, 3,2,5,3, 3,2,6,3, 3,2,7,3, 3,2,8,3, 3,2,9,3, 3,3,0,3, 3,3,1,3, 3,3,2,3, - 3,3,3,3, 3,3,4,3, 3,3,5,3, 3,3,6,3, 3,3,7,3, 3,3,8,3, 3,3,9,3, 3,4,0,3, 3,4,1,3, - 3,4,2,3, 3,4,3,3, 3,4,4,3, 3,4,5,3, 3,4,6,3, 3,4,7,3, 3,4,8,3, 3,4,9,3, 3,5,0,3, - 3,5,1,3, 3,5,2,3, 3,5,3,3, 3,5,4,3, 3,5,5,3, 3,5,6,3, 3,5,7,3, 3,5,8,3, 3,5,9,3, - 3,6,0,3, 3,6,1,3, 3,6,2,3, 3,6,3,3, 3,6,4,3, 3,6,5,3, 3,6,6,3, 3,6,7,3, 3,6,8,3, - 3,6,9,3, 3,7,0,3, 3,7,1,3, 3,7,2,3, 3,7,3,3, 3,7,4,3, 3,7,5,3, 3,7,6,3, 3,7,7,3, - 3,7,8,3, 3,7,9,3, 3,8,0,3, 3,8,1,3, 3,8,2,3, 3,8,3,3, 3,8,4,3, 3,8,5,3, 3,8,6,3, - 3,8,7,3, 3,8,8,3, 3,8,9,3, 3,9,0,3, 3,9,1,3, 3,9,2,3, 3,9,3,3, 3,9,4,3, 3,9,5,3, - 3,9,6,3, 3,9,7,3, 3,9,8,3, 3,9,9,3, 4,0,0,3, 4,0,1,3, 4,0,2,3, 4,0,3,3, 4,0,4,3, - 4,0,5,3, 4,0,6,3, 4,0,7,3, 4,0,8,3, 4,0,9,3, 4,1,0,3, 4,1,1,3, 4,1,2,3, 4,1,3,3, - 4,1,4,3, 4,1,5,3, 4,1,6,3, 4,1,7,3, 4,1,8,3, 4,1,9,3, 4,2,0,3, 4,2,1,3, 4,2,2,3, - 4,2,3,3, 4,2,4,3, 4,2,5,3, 4,2,6,3, 4,2,7,3, 4,2,8,3, 4,2,9,3, 4,3,0,3, 4,3,1,3, - 4,3,2,3, 4,3,3,3, 4,3,4,3, 4,3,5,3, 4,3,6,3, 4,3,7,3, 4,3,8,3, 4,3,9,3, 4,4,0,3, - 4,4,1,3, 4,4,2,3, 4,4,3,3, 4,4,4,3, 4,4,5,3, 4,4,6,3, 4,4,7,3, 4,4,8,3, 4,4,9,3, - 4,5,0,3, 4,5,1,3, 4,5,2,3, 4,5,3,3, 4,5,4,3, 4,5,5,3, 4,5,6,3, 4,5,7,3, 4,5,8,3, - 4,5,9,3, 4,6,0,3, 4,6,1,3, 4,6,2,3, 4,6,3,3, 4,6,4,3, 4,6,5,3, 4,6,6,3, 4,6,7,3, - 4,6,8,3, 4,6,9,3, 4,7,0,3, 4,7,1,3, 4,7,2,3, 4,7,3,3, 4,7,4,3, 4,7,5,3, 4,7,6,3, - 4,7,7,3, 4,7,8,3, 4,7,9,3, 4,8,0,3, 4,8,1,3, 4,8,2,3, 4,8,3,3, 4,8,4,3, 4,8,5,3, - 4,8,6,3, 4,8,7,3, 4,8,8,3, 4,8,9,3, 4,9,0,3, 4,9,1,3, 4,9,2,3, 4,9,3,3, 4,9,4,3, - 4,9,5,3, 4,9,6,3, 4,9,7,3, 4,9,8,3, 4,9,9,3, 5,0,0,3, 5,0,1,3, 5,0,2,3, 5,0,3,3, - 5,0,4,3, 5,0,5,3, 5,0,6,3, 5,0,7,3, 5,0,8,3, 5,0,9,3, 5,1,0,3, 5,1,1,3, 5,1,2,3, - 5,1,3,3, 5,1,4,3, 5,1,5,3, 5,1,6,3, 5,1,7,3, 5,1,8,3, 5,1,9,3, 5,2,0,3, 5,2,1,3, - 5,2,2,3, 5,2,3,3, 5,2,4,3, 5,2,5,3, 5,2,6,3, 5,2,7,3, 5,2,8,3, 5,2,9,3, 5,3,0,3, - 5,3,1,3, 5,3,2,3, 5,3,3,3, 5,3,4,3, 5,3,5,3, 5,3,6,3, 5,3,7,3, 5,3,8,3, 5,3,9,3, - 5,4,0,3, 5,4,1,3, 5,4,2,3, 5,4,3,3, 5,4,4,3, 5,4,5,3, 5,4,6,3, 5,4,7,3, 5,4,8,3, - 5,4,9,3, 5,5,0,3, 5,5,1,3, 5,5,2,3, 5,5,3,3, 5,5,4,3, 5,5,5,3, 5,5,6,3, 5,5,7,3, - 5,5,8,3, 5,5,9,3, 5,6,0,3, 5,6,1,3, 5,6,2,3, 5,6,3,3, 5,6,4,3, 5,6,5,3, 5,6,6,3, - 5,6,7,3, 5,6,8,3, 5,6,9,3, 5,7,0,3, 5,7,1,3, 5,7,2,3, 5,7,3,3, 5,7,4,3, 5,7,5,3, - 5,7,6,3, 5,7,7,3, 5,7,8,3, 5,7,9,3, 5,8,0,3, 5,8,1,3, 5,8,2,3, 5,8,3,3, 5,8,4,3, - 5,8,5,3, 5,8,6,3, 5,8,7,3, 5,8,8,3, 5,8,9,3, 5,9,0,3, 5,9,1,3, 5,9,2,3, 5,9,3,3, - 5,9,4,3, 5,9,5,3, 5,9,6,3, 5,9,7,3, 5,9,8,3, 5,9,9,3, 6,0,0,3, 6,0,1,3, 6,0,2,3, - 6,0,3,3, 6,0,4,3, 6,0,5,3, 6,0,6,3, 6,0,7,3, 6,0,8,3, 6,0,9,3, 6,1,0,3, 6,1,1,3, - 6,1,2,3, 6,1,3,3, 6,1,4,3, 6,1,5,3, 6,1,6,3, 6,1,7,3, 6,1,8,3, 6,1,9,3, 6,2,0,3, - 6,2,1,3, 6,2,2,3, 6,2,3,3, 6,2,4,3, 6,2,5,3, 6,2,6,3, 6,2,7,3, 6,2,8,3, 6,2,9,3, - 6,3,0,3, 6,3,1,3, 6,3,2,3, 6,3,3,3, 6,3,4,3, 6,3,5,3, 6,3,6,3, 6,3,7,3, 6,3,8,3, - 6,3,9,3, 6,4,0,3, 6,4,1,3, 6,4,2,3, 6,4,3,3, 6,4,4,3, 6,4,5,3, 6,4,6,3, 6,4,7,3, - 6,4,8,3, 6,4,9,3, 6,5,0,3, 6,5,1,3, 6,5,2,3, 6,5,3,3, 6,5,4,3, 6,5,5,3, 6,5,6,3, - 6,5,7,3, 6,5,8,3, 6,5,9,3, 6,6,0,3, 6,6,1,3, 6,6,2,3, 6,6,3,3, 6,6,4,3, 6,6,5,3, - 6,6,6,3, 6,6,7,3, 6,6,8,3, 6,6,9,3, 6,7,0,3, 6,7,1,3, 6,7,2,3, 6,7,3,3, 6,7,4,3, - 6,7,5,3, 6,7,6,3, 6,7,7,3, 6,7,8,3, 6,7,9,3, 6,8,0,3, 6,8,1,3, 6,8,2,3, 6,8,3,3, - 6,8,4,3, 6,8,5,3, 6,8,6,3, 6,8,7,3, 6,8,8,3, 6,8,9,3, 6,9,0,3, 6,9,1,3, 6,9,2,3, - 6,9,3,3, 6,9,4,3, 6,9,5,3, 6,9,6,3, 6,9,7,3, 6,9,8,3, 6,9,9,3, 7,0,0,3, 7,0,1,3, - 7,0,2,3, 7,0,3,3, 7,0,4,3, 7,0,5,3, 7,0,6,3, 7,0,7,3, 7,0,8,3, 7,0,9,3, 7,1,0,3, - 7,1,1,3, 7,1,2,3, 7,1,3,3, 7,1,4,3, 7,1,5,3, 7,1,6,3, 7,1,7,3, 7,1,8,3, 7,1,9,3, - 7,2,0,3, 7,2,1,3, 7,2,2,3, 7,2,3,3, 7,2,4,3, 7,2,5,3, 7,2,6,3, 7,2,7,3, 7,2,8,3, - 7,2,9,3, 7,3,0,3, 7,3,1,3, 7,3,2,3, 7,3,3,3, 7,3,4,3, 7,3,5,3, 7,3,6,3, 7,3,7,3, - 7,3,8,3, 7,3,9,3, 7,4,0,3, 7,4,1,3, 7,4,2,3, 7,4,3,3, 7,4,4,3, 7,4,5,3, 7,4,6,3, - 7,4,7,3, 7,4,8,3, 7,4,9,3, 7,5,0,3, 7,5,1,3, 7,5,2,3, 7,5,3,3, 7,5,4,3, 7,5,5,3, - 7,5,6,3, 7,5,7,3, 7,5,8,3, 7,5,9,3, 7,6,0,3, 7,6,1,3, 7,6,2,3, 7,6,3,3, 7,6,4,3, - 7,6,5,3, 7,6,6,3, 7,6,7,3, 7,6,8,3, 7,6,9,3, 7,7,0,3, 7,7,1,3, 7,7,2,3, 7,7,3,3, - 7,7,4,3, 7,7,5,3, 7,7,6,3, 7,7,7,3, 7,7,8,3, 7,7,9,3, 7,8,0,3, 7,8,1,3, 7,8,2,3, - 7,8,3,3, 7,8,4,3, 7,8,5,3, 7,8,6,3, 7,8,7,3, 7,8,8,3, 7,8,9,3, 7,9,0,3, 7,9,1,3, - 7,9,2,3, 7,9,3,3, 7,9,4,3, 7,9,5,3, 7,9,6,3, 7,9,7,3, 7,9,8,3, 7,9,9,3, 8,0,0,3, - 8,0,1,3, 8,0,2,3, 8,0,3,3, 8,0,4,3, 8,0,5,3, 8,0,6,3, 8,0,7,3, 8,0,8,3, 8,0,9,3, - 8,1,0,3, 8,1,1,3, 8,1,2,3, 8,1,3,3, 8,1,4,3, 8,1,5,3, 8,1,6,3, 8,1,7,3, 8,1,8,3, - 8,1,9,3, 8,2,0,3, 8,2,1,3, 8,2,2,3, 8,2,3,3, 8,2,4,3, 8,2,5,3, 8,2,6,3, 8,2,7,3, - 8,2,8,3, 8,2,9,3, 8,3,0,3, 8,3,1,3, 8,3,2,3, 8,3,3,3, 8,3,4,3, 8,3,5,3, 8,3,6,3, - 8,3,7,3, 8,3,8,3, 8,3,9,3, 8,4,0,3, 8,4,1,3, 8,4,2,3, 8,4,3,3, 8,4,4,3, 8,4,5,3, - 8,4,6,3, 8,4,7,3, 8,4,8,3, 8,4,9,3, 8,5,0,3, 8,5,1,3, 8,5,2,3, 8,5,3,3, 8,5,4,3, - 8,5,5,3, 8,5,6,3, 8,5,7,3, 8,5,8,3, 8,5,9,3, 8,6,0,3, 8,6,1,3, 8,6,2,3, 8,6,3,3, - 8,6,4,3, 8,6,5,3, 8,6,6,3, 8,6,7,3, 8,6,8,3, 8,6,9,3, 8,7,0,3, 8,7,1,3, 8,7,2,3, - 8,7,3,3, 8,7,4,3, 8,7,5,3, 8,7,6,3, 8,7,7,3, 8,7,8,3, 8,7,9,3, 8,8,0,3, 8,8,1,3, - 8,8,2,3, 8,8,3,3, 8,8,4,3, 8,8,5,3, 8,8,6,3, 8,8,7,3, 8,8,8,3, 8,8,9,3, 8,9,0,3, - 8,9,1,3, 8,9,2,3, 8,9,3,3, 8,9,4,3, 8,9,5,3, 8,9,6,3, 8,9,7,3, 8,9,8,3, 8,9,9,3, - 9,0,0,3, 9,0,1,3, 9,0,2,3, 9,0,3,3, 9,0,4,3, 9,0,5,3, 9,0,6,3, 9,0,7,3, 9,0,8,3, - 9,0,9,3, 9,1,0,3, 9,1,1,3, 9,1,2,3, 9,1,3,3, 9,1,4,3, 9,1,5,3, 9,1,6,3, 9,1,7,3, - 9,1,8,3, 9,1,9,3, 9,2,0,3, 9,2,1,3, 9,2,2,3, 9,2,3,3, 9,2,4,3, 9,2,5,3, 9,2,6,3, - 9,2,7,3, 9,2,8,3, 9,2,9,3, 9,3,0,3, 9,3,1,3, 9,3,2,3, 9,3,3,3, 9,3,4,3, 9,3,5,3, - 9,3,6,3, 9,3,7,3, 9,3,8,3, 9,3,9,3, 9,4,0,3, 9,4,1,3, 9,4,2,3, 9,4,3,3, 9,4,4,3, - 9,4,5,3, 9,4,6,3, 9,4,7,3, 9,4,8,3, 9,4,9,3, 9,5,0,3, 9,5,1,3, 9,5,2,3, 9,5,3,3, - 9,5,4,3, 9,5,5,3, 9,5,6,3, 9,5,7,3, 9,5,8,3, 9,5,9,3, 9,6,0,3, 9,6,1,3, 9,6,2,3, - 9,6,3,3, 9,6,4,3, 9,6,5,3, 9,6,6,3, 9,6,7,3, 9,6,8,3, 9,6,9,3, 9,7,0,3, 9,7,1,3, - 9,7,2,3, 9,7,3,3, 9,7,4,3, 9,7,5,3, 9,7,6,3, 9,7,7,3, 9,7,8,3, 9,7,9,3, 9,8,0,3, - 9,8,1,3, 9,8,2,3, 9,8,3,3, 9,8,4,3, 9,8,5,3, 9,8,6,3, 9,8,7,3, 9,8,8,3, 9,8,9,3, - 9,9,0,3, 9,9,1,3, 9,9,2,3, 9,9,3,3, 9,9,4,3, 9,9,5,3, 9,9,6,3, 9,9,7,3, 9,9,8,3, - 9,9,9,3}; -#endif - diff --git a/decnumber/src/decNumberLocal.h.in b/decnumber/src/decNumberLocal.h.in deleted file mode 100644 --- a/decnumber/src/decNumberLocal.h.in +++ /dev/null @@ -1,757 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* decNumber package local type, tuning, and macro definitions */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is called decNumber.pdf. This document is */ -/* available, together with arithmetic and format specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* This header file is included by all modules in the decNumber */ -/* library, and contains local type definitions, tuning parameters, */ -/* etc. It should not need to be used by application programs. */ -/* decNumber.h or one of decDouble (etc.) must be included first. */ -/* ------------------------------------------------------------------ */ - -#if !defined(DECNUMBERLOC) - #define DECNUMBERLOC - #define DECVERSION "decNumber 3.68" /* Package Version [16 max.] */ - #define DECNLAUTHOR "Mike Cowlishaw" /* Who to blame */ - - #include /* for abs */ - #include /* for memset, strcpy */ - - /* Conditional code flag -- set this to match hardware platform */ - #if !defined(DECLITEND) - #define DECLITEND @LITEND@ /* 1=little-endian, 0=big-endian */ - #endif - - /* Conditional code flag -- set this to 1 for best performance */ - #if !defined(DECUSE64) - #define DECUSE64 1 /* 1=use int64s, 0=int32 & smaller only */ - #endif - - /* Conditional code flag -- set this to 0 to exclude printf calls */ - #if !defined(DECPRINT) - #define DECPRINT 1 /* 1=allow printf calls; 0=no printf */ - #endif - - /* Conditional check flags -- set these to 0 for best performance */ - #if !defined(DECCHECK) - #define DECCHECK 0 /* 1 to enable robust checking */ - #endif - #if !defined(DECALLOC) - #define DECALLOC 0 /* 1 to enable memory accounting */ - #endif - #if !defined(DECTRACE) - #define DECTRACE 0 /* 1 to trace certain internals, etc. */ - #endif - - /* Tuning parameter for decNumber (arbitrary precision) module */ - #if !defined(DECBUFFER) - #define DECBUFFER 36 /* Size basis for local buffers. This */ - /* should be a common maximum precision */ - /* rounded up to a multiple of 4; must */ - /* be zero or positive. */ - #endif - - - /* ---------------------------------------------------------------- */ - /* Check parameter dependencies */ - /* ---------------------------------------------------------------- */ - #if DECCHECK & !DECPRINT - #error DECCHECK needs DECPRINT to be useful - #endif - #if DECALLOC & !DECPRINT - #error DECALLOC needs DECPRINT to be useful - #endif - #if DECTRACE & !DECPRINT - #error DECTRACE needs DECPRINT to be useful - #endif - - /* ---------------------------------------------------------------- */ - /* Definitions for all modules (general-purpose) */ - /* ---------------------------------------------------------------- */ - - /* Local names for common types -- for safety, decNumber modules do */ - /* not use int or long directly. */ - #define Flag uint8_t - #define Byte int8_t - #define uByte uint8_t - #define Short int16_t - #define uShort uint16_t - #define Int int32_t - #define uInt uint32_t - #define Unit decNumberUnit - #if DECUSE64 - #define Long int64_t - #define uLong uint64_t - #endif - - /* Development-use definitions */ - typedef long int LI; /* for printf arguments only */ - #define DECNOINT 0 /* 1 to check no internal use of 'int' */ - /* or stdint types */ - #if DECNOINT - /* if these interfere with your C includes, do not set DECNOINT */ - #define int ? /* enable to ensure that plain C 'int' */ - #define long ?? /* .. or 'long' types are not used */ - #endif - - /* Shared lookup tables */ - extern const uByte DECSTICKYTAB[10]; /* re-round digits if sticky */ - extern const uInt DECPOWERS[10]; /* powers of ten table */ - /* The following are included from decDPD.h */ - extern const uShort DPD2BIN[1024]; /* DPD -> 0-999 */ - extern const uShort BIN2DPD[1000]; /* 0-999 -> DPD */ - extern const uInt DPD2BINK[1024]; /* DPD -> 0-999000 */ - extern const uInt DPD2BINM[1024]; /* DPD -> 0-999000000 */ - extern const uByte DPD2BCD8[4096]; /* DPD -> ddd + len */ - extern const uByte BIN2BCD8[4000]; /* 0-999 -> ddd + len */ - extern const uShort BCD2DPD[2458]; /* 0-0x999 -> DPD (0x999=2457)*/ - - /* LONGMUL32HI -- set w=(u*v)>>32, where w, u, and v are uInts */ - /* (that is, sets w to be the high-order word of the 64-bit result; */ - /* the low-order word is simply u*v.) */ - /* This version is derived from Knuth via Hacker's Delight; */ - /* it seems to optimize better than some others tried */ - #define LONGMUL32HI(w, u, v) { \ - uInt u0, u1, v0, v1, w0, w1, w2, t; \ - u0=u & 0xffff; u1=u>>16; \ - v0=v & 0xffff; v1=v>>16; \ - w0=u0*v0; \ - t=u1*v0 + (w0>>16); \ - w1=t & 0xffff; w2=t>>16; \ - w1=u0*v1 + w1; \ - (w)=u1*v1 + w2 + (w1>>16);} - - /* ROUNDUP -- round an integer up to a multiple of n */ - #define ROUNDUP(i, n) ((((i)+(n)-1)/n)*n) - #define ROUNDUP4(i) (((i)+3)&~3) /* special for n=4 */ - - /* ROUNDDOWN -- round an integer down to a multiple of n */ - #define ROUNDDOWN(i, n) (((i)/n)*n) - #define ROUNDDOWN4(i) ((i)&~3) /* special for n=4 */ - - /* References to multi-byte sequences under different sizes; these */ - /* require locally declared variables, but do not violate strict */ - /* aliasing or alignment (as did the UINTAT simple cast to uInt). */ - /* Variables needed are uswork, uiwork, etc. [so do not use at same */ - /* level in an expression, e.g., UBTOUI(x)==UBTOUI(y) may fail]. */ - - /* Return a uInt, etc., from bytes starting at a char* or uByte* */ - #define UBTOUS(b) (memcpy((void *)&uswork, b, 2), uswork) - #define UBTOUI(b) (memcpy((void *)&uiwork, b, 4), uiwork) - - /* Store a uInt, etc., into bytes starting at a char* or uByte*. */ - /* Returns i, evaluated, for convenience; has to use uiwork because */ - /* i may be an expression. */ - #define UBFROMUS(b, i) (uswork=(i), memcpy(b, (void *)&uswork, 2), uswork) - #define UBFROMUI(b, i) (uiwork=(i), memcpy(b, (void *)&uiwork, 4), uiwork) - - /* X10 and X100 -- multiply integer i by 10 or 100 */ - /* [shifts are usually faster than multiply; could be conditional] */ - #define X10(i) (((i)<<1)+((i)<<3)) - #define X100(i) (((i)<<2)+((i)<<5)+((i)<<6)) - - /* MAXI and MINI -- general max & min (not in ANSI) for integers */ - #define MAXI(x,y) ((x)<(y)?(y):(x)) - #define MINI(x,y) ((x)>(y)?(y):(x)) - - /* Useful constants */ - #define BILLION 1000000000 /* 10**9 */ - /* CHARMASK: 0x30303030 for ASCII/UTF8; 0xF0F0F0F0 for EBCDIC */ - #define CHARMASK ((((((((uInt)'0')<<8)+'0')<<8)+'0')<<8)+'0') - - - /* ---------------------------------------------------------------- */ - /* Definitions for arbitary-precision modules (only valid after */ - /* decNumber.h has been included) */ - /* ---------------------------------------------------------------- */ - - /* Limits and constants */ - #define DECNUMMAXP 999999999 /* maximum precision code can handle */ - #define DECNUMMAXE 999999999 /* maximum adjusted exponent ditto */ - #define DECNUMMINE -999999999 /* minimum adjusted exponent ditto */ - #if (DECNUMMAXP != DEC_MAX_DIGITS) - #error Maximum digits mismatch - #endif - #if (DECNUMMAXE != DEC_MAX_EMAX) - #error Maximum exponent mismatch - #endif - #if (DECNUMMINE != DEC_MIN_EMIN) - #error Minimum exponent mismatch - #endif - - /* Set DECDPUNMAX -- the maximum integer that fits in DECDPUN */ - /* digits, and D2UTABLE -- the initializer for the D2U table */ - #if DECDPUN==1 - #define DECDPUNMAX 9 - #define D2UTABLE {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17, \ - 18,19,20,21,22,23,24,25,26,27,28,29,30,31,32, \ - 33,34,35,36,37,38,39,40,41,42,43,44,45,46,47, \ - 48,49} - #elif DECDPUN==2 - #define DECDPUNMAX 99 - #define D2UTABLE {0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10, \ - 11,11,12,12,13,13,14,14,15,15,16,16,17,17,18, \ - 18,19,19,20,20,21,21,22,22,23,23,24,24,25} - #elif DECDPUN==3 - #define DECDPUNMAX 999 - #define D2UTABLE {0,1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6,7,7,7, \ - 8,8,8,9,9,9,10,10,10,11,11,11,12,12,12,13,13, \ - 13,14,14,14,15,15,15,16,16,16,17} - #elif DECDPUN==4 - #define DECDPUNMAX 9999 - #define D2UTABLE {0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6, \ - 6,6,6,7,7,7,7,8,8,8,8,9,9,9,9,10,10,10,10,11, \ - 11,11,11,12,12,12,12,13} - #elif DECDPUN==5 - #define DECDPUNMAX 99999 - #define D2UTABLE {0,1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5, \ - 5,5,5,5,6,6,6,6,6,7,7,7,7,7,8,8,8,8,8,9,9,9, \ - 9,9,10,10,10,10} - #elif DECDPUN==6 - #define DECDPUNMAX 999999 - #define D2UTABLE {0,1,1,1,1,1,1,2,2,2,2,2,2,3,3,3,3,3,3,4,4,4, \ - 4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,7,7,7,7,7,7,8, \ - 8,8,8,8,8,9} - #elif DECDPUN==7 - #define DECDPUNMAX 9999999 - #define D2UTABLE {0,1,1,1,1,1,1,1,2,2,2,2,2,2,2,3,3,3,3,3,3,3, \ - 4,4,4,4,4,4,4,5,5,5,5,5,5,5,6,6,6,6,6,6,6,7, \ - 7,7,7,7,7,7} - #elif DECDPUN==8 - #define DECDPUNMAX 99999999 - #define D2UTABLE {0,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3, \ - 3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6, \ - 6,6,6,6,6,7} - #elif DECDPUN==9 - #define DECDPUNMAX 999999999 - #define D2UTABLE {0,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,3,3,3, \ - 3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5, \ - 5,5,6,6,6,6} - #elif defined(DECDPUN) - #error DECDPUN must be in the range 1-9 - #endif - - /* ----- Shared data (in decNumber.c) ----- */ - /* Public lookup table used by the D2U macro (see below) */ - #define DECMAXD2U 49 - extern const uByte d2utable[DECMAXD2U+1]; - - /* ----- Macros ----- */ - /* ISZERO -- return true if decNumber dn is a zero */ - /* [performance-critical in some situations] */ - #define ISZERO(dn) decNumberIsZero(dn) /* now just a local name */ - - /* D2U -- return the number of Units needed to hold d digits */ - /* (runtime version, with table lookaside for small d) */ - #if DECDPUN==8 - #define D2U(d) ((unsigned)((d)<=DECMAXD2U?d2utable[d]:((d)+7)>>3)) - #elif DECDPUN==4 - #define D2U(d) ((unsigned)((d)<=DECMAXD2U?d2utable[d]:((d)+3)>>2)) - #else - #define D2U(d) ((d)<=DECMAXD2U?d2utable[d]:((d)+DECDPUN-1)/DECDPUN) - #endif - /* SD2U -- static D2U macro (for compile-time calculation) */ - #define SD2U(d) (((d)+DECDPUN-1)/DECDPUN) - - /* MSUDIGITS -- returns digits in msu, from digits, calculated */ - /* using D2U */ - #define MSUDIGITS(d) ((d)-(D2U(d)-1)*DECDPUN) - - /* D2N -- return the number of decNumber structs that would be */ - /* needed to contain that number of digits (and the initial */ - /* decNumber struct) safely. Note that one Unit is included in the */ - /* initial structure. Used for allocating space that is aligned on */ - /* a decNumber struct boundary. */ - #define D2N(d) \ - ((((SD2U(d)-1)*sizeof(Unit))+sizeof(decNumber)*2-1)/sizeof(decNumber)) - - /* TODIGIT -- macro to remove the leading digit from the unsigned */ - /* integer u at column cut (counting from the right, LSD=0) and */ - /* place it as an ASCII character into the character pointed to by */ - /* c. Note that cut must be <= 9, and the maximum value for u is */ - /* 2,000,000,000 (as is needed for negative exponents of */ - /* subnormals). The unsigned integer pow is used as a temporary */ - /* variable. */ - #define TODIGIT(u, cut, c, pow) { \ - *(c)='0'; \ - pow=DECPOWERS[cut]*2; \ - if ((u)>pow) { \ - pow*=4; \ - if ((u)>=pow) {(u)-=pow; *(c)+=8;} \ - pow/=2; \ - if ((u)>=pow) {(u)-=pow; *(c)+=4;} \ - pow/=2; \ - } \ - if ((u)>=pow) {(u)-=pow; *(c)+=2;} \ - pow/=2; \ - if ((u)>=pow) {(u)-=pow; *(c)+=1;} \ - } - - /* ---------------------------------------------------------------- */ - /* Definitions for fixed-precision modules (only valid after */ - /* decSingle.h, decDouble.h, or decQuad.h has been included) */ - /* ---------------------------------------------------------------- */ - - /* bcdnum -- a structure describing a format-independent finite */ - /* number, whose coefficient is a string of bcd8 uBytes */ - typedef struct { - uByte *msd; /* -> most significant digit */ - uByte *lsd; /* -> least ditto */ - uInt sign; /* 0=positive, DECFLOAT_Sign=negative */ - Int exponent; /* Unadjusted signed exponent (q), or */ - /* DECFLOAT_NaN etc. for a special */ - } bcdnum; - - /* Test if exponent or bcdnum exponent must be a special, etc. */ - #define EXPISSPECIAL(exp) ((exp)>=DECFLOAT_MinSp) - #define EXPISINF(exp) (exp==DECFLOAT_Inf) - #define EXPISNAN(exp) (exp==DECFLOAT_qNaN || exp==DECFLOAT_sNaN) - #define NUMISSPECIAL(num) (EXPISSPECIAL((num)->exponent)) - - /* Refer to a 32-bit word or byte in a decFloat (df) by big-endian */ - /* (array) notation (the 0 word or byte contains the sign bit), */ - /* automatically adjusting for endianness; similarly address a word */ - /* in the next-wider format (decFloatWider, or dfw) */ - #define DECWORDS (DECBYTES/4) - #define DECWWORDS (DECWBYTES/4) - #if DECLITEND - #define DFBYTE(df, off) ((df)->bytes[DECBYTES-1-(off)]) - #define DFWORD(df, off) ((df)->words[DECWORDS-1-(off)]) - #define DFWWORD(dfw, off) ((dfw)->words[DECWWORDS-1-(off)]) - #else - #define DFBYTE(df, off) ((df)->bytes[off]) - #define DFWORD(df, off) ((df)->words[off]) - #define DFWWORD(dfw, off) ((dfw)->words[off]) - #endif - - /* Tests for sign or specials, directly on DECFLOATs */ - #define DFISSIGNED(df) ((DFWORD(df, 0)&0x80000000)!=0) - #define DFISSPECIAL(df) ((DFWORD(df, 0)&0x78000000)==0x78000000) - #define DFISINF(df) ((DFWORD(df, 0)&0x7c000000)==0x78000000) - #define DFISNAN(df) ((DFWORD(df, 0)&0x7c000000)==0x7c000000) - #define DFISQNAN(df) ((DFWORD(df, 0)&0x7e000000)==0x7c000000) - #define DFISSNAN(df) ((DFWORD(df, 0)&0x7e000000)==0x7e000000) - - /* Shared lookup tables */ - extern const uInt DECCOMBMSD[64]; /* Combination field -> MSD */ - extern const uInt DECCOMBFROM[48]; /* exp+msd -> Combination */ - - /* Private generic (utility) routine */ - #if DECCHECK || DECTRACE - extern void decShowNum(const bcdnum *, const char *); - #endif - - /* Format-dependent macros and constants */ - #if defined(DECPMAX) - - /* Useful constants */ - #define DECPMAX9 (ROUNDUP(DECPMAX, 9)/9) /* 'Pmax' in 10**9s */ - /* Top words for a zero */ - #define SINGLEZERO 0x22500000 - #define DOUBLEZERO 0x22380000 - #define QUADZERO 0x22080000 - /* [ZEROWORD is defined to be one of these in the DFISZERO macro] */ - - /* Format-dependent common tests: */ - /* DFISZERO -- test for (any) zero */ - /* DFISCCZERO -- test for coefficient continuation being zero */ - /* DFISCC01 -- test for coefficient contains only 0s and 1s */ - /* DFISINT -- test for finite and exponent q=0 */ - /* DFISUINT01 -- test for sign=0, finite, exponent q=0, and */ - /* MSD=0 or 1 */ - /* ZEROWORD is also defined here. */ - /* */ - /* In DFISZERO the first test checks the least-significant word */ - /* (most likely to be non-zero); the penultimate tests MSD and */ - /* DPDs in the signword, and the final test excludes specials and */ - /* MSD>7. DFISINT similarly has to allow for the two forms of */ - /* MSD codes. DFISUINT01 only has to allow for one form of MSD */ - /* code. */ - #if DECPMAX==7 - #define ZEROWORD SINGLEZERO - /* [test macros not needed except for Zero] */ - #define DFISZERO(df) ((DFWORD(df, 0)&0x1c0fffff)==0 \ - && (DFWORD(df, 0)&0x60000000)!=0x60000000) - #elif DECPMAX==16 - #define ZEROWORD DOUBLEZERO - #define DFISZERO(df) ((DFWORD(df, 1)==0 \ - && (DFWORD(df, 0)&0x1c03ffff)==0 \ - && (DFWORD(df, 0)&0x60000000)!=0x60000000)) - #define DFISINT(df) ((DFWORD(df, 0)&0x63fc0000)==0x22380000 \ - ||(DFWORD(df, 0)&0x7bfc0000)==0x6a380000) - #define DFISUINT01(df) ((DFWORD(df, 0)&0xfbfc0000)==0x22380000) - #define DFISCCZERO(df) (DFWORD(df, 1)==0 \ - && (DFWORD(df, 0)&0x0003ffff)==0) - #define DFISCC01(df) ((DFWORD(df, 0)&~0xfffc9124)==0 \ - && (DFWORD(df, 1)&~0x49124491)==0) - #elif DECPMAX==34 - #define ZEROWORD QUADZERO - #define DFISZERO(df) ((DFWORD(df, 3)==0 \ - && DFWORD(df, 2)==0 \ - && DFWORD(df, 1)==0 \ - && (DFWORD(df, 0)&0x1c003fff)==0 \ - && (DFWORD(df, 0)&0x60000000)!=0x60000000)) - #define DFISINT(df) ((DFWORD(df, 0)&0x63ffc000)==0x22080000 \ - ||(DFWORD(df, 0)&0x7bffc000)==0x6a080000) - #define DFISUINT01(df) ((DFWORD(df, 0)&0xfbffc000)==0x22080000) - #define DFISCCZERO(df) (DFWORD(df, 3)==0 \ - && DFWORD(df, 2)==0 \ - && DFWORD(df, 1)==0 \ - && (DFWORD(df, 0)&0x00003fff)==0) - - #define DFISCC01(df) ((DFWORD(df, 0)&~0xffffc912)==0 \ - && (DFWORD(df, 1)&~0x44912449)==0 \ - && (DFWORD(df, 2)&~0x12449124)==0 \ - && (DFWORD(df, 3)&~0x49124491)==0) - #endif - - /* Macros to test if a certain 10 bits of a uInt or pair of uInts */ - /* are a canonical declet [higher or lower bits are ignored]. */ - /* declet is at offset 0 (from the right) in a uInt: */ - #define CANONDPD(dpd) (((dpd)&0x300)==0 || ((dpd)&0x6e)!=0x6e) - /* declet is at offset k (a multiple of 2) in a uInt: */ - #define CANONDPDOFF(dpd, k) (((dpd)&(0x300<<(k)))==0 \ - || ((dpd)&(((uInt)0x6e)<<(k)))!=(((uInt)0x6e)<<(k))) - /* declet is at offset k (a multiple of 2) in a pair of uInts: */ - /* [the top 2 bits will always be in the more-significant uInt] */ - #define CANONDPDTWO(hi, lo, k) (((hi)&(0x300>>(32-(k))))==0 \ - || ((hi)&(0x6e>>(32-(k))))!=(0x6e>>(32-(k))) \ - || ((lo)&(((uInt)0x6e)<<(k)))!=(((uInt)0x6e)<<(k))) - - /* Macro to test whether a full-length (length DECPMAX) BCD8 */ - /* coefficient, starting at uByte u, is all zeros */ - /* Test just the LSWord first, then the remainder as a sequence */ - /* of tests in order to avoid same-level use of UBTOUI */ - #if DECPMAX==7 - #define ISCOEFFZERO(u) ( \ - UBTOUI((u)+DECPMAX-4)==0 \ - && UBTOUS((u)+DECPMAX-6)==0 \ - && *(u)==0) - #elif DECPMAX==16 - #define ISCOEFFZERO(u) ( \ - UBTOUI((u)+DECPMAX-4)==0 \ - && UBTOUI((u)+DECPMAX-8)==0 \ - && UBTOUI((u)+DECPMAX-12)==0 \ - && UBTOUI(u)==0) - #elif DECPMAX==34 - #define ISCOEFFZERO(u) ( \ - UBTOUI((u)+DECPMAX-4)==0 \ - && UBTOUI((u)+DECPMAX-8)==0 \ - && UBTOUI((u)+DECPMAX-12)==0 \ - && UBTOUI((u)+DECPMAX-16)==0 \ - && UBTOUI((u)+DECPMAX-20)==0 \ - && UBTOUI((u)+DECPMAX-24)==0 \ - && UBTOUI((u)+DECPMAX-28)==0 \ - && UBTOUI((u)+DECPMAX-32)==0 \ - && UBTOUS(u)==0) - #endif - - /* Macros and masks for the sign, exponent continuation, and MSD */ - /* Get the sign as DECFLOAT_Sign or 0 */ - #define GETSIGN(df) (DFWORD(df, 0)&0x80000000) - /* Get the exponent continuation from a decFloat *df as an Int */ - #define GETECON(df) ((Int)((DFWORD((df), 0)&0x03ffffff)>>(32-6-DECECONL))) - /* Ditto, from the next-wider format */ - #define GETWECON(df) ((Int)((DFWWORD((df), 0)&0x03ffffff)>>(32-6-DECWECONL))) - /* Get the biased exponent similarly */ - #define GETEXP(df) ((Int)(DECCOMBEXP[DFWORD((df), 0)>>26]+GETECON(df))) - /* Get the unbiased exponent similarly */ - #define GETEXPUN(df) ((Int)GETEXP(df)-DECBIAS) - /* Get the MSD similarly (as uInt) */ - #define GETMSD(df) (DECCOMBMSD[DFWORD((df), 0)>>26]) - - /* Compile-time computes of the exponent continuation field masks */ - /* full exponent continuation field: */ - #define ECONMASK ((0x03ffffff>>(32-6-DECECONL))<<(32-6-DECECONL)) - /* same, not including its first digit (the qNaN/sNaN selector): */ - #define ECONNANMASK ((0x01ffffff>>(32-6-DECECONL))<<(32-6-DECECONL)) - - /* Macros to decode the coefficient in a finite decFloat *df into */ - /* a BCD string (uByte *bcdin) of length DECPMAX uBytes. */ - - /* In-line sequence to convert least significant 10 bits of uInt */ - /* dpd to three BCD8 digits starting at uByte u. Note that an */ - /* extra byte is written to the right of the three digits because */ - /* four bytes are moved at a time for speed; the alternative */ - /* macro moves exactly three bytes (usually slower). */ - #define dpd2bcd8(u, dpd) memcpy(u, &DPD2BCD8[((dpd)&0x3ff)*4], 4) - #define dpd2bcd83(u, dpd) memcpy(u, &DPD2BCD8[((dpd)&0x3ff)*4], 3) - - /* Decode the declets. After extracting each one, it is decoded */ - /* to BCD8 using a table lookup (also used for variable-length */ - /* decode). Each DPD decode is 3 bytes BCD8 plus a one-byte */ - /* length which is not used, here). Fixed-length 4-byte moves */ - /* are fast, however, almost everywhere, and so are used except */ - /* for the final three bytes (to avoid overrun). The code below */ - /* is 36 instructions for Doubles and about 70 for Quads, even */ - /* on IA32. */ - - /* Two macros are defined for each format: */ - /* GETCOEFF extracts the coefficient of the current format */ - /* GETWCOEFF extracts the coefficient of the next-wider format. */ - /* The latter is a copy of the next-wider GETCOEFF using DFWWORD. */ - - #if DECPMAX==7 - #define GETCOEFF(df, bcd) { \ - uInt sourhi=DFWORD(df, 0); \ - *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \ - dpd2bcd8(bcd+1, sourhi>>10); \ - dpd2bcd83(bcd+4, sourhi);} - #define GETWCOEFF(df, bcd) { \ - uInt sourhi=DFWWORD(df, 0); \ - uInt sourlo=DFWWORD(df, 1); \ - *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \ - dpd2bcd8(bcd+1, sourhi>>8); \ - dpd2bcd8(bcd+4, (sourhi<<2) | (sourlo>>30)); \ - dpd2bcd8(bcd+7, sourlo>>20); \ - dpd2bcd8(bcd+10, sourlo>>10); \ - dpd2bcd83(bcd+13, sourlo);} - - #elif DECPMAX==16 - #define GETCOEFF(df, bcd) { \ - uInt sourhi=DFWORD(df, 0); \ - uInt sourlo=DFWORD(df, 1); \ - *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \ - dpd2bcd8(bcd+1, sourhi>>8); \ - dpd2bcd8(bcd+4, (sourhi<<2) | (sourlo>>30)); \ - dpd2bcd8(bcd+7, sourlo>>20); \ - dpd2bcd8(bcd+10, sourlo>>10); \ - dpd2bcd83(bcd+13, sourlo);} - #define GETWCOEFF(df, bcd) { \ - uInt sourhi=DFWWORD(df, 0); \ - uInt sourmh=DFWWORD(df, 1); \ - uInt sourml=DFWWORD(df, 2); \ - uInt sourlo=DFWWORD(df, 3); \ - *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \ - dpd2bcd8(bcd+1, sourhi>>4); \ - dpd2bcd8(bcd+4, ((sourhi)<<6) | (sourmh>>26)); \ - dpd2bcd8(bcd+7, sourmh>>16); \ - dpd2bcd8(bcd+10, sourmh>>6); \ - dpd2bcd8(bcd+13, ((sourmh)<<4) | (sourml>>28)); \ - dpd2bcd8(bcd+16, sourml>>18); \ - dpd2bcd8(bcd+19, sourml>>8); \ - dpd2bcd8(bcd+22, ((sourml)<<2) | (sourlo>>30)); \ - dpd2bcd8(bcd+25, sourlo>>20); \ - dpd2bcd8(bcd+28, sourlo>>10); \ - dpd2bcd83(bcd+31, sourlo);} - - #elif DECPMAX==34 - #define GETCOEFF(df, bcd) { \ - uInt sourhi=DFWORD(df, 0); \ - uInt sourmh=DFWORD(df, 1); \ - uInt sourml=DFWORD(df, 2); \ - uInt sourlo=DFWORD(df, 3); \ - *(bcd)=(uByte)DECCOMBMSD[sourhi>>26]; \ - dpd2bcd8(bcd+1, sourhi>>4); \ - dpd2bcd8(bcd+4, ((sourhi)<<6) | (sourmh>>26)); \ - dpd2bcd8(bcd+7, sourmh>>16); \ - dpd2bcd8(bcd+10, sourmh>>6); \ - dpd2bcd8(bcd+13, ((sourmh)<<4) | (sourml>>28)); \ - dpd2bcd8(bcd+16, sourml>>18); \ - dpd2bcd8(bcd+19, sourml>>8); \ - dpd2bcd8(bcd+22, ((sourml)<<2) | (sourlo>>30)); \ - dpd2bcd8(bcd+25, sourlo>>20); \ - dpd2bcd8(bcd+28, sourlo>>10); \ - dpd2bcd83(bcd+31, sourlo);} - - #define GETWCOEFF(df, bcd) {??} /* [should never be used] */ - #endif - - /* Macros to decode the coefficient in a finite decFloat *df into */ - /* a base-billion uInt array, with the least-significant */ - /* 0-999999999 'digit' at offset 0. */ - - /* Decode the declets. After extracting each one, it is decoded */ - /* to binary using a table lookup. Three tables are used; one */ - /* the usual DPD to binary, the other two pre-multiplied by 1000 */ - /* and 1000000 to avoid multiplication during decode. These */ - /* tables can also be used for multiplying up the MSD as the DPD */ - /* code for 0 through 9 is the identity. */ - #define DPD2BIN0 DPD2BIN /* for prettier code */ - - #if DECPMAX==7 - #define GETCOEFFBILL(df, buf) { \ - uInt sourhi=DFWORD(df, 0); \ - (buf)[0]=DPD2BIN0[sourhi&0x3ff] \ - +DPD2BINK[(sourhi>>10)&0x3ff] \ - +DPD2BINM[DECCOMBMSD[sourhi>>26]];} - - #elif DECPMAX==16 - #define GETCOEFFBILL(df, buf) { \ - uInt sourhi, sourlo; \ - sourlo=DFWORD(df, 1); \ - (buf)[0]=DPD2BIN0[sourlo&0x3ff] \ - +DPD2BINK[(sourlo>>10)&0x3ff] \ - +DPD2BINM[(sourlo>>20)&0x3ff]; \ - sourhi=DFWORD(df, 0); \ - (buf)[1]=DPD2BIN0[((sourhi<<2) | (sourlo>>30))&0x3ff] \ - +DPD2BINK[(sourhi>>8)&0x3ff] \ - +DPD2BINM[DECCOMBMSD[sourhi>>26]];} - - #elif DECPMAX==34 - #define GETCOEFFBILL(df, buf) { \ - uInt sourhi, sourmh, sourml, sourlo; \ - sourlo=DFWORD(df, 3); \ - (buf)[0]=DPD2BIN0[sourlo&0x3ff] \ - +DPD2BINK[(sourlo>>10)&0x3ff] \ - +DPD2BINM[(sourlo>>20)&0x3ff]; \ - sourml=DFWORD(df, 2); \ - (buf)[1]=DPD2BIN0[((sourml<<2) | (sourlo>>30))&0x3ff] \ - +DPD2BINK[(sourml>>8)&0x3ff] \ - +DPD2BINM[(sourml>>18)&0x3ff]; \ - sourmh=DFWORD(df, 1); \ - (buf)[2]=DPD2BIN0[((sourmh<<4) | (sourml>>28))&0x3ff] \ - +DPD2BINK[(sourmh>>6)&0x3ff] \ - +DPD2BINM[(sourmh>>16)&0x3ff]; \ - sourhi=DFWORD(df, 0); \ - (buf)[3]=DPD2BIN0[((sourhi<<6) | (sourmh>>26))&0x3ff] \ - +DPD2BINK[(sourhi>>4)&0x3ff] \ - +DPD2BINM[DECCOMBMSD[sourhi>>26]];} - - #endif - - /* Macros to decode the coefficient in a finite decFloat *df into */ - /* a base-thousand uInt array (of size DECLETS+1, to allow for */ - /* the MSD), with the least-significant 0-999 'digit' at offset 0.*/ - - /* Decode the declets. After extracting each one, it is decoded */ - /* to binary using a table lookup. */ - #if DECPMAX==7 - #define GETCOEFFTHOU(df, buf) { \ - uInt sourhi=DFWORD(df, 0); \ - (buf)[0]=DPD2BIN[sourhi&0x3ff]; \ - (buf)[1]=DPD2BIN[(sourhi>>10)&0x3ff]; \ - (buf)[2]=DECCOMBMSD[sourhi>>26];} - - #elif DECPMAX==16 - #define GETCOEFFTHOU(df, buf) { \ - uInt sourhi, sourlo; \ - sourlo=DFWORD(df, 1); \ - (buf)[0]=DPD2BIN[sourlo&0x3ff]; \ - (buf)[1]=DPD2BIN[(sourlo>>10)&0x3ff]; \ - (buf)[2]=DPD2BIN[(sourlo>>20)&0x3ff]; \ - sourhi=DFWORD(df, 0); \ - (buf)[3]=DPD2BIN[((sourhi<<2) | (sourlo>>30))&0x3ff]; \ - (buf)[4]=DPD2BIN[(sourhi>>8)&0x3ff]; \ - (buf)[5]=DECCOMBMSD[sourhi>>26];} - - #elif DECPMAX==34 - #define GETCOEFFTHOU(df, buf) { \ - uInt sourhi, sourmh, sourml, sourlo; \ - sourlo=DFWORD(df, 3); \ - (buf)[0]=DPD2BIN[sourlo&0x3ff]; \ - (buf)[1]=DPD2BIN[(sourlo>>10)&0x3ff]; \ - (buf)[2]=DPD2BIN[(sourlo>>20)&0x3ff]; \ - sourml=DFWORD(df, 2); \ - (buf)[3]=DPD2BIN[((sourml<<2) | (sourlo>>30))&0x3ff]; \ - (buf)[4]=DPD2BIN[(sourml>>8)&0x3ff]; \ - (buf)[5]=DPD2BIN[(sourml>>18)&0x3ff]; \ - sourmh=DFWORD(df, 1); \ - (buf)[6]=DPD2BIN[((sourmh<<4) | (sourml>>28))&0x3ff]; \ - (buf)[7]=DPD2BIN[(sourmh>>6)&0x3ff]; \ - (buf)[8]=DPD2BIN[(sourmh>>16)&0x3ff]; \ - sourhi=DFWORD(df, 0); \ - (buf)[9]=DPD2BIN[((sourhi<<6) | (sourmh>>26))&0x3ff]; \ - (buf)[10]=DPD2BIN[(sourhi>>4)&0x3ff]; \ - (buf)[11]=DECCOMBMSD[sourhi>>26];} - #endif - - - /* Macros to decode the coefficient in a finite decFloat *df and */ - /* add to a base-thousand uInt array (as for GETCOEFFTHOU). */ - /* After the addition then most significant 'digit' in the array */ - /* might have a value larger then 10 (with a maximum of 19). */ - #if DECPMAX==7 - #define ADDCOEFFTHOU(df, buf) { \ - uInt sourhi=DFWORD(df, 0); \ - (buf)[0]+=DPD2BIN[sourhi&0x3ff]; \ - if (buf[0]>999) {buf[0]-=1000; buf[1]++;} \ - (buf)[1]+=DPD2BIN[(sourhi>>10)&0x3ff]; \ - if (buf[1]>999) {buf[1]-=1000; buf[2]++;} \ - (buf)[2]+=DECCOMBMSD[sourhi>>26];} - - #elif DECPMAX==16 - #define ADDCOEFFTHOU(df, buf) { \ - uInt sourhi, sourlo; \ - sourlo=DFWORD(df, 1); \ - (buf)[0]+=DPD2BIN[sourlo&0x3ff]; \ - if (buf[0]>999) {buf[0]-=1000; buf[1]++;} \ - (buf)[1]+=DPD2BIN[(sourlo>>10)&0x3ff]; \ - if (buf[1]>999) {buf[1]-=1000; buf[2]++;} \ - (buf)[2]+=DPD2BIN[(sourlo>>20)&0x3ff]; \ - if (buf[2]>999) {buf[2]-=1000; buf[3]++;} \ - sourhi=DFWORD(df, 0); \ - (buf)[3]+=DPD2BIN[((sourhi<<2) | (sourlo>>30))&0x3ff]; \ - if (buf[3]>999) {buf[3]-=1000; buf[4]++;} \ - (buf)[4]+=DPD2BIN[(sourhi>>8)&0x3ff]; \ - if (buf[4]>999) {buf[4]-=1000; buf[5]++;} \ - (buf)[5]+=DECCOMBMSD[sourhi>>26];} - - #elif DECPMAX==34 - #define ADDCOEFFTHOU(df, buf) { \ - uInt sourhi, sourmh, sourml, sourlo; \ - sourlo=DFWORD(df, 3); \ - (buf)[0]+=DPD2BIN[sourlo&0x3ff]; \ - if (buf[0]>999) {buf[0]-=1000; buf[1]++;} \ - (buf)[1]+=DPD2BIN[(sourlo>>10)&0x3ff]; \ - if (buf[1]>999) {buf[1]-=1000; buf[2]++;} \ - (buf)[2]+=DPD2BIN[(sourlo>>20)&0x3ff]; \ - if (buf[2]>999) {buf[2]-=1000; buf[3]++;} \ - sourml=DFWORD(df, 2); \ - (buf)[3]+=DPD2BIN[((sourml<<2) | (sourlo>>30))&0x3ff]; \ - if (buf[3]>999) {buf[3]-=1000; buf[4]++;} \ - (buf)[4]+=DPD2BIN[(sourml>>8)&0x3ff]; \ - if (buf[4]>999) {buf[4]-=1000; buf[5]++;} \ - (buf)[5]+=DPD2BIN[(sourml>>18)&0x3ff]; \ - if (buf[5]>999) {buf[5]-=1000; buf[6]++;} \ - sourmh=DFWORD(df, 1); \ - (buf)[6]+=DPD2BIN[((sourmh<<4) | (sourml>>28))&0x3ff]; \ - if (buf[6]>999) {buf[6]-=1000; buf[7]++;} \ - (buf)[7]+=DPD2BIN[(sourmh>>6)&0x3ff]; \ - if (buf[7]>999) {buf[7]-=1000; buf[8]++;} \ - (buf)[8]+=DPD2BIN[(sourmh>>16)&0x3ff]; \ - if (buf[8]>999) {buf[8]-=1000; buf[9]++;} \ - sourhi=DFWORD(df, 0); \ - (buf)[9]+=DPD2BIN[((sourhi<<6) | (sourmh>>26))&0x3ff]; \ - if (buf[9]>999) {buf[9]-=1000; buf[10]++;} \ - (buf)[10]+=DPD2BIN[(sourhi>>4)&0x3ff]; \ - if (buf[10]>999) {buf[10]-=1000; buf[11]++;} \ - (buf)[11]+=DECCOMBMSD[sourhi>>26];} - #endif - - - /* Set a decFloat to the maximum positive finite number (Nmax) */ - #if DECPMAX==7 - #define DFSETNMAX(df) \ - {DFWORD(df, 0)=0x77f3fcff;} - #elif DECPMAX==16 - #define DFSETNMAX(df) \ - {DFWORD(df, 0)=0x77fcff3f; \ - DFWORD(df, 1)=0xcff3fcff;} - #elif DECPMAX==34 - #define DFSETNMAX(df) \ - {DFWORD(df, 0)=0x77ffcff3; \ - DFWORD(df, 1)=0xfcff3fcf; \ - DFWORD(df, 2)=0xf3fcff3f; \ - DFWORD(df, 3)=0xcff3fcff;} - #endif - - /* [end of format-dependent macros and constants] */ - #endif - -#else - #error decNumberLocal included more than once -#endif diff --git a/decnumber/src/decQuad.c b/decnumber/src/decQuad.c deleted file mode 100644 --- a/decnumber/src/decQuad.c +++ /dev/null @@ -1,135 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* decQuad.c -- decQuad operations module */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is included in the package as decNumber.pdf. This */ -/* document is also available in HTML, together with specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* This module comprises decQuad operations (including conversions) */ -/* ------------------------------------------------------------------ */ - - -/* Constant mappings for shared code */ -#define DECPMAX DECQUAD_Pmax -#define DECEMIN DECQUAD_Emin -#define DECEMAX DECQUAD_Emax -#define DECEMAXD DECQUAD_EmaxD -#define DECBYTES DECQUAD_Bytes -#define DECSTRING DECQUAD_String -#define DECECONL DECQUAD_EconL -#define DECBIAS DECQUAD_Bias -#define DECLETS DECQUAD_Declets -#define DECQTINY (-DECQUAD_Bias) - -/* Type and function mappings for shared code */ -#define decFloat decQuad // Type name - -// Utilities and conversions (binary results, extractors, etc.) -#define decFloatFromBCD decQuadFromBCD -#define decFloatFromInt32 decQuadFromInt32 -#define decFloatFromPacked decQuadFromPacked -#define decFloatFromPackedChecked decQuadFromPackedChecked -#define decFloatFromString decQuadFromString -#define decFloatFromUInt32 decQuadFromUInt32 -#define decFloatFromWider decQuadFromWider -#define decFloatGetCoefficient decQuadGetCoefficient -#define decFloatGetExponent decQuadGetExponent -#define decFloatSetCoefficient decQuadSetCoefficient -#define decFloatSetExponent decQuadSetExponent -#define decFloatShow decQuadShow -#define decFloatToBCD decQuadToBCD -#define decFloatToEngString decQuadToEngString -#define decFloatToInt32 decQuadToInt32 -#define decFloatToInt32Exact decQuadToInt32Exact -#define decFloatToPacked decQuadToPacked -#define decFloatToString decQuadToString -#define decFloatToUInt32 decQuadToUInt32 -#define decFloatToUInt32Exact decQuadToUInt32Exact -#define decFloatToWider decQuadToWider -#define decFloatZero decQuadZero - -// Computational (result is a decFloat) -#define decFloatAbs decQuadAbs -#define decFloatAdd decQuadAdd -#define decFloatAnd decQuadAnd -#define decFloatDivide decQuadDivide -#define decFloatDivideInteger decQuadDivideInteger -#define decFloatFMA decQuadFMA -#define decFloatInvert decQuadInvert -#define decFloatLogB decQuadLogB -#define decFloatMax decQuadMax -#define decFloatMaxMag decQuadMaxMag -#define decFloatMin decQuadMin -#define decFloatMinMag decQuadMinMag -#define decFloatMinus decQuadMinus -#define decFloatMultiply decQuadMultiply -#define decFloatNextMinus decQuadNextMinus -#define decFloatNextPlus decQuadNextPlus -#define decFloatNextToward decQuadNextToward -#define decFloatOr decQuadOr -#define decFloatPlus decQuadPlus -#define decFloatQuantize decQuadQuantize -#define decFloatReduce decQuadReduce -#define decFloatRemainder decQuadRemainder -#define decFloatRemainderNear decQuadRemainderNear -#define decFloatRotate decQuadRotate -#define decFloatScaleB decQuadScaleB -#define decFloatShift decQuadShift -#define decFloatSubtract decQuadSubtract -#define decFloatToIntegralValue decQuadToIntegralValue -#define decFloatToIntegralExact decQuadToIntegralExact -#define decFloatXor decQuadXor - -// Comparisons -#define decFloatCompare decQuadCompare -#define decFloatCompareSignal decQuadCompareSignal -#define decFloatCompareTotal decQuadCompareTotal -#define decFloatCompareTotalMag decQuadCompareTotalMag - -// Copies -#define decFloatCanonical decQuadCanonical -#define decFloatCopy decQuadCopy -#define decFloatCopyAbs decQuadCopyAbs -#define decFloatCopyNegate decQuadCopyNegate -#define decFloatCopySign decQuadCopySign - -// Non-computational -#define decFloatClass decQuadClass -#define decFloatClassString decQuadClassString -#define decFloatDigits decQuadDigits -#define decFloatIsCanonical decQuadIsCanonical -#define decFloatIsFinite decQuadIsFinite -#define decFloatIsInfinite decQuadIsInfinite -#define decFloatIsInteger decQuadIsInteger -#define decFloatIsLogical decQuadIsLogical -#define decFloatIsNaN decQuadIsNaN -#define decFloatIsNegative decQuadIsNegative -#define decFloatIsNormal decQuadIsNormal -#define decFloatIsPositive decQuadIsPositive -#define decFloatIsSignaling decQuadIsSignaling -#define decFloatIsSignalling decQuadIsSignalling -#define decFloatIsSigned decQuadIsSigned -#define decFloatIsSubnormal decQuadIsSubnormal -#define decFloatIsZero decQuadIsZero -#define decFloatRadix decQuadRadix -#define decFloatSameQuantum decQuadSameQuantum -#define decFloatVersion decQuadVersion - -/* And now the code itself */ -#include "decContext.h" // public includes -#include "decQuad.h" // .. -#include "decNumberLocal.h" // local includes (need DECPMAX) -#include "decCommon.c" // non-arithmetic decFloat routines -#include "decBasic.c" // basic formats routines - diff --git a/decnumber/src/decQuad.h b/decnumber/src/decQuad.h deleted file mode 100644 --- a/decnumber/src/decQuad.h +++ /dev/null @@ -1,177 +0,0 @@ -/* ------------------------------------------------------------------ */ -/* decQuad.h -- Decimal 128-bit format module header */ -/* ------------------------------------------------------------------ */ -/* Copyright (c) IBM Corporation, 2000, 2010. All rights reserved. */ -/* */ -/* This software is made available under the terms of the */ -/* ICU License -- ICU 1.8.1 and later. */ -/* */ -/* The description and User's Guide ("The decNumber C Library") for */ -/* this software is included in the package as decNumber.pdf. This */ -/* document is also available in HTML, together with specifications, */ -/* testcases, and Web links, on the General Decimal Arithmetic page. */ -/* */ -/* Please send comments, suggestions, and corrections to the author: */ -/* mfc@uk.ibm.com */ -/* Mike Cowlishaw, IBM Fellow */ -/* IBM UK, PO Box 31, Birmingham Road, Warwick CV34 5JL, UK */ -/* ------------------------------------------------------------------ */ -/* This include file is always included by decSingle and decDouble, */ -/* and therefore also holds useful constants used by all three. */ - -#if !defined(DECQUAD) - #define DECQUAD - - #define DECQUADNAME "decimalQuad" /* Short name */ - #define DECQUADTITLE "Decimal 128-bit datum" /* Verbose name */ - #define DECQUADAUTHOR "Mike Cowlishaw" /* Who to blame */ - - /* parameters for decQuads */ - #define DECQUAD_Bytes 16 /* length */ - #define DECQUAD_Pmax 34 /* maximum precision (digits) */ - #define DECQUAD_Emin -6143 /* minimum adjusted exponent */ - #define DECQUAD_Emax 6144 /* maximum adjusted exponent */ - #define DECQUAD_EmaxD 4 /* maximum exponent digits */ - #define DECQUAD_Bias 6176 /* bias for the exponent */ - #define DECQUAD_String 43 /* maximum string length, +1 */ - #define DECQUAD_EconL 12 /* exponent continuation length */ - #define DECQUAD_Declets 11 /* count of declets */ - /* highest biased exponent (Elimit-1) */ - #define DECQUAD_Ehigh (DECQUAD_Emax + DECQUAD_Bias - (DECQUAD_Pmax-1)) - - /* Required include */ - #include "decContext.h" - - /* The decQuad decimal 128-bit type, accessible by all sizes */ - typedef union { - uint8_t bytes[DECQUAD_Bytes]; /* fields: 1, 5, 12, 110 bits */ - uint16_t shorts[DECQUAD_Bytes/2]; - uint32_t words[DECQUAD_Bytes/4]; - #if DECUSE64 - uint64_t longs[DECQUAD_Bytes/8]; - #endif - } decQuad; - - /* ---------------------------------------------------------------- */ - /* Shared constants */ - /* ---------------------------------------------------------------- */ - - /* sign and special values [top 32-bits; last two bits are don't-care - for Infinity on input, last bit don't-care for NaNs] */ - #define DECFLOAT_Sign 0x80000000 /* 1 00000 00 Sign */ - #define DECFLOAT_NaN 0x7c000000 /* 0 11111 00 NaN generic */ - #define DECFLOAT_qNaN 0x7c000000 /* 0 11111 00 qNaN */ - #define DECFLOAT_sNaN 0x7e000000 /* 0 11111 10 sNaN */ - #define DECFLOAT_Inf 0x78000000 /* 0 11110 00 Infinity */ - #define DECFLOAT_MinSp 0x78000000 /* minimum special value */ - /* [specials are all >=MinSp] */ - /* Sign nibble constants */ - #if !defined(DECPPLUSALT) - #define DECPPLUSALT 0x0A /* alternate plus nibble */ - #define DECPMINUSALT 0x0B /* alternate minus nibble */ - #define DECPPLUS 0x0C /* preferred plus nibble */ - #define DECPMINUS 0x0D /* preferred minus nibble */ - #define DECPPLUSALT2 0x0E /* alternate plus nibble */ - #define DECPUNSIGNED 0x0F /* alternate plus nibble (unsigned) */ - #endif - - /* ---------------------------------------------------------------- */ - /* Routines -- implemented as decFloat routines in common files */ - /* ---------------------------------------------------------------- */ - - /* Utilities and conversions, extractors, etc.) */ - extern decQuad * decQuadFromBCD(decQuad *, int32_t, const uint8_t *, int32_t); - extern decQuad * decQuadFromInt32(decQuad *, int32_t); - extern decQuad * decQuadFromPacked(decQuad *, int32_t, const uint8_t *); - extern decQuad * decQuadFromPackedChecked(decQuad *, int32_t, const uint8_t *); - extern decQuad * decQuadFromString(decQuad *, const char *, decContext *); - extern decQuad * decQuadFromUInt32(decQuad *, uint32_t); - extern int32_t decQuadGetCoefficient(const decQuad *, uint8_t *); - extern int32_t decQuadGetExponent(const decQuad *); - extern decQuad * decQuadSetCoefficient(decQuad *, const uint8_t *, int32_t); - extern decQuad * decQuadSetExponent(decQuad *, decContext *, int32_t); - extern void decQuadShow(const decQuad *, const char *); - extern int32_t decQuadToBCD(const decQuad *, int32_t *, uint8_t *); - extern char * decQuadToEngString(const decQuad *, char *); - extern int32_t decQuadToInt32(const decQuad *, decContext *, enum rounding); - extern int32_t decQuadToInt32Exact(const decQuad *, decContext *, enum rounding); - extern int32_t decQuadToPacked(const decQuad *, int32_t *, uint8_t *); - extern char * decQuadToString(const decQuad *, char *); - extern uint32_t decQuadToUInt32(const decQuad *, decContext *, enum rounding); - extern uint32_t decQuadToUInt32Exact(const decQuad *, decContext *, enum rounding); - extern decQuad * decQuadZero(decQuad *); - - /* Computational (result is a decQuad) */ - extern decQuad * decQuadAbs(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadAdd(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadAnd(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadDivide(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadDivideInteger(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadFMA(decQuad *, const decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadInvert(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadLogB(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadMax(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadMaxMag(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadMin(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadMinMag(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadMinus(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadMultiply(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadNextMinus(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadNextPlus(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadNextToward(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadOr(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadPlus(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadQuantize(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadReduce(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadRemainder(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadRemainderNear(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadRotate(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadScaleB(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadShift(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadSubtract(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadToIntegralValue(decQuad *, const decQuad *, decContext *, enum rounding); - extern decQuad * decQuadToIntegralExact(decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadXor(decQuad *, const decQuad *, const decQuad *, decContext *); - - /* Comparisons */ - extern decQuad * decQuadCompare(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadCompareSignal(decQuad *, const decQuad *, const decQuad *, decContext *); - extern decQuad * decQuadCompareTotal(decQuad *, const decQuad *, const decQuad *); - extern decQuad * decQuadCompareTotalMag(decQuad *, const decQuad *, const decQuad *); - - /* Copies */ - extern decQuad * decQuadCanonical(decQuad *, const decQuad *); - extern decQuad * decQuadCopy(decQuad *, const decQuad *); - extern decQuad * decQuadCopyAbs(decQuad *, const decQuad *); - extern decQuad * decQuadCopyNegate(decQuad *, const decQuad *); - extern decQuad * decQuadCopySign(decQuad *, const decQuad *, const decQuad *); - - /* Non-computational */ - extern enum decClass decQuadClass(const decQuad *); - extern const char * decQuadClassString(const decQuad *); - extern uint32_t decQuadDigits(const decQuad *); - extern uint32_t decQuadIsCanonical(const decQuad *); - extern uint32_t decQuadIsFinite(const decQuad *); - extern uint32_t decQuadIsInteger(const decQuad *); - extern uint32_t decQuadIsLogical(const decQuad *); - extern uint32_t decQuadIsInfinite(const decQuad *); - extern uint32_t decQuadIsNaN(const decQuad *); - extern uint32_t decQuadIsNegative(const decQuad *); - extern uint32_t decQuadIsNormal(const decQuad *); - extern uint32_t decQuadIsPositive(const decQuad *); - extern uint32_t decQuadIsSignaling(const decQuad *); - extern uint32_t decQuadIsSignalling(const decQuad *); - extern uint32_t decQuadIsSigned(const decQuad *); - extern uint32_t decQuadIsSubnormal(const decQuad *); - extern uint32_t decQuadIsZero(const decQuad *); - extern uint32_t decQuadRadix(const decQuad *); - extern uint32_t decQuadSameQuantum(const decQuad *, const decQuad *); - extern const char * decQuadVersion(void); - - /* decNumber conversions; these are implemented as macros so as not */ - /* to force a dependency on decimal128 and decNumber in decQuad. */ - /* decQuadFromNumber returns a decimal128 * to avoid warnings. */ - #define decQuadToNumber(dq, dn) decimal128ToNumber((decimal128 *)(dq), dn) - #define decQuadFromNumber(dq, dn, set) decimal128FromNumber((decimal128 *)(dq), dn, set) - -#endif diff --git a/dectest/AllModules.hs b/dectest/AllModules.hs new file mode 100644 --- /dev/null +++ b/dectest/AllModules.hs @@ -0,0 +1,22 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +-- | Lists all modules in the tests directory. A hack to make it +-- easy to compile all test modules. By importing this file in the +-- main immutability.hs, all modules get compiled. +module AllModules where + +import Conditions +import Parse +import Parse.Tokenizer +import Parse.Tokens +import Types +import Runner +import Directives +import TestLog +import Util +import Operand +import Result +import Arity +import TestHelpers +import Specials +import NumTests diff --git a/dectest/Arity.hs b/dectest/Arity.hs new file mode 100644 --- /dev/null +++ b/dectest/Arity.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Use functions in here to test any testcase except toSci, +-- toEng, or apply. Those have special rules for operand parsing. +module Arity where + +import TestLog +import qualified Data.ByteString.Char8 as BS8 +import qualified Deka.Dec as D +import qualified Deka.Context as C +import Control.Monad +import Data.Monoid +import Operand +import Result +import Types +import Directives +import TestHelpers + +type Unary = D.Dec -> C.Ctx D.Dec +type Binary = D.Dec -> D.Dec -> C.Ctx D.Dec +type Ternary = D.Dec -> D.Dec -> D.Dec -> C.Ctx D.Dec + +unary :: Unary -> Test +unary f dirs ops rslt conds = runTestLog $ do + ic <- parseDirectives dirs + op <- case ops of + x:[] -> operand ic x + _ -> flunk $ "one operand expected, got " <> + (BS8.pack . show . length $ ops) + mayRslt <- result rslt + let k = ic >> f op + (r, fl) = C.runCtxStatus k + testConditions conds fl + testDec r mayRslt + pass "conditions and result match targets" + +binary :: Binary -> Test +binary f dirs ops rslt conds = runTestLog $ do + ic <- parseDirectives dirs + (opX, opY) <- case ops of + x:y:[] -> do + ox <- operand ic x + oy <- operand ic y + return (ox, oy) + _ -> flunk $ "two operands expected, got " <> + (BS8.pack . show . length $ ops) + mayRslt <- result rslt + let k = ic >> f opX opY + (r, fl) = C.runCtxStatus k + testConditions conds fl + testDec r mayRslt + pass "conditions and result match targets" + +comparer :: (D.Dec -> D.Dec -> Ordering) -> Test +comparer f dirs ops rslt conds = runTestLog $ do + when (not . null $ conds) . flunk $ + "comparer: conditions not null, which makes no sense " + <> "for this kind of test." + ic <- parseDirectives dirs + (opX, opY) <- case ops of + x:y:[] -> do + ox <- operand ic x + oy <- operand ic y + return (ox, oy) + _ -> flunk $ "two operands expected, got " <> + (BS8.pack . show . length $ ops) + rsltO <- resultOrd rslt + let r = f opX opY + if rsltO == r + then pass "conditions and result match targets" + else flunk $ "expected: " <> (BS8.pack . show $ rsltO) + <> " got: " <> (BS8.pack . show $ r) + +binaryTest :: (D.Dec -> D.Dec -> Bool) -> Test +binaryTest f dirs ops rslt conds = runTestLog $ do + when (not . null $ conds) . flunk $ + "binaryTest: conditions not null, which makes no sense " + <> "for this kind of test." + ic <- parseDirectives dirs + (opX, opY) <- case ops of + x:y:[] -> do + ox <- operand ic x + oy <- operand ic y + return (ox, oy) + _ -> flunk $ "two operands expected, got " <> + (BS8.pack . show . length $ ops) + rsltB <- resultBool rslt + let r = f opX opY + if rsltB == r + then pass "conditions and result match targets" + else flunk $ "expected: " <> (BS8.pack . show $ rsltB) + <> " got: " <> (BS8.pack . show $ r) + + +decAndIntegral + :: (D.Dec -> D.Signed -> C.Ctx D.Dec) -> Test + +decAndIntegral f dirs ops rslt conds = runTestLog $ do + ic <- parseDirectives dirs + (opX, opY) <- case ops of + x:y:[] -> do + ox <- operand ic x + oy <- operandIntegral y + return (ox, oy) + _ -> flunk $ "two operands expected, got " <> + (BS8.pack . show . length $ ops) + let k = ic >> f opX opY + (r, fl) = C.runCtxStatus k + mayRslt <- result rslt + testConditions conds fl + testDec r mayRslt + pass "conditions and results match targets" + +ternary :: Ternary -> Test +ternary f dirs ops rslt conds = runTestLog $ do + ic <- parseDirectives dirs + (opX, opY, opZ) <- case ops of + x:y:z:[] -> do + ox <- operand ic x + oy <- operand ic y + oz <- operand ic z + return (ox, oy, oz) + _ -> flunk $ "three operands expected, got " <> + (BS8.pack . show . length $ ops) + mayRslt <- result rslt + let k = ic >> f opX opY opZ + (r, fl) = C.runCtxStatus k + testConditions conds fl + testDec r mayRslt + pass "conditions and result match targets" + diff --git a/dectest/Conditions.hs b/dectest/Conditions.hs new file mode 100644 --- /dev/null +++ b/dectest/Conditions.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Conditions where + +import qualified Data.ByteString.Char8 as BS8 +import TestLog +import Data.String +import qualified Deka.Context as C +import Data.Monoid +import Data.Char (toLower) +import Data.List (sort) + +-- | Parses and sorts a list of conditions. + +parseConditions :: [BS8.ByteString] -> TestLog [C.Flag] +parseConditions = fmap sort . mapM parseCondition + +parseCondition :: BS8.ByteString -> TestLog C.Flag +parseCondition str = case lookup s allConditions of + Nothing -> flunk $ "could not parse condition: " <> str + Just f -> tell ("parsed condition: " <> str) >> return f + where + s = map toLower . BS8.unpack $ str + +allConditions :: IsString a => [(a, C.Flag)] +allConditions = + [ ("clamped", C.clamped) + , ("conversion_syntax", C.conversionSyntax) + , ("division_by_zero", C.divisionByZero) + , ("division_impossible", C.divisionImpossible) + , ("division_undefined", C.divisionUndefined) + , ("inexact", C.inexact) + + -- insufficient_storage not present in mpdecimal - not used in the + -- tests + -- , ("insufficient_storage", C.insufficientStorage) + + , ("invalid_context", C.invalidContext) + , ("invalid_operation", C.invalidOperation) + + -- lost_digits - not present in mpdecimal - but also not in the + -- decNumber tests + --, ("lost_digits", C.lostDigits) + + , ("overflow", C.overflow) + , ("rounded", C.rounded) + , ("subnormal", C.subnormal) + , ("underflow", C.underflow) + ] + diff --git a/dectest/Directives.hs b/dectest/Directives.hs new file mode 100644 --- /dev/null +++ b/dectest/Directives.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE OverloadedStrings #-} +module Directives where + +import qualified Parse as P +import qualified Deka.Context as C +import Data.Char (toLower) +import qualified Data.ByteString.Char8 as BS8 +import Data.Monoid +import TestLog +import Util +import Data.String +import qualified Data.Sequence as S +import Data.Sequence(ViewR(..)) + +data Directives = Directives + { dsPrecision :: Maybe P.Value + , dsRounding :: Maybe P.Value + , dsEmax :: Maybe P.Value + , dsEmin :: Maybe P.Value + , dsExtended :: Maybe P.Value + , dsClamp :: Maybe P.Value + , dsVersion :: Maybe P.Value + } deriving Show + +type Getter = Directives -> Maybe P.Value +type Setter = P.Value -> Directives -> Directives + +dirFields + :: IsString a + => [(a, (Getter, Setter))] +dirFields = + [ ("precision", (dsPrecision, \v d -> d { dsPrecision = Just v })) + , ("rounding", (dsRounding, \v d -> d { dsRounding = Just v })) + , ("maxexponent", (dsEmax, \v d -> d { dsEmax = Just v })) + , ("minexponent", (dsEmin, \v d -> d { dsEmin = Just v })) + , ("extended", (dsExtended, \v d -> d { dsExtended = Just v })) + , ("clamp", (dsClamp, \v d -> d { dsClamp = Just v })) + , ("version", (dsVersion, \v d -> d { dsVersion = Just v })) + ] + +emptyDirectives :: Directives +emptyDirectives = Directives Nothing Nothing Nothing Nothing + Nothing Nothing Nothing + +plusDirective + :: (P.Keyword, P.Value) + -> Directives + -> TestLog Directives +plusDirective (kw, vl) d = case lookup k dirFields of + Nothing -> flunk $ "could not find directive: " <> BS8.pack k + Just p -> add p + where + (k, v) = (map toLower . BS8.unpack . P.unKeyword $ kw, + P.unValue vl) + add (get, set) = case get d of + Nothing -> do + tell $ "using directive " <> BS8.pack k <> " with value " <> v + return $ set vl d + Just _ -> do + tell $ "ignoring old directive " <> BS8.pack k + <> " with value " <> v + return d + +plusDirectives + :: S.Seq (P.Keyword, P.Value) + -> TestLog Directives +plusDirectives = go emptyDirectives + where + go ds sq = case S.viewr sq of + EmptyR -> return ds + sq' :> p -> do + ds' <- plusDirective p ds + go ds' sq' + +directivesToCtx :: Directives -> TestLog (C.Ctx ()) +directivesToCtx ds = do + + rnd <- case dsRounding ds of + Nothing -> return (return ()) + Just (P.Value r) -> do + let dflt = flunk $ "could not set rounding: " <> r + mayRnd = lookup r allRounds + rnd <- maybe dflt return mayRnd + tell $ "setting rounding to " <> r + return (C.setRound rnd) + + clmp <- case dsClamp ds of + Nothing -> return (return ()) + Just (P.Value r) -> case readNumberBS r >>= parseBool of + Nothing -> flunk $ "could not set clamp: " <> r + Just p -> do + tell $ "setting clamp to " <> BS8.pack (show p) + return (C.setClamp p) + + tri <- do + pcsn <- case dsPrecision ds of + Nothing -> flunk "precision not present in directives" + Just (P.Value r) -> case readNumberBS r >>= C.precision of + Nothing -> flunk $ "could not set precision: " <> r + Just p -> do + tell $ "using for precision: " <> r + return p + + emx <- case dsEmax ds of + Nothing -> flunk "emax not present in directives" + Just (P.Value r) -> case readNumberBS r >>= C.emax of + Nothing -> flunk $ "could not set emax: " <> r + Just x -> do + tell $ "using for Emax: " <> r + return x + + emn <- case dsEmin ds of + Nothing -> flunk "emin not present in directives" + Just (P.Value r) -> case readNumberBS r >>= C.emin of + Nothing -> flunk $ "could not set emin: " <> r + Just x -> do + tell $ "using for Emin: " <> r + return x + + case C.trio pcsn emx emn of + Nothing -> flunk $ "failed to set trio" + Just t -> return $ C.setTrio t + + return $ rnd >> clmp >> tri + +parseDirectives + :: S.Seq (P.Keyword, P.Value) + -> TestLog (C.Ctx ()) +parseDirectives sq = plusDirectives sq >>= directivesToCtx + +allRounds :: IsString a => [(a, C.Round)] +allRounds = + [ ("ceiling", C.roundCeiling) + , ("up", C.roundUp) + , ("half_up", C.roundHalfUp) + , ("half_even", C.roundHalfEven) + , ("half_down", C.roundHalfDown) + , ("down", C.roundDown) + , ("floor", C.roundFloor) + , ("05up", C.round05Up) + ] + diff --git a/dectest/NumTests.hs b/dectest/NumTests.hs new file mode 100644 --- /dev/null +++ b/dectest/NumTests.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-} + +module NumTests where + +import Arity +import Types +import Specials +import Deka.Dec +import qualified Data.ByteString.Char8 as BS8 + +testLookups :: [(BS8.ByteString, Test)] +testLookups = + [ ("abs", unary abs) + , ("add", binary add) + , ("and", binary and) + , ("apply", apply) + -- skip: canonical + , ("class", decClass) + , ("compare", binary compare) + , ("comparesig", binary compareSignal) + , ("comparetotal", comparer compareTotal) + , ("comparetotalmag", comparer compareTotalMag) + -- skip: copy, copyabs, copynegate, copysign + , ("divide", binary divide) + , ("divideint", binary divideInteger) + , ("exp", unary exp) + , ("fma", ternary fma) + , ("invert", unary invert) + , ("ln", unary ln) + , ("log10", unary log10) + , ("logb", unary logB) + , ("max", binary max) + , ("min", binary min) + , ("maxmag", binary maxMag) + , ("minmag", binary minMag) + , ("minus", unary minus) + , ("multiply", binary multiply) + , ("nextminus", unary nextMinus) + , ("nextplus", unary nextPlus) + , ("nexttoward", binary nextToward) + , ("or", binary or) + , ("plus", unary plus) + , ("power", binary power) + , ("quantize", binary quantize) + , ("reduce", unary reduce) + , ("remainder", binary remainder) + , ("remaindernear", binary remainderNear) + , ("rescale", decAndIntegral rescale) + , ("rotate", binary rotate) + , ("samequantum", binaryTest sameQuantum) + , ("scaleb", binary scaleB) + , ("shift", binary shift) + , ("squareroot", unary squareRoot) + , ("subtract", binary subtract) + , ("toEng", toEng) + , ("tointegral", unary toIntegralValue) + , ("toIntegralx", unary toIntegralExact) + , ("toSci", toSci) + -- skip: trim + , ("xor", binary xor) + ] diff --git a/dectest/Operand.hs b/dectest/Operand.hs new file mode 100644 --- /dev/null +++ b/dectest/Operand.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} +module Operand where + +import TestLog +import qualified Data.ByteString.Char8 as BS8 +import qualified Deka.Dec as D +import qualified Deka.Context as C +import Data.Monoid +import Util + +-- | Parses an operand. Do not use this function for @toSci@, +-- @toEng@, or @apply@ as those have special rules for handling the +-- context. +-- +-- Bypasses if the operand contains any octothorpe. + +operand + :: C.Ctx () + -- ^ Initial context to use + -> BS8.ByteString + -- ^ Parse this token + -> TestLog D.Dec +operand ic bs + | '#' `BS8.elem` bs = + bypass $ "operand contains an octothorpe: " <> bs + | otherwise = do + tell $ "parsing operand token: " <> bs + let k = do + ic + p <- fmap C.unPrecision C.setMaxPrecision + s <- D.fromByteString bs + return (p, s) + let (p, r) = C.runCtx k + tell $ "operand parse result: " <> D.toByteString r + <> " parsed at precision: " <> BS8.pack (show p) + return r + +-- | Parses an operand into a context. Use this function for +-- @toSci@, @toEng@, and @apply@. Bypasses if the operand contains +-- any octothorpe. +operandSciEngAp + :: C.Ctx () + -- ^ Initial context to use + -> BS8.ByteString + -- ^ Parse this token + -> TestLog (C.Ctx D.Dec) +operandSciEngAp ic bs + | '#' `BS8.elem` bs = + bypass $ "operand contains an octothorpe: " <> bs + | otherwise = do + tell $ "parsing operand token: " <> bs + let k = ic >> D.fromByteString bs + return k + +-- | Parses a signed integral operand. +operandIntegral + :: BS8.ByteString + -> TestLog D.Signed +operandIntegral bs + | '#' `BS8.elem` bs = + bypass $ "operand contains an octothorpe: " <> bs + + | otherwise = case readNumberBS bs of + Nothing -> flunk $ "could not parse integral operand: " <> bs + Just r -> do + tell $ "parsed integral operand: " <> bs + return r diff --git a/dectest/Parse.hs b/dectest/Parse.hs new file mode 100644 --- /dev/null +++ b/dectest/Parse.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} +module Parse where + +import Parse.Tokens +import qualified Data.ByteString.Char8 as BS8 + +-- | Remove the comments from a line of tokens. Any unquoted token that +-- starts with two dashes is removed. Also, any token that comes +-- after such a token is also removed. +removeComments :: [Token] -> [Token] +removeComments toks = go toks + where + go [] = [] + go (t:ts) + | quoted t = t : go ts + | BS8.take 2 (unToken t) == "--" = [] + | otherwise = t : go ts + +newtype Keyword = Keyword { unKeyword :: BS8.ByteString } + deriving (Eq, Show) + +newtype Value = Value { unValue :: BS8.ByteString } + deriving (Eq, Show) + +data TestSpec = TestSpec + { testId :: BS8.ByteString + , testOperation :: BS8.ByteString + , testOperands :: [BS8.ByteString] + , testResult :: BS8.ByteString + , testConditions :: [BS8.ByteString] + } deriving Show + +data Instruction + = Blank + | Directive Keyword Value + | Test TestSpec + deriving Show + +data File = File + { fileName :: BS8.ByteString + , fileContents :: [Either File Instruction] + } deriving Show + +directive :: [Token] -> (Keyword, Value) +directive ts = case ts of + x:y:[] -> ( Keyword . BS8.init . unToken $ x, + Value (unToken y) ) + _ -> error "directive: bad token count" + +lineToContent :: [Token] -> IO (Either File Instruction) +lineToContent ts + | null ts = return . Right $ Blank + | length ts == 2 && kw == "dectest" = fmap Left $ parseFile fn + | length ts == 2 = return . Right $ Directive akw avl + | otherwise = return . Right . Test . mkTestSpec $ ts + where + (akw@(Keyword kw), avl@(Value val)) = directive ts + fn = val `BS8.append` ".decTest" + +mkTestSpec :: [Token] -> TestSpec +mkTestSpec ts + | length ts < 5 = error "mkTestSpec: list too short" + | otherwise = TestSpec + { testId = unToken . head $ ts + , testOperation = unToken . head . drop 1 $ ts + , testOperands = map unToken + . takeWhile (not . resultsIn) + . drop 2 + $ ts + , testResult = unToken + . safeHead + . drop 1 + . dropWhile (not . resultsIn) + . drop 2 + $ ts + , testConditions = map unToken + . drop 2 + . dropWhile (not . resultsIn) + . drop 2 + $ ts + } + where + resultsIn t = unToken t == "->" && not (quoted t) + safeHead x = case x of + [] -> error "mkTestSpec: list too short" + y:_ -> y + +rawToContent :: Raw -> IO [Either File Instruction] +rawToContent + = mapM lineToContent + . map removeComments + . map processLine + . splitLines + +parseFile :: BS8.ByteString -> IO File +parseFile fn = do + rw <- raw (BS8.unpack fn) + ctnt <- rawToContent rw + return $ File fn ctnt diff --git a/dectest/Parse/Tokenizer.hs b/dectest/Parse/Tokenizer.hs new file mode 100644 --- /dev/null +++ b/dectest/Parse/Tokenizer.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | A finite state machine to break a single line of text into +-- tokens. +-- +-- The machine has three main states, some of which have sub-states: +-- +-- * inside of a token. Here, the machine can be in a @plain@ (that +-- is, unquoted) word, or it can be inside of a quoted word. When +-- inside of a quoted word, if a closing quotation mark is seen, the +-- machine transitions to being in a @pending@ state. The next +-- character determines what happens next: if it's an identical +-- quotation mark, then a single quotation mark is added to the +-- current token, and the machine stays in a quoted word state. If +-- the character is anything else, the machine outputs the previous +-- token and begins a new one. +-- +-- * between tokens. +-- +-- * in a comment. Before a token is output, the tokenizer examines +-- it to determine whether it is both (1) unquoted, and (2) begins +-- with two dashes. If so, it's a comment token. The token is not +-- output, and the machine shifts to being in a comment state, which +-- swallows all remaining characters that are input. +-- +-- To use the tokenizer: +-- +-- * turn it on with 'start'. +-- +-- * Feed it characters from the line using 'feed'. Occasionally +-- this will output a single 'Token'. It always outputs a new +-- 'Tokenizer' that will accept further characters. +-- +-- * when done, be sure to turn it off with 'finish'. This will +-- eject any characters in the tokenizer that have not been spit out +-- yet. + +module Parse.Tokenizer + ( Tokenizer + , Token(..) + , start -- :: Tokenizer + , feed -- :: Char -> Tokenizer -> (Tokenizer, Maybe Token) + , finish -- :: Tokenizer -> Maybe Token + ) where + +import qualified Data.ByteString.Char8 as BS8 + +-- | Set to True when a single close quote character has been +-- parsed. Since double quote characters indicates an enclosed +-- quote, we don't know until the next character whether to close +-- the quote or just include a quote in the token. +type Pending = Bool + +data QuoteType = Single | Double + deriving (Eq, Show) + +toQuot :: QuoteType -> Char +toQuot Single = '\'' +toQuot Double = '"' + +data InTok + = PlainWord + | Quoted QuoteType Pending + deriving Show + +data Accepting + = InTok InTok BS8.ByteString + | BetweenToks + deriving Show + +-- The Tokenizer holds a Maybe Accepting, which is Nothing if the +-- Tokenizer is no longer accepting new characters because it is in +-- an comment, or is Just if accepting new characters. + +data Tokenizer = Tokenizer (Maybe Accepting) + deriving Show + +data Token = Token + { unToken :: BS8.ByteString + , quoted :: Bool + } deriving (Eq, Ord, Show) + +-- | Turns the tokenizer on. + +start :: Tokenizer +start = Tokenizer . Just $ BetweenToks + +-- | Feeds a character to the tokenizer. +feed :: Char -> Tokenizer -> (Tokenizer, Maybe Token) +feed c (Tokenizer t) = case t of + Nothing -> (Tokenizer Nothing, Nothing) + + Just a -> case a of + InTok tokType curr -> case tokType of + + PlainWord -> + let mnt q = mint (InTok (Quoted q False) BS8.empty) + curr False + in case c of + '"' -> mnt Double + '\'' -> mnt Single + ' ' -> mint BetweenToks curr False + _ -> stayInTok c curr PlainWord + + Quoted qType pend + | pend -> acceptQuotedWithPending c curr qType + | otherwise -> acceptQuotedNoPending c curr qType + + BetweenToks -> case c of + ' ' -> (Tokenizer (Just BetweenToks), Nothing) + '"' -> newTok (Left Double) + '\'' -> newTok (Left Single) + _ -> newTok (Right c) + +-- | Creates a new token, if called for. Checks to see if the token +-- that would be produced would be a comment token. If so, do not +-- emit a token, and return a Tokenizer that does not accept new +-- characters. Otherwise, emit the token, and return an accepting +-- Tokenizer. + +mint + :: Accepting + -- ^ If a token is produced because the Tokenizer did not output a + -- comment, this becomes the new state of the Tokenizer. + -> BS8.ByteString + -- ^ What to output + -> Bool + -- ^ True if the token is quoted; False if not + -> (Tokenizer, Maybe Token) +mint a o q + | q = nt + | otherwise = + if BS8.take 2 o == "--" + then (Tokenizer Nothing, Nothing) + else nt + where + nt = (Tokenizer (Just a), Just (Token o q)) + +-- | Accepts a new character without producing a token. + +stayInTok + :: Char + -- ^ Character to add to the storehouse of characters in the + -- current token + -> BS8.ByteString + -- ^ Storehouse of current characters + -> InTok + -> (Tokenizer, Maybe Token) + -- ^ snd is always False, fst is a Tokenizer that is InTok +stayInTok c s i = (tzr, Nothing) + where + tzr = Tokenizer (Just ac) + ac = InTok i (s `BS8.snoc` c) + +-- | Accepts a character while within a quote and there is not a +-- pending character. + +acceptQuotedNoPending + :: Char + -- ^ Character to accept + -> BS8.ByteString + -- ^ Storehouse of current characters + -> QuoteType + -- ^ Type of quote we're currently inside of + -> (Tokenizer, Maybe Token) + -- ^ snd is always False, fst is a Tokenizer that is InTok +acceptQuotedNoPending c s q = (tzr, Nothing) + where + tzr = Tokenizer (Just ac) + ac = InTok (Quoted q pnd) s' + (s', pnd) + | c == toQuot q = (s, True) + | otherwise = (s `BS8.snoc` c, False) + +-- | Accepts a character while within a quote and there is a pending +-- character. +acceptQuotedWithPending + :: Char + -- ^ Character to accept + -> BS8.ByteString + -- ^ Storehouse of current characters + -> QuoteType + -- ^ Type of quote we're currently inside of + -> (Tokenizer, Maybe Token) + -- ^ snd is always False, fst is a Tokenizer that is InTok +acceptQuotedWithPending c s q + | c == toQuot q = stayInTok c s (Quoted q False) + | otherwise = case c of + ' ' -> mnt BetweenToks + '"' -> mnt (InTok (Quoted Double False) BS8.empty) + '\'' -> mnt (InTok (Quoted Single False) BS8.empty) + _ -> mnt (InTok PlainWord (BS8.singleton c)) + where + mnt a = mint a s True + +-- | Starts a new token. +newTok + :: Either QuoteType Char + -- ^ If Left, start a new quoted token. If Right, start a new + -- plain token with the given character. + -> (Tokenizer, Maybe Token) + -- ^ snd is always False, fst if an accepting Tokenizer +newTok e = (Tokenizer (Just (InTok i s)), Nothing) + where + (i, s) = case e of + Left q -> (Quoted q False, BS8.empty) + Right c -> (PlainWord, BS8.singleton c) + +-- | Finishes any remaining tokens in the machine. Applies 'error' +-- if there is a quoted token in the machine that has not been +-- finished yet. +finish :: Tokenizer -> Maybe Token +finish (Tokenizer ma) = case ma of + Nothing -> Nothing + Just a -> case a of + BetweenToks -> Nothing + InTok i s -> case i of + PlainWord -> Just (Token s False) + Quoted _ pnd + | pnd -> Just (Token s True) + | otherwise -> error "finish: quoted token still in machine" diff --git a/dectest/Parse/Tokens.hs b/dectest/Parse/Tokens.hs new file mode 100644 --- /dev/null +++ b/dectest/Parse/Tokens.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} +module Parse.Tokens + ( Raw(unRaw) + , Line(..) + , T.Token(..) + , splitLines + , processLine + , raw + ) where + +import qualified Data.ByteString.Char8 as BS8 +import qualified Parse.Tokenizer as T + +-- | Raw file, parsed in from disk. +newtype Raw = Raw { unRaw :: BS8.ByteString } + deriving Show + +raw :: FilePath -> IO Raw +raw = fmap Raw . BS8.readFile + +-- | A line from a Raw. Does not contain any newlines. +newtype Line = Line { unLine :: BS8.ByteString } + deriving Show + +-- | Splits a Raw into a list of Line. First, eliminates any +-- MS-DOS carriage returns (ASCII character 0d). Then, uses the +-- ByteString lines function. +splitLines :: Raw -> [Line] +splitLines = map Line . BS8.lines . BS8.filter (/= '\r') . unRaw + +-- +-- Parsing a Line into Tokens +-- + +data HighLevelLine = HighLevelLine + { llState :: T.Tokenizer + , llToks :: [T.Token] + } deriving Show + +highLevelProc :: HighLevelLine -> Char -> HighLevelLine +highLevelProc h c = HighLevelLine l' ts' + where + (l', mayT) = T.feed c (llState h) + ts' = case mayT of + Nothing -> llToks h + Just t' -> t' : llToks h + +eject :: HighLevelLine -> [T.Token] +eject h = reverse toks + where + toks = case T.finish (llState h) of + Nothing -> llToks h + Just t -> t : llToks h + +processLine :: Line -> [T.Token] +processLine + = eject + . BS8.foldl highLevelProc z + . unLine + where + z = HighLevelLine T.start [] + +_testProcessLine :: String -> IO () +_testProcessLine + = mapM_ BS8.putStrLn + . map T.unToken + . processLine + . Line + . BS8.pack + diff --git a/dectest/Result.hs b/dectest/Result.hs new file mode 100644 --- /dev/null +++ b/dectest/Result.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +module Result where + +import TestLog +import qualified Data.ByteString.Char8 as BS8 +import qualified Deka.Dec as D +import qualified Deka.Context as C +import Data.Monoid + +-- | Parses a result token. Returns Nothing if the result token was +-- a question mark, as this indicates that the result is undefined. +-- Bypasses if the token contains an octothorpe. Otherwise, returns +-- the Dec. +-- +-- Probably the easiest way to do the comparison is going to be to +-- take the output of the test function, apply @toByteString@ to it, +-- and then test that for equality with the result of applying +-- @toByteString@ to the result returned from here. + +result + :: BS8.ByteString + -> TestLog (Maybe D.Dec) +result bs + | '#' `BS8.elem` bs = + bypass $ "result contains an octothorpe: " <> bs + + | '?' `BS8.elem` bs = do + tell "result token contains a question mark" + return Nothing + + | otherwise = do + tell $ "parsing result token: " <> bs + let r = C.runCtx (D.fromByteString bs) + tell $ "result parse result: " <> D.toByteString r + return . Just $ r + +-- | Parses result token where the function is expecting an +-- Ordering. + +resultOrd + :: BS8.ByteString + -> TestLog Ordering +resultOrd bs + | '#' `BS8.elem` bs = + bypass $ "result contains an octothorpe: " <> bs + + | '?' `BS8.elem` bs = + flunk "result token contains a question mark" + + | otherwise = do + tell $ "parsing result token: " <> bs + case bs of + "-1" -> return LT + "0" -> return EQ + "1" -> return GT + _ -> flunk $ "unrecognized Ord result: " <> bs + +resultBool + :: BS8.ByteString + -> TestLog Bool +resultBool bs + | '#' `BS8.elem` bs = + bypass $ "result contains an octothorpe: " <> bs + + | '?' `BS8.elem` bs = + flunk "result token contains a question mark" + + | otherwise = do + tell $ "parsing result token: " <> bs + case bs of + "1" -> return True + "0" -> return False + _ -> flunk $ "unrecognized Bool result: " <> bs + diff --git a/dectest/Runner.hs b/dectest/Runner.hs new file mode 100644 --- /dev/null +++ b/dectest/Runner.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE OverloadedStrings, BangPatterns #-} +module Runner (runAndExit) where + +import qualified Parse as P +import qualified Data.ByteString.Char8 as BS8 +import Data.Monoid +import Data.List (intersperse) +import System.Exit +import Data.Foldable (toList) +import qualified Data.Sequence as S +import Data.Sequence ((|>)) +import Pipes +import Pipes.Prelude (fold) +import NumTests (testLookups) +import Types + +produceFile :: MonadIO m => Pipe BS8.ByteString P.File m () +produceFile = do + bs <- await + f <- liftIO $ P.parseFile bs + yield f + +order :: Monad m => Pipe P.File Order m () +order = do + f <- await + go S.empty (P.fileContents f) + where + go !sq ls = case ls of + [] -> return () + x:xs -> case x of + Left inner -> go S.empty (P.fileContents inner) + Right i -> case i of + P.Blank -> go sq xs + P.Directive k v -> + let sq' = sq |> (k, v) + in go sq' xs + P.Test spec -> do + yield (Order sq spec) + go sq xs + +output :: Monad m => Pipe Order TestOutput m () +output = do + o <- await + case lookup (P.testOperation . ordSpec $ o) testLookups of + Nothing -> yield (noOperation . ordSpec $ o) + Just t -> yield (runTest o t) + output + + +printTest + :: MonadIO m + => Pipe TestOutput (Maybe Bool) m () +printTest = do + o <- await + liftIO . BS8.putStr . showResult $ o + yield (outResult o) + printTest + +pipeline :: MonadIO m => Pipe BS8.ByteString (Maybe Bool) m () +pipeline = + produceFile + >-> order + >-> output + >-> printTest + +totals :: Monad m => Producer (Maybe Bool) m () -> m Counts +totals = fold tally mempty id + +runAndExit :: [String] -> IO () +runAndExit ss = do + let bs = map BS8.pack ss + pip = each bs >-> pipeline + tot <- totals pip + putStr . showCounts $ tot + exit tot + +noOperation :: P.TestSpec -> TestOutput +noOperation ts = TestOutput + { outSpec = ts + , outResult = Nothing + , outLog = S.singleton "no matching operation; skipping" + } + +data Order = Order + { _ordDirectives :: S.Seq (P.Keyword, P.Value) + , ordSpec :: P.TestSpec + } + +runTest + :: Order + -> Test + -> TestOutput +runTest (Order ds ts) t = TestOutput + { outSpec = ts + , outResult = r + , outLog = l + } + where + (r, l) = t ds (P.testOperands ts) (P.testResult ts) + (P.testConditions ts) + +data TestOutput = TestOutput + { outSpec :: P.TestSpec + , outResult :: Maybe Bool + , outLog :: S.Seq BS8.ByteString + } + +data Counts = Counts + { _nPass :: !Int + , nFail :: !Int + , _nSkip :: !Int + } deriving Show + +tally :: Counts -> Maybe Bool -> Counts +tally (Counts p f s) mb = case mb of + Nothing -> Counts p f (s + 1) + Just True -> Counts (p + 1) f s + Just False -> Counts p (f + 1) s + +instance Monoid Counts where + mempty = Counts 0 0 0 + (Counts x1 y1 z1) `mappend` (Counts x2 y2 z2) = + Counts (x1 + x2) (y1 + y2) (z1 + z2) + +showCounts :: Counts -> String +showCounts (Counts p f s) = unlines + [ "pass: " ++ show p + , "fail: " ++ show f + , "skip: " ++ show s + , "total: " ++ show (p + f + s) + ] + +exit :: Counts -> IO () +exit c + | nFail c > 0 = exitFailure + | otherwise = exitSuccess + +showResult + :: TestOutput + -> BS8.ByteString +showResult (TestOutput t r sq) = BS8.unlines $ l1:lr + where + l1 = pf <+> showSpec t + pf = case r of + Nothing -> "[skip]" + Just True -> "[pass]" + Just False -> "[FAIL]" + lr = map (" " <>) . toList $ sq + +showSpec :: P.TestSpec -> BS8.ByteString +showSpec t = + P.testId t + <+> P.testOperation t + <+> BS8.concat (intersperse " " . P.testOperands $ t) + <+> "->" + <+> P.testResult t + <+> BS8.concat (intersperse " " . P.testConditions $ t) + +(<+>) :: BS8.ByteString -> BS8.ByteString -> BS8.ByteString +l <+> r + | BS8.null l && BS8.null r = "" + | BS8.null l || BS8.null r = l <> r + | otherwise = l <> " " <> r + diff --git a/dectest/Specials.hs b/dectest/Specials.hs new file mode 100644 --- /dev/null +++ b/dectest/Specials.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Handling special cases: toSci, toEng, apply, class. + +module Specials where + +import qualified Data.ByteString.Char8 as BS8 +import TestLog +import qualified Deka.Context as C +import qualified Deka.Dec as D +import Types +import Operand +import Directives +import TestHelpers +import Data.Monoid +import Result +import Data.Char (toLower) +import Control.Arrow (first) + +toSciOrEng :: (D.Dec -> BS8.ByteString) -> Test +toSciOrEng fn dirs opS rsS cdS = runTestLog $ do + ic <- parseDirectives dirs + getOp <- case opS of + x:[] -> operandSciEngAp ic x + _ -> flunk $ "expected 1 operand, got " <> + (BS8.pack . show . length $ opS) + let (rConv, fl) = C.runCtxStatus getOp + r = fn rConv + testConditions cdS fl + if r == rsS + then pass $ "string " <> r <> " matches expected result" + else flunk $ "string " <> r <> " does not match expected " + <> "result of " <> rsS + +toSci :: Test +toSci = toSciOrEng D.toByteString + +toEng :: Test +toEng = toSciOrEng D.toEngByteString + +apply :: Test +apply dirs opS rsS cdS = runTestLog $ do + ic <- parseDirectives dirs + getOp <- case opS of + x:[] -> operandSciEngAp ic x + _ -> flunk $ "expected 1 operand, got " <> + (BS8.pack . show . length $ opS) + let k = getOp >>= D.plus + (rConv, fl) = C.runCtxStatus k + r = D.toByteString rConv + tgt <- result rsS + testConditions cdS fl + case tgt of + Nothing -> flunk $ "target result of apply is undefined; " + <> "this makes no sense" + Just t + | D.toByteString t == r -> pass "result is as expected" + | otherwise -> flunk $ "result of " <> r + <> " does not match expected result of " + <> D.toByteString t + +parseClass :: BS8.ByteString -> TestLog D.Class +parseClass bs = case lookup lwr ls of + Nothing -> flunk $ "could not parse class: " <> bs + Just r -> do + tell $ "parsed class: " <> bs + return r + where + lwr = map toLower . BS8.unpack $ bs + ls = map (first (map toLower)) D.strToClass + +decClass :: Test +decClass dirs opS rsS cdS = runTestLog $ do + ic <- parseDirectives dirs + op <- case opS of + x:[] -> operand ic x + _ -> flunk $ "expected 1 operand, got " <> + (BS8.pack . show . length $ opS) + tgt <- parseClass rsS + let k = ic >> D.numClass op + (r, fl) = C.runCtxStatus k + testConditions cdS fl + if r == tgt + then pass "result is as expected" + else flunk $ "unexpected class: result is " <> + (BS8.pack . show $ r) diff --git a/dectest/TestHelpers.hs b/dectest/TestHelpers.hs new file mode 100644 --- /dev/null +++ b/dectest/TestHelpers.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +module TestHelpers where + +import TestLog +import qualified Data.ByteString.Char8 as BS8 +import qualified Deka.Dec as D +import qualified Deka.Context as C +import Data.Monoid +import Conditions +import Data.List (sort) + +testConditions + :: [BS8.ByteString] + -- ^ List of conditions + -> C.Flags + -- ^ Actual conditions from test + -> TestLog () +testConditions bs flgs = do + cs <- parseConditions bs + let fs = sort . C.unpackFlags $ flgs + if sort fs == sort cs + then tell "conditions are as expected" + else flunk $ "conditions not as expected: " <> + (BS8.pack . show $ fs) + +testDec :: D.Dec -> Maybe D.Dec -> TestLog () +testDec x y = case y of + Nothing -> tell "target result is undefined" >> return () + Just r -> + let sx = D.toByteString x + sr = D.toByteString r + res | sx == sr = tell "result is as expected" + | otherwise = + flunk $ "output: " <> sx <> " expected result: " <> sr + in res diff --git a/dectest/TestLog.hs b/dectest/TestLog.hs new file mode 100644 --- /dev/null +++ b/dectest/TestLog.hs @@ -0,0 +1,64 @@ +module TestLog + ( TestLog + , tell + , bypass + , flunk + , Done + , pass + , runTestLog + ) where + +import qualified Data.Sequence as S +import Control.Applicative +import Control.Monad +import qualified Data.ByteString.Char8 as BS8 +import Data.Monoid + +data State a + = Good a + | Failed + | Bypass + deriving Show + +newtype TestLog a = TestLog + { unTestLog :: (S.Seq BS8.ByteString, State a) } + deriving Show + +instance Monad TestLog where + return a = TestLog (S.empty, Good a) + (TestLog (ss, st)) >>= f = TestLog $ case st of + Failed -> (ss, Failed) + Bypass -> (ss, Bypass) + Good a -> let (ss', st') = unTestLog $ f a in + (ss <> ss', st') + +instance Applicative TestLog where + pure = return + (<*>) = ap + +instance Functor TestLog where + fmap = liftM + +tell :: BS8.ByteString -> TestLog () +tell bs = TestLog (S.singleton bs, Good ()) + +bypass :: BS8.ByteString -> TestLog a +bypass bs = TestLog (S.singleton bs, Bypass) + +flunk :: BS8.ByteString -> TestLog a +flunk bs = TestLog (S.singleton bs, Failed) + +data Done = Done + deriving Show + +pass :: BS8.ByteString -> TestLog Done +pass bs = TestLog (S.singleton bs, Good Done) + +runTestLog :: TestLog Done -> (Maybe Bool, S.Seq BS8.ByteString) +runTestLog (TestLog (ss, st)) = (r, ss) + where + r = case st of + Good Done -> Just True + Failed -> Just False + Bypass -> Nothing + diff --git a/dectest/Types.hs b/dectest/Types.hs new file mode 100644 --- /dev/null +++ b/dectest/Types.hs @@ -0,0 +1,36 @@ +module Types where + +import qualified Data.ByteString.Char8 as BS8 +import qualified Parse as P +import Data.Sequence + +-- | All tests must conform to this interface. + +type Test + + = Seq (P.Keyword, P.Value) + -- ^ All directives in force when the test is run. Oldest + -- directives are on the left side of the Seq; newest ones, on + -- the right side. + + -> [BS8.ByteString] + -- ^ Operands + + -> BS8.ByteString + -- ^ Result + + -> [BS8.ByteString] + -- ^ Conditions. These are already sorted. + + -> (Maybe Bool, Seq BS8.ByteString) + -- ^ The test returns a Maybe Bool to indicate the test result. + -- Passage is Just True, failure is Just False, skip is Nothing. + -- Use Nothing for inputs that the implementation does not + -- support, such as null operands. For all other failures + -- (including programmer errors or test configuration errors such + -- as mismatches in the number of operands), use Just False. + -- + -- Also returned is a list of ByteString. These are narratives. + -- Put one pice of data in each line. For example you might + -- include information on how the operands parsed, how the result + -- parsed, what information the test function returned, etc. diff --git a/dectest/Util.hs b/dectest/Util.hs new file mode 100644 --- /dev/null +++ b/dectest/Util.hs @@ -0,0 +1,28 @@ +module Util where + +import qualified Data.ByteString.Char8 as BS8 + +switch :: a -> [(Bool, a)] -> a +switch dflt [] = dflt +switch dflt ((bl, a):xs) + | bl = a + | otherwise = switch dflt xs + +parseBool :: Int -> Maybe Bool +parseBool i + | i == 0 = Just False + | i == 1 = Just True + | otherwise = Nothing + +safeRead :: Read a => String -> Maybe a +safeRead a = case reads a of + (x, ""):[] -> Just x + _ -> Nothing + +readNumber :: Read a => String -> Maybe a +readNumber a = case a of + [] -> Nothing + x:xs -> if x == '+' then safeRead xs else safeRead (x:xs) + +readNumberBS :: Read a => BS8.ByteString -> Maybe a +readNumberBS bs = readNumber (BS8.unpack bs) diff --git a/dectest/dectest.hs b/dectest/dectest.hs new file mode 100644 --- /dev/null +++ b/dectest/dectest.hs @@ -0,0 +1,7 @@ +module Main where + +import Runner +import System.Environment + +main :: IO () +main = getArgs >>= runAndExit diff --git a/deka.cabal b/deka.cabal --- a/deka.cabal +++ b/deka.cabal @@ -1,15 +1,23 @@ name: deka -version: 0.4.0.4 +version: 0.6.0.0 synopsis: Decimal floating point arithmetic description: - deka provides decimal floating point arithmetic. It - is based on the decNumber C library, which is available - at + + deka provides decimal floating point arithmetic. It is based on + mpdecimal, the C library used to provide support for the Decimal + module in Python 3. . - + You will need to install mpdecimal to use deka; otherwise your + executables will not link. It is available at . - decNumber, in turn, implements the General Decimal Arithmetic + + . + mpdecimal has also been packaged for some Linux distributions, + such as Debian (libmpdec-dev - available in Jessie and later) and + Arch (mpdecimal). + . + mpdecimal, in turn, implements the General Decimal Arithmetic Specification, which is available at . @@ -25,16 +33,9 @@ maintainer: omari@smileystation.com copyright: 2014 Omari Norman category: Math -build-type: Configure +build-type: Simple extra-source-files: README.md ChangeLog current-versions.txt minimum-versions.txt - configure - decnumber/src/decNumberLocal.h.in - decnumber/src/decCommon.c - decnumber/src/decBasic.c - decnumber/src/decContext.h - decnumber/src/decQuad.h - decnumber/src/decDPD.h cabal-version: >=1.10 tested-with: GHC==7.4.1 GHC==7.6.3, GHC ==7.8.2 @@ -42,64 +43,84 @@ hs-source-dirs: lib exposed-modules: - Data.Deka - , Data.Deka.Quad - , Data.Deka.Docs - , Data.Deka.Docs.Examples + Deka + , Deka.Context + , Deka.Dec + , Deka.Docs + , Deka.Docs.Examples + , Deka.Native + , Deka.Native.Abstract + , Deka.Native.FromString other-modules: - Data.Deka.Decnumber - , Data.Deka.Internal - + Deka.Internal.Context + , Deka.Internal.Dec.CtxFree + , Deka.Internal.Dec.Ctx + , Deka.Internal.Unsafe + , Deka.Internal.Mpdec + , Deka.Internal.Util.Ctx + build-depends: base >=4.5.0.0 && < 4.8 , bytestring >=0.9.2.1 && < 0.11 + , parsec >= 3.1.2 && < 3.2 + , transformers >= 0.3.0.0 && < 0.4 ghc-options: -Wall default-language: Haskell2010 - c-sources: - decnumber/src/decQuad.c - decnumber/src/decContext.c - include-dirs: - decnumber/src - - --- The test suite does not have deka listed in the build-depends. --- This lengthens the compilation times but it allows the test suite --- to have access to Data.Deka.Internal, which is critical for --- testing. + extra-libraries: mpdec -Test-Suite tasty-test +Test-Suite dectest Build-depends: - base >=4.5.0.0 && < 4.8 - , tasty-quickcheck >=0.3.1 && < 0.9 - , tasty >=0.7 && < 0.9 - , QuickCheck >=2.6 && < 2.8 + deka ==0.6.0.0 + , base >= 4.5.0.0 && < 4.8 , bytestring >=0.9.2.1 && < 0.11 + , transformers >= 0.3.0.0 && < 0.4.0.0 + , containers >= 0.4.2.1 && < 0.6 + , pipes >= 4.1.1 && < 4.2 + type: exitcode-stdio-1.0 + hs-source-dirs: dectest + ghc-options: -Wall + main-is: dectest.hs other-modules: - Data.Deka - , Data.Deka.Internal - , Data.Deka.Decnumber - , Data.Deka.Quad - , Data.Deka.Docs - , Data.Deka.Docs.Examples + AllModules + , Arity + , Conditions + , Directives + , NumTests + , Operand + , Parse + , Parse.Tokenizer + , Parse.Tokens + , Result + , Runner + , Specials + , TestHelpers + , TestLog + , Types + , Util + default-language: Haskell2010 + extra-libraries: mpdec - , DataDir - , DataDir.DekaDir - , DataDir.DekaTest - , DataDir.DekaDir.QuadTest +Test-Suite native + Build-depends: + deka ==0.6.0.0 + , base >= 4.5.0.0 && < 4.8 + , bytestring >=0.9.2.1 && < 0.11 + , QuickCheck >= 2.7.3 && < 2.8 + , tasty >= 0.8.0.4 && < 0.9 + , tasty-quickcheck >= 0.8.0.3 && < 0.9 type: exitcode-stdio-1.0 - hs-source-dirs: test lib - ghc-options: -Wall -rtsopts -fprof-auto - main-is: tasty-test.hs - default-language: Haskell2010 - - c-sources: - decnumber/src/decQuad.c - decnumber/src/decContext.c - include-dirs: - decnumber/src + hs-source-dirs: native + ghc-options: -Wall + main-is: native.hs + other-modules: + AllModules + , Generators + , Properties + default-language: Haskell2010 + extra-libraries: mpdec diff --git a/lib/Data/Deka.hs b/lib/Data/Deka.hs deleted file mode 100644 --- a/lib/Data/Deka.hs +++ /dev/null @@ -1,168 +0,0 @@ -{-# LANGUAGE Safe, DeriveDataTypeable #-} - --- | Simple decimal arithmetic. --- --- 'Deka' provides a decimal arithmetic type. You are limited to 34 --- digits of precision. That's 34 digits total, not 34 digits after --- the decimal point. For example, the numbers @123.0@ and @0.1230@ --- both have four digits of precision. Deka remembers significant --- digits, so @123@ has three digits of precision while @123.0@ has --- four digits of precision. --- --- Using this module, the results are never inexact. Computations --- will throw exceptions rather than returning an inexact result. --- That way, you know that any result you have is exactly correct. --- --- 'Deka' represents only finite values. There are no infinities or --- not-a-number values allowed. --- --- For more control over your arithmetic, see "Data.Deka.Quad", but --- for many routine uses this module is sufficient and is more --- succinct because, unlike 'Quad', 'Deka' is a member of the 'Num' --- typeclass. -module Data.Deka - ( Deka - , unDeka - , DekaT(..) - , integralToDeka - , strToDeka - , quadToDeka - , DekaError(..) - ) where - -import Control.Exception -import Data.Maybe -import Data.Typeable -import Data.Deka.Quad -import qualified Data.Deka.Quad as P -import qualified Data.ByteString.Char8 as BS8 - --- | Thrown by arithmetic functions in the Num class, as this is the --- only way to indicate errors. -data DekaError - = IntegerTooBig Integer - -- ^ Could not convert an integer to a Deka; it is too big. - | Flagged Flags - -- ^ A computation set flags. This will happen if, for example, - -- you calculate a result that is out of range, such as - -- - -- >>> maxBound + maxBound :: Deka - deriving (Show, Typeable) - -instance Exception DekaError - --- | Deka wraps a 'Quad'. Only finite 'Quad' may become a 'Deka'; --- no infinities or NaN values are allowed. --- --- 'Deka' is a member of 'Num' and 'Real', making it easy to use for --- elementary arithmetic. Any time you perform arithmetic, the --- results are always exact. The arithmetic functions will throw --- exceptions rather than give you an inexact result. --- --- 'Deka' is not a member 'Fractional' because it is generally --- impossible to perform division without getting inexact results, --- and 'Deka' never holds inexact results. -newtype Deka = Deka { unDeka :: Quad } - deriving Show - -eval :: Ctx a -> a -eval c - | fl == emptyFlags = r - | otherwise = throw . Flagged $ fl - where - (r, fl) = runCtx c - --- | Eq compares by value. For instance, @3.5 == 3.500@. -instance Eq Deka where - Deka x == Deka y = case compareOrd x y of - Just EQ -> True - Just _ -> False - _ -> error "Deka: Eq: unexpected result" - --- | Ord compares by value. For instance, @compare 3.5 3.500 == --- EQ@. -instance Ord Deka where - compare (Deka x) (Deka y) = case compareOrd x y of - Just r -> r - _ -> error "Deka: compare: unexpected reslt" - --- | Many of the 'Num' functions will throw 'DekaError' if their --- arguments are out of range or if they produce results that are --- out of range or inexact. For functions that don't throw, you can --- use 'integralToDeka' rather than 'fromInteger', or you can use --- "Data.Deka.Quad" instead of 'Deka'. -instance Num Deka where - Deka x + Deka y = Deka . eval $ P.add x y - Deka x - Deka y = Deka . eval $ P.subtract x y - Deka x * Deka y = Deka . eval $ P.multiply x y - negate = Deka . eval . P.minus . unDeka - abs = Deka . eval . P.abs . unDeka - signum (Deka x) - | f isZero = fromInteger 0 - | f isNegative = fromInteger (-1) - | otherwise = fromInteger 1 - where - f g = g x - fromInteger i = fromMaybe (throw (IntegerTooBig i)) - . integralToDeka $ i - -instance Real Deka where - toRational (Deka x) = case decodedToRational . toBCD $ x of - Nothing -> error "Deka.toRational: failed." - Just r -> r - -instance Bounded Deka where - minBound = Deka $ fromBCD (Decoded Sign1 (Finite oneCoeff minBound)) - where - oneCoeff = succ minBound - maxBound = Deka $ fromBCD (Decoded Sign0 (Finite maxBound maxBound)) - - --- | Decimals with a total ordering. -newtype DekaT = DekaT { unDekaT :: Deka } - deriving Show - --- | Eq compares by a total ordering. -instance Eq DekaT where - DekaT (Deka x) == DekaT (Deka y) - | r == EQ = True - | otherwise = False - where - r = compareTotal x y - --- | Ord compares by a total ordering. -instance Ord DekaT where - compare (DekaT (Deka x)) (DekaT (Deka y)) = compareTotal x y - - --- | Convert any integral to a Deka. Returns 'Nothing' if the --- integer is too big to fit into a Deka (34 digits). -integralToDeka :: Integral a => a -> Maybe Deka -integralToDeka i = do - coe <- P.coefficient . P.integralToDigits $ i - let d = Decoded sgn (Finite coe zeroExponent) - sgn = if i < 0 then Sign1 else Sign0 - return . Deka $ fromBCD d - --- | Convert a string to a Deka. You can use ordinary numeric --- strings, such as @3.25@, or exponential notation, like @325E-2@. --- More information on your choices is at: --- --- --- --- You cannot use strings that represent an NaN or an infinity. If --- you do that, or use an otherwise invalid string, this function --- returns 'Nothing'. -strToDeka :: String -> Maybe Deka -strToDeka s - | fl /= emptyFlags = Nothing - | not (isFinite r) = Nothing - | otherwise = Just (Deka r) - where - (r, fl) = runCtx . fromByteString . BS8.pack $ s - --- | Change a Quad to a Deka. Only succeeds for finite Quad. -quadToDeka :: Quad -> Maybe Deka -quadToDeka q - | isFinite q = Just $ Deka q - | otherwise = Nothing diff --git a/lib/Data/Deka/Decnumber.hsc b/lib/Data/Deka/Decnumber.hsc deleted file mode 100644 --- a/lib/Data/Deka/Decnumber.hsc +++ /dev/null @@ -1,731 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -#include -#include - -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) - --- | Low-level bindings to the decNumber library. -module Data.Deka.Decnumber where - -import Foreign.Safe -import Foreign.C -import Control.Applicative - -c'NULL :: Num a => a -c'NULL = #const NULL - -type C'rounding = #type enum rounding - -c'DEC_ROUND_CEILING :: Num a => a -c'DEC_ROUND_CEILING = #const DEC_ROUND_CEILING - -c'DEC_ROUND_UP :: Num a => a -c'DEC_ROUND_UP = #const DEC_ROUND_UP - -c'DEC_ROUND_HALF_UP :: Num a => a -c'DEC_ROUND_HALF_UP = #const DEC_ROUND_HALF_UP - -c'DEC_ROUND_HALF_EVEN :: Num a => a -c'DEC_ROUND_HALF_EVEN = #const DEC_ROUND_HALF_EVEN - -c'DEC_ROUND_HALF_DOWN :: Num a => a -c'DEC_ROUND_HALF_DOWN = #const DEC_ROUND_HALF_DOWN - -c'DEC_ROUND_DOWN :: Num a => a -c'DEC_ROUND_DOWN = #const DEC_ROUND_DOWN - -c'DEC_ROUND_FLOOR :: Num a => a -c'DEC_ROUND_FLOOR = #const DEC_ROUND_FLOOR - -c'DEC_ROUND_05UP :: Num a => a -c'DEC_ROUND_05UP = #const DEC_ROUND_05UP - -c'DEC_ROUND_MAX :: Num a => a -c'DEC_ROUND_MAX = #const DEC_ROUND_MAX - -type C'int32_t = #type int32_t -type C'uint8_t = #type uint8_t -type C'uint16_t = #type uint16_t -type C'uint32_t = #type uint32_t -type C'uint64_t = #type uint64_t - -data C'decContext = C'decContext - { c'decContext'digits :: C'int32_t - , c'decContext'emax :: C'int32_t - , c'decContext'emin :: C'int32_t - , c'decContext'round :: C'rounding - , c'decContext'traps :: C'uint32_t - , c'decContext'status :: C'uint32_t - , c'decContext'clamp :: C'uint8_t - } deriving (Eq, Show) - -instance Storable C'decContext where - sizeOf _ = #size decContext - alignment _ = #alignment decContext - peek p = - C'decContext - <$> #{peek decContext, digits} p - <*> #{peek decContext, emax} p - <*> #{peek decContext, emin} p - <*> #{peek decContext, round} p - <*> #{peek decContext, traps} p - <*> #{peek decContext, status} p - <*> #{peek decContext, clamp} p - - poke p (C'decContext d ex en r t s c) = - #{poke decContext, digits} p d - >> #{poke decContext, emax} p ex - >> #{poke decContext, emin} p en - >> #{poke decContext, round} p r - >> #{poke decContext, traps} p t - >> #{poke decContext, status} p s - >> #{poke decContext, clamp} p c - -p'decContext'status :: Ptr C'decContext -> Ptr C'uint32_t -p'decContext'status = #ptr decContext, status - -p'decContext'round :: Ptr C'decContext -> Ptr C'rounding -p'decContext'round = #ptr decContext, round - --- decContext -c'DEC_INIT_DECQUAD :: Num a => a -c'DEC_INIT_DECQUAD = #const DEC_INIT_DECQUAD - -foreign import ccall unsafe "decContextDefault" unsafe'c'decContextDefault - :: Ptr C'decContext - -> C'int32_t - -> IO (Ptr C'decContext) - -type C'decClass = #type enum decClass - -c'DEC_CLASS_SNAN :: Num a => a -c'DEC_CLASS_SNAN = #const DEC_CLASS_SNAN - -c'DEC_CLASS_QNAN :: Num a => a -c'DEC_CLASS_QNAN = #const DEC_CLASS_QNAN - -c'DEC_CLASS_NEG_INF :: Num a => a -c'DEC_CLASS_NEG_INF = #const DEC_CLASS_NEG_INF - -c'DEC_CLASS_NEG_NORMAL :: Num a => a -c'DEC_CLASS_NEG_NORMAL = #const DEC_CLASS_NEG_NORMAL - -c'DEC_CLASS_NEG_SUBNORMAL :: Num a => a -c'DEC_CLASS_NEG_SUBNORMAL = #const DEC_CLASS_NEG_SUBNORMAL - -c'DEC_CLASS_NEG_ZERO :: Num a => a -c'DEC_CLASS_NEG_ZERO = #const DEC_CLASS_NEG_ZERO - -c'DEC_CLASS_POS_ZERO :: Num a => a -c'DEC_CLASS_POS_ZERO = #const DEC_CLASS_POS_ZERO - -c'DEC_CLASS_POS_SUBNORMAL :: Num a => a -c'DEC_CLASS_POS_SUBNORMAL = #const DEC_CLASS_POS_SUBNORMAL - -c'DEC_CLASS_POS_NORMAL :: Num a => a -c'DEC_CLASS_POS_NORMAL = #const DEC_CLASS_POS_NORMAL - -c'DEC_CLASS_POS_INF :: Num a => a -c'DEC_CLASS_POS_INF = #const DEC_CLASS_POS_INF - -c'DEC_Conversion_syntax :: Num a => a -c'DEC_Conversion_syntax = #const DEC_Conversion_syntax - -c'DEC_Division_by_zero :: Num a => a -c'DEC_Division_by_zero = #const DEC_Division_by_zero - -c'DEC_Division_impossible :: Num a => a -c'DEC_Division_impossible = #const DEC_Division_impossible - -c'DEC_Division_undefined :: Num a => a -c'DEC_Division_undefined = #const DEC_Division_undefined - -c'DEC_Insufficient_storage :: Num a => a -c'DEC_Insufficient_storage = #const DEC_Insufficient_storage - -c'DEC_Inexact :: Num a => a -c'DEC_Inexact = #const DEC_Inexact - -c'DEC_Invalid_context :: Num a => a -c'DEC_Invalid_context = #const DEC_Invalid_context - -c'DEC_Invalid_operation :: Num a => a -c'DEC_Invalid_operation = #const DEC_Invalid_operation - -c'DEC_Overflow :: Num a => a -c'DEC_Overflow = #const DEC_Overflow - -c'DEC_Clamped :: Num a => a -c'DEC_Clamped = #const DEC_Clamped - -c'DEC_Rounded :: Num a => a -c'DEC_Rounded = #const DEC_Rounded - -c'DEC_Subnormal :: Num a => a -c'DEC_Subnormal = #const DEC_Subnormal - -c'DEC_Underflow :: Num a => a -c'DEC_Underflow = #const DEC_Underflow - -c'DEC_IEEE_754_Division_by_zero :: Num a => a -c'DEC_IEEE_754_Division_by_zero = #const DEC_IEEE_754_Division_by_zero - -c'DEC_IEEE_754_Inexact :: Num a => a -c'DEC_IEEE_754_Inexact = #const DEC_IEEE_754_Inexact - -c'DEC_IEEE_754_Invalid_operation :: Num a => a -c'DEC_IEEE_754_Invalid_operation = #const DEC_IEEE_754_Invalid_operation - -c'DEC_IEEE_754_Overflow :: Num a => a -c'DEC_IEEE_754_Overflow = #const DEC_IEEE_754_Overflow - -c'DEC_IEEE_754_Underflow :: Num a => a -c'DEC_IEEE_754_Underflow = #const DEC_IEEE_754_Underflow - -c'DEC_Errors :: Num a => a -c'DEC_Errors = #const DEC_Errors - -c'DEC_NaNs :: Num a => a -c'DEC_NaNs = #const DEC_NaNs - -c'DEC_Condition_Length :: Num a => a -c'DEC_Condition_Length = #const DEC_Condition_Length - -c'DEC_INIT_BASE :: Num a => a -c'DEC_INIT_BASE = #const DEC_INIT_BASE - -c'DEC_INIT_DECIMAL32 :: Num a => a -c'DEC_INIT_DECIMAL32 = #const DEC_INIT_DECIMAL32 - -c'DEC_INIT_DECIMAL64 :: Num a => a -c'DEC_INIT_DECIMAL64 = #const DEC_INIT_DECIMAL64 - -c'DEC_INIT_DECIMAL128 :: Num a => a -c'DEC_INIT_DECIMAL128 = #const DEC_INIT_DECIMAL128 - - -c'DECQUAD_Bytes :: Num a => a -c'DECQUAD_Bytes = #const DECQUAD_Bytes - -c'DECQUAD_Pmax :: Num a => a -c'DECQUAD_Pmax = #const DECQUAD_Pmax - -c'DECQUAD_Emin :: Num a => a -c'DECQUAD_Emin = #const DECQUAD_Emin - -c'DECQUAD_Emax :: Num a => a -c'DECQUAD_Emax = #const DECQUAD_Emax - -c'DECQUAD_EmaxD :: Num a => a -c'DECQUAD_EmaxD = #const DECQUAD_EmaxD - -c'DECQUAD_Bias :: Num a => a -c'DECQUAD_Bias = #const DECQUAD_Bias - -c'DECQUAD_String :: Num a => a -c'DECQUAD_String = #const DECQUAD_String - -c'DECQUAD_EconL :: Num a => a -c'DECQUAD_EconL = #const DECQUAD_EconL - -c'DECQUAD_Declets :: Num a => a -c'DECQUAD_Declets = #const DECQUAD_Declets - -c'DECQUAD_Ehigh :: Num a => a -c'DECQUAD_Ehigh = #const DECQUAD_Ehigh - -newtype C'decQuad = C'decQuad - { c'decQuad'bytes :: [C'uint8_t] - } deriving (Eq, Show) - -p'decQuad'bytes :: Ptr C'decQuad -> Ptr c'decQuad'bytes -p'decQuad'bytes = #ptr decQuad, bytes - -instance Storable C'decQuad where - sizeOf _ = #size decQuad - alignment _ = #alignment decQuad - peek p = - let pArr = p'decQuad'bytes p - in fmap C'decQuad $ peekArray c'DECQUAD_Bytes pArr - poke p (C'decQuad bs) = pokeArray (p'decQuad'bytes p) bs - -c'DECFLOAT_Sign :: Num a => a -c'DECFLOAT_Sign = #const DECFLOAT_Sign - -c'DECFLOAT_NaN :: Num a => a -c'DECFLOAT_NaN = #const DECFLOAT_NaN - -c'DECFLOAT_qNaN :: Num a => a -c'DECFLOAT_qNaN = #const DECFLOAT_qNaN - -c'DECFLOAT_sNaN :: Num a => a -c'DECFLOAT_sNaN = #const DECFLOAT_sNaN - -c'DECFLOAT_Inf :: Num a => a -c'DECFLOAT_Inf = #const DECFLOAT_Inf - -c'DECFLOAT_MinSp :: Num a => a -c'DECFLOAT_MinSp = #const DECFLOAT_MinSp - - -c'DECPPLUSALT :: Num a => a -c'DECPPLUSALT = #const DECPPLUSALT - -c'DECPMINUSALT :: Num a => a -c'DECPMINUSALT = #const DECPMINUSALT - -c'DECPPLUS :: Num a => a -c'DECPPLUS = #const DECPPLUS - -c'DECPMINUS :: Num a => a -c'DECPMINUS = #const DECPMINUS - -c'DECPPLUSALT2 :: Num a => a -c'DECPPLUSALT2 = #const DECPPLUSALT2 - -c'DECPUNSIGNED :: Num a => a -c'DECPUNSIGNED = #const DECPUNSIGNED - - --- Utilities - -foreign import ccall unsafe "decQuadToInt32" unsafe'c'decQuadToInt32 - :: Ptr C'decQuad - -> Ptr C'decContext - -> C'rounding - -> IO C'int32_t - -foreign import ccall unsafe "decQuadToInt32Exact" unsafe'c'decQuadToInt32Exact - :: Ptr C'decQuad - -> Ptr C'decContext - -> C'rounding - -> IO C'int32_t - -foreign import ccall unsafe "decQuadFromInt32" unsafe'c'decQuadFromInt32 - :: Ptr C'decQuad - -> C'int32_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadFromPacked" unsafe'c'decQuadFromPacked - :: Ptr C'decQuad - -> C'int32_t - -> Ptr C'uint8_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadFromPackedChecked" unsafe'c'decQuadFromPackedChecked - :: Ptr C'decQuad - -> C'int32_t - -> Ptr C'uint8_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadFromUInt32" unsafe'c'decQuadFromUInt32 - :: Ptr C'decQuad - -> C'uint32_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadFromString" unsafe'c'decQuadFromString - :: Ptr C'decQuad - -> CString - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadGetCoefficient" unsafe'c'decQuadGetCoefficient - :: Ptr C'decQuad - -> Ptr C'uint8_t - -> IO C'int32_t - -foreign import ccall unsafe "decQuadGetExponent" unsafe'c'decQuadGetExponent - :: Ptr C'decQuad - -> IO C'int32_t - -foreign import ccall unsafe "decQuadSetCoefficient" unsafe'c'decQuadSetCoefficient - :: Ptr C'decQuad - -> Ptr C'uint8_t - -> C'int32_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadSetExponent" unsafe'c'decQuadSetExponent - :: Ptr C'decQuad - -> Ptr C'decContext - -> C'int32_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadShow" unsafe'c'decQuadShow - :: Ptr C'decQuad - -> CString - -> IO () - -foreign import ccall unsafe "decQuadToEngString" unsafe'c'decQuadToEngString - :: Ptr C'decQuad - -> CString - -> IO CString - -foreign import ccall unsafe "decQuadToString" unsafe'c'decQuadToString - :: Ptr C'decQuad - -> CString - -> IO CString - -foreign import ccall unsafe "decQuadToUInt32" unsafe'c'decQuadToUInt32 - :: Ptr C'decQuad - -> Ptr C'decContext - -> C'rounding - -> IO C'uint32_t - - -foreign import ccall unsafe "decQuadToUInt32Exact" unsafe'c'decQuadToUInt32Exact - :: Ptr C'decQuad - -> Ptr C'decContext - -> C'rounding - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadZero" unsafe'c'decQuadZero - :: Ptr C'decQuad - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadAbs" unsafe'c'decQuadAbs - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadAdd" unsafe'c'decQuadAdd - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadAnd" unsafe'c'decQuadAnd - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadDivide" unsafe'c'decQuadDivide - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadDivideInteger" unsafe'c'decQuadDivideInteger - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadFMA" unsafe'c'decQuadFMA - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadFromBCD" unsafe'c'decQuadFromBCD - :: Ptr C'decQuad - -> C'int32_t - -> Ptr C'uint8_t - -> C'int32_t - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadInvert" unsafe'c'decQuadInvert - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadLogB" unsafe'c'decQuadLogB - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadMax" unsafe'c'decQuadMax - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadMaxMag" unsafe'c'decQuadMaxMag - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadMin" unsafe'c'decQuadMin - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadMinMag" unsafe'c'decQuadMinMag - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadMinus" unsafe'c'decQuadMinus - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadMultiply" unsafe'c'decQuadMultiply - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadNextMinus" unsafe'c'decQuadNextMinus - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadNextPlus" unsafe'c'decQuadNextPlus - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadNextToward" unsafe'c'decQuadNextToward - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadOr" unsafe'c'decQuadOr - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadPlus" unsafe'c'decQuadPlus - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadQuantize" unsafe'c'decQuadQuantize - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadReduce" unsafe'c'decQuadReduce - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadRemainder" unsafe'c'decQuadRemainder - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadRemainderNear" unsafe'c'decQuadRemainderNear - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadRotate" unsafe'c'decQuadRotate - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadScaleB" unsafe'c'decQuadScaleB - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadShift" unsafe'c'decQuadShift - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadSubtract" unsafe'c'decQuadSubtract - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadToBCD" unsafe'c'decQuadToBCD - :: Ptr C'decQuad - -> Ptr C'int32_t - -> Ptr C'uint8_t - -> IO C'int32_t - -foreign import ccall unsafe "decQuadToIntegralValue" unsafe'c'decQuadToIntegralValue - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> C'rounding - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadToIntegralExact" unsafe'c'decQuadToIntegralExact - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadXor" unsafe'c'decQuadXor - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - --- Comparisons - -foreign import ccall unsafe "decQuadCompare" unsafe'c'decQuadCompare - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCompareSignal" unsafe'c'decQuadCompareSignal - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCompareTotal" unsafe'c'decQuadCompareTotal - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCompareTotalMag" unsafe'c'decQuadCompareTotalMag - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - --- Copies -foreign import ccall unsafe "decQuadCanonical" unsafe'c'decQuadCanonical - :: Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCopyAbs" unsafe'c'decQuadCopyAbs - :: Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCopyNegate" unsafe'c'decQuadCopyNegate - :: Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCopySign" unsafe'c'decQuadCopySign - :: Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - -foreign import ccall unsafe "decQuadCopy" unsafe'c'decQuadCopy - :: Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - --- Non-computational - -foreign import ccall unsafe "decQuadClass" unsafe'c'decQuadClass - :: Ptr C'decQuad - -> IO C'decClass - -foreign import ccall unsafe "decQuadClassString" unsafe'c'decQuadClassString - :: Ptr C'decQuad - -> IO CString - -foreign import ccall unsafe "decQuadDigits" unsafe'c'decQuadDigits - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsCanonical" unsafe'c'decQuadIsCanonical - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsFinite" unsafe'c'decQuadIsFinite - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsInteger" unsafe'c'decQuadIsInteger - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsLogical" unsafe'c'decQuadIsLogical - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsInfinite" unsafe'c'decQuadIsInfinite - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsNaN" unsafe'c'decQuadIsNaN - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsNegative" unsafe'c'decQuadIsNegative - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsNormal" unsafe'c'decQuadIsNormal - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsPositive" unsafe'c'decQuadIsPositive - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsSignaling" unsafe'c'decQuadIsSignaling - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsSigned" unsafe'c'decQuadIsSigned - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsSubnormal" unsafe'c'decQuadIsSubnormal - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadIsZero" unsafe'c'decQuadIsZero - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadRadix" unsafe'c'decQuadRadix - :: Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadSameQuantum" unsafe'c'decQuadSameQuantum - :: Ptr C'decQuad - -> Ptr C'decQuad - -> IO C'uint32_t - -foreign import ccall unsafe "decQuadVersion" unsafe'c'decQuadVersion - :: IO CString diff --git a/lib/Data/Deka/Docs.hs b/lib/Data/Deka/Docs.hs deleted file mode 100644 --- a/lib/Data/Deka/Docs.hs +++ /dev/null @@ -1,23 +0,0 @@ --- | Documentation for Deka. --- --- At the moment, documentation is scattered about. Some of it is --- in the main README.md, which is in the source code tree and is --- viewable in Github at --- --- --- --- Of course much of it is in the Haddock comments in the source --- code itself. --- --- There is also a module here, "Data.Deka.Docs.Examples". It is in --- literate Haskell and has many comments. Unfortunately Haddock --- does not play well with Literate Haskell. However, the style of --- the file would not play well with Haddock anyway so I'm not sure --- I would ever switch back to regular Haskell for that file. --- --- So if you link to the file from the Haddock docs, you will just --- get a blank page. Fortunately it is easily readable in Github: --- --- - -module Data.Deka.Docs where diff --git a/lib/Data/Deka/Docs/Examples.lhs b/lib/Data/Deka/Docs/Examples.lhs deleted file mode 100644 --- a/lib/Data/Deka/Docs/Examples.lhs +++ /dev/null @@ -1,282 +0,0 @@ -Examples for the Deka library -============================= - -For very simple arithmetic, just import `Data.Deka`. It contains a -`Deka` type, which is an instance of Num. For more control over your -arithmetic, import `Data.Deka.Quad`. Be aware that `Quad` exports some -functions that clash with Prelude names, so you might want to do a -qualified `import`; however we will just import them unqualified -here. - -> -- Examples will deliberately shadow some names -> {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -> -> -- | If you are viewing this module in Haddock and expecting to -> -- see examples, you won't see anything. The file is written in -> -- literate Haskell, so the idea is that you will look at the -> -- source itself. You can look at the source in Haddock, but it -> -- will probably be poorly formatted because HsColour formats it -> -- rather oddly by default. The easiest way to see it -> -- is on Github: -> -- -> -- -> module Data.Deka.Docs.Examples where - -> import Data.Deka -> import Data.Maybe -> import Data.Deka.Quad - -We need Char8 ByteStrings when working with the `Quad` module: - -> import qualified Data.ByteString.Char8 as BS8 - -> examples :: IO () -> examples = do { - -Why is decimal arithmetic important? The webpages here discuss the -issue at great length: - -http://speleotrove.com/decimal/ - -But in a nutshell, the floats that are built in to nearly every -computer language, including Haskell, are approximate. That's OK -for many purposes. It's not OK if you need exact results, such as -for financial purposes. - -For example, on my machine this will not output 0.3 but instead will -output 0.3 plus a small fraction: - -> print $ 0.1 + 0.1 + (0.1 :: Double); - -This sort of imprecision adds up quickly and makes your life as a -programmer harder in many ways. It also produces results that are -simply incorrect if you needed an exact answer. - -For simple arithmetic like this, deka provides the `Deka` type. It is -an instance of `Num`. Results with the `Deka` type are never, ever -rounded. You are limited to 34 digits of precision. If you need -more than 34 digits of precision, you can afford to pay someone to -develop your own library :) For example, these numbers all have 5 -digits of precision: - - 12345 - 123.45 - 0.12345 - 0.00012345 - -All numbers in deka are stored as a "coefficient" and an "exponent". -The coefficient is an integer, and the exponent is an -integer that may be negative, zero, or positive. Here, the -coefficient is always 12345, but the exponent varies: - - Number Exponent - 12345 0 - 123.45 -2 - 0.12345 -5 - 0.00012345 -8 - -Some numbers can only accurately be written down using scientific -notation if we want to reflect how many digits are in the -coefficient. We can do this with E notation, where the coefficient -is followed by the exponent. To get the original number, if the -coefficient is c and the exponent is e, do - - c * 10 ^ e - -So, for example, you can say that `12345e0` and `1234500e-2` are the -same number, but they have different coefficients. - -For more about decimal arithmetic, you will really want to read - -http://speleotrove.com/decimal/decarith.html - -It's written in a very clear style. - -OK, so back to `Deka`. We said that `print $ 0.1 + 0.1 + 0.1` yields -an inaccurate result. How to do it with `Deka`? - -First we have to create a `Deka`. `Deka` is not an instance of -`Read`. However you can use `strToDeka`, which has the type - - strToDeka :: String -> Maybe Deka - -If you give a bad input string, you get `Nothing`; otherwise you get -a `Just` with your `Deka`. The input string can be in regular or -scientific notation. - -So, the following snippet will not give you incorrectly rounded -results: - -> let { oneTenth = fromJust . strToDeka $ "0.1" }; -> print $ oneTenth + oneTenth + oneTenth; - -`Deka` is not an instance of other numeric typeclasses, such as -`Real` or `Fractional`. That's because `Deka` never ever rounds, no -matter what. For `Deka` to be a member of `Fractional`, it would -need to implement division, and division without rounding can't do -very much. - -Sometimes it will be impossible for `Deka` to do its math without -rounding. In that case, the functions in the `Deka` module will -apply `error` and quit. That way you are assured that if you have a -result, it is not rounded. - - -More flexibility with the `Data.Deka.Quad` module -=============================================== - -Though the `Deka` type provides you with some flexibility--and it's -easy to use because it's an instance of `Num`--sometimes you need more -flexibility. If you want to perform division, for example, `Deka` is -no good. For more flexibility, but more cumbersome use, turn to the -`Data.Deka.Quad` module. - -The main type of the `Quad` module is called `Quad`, after decQuad in -the decNumber library. It exposes the full power of the decNumber -library. The disadvantage is that many computations must be -performed in the `Ctx` monad. This monad carries the state that -decNumber needs to do its work. It provides you with a lot of -information about any errors that have occurred during computations. - -If you are getting into the `Quad` module, you really need to read the -decimal arithmetic specification at - -http://speleotrove.com/decimal/decarith.html - -Context -------- - -This specification provides that many computations occur within a -so-called "context", which holds information that affects the -computation, such as how to round inexact results. The context also -holds information about any errors that have happened so far, such -as division by zero, and can tell you other information such as -whether any computations performed so far have calculated an inexact -result. - -The context of the decimal arithmetic specification is represented -in Deka by the `Ctx` type. `Ctx` provides computations with the -context that they need, and it allows computations to record errors -that may arise. `Ctx` is a `Monad` so you can use the usual monad -functions and `do` notation to combine your computations. -`Data.Deka.Quad` has functions you can use to change the context's -rounding, see what errors have been set, and clear errors. Once an -error flag is set, you have to clear it; the functions in `Quad` -won't clear it for you. However, computations can proceed normally -even if an error flag was set in a previous computation. - -After building up a computation in the `Ctx` monad, you need a way -to get the results and use them elsewhere in your program. Two -functions do this: `runCtx` and `evalCtx`. `runCtx` has type - - runCtx :: Ctx a -> (a, Flags) - -It gives you the result of the computation, as well as any flags -that may have arisen. Later we'll talk more about flags; they -indicate any errors or warnings that arose during a computation. -`evalCtx` has type - - evalCtx :: Ctx a -> a - -so it does not tell you any flags that may have arisen. - -Not all computations need a context. For example, `compareTotal` -does not need a context, and it can never return an error. These -functions are pure like any other Haskell function. - -Example - using `do` notation ------------------------------ - -Following is an example of how you would add one tenth using the -Quad type: - -> let { oneTenth = evalCtx . fromByteString . BS8.pack $ "0.1" }; -> BS8.putStrLn . toByteString . evalCtx $ do -> r1 <- add oneTenth oneTenth -> add r1 oneTenth -> ; - -As you can see this is much more cumbersome than using `Deka`. But -it does give you the full power of decNumber. - -Rounding --------- - -One reason to use the `Deka` module is because you want greater -control over rounding. There are many varieties of rounding -available, which you can set. This can be useful with division, for -example, where you will not get exact results. All results are -computed to 34 digits of precision. - -> let tenSixths = evalCtx $ do -> setRound roundDown -> ten <- fromByteString . BS8.pack $ "10" -> three <- fromByteString . BS8.pack $ "6" -> divide ten three -> ; - -Perhaps you want to round the result to a particular number of -decimal places. You do this with the `quantize` function. It takes -two `Quad`: one that you want to round, and another that has the -number of decimal places you want to round to. - -> putStrLn "This is 10 / 6, rounded to two places:"; -> BS8.putStrLn . toByteString . evalCtx $ do -> twoPlaces <- fromByteString . BS8.pack $ "1e-2" -> quantize tenSixths twoPlaces -> ; - -By default, rounding is done using the "roundHalfEven" method. You -can set a different rounding method if you wish; the rounding -methods are listed in the Haddock documentation for `Data.Deka.Quad`. - -> putStrLn "This is 10 / 6, rounded using the 'roundDown' method."; -> BS8.putStrLn . toByteString . evalCtx $ do -> twoPlaces <- fromByteString . BS8.pack $ "1e-2" -> setRound roundDown -> quantize tenSixths twoPlaces -> ; - - -Flags ------ - -A computation may set any number of flags. These are listed in the -`Data.Deka.Quad` module. They indicate errors (like division by zero) -or give information (such as the fact that a computation was -inexact.) Functions in `Data.Deka.Quad` manipulate which flags are -currently set. Though computations set flags, they never clear -them. You have to clear them yourself. - -In addition to flags being available for inspection within the `Ctx` -monad, you can get the final flags using `runCtx`. - -> let (r, fl) = runCtx $ do -> big1 <- fromByteString . BS8.pack $ "987e3000" -> big2 <- fromByteString . BS8.pack $ "322e6000" -> rslt <- multiply big1 big2 -> return $ toByteString rslt -> ; -> putStr "result: "; -> BS8.putStrLn r; -> putStr "flags set: "; -> print fl; - -The above example also shows that computations may return a Quad -that is not finite--that is, it might be inifite, or it might be a -Not-a-Number, or NaN. In contrast, computations using the Deka type -never return non-finite values. - -Conclusion ----------- - -That should be enough to get you started. If you find any bug no -matter how small--even just a typo in the documentation--report it -to me at omari@smileystation.com or file a ticket or a pull request -in Github: - -https://github.com/massysett/deka - -No bug is too small! - -> }; diff --git a/lib/Data/Deka/Internal.hs b/lib/Data/Deka/Internal.hs deleted file mode 100644 --- a/lib/Data/Deka/Internal.hs +++ /dev/null @@ -1,163 +0,0 @@ --- | Internal types - for Deka use only --- --- This module is not listed for export in the cabal file. It --- contains types that library users have no access to, but which --- are needed by multiple Deka modules or that the test suite needs --- access to. -module Data.Deka.Internal where - -import Foreign.Safe -import Foreign.C -import qualified Data.ByteString.Char8 as BS8 -import Data.Deka.Decnumber -import Control.Applicative -import Control.Monad -import System.IO.Unsafe (unsafePerformIO) - --- # Helpers - -type Boolean - = Ptr C'decQuad - -> IO C'uint32_t - -boolean - :: Boolean - -> Quad - -> Bool -boolean f d = unsafePerformIO $ - withForeignPtr (unQuad d) $ \pD -> - f pD >>= \r -> - return $ case r of - 1 -> True - 0 -> False - _ -> error "boolean: bad return value" - --- | Creates a new Quad. Uninitialized, so don't export this --- function. -newQuad :: IO Quad -newQuad = fmap Quad mallocForeignPtr - -type BinaryCtxFree - = Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> IO (Ptr C'decQuad) - -binaryCtxFree - :: BinaryCtxFree - -> Quad - -> Quad - -> Quad -binaryCtxFree f x y = unsafePerformIO $ - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - withForeignPtr (unQuad x) $ \pX -> - withForeignPtr (unQuad y) $ \pY -> - f pR pX pY >> - return r - --- | The Ctx monad --- --- The General Decimal Arithmetic specification states that most --- computations occur within a @context@, which affects the manner --- in which computations are done (for instance, the context --- determines the rounding algorithm). The context also carries --- the flags that computations can set (for instance, a computation might --- set a flag to indicate that the result is rounded or inexact or --- was a division by zero.) The Ctx monad carries this context. -newtype Ctx a = Ctx { unCtx :: Ptr C'decContext -> IO a } - -instance Functor Ctx where - fmap = liftM - -instance Applicative Ctx where - pure = return - (<*>) = ap - -instance Monad Ctx where - return a = Ctx $ \_ -> return a - Ctx a >>= f = Ctx $ \p -> do - r1 <- a p - let b = unCtx $ f r1 - b p - fail s = Ctx $ \_ -> fail s - --- | Decimal number. As indicated in the General Decimal --- Arithmetic specification, a 'Quad' might be a finite number --- (perhaps the most common type) or it might be infinite or a --- not-a-number. 'decClass' will tell you a little more about a --- particular 'Quad'. -newtype Quad = Quad { unQuad :: ForeignPtr C'decQuad } - --- | The Eq instance depends on an IEEE 754 total ordering. In --- particular, note that, for example, @7.5@ is not equal to @7.50@. --- See --- --- - -instance Eq Quad where - x == y = case compareTotal x y of - EQ -> True - _ -> False - --- | Like the 'Eq' instance, this uses an IEEE 754 total ordering. -instance Ord Quad where - compare = compareTotal - --- | The Show instance uses 'toByteString'. -instance Show Quad where - show = BS8.unpack . toByteString - --- | Converts a 'Quad' to a string. May use non-scientific --- notation, but only if that's unambiguous; otherwise, uses --- scientific notation. --- --- In the decNumber C library, this is called @toString@; the name --- was changed here because this function doesn't return a Haskell --- 'String'. -toByteString :: Quad -> BS8.ByteString -toByteString = mkString unsafe'c'decQuadToString - -type MkString - = Ptr C'decQuad - -> CString - -> IO CString - -mkString - :: MkString - -> Quad - -> BS8.ByteString -mkString f d = unsafePerformIO $ - withForeignPtr (unQuad d) $ \pD -> - allocaBytes c'DECQUAD_String $ \pS -> - f pD pS - >> BS8.packCString pS - --- | Compares using an IEEE 754 total ordering, which takes into --- account the exponent. IEEE 754 says that this function might --- return different results depending upon whether the operands are --- canonical; 'Quad' are always canonical so you don't need to worry --- about that here. -compareTotal :: Quad -> Quad -> Ordering -compareTotal x y - | isNegative c = LT - | isZero c = EQ - | isPositive c = GT - | otherwise = error "compareTotal: unknown result" - where - c = binaryCtxFree unsafe'c'decQuadCompareTotal x y - --- # Tests - --- | True only if @x@ is less than zero and is not an NaN. -isNegative :: Quad -> Bool -isNegative = boolean unsafe'c'decQuadIsNegative - --- | True only if @x@ is a zero. -isZero :: Quad -> Bool -isZero = boolean unsafe'c'decQuadIsZero - --- | True only if @x@ is greater than zero and is not an NaN. -isPositive :: Quad -> Bool -isPositive = boolean unsafe'c'decQuadIsPositive - diff --git a/lib/Data/Deka/Quad.hs b/lib/Data/Deka/Quad.hs deleted file mode 100644 --- a/lib/Data/Deka/Quad.hs +++ /dev/null @@ -1,1688 +0,0 @@ -{-# LANGUAGE Trustworthy, DeriveDataTypeable #-} - --- | Floating-point decimals. --- --- This uses the decNumber C library, so you will want to read the --- documentation about it to fully understand this module: --- --- --- --- --- --- --- --- Many of the comments on what these functions do are taken --- directly from the documentation for the decNumber C library. --- --- In particular, this module implements the decQuad type. decQuad --- supports up to 34 digits of precision and exponents between -6176 --- and 6111. It doesn't silently round, overflow, or underflow; --- rather, the library will notify you if these things happen. --- --- Many functions in this module clash with Prelude names, so you --- might want to do --- --- > import qualified Data.Deka.Quad as Q -module Data.Deka.Quad - ( - -- * Quad - Quad - - -- * Rounding - -- | For more on the rounding algorithms, see - -- - -- - , Round - , roundCeiling - , roundUp - , roundHalfUp - , roundHalfEven - , roundHalfDown - , roundDown - , roundFloor - , round05Up - - -- * Flags - -- - -- | For more on possible flags, see - -- - -- - , Flag - , divisionUndefined - , divisionByZero - , divisionImpossible - , invalidOperation - , inexact - , underflow - , overflow - , conversionSyntax - - , Flags - , unFlags - , setFlag - , clearFlag - , checkFlag - , emptyFlags - - -- * Ctx monad - , Ctx - , getStatus - , setStatus - , mapStatus - , getRound - , setRound - , runCtx - , evalCtx - - -- * Class - , DecClass - , sNan - , qNan - , negInf - , negNormal - , negSubnormal - , negZero - , posZero - , posSubnormal - , posNormal - , posInf - , decClass - - -- * Converting to and from strings - , fromByteString - , toByteString - , toEngByteString - - -- * Converting to and from integers - , C'int32_t - , C'uint32_t - , fromInt32 - , fromUInt32 - , toInt32 - , toInt32Exact - , toUInt32 - , toUInt32Exact - - -- * Arithmetic - , add - , subtract - , multiply - , fma - , divide - , divideInteger - , remainder - , remainderNear - - -- * Exponent and coefficient adjustment - , quantize - , reduce - - -- * Comparisons - , compare - , compareOrd - , compareSignal - , compareTotal - , compareTotalMag - , max - , maxMag - , min - , minMag - , sameQuantum - - -- * Tests - , isFinite - , isInfinite - , isInteger - , isLogical - , isNaN - , isNegative - , isNormal - , isPositive - , isSignaling - , isSigned - , isSubnormal - , isZero - - -- * Signs - , plus - , minus - , abs - , copySign - - -- * Increment and decrement - , nextMinus - , nextPlus - , nextToward - - -- * Digit-wise - , and - , or - , xor - , invert - , shift - , rotate - - -- * log and scale - , logB - , scaleB - - -- * Attributes - , digits - - -- * Integral rounding - - -- | If you want to round but not to an integral value (e.g. round - -- to two decimal places), see 'quantize'. - , toIntegralExact - , toIntegralValue - - -- * Constants - , zero - , one - , version - - -- * Complete encoding and decoding - - -- | These convert a 'Quad' to a 'Decoded', which is a pure - -- Haskell type containing all the information in the 'Quad'. - - -- ** Digits - , Digit(..) - , digitToInt - , intToDigit - , digitToChar - , digitsToInteger - , integralToDigits - - -- ** Coefficients - , coefficientLen - , payloadLen - , Coefficient - , coefficient - , unCoefficient - , zeroCoefficient - , oneCoefficient - , Payload - , payload - , unPayload - , zeroPayload - - -- ** Exponents - , Exponent - , exponent - , unExponent - , zeroExponent - , minMaxExp - , AdjustedExp - , adjustedExp - , unAdjustedExp - , minNormalAdj - , minNormalExp - , adjustedToExponent - - -- ** Sign, NaN, Value, Decoded - , Sign(..) - , NaN(..) - , Value(..) - , Decoded(..) - - --- ** Conversion functions - , fromBCD - , toBCD - , scientific - , ordinary - , decodedToRational - - -- ** Decoded predicates - - -- *** Duplicates of Quad tests that return Bool - -- | These duplicate the tests that are available for the Quad - -- type directly. - , dIsFinite - , dIsInfinite - , dIsInteger - , dIsLogical - , dIsNaN - , dIsNegative - , dIsNormal - , dIsPositive - , dIsSignaling - , dIsSigned - , dIsSubnormal - , dIsZero - , dDigits - - -- *** Duplicates of Quad tests that return 'DecClass' - , dIsSNaN - , dIsQNaN - , dIsNegInf - , dIsNegNormal - , dIsNegSubnormal - , dIsNegZero - , dIsPosZero - , dIsPosSubnormal - , dIsPosNormal - , dIsPosInf - - ) where - --- # Imports - -import Control.Exception -import Control.Monad -import qualified Data.ByteString.Char8 as BS8 -import Data.Maybe -import Data.Ratio -import Data.Typeable -import Foreign.Safe hiding - ( void - , isSigned - , rotate - , shift - , xor - ) -import Prelude hiding - ( abs - , and - , compare - , isInfinite - , isNaN - , max - , min - , or - , subtract - , significand - , exponent - ) -import qualified Prelude -import System.IO.Unsafe (unsafePerformIO) - -import Data.Deka.Decnumber -import Data.Deka.Internal - --- # Rounding - -newtype Round = Round { unRound :: C'rounding } - deriving (Eq, Ord) - -instance Show Round where - show (Round r) - | r == c'DEC_ROUND_CEILING = "roundCeiling" - | r == c'DEC_ROUND_UP = "roundUp" - | r == c'DEC_ROUND_HALF_UP = "roundHalfUp" - | r == c'DEC_ROUND_HALF_EVEN = "roundHalfEven" - | r == c'DEC_ROUND_HALF_DOWN = "roundHalfDown" - | r == c'DEC_ROUND_DOWN = "roundDown" - | r == c'DEC_ROUND_FLOOR = "roundFloor" - | r == c'DEC_ROUND_05UP = "round05Up" - | otherwise = error "Deka.Quad.Round.show: unrecognized rounding" - --- | Round toward positive infinity. -roundCeiling :: Round -roundCeiling = Round c'DEC_ROUND_CEILING - --- | Round away from zero. -roundUp :: Round -roundUp = Round c'DEC_ROUND_UP - --- | @0.5@ rounds up -roundHalfUp :: Round -roundHalfUp = Round c'DEC_ROUND_HALF_UP - --- | @0.5@ rounds to nearest even -roundHalfEven :: Round -roundHalfEven = Round c'DEC_ROUND_HALF_EVEN - --- | @0.5@ rounds down -roundHalfDown :: Round -roundHalfDown = Round c'DEC_ROUND_HALF_DOWN - --- | Round toward zero - truncate -roundDown :: Round -roundDown = Round c'DEC_ROUND_DOWN - --- | Round toward negative infinity. -roundFloor :: Round -roundFloor = Round c'DEC_ROUND_FLOOR - --- | Round for reround -round05Up :: Round -round05Up = Round c'DEC_ROUND_05UP - --- # Status - --- | A single error or warning condition that may be set in the --- 'Ctx'. -newtype Flag = Flag C'uint32_t - deriving (Eq, Ord) - -instance Show Flag where - show (Flag f) - | f == c'DEC_Division_undefined = "disivionUndefined" - | f == c'DEC_Division_by_zero = "divisionByZero" - | f == c'DEC_Division_impossible = "divisionImpossible" - | f == c'DEC_Inexact = "inexact" - | f == c'DEC_Invalid_operation = "invalidOperation" - | f == c'DEC_Underflow = "underflow" - | f == c'DEC_Overflow = "overflow" - | f == c'DEC_Conversion_syntax = "conversionSyntax" - | otherwise = error "Deka.Quad: show flag: unrecogized flag" - --- Docs are a bit unclear about what status flags can actually be --- set; the source code reveals that these can be set. - --- | @0/0@ is undefined. It sets this flag and returns a quiet NaN. -divisionUndefined :: Flag -divisionUndefined = Flag c'DEC_Division_undefined - --- | A non-zero dividend is divided by zero. Unlike @0/0@, it has a --- defined result (a signed Infinity). -divisionByZero :: Flag -divisionByZero = Flag c'DEC_Division_by_zero - --- | Sometimes raised by 'divideInteger' and 'remainder'. -divisionImpossible :: Flag -divisionImpossible = Flag c'DEC_Division_impossible - --- | Raised on a variety of invalid operations, such as an attempt --- to use 'compareSignal' on an operand that is an NaN. -invalidOperation :: Flag -invalidOperation = Flag c'DEC_Invalid_operation - --- | One or more non-zero coefficient digits were discarded during --- rounding. -inexact :: Flag -inexact = Flag c'DEC_Inexact - --- | A result is both subnormal and inexact. -underflow :: Flag -underflow = Flag c'DEC_Underflow - --- | The exponent of a result is too large to be represented. -overflow :: Flag -overflow = Flag c'DEC_Overflow - --- | A source string (for instance, in 'fromByteString') contained --- errors. -conversionSyntax :: Flag -conversionSyntax = Flag c'DEC_Conversion_syntax - --- Invalid Context is not recreated here; it should never happen - --- | A container for multiple 'Flag' indicating which are set and --- which are not. An instance of 'Exception' so you can throw it if --- you want (no functions in this module throw.) -newtype Flags = Flags C'uint32_t - deriving (Eq, Ord, Typeable) - -instance Exception Flags - -unFlags :: Flags -> [Flag] -unFlags fs = mapMaybe getFlag allFlags - where - getFlag fl = if checkFlag fl fs then Just fl else Nothing - allFlags = [ divisionUndefined, divisionByZero, - divisionImpossible, invalidOperation, inexact, underflow, - overflow, conversionSyntax] - --- | Show gives you a comma-separated list of flags that are set, or --- an empty string if no flags are set. -instance Show Flags where - show = show . unFlags - -setFlag :: Flag -> Flags -> Flags -setFlag (Flag f1) (Flags fA) = Flags (f1 .|. fA) - -clearFlag :: Flag -> Flags -> Flags -clearFlag (Flag f1) (Flags fA) = Flags (complement f1 .&. fA) - --- | Is this 'Flag' set? -checkFlag :: Flag -> Flags -> Bool -checkFlag (Flag f1) (Flags fA) = (f1 .&. fA) /= 0 - --- | A 'Flags' with no 'Flag' set. -emptyFlags :: Flags -emptyFlags = Flags 0 - --- | The current status flags, which indicate results from previous --- computations. -getStatus :: Ctx Flags -getStatus = Ctx $ \cPtr -> do - let pSt = p'decContext'status cPtr - fmap Flags . peek $ pSt - --- | Set the current status to whatever you wish. -setStatus :: Flags -> Ctx () -setStatus (Flags f) = Ctx $ \cPtr -> do - let pSt = p'decContext'status cPtr - poke pSt f - -mapStatus :: (Flags -> Flags) -> Ctx () -mapStatus f = do - st <- getStatus - let st' = f st - setStatus st' - --- | The current rounding method -getRound :: Ctx Round -getRound = Ctx $ \cPtr -> do - let pR = p'decContext'round cPtr - fmap Round . peek $ pR - --- | Change the current rounding method -setRound :: Round -> Ctx () -setRound r = Ctx $ \cPtr -> do - let pR = p'decContext'round cPtr - poke pR . unRound $ r - --- | By default, rounding is set to 'roundHalfEven'. No status flags are set --- initially. Returns the final status flags along with the result --- of the computation. -runCtx :: Ctx a -> (a, Flags) -runCtx (Ctx k) = unsafePerformIO $ do - fp <- mallocForeignPtr - withForeignPtr fp $ \pCtx -> do - _ <- unsafe'c'decContextDefault pCtx c'DEC_INIT_DECQUAD - res <- k pCtx - fl' <- fmap Flags . peek . p'decContext'status $ pCtx - return (res, fl') - --- | Like 'runCtx' but does not return the final flags. -evalCtx :: Ctx a -> a -evalCtx (Ctx k) = unsafePerformIO $ do - fp <- mallocForeignPtr - withForeignPtr fp $ \pCtx -> do - _ <- unsafe'c'decContextDefault pCtx c'DEC_INIT_DECQUAD - k pCtx - - --- # Class - --- | Different categories of 'Quad'. -newtype DecClass = DecClass C'decClass - deriving (Eq, Ord) - --- | Signaling NaN -sNan :: DecClass -sNan = DecClass c'DEC_CLASS_SNAN - --- | Quiet NaN -qNan :: DecClass -qNan = DecClass c'DEC_CLASS_QNAN - --- | Negative infinity -negInf :: DecClass -negInf = DecClass c'DEC_CLASS_NEG_INF - --- | Negative normal number -negNormal :: DecClass -negNormal = DecClass c'DEC_CLASS_NEG_NORMAL - --- | Negative subnormal number -negSubnormal :: DecClass -negSubnormal = DecClass c'DEC_CLASS_NEG_SUBNORMAL - --- | The negative zero -negZero :: DecClass -negZero = DecClass c'DEC_CLASS_NEG_ZERO - --- | The positive zero -posZero :: DecClass -posZero = DecClass c'DEC_CLASS_POS_ZERO - --- | A positive subnormal number -posSubnormal :: DecClass -posSubnormal = DecClass c'DEC_CLASS_POS_SUBNORMAL - --- | A positive normal number -posNormal :: DecClass -posNormal = DecClass c'DEC_CLASS_POS_NORMAL - --- | Positive infinity -posInf :: DecClass -posInf = DecClass c'DEC_CLASS_POS_INF - -instance Show DecClass where - show (DecClass x) - | x == c'DEC_CLASS_SNAN = "sNaN" - | x == c'DEC_CLASS_QNAN = "NaN" - | x == c'DEC_CLASS_NEG_INF = "-Infinity" - | x == c'DEC_CLASS_NEG_NORMAL = "-Normal" - | x == c'DEC_CLASS_NEG_SUBNORMAL = "-Subnormal" - | x == c'DEC_CLASS_NEG_ZERO = "-Zero" - | x == c'DEC_CLASS_POS_ZERO = "+Zero" - | x == c'DEC_CLASS_POS_SUBNORMAL = "+Subnormal" - | x == c'DEC_CLASS_POS_NORMAL = "+Normal" - | x == c'DEC_CLASS_POS_INF = "+Infinity" - | otherwise = error "decClass show: invalid value" - - --- # Helpers. Do not export these. - -type Unary - = Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -unary - :: Unary - -> Quad - -> Ctx Quad -unary f d = Ctx $ \ptrC -> - newQuad >>= \r -> - withForeignPtr (unQuad d) $ \ptrX -> - withForeignPtr (unQuad r) $ \ptrR -> - f ptrR ptrX ptrC >> - return r - -type Binary - = Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -binary - :: Binary - -> Quad - -> Quad - -> Ctx Quad -binary f x y = Ctx $ \pC -> - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - withForeignPtr (unQuad x) $ \pX -> - withForeignPtr (unQuad y) $ \pY -> - f pR pX pY pC >> - return r - -type UnaryGet a - = Ptr C'decQuad - -> IO a - -unaryGet - :: UnaryGet a - -> Quad - -> a -unaryGet f d = unsafePerformIO $ - withForeignPtr (unQuad d) $ \pD -> f pD - -type Ternary - = Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decQuad - -> Ptr C'decContext - -> IO (Ptr C'decQuad) - -ternary - :: Ternary - -> Quad - -> Quad - -> Quad - -> Ctx Quad -ternary f x y z = Ctx $ \pC -> - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - withForeignPtr (unQuad x) $ \pX -> - withForeignPtr (unQuad y) $ \pY -> - withForeignPtr (unQuad z) $ \pZ -> - f pR pX pY pZ pC - >> return r - --- MkString and mkString - moved to Internal so that toByteString --- can use them - -type GetRounded a - = Ptr C'decQuad - -> Ptr C'decContext - -> C'rounding - -> IO a - -getRounded - :: GetRounded a - -> Round - -> Quad - -> Ctx a -getRounded f (Round r) d = Ctx $ \pC -> - withForeignPtr (unQuad d) $ \pD -> - f pD pC r - --- # End Helpers - --- # Functions from decQuad. In alphabetical order. - --- | Absolute value. NaNs are handled normally (the sign of an NaN --- is not affected, and an sNaN sets 'invalidOperation'. -abs :: Quad -> Ctx Quad -abs = unary unsafe'c'decQuadAbs - -add :: Quad -> Quad -> Ctx Quad -add = binary unsafe'c'decQuadAdd - --- | Digit-wise logical and. Operands must be: --- --- * zero or positive --- --- * integers --- --- * comprise only zeroes and/or ones --- --- If not, 'invalidOperation' is set. -and :: Quad -> Quad -> Ctx Quad -and = binary unsafe'c'decQuadAnd - --- | More information about a particular 'Quad'. -decClass :: Quad -> DecClass -decClass = DecClass . unaryGet unsafe'c'decQuadClass - --- | Compares two 'Quad' numerically. The result might be @-1@, @0@, --- @1@, or NaN, where @-1@ means x is less than y, @0@ indicates --- numerical equality, @1@ means y is greater than x. NaN is --- returned only if x or y is an NaN. --- --- Thus, this function does not return an 'Ordering' because the --- result might be an NaN. --- -compare :: Quad -> Quad -> Ctx Quad -compare = binary unsafe'c'decQuadCompare - --- | Wrapper for 'compare' that returns an 'Ordering' rather than a --- 'Quad'. Returns @Just LT@ rather than -1, @Just EQ@ rather than --- 0, and @Just GT@ rather than 1, and @Nothing@ rather than NaN. --- This is a pure function; it does not affect the 'Ctx'. - -compareOrd :: Quad -> Quad -> Maybe Ordering -compareOrd x y = evalCtx $ do - c <- compare x y - let r | isNaN c = Nothing - | isNegative c = Just LT - | isZero c = Just EQ - | isPositive c = Just GT - | otherwise = error "compareOrd: unknown result" - return r - --- | Same as 'compare', but a quietNaN is treated like a signaling --- NaN (sets 'invalidOperation'). -compareSignal :: Quad -> Quad -> Ctx Quad -compareSignal = binary unsafe'c'decQuadCompareSignal - --- | Same as 'compareTotal' but compares the absolute value of the --- two arguments. -compareTotalMag :: Quad -> Quad -> Ordering -compareTotalMag x y = - let c = binaryCtxFree unsafe'c'decQuadCompareTotalMag x y - r | isNegative c = LT - | isZero c = EQ - | isPositive c = GT - | otherwise = error "compareTotalMag: unknown result" - in r - - --- decNumber's CopySign copies the contents from pS to PN, except --- that the sign is copied from pP to pN - --- | @copySign x y@ returns @z@, which is a copy of @x@ but has the --- sign of @y@. This function never raises any signals. -copySign :: Quad -> Quad -> Quad -copySign s p = unsafePerformIO $ - newQuad >>= \n -> - withForeignPtr (unQuad n) $ \pN -> - withForeignPtr (unQuad s) $ \pS -> - withForeignPtr (unQuad p) $ \pP -> - unsafe'c'decQuadCopySign pN pS pP >> - return n - --- | Number of significant digits. If zero or infinite, returns 1. --- If NaN, returns number of digits in the payload. -digits :: Quad -> Int -digits = fromIntegral . unaryGet unsafe'c'decQuadDigits - -divide :: Quad -> Quad -> Ctx Quad -divide = binary unsafe'c'decQuadDivide - --- | @divideInteger x y@ returns the integer part of the result --- (rounded toward zero), with an exponent of 0. If the the result --- would not fit because it has too many digits, --- 'divisionImpossible' is set. -divideInteger :: Quad -> Quad -> Ctx Quad -divideInteger = binary unsafe'c'decQuadDivideInteger - --- | Fused multiply add; @fma x y z@ calculates @x * y + z@. The --- multiply is carried out first and is exact, so the result has --- only one final rounding. -fma :: Quad -> Quad -> Quad -> Ctx Quad -fma = ternary unsafe'c'decQuadFMA - -fromInt32 :: C'int32_t -> Quad -fromInt32 i = unsafePerformIO $ - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - unsafe'c'decQuadFromInt32 pR i - >> return r - --- | Reads a ByteString, which can be in scientific, engineering, or --- \"regular\" decimal notation. Also reads NaN, Infinity, etc. --- Will return a signaling NaN and set 'invalidOperation' if the --- string given is invalid. --- --- In the decNumber C library, this function was called --- @fromString@; the name was changed here because it doesn't take a --- regular Haskell 'String'. -fromByteString :: BS8.ByteString -> Ctx Quad -fromByteString s = Ctx $ \pC -> - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - BS8.useAsCString s $ \pS -> - unsafe'c'decQuadFromString pR pS pC >> - return r - -fromUInt32 :: C'uint32_t -> Quad -fromUInt32 i = unsafePerformIO $ - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - unsafe'c'decQuadFromUInt32 pR i >> - return r - --- | Digit-wise logical inversion. The operand must be: --- --- * zero or positive --- --- * integers --- --- * comprise only zeroes and/or ones --- --- If not, 'invalidOperation' is set. -invert :: Quad -> Ctx Quad -invert = unary unsafe'c'decQuadInvert - --- | True if @x@ is neither infinite nor a NaN. -isFinite :: Quad -> Bool -isFinite = boolean unsafe'c'decQuadIsFinite - --- | True for infinities. -isInfinite :: Quad -> Bool -isInfinite = boolean unsafe'c'decQuadIsInfinite - --- | True if @x@ is finite and has exponent of @0@; False otherwise. --- This tests the exponent, not the /adjusted/ exponent. This can --- lead to results you may not expect: --- --- >>> isInteger . evalCtx . fromByteString . pack $ "3.00e2" --- True --- --- >>> isInteger . evalCtx . fromByteString . pack $ "3e2" --- False --- --- >>> isInteger . evalCtx . fromByteString . pack $ "3.00e0" --- False -isInteger :: Quad -> Bool -isInteger = boolean unsafe'c'decQuadIsInteger - --- | True only if @x@ is zero or positive, an integer (finite with --- exponent of 0), and the coefficient is only zeroes and/or ones. -isLogical :: Quad -> Bool -isLogical = boolean unsafe'c'decQuadIsLogical - --- | True for NaNs. -isNaN :: Quad -> Bool -isNaN = boolean unsafe'c'decQuadIsNaN - --- | True only if @x@ is finite, non-zero, and not subnormal. -isNormal :: Quad -> Bool -isNormal = boolean unsafe'c'decQuadIsNormal - --- | True only if @x@ is a signaling NaN. -isSignaling :: Quad -> Bool -isSignaling = boolean unsafe'c'decQuadIsSignaling - --- | True only if @x@ has a sign of 1. Note that zeroes and NaNs --- may have sign of 1. -isSigned :: Quad -> Bool -isSigned = boolean unsafe'c'decQuadIsSigned - --- | True only if @x@ is subnormal - that is, finite, non-zero, and --- with a magnitude less than 10 ^ emin. -isSubnormal :: Quad -> Bool -isSubnormal = boolean unsafe'c'decQuadIsSubnormal - --- | @logB x@ Returns the adjusted exponent of x, according to IEEE --- 754 rules. If @x@ is infinite, returns +Infinity. If @x@ is --- zero, the result is -Infinity, and 'divisionByZero' is set. If --- @x@ is less than zero, the absolute value of @x@ is used. If @x@ --- is one, the result is 0. NaNs are propagated as for arithmetic --- operations. -logB :: Quad -> Ctx Quad -logB = unary unsafe'c'decQuadLogB - --- | @max x y@ returns the larger argument; if either (but not both) --- @x@ or @y@ is a quiet NaN then the other argument is the result; --- otherwise, NaNs, are handled as for arithmetic operations. -max :: Quad -> Quad -> Ctx Quad -max = binary unsafe'c'decQuadMax - --- | Like 'max' but the absolute values of the arguments are used. -maxMag :: Quad -> Quad -> Ctx Quad -maxMag = binary unsafe'c'decQuadMaxMag - --- | @min x y@ returns the smaller argument; if either (but not both) --- @x@ or @y@ is a quiet NaN then the other argument is the result; --- otherwise, NaNs, are handled as for arithmetic operations. -min :: Quad -> Quad -> Ctx Quad -min = binary unsafe'c'decQuadMin - --- | Like 'min' but the absolute values of the arguments are used. -minMag :: Quad -> Quad -> Ctx Quad -minMag = binary unsafe'c'decQuadMinMag - --- | Negation. Result has the same effect as @0 - x@ when the --- exponent of the zero is the same as that of @x@, if @x@ is --- finite. -minus :: Quad -> Ctx Quad -minus = unary unsafe'c'decQuadMinus - -multiply :: Quad -> Quad -> Ctx Quad -multiply = binary unsafe'c'decQuadMultiply - --- | Decrements toward negative infinity. -nextMinus :: Quad -> Ctx Quad -nextMinus = unary unsafe'c'decQuadNextMinus - --- | Increments toward positive infinity. -nextPlus :: Quad -> Ctx Quad -nextPlus = unary unsafe'c'decQuadNextPlus - --- | @nextToward x y@ returns the next 'Quad' in the direction of --- @y@. -nextToward :: Quad -> Quad -> Ctx Quad -nextToward = binary unsafe'c'decQuadNextToward - --- | Digit wise logical inclusive Or. Operands must be: --- --- * zero or positive --- --- * integers --- --- * comprise only zeroes and/or ones --- --- If not, 'invalidOperation' is set. -or :: Quad -> Quad -> Ctx Quad -or = binary unsafe'c'decQuadOr - --- | Same effect as @0 + x@ where the exponent of the zero is the --- same as that of @x@ if @x@ is finite). NaNs are handled as for --- arithmetic operations. -plus :: Quad -> Ctx Quad -plus = unary unsafe'c'decQuadPlus - --- | @quantize x y@ returns @z@ which is @x@ set to have the same --- quantum as @y@; that is, numerically the same value but rounded --- or padded if necessary to have the same exponent as @y@. Useful --- for rounding monetary quantities. -quantize :: Quad -> Quad -> Ctx Quad -quantize = binary unsafe'c'decQuadQuantize - --- | Reduces coefficient to its shortest possible form without --- changing the value of the result by removing all possible --- trailing zeroes. -reduce :: Quad -> Ctx Quad -reduce = unary unsafe'c'decQuadReduce - --- | Remainder from integer division. If the intermediate integer --- does not fit within a Quad, 'divisionImpossible' is raised. -remainder :: Quad -> Quad -> Ctx Quad -remainder = binary unsafe'c'decQuadRemainder - --- | Like 'remainder' but the nearest integer is used for for the --- intermediate result instead of the result from 'divideInteger'. -remainderNear :: Quad -> Quad -> Ctx Quad -remainderNear = binary unsafe'c'decQuadRemainderNear - --- | @rotate x y@ rotates the digits of x to the left (if @y@ is --- positive) or right (if @y@ is negative) without adjusting the --- exponent or sign of @x@. @y@ is the number of positions to --- rotate and must be in the range @negate 'coefficientLen'@ to --- @'coefficentLen'@. --- --- NaNs are propagated as usual. No status is set unless @y@ is --- invalid or an operand is an NaN. -rotate :: Quad -> Quad -> Ctx Quad -rotate = binary unsafe'c'decQuadRotate - --- | True only if both operands have the same exponent or are both --- NaNs (quiet or signaling) or both infinite. -sameQuantum :: Quad -> Quad -> Bool -sameQuantum x y = unsafePerformIO $ - withForeignPtr (unQuad x) $ \pX -> - withForeignPtr (unQuad y) $ \pY -> - unsafe'c'decQuadSameQuantum pX pY >>= \r -> - return $ case r of - 1 -> True - 0 -> False - _ -> error "sameQuantum: error: invalid result" - --- | @scaleB x y@ calculates @x * 10 ^ y@. @y@ must be an integer --- (finite with exponent of 0) in the range of plus or minus @2 * --- 'coefficientLen' + 'coefficientLen')@, typically resulting from --- 'logB'. Underflow and overflow might occur; NaNs propagate as --- usual. -scaleB :: Quad -> Quad -> Ctx Quad -scaleB = binary unsafe'c'decQuadScaleB - --- | @shift x y@ shifts digits the digits of x to the left (if @y@ --- is positive) or right (if @y@ is negative) without adjusting the --- exponent or sign of @x@. Any digits shifted in from the left or --- right will be 0. --- --- @y@ is a count of positions to shift; it must be a finite --- integer in the range @negate 'coefficientLen'@ to --- 'coefficientLen'. NaNs propagate as usual. If @x@ is infinite --- the result is an infinity of the same sign. No status is set --- unless y is invalid or the operand is an NaN. -shift :: Quad -> Quad -> Ctx Quad -shift = binary unsafe'c'decQuadShift - --- omitted: Show - -subtract :: Quad -> Quad -> Ctx Quad -subtract = binary unsafe'c'decQuadSubtract - --- | Returns a string in engineering notation. --- --- In the decNumber C library, this is called @toEngString@; the --- name is changed here because the function does not return a --- regular Haskell 'String'. -toEngByteString :: Quad -> BS8.ByteString -toEngByteString = mkString unsafe'c'decQuadToEngString - --- | Uses the rounding method given rather than the one in the --- 'Ctx'. If the operand is infinite, an NaN, or if the result of --- rounding is outside the range of a 'C'int32_t', then --- 'invalidOperation' is set. 'inexact' is not set even if rounding --- occurred. -toInt32 :: Round -> Quad -> Ctx C'int32_t -toInt32 = getRounded unsafe'c'decQuadToInt32 - --- | Like 'toInt32' but if rounding removes non-zero digits then --- 'inexact' is set. -toInt32Exact :: Round -> Quad -> Ctx C'int32_t -toInt32Exact = getRounded unsafe'c'decQuadToInt32Exact - --- | Rounds to an integral using the rounding mode set in the 'Ctx'. --- If the operand is infinite, an infinity of the same sign is --- returned. If the operand is an NaN, the result is the same as --- for other arithmetic operations. If rounding removes non-zero --- digits then 'inexact' is set. -toIntegralExact :: Quad -> Ctx Quad -toIntegralExact = unary unsafe'c'decQuadToIntegralExact - --- | @toIntegralValue r x@ returns an integral value of @x@ using --- the rounding mode @r@ rather than the one specified in the 'Ctx'. --- If the operand is an NaN, the result is the same as for other --- arithmetic operations. 'inexact' is not set even if rounding --- occurred. -toIntegralValue :: Round -> Quad -> Ctx Quad -toIntegralValue (Round rnd) d = Ctx $ \pC -> - withForeignPtr (unQuad d) $ \pD -> - newQuad >>= \r -> - withForeignPtr (unQuad r) $ \pR -> - unsafe'c'decQuadToIntegralValue pR pD pC rnd >> - return r - --- toByteString - moved to Internal so that Quad can Show in a --- non-orphan instance - --- | @toUInt32 r x@ returns the value of @x@, rounded to an integer --- if necessary using the rounding mode @r@ rather than the one --- given in the 'Ctx'. If @x@ is infinite, or outside of the range --- of a 'C'uint32_t', then 'invalidOperation' is set. 'inexact' is --- not set even if rounding occurs. --- --- The negative zero converts to 0 and is valid, but negative --- numbers are not valid. -toUInt32 :: Round -> Quad -> Ctx C'uint32_t -toUInt32 = getRounded unsafe'c'decQuadToUInt32 - --- | Same as 'toUInt32' but if rounding removes non-zero digits then --- 'inexact' is set. -toUInt32Exact :: Round -> Quad -> Ctx C'uint32_t -toUInt32Exact = getRounded unsafe'c'decQuadToUInt32Exact - --- | Identifies the version of the decNumber C library. -version :: BS8.ByteString -version = unsafePerformIO $ - unsafe'c'decQuadVersion >>= BS8.packCString - --- | Digit-wise logical exclusive or. Operands must be: --- --- * zero or positive --- --- * integers --- --- * comprise only zeroes and/or ones --- --- If not, 'invalidOperation' is set. - -xor :: Quad -> Quad -> Ctx Quad -xor = binary unsafe'c'decQuadXor - --- | A Quad whose coefficient, exponent, and sign are all 0. -zero :: Quad -zero = unsafePerformIO $ - newQuad >>= \d -> - withForeignPtr (unQuad d) $ \pD -> - unsafe'c'decQuadZero pD >> - return d - --- | A Quad with coefficient 'D1', exponent 0, and sign 'Sign0'. -one :: Quad -one = fromBCD - $ Decoded Sign0 (Finite (Coefficient [D1]) (Exponent 0)) - --- # Conversions - -data Sign - = Sign0 - -- ^ The number is positive or is zero - | Sign1 - -- ^ The number is negative or the negative zero - deriving (Eq, Ord, Show, Enum, Bounded) - -data NaN - = Quiet - | Signaling - deriving (Eq, Ord, Show, Enum, Bounded) - --- Decimal Arithmetic Specification version 1.70, page 10, says that --- the minimum and maximum adjusted exponent is given by --- --- @-x - (c - 1) + 1@ and @x - (c - 1)@ --- --- where @x@ the upper limit on the absolute value of exponent, and --- @c@ is the length of the coefficient in decimal digits. --- --- However, the lower bound of the above formula only accounts for --- normal numbers. When subnormal numbers are enabled (as they are --- here), the lower bound on exponents is --- --- @m - (p - 1)@ --- --- where @m@ is the smallest possible adjusted exponent for normal --- numbers (called Emin), and p is the working precision. --- --- Also, the upper bound is different too, becuase decQuad is --- clamped; see decNumber manual, page 23. This means the maximum --- exponent is limited to --- --- @t - (p - 1)@ --- --- where @t@ is the maximum possible adjusted exponent and p is the --- working precision. --- --- The function below uses the minimum and maximum accounting for --- the clamp and the subnormals. - --- | The minimum and maximum possible exponent. -minMaxExp :: (Int, Int) -minMaxExp = (l, h) - where - l = c'DECQUAD_Emin - c'DECQUAD_Pmax + 1 - h = c'DECQUAD_Emax - c'DECQUAD_Pmax + 1 - --- | The smallest possible adjusted exponent that is still normal. --- Adjusted exponents smaller than this are subnormal. -minNormalAdj :: AdjustedExp -minNormalAdj = AdjustedExp c'DECQUAD_Emin - --- | Like 'minNormalAdj', but returns the size of the regular exponent --- rather than the adjusted exponent. -minNormalExp :: Coefficient -> Exponent -minNormalExp c = adjustedToExponent c $ minNormalAdj - --- | The signed integer which indicates the power of ten by which --- the coefficient is multiplied. -newtype Exponent = Exponent { unExponent :: Int } - deriving (Eq, Ord, Show) - -instance Bounded Exponent where - minBound = Exponent . fst $ minMaxExp - maxBound = Exponent . snd $ minMaxExp - -instance Enum Exponent where - toEnum i - | r < minBound = error e - | r > maxBound = error e - | otherwise = r - where - r = Exponent i - e = "Deka.Exponent.toEnum: integer out of range" - - fromEnum (Exponent i) = i - --- | Ensures that the exponent is within the range allowed by --- 'minMaxExp'. -exponent :: Int -> Maybe Exponent -exponent i - | i < l = Nothing - | i > h = Nothing - | otherwise = Just . Exponent $ i - where - (l, h) = minMaxExp - --- | An Exponent whose value is 0. -zeroExponent :: Exponent -zeroExponent = Exponent 0 - -data Value - = Finite Coefficient Exponent - | Infinite - | NaN NaN Payload - deriving (Eq, Ord, Show) - --- | A pure Haskell type which holds information identical to that --- in a 'Quad'. -data Decoded = Decoded - { dSign :: Sign - , dValue :: Value - } deriving (Eq, Ord, Show) - - --- | Decodes a 'Quad' to a pure Haskell type which holds identical --- information. -toBCD :: Quad -> Decoded -toBCD d = unsafePerformIO $ - withForeignPtr (unQuad d) $ \pD -> - allocaBytes c'DECQUAD_Pmax $ \pArr -> - alloca $ \pExp -> - unsafe'c'decQuadToBCD pD pExp pArr >>= \sgn -> - peek pExp >>= \ex -> - peekArray c'DECQUAD_Pmax pArr >>= \coef -> - return (getDecoded sgn ex coef) - --- | Encodes a new 'Quad'. -fromBCD :: Decoded -> Quad -fromBCD dcd = unsafePerformIO $ - newQuad >>= \d -> - withForeignPtr (unQuad d) $ \pD -> - let (expn, digs, sgn) = toDecNumberBCD dcd in - withArray digs $ \pArr -> - unsafe'c'decQuadFromBCD pD expn pArr sgn >> - return d - - --- ## Decoding and encoding helpers - -toDecNumberBCD :: Decoded -> (C'int32_t, [C'uint8_t], C'int32_t) -toDecNumberBCD (Decoded s v) = (e, ds, sgn) - where - sgn = case s of { Sign0 -> 0; Sign1 -> c'DECFLOAT_Sign } - (e, ds) = case v of - Infinite -> (c'DECFLOAT_Inf, replicate c'DECQUAD_Pmax 0) - NaN n (Payload ps) -> (ns, np) - where - ns = case n of - Quiet -> c'DECFLOAT_qNaN - Signaling -> c'DECFLOAT_sNaN - np = pad ++ map digitToInt ps - pad = replicate (c'DECQUAD_Pmax - length ps) 0 - Finite (Coefficient digs) (Exponent ex) -> - ( fromIntegral ex, pad ++ map digitToInt digs ) - where - pad = replicate (c'DECQUAD_Pmax - length digs) 0 - -getDecoded - :: C'int32_t - -- ^ Sign. Zero if sign is zero; non-zero if sign is not zero - -- (that is, is negavite.) - -> C'int32_t - -- ^ Exponent - -> [C'uint8_t] - -- ^ Coefficient - -> Decoded -getDecoded sgn ex coef = Decoded s v - where - s = if sgn == 0 then Sign0 else Sign1 - v | ex == c'DECFLOAT_qNaN = NaN Quiet pld - | ex == c'DECFLOAT_sNaN = NaN Signaling pld - | ex == c'DECFLOAT_Inf = Infinite - | otherwise = Finite coe (Exponent $ fromIntegral ex) - where - pld = Payload . toDigs . tail $ coef - coe = Coefficient . toDigs $ coef - toDigs c = case dropWhile (== D0) . map intToDigit $ c of - [] -> [D0] - xs -> xs - --- ## Decoded to scientific and ordinary notation - --- | Converts a Decoded to scientific notation. Unlike --- 'toByteString' this will always use scientific notation. For --- NaNs and infinities, the notation is identical to that of --- decNumber (see Decimal Arithmetic Specification page 19). This --- means that a quiet NaN is @NaN@ while a signaling NaN is @sNaN@, --- and infinity is @Infinity@. --- --- Like decQuadToString, the payload of an NaN is not shown if it is --- zero. - -scientific :: Decoded -> String -scientific d = sign ++ rest - where - sign = case dSign d of - Sign0 -> "" - Sign1 -> "-" - rest = case dValue d of - Infinite -> "Infinity" - Finite c e -> sciFinite c e - NaN n p -> sciNaN n p - -sciFinite :: Coefficient -> Exponent -> String -sciFinite c e = sCoe ++ 'E':sExp - where - sCoe = case unCoefficient c of - x:xs -> digitToChar x : case xs of - [] -> [] - _ -> '.' : map digitToChar xs - [] -> error "sciFinite: empty coefficient" - sExp = show . unAdjustedExp . adjustedExp c $ e - -sciNaN :: NaN -> Payload -> String -sciNaN n p = nStr ++ pStr - where - nStr = case n of { Quiet -> "NaN"; Signaling -> "sNaN" } - pStr = case unPayload p of - [D0] -> "" - xs -> map digitToChar xs - --- | Converts Decoded to ordinary decimal notation. For NaNs and --- infinities, the notation is identical to that of 'scientific'. --- Unlike 'scientific', though the result can always be converted back --- to a 'Quad' using 'fromByteString', the number of significant --- digits might change. For example, though @1.2E3@ has two --- significant digits, using @ordinary@ on this value and then --- reading it back in with @fromByteString@ will give you @1200E0@, --- which has four significant digits. - -ordinary :: Decoded -> String -ordinary d = sign ++ rest - where - sign = case dSign d of - Sign0 -> "" - Sign1 -> "-" - rest = case dValue d of - Infinite -> "Infinity" - Finite c e -> onyFinite c e - NaN n p -> sciNaN n p - -onyFinite :: Coefficient -> Exponent -> String -onyFinite c e - | coe == [D0] = "0" - | ex >= 0 = map digitToChar coe ++ replicate ex '0' - | aex < lCoe = - let (lft, rt) = splitAt (lCoe - aex) coe - in map digitToChar lft ++ "." ++ map digitToChar rt - | otherwise = - let numZeroes = aex - lCoe - in "0." ++ replicate numZeroes '0' ++ map digitToChar coe - where - ex = unExponent e - coe = unCoefficient c - aex = Prelude.abs ex - lCoe = length coe - --- | Converts a Decoded to a Rational. Returns Nothing if the --- Decoded is not finite. -decodedToRational :: Decoded -> Maybe Rational -decodedToRational d = case dValue d of - (Finite c e) -> - let int = digitsToInteger . unCoefficient $ c - ex = unExponent e - mkSgn = if dSign d == Sign0 then id else negate - mult = if ex < 0 then 1 % (10 ^ Prelude.abs ex) else 10 ^ ex - in Just . mkSgn $ fromIntegral int * mult - _ -> Nothing - --- ## Digits - --- | A single decimal digit. -data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 - deriving (Eq, Ord, Show, Enum, Bounded) - -digitToInt :: Integral a => Digit -> a -digitToInt d = case d of - { D0 -> 0; D1 -> 1; D2 -> 2; D3 -> 3; D4 -> 4; D5 -> 5; - D6 -> 6; D7 -> 7; D8 -> 8; D9 -> 9 } - -intToDigit :: Integral a => a -> Digit -intToDigit i = case i of - { 0 -> D0; 1 -> D1; 2 -> D2; 3 -> D3; 4 -> D4; - 5 -> D5; 6 -> D6; 7 -> D7; 8 -> D8; 9 -> D9; - _ -> error "intToDigit: integer out of range" } - -digitToChar :: Digit -> Char -digitToChar d = case d of - { D0 -> '0'; D1 -> '1'; D2 -> '2'; D3 -> '3'; D4 -> '4'; - D5 -> '5'; D6 -> '6'; D7 -> '7'; D8 -> '8'; D9 -> '9' } - - --- | A list of digits, less than or equal to 'coefficientLen' long. --- Corresponds only to finite numbers. -newtype Coefficient = Coefficient { unCoefficient :: [Digit] } - deriving (Eq, Ord, Show) - -instance Bounded Coefficient where - minBound = Coefficient [D0] - maxBound = Coefficient $ replicate coefficientLen D9 - -instance Enum Coefficient where - toEnum i - | i < 0 = error $ "Deka.Quad.Coefficient.toEnum: argument " - ++ "out of range; is negative" - | length r > coefficientLen = error $ "Deka.Quad.Coefficient." - ++ "toEnum: argument too large" - | otherwise = Coefficient r - where - r = integralToDigits i - - fromEnum i - | r > (fromIntegral (maxBound :: Int)) = - error $ "Deka.Quad.Coefficient.fromEnum:" - ++ " argument too large to fit into Int" - | otherwise = fromIntegral r - where - r = digitsToInteger . unCoefficient $ i - --- | Creates a 'Coefficient'. Checks to ensure it is not null and --- that it is not longer than 'coefficientLen' and that it does not --- have leading zeroes (if it is 0, a single 'D0' is allowed). -coefficient :: [Digit] -> Maybe Coefficient -coefficient ls - | null ls = Nothing - | length ls > 1 && head ls == D0 = Nothing - | length ls > coefficientLen = Nothing - | otherwise = Just . Coefficient $ ls - --- | Coefficient of 'D0' -zeroCoefficient :: Coefficient -zeroCoefficient = Coefficient [D0] - --- | Coefficient of 'D1' -oneCoefficient :: Coefficient -oneCoefficient = Coefficient [D1] - --- | A list of digits, less than or equal to 'payloadLen' --- long. Accompanies an NaN, potentially with diagnostic --- information (I do not know if decNumber actually makes use of --- this.) -newtype Payload = Payload { unPayload :: [Digit] } - deriving (Eq, Ord, Show) - -instance Bounded Payload where - minBound = Payload [D0] - maxBound = Payload $ replicate payloadLen D9 - -instance Enum Payload where - toEnum i - | i < 0 = error $ "Deka.Quad.Payload.toEnum: argument " - ++ "out of range; is negative" - | length r > payloadLen = error $ "Deka.Quad.Payload." - ++ "toEnum: argument too large" - | otherwise = Payload r - where - r = integralToDigits i - - fromEnum i - | r > (fromIntegral (maxBound :: Int)) = - error $ "Deka.Quad.Payload.fromEnum:" - ++ " argument too large to fit into Int" - | otherwise = fromIntegral r - where - r = digitsToInteger . unPayload $ i - --- | Creates a 'Payload'. Checks to ensure it is not null, not --- longer than 'payloadLen' and that it does not have leading zeroes --- (if it is 0, a single 'D0' is allowed). -payload :: [Digit] -> Maybe Payload -payload ds - | null ds = Nothing - | length ds > 1 && head ds == D0 = Nothing - | length ds > payloadLen = Nothing - | otherwise = Just . Payload $ ds - --- | Payload of [D0] -zeroPayload :: Payload -zeroPayload = Payload [D0] - - --- | The most significant digit is at the head of the list. -digitsToInteger :: [Digit] -> Integer -digitsToInteger ls = go (length ls - 1) 0 ls - where - go c t ds = case ds of - [] -> t - x:xs -> let m = digitToInt x * 10 ^ c - t' = m + t - c' = c - 1 - _types = c :: Int - in go c' t' xs - --- | The most significant digit is at --- the head of the list. Sign of number is not relevant. -integralToDigits :: Integral a => a -> [Digit] -integralToDigits = reverse . go . Prelude.abs - where - go i - | i == 0 = [] - | otherwise = - let (d, m) = i `divMod` 10 - in intToDigit m : go d - --- | Maximum number of digits in a coefficient. -coefficientLen :: Int -coefficientLen = c'DECQUAD_Pmax - --- | Maximum number of digits in a payload. -payloadLen :: Int -payloadLen = c'DECQUAD_Pmax - 1 - --- # Decoded predicates - -dIsFinite :: Decoded -> Bool -dIsFinite (Decoded _ v) = case v of - Finite _ _ -> True - _ -> False - -dIsInfinite :: Decoded -> Bool -dIsInfinite (Decoded _ v) = case v of - Infinite -> True - _ -> False - -dIsInteger :: Decoded -> Bool -dIsInteger (Decoded _ v) = case v of - Finite _ e -> unExponent e == 0 - _ -> False - --- | True only if @x@ is zero or positive, an integer (finite with --- exponent of 0), and the coefficient is only zeroes and/or ones. --- The sign must be Sign0 (that is, you cannot have a negative --- zero.) -dIsLogical :: Decoded -> Bool -dIsLogical (Decoded s v) = fromMaybe False $ do - guard $ s == Sign0 - (d, e) <- case v of - Finite ds ex -> return (ds, ex) - _ -> Nothing - guard $ e == zeroExponent - return - . all (\x -> x == D0 || x == D1) - . unCoefficient $ d - -dIsNaN :: Decoded -> Bool -dIsNaN (Decoded _ v) = case v of - NaN _ _ -> True - _ -> False - --- | True only if @x@ is less than zero and is not an NaN. It's not --- enough for the sign to be Sign1; the coefficient (if finite) must --- be greater than zero. -dIsNegative :: Decoded -> Bool -dIsNegative (Decoded s v) = fromMaybe False $ do - guard $ s == Sign1 - return $ case v of - Finite d _ -> any (/= D0) . unCoefficient $ d - Infinite -> True - _ -> False - -dIsNormal :: Decoded -> Bool -dIsNormal (Decoded _ v) = case v of - Finite d e - | adjustedExp d e < minNormalAdj -> False - | otherwise -> any (/= D0) . unCoefficient $ d - _ -> False - -dIsPositive :: Decoded -> Bool -dIsPositive (Decoded s v) - | s == Sign1 = False - | otherwise = case v of - Finite d _ -> any (/= D0) . unCoefficient $ d - Infinite -> True - _ -> False - -dIsSignaling :: Decoded -> Bool -dIsSignaling (Decoded _ v) = case v of - NaN Signaling _ -> True - _ -> False - - -dIsSigned :: Decoded -> Bool -dIsSigned (Decoded s _) = s == Sign1 - -dIsSubnormal :: Decoded -> Bool -dIsSubnormal (Decoded _ v) = case v of - Finite d e -> adjustedExp d e < minNormalAdj - _ -> False - --- | True for any zero (negative or positive zero). -dIsZero :: Decoded -> Bool -dIsZero (Decoded _ v) = case v of - Finite d _ -> all (== D0) . unCoefficient $ d - _ -> False - --- | The number of significant digits. Zero returns 1. -dDigits :: Coefficient -> Int -dDigits (Coefficient ds) = case dropWhile (== D0) ds of - [] -> 1 - rs -> length rs - --- | An adjusted exponent is the value of an exponent of a number --- when that number is expressed as though in scientific notation --- with one digit before any decimal point. This is the finite --- exponent + (number of significant digits - 1). -newtype AdjustedExp = AdjustedExp { unAdjustedExp :: Int } - deriving (Eq, Show, Ord) - -instance Bounded AdjustedExp where - minBound = AdjustedExp $ fst minMaxExp - maxBound = AdjustedExp $ snd minMaxExp + coefficientLen - 1 - -instance Enum AdjustedExp where - toEnum i - | r < minBound = error e - | r > maxBound = error e - | otherwise = r - where - r = AdjustedExp i - e = "Deka.AdjustedExp.toEnum: integer out of range" - - fromEnum (AdjustedExp i) = i - -adjustedExp :: Coefficient -> Exponent -> AdjustedExp -adjustedExp ds e = AdjustedExp $ unExponent e - + dDigits ds - 1 - -adjustedToExponent :: Coefficient -> AdjustedExp -> Exponent -adjustedToExponent ds e = Exponent $ unAdjustedExp e - - dDigits ds + 1 - --- # DecClass-like Decoded predicates - -dIsSNaN :: Decoded -> Bool -dIsSNaN d = case dValue d of - NaN n _ -> n == Signaling - _ -> False - -dIsQNaN :: Decoded -> Bool -dIsQNaN d = case dValue d of - NaN n _ -> n == Quiet - _ -> False - -dIsNegInf :: Decoded -> Bool -dIsNegInf d - | dSign d == Sign0 = False - | otherwise = dValue d == Infinite - -dIsNegNormal :: Decoded -> Bool -dIsNegNormal d - | dSign d == Sign0 = False - | otherwise = case dValue d of - Finite c e -> e >= minNormalExp c - _ -> False - -dIsNegSubnormal :: Decoded -> Bool -dIsNegSubnormal d - | dSign d == Sign0 = False - | otherwise = case dValue d of - Finite c e -> e < minNormalExp c - _ -> False - -dIsNegZero :: Decoded -> Bool -dIsNegZero d - | dSign d == Sign0 = False - | otherwise = case dValue d of - Finite c _ -> unCoefficient c == [D0] - _ -> False - -dIsPosZero :: Decoded -> Bool -dIsPosZero d - | dSign d == Sign1 = False - | otherwise = case dValue d of - Finite c _ -> unCoefficient c == [D0] - _ -> False - -dIsPosSubnormal :: Decoded -> Bool -dIsPosSubnormal d - | dSign d == Sign1 = False - | otherwise = case dValue d of - Finite c e -> e < minNormalExp c - _ -> False - -dIsPosNormal :: Decoded -> Bool -dIsPosNormal d - | dSign d == Sign1 = False - | otherwise = case dValue d of - Finite c e -> e >= minNormalExp c - _ -> False - -dIsPosInf :: Decoded -> Bool -dIsPosInf d - | dSign d == Sign1 = False - | otherwise = dValue d == Infinite - - --- # decQuad functions not recreated here: - --- skipped: classString - not needed --- skipped: copy - not needed --- skipped: copyAbs - use abs instead --- skipped: copyNegate - use negate instead --- skipped: fromNumber - not needed --- skipped: fromPacked - use fromPackedChecked instead --- skipped: fromWider - not needed --- skipped: getExponent, setExponent - use toBCD, fromBCD --- skipped: getCoefficient, setCoefficient - use toBCD, fromBCD --- skipped: isCanonical - not needed --- skipped: radix - not needed --- skipped: toNumber - not needed --- skipped: toPacked - use decode function instead --- skipped: toWider - not needed --- skipped: show - not needed; impure diff --git a/lib/Deka.hs b/lib/Deka.hs new file mode 100644 --- /dev/null +++ b/lib/Deka.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE Safe, DeriveDataTypeable #-} + +-- | Simple decimal arithmetic. +-- +-- 'Deka' provides a decimal arithmetic type. Using this module, the +-- results are never inexact. Computations will throw exceptions +-- rather than returning an inexact result. That way, you know that +-- any result you have is exactly correct. +-- +-- On 64-bit platforms, you are limited to: +-- +-- * a coefficient of ((2 * 10 ^ 17) - 1) digits long +-- +-- * a maximum exponent of ((1 * 10 ^ 18) - 1) +-- +-- * a minimum exponent of -((1 * 10 ^ 18) + 1) +-- +-- On 32-bit platforms, you are limited to: +-- +-- * a coefficient of 8.5 * 10 ^ 8 digits long +-- +-- * a maximum exponent of 4.25 * 10 ^ 8 +-- +-- * a minimum exponent of -4.25 * 10 ^ 8 +-- +-- If you exceed these limits, your computation will throw an +-- exception. +-- +-- 'Deka' represents only finite values. There are no infinities or +-- not-a-number values allowed. +-- +-- For more control over your arithmetic, see "Deka.Dec", but +-- for many routine uses this module is sufficient and is more +-- succinct because, unlike 'Dec', 'Deka' is a member of the 'Num' +-- typeclass. + +module Deka + ( Deka + , unDeka + , DekaT(..) + , integralToDeka + , strToDeka + , quadToDeka + , DekaError(..) + ) where + +import Control.Exception +import Data.Typeable +import Deka.Dec hiding (compare) +import qualified Deka.Dec as D +import qualified Data.ByteString.Char8 as BS8 + +-- | Thrown by arithmetic functions in the Num class, as this is the +-- only way to indicate errors. +data DekaError + = Flagged Flags + -- ^ A computation set flags. This will happen if, for example, + -- you calculate a result that is out of range. + deriving (Show, Typeable) + +instance Exception DekaError + +-- | Deka wraps a 'Dec'. Only finite 'Dec' may become a 'Deka'; +-- no infinities or NaN values are allowed. +-- +-- 'Deka' is a member of 'Num', making it easy to use for +-- elementary arithmetic. Any time you perform arithmetic, the +-- results are always exact. The arithmetic functions will throw +-- exceptions rather than give you an inexact result. +-- +-- 'Deka' is not a member 'Fractional' because it is generally +-- impossible to perform division without getting inexact results, +-- and 'Deka' never holds inexact results. +newtype Deka = Deka { unDeka :: Dec } + deriving Show + +eval :: Ctx a -> a +eval c + | fl == emptyFlags = r + | otherwise = throw . Flagged $ fl + where + (r, fl) = runCtxStatus c + +-- | Eq compares by value. For instance, @3.5 == 3.500@. +instance Eq Deka where + Deka x == Deka y = case eval k of + EQ -> True + _ -> False + where + k = do + d <- D.compare x y + let f | isZero d = EQ + | isPositive d = GT + | otherwise = LT + return f + +-- | Ord compares by value. For instance, @compare 3.5 3.500 == +-- EQ@. +instance Ord Deka where + compare (Deka x) (Deka y) = eval $ do + d <- D.compare x y + let f | isZero d = EQ + | isPositive d = GT + | otherwise = LT + return f + +-- | Many of the 'Num' functions will throw 'DekaError' if their +-- arguments are out of range or if they produce results that are +-- out of range or inexact. For functions that don't throw, you can +-- use 'integralToDeka' rather than 'fromInteger', or you can use +-- "Deka.Dec" instead of 'Deka'. +instance Num Deka where + Deka x + Deka y = Deka . eval $ D.add x y + Deka x - Deka y = Deka . eval $ D.subtract x y + Deka x * Deka y = Deka . eval $ D.multiply x y + negate = Deka . eval . D.minus . unDeka + abs = Deka . eval . D.abs . unDeka + signum (Deka x) + | f isZero = fromInteger 0 + | f isNegative = fromInteger (-1) + | otherwise = fromInteger 1 + where + f g = g x + fromInteger = Deka . eval . fromByteString . BS8.pack . show + +-- | Decimals with a total ordering. +newtype DekaT = DekaT { unDekaT :: Deka } + deriving Show + +-- | Eq compares by a total ordering. +instance Eq DekaT where + DekaT (Deka x) == DekaT (Deka y) + | r == EQ = True + | otherwise = False + where + r = compareTotal x y + +-- | Ord compares by a total ordering. +instance Ord DekaT where + compare (DekaT (Deka x)) (DekaT (Deka y)) = compareTotal x y + + +-- | Convert any integral to a 'Deka'. Returns 'Nothing' if the +-- integer is too big to fit into a 'Deka'. +integralToDeka :: (Integral a, Show a) => a -> Maybe Deka +integralToDeka i + | fl == emptyFlags = Just . Deka $ d + | otherwise = Nothing + where + (d, fl) = runCtxStatus . fromByteString . BS8.pack . show $ i + +-- | Convert a string to a Deka. You can use ordinary numeric +-- strings, such as @3.25@, or exponential notation, like @325E-2@. +-- More information on your choices is at: +-- +-- +-- +-- You cannot use strings that represent an NaN or an infinity. If +-- you do that, or use an otherwise invalid string, this function +-- returns 'Nothing'. +strToDeka :: String -> Maybe Deka +strToDeka s + | not (emptyFlags == fl) = Nothing + | not (isFinite r) = Nothing + | otherwise = Just (Deka r) + where + (r, fl) = runCtxStatus . fromByteString . BS8.pack $ s + +-- | Change a 'Dec' to a 'Deka'. Only succeeds for finite 'Dec'. +quadToDeka :: Dec -> Maybe Deka +quadToDeka d + | isFinite d = Just $ Deka d + | otherwise = Nothing diff --git a/lib/Deka/Context.hs b/lib/Deka/Context.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Context.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE Safe #-} +module Deka.Context + ( + + -- * Integer type + Signed + + -- * Ctx + , Ctx + + -- * Flags + , Flag + , Flags + , allFlag + , fullFlags + , emptyFlags + , packFlags + , unpackFlags + + -- ** Individual flags + , clamped + , conversionSyntax + , divisionByZero + , divisionImpossible + , divisionUndefined + , fpuError + , inexact + , invalidContext + , invalidOperation + , mallocError + , notImplemented + , overflow + , rounded + , subnormal + , underflow + + -- * Traps + , getTraps + , setTraps + + -- * Status + , getStatus + , setStatus + + -- * Digits + , Precision + , precision + , unPrecision + , getPrecision + , setMaxPrecision + + -- * Rounding + -- ** Rounding types + , Round + , roundCeiling + , roundUp + , roundHalfUp + , roundHalfEven + , roundHalfDown + , roundDown + , roundFloor + , round05Up + , roundTruncate + + -- ** Getting and setting + , getRound + , setRound + + -- * Emax and Emin + -- ** Emax + , Emax + , unEmax + , emax + , getEmax + + -- ** Emin + , Emin + , unEmin + , emin + , getEmin + + -- * Trio + , Trio + , trioPrecision + , trioEmax + , trioEmin + , trio + , setTrio + , getTrio + + -- * Clamp + , getClamp + , setClamp + + -- * Correct rounding + , getAllCorrectRound + , setAllCorrectRound + + -- * Initializers + , Initializer(..) + , initCtx + + -- * Running a Ctx + , runCtxInit + , runCtx + , runCtxStatus + , local + + ) where + +import Deka.Internal.Context +import Deka.Internal.Mpdec (Signed) diff --git a/lib/Deka/Dec.hs b/lib/Deka/Dec.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Dec.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE Safe #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Decimal arithmetic. +-- +-- Much documentation is copied from documentation for the decNumber +-- C library, available at +-- +-- +module Deka.Dec + ( Dec + + -- * Context + , module Deka.Context + + -- * String Conversions + , fromByteString + , toByteString + , toEngByteString + + -- * Arithmetic + , add + , subtract + , multiply + , fma + , divide + , divideInteger + , remainder + , remainderNear + + -- * Signs and absolute value + , abs + , plus + , minus + + -- * Comparisons + , compare + , compareSignal + , compareTotal + , compareTotalMag + , max + , maxMag + , min + , minMag + + -- * Increments + , nextMinus + , nextPlus + , nextToward + + -- * Exponent testing and adjustment + , sameQuantum + , quantize + , rescale + , scaleB + + -- * Digit-wise and logical + , and + , or + , xor + , shift + , rotate + , invert + + -- * Trailing zeroes + , reduce + + -- * Integral rounding + , toIntegralExact + , toIntegralValue + + -- * Logarithms, exponents, roots + , exp + , ln + , logB + , log10 + , power + , squareRoot + + -- * Identification + , PosNeg(..) + , Number(..) + , Class(..) + , strToClass + , numClass + , isNormal + , isSubnormal + , isFinite + , isInfinite + , isNaN + , isNegative + , isPositive + , isSigned + , isQNaN + , isSNaN + , isSpecial + , isZero + , isZeroCoeff + , isOddCoeff + , Sign(..) + , sign + , EvenOdd(..) + , evenOdd + + -- * Version + , version + + ) where + +import Deka.Internal.Dec.CtxFree +import Deka.Internal.Dec.Ctx +import Deka.Internal.Mpdec +import Deka.Context +import Data.ByteString.Char8 as BS8 +import Prelude (Show(..), (.)) + +-- | Same as +-- +-- @ +-- 'BS8.unpack' . 'toByteString' +-- @ +instance Show Dec where + show = BS8.unpack . toByteString + diff --git a/lib/Deka/Docs.hs b/lib/Deka/Docs.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Docs.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE Safe #-} +-- | Documentation for Deka. +-- +-- At the moment, documentation is scattered about. Some of it is +-- in the main README.md, which is in the source code tree and is +-- viewable in Github at +-- +-- +-- +-- Of course much of it is in the Haddock comments in the source +-- code itself. +-- +-- There is also a module here, "Deka.Docs.Examples". It is in +-- literate Haskell and has many comments. Unfortunately Haddock +-- does not play well with Literate Haskell. However, the style of +-- the file would not play well with Haddock anyway so I'm not sure +-- I would ever switch back to regular Haskell for that file. +-- +-- So if you link to the file from the Haddock docs, you will just +-- get a blank page. Fortunately it is easily readable in Github: +-- +-- + +module Deka.Docs where diff --git a/lib/Deka/Docs/Examples.lhs b/lib/Deka/Docs/Examples.lhs new file mode 100644 --- /dev/null +++ b/lib/Deka/Docs/Examples.lhs @@ -0,0 +1,268 @@ +Examples for the Deka library +============================= + +For very simple arithmetic, just import `Deka`. It contains a +`Deka` type, which is an instance of Num. For more control over your +arithmetic, import `Deka.Fixed.Quad`. Be aware that `Quad` exports some +functions that clash with Prelude names, so you might want to do a +qualified `import`; however we will just import them unqualified +here. + +> -- Examples will deliberately shadow some names +> {-# OPTIONS_GHC -fno-warn-name-shadowing #-} +> {-# LANGUAGE Safe #-} +> +> -- | If you are viewing this module in Haddock and expecting to +> -- see examples, you won't see anything. The file is written in +> -- literate Haskell, so the idea is that you will look at the +> -- source itself. You can look at the source in Haddock, but it +> -- will probably be poorly formatted because HsColour formats it +> -- rather oddly by default. The easiest way to see it +> -- is on Github: +> -- +> -- +> module Deka.Docs.Examples where + +> import Deka +> import Deka.Dec +> import Data.Maybe + +We need Char8 ByteStrings when working with the `Deka.Dec` module: + +> import qualified Data.ByteString.Char8 as BS8 + +> examples :: IO () +> examples = do { + +Why is decimal arithmetic important? The webpages here discuss the +issue at great length: + +http://speleotrove.com/decimal/ + +But in a nutshell, the floats that are built in to nearly every +computer language, including Haskell, are approximate. That's OK +for many purposes. It's not OK if you need exact results, such as +for financial purposes. + +For example, on my machine this will not output 0.3 but instead will +output 0.3 plus a small fraction: + +> print $ 0.1 + 0.1 + (0.1 :: Double); + +This sort of imprecision adds up quickly and makes your life as a +programmer harder in many ways. It also produces results that are +simply incorrect if you needed an exact answer. + +For simple arithmetic like this, deka provides the `Deka` type. It is +an instance of `Num`. Results with the `Deka` type are never, ever +rounded. There are limits on the size of numbers you can use; these +limits are huge and should not affect most uses. They are +documented in the `Deka` module. + +All numbers in deka are stored as a "coefficient" and an "exponent". +The coefficient is an integer, and the exponent is an +integer that may be negative, zero, or positive. Here, the +coefficient is always 12345, but the exponent varies: + + Number Exponent + 12345 0 + 123.45 -2 + 0.12345 -5 + 0.00012345 -8 + +Some numbers can only accurately be written down using scientific +notation if we want to reflect how many digits are in the +coefficient. We can do this with E notation, where the coefficient +is followed by the exponent. To get the original number, if the +coefficient is c and the exponent is e, do + + c * 10 ^ e + +So, for example, you can say that `12345e0` and `1234500e-2` are the +same number, but they have different coefficients. + +For more about decimal arithmetic, you will really want to read + +http://speleotrove.com/decimal/decarith.html + +It's written in a very clear style. + +OK, so back to `Deka`. We said that `print $ 0.1 + 0.1 + 0.1` yields +an inaccurate result. How to do it with `Deka`? + +First we have to create a `Deka`. `Deka` is not an instance of +`Read`. However you can use `strToDeka`, which has the type + + strToDeka :: String -> Maybe Deka + +If you give a bad input string, you get `Nothing`; otherwise you get +a `Just` with your `Deka`. The input string can be in regular or +scientific notation. + +So, the following snippet will not give you incorrectly rounded +results: + +> let { oneTenth = fromJust . strToDeka $ "0.1" }; +> print $ oneTenth + oneTenth + oneTenth; + +`Deka` is not an instance of other numeric typeclasses, such as +`Real` or `Fractional`. That's because `Deka` never ever rounds, no +matter what. For `Deka` to be a member of `Fractional`, it would +need to implement division, and division without rounding can't do +very much. + +Sometimes it will be impossible for `Deka` to do its math without +rounding. In that case, the functions in the `Deka` module will +apply `error` and quit. That way you are assured that if you have a +result, it is not rounded. + + +More flexibility with the `Deka.Dec` module +================================================= + +Though the `Deka` type provides you with some flexibility--and it's +easy to use because it's an instance of `Num`--sometimes you need more +flexibility. If you want to perform division, for example, `Deka` is +no good. For more flexibility, but more cumbersome use, turn to the +`Deka.Dec` module. + +The main type of the `Deka.Dec` module is called `Dec`, as in +"Decimal". It exposes the full power of the mpdecimal library. The +disadvantage is that many computations must be performed in the +`Ctx` monad. This monad carries the state that decNumber needs to +do its work. It provides you with a lot of information about any +errors that have occurred during computations. + +If you are getting into the `Deka.Dec` module, you really need to read the +decimal arithmetic specification at + +http://speleotrove.com/decimal/decarith.html + +Context +------- + +This specification provides that many computations occur within a +so-called "context", which holds information that affects the +computation, such as how to round inexact results. The context also +holds information about any errors that have happened so far, such +as division by zero, and can tell you other information such as +whether any computations performed so far have calculated an inexact +result. + +The context of the decimal arithmetic specification is represented +in Deka by the `Ctx` type. `Ctx` provides computations with the +context that they need, and it allows computations to record errors +that may arise. `Ctx` is a `Monad` so you can use the usual monad +functions and `do` notation to combine your computations. +`Deka.Context`, which is re-exported by `Deka.Dec`, has functions +you can use to change the context's rounding, see what errors have +been set, and clear errors. Once an error flag is set, you have to +clear it; the functions in `Quad` won't clear it for you. However, +computations can proceed normally even if an error flag was set in a +previous computation. + +After building up a computation in the `Ctx` monad, you need a way +to get the results and use them elsewhere in your program. For this +you use the `runQuad` function: + + runCtx :: Ctx a -> a + +Not all computations need a context. For example, `compareTotal` +does not need a context, and it can never return an error. + +Example - using `do` notation +----------------------------- + +Following is an example of how you would add one tenth using the +Quad type: + +> let { oneTenth = runCtx . fromByteString . BS8.pack $ "0.1" }; +> BS8.putStrLn . toByteString . runCtx $ do +> r1 <- add oneTenth oneTenth +> add r1 oneTenth +> ; + +As you can see this is much more cumbersome than using `Deka`. But +it does give you the full power of mpdecimal. + +Rounding +-------- + +One reason to use the `Deka.Dec` module is because you want greater +control over rounding. There are many varieties of rounding +available, which you can set. This can be useful with division, for +example, where you will not get exact results. All results are +computed to 34 digits of precision. + +> let tenSixths = runCtx $ do +> setRound roundDown +> ten <- fromByteString . BS8.pack $ "10" +> three <- fromByteString . BS8.pack $ "6" +> divide ten three +> ; + +Perhaps you want to round the result to a particular number of +decimal places. You do this with the `quantize` function. It takes +two `Quad`: one that you want to round, and another that has the +number of decimal places you want to round to. + +> putStrLn "This is 10 / 6, rounded to two places:"; +> BS8.putStrLn . toByteString . runCtx $ do +> twoPlaces <- fromByteString . BS8.pack $ "1e-2" +> quantize tenSixths twoPlaces +> ; + +By default, rounding is done using the `roundHalfEven` method. You +can set a different rounding method if you wish; the rounding +methods are listed in the Haddock documentation for `Deka.Context`. + +> putStrLn "This is 10 / 6, rounded using the 'roundDown' method."; +> BS8.putStrLn . toByteString . runCtx $ do +> twoPlaces <- fromByteString . BS8.pack $ "1e-2" +> setRound roundDown +> quantize tenSixths twoPlaces +> ; + + +Flags +----- + +A computation may set any number of flags. These are listed in the +`Deka.Context` module. They indicate errors (like division by zero) +or give information (such as the fact that a computation was +inexact.) Functions in `Deka.Context` manipulate which flags are +currently set. Though computations set flags, they never clear +them. You have to clear them yourself. + +To see which flags are set, use `getStatus`: + +> let (r, fl) = runCtx $ do +> big1 <- fromByteString . BS8.pack $ "987e3000" +> nan <- fromByteString . BS8.pack $ "sNaN" +> rslt <- multiply big1 nan +> fl <- getStatus +> return $ (toByteString rslt, fl) +> ; +> putStr "result: "; +> BS8.putStrLn r; +> putStr "flags set: "; +> print fl; + +The above example also shows that computations may return a Quad +that is not finite--that is, it might be inifite, or it might be a +Not-a-Number, or NaN. In contrast, computations using the Deka type +never return non-finite values. + +Conclusion +---------- + +That should be enough to get you started. If you find any bug no +matter how small--even just a typo in the documentation--report it +to me at omari@smileystation.com or file a ticket or a pull request +in Github: + +https://github.com/massysett/deka + +No bug is too small! + +> }; diff --git a/lib/Deka/Internal/Context.hs b/lib/Deka/Internal/Context.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Internal/Context.hs @@ -0,0 +1,637 @@ +{-# LANGUAGE Trustworthy, DeriveDataTypeable #-} +module Deka.Internal.Context where + +import Foreign.C +import Foreign.Safe +import Control.Applicative +import Control.Monad +import Control.Exception +import Data.Typeable +import Deka.Internal.Mpdec +import System.IO.Unsafe (unsafePerformIO) + +-- | The Ctx monad +-- +-- The General Decimal Arithmetic specification states that most +-- computations occur within a @context@, which affects the manner +-- in which computations are done (for instance, the context +-- determines the rounding algorithm). The context also carries +-- the flags that computations can set (for instance, a computation might +-- set a flag to indicate that the result is rounded or inexact or +-- was a division by zero.) The Ctx monad carries this context. + +newtype Ctx a = Ctx { unCtx :: Ptr C'mpd_context_t -> IO a } + +instance Functor Ctx where + fmap = liftM + +instance Applicative Ctx where + pure = return + (<*>) = ap + +instance Monad Ctx where + return a = Ctx $ \_ -> return a + Ctx a >>= f = Ctx $ \p -> do + r1 <- a p + let b = unCtx $ f r1 + b p + fail s = Ctx $ \_ -> fail s + +-- # Rounding + +newtype Round = Round { _unRound :: CInt } + deriving (Eq, Ord) + +-- | Round toward positive infinity. +roundCeiling :: Round +roundCeiling = Round c'MPD_ROUND_CEILING + +-- | Round away from zero. +roundUp :: Round +roundUp = Round c'MPD_ROUND_UP + +-- | @0.5@ rounds up +roundHalfUp :: Round +roundHalfUp = Round c'MPD_ROUND_HALF_UP + +-- | @0.5@ rounds to nearest even +roundHalfEven :: Round +roundHalfEven = Round c'MPD_ROUND_HALF_EVEN + +-- | @0.5@ rounds down +roundHalfDown :: Round +roundHalfDown = Round c'MPD_ROUND_HALF_DOWN + +-- | Round toward zero - truncate +roundDown :: Round +roundDown = Round c'MPD_ROUND_DOWN + +-- | Round toward negative infinity. +roundFloor :: Round +roundFloor = Round c'MPD_ROUND_FLOOR + +-- | Round for reround +round05Up :: Round +round05Up = Round c'MPD_ROUND_05UP + +-- | Truncate, but set infinities. +roundTruncate :: Round +roundTruncate = Round c'MPD_ROUND_TRUNC + +instance Show Round where + show r + | r == roundCeiling = "ceiling" + | r == roundUp = "up" + | r == roundHalfUp = "half up" + | r == roundHalfEven = "half even" + | r == roundHalfDown = "half down" + | r == roundDown = "down" + | r == roundFloor = "floor" + | r == round05Up = "05up" + | r == roundTruncate = "truncate" + | otherwise = error "show: unknown rounding value" + +getRound :: Ctx Round +getRound = Ctx $ fmap Round . peek . p'mpd_context_t'round + +setRound :: Round -> Ctx () +setRound (Round r) = Ctx $ \ptr -> poke (p'mpd_context_t'round ptr) r + +-- # Precision + +-- | Sets the precision to be used for all operations. The result +-- of an operation is rounded to this length if necessary. +newtype Precision = Precision { unPrecision :: Signed } + deriving (Eq, Ord, Show) + +instance Bounded Precision where + minBound = Precision 1 + maxBound = Precision c'MPD_MAX_PREC + +-- | Creates a 'Precision' that you can then set with +-- 'setTrio'. Returns 'Nothing' if the argument is out of +-- range. The minimum possible value is always 1; the maximum +-- possible value is platform dependent and is revealed by +-- 'maxBound'. +precision :: Signed -> Maybe Precision +precision i + | i < 1 = Nothing + | i > c'MPD_MAX_PREC = Nothing + | otherwise = Just . Precision $ i + +-- | Sets the precision to the maximum possible, respecting that +-- @'Emax' > 5 * 'Precision'@. Returns the new 'Precision'. + +setMaxPrecision :: Ctx Precision +setMaxPrecision = do + Emax x <- getEmax + let p' = Precision $ x `div` 5 + setPrecision p' + return p' + +setPrecision :: Precision -> Ctx () +setPrecision (Precision d) = Ctx $ \ptr -> + poke (p'mpd_context_t'prec ptr) d + +getPrecision :: Ctx Precision +getPrecision = Ctx $ fmap Precision . peek . p'mpd_context_t'prec + +-- # Emax, Emin + +-- | Maximum adjusted exponent. The adjusted exponent is calculated +-- as though the number were expressed in scientific notation. If +-- the adjusted exponent would be larger than 'Emax' then an +-- overflow results. +-- +-- The minimum possible value is always 0; the +-- maximum possible value is platform dependent and is revealed by +-- 'maxBound'. +newtype Emax = Emax { unEmax :: Signed } + deriving (Eq, Ord, Show) + +instance Bounded Emax where + minBound = Emax 0 + maxBound = Emax c'MPD_MAX_EMAX + +-- | Minimum adjusted exponent. The adjusted exponent is calculated +-- as though the number were expressed in scientific notation. If +-- the adjusted exponent would be smaller than 'Emin' then the +-- result is subnormal. If the result is also inexact, an underflow +-- results. If subnormal results are allowed (see 'setClamp') the +-- smallest possible exponent is 'Emin' minus 'Precision' plus @1@. +-- +-- The minimum possible value is platform dependent +-- and is revealed by 'minBound'; the maximum possible value is +-- always 0. +newtype Emin = Emin { unEmin :: Signed } + deriving (Eq, Ord, Show) + +instance Bounded Emin where + minBound = Emin c'MPD_MIN_EMIN + maxBound = Emin 0 + +-- | Returns an 'Emax' for use in 'setTrio'. Fails if argument is +-- out of range. +emax :: Signed -> Maybe Emax +emax i + | r < minBound = Nothing + | r > maxBound = Nothing + | otherwise = Just r + where + r = Emax i + +-- | Returns an 'Emin' for use in 'setTrio'. Fails if argument is +-- out of range. +emin :: Signed -> Maybe Emin +emin i + | r < minBound = Nothing + | r > maxBound = Nothing + | otherwise = Just r + where + r = Emin i + +getEmax :: Ctx Emax +getEmax = Ctx $ fmap Emax . peek . p'mpd_context_t'emax + +setEmax :: Emax -> Ctx () +setEmax (Emax i) = Ctx $ \ptr -> poke (p'mpd_context_t'emax ptr) i + +getEmin :: Ctx Emin +getEmin = Ctx $ fmap Emin . peek . p'mpd_context_t'emin + +setEmin :: Emin -> Ctx () +setEmin (Emin i) = Ctx $ \ptr -> poke (p'mpd_context_t'emin ptr) i + +-- # Trio + +-- | In addition to the limits on 'Precision', 'Emax', and 'Emin', +-- there are also requirements on the relationship between these +-- three variables: +-- +-- * @'Emax' > 5 * 'Precision'@ +-- +-- * either @'Emin' == 1 - 'Emax'@ or @'Emin' == -'Emax'@ +-- +-- The 'Trio' enforces this relationship. +-- +-- It is also recommended that @'Emax' > 10 * 'Precision'@, but +-- since this is not required the 'Trio' does not enforce it. + +data Trio = Trio + { trioPrecision :: Precision + , trioEmax :: Emax + , trioEmin :: Emin + } deriving Show + +-- | Make a new 'Trio'. Fails if the values are out of range. + +trio :: Precision -> Emax -> Emin -> Maybe Trio +trio pp@(Precision p) px@(Emax x) pn@(Emin n) + | not $ x > 5 * p = Nothing + | not $ n == 1 - x || n == negate x = Nothing + | otherwise = Just $ Trio pp px pn + +setTrio :: Trio -> Ctx () +setTrio (Trio p x n) = + setPrecision p >> setEmax x >> setEmin n + +getTrio :: Ctx Trio +getTrio = liftM3 Trio getPrecision getEmax getEmin + +-- # Clamp + +getClamp :: Ctx Bool +getClamp = Ctx $ fmap (/= 0) . peek . p'mpd_context_t'clamp + +-- | Controls explicit exponent clamping. When False, a result +-- exponent is limited to a maximum of emax and a minimum of emin +-- (for example, the exponent of a zero result will be clamped to be +-- in this range). When True, a result exponent has the same minimum +-- but is limited to a maximum of emax-(digits-1). As well as +-- clamping zeros, this may cause the coefficient of a result to be +-- padded with zeros on the right in order to bring the exponent +-- within range. +-- +-- Also when True, this limits the length of NaN payloads to +-- 'Precision' - 1 when constructing a NaN by conversion from a +-- string. + +setClamp :: Bool -> Ctx () +setClamp b = Ctx f + where + f ptr = poke (p'mpd_context_t'clamp ptr) v + v = if b then 1 else 0 + + +-- # Flags + +-- | Indicates error conditions. This type serves two purposes: +-- computations set flags to indicate errors, and flags indicate +-- which errors you want to have raise a signal. See 'getStatus', +-- 'setStatus', 'getTraps', and 'setTraps'. +-- +-- 'Flag' is an instance of 'Exception' so that you can throw it if +-- you want; however, none of the functions in the @deka@ package +-- throw. +newtype Flag = Flag { unFlag :: Word32 } + deriving (Eq, Ord, Typeable) + +instance Exception Flag + +instance Show Flag where + show f + | f == conversionSyntax = "Conversion syntax" + | f == divisionByZero = "Division by zero" + | f == divisionImpossible = "Division impossible" + | f == divisionUndefined = "Division undefined" + | f == inexact = "Inexact" + | f == invalidContext = "Invalid context" + | f == invalidOperation = "Invalid operation" + | f == mallocError = "malloc error" + | f == fpuError = "FPU error" + | f == notImplemented = "Not implemented" + | f == overflow = "Overflow" + | f == clamped = "Clamped" + | f == rounded = "Rounded" + | f == subnormal = "Subnormal" + | f == underflow = "Underflow" + | otherwise = error "show flag: unrecognized flag" + +-- | A container of 'Flag'. +newtype Flags = Flags { unFlags :: Word32 } + deriving (Eq, Typeable) + +instance Show Flags where + show = show . unpackFlags + +instance Exception Flags + +-- | A list of all possible 'Flag', in order. +allFlag :: [Flag] +allFlag = + [ clamped + , conversionSyntax + , divisionByZero + , divisionImpossible + , divisionUndefined + , fpuError + , inexact + , invalidContext + , invalidOperation + , mallocError + , notImplemented + , overflow + , rounded + , subnormal + , underflow + ] + +-- | All possible 'Flag' are set. +fullFlags :: Flags +fullFlags = packFlags allFlag + +-- | No 'Flag' are set. +emptyFlags :: Flags +emptyFlags = Flags 0 + +-- | Flags will always be unpacked in order. +unpackFlags :: Flags -> [Flag] +unpackFlags (Flags i) = f allFlag + where + f [] = [] + f (Flag x:xs) + | x .&. i /= 0 = Flag x : f xs + | otherwise = f xs + +packFlags :: [Flag] -> Flags +packFlags = Flags . foldl (.|.) 0 . map unFlag + +-- | A source string (for instance, in 'fromByteString') contained +-- errors. +conversionSyntax :: Flag +conversionSyntax = Flag c'MPD_Conversion_syntax + +-- | A non-zero dividend is divided by zero. Unlike @0/0@, it has a +-- defined result (a signed Infinity). +divisionByZero :: Flag +divisionByZero = Flag c'MPD_Division_by_zero + +-- | Sometimes raised by 'divideInteger' and 'remainder'. +divisionImpossible :: Flag +divisionImpossible = Flag c'MPD_Division_impossible + +-- | @0/0@ is undefined. It sets this flag and returns a quiet NaN. +divisionUndefined :: Flag +divisionUndefined = Flag c'MPD_Division_undefined + +-- | One or more non-zero coefficient digits were discarded during +-- rounding. +inexact :: Flag +inexact = Flag c'MPD_Inexact + +-- | The Context for computations was invalid; this error should +-- never occur because @deka@ keeps you from setting an invalid +-- context. +invalidContext :: Flag +invalidContext = Flag c'MPD_Invalid_context + +-- | Raised on a variety of invalid operations, such as an attempt +-- to use 'compareSignal' on an operand that is an NaN. +invalidOperation :: Flag +invalidOperation = Flag c'MPD_Invalid_operation + +mallocError :: Flag +mallocError = Flag c'MPD_Malloc_error + +fpuError :: Flag +fpuError = Flag c'MPD_Fpu_error + +notImplemented :: Flag +notImplemented = Flag c'MPD_Not_implemented + +-- | The exponent of a result is too large to be represented. +overflow :: Flag +overflow = Flag c'MPD_Overflow + +clamped :: Flag +clamped = Flag c'MPD_Clamped + +rounded :: Flag +rounded = Flag c'MPD_Rounded + +subnormal :: Flag +subnormal = Flag c'MPD_Subnormal + +-- | A result is both subnormal and inexact. +underflow :: Flag +underflow = Flag c'MPD_Underflow + +-- # Traps + +-- ## Set + +-- | If you set a trap, a computation will immediately raise +-- @SIGFPE@ if the corresponding error arises. (Currently this +-- behavior cannot be configured to do something else.) +-- 'setTraps' clears all existing traps and sets them to the new +-- ones you specify. +-- +-- By setting a flag here, SIGFPE is raised if any subsequent +-- computations raise the corresponding error condition. Setting a +-- flag with this function or with 'setTrap' never, by itself, +-- causes SIGFPE to be raised; it is raised only by a subsequent +-- computation. So, if you set a flag using this function or +-- 'setTrap' and the corresponding status flag is already set, +-- SIGFPE will be raised only if a subsequent computation raises +-- that error condition. +setTraps :: Flags -> Ctx () +setTraps fs = Ctx $ \ptr -> do + let pTr = p'mpd_context_t'traps ptr + poke pTr (unFlags fs) + +-- | Gets all currently set traps. +getTraps :: Ctx Flags +getTraps = Ctx $ \ptr -> do + ts <- peek (p'mpd_context_t'traps ptr) + return $ Flags ts + +-- # Status + +-- ## Set + +-- | Sets status flags. All existing status flags are cleared and +-- replaced with the ones you indicate here. +setStatus :: Flags -> Ctx () +setStatus fs = Ctx $ \ptr -> + poke (p'mpd_context_t'status ptr) (unFlags fs) + +-- | All currently set status flags. +getStatus :: Ctx Flags +getStatus = Ctx $ \ptr -> do + let pSt = p'mpd_context_t'status ptr + ts <- peek pSt + return $ Flags ts + +-- # Initializers + +-- | Before running computations in a context. the context must be +-- initialized with certain settings, such as the rounding mode, +-- precision, and maximum adjusted exponent. An 'Initializer' +-- contains all these settings. +-- +-- On 64-bit platforms, the maximums are: +-- +-- * 'Precision' of ((1 * 10 ^ 18) - 1) +-- * 'Emax' of ((1 * 10 ^ 18) - 1) +-- * 'Emin' of -((1 * 10 ^ 18) - 1) +-- +-- On 32-bit platforms, the maximums are: +-- +-- * 'Precision' of 4.25 * 10 ^ 8 +-- * 'Emax' of 4.25 * 10 ^ 8 +-- * 'Emin' of -4.25 * 10 ^ 8 + +data Initializer + = Max + -- ^ Sets: + -- + -- * 'Precision' to the maximum available + -- * 'Emax' to the maximum available + -- * 'Emin' to the minimum available + -- * 'Round' to 'roundHalfEven' + -- * Traps to 'invalidOperation', 'divisionByZero', 'overflow', + -- 'underflow' + -- * No status flags are set + -- * No newtrap is set + -- * 'setClamp' is False + -- * 'setAllCorrectRound' is True + -- + -- As noted in the documentation for 'Trio', the specification + -- requires that @'Emax' > 5 * 'Precision'@; 'Max' does /not/ + -- respect this. + + | Default + -- ^ Same as 'Max', except: + -- + -- * Precision is @2 * MPD_RDIGITS@ + + | Basic + -- ^ Same as 'Max', except: + -- + -- * 'Precision' is 9 + -- * Traps to 'invalidOperation', 'divisionByZero', 'overflow', + -- 'underflow', and 'clamped' + + | Pedantic + -- ^ Sets the maximum allowable figures, while respecting the + -- restriction that stated in the specification and the @mpdecimal@ + -- documentation, which is that @'Emax' > 5 * 'Precision'@. Also, + -- sets no traps. This sets: + -- + -- * 'Emax' to the maximum available + -- * 'Emin' to the minimum available + -- + -- * 'Precision' is set to @'Emax' `div` 5@. On 64-bit platforms, + -- this is ((2 * 10 ^ 17) - 1); on 32-bit platforms, this is 8.5 * + -- 10 ^ 8. + -- + -- * 'Round' to 'roundHalfEven' + -- * No traps are set + -- * No status flags are set + -- * No newtrap is set + -- * 'setClamp' is False + -- * 'setAllCorrectRound' is True + + | Decimal32 + -- ^ Sets: + -- + -- * 'Precision' to @7@ + -- * 'Emax' to @96@ + -- * 'Emin' to @-95@ + -- * Rounding to 'roundHalfEven' + -- * No traps are enabled + -- * No status flags are set + -- 'newTrap' is clear + -- * 'setClamp' is True + -- * 'setAllCorrectRound' is True + + | Decimal64 + -- ^ Same as 'Decimal32', except: + -- + -- * 'Precision' is @16@ + -- * 'Emax' is @384@ + -- * 'Emin' is @-383@ + + | Decimal128 + -- ^ Same as 'Decimal32', except: + -- + -- * 'Precision' is @34@ + -- * 'Emax' is @6144@ + -- * 'Emin' is @-6143@ + +-- | Re-initialize a 'Ctx' using the given Initializer. +initCtx :: Initializer -> Ctx () +initCtx i = Ctx $ \p -> + case i of + Max -> c'mpd_maxcontext p + Default -> c'mpd_defaultcontext p + Basic -> c'mpd_basiccontext p + Pedantic -> unCtx pedantic p + Decimal32 -> c'mpd_ieee_context p 32 >> return () + Decimal64 -> c'mpd_ieee_context p 64 >> return () + Decimal128 -> c'mpd_ieee_context p 128 >> return () + +clearStatus :: Ctx () +clearStatus = Ctx $ \p -> poke (p'mpd_context_t'status p) 0 + +clearNewtrap :: Ctx () +clearNewtrap = Ctx $ \p -> poke (p'mpd_context_t'newtrap p) 0 + +pedantic :: Ctx () +pedantic = do + setEmax maxBound + setEmin minBound + let pc = Precision $ ((unEmax maxBound) `div` 5) + setPrecision pc + setRound roundHalfEven + setTraps emptyFlags + clearStatus + clearNewtrap + setClamp False + setAllCorrectRound True + +-- # allCorrectRound + +-- | By default, most functions are correctly rounded. By setting +-- allCorrectRound, correct rounding is additionally enabled for +-- exp, ln, and log10. In this case, all functions except pow and +-- invroot return correctly rounded results. +getAllCorrectRound :: Ctx Bool +getAllCorrectRound = Ctx $ fmap (/= 0) . peek . p'mpd_context_t'allcr + +setAllCorrectRound :: Bool -> Ctx () +setAllCorrectRound b = Ctx f + where + f ptr = poke (p'mpd_context_t'allcr ptr) v + v = if b then 1 else 0 + +-- # Runners + +-- | Runs a Ctx computation; begins with the given Initializer to +-- set up the context. +runCtxInit :: Initializer -> Ctx a -> a +runCtxInit i (Ctx f) = unsafePerformIO $ do + fp <- mallocForeignPtrBytes c'mpd_context_t'sizeOf + withForeignPtr fp $ \ptr -> do + _ <- unCtx (initCtx i) ptr + f ptr + +-- | Runs a Ctx computation using the 'Pedantic' Initializer. +runCtx :: Ctx a -> a +runCtx = runCtxInit Pedantic + +-- | Like 'runCtx' but also returns any status flags resulting from +-- the computation. +runCtxStatus :: Ctx a -> (a, Flags) +runCtxStatus c = runCtx $ do + r <- c + f <- getStatus + return (r, f) + +-- # Local + +-- | Runs a Ctx computation within the existing Ctx. The existing +-- Ctx is copied to form a new Ctx; then the child computation is +-- run without affecting the parent Ctx. + +local + :: Ctx a + -- ^ Run this computation. It is initialized with the current + -- Ctx, but does not affect the current Ctx. + -> Ctx a + -- ^ Returns the result of the child computation. +local (Ctx l) = Ctx $ \parent -> + allocaBytes (c'mpd_context_t'sizeOf) $ \child -> + copyBytes child parent c'mpd_context_t'sizeOf >> + l child + diff --git a/lib/Deka/Internal/Dec/Ctx.hs b/lib/Deka/Internal/Dec/Ctx.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Internal/Dec/Ctx.hs @@ -0,0 +1,364 @@ +{-# LANGUAGE Safe, OverloadedStrings #-} +module Deka.Internal.Dec.Ctx where + +import qualified Data.ByteString.Char8 as BS8 +import Deka.Internal.Context +import Deka.Internal.Mpdec +import Deka.Internal.Util.Ctx +import Data.String + +-- | Converts a character string to a 'Dec'. Implements the +-- _to-number_ conversion from the General Decimal Arithmetic +-- specification. +-- +-- The conversion is exact provided that the numeric string has no +-- more significant digits than are specified in the 'Precision' in +-- the 'Ctx' and the adjusted exponent is in the range specified by +-- 'Emin' and 'Emax' in the 'Ctx'. If there are more than +-- 'Precision' digits in the string, or the exponent is out of +-- range, the value will be rounded as necessary using the 'Round' +-- rounding mode. The 'Precision' therefore both determines the +-- maximum precision for unrounded numbers and defines the minimum +-- size of the 'Dec' structure required. +-- +-- Possible errors are 'conversionSyntax' (the string does not have +-- the syntax of a number, which depends on 'setExtended' in the +-- 'Ctx'), 'overflow' (the adjusted exponent of the number is larger +-- than 'Emax'), or 'underflow' (the adjusted exponent is less than +-- 'Emin' and the conversion is not exact). If any of these +-- conditions are set, the number structure will have a defined +-- value as described in the arithmetic specification (this may be a +-- subnormal or infinite value). + +fromByteString :: BS8.ByteString -> Ctx Dec +fromByteString bs = Ctx $ \pCtx -> + newDec $ \dn -> + BS8.useAsCString bs $ \cstr -> + c'mpd_set_string dn cstr pCtx + +-- | Returns the absolute value. The same effect as 'plus' unless +-- the operand is negative, in which case it is the same as 'minus'. +abs :: Dec -> Ctx Dec +abs = unary c'mpd_abs + +-- | Addition. +add :: Dec -> Dec -> Ctx Dec +add = binary c'mpd_add + +-- | Digit-wise logical @and@. +and :: Dec -> Dec -> Ctx Dec +and = binary c'mpd_and + +-- | @compare x y@ returns @-1@ if a is less than b, 0 if a is equal +-- to b, and 1 if a is greater than b. 'invalidOperation' is set if +-- at least one of the operands is a signaling NaN. +compare :: Dec -> Dec -> Ctx Dec +compare = binary c'mpd_compare + +-- | Identical to 'Deka.Dec.compare' except that all NaNs +-- (including quiet NaNs) set the 'invalidOperation' condition. +compareSignal :: Dec -> Dec -> Ctx Dec +compareSignal = binary c'mpd_compare_signal + +-- | Division. +divide :: Dec -> Dec -> Ctx Dec +divide = binary c'mpd_div + +-- | Returns the integer part of the result of division. It must be +-- possible to express the result as an integer. That is, it must +-- have no more digits than 'Precision' in the 'Ctx'. If it does +-- then 'divisionImpossible' is raised. +divideInteger :: Dec -> Dec -> Ctx Dec +divideInteger = binary c'mpd_divint + +-- | Exponentiation. Result is rounded if necessary using the +-- 'Precision' in the 'Ctx' and using the 'roundHalfEven' rounding +-- method. +-- +-- Finite results will always be full precision and inexact, except +-- when rhs is a zero or -Infinity (giving 1 or 0 respectively). +-- Inexact results will almost always be correctly rounded, but may +-- be up to 1 ulp (unit in last place) in error in rare cases. +-- +-- This is a mathematical function; the @10 ^ 6@ restrictions on +-- precision and range apply as described above. +exp :: Dec -> Ctx Dec +exp = unary c'mpd_exp + +-- | @fma x y z@ multiplies @x@ by @y@ and then adds @z@ to that +-- intermediate result. It is equivalent to a multiplication +-- followed by an addition except that the intermediate result is +-- not rounded and will not cause overflow or underflow. That is, +-- only the final result is rounded and checked. +-- +-- This is a mathematical function; the @10 ^ 6@ restrictions on +-- precision and range apply as described above. +fma :: Dec -> Dec -> Dec -> Ctx Dec +fma = ternary c'mpd_fma + +-- | Digit-wise inversion (a @0@ becomes a @1@ and vice versa). +invert :: Dec -> Ctx Dec +invert = unary c'mpd_invert + +-- | Natural logarithm. Results are correctly rounded if +-- 'setAllCorrectRound' is True. +ln :: Dec -> Ctx Dec +ln = unary c'mpd_ln + +-- | Returns the adjusted exponent of the operand, according to the +-- rules for @logB@ of IEEE 754. This returns the exponent of the +-- operand as though its decimal point had been moved to follow the +-- first digit while keeping the same value. The result is not +-- limited by 'Emin' or 'Emax'. + +-- | If operand is an NaN, the general rules apply. If operand is +-- infinite, the result is +Infinity. If operand is zero, result is +-- -Infinity and 'invalidOperation' is set. Otherwise, the result +-- is the same as the adjusted exponent of the operand, or +-- @floor(log10(a))@ where @a@ is the operand. +logB :: Dec -> Ctx Dec +logB = unary c'mpd_logb + +-- | Base 10 logarithm. Results are correctly rounded if +-- 'setAllCorrectRound' is True. +log10 :: Dec -> Ctx Dec +log10 = unary c'mpd_log10 + +-- | Compares two numbers numerically and returns the larger. If +-- the numbers compare equal then number is chosen with regard to +-- sign and exponent. Unusually, if one operand is a quiet NaN and +-- the other a number, then the number is returned. +max :: Dec -> Dec -> Ctx Dec +max = binary c'mpd_max + +-- | Compares the magnitude of two numbers numerically and sets +-- number to the larger. It is identical to 'Deka.Dec.max' except +-- that the signs of the operands are ignored and taken to be 0 +-- (non-negative). +maxMag :: Dec -> Dec -> Ctx Dec +maxMag = binary c'mpd_max_mag + +-- | Compares two numbers numerically and sets number to the +-- smaller. If the numbers compare equal then number is chosen with +-- regard to sign and exponent. Unusually, if one operand is a quiet +-- NaN and the other a number, then the number is returned. +min :: Dec -> Dec -> Ctx Dec +min = binary c'mpd_min + +-- | Compares the magnitude of two numbers numerically and sets +-- number to the smaller. It is identical to 'Deka.Dec.min' except +-- that the signs of the operands are ignored and taken to be 0 +-- (non-negative). +minMag :: Dec -> Dec -> Ctx Dec +minMag = binary c'mpd_min_mag + +-- | Returns the result of subtracting the operand from zero. hat +-- is, it is negated, following the usual arithmetic rules; this may +-- be used for implementing a prefix minus operation. +minus :: Dec -> Ctx Dec +minus = unary c'mpd_minus + +-- | Multiplication. +multiply :: Dec -> Dec -> Ctx Dec +multiply = binary c'mpd_mul + +-- | Digit-wise logical inclusive or. +or :: Dec -> Dec -> Ctx Dec +or = binary c'mpd_or + +-- | Returns the result of adding the operand to zero. This takes +-- place according to the settings given in the 'Ctx', following the +-- usual arithmetic rules. This may therefore be used for rounding +-- or for implementing a prefix plus operation. +plus :: Dec -> Ctx Dec +plus = unary c'mpd_plus + +-- | @power b e@ returns @b@ raised to the power of @e@. Integer +-- powers are exact, provided that the result is finite and fits +-- into 'Precision'. +-- +-- Results are not correctly rounded, even if 'setAllCorrectRound' +-- is True. The error of the function is less than @1ULP + t@, +-- where @t@ has a maximum of @0.1ULP@, but is almost always less +-- than @0.001ULP@. + +power :: Dec -> Dec -> Ctx Dec +power = binary c'mpd_pow + +-- | @quantize a b@ returns the number that is equal in value to +-- @a@, but has the exponent of @b@. +quantize :: Dec -> Dec -> Ctx Dec +quantize = binary c'mpd_quantize + +-- overflow/underflow checks, returns @a@ in its simplest form with +-- all trailing zeros removed. +reduce :: Dec -> Ctx Dec +reduce = unary c'mpd_reduce + +-- | @remainder a b@ returns the remainder of @a / b@. +remainder :: Dec -> Dec -> Ctx Dec +remainder = binary c'mpd_rem + +-- | @remainderNear a b@ returns @a - b * n@, where @n@ is the +-- integer nearest the exact value of @a / b@. If two integers are +-- equally near then the even one is chosen. +remainderNear :: Dec -> Dec -> Ctx Dec +remainderNear = binary c'mpd_rem_near + +-- | @rescale a b@ returns the number that is equal in value +-- to @a@, but has the exponent @b@. Special numbers are copied +-- without signaling. This function is not part of the General +-- Decimal Arithmetic Specification. It +-- is also not equivalent to the rescale function that was removed +-- from the specification. + +rescale :: Dec -> Signed -> Ctx Dec +rescale a b = Ctx $ \p -> newDec $ \r -> + withDec a $ \pa -> + c'mpd_rescale r pa b p + +-- | @rotate x y@ returns @x@ rotated by @y@ places. @y@ must be in +-- the range [-'Precision', 'Precision']. A negative @y@ indicates a +-- right rotation, a positive @y@ a left rotation. + +rotate :: Dec -> Dec -> Ctx Dec +rotate = binary c'mpd_rotate + +-- | @scaleB a b@ - b must be an integer with exponent 0. If @a@ is +-- infinite, returns @a@. Otherwise, returns @a@ with the +-- value of @b@ added to the exponent. + +scaleB :: Dec -> Dec -> Ctx Dec +scaleB = binary c'mpd_scaleb + +-- | @shift a b@ returns @a@ shifted by @b@ places. @b@ must be in +-- the range [-'Precision', 'Precision']. A negative @b@ indicates a +-- right shift, a positive @b@ a left shift. Digits that do not fit +-- are discarded. + +shift :: Dec -> Dec -> Ctx Dec +shift = binary c'mpd_shift + +-- | Returns the square root. This function is always correctly +-- rounded using the 'roundHalfEven' method. + +squareRoot :: Dec -> Ctx Dec +squareRoot = unary c'mpd_sqrt + +-- | Returns the reciprocal of the square root. This function +-- always uses 'roundHalfEven'. Results are not correctly rounded +-- even if 'setAllCorrectRound' is True. + +inverseSquareRoot :: Dec -> Ctx Dec +inverseSquareRoot = unary c'mpd_invroot + + +-- | Subtraction. + +subtract :: Dec -> Dec -> Ctx Dec +subtract = binary c'mpd_sub + +-- | Round to an integer, using the rounding mode of the context. +-- Only a signaling NaN causes an 'invalidOperation' +-- condition. + +toIntegralExact :: Dec -> Ctx Dec +toIntegralExact = unary c'mpd_round_to_intx + +-- | Like 'toIntegralExact', but 'inexact' and 'rounded' are never +-- set. +toIntegralValue :: Dec -> Ctx Dec +toIntegralValue = unary c'mpd_round_to_int + +floor :: Dec -> Ctx Dec +floor = unary c'mpd_floor + +ceiling :: Dec -> Ctx Dec +ceiling = unary c'mpd_ceil + +truncate :: Dec -> Ctx Dec +truncate = unary c'mpd_trunc + +-- | Digit-wise logical exclusive or. + +xor :: Dec -> Dec -> Ctx Dec +xor = binary c'mpd_xor + +-- | Returns the closest representable number that is smaller than +-- the operand. +nextMinus :: Dec -> Ctx Dec +nextMinus = unary c'mpd_next_minus + +-- | Returns the closest representable number that is larger than +-- the operand. +nextPlus :: Dec -> Ctx Dec +nextPlus = unary c'mpd_next_plus + +-- | @nextToward a b@ returns the representable number closest to +-- @a@ in the direction of @b@. + +nextToward :: Dec -> Dec -> Ctx Dec +nextToward = binary c'mpd_next_toward + +toBool :: Integral a => a -> Bool +toBool i + | i == 0 = False + | otherwise = True + +-- | False if the decimal is special or zero, or the exponent is +-- less than 'Emin'. True otherwise. + +isNormal :: Dec -> Ctx Bool +isNormal d = Ctx $ \p -> + withDec d $ \pd -> + c'mpd_isnormal pd p >>= \i -> + return (toBool i) + +-- | False if the decimal is special or zero, or the exponent is +-- greater or equal to 'Emin'. True otherwise. +isSubnormal :: Dec -> Ctx Bool +isSubnormal d = Ctx $ \p -> + withDec d $ \pd -> + c'mpd_issubnormal pd p >>= \i -> + return (toBool i) + +data PosNeg = Pos | Neg + deriving (Eq, Ord, Show) + +data Number + = Infinity + | Normal + | Subnormal + | Zero + deriving (Eq, Ord, Show) + +data Class + = SNaN + | NaN + | Number PosNeg Number + deriving (Eq, Ord, Show) + +strToClass :: IsString a => [(a, Class)] +strToClass = + [ ("sNaN", SNaN) + , ("NaN", NaN) + , ("-Infinity", Number Neg Infinity) + , ("-Normal", Number Neg Normal) + , ("-Subnormal", Number Neg Subnormal) + , ("-Zero", Number Neg Zero) + , ("+Zero", Number Pos Zero) + , ("+Subnormal", Number Pos Subnormal) + , ("+Normal", Number Pos Normal) + , ("+Infinity", Number Pos Infinity) + ] + +-- | Determines the 'Class' of a 'Dec'. + +numClass :: Dec -> Ctx Class +numClass d = Ctx $ \pCtx -> + withDec d $ \pd -> + c'mpd_class pd pCtx >>= \chars -> + BS8.packCString chars >>= \bs -> + return . maybe (error "numClass: class not found") id + . lookup bs $ strToClass + diff --git a/lib/Deka/Internal/Dec/CtxFree.hs b/lib/Deka/Internal/Dec/CtxFree.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Internal/Dec/CtxFree.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE EmptyDataDecls, Trustworthy #-} + +module Deka.Internal.Dec.CtxFree where + +import Foreign.Safe +import qualified Data.ByteString.Char8 as BS8 +import Prelude +import Foreign.C.Types +import Deka.Internal.Mpdec +import System.IO.Unsafe (unsafePerformIO) + +numToOrd :: (Num a, Ord a) => a -> Ordering +numToOrd a + | a < 0 = LT + | a > 0 = GT + | otherwise = EQ + +-- | @compareTotal x y@ compares to numbers using the IEEE 754 total +-- ordering. If @x@ is less +-- than @y@, returns @-1@. If they are equal (that is, when +-- subtracted the result would be 0), returns @0@. If @y@ is +-- greater than @x@, returns @1@. +-- +-- Here is the total ordering: +-- +-- @-NaN < -sNaN < -Infinity < -finites < -0 < +0 < +finites +-- < +Infinity < +SNaN < +NaN@ +-- +-- Also, @1.000@ < @1.0@ (etc.) and NaNs are ordered by payload. +compareTotal :: Dec -> Dec -> Ordering +compareTotal x y = unsafePerformIO $ + withDec x $ \px -> + withDec y $ \py -> + c'mpd_cmp_total px py >>= \i -> + return (numToOrd i) + +-- | Same as 'compareTotal' except that the signs of the operands +-- are ignored and taken to be 0 (non-negative). + +compareTotalMag :: Dec -> Dec -> Ordering +compareTotalMag x y = unsafePerformIO $ + withDec x $ \px -> + withDec y $ \py -> + c'mpd_cmp_total_mag px py >>= \i -> + return (numToOrd i) + +-- | Converts a number to engineering notation. +toEngByteString :: Dec -> BS8.ByteString +toEngByteString dn = unsafePerformIO $ + withDec dn $ \pDn -> + c'mpd_to_eng pDn capitalize >>= \bytes -> + BS8.packCString bytes >>= \bs -> + free bytes >>= \_ -> + return bs + +-- | Converts a number to scientific notation. +toByteString :: Dec -> BS8.ByteString +toByteString dn = unsafePerformIO $ + withDec dn $ \pDn -> + c'mpd_to_sci pDn capitalize >>= \bytes -> + BS8.packCString bytes >>= \bs -> + free bytes >>= \_ -> + return bs + +-- | True if both operands have the same exponent; False otherwise. +sameQuantum :: Dec -> Dec -> Bool +sameQuantum x y = unsafePerformIO $ + withDec x $ \px -> + withDec y $ \py -> + c'mpd_same_quantum px py >>= \r -> + return $ if r == 0 then False else True + +version :: BS8.ByteString +version = c'MPD_VERSION + +testBool + :: (CMpd -> IO CInt) + -> Dec + -> Bool +testBool f d = unsafePerformIO $ + withDec d $ \pd -> + f pd >>= \bl -> + return (toBool bl) + +isFinite :: Dec -> Bool +isFinite = testBool c'mpd_isfinite + +isInfinite :: Dec -> Bool +isInfinite = testBool c'mpd_isinfinite + +isNaN :: Dec -> Bool +isNaN = testBool c'mpd_isnan + +isNegative :: Dec -> Bool +isNegative = testBool c'mpd_isnegative + +isPositive :: Dec -> Bool +isPositive = testBool c'mpd_ispositive + +isSigned :: Dec -> Bool +isSigned = testBool c'mpd_issigned + +isQNaN :: Dec -> Bool +isQNaN = testBool c'mpd_isqnan + +isSNaN :: Dec -> Bool +isSNaN = testBool c'mpd_issnan + +isSpecial :: Dec -> Bool +isSpecial = testBool c'mpd_isspecial + +isZero :: Dec -> Bool +isZero = testBool c'mpd_iszero + +isZeroCoeff :: Dec -> Bool +isZeroCoeff = testBool c'mpd_iszerocoeff + +isOddCoeff :: Dec -> Bool +isOddCoeff = testBool c'mpd_isoddcoeff + +data Sign = Sign0 | Sign1 + deriving (Eq, Ord, Show) + +sign :: Dec -> Sign +sign d = unsafePerformIO $ + withDec d $ \pd -> + c'mpd_sign pd >>= \i -> + return $ if i == 0 then Sign0 else Sign1 + +data EvenOdd = Even | Odd + deriving (Eq, Show) + +evenOdd :: Dec -> (Maybe EvenOdd) +evenOdd d = unsafePerformIO $ + withDec d $ \pd -> + c'mpd_isinteger pd >>= \isint -> + if isint /= 0 + then c'mpd_isodd pd >>= \oddR -> + return $ if oddR == 0 then Just Even else Just Odd + else return Nothing + diff --git a/lib/Deka/Internal/Mpdec.hsc b/lib/Deka/Internal/Mpdec.hsc new file mode 100644 --- /dev/null +++ b/lib/Deka/Internal/Mpdec.hsc @@ -0,0 +1,838 @@ +{-# LANGUAGE EmptyDataDecls, Safe #-} +{-# LANGUAGE OverloadedStrings #-} +#include + +#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) + +module Deka.Internal.Mpdec + ( + -- * Context + Signed + , Unsigned + , C'mpd_context_t + , c'MPD_VERSION + , c'MPD_SSIZE_MAX + , c'MPD_SSIZE_MIN + , c'MPD_MAX_PREC + , c'MPD_MAX_EMAX + , c'MPD_MIN_EMIN + , c'MPD_ROUND_UP + , c'MPD_ROUND_DOWN + , c'MPD_ROUND_CEILING + , c'MPD_ROUND_FLOOR + , c'MPD_ROUND_HALF_UP + , c'MPD_ROUND_HALF_DOWN + , c'MPD_ROUND_HALF_EVEN + , c'MPD_ROUND_05UP + , c'MPD_ROUND_TRUNC + , c'mpd_context_t'sizeOf + , p'mpd_context_t'prec + , p'mpd_context_t'emax + , p'mpd_context_t'emin + , p'mpd_context_t'traps + , p'mpd_context_t'status + , p'mpd_context_t'newtrap + , p'mpd_context_t'round + , p'mpd_context_t'clamp + , p'mpd_context_t'allcr + , c'MPD_Clamped + , c'MPD_Conversion_syntax + , c'MPD_Division_by_zero + , c'MPD_Division_impossible + , c'MPD_Division_undefined + , c'MPD_Fpu_error + , c'MPD_Inexact + , c'MPD_Invalid_context + , c'MPD_Invalid_operation + , c'MPD_Malloc_error + , c'MPD_Not_implemented + , c'MPD_Overflow + , c'MPD_Rounded + , c'MPD_Subnormal + , c'MPD_Underflow + , c'mpd_maxcontext + , c'mpd_defaultcontext + , c'mpd_basiccontext + , c'mpd_ieee_context + + -- * Mpdec + , CMpd + , Mpd + , Dec + , withDec + , newDec + , newDec2 + , c'divmod + , c'mpd_fma + , c'mpd_powmod + , c'mpd_adjexp + , capitalize + , c'mpd_to_sci + , c'mpd_to_eng + , c'mpd_set_string + , c'mpd_compare_total + , c'mpd_cmp_total + , c'mpd_compare_total_mag + , c'mpd_cmp_total_mag + , c'mpd_same_quantum + , c'mpd_class + , c'mpd_isnormal + , c'mpd_issubnormal + , c'mpd_sign + , c'mpd_arith_sign + , c'mpd_trail_zeros + , c'mpd_del + , c'mpd_copy + , c'mpd_copy_abs + , c'mpd_copy_negate + , c'mpd_invert + , c'mpd_logb + , c'mpd_abs + , c'mpd_exp + , c'mpd_ln + , c'mpd_log10 + , c'mpd_minus + , c'mpd_next_minus + , c'mpd_next_plus + , c'mpd_plus + , c'mpd_reduce + , c'mpd_round_to_intx + , c'mpd_round_to_int + , c'mpd_trunc + , c'mpd_floor + , c'mpd_ceil + , c'mpd_sqrt + , c'mpd_invroot + , c'mpd_and + , c'mpd_copy_sign + , c'mpd_or + , c'mpd_rotate + , c'mpd_scaleb + , c'mpd_shift + , c'mpd_xor + , c'mpd_compare + , c'mpd_compare_signal + , c'mpd_add + , c'mpd_sub + , c'mpd_div + , c'mpd_divint + , c'mpd_max + , c'mpd_max_mag + , c'mpd_min + , c'mpd_min_mag + , c'mpd_mul + , c'mpd_next_toward + , c'mpd_pow + , c'mpd_quantize + , c'mpd_rescale + , c'mpd_rem + , c'mpd_rem_near + , c'mpd_isfinite + , c'mpd_isinfinite + , c'mpd_isinteger + , c'mpd_isnan + , c'mpd_isnegative + , c'mpd_ispositive + , c'mpd_isqnan + , c'mpd_issnan + , c'mpd_issigned + , c'mpd_isspecial + , c'mpd_iszero + , c'mpd_iszerocoeff + , c'mpd_isoddcoeff + , c'mpd_isodd + , c'mpd_iseven + ) where + +import Foreign.Safe +import Foreign.C +import Control.Monad +import Data.String + +c'MPD_VERSION :: IsString a => a +c'MPD_VERSION = #const_str MPD_VERSION + +-- | An unsigned integer. Its size is platform dependent. +type Unsigned = #type mpd_size_t + +-- | A signed integer. Its size is platform dependent. +type Signed = #type mpd_ssize_t + +c'MPD_SSIZE_MAX :: Signed +c'MPD_SSIZE_MAX = #const MPD_SSIZE_MAX + +-- Must convert the constant to an Integer first; it will overflow +-- otherwise. GHC's NegativeLiterals extension solves this problem, +-- but it is not available on GHC < 7.8. +c'MPD_SSIZE_MIN :: Signed +c'MPD_SSIZE_MIN = fromInteger $ #const MPD_SSIZE_MIN + +c'MPD_MAX_PREC :: Signed +c'MPD_MAX_PREC = #const MPD_MAX_PREC + +c'MPD_MAX_EMAX :: Signed +c'MPD_MAX_EMAX = #const MPD_MAX_EMAX + +c'MPD_MIN_EMIN :: Signed +c'MPD_MIN_EMIN = #const MPD_MIN_EMIN + +c'MPD_ROUND_UP :: CInt +c'MPD_ROUND_UP = #const MPD_ROUND_UP + +c'MPD_ROUND_DOWN :: CInt +c'MPD_ROUND_DOWN = #const MPD_ROUND_DOWN + +c'MPD_ROUND_CEILING :: CInt +c'MPD_ROUND_CEILING = #const MPD_ROUND_CEILING + +c'MPD_ROUND_FLOOR :: CInt +c'MPD_ROUND_FLOOR = #const MPD_ROUND_FLOOR + +c'MPD_ROUND_HALF_UP :: CInt +c'MPD_ROUND_HALF_UP = #const MPD_ROUND_HALF_UP + +c'MPD_ROUND_HALF_DOWN :: CInt +c'MPD_ROUND_HALF_DOWN = #const MPD_ROUND_HALF_DOWN + +c'MPD_ROUND_HALF_EVEN :: CInt +c'MPD_ROUND_HALF_EVEN = #const MPD_ROUND_HALF_EVEN + +c'MPD_ROUND_05UP :: CInt +c'MPD_ROUND_05UP = #const MPD_ROUND_05UP + +c'MPD_ROUND_TRUNC :: CInt +c'MPD_ROUND_TRUNC = #const MPD_ROUND_TRUNC + +data C'mpd_context_t + +c'mpd_context_t'sizeOf :: Int +c'mpd_context_t'sizeOf = #size mpd_context_t + +p'mpd_context_t'prec :: Ptr C'mpd_context_t -> Ptr Signed +p'mpd_context_t'prec = #ptr mpd_context_t, prec + +p'mpd_context_t'emax :: Ptr C'mpd_context_t -> Ptr Signed +p'mpd_context_t'emax = #ptr mpd_context_t, emax + +p'mpd_context_t'emin :: Ptr C'mpd_context_t -> Ptr Signed +p'mpd_context_t'emin = #ptr mpd_context_t, emin + +p'mpd_context_t'traps :: Ptr C'mpd_context_t -> Ptr Word32 +p'mpd_context_t'traps = #ptr mpd_context_t, traps + +p'mpd_context_t'status :: Ptr C'mpd_context_t -> Ptr Word32 +p'mpd_context_t'status = #ptr mpd_context_t, status + +p'mpd_context_t'newtrap :: Ptr C'mpd_context_t -> Ptr Word32 +p'mpd_context_t'newtrap = #ptr mpd_context_t, newtrap + +p'mpd_context_t'round :: Ptr C'mpd_context_t -> Ptr CInt +p'mpd_context_t'round = #ptr mpd_context_t, round + +p'mpd_context_t'clamp :: Ptr C'mpd_context_t -> Ptr CInt +p'mpd_context_t'clamp = #ptr mpd_context_t, clamp + +p'mpd_context_t'allcr :: Ptr C'mpd_context_t -> Ptr CInt +p'mpd_context_t'allcr = #ptr mpd_context_t, allcr + +c'MPD_Clamped :: Word32 +c'MPD_Clamped = #const MPD_Clamped + +c'MPD_Conversion_syntax :: Word32 +c'MPD_Conversion_syntax = #const MPD_Conversion_syntax + +c'MPD_Division_by_zero :: Word32 +c'MPD_Division_by_zero = #const MPD_Division_by_zero + +c'MPD_Division_impossible :: Word32 +c'MPD_Division_impossible = #const MPD_Division_impossible + +c'MPD_Division_undefined :: Word32 +c'MPD_Division_undefined = #const MPD_Division_undefined + +c'MPD_Fpu_error :: Word32 +c'MPD_Fpu_error = #const MPD_Fpu_error + +c'MPD_Inexact :: Word32 +c'MPD_Inexact = #const MPD_Inexact + +c'MPD_Invalid_context :: Word32 +c'MPD_Invalid_context = #const MPD_Invalid_context + +c'MPD_Invalid_operation :: Word32 +c'MPD_Invalid_operation = #const MPD_Invalid_operation + +c'MPD_Malloc_error :: Word32 +c'MPD_Malloc_error = #const MPD_Malloc_error + +c'MPD_Not_implemented :: Word32 +c'MPD_Not_implemented = #const MPD_Not_implemented + +c'MPD_Overflow :: Word32 +c'MPD_Overflow = #const MPD_Overflow + +c'MPD_Rounded :: Word32 +c'MPD_Rounded = #const MPD_Rounded + +c'MPD_Subnormal :: Word32 +c'MPD_Subnormal = #const MPD_Subnormal + +c'MPD_Underflow :: Word32 +c'MPD_Underflow = #const MPD_Underflow + +foreign import ccall unsafe "mpd_maxcontext" c'mpd_maxcontext + :: Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_defaultcontext" c'mpd_defaultcontext + :: Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_basiccontext" c'mpd_basiccontext + :: Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_ieee_context" c'mpd_ieee_context + :: Ptr C'mpd_context_t + -> CInt + -> IO CInt + +-- +-- mpd_t +-- + +data C'mpd_t + +newtype CMpd = CMpd { _unCMpd :: Ptr C'mpd_t } +newtype Mpd = Mpd { unMpd :: Ptr C'mpd_t } + +-- | A decimal value. A decimal consists of: +-- +-- * an integral /coefficient/, +-- +-- * an /exponent/, and +-- +-- * a /sign/. +-- +-- A decimal may also be a /special value/, which can be: +-- +-- * /NaN/ (Not a Number), which may be either /quiet/ +-- (propagates quietly through operations) or /signaling/ (raises +-- the /Invalid operation/ condition when encountered), or +-- +-- * /Infinity/, either positive or negative. + +newtype Dec = Dec { _unDec :: ForeignPtr C'mpd_t } + +withDec :: Dec -> (CMpd -> IO a) -> IO a +withDec (Dec fp) f = + withForeignPtr fp $ \ptr -> + f (CMpd ptr) + +-- Irregular arithmetics + +foreign import ccall unsafe "mpd_divmod" c'divmod + :: Mpd + -> Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_fma" c'mpd_fma + :: Mpd + -> CMpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_powmod" c'mpd_powmod + :: Mpd + -> CMpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_adjexp" c'mpd_adjexp + :: CMpd + -> IO Signed + +-- Output to string + +foreign import ccall unsafe "mpd_to_sci" c'mpd_to_sci + :: CMpd + -> CInt + -> IO (Ptr CChar) + +-- | Set to 1 to capitalize the exponent character; otherwise, if it +-- is 0, the exponent character is lower case. +capitalize :: CInt +capitalize = 1 + +foreign import ccall unsafe "mpd_to_eng" c'mpd_to_eng + :: CMpd + -> CInt + -> IO (Ptr CChar) + +foreign import ccall unsafe "mpd_set_string" c'mpd_set_string + :: Mpd + -> Ptr CChar + -> Ptr C'mpd_context_t + -> IO () + +-- comparisons + +-- compare_total is context free +foreign import ccall unsafe "mpd_compare_total" c'mpd_compare_total + :: Mpd + -> CMpd + -> CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_cmp_total" c'mpd_cmp_total + :: CMpd + -> CMpd + -> IO CInt + +-- total_mag is context free +foreign import ccall unsafe "mpd_compare_total_mag" c'mpd_compare_total_mag + :: Mpd + -> CMpd + -> CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_cmp_total_mag" c'mpd_cmp_total_mag + :: CMpd + -> CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_same_quantum" c'mpd_same_quantum + :: CMpd + -> CMpd + -> IO CInt + +-- Tests + +foreign import ccall unsafe "mpd_class" c'mpd_class + :: CMpd + -> Ptr C'mpd_context_t + -> IO (Ptr CChar) + +foreign import ccall unsafe "mpd_isnormal" c'mpd_isnormal + :: CMpd + -> Ptr C'mpd_context_t + -> IO CInt + +foreign import ccall unsafe "mpd_issubnormal" c'mpd_issubnormal + :: CMpd + -> Ptr C'mpd_context_t + -> IO CInt + +foreign import ccall unsafe "mpd_sign" c'mpd_sign + :: CMpd + -> IO Word8 + +foreign import ccall unsafe "mpd_arith_sign" c'mpd_arith_sign + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_trail_zeros" c'mpd_trail_zeros + :: CMpd + -> IO Signed + +-- Memory handling +foreign import ccall unsafe "mpd_qnew" c'mpd_qnew + :: IO (Mpd) + +newDec :: (Mpd -> IO ()) -> IO Dec +newDec f = do + p <- c'mpd_qnew + when (unMpd p == nullPtr) $ error "newMpd: failure" + fp <- newForeignPtr fp'mpd_del (unMpd p) + withForeignPtr fp $ \x1 -> + f (Mpd x1) + return $ Dec fp + +newDec2 :: (Mpd -> Mpd -> IO ()) -> IO (Dec, Dec) +newDec2 f = do + p1 <- c'mpd_qnew + when (unMpd p1 == nullPtr) $ error "newMpd: failure" + p2 <- c'mpd_qnew + when (unMpd p2 == nullPtr) $ error "newMpd: failure" + fp1 <- newForeignPtr fp'mpd_del (unMpd p1) + fp2 <- newForeignPtr fp'mpd_del (unMpd p2) + withForeignPtr fp1 $ \x1 -> + withForeignPtr fp2 $ \x2 -> + f (Mpd x1) (Mpd x2) + return (Dec fp1, Dec fp2) + + +foreign import ccall unsafe "mpd_del" c'mpd_del + :: Mpd + -> IO () + +foreign import ccall unsafe "&mpd_del" fp'mpd_del + :: FunPtr (Ptr C'mpd_t -> IO ()) + +-- Imported from mkmpd + +foreign import ccall unsafe "mpd_copy" c'mpd_copy + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_copy_abs" c'mpd_copy_abs + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_copy_negate" c'mpd_copy_negate + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_invert" c'mpd_invert + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_logb" c'mpd_logb + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_abs" c'mpd_abs + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_exp" c'mpd_exp + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_ln" c'mpd_ln + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_log10" c'mpd_log10 + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_minus" c'mpd_minus + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_next_minus" c'mpd_next_minus + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_next_plus" c'mpd_next_plus + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_plus" c'mpd_plus + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_reduce" c'mpd_reduce + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_round_to_intx" c'mpd_round_to_intx + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_round_to_int" c'mpd_round_to_int + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_trunc" c'mpd_trunc + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_floor" c'mpd_floor + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_ceil" c'mpd_ceil + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_sqrt" c'mpd_sqrt + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_invroot" c'mpd_invroot + :: Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + + +foreign import ccall unsafe "mpd_and" c'mpd_and + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_copy_sign" c'mpd_copy_sign + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_or" c'mpd_or + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_rotate" c'mpd_rotate + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_scaleb" c'mpd_scaleb + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_shift" c'mpd_shift + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_xor" c'mpd_xor + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_compare" c'mpd_compare + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_compare_signal" c'mpd_compare_signal + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_add" c'mpd_add + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_sub" c'mpd_sub + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_div" c'mpd_div + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_divint" c'mpd_divint + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_max" c'mpd_max + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_max_mag" c'mpd_max_mag + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_min" c'mpd_min + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_min_mag" c'mpd_min_mag + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_mul" c'mpd_mul + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_next_toward" c'mpd_next_toward + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_pow" c'mpd_pow + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_quantize" c'mpd_quantize + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_rescale" c'mpd_rescale + :: Mpd + -> CMpd + -> Signed + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_rem" c'mpd_rem + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_rem_near" c'mpd_rem_near + :: Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +foreign import ccall unsafe "mpd_isfinite" c'mpd_isfinite + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isinfinite" c'mpd_isinfinite + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isinteger" c'mpd_isinteger + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isnan" c'mpd_isnan + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isnegative" c'mpd_isnegative + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_ispositive" c'mpd_ispositive + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isqnan" c'mpd_isqnan + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_issnan" c'mpd_issnan + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_issigned" c'mpd_issigned + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isspecial" c'mpd_isspecial + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_iszero" c'mpd_iszero + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_iszerocoeff" c'mpd_iszerocoeff + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isoddcoeff" c'mpd_isoddcoeff + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_isodd" c'mpd_isodd + :: CMpd + -> IO CInt + +foreign import ccall unsafe "mpd_iseven" c'mpd_iseven + :: CMpd + -> IO CInt + +-- Handlers + + diff --git a/lib/Deka/Internal/Unsafe.hs b/lib/Deka/Internal/Unsafe.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Internal/Unsafe.hs @@ -0,0 +1,19 @@ +module Deka.Internal.Unsafe where + +import System.IO.Unsafe (unsafePerformIO) + +unsafe0 :: IO a -> a +unsafe0 = unsafePerformIO + +unsafe1 :: (a -> IO b) -> a -> b +unsafe1 f a = unsafePerformIO (f a) + +unsafe2 :: (a -> b -> IO c) -> a -> b -> c +unsafe2 f a b = unsafePerformIO (f a b) + +unsafe3 :: (a -> b -> c -> IO d) -> a -> b -> c -> d +unsafe3 f a b c = unsafePerformIO (f a b c) + +unsafe4 :: (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> e +unsafe4 f a b c d = unsafePerformIO (f a b c d) + diff --git a/lib/Deka/Internal/Util/Ctx.hs b/lib/Deka/Internal/Util/Ctx.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Internal/Util/Ctx.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE Safe #-} +module Deka.Internal.Util.Ctx where + +import Deka.Internal.Mpdec +import Deka.Internal.Context +import Foreign.Safe + +type Unary + = Mpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +unary :: Unary -> Dec -> Ctx Dec +unary f d = Ctx $ \p -> + newDec $ \nw -> + withDec d $ \old -> + f nw old p + +type Binary + = Mpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +binary :: Binary -> Dec -> Dec -> Ctx Dec +binary f a b = Ctx $ \p -> + newDec $ \nw -> + withDec a $ \pa -> + withDec b $ \pb -> + f nw pa pb p + +type Ternary + = Mpd + -> CMpd + -> CMpd + -> CMpd + -> Ptr C'mpd_context_t + -> IO () + +ternary :: Ternary -> Dec -> Dec -> Dec -> Ctx Dec +ternary f a b c = Ctx $ \p -> + newDec $ \n -> + withDec a $ \pa -> + withDec b $ \pb -> + withDec c $ \pc -> + f n pa pb pc p diff --git a/lib/Deka/Native.hs b/lib/Deka/Native.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Native.hs @@ -0,0 +1,88 @@ +-- | Representation of numbers in native Haskell types. +-- +-- Since deka is a binding to the mpdecimal C library, the data +-- types are held as pointers to data which are managed by C +-- functions. Therefore there is no direct access to what is inside +-- of the the 'Deka.Dec' data type. Modules in "Deka.Native" +-- provide Haskell types mirroring the abstract representations +-- given in the General Decimal Arithmetic Specification. This is +-- useful if you want to manipulate the data in an abstract way. +-- For example, perhaps you want to perform arithmetic on a value, +-- transform it to abstract form, add digit grouping characters, and +-- then use your own functions to pretty print the result. +-- +-- The General Decimal Arithmetic Specification gives an abstract +-- representation of each number. This information is taken from +-- the General Decimal Arithmetic specification at +-- +-- +-- +-- A number may be /finite/, in +-- which case it has three components: a /sign/, which must be zero +-- (for zero or positive numbers) or one (for negative zero and +-- negative numbers), an integral /coefficient/, which is always +-- zero or positive, and a signed integral /exponent/, which +-- indicates the power of ten by which the number is multiplied. +-- The value of a finite number if given by +-- +-- > (-1) ^ sign * coefficient * 10 ^ exponent +-- +-- In addition to finite numbers, a number may also be one of three +-- /special values/: +-- +-- * /infinity/ - numbers infinitely large in magnitude +-- +-- * /quiet NaN/ - an undefined result which does not cause an +-- 'invalidOperation' condition. +-- +-- * /signaling NaN/ - an undefined result which will usually cause +-- an 'invalidOperation' condition. +-- +-- When a number has one of these special values, its /coefficient/ +-- and /exponent/ are undefined. An NaN, however, may have +-- additional /diagnostic information/, which is a positive integer. +-- +-- All special values have a sign. The sign of an infinity is +-- significant. The sign of an NaN has no meaning, though it may be +-- considered as part of the diagnostic information. +-- +-- You can transform an abstract form to a 'Dec' losslessly by using +-- 'abstractToByteString'. This gives you a string in scientific +-- notation, as specified in @to-scientific-string@ in the +-- specification. There is a one-to-one mapping of abstract +-- representations to @scientific-string@ representations. You can +-- also transform a 'Dec' to an 'Abstract' losslessly by using +-- 'abstractFromByteString'. This operation will not fail if it is +-- using output from 'toByteString'; but it might fail otherwise, if +-- the input is malformed. +-- +-- All standard typeclass instances in these modules are derived; so +-- while the 'Ord' instance might be useful to use 'Abstract' as the +-- key in a Map, don't expect it to tell you anything about how +-- 'Abstract' are situated on the number line. +module Deka.Native + ( -- * Digits and groups of digits + Novem(..) + , Decem(..) + , Decuple(..) + , Aut(..) + , Firmado(..) + + -- * Elements of abstract numbers + , Coefficient(..) + , Exponent(..) + , Diagnostic(..) + , Noisy(..) + , NonNum(..) + , Value(..) + , Abstract(..) + + -- * Transformations + , abstractToString + , abstractToDec + , stringToAbstract + , decToAbstract + ) where + +import Deka.Native.Abstract +import Deka.Native.FromString (stringToAbstract, decToAbstract) diff --git a/lib/Deka/Native/Abstract.hs b/lib/Deka/Native/Abstract.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Native/Abstract.hs @@ -0,0 +1,330 @@ +{-# LANGUAGE OverloadedStrings, BangPatterns #-} + +module Deka.Native.Abstract where + +import Deka.Dec +import Prelude hiding (exponent) +import Control.Monad +import Data.List (foldl') +import qualified Data.ByteString.Char8 as BS8 + +-- # Types + +-- | A digit from one to nine. Useful to represent a most +-- significant digit, or MSD, as an MSD cannot be the digit zero. +data Novem = D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 + deriving (Eq, Ord, Show, Enum, Bounded) + +novemToChar :: Novem -> Char +novemToChar n = case n of + { D1 -> '1'; D2 -> '2'; D3 -> '3'; D4 -> '4'; D5 -> '5'; + D6 -> '6'; D7 -> '7'; D8 -> '8'; D9 -> '9' } + +charToNovem :: Char -> Maybe Novem +charToNovem c = case c of + { '1' -> Just D1; '2' -> Just D2; '3' -> Just D3; + '4' -> Just D4; '5' -> Just D5; '6' -> Just D6; '7' -> Just D7; + '8' -> Just D8; '9' -> Just D9; _ -> Nothing } + +novemToInt :: Integral a => Novem -> a +novemToInt d = case d of + { D1 -> 1; D2 -> 2; D3 -> 3; D4 -> 4; D5 -> 5; D6 -> 6; + D7 -> 7; D8 -> 8; D9 -> 9 } + +intToNovem :: Integral a => a -> Maybe Novem +intToNovem a = case a of + { 1 -> Just D1; 2 -> Just D2; 3 -> Just D3; 4 -> Just D4; + 5 -> Just D5; 6 -> Just D6; + 7 -> Just D7; 8 -> Just D8; 9 -> Just D9; _ -> Nothing } + +-- | A digit from zero to nine. +data Decem + = D0 + | Nonem Novem + deriving (Eq, Ord, Show) + +decemToChar :: Decem -> Char +decemToChar d = case d of + { D0 -> '0'; Nonem n -> novemToChar n } + +charToDecem :: Char -> Maybe Decem +charToDecem c = case c of + { '0' -> Just D0; _ -> fmap Nonem (charToNovem c) } + +decemToInt :: Integral a => Decem -> a +decemToInt d = case d of + { D0 -> 0; Nonem n -> novemToInt n } + +decemToNovem :: Decem -> Maybe Novem +decemToNovem d = case d of + Nonem n -> Just n + _ -> Nothing + +intToDecem :: Integral a => a -> Maybe Decem +intToDecem i = case i of + { 0 -> Just D0; _ -> fmap Nonem $ intToNovem i } + +intToDecemList :: Integral a => a -> (Sign, [Decem]) +intToDecemList x = (sgn, ls) + where + sgn | x < 0 = Sign1 + | otherwise = Sign0 + ls = reverse . go . Prelude.abs $ x + go !i = + let (d, m) = i `divMod` 10 + r = maybe (error "intToDecemList: error") id + . intToDecem $ m + in if i == 0 + then [] + else r : go d + +decemListToInt :: Integral a => [Decem] -> a +decemListToInt ds = foldl' f 0 . indices $ ds + where + indices = zip (iterate pred (length ds - 1)) + f acc (ix, d) = acc + decemToInt d * 10 ^ ix + +-- | A non-empty set of digits. The MSD must be from 1 to 9. + +data Decuple = Decuple Novem [Decem] + deriving (Eq, Ord, Show) + +decupleToString :: Decuple -> String +decupleToString (Decuple msd rest) = + novemToChar msd : map decemToChar rest + +stringToDecuple :: String -> Maybe Decuple +stringToDecuple str = case str of + [] -> Nothing + x:xs -> liftM2 Decuple (charToNovem x) (mapM charToDecem xs) + +decupleToInt :: Integral a => Decuple -> a +decupleToInt (Decuple n ds) = + let len = length ds + go !soFar !i digs = case digs of + [] -> soFar + x:xs -> + let nxt = i - 1 + thisSum = soFar + decemToInt x * 10 ^ nxt + in go thisSum nxt xs + in novemToInt n * (10 ^ len) + go 0 len ds + +uncons :: [a] -> Maybe (a, [a]) +uncons a = case a of + [] -> Nothing + x:xs -> Just (x, xs) + +intToDecuple :: Integral a => a -> Maybe (Sign, Decuple) +intToDecuple x = do + let (sgn, ds) = intToDecemList x + (d1, dr) <- uncons ds + let nv = maybe (error "intToDecuple: MSD is not zero") id + . decemToNovem $ d1 + return (sgn, Decuple nv dr) + +decemListToDecuple :: [Decem] -> Maybe Decuple +decemListToDecuple ds = case dropWhile (== D0) ds of + [] -> Nothing + x:xs -> Just $ Decuple d1 xs + where + d1 = maybe (error "decemListToDecuple: bad MSD") id + . decemToNovem $ x + + +-- | Either a set of digits, or zero. Unsigned. + +data Aut + = Nil + -- ^ Zero + | Plenus Decuple + -- ^ Non-zero + deriving (Eq, Ord, Show) + +autToString :: Aut -> String +autToString a = case a of + Nil -> "0" + Plenus ds -> decupleToString ds + +stringToAut :: String -> Maybe Aut +stringToAut s = case s of + "0" -> Just Nil + _ -> fmap Plenus $ stringToDecuple s + +autToInt :: Integral a => Aut -> a +autToInt a = case a of + Nil -> 0 + Plenus d -> decupleToInt d + +-- | Fails if the argument is less than zero. +intToAut :: Integral a => a -> Maybe Aut +intToAut a = case intToDecuple a of + Nothing -> Just Nil + Just (s, d) -> case s of + Sign1 -> Nothing + _ -> return . Plenus $ d + +decemListToAut :: [Decem] -> Aut +decemListToAut ds = case dropWhile (== D0) ds of + [] -> Nil + x:xs -> Plenus $ Decuple d1 xs + where + d1 = maybe (error "decemListToAut: bad MSD") id + . decemToNovem $ x + +-- | Either a set of digits, or zero. Signed. + +data Firmado + = Cero + -- ^ Zero + | Completo PosNeg Decuple + -- ^ Non-zero + deriving (Eq, Ord, Show) + +firmadoToString :: Firmado -> String +firmadoToString x = case x of + Cero -> "0" + Completo p d -> sgn : decupleToString d + where + sgn = case p of { Pos -> '+'; Neg -> '-' } + +stringToFirmado :: String -> Maybe Firmado +stringToFirmado s + | s == "0" = Just Cero + | otherwise = do + (sgn, rst) <- case s of + "" -> Nothing + x:xs -> case x of + '+' -> return (Pos, xs) + '-' -> return (Neg, xs) + _ -> Nothing + dec <- stringToDecuple rst + return $ Completo sgn dec + +firmadoToInt :: Integral a => Firmado -> a +firmadoToInt x = case x of + Cero -> 0 + Completo p d -> apply . decupleToInt $ d + where + apply = case p of { Pos -> id; Neg -> negate } + +intToFirmado :: Integral a => a -> Firmado +intToFirmado i = case intToDecuple i of + Nothing -> Cero + Just (sgn, d) -> Completo p d + where + p = case sgn of { Sign0 -> Pos; Sign1 -> Neg } + + +-- +-- Types in Abstract +-- + +-- | The coefficient in a number; not used in infinities or NaNs. +newtype Coefficient = Coefficient { unCoefficient :: Aut } + deriving (Eq, Ord, Show) + +-- | The exponent in a number. +newtype Exponent = Exponent { unExponent :: Firmado } + deriving (Eq, Ord, Show) + +-- | The diagnostic information in an NaN. +newtype Diagnostic = Diagnostic { unDiagnostic :: Decuple } + deriving (Eq, Ord, Show) + +-- | Whether an NaN is quiet or signaling. +data Noisy = Quiet | Signaling + deriving (Eq, Ord, Show) + +-- | Not a Number. +data NonNum = NonNum + { noisy :: Noisy + , diagnostic :: Maybe Diagnostic + } deriving (Eq, Ord, Show) + +-- | All data in an abstract number except for the sign. +data Value + = Finite Coefficient Exponent + | Infinite + | NotANumber NonNum + deriving (Eq, Ord, Show) + +-- | Abstract representation of all numbers covered by the General +-- Decimal Arithmetic Specification. +data Abstract = Abstract + { sign :: Sign + , value :: Value + } deriving (Eq, Ord, Show) + +signToString :: Sign -> String +signToString s = case s of + Sign0 -> "" + Sign1 -> "-" + +-- | Adjusted exponent. Roughly speaking this represents the +-- coefficient and exponent of an abstract decimal, adjusted so +-- there is a decimal point between the most significant digit of +-- the coefficient and the remaning digits. +newtype AdjustedExp = AdjustedExp { unAdjustedExp :: Integer } + deriving (Eq, Ord, Show) + +-- | Computes an adjusted exponent. The length of a zero +-- coefficient is one. +adjustedExp :: Coefficient -> Exponent -> AdjustedExp +adjustedExp coe ex = AdjustedExp $ e + (c - 1) + where + e = firmadoToInt . unExponent $ ex + c = fromIntegral $ case unCoefficient coe of + Nil -> 1 + Plenus (Decuple _ ds) -> length ds + 1 + +fmtAdjustedExp :: AdjustedExp -> String +fmtAdjustedExp (AdjustedExp i) = 'E' : sgn : digs + where + sgn | i < 0 = '-' + | otherwise = '+' + digs = show . Prelude.abs $ i + +finiteToString :: Coefficient -> Exponent -> String +finiteToString c e = coe ++ ae + where + coe = case unCoefficient c of + Nil -> "0" + Plenus (Decuple n ds) + | null ds -> [novemToChar n] + | otherwise -> novemToChar n : '.' : map decemToChar ds + ae = fmtAdjustedExp $ adjustedExp c e + +nanToString :: NonNum -> String +nanToString (NonNum n d) = pfx ++ "NaN" ++ dia + where + pfx = case n of { Quiet -> ""; Signaling -> "s" } + dia = maybe "" (decupleToString . unDiagnostic) d + +fmtValue :: Value -> String +fmtValue v = case v of + Finite c e -> finiteToString c e + Infinite -> "Infinity" + NotANumber n -> nanToString n + +-- | Transform an 'Abstract' to a 'String'. This conforms to the +-- @to-scientific-string@ transformation given in the General +-- Decimal Arithmetic Specification at +-- +-- +-- +-- with one exception: the specification provides that some finite +-- numbers are represented without exponential notation. +-- 'abstractToString' /always/ uses exponential notation on finite +-- numbers. +abstractToString :: Abstract -> String +abstractToString (Abstract s v) = sgn ++ fmtValue v + where + sgn = case s of { Sign0 -> ""; Sign1 -> "-" } + +-- | Transforms an 'Abstract' to a 'Dec'. Result is computed in a +-- context using the 'Pedantic' initializer. Result is returned +-- along with any status flags arising from the computation. +abstractToDec :: Abstract -> (Dec, Flags) +abstractToDec = runCtxStatus . fromByteString + . BS8.pack . abstractToString + diff --git a/lib/Deka/Native/FromString.hs b/lib/Deka/Native/FromString.hs new file mode 100644 --- /dev/null +++ b/lib/Deka/Native/FromString.hs @@ -0,0 +1,227 @@ +-- | Uses the specification for string conversions given in the +-- General Decimal Arithmetic Specification to convert strings to an +-- abstract syntax tree. The specification for string conversions +-- is at +-- +-- +-- +-- The functions and types in this module fall into two groups. The +-- first group converts a string to a 'NumericString', which is an +-- abstract representation of the grammar given in the General +-- Decimal Arithmetic Specification. These functions use Parsec to +-- parse the string. The second group transforms the +-- 'NumericString' to an 'A.Abstract', a form which more closely +-- aligns with the abstract representation given at +-- +-- . +-- +-- You can transform an 'A.Abstract' to a numeric string; no +-- functions are provided to transform a 'NumericString' directly +-- back to a string. +module Deka.Native.FromString where + +import Data.Char (toLower) +import Control.Applicative +import Text.Parsec.String +import Text.Parsec.Prim (tokenPrim, try, parse) +import Text.Parsec.Pos +import Text.Parsec.Char (char, string) +import Text.Parsec.Combinator (many1, eof) +import qualified Deka.Native.Abstract as A +import Deka.Native.Abstract + (Decem(..), Novem(..), decemListToInt) +import Deka.Dec (Sign(..)) +import qualified Deka.Dec as D +import qualified Data.ByteString.Char8 as BS8 + +sign :: Parser Sign +sign = tokenPrim show next f + where + next pos c _ = updatePosChar pos c + f c = case c of + '-' -> Just Sign1 + '+' -> Just Sign0 + _ -> Nothing + +optSign :: Parser Sign +optSign = do + s <- optional sign + return $ maybe Sign0 id s + +digit :: Parser Decem +digit = tokenPrim show next f + where + next pos c _ = updatePosChar pos c + f c = case c of + { '0' -> Just D0; '1' -> Just $ Nonem D1; '2' -> Just $ Nonem D2; + '3' -> Just $ Nonem D3; '4' -> Just $ Nonem D4; + '5' -> Just $ Nonem D5; '6' -> Just $ Nonem D6; + '7' -> Just $ Nonem D7; '8' -> Just $ Nonem D8; + '9' -> Just $ Nonem D9; _ -> Nothing } + +indicator :: Parser () +indicator = () <$ char 'e' + +digits :: Parser [Decem] +digits = many1 digit + +data DecimalPart + = WholeFrac [Decem] [Decem] + | WholeOnly [Decem] + deriving (Eq, Ord, Show) + +decimalPart :: Parser DecimalPart +decimalPart = do + ds1 <- optional digits + case ds1 of + Nothing -> do + _ <- char '.' + fmap WholeOnly digits + Just ds -> do + dot <- optional (char '.') + case dot of + Just _ -> do + ds2 <- many digit + return $ WholeFrac ds ds2 + Nothing -> return $ WholeOnly ds + +data ExponentPart = ExponentPart + { expSign :: Sign + , expDigits :: [Decem] + } deriving (Eq, Ord, Show) + +exponentPart :: Parser ExponentPart +exponentPart = do + indicator + sgn <- optSign + ds <- digits + return $ ExponentPart sgn ds + +infinity :: Parser () +infinity = try $ do + _ <- string "inf" + _ <- optional (string "inity") + return () + +nanId :: Parser A.Noisy +nanId = try (string "nan" >> return A.Quiet) + <|> try (string "snan" >> return A.Signaling) + +data NaN = NaN A.Noisy [Decem] + deriving (Eq, Ord, Show) + +nan :: Parser NaN +nan = liftA2 NaN nanId (many digit) + +data NumericValue + = NVDec DecimalPart (Maybe ExponentPart) + | Infinity + deriving (Eq, Ord, Show) + +numericValue :: Parser NumericValue +numericValue = + (Infinity <$ infinity) + <|> liftA2 NVDec decimalPart (optional exponentPart) + +data NumericString = NumericString + { nsSign :: Sign + , nsValue :: Either NumericValue NaN + } deriving (Eq, Ord, Show) + +numericString :: Parser NumericString +numericString = liftA2 NumericString optSign ei + where + ei = (fmap Left numericValue <|> fmap Right nan) + +parseNumericString :: String -> Either String NumericString +parseNumericString s = + case parse (numericString <* eof) "" (map toLower s) of + Left e -> Left (show e) + Right g -> Right g + +numericStringToAbstract :: NumericString -> A.Abstract +numericStringToAbstract (NumericString sgn ei) = A.Abstract sgn val + where + val = case ei of + Left nv -> case nv of + NVDec dp me -> uncurry A.Finite $ finiteToAbstract dp me + Infinity -> A.Infinite + Right nn -> A.NotANumber . nanToAbstract $ nn + +nanToAbstract + :: NaN + -> A.NonNum +nanToAbstract (NaN nsy ds) = A.NonNum nsy . fmap A.Diagnostic + . A.decemListToDecuple $ ds + +finiteToAbstract + :: DecimalPart + -> Maybe ExponentPart + -> (A.Coefficient, A.Exponent) +finiteToAbstract dp mep = (coe, ex) + where + ex = abstractExponent . actualExponent dp + . givenExponent $ mep + coe = abstractCoeff dp + + +-- | A numeric value for the exponent that was given in the input +-- string. + +givenExponent :: Maybe ExponentPart -> Integer +givenExponent me = case me of + Nothing -> 0 + Just (ExponentPart s ds) -> getSgn $ decemListToInt ds + where + getSgn = case s of + Sign0 -> id + Sign1 -> negate + +-- | The number of digits after the decimal point, subtracted from +-- the numeric value for the exponent given in the string + +actualExponent + :: DecimalPart + -> Integer + -- ^ Output from 'givenExponent' + -> Integer +actualExponent d i = case d of + WholeFrac _ ds -> i - fromIntegral (length ds) + _ -> i + +-- The value of the abstract exponent. + +abstractExponent + :: Integer + -- ^ The output from 'actualExponent' + -> A.Exponent +abstractExponent = A.Exponent . A.intToFirmado + +abstractCoeff :: DecimalPart -> A.Coefficient +abstractCoeff d = + let ds = case d of + WholeFrac d1 d2 -> d1 ++ d2 + WholeOnly d1 -> d1 + in A.Coefficient $ A.decemListToAut ds + +stringToAbstract + + :: String + -- ^ Input string + + -> Either String A.Abstract + -- ^ Returns a Right with the abstract representation of the input + -- string, if the input conformed to the numeric string + -- specification given in the General Decimal Arithmetic + -- Specification. Otherwise, returns a Left with an error + -- message. + +stringToAbstract = fmap numericStringToAbstract . parseNumericString + +-- | Transforms a 'Dec' to an 'Abstract'. +decToAbstract :: D.Dec -> A.Abstract +decToAbstract = either (error msg) id . stringToAbstract + . BS8.unpack . D.toByteString + where + msg = "decToAbstract: error: could not parse output from " + ++ "toByteString" diff --git a/minimum-versions.txt b/minimum-versions.txt --- a/minimum-versions.txt +++ b/minimum-versions.txt @@ -1,11 +1,11 @@ This package was tested to work with these dependency versions and compiler version. These are the minimum versions given in the .cabal file. -Tested as of: 2014-04-17 19:37:00.007331 UTC +Tested as of: 2014-05-20 16:07:05.864819 UTC Path to compiler: ghc-7.4.1 Compiler description: 7.4.1 -/var/lib/ghc/package.conf.d: +/opt/ghc/7.4.1/lib/ghc-7.4.1/package.conf.d: Cabal-1.14.0 array-0.4.0.0 base-4.5.0.0 @@ -33,35 +33,27 @@ time-1.4 unix-2.5.1.0 -/home/massysett/deka/sunlight-20121/db: - MonadRandom-0.1.13 - QuickCheck-2.6 +/home/massysett/deka/sunlight-730/db: + QuickCheck-2.7.3 ansi-terminal-0.6.1.1 ansi-wl-pprint-0.6.7.1 - base-unicode-symbols-0.2.2.4 - comonad-4.0.1 - contravariant-0.4.4 - deka-0.4.0.4 - distributive-0.4.3.1 - either-4.1.1 - hashable-1.2.1.0 - monad-control-0.3.2.3 + async-2.0.1.5 + deka-0.6.0.0 + mmorph-1.0.3 mtl-2.1.3.1 - nats-0.1.2 - optparse-applicative-0.8.0.1 - parsec-3.1.5 + optparse-applicative-0.8.1 + parsec-3.1.2 + pipes-4.1.1 + primitive-0.5.3.0 random-1.0.1.1 regex-base-0.93.2 regex-tdfa-1.2.0 - semigroupoids-4.0.1 - semigroups-0.13.0.1 stm-2.4.3 - tagged-0.7.1 - tasty-0.7 - tasty-quickcheck-0.3.1 - text-1.1.0.1 + tagged-0.7.2 + tasty-0.8.0.4 + tasty-quickcheck-0.8.0.3 + text-0.11.3.1 + tf-random-0.5 transformers-0.3.0.0 - transformers-base-0.4.1 - transformers-compat-0.1.1.1 - unordered-containers-0.2.4.0 + unbounded-delays-0.1.0.7 diff --git a/native/AllModules.hs b/native/AllModules.hs new file mode 100644 --- /dev/null +++ b/native/AllModules.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +module AllModules where + +import Generators +import Properties diff --git a/native/Generators.hs b/native/Generators.hs new file mode 100644 --- /dev/null +++ b/native/Generators.hs @@ -0,0 +1,58 @@ +-- | Generators of native data types. + +module Generators where + +import Control.Applicative +import Test.QuickCheck +import qualified Deka.Native as D +import qualified Deka.Dec as Dec +import Prelude hiding (exponent) + +novem :: Gen D.Novem +novem = elements [minBound..maxBound] + +decem :: Gen D.Decem +decem = frequency [(1, return D.D0), (9, fmap D.Nonem novem)] + +decuple :: Gen D.Decuple +decuple = D.Decuple <$> novem <*> listOf decem + +aut :: Gen D.Aut +aut = frequency [(1, return D.Nil), (4, fmap D.Plenus decuple)] + +posNeg :: Gen Dec.PosNeg +posNeg = elements [Dec.Pos, Dec.Neg] + +firmado :: Gen D.Firmado +firmado = frequency [(1, return D.Cero) + , (4, D.Completo <$> posNeg <*> decuple)] + +coefficient :: Gen D.Coefficient +coefficient = fmap D.Coefficient aut + +exponent :: Gen D.Exponent +exponent = fmap D.Exponent firmado + +diagnostic :: Gen D.Diagnostic +diagnostic = fmap D.Diagnostic decuple + +noisy :: Gen D.Noisy +noisy = elements [D.Quiet, D.Signaling] + +nonNum :: Gen D.NonNum +nonNum = D.NonNum + <$> noisy + <*> frequency [(1, return Nothing), (3, fmap Just diagnostic)] + +value :: Gen D.Value +value = frequency + [ (4, D.Finite <$> coefficient <*> exponent) + , (1, return D.Infinite) + , (1, fmap D.NotANumber nonNum) + ] + +sign :: Gen Dec.Sign +sign = elements [ Dec.Sign1, Dec.Sign0 ] + +abstract :: Gen D.Abstract +abstract = D.Abstract <$> sign <*> value diff --git a/native/Properties.hs b/native/Properties.hs new file mode 100644 --- /dev/null +++ b/native/Properties.hs @@ -0,0 +1,25 @@ +module Properties where + +import qualified Generators as G +import qualified Deka.Native as N +import Test.Tasty.QuickCheck (testProperty) +import Test.Tasty (TestTree, testGroup) +import Test.QuickCheck +import qualified Deka.Dec as D + +tests :: TestTree +tests = testGroup "Native" + [ testProperty "abstract -> string -> abstract" $ + forAll G.abstract $ \a -> + case N.stringToAbstract . N.abstractToString $ a of + Left _ -> property False + Right a' -> a === a' + + , testProperty "Dec -> Abstract -> Dec" $ + forAll G.abstract $ \a -> + let (d, flgs) = N.abstractToDec a + a' = N.decToAbstract d + (d'', flgs') = N.abstractToDec a' + in flgs == D.emptyFlags && flgs' == D.emptyFlags + ==> D.compareTotal d d'' == EQ + ] diff --git a/native/native.hs b/native/native.hs new file mode 100644 --- /dev/null +++ b/native/native.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +module Main where + +import AllModules +import Properties (tests) +import Test.Tasty (defaultMain) + +main :: IO () +main = defaultMain tests diff --git a/test/DataDir.hs b/test/DataDir.hs deleted file mode 100644 --- a/test/DataDir.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} - -module DataDir where - -import Test.Tasty -import qualified DataDir.DekaDir -import qualified DataDir.DekaTest - -tests = testGroup "DataDir" - [ DataDir.DekaDir.tests - , DataDir.DekaTest.tests - ] diff --git a/test/DataDir/DekaDir.hs b/test/DataDir/DekaDir.hs deleted file mode 100644 --- a/test/DataDir/DekaDir.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} - -module DataDir.DekaDir where - -import Test.Tasty -import qualified DataDir.DekaDir.QuadTest - -tests = testGroup "DekaDir" - [ DataDir.DekaDir.QuadTest.tests - ] diff --git a/test/DataDir/DekaDir/QuadTest.hs b/test/DataDir/DekaDir/QuadTest.hs deleted file mode 100644 --- a/test/DataDir/DekaDir/QuadTest.hs +++ /dev/null @@ -1,1422 +0,0 @@ --- | Tests for the Quad module. --- --- The object of these tests is not to test decNumber but, rather, --- to test Deka to ensure there are no transposed arguments or other --- glaring errors. Also, ensures that the FFI binding behaves as it --- should and that there are no side effects where there shouldn't --- be any. --- --- Every function that takes a Quad as an argument is tested to --- ensure it does not modify that Quad. --- --- encoding and decoding must also be thoroughly tested as this can --- be quite error prone. -module DataDir.DekaDir.QuadTest where - -import Control.Applicative -import Control.Exception (evaluate) -import qualified Data.ByteString.Char8 as BS8 -import Control.Monad -import Test.Tasty -import qualified Data.Deka.Quad as E -import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck hiding (maxSize) -import Test.QuickCheck.Monadic -import Data.Deka.Internal -import Data.Deka.Decnumber -import Data.Maybe -import Foreign - -isLeft :: Either a b -> Bool -isLeft e = case e of { Left _ -> True; _ -> False } - -isRight :: Either a b -> Bool -isRight e = case e of { Right _ -> True; _ -> False } - -lenCoeff :: E.Decoded -> Maybe Int -lenCoeff dcd = fmap length . fmap E.unCoefficient - $ case E.dValue dcd of - E.Finite c _ -> Just c - _ -> Nothing - --- | Maximum Integer for testing purposes. -maxInteger :: Integer -maxInteger = 10 ^ (100 :: Int) - --- | Minimum Integer for testing purposes. -minInteger :: Integer -minInteger = negate (10 ^ (100 :: Int)) - --- | The largest number with the given number of digits. -biggestDigs :: Int -> Integer -biggestDigs i = 10 ^ i - 1 - --- | The smallest positive number with the given number of digits. -smallestDigs :: Int -> Integer -smallestDigs i = 10 ^ (i - 1) - -maxSize :: Int -> Gen a -> Gen a -maxSize s g = sized $ \o -> resize (min o s) g - -numDigits :: (Num a, Show a) => a -> Int -numDigits = length . show . abs - -increaseAbs :: E.Quad -> E.Ctx E.Quad -increaseAbs q = do - let neg = E.isNegative q - if neg - then E.nextMinus q - else E.nextPlus q - -decreaseAbs :: E.Quad -> E.Ctx E.Quad -decreaseAbs q = do - let neg = E.isNegative q - if neg - then E.nextPlus q - else E.nextMinus q - --- # Generators - -genSign :: Gen E.Sign -genSign = elements [ minBound..maxBound ] - -genBinaryMSD :: Gen E.Digit -genBinaryMSD = return E.D1 - -genBinaryNonMSD :: Gen E.Digit -genBinaryNonMSD = elements [E.D0, E.D1] - -binaryDigs :: (Gen E.Digit, Gen E.Digit) -binaryDigs = (genBinaryMSD, genBinaryNonMSD) - -genDecimalMSD :: Gen E.Digit -genDecimalMSD = elements [ E.D1, E.D2, E.D3, E.D4, E.D5, - E.D6, E.D7, E.D8, E.D9 ] - -genDecimalNonMSD :: Gen E.Digit -genDecimalNonMSD = elements - [ E.D0, E.D1, E.D2, E.D3, E.D4, E.D5, - E.D6, E.D7, E.D8, E.D9 ] - -decimalDigs :: (Gen E.Digit, Gen E.Digit) -decimalDigs = (genDecimalMSD, genDecimalNonMSD) - --- | Given a length, generate a list of digits. All lists generated --- will be exactly the length given. -genDigits - :: Int - -- ^ Length - -> (Gen E.Digit, Gen E.Digit) - -- ^ Generate MSD, remaining digits - -> Gen [E.Digit] -genDigits l (gm, gr) = do - msd <- gm - rs <- vectorOf (l - 1) gr - return $ msd : rs - --- | Given a maximum length, generate lists of digits that are no --- longer than the length given. The list will be of a random --- length, but it will be no longer than the larger of the size --- parameter and the given maximum length. The list will always be --- at least one element long regardless of the maximum length passed --- in. -sizedDigits - :: Int - -- ^ Maximum length. (Size parameter determines the maximum - -- length, but it will not exceed this amount.) - -> (Gen E.Digit, Gen E.Digit) - -- ^ Generate MSD, remaining digits - -> Gen [E.Digit] -sizedDigits m (gm, gr) = sized $ \s -> do - let sz = max 1 s - maxLen = min sz m - len <- choose (1, maxLen) - genDigits len (gm, gr) - --- ## Finite number generators - -coeffDigits :: (Gen E.Digit, Gen E.Digit) -> Gen [E.Digit] -coeffDigits p = sized f - where - f x | x == 0 = oneof [ sizedDigits 0 p, return [E.D0] ] - | otherwise = sizedDigits E.coefficientLen p - -genFiniteDcd - :: Gen E.Sign - -> Gen [E.Digit] - -- ^ Generate coefficient - -> (E.Coefficient -> Gen Int) - -- ^ Generate exponent - -> Gen E.Decoded -genFiniteDcd gs gc ge = do - s <- gs - ds <- gc - let coe = case E.coefficient ds of - Nothing -> error "genFinite: coefficient failed" - Just r -> r - e <- ge coe - let ex = case E.exponent e of - Nothing -> error "genFiniteDcd: exponent failed" - Just r -> r - return $ E.Decoded s (E.Finite coe ex) - -rangedExponent - :: (Int, Int) - -- ^ Minimum and maximum exponent. Exponent will never exceed - -- allowable values. - -> Gen Int -rangedExponent (em, ex) = do - let (mPE, xPE) = E.minMaxExp - (mR, xR) = (max em mPE, min ex xPE) - choose (mR, xR) - -sizedExponent :: Gen Int -sizedExponent = sized $ \s -> - let x = s ^ (2 :: Int) - in rangedExponent (negate x, x) - -fullExpRange :: Gen Int -fullExpRange = rangedExponent E.minMaxExp - --- ## Infinite number generators - -genInfinite :: Gen E.Sign -> Gen E.Decoded -genInfinite gs = do - s <- gs - return $ E.Decoded s E.Infinite - --- ## NaN number generators - -payloadDigits :: (Gen E.Digit, Gen E.Digit) -> Gen [E.Digit] -payloadDigits = sizedDigits E.payloadLen - -genNaN :: Gen E.NaN -genNaN = elements [ E.Quiet, E.Signaling ] - -genNaNDcd - :: Gen E.Sign - -> Gen E.NaN - -> Gen [E.Digit] - -- ^ Generate payload - -> Gen E.Decoded -genNaNDcd gs gn gd = do - s <- gs - ds <- gd - n <- gn - let pay = case E.payload ds of - Nothing -> error "genNaNDcd: payload failed" - Just r -> r - return $ E.Decoded s (E.NaN n pay) - --- ## Decoded generators - --- | Most general Decoded generator. Generates throughout the --- possible range of Decoded. Depends on the size parameter. -genDecoded :: Gen E.Decoded -genDecoded = frequency [(4, genFinite), (1, inf), (1, nan)] - where - inf = genInfinite genSign - nan = genNaNDcd genSign genNaN (payloadDigits decimalDigs) - --- | Generates finite decoded numbers. -genFinite :: Gen E.Decoded -genFinite = genFiniteDcd genSign (coeffDigits decimalDigs) - (const sizedExponent) - - --- ## Specialized finite generators - --- | Generates positive and negative zeroes. -genZero :: Gen E.Decoded -genZero = genFiniteDcd genSign (return [E.D0]) (const fullExpRange) - -genNegZero :: Gen E.Decoded -genNegZero = genFiniteDcd (return E.Sign1) (return [E.D0]) - (const fullExpRange) - -genPosZero :: Gen E.Decoded -genPosZero = genFiniteDcd (return E.Sign0) (return [E.D0]) - (const fullExpRange) - --- | Generates positive one. -genOne :: Gen E.Decoded -genOne = genFiniteDcd (return E.Sign0) gDigs gExp - where - gDigs = sizedDigits E.coefficientLen (return E.D1, return E.D0) - gExp co = return . negate $ length (E.unCoefficient co) - 1 - -genSmallFinite :: Gen E.Decoded -genSmallFinite = maxSize 5 genFinite - --- | Generates two values that are equivalent, but with --- different exponents. - -genEquivalent :: Gen (E.Decoded, E.Decoded) -genEquivalent = do - let genCoeff1 = sizedDigits (E.coefficientLen - 1) decimalDigs - genExp1 c = - let (l, h) = E.minMaxExp - l' = l + (E.coefficientLen - (length . E.unCoefficient $ c)) - in choose (l', h) - d1 <- genFiniteDcd genSign genCoeff1 genExp1 - let (c1, e1) = case E.dValue d1 of - E.Finite c e -> (E.unCoefficient c, E.unExponent e) - _ -> error "genEquivalent failed" - maxMore = E.coefficientLen - length c1 - more <- choose (1, maxMore) - let coeff2 = case E.coefficient (c1 ++ replicate more E.D0) of - Nothing -> error "genEquivalent: coefficient failed" - Just r -> r - exp2 = case E.exponent (e1 - more) of - Nothing -> error "genEquivalent: exponent failed" - Just r -> r - d2 = E.Decoded (E.dSign d1) (E.Finite coeff2 exp2) - b <- arbitrary - let r = if b then (d1, d2) else (d2, d1) - return r - - - -genNonZeroSmallFinite :: Gen E.Decoded -genNonZeroSmallFinite = maxSize 5 $ genFiniteDcd genSign - gd ge - where - gd = sizedDigits E.coefficientLen decimalDigs - ge = (const sizedExponent) - -genInteger :: Gen E.Decoded -genInteger = genFiniteDcd genSign - (coeffDigits decimalDigs) (const . return $ 0) - -genLogical :: Gen E.Decoded -genLogical = genFiniteDcd (return E.Sign0) - (coeffDigits binaryDigs) (const . return $ 0) - -genNormal :: Gen E.Sign -> Gen [E.Digit] -> Gen E.Decoded -genNormal gs gc = genFiniteDcd gs gc ge - where - ge c = do - let minNrml = E.unExponent $ E.minNormalExp c - maxE = snd E.minMaxExp - choose (minNrml, maxE) - -genSubnormal :: Gen E.Sign -> Gen [E.Digit] -> Gen E.Decoded -genSubnormal gs gd = genFiniteDcd gs gd ge - where - ge c = - let minNrml = E.unExponent . E.minNormalExp $ c - minE = fst E.minMaxExp - f | minE > minNrml - 1 = error "genSubnormal failed" - | otherwise = choose (minE, minNrml - 1) - in f - -genPositive :: Gen E.Decoded -genPositive = genFiniteDcd (return E.Sign0) gd ge - where - gd = sizedDigits E.coefficientLen decimalDigs - ge = (const sizedExponent) - -genNegative :: Gen E.Decoded -genNegative = genFiniteDcd (return E.Sign1) gd ge - where - gd = sizedDigits E.coefficientLen decimalDigs - ge = (const sizedExponent) - --- ## Specialized other generators - -genSignaling :: Gen E.Decoded -genSignaling = genNaNDcd genSign (return E.Signaling) - (payloadDigits decimalDigs) - -genSigned :: Gen E.Decoded -genSigned = oneof - [ genFiniteDcd (return E.Sign1) (coeffDigits decimalDigs) (const sizedExponent) - , genNaNDcd (return E.Sign1) genNaN (payloadDigits decimalDigs) - , genInfinite (return E.Sign1) - ] - --- ## Other generators - -genRound :: Gen E.Round -genRound = elements [ E.roundCeiling, E.roundUp, E.roundHalfUp, - E.roundHalfEven, E.roundHalfDown, E.roundDown, E.roundFloor, - E.round05Up ] - -allFlags :: [E.Flag] -allFlags = [ E.divisionUndefined, E.divisionByZero, - E.divisionImpossible, E.invalidOperation, E.inexact, - E.underflow, E.overflow, E.conversionSyntax ] - -genFlag :: Gen E.Flag -genFlag = elements allFlags - -onePointFive :: E.Quad -onePointFive = E.evalCtx . E.fromByteString . BS8.pack $ "1.5" - --- # Test builders - -associativity - :: String - -- ^ Name - -> (E.Quad -> E.Quad -> E.Ctx E.Quad) - -> TestTree -associativity n f = testProperty desc $ - forAll genSmallFinite $ \ dx -> - forAll genSmallFinite $ \ dy -> - forAll genSmallFinite $ \ dz -> - let (noFlags, resIsZero) = E.evalCtx $ do - let x = E.fromBCD dx - y = E.fromBCD dy - z = E.fromBCD dz - r1 <- f x y >>= f z - r2 <- f y z >>= f x - let c = E.evalCtx $ E.compare r1 r2 - isZ = E.isZero c - fl <- E.getStatus - return (fl == E.emptyFlags, isZ) - in noFlags ==> resIsZero - where - desc = n ++ " is associative on finite numbers" - -commutativity - :: String - -- ^ Name - -> (E.Quad -> E.Quad -> E.Ctx E.Quad) - -> TestTree -commutativity n f = testProperty desc $ - forAll genSmallFinite $ \dx -> - forAll genSmallFinite $ \dy -> - let (noFlags, resIsZero) = E.evalCtx $ do - let x = E.fromBCD dx - y = E.fromBCD dy - r1 <- f x y - r2 <- f y x - let isZ = E.compareTotal r1 r2 == EQ - fl <- E.getStatus - return (fl == E.emptyFlags, isZ) - in noFlags ==> resIsZero - where - desc = n ++ " is commutative where there are no flags" - --- # Immutability test builders - - -inContext :: (Ptr C'decContext -> IO Bool) -> PropertyM IO Bool -inContext f = - run $ alloca $ \pCtx -> do - _ <- unsafe'c'decContextDefault pCtx c'DEC_INIT_DECQUAD - f pCtx - -{- Also for below, consider this code snippet: - -module Main where - -import Control.Exception (evaluate) -import System.IO.Unsafe (unsafePerformIO) - -myThing :: String -> Int -myThing s = unsafePerformIO $ putStrLn s >> return 2 - -main :: IO () -main = do - x <- return . Just $ myThing "this will NOT be printed" - _ <- evaluate x - y <- return $ myThing "this will be printed" - _ <- evaluate y - _ <- evaluate $ myThing "this will be printed too" - putStrLn "Done" - --} - --- | These functions assume that reducing the return type of the --- subject function to WHNF will force any associated IO to occur. --- For example, imuUni will work as intended if you apply it --- like so: --- --- > imuUni "okay" (fmap (fmap return) E.decClass) --- --- In this case, the function passed as an argument to imuUni is --- run, and the result (Quad) is reduced to WHNF. This works as --- intended because it forces the underlying function to perform its --- IO. --- --- This would not work, even though it is well-typed: --- --- > imuUni "broken" (fmap (fmap (return . Just))) --- --- because in this case, the value returned from the computation is --- a Ctx Maybe. Reducing the Maybe to WHNF will not force any --- underlying IO to occurr, as this just gives you either a Maybe --- data constructor or _|_. -imuUni - :: String - -- ^ Name - -> (E.Quad -> E.Ctx a) - -> TestTree -imuUni n f = testProperty desc $ - forAll genDecoded $ \dx -> - monadicIO $ - let k cPtr = do - d <- evaluate $ E.fromBCD dx - dcd1 <- withForeignPtr (unQuad d) peek - x <- unCtx (f d) cPtr - _ <- evaluate x - dcd2 <- withForeignPtr (unQuad d) peek - return $ dcd1 == dcd2 - in inContext k >>= assert - where - desc = n ++ " (unary function) does not mutate only argument" - - -imuBinary1st - :: Show a - => String - -- ^ Name - -> (Gen a, a -> c) - -> (E.Quad -> c -> E.Ctx b) - -> TestTree -imuBinary1st n (genA, getC) f = testProperty desc $ - forAll genDecoded $ \dx -> - forAll genA $ \a -> - monadicIO $ - let k cPtr = do - d <- evaluate $ E.fromBCD dx - dcd1 <- withForeignPtr (unQuad d) peek - x <- unCtx (f d (getC a)) cPtr - _ <- evaluate x - dcd2 <- withForeignPtr (unQuad d) peek - return $ dcd1 == dcd2 - in inContext k >>= assert - where - desc = n ++ " (binary function) does not mutate first argument" - -imuBinary2nd - :: Show a - => String - -- ^ Name - -> (Gen a, a -> c) - -> (c -> E.Quad -> E.Ctx b) - -> TestTree -imuBinary2nd n (genA, getC) f = testProperty desc $ - forAll genDecoded $ \dx -> - forAll genA $ \a -> - monadicIO $ - let k cPtr = do - d <- evaluate $ E.fromBCD dx - dcd1 <- withForeignPtr (unQuad d) peek - x <- unCtx (f (getC a) d) cPtr - _ <- evaluate x - dcd2 <- withForeignPtr (unQuad d) peek - return $ dcd1 == dcd2 - in inContext k >>= assert - where - desc = n ++ " (binary function) does not mutate second argument" - -imuBinary - :: String - -> (E.Quad -> E.Quad -> E.Ctx a) - -> TestTree -imuBinary n f = testGroup ("immutability - " ++ n) - [ imuBinary1st n (genDecoded, E.fromBCD) f - , imuBinary2nd n (genDecoded, E.fromBCD) f - ] - -imuTernary - :: String - -> (E.Quad -> E.Quad -> E.Quad -> E.Ctx a) - -> TestTree -imuTernary n f = testGroup (n ++ " (ternary function) - immutability") - [ testProperty "first argument" $ - forAll gen3 $ \(ga, gb, gc) -> - monadicIO $ - let k cPtr = do - a <- evaluate $ E.fromBCD ga - b <- evaluate $ E.fromBCD gb - c <- evaluate $ E.fromBCD gc - dcd1 <- withForeignPtr (unQuad a) peek - x <- unCtx (f a b c) cPtr - _ <- evaluate x - dcd2 <- withForeignPtr (unQuad a) peek - return $ dcd1 == dcd2 - in inContext k >>= assert - - , testProperty "second argument" $ - forAll gen3 $ \(ga, gb, gc) -> - monadicIO $ - let k cPtr = do - a <- evaluate $ E.fromBCD ga - b <- evaluate $ E.fromBCD gb - c <- evaluate $ E.fromBCD gc - dcd1 <- withForeignPtr (unQuad b) peek - x <- unCtx (f a b c) cPtr - _ <- evaluate x - dcd2 <- withForeignPtr (unQuad b) peek - return $ dcd1 == dcd2 - in inContext k >>= assert - - , testProperty "third argument" $ - forAll gen3 $ \(ga, gb, gc) -> - monadicIO $ - let k cPtr = do - a <- evaluate $ E.fromBCD ga - b <- evaluate $ E.fromBCD gb - c <- evaluate $ E.fromBCD gc - dcd1 <- withForeignPtr (unQuad c) peek - x <- unCtx (f a b c) cPtr - _ <- evaluate x - dcd2 <- withForeignPtr (unQuad c) peek - return $ dcd1 == dcd2 - in inContext k >>= assert - ] - where - gen3 = (,,) <$> genDecoded <*> genDecoded <*> genDecoded - -identity - :: String - -- ^ Name of thing that is identity (e.g. zero) - -> Gen E.Decoded - -> (E.Quad -> E.Quad -> E.Ctx E.Quad) - -> TestTree -identity n g f = testProperty name $ - forAll genFinite $ \ad -> - forAll g $ \bd -> E.evalCtx $ do - let a = E.fromBCD ad - b = E.fromBCD bd - r <- f a b - c <- E.compare a r - return $ E.isZero c - where - name = n ++ " is the identity for finite numbers" - -eitherToOrd :: Either E.Quad Ordering -> Ordering -eitherToOrd = either toOrd id - where - toOrd x | E.isNegative x = LT - | E.isZero x = EQ - | E.isPositive x = GT - | otherwise = error "eitherToOrd: unrecognized value" - -comparison - :: String - -- ^ Name of function - -> (E.Quad -> E.Ctx E.Quad) - -- ^ How to make a larger Quad - -> (E.Quad -> E.Ctx E.Quad) - -- ^ How to make a smaller Quad - -> (E.Quad -> E.Quad -> E.Ctx (Either E.Quad Ordering)) - -> TestTree - -comparison n fB fS fC = testGroup (n ++ " comparisons") - [ testProperty "x > y" $ forAll genNonZeroSmallFinite $ - \da -> E.evalCtx $ do - let a = E.fromBCD da - b <- fB a - c <- fC b a - return $ eitherToOrd c == GT - - , testProperty "x < y" $ forAll genNonZeroSmallFinite $ - \da -> E.evalCtx $ do - let a = E.fromBCD da - b <- fS a - c <- fC b a - return $ eitherToOrd c == LT - - , testProperty "x == x" $ forAll genNonZeroSmallFinite $ - \da -> E.evalCtx $ do - let a = E.fromBCD da - c <- fC a a - return $ eitherToOrd c == EQ - - , testProperty "transitive" $ forAll genNonZeroSmallFinite $ - \da -> - forAll genNonZeroSmallFinite $ \db -> E.evalCtx $ do - let a = E.fromBCD da - b = E.fromBCD db - c <- fC a b - case eitherToOrd c of - EQ -> do - c' <- fC b a - return $ eitherToOrd c' == EQ - o -> do - c' <- fC b a - let cOrd = eitherToOrd c' - return $ case cOrd of - LT -> o == GT - GT -> o == LT - EQ -> False - ] - -testMinMax - :: String - -> Bool - -- ^ True if testing absolute values - -> (E.Quad -> E.Quad -> E.Ctx E.Quad) - -> TestTree -testMinMax n ab f = testProperty (n ++ " and compare") $ - forAll genSmallFinite $ \da -> - forAll genSmallFinite $ \db -> E.evalCtx $ do - let aa = E.fromBCD da - bb = E.fromBCD db - (a, b) <- if ab - then do - aaa <- E.abs aa - bbb <- E.abs bb - return $ (aaa, bbb) - else return (aa, bb) - r <- E.compare a b - m <- f a b - let z = E.isZero r - if z - then do - r' <- E.compare m a - r'' <- E.compare m b - let zr' = E.isZero r' - zr'' = E.isZero r'' - return $ zr' && zr'' - else do - nw <- f b a - r' <- E.compare nw m - return $ E.isZero r' - - -decodedSameQuantum :: E.Decoded -> E.Decoded -> Bool -decodedSameQuantum x y = case (E.dValue x, E.dValue y) of - (E.Finite _ e1, E.Finite _ e2) -> e1 == e2 - (E.Infinite, E.Infinite) -> True - (E.NaN _ _, E.NaN _ _) -> True - _ -> False - --- | Tests that a boolean function succeeds and fails as it should. - -testBoolean - :: String - -- ^ Name - -> Gen E.Decoded - -- ^ Generates decodes that should succeed - -> (E.Decoded -> Bool) - -- ^ This predicate returns True on successful decodes - -> (E.Quad -> Bool) - -- ^ Function to test - -> TestTree -testBoolean n g pd f = testGroup n - [ testProperty "predicate returns true on generated decodes" $ - forAll g $ \d -> pd d - - , testProperty "succeeds when it should" $ - forAll g $ \dcd -> - let q = E.fromBCD dcd - in f q - - , testProperty "fails when it should" $ - forAll (genDecoded `suchThat` (not . pd)) $ \dcd -> - let q = E.fromBCD dcd - in not $ f q - - , testProperty "decNumber and Deka predicate return same result" - $ forAll genDecoded $ \dcd -> - let q = E.fromBCD dcd - b = f q - in b == pd dcd - ] - --- | Tests functions that deal with DecClass. -testDecClass - :: E.DecClass - -- ^ Class being tested - -> Gen E.Decoded - -- ^ Generates Decoded that are in this class - -> (E.Decoded -> Bool) - -- ^ This function should return True on Decoded that are in the - -- class - -> TestTree - -testDecClass c ge f = testGroup (show c) - [ testProperty "predicate returns True on generated decodes" $ - forAll ge f - - , testProperty "decClass returns matching class" $ - forAll ge $ \dcd -> let q = E.fromBCD dcd in E.decClass q == c - - , testProperty "decClass does not return matching class otherwise" $ - forAll (genDecoded `suchThat` (not . f)) $ \dcd -> - let q = E.fromBCD dcd in E.decClass q /= c - ] - -genInt32 :: Gen C'int32_t -genInt32 = choose (minBound, maxBound) - -genUInt32 :: Gen C'uint32_t -genUInt32 = choose (minBound, maxBound) - -intConversion - :: (Show a, Eq a) - => String - -- ^ Name - -> Gen a - -> (a -> E.Quad) - -- ^ Convert from C int - -> (E.Round -> E.Quad -> E.Ctx a) - -- ^ Convert to C int - -> TestTree -intConversion n gen fr to = testGroup (n ++ " conversions") - [ testProperty "convert from C integer to Quad and back" $ - forAll genRound $ \r -> - forAll gen $ \i -> - let q = fr i - (i', fl) = E.runCtx $ to r q - in fl == E.emptyFlags && i' == i - ] - --- | Tests that what is returned by an operation has the same --- exponent and sign of the first operand. -sameSignExp - :: (E.Quad -> E.Quad -> E.Ctx E.Quad) - -> TestTree -sameSignExp f = testProperty - "result has same sign and exponent as first argument" $ - forAll genFinite $ \d -> E.evalCtx $ do - let x = E.fromBCD d - r <- f x E.one - let d' = E.toBCD r - sameExp = case (E.dValue d, E.dValue d') of - (E.Finite _ e, E.Finite _ e') -> e == e' - _ -> False - return $ E.dSign d == E.dSign d' && sameExp - --- # Tests - -tests :: TestTree -tests = testGroup "Quad" - [ testGroup "helper functions" - [ testGroup "biggestDigs" - [ testProperty "generates correct number of digits" $ - forAll (choose (1, 500)) $ \i -> - numDigits (biggestDigs i) == i - - , testProperty "adding one increases number of digits" $ - forAll (choose (1, 500)) $ \i -> - let r = biggestDigs i - n = numDigits r - n' = numDigits (r + 1) - in n' == n + 1 - ] - - , testGroup "smallestDigs" - [ testProperty "generates correct number of digits" $ - forAll (choose (1, 500)) $ \i -> - numDigits (smallestDigs i) == i - - , testProperty "subtracting one decreases number of digits" $ - forAll (choose (1, 500)) $ \i -> - let r = smallestDigs i - in r > 1 ==> numDigits r - 1 == numDigits (r - 1) - ] - ] - - - , testGroup "immutability" - [ testGroup "conversions" - [ imuUni "decClass" (fmap return E.decClass) - , imuUni "toBCD" (fmap return E.toBCD) - , imuUni "toByteString" (fmap return E.toByteString) - , imuUni "toEngByteString" (fmap return E.toEngByteString) - , imuBinary2nd "toInt32" (genRound, id) E.toInt32 - , imuBinary2nd "toInt32Exact" (genRound, id) E.toInt32Exact - , imuBinary2nd "toUInt32" (genRound, id) E.toUInt32 - , imuBinary2nd "toUInt32Exact" (genRound, id) E.toUInt32Exact - , imuUni "toIntegralExact" E.toIntegralExact - , imuBinary2nd "toIntegralValue" (genRound, id) E.toIntegralValue - ] - - , testGroup "arithmetic" - [ imuBinary "add" E.add - , imuBinary "subtract" E.subtract - , imuBinary "multiply" E.multiply - , imuTernary "fma" E.fma - , imuBinary "divide" E.divide - , imuBinary "divideInteger" E.divideInteger - , imuBinary "remainder" E.remainder - , imuBinary "remainderNear" E.remainderNear - ] - - , testGroup "exponent and coefficient adjustment" - [ imuBinary "quantize" E.quantize - , imuUni "reduce" E.reduce - ] - - , testGroup "comparisons" - [ imuBinary "compare" E.compare - , imuBinary "compareSignal" E.compareSignal - , imuBinary "compareTotal" - (fmap (fmap return) E.compareTotal) - , imuBinary "compareTotalMag" - (fmap (fmap return) E.compareTotalMag) - , imuBinary "max" E.max - , imuBinary "maxMag" E.maxMag - , imuBinary "min" E.min - , imuBinary "minMag" E.minMag - , imuBinary "sameQuantum" - (fmap (fmap return) E.sameQuantum) - ] - - , let f s k = imuUni s (fmap return k) in - testGroup "tests" - [ f "isFinite" E.isFinite - , f "isInfinite" E.isInfinite - , f "isInteger" E.isInteger - , f "isLogical" E.isLogical - , f "isNaN" E.isNaN - , f "isNegative" E.isNegative - , f "isNormal" E.isNormal - , f "isPositive" E.isPositive - , f "isSignaling" E.isSignaling - , f "isSigned" E.isSigned - , f "isSubnormal" E.isSubnormal - , f "isZero" E.isZero - ] - - , testGroup "signs" - [ imuUni "plus" E.plus - , imuUni "minus" E.minus - , imuUni "abs" E.abs - , imuBinary "copySign" (fmap (fmap return) E.copySign) - ] - - , testGroup "increment and decrement" - [ imuUni "nextMinus" E.nextMinus - , imuUni "nextPlus" E.nextPlus - , imuBinary "nextToward" E.nextToward - ] - - , testGroup "logical, bitwise, digit shifting" - [ imuBinary "and" E.and - , imuBinary "or" E.or - , imuBinary "shift" E.shift - , imuBinary "xor" E.xor - , imuBinary "rotate" E.rotate - , imuUni "invert" E.invert - ] - - , testGroup "log and scale" - [ imuUni "logB" E.logB - , imuBinary "scaleB" E.scaleB - ] - - , testGroup "attributes" - [ imuUni "digits" (fmap return E.digits) - ] - ] -- immutability - - , testGroup "rounding" - [ testProperty "default rounding is half even" $ - once . E.evalCtx $ do - r <- E.getRound - return $ r == E.roundHalfEven - - , testProperty "setRound works" $ - forAll genRound $ \r -> E.evalCtx $ do - E.setRound r - r' <- E.getRound - return $ r == r' - - ] -- rounding - - , testGroup "flags" - [ testProperty "no flags set initially" . once - . E.evalCtx $ do - fl <- E.getStatus - return $ fl == E.emptyFlags - ] - - , testGroup "classes" - [ testDecClass E.sNan - (genNaNDcd genSign (return E.Signaling) (payloadDigits decimalDigs)) - E.dIsNaN - - , testDecClass E.qNan - (genNaNDcd genSign (return E.Quiet) (payloadDigits decimalDigs)) - E.dIsNaN - - , testDecClass E.negInf - (genInfinite (return E.Sign1)) E.dIsNegInf - - , testDecClass E.negNormal - (genNormal (return E.Sign1) - (sizedDigits E.coefficientLen decimalDigs)) E.dIsNegNormal - - , testDecClass E.negSubnormal - (genSubnormal (return E.Sign1) - (sizedDigits (E.coefficientLen - 1) decimalDigs)) - E.dIsNegSubnormal - - , testDecClass E.negZero genNegZero E.dIsNegZero - , testDecClass E.posZero genPosZero E.dIsPosZero - - , testDecClass E.posSubnormal - (genSubnormal (return E.Sign0) - (sizedDigits (E.coefficientLen - 1) decimalDigs)) - E.dIsPosSubnormal - - , testDecClass E.posNormal - (genNormal (return E.Sign0) - (sizedDigits E.coefficientLen decimalDigs)) E.dIsPosNormal - - , testDecClass E.posInf - (genInfinite (return E.Sign0)) E.dIsPosInf - - ] -- classes - - , testGroup "string conversions" - [ testProperty ("Decoded -> Quad -> ByteString" - ++ " -> Quad -> Decoded") $ - forAll genDecoded $ \d -> - let q = E.fromBCD d - bs = E.toByteString q - q' = E.evalCtx $ E.fromByteString bs - d' = E.toBCD q' - desc = "toByteString: " ++ BS8.unpack bs - ++ " toBCD: " ++ show d' - in printTestCase desc $ d' == d - - , testProperty ("fromBCD and (fromByteString . scientific) " - ++ "give same result") $ - forAll genDecoded $ \d -> - let qD = E.fromBCD d - (qS, fl) = E.runCtx . E.fromByteString - . BS8.pack . E.scientific $ d - compared = E.compareTotal qD qS == EQ - in compared && fl == E.emptyFlags - - , testProperty ("fromBCD and (fromByteString . ordinary) " - ++ "give results that compare equal") $ - forAll genDecoded $ \d -> - let qD = E.fromBCD d - str = E.ordinary d - (qS, fl) = E.runCtx . E.fromByteString - . BS8.pack $ str - cmpResult - | E.isNormal qD = E.compareOrd qD qS == Just EQ - | otherwise = E.compareTotal qD qS == EQ - noFlags f = f == E.emptyFlags - desc = "string: " ++ str - ++ " fromByteString result: " ++ show qS - in noFlags fl ==> printTestCase desc cmpResult - - , testProperty "toByteString -> fromByteString" $ - forAll genDecoded $ \d -> - let q = E.fromBCD d - bs = E.toByteString q - (q', fl) = E.runCtx . E.fromByteString $ bs - cmpRes = E.compareTotal q q' == EQ - in cmpRes && fl == E.emptyFlags - - , testProperty "toEngByteString -> fromByteString" $ - forAll genDecoded $ \d -> - let q = E.fromBCD d - bs = E.toEngByteString q - (q', fl) = E.runCtx . E.fromByteString $ bs - cmpRes = E.compareOrd q q' == Just EQ - cmpResTot = E.compareTotal q q' == EQ - res = if E.isFinite q then cmpRes else cmpResTot - in fl == E.emptyFlags ==> res - ] -- string conversions - - , testGroup "integer conversions" - [ intConversion "int32" genInt32 E.fromInt32 E.toInt32 - , intConversion "uint32" genUInt32 E.fromUInt32 E.toUInt32 - , intConversion "int32 exact" genInt32 E.fromInt32 E.toInt32Exact - , intConversion "uint32 exact" genUInt32 E.fromUInt32 E.toUInt32Exact - ] -- integer conversions - - , testGroup "arithmetic" - [ testGroup "add" - [ associativity "add" E.add - , commutativity "add" E.add - , identity "zero" genZero E.add - ] - - , testGroup "multiply" - [ associativity "multiply" E.multiply - , commutativity "multiply" E.multiply - , identity "one" genOne E.multiply - ] - - , testGroup "subtract" - [ testProperty "is the inverse of add" $ - forAll genSmallFinite $ \da -> - forAll genSmallFinite $ \db -> - let (r, fl) = E.runCtx $ do - let a = E.fromBCD da - b = E.fromBCD db - r1 <- E.add a b - r2 <- E.subtract r1 b - c <- E.compare r2 a - return $ E.isZero c - in fl == E.emptyFlags ==> r - - , identity "zero" genZero E.subtract - ] - - , testGroup "fused multiply add" - [ testProperty "is same as multiply and add" $ - forAll genSmallFinite $ \da -> - forAll genSmallFinite $ \db -> - forAll genSmallFinite $ \dc -> - let (r, fl) = E.runCtx $ do - let a = E.fromBCD da - b = E.fromBCD db - c = E.fromBCD dc - r1 <- E.multiply a b - r2 <- E.add r1 c - r2' <- E.fma a b c - cm <- E.compare r2 r2' - return $ E.isZero cm - in fl == E.emptyFlags ==> r - ] - - , testGroup "divide" - [ identity "one" genOne E.divide ] - - , testGroup "divideInteger" - [ testProperty "result has exponent 0" $ - forAll genSmallFinite $ \da -> - forAll genSmallFinite $ \db -> - let (e, fl) = E.runCtx $ do - let a = E.fromBCD da - b = E.fromBCD db - c <- E.divideInteger a b - return $ E.isInteger c - in fl == E.emptyFlags ==> e - ] - - , testGroup "remainder" - [ testProperty "x = int * y + rem" $ - forAll genSmallFinite $ \dx -> - forAll genSmallFinite $ \dy -> - let (r, fl) = E.runCtx $ do - let x = E.fromBCD dx - y = E.fromBCD dy - it <- E.divideInteger x y - rm <- E.remainder x y - i1 <- E.multiply it y - i2 <- E.add i1 rm - c <- E.compare i2 x - return $ E.isZero c - in fl == E.emptyFlags ==> r - ] - -- remainderNear - no test - not sure I understand the - -- semantics - - ] -- arithmetic - - , testGroup "exponent and coefficient adjustment" - [ testGroup "quantize" - [ testProperty "result has same quantum" $ - forAll genSmallFinite $ \dx -> - forAll genSmallFinite $ \dy -> - let (r, fl) = E.runCtx $ do - let x = E.fromBCD dx - y = E.fromBCD dy - c <- E.quantize x y - let getExp a = do - let dcd = E.toBCD a - return $ case E.dValue dcd of - E.Finite _ e -> Just e - _ -> Nothing - exC <- getExp c - exY <- getExp y - let fin = E.isFinite c - return $ fin && exC == exY - in fl == E.emptyFlags ==> r - ] - - , testGroup "reduce" - [ testProperty "result is equivalent" $ - forAll genSmallFinite $ \dx -> E.evalCtx $ do - let x = E.fromBCD dx - r <- E.reduce x - c <- E.compare r x - return $ E.isZero c - - , testProperty "result has no trailing zeroes" $ - forAll genSmallFinite $ \dx -> E.evalCtx $ do - let x = E.fromBCD dx - r <- E.reduce x - let dcd = E.toBCD r - return $ case E.dValue dcd of - E.Infinite -> False - E.NaN _ _ -> False - E.Finite c _ -> - let digs = E.unCoefficient c - in all (== E.D0) digs || last digs /= E.D0 - ] - ] -- exponent and coefficient adjustment - - , testGroup "comparisons" - [ comparison "compare" E.nextPlus E.nextMinus - (fmap (fmap (fmap Left)) E.compare) - - , comparison "compareSignal" E.nextPlus - E.nextMinus (fmap (fmap (fmap Left )) E.compareSignal) - - , comparison "compareTotal" E.nextPlus E.nextMinus - (fmap (fmap (return . Right)) E.compareTotal) - - , comparison "compareTotalMag" increaseAbs decreaseAbs - (fmap (fmap (return . Right)) E.compareTotalMag) - - , testMinMax "min" False E.min - , testMinMax "max" False E.max - , testMinMax "maxMag" True E.maxMag - , testMinMax "minMag" True E.minMag - - , testGroup "sameQuantum" - [ testProperty "is true for same Decoded" $ - forAll genDecoded $ \d -> - let x = E.fromBCD d - in E.sameQuantum x x - - , testProperty "is false for different Decoded" $ - forAll ( liftM2 (,) genDecoded genDecoded - `suchThat` (not . uncurry decodedSameQuantum)) - $ \p -> let qx = E.fromBCD . fst $ p - qy = E.fromBCD . snd $ p - in not $ E.sameQuantum qx qy - ] - ] -- comparisons - - , testGroup "tests" - [ testBoolean "isFinite" genFinite E.dIsFinite E.isFinite - - , testBoolean "isInfinite" (genInfinite genSign) - E.dIsInfinite E.isInfinite - - , testGroup "isInteger" - [ testBoolean "isInteger" genInteger E.dIsInteger E.isInteger - - , let e = fromMaybe (error "isInteger exponent failed") - . E.exponent $ 2 - c = fromMaybe (error "isInteger coefficient failed") - . E.coefficient $ [E.D3] - dcd = E.Decoded E.Sign0 (E.Finite c e) - d = E.fromBCD dcd - in testProperty "returns False on 3 * 10 ^ 2" . once - . not . E.isInteger $ d - ] - - , testBoolean "isLogical" genLogical - E.dIsLogical E.isLogical - - , testBoolean "isNaN" - (genNaNDcd genSign genNaN (payloadDigits decimalDigs)) - E.dIsNaN E.isNaN - - , testBoolean "isNegative" genNegative - E.dIsNegative E.isNegative - - , testBoolean "isNormal" - (genNormal genSign (sizedDigits E.coefficientLen decimalDigs)) - E.dIsNormal E.isNormal - - , testBoolean "isPositive" genPositive - E.dIsPositive E.isPositive - - , testBoolean "isSignaling" genSignaling - E.dIsSignaling E.isSignaling - - , testBoolean "isSigned" genSigned - E.dIsSigned E.isSigned - - , testBoolean "isSubnormal" - (genSubnormal genSign (sizedDigits (E.coefficientLen - 1) decimalDigs)) - E.dIsSubnormal E.isSubnormal - - , testBoolean "isZero" genZero E.dIsZero E.isZero - - ] -- tests - - , testGroup "signs" - [ testGroup "plus" - [ testProperty "same as 0 + x where 0 has same exponent" $ - forAll genDecoded $ \d -> - let e = case E.dValue d of - E.Finite _ ex -> ex - _ -> E.zeroExponent - z = E.fromBCD $ E.Decoded E.Sign0 - (E.Finite E.zeroCoefficient e) - q = E.fromBCD d - rAdd = E.evalCtx $ E.add z q - rPlus = E.evalCtx $ E.plus q - in E.compareTotal rAdd rPlus == EQ - ] - - , testGroup "minus" - [ testProperty "same as 0 - x where 0 has same exponent" $ - forAll genDecoded $ \d -> - let e = case E.dValue d of - E.Finite _ ex -> ex - _ -> E.zeroExponent - z = E.fromBCD $ E.Decoded E.Sign0 - (E.Finite E.zeroCoefficient e) - q = E.fromBCD d - rSubt = E.evalCtx $ E.subtract z q - rMinus = E.evalCtx $ E.minus q - in E.compareTotal rSubt rMinus == EQ - ] - - , testGroup "abs" - [ testProperty "sign is correctly set" $ - forAll genDecoded $ \d -> - let expected = case E.dValue d of - E.Finite _ _ -> E.Sign0 - E.Infinite -> E.Sign0 - E.NaN _ _ -> E.dSign d - q = E.fromBCD d - actual = E.dSign . E.toBCD . E.evalCtx . E.abs $ q - in actual == expected - ] - - , testGroup "copySign" - [ testProperty "z is copy of x with sign of y" $ - forAll genDecoded $ \dx -> - forAll genDecoded $ \dy -> - let expected = dx { E.dSign = E.dSign dy } - (x, y) = (E.fromBCD dx, E.fromBCD dy) - r = E.toBCD $ E.copySign x y - in r == expected - ] - ] -- signs - - , testGroup "increment and decrement" - [ testProperty "nextMinus returns smaller result" $ - forAll genFinite $ \d -> - let q = E.fromBCD d - (r, fl) = E.runCtx $ E.nextMinus q - cmp = E.evalCtx $ E.compare r q - in fl == E.emptyFlags ==> E.isNegative cmp - - , testProperty "nextPlus returns larger result" $ - forAll genFinite $ \d -> - let q = E.fromBCD d - (r, fl) = E.runCtx $ E.nextPlus q - cmp = E.evalCtx $ E.compare r q - in fl == E.emptyFlags ==> E.isPositive cmp - - , testProperty "nextToward does not change sign of comparison" $ - forAll genFinite $ \dx -> - forAll genFinite $ \dy -> - let x = E.fromBCD dx - y = E.fromBCD dy - cmp1 = E.evalCtx $ E.compare x y - x' = E.evalCtx $ E.nextToward x y - cmp2 = E.evalCtx $ E.compare x' y - r | E.isNegative cmp1 = E.isNegative cmp2 || E.isZero cmp2 - | E.isZero cmp1 = E.isZero cmp2 - | otherwise = E.isPositive cmp2 || E.isZero cmp2 - in r - - ] -- increment and decrement - - , testGroup "digit-wise" - [ testGroup "and" - [ testProperty "x & 0 == 0" $ - forAll genLogical $ \d -> - let q = E.fromBCD d - r = E.evalCtx $ E.and q E.zero - in E.isZero r - ] - - , testGroup "or" - [ testProperty "x | 0 == x" $ - forAll genLogical $ \d -> - let r = E.evalCtx $ E.or x E.zero - x = E.fromBCD d - in E.compareOrd x r == Just EQ - - , testProperty "x | x == x" $ - forAll genLogical $ \d -> - let r = E.evalCtx $ E.or x x - cmp = E.compareTotal r x - x = E.fromBCD d - in cmp == EQ - ] - - , testGroup "xor" - [ testProperty "x XOR 0 == x" $ - forAll genLogical $ \d -> - let r = E.evalCtx $ E.xor x E.zero - cmp = E.compareTotal r x - x = E.fromBCD d - in cmp == EQ - - , testProperty "x XOR x == 0" $ - forAll genLogical $ \d -> - let r = E.evalCtx $ E.xor x x - x = E.fromBCD d - in E.isZero r - - ] - - , testGroup "invert" - [ testProperty "invert twice is idempotent" $ - forAll genLogical $ \d -> E.evalCtx $ do - let q = E.fromBCD d - r1 <- E.invert q - r2 <- E.invert r1 - return $ E.compareOrd r2 q == Just EQ - ] - - , testGroup "shift" - [ sameSignExp E.shift - ] -- shift - - , testGroup "rotate" - [ sameSignExp E.rotate - ] - ] -- digit-wise - - , testGroup "log and scale" - [ testGroup "logB" - [ testProperty "returns adjusted exponent of finite numbers" $ - forAll genFinite $ \d -> E.evalCtx $ do - let q = E.fromBCD d - lg <- E.logB q - i <- E.toInt32 E.roundUp lg - let e = fromIntegral i - r = case E.dValue d of - E.Finite c ex -> - E.unAdjustedExp (E.adjustedExp c ex) == e - _ -> False - return r - ] - - , testGroup "scaleB" - [ testProperty "scaleB x 0 == x" $ - forAll genFinite $ \d -> E.evalCtx $ do - let q = E.fromBCD d - b <- E.scaleB q E.zero - return $ E.compareOrd q b == Just EQ - ] - ] -- log and scale - - , testGroup "attributes" - [ testGroup "digits" - [ testProperty "gets same result as length of decoded coeff" $ - forAll genFinite $ \d -> - let digs = E.digits . E.fromBCD $ d - in case E.dValue d of - E.Finite c _ -> length (E.unCoefficient c) == digs - _ -> False - ] - ] -- attributes - - , testGroup "conversions" - [ testGroup "decode and encode" - [ testProperty "round trip from Decoded" $ - forAll genDecoded $ \d -> - let r = E.toBCD . E.fromBCD $ d - in printTestCase ("result: " ++ show r) (r == d) - ] - ] -- conversions - - ] -- Quad diff --git a/test/DataDir/DekaTest.hs b/test/DataDir/DekaTest.hs deleted file mode 100644 --- a/test/DataDir/DekaTest.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} - -module DataDir.DekaTest where - -import Data.Maybe -import Control.Exception -import Test.Tasty -import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck -import Test.QuickCheck.Monadic -import qualified Test.QuickCheck.Monadic as Q -import DataDir.DekaDir.QuadTest -import Data.Deka.Quad -import Data.Deka -import qualified Data.ByteString.Char8 as BS8 - --- | Tests that a binary operator never produces non-finite values. -noNonFinite - :: String - -- ^ Name - -> (Deka -> Deka -> Deka) - -> TestTree -noNonFinite n f = testProperty - (n ++ " does not produce non-finite values") prop - where - prop = - forAll genFinite $ \d1 -> - forAll genFinite $ \d2 -> - monadicIO $ do - mayR <- run (doCalc d1 d2) - case mayR of - Nothing -> Q.assert True - Just r -> Q.assert . isFinite . unDeka $ r - doCalc x y = - let (xD, yD) = (toDeka x, toDeka y) - outer = do - r <- evaluate $ f xD yD - return . Just $ r - catcher e = let _types = e :: DekaError in return Nothing - in Control.Exception.catch outer catcher - --- | Puts finite Quad into a Deka. Calls "error" if it fails. - -toDeka :: Decoded -> Deka -toDeka = fromMaybe (error "toDeka failed") . quadToDeka . fromBCD - -tests = testGroup "Deka" - [ testGroup "integralToDeka" - [ testProperty "succeeds when <= Pmax digits" $ - let r = (negate i, i) - i = biggestDigs coefficientLen - in forAll (choose r) $ \int -> isJust (integralToDeka int) - ] - - , testGroup "strToDeka" - [ testProperty "fails on non-finite strings; succeeds on finites" $ - forAll genDecoded $ \d -> - let r = strToDeka . BS8.unpack . toByteString . fromBCD $ d - in case dValue d of - Finite _ _ -> isJust r - _ -> isNothing r - ] - - , testGroup "quadToDeka" - [ testProperty "fails and succeeds as it should" $ - forAll genDecoded $ \d -> - let r = quadToDeka $ fromBCD d - in if dIsFinite d then isJust r else isNothing r - ] - - , testGroup "Deka" - [ testProperty "equivalent Deka are Eq" $ - forAll genEquivalent $ \(d1, d2) -> - let (q1, q2) = (toDeka d1, toDeka d2) - in q1 == q2 - - , noNonFinite "+" (+) - , noNonFinite "-" (-) - , noNonFinite "*" (*) - ] - ] diff --git a/test/tasty-test.hs b/test/tasty-test.hs deleted file mode 100644 --- a/test/tasty-test.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -module Main where - -import Test.Tasty - -import qualified DataDir - -tests :: TestTree -tests = testGroup "tasty-test" - [ DataDir.tests - ] - -main = defaultMain tests