+ dynamic set contruction

  * smallsets are now working (always longint size)

compiler/cg386add.pas

@@ -36,26 +36,22 @@ implementation
       cgi386,cgai386,temp_gen,tgeni386,hcodegen;
 
 {*****************************************************************************
-                             SecondAdd
+                                Helpers
 *****************************************************************************}
 
-    procedure setaddresult(cmpop,unsigned : boolean;var p :ptree);
+    procedure SetResultLocation(cmpop,unsigned:boolean;var p :ptree);
       var
          flags : tresflags;
       begin
+         { remove temporary location if not a set or string }
          if (p^.left^.resulttype^.deftype<>stringdef) and
-             ((p^.left^.resulttype^.deftype<>setdef) or
-              (psetdef(p^.left^.resulttype)^.settype=smallset)) then
-              if (p^.left^.location.loc=LOC_REFERENCE) or
-                 (p^.left^.location.loc=LOC_MEM) then
-                ungetiftemp(p^.left^.location.reference);
+            ((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
+            (p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+           ungetiftemp(p^.left^.location.reference);
          if (p^.right^.resulttype^.deftype<>stringdef) and
-             ((p^.right^.resulttype^.deftype<>setdef) or
-              (psetdef(p^.right^.resulttype)^.settype=smallset)) then
-              { this can be useful if for instance length(string) is called }
-              if (p^.right^.location.loc=LOC_REFERENCE) or
-                 (p^.right^.location.loc=LOC_MEM) then
-                ungetiftemp(p^.right^.location.reference);
+            ((p^.right^.resulttype^.deftype<>setdef) or (psetdef(p^.right^.resulttype)^.settype=smallset)) and
+            (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+           ungetiftemp(p^.right^.location.reference);
          { in case of comparison operation the put result in the flags }
          if cmpop then
            begin
@@ -107,24 +103,21 @@ implementation
       end;
 
 
-  procedure addstring(var p : ptree);
-
-    var
-       swapp : ptree;
-       pushedregs : tpushed;
-       href : treference;
-       pushed,cmpop : boolean;
-
-    begin
-       { string operations are not commutative }
-       if p^.swaped then
-         begin
-            swapp:=p^.left;
-            p^.left:=p^.right;
-            p^.right:=swapp;
-            { because of jump being produced at comparison below: }
-            p^.swaped:=not(p^.swaped);
-         end;
+{*****************************************************************************
+                                Addstring
+*****************************************************************************}
+
+    procedure addstring(var p : ptree);
+      var
+        pushedregs : tpushed;
+        href       : treference;
+        pushed,
+        cmpop      : boolean;
+      begin
+        { string operations are not commutative }
+        if p^.swaped then
+         swaptree(p);
+
 {$ifdef UseAnsiString}
               if is_ansistring(p^.left^.resulttype) then
                 begin
@@ -278,11 +271,135 @@ implementation
             end;
             else Message(sym_e_type_mismatch);
           end;
-       setaddresult(cmpop,true,p);
-    end;
+        SetResultLocation(cmpop,true,p);
+      end;
 
-    procedure secondadd(var p : ptree);
 
+{*****************************************************************************
+                                Addset
+*****************************************************************************}
+
+    procedure addset(var p : ptree);
+      var
+        right_small,
+        cmpop,
+        pushed : boolean;
+        href2,
+        href   : treference;
+        swapp  : ptree;
+        pushedregs : tpushed;
+      begin
+        cmpop:=false;
+
+        { not commutative }
+        if p^.swaped then
+         swaptree(p);
+
+        secondpass(p^.left);
+        { are too few registers free? }
+        pushed:=maybe_push(p^.right^.registers32,p);
+        secondpass(p^.right);
+        if codegenerror then
+          exit;
+        if pushed then
+          restore(p);
+
+        set_location(p^.location,p^.left^.location);
+        right_small:=(p^.right^.resulttype^.deftype=setdef) and (psetdef(p^.right^.resulttype)^.settype=smallset);
+
+        { handle operations }
+        reset_reference(href2);
+        case p^.treetype of
+          equaln,
+        unequaln : begin
+                     cmpop:=true;
+                     del_reference(p^.left^.location.reference);
+                     del_reference(p^.right^.location.reference);
+                     pushusedregisters(pushedregs,$ff);
+                     emitpushreferenceaddr(exprasmlist,href2);
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     emitcall('SET_COMP_SETS',true);
+                     maybe_loadesi;
+                     popusedregisters(pushedregs);
+                     ungetiftemp(p^.left^.location.reference);
+                     ungetiftemp(p^.right^.location.reference);
+                   end;
+            addn : begin
+                   { add can be an other SET or Range or Element ! }
+                     del_reference(p^.left^.location.reference);
+                     del_reference(p^.right^.location.reference);
+                     pushusedregisters(pushedregs,$ff);
+                     href.symbol:=nil;
+                     gettempofsizereference(32,href);
+                     case p^.right^.treetype of
+                    setelen : begin
+                                concatcopy(p^.left^.location.reference,href,32,false);
+                                pushsetelement(p^.right^.left);
+                                emitpushreferenceaddr(exprasmlist,href);
+                                emitcall('SET_SET_BYTE',true);
+                              end;
+                     rangen : begin
+                                concatcopy(p^.left^.location.reference,href,32,false);
+                                pushsetelement(p^.right^.right);
+                                pushsetelement(p^.right^.left);
+                                emitpushreferenceaddr(exprasmlist,href);
+                                emitcall('SET_SET_RANGE',true);
+                              end;
+                     else
+                      begin
+                      { must be an other set }
+                        emitpushreferenceaddr(exprasmlist,href);
+                        emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                        emitcall('SET_ADD_SETS',true);
+                      end;
+                     end;
+                     maybe_loadesi;
+                     popusedregisters(pushedregs);
+                     ungetiftemp(p^.left^.location.reference);
+                     ungetiftemp(p^.right^.location.reference);
+                     p^.location.loc:=LOC_MEM;
+                     stringdispose(p^.location.reference.symbol);
+                     p^.location.reference:=href;
+                   end;
+            subn,
+         symdifn,
+            muln : begin
+                     if p^.right^.treetype in [rangen,setelen] then
+                      internalerror(45362);
+                     del_reference(p^.left^.location.reference);
+                     del_reference(p^.right^.location.reference);
+                     href.symbol:=nil;
+                     pushusedregisters(pushedregs,$ff);
+                     gettempofsizereference(32,href);
+                     emitpushreferenceaddr(exprasmlist,href);
+                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     case p^.treetype of
+                      subn : emitcall('SET_SUB_SETS',true);
+                   symdifn : emitcall('SET_SYMDIF_SETS',true);
+                      muln : emitcall('SET_MUL_SETS',true);
+                     end;
+                     maybe_loadesi;
+                     popusedregisters(pushedregs);
+                     ungetiftemp(p^.left^.location.reference);
+                     ungetiftemp(p^.right^.location.reference);
+                     p^.location.loc:=LOC_MEM;
+                     stringdispose(p^.location.reference.symbol);
+                     p^.location.reference:=href;
+                   end;
+        else
+          Message(sym_e_type_mismatch);
+        end;
+        SetResultLocation(cmpop,true,p);
+      end;
+
+
+{*****************************************************************************
+                                SecondAdd
+*****************************************************************************}
+
+    procedure secondadd(var p : ptree);
     { is also being used for xor, and "mul", "sub, or and comparative }
     { operators                                                       }
 
@@ -317,11 +434,23 @@ implementation
 {$endif SUPPORT_MMX}
 
       begin
-         if (p^.left^.resulttype^.deftype=stringdef) then
-           begin
-              addstring(p);
-              exit;
-           end;
+      { to make it more readable, string and set (not smallset!) have their
+        own procedures }
+        case p^.left^.resulttype^.deftype of
+         stringdef : begin
+                       addstring(p);
+                       exit;
+                     end;
+            setdef : begin
+                     { not for smallsets }
+                       if not(psetdef(p^.left^.resulttype)^.settype=smallset) then
+                        begin
+                          addset(p);
+                          exit;
+                        end;
+                     end;
+        end;
+
          unsigned:=false;
          is_in_dest:=false;
          extra_not:=false;
@@ -376,12 +505,7 @@ implementation
           unequaln,
        equaln,xorn : begin
                        if p^.left^.treetype=ordconstn then
-                         begin
-                            swapp:=p^.right;
-                            p^.right:=p^.left;
-                            p^.left:=swapp;
-                            p^.swaped:=not(p^.swaped);
-                         end;
+                        swaptree(p);
                        secondpass(p^.left);
                        p^.location:=p^.left^.location;
                        { are enough registers free ? }
@@ -394,84 +518,11 @@ implementation
                Message(sym_e_type_mismatch);
              end
            end
-         else if (p^.left^.resulttype^.deftype=setdef) and
-                 not(psetdef(p^.left^.resulttype)^.settype=smallset) then
-           begin
-              mboverflow:=false;
-              secondpass(p^.left);
-              set_location(p^.location,p^.left^.location);
-              { are too few registers free? }
-              pushed:=maybe_push(p^.right^.registers32,p);
-              secondpass(p^.right);
-              if pushed then restore(p);
-              { not commutative }
-              if p^.swaped then
-                begin
-                   swapp:=p^.left;
-                   p^.left:=p^.right;
-                   p^.right:=swapp;
-                   { because of jump being produced by comparison }
-                   p^.swaped:=not(p^.swaped);
-                end;
-              case p^.treetype of
-                equaln,unequaln:
-                  begin
-                     cmpop:=true;
-                     del_reference(p^.left^.location.reference);
-                     del_reference(p^.right^.location.reference);
-                     pushusedregisters(pushedregs,$ff);
-                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
-                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                     emitcall('SET_COMP_SETS',true);
-                     maybe_loadesi;
-                     popusedregisters(pushedregs);
-                     ungetiftemp(p^.left^.location.reference);
-                     ungetiftemp(p^.right^.location.reference);
-                  end;
-                addn,symdifn,subn,muln:
-                  begin
-                     cmpop:=false;
-                     del_reference(p^.left^.location.reference);
-                     del_reference(p^.right^.location.reference);
-                     href.symbol:=nil;
-                     pushusedregisters(pushedregs,$ff);
-                     gettempofsizereference(32,href);
-                     emitpushreferenceaddr(exprasmlist,href);
-                     { wrong place !! was hard to find out
-                     pushusedregisters(pushedregs,$ff);}
-                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
-                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                     case p^.treetype of
-                       subn:
-                         emitcall('SET_SUB_SETS',true);
-                       addn:
-                         emitcall('SET_ADD_SETS',true);
-                       symdifn:
-                         emitcall('SET_SYMDIF_SETS',true);
-                       muln:
-                         emitcall('SET_MUL_SETS',true);
-                     end;
-                     maybe_loadesi;
-                     popusedregisters(pushedregs);
-                     ungetiftemp(p^.left^.location.reference);
-                     ungetiftemp(p^.right^.location.reference);
-                     p^.location.loc:=LOC_MEM;
-                     stringdispose(p^.location.reference.symbol);
-                     p^.location.reference:=href;
-                  end;
-                else Message(sym_e_type_mismatch);
-              end;
-           end
          else
            begin
               { in case of constant put it to the left }
               if p^.left^.treetype=ordconstn then
-                begin
-                   swapp:=p^.right;
-                   p^.right:=p^.left;
-                   p^.left:=swapp;
-                   p^.swaped:=not(p^.swaped);
-                end;
+               swaptree(p);
               secondpass(p^.left);
               { this will be complicated as
                a lot of code below assumes that
@@ -488,10 +539,13 @@ implementation
               else
 {$endif test_dest_loc}
                 set_location(p^.location,p^.left^.location);
+
               { are too few registers free? }
               pushed:=maybe_push(p^.right^.registers32,p);
               secondpass(p^.right);
-              if pushed then restore(p);
+              if pushed then
+                restore(p);
+
               if (p^.left^.resulttype^.deftype=pointerdef) or
 
                  (p^.right^.resulttype^.deftype=pointerdef) or
@@ -534,7 +588,6 @@ implementation
                       (porddef(p^.right^.resulttype)^.typ=u32bit)) then
                      unsigned:=true;
                    is_set:=p^.resulttype^.deftype=setdef;
-
                    case p^.treetype of
                       addn : begin
                                 if is_set then
@@ -606,7 +659,7 @@ implementation
                    { left and right no register?  }
                    { then one must be demanded    }
                    if (p^.left^.location.loc<>LOC_REGISTER) and
-                     (p^.right^.location.loc<>LOC_REGISTER) then
+                      (p^.right^.location.loc<>LOC_REGISTER) then
                      begin
                         { register variable ? }
                         if (p^.left^.location.loc=LOC_CREGISTER) then
@@ -633,12 +686,10 @@ implementation
                                   emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
                                     hregister);
                                end
-
                           end
                         else
                           begin
                              del_reference(p^.left^.location.reference);
-
                              if is_in_dest then
                                begin
                                   hregister:=p^.location.register;
@@ -657,10 +708,8 @@ implementation
                                     newreference(p^.left^.location.reference),hregister)));
                                end;
                           end;
-
                         p^.location.loc:=LOC_REGISTER;
                         p^.location.register:=hregister;
-
                      end
                    else
                      { if on the right the register then swap }
@@ -896,12 +945,7 @@ implementation
                  begin
                     { real constants to the left }
                     if p^.left^.treetype=realconstn then
-                      begin
-                         swapp:=p^.right;
-                         p^.right:=p^.left;
-                         p^.left:=swapp;
-                         p^.swaped:=not(p^.swaped);
-                      end;
+                      swaptree(p);
                     cmpop:=false;
                     case p^.treetype of
                        addn : op:=A_FADDP;
@@ -1094,7 +1138,6 @@ implementation
                                   emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
                                     hregister);
                                end
