+ started to implement FPU support for the ARM

  * fixed a lot of other things

compiler/arm/aasmcpu.pas

@@ -39,6 +39,7 @@ uses
 
     type
       taicpu = class(taicpu_abstract)
+         roundingmode : troundingmode;
          procedure loadshifterop(opidx:longint;const so:tshifterop);
          constructor op_none(op : tasmop);
 
@@ -48,7 +49,6 @@ uses
          constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
          constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
          constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
-         constructor op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
 
          constructor op_const_const(op : tasmop;_op1,_op2 : longint);
 
@@ -164,16 +164,6 @@ implementation
          loadconst(1,aword(_op2));
       end;
 
-     constructor taicpu.op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
-      begin
-         inherited create(op);
-         if (_op2.enum = R_INTREGISTER) and (_op2.number = NR_NO) then
-           internalerror(2003031209);
-         ops:=2;
-         loadconst(0,aword(_op1));
-         loadreg(1,_op2);
-      end;
-
 
     constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
       begin
@@ -751,7 +741,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2003-08-24 12:27:26  florian
+  Revision 1.4  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.3  2003/08/24 12:27:26  florian
     * continued to work on the arm port
 
   Revision 1.2  2003/08/20 15:50:12  florian

compiler/arm/cgcpu.pas

@@ -92,16 +92,6 @@ unit cgcpu;
 
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
 
-      private
-
-        procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
-        procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
-        procedure g_stackframe_entry_aix(list : taasmoutput;localsize : longint);
-        procedure g_return_from_proc_aix(list : taasmoutput;parasize : aword);
-        procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
-        procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword);
-
-
         procedure a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
                     ref: treference);
 
@@ -132,6 +122,8 @@ unit cgcpu;
                            C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
     }
 
+   function is_shifter_const(d : dword;var imm_shift : byte) : boolean;
+
   implementation
 
 
@@ -386,6 +378,7 @@ unit cgcpu;
 
      procedure tcgarm.a_jmp_always(list : taasmoutput;l: tasmlabel);
        begin
+         list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(l.name)));
        end;
 
 
@@ -459,36 +452,6 @@ unit cgcpu;
        end;
 
 
-     procedure tcgarm.g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
-       begin
-       end;
-
-
-     procedure tcgarm.g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
-       begin
-       end;
-
-
-     procedure tcgarm.g_stackframe_entry_aix(list : taasmoutput;localsize : longint);
-       begin
-       end;
-
-
-     procedure tcgarm.g_return_from_proc_aix(list : taasmoutput;parasize : aword);
-       begin
-       end;
-
-
-     procedure tcgarm.g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
-       begin
-       end;
-
-
-     procedure tcgarm.g_return_from_proc_mac(list : taasmoutput;parasize : aword);
-       begin
-       end;
-
-
      { contains the common code of a_load_reg_ref and a_load_ref_reg }
      procedure tcgarm.a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
                  ref: treference);
@@ -530,7 +493,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2003-08-24 12:27:26  florian
+  Revision 1.5  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.4  2003/08/24 12:27:26  florian
     * continued to work on the arm port
 
   Revision 1.3  2003/08/21 03:14:00  florian

compiler/arm/cpubase.pas

@@ -56,8 +56,13 @@ uses
               A_SBC,A_SMLAL,A_SMULL,A_SMUL,
               A_SMULW,A_STC,A_STC2,A_STM,A_STR,A_STRB,A_STRBT,A_STRD,
               A_STRH,A_STRT,A_SUB,A_SWI,A_SWP,A_SWPB,A_TEQ,A_TST,
-              A_UMLAL,A_UMULL
-              { FPA coprocessor codes }
+              A_UMLAL,A_UMULL,
+              { FPA coprocessor instructions }
+              A_LDF,A_STF,A_LFM,A_SFM,A_FLT,A_FIX,A_WFS,A_RFS,A_RFC,
+              A_ADF,A_DVF,A_FDV,A_FML,A_FRD,A_MUF,A_POL,A_PW,A_RDF,
+              A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS,
+              A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_NRM,A_RND,A_SIN,A_SQT,A_TAN,A_URD,
+              A_CMF,A_CNF
               { VPA coprocessor codes }
               );
 
