{
Lang – основной модуль для разработки программ и библиотек.
Copyright © 2016, 2019, 2022–2023 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Меньшей Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Меньшей Стандартной
общественной лицензии GNU.
Вы должны были получить копию Меньшей Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit Lang;
{$MODE DELPHI}
{$ASMMODE INTEL}
interface
uses
Windows,
Classes;
{%region public }
type
boolean = System.Boolean;
wchar = System.WideChar;
float = System.Single;
double = System.Double;
real = System.Extended;
byte = System.Shortint;
short = System.Smallint;
int = System.Longint;
long = System.Int64;
boolean_Array1d = packed array of boolean;
wchar_Array1d = packed array of wchar;
float_Array1d = packed array of float;
double_Array1d = packed array of double;
real_Array1d = packed array of real;
byte_Array1d = packed array of byte;
short_Array1d = packed array of short;
int_Array1d = packed array of int;
long_Array1d = packed array of long;
AnsiString_Array1d = packed array of AnsiString;
UnicodeString_Array1d = packed array of UnicodeString;
boolean_Array2d = packed array of boolean_Array1d;
wchar_Array2d = packed array of wchar_Array1d;
float_Array2d = packed array of float_Array1d;
double_Array2d = packed array of double_Array1d;
real_Array2d = packed array of real_Array1d;
byte_Array2d = packed array of byte_Array1d;
short_Array2d = packed array of short_Array1d;
int_Array2d = packed array of int_Array1d;
long_Array2d = packed array of long_Array1d;
AnsiString_Array2d = packed array of AnsiString_Array1d;
UnicodeString_Array2d = packed array of UnicodeString_Array1d;
const
MAX_STRUCTURE_SIZE = int($01000000);
ROUND_TO_NEAREST = int(0);
ROUND_DOWN = int(1);
ROUND_UP = int(2);
ROUND_TOWARD_ZERO = int(3);
MAX_INT = int($7fffffff);
MIN_INT = int($80000000);
MAX_LONG = long($7fffffffffffffff);
MIN_LONG = long($8000000000000000);
PI = real(3.141592653589793238462);
E = real(2.718281828459045235360);
POS_INF = real(1.0 / 0.0);
NEG_INF = real(-1.0 / 0.0);
NAN = real(0.0 / 0.0);
INF = POS_INF;
DIRECTORY_SEPARATOR = '\';
LINE_ENDING = #13#10;
HEX_DIGITS = '0123456789abcdef';
type
ByteArray = packed array [0..(MAX_STRUCTURE_SIZE div sizeof(byte)) - 1] of byte;
ShortArray = packed array [0..(MAX_STRUCTURE_SIZE div sizeof(short)) - 1] of short;
IntArray = packed array [0..(MAX_STRUCTURE_SIZE div sizeof(int)) - 1] of int;
PByteArray = ^ByteArray;
PShortArray = ^ShortArray;
PIntArray = ^IntArray;
Pointer = System.Pointer;
GUID = System.TGUID;
const
INTERFACE_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C1500}';
CLASS_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C1501}';
RUNNABLE_GUID = '{74C86B60-AC5B-4E8D-8ACD-29A50B5C1502}';
type
_Interface = interface;
_Class = interface;
Runnable = interface;
_Object = class;
RefCountInterfacedObject = class;
ClassData = class;
Thread = class;
Exception = class;
RuntimeException = class;
NullPointerException = class;
IndexOutOfBoundsException = class;
ArrayIndexOutOfBoundsException = class;
IllegalArgumentException = class;
LongRecord = packed record
case int of
0: (value: long);
1: (lo: int;
hi: int);
end;
FloatRecord = packed record
case int of
0: (value: float);
1: (bits: int);
end;
DoubleRecord = packed record
case int of
0: (value: double);
1: (bits: long);
end;
RealRecord = packed record
case int of
0: (value: real);
1: (significand: long;
exponentAngSign: short);
end;
{$M+}
_Interface = interface(IUnknown) [INTERFACE_GUID]
function getInterface(const iid: GUID; out obj): boolean;
function getInterfaceWeak(const iid: GUID; out obj): boolean;
function getClass(): _Class;
function asObject(): TObject;
end;
{$M-}
_Class = interface(_Interface) [CLASS_GUID]
function isInheritedFrom(cls: _Class): boolean;
function isInstance(obj: TObject): boolean;
function getInstanceSize(): int;
function getSuperclass(): _Class;
function getName(): AnsiString;
function getSimpleName(): AnsiString;
function getClassType(): TClass;
end;
Runnable = interface(_Interface) [RUNNABLE_GUID]
procedure run();
end;
{$M+}
_Object = class(TObject, IUnknown, _Interface)
public
constructor create();
destructor destroy; override;
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
procedure free();
{ IUnknown }
function queryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: GUID; out obj): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
function _addref(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
function _release(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
{ _Interface }
function getInterface(const iid: GUID; out obj): boolean;
function getInterfaceWeak(const iid: GUID; out obj): boolean;
function getClass(): _Class;
function asObject(): TObject;
public
class function asClass(): _Class;
end;
{$M-}
RefCountInterfacedObject = class(_Object)
strict private
refcount: int;
public
constructor create();
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
function _addref(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; override; final;
function _release(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; override; final;
public
class function newInstance(): TObject; override;
end;
ClassData = class(RefCountInterfacedObject, _Class)
strict private
clsptr: TClass;
public
constructor create(clsptr: TClass);
function isInheritedFrom(cls: _Class): boolean;
function isInstance(obj: TObject): boolean;
function getInstanceSize(): int;
function getSuperclass(): _Class;
function getName(): AnsiString;
function getSimpleName(): AnsiString;
function getClassType(): TClass;
end;
Thread = class(_Object, Runnable)
private
freeOnTerminate: boolean;
target: Runnable;
inst: Classes.TThread;
name: AnsiString;
public
constructor create(target: Runnable; const name: AnsiString; freeOnTerminate: boolean);
procedure run(); virtual;
procedure start(); virtual;
function getName(): AnsiString; virtual;
end;
ThreadLock = class(_Object)
strict private
lock: Windows.CRITICAL_SECTION;
public
constructor create(); virtual;
destructor destroy; override;
procedure enter(); virtual;
procedure leave(); virtual;
end;
Exception = class(_Object)
strict private
fmessage: AnsiString;
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
function getMessage(): AnsiString; virtual;
end;
RuntimeException = class(Exception)
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
end;
NullPointerException = class(RuntimeException)
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
end;
IndexOutOfBoundsException = class(RuntimeException)
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
constructor create(index: int); overload;
end;
ArrayIndexOutOfBoundsException = class(IndexOutOfBoundsException)
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
constructor create(index: int); overload;
end;
IllegalArgumentException = class(RuntimeException)
public
constructor create(); overload;
constructor create(const message: AnsiString); overload;
end;
{%endregion}
{%region routine }
procedure startThread(target: Runnable); overload;
procedure startThread(target: Runnable; const name: AnsiString); overload;
procedure configureFPU();
procedure setRoundMode(mode: int);
function sar(value, bits: int): int;
function isNaN(value: real): boolean; inline;
function isInfinity(value: real): boolean; stdcall;
function byteSwap(value: int): int; overload;
function byteSwap(value: long): long; stdcall; overload;
function floatToIntBits(a: float): int; inline;
function intBitsToFloat(a: int): float; inline;
function doubleToLongBits(a: double): long; inline;
function longBitsToDouble(a: long): double; inline;
function extractSignificand(a: real): long; inline;
function extractExponentAndSign(a: real): int; inline;
function buildReal(exponentAndSign: int; significand: long): real; inline;
function buildLong(lo, hi: int): long; inline;
function cmpgReal(v1, v2: real): int; stdcall;
function cmplReal(v1, v2: real): int; stdcall;
function zeroExtend(value: int): long; inline;
function abs(x: int): int; inline; overload;
function abs(x: long): int; inline; overload;
function abs(x: real): real; inline; overload;
function min(a, b: int): int; inline; overload;
function min(a, b: long): long; inline; overload;
function max(a, b: int): int; inline; overload;
function max(a, b: long): long; inline; overload;
function mulLong(multiplier1, multiplier2: long): long; stdcall;
function divLong(divident, divisor: long; out remainder: long): long; stdcall;
function toInt(value: real): int; stdcall;
function toLong(value: real): long; stdcall;
function round(value: real): long; stdcall;
function arctan(y, x: real): real; stdcall;
function roundToInteger(value: real): real; stdcall;
function intPart(value: real): real; stdcall;
function fracPart(value: real): real; stdcall;
function sqrt(value: real): real; stdcall;
function sin(value: real): real; stdcall;
function cos(value: real): real; stdcall;
function pow2(value: real): real; stdcall;
function log2(value: real): real; stdcall;
function floor(value: real): real; stdcall;
function ceil(value: real): real; stdcall;
function pointerToInt(p: pointer): ptrint; inline;
function intToPointer(p: ptrint): pointer; inline;
function toFloat(value: real): float; stdcall;
function toDouble(value: real): double; stdcall;
function toReal(value: int): real; stdcall; overload;
function toReal(value: long): real; stdcall; overload;
function toReal(value: float): real; stdcall; overload;
function toReal(value: double): real; stdcall; overload;
function toDecString(value: real): AnsiString; overload;
function toDecString(value: long): AnsiString; overload;
function toHexString(value: long; digits: int): AnsiString;
function toUTF8String(const s: UnicodeString): AnsiString;
function toUTF16String(const s: AnsiString): UnicodeString;
function toUpperCase(const s: AnsiString): AnsiString; overload;
function toUpperCase(const s: UnicodeString): UnicodeString; overload;
function toLowerCase(const s: AnsiString): AnsiString; overload;
function toLowerCase(const s: UnicodeString): UnicodeString; overload;
function getCharCodes(const s: AnsiString): int_Array1d; overload;
function getCharCodes(const s: UnicodeString): int_Array1d; overload;
function extractString(const buf: byte_Array1d; offset, length: int): AnsiString;
function stringToByteArray(const s: AnsiString): byte_Array1d;
function startsWith(const prefix, s: AnsiString; position: int): boolean; overload;
function startsWith(const prefix, s: UnicodeString; position: int): boolean; overload;
function startsWith(const prefix, s: AnsiString): boolean; overload;
function startsWith(const prefix, s: UnicodeString): boolean; overload;
function endsWith(const suffix, s: AnsiString): boolean; overload;
function endsWith(const suffix, s: UnicodeString): boolean; overload;
function trim(const s: AnsiString): AnsiString; overload;
function trim(const s: UnicodeString): UnicodeString; overload;
function parseDecInt(const s: AnsiString; default: int): int;
function parseHexInt(const s: AnsiString; default: int): int;
function parseDecLong(const s: AnsiString; default: long): long;
function parseHexLong(const s: AnsiString; default: long): long;
function parseReal(const s: AnsiString; default: real): real;
function parseParams(): AnsiString_Array1d;
function boolean_Array1d_create(length: int): boolean_Array1d;
function wchar_Array1d_create(length: int): wchar_Array1d;
function float_Array1d_create(length: int): float_Array1d;
function double_Array1d_create(length: int): double_Array1d;
function real_Array1d_create(length: int): real_Array1d;
function byte_Array1d_create(length: int): byte_Array1d;
function short_Array1d_create(length: int): short_Array1d;
function int_Array1d_create(length: int): int_Array1d;
function long_Array1d_create(length: int): long_Array1d;
function String_Array1d_create(length: int): AnsiString_Array1d;
function UnicodeString_Array1d_create(length: int): UnicodeString_Array1d;
function boolean_Array2d_create(length: int): boolean_Array2d; overload;
function wchar_Array2d_create(length: int): wchar_Array2d; overload;
function float_Array2d_create(length: int): float_Array2d; overload;
function double_Array2d_create(length: int): double_Array2d; overload;
function real_Array2d_create(length: int): real_Array2d; overload;
function byte_Array2d_create(length: int): byte_Array2d; overload;
function short_Array2d_create(length: int): short_Array2d; overload;
function int_Array2d_create(length: int): int_Array2d; overload;
function long_Array2d_create(length: int): long_Array2d; overload;
function String_Array2d_create(length: int): AnsiString_Array2d; overload;
function UnicodeString_Array2d_create(length: int): UnicodeString_Array2d; overload;
function boolean_Array2d_create(length, sublength: int): boolean_Array2d; overload;
function wchar_Array2d_create(length, sublength: int): wchar_Array2d; overload;
function float_Array2d_create(length, sublength: int): float_Array2d; overload;
function double_Array2d_create(length, sublength: int): double_Array2d; overload;
function real_Array2d_create(length, sublength: int): real_Array2d; overload;
function byte_Array2d_create(length, sublength: int): byte_Array2d; overload;
function short_Array2d_create(length, sublength: int): short_Array2d; overload;
function int_Array2d_create(length, sublength: int): int_Array2d; overload;
function long_Array2d_create(length, sublength: int): long_Array2d; overload;
function String_Array2d_create(length, sublength: int): AnsiString_Array2d; overload;
function UnicodeString_Array2d_create(length, sublength: int): UnicodeString_Array2d; overload;
function String_create(length: int): AnsiString;
function UnicodeString_create(length: int): UnicodeString; overload;
function UnicodeString_create(const chars: wchar_Array1d): UnicodeString; overload;
function UnicodeString_create(const chars: wchar_Array1d; offset, length: int): UnicodeString; overload;
function toBooleanArray1d(const arr: array of boolean): boolean_Array1d;
function toWcharArray1d(const arr: array of wchar): wchar_Array1d;
function toFloatArray1d(const arr: array of float): float_Array1d;
function toDoubleArray1d(const arr: array of double): double_Array1d;
function toRealArray1d(const arr: array of real): real_Array1d;
function toByteArray1d(const arr: array of byte): byte_Array1d;
function toShortArray1d(const arr: array of short): short_Array1d;
function toIntArray1d(const arr: array of int): int_Array1d;
function toLongArray1d(const arr: array of long): long_Array1d;
function toStringArray1d(const arr: array of AnsiString): AnsiString_Array1d;
function toUnicodeStringArray1d(const arr: array of UnicodeString): UnicodeString_Array1d;
function toBooleanArray2d(const arr: array of boolean_Array1d): boolean_Array2d;
function toWcharArray2d(const arr: array of wchar_Array1d): wchar_Array2d;
function toFloatArray2d(const arr: array of float_Array1d): float_Array2d;
function toDoubleArray2d(const arr: array of double_Array1d): double_Array2d;
function toRealArray2d(const arr: array of real_Array1d): real_Array2d;
function toByteArray2d(const arr: array of byte_Array1d): byte_Array2d;
function toShortArray2d(const arr: array of short_Array1d): short_Array2d;
function toIntArray2d(const arr: array of int_Array1d): int_Array2d;
function toLongArray2d(const arr: array of long_Array1d): long_Array2d;
function toStringArray2d(const arr: array of AnsiString_Array1d): AnsiString_Array2d;
function toUnicodeStringArray2d(const arr: array of UnicodeString_Array1d): UnicodeString_Array2d;
procedure arraycopy(const src: boolean_Array1d; srcOffset: int; const dst: boolean_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: wchar_Array1d; srcOffset: int; const dst: wchar_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: float_Array1d; srcOffset: int; const dst: float_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: double_Array1d; srcOffset: int; const dst: double_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: real_Array1d; srcOffset: int; const dst: real_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: byte_Array1d; srcOffset: int; const dst: byte_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: short_Array1d; srcOffset: int; const dst: short_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: int_Array1d; srcOffset: int; const dst: int_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: long_Array1d; srcOffset: int; const dst: long_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: AnsiString_Array1d; srcOffset: int; const dst: AnsiString_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: UnicodeString_Array1d; srcOffset: int; const dst: UnicodeString_Array1d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: boolean_Array2d; srcOffset: int; const dst: boolean_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: wchar_Array2d; srcOffset: int; const dst: wchar_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: float_Array2d; srcOffset: int; const dst: float_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: double_Array2d; srcOffset: int; const dst: double_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: real_Array2d; srcOffset: int; const dst: real_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: byte_Array2d; srcOffset: int; const dst: byte_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: short_Array2d; srcOffset: int; const dst: short_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: int_Array2d; srcOffset: int; const dst: int_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: long_Array2d; srcOffset: int; const dst: long_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: AnsiString_Array2d; srcOffset: int; const dst: AnsiString_Array2d; dstOffset: int; length: int); overload;
procedure arraycopy(const src: UnicodeString_Array2d; srcOffset: int; const dst: UnicodeString_Array2d; dstOffset: int; length: int); overload;
{%endregion}
implementation
{%region private }
type
RunnableThread = class(TThread)
strict private
owner: Thread;
protected
procedure execute(); override;
public
constructor create(owner: Thread);
end;
{%endregion}
{%region routine }
function interlockedIncrement(target: Pointer): int; assembler; nostackframe;
asm
lea edx, [eax+$00]
mov eax, $01
lock xadd dword[edx+$00], eax
lea eax, [eax+$01]
end;
function interlockedDecrement(target: Pointer): int; assembler; nostackframe;
asm
lea edx, [eax+$00]
mov eax, -$01
lock xadd dword[edx+$00], eax
lea eax, [eax-$01]
end;
function pow10(value: real; power: int): real; stdcall;
type
RealArray = packed array [0..4] of Word;
const
tab0: array [0..31] of RealArray =
(
( $0000, $0000, $0000, $8000, $3fff ), ( $0000, $0000, $0000, $a000, $4002 ),
( $0000, $0000, $0000, $c800, $4005 ), ( $0000, $0000, $0000, $fa00, $4008 ),
( $0000, $0000, $0000, $9c40, $400c ), ( $0000, $0000, $0000, $c350, $400f ),
( $0000, $0000, $0000, $f424, $4012 ), ( $0000, $0000, $8000, $9896, $4016 ),
( $0000, $0000, $2000, $bebc, $4019 ), ( $0000, $0000, $2800, $ee6b, $401c ),
( $0000, $0000, $f900, $9502, $4020 ), ( $0000, $0000, $b740, $ba43, $4023 ),
( $0000, $0000, $a510, $e8d4, $4026 ), ( $0000, $0000, $e72a, $9184, $402a ),
( $0000, $8000, $20f4, $b5e6, $402d ), ( $0000, $a000, $a931, $e35f, $4030 ),
( $0000, $0400, $c9bf, $8e1b, $4034 ), ( $0000, $c500, $bc2e, $b1a2, $4037 ),
( $0000, $7640, $6b3a, $de0b, $403a ), ( $0000, $89e8, $2304, $8ac7, $403e ),
( $0000, $ac62, $ebc5, $ad78, $4041 ), ( $8000, $177a, $26b7, $d8d7, $4044 ),
( $9000, $6eac, $7832, $8786, $4048 ), ( $b400, $0a57, $163f, $a968, $404b ),
( $a100, $cced, $1bce, $d3c2, $404e ), ( $84a0, $4014, $5161, $8459, $4052 ),
( $a5c8, $9019, $a5b9, $a56f, $4055 ), ( $0f3a, $f420, $8f27, $cecb, $4058 ),
( $0984, $f894, $3978, $813f, $405c ), ( $0be5, $36b9, $07d7, $a18f, $405f ),
( $4edf, $0467, $c9cd, $c9f2, $4062 ), ( $2296, $4581, $7c40, $fc6f, $4065 )
);
tab1: array [0..15] of RealArray =
(
( $0000, $0000, $0000, $8000, $3fff ), ( $b59e, $2b70, $ada8, $9dc5, $4069 ),
( $a6d5, $ffcf, $1f49, $c278, $40d3 ), ( $14a3, $c59b, $ab16, $efb3, $413d ),
( $8ce0, $80e9, $47c9, $93ba, $41a8 ), ( $17aa, $7fe6, $a12b, $b616, $4212 ),
( $556b, $3927, $f78d, $e070, $427c ), ( $c930, $e33c, $96ff, $8a52, $42e7 ),
( $de8e, $9df9, $ebfb, $aa7e, $4351 ), ( $2f8c, $5c6a, $fc19, $d226, $43bb ),
( $e376, $f2cc, $2f29, $8184, $4426 ), ( $0ad2, $db90, $2700, $9fa4, $4490 ),
( $aa17, $aef8, $e310, $c4c5, $44fa ), ( $9c59, $e9b0, $9c07, $f28a, $4564 ),
( $f3d4, $ebf7, $4ae1, $957a, $45cf ), ( $a262, $0795, $d8dc, $b83e, $4639 )
);
tab2: array [0..9] of RealArray =
(
( $0000, $0000, $0000, $8000, $3fff ), ( $91c7, $a60e, $a0ae, $e319, $46a3 ),
( $0c17, $8175, $7586, $c976, $4d48 ), ( $a7e4, $3993, $353b, $b2b8, $53ed ),
( $5de5, $c53d, $3b5d, $9e8b, $5a92 ), ( $f0a6, $20a1, $54c0, $8ca5, $6137 ),
( $5a8b, $d88b, $5d25, $f989, $67db ), ( $f3f8, $bf27, $c8a2, $dd5d, $6e80 ),
( $979b, $8a20, $5202, $c460, $7525 ), ( $59f0, $6ed5, $1162, $ae35, $7bca )
);
{
расшифровка:
const
tab0: array [0..31] of real =
(
1e+0000, 1e+0001, 1e+0002, 1e+0003, 1e+0004, 1e+0005, 1e+0006, 1e+0007,
1e+0008, 1e+0009, 1e+0010, 1e+0011, 1e+0012, 1e+0013, 1e+0014, 1e+0015,
1e+0016, 1e+0017, 1e+0018, 1e+0019, 1e+0020, 1e+0021, 1e+0022, 1e+0023,
1e+0024, 1e+0025, 1e+0026, 1e+0027, 1e+0028, 1e+0029, 1e+0030, 1e+0031
);
tab1: array [0..15] of real =
(
1e+0000, 1e+0032, 1e+0064, 1e+0096, 1e+0128, 1e+0160, 1e+0192, 1e+0224,
1e+0256, 1e+0288, 1e+0320, 1e+0352, 1e+0384, 1e+0416, 1e+0448, 1e+0480
);
tab2: array [0..9] of real =
(
1e+0000, 1e+0512, 1e+1024, 1e+1536, 1e+2048,
1e+2560, 1e+3072, 1e+3584, 1e+4096, 1e+4608
);
}
var
pow0: int;
pow1: int;
pow2: int;
begin
result := value;
setRoundMode(ROUND_TO_NEAREST);
if power > 0 then begin
if power >= 5120 then begin
result := INF;
exit;
end;
pow0 := power and $1f;
pow1 := (power shr 5) and $0f;
pow2 := (power shr 9) and $0f;
result := result * real(tab0[pow0]) * real(tab1[pow1]) * real(tab2[pow2]);
end else
if power < 0 then begin
power := -power;
if power >= 5120 then begin
result := 0;
exit;
end;
pow0 := power and $1f;
pow1 := (power shr 5) and $0f;
pow2 := (power shr 9) and $0f;
result := result / real(tab0[pow0]) / real(tab1[pow1]) / real(tab2[pow2]);
end;
end;
procedure startThread(target: Runnable);
begin
(Thread.create(target, 'Безымянный поток', true)).start();
end;
procedure startThread(target: Runnable; const name: AnsiString);
begin
(Thread.create(target, name, true)).start();
end;
procedure configureFPU(); assembler; nostackframe;
asm
lea esp, [esp-$04]
fnstcw word [esp+$00]
or dword[esp+$00], $0000003f
and dword[esp+$00], $0000f3ff
fnclex
fldcw word [esp+$00]
lea esp, [esp+$04]
end;
procedure setRoundMode(mode: int); assembler; nostackframe;
asm
lea esp, [esp-$04]
fnstcw word [esp+$00]
and dword[esp+$00], $0000f3ff
and eax, $03
shl eax, $0a
or dword[esp+$00], eax
fclex
fldcw word [esp+$00]
lea esp, [esp+$04]
end;
function sar(value, bits: int): int; assembler; nostackframe;
asm
mov cl, dl
sar eax, cl
end;
function isNaN(value: real): boolean; inline;
begin
result := cmplReal(value, value) <> 0;
end;
function isInfinity(value: real): boolean; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
ffree st
fincstp
sahf
jz @0
jnp @0
jnc @0
mov eax, true
ret $0c
@0: mov eax, false
end;
function byteSwap(value: int): int; assembler; nostackframe;
asm
bswap eax
end;
function byteSwap(value: long): long; stdcall; assembler; nostackframe;
asm
mov eax, dword[value+$04]
mov edx, dword[value+$00]
bswap eax
bswap edx
end;
function floatToIntBits(a: float): int; inline;
begin
result := FloatRecord(a).bits;
end;
function intBitsToFloat(a: int): float; inline;
begin
result := FloatRecord(a).value;
end;
function doubleToLongBits(a: double): long; inline;
begin
result := DoubleRecord(a).bits;
end;
function longBitsToDouble(a: long): double; inline;
begin
result := DoubleRecord(a).value;
end;
function extractSignificand(a: real): long; inline;
begin
result := RealRecord(a).significand;
end;
function extractExponentAndSign(a: real): int; inline;
begin
result := RealRecord(a).exponentAngSign and $ffff;
end;
function buildReal(exponentAndSign: int; significand: long): real; inline;
var
r: RealRecord absolute result;
begin
result := 0;
r.exponentAngSign := short(exponentAndSign);
r.significand := significand;
end;
function buildLong(lo, hi: int): long; inline;
var
r: LongRecord;
begin
r.lo := lo;
r.hi := hi;
result := r.value;
end;
function cmpgReal(v1, v2: real): int; stdcall; assembler; nostackframe;
asm
fld tbyte[v2]
fld tbyte[v1]
fcompp
fnstsw ax
sahf
jp @gt
ja @gt
je @eq
mov eax, -$01
ret $18
@eq: xor eax, eax
ret $18
@gt: mov eax, $01
end;
function cmplReal(v1, v2: real): int; stdcall; assembler; nostackframe;
asm
fld tbyte[v2]
fld tbyte[v1]
fcompp
fnstsw ax
sahf
jp @lt
ja @gt
je @eq
@lt: mov eax, -$01
ret $18
@eq: xor eax, eax
ret $18
@gt: mov eax, $01
end;
function zeroExtend(value: int): long; inline;
begin
result := long(value) and long($00000000ffffffff);
end;
function abs(x: int): int; inline;
begin
if x >= 0 then begin
result := x;
end else begin
result := -x;
end;
end;
function abs(x: long): int; inline;
begin
if x >= 0 then begin
result := x;
end else begin
result := -x;
end;
end;
function abs(x: real): real; inline;
begin
if cmpgReal(x, 0.0) >= 0 then begin
result := x;
end else begin
result := -x;
end;
end;
function min(a, b: int): int; inline;
begin
if a <= b then begin
result := a;
end else begin
result := b;
end;
end;
function min(a, b: long): long; inline;
begin
if a <= b then begin
result := a;
end else begin
result := b;
end;
end;
function max(a, b: int): int; inline;
begin
if a >= b then begin
result := a;
end else begin
result := b;
end;
end;
function max(a, b: long): long; inline;
begin
if a >= b then begin
result := a;
end else begin
result := b;
end;
end;
function mulLong(multiplier1, multiplier2: long): long; stdcall; assembler; nostackframe;
asm
mov eax, [multiplier2+$04]
mul dword[multiplier1+$00]
lea ecx, [eax+$00]
mov eax, [multiplier1+$04]
mul dword[multiplier2+$00]
lea ecx, [eax+ecx]
mov eax, [multiplier1+$00]
mul dword[multiplier2+$00]
lea edx, [ecx+edx]
end;
function divLong(divident, divisor: long; out remainder: long): long; stdcall; assembler; nostackframe;
asm
push ebx
mov ebx, [divisor+$04]
mov ecx, [divisor+$08]
mov eax, [divident+$04]
mov edx, [divident+$08]
{ знак делителя }
test ecx, $80000000
jnz @3
push dword $00
jmp @4
@3: push dword $01
neg ebx
adc ecx, $00
neg ecx
{ знак делимого }
@4: test edx, $80000000
jnz @5
push dword $00
jmp @6
@5: push dword $01
neg eax
adc edx, $00
neg edx
{ подготовка к делению }
@6: push esi
push edi
push ebp
lea ebp, [ecx+$00]
xor esi, esi
xor edi, edi
mov ecx, $40
{ деление }
{ edx:eax = делимое -> частное }
{ ebp:ebx = делитель }
{ edi:esi = 0 -> остаток }
@0: shl eax, $01
rcl edx, $01
rcl esi, $01
rcl edi, $01
cmp edi, ebp
jb @2
ja @1
cmp esi, ebx
jb @2
@1: sub esi, ebx
sbb edi, ebp
lea eax, [eax+$01]
@2: loop @0
{ знак остатка }
pop ebp
test byte [esp+$08], $01
jz @7
neg esi
adc edi, $00
neg edi
test byte [esp+$0c], $01
jnz @7
neg eax
adc edx, $00
neg edx
jmp @8
{ знак частного }
@7: test byte [esp+$08], $01
jnz @8
test byte [esp+$0c], $01
jz @8
neg eax
adc edx, $00
neg edx
{ запись остатка }
@8: mov ebx, [remainder+$14]
mov dword[ebx+$00], esi
mov dword[ebx+$04], edi
{ выход из функции }
pop edi
pop esi
lea esp, [esp+$08]
pop ebx
end;
function toInt(value: real): int; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
ffree st
fincstp
sahf
jz @0
jp @0
jnc @0
xor eax, eax
ret $0c
@0: lea esp, [esp-$04]
mov dword[esp+$00], MAX_INT
fild dword[esp+$00]
lea esp, [esp+$04]
fld tbyte[value]
fcompp
fnstsw ax
sahf
jbe @1
mov eax, MAX_INT
ret $0c
@1: mov eax, ROUND_TOWARD_ZERO
call setRoundMode
fld tbyte[value]
lea esp, [esp-$04]
fistp dword[esp+$00]
pop eax
end;
function toLong(value: real): long; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
ffree st
fincstp
sahf
jz @0
jp @0
jnc @0
xor eax, eax
xor edx, edx
ret $0c
@0: lea esp, [esp-$08]
mov dword[esp+$00], $ffffffff
mov dword[esp+$04], $7fffffff
fild qword[esp+$00]
lea esp, [esp+$08]
fld tbyte[value]
fcompp
fnstsw ax
sahf
jbe @1
mov eax, $ffffffff
mov edx, $7fffffff
ret $0c
@1: mov eax, ROUND_TOWARD_ZERO
call setRoundMode
fld tbyte[value]
lea esp, [esp-$08]
fistp qword[esp+$00]
pop eax
pop edx
end;
function round(value: real): long; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
ffree st
fincstp
sahf
jz @0
jp @0
jnc @0
xor eax, eax
xor edx, edx
ret $0c
@0: lea esp, [esp-$08]
mov dword[esp+$00], $ffffffff
mov dword[esp+$04], $7fffffff
fild qword[esp+$00]
lea esp, [esp+$08]
fld tbyte[value]
fcompp
fnstsw ax
sahf
jbe @1
mov eax, $ffffffff
mov edx, $7fffffff
ret $0c
@1: mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
lea esp, [esp-$08]
fistp qword[esp+$00]
pop eax
pop edx
end;
function arctan(y, x: real): real; stdcall; assembler; nostackframe;
asm
fld tbyte[y]
fld tbyte[x]
fpatan
end;
function roundToInteger(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
frndint
end;
function intPart(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TOWARD_ZERO
call setRoundMode
fld tbyte[value]
frndint
end;
function fracPart(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TOWARD_ZERO
call setRoundMode
fld tbyte[value]
fld st
frndint
fsubp st(1), st
end;
function sqrt(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
fsqrt
end;
function sin(value: real): real; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
ffree st
fincstp
sahf
jz @0
jc @3
@0: mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
fsin
fnstsw ax
sahf
jp @1
ret $0c
@1: ffree st
fincstp
lea esp, [esp-$0c]
mov dword[esp+$00], $2168c235
mov dword[esp+$04], $c90fdaa2
mov dword[esp+$08], $00004001
fld tbyte[esp+$00]
lea esp, [esp+$0c]
fld tbyte[value]
@2: fprem
fstsw ax
test ax, $0400
jnz @2
fstp st(1)
fsin
ret $0c
@3: lea esp, [esp-$0c]
mov dword[esp+$00], $00000000
mov dword[esp+$04], $c0000000
mov dword[esp+$08], $00007fff
fld tbyte[esp+$00]
lea esp, [esp+$0c]
end;
function cos(value: real): real; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
ffree st
fincstp
sahf
jz @0
jc @3
@0: mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
fcos
fnstsw ax
sahf
jp @1
ret $0c
@1: ffree st
fincstp
lea esp, [esp-$0c]
mov dword[esp+$00], $2168c235
mov dword[esp+$04], $c90fdaa2
mov dword[esp+$08], $00004001
fld tbyte[esp+$00]
lea esp, [esp+$0c]
fld tbyte[value]
@2: fprem
fstsw ax
test ax, $0400
jnz @2
fstp st(1)
fcos
ret $0c
@3: lea esp, [esp-$0c]
mov dword[esp+$00], $00000000
mov dword[esp+$04], $c0000000
mov dword[esp+$08], $00007fff
fld tbyte[esp+$00]
lea esp, [esp+$0c]
end;
function pow2(value: real): real; stdcall; assembler; nostackframe;
asm
fld tbyte[value]
fxam
fnstsw ax
sahf
jz @1
jnp @1
jnc @1
ffree st
fincstp
test ah, $02
jz @0
push dword $00000000
fild dword[esp+$00]
lea esp, [esp+$04]
ret $0c
@0: lea esp, [esp-$0c]
mov dword[esp+$00], $00000000
mov dword[esp+$04], $80000000
mov dword[esp+$08], $00007fff
fld tbyte[esp+$00]
lea esp, [esp+$0c]
ret $0c
@1: mov eax, ROUND_TOWARD_ZERO
call setRoundMode
fld st
frndint
mov eax, ROUND_TO_NEAREST
call setRoundMode
fsubp st(1), st
f2xm1
fld1
faddp st(1), st
fld tbyte[value]
fld1
fscale
fmulp st(2), st
ffree st
fincstp
end;
function log2(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TO_NEAREST
call setRoundMode
fld1
fld tbyte[value]
fyl2x
end;
function floor(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_DOWN
call setRoundMode
fld tbyte[value]
frndint
end;
function ceil(value: real): real; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_UP
call setRoundMode
fld tbyte[value]
frndint
end;
{$WARNINGS OFF}
{$HINTS OFF}
function pointerToInt(p: Pointer): PtrInt; inline;
begin
result := PtrInt(p);
end;
function intToPointer(p: PtrInt): Pointer; inline;
begin
result := Pointer(p);
end;
{$WARNINGS ON}
{$HINTS ON}
function toFloat(value: real): float; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
lea esp, [esp-$04]
fstp dword[esp+$00]
fld dword[esp+$00]
lea esp, [esp+$04]
end;
function toDouble(value: real): double; stdcall; assembler; nostackframe;
asm
mov eax, ROUND_TO_NEAREST
call setRoundMode
fld tbyte[value]
lea esp, [esp-$08]
fstp qword[esp+$00]
fld qword[esp+$00]
lea esp, [esp+$08]
end;
function toReal(value: int): real; stdcall; assembler; nostackframe;
asm
fild dword[value]
end;
function toReal(value: long): real; stdcall; assembler; nostackframe;
asm
fild qword[value]
end;
function toReal(value: float): real; stdcall; assembler; nostackframe;
asm
fld dword[value]
end;
function toReal(value: double): real; stdcall; assembler; nostackframe;
asm
fld qword[value]
end;
function toDecString(value: real): AnsiString;
const
digits = '0123456789';
var
buf: packed array [0..31] of char;
i: int;
len: int;
order: int;
dotpos: int;
rem: long;
intval: long;
expform: boolean;
begin
if isNaN(value) then begin
result := 'NaN';
exit;
end;
if cmplReal(value, POS_INF) = 0 then begin
result := '+Inf';
exit;
end;
if cmplReal(value, NEG_INF) = 0 then begin
result := '-Inf';
exit;
end;
initialize(buf);
fillChar(buf, sizeof(buf), '0');
len := 0;
if int(RealRecord(value).exponentAngSign) < 0 then begin
buf[len] := '-';
inc(len);
value := -value;
end;
if cmplReal(value, 0.0) <> 0 then begin
order := toInt(3.010299956639811952e-0001 * log2(value)); { order = lg(value) }
expform := (value < 1.e-0006) or (value >= 1.e+0018);
if expform then begin
{ (value < 1.e-0006) or (value >= 1.e+0018) }
if order < 0 then begin
dec(order);
end;
intval := round(pow10(value, 17 - order));
if intval < 100000000000000000 then begin
intval := mulLong(intval, 10);
dec(order);
end;
if intval > 999999999999999999 then begin
intval := divLong(intval, 10, rem);
inc(order);
end;
dotpos := len + 1;
end else
if value < 1.e+0000 then begin
{ (value >= 1.e-0006) and (value < 1.e+0000) }
intval := round(pow10(value, 17));
dotpos := len + 1;
end else
if value < 1.e+0017 then begin
{ (value >= 1.e+0000) and (value < 1.e+0017) }
intval := round(pow10(value, 17 - order));
if intval <= 99999999999999999 then begin
intval := mulLong(intval, 10);
dec(order);
end;
if intval > 999999999999999999 then begin
intval := divLong(intval, 10, rem);
inc(order);
end;
dotpos := len + order + 1;
end else begin
{ (value >= 1.e+0017) and (value < 1.e+0018) }
intval := round(value);
if intval > 999999999999999999 then begin
intval := 999999999999999999;
end;
dotpos := len + 18;
end;
buf[dotpos] := '.';
for i := len + 17 downto len do begin
intval := divLong(intval, 10, rem);
buf[i + byte(i >= dotpos)] := digits[int(rem) + 1];
end;
inc(len, 20);
while buf[len - 1] in ['0', '.'] do begin
dec(len);
if buf[len] = '.' then begin
break;
end;
end;
if expform then begin
buf[len] := 'E';
if order < 0 then begin
buf[len + 1] := '-';
order := -order;
end else begin
buf[len + 1] := '+';
end;
buf[len + 2] := digits[((order div 1000) mod 10) + 1];
buf[len + 3] := digits[((order div 100) mod 10) + 1];
buf[len + 4] := digits[((order div 10) mod 10) + 1];
buf[len + 5] := digits[(order mod 10) + 1];
inc(len, 6);
end;
end else begin
inc(len);
end;
result := String_create(len);
move(buf[0], result[1], len);
end;
function toDecString(value: long): AnsiString;
const
BASE = 10;
MIN_VALUE_STRING = '-9223372036854775808';
DEC_DIGITS = '0123456789';
MINUS = '-';
var
sign: boolean;
begin
if value = MIN_LONG then begin
result := MIN_VALUE_STRING;
exit;
end;
result := '';
if value < 0 then begin
value := -value;
sign := true;
end else begin
sign := false;
end;
repeat
result := DEC_DIGITS[byte(value mod BASE) + 1] + result;
value := value div BASE;
until value = 0;
if sign then begin
result := MINUS + result;
end;
end;
function toHexString(value: long; digits: int): AnsiString;
const
MASK = long($0fffffffffffffff);
begin
if digits <= 0 then begin
digits := 1;
end;
result := '';
repeat
result := HEX_DIGITS[byte(value and $f) + 1] + result;
value := (value shr 4) and MASK;
dec(digits);
until (value = 0) and (digits <= 0);
end;
function toUTF8String(const s: UnicodeString): AnsiString;
var
buf: PChar;
cap: int;
idx: int;
procedure appendStr(const s: AnsiString);
var
l: int;
begin
l := length(s);
if idx > cap - l then begin
inc(cap, (l + $7fff) and (-$8000));
buf := reallocMemory(buf, cap);
end;
move(s[1], buf[idx], l);
inc(idx, l);
end;
var
i: int;
c: int;
c1: int;
uchr: AnsiString;
begin
buf := nil;
cap := 0;
idx := 0;
i := 1;
while i <= length(s) do begin
c := int(s[i]) and $ffff;
inc(i);
if (i <= length(s)) and (c >= $d800) and (c < $dc00) then begin
c1 := int(s[i]) and $ffff;
if (c1 >= $dc00) and (c1 < $e000) then begin
c := ((c and $03ff) shl $0a) + (c1 and $03ff) + $00010000;
inc(i);
end;
end;
case c of
$00000000..$0000007f:
uchr := char(c);
$00000080..$000007ff:
uchr := char($c0 + ((c shr $06) and $1f)) + char($80 + (c and $3f));
$00000800..$0000ffff:
uchr := char($e0 + ((c shr $0c) and $0f)) + char($80 + ((c shr $06) and $3f)) + char($80 + (c and $3f));
else
uchr := char($f0 + ((c shr $12) and $07)) + char($80 + ((c shr $0c) and $3f)) + char($80 + ((c shr $06) and $3f)) + char($80 + (c and $3f));
end;
appendStr(uchr);
end;
result := String_create(idx);
move(buf[0], result[1], idx);
freeMemory(buf);
end;
function toUTF16String(const s: AnsiString): UnicodeString;
var
buf: PWideChar;
cap: int;
idx: int;
procedure appendChar(c: int);
begin
if idx >= cap - 1 then begin
inc(cap, $8000);
buf := reallocMemory(buf, sizeof(wchar) * cap);
end;
if c < $00010000 then begin
buf[idx] := wchar(c);
inc(idx);
end else begin
dec(c, $00010000);
buf[idx] := wchar($d800 + ((c shr $0a) and $ffff));
buf[idx + 1] := wchar($dc00 + (c and $03ff));
inc(idx, 2);
end;
end;
var
i: int;
c: int;
uchr: int;
shift: int;
begin
buf := nil;
cap := 0;
idx := 0;
uchr := 0;
shift := -1;
for i := 1 to length(s) do begin
c := int(s[i]) and $ff;
case c of
$00..$7f: begin
if shift >= 0 then begin
appendChar(uchr);
end;
appendChar(c);
end;
$80..$bf: begin
uchr := uchr + ((c and $3f) shl shift);
dec(shift, $06);
if shift < 0 then begin
appendChar(uchr);
end;
end;
$c0..$df: begin
if shift >= 0 then begin
appendChar(uchr);
end;
uchr := (c and $1f) shl $06;
shift := $00;
end;
$e0..$ef: begin
if shift >= 0 then begin
appendChar(uchr);
end;
uchr := (c and $0f) shl $0c;
shift := $06;
end;
else
if shift >= 0 then begin
appendChar(uchr);
end;
uchr := (c and $07) shl $12;
shift := $0c;
end;
end;
result := UnicodeString_create(idx);
move(buf[0], result[1], sizeof(wchar) * idx);
freeMemory(buf);
end;
function toUpperCase(const s: AnsiString): AnsiString;
var
l: int;
i: int;
c: char;
begin
l := length(s);
result := copy(s, 1, l);
for i := 1 to l do begin
c := result[i];
if (c >= 'a') and (c <= 'z') then begin
result[i] := char(int(c) - 32);
end;
end;
end;
function toUpperCase(const s: UnicodeString): UnicodeString;
var
l: int;
i: int;
c: wchar;
begin
l := length(s);
result := copy(s, 1, l);
for i := 1 to l do begin
c := result[i];
if (c >= 'a') and (c <= 'z') then begin
result[i] := wchar(int(c) - 32);
end;
end;
end;
function toLowerCase(const s: AnsiString): AnsiString;
var
l: int;
i: int;
c: Char;
begin
l := length(s);
result := copy(s, 1, l);
for i := 1 to l do begin
c := result[i];
if (c >= 'A') and (c <= 'Z') then begin
result[i] := char(int(c) + 32);
end;
end;
end;
function toLowerCase(const s: UnicodeString): UnicodeString;
var
l: int;
i: int;
c: wchar;
begin
l := length(s);
result := copy(s, 1, l);
for i := 1 to l do begin
c := result[i];
if (c >= 'A') and (c <= 'Z') then begin
result[i] := wchar(int(c) + 32);
end;
end;
end;
function getCharCodes(const s: AnsiString): int_Array1d;
begin
result := getCharCodes(toUTF16String(s));
end;
function getCharCodes(const s: UnicodeString): int_Array1d;
var
i: int;
j: int;
c: int;
w: int;
w1: int;
begin
c := 0;
i := 1;
while i <= length(s) do begin
w := int(s[i]) and $ffff;
inc(i);
inc(c);
if (i <= length(s)) and (w >= $d800) and (w < $dc00) then begin
w1 := int(s[i]) and $ffff;
if (w1 >= $dc00) and (w1 < $e000) then begin
inc(i);
end;
end;
end;
result := int_Array1d_create(c);
i := 1;
j := 0;
while i <= length(s) do begin
w := int(s[i]) and $ffff;
inc(i);
if (i <= length(s)) and (w >= $d800) and (w < $dc00) then begin
w1 := int(s[i]) and $ffff;
if (w1 >= $dc00) and (w1 < $e000) then begin
result[j] := ((w and $03ff) shl $0a) + (w1 and $03ff) + $00010000;
inc(i);
end else begin
result[j] := w;
end;
end else begin
result[j] := w;
end;
inc(j);
end;
end;
function extractString(const buf: byte_Array1d; offset, length: int): AnsiString;
var
lim: int;
len: int;
begin
lim := offset + length;
len := System.length(buf);
if (lim > len) or (lim < offset) or (offset < 0) or (offset > len) then begin
raise ArrayIndexOutOfBoundsException.create('extractString: индекс элемента массива выходит из диапазона.');
end;
result := String_create(length);
move(buf[offset], result[1], length);
end;
function stringToByteArray(const s: AnsiString): byte_Array1d;
var
l: int;
begin
l := length(s);
result := byte_Array1d_create(l);
move(s[1], result[0], l);
end;
function startsWith(const prefix, s: AnsiString; position: int): boolean;
begin
result := (position >= 1) and (position <= length(s) - length(prefix) + 1) and (copy(s, position, length(prefix)) = prefix);
end;
function startsWith(const prefix, s: UnicodeString; position: int): boolean;
begin
result := (position >= 1) and (position <= length(s) - length(prefix) + 1) and (copy(s, position, length(prefix)) = prefix);
end;
function startsWith(const prefix, s: AnsiString): boolean;
begin
result := startsWith(prefix, s, 1);
end;
function startsWith(const prefix, s: UnicodeString): boolean;
begin
result := startsWith(prefix, s, 1);
end;
function endsWith(const suffix, s: AnsiString): boolean;
begin
result := startsWith(suffix, s, length(s) - length(suffix) + 1);
end;
function endsWith(const suffix, s: UnicodeString): boolean;
begin
result := startsWith(suffix, s, length(s) - length(suffix) + 1);
end;
function trim(const s: AnsiString): AnsiString;
var
b: int;
e: int;
l: int;
begin
l := length(s);
b := 1;
while (b <= l) and (s[b] <= #32) do begin
inc(b);
end;
e := l;
while (e >= b) and (s[e] <= #32) do begin
dec(e);
end;
result := copy(s, b, e - b + 1);
end;
function trim(const s: UnicodeString): UnicodeString;
var
b: int;
e: int;
l: int;
begin
l := length(s);
b := 1;
while (b <= l) and (s[b] <= #32) do begin
inc(b);
end;
e := l;
while (e >= b) and (s[e] <= #32) do begin
dec(e);
end;
result := copy(s, b, e - b + 1);
end;
function parseDecInt(const s: AnsiString; default: int): int;
var
n: boolean;
i: int;
c: int;
begin
if length(s) <= 0 then begin
result := default;
exit;
end;
result := 0;
n := s[1] = '-';
for i := 1 to length(s) do begin
c := int(s[i]);
case char(c) of
'0'..'9': begin
result := (result * 10) + (c - int('0'));
end;
'-': begin
if i > 1 then begin
result := default;
exit;
end;
end;
else
result := default;
exit;
end;
end;
if n then begin
result := -result;
end;
end;
function parseHexInt(const s: AnsiString; default: int): int;
var
i: int;
c: int;
l: int;
begin
l := length(s);
if l = 0 then begin
result := default;
exit;
end;
result := 0;
for i := 1 to l do begin
c := int(s[i]);
case char(c) of
'0'..'9': begin
result := (result shl 4) + (c - int('0'));
end;
'A'..'F': begin
result := (result shl 4) + (c - int('A') + 10);
end;
'a'..'f': begin
result := (result shl 4) + (c - int('a') + 10);
end;
else
result := default;
exit;
end;
end;
end;
function parseDecLong(const s: AnsiString; default: long): long;
var
n: boolean;
i: int;
c: int;
begin
result := 0;
n := (length(s) > 0) and (s[1] = '-');
for i := 1 to length(s) do begin
c := int(s[i]);
case char(c) of
'0'..'9': begin
result := mulLong(result, 10) + (long(c) - long('0'));
end;
'-': begin
if i > 1 then begin
result := default;
exit;
end;
end;
else
result := default;
exit;
end;
end;
if n then begin
result := -result;
end;
end;
function parseHexLong(const s: AnsiString; default: long): long;
var
i: int;
c: int;
l: int;
begin
l := length(s);
if l = 0 then begin
result := default;
exit;
end;
result := 0;
for i := 1 to l do begin
c := int(s[i]);
case char(c) of
'0'..'9': begin
result := (result shl 4) + (long(c) - long('0'));
end;
'A'..'F': begin
result := (result shl 4) + (long(c) - long('A') + 10);
end;
'a'..'f': begin
result := (result shl 4) + (long(c) - long('a') + 10);
end;
else
result := default;
exit;
end;
end;
end;
function parseReal(const s: AnsiString; default: real): real;
var
error: boolean;
negative: boolean;
c: System.Char;
pos: int;
order: int;
fracLength: int;
text: PChar;
lc: AnsiString;
begin
if length(s) = 0 then begin
result := default;
exit;
end;
lc := toLowerCase(s);
if (lc = '+inf') or (lc = 'inf') then begin
result := POS_INF;
exit;
end;
if lc = '-inf' then begin
result := NEG_INF;
exit;
end;
if lc = 'nan' then begin
result := NAN;
exit;
end;
result := 0;
error := false;
negative := false;
pos := 0;
fracLength := 0;
order := 0;
text := PChar(s);
case text[0] of
'+', ' ': begin
inc(pos);
end;
'-': begin
negative := true;
inc(pos);
end;
end;
c := text[pos];
while (c >= '0') and (c <= '9') do begin
result := (10.0 * result) + toReal(int(c) - int('0'));
inc(pos);
c := text[pos];
end;
if c = '.' then begin
inc(pos);
c := text[pos];
while (c >= '0') and (c <= '9') do begin
result := (10.0 * result) + toReal(int(c) - int('0'));
inc(fracLength);
inc(pos);
c := text[pos];
end;
end;
if negative then begin
result := -result;
negative := false;
end;
c := text[pos];
if c in ['E', 'e'] then begin
inc(pos);
case text[pos] of
'+': begin
inc(pos);
end;
'-': begin
negative := true;
inc(pos);
end;
end;
c := text[pos];
if (c >= '0') and (c <= '9') then begin
repeat
order := (10 * order) + (int(c) - int('0'));
if order > 9999 then begin
error := true;
break;
end;
inc(pos);
c := text[pos];
until (c < '0') or (c > '9');
end else begin
error := true;
end;
end;
if text[pos] <> #0 then begin
error := true;
end;
if not error then begin
if negative then begin
order := -order;
end;
result := pow10(result, order - fracLength);
if isInfinity(result) then begin
error := true;
end;
end;
if error then begin
result := default;
end;
end;
function parseParams(): AnsiString_Array1d;
const
SPACE = #32;
QUOTE = '"';
var
s: UnicodeString;
r: AnsiString;
i: int;
c: int;
l: int;
b: int;
f: boolean;
begin
s := UnicodeString(Windows.getCommandLineW());
c := 0;
l := length(s);
f := false;
for i := 1 to l do begin
if s[i] = QUOTE then begin
f := not f;
end;
if (not f) and (i > 1) and (s[i - 1] > SPACE) and (s[i] = SPACE) then begin
inc(c);
end;
end;
if (l > 0) and (s[l] > SPACE) then begin
inc(c);
end;
result := String_Array1d_create(c);
c := 0;
b := 1;
f := false;
for i := 1 to l do begin
if (not f) and (s[i] > SPACE) and (((i > 1) and (s[i - 1] = SPACE)) or (i = 1)) then begin
b := i;
end;
if s[i] = QUOTE then begin
f := not f;
end;
if (not f) and (s[i] > SPACE) and (((i < l) and (s[i + 1] = SPACE)) or (i = l)) then begin
if s[i] = QUOTE then begin
result[c] := toUTF8String(copy(s, b + 1, i - b - 1));
end else begin
result[c] := toUTF8String(copy(s, b, i - b + 1));
end;
inc(c);
end;
end;
if length(result) > 0 then begin
r := result[0];
for i := length(r) downto 1 do begin
if r[i] = '/' then begin
r[i] := DIRECTORY_SEPARATOR;
end;
end;
result[0] := r;
end;
end;
function boolean_Array1d_create(length: int): boolean_Array1d;
begin
setLength(result, length);
end;
function wchar_Array1d_create(length: int): wchar_Array1d;
begin
setLength(result, length);
end;
function float_Array1d_create(length: int): float_Array1d;
begin
setLength(result, length);
end;
function double_Array1d_create(length: int): double_Array1d;
begin
setLength(result, length);
end;
function real_Array1d_create(length: int): real_Array1d;
begin
setLength(result, length);
end;
function byte_Array1d_create(length: int): byte_Array1d;
begin
setLength(result, length);
end;
function short_Array1d_create(length: int): short_Array1d;
begin
setLength(result, length);
end;
function int_Array1d_create(length: int): int_Array1d;
begin
setLength(result, length);
end;
function long_Array1d_create(length: int): long_Array1d;
begin
setLength(result, length);
end;
function String_Array1d_create(length: int): AnsiString_Array1d;
begin
setLength(result, length);
end;
function UnicodeString_Array1d_create(length: int): UnicodeString_Array1d;
begin
setLength(result, length);
end;
function boolean_Array2d_create(length: int): boolean_Array2d;
begin
setLength(result, length);
end;
function wchar_Array2d_create(length: int): wchar_Array2d;
begin
setLength(result, length);
end;
function float_Array2d_create(length: int): float_Array2d;
begin
setLength(result, length);
end;
function double_Array2d_create(length: int): double_Array2d;
begin
setLength(result, length);
end;
function real_Array2d_create(length: int): real_Array2d;
begin
setLength(result, length);
end;
function byte_Array2d_create(length: int): byte_Array2d;
begin
setLength(result, length);
end;
function short_Array2d_create(length: int): short_Array2d;
begin
setLength(result, length);
end;
function int_Array2d_create(length: int): int_Array2d;
begin
setLength(result, length);
end;
function long_Array2d_create(length: int): long_Array2d;
begin
setLength(result, length);
end;
function String_Array2d_create(length: int): AnsiString_Array2d;
begin
setLength(result, length);
end;
function UnicodeString_Array2d_create(length: int): UnicodeString_Array2d;
begin
setLength(result, length);
end;
function boolean_Array2d_create(length, sublength: int): boolean_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function wchar_Array2d_create(length, sublength: int): wchar_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function float_Array2d_create(length, sublength: int): float_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function double_Array2d_create(length, sublength: int): double_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function real_Array2d_create(length, sublength: int): real_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function byte_Array2d_create(length, sublength: int): byte_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function short_Array2d_create(length, sublength: int): short_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function int_Array2d_create(length, sublength: int): int_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function long_Array2d_create(length, sublength: int): long_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function String_Array2d_create(length, sublength: int): AnsiString_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function UnicodeString_Array2d_create(length, sublength: int): UnicodeString_Array2d;
var
i: int;
begin
setLength(result, length);
for i := length - 1 downto 0 do begin
setLength(result[i], sublength);
end;
end;
function String_create(length: int): AnsiString;
begin
setLength(result, length);
end;
function UnicodeString_create(length: int): UnicodeString;
begin
setLength(result, length);
end;
function UnicodeString_create(const chars: wchar_Array1d): UnicodeString;
begin
result := UnicodeString_create(chars, 0, length(chars));
end;
function UnicodeString_create(const chars: wchar_Array1d; offset, length: int): UnicodeString;
var
lim: int;
len: int;
begin
lim := offset + length;
len := System.length(chars);
if (lim > len) or (lim < offset) or (offset < 0) or (offset > len) then begin
raise ArrayIndexOutOfBoundsException.create('UnicodeString_create: индекс элемента массива выходит из диапазона.');
end;
result := UnicodeString_create(length);
move(chars[offset], result[1], length * sizeof(wchar));
end;
function toBooleanArray1d(const arr: array of boolean): boolean_Array1d;
begin
result := boolean_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(boolean));
end;
function toWcharArray1d(const arr: array of wchar): wchar_Array1d;
begin
result := wchar_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(wchar));
end;
function toFloatArray1d(const arr: array of float): float_Array1d;
begin
result := float_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(float));
end;
function toDoubleArray1d(const arr: array of double): double_Array1d;
begin
result := double_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(double));
end;
function toRealArray1d(const arr: array of real): real_Array1d;
begin
result := real_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(real));
end;
function toByteArray1d(const arr: array of byte): byte_Array1d;
begin
result := byte_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(byte));
end;
function toShortArray1d(const arr: array of short): short_Array1d;
begin
result := short_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(short));
end;
function toIntArray1d(const arr: array of int): int_Array1d;
begin
result := int_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(int));
end;
function toLongArray1d(const arr: array of long): long_Array1d;
begin
result := long_Array1d_create(length(arr));
move(arr[0], result[0], length(result) * sizeof(long));
end;
function toStringArray1d(const arr: array of AnsiString): AnsiString_Array1d;
var
i: int;
begin
result := String_Array1d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toUnicodeStringArray1d(const arr: array of UnicodeString): UnicodeString_Array1d;
var
i: int;
begin
result := UnicodeString_Array1d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toBooleanArray2d(const arr: array of boolean_Array1d): boolean_Array2d;
var
i: int;
begin
result := boolean_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toWcharArray2d(const arr: array of wchar_Array1d): wchar_Array2d;
var
i: int;
begin
result := wchar_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toFloatArray2d(const arr: array of float_Array1d): float_Array2d;
var
i: int;
begin
result := float_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toDoubleArray2d(const arr: array of double_Array1d): double_Array2d;
var
i: int;
begin
result := double_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toRealArray2d(const arr: array of real_Array1d): real_Array2d;
var
i: int;
begin
result := real_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toByteArray2d(const arr: array of byte_Array1d): byte_Array2d;
var
i: int;
begin
result := byte_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toShortArray2d(const arr: array of short_Array1d): short_Array2d;
var
i: int;
begin
result := short_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toIntArray2d(const arr: array of int_Array1d): int_Array2d;
var
i: int;
begin
result := int_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toLongArray2d(const arr: array of long_Array1d): long_Array2d;
var
i: int;
begin
result := long_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toStringArray2d(const arr: array of AnsiString_Array1d): AnsiString_Array2d;
var
i: int;
begin
result := String_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
function toUnicodeStringArray2d(const arr: array of UnicodeString_Array1d): UnicodeString_Array2d;
var
i: int;
begin
result := UnicodeString_Array2d_create(length(arr));
for i := length(result) - 1 downto 0 do begin
result[i] := arr[i];
end;
end;
procedure arraycopy(const src: boolean_Array1d; srcOffset: int; const dst: boolean_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(boolean));
end;
procedure arraycopy(const src: wchar_Array1d; srcOffset: int; const dst: wchar_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(wchar));
end;
procedure arraycopy(const src: float_Array1d; srcOffset: int; const dst: float_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(float));
end;
procedure arraycopy(const src: double_Array1d; srcOffset: int; const dst: double_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(double));
end;
procedure arraycopy(const src: real_Array1d; srcOffset: int; const dst: real_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(real));
end;
procedure arraycopy(const src: byte_Array1d; srcOffset: int; const dst: byte_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(byte));
end;
procedure arraycopy(const src: short_Array1d; srcOffset: int; const dst: short_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(short));
end;
procedure arraycopy(const src: int_Array1d; srcOffset: int; const dst: int_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(int));
end;
procedure arraycopy(const src: long_Array1d; srcOffset: int; const dst: long_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(long));
end;
procedure arraycopy(const src: AnsiString_Array1d; srcOffset: int; const dst: AnsiString_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: UnicodeString_Array1d; srcOffset: int; const dst: UnicodeString_Array1d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: boolean_Array2d; srcOffset: int; const dst: boolean_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: wchar_Array2d; srcOffset: int; const dst: wchar_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: float_Array2d; srcOffset: int; const dst: float_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: double_Array2d; srcOffset: int; const dst: double_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: real_Array2d; srcOffset: int; const dst: real_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: byte_Array2d; srcOffset: int; const dst: byte_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: short_Array2d; srcOffset: int; const dst: short_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: int_Array2d; srcOffset: int; const dst: int_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: long_Array2d; srcOffset: int; const dst: long_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: AnsiString_Array2d; srcOffset: int; const dst: AnsiString_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
procedure arraycopy(const src: UnicodeString_Array2d; srcOffset: int; const dst: UnicodeString_Array2d; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
if (src = dst) and (srcOffset < dstOffset) then begin
for i := length - 1 downto 0 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end else begin
for i := 0 to length - 1 do begin
dst[dstOffset + i] := src[srcOffset + i];
end;
end;
end;
{%endregion}
{%region _Object }
class function _Object.asClass(): _Class;
begin
result := ClassData.create(classType());
end;
constructor _Object.create();
begin
inherited create();
end;
destructor _Object.destroy;
begin
inherited destroy;
end;
procedure _Object.afterConstruction();
begin
end;
procedure _Object.beforeDestruction();
begin
end;
procedure _Object.free();
begin
if self <> nil then begin
destroy;
end;
end;
function _Object.queryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: GUID; out obj): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
if getInterface(iid, obj) then begin
result := S_OK;
end else begin
result := E_NOINTERFACE;
end;
end;
function _Object._addref(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
result := -1;
end;
function _Object._release(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
result := -1;
end;
function _Object.getInterface(const iid: GUID; out obj): boolean;
begin
result := inherited getInterface(iid, obj);
end;
function _Object.getInterfaceWeak(const iid: GUID; out obj): boolean;
begin
result := inherited getInterfaceWeak(iid, obj);
end;
function _Object.getClass(): _Class;
begin
result := ClassData.create(classType());
end;
function _Object.asObject(): TObject;
begin
result := self;
end;
{%endregion}
{%region RefCountInterfacedObject }
class function RefCountInterfacedObject.newInstance(): TObject;
begin
result := inherited newInstance();
if result <> nil then begin
RefCountInterfacedObject(result).refcount := 1;
end;
end;
constructor RefCountInterfacedObject.create();
begin
inherited create();
end;
procedure RefCountInterfacedObject.afterConstruction(); assembler;
asm
lock dec dword[eax+offset refcount]
end;
procedure RefCountInterfacedObject.beforeDestruction();
begin
if refcount <> 0 then begin
raise RuntimeException.create('Error 204 (refcount != 0)');
end;
end;
function RefCountInterfacedObject._addref(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
result := interlockedIncrement(@refcount);
end;
function RefCountInterfacedObject._release(): int; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
result := interlockedDecrement(@refcount);
if result = 0 then begin
destroy;
end;
end;
{%endregion}
{%region ClassData }
constructor ClassData.create(clsptr: TClass);
begin
inherited create();
self.clsptr := clsptr;
end;
function ClassData.isInheritedFrom(cls: _Class): boolean;
begin
if cls <> nil then begin
result := clsptr.inheritsFrom(cls.getClassType());
end else begin
result := false;
end;
end;
function ClassData.isInstance(obj: TObject): boolean;
begin
result := (obj <> nil) and (obj.classType().inheritsFrom(clsptr));
end;
function ClassData.getInstanceSize(): int;
begin
result := int(clsptr.instanceSize());
end;
function ClassData.getSuperclass(): _Class;
begin
result := ClassData.create(clsptr.classParent());
end;
function ClassData.getName(): AnsiString;
begin
result := clsptr.unitName() + '.' + clsptr.className();
end;
function ClassData.getSimpleName(): AnsiString;
begin
result := clsptr.className();
end;
function ClassData.getClassType(): TClass;
begin
result := clsptr;
end;
{%endregion}
{%region Thread }
constructor Thread.create(target: Runnable; const name: AnsiString; freeOnTerminate: boolean);
begin
inherited create();
self.freeOnTerminate := freeOnTerminate;
if target = nil then begin
self.target := self;
end else begin
self.target := target;
end;
self.name := name;
self.inst := RunnableThread.create(self);
end;
procedure Thread.run();
begin
end;
procedure Thread.start();
var
t: TThread;
begin
t := inst;
if t <> nil then begin
t.start();
end;
end;
function Thread.getName(): AnsiString;
begin
result := name;
end;
{%endregion}
{%region ThreadLock }
constructor ThreadLock.create();
begin
inherited create();
Windows.initializeCriticalSection(@lock);
end;
destructor ThreadLock.destroy;
begin
Windows.deleteCriticalSection(@lock);
inherited destroy;
end;
procedure ThreadLock.enter();
begin
Windows.enterCriticalSection(@lock);
end;
procedure ThreadLock.leave();
begin
Windows.leaveCriticalSection(@lock);
end;
{%endregion}
{%region Exception }
constructor Exception.create();
begin
inherited create();
end;
constructor Exception.create(const message: AnsiString);
begin
inherited create();
self.fmessage := message;
end;
function Exception.getMessage(): AnsiString;
begin
result := fmessage;
end;
{%endregion}
{%region RuntimeException }
constructor RuntimeException.create();
begin
inherited create();
end;
constructor RuntimeException.create(const message: AnsiString);
begin
inherited create(message);
end;
{%endregion}
{%region NullPointerException }
constructor NullPointerException.create();
begin
inherited create();
end;
constructor NullPointerException.create(const message: AnsiString);
begin
inherited create(message);
end;
{%endregion}
{%region IndexOutOfBoundsException }
constructor IndexOutOfBoundsException.create();
begin
inherited create();
end;
constructor IndexOutOfBoundsException.create(const message: AnsiString);
begin
inherited create(message);
end;
constructor IndexOutOfBoundsException.create(index: int);
begin
inherited create('Индекс выходит из диапазона: ' + toDecString(index) + '.');
end;
{%endregion}
{%region ArrayIndexOutOfBoundsException }
constructor ArrayIndexOutOfBoundsException.create();
begin
inherited create();
end;
constructor ArrayIndexOutOfBoundsException.create(const message: AnsiString);
begin
inherited create(message);
end;
constructor ArrayIndexOutOfBoundsException.create(index: int);
begin
inherited create('индекс элемента массива выходит из диапазона: ' + toDecString(index) + '.');
end;
{%endregion}
{%region IllegalArgumentException }
constructor IllegalArgumentException.create();
begin
inherited create();
end;
constructor IllegalArgumentException.create(const message: AnsiString);
begin
inherited create(message);
end;
{%endregion}
{%region RunnableThread }
constructor RunnableThread.create(owner: Thread);
begin
inherited create(true, defaultStackSize);
self.freeOnTerminate := true;
self.owner := owner;
end;
procedure RunnableThread.execute();
var
owner: Thread;
begin
owner := self.owner;
try
owner.target.run();
except
end;
Pointer(owner.target) := nil;
owner.inst := nil;
if owner.freeOnTerminate then begin
owner.free();
end;
end;
{%endregion}
initialization {%region}
configureFPU();
{%endregion}
end.
