fpc/rtl/inc/int64.inc

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1998 by the Free Pascal development team

    This file contains some helper routines for int64 and qword

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$Q- no overflow checking }
{$R- no range checking }

    type
       qwordrec = packed record
         low : cardinal;
         high : cardinal;
       end;

    function count_leading_zero(q : qword) : longint;

      var
         r,i : longint;

      begin
         r:=0;
         for i:=0 to 31 do
           begin
              if (qwordrec(q).high and ($80000000 shr i))<>0 then
                begin
                   count_leading_zero:=r;
                   exit;
                end;
              inc(r);
           end;
         for i:=0 to 31 do
           begin
              if (qwordrec(q).low and ($80000000 shr i))<>0 then
                begin
                   count_leading_zero:=r;
                   exit;
                end;
              inc(r);
           end;
         count_leading_zero:=r;
      end;

    function divqword(z,n : qword) : qword;safecall;

      begin
      end;

    function divint64(z,n : int64) : int64;safecall;

      var
         sign : boolean;
         q1,q2,q3 : qword;

      begin
         sign:=false;
         if z<0 then
           begin
              sign:=not(sign);
              q1:=qword(-z);
           end
         else
           q1:=z;
         if q<0 then
           begin
              sign:=not(sign);
              q2:=qword(-q);
           end
         else
           q2:=q;

          { is coded by the compiler as call to divqword }
          q3:=q1 div q2;

         if sign then
           divint64:=-q3
         else
           divint64:=q3;
      end;

    { multiplies two qwords }
    function mulqword(f1,f2 : qword;checkoverflow : boolean) : qword;safecall;

      var
         res,bitpos : qword;
         l : longint;

      begin
         res:=0;
         bitpos:=1;

         { we can't write qword constants directly :( }
         bitpos64:=1 shl 63;

         for l:=0 to 63 do
           begin
              if (f2 and bitpos)<>0 then
              if checkoverflow then
{$Q+}                
                res:=res+f1
{$Q-}
              else
                res:=res+f1;

              if ((f1 and bitpos64)<>0) and checkoverflow then
                int_overflow;

              f1:=f1 shl 1;
              bitpos:=bitpos shl 1;
           end;
      end;

    {    multiplies two int64 ....
       fpuint64 = false:
         ... using the the qword multiplication
       fpuint64 = true:
         ... using the comp multiplication
     }
    function mulint64(f1,f2 : int64;checkoverflow : boolean) : int64;safecall;

      var
         sign : boolean;
         q1,q2,q3 : qword;

      begin
         sign:=false;
         if f1<0 then
           begin
              sign:=not(sign);
              q1:=qword(-f1);
           end
         else
           q1:=f1;
         if f2<0 then
           begin
              sign:=not(sign);
              q2:=qword(-f2);
           end
         else
           q2:=f2;
         { the q1*q2 is coded as call to mulqword }
         if checkoverflow then
{$Q+}
           q3:=q1*q2 
         else
{$Q-}
           q3:=q1*q2

         if sign then
           mulint64:=-q3
         else
           mulint64:=q3;
      end;

    procedure int_str(value : qword;var s : string);

      var
         hs : string;

      begin
         hs:='';
         repeat
           hs:=chr(longint(value mod 10)+48)+hs;
           value:=value div 10;
         until value=0;
         s:=hs;
      end;

    procedure int_str(value : int64;var s : string);

      var
         hs : string;
         q : qword;

      begin
         if value<0 then
           begin
              q:=qword(-value);
              int_str(q,hs);
              s:='-'+hs;
           end
         else
           int_str(qword(value),s);
      end;

{
  $Log$
  Revision 1.2  1999-01-06 12:25:03  florian
    * naming for str(...) routines inserted
    * don't know what in int64 changed

  Revision 1.1  1998/12/12 12:15:41  florian
    + first implementation

}