Bläddra i källkod

* fixed ppc inlining stuff
* fixed wrong unit writing
+ added some sse stuff

florian 21 år sedan
förälder
incheckning
b52cee6639
7 ändrade filer med 225 tillägg och 29 borttagningar
  1. 15 1
      compiler/cgbase.pas
  2. 19 1
      compiler/cgobj.pas
  3. 8 6
      compiler/ncal.pas
  4. 7 1
      compiler/ncgcal.pas
  5. 6 2
      compiler/psub.pas
  6. 19 15
      compiler/symdef.pas
  7. 151 3
      compiler/x86/cgx86.pas

+ 15 - 1
compiler/cgbase.pas

@@ -289,6 +289,9 @@ interface
     { returns true, if shuffle describes a real shuffle operation and not only a move }
     { returns true, if shuffle describes a real shuffle operation and not only a move }
     function realshuffle(shuffle : pmmshuffle) : boolean;
     function realshuffle(shuffle : pmmshuffle) : boolean;
 
 
+    { returns true, if the shuffle describes only a move of the scalar at index 0 }
+    function shufflescalar(shuffle : pmmshuffle) : boolean;
+
     { removes shuffling from shuffle, this means that the destenation index of each shuffle is copied to
     { removes shuffling from shuffle, this means that the destenation index of each shuffle is copied to
       the source }
       the source }
     procedure removeshuffles(var shuffle : tmmshuffle);
     procedure removeshuffles(var shuffle : tmmshuffle);
@@ -559,6 +562,12 @@ implementation
       end;
       end;
 
 
 
 
+    function shufflescalar(shuffle : pmmshuffle) : boolean;
+      begin
+        result:=shuffle^.len=0;
+      end;
+
+
     procedure removeshuffles(var shuffle : tmmshuffle);
     procedure removeshuffles(var shuffle : tmmshuffle);
       var
       var
         i : longint;
         i : longint;
@@ -578,7 +587,12 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.80  2003-12-19 22:08:44  daniel
+  Revision 1.81  2003-12-21 19:42:42  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.80  2003/12/19 22:08:44  daniel
     * Some work to restore the MMX capabilities
     * Some work to restore the MMX capabilities
 
 
   Revision 1.79  2003/12/15 21:25:48  peter
   Revision 1.79  2003/12/15 21:25:48  peter

+ 19 - 1
compiler/cgobj.pas

