paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:14:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ unicodestring support for the JVM target (except for multiple adds

Browse Source 
in a single statement, to be added later)
   o the unicodestrings are internally simply java.lang.String instances
   o at the language level, the unicodestrings are assignment-compatible
     with java.lang.String
   o constant strings can be implicitly converted to java.lang.String
   o since java.lang.String is immutable, in particular changing a
     single character in a string is extremely inefficient. This could
     be solved by letting unicodestring map to java.lang.StringBuilder,
     but that would make integration with plain Java code harder

git-svn-id: branches/jvmbackend@18470 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:02:33 +00:00
parent d759598c70
commit 91855becfe
18 changed files with 2977 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -7359,6 +7359,8 @@ rtl/java/objpas.pp svneol=native#text/plain
rtl/java/rtl.cfg svneol=native#text/plain rtl/java/rtl.cfg svneol=native#text/plain
rtl/java/rtti.inc svneol=native#text/plain rtl/java/rtti.inc svneol=native#text/plain
rtl/java/system.pp svneol=native#text/plain rtl/java/system.pp svneol=native#text/plain
rtl/java/ustringh.inc svneol=native#text/plain
rtl/java/ustrings.inc svneol=native#text/plain
rtl/jvm/makefile.cpu svneol=native#text/plain rtl/jvm/makefile.cpu svneol=native#text/plain
rtl/linux/Makefile svneol=native#text/plain rtl/linux/Makefile svneol=native#text/plain
rtl/linux/Makefile.fpc svneol=native#text/plain rtl/linux/Makefile.fpc svneol=native#text/plain

37
compiler/defcmp.pas
View File

@ -200,6 +200,12 @@ implementation
exit; exit;
end; end;
{ resolve anonymous external definitions }
if def_from.typ=objectdef then
def_from:=find_real_class_definition(tobjectdef(def_from),false);
if def_to.typ=objectdef then
def_to:=find_real_class_definition(tobjectdef(def_to),false);
{ same def? then we've an exact match } { same def? then we've an exact match }
if def_from=def_to then if def_from=def_to then
begin begin
@ -523,7 +529,13 @@ implementation
begin begin
doconv:=tc_intf_2_string; doconv:=tc_intf_2_string;
eq:=te_convert_l1; eq:=te_convert_l1;
end; end
else if (def_from=java_jlstring) and
is_wide_or_unicode_string(def_to) then
begin
doconv:=tc_equal;
eq:=te_equal;
end
end; end;
end; end;
end; end;
@ -1267,23 +1279,24 @@ implementation
objectdef : objectdef :
begin begin
{ Objective-C/Java classes (handle anonymous externals) }
if (def_from.typ=objectdef) and
(find_real_class_definition(tobjectdef(def_from),false) =
find_real_class_definition(tobjectdef(def_to),false)) then
begin
doconv:=tc_equal;
{ exact, not equal, because can change between interface
and implementation }
eq:=te_exact;
end
{ object pascal objects } { object pascal objects }
else if (def_from.typ=objectdef) and if (def_from.typ=objectdef) and
(tobjectdef(def_from).is_related(tobjectdef(def_to))) then (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
begin begin
doconv:=tc_equal; doconv:=tc_equal;
eq:=te_convert_l1; eq:=te_convert_l1;
end end
{ java.lang.string -> unicodestring }
else if (def_to=java_jlstring) and
(is_wide_or_unicode_string(def_from) or
(fromtreetype=stringconstn)) then
begin
doconv:=tc_equal;
if is_wide_or_unicode_string(def_from) then
eq:=te_equal
else
eq:=te_convert_l2;
end
else else
{ specific to implicit pointer object types } { specific to implicit pointer object types }
if is_implicit_pointer_object_type(def_to) then if is_implicit_pointer_object_type(def_to) then

64
compiler/jvm/njvmadd.pas
View File

@ -34,8 +34,9 @@ interface
{ tjvmaddnode } { tjvmaddnode }
tjvmaddnode = class(tcgaddnode) tjvmaddnode = class(tcgaddnode)
protected
function pass_1: tnode;override; function pass_1: tnode;override;
protected
function first_addstring: tnode; override;
function cmpnode2signedtopcmp: TOpCmp; function cmpnode2signedtopcmp: TOpCmp;
@ -54,12 +55,13 @@ interface
uses uses
systems, systems,
cutils,verbose, cutils,verbose,constexp,
symtable,symdef,
paramgr,procinfo, paramgr,procinfo,
aasmtai,aasmdata,aasmcpu,defutil, aasmtai,aasmdata,aasmcpu,defutil,
hlcgobj,hlcgcpu,cgutils, hlcgobj,hlcgcpu,cgutils,
cpupara, cpupara,
ncon,nset,nadd, ncon,nset,nadd,ncal,
cgobj; cgobj;
{***************************************************************************** {*****************************************************************************
@ -74,6 +76,62 @@ interface
end; end;
function tjvmaddnode.first_addstring: tnode;
var
cmpfuncname: string;
begin
{ when we get here, we are sure that both the left and the right }
{ node are both strings of the same stringtype (JM) }
case nodetype of
addn:
begin
if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
begin
result:=right;
left.free;
left:=nil;
right:=nil;
exit;
end;
if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
begin
result:=left;
left:=nil;
right.free;
right:=nil;
exit;
end;
{ create the call to the concat routine both strings as arguments }
result:=ccallnode.createintern('fpc_'+
tstringdef(resultdef).stringtypname+'_concat',
ccallparanode.create(right,
ccallparanode.create(left,nil)));
{ we reused the arguments }
left := nil;
right := nil;
end;
ltn,lten,gtn,gten,equaln,unequaln :
begin
{ call compare routine }
cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
{ for equality checks use optimized version }
if nodetype in [equaln,unequaln] then
cmpfuncname := cmpfuncname + '_equal';
result := ccallnode.createintern(cmpfuncname,
ccallparanode.create(right,ccallparanode.create(left,nil)));
{ and compare its result with 0 according to the original operator }
result := caddnode.create(nodetype,result,
cordconstnode.create(0,s32inttype,false));
left := nil;
right := nil;
end;
else
internalerror(2011031401);
end;
end;
function tjvmaddnode.cmpnode2signedtopcmp: TOpCmp; function tjvmaddnode.cmpnode2signedtopcmp: TOpCmp;
begin begin
case nodetype of case nodetype of

29
compiler/jvm/njvmcnv.pas
View File

@ -31,6 +31,7 @@ interface
type type
tjvmtypeconvnode = class(tcgtypeconvnode) tjvmtypeconvnode = class(tcgtypeconvnode)
function typecheck_dynarray_to_openarray: tnode; override; function typecheck_dynarray_to_openarray: tnode; override;
function typecheck_string_to_chararray: tnode; override;
procedure second_int_to_int;override; procedure second_int_to_int;override;
{ procedure second_string_to_string;override; } { procedure second_string_to_string;override; }
@ -99,6 +100,34 @@ implementation
end; end;
function tjvmtypeconvnode.typecheck_string_to_chararray: tnode;
var
newblock: tblocknode;
newstat: tstatementnode;
restemp: ttempcreatenode;
chartype: string;
begin
if (left.nodetype = stringconstn) and
(tstringconstnode(left).cst_type=cst_conststring) then
inserttypeconv(left,cunicodestringtype);
{ even constant strings have to be handled via a helper }
if is_widechar(tarraydef(resultdef).elementdef) then
chartype:='widechar'
else
chartype:='char';
newblock:=internalstatements(newstat);
restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
addstatement(newstat,restemp);
addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
'_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
ctemprefnode.create(restemp),nil))));
addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
addstatement(newstat,ctemprefnode.create(restemp));
result:=newblock;
left:=nil;
end;
{***************************************************************************** {*****************************************************************************
FirstTypeConv FirstTypeConv
*****************************************************************************} *****************************************************************************}

