Quellcode durchsuchen

Merged revisions 7831,7833,7835-7839,7845-7846,7848-7849,7862,7864-7865,7869,7872,7877,7882,7912,7927-7929,7953,7961,7967,7971,7986-7987,7990-7994,7998-8000,8004-8006,8008-8012,8016,8027,8034,8036-8037,8039,8044,8046,8048,8051,8060,8071,8075-8076,8082-8083,8087-8089,8095-8096,8099-8100,8110,8131,8136,8187,8190,8203,8206-8207,8212-8213,8215,8225,8227,8233-8239,8262,8302,8307,8309,8316,8318-8319,8336,8338-8340,8404,8410-8411,8430,8438-8442,8445-8446,8448,8450-8454,8456-8457,8459,8462,8467,8469-8470,8472-8483,8486-8488,8490,8493,8496,8506,8530 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r7831 | jonas | 2007-06-27 19:26:18 +0200 (Wed, 27 Jun 2007) | 5 lines

* fixed several problems with packed set operand sizes
* added LOC_CONSTANT to the list of allowed locations for the left
hand side of an in-node, so it doesn't get forced into a register
anymore in that case
........
r7833 | jonas | 2007-06-27 21:50:09 +0200 (Wed, 27 Jun 2007) | 3 lines

* more packed set operand size problems fixed (include/exclude, mantis
#9167)
........
r7835 | daniel | 2007-06-27 22:31:58 +0200 (Wed, 27 Jun 2007) | 2 lines

* Fix operator count.
........
r7845 | daniel | 2007-06-29 08:33:12 +0200 (Fri, 29 Jun 2007) | 2 lines

* Fixed another placed where chained paralocs where not being processed.
........
r7848 | daniel | 2007-06-29 19:46:27 +0200 (Fri, 29 Jun 2007) | 2 lines

* Also execute setfirsttemp on non-Windows platforms. Fixes -O2 cycle on Linux.
........
r7912 | jonas | 2007-07-01 21:35:22 +0200 (Sun, 01 Jul 2007) | 5 lines

* fixed generic in-code in case left = LOC_JUMP
* fixed generic and x86 in-code in case genjumps=true and
complexity(right)>complexity(left) (not sure if possible
in practice currently, but better safe than sorry)
........
r8110 | daniel | 2007-07-21 11:20:33 +0200 (Sat, 21 Jul 2007) | 3 lines

+ For muln, don't load left operand in register unless necessary.
(mul supports memory operands).
........
r8131 | daniel | 2007-07-22 13:48:10 +0200 (Sun, 22 Jul 2007) | 2 lines

* Fix mul opsize
........
r8467 | karoly | 2007-09-14 00:30:27 +0200 (Fri, 14 Sep 2007) | 2 lines

+ made m68k compiler to compile again
........
r8530 | peter | 2007-09-17 22:52:24 +0200 (Mon, 17 Sep 2007) | 2 lines

* release temp when downgrading fpuregister value
........

git-svn-id: branches/fixes_2_2@8583 -

peter vor 18 Jahren
Ursprung
Commit
9b8079dcc4

+ 1 - 0
.gitattributes

@@ -8353,6 +8353,7 @@ tests/webtbs/tw9139a.pp svneol=native#text/plain
 tests/webtbs/tw9145.pp svneol=native#text/plain
 tests/webtbs/tw9161.pp svneol=native#text/plain
 tests/webtbs/tw9162.pp svneol=native#text/plain
+tests/webtbs/tw9167.pp svneol=native#text/plain
 tests/webtbs/tw9174.pp svneol=native#text/plain
 tests/webtbs/tw9176a.pp -text
 tests/webtbs/tw9179.pp svneol=native#text/plain

+ 3 - 3
compiler/cgobj.pas

@@ -3365,19 +3365,19 @@ implementation
             begin
               case loc of
                 LOC_REGISTER:
-                  cg.a_op_const_reg(list,OP_SUB,size,ioffset,register);
+                  a_op_const_reg(list,OP_SUB,size,ioffset,register);
                 LOC_REFERENCE:
                   begin
                     { offset in the wrapper needs to be adjusted for the stored
                       return address }
                     reference_reset_base(href,reference.index,reference.offset+sizeof(aint));
-                    cg.a_op_const_ref(list,OP_SUB,size,ioffset,href);
+                    a_op_const_ref(list,OP_SUB,size,ioffset,href);
                   end
                 else
                   internalerror(200309189);
               end;
               paraloc:=next;
-           end;
+            end;
       end;
 
 

+ 23 - 6
compiler/i386/n386add.pas

@@ -345,7 +345,9 @@ interface
 
     procedure ti386addnode.second_mul;
 
-    var r:Tregister;
+    var reg:Tregister;
+        ref:Treference;
+        use_ref:boolean;
         hl4 : tasmlabel;
 
     begin
@@ -353,17 +355,32 @@ interface
 
       {The location.register will be filled in later (JM)}
       location_reset(location,LOC_REGISTER,OS_INT);
-      {Get a temp register and load the left value into it
-       and free the location.}
-      r:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-      cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,r);
+      { Mul supports registers and references, so if not register/reference,
+        load the location into a register}
+      use_ref:=false;
+      if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+        reg:=left.location.register
+      else if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+        begin
+          ref:=left.location.reference;
+          use_ref:=true;
+        end
+      else
+        begin
+          {LOC_CONSTANT for example.}
+          reg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+          cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,reg);
+        end;
       {Allocate EAX.}
       cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
       {Load the right value.}
       cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_EAX);
       {Also allocate EDX, since it is also modified by a mul (JM).}
       cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-      emit_reg(A_MUL,S_L,r);
