+ support for sets with size 1 and 2

git-svn-id: trunk@6172 -

.gitattributes

@@ -6796,6 +6796,8 @@ tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
 tests/test/tset1.pp svneol=native#text/plain
 tests/test/tset2.pp svneol=native#text/plain
+tests/test/tset3.pp svneol=native#text/plain
+tests/test/tset4.pp svneol=native#text/plain
 tests/test/tstack.pp svneol=native#text/plain
 tests/test/tstprocv.pp svneol=native#text/plain
 tests/test/tstring1.pp svneol=native#text/plain
@@ -7996,6 +7998,7 @@ tests/webtbs/tw8153a.pp svneol=native#text/plain
 tests/webtbs/tw8155.pp svneol=native#text/plain
 tests/webtbs/tw8156.pp svneol=native#text/plain
 tests/webtbs/tw8171.pp svneol=native#text/plain
+tests/webtbs/tw8172.pp svneol=native#text/plain
 tests/webtbs/tw8183.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/defutil.pas

@@ -1017,7 +1017,7 @@ implementation
     function is_varset(p : tdef) : boolean;
       begin
         if (target_info.endian = endian_little) then
-          result:=(p.typ=setdef) and not(p.size=4)
+          result:=(p.typ=setdef) and not(p.size in [1,2,4])
         else
           result:=false;
       end;

compiler/fpcdefs.inc

@@ -23,10 +23,14 @@
 {$PACKENUM 1}
 {$ifdef FPC_HAS_VARSETS}
 {$ifndef FPC_BIG_ENDIAN}
-{ $PACKSET 1}
+{$define USE_PACKSET1}
 {$endif}
 {$endif FPC_HAS_VARSETS}
 
+{$ifdef USE_PACKSET1}
+{$PACKSET 1}
+{$endif USE_PACKSET1}
+
 { We don't use exceptions, so turn off the implicit
   exceptions in the constructors }
 {$IMPLICITEXCEPTIONS OFF}

compiler/ncginl.pas

@@ -510,7 +510,10 @@ implementation
           use_small : boolean;
           href : treference;
         begin
-          opsize:=OS_32;
+          if not(is_varset(tcallparanode(left).resultdef)) then
+            opsize:=int_cgsize(tcallparanode(left).resultdef.size)
+          else
+            opsize:=OS_32;
           bitsperop:=(8*tcgsize2size[opsize]);
           secondpass(tcallparanode(left).left);
           if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then

compiler/ncgrtti.pas