-
                           end
                         else
                           begin
@@ -1113,17 +1156,14 @@ implementation
                                     newreference(p^.left^.location.reference),hregister)));
                                end;
                           end;
-
                         p^.location.loc:=LOC_MMXREGISTER;
                         p^.location.register:=hregister;
-
                      end
                    else
                      { if on the right the register then swap }
                      if (p^.right^.location.loc=LOC_MMXREGISTER) then
                        begin
                           swap_location(p^.location,p^.right^.location);
-
                           { newly swapped also set swapped flag }
                           p^.swaped:=not(p^.swaped);
                        end;
@@ -1142,7 +1182,6 @@ implementation
                                end
                              else
                                begin
-
                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
                                     newreference(p^.right^.location.reference),R_MM7)));
                                   exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,p^.location.register,
@@ -1191,14 +1230,18 @@ implementation
 {$endif SUPPORT_MMX}
               else Message(sym_e_type_mismatch);
            end;
-       setaddresult(cmpop,unsigned,p);
+       SetResultLocation(cmpop,unsigned,p);
     end;
 
 
 end.
 {
   $Log$
-  Revision 1.4  1998-08-10 14:49:42  peter
+  Revision 1.5  1998-08-14 18:18:37  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.4  1998/08/10 14:49:42  peter
     + localswitches, moduleswitches, globalswitches splitting
 
   Revision 1.3  1998/06/25 08:48:04  florian

compiler/cg386cnv.pas

@@ -1018,6 +1018,26 @@ implementation
          end;
      end;
 
+
+    procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
+      var
+        href : treference;
+        pushedregs : tpushed;
+      begin
+        href.symbol:=nil;
+        pushusedregisters(pushedregs,$ff);
+        gettempofsizereference(32,href);
+        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+        emitpushreferenceaddr(exprasmlist,href);
+        emitcall('SET_LOAD_SMALL',true);
+        maybe_loadesi;
+        popusedregisters(pushedregs);
+        p^.location.loc:=LOC_MEM;
+        stringdispose(p^.location.reference.symbol);
+        p^.location.reference:=href;
+      end;
+
+
     procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
       begin
       end;
@@ -1030,8 +1050,9 @@ implementation
     procedure secondtypeconv(var p : ptree);
 
       const
-         secondconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
-           tsecondconvproc = (second_bigger,second_only_rangecheck,
+         secondconvert : array[tconverttype] of
+           tsecondconvproc = (second_nothing,second_nothing,
+           second_bigger,second_only_rangecheck,
            second_bigger,second_bigger,second_bigger,
            second_smaller,second_smaller,
            second_smaller,second_string_string,
@@ -1053,7 +1074,8 @@ implementation
            second_chararray_to_string,
            second_proc_to_procvar,
            { is constant char to pchar, is done by firstpass }
-           second_nothing);
+           second_nothing,
+           second_load_smallset);
 
       begin
          { this isn't good coding, I think tc_bool_2_int, shouldn't be }
@@ -1065,8 +1087,11 @@ implementation
            begin
               secondpass(p^.left);
               set_location(p^.location,p^.left^.location);
+              if codegenerror then
+               exit;
            end;
-         if (p^.convtyp<>tc_equal) and (p^.convtyp<>tc_not_possible) then
+
+         if not(p^.convtyp in [tc_equal,tc_not_possible]) then
            {the second argument only is for maybe_range_checking !}
            secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
       end;
@@ -1180,7 +1205,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  1998-08-10 23:59:59  peter
+  Revision 1.12  1998-08-14 18:18:38  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.11  1998/08/10 23:59:59  peter
     * fixed dup log
 
   Revision 1.10  1998/08/10 14:49:47  peter

compiler/cg386con.pas

@@ -267,86 +267,23 @@ implementation
          i : longint;
          hp : ptree;
          href,sref : treference;
-{$ifdef TestSmallSet}
-         smallsetvalue : longint;
-         hr,hr2 : tregister;
-{$endif TestSmallSet}
       begin
-         { this should be reimplemented for smallsets }
-         { differently  (PM) }
-         { produce constant part }
-{$ifdef TestSmallSet}
-         if psetdef(p^.resulttype)^.settype=smallset then
-           begin
-              smallsetvalue:=(p^.constset^[3]*256)+p^.constset^[2];
-              smallsetvalue:=(smallsetvalue*256+p^.constset^[1])*256+p^.constset^[0];
-              {consts^.concat(new(pai_const,init_32bit(smallsetvalue)));}
-              hr:=getregister32;
-              exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
-                smallsetvalue,hr)));
-              hp:=p^.left;
-              if assigned(hp) then
-                begin
-                   while assigned(hp) do
-                     begin
-                        secondpass(hp^.left);
-                        if codegenerror then
-                          exit;
-                        case hp^.left^.location.loc of
-                          LOC_MEM,LOC_REFERENCE :
-                            begin
-                               hr2:=getregister32;
-                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                               newreference(hp^.left^.location.reference),hr2)));
-                               exprasmlist^.concat(new(pai386,op_reg_reg(A_BTS,S_NO,
-                                 hr2,hr)));
-                               ungetregister32(hr2);
-                            end;
-                          LOC_REGISTER,LOC_CREGISTER :
-                            exprasmlist^.concat(new(pai386,op_reg_reg(A_BTS,S_NO,
-                              hp^.left^.location.register,hr)));
-                          else
-                            internalerror(10567);
-                          end;
-                        hp:=hp^.right;
-                     end;
-                end;
-              p^.location.loc:=LOC_REGISTER;
-              p^.location.register:=hr;
-           end
-         else
-{$endif TestSmallSet}
-           begin
-             href.symbol := Nil;
-             clear_reference(href);
-             getlabel(l);
-             stringdispose(p^.location.reference.symbol);
-             href.symbol:=stringdup(constlabel2str(l,constseta));
-             concat_constlabel(l,constseta);
-             for i:=0 to 31 do
-               consts^.concat(new(pai_const,init_8bit(p^.constset^[i])));
-             hp:=p^.left;
-             if assigned(hp) then
-               begin
-                  sref.symbol:=nil;
-                  gettempofsizereference(32,sref);
-                  concatcopy(href,sref,32,false);
-                  while assigned(hp) do
-                    begin
-                       secondpass(hp^.left);
-                       if codegenerror then
-                         exit;
-                       pushsetelement(hp^.left);
-                       emitpushreferenceaddr(exprasmlist,sref);
-                       { register is save in subroutine }
-                       emitcall('SET_SET_BYTE',true);
-                       hp:=hp^.right;
-                    end;
-                  p^.location.reference:=sref;
-               end
-             else
-               p^.location.reference:=href;
-           end;
+        reset_reference(href);
+        getlabel(l);
+        stringdispose(p^.location.reference.symbol);
+        href.symbol:=stringdup(constlabel2str(l,constseta));
+        concat_constlabel(l,constseta);
+        if psetdef(p^.resulttype)^.settype=smallset then
+         begin
+           move(p^.constset^,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^.constset^[i])));
+         end;
+        p^.location.reference:=href;
       end;
 
 