@@ -231,6 +231,9 @@ unit cgobj;
           procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
           procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
           procedure a_parammm_ref(list: taasmoutput; size: tcgsize; ref: treference;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
           procedure a_parammm_ref(list: taasmoutput; size: tcgsize; ref: treference;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
           procedure a_parammm_loc(list: taasmoutput; loc: tlocation; const locpara : tparalocation;shuffle : pmmshuffle); virtual;
           procedure a_parammm_loc(list: taasmoutput; loc: tlocation; const locpara : tparalocation;shuffle : pmmshuffle); virtual;
+          procedure a_opmm_reg_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); virtual;abstract;
+          procedure a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
+          procedure a_opmm_reg_ref(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
 
 
           { basic arithmetic operations }
           { basic arithmetic operations }
           { note: for operators which require only one argument (not, neg), use }
           { note: for operators which require only one argument (not, neg), use }
@@ -1395,6 +1398,16 @@ implementation
       end;
       end;
 
 
 
 
+    procedure tcg.a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
+      begin
+      end;
+
+
+    procedure tcg.a_opmm_reg_ref(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
+      begin
+      end;
+
+
     class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
     class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
       begin
       begin
         reg_cgsize := OS_INT;
         reg_cgsize := OS_INT;
@@ -1973,7 +1986,12 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.140  2003-12-15 21:39:39  florian
+  Revision 1.141  2003-12-21 19:42:42  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.140  2003/12/15 21:39:39  florian
     * improved register allocation of generic a_param_const and a_param_ref
     * improved register allocation of generic a_param_const and a_param_ref
 
 
   Revision 1.139  2003/12/15 21:25:48  peter
   Revision 1.139  2003/12/15 21:25:48  peter

+ 8 - 6
compiler/ncal.pas

@@ -2459,12 +2459,9 @@ type
               { handle predefined procedures }
               { handle predefined procedures }
               if (procdefinition.proccalloption=pocall_inline) then
               if (procdefinition.proccalloption=pocall_inline) then
                 begin
                 begin
+                   { inherit flags }
                    current_procinfo.flags:=current_procinfo.flags+((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
                    current_procinfo.flags:=current_procinfo.flags+((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
-                   {
-                   writeln(longint(current_procinfo.flags));
-                   writeln(longint(inherited_inlining_flags));
-                   writeln(longint((procdefinition as tprocdef).inlininginfo^.flags));
-                   }
+
                    if assigned(methodpointer) then
                    if assigned(methodpointer) then
                      CGMessage(cg_e_unable_inline_object_methods);
                      CGMessage(cg_e_unable_inline_object_methods);
                    if assigned(right) then
                    if assigned(right) then
@@ -2704,7 +2701,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.215  2003-12-20 12:38:51  florian
+  Revision 1.216  2003-12-21 19:42:42  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.215  2003/12/20 12:38:51  florian
     * some x86-64 compilation fixe
     * some x86-64 compilation fixe
 
 
   Revision 1.214  2003/12/16 22:09:31  florian
   Revision 1.214  2003/12/16 22:09:31  florian

+ 7 - 1
compiler/ncgcal.pas

@@ -988,6 +988,7 @@ implementation
          { create temp procinfo that will be used for the inlinecode tree }
          { create temp procinfo that will be used for the inlinecode tree }
          current_procinfo:=cprocinfo.create(nil);
          current_procinfo:=cprocinfo.create(nil);
          current_procinfo.procdef:=tprocdef(procdefinition);
          current_procinfo.procdef:=tprocdef(procdefinition);
+         current_procinfo.flags:=oldprocinfo.flags;
 
 
          { when the oldprocinfo is also being inlined reuse the
          { when the oldprocinfo is also being inlined reuse the
            inlining_procinfo }
            inlining_procinfo }
@@ -1130,7 +1131,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.146  2003-12-15 21:25:48  peter
+  Revision 1.147  2003-12-21 19:42:42  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.146  2003/12/15 21:25:48  peter
     * reg allocations for imaginary register are now inserted just
     * reg allocations for imaginary register are now inserted just
       before reg allocation
       before reg allocation
     * tregister changed to enum to allow compile time check
     * tregister changed to enum to allow compile time check

+ 6 - 2
compiler/psub.pas

@@ -987,7 +987,6 @@ implementation
                printnode_procdef(procdef);
                printnode_procdef(procdef);
            end;
            end;
 
 
-         new(procdef.inlininginfo);
          { store a copy of the original tree for inline, for
          { store a copy of the original tree for inline, for
            normal procedures only store a reference to the
            normal procedures only store a reference to the
            current tree }
            current tree }
@@ -1336,7 +1335,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.180  2003-12-19 22:08:44  daniel
+  Revision 1.181  2003-12-21 19:42:43  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.180  2003/12/19 22:08:44  daniel
     * Some work to restore the MMX capabilities
     * Some work to restore the MMX capabilities
 
 
   Revision 1.179  2003/12/16 22:36:19  florian
   Revision 1.179  2003/12/16 22:36:19  florian

+ 19 - 15
compiler/symdef.pas

@@ -3605,9 +3605,7 @@ implementation
          interfacedef:=false;
          interfacedef:=false;
          hasforward:=false;
          hasforward:=false;
          _class := nil;
          _class := nil;
-         { only for non inlined procedures loaded from a unit
-           we don't need this info
-         }
+
          new(inlininginfo);
          new(inlininginfo);
          fillchar(inlininginfo^,sizeof(tinlininginfo),0);
          fillchar(inlininginfo^,sizeof(tinlininginfo),0);
          overloadnumber:=0;
          overloadnumber:=0;
@@ -3638,7 +3636,11 @@ implementation
          ppufile.getsmallset(symoptions);
          ppufile.getsmallset(symoptions);
          { inline stuff }
          { inline stuff }
          if proccalloption=pocall_inline then
          if proccalloption=pocall_inline then
-           ppufile.getderef(funcretsymderef)
+           begin
+             ppufile.getderef(funcretsymderef);
+             new(inlininginfo);
+             ppufile.getsmallset(inlininginfo^.flags);
+           end
          else
          else
            funcretsym:=nil;
            funcretsym:=nil;
 
 
@@ -3659,11 +3661,7 @@ implementation
 
 
          { inline stuff }
          { inline stuff }
          if proccalloption=pocall_inline then
          if proccalloption=pocall_inline then
-           begin
-             new(inlininginfo);
-             inlininginfo^.code:=ppuloadnodetree(ppufile);
-             ppufile.getsmallset(inlininginfo^.flags);
-           end
+           inlininginfo^.code:=ppuloadnodetree(ppufile)
          else
          else
            inlininginfo := nil;
            inlininginfo := nil;
 
 
@@ -3766,7 +3764,11 @@ implementation
          oldintfcrc:=ppufile.do_crc;
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
          ppufile.do_crc:=false;
          if proccalloption=pocall_inline then
          if proccalloption=pocall_inline then
-           ppufile.putderef(funcretsymderef);
+           begin
+             ppufile.putderef(funcretsymderef);
+             ppufile.putsmallset(inlininginfo^.flags);
+           end;
+
          ppufile.do_crc:=oldintfcrc;
          ppufile.do_crc:=oldintfcrc;
 
 
          { write this entry }
          { write this entry }
@@ -3792,10 +3794,7 @@ implementation
          oldintfcrc:=ppufile.do_crc;
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
          ppufile.do_crc:=false;
          if proccalloption=pocall_inline then
          if proccalloption=pocall_inline then
-           begin
-             ppuwritenodetree(ppufile,inlininginfo^.code);
-             ppufile.putsmallset(inlininginfo^.flags);
-           end;
+           ppuwritenodetree(ppufile,inlininginfo^.code);
 
 
          ppufile.do_crc:=oldintfcrc;
          ppufile.do_crc:=oldintfcrc;
 
 
@@ -6139,7 +6138,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.193  2003-12-16 21:29:24  florian
+  Revision 1.194  2003-12-21 19:42:43  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.193  2003/12/16 21:29:24  florian
     + inlined procedures inherit procinfo flags
     + inlined procedures inherit procinfo flags
 
 
   Revision 1.192  2003/12/12 12:09:40  marco
   Revision 1.192  2003/12/12 12:09:40  marco

+ 151 - 3
compiler/x86/cgx86.pas

@@ -93,6 +93,8 @@ unit cgx86;
         procedure a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override;
         procedure a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override;
         procedure a_loadmm_ref_reg(list: taasmoutput; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
         procedure a_loadmm_ref_reg(list: taasmoutput; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
         procedure a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
         procedure a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
+        procedure a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
+        procedure a_opmm_reg_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle);override;
 
 
         {  comparison operations }
         {  comparison operations }
         procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
         procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
@@ -133,6 +135,8 @@ unit cgx86;
       protected
       protected
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
         procedure check_register_size(size:tcgsize;reg:tregister);
         procedure check_register_size(size:tcgsize;reg:tregister);
+
+        procedure opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
       private
       private
         procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
         procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
 
 
@@ -708,9 +712,49 @@ unit cgx86;
        end;
        end;
 
 
 
 
+    function get_scalar_mm_op(fromsize,tosize : tcgsize) : tasmop;
+      begin
+        case fromsize of
+          OS_F32:
+            case tosize of
+              OS_F64:
+                result:=A_CVTSS2SD;
+              OS_F32:
+                result:=A_MOVSS;
+              else
+                internalerror(200312205);
+            end;
+          OS_F64:
+            case tosize of
+              OS_F64:
+                result:=A_MOVSD;
+              OS_F32:
+                result:=A_CVTSD2SS;
+              else
+                internalerror(200312204);
+            end;
+          else
+            internalerror(200312203);
+        end;
+      end;
+
+
     procedure tcgx86.a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle);
     procedure tcgx86.a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle);
        begin
        begin
-         list.concat(taicpu.op_reg_reg(A_MOVQ,S_NO,reg1,reg2));
+         if shuffle=nil then
+           begin
+             if fromsize=tosize then
+               list.concat(taicpu.op_reg_reg(A_MOVAPS,S_NO,reg1,reg2))
+             else
+               internalerror(200312202);
+           end
+         else
+           begin
+             if shufflescalar(shuffle) then
+               list.concat(taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg1,reg2))
+             else
+               internalerror(200312201);
+           end;
        end;
        end;
 
 
 
 
@@ -726,6 +770,105 @@ unit cgx86;
        end;
        end;
 
 
 
 
+    procedure tcgx86.a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
+      var
+        l : tlocation;
+      begin
+        l.loc:=LOC_REFERENCE;
+        l.reference:=ref;
+        l.size:=size;
+        opmm_loc_reg(list,op,size,l,reg,shuffle);
+      end;
+
+
+    procedure tcgx86.a_opmm_reg_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle);
+     var
+       l : tlocation;
+     begin
+       l.loc:=LOC_REGISTER;
+       l.register:=src;
+       l.size:=size;
+       opmm_loc_reg(list,op,size,l,dst,shuffle);
+     end;
+
+
+    procedure tcgx86.opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
+      const
+        opmm2asmop : array[0..1,OS_F32..OS_F64,topcg] of tasmop = (
+          ( { scalar }
+            ( { OS_F32 }
+              A_NOP,A_ADDSS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP
+            ),
+          { Intel did again a "nice" job: they added packed double operations (*PD) to SSE2 but
+            no scalar ones (*SD)
+          }
+          {$ifdef x86_64}
+            ( { OS_F64 }
+              A_NOP,A_ADDSD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP
+            )
+          {$else x86_64}
+            ( { OS_F64 }
+              A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP
+            )
+          {$endif x86_64}
+          ),
+          ( { vectorized/packed }
+            ( { OS_F32 }
+              A_NOP,A_ADDPS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP
+            ),
+            ( { OS_F64 }
+              A_NOP,A_ADDPD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP
+            )
+          )
+        );
+
+      var
+        resultreg : tregister;
+        asmop : tasmop;
+      begin
+        { this is an internally used procedure so the parameters have
+          some constrains
+        }
+        if loc.size<>size then
+          internalerror(200312213);
+        resultreg:=dst;
+        { deshuffle }
+        //!!!
+        if (shuffle<>nil) and not(shufflescalar(shuffle)) then
+          begin
+          end
+        else if (shuffle=nil) then
+          asmop:=opmm2asmop[1,size,op]
+        else if shufflescalar(shuffle) then
+          begin
+            asmop:=opmm2asmop[0,size,op];
+            { no scalar operation available? }
+            if asmop=A_NOP then
+              begin
+                { do vectorized and shuffle finally }
+                //!!!
+              end;
+          end
+        else
+          internalerror(200312211);
+        if asmop=A_NOP then
+          internalerror(200312215);
+        case loc.loc of
+          LOC_CREFERENCE,LOC_REFERENCE:
+            list.concat(taicpu.op_ref_reg(asmop,S_NO,loc.reference,resultreg));
+          LOC_CMMREGISTER,LOC_MMREGISTER:
+            list.concat(taicpu.op_reg_reg(asmop,S_NO,loc.register,resultreg));
+          else
+            internalerror(200312214);
+        end;
+        { shuffle }
+        if resultreg<>dst then
+          begin
+            internalerror(200312212);
+          end;
+      end;
+
+
     procedure tcgx86.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
     procedure tcgx86.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
 
 
       var
       var
@@ -1173,7 +1316,7 @@ unit cgx86;
          not(pi_uses_fpu in current_procinfo.flags) and
          not(pi_uses_fpu in current_procinfo.flags) and
          ((len=8) or (len=16) or (len=24) or (len=32)) then
          ((len=8) or (len=16) or (len=24) or (len=32)) then
         cm:=copy_mmx;
         cm:=copy_mmx;
-      if (cs_littlesize in aktglobalswitches) and 
+      if (cs_littlesize in aktglobalswitches) and
          (len>helpsize) and
          (len>helpsize) and
          not((len<=16) and (cm=copy_mmx)) then
          not((len<=16) and (cm=copy_mmx)) then
         cm:=copy_string;
         cm:=copy_string;
@@ -1758,7 +1901,12 @@ unit cgx86;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.92  2003-12-19 22:08:44  daniel
+  Revision 1.93  2003-12-21 19:42:43  florian
+    * fixed ppc inlining stuff
+    * fixed wrong unit writing
+    + added some sse stuff
+
+  Revision 1.92  2003/12/19 22:08:44  daniel
     * Some work to restore the MMX capabilities
     * Some work to restore the MMX capabilities
 
 
   Revision 1.91  2003/12/15 21:25:49  peter
   Revision 1.91  2003/12/15 21:25:49  peter