paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 17:47:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

Add FillWord procedures and implement unicode StringOfChar for JVM cpu

Browse Source 
(cherry picked from commit 74c97e8928)
This commit is contained in:
Pierre Muller 2022-01-07 22:58:36 +00:00
parent 8731c5f7fd
commit 48f68cbeed
3 changed files with 116 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
rtl/java/jsystemh.inc
View File

@ -108,6 +108,39 @@ procedure fillchar(var arr: array of qword; len: sizeint; val: boolean); externa
procedure fillchar(var arr: array of qword; len: sizeint; val: ansichar); external;
procedure fillchar(var arr: array of qword; len: sizeint; val: jbyte); external;
procedure fillword(var arr: array of jshort; len: sizeint; val: word);
procedure fillword(var arr: array of jshort; len: sizeint; val: boolean);
procedure fillword(var arr: array of jshort; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of jshort; len: sizeint; val: jshort); external;
procedure fillword(var arr: array of word; len: sizeint; val: word); external;
procedure fillword(var arr: array of word; len: sizeint; val: boolean); external;
procedure fillword(var arr: array of word; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of word; len: sizeint; val: jshort); external;
{ widechar maps to a different signature }
procedure fillword(var arr: array of widechar; len: sizeint; val: word);
procedure fillword(var arr: array of widechar; len: sizeint; val: boolean);
procedure fillword(var arr: array of widechar; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of widechar; len: sizeint; val: jshort); external;
procedure fillword(var arr: array of jint; len: sizeint; val: word);
procedure fillword(var arr: array of jint; len: sizeint; val: boolean);
procedure fillword(var arr: array of jint; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of jint; len: sizeint; val: jshort); external;
procedure fillword(var arr: array of dword; len: sizeint; val: word); external;
procedure fillword(var arr: array of dword; len: sizeint; val: boolean); external;
procedure fillword(var arr: array of dword; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of dword; len: sizeint; val: jshort); external;
procedure fillword(var arr: array of jlong; len: sizeint; val: word);
procedure fillword(var arr: array of jlong; len: sizeint; val: boolean);
procedure fillword(var arr: array of jlong; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of jlong; len: sizeint; val: jshort); external;
procedure fillword(var arr: array of qword; len: sizeint; val: word); external;
procedure fillword(var arr: array of qword; len: sizeint; val: boolean); external;
procedure fillword(var arr: array of qword; len: sizeint; val: widechar); external;
procedure fillword(var arr: array of qword; len: sizeint; val: jshort); external;
function IndexChar(const buf: array of boolean;len:SizeInt;b:ansichar):SizeInt;
function IndexChar(const buf: array of jbyte;len:SizeInt;b:ansichar):SizeInt;

15
rtl/java/justrings.inc
View File

@ -177,6 +177,21 @@ begin
result:=JLString.Create(TJCharArray(p),0,Size);
end;
{$define FPC_HAS_UNICODESTR_OF_CHAR}
Function StringOfChar(c : Unicodechar;l : SizeInt) : UnicodeString;
var
arr : array of jchar;
begin
if l>0 then
begin
SetLength(arr,l);
FillWord(arr,l,word(c));
Setlength(StringOfChar,l);
StringOfChar:=JLString.Create(TJCharArray(arr),0,l);
end
else
StringOfChar:='';
end;
{ lie, not used by compiler }
{$define FPC_HAS_PUNICODECHAR_TO_SHORTSTR}

70
rtl/jvm/jvm.inc
View File

@ -175,12 +175,78 @@ procedure fillchar(var arr: array of jlong; len: sizeint; val: boolean);
fillchar(arr,len,jbyte(val));
end;
{$pop}
{$define FPC_SYSTEM_HAS_FILLWORD}
procedure fillword(var arr: array of jshort; len: sizeint; val: word);
begin
JUArrays.fill(arr,0,len,jshort(val));
end;
procedure fillword(var arr: array of jshort; len: sizeint; val: boolean);
begin
fillword(arr,len,jshort(jbyte(val)));
end;
{ widechar maps to a different signature }
procedure fillword(var arr: array of widechar; len: sizeint; val: word);
var
w : widechar;
begin
w:=widechar(val);
JUArrays.fill(arr,0,len,w);
end;
procedure fillword(var arr: array of widechar; len: sizeint; val: boolean);
begin
fillword(arr,len,jshort(jbyte(val)));
end;
procedure fillword(var arr: array of jint; len: sizeint; val: word);
var
d, dmask: jint;
begin
d:=cardinal(val shl 16) or val;
JUArrays.fill(arr,0,len div 2,d);
len:=len and 1;
if len<>0 then
begin
dmask:=not((1 shl (32-8*len))-1);
d:=d and dmask;
arr[len shr 2+1]:=(arr[len shr 2+1] and not(dmask)) or d;
end;
end;
procedure fillword(var arr: array of jint; len: sizeint; val: boolean);
begin
fillword(arr,len,jshort(jbyte(val)));
end;
procedure fillword(var arr: array of jlong; len: sizeint; val: word);
var
i, imask: jlong;
begin
i:=cardinal(val shl 16) or val;
i:=(i shl 32) or i;
JUArrays.fill(arr,0,len shr 2,i);
len:=len and 3;
if len<>0 then
begin
imask:=not((1 shl (32-8*len))-1);
i:=i and imask;
arr[len shr 2+1]:=(arr[len shr 2+1] and not(imask)) or i;
end;
end;
procedure fillword(var arr: array of jlong; len: sizeint; val: boolean);
begin
fillword(arr,len,jshort(jbyte(val)));
end;
{$define FPC_SYSTEM_HAS_FILLDWORD}
{$define FPC_SYSTEM_HAS_FILLQWORD}
{$pop}
{$define FPC_SYSTEM_HAS_INDEXBYTE}
function IndexByte(const buf: array of jbyte;len:SizeInt;b:jbyte):SizeInt;