(********************************************************************)
(*                                                                  *)
(*  bin64.s7i     64-bit binary value support library               *)
(*  Copyright (C) 2015 - 2024  Thomas Mertes                        *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


include "bigint.s7i";
include "float.s7i";


(**
 *  Binary values with 64 bits.
 *  This type supports bitwise operations but no integer arithmetic.
 *  The internal representation is the same as for integer.
 *)
const type: bin64 is subtype object;

const proc: destroy (ref bin64: aValue)                        is action "GEN_DESTR";
const proc: (ref bin64: dest) ::= (ref bin64: source)          is action "INT_CREATE";
IN_PARAM_IS_VALUE(bin64);

const proc: (inout bin64: dest) := (in bin64: source)          is action "INT_CPY";


(**
 *  Convert to bin64.
 *  @return the unchanged value as bin64.
 *)
const func bin64: bin64 (in integer: number)                   is action "INT_ICONV1";


(**
 *  Default value of ''bin64'' (bin64(0)).
 *)
const bin64: (attr bin64) . value   is bin64(0);


(**
 *  Convert to bin64.
 *  @return the unchanged value as bin64.
 *  @exception RANGE_ERROR The number is negative or too big to fit
 *             into a bin64 value.
 *)
const func bin64: bin64 (in bigInteger: number)                is action "BIN_BINARY";


(**
 *  Convert to bin64.
 *  @return the unchanged value as bin64.
 *)
const func bin64: bin64 (in char: ch) is
  return bin64(ord(ch));


(**
 *  Get bits in IEEE 754 double-precision representation from a float.
 *  IEEE 754 is a standard for floating point arithmetic.
 *  The double-precision format of IEEE 754 has a sign bit,
 *  an 11 bit exponent, and a 52 bit mantissa.
 *   bin64(1.0)  returns  bin64(16#3ff0000000000000)
 *  @param number Float value to be converted to bin64.
 *  @return 64 bits in IEEE 754 double-precision float representation.
 *)
const func bin64: bin64 (in float: number)                     is action "FLT_DOUBLE2BITS";


(**
 *  Convert to integer.
 *  @return the unchanged value as integer.
 *)
const func integer: (attr integer) conv (in bin64: bits)       is action "INT_ICONV3";


(**
 *  Convert to bin64.
 *  @return the unchanged value as bin64.
 *)
const func bin64: (attr bin64) conv (in integer: anInt)        is action "INT_ICONV3";


(**
 *  Convert to integer.
 *  @return the unchanged value as integer.
 *)
const func integer: ord (in bin64: bits)                       is action "INT_ICONV1";


(**
 *  Convert to integer.
 *  @return the unchanged value as integer.
 *)
const func integer: integer (in bin64: bits)                   is action "INT_ICONV1";


(**
 *  Convert to bigInteger.
 *  @return the unchanged value as integer.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func bigInteger: big (in bin64: bits)                    is action "BIN_BIG";


(**
 *  Convert to bigInteger.
 *  @return the unchanged value as integer.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func bigInteger: bigInteger (in bin64: bits)             is action "BIN_BIG";


(**
 *  Get a float from bits in IEEE 754 double-precision representation.
 *  IEEE 754 is a standard for floating point arithmetic.
 *  The double-precision format of IEEE 754 has a sign bit,
 *  an 11 bit exponent, and a 52 bit mantissa.
 *   float(bin64(16#3ff0000000000000))  returns  1.0
 *  @param bits Bits to be converted to a float.
 *  @return a float from bits in double-precision float representation.
 *)
const func float: float (in bin64: bits)                       is action "FLT_BITS2DOUBLE";


(**
 *  Compare two bin64 values.
 *  @return -1, 0 or 1 if the first argument is considered to be
 *          respectively less than, equal to, or greater than the
 *          second.
 *)
const func integer: compare (in bin64: bits1, in bin64: bits2) is action "BIN_CMP";


(**
 *  Compute the hash value of a bin64 value.
 *  @return the hash value.
 *)
const func integer: hashCode (in bin64: bits)                  is action "INT_HASHCODE";


(**
 *  Compute pseudo-random bin64 value.
 *  The random values are uniform distributed.
 *  @return a random bin64 value.
 *)
const func bin64: rand (attr bin64) is
  return bin64(rand(integer.first, integer.last));


(**
 *  Number of bits in the minimum binary representation.
 *  Leading zero bits are not part of the minimum binary representation.
 *   bitLength(bin64(0))  returns 0
 *   bitLength(bin64(1))  returns 1
 *   bitLength(bin64(4))  returns 3
 *  @return the number of bits.
 *)
const func integer: bitLength (in bin64: bits)                 is action "BIN_BIT_LENGTH";


(**
 *  Number of lowest-order zero bits in the binary representation.
 *  This is equal to the index of the lowest-order one bit (indices start with 0).
 *  If there are only zero bits (''bits'' is bin64(0)) the result is -1.
 *   lowestSetBit(bin64(0))  returns -1
 *   lowestSetBit(bin64(1))  returns  0
 *   lowestSetBit(bin64(4))  returns  2
 *  @return the number of lowest-order zero bits or -1 for lowestSetBit(bin64(0)).
 *)
const func integer: lowestSetBit (in bin64: bits)              is action "BIN_LOWEST_SET_BIT";


(**
 *  Convert an ''bin64'' value to a [[string]].
 *  The values is converted to a string with decimal representation.
 *  The conversion interprets the ''bin64'' value as unsigned.
 *  @return the string result of the conversion.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: str (in bin64: bits)                        is action "BIN_STR";


(**
 *  Convert a ''bin64'' value to a [[string]] using a radix.
 *  The conversion uses the numeral system with the given ''base''.
 *  Digit values from 10 upward are encoded with lower case letters.
 *  E.g.: 10 is encoded with a, 11 with b, etc.
 *   bin64(48879) radix 16   returns "beef"
 *  @return the string result of the conversion.
 *  @exception RANGE_ERROR If base < 2 or base > 36 holds.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: (in bin64: bits) radix (in integer: base)   is action "BIN_radix";


(**
 *  Convert a ''bin64'' value to a [[string]] using a radix.
 *  The conversion uses the numeral system with the given ''base''.
 *  Digit values from 10 upward are encoded with upper case letters.
 *  E.g.: 10 is encoded with A, 11 with B, etc.
 *   bin64(48879) RADIX 16   returns "BEEF"
 *  @return the string result of the conversion.
 *  @exception RANGE_ERROR If base < 2 or base > 36 holds.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: (in bin64: bits) RADIX (in integer: base)   is action "BIN_RADIX";


(**
 *  Convert a ''bin64'' into a [[string]] of bytes with big-endian encoding.
 *  The result uses binary representation with a base of 256.
 *  The result contains chars (bytes) with an ordinal <= 255.
 *   bytes(bin64(1413829460), BE, 5)  returns "\0;TEST"
 *   bytes(bin64(1413829460), BE, 4)  returns "TEST"
 *   bytes(bin64(1413829460), BE, 3)  raises RANGE_ERROR
 *  @param bits Bin64 to be converted.
 *  @param length Determines the length of the result string.
 *  @return a string of ''length'' bytes with the unsigned binary
 *          representation of ''bits''.
 *  @exception RANGE_ERROR If ''length'' is negative or zero, or
 *                         if the result would not fit in ''length'' bytes.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: bytes (in bin64: bits, BE, in integer: length) is action "BIN_N_BYTES_BE";


(**
 *  Convert a ''bin64'' into a [[string]] of bytes with little-endian encoding.
 *  The result uses binary representation with a base of 256.
 *  The result contains chars (bytes) with an ordinal <= 255.
 *   bytes(bin64(1413829460), LE, 5)  returns "TEST\0;"
 *   bytes(bin64(1413829460), LE, 4)  returns "TEST"
 *   bytes(bin64(1413829460), LE, 3)  raises RANGE_ERROR
 *  @param bits Bin64 to be converted.
 *  @param length Determines the length of the result string.
 *  @return a string of ''length'' bytes with the unsigned binary
 *          representation of ''bits''.
 *  @exception RANGE_ERROR If ''length'' is negative or zero, or
 *                         if the result would not fit in ''length'' bytes.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: bytes (in bin64: bits, LE, in integer: length) is action "BIN_N_BYTES_LE";


(**
 *  Check if two bin64 values are equal.
 *  @return TRUE if the two values are equal,
 *          FALSE otherwise.
 *)
const func boolean: (in bin64: bits1) = (in bin64: bits2)      is action "INT_EQ";


(**
 *  Check if two bin64 values are not equal.
 *  @return FALSE if both values are equal,
 *          TRUE otherwise.
 *)
const func boolean: (in bin64: bits1) <> (in bin64: bits2)     is action "INT_NE";


(**
 *  Compute a bitwise ''and'' of two bin64 values.
 *   bin64(2#1100) & bin64(2#1010)  returns  bin64(2#1000)
 *  @return the bitwise ''and'' of the two values.
 *)
const func bin64: (in bin64: bits1) & (in bin64: bits2)        is action "BIN_AND";


(**
 *  Compute a bitwise inclusive ''or'' of two bin64 values.
 *   bin64(2#1100) | bin64(2#1010)  returns  bin64(2#1110)
 *  @return the bitwise inclusive ''or'' of the two values.
 *)
const func bin64: (in bin64: bits1) | (in bin64: bits2)        is action "BIN_OR";


(**
 *  Compute a bitwise exclusive or (''xor'') of two bin64 values.
 *   bin64(2#1100) >< bin64(2#1010)  returns  bin64(2#0110)
 *  @return the bitwise ''xor'' of the two values.
 *)
const func bin64: (in bin64: bits1) >< (in bin64: bits2)       is action "BIN_XOR";


(**
 *  Compute a bitwise ''not'' of a bin64 value.
 *   ~bin64(2#1)  returns  bin64(16#fffffffffffffffe_)
 *  @return the bitwise ''not'' of the value.
 *)
const func bin64: ~ (in bin64: bits) is
  return bits >< bin64(16#ffffffffffffffff_);


(**
 *  Compute ''bits'' logically left shifted by ''lshift''.
 *  Bits shifted beyond the highest bit position are lost.
 *   bin64(16#1234567890abcde0) << 4  returns  bin64(16#234567890abcde00)
 *   bin64(1) << 64                   raises OVERFLOW_ERROR
 *  @return the left shifted value.
 *  @exception OVERFLOW_ERROR If the shift amount is
 *             negative or greater equal 64.
 *)
const func bin64: (in bin64: bits) << (in integer: lshift)     is action "BIN_LSHIFT";


(**
 *  Compute ''bits'' logically right shifted by ''rshift''.
 *  Bits shifted beyond the lowest bit position are lost.
 *   bin64(16#1234567890abcde0) >> 4  returns  bin64(16#1234567890abcde)
 *  @return the right shifted value.
 *  @exception OVERFLOW_ERROR If the shift amount is
 *             negative or greater equal 64.
 *)
const func bin64: (in bin64: bits) >> (in integer: rshift)     is action "BIN_RSHIFT";


(**
 *  Logical left shift ''bits'' by ''lshift'' and assign the result back to ''bits''.
 *  Bits shifted beyond the highest bit position are lost.
 *  @exception OVERFLOW_ERROR If the shift amount is
 *             negative or greater equal 64.
 *)
const proc: (inout bin64: bits) <<:= (in integer: lshift)      is action "BIN_LSHIFT_ASSIGN";


(**
 *  Logical right shift ''bits'' by ''rshift'' and assign the result back to ''bits''.
 *  Bits shifted beyond the lowest bit position are lost.
 *  @exception OVERFLOW_ERROR If the shift amount is
 *             negative or greater equal 64.
 *)
const proc: (inout bin64: bits) >>:= (in integer: rshift)      is action "BIN_RSHIFT_ASSIGN";


(**
 *  Compute a bitwise ''and'' and assign the result back to ''bits1''.
 *)
const proc: (inout bin64: bits1) &:= (in bin64: bits2)         is action "BIN_AND_ASSIGN";


(**
 *  Compute a bitwise inclusive ''or'' and assign the result back to ''bits1''.
 *)
const proc: (inout bin64: bits1) |:= (in bin64: bits2)         is action "BIN_OR_ASSIGN";


(**
 *  Compute a bitwise exclusive or (''xor'') and assign the result back to ''bits1''.
 *)
const proc: (inout bin64: bits1) ><:= (in bin64: bits2)        is action "BIN_XOR_ASSIGN";


(**
 *  Rotate the bits of a bin64 value left by shiftCount bits.
 *  The vacant bit positions at the right side are filled in with
 *  the bits that are shifted out at the left side.
 *   rotLeft(bin64(16#76543210fedcba98), 12)  returns  bin64(16#43210fedcba98765)
 *  @return the left rotated value.
 *  @exception OVERFLOW_ERROR If the shift amount is negative
 *             or greater than 64.
 *)
const func bin64: rotLeft (in bin64: x, in integer: shiftCount) is
  return x << shiftCount | x >> (64 - shiftCount);


(**
 *  Rotate the bits of a bin64 value right by shiftCount bits.
 *  The vacant bit positions at the left side are filled in with
 *  the bits that are shifted out at the right side.
 *   rotRight(bin64(16#76543210fedcba98), 40)  returns  bin64(16#10fedcba98765432)
 *  @return the right rotated value.
 *  @exception OVERFLOW_ERROR If the shift amount is negative
 *             or greater than 64.
 *)
const func bin64: rotRight (in bin64: x, in integer: shiftCount) is
  return x >> shiftCount | x << (64 - shiftCount);


(**
 *  Get 64 bits from a bitset starting with ''lowestBitNum''.
 *  @return a bit pattern with 64 bits from ''set1''.
 *)
const func bin64: getBinary (in bitset: set1,
                             in integer: lowestBitNum)         is action "BIN_GET_BINARY_FROM_SET";


(**
 *  Get bits in MBF double-precision representation from a float.
 *  Microsoft Binary Format (MBF) is a format for floating point numbers.
 *  The double-precision version of MBF has a 8 bit exponent, a sign bit
 *  and a 55 bit mantissa.
 *   float2MbfBits(1.0, DOUBLE)  returns  bin64(16#8100000000000000_)
 *  @param number Float value to be converted to bin64.
 *  @return 64 bits in MBF double-precision float representation.
 *  @exception RANGE_ERROR If number is not representable in MBF.
 *             NaN, Infinity and -Infinity are not representable
 *             in MBF. Numbers with an absolute value larger than
 *             1.7014118346046921e+38 are also not representable
 *             in MBF.
 *)
const func bin64: float2MbfBits (in float: number, DOUBLE) is func
  result
    var bin64: bits is bin64(0);
  local
    const integer: ieeeExponentBits is 11;
    const integer: ieeeMantissaBits is 52;
    const bin64: ieeeSignMask is bin64(1) << (ieeeExponentBits + ieeeMantissaBits);
    const bin64: ieeeMantissaMask is bin64(pred(1 << ieeeMantissaBits));
    const integer: mbfExponentBits is 8;
    const integer: mbfMantissaBits is 55;
    const integer: mbfMaxExponent is pred(2 ** mbfExponentBits);
    const integer: mbfExponentBias is 129;
    var floatElements: ieeeElements is floatElements.value;
    var bin64: fractionBits is bin64(0);
    var integer: mbfExponent is 0;
  begin
    if isNaN(number) or abs(number) = Infinity then
      raise RANGE_ERROR;
    elsif number <> 0.0 then
      ieeeElements := decompose(number);
      fractionBits := bin64(ieeeElements.fraction);
      mbfExponent := ieeeElements.exponent - 1 + mbfExponentBias;
      if mbfExponent > mbfMaxExponent then
        raise RANGE_ERROR;
      elsif mbfExponent > 0 then
        bits := (bin64(mbfExponent) << succ(mbfMantissaBits)) |
                ((fractionBits & ieeeSignMask) >> mbfExponentBits) |
                ((fractionBits & ieeeMantissaMask) << (mbfMantissaBits - ieeeMantissaBits));
      end if;
    end if;
  end func;


(**
 *  Get a float from bits in MBF double-precision representation.
 *  Microsoft Binary Format (MBF) is a format for floating point numbers.
 *  The double-precision version of MBF has a 8 bit exponent, a sign bit
 *  and a 55 bit mantissa.
 *   mbfBits2Float(bin64(16#8100000000000000_))  returns  1.0
 *  @param bits Bits to be converted to a float.
 *  @return a float from bits in double-precision float representation.
 *)
const func float: mbfBits2Float (in bin64: bits) is func
  result
    var float: aFloat is 0.0;
  local
    const integer: mantissaBits is 55;
    const bin64: mantissaMask is bin64(pred(1 << mantissaBits));
    const bin64: mantissaSign is bin64(1 << mantissaBits);
    const integer: exponentBias is 129;
    var integer: exponent is 0;
  begin
    exponent := ord(bits >> succ(mantissaBits));
    if exponent <> 0 then
      # Ignore sign bit and set implicit leading one bit of mantissa instead.
      aFloat := flt(ord(mantissaSign | bits & mantissaMask));
      # Check sign bit.
      if ord(bits & mantissaSign) <> 0 then
        aFloat := -aFloat;
      end if;
      aFloat := aFloat * 2.0 ** (exponent - exponentBias - mantissaBits);
    end if;
  end func;


(**
 *  Convert a string of bytes (interpreted as big-endian) to a bin64.
 *  @param byteStri String of bytes to be converted. The bytes are
 *         interpreted as binary big-endian representation with a
 *         base of 256.
 *  @return a bin64 created from 'byteStri'.
 *  @exception RANGE_ERROR If 'byteStri' is empty or
 *             if characters beyond '\255;' are present or
 *             if the result value cannot be represented with a bin64.
 *)
const func bin64: bin64 (in string: byteStri, BE)              is action "BIN_BYTES_BE_2_UINT";


(**
 *  Convert a string of bytes (interpreted as little-endian) to a bin64.
 *  @param byteStri String of bytes to be converted. The bytes are
 *         interpreted as binary little-endian representation with a
 *         base of 256.
 *  @return a bin64 created from 'byteStri'.
 *  @exception RANGE_ERROR If 'byteStri' is empty or
 *             if characters beyond '\255;' are present or
 *             if the result value cannot be represented with a bin64.
 *)
const func bin64: bin64 (in string: byteStri, LE)              is action "BIN_BYTES_LE_2_UINT";


# Allows 'array bin64' everywhere without extra type definition.
const type: _bin64Array is array bin64;


enable_output(bin64);

CASE_DECLS(bin64);
DECLARE_TERNARY(bin64);