@@ -699,7 +699,11 @@ implementation
             { interface: write flags, iid and iidstr }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(
               { ugly, but working }
+{$ifdef USE_PACKSET1}
+              byte([
+{$else USE_PACKSET1}
               longint([
+{$endif USE_PACKSET1}
                 TCompilerIntfFlag(ord(ifHasGuid)*ord(assigned(def.iidguid))),
                 TCompilerIntfFlag(ord(ifHasStrGUID)*ord(assigned(def.iidstr)))
               ])

compiler/ncnv.pas

@@ -2246,22 +2246,38 @@ implementation
 
 
     function ttypeconvnode.first_load_smallset : tnode;
-
       var
         srsym: ttypesym;
-        p: tcallparanode;
-
+        newstatement : tstatementnode;
+        temp    : ttempcreatenode;
       begin
-        srsym:=search_system_type('FPC_SMALL_SET');
-        p := ccallparanode.create(left,nil);
+        { old small set code }
+        if left.resultdef.size=4 then
+          begin
+            srsym:=search_system_type('FPC_SMALL_SET');
+            result :=
+              ccallnode.createinternres('fpc_set_load_small',
+                ccallparanode.create(ctypeconvnode.create_internal(left,srsym.typedef),nil),resultdef);
+          end
+        else
+          begin
+            result:=internalstatements(newstatement);
+
+            { create temp for result }
+            temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
+                          addstatement(newstatement,temp);
+
+            addstatement(newstatement,ccallnode.createintern('fpc_varset_load',
+              ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+              ccallparanode.create(ctemprefnode.create(temp),
+              ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
+              ccallparanode.create(left,nil)))))
+            );
+            addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+            addstatement(newstatement,ctemprefnode.create(temp));
+          end;
         { reused }
         left := nil;
-        { convert parameter explicitely to fpc_small_set }
-        p.left := ctypeconvnode.create_internal(p.left,srsym.typedef);
-        { create call, adjust resultdef }
-        result :=
-          ccallnode.createinternres('fpc_set_load_small',p,resultdef);
-        firstpass(result);
       end;
 
 

compiler/pexpr.pas

@@ -141,7 +141,6 @@ implementation
        end;
 
 
-
     procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
       var
         plist : ppropaccesslistitem;

compiler/symdef.pas

@@ -2006,14 +2006,12 @@ implementation
          if high<32 then
            begin
              settype:=smallset;
-             (*
              if current_settings.setalloc=0 then      { $PACKSET Fixed?}
-             *)
                savesize:=Sizeof(longint)
-             (*
-             else                       {No, use $PACKSET VALUE for rounding}
+             else
                savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
-             *)
+             if savesize=3 then
+               savesize:=4;
            end
          else
           if high<256 then
@@ -2035,7 +2033,7 @@ implementation
          ppufile.getderef(elementdefderef);
          settype:=tsettype(ppufile.getbyte);
          case settype of
-           normset : savesize:=32;
+           normset : savesize:=ppufile.getaint;
            varset : savesize:=ppufile.getlongint;
            smallset : savesize:=Sizeof(longint);
          end;

compiler/x86/nx86add.pas

@@ -333,14 +333,10 @@ unit nx86add;
 
         noswap:=false;
         extra_not:=false;
-        opsize:=OS_32;
+        opsize:=int_cgsize(resultdef.size);
         case nodetype of
           addn :
             begin
-              { this is a really ugly hack!!!!!!!!!! }
-              { this could be done later using EDI   }
-              { as it is done for subn               }
-              { instead of two registers!!!!         }
               { adding elements is not commutative }
               if (nf_swapped in flags) and (left.nodetype=setelementn) then
                swapleftright;
@@ -349,7 +345,10 @@ unit nx86add;
                begin
                  { no range support for smallsets! }
                  if assigned(tsetelementnode(right).right) then
-                  internalerror(43244);
+                   internalerror(43244);
+                 { btsb isn't supported }
+                 if opsize=OS_8 then
+                   opsize:=OS_32;
                  { bts requires both elements to be registers }
                  location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false);
                  location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true);
@@ -389,7 +388,12 @@ unit nx86add;
         emit_generic_code(op,opsize,true,extra_not,false);
         location_freetemp(current_asmdata.CurrAsmList,right.location);
 
-        set_result_location_reg;
+        { left is always a register and contains the result }
+        location:=left.location;
+
+        { fix the changed opsize we did above because of the missing btsb }
+        if opsize<>int_cgsize(resultdef.size) then
+          location_force_reg(current_asmdata.CurrAsmList,location,int_cgsize(resultdef.size),false);
       end;
 
 
@@ -399,7 +403,7 @@ unit nx86add;
         op     : TAsmOp;
       begin
         pass_left_right;
-        opsize:=OS_32;
+        opsize:=int_cgsize(resultdef.size);
         case nodetype of
           equaln,
           unequaln :

compiler/x86/nx86inl.pas

@@ -343,7 +343,10 @@ implementation
          cgop : topcg;
          opsize : tcgsize;
         begin
-          opsize:=OS_32;
+          if not(is_varset(tcallparanode(left).resultdef)) then
+            opsize:=int_cgsize(tcallparanode(left).resultdef.size)
+          else
+            opsize:=OS_32;
           bitsperop:=(8*tcgsize2size[opsize]);
           secondpass(tcallparanode(left).left);
           if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
@@ -374,6 +377,8 @@ implementation
             end
           else
             begin
+              if opsize=OS_8 then
+                opsize:=OS_32;
               { generate code for the element to set }
               secondpass(tcallparanode(tcallparanode(left).right).left);
               { determine asm operator }

rtl/inc/compproc.inc

@@ -381,7 +381,7 @@ function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set; c
 function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
 function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
 
-procedure fpc_varset_load_small(l: fpc_small_set;var dest;size : ptrint); compilerproc;
+procedure fpc_varset_load(const l;sourcesize : longint;var dest;size : ptrint); compilerproc;
 procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
 procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
 procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc;

