+ generic int_to_real type conversion

+ generic unaryminus node

compiler/ncgmat.pas

@@ -0,0 +1,198 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate generic mathematical nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgmat;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,nmat,cpubase,cgbase,cginfo;
+
+type
+      tcgunaryminusnode = class(tunaryminusnode)
+         procedure pass_2;override;
+         { This routine is called to change the sign of the 
+           floating point value in the floating point 
+           register r.
+           
+           This routine should be overriden, since
+           the generic version is not optimal at all. The
+           generic version assumes that floating
+           point values are stored in the register
+           in IEEE-754 format.
+         }  
+         procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
+      end;
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
+      pass_1,pass_2,
+      ncon,
+      cpuinfo,
+      tgobj,ncgutil,cgobj,rgobj,rgcpu,cg64f32;
+
+{*****************************************************************************
+                          TCGUNARYMINUSNODE
+*****************************************************************************}
+    procedure tcgunaryminusnode.emit_float_sign_change(r: tregister; _size : tcgsize);
+     var
+       href : treference;
+       hreg : tregister;
+      begin
+        { get a temporary memory reference to store the floating
+          point value
+        }
+        tg.gettempofsizereference(exprasmlist,tcgsize2size[_size],href);
+        { store the floating point value in the temporary memory area }
+        cg.a_loadfpu_reg_ref(exprasmlist,_size,r,href);
+        { only single and double ieee are supported }
+        if _size = OS_F64 then
+          begin
+            { on little-endian machine the most significant
+              32-bit value is stored at the highest address
+            }  
+            if target_info.endian = endian_little then
+              inc(href.offset,4);
+          end
+        else 
+        if _size <> OS_F32 then
+           internalerror(20020814);
+        hreg := rg.getregisterint(exprasmlist);
+        { load value }
+        cg.a_load_ref_reg(exprasmlist,OS_32,href,hreg);
+        { bitwise complement copied value }
+        cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_32,hreg,hreg);
+        { sign-bit is bit 31/63 of single/double }
+        cg.a_op_const_reg(exprasmlist,OP_AND,$80000000,hreg);
+        { or with value in reference memory }
+        cg.a_op_reg_ref(exprasmlist,OP_OR,OS_32,hreg,href);
+        rg.ungetregister(exprasmlist,hreg);
+        { store the floating point value in the temporary memory area }
+        if _size = OS_F64 then
+          begin
+            { on little-endian machine the most significant
+              32-bit value is stored at the highest address
+            }  
+            if target_info.endian = endian_little then
+              dec(href.offset,4);
+          end;
+        cg.a_loadfpu_ref_reg(exprasmlist,_size,href,r);
+      end;
+
+
+    procedure tcgunaryminusnode.pass_2;
+
+
+      begin
+         if is_64bitint(left.resulttype.def) then
+           begin
+              secondpass(left);
+
+              { load left operator in a register }
+              location_copy(location,left.location);
+              location_force_reg(exprasmlist,location,OS_64,false);
+              cg64.a_op64_loc_reg(exprasmlist,OP_NEG,
+                 location,joinreg64(location.registerlow,location.registerhigh));
+           end
+         else
+           begin
+              secondpass(left);
+              location_reset(location,LOC_REGISTER,OS_INT);
+              case left.location.loc of
+                 LOC_REGISTER:
+                   begin
+                      location.register:=left.location.register;
+                      cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
+                         location.register);
+                   end;
+                 LOC_CREGISTER:
+                   begin
+                      location.register:=rg.getregisterint(exprasmlist);
+                      cg.a_load_reg_reg(exprasmlist,OS_INT,left.location.register,
+                        location.register);
+                      cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
+                         location.register);
+                   end;
+                 LOC_REFERENCE,
+                 LOC_CREFERENCE:
+                   begin
+                      reference_release(exprasmlist,left.location.reference);
+                      if (left.resulttype.def.deftype=floatdef) then
+                        begin
+                           location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
+                           location.register:=rg.getregisterfpu(exprasmlist);
+                           cg.a_loadfpu_ref_reg(exprasmlist,
+                              def_cgsize(left.resulttype.def),
+                              left.location.reference,location.register);
+                           emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));   
+                        end
+                      else
+                        begin
+                           location.register:=rg.getregisterint(exprasmlist);
+                           { why is the size is OS_INT, since in pass_1 we convert
+                             everything to a signed natural value anyways
+                           }  
+                           cg.a_load_ref_reg(exprasmlist,OS_INT,
+                               left.location.reference,location.register);
+                           cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
+                               location.register);
+                        end;
+                   end;
+                 LOC_FPUREGISTER:
+                   begin
+                      location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
+                      location.register:=left.location.register;
+                      emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));   
+                   end;
+                 LOC_CFPUREGISTER:
+                   begin
+                      location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
+                      location.register:=rg.getregisterfpu(exprasmlist);
+                      cg.a_loadfpu_reg_reg(exprasmlist,left.location.register,location.register);
+                      emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));   
+                   end;
+                 else
+                    internalerror(200203225);
+              end;
+           end;
+      end;
+
+
+
+
+begin
+   cunaryminusnode:=tcgunaryminusnode;
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-14 19:26:55  carl
+    + generic int_to_real type conversion
+    + generic unaryminus node
+
+}