104
compiler/jvm/njvminl.pas
View File

@ -37,6 +37,7 @@ interface
function typecheck_new(var handled: boolean): tnode; function typecheck_new(var handled: boolean): tnode;
function first_setlength_array: tnode; function first_setlength_array: tnode;
function first_setlength_string: tnode;
public public
{ typecheck override to intercept handling } { typecheck override to intercept handling }
function pass_typecheck: tnode; override; function pass_typecheck: tnode; override;
@ -55,6 +56,7 @@ interface
*) *)
function first_new: tnode; override; function first_new: tnode; override;
function first_setlength: tnode; override; function first_setlength: tnode; override;
function first_length: tnode; override;
procedure second_length; override; procedure second_length; override;
(* (*
@ -93,7 +95,8 @@ implementation
begin begin
typecheckpass(left); typecheckpass(left);
if is_dynamic_array(left.resultdef) or if is_dynamic_array(left.resultdef) or
is_open_array(left.resultdef) then is_open_array(left.resultdef) or
is_wide_or_unicode_string(left.resultdef) then
begin begin
resultdef:=s32inttype; resultdef:=s32inttype;
result:=nil; result:=nil;
@ -334,6 +337,44 @@ implementation
end; end;
function tjvminlinenode.first_setlength_string: tnode;
var
newblock: tblocknode;
newstatement: tstatementnode;
lefttemp: ttempcreatenode;
assignmenttarget: tnode;
begin
if is_wide_or_unicode_string(left.resultdef) then
begin
{ store left into a temp in case it may contain a function call
(which must not be evaluated twice) }
lefttemp:=maybereplacewithtempref(tcallparanode(left).left,tcallparanode(left).left.resultdef.size,false);
if assigned(lefttemp) then
begin
newblock:=internalstatements(newstatement);
addstatement(newstatement,lefttemp);
assignmenttarget:=ctemprefnode.create(lefttemp);
typecheckpass(tnode(assignmenttarget));
end
else
assignmenttarget:=tcallparanode(left).left.getcopy;
{ back to original order for the call }
left:=reverseparameters(tcallparanode(left));
result:=cassignmentnode.create(assignmenttarget,
ccallnode.createintern('fpc_unicodestr_setlength',left));
if assigned(lefttemp) then
begin
addstatement(newstatement,result);
addstatement(newstatement,ctempdeletenode.create(lefttemp));
result:=newblock;
end;
left:=nil;
end
else
internalerror(2011031405);
end;
function tjvminlinenode.first_setlength: tnode; function tjvminlinenode.first_setlength: tnode;
begin begin
@ -351,12 +392,64 @@ implementation
case left.resultdef.typ of case left.resultdef.typ of
arraydef: arraydef:
result:=first_setlength_array; result:=first_setlength_array;
stringdef:
result:=first_setlength_string;
else else
internalerror(2011031204); internalerror(2011031204);
end; end;
end; end;
function tjvminlinenode.first_length: tnode;
var
newblock: tblocknode;
newstatement: tstatementnode;
lentemp: ttempcreatenode;
ifcond,
stringnonnull,
stringnull: tnode;
psym: tsym;
begin
if is_wide_or_unicode_string(left.resultdef) then
begin
{ if assigned(JLString(left)) then
lentemp:=JLString(left).length()
else
lentemp:=0;
--> return lentemp
}
newblock:=internalstatements(newstatement);
lentemp:=ctempcreatenode.create(s32inttype,s32inttype.size,tt_persistent,true);
addstatement(newstatement,lentemp);
{ if-condition }
ifcond:=cinlinenode.create(in_assigned_x,false,
ccallparanode.create(ctypeconvnode.create_explicit(left.getcopy,java_jlstring),nil));
{ then-path (reuse left, since last use) }
psym:=search_struct_member(java_jlstring,'LENGTH');
if not assigned(psym) or
(psym.typ<>procsym) then
internalerror(2011031403);
stringnonnull:=cassignmentnode.create(
ctemprefnode.create(lentemp),
ccallnode.create(nil,tprocsym(psym),psym.owner,
ctypeconvnode.create_explicit(left,java_jlstring),[]));
left:=nil;
{ else-path}
stringnull:=cassignmentnode.create(
ctemprefnode.create(lentemp),
genintconstnode(0));
{ complete if-statement }
addstatement(newstatement,cifnode.create(ifcond,stringnonnull,stringnull));
{ return temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(lentemp));
addstatement(newstatement,ctemprefnode.create(lentemp));
result:=newblock;
end
else
result:=inherited first_length;
end;
procedure tjvminlinenode.second_length; procedure tjvminlinenode.second_length;
begin begin
if is_dynamic_array(left.resultdef) or if is_dynamic_array(left.resultdef) or
@ -497,6 +590,7 @@ implementation
var var
target: tnode; target: tnode;
lenpara: tnode; lenpara: tnode;
emptystr: ansichar;
begin begin
target:=tcallparanode(left).left; target:=tcallparanode(left).left;
lenpara:=tcallparanode(tcallparanode(left).right).left; lenpara:=tcallparanode(tcallparanode(left).right).left;
@ -506,7 +600,13 @@ implementation
internalerror(2011031801); internalerror(2011031801);
secondpass(target); secondpass(target);
if is_dynamic_array(target.resultdef) then if is_wide_or_unicode_string(target.resultdef) then
begin
emptystr:=#0;
current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,0,@emptystr));
thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
end
else if is_dynamic_array(target.resultdef) then
begin begin
thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER); thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER);
thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1); thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1);

