{
Lang – основной модуль для разработки программ и библиотек.
Только 32-битные платформы на основе IA-32.
Для работы требуется наличие расширений FPU, MMX, SSE, SSE2, SSE3.
Наличие SSSE3 опционально.
Copyright © 2017 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Меньшей Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Меньшей Стандартной
общественной лицензии GNU.
Вы должны были получить копию Меньшей Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit Lang;
{$MODE OBJFPC}
interface
uses
SysConst, SysUtils, Classes;
{$ASMMODE INTEL,CALLING REGISTER,INLINE ON,GOTO ON}
{$H+,I-,J-,M-,Q-,R-,T-}
{DEFINE SSSE3}
const
MAX_RADIX = 36;
MIN_RADIX = 2;
MAX_STRUCTURE_SIZE = longint($00100000);
MIN_INT = longint($80000000);
MAX_INT = longint($7fffffff);
MIN_LONG = int64($8000000000000000);
MAX_LONG = int64($7fffffffffffffff);
LINE_ENDING =
{$IF DEFINED(GO32V2) OR DEFINED(WINDOWS)}
#$0d#$0a
{$ELSEIF DEFINED(UNIX)}
#$0a
{$ELSE}
#$0d
{$ENDIF};
DIRECTORY_SEPARATOR =
{$IF DEFINED(GO32V2) OR DEFINED(WINDOWS)}
'\'
{$ELSE}
'/'
{$ENDIF};
DIGITS = '0123456789abcdefghijklmnopqrstuvwxyz';
type
_Interface = interface;
Runnable = interface;
_Class = interface;
_Object = class;
RefCountInterfacedObject = class;
FPU = class;
SSE = class;
Math = class;
RealValueRepresenter = class;
Thread = class;
Exception = class;
RuntimeException = class;
IllegalStateException = class;
IllegalArgumentException = class;
NumberFormatException = class;
IndexOutOfBoundsException = class;
ArrayIndexOutOfBoundsException = class;
NegativeArraySizeException = class;
NullPointerException = class;
UnsupportedOperationException = class;
{$M+}
boolean = System.Boolean;
char = System.Char;
uchar = System.WideChar;
byte = System.ShortInt;
short = System.SmallInt;
int = System.LongInt;
long = packed record
case int of
0: (bytes: array [$0..$7] of byte);
1: (shorts: array [$0..$3] of short);
2: (ints: array [$0..$1] of int);
3: (native: int64);
end;
ultra = packed record
case int of
0: (bytes: array [$0..$f] of byte);
1: (shorts: array [$0..$7] of short);
2: (ints: array [$0..$3] of int);
3: (longs: array [$0..$1] of long);
end;
float = System.Single;
double = System.Double;
real = System.Extended;
xvector = packed record
floats: array [$0..$3] of float;
end;
boolean_Array1d = packed array of boolean;
char_Array1d = packed array of char;
uchar_Array1d = packed array of uchar;
byte_Array1d = packed array of byte;
short_Array1d = packed array of short;
int_Array1d = packed array of int;
long_Array1d = packed array of long;
ultra_Array1d = packed array of ultra;
float_Array1d = packed array of float;
double_Array1d = packed array of double;
real_Array1d = packed array of real;
xvector_Array1d = packed array of xvector;
Object_Array1d = packed array of TObject;
Interface_Array1d = packed array of IUnknown;
Class_Array1d = packed array of _Class;
String_Array1d = packed array of AnsiString;
UnicodeString_Array1d = packed array of UnicodeString;
boolean_Array2d = packed array of boolean_Array1d;
char_Array2d = packed array of char_Array1d;
uchar_Array2d = packed array of uchar_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;
ultra_Array2d = packed array of ultra_Array1d;
float_Array2d = packed array of float_Array1d;
double_Array2d = packed array of double_Array1d;
real_Array2d = packed array of real_Array1d;
xvector_Array2d = packed array of xvector_Array1d;
Object_Array2d = packed array of Object_Array1d;
Interface_Array2d = packed array of Interface_Array1d;
Class_Array2d = packed array of Class_Array1d;
String_Array2d = packed array of String_Array1d;
UnicodeString_Array2d = packed array of UnicodeString_Array1d;
byte_ArraySimpleContent = packed array [0..MAX_STRUCTURE_SIZE div sizeof(byte) - 1] of byte;
short_ArraySimpleContent = packed array [0..MAX_STRUCTURE_SIZE div sizeof(short) - 1] of short;
int_ArraySimpleContent = packed array [0..MAX_STRUCTURE_SIZE div sizeof(int) - 1] of int;
byte_ArraySimple = ^byte_ArraySimpleContent;
short_ArraySimple = ^short_ArraySimpleContent;
int_ArraySimple = ^int_ArraySimpleContent;
TObjectExtended = class helper for TObject
public
function getClass(): _Class;
end;
_Interface = interface(IUnknown) ['{F5377D1E-7AF2-4BBA-822E-778B4F7D652F}']
procedure dispatch(var message);
procedure dispatchStr(var message);
procedure defaultHandler(var message);
procedure defaultHandlerStr(var message);
function fieldAddress(const name: ShortString): Pointer;
function safeCallException(exceptObject: TObject; exceptAddr: Pointer): HResult;
function equals(obj: TObject): boolean;
function getHashCode(): int;
function toString(): AnsiString;
end;
Runnable = interface(_Interface) ['{5BF760E3-0DD8-49EE-AEB9-F3A7978E21CD}']
procedure run();
end;
_Class = interface(_Interface) ['{F5377D1E-7AF2-4BBA-822E-778B4F7D6530}']
function isInterface(): boolean;
function isInstance(const ref: TObject): boolean; overload;
function isInstance(const ref: _Interface): boolean; overload;
function isInterfaceImplements(const intf: _Class): boolean;
function isInheritedFrom(const cls: _Class): boolean;
function isAssignableFrom(const cls: _Class): boolean;
function getInterfaces(): Class_Array1d;
function getSuperclass(): _Class;
function getUnitName(): AnsiString;
function getSimpleName(): AnsiString;
function getCanonicalName(): AnsiString;
end;
_Object = class(TObject, IUnknown, _Interface)
public
constructor create();
destructor destroy; override;
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function queryInterface(
{$IFDEF FPC_HAS_CONSTREF} constref {$ELSE} const {$ENDIF} iid: TGuid;
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;
end;
RefCountInterfacedObject = class(_Object)
public
class function newInstance(): TObject; override;
public
constructor create();
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
function _addref(): int; {$IFNDEF WINDOWS} cdecl {$ELSE} stdcall {$ENDIF}; override;
function _release(): int; {$IFNDEF WINDOWS} cdecl {$ELSE} stdcall {$ENDIF}; override;
strict private
refcount: int;
end;
FPU = class(_Object)
public
type Environment = packed record
fctrl: int;
fstat: int;
ftags: int;
fiofs: int;
fiseg: short;
fopcode: short;
foofs: int;
foseg: short;
reserved: short;
end;
const ROUND_TO_NEAREST = $0000;
const ROUND_DOWN = $0400;
const ROUND_UP = $0800;
const ROUND_TOWARD_ZERO = $0c00;
const PRECISION = $0020;
const UNDERFLOW = $0010;
const OVERFLOW = $0008;
const ZERO_DIVIDE = $0004;
const DENORMAL = $0002;
const INVALID = $0001;
class procedure configure();
class procedure getEnvironment(out env: Environment);
class procedure setEnvironment(const env: Environment);
class procedure setExceptionMask(exceptionMask: int);
class procedure setRoundMode(roundMode: int);
class function isSupported(): boolean;
class function getExceptionMask(): int;
class function getRoundMode(): int;
private
class procedure clinit();
end;
SSE = class(_Object)
public
const FLUSH_TO_ZERO = $8000;
const ROUND_TO_NEAREST = $0000;
const ROUND_DOWN = $2000;
const ROUND_UP = $4000;
const ROUND_TOWARD_ZERO = $6000;
const PRECISION = $1000;
const UNDERFLOW = $0800;
const OVERFLOW = $0400;
const ZERO_DIVIDE = $0200;
const DENORMAL = $0100;
const INVALID = $0080;
const DENORMALS_ARE_ZEROS = $0040;
class procedure configure();
class procedure setEnvironment(mxcsr: int);
class procedure setExceptionMask(exceptionMask: int);
class procedure setRoundMode(roundMode: int);
class function isSupported(): boolean;
class function getEnvironment(): int;
class function getExceptionMask(): int;
class function getRoundMode(): int;
private
class procedure clinit();
end;
Math = class(_Object)
public
const NAN = real(0.000 / 0.000);
const INF = real(1.000 / 0.000);
const POS_INF = real(1.000 / 0.000);
const NEG_INF = real(-1.000 / 0.000);
const PI = real(3.141592653589793238462);
const E = real(2.718281828459045235360);
class function abs(x: int): int; overload;
class function abs(x: long): long; overload;
class function abs(x: real): real; overload;
class function min(x, y: int): int; overload;
class function min(x, y: long): long; overload;
class function min(x, y: real): real; overload;
class function max(x, y: int): int; overload;
class function max(x, y: long): long; overload;
class function max(x, y: real): real; overload;
class function intPart(x: real): real;
class function fracPart(x: real): real;
class function floor(x: real): real;
class function ceil(x: real): real;
class function sqrt(x: real): real;
class function pow2(x: real): real;
class function log2(x: real): real;
class function sin(x: real): real;
class function cos(x: real): real;
class function tan(x: real): real;
class function arctan(y, x: real): real;
class function toDegrees(angrad: real): real;
class function toRadians(angdeg: real): real;
class function round(x: real): long;
end;
RealValueRepresenter = class(_Object)
public
const MIN_SIGNIFICAND_DIGITS = 6;
const MAX_SIGNIFICAND_DIGITS = 18;
const FLOAT_SIGNIFICAND_DIGITS = 7;
const DOUBLE_SIGNIFICAND_DIGITS = 15;
const REAL_SIGNIFICAND_DIGITS = 18;
const MIN_ORDER_DIGITS = 2;
const MAX_ORDER_DIGITS = 4;
const FLOAT_ORDER_DIGITS = 2;
const DOUBLE_ORDER_DIGITS = 3;
const REAL_ORDER_DIGITS = 4;
class function pow10(value: real; pow: int): real;
private
class var INSTANCE: RealValueRepresenter;
class procedure clinit();
class procedure cldone();
strict private
class function tab_04_00(pow: int): real;
class function tab_08_05(pow: int): real;
class function tab_12_09(pow: int): real;
public
constructor create(significandDigits, orderDigits: int);
function toString(value: real): AnsiString; overload; virtual;
strict private
limitValueWithFractialPart: real;
limitValueWithoutExponent: real;
orderDigits: int;
significandDigits: int;
minRepresentValue: long;
maxRepresentValue: long;
end;
Thread = class(TThread, IUnknown, _Interface, Runnable)
strict private
class var THREAD_NUM: int;
class function nextThreadNum(): int;
public
constructor create(); overload;
constructor create(const name: String); overload;
constructor create(const target: Runnable); overload;
constructor create(const target: Runnable; const name: String); overload;
function toString(): AnsiString; override;
function queryInterface(
{$IFDEF FPC_HAS_CONSTREF} constref {$ELSE} const {$ENDIF} iid: TGuid;
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;
procedure run(); virtual;
function getName(): String;
protected
procedure execute(); override; final;
strict private
target: Pointer;
name: String;
end;
{$M-}
Exception = class(SysUtils.Exception)
public
constructor create(const amessage: String);
constructor createHelp(const amessage: String; ahelpContext: int);
function toString(): AnsiString; override;
end;
RuntimeException = class(Exception);
IllegalStateException = class(RuntimeException);
IllegalArgumentException = class(RuntimeException);
NumberFormatException = class(IllegalArgumentException);
IndexOutOfBoundsException = class(RuntimeException);
ArrayIndexOutOfBoundsException = class(IndexOutOfBoundsException);
NegativeArraySizeException = class(RuntimeException);
NullPointerException = class(RuntimeException);
UnsupportedOperationException = class(RuntimeException);
resourcestring
msgIllegalArgument = 'Недопустимое значение параметра ';
msgIndexOutOfBounds = 'Индекс выходит из диапазона.';
msgArrayIndexOutOfBounds = 'Индекс массива выходит из диапазона.';
msgNegativeArraySize = 'Длина массива не может быть отрицательной.';
msgNullPointer = 'Нулевой указатель не может быть разыменован.';
msgInvalidRadix = 'Недопустимое основание системы счисления.';
msgUnsupportedOperation = 'Операция не поддерживается.';
msgThread = 'Поток';
function byteToBinString(value: int): String;
function byteToHexString(value: int): String;
function shortByteSwap(value: int): int;
function shortToBinString(value: int): String;
function shortToHexString(value: int): String;
function intByteSwap(value: int): int;
function intUDiv(dividend, divisor: int): int;
function intUMod(dividend, divisor: int): int;
function intSar(multiplier: int; bits: int): int;
function intZeroExtend(value: int): long; inline;
function intBitsToFloat(value: int): float; inline;
function intToReal(value: int): real;
function intToString(value: int): String; overload;
function intToString(value: int; radix: int): String; overload;
function intToBinString(value: int): String;
function intToHexString(value: int): String;
function longBuild(short3, short2, short1, short0: int): long; overload; inline;
function longBuild(hi, lo: int): long; overload; inline;
function longByteSwap(const value: long): long;
function longEquals(const relationship1, relationship2: long): boolean;
function longGreate(const relationship1, relationship2: long): boolean;
function longCmp(const relationship1, relationship2: long): int;
function longAdd(const addendum1, addendum2: long): long;
function longSub(const addendum1, addendum2: long): long;
function longMul(const multiplier1, multiplier2: long): long;
function longDiv(const dividend, divisor: long): long;
function longMod(const dividend, divisor: long): long;
function longUDiv(const dividend, divisor: long): long;
function longUMod(const dividend, divisor: long): long;
function longNeg(const value: long): long;
function longOr(const addendum1, addendum2: long): long;
function longXor(const addendum1, addendum2: long): long;
function longAnd(const multiplier1, multiplier2: long): long;
function longSar(const multiplier: long; bits: int): long;
function longShr(const multiplier: long; bits: int): long;
function longShl(const multiplier: long; bits: int): long;
function longNot(const value: long): long;
function longBitsToDouble(const value: long): double; inline;
function longToReal(const value: long): real;
function longToString(const value: long): String; overload;
function longToString(const value: long; radix: int): String; overload;
function longToBinString(const value: long): String;
function longToHexString(const value: long): String;
function mmxPack(const value: long): int;
function mmxUnpackLo(value: int): long;
function mmxUnpackHi(value: int): long;
function mmxEquals(const relationship1, relationship2: long): long;
function mmxGreate(const relationship1, relationship2: long): long;
function mmxAdd(const addendum1, addendum2: long): long;
function mmxAddS(const addendum1, addendum2: long): long;
function mmxAddUS(const addendum1, addendum2: long): long;
function mmxSub(const addendum1, addendum2: long): long;
function mmxSubS(const addendum1, addendum2: long): long;
function mmxSubUS(const addendum1, addendum2: long): long;
function mmxMulLo(const multiplier1, multiplier2: long): long;
function mmxMulHi(const multiplier1, multiplier2: long): long;
function mmxMulHiS(const multiplier1, multiplier2: long): long;
function mmxSar(const multiplier: long; bits: int): long;
function mmxShr(const multiplier: long; bits: int): long;
function mmxShl(const multiplier: long; bits: int): long;
function ultraBuild(short7, short6, short5, short4, short3, short2, short1, short0: int): ultra;
overload; inline;
function ultraBuild(int3, int2, int1, int0: int): ultra; overload; inline;
function ultraBuild(const hi, lo: long): ultra; overload; inline;
function ultraByteSwap(const value: ultra): ultra;
function ultraEquals(const relationship1, relationship2: ultra): boolean;
function ultraOr(const addendum1, addendum2: ultra): ultra;
function ultraXor(const addendum1, addendum2: ultra): ultra;
function ultraAnd(const multiplier1, multiplier2: ultra): ultra;
function ultraNot(const value: ultra): ultra;
function ssesPack(const value: ultra): long;
function ssesUnpackLo(const value: long): ultra;
function ssesUnpackHi(const value: long): ultra;
function ssesEquals(const relationship1, relationship2: ultra): ultra;
function ssesGreate(const relationship1, relationship2: ultra): ultra;
function ssesAdd(const addendum1, addendum2: ultra): ultra;
function ssesAddS(const addendum1, addendum2: ultra): ultra;
function ssesAddUS(const addendum1, addendum2: ultra): ultra;
function ssesSub(const addendum1, addendum2: ultra): ultra;
function ssesSubS(const addendum1, addendum2: ultra): ultra;
function ssesSubUS(const addendum1, addendum2: ultra): ultra;
function ssesMulLo(const multiplier1, multiplier2: ultra): ultra;
function ssesMulHi(const multiplier1, multiplier2: ultra): ultra;
function ssesMulHiS(const multiplier1, multiplier2: ultra): ultra;
function ssesSar(const multiplier: ultra; bits: int): ultra;
function ssesShr(const multiplier: ultra; bits: int): ultra;
function ssesShl(const multiplier: ultra; bits: int): ultra;
function sseiPack(const value: ultra): long;
function sseiUnpackLo(const value: long): ultra;
function sseiUnpackHi(const value: long): ultra;
function sseiEquals(const relationship1, relationship2: ultra): ultra;
function sseiGreate(const relationship1, relationship2: ultra): ultra;
function sseiAdd(const addendum1, addendum2: ultra): ultra;
function sseiSub(const addendum1, addendum2: ultra): ultra;
function sseiMulLo(const multiplier1, multiplier2: ultra): ultra;
function sseiMulHi(const multiplier1, multiplier2: ultra): ultra;
function sseiSar(const multiplier: ultra; bits: int): ultra;
function sseiShr(const multiplier: ultra; bits: int): ultra;
function sseiShl(const multiplier: ultra; bits: int): ultra;
function floatToIntBits(value: float): int; inline;
function doubleToLongBits(value: double): long; inline;
function realBuild(exponent: int; significand: long): real; inline;
function realExtractSignificand(value: real): long; inline;
function realExtractExponent(value: real): int; inline;
function realIsNaN(value: real): boolean; inline;
function realIsInfinity(value: real): boolean;
function realCmpl(relationship1, relationship2: real): int;
function realCmpg(relationship1, relationship2: real): int;
function realMod(dividend, divisor: real): real;
function realToInt(value: real): int;
function realToLong(value: real): long;
function realToFloat(value: real): float;
function realToDouble(value: real): double;
function realToString(value: real): String;
function xvectorBuild(float3, float2, float1, float0: float): xvector; inline;
function xvectorEquals(const relationship1, relationship2: xvector): boolean;
function ssefConvertToVector(const value: ultra): xvector;
function ssefConvertToUltra(const value: xvector): ultra;
function ssefCmpl(const relationship1, relationship2: xvector): ultra;
function ssefCmpg(const relationship1, relationship2: xvector): ultra;
function ssefCmpe(const relationship1, relationship2: xvector): ultra;
function ssefCmpge(const relationship1, relationship2: xvector): ultra;
function ssefCmple(const relationship1, relationship2: xvector): ultra;
function ssefCmpne(const relationship1, relationship2: xvector): ultra;
function ssefAdd(const addendum1, addendum2: xvector): xvector;
function ssefSub(const addendum1, addendum2: xvector): xvector;
function ssefMul(const multiplier1, multiplier2: xvector): xvector;
function ssefDiv(const dividend, divisor: xvector): xvector;
function ssefMin(const value1, value2: xvector): xvector;
function ssefMax(const value1, value2: xvector): xvector;
function ssefReciproc(const value: xvector): xvector;
function ssefReciSqrt(const value: xvector): xvector;
function ssefSqrt(const value: xvector): xvector;
function stringToUTF8(const s: UnicodeString): String;
function stringToUTF16(const s: String): UnicodeString;
function stringToCharArray(const s: String): char_Array1d; overload;
function stringToCharArray(const s: UnicodeString): uchar_Array1d; overload;
function stringToUpperCase(const s: String): String; overload;
function stringToUpperCase(const s: UnicodeString): UnicodeString; overload;
function stringToLowerCase(const s: String): String; overload;
function stringToLowerCase(const s: UnicodeString): UnicodeString; overload;
function stringToCharCodes(const s: String): int_Array1d; overload;
function stringToCharCodes(const s: UnicodeString): int_Array1d; overload;
function stringToByteArray(const s: String): byte_Array1d;
function stringToShortArray(const s: UnicodeString): short_Array1d;
function stringStartsWith(const prefix, s: String; position: int): boolean; overload;
function stringStartsWith(const prefix, s: UnicodeString; position: int): boolean; overload;
function stringStartsWith(const prefix, s: String): boolean; overload;
function stringStartsWith(const prefix, s: UnicodeString): boolean; overload;
function stringEndsWith(const suffix, s: String): boolean; overload;
function stringEndsWith(const suffix, s: UnicodeString): boolean; overload;
function stringTrim(const s: String): String; overload;
function stringTrim(const s: UnicodeString): UnicodeString; overload;
function stringCopy(const s: String): String; overload;
function stringCopy(const s: UnicodeString): UnicodeString; overload;
function stringGetHashCode(const s: String): int; overload;
function stringGetHashCode(const s: UnicodeString): int; overload;
function stringParseInt(const s: String): int; overload;
function stringParseInt(const s: String; radix: int): int; overload;
function stringParseInt(const s: String; radix: int; default: int): int; overload;
function stringParseLong(const s: String): long; overload;
function stringParseLong(const s: String; radix: int): long; overload;
function stringParseLong(const s: String; radix: int; default: long): long; overload;
function stringParseReal(const s: String): real; overload;
function stringParseReal(const s: String; default: real): real; overload;
function stringParseCommandLine(): UnicodeString_Array1d;
operator :=(const value: long): byte; inline;
operator :=(const value: long): short; inline;
operator :=(const value: long): int; inline;
operator :=(const value: long): int64; inline;
operator :=(const value: long): float; inline;
operator :=(const value: long): double; inline;
operator :=(const value: long): real; inline;
operator :=(const value: int64): long; inline;
operator =(const relationship1, relationship2: long): boolean; inline;
operator <(const relationship1, relationship2: long): boolean; inline;
operator >(const relationship1, relationship2: long): boolean; inline;
operator <=(const relationship1, relationship2: long): boolean; inline;
operator >=(const relationship1, relationship2: long): boolean; inline;
operator <>(const relationship1, relationship2: long): boolean; inline;
operator +(const addendum1, addendum2: long): long; inline;
operator -(const addendum1, addendum2: long): long; inline;
operator *(const multiplier1, multiplier2: long): long; inline;
operator /(const multiplier1, multiplier2: long): real; inline;
operator +(const value: long): long; inline;
operator -(const value: long): long; inline;
operator or(const addendum1, addendum2: long): long; inline;
operator xor(const addendum1, addendum2: long): long; inline;
operator and(const multiplier1, multiplier2: long): long; inline;
operator shr(const multiplier: long; bits: int): long; inline;
operator shl(const multiplier: long; bits: int): long; inline;
operator div(const dividend, divisor: long): long; inline;
operator mod(const dividend, divisor: long): long; inline;
operator not(const value: long): long; inline;
operator inc(const value: long): long; inline;
operator inc(const delta, value: long): long; inline;
operator dec(const value: long): long; inline;
operator dec(const delta, value: long): long; inline;
operator :=(const value: ultra): byte; inline;
operator :=(const value: ultra): short; inline;
operator :=(const value: ultra): int; inline;
operator :=(const value: ultra): int64; inline;
operator :=(const value: ultra): long; inline;
operator :=(const value: int64): ultra; inline;
operator :=(const value: long): ultra; inline;
operator =(const relationship1, relationship2: ultra): boolean; inline;
operator <>(const relationship1, relationship2: ultra): boolean; inline;
operator or(const addendum1, addendum2: ultra): ultra; inline;
operator xor(const addendum1, addendum2: ultra): ultra; inline;
operator and(const multiplier1, multiplier2: ultra): ultra; inline;
operator not(const value: ultra): ultra; inline;
operator :=(const value: xvector): real; inline;
operator :=(const value: xvector): ultra; inline;
operator :=(const value: byte): xvector; inline;
operator :=(const value: short): xvector; inline;
operator :=(const value: int): xvector; inline;
operator :=(const value: int64): xvector; inline;
operator :=(const value: long): xvector; inline;
operator :=(const value: float): xvector; inline;
operator :=(const value: double): xvector; inline;
operator :=(const value: real): xvector; inline;
operator :=(const value: ultra): xvector; inline;
operator =(const relationship1, relationship2: xvector): boolean; inline;
operator <>(const relationship1, relationship2: xvector): boolean; inline;
operator :=(const intf: TGuid): _Interface; inline;
operator :=(const intf: TGuid): _Class; inline;
operator :=(const cls: TClass): _Interface; inline;
operator :=(const cls: TClass): _Class; inline;
function boolean_Array1d_create(length: int): boolean_Array1d; overload;
function char_Array1d_create(length: int): char_Array1d; overload;
function uchar_Array1d_create(length: int): uchar_Array1d; overload;
function byte_Array1d_create(length: int): byte_Array1d; overload;
function short_Array1d_create(length: int): short_Array1d; overload;
function int_Array1d_create(length: int): int_Array1d; overload;
function long_Array1d_create(length: int): long_Array1d; overload;
function ultra_Array1d_create(length: int): ultra_Array1d; overload;
function float_Array1d_create(length: int): float_Array1d; overload;
function double_Array1d_create(length: int): double_Array1d; overload;
function real_Array1d_create(length: int): real_Array1d; overload;
function xvector_Array1d_create(length: int): xvector_Array1d; overload;
function Object_Array1d_create(length: int): Object_Array1d; overload;
function Interface_Array1d_create(length: int): Interface_Array1d; overload;
function String_Array1d_create(length: int): String_Array1d; overload;
function UnicodeString_Array1d_create(length: int): UnicodeString_Array1d; overload;
function boolean_Array2d_create(length: int): boolean_Array2d; overload;
function char_Array2d_create(length: int): char_Array2d; overload;
function uchar_Array2d_create(length: int): uchar_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 ultra_Array2d_create(length: int): ultra_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 xvector_Array2d_create(length: int): xvector_Array2d; overload;
function Object_Array2d_create(length: int): Object_Array2d; overload;
function Interface_Array2d_create(length: int): Interface_Array2d; overload;
function String_Array2d_create(length: int): String_Array2d; overload;
function UnicodeString_Array2d_create(length: int): UnicodeString_Array2d; overload;
function boolean_Array2d_create(length1, length2: int): boolean_Array2d; overload;
function char_Array2d_create(length1, length2: int): char_Array2d; overload;
function uchar_Array2d_create(length1, length2: int): uchar_Array2d; overload;
function byte_Array2d_create(length1, length2: int): byte_Array2d; overload;
function short_Array2d_create(length1, length2: int): short_Array2d; overload;
function int_Array2d_create(length1, length2: int): int_Array2d; overload;
function long_Array2d_create(length1, length2: int): long_Array2d; overload;
function ultra_Array2d_create(length1, length2: int): ultra_Array2d; overload;
function float_Array2d_create(length1, length2: int): float_Array2d; overload;
function double_Array2d_create(length1, length2: int): double_Array2d; overload;
function real_Array2d_create(length1, length2: int): real_Array2d; overload;
function xvector_Array2d_create(length1, length2: int): xvector_Array2d; overload;
function Object_Array2d_create(length1, length2: int): Object_Array2d; overload;
function Interface_Array2d_create(length1, length2: int): Interface_Array2d; overload;
function String_Array2d_create(length1, length2: int): String_Array2d; overload;
function UnicodeString_Array2d_create(length1, length2: int): UnicodeString_Array2d; overload;
function boolean_Array1d_create(const elements: array of boolean): boolean_Array1d; overload;
function char_Array1d_create(const elements: array of char): char_Array1d; overload;
function uchar_Array1d_create(const elements: array of uchar): uchar_Array1d; overload;
function byte_Array1d_create(const elements: array of byte): byte_Array1d; overload;
function short_Array1d_create(const elements: array of short): short_Array1d; overload;
function int_Array1d_create(const elements: array of int): int_Array1d; overload;
function long_Array1d_create(const elements: array of long): long_Array1d; overload;
function ultra_Array1d_create(const elements: array of ultra): ultra_Array1d; overload;
function float_Array1d_create(const elements: array of float): float_Array1d; overload;
function double_Array1d_create(const elements: array of double): double_Array1d; overload;
function real_Array1d_create(const elements: array of real): real_Array1d; overload;
function xvector_Array1d_create(const elements: array of xvector): xvector_Array1d; overload;
function Object_Array1d_create(const elements: array of TObject): Object_Array1d; overload;
function Interface_Array1d_create(const elements: array of IUnknown): Interface_Array1d; overload;
function String_Array1d_create(const elements: array of String): String_Array1d; overload;
function UnicodeString_Array1d_create(
const elements: array of UnicodeString): UnicodeString_Array1d; overload;
function boolean_Array2d_create(
const elements: array of boolean_Array1d): boolean_Array2d; overload;
function char_Array2d_create(const elements: array of char_Array1d): char_Array2d; overload;
function uchar_Array2d_create(const elements: array of uchar_Array1d): uchar_Array2d; overload;
function byte_Array2d_create(const elements: array of byte_Array1d): byte_Array2d; overload;
function short_Array2d_create(const elements: array of short_Array1d): short_Array2d; overload;
function int_Array2d_create(const elements: array of int_Array1d): int_Array2d; overload;
function long_Array2d_create(const elements: array of long_Array1d): long_Array2d; overload;
function ultra_Array2d_create(const elements: array of ultra_Array1d): ultra_Array2d; overload;
function float_Array2d_create(const elements: array of float_Array1d): float_Array2d; overload;
function double_Array2d_create(const elements: array of double_Array1d): double_Array2d; overload;
function real_Array2d_create(const elements: array of real_Array1d): real_Array2d; overload;
function xvector_Array2d_create(
const elements: array of xvector_Array1d): xvector_Array2d; overload;
function Object_Array2d_create(const elements: array of Object_Array1d): Object_Array2d; overload;
function Interface_Array2d_create(
const elements: array of Interface_Array1d): Interface_Array2d; overload;
function String_Array2d_create(const elements: array of String_Array1d): String_Array2d; overload;
function UnicodeString_Array2d_create(
const elements: array of UnicodeString_Array1d): UnicodeString_Array2d; overload;
function String_build(const charCodes: int_Array1d): String;
function String_create(length: int): String; overload;
function String_create(const src: char_Array1d; offset, length: int): String; overload;
function String_create(const src: byte_Array1d; offset, length: int): String; overload;
function UnicodeString_build(const charCodes: int_Array1d): UnicodeString;
function UnicodeString_create(length: int): UnicodeString; overload;
function UnicodeString_create(const src: uchar_Array1d;
offset, length: int): UnicodeString; overload;
function UnicodeString_create(const src: short_Array1d;
offset, length: int): UnicodeString; overload;
procedure arraycopyPrimitives(const src: boolean_Array1d; srcOffset: int;
const dst: boolean_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: char_Array1d; srcOffset: int;
const dst: char_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: uchar_Array1d; srcOffset: int;
const dst: uchar_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: byte_Array1d; srcOffset: int;
const dst: byte_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: short_Array1d; srcOffset: int;
const dst: short_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: int_Array1d; srcOffset: int;
const dst: int_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: long_Array1d; srcOffset: int;
const dst: long_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: ultra_Array1d; srcOffset: int;
const dst: ultra_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: float_Array1d; srcOffset: int;
const dst: float_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: double_Array1d; srcOffset: int;
const dst: double_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: real_Array1d; srcOffset: int;
const dst: real_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyPrimitives(const src: xvector_Array1d; srcOffset: int;
const dst: xvector_Array1d; dstOffset: int; length: int); overload;
procedure arraycopyStrings(const src: String_Array1d; srcOffset: int;
const dst: String_Array1d; dstOffset: int; length: int);
procedure arraycopyUnicodeStrings(const src: UnicodeString_Array1d; srcOffset: int;
const dst: UnicodeString_Array1d; dstOffset: int; length: int);
procedure arraycopyObjects(const src; srcOffset: int;
const dst; dstOffset: int; length: int);
procedure arraycopyInterfaces(const src; srcOffset: int;
const dst; dstOffset: int; length: int);
procedure arraycopyArrays(const src; srcOffset: int;
const dst; dstOffset: int; length: int);
implementation
{ unit private members }
type
ClassInfoAsObject = class;
IntfInfoAsObject = class;
RealRecord = packed record
case int of
0: (significand: long;
exponent: short);
1: (native: real);
end;
ClassInfoAsObject = class(RefCountInterfacedObject, _Class)
public
constructor create(const info: TClass);
function isInterface(): boolean;
function isInstance(const ref: TObject): boolean; overload;
function isInstance(const ref: _Interface): boolean; overload;
function isInterfaceImplements(const intf: _Class): boolean;
function isInheritedFrom(const cls: _Class): boolean;
function isAssignableFrom(const cls: _Class): boolean;
function getInterfaces(): Class_Array1d;
function getSuperclass(): _Class;
function getUnitName(): AnsiString;
function getSimpleName(): AnsiString;
function getCanonicalName(): AnsiString;
private
info: TClass;
end;
IntfInfoAsObject = class(RefCountInterfacedObject, _Class)
public
constructor create(const info: TGuid);
function isInterface(): boolean;
function isInstance(const ref: TObject): boolean; overload;
function isInstance(const ref: _Interface): boolean; overload;
function isInterfaceImplements(const intf: _Class): boolean;
function isInheritedFrom(const cls: _Class): boolean;
function isAssignableFrom(const cls: _Class): boolean;
function getInterfaces(): Class_Array1d;
function getSuperclass(): _Class;
function getUnitName(): AnsiString;
function getSimpleName(): AnsiString;
function getCanonicalName(): AnsiString;
private
info: TGuid;
end;
const
FPU_DEFAULT_ENVIRONMENT: FPU.Environment = (
fctrl: $033f;
fstat: $0000;
ftags: $ffff;
fiofs: $00000000;
fiseg: $0000;
fopcode: $0000;
foofs: $00000000;
foseg: $0000;
reserved: 0
);
SSE_DEFAULT_ENVIRONMENT = int($1f80);
procedure raiseDivByZero();
begin
raise EDivByZero.create(sDivByZero);
end;
function getDigitRepresentation(digit: int): char;
begin
if (digit >= 0) and (digit < 10) then begin
result := char(digit + int('0'));
end else begin
result := char(digit + (int('a') - $0a));
end;
end;
function getDigit(c: char; radix: int): int;
begin
case c of
'0'..'9': begin
result := int(c) - int('0');
end;
'A'..'Z': begin
result := int(c) - (int('A') - $0a);
end;
'a'..'z': begin
result := int(c) - (int('a') - $0a);
end;
else
result := -1;
end;
if result >= radix then begin
result := -1;
end;
end;
function interlockedIncrement(intField: Pointer): int; assembler; nostackframe;
asm
{ ВХОД: eax – intField }
{ ВЫХОД: eax – результат }
mov edx, eax
mov eax, $01
lock xadd [edx], eax
inc eax
end;
function interlockedDecrement(intField: Pointer): int; assembler; nostackframe;
asm
{ ВХОД: eax – intField }
{ ВЫХОД: eax – результат }
mov edx, eax
mov eax, -$01
lock xadd [edx], eax
dec eax
end;
{ imports }
{$IFDEF WINDOWS}
function getCommandLine(): PWideChar; stdcall;
external 'kernel32' name 'GetCommandLineW';
{$ENDIF}
{ TObjectExtended }
function TObjectExtended.getClass(): _Class;
begin
result := ClassInfoAsObject.create(classType());
end;
{ _Object }
constructor _Object.create();
begin
inherited create();
end;
destructor _Object.destroy;
begin
inherited destroy;
end;
procedure _Object.afterConstruction();
begin
end;
procedure _Object.beforeDestruction();
begin
end;
function _Object.equals(obj: TObject): boolean;
begin
result := self = obj;
end;
function _Object.getHashCode(): int;
begin
result := int(self);
end;
function _Object.toString(): AnsiString;
begin
result := unitName() + '.' + className() + '@' + intToHexString(int(self));
end;
function _Object.queryInterface(
{$IFDEF FPC_HAS_CONSTREF} constref {$ELSE} const {$ENDIF} iid: TGuid;
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;
{ 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
{ ВХОД: eax – self }
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;
{ FPU }
class procedure FPU.configure(); assembler; nostackframe;
asm
fldenv [FPU_DEFAULT_ENVIRONMENT]
fldz
fldz
fldz
fldz
fldz
fldz
fldz
fldz
fldenv [FPU_DEFAULT_ENVIRONMENT]
end;
class procedure FPU.getEnvironment(out env: Environment); assembler; nostackframe;
asm
{ ВХОД: edx – env }
fnstenv [edx]
end;
class procedure FPU.setEnvironment(const env: Environment); assembler; nostackframe;
asm
{ ВХОД: edx – env }
fldenv [edx]
end;
class procedure FPU.setExceptionMask(exceptionMask: int); assembler; nostackframe;
asm
{ ВХОД: edx – exceptionMask }
lea esp, [esp - $04]
fnstcw [esp]
pop eax
and eax, $0000ffc0
and edx, $0000003f
or eax, edx
push eax
fnclex
fldcw [esp]
lea esp, [esp + $04]
end;
class procedure FPU.setRoundMode(roundMode: int); assembler; nostackframe;
asm
{ ВХОД: edx – roundMode }
lea esp, [esp - $04]
fnstcw [esp]
pop eax
and eax, $0000f3ff
and edx, $00000c00
or eax, edx
push eax
fnclex
fldcw [esp]
lea esp, [esp + $04]
end;
class function FPU.isSupported(): boolean; assembler; nostackframe;
asm
{ ВЫХОД: eax – наличие FPU }
mov edx, $00200000
pushfd
or [esp], edx
popfd
pushfd
pop eax
test eax, edx
jz @notSupported
and eax, $ffdfffff
push eax
popfd
push ebx
mov eax, $00000001
cpuid
pop ebx
test edx, $00000001
jz @notSupported
mov eax, true
ret
@notSupported: xor eax, eax
end;
class function FPU.getExceptionMask(): int; assembler; nostackframe;
asm
{ ВЫХОД: eax – маски исключений FPU }
lea esp, [esp - $04]
fnstcw [esp]
pop eax
and eax, $0000003f
end;
class function FPU.getRoundMode(): int; assembler; nostackframe;
asm
{ ВЫХОД: eax – режим округления FPU }
lea esp, [esp - $04]
fnstcw [esp]
pop eax
and eax, $00000c00
end;
class procedure FPU.clinit();
begin
if isSupported() then begin
configure();
setRoundMode(ROUND_TO_NEAREST);
end;
end;
{ SSE }
class procedure SSE.configure(); assembler; nostackframe;
asm
mov eax, SSE_DEFAULT_ENVIRONMENT
push eax
ldmxcsr [esp]
xor eax, eax
mov [esp], eax
push eax
push eax
push eax
movdqu xmm0, [esp]
movdqu xmm1, xmm0
movdqu xmm2, xmm0
movdqu xmm3, xmm0
movdqu xmm4, xmm0
movdqu xmm5, xmm0
movdqu xmm6, xmm0
movdqu xmm7, xmm0
lea esp, [esp + $10]
end;
class procedure SSE.setEnvironment(mxcsr: int); assembler; nostackframe;
asm
{ ВХОД: edx – mxcsr }
and edx, $0000ffff
push edx
ldmxcsr [esp]
lea esp, [esp + $04]
end;
class procedure SSE.setExceptionMask(exceptionMask: int); assembler; nostackframe;
asm
{ ВХОД: edx – exceptionMask }
lea esp, [esp - $04]
stmxcsr [esp]
pop eax
and eax, $0000e07f
and edx, $00001f80
or eax, edx
push eax
ldmxcsr [esp]
lea esp, [esp + $04]
end;
class procedure SSE.setRoundMode(roundMode: int); assembler; nostackframe;
asm
{ ВХОД: edx – roundMode }
lea esp, [esp - $04]
stmxcsr [esp]
pop eax
and eax, $00009fff
and edx, $00006000
or eax, edx
push eax
ldmxcsr [esp]
lea esp, [esp + $04]
end;
class function SSE.isSupported(): boolean; assembler; nostackframe;
asm
{ ВЫХОД: eax – наличие MMX, SSE, SSE2 и SSE3 }
mov edx, $00200000
pushfd
or [esp], edx
popfd
pushfd
pop eax
test eax, edx
jz @notSupported
and eax, $ffdfffff
push eax
popfd
push ebx
mov eax, $00000001
cpuid
pop ebx
and edx, $07800000
cmp edx, $07800000
jne @notSupported
test ecx, $00000001
jz @notSupported
mov eax, true
ret
@notSupported: xor eax, eax
end;
class function SSE.getEnvironment(): int; assembler; nostackframe;
asm
{ ВЫХОД: eax – текущая среда SSE }
lea esp, [esp - $04]
stmxcsr [esp]
pop eax
end;
class function SSE.getExceptionMask(): int; assembler; nostackframe;
asm
{ ВЫХОД: eax – маски исключений SSE }
lea esp, [esp - $04]
stmxcsr [esp]
pop eax
and eax, $00001f80
end;
class function SSE.getRoundMode(): int; assembler; nostackframe;
asm
{ ВЫХОД: eax – текущий режим округления SSE }
lea esp, [esp - $04]
stmxcsr [esp]
pop eax
and eax, $00006000
end;
class procedure SSE.clinit();
begin
if isSupported() then begin
configure();
setRoundMode(ROUND_TO_NEAREST);
end;
end;
{ Math }
class function Math.abs(x: int): int;
begin
if x >= 0 then begin
result := x;
end else begin
result := -x;
end;
end;
class function Math.abs(x: long): long;
begin
if x >= 0 then begin
result := x;
end else begin
result := -x;
end;
end;
class function Math.abs(x: real): real;
begin
result := realBuild(realExtractExponent(x) and $7fff, realExtractSignificand(x));
end;
class function Math.min(x, y: int): int;
begin
if x <= y then begin
result := x;
end else begin
result := y;
end;
end;
class function Math.min(x, y: long): long;
begin
if x <= y then begin
result := x;
end else begin
result := y;
end;
end;
class function Math.min(x, y: real): real;
begin
if realCmpl(x, x) <> 0 then begin
result := x;
end else
if (realCmpl(x, 0.0) = 0) and (realCmpl(y, 0.0) = 0) and
(realExtractExponent(y) < 0) then begin
result := y;
end else
if realCmpg(x, y) > 0 then begin
result := y;
end else begin
result := x;
end;
end;
class function Math.max(x, y: int): int;
begin
if x >= y then begin
result := x;
end else begin
result := y;
end;
end;
class function Math.max(x, y: long): long;
begin
if x >= y then begin
result := x;
end else begin
result := y;
end;
end;
class function Math.max(x, y: real): real;
begin
if realCmpl(x, x) <> 0 then begin
result := x;
end else
if (realCmpl(x, 0.0) = 0) and (realCmpl(y, 0.0) = 0) and
(realExtractExponent(x) < 0) then begin
result := y;
end else
if realCmpl(x, y) < 0 then begin
result := y;
end else begin
result := x;
end;
end;
class function Math.intPart(x: real): real; assembler;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
call FPU.getRoundMode
mov ecx, eax
mov edx, $0c00
call FPU.setRoundMode
fld tbyte [x]
frndint
mov edx, ecx
call FPU.setRoundMode
end;
class function Math.fracPart(x: real): real; assembler;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
call FPU.getRoundMode
mov ecx, eax
mov edx, $0c00
call FPU.setRoundMode
fld tbyte [x]
fld st(0)
frndint
fsubp st(1), st(0)
mov edx, ecx
call FPU.setRoundMode
end;
class function Math.floor(x: real): real; assembler;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
call FPU.getRoundMode
mov ecx, eax
mov edx, $0400
call FPU.setRoundMode
fld tbyte [x]
frndint
mov edx, ecx
call FPU.setRoundMode
end;
class function Math.ceil(x: real): real; assembler;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
call FPU.getRoundMode
mov ecx, eax
mov edx, $0800
call FPU.setRoundMode
fld tbyte [x]
frndint
mov edx, ecx
call FPU.setRoundMode
end;
class function Math.sqrt(x: real): real; assembler;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
fld tbyte [x]
fsqrt
end;
class function Math.pow2(x: real): real; assembler;
var
immediate: real;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
mov eax, [x + $06]
sar eax, $0e
cmp eax, $0001fffe
je @0
cmp eax, $fffffffe
jne @1
fldz
leave
ret $0c
@0: mov dword [immediate + $00], $00000000
mov dword [immediate + $04], $80000000
mov dword [immediate + $08], $00007fff
fld tbyte [immediate]
leave
ret $0c
@1: fld tbyte [x]
fxam
fnstsw ax
ffree st(0)
fincstp
sahf
jz @2
jp @2
mov dword [immediate + $00], $00000000
mov dword [immediate + $04], $c0000000
mov dword [immediate + $08], $0000ffff
fld tbyte [immediate]
leave
ret $0c
@2: call FPU.getRoundMode
mov ecx, eax
mov edx, $0c00
call FPU.setRoundMode
fld tbyte [x]
fld st(0)
frndint
mov edx, ecx
call FPU.setRoundMode
fsubp st(1), st(0)
f2xm1
fld1
faddp st(1), st(0)
fld tbyte [x]
fld1
fscale
fmulp st(2), st(0)
ffree st(0)
fincstp
end;
class function Math.log2(x: real): real; assembler;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
fld1
fld tbyte [x]
fyl2x
end;
class function Math.sin(x: real): real; assembler;
var
immediate: real;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
fld tbyte [x]
fxam
fnstsw ax
sahf
jz @0
jp @0
ffree st(0)
fincstp
mov dword [immediate + $00], $00000000
mov dword [immediate + $04], $c0000000
mov dword [immediate + $08], $0000ffff
fld tbyte [immediate]
leave
ret $0c
@0: fsin
fnstsw ax
sahf
jp @1
leave
ret $0c
@1: ffree st(0)
fincstp
mov dword [immediate + $00], $2168c236
mov dword [immediate + $04], $c90fdaa2
mov dword [immediate + $08], $00004001
fld tbyte [immediate]
fld tbyte [x]
@2: fprem
fnstsw ax
test ax, $0400
jnz @2
fstp st(1)
fsin
end;
class function Math.cos(x: real): real; assembler;
var
immediate: real;
asm
{ ВХОД: tbyte [x] – x }
{ ВЫХОД: st(0) – результат }
fld tbyte [x]
fxam
fnstsw ax
sahf
jz @0
jp @0
ffree st(0)
fincstp
mov dword [immediate + $00], $00000000
mov dword [immediate + $04], $c0000000
mov dword [immediate + $08], $0000ffff
fld tbyte [immediate]
leave
ret $0c
@0: fcos
fnstsw ax
sahf
jp @1
leave
ret $0c
@1: ffree st(0)
fincstp
mov dword [immediate + $00], $2168c236
mov dword [immediate + $04], $c90fdaa2
mov dword [immediate + $08], $00004001
fld tbyte [immediate]
fld tbyte [x]
@2: fprem
fnstsw ax
test ax, $0400
jnz @2
fstp st(1)
fcos
end;
class function Math.tan(x: real): real;
begin
result := sin(x) / cos(x);
end;
class function Math.arctan(y, x: real): real; assembler;
asm
{ ВХОД: tbyte [y] – y
tbyte [x] – x}
{ ВЫХОД: st(0) – результат }
fld tbyte [y]
fld tbyte [x]
fpatan
end;
class function Math.toDegrees(angrad: real): real;
begin
result := angrad * (180.0 / PI);
end;
class function Math.toRadians(angdeg: real): real;
begin
result := angdeg / (180.0 / PI);
end;
class function Math.round(x: real): long; assembler;
var
immediate: long;
resultPtr: ^int64;
asm
{ ВХОД: tbyte [x] – x
edx – результат }
fld tbyte [x]
mov dword [immediate + $00], $ffffffff
mov dword [immediate + $04], $7fffffff
fild qword [immediate]
fcomip st(0), st(1)
jnp @0
ffree st(0)
fincstp
mov dword [edx + $00], $00000000
mov dword [edx + $04], $00000000
leave
ret $0c
@0: ja @1
ffree st(0)
fincstp
mov dword [edx + $00], $ffffffff
mov dword [edx + $04], $7fffffff
leave
ret $0c
@1: mov [resultPtr], edx
call FPU.getRoundMode
mov ecx, eax
mov edx, $0000
call FPU.setRoundMode
mov eax, [resultPtr]
fistp qword [eax]
mov edx, ecx
call FPU.setRoundMode
end;
{ RealValueRepresenter }
class function RealValueRepresenter.pow10(value: real; pow: int): real;
begin
if pow > 0 then begin
if pow < $2000 then begin
result := value * tab_04_00(pow) * tab_08_05(pow) * tab_12_09(pow);
end else begin
result := value * Math.POS_INF;
end;
end else
if pow < 0 then begin
pow := -pow;
if pow < $2000 then begin
result := value / tab_04_00(pow) / tab_08_05(pow) / tab_12_09(pow);
end else begin
result := value / Math.POS_INF;
end;
end else begin
result := value;
end;
end;
class procedure RealValueRepresenter.clinit();
begin
INSTANCE := RealValueRepresenter.create(REAL_SIGNIFICAND_DIGITS, REAL_ORDER_DIGITS);
end;
class procedure RealValueRepresenter.cldone();
begin
INSTANCE.free();
INSTANCE := nil;
end;
class function RealValueRepresenter.tab_04_00(pow: int): real;
begin
case pow and $1f of
0: result := 1.e+0000;
1: result := 1.e+0001;
2: result := 1.e+0002;
3: result := 1.e+0003;
4: result := 1.e+0004;
5: result := 1.e+0005;
6: result := 1.e+0006;
7: result := 1.e+0007;
8: result := 1.e+0008;
9: result := 1.e+0009;
10: result := 1.e+0010;
11: result := 1.e+0011;
12: result := 1.e+0012;
13: result := 1.e+0013;
14: result := 1.e+0014;
15: result := 1.e+0015;
16: result := 1.e+0016;
17: result := 1.e+0017;
18: result := 1.e+0018;
19: result := 1.e+0019;
20: result := 1.e+0020;
21: result := 1.e+0021;
22: result := 1.e+0022;
23: result := 1.e+0023;
24: result := 1.e+0024;
25: result := 1.e+0025;
26: result := 1.e+0026;
27: result := 1.e+0027;
28: result := 1.e+0028;
29: result := 1.e+0029;
30: result := 1.e+0030;
31: result := 1.e+0031;
else
result := 0.000;
end;
end;
class function RealValueRepresenter.tab_08_05(pow: int): real;
begin
case (pow shr 5) and $0f of
0: result := 1.e+0000;
1: result := 1.e+0032;
2: result := 1.e+0064;
3: result := 1.e+0096;
4: result := 1.e+0128;
5: result := 1.e+0160;
6: result := 1.e+0192;
7: result := 1.e+0224;
8: result := 1.e+0256;
9: result := 1.e+0288;
10: result := 1.e+0320;
11: result := 1.e+0352;
12: result := 1.e+0384;
13: result := 1.e+0416;
14: result := 1.e+0448;
15: result := 1.e+0480;
else
result := 0.000;
end;
end;
class function RealValueRepresenter.tab_12_09(pow: int): real;
begin
case (pow shr 9) and $0f of
0: result := 1.e+0000;
1: result := 1.e+0512;
2: result := 1.e+1024;
3: result := 1.e+1536;
4: result := 1.e+2048;
5: result := 1.e+2560;
6: result := 1.e+3072;
7: result := 1.e+3584;
8: result := 1.e+4096;
9: result := 1.e+4608;
10..15:
result := Math.POS_INF;
else
result := 0.000;
end;
end;
constructor RealValueRepresenter.create(significandDigits, orderDigits: int);
var
i: int;
maxRepresent: long;
begin
inherited create();
significandDigits := Math.max(MIN_SIGNIFICAND_DIGITS, Math.min(MAX_SIGNIFICAND_DIGITS,
significandDigits));
orderDigits := Math.max(MIN_ORDER_DIGITS, Math.min(MAX_ORDER_DIGITS, orderDigits));
maxRepresent := 1;
for i := significandDigits - 1 downto 0 do begin
maxRepresent := 10 * maxRepresent;
end;
self.limitValueWithFractialPart := pow10(1.0, significandDigits - 1);
self.limitValueWithoutExponent := pow10(1.0, significandDigits);
self.orderDigits := orderDigits;
self.significandDigits := significandDigits;
self.minRepresentValue := maxRepresent div 10;
self.maxRepresentValue := maxRepresent - 1;
end;
function RealValueRepresenter.toString(value: real): AnsiString;
var
expform: boolean;
c: char;
i: int;
j: int;
len: int;
order: int;
dotpos: int;
sigdig: int;
intexp: int;
intval: long;
tmp: long;
buf: char_Array1d;
begin
if realIsNaN(value) then begin
result := 'NaN';
exit;
end;
if realCmpl(value, Math.POS_INF) = 0 then begin
result := '+Inf';
exit;
end;
if realCmpl(value, Math.NEG_INF) = 0 then begin
result := '-Inf';
exit;
end;
len := 0;
i := 32;
buf := char_Array1d_create(i);
while i > 0 do begin
dec(i);
buf[i] := '0';
end;
intval := realExtractSignificand(value);
intexp := realExtractExponent(value);
if intexp < 0 then begin
buf[len] := '-';
inc(len);
value := -value;
intexp := intexp xor int($ffff8000);
end;
if (intexp <> 0) or (intval <> 0) then begin
order := realToInt(3.010299956639811952137e-0001 * Math.log2(value));
sigdig := significandDigits;
expform := (realCmpg(value, 1.e-0006) < 0) or
(realCmpl(value, limitValueWithoutExponent) >= 0);
if expform then begin
if order < 0 then begin
dec(order);
end;
intval := Math.round(pow10(value, sigdig - order - 1));
if intval < minRepresentValue then begin
intval := 10 * intval;
dec(order);
end;
if intval > maxRepresentValue then begin
intval := intval div 10;
inc(order);
end;
dotpos := len + 1;
end else
if realCmpg(value, 1.e+0000) < 0 then begin
intval := Math.round(pow10(value, sigdig - 1));
dotpos := len + 1;
end else
if realCmpg(value, limitValueWithFractialPart) < 0 then begin
intval := Math.round(pow10(value, sigdig - order - 1));
if intval < minRepresentValue then begin
intval := 10 * intval;
dec(order);
end;
if intval > maxRepresentValue then begin
intval := intval div 10;
inc(order);
end;
dotpos := len + order + 1;
end else begin
intval := Math.round(value);
tmp := maxRepresentValue;
if intval > tmp then begin
intval := tmp;
end;
dotpos := len + sigdig;
end;
buf[dotpos] := '.';
i := len + sigdig;
while i > len do begin
dec(i);
if i >= dotpos then begin
j := i + 1;
end else begin
j := i;
end;
buf[j] := char(int(intval mod 10) + int('0'));
intval := intval div 10;
end;
len := len + (sigdig + 2);
repeat
c := buf[len - 1];
if (c <> '0') and (c <> '.') then begin
break;
end;
dec(len);
if c = '.' then begin
break;
end;
until false;
if expform then begin
buf[len] := 'E';
inc(len);
if order < 0 then begin
buf[len] := '-';
inc(len);
order := -order;
end else begin
buf[len] := '+';
inc(len);
end;
i := len + orderDigits;
j := i;
while i > len do begin
dec(i);
buf[i] := char((order mod 10) + int('0'));
order := order div 10;
end;
len := j;
end;
end else begin
inc(len);
end;
result := String_create(buf, 0, len);
end;
{ Thread }
class function Thread.nextThreadNum(): int;
begin
result := interlockedIncrement(@THREAD_NUM);
end;
constructor Thread.create();
begin
create(nil, '');
end;
constructor Thread.create(const name: String);
begin
create(nil, name);
end;
constructor Thread.create(const target: Runnable);
begin
create(target, '');
end;
constructor Thread.create(const target: Runnable; const name: String);
var
thrdName: String;
begin
inherited create(true, $00100000);
freeOnTerminate := true;
if length(name) <= 0 then begin
thrdName := msgThread + #$20 + intToString(nextThreadNum());
end else begin
thrdName := name;
end;
self.target := target;
self.name := thrdName;
end;
function Thread.toString(): AnsiString;
begin
result := msgThread + '[' + name + ']';
end;
function Thread.queryInterface(
{$IFDEF FPC_HAS_CONSTREF} constref {$ELSE} const {$ENDIF} iid: TGuid;
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 Thread._addref(): int;
{$IFNDEF WINDOWS} cdecl {$ELSE} stdcall {$ENDIF};
begin
result := -1;
end;
function Thread._release(): int;
{$IFNDEF WINDOWS} cdecl {$ELSE} stdcall {$ENDIF};
begin
result := -1;
end;
procedure Thread.run();
begin
end;
function Thread.getName(): String;
begin
result := name;
end;
procedure Thread.execute();
var
ltarget: Pointer;
begin
FPU.clinit();
SSE.clinit();
ltarget := self.target;
if ltarget <> nil then begin
Runnable(ltarget).run();
exit;
end;
run();
end;
{ Exception }
constructor Exception.create(const amessage: String);
begin
inherited create(amessage);
end;
constructor Exception.createHelp(const amessage: String; ahelpContext: int);
begin
inherited createHelp(amessage, ahelpContext);
end;
function Exception.toString(): AnsiString;
var
lmessage: String;
begin
lmessage := self.message;
if length(lmessage) > 0 then begin
result := unitName() + '.' + className() + ': ' + lmessage;
end else begin
result := unitName() + '.' + className();
end;
end;
{ ClassInfoAsObject }
constructor ClassInfoAsObject.create(const info: TClass);
begin
inherited create();
self.info := info;
end;
function ClassInfoAsObject.isInterface(): boolean;
begin
result := false;
end;
function ClassInfoAsObject.isInstance(const ref: TObject): boolean;
begin
result := (ref <> nil) and isAssignableFrom(ref.getClass());
end;
function ClassInfoAsObject.isInstance(const ref: _Interface): boolean;
begin
result := (ref <> nil) and isAssignableFrom((ref as TObject).getClass());
end;
function ClassInfoAsObject.isInterfaceImplements(const intf: _Class): boolean;
var
i: int;
c: TClass;
iid: TGuid;
table: PInterfaceTable;
begin
if not (intf is IntfInfoAsObject) then begin
result := false;
exit;
end;
iid := (intf as IntfInfoAsObject).info;
c := self.info;
repeat
table := c.getInterfaceTable();
for i := table^.entryCount - 1 downto 0 do begin
if SysUtils.isEqualGUID(table^.entries[i].iid^, iid) then begin
result := true;
exit;
end;
end;
c := c.classParent();
until c = nil;
result := false;
end;
function ClassInfoAsObject.isInheritedFrom(const cls: _Class): boolean;
var
c: TClass;
cid: TClass;
begin
if not (cls is ClassInfoAsObject) then begin
result := false;
exit;
end;
cid := (cls as ClassInfoAsObject).info;
c := self.info;
repeat
if c = cid then begin
result := true;
exit;
end;
c := c.classParent();
until c = nil;
result := false;
end;
function ClassInfoAsObject.isAssignableFrom(const cls: _Class): boolean;
begin
if cls = nil then begin
raise NullPointerException.create(msgNullPointer);
end;
result := cls.isInheritedFrom(self);
end;
function ClassInfoAsObject.getInterfaces(): Class_Array1d;
var
i: int;
len: int;
table: PInterfaceTable;
begin
table := info.getInterfaceTable();
len := table^.entryCount;
result := Class_Array1d(Interface_Array1d_create(len));
for i := len - 1 downto 0 do begin
result[i] := IntfInfoAsObject.create(table^.entries[i].iid^);
end;
end;
function ClassInfoAsObject.getSuperclass(): _Class;
begin
result := ClassInfoAsObject.create(info.classParent());
end;
function ClassInfoAsObject.getUnitName(): AnsiString;
begin
result := info.unitName();
end;
function ClassInfoAsObject.getSimpleName(): AnsiString;
begin
result := info.className();
end;
function ClassInfoAsObject.getCanonicalName(): AnsiString;
var
c: TClass;
begin
c := info;
result := c.unitName() + '.' + c.className();
end;
{ IntfInfoAsObject }
constructor IntfInfoAsObject.create(const info: TGuid);
begin
inherited create();
self.info := info;
end;
function IntfInfoAsObject.isInterface(): boolean;
begin
result := true;
end;
function IntfInfoAsObject.isInstance(const ref: TObject): boolean;
begin
result := (ref <> nil) and isAssignableFrom(ref.getClass());
end;
function IntfInfoAsObject.isInstance(const ref: _Interface): boolean;
begin
result := (ref <> nil) and isAssignableFrom((ref as TObject).getClass());
end;
function IntfInfoAsObject.isInterfaceImplements(const intf: _Class): boolean;
begin
result := false;
end;
function IntfInfoAsObject.isInheritedFrom(const cls: _Class): boolean;
begin
result := false;
end;
function IntfInfoAsObject.isAssignableFrom(const cls: _Class): boolean;
begin
if cls = nil then begin
raise NullPointerException.create(msgNullPointer);
end;
result := cls.isInterfaceImplements(self);
end;
function IntfInfoAsObject.getInterfaces(): Class_Array1d;
begin
result := nil;
end;
function IntfInfoAsObject.getSuperclass(): _Class;
begin
result := nil;
end;
function IntfInfoAsObject.getUnitName(): AnsiString;
begin
result := '';
end;
function IntfInfoAsObject.getSimpleName(): AnsiString;
begin
result := SysUtils.GUIDToString(info);
end;
function IntfInfoAsObject.getCanonicalName(): AnsiString;
begin
result := SysUtils.GUIDToString(info);
end;
{ functions }
{ byte }
function byteToBinString(value: int): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($08);
for i := $00 to $07 do begin
buf[i] := DIGITS[((value shr (i xor $07)) and $01) + 1];
end;
result := String_create(buf, $00, $08);
end;
function byteToHexString(value: int): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($02);
for i := $00 to $01 do begin
buf[i] := DIGITS[((value shr ((i xor $01) shl 2)) and $0f) + 1];
end;
result := String_create(buf, $00, $02);
end;
{ short }
function shortByteSwap(value: int): int; assembler; nostackframe;
asm
{ ВХОД: eax – value }
{ ВЫХОД: eax – результат }
xchg al, ah
movsx eax, ax
end;
function shortToBinString(value: int): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($10);
for i := $00 to $0f do begin
buf[i] := DIGITS[((value shr (i xor $0f)) and $01) + 1];
end;
result := String_create(buf, $00, $10);
end;
function shortToHexString(value: int): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($04);
for i := $00 to $03 do begin
buf[i] := DIGITS[((value shr ((i xor $03) shl 2)) and $0f) + 1];
end;
result := String_create(buf, $00, $04);
end;
{ int }
function intByteSwap(value: int): int; assembler; nostackframe;
asm
{ ВХОД: eax – value }
{ ВЫХОД: eax – результат }
bswap eax
end;
function intUDiv(dividend, divisor: int): int; assembler; nostackframe;
asm
{ ВХОД: eax – dividend
edx – divisor }
{ ВЫХОД: eax – результат }
mov ecx, edx
xor edx, edx
div ecx
end;
function intUMod(dividend, divisor: int): int; assembler; nostackframe;
asm
{ ВХОД: eax – dividend
edx – divisor }
{ ВЫХОД: eax – результат }
mov ecx, edx
xor edx, edx
div ecx
mov eax, edx
end;
function intSar(multiplier: int; bits: int): int; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits }
{ ВЫХОД: eax – результат }
mov cl, dl
sar eax, cl
end;
function intZeroExtend(value: int): long; inline;
begin
result.ints[0] := value;
result.ints[1] := 0;
end;
function intBitsToFloat(value: int): float; inline;
begin
result := float((@value)^);
end;
function intToReal(value: int): real; assembler; nostackframe;
asm
{ ВХОД: eax – value }
{ ВЫХОД: st(0) – результат }
push eax
fild dword [esp]
lea esp, [esp + $04]
end;
function intToString(value: int): String;
begin
result := intToString(value, 10);
end;
function intToString(value: int; radix: int): String;
var
negative: boolean;
i: int;
len: int;
radixNeg: int;
buf: char_Array1d;
begin
negative := value < 0;
i := sizeof(value) shl 3;
len := i + 1;
buf := char_Array1d_create(len);
if (radix > MAX_RADIX) or (radix < MIN_RADIX) then begin
radix := 10;
end;
if negative = false then begin
value := -value;
end;
radixNeg := -radix;
while value <= radixNeg do begin
buf[i] := getDigitRepresentation(-(value mod radix));
dec(i);
value := value div radix;
end;
buf[i] := getDigitRepresentation(-value);
if negative = true then begin
dec(i);
buf[i] := '-';
end;
result := String_create(buf, i, len - i);
end;
function intToBinString(value: int): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($20);
for i := $00 to $1f do begin
buf[i] := DIGITS[((value shr (i xor $1f)) and $01) + 1];
end;
result := String_create(buf, $00, $20);
end;
function intToHexString(value: int): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($08);
for i := $00 to $07 do begin
buf[i] := DIGITS[((value shr ((i xor $07) shl 2)) and $0f) + 1];
end;
result := String_create(buf, $00, $08);
end;
{ long }
function longBuild(short3, short2, short1, short0: int): long; inline;
begin
result.shorts[0] := short(short0);
result.shorts[1] := short(short1);
result.shorts[2] := short(short2);
result.shorts[3] := short(short3);
end;
function longBuild(hi, lo: int): long; inline;
begin
result.ints[0] := lo;
result.ints[1] := hi;
end;
function longByteSwap(const value: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
mov ecx, [eax + $00]
bswap ecx
mov [edx + $04], ecx
mov ecx, [eax + $04]
bswap ecx
mov [edx + $00], ecx
end;
function longEquals(const relationship1, relationship2: long): boolean; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2 }
{ ВЫХОД: eax – результат }
mov ecx, [eax + $04]
cmp ecx, [edx + $04]
jne @ne
mov ecx, [eax + $00]
cmp ecx, [edx + $00]
jne @ne
mov eax, true
ret
@ne: xor eax, eax
end;
function longGreate(const relationship1, relationship2: long): boolean; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2 }
{ ВЫХОД: eax – результат }
mov ecx, [eax + $04]
cmp ecx, [edx + $04]
jg @gt
jl @le
mov ecx, [eax + $00]
cmp ecx, [edx + $00]
ja @gt
@le: xor eax, eax
ret
@gt: mov eax, true
end;
function longCmp(const relationship1, relationship2: long): int; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2 }
{ ВЫХОД: eax – результат }
mov ecx, [eax + $04]
cmp ecx, [edx + $04]
jg @gt
jl @lt
mov ecx, [eax + $00]
cmp ecx, [edx + $00]
ja @gt
je @eq
@lt: mov eax, -$01
ret
@eq: xor eax, eax
ret
@gt: mov eax, $01
end;
function longAdd(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
paddq xmm0, xmm1
movq [ecx], xmm0
end;
function longSub(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
psubq xmm0, xmm1
movq [ecx], xmm0
end;
function longMul(const multiplier1, multiplier2: long): long; assembler;
var
immediate1: ultra;
immediate2: ultra;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movd xmm0, [eax + $00]
movd xmm1, [edx + $00]
movd xmm2, [eax + $04]
movd xmm3, [edx + $04]
movdqu xmm4, xmm0
pmuludq xmm4, xmm1
movq [immediate1 + $00], xmm0
movq [immediate2 + $08], xmm1
movq [immediate1 + $08], xmm2
movq [immediate2 + $00], xmm3
movdqu xmm0, [immediate1]
movdqu xmm1, [immediate2]
pmuludq xmm0, xmm1
psllq xmm0, $20
movhlps xmm1, xmm0
paddq xmm0, xmm1
paddq xmm0, xmm4
movq [ecx], xmm0
end;
function longDiv(const dividend, divisor: long): long; assembler;
var
resultSign: int;
resultPtr: ^int64;
asm
{ ВХОД: eax – dividend
edx – divisor
ecx – результат }
cmp dword [edx + $00], $00
jne @0
cmp dword [edx + $04], $00
jne @0
call raiseDivByZero
leave
ret
@0: push esi
push edi
push ebx
mov [resultPtr], ecx
mov ecx, [edx + $04]
mov ebx, [edx + $00]
mov edx, [eax + $04]
mov eax, [eax + $00]
xor esi, esi
xor edi, edi
test edx, $80000000
jnz @1
mov byte [resultSign], $00
jmp @2
@1: mov byte [resultSign], $01
neg eax
adc edx, $00
neg edx
@2: test ecx, $80000000
jz @3
xor byte [resultSign], $01
neg ebx
adc ecx, $00
neg ecx
@3: push ebp
mov ebp, ecx
mov ecx, $40
{ edx:eax – dividend => quotient }
{ ebp:ebx – divisor }
{ edi:esi – 0 => remainder }
@4: shl eax, $01
rcl edx, $01
rcl esi, $01
rcl edi, $01
cmp edi, ebp
jb @6
ja @5
cmp esi, ebx
jb @6
@5: sub esi, ebx
sbb edi, ebp
inc eax
@6: loop @4
pop ebp
test byte [resultSign], $01
jz @7
neg eax
adc edx, $00
neg edx
@7: mov ecx, [resultPtr]
mov [ecx + $00], eax
mov [ecx + $04], edx
pop ebx
pop edi
pop esi
end;
function longMod(const dividend, divisor: long): long; assembler;
var
resultSign: int;
resultPtr: ^int64;
asm
{ ВХОД: eax – dividend
edx – divisor
ecx – результат }
cmp dword [edx + $00], $00
jne @0
cmp dword [edx + $04], $00
jne @0
call raiseDivByZero
leave
ret
@0: push esi
push edi
push ebx
mov [resultPtr], ecx
mov ecx, [edx + $04]
mov ebx, [edx + $00]
mov edx, [eax + $04]
mov eax, [eax + $00]
xor esi, esi
xor edi, edi
test edx, $80000000
jnz @1
mov byte [resultSign], $00
jmp @2
@1: mov byte [resultSign], $01
neg eax
adc edx, $00
neg edx
@2: test ecx, $80000000
jz @3
neg ebx
adc ecx, $00
neg ecx
@3: push ebp
mov ebp, ecx
mov ecx, $40
{ edx:eax – dividend => quotient }
{ ebp:ebx – divisor }
{ edi:esi – 0 => remainder }
@4: shl eax, $01
rcl edx, $01
rcl esi, $01
rcl edi, $01
cmp edi, ebp
jb @6
ja @5
cmp esi, ebx
jb @6
@5: sub esi, ebx
sbb edi, ebp
inc eax
@6: loop @4
pop ebp
test byte [resultSign], $01
jz @7
neg esi
adc edi, $00
neg edi
@7: mov ecx, [resultPtr]
mov [ecx + $00], esi
mov [ecx + $04], edi
pop ebx
pop edi
pop esi
end;
function longUDiv(const dividend, divisor: long): long; assembler;
var
resultPtr: ^int64;
asm
{ ВХОД: eax – dividend
edx – divisor
ecx – результат }
cmp dword [edx + $00], $00
jne @0
cmp dword [edx + $04], $00
jne @0
call raiseDivByZero
leave
ret
@0: push esi
push edi
push ebx
mov [resultPtr], ecx
mov ecx, [edx + $04]
mov ebx, [edx + $00]
mov edx, [eax + $04]
mov eax, [eax + $00]
xor esi, esi
xor edi, edi
push ebp
mov ebp, ecx
mov ecx, $40
{ edx:eax – dividend => quotient }
{ ebp:ebx – divisor }
{ edi:esi – 0 => remainder }
@4: shl eax, $01
rcl edx, $01
rcl esi, $01
rcl edi, $01
cmp edi, ebp
jb @6
ja @5
cmp esi, ebx
jb @6
@5: sub esi, ebx
sbb edi, ebp
inc eax
@6: loop @4
pop ebp
mov ecx, [resultPtr]
mov [ecx + $00], eax
mov [ecx + $04], edx
pop ebx
pop edi
pop esi
end;
function longUMod(const dividend, divisor: long): long; assembler;
var
resultPtr: ^int64;
asm
{ ВХОД: eax – dividend
edx – divisor
ecx – результат }
cmp dword [edx + $00], $00
jne @0
cmp dword [edx + $04], $00
jne @0
call raiseDivByZero
leave
ret
@0: push esi
push edi
push ebx
mov [resultPtr], ecx
mov ecx, [edx + $04]
mov ebx, [edx + $00]
mov edx, [eax + $04]
mov eax, [eax + $00]
xor esi, esi
xor edi, edi
push ebp
mov ebp, ecx
mov ecx, $40
{ edx:eax – dividend => quotient }
{ ebp:ebx – divisor }
{ edi:esi – 0 => remainder }
@4: shl eax, $01
rcl edx, $01
rcl esi, $01
rcl edi, $01
cmp edi, ebp
jb @6
ja @5
cmp esi, ebx
jb @6
@5: sub esi, ebx
sbb edi, ebp
inc eax
@6: loop @4
pop ebp
mov ecx, [resultPtr]
mov [ecx + $00], esi
mov [ecx + $04], edi
pop ebx
pop edi
pop esi
end;
function longNeg(const value: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
mov ecx, [eax + $04]
mov eax, [eax + $00]
neg eax
adc ecx, $00
neg ecx
mov [edx + $00], eax
mov [edx + $04], ecx
end;
function longOr(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
por xmm0, xmm1
movq [ecx], xmm0
end;
function longXor(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
pxor xmm0, xmm1
movq [ecx], xmm0
end;
function longAnd(const multiplier1, multiplier2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
pand xmm0, xmm1
movq [ecx], xmm0
end;
function longSar(const multiplier: long; bits: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
and edx, $3f
movq xmm0, [eax]
pxor xmm1, xmm1
movd xmm2, edx
test dword [eax + $04], $80000000
jz @0
xor dl, $3f
inc dl
mov eax, $ffffffff
push eax
push eax
movq xmm1, [esp]
movd xmm3, edx
lea esp, [esp + $08]
psllq xmm1, xmm3
@0: psrlq xmm0, xmm2
por xmm0, xmm1
movq [ecx], xmm0
end;
function longShr(const multiplier: long; bits: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
and edx, $3f
movq xmm0, [eax]
movd xmm1, edx
psrlq xmm0, xmm1
movq [ecx], xmm0
end;
function longShl(const multiplier: long; bits: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
and edx, $3f
movq xmm0, [eax]
movd xmm1, edx
psllq xmm0, xmm1
movq [ecx], xmm0
end;
function longNot(const value: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
mov ecx, [eax + $04]
mov eax, [eax + $00]
not eax
not ecx
mov [edx + $00], eax
mov [edx + $04], ecx
end;
function longBitsToDouble(const value: long): double; inline;
begin
result := double((@value)^);
end;
function longToReal(const value: long): real; assembler; nostackframe;
asm
{ ВХОД: eax – value }
{ ВЫХОД: st(0) – результат }
fild qword [eax]
end;
function longToString(const value: long): String;
begin
result := longToString(value, 10);
end;
function longToString(const value: long; radix: int): String;
var
negative: boolean;
i: int;
len: int;
valueCopy: long;
longRadix: long;
longRadixNeg: long;
buf: char_Array1d;
begin
negative := value < 0;
i := sizeof(value) shl 3;
len := i + 1;
valueCopy := value;
buf := char_Array1d_create(len);
if (radix > MAX_RADIX) or (radix < MIN_RADIX) then begin
radix := 10;
end;
if not negative then begin
valueCopy := -valueCopy;
end;
longRadix := long(radix);
longRadixNeg := -longRadix;
while valueCopy <= longRadixNeg do begin
buf[i] := getDigitRepresentation(int(-(valueCopy mod longRadix)));
dec(i);
valueCopy := valueCopy div longRadix;
end;
buf[i] := getDigitRepresentation(int(-valueCopy));
if negative then begin
dec(i);
buf[i] := '-';
end;
result := String_create(buf, i, len - i);
end;
function longToBinString(const value: long): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($40);
for i := $00 to $3f do begin
buf[i] := DIGITS[((value.ints[(i shr 5) xor $01] shr (i xor $1f)) and $01) + 1];
end;
result := String_create(buf, $00, $40);
end;
function longToHexString(const value: long): String;
var
i: int;
buf: char_Array1d;
begin
buf := char_Array1d_create($10);
for i := $00 to $0f do begin
buf[i] := DIGITS[((value.ints[(i shr 3) xor $01] shr ((i xor $07) shl 2)) and $0f) + 1];
end;
result := String_create(buf, $00, $10);
end;
{ mmx }
function mmxPack(const value: long): int; assembler; nostackframe;
asm
{ ВХОД: eax – value }
{ ВЫХОД: eax – результат }
movq xmm0, [eax]
packuswb xmm0, xmm0
movd eax, xmm0
end;
function mmxUnpackLo(value: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movd xmm0, eax
pxor xmm1, xmm1
punpcklbw xmm0, xmm1
movq [edx], xmm0
end;
function mmxUnpackHi(value: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movd xmm0, eax
pxor xmm1, xmm1
punpcklbw xmm1, xmm0
movq [edx], xmm1
end;
function mmxEquals(const relationship1, relationship2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
pcmpeqw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxGreate(const relationship1, relationship2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
pcmpgtw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxAdd(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
paddw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxAddS(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
paddsw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxAddUS(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
paddusw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxSub(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
psubw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxSubS(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
psubsw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxSubUS(const addendum1, addendum2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
psubusw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxMulLo(const multiplier1, multiplier2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
pmullw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxMulHi(const multiplier1, multiplier2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movq xmm0, [eax]
movq xmm1, [edx]
pmulhuw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxMulHiS(const multiplier1, multiplier2: long): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
{$IFDEF SSSE3}
movq xmm0, [eax]
movq xmm1, [edx]
pmulhrsw xmm0, xmm1
{$ELSE}
push dword $00000001
push dword $00000001
push dword $00000001
push dword $00000001
movq xmm0, [eax]
movdqu xmm1, xmm0
movq xmm2, [edx]
pmullw xmm0, xmm2
pmulhw xmm1, xmm2
punpcklwd xmm0, xmm1
psrad xmm0, $0e
movdqu xmm1, [esp]
paddd xmm0, xmm1
psrad xmm0, $01
pxor xmm1, xmm1
packssdw xmm0, xmm1
lea esp, [esp + $10]
{$ENDIF}
movq [ecx], xmm0
end;
function mmxSar(const multiplier: long; bits: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movq xmm0, [eax]
movd xmm1, edx
psraw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxShr(const multiplier: long; bits: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movq xmm0, [eax]
movd xmm1, edx
psrlw xmm0, xmm1
movq [ecx], xmm0
end;
function mmxShl(const multiplier: long; bits: int): long; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movq xmm0, [eax]
movd xmm1, edx
psllw xmm0, xmm1
movq [ecx], xmm0
end;
{ ultra }
function ultraBuild(short7, short6, short5, short4, short3, short2, short1, short0: int): ultra;
inline;
begin
result.shorts[0] := short(short0);
result.shorts[1] := short(short1);
result.shorts[2] := short(short2);
result.shorts[3] := short(short3);
result.shorts[4] := short(short4);
result.shorts[5] := short(short5);
result.shorts[6] := short(short6);
result.shorts[7] := short(short7);
end;
function ultraBuild(int3, int2, int1, int0: int): ultra; inline;
begin
result.ints[0] := int0;
result.ints[1] := int1;
result.ints[2] := int2;
result.ints[3] := int3;
end;
function ultraBuild(const hi, lo: long): ultra; inline;
begin
result.longs[0] := lo;
result.longs[1] := hi;
end;
function ultraByteSwap(const value: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
mov ecx, [eax + $00]
bswap ecx
mov [edx + $0c], ecx
mov ecx, [eax + $04]
bswap ecx
mov [edx + $08], ecx
mov ecx, [eax + $08]
bswap ecx
mov [edx + $04], ecx
mov ecx, [eax + $0c]
bswap ecx
mov [edx + $00], ecx
end;
function ultraEquals(const relationship1, relationship2: ultra): boolean; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2 }
{ ВЫХОД: eax – результат }
mov ecx, [eax + $0c]
cmp ecx, [edx + $0c]
jne @ne
mov ecx, [eax + $08]
cmp ecx, [edx + $08]
jne @ne
mov ecx, [eax + $04]
cmp ecx, [edx + $04]
jne @ne
mov ecx, [eax + $00]
cmp ecx, [edx + $00]
jne @ne
mov eax, true
ret
@ne: xor eax, eax
end;
function ultraOr(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
por xmm0, xmm1
movdqu [ecx], xmm0
end;
function ultraXor(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pxor xmm0, xmm1
movdqu [ecx], xmm0
end;
function ultraAnd(const multiplier1, multiplier2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pand xmm0, xmm1
movdqu [ecx], xmm0
end;
function ultraNot(const value: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
lea esp, [esp - $10]
mov ecx, $ffffffff
mov [esp + $00], ecx
mov [esp + $04], ecx
mov [esp + $08], ecx
mov [esp + $0c], ecx
movdqu xmm0, [eax]
movdqu xmm1, [esp]
pxor xmm0, xmm1
movdqu [edx], xmm0
lea esp, [esp + $10]
end;
{ sse – short operations }
function ssesPack(const value: ultra): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movdqu xmm0, [eax]
packuswb xmm0, xmm0
movq [edx], xmm0
end;
function ssesUnpackLo(const value: long): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movq xmm0, [eax]
pxor xmm1, xmm1
punpcklbw xmm0, xmm1
movdqu [edx], xmm0
end;
function ssesUnpackHi(const value: long): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movq xmm0, [eax]
pxor xmm1, xmm1
punpcklbw xmm1, xmm0
movdqu [edx], xmm1
end;
function ssesEquals(const relationship1, relationship2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pcmpeqw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesGreate(const relationship1, relationship2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pcmpgtw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesAdd(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
paddw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesAddS(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
paddsw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesAddUS(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
paddusw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesSub(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
psubw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesSubS(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
psubsw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesSubUS(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
psubusw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesMulLo(const multiplier1, multiplier2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pmullw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesMulHi(const multiplier1, multiplier2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pmulhuw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesMulHiS(const multiplier1, multiplier2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
{$IFDEF SSSE3}
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pmulhrsw xmm0, xmm1
{$ELSE}
push dword $00000001
push dword $00000001
push dword $00000001
push dword $00000001
movdqu xmm0, [eax]
movdqu xmm1, xmm0
movdqu xmm2, [edx]
pmullw xmm0, xmm2
pmulhw xmm1, xmm2
movdqu xmm2, xmm0
movdqu xmm3, xmm1
punpcklwd xmm0, xmm1
punpckhwd xmm2, xmm3
psrad xmm0, $0e
psrad xmm2, $0e
movdqu xmm1, [esp]
paddd xmm0, xmm1
paddd xmm2, xmm1
psrad xmm0, $01
psrad xmm2, $01
packssdw xmm0, xmm2
lea esp, [esp + $10]
{$ENDIF}
movdqu [ecx], xmm0
end;
function ssesSar(const multiplier: ultra; bits: int): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movdqu xmm0, [eax]
movd xmm1, edx
psraw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesShr(const multiplier: ultra; bits: int): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movdqu xmm0, [eax]
movd xmm1, edx
psrlw xmm0, xmm1
movdqu [ecx], xmm0
end;
function ssesShl(const multiplier: ultra; bits: int): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movdqu xmm0, [eax]
movd xmm1, edx
psllw xmm0, xmm1
movdqu [ecx], xmm0
end;
{ sse – int operations }
function sseiPack(const value: ultra): long; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
lea esp, [esp - $10]
mov ecx, $ffff8000
mov [esp + $00], ecx
mov [esp + $04], ecx
mov [esp + $08], ecx
mov [esp + $0c], ecx
movdqu xmm0, [eax]
movdqu xmm1, [esp]
paddd xmm0, xmm1
packssdw xmm0, xmm1
lea ecx, [ecx + $80010000]
mov [esp + $00], ecx
mov [esp + $04], ecx
movq xmm1, [esp]
paddw xmm0, xmm1
movq [edx], xmm0
lea esp, [esp + $10]
end;
function sseiUnpackLo(const value: long): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movq xmm0, [eax]
pxor xmm1, xmm1
punpcklwd xmm0, xmm1
movdqu [edx], xmm0
end;
function sseiUnpackHi(const value: long): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movq xmm0, [eax]
pxor xmm1, xmm1
punpcklwd xmm1, xmm0
movdqu [edx], xmm1
end;
function sseiEquals(const relationship1, relationship2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pcmpeqd xmm0, xmm1
movdqu [ecx], xmm0
end;
function sseiGreate(const relationship1, relationship2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
pcmpgtd xmm0, xmm1
movdqu [ecx], xmm0
end;
function sseiAdd(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
paddd xmm0, xmm1
movdqu [ecx], xmm0
end;
function sseiSub(const addendum1, addendum2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movdqu xmm0, [eax]
movdqu xmm1, [edx]
psubd xmm0, xmm1
movdqu [ecx], xmm0
end;
function sseiMulLo(const multiplier1, multiplier2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
push ebx
lea esp, [esp - $10]
xor ebx, ebx
mov [esp + $04], ebx
mov [esp + $0c], ebx
dec ebx
mov [esp + $00], ebx
mov [esp + $08], ebx
movdqu xmm0, [eax]
movdqu xmm1, [edx]
movdqu xmm2, xmm0
movdqu xmm3, xmm1
psrlq xmm2, $20
psrlq xmm3, $20
pmuludq xmm0, xmm1
pmuludq xmm2, xmm3
psllq xmm2, $20
movdqu xmm1, [esp]
pand xmm0, xmm1
por xmm0, xmm2
movdqu [ecx], xmm0
lea esp, [esp + $10]
pop ebx
end;
function sseiMulHi(const multiplier1, multiplier2: ultra): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
push ebx
lea esp, [esp - $10]
xor ebx, ebx
mov [esp + $00], ebx
mov [esp + $08], ebx
dec ebx
mov [esp + $04], ebx
mov [esp + $0c], ebx
movdqu xmm0, [eax]
movdqu xmm1, [edx]
movdqu xmm2, xmm0
movdqu xmm3, xmm1
psrlq xmm2, $20
psrlq xmm3, $20
pmuludq xmm0, xmm1
pmuludq xmm2, xmm3
psrlq xmm0, $20
movdqu xmm1, [esp]
pand xmm2, xmm1
por xmm0, xmm2
movdqu [ecx], xmm0
lea esp, [esp + $10]
pop ebx
end;
function sseiSar(const multiplier: ultra; bits: int): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movdqu xmm0, [eax]
movd xmm1, edx
psrad xmm0, xmm1
movdqu [ecx], xmm0
end;
function sseiShr(const multiplier: ultra; bits: int): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movdqu xmm0, [eax]
movd xmm1, edx
psrld xmm0, xmm1
movdqu [ecx], xmm0
end;
function sseiShl(const multiplier: ultra; bits: int): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier
edx – bits
ecx – результат }
movdqu xmm0, [eax]
movd xmm1, edx
pslld xmm0, xmm1
movdqu [ecx], xmm0
end;
{ float }
function floatToIntBits(value: float): int; inline;
begin
result := int((@value)^);
end;
{ double }
function doubleToLongBits(value: double): long; inline;
begin
result := long((@value)^);
end;
{ real }
function realBuild(exponent: int; significand: long): real; inline;
begin
RealRecord(result).significand := significand;
RealRecord(result).exponent := short(exponent);
end;
function realExtractSignificand(value: real): long; inline;
begin
result := RealRecord(value).significand;
end;
function realExtractExponent(value: real): int; inline;
begin
result := RealRecord(value).exponent;
end;
function realIsNaN(value: real): boolean; inline;
begin
result := realCmpl(value, value) <> 0;
end;
function realIsInfinity(value: real): boolean; assembler; nostackframe;
asm
{ ВХОД: tbyte [esp + $04] – value }
{ ВЫХОД: eax – результат }
fld tbyte [esp + $04]
fxam
fnstsw ax
ffree st(0)
fincstp
sahf
jz @notInfinity
jnp @notInfinity
jnc @notInfinity
mov eax, true
ret $0c
@notInfinity: xor eax, eax
end;
function realCmpl(relationship1, relationship2: real): int; assembler; nostackframe;
asm
{ ВХОД: tbyte [esp + $10] – relationship1
tbyte [esp + $04] – relationship2 }
{ ВЫХОД: eax – результат }
fld tbyte [esp + $04]
fld tbyte [esp + $10]
fcompp
fnstsw ax
sahf
jp @lt
je @eq
jb @lt
mov eax, $01
ret $18
@eq: xor eax, eax
ret $18
@lt: mov eax, -$01
end;
function realCmpg(relationship1, relationship2: real): int; assembler; nostackframe;
asm
{ ВХОД: tbyte [esp + $10] – relationship1
tbyte [esp + $04] – relationship2 }
{ ВЫХОД: eax – результат }
fld tbyte [esp + $04]
fld tbyte [esp + $10]
fcompp
fnstsw ax
sahf
jp @gt
je @eq
ja @gt
mov eax, -$01
ret $18
@eq: xor eax, eax
ret $18
@gt: mov eax, $01
end;
function realMod(dividend, divisor: real): real; assembler; nostackframe;
asm
{ ВХОД: tbyte [esp + $10] – dividend
tbyte [esp + $04] – divisor }
{ ВЫХОД: st(0) – результат }
fld tbyte [esp + $04]
fld tbyte [esp + $10]
@0: fprem
fnstsw ax
test ax, $0400
jnz @0
fstp st(1)
end;
function realToInt(value: real): int; assembler;
var
immediate: int;
asm
{ ВХОД: tbyte [value] – value }
{ ВЫХОД: eax – результат }
mov dword [immediate], $7fffffff
fld tbyte [value]
ficom dword [immediate]
fnstsw ax
sahf
jnp @0
ffree st(0)
fincstp
xor eax, eax
leave
ret $0c
@0: jbe @1
ffree st(0)
fincstp
mov eax, $7fffffff
leave
ret $0c
@1: fisttp dword [immediate]
mov eax, [immediate]
end;
function realToLong(value: real): long; assembler;
var
immediate: long;
asm
{ ВХОД: tbyte [value] – value
eax – результат }
fld tbyte [value]
mov dword [immediate + $00], $ffffffff
mov dword [immediate + $04], $7fffffff
fild qword [immediate]
fcomip st(0), st(1)
jnp @0
ffree st(0)
fincstp
mov dword [eax + $00], $00000000
mov dword [eax + $04], $00000000
leave
ret $0c
@0: ja @1
ffree st(0)
fincstp
mov dword [eax + $00], $ffffffff
mov dword [eax + $04], $7fffffff
leave
ret $0c
@1: fisttp qword [eax]
end;
function realToFloat(value: real): float; assembler;
var
immediate: float;
asm
{ ВХОД: tbyte [value] – value }
{ ВЫХОД: st(0) – результат }
fld tbyte [value]
fstp dword [immediate]
fld dword [immediate]
end;
function realToDouble(value: real): double; assembler;
var
immediate: double;
asm
{ ВХОД: tbyte [value] – value }
{ ВЫХОД: st(0) – результат }
fld tbyte [value]
fstp qword [immediate]
fld qword [immediate]
end;
function realToString(value: real): String;
begin
result := RealValueRepresenter.INSTANCE.toString(value);
end;
{ xvector }
function xvectorBuild(float3, float2, float1, float0: float): xvector; inline;
begin
result.floats[0] := float0;
result.floats[1] := float1;
result.floats[2] := float2;
result.floats[3] := float3;
end;
function xvectorEquals(const relationship1, relationship2: xvector): boolean; assembler;
nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2 }
{ ВЫХОД: eax – результат }
mov ecx, [eax + $0c]
cmp ecx, [edx + $0c]
jne @ne
mov ecx, [eax + $08]
cmp ecx, [edx + $08]
jne @ne
mov ecx, [eax + $04]
cmp ecx, [edx + $04]
jne @ne
mov ecx, [eax + $00]
cmp ecx, [edx + $00]
jne @ne
mov eax, true
ret
@ne: xor eax, eax
end;
{ sse – float operations }
function ssefConvertToVector(const value: ultra): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movdqu xmm0, [eax]
cvtdq2ps xmm0, xmm0
movups [edx], xmm0
end;
function ssefConvertToUltra(const value: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movups xmm0, [eax]
cvttps2dq xmm0, xmm0
movdqu [edx], xmm0
end;
function ssefCmpl(const relationship1, relationship2: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
cmpps xmm0, xmm1, $01
movdqu [ecx], xmm0
end;
function ssefCmpg(const relationship1, relationship2: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
cmpps xmm1, xmm0, $01
movdqu [ecx], xmm1
end;
function ssefCmpe(const relationship1, relationship2: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
cmpps xmm0, xmm1, $00
movdqu [ecx], xmm0
end;
function ssefCmpge(const relationship1, relationship2: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
cmpps xmm1, xmm0, $02
movdqu [ecx], xmm1
end;
function ssefCmple(const relationship1, relationship2: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
cmpps xmm0, xmm1, $02
movdqu [ecx], xmm0
end;
function ssefCmpne(const relationship1, relationship2: xvector): ultra; assembler; nostackframe;
asm
{ ВХОД: eax – relationship1
edx – relationship2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
cmpps xmm0, xmm1, $04
movdqu [ecx], xmm0
end;
function ssefAdd(const addendum1, addendum2: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
addps xmm0, xmm1
movups [ecx], xmm0
end;
function ssefSub(const addendum1, addendum2: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – addendum1
edx – addendum2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
subps xmm0, xmm1
movups [ecx], xmm0
end;
function ssefMul(const multiplier1, multiplier2: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – multiplier1
edx – multiplier2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
mulps xmm0, xmm1
movups [ecx], xmm0
end;
function ssefDiv(const dividend, divisor: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – dividend
edx – divisor
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
divps xmm0, xmm1
movups [ecx], xmm0
end;
function ssefMin(const value1, value2: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – value1
edx – value2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
minps xmm0, xmm1
movups [ecx], xmm0
end;
function ssefMax(const value1, value2: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – value1
edx – value2
ecx – результат }
movups xmm0, [eax]
movups xmm1, [edx]
maxps xmm0, xmm1
movups [ecx], xmm0
end;
function ssefReciproc(const value: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movups xmm0, [eax]
rcpps xmm0, xmm0
movups [edx], xmm0
end;
function ssefReciSqrt(const value: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movups xmm0, [eax]
rsqrtps xmm0, xmm0
movups [edx], xmm0
end;
function ssefSqrt(const value: xvector): xvector; assembler; nostackframe;
asm
{ ВХОД: eax – value
edx – результат }
movups xmm0, [eax]
sqrtps xmm0, xmm0
movups [edx], xmm0
end;
{ string }
function stringToUTF8(const s: UnicodeString): String;
var
char1: int;
char2: int;
code: int;
slen: int;
rlen: int;
i: int;
buf: char_Array1d;
begin
slen := length(s);
rlen := 0;
i := 1;
buf := char_Array1d_create(slen * 3);
while i <= slen do begin
char1 := int(s[i]);
inc(i);
if (char1 < $d800) or (char1 >= $e000) then begin
code := char1;
end else
if char1 >= $dc00 then begin
code := char1 and $03ff;
end else begin
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if (char2 < $dc00) or (char2 >= $e000) then begin
char2 := 0;
end else begin
inc(i);
end;
end;
code := (((char1 and $03ff) shl 10) + (char2 and $03ff)) + $010000;
end;
case code of
$000000..$00007f: begin
buf[rlen] := char(code);
inc(rlen);
end;
$000080..$0007ff: begin
buf[rlen] := char($c0 + (code shr 6));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
$000800..$00ffff: begin
buf[rlen] := char($e0 + (code shr 12));
inc(rlen);
buf[rlen] := char($80 + ((code shr 6) and $3f));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
$010000..$1fffff: begin
buf[rlen] := char($f0 + (code shr 18));
inc(rlen);
buf[rlen] := char($80 + ((code shr 12) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 6) and $3f));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
end;
end;
result := String_create(buf, 0, rlen);
end;
function stringToUTF16(const s: String): UnicodeString;
var
char1: int;
char2: int;
char3: int;
char4: int;
code: int;
slen: int;
rlen: int;
i: int;
buf: uchar_Array1d;
begin
slen := length(s);
rlen := 0;
i := 1;
buf := uchar_Array1d_create(slen shl 1);
while i <= slen do begin
char1 := int(s[i]);
inc(i);
case char1 of
$00..$7f: begin
{ $000000..$00007f }
buf[rlen] := uchar(char1);
inc(rlen);
end;
$c0..$df: begin
{ $000080..$0007ff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
buf[rlen] := uchar(((char1 and $1f) shl 6) or (char2 and $3f));
inc(rlen);
end;
$e0..$ef: begin
{ $000800..$00ffff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
char3 := 0;
if i <= slen then begin
char3 := int(s[i]);
if char3 and $c0 <> $80 then begin
char3 := 0;
end else begin
inc(i);
end;
end;
code := ((char1 and $0f) shl 12) or ((char2 and $3f) shl 6) or (char3 and $3f);
if (code < $d800) or (code >= $e000) then begin
buf[rlen] := uchar(code);
inc(rlen);
end;
end;
$f0..$f7: begin
{ $010000..$1fffff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
char3 := 0;
if i <= slen then begin
char3 := int(s[i]);
if char3 and $c0 <> $80 then begin
char3 := 0;
end else begin
inc(i);
end;
end;
char4 := 0;
if i <= slen then begin
char4 := int(s[i]);
if char4 and $c0 <> $80 then begin
char4 := 0;
end else begin
inc(i);
end;
end;
code := ((char1 and $07) shl 18) or ((char2 and $3f) shl 12) or
((char3 and $3f) shl 6) or (char4 and $3f);
if (code < $00d800) or (code >= $00e000) and (code < $010000) then begin
buf[rlen] := uchar(code);
inc(rlen);
end else
if (code >= $010000) and (code < $110000) then begin
code := code - $010000;
buf[rlen] := uchar($d800 or (code shr 10));
inc(rlen);
buf[rlen] := uchar($dc00 or (code and $03ff));
inc(rlen);
end;
end;
end;
end;
result := UnicodeString_create(buf, 0, rlen);
end;
function stringToCharArray(const s: String): char_Array1d;
var
len: int;
begin
len := length(s);
setLength(result, len);
System.move(s[1], result[0], len * sizeof(result[0]));
end;
function stringToCharArray(const s: UnicodeString): uchar_Array1d;
var
len: int;
begin
len := length(s);
setLength(result, len);
System.move(s[1], result[0], len * sizeof(result[0]));
end;
function stringToUpperCase(const s: String): String;
var
newString: boolean;
i: int;
c: int;
len: int;
buf: char_Array1d;
begin
newString := false;
buf := stringToCharArray(s);
len := length(buf);
for i := 0 to len - 1 do begin
c := int(buf[i]);
if (c >= int('a')) and (c <= int('z')) then begin
newString := true;
buf[i] := char(c - 32);
end;
end;
if newString then begin
result := String_create(buf, 0, len);
end else begin
result := s;
end;
end;
function stringToUpperCase(const s: UnicodeString): UnicodeString;
var
newString: boolean;
i: int;
c: int;
len: int;
buf: uchar_Array1d;
begin
newString := false;
buf := stringToCharArray(s);
len := length(buf);
for i := 0 to len - 1 do begin
c := int(buf[i]);
if (c >= int('a')) and (c <= int('z')) then begin
newString := true;
buf[i] := char(c - 32);
end;
end;
if newString then begin
result := UnicodeString_create(buf, 0, len);
end else begin
result := s;
end;
end;
function stringToLowerCase(const s: String): String;
var
newString: boolean;
i: int;
c: int;
len: int;
buf: char_Array1d;
begin
newString := false;
buf := stringToCharArray(s);
len := length(buf);
for i := 0 to len - 1 do begin
c := int(buf[i]);
if (c >= int('A')) and (c <= int('Z')) then begin
newString := true;
buf[i] := char(c + 32);
end;
end;
if newString then begin
result := String_create(buf, 0, len);
end else begin
result := s;
end;
end;
function stringToLowerCase(const s: UnicodeString): UnicodeString;
var
newString: boolean;
i: int;
c: int;
len: int;
buf: uchar_Array1d;
begin
newString := false;
buf := stringToCharArray(s);
len := length(buf);
for i := 0 to len - 1 do begin
c := int(buf[i]);
if (c >= int('A')) and (c <= int('Z')) then begin
newString := true;
buf[i] := char(c + 32);
end;
end;
if newString then begin
result := UnicodeString_create(buf, 0, len);
end else begin
result := s;
end;
end;
function stringToCharCodes(const s: String): int_Array1d;
var
char1: int;
char2: int;
char3: int;
char4: int;
char5: int;
char6: int;
slen: int;
rlen: int;
i: int;
buf: int_Array1d;
begin
slen := length(s);
rlen := 0;
i := 1;
buf := int_Array1d_create(slen);
while i <= slen do begin
char1 := int(s[i]);
inc(i);
case char1 of
$00..$7f: begin
{ $00000000..$0000007f }
buf[rlen] := char1;
inc(rlen);
end;
$c0..$df: begin
{ $00000080..$000007ff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
buf[rlen] := ((char1 and $1f) shl 6) or (char2 and $3f);
inc(rlen);
end;
$e0..$ef: begin
{ $00000800..$0000ffff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
char3 := 0;
if i <= slen then begin
char3 := int(s[i]);
if char3 and $c0 <> $80 then begin
char3 := 0;
end else begin
inc(i);
end;
end;
buf[rlen] := ((char1 and $0f) shl 12) or ((char2 and $3f) shl 6) or (char3 and $3f);
inc(rlen);
end;
$f0..$f7: begin
{ $00010000..$001fffff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
char3 := 0;
if i <= slen then begin
char3 := int(s[i]);
if char3 and $c0 <> $80 then begin
char3 := 0;
end else begin
inc(i);
end;
end;
char4 := 0;
if i <= slen then begin
char4 := int(s[i]);
if char4 and $c0 <> $80 then begin
char4 := 0;
end else begin
inc(i);
end;
end;
buf[rlen] := ((char1 and $07) shl 18) or ((char2 and $3f) shl 12) or
((char3 and $3f) shl 6) or (char4 and $3f);
inc(rlen);
end;
$f8..$fb: begin
{ $00200000..$03ffffff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
char3 := 0;
if i <= slen then begin
char3 := int(s[i]);
if char3 and $c0 <> $80 then begin
char3 := 0;
end else begin
inc(i);
end;
end;
char4 := 0;
if i <= slen then begin
char4 := int(s[i]);
if char4 and $c0 <> $80 then begin
char4 := 0;
end else begin
inc(i);
end;
end;
char5 := 0;
if i <= slen then begin
char5 := int(s[i]);
if char5 and $c0 <> $80 then begin
char5 := 0;
end else begin
inc(i);
end;
end;
buf[rlen] := ((char1 and $03) shl 24) or ((char2 and $3f) shl 18) or
((char3 and $3f) shl 12) or ((char4 and $3f) shl 6) or (char5 and $3f);
inc(rlen);
end;
$fc..$ff: begin
{ $04000000..$7fffffff }
{ $80000000..$ffffffff }
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if char2 and $c0 <> $80 then begin
char2 := 0;
end else begin
inc(i);
end;
end;
char3 := 0;
if i <= slen then begin
char3 := int(s[i]);
if char3 and $c0 <> $80 then begin
char3 := 0;
end else begin
inc(i);
end;
end;
char4 := 0;
if i <= slen then begin
char4 := int(s[i]);
if char4 and $c0 <> $80 then begin
char4 := 0;
end else begin
inc(i);
end;
end;
char5 := 0;
if i <= slen then begin
char5 := int(s[i]);
if char5 and $c0 <> $80 then begin
char5 := 0;
end else begin
inc(i);
end;
end;
char6 := 0;
if i <= slen then begin
char6 := int(s[i]);
if char6 and $c0 <> $80 then begin
char6 := 0;
end else begin
inc(i);
end;
end;
buf[rlen] := ((char1 and $03) shl 30) or ((char2 and $3f) shl 24) or
((char3 and $3f) shl 18) or ((char4 and $3f) shl 12) or
((char5 and $3f) shl 6) or (char6 and $3f);
inc(rlen);
end;
end;
end;
if rlen < slen then begin
result := int_Array1d_create(rlen);
arraycopyPrimitives(buf, 0, result, 0, rlen);
end else begin
result := buf;
end;
end;
function stringToCharCodes(const s: UnicodeString): int_Array1d;
var
char1: int;
char2: int;
code: int;
slen: int;
rlen: int;
i: int;
buf: int_Array1d;
begin
slen := length(s);
rlen := 0;
i := 1;
buf := int_Array1d_create(slen);
while i <= slen do begin
char1 := int(s[i]);
inc(i);
if (char1 < $d800) or (char1 >= $e000) then begin
code := char1;
end else
if char1 >= $dc00 then begin
code := char1 and $03ff;
end else begin
char2 := 0;
if i <= slen then begin
char2 := int(s[i]);
if (char2 < $dc00) or (char2 >= $e000) then begin
char2 := 0;
end else begin
inc(i);
end;
end;
code := (((char1 and $03ff) shl 10) + (char2 and $03ff)) + $010000;
end;
buf[rlen] := code;
inc(rlen);
end;
if rlen < slen then begin
result := int_Array1d_create(rlen);
arraycopyPrimitives(buf, 0, result, 0, rlen);
end else begin
result := buf;
end;
end;
function stringToByteArray(const s: String): byte_Array1d;
var
len: int;
begin
len := length(s);
setLength(result, len);
System.move(s[1], result[0], len * sizeof(result[0]));
end;
function stringToShortArray(const s: UnicodeString): short_Array1d;
var
len: int;
begin
len := length(s);
setLength(result, len);
System.move(s[1], result[0], len * sizeof(result[0]));
end;
function stringStartsWith(const prefix, s: String; position: int): boolean;
var
i: int;
j: int;
plen: int;
slen: int;
diff: int;
begin
result := false;
plen := length(prefix);
slen := length(s);
diff := slen - plen;
if (diff >= 0) and (position >= 1) and (position <= diff + 1) then begin
result := true;
j := position;
for i := 1 to plen do begin
if prefix[i] <> s[j] then begin
result := false;
break;
end;
inc(j);
end;
end;
end;
function stringStartsWith(const prefix, s: UnicodeString; position: int): boolean;
var
i: int;
j: int;
plen: int;
slen: int;
diff: int;
begin
result := false;
plen := length(prefix);
slen := length(s);
diff := slen - plen;
if (diff >= 0) and (position >= 1) and (position <= diff + 1) then begin
result := true;
j := position;
for i := 1 to plen do begin
if prefix[i] <> s[j] then begin
result := false;
break;
end;
inc(j);
end;
end;
end;
function stringStartsWith(const prefix, s: String): boolean;
begin
result := stringStartsWith(prefix, s, 1);
end;
function stringStartsWith(const prefix, s: UnicodeString): boolean;
begin
result := stringStartsWith(prefix, s, 1);
end;
function stringEndsWith(const suffix, s: String): boolean;
begin
result := stringStartsWith(suffix, s, length(s) - length(suffix) + 1);
end;
function stringEndsWith(const suffix, s: UnicodeString): boolean;
begin
result := stringStartsWith(suffix, s, length(s) - length(suffix) + 1);
end;
function stringTrim(const s: String): String;
var
i: int;
len: int;
sindex: int;
findex: int;
begin
len := length(s);
sindex := len + 1;
for i := 1 to len do begin
if int(s[i]) > 32 then begin
sindex := i;
break;
end;
end;
findex := 0;
for i := len downto 1 do begin
if int(s[i]) > 32 then begin
findex := i;
break;
end;
end;
if findex < sindex then begin
result := '';
end else
if (sindex = 1) and (findex = len) then begin
result := s;
end else begin
result := copy(s, sindex, findex - sindex + 1);
end;
end;
function stringTrim(const s: UnicodeString): UnicodeString;
var
i: int;
len: int;
sindex: int;
findex: int;
begin
len := length(s);
sindex := len + 1;
for i := 1 to len do begin
if int(s[i]) > 32 then begin
sindex := i;
break;
end;
end;
findex := 0;
for i := len downto 1 do begin
if int(s[i]) > 32 then begin
findex := i;
break;
end;
end;
if findex < sindex then begin
result := '';
end else
if (sindex = 1) and (findex = len) then begin
result := s;
end else begin
result := copy(s, sindex, findex - sindex + 1);
end;
end;
function stringCopy(const s: String): String;
begin
result := copy(s, 1, length(s));
end;
function stringCopy(const s: UnicodeString): UnicodeString;
begin
result := copy(s, 1, length(s));
end;
function stringGetHashCode(const s: String): int;
var
i: int;
c: int;
begin
result := 0;
c := length(s);
for i := 1 to c do begin
result := (31 * result) + int(s[i]);
end;
end;
function stringGetHashCode(const s: UnicodeString): int;
var
i: int;
c: int;
begin
result := 0;
c := length(s);
for i := 1 to c do begin
result := (31 * result) + int(s[i]);
end;
end;
function stringParseInt(const s: String): int;
begin
result := stringParseInt(s, 10);
end;
function stringParseInt(const s: String; radix: int): int;
var
negative: boolean;
i: int;
len: int;
digit: int;
limit: int;
mulmin: int;
immediate: int;
begin
len := length(s);
if len = 0 then begin
raise NumberFormatException.create(s);
end;
if (radix > MAX_RADIX) or (radix < MIN_RADIX) then begin
raise NumberFormatException.create(msgInvalidRadix);
end;
negative := false;
i := 1;
result := 0;
if s[i] = '-' then begin
negative := true;
limit := int($80000000);
inc(i);
end else begin
limit := int($80000001);
end;
mulmin := limit div radix;
if i <= len then begin
digit := getDigit(s[i], radix);
inc(i);
if digit < 0 then begin
raise NumberFormatException.create(s);
end;
result := -digit;
end;
while i <= len do begin
digit := getDigit(s[i], radix);
inc(i);
immediate := result * radix;
if (digit < 0) or (result < mulmin) or (immediate < limit + digit) then begin
raise NumberFormatException.create(s);
end;
result := immediate - digit;
end;
if negative then begin
if i <= 2 then begin
raise NumberFormatException.create(s);
end;
end else begin
result := -result;
end;
end;
function stringParseInt(const s: String; radix: int; default: int): int;
var
negative: boolean;
i: int;
len: int;
digit: int;
limit: int;
mulmin: int;
immediate: int;
begin
len := length(s);
if (len = 0) or (radix > MAX_RADIX) or (radix < MIN_RADIX) then begin
result := default;
exit;
end;
negative := false;
i := 1;
result := 0;
if s[i] = '-' then begin
negative := true;
limit := int($80000000);
inc(i);
end else begin
limit := int($80000001);
end;
mulmin := limit div radix;
if i <= len then begin
digit := getDigit(s[i], radix);
inc(i);
if digit < 0 then begin
result := default;
exit;
end;
result := -digit;
end;
while i <= len do begin
digit := getDigit(s[i], radix);
inc(i);
immediate := result * radix;
if (digit < 0) or (result < mulmin) or (immediate < limit + digit) then begin
result := default;
exit;
end;
result := immediate - digit;
end;
if negative then begin
if i <= 2 then begin
result := default;
end;
end else begin
result := -result;
end;
end;
function stringParseLong(const s: String): long;
begin
result := stringParseLong(s, 10);
end;
function stringParseLong(const s: String; radix: int): long;
var
negative: boolean;
i: int;
len: int;
digit: int;
limit: long;
mulmin: long;
immediate: long;
begin
len := length(s);
if len = 0 then begin
raise NumberFormatException.create(s);
end;
if (radix > MAX_RADIX) or (radix < MIN_RADIX) then begin
raise NumberFormatException.create(msgInvalidRadix);
end;
negative := false;
i := 1;
result := 0;
if s[i] = '-' then begin
negative := true;
limit := long($8000000000000000);
inc(i);
end else begin
limit := long($8000000000000001);
end;
mulmin := limit div long(radix);
if i <= len then begin
digit := getDigit(s[i], radix);
inc(i);
if digit < 0 then begin
raise NumberFormatException.create(s);
end;
result := long(-digit);
end;
while i <= len do begin
digit := getDigit(s[i], radix);
inc(i);
immediate := result * long(radix);
if (digit < 0) or (result < mulmin) or (immediate < limit + long(digit)) then begin
raise NumberFormatException.create(s);
end;
result := immediate - long(digit);
end;
if negative then begin
if i <= 2 then begin
raise NumberFormatException.create(s);
end;
end else begin
result := -result;
end;
end;
function stringParseLong(const s: String; radix: int; default: long): long;
var
negative: boolean;
i: int;
len: int;
digit: int;
limit: long;
mulmin: long;
immediate: long;
begin
len := length(s);
if (len = 0) or (radix > MAX_RADIX) or (radix < MIN_RADIX) then begin
result := default;
exit;
end;
negative := false;
i := 1;
result := 0;
if s[i] = '-' then begin
negative := true;
limit := long($8000000000000000);
inc(i);
end else begin
limit := long($8000000000000001);
end;
mulmin := limit div long(radix);
if i <= len then begin
digit := getDigit(s[i], radix);
inc(i);
if digit < 0 then begin
result := default;
exit;
end;
result := long(-digit);
end;
while i <= len do begin
digit := getDigit(s[i], radix);
inc(i);
immediate := result * long(radix);
if (digit < 0) or (result < mulmin) or (immediate < limit + long(digit)) then begin
result := default;
exit;
end;
result := immediate - long(digit);
end;
if negative then begin
if i <= 2 then begin
result := default;
end;
end else begin
result := -result;
end;
end;
function stringParseReal(const s: String): real;
label
label0;
var
negative: boolean;
c: char;
order: int;
frac: int;
len: int;
i: int;
ucs: String;
begin
len := length(s);
if len = 0 then begin
raise NumberFormatException.create(s);
end;
ucs := stringToUpperCase(s);
if ('+INF' = ucs) or ('INF' = ucs) then begin
result := Math.POS_INF;
exit;
end;
if '-INF' = ucs then begin
result := Math.NEG_INF;
exit;
end;
if 'NAN' = ucs then begin
result := Math.NAN;
exit;
end;
negative := false;
order := 0;
frac := 0;
i := 1;
result := 0.000;
case s[i] of
'-': begin
negative := true;
inc(i);
end;
'+', ' ': begin
inc(i);
end;
end;
if i <= len then begin
c := s[i];
end else begin
c := #0;
end;
if (c >= '0') and (c <= '9') or (c = '.') then begin
if c = '.' then begin
goto label0;
end;
result := int(c) - int('0');
end else begin
raise NumberFormatException.create(s);
end;
inc(i);
repeat
if i > len then begin
break;
end;
c := s[i];
if (c < '0') or (c > '9') then begin
break;
end;
result := (10.000 * result) + (int(c) - int('0'));
inc(i);
until false;
label0:
if (i <= len) and (s[i] = '.') then begin
inc(i);
repeat
if i > len then begin
break;
end;
c := s[i];
if (c < '0') or (c > '9') then begin
break;
end;
result := (10.000 * result) + (int(c) - int('0'));
inc(frac);
inc(i);
until false;
end;
if negative then begin
result := -result;
negative := false;
end;
if i <= len then begin
c := s[i];
end else begin
c := #0;
end;
if (c = 'E') or (c = 'e') then begin
inc(i);
if i > len then begin
raise NumberFormatException.create(s);
end;
case s[i] of
'-': begin
negative := true;
inc(i);
end;
'+': begin
inc(i);
end;
end;
if i > len then begin
raise NumberFormatException.create(s);
end;
repeat
if i > len then begin
break;
end;
c := s[i];
if (c < '0') or (c > '9') then begin
break;
end;
order := (10 * order) + (int(c) - int('0'));
if order > 9999 then begin
raise NumberFormatException.create(s);
end;
inc(i);
until false;
if negative then begin
order := -order;
end;
end;
result := RealValueRepresenter.pow10(result, order - frac);
if (i <= len) or realIsInfinity(result) then begin
raise NumberFormatException.create(s);
end;
end;
function stringParseReal(const s: String; default: real): real;
label
label0;
var
negative: boolean;
c: char;
order: int;
frac: int;
len: int;
i: int;
ucs: String;
begin
len := length(s);
if len = 0 then begin
result := default;
exit;
end;
ucs := stringToUpperCase(s);
if ('+INF' = ucs) or ('INF' = ucs) then begin
result := Math.POS_INF;
exit;
end;
if '-INF' = ucs then begin
result := Math.NEG_INF;
exit;
end;
if 'NAN' = ucs then begin
result := Math.NAN;
exit;
end;
negative := false;
order := 0;
frac := 0;
i := 1;
result := 0.000;
case s[i] of
'-': begin
negative := true;
inc(i);
end;
'+', ' ': begin
inc(i);
end;
end;
if i <= len then begin
c := s[i];
end else begin
c := #0;
end;
if (c >= '0') and (c <= '9') or (c = '.') then begin
if c = '.' then begin
goto label0;
end;
result := int(c) - int('0');
end else begin
result := default;
exit;
end;
inc(i);
repeat
if i > len then begin
break;
end;
c := s[i];
if (c < '0') or (c > '9') then begin
break;
end;
result := (10.000 * result) + (int(c) - int('0'));
inc(i);
until false;
label0:
if (i <= len) and (s[i] = '.') then begin
inc(i);
repeat
if i > len then begin
break;
end;
c := s[i];
if (c < '0') or (c > '9') then begin
break;
end;
result := (10.000 * result) + (int(c) - int('0'));
inc(frac);
inc(i);
until false;
end;
if negative then begin
result := -result;
negative := false;
end;
if i <= len then begin
c := s[i];
end else begin
c := #0;
end;
if (c = 'E') or (c = 'e') then begin
inc(i);
if i > len then begin
result := default;
exit;
end;
case s[i] of
'-': begin
negative := true;
inc(i);
end;
'+': begin
inc(i);
end;
end;
if i > len then begin
result := default;
exit;
end;
repeat
if i > len then begin
break;
end;
c := s[i];
if (c < '0') or (c > '9') then begin
break;
end;
order := (10 * order) + (int(c) - int('0'));
if order > 9999 then begin
result := default;
exit;
end;
inc(i);
until false;
if negative then begin
order := -order;
end;
end;
result := RealValueRepresenter.pow10(result, order - frac);
if (i <= len) or realIsInfinity(result) then begin
result := default;
end;
end;
{$IF DEFINED(WINDOWS)}
function stringParseCommandLine(): UnicodeString_Array1d;
var
f: boolean;
i: int;
c: int;
l: int;
b: int;
r: UnicodeString;
s: UnicodeString;
begin
s := UnicodeString(getCommandLine());
f := false;
c := 0;
l := length(s);
for i := 1 to l do begin
if s[i] = '"' then begin
f := f = false;
end;
if (f = false) and (i > 1) and (s[i - 1] > #$20) and (s[i] = #$20) then begin
inc(c);
end;
end;
if (l > 0) and (s[l] > #$20) then begin
inc(c);
end;
result := UnicodeString_Array1d_create(c);
f := false;
c := 0;
b := 0;
for i := 1 to l do begin
if (f = false) and (s[i] > #$20) and ((i > 1) and (s[i - 1] = #$20) or (i = 1)) then begin
b := i;
end;
if s[i] = '"' then begin
f := f = false;
end;
if (f = false) and (s[i] > #$20) and ((i < l) and (s[i + 1] = #$20) or (i = l)) then begin
if s[i] = '"' then begin
result[c] := copy(s, b + 1, i - b - 1);
end else begin
result[c] := copy(s, b, i - b + 1);
end;
inc(c);
end;
end;
if c > 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;
{$ELSEIF DEFINED(GO32V2)}
function stringParseCommandLine(): UnicodeString_Array1d;
var
i: int;
c: int;
a: PPChar;
r: UnicodeString;
begin
c := argc;
a := argv;
result := UnicodeString_Array1d_create(c);
for i := c - 1 downto 0 do begin
result[i] := stringToUTF16(String(a[i]));
end;
if c > 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;
{$ELSE}
function stringParseCommandLine(): UnicodeString_Array1d;
var
i: int;
c: int;
a: PPChar;
begin
c := argc;
a := argv;
result := UnicodeString_Array1d_create(c);
for i := c - 1 downto 0 do begin
result[i] := stringToUTF16(String(a[i]));
end;
end;
{$ENDIF}
{ long – operators }
operator :=(const value: long): byte; inline;
begin
result := value.bytes[0];
end;
operator :=(const value: long): short; inline;
begin
result := value.shorts[0];
end;
operator :=(const value: long): int; inline;
begin
result := value.ints[0];
end;
operator :=(const value: long): int64; inline;
begin
result := value.native;
end;
operator :=(const value: long): float; inline;
begin
result := realToFloat(longToReal(value));
end;
operator :=(const value: long): double; inline;
begin
result := realToDouble(longToReal(value));
end;
operator :=(const value: long): real; inline;
begin
result := longToReal(value);
end;
operator :=(const value: int64): long; inline;
begin
result.native := value;
end;
operator =(const relationship1, relationship2: long): boolean; inline;
begin
result := longEquals(relationship1, relationship2);
end;
operator <(const relationship1, relationship2: long): boolean; inline;
begin
result := longGreate(relationship2, relationship1);
end;
operator >(const relationship1, relationship2: long): boolean; inline;
begin
result := longGreate(relationship1, relationship2);
end;
operator <=(const relationship1, relationship2: long): boolean; inline;
begin
result := not longGreate(relationship1, relationship2);
end;
operator >=(const relationship1, relationship2: long): boolean; inline;
begin
result := not longGreate(relationship2, relationship1);
end;
operator <>(const relationship1, relationship2: long): boolean; inline;
begin
result := not longEquals(relationship1, relationship2);
end;
operator +(const addendum1, addendum2: long): long; inline;
begin
result := longAdd(addendum1, addendum2);
end;
operator -(const addendum1, addendum2: long): long; inline;
begin
result := longSub(addendum1, addendum2);
end;
operator *(const multiplier1, multiplier2: long): long; inline;
begin
result := longMul(multiplier1, multiplier2);
end;
operator /(const multiplier1, multiplier2: long): real; inline;
begin
result := longToReal(multiplier1) / longToReal(multiplier2);
end;
operator +(const value: long): long; inline;
begin
result := value;
end;
operator -(const value: long): long; inline;
begin
result := longNeg(value);
end;
operator or(const addendum1, addendum2: long): long; inline;
begin
result := longOr(addendum1, addendum2);
end;
operator xor(const addendum1, addendum2: long): long; inline;
begin
result := longXor(addendum1, addendum2);
end;
operator and(const multiplier1, multiplier2: long): long; inline;
begin
result := longAnd(multiplier1, multiplier2);
end;
operator shr(const multiplier: long; bits: int): long; inline;
begin
result := longShr(multiplier, bits);
end;
operator shl(const multiplier: long; bits: int): long; inline;
begin
result := longShl(multiplier, bits);
end;
operator div(const dividend, divisor: long): long; inline;
begin
result := longDiv(dividend, divisor);
end;
operator mod(const dividend, divisor: long): long; inline;
begin
result := longMod(dividend, divisor);
end;
operator not(const value: long): long; inline;
begin
result := longNot(value);
end;
operator inc(const value: long): long; inline;
begin
result := longAdd(value, 1);
end;
operator inc(const delta, value: long): long; inline;
begin
result := longAdd(value, delta);
end;
operator dec(const value: long): long; inline;
begin
result := longSub(value, 1);
end;
operator dec(const delta, value: long): long; inline;
begin
result := longSub(value, delta);
end;
{ ultra – operators }
operator :=(const value: ultra): byte; inline;
begin
result := value.bytes[0];
end;
operator :=(const value: ultra): short; inline;
begin
result := value.shorts[0];
end;
operator :=(const value: ultra): int; inline;
begin
result := value.ints[0];
end;
operator :=(const value: ultra): int64; inline;
begin
result := value.longs[0].native;
end;
operator :=(const value: ultra): long; inline;
begin
result := value.longs[0];
end;
operator :=(const value: int64): ultra; inline;
begin
result.longs[0].native := value;
result.longs[1].native := 0;
end;
operator :=(const value: long): ultra; inline;
begin
result.longs[0] := value;
result.longs[1].native := 0;
end;
operator =(const relationship1, relationship2: ultra): boolean; inline;
begin
result := ultraEquals(relationship1, relationship2);
end;
operator <>(const relationship1, relationship2: ultra): boolean; inline;
begin
result := not ultraEquals(relationship1, relationship2);
end;
operator or(const addendum1, addendum2: ultra): ultra; inline;
begin
result := ultraOr(addendum1, addendum2);
end;
operator xor(const addendum1, addendum2: ultra): ultra; inline;
begin
result := ultraXor(addendum1, addendum2);
end;
operator and(const multiplier1, multiplier2: ultra): ultra; inline;
begin
result := ultraAnd(multiplier1, multiplier2);
end;
operator not(const value: ultra): ultra; inline;
begin
result := ultraNot(value);
end;
{ vector operators }
operator :=(const value: xvector): real; inline;
begin
result := value.floats[0];
end;
operator :=(const value: xvector): ultra; inline;
begin
result := ssefConvertToUltra(value);
end;
operator :=(const value: byte): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: short): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: int): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: int64): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: long): xvector; inline;
begin
result.floats[0] := value.native;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: float): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: double): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: real): xvector; inline;
begin
result.floats[0] := value;
result.floats[1] := 0;
result.floats[2] := 0;
result.floats[3] := 0;
end;
operator :=(const value: ultra): xvector; inline;
begin
result := ssefConvertToVector(value);
end;
operator =(const relationship1, relationship2: xvector): boolean; inline;
begin
result := xvectorEquals(relationship1, relationship2);
end;
operator <>(const relationship1, relationship2: xvector): boolean; inline;
begin
result := not xvectorEquals(relationship1, relationship2);
end;
{ := operators }
operator :=(const intf: TGuid): _Interface; inline;
begin
result := IntfInfoAsObject.create(intf);
end;
operator :=(const intf: TGuid): _Class; inline;
begin
result := IntfInfoAsObject.create(intf);
end;
operator :=(const cls: TClass): _Interface; inline;
begin
result := ClassInfoAsObject.create(cls);
end;
operator :=(const cls: TClass): _Class; inline;
begin
result := ClassInfoAsObject.create(cls);
end;
{ array1d_create by length }
function boolean_Array1d_create(length: int): boolean_Array1d;
begin
setLength(result, length);
end;
function char_Array1d_create(length: int): char_Array1d;
begin
setLength(result, length);
end;
function uchar_Array1d_create(length: int): uchar_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 ultra_Array1d_create(length: int): ultra_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 xvector_Array1d_create(length: int): xvector_Array1d;
begin
setLength(result, length);
end;
function Object_Array1d_create(length: int): Object_Array1d;
begin
setLength(result, length);
end;
function Interface_Array1d_create(length: int): Interface_Array1d;
begin
setLength(result, length);
end;
function String_Array1d_create(length: int): String_Array1d;
begin
setLength(result, length);
end;
function UnicodeString_Array1d_create(length: int): UnicodeString_Array1d;
begin
setLength(result, length);
end;
{ array2d_create by length }
function boolean_Array2d_create(length: int): boolean_Array2d;
begin
setLength(result, length);
end;
function char_Array2d_create(length: int): char_Array2d;
begin
setLength(result, length);
end;
function uchar_Array2d_create(length: int): uchar_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 ultra_Array2d_create(length: int): ultra_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 xvector_Array2d_create(length: int): xvector_Array2d;
begin
setLength(result, length);
end;
function Object_Array2d_create(length: int): Object_Array2d;
begin
setLength(result, length);
end;
function Interface_Array2d_create(length: int): Interface_Array2d;
begin
setLength(result, length);
end;
function String_Array2d_create(length: int): String_Array2d;
begin
setLength(result, length);
end;
function UnicodeString_Array2d_create(length: int): UnicodeString_Array2d;
begin
setLength(result, length);
end;
{ array2d_create by length1, length2 }
function boolean_Array2d_create(length1, length2: int): boolean_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function char_Array2d_create(length1, length2: int): char_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function uchar_Array2d_create(length1, length2: int): uchar_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function byte_Array2d_create(length1, length2: int): byte_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function short_Array2d_create(length1, length2: int): short_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function int_Array2d_create(length1, length2: int): int_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function long_Array2d_create(length1, length2: int): long_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function ultra_Array2d_create(length1, length2: int): ultra_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function float_Array2d_create(length1, length2: int): float_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function double_Array2d_create(length1, length2: int): double_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function real_Array2d_create(length1, length2: int): real_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function xvector_Array2d_create(length1, length2: int): xvector_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function Object_Array2d_create(length1, length2: int): Object_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function Interface_Array2d_create(length1, length2: int): Interface_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function String_Array2d_create(length1, length2: int): String_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
function UnicodeString_Array2d_create(length1, length2: int): UnicodeString_Array2d;
var
i: int;
begin
setLength(result, length1);
for i := length1 - 1 downto 0 do begin
setLength(result[i], length2);
end;
end;
{ array1d_create by elements }
function boolean_Array1d_create(const elements: array of boolean): boolean_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function char_Array1d_create(const elements: array of char): char_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function uchar_Array1d_create(const elements: array of uchar): uchar_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function byte_Array1d_create(const elements: array of byte): byte_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function short_Array1d_create(const elements: array of short): short_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function int_Array1d_create(const elements: array of int): int_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function long_Array1d_create(const elements: array of long): long_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function ultra_Array1d_create(const elements: array of ultra): ultra_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function float_Array1d_create(const elements: array of float): float_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function double_Array1d_create(const elements: array of double): double_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function real_Array1d_create(const elements: array of real): real_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function xvector_Array1d_create(const elements: array of xvector): xvector_Array1d;
var
count: int;
begin
count := length(elements);
setLength(result, count);
System.move(elements[0], result[0], count * sizeof(result[0]));
end;
function Object_Array1d_create(const elements: array of TObject): Object_Array1d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function Interface_Array1d_create(const elements: array of IUnknown): Interface_Array1d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function String_Array1d_create(const elements: array of String): String_Array1d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function UnicodeString_Array1d_create(
const elements: array of UnicodeString): UnicodeString_Array1d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
{ array2d_create by elements }
function boolean_Array2d_create(const elements: array of boolean_Array1d): boolean_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function char_Array2d_create(const elements: array of char_Array1d): char_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function uchar_Array2d_create(const elements: array of uchar_Array1d): uchar_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function byte_Array2d_create(const elements: array of byte_Array1d): byte_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function short_Array2d_create(const elements: array of short_Array1d): short_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function int_Array2d_create(const elements: array of int_Array1d): int_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function long_Array2d_create(const elements: array of long_Array1d): long_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function ultra_Array2d_create(const elements: array of ultra_Array1d): ultra_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function float_Array2d_create(const elements: array of float_Array1d): float_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function double_Array2d_create(const elements: array of double_Array1d): double_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function real_Array2d_create(const elements: array of real_Array1d): real_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function xvector_Array2d_create(const elements: array of xvector_Array1d): xvector_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function Object_Array2d_create(const elements: array of Object_Array1d): Object_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function Interface_Array2d_create(const elements: array of Interface_Array1d): Interface_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function String_Array2d_create(const elements: array of String_Array1d): String_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
function UnicodeString_Array2d_create(
const elements: array of UnicodeString_Array1d): UnicodeString_Array2d;
var
i: int;
count: int;
begin
count := length(elements);
setLength(result, count);
for i := count - 1 downto 0 do begin
result[i] := elements[i];
end;
end;
{ String constructors }
function String_build(const charCodes: int_Array1d): String;
var
code: int;
clen: int;
rlen: int;
i: int;
buf: char_Array1d;
begin
clen := length(charCodes);
rlen := 0;
i := 0;
buf := char_Array1d_create(6 * clen);
for i := 0 to clen - 1 do begin
code := charCodes[i];
case code of
$00000000..$0000007f: begin
buf[rlen] := char(code);
inc(rlen);
end;
$00000080..$000007ff: begin
buf[rlen] := char($c0 + (code shr 6));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
$00000800..$0000ffff: begin
buf[rlen] := char($e0 + (code shr 12));
inc(rlen);
buf[rlen] := char($80 + ((code shr 6) and $3f));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
$00010000..$001fffff: begin
buf[rlen] := char($f0 + (code shr 18));
inc(rlen);
buf[rlen] := char($80 + ((code shr 12) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 6) and $3f));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
$00200000..$03ffffff: begin
buf[rlen] := char($f8 + (code shr 24));
inc(rlen);
buf[rlen] := char($80 + ((code shr 18) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 12) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 6) and $3f));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
else
buf[rlen] := char($f8 + (code shr 30));
inc(rlen);
buf[rlen] := char($80 + ((code shr 24) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 18) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 12) and $3f));
inc(rlen);
buf[rlen] := char($80 + ((code shr 6) and $3f));
inc(rlen);
buf[rlen] := char($80 + (code and $3f));
inc(rlen);
end;
end;
result := String_create(buf, 0, rlen);
end;
function String_create(length: int): String;
begin
setLength(result, length);
end;
function String_create(const src: char_Array1d; offset, length: int): String;
var
lim: int;
len: int;
begin
lim := offset + length;
len := System.length(src);
if (lim > len) or (lim < offset) or (offset > len) or (offset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
setLength(result, length);
System.move(src[offset], result[1], length * sizeof(result[1]));
end;
function String_create(const src: byte_Array1d; offset, length: int): String;
var
lim: int;
len: int;
begin
lim := offset + length;
len := System.length(src);
if (lim > len) or (lim < offset) or (offset > len) or (offset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
setLength(result, length);
System.move(src[offset], result[1], length * sizeof(result[1]));
end;
{ UnicodeString constructors }
function UnicodeString_build(const charCodes: int_Array1d): UnicodeString;
var
code: int;
clen: int;
rlen: int;
i: int;
buf: uchar_Array1d;
begin
clen := length(charCodes);
rlen := 0;
i := 0;
buf := uchar_Array1d_create(clen shl 1);
for i := 0 to clen - 1 do begin
code := charCodes[i];
case code of
$000000..$00d7ff, $00e000..$00ffff: begin
buf[rlen] := uchar(code);
inc(rlen);
end;
$010000..$10ffff: begin
dec(code, $010000);
buf[rlen] := uchar($d800 or (code shr $000a));
inc(rlen);
buf[rlen] := uchar($dc00 or (code and $03ff));
inc(rlen);
end;
end;
end;
result := UnicodeString_create(buf, 0, rlen);
end;
function UnicodeString_create(length: int): UnicodeString;
begin
setLength(result, length);
end;
function UnicodeString_create(const src: uchar_Array1d; offset, length: int): UnicodeString;
var
lim: int;
len: int;
begin
lim := offset + length;
len := System.length(src);
if (lim > len) or (lim < offset) or (offset > len) or (offset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
setLength(result, length);
System.move(src[offset], result[1], length * sizeof(result[1]));
end;
function UnicodeString_create(const src: short_Array1d; offset, length: int): UnicodeString;
var
lim: int;
len: int;
begin
lim := offset + length;
len := System.length(src);
if (lim > len) or (lim < offset) or (offset > len) or (offset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
setLength(result, length);
System.move(src[offset], result[1], length * sizeof(result[1]));
end;
{ arraycopy }
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(const src: char_Array1d; srcOffset: int;
const dst: char_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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(const src: uchar_Array1d; srcOffset: int;
const dst: uchar_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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(const src: ultra_Array1d; srcOffset: int;
const dst: ultra_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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyPrimitives(const src: xvector_Array1d; srcOffset: int;
const dst: xvector_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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
System.move(src[srcOffset], dst[dstOffset], length * sizeof(dst[0]));
end;
procedure arraycopyStrings(const src: String_Array1d; srcOffset: int;
const dst: String_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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
if (src = dst) and (srcOffset < dstOffset) then begin
inc(dstOffset, length);
inc(srcOffset, length);
for i := length - 1 downto 0 do begin
dec(dstOffset);
dec(srcOffset);
dst[dstOffset] := src[srcOffset];
end;
end else begin
dec(length);
for i := 0 to length do begin
dst[dstOffset] := src[srcOffset];
inc(dstOffset);
inc(srcOffset);
end;
end;
end;
procedure arraycopyUnicodeStrings(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 > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
if (src = dst) and (srcOffset < dstOffset) then begin
inc(dstOffset, length);
inc(srcOffset, length);
for i := length - 1 downto 0 do begin
dec(dstOffset);
dec(srcOffset);
dst[dstOffset] := src[srcOffset];
end;
end else begin
dec(length);
for i := 0 to length do begin
dst[dstOffset] := src[srcOffset];
inc(dstOffset);
inc(srcOffset);
end;
end;
end;
procedure arraycopyObjects(const src; srcOffset: int; const dst; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(Object_Array1d(src));
if (lim > len) or (lim < srcOffset) or (srcOffset > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(Object_Array1d(dst));
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
if (Object_Array1d(src) = Object_Array1d(dst)) and (srcOffset < dstOffset) then begin
inc(dstOffset, length);
inc(srcOffset, length);
for i := length - 1 downto 0 do begin
dec(dstOffset);
dec(srcOffset);
Object_Array1d(dst)[dstOffset] := Object_Array1d(src)[srcOffset];
end;
end else begin
dec(length);
for i := 0 to length do begin
Object_Array1d(dst)[dstOffset] := Object_Array1d(src)[srcOffset];
inc(dstOffset);
inc(srcOffset);
end;
end;
end;
procedure arraycopyInterfaces(const src; srcOffset: int; const dst; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(Interface_Array1d(src));
if (lim > len) or (lim < srcOffset) or (srcOffset > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(Interface_Array1d(dst));
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
if (Interface_Array1d(src) = Interface_Array1d(dst)) and (srcOffset < dstOffset) then begin
inc(dstOffset, length);
inc(srcOffset, length);
for i := length - 1 downto 0 do begin
dec(dstOffset);
dec(srcOffset);
Interface_Array1d(dst)[dstOffset] := Interface_Array1d(src)[srcOffset];
end;
end else begin
dec(length);
for i := 0 to length do begin
Interface_Array1d(dst)[dstOffset] := Interface_Array1d(src)[srcOffset];
inc(dstOffset);
inc(srcOffset);
end;
end;
end;
procedure arraycopyArrays(const src; srcOffset: int; const dst; dstOffset: int; length: int);
var
lim: int;
len: int;
i: int;
begin
lim := srcOffset + length;
len := System.length(byte_Array2d(src));
if (lim > len) or (lim < srcOffset) or (srcOffset > len) or (srcOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
lim := dstOffset + length;
len := System.length(byte_Array2d(dst));
if (lim > len) or (lim < dstOffset) or (dstOffset > len) or (dstOffset < 0) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
if (byte_Array2d(src) = byte_Array2d(dst)) and (srcOffset < dstOffset) then begin
inc(dstOffset, length);
inc(srcOffset, length);
for i := length - 1 downto 0 do begin
dec(dstOffset);
dec(srcOffset);
byte_Array2d(dst)[dstOffset] := byte_Array2d(src)[srcOffset];
end;
end else begin
dec(length);
for i := 0 to length do begin
byte_Array2d(dst)[dstOffset] := byte_Array2d(src)[srcOffset];
inc(dstOffset);
inc(srcOffset);
end;
end;
end;
initialization
FPU.clinit();
SSE.clinit();
RealValueRepresenter.clinit();
finalization
RealValueRepresenter.cldone();
end.
