+ optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)

  * more fixes to m68k for 64-bit operations

compiler/cg64f32.pas

@@ -72,6 +72,13 @@ unit cg64f32;
         procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
         procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
 
+        {# This routine tries to optimize the a_op64_const_reg operation, by
+           removing superfluous opcodes. Returns TRUE if normal processing
+           must continue in op64_const_reg, otherwise, everything is processed
+           entirely in this routine, by emitting the appropriate 32-bit opcodes.
+        }   
+        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;override;
+
         procedure g_rangecheck64(list: taasmoutput; const p: tnode;
           const todef: tdef); override;
       end;
@@ -620,6 +627,98 @@ unit cg64f32;
              end;
       end;
 
+    function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;
+      var
+        lowvalue, highvalue : cardinal;
+        hreg: tregister;
+      begin
+        lowvalue := cardinal(a);
+        highvalue:= a shr 32;
+        { assume it will be optimized out }
+        optimize64_op_const_reg := true;
+        case op of
+        OP_ADD:
+           begin
+             if a = 0 then 
+                exit;
+           end;
+        OP_AND:
+           begin
+              if lowvalue <> high(cardinal) then
+                cg.a_op_const_reg(list,op,lowvalue,reg.reglo);
+              if highvalue <> high(cardinal) then
+                cg.a_op_const_reg(list,op,highvalue,reg.reghi);
+              { already emitted correctly }  
+              exit;
+           end;
+        OP_OR:
+           begin
+              if lowvalue <> 0 then
+                cg.a_op_const_reg(list,op,lowvalue,reg.reglo);
+              if highvalue <> 0 then
+                cg.a_op_const_reg(list,op,highvalue,reg.reghi);
+              { already emitted correctly }  
+              exit;
+           end;
+        OP_SUB:
+           begin
+             if a = 0 then 
+                exit;
+           end;
+        OP_XOR:
+           begin
+           end;
+        OP_SHL:
+           begin
+             if a = 0 then 
+                 exit;
+             { simply clear low-register 
+               and shift the rest and swap
+               registers.
+             }
+             if (a > 31) then
+               begin
+                 cg.a_load_const_reg(list,OS_32,0,reg.reglo);
+                 cg.a_op_const_reg(list,OP_SHL,a mod 32,reg.reghi);
+                 { swap the registers }
+                 hreg := reg.reghi;
+                 reg.reghi := reg.reglo;
+                 reg.reglo := hreg; 
+                 exit;
+               end;
+           end;
+        OP_SHR:   
+           begin
+             if a = 0 then exit;
+             { simply clear high-register 
+               and shift the rest and swap
+               registers.
+             }
+             if (a > 31) then
+               begin
+                 cg.a_load_const_reg(list,OS_32,0,reg.reghi);
+                 cg.a_op_const_reg(list,OP_SHL,a mod 32,reg.reglo);
+                 { swap the registers }
+                 hreg := reg.reghi;
+                 reg.reghi := reg.reglo;
+                 reg.reglo := hreg; 
+                 exit;
+               end;
+           end;
+        OP_IMUL,OP_MUL:
+           begin
+             if a = 1 then exit;
+           end;
+        OP_IDIV,OP_DIV:
+            begin
+             if a = 1 then exit;
+            end;
+        else
+           internalerror(20020817);
+        end;   
+        optimize64_op_const_reg := false;
+      end;
+
 (*
     procedure int64f32_assignment_int64_reg(p : passignmentnode);
 
@@ -633,7 +732,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-08-17 22:09:43  florian
+  Revision 1.27  2002-08-19 18:17:47  carl
+    + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
+    * more fixes to m68k for 64-bit operations
+
+  Revision 1.26  2002/08/17 22:09:43  florian
     * result type handling in tcgcal.pass_2 overhauled
     * better tnode.dowrite
     * some ppc stuff fixed

compiler/cg64f64.pas

@@ -173,6 +173,12 @@ unit cg64f64;
       const todef: tdef);
       begin
       end;