@@ -365,7 +302,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  1998-08-04 13:22:46  pierre
+  Revision 1.11  1998-08-14 18:18:39  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.10  1998/08/04 13:22:46  pierre
     * weird bug fixed :
       a pchar ' ' (simple space or any other letter) was found to
       be equal to a string of length zero !!!

compiler/cg386set.pas

@@ -26,6 +26,8 @@ interface
     uses
       tree;
 
+    procedure secondrange(var p : ptree);
+    procedure secondsetele(var p : ptree);
     procedure secondin(var p : ptree);
     procedure secondcase(var p : ptree);
 
@@ -35,11 +37,40 @@ implementation
     uses
       cobjects,verbose,globals,systems,
       symtable,aasm,i386,types,
-      cgi386,cgai386,tgeni386,hcodegen;
+      cgi386,cgai386,tgeni386,temp_gen,hcodegen;
 
      const
        bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
 
+{*****************************************************************************
+                              SecondRange
+*****************************************************************************}
+
+    procedure secondrange(var p : ptree);
+       begin
+         secondpass(p^.left);
+         secondpass(p^.right);
+         { we doesn't modifiy the left side, we check only the type }
+         set_location(p^.location,p^.left^.location);
+       end;
+
+
+{*****************************************************************************
+                              SecondSetEle
+*****************************************************************************}
+
+    procedure secondsetele(var p : ptree);
+       begin
+         secondpass(p^.left);
+         { we doesn't modifiy the left side, we check only the type }
+         set_location(p^.location,p^.left^.location);
+         { return always in 32bit becuase set operations are done with
+           S_L opsize }
+         if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+          emit_to_reg32(p^.location.register);
+       end;
+
+
 {*****************************************************************************
                               SecondIn
 *****************************************************************************}
@@ -47,365 +78,353 @@ implementation
     procedure secondin(var p : ptree);
        type
          Tsetpart=record
-           range:boolean;      {Part is a range.}
-           start,stop:byte;    {Start/stop when range; Stop=element when an element.}
+           range : boolean;      {Part is a range.}
+           start,stop : byte;    {Start/stop when range; Stop=element when an element.}
          end;
        var
-         pushed,ranges : boolean;
-         hr,pleftreg : tregister;
-         opsize : topsize;
-         setparts:array[1..8] of Tsetpart;
-         i,numparts:byte;
-         href,href2:Treference;
-         l,l2 : plabel;
-
-               function analizeset(Aset:Pconstset):boolean;
-               type
-                 byteset=set of byte;
-               var
-                 compares,maxcompares:word;
-                 i:byte;
+         use_small,
+         pushed,
+         ranges     : boolean;
+         hr,hr2,
+         pleftreg   : tregister;
+         opsize     : topsize;
+         setparts   : array[1..8] of Tsetpart;
+         i,numparts : byte;
+         href,href2 : Treference;
+         l,l2       : plabel;
+
+         function analizeset(Aset:Pconstset;is_small:boolean):boolean;
+           type
+             byteset=set of byte;
+           var
+             compares,maxcompares:word;
+             i:byte;
+           begin
+             analizeset:=false;
+             ranges:=false;
+             numparts:=0;
+             compares:=0;
+             { Lots of comparisions take a lot of time, so do not allow
+               too much comparisions. 8 comparisions are, however, still
+               smalller than emitting the set }
+             if cs_littlesize in aktglobalswitches then
+              maxcompares:=8
+             else
+              maxcompares:=5;
+             { when smallset is possible allow only 3 compares the smallset
+               code is for littlesize also smaller when more compares are used }
+             if is_small then
+              maxcompares:=3;
+             for i:=0 to 255 do
+              if i in byteset(Aset^) then
                begin
-                    analizeset:=false;
-                    ranges:=false;
-                    numparts:=0;
-                    compares:=0;
-                    {Lots of comparisions take a lot of time, so do not allow
-                     too much comparisions. 8 comparisions are, however, still
-                     smalller than emitting the set.}
-                    maxcompares:=5;
-                    if cs_littlesize in aktglobalswitches then
-                         maxcompares:=8;
-                    for i:=0 to 255 do
-                         if i in byteset(Aset^) then
-                              begin
-                                   if (numparts=0) or
-                                    (i<>setparts[numparts].stop+1) then
-                                        begin
-                                             {Set element is a separate element.}
-                                             inc(compares);
-                                             if compares>maxcompares then
-                                                  exit;
-                                             inc(numparts);
-                                             setparts[numparts].range:=false;
-                                             setparts[numparts].stop:=i;
-                                        end
-                                    else
-                                        {Set element is part of a range.}
-                                        if not setparts[numparts].range then
-                                             begin
-                                                  {Transform an element into a range.}
-                                                  setparts[numparts].range:=true;
-                                                  setparts[numparts].start:=
-                                                   setparts[numparts].stop;
-                                                  setparts[numparts].stop:=i;
-                                                  inc(compares);
-                                                  if compares>maxcompares then
-                                                       exit;
-                                             end
-                                        else
-                                             begin
-                                                  {Extend a range.}
-                                                  setparts[numparts].stop:=i;
-                                                  {A range of two elements can better
-                                                   be checked as two separate ones.
-                                                   When extending a range, our range
-                                                   becomes larger than two elements.}
-                                                  ranges:=true;
-                                             end;
-                              end;
-                    analizeset:=true;
-               end;
+                 if (numparts=0) or (i<>setparts[numparts].stop+1) then
+                  begin
+                  {Set element is a separate element.}
+                    inc(compares);
+                    if compares>maxcompares then
+                         exit;
+                    inc(numparts);
+                    setparts[numparts].range:=false;
+                    setparts[numparts].stop:=i;
+                  end
+                 else
+                  {Set element is part of a range.}
+                  if not setparts[numparts].range then
+                   begin
+                     {Transform an element into a range.}
+                     setparts[numparts].range:=true;
+                     setparts[numparts].start:=setparts[numparts].stop;
+                     setparts[numparts].stop:=i;
+                     inc(compares);
+                     if compares>maxcompares then
+                      exit;
+                   end
+                 else
+                  begin
+                    {Extend a range.}
+                    setparts[numparts].stop:=i;
+                    {A range of two elements can better
+                     be checked as two separate ones.
+                     When extending a range, our range
+                     becomes larger than two elements.}
+                    ranges:=true;
+                  end;
+              end;
+             analizeset:=true;
+           end;
 
        begin
-           if psetdef(p^.right^.resulttype)^.settype=smallset then
+         { calculate both operators }
+         { the complex one first }
+         firstcomplex(p);
+         secondpass(p^.left);
+         { are too few registers free? }
+         pushed:=maybe_push(p^.right^.registers32,p^.left);
+         secondpass(p^.right);
+         if pushed then
+          restore(p^.left);
+         if codegenerror then
+          exit;
+
+         { ofcourse not commutative }
+         if p^.swaped then
+          swaptree(p);
+
+         { check if we can use smallset operation using btl which is limited
+           to 32 bits, the left side may also not contain higher values !! }
+         use_small:=(psetdef(p^.right^.resulttype)^.settype=smallset) and
+                    ((p^.left^.resulttype^.deftype=orddef) and (porddef(p^.left^.resulttype)^.high<=32) or
+                     (p^.left^.resulttype^.deftype=enumdef) and (penumdef(p^.left^.resulttype)^.max<=32));
+
+         { Can we generate jumps? Possible for all types of sets }
+         if (p^.right^.treetype=setconstrn) and
+            analizeset(p^.right^.constset,use_small) then
+          begin
+            { It gives us advantage to check for the set elements
+              separately instead of using the SET_IN_BYTE procedure.
+              To do: Build in support for LOC_JUMP }
+
+            { If register is used, use only lower 8 bits }
+            if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
              begin
-                 if p^.left^.treetype=ordconstn then
-                    begin
-                       { only compulsory }
-                       secondpass(p^.left);
-                            secondpass(p^.right);
-                       if codegenerror then
-                          exit;
-                       p^.location.resflags:=F_NE;
-                       case p^.right^.location.loc of
-                          LOC_REGISTER,LOC_CREGISTER:
-                            begin
-                               exprasmlist^.concat(new(pai386,op_const_reg(
-                                 A_TEST,S_L,1 shl (p^.left^.value and 31),
-                                 p^.right^.location.register)));
-                               ungetregister32(p^.right^.location.register);
-                            end
-                          else
-                            begin
-                               exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_L,1 shl (p^.left^.value and 31),
-                                 newreference(p^.right^.location.reference))));
-                               del_reference(p^.right^.location.reference);
-                            end;
-                       end;
-                    end
-                 else
+               pleftreg:=p^.left^.location.register;
+               if pleftreg in [R_AX..R_DX] then
+                begin
+                  exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_W,255,pleftreg)));
+                  opsize:=S_W;
+                end
+               else
+                if pleftreg in [R_EAX..R_EDI] then
+                 begin
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,255,pleftreg)));
+                   opsize:=S_L;
+                 end
+               else
+                opsize:=S_B;
+             end;
+
+            { Get a label to jump to the end }
+            p^.location.loc:=LOC_FLAGS;
+
+            { It's better to use the zero flag when there are
+              no ranges }
+            if ranges then
+              p^.location.resflags:=F_C
+            else
+              p^.location.resflags:=F_E;
+
+            reset_reference(href);
+            getlabel(l);
+            href.symbol:=stringdup(lab2str(l));
+
+            for i:=1 to numparts do
+             if setparts[i].range then
+              begin
+                { Check if left is in a range }
+                { Get a label to jump over the check }
+                reset_reference(href2);
+                getlabel(l2);
+                href.symbol:=stringdup(lab2str(l2));
+                if setparts[i].start=setparts[i].stop-1 then
+                 begin
+                   case p^.left^.location.loc of
+                  LOC_REGISTER,
+                 LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
+                                   setparts[i].start,pleftreg)));
+                   else
+                     exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
+                       setparts[i].start,newreference(p^.left^.location.reference))));
+                   end;
+                   { Result should be in carry flag when ranges are used }
+                   if ranges then
+                     exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
+                   { If found, jump to end }
+                   emitl(A_JE,l);
+                   case p^.left^.location.loc of
+                  LOC_REGISTER,
+                 LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
+                                   setparts[i].stop,pleftreg)));
+                   else
+                     exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
+                       setparts[i].stop,newreference(p^.left^.location.reference))));
+                   end;
+                   { Result should be in carry flag when ranges are used }
+                   if ranges then
+                     exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
+                   { If found, jump to end }
+                   emitl(A_JE,l);
+                 end
+                else
+                 begin
+                   if setparts[i].start<>0 then
                     begin
