* varset support fixed

git-svn-id: trunk@5294 -

compiler/defutil.pas

@@ -1011,7 +1011,7 @@ implementation
     {# returns true, if the type passed is a varset }
     function is_varset(p : tdef) : boolean;
       begin
-        result:=(p.typ=setdef) and not(p.size=4) and not(p.size=32);
+        result:=(p.typ=setdef) and not(p.size=4);
       end;
 
 

compiler/htypechk.pas

@@ -895,6 +895,7 @@ implementation
 
     function  valid_for_assign(p:tnode;opts:TValidAssigns; report_errors: boolean):boolean;
       var
+        hp2,
         hp : tnode;
         gotstring,
         gotsubscript,
@@ -1084,6 +1085,24 @@ implementation
                    gotdynarray:=true;
                  hp:=tunarynode(hp).left;
                end;
+             blockn :
+               begin
+                 hp2:=tblocknode(hp).statements;
+                 if assigned(hp2) then
+                   begin
+                     if hp2.nodetype<>statementn then
+                       internalerror(2006110801);
+                     while assigned(tstatementnode(hp2).next) do
+                       hp2:=tstatementnode(hp2).next;
+                     hp:=tstatementnode(hp2).statement;
+                   end
+                 else
+                   begin
+                     if report_errors then
+                      CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
+                     exit;
+                   end;
+               end;
              asn :
                begin
                  { asn can't be assigned directly, it returns the value in a register instead

compiler/nadd.pas

@@ -1729,10 +1729,8 @@ implementation
         newstatement : tstatementnode;
         temp    : ttempcreatenode;
       begin
-        if is_varset(left.resultdef) then
+        if is_varset(left.resultdef) or is_varset(right.resultdef) then
           begin
-            if not(is_varset(right.resultdef)) then
-              internalerror(2006091901);
             case nodetype of
               equaln,unequaln,lten,gten:
                 begin
@@ -1778,7 +1776,7 @@ implementation
                       addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
                         ccallparanode.create(ctemprefnode.create(temp),
                         ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
-                        ccallparanode.create(tsetelementnode(right).left,nil))))
+                        ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),nil))))
                       );
 
                       { the last statement should return the value as
@@ -1804,15 +1802,15 @@ implementation
                           if assigned(tsetelementnode(right).right) then
                             addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
                               ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
-                              ccallparanode.create(tsetelementnode(right).right,
-                              ccallparanode.create(tsetelementnode(right).left,
+                              ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(tsetelementnode(right).right),sinttype),
+                              ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(tsetelementnode(right).left),sinttype),
                               ccallparanode.create(ctemprefnode.create(temp),
                               ccallparanode.create(left,nil))))))
                             )
                           else
                             addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
                               ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
-                              ccallparanode.create(tsetelementnode(right).left,
+                              ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
                               ccallparanode.create(ctemprefnode.create(temp),
                               ccallparanode.create(left,nil)))))
                             );

compiler/nbas.pas

@@ -73,6 +73,8 @@ interface
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure printnodetree(var t:text);override;
+          property statement : tnode read left write left;
+          property next : tnode read right write right;
        end;
        tstatementnodeclass = class of tstatementnode;
 
@@ -84,6 +86,7 @@ interface
 {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
 {$endif state_tracking}
+          property statements : tnode read left write left;
        end;
        tblocknodeclass = class of tblocknode;
 

compiler/ncgadd.pas

@@ -219,7 +219,7 @@ interface
             { when it is not allowed to swap we have a constant on
               left, that will give problems }
             if not allow_swap then
-              internalerror(200307041);
+              internalerror(200307043);
             swapleftright;
           end;
       end;

compiler/symdef.pas

@@ -2012,10 +2012,14 @@ 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}
-               savesize:=current_settings.setalloc*((high+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
+               savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
+             }
            end
          else
           if high<256 then
@@ -2024,10 +2028,10 @@ implementation
               if current_settings.setalloc=0 then      { $PACKSET Fixed?}
                 savesize:=32
               else                       {No, use $PACKSET VALUE for rounding}
-                savesize:=current_settings.setalloc*((high+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
+                savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
             end
           else
-            savesize:=current_settings.setalloc*((high+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
+            savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8));
       end;
 
 

rtl/inc/compproc.inc

@@ -313,8 +313,8 @@ function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean; compil
 
 procedure fpc_varset_load_small(l: fpc_small_set;var dest;size : ptrint); compilerproc;
 procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
-procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc;
-procedure fpc_varset_unset(var source,dest; b,size : ptrint); 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;
 procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc;
 function fpc_varset_in(const p; b : ptrint): boolean; compilerproc;
 procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc;

rtl/inc/genset.inc

@@ -239,11 +239,11 @@ procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
 {
   add the element b to the set "source"
 }
-procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc;
+procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
   type
     tbytearray = array[0..sizeof(sizeint)-1] of byte;
   begin
-    move(source,dest,sizeof(source));
+    move(source,dest,size);
     tbytearray(dest)[b div 8]:=tbytearray(dest)[b div 8] or (1 shl (b mod 8));
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_BYTE}
@@ -254,7 +254,7 @@ procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc;
    suppresses the element b to the set pointed by p
    used for exclude(set,element)
 }
-procedure fpc_varset_unset(var source,dest; b,size : ptrint); compilerproc;
+procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc;
   type
     tbytearray = array[0..sizeof(sizeint)-1] of byte;
   begin