+      if use_ref then
+        emit_ref(A_MUL,S_L,ref)
+      else
+        emit_reg(A_MUL,S_L,reg);
       if cs_check_overflow in current_settings.localswitches  then
        begin
          current_asmdata.getjumplabel(hl4);

+ 5 - 4
compiler/m68k/n68kmat.pas

@@ -266,7 +266,7 @@ implementation
         hregister,resultreg,hregister1,
         hreg64hi,hreg64lo : tregister;
         op : topcg;
-        shiftval: aword;
+        shiftval: aint;
       begin
         secondpass(left);
         secondpass(right);
@@ -279,7 +279,8 @@ implementation
             hreg64hi:=left.location.register64.reghi;
             hreg64lo:=left.location.register64.reglo;
 
-            shiftval := tordconstnode(right).value and 63;
+            shiftval := tordconstnode(right).value.svalue;
+	    shiftval := shiftval and 63;
             if shiftval > 31 then
               begin
                 if nodetype = shln then
@@ -339,8 +340,8 @@ implementation
             { shifting by a constant directly coded: }
             if (right.nodetype=ordconstn) then
               begin
-                if tordconstnode(right).value and 31<>0 then
-                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,OS_32,tordconstnode(right).value and 31,hregister1,resultreg)
+                if tordconstnode(right).value.svalue and 31<>0 then
+                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,OS_32,tordconstnode(right).value.svalue and 31,hregister1,resultreg)
               end
             else
               begin

+ 33 - 5
compiler/ncgset.pas

@@ -258,15 +258,17 @@ implementation
     procedure tcginnode.pass_generate_code;
        var
          adjustment : aint;
-         href : treference;
+         otl, ofl   : tasmlabel;
          hr,hr2,
          pleftreg   : tregister;
+	 href       : treference;
          setparts   : Tsetparts;
          opsize     : tcgsize;
          uopsize    : tcgsize;
          orgopsize  : tcgsize;
          genjumps,
-         use_small  : boolean;
+         use_small,
+         isjump     : boolean;
          i,numparts : byte;
          l, l2      : tasmlabel;
          needslabel : Boolean;
@@ -284,10 +286,36 @@ implementation
            opsize := uopsize;
          needslabel := false;
 