-                       { calculate both operators }
-                       { the complex one first }
-                       firstcomplex(p);
-                       secondpass(p^.left);
-                       { are too few registers free? }
-                       pushed:=maybe_push(p^.right^.registers32,p^.left);
-                       secondpass(p^.right);
-                       if pushed then
-                          restore(p^.left);
-                       { of course not commutative }
-                       if p^.swaped then
-                              swaptree(p);
-                       case p^.left^.location.loc of
-                         LOC_REGISTER,
-                         LOC_CREGISTER:
-                           begin
-                              hr:=p^.left^.location.register;
-                              case p^.left^.location.register of
-                                 R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
-                                    begin
-                                        hr:=reg16toreg32(p^.left^.location.register);
-                                        ungetregister32(hr);
-                                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,
-                                          p^.left^.location.register,hr)));
-                                    end;
-                                 R_AL,R_BL,R_CL,R_DL :
-                                    begin
-                                        hr:=reg8toreg32(p^.left^.location.register);
-                                        ungetregister32(hr);
-                                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,
-                                          p^.left^.location.register,hr)));
-                                    end;
-                              end;
-                           end;
-                         else
-                             begin
-                                 { the set element isn't never samller than a byte  }
-                                 { and because it's a small set we need only 5 bits }
-                                 { but 8 bits are eaiser to load                    }
-                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,
-                                   newreference(p^.left^.location.reference),R_EDI)));
-                                 hr:=R_EDI;
-                                 del_reference(p^.left^.location.reference);
-                             end;
-                       end;
-                       case p^.right^.location.loc of
-                         LOC_REGISTER,
-                         LOC_CREGISTER:
-                           exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,
-                             p^.right^.location.register)));
-                         else
-                            begin
-                               exprasmlist^.concat(new(pai386,op_reg_ref(A_BT,S_L,hr,
-                                 newreference(p^.right^.location.reference))));
-                                        del_reference(p^.right^.location.reference);
-                            end;
-                       end;
-                       p^.location.loc:=LOC_FLAGS;
-                       p^.location.resflags:=F_C;
+                      { We only check for the lower bound if it is > 0, because
+                        set elements lower than 0 dont exist }
+                      case p^.left^.location.loc of
+                     LOC_REGISTER,
+                    LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
+                                      setparts[i].start,pleftreg)));
+                      else
+                        exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
+                          setparts[i].start,newreference(p^.left^.location.reference))));
+                      end;
+                      { If lower, jump to next check }
+                      emitl(A_JB,l2);
                     end;