+      
+    function tcg64f64.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;
+     begin
+       { this should be the same routine as optimize_const_reg!!!!!!!! } 
+     end;
+      
 
     procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister64);
 
@@ -190,7 +196,11 @@ unit cg64f64;
 end.
 {
   $Log$
-  Revision 1.3  2002-08-17 22:09:43  florian
+  Revision 1.4  2002-08-19 18:17:48  carl
+    + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
+    * more fixes to m68k for 64-bit operations
+
+  Revision 1.3  2002/08/17 22:09:43  florian
     * result type handling in tcgcal.pass_2 overhauled
     * better tnode.dowrite
     * some ppc stuff fixed

compiler/cgobj.pas

@@ -248,13 +248,15 @@ unit cgobj;
              This routine tries to optimize the const_reg opcode, and should be
              called at the start of a_op_const_reg. It returns the actual opcode
              to emit, and the constant value to emit. If this routine returns
-             FALSE, no instruction should be emitted (.eg : imul reg by 1 )
+             TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
 
              @param(op The opcode to emit, returns the opcode which must be emitted)
              @param(a  The constant which should be emitted, returns the constant which must
-                    be amitted)
-          }
-          function optimize_const_reg(var op: topcg; var a : aword): boolean;virtual;
+                    be emitted)
+             @param(reg The register to emit the opcode with, returns the register with
+                   which the opcode will be emitted)
+          }   
+          function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg: tregister): boolean;virtual;
 
          {#
              This routine is used in exception management nodes. It should
@@ -447,6 +449,19 @@ unit cgobj;
         procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : tparalocation);virtual;abstract;
         procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : tparalocation);virtual;abstract;
 
+        { 
+             This routine tries to optimize the const_reg opcode, and should be
+             called at the start of a_op64_const_reg. It returns the actual opcode
+             to emit, and the constant value to emit. If this routine returns
+             TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
+             
+             @param(op The opcode to emit, returns the opcode which must be emitted)
+             @param(a  The constant which should be emitted, returns the constant which must
+                    be emitted)
+             @param(reg The register to emit the opcode with, returns the register with
+                   which the opcode will be emitted)
+        }   
+        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;virtual;abstract;
 
 
         { override to catch 64bit rangechecks }
@@ -756,21 +771,21 @@ unit cgobj;
       end;
 
 
-    function tcg.optimize_const_reg(var op: topcg; var a : aword): boolean;
+    function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg:tregister): boolean;
       var
         powerval : longint;
       begin
-        optimize_const_reg := true;
+        optimize_op_const_reg := false;
         case op of
           { or with zero returns same result }
-          OP_OR : if a = 0 then optimize_const_reg := false;
+          OP_OR : if a = 0 then optimize_op_const_reg := true;
           { and with max returns same result }
-          OP_AND : if (a = high(a)) then optimize_const_reg := false;
+          OP_AND : if (a = high(a)) then optimize_op_const_reg := true;
           { division by 1 returns result }
           OP_DIV :
             begin
               if a = 1 then
-                optimize_const_reg := false
+                optimize_op_const_reg := true
               else if ispowerof2(int64(a), powerval) then
                 begin
                   a := powerval;
@@ -781,7 +796,7 @@ unit cgobj;
           OP_IDIV:
             begin
               if a = 1 then
-                optimize_const_reg := false
+                optimize_op_const_reg := true
               else if ispowerof2(int64(a), powerval) then
                 begin
                   a := powerval;
@@ -792,7 +807,7 @@ unit cgobj;
         OP_MUL,OP_IMUL:
             begin
                if a = 1 then
-                  optimize_const_reg := false
+                  optimize_op_const_reg := true
                else if ispowerof2(int64(a), powerval) then
                  begin
                    a := powerval;
@@ -802,8 +817,8 @@ unit cgobj;
             end;
         OP_SAR,OP_SHL,OP_SHR:
            begin
-              if a = 1 then
-                 optimize_const_reg := false;
+              if a = 0 then 
+                 optimize_op_const_reg := true;
               exit;
            end;
         end;
