Вверх ↑
Ответов: 207
Рейтинг: 14
#1: 2021-07-11 11:30:25 ЛС | профиль | цитата
Netspirit писал(а):
происходит округление до меньшего количества знаков при выводе

Ясно, спасибо за разъяснение.
Netspirit писал(а):
Текущий вариант Extended2Str() был протестирован для получения одинаковых результатов со старой KOL

Я нисколько не сомневался в правильности твоей функции.
Netspirit писал(а):
в официальных KOL падает на некоторых числах

Так сам Кладов писал, что она глючная.
Я пробовал переделанную родную KOLовскую функцию под WIN64. В ней заметил еще большие отклонения.

function Extended2Str( E: Extended ): KOLString;
function UnpackFromBuf( const Buf: array of Byte; N: Integer ): KOLString;
var I, J, K, L: Integer;
begin
SetLength( Result, 16 );
J := 1;
for I := 7 downto 0 do
begin
K := Buf[ I ] shr 4;
Result[ J ] := KOLChar( Ord('0') + K );
Inc( J );
K := Buf[ I ] and $F;
Result[ J ] := KOLChar( Ord('0') + K );
Inc( J );
end;
//Assert( Result[ 1 ] = '0', 'error!' );
Delete( Result, 1, 1 );
if N <= 0 then
begin
while N < 0 do
begin
Result := '0' + Result;
Inc( N );
end;
Result := '0.' + Result;
end else
if N < Length( Result ) then
begin
Result := Copy( Result, 1, N ) + '.' + CopyEnd( Result, N + 1 );
end else
begin
while N > Length( Result ) do
begin
Result := Result + '0';
end;
Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
end;
L := Length( Result );
while L > 1 do
begin
if (Result[ L ] <> '0')
and (Result[ L ] <> '.') then
break;
Dec( L );
if Result[ L + 1 ] = '.' then break;
end;
if L < Length( Result ) then Delete( Result, L + 1, MaxInt );
end;
var
S: Boolean;
var F: Extended;
N: Integer;
Buf1: array[ 0..9 ] of Byte;
I10: Integer;
{$IFDEF PAS_ONLY}
procedure Ext2BDC(E: Extended; Buf1: array of byte);
{$IFDEF WIN64} var F: Extended; {$ENDIF}
asm
{$IFDEF WIN64}
MOVQ qword ptr F, E
FLD F
{$ELSE}
FLD E
{$ENDIF}
FBSTP [Buf1]
end;
{$ENDIF}
begin
Result := '0';
if E = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
S := E < 0;
if S then E := -E;

N := 15;
F := 5E12;
I10 := 10;
while E < F do
begin
Dec( N );
E := E * I10;
end;
if N = 15 then
while E >= 1E13 do
begin
Inc( N );
E := E / I10;
end;

while TRUE do
begin
{$IFDEF PAS_ONLY}
Ext2BDC(E, Buf1);
// if TRUNC(Abs(E)) >= 10000000 then
// break;
{$ELSE}
asm
FLD [E]
FBSTP [Buf1]
end;
{$ENDIF}
if Buf1[ 7 ] <> 0 then break;
E := E * I10;
Dec( N );
end;
Result := UnpackFromBuf( Buf1, N );
if S then Result := '-' + Result;
end;
карма: 2

0