-         { calculate both operators }
-         { the complex one first }
-         firstcomplex(self);
+         isjump:=false;
+         if (left.expectloc=LOC_JUMP) then
+           begin
+             otl:=current_procinfo.CurrTrueLabel;
+             current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
+             ofl:=current_procinfo.CurrFalseLabel;
+             current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
+             isjump:=true;
+           end
+         else if not genjumps then
+           { calculate both operators }
+           { the complex one first }
+           { only if left will not be a LOC_JUMP, to keep complexity in the }
+           { code generator down. This almost never happens anyway, only in }
+           { case like "if ((a in someset) in someboolset) then" etc        }
+           { also not in case of genjumps, because then we don't secondpass }
+           { right at all (so we have to make sure that "right" really is   }
+           { "right" and not "swapped left" in that case)                   }
+           firstcomplex(self);
+
          secondpass(left);
+         if isjump then
+           begin
+             location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
+             current_procinfo.CurrTrueLabel:=otl;
+             current_procinfo.CurrFalseLabel:=ofl;
+           end
+         else if (left.location.loc=LOC_JUMP) then
+           internalerror(2007070101);
+
          { Only process the right if we are not generating jumps }
          if not genjumps then
            secondpass(right);

+ 2 - 1
compiler/x86/cgx86.pas

@@ -873,9 +873,10 @@ unit cgx86;
             (tosize<fromsize) then
            begin
              { can't round down to lower precision in x87 :/ }
-             tg.gettemp(list,tcgsize2size[tosize],tt_persistent,href);
+             tg.gettemp(list,tcgsize2size[tosize],tt_normal,href);
              a_loadfpu_reg_ref(list,fromsize,tosize,NR_ST,href);
              a_loadfpu_ref_reg(list,tosize,tosize,href,NR_ST);
+             tg.ungettemp(list,href);
            end;
        end;
 

+ 6 - 0
compiler/x86/nx86add.pas

@@ -209,6 +209,12 @@ unit nx86add;
               location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]));
             end;
           end;
+        if (right.location.loc<>LOC_CONSTANT) and
+           (tcgsize2unsigned[right.location.size]<>opsize) then
+          location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true);
+        if (left.location.loc<>LOC_CONSTANT) and
+           (tcgsize2unsigned[left.location.size]<>opsize) then
+          location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false);
        end;
 
 

+ 7 - 19
compiler/x86/nx86inl.pas

@@ -349,10 +349,11 @@ implementation
             opsize:=OS_32;
           bitsperop:=(8*tcgsize2size[opsize]);
           secondpass(tcallparanode(left).left);
-          if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
+          secondpass(tcallparanode(tcallparanode(left).right).left);
+          if tcallparanode(tcallparanode(left).right).left.location.loc=LOC_CONSTANT then
             begin
               { calculate bit position }
-              l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod bitsperop);
+              l:=1 shl (tcallparanode(tcallparanode(left).right).left.location.value mod bitsperop);
 
               { determine operator }
               if inlinenumber=in_include_x_y then
@@ -366,7 +367,7 @@ implementation
                 LOC_REFERENCE :
                   begin
                     inc(tcallparanode(left).left.location.reference.offset,
-                      (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div bitsperop)*tcgsize2size[opsize]);
+                      (tcallparanode(tcallparanode(left).right).left.location.value div bitsperop)*tcgsize2size[opsize]);
                     cg.a_op_const_ref(current_asmdata.CurrAsmList,cgop,opsize,l,tcallparanode(left).left.location.reference);
                   end;
                 LOC_CREGISTER :
@@ -377,29 +378,16 @@ implementation
             end
           else
             begin
-              if opsize=OS_8 then
+              if opsize in [OS_8,OS_S8] then
                 opsize:=OS_32;
-              { generate code for the element to set }
-              secondpass(tcallparanode(tcallparanode(left).right).left);
               { determine asm operator }
               if inlinenumber=in_include_x_y then
                  asmop:=A_BTS
               else
                  asmop:=A_BTR;
 
