Freeman пишет:Что-то ситуация с неработающей тригонометрией в Delphi 2007 подкосила меня окончательно. Понял, что сил заниматься этой проблемой пока нет. Стоит ли выпускать исправленный SDK в том виде как есть, теперь не знаю.
А родной модуль System.pas от Delphi 2007 пересобирается?
Может там какие-нибудь директивы компиляции ещё указаны, которых у нас нет.
Freeman пишет:Внезапно оказалось, что программа не компилируется Delphi 2007. Ругается на отсутствие Sin, Cos и Random.
Хм.. даже на Random ругается?
Попробовать взять родной модуль, убрать оттуда ненужное, добавить нужное из нашего System.pas.
Или выложи куда-нибудь System от Delphi 2007.
Добавлено 2021-12-05 в 01:06
Freeman пишет:Думаю, код коротких системных функции копировать можно. Они обусловлены логикой компилятора ни не могут быть реализованы по-другому. В System уже достаточно кода, написанного вручную, чтобы обеспечить чистоту прав. После реализации строк уже никто не скажет, что мы всё скопировали.
Прикольно, теперь при помощи KoW можно собирать приложения и под Windows, и вполне естественно они будут меньше по размеру, чем со стандартным System.
По поводу коротких системных функций: в System есть функция Exp(procedure _EXP;) — более 10-ти строк, можем ли мы её использовать? Я заинтересовался вопросом, как ещё можно её реализовать?
И наткнулся на одну интересную библиотеку различных функций.
Лицензия: Based on "The zlib/libpng License".
Автор Wolfgang Ehrhardt, я узнал о ней из сообщения на форуме.
А вот, что есть на github
▼Вот как выглядит функция Exp там
сначала объявлены тип и константы
type
THexDblA = packed array[0..7] of byte; {Double as array of bytes}
const
ln2_hi: THexDblA = ($00,$00,$E0,$FE,$42,$2E,$E6,$3F);
ln2_lo: THexDblA = ($76,$3C,$79,$35,$EF,$39,$EA,$3D);
теперь сама функция
function exp(x: extended): extended; assembler; {&Frame-} {&Uses none}
{-Accurate exp, result good to extended precision}
asm
{This version of Norbert Juffa's exp is from the VirtualPascal RTL source,}
{discussed and explained in the VP Bugtracker system. Quote: }
{ }
{ ... "since the 387, F2XM1 can accecpt arguments in [-1, 1]. }
{ }
{ So, we can split the argument into an integer and a fraction part using }
{ FRNDINT and the fraction part will always be -1 <= f <= 1 no matter what}
{ rounding control. This means we don't have to load/restore the FPU }
{ control word (CW) which is slow on modern OOO FPUs (since FLDCW is a }
{ serializing instruction). }
{ }
{ Note that precision is lost in doing exponentation when the fraction is }
{ subtracted from the integer part of the argument. The "naive" code can }
{ loose up to 11 (or 15) bits of the extended precision format for large }
{ DP or EP arguments, yielding a result good to double precision. To get a}
{ function accurate to full extended precision, we need to simulate higher}
{ precision intermediate arithmetic." }
{ Ref: [Virtual Pascal 0000056]: More accurate Exp() function. URL (Oct.2009):}
{ https://admin.topica.com/lists/virtualpascal@topica.com/read/message.html?sort=a&mid=908867704&start=7}
fld [x] { x }
fldl2e { log2(e) | x }
fmul st,st(1) { z = x * log2(e) x }
frndint { int(z) | x }
fld qword ptr [ln2_hi] { ln2_hi | int(z) | x }
fmul st,st(1) { int(z)*ln2_hi | int(z) | x }
fsubp st(2),st { int(z) | x-int(z)*ln2_hi }
fld qword ptr [ln2_lo] { ln2_lo | int(z) | x-int(z)*ln2_hi }
fmul st, st(1) { int(z)*ln2_lo | int(z) | x-int(z)*ln2_hi }
fsubp st(2),st { int(z) | (x-int(z)*ln2_hi)-int(z)*ln2_lo }
fxch st(1) { (x-int(z)*ln2_hi)-int(z)*ln2_lo | int(z) }
fldl2e { log2(e) | (x-int(z)*ln2_hi)-int(z)*ln2_lo | int(z)}
fmulp st(1),st { frac(z) | int(z) }
{$ifndef use_fast_exp}
{It may happen (especially for rounding modes other than "round to nearest") }
{that |frac(z)| > 1. In this case the result of f2xm1 is undefined. The next }
{lines will test frac(z) and use a safe algorithm if necessary. }
{Another problem pops up if x is very large e.g. for x=1e3000. AMath checks }
{int(z) and returns 2^int(z) if int(z) > 1.5*16384, result is 0 or overflow! }
fld st
fabs { abs(frac(z)) | frac(z) | int(z) }
fld1 { 1 | abs(frac(z)) | frac(z) | int(z) }
fcompp
fstsw ax
sahf
jae @@1 { frac(z) <= 1, no special action needed }
fld st(1) { int(z) | frac(z) | int(z) }
fabs { abs(int(z)) | frac(z) | int(z) }
fcomp [ebig]
fstsw ax
sahf
jb @@0
fsub st,st { set frac=0 and scale with too large int(z)}
jmp @@1
@@0:
{Safely calculate 2^frac(z)-1 as (2^(frac(z)/2)-1)*(2^(frac(z)/2)+1) and use }
{2^(frac(z)/2)+1 = (2^(frac(z)/2)-1) + 2 (suggested by N. Juffa, 16.Jan.2011) }
fmul dword ptr [half] { frac(z)/2 | int(z) }
f2xm1 { 2^(frac(z)/2)-1 | int(z) }
fld st { 2^(frac(z)/2)-1 | 2^(frac(z)/2)-1 | int(z) }
fadd dword ptr [two] { 2^(frac(z)/2)+1 | 2^(frac(z)/2)-1 | int(z) }
fmulp st(1),st { 2^frac(z)-1 | int(z) }
jmp @@2
{$endif}
@@1:
f2xm1 { 2^frac(z)-1 | int(z) }
@@2:
fld1 { 1 | 2^frac(z)-1 | int(z) }
faddp st(1),st { 2^frac(z) | int(z) }
fscale { 2^z | int(z) }
fstp st(1) { 2^z = e^x }
fwait
end;
В основном в этой библиотеке математика и криптография.
Но можно найти что-то полезное и для KoW: в этой библиотеке реализован модуль Crt для Delphi
{BP7 compatible CRT unit for Win32/64 Delphi}
REQUIREMENTS : D2-D7/D9-D10/D12/D17
Кроме того, библиотека содержит различные функции сортировки(QuickSort, HeapSort, CombSort).
Почти всюду в исходниках огромное количество ссылок на источники информации(книги, обсуждения), по которым написан код.
Множество полезных комментариев к коду.
Содержит различные варианты кода для разных компиляторов,
workaround-ы для решения проблем с тем или иным компилятором.
В основном поддерживаются: TurboPascal5-7, Delphi1-Delphi7/Delphi9-Delphi10, FreePascal, VirtualPascal.
Думаю, что и мы можем извлечь что-то полезное из этой библиотеки.
Добавлено 2022-01-04 в 05:53
Freeman пишет:Что-то ситуация с неработающей тригонометрией в Delphi 2007 подкосила меня окончательно. Понял, что сил заниматься этой проблемой пока нет. Стоит ли выпускать исправленный SDK в том виде как есть, теперь не знаю.
Товарищ, я кажется нашёл, в чём причина!
Короче, есть один проект, ну не важно 
В общем, у них на форуме я нашёл файлы
В том архиве содержатся улучшенные\оптимизированные системные модули:
Speed improvements by Arnaud Bouchez, 2009-2010 - http://bouchez.info
Вообще вот в этой теме объясняется, что там было улучшено.
Так суть вот в чём:
там в System в начале файла есть вот это:
(* You can use RTLVersion in $IF expressions to test the runtime library
version level independently of the compiler version level.
Example: {$IF RTLVersion >= 16.2} ... {$IFEND} *)
const
RTLVersion =
{$ifdef VER185}18.50;{$else} // Delphi 2007
{$ifdef VER180}18.00;{$else} // Delphi 2006
{$ifdef VER170}17.00;{$else} // Delphi 2005
{$ifdef VER160}16.00;{$else} // Delphi 8
{$ifdef VER150}15.00;{$else} // Delphi 7
{$ifdef VER140}14.00;{$else} // Delphi 6
{$ifdef VER130}13.00;{$else} // Delphi 5
{$ifdef VER120}16.00;{$else} // Delphi 4
{$ifdef VER100}10.00;{$else} // Delphi 3
invalid Delphi compiler version
{$endif}{$endif}{$endif}{$endif}{$endif}{$endif}{$endif}{$endif}{$endif}
{$EXTERNALSYM CompilerVersion}
{$IFDEF CONDITIONALEXPRESSIONS} //Delphi 6 or newer
{$if CompilerVersion >= 17} // Delphi 2005 or newer
{$define HASINLINE} // we can use the inline feature
{$define NEWRTL} // rtl was modified
{$ifend}
{$ENDIF}
Нас в этом коде интересует NEWRTL
Теперь смотрим ниже, для чего оно нужно
{ ----------------------------------------------------- }
{ functions & procedures that need compiler magic }
{ ----------------------------------------------------- }
{$ifdef NEWRTL}
function Int(const X: Extended): Extended;
asm
FLD X
SUB ESP,4
FNSTCW [ESP].Word // save
FNSTCW [ESP+2].Word // scratch
FWAIT
OR [ESP+2].Word, $0F00 // trunc toward zero, full precision
FLDCW [ESP+2].Word
FRNDINT
FWAIT
FLDCW [ESP].Word
ADD ESP,4
end;
function Frac(const X: Extended): Extended;
asm
FLD X
FLD ST(0)
SUB ESP,4
FNSTCW [ESP].Word // save
FNSTCW [ESP+2].Word // scratch
FWAIT
OR [ESP+2].Word, $0F00 // trunc toward zero, full precision
FLDCW [ESP+2].Word
FRNDINT
FWAIT
FLDCW [ESP].Word
ADD ESP,4
FSUB
end;
function Exp(const X: Extended): Extended;
asm
{ e**x = 2**(x*log2(e)) }
FLD X
FLDL2E { y := x*log2e; }
FMUL
FLD ST(0) { i := round(y); }
FRNDINT
FSUB ST(1), ST { f := y - i; }
FXCH ST(1) { z := 2**f }
F2XM1
FLD1
FADD
FSCALE { result := z * 2**i }
FSTP ST(1)
end;
function Cos(const X: Extended): Extended;
asm
FLD X
FCOS
FWAIT
end;
function Sin(const X: Extended): Extended;
asm
FLD X
FSIN
FWAIT
end;
function Ln(const X: Extended): Extended;
asm
FLD X
FLDLN2
FXCH
FYL2X
FWAIT
end;
function ArcTan(const X: Extended): Extended;
asm
FLD X
FLD1
FPATAN
FWAIT
end;
function Sqrt(const X: Extended): Extended;
asm
FLD X
FSQRT
FWAIT
end;
{$else}
procedure _COS;
asm
FCOS
FNSTSW AX
SAHF
JP @@outOfRange
RET
@@outOfRange:
FSTP st(0) { for now, return 0. result would }
FLDZ { have little significance anyway }
end;
procedure _EXP;
asm
{ e**x = 2**(x*log2(e)) }
FLDL2E { y := x*log2e; }
FMUL
FLD ST(0) { i := round(y); }
FRNDINT
FSUB ST(1), ST { f := y - i; }
FXCH ST(1) { z := 2**f }
F2XM1
FLD1
FADD
FSCALE { result := z * 2**i }
FSTP ST(1)
end;
procedure _INT;
asm
SUB ESP,4
FNSTCW [ESP].Word // save
FNSTCW [ESP+2].Word // scratch
FWAIT
OR [ESP+2].Word, $0F00 // trunc toward zero, full precision
FLDCW [ESP+2].Word
FRNDINT
FWAIT
FLDCW [ESP].Word
ADD ESP,4
end;
procedure _SIN;
asm
FSIN
FNSTSW AX
SAHF
JP @@outOfRange
RET
@@outOfRange:
FSTP st(0) { for now, return 0. result would }
FLDZ { have little significance anyway }
end;
procedure _FRAC;
asm
FLD ST(0)
SUB ESP,4
FNSTCW [ESP].Word // save
FNSTCW [ESP+2].Word // scratch
FWAIT
OR [ESP+2].Word, $0F00 // trunc toward zero, full precision
FLDCW [ESP+2].Word
FRNDINT
FWAIT
FLDCW [ESP].Word
ADD ESP,4
FSUB
end;
{$endif}
procedure _ROUND;
asm
{ -> FST(0) Extended argument }
{ <- EDX:EAX Result }
SUB ESP,8
FISTP qword ptr [ESP]
FWAIT
POP EAX
POP EDX
end;
procedure _TRUNC;
asm
{ -> FST(0) Extended argument }
{ <- EDX:EAX Result }
SUB ESP,12
FNSTCW [ESP].Word // save
FNSTCW [ESP+2].Word // scratch
FWAIT
OR [ESP+2].Word, $0F00 // trunc toward zero, full precision
FLDCW [ESP+2].Word
FISTP qword ptr [ESP+4]
FWAIT
FLDCW [ESP].Word
POP ECX
POP EAX
POP EDX
end;
Проще говоря, для Delphi 7 и для Delphi 2007 используются разные версии функций, обрати внимание, что не все: Trunc и Round только одна версия для обоих случаев.
Так-то!