@@ -188,19 +193,29 @@ uses
         in this enumeration
       }
       TOpPostfix = (PF_None,
-        { update condition flags }
+        { update condition flags
+          or floating point single }
         PF_S,
+        { floating point size }
+        PF_D,PF_E,PF_P,FP_EP,
         { load/store }
         PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
         { multiple load/store address modes }
         PF_IA,PF_IB,PF_DA,PF_DB,PF_DF,PF_FA,PF_ED,PF_EA
       );
+
+      TRoundingMode = (RM_None,RM_P,RM_M,RM_Z);
+
     const
       oppostfix2str : array[TOpPostfix] of string[2] = ('',
         's',
+        'd','e','p','ep',
         'b','sb','bt','h','sh','t',
         'ia','ib','da','db','df','fa','ed','ea');
 
+      roundingmode2str : array[TRoundingMode] of string[1] = ('',
+        'p','m','z');
+
 {*****************************************************************************
                                 Conditions
 *****************************************************************************}
@@ -434,8 +449,13 @@ uses
                 'sbc','smlal','smull','smul',
                 'smulw','stc','stc2','stm','str','strb','strbt','strd',
                 'strh','strt','sub','swi','swp','swpb','teq','tst',
-                'umlal','umull'
+                'umlal','umull',
                 { FPA coprocessor codes }
+                'ldf','stf','lfm','sfm','flt','fix','wfs','rfs','rfc',
+                'adf','dvf','fdv','fml','frd','muf','pol','pw','rdf',
+                'rmf','rpw','rsf','suf','abs','acs','asn','atn','cos',
+                'exp','log','lgn','mvf','mnf','nrm','rnd','sin','sqt','tan','urd',
+                'cmf','cnf'
                 { VPA coprocessor codes }
                 );
 
@@ -640,7 +660,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2003-08-24 12:27:26  florian
+  Revision 1.7  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.6  2003/08/24 12:27:26  florian
     * continued to work on the arm port
 
   Revision 1.5  2003/08/21 03:14:00  florian

compiler/arm/cpuinfo.pas

@@ -45,6 +45,15 @@ Type
        armv4
       );
 
+   tfputype =
+     (no_fpuprocessor,
+      fpu_soft,
+      fpu_fpa,
+      fpu_fpa10,
+      fpu_fpa11,
+      fpu_vfp
+     );
+
 Const
    {# Size of native extended floating point type }
    extended_size = 8;
@@ -66,6 +75,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.1  2003-07-21 16:35:30  florian
+  Revision 1.2  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.1  2003/07/21 16:35:30  florian
     * very basic stuff for the arm
 }

compiler/arm/cpunode.pas

@@ -30,7 +30,7 @@ unit cpunode;
 
     uses
        { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)
@@ -43,7 +43,11 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.4  2003-08-24 12:27:26  florian
+  Revision 1.5  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.4  2003/08/24 12:27:26  florian
     * continued to work on the arm port
 
   Revision 1.3  2003/08/21 23:24:08  florian

compiler/arm/narmadd.pas

@@ -36,10 +36,9 @@ interface
        protected
           procedure second_addfloat;override;
           procedure second_cmpfloat;override;
-          procedure second_cmpboolean;override;
+          procedure second_cmpordinal;override;
           procedure second_cmpsmallset;override;
           procedure second_cmp64bit;override;
-          procedure second_cmpordinal;override;
        end;
 
   implementation
@@ -124,40 +123,53 @@ interface
       var
         op : TAsmOp;
       begin
