Browse Source

* sets are not written twice anymore
* optimize for emptyset+single element which uses a new routine from
set.inc FPC_SET_CREATE_ELEMENT

peter 27 years ago
parent
commit
6756b4ec78
3 changed files with 155 additions and 37 deletions
  1. 48 20
      compiler/cg386add.pas
  2. 83 16
      compiler/cg386con.pas
  3. 24 1
      compiler/tree.pas

+ 48 - 20
compiler/cg386add.pas

@@ -23,6 +23,8 @@
 unit cg386add;
 interface
 
+{$define usecreateset}
+
     uses
       tree;
 
@@ -315,6 +317,7 @@ implementation
 
     procedure addset(var p : ptree);
       var
+        createset,
         cmpop,
         pushed : boolean;
         href   : treference;
@@ -326,7 +329,18 @@ implementation
         if p^.swaped then
          swaptree(p);
 
-        secondpass(p^.left);
+        { optimize first loading of a set }
+{$ifdef usecreateset}
+        if (p^.right^.treetype=setelementn) and
+           is_emptyset(p^.left) then
+         createset:=true
+        else
+{$endif}
+         begin
+           createset:=false;
+           secondpass(p^.left);
+         end;
+
         { are too few registers free? }
         pushed:=maybe_push(p^.right^.registers32,p);
         secondpass(p^.right);
@@ -360,31 +374,40 @@ implementation
                      pushusedregisters(pushedregs,$ff);
                      href.symbol:=nil;
                      gettempofsizereference(32,href);
-                   { add a range or a single element? }
-                     if p^.right^.treetype=setelementn then
+                     if createset then
+                      begin
+                        pushsetelement(p^.right^.left);
+                        emitpushreferenceaddr(exprasmlist,href);
+                        emitcall('FPC_SET_CREATE_ELEMENT',true);
+                      end
+                     else
                       begin
-                        concatcopy(p^.left^.location.reference,href,32,false,false);
-                        if assigned(p^.right^.right) then
+                      { add a range or a single element? }
+                        if p^.right^.treetype=setelementn then
                          begin
-                           pushsetelement(p^.right^.right);
-                           pushsetelement(p^.right^.left);
-                           emitpushreferenceaddr(exprasmlist,href);
-                           emitcall('FPC_SET_SET_RANGE',true);
+                           concatcopy(p^.left^.location.reference,href,32,false,false);
+                           if assigned(p^.right^.right) then
+                            begin
+                              pushsetelement(p^.right^.right);
+                              pushsetelement(p^.right^.left);
+                              emitpushreferenceaddr(exprasmlist,href);
+                              emitcall('FPC_SET_SET_RANGE',true);
+                            end
+                           else
+                            begin
+                              pushsetelement(p^.right^.left);
+                              emitpushreferenceaddr(exprasmlist,href);
+                              emitcall('FPC_SET_SET_BYTE',true);
+                            end;
                          end
                         else
                          begin
-                           pushsetelement(p^.right^.left);
+                         { must be an other set }
                            emitpushreferenceaddr(exprasmlist,href);
-                           emitcall('FPC_SET_SET_BYTE',true);
+                           emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                           emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                           emitcall('FPC_SET_ADD_SETS',true);
                          end;
-                      end
-                     else
-                      begin
-                      { must be an other set }
-                        emitpushreferenceaddr(exprasmlist,href);
-                        emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
-                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                        emitcall('FPC_SET_ADD_SETS',true);
                       end;
                      maybe_loadesi;
                      popusedregisters(pushedregs);
@@ -1364,7 +1387,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  1998-11-18 15:44:05  peter
+  Revision 1.30  1998-11-24 12:52:40  peter
+    * sets are not written twice anymore
+    * optimize for emptyset+single element which uses a new routine from
+      set.inc FPC_SET_CREATE_ELEMENT
+
+  Revision 1.29  1998/11/18 15:44:05  peter
     * VALUEPARA for tp7 compatible value parameters
 
   Revision 1.28  1998/11/18 09:18:01  pierre

+ 83 - 16
compiler/cg386con.pas

@@ -245,8 +245,10 @@ implementation
 
     procedure secondsetconst(var p : ptree);
       var
-         lastlabel : plabel;
-         i : longint;
+         hp1         : pai;
+         lastlabel   : plabel;
+         i           : longint;
+         neededtyp   : tait;
       begin
 {$ifdef SMALLSETORD}
         if psetdef(p^.resulttype)^.settype=smallset then
@@ -269,21 +271,81 @@ implementation
            p^.location.loc:=LOC_MEM;
          end;
 {$else}