-             end
-           else
-             begin
-                 if p^.left^.treetype=ordconstn then
+                   { We only check for the high bound if it is < 255, because
+                     set elements higher than 255 do nt exist, the its always true,
+                     so only a JMP is generated }
+                   if setparts[i].stop<>255 then
                     begin
-                       { only compulsory }
-                       secondpass(p^.left);
-                       secondpass(p^.right);
-                       if codegenerror then
-                          exit;
-                       p^.location.resflags:=F_NE;
-                       inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
-                       exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_B,1 shl (p^.left^.value and 7),
-                          newreference(p^.right^.location.reference))));
-                       del_reference(p^.right^.location.reference);
+                      case p^.left^.location.loc of
+                     LOC_REGISTER,
+                    LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
+                                      setparts[i].stop+1,pleftreg)));
+                      else
+                        exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
+                          setparts[i].stop+1,newreference(p^.left^.location.reference))));
+                      end;
+                      { If higher, element is in set }
+                      emitl(A_JB,l);
                     end
-                 else
+                   else
                     begin
-                       if (p^.right^.treetype=setconstrn) and
-                         analizeset(p^.right^.constset) then
-                         begin
-                            {It gives us advantage to check for the set elements
-                             separately instead of using the SET_IN_BYTE procedure.
-                             To do: Build in support for LOC_JUMP.}
-                            secondpass(p^.left);
-                            {We won't do a second pass on p^.right, because
-                             this will emit the constant set.}
-                            {If register is used, use only lower 8 bits}
-                            if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                             begin
-                               pleftreg:=p^.left^.location.register;
-                               if pleftreg in [R_AL..R_DH] then
-                                 begin
-                                    exprasmlist^.concat(new(pai386,op_const_reg(
-                                      A_AND,S_B,255,pleftreg)));
-                                    opsize:=S_B;
-                                 end
-                               else
-                                 begin
-                                    exprasmlist^.concat(new(pai386,op_const_reg(
-                                      A_AND,S_L,255,pleftreg)));
-                                    if pleftreg in [R_EAX..R_EDI] then
-                                      opsize:=S_L
-                                    else
-                                      opsize:=S_W;
-                                 end;
-                             end;
-                            {Get a label to jump to the end.}
-                            p^.location.loc:=LOC_FLAGS;
-                            {It's better to use the zero flag when there are
-                             no ranges.}
-                            if ranges then
-                              p^.location.resflags:=F_C
-                            else
-                              p^.location.resflags:=F_E;
-                            href.symbol := nil;
-                            clear_reference(href);
-                            getlabel(l);
-                            href.symbol:=stringdup(lab2str(l));
-                            for i:=1 to numparts do
-                              if setparts[i].range then
-                                begin
-                                   {Check if left is in a range.}
-                                   {Get a label to jump over the check.}
-                                   href2.symbol := nil;
-                                   clear_reference(href2);
-                                   getlabel(l2);
-                                   href.symbol:=stringdup(lab2str(l2));
-                                   if setparts[i].start=setparts[i].stop-1 then
-                                     begin
-                                        case p^.left^.location.loc of
-                                           LOC_REGISTER,
-                                           LOC_CREGISTER :
-                                             exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
-                                               setparts[i].start,pleftreg)));
-                                           else
-                                             exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
-                                               setparts[i].start,newreference(p^.left^.location.reference))));
-                                        end;
-                                        {Result should be in carry flag when ranges are used.}
-                                        if ranges then
-                                          exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
-                                        {If found, jump to end.}
-                                        emitl(A_JE,l);
-                                        case p^.left^.location.loc of
-                                           LOC_REGISTER,
-                                           LOC_CREGISTER:
-                                             exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
-                                               setparts[i].stop,pleftreg)));
-                                           else
-                                             exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
-                                               setparts[i].stop,newreference(p^.left^.location.reference))));
-                                        end;
-                                        {Result should be in carry flag when ranges are used.}
-                                        if ranges then
-                                          exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
-                                        {If found, jump to end.}
-                                        emitl(A_JE,l);
-                                     end
-                                   else
-                                     begin
-                                        if setparts[i].start<>0 then
-                                          begin
-                                             { We only check for the lower bound if it is > 0, because
-                                             set elements lower than 0 do nt exist.}
-                                             case p^.left^.location.loc of
-                                               LOC_REGISTER,
-                                               LOC_CREGISTER :
-                                                 exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
-                                                 setparts[i].start,pleftreg)));
-                                               else
-                                                 exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
-                                               setparts[i].start,newreference(p^.left^.location.reference))));
-                                             end;
-                                             {If lower, jump to next check.}
-                                             emitl(A_JB,l2);
-                                          end;
-                                      { We only check for the high bound if it is < 255, because
-                                        set elements higher than 255 do nt exist, the its always true,
-                                        so only a JMP is generated }
-                                        if setparts[i].stop<>255 then
-                                          begin
-                                             case p^.left^.location.loc of
-                                               LOC_REGISTER,
-                                               LOC_CREGISTER :
-                                                 exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
-                                                   setparts[i].stop+1,pleftreg)));
-                                               else
-                                                 exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
-                                                   setparts[i].stop+1,newreference(p^.left^.location.reference))));
-                                             end;
-                                             {If higher, element is in set.}
-                                             emitl(A_JB,l);
-                                          end
-                                         else
-                                          begin
-                                            exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
-                                            emitl(A_JMP,l);
-                                          end;
-                                      end;
-                                   {Emit the jump over label.}
-                                   exprasmlist^.concat(new(pai_label,init(l2)));
+                      exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
+                      emitl(A_JMP,l);
+                    end;
+                 end;
+                { Emit the jump over label }
+                exprasmlist^.concat(new(pai_label,init(l2)));
+              end
+             else
+              begin
+                { Emit code to check if left is an element }
+                case p^.left^.location.loc of
+               LOC_REGISTER,
+              LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
+                                setparts[i].stop,pleftreg)));
+                else
+                  exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
+                    setparts[i].stop,newreference(p^.left^.location.reference))));
+                end;
+                { Result should be in carry flag when ranges are used }
+                if ranges then
+                 exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
+                { If found, jump to end }
+                emitl(A_JE,l);
+              end;
+             if ranges then
+              exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
+             { To compensate for not doing a second pass }
+             stringdispose(p^.right^.location.reference.symbol);
+             { Now place the end label }
+             exprasmlist^.concat(new(pai_label,init(l)));
+             case p^.left^.location.loc of
+            LOC_REGISTER,
+           LOC_CREGISTER : ungetregister32(pleftreg);
+             else
+               del_reference(p^.left^.location.reference);
+             end;
+          end
+         else
+          begin
+          { We will now generated code to check the set itself, no jmps,
+            handle smallsets separate, because it allows faster checks }
+            if use_small then
+             begin
+               if p^.left^.treetype=ordconstn then
+                begin
+                  p^.location.resflags:=F_NE;
+                  case p^.right^.location.loc of
+                 LOC_REGISTER,
+                LOC_CREGISTER : begin
+                                  exprasmlist^.concat(new(pai386,op_const_reg(A_TEST,S_L,
+                                    1 shl (p^.left^.value and 31),p^.right^.location.register)));
+                                  ungetregister32(p^.right^.location.register);
                                 end
