paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 16:09:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2011-08-29 22:59:03 +00:00
parent 6a7ff1cf75
commit 5496436349
9 changed files with 270 additions and 417 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

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

140
rtl/inc/astrings.inc
View File

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

91
rtl/java/astringh.inc
View File

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

34
rtl/java/compproc.inc
View File

@ -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_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; procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of AnsiChar); compilerproc;
(*
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc; procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
procedure fpc_AnsiStr_uint(v : valuint;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; procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
{$endif FPC_HAS_STR_CURRENCY} {$endif FPC_HAS_STR_CURRENCY}
{$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
*)
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)} {$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_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_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; procedure fpc_chararray_int64(v : int64;len : SizeInt;out a : array of AnsiChar); compilerproc;
(*
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : ansistring); compilerproc; procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : ansistring); compilerproc;
procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : ansistring); compilerproc; procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : ansistring); compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
*)
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)} {$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} {$endif FPC_STR_ENUM_INTERN}
Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; compilerproc; Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
(*
{$ifndef FPUNONE} {$ifndef FPUNONE}
Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc; Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
{$endif} {$endif}
@ -183,7 +178,6 @@ Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Cur
{$ifndef FPC_STR_ENUM_INTERN} {$ifndef FPC_STR_ENUM_INTERN}
function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc; function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc;
{$endif} {$endif}
*)
{$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$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; Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; compilerproc;
{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)} {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef VER2_2} {$ifndef VER2_2}
(*
{$ifndef FPUNONE} {$ifndef FPUNONE}
Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc; Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc;
{$endif} {$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; function fpc_val_Enum_UnicodeStr(str2ordindex:pointer;const s:UnicodeString;out code:valsint):longint;compilerproc;
{$endif FPC_STR_ENUM_INTERN} {$endif FPC_STR_ENUM_INTERN}
Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; compilerproc; Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; compilerproc;
*)
{$endif VER2_2} {$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef CPU64} {$ifndef CPU64}
Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; compilerproc; 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; Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord; compilerproc;
(*
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword;compilerproc; 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; 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; Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Int64; compilerproc;
{$endif VER2_2} {$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
*)
{$endif CPU64} {$endif CPU64}
(*
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
(*
Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc; Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc; Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
*) *)
{$ifndef nounsupported} {$ifndef nounsupported}
//Procedure fpc_AnsiStr_Assign (Var DestS : jlobject;S2 : jlobject); compilerproc; //Procedure fpc_AnsiStr_Assign (Var DestS : jlobject;S2 : jlobject); compilerproc;
{$endif} {$endif}
(* //{$ifdef STR_CONCAT_PROCS}
{$ifdef STR_CONCAT_PROCS} //Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc;
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; Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc;
{$else STR_CONCAT_PROCS} //{$else STR_CONCAT_PROCS}
*) //{$ifndef nounsupported}
{$ifndef nounsupported}
function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc; function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
{$endif} //{$endif}
(* //function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc; //{$endif STR_CONCAT_PROCS}
{$endif STR_CONCAT_PROCS}
*)
{$ifndef nounsupported} {$ifndef nounsupported}
Procedure fpc_ansistr_append_char(Var S : AnsiString;c : AnsiChar); compilerproc; Procedure fpc_ansistr_append_char(Var S : AnsiString;c : AnsiChar); compilerproc;
Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); 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 { pointer argument because otherwise when calling this, we get
an endless loop since a 'var s: ansistring' must be made an endless loop since a 'var s: ansistring' must be made
unique as well } 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} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
*)
{***************************************************************************** {*****************************************************************************
Unicode string support Unicode string support
*****************************************************************************} *****************************************************************************}

42
rtl/java/jastringh.inc Normal file
View File

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

365
rtl/java/astrings.inc → rtl/java/jastrings.inc
View File