rtl/inc/genset.inc

@@ -213,10 +213,10 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
 {
   load a normal set p from a smallset l
 }
-procedure fpc_varset_load_small(l: fpc_small_set;var dest;size : ptrint); compilerproc;
+procedure fpc_varset_load(const l;sourcesize : longint;var dest;size : ptrint); compilerproc;
   begin
-    move(l,plongint(@dest)^,4);
-    FillChar((@dest+4)^,size-4,0);
+    move(l,plongint(@dest)^,sourcesize);
+    FillChar((@dest+sourcesize)^,size-sourcesize,0);
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 

tests/test/tset3.pp

@@ -0,0 +1,77 @@
+{$packset 1}
+type
+  tmini = 0..7;
+  tminiset = set of tmini;
+
+
+procedure do_error(w : word);
+  begin
+    writeln('Error: ',w);
+    halt(1);
+  end;
+
+var
+  s1,s2,s3 : tminiset;
+  b : byte;
+  m : tmini;
+begin
+  s1:=[];
+  if s1<>[] then
+    do_error(1);
+
+  s1:=[1];
+  if s1<>[1] then
+    do_error(2);
+
+  s2:=[2,3];
+  if s2<>[2,3] then
+    do_error(3);
+
+  b:=6;
+  s3:=[b,7];
+  if s3<>[6,7] then
+    do_error(4);
+
+  s1:=s1+s2;
+  if s1<>[1..3] then
+    do_error(5);
+
+  s2:=s1;
+
+  if not(s1=s2) then
+    do_error(6);
+
+  s3:=[4];
+
+  include(s1,4);
+  if s1<>[1..4] then
+    do_error(7);
+
+  s2:=s1;
+
+  exclude(s1,4);
+  if s1<>[1..3] then
+    do_error(8);
+
+  s2:=s2-s3;
+  if s1<>s2 then
+    do_error(9);
+
+  b:=4;
+  include(s1,b);
+  if s1<>[1..4] then
+    do_error(10);
+
+  s2:=s2+[b];
+  if s1<>s2 then
+    do_error(11);
+
+  s2:=s1;
+  m:=3;
+  s1:=s1-[m];
+  exclude(s2,m);
+  if s1<>s2 then
+    do_error(12);
+
+  writeln('ok');
+end.

tests/test/tset4.pp

@@ -0,0 +1,19 @@
+{$mode objpas}
+{$packset 1}
+uses
+  sysutils;
+
+function possetex (const c:string;const s : ansistring;count:Integer ):Integer;
+
+var cset : TSysCharSet;
+    i    : integer;
+begin
+  cset:=[];
+  if length(c)>0 then
+  for i:=1 to length(c) do
+    include(cset,c[i]);
+end;
+
+begin
+end.
+

tests/webtbs/tw8172.pp

@@ -0,0 +1,41 @@
+program SetSizeWrong;
+
+{$IFDEF FPC}
+  {$mode delphi}
+
+  {$packenum 1}
+  {$packset 1}
+{$ENDIF}
+
+type
+  { the flags that are sent with every message }
+  TnxMessageHeaderFlag = (
+    {the message header is followed by a string}
+    mhfErrorMessage,
+    { reserver for future use }
+    mhfReserved1,
+    { reserver for future use }
+    mhfReserved2,
+    { reserver for future use }
+    mhfReserved3,
+    { reserver for future use }
+    mhfReserved4,
+    { reserver for future use }
+    mhfReserved5,
+    { reserver for future use }
+    mhfReserved6,
+    { reserver for future use }
+    mhfReserved7
+  );
+
+  { set of Message flags }
+  TnxMessageHeaderFlags = set of TnxMessageHeaderFlag;
+
+begin
+  if SizeOf(TnxMessageHeaderFlag)<>1 then
+    halt(1);
+  WriteLn(SizeOf(TnxMessageHeaderFlag)); // should be 1, is 1
+  WriteLn(SizeOf(TnxMessageHeaderFlags)); // should be 1, is 4
+  if SizeOf(TnxMessageHeaderFlags)<>1 then
+    halt(1);
+end.