module mp_ari;
{============================================================================}
{=====  mp_ari  ==========   Multi-Precision Arithmetic   ===================}
{=========================   =     =         ===          ===================}
{============================================================================}
{                                                                            }
{    File    :  MP_ARI.P                                                     }
{                                                                            }
{=   Version :  1.1                                                          }
{                                                                            }
{=   Date    :  05/29/91  ( first implementation )                           }
{=              03/21/95  ( last change )                                    }
{                                                                            }
{    Language:  PASCAL-XSC, Vers. 3.0 or later                               }
{                                                                            }
{    Authors :  K. Braune, D. Cordes, W. Kraemer, R. Hammer                  }
{                                                                            }
{    Site    :  Institute for Applied Mathematics (IAM),                     }
{               University of Karlsruhe,                                     }
{               76128 Karlsruhe, Germany.                                    }
{                                                                            }
{    Tel.    :  +49 721 608-6013 (W. Kraemer)                                }
{    Fax     :  +49 721 69 52 83 (IAM)                                       }
{----------------------------------------------------------------------------}
{                                                                            }
{    Short Description:                                                      }
{    ------------------                                                      }
{      Module for multi-precision real arithmetic. This arithmetic is also   }
{      used internally by Pascal-XSC.                                        }
{                                                                            }
{    Literature:                                                             }
{    -----------                                                             }
{      [1] W. Kraemer: Eine portable Langzahl- und Langzahlintervallarithme- }
{                      tik mit Anwendungen. ZAMM 73, 1992.                   }
{                                                                            }
{      [2] W. Kraemer: Die Berechnung von Standardfunktionen in Rechenanla-  }
{                      gen. In Chatterji, S., Fuchssteiner, B., Kulisch, U., }
{                      Liedl, R., Purkert, W. (Eds):  Jahrbuch Ueberblicke   }
{                      Mathematik 1992, Vieweg, Braunschweig, 1992.          }
{                                                                            }
{      [3] W. Kraemer: Multiple-Precision Computations with Result Verifica- }
{                      tion. In Adams, E., Kulisch, U. (Eds.): Scientific    }
{                      Computing with Automatic Result Verification.         }
{                      Academic Press, San Diego, 1993.                      }
{                                                                            }
{      [4] R. Hammer : Multi-Precision Arithmetic in PASCAL-XSC, Implementa- }
{                      tion and Apllication. Special Issue of the SCAN-93    }
{                      and the MMSC'93, Math. and Comp. for Simulation, to   }
{                      appear 1994.                                          }
{============================================================================}
use
  iostd;   { For exception handling }



{============================================================================}
{==========   Datatypes   ===================================================}
{============================================================================}
global type  mpreal = ^integer;  { Real multiple-precision data type }

global type  mpmode = global (InitFunc, TempFunc, InitOp, TempOp);
                      {== Needed for allocation of the result variable ==}
                      {== in an operator or function definition.       ==}

var MpMaxReal,NegMpMaxReal:mpreal;

{============================================================================}
{==========   Memory Management   ===========================================}
{============================================================================}
global procedure mpinit( var x : mpreal );    { Initialize a mpreal variable }
  external l_init;

global procedure mpvlcp( var x : mpreal );    { Get a local copy of a mpreal }
  external l_vlcp;                            { variable                     }

global procedure mpfree( var x : mpreal );    { Free a mpreal variable       }
  external l_free;

global procedure mptemp( var x : mpreal );    { Mark a mpreal variable to be }
  external l_temp;                            { temporarily used             }

global procedure mputmp( var x : mpreal );    { Reset the temporary flag of  }
  external l_utmp;                            { a mpreal variable            }

global function mpttst( var x : mpreal ) : boolean; { Test a mpreal variable }
  external l_ttmp;                                  { to be temporarily used }


{============================================================================}
{==========   I/O - Routines   ==============================================}
{============================================================================}
global procedure read( var t : text; var x : mpreal );
  external f_rdl1;

global procedure read( var t : text; var x : mpreal; i : integer );
  external f_rdl2;

global procedure write( var t : text; x : mpreal );
  external f_wrl1;

global procedure write( var t : text; x : mpreal; i : integer );
  external f_wrl2;

global procedure write( var t : text; x : mpreal; i, j : integer );
  external f_wrl3;

global procedure write( var t : text; x : mpreal; i, j, k : integer );
  external f_wrl4;

global procedure writehex( var t : text; x : mpreal; mode : char );
  external l_whex;   { Hexadecimal output, mode: 'x' or 'X' }
                     { to get lower or upper case digits    }

{============================================================================}
{==========   Exception Handling   ==========================================}
{============================================================================}
const                  { Error codes }
  odd_err = 1;
  conv_err = 2;

procedure traceback( var t : text );
  external f_back ;

procedure exit( ReturnCode : integer );
  external a_exit;

procedure _math_message( ErrNo : integer; var Arg : mpreal );
var
  Msg : text;
begin
  rewrite(Msg,stderr);
  write(Msg,'MP_ARI.P: !!! ERROR !!! ');

  case (ErrNo) of
    odd_err  : writeln(Msg,'odd_mp(MPREAL) argument is not an integer!');
    conv_err : writeln(Msg,'invalid conversion real:=mpreal, mpreal not in [-maxreal,maxreal]');
    else     : writeln(Msg,'Unknown error !');
  end;

  writeln(Msg,'Argument:');
  writeln(Msg,Arg);

  traceback(Msg);
  exit(-1);
end;

{============================================================================}
{==========   Logical Operators: mpreal <--> mpreal   =======================}
{============================================================================}
global operator =  ( x, y : mpreal ) res : boolean;
  external l_eq;

global operator >= ( x, y : mpreal ) res : boolean;
  external l_ge;

global operator >  ( x, y : mpreal ) res : boolean;
  external l_gt;

global operator <= ( x, y : mpreal ) res : boolean;
  external l_le;

global operator <  ( x, y : mpreal ) res: boolean;
  external l_lt;

global operator <> ( x, y : mpreal ) res : boolean;
  external l_ne;

{============================================================================}
{=====================   Type Conversion (Local)   ==========================}
{============================================================================}
{ These functions are used for explicit type conversions. The parameter 'rnd'}
{ specifies the rounding mode:                                               }
{                                                                            }
{         rnd  | Rounding                                                    }
{       -------|--------------------                                         }
{         < 0  | downwardly directed                                         }
{         = 0  | to the nearest                                              }
{         > 0  | upwardly directed                                           }
{                                                                            }
{ The following functions are locally defined.                               }
{----------------------------------------------------------------------------}
procedure b_rtol( r : real; var x : mpreal; rnd : integer );
  external b_rtol;    { real to mpreal}

procedure b_ltor1( x : mpreal; var r : real; rnd : integer );
  external b_ltor;    { mpreal to real}

procedure b_ltor( x : mpreal; var r : real; rnd : integer );
begin
  if (x<NegMpMaxReal) or (x>MpMaxReal) then
    _math_message(2,x)
  else
    b_ltor1(x,r,rnd);
end;

procedure l_rval( s : string; var val : mpreal; rnd : integer );
  external l_rval;    { string to real }


{============================================================================}
{==========   Special Assignment Operators  =================================}
{============================================================================}
{ A special assignment operator is used to initialize the result variable of }
{ a function (InitFunc) or operator (InitOp) or to mark the result variable  }
{ to be temporary (TempFunc, TempOp). 'InitFunc' and 'InitOp' are synonyms.  }
{ 'TempFunc' and 'TempOp' are also synonyms. For compatibility to older      }
{ versions of the multi-precision modules there also exists an assignment    }
{ operator of type boolean. The value 'true' is equivalent to 'InitFunc' and }
{ 'InitOp', the value 'false' is equivalent to 'TempFunc' and 'TempOp'.      }
{----------------------------------------------------------------------------}
global operator := ( var x : mpreal; mode : mpmode );
begin
  case mode of
    InitFunc, InitOp : mpinit(x);
    TempFunc, TempOp : mptemp(x);
    else:  { No action }
  end;
end;

global operator := ( var x : mpreal; mode : boolean );
begin
  if (mode) then
    mpinit(x)
  else
    mptemp(x);
end;


{============================================================================}
{==========   Assignment Operators   ========================================}
{============================================================================}
global operator := ( var x : mpreal; y : mpreal );        { mpreal := mpreal }
  external l_ass;                                         {------------------}

global operator := ( var x : mpreal; r : real );            { mpreal := real }
var                                                         {----------------}
  y : mpreal;
begin
  mpinit(y);
  b_rtol(r,y,0);
  x := y;
  mpfree(y);
end;

global operator := ( var x : mpreal; i : integer );      { mpreal := integer }
var                                                      {-------------------}
  y : mpreal;
begin
  mpinit(y);
  b_rtol(i,y,0);
  x := y;
  mpfree(y);
end;

global operator := ( var r : real; x : mpreal );            { real := mpreal }
var                                                         {----------------}
  y : mpreal;
begin
  mpvlcp(x); mpinit(y);
  y := x;
  b_ltor(y,r,0);
  mpfree(x); mpfree(y);
end;


{============================================================================}
{==========   Functions for Type Coercions   ================================}
{============================================================================}
{ Note: Functions without rounding parameter are implemented separately to   }
{       gain speed for these basic functions.                                }
{----------------------------------------------------------------------------}
global function _mpreal( r : real ) : mpreal;                { real coercion }
begin                                                        {---------------}
  _mpreal := InitFunc;
  _mpreal := r;
  _mpreal := TempFunc;
end;

global function _mpreal( r : real; rnd : integer ) : mpreal; { real-coercion }
var                                                          { with rounding }
  x : mpreal;                                                {---------------}
begin
  mpinit(x);
  b_rtol(r,x,rnd);
  _mpreal := InitFunc;
  _mpreal := x;
  _mpreal := TempFunc;
  mpfree(x);
end;

global function _mpreal( i : integer ) : mpreal;          { integer-coercion }
var                                                       {------------------}
  x : mpreal;
begin
  mpinit(x);
  _mpreal := InitFunc;
  _mpreal := i;
  _mpreal := TempFunc;
  mpfree(x);
end;

global function _mpreal( i : integer; rnd : integer ) : mpreal;
var                                                       { integer-coercion }
  x : mpreal;                                             { with rounding    }
begin                                                     {------------------}
  mpinit(x);
  b_rtol(i,x,rnd);
  _mpreal := InitFunc;
  _mpreal := x;
  _mpreal := TempFunc;
  mpfree(x);
end;

global function _real( x : mpreal ) : real;              { real-coercion for }
var                                                      { a mpreal argument }
  r : real;                                              {-------------------}
  y : mpreal;
begin
  mpvlcp(x); mpinit(y);
  y := x;
  b_ltor(y,r,0);
  _real := r;
  mpfree(x); mpfree(y);
end;

global function _real( x : mpreal; rnd : integer ) : real;
var                                                      { real-coercion for }
  r : real;                                              { a mpreal argument }
  y : mpreal;                                            { with rounding     }
begin                                                    {-------------------}
  mpvlcp(x); mpinit(y);
  y := x;
  b_ltor(y,r,rnd);
  _real := r;
  mpfree(x); mpfree(y);
end;


{============================================================================}
{==========   Precision Control   ===========================================}
{============================================================================}
global procedure setprec( i : integer );              { Set actual precision }
  external l_prec;                                    {----------------------}

global function getprec : integer;                    { Get actual precision }
  external l_rprc;                                    {----------------------}





{============================================================================}
{==========   Logical Operators: mpreal <--> real     =======================}
{==========                      real   <--> mpreal   =======================}
{============================================================================}
global operator = ( r : real; x : mpreal ) eq : boolean;
begin
  mpvlcp(x);
  eq := (_mpreal(r) = x);
  mpfree(x);
end;

global operator = ( x : mpreal; r : real ) eq : boolean;
begin
  mpvlcp(x);
  eq := (x = _mpreal(r));
  mpfree(x);
end;

global operator <> ( r : real; x : mpreal ) neq : boolean;
begin
  mpvlcp(x);
  neq := (_mpreal(r) <> x);
  mpfree(x);
end;

global operator <> ( x : mpreal; r : real ) neq : boolean;
begin
  mpvlcp(x);
  neq := (x <> _mpreal(r));
  mpfree(x);
end;

global operator > ( r : real; x : mpreal ) gt : boolean;
begin
  mpvlcp(x);
  gt := (_mpreal(r) > x);
  mpfree(x);
end;

global operator > ( x : mpreal; r : real ) gt : boolean;
begin
  mpvlcp(x);
  gt := (x > _mpreal(r));
  mpfree(x);
end;

global operator >= ( r : real; x : mpreal ) ge : boolean;
begin
  mpvlcp(x);
  ge := (_mpreal(r) >= x);
  mpfree(x);
end;

global operator >= ( x : mpreal; r : real ) ge : boolean;
begin
  mpvlcp(x);
  ge := (x >= _mpreal(r));
  mpfree(x);
end;

global operator < ( r : real; x : mpreal ) lt : boolean;
begin
  mpvlcp(x);
  lt := (_mpreal(r) < x);
  mpfree(x);
end;

global operator < ( x : mpreal; r : real ) lt : boolean;
begin
  mpvlcp(x);
  lt := (x < _mpreal(r));
  mpfree(x);
end;

global operator <= ( r : real; x : mpreal ) le : boolean;
begin
  mpvlcp(x);
  le := (_mpreal(r) <= x);
  mpfree(x);
end;

global operator <= ( x : mpreal; r : real ) le : boolean;
begin
  mpvlcp(x);
  le := (x <= _mpreal(r));
  mpfree(x);
end;


{============================================================================}
{==========   Arithmetic Operators: mpreal <--> mpreal   ====================}
{============================================================================}
global operator +  ( x : mpreal ) mplus : mpreal;
begin
  mpvlcp(x);
  mplus := InitOp;
  mplus := x;
  mplus := TempOp;
  mpfree(x);
end;

global operator -  ( x : mpreal ) mminus : mpreal;
  external l_umin;

global operator +  ( x, y : mpreal ) add : mpreal;
  external l_addc;

global operator +> ( x, y : mpreal ) addu : mpreal;
  external l_addu;

global operator +< ( x, y : mpreal ) addd : mpreal;
  external l_addd;

global operator -  ( x, y : mpreal ) sub : mpreal;
  external l_subc;

global operator -> ( x, y : mpreal ) subu : mpreal;
  external l_subu;

global operator -< ( x, y : mpreal ) subd : mpreal;
  external l_subd;

global operator *  ( x, y : mpreal ) mul : mpreal;
  external l_mulc;

global operator *> ( x, y : mpreal ) mulu : mpreal;
  external l_mulu;

global operator *< ( x, y : mpreal ) muld : mpreal;
  external l_muld;

global operator /  ( x, y : mpreal ) frac : mpreal;
  external l_divc;

global operator /> ( x, y : mpreal ) fracu : mpreal;
  external l_divu;

global operator /< ( x, y : mpreal ) fracd : mpreal;
  external l_divd;


{============================================================================}
{==========   Arithmetic Operators: real   <--> mpreal   ====================}
{==========                         mpreal <--> real     ====================}
{============================================================================}
global operator +  ( r : real; x : mpreal ) add : mpreal;
begin
  mpvlcp(x);
  add := InitOp;
  add := _mpreal(r) + x;
  add := TempOp;
  mpfree(x);
end;

global operator +>  ( r : real; x : mpreal ) addu : mpreal;
begin
  mpvlcp(x);
  addu := InitOp;
  addu := _mpreal(r) +> x;
  addu := TempOp;
  mpfree(x);
end;

global operator +<  ( r : real; x : mpreal ) addd : mpreal;
begin
  mpvlcp(x);
  addd := InitOp;
  addd := _mpreal(r) +< x;
  addd := TempOp;
  mpfree(x);
end;

global operator +  ( x : mpreal; r : real ) add : mpreal;
begin
  mpvlcp(x);
  add := InitOp;
  add := x + _mpreal(r);
  add := TempOp;
  mpfree(x);
end;

global operator +>  ( x : mpreal; r : real ) addu : mpreal;
begin
  mpvlcp(x);
  addu := InitOp;
  addu := x +> _mpreal(r);
  addu := TempOp;
  mpfree(x);
end;

global operator +<  ( x : mpreal; r : real ) addd : mpreal;
begin
  mpvlcp(x);
  addd := InitOp;
  addd := x +< _mpreal(r);
  addd := TempOp;
  mpfree(x);
end;

global operator -  ( r : real; x : mpreal ) sub : mpreal;
begin
  mpvlcp(x);
  sub := InitOp;
  sub := _mpreal(r) - x;
  sub := TempOp;
  mpfree(x);
end;

global operator ->  ( r : real; x : mpreal ) subu : mpreal;
begin
  mpvlcp(x);
  subu := InitOp;
  subu := _mpreal(r) -> x;
  subu := TempOp;
  mpfree(x);
end;

global operator -<  ( r : real; x : mpreal ) subd : mpreal;
begin
  mpvlcp(x);
  subd := InitOp;
  subd := _mpreal(r) -< x;
  subd := TempOp;
  mpfree(x);
end;

global operator -  ( x : mpreal; r : real ) sub : mpreal;
begin
  mpvlcp(x);
  sub := InitOp;
  sub := x - _mpreal(r);
  sub := TempOp;
  mpfree(x);
end;

global operator ->  ( x : mpreal; r : real ) subu : mpreal;
begin
  mpvlcp(x);
  subu := InitOp;
  subu := x -> _mpreal(r);
  subu := TempOp;
  mpfree(x);
end;

global operator -<  ( x : mpreal; r : real ) subd : mpreal;
begin
  mpvlcp(x);
  subd := InitOp;
  subd := x -< _mpreal(r);
  subd := TempOp;
  mpfree(x);
end;

global operator *  ( r : real; x : mpreal ) mul : mpreal;
begin
  mpvlcp(x);
  mul := InitOp;
  mul := _mpreal(r) * x;
  mul := TempOp;
  mpfree(x);
end;

global operator *>  ( r : real; x : mpreal ) mulu : mpreal;
begin
  mpvlcp(x);
  mulu := InitOp;
  mulu := _mpreal(r) *> x;
  mulu := TempOp;
  mpfree(x);
end;

global operator *<  ( r : real; x : mpreal ) muld : mpreal;
begin
  mpvlcp(x);
  muld := InitOp;
  muld := _mpreal(r) *< x;
  muld := TempOp;
  mpfree(x);
end;

global operator *  ( x : mpreal; r : real ) mul : mpreal;
begin
  mpvlcp(x);
  mul := InitOp;
  mul := x * _mpreal(r);
  mul := TempOp;
  mpfree(x);
end;

global operator *>  ( x : mpreal; r : real ) mulu : mpreal;
begin
  mpvlcp(x);
  mulu := InitOp;
  mulu := x *> _mpreal(r);
  mulu := TempOp;
  mpfree(x);
end;

global operator *<  ( x : mpreal; r : real ) muld : mpreal;
begin
  mpvlcp(x);
  muld := InitOp;
  muld := x *< _mpreal(r);
  muld := TempOp;
  mpfree(x);
end;

global operator /  ( r : real; x : mpreal ) frac : mpreal;
begin
  mpvlcp(x);
  frac := InitOp;
  frac := _mpreal(r) / x;
  frac := TempOp;
  mpfree(x);
end;

global operator />  ( r : real; x : mpreal ) fracu : mpreal;
begin
  mpvlcp(x);
  fracu := InitOp;
  fracu := _mpreal(r) /> x;
  fracu := TempOp;
  mpfree(x);
end;

global operator /<  ( r : real; x : mpreal ) fracd : mpreal;
begin
  mpvlcp(x);
  fracd := InitOp;
  fracd := _mpreal(r) /< x;
  fracd := TempOp;
  mpfree(x);
end;

global operator /  ( x : mpreal; r : real ) frac : mpreal;
begin
  mpvlcp(x);
  frac := InitOp;
  frac := x / _mpreal(r);
  frac := TempOp;
  mpfree(x);
end;

global operator />  ( x : mpreal; r : real ) fracu : mpreal;
begin
  mpvlcp(x);
  fracu := InitOp;
  fracu := x /> _mpreal(r);
  fracu := TempOp;
  mpfree(x);
end;

global operator /<  ( x : mpreal; r : real ) fracd : mpreal;
begin
  mpvlcp(x);
  fracd := InitOp;
  fracd := x /< _mpreal(r);
  fracd := TempOp;
  mpfree(x);
end;


{============================================================================}
{==========   Arithmetic Operators: integer <--> mpreal    ==================}
{==========                         mpreal  <--> integer   ==================}
{============================================================================}
{ Only the multiplicative operators * and / are supplied!                    }
{----------------------------------------------------------------------------}
global operator * ( i : integer; x : mpreal ) mul : mpreal;
begin
  mpvlcp(x);
  mul := InitOp;
  mul := _mpreal(i) * x;
  mul := false;
  mpfree(x);
end;

global operator *> ( i : integer; x : mpreal ) mulu : mpreal;
begin
  mpvlcp(x);
  mulu := InitOp;
  mulu := _mpreal(i) *> x;
  mulu := TempOp;
  mpfree(x);
end;

global operator *< ( i : integer; x : mpreal ) muld : mpreal;
begin
  mpvlcp(x);
  muld := InitOp;
  muld := _mpreal(i) *< x;
  muld := TempOp;
  mpfree(x);
end;

global operator * ( x : mpreal; i : integer ) mul : mpreal;
begin
  mpvlcp(x);
  mul := InitOp;
  mul := x * _mpreal(i);
  mul := TempOp;
  mpfree(x);
end;

global operator *> ( x : mpreal; i : integer ) mulu : mpreal;
begin
  mpvlcp(x);
  mulu := InitOp;
  mulu := x *> _mpreal(i);
  mulu := TempOp;
  mpfree(x);
end;

global operator *< ( x : mpreal; i : integer ) muld : mpreal;
begin
  mpvlcp(x);
  muld := InitOp;
  muld := x *< _mpreal(i);
  muld := TempOp;
  mpfree(x);
end;

global operator / ( i : integer; x : mpreal ) frac : mpreal;
begin
  mpvlcp(x);
  frac := InitOp;
  frac := _mpreal(i) / x;
  frac := TempOp;
  mpfree(x);
end;

global operator /> ( i : integer; x : mpreal ) fracu : mpreal;
begin
  mpvlcp(x);
  fracu := InitOp;
  fracu := _mpreal(i) /> x;
  fracu := TempOp;
  mpfree(x);
end;

global operator /<  ( i : integer; x : mpreal ) fracd : mpreal;
begin
  mpvlcp(x);
  fracd := InitOp;
  fracd := _mpreal(i) /< x;
  fracd := TempOp;
  mpfree(x);
end;

global operator /  ( x : mpreal; i : integer ) frac : mpreal;
begin
  mpvlcp(x);
  frac := InitOp;
  frac := x / _mpreal(i);
  frac := TempOp;
  mpfree(x);
end;

global operator />  ( x : mpreal; i : integer ) fracu : mpreal;
begin
  mpvlcp(x);
  fracu := InitOp;
  fracu := x /> _mpreal(i);
  fracu := TempOp;
  mpfree(x);
end;

global operator /<  ( x : mpreal; i : integer ) fracd : mpreal;
begin
  mpvlcp(x);
  fracd := InitOp;
  fracd := x /< _mpreal(i);
  fracd := TempOp;
  mpfree(x);
end;


{============================================================================}
{==========   Standard Functions   ==========================================}
{============================================================================}

{-----------------------------------}
{ Conversions from string to mpreal }
{-----------------------------------}
global function mpval( s : string ) : mpreal;        { No rounding parameter }
var                                                  {-----------------------}
  temp : mpreal;
begin
  mpinit(temp);
  l_rval(s,temp,0);
  mpval := InitFunc;
  mpval := temp;
  mpval := TempFunc;
  mpfree(temp);
end;

global function mpval( s : string; rnd : integer ) : mpreal;
var                                                { With rounding parameter }
  temp : mpreal;                                   {-------------------------}
begin
  mpinit(temp);
  l_rval(s,temp,rnd);
  mpval := InitFunc;
  mpval := temp;
  mpval := TempFunc;
  mpfree(temp);
end;


{---------------------------------------------------}
{ Composing, decomposing, successor and predecessor }
{---------------------------------------------------}
global function comp( mant : mpreal; expo : integer ) : mpreal;
  external l_comp;

global function expo( x : mpreal ) : integer;
  external l_expo;

global function mant( x : mpreal ) : mpreal;
  external l_mant;

function pred1( x : mpreal ) : mpreal;
  external l_pred;

global function pred( x : mpreal ) : mpreal;
  begin
    pred:=true;
    if x=0 then
      pred:=comp(_mpreal(-0.5),-2147483646)
    else
      pred:=pred1(x);
    pred:=false;
  end;

function succ1( x : mpreal ) : mpreal;
  external l_succ;

global function succ( x : mpreal ) : mpreal;
  begin
    succ:=true;
    if x=0 then
      succ:=comp(_mpreal(0.5),-2147483646)
    else
      succ:=succ1(x);
    succ:=false;
  end;


{-----------------------------------------------}
{ Sign, trunc and round: result of type integer }
{-----------------------------------------------}
global function sign( x : mpreal ) : integer;
  external l_sign;

global function trunc( x : mpreal ) : integer;
  external l_trun;

global function round( x : mpreal ) : integer;
  external l_rond;


{----------------------------------------}
{ Absolute value, square and square root }
{----------------------------------------}
global function abs( x : mpreal ) : mpreal;
  external l_abs;

global function sqr( x : mpreal ) : mpreal;
begin
  mpvlcp(x);
  sqr := InitFunc;
  sqr := x*x;
  sqr := TempFunc;
  mpfree(x);
end;

global function sqrt( x : mpreal ) : mpreal;
  external l_sqrt;


{-----------------------}
{ Logarithmic functions }
{-----------------------}
global function ln( x : mpreal ) : mpreal;
  external l_log;

global function loga( x, a : mpreal ) : mpreal;
  external l_loga;

global function log2( x: mpreal ) : mpreal;
begin
  mpvlcp(x);
  log2 := InitFunc;
  log2 := loga(x,_mpreal(2));
  log2 := TempFunc;
  mpfree(x);
end;

global function log10( x: mpreal ) : mpreal;
begin
  mpvlcp(x);
  log10 := InitFunc;
  log10 := loga(x,_mpreal(10));
  log10 := TempFunc;
  mpfree(x);
end;


{-----------------------}
{ Exponential functions }
{-----------------------}
global function exp( x : mpreal ) : mpreal;
  external l_exp;

global function power( x, y : mpreal ) : mpreal;
  external l_pow;

global function exp2( x : mpreal ) : mpreal;
begin
  mpvlcp(x);
  exp2 := InitFunc;
  exp2 := power(_mpreal(2),x);
  exp2 := TempFunc;
  mpfree(x);
end;

global function exp10( x : mpreal ) : mpreal;
begin
  mpvlcp(x);
  exp10 := InitFunc;
  exp10 := power(_mpreal(10),x);
  exp10 := TempFunc;
  mpfree(x);
end;


{-------------------------}
{ Trigonometric functions }
{-------------------------}
global function sin( x : mpreal ) : mpreal;
  external l_sin;

global function cos( x : mpreal ) : mpreal;
  external l_cos;

global function tan( x : mpreal ) : mpreal;
  external l_tan;

global function cot( x : mpreal ) : mpreal;
  external l_cot;


{---------------------------------}
{ Inverse trigonometric functions }
{---------------------------------}
global function arcsin( x : mpreal ) : mpreal;
  external l_asin;

global function arccos( x : mpreal ) : mpreal;
  external l_acos;

global function arctan( x : mpreal ) : mpreal;
  external l_atan;

global function arccot( x : mpreal ) : mpreal;
  external l_acot;

global function arctan2( x, y : mpreal ) : mpreal;
  external l_atn2;


{----------------------}
{ Hyperbolic functions }
{----------------------}
global function sinh( x : mpreal ) : mpreal;
  external l_sinh;

global function cosh( x : mpreal ) : mpreal;
  external l_cosh;

global function tanh( x : mpreal ) : mpreal;
  external l_tanh;

global function coth( x : mpreal ) : mpreal;
  external l_coth;


{------------------------------}
{ Inverse hyperbolic functions }
{------------------------------}
global function arsinh( x : mpreal ) : mpreal;
  external l_asnh;

global function arcosh( x : mpreal ) : mpreal;
  external l_acsh;

global function artanh( x : mpreal ) : mpreal;
  external l_atnh;

global function arcoth( x : mpreal ) : mpreal;
  external l_acth;


{============================================================================}
{==========   Miscellaneous Functions   =====================================}
{============================================================================}
global function mant_length( x : mpreal ) : integer;   { Number of mp-digits }
  external l_mlen;                                     {---------------------}

procedure exact_copy( var x : mpreal; y : mpreal; var r, l : integer);
  external l_exct;

global function copy( x : mpreal ) : mpreal;          { Exact copy, ignoring }
var                                                   { the actual precision }
  Dummy : integer;                                    {----------------------}
  y     : mpreal;
begin
  mpvlcp(x); mpinit(y);
  exact_copy(y,x,Dummy,Dummy);
  copy := InitFunc;
  copy := y;
  copy := TempFunc;
  mpfree(x); mpfree(y);
end;

global function trunc_mp( x : mpreal ) : mpreal;  { Integer part of a mpreal }
var                                               {--------------------------}
  w, y, z     : mpreal;
  OldPrec, nn : integer;
  neg         : boolean;
begin
  mpvlcp(x); mpinit(w); mpinit(y); mpinit(z);

  neg := (x < 0);
  if neg then x := abs(x);
  OldPrec:= getprec;  { save actual precision }

  y := 0;
  if (x < maxint) then
    y := trunc(x)
  else
    begin
      nn := trunc(log2(x)/32+1);
      setprec(nn);
      z := x;
      w := 1;
      while ( z /< w > maxint) do
        begin  w := w * maxint;  end;
      while (w > 1) do
      begin
        y := y + trunc(z/<w)*w;
        z := z - trunc(z/<w)*w;
        w := w/maxint;   { exact division }
      end;
      y := y + trunc(x-y);
    end;

  if neg then y := -y;

  setprec(OldPrec);  { restore old precision }

  trunc_mp:= InitFunc;
  trunc_mp:= y;
  trunc_mp:= TempFunc;

  mpfree(x); mpfree(w); mpfree(y); mpfree(z);
end;

global function odd_mp( x : mpreal) : boolean;     { Test for a mpreal to be }
var                                                { an odd integer value    }
  y : mpreal;                                      {-------------------------}
begin
  mpvlcp(x); mpinit(y);

  y := x;
  if (y <> trunc_mp(y)) then
    _math_message(odd_err,x)
  else
    odd_mp := (trunc_mp(y/2)*2 <> y);

  mpfree(x); mpfree(y);
end;

global function min( x, y : mpreal ) : mpreal;      { Minimum of two mpreals }
begin                                               {------------------------}
  mpvlcp(x); mpvlcp(y);
  min := InitFunc;
  if (x < y) then min := x
             else min := y;
  min := TempFunc;
  mpfree(x); mpfree(y);
end;

global function max( x, y : mpreal ) : mpreal;      { Maximum of two mpreals }
begin                                               {------------------------}
  mpvlcp(x); mpvlcp(y);
  max := InitFunc;
  if (x > y) then max := x
             else max := y;
  max := TempFunc;
  mpfree(x); mpfree(y);
end;

{============================================================================}
{==========   Module Initalization Part   ===================================}
{============================================================================}
begin
  mpinit(MpMaxReal); mpinit(NegMpMaxReal);
  MpMaxReal:=1.7976931348623158e308;
  NegMpMaxReal:=-1.7976931348623158e308;
end.
{====================  Last line of module mp_ari: 1130  ====================}