paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-04 18:50:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

* extracted dynarray helpers from system unit into jdynarr.inc (were

Browse Source 
in the system unit for easier debugging)
  * disabled a bunch more feature flags by default for the JVM target
  * incorporate modified version of inc/systemh.inc (split into two parts:
    jsystemh_types.inc and jsystemh.inc, because some of the types are
    required for the declaration of the shortstring/ansistring/set/...
    classes, which in turn are required for the routine declarations) and
    inc/system.inc (as jsystem.inc)
   o moved some routines around from old to new locations based on where
     they appear in the common files
   o added a number of defines that allow skipping more common implementations
     in case a platform-specific one is already available
  * all base classes (AnsistringClass etc) are now descendants of
    JLObject rather than TObject, because their declaration is now parsed
    before TObject is known (and there's no need for them to inherit from
    TObject)
  * incorporate modified version of inc/system.inc
  * use the common version of generic.inc, currh.inc, gencurr.inc and
    genmath.inc (with small modification to those files)
  + addition of quite a bit of system unit functionality (halt, runerror,
    random, round, str() for integer types, abs, odd, endian swapping helpers,
    bit scanning, trigonometric functions, ln, exp, ...)
   o round()/trunc() for comp-types has been renamed trunc_comp() on the
     JVM target because their JVM signature conflicts with trunc(currency)
   o the unsigned versions of swapendian() and other endian helpers are not
     available on the JVM target because of JVM signature conflicts

git-svn-id: branches/jvmbackend@18746 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:32:13 +00:00
parent 1418faf854
commit 8a95a04e16
33 changed files with 4276 additions and 1185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
.gitattributes vendored
View File

@ -7361,24 +7361,36 @@ rtl/java/java_sys.inc svneol=native#text/plain
rtl/java/java_sysh.inc svneol=native#text/plain
rtl/java/jdk15.inc svneol=native#text/plain
rtl/java/jdk15.pas svneol=native#text/plain
rtl/java/jdynarr.inc svneol=native#text/plain
rtl/java/jdynarrh.inc svneol=native#text/plain
rtl/java/jint64.inc svneol=native#text/plain
rtl/java/jmath.inc svneol=native#text/plain
rtl/java/jpvar.inc svneol=native#text/plain
rtl/java/jpvarh.inc svneol=native#text/plain
rtl/java/jrec.inc svneol=native#text/plain
rtl/java/jrech.inc svneol=native#text/plain
rtl/java/jset.inc svneol=native#text/plain
rtl/java/jseth.inc svneol=native#text/plain
rtl/java/jsystem.inc svneol=native#text/plain
rtl/java/jsystemh.inc svneol=native#text/plain
rtl/java/jsystemh_types.inc svneol=native#text/plain
rtl/java/objpas.inc svneol=native#text/plain
rtl/java/objpas.pp svneol=native#text/plain
rtl/java/objpash.inc svneol=native#text/plain
rtl/java/rtl.cfg svneol=native#text/plain
rtl/java/rtti.inc svneol=native#text/plain
rtl/java/sstringh.inc svneol=native#text/plain
rtl/java/sstrings.inc svneol=native#text/plain
rtl/java/sysos.inc svneol=native#text/plain
rtl/java/sysosh.inc svneol=native#text/plain
rtl/java/sysres.inc svneol=native#text/plain
rtl/java/system.pp svneol=native#text/plain
rtl/java/ustringh.inc svneol=native#text/plain
rtl/java/ustrings.inc svneol=native#text/plain
rtl/jvm/int64p.inc svneol=native#text/plain
rtl/jvm/jvm.inc svneol=native#text/plain
rtl/jvm/makefile.cpu svneol=native#text/plain
rtl/jvm/math.inc svneol=native#text/plain
rtl/jvm/setjump.inc svneol=native#text/plain
rtl/jvm/setjumph.inc svneol=native#text/plain
rtl/linux/Makefile svneol=native#text/plain
rtl/linux/Makefile.fpc svneol=native#text/plain
rtl/linux/arm/bsyscall.inc svneol=native#text/plain

6
compiler/options.pas
View File

@ -2297,7 +2297,9 @@ begin
// until these features are implemented, they are disabled in the compiler
target_unsup_features:=[f_stackcheck];
system_jvm_java32:
target_unsup_features:=[f_threading,f_commandargs,f_fileio,f_textio,f_consoleio,f_dynlibs];
target_unsup_features:=[f_heap,f_textio,f_consoleio,f_fileio,
f_variants,f_objects,f_threading,f_commandargs,
f_processes,f_stackcheck,f_dynlibs,f_softfpu,f_objectivec1,f_resources];
else
target_unsup_features:=[];
end;
@ -2516,7 +2518,7 @@ begin
def_system_macro('FPC_HAS_MEMBAR');
def_system_macro('FPC_SETBASE_USED');
{$if defined(x86) or defined(arm)}
{$if defined(x86) or defined(arm) or defined(jvm)}
def_system_macro('INTERNAL_BACKTRACE');
{$endif}
def_system_macro('STR_CONCAT_PROCS');

2
compiler/systems/i_jvm.pas
View File

@ -39,7 +39,7 @@ unit i_jvm;
system : system_jvm_java32;
name : 'Java Virtual Machine';
shortname : 'Java';
flags : [tf_files_case_sensitive,
flags : [tf_files_case_sensitive,tf_no_generic_stackcheck,
{ avoid the creation of threadvar tables }
tf_section_threadvars];
cpu : cpu_jvm;

7
rtl/inc/currh.inc
View File

@ -15,9 +15,14 @@
{$ifdef FPC_CURRENCY_IS_INT64}
function trunc(c : currency) : int64;
function trunc(c : comp) : int64;
function round(c : currency) : int64;
{$ifndef cpujvm}
function trunc(c : comp) : int64;
function round(c : comp) : int64;
{$else not cpujvm}
function trunc_comp(c: comp) : int64;
function round_comp(c : comp) : int64;
{$endif not cpujvm}
{$endif FPC_CURRENCY_IS_INT64}

30
rtl/inc/gencurr.inc
View File

@ -15,35 +15,31 @@
{$ifdef FPC_CURRENCY_IS_INT64}
function trunc(c : currency) : int64;
type
tmyrec = record
i: int64;
end;
begin
result := int64(tmyrec(c)) div 10000
{ the type conversion includes dividing by 10000 }
result := int64(c)
end;
{$ifndef cpujvm}
function trunc(c : comp) : int64;
{$else not cpujvm}
function trunc_comp(c : comp) : int64;
{$endif cpujvm}
begin
result := c
end;
function round(c : currency) : int64;
type
tmyrec = record
i: int64;
end;
var
rem, absrem: longint;
rem, absrem: currency;
begin
{ (int64(tmyrec(c))(+/-)5000) div 10000 can overflow }
result := int64(tmyrec(c)) div 10000;
rem := int64(tmyrec(c)) - result * 10000;
result := int64(c);
rem := c - currency(result);
absrem := abs(rem);
if (absrem > 5000) or
((absrem = 5000) and
if (absrem > 0.5) or
((absrem = 0.5) and
(rem > 0)) then
if (rem > 0) then
inc(result)
@ -52,7 +48,11 @@
end;
{$ifndef cpujvm}
function round(c : comp) : int64;
{$else not cpujvm}
function round_comp(c : comp) : int64;
{$endif cpujvm}
begin
result := c
end;

49
rtl/inc/generic.inc
View File

@ -1120,6 +1120,7 @@ end;
{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
{$ifndef JVM}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
@ -1142,6 +1143,8 @@ function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_STRTOSHORTSTRINGPROC}
end;
{$endif not JVM}
{$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
@ -1758,6 +1761,7 @@ function align(addr : PtrUInt;alignment : PtrUInt) : PtrUInt;{$ifdef SYSTEMINLIN
end;
{$ifndef JVM}
function align(addr : Pointer;alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
var
tmp: PtrUInt;
@ -1765,7 +1769,7 @@ function align(addr : Pointer;alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLIN
tmp:=PtrUInt(addr)+alignment-1;
result:=pointer(tmp-(tmp mod alignment));
end;
{$endif}
{****************************************************************************
Str()
@ -1773,7 +1777,7 @@ function align(addr : Pointer;alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLIN
{$ifndef FPC_SYSTEM_HAS_INT_STR_LONGINT}
procedure int_str(l:longint;out s:string);
procedure int_str(l:longint;out s:shortstring);
var
m,m1 : longword;
pcstart,
@ -1816,7 +1820,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_INT_STR_LONGWORD}
procedure int_str(l:longword;out s:string);
procedure int_str_unsigned(l:longword;out s:shortstring);
var
m1 : longword;
pcstart,
@ -1851,7 +1855,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_INT_STR_INT64}
procedure int_str(l:int64;out s:string);
procedure int_str(l:int64;out s:shortstring);
var
m,m1 : qword;
pcstart,
@ -1894,7 +1898,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_INT_STR_QWORD}
procedure int_str(l:qword;out s:string);
procedure int_str_unsigned(l:qword;out s:shortstring);
var
m1 : qword;
pcstart,
@ -1957,12 +1961,12 @@ function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inlin
Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
end;
{$ifndef cpujvm}
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result := Word((AValue shr 8) or (AValue shl 8));
end;
{$endif}
function SwapEndian(const AValue: LongInt): LongInt;
begin
@ -1972,7 +1976,7 @@ function SwapEndian(const AValue: LongInt): LongInt;
or (AValue shr 24);
end;
{$ifndef cpujvm}
function SwapEndian(const AValue: DWord): DWord;
begin
Result := (AValue shl 24)
@ -1980,7 +1984,7 @@ function SwapEndian(const AValue: DWord): DWord;
or ((AValue and $00FF0000) shr 8)
or (AValue shr 24);
end;
{$endif}
function SwapEndian(const AValue: Int64): Int64;
begin
@ -1994,7 +1998,7 @@ function SwapEndian(const AValue: Int64): Int64;
or (AValue shr 56);
end;
{$ifndef cpujvm}
function SwapEndian(const AValue: QWord): QWord;
begin
Result := (AValue shl 56)
@ -2006,6 +2010,7 @@ function SwapEndian(const AValue: QWord): QWord;
or ((AValue and $00FF000000000000) shr 40)
or (AValue shr 56);
end;
{$endif}
{$endif FPC_SYSTEM_HAS_SWAPENDIAN}
function BEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2018,6 +2023,7 @@ function BEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$e
end;
{$ifndef cpujvm}
function BEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_BIG}
@ -2026,6 +2032,7 @@ function BEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function BEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2038,6 +2045,7 @@ function BEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$end
end;
{$ifndef cpujvm}
function BEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_BIG}
@ -2046,6 +2054,7 @@ function BEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function BEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2058,6 +2067,7 @@ function BEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
end;
{$ifndef cpujvm}
function BEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_BIG}
@ -2066,6 +2076,7 @@ function BEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
@ -2079,6 +2090,7 @@ function LEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$e
end;
{$ifndef cpujvm}
function LEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_LITTLE}
@ -2087,6 +2099,7 @@ function LEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function LEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2099,6 +2112,7 @@ function LEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$end
end;
{$ifndef cpujvm}
function LEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_LITTLE}
@ -2107,6 +2121,7 @@ function LEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function LEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2119,6 +2134,7 @@ function LEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
end;
{$ifndef cpujvm}
function LEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_LITTLE}
@ -2127,6 +2143,7 @@ function LEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
@ -2140,6 +2157,7 @@ function NtoBE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$e
end;
{$ifndef cpujvm}
function NtoBE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_BIG}
@ -2148,6 +2166,7 @@ function NtoBE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function NtoBE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2160,6 +2179,7 @@ function NtoBE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$end
end;
{$ifndef cpujvm}
function NtoBE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_BIG}
@ -2168,6 +2188,7 @@ function NtoBE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function NtoBE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2180,6 +2201,7 @@ function NtoBE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
end;
{$ifndef cpujvm}
function NtoBE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_BIG}
@ -2188,6 +2210,7 @@ function NtoBE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function NtoLE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2200,6 +2223,7 @@ function NtoLE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$e
end;
{$ifndef cpujvm}
function NtoLE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_LITTLE}
@ -2208,6 +2232,7 @@ function NtoLE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function NtoLE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2220,6 +2245,7 @@ function NtoLE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$end
end;
{$ifndef cpujvm}
function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_LITTLE}
@ -2228,6 +2254,7 @@ function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -2240,6 +2267,7 @@ function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
end;
{$ifndef cpujvm}
function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$IFDEF ENDIAN_LITTLE}
@ -2248,6 +2276,7 @@ function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
Result := SwapEndian(AValue);
{$ENDIF}
end;
{$endif not cpujvm}
{$ifndef FPC_SYSTEM_HAS_MEM_BARRIER}

4
rtl/inc/genmath.inc
View File

@ -946,6 +946,7 @@ invalid:
Begin
fr := abs(Frac(d));
tr := Trunc(d);
result:=0;
case softfloat_rounding_mode of
float_round_nearest_even:
begin
@ -983,6 +984,9 @@ invalid:
result:=tr;
float_round_to_zero:
result:=tr;
else
{ needed for jvm: result must be initialized on all paths }
result:=0;
end;
end;
{$endif FPC_SYSTEM_HAS_ROUND}

48
rtl/inc/sstrings.inc
View File

