{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH Out}
{$MODESWITCH RESULT}
unit dparser;

interface

const
  // No error
  PARSER_OK                     = 0;
  // More characters were expected
  PARSER_ERROR_NOT_ENOUGH_CHARS = 1;
  // Input value is greater than can be represented
  PARSER_ERROR_OVERFLOW         = 2;
  // Input value is less than can be represented
  PARSER_ERROR_UNDERFLOW        = 3;
  // Client code may declare their own error codes as PARSER_ERROR_CLIENT+i
  PARSER_ERROR_CLIENT           = 1000;

  POWEROF10: array[0 .. 11] of UInt64 = (
    1, 10, 100, 1000,
    10 * 1000, 100 * 1000, 1000 * 1000,
    10 * 1000 * 1000, 100 * 1000 * 1000, 1000 * 1000 * 1000,
    10 * 1000 * 1000 * 1000,
    100 * 1000 * 1000 * 1000
  );

function ParseDecimalU32Unsafe(S: PAnsiChar; Len: SizeUInt): UInt32; overload;
function ParseDecimalU32Unsafe(S, SEnd: PAnsiChar): UInt32; inline; overload;
//
//      Parses decimal integer without any validation.
//
//  Parameters:
//
//      S: pointer to the beginning of the string
//      Len: 0..10
//      SEnd: pointer to the end of the string, SEnd=S+Len
//

function ParseDecimalU64Unsafe(S: PAnsiChar; Len: SizeUInt): UInt64; overload;
function ParseDecimalU64Unsafe(S, SEnd: PAnsiChar): UInt64; inline; overload;
//
//      Parses decimal integer without any validation.
//
//  Parameters:
//
//      S: pointer to the beginning of the string
//      Len: 0..20
//      SEnd: pointer to the end of the string, SEnd=S+Len
//

function ParseHexU32Unsafe(S: PAnsiChar; Len: SizeUInt): UInt32; {FIXME broken in fpc 3.2.0 inline;} overload;
function ParseHexU32Unsafe(S, SEnd: PAnsiChar): UInt32; {FIXME broken in fpc 3.2.0 inline;} overload;
//
//      Parses hexdecimal integer without any validation.
//
//  Parameters:
//
//      S: pointer to the beginning of the string
//      Len: 0..8
//      SEnd: pointer to the end of the string, SEnd=S+Len
//

procedure SkipDecimalsDigits(var S: PAnsiChar; SEnd: PAnsiChar);
//
//      Skips decimal digits, i.e. '0'..'9'.
//
//  Parameters:
//
//      S: the cursor to ansi buffer
//      SEnd: the end of the buffer
//
//  Returns:
//
//      S: cursor to the first non-decimal character or SEnd.
//

procedure SkipHexDigits(var S: PAnsiChar; SEnd: PAnsiChar);
//
//      Skips hexdecimal digits, i.e. '0'..'9', 'a'..'f', 'A'..'F'.
//
//  Parameters:
//
//      S: the cursor to ansi buffer
//      SEnd: the end of the buffer
//
//  Returns:
//
//      S: cursor to the first non-hexdecimal character or SEnd.
//