-        { we will see what instruction set we'll use on the arm for FP
-        pass_left_right;
-        if (nf_swaped in flags) then
-          swapleftright;
-
-        case nodetype of
-          addn :
-            op:=A_FADDs;
-          muln :
-            op:=A_FMULs;
-          subn :
-            op:=A_FSUBs;
-          slashn :
-            op:=A_FDIVs;
-          else
-            internalerror(200306014);
+        case aktfputype of
+           fpu_fpa,
+           fpu_fpa10,
+           fpu_fpa11:
+             begin
+               { we will see what instruction set we'll use on the arm for FP
+               pass_left_right;
+               if (nf_swaped in flags) then
+                 swapleftright;
+
+               case nodetype of
+                 addn :
+                   op:=A_FADDs;
+                 muln :
+                   op:=A_FMULs;
+                 subn :
+                   op:=A_FSUBs;
+                 slashn :
+                   op:=A_FDIVs;
+                 else
+                   internalerror(200306014);
+               end;
+
+               { force fpureg as location, left right doesn't matter
+                 as both will be in a fpureg }
+               location_force_fpureg(exprasmlist,left.location,true);
+               location_force_fpureg(exprasmlist,right.location,(left.location.loc<>LOC_CFPUREGISTER));
+
+               location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
+               if left.location.loc<>LOC_CFPUREGISTER then
+                 location.register:=left.location.register
+               else
+                 location.register:=right.location.register;
+
+               exprasmlist.concat(taicpu.op_reg_reg_reg(op,
+                  left.location.register,right.location.register,location.register));
+
+               release_reg_left_right;
+               }
+               location.loc:=LOC_FPUREGISTER;
+             end;
+           fpu_soft:
+             { this case should be handled already by pass1 }
+             internalerror(200308252);
+           else
+             internalerror(200308251);
         end;
-
-        { force fpureg as location, left right doesn't matter
-          as both will be in a fpureg }
-        location_force_fpureg(exprasmlist,left.location,true);
-        location_force_fpureg(exprasmlist,right.location,(left.location.loc<>LOC_CFPUREGISTER));
-
-        location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
-        if left.location.loc<>LOC_CFPUREGISTER then
-          location.register:=left.location.register
-        else
-          location.register:=right.location.register;
-
-        exprasmlist.concat(taicpu.op_reg_reg_reg(op,
-           left.location.register,right.location.register,location.register));
-
-        release_reg_left_right;
-        }
       end;
 
 
@@ -183,30 +195,9 @@ interface
 
         release_reg_left_right;
         }
-      end;
-
-
-    procedure tarmaddnode.second_cmpboolean;
-      var
-        zeroreg : tregister;
-      begin
-        {!!!!!!!
-        pass_left_right;
-        force_reg_left_right(true,true);
-
-        zeroreg.enum:=R_INTREGISTER;
-        zeroreg.number:=NR_G0;
-
-        if right.location.loc = LOC_CONSTANT then
-          tcgsparc(cg).handle_reg_const_reg(exprasmlist,A_SUBcc,left.location.register,right.location.value,zeroreg)
-        else
-          exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,zeroreg));
-
+        //!!!!
         location_reset(location,LOC_FLAGS,OS_NO);
         location.resflags:=getresflags(true);
-
-        release_reg_left_right;
-        }
       end;
 
 
@@ -238,7 +229,6 @@ interface
       var
         unsigned : boolean;
       begin
-        {!!!!!!!
 {$warning TODO 64bit compare}
         unsigned:=not(is_signed(left.resulttype.def)) or
                   not(is_signed(right.resulttype.def));
@@ -247,35 +237,41 @@ interface
         location.resflags:=getresflags(unsigned);
 
         release_reg_left_right;
-        }
       end;
 
 
     procedure tarmaddnode.second_cmpordinal;
       var
-        zeroreg : tregister;
         unsigned : boolean;
+        tmpreg : tregister;
+        b : byte;
       begin