@@ -1553,7 +1568,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.52  2002-08-17 22:09:43  florian
+  Revision 1.53  2002-08-19 18:17:48  carl
+    + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
+    * more fixes to m68k for 64-bit operations
+
+  Revision 1.52  2002/08/17 22:09:43  florian
     * result type handling in tcgcal.pass_2 overhauled
     * better tnode.dowrite
     * some ppc stuff fixed

compiler/fpcdefs.inc

@@ -38,7 +38,11 @@
 
 {
   $Log$
-  Revision 1.5  2002-08-15 15:11:53  carl
+  Revision 1.6  2002-08-19 18:17:48  carl
+    + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
+    * more fixes to m68k for 64-bit operations
+
+  Revision 1.5  2002/08/15 15:11:53  carl
     * oldset define is now correct for all cpu's except i386
     * correct compilation problems because of the above
 
@@ -50,3 +54,6 @@
     + log added
 
 }
+
+{ 
+}

compiler/m68k/cgcpu.pas

@@ -30,7 +30,7 @@ unit cgcpu;
        cginfo,cgbase,cgobj,
        aasmbase,aasmtai,aasmcpu,
        cpubase,cpuinfo,cpupara,
-       node,symconst;
+       node,symconst,cg64f32;
 
     type
       tcg68k = class(tcg)
@@ -61,13 +61,7 @@ unit cgcpu;
           { generates overflow checking code for a node }
           procedure g_overflowcheck(list: taasmoutput; const p: tnode); override;
           procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); override;
-          { 
-            This routine should setup the stack frame and allocate @var(localsize) bytes on
-            the local stack (for local variables). It should also setup the frame pointer,
-            so that all variables are now accessed via the frame pointer register.
-          }  
           procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
-          { restores the previous frame pointer at procedure exit }
           procedure g_restore_frame_pointer(list : taasmoutput);override;
           procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
           procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
@@ -85,6 +79,10 @@ unit cgcpu;
      
      end;
 
+     tcg64f68k = class(tcg64f32)
+       procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
+       procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
+     end;
 
      { This function returns true if the reference+offset is valid.
        Otherwise extra code must be generated to solve the reference.
@@ -110,7 +108,7 @@ Implementation
     uses
        globtype,globals,verbose,systems,cutils,
        symdef,symsym,defbase,paramgr,
-       rgobj,tgobj,rgcpu,cg64f32;
+       rgobj,tgobj,rgcpu;
 
          
     const     
@@ -168,7 +166,9 @@ Implementation
            end;
       end;
       
-      
+{****************************************************************************}
+{                               TCG68K                                       }
+{****************************************************************************}
     function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean;
 
        var
@@ -285,7 +285,11 @@ Implementation
       
     procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); 
       begin
-        list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2));
+        { in emulation mode, only 32-bit single is supported }
+        if cs_fp_emulation in aktmoduleswitches then
+          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2))
+        else
+          list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2));
       end;
       
 
@@ -299,7 +303,11 @@ Implementation
         if opsize = S_FX then
           internalerror(20020729);
         fixref(list,href);    
-        list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
+        { in emulation mode, only 32-bit single is supported }
+        if cs_fp_emulation in aktmoduleswitches then
+           list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
+        else
+           list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
       end;
       
     procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); 
@@ -310,7 +318,11 @@ Implementation
         { extended is not supported, since it is not available on Coldfire }
         if opsize = S_FX then
           internalerror(20020729);
-        list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
+        { in emulation mode, only 32-bit single is supported }
+        if cs_fp_emulation in aktmoduleswitches then
+          list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
+        else
+          list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
       end;
       
     procedure tcg68k.a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); 
@@ -341,7 +353,7 @@ Implementation
        opcode : tasmop;
       begin
         { need to emit opcode? }
-        if not optimize_const_reg(op, a) then
+        if optimize_op_const_reg(list, op, a, reg) then
            exit;
         opcode := topcg2tasmop[op];
         case op of
@@ -1100,15 +1112,133 @@ Implementation
          list.concat(ai);
        end;
 
