* Basic structures for new sethandling implemented.

compiler/globals.pas

@@ -150,6 +150,9 @@ unit globals;
        initmoduleswitches : tmoduleswitches;
        initlocalswitches  : tlocalswitches;
        initmodeswitches   : tmodeswitches;
+       {$IFDEF testvarsets}
+        Initsetalloc,                            {0=fixed, 1 =var}
+       {$ENDIF}
        initpackenum       : longint;
        initpackrecords    : tpackrecords;
        initoutputformat   : tasm;
@@ -161,6 +164,9 @@ unit globals;
        aktmoduleswitches : tmoduleswitches;
        aktlocalswitches  : tlocalswitches;
        aktmodeswitches   : tmodeswitches;
+       {$IFDEF testvarsets}
+        aktsetalloc,
+       {$ENDIF}
        aktpackenum       : longint;
        aktmaxfpuregisters: longint;
        aktpackrecords    : tpackrecords;
@@ -1474,6 +1480,9 @@ implementation
         initoptprocessor:=Class386;
         initspecificoptprocessor:=Class386;
         initpackenum:=4;
+        {$IFDEF testvarsets}
+        initsetalloc:=0;
+        {$ENDIF}
         initpackrecords:=packrecord_2;
         initoutputformat:=target_asm.id;
         initasmmode:=asmmode_i386_att;
@@ -1482,6 +1491,9 @@ implementation
         initoptprocessor:=MC68000;
         include(initmoduleswitches,cs_fp_emulation);
         initpackenum:=4;
+        {$IFDEF testvarsets}
+         initsetalloc:=0;
+        {$ENDIF}
         initpackrecords:=packrecord_2;
         initoutputformat:=as_m68k_as;
         initasmmode:=asmmode_m68k_mot;
@@ -1513,7 +1525,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2000-02-10 11:45:48  peter
+  Revision 1.53  2000-02-14 20:58:44  marco
+   * Basic structures for new sethandling implemented.
+
+  Revision 1.52  2000/02/10 11:45:48  peter
     * addpath fixed with list of paths when inserting at the beginning
     * if exepath=currentdir then it's not inserted in path list
     * searchpaths in ppc386.cfg are now added at the beginning of the
@@ -1600,4 +1615,4 @@ end.
     * define FPC_DELPHI,FPC_OBJFPC,FPC_TP,FPC_GPC
     * initial support for ansistring default with modes
 
-}
+}

compiler/parser.pas

@@ -377,6 +377,9 @@ unit parser;
          aktlocalswitches:=initlocalswitches;
          aktmoduleswitches:=initmoduleswitches;
          aktmodeswitches:=initmodeswitches;
+         {$IFDEF Testvarsets}
+         aktsetalloc:=initsetalloc;
+         {$ENDIF}
          aktpackrecords:=initpackrecords;
          aktpackenum:=initpackenum;
          aktoutputformat:=initoutputformat;
@@ -591,7 +594,10 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.99  2000-02-09 13:22:55  peter
+  Revision 1.100  2000-02-14 20:58:44  marco
+   * Basic structures for new sethandling implemented.
+
+  Revision 1.99  2000/02/09 13:22:55  peter
     * log truncated
 
   Revision 1.98  2000/01/23 21:29:17  florian
@@ -663,4 +669,4 @@ end.
   Revision 1.79  1999/08/01 23:36:40  florian
     * some changes to compile the new code generator
 
-}
+}

compiler/scandir.inc

@@ -42,6 +42,9 @@ type
      _DIR_NOTE,_DIR_NOTES,
      _DIR_OBJECTPATH,_DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
      _DIR_PACKENUM,_DIR_PACKRECORDS,
+     {$IFDEF Testvarsets}
+      _DIR_PACKSET,
+     {$ENDIF}
      _DIR_R,_DIR_RANGECHECKS,_DIR_REFERENCEINFO,
      _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STACKFRAMES,_DIR_STATIC,_DIR_STOP,
      _DIR_TYPEDADDRESS,_DIR_TYPEINFO,
@@ -110,6 +113,9 @@ const
      'OVERFLOWCHECKS',
      'PACKENUM',
      'PACKRECORDS',
+     {$IFDEF testvarsets}
+     'PACKSET',
+     {$ENDIF}
      'R',
      'RANGECHECKS',
      'REFERENCEINFO',
@@ -953,6 +959,32 @@ const
          end;
       end;
 
+{$ifdef testvarsets}
+    procedure dir_setalloc(t:tdirectivetoken);
+      var
+        hs : string;
+      begin
+        current_scanner^.skipspace;
+        if not(c in ['1','2','4']) then
+         begin
+           hs:=current_scanner^.readid;
+           if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
+           aktsetalloc:=0               {Fixed mode, sets are 4 or 32 bytes}
+          else
+           Message(scan_w_only_packset);
+          end
+        else
+         begin
+           case current_scanner^.readval of
+            1 : aktpackenum:=1;
+            2 : aktpackenum:=2;
+            4 : aktpackenum:=4;
+           else
+            Message(scan_w_only_packset);
+           end;
+         end;
+      end;
+{$ENDIF}
     procedure dir_apptype(t:tdirectivetoken);
 
       var
@@ -1152,6 +1184,9 @@ const
          {_DIR_OVERFLOWCHECKS} dir_delphiswitch,
          {_DIR_PACKENUM} dir_packenum,
          {_DIR_PACKRECORDS} dir_packrecords,
+         {$IFDEF TestVarsets}
+         {_DIR_PACKSET} dir_packset,
+         {$ENDIF}
          {_DIR_R} dir_resource,
          {_DIR_RANGECHECKS} dir_delphiswitch,
          {_DIR_REFERENCEINFO} dir_delphiswitch,
@@ -1252,7 +1287,10 @@ const
 
 {
   $Log$
-  Revision 1.74  2000-02-09 13:23:03  peter
+  Revision 1.75  2000-02-14 20:58:43  marco
+   * Basic structures for new sethandling implemented.
+
+  Revision 1.74  2000/02/09 13:23:03  peter
     * log truncated
 
   Revision 1.73  2000/01/14 14:28:40  pierre

compiler/symdef.inc

@@ -1627,9 +1627,17 @@
          { small sets only working for i386 PM }
          if high<32 then
            begin
-              settype:=smallset;
-              savesize:=Sizeof(longint);
-           end
+            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
          else
 {$endif usesmallset}
          if high<256 then
@@ -3924,7 +3932,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.195  2000-02-11 13:53:49  pierre
+  Revision 1.196  2000-02-14 20:58:43  marco
+   * Basic structures for new sethandling implemented.
+
+  Revision 1.195  2000/02/11 13:53:49  pierre
    * avoid stack overflow in tref.done (bug 846)
 
   Revision 1.194  2000/02/09 13:23:04  peter