+ support for qword div/mod via helper (the JVM only supports signed

64 bit division natively)

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

.gitattributes

@@ -7354,6 +7354,7 @@ rtl/java/compproc.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/jdynarrh.inc svneol=native#text/plain
+rtl/java/jint64.inc svneol=native#text/plain
 rtl/java/jmathh.inc svneol=native#text/plain
 rtl/java/jrec.inc svneol=native#text/plain
 rtl/java/jrech.inc svneol=native#text/plain

compiler/jvm/njvmmat.pas

@@ -30,6 +30,9 @@ interface
 
     type
       tjvmmoddivnode = class(tmoddivnode)
+        protected
+          function use_moddiv64bitint_helper: boolean; override;
+        public
          procedure pass_generate_code;override;
       end;
 
@@ -62,6 +65,16 @@ implementation
                              tjvmmoddivnode
 *****************************************************************************}
 
+    function tjvmmoddivnode.use_moddiv64bitint_helper: boolean;
+      begin
+        result:=
+          (left.resultdef.typ=orddef) and
+          (right.resultdef.typ=orddef) and
+          ((torddef(left.resultdef).ordtype=u64bit) or
+           (torddef(right.resultdef).ordtype=u64bit));
+      end;
+
+
     procedure tjvmmoddivnode.pass_generate_code;
       var
         op: topcg;

compiler/nmat.pas

@@ -34,11 +34,10 @@ interface
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean) : tnode;override;
          protected
-{$ifndef cpu64bitalu}
           { override the following if you want to implement }
           { parts explicitely in the code generator (JM)    }
+          function use_moddiv64bitint_helper: boolean; virtual;
           function first_moddiv64bitint: tnode; virtual;
-{$endif not cpu64bitalu}
           function firstoptimize: tnode; virtual;
           function first_moddivint: tnode; virtual;
        end;
@@ -150,6 +149,22 @@ implementation
       end;
 
 
+    function tmoddivnode.use_moddiv64bitint_helper: boolean;
+      begin
+        { not with an ifdef around the call to this routine, because e.g. the
+          Java VM has a signed 64 bit division opcode, but not an unsigned
+          one }
+{$ifdef cpu64bitalu}
+        result:=false;
+{$else cpu64bitalu}
+        result:=
+          (left.resultdef.typ=orddef) and
+          (right.resultdef.typ=orddef) and
+          (is_64bitint(left.resultdef) or is_64bitint(right.resultdef));
+{$endif cpu64bitaly}
+      end;
+
+
     function tmoddivnode.pass_typecheck:tnode;
       var
         hp,t : tnode;
@@ -322,7 +337,6 @@ implementation
 {$endif cpuneedsdiv32helper}
 
 
-{$ifndef cpu64bitalu}
     function tmoddivnode.first_moddiv64bitint: tnode;
       var
         procname: string[31];
@@ -355,7 +369,6 @@ implementation
         right := nil;
         firstpass(result);
       end;
-{$endif not cpu64bitalu}
 
 
     function tmoddivnode.firstoptimize: tnode;
@@ -429,11 +442,8 @@ implementation
          if assigned(result) then
            exit;
 
-{$ifndef cpu64bitalu}
          { 64bit }
-         if (left.resultdef.typ=orddef) and
+         if use_moddiv64bitint_helper then
-            (right.resultdef.typ=orddef) and
-            (is_64bitint(left.resultdef) or is_64bitint(right.resultdef)) then
            begin
              result := first_moddiv64bitint;
              if assigned(result) then
@@ -441,7 +451,6 @@ implementation
              expectloc:=LOC_REGISTER;
            end
          else
-{$endif not cpu64bitalu}
            begin
              result := first_moddivint;
              if assigned(result) then

rtl/java/compproc.inc

@@ -528,10 +528,10 @@ 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;

rtl/java/jint64.inc

@@ -0,0 +1,51 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    This file contains some helper routines for qword
+
+    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.
+
+ **********************************************************************}
+{$Q- no overflow checking }
+{$R- no range checking }
+
+{$ifndef FPC_SYSTEM_HAS_DIV_QWORD}
+    function fpc_div_qword(n,z : qword) : qword; compilerproc;
+      var
+        signmask, tmpz: qword;
+        tmpq, rest: int64;
+      begin
+        { emulate unsigned division using signed division, see
+          http://hackers-delight.org.ua/060.htm }
+         signmask:=qword(not(SarInt64(int64(n),63)));
+         tmpz:=z and signmask;
+         tmpq:=(int64(tmpz shr 1) div int64(n)) * 2;
+         rest:=z-tmpq*n;
+         fpc_div_qword:=tmpq+ord(rest>=n);
+      end;
+{$endif FPC_SYSTEM_HAS_DIV_QWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_MOD_QWORD}
+    function fpc_mod_qword(n,z : qword) : qword; compilerproc;
+      var
+        signmask, tmpz: qword;
+        tmpq: int64;
+      begin
+        { emulate unsigned division using signed division, see
+          http://hackers-delight.org.ua/060.htm }
+         signmask:=qword(not(SarInt64(int64(n),63)));
+         tmpz:=z and signmask;
+         tmpq:=(int64(tmpz shr 1) div int64(n)) * 2;
+         fpc_mod_qword:=z-tmpq*n;
+         if fpc_mod_qword>=n then
+           dec(fpc_mod_qword,n);
+      end;
+{$endif FPC_SYSTEM_HAS_MOD_QWORD}
+

rtl/java/system.pp

@@ -269,6 +269,7 @@ function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_s
 {$i ustrings.inc}
 {$i rtti.inc}
 {$i jrec.inc}
+{$i jint64.inc}
 
 function min(a,b : longint) : longint;
   begin