41
compiler/jvm/njvmld.pas
View File

@ -36,6 +36,10 @@ type
function is_addr_param_load: boolean; override; function is_addr_param_load: boolean; override;
end; end;
tjvmassignmentnode = class(tcgassignmentnode)
function pass_1: tnode; override;
end;
tjvmarrayconstructornode = class(tcgarrayconstructornode) tjvmarrayconstructornode = class(tcgarrayconstructornode)
protected protected
procedure makearrayref(var ref: treference; eledef: tdef); override; procedure makearrayref(var ref: treference; eledef: tdef); override;
@ -47,10 +51,42 @@ implementation
uses uses
verbose, verbose,
aasmdata, aasmdata,
nld, nbas,nld,ncal,nmem,ncnv,
symsym,symdef,jvmdef, symsym,symdef,defutil,jvmdef,
cgbase,hlcgobj; cgbase,hlcgobj;
{ tjvmassignmentnode }
function tjvmassignmentnode.pass_1: tnode;
var
target: tnode;
begin
{ intercept writes to string elements, because Java strings are immutable
-> detour via StringBuilder
}
target:=left.actualtargetnode;
if (target.nodetype=vecn) and
is_wide_or_unicode_string(tvecnode(target).left.resultdef) then
begin
{ prevent errors in case of an expression such as
word(str[x]):=1234;
}
inserttypeconv_explicit(right,cwidechartype);
result:=ccallnode.createintern('fpc_unicodestr_setchar',
ccallparanode.create(right,
ccallparanode.create(tvecnode(target).right,
ccallparanode.create(tvecnode(target).left.getcopy,nil))));
result:=cassignmentnode.create(tvecnode(target).left,result);
right:=nil;
tvecnode(target).left:=nil;
tvecnode(target).right:=nil;
exit;
end
else
result:=inherited;
end;
function tjvmloadnode.is_addr_param_load: boolean; function tjvmloadnode.is_addr_param_load: boolean;
begin begin
result:= result:=
@ -82,6 +118,7 @@ procedure tjvmarrayconstructornode.advancearrayoffset(var ref: treference; elesi
begin begin
cloadnode:=tjvmloadnode; cloadnode:=tjvmloadnode;
cassignmentnode:=tjvmassignmentnode;
carrayconstructornode:=tjvmarrayconstructornode; carrayconstructornode:=tjvmarrayconstructornode;
end. end.

29
compiler/jvm/njvmmem.pas
View File

@ -32,6 +32,7 @@ interface
type type
tjvmvecnode = class(tcgvecnode) tjvmvecnode = class(tcgvecnode)
function pass_1: tnode; override;
procedure pass_generate_code;override; procedure pass_generate_code;override;
end; end;
@ -39,8 +40,9 @@ implementation
uses uses
systems, systems,
cutils,verbose, cutils,verbose,constexp,
symdef,defutil, symconst,symtype,symtable,symsym,symdef,defutil,
nadd,ncal,ncnv,ncon,
aasmdata,pass_2, aasmdata,pass_2,
cgutils,hlcgobj,hlcgcpu; cgutils,hlcgobj,hlcgcpu;
@ -48,6 +50,29 @@ implementation
TJVMVECNODE TJVMVECNODE
*****************************************************************************} *****************************************************************************}
function tjvmvecnode.pass_1: tnode;
var
psym: tsym;
begin
if is_wide_or_unicode_string(left.resultdef) then
begin
psym:=search_struct_member(java_jlstring,'CHARAT');
if not assigned(psym) or
(psym.typ<>procsym) then
internalerror(2011031501);
{ Pascal strings are 1-based, Java strings 0-based }
result:=ccallnode.create(ccallparanode.create(
caddnode.create(subn,right,genintconstnode(1)),nil),tprocsym(psym),
psym.owner,ctypeconvnode.create_explicit(left,java_jlstring),[]);
left:=nil;
right:=nil;
exit;
end
else
result:=inherited;
end;
procedure tjvmvecnode.pass_generate_code; procedure tjvmvecnode.pass_generate_code;
var var
newsize: tcgsize; newsize: tcgsize;

5
compiler/jvmdef.pas
View File

@ -86,8 +86,9 @@ implementation
stringdef : stringdef :
begin begin
case tstringdef(def).stringtype of case tstringdef(def).stringtype of
{ translated into Java.Lang.String } { translated into java.lang.String }
st_widestring: st_widestring,
st_unicodestring:
encodedstr:=encodedstr+'Ljava/lang/String;'; encodedstr:=encodedstr+'Ljava/lang/String;';
else else
{ May be handled via wrapping later } { May be handled via wrapping later }

21
compiler/ninl.pas
View File

