2
0
Эх сурвалжийг харах

+ first batch of varset support, as long as packset isn't changed, it doesn't change anything

git-svn-id: trunk@4710 -
florian 19 жил өмнө
parent
commit
569c4871fc

+ 1 - 0
.gitattributes

@@ -6253,6 +6253,7 @@ tests/test/tunit3.pp svneol=native#text/plain
 tests/test/tunroll1.pp svneol=native#text/plain
 tests/test/tunroll1.pp svneol=native#text/plain
 tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
+tests/test/tvarset1.pp svneol=native#text/plain
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain

+ 10 - 0
compiler/defutil.pas

@@ -221,6 +221,9 @@ interface
     {# returns true, if the type passed is can be used with windows automation }
     {# returns true, if the type passed is can be used with windows automation }
     function is_automatable(p : tdef) : boolean;
     function is_automatable(p : tdef) : boolean;
 
 
+    {# returns true, if the type passed is a varset }
+    function is_varset(p : tdef) : boolean;
+
 implementation
 implementation
 
 
     uses
     uses
@@ -965,4 +968,11 @@ implementation
       end;
       end;
 
 
 
 
+    {# returns true, if the type passed is a varset }
+    function is_varset(p : tdef) : boolean;
+      begin
+        result:=(p.deftype=setdef) and not(p.size=4) and not(p.size=32);
+      end;
+
+
 end.
 end.

+ 4 - 8
compiler/globals.pas

@@ -224,9 +224,9 @@ interface
        initlocalswitches  : tlocalswitches;
        initlocalswitches  : tlocalswitches;
        initmodeswitches   : tmodeswitches;
        initmodeswitches   : tmodeswitches;
        initoptimizerswitches : toptimizerswitches;
        initoptimizerswitches : toptimizerswitches;
-       {$IFDEF testvarsets}
-        Initsetalloc,                            {0=fixed, 1 =var}
-       {$ENDIF}
+       { 0: old behaviour for sets <=256 elements
+         >0: round to this size }
+       initsetalloc,
        initpackenum       : shortint;
        initpackenum       : shortint;
        initalignment      : talignmentinfo;
        initalignment      : talignmentinfo;
        initcputype,
        initcputype,
@@ -245,9 +245,7 @@ interface
        nextaktlocalswitches : tlocalswitches;
        nextaktlocalswitches : tlocalswitches;
        localswitcheschanged : boolean;
        localswitcheschanged : boolean;
        aktmodeswitches    : tmodeswitches;
        aktmodeswitches    : tmodeswitches;
-       {$IFDEF testvarsets}
-        aktsetalloc,
-       {$ENDIF}
+       aktsetalloc,
        aktpackrecords,
        aktpackrecords,
        aktpackenum        : shortint;
        aktpackenum        : shortint;
        aktmaxfpuregisters : longint;
        aktmaxfpuregisters : longint;
@@ -2268,9 +2266,7 @@ end;
         initoptimizerswitches:=[];
         initoptimizerswitches:=[];
         initsourcecodepage:='8859-1';
         initsourcecodepage:='8859-1';
         initpackenum:=4;
         initpackenum:=4;
-        {$IFDEF testvarsets}
         initsetalloc:=0;
         initsetalloc:=0;
-        {$ENDIF}
         fillchar(initalignment,sizeof(talignmentinfo),0);
         fillchar(initalignment,sizeof(talignmentinfo),0);
         { might be overridden later }
         { might be overridden later }
         initasmmode:=asmmode_standard;
         initasmmode:=asmmode_standard;

+ 2 - 0
compiler/msg/errore.msg

@@ -343,6 +343,8 @@ scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE is not supported by the tar
 % The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS
 % The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS
 scanner_e_illegal_warn_state=02079_E_Illegal state for $WARN directive
 scanner_e_illegal_warn_state=02079_E_Illegal state for $WARN directive
 % Only ON and OFF can be used as state with a \$warn compiler directive
 % Only ON and OFF can be used as state with a \$warn compiler directive
+scan_e_only_packset=02080_E_Illegal set packing value
+% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameter
 % \end{description}
 % \end{description}
 #
 #
 # Parser
 # Parser

+ 3 - 2
compiler/msgidx.inc

@@ -100,6 +100,7 @@ const
   scan_w_minstacksize_not_support=02077;
   scan_w_minstacksize_not_support=02077;
   scan_w_maxstacksize_not_support=02078;
   scan_w_maxstacksize_not_support=02078;
   scanner_e_illegal_warn_state=02079;
   scanner_e_illegal_warn_state=02079;
+  scan_e_only_packset=02080;
   parser_e_syntax_error=03000;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
   parser_w_proc_directive_ignored=03005;
@@ -695,9 +696,9 @@ const
   option_info=11024;
   option_info=11024;
   option_help_pages=11025;
   option_help_pages=11025;
 
 
-  MsgTxtSize = 41028;
+  MsgTxtSize = 41062;
 
 
   MsgIdxMax : array[1..20] of longint=(
   MsgIdxMax : array[1..20] of longint=(
-    24,80,224,66,62,47,101,22,135,60,
+    24,81,224,66,62,47,101,22,135,60,
     41,1,1,1,1,1,1,1,1,1
     41,1,1,1,1,1,1,1,1,1
   );
   );

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 275 - 274
compiler/msgtxt.inc


+ 265 - 117
compiler/nadd.pas

@@ -1658,141 +1658,289 @@ implementation
       end;
       end;
 
 
 
 
-    function taddnode.first_addset: tnode;
+    function taddnode.first_addset : tnode;
+
+      procedure call_varset_helper(const n : string);
+        var
+          newstatement : tstatementnode;
+          temp    : ttempcreatenode;
+        begin
+          { add two var sets }
+          result:=internalstatements(newstatement);
+
+          { create temp for result }
+          temp:=ctempcreatenode.create(resulttype,resulttype.def.size,tt_persistent,true);
+          addstatement(newstatement,temp);
+
+          addstatement(newstatement,ccallnode.createintern(n,
+            ccallparanode.create(cordconstnode.create(resulttype.def.size,sinttype,false),
+            ccallparanode.create(ctemprefnode.create(temp),
+            ccallparanode.create(right,
+            ccallparanode.create(left,nil)))))
+          );
+
+          { remove reused parts from original node }
+          left:=nil;
+          right:=nil;
+          { the last statement should return the value as
+            location and type, this is done be referencing the
+            temp and converting it first from a persistent temp to
+            normal temp }
+          addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+          addstatement(newstatement,ctemprefnode.create(temp));
+        end;
+
       var
       var
         procname: string[31];
         procname: string[31];
         tempn: tnode;
         tempn: tnode;
         paras: tcallparanode;
         paras: tcallparanode;
         srsym: ttypesym;
         srsym: ttypesym;
+        newstatement : tstatementnode;
+        temp    : ttempcreatenode;
       begin
       begin
-        { get the sym that represents the fpc_normal_set type }
-        srsym:=search_system_type('FPC_NORMAL_SET');
-        case nodetype of
-          equaln,unequaln,lten,gten:
-            begin
-              case nodetype of
-                equaln,unequaln:
-                  procname := 'fpc_set_comp_sets';
-                lten,gten:
-                  begin
-                    procname := 'fpc_set_contains_sets';
-                    { (left >= right) = (right <= left) }
-                    if nodetype = gten then
+        if is_varset(left.resulttype.def) then
+          begin
+            if not(is_varset(right.resulttype.def)) then
+              internalerror(2006091901);
+            case nodetype of
+              equaln,unequaln,lten,gten:
+                begin
+                  case nodetype of
+                    equaln,unequaln:
+                      procname := 'fpc_varset_comp_sets';
+                    lten,gten:
                       begin
                       begin
-                        tempn := left;
-                        left := right;
-                        right := tempn;
-                      end;
+                        procname := 'fpc_varset_contains_sets';
+                        { (left >= right) = (right <= left) }
+                        if nodetype = gten then
+                          begin
+                            tempn := left;
+                            left := right;
+                            right := tempn;
+                          end;
+                       end;
                    end;
                    end;
-               end;
-               { convert the arguments (explicitely) to fpc_normal_set's }
-               left := ctypeconvnode.create_internal(left,srsym.restype);
-               right := ctypeconvnode.create_internal(right,srsym.restype);
-               result := ccallnode.createintern(procname,ccallparanode.create(right,
-                 ccallparanode.create(left,nil)));
-               { left and right are reused as parameters }
-               left := nil;
-               right := nil;
-               { for an unequaln, we have to negate the result of comp_sets }
-               if nodetype = unequaln then
-                 result := cnotnode.create(result);
-            end;
-          addn:
-            begin
-              { optimize first loading of a set }
-              if (right.nodetype=setelementn) and
-                 not(assigned(tsetelementnode(right).right)) and
-                 is_emptyset(left) then
+                   result := ccallnode.createinternres(procname,
+                     ccallparanode.create(cordconstnode.create(left.resulttype.def.size,sinttype,false),
+                     ccallparanode.create(right,
+                     ccallparanode.create(left,nil))),resulttype);
+                   { left and right are reused as parameters }
+                   left := nil;
+                   right := nil;
+                   { for an unequaln, we have to negate the result of comp_sets }
+                   if nodetype = unequaln then
+                     result := cnotnode.create(result);
+                end;
+              addn:
                 begin
                 begin
-                  { type cast the value to pass as argument to a byte, }
-                  { since that's what the helper expects               }
-                  tsetelementnode(right).left :=
-                    ctypeconvnode.create_internal(tsetelementnode(right).left,u8inttype);
-                  { set the resulttype to the actual one (otherwise it's }
-                  { "fpc_normal_set")                                    }
-                  result := ccallnode.createinternres('fpc_set_create_element',
-                    ccallparanode.create(tsetelementnode(right).left,nil),
-                    resulttype);
-                  { reused }
-                  tsetelementnode(right).left := nil;
-                end
+                  { optimize first loading of a set }
+                  if (right.nodetype=setelementn) and
+                     not(assigned(tsetelementnode(right).right)) and
+                     is_emptyset(left) then
+                    begin
+                      result:=internalstatements(newstatement);
+
+                      { create temp for result }
+                      temp:=ctempcreatenode.create(resulttype,resulttype.def.size,tt_persistent,true);
+                      addstatement(newstatement,temp);
+
+                      addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
+                        ccallparanode.create(ctemprefnode.create(temp),
+                        ccallparanode.create(cordconstnode.create(resulttype.def.size,sinttype,false),
+                        ccallparanode.create(tsetelementnode(right).left,nil))))
+                      );
+
+                      { the last statement should return the value as
+                        location and type, this is done be referencing the
+                        temp and converting it first from a persistent temp to
+                        normal temp }
+                      addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+                      addstatement(newstatement,ctemprefnode.create(temp));
+
+                      tsetelementnode(right).left := nil;
+                    end
+                  else
+                    begin
+                      if right.nodetype=setelementn then
+                        begin
+                          result:=internalstatements(newstatement);
+
+                          { create temp for result }
+                          temp:=ctempcreatenode.create(resulttype,resulttype.def.size,tt_persistent,true);
+                          addstatement(newstatement,temp);
+
+                          { add a range or a single element? }
+                          if assigned(tsetelementnode(right).right) then
+                            addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
+                              ccallparanode.create(cordconstnode.create(resulttype.def.size,sinttype,false),
+                              ccallparanode.create(tsetelementnode(right).right,
+                              ccallparanode.create(tsetelementnode(right).left,
+                              ccallparanode.create(ctemprefnode.create(temp),
+                              ccallparanode.create(left,nil))))))
+                            )
+                          else
+                            addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
+                              ccallparanode.create(cordconstnode.create(resulttype.def.size,sinttype,false),
+                              ccallparanode.create(tsetelementnode(right).left,
+                              ccallparanode.create(ctemprefnode.create(temp),
+                              ccallparanode.create(left,nil)))))
+                            );
+                          { remove reused parts from original node }
+                          tsetelementnode(right).right:=nil;
+                          tsetelementnode(right).left:=nil;
+                          left:=nil;
+                          { the last statement should return the value as
+                            location and type, this is done be referencing the
+                            temp and converting it first from a persistent temp to
+                            normal temp }
+                          addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+                          addstatement(newstatement,ctemprefnode.create(temp));
+                        end
+                      else
+                        call_varset_helper('fpc_varset_add_sets');
+                    end
+                end;
+              subn:
+                call_varset_helper('fpc_varset_sub_sets');
+              symdifn:
+                call_varset_helper('fpc_varset_symdif_sets');
+              muln:
+                call_varset_helper('fpc_varset_mul_sets');
               else
               else
+                internalerror(200609241);
+            end;
+          end
+        else
+          begin
+            { get the sym that represents the fpc_normal_set type }
+            srsym:=search_system_type('FPC_NORMAL_SET');
+            case nodetype of
+              equaln,unequaln,lten,gten:
                 begin
                 begin
-                  if right.nodetype=setelementn then
-                   begin
-                     { convert the arguments to bytes, since that's what }
-                     { the helper expects                               }
-                     tsetelementnode(right).left :=
-                       ctypeconvnode.create_internal(tsetelementnode(right).left,
-                       u8inttype);
-
-                     { convert the original set (explicitely) to an   }
-                     { fpc_normal_set so we can pass it to the helper }
-                     left := ctypeconvnode.create_internal(left,srsym.restype);
-
-                     { add a range or a single element? }
-                     if assigned(tsetelementnode(right).right) then
+                  case nodetype of
+                    equaln,unequaln:
+                      procname := 'fpc_set_comp_sets';
+                    lten,gten:
+                      begin
+                        procname := 'fpc_set_contains_sets';
+                        { (left >= right) = (right <= left) }
+                        if nodetype = gten then
+                          begin
+                            tempn := left;
+                            left := right;
+                            right := tempn;
+                          end;
+                       end;
+                   end;
+                   { convert the arguments (explicitely) to fpc_normal_set's }
+                   left := ctypeconvnode.create_internal(left,srsym.restype);
+                   right := ctypeconvnode.create_internal(right,srsym.restype);
+                   result := ccallnode.createintern(procname,ccallparanode.create(right,
+                     ccallparanode.create(left,nil)));
+                   { left and right are reused as parameters }
+                   left := nil;
+                   right := nil;
+                   { for an unequaln, we have to negate the result of comp_sets }
+                   if nodetype = unequaln then
+                     result := cnotnode.create(result);
+                end;
+              addn:
+                begin
+                  { optimize first loading of a set }
+                  if (right.nodetype=setelementn) and
+                     not(assigned(tsetelementnode(right).right)) and
+                     is_emptyset(left) then
+                    begin
+                      { type cast the value to pass as argument to a byte, }
+                      { since that's what the helper expects               }
+                      tsetelementnode(right).left :=
+                        ctypeconvnode.create_internal(tsetelementnode(right).left,u8inttype);
+                      { set the resulttype to the actual one (otherwise it's }
+                      { "fpc_normal_set")                                    }
+                      result := ccallnode.createinternres('fpc_set_create_element',
+                        ccallparanode.create(tsetelementnode(right).left,nil),
+                        resulttype);
+                      { reused }
+                      tsetelementnode(right).left := nil;
+                    end
+                  else
+                    begin
+                      if right.nodetype=setelementn then
                        begin
                        begin
-                         tsetelementnode(right).right :=
-                           ctypeconvnode.create_internal(tsetelementnode(right).right,
+                         { convert the arguments to bytes, since that's what }
+                         { the helper expects                               }
+                         tsetelementnode(right).left :=
+                           ctypeconvnode.create_internal(tsetelementnode(right).left,
                            u8inttype);
                            u8inttype);
 
 
-                         { create the call }
-                         result := ccallnode.createinternres('fpc_set_set_range',
-                           ccallparanode.create(tsetelementnode(right).right,
-                           ccallparanode.create(tsetelementnode(right).left,
-                           ccallparanode.create(left,nil))),resulttype);
+                         { convert the original set (explicitely) to an   }
+                         { fpc_normal_set so we can pass it to the helper }
+                         left := ctypeconvnode.create_internal(left,srsym.restype);
+
+                         { add a range or a single element? }
+                         if assigned(tsetelementnode(right).right) then
+                           begin
+                             tsetelementnode(right).right :=
+                               ctypeconvnode.create_internal(tsetelementnode(right).right,
+                               u8inttype);
+
+                             { create the call }
+                             result := ccallnode.createinternres('fpc_set_set_range',
+                               ccallparanode.create(tsetelementnode(right).right,
+                               ccallparanode.create(tsetelementnode(right).left,
+                               ccallparanode.create(left,nil))),resulttype);
+                           end
+                         else
+                           begin
+                             result := ccallnode.createinternres('fpc_set_set_byte',
+                               ccallparanode.create(tsetelementnode(right).left,
+                               ccallparanode.create(left,nil)),resulttype);
+                           end;
+                         { remove reused parts from original node }
+                         tsetelementnode(right).right := nil;
+                         tsetelementnode(right).left := nil;
+                         left := nil;
                        end
                        end
-                     else
+                      else
                        begin
                        begin
-                         result := ccallnode.createinternres('fpc_set_set_byte',
-                           ccallparanode.create(tsetelementnode(right).left,
-                           ccallparanode.create(left,nil)),resulttype);
+                         { add two sets }
+
+                         { convert the sets to fpc_normal_set's }
+                         result := ccallnode.createinternres('fpc_set_add_sets',
+                           ccallparanode.create(
+                             ctypeconvnode.create_explicit(right,srsym.restype),
+                           ccallparanode.create(
+                             ctypeconvnode.create_internal(left,srsym.restype),nil)),resulttype);
+                         { remove reused parts from original node }
+                         left := nil;
+                         right := nil;
                        end;
                        end;
-                     { remove reused parts from original node }
-                     tsetelementnode(right).right := nil;
-                     tsetelementnode(right).left := nil;
-                     left := nil;
-                   end
-                  else
-                   begin
-                     { add two sets }
-
-                     { convert the sets to fpc_normal_set's }
-                     result := ccallnode.createinternres('fpc_set_add_sets',
-                       ccallparanode.create(
-                         ctypeconvnode.create_explicit(right,srsym.restype),
-                       ccallparanode.create(
-                         ctypeconvnode.create_internal(left,srsym.restype),nil)),resulttype);
-                     { remove reused parts from original node }
-                     left := nil;
-                     right := nil;
-                   end;
-                end
-            end;
-          subn,symdifn,muln:
-            begin
-              { convert the sets to fpc_normal_set's }
-              paras := ccallparanode.create(ctypeconvnode.create_internal(right,srsym.restype),
-                ccallparanode.create(ctypeconvnode.create_internal(left,srsym.restype),nil));
-              case nodetype of
-                subn:
-                  result := ccallnode.createinternres('fpc_set_sub_sets',
-                    paras,resulttype);
-                symdifn:
-                  result := ccallnode.createinternres('fpc_set_symdif_sets',
-                    paras,resulttype);
-                muln:
-                  result := ccallnode.createinternres('fpc_set_mul_sets',
-                    paras,resulttype);
-              end;
-              { remove reused parts from original node }
-              left := nil;
-              right := nil;
+                    end
+                end;
+              subn,symdifn,muln:
+                begin
+                  { convert the sets to fpc_normal_set's }
+                  paras := ccallparanode.create(ctypeconvnode.create_internal(right,srsym.restype),
+                    ccallparanode.create(ctypeconvnode.create_internal(left,srsym.restype),nil));
+                  case nodetype of
+                    subn:
+                      result := ccallnode.createinternres('fpc_set_sub_sets',
+                        paras,resulttype);
+                    symdifn:
+                      result := ccallnode.createinternres('fpc_set_symdif_sets',
+                        paras,resulttype);
+                    muln:
+                      result := ccallnode.createinternres('fpc_set_mul_sets',
+                        paras,resulttype);
+                  end;
+                  { remove reused parts from original node }
+                  left := nil;
+                  right := nil;
+                end;
+              else
+                internalerror(200108311);
             end;
             end;
-          else
-            internalerror(200108311);
-        end;
+          end;
       end;
       end;
 
 
 
 

+ 0 - 2
compiler/parser.pas

@@ -386,9 +386,7 @@ implementation
          aktmoduleswitches:=initmoduleswitches;
          aktmoduleswitches:=initmoduleswitches;
          aktmodeswitches:=initmodeswitches;
          aktmodeswitches:=initmodeswitches;
          aktoptimizerswitches:=initoptimizerswitches;
          aktoptimizerswitches:=initoptimizerswitches;
-         {$IFDEF Testvarsets}
          aktsetalloc:=initsetalloc;
          aktsetalloc:=initsetalloc;
-         {$ENDIF}
          aktalignment:=initalignment;
          aktalignment:=initalignment;
          aktfputype:=initfputype;
          aktfputype:=initfputype;
          aktpackenum:=initpackenum;
          aktpackenum:=initpackenum;

+ 6 - 7
compiler/scandir.pas

@@ -812,19 +812,19 @@ implementation
          end;
          end;
       end;
       end;
 
 
-{$ifdef testvarsets}
+
     procedure dir_packset;
     procedure dir_packset;
       var
       var
         hs : string;
         hs : string;
       begin
       begin
         current_scanner.skipspace;
         current_scanner.skipspace;
-        if not(c in ['1','2','4']) then
+        if not(c in ['1','2','4','8']) then
          begin
          begin
            hs:=current_scanner.readid;
            hs:=current_scanner.readid;
            if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
            if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
             aktsetalloc:=0               {Fixed mode, sets are 4 or 32 bytes}
             aktsetalloc:=0               {Fixed mode, sets are 4 or 32 bytes}
            else
            else
-            Message(scan_w_only_packset);
+            Message(scan_e_only_packset);
          end
          end
         else
         else
          begin
          begin
@@ -832,12 +832,13 @@ implementation
             1 : aktsetalloc:=1;
             1 : aktsetalloc:=1;
             2 : aktsetalloc:=2;
             2 : aktsetalloc:=2;
             4 : aktsetalloc:=4;
             4 : aktsetalloc:=4;
+            8 : aktsetalloc:=8;
            else
            else
-            Message(scan_w_only_packset);
+            Message(scan_e_only_packset);
            end;
            end;
          end;
          end;
       end;
       end;
-{$ENDIF}
+
 
 
     procedure dir_pic;
     procedure dir_pic;
       begin
       begin
@@ -1276,9 +1277,7 @@ implementation
         AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks);
         AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks);
         AddDirective('PACKENUM',directive_all, @dir_packenum);
         AddDirective('PACKENUM',directive_all, @dir_packenum);
         AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
         AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
-{$IFDEF TestVarsets}
         AddDirective('PACKSET',directive_all, @dir_packset);
         AddDirective('PACKSET',directive_all, @dir_packset);
-{$ENDIF}
         AddDirective('PIC',directive_all, @dir_pic);
         AddDirective('PIC',directive_all, @dir_pic);
         AddDirective('POP',directive_mac, @dir_pop);
         AddDirective('POP',directive_mac, @dir_pop);
         AddDirective('PROFILE',directive_all, @dir_profile);
         AddDirective('PROFILE',directive_all, @dir_profile);

+ 15 - 25
compiler/symdef.pas

@@ -2294,33 +2294,23 @@ implementation
          setmax:=high;
          setmax:=high;
          if high<32 then
          if high<32 then
            begin
            begin
-            settype:=smallset;
-           {$ifdef testvarsets}
-            if aktsetalloc=0 THEN      { $PACKSET Fixed?}
-           {$endif}
-            savesize:=Sizeof(longint)
-           {$ifdef testvarsets}
-           else                       {No, use $PACKSET VALUE for rounding}
-            savesize:=aktsetalloc*((high+aktsetalloc*8-1) DIV (aktsetalloc*8))
-           {$endif}
-              ;
-          end
+             settype:=smallset;
+             if aktsetalloc=0 then      { $PACKSET Fixed?}
+               savesize:=Sizeof(longint)
+             else                       {No, use $PACKSET VALUE for rounding}
+               savesize:=aktsetalloc*((high+aktsetalloc*8-1) DIV (aktsetalloc*8));
+           end
          else
          else
           if high<256 then
           if high<256 then
-           begin
+            begin
               settype:=normset;
               settype:=normset;
-              savesize:=32;
-           end
-         else
-{$ifdef testvarsets}
-         if high<$10000 then
-           begin
-              settype:=varset;
-              savesize:=4*((high+31) div 32);
-           end
-         else
-{$endif testvarsets}
-          Message(sym_e_ill_type_decl_set);
+              if aktsetalloc=0 then      { $PACKSET Fixed?}
+                savesize:=32
+              else                       {No, use $PACKSET VALUE for rounding}
+                savesize:=aktsetalloc*((high+aktsetalloc*8-1) DIV (aktsetalloc*8));
+            end
+          else
+            savesize:=aktsetalloc*((high+aktsetalloc*8-1) DIV (aktsetalloc*8));
       end;
       end;
 
 
 
 
@@ -2809,7 +2799,7 @@ implementation
          trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
-         trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte);  
+         trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).ppuload(ppufile);
          trecordsymtable(symtable).ppuload(ppufile);
          symtable.defowner:=self;
          symtable.defowner:=self;
          isunion:=false;
          isunion:=false;

+ 13 - 0
rtl/inc/compproc.inc

@@ -293,6 +293,19 @@ 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_comp_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
 function fpc_set_contains_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_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_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;
+procedure fpc_varset_mul_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+procedure fpc_varset_sub_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+procedure fpc_varset_symdif_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+function fpc_varset_comp_sets(const set1,set2;size : ptrint):boolean; compilerproc;
+function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean; compilerproc;
+
 {$ifdef LARGESETS}
 {$ifdef LARGESETS}
 procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc;
 procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc;
 procedure fpc_largeset_in_word(p : pointer;b : word); compilerproc;
 procedure fpc_largeset_in_word(p : pointer;b : word); compilerproc;

+ 57 - 0
tests/test/tvarset1.pp

@@ -0,0 +1,57 @@
+{$packset 1}
+type
+  tset8 = set of 0..63;
+
+procedure do_error(l : longint);
+
+  begin
+     writeln('Error near number ',l);
+     halt(1);
+  end;
+
+var
+  set8_1,set8_2,set8_3 : tset8;
+  i,j : longint;
+begin
+  if sizeof(tset8)<>8 then
+    do_error(1);
+
+  set8_1:=[42];
+  set8_2:=set8_1;
+  if set8_1<>set8_2 then
+    do_error(2);
+
+  set8_2:=[41,42];
+  if set8_1=set8_2 then
+    do_error(3);
+
+  if set8_1>=set8_2 then
+    do_error(4);
+
+  set8_1:=[21..50];
+  if set8_1<=set8_2 then
+    do_error(5);
+
+  set8_1:=[1];
+  set8_2:=[2];
+  set8_3:=set8_1+set8_2;
+  if set8_3<>[1,2] then
+    do_error(6);
+
+  i:=55;
+  set8_1:=[i];
+  if set8_1<>[55] then
+    do_error(7);
+
+  i:=55;
+  j:=60;
+  set8_1:=[i,j];
+  if set8_1<>[55,60] then
+    do_error(8);
+
+  i:=55;
+  j:=60;
+  set8_1:=[i..j];
+  if set8_1<>[55..60] then
+    do_error(9);
+end.

Энэ ялгаанд хэт олон файл өөрчлөгдсөн тул зарим файлыг харуулаагүй болно