compiler/ncnv.pas

@@ -263,10 +263,10 @@ implementation
 
         procedure do_set(pos : longint);
 
-	{$ifdef oldset}
+  {$ifdef oldset}
         var
           mask,l : longint;
-	{$endif}
+  {$endif}
 
         begin
           if (pos and not $ff)<>0 then
@@ -275,7 +275,7 @@ implementation
            constsethi:=pos;
           if pos<constsetlo then
            constsetlo:=pos;
-	{$ifdef oldset}
+  {$ifdef oldset}
           { to do this correctly we use the 32bit array }
           l:=pos shr 5;
           mask:=1 shl (pos mod 32);
@@ -283,9 +283,9 @@ implementation
           if (pconst32bitset(constset)^[l] and mask)<>0 then
            Message(parser_e_illegal_set_expr);
           pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask;
-	{$else}
+  {$else}
-	  include(constset^,pos);
+    include(constset^,pos);
-	{$endif}
+  {$endif}
         end;
 
       var
@@ -295,11 +295,11 @@ implementation
       begin
         if p.nodetype<>arrayconstructorn then
          internalerror(200205105);
-	new(constset);
+  new(constset);
       {$ifdef oldset}
         FillChar(constset^,sizeof(constset^),0);
       {$else}
-	constset^:=[];
+  constset^:=[];
       {$endif}
         htype.reset;
         constsetlo:=0;
@@ -964,7 +964,7 @@ implementation
                begin
                  if is_procsym_call(left) then
                   begin
-		    currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
+        currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
                     hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
                         currprocdef,tcallnode(left).symtableproc);
                     if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
@@ -1354,28 +1354,47 @@ implementation
       end;
 
 
-    function ttypeconvnode.first_int_to_real : tnode;
+    function ttypeconvnode.first_int_to_real: tnode;
-
+      var
+        fname: string[19];
+        typname : string[12];  
       begin
-        first_int_to_real:=nil;
+        { Get the type name  }
-{$ifdef m68k}
+        {  Normally the typename should be one of the following:
-         if (cs_fp_emulation in aktmoduleswitches) or
+            single, double - carl
-            (tfloatdef(resulttype.def).typ=s32real) then
+        }    
-           begin
+        typname := lower(pbestrealtype^.def.gettypename);   
-             if registers32<1 then
+        { converting a 64bit integer to a float requires a helper }
-               registers32:=1;
+        if is_64bitint(left.resulttype.def) then
-           end
+          begin
-         else
+            if is_signed(left.resulttype.def) then
-           if registersfpu<1 then
+              fname := 'fpc_int64_to_'+typname
-             registersfpu:=1;
+            else
-{$else not m68k}
+              fname := 'fpc_qword_to_'+typname;
-         if registersfpu<1 then
+            result := ccallnode.createintern(fname,ccallparanode.create(
-          registersfpu:=1;
+              left,nil));
-{$endif not m68k}
+            left:=nil;
-        location.loc:=LOC_FPUREGISTER;
+            firstpass(result);
+            exit;
+          end
+        else
+          { other integers are supposed to be 32 bit }
+          begin
+            if is_signed(left.resulttype.def) then
+              fname := 'fpc_longint_to_'+typname
+            else
+              fname := 'fpc_cardinal_to_'+typname;
+            result := ccallnode.createintern(fname,ccallparanode.create(
+              left,nil));
+            left:=nil;
+            firstpass(result);
+            exit;
+          end;
       end;
 
 
