* the generic astrings.inc is now also used to the extent possible on

    the JVM target, and pos/insert/delete/val/str/uniquestring/setstring/
    stringofchar/... are now also available for ansistrings on the JVM
    target

git-svn-id: branches/jvmbackend@18906 -

.gitattributes

@@ -7355,9 +7355,9 @@ rtl/inc/wstrings.inc svneol=native#text/plain
 rtl/inc/wustrings.inc svneol=native#text/plain
 rtl/java/Makefile svneol=native#text/plain
 rtl/java/Makefile.fpc svneol=native#text/plain
-rtl/java/astringh.inc svneol=native#text/plain
-rtl/java/astrings.inc svneol=native#text/plain
 rtl/java/compproc.inc svneol=native#text/plain
+rtl/java/jastringh.inc svneol=native#text/plain
+rtl/java/jastrings.inc svneol=native#text/plain
 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/inc/astrings.inc

@@ -17,6 +17,8 @@
 { This will release some functions for special shortstring support }
 { define EXTRAANSISHORT}
 
+
+{$ifndef FPC_ANSISTRING_TYPE_DEFINED}
 {
   This file contains the implementation of the AnsiString type,
   and all things that are needed for it.
@@ -44,14 +46,23 @@ Type
 Const
   AnsiRecLen = SizeOf(TAnsiRec);
   FirstOff   = SizeOf(TAnsiRec)-1;
-
+{$define FPC_ANSISTRING_TYPE_DEFINED}
 
 {****************************************************************************
                     Internal functions, not in interface.
 ****************************************************************************}
 
+{$ifndef FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
+{$define FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
+procedure fpc_pchar_ansistr_intern_charmove(const src: pchar; const srcindex: byte; var dst: ansistring; const dstindex, len: byte); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  move(src[srcindex],pbyte(pointer(dst))[dstindex],len);
+end;
+{$endif FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
 
 
+{$ifndef FPC_HAS_NEWANSISTR}
+{$endif FPC_HAS_NEWANSISTR}
 Function NewAnsiString(Len : SizeInt) : Pointer;
 {
   Allocate a new AnsiString on the heap.
@@ -71,8 +82,11 @@ begin
    end;
   NewAnsiString:=P;
 end;
+{$endif FPC_HAS_NEWANSISTR}
 
 
+{$ifndef FPC_HAS_DISPOSE_ANSISTR}
+{$define FPC_HAS_DISPOSE_ANSISTR}
 Procedure DisposeAnsiString(Var S : Pointer); {$IFNDEF VER2_0} Inline; {$ENDIF}
 {
   Deallocates a AnsiString From the heap.
@@ -84,8 +98,11 @@ begin
   FreeMem (S);
   S:=Nil;
 end;
+{$endif FPC_HAS_DISPOSE_ANSISTR}
+
 
 {$ifndef FPC_SYSTEM_HAS_ANSISTR_DECR_REF}
+{$define FPC_SYSTEM_HAS_ANSISTR_DECR_REF}
 Procedure fpc_ansistr_decr_ref (Var S : Pointer); [Public,Alias:'FPC_ANSISTR_DECR_REF'];  compilerproc;
 {
   Decreases the ReferenceCount of a non constant ansistring;
@@ -106,12 +123,14 @@ Begin
     { Ref count dropped to zero }
     DisposeAnsiString (S);        { Remove...}
 end;
-
 {$endif FPC_SYSTEM_HAS_ANSISTR_DECR_REF}
 
 { also define alias for internal use in the system unit }
 Procedure fpc_ansistr_decr_ref (Var S : Pointer); [external name 'FPC_ANSISTR_DECR_REF'];
 
+
+{$ifndef FPC_SYSTEM_HAS_ANSISTR_INCR_REF}
+{$define FPC_SYSTEM_HAS_ANSISTR_INCR_REF}
 Procedure fpc_AnsiStr_Incr_Ref (S : Pointer); [Public,Alias:'FPC_ANSISTR_INCR_REF'];  compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
 Begin
   If S=Nil then
@@ -120,11 +139,14 @@ Begin
   If PAnsiRec(S-FirstOff)^.Ref<0 then exit;
   inclocked(PAnsiRec(S-FirstOff)^.Ref);
 end;
-
+{$endif FPC_SYSTEM_HAS_ANSISTR_DECR_REF}
 
 { also define alias which can be used inside the system unit }
 Procedure fpc_AnsiStr_Incr_Ref (S : Pointer); [external name 'FPC_ANSISTR_INCR_REF'];
 
+
+{$ifndef FPC_HAS_ANSISTR_ASSIGN}
+{$define FPC_HAS_ANSISTR_ASSIGN}
 Procedure fpc_AnsiStr_Assign (Var DestS : Pointer;S2 : Pointer);[Public,Alias:'FPC_ANSISTR_ASSIGN'];  compilerproc;
 {
   Assigns S2 to S1 (S1:=S2), taking in account reference counts.
@@ -140,12 +162,16 @@ begin
   { And finally, have DestS pointing to S2 (or its copy) }
   DestS:=S2;
 end;
+{$endif FPC_HAS_ANSISTR_ASSIGN}
+
 
 { alias for internal use }
 Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_ANSISTR_ASSIGN'];
 
 {$ifndef STR_CONCAT_PROCS}
 
+{$ifndef FPC_HAS_ANSISTR_CONCAT}
+{$define FPC_HAS_ANSISTR_CONCAT}
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
 Var
   Size,Location : SizeInt;
@@ -170,8 +196,11 @@ begin
   inc(pc,location);
   Move(S2[1],pc^,Size+1);
 end;
+{$endif FPC_HAS_ANSISTR_CONCAT}
 
 
+{$ifndef FPC_HAS_ANSISTR_CONCAT_MULTI}
+{$define FPC_HAS_ANSISTR_CONCAT_MULTI}
 function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
 Var
   i  : Longint;
@@ -197,9 +226,12 @@ begin
         end;
     end;
 end;
+{$endif FPC_HAS_ANSISTR_CONCAT_MULTI}
 
 {$else STR_CONCAT_PROCS}
 
+{$ifndef FPC_HAS_ANSISTR_CONCAT}
+{$define FPC_HAS_ANSISTR_CONCAT}
 procedure fpc_AnsiStr_Concat (var DestS:ansistring;const S1,S2 : AnsiString); compilerproc;
 Var
   Size,Location : SizeInt;
@@ -242,8 +274,11 @@ begin
       Move(Pointer(S2)^,(Pointer(DestS)+Location)^,Size+1);
     end;
 end;
+{$endif FPC_HAS_ANSISTR_CONCAT}
 
 
+{$ifndef FPC_HAS_ANSISTR_CONCAT_MULTI}
+{$define FPC_HAS_ANSISTR_CONCAT_MULTI}
 procedure fpc_AnsiStr_Concat_multi (var DestS:ansistring;const sarr:array of Ansistring); compilerproc;
 Var
   lowstart,i  : Longint;
@@ -302,7 +337,7 @@ begin
     end;
   fpc_AnsiStr_Decr_Ref(destcopy);
 end;
-
+{$endif FPC_HAS_ANSISTR_CONCAT_MULTI}
 
 {$endif STR_CONCAT_PROCS}
 
@@ -332,6 +367,8 @@ end;
 
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 
+{$ifndef FPC_HAS_ANSISTR_TO_SHORTSTR}
+{$define FPC_HAS_ANSISTR_TO_SHORTSTR}
 { the following declaration has exactly the same effect as                   }
 { procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);     }
 { which is what the old helper was, so we don't need an extra implementation }
@@ -354,9 +391,12 @@ begin
      byte(fpc_AnsiStr_To_ShortStr[0]):=byte(Size);
    end;
 end;
+{$endif FPC_HAS_ANSISTR_TO_SHORTSTR}
 
 {$else FPC_STRTOSHORTSTRINGPROC}
 
+{$ifndef FPC_HAS_ANSISTR_TO_SHORTSTR}
+{$define FPC_HAS_ANSISTR_TO_SHORTSTR}
 procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];  compilerproc;
 {
   Converts a AnsiString to a ShortString;
@@ -375,10 +415,13 @@ begin
      byte(res[0]):=byte(Size);
    end;
 end;
+{$endif FPC_HAS_ANSISTR_TO_SHORTSTR}
 
 {$endif FPC_STRTOSHORTSTRINGPROC}
 
 
+{$ifndef FPC_HAS_SHORTSTR_TO_ANSISTR}
+{$define FPC_HAS_SHORTSTR_TO_ANSISTR}
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 {
   Converts a ShortString to a AnsiString;
@@ -391,7 +434,11 @@ begin
   if Size>0 then
     Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
 end;
+{$endif FPC_HAS_SHORTSTR_TO_ANSISTR}
+
 
+{$ifndef FPC_HAS_CHAR_TO_ANSISTR}
+{$define FPC_HAS_CHAR_TO_ANSISTR}
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 {
   Converts a Char to a AnsiString;
@@ -402,8 +449,11 @@ begin
   { Terminating Zero }
   PByte(Pointer(fpc_Char_To_AnsiStr)+1)^:=0;
 end;
+{$endif FPC_HAS_CHAR_TO_ANSISTR}
 
 
+{$ifndef FPC_HAS_PCHAR_TO_ANSISTR}
+{$define FPC_HAS_PCHAR_TO_ANSISTR}
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 Var
   L : SizeInt;
@@ -416,9 +466,11 @@ begin
   if L > 0 then
     Move (P[0],Pointer(fpc_PChar_To_AnsiStr)^,L)
 end;
+{$endif FPC_HAS_PCHAR_TO_ANSISTR}
 
 
-
+{$ifndef FPC_HAS_CHARARRAY_TO_ANSISTR}
+{$define FPC_HAS_CHARARRAY_TO_ANSISTR}
 Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
 var
   i  : SizeInt;
@@ -440,9 +492,12 @@ begin
   if i > 0 then
     Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
 end;
+{$endif FPC_HAS_CHARARRAY_TO_ANSISTR}
 
 {$ifndef FPC_STRTOCHARARRAYPROC}
 
+{$ifndef FPC_HAS_ANSISTR_TO_CHARARRAY}
+{$define FPC_HAS_ANSISTR_TO_CHARARRAY}
 { note: inside the compiler, the resulttype is modified to be the length }
 { of the actual chararray to which we convert (JM)                       }
 function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; [public, alias: 'FPC_ANSISTR_TO_CHARARRAY']; compilerproc;
@@ -462,9 +517,12 @@ begin
 {$r+}
 {$endif}
 end;
+{$endif FPC_HAS_ANSISTR_TO_CHARARRAY}
 
 {$else ndef FPC_STRTOCHARARRAYPROC}
 
+{$ifndef FPC_HAS_ANSISTR_TO_CHARARRAY}
+{$define FPC_HAS_ANSISTR_TO_CHARARRAY}
 procedure  fpc_ansistr_to_chararray(out res: array of char; const src: ansistring); compilerproc;
 var
   len: SizeInt;
@@ -482,9 +540,12 @@ begin
 {$r+}
 {$endif}
 end;
+{$endif FPC_HAS_ANSISTR_TO_CHARARRAY}
 
 {$endif ndef FPC_STRTOCHARARRAYPROC}
 
+{$ifndef FPC_HAS_ANSISTR_COMPARE}
+{$define FPC_HAS_ANSISTR_COMPARE}
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE'];  compilerproc;
 {
   Compares 2 AnsiStrings;
@@ -514,7 +575,11 @@ begin
   else
     result:=Length(S1)-Length(S2);
 end;
+{$endif FPC_HAS_ANSISTR_COMPARE}
 
+
+{$ifndef FPC_HAS_ANSISTR_COMPARE_EQUAL}
+{$define FPC_HAS_ANSISTR_COMPARE_EQUAL}
 Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE_EQUAL'];  compilerproc;
 {
   Compares 2 AnsiStrings for equality/inequality only;
@@ -537,6 +602,7 @@ begin
     if MaxI>0 then
       result:=CompareByte(S1[1],S2[1],MaxI);
 end;
+{$endif FPC_HAS_ANSISTR_COMPARE_EQUAL}
 
 {$ifdef VER2_4}
 // obsolete but needed for boostrapping with 2.4
@@ -553,13 +619,19 @@ begin
 end;
 
 {$else VER2_4}
+{$ifndef FPC_HAS_ANSISTR_CHECKRANGE}
+{$define FPC_HAS_ANSISTR_CHECKRANGE}
 Procedure fpc_AnsiStr_CheckRange(p: Pointer; index: SizeInt);[Public,Alias : 'FPC_ANSISTR_RANGECHECK'];  compilerproc;
 begin
   if (p=nil) or (index>PAnsiRec(p-FirstOff)^.Len) or (Index<1) then
     HandleErrorFrame(201,get_frame);
 end;
+{$endif FPC_HAS_ANSISTR_CHECKRANGE}
 {$endif VER2_4}
 
+
+{$ifndef FPC_HAS_ANSISTR_SETLENGTH}
+{$define FPC_HAS_ANSISTR_SETLENGTH}
 Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt);[Public,Alias : 'FPC_ANSISTR_SETLENGTH'];  compilerproc;
 {
   Sets The length of string S to L.
@@ -618,6 +690,8 @@ begin
       Pointer(S):=Nil;
     end;
 end;
+{$endif FPC_HAS_ANSISTR_SETLENGTH}
+
 
 {$ifdef EXTRAANSISHORT}
 Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt;  compilerproc;
@@ -650,6 +724,8 @@ end;
                      Public functions, In interface.
 *****************************************************************************}
 
+{$ifndef FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
+{$define FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
 function fpc_truely_ansistr_unique(Var S : Pointer): Pointer;
 Var
   SNew : Pointer;
@@ -665,7 +741,6 @@ begin
 end;
 
 
-{$ifndef FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
 // MV: inline the basic checks for case that S is already unique.
 // Rest is too complex to inline, so factor that out as a call.
 Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
@@ -683,6 +758,8 @@ end;
 {$endif FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
 
 
+{$ifndef FPC_HAS_ANSISTR_APPEND_CHAR}
+{$define FPC_HAS_ANSISTR_APPEND_CHAR}
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : char); [Public,Alias : 'FPC_ANSISTR_APPEND_CHAR']; compilerproc;
 begin
   SetLength(S,length(S)+1);
@@ -690,7 +767,11 @@ begin
   PChar(Pointer(S)+length(S)-1)^:=c;
   PByte(Pointer(S)+length(S))^:=0; { Terminating Zero }
 end;
+{$endif FPC_HAS_ANSISTR_APPEND_CHAR}
+
 
+{$ifndef FPC_HAS_ANSISTR_APPEND_SHORTSTR}
+{$define FPC_HAS_ANSISTR_APPEND_SHORTSTR}
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); [Public,Alias : 'FPC_ANSISTR_APPEND_SHORTSTRING']; compilerproc;
 var
    ofs : SizeInt;
@@ -703,7 +784,11 @@ begin
    move(Str[1],(pointer(S)+ofs)^,length(Str));
    PByte(Pointer(S)+length(S))^:=0; { Terminating Zero }
 end;
+{$endif FPC_HAS_ANSISTR_APPEND_SHORTSTR}
+
 
+{$ifndef FPC_HAS_ANSISTR_APPEND_ANSISTR}
+{$define FPC_HAS_ANSISTR_APPEND_ANSISTR}
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); [Public,Alias : 'FPC_ANSISTR_APPEND_ANSISTRING']; compilerproc;
 var
    ofs, strlength: SizeInt;
@@ -723,7 +808,11 @@ begin
      { the setlength may have relocated the string, so str may no longer be valid }
      move(S[1],(pointer(S)+ofs)^,strlength+1)
 end;
+{$endif FPC_HAS_ANSISTR_APPEND_ANSISTR}
 
+
+{$ifndef FPC_HAS_ANSISTR_COPY}
+{$define FPC_HAS_ANSISTR_COPY}
 Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
 var
   ResultAddress : Pointer;
@@ -752,7 +841,11 @@ begin
    fpc_ansistr_decr_ref(Pointer(fpc_ansistr_copy));
   Pointer(fpc_ansistr_Copy):=ResultAddress;
 end;
+{$endif FPC_HAS_ANSISTR_COPY}
+
 
+{$ifndef FPC_HAS_POS_SHORTSTR_ANSISTR}
+{$define FPC_HAS_POS_SHORTSTR_ANSISTR}
 Function Pos (Const Substr : ShortString; Const Source : AnsiString) : SizeInt;
 
 var
@@ -778,8 +871,11 @@ begin
       end;
    end;
 end;
+{$endif FPC_HAS_POS_SHORTSTR_ANSISTR}
 
 
+{$ifndef FPC_HAS_POS_ANSISTR_ANSISTR}
+{$define FPC_HAS_POS_ANSISTR_ANSISTR}
 Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt;
 var
   i,MaxLen : SizeInt;
@@ -804,8 +900,11 @@ begin
       end;
    end;
 end;
+{$endif FPC_HAS_POS_ANSISTR_ANSISTR}
 
 
+{$ifndef FPC_HAS_POS_ANSICHAR_ANSISTR}
+{$define FPC_HAS_POS_ANSICHAR_ANSISTR}
 { Faster version for a char alone. Must be implemented because   }
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
@@ -827,6 +926,7 @@ begin
    end;
   pos:=0;
 end;
+{$endif FPC_HAS_POS_ANSICHAR_ANSISTR}
 
 
 {$ifndef FPUNONE}
@@ -937,6 +1037,8 @@ begin
 end;
 {$endif}
 
+
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring);[public,alias:'FPC_ANSISTR_ENUM'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
 
 var ss:shortstring;
@@ -945,6 +1047,7 @@ begin
   fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
   s:=ss;
 end;
+{$endif FPC_STR_ENUM_INTERN}
 
 
 procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring);[public,alias:'FPC_ANSISTR_BOOL'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
@@ -956,11 +1059,13 @@ begin
 end;
 
 
+{$ifndef FPC_STR_ENUM_INTERN}
 function fpc_val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_ANSISTR']; compilerproc;
 
 begin
   fpc_val_enum_ansistr:=fpc_val_enum_shortstr(str2ordindex,s,code);
 end;
+{$endif FPC_STR_ENUM_INTERN}
 
 
 {$ifdef FPC_HAS_STR_CURRENCY}
@@ -1025,7 +1130,7 @@ begin
   If (Size<=LS-Index) then
     begin
       Dec(Index);
-      Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index-Size+1);
+      fpc_pchar_ansistr_intern_charmove(pchar(S),Index+Size,S,Index,LS-Index-Size+1);
     end;
   Setlength(S,LS-Size);
 end;
@@ -1044,30 +1149,34 @@ begin
   if index > LS then
    index := LS+1;
   Dec(Index);
-  Pointer(Temp) := NewAnsiString(Length(Source)+LS);
   SetLength(Temp,Length(Source)+LS);
   If Index>0 then
-    move (Pointer(S)^,Pointer(Temp)^,Index);
-  Move (Pointer(Source)^,PByte(Temp)[Index],Length(Source));
+    fpc_pchar_ansistr_intern_charmove(pchar(S),0,Temp,0,Index);
+  fpc_pchar_ansistr_intern_charmove(pchar(Source),0,Temp,Index,Length(Source));
   If (LS-Index)>0 then
-    Move(PByte(Pointer(S))[Index],PByte(temp)[Length(Source)+index],LS-Index);
+    fpc_pchar_ansistr_intern_charmove(pchar(S),Index,Temp,Length(Source)+Index,LS-Index);
   S:=Temp;
 end;
 
 
+{$ifndef FPC_HAS_ANSISTR_OF_CHAR}
+{$define FPC_HAS_ANSISTR_OF_CHAR}
 Function StringOfChar(c : char;l : SizeInt) : AnsiString;
 begin
   SetLength(StringOfChar,l);
   FillChar(Pointer(StringOfChar)^,Length(StringOfChar),c);
 end;
+{$endif FPC_HAS_ANSISTR_OF_CHAR}
+
 
 Procedure SetString (Out S : AnsiString; Buf : PChar; Len : SizeInt); {$IFNDEF VER2_0} Inline; {$ENDIF}
 begin
   SetLength(S,Len);
   If (Buf<>Nil) then
-    Move (Buf^,Pointer(S)^,Len);
+    fpc_pchar_ansistr_intern_charmove(Buf,0,S,0,Len);
 end;
 
+
 Procedure SetString (Out S : AnsiString; Buf : PWideChar; Len : SizeInt);
 begin
   if (Buf<>nil) and (Len>0) then
@@ -1076,6 +1185,9 @@ begin
     SetLength(S, Len);
 end;
 
+
+{$ifndef FPC_HAS_UPCASE_ANSISTR}
+{$define FPC_HAS_UPCASE_ANSISTR}
 function upcase(const s : ansistring) : ansistring;
 var
   i : SizeInt;
@@ -1084,8 +1196,11 @@ begin
   for i := 1 to length (s) do
     result[i] := upcase(s[i]);
 end;
+{$endif FPC_HAS_UPCASE_ANSISTR}
 
 
+{$ifndef FPC_HAS_LOWERCASE_ANSISTR}
+{$define FPC_HAS_LOWERCASE_ANSISTR}
 function lowercase(const s : ansistring) : ansistring;
 var
   i : SizeInt;
@@ -1094,3 +1209,4 @@ begin
   for i := 1 to length (s) do
     result[i] := lowercase(s[i]);
 end;
+{$endif FPC_HAS_LOWERCASE_ANSISTR}

rtl/java/astringh.inc

@@ -1,91 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2005,2011 by Florian Klaempfl and Jonas Maebe,
-    members of the Free Pascal development team.
-
-    This file implements support routines for AnsiStrings with FPC/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.
-
- **********************************************************************}
-
-type
-  AnsistringClass = class sealed (JLObject)
-   private
-    fdata: TAnsiCharArray;
-   public
-    constructor Create(const arr: array of ansichar; length: longint);overload;
-    constructor Create(const arr: array of unicodechar);overload;
-    constructor Create(const u: unicodestring);overload;
-    constructor Create(const a: ansistring);overload;
-    constructor Create(const s: shortstring);overload;
-    constructor Create(ch: ansichar);overload;
-    constructor Create(ch: unicodechar);overload;
-    class function CreateFromLiteralStringBytes(const u: unicodestring): ansistring; static;
-    function charAt(index: jint): ansichar;
-    function toUnicodeString: unicodestring;
-    function toShortstring(maxlen: byte): shortstring;
-    function toString: JLString; override;
-//    function concat(const a: ansistring): ansistring;
-//    function concatmultiple(const arr: array of ansistring): ansistring;
-    function length: jint;
-    property internChars: TAnsiCharArray read fdata;
-  end;
-
-Function Pos (Const Substr : Ansistring; Const Source : Ansistring) : SizeInt;
-Function Pos (c : AnsiChar; Const s : Ansistring) : SizeInt;
-//Function Pos (c : AnsiString; Const s : UnicodeString) : SizeInt;
-//Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;
-//Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;
-
-Function UpCase(const s : Ansistring) : Ansistring;
-//Function UpCase(c:UnicodeChar):UnicodeChar;
-
-//Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt);
-//Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);
-//Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
-//Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
-//
-//function WideCharToString(S : PWideChar) : AnsiString;
-//function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
-//function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
-//procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
-//procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
-//
-//function UnicodeCharToString(S : PUnicodeChar) : AnsiString;
-//function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
-//function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : AnsiString;
-//procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
-//procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
-//
-//procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
-//procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
-
-//function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
-//function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
-//function UTF8Encode(const s : Ansistring) : UTF8String; inline;
-//function UTF8Encode(const s : UnicodeString) : UTF8String;
-//function UTF8Decode(const s : UTF8String): UnicodeString;
-//function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
-//function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
-//function WideStringToUCS4String(const s : WideString) : UCS4String;
-//function UCS4StringToWideString(const s : UCS4String) : WideString;
-
-//Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
-//Procedure SetWideStringManager (Const New : TUnicodeStringManager);
-//Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
-
-//Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
-//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
-//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
-
-

rtl/java/compproc.inc

@@ -74,7 +74,6 @@ procedure fpc_ShortStr_Currency({$ifdef cpujvm}constref{$endif} c : currency; le
 
 procedure fpc_chararray_sint(v : valsint;len : SizeInt;out a : array of AnsiChar); compilerproc;
 procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of AnsiChar); compilerproc;
-(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
 procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compilerproc;
@@ -89,7 +88,6 @@ procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring); compilerpr
 procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
 {$endif FPC_HAS_STR_CURRENCY}
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
-*)
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
   {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
@@ -106,12 +104,10 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
   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}
   procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : ansistring); compilerproc;
   procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : ansistring); compilerproc;
   {$endif FPC_HAS_FEATURE_ANSISTRINGS}
-  *)
 
   {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
     {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
@@ -173,7 +169,6 @@ function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code
 {$endif FPC_STR_ENUM_INTERN}
 Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; compilerproc;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-(*
 {$ifndef FPUNONE}
 Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
 {$endif}
@@ -183,7 +178,6 @@ Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Cur
 {$ifndef FPC_STR_ENUM_INTERN}
 function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc;
 {$endif}
-*)
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@@ -199,7 +193,6 @@ function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:v
   Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; compilerproc;
   {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
   {$ifndef VER2_2}
-  (*
   {$ifndef FPUNONE}
   Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc;
   {$endif}
@@ -209,14 +202,12 @@ function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:v
   function fpc_val_Enum_UnicodeStr(str2ordindex:pointer;const s:UnicodeString;out code:valsint):longint;compilerproc;
   {$endif FPC_STR_ENUM_INTERN}
   Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; compilerproc;
-*)
   {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifndef CPU64}
 Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; compilerproc;
 Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord; compilerproc;
-(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword;compilerproc;
 Function fpc_Val_int64_AnsiStr (Const S : AnsiString; out Code : ValSInt): Int64; compilerproc;
@@ -232,31 +223,26 @@ Function fpc_Val_qword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt):
 Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Int64; compilerproc;
 {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
-*)
 
 {$endif CPU64}
 
-(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+(*
 Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
 Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
 *)
 {$ifndef nounsupported}
 //Procedure fpc_AnsiStr_Assign (Var DestS : jlobject;S2 : jlobject); compilerproc;
 {$endif}
-(*
-{$ifdef STR_CONCAT_PROCS}
-Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc;
+//{$ifdef STR_CONCAT_PROCS}
+//Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc;
 Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc;
-{$else STR_CONCAT_PROCS}
-*)
-{$ifndef nounsupported}
+//{$else STR_CONCAT_PROCS}
+//{$ifndef nounsupported}
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
-{$endif}
-(*
-function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
-{$endif STR_CONCAT_PROCS}
-*)
+//{$endif}
+//function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
+//{$endif STR_CONCAT_PROCS}
 {$ifndef nounsupported}
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : AnsiChar); compilerproc;
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
@@ -296,10 +282,8 @@ Function  fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiSt
 { pointer argument because otherwise when calling this, we get
   an endless loop since a 'var s: ansistring' must be made
   unique as well                                               }
-//Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
-(*
+Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
-*)
 {*****************************************************************************
                         Unicode string support
 *****************************************************************************}

rtl/java/jastringh.inc

@@ -0,0 +1,42 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005,2011 by Florian Klaempfl and Jonas Maebe,
+    members of the Free Pascal development team.
+
+    This file implements support routines for AnsiStrings with FPC/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.
+
+ **********************************************************************}
+
+{$define FPC_ANSISTRING_TYPE_DEFINED}
+type
+  AnsistringClass = class sealed (JLObject)
+   private
+    fdata: TAnsiCharArray;
+   public
+    constructor Create(len: longint);overload;
+    constructor Create(const arr: array of ansichar; length: longint);overload;
+    constructor Create(const arr: array of unicodechar);overload;
+    constructor Create(const u: unicodestring);overload;
+    constructor Create(const a: ansistring);overload;
+    constructor Create(const s: shortstring);overload;
+    constructor Create(ch: ansichar);overload;
+    constructor Create(ch: unicodechar);overload;
+    class function CreateFromLiteralStringBytes(const u: unicodestring): ansistring; static;
+    function charAt(index: jint): ansichar;
+    function toUnicodeString: unicodestring;
+    function toShortstring(maxlen: byte): shortstring;
+    function toString: JLString; override;
+//    function concat(const a: ansistring): ansistring;
+//    function concatmultiple(const arr: array of ansistring): ansistring;
+    function length: jint;
+    property internChars: TAnsiCharArray read fdata;
+  end;
+
+

rtl/java/astrings.inc → rtl/java/jastrings.inc

@@ -17,6 +17,12 @@
 { This will release some functions for special shortstring support }
 { define EXTRAANSISHORT}
 
+constructor AnsistringClass.Create(len: longint);
+begin
+  { +1 for terminating #0 }
+  setlength(fdata,len+1);
+end;
+
 constructor AnsistringClass.Create(const arr: array of ansichar; length: longint);
 begin
   { make explicit copy so that changing the array afterwards doesn't change
@@ -177,6 +183,32 @@ end;
                     Internal functions, not in interface.
 ****************************************************************************}
 
+{$ifndef FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
+{$define FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
+procedure fpc_pchar_ansistr_intern_charmove(const src: pchar; const srcindex: byte; var dst: ansistring; const dstindex, len: byte); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  JLSystem.arraycopy(JLObject(src),srcindex,JLObject(AnsistringClass(dst).fdata),dstindex,len);
+end;
+{$endif FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
+
+
+{$define FPC_HAS_NEWANSISTR}
+Function NewAnsiString(Len : SizeInt) : Pointer;
+{
+  Allocate a new AnsiString on the heap.
+  initialize it to zero length and reference count 1.
+}
+begin
+  result:=AnsistringClass.Create(len);
+end;
+
+{ not required }
+{$define FPC_HAS_DISPOSE_ANSISTR}
+{$define FPC_SYSTEM_HAS_ANSISTR_DECR_REF}
+{$define FPC_SYSTEM_HAS_ANSISTR_INCR_REF}
+{$define FPC_HAS_ANSISTR_ASSIGN}
+
+{$define FPC_HAS_ANSISTR_CONCAT}
 function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
 var
   newdata: array of ansichar;
@@ -195,6 +227,7 @@ begin
 end;
 
 
+{$define FPC_HAS_ANSISTR_CONCAT_MULTI}
 procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ansistring); compilerproc;
   Var
     i  : longint;
@@ -226,6 +259,7 @@ procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ans
 end;
 
 
+{$define FPC_HAS_ANSISTR_TO_SHORTSTR}
 procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring); compilerproc;
 {
   Converts a AnsiString to a ShortString;
@@ -246,6 +280,7 @@ begin
 end;
 
 
+{$define FPC_HAS_SHORTSTR_TO_ANSISTR}
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 {
   Converts a ShortString to a AnsiString;
@@ -260,6 +295,7 @@ begin
 end;
 
 
+{$define FPC_HAS_CHAR_TO_ANSISTR}
 Function fpc_Char_To_AnsiStr(const c : AnsiChar): AnsiString; compilerproc;
 {
   Converts a Char to a AnsiString;
@@ -269,6 +305,7 @@ begin
 end;
 
 
+{$define FPC_HAS_PCHAR_TO_ANSISTR}
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 var
   i, len: longint;
@@ -285,6 +322,7 @@ begin
 end;
 
 
+{$define FPC_HAS_CHARARRAY_TO_ANSISTR}
 Function fpc_CharArray_To_AnsiStr(const arr: array of ansichar; zerobased: boolean = true): ansistring; compilerproc;
 var
   i,j  : SizeInt;
@@ -326,6 +364,8 @@ begin
   result:=Ansistring(res);
 end;
 
+
+{$define FPC_HAS_ANSISTR_TO_CHARARRAY}
 procedure fpc_ansistr_to_chararray(out res: array of ansichar; const src: ansistring); compilerproc;
 var
   len: longint;
@@ -351,6 +391,7 @@ begin
 end;
 
 
+{$define FPC_HAS_ANSISTR_COMPARE}
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;  compilerproc;
 {
   Compares 2 AnsiStrings;
@@ -385,6 +426,8 @@ begin
     result:=Length(S1)-Length(S2);
 end;
 
+
+{$define FPC_HAS_ANSISTR_COMPARE_EQUAL}
 Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
 {
   Compares 2 AnsiStrings for equality/inequality only;
@@ -404,7 +447,11 @@ begin
 end;
 
 
+{ not required, the JVM does the range checking for us }
+{$define FPC_HAS_ANSISTR_CHECKRANGE}
+
 
+{$define FPC_HAS_ANSISTR_SETLENGTH}
 function fpc_AnsiStr_SetLength (S : AnsiString; l : SizeInt): Ansistring; compilerproc;
 {
   Sets The length of string S to L.
@@ -424,41 +471,22 @@ end;
 {*****************************************************************************
                      Public functions, In interface.
 *****************************************************************************}
-(*
-function fpc_truely_ansistr_unique(Var S : Pointer): Pointer;
-Var
-  SNew : Pointer;
-  L    : SizeInt;
+
+{ can't implement reference counting since no control over what javacc-compiled
+  code does with ansistrings -> always create a copy }
+{$define FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
+procedure FPC_ANSISTR_UNIQUE(var s: AnsiString); inline;
 begin
-  L:=PAnsiRec(Pointer(S)-FirstOff)^.len;
-  SNew:=NewAnsiString (L);
-  Move (Pointer(S)^,SNew^,L+1);
-  PAnsiRec(SNew-FirstOff)^.len:=L;
-  fpc_ansistr_decr_ref (Pointer(S));  { Thread safe }
-  pointer(S):=SNew;
-  pointer(result):=SNew;
+  s:=ansistring(AnsistringClass.Create(s));
 end;
-*)
 
-(*
-{$ifndef FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
-// MV: inline the basic checks for case that S is already unique.
-// Rest is too complex to inline, so factor that out as a call.
 Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
-{
-  Make sure reference count of S is 1,
-  using copy-on-write semantics.
-}
 begin
-  pointer(result) := pointer(s);
-  If Pointer(S)=Nil then
-    exit;
-  if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
-    result:=fpc_truely_ansistr_unique(s);
+  s:=AnsistringClass.Create(ansistring(s));
+  result:=s;
 end;
-{$endif FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
-*)
 
+{$define FPC_HAS_ANSISTR_APPEND_CHAR}
 Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc;
 var
   curlen: sizeint;
@@ -468,6 +496,8 @@ begin
   AnsistringClass(s).fdata[curlen]:=c;
 end;
 
+
+{$define FPC_HAS_ANSISTR_APPEND_SHORTSTR}
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
 var
    ofs : SizeInt;
@@ -480,6 +510,8 @@ begin
    JLSystem.ArrayCopy(JLObject(ShortstringClass(@Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
 end;
 
+
+{$define FPC_HAS_ANSISTR_APPEND_ANSISTR}
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
 var
   ofs, strlength: longint;
@@ -494,6 +526,8 @@ begin
    JLSystem.ArrayCopy(JLObject(AnsistringClass(Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,strlength);
 end;
 
+
+{$define FPC_HAS_ANSISTR_COPY}
 Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
 var
   res: AnsistringClass;
@@ -517,33 +551,40 @@ begin
   { default function result is empty string }
 end;
 
-(*
+
+{$define FPC_HAS_POS_SHORTSTR_ANSISTR}
 Function Pos (Const Substr : ShortString; Const Source : AnsiString) : SizeInt;
 var
-  i,MaxLen : SizeInt;
-  pc : pchar;
+  i,j,k,MaxLen, SubstrLen : SizeInt;
 begin
   Pos:=0;
-  if Length(SubStr)>0 then
+  SubstrLen:=Length(SubStr);
+  if SubstrLen>0 then
    begin
      MaxLen:=Length(source)-Length(SubStr);
      i:=0;
-     pc:=@source[1];
      while (i<=MaxLen) do
       begin
         inc(i);
-        if (SubStr[1]=pc^) and
-           (CompareByte(Substr[1],pc^,Length(SubStr))=0) then
+        j:=0;
+        k:=i-1;
+        while (j<SubstrLen) and
+              (ShortStringClass(@SubStr).fdata[j]=AnsistringClass(Source).fdata[k]) do
+          begin
+            inc(j);
+            inc(k);
+          end;
+        if (j=SubstrLen) then
          begin
            Pos:=i;
            exit;
          end;
-        inc(pc);
       end;
    end;
 end;
-*)
 
+
+{$define FPC_HAS_POS_ANSISTR_ANSISTR}
 Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt;
 var
   i,j,k,MaxLen, SubstrLen : SizeInt;
@@ -575,6 +616,7 @@ begin
 end;
 
 
+{$define FPC_HAS_POS_ANSICHAR_ANSISTR}
 { Faster version for a char alone. Must be implemented because   }
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
@@ -594,254 +636,16 @@ begin
   pos:=0;
 end;
 
-(*
-{$ifndef FPUNONE}
-Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; compilerproc;
-Var
-  SS : String;
-begin
-  fpc_Val_Real_AnsiStr := 0;
-  if length(S) > 255 then
-    code := 256
-  else
-    begin
-      SS := S;
-      Val(SS,fpc_Val_Real_AnsiStr,code);
-    end;
-end;
-{$endif}
-
-
-Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_ANSISTR']; compilerproc;
-Var
-  SS : String;
-begin
-  if length(S) > 255 then
-    begin
-      fpc_Val_Currency_AnsiStr := 0;
-      code := 256;
-    end
-  else
-    begin
-      SS := S;
-      Val(SS,fpc_Val_Currency_AnsiStr,code);
-    end;
-end;
-
-
-Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_ANSISTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_UInt_AnsiStr := 0;
-  if length(S) > 255 then
-    code := 256
-  else
-    begin
-      SS := S;
-      Val(SS,fpc_Val_UInt_AnsiStr,code);
-    end;
-end;
-
-
-Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_ANSISTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_SInt_AnsiStr:=0;
-  if length(S)>255 then
-    code:=256
-  else
-    begin
-       SS := S;
-       fpc_Val_SInt_AnsiStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
-    end;
-end;
-
-
-{$ifndef CPU64}
-
-Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_ANSISTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_qword_AnsiStr:=0;
-  if length(S)>255 then
-    code:=256
-  else
-    begin
-       SS := S;
-       Val(SS,fpc_Val_qword_AnsiStr,Code);
-    end;
-end;
-
-
-Function fpc_Val_int64_AnsiStr (Const S : AnsiString; out Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_ANSISTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_int64_AnsiStr:=0;
-  if length(S)>255 then
-    code:=256
-  else
-    begin
-       SS := s;
-       Val(SS,fpc_Val_int64_AnsiStr,Code);
-    end;
-end;
-
-{$endif CPU64}
-
-
-{$ifndef FPUNONE}
-procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-var
-  ss: ShortString;
-begin
-  str_real(len,fr,d,treal_type(rt),ss);
-  s:=ss;
-end;
-{$endif}
-
-procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring);[public,alias:'FPC_ANSISTR_ENUM'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-
-var ss:shortstring;
-
-begin
-  fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
-  s:=ss;
-end;
-
-
-procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring);[public,alias:'FPC_ANSISTR_BOOL'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-var
-  ss:shortstring;
-begin
-  fpc_shortstr_bool(b,len,ss);
-  s:=ss;
-end;
-
-
-function fpc_val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_ANSISTR']; compilerproc;
-
-begin
-  fpc_val_enum_ansistr:=fpc_val_enum_shortstr(str2ordindex,s,code);
-end;
-
-
-{$ifdef FPC_HAS_STR_CURRENCY}
-procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_CURRENCY']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-var
-  ss: ShortString;
-begin
-  str(c:len:fr,ss);
-  s:=ss;
-end;
-{$endif FPC_HAS_STR_CURRENCY}
-
-Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-Var
-  SS : ShortString;
-begin
-  str(v:Len,SS);
-  S:=SS;
-end;
-
-
-
-Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALSINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-Var
-  SS : ShortString;
-begin
-  str (v:Len,SS);
-  S:=SS;
-end;
-
-
-{$ifndef CPU64}
-
-Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_QWORD']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-Var
-  SS : ShortString;
-begin
-  str(v:Len,SS);
-  S:=SS;
-end;
-
-Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_INT64']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
-Var
-  SS : ShortString;
-begin
-  str (v:Len,SS);
-  S:=SS;
-end;
-
-{$endif CPU64}
-
-Procedure Delete (Var S : AnsiString; Index,Size: SizeInt);
-Var
-  LS : SizeInt;
-begin
-  ls:=Length(S);
-  If (Index>LS) or (Index<=0) or (Size<=0) then
-    exit;
-  UniqueString (S);
-  If (Size>LS-Index) then   // Size+Index gives overflow ??
-     Size:=LS-Index+1;
-  If (Size<=LS-Index) then
-    begin
-      Dec(Index);
-      Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index-Size+1);
-    end;
-  Setlength(S,LS-Size);
-end;
-
-
-Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : SizeInt);
-var
-  Temp : AnsiString;
-  LS : SizeInt;
-begin
-  If Length(Source)=0 then
-   exit;
-  if index <= 0 then
-   index := 1;
-  Ls:=Length(S);
-  if index > LS then
-   index := LS+1;
-  Dec(Index);
-  Pointer(Temp) := NewAnsiString(Length(Source)+LS);
-  SetLength(Temp,Length(Source)+LS);
-  If Index>0 then
-    move (Pointer(S)^,Pointer(Temp)^,Index);
-  Move (Pointer(Source)^,PByte(Temp)[Index],Length(Source));
-  If (LS-Index)>0 then
-    Move(PByte(Pointer(S))[Index],PByte(temp)[Length(Source)+index],LS-Index);
-  S:=Temp;
-end;
-
 
+{$define FPC_HAS_ANSISTR_OF_CHAR}
 Function StringOfChar(c : char;l : SizeInt) : AnsiString;
 begin
   SetLength(StringOfChar,l);
-  FillChar(Pointer(StringOfChar)^,Length(StringOfChar),c);
-end;
-Procedure SetString (Out S : AnsiString; Buf : PChar; Len : SizeInt); {$IFNDEF VER2_0} Inline; {$ENDIF}
-begin
-  SetLength(S,Len);
-  If (Buf<>Nil) then
-    Move (Buf^,Pointer(S)^,Len);
+  FillChar(AnsistringClass(result).fdata,l,c);
 end;
 
-Procedure SetString (Out S : AnsiString; Buf : PWideChar; Len : SizeInt);
-begin
-  if (Buf<>nil) and (Len>0) then
-    widestringmanager.Wide2AnsiMoveProc(Buf,S,Len)
-  else
-    SetLength(S, Len);
-end;
-*)
 
+{$define FPC_HAS_UPCASE_ANSISTR}
 function upcase(const s : ansistring) : ansistring;
 var
   u : unicodestring;
@@ -851,6 +655,7 @@ begin
 end;
 
 
+{$define FPC_HAS_LOWERCASE_ANSISTR}
 function lowercase(const s : ansistring) : ansistring;
 var
   u : unicodestring;

rtl/java/jsystemh.inc

@@ -421,14 +421,13 @@ Function  hexStr(Val:Pointer):shortstring;
 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;*)
+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;
@@ -439,7 +438,6 @@ 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

rtl/java/system.pp

@@ -92,7 +92,7 @@ const
 {$i jtvarh.inc}
 {$i jsstringh.inc}
 {$i jdynarrh.inc}
-{$i astringh.inc}
+{$i jastringh.inc}
 {$i justringh.inc}
 
 {$i jsystemh.inc}
@@ -112,6 +112,7 @@ function min(a,b : longint) : longint;
 
 {$i jtvar.inc}
 {$i jsstrings.inc}
+{$i jastrings.inc}
 {$i justrings.inc}
 {$i jrec.inc}
 {$i jset.inc}

tests/test/jvm/tstr.pp

@@ -202,7 +202,6 @@ begin
   check('8589934592');
 end;
 
-(*
 procedure test_ansistr;
 type
   tlocalstring = ansistring;
@@ -386,7 +385,6 @@ begin
   str(q:3,s);
   check('8589934592');
 end;
-*)
 
 {$ifdef haswidestring}
 procedure test_widestr;
@@ -575,7 +573,7 @@ end;
 
 begin
   test_shortstr;
-//  test_ansistr;
+  test_ansistr;
 {$ifdef haswidestring}
   test_widestr;
 {$endif haswidestring}