Переглянути джерело

Add FillWord procedures and implement unicode StringOfChar for JVM cpu

Pierre Muller 3 роки тому
батько
коміт
74c97e8928
3 змінених файлів з 116 додано та 2 видалено
  1. 33 0
      rtl/java/jsystemh.inc
  2. 15 0
      rtl/java/justrings.inc
  3. 68 2
      rtl/jvm/jvm.inc

+ 33 - 0
rtl/java/jsystemh.inc

@@ -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 - 0
rtl/java/justrings.inc

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

+ 68 - 2
rtl/jvm/jvm.inc

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