-                              else
-                                begin
-                                   {Emit code to check if left is an element.}
-                                   case p^.left^.location.loc of
-                                      LOC_REGISTER,
-                                      LOC_CREGISTER:
-                                        exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,
-                                          setparts[i].stop,pleftreg)));
-                                      else
-                                        exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
-                                          setparts[i].stop,newreference(p^.left^.location.reference))));
-                                   end;
-                                   {Result should be in carry flag when ranges are used.}
-                                   if ranges then
-                                     exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
-                                   {If found, jump to end.}
-                                   emitl(A_JE,l);
+                  else
+                   begin
+                     exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_L,1 shl (p^.left^.value and 31),
+                       newreference(p^.right^.location.reference))));
+                     del_reference(p^.right^.location.reference);
+                   end;
+                  end;
+                end
+               else
+                begin
+                  case p^.left^.location.loc of
+                 LOC_REGISTER,
+                LOC_CREGISTER : begin
+                                  hr:=p^.left^.location.register;
+                                  emit_to_reg32(hr);
                                 end;
-                            if ranges then
-                              exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
-                            {To compensate for not doing a second pass.}
-                            stringdispose(p^.right^.location.reference.symbol);
-                            {Now place the end label.}
-                            exprasmlist^.concat(new(pai_label,init(l)));
-                            case p^.left^.location.loc of
-                               LOC_REGISTER,
-                               LOC_CREGISTER:
-                                 ungetregister32(pleftreg);
-                               else
-                                 del_reference(p^.left^.location.reference);
-                            end;
-                         end
-                       else
-                         begin
-                            { calculate both operators }
-                            { the complex one first }
-                            firstcomplex(p);
-                            secondpass(p^.left);
-                            { are too few registers free? }
-                            pushed:=maybe_push(p^.right^.registers32,p);
-                            secondpass(p^.right);
-                            if pushed then restore(p);
-                            { of course not commutative }
-                            if p^.swaped then
-                              swaptree(p);
-                            pushsetelement(p^.left);
-                            emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
-                            del_reference(p^.right^.location.reference);
-                            { registers need not be save. that happens in SET_IN_BYTE }
-                            { (EDI is changed) }
-                            emitcall('SET_IN_BYTE',true);
-                            { ungetiftemp(p^.right^.location.reference); }
-                            p^.location.loc:=LOC_FLAGS;
-                            p^.location.resflags:=F_C;
-                         end;
+                  else
+                    begin
+                      { the set element isn't never samller than a byte  }
+                      { and because it's a small set we need only 5 bits }
+                      { but 8 bits are easier to load                    }
+                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,
+                        newreference(p^.left^.location.reference),R_EDI)));
+                      hr:=R_EDI;
+                      del_reference(p^.left^.location.reference);
+                    end;
+                  end;
+
+                  case p^.right^.location.loc of
+                 LOC_REGISTER,
+                LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,
+                                  p^.right^.location.register)));
+                  else
+                    begin
+                      if p^.right^.location.reference.isintvalue then
+                       begin
+                       { We have to load the value into a register because
+                         btl does not accept values only refs or regs (PFV) }
+                         hr2:=getregister32;
+                         exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,
+                           p^.right^.location.reference.offset,hr2)));
+                         exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,hr2)));
+                         ungetregister32(hr2);
+                       end
+                      else
+                        exprasmlist^.concat(new(pai386,op_reg_ref(A_BT,S_L,hr,
+                          newreference(p^.right^.location.reference))));
+
+                      del_reference(p^.right^.location.reference);
                     end;
+                  end;
+                  ungetregister32(hr);
+                  p^.location.loc:=LOC_FLAGS;
+                  p^.location.resflags:=F_C;
                 end;
+             end
+            else
+             begin
+               { do search in a normal set which could have >32 elementsm
+                 but also used if the left side contains higher values > 32 }
+               if p^.left^.treetype=ordconstn then
+                begin
+                  p^.location.resflags:=F_NE;
+                  inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
+                  exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_B,1 shl (p^.left^.value and 7),
+                    newreference(p^.right^.location.reference))));
+                  del_reference(p^.right^.location.reference);
+                end
+               else
+                begin
+                  pushsetelement(p^.left);
+                  emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                  del_reference(p^.right^.location.reference);
+                  { registers need not be save. that happens in SET_IN_BYTE }
+                  { (EDI is changed) }
+                  emitcall('SET_IN_BYTE',true);
+                  { ungetiftemp(p^.right^.location.reference); }
+                  p^.location.loc:=LOC_FLAGS;
+                  p^.location.resflags:=F_C;
+                end;
+             end;
+          end;
        end;
 
 
@@ -763,7 +782,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1998-08-10 14:49:51  peter
+  Revision 1.5  1998-08-14 18:18:40  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.4  1998/08/10 14:49:51  peter
     + localswitches, moduleswitches, globalswitches splitting
 
   Revision 1.3  1998/06/25 08:48:10  florian

compiler/cgi386.pas