@ -70,6 +70,7 @@ interface
nodes are not generated by the parser. It's however used internally nodes are not generated by the parser. It's however used internally
by the JVM backend to create new dynamic arrays. } by the JVM backend to create new dynamic arrays. }
function first_new: tnode; virtual; function first_new: tnode; virtual;
function first_length: tnode; virtual;
private private
function handle_str: tnode; function handle_str: tnode;
function handle_reset_rewrite_typed: tnode; function handle_reset_rewrite_typed: tnode;
@ -2898,13 +2899,7 @@ implementation
in_length_x: in_length_x:
begin begin
if is_shortstring(left.resultdef) then result:=first_length;
expectloc:=left.expectloc
else
begin
{ ansi/wide string }
expectloc:=LOC_REGISTER;
end;
end; end;
in_typeinfo_x: in_typeinfo_x:
@ -3428,6 +3423,18 @@ implementation
result:=nil; result:=nil;
end; end;
function tinlinenode.first_length: tnode;
begin
result:=nil;
if is_shortstring(left.resultdef) then
expectloc:=left.expectloc
else
begin
{ ansi/wide string }
expectloc:=LOC_REGISTER;
end;
end;
function tinlinenode.first_pack_unpack: tnode; function tinlinenode.first_pack_unpack: tnode;
var var
loopstatement : tstatementnode; loopstatement : tstatementnode;

2
compiler/pdecobj.pas
View File

@ -1293,6 +1293,8 @@ implementation
java_jlthrowable:=current_objectdef; java_jlthrowable:=current_objectdef;
if (current_objectdef.objname^='FPCBASERECORDTYPE') then if (current_objectdef.objname^='FPCBASERECORDTYPE') then
java_fpcbaserecordtype:=current_objectdef; java_fpcbaserecordtype:=current_objectdef;
if (current_objectdef.objname^='JLSTRING') then
java_jlstring:=current_objectdef;
end; end;
end; end;
end; end;

4
compiler/symdef.pas
View File

@ -783,6 +783,8 @@ interface
java_jlthrowable : tobjectdef; java_jlthrowable : tobjectdef;
{ FPC base type for records } { FPC base type for records }
java_fpcbaserecordtype : tobjectdef; java_fpcbaserecordtype : tobjectdef;
{ java.lang.String }
java_jlstring : tobjectdef;
const const
{$ifdef i386} {$ifdef i386}
@ -4703,6 +4705,8 @@ implementation
java_jlthrowable:=self; java_jlthrowable:=self;
if (objname^='FPCBASERECORDTYPE') then if (objname^='FPCBASERECORDTYPE') then
java_fpcbaserecordtype:=self; java_fpcbaserecordtype:=self;
if (objname^='JLSTRING') then
java_jlstring:=self;
end; end;
writing_class_record_dbginfo:=false; writing_class_record_dbginfo:=false;
end; end;

6
compiler/x86/nx86add.pas
View File

@ -43,7 +43,7 @@ unit nx86add;
procedure second_addfloatsse; procedure second_addfloatsse;
public public
procedure second_addfloat;override; procedure second_addfloat;override;
procedure second_addsmallset;override; // procedure second_addsmallset;override;
procedure second_add64bit;override; procedure second_add64bit;override;
procedure second_cmpfloat;override; procedure second_cmpfloat;override;
procedure second_cmpsmallset;override; procedure second_cmpsmallset;override;
@ -330,7 +330,7 @@ unit nx86add;
{***************************************************************************** {*****************************************************************************
AddSmallSet AddSmallSet
*****************************************************************************} *****************************************************************************}
(*
procedure tx86addnode.second_addsmallset; procedure tx86addnode.second_addsmallset;
var var
setbase : aint; setbase : aint;
@ -433,7 +433,7 @@ unit nx86add;
if opsize<>int_cgsize(resultdef.size) then if opsize<>int_cgsize(resultdef.size) then
location_force_reg(current_asmdata.CurrAsmList,location,int_cgsize(resultdef.size),false); location_force_reg(current_asmdata.CurrAsmList,location,int_cgsize(resultdef.size),false);
end; end;
*)
procedure tx86addnode.second_cmpsmallset; procedure tx86addnode.second_cmpsmallset;
var var

649
rtl/java/compproc.inc
View File