-        {!!!!!!!
         pass_left_right;
         force_reg_left_right(true,true);
 
         unsigned:=not(is_signed(left.resulttype.def)) or
                   not(is_signed(right.resulttype.def));
 
-        zeroreg.enum:=R_INTREGISTER;
-        zeroreg.number:=NR_G0;
-
         if right.location.loc = LOC_CONSTANT then
-          tcgsparc(cg).handle_reg_const_reg(exprasmlist,A_SUBcc,left.location.register,right.location.value,zeroreg)
+          begin
+             if is_shifter_const(right.location.value,b) then
+               exprasmlist.concat(taicpu.op_reg_const(A_CMP,left.location.register,right.location.value))
+             else
+               begin
+                 tmpreg:=rg.getregisterint(exprasmlist,location.size);
+                 cg.a_load_const_reg(exprasmlist,OS_INT,
+                   aword(right.location.value),tmpreg);
+                 exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,tmpreg));
+                 rg.ungetregisterint(exprasmlist,tmpreg);
+               end;
+          end
         else
-          exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,zeroreg));
+          exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
 
         location_reset(location,LOC_FLAGS,OS_NO);
         location.resflags:=getresflags(unsigned);
 
         release_reg_left_right;
-        }
       end;
 
 begin
@@ -283,6 +279,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2003-08-21 03:14:00  florian
+  Revision 1.2  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.1  2003/08/21 03:14:00  florian
     * arm compiler can be compiled; far from being working
 }

compiler/arm/narmcnv.pas

@@ -32,6 +32,7 @@ interface
     type
        tarmtypeconvnode = class(tcgtypeconvnode)
          protected
+           function first_int_to_real: tnode;override;
          { procedure second_int_to_int;override; }
          { procedure second_string_to_string;override; }
          { procedure second_cstring_to_pchar;override; }
@@ -68,6 +69,43 @@ implementation
       rgobj,tgobj,cgobj,cginfo;
 
 
+{*****************************************************************************
+                             FirstTypeConv
+*****************************************************************************}
+
+    function tarmtypeconvnode.first_int_to_real: tnode;
+      var
+        fname: string[19];
+      begin
+        { converting a 64bit integer to a float requires a helper }
+        if is_64bitint(left.resulttype.def) then
+          begin
+            if is_signed(left.resulttype.def) then
+              fname := 'fpc_int64_to_double'
+            else
+              fname := 'fpc_qword_to_double';
+            result := ccallnode.createintern(fname,ccallparanode.create(
+              left,nil));
+            left:=nil;
+            firstpass(result);
+            exit;
+          end
+        else
+          { other integers are supposed to be 32 bit }
+          begin
+            if is_signed(left.resulttype.def) then
+              inserttypeconv(left,s32bittype)
+            else
+              inserttypeconv(left,u32bittype);
+            firstpass(left);
+          end;
+        result := nil;
+        if registersfpu<1 then
+          registersfpu:=1;
+        expectloc:=LOC_FPUREGISTER;
+      end;
+
+
     procedure tarmtypeconvnode.second_int_to_real;
       begin
       end;
@@ -138,6 +176,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2003-08-21 23:24:08  florian
+  Revision 1.2  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.1  2003/08/21 23:24:08  florian
     * continued to work on the arm skeleton
 }

compiler/arm/rgcpu.pas

@@ -36,18 +36,8 @@ unit rgcpu;
 
      type
        trgcpu = class(trgobj)
-         function getexplicitregisterint(list: taasmoutput; reg: Tnewregister): tregister; override;
-         procedure ungetregisterint(list: taasmoutput; reg: tregister); override;
          function getexplicitregisterfpu(list : taasmoutput; r : Toldregister) : tregister;override;
          procedure ungetregisterfpu(list: taasmoutput; r : tregister; size:TCGsize);override;
-{$ifndef newra}
-         procedure saveusedintregisters(list:Taasmoutput;
-                                         var saved:Tpushedsavedint;
-                                         const s:Tsupregset);override;
-         procedure saveusedotherregisters(list:Taasmoutput;
-                                           var saved:Tpushedsavedother;
-                                           const s:Tregisterset);override;
-{$endif newra}
          procedure cleartempgen; override;
         private
          usedpararegs: Tsupregset;