@@ -207,7 +207,7 @@ implementation
        const
          procedures : array[ttreetyp] of secondpassproc =
             (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
-             secondmoddiv,secondassignment,secondload,secondnothing,
+             secondmoddiv,secondassignment,secondload,secondrange,
              secondadd,secondadd,secondadd,secondadd,
              secondadd,secondadd,secondin,secondadd,
              secondadd,secondshlshr,secondshlshr,secondadd,
@@ -219,7 +219,7 @@ implementation
              secondstringconst,secondfuncret,secondselfn,
              secondnot,secondinline,secondniln,seconderror,
              secondnothing,secondhnewn,secondhdisposen,secondnewn,
-             secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
+             secondsimplenewdispose,secondsetele,secondsetcons,secondblockn,
              secondstatement,secondnothing,secondifn,secondbreakn,
              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
              secondexitn,secondwith,secondcase,secondlabel,
@@ -506,7 +506,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  1998-08-10 14:49:53  peter
+  Revision 1.48  1998-08-14 18:18:43  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.47  1998/08/10 14:49:53  peter
     + localswitches, moduleswitches, globalswitches splitting
 
   Revision 1.46  1998/08/10 10:18:23  peter
@@ -571,8 +575,6 @@ end.
   Revision 1.32  1998/06/04 09:55:35  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
 
-  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
-
   Revision 1.31  1998/06/03 22:48:52  peter
     + wordbool,longbool
     * rename bis,von -> high,low

compiler/pass_1.pas

@@ -130,11 +130,25 @@ unit pass_1;
 
     procedure left_right_max(p : ptree);
       begin
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-         p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
+        if assigned(p^.left) then
+         begin
+           if assigned(p^.right) then
+            begin
+              p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
+              p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
 {$ifdef SUPPORT_MMX}
-         p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
+              p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
 {$endif SUPPORT_MMX}
+            end
+           else
+            begin
+              p^.registers32:=p^.left^.registers32;
+              p^.registersfpu:=p^.left^.registersfpu;
+{$ifdef SUPPORT_MMX}
+              p^.registersmmx:=p^.left^.registersmmx;
+{$endif SUPPORT_MMX}
+            end;
+         end;
       end;
 
     { calculates the needed registers for a binary operator }
@@ -142,20 +156,35 @@ unit pass_1;
 
       begin
          left_right_max(p);
-         { Nur wenn links und rechts ein Unterschied < ben”tige Anzahl ist, }
-         { wird ein zus„tzliches Register ben”tigt, da es dann keinen       }
-         { schwierigeren Ast gibt, welcher erst ausgewertet werden kann     }
-
-         if (abs(p^.left^.registers32-p^.right^.registers32)<r32) then
-           inc(p^.registers32,r32);
-
-         if (abs(p^.left^.registersfpu-p^.right^.registersfpu)<fpu) then
-           inc(p^.registersfpu,fpu);
 
+      { Only when the difference between the left and right registers < the
+        wanted registers allocate the amount of registers }
+        
+        if assigned(p^.left) then
+         begin
+           if assigned(p^.right) then
+            begin
+              if (abs(p^.left^.registers32-p^.right^.registers32)<r32) then
+               inc(p^.registers32,r32);
+              if (abs(p^.left^.registersfpu-p^.right^.registersfpu)<fpu) then
+               inc(p^.registersfpu,fpu);
+{$ifdef SUPPORT_MMX}
+              if (abs(p^.left^.registersmmx-p^.right^.registersmmx)<mmx) then
+               inc(p^.registersmmx,mmx);
+{$endif SUPPORT_MMX}
+            end
+           else
+            begin
+              if (p^.left^.registers32<r32) then
+               inc(p^.registers32,r32);
+              if (p^.left^.registersfpu<fpu) then
+               inc(p^.registersfpu,fpu);
 {$ifdef SUPPORT_MMX}
-         if (abs(p^.left^.registersmmx-p^.right^.registersmmx)<mmx) then
-           inc(p^.registersmmx,mmx);
+              if (p^.left^.registersmmx<mmx) then
+               inc(p^.registersmmx,mmx);
 {$endif SUPPORT_MMX}
+            end;
+         end;
 
          { error message, if more than 8 floating point }
          { registers are needed                         }
@@ -163,25 +192,25 @@ unit pass_1;
           Message(cg_e_too_complex_expr);
       end;
 
-    function both_rm(p : ptree) : boolean;
 
+    function both_rm(p : ptree) : boolean;
         begin
            both_rm:=(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
-             (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]);
+                    (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]);
         end;
 
+
     function is_assignment_overloaded(from_def,to_def : pdef) : boolean;forward;
 
+
     function isconvertable(def_from,def_to : pdef;
              var doconv : tconverttype;fromtreetype : ttreetyp;
              explicit : boolean) : boolean;
-
+      const
       { Tbasetype:  uauto,uvoid,uchar,
                     u8bit,u16bit,u32bit,
                     s8bit,s16bit,s32,
                     bool8bit,bool16bit,boot32bit }
