{
Utils – содержит классы для работы с элементарными типами данных как с объектами,
хэш-таблицами, векторами, датой и временем, календарями.
Copyright © 2017 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Меньшей Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Меньшей Стандартной
общественной лицензии GNU.
Вы должны были получить копию Меньшей Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit Utils;
{$MODE OBJFPC}
interface
uses
Lang,
{$IF DEFINED(GO32V2)} IntfGo32
{$ELSEIF DEFINED(WINDOWS)} IntfWin
{$ENDIF};
{$ASMMODE INTEL,CALLING REGISTER,INLINE ON,GOTO ON}
{$H+,I-,J-,M-,Q-,R-,T-}
type
Enumeration = interface;
BooleanAsObject = interface;
CharAsObject = interface;
UCharAsObject = interface;
IntegerAsObject = interface;
LongAsObject = interface;
UltraAsObject = interface;
FloatAsObject = interface;
DoubleAsObject = interface;
RealAsObject = interface;
XVectorAsObject = interface;
StringAsObject = interface;
UnicodeStringAsObject = interface;
Hashtable = class;
Vector = class;
Stack = class;
DateTime = class;
TimeZone = class;
Calendar = class;
ExtendedCalendar = class;
JulianCalendar = class;
GregorianCalendar = class;
NoSuchElementException = class;
EmptyStackException = class;
Enumeration = interface(_Interface) ['{AB9B4D27-2302-4FD0-BD7B-E4AA2420558C}']
function hasMoreElements(): boolean;
function nextElement(): _Interface;
end;
BooleanAsObject = interface(_Interface) ['{BE57986A-5F30-459A-B8CD-E0888E02DA00}']
function booleanValue(): boolean;
end;
CharAsObject = interface(_Interface) ['{BE57986A-5F30-459A-B8CD-E0888E02DA01}']
function charValue(): char;
end;
UCharAsObject = interface(_Interface) ['{BE57986A-5F30-459A-B8CD-E0888E02DA02}']
function ucharValue(): uchar;
end;
IntegerAsObject = interface(_Interface) ['{BE57986A-5F30-459A-B8CD-E0888E02DA14}']
function byteValue(): int;
function shortValue(): int;
function intValue(): int;
end;
LongAsObject = interface(IntegerAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA18}']
function nativeValue(): int64;
function longValue(): long;
end;
UltraAsObject = interface(LongAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA1F}']
function getShort(index: int): int;
function getInt(index: int): int;
function ultraValue(): ultra;
end;
FloatAsObject = interface(LongAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA24}']
function floatValue(): float;
end;
DoubleAsObject = interface(FloatAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA28}']
function doubleValue(): double;
end;
RealAsObject = interface(DoubleAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA2A}']
function realValue(): real;
end;
XVectorAsObject = interface(RealAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA2F}']
function getFloat(index: int): float;
function xvectorValue(): xvector;
end;
StringAsObject = interface(_Interface) ['{BE57986A-5F30-459A-B8CD-E0888E02DA31}']
function stringValue(): AnsiString;
end;
UnicodeStringAsObject = interface(StringAsObject) ['{BE57986A-5F30-459A-B8CD-E0888E02DA32}']
function unicodeStringValue(): UnicodeString;
end;
Hashtable = class(RefCountInterfacedObject)
strict private
type Entry = class(_Object)
public
constructor create(hash: int; key, value: _Interface; next: Entry);
destructor destroy; override;
public
nextf: boolean;
hash: int;
key: _Interface;
value: _Interface;
next: Entry;
end;
type Entry_Array1d = packed array of Entry;
protected
type Enumerator = class(RefCountInterfacedObject, Enumeration)
public
constructor create(keys: boolean; const table: Entry_Array1d);
function hasMoreElements(): boolean; virtual;
function nextElement(): _Interface; virtual;
strict private
keys: boolean;
index: int;
entryf: Entry;
table: Entry_Array1d;
end;
public
constructor create(); overload;
constructor create(initialCapacity: int); overload;
destructor destroy; override;
function toString(): AnsiString; override;
procedure clear(); virtual;
function isEmpty(): boolean; virtual;
function contains(value: _Interface): boolean; virtual;
function containsKey(key: _Interface): boolean; virtual;
function size(): int; virtual;
function remove(key: _Interface): _Interface; virtual;
function get(key: _Interface): _Interface; virtual;
function put(key, value: _Interface): _Interface; virtual;
function keys(): Enumeration; virtual;
function elements(): Enumeration; virtual;
protected
procedure rehash(); virtual;
strict private
factor: int;
length: int;
table: Entry_Array1d;
end;
Vector = class(RefCountInterfacedObject)
protected
type _Interface_Array1d = packed array of _Interface;
type Enumerator = class(RefCountInterfacedObject, Enumeration)
public
constructor create(thisVector: Vector);
function hasMoreElements(): boolean; virtual;
function nextElement(): _Interface; virtual;
strict private
thisVector: Vector;
index: int;
end;
public
constructor create(); overload;
constructor create(initialCapacity: int); overload;
function toString(): AnsiString; override;
procedure clear(); virtual;
procedure trimToSize(); virtual;
procedure copyInto(const destination: Interface_Array1d); virtual;
procedure ensureCapacity(minimumCapacity: int); virtual;
procedure removeElementAt(index: int); virtual;
procedure insertElementAt(index: int; element: _Interface); virtual;
procedure setElementAt(index: int; element: _Interface); virtual;
procedure addElement(element: _Interface); virtual;
procedure setSize(newSize: int); virtual;
function isEmpty(): boolean; virtual;
function contains(element: _Interface): boolean; virtual;
function removeElement(element: _Interface): boolean; virtual;
function capacity(): int; virtual;
function size(): int; virtual;
function indexOf(element: _Interface): int; overload; virtual;
function indexOf(element: _Interface; fromIndex: int): int; overload; virtual;
function lastIndexOf(element: _Interface): int; overload; virtual;
function lastIndexOf(element: _Interface; fromIndex: int): int; overload; virtual;
function firstElement(): _Interface; virtual;
function lastElement(): _Interface; virtual;
function elementAt(index: int): _Interface; virtual;
function elements(): Enumeration; virtual;
protected
elementCount: int;
elementData: _Interface_Array1d;
private
function ensureCapacityHelper(minimumCapacity: int): _Interface_Array1d;
end;
Stack = class(Vector)
public
constructor create(); overload;
constructor create(initialCapacity: int); overload;
function pop(): _Interface; virtual;
function peek(): _Interface; virtual;
procedure push(element: _Interface); virtual;
end;
DateTime = class(RefCountInterfacedObject)
public
constructor create(internalRepresentation: long); overload;
constructor create(year, month, day, hour, minute, second, millisecond: int); overload;
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
strict private
{
внутреннее представление даты и времени:
┌───────┬───┬───┬───┬───┬───────┐
│ год │мес│чис│час│мин│миллис.│ – поля
├───┬───┼───┼───┼───┼───┼───┬───┤
│ 7 │ 6 │ 5 │ 4 │ 3 │ 2 │ 1 │ 0 │ – байты
├───┴───┼───┴───┼───┴───┼───┴───┤
│ 3 │ 2 │ 1 │ 0 │ – слова
└───────┴───────┴───────┴───────┘
}
fieldInternalRepresentation: long;
procedure setByte(index, value: int);
procedure setWord(index, value: int);
procedure setSecond(value: int);
procedure setMillisecond(value: int);
function getByte(index: int): int;
function getWord(index: int): int;
function getSecond(): int;
function getMillisecond(): int;
published
property year: int index 3
read getWord
write setWord
stored false;
property month: int index 5
read getByte
write setByte
stored false;
property day: int index 4
read getByte
write setByte
stored false;
property hour: int index 3
read getByte
write setByte
stored false;
property minute: int index 2
read getByte
write setByte
stored false;
property second: int
read getSecond
write setSecond
stored false;
property millisecond: int
read getMillisecond
write setMillisecond
stored false;
property nativeRepresentation: int64
read fieldInternalRepresentation.native
write fieldInternalRepresentation.native
default 0;
end;
TimeZone = class(_Object)
public
class function getCurrentOffsetInMillis(): int;
end;
Calendar = class(RefCountInterfacedObject)
public
{ индексы полей }
const FIELD_MILLIS = 0;
const FIELD_SECOND = 1;
const FIELD_MINUTE = 2;
const FIELD_HOUR_OF_DAY = 3;
const FIELD_HOUR = 4;
const FIELD_AM_PM = 5;
const FIELD_DAY_OF_WEEK = 6;
const FIELD_DAY = 7;
const FIELD_MONTH = 8;
const FIELD_YEAR = 9;
const FIELD_ARRAY_LENGTH = 10;
{ до/после полудня }
const AM = 0;
const PM = 1;
{ дни недели }
const MONDAY = 1;
const TUESDAY = 2;
const WEDNESDAY = 3;
const THURSDAY = 4;
const FRIDAY = 5;
const SATURDAY = 6;
const SUNDAY = 0;
{ месяцы }
const JANUARY = 1;
const FEBRUARY = 2;
const MARCH = 3;
const APRIL = 4;
const MAY = 5;
const JUNE = 6;
const JULY = 7;
const AUGUST = 8;
const SEPTEMBER = 9;
const OCTOBER = 10;
const NOVEMBER = 11;
const DECEMBER = 12;
public
constructor create(); overload;
constructor create(offsetInMillis: int; time: DateTime); overload;
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
procedure setOffsetInMillis(offsetInMillis: int); virtual;
function before(when: Calendar): boolean; virtual;
function after(when: Calendar): boolean; virtual;
function getOffsetInMillis(): int; virtual;
procedure getTime(dst: DateTime);
procedure setTime(src: DateTime);
procedure setField(field, value: int);
procedure setTimeInMillis(timeInMillis: long);
function getField(field: int): int;
function getTimeInMillis(): long;
protected
timeInMillis: long;
isSet: boolean_Array1d;
fields: int_Array1d;
procedure computeFields(); virtual; abstract;
procedure computeTimeInMillis(); virtual; abstract;
procedure computeHourOfDay(); virtual;
procedure computeHour(); virtual;
strict private
timeSet: boolean;
offsetInMillis: int;
end;
ExtendedCalendar = class(Calendar)
public
function isLeapYear(year: int): boolean; virtual; abstract;
function getNumOfDays(year, month: int): int; virtual; abstract;
function getDayOfWeek(year, month, day: int): int; virtual; abstract;
function getInternalRepresentation(time: long;
offsetInMillis: int): long; virtual; abstract;
function getTime(internalRepresentation: long;
offsetInMillis: int): long; overload; virtual; abstract;
function getTime(year, month, day, hour, minute, second, millis,
offsetInMillis: int): long; overload; virtual; abstract;
end;
JulianCalendar = class(ExtendedCalendar)
private
class var DAYS: byte_Array2d;
class procedure clinit();
class procedure cldone();
public
function isLeapYear(year: int): boolean; override; final;
function getNumOfDays(year, month: int): int; override; final;
function getDayOfWeek(year, month, day: int): int; override; final;
function getInternalRepresentation(time: long;
offsetInMillis: int): long; override; final;
function getTime(internalRepresentation: long;
offsetInMillis: int): long; overload; override; final;
function getTime(year, month, day, hour, minute, second, millis,
offsetInMillis: int): long; overload; override; final;
protected
procedure computeFields(); override; final;
procedure computeTimeInMillis(); override; final;
end;
GregorianCalendar = class(ExtendedCalendar)
public
function isLeapYear(year: int): boolean; override; final;
function getNumOfDays(year, month: int): int; override; final;
function getDayOfWeek(year, month, day: int): int; override; final;
function getInternalRepresentation(time: long;
offsetInMillis: int): long; override; final;
function getTime(internalRepresentation: long;
offsetInMillis: int): long; overload; override; final;
function getTime(year, month, day, hour, minute, second, millis,
offsetInMillis: int): long; overload; override; final;
protected
procedure computeFields(); override; final;
procedure computeTimeInMillis(); override; final;
end;
NoSuchElementException = class(RuntimeException);
EmptyStackException = class(RuntimeException);
resourcestring
msgNoSuchElement = 'Больше не осталось элементов для перечисления.';
msgEmptyStack = 'Стек пуст.';
operator :=(const value: boolean): _Interface;
operator :=(const value: char): _Interface;
operator :=(const value: uchar): _Interface;
operator :=(const value: byte): _Interface;
operator :=(const value: short): _Interface;
operator :=(const value: int): _Interface;
operator :=(const value: int64): _Interface;
operator :=(const value: long): _Interface;
operator :=(const value: ultra): _Interface;
operator :=(const value: float): _Interface;
operator :=(const value: double): _Interface;
operator :=(const value: real): _Interface;
operator :=(const value: xvector): _Interface;
operator :=(const value: AnsiString): _Interface;
operator :=(const value: UnicodeString): _Interface;
operator :=(const value: boolean): BooleanAsObject;
operator :=(const value: char): CharAsObject;
operator :=(const value: uchar): UCharAsObject;
operator :=(const value: byte): IntegerAsObject;
operator :=(const value: short): IntegerAsObject;
operator :=(const value: int): IntegerAsObject;
operator :=(const value: int64): LongAsObject;
operator :=(const value: long): LongAsObject;
operator :=(const value: ultra): UltraAsObject;
operator :=(const value: float): FloatAsObject;
operator :=(const value: double): DoubleAsObject;
operator :=(const value: real): RealAsObject;
operator :=(const value: xvector): XVectorAsObject;
operator :=(const value: AnsiString): StringAsObject;
operator :=(const value: UnicodeString): UnicodeStringAsObject;
implementation
type
BooleanVal = class;
NumericVal = class;
IntegerVal = class;
LongVal = class;
UltraVal = class;
RealVal = class;
XVectorVal = class;
CharVal = class;
UCharVal = class;
StringVal = class;
UStringVal = class;
BooleanVal = class(RefCountInterfacedObject, BooleanAsObject)
private
class var FALSE: BooleanAsObject;
class var TRUE: BooleanAsObject;
class procedure clinit();
class procedure cldone();
public
constructor create(value: boolean);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function booleanValue(): boolean; virtual;
private
value: boolean;
end;
NumericVal = class(RefCountInterfacedObject, IntegerAsObject, LongAsObject,
FloatAsObject, DoubleAsObject, RealAsObject)
public
constructor create();
function byteValue(): int; virtual;
function shortValue(): int; virtual;
function intValue(): int; virtual; abstract;
function nativeValue(): int64; virtual; abstract;
function longValue(): long; virtual; abstract;
function floatValue(): float; virtual; abstract;
function doubleValue(): double; virtual; abstract;
function realValue(): real; virtual; abstract;
end;
IntegerVal = class(NumericVal)
public
constructor create(value: int);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function intValue(): int; override;
function nativeValue(): int64; override;
function longValue(): long; override;
function floatValue(): float; override;
function doubleValue(): double; override;
function realValue(): real; override;
private
int0: int;
end;
LongVal = class(IntegerVal)
public
constructor create(const value: long); overload;
constructor create(const value: int64); overload;
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function nativeValue(): int64; override;
function longValue(): long; override;
function floatValue(): float; override;
function doubleValue(): double; override;
function realValue(): real; override;
private
int1: int;
function long0(): long;
end;
UltraVal = class(IntegerVal, UltraAsObject)
public
constructor create(const value: ultra);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function nativeValue(): int64; override;
function longValue(): long; override;
function getShort(index: int): int; virtual;
function getInt(index: int): int; virtual;
function ultraValue(): ultra; virtual;
private
int1: int;
long1: long;
function long0(): long;
function ultra0(): ultra;
end;
RealVal = class(NumericVal)
public
constructor create(const value: real);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function intValue(): int; override;
function nativeValue(): int64; override;
function longValue(): long; override;
function floatValue(): float; override;
function doubleValue(): double; override;
function realValue(): real; override;
private
value: real;
end;
XVectorVal = class(NumericVal, XVectorAsObject)
public
constructor create(const value: xvector);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function intValue(): int; override;
function nativeValue(): int64; override;
function longValue(): long; override;
function floatValue(): float; override;
function doubleValue(): double; override;
function realValue(): real; override;
function getFloat(index: int): float; virtual;
function xvectorValue(): xvector; virtual;
private
value: xvector;
end;
CharVal = class(RefCountInterfacedObject, CharAsObject)
public
constructor create(value: char);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function charValue(): char; virtual;
private
value: char;
end;
UCharVal = class(RefCountInterfacedObject, UCharAsObject)
public
constructor create(value: uchar);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function ucharValue(): uchar; virtual;
private
value: uchar;
end;
StringVal = class(RefCountInterfacedObject, StringAsObject, UnicodeStringAsObject)
public
constructor create(const value: AnsiString);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function stringValue(): AnsiString; virtual;
function unicodeStringValue(): UnicodeString; virtual;
private
value: AnsiString;
end;
UStringVal = class(RefCountInterfacedObject, StringAsObject, UnicodeStringAsObject)
public
constructor create(const value: UnicodeString);
function equals(obj: TObject): boolean; override;
function getHashCode(): int; override;
function toString(): AnsiString; override;
function stringValue(): AnsiString; virtual;
function unicodeStringValue(): UnicodeString; virtual;
private
value: UnicodeString;
end;
{ Hashtable.Entry }
constructor Hashtable.Entry.create(hash: int; key, value: _Interface; next: Entry);
begin
inherited create();
self.nextf := true;
self.hash := hash;
self.key := key;
self.value := value;
self.next := next;
end;
destructor Hashtable.Entry.destroy;
begin
if nextf then begin
next.free();
end;
inherited destroy;
end;
{ Hashtable.Enumerator }
constructor Hashtable.Enumerator.create(keys: boolean; const table: Entry_Array1d);
begin
inherited create();
self.keys := keys;
self.index := System.length(table);
self.entryf := nil;
self.table := table;
end;
function Hashtable.Enumerator.hasMoreElements(): boolean;
var
i: int;
e: Entry;
t: Entry_Array1d;
begin
if entryf <> nil then begin
result := true;
exit;
end;
t := table;
for i := index - 1 downto 0 do begin
e := t[i];
entryf := e;
if e <> nil then begin
index := i;
result := true;
exit;
end;
end;
index := -1;
result := false;
end;
function Hashtable.Enumerator.nextElement(): _Interface;
label
label0;
var
i: int;
e: Entry;
t: Entry_Array1d;
begin
if entryf = nil then begin
t := table;
for i := index - 1 downto 0 do begin
e := t[i];
entryf := e;
if e <> nil then begin
index := i;
goto label0;
end;
end;
index := -1;
end;
label0:
e := entryf;
if e = nil then begin
raise NoSuchElementException.create(msgNoSuchElement);
end;
entryf := e.next;
if keys then begin
result := e.key;
end else begin
result := e.value;
end;
end;
{ Hashtable }
constructor Hashtable.create();
begin
create($0f);
end;
constructor Hashtable.create(initialCapacity: int);
begin
inherited create();
if initialCapacity <= 0 then begin
initialCapacity := 1;
end;
self.factor := (initialCapacity * 3) shr 2;
self.length := 0;
self.table := Entry_Array1d(Object_Array1d_create(initialCapacity));
end;
destructor Hashtable.destroy;
var
i: int;
t: Entry_Array1d;
begin
t := table;
for i := System.length(t) - 1 downto 0 do begin
t[i].free();
end;
inherited destroy;
end;
function Hashtable.toString(): AnsiString;
var
i: int;
k: Enumeration;
e: Enumeration;
t: Entry_Array1d;
begin
t := table;
k := Enumerator.create(true, t);
e := Enumerator.create(false, t);
result := '{';
for i := length - 1 downto 0 do begin
result := result + (k.nextElement().toString() + '=' + e.nextElement().toString());
if i > 0 then begin
result := result + ', ';
end;
end;
result := result + '}';
end;
procedure Hashtable.clear();
var
i: int;
t: Entry_Array1d;
begin
t := table;
for i := System.length(t) - 1 downto 0 do begin
t[i].free();
t[i] := nil;
end;
length := 0;
end;
function Hashtable.isEmpty(): boolean;
begin
result := length = 0;
end;
function Hashtable.contains(value: _Interface): boolean;
var
i: int;
e: Entry;
t: Entry_Array1d;
begin
if value = nil then begin
result := false;
exit;
end;
t := table;
for i := System.length(t) - 1 downto 0 do begin
e := t[i];
while e <> nil do begin
if value.equals(e.value as TObject) then begin
result := true;
exit;
end;
e := e.next;
end;
end;
result := false;
end;
function Hashtable.containsKey(key: _Interface): boolean;
var
hash: int;
e: Entry;
t: Entry_Array1d;
begin
if key = nil then begin
result := false;
exit;
end;
hash := key.getHashCode();
t := table;
e := t[(hash and MAX_INT) mod System.length(t)];
while e <> nil do begin
if (hash = e.hash) and (key.equals(e.key as TObject)) then begin
result := true;
exit;
end;
e := e.next;
end;
result := false;
end;
function Hashtable.size(): int;
begin
result := length;
end;
function Hashtable.remove(key: _Interface): _Interface;
var
hash: int;
i: int;
e: Entry;
f: Entry;
t: Entry_Array1d;
begin
if key = nil then begin
result := nil;
exit;
end;
hash := key.getHashCode();
t := table;
i := (hash and MAX_INT) mod System.length(t);
f := nil;
e := t[i];
while e <> nil do begin
if (hash = e.hash) and (key.equals(e.key as TObject)) then begin
result := e.value;
if f <> nil then begin
f.next := e.next;
end else begin
t[i] := e.next;
end;
e.nextf := false;
e.free();
dec(length);
exit;
end;
f := e;
e := e.next;
end;
result := nil;
end;
function Hashtable.get(key: _Interface): _Interface;
var
hash: PtrInt;
e: Entry;
t: Entry_Array1d;
begin
if key = nil then begin
result := nil;
exit;
end;
hash := key.getHashCode();
t := table;
e := t[(hash and MAX_INT) mod System.length(t)];
while e <> nil do begin
if (hash = e.hash) and (key.equals(e.key as TObject)) then begin
result := e.value;
exit;
end;
e := e.next;
end;
result := nil;
end;
function Hashtable.put(key, value: _Interface): _Interface;
var
hash: PtrInt;
i: int;
l: int;
e: Entry;
t: Entry_Array1d;
begin
if (key = nil) or (value = nil) then begin
result := nil;
exit;
end;
hash := key.getHashCode();
t := table;
i := (hash and MAX_INT) mod System.length(t);
e := t[i];
while e <> nil do begin
if (hash = e.hash) and (key.equals(e.key as TObject)) then begin
result := e.value;
e.value := value;
exit;
end;
e := e.next;
end;
l := length;
if l >= factor then begin
rehash();
t := table;
i := (hash and MAX_INT) mod System.length(t);
end;
t[i] := Entry.create(hash, key, value, t[i]);
length := l + 1;
result := nil;
end;
function Hashtable.keys(): Enumeration;
begin
result := Enumerator.create(true, table);
end;
function Hashtable.elements(): Enumeration;
begin
result := Enumerator.create(false, table);
end;
procedure Hashtable.rehash();
var
i: int;
j: int;
nc: int;
oc: int;
e: Entry;
f: Entry;
nt: Entry_Array1d;
ot: Entry_Array1d;
begin
ot := table;
oc := System.length(ot);
nc := (oc shl 1) + 1;
nt := Entry_Array1d(Object_Array1d_create(nc));
table := nt;
factor := (nc * 3) shr 2;
for i := oc - 1 downto 0 do begin
f := ot[i];
while f <> nil do begin
e := f;
j := (e.hash and MAX_INT) mod nc;
f := f.next;
e.next := nt[j];
nt[j] := e;
end;
end;
end;
{ Vector.Enumerator }
constructor Vector.Enumerator.create(thisVector: Vector);
begin
inherited create();
self.thisVector := thisVector;
self.index := 0;
end;
function Vector.Enumerator.hasMoreElements(): boolean;
begin
result := index < thisVector.elementCount;
end;
function Vector.Enumerator.nextElement(): _Interface;
var
i: int;
vect: Vector;
begin
i := index;
vect := thisVector;
if i >= vect.elementCount then begin
raise NoSuchElementException.create(msgNoSuchElement);
end;
index := i + 1;
result := vect.elementData[i];
end;
{ Vector }
constructor Vector.create();
begin
create($0f);
end;
constructor Vector.create(initialCapacity: int);
begin
inherited create();
if initialCapacity <= 0 then begin
initialCapacity := 1;
end;
self.elementCount := 0;
self.elementData := _Interface_Array1d(Interface_Array1d_create(initialCapacity));
end;
function Vector.toString(): AnsiString;
var
i: int;
c: int;
e: _Interface;
d: _Interface_Array1d;
begin
result := '[';
c := elementCount - 1;
d := elementData;
for i := 0 to c do begin
e := d[i];
if e <> nil then begin
result := result + e.toString();
end else begin
result := result + 'null';
end;
if i < c then begin
result := result + ', ';
end;
end;
result := result + ']';
end;
procedure Vector.clear();
var
i: int;
d: _Interface_Array1d;
begin
d := elementData;
for i := elementCount - 1 downto 0 do begin
d[i] := nil;
end;
elementCount := 0;
end;
procedure Vector.trimToSize();
var
c: int;
od: _Interface_Array1d;
nd: _Interface_Array1d;
begin
c := elementCount;
od := elementData;
if c < length(od) then begin
nd := _Interface_Array1d(Interface_Array1d_create(c));
arraycopyInterfaces(od, 0, nd, 0, c);
elementData := nd;
end;
end;
procedure Vector.copyInto(const destination: Interface_Array1d);
var
i: int;
d: _Interface_Array1d;
begin
d := elementData;
for i := Math.min(elementCount, length(destination)) - 1 downto 0 do begin
destination[i] := d[i];
end;
end;
procedure Vector.ensureCapacity(minimumCapacity: int);
begin
if minimumCapacity > length(elementData) then begin
ensureCapacityHelper(minimumCapacity);
end;
end;
procedure Vector.removeElementAt(index: int);
var
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount - 1;
if (index < 0) or (index > c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
d := elementData;
i := c - index;
if i > 0 then begin
arraycopyInterfaces(d, index + 1, d, index, i);
end;
d[c] := nil;
elementCount := c;
end;
procedure Vector.insertElementAt(index: int; element: _Interface);
var
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount;
if (index < 0) or (index > c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
d := elementData;
if c = length(d) then begin
d := ensureCapacityHelper(c + 1);
end;
i := c - index;
if i > 0 then begin
arraycopyInterfaces(d, index, d, index + 1, i);
end;
d[index] := element;
elementCount := c + 1;
end;
procedure Vector.setElementAt(index: int; element: _Interface);
begin
if (index < 0) or (index >= elementCount) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
elementData[index] := element;
end;
procedure Vector.addElement(element: _Interface);
var
c: int;
d: _Interface_Array1d;
begin
c := elementCount;
d := elementData;
if c = length(d) then begin
d := ensureCapacityHelper(c + 1);
end;
d[c] := element;
elementCount := c + 1;
end;
procedure Vector.setSize(newSize: int);
var
i: int;
c: int;
d: _Interface_Array1d;
begin
d := elementData;
if newSize < 0 then begin
newSize := 0;
end;
if newSize > length(d) then begin
d := ensureCapacityHelper(newSize);
end;
c := elementCount;
if newSize >= c then begin
for i := newSize - 1 downto c do begin
d[i] := nil;
end;
end else begin
for i := c - 1 downto newSize do begin
d[i] := nil;
end;
end;
elementCount := newSize;
end;
function Vector.isEmpty(): boolean;
begin
result := elementCount <= 0;
end;
function Vector.contains(element: _Interface): boolean;
var
i: int;
d: _Interface_Array1d;
begin
d := elementData;
if element = nil then begin
for i := elementCount - 1 downto 0 do begin
if d[i] = nil then begin
result := true;
exit;
end;
end;
end else begin
for i := elementCount - 1 downto 0 do begin
if element.equals(d[i] as TObject) then begin
result := true;
exit;
end;
end;
end;
result := false;
end;
function Vector.removeElement(element: _Interface): boolean;
label
label0;
var
index: int;
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount - 1;
d := elementData;
begin
if element = nil then begin
for i := 0 to c do begin
if d[i] = nil then begin
index := i;
goto label0;
end;
end;
end else begin
for i := 0 to c do begin
if element.equals(d[i] as TObject) then begin
index := i;
goto label0;
end;
end;
end;
result := false;
exit;
end;
label0:
i := c - index;
if i > 0 then begin
arraycopyInterfaces(d, index + 1, d, index, i);
end;
d[c] := nil;
elementCount := c;
result := true;
end;
function Vector.capacity(): int;
begin
result := length(elementData);
end;
function Vector.size(): int;
begin
result := elementCount;
end;
function Vector.indexOf(element: _Interface): int;
var
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount - 1;
d := elementData;
if element = nil then begin
for i := 0 to c do begin
if d[i] = nil then begin
result := i;
exit;
end;
end;
end else begin
for i := 0 to c do begin
if element.equals(d[i] as TObject) then begin
result := i;
exit;
end;
end;
end;
result := -1;
end;
function Vector.indexOf(element: _Interface; fromIndex: int): int;
var
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount - 1;
d := elementData;
if fromIndex < 0 then begin
fromIndex := 0;
end;
if element = nil then begin
for i := fromIndex to c do begin
if d[i] = nil then begin
result := i;
exit;
end;
end;
end else begin
for i := fromIndex to c do begin
if element.equals(d[i] as TObject) then begin
result := i;
exit;
end;
end;
end;
result := -1;
end;
function Vector.lastIndexOf(element: _Interface): int;
var
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount - 1;
d := elementData;
if element = nil then begin
for i := c downto 0 do begin
if d[i] = nil then begin
result := i;
exit;
end;
end;
end else begin
for i := c downto 0 do begin
if element.equals(d[i] as TObject) then begin
result := i;
exit;
end;
end;
end;
result := -1;
end;
function Vector.lastIndexOf(element: _Interface; fromIndex: int): int;
var
i: int;
c: int;
d: _Interface_Array1d;
begin
c := elementCount - 1;
d := elementData;
if fromIndex > c then begin
fromIndex := c;
end;
if element = nil then begin
for i := fromIndex downto 0 do begin
if d[i] = nil then begin
result := i;
exit;
end;
end;
end else begin
for i := fromIndex downto 0 do begin
if element.equals(d[i] as TObject) then begin
result := i;
exit;
end;
end;
end;
result := -1;
end;
function Vector.firstElement(): _Interface;
begin
if elementCount <= 0 then begin
raise NoSuchElementException.create(msgNoSuchElement);
end;
result := elementData[0];
end;
function Vector.lastElement(): _Interface;
var
c: int;
begin
c := elementCount;
if c <= 0 then begin
raise NoSuchElementException.create(msgNoSuchElement);
end;
result := elementData[c - 1];
end;
function Vector.elementAt(index: int): _Interface;
begin
if (index < 0) or (index >= elementCount) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := elementData[index];
end;
function Vector.elements(): Enumeration;
begin
result := Enumerator.create(self);
end;
function Vector.ensureCapacityHelper(minimumCapacity: int): _Interface_Array1d;
var
oc: int;
nc: int;
d: _Interface_Array1d;
begin
d := elementData;
oc := length(d);
nc := (oc shl 1) + 1;
if nc < minimumCapacity then begin
nc := minimumCapacity;
end;
result := _Interface_Array1d(Interface_Array1d_create(nc));
arraycopyInterfaces(d, 0, result, 0, elementCount);
elementData := result;
end;
{ Stack }
constructor Stack.create();
begin
inherited create();
end;
constructor Stack.create(initialCapacity: int);
begin
inherited create(initialCapacity);
end;
function Stack.pop(): _Interface;
var
index: int;
begin
index := size() - 1;
if index < 0 then begin
raise EmptyStackException.create(msgEmptyStack);
end;
result := elementAt(index);
removeElementAt(index);
end;
function Stack.peek(): _Interface;
var
index: int;
begin
index := size() - 1;
if index < 0 then begin
raise EmptyStackException.create(msgEmptyStack);
end;
result := elementAt(index);
end;
procedure Stack.push(element: _Interface);
begin
addElement(element);
end;
{ DateTime }
constructor DateTime.create(year, month, day, hour, minute, second, millisecond: int);
begin
create(longBuild((year shl 16) or ((month and $ff) shl 8) or (day and $ff),
(hour shl 24) or ((minute and $ff) shl 16) or
((second * 1000 + millisecond) and $ffff)));
end;
constructor DateTime.create(internalRepresentation: long);
begin
inherited create();
self.fieldInternalRepresentation := internalRepresentation;
end;
function DateTime.equals(obj: TObject): boolean;
begin
result := (obj = self) or (obj is DateTime) and
(fieldInternalRepresentation = DateTime(obj).fieldInternalRepresentation);
end;
function DateTime.getHashCode(): int;
var
value: long;
begin
value := fieldInternalRepresentation;
result := value.ints[0] xor value.ints[1];
end;
function DateTime.toString(): AnsiString;
var
y: int;
m: int;
d: int;
hrs: int;
min: int;
sec: int;
msc: int;
word0: int;
reprs: long;
cares: char_Array1d;
begin
reprs := fieldInternalRepresentation;
word0 := reprs.shorts[0] and $ffff;
y := reprs.shorts[3] and $ffff;
m := reprs.bytes[5] and $ff;
d := reprs.bytes[4] and $ff;
hrs := reprs.bytes[3] and $ff;
min := reprs.bytes[2] and $ff;
sec := word0 div 1000;
msc := word0 mod 1000;
cares := char_Array1d_create([
'-', DIGITS[(m div 10) + 1], DIGITS[(m mod 10) + 1],
'-', DIGITS[(d div 10) + 1], DIGITS[(d mod 10) + 1],
' ', DIGITS[(hrs div 10) + 1], DIGITS[(hrs mod 10) + 1],
':', DIGITS[(min div 10) + 1], DIGITS[(min mod 10) + 1],
':', DIGITS[(sec div 10) + 1], DIGITS[(sec mod 10) + 1],
'.', DIGITS[(msc div 100) + 1], DIGITS[((msc div 10) mod 10) + 1],
DIGITS[(msc mod 10) + 1] ]);
result := intToString(y) + String_create(cares, 0, length(cares));
end;
procedure DateTime.setByte(index, value: int);
begin
fieldInternalRepresentation.bytes[index] := byte(value);
end;
procedure DateTime.setWord(index, value: int);
begin
fieldInternalRepresentation.shorts[index] := short(value);
end;
procedure DateTime.setSecond(value: int);
var
pword0: ^short;
begin
pword0 := @(fieldInternalRepresentation.shorts[0]);
pword0^ := value * 1000 + ((pword0^ and $ffff) mod 1000);
end;
procedure DateTime.setMillisecond(value: int);
var
pword0: ^short;
begin
pword0 := @(fieldInternalRepresentation.shorts[0]);
pword0^ := ((pword0^ and $ffff) div 1000) * 1000 + value;
end;
function DateTime.getByte(index: int): int;
begin
result := fieldInternalRepresentation.bytes[index] and $ff;
end;
function DateTime.getWord(index: int): int;
begin
result := fieldInternalRepresentation.shorts[index] and $ffff;
end;
function DateTime.getSecond(): int;
begin
result := (fieldInternalRepresentation.shorts[0] and $ffff) div 1000;
end;
function DateTime.getMillisecond(): int;
begin
result := (fieldInternalRepresentation.shorts[0] and $ffff) mod 1000;
end;
class function TimeZone.getCurrentOffsetInMillis(): int;
begin
result := osintfGetCurrentUTCOffsetInMillis();
end;
{ Calendar }
constructor Calendar.create();
begin
create(0, nil);
end;
constructor Calendar.create(offsetInMillis: int; time: DateTime);
var
s: boolean_Array1d;
f: int_Array1d;
begin
inherited create();
s := boolean_Array1d_create(FIELD_ARRAY_LENGTH);
f := int_Array1d_create(FIELD_ARRAY_LENGTH);
self.timeInMillis := 0;
self.isSet := s;
self.fields := f;
self.timeSet := false;
self.offsetInMillis := offsetInMillis;
if time <> nil then begin
s[FIELD_MILLIS] := true;
s[FIELD_SECOND] := true;
s[FIELD_MINUTE] := true;
s[FIELD_HOUR_OF_DAY] := true;
s[FIELD_DAY] := true;
s[FIELD_MONTH] := true;
s[FIELD_YEAR] := true;
f[FIELD_MILLIS] := time.millisecond;
f[FIELD_SECOND] := time.second;
f[FIELD_MINUTE] := time.minute;
f[FIELD_HOUR_OF_DAY] := time.hour;
f[FIELD_DAY] := time.day;
f[FIELD_MONTH] := time.month;
f[FIELD_YEAR] := time.year;
end;
end;
function Calendar.equals(obj: TObject): boolean;
begin
result := (obj = self) or (obj is Calendar) and
(getTimeInMillis() = Calendar(obj).getTimeInMillis());
end;
function Calendar.getHashCode(): int;
var
millis: long;
begin
millis := getTimeInMillis();
result := millis.ints[0] xor millis.ints[1];
end;
procedure Calendar.setOffsetInMillis(offsetInMillis: int);
begin
getTimeInMillis();
self.offsetInMillis := offsetInMillis;
computeFields();
end;
function Calendar.before(when: Calendar): boolean;
begin
result := self.getTimeInMillis() < when.getTimeInMillis();
end;
function Calendar.after(when: Calendar): boolean;
begin
result := self.getTimeInMillis() > when.getTimeInMillis();
end;
function Calendar.getOffsetInMillis(): int;
begin
result := offsetInMillis;
end;
procedure Calendar.getTime(dst: DateTime);
var
f: int_Array1d;
begin
if dst = nil then begin
raise NullPointerException.create(msgNullPointer);
end;
getTimeInMillis();
computeFields();
f := fields;
dst.nativeRepresentation := longBuild(
(f[FIELD_YEAR] shl 16) or ((f[FIELD_MONTH] and $ff) shl 8) or (f[FIELD_DAY] and $ff),
(f[FIELD_HOUR_OF_DAY] shl 24) or ((f[FIELD_MINUTE] and $ff) shl 16) or
((f[FIELD_SECOND] * 1000 + f[FIELD_MILLIS]) and $ffff)).native;
end;
procedure Calendar.setTime(src: DateTime);
var
s: boolean_Array1d;
f: int_Array1d;
begin
if src = nil then begin
raise NullPointerException.create(msgNullPointer);
end;
s := isSet;
f := fields;
timeSet := false;
s[FIELD_MILLIS] := true;
s[FIELD_SECOND] := true;
s[FIELD_MINUTE] := true;
s[FIELD_HOUR_OF_DAY] := true;
s[FIELD_DAY] := true;
s[FIELD_MONTH] := true;
s[FIELD_YEAR] := true;
f[FIELD_MILLIS] := src.millisecond;
f[FIELD_SECOND] := src.second;
f[FIELD_MINUTE] := src.minute;
f[FIELD_HOUR_OF_DAY] := src.hour;
f[FIELD_DAY] := src.day;
f[FIELD_MONTH] := src.month;
f[FIELD_YEAR] := src.year;
end;
procedure Calendar.setField(field, value: int);
begin
timeSet := false;
isSet[field] := true;
fields[field] := value;
end;
procedure Calendar.setTimeInMillis(timeInMillis: long);
begin
self.timeSet := true;
self.timeInMillis := timeInMillis;
fields[FIELD_DAY_OF_WEEK] := -1;
computeFields();
end;
function Calendar.getField(field: int): int;
begin
case field of
FIELD_HOUR_OF_DAY, FIELD_HOUR, FIELD_AM_PM, FIELD_DAY_OF_WEEK: begin
getTimeInMillis();
computeFields();
end;
end;
result := fields[field];
end;
function Calendar.getTimeInMillis(): long;
begin
if timeSet = false then begin
computeTimeInMillis();
timeSet := true;
end;
result := timeInMillis;
end;
procedure Calendar.computeHourOfDay();
var
hour: int;
ampm: int;
f: int_Array1d;
begin
f := fields;
ampm := Math.max(0, Math.min(1, f[FIELD_AM_PM]));
hour := Math.max(1, Math.min(12, f[FIELD_HOUR])) mod 12;
f[FIELD_HOUR_OF_DAY] := ampm * 12 + hour;
end;
procedure Calendar.computeHour();
var
hour: int;
hourOfDay: int;
f: int_Array1d;
begin
f := fields;
hourOfDay := Math.max(0, Math.min(23, f[FIELD_HOUR_OF_DAY]));
hour := hourOfDay mod 12;
if hour = 0 then begin
hour := 12;
end;
f[FIELD_HOUR] := hour;
f[FIELD_AM_PM] := hourOfDay div 12;
end;
{ JulianCalendar }
class procedure JulianCalendar.clinit();
begin
DAYS := byte_Array2d_create([
byte_Array1d_create([ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ]),
byte_Array1d_create([ 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ])]);
end;
class procedure JulianCalendar.cldone();
begin
DAYS := nil;
end;
function JulianCalendar.isLeapYear(year: int): boolean;
begin
result := year mod 4 = 0;
end;
function JulianCalendar.getNumOfDays(year, month: int): int;
var
leap: int;
begin
if (month < 1) or (month > 12) then begin
raise IllegalArgumentException.create(msgIllegalArgument);
end;
if isLeapYear(year) then begin
leap := 1;
end else begin
leap := 0;
end;
result := JulianCalendar.DAYS[leap][month - 1];
end;
function JulianCalendar.getDayOfWeek(year, month, day: int): int;
begin
result := int((((getTime(year, month, day, 0, 0, 0, 0, 0) + long(2 * 86400000)) div
86400000) + 6) mod 7);
end;
function JulianCalendar.getInternalRepresentation(time: long; offsetInMillis: int): long;
var
leap: int;
year: int;
month: int;
day: int;
hour: int;
minute: int;
millis: int;
dur: int;
j: int;
i: long;
months: byte_Array1d;
begin
inc(time, long(offsetInMillis) + long(2 * 86400000));
i := time mod 86400000;
hour := int(i div 3600000);
i := i mod 3600000;
minute := int(i div 60000);
i := i mod 60000;
millis := int(i);
i := time div 86400000;
j := int((i div 1461) * 4);
i := i mod 1461;
if i = 1460 then begin
inc(j, 3);
i := 365;
end else begin
inc(j, int(i div 365));
i := i mod 365;
end;
inc(j);
year := j;
if isLeapYear(j) then begin
leap := 1;
end else begin
leap := 0;
end;
months := JulianCalendar.DAYS[leap];
j := 0;
dur := months[j];
while i >= long(dur) do begin
dec(i, long(dur));
inc(j);
dur := months[j];
end;
month := j + 1;
day := int(i) + 1;
result := longBuild((year shl 16) or (month shl 8) or day,
(hour shl 24) or (minute shl 16) or millis);
end;
function JulianCalendar.getTime(internalRepresentation: long; offsetInMillis: int): long;
var
hi: int;
lo: int;
word0: int;
begin
hi := internalRepresentation.ints[1];
lo := internalRepresentation.ints[0];
word0 := lo and $ffff;
result := getTime(hi shr 16, (hi shr 8) and $ff, hi and $ff,
lo shr 24, (lo shr 16) and $ff, word0 div 1000, word0 mod 1000, offsetInMillis);
end;
function JulianCalendar.getTime(year, month, day, hour, minute, second, millis,
offsetInMillis: int): long;
var
i: int;
leap: int;
months: byte_Array1d;
begin
if isLeapYear(year) then begin
leap := 1;
end else begin
leap := 0;
end;
dec(year);
result := -2 * 86400000;
inc(result, 126230400000 * long(year div 4));
year := year mod 4;
inc(result, 31536000000 * long(year));
months := JulianCalendar.DAYS[leap];
for i := month - 2 downto 0 do begin
inc(result, 86400000 * long(months[i]));
end;
dec(day);
inc(result, 86400000 * long(day) + 3600000 * long(hour) + 60000 * long(minute) +
1000 * long(second) + long(millis) - long(offsetInMillis));
end;
procedure JulianCalendar.computeFields();
var
h: int;
j: int;
dur: int;
leap: int;
i: long;
time: long;
months: byte_Array1d;
f: int_Array1d;
begin
time := timeInMillis + (long(getOffsetInMillis()) + long(2 * 86400000));
i := time mod 86400000;
h := i div 3600000;
f := fields;
f[FIELD_HOUR_OF_DAY] := h;
f[FIELD_AM_PM] := h div 12;
h := h mod 12;
if h = 0 then begin
f[FIELD_HOUR] := 12;
end else begin
f[FIELD_HOUR] := h;
end;
i := i mod 3600000;
f[FIELD_MINUTE] := int(i div 60000);
i := i mod 60000;
f[FIELD_SECOND] := int(i div 1000);
i := i mod 1000;
f[FIELD_MILLIS] := int(i);
time := time div 86400000;
i := time;
j := int((i div 1461) * 4);
i := i mod 1461;
if i = 1460 then begin
inc(j, 3);
i := 365;
end else begin
inc(j, int(i div 365));
i := i mod 365;
end;
inc(j);
f[FIELD_YEAR] := j;
if isLeapYear(j) then begin
leap := 1;
end else begin
leap := 0;
end;
months := JulianCalendar.DAYS[leap];
j := 0;
dur := months[j];
while i >= long(dur) do begin
dec(i, long(dur));
inc(j);
dur := months[j];
end;
f[FIELD_MONTH] := j + 1;
f[FIELD_DAY] := int(i) + 1;
f[FIELD_DAY_OF_WEEK] := int((time + 6) mod 7);
end;
procedure JulianCalendar.computeTimeInMillis();
var
s: boolean_Array1d;
f: int_Array1d;
hour: int;
begin
s := isSet;
f := fields;
if s[FIELD_AM_PM] or s[FIELD_HOUR] then begin
hour := Math.max(1, Math.min(12, f[FIELD_HOUR]));
if hour = 12 then begin
hour := 0;
end;
if f[FIELD_AM_PM] <> 0 then begin
inc(hour, 12);
end;
end else begin
hour := f[FIELD_HOUR_OF_DAY];
end;
s[FIELD_AM_PM] := false;
s[FIELD_HOUR] := false;
timeInMillis := getTime(f[FIELD_YEAR], f[FIELD_MONTH], f[FIELD_DAY],
hour, f[FIELD_MINUTE], f[FIELD_SECOND], f[FIELD_MILLIS], getOffsetInMillis());
end;
{ GregorianCalendar }
function GregorianCalendar.isLeapYear(year: int): boolean;
begin
if year mod 100 = 0 then begin
result := year mod 400 = 0;
end else begin
result := year mod 4 = 0;
end;
end;
function GregorianCalendar.getNumOfDays(year, month: int): int;
var
leap: int;
begin
if (month < 1) or (month > 12) then begin
raise IllegalArgumentException.create(msgIllegalArgument);
end;
if isLeapYear(year) then begin
leap := 1;
end else begin
leap := 0;
end;
result := JulianCalendar.DAYS[leap][month - 1];
end;
function GregorianCalendar.getDayOfWeek(year, month, day: int): int;
begin
result := int(((getTime(year, month, day, 0, 0, 0, 0, 0) div 86400000) + 1) mod 7);
end;
function GregorianCalendar.getInternalRepresentation(time: long; offsetInMillis: int): long;
var
leap: int;
year: int;
month: int;
day: int;
hour: int;
minute: int;
millis: int;
dur: int;
j: int;
i: long;
months: byte_Array1d;
begin
inc(time, long(offsetInMillis));
i := time mod 86400000;
hour := int(i div 3600000);
i := i mod 3600000;
minute := int(i div 60000);
i := i mod 60000;
millis := int(i);
i := time div 86400000;
j := int((i div 146097) * 400);
i := i mod 146097;
if i = 146096 then begin
inc(j, 399);
i := 365;
end else begin
inc(j, int((i div 36524) * 100));
i := i mod 36524;
inc(j, int((i div 1461) * 4));
i := i mod 1461;
if i = 1460 then begin
inc(j, 3);
i := 365;
end else begin
inc(j, int(i div 365));
i := i mod 365;
end;
end;
inc(j);
year := j;
if isLeapYear(j) then begin
leap := 1;
end else begin
leap := 0;
end;
months := JulianCalendar.DAYS[leap];
j := 0;
dur := months[j];
while i >= long(dur) do begin
dec(i, long(dur));
inc(j);
dur := months[j];
end;
month := j + 1;
day := int(i) + 1;
result := longBuild((year shl 16) or (month shl 8) or day,
(hour shl 24) or (minute shl 16) or millis);
end;
function GregorianCalendar.getTime(internalRepresentation: long; offsetInMillis: int): long;
var
hi: int;
lo: int;
word0: int;
begin
hi := internalRepresentation.ints[1];
lo := internalRepresentation.ints[0];
word0 := lo and $ffff;
result := getTime(hi shr 16, (hi shr 8) and $ff, hi and $ff,
lo shr 24, (lo shr 16) and $ff, word0 div 1000, word0 mod 1000, offsetInMillis);
end;
function GregorianCalendar.getTime(year, month, day, hour, minute, second, millis,
offsetInMillis: int): long;
var
i: int;
leap: int;
months: byte_Array1d;
begin
if isLeapYear(year) then begin
leap := 1;
end else begin
leap := 0;
end;
dec(year);
result := 0;
inc(result, 12622780800000 * long(year div 400));
year := year mod 400;
inc(result, 3155673600000 * long(year div 100));
year := year mod 100;
inc(result, 126230400000 * long(year div 4));
year := year mod 4;
inc(result, 31536000000 * long(year));
months := JulianCalendar.DAYS[leap];
for i := month - 2 downto 0 do begin
inc(result, 86400000 * long(months[i]));
end;
dec(day);
inc(result, 86400000 * long(day) + 3600000 * long(hour) + 60000 * long(minute) +
1000 * long(second) + long(millis) - long(offsetInMillis));
end;
procedure GregorianCalendar.computeFields();
var
h: int;
j: int;
dur: int;
leap: int;
i: long;
time: long;
months: byte_Array1d;
f: int_Array1d;
begin
time := timeInMillis + getOffsetInMillis();
i := time mod 86400000;
h := i div 3600000;
f := fields;
f[FIELD_HOUR_OF_DAY] := h;
f[FIELD_AM_PM] := h div 12;
h := h mod 12;
if h = 0 then begin
f[FIELD_HOUR] := 12;
end else begin
f[FIELD_HOUR] := h;
end;
i := i mod 3600000;
f[FIELD_MINUTE] := int(i div 60000);
i := i mod 60000;
f[FIELD_SECOND] := int(i div 1000);
i := i mod 1000;
f[FIELD_MILLIS] := int(i);
time := time div 86400000;
i := time;
j := int((i div 146097) * 400);
i := i mod 146097;
if i = 146096 then begin
inc(j, 399);
i := 365;
end else begin
inc(j, int((i div 36524) * 100));
i := i mod 36524;
inc(j, int((i div 1461) * 4));
i := i mod 1461;
if i = 1460 then begin
inc(j, 3);
i := 365;
end else begin
inc(j, int(i div 365));
i := i mod 365;
end;
end;
inc(j);
f[FIELD_YEAR] := j;
if isLeapYear(j) then begin
leap := 1;
end else begin
leap := 0;
end;
months := JulianCalendar.DAYS[leap];
j := 0;
dur := months[j];
while i >= long(dur) do begin
dec(i, long(dur));
inc(j);
dur := months[j];
end;
f[FIELD_MONTH] := j + 1;
f[FIELD_DAY] := int(i) + 1;
f[FIELD_DAY_OF_WEEK] := int((time + 1) mod 7);
end;
procedure GregorianCalendar.computeTimeInMillis();
var
s: boolean_Array1d;
f: int_Array1d;
hour: int;
begin
s := isSet;
f := fields;
if s[FIELD_AM_PM] or s[FIELD_HOUR] then begin
hour := Math.max(1, Math.min(12, f[FIELD_HOUR]));
if hour = 12 then begin
hour := 0;
end;
if f[FIELD_AM_PM] <> 0 then begin
inc(hour, 12);
end;
end else begin
hour := f[FIELD_HOUR_OF_DAY];
end;
s[FIELD_AM_PM] := false;
s[FIELD_HOUR] := false;
timeInMillis := getTime(f[FIELD_YEAR], f[FIELD_MONTH], f[FIELD_DAY],
hour, f[FIELD_MINUTE], f[FIELD_SECOND], f[FIELD_MILLIS], getOffsetInMillis());
end;
{ BooleanVal }
class procedure BooleanVal.clinit();
begin
FALSE := BooleanVal.create(System.false);
TRUE := BooleanVal.create(System.true);
end;
class procedure BooleanVal.cldone();
begin
FALSE := nil;
TRUE := nil;
end;
constructor BooleanVal.create(value: boolean);
begin
inherited create();
self.value := value;
end;
function BooleanVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is BooleanAsObject) and
(value = (_Object(obj) as BooleanAsObject).booleanValue());
end;
function BooleanVal.getHashCode(): int;
begin
if value then begin
result := 1231;
end else begin
result := 1237;
end;
end;
function BooleanVal.toString(): AnsiString;
begin
if value then begin
result := 'true';
end else begin
result := 'false';
end;
end;
function BooleanVal.booleanValue(): boolean;
begin
result := value;
end;
{ NumericVal }
constructor NumericVal.create();
begin
inherited create();
end;
function NumericVal.byteValue(): int;
begin
result := byte(intValue());
end;
function NumericVal.shortValue(): int;
begin
result := short(intValue());
end;
{ IntegerVal }
constructor IntegerVal.create(value: int);
begin
inherited create();
self.int0 := value;
end;
function IntegerVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is IntegerAsObject) and
(int0 = (_Object(obj) as IntegerAsObject).intValue());
end;
function IntegerVal.getHashCode(): int;
begin
result := int0;
end;
function IntegerVal.toString(): AnsiString;
begin
result := intToString(int0);
end;
function IntegerVal.intValue(): int;
begin
result := int0;
end;
function IntegerVal.nativeValue(): int64;
begin
result := int0;
end;
function IntegerVal.longValue(): long;
begin
result := int0;
end;
function IntegerVal.floatValue(): float;
begin
result := int0;
end;
function IntegerVal.doubleValue(): double;
begin
result := int0;
end;
function IntegerVal.realValue(): real;
begin
result := int0;
end;
{ LongVal }
constructor LongVal.create(const value: long);
begin
inherited create(value.ints[0]);
self.int1 := value.ints[1];
end;
constructor LongVal.create(const value: int64);
begin
create(long(value));
end;
function LongVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is LongAsObject) and
(long0() = (_Object(obj) as LongAsObject).longValue());
end;
function LongVal.getHashCode(): int;
begin
result := int0 xor int1;
end;
function LongVal.toString(): AnsiString;
begin
result := longToString(long0());
end;
function LongVal.nativeValue(): int64;
begin
result := long0().native;
end;
function LongVal.longValue(): long;
begin
result := long0();
end;
function LongVal.floatValue(): float;
begin
result := real(long0());
end;
function LongVal.doubleValue(): double;
begin
result := real(long0());
end;
function LongVal.realValue(): real;
begin
result := real(long0());
end;
function LongVal.long0(): long;
begin
result := longBuild(int1, int0);
end;
{ UltraVal }
constructor UltraVal.create(const value: ultra);
begin
inherited create(value.ints[0]);
self.int1 := value.ints[1];
self.long1 := value.longs[1];
end;
function UltraVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is UltraAsObject) and
(ultra0() = (_Object(obj) as UltraAsObject).ultraValue());
end;
function UltraVal.getHashCode(): int;
begin
result := int0 xor int1 xor long1.ints[0] xor long1.ints[1];
end;
function UltraVal.toString(): AnsiString;
begin
result := 'ultra{' + intToString(long1.ints[1]) + ', ' + intToString(long1.ints[0]) + ', ' +
intToString(int1) + ', ' + intToString(int0) + '}';
end;
function UltraVal.nativeValue(): int64;
begin
result := long0().native;
end;
function UltraVal.longValue(): long;
begin
result := long0();
end;
function UltraVal.getShort(index: int): int;
begin
case index of
0: begin
result := short(int0);
end;
1: begin
result := short(int0 shr 16);
end;
2: begin
result := short(int1);
end;
3: begin
result := short(int1 shr 16);
end;
4..7: begin
result := long1.shorts[index - 4];
end;
else
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
end;
function UltraVal.getInt(index: int): int;
begin
case index of
0: begin
result := int0;
end;
1: begin
result := int1;
end;
2..3: begin
result := long1.ints[index - 2];
end;
else
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
end;
function UltraVal.ultraValue(): ultra;
begin
result := ultra0();
end;
function UltraVal.long0(): long;
begin
result := longBuild(int1, int0);
end;
function UltraVal.ultra0(): ultra;
begin
result := ultraBuild(long1.ints[1], long1.ints[0], int1, int0);
end;
{ RealVal }
constructor RealVal.create(const value: real);
begin
inherited create();
self.value := value;
end;
function RealVal.equals(obj: TObject): boolean;
var
tvalue: real;
avalue: real;
begin
if not (obj is _Object) then begin
result := false;
exit;
end;
if _Object(obj) is RealAsObject then begin
tvalue := value;
avalue := (_Object(obj) as RealAsObject).realValue();
result := (realExtractExponent(tvalue) = realExtractExponent(avalue)) and
(realExtractSignificand(tvalue) = realExtractSignificand(avalue));
end else begin
result := (_Object(obj) is DoubleAsObject) and (doubleToLongBits(value) =
doubleToLongBits((_Object(obj) as DoubleAsObject).doubleValue())) or
(_Object(obj) is FloatAsObject) and (floatToIntBits(value) =
floatToIntBits((_Object(obj) as FloatAsObject).floatValue()));
end;
end;
function RealVal.getHashCode(): int;
var
e: int;
s: long;
v: real;
begin
v := value;
s := realExtractSignificand(v);
e := realExtractExponent(v);
result := e xor s.ints[0] xor s.ints[1];
end;
function RealVal.toString(): AnsiString;
begin
result := realToString(value);
end;
function RealVal.intValue(): int;
begin
result := realToInt(value);
end;
function RealVal.nativeValue(): int64;
begin
result := realToLong(value).native;
end;
function RealVal.longValue(): long;
begin
result := realToLong(value);
end;
function RealVal.floatValue(): float;
begin
result := realToFloat(value);
end;
function RealVal.doubleValue(): double;
begin
result := realToDouble(value);
end;
function RealVal.realValue(): real;
begin
result := value;
end;
{ XVectorVal }
constructor XVectorVal.create(const value: xvector);
begin
inherited create();
self.value := value;
end;
function XVectorVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is XVectorAsObject) and
(value = (_Object(obj) as XVectorAsObject).xvectorValue());
end;
function XVectorVal.getHashCode(): int;
begin
result := floatToIntBits(value.floats[0]) xor floatToIntBits(value.floats[1]) xor
floatToIntBits(value.floats[2]) xor floatToIntBits(value.floats[3]);
end;
function XVectorVal.toString(): AnsiString;
var
repr: RealValueRepresenter;
begin
repr := RealValueRepresenter.create(RealValueRepresenter.FLOAT_SIGNIFICAND_DIGITS,
RealValueRepresenter.FLOAT_ORDER_DIGITS);
try
result := 'xvector{' +
repr.toString(value.floats[3]) + ', ' + repr.toString(value.floats[2]) + ', ' +
repr.toString(value.floats[1]) + ', ' + repr.toString(value.floats[0]) + '}';
finally
repr.free();
end;
end;
function XVectorVal.intValue(): int;
begin
result := realToInt(value.floats[0]);
end;
function XVectorVal.nativeValue(): int64;
begin
result := realToLong(value.floats[0]).native;
end;
function XVectorVal.longValue(): long;
begin
result := realToLong(value.floats[0]);
end;
function XVectorVal.floatValue(): float;
begin
result := value.floats[0];
end;
function XVectorVal.doubleValue(): double;
begin
result := value.floats[0];
end;
function XVectorVal.realValue(): real;
begin
result := value.floats[0];
end;
function XVectorVal.getFloat(index: int): float;
begin
if (index < 0) or (index > 3) then begin
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
result := value.floats[index];
end;
function XVectorVal.xvectorValue(): xvector;
begin
result := value;
end;
{ CharVal }
constructor CharVal.create(value: char);
begin
inherited create();
self.value := value;
end;
function CharVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is CharAsObject) and
(int(value) = int((_Object(obj) as CharAsObject).charValue()));
end;
function CharVal.getHashCode(): int;
begin
result := int(value);
end;
function CharVal.toString(): AnsiString;
begin
result := value;
end;
function CharVal.charValue(): char;
begin
result := value;
end;
{ UCharVal }
constructor UCharVal.create(value: uchar);
begin
inherited create();
self.value := value;
end;
function UCharVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is UCharAsObject) and
(int(value) = int((_Object(obj) as UCharAsObject).ucharValue()));
end;
function UCharVal.getHashCode(): int;
begin
result := int(value);
end;
function UCharVal.toString(): AnsiString;
begin
result := stringToUTF8(value);
end;
function UCharVal.ucharValue(): uchar;
begin
result := value;
end;
{ StringVal }
constructor StringVal.create(const value: AnsiString);
begin
inherited create();
self.value := value;
end;
function StringVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is StringAsObject) and
(value = (_Object(obj) as StringAsObject).stringValue());
end;
function StringVal.getHashCode(): int;
var
i: int;
s: AnsiString;
begin
s := value;
result := 0;
for i := length(s) downto 1 do begin
result := (31 * result) + int(s[i]);
end;
end;
function StringVal.toString(): AnsiString;
begin
result := value;
end;
function StringVal.stringValue(): AnsiString;
begin
result := value;
end;
function StringVal.unicodeStringValue(): UnicodeString;
begin
result := stringToUTF16(value);
end;
{ UStringVal }
constructor UStringVal.create(const value: UnicodeString);
begin
inherited create();
self.value := value;
end;
function UStringVal.equals(obj: TObject): boolean;
begin
result := (obj is _Object) and (_Object(obj) is UnicodeStringAsObject) and
(value = (_Object(obj) as UnicodeStringAsObject).unicodeStringValue());
end;
function UStringVal.getHashCode(): int;
var
i: int;
s: UnicodeString;
begin
s := value;
result := 0;
for i := length(s) downto 1 do begin
result := (31 * result) + int(s[i]);
end;
end;
function UStringVal.toString(): AnsiString;
begin
result := stringToUTF8(value);
end;
function UStringVal.stringValue(): AnsiString;
begin
result := stringToUTF8(value);
end;
function UStringVal.unicodeStringValue(): UnicodeString;
begin
result := value;
end;
{ := operators }
operator :=(const value: boolean): _Interface;
begin
if value then begin
result := BooleanVal.TRUE;
end else begin
result := BooleanVal.FALSE;
end;
end;
operator :=(const value: char): _Interface;
begin
result := CharVal.create(value);
end;
operator :=(const value: uchar): _Interface;
begin
result := UCharVal.create(value);
end;
operator :=(const value: byte): _Interface;
begin
result := IntegerVal.create(value);
end;
operator :=(const value: short): _Interface;
begin
result := IntegerVal.create(value);
end;
operator :=(const value: int): _Interface;
begin
result := IntegerVal.create(value);
end;
operator :=(const value: int64): _Interface;
begin
result := LongVal.create(value);
end;
operator :=(const value: long): _Interface;
begin
result := LongVal.create(value);
end;
operator :=(const value: ultra): _Interface;
begin
result := UltraVal.create(value);
end;
operator :=(const value: float): _Interface;
begin
result := RealVal.create(value);
end;
operator :=(const value: double): _Interface;
begin
result := RealVal.create(value);
end;
operator :=(const value: real): _Interface;
begin
result := RealVal.create(value);
end;
operator :=(const value: xvector): _Interface;
begin
result := XVectorVal.create(value);
end;
operator :=(const value: AnsiString): _Interface;
begin
result := StringVal.create(value);
end;
operator :=(const value: UnicodeString): _Interface;
begin
result := UStringVal.create(value);
end;
operator :=(const value: boolean): BooleanAsObject;
begin
if value then begin
result := BooleanVal.TRUE;
end else begin
result := BooleanVal.FALSE;
end;
end;
operator :=(const value: char): CharAsObject;
begin
result := CharVal.create(value);
end;
operator :=(const value: uchar): UCharAsObject;
begin
result := UCharVal.create(value);
end;
operator :=(const value: byte): IntegerAsObject;
begin
result := IntegerVal.create(value);
end;
operator :=(const value: short): IntegerAsObject;
begin
result := IntegerVal.create(value);
end;
operator :=(const value: int): IntegerAsObject;
begin
result := IntegerVal.create(value);
end;
operator :=(const value: int64): LongAsObject;
begin
result := LongVal.create(value);
end;
operator :=(const value: long): LongAsObject;
begin
result := LongVal.create(value);
end;
operator :=(const value: ultra): UltraAsObject;
begin
result := UltraVal.create(value);
end;
operator :=(const value: float): FloatAsObject;
begin
result := RealVal.create(value);
end;
operator :=(const value: double): DoubleAsObject;
begin
result := RealVal.create(value);
end;
operator :=(const value: real): RealAsObject;
begin
result := RealVal.create(value);
end;
operator :=(const value: xvector): XVectorAsObject;
begin
result := XVectorVal.create(value);
end;
operator :=(const value: AnsiString): StringAsObject;
begin
result := StringVal.create(value);
end;
operator :=(const value: UnicodeString): UnicodeStringAsObject;
begin
result := UStringVal.create(value);
end;
initialization
JulianCalendar.clinit();
BooleanVal.clinit();
finalization
BooleanVal.cldone();
JulianCalendar.cldone();
end.