-              if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
-                { we don't need a mod 32 because this is done automatically  }
-                { by the bts instruction. For proper checking we would       }
-
-                { note: bts doesn't do any mod'ing, that's why we can also use }
-                { it for normalsets! (JM)                                      }
-
-                { need a cmp and jmp, but this should be done by the         }
-                { type cast code which does range checking if necessary (FK) }
-                hregister:=cg.makeregsize(current_asmdata.CurrAsmList,Tcallparanode(Tcallparanode(left).right).left.location.register,opsize)
-              else
-                hregister:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
-              cg.a_load_loc_reg(current_asmdata.CurrAsmList,opsize,tcallparanode(tcallparanode(left).right).left.location,hregister);
+              location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,opsize,true);
+              hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
               if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
                 emit_reg_ref(asmop,tcgsize2opsize[opsize],hregister,tcallparanode(left).left.location.reference)
               else

+ 29 - 19
compiler/x86/nx86set.pas

@@ -170,7 +170,11 @@ implementation
                    analizeset(tsetconstnode(right).value_set,use_small);
          { calculate both operators }
          { the complex one first }
-         firstcomplex(self);
+         { not in case of genjumps, because then we don't secondpass    }
+         { right at all (so we have to make sure that "right" really is }
+         { "right" and not "swapped left" in that case)                 }
+         if not(genjumps) then
+           firstcomplex(self);
          secondpass(left);
          { Only process the right if we are not generating jumps }
          if not genjumps then
@@ -189,7 +193,7 @@ implementation
          if is_signed(left.resultdef) then
            opsize := tcgsize(ord(opsize)+(ord(OS_S8)-ord(OS_8)));
 
-         if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then
+         if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE,LOC_CONSTANT]) then
            location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
 
          if genjumps then
@@ -281,20 +285,20 @@ implementation
               handle smallsets separate, because it allows faster checks }
             if use_small then
              begin
-               if left.nodetype=ordconstn then
+               if left.location.loc=LOC_CONSTANT then
                 begin
                   location.resflags:=F_NE;
                   case right.location.loc of
                     LOC_REGISTER,
                     LOC_CREGISTER:
                       begin
-                         emit_const_reg(A_TEST,S_L,
-                           1 shl (tordconstnode(left).value and 31),right.location.register);
+                         emit_const_reg(A_TEST,TCGSize2OpSize[right.location.size],
+                           1 shl (left.location.value and 31),right.location.register);
                       end;
                     LOC_REFERENCE,
                     LOC_CREFERENCE :
                       begin
-                        emit_const_ref(A_TEST,S_L,1 shl (tordconstnode(left).value and 31),
+                        emit_const_ref(A_TEST,TCGSize2OpSize[right.location.size],1 shl (left.location.value and 31),
                            right.location.reference);
                       end;
                     else
@@ -304,6 +308,9 @@ implementation
                else
                 begin
                   location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,true);
+                  if (tcgsize2size[right.location.size] < 4) or
+                     (right.location.loc = LOC_CONSTANT) then
+                    location_force_reg(current_asmdata.CurrAsmList,right.location,OS_32,true);
                   hreg:=left.location.register;
 
                   case right.location.loc of
@@ -312,14 +319,6 @@ implementation
                       begin
                         emit_reg_reg(A_BT,S_L,hreg,right.location.register);
                       end;
-                     LOC_CONSTANT :
-                       begin
-                         { We have to load the value into a register because
-                            btl does not accept values only refs or regs (PFV) }
-                         hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
-                         cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,right.location.value,hreg2);
-                         emit_reg_reg(A_BT,S_L,hreg,hreg2);
-                       end;
                      LOC_CREFERENCE,
                      LOC_REFERENCE :
                        begin
@@ -340,7 +339,7 @@ implementation
                   current_asmdata.getjumplabel(l2);
 
                   { load constants to a register }
-                  if left.nodetype=ordconstn then
+                  if left.location.loc=LOC_CONSTANT then
                     location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
 
                   case left.location.loc of
@@ -381,15 +380,26 @@ implementation
                 end { of right.location.loc=LOC_CONSTANT }
                { do search in a normal set which could have >32 elementsm
                  but also used if the left side contains values > 32 or < 0 }
-               else if left.nodetype=ordconstn then
+               else if left.location.loc=LOC_CONSTANT then
                 begin
-                  if (tordconstnode(left).value < 0) or ((tordconstnode(left).value shr 3) >= right.resultdef.size) then
+                  if (left.location.value<0) or ((left.location.value shr 3) >= right.resultdef.size) then
                     {should be caught earlier }
                     internalerror(2007020201);
 
                   location.resflags:=F_NE;