-        getdatalabel(lastlabel);
-        p^.lab_set:=lastlabel;
-        if (cs_smartlink in aktmoduleswitches) then
-         consts^.concat(new(pai_cut,init));
-        consts^.concat(new(pai_label,init(lastlabel)));
         if psetdef(p^.resulttype)^.settype=smallset then
-         begin
-           move(p^.value_set^,i,sizeof(longint));
-           consts^.concat(new(pai_const,init_32bit(i)));
-         end
+         neededtyp:=ait_const_32bit
         else
-         begin
-           for i:=0 to 31 do
-             consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
-         end;
+         neededtyp:=ait_const_8bit;
+        lastlabel:=nil;
+        { const already used ? }
+        if not assigned(p^.lab_set) then
+          begin
+             { tries to found an old entry }
+             hp1:=pai(consts^.first);
+             while assigned(hp1) do
+               begin
+                  if hp1^.typ=ait_label then
+                    lastlabel:=pai_label(hp1)^.l
+                  else
+                    begin
+                      if (lastlabel<>nil) and (hp1^.typ=neededtyp) then
+                        begin
+                          if (hp1^.typ=ait_const_8bit) then
+                           begin
+                             { compare normal set }
+                             i:=0;
+                             while assigned(hp1) and (i<32) do
+                              begin
+                                if pai_const(hp1)^.value<>p^.value_set^[i] then
+                                 break;
+                                inc(i);
+                                hp1:=pai(hp1^.next);
+                              end;
+                             if i=32 then
+                              begin
+                                { found! }
+                                p^.lab_set:=lastlabel;
+                                break;
+                              end;
+                             { leave when the end of consts is reached, so no
+                               hp1^.next is done }
+                             if not assigned(hp1) then
+                              break;
+                           end
+                          else
+                           begin
+                             { compare small set }
+                             if plongint(p^.value_set)^=pai_const(hp1)^.value then
+                              begin
+                                { found! }
+                                p^.lab_set:=lastlabel;
+                                break;
+                              end;
+                           end;
+                        end;
+                      lastlabel:=nil;
+                    end;
+                  hp1:=pai(hp1^.next);
+               end;
+             { :-(, we must generate a new entry }
+             if not assigned(p^.lab_set) then
+               begin
+                 getdatalabel(lastlabel);
+                 p^.lab_set:=lastlabel;
+                 if (cs_smartlink in aktmoduleswitches) then
+                  consts^.concat(new(pai_cut,init));
+                 consts^.concat(new(pai_label,init(lastlabel)));
+                 if psetdef(p^.resulttype)^.settype=smallset then
+                  begin
+                    move(p^.value_set^,i,sizeof(longint));
+                    consts^.concat(new(pai_const,init_32bit(i)));
+                  end
+                 else
+                  begin
+                    for i:=0 to 31 do
+                      consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
+                  end;
+               end;
+          end;
         clear_reference(p^.location.reference);
         p^.location.reference.symbol:=stringdup(lab2str(p^.lab_set));
         p^.location.loc:=LOC_MEM;
@@ -306,7 +368,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  1998-11-16 12:11:29  peter
+  Revision 1.21  1998-11-24 12:52:41  peter
+    * sets are not written twice anymore
+    * optimize for emptyset+single element which uses a new routine from
+      set.inc FPC_SET_CREATE_ELEMENT
+
+  Revision 1.20  1998/11/16 12:11:29  peter
     * fixed ansistring crash
 
   Revision 1.19  1998/11/05 23:40:45  pierre

+ 24 - 1
compiler/tree.pas

@@ -299,6 +299,7 @@ unit tree;
     function is_constrealnode(p : ptree) : boolean;
     function is_constcharnode(p : ptree) : boolean;
     function str_length(p : ptree) : longint;
+    function is_emptyset(p : ptree):boolean;
 
 {$I innr.inc}
 
@@ -1601,10 +1602,32 @@ unit tree;
       end;
 
 
+    function is_emptyset(p : ptree):boolean;
+    {
+      return true if set s is empty
+    }
+      var
+        i : longint;
+      begin
+        i:=0;
+        if p^.treetype=setconstn then
+         begin
+           while (i<32) and (p^.value_set^[i]=0) do
+            inc(i);
+         end;
+        is_emptyset:=(i=32);
+      end;
+
+
 end.
 {
   $Log$
-  Revision 1.52  1998-11-23 17:51:58  pierre
+  Revision 1.53  1998-11-24 12:52:42  peter
+    * sets are not written twice anymore
+    * optimize for emptyset+single element which uses a new routine from
+      set.inc FPC_SET_CREATE_ELEMENT
+
+  Revision 1.52  1998/11/23 17:51:58  pierre
    * added checking before dispose of reference string
 
   Revision 1.51  1998/11/13 10:15:53  peter