+
+
     function ttypeconvnode.first_real_to_real : tnode;
       begin
          first_real_to_real:=nil;
@@ -1920,7 +1939,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.68  2002-08-11 16:08:55  florian
+  Revision 1.69  2002-08-14 19:26:55  carl
+    + generic int_to_real type conversion
+    + generic unaryminus node
+
+  Revision 1.68  2002/08/11 16:08:55  florian
     + support of explicit type case boolean->char
 
   Revision 1.67  2002/08/11 15:28:00  florian

compiler/nmat.pas

@@ -59,8 +59,8 @@ interface
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        {$ifdef state_tracking}
-	  function track_state_pass(exec_known:boolean):boolean;override;
+    function track_state_pass(exec_known:boolean):boolean;override;
-	{$endif}
+  {$endif}
        end;
        tnotnodeclass = class of tnotnode;
 
@@ -486,7 +486,7 @@ implementation
               if (left.location.loc<>LOC_REGISTER) and
                  (registersfpu<1) then
                 registersfpu:=1;
-              location.loc:=LOC_REGISTER;
+              location.loc:=LOC_FPUREGISTER;
            end
 {$ifdef SUPPORT_MMX}
          else if (cs_mmx in aktlocalswitches) and
@@ -519,7 +519,7 @@ implementation
  ****************************************************************************}
 
     const boolean_reverse:array[ltn..unequaln] of Tnodetype=
-	(gten,gtn,lten,ltn,unequaln,equaln);
+  (gten,gtn,lten,ltn,unequaln,equaln);
 
     constructor tnotnode.create(expr : tnode);
 
@@ -541,25 +541,25 @@ implementation
 
          resulttype:=left.resulttype;
 
-	 {Try optmimizing ourself away.}
+   {Try optmimizing ourself away.}
-	 if left.nodetype=notn then
+   if left.nodetype=notn then
-	    begin
+      begin
-		{Double not. Remove both.}
+    {Double not. Remove both.}
-		t:=Tnotnode(left).left;
+    t:=Tnotnode(left).left;
-		Tnotnode(left).left:=nil;
+    Tnotnode(left).left:=nil;
-		left:=t;
+    left:=t;
-		result:=t;
+    result:=t;
-		exit;
+    exit;
-	    end;
+      end;
-	 if left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten] then
+   if left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten] then
-	    begin
+      begin
-		{Not of boolean expression. Turn around the operator and remove
+    {Not of boolean expression. Turn around the operator and remove
-		 the not.}
+     the not.}
-		result:=left;
+    result:=left;
-		left.nodetype:=boolean_reverse[left.nodetype];
+    left.nodetype:=boolean_reverse[left.nodetype];
-		left:=nil;
+    left:=nil;
-		exit;
+    exit;
-	    end;
+      end;
 
          { constant folding }
          if (left.nodetype=ordconstn) then
@@ -701,12 +701,12 @@ implementation
     function Tnotnode.track_state_pass(exec_known:boolean):boolean;
 
     begin
-	track_state_pass:=true;
+  track_state_pass:=true;
-	if left.track_state_pass(exec_known) then
+  if left.track_state_pass(exec_known) then
-	    begin
+      begin
-		left.resulttype.def:=nil;
+    left.resulttype.def:=nil;
-		do_resulttypepass(left);
+    do_resulttypepass(left);
-	    end;
+      end;
     end;
 {$endif}
 
@@ -718,7 +718,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-07-20 11:57:54  florian
+  Revision 1.37  2002-08-14 19:26:55  carl
+    + generic int_to_real type conversion
+    + generic unaryminus node
+
+  Revision 1.36  2002/07/20 11:57:54  florian
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added