-
+{****************************************************************************}
+{                               TCG64F68K                                    }
+{****************************************************************************}
+ procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
+  var
+   hreg1, hreg2 : tregister;
+   opcode : tasmop;
+  begin
+    opcode := topcg2tasmop[op];
+    case op of
+      OP_ADD :  
+         begin
+            { if one of these three registers is an address
+              register, we'll really get into problems!
+            }
+            if rg.isaddressregister(regdst.reglo) or
+               rg.isaddressregister(regdst.reghi) or
+               rg.isaddressregister(regsrc.reghi) then
+                 internalerror(20020817);
+            list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo));
+            list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi));
+         end;
+      OP_AND,OP_OR :
+          begin
+            { at least one of the registers must be a data register }
+            if (rg.isaddressregister(regdst.reglo) and
+                rg.isaddressregister(regsrc.reglo)) or
+               (rg.isaddressregister(regsrc.reghi) and
+                rg.isaddressregister(regdst.reghi))
+               then
+                 internalerror(20020817);
+            cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
+            cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
+          end;
+      { this is handled in 1st pass for 32-bit cpu's (helper call) }
+      OP_IDIV,OP_DIV, 
+      OP_IMUL,OP_MUL: internalerror(2002081701); 
+      { this is also handled in 1st pass for 32-bit cpu's (helper call) }
+      OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
+      OP_SUB:
+         begin
+            { if one of these three registers is an address
+              register, we'll really get into problems!
+            }
+            if rg.isaddressregister(regdst.reglo) or
+               rg.isaddressregister(regdst.reghi) or
+               rg.isaddressregister(regsrc.reghi) then
+                 internalerror(20020817);
+            list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo));
+            list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi));
+         end;
+      OP_XOR:
+        begin
+            if rg.isaddressregister(regdst.reglo) or
+               rg.isaddressregister(regsrc.reglo) or
+               rg.isaddressregister(regsrc.reghi) or
+               rg.isaddressregister(regdst.reghi) then
+                 internalerror(20020817);
+            list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo));
+            list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi));
+        end;
+    end; { end case }
+  end;
+  
+  
+ procedure tcg64f68k.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
+  var
+   lowvalue : cardinal;
+   highvalue : cardinal;
+  begin
+    { is it optimized out ? }
+    if optimize64_op_const_reg(list,op,value,reg) then
+       exit;
+    
+    lowvalue := cardinal(value);
+    highvalue:= value shr 32;
+    
+   { the destination registers must be data registers }
+   if  rg.isaddressregister(reg.reglo) or
+       rg.isaddressregister(reg.reghi) then
+         internalerror(20020817);
+   case op of      
+      OP_ADD :  
+         begin
+            list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,reg.reglo));
+            list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,reg.reglo));
+         end;
+      OP_AND :
+          begin
+            { should already be optimized out }
+            internalerror(2002081801);
+          end;
+      OP_OR :
+          begin
+            { should already be optimized out }
+            internalerror(2002081802);
+          end;
+      { this is handled in 1st pass for 32-bit cpu's (helper call) }
+      OP_IDIV,OP_DIV, 
+      OP_IMUL,OP_MUL: internalerror(2002081701); 
+      { this is also handled in 1st pass for 32-bit cpu's (helper call) }
+      OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
+      OP_SUB:
+         begin
+            list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,reg.reglo));
+            list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,reg.reglo));
+         end;
+      OP_XOR:
+        begin
+            list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,reg.reglo));
+            list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,reg.reglo));
+        end;
+    end; { end case }    
+  end;
+  
 begin
   cg := tcg68k.create;
-  cg64 :=tcg64f32.create;
+  cg64 :=tcg64f68k.create;
 end.
 
 { 
   $Log$
-  Revision 1.4  2002-08-16 14:24:59  carl
+  Revision 1.5  2002-08-19 18:17:48  carl
+    + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
+    * more fixes to m68k for 64-bit operations
+
+  Revision 1.4  2002/08/16 14:24:59  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     + ret_in_reg to replace ret_in_acc
       (fix some register allocation bugs at the same time)