@ -21,6 +21,579 @@
**********************************************************************} **********************************************************************}
{ some dummy types necessary to have generic resulttypes for certain compilerprocs }
type
{ normally the array should be maxlongint big, but that will confuse
the debugger. The compiler will set the correct size of the array
internally. It's now set to 0..0 because when compiling with -gt,
the entire array will be trashed, so it must not be defined larger
than the minimal size (otherwise we can trash other memory) }
fpc_big_chararray = array[0..0] of AnsiChar;
fpc_big_widechararray = array[0..0] of widechar;
fpc_big_unicodechararray = array[0..0] of unicodechar;
fpc_small_set = bitpacked array[0..31] of 0..1;
fpc_normal_set = bitpacked array[0..255] of 0..1;
fpc_normal_set_byte = array[0..31] of byte;
fpc_normal_set_long = array[0..7] of longint;
(*
procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifndef STR_CONCAT_PROCS}
function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
{$else STR_CONCAT_PROCS}
procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of pshortstring);compilerproc;
{$endif STR_CONCAT_PROCS}
procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_length(p:pchar):longint; compilerproc;
function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_chararray_to_shortstr(const arr: array of AnsiChar; zerobased: boolean = true):shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
function fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
*)
(*
{ Str() support }
procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
procedure fpc_shortstr_uint(v : valuint;len : SizeInt;out s : shortstring); compilerproc;
{$ifndef FPUNONE}
procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring); compilerproc;
{$endif}
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);compilerproc;
procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);compilerproc;
procedure fpc_ShortStr_Currency(c : currency; len,f : SizeInt; out s : shortstring); 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;
{$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;
{$ifndef FPUNONE}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
{$endif}
procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring); compilerproc;
procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring); compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
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)}
procedure fpc_WideStr_sint(v : valsint; Len : SizeInt; out S : WideString); compilerproc;
procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compilerproc;
{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef VER2_2}
procedure fpc_UnicodeStr_sint(v : valsint; Len : SizeInt; out S : UnicodeString); compilerproc;
procedure fpc_UnicodeStr_uint(v : valuint;Len : SizeInt; out S : UnicodeString); compilerproc;
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef CPU64}
procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring); compilerproc;
procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring); compilerproc;
procedure fpc_chararray_qword(v : qword;len : SizeInt;out a : array of AnsiChar); compilerproc;
procedure fpc_chararray_int64(v : int64;len : SizeInt;out a : array of AnsiChar); compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
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)}
procedure fpc_widestr_qword(v : qword;len : SizeInt;out s : widestring); compilerproc;
procedure fpc_widestr_int64(v : int64;len : SizeInt;out s : widestring); compilerproc;
{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef VER2_2}
procedure fpc_UnicodeStr_qword(v : qword;len : SizeInt;out s : UnicodeString); compilerproc;
procedure fpc_UnicodeStr_int64(v : int64;len : SizeInt;out s : UnicodeString); compilerproc;
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$endif CPU64}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef FPUNONE}
procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
{$endif}
procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
procedure fpc_widestr_bool(b : boolean;len:sizeint;out s:widestring);compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef VER2_2}
{$ifndef FPUNONE}
procedure fpc_UnicodeStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : UnicodeString); compilerproc;
{$endif}
procedure fpc_unicodestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:unicodestring);compilerproc;
procedure fpc_unicodestr_bool(b : boolean;len:sizeint;out s:unicodestring);compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_UnicodeStr_Currency(c : Currency;len,fr : SizeInt;out s : UnicodeString);compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPUNONE}
procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of AnsiChar); compilerproc;
{$endif}
procedure fpc_chararray_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out a : array of AnsiChar);compilerproc;
procedure fpc_chararray_bool(b : boolean;len:sizeint;out a : array of AnsiChar);compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of AnsiChar);compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
{ Val() support }
{$ifndef FPUNONE}
Function fpc_Val_Real_ShortStr(const s : shortstring; out code : ValSInt): ValReal; compilerproc;
{$endif}
Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code: ValSInt): ValSInt; compilerproc;
Function fpc_Val_UInt_Shortstr(Const S: ShortString; out Code: ValSInt): ValUInt; compilerproc;
function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; compilerproc;
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}
Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; compilerproc;
Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; compilerproc;
Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; compilerproc;
function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef FPUNONE}
Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; compilerproc;
{$endif}
Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; compilerproc;
Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; compilerproc;
function fpc_val_Enum_WideStr (str2ordindex:pointer;const s:WideString;out code:valsint):longint;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)}
{$ifndef VER2_2}
{$ifndef FPUNONE}
Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc;
{$endif}
Function fpc_Val_SInt_UnicodeStr (DestSize: SizeInt; Const S : UnicodeString; out Code : ValSInt): ValSInt; compilerproc;
Function fpc_Val_UInt_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): ValUInt; compilerproc;
function fpc_val_Enum_UnicodeStr(str2ordindex:pointer;const s:UnicodeString;out code:valsint):longint;compilerproc;
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;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
Function fpc_Val_qword_WideStr (Const S : WideString; out Code : ValSInt): qword; compilerproc;
Function fpc_Val_int64_WideStr (Const S : WideString; out Code : ValSInt): Int64; compilerproc;
{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
{$ifndef VER2_2}
Function fpc_Val_qword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): qword; compilerproc;
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;
Procedure fpc_AnsiStr_Assign (Var DestS : Pointer;S2 : Pointer); 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}
function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
{$endif STR_CONCAT_PROCS}
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_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
{$ifdef EXTRAANSISHORT}
Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
{$endif EXTRAANSISHORT}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
Function fpc_Char_To_AnsiStr(const c : AnsiChar): AnsiString; compilerproc;
Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
Function fpc_CharArray_To_AnsiStr(const arr: array of AnsiChar; zerobased: boolean = true): ansistring; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: ansistring)compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
Procedure fpc_AnsiStr_CheckRange(len,index : SizeInt); compilerproc;
Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt); compilerproc;
Function fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
{$ifdef EXTRAANSISHORT}
Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc;
{$endif EXTRAANSISHORT}
{ 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 : Pointer): Pointer; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
*)
{*****************************************************************************
Unicode string support
*****************************************************************************}
(*
{$ifndef VER2_2}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeString): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString; compilerproc;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
*)
Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; compilerproc;
Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compilerproc;
Function fpc_UnicodeStr_Concat (const S1,S2 : UnicodeString) : UnicodeString; compilerproc;
function fpc_UnicodeStr_Concat_multi (const sarr:array of Unicodestring): unicodestring; compilerproc;
Function fpc_Char_To_UnicodeStr(const c : AnsiChar): UnicodeString; compilerproc;
Function fpc_CharArray_To_UnicodeStr(const arr: array of AnsiChar; zerobased: boolean = true): UnicodeString; compilerproc;
procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: UnicodeString); compilerproc;
//procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
//procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
procedure fpc_unicodestr_to_unicodechararray(out res: array of unicodechar; const src: UnicodeString); compilerproc;
function fpc_unicodestr_setchar(const s: UnicodeString; const index: longint; const ch: unicodechar): UnicodeString; compilerproc;
(*
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerobased: boolean = true): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; zerobased: boolean = true): AnsiString; compilerproc;
*)
Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
(*
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
*)
Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
(*
{$ifndef FPC_STRTOCHARARRAYPROC}
Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
*)
procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
(*
{$endif ndef FPC_STRTOCHARARRAYPROC}
*)
Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
(*
Procedure fpc_UnicodeStr_CheckZero(p : pointer); compilerproc;
Procedure fpc_UnicodeStr_CheckRange(len,index : SizeInt); compilerproc;
*)
Function fpc_UnicodeStr_SetLength (const S : UnicodeString; l : SizeInt): UnicodeString; compilerproc;
Function fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
//function fpc_unicodestr_Unique(Var S : Pointer): Pointer; compilerproc;
Function fpc_Char_To_UChar(const c : AnsiChar): UnicodeChar; compilerproc;
Function fpc_UChar_To_Char(const c : UnicodeChar): AnsiChar; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
(*
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar): ansistring; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc;
Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
*)
(*
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
*)
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Function fpc_Char_To_WChar(const c : AnsiChar): WideChar; compilerproc;
Function fpc_WChar_To_Char(const c : WideChar): AnsiChar; compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_TEXTIO}
{ from text.inc }
Function fpc_get_input:PText;compilerproc;
Function fpc_get_output:PText;compilerproc;
Procedure fpc_Write_End(var f:Text); compilerproc;
Procedure fpc_Writeln_End(var f:Text); compilerproc;
Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); compilerproc;
Procedure fpc_Write_Text_ShortStr_Iso(Len : Longint;var f : Text;const s : String); compilerproc;
Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of AnsiChar; zerobased: boolean = true); compilerproc;
Procedure fpc_Write_Text_Pchar_as_Array_Iso(Len : Longint;var f : Text;const s : array of AnsiChar; zerobased: boolean = true); compilerproc;
Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); compilerproc;
Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; const S : AnsiString); compilerproc;
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideString); compilerproc;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : UnicodeString); compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); compilerproc;
Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); compilerproc;
Procedure fpc_Write_Text_SInt_Iso(Len : Longint;var t : Text;l : ValSInt); compilerproc;
Procedure fpc_Write_Text_UInt_Iso(Len : Longint;var t : Text;l : ValUInt); compilerproc;
{$ifndef CPU64}
procedure fpc_write_text_qword(len : longint;var t : text;q : qword); compilerproc;
procedure fpc_write_text_int64(len : longint;var t : text;i : int64); compilerproc;
procedure fpc_write_text_qword_iso(len : longint;var t : text;q : qword); compilerproc;
procedure fpc_write_text_int64_iso(len : longint;var t : text;i : int64); compilerproc;
{$endif CPU64}
{$ifndef FPUNONE}
Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
Procedure fpc_Write_Text_Float_Iso(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
{$endif}
procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); compilerproc;
Procedure fpc_Write_Text_Boolean_Iso(Len : Longint;var t : Text;b : Boolean); compilerproc;
Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : AnsiChar); compilerproc;
Procedure fpc_Write_Text_Char_Iso(Len : Longint;var t : Text;c : AnsiChar); compilerproc;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
function fpc_SetupWriteStr_Shortstr(out s: shortstring): PText; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
function fpc_SetupWriteStr_Ansistr(out s: ansistring): PText; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function fpc_SetupWriteStr_Unicodestr(out s: unicodestring): PText; compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
function fpc_SetupWriteStr_Widestr(out s: widestring): PText; compilerproc;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
function fpc_SetupReadStr_Shortstr(const s: shortstring): PText; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
function fpc_SetupReadStr_Ansistr(const s: ansistring): PText; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function fpc_SetupReadStr_Unicodestr(const s: unicodestring): PText; compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
function fpc_SetupReadStr_Widestr(const s: widestring): PText; compilerproc;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_HAS_FEATURE_TEXTIO}
{$ifdef FPC_HAS_FEATURE_VARIANTS}
procedure fpc_variant_copy(d,s : pointer);compilerproc;
procedure fpc_variant_copy_overwrite(source, dest : pointer);compilerproc;
procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); compilerproc;
function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;
function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
function fpc_variant_to_idispatch(const v : variant) : idispatch;compilerproc;
function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata; calldesc : pcalldesc;params : pointer);compilerproc;
{$endif FPC_HAS_FEATURE_VARIANTS}
{$ifdef FPC_HAS_FEATURE_TEXTIO}
Procedure fpc_Read_End(var f:Text); compilerproc;
Procedure fpc_ReadLn_End(var f : Text); compilerproc;
Procedure fpc_ReadLn_End_Iso(var f : Text); compilerproc;
Procedure fpc_Read_Text_ShortStr(var f : Text;out s : String); compilerproc;
Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text; const s : PChar); compilerproc;
Procedure fpc_Read_Text_PChar_As_Array(var f : Text;out s : array of AnsiChar; zerobased: boolean = false); compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : AnsiString); compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Read_Text_UnicodeStr(var f : Text;out us : UnicodeString); compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Procedure fpc_Read_Text_WideStr(var f : Text;out ws : WideString); compilerproc;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
Procedure fpc_Read_Text_Char(var f : Text; out c : AnsiChar); compilerproc;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Read_Text_Char_Iso(var f : Text; out c : AnsiChar); compilerproc;
Procedure fpc_Read_Text_SInt(var f : Text; out l :ValSInt); compilerproc;
Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
{$ifndef FPUNONE}
Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
{$endif}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
{$ifndef CPU64}
Procedure fpc_Read_Text_QWord(var f : text; out q : qword); compilerproc;
Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;
{$endif CPU64}
{$endif FPC_HAS_FEATURE_TEXTIO}
{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
function fpc_div_dword(n,z : dword) : dword; compilerproc;
function fpc_mod_dword(n,z : dword) : dword; compilerproc;
function fpc_div_longint(n,z : longint) : longint; compilerproc;
function fpc_mod_longint(n,z : longint) : longint; compilerproc;
{$endif FPC_INCLUDE_SOFTWARE_MOD_DIV}
(*
{ from int64.inc }
function fpc_div_qword(n,z : qword) : qword; compilerproc;
function fpc_mod_qword(n,z : qword) : qword; compilerproc;
function fpc_div_int64(n,z : int64) : int64; compilerproc;
function fpc_mod_int64(n,z : int64) : int64; compilerproc;
function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword; compilerproc;
function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64; compilerproc;
*)
{$ifdef FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
function fpc_shl_qword(value,shift : qword) : qword; compilerproc;
function fpc_shr_qword(value,shift : qword) : qword; compilerproc;
function fpc_shl_int64(value,shift : int64) : int64; compilerproc;
function fpc_shr_int64(value,shift : int64) : int64; compilerproc;
{$endif FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
(*
{$ifndef FPUNONE}
function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_exp_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_frac_real(d : ValReal) : ValReal;compilerproc;
function fpc_int_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_ln_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_pi_real : ValReal;compilerproc;
function fpc_sin_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
function fpc_round_real(d : ValReal) : int64;compilerproc;
function fpc_trunc_real(d : ValReal) : int64;compilerproc;
{$endif}
*)
{$ifdef FPC_HAS_FEATURE_CLASSES}
function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
procedure fpc_intf_incr_ref(i: pointer); compilerproc;
procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
//procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TGUID); compilerproc;
function fpc_intf_is(const S: pointer; const iid: TGUID): Boolean; compilerproc;
function fpc_intf_is_class(const S: pointer; const aclass: tclass): Boolean; compilerproc;
function fpc_class_is_intf(const S: pointer; const iid: TGUID): Boolean; compilerproc;
function fpc_class_is_corbaintf(const S: pointer; const iid: Shortstring): Boolean; compilerproc;
function fpc_intf_cast(const S: pointer; const iid: TGUID): IInterface; compilerproc;
function fpc_intf_cast_class(const S: pointer; const aclass: tclass): pointer; compilerproc;
function fpc_class_cast_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
function fpc_class_cast_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
function fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
function fpc_intf_as_class(const S: pointer; const aclass: tclass): pointer; compilerproc;
function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
{$ifdef FPC_HAS_FEATURE_VARIANTS}
procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc: Pointer; Params: Pointer); compilerproc;
{$endif FPC_HAS_FEATURE_VARIANTS}
{$endif FPC_HAS_FEATURE_CLASSES}
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc;
Procedure fpc_PopAddrStack; compilerproc;
function fpc_PopObjectStack : TObject; compilerproc;
function fpc_PopSecondObjectStack : TObject; compilerproc;
Procedure fpc_ReRaise; compilerproc;
Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc;
function fpc_GetExceptionAddr : Pointer; compilerproc;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
{$ifdef FPC_HAS_FEATURE_OBJECTS}
function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;compilerproc;
procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);compilerproc;
procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);compilerproc;
{$endif FPC_HAS_FEATURE_OBJECTS}
{$ifdef dummy}
procedure fpc_check_object(obj:pointer); compilerproc;
procedure fpc_check_object_ext(vmt,expvmt:pointer);compilerproc;
{$endif dummy}
{$ifdef FPC_HAS_FEATURE_RTTI} {$ifdef FPC_HAS_FEATURE_RTTI}
Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc; Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc;
Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc; Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc;
@ -33,6 +606,17 @@ procedure fpc_decref_array(data,typeinfo: pointer; count: sizeint); compilerproc
Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc; Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc;
Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline; Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
{$endif FPC_HAS_FEATURE_RTTI} {$endif FPC_HAS_FEATURE_RTTI}
{ array initialisation helpers (for open array "out" parameters whose elements
are normally refcounted) }
{ open array of unicodestring. normalarrdim contains the number of dimensions
a regular array, if any, that contains these unicodestrings. E.g.:
type
tarr = array[1..10,2..9] of unicodestring;
procedure test(out arr: array of tarr);
-> normalarrdim will be 2
}
procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
{ normalarrdim contains the number of dimensions { normalarrdim contains the number of dimensions
a regular array, if any, that contains these unicodestrings. E.g.: a regular array, if any, that contains these unicodestrings. E.g.:
type type
@ -54,3 +638,68 @@ Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc; procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc; procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
(*
{$ifdef FPC_SETBASE_USED}
procedure fpc_varset_load(const l;sourcesize : longint;var dest;size,srcminusdstbase : ptrint); compilerproc;
{$else}
procedure fpc_varset_load(const l;sourcesize : longint;var dest;size : ptrint); compilerproc;
{$endif}
procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc;
procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc;
procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc;
procedure fpc_varset_mul_sets(const set1,set2; var dest;size : ptrint); compilerproc;
procedure fpc_varset_sub_sets(const set1,set2; var dest;size : ptrint); compilerproc;
procedure fpc_varset_symdif_sets(const set1,set2; var dest;size : ptrint); compilerproc;
function fpc_varset_comp_sets(const set1,set2;size : ptrint):boolean; compilerproc;
function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean; compilerproc;
{$ifdef LARGESETS}
procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc;
procedure fpc_largeset_in_word(p : pointer;b : word); compilerproc;
procedure fpc_largeset_add_sets(set1,set2,dest : pointer;size : longint); compilerproc;
procedure fpc_largeset_sets(set1,set2,dest : pointer;size : longint); compilerproc;
procedure fpc_largeset_sub_sets(set1,set2,dest : pointer;size : longint); compilerproc;
procedure fpc_largeset_symdif_sets(set1,set2,dest : pointer;size : longint); compilerproc;
procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint); compilerproc;
procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint); compilerproc;
{$endif LARGESETS}
procedure fpc_rangeerror; compilerproc;
procedure fpc_divbyzero; compilerproc;
procedure fpc_overflow; compilerproc;
procedure fpc_iocheck; compilerproc;
procedure fpc_InitializeUnits; compilerproc;
// not generated by compiler, called directly in system unit
// procedure fpc_FinalizeUnits; compilerproc;
{
Procedure fpc_do_exit; compilerproc;
Procedure fpc_lib_exit; compilerproc;
Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
Procedure fpc_HandleError (Errno : longint); compilerproc;
}
procedure fpc_AbstractErrorIntern;compilerproc;
procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); compilerproc;
*)
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure fpc_reset_typed(var f : TypedFile;Size : Longint); compilerproc;
Procedure fpc_rewrite_typed(var f : TypedFile;Size : Longint); compilerproc;
Procedure fpc_reset_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
Procedure fpc_rewrite_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
{$endif FPC_HAS_FEATURE_FILEIO}
{$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
function fpc_int64_to_double(i: int64): double; compilerproc;
function fpc_qword_to_double(q: qword): double; compilerproc;
{$endif FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
(*
function fpc_setjmp(var s : jmp_buf) : longint; compilerproc;
procedure fpc_longjmp(var s : jmp_buf; value : longint); compilerproc;
*)

1
rtl/java/jdynarrh.inc
View File

@ -25,6 +25,7 @@ type
TJDoubleArray = array of jdouble; TJDoubleArray = array of jdouble;
TJObjectArray = array of JLObject; TJObjectArray = array of JLObject;
TJRecordArray = array of FpcBaseRecordType; TJRecordArray = array of FpcBaseRecordType;
TJStringArray = array of unicodestring;
const const
FPCJDynArrTypeJByte = 'B'; FPCJDynArrTypeJByte = 'B';

19
rtl/java/rtti.inc
View File

@ -12,6 +12,25 @@
**********************************************************************} **********************************************************************}
procedure fpc_initialize_array_jstring_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_unicodestring';
procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_jstring_intern(TJObjectArray(arr[i]),normalarrdim-1);
end
else
begin
for i:=low(arr) to high(arr) do
unicodestring(arr[i]):='';
end;
end;
procedure fpc_initialize_array_dynarr_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_dynarr'; procedure fpc_initialize_array_dynarr_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_dynarr';
procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc; procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;