@@ -59,44 +49,10 @@ unit rgcpu;
     uses
       cgobj, verbose, cutils;
 
-    function trgcpu.getexplicitregisterint(list: taasmoutput; reg: Tnewregister): tregister;
-
-      begin
-        if ((reg shr 8) in [RS_R0{$ifndef newra},RS_R2..RS_R12{$endif}]) and
-           not((reg shr 8) in is_reg_var_int) then
-          begin
-            if (reg shr 8) in usedpararegs then
-              internalerror(2003060701);
-{              comment(v_warning,'Double allocation of register '+tostr((reg shr 8)-1));}
-            include(usedpararegs,reg shr 8);
-            result.enum:=R_INTREGISTER;
-            result.number:=reg;
-            cg.a_reg_alloc(list,result);
-          end
-        else result := inherited getexplicitregisterint(list,reg);
-      end;
-
-
-    procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
-
-      begin
-        if ((reg.number shr 8) in [RS_R0{$ifndef newra},RS_R2..RS_R12{$endif newra}]) and
-            not((reg.number shr 8) in is_reg_var_int) then
-          begin
-            if not((reg.number shr 8) in usedpararegs) then
-              internalerror(2003060702);
-{               comment(v_warning,'Double free of register '+tostr((reg.number shr 8)-1));}
-            exclude(usedpararegs,reg.number shr 8);
-            cg.a_reg_dealloc(list,reg);
-          end
-        else
-          inherited ungetregisterint(list,reg);
-      end;
-
 
     function trgcpu.getexplicitregisterfpu(list : taasmoutput; r : Toldregister) : tregister;
       begin
-        if (r in [R_F1..R_F13]) and
+        if (r in [R_F0..R_F3]) and
            not is_reg_var_other[r] then
           begin
             if r in usedparafpuregs then
@@ -106,13 +62,13 @@ unit rgcpu;
             cg.a_reg_alloc(list,result);
           end
         else
-          result := inherited getexplicitregisterfpu(list,r);
+          result:=inherited getexplicitregisterfpu(list,r);
       end;
 
 
     procedure trgcpu.ungetregisterfpu(list: taasmoutput; r : tregister; size:TCGsize);
       begin
-        if (r.enum in [R_F1..R_F13]) and
+        if (r.enum in [R_F0..R_F3]) and
            not is_reg_var_other[r.enum] then
           begin
             if not(r.enum in usedparafpuregs) then
@@ -125,30 +81,6 @@ unit rgcpu;
       end;
 
 
-{$ifndef newra}
-    procedure trgcpu.saveusedintregisters(list:Taasmoutput;
-                                         var saved:Tpushedsavedint;
-                                         const s:Tsupregset);
-      begin
-        // saving/restoring is done by the callee (except for registers
-        // which already contain parameters, but those aren't allocated
-        // correctly yet)
-        filldword(saved,sizeof(saved) div 4,reg_not_saved);
-      end;
-
-
-    procedure trgcpu.saveusedotherregisters(list:Taasmoutput;
-                                           var saved:Tpushedsavedother;
-                                           const s:Tregisterset);
-      begin
-        // saving/restoring is done by the callee (except for registers
-        // which already contain parameters, but those aren't allocated
-        // correctly yet)
-        filldword(saved,sizeof(saved) div 4,reg_not_saved);
-      end;
-{$endif newra}
-
-
     procedure trgcpu.cleartempgen;
 
       begin
@@ -157,12 +89,17 @@ unit rgcpu;
         usedparafpuregs := [];
       end;
 
+
 initialization
   rg := trgcpu.create(last_supreg-first_supreg+1);
 end.
 
 {
   $Log$
-  Revision 1.1  2003-08-16 13:23:01  florian
+  Revision 1.2  2003-08-25 23:20:38  florian
+    + started to implement FPU support for the ARM
+    * fixed a lot of other things
+
+  Revision 1.1  2003/08/16 13:23:01  florian
     * several arm related stuff fixed
 }