function SkipMinus(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;
//
//      Tries to skip '-'.
//
//  Parameters:
//
//      S: the cursor to the input buffer
//      SEnd: the end of the input buffer
//
//  Returns:
//
//      Result: True if S^ is '-', False otherwise
//      S: cursor to the next character if S^='-', unchanged otherwise
//

function SkipSign(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;
//
//      Tries to skip '-' or '+'.
//
//  Parameters:
//
//      S: the cursor to the input buffer
//      SEnd: the end of the input buffer
//
//  Returns:
//
//      Result: True if S^='-', False otherwise
//      S: cursor to the next character if S^ is '-' or '+', unchanged otherwise
//

function SkipChar(var S: PAnsiChar; SEnd: PAnsiChar; C: AnsiChar): Boolean;
//
//      Tries to skip character C.
//
//  Parameters:
//
//      S: the cursor to the input buffer
//      SEnd: the end of the input buffer
//      C: the character
//
//  Returns:
//
//      Result: True if S^=C, False otherwise
//      S: cursor to the next character if S^=C, unchanged otherwise
//

function SkipToChar(var S: PAnsiChar; SEnd: PAnsiChar; C: AnsiChar): Boolean; inline;

function SkipSpaces(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;

function SkipToSpace(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;

//
//  ParseDecimalU32
//  ParseDecimalI32
//  ParseDecimalU64
//  ParseDecimalI64
//  ParseHexU32
//
function ParseDecimalU32(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out U: UInt32;
                         Err: PLongInt = nil): Boolean;
function ParseDecimalI32(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out I: Int32;
                         Err: PLongInt = nil): Boolean;
function ParseDecimalU64(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out U: UInt64;
                         Err: PLongInt = nil): Boolean;
function ParseDecimalI64(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out I: Int64;
                         Err: PLongInt = nil): Boolean;
function ParseHexU32(var S: PAnsiChar;
                     SEnd: PAnsiChar;
                     out U: UInt32;
                     Err: PLongInt = nil): Boolean;
//
//      Tries to parse integer. Returns True and parsed integer and advances
//      the cursor right after that integer. Returns False and error code
//      otherwise.
//
//      Ranges for valid integers:
//
//        UInt32:           0 .. 4294967295
//         Int32: -2147483648 .. 2147483647
//        UInt64:           0 .. 18446744073709551615
//         Int64: -9223372036854775808 .. 9223372036854775807
//
//  Parameters:
//
//      S: the cursor to the input buffer
//      SEnd: the end of the input buffer
//      Err: pointer to error code to be returned, nil if not needed
//
//  Succesful returns:
//
//      Result: True
//      U or I: parsed integer
//      Err^: error code (see PARSER_ERROR_* constants)
//
//  Errorneous returns:
//
//      PARSER_ERROR_NOT_ENOUGH_CHARS
//
//          No digits at all.
//
//      PARSER_ERROR_OVERFLOW
//
//          Input value is large and cannot be represented in U or I.
//
//      PARSER_ERROR_UNDERFLOW
//
//          Input value is small and cannot be stored in U or I.
//

function BuildDoubleFromBinaryParts(Sign: LongInt;
                                    I: Int64;
                                    E: LongInt;
                                    out F: Double): Boolean;
//
//      Builds IEEE-754 64-bit Double-Precision Floating-Point from binary
//      components.
//
//      Basically it does:
//
//          F := Sign * I * 2^E
//
//  Parameters:
//
//      Sign: 0 for potitive number, 1 or -1 for negative
//      I: 0<=I<2^51
//      E: -1023<=E<=1023
//
//  Returns:
//
//      Result: True if arguments are correct and F can be built
//      F: Sign * I * 2^E
//

function BuildDoubleFromDecimalParts(Sign: LongInt;
                                     I: Int64;
                                     E: LongInt;
                                     out F: Double): Boolean;
//
//      Builds IEEE-754 64-bit Double-Precision Floating-Point from decimal
//      components.
//
//      Basically it does the following assignment:
//
//          F := Sign * I * 10^E
//
//  Parameters:
//
//      Sign: 0 for potitive number, 1 or -1 for negative
//      I: 0 <= I < 10^18
//      E: -386 <= E <= 309
//
//  Returns:
//
//      Result: True if arguments are correct and F can be built
//      F: Sign * I * 10^E
//

function NextLine(var S: PAnsiChar;
                  SEnd: PAnsiChar;
                  out Line: PAnsiChar;
                  out LineEnd: PAnsiChar): Boolean;
function NextLine(var S: PAnsiChar;
                  SEnd: PAnsiChar): Boolean; overload; inline;
//
//      Tries to read a line from input buffer. A line ends with #13, #13#10,
//      #10 or at the end of the buffer.
//
//  Parameters:
//
//      S: the cursor to the input buffer
//      SEnd: the end of the input buffer
//
//  Returns:
//
//      Result: False if buffer is already empty, True otherwise
//      S: pointer to beginning of the next line, or SEnd
//      Line: the beginning of the extracted line, undefined if Result=False
//      LineEnd: the end of the extracted line, undefined if Result=False
//
//  Typical usage:
//
//      S := input buffer;
//      SEnd := end of buffer;
//      while NextLine(S, SEnd, Line, LineEnd) do begin
//        // (Line, LineEnd) are currect line
//      end;
//

function NextCSV(var S: PAnsiChar;
                 SEnd: PAnsiChar;
                 out Value: PAnsiChar;
                 out ValueEnd: PAnsiChar): Boolean;
//
//      Tries to read next comma separated value (csv). CSV ends with ',' or at
//      the end of the buffer.
//
//      ! Ignores last value if it is empty. Add comma to the end of CSV list
//        if you want to iterate last empty value as well.
//
//  Typical usage:
//
//      S := input buffer;
//      SEnd := end of buffer;
//      while NextCSV(S, SEnd, Value, ValueEnd) do begin
//        // (Value, ValueEnd) is currect value now
//      end;
//

function FillParsingError(Err: PLongInt; Value: LongInt): Boolean; inline;
//
//    Utility function. If Err<>nil, it fills Err with the Value.
//    Always returns False.
//
//  Typical usage:
//
//    Exit(FillParsingError(Err, PARSER_ERROR_...));
//

implementation

var
  HEX_DIGIT_LOOKUP: array[0 .. 255] of Byte;
procedure InitHexDigitLookup;
var
  I: LongInt;
begin
  FillChar(HEX_DIGIT_LOOKUP[0], Length(HEX_DIGIT_LOOKUP), 255);
  for I := 0 to 5 do begin
    HEX_DIGIT_LOOKUP[Ord('0') + I] := I;
    HEX_DIGIT_LOOKUP[Ord('a') + I] := 10 + I;
    HEX_DIGIT_LOOKUP[Ord('A') + I] := 10 + I;
  end;
  for I := 6 to 9 do begin
    HEX_DIGIT_LOOKUP[Ord('0') + I] := I;
  end;
end;

function FillParsingError(Err: PLongInt; Value: LongInt): Boolean;
begin
  if Err <> nil then
    Err^ := Value;
  Exit(False);
end;

// 0 .. 2147483647
function ParseDecimalU32Unsafe(S: PAnsiChar;
                               Len: SizeUInt): UInt32;
label
  L0, L1, L2, L3, L4, L5, L6, L7, L8, L9, L10;
begin
  Result := 0;
  if Len <= 1 then begin
    goto L1;
  end;
  if Len <= 6 then begin
    if Len <= 3 then begin
      if Len = 3 then begin
        goto L3;
      end else
        goto L2;
    end;
    if Len >= 5 then begin
      if Len = 5 then begin
        goto L5;
      end else
        goto L6;
    end;
    goto L4;
  end;
  if Len <= 8 then begin
    if Len = 8 then begin
      goto L8;
    end else
      goto L7;
  end;
  if Len = 9 then
    goto L9;
L10: Result := Result + (Ord(S[Len - 10]) - Ord('0')) * 1000000000;
L9:  Result := Result + (Ord(S[Len -  9]) - Ord('0')) * 100000000;
L8:  Result := Result + (Ord(S[Len -  8]) - Ord('0')) * 10000000;
L7:  Result := Result + (Ord(S[Len -  7]) - Ord('0')) * 1000000;
L6:  Result := Result + (Ord(S[Len -  6]) - Ord('0')) * 100000;
L5:  Result := Result + (Ord(S[Len -  5]) - Ord('0')) * 10000;
L4:  Result := Result + (Ord(S[Len -  4]) - Ord('0')) * 1000;
L3:  Result := Result + (Ord(S[Len -  3]) - Ord('0')) * 100;
L2:  Result := Result + (Ord(S[Len -  2]) - Ord('0')) * 10;
L1:  Result := Result + (Ord(S[Len -  1]) - Ord('0'));
L0:
end;

function ParseDecimalU32Unsafe(S, SEnd: PAnsiChar): UInt32;
begin
  Result := ParseDecimalU32Unsafe(S, SEnd - S);
end;

const
  POWEROF10_DOUBLE: array[0 .. 22] of Double = (
    1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 1e10,
    1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20,
    1e21, 1e22
  );

function ParseDecimalU64Unsafe(S: PAnsiChar; Len: SizeUInt): UInt64;
var
  U: UInt32;
begin
  if Len <= 9 then begin
    Result := ParseDecimalU32Unsafe(S, Len);
  end else begin
    Result := UInt64(ParseDecimalU32Unsafe(S, 9)) * POWEROF10[Len - 9] +
              UInt64(ParseDecimalU32Unsafe(S + 9, Len - 9));
  end;
end;

function ParseDecimalU64Unsafe(S, SEnd: PAnsiChar): UInt64;
begin
  Result := ParseDecimalU64Unsafe(S, SEnd - S);
end;

function _ParseHexU32Unsafe(S, SEnd: PAnsiChar; Len: SizeUInt): UInt32;
label
  L0, L1, L2, L3, L4, L5, L6, L7, L8;
begin
  Result := 0;
  if Len <= 1 then begin
    if Len = 0 then begin
      goto L0;
    end else
      goto L1;
  end;
  if Len <= 6 then begin
    if Len <= 3 then begin
      if Len = 3 then begin
        goto L3;
      end else
        goto L2;
    end;
    if Len >= 5 then begin
      if Len = 5 then begin
        goto L5;
      end else
        goto L6;
    end;
    goto L4;
  end;
  if Len = 8 then begin
    goto L8;
  end else
    goto L7;
L8:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  8)^)] shl 28;
L7:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  7)^)] shl 24;
L6:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  6)^)] shl 20;
L5:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  5)^)] shl 16;
L4:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  4)^)] shl 12;
L3:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  3)^)] shl 8;
L2:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  2)^)] shl 4;
L1:  Result := Result + HEX_DIGIT_LOOKUP[Ord((SEnd -  1)^)];
L0:
end;

