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

    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 -

.gitattributes

@@ -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

compiler/options.pas

@@ -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');

compiler/systems/i_jvm.pas

@@ -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;

rtl/inc/currh.inc

@@ -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}
 
 

rtl/inc/gencurr.inc

@@ -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;

rtl/inc/generic.inc

@@ -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}
 

rtl/inc/genmath.inc

@@ -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}

rtl/inc/sstrings.inc

@@ -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

rtl/java/astringh.inc

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

rtl/java/compproc.inc

@@ -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

rtl/java/java_sys.inc

@@ -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;

rtl/java/java_sysh.inc

@@ -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;

rtl/java/jdk15.inc

@@ -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;

rtl/java/jdk15.pas

@@ -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;

rtl/java/jdynarr.inc

@@ -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;
+

rtl/java/jsystem.inc

@@ -0,0 +1,1491 @@
+{
+
+    This file is part of the Free Pascal Run time library.
+    Copyright (c) 1999-2008 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.
+
+ **********************************************************************}
+
+
+{ The RTTI is implemented through a series of constants : }
+
+Const
+   // please update tkManagedTypes below if you add new
+   // values
+   tkUnknown       = 0;
+   tkInteger       = 1;
+   tkChar          = 2;
+   tkEnumeration   = 3;
+   tkFloat         = 4;
+   tkSet           = 5;
+   tkMethod        = 6;
+   tkSString       = 7;
+   tkString        = tkSString;
+   tkLString       = 8;
+   tkAString       = 9;
+   tkWString       = 10;
+   tkVariant       = 11;
+   tkArray         = 12;
+   tkRecord        = 13;
+   tkInterface     = 14;
+   tkClass         = 15;
+   tkObject        = 16;
+   tkWChar         = 17;
+   tkBool          = 18;
+   tkInt64         = 19;
+   tkQWord         = 20;
+   tkDynArray      = 21;
+   tkInterfaceCorba = 22;
+   tkProcVar       = 23;
+   tkUString       = 24;
+   tkHelper        = 26;
+
+  // all potentially managed types
+  tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
+                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
+
+{****************************************************************************
+                                Local types
+****************************************************************************}
+
+{
+  TextRec and FileRec are put in a separate file to make it available to other
+  units without putting it explicitly in systemh.
+  This way we keep TP compatibility, and the TextRec definition is available
+  for everyone who needs it.
+}
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+{$i filerec.inc}
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
+{$i textrec.inc}
+{$endif FPC_HAS_FEATURE_TEXTIO}
+
+{$ifdef FPC_HAS_FEATURE_EXITCODE}
+  {$ifdef FPC_OBJFPC_EXTENDED_IF}
+    {$if High(errorcode)<>maxExitCode}
+      {$define FPC_LIMITED_EXITCODE}
+    {$endif}
+  {$else}
+    {$define FPC_LIMITED_EXITCODE}
+  {$endif FPC_OBJFPC_EXTENDED_IF}
+{$endif FPC_HAS_FEATURE_EXITCODE}
+
+Procedure HandleError (Errno : Longint); forward;
+Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
+
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
+type
+  FileFunc = Procedure(var t : TextRec);
+{$endif FPC_HAS_FEATURE_TEXTIO}
+
+
+const
+  STACK_MARGIN = 16384;    { Stack size margin for stack checking }
+{ Random / Randomize constants }
+  OldRandSeed : Cardinal = 0;
+
+(*
+{ For Error Handling.}
+  ErrorBase : Pointer = nil;
+*)
+
+{ Used by the ansi/widestrings and maybe also other things in the future }
+var
+  { widechar, because also used by widestring -> pwidechar conversions }
+  emptychar : widechar;public name 'FPC_EMPTYCHAR';
+{$ifndef FPC_NO_GENERIC_STACK_CHECK}
+  { if the OS does the stack checking, we don't need any stklen from the
+    main program }
+  initialstklen : SizeUint;external name '__stklen';
+{$endif FPC_NO_GENERIC_STACK_CHECK}
+
+{ checks whether the given suggested size for the stack of the current
+ thread is acceptable. If this is the case, returns it unaltered.
+ Otherwise it should return an acceptable value.
+
+ Operating systems that automatically expand their stack on demand, should
+ simply return a very large value.
+ Operating systems which do not have a possibility to retrieve stack size
+ information, should simply return the given stklen value (This is the default
+ implementation).
+}
+{$ifdef FPC_HAS_FEATURE_STACKCHECK}
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt; forward;
+{$endif FPC_HAS_FEATURE_STACKCHECK}
+
+{*****************************************************************************
+                       OS dependent Helpers/Syscalls
+*****************************************************************************}
+
+{ for some OSes do_isdevice is defined in sysos.inc, but for others (win32)
+  it isn't, and is used before the actual definition is encountered         }
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+function do_isdevice(handle:thandle):boolean;forward;
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+
+{$i sysos.inc}
+
+
+{****************************************************************************
+                    Include processor specific routines
+****************************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+{ Under Haiku, bcopy cause a problem when searching for include file
+  in the compiler. So, we use the internal implementation for now
+  under BeOS and Haiku.  }
+{$ifndef BEOS}
+{ prefer libc implementations over our own, as they're most likely faster }
+{$i cgeneric.inc}
+{ is now declared as external reference to another routine in the interface }
+{$i cgenstr.inc}
+{$endif}
+{$endif FPC_USE_LIBC}
+
+{$ifdef cpui386}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i i386.inc}  { Case dependent, don't change }
+{$endif cpui386}
+
+{$ifdef cpum68k}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i m68k.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpum68k}
+
+{$ifdef cpux86_64}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i x86_64.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpux86_64}
+
+{$ifdef cpupowerpc32}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i powerpc.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpupowerpc32}
+
+{$ifdef cpupowerpc64}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i powerpc64.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpupowerpc64}
+
+{$ifdef cpualpha}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i alpha.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpualpha}
+
+{$ifdef cpuiA64}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i ia64.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpuiA64}
+
+{$ifdef cpusparc}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i sparc.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpusparc}
+
+{$ifdef cpuarm}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$if defined(CPUCORTEXM3) or defined(CPUARMV7M)}
+    {$i thumb2.inc}  { Case dependent, don't change }
+  {$else}
+    {$i arm.inc}  { Case dependent, don't change }
+  {$endif}
+  {$define SYSPROCDEFINED}
+{$endif cpuarm}
+
+{$ifdef cpuavr}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i avr.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpuavr}
+
+{$ifdef cpujvm}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i jvm.inc}
+  {$define SYSPROCDEFINED}
+{$endif cpuavr}
+
+{$ifndef jvm}
+procedure fillchar(var x;count : SizeInt;value : boolean);
+begin
+  fillchar(x,count,byte(value));
+end;
+
+
+procedure fillchar(var x;count : SizeInt;value : char);
+begin
+  fillchar(x,count,byte(value));
+end;
+
+
+procedure FillByte (var x;count : SizeInt;value : byte );
+begin
+  FillChar (X,Count,VALUE);
+end;
+
+
+function IndexChar(Const buf;len:SizeInt;b:char):SizeInt;
+begin
+  IndexChar:=IndexByte(Buf,Len,byte(B));
+end;
+
+
+function CompareChar(Const buf1,buf2;len:SizeInt):SizeInt;
+begin
+  CompareChar:=CompareByte(buf1,buf2,len);
+end;
+{$endif jvm}
+
+{ Include generic pascal only routines which are not defined in the processor
+  specific include file }
+{$I generic.inc}
+
+
+{****************************************************************************
+                                Set Handling
+****************************************************************************}
+
+{$ifndef jvm}
+{ Include set support which is processor specific}
+{$i set.inc}
+{ Include generic pascal routines for sets if the processor }
+{ specific routines are not available.                      }
+{$i genset.inc}
+{$endif}
+
+{****************************************************************************
+                               Math Routines
+****************************************************************************}
+
+function Hi(b : byte): byte;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+   Hi := b shr 4
+end;
+
+function Lo(b : byte): byte;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+   Lo := b and $0f
+end;
+
+Function Swap (X : Word) : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Swap := SwapEndian(X);
+End;
+
+//Function Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}
+//Begin
+//  Swap := SwapEndian(X);
+//End;
+
+Function Swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Swap:=(X and $ffff) shl 16 + (X shr 16)
+End;
+
+//Function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}
+//Begin
+//  Swap:=(X and $ffff) shl 16 + (X shr 16)
+//End;
+
+//Function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
+//Begin
+//  Swap:=(X and $ffffffff) shl 32 + (X shr 32);
+//End;
+
+Function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Swap:=(X and $ffffffff) shl 32 + (X shr 32);
+End;
+
+{$ifdef SUPPORT_DOUBLE}
+operator := (b:real48) d:double;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ D:=real2double(b);
+end;
+{$endif SUPPORT_DOUBLE}
+
+{$ifdef SUPPORT_EXTENDED}
+operator := (b:real48) e:extended;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ e:=real2double(b);
+end;
+{$endif SUPPORT_EXTENDED}
+
+{$ifndef FPUNONE}
+{$ifdef FPC_USE_LIBC}
+{ Include libc versions }
+{$i cgenmath.inc}
+{$endif FPC_USE_LIBC}
+{ Include processor specific routines }
+{$I math.inc}
+{ Include generic version }
+{$I genmath.inc}
+{$endif}
+
+{$i gencurr.inc}
+
+
+function aligntoptr(p : pointer) : pointer;inline;
+  begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+    result:=align(p,sizeof(p));
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+    result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  end;
+
+
+{****************************************************************************
+                  Subroutines for String handling
+****************************************************************************}
+
+{ Needs to be before RTTI handling }
+
+{$i sstrings.inc}
+
+{ requires sstrings.inc for initval }
+{$I int64p.inc}
+{ contains invalid typecasts for the JVM}
+{$ifndef jvm}
+{$I int64.inc}
+{$endif not jvm}
+
+{Requires int64.inc, since that contains the VAL functions for int64 and qword}
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+{$i astrings.inc}
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+    {$i wstrings.inc}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$i ustrings.inc}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$i aliases.inc}
+
+{*****************************************************************************
+                        Dynamic Array support
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
+(*
+{$i dynarr.inc}
+*)
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
+
+{*****************************************************************************
+                        Object Pascal support
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_CLASSES}
+{$i objpas.inc}
+{$endif FPC_HAS_FEATURE_CLASSES}
+
+{*****************************************************************************
+                            Variant support
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
+{$i variant.inc}
+{$endif FPC_HAS_FEATURE_VARIANTS}
+
+{****************************************************************************
+                         Run-Time Type Information (RTTI)
+****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_RTTI}
+{$i rtti.inc}
+{$endif FPC_HAS_FEATURE_RTTI}
+
+{$if defined(FPC_HAS_FEATURE_RANDOM)}
+
+{----------------------------------------------------------------------
+   Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
+   Pseudo-Random Number Generator.
+
+   What is Mersenne Twister?
+   Mersenne Twister(MT) is a pseudorandom number generator developped by
+   Makoto Matsumoto and Takuji Nishimura (alphabetical order) during
+   1996-1997. MT has the following merits:
+   It is designed with consideration on the flaws of various existing
+   generators.
+   Far longer period and far higher order of equidistribution than any
+   other implemented generators. (It is proved that the period is 2^19937-1,
+   and 623-dimensional equidistribution property is assured.)
+   Fast generation. (Although it depends on the system, it is reported that
+   MT is sometimes faster than the standard ANSI-C library in a system
+   with pipeline and cache memory.)
+   Efficient use of the memory. (The implemented C-code mt19937.c
+   consumes only 624 words of working area.)
+
+   home page
+     http://www.math.keio.ac.jp/~matumoto/emt.html
+   original c source
+     http://www.math.keio.ac.jp/~nisimura/random/int/mt19937int.c
+
+   Coded by Takuji Nishimura, considering the suggestions by
+   Topher Cooper and Marc Rieffel in July-Aug. 1997.
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either
+   version 2 of the License, or (at your option) any later
+   version.
+   This library 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.
+   See the GNU Library General Public License for more details.
+   You should have received a copy of the GNU Library General
+   Public License along with this library; if not, write to the
+   Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307  USA
+
+   Copyright (C) 1997, 1999 Makoto Matsumoto and Takuji Nishimura.
+   When you use this, send an email to: [email protected]
+   with an appropriate reference to your work.
+
+   REFERENCE
+   M. Matsumoto and T. Nishimura,
+   "Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
+   Pseudo-Random Number Generator",
+   ACM Transactions on Modeling and Computer Simulation,
+   Vol. 8, No. 1, January 1998, pp 3--30.
+
+
+  Translated to OP and Delphi interface added by Roman Krejci (6.12.1999)
+
+  http://www.rksolution.cz/delphi/tips.htm
+
+  Revised 21.6.2000: Bug in the function RandInt_MT19937 fixed
+
+  2003/10/26: adapted to use the improved intialisation mentioned at
+  <http://www.math.keio.ac.jp/~matumoto/MT2002/emt19937ar.html> and
+  removed the assembler code
+
+ ----------------------------------------------------------------------}
+
+{$R-} {range checking off}
+{$Q-} {overflow checking off}
+
+{ Period parameter }
+Const
+  MT19937N=624;
+
+Type
+  tMT19937StateArray = array [0..MT19937N-1] of longint; // the array for the state vector
+
+{ Period parameters }
+const
+  MT19937M=397;
+  MT19937MATRIX_A  =$9908b0df;  // constant vector a
+  MT19937UPPER_MASK=longint($80000000);  // most significant w-r bits
+  MT19937LOWER_MASK=longint($7fffffff);  // least significant r bits
+
+{ Tempering parameters }
+  TEMPERING_MASK_B=longint($9d2c5680);
+  TEMPERING_MASK_C=longint($efc60000);
+
+
+VAR
+  mt : tMT19937StateArray;
+
+const
+  mti: longint=MT19937N+1; // mti=MT19937N+1 means mt[] is not initialized
+
+{ Initializing the array with a seed }
+procedure sgenrand_MT19937(seed: longint);
+var
+  i: longint;
+begin
+  mt[0] := seed;
+  for i := 1 to MT19937N-1 do
+    begin
+      mt[i] := 1812433253 * (mt[i-1] xor (mt[i-1] shr 30)) + i;
+      { See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. }
+      { In the previous versions, MSBs of the seed affect   }
+      { only MSBs of the array mt[].                        }
+      { 2002/01/09 modified by Makoto Matsumoto             }
+    end;
+  mti := MT19937N;
+end;
+
+
+function genrand_MT19937: longint;
+const
+  mag01 : array [0..1] of longint =(0, longint(MT19937MATRIX_A));
+var
+  y: longint;
+  kk: longint;
+begin
+  if RandSeed<>OldRandSeed then
+    mti:=MT19937N+1;
+  if (mti >= MT19937N) { generate MT19937N longints at one time }
+  then begin
+     if mti = (MT19937N+1) then  // if sgenrand_MT19937() has not been called,
+       begin
+         sgenrand_MT19937(randseed);   // default initial seed is used
+         { hack: randseed is not used more than once in this algorithm. Most }
+         {  user changes are re-initialising reandseed with the value it had }
+         {  at the start -> with the "not", we will detect this change.      }
+         {  Detecting other changes is not useful, since the generated       }
+         {  numbers will be different anyway.                                }
+         randseed := not(randseed);
+         oldrandseed := randseed;
+       end;
+     for kk:=0 to MT19937N-MT19937M-1 do begin
+        y := (mt[kk] and MT19937UPPER_MASK) or (mt[kk+1] and MT19937LOWER_MASK);
+        mt[kk] := mt[kk+MT19937M] xor (y shr 1) xor mag01[y and $00000001];
+     end;
+     for kk:= MT19937N-MT19937M to MT19937N-2 do begin
+       y := (mt[kk] and MT19937UPPER_MASK) or (mt[kk+1] and MT19937LOWER_MASK);
+       mt[kk] := mt[kk+(MT19937M-MT19937N)] xor (y shr 1) xor mag01[y and $00000001];
+     end;
+     y := (mt[MT19937N-1] and MT19937UPPER_MASK) or (mt[0] and MT19937LOWER_MASK);
+     mt[MT19937N-1] := mt[MT19937M-1] xor (y shr 1) xor mag01[y and $00000001];
+     mti := 0;
+  end;
+  y := mt[mti]; inc(mti);
+  y := y xor (y shr 11);
+  y := y xor (y shl 7)  and TEMPERING_MASK_B;
+  y := y xor (y shl 15) and TEMPERING_MASK_C;
+  y := y xor (y shr 18);
+  Result := y;
+end;
+
+
+function random(l:longint): longint;
+begin
+  { otherwise we can return values = l (JM) }
+  if (l < 0) then
+    inc(l);
+  random := longint((int64(cardinal(genrand_MT19937))*l) shr 32);
+end;
+
+function random(l:int64): int64;
+begin
+  { always call random, so the random generator cycles (TP-compatible) (JM) }
+  random := int64((qword(cardinal(genrand_MT19937)) or ((qword(cardinal(genrand_MT19937)) shl 32))) and $7fffffffffffffff);
+  if (l<>0) then
+    random := random mod l
+  else
+    random := 0;
+end;
+
+{$ifndef FPUNONE}
+function random: extended;
+begin
+  random := cardinal(genrand_MT19937) * (extended(1.0)/(int64(1) shl 32));
+end;
+{$endif}
+{$endif FPC_HAS_FEATURE_RANDOM}
+
+
+{****************************************************************************
+                            Memory Management
+****************************************************************************}
+(*
+Function Ptr(sel,off : Longint) : farpointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  ptr:=farpointer((sel shl 4)+off);
+End;
+
+Function CSeg : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Cseg:=0;
+End;
+
+Function DSeg : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Dseg:=0;
+End;
+
+Function SSeg : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Sseg:=0;
+End;
+*)
+
+
+{$ifopt R+}
+{$define RangeCheckWasOn}
+{$R-}
+{$endif opt R+}
+
+{$ifopt I+}
+{$define IOCheckWasOn}
+{$I-}
+{$endif opt I+}
+
+{$ifopt Q+}
+{$define OverflowCheckWasOn}
+{$Q-}
+{$endif opt Q+}
+
+{*****************************************************************************
+                             Miscellaneous
+*****************************************************************************}
+
+procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; compilerproc;
+begin
+  HandleErrorFrame(201,get_frame);
+end;
+
+
+procedure fpc_divbyzero;[public,alias:'FPC_DIVBYZERO']; compilerproc;
+begin
+  HandleErrorFrame(200,get_frame);
+end;
+
+
+procedure fpc_overflow;[public,alias:'FPC_OVERFLOW']; compilerproc;
+begin
+  HandleErrorFrame(215,get_frame);
+end;
+
+
+procedure fpc_threaderror; [public,alias:'FPC_THREADERROR'];
+begin
+  HandleErrorFrame(6,get_frame);
+end;
+
+(*
+procedure fpc_iocheck;[public,alias:'FPC_IOCHECK']; compilerproc;
+var
+  l : longint;
+  HInoutRes : PWord;
+begin
+  HInOutRes:=@InoutRes;
+  if HInOutRes^<>0 then
+   begin
+     l:=HInOutRes^;
+     HInOutRes^:=0;
+     HandleErrorFrame(l,get_frame);
+   end;
+end;
+
+
+Function IOResult:Word;
+var
+  HInoutRes : PWord;
+Begin
+  HInoutRes:=@InoutRes;
+  IOResult:=HInOutRes^;
+  HInOutRes^:=0;
+End;
+
+
+Function GetThreadID:TThreadID;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+(* ThreadID is stored in a threadvar and made available in interface *)
+(* to allow setup of this value during thread initialization.        *)
+  GetThreadID := ThreadID;
+end;
+
+
+function fpc_safecallcheck(res : hresult) : hresult;[public,alias:'FPC_SAFECALLCHECK']; compilerproc; {$ifdef CPU86} register; {$endif}
+begin
+  if res<0 then
+    begin
+      if assigned(SafeCallErrorProc) then
+        SafeCallErrorProc(res,get_frame);
+      HandleErrorFrame(229,get_frame);
+    end;
+  result:=res;
+end;
+*)
+
+{*****************************************************************************
+                         Stack check code
+*****************************************************************************}
+
+{ be compatible with old code }
+{$ifdef FPC_NO_GENERIC_STACK_CHECK}
+{$define NO_GENERIC_STACK_CHECK}
+{$endif FPC_NO_GENERIC_STACK_CHECK}
+
+{$IFNDEF NO_GENERIC_STACK_CHECK}
+
+{$IFOPT S+}
+{$DEFINE STACKCHECK}
+{$ENDIF}
+{$S-}
+procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK'];
+var
+  c : Pointer;
+begin
+  { Avoid recursive calls when called from the exit routines }
+  if StackError then
+   exit;
+  { don't use sack_size, since the stack pointer has already been
+    decreased when this routine is called
+  }
+  c := Sptr - STACK_MARGIN;
+  if (c <= StackBottom) then
+   begin
+     StackError:=true;
+     HandleError(202);
+   end;
+end;
+{$IFDEF STACKCHECK}
+{$S+}
+{$ENDIF}
+{$UNDEF STACKCHECK}
+
+{$ENDIF NO_GENERIC_STACK_CHECK}
+
+{*****************************************************************************
+                        Initialization / Finalization
+*****************************************************************************}
+(*
+const
+  maxunits=1024; { See also files.pas of the compiler source }
+type
+  TInitFinalRec=record
+    InitProc,
+    FinalProc : TProcedure;
+  end;
+  TInitFinalTable = record
+    TableCount,
+    InitCount  : longint;
+    Procs      : array[1..maxunits] of TInitFinalRec;
+  end;
+  PInitFinalTable = ^TInitFinalTable;
+
+
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+var
+  InitFinalTable : TInitFinalTable;external name 'INITFINAL';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
+
+procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
+var
+  i : longint;
+begin
+  { call cpu/fpu initialisation routine }
+  fpc_cpuinit;
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+  with PInitFinalTable(EntryInformation.InitFinalTable)^ do
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
+  with InitFinalTable do
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+   begin
+     for i:=1 to TableCount do
+      begin
+        if assigned(Procs[i].InitProc) then
+         Procs[i].InitProc();
+        InitCount:=i;
+      end;
+   end;
+  if assigned(InitProc) then
+    TProcedure(InitProc)();
+end;
+
+
+procedure internal_initializeunits; external name 'FPC_INITIALIZEUNITS';
+
+procedure fpc_LibInitializeUnits;[public,alias:'FPC_LIBINITIALIZEUNITS'];
+begin
+  IsLibrary:=true;
+  { must also be set to true for packages when implemented }
+  ModuleIsLib:=true;
+  internal_initializeunits;
+end;
+
+
+procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
+begin
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+  with PInitFinalTable(EntryInformation.InitFinalTable)^ do
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
+  with InitFinalTable do
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+   begin
+     while (InitCount>0) do
+      begin
+        // we've to decrement the cound before calling the final. code
+        // else a halt in the final. code leads to a endless loop
+        dec(InitCount);
+        if assigned(Procs[InitCount+1].FinalProc) then
+         Procs[InitCount+1].FinalProc();
+      end;
+   end;
+end;
+*)
+{*****************************************************************************
+                          Error / Exit / ExitProc
+*****************************************************************************}
+
+Procedure system_exit;forward;
+{$ifdef FPC_HAS_FEATURE_HEAP}
+{$ifndef HAS_MEMORYMANAGER}
+//not needed if independant memory manager
+Procedure FinalizeHeap;forward;
+{$endif HAS_MEMORYMANAGER}
+{$endif FPC_HAS_FEATURE_HEAP}
+
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+procedure SysFlushStdIO;
+var
+  pstdout : ^Text;
+begin
+  { Show runtime error and exit }
+  pstdout:=@stdout;
+  If erroraddr<>nil Then
+   Begin
+     Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr));
+     { to get a nice symify }
+     Writeln(pstdout^,BackTraceStrFunc(Erroraddr));
+     dump_stack(pstdout^,ErrorBase);
+     Writeln(pstdout^,'');
+   End;
+
+  { Make sure that all output is written to the redirected file }
+  if Textrec(Output).Mode=fmOutput then
+    Flush(Output);
+  if Textrec(ErrOutput).Mode=fmOutput then
+    Flush(ErrOutput);
+  if Textrec(pstdout^).Mode=fmOutput then
+    Flush(pstdout^);
+  if Textrec(StdErr).Mode=fmOutput then
+    Flush(StdErr);
+end;
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+
+
+Procedure InternalExit;
+(*
+var
+  current_exit : Procedure;
+{$if defined(MSWINDOWS) or defined(OS2)}
+  i : longint;
+{$endif}
+*)
+Begin
+(*
+{$ifdef SYSTEMDEBUG}
+  writeln('InternalExit');
+{$endif SYSTEMDEBUG}
+  while exitProc<>nil Do
+   Begin
+     InOutRes:=0;
+     current_exit:=tProcedure(exitProc);
+     exitProc:=nil;
+     current_exit();
+   End;
+  { Finalize units }
+  FinalizeUnits;
+
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+  SysFlushStdIO;
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+
+{$if defined(MSWINDOWS) or defined(OS2)}
+  { finally release the heap if possible, especially
+    important for DLLs.
+    Reset the array to nil, and finally also argv itself to
+    avoid double freeing problem in case this function gets called twice. }
+  if assigned(argv) then
+    begin
+      for i:=0 to argc-1 do
+        if assigned(argv[i]) then
+          begin
+            sysfreemem(argv[i]);
+            argv[i]:=nil;
+          end;
+      sysfreemem(argv);
+      argv:=nil;
+    end;
+{$endif}
+{$ifdef LINUX}
+  {sysfreemem already checks for nil}
+  sysfreemem(calculated_cmdline);
+{$endif}
+{$ifdef BSD}
+  sysfreemem(cmdline);
+{$endif}
+
+{$ifdef FPC_HAS_FEATURE_HEAP}
+{$ifndef HAS_MEMORYMANAGER}
+  FinalizeHeap;
+{$endif HAS_MEMORYMANAGER}
+{$endif FPC_HAS_FEATURE_HEAP}
+*)
+End;
+
+
+Procedure do_exit;[Public,Alias:'FPC_DO_EXIT'];
+begin
+  InternalExit;
+  System_exit;
+end;
+
+
+Procedure lib_exit;[Public,Alias:'FPC_LIB_EXIT'];
+begin
+  InternalExit;
+end;
+
+
+Procedure Halt(ErrNum: Longint);
+Begin
+  ExitCode:=Errnum;
+  Do_Exit;
+end;
+
+(*
+function SysBackTraceStr (Addr: Pointer): ShortString;
+begin
+  SysBackTraceStr:='  $'+hexstr(addr);
+end;
+*)
+
+
+
+Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer);[public,alias:'FPC_BREAK_ERROR']; {$ifdef CPU86} register; {$endif}
+begin
+  raise FpcRunTimeError.Create(Errno);
+(*
+  If pointer(ErrorProc)<>Nil then
+    ErrorProc(Errno,addr,frame);
+  errorcode:=word(Errno);
+  erroraddr:=addr;
+  errorbase:=frame;
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+  if ExceptAddrStack <> nil then
+    raise TObject(nil) at addr,frame;
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
+
+{$ifdef FPC_HAS_FEATURE_EXITCODE}
+{$ifdef FPC_LIMITED_EXITCODE}
+  if errorcode > maxExitCode then
+    halt(255)
+  else
+{$endif FPC_LIMITED_EXITCODE}
+    halt(errorcode);
+{$else FPC_HAS_FEATURE_EXITCODE}
+  halt;
+{$endif FPC_HAS_FEATURE_EXITCODE}
+*)
+end;
+
+Procedure HandleErrorFrame (Errno : longint;frame : Pointer);
+{
+  Procedure to handle internal errors, i.e. not user-invoked errors
+  Internal function should ALWAYS call HandleError instead of RunError.
+  Can be used for exception handlers to specify the frame
+}
+begin
+  HandleErrorAddrFrame(Errno,get_caller_addr(frame),get_caller_frame(frame));
+end;
+
+
+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.
+}
+begin
+  HandleErrorFrame(Errno,get_frame);
+end;
+
+
+procedure RunError(w : word);[alias: 'FPC_RUNERROR'];
+begin
+  errorcode:=w;
+(*
+  erroraddr:=get_caller_addr(get_frame);
+  errorbase:=get_caller_frame(get_frame);
+  *)
+{$ifdef FPC_HAS_FEATURE_EXITCODE}
+{$ifdef FPC_LIMITED_EXITCODE}
+  if errorcode > maxExitCode then
+    halt(255)
+  else
+{$endif FPC_LIMITED_EXITCODE}
+    halt(errorcode);
+{$else FPC_HAS_FEATURE_EXITCODE}
+  halt;
+{$endif FPC_HAS_FEATURE_EXITCODE}
+end;
+
+
+Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  RunError (0);
+End;
+
+
+Procedure Halt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+  Halt(0);
+End;
+
+Procedure Error(RunTimeError : TRunTimeError);
+
+begin
+  RunError(RuntimeErrorExitCodes[RunTimeError]);
+end;
+
+
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+Procedure dump_stack(var f : text;bp : Pointer);
+var
+  i : Longint;
+  prevbp : Pointer;
+  is_dev : boolean;
+  caller_frame,
+  caller_addr : Pointer;
+Begin
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+  try
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
+    prevbp:=bp-1;
+    i:=0;
+    is_dev:=do_isdevice(textrec(f).Handle);
+    while bp > prevbp Do
+     Begin
+       caller_addr := get_caller_addr(bp);
+       caller_frame := get_caller_frame(bp);
+       if (caller_addr=nil) then
+         break;
+       Writeln(f,BackTraceStrFunc(caller_addr));
+       if (caller_frame=nil) then
+         break;
+       Inc(i);
+       If ((i>max_frame_dump) and is_dev) or (i>256) Then
+         break;
+       prevbp:=bp;
+       bp:=caller_frame;
+     End;
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+   except
+     { prevent endless dump if an exception occured }
+   end;
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
+End;
+
+
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+procedure DumpExceptionBackTrace(var f:text);
+var
+  FrameNumber,
+  FrameCount   : longint;
+  Frames       : PPointer;
+begin
+  if RaiseList=nil then
+    exit;
+  WriteLn(f,BackTraceStrFunc(RaiseList^.Addr));
+  FrameCount:=RaiseList^.Framecount;
+  Frames:=RaiseList^.Frames;
+  for FrameNumber := 0 to FrameCount-1 do
+    WriteLn(f,BackTraceStrFunc(Frames[FrameNumber]));
+end;
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
+
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+
+
+{$ifdef FPC_HAS_FEATURE_HEAP}
+Type
+  PExitProcInfo = ^TExitProcInfo;
+  TExitProcInfo = Record
+    Next     : PExitProcInfo;
+    SaveExit : Pointer;
+    Proc     : TProcedure;
+  End;
+const
+  ExitProcList: PExitProcInfo = nil;
+
+Procedure DoExitProc;
+var
+  P    : PExitProcInfo;
+  Proc : TProcedure;
+Begin
+  P:=ExitProcList;
+  ExitProcList:=P^.Next;
+  ExitProc:=P^.SaveExit;
+  Proc:=P^.Proc;
+  DisPose(P);
+  Proc();
+End;
+
+
+Procedure AddExitProc(Proc: TProcedure);
+var
+  P : PExitProcInfo;
+Begin
+  New(P);
+  P^.Next:=ExitProcList;
+  P^.SaveExit:=ExitProc;
+  P^.Proc:=Proc;
+  ExitProcList:=P;
+  ExitProc:=@DoExitProc;
+End;
+{$endif FPC_HAS_FEATURE_HEAP}
+
+
+{$ifdef FPC_HAS_FEATURE_HEAP}
+function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
+// Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?)
+// Note: for internal use by skilled programmers only
+// if "s" goes out of scope in the parent procedure, the pointer is dangling.
+
+var p   : ppchar;
+    i   : LongInt;
+begin
+  if High(s)<Low(s) Then Exit(NIL);
+  Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2));  // one more for NIL, one more
+                                              // for cmd
+  if p=nil then
+    begin
+      {$ifdef xunix}
+      fpseterrno(ESysEnomem);
+      {$endif}
+      exit(NIL);
+    end;
+  for i:=low(s) to high(s) do
+     p[i+Reserveentries]:=pchar(s[i]);
+  p[high(s)+1+Reserveentries]:=nil;
+  ArrayStringToPPchar:=p;
+end;
+
+
+Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
+{
+  Create a PPChar to structure of pchars which are the arguments specified
+  in the string S. Especially useful for creating an ArgV for Exec-calls
+}
+
+begin
+  StringToPPChar:=StringToPPChar(PChar(S),ReserveEntries);
+end;
+
+
+Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
+
+var
+  i,nr  : longint;
+  Buf : ^char;
+  p   : ppchar;
+
+begin
+  buf:=s;
+  nr:=1;
+  while (buf^<>#0) do                   // count nr of args
+   begin
+     while (buf^ in [' ',#9,#10]) do    // Kill separators.
+      inc(buf);
+     inc(nr);
+     if buf^='"' Then                   // quotes argument?
+      begin
+        inc(buf);
+        while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+         inc(buf);
+        if buf^='"' then                // skip closing quote.
+          inc(buf);
+      end
+     else
+       begin                            // else std
+         while not (buf^ in [' ',#0,#9,#10]) do
+           inc(buf);
+       end;
+   end;
+  getmem(p,(ReserveEntries+nr)*sizeof(pchar));
+  StringToPPChar:=p;
+  if p=nil then
+   begin
+     {$ifdef xunix}
+     fpseterrno(ESysEnomem);
+     {$endif}
+     exit;
+   end;
+  for i:=1 to ReserveEntries do inc(p); // skip empty slots
+  buf:=s;
+  while (buf^<>#0) do
+   begin
+     while (buf^ in [' ',#9,#10]) do    // Kill separators.
+      begin
+       buf^:=#0;
+       inc(buf);
+      end;
+     if buf^='"' Then                   // quotes argument?
+      begin
+        inc(buf);
+        p^:=buf;
+        inc(p);
+        p^:=nil;
+        while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+         inc(buf);
+        if buf^='"' then                // skip closing quote.
+          begin
+            buf^:=#0;
+            inc(buf);
+          end;
+      end
+     else
+       begin
+        p^:=buf;
+        inc(p);
+        p^:=nil;
+         while not (buf^ in [' ',#0,#9,#10]) do
+           inc(buf);
+       end;
+   end;
+end;
+{$endif FPC_HAS_FEATURE_HEAP}
+
+
+{*****************************************************************************
+                          Abstract/Assert support.
+*****************************************************************************}
+
+procedure fpc_AbstractErrorIntern;compilerproc;[public,alias : 'FPC_ABSTRACTERROR'];
+begin
+(*
+  If pointer(AbstractErrorProc)<>nil then
+    AbstractErrorProc();
+*)
+  HandleErrorFrame(211,get_frame);
+end;
+
+
+Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); [Public,Alias : 'FPC_ASSERT']; compilerproc;
+begin
+(*
+  if pointer(AssertErrorProc)<>nil then
+    AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
+  else
+*)
+    HandleErrorFrame(227,get_frame);
+end;
+
+
+Procedure SysAssert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer);
+begin
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+  If msg='' then
+    write(stderr,'Assertion failed')
+  else
+    write(stderr,msg);
+  Writeln(stderr,' (',FName,', line ',LineNo,').');
+  Writeln(stderr,'');
+{$ifdef FPC_HAS_FEATURE_EXITCODE}
+  Halt(227);
+{$else FPC_HAS_FEATURE_EXITCODE}
+  halt;
+{$endif FPC_HAS_FEATURE_EXITCODE}
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+end;
+
+
+{*****************************************************************************
+                       SetJmp/LongJmp support.
+*****************************************************************************}
+
+{$i setjump.inc}
+
+
+{$ifdef IOCheckWasOn}
+{$I+}
+{$endif}
+
+{$ifdef RangeCheckWasOn}
+{$R+}
+{$endif}
+
+{$ifdef OverflowCheckWasOn}
+{$Q+}
+{$endif}
+
+
+{*****************************************************************************
+                               Heap
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_HEAP}
+{$i sysheap.inc}
+
+{$i heap.inc}
+{$endif FPC_HAS_FEATURE_HEAP}
+
+{*****************************************************************************
+                          Thread support
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_THREADING}
+{ Generic threadmanager }
+{$i thread.inc}
+
+{ Generic threadvar support }
+{$i threadvr.inc}
+
+{$ifdef DISABLE_NO_THREAD_MANAGER}
+{ OS Dependent implementation }
+{$i systhrd.inc}
+{$endif DISABLE_NO_THREAD_MANAGER}
+{$endif FPC_HAS_FEATURE_THREADING}
+
+
+{*****************************************************************************
+                            File Handling
+*****************************************************************************}
+
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+{ Allow slash and backslash as separators }
+procedure DoDirSeparators(p:Pchar);
+var
+  i : longint;
+begin
+  for i:=0 to strlen(p) do
+    if p[i] in AllowDirectorySeparators then
+      p[i]:=DirectorySeparator;
+end;
+
+procedure DoDirSeparators(var p:shortstring);
+var
+  i : longint;
+begin
+  for i:=1 to length(p) do
+    if p[i] in AllowDirectorySeparators then
+      p[i]:=DirectorySeparator;
+end;
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+{ OS dependent low level file functions }
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+{$i sysfile.inc}
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+{ Text file }
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
+{$i text.inc}
+{$endif FPC_HAS_FEATURE_TEXTIO}
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+{ Untyped file }
+{$i file.inc}
+
+{ Typed file }
+{$i typefile.inc}
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+
+{*****************************************************************************
+                            Directory Handling
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+{ OS dependent dir functions }
+{$i sysdir.inc}
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+Procedure getdir(drivenr:byte;Var dir:ansistring);
+{ this is needed to also allow ansistrings, the shortstring version is
+  OS dependent }
+var
+  s : shortstring;
+begin
+  getdir(drivenr,s);
+  dir:=s;
+end;
+{$endif}
+
+{$if defined(FPC_HAS_FEATURE_FILEIO)}
+
+Procedure MkDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  MkDir(@buffer[0],length(s));
+End;
+
+Procedure RmDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  RmDir(@buffer[0],length(s));
+End;
+
+Procedure ChDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  ChDir(@buffer[0],length(s));
+End;
+{$endif}
+
+{*****************************************************************************
+                            Resources support
+*****************************************************************************}
+
+{$i sysres.inc}
+(*
+const
+  CtrlBreakHandler: TCtrlBreakHandler = nil;
+{$IFNDEF FPC_HAS_SETCTRLBREAKHANDLER}
+(* It is possible to provide platform specific implementation performing   *)
+(* special initialization; default implementation just sets the procedural *)
+(* variable to make it available for use from the exception handler.       *)
+function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
+begin
+  (* Return either nil or previous handler *)
+  SysSetCtrlBreakHandler := CtrlBreakHandler;
+  CtrlBreakHandler := Handler;
+end;
+{$ENDIF FPC_HAS_SETCTRLBREAKHANDLER}
+*)
+

rtl/java/jsystemh.inc

@@ -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}

rtl/java/jsystemh_types.inc

@@ -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}
+

rtl/java/objpas.inc

@@ -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;
+
+

rtl/java/objpash.inc

@@ -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}
+

rtl/java/rtl.cfg

@@ -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

rtl/java/sstringh.inc

@@ -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;
 

rtl/java/sstrings.inc

@@ -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}

rtl/java/sysos.inc

@@ -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;
+

rtl/java/sysosh.inc

@@ -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;

rtl/java/sysres.inc

@@ -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.
+
+ **********************************************************************
+}
+

rtl/java/system.pp

@@ -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,613 +67,50 @@ 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;
-
+{$i jdynarr.inc}
 
-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;
+{*****************************************************************************
+                       Misc. System Dependent Functions
+*****************************************************************************}
 
+procedure System_exit;
   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;
+    JLRuntime.getRuntime.exit(ExitCode);
   end;
 
 
-function fpc_dynarray_copy(src: JLObject; start, len: longint; ndim: longint; eletype: jchar): JLObject;
-  var
-    i: longint;
-    srclen: longint;
+procedure randomize;
   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;
+    randseed:=JUCalendar.getInstance.getTimeInMillis;
   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}
-
-
-
-{*****************************************************************************
-                       Misc. System Dependent Functions
-*****************************************************************************}
-
-  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;
-
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}

rtl/java/ustringh.inc

@@ -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;

rtl/java/jint64.inc → rtl/jvm/int64p.inc

@@ -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}
+

rtl/jvm/jvm.inc

@@ -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}
+