-                  inc(right.location.reference.offset,tordconstnode(left).value shr 3);
-                  emit_const_ref(A_TEST,S_B,1 shl (tordconstnode(left).value and 7),right.location.reference);
+                  case right.location.loc of
+                    LOC_REFERENCE,LOC_CREFERENCE:
+                      begin
+                        inc(right.location.reference.offset,left.location.value shr 3);
+                        emit_const_ref(A_TEST,S_B,1 shl (left.location.value and 7),right.location.reference);
+                      end;
+                    LOC_REGISTER,LOC_CREGISTER:
+                      begin
+                        emit_const_reg(A_TEST,TCGSize2OpSize[right.location.size],1 shl (left.location.value),right.location.register);
+                      end;
+                    else
+                      internalerror(2007051901);
+                  end;
                 end
                else
                 begin

+ 23 - 6
compiler/x86_64/nx64add.pas

@@ -47,7 +47,9 @@ interface
 
     procedure tx8664addnode.second_mul;
 
-    var r:Tregister;
+    var reg:Tregister;
+        ref:Treference;
+        use_ref:boolean;
         hl4 : tasmlabel;
 
     begin
@@ -55,17 +57,32 @@ interface
 
       { The location.register will be filled in later (JM) }
       location_reset(location,LOC_REGISTER,OS_INT);
-      { Get a temp register and load the left value into it
-        and free the location. }
-      r:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-      cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,r);
+      { Mul supports registers and references, so if not register/reference,
+        load the location into a register}
+      use_ref:=false;
+      if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+        reg:=left.location.register
+      else if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+        begin
+          ref:=left.location.reference;
+          use_ref:=true;
+        end
+      else
+        begin
+          {LOC_CONSTANT for example.}
+          reg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+          cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,reg);
+        end;
       { Allocate RAX. }
       cg.getcpuregister(current_asmdata.CurrAsmList,NR_RAX);
       { Load the right value. }
       cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_RAX);
       { Also allocate RDX, since it is also modified by a mul (JM). }
       cg.getcpuregister(current_asmdata.CurrAsmList,NR_RDX);
-      emit_reg(A_MUL,S_Q,r);
+      if use_ref then
+        emit_ref(A_MUL,S_Q,ref)
+      else
+        emit_reg(A_MUL,S_Q,reg);
       if cs_check_overflow in current_settings.localswitches  then
        begin
          current_asmdata.getjumplabel(hl4);

+ 18 - 0
tests/test/cg/tin.pp

@@ -298,6 +298,7 @@ var
    var
      op1 : tnormalset;
      op2 : tnormalset;
+     bs  : set of boolean;
      op  : tbigenum;
      passed : boolean;
    begin
@@ -347,6 +348,23 @@ var
        passed:=false;
 
      checkpassed(passed);
+
+
+     { LEFT : LOC_JUMP                            }
+     { RIGHT : LOC_REGISTER,LOC_CREGISTER         }
+     bs:=[false,true];
+     op:=A_MOVE;
+     passed:=true;
+     if not(not(op in [A_BFSET,A_MOVE,A_ASL..A_BCC]) in bs) then
+       passed := false;
+     if not((op in [A_BFSET,A_MOVE,A_ASL..A_BCC]) in bs) then
+       passed := false;
+
+     bs:=[false];
+     if ((op in [A_BFSET,A_MOVE,A_ASL..A_BCC]) in bs) then
+       passed := false;
+
+     checkpassed(passed);
    end;
 
    { WITH JUMP TABLE }

+ 26 - 0
tests/webtbs/tw9167.pp

@@ -0,0 +1,26 @@
+type
+  TShiftStateEnum = (ssShift, ssAlt, ssCtrl,
+    ssLeft, ssRight, ssMiddle, ssDouble,
+    // Extra additions
+    ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,
+    ssScroll,ssTriple,ssQuad);
+
+{$packset 1}
+  TShiftState = set of TShiftStateEnum;
+{$packset default}
+
+var
+  s: tshiftstate;
+  ss: tshiftstateenum;
+begin
+  s := [];
+  ss:=ssShift;
+  include(s,ss);
+  include(s,ssSuper);
+  if not(ssShift in s) or
+     not(ssSuper in s) then
+    halt(1);
+  if not(ss in s) then
+    halt(2);
+end.
+