Browse Source

* Readded old set code. To use it define 'oldset'. Activated by default
for ppc.

daniel 23 years ago
parent
commit
1130395e7e
9 changed files with 231 additions and 13 deletions
  1. 8 1
      compiler/fpcdefs.inc
  2. 82 2
      compiler/nadd.pas
  3. 9 1
      compiler/ncgcon.pas
  4. 20 2
      compiler/ncgset.pas
  5. 24 1
      compiler/ncnv.pas
  6. 40 1
      compiler/ncon.pas
  7. 10 2
      compiler/node.pas
  8. 22 2
      compiler/nset.pas
  9. 16 1
      compiler/ptconst.pas

+ 8 - 1
compiler/fpcdefs.inc

@@ -33,10 +33,17 @@
 {$ifdef x86_64}
   {$define x86}
 {$endif x86_64}
+{$ifdef ppc}
+  {$define oldset}
+{$endif}
 
 {
   $Log$
-  Revision 1.3  2002-07-04 18:56:50  florian
+  Revision 1.4  2002-07-23 12:34:29  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.3  2002/07/04 18:56:50  florian
     + log added
 
 }

+ 82 - 2
compiler/nadd.pas

@@ -472,6 +472,81 @@ implementation
                  left:=nil;
                  exit;
                end;