@ -15,13 +15,19 @@
subroutines for string handling
****************************************************************************}
{$ifndef FPC_HAS_SHORTSTR_SETLENGTH}
{$define FPC_HAS_SHORTSTR_SETLENGTH}
procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH']; compilerproc;
begin
if Len>255 then
Len:=255;
s[0]:=chr(len);
end;
{$endif FPC_HAS_SHORTSTR_SETLENGTH}
{$ifndef FPC_HAS_SHORTSTR_COPY}
{$define FPC_HAS_SHORTSTR_COPY}
function fpc_shortstr_copy(const s : shortstring;index : SizeInt;count : SizeInt): shortstring;compilerproc;
begin
if count<0 then
@ -38,8 +44,11 @@ begin
fpc_shortstr_Copy[0]:=chr(Count);
Move(s[Index+1],fpc_shortstr_Copy[1],Count);
end;
{$endif FPC_HAS_SHORTSTR_COPY}
{$ifndef FPC_HAS_SHORTSTR_DELETE}
{$define FPC_HAS_SHORTSTR_DELETE}
procedure delete(var s : shortstring;index : SizeInt;count : SizeInt);
begin
if index<=0 then
@ -53,8 +62,11 @@ begin
Move(s[Index+Count],s[Index],Length(s)-Index+1);
end;
end;
{$endif FPC_HAS_SHORTSTR_DELETE}
{$ifndef FPC_HAS_SHORTSTR_INSERT}
{$define FPC_HAS_SHORTSTR_INSERT}
procedure insert(const source : shortstring;var s : shortstring;index : SizeInt);
var
cut,srclen,indexlen : SizeInt;
@ -80,8 +92,11 @@ begin
move(Source[1],s[Index],srclen);
s[0]:=chr(index+srclen+indexlen-1);
end;
{$endif FPC_HAS_SHORTSTR_INSERT}
{$ifndef FPC_HAS_SHORTSTR_INSERT_CHAR}
{$define FPC_HAS_SHORTSTR_INSERT_CHAR}
procedure insert(source : Char;var s : shortstring;index : SizeInt);
var
indexlen : SizeInt;
@ -97,8 +112,11 @@ begin
s[Index]:=Source;
s[0]:=chr(index+indexlen);
end;
{$endif FPC_HAS_SHORTSTR_INSERT_CHAR}
{$ifndef FPC_HAS_SHORTSTR_POS_SHORTSTR}
{$define FPC_HAS_SHORTSTR_POS_SHORTSTR}
function pos(const substr : shortstring;const s : shortstring):SizeInt;
var
i,MaxLen : SizeInt;
@ -123,8 +141,11 @@ begin
end;
end;
end;
{$endif FPC_HAS_SHORTSTR_POS_SHORTSTR}
{$ifndef FPC_HAS_SHORTSTR_POS_CHAR}
{$define FPC_HAS_SHORTSTR_POS_CHAR}
{Faster when looking for a single char...}
function pos(c:char;const s:shortstring):SizeInt;
var
@ -143,6 +164,7 @@ begin
end;
pos:=0;
end;
{$endif FPC_HAS_SHORTSTR_POS_CHAR}
function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
@ -162,12 +184,16 @@ begin
end;
{$if not defined(FPC_UPCASE_CHAR) or not defined(FPC_LOWERCASE_CHAR)}
{$ifdef IBM_CHAR_SET}
const
UpCaseTbl : shortstring[7]=#154#142#153#144#128#143#165;
LoCaseTbl : shortstring[7]=#129#132#148#130#135#134#164;
{$endif}
{$endif}
{$ifndef FPC_UPCASE_CHAR}
{$define FPC_UPCASE_CHAR}
function upcase(c : char) : char;
{$IFDEF IBM_CHAR_SET}
var
@ -189,8 +215,11 @@ begin
upcase:=c;
{$ENDIF}
end;
{$endif FPC_UPCASE_CHAR}
{$ifndef FPC_UPCASE_SHORTSTR}
{$define FPC_UPCASE_SHORTSTR}
function upcase(const s : shortstring) : shortstring;
var
i : longint;
@ -199,8 +228,11 @@ begin
for i := 1 to length (s) do
upcase[i] := upcase (s[i]);
end;
{$endif FPC_UPCASE_SHORTSTR}
{$ifndef FPC_LOWERCASE_CHAR}
{$define FPC_LOWERCASE_CHAR}
function lowercase(c : char) : char;overload;
{$IFDEF IBM_CHAR_SET}
var
@ -222,8 +254,11 @@ begin
lowercase:=c;
{$ENDIF}
end;
{$endif FPC_LOWERCASE_CHAR}
{$ifndef FPC_LOWERCASE_SHORTSTR}
{$define FPC_LOWERCASE_SHORTSTR}
function lowercase(const s : shortstring) : shortstring; overload;
var
i : longint;
@ -232,7 +267,7 @@ begin
for i:=1 to length(s) do
lowercase[i]:=lowercase (s[i]);
end;
{$endif FPC_LOWERCASE_SHORTSTR}
const
HexTbl : array[0..15] of char='0123456789ABCDEF';
@ -367,7 +402,7 @@ end;
procedure fpc_shortstr_UInt(v : valUInt;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_UINT']; compilerproc;
begin
int_str(v,s);
int_str_unsigned(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end;
@ -376,7 +411,7 @@ end;
procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_QWORD']; compilerproc;
begin
int_str(v,s);
int_str_unsigned(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end;
@ -407,6 +442,8 @@ begin
end;
{$endif}
{$ifndef FPC_SHORTSTR_ENUM_INTERN}
{$define FPC_SHORTSTR_ENUM_INTERN}
function fpc_shortstr_enum_intern(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring): longint;
{ The following contains the TTypeInfo/TTypeData records from typinfo.pp
@ -544,6 +581,7 @@ end;
{ also define alias for internal use in the system unit }
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);external name 'FPC_SHORTSTR_ENUM';
{$endif FPC_SHORTSTR_ENUM_INTERN}
procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);[public,alias:'FPC_SHORTSTR_BOOL'];compilerproc;
@ -768,7 +806,7 @@ var
ss : shortstring;
maxlen : SizeInt;
begin
int_str(v,ss);
int_str_unsigned(v,ss);
if length(ss)<len then
ss:=space(len-length(ss))+ss;
if length(ss)<high(a)+1 then
@ -786,7 +824,7 @@ var
ss : shortstring;
maxlen : SizeInt;
begin
int_str(v,ss);
int_str_unsigned(v,ss);
if length(ss)<len then
ss:=space(len-length(ss))+ss;
if length(ss)<high(a)+1 then

2
rtl/java/astringh.inc
View File

@ -15,7 +15,7 @@
**********************************************************************}
type
AnsistringClass = class sealed
AnsistringClass = class sealed (JLObject)
private
fdata: TAnsiCharArray;
public

18
rtl/java/compproc.inc
View File

@ -62,10 +62,10 @@ procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: Short
Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
function fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
(*
{ Str() support }
procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
procedure fpc_shortstr_uint(v : valuint;len : SizeInt;out s : shortstring); compilerproc;
(*
{$ifndef FPUNONE}
procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring); compilerproc;
{$endif}
@ -98,10 +98,11 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
procedure fpc_UnicodeStr_uint(v : valuint;Len : SizeInt; out S : UnicodeString); compilerproc;
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
*)
{$ifndef CPU64}
procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring); compilerproc;
procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring); compilerproc;
(*
procedure fpc_chararray_qword(v : qword;len : SizeInt;out a : array of AnsiChar); compilerproc;
procedure fpc_chararray_int64(v : int64;len : SizeInt;out a : array of AnsiChar); compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
@ -119,7 +120,9 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
procedure fpc_UnicodeStr_int64(v : int64;len : SizeInt;out s : UnicodeString); compilerproc;
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
*)
{$endif CPU64}
(*
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef FPUNONE}
@ -346,6 +349,7 @@ Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
(*
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar): ansistring; compilerproc;
@ -358,6 +362,7 @@ Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; comp
procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
*)
(*
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@ -530,6 +535,7 @@ function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
function fpc_round_real(d : ValReal) : int64;compilerproc;
function fpc_trunc_real(d : ValReal) : int64;compilerproc;
{$endif}
(*
{$ifdef FPC_HAS_FEATURE_CLASSES}
function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
@ -553,8 +559,9 @@ function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Point
procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc: Pointer; Params: Pointer); compilerproc;
{$endif FPC_HAS_FEATURE_VARIANTS}
{$endif FPC_HAS_FEATURE_CLASSES}
*)
(*
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
@ -567,7 +574,7 @@ Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc;
function fpc_GetExceptionAddr : Pointer; compilerproc;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
*)
{$ifdef FPC_HAS_FEATURE_OBJECTS}
function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;compilerproc;
@ -581,7 +588,7 @@ procedure fpc_check_object(obj:pointer); compilerproc;
procedure fpc_check_object_ext(vmt,expvmt:pointer);compilerproc;
{$endif dummy}
(*
{$ifdef FPC_HAS_FEATURE_RTTI}
Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc;
Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc;
@ -594,6 +601,7 @@ procedure fpc_decref_array(data,typeinfo: pointer; count: sizeint); compilerproc
Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc;
Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
{$endif FPC_HAS_FEATURE_RTTI}
*)
{ array initialisation helpers (for open array "out" parameters whose elements
are normally refcounted) }
{ open array of unicodestring. normalarrdim contains the number of dimensions

218
rtl/java/java_sys.inc
View File

@ -106,6 +106,39 @@
class function scalb(para1: jfloat; para2: jint): jfloat; static; overload;
end;
JLRuntime = class external 'java.lang' name 'Runtime' (JLObject)
public
class function getRuntime(): JLRuntime; static; overload;
procedure exit(para1: jint); overload; virtual;
procedure addShutdownHook(para1: JLThread); overload; virtual;
function removeShutdownHook(para1: JLThread): jboolean; overload; virtual;
procedure halt(para1: jint); overload; virtual;
class procedure runFinalizersOnExit(para1: jboolean); static; overload;
function exec(para1: JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; para2: Arr1JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; var para2: array of JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; para2: Arr1JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; var para2: array of JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: Arr1JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(var para1: array of JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: Arr1JLString; para2: Arr1JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(var para1: array of JLString; var para2: array of JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: Arr1JLString; para2: Arr1JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function exec(var para1: array of JLString; var para2: array of JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function availableProcessors(): jint; overload; virtual;
function freeMemory(): jlong; overload; virtual;
function totalMemory(): jlong; overload; virtual;
function maxMemory(): jlong; overload; virtual;
procedure gc(); overload; virtual;
procedure runFinalization(); overload; virtual;
procedure traceInstructions(para1: jboolean); overload; virtual;
procedure traceMethodCalls(para1: jboolean); overload; virtual;
procedure load(para1: JLString); overload; virtual;
procedure loadLibrary(para1: JLString); overload; virtual;
function getLocalizedInputStream(para1: JIInputStream): JIInputStream; overload; virtual;
function getLocalizedOutputStream(para1: JIOutputStream): JIOutputStream; overload; virtual;
end;
JLSystem = class sealed external 'java.lang' name 'System' (JLObject)
public
final class var
@ -1064,6 +1097,129 @@
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JUCalendar = class abstract external 'java.util' name 'Calendar' (JLObject, JISerializable, JLCloneable, JLComparable)
public
type
InnerCalendarAccessControlContext = class;
Arr1InnerCalendarAccessControlContext = array of InnerCalendarAccessControlContext;
Arr2InnerCalendarAccessControlContext = array of Arr1InnerCalendarAccessControlContext;
Arr3InnerCalendarAccessControlContext = array of Arr2InnerCalendarAccessControlContext;
InnerCalendarAccessControlContext = class external 'java.util' name 'CalendarAccessControlContext'
end;
public
const
ERA = 0;
YEAR = 1;
MONTH = 2;
WEEK_OF_YEAR = 3;
WEEK_OF_MONTH = 4;
DATE = 5;
DAY_OF_MONTH = 5;
DAY_OF_YEAR = 6;
DAY_OF_WEEK = 7;
DAY_OF_WEEK_IN_MONTH = 8;
AM_PM = 9;
HOUR = 10;
HOUR_OF_DAY = 11;
MINUTE = 12;
SECOND = 13;
MILLISECOND = 14;
ZONE_OFFSET = 15;
DST_OFFSET = 16;
FIELD_COUNT = 17;
SUNDAY = 1;
MONDAY = 2;
TUESDAY = 3;
WEDNESDAY = 4;
THURSDAY = 5;
FRIDAY = 6;
SATURDAY = 7;
JANUARY = 0;
FEBRUARY = 1;
MARCH = 2;
APRIL = 3;
MAY = 4;
JUNE = 5;
JULY = 6;
AUGUST = 7;
SEPTEMBER = 8;
OCTOBER = 9;
NOVEMBER = 10;
DECEMBER = 11;
UNDECIMBER = 12;
AM = 0;
PM = 1;
ALL_STYLES = 0;
SHORT = 1;
LONG = 2;
strict protected
var
ffields: Arr1jint; external name 'fields';
fisSet: Arr1jboolean; external name 'isSet';
ftime: jlong; external name 'time';
fisTimeSet: jboolean; external name 'isTimeSet';
fareFieldsSet: jboolean; external name 'areFieldsSet';
strict protected
constructor create(); overload;
constructor create(para1: JUTimeZone; para2: JULocale); overload;
public
class function getInstance(): JUCalendar; static; overload;
class function getInstance(para1: JUTimeZone): JUCalendar; static; overload;
class function getInstance(para1: JULocale): JUCalendar; static; overload;
class function getInstance(para1: JUTimeZone; para2: JULocale): JUCalendar; static; overload;
class function getAvailableLocales(): Arr1JULocale; static; overload;
strict protected
procedure computeTime(); overload; virtual; abstract;
procedure computeFields(); overload; virtual; abstract;
public
function getTime(): JUDate; overload; virtual; final;
procedure setTime(para1: JUDate); overload; virtual; final;
function getTimeInMillis(): jlong; overload; virtual;
procedure setTimeInMillis(para1: jlong); overload; virtual;
function get(para1: jint): jint; overload; virtual;
strict protected
function internalGet(para1: jint): jint; overload; virtual; final;
public
procedure &set(para1: jint; para2: jint); overload; virtual;
procedure &set(para1: jint; para2: jint; para3: jint); overload; virtual; final;
procedure &set(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint); overload; virtual; final;
procedure &set(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint; para6: jint); overload; virtual; final;
procedure clear(); overload; virtual; final;
procedure clear(para1: jint); overload; virtual; final;
function isSet(para1: jint): jboolean; overload; virtual; final;
function getDisplayName(para1: jint; para2: jint; para3: JULocale): JLString; overload; virtual;
function getDisplayNames(para1: jint; para2: jint; para3: JULocale): JUMap; overload; virtual;
strict protected
procedure complete(); overload; virtual;
public
function equals(para1: JLObject): jboolean; overload; virtual;
function hashCode(): jint; overload; virtual;
function before(para1: JLObject): jboolean; overload; virtual;
function after(para1: JLObject): jboolean; overload; virtual;
function compareTo(para1: JUCalendar): jint; overload; virtual;
procedure add(para1: jint; para2: jint); overload; virtual; abstract;
procedure roll(para1: jint; para2: jboolean); overload; virtual; abstract;
procedure roll(para1: jint; para2: jint); overload; virtual;
procedure setTimeZone(para1: JUTimeZone); overload; virtual;
function getTimeZone(): JUTimeZone; overload; virtual;
procedure setLenient(para1: jboolean); overload; virtual;
function isLenient(): jboolean; overload; virtual;
procedure setFirstDayOfWeek(para1: jint); overload; virtual;
function getFirstDayOfWeek(): jint; overload; virtual;
procedure setMinimalDaysInFirstWeek(para1: jint); overload; virtual;
function getMinimalDaysInFirstWeek(): jint; overload; virtual;
function getMinimum(para1: jint): jint; overload; virtual; abstract;
function getMaximum(para1: jint): jint; overload; virtual; abstract;
function getGreatestMinimum(para1: jint): jint; overload; virtual; abstract;
function getLeastMaximum(para1: jint): jint; overload; virtual; abstract;
function getActualMinimum(para1: jint): jint; overload; virtual;
function getActualMaximum(para1: jint): jint; overload; virtual;
function clone(): JLObject; overload; virtual;
function toString(): JLString; overload; virtual;
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JUCollection = interface external 'java.util' name 'Collection' (JLIterable)
function size(): jint; overload;
function isEmpty(): jboolean; overload;
@ -1570,6 +1726,68 @@
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JMBigInteger = class external 'java.math' name 'BigInteger' (JLNumber, JLComparable)
public
final class var
fZERO: JMBigInteger; external name 'ZERO';
fONE: JMBigInteger; external name 'ONE';
fTEN: JMBigInteger; external name 'TEN';
public
constructor create(para1: Arr1jbyte); overload;
constructor create(const para1: array of jbyte); overload;
constructor create(para1: jint; para2: Arr1jbyte); overload;
constructor create(para1: jint; const para2: array of jbyte); overload;
constructor create(para1: JLString; para2: jint); overload;
constructor create(para1: JLString); overload;
constructor create(para1: jint; para2: JURandom); overload;
constructor create(para1: jint; para2: jint; para3: JURandom); overload;
class function probablePrime(para1: jint; para2: JURandom): JMBigInteger; static; overload;
function nextProbablePrime(): JMBigInteger; overload; virtual;
class function valueOf(para1: jlong): JMBigInteger; static; overload;
function add(para1: JMBigInteger): JMBigInteger; overload; virtual;
function subtract(para1: JMBigInteger): JMBigInteger; overload; virtual;
function multiply(para1: JMBigInteger): JMBigInteger; overload; virtual;
function divide(para1: JMBigInteger): JMBigInteger; overload; virtual;
function divideAndRemainder(para1: JMBigInteger): Arr1JMBigInteger; overload; virtual;
function remainder(para1: JMBigInteger): JMBigInteger; overload; virtual;
function pow(para1: jint): JMBigInteger; overload; virtual;
function gcd(para1: JMBigInteger): JMBigInteger; overload; virtual;
function abs(): JMBigInteger; overload; virtual;
function negate(): JMBigInteger; overload; virtual;
function signum(): jint; overload; virtual;
function &mod(para1: JMBigInteger): JMBigInteger; overload; virtual;
function modPow(para1: JMBigInteger; para2: JMBigInteger): JMBigInteger; overload; virtual;
function modInverse(para1: JMBigInteger): JMBigInteger; overload; virtual;
function shiftLeft(para1: jint): JMBigInteger; overload; virtual;
function shiftRight(para1: jint): JMBigInteger; overload; virtual;
function &and(para1: JMBigInteger): JMBigInteger; overload; virtual;
function &or(para1: JMBigInteger): JMBigInteger; overload; virtual;
function &xor(para1: JMBigInteger): JMBigInteger; overload; virtual;
function &not(): JMBigInteger; overload; virtual;
function andNot(para1: JMBigInteger): JMBigInteger; overload; virtual;
function testBit(para1: jint): jboolean; overload; virtual;
function setBit(para1: jint): JMBigInteger; overload; virtual;
function clearBit(para1: jint): JMBigInteger; overload; virtual;
function flipBit(para1: jint): JMBigInteger; overload; virtual;
function getLowestSetBit(): jint; overload; virtual;
function bitLength(): jint; overload; virtual;
function bitCount(): jint; overload; virtual;
function isProbablePrime(para1: jint): jboolean; overload; virtual;
function compareTo(para1: JMBigInteger): jint; overload; virtual;
function equals(para1: JLObject): jboolean; overload; virtual;
function min(para1: JMBigInteger): JMBigInteger; overload; virtual;
function max(para1: JMBigInteger): JMBigInteger; overload; virtual;
function hashCode(): jint; overload; virtual;
function toString(para1: jint): JLString; overload; virtual;
function toString(): JLString; overload; virtual;
function toByteArray(): Arr1jbyte; overload; virtual;
function intValue(): jint; overload; virtual;
function longValue(): jlong; overload; virtual;
function floatValue(): jfloat; overload; virtual;
function doubleValue(): jdouble; overload; virtual;
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JLError = class external 'java.lang' name 'Error' (JLThrowable)
public
constructor create(); overload;

62
rtl/java/java_sysh.inc
View File

@ -1,4 +1,4 @@
{ Imports for Java packages/classes: java.io.Serializable, java.lang.AbstractStringBuilder, java.lang.Appendable, java.lang.Boolean, java.lang.Byte, java.lang.CharSequence, java.lang.Character, java.lang.Class, java.lang.Cloneable, java.lang.Comparable, java.lang.Double, java.lang.Enum, java.lang.Error, java.lang.Exception, java.lang.Float, java.lang.IllegalArgumentException, java.lang.IndexOutOfBoundsException, java.lang.Integer, java.lang.Iterable, java.lang.LinkageError, java.lang.Long, java.lang.Math, java.lang.NoSuchMethodException, java.lang.Number, java.lang.Object, java.lang.RuntimeException, java.lang.Short, java.lang.String, java.lang.StringBuffer, java.lang.StringBuilder, java.lang.System, java.lang.Throwable, java.lang.reflect.AccessibleObject, java.lang.reflect.AnnotatedElement, java.lang.reflect.Array, java.lang.reflect.GenericDeclaration, java.lang.reflect.Member, java.lang.reflect.Method, java.lang.reflect.Type, java.text.Collator, java.util.AbstractCollection, java.util.AbstractMap, java.util.AbstractSet, java.util.Arrays, java.util.BitSet, java.util.Collection, java.util.Comparator, java.util.EnumSet, java.util.HashMap, java.util.Iterator, java.util.Map, java.util.Set }
{ Imports for Java packages/classes: java.io.Serializable, java.lang.AbstractStringBuilder, java.lang.Appendable, java.lang.Boolean, java.lang.Byte, java.lang.CharSequence, java.lang.Character, java.lang.Class, java.lang.Cloneable, java.lang.Comparable, java.lang.Double, java.lang.Enum, java.lang.Error, java.lang.Exception, java.lang.Float, java.lang.IllegalArgumentException, java.lang.IndexOutOfBoundsException, java.lang.Integer, java.lang.Iterable, java.lang.LinkageError, java.lang.Long, java.lang.Math, java.lang.NoSuchMethodException, java.lang.Number, java.lang.Object, java.lang.Runtime, java.lang.RuntimeException, java.lang.Short, java.lang.String, java.lang.StringBuffer, java.lang.StringBuilder, java.lang.System, java.lang.Throwable, java.lang.reflect.AccessibleObject, java.lang.reflect.AnnotatedElement, java.lang.reflect.Array, java.lang.reflect.GenericDeclaration, java.lang.reflect.Member, java.lang.reflect.Method, java.lang.reflect.Type, java.math.BigInteger, java.text.Collator, java.util.AbstractCollection, java.util.AbstractMap, java.util.AbstractSet, java.util.Arrays, java.util.BitSet, java.util.Calendar, java.util.Collection, java.util.Comparator, java.util.EnumSet, java.util.HashMap, java.util.Iterator, java.util.Map, java.util.Set }
type
JLNoSuchMethodException = class;
Arr1JLNoSuchMethodException = array of JLNoSuchMethodException;
@ -50,6 +50,11 @@ type
Arr2JLCharacter = array of Arr1JLCharacter;
Arr3JLCharacter = array of Arr2JLCharacter;
JMBigInteger = class;
Arr1JMBigInteger = array of JMBigInteger;
Arr2JMBigInteger = array of Arr1JMBigInteger;
Arr3JMBigInteger = array of Arr2JMBigInteger;
JUArrays = class;
Arr1JUArrays = array of JUArrays;
Arr2JUArrays = array of Arr1JUArrays;
@ -60,6 +65,11 @@ type
Arr2JLBoolean = array of Arr1JLBoolean;
Arr3JLBoolean = array of Arr2JLBoolean;
JLRuntime = class;
Arr1JLRuntime = array of JLRuntime;
Arr2JLRuntime = array of Arr1JLRuntime;
Arr3JLRuntime = array of Arr2JLRuntime;
JLLong = class;
Arr1JLLong = array of JLLong;
Arr2JLLong = array of Arr1JLLong;
@ -135,6 +145,11 @@ type
Arr2JLDouble = array of Arr1JLDouble;
Arr3JLDouble = array of Arr2JLDouble;
JUCalendar = class;
Arr1JUCalendar = array of JUCalendar;
Arr2JUCalendar = array of Arr1JUCalendar;
Arr3JUCalendar = array of Arr2JUCalendar;
JTCollator = class;
Arr1JTCollator = array of JTCollator;
Arr2JTCollator = array of Arr1JTCollator;
@ -260,6 +275,11 @@ type
Arr2JISerializable = array of Arr1JISerializable;
Arr3JISerializable = array of Arr2JISerializable;
JIFile = class external 'java.io' name 'File';
Arr1JIFile = array of JIFile;
Arr2JIFile = array of Arr1JIFile;
Arr3JIFile = array of Arr2JIFile;
JLStackTraceElement = class external 'java.lang' name 'StackTraceElement';
Arr1JLStackTraceElement = array of JLStackTraceElement;
Arr2JLStackTraceElement = array of Arr1JLStackTraceElement;
@ -270,6 +290,16 @@ type
Arr2JLClassLoader = array of Arr1JLClassLoader;
Arr3JLClassLoader = array of Arr2JLClassLoader;
JUDate = class external 'java.util' name 'Date';
Arr1JUDate = array of JUDate;
Arr2JUDate = array of Arr1JUDate;
Arr3JUDate = array of Arr2JUDate;
JLThread = class external 'java.lang' name 'Thread';
Arr1JLThread = array of JLThread;
Arr2JLThread = array of Arr1JLThread;
Arr3JLThread = array of Arr2JLThread;
JUProperties = class external 'java.util' name 'Properties';
Arr1JUProperties = array of JUProperties;
Arr2JUProperties = array of Arr1JUProperties;
@ -290,16 +320,16 @@ type
Arr2JSProtectionDomain = array of Arr1JSProtectionDomain;
Arr3JSProtectionDomain = array of Arr2JSProtectionDomain;
JIPrintStream = class external 'java.io' name 'PrintStream';
Arr1JIPrintStream = array of JIPrintStream;
Arr2JIPrintStream = array of Arr1JIPrintStream;
Arr3JIPrintStream = array of Arr2JIPrintStream;
JLRField = class external 'java.lang.reflect' name 'Field';
Arr1JLRField = array of JLRField;
Arr2JLRField = array of Arr1JLRField;
Arr3JLRField = array of Arr2JLRField;
JIPrintStream = class external 'java.io' name 'PrintStream';
Arr1JIPrintStream = array of JIPrintStream;
Arr2JIPrintStream = array of Arr1JIPrintStream;
Arr3JIPrintStream = array of Arr2JIPrintStream;
JTCollationKey = class external 'java.text' name 'CollationKey';
Arr1JTCollationKey = array of JTCollationKey;
Arr2JTCollationKey = array of Arr1JTCollationKey;
@ -325,6 +355,11 @@ type
Arr2JNURL = array of Arr1JNURL;
Arr3JNURL = array of Arr2JNURL;
JLProcess = class external 'java.lang' name 'Process';
Arr1JLProcess = array of JLProcess;
Arr2JLProcess = array of Arr1JLProcess;
Arr3JLProcess = array of Arr2JLProcess;
JIConsole = class external 'java.io' name 'Console';
Arr1JIConsole = array of JIConsole;
Arr2JIConsole = array of Arr1JIConsole;
@ -340,6 +375,21 @@ type
Arr2JNCCharset = array of Arr1JNCCharset;
Arr3JNCCharset = array of Arr2JNCCharset;
JUTimeZone = class external 'java.util' name 'TimeZone';
Arr1JUTimeZone = array of JUTimeZone;
Arr2JUTimeZone = array of Arr1JUTimeZone;
Arr3JUTimeZone = array of Arr2JUTimeZone;
JURandom = class external 'java.util' name 'Random';
Arr1JURandom = array of JURandom;
Arr2JURandom = array of Arr1JURandom;
Arr3JURandom = array of Arr2JURandom;
JIOutputStream = class external 'java.io' name 'OutputStream';
Arr1JIOutputStream = array of JIOutputStream;
Arr2JIOutputStream = array of Arr1JIOutputStream;
Arr3JIOutputStream = array of Arr2JIOutputStream;
JUList = interface external 'java.util' name 'List';
Arr1JUList = array of JUList;
Arr2JUList = array of Arr1JUList;

350
rtl/java/jdk15.inc
View File

@ -1949,39 +1949,6 @@
procedure run(); overload;
end;
JLRuntime = class external 'java.lang' name 'Runtime' (JLObject)
public
class function getRuntime(): JLRuntime; static; overload;
procedure exit(para1: jint); overload; virtual;
procedure addShutdownHook(para1: JLThread); overload; virtual;
function removeShutdownHook(para1: JLThread): jboolean; overload; virtual;
procedure halt(para1: jint); overload; virtual;
class procedure runFinalizersOnExit(para1: jboolean); static; overload;
function exec(para1: JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; para2: Arr1JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; var para2: array of JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; para2: Arr1JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: JLString; var para2: array of JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: Arr1JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(var para1: array of JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: Arr1JLString; para2: Arr1JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(var para1: array of JLString; var para2: array of JLString): JLProcess; overload; virtual; // throws java.io.IOException
function exec(para1: Arr1JLString; para2: Arr1JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function exec(var para1: array of JLString; var para2: array of JLString; para3: JIFile): JLProcess; overload; virtual; // throws java.io.IOException
function availableProcessors(): jint; overload; virtual;
function freeMemory(): jlong; overload; virtual;
function totalMemory(): jlong; overload; virtual;
function maxMemory(): jlong; overload; virtual;
procedure gc(); overload; virtual;
procedure runFinalization(); overload; virtual;
procedure traceInstructions(para1: jboolean); overload; virtual;
procedure traceMethodCalls(para1: jboolean); overload; virtual;
procedure load(para1: JLString); overload; virtual;
procedure loadLibrary(para1: JLString); overload; virtual;
function getLocalizedInputStream(para1: JIInputStream): JIInputStream; overload; virtual;
function getLocalizedOutputStream(para1: JIOutputStream): JIOutputStream; overload; virtual;
end;
JLSecurityManager = class external 'java.lang' name 'SecurityManager' (JLObject)
strict protected
var
@ -23579,129 +23546,6 @@
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JUCalendar = class abstract external 'java.util' name 'Calendar' (JLObject, JISerializable, JLCloneable, JLComparable)
public
type
InnerCalendarAccessControlContext = class;
Arr1InnerCalendarAccessControlContext = array of InnerCalendarAccessControlContext;
Arr2InnerCalendarAccessControlContext = array of Arr1InnerCalendarAccessControlContext;
Arr3InnerCalendarAccessControlContext = array of Arr2InnerCalendarAccessControlContext;
InnerCalendarAccessControlContext = class external 'java.util' name 'CalendarAccessControlContext'
end;
public
const
ERA = 0;
YEAR = 1;
MONTH = 2;
WEEK_OF_YEAR = 3;
WEEK_OF_MONTH = 4;
DATE = 5;
DAY_OF_MONTH = 5;
DAY_OF_YEAR = 6;
DAY_OF_WEEK = 7;
DAY_OF_WEEK_IN_MONTH = 8;
AM_PM = 9;
HOUR = 10;
HOUR_OF_DAY = 11;
MINUTE = 12;
SECOND = 13;
MILLISECOND = 14;
ZONE_OFFSET = 15;
DST_OFFSET = 16;
FIELD_COUNT = 17;
SUNDAY = 1;
MONDAY = 2;
TUESDAY = 3;
WEDNESDAY = 4;
THURSDAY = 5;
FRIDAY = 6;
SATURDAY = 7;
JANUARY = 0;
FEBRUARY = 1;
MARCH = 2;
APRIL = 3;
MAY = 4;
JUNE = 5;
JULY = 6;
AUGUST = 7;
SEPTEMBER = 8;
OCTOBER = 9;
NOVEMBER = 10;
DECEMBER = 11;
UNDECIMBER = 12;
AM = 0;
PM = 1;
ALL_STYLES = 0;
SHORT = 1;
LONG = 2;
strict protected
var
ffields: Arr1jint; external name 'fields';
fisSet: Arr1jboolean; external name 'isSet';
ftime: jlong; external name 'time';
fisTimeSet: jboolean; external name 'isTimeSet';
fareFieldsSet: jboolean; external name 'areFieldsSet';
strict protected
constructor create(); overload;
constructor create(para1: JUTimeZone; para2: JULocale); overload;
public
class function getInstance(): JUCalendar; static; overload;
class function getInstance(para1: JUTimeZone): JUCalendar; static; overload;
class function getInstance(para1: JULocale): JUCalendar; static; overload;
class function getInstance(para1: JUTimeZone; para2: JULocale): JUCalendar; static; overload;
class function getAvailableLocales(): Arr1JULocale; static; overload;
strict protected
procedure computeTime(); overload; virtual; abstract;
procedure computeFields(); overload; virtual; abstract;
public
function getTime(): JUDate; overload; virtual; final;
procedure setTime(para1: JUDate); overload; virtual; final;
function getTimeInMillis(): jlong; overload; virtual;
procedure setTimeInMillis(para1: jlong); overload; virtual;
function get(para1: jint): jint; overload; virtual;
strict protected
function internalGet(para1: jint): jint; overload; virtual; final;
public
procedure &set(para1: jint; para2: jint); overload; virtual;
procedure &set(para1: jint; para2: jint; para3: jint); overload; virtual; final;
procedure &set(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint); overload; virtual; final;
procedure &set(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint; para6: jint); overload; virtual; final;
procedure clear(); overload; virtual; final;
procedure clear(para1: jint); overload; virtual; final;
function isSet(para1: jint): jboolean; overload; virtual; final;
function getDisplayName(para1: jint; para2: jint; para3: JULocale): JLString; overload; virtual;
function getDisplayNames(para1: jint; para2: jint; para3: JULocale): JUMap; overload; virtual;
strict protected
procedure complete(); overload; virtual;
public
function equals(para1: JLObject): jboolean; overload; virtual;
function hashCode(): jint; overload; virtual;
function before(para1: JLObject): jboolean; overload; virtual;
function after(para1: JLObject): jboolean; overload; virtual;
function compareTo(para1: JUCalendar): jint; overload; virtual;
procedure add(para1: jint; para2: jint); overload; virtual; abstract;
procedure roll(para1: jint; para2: jboolean); overload; virtual; abstract;
procedure roll(para1: jint; para2: jint); overload; virtual;
procedure setTimeZone(para1: JUTimeZone); overload; virtual;
function getTimeZone(): JUTimeZone; overload; virtual;
procedure setLenient(para1: jboolean); overload; virtual;
function isLenient(): jboolean; overload; virtual;
procedure setFirstDayOfWeek(para1: jint); overload; virtual;
function getFirstDayOfWeek(): jint; overload; virtual;
procedure setMinimalDaysInFirstWeek(para1: jint); overload; virtual;
function getMinimalDaysInFirstWeek(): jint; overload; virtual;
function getMinimum(para1: jint): jint; overload; virtual; abstract;
function getMaximum(para1: jint): jint; overload; virtual; abstract;
function getGreatestMinimum(para1: jint): jint; overload; virtual; abstract;
function getLeastMaximum(para1: jint): jint; overload; virtual; abstract;
function getActualMinimum(para1: jint): jint; overload; virtual;
function getActualMaximum(para1: jint): jint; overload; virtual;
function clone(): JLObject; overload; virtual;
function toString(): JLString; overload; virtual;
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JUDate = class external 'java.util' name 'Date' (JLObject, JISerializable, JLCloneable, JLComparable)
public
constructor create(); overload;
@ -24184,68 +24028,6 @@
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JMBigInteger = class external 'java.math' name 'BigInteger' (JLNumber, JLComparable)
public
final class var
fZERO: JMBigInteger; external name 'ZERO';
fONE: JMBigInteger; external name 'ONE';
fTEN: JMBigInteger; external name 'TEN';
public
constructor create(para1: Arr1jbyte); overload;
constructor create(const para1: array of jbyte); overload;
constructor create(para1: jint; para2: Arr1jbyte); overload;
constructor create(para1: jint; const para2: array of jbyte); overload;
constructor create(para1: JLString; para2: jint); overload;
constructor create(para1: JLString); overload;
constructor create(para1: jint; para2: JURandom); overload;
constructor create(para1: jint; para2: jint; para3: JURandom); overload;
class function probablePrime(para1: jint; para2: JURandom): JMBigInteger; static; overload;
function nextProbablePrime(): JMBigInteger; overload; virtual;
class function valueOf(para1: jlong): JMBigInteger; static; overload;
function add(para1: JMBigInteger): JMBigInteger; overload; virtual;
function subtract(para1: JMBigInteger): JMBigInteger; overload; virtual;
function multiply(para1: JMBigInteger): JMBigInteger; overload; virtual;
function divide(para1: JMBigInteger): JMBigInteger; overload; virtual;
function divideAndRemainder(para1: JMBigInteger): Arr1JMBigInteger; overload; virtual;
function remainder(para1: JMBigInteger): JMBigInteger; overload; virtual;
function pow(para1: jint): JMBigInteger; overload; virtual;
function gcd(para1: JMBigInteger): JMBigInteger; overload; virtual;
function abs(): JMBigInteger; overload; virtual;
function negate(): JMBigInteger; overload; virtual;
function signum(): jint; overload; virtual;
function &mod(para1: JMBigInteger): JMBigInteger; overload; virtual;
function modPow(para1: JMBigInteger; para2: JMBigInteger): JMBigInteger; overload; virtual;
function modInverse(para1: JMBigInteger): JMBigInteger; overload; virtual;
function shiftLeft(para1: jint): JMBigInteger; overload; virtual;
function shiftRight(para1: jint): JMBigInteger; overload; virtual;
function &and(para1: JMBigInteger): JMBigInteger; overload; virtual;
function &or(para1: JMBigInteger): JMBigInteger; overload; virtual;
function &xor(para1: JMBigInteger): JMBigInteger; overload; virtual;
function &not(): JMBigInteger; overload; virtual;
function andNot(para1: JMBigInteger): JMBigInteger; overload; virtual;
function testBit(para1: jint): jboolean; overload; virtual;
function setBit(para1: jint): JMBigInteger; overload; virtual;
function clearBit(para1: jint): JMBigInteger; overload; virtual;
function flipBit(para1: jint): JMBigInteger; overload; virtual;
function getLowestSetBit(): jint; overload; virtual;
function bitLength(): jint; overload; virtual;
function bitCount(): jint; overload; virtual;
function isProbablePrime(para1: jint): jboolean; overload; virtual;
function compareTo(para1: JMBigInteger): jint; overload; virtual;
function equals(para1: JLObject): jboolean; overload; virtual;
function min(para1: JMBigInteger): JMBigInteger; overload; virtual;
function max(para1: JMBigInteger): JMBigInteger; overload; virtual;
function hashCode(): jint; overload; virtual;
function toString(para1: jint): JLString; overload; virtual;
function toString(): JLString; overload; virtual;
function toByteArray(): Arr1jbyte; overload; virtual;
function intValue(): jint; overload; virtual;
function longValue(): jlong; overload; virtual;
function floatValue(): jfloat; overload; virtual;
function doubleValue(): jdouble; overload; virtual;
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JUCAAtomicInteger = class external 'java.util.concurrent.atomic' name 'AtomicInteger' (JLNumber, JISerializable)
public
constructor create(para1: jint); overload;
@ -24584,6 +24366,72 @@
function entrySet(): JUSet; overload; virtual;
end;
JUGregorianCalendar = class external 'java.util' name 'GregorianCalendar' (JUCalendar)
public
const
BC = 0;
AD = 1;
public
constructor create(); overload;
constructor create(para1: JUTimeZone); overload;
constructor create(para1: JULocale); overload;
constructor create(para1: JUTimeZone; para2: JULocale); overload;
constructor create(para1: jint; para2: jint; para3: jint); overload;
constructor create(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint); overload;
constructor create(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint; para6: jint); overload;
procedure setGregorianChange(para1: JUDate); overload; virtual;
function getGregorianChange(): JUDate; overload; virtual; final;
function isLeapYear(para1: jint): jboolean; overload; virtual;
function equals(para1: JLObject): jboolean; overload; virtual;
function hashCode(): jint; overload; virtual;
procedure add(para1: jint; para2: jint); overload; virtual;
procedure roll(para1: jint; para2: jboolean); overload; virtual;
procedure roll(para1: jint; para2: jint); overload; virtual;
function getMinimum(para1: jint): jint; overload; virtual;
function getMaximum(para1: jint): jint; overload; virtual;
function getGreatestMinimum(para1: jint): jint; overload; virtual;
function getLeastMaximum(para1: jint): jint; overload; virtual;
function getActualMinimum(para1: jint): jint; overload; virtual;
function getActualMaximum(para1: jint): jint; overload; virtual;
function clone(): JLObject; overload; virtual;
function getTimeZone(): JUTimeZone; overload; virtual;
procedure setTimeZone(para1: JUTimeZone); overload; virtual;
strict protected
procedure computeFields(); overload; virtual;
procedure computeTime(); overload; virtual;
end;
JUJapaneseImperialCalendar = class external 'java.util' name 'JapaneseImperialCalendar' (JUCalendar)
public
const
BEFORE_MEIJI = 0;
MEIJI = 1;
TAISHO = 2;
SHOWA = 3;
HEISEI = 4;
public
constructor create(para1: JUTimeZone; para2: JULocale); overload;
function equals(para1: JLObject): jboolean; overload; virtual;
function hashCode(): jint; overload; virtual;
procedure add(para1: jint; para2: jint); overload; virtual;
procedure roll(para1: jint; para2: jboolean); overload; virtual;
procedure roll(para1: jint; para2: jint); overload; virtual;
function getDisplayName(para1: jint; para2: jint; para3: JULocale): JLString; overload; virtual;
function getDisplayNames(para1: jint; para2: jint; para3: JULocale): JUMap; overload; virtual;
function getMinimum(para1: jint): jint; overload; virtual;
function getMaximum(para1: jint): jint; overload; virtual;
function getGreatestMinimum(para1: jint): jint; overload; virtual;
function getLeastMaximum(para1: jint): jint; overload; virtual;
function getActualMinimum(para1: jint): jint; overload; virtual;
function getActualMaximum(para1: jint): jint; overload; virtual;
function clone(): JLObject; overload; virtual;
function getTimeZone(): JUTimeZone; overload; virtual;
procedure setTimeZone(para1: JUTimeZone); overload; virtual;
strict protected
procedure computeFields(); overload; virtual;
procedure computeTime(); overload; virtual;
end;
JUCCopyOnWriteArraySet = class external 'java.util.concurrent' name 'CopyOnWriteArraySet' (JUAbstractSet, JISerializable)
public
constructor create(); overload;
@ -43681,72 +43529,6 @@
function compareTo(para1: JLObject): jint; overload; virtual;
end;
JUGregorianCalendar = class external 'java.util' name 'GregorianCalendar' (JUCalendar)
public
const
BC = 0;
AD = 1;
public
constructor create(); overload;
constructor create(para1: JUTimeZone); overload;
constructor create(para1: JULocale); overload;
constructor create(para1: JUTimeZone; para2: JULocale); overload;
constructor create(para1: jint; para2: jint; para3: jint); overload;
constructor create(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint); overload;
constructor create(para1: jint; para2: jint; para3: jint; para4: jint; para5: jint; para6: jint); overload;
procedure setGregorianChange(para1: JUDate); overload; virtual;
function getGregorianChange(): JUDate; overload; virtual; final;
function isLeapYear(para1: jint): jboolean; overload; virtual;
function equals(para1: JLObject): jboolean; overload; virtual;
function hashCode(): jint; overload; virtual;
procedure add(para1: jint; para2: jint); overload; virtual;
procedure roll(para1: jint; para2: jboolean); overload; virtual;
procedure roll(para1: jint; para2: jint); overload; virtual;
function getMinimum(para1: jint): jint; overload; virtual;
function getMaximum(para1: jint): jint; overload; virtual;
function getGreatestMinimum(para1: jint): jint; overload; virtual;
function getLeastMaximum(para1: jint): jint; overload; virtual;
function getActualMinimum(para1: jint): jint; overload; virtual;
function getActualMaximum(para1: jint): jint; overload; virtual;
function clone(): JLObject; overload; virtual;
function getTimeZone(): JUTimeZone; overload; virtual;
procedure setTimeZone(para1: JUTimeZone); overload; virtual;
strict protected
procedure computeFields(); overload; virtual;
procedure computeTime(); overload; virtual;
end;
JUJapaneseImperialCalendar = class external 'java.util' name 'JapaneseImperialCalendar' (JUCalendar)
public
const
BEFORE_MEIJI = 0;
MEIJI = 1;
TAISHO = 2;
SHOWA = 3;
HEISEI = 4;
public
constructor create(para1: JUTimeZone; para2: JULocale); overload;
function equals(para1: JLObject): jboolean; overload; virtual;
function hashCode(): jint; overload; virtual;
procedure add(para1: jint; para2: jint); overload; virtual;
procedure roll(para1: jint; para2: jboolean); overload; virtual;
procedure roll(para1: jint; para2: jint); overload; virtual;
function getDisplayName(para1: jint; para2: jint; para3: JULocale): JLString; overload; virtual;
function getDisplayNames(para1: jint; para2: jint; para3: JULocale): JUMap; overload; virtual;
function getMinimum(para1: jint): jint; overload; virtual;
function getMaximum(para1: jint): jint; overload; virtual;
function getGreatestMinimum(para1: jint): jint; overload; virtual;
function getLeastMaximum(para1: jint): jint; overload; virtual;
function getActualMinimum(para1: jint): jint; overload; virtual;
function getActualMaximum(para1: jint): jint; overload; virtual;
function clone(): JLObject; overload; virtual;
function getTimeZone(): JUTimeZone; overload; virtual;
procedure setTimeZone(para1: JUTimeZone); overload; virtual;
strict protected
procedure computeFields(); overload; virtual;
procedure computeTime(); overload; virtual;
end;
JSDate = class external 'java.sql' name 'Date' (JUDate)
public
constructor create(para1: jint; para2: jint; para3: jint); overload;

53
rtl/java/jdk15.pas
View File

@ -1645,11 +1645,6 @@ type
Arr2JNDoubleBuffer = array of Arr1JNDoubleBuffer;
Arr3JNDoubleBuffer = array of Arr2JNDoubleBuffer;
JMBigInteger = class;
Arr1JMBigInteger = array of JMBigInteger;
Arr2JMBigInteger = array of Arr1JMBigInteger;
Arr3JMBigInteger = array of Arr2JMBigInteger;
JMOInvalidOpenTypeException = class;
Arr1JMOInvalidOpenTypeException = array of JMOInvalidOpenTypeException;
Arr2JMOInvalidOpenTypeException = array of Arr1JMOInvalidOpenTypeException;
@ -5980,26 +5975,26 @@ type
Arr2OOPServerForwardRequest = array of Arr1OOPServerForwardRequest;
Arr3OOPServerForwardRequest = array of Arr2OOPServerForwardRequest;
JNCookieHandler = class;
Arr1JNCookieHandler = array of JNCookieHandler;
Arr2JNCookieHandler = array of Arr1JNCookieHandler;
Arr3JNCookieHandler = array of Arr2JNCookieHandler;
JUObservable = class;
Arr1JUObservable = array of JUObservable;
Arr2JUObservable = array of Arr1JUObservable;
Arr3JUObservable = array of Arr2JUObservable;
JUJapaneseImperialCalendar = class;
Arr1JUJapaneseImperialCalendar = array of JUJapaneseImperialCalendar;
Arr2JUJapaneseImperialCalendar = array of Arr1JUJapaneseImperialCalendar;
Arr3JUJapaneseImperialCalendar = array of Arr2JUJapaneseImperialCalendar;
JNCookieHandler = class;
Arr1JNCookieHandler = array of JNCookieHandler;
Arr2JNCookieHandler = array of Arr1JNCookieHandler;
Arr3JNCookieHandler = array of Arr2JNCookieHandler;
JXCDDOMStructure = class;
Arr1JXCDDOMStructure = array of JXCDDOMStructure;
Arr2JXCDDOMStructure = array of Arr1JXCDDOMStructure;
Arr3JXCDDOMStructure = array of Arr2JXCDDOMStructure;
JUJapaneseImperialCalendar = class;
Arr1JUJapaneseImperialCalendar = array of JUJapaneseImperialCalendar;
Arr2JUJapaneseImperialCalendar = array of Arr1JUJapaneseImperialCalendar;
Arr3JUJapaneseImperialCalendar = array of Arr2JUJapaneseImperialCalendar;
JXSUStreamReaderDelegate = class;
Arr1JXSUStreamReaderDelegate = array of JXSUStreamReaderDelegate;
Arr2JXSUStreamReaderDelegate = array of Arr1JXSUStreamReaderDelegate;
@ -8030,11 +8025,6 @@ type
Arr2JSPBBasicInternalFrameUI = array of Arr1JSPBBasicInternalFrameUI;
Arr3JSPBBasicInternalFrameUI = array of Arr2JSPBBasicInternalFrameUI;
JLRuntime = class;
Arr1JLRuntime = array of JLRuntime;
Arr2JLRuntime = array of Arr1JLRuntime;
Arr3JLRuntime = array of Arr2JLRuntime;
JADimension = class;
Arr1JADimension = array of JADimension;
Arr2JADimension = array of Arr1JADimension;
@ -9800,16 +9790,16 @@ type
Arr2JSSAudioPermission = array of Arr1JSSAudioPermission;
Arr3JSSAudioPermission = array of Arr2JSSAudioPermission;
JAEInputEvent = class;
Arr1JAEInputEvent = array of JAEInputEvent;
Arr2JAEInputEvent = array of Arr1JAEInputEvent;
Arr3JAEInputEvent = array of Arr2JAEInputEvent;
JULocaleISOData = class;
Arr1JULocaleISOData = array of JULocaleISOData;
Arr2JULocaleISOData = array of Arr1JULocaleISOData;
Arr3JULocaleISOData = array of Arr2JULocaleISOData;
JAEInputEvent = class;
Arr1JAEInputEvent = array of JAEInputEvent;
Arr2JAEInputEvent = array of Arr1JAEInputEvent;
Arr3JAEInputEvent = array of Arr2JAEInputEvent;
JAPoint = class;
Arr1JAPoint = array of JAPoint;
Arr2JAPoint = array of Arr1JAPoint;
@ -14705,11 +14695,6 @@ type
Arr2JSCCRLException = array of Arr1JSCCRLException;
Arr3JSCCRLException = array of Arr2JSCCRLException;
JUCalendar = class;
Arr1JUCalendar = array of JUCalendar;
Arr2JUCalendar = array of Arr1JUCalendar;
Arr3JUCalendar = array of Arr2JUCalendar;
JNHeapByteBufferR = class;
Arr1JNHeapByteBufferR = array of JNHeapByteBufferR;
Arr2JNHeapByteBufferR = array of Arr1JNHeapByteBufferR;
@ -20705,6 +20690,11 @@ type
Arr2JLCharacter = array of Arr1JLCharacter;
Arr3JLCharacter = array of Arr2JLCharacter;
JMBigInteger = class external 'java.math' name 'BigInteger';
Arr1JMBigInteger = array of JMBigInteger;
Arr2JMBigInteger = array of Arr1JMBigInteger;
Arr3JMBigInteger = array of Arr2JMBigInteger;
JLBoolean = class external 'java.lang' name 'Boolean';
Arr1JLBoolean = array of JLBoolean;
Arr2JLBoolean = array of Arr1JLBoolean;
@ -20760,6 +20750,11 @@ type
Arr2JUHashMap = array of Arr1JUHashMap;
Arr3JUHashMap = array of Arr2JUHashMap;
JUCalendar = class external 'java.util' name 'Calendar';
Arr1JUCalendar = array of JUCalendar;
Arr2JUCalendar = array of Arr1JUCalendar;
Arr3JUCalendar = array of Arr2JUCalendar;
JTCollator = class external 'java.text' name 'Collator';
Arr1JTCollator = array of JTCollator;
Arr2JTCollator = array of Arr1JTCollator;

394
rtl/java/jdynarr.inc Normal file
View File

@ -0,0 +1,394 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
This file implements the helper routines for dyn. Arrays in FPC
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}
function min(a,b : longint) : longint;
begin
if a<=b then
min:=a
else
min:=b;
end;
{$i jrec.inc}
{$i jset.inc}
{$i jpvar.inc}
{$i jsystem.inc}
{ copying helpers }
procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
var
srclen, dstlen: jint;
begin
if assigned(src) then
srclen:=JLRArray.getLength(src)
else
srclen:=0;
if assigned(dst) then
dstlen:=JLRArray.getLength(dst)
else
dstlen:=0;
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ causes exception in JLSystem.arraycopy }
if (srccopylen=0) or
(dstlen=0) then
exit;
JLSystem.arraycopy(src,srcstart,dst,0,min(srccopylen,dstlen));
end;
procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
src[srcstart+i].fpcDeepCopy(dst[i]);
end;
procedure fpc_copy_jenumset_array(src, dst: TJEnumSetArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
begin
dst[i].clear;
dst[i].addAll(src[srcstart+i]);
end;
end;
procedure fpc_copy_jbitset_array(src, dst: TJBitSetArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
begin
dst[i].clear;
dst[i].addAll(src[srcstart+i]);
end;
end;
procedure fpc_copy_jprocvar_array(src, dst: TJProcVarArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
src[srcstart+i].fpcDeepCopy(dst[i]);
end;
procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
pshortstring(src[srcstart+i])^:=pshortstring(dst[i])^;
end;
{ 1-dimensional setlength routines }
function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
var
orglen, newlen: jint;
begin
orglen:=0;
newlen:=0;
if not deepcopy then
begin
if assigned(aorg) then
orglen:=JLRArray.getLength(aorg)
else
orglen:=0;
if assigned(anew) then
newlen:=JLRArray.getLength(anew)
else
newlen:=0;
end;
if deepcopy or
(orglen<>newlen) then
begin
if docopy then
fpc_copy_shallow_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jrecord_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jenumset(aorg, anew: TJEnumSetArray; deepcopy: boolean): TJEnumSetArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jenumset_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jbitset(aorg, anew: TJBitSetArray; deepcopy: boolean): TJBitSetArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jbitset_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jprocvar(aorg, anew: TJProcVarArray; deepcopy: boolean): TJProcVarArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jprocvar_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jshortstring_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
{ multi-dimensional setlength routine }
function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
var
partdone,
i: longint;
begin
{ resize the current dimension; no need to copy the subarrays of the old
array, as the subarrays will be (re-)initialised immediately below }
{ the srcstart/srccopylen always refers to the first dimension (since copy()
performs a shallow copy of a dynamic array }
result:=TJObjectArray(fpc_setlength_dynarr_generic(JLObject(aorg),JLObject(anew),deepcopy,false));
{ if aorg was empty, there's nothing else to do since result will now
contain anew, of which all other dimensions are already initialised
correctly since there are no aorg elements to copy }
if not assigned(aorg) and
not deepcopy then
exit;
partdone:=min(high(result),high(aorg));
{ ndim must be >=2 when this routine is called, since it has to return
an array of java.lang.Object! (arrays are also objects, but primitive
types are not) }
if ndim=2 then
begin
{ final dimension -> copy the primitive arrays }
case eletype of
FPCJDynArrTypeRecord:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jrecord(TJRecordArray(aorg[i]),TJRecordArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeEnumSet:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jenumset(TJEnumSetArray(aorg[i]),TJEnumSetArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jenumset(nil,TJEnumSetArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeBitSet:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jbitset(TJBitSetArray(aorg[i]),TJBitSetArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jbitset(nil,TJBitSetArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeProcVar:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jprocvar(TJProcVarArray(aorg[i]),TJProcVarArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jprocvar(nil,TJProcVarArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeShortstring:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(TShortstringArray(aorg[i]),TShortstringArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(nil,TShortstringArray(anew[i]),deepcopy));
end;
else
begin
for i:=low(result) to partdone do
result[i]:=fpc_setlength_dynarr_generic(aorg[i],anew[i],deepcopy);
for i:=succ(partdone) to high(result) do
result[i]:=fpc_setlength_dynarr_generic(nil,anew[i],deepcopy);
end;
end;
end
else
begin
{ recursively handle the next dimension }
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_multidim(TJObjectArray(aorg[i]),TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_multidim(nil,TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
end;
end;
function fpc_dynarray_copy(src: JLObject; start, len: longint; ndim: longint; eletype: jchar): JLObject;
var
i: longint;
srclen: longint;
begin
if not assigned(src) then
begin
result:=nil;
exit;
end;
srclen:=JLRArray.getLength(src);
if (start=-1) and
(len=-1) then
begin
len:=srclen;
start:=0;
end
else if (start+len>srclen) then
len:=srclen-start+1;
result:=JLRArray.newInstance(src.getClass.getComponentType,len);
if ndim=1 then
begin
case eletype of
FPCJDynArrTypeRecord:
fpc_copy_jrecord_array(TJRecordArray(src),TJRecordArray(result),start,len);
FPCJDynArrTypeEnumSet:
fpc_copy_jenumset_array(TJEnumSetArray(src),TJEnumSetArray(result),start,len);
FPCJDynArrTypeBitSet:
fpc_copy_jbitset_array(TJBitSetArray(src),TJBitSetArray(result),start,len);
FPCJDynArrTypeProcvar:
fpc_copy_jprocvar_array(TJProcVarArray(src),TJProcVarArray(result),start,len);
FPCJDynArrTypeShortstring:
fpc_copy_jshortstring_array(TShortstringArray(src),TShortstringArray(result),start,len);
else
fpc_copy_shallow_array(src,result,start,len);
end
end
else
begin
for i:=0 to len-1 do
TJObjectArray(result)[i]:=fpc_dynarray_copy(TJObjectArray(src)[start+i],-1,-1,ndim-1,eletype);
end;
end;

1491
rtl/java/jsystem.inc Normal file
View File

File diff suppressed because it is too large Load Diff

733
rtl/java/jsystemh.inc Normal file
View File

@ -0,0 +1,733 @@
{
This file contains the OS independent declarations of the system unit
This file is part of the Free Pascal Run time library.
Copyright (c) 1999-2005 by the Free Pascal development team
See the File COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{****************************************************************************
Processor specific routines
****************************************************************************}
{$ifdef FPC_USE_LIBC}
{$ifdef SYSTEMINLINE}
{$define INLINEGENERICS}
{$endif}
{$endif}
(*
Procedure Move(const source;var dest;count:SizeInt);
Procedure FillChar(var x;count:SizeInt;Value:Byte);
Procedure FillChar(var x;count:SizeInt;Value:Boolean);
Procedure FillChar(var x;count:SizeInt;Value:Char);
procedure FillByte(var x;count:SizeInt;value:byte);
Procedure FillWord(var x;count:SizeInt;Value:Word);
procedure FillDWord(var x;count:SizeInt;value:DWord);
procedure FillQWord(var x;count:SizeInt;value:QWord);
function IndexChar(const buf;len:SizeInt;b:char):SizeInt;
function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;
function Indexword(const buf;len:SizeInt;b:word):SizeInt;
function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt;
function IndexQWord(const buf;len:SizeInt;b:QWord):SizeInt;
function CompareChar(const buf1,buf2;len:SizeInt):SizeInt;
function CompareByte(const buf1,buf2;len:SizeInt):SizeInt;
function CompareWord(const buf1,buf2;len:SizeInt):SizeInt;
function CompareDWord(const buf1,buf2;len:SizeInt):SizeInt;
procedure MoveChar0(const buf1;var buf2;len:SizeInt);
function IndexChar0(const buf;len:SizeInt;b:char):SizeInt;
function CompareChar0(const buf1,buf2;len:SizeInt):SizeInt;
procedure prefetch(const mem);[internproc:fpc_in_prefetch_var];
procedure ReadBarrier;
procedure ReadDependencyBarrier;
procedure ReadWriteBarrier;
procedure WriteBarrier;
*)
{****************************************************************************
Math Routines
****************************************************************************}
Function lo(B: Byte):Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
Function hi(b : Byte) : Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];
Function lo(l : DWord) : Word; [INTERNPROC: fpc_in_lo_long];
Function lo(i : Int64) : DWord; [INTERNPROC: fpc_in_lo_qword];
Function lo(q : QWord) : DWord; [INTERNPROC: fpc_in_lo_qword];
Function hi(i : Integer) : byte; [INTERNPROC: fpc_in_hi_Word];
Function hi(w : Word) : byte; [INTERNPROC: fpc_in_hi_Word];
Function hi(l : Longint) : Word; [INTERNPROC: fpc_in_hi_long];
Function hi(l : DWord) : Word; [INTERNPROC: fpc_in_hi_long];
Function hi(i : Int64) : DWord; [INTERNPROC: fpc_in_hi_qword];
Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
Function swap (X : Word) : Word;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_word];
(* Function Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_word]; *)
Function swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_long];
(* Function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_long]; *)
(* Function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_qword]; *)
Function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_qword];
Function Align (Addr : PtrUInt; Alignment : PtrUInt) : PtrUInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(*
Function Align (Addr : Pointer; Alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
*)
{$ifdef FPC_HAS_FEATURE_RANDOM}
Function Random(l:longint):longint;
Function Random(l:int64):int64;
{$ifndef FPUNONE}
Function Random: extended;
{$endif}
Procedure Randomize;
{$endif FPC_HAS_FEATURE_RANDOM}
{$ifdef FPC_HAS_INTERNAL_ABS_LONG and (defined(cpui386) or defined(cpux86_64) or defined(cpupowerpc))}
{$define FPC_SYSTEM_HAS_ABS_LONGINT}
Function abs(l:longint):longint;[internproc:fpc_in_abs_long];
{$else FPC_HAS_INTERNAL_ABS_LONG}
Function abs(l:Longint):Longint;[internconst:fpc_in_const_abs];{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_ABS_LONG}
Function abs(l:Int64):Int64;[internconst:fpc_in_const_abs];{$ifdef SYSTEMINLINE}inline;{$endif}
Function sqr(l:Longint):Longint;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
Function sqr(l:Int64):Int64;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
(* Function sqr(l:QWord):QWord;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif} *)
Function odd(l:Longint):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif}
(* Function odd(l:Longword):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif} *)
Function odd(l:Int64):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif}
(* Function odd(l:QWord):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif} *)
function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function SwapEndian(const AValue: LongInt): LongInt;
(* function SwapEndian(const AValue: DWord): DWord; *)
function SwapEndian(const AValue: Int64): Int64;
(* function SwapEndian(const AValue: QWord): QWord; *)
function BEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function BEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function BEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function BEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function BEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function BEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function LEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function LEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function LEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function LEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function LEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function LEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function NtoBE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function NtoBE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function NtoBE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function NtoBE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function NtoBE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function NtoBE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function NtoLE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function NtoLE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function NtoLE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
(* function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif} *)
{$ifdef FPC_HAS_INTERNAL_ROX}
{$if defined(cpux86_64) or defined(cpui386)}
{$define FPC_HAS_INTERNAL_ROX_BYTE}
{$define FPC_HAS_INTERNAL_ROX_WORD}
{$endif defined(cpux86_64) or defined(cpui386)}
{$if defined(cpux86_64) or defined(cpui386) or defined(arm) or defined(powerpc) or defined(powerpc64)}
{$define FPC_HAS_INTERNAL_ROX_DWORD}
{$endif defined(cpux86_64) or defined(cpui386) or defined(arm) or defined(powerpc) or defined(powerpc64)}
{$if defined(cpux86_64) or defined(powerpc64)}
{$define FPC_HAS_INTERNAL_ROX_QWORD}
{$endif defined(cpux86_64) or defined(powerpc64)}
{$endif FPC_HAS_INTERNAL_ROX}
{$ifdef FPC_HAS_INTERNAL_ROX_BYTE}
function RorByte(Const AValue : Byte): Byte;[internproc:fpc_in_ror_x];
function RorByte(Const AValue : Byte;const Dist : Byte): Byte;[internproc:fpc_in_ror_x_x];
function RolByte(Const AValue : Byte): Byte;[internproc:fpc_in_rol_x];
function RolByte(Const AValue : Byte;const Dist : Byte): Byte;[internproc:fpc_in_rol_x_x];
{$else FPC_HAS_INTERNAL_ROX_BYTE}
function RorByte(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function RorByte(Const AValue : Byte;const Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolByte(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolByte(Const AValue : Byte;const Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_ROX_BYTE}
{$ifdef FPC_HAS_INTERNAL_ROX_WORD}
function RorWord(Const AValue : Word): Word;[internproc:fpc_in_ror_x];
function RorWord(Const AValue : Word;const Dist : Byte): Word;[internproc:fpc_in_ror_x_x];
function RolWord(Const AValue : Word): Word;[internproc:fpc_in_rol_x];
function RolWord(Const AValue : Word;const Dist : Byte): Word;[internproc:fpc_in_rol_x_x];
{$else FPC_HAS_INTERNAL_ROX_WORD}
function RorWord(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function RorWord(Const AValue : Word;const Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolWord(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolWord(Const AValue : Word;const Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_ROX_WORD}
{$ifdef FPC_HAS_INTERNAL_ROX_DWORD}
function RorDWord(Const AValue : DWord): DWord;[internproc:fpc_in_ror_x];
function RorDWord(Const AValue : DWord;const Dist : Byte): DWord;[internproc:fpc_in_ror_x_x];
function RolDWord(Const AValue : DWord): DWord;[internproc:fpc_in_rol_x];
function RolDWord(Const AValue : DWord;const Dist : Byte): DWord;[internproc:fpc_in_rol_x_x];
{$else FPC_HAS_INTERNAL_ROX_DWORD}
function RorDWord(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function RorDWord(Const AValue : DWord;const Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolDWord(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolDWord(Const AValue : DWord;const Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_ROX_DWORD}
{$ifdef FPC_HAS_INTERNAL_ROX_QWORD}
function RorQWord(Const AValue : QWord): QWord;[internproc:fpc_in_ror_x];
function RorQWord(Const AValue : QWord;const Dist : Byte): QWord;[internproc:fpc_in_ror_x_x];
function RolQWord(Const AValue : QWord): QWord;[internproc:fpc_in_rol_x];
function RolQWord(Const AValue : QWord;const Dist : Byte): QWord;[internproc:fpc_in_rol_x_x];
{$else FPC_HAS_INTERNAL_ROX_QWORD}
function RorQWord(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function RorQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolQWord(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function RolQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_ROX_QWORD}
{$ifdef FPC_HAS_INTERNAL_SAR}
{$if defined(cpux86_64) or defined(cpui386)}
{$define FPC_HAS_INTERNAL_SAR_BYTE}
{$define FPC_HAS_INTERNAL_SAR_WORD}
{$endif defined(cpux86_64) or defined(cpui386)}
{ currently, all supported CPUs have an internal 32 bit sar implementation }
{ $if defined(cpux86_64) or defined(cpui386) or defined(arm) or defined(powerpc) or defined(powerpc64)}
{$define FPC_HAS_INTERNAL_SAR_DWORD}
{ $endif defined(cpux86_64) or defined(cpui386) or defined(arm) or defined(powerpc) or defined(powerpc64)}
{$if defined(cpux86_64) or defined(powerpc64)}
{$define FPC_HAS_INTERNAL_SAR_QWORD}
{$endif defined(cpux86_64) or defined(powerpc64)}
{$endif FPC_HAS_INTERNAL_SAR}
{$ifdef FPC_HAS_INTERNAL_SAR_BYTE}
function SarShortint(Const AValue : Shortint): Shortint;[internproc:fpc_in_sar_x];
function SarShortint(Const AValue : Shortint;Shift : Byte): Shortint;[internproc:fpc_in_sar_x_y];
{$else FPC_HAS_INTERNAL_ROX_BYTE}
function SarShortint(Const AValue : Shortint;const Shift : Byte = 1): Shortint;
{$endif FPC_HAS_INTERNAL_ROX_BYTE}
{$ifdef FPC_HAS_INTERNAL_SAR_WORD}
function SarSmallint(Const AValue : Smallint): Smallint;[internproc:fpc_in_sar_x];
function SarSmallint(Const AValue : Smallint;Shift : Byte): Smallint;[internproc:fpc_in_sar_x_y];
{$else FPC_HAS_INTERNAL_SAR_WORD}
function SarSmallint(Const AValue : Smallint;const Shift : Byte = 1): Smallint;
{$endif FPC_HAS_INTERNAL_SAR_WORD}
{$ifdef FPC_HAS_INTERNAL_SAR_DWORD}
function SarLongint(Const AValue : Longint): Longint;[internproc:fpc_in_sar_x];
function SarLongint(Const AValue : Longint;Shift : Byte): Longint;[internproc:fpc_in_sar_x_y];
{$else FPC_HAS_INTERNAL_SAR_DWORD}
function SarLongint(Const AValue : Longint;const Shift : Byte = 1): Longint;
{$endif FPC_HAS_INTERNAL_SAR_DWORD}
{$ifdef FPC_HAS_INTERNAL_SAR_QWORD}
function SarInt64(Const AValue : Int64): Int64;[internproc:fpc_in_sar_x];
function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_sar_x_y];
{$else FPC_HAS_INTERNAL_SAR_QWORD}
function SarInt64(Const AValue : Int64;const Shift : Byte = 1): Int64;
{$endif FPC_HAS_INTERNAL_SAR_QWORD}
{$ifdef FPC_HAS_INTERNAL_BSX}
{$if defined(cpui386) or defined(cpux86_64)}
{$define FPC_HAS_INTERNAL_BSX_BYTE}
{$define FPC_HAS_INTERNAL_BSX_WORD}
{$define FPC_HAS_INTERNAL_BSX_DWORD}
{$endif}
{$if defined(cpux86_64)}
{$define FPC_HAS_INTERNAL_BSX_QWORD}
{$endif}
{$endif}
{$ifdef FPC_HAS_INTERNAL_BSX_BYTE}
function BsfByte(Const AValue: Byte): Byte;[internproc:fpc_in_bsf_x];
function BsrByte(Const AValue: Byte): Byte;[internproc:fpc_in_bsr_x];
{$else}
function BsfByte(Const AValue: Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
function BsrByte(Const AValue: Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
{$ifdef FPC_HAS_INTERNAL_BSX_WORD}
function BsfWord(Const AValue: Word): cardinal;[internproc:fpc_in_bsf_x];
function BsrWord(Const AValue: Word): cardinal;[internproc:fpc_in_bsr_x];
{$else}
function BsfWord(Const AValue: Word): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
function BsrWord(Const AValue: Word): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
{$ifdef FPC_HAS_INTERNAL_BSX_DWORD}
function BsfDWord(Const AValue : DWord): cardinal;[internproc:fpc_in_bsf_x];
function BsrDWord(Const AValue : DWord): cardinal;[internproc:fpc_in_bsr_x];
{$else}
function BsfDWord(Const AValue : DWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
function BsrDWord(Const AValue : DWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_BSX_DWORD}
{$ifdef FPC_HAS_INTERNAL_BSX_QWORD}
function BsfQWord(Const AValue : QWord): cardinal;[internproc:fpc_in_bsf_x];
function BsrQWord(Const AValue : QWord): cardinal;[internproc:fpc_in_bsr_x];
{$else}
function BsfQWord(Const AValue : QWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
function BsrQWord(Const AValue : QWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_INTERNAL_BSF_QWORD}
{$ifndef FPUNONE}
{ float math routines }
{$I mathh.inc}
{$endif}
{ currency math routines }
{$I currh.inc}
{****************************************************************************
Addr/Pointer Handling
****************************************************************************}
(*
Function ptr(sel,off:Longint):farpointer;[internconst:fpc_in_const_ptr];{$ifdef SYSTEMINLINE}inline;{$endif}
Function Cseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Dseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Sseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
*)
{****************************************************************************
PChar and String Handling
****************************************************************************}
(*
function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
{ Shortstring functions }
Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);
Procedure Insert(source:Char;var s:shortstring;index:SizeInt);
Function Pos(const substr:shortstring;const s:shortstring):SizeInt;
Function Pos(C:Char;const s:shortstring):SizeInt;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function Pos (const Substr : ShortString; const Source : AnsiString) : SizeInt;
Procedure SetString (out S : AnsiString; Buf : PChar; Len : SizeInt);
Procedure SetString (out S : AnsiString; Buf : PWideChar; Len : SizeInt);
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
Procedure SetString (out S : Shortstring; Buf : PChar; Len : SizeInt);
function ShortCompareText(const S1, S2: shortstring): SizeInt;
Function upCase(const s:shortstring):shortstring;
Function lowerCase(const s:shortstring):shortstring; overload;
Function Space(b:byte):shortstring;
Function hexStr(Val:Longint;cnt:byte):shortstring;
Function OctStr(Val:Longint;cnt:byte):shortstring;
Function binStr(Val:Longint;cnt:byte):shortstring;
Function hexStr(Val:int64;cnt:byte):shortstring;
Function OctStr(Val:int64;cnt:byte):shortstring;
Function binStr(Val:int64;cnt:byte):shortstring;
Function hexStr(Val:qword;cnt:byte):shortstring;
Function OctStr(Val:qword;cnt:byte):shortstring;
Function binStr(Val:qword;cnt:byte):shortstring;
Function hexStr(Val:Pointer):shortstring;
*)
{ Char functions }
Function chr(b : byte) : Char; [INTERNPROC: fpc_in_chr_byte];
Function upCase(c:Char):Char;
Function lowerCase(c:Char):Char; overload;
(*function pos(const substr : shortstring;c:char): SizeInt;*)
{****************************************************************************
AnsiString Handling
****************************************************************************}
(*
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure UniqueString(var S : AnsiString);external name 'FPC_ANSISTR_UNIQUE';
Function Pos (const Substr : AnsiString; const Source : AnsiString) : SizeInt;
Function Pos (c : Char; const s : AnsiString) : SizeInt;
Procedure Insert (const Source : AnsiString; var S : AnsiString; Index : SizeInt);
Procedure Delete (var S : AnsiString; Index,Size: SizeInt);
Function StringOfChar(c : char;l : SizeInt) : AnsiString;
function upcase(const s : ansistring) : ansistring;
function lowercase(const s : ansistring) : ansistring;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
*)
{****************************************************************************
WideString Handling
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$i ustringh.inc}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$i wstringh.inc}
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{****************************************************************************
Untyped File Management
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure Assign(out f:File;const Name:string);
Procedure Assign(out f:File;p:pchar);
Procedure Assign(out f:File;c:char);
Procedure Rewrite(var f:File;l:Longint);
Procedure Rewrite(var f:File);
Procedure Reset(var f:File;l:Longint);
Procedure Reset(var f:File);
Procedure Close(var f:File);
Procedure BlockWrite(var f:File;const Buf;Count:Int64;var Result:Int64);
Procedure BlockWrite(var f:File;const Buf;Count:Longint;var Result:Longint);
Procedure BlockWrite(var f:File;const Buf;Count:Cardinal;var Result:Cardinal);
Procedure BlockWrite(var f:File;const Buf;Count:Word;var Result:Word);
Procedure BlockWrite(var f:File;const Buf;Count:Word;var Result:Integer);
Procedure BlockWrite(var f:File;const Buf;Count:Longint);
Procedure BlockRead(var f:File;var Buf;count:Int64;var Result:Int64);
Procedure BlockRead(var f:File;var Buf;count:Longint;var Result:Longint);
Procedure BlockRead(var f:File;var Buf;count:Cardinal;var Result:Cardinal);
Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);
Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);
Procedure BlockRead(var f:File;var Buf;count:Int64);
Function FilePos(var f:File):Int64;
Function FileSize(var f:File):Int64;
Procedure Seek(var f:File;Pos:Int64);
Function EOF(var f:File):Boolean;
Procedure Erase(var f:File);
Procedure Rename(var f:File;const s:string);
Procedure Rename(var f:File;p:pchar);
Procedure Rename(var f:File;c:char);
Procedure Truncate (var F:File);
{$endif FPC_HAS_FEATURE_FILEIO}
{****************************************************************************
Typed File Management
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure Assign(out f:TypedFile;const Name:string);
Procedure Assign(out f:TypedFile;p:pchar);
Procedure Assign(out f:TypedFile;c:char);
Procedure Reset(var f : TypedFile); [INTERNPROC: fpc_in_Reset_TypedFile];
Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
{$endif FPC_HAS_FEATURE_FILEIO}
{****************************************************************************
Text File Management
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_TEXTIO}
Procedure Assign(out t:Text;const s:string);
Procedure Assign(out t:Text;p:pchar);
Procedure Assign(out t:Text;c:char);
Procedure Close(var t:Text);
Procedure Rewrite(var t:Text);
Procedure Reset(var t:Text);
Procedure Append(var t:Text);
Procedure Flush(var t:Text);
Procedure Erase(var t:Text);
Procedure Rename(var t:Text;const s:string);
Procedure Rename(var t:Text;p:pchar);
Procedure Rename(var t:Text;c:char);
Function EOF(var t:Text):Boolean;
Function EOF:Boolean;
Function EOLn(var t:Text):Boolean;
Function EOLn:Boolean;
Function SeekEOLn (var t:Text):Boolean;
Function SeekEOF (var t:Text):Boolean;
Function SeekEOLn:Boolean;
Function SeekEOF:Boolean;
Procedure SetTextBuf(var f:Text; var Buf);[INTERNPROC:fpc_in_settextbuf_file_x];
Procedure SetTextBuf(var f:Text; var Buf; Size:SizeInt);
Procedure SetTextLineEnding(var f:Text; Ending:string);
{$endif FPC_HAS_FEATURE_TEXTIO}
{****************************************************************************
Directory Management
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure chdir(const s:string); overload;
Procedure mkdir(const s:string); overload;
Procedure rmdir(const s:string); overload;
// the pchar versions are exported via alias for use in objpas
Procedure getdir(drivenr:byte;var dir:shortstring);
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure getdir(drivenr:byte;var dir:ansistring);
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$endif FPC_HAS_FEATURE_FILEIO}
{*****************************************************************************
Miscellaneous
*****************************************************************************}
{ os independent calls to allow backtraces }
{$IFDEF INTERNAL_BACKTRACE}
// inserted in compiler/psystem.pas
//function get_frame:pointer;[INTERNPROC:fpc_in_get_frame];
(*
// still defined externally
function get_caller_addr(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_addr];
function get_caller_frame(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_frame];
*)
{$ELSE}
function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ENDIF}
(*
function get_caller_addr(framebp:pointer):pointer;
function get_caller_frame(framebp:pointer):pointer;
*)
//Function IOResult:Word;
//Function Sptr:Pointer;[internconst:fpc_in_const_ptr];
{$ifdef FPC_HAS_FEATURE_PROCESSES}
Function GetProcessID:SizeUInt;
Function GetThreadID:TThreadID;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif FPC_HAS_FEATURE_PROCESSES}
(*
function InterLockedIncrement (var Target: longint) : longint; public name 'FPC_INTERLOCKEDINCREMENT';
function InterLockedDecrement (var Target: longint) : longint; public name 'FPC_INTERLOCKEDDECREMENT';
function InterLockedExchange (var Target: longint;Source : longint) : longint; public name 'FPC_INTERLOCKEDEXCHANGE';
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; public name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; public name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$ifdef cpu64}
function InterLockedIncrement64 (var Target: int64) : int64; public name 'FPC_INTERLOCKEDINCREMENT64';
function InterLockedDecrement64 (var Target: int64) : int64; public name 'FPC_INTERLOCKEDDECREMENT64';
function InterLockedExchange64 (var Target: int64;Source : int64) : int64; public name 'FPC_INTERLOCKEDEXCHANGE64';
function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64; public name 'FPC_INTERLOCKEDEXCHANGEADD64';
function InterlockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64; public name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
{$endif cpu64}
{ Pointer overloads }
{$ifdef cpu64}
function InterLockedIncrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDINCREMENT64';
function InterLockedDecrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDDECREMENT64';
function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGE64';
function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD64';
function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
{$else cpu64}
function InterLockedIncrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDINCREMENT';
function InterLockedDecrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDDECREMENT';
function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGE';
function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$endif cpu64}
{ unsigned overloads }
function InterLockedIncrement (var Target: cardinal) : cardinal; external name 'FPC_INTERLOCKEDINCREMENT';
function InterLockedDecrement (var Target: cardinal) : cardinal; external name 'FPC_INTERLOCKEDDECREMENT';
function InterLockedExchange (var Target: cardinal;Source : cardinal) : cardinal; external name 'FPC_INTERLOCKEDEXCHANGE';
function InterLockedExchangeAdd (var Target: cardinal;Source : cardinal) : cardinal; external name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: cardinal; NewValue: cardinal; Comperand: cardinal): cardinal; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$ifdef cpu64}
function InterLockedIncrement64 (var Target: qword) : qword; external name 'FPC_INTERLOCKEDINCREMENT64';
function InterLockedDecrement64 (var Target: qword) : qword; external name 'FPC_INTERLOCKEDDECREMENT64';
function InterLockedExchange64 (var Target: qword;Source : qword) : qword; external name 'FPC_INTERLOCKEDEXCHANGE64';
function InterLockedExchangeAdd64 (var Target: qword;Source : qword) : qword; external name 'FPC_INTERLOCKEDEXCHANGEADD64';
function InterlockedCompareExchange64(var Target: qword; NewValue: qword; Comperand: qword): int64; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
{$endif cpu64}
*)
{*****************************************************************************
Init / Exit / ExitProc
*****************************************************************************}
type
TRuntimeError =
(reNone, reOutOfMemory, reInvalidPtr, reDivByZero, reRangeError,
reIntOverflow, reInvalidOp, reZeroDivide, reOverflow, reUnderflow,
reInvalidCast, reAccessViolation, rePrivInstruction, reControlBreak,
reStackOverflow, reVarTypeCast, reVarInvalidOp, reVarDispatch,
reVarArrayCreate, reVarNotArray, reVarArrayBounds, reAssertionFailed,
reExternalException, reIntfCastError, reSafeCallError, reQuit,
reCodesetConversion);
Const
// Please keep locations corresponding to location in array above
RuntimeErrorExitCodes : Array[TRuntimeError] of Byte = (
0 , 203, 204, 200, 201,
215, 207, 200, 205, 206,
219, 216, 218, 217,
202, 220, 221, 222,
223, 224, 225, 227,
212, 228, 229, 233,
234);
Procedure Error(RunTimeError : TRunTimeError);
{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
Function Paramcount:Longint;
Function ParamStr(l:Longint):string;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
Procedure Dump_Stack(var f : text;bp:pointer);
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
procedure DumpExceptionBackTrace(var f:text);
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
{$endif FPC_HAS_FEATURE_CONSOLEIO}
Procedure RunError(w:Word);
Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
Procedure halt(errnum:Longint);
{$ifdef FPC_HAS_FEATURE_HEAP}
Procedure AddExitProc(Proc:TProcedure);
{$endif FPC_HAS_FEATURE_HEAP}
Procedure halt;{$ifdef SYSTEMINLINE}inline;{$endif}
{ Need to be exported for threads unit }
(*
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
Procedure SysInitExceptions;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
*)
{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
procedure SysInitStdIO;
procedure SysFlushStdIO;
{$endif FPC_HAS_FEATURE_CONSOLEIO}
{$ifndef FPUNONE}
Procedure SysResetFPU;
Procedure SysInitFPU;
{$endif}
{*****************************************************************************
Abstract/Assert/Error Handling
*****************************************************************************}
{$ifdef FPC_HAS_FEATURE_HEAP}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
Function StringToPPChar(var S:AnsiString;ReserveEntries:integer):ppchar;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
{$endif FPC_HAS_FEATURE_HEAP}
(*
procedure AbstractError;external name 'FPC_ABSTRACTERROR';
Function SysBackTraceStr(Addr:Pointer): ShortString;
Procedure SysAssert(const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
*)
(* Supposed to return address of previous CtrlBreakHandler *)
(* (may be nil), returned value of pointer (-1) means that *)
(* attempt to setup CtrlBreakHandler wasn't successful. *)
(*
function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
*)
{ Error handlers }
(*
Type
TBackTraceStrFunc = Function (Addr: Pointer): ShortString;
TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
TAbstractErrorProc = Procedure;
TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
TSafeCallErrorProc = Procedure(error : HResult;addr : pointer);
const
BackTraceStrFunc : TBackTraceStrFunc = @SysBackTraceStr;
ErrorProc : TErrorProc = nil;
AbstractErrorProc : TAbstractErrorProc = nil;
AssertErrorProc : TAssertErrorProc = @SysAssert;
SafeCallErrorProc : TSafeCallErrorProc = nil;
*)
{*****************************************************************************
SetJmp/LongJmp
*****************************************************************************}
{$i setjumph.inc}
{*****************************************************************************
Object Pascal support
*****************************************************************************}
{$ifdef FPC_HAS_FEATURE_CLASSES}
{$i objpash.inc}
{$endif FPC_HAS_FEATURE_CLASSES}
{*****************************************************************************
Variant support
*****************************************************************************}
{$ifdef FPC_HAS_FEATURE_VARIANTS}
{$i varianth.inc}
{$endif FPC_HAS_FEATURE_VARIANTS}
{*****************************************************************************
Internal helper routines support
*****************************************************************************}
(*
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
{$i dynarrh.inc}
{$endif FPC_HAS_FEATURE_DYNARRAYS}
*)
{ documenting compiler proc. is useless, they shouldn't be used by the user anyways }
(*
{$ifndef fpdocsystem}
{$i compproc.inc}
{$endif fpdocsystem}
*)
{*****************************************************************************
Heap
*****************************************************************************}
{$ifdef FPC_HAS_FEATURE_HEAP}
{$i heaph.inc}
{$endif FPC_HAS_FEATURE_HEAP}
{*****************************************************************************
Thread support
*****************************************************************************}
{ Generic threadmanager }
{$ifdef FPC_HAS_FEATURE_THREADING}
{$i threadh.inc}
{$endif FPC_HAS_FEATURE_THREADING}
{*****************************************************************************
Resources support
*****************************************************************************}
(*
{$i resh.inc}
*)
{*****************************************************************************
FPDoc phony declarations.
*****************************************************************************}
{$ifdef fpdocsystem}
{$i system.fpd}
{$endif}

521
rtl/java/jsystemh_types.inc Normal file
View File

@ -0,0 +1,521 @@
{
This file contains the OS independent declarations of the system unit
This file is part of the Free Pascal Run time library.
Copyright (c) 1999-2005 by the Free Pascal development team
See the File COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{****************************************************************************
Needed switches
****************************************************************************}
{$I-,Q-,H-,R-,V-}
{$mode objfpc}
{ At least 2.4.0 is required }
{$if defined(VER1) or defined(VER2_0) or defined(VER2_2) }
{$fatal You need at least FPC 2.4.0 to build this version of FPC}
{$endif}
{ Using inlining for small system functions/wrappers }
{$inline on}
{$define SYSTEMINLINE}
{ don't use FPU registervariables on the i386 }
{$ifdef CPUI386}
{$maxfpuregisters 0}
{$endif CPUI386}
{ the assembler helpers need this}
{$ifdef CPUPOWERPC}
{$goto+}
{$endif CPUPOWERPC}
{$ifdef CPUAVR}
{$goto+}
{$endif CPUAVR}
{ needed for insert,delete,readln }
{$P+}
{ stack checking always disabled
for system unit. This is because
the startup code might not
have been called yet when we
get a stack error, this will
cause big crashes
}
{$S-}
{****************************************************************************
Global Types and Constants
****************************************************************************}
Type
{ The compiler has all integer types defined internally. Here
we define only aliases }
DWord = LongWord;
Cardinal = LongWord;
Integer = SmallInt;
UInt64 = QWord;
{ moved here from psystem.pas
Delphi allows chose of overloaded procedure depending
on Real <-> Double, so use type here, see also tw7425.pp (FK) }
{$ifndef FPUNONE}
Real = type Double;
{$endif}
{$ifdef CPUI386}
{$define CPU32}
{$define DEFAULT_EXTENDED}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define SUPPORT_EXTENDED}
{$define SUPPORT_COMP}
{$ifndef FPUNONE}
ValReal = Extended;
{$endif}
{$endif CPUI386}
{$ifdef CPUX86_64}
{$ifdef FPC_HAS_TYPE_EXTENDED}
{ win64 doesn't support the legacy fpu }
{$define DEFAULT_EXTENDED}
{$define SUPPORT_EXTENDED}
{$define SUPPORT_COMP}
{$ifndef FPUNONE}
ValReal = Extended;
{$endif}
{$else FPC_HAS_TYPE_EXTENDED}
{$define DEFAULT_DOUBLE}
{$ifndef FPUNONE}
ValReal = Double;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
PComp = ^Comp;
{$endif FPC_HAS_TYPE_EXTENDED}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$endif CPUX86_64}
{$ifdef CPUM68K}
{$define DEFAULT_DOUBLE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$ifndef FPUNONE}
ValReal = Real;
{$endif}
{ Comp type does not exist on fpu }
Comp = int64;
PComp = ^Comp;
FarPointer = Pointer;
{$endif CPUM68K}
{$ifdef CPUPOWERPC}
{$define DEFAULT_DOUBLE}
{$ifndef FPUNONE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
ValReal = Double;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
PComp = ^Comp;
FarPointer = Pointer;
{$endif CPUPOWERPC}
{$ifdef CPUSPARC}
{$define DEFAULT_DOUBLE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
{$ifndef FPUNONE}
ValReal = Double;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
PComp = ^Comp;
FarPointer = Pointer;
{$endif CPUSPARC}
{$ifdef CPUARM}
{$define DEFAULT_DOUBLE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define FPC_INCLUDE_SOFTWARE_MOD_DIV}
{$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
{$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
{$ifndef FPUNONE}
ValReal = Real;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
PComp = ^Comp;
FarPointer = Pointer;
{$endif CPUARM}
{$ifdef CPUAVR}
{$define DEFAULT_SINGLE}
{$define FPC_INCLUDE_SOFTWARE_MOD_DIV}
{$define FPC_INCLUDE_SOFTWARE_MUL}
{$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
{$ifndef FPUNONE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
ValReal = Real;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
PComp = ^Comp;
FarPointer = Pointer;
{$endif CPUARM}
{$ifdef CPUJVM}
{$define DEFAULT_DOUBLE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
ValReal = Double;
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
PComp = ^Comp;
{$endif CPUJVM}
{$ifdef CPU64}
SizeInt = Int64;
SizeUInt = QWord;
PtrInt = Int64;
PtrUInt = QWord;
ValSInt = int64;
ValUInt = qword;
{$endif CPU64}
{$ifdef CPU32}
SizeInt = Longint;
SizeUInt = DWord;
PtrInt = Longint;
PtrUInt = DWord;
ValSInt = Longint;
ValUInt = Cardinal;
{$endif CPU32}
{$ifdef CPU16}
SizeInt = Integer;
SizeUInt = Word;
PtrInt = Integer;
PtrUInt = Word;
ValSInt = Integer;
ValUInt = Word;
{$endif CPU16}
NativeInt = PtrInt;
NativeUint = PtrUint;
(*
{ Zero - terminated strings }
PChar = ^Char;
PPChar = ^PChar;
PPPChar = ^PPChar;
*)
{ AnsiChar is equivalent of Char, so we need
to use type renamings }
TAnsiChar = Char;
AnsiChar = Char;
(*
PAnsiChar = PChar;
PPAnsiChar = PPChar;
*)
UCS4Char = type 0..$10ffff;
(*
PUCS4Char = ^UCS4Char;
*)
{$ifdef CPU16}
TUCS4CharArray = array[0..32767 div sizeof(UCS4Char)-1] of UCS4Char;
{$else CPU16}
TUCS4CharArray = array[0..$effffff] of UCS4Char;
{$endif CPU16}
(*
PUCS4CharArray = ^TUCS4CharArray;
*)
UCS4String = array of UCS4Char;
UTF8String = type ansistring;
(*
PUTF8String = ^UTF8String;
*)
HRESULT = type Longint;
{$ifndef FPUNONE}
TDateTime = type Double;
TDate = type TDateTime;
TTime = type TDateTime;
{$endif}
TError = type Longint;
{$ifndef FPUNONE}
(*
PSingle = ^Single;
PDouble = ^Double;
PExtended = ^Extended;
PPDouble = ^PDouble;
*)
{$endif}
(*
PCurrency = ^Currency;
*)
{$ifdef SUPPORT_COMP}
(*
PComp = ^Comp;
*)
{$endif SUPPORT_COMP}
(*
PSmallInt = ^Smallint;
PShortInt = ^Shortint;
PInteger = ^Integer;
PByte = ^Byte;
PWord = ^word;
PDWord = ^DWord;
PLongWord = ^LongWord;
PLongint = ^Longint;
PCardinal = ^Cardinal;
PQWord = ^QWord;
PInt64 = ^Int64;
PPtrInt = ^PtrInt;
PPtrUInt = ^PtrUInt;
PSizeInt = ^SizeInt;
PPByte = ^PByte;
PPLongint = ^PLongint;
PPointer = ^Pointer;
PPPointer = ^PPointer;
PBoolean = ^Boolean;
PWordBool = ^WordBool;
PLongBool = ^LongBool;
*)
PShortString = ^ShortString;
(*
PAnsiString = ^AnsiString;
{$ifndef FPUNONE}
PDate = ^TDateTime;
PDateTime = ^TDateTime;
{$endif}
PError = ^TError;
PVariant = ^Variant;
POleVariant = ^OleVariant;
PWideChar = ^WideChar;
PPWideChar = ^PWideChar;
PPPWideChar = ^PPWideChar;
*)
WChar = Widechar;
UCS2Char = WideChar;
(*
PUCS2Char = PWideChar;
PWideString = ^WideString;
*)
UnicodeChar = WideChar;
(*
PUnicodeChar = ^UnicodeChar;
PUnicodeString = ^UnicodeString;
{ Needed for fpc_get_output }
PText = ^Text;
*)
TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);
{ procedure type }
TProcedure = Procedure;
{ platform dependent types }
{$i sysosh.inc}
(*
type
TEntryInformation = record
InitFinalTable : Pointer;
ThreadvarTablesTable : Pointer;
asm_exit : Procedure;stdcall;
PascalMain : Procedure;stdcall;
valgrind_used : boolean;
end;
*)
const
{ Maximum value of the biggest signed and unsigned integer type available}
MaxSIntValue = High(ValSInt);
MaxUIntValue = High(ValUInt);
{ max. values for longint and int}
maxLongint = $7fffffff;
maxSmallint = 32767;
maxint = maxsmallint;
type
{$ifdef CPU16}
IntegerArray = array[0..maxSmallint div sizeof(Integer)-1] of Integer;
{$else CPU16}
IntegerArray = array[0..$effffff] of Integer;
{$endif CPU16}
PIntegerArray = ^IntegerArray;
{$ifdef CPU16}
PointerArray = array [0..32767 div sizeof(Pointer)-1] of Pointer;
{$else CPU16}
PointerArray = array [0..512*1024*1024-2] of Pointer;
{$endif CPU16}
(*
PPointerArray = ^PointerArray;
*)
TBoundArray = array of SizeInt;
(*
{$ifdef CPU16}
TPCharArray = packed array[0..(MaxSmallint div SizeOf(PChar))-1] of PChar;
{$else CPU16}
TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
{$endif CPU16}
PPCharArray = ^TPCharArray;
*)
(* CtrlBreak set to true signalizes Ctrl-Break signal, otherwise Ctrl-C. *)
(* Return value of true means that the signal has been processed, false *)
(* means that default handling should be used. *)
(*
TCtrlBreakHandler = function (CtrlBreak: boolean): boolean;
*)
const
{$ifdef cpui386}
{ Always i386 or newer }
Test8086 : byte = 2;
{ Always 387 or newer. Emulated if needed. }
Test8087 : byte = 3;
{ will be detected at startup }
has_sse_support : boolean = false;
has_mmx_support : boolean = false;
{$endif cpui386}
{$ifdef cpum68k}
Test68000 : byte = 0; { Must be determined at startup for both }
Test68881 : byte = 0;
{$endif cpum68k}
{ max level in dumping on error }
Max_Frame_Dump : Word = 8;
(*
{ Exit Procedure handling consts and types }
ExitProc : pointer = nil;
Erroraddr: pointer = nil;
*)
Errorcode: Word = 0;
{ file input modes }
fmClosed = $D7B0;
fmInput = $D7B1;
fmOutput = $D7B2;
fmInOut = $D7B3;
fmAppend = $D7B4;
Filemode : byte = 2;
(* Value should be changed during system initialization as appropriate. *)
{ assume that this program will not spawn other threads, when the
first thread is started the following constants need to be filled }
IsMultiThread : longbool = FALSE;
{ set to true, if a threading helper is used before a thread
manager has been installed }
ThreadingAlreadyUsed : boolean = FALSE;
{ Indicates if there was an error }
StackError : boolean = FALSE;
(*
InitProc : Pointer = nil;
*)
{ compatibility }
ModuleIsLib : Boolean = FALSE;
ModuleIsPackage : Boolean = FALSE;
ModuleIsCpp : Boolean = FALSE;
var
ExitCode : Longint; (* public name 'operatingsystem_result'; *)
RandSeed : Cardinal;
{ Delphi compatibility }
IsLibrary : boolean = false;
IsConsole : boolean;
{ Threading support }
fpc_threadvar_relocate_proc : pointer; public name 'FPC_THREADVAR_RELOCATE';
(*
{$ifndef HAS_CMDLINE}
{Value should be changed during system initialization as appropriate.}
var cmdline:Pchar=nil;
{$endif}
*)
(*
ThreadVar
ThreadID : TThreadID;
{ Standard In- and Output }
ErrOutput,
Output,
Input,
StdOut,
StdErr : Text;
InOutRes : Word;
{ Stack checking }
StackTop,
StackBottom : Pointer;
StackLength : SizeUInt;
*)
{ Numbers for routines that have compiler magic }
{$I innr.inc}

38
rtl/java/objpas.inc Normal file
View File

@ -0,0 +1,38 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
This file implements the helper routines for TObject
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}
procedure TObject.Free;
begin
if not DestructorCalled then
begin
DestructorCalled:=true;
Destroy;
end;
end;
destructor TObject.Destroy;
begin
end;
procedure TObject.Finalize;
begin
Free;
end;

83
rtl/java/objpash.inc Normal file
View File

@ -0,0 +1,83 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
This file implements the helper routines for TObject
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}
type
TObject = class(JLObject)
strict private
DestructorCalled: Boolean;
public
procedure Free;
destructor Destroy; virtual;
procedure finalize; override;
end;
TClass = class of TObject;
{$ifndef nounsupported}
const
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
{$ifndef FPUNONE}
vtExtended = 3;
{$endif}
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString = 11;
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
vtQWord = 17;
vtUnicodeString = 18;
type
TVarRec = record
case VType : sizeint of
{$ifdef ENDIAN_BIG}
vtInteger : ({$IFDEF CPU64}integerdummy1 : Longint;{$ENDIF CPU64}VInteger: Longint);
vtBoolean : ({$IFDEF CPU64}booldummy : Longint;{$ENDIF CPU64}booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean);
vtChar : ({$IFDEF CPU64}chardummy : Longint;{$ENDIF CPU64}chardummy1,chardummy2,chardummy3: byte; VChar: Char);
vtWideChar : ({$IFDEF CPU64}widechardummy : Longint;{$ENDIF CPU64}wchardummy1,VWideChar: WideChar);
{$else ENDIAN_BIG}
vtInteger : (VInteger: Longint);
vtBoolean : (VBoolean: Boolean);
vtChar : (VChar: Char);
vtWideChar : (VWideChar: WideChar);
{$endif ENDIAN_BIG}
// vtString : (VString: PShortString);
vtPointer : (VPointer: JLObject);
vtPChar : (VPChar: JLObject);
vtObject : (VObject: TObject);
vtClass : (VClass: TClass);
vtPWideChar : (VPWideChar: JLObject);
vtAnsiString : (VAnsiString: AnsiStringClass);
vtCurrency : (VCurrency: Currency);
// vtVariant : (VVariant: PVariant);
vtInterface : (VInterface: JLObject);
vtWideString : (VWideString: JLString);
vtInt64 : (VInt64: Int64);
vtUnicodeString : (VUnicodeString: JLString);
vtQWord : (VQWord: QWord);
end;
{$endif}

2
rtl/java/rtl.cfg
View File

@ -1,5 +1,5 @@
# first, disable all
-Sf-
# -Sf-
# uncomment to enable the stuff you want to use
# include full heap management into the rtl

4
rtl/java/sstringh.inc
View File

@ -16,7 +16,7 @@
type
TAnsiCharArray = array of ansichar;
ShortstringClass = class sealed (JLCloneable)
ShortstringClass = class sealed (JLObject,JLCloneable)
public
{ "length byte" }
curlen: byte;
@ -46,7 +46,7 @@ type
function length: jint;
end;
AnsiCharArrayClass = class sealed
AnsiCharArrayClass = class sealed (JLObject)
class function CreateFromLiteralStringBytes(const u: unicodestring; maxlen: byte): TAnsiCharArray; static;
end;

272
rtl/java/sstrings.inc
View File

@ -203,212 +203,6 @@ begin
end;
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
var
len: longint;
begin
len:=length(sstr);
if len>high(res) then
len:=high(res);
ShortstringClass(@res).curlen:=len;
JLSystem.ArrayCopy(JLObject(ShortstringClass(@sstr).fdata),0,JLObject(ShortstringClass(@res).fdata),0,len);
end;
procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
var
tmpres: ShortstringClass;
s1l, s2l: longint;
begin
s1l:=length(s1);
s2l:=length(s2);
if (s1l+s2l)>high(dests) then
begin
if s1l>high(dests) then
s1l:=high(dests);
s2l:=high(dests)-s1l;
end;
if ShortstringClass(@dests)=ShortstringClass(@s1) then
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
else if ShortstringClass(@dests)=ShortstringClass(@s2) then
begin
JLSystem.ArrayCopy(JLObject(ShortstringClass(@dests).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
end
else
begin
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
end;
ShortstringClass(@dests).curlen:=s1l+s2l;
end;
procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
var
s2l : byte;
LowStart,i,
Len : longint;
needtemp : boolean;
tmpstr : shortstring;
p,pdest : ShortstringClass;
begin
if high(sarr)=0 then
begin
DestS:='';
exit;
end;
lowstart:=low(sarr);
if ShortstringClass(@DestS)=sarr[lowstart] then
inc(lowstart);
{ Check for another reuse, then we can't use
the append optimization and need to use a temp }
needtemp:=false;
for i:=lowstart to high(sarr) do
begin
if ShortstringClass(@DestS)=sarr[i] then
begin
needtemp:=true;
break;
end;
end;
if needtemp then
begin
lowstart:=low(sarr);
tmpstr:='';
pdest:=ShortstringClass(@tmpstr)
end
else
begin
{ Start with empty DestS if we start with concatting
the first array element }
if lowstart=low(sarr) then
DestS:='';
pdest:=ShortstringClass(@DestS);
end;
{ Concat all strings, except the string we already
copied in DestS }
Len:=pdest.curlen;
for i:=lowstart to high(sarr) do
begin
p:=sarr[i];
if assigned(p) then
begin
s2l:=p.curlen;
if Len+s2l>high(dests) then
s2l:=high(dests)-Len;
JLSystem.ArrayCopy(JLObject(p.fdata),0,JLObject(pdest.fdata),len,s2l);
inc(Len,s2l);
end;
end;
pdest.curlen:=len;
if needtemp then
DestS:=TmpStr;
end;
procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
var
s1l, s2l : integer;
begin
s1l:=length(s1);
s2l:=length(s2);
if s1l+s2l>high(s1) then
s2l:=high(s1)-s1l;
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@s1).fdata),s1l,s2l);
s1[0]:=chr(s1l+s2l);
end;
function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
Var
MaxI,Temp, i : SizeInt;
begin
if ShortstringClass(@left)=ShortstringClass(@right) then
begin
result:=0;
exit;
end;
Maxi:=Length(left);
temp:=Length(right);
If MaxI>Temp then
MaxI:=Temp;
if MaxI>0 then
begin
for i:=0 to MaxI-1 do
begin
result:=ord(ShortstringClass(@left).fdata[i])-ord(ShortstringClass(@right).fdata[i]);
if result<>0 then
exit;
end;
result:=Length(left)-Length(right);
end
else
result:=Length(left)-Length(right);
end;
function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
Var
MaxI,Temp : SizeInt;
begin
if ShortstringClass(@left)=ShortstringClass(@right) then
begin
result:=0;
exit;
end;
result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(@left).fdata),TJByteArray(ShortstringClass(@right).fdata)));
end;
procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
var
l: longint;
index: longint;
len: byte;
foundnull: boolean;
begin
l:=high(arr)+1;
if l>=high(res)+1 then
l:=high(res)
else if l<0 then
l:=0;
if zerobased then
begin
foundnull:=false;
for index:=low(arr) to l-1 do
if arr[index]=#0 then
begin
foundnull:=true;
break;
end;
if not foundnull then
len:=l
else
len:=index;
end
else
len:=l;
JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(@res).fdata),0,len);
ShortstringClass(@res).curlen:=len;
end;
procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
var
len: longint;
begin
len:=length(src);
if len>length(res) then
len:=length(res);
{ make sure we don't access char 1 if length is 0 (JM) }
if len>0 then
JLSystem.ArrayCopy(JLObject(ShortstringClass(@src).fdata),0,JLObject(@res),0,len);
if len<=high(res) then
JUArrays.fill(TJByteArray(@res),len,high(res),0);
end;
procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
{
Converts a WideChar to a ShortString;
@ -456,6 +250,17 @@ begin
end;
Function upCase(c:Char):Char;
var
u : unicodestring;
s: ansistring;
begin
u:=c;
s:=upcase(u);
c:=s[1];
end;
function lowercase(const s : shortstring) : shortstring;
var
u : unicodestring;
@ -465,6 +270,17 @@ begin
end;
Function lowerCase(c:Char):Char; overload;
var
u : unicodestring;
s: ansistring;
begin
u:=c;
s:=lowercase(u);
c:=s[1];
end;
Function Pos (Const Substr : Shortstring; Const Source : Shortstring) : SizeInt;
var
i,j,k,MaxLen, SubstrLen : SizeInt;
@ -516,3 +332,47 @@ begin
end;
function space (b : byte): shortstring;
begin
setlength(result,b);
if b>0 then
JUArrays.fill(TJByteArray(ShortstringClass(@result).fdata),0,b,ord(' '))
end;
{*****************************************************************************
Str() Helpers
*****************************************************************************}
procedure fpc_shortstr_SInt(v : valSInt;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_SINT']; compilerproc;
begin
int_str(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end;
procedure fpc_shortstr_UInt(v : valUInt;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_UINT']; compilerproc;
begin
int_str_unsigned(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end;
procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_QWORD']; compilerproc;
begin
int_str_unsigned(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end;
procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_INT64']; compilerproc;
begin
int_str(v,s);
if length(s)<len then
s:=space(len-length(s))+s;
end;
{ lie, implemented internally in the compiler }
{$define FPC_SHORTSTR_ENUM_INTERN}

22
rtl/java/sysos.inc Normal file
View File

@ -0,0 +1,22 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
This file implements some Java-specific system unit routines
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}
constructor FpcRunTimeError.create(l: longint);
begin
inherited Create('Run time error '+unicodestring(JLInteger.valueOf(l).toString));
end;

21
rtl/java/sysosh.inc Normal file
View File

@ -0,0 +1,21 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
This file implements some Java-specific system unit routines
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}
type
FpcRunTimeError = class(JLException)
constructor create(l: longint);
end;

17
rtl/java/sysres.inc Normal file
View File

@ -0,0 +1,17 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
Dummy file to prevent inclusion of the generic resource support
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}

627
rtl/java/system.pp
View File

@ -28,45 +28,7 @@ Unit system;
{$implicitexceptions off}
{$mode objfpc}
{$undef FPC_HAS_FEATURE_ANSISTRINGS}
{$undef FPC_HAS_FEATURE_TEXTIO}
{$undef FPC_HAS_FEATURE_VARIANTS}
{$undef FPC_HAS_FEATURE_CLASSES}
{$undef FPC_HAS_FEATURE_EXCEPTIONS}
{$undef FPC_HAS_FEATURE_OBJECTS}
{$undef FPC_HAS_FEATURE_RTTI}
{$undef FPC_HAS_FEATURE_FILEIO}
{$undef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
Type
{ The compiler has all integer types defined internally. Here
we define only aliases }
DWord = LongWord;
Cardinal = LongWord;
Integer = SmallInt;
UInt64 = QWord;
SizeInt = Longint;
SizeUInt = Longint;
PtrInt = Longint;
PtrUInt = Longint;
{$define DEFAULT_DOUBLE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
ValReal = Double;
Real = type Double;
AnsiChar = Char;
UnicodeChar = WideChar;
{ map comp to int64 }
Comp = Int64;
HResult = type longint;
PShortString = ^ShortString;
{ Java primitive types }
jboolean = boolean;
jbyte = shortint;
@ -105,612 +67,49 @@ Type
Arr3jdouble = array of Arr2jdouble;
const
{ max. values for longint and int}
maxLongint = $7fffffff;
maxSmallint = 32767;
maxint = maxsmallint;
maxExitCode = 255;
{ Java base class type }
{$i java_sysh.inc}
{$i java_sys.inc}
type
TObject = class(JLObject)
strict private
DestructorCalled: Boolean;
public
procedure Free;
destructor Destroy; virtual;
procedure finalize; override;
end;
FpcEnumValueObtainable = interface
function fpcOrdinal: jint;
function fpcGenericValueOf(__fpc_int: longint): JLEnum;
end;
{$i innr.inc}
{$i jrech.inc}
{$i jseth.inc}
{$i sstringh.inc}
{$i jpvarh.inc}
{$i jsystemh_types.inc}
{$i sstringh.inc}
{$i jdynarrh.inc}
{$i astringh.inc}
{$i mathh.inc}
{$ifndef nounsupported}
const
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
{$ifndef FPUNONE}
vtExtended = 3;
{$endif}
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString = 11;
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
vtQWord = 17;
vtUnicodeString = 18;
type
TVarRec = record
case VType : sizeint of
{$ifdef ENDIAN_BIG}
vtInteger : ({$IFDEF CPU64}integerdummy1 : Longint;{$ENDIF CPU64}VInteger: Longint);
vtBoolean : ({$IFDEF CPU64}booldummy : Longint;{$ENDIF CPU64}booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean);
vtChar : ({$IFDEF CPU64}chardummy : Longint;{$ENDIF CPU64}chardummy1,chardummy2,chardummy3: byte; VChar: Char);
vtWideChar : ({$IFDEF CPU64}widechardummy : Longint;{$ENDIF CPU64}wchardummy1,VWideChar: WideChar);
{$else ENDIAN_BIG}
vtInteger : (VInteger: Longint);
vtBoolean : (VBoolean: Boolean);
vtChar : (VChar: Char);
vtWideChar : (VWideChar: WideChar);
{$endif ENDIAN_BIG}
// vtString : (VString: PShortString);
// vtPointer : (VPointer: Pointer);
/// vtPChar : (VPChar: PChar);
vtObject : (VObject: TObject);
// vtClass : (VClass: TClass);
// vtPWideChar : (VPWideChar: PWideChar);
vtAnsiString : (VAnsiString: JLObject);
vtCurrency : (VCurrency: Currency);
// vtVariant : (VVariant: PVariant);
vtInterface : (VInterface: JLObject);
vtWideString : (VWideString: JLString);
vtInt64 : (VInt64: Int64);
vtUnicodeString : (VUnicodeString: JLString);
vtQWord : (VQWord: QWord);
end;
{$endif}
Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];
Function lo(l : DWord) : Word; [INTERNPROC: fpc_in_lo_long];
Function lo(i : Int64) : DWord; [INTERNPROC: fpc_in_lo_qword];
Function lo(q : QWord) : DWord; [INTERNPROC: fpc_in_lo_qword];
Function hi(i : Integer) : byte; [INTERNPROC: fpc_in_hi_Word];
Function hi(w : Word) : byte; [INTERNPROC: fpc_in_hi_Word];
Function hi(l : Longint) : Word; [INTERNPROC: fpc_in_hi_long];
Function hi(l : DWord) : Word; [INTERNPROC: fpc_in_hi_long];
Function hi(i : Int64) : DWord; [INTERNPROC: fpc_in_hi_qword];
Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
Function chr(b : byte) : AnsiChar; [INTERNPROC: fpc_in_chr_byte];
function RorByte(Const AValue : Byte): Byte;[internproc:fpc_in_ror_x];
function RorByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_ror_x_x];
function RolByte(Const AValue : Byte): Byte;[internproc:fpc_in_rol_x];
function RolByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_rol_x_x];
function RorWord(Const AValue : Word): Word;[internproc:fpc_in_ror_x];
function RorWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_ror_x_x];
function RolWord(Const AValue : Word): Word;[internproc:fpc_in_rol_x];
function RolWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_rol_x_x];
function RorDWord(Const AValue : DWord): DWord;[internproc:fpc_in_ror_x];
function RorDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_ror_x_x];
function RolDWord(Const AValue : DWord): DWord;[internproc:fpc_in_rol_x];
function RolDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_rol_x_x];
function RorQWord(Const AValue : QWord): QWord;[internproc:fpc_in_ror_x];
function RorQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_ror_x_x];
function RolQWord(Const AValue : QWord): QWord;[internproc:fpc_in_rol_x];
function RolQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_rol_x_x];
function SarShortint(Const AValue : Shortint): Shortint;[internproc:fpc_in_sar_x];
function SarShortint(Const AValue : Shortint;Shift : Byte): Shortint;[internproc:fpc_in_sar_x_y];
function SarSmallint(Const AValue : Smallint): Smallint;[internproc:fpc_in_sar_x];
function SarSmallint(Const AValue : Smallint;Shift : Byte): Smallint;[internproc:fpc_in_sar_x_y];
function SarLongint(Const AValue : Longint): Longint;[internproc:fpc_in_sar_x];
function SarLongint(Const AValue : Longint;Shift : Byte): Longint;[internproc:fpc_in_sar_x_y];
function SarInt64(Const AValue : Int64): Int64;[internproc:fpc_in_sar_x];
function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_sar_x_y];
{$i jsystemh.inc}
{$i compproc.inc}
{$i ustringh.inc}
{*****************************************************************************}
implementation
{*****************************************************************************}
{i jdynarr.inc}
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe
member of the Free Pascal development team.
This file implements the helper routines for dyn. Arrays in FPC
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
}
function min(a,b : longint) : longint;
begin
if a<=b then
min:=a
else
min:=b;
end;
Procedure HandleError (Errno : longint); forward;
{$i sstrings.inc}
{$i astrings.inc}
{$i ustrings.inc}
{$i rtti.inc}
{$i jrec.inc}
{$i jset.inc}
{$i jint64.inc}
{$i jpvar.inc}
{$i jmath.inc}
{$i genmath.inc}
{ copying helpers }
procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
var
srclen, dstlen: jint;
begin
if assigned(src) then
srclen:=JLRArray.getLength(src)
else
srclen:=0;
if assigned(dst) then
dstlen:=JLRArray.getLength(dst)
else
dstlen:=0;
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ causes exception in JLSystem.arraycopy }
if (srccopylen=0) or
(dstlen=0) then
exit;
JLSystem.arraycopy(src,srcstart,dst,0,min(srccopylen,dstlen));
end;
procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
src[srcstart+i].fpcDeepCopy(dst[i]);
end;
procedure fpc_copy_jenumset_array(src, dst: TJEnumSetArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
begin
dst[i].clear;
dst[i].addAll(src[srcstart+i]);
end;
end;
procedure fpc_copy_jbitset_array(src, dst: TJBitSetArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
begin
dst[i].clear;
dst[i].addAll(src[srcstart+i]);
end;
end;
procedure fpc_copy_jprocvar_array(src, dst: TJProcVarArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
src[srcstart+i].fpcDeepCopy(dst[i]);
end;
procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
var
i: longint;
srclen, dstlen: jint;
begin
srclen:=length(src);
dstlen:=length(dst);
if srcstart=-1 then
srcstart:=0
else if srcstart>=srclen then
exit;
if srccopylen=-1 then
srccopylen:=srclen
else if srcstart+srccopylen>srclen then
srccopylen:=srclen-srcstart;
{ no arraycopy, have to clone each element }
for i:=0 to min(srccopylen,dstlen)-1 do
pshortstring(src[srcstart+i])^:=pshortstring(dst[i])^;
end;
{ 1-dimensional setlength routines }
function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
var
orglen, newlen: jint;
begin
orglen:=0;
newlen:=0;
if not deepcopy then
begin
if assigned(aorg) then
orglen:=JLRArray.getLength(aorg)
else
orglen:=0;
if assigned(anew) then
newlen:=JLRArray.getLength(anew)
else
newlen:=0;
end;
if deepcopy or
(orglen<>newlen) then
begin
if docopy then
fpc_copy_shallow_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jrecord_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jenumset(aorg, anew: TJEnumSetArray; deepcopy: boolean): TJEnumSetArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jenumset_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jbitset(aorg, anew: TJBitSetArray; deepcopy: boolean): TJBitSetArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jbitset_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jprocvar(aorg, anew: TJProcVarArray; deepcopy: boolean): TJProcVarArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jprocvar_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
begin
if deepcopy or
(length(aorg)<>length(anew)) then
begin
fpc_copy_jshortstring_array(aorg,anew);
result:=anew
end
else
result:=aorg;
end;
{ multi-dimensional setlength routine }
function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
var
partdone,
i: longint;
begin
{ resize the current dimension; no need to copy the subarrays of the old
array, as the subarrays will be (re-)initialised immediately below }
{ the srcstart/srccopylen always refers to the first dimension (since copy()
performs a shallow copy of a dynamic array }
result:=TJObjectArray(fpc_setlength_dynarr_generic(JLObject(aorg),JLObject(anew),deepcopy,false));
{ if aorg was empty, there's nothing else to do since result will now
contain anew, of which all other dimensions are already initialised
correctly since there are no aorg elements to copy }
if not assigned(aorg) and
not deepcopy then
exit;
partdone:=min(high(result),high(aorg));
{ ndim must be >=2 when this routine is called, since it has to return
an array of java.lang.Object! (arrays are also objects, but primitive
types are not) }
if ndim=2 then
begin
{ final dimension -> copy the primitive arrays }
case eletype of
FPCJDynArrTypeRecord:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jrecord(TJRecordArray(aorg[i]),TJRecordArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeEnumSet:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jenumset(TJEnumSetArray(aorg[i]),TJEnumSetArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jenumset(nil,TJEnumSetArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeBitSet:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jbitset(TJBitSetArray(aorg[i]),TJBitSetArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jbitset(nil,TJBitSetArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeProcVar:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jprocvar(TJProcVarArray(aorg[i]),TJProcVarArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jprocvar(nil,TJProcVarArray(anew[i]),deepcopy));
end;
FPCJDynArrTypeShortstring:
begin
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(TShortstringArray(aorg[i]),TShortstringArray(anew[i]),deepcopy));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(nil,TShortstringArray(anew[i]),deepcopy));
end;
else
begin
for i:=low(result) to partdone do
result[i]:=fpc_setlength_dynarr_generic(aorg[i],anew[i],deepcopy);
for i:=succ(partdone) to high(result) do
result[i]:=fpc_setlength_dynarr_generic(nil,anew[i],deepcopy);
end;
end;
end
else
begin
{ recursively handle the next dimension }
for i:=low(result) to partdone do
result[i]:=JLObject(fpc_setlength_dynarr_multidim(TJObjectArray(aorg[i]),TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
for i:=succ(partdone) to high(result) do
result[i]:=JLObject(fpc_setlength_dynarr_multidim(nil,TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
end;
end;
function fpc_dynarray_copy(src: JLObject; start, len: longint; ndim: longint; eletype: jchar): JLObject;
var
i: longint;
srclen: longint;
begin
if not assigned(src) then
begin
result:=nil;
exit;
end;
srclen:=JLRArray.getLength(src);
if (start=-1) and
(len=-1) then
begin
len:=srclen;
start:=0;
end
else if (start+len>srclen) then
len:=srclen-start+1;
result:=JLRArray.newInstance(src.getClass.getComponentType,len);
if ndim=1 then
begin
case eletype of
FPCJDynArrTypeRecord:
fpc_copy_jrecord_array(TJRecordArray(src),TJRecordArray(result),start,len);
FPCJDynArrTypeEnumSet:
fpc_copy_jenumset_array(TJEnumSetArray(src),TJEnumSetArray(result),start,len);
FPCJDynArrTypeBitSet:
fpc_copy_jbitset_array(TJBitSetArray(src),TJBitSetArray(result),start,len);
FPCJDynArrTypeProcvar:
fpc_copy_jprocvar_array(TJProcVarArray(src),TJProcVarArray(result),start,len);
FPCJDynArrTypeShortstring:
fpc_copy_jshortstring_array(TShortstringArray(src),TShortstringArray(result),start,len);
else
fpc_copy_shallow_array(src,result,start,len);
end
end
else
begin
for i:=0 to len-1 do
TJObjectArray(result)[i]:=fpc_dynarray_copy(TJObjectArray(src)[start+i],-1,-1,ndim-1,eletype);
end;
end;
{i jdynarr.inc end}
{*****************************************************************************
Things from system.inc
*****************************************************************************}
Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
{
Procedure to handle internal errors, i.e. not user-invoked errors
Internal function should ALWAYS call HandleError instead of RunError.
For now this one cannot be intercepted in Java and always simply raise an
exception.
}
begin
raise JLException.Create('Runtime error '+UnicodeString(JLInteger.valueOf(Errno).toString));
end;
{$ifdef SUPPORT_DOUBLE}
operator := (b:real48) d:double;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
D:=real2double(b);
end;
{$endif SUPPORT_DOUBLE}
{$i jdynarr.inc}
{*****************************************************************************
Misc. System Dependent Functions
*****************************************************************************}
procedure TObject.Free;
begin
if not DestructorCalled then
begin
DestructorCalled:=true;
Destroy;
end;
end;
procedure System_exit;
begin
JLRuntime.getRuntime.exit(ExitCode);
end;
destructor TObject.Destroy;
begin
end;
procedure TObject.Finalize;
begin
Free;
end;
procedure randomize;
begin
randseed:=JUCalendar.getInstance.getTimeInMillis;
end;
{*****************************************************************************
SystemUnit Initialization

2
rtl/java/ustringh.inc
View File

@ -48,7 +48,7 @@ Function UpCase(c:UnicodeChar):UnicodeChar;
Type
{ hooks for internationalization
please add new procedures at the end, it makes it easier to detect new procedures }
TUnicodeStringManager = class
TUnicodeStringManager = class(JLObject)
collator: JTCollator;
constructor create;
end;

6
rtl/java/jint64.inc → rtl/jvm/int64p.inc
View File

@ -16,6 +16,7 @@
{$R- no range checking }
{$ifndef FPC_SYSTEM_HAS_DIV_QWORD}
{$define FPC_SYSTEM_HAS_DIV_QWORD}
function fpc_div_qword(n,z : qword) : qword; compilerproc;
var
signmask, tmpz: qword;
@ -33,6 +34,7 @@
{$ifndef FPC_SYSTEM_HAS_MOD_QWORD}
{$define FPC_SYSTEM_HAS_MOD_QWORD}
function fpc_mod_qword(n,z : qword) : qword; compilerproc;
var
signmask, tmpz: qword;
@ -49,3 +51,7 @@
end;
{$endif FPC_SYSTEM_HAS_MOD_QWORD}
{ lie to prevent two overloads for sqr(jlong) }
{$define FPC_SYSTEM_HAS_SQR_QWORD}

363
rtl/jvm/jvm.inc Normal file
View File

@ -0,0 +1,363 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by the Free Pascal development team.
Processor dependent implementation for the system unit for
JVM
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{****************************************************************************
JVM specific stuff
****************************************************************************}
{$define FPC_SYSTEM_HAS_SYSINITFPU}
Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
end;
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
softfloat_exception_flags:=0;
end;
procedure fpc_cpuinit;
begin
SysResetFPU;
if not(IsLibrary) then
SysInitFPU;
end;
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:pointer;
begin
result:=nil;
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer):pointer;
begin
result:=nil;
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer):pointer;
begin
result:=nil;
end;
{$define FPC_SYSTEM_HAS_SPTR}
function Sptr:Pointer;
begin
result:=nil;
end;
{****************************************************************************
Primitives
****************************************************************************}
{ lie so that the non-compilable generic versions will be skipped }
{$define FPC_SYSTEM_HAS_MOVE}
{$define FPC_SYSTEM_HAS_FILLCHAR}
{$define FPC_SYSTEM_HAS_FILLWORD}
{$define FPC_SYSTEM_HAS_FILLDWORD}
{$define FPC_SYSTEM_HAS_FILLQWORD}
{$define FPC_SYSTEM_HAS_INDEXBYTE}
{$define FPC_SYSTEM_HAS_INDEXWORD}
{$define FPC_SYSTEM_HAS_INDEXDWORD}
{$define FPC_SYSTEM_HAS_INDEXQWORD}
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
{$define FPC_SYSTEM_HAS_COMPAREWORD}
{$define FPC_SYSTEM_HAS_COMPAREDWORD}
{$define FPC_SYSTEM_HAS_MOVECHAR0}
{$define FPC_SYSTEM_HAS_INDEXCHAR0}
{$define FPC_SYSTEM_HAS_COMPARECHAR0}
{****************************************************************************
String
****************************************************************************}
{ more lies }
{$define FPC_STRTOSHORTSTRINGPROC}
{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
{$define FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
var
len: longint;
begin
len:=length(sstr);
if len>high(res) then
len:=high(res);
ShortstringClass(@res).curlen:=len;
JLSystem.ArrayCopy(JLObject(ShortstringClass(@sstr).fdata),0,JLObject(ShortstringClass(@res).fdata),0,len);
end;
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
var
tmpres: ShortstringClass;
s1l, s2l: longint;
begin
s1l:=length(s1);
s2l:=length(s2);
if (s1l+s2l)>high(dests) then
begin
if s1l>high(dests) then
s1l:=high(dests);
s2l:=high(dests)-s1l;
end;
if ShortstringClass(@dests)=ShortstringClass(@s1) then
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
else if ShortstringClass(@dests)=ShortstringClass(@s2) then
begin
JLSystem.ArrayCopy(JLObject(ShortstringClass(@dests).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
end
else
begin
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
end;
ShortstringClass(@dests).curlen:=s1l+s2l;
end;
procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
var
s2l : byte;
LowStart,i,
Len : longint;
needtemp : boolean;
tmpstr : shortstring;
p,pdest : ShortstringClass;
begin
if high(sarr)=0 then
begin
DestS:='';
exit;
end;
lowstart:=low(sarr);
if ShortstringClass(@DestS)=sarr[lowstart] then
inc(lowstart);
{ Check for another reuse, then we can't use
the append optimization and need to use a temp }
needtemp:=false;
for i:=lowstart to high(sarr) do
begin
if ShortstringClass(@DestS)=sarr[i] then
begin
needtemp:=true;
break;
end;
end;
if needtemp then
begin
lowstart:=low(sarr);
tmpstr:='';
pdest:=ShortstringClass(@tmpstr)
end
else
begin
{ Start with empty DestS if we start with concatting
the first array element }
if lowstart=low(sarr) then
DestS:='';
pdest:=ShortstringClass(@DestS);
end;
{ Concat all strings, except the string we already
copied in DestS }
Len:=pdest.curlen;
for i:=lowstart to high(sarr) do
begin
p:=sarr[i];
if assigned(p) then
begin
s2l:=p.curlen;
if Len+s2l>high(dests) then
s2l:=high(dests)-Len;
JLSystem.ArrayCopy(JLObject(p.fdata),0,JLObject(pdest.fdata),len,s2l);
inc(Len,s2l);
end;
end;
pdest.curlen:=len;
if needtemp then
DestS:=TmpStr;
end;
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
var
s1l, s2l : integer;
begin
s1l:=length(s1);
s2l:=length(s2);
if s1l+s2l>high(s1) then
s2l:=high(s1)-s1l;
JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@s1).fdata),s1l,s2l);
s1[0]:=chr(s1l+s2l);
end;
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
Var
MaxI,Temp, i : SizeInt;
begin
if ShortstringClass(@left)=ShortstringClass(@right) then
begin
result:=0;
exit;
end;
Maxi:=Length(left);
temp:=Length(right);
If MaxI>Temp then
MaxI:=Temp;
if MaxI>0 then
begin
for i:=0 to MaxI-1 do
begin
result:=ord(ShortstringClass(@left).fdata[i])-ord(ShortstringClass(@right).fdata[i]);
if result<>0 then
exit;
end;
result:=Length(left)-Length(right);
end
else
result:=Length(left)-Length(right);
end;
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE_EQUAL}
function fpc_shortstr_compare_intern(const left,right:shortstring) : longint; external name 'fpc_shortstr_compare';
function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
begin
{ perform normal comparsion, because JUArrays.equals() only returns true if
the arrays have equal length, while we only want to compare curlen bytes }
result:=fpc_shortstr_compare_intern(left,right);
end;
{$define FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
var
l: longint;
index: longint;
len: byte;
foundnull: boolean;
begin
l:=high(arr)+1;
if l>=high(res)+1 then
l:=high(res)
else if l<0 then
l:=0;
if zerobased then
begin
foundnull:=false;
for index:=low(arr) to l-1 do
if arr[index]=#0 then
begin
foundnull:=true;
break;
end;
if not foundnull then
len:=l
else
len:=index;
end
else
len:=l;
JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(@res).fdata),0,len);
ShortstringClass(@res).curlen:=len;
end;
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
var
len: longint;
begin
len:=length(src);
if len>length(res) then
len:=length(res);
{ make sure we don't access char 1 if length is 0 (JM) }
if len>0 then
JLSystem.ArrayCopy(JLObject(ShortstringClass(@src).fdata),0,JLObject(@res),0,len);
if len<=high(res) then
JUArrays.fill(TJByteArray(@res),len,high(res),0);
end;
{****************************************************************************
Str()
****************************************************************************}
{$define FPC_SYSTEM_HAS_INT_STR_LONGINT}
procedure int_str(l:longint;out s:shortstring);
begin
s:=unicodestring(JLInteger.valueOf(l).toString);
end;
{$define FPC_SYSTEM_HAS_INT_STR_LONGWORD}
procedure int_str_unsigned(l:longword;out s:shortstring);
begin
s:=unicodestring(JLLong.valueOf(l).toString);
end;
{$define FPC_SYSTEM_HAS_INT_STR_INT64}
procedure int_str(l:int64;out s:shortstring);
begin
s:=unicodestring(JLLong.valueOf(l).toString);
end;
{$define FPC_SYSTEM_HAS_INT_STR_QWORD}
procedure int_str_unsigned(l:qword;out s:shortstring);
var
tmp: int64;
tmpstr: JLString;
bi: JMBigInteger;
begin
tmp:=int64(l);
tmpstr:=JLLong.valueOf(tmp and $7fffffffffffffff).toString;
if tmp<0 then
begin
{ no unsigned 64 bit types in Java -> use big integer to add
high(int64) to the string representation }
bi:=JMBigInteger.Create(tmpstr);
bi:=bi.add(JMBigInteger.Create('9223372036854775808'));
tmpstr:=bi.toString;
end;
s:=unicodestring(tmpstr);
end;
{ lies... }
{$define FPC_SYSTEM_HAS_ODD_LONGWORD}
{$define FPC_SYSTEM_HAS_ODD_QWORD}
{$define FPC_SYSTEM_HAS_SQR_QWORD}

0
rtl/java/jmath.inc → rtl/jvm/math.inc
View File

0
rtl/jvm/setjump.inc Normal file
View File

0
rtl/jvm/setjumph.inc Normal file
View File