-
-      const
          basedefconverts : array[tbasetype,tbasetype] of tconverttype =
            {uauto}
            ((tc_not_possible,tc_not_possible,tc_not_possible,
@@ -624,6 +653,7 @@ unit pass_1;
          end;
       end;
 
+
     procedure firstadd(var p : ptree);
 
       procedure make_bool_equal_size(var p:ptree);
@@ -646,11 +676,11 @@ unit pass_1;
       end;
 
       var
-         lt,rt : ttreetyp;
-         t : ptree;
-         rv,lv : longint;
-         rvd,lvd : {double}bestreal;
-         rd,ld : pdef;
+         t       : ptree;
+         lt,rt   : ttreetyp;
+         rv,lv   : longint;
+         rvd,lvd : bestreal;
+         rd,ld   : pdef;
          concatstrings : boolean;
 
          { to evalute const sets }
@@ -1019,24 +1049,29 @@ unit pass_1;
               p^.location.loc:=LOC_MEM;
            end
          else
-           if ((rd^.deftype=setdef) and (ld^.deftype=setdef)) then
+           if (ld^.deftype=setdef) then
              begin
-                case p^.treetype of
-                   subn,symdifn,addn,muln,equaln,unequaln : ;
-                   else Message(sym_e_type_mismatch);
-                end;
-                if not(is_equal(rd,ld)) then
-                 Message(sym_e_set_element_are_not_comp);
-                { why here its is alredy in entry of firstadd
-                firstpass(p^.left);
-                firstpass(p^.right); }
+                if not(p^.treetype in [subn,symdifn,addn,muln,equaln,unequaln]) or
+                   ((rd^.deftype<>setdef) and (p^.treetype<>addn)) then
+                  Message(sym_e_type_mismatch);
+
+                if ((rd^.deftype=setdef) and not(is_equal(rd,ld))) and
+                   not((rt in [rangen,setelen]) and is_equal(psetdef(ld)^.setof,rd)) then
+                  Message(sym_e_set_element_are_not_comp);
+
+                { if the destination is not a smallset then insert a typeconv
+                  which loads a smallset into a normal set }
+                if (psetdef(ld)^.settype<>smallset) and
+                   (psetdef(rd)^.settype=smallset) then
+                 begin
+{                   Internalerror(34243);}
+                   p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
+                   firstpass(p^.right);
+                 end;
+
                 { do constant evalution }
-                { set constructor ? }
                 if (p^.right^.treetype=setconstrn) and
-                  (p^.left^.treetype=setconstrn) and
-                  { and no variables ? }
-                  (p^.right^.left=nil) and
-                  (p^.left^.left=nil) then
+                   (p^.left^.treetype=setconstrn) then
                   begin
                      new(resultset);
                      case p^.treetype of
@@ -1058,32 +1093,32 @@ unit pass_1;
                                       p^.left^.constset^[i] and not(p^.right^.constset^[i]);
                                   t:=gensetconstruktnode(resultset,psetdef(ld));
                                end;
-                        symdifn : begin
+                     symdifn : begin
                                   for i:=0 to 31 do
                                     resultset^[i]:=
                                       p^.left^.constset^[i] xor p^.right^.constset^[i];
                                   t:=gensetconstruktnode(resultset,psetdef(ld));
                                end;
-                        unequaln : begin
-                                      b:=true;
-                                      for i:=0 to 31 do
-                                        if p^.right^.constset^[i]=p^.left^.constset^[i] then
-                                          begin
-                                             b:=false;
-                                             break;
-                                          end;
-                                      t:=genordinalconstnode(ord(b),booldef);
+                    unequaln : begin
+                                 b:=true;
+                                 for i:=0 to 31 do
+                                  if p^.right^.constset^[i]=p^.left^.constset^[i] then
+                                   begin
+                                     b:=false;
+                                     break;
                                    end;
-                        equaln : begin
-                                    b:=true;
-                                    for i:=0 to 31 do
-                                      if p^.right^.constset^[i]<>p^.left^.constset^[i] then
-                                        begin
-                                           b:=false;
-                                           break;
-                                        end;
-                                     t:=genordinalconstnode(ord(b),booldef);
-                                  end;
+                                 t:=genordinalconstnode(ord(b),booldef);
+                               end;
+                      equaln : begin
+                                 b:=true;
+                                 for i:=0 to 31 do
+                                  if p^.right^.constset^[i]<>p^.left^.constset^[i] then
+                                   begin
+                                     b:=false;
+                                     break;
+                                   end;
+                                 t:=genordinalconstnode(ord(b),booldef);
+                               end;
                      end;
                      dispose(resultset);
                      disposetree(p);
@@ -1091,12 +1126,13 @@ unit pass_1;
                      firstpass(p);
                      exit;
                   end
-                else if psetdef(rd)^.settype=smallset then
+                else
+                 if psetdef(rd)^.settype=smallset then
                   begin
                      calcregisters(p,1,0,0);
                      p^.location.loc:=LOC_REGISTER;
                   end
-                else
+                 else
                   begin
                      calcregisters(p,0,0,0);
                      { here we call SET... }
@@ -1948,35 +1984,25 @@ unit pass_1;
          firstpass(p^.right);
          if codegenerror then
            exit;
-         { allow only ordinal constants }
-         if not((p^.left^.treetype=ordconstn) and
-            (p^.right^.treetype=ordconstn)) then
-           Message(cg_e_illegal_expression);
-         { upper limit must be greater or equal than lower limit }
-         { not if u32bit }
-         if (p^.left^.value>p^.right^.value) and
-            (( p^.left^.value<0) or (p^.right^.value>=0)) then
-           Message(cg_e_upper_lower_than_lower);
          { both types must be compatible }
-         if not(isconvertable(p^.left^.resulttype,p^.right^.resulttype,
-           ct,ordconstn,false)) and
-           not(is_equal(p^.left^.resulttype,p^.right^.resulttype)) then
+         if not(is_equal(p^.left^.resulttype,p^.right^.resulttype)) and
+            not(isconvertable(p^.left^.resulttype,p^.right^.resulttype,ct,ordconstn,false)) then
            Message(sym_e_type_mismatch);
+         { Check if only when its a constant set }
+         if (p^.left^.treetype=ordconstn) and (p^.right^.treetype=ordconstn) then
+          begin
+          { upper limit must be greater or equal than lower limit }
+          { not if u32bit }
+            if (p^.left^.value>p^.right^.value) and
+               (( p^.left^.value<0) or (p^.right^.value>=0)) then
+              Message(cg_e_upper_lower_than_lower);
+          end;
+        left_right_max(p);
+        p^.resulttype:=p^.left^.resulttype;
+        set_location(p^.location,p^.left^.location);
       end;
 
-      {
-      begin
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-         if p^.right^.treetype<>ordconstn then
-           begin
-              case p^.right^.location.loc of
-                 LOC_MEM,LOC_REFERENCE,
-                 LOC_CREGISTER,LOC_FLAGS:
-                   inc(p^.registers32);
-              end;
-           end;
-      end;
-      }
+
     procedure firstvecn(var p : ptree);
 
       var
@@ -2440,21 +2466,41 @@ unit pass_1;
           exit;
         end;
 
-       { remove obsolete type conversions }
-       if is_equal(p^.left^.resulttype,p^.resulttype) then
-         begin
-            hp:=p;
-            p:=p^.left;
-            p^.resulttype:=hp^.resulttype;
-            putnode(hp);
-            exit;
-         end;
+       { load the values from the left part }
        p^.registers32:=p^.left^.registers32;
        p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
        p^.registersmmx:=p^.left^.registersmmx;
 {$endif}
        set_location(p^.location,p^.left^.location);
+
+       { remove obsolete type conversions }
+       if is_equal(p^.left^.resulttype,p^.resulttype) then
+         begin
+         { becuase is_equal only checks the basetype for sets we need to
+           check here if we are loading a smallset into a normalset }
+           if (p^.resulttype^.deftype=setdef) and
+              (p^.left^.resulttype^.deftype=setdef) and
+              (psetdef(p^.resulttype)^.settype<>smallset) and
+              (psetdef(p^.left^.resulttype)^.settype=smallset) then
+            begin
+            { try to define the set as a normalset if it's a constant set }
+              if p^.left^.treetype=setconstrn then
+               psetdef(p^.left^.resulttype)^.settype:=normset
+              else
+               p^.convtyp:=tc_load_smallset;
+              exit;
+            end
+           else
+            begin
+              hp:=p;
+              p:=p^.left;
+              p^.resulttype:=hp^.resulttype;
+              putnode(hp);
+              exit;
+            end;
+         end;
+
        if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
          begin
             procinfo.flags:=procinfo.flags or pi_do_call;
@@ -4231,35 +4277,22 @@ unit pass_1;
          procinfo.flags:=procinfo.flags or pi_do_call;
       end;
 
-    procedure firstsetcons(var p : ptree);
-
-      var
-         hp : ptree;
 
+    procedure firstsetele(var p : ptree);
       begin
-         p^.location.loc:=LOC_MEM;
-         hp:=p^.left;
-         { is done by getnode*
-         p^.registers32:=0;
-         p^.registersfpu:=0;
-         }
-         while assigned(hp) do
-           begin
-              firstpass(hp^.left);
+         firstpass(p^.left);
+         calcregisters(p,0,0,0);
+         p^.resulttype:=p^.left^.resulttype;
+         set_location(p^.location,p^.left^.location);
+      end;
 
-              if codegenerror then
-                exit;
 
-              p^.registers32:=max(p^.registers32,hp^.left^.registers32);
-              p^.registersfpu:=max(p^.registersfpu,hp^.left^.registersfpu);;
-{$ifdef SUPPORT_MMX}
-              p^.registersmmx:=max(p^.registersmmx,hp^.left^.registersmmx);
-{$endif SUPPORT_MMX}
-              hp:=hp^.right;
-           end;
-         { result type is already set }
+    procedure firstsetcons(var p : ptree);
+      begin
+         p^.location.loc:=LOC_MEM;
       end;
 
+
     procedure firstin(var p : ptree);
 
       begin
@@ -4813,11 +4846,7 @@ unit pass_1;
          firstpass(p^.right);
          if codegenerror then
            exit;
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-         p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}
+         left_right_max(p);
       end;
 
     procedure firstis(var p : ptree);
@@ -4861,12 +4890,6 @@ unit pass_1;
            exit;
 
          left_right_max(p);
-(*       this was wrong,no ??
-         p^.registersfpu:=max(p^.left^.registersfpu,p^.left^.registersfpu);
-         p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
-{$ifdef SUPPORT_MMX}
-         p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
-{$endif SUPPORT_MMX}             *)
 
          { left must be a class }
          if (p^.left^.resulttype^.deftype<>objectdef) or
@@ -5089,7 +5112,7 @@ unit pass_1;
              firststringconst,firstfuncret,firstselfn,
              firstnot,firstinline,firstniln,firsterror,
              firsttypen,firsthnewn,firsthdisposen,firstnewn,
-             firstsimplenewdispose,firstnothing,firstsetcons,firstblock,
+             firstsimplenewdispose,firstsetele,firstsetcons,firstblock,
              firststatement,firstnothing,firstif,firstnothing,
              firstnothing,first_while_repeat,first_while_repeat,firstfor,
              firstexitn,firstwith,firstcase,firstlabel,
@@ -5183,7 +5206,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.54  1998-08-13 11:00:10  peter
+  Revision 1.55  1998-08-14 18:18:44  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.54  1998/08/13 11:00:10  peter
     * fixed procedure<>procedure construct
 
   Revision 1.53  1998/08/12 19:39:28  peter

compiler/tree.pas

@@ -146,7 +146,7 @@ unit tree;
                       tc_int_2_real,tc_real_2_fix,
                       tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
                       tc_chararray_2_string,
-                      tc_proc2procvar,tc_cchar_charpointer);
+                      tc_proc2procvar,tc_cchar_charpointer,tc_load_smallset);
 
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,
@@ -1557,7 +1557,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.28  1998-08-13 11:00:13  peter
+  Revision 1.29  1998-08-14 18:18:48  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.28  1998/08/13 11:00:13  peter
     * fixed procedure<>procedure construct
 
   Revision 1.27  1998/08/10 14:50:35  peter

compiler/types.pas

@@ -497,8 +497,9 @@ unit types;
               begin
                  if assigned(psetdef(def1)^.setof) and
                     assigned(psetdef(def2)^.setof) then
-                   b:=is_equal(psetdef(def1)^.setof,psetdef(def2)^.setof)
-                 else b:=true;
+                   b:=(psetdef(def1)^.setof^.deftype=psetdef(def2)^.setof^.deftype)
+                 else
+                   b:=true;
               end
           else
             if (def1^.deftype=procvardef) and (def2^.deftype=procvardef) then
@@ -861,9 +862,17 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.17  1998-08-05 16:00:17  florian
+  Revision 1.18  1998-08-14 18:18:49  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.17  1998/08/05 16:00:17  florian
     * some fixes for ansi strings
-    * $log$ to $Log$ changed
+    * $log$ to $Log$
+    * $log$ to Revision 1.18  1998-08-14 18:18:49  peter
+    * $log$ to   + dynamic set contruction
+    * $log$ to   * smallsets are now working (always longint size)
+    * $log$ to changed
 
   Revision 1.16  1998/07/20 23:35:50  michael
   Const ansistrings are not copied.