+{$ifdef oldset}
+	      case nodetype of
+		addn :
+		   begin
+		      for i:=0 to 31 do
+		        resultset[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
+		      t:=csetconstnode.create(@resultset,left.resulttype);
+		   end;
+		muln :
+		   begin
+		      for i:=0 to 31 do
+		        resultset[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
+		      t:=csetconstnode.create(@resultset,left.resulttype);
+		   end;
+		subn :
+		   begin
+		      for i:=0 to 31 do
+		        resultset[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
+		      t:=csetconstnode.create(@resultset,left.resulttype);
+		   end;
+		symdifn :
+		   begin
+		      for i:=0 to 31 do
+		        resultset[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
+		      t:=csetconstnode.create(@resultset,left.resulttype);
+		   end;
+		unequaln :
+		   begin
+		      b:=true;
+		      for i:=0 to 31 do
+		       if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
+		        begin
+		          b:=false;
+		          break;
+		        end;
+		      t:=cordconstnode.create(ord(b),booltype);
+		   end;
+		equaln :
+		   begin
+		      b:=true;
+		      for i:=0 to 31 do
+		       if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
+		        begin
+		          b:=false;
+		          break;
+	    		end;
+		      t:=cordconstnode.create(ord(b),booltype);
+		   end;
+		lten :
+		   begin
+		     b := true;
+		     for i := 0 to 31 Do
+		       if (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
+		           tsetconstnode(left).value_set^[i] Then
+		         begin
+		           b := false;
+		           break
+		         end;
+		     t := cordconstnode.create(ord(b),booltype);
+		   end;
+	        gten :
+                   begin
+	             b := true;
+    		     for i := 0 to 31 Do
+            	       If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
+                	   tsetconstnode(right).value_set^[i] Then
+                         begin
+	                   b := false;
+    		           break
+    	                 end;
+            	     t := cordconstnode.create(ord(b),booltype);
+            	   end;
+              end;
+
+{$else}
               case nodetype of
                  addn :
 		    begin
@@ -485,7 +560,7 @@ implementation
 		    end;
                  subn :
 		    begin
-			resultset:=tsetconstnode(right).value_set^ - tsetconstnode(left).value_set^;
+			resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
                         t:=csetconstnode.create(@resultset,left.resulttype);
 		    end;
                  symdifn :
@@ -514,6 +589,7 @@ implementation
             		t:=cordconstnode.create(byte(b),booltype);
                     end;
               end;
+{$endif}
               result:=t;
               exit;
            end;
@@ -1632,7 +1708,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2002-07-22 11:48:04  daniel
+  Revision 1.56  2002-07-23 12:34:29  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.55  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.54  2002/07/20 11:57:53  florian

+ 9 - 1
compiler/ncgcon.pas

@@ -423,7 +423,11 @@ implementation
                              i:=0;
                              while assigned(hp1) and (i<32) do
                               begin
+			    {$ifdef oldset}
+                                if tai_const(hp1).value<>value_set^[i] then
+			    {$else}
                                 if tai_const(hp1).value<>Psetbytes(value_set)^[i] then
+			    {$endif}
                                  break;
                                 inc(i);
                                 hp1:=tai(hp1.next);
@@ -522,7 +526,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2002-07-22 11:48:04  daniel
+  Revision 1.15  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.14  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.13  2002/07/20 11:57:53  florian

+ 20 - 2
compiler/ncgset.pas

@@ -137,10 +137,15 @@ implementation
          pushedregs : tmaybesave;
          l,l2,l3       : tasmlabel;
 
+{$ifdef oldset}
+         function analizeset(Aset:Pconstset;is_small:boolean):boolean;
+	   type
+             byteset=set of byte;
+{$else}
          function analizeset(const Aset:Tconstset;is_small:boolean):boolean;
+{$endif}
            var
              compares,maxcompares:word;
-	     
              i:byte;
            begin
              analizeset:=false;
@@ -159,7 +164,11 @@ implementation
              if is_small then
               maxcompares:=3;
              for i:=0 to 255 do
+	     {$ifdef oldset}
+              if i in byteset(Aset^) then
+	     {$else}
               if i in Aset then
+	     {$endif}
                begin
                  if (numparts=0) or (i<>setparts[numparts].stop+1) then
                   begin
@@ -207,8 +216,13 @@ implementation
                      (left.resulttype.def.deftype=enumdef) and (tenumdef(left.resulttype.def).max<=32));
 
          { Can we generate jumps? Possible for all types of sets }
+{$ifdef oldset}
+         genjumps:=(right.nodetype=setconstn) and
+                   analizeset(Tsetconstnode(right).value_set,use_small);
+{$else}
          genjumps:=(right.nodetype=setconstn) and
                    analizeset(Tsetconstnode(right).value_set^,use_small);
+{$endif}
          { calculate both operators }
          { the complex one first }
          firstcomplex(self);
@@ -570,7 +584,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2002-07-22 11:48:04  daniel
+  Revision 1.9  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.8  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.7  2002/07/21 16:58:20  jonas

+ 24 - 1
compiler/ncnv.pas

@@ -239,6 +239,11 @@ implementation
 
         procedure do_set(pos : longint);
 
+	{$ifdef oldset}
+        var
+          mask,l : longint;
+	{$endif}
+
         begin
           if (pos and not $ff)<>0 then
            Message(parser_e_illegal_set_expr);
@@ -246,7 +251,17 @@ implementation
            constsethi:=pos;
           if pos<constsetlo then
            constsetlo:=pos;
+	{$ifdef oldset}
+          { to do this correctly we use the 32bit array }
+          l:=pos shr 5;
+          mask:=1 shl (pos mod 32);
+          { do we allow the same twice }
+          if (pconst32bitset(constset)^[l] and mask)<>0 then
+           Message(parser_e_illegal_set_expr);
+          pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask;
+	{$else}
 	  include(constset^,pos);
+	{$endif}
         end;
 
       var
@@ -257,7 +272,11 @@ implementation
         if p.nodetype<>arrayconstructorn then
          internalerror(200205105);
 	new(constset);
+      {$ifdef oldset}
+        FillChar(constset^,sizeof(constset^),0);
+      {$else}
 	constset^:=[];
+      {$endif}
         htype.reset;
         constsetlo:=0;
         constsethi:=0;
@@ -1751,7 +1770,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.63  2002-07-23 09:51:22  daniel
+  Revision 1.64  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.63  2002/07/23 09:51:22  daniel
   * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
     are worth comitting.
 

+ 40 - 1
compiler/ncon.pas

@@ -250,13 +250,28 @@ implementation
          str_length:=tstringconstnode(p).len;
       end;
 
+{$ifdef oldset}
+    function is_emptyset(p : tnode):boolean;
 
+      var
+        i : longint;
+      begin
+        i:=0;
+        if p.nodetype=setconstn then
+         begin
+           while (i<32) and (tsetconstnode(p).value_set^[i]=0) do
+            inc(i);
+         end;
+        is_emptyset:=(i=32);
+      end;
+{$else}
     function is_emptyset(p : tnode):boolean;
 
     begin
         is_emptyset:=(p.nodetype=setconstn) and 
 	 (Tsetconstnode(p).value_set^=[]);
     end;
+{$endif}
 
 
     function genconstsymtree(p : tconstsym) : tnode;
@@ -633,12 +648,32 @@ implementation
           location.loc:=LOC_CREFERENCE;
       end;
 
+{$ifdef oldset}
+    function tsetconstnode.docompare(p: tnode): boolean;
+      var
+        i: 0..31;
+      begin
+        if inherited docompare(p) then
+          begin
+            for i := 0 to 31 do
+              if (value_set^[i] <> tsetconstnode(p).value_set^[i]) then
+                begin
+                  docompare := false;
+                  exit
+                end;
+            docompare := true;
+          end
+        else
+          docompare := false;
+      end;
+{$else}
     function tsetconstnode.docompare(p: tnode): boolean;
 
     begin
 	docompare:=(inherited docompare(p))
 	 and (value_set^=Tsetconstnode(p).value_set^);
     end;
+{$endif}
 
 {*****************************************************************************
                                TNILNODE
@@ -715,7 +750,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-07-22 11:48:04  daniel
+  Revision 1.37  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.36  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.35  2002/07/20 11:57:54  florian

+ 10 - 2
compiler/node.pas

@@ -35,9 +35,13 @@ interface
 
     type
        pconstset = ^tconstset;
-       tconstset = set of 0..255;
+    {$ifdef oldset}
+       tconstset = array[0..31] of byte;
        pconst32bitset = ^tconst32bitset;
        tconst32bitset = array[0..7] of longint;
+    {$else}
+       tconstset = set of 0..255;
+    {$endif}
 
        tnodetype = (
           addn,     {Represents the + operator.}
@@ -823,7 +827,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  2002-07-22 11:48:04  daniel
+  Revision 1.33  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.32  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.31  2002/07/21 06:58:49  daniel

+ 22 - 2
compiler/nset.pas

@@ -177,6 +177,10 @@ implementation
 
     function tinnode.det_resulttype:tnode;
 
+{$ifdef oldset}
+      type
+        byteset = set of byte;
+{$endif}
       var
         t : tnode;
         pst : pconstset;
@@ -194,14 +198,22 @@ implementation
                 pes:=tenumsym(tenumdef(psd.elementtype.def).firstenum);
                 while assigned(pes) do
                   begin
+		{$ifdef oldset}
+		    pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8));
+		{$else}
 		    include(pcs^,pes.value);
+		{$endif}
                     pes:=pes.nextenum;
                   end;
               end;
             orddef :
               begin
                 for i:=torddef(psd.elementtype.def).low to torddef(psd.elementtype.def).high do
+		{$ifdef oldset}
+                    pcs^[i div 8]:=pcs^[i div 8] or (1 shl (i mod 8));
+		{$else}
 		    include(pcs^,i);
+		{$endif}
               end;
           end;
           createsetconst:=pcs;
@@ -255,10 +267,14 @@ implementation
             exit;
           end;
 
-         { constant evaulation }
+         { constant evaluation }
          if (left.nodetype=ordconstn) and (right.nodetype=setconstn) then
           begin
+	{$ifdef oldset}
+	    t:=cordconstnode.create(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booltype);
+	{$else}
             t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),booltype);
+	{$endif}
             resulttypepass(t);
             result:=t;
             exit;
@@ -575,7 +591,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.28  2002-07-22 11:48:04  daniel
+  Revision 1.29  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.28  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.27  2002/07/20 11:57:55  florian

+ 16 - 1
compiler/ptconst.pas

@@ -445,7 +445,11 @@ implementation
                         if source_info.endian = target_info.endian then
                           begin
                             for l:=0 to p.resulttype.def.size-1 do
+			    {$ifdef oldset}
+			       curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[l]));
+			    {$else}
                                curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[l]));
+			    {$endif}
                           end
                         else
                           begin
@@ -453,10 +457,17 @@ implementation
                             j:=0;
                             for l:=0 to ((p.resulttype.def.size-1) div 4) do
                               begin
+			{$ifdef oldset}
+                		curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+3]));
+                		curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+2]));
+                		curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j+1]));
+                		curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[j]));
+			{$else}
                                 curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+3]));
                                 curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+2]));
                                 curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+1]));
                                 curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j]));
+			{$endif}
                                 Inc(j,4);
                               end;
                           end;
@@ -975,7 +986,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  2002-07-22 11:48:04  daniel
+  Revision 1.53  2002-07-23 12:34:30  daniel
+  * Readded old set code. To use it define 'oldset'. Activated by default
+    for ppc.
+
+  Revision 1.52  2002/07/22 11:48:04  daniel
   * Sets are now internally sets.
 
   Revision 1.51  2002/07/20 11:57:56  florian