71
rtl/java/system.pp
View File

@ -28,7 +28,15 @@ Unit system;
{$implicitexceptions off} {$implicitexceptions off}
{$mode objfpc} {$mode objfpc}
{$undef FPC_HAS_FEATURE_ANSISTRINGS}
{$undef FPC_HAS_FEATURE_TEXTIO}
{$undef FPC_HAS_FEATURE_VARIANTS}
{$undef FPC_HAS_FEATURE_CLASSES}
{$undef FPC_HAS_FEATURE_EXCEPTIONS}
{$undef FPC_HAS_FEATURE_OBJECTS}
{$undef FPC_HAS_FEATURE_RTTI} {$undef FPC_HAS_FEATURE_RTTI}
{$undef FPC_HAS_FEATURE_FILEIO}
{$undef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
Type Type
{ The compiler has all integer types defined internally. Here { The compiler has all integer types defined internally. Here
@ -37,9 +45,16 @@ Type
Cardinal = LongWord; Cardinal = LongWord;
Integer = SmallInt; Integer = SmallInt;
UInt64 = QWord; UInt64 = QWord;
SizeInt = Longint;
SizeUInt = Longint;
PtrInt = Longint;
PtrUInt = Longint;
ValReal = Double; ValReal = Double;
AnsiChar = Char;
UnicodeChar = WideChar;
{ map comp to int64, } { map comp to int64, }
Comp = Int64; Comp = Int64;
@ -109,8 +124,62 @@ type
{$i jrech.inc} {$i jrech.inc}
{$i jdynarrh.inc} {$i jdynarrh.inc}
Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];
Function lo(l : DWord) : Word; [INTERNPROC: fpc_in_lo_long];
Function lo(i : Int64) : DWord; [INTERNPROC: fpc_in_lo_qword];
Function lo(q : QWord) : DWord; [INTERNPROC: fpc_in_lo_qword];
Function hi(i : Integer) : byte; [INTERNPROC: fpc_in_hi_Word];
Function hi(w : Word) : byte; [INTERNPROC: fpc_in_hi_Word];
Function hi(l : Longint) : Word; [INTERNPROC: fpc_in_hi_long];
Function hi(l : DWord) : Word; [INTERNPROC: fpc_in_hi_long];
Function hi(i : Int64) : DWord; [INTERNPROC: fpc_in_hi_qword];
Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
Function chr(b : byte) : AnsiChar; [INTERNPROC: fpc_in_chr_byte];
function RorByte(Const AValue : Byte): Byte;[internproc:fpc_in_ror_x];
function RorByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_ror_x_x];
function RolByte(Const AValue : Byte): Byte;[internproc:fpc_in_rol_x];
function RolByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_rol_x_x];
function RorWord(Const AValue : Word): Word;[internproc:fpc_in_ror_x];
function RorWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_ror_x_x];
function RolWord(Const AValue : Word): Word;[internproc:fpc_in_rol_x];
function RolWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_rol_x_x];
function RorDWord(Const AValue : DWord): DWord;[internproc:fpc_in_ror_x];
function RorDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_ror_x_x];
function RolDWord(Const AValue : DWord): DWord;[internproc:fpc_in_rol_x];
function RolDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_rol_x_x];
function RorQWord(Const AValue : QWord): QWord;[internproc:fpc_in_ror_x];
function RorQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_ror_x_x];
function RolQWord(Const AValue : QWord): QWord;[internproc:fpc_in_rol_x];
function RolQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_rol_x_x];
function SarShortint(Const AValue : Shortint): Shortint;[internproc:fpc_in_sar_x];
function SarShortint(Const AValue : Shortint;Shift : Byte): Shortint;[internproc:fpc_in_sar_x_y];
function SarSmallint(Const AValue : Smallint): Smallint;[internproc:fpc_in_sar_x];
function SarSmallint(Const AValue : Smallint;Shift : Byte): Smallint;[internproc:fpc_in_sar_x_y];
function SarLongint(Const AValue : Longint): Longint;[internproc:fpc_in_sar_x];
function SarLongint(Const AValue : Longint;Shift : Byte): Longint;[internproc:fpc_in_sar_x_y];
function SarInt64(Const AValue : Int64): Int64;[internproc:fpc_in_sar_x];
function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_sar_x_y];
{$i compproc.inc} {$i compproc.inc}
{$i ustringh.inc}
{*****************************************************************************} {*****************************************************************************}
implementation implementation
{*****************************************************************************} {*****************************************************************************}
@ -133,6 +202,7 @@ type
********************************************************************** **********************************************************************
} }
{$i ustrings.inc}
{$i rtti.inc} {$i rtti.inc}
{$i jrec.inc} {$i jrec.inc}
@ -482,3 +552,4 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
*****************************************************************************} *****************************************************************************}
end. end.

81
rtl/java/ustringh.inc Normal file
View File

@ -0,0 +1,81 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2005 by Florian Klaempfl,
member of the Free Pascal development team.
This file implements support routines for UnicodeStrings with FPC
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
Function Pos (c : UnicodeChar; Const s : UnicodeString) : 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 : UnicodeString) : UnicodeString;
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);
Type
{ hooks for internationalization
please add new procedures at the end, it makes it easier to detect new procedures }
TUnicodeStringManager = class
collator: JTCollator;
constructor create;
end;
var
widestringmanager : TUnicodeStringManager;
//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);

1843
rtl/java/ustrings.inc Normal file
View File

File diff suppressed because it is too large Load Diff