@ -17,6 +17,12 @@
{ This will release some functions for special shortstring support } { This will release some functions for special shortstring support }
{ define EXTRAANSISHORT} { 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); constructor AnsistringClass.Create(const arr: array of ansichar; length: longint);
begin begin
{ make explicit copy so that changing the array afterwards doesn't change { make explicit copy so that changing the array afterwards doesn't change
@ -177,6 +183,32 @@ end;
Internal functions, not in interface. 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; function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
var var
newdata: array of ansichar; newdata: array of ansichar;
@ -195,6 +227,7 @@ begin
end; end;
{$define FPC_HAS_ANSISTR_CONCAT_MULTI}
procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ansistring); compilerproc; procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ansistring); compilerproc;
Var Var
i : longint; i : longint;
@ -226,6 +259,7 @@ procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ans
end; end;
{$define FPC_HAS_ANSISTR_TO_SHORTSTR}
procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring); compilerproc; procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring); compilerproc;
{ {
Converts a AnsiString to a ShortString; Converts a AnsiString to a ShortString;
@ -246,6 +280,7 @@ begin
end; end;
{$define FPC_HAS_SHORTSTR_TO_ANSISTR}
Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc; Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
{ {
Converts a ShortString to a AnsiString; Converts a ShortString to a AnsiString;
@ -260,6 +295,7 @@ begin
end; end;
{$define FPC_HAS_CHAR_TO_ANSISTR}
Function fpc_Char_To_AnsiStr(const c : AnsiChar): AnsiString; compilerproc; Function fpc_Char_To_AnsiStr(const c : AnsiChar): AnsiString; compilerproc;
{ {
Converts a Char to a AnsiString; Converts a Char to a AnsiString;
@ -269,6 +305,7 @@ begin
end; end;
{$define FPC_HAS_PCHAR_TO_ANSISTR}
Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc; Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
var var
i, len: longint; i, len: longint;
@ -285,6 +322,7 @@ begin
end; end;
{$define FPC_HAS_CHARARRAY_TO_ANSISTR}
Function fpc_CharArray_To_AnsiStr(const arr: array of ansichar; zerobased: boolean = true): ansistring; compilerproc; Function fpc_CharArray_To_AnsiStr(const arr: array of ansichar; zerobased: boolean = true): ansistring; compilerproc;
var var
i,j : SizeInt; i,j : SizeInt;
@ -326,6 +364,8 @@ begin
result:=Ansistring(res); result:=Ansistring(res);
end; end;
{$define FPC_HAS_ANSISTR_TO_CHARARRAY}
procedure fpc_ansistr_to_chararray(out res: array of ansichar; const src: ansistring); compilerproc; procedure fpc_ansistr_to_chararray(out res: array of ansichar; const src: ansistring); compilerproc;
var var
len: longint; len: longint;
@ -351,6 +391,7 @@ begin
end; end;
{$define FPC_HAS_ANSISTR_COMPARE}
Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc; Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
{ {
Compares 2 AnsiStrings; Compares 2 AnsiStrings;
@ -385,6 +426,8 @@ begin
result:=Length(S1)-Length(S2); result:=Length(S1)-Length(S2);
end; end;
{$define FPC_HAS_ANSISTR_COMPARE_EQUAL}
Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc; Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
{ {
Compares 2 AnsiStrings for equality/inequality only; Compares 2 AnsiStrings for equality/inequality only;
@ -404,7 +447,11 @@ begin
end; 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; function fpc_AnsiStr_SetLength (S : AnsiString; l : SizeInt): Ansistring; compilerproc;
{ {
Sets The length of string S to L. Sets The length of string S to L.
@ -424,41 +471,22 @@ end;
{***************************************************************************** {*****************************************************************************
Public functions, In interface. Public functions, In interface.
*****************************************************************************} *****************************************************************************}
(*
function fpc_truely_ansistr_unique(Var S : Pointer): Pointer;
Var
SNew : Pointer;
L : SizeInt;
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;
end;
*)
(* { can't implement reference counting since no control over what javacc-compiled
{$ifndef FPC_SYSTEM_HAS_ANSISTR_UNIQUE} code does with ansistrings -> always create a copy }
// MV: inline the basic checks for case that S is already unique. {$define FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
// Rest is too complex to inline, so factor that out as a call. procedure FPC_ANSISTR_UNIQUE(var s: AnsiString); inline;
begin
s:=ansistring(AnsistringClass.Create(s));
end;
Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc; Function fpc_ansistr_Unique(Var S : jlobject): jlobject; compilerproc;
{
Make sure reference count of S is 1,
using copy-on-write semantics.
}
begin begin
pointer(result) := pointer(s); s:=AnsistringClass.Create(ansistring(s));
If Pointer(S)=Nil then result:=s;
exit;
if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
result:=fpc_truely_ansistr_unique(s);
end; end;
{$endif FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
*)
{$define FPC_HAS_ANSISTR_APPEND_CHAR}
Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc; Procedure fpc_ansistr_append_char(Var S : AnsiString;c : ansichar); compilerproc;
var var
curlen: sizeint; curlen: sizeint;
@ -468,6 +496,8 @@ begin
AnsistringClass(s).fdata[curlen]:=c; AnsistringClass(s).fdata[curlen]:=c;
end; end;
{$define FPC_HAS_ANSISTR_APPEND_SHORTSTR}
Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc; Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
var var
ofs : SizeInt; ofs : SizeInt;
@ -480,6 +510,8 @@ begin
JLSystem.ArrayCopy(JLObject(ShortstringClass(@Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str)); JLSystem.ArrayCopy(JLObject(ShortstringClass(@Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
end; end;
{$define FPC_HAS_ANSISTR_APPEND_ANSISTR}
Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc; Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
var var
ofs, strlength: longint; ofs, strlength: longint;
@ -494,6 +526,8 @@ begin
JLSystem.ArrayCopy(JLObject(AnsistringClass(Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,strlength); JLSystem.ArrayCopy(JLObject(AnsistringClass(Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,strlength);
end; end;
{$define FPC_HAS_ANSISTR_COPY}
Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc; Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
var var
res: AnsistringClass; res: AnsistringClass;
@ -517,33 +551,40 @@ begin
{ default function result is empty string } { default function result is empty string }
end; end;
(*
{$define FPC_HAS_POS_SHORTSTR_ANSISTR}
Function Pos (Const Substr : ShortString; Const Source : AnsiString) : SizeInt; Function Pos (Const Substr : ShortString; Const Source : AnsiString) : SizeInt;
var var
i,MaxLen : SizeInt; i,j,k,MaxLen, SubstrLen : SizeInt;
pc : pchar;
begin begin
Pos:=0; Pos:=0;
if Length(SubStr)>0 then SubstrLen:=Length(SubStr);
if SubstrLen>0 then
begin begin
MaxLen:=Length(source)-Length(SubStr); MaxLen:=Length(source)-Length(SubStr);
i:=0; i:=0;
pc:=@source[1];
while (i<=MaxLen) do while (i<=MaxLen) do
begin begin
inc(i); inc(i);
if (SubStr[1]=pc^) and j:=0;
(CompareByte(Substr[1],pc^,Length(SubStr))=0) then 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 begin
Pos:=i; Pos:=i;
exit; exit;
end; end;
inc(pc);
end; end;
end; end;
end; end;
*)
{$define FPC_HAS_POS_ANSISTR_ANSISTR}
Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt;
var var
i,j,k,MaxLen, SubstrLen : SizeInt; i,j,k,MaxLen, SubstrLen : SizeInt;
@ -575,6 +616,7 @@ begin
end; end;
{$define FPC_HAS_POS_ANSICHAR_ANSISTR}
{ Faster version for a char alone. Must be implemented because } { Faster version for a char alone. Must be implemented because }
{ pos(c: char; const s: shortstring) also exists, so otherwise } { pos(c: char; const s: shortstring) also exists, so otherwise }
{ using pos(char,pchar) will always call the shortstring version } { using pos(char,pchar) will always call the shortstring version }
@ -594,254 +636,16 @@ begin
pos:=0; pos:=0;
end; 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; Function StringOfChar(c : char;l : SizeInt) : AnsiString;
begin begin
SetLength(StringOfChar,l); SetLength(StringOfChar,l);
FillChar(Pointer(StringOfChar)^,Length(StringOfChar),c); FillChar(AnsistringClass(result).fdata,l,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);
end; 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; function upcase(const s : ansistring) : ansistring;
var var
u : unicodestring; u : unicodestring;
@ -851,6 +655,7 @@ begin
end; end;
{$define FPC_HAS_LOWERCASE_ANSISTR}
function lowercase(const s : ansistring) : ansistring; function lowercase(const s : ansistring) : ansistring;
var var
u : unicodestring; u : unicodestring;

4
rtl/java/jsystemh.inc
View File

@ -421,14 +421,13 @@ Function hexStr(Val:Pointer):shortstring;
Function chr(b : byte) : Char; [INTERNPROC: fpc_in_chr_byte]; Function chr(b : byte) : Char; [INTERNPROC: fpc_in_chr_byte];
Function upCase(c:Char):Char; Function upCase(c:Char):Char;
Function lowerCase(c:Char):Char; overload; Function lowerCase(c:Char):Char; overload;
(*function pos(const substr : shortstring;c:char): SizeInt;*) function pos(const substr : shortstring;c:char): SizeInt;
{**************************************************************************** {****************************************************************************
AnsiString Handling AnsiString Handling
****************************************************************************} ****************************************************************************}
(*
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure UniqueString(var S : AnsiString);external name 'FPC_ANSISTR_UNIQUE'; Procedure UniqueString(var S : AnsiString);external name 'FPC_ANSISTR_UNIQUE';
Function Pos (const Substr : AnsiString; const Source : AnsiString) : SizeInt; 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 upcase(const s : ansistring) : ansistring;
function lowercase(const s : ansistring) : ansistring; function lowercase(const s : ansistring) : ansistring;
{$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
*)
{**************************************************************************** {****************************************************************************
WideString Handling WideString Handling

3
rtl/java/system.pp
View File

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

4
tests/test/jvm/tstr.pp
View File

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