function ParseHexU32Unsafe(S: PAnsiChar; Len: SizeUInt): UInt32;
begin
  Result := _ParseHexU32Unsafe(S, S + Len, Len);
end;

function ParseHexU32Unsafe(S, SEnd: PAnsiChar): UInt32;
begin
  Result := _ParseHexU32Unsafe(S, SEnd, SEnd - S);
end;

function _SkipDecimalsDigits(S, SEnd: PAnsiChar): PAnsiChar; inline;
begin
  // Unrolled loop
  while S + 3 < SEnd do begin
    if not (S^ in ['0'..'9']) then
      Exit(S);
    if not (S[1] in ['0'..'9']) then
      Exit(S + 1);
    if not (S[2] in ['0'..'9']) then
      Exit(S + 2);
    if not (S[3] in ['0'..'9']) then
      Exit(S + 3);
    Inc(S, 4);
  end;
  case SEnd - S of
    1: begin
         if not (S^ in ['0'..'9']) then
           Exit(S);
         Exit(SEnd);
       end;
    2: begin
         if not (S^ in ['0'..'9']) then
           Exit(S);
         if not (S[1] in ['0'..'9']) then
           Exit(S + 1);
         Exit(SEnd);
       end;
    3: begin
         if not (S^ in ['0'..'9']) then
           Exit(S);
         if not (S[1] in ['0'..'9']) then
           Exit(S + 1);
         if not (S[2] in ['0'..'9']) then
           Exit(S + 1);
         Exit(SEnd);
       end;
  else
    Exit(SEnd);
  end;
end;

procedure SkipDecimalsDigits(var S: PAnsiChar; SEnd: PAnsiChar);
begin
  S := _SkipDecimalsDigits(S, SEnd);
end;

function _SkipHexDigits(S, SEnd: PAnsiChar): PAnsiChar; inline;
begin
  while S < SEnd do begin
    if HEX_DIGIT_LOOKUP[Ord(S^)] > 15 then
      break;
    Inc(S);
  end;
  Result := S;
end;

procedure SkipHexDigits(var S: PAnsiChar; SEnd: PAnsiChar);
begin
  S := _SkipHexDigits(S, SEnd);
end;

function SkipMinus(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;
begin
  if (S < SEnd) and (S^ = '-') then begin
    Inc(S);
    Exit(True);
  end else
    Exit(False);
end;

function SkipSign(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;
begin
  if S < SEnd then begin
    case S^ of
      '-': begin
             Inc(S);
             Exit(True);
           end;
      '+': begin
             Inc(S);
             Exit(False);
           end;
    else
      Exit(False);
    end;
  end else
    Exit(False);
end;

function SkipChar(var S: PAnsiChar; SEnd: PAnsiChar; C: AnsiChar): Boolean;
begin
  if (S < SEnd) and (S^ = C) then begin
    Inc(S);
    Exit(True);
  end else
    Exit(False);
end;

function SkipToChar(var S: PAnsiChar; SEnd: PAnsiChar; C: AnsiChar): Boolean;
var
  I: SizeInt;
begin
  I := IndexByte(S^, SEnd - S, Ord(C));
  if I <> -1 then begin
    Inc(S, I);
    Exit(True);
  end else begin
    S := SEnd;
    Exit(False);
  end;
end;

function _SkipSpaces(S: PAnsiChar; SEnd: PAnsiChar): PAnsiChar; inline;
begin
  while (S < SEnd) and (S^ = ' ') do
    Inc(S);
  Result := S;
end;

function SkipSpaces(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;
begin
  S := _SkipSpaces(S, SEnd);
  Result := S < SEnd;
end;

function _SkipToSpace(S: PAnsiChar; SEnd: PAnsiChar): PAnsiChar; inline;
begin
  while (S < SEnd) and (S^ <> ' ') do
    Inc(S);
  Result := S;
end;

function SkipToSpace(var S: PAnsiChar; SEnd: PAnsiChar): Boolean;
begin
  S := _SkipToSpace(S, SEnd);
  Result := S < SEnd;
end;

function ParseDecimalU32(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out U: UInt32;
                         Err: PLongInt = nil): Boolean;
var
  I: PAnsiChar;
begin
  Result := False;
  if (S >= SEnd) or not (S^ in ['0'..'9']) then
    Exit(FillParsingError(Err, PARSER_ERROR_NOT_ENOUGH_CHARS));
  I := _SkipDecimalsDigits(S + 1, SEnd);
  if I - S > 10 then begin // FIXME length=10!
    Exit(FillParsingError(Err, PARSER_ERROR_OVERFLOW));
  end else
    Result := True;
  U := ParseDecimalU32Unsafe(S, I - S);
  S := I;
end;

function ParseDecimalI32(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out I: Int32;
                         Err: PLongInt = nil): Boolean;
var
  U: UInt32;
begin
  if SkipSign(S, SEnd) then begin
    I := -1; // FIXME
  end else
    I := 0;
  if not ParseDecimalU32(S, SEnd, U, Err) then
    Exit(False);
  if I < 0 then begin // FIXME
    I := - U;
  end else
    I := U;
  Exit(True);
end;

function ParseDecimalU64(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out U: UInt64;
                         Err: PLongInt = nil): Boolean;
var
  I: PAnsiChar;
begin
  if (S >= SEnd) or not (S^ in ['0'..'9']) then
    Exit(FillParsingError(Err, PARSER_ERROR_NOT_ENOUGH_CHARS));
  I := _SkipDecimalsDigits(S + 1, SEnd);
  if I - S >= 20 then begin
    Exit(FillParsingError(Err, PARSER_ERROR_OVERFLOW));
  end else
    Result := True;
  U := ParseDecimalU64Unsafe(S, I - S);
  S := I;
end;

function ParseDecimalI64(var S: PAnsiChar;
                         SEnd: PAnsiChar;
                         out I: Int64;
                         Err: PLongInt = nil): Boolean;
var
  U: UInt64;
begin
  if SkipSign(S, SEnd) then begin
    I := Int64(1 shl 64); // FIXME
  end else
    I := 0;
  if not ParseDecimalU64(S, SEnd, U, Err) then
    Exit(False);
  I := I or U;
  Exit(True);
end;

function ParseHexU32(var S: PAnsiChar;
                     SEnd: PAnsiChar;
                     out U: UInt32;
                     Err: PLongInt = nil): Boolean;
var
  I: PAnsiChar;
begin
  I := _SkipHexDigits(S, SEnd);
  if I = S then
    Exit(FillParsingError(Err, PARSER_ERROR_NOT_ENOUGH_CHARS));
  if I - S > 8 then
    Exit(FillParsingError(Err, PARSER_ERROR_OVERFLOW));
  U := ParseHexU32Unsafe(S, I);
  Exit(False);
end;

function BuildDoubleFromBinaryParts(Sign: LongInt;
                                    I: Int64;
                                    E: LongInt;
                                    out F: Double): Boolean;
var
  TrueI: UInt64;
  TrueE: UInt64;
  Res: UInt64;
begin
  TrueE := E + 1023;
  TrueI := I;
  if TrueI <> 0 then begin
    if TrueE <> 0 then begin
      Inc(TrueE, 52);
      while TrueI and (1 shl 52) = 0 do begin
        TrueI := TrueI shl 1;
        Dec(TrueE);
      end;
      TrueI := TrueI and not (1 shl 52);
    end;
  end;
  Res := ((Int64(Sign) and 1) shl 63) or
         ((UInt64(TrueE) and $07FF) shl 52) or
         (TrueI and UInt64($FFFFFFFFFFFFF));
  Move(Res, F, SizeOf(F));
  Result := True;
end;

type
  UInt96 = record
    Low: UInt64;
    High: UInt32;
  end;

procedure _Div5(var V: UInt96); inline;
var
  R: UInt32;
  L: UInt64;
begin
  R := V.High mod 5;
  V.High := V.High div 5;
  L := (UInt64(R) shl 61) or (V.Low shr 3);
  V.Low := (L div 5) shl 3 + (((L mod 5) shl 3 + V.Low and 7) div 5);
end;

type
  // for ARM
  PUInt64 = ^UInt64;

function BuildDoubleFromDecimalParts(Sign: LongInt;
                                     I: Int64;
                                     E: LongInt;
                                     out F: Double): Boolean;
var
  Q, R, S: UInt96;
  Y: LongInt;
  P: LongInt;
  Carry: Cardinal;
  HasLostBits: Boolean;
  J: UInt64;
begin
  //
  //  0 and integer cases are the easiest ones.
  //
  if E = 0 then begin
    F := I;
    if Sign <> 0 then
      F := - F;
    Exit(True);
  end;

  //
  //  Fast Path
  //
  //    We assume here that
  //    * if I and E are in the specified ranges, then both I and 10^E can
  //      be exactly represented as Doubles, and
  //    * appropriate division or multiplication produces correctly
  //      rounded result.
  //
  //    The assumptions are true for IEEE 754 floating-point numbers and
  //    operations, but we also rely on correct implementation of the IEEE in
  //    the free pascal...  :)
  //
  if (Abs(I) <= 9007199254740991) and (Abs(E) <= 22) then begin
    if E < 0 then begin
      F := Double(I) / Double(POWEROF10_DOUBLE[-E]);
    end else
      F := Double(I) * Double(POWEROF10_DOUBLE[E]);
    if Sign <> 0 then
      F := - F;
    Exit(True);
  end;

  //
  //  Correction loop
  //
  //    (The implementation may not be perfect yet.)
  //
  //    The idea of the algorithm is to keep the following expression unchanged:
  //
  //        S * 10^E * 2^Y
  //
  //    Initially Y=0 (so the expression is effectively S*10^E -- the input of
  //    the function), and as a result of the loop we want to achieve E=0 (so
  //    the expression becomes S*2^Y -- binary representation of number we
  //    need).
  //
  //    Each step of the correction loop we reduce E by 1. This reduction
  //    compensates by multiplying or dividing S by 10. To prevent overflow or
  //    underflow of S (which lead to invalid result or lost accuracy) we
  //    shift bitwise S and compensate it with appropriate changes to Y.
  //
  //    Also we use 96-bit integer arithmetic for S here.
  //
  //    Other tricks used in the code are for better performance.
  //
  HasLostBits := False;
  S.Low := I;
  S.High := 0;
  Y := 92;
  if E > 0 then begin
    while E > 0 do begin
      // S := S * 10
      Carry := ((S.Low shr 32) * 10) shr 32;
      S.Low := S.Low * 10;
      S.High := S.High * 10 + Carry;
      Dec(E);

      while S.High and $F0000000 <> 0 do begin
        // S := S shr 1
        HasLostBits := HasLostBits or (S.Low and 1 <> 0);
        S.Low := (S.Low shr 1) or (UInt64(S.High and 1) shl 63);
        S.High := S.High shr 1;
        Inc(Y);
      end;
    end;
  end;
  if E < 0 then begin
    Inc(Y, E);
    // Now we have S * 5^E * 2^Y, division by 5 is faster than by 10
    while E < 0 do begin
      // If S.High = 0 we can safely shift left S by 32
      if S.High = 0 then begin
        Dec(Y, 32);
        S.High := S.Low shr 32;
        S.Low := S.Low shl 32;
      end;
      if S.High = 0 then begin
        Dec(Y, 32);
        S.High := S.Low shr 32;
        S.Low := 0;
      end;
      P := 0;
      while S.High and $F0000000 = 0 do begin
        S.High := S.High shl 1;
        Dec(Y);
        Inc(P);
      end;
      if P > 0 then begin
        S.High := S.High or (S.Low shr (64 - P));
        S.Low := S.Low shl P;
      end;
      _Div5(S);
      Inc(E);
    end;
  end;

  //
  //  Normalization of the fraction to prepare it for final packing into
  //  Double
  //
  if (S.High <> 0) or (S.Low <> 0) then begin
    if S.High = 0 then begin
      Dec(Y, 32);
      S.High := S.Low shr 32;
      S.Low := S.Low shl 32;
    end;
    if S.High = 0 then begin
      Dec(Y, 32);
      S.High := S.Low shr 32;
      S.Low := 0;
    end;
    P := 0;
    while S.High and $F0000000 = 0 do begin
      S.High := S.High shl 1;
      Dec(Y);
      Inc(P);
    end;
    S.High := S.High or (S.Low shr (64 - P));
    S.Low := S.Low shl P;
  end;

  //
  //  Now we determine round direction.
  //
  //     S                                     v54    | Round direction
  //   MSB                                    v53     |
  //  ---------------------------------------------------------------------
  //   1***************************************0******| Round down
  //   1***************************************1***1**| Round up
  //   1**************************************11000000| Round up
  //   1**************************************01000000| Round down
  //
  if (S.Low and (UInt64(1) shl 39)) <> 0 then begin
    if ((S.Low and (UInt64(1) shl 39 - 1)) <> 0) or HasLostBits then begin
      // Round up
      J := 40;
      while (J < 64) and (S.Low and (UInt64(1) shl J) <> 0) do begin
        S.Low := S.Low and not UInt64((UInt64(1) shl J));
        Inc(J);
      end;
      if J = 64 then begin
        S.Low := 0;
        J := 0;
        while (J < 32) and (S.High and (UInt32(1) shl J) <> 0) do begin
          S.High := S.High and not UInt32((UInt32(1) shl J));
          Inc(J);
        end;
        if J = 32 then begin
          S.High := 0;
          Inc(Y);
        end else begin
          S.High := S.High or (UInt32(1) shl J);
        end;
      end else
        S.Low := S.Low or (UInt64(1) shl J);
    end else begin
      // Rounding is not goining to change value
    end;
  end else begin
    // Round down
  end;

  //
  //  Final packing
  //
  PUInt64(@F)^ := (UInt64(Sign) shl 63)
              or (((UInt64(Y) + 1023) and $07FF) shl 52)
              or UInt64(UInt64(S.High and $FFFFFFF) shl 24)
              or  (UInt64(S.Low) shr 40);
  Result := True;
end;

function SkipLine(S, SEnd: PAnsiChar; out LineEnd: PAnsiChar): PAnsiChar; inline;
begin
  while S < SEnd do begin
    case S^ of
      #10: begin
             LineEnd := S;
             Exit(S + 1);
           end;
      #13: begin
             LineEnd := S;
             if (S + 1 < SEnd) and (S[1] = #10) then
               Exit(S + 2);
             Exit(S + 1);
           end;
    end;
    Inc(S);
  end;
  LineEnd := SEnd;
  Exit(SEnd);
end;

function NextLine(var S: PAnsiChar;
                  SEnd: PAnsiChar;
                  out Line: PAnsiChar;
                  out LineEnd: PAnsiChar): Boolean;
begin
  if S >= SEnd then
    Exit(False);
  Line := S;
  S := SkipLine(S, SEnd, LineEnd);
  Exit(True);
end;

function NextLine(var S: PAnsiChar;
                  SEnd: PAnsiChar): Boolean; overload; inline;
var
  Line, LineEnd: PAnsiChar;
begin
  Exit(NextLine(S, SEnd, Line, LineEnd));
end;

function _SkipCSV(S, SEnd: PAnsiChar; out ValueEnd: PAnsiChar): PAnsiChar; inline;
begin
  ValueEnd := S;
  if SkipToChar(ValueEnd, SEnd, ',') then begin
    Exit(ValueEnd + 1);
  end else begin
    Exit(SEnd);
  end;
end;

function NextCSV(var S: PAnsiChar;
                 SEnd: PAnsiChar;
                 out Value: PAnsiChar;
                 out ValueEnd: PAnsiChar): Boolean;
begin
  if S >= SEnd then
    Exit(False);
  Value := S;
  S := _SkipCSV(S, SEnd, ValueEnd);
  Exit(True);
end;

initialization
  InitHexDigitLookup;
end.
