* compilerproc implementation of set addition/substraction/...

  * changed the declaration of some set helpers somewhat to accomodate the
    above change
  * i386 still uses the old code for comparisons of sets, because its
    helpers return the results in the flags
  * dummy tc_normal_2_small_set type conversion because I need the original
    resulttype of the set add nodes
  NOTE: you have to start a cycle with 1.0.5!

compiler/i386/n386add.pas

@@ -36,6 +36,7 @@ interface
           procedure SetResultLocation(cmpop,unsigned : boolean);
          protected
           function first_addstring : tnode; override;
+          function first_addset : tnode; override;
          private
           procedure second_addstring;
           procedure second_addset;
@@ -257,9 +258,21 @@ interface
                                 Addset
 *****************************************************************************}
 
+    { we have to disable the compilerproc handling for all set helpers that }
+    { return booleans, because they return their results in the flags       }
+    function ti386addnode.first_addset : tnode;
+      begin
+        if is_boolean(resulttype.def) then
+          begin
+            result := nil;
+            exit;
+          end;
+        result := inherited first_addset;
+      end;
+
+
     procedure ti386addnode.second_addset;
       var
-        createset,
         cmpop,
         pushed : boolean;
         href   : treference;
@@ -272,16 +285,7 @@ interface
         if nf_swaped in flags then
          swapleftright;
 
-        { optimize first loading of a set }
-        if (right.nodetype=setelementn) and
-           not(assigned(tsetelementnode(right).right)) and
-           is_emptyset(left) then
-         createset:=true
-        else
-         begin
-           createset:=false;
-           secondpass(left);
-         end;
+         secondpass(left);
 
         { are too few registers free? }
         pushed:=maybe_push(right.registers32,left,false);
@@ -294,151 +298,45 @@ interface
         set_location(location,left.location);
 
         { handle operations }
+        { (the rest is handled by compilerprocs in pass 1) (JM) }
 
         case nodetype of
           equaln,
         unequaln
-        ,lten, gten
-                  : begin
-                     cmpop:=true;
-                     del_location(left.location);
-                     del_location(right.location);
-                     pushusedregisters(pushedregs,$ff);
-                     If (nodetype in [equaln, unequaln, lten]) Then
-                       Begin
-                         emitpushreferenceaddr(right.location.reference);
-                         emitpushreferenceaddr(left.location.reference);
-                       End
-                     Else  {gten = lten, if the arguments are reversed}
-                       Begin
-                         emitpushreferenceaddr(left.location.reference);
-                         emitpushreferenceaddr(right.location.reference);
-                       End;
-                     saveregvars($ff);
-                     Case nodetype of
-                       equaln, unequaln:
-                         emitcall('FPC_SET_COMP_SETS');
-                       lten, gten:
-                         Begin
-                           emitcall('FPC_SET_CONTAINS_SETS');
-                           { we need a jne afterwards, not a jnbe/jnae }
-                           nodetype := equaln;
-                        End;
-                     End;
-                     maybe_loadself;
-                     popusedregisters(pushedregs);
-                     ungetiftemp(left.location.reference);
-                     ungetiftemp(right.location.reference);
-                   end;
-            addn : begin
-                   { add can be an other SET or Range or Element ! }
-                     { del_location(right.location);
-                       done in pushsetelement below PM
-
-                     And someone added it again because those registers must
-                     not be pushed by the pushusedregisters, however this
-                     breaks the optimizer (JM)
-
-                     del_location(right.location);
-                     pushusedregisters(pushedregs,$ff);}
-
-                     regstopush := $ff;
-                     remove_non_regvars_from_loc(right.location,regstopush);
-                     if (right.nodetype = setelementn) and
-                        assigned(tsetelementnode(right).right) then
-                       remove_non_regvars_from_loc(tsetelementnode(right).right.location,regstopush);
-                     remove_non_regvars_from_loc(left.location,regstopush);
-                     pushusedregisters(pushedregs,regstopush);
-                     { this is still right before the instruction that uses }
-                     { left.location, but that can be fixed by the      }
-                     { optimizer. There must never be an additional         }
-                     { between the release and the use, because that is not }
-                     { detected/fixed. As Pierre said above, right.loc  }
-                     { will be released in pushsetelement (JM)              }
-                     del_location(left.location);
-                     href.symbol:=nil;
-                     gettempofsizereference(32,href);
-                     if createset then
-                      begin
-                        pushsetelement(tunarynode(right).left);
-                        emitpushreferenceaddr(href);
-                        saveregvars(regstopush);
-                        emitcall('FPC_SET_CREATE_ELEMENT');
-                      end
-                     else
-                      begin
-                      { add a range or a single element? }
-                        if right.nodetype=setelementn then
-                         begin
-                           concatcopy(left.location.reference,href,32,false,false);
-                           if assigned(tbinarynode(right).right) then
-                            begin
-                              pushsetelement(tbinarynode(right).right);
-                              pushsetelement(tunarynode(right).left);
-                              emitpushreferenceaddr(href);
-                              saveregvars(regstopush);
-                              emitcall('FPC_SET_SET_RANGE');
-                            end
-                           else
-                            begin
-                              pushsetelement(tunarynode(right).left);
-                              emitpushreferenceaddr(href);
-                              saveregvars(regstopush);
-                              emitcall('FPC_SET_SET_BYTE');
-                            end;
-                         end
-                        else
-                         begin
-                         { must be an other set }
-                           emitpushreferenceaddr(href);
-                           emitpushreferenceaddr(right.location.reference);
-                           emitpushreferenceaddr(left.location.reference);
-                           saveregvars(regstopush);
-                           emitcall('FPC_SET_ADD_SETS');
-                         end;
-                      end;
-                     maybe_loadself;
-                     popusedregisters(pushedregs);
-                     ungetiftemp(left.location.reference);
-                     ungetiftemp(right.location.reference);
-                     location.loc:=LOC_MEM;
-                     location.reference:=href;
-                   end;
-            subn,
-         symdifn,
-            muln : begin
-                     { Find out which registers have to pushed (JM) }
-                     regstopush := $ff;
-                     remove_non_regvars_from_loc(left.location,regstopush);
-                     remove_non_regvars_from_loc(right.location,regstopush);
-                     { Push them (JM) }
-                     pushusedregisters(pushedregs,regstopush);
-                     href.symbol:=nil;
-                     gettempofsizereference(32,href);
-                     emitpushreferenceaddr(href);
-                     { Release the registers right before they're used,  }
-                     { see explanation in cgai386.pas:loadansistring for }
-                     { info why this is done right before the push (JM)  }
-                     del_location(right.location);
-                     emitpushreferenceaddr(right.location.reference);
-                     { The same here }
-                     del_location(left.location);
-                     emitpushreferenceaddr(left.location.reference);
-                     saveregvars(regstopush);
-                     case nodetype of
-                      subn : emitcall('FPC_SET_SUB_SETS');
-                   symdifn : emitcall('FPC_SET_SYMDIF_SETS');
-                      muln : emitcall('FPC_SET_MUL_SETS');
-                     end;
-                     maybe_loadself;
-                     popusedregisters(pushedregs);
-                     ungetiftemp(left.location.reference);
-                     ungetiftemp(right.location.reference);
-                     location.loc:=LOC_MEM;
-                     location.reference:=href;
-                   end;
+        ,lten, gten :
+          begin
+            cmpop:=true;
+            del_location(left.location);
+            del_location(right.location);
+            pushusedregisters(pushedregs,$ff);
+            If (nodetype in [equaln, unequaln, lten]) Then
+              Begin
+                emitpushreferenceaddr(right.location.reference);
+                emitpushreferenceaddr(left.location.reference);
+              End
+            Else  {gten = lten, if the arguments are reversed}
+              Begin
+                emitpushreferenceaddr(left.location.reference);
+                emitpushreferenceaddr(right.location.reference);
+              End;
+            saveregvars($ff);
+            Case nodetype of
+              equaln, unequaln:
+                emitcall('FPC_SET_COMP_SETS');
+              lten, gten:
+                Begin
+                  emitcall('FPC_SET_CONTAINS_SETS');
+                  { we need a jne afterwards, not a jnbe/jnae }
+                  nodetype := equaln;
+               End;
+            End;
+            maybe_loadself;
+            popusedregisters(pushedregs);
+            ungetiftemp(left.location.reference);
+            ungetiftemp(right.location.reference);
+          end;
         else
-          CGMessage(type_e_mismatch);
+          internalerror(200108314);
         end;
         SetResultLocation(cmpop,true);
       end;
@@ -2082,7 +1980,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-08-30 15:43:14  jonas
+  Revision 1.21  2001-09-03 13:27:42  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.20  2001/08/30 15:43:14  jonas
     * converted adding/comparing of strings to compileproc. Note that due
       to the way the shortstring helpers for i386 are written, they are
       still handled by the old code (reason: fpc_shortstr_compare returns

compiler/i386/n386cnv.pas

@@ -806,7 +806,8 @@ implementation
            @ti386typeconvnode.second_nothing, { interface 2 string }
            @ti386typeconvnode.second_nothing, { interface 2 guid   }
            @ti386typeconvnode.second_class_to_intf,
-           @ti386typeconvnode.second_char_to_char
+           @ti386typeconvnode.second_char_to_char,
+           @ti386typeconvnode.second_nothing  { normal_2_smallset }
          );
       type
          tprocedureofobject = procedure of object;
@@ -1000,7 +1001,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2001-08-29 19:49:03  jonas
+  Revision 1.23  2001-09-03 13:27:42  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.22  2001/08/29 19:49:03  jonas
     * some fixes in compilerprocs for chararray to string conversions
     * conversion from string to chararray is now also done via compilerprocs
 

compiler/nadd.pas

@@ -38,6 +38,7 @@ interface
           { override the following if you want to implement }
           { parts explicitely in the code generator (JM)    }
           function first_addstring: tnode; virtual;
+          function first_addset: tnode; virtual;
        end;
        taddnodeclass = class of taddnode;
 
@@ -53,7 +54,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,widestr,
-      symconst,symtype,symdef,symsym,types,
+      symconst,symtype,symbase,symdef,symsym,symtable,types,
       cpuinfo,
       cgbase,
       htypechk,pass_1,
@@ -1110,6 +1111,164 @@ implementation
       end;
 
 
+    function taddnode.first_addset: tnode;
+      var
+        procname: string[31];
+        tempn: tnode;
+        paras: tcallparanode;
+        srsym: ttypesym;
+        symowner: tsymtable;
+        createset: boolean;
+      begin
+        { get the sym that represents the fpc_normal_set type }
+        if not(cs_compilesystem in aktmoduleswitches) then
+          srsym := ttypesym(searchsymonlyin(systemunit,'FPC_NORMAL_SET'))
+        else
+          searchsym('FPC_NORMAL_SET',tsym(srsym),symowner);
+        if not assigned(srsym) or
+           (srsym.typ <> typesym) then
+          internalerror(200108313);
+
+        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_set';
+                    { (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(left,srsym.restype);
+               right := ctypeconvnode.create(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(tsetelementnode(right).left,u8bittype);
+                  tsetelementnode(right).left.toggleflag(nf_explizit);
+                  { 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
+                     { convert the arguments to bytes, since that's what }
+                     { the helper expects                               }
+                     tsetelementnode(right).left :=
+                       ctypeconvnode.create(tsetelementnode(right).left,
+                       u8bittype);
+                     tsetelementnode(right).left.toggleflag(nf_explizit);
+                    
+                     { convert the original set (explicitely) to an   }
+                     { fpc_normal_set so we can pass it to the helper }
+                     left := ctypeconvnode.create(left,srsym.restype);
+                     left.toggleflag(nf_explizit);
+                     
+                     { add a range or a single element? }
+                     if assigned(tsetelementnode(right).right) then
+                       begin
+                         tsetelementnode(right).right :=
+                           ctypeconvnode.create(tsetelementnode(right).right,
+                           u8bittype);
+                         tsetelementnode(right).right.toggleflag(nf_explizit);
+                         
+                         { 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
+                  else
+                   begin
+                     { add two sets }
+                     
+                     { convert the sets to fpc_normal_set's }
+                     left := ctypeconvnode.create(left,srsym.restype);
+                     left.toggleflag(nf_explizit);
+                     right := ctypeconvnode.create(right,srsym.restype);
+                     right.toggleflag(nf_explizit);
+                     result := ccallnode.createinternres('fpc_set_add_sets',
+                       ccallparanode.create(right,
+                       ccallparanode.create(left,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 }
+              left := ctypeconvnode.create(left,srsym.restype);
+              left.toggleflag(nf_explizit);
+              right := ctypeconvnode.create(right,srsym.restype);
+              right.toggleflag(nf_explizit);
+              paras := ccallparanode.create(right,
+                ccallparanode.create(left,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;
+        firstpass(result);
+      end;
+
+
     function taddnode.pass_1 : tnode;
       var
          hp      : tnode;
@@ -1203,6 +1362,9 @@ implementation
               end
              else
               begin
+                 result := first_addset;
+                 if assigned(result) then
+                   exit;
                  calcregisters(self,0,0,0);
                  { here we call SET... }
                  procinfo^.flags:=procinfo^.flags or pi_do_call;
@@ -1369,7 +1531,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2001-09-02 21:12:06  peter
+  Revision 1.37  2001-09-03 13:27:42  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.36  2001/09/02 21:12:06  peter
     * move class of definitions into type section for delphi
 
   Revision 1.35  2001/08/31 15:42:15  jonas

compiler/ncnv.pas

@@ -126,7 +126,10 @@ implementation
          end;
 
         { don't insert obsolete type conversions }
-        if is_equal(p.resulttype.def,t.def) then
+        if is_equal(p.resulttype.def,t.def) and
+           not ((p.resulttype.def.deftype=setdef) and
+                (tsetdef(p.resulttype.def).settype <>
+                 tsetdef(t.def).settype)) then
          begin
            p.resulttype:=t;
          end
@@ -686,7 +689,8 @@ implementation
           { intf_2_string } nil,
           { intf_2_guid } nil,
           { class_2_intf } nil,
-          { char_2_char } @ttypeconvnode.resulttype_char_to_char
+          { char_2_char } @ttypeconvnode.resulttype_char_to_char,
+          { nomal_2_smallset} nil
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -725,19 +729,24 @@ implementation
             check here if we are loading a smallset into a normalset }
             if (resulttype.def.deftype=setdef) and
                (left.resulttype.def.deftype=setdef) and
-               (tsetdef(resulttype.def).settype<>smallset) and
-               (tsetdef(left.resulttype.def).settype=smallset) then
-             begin
-             { try to define the set as a normalset if it's a constant set }
-               if left.nodetype=setconstn then
-                begin
-                  resulttype:=left.resulttype;
-                  tsetdef(resulttype.def).settype:=normset
-                end
-               else
-                convtype:=tc_load_smallset;
-               exit;
-             end
+               ((tsetdef(resulttype.def).settype = smallset) xor
+                (tsetdef(left.resulttype.def).settype = smallset)) then
+              begin
+              { try to define the set as a normalset if it's a constant set }
+                if (tsetdef(resulttype.def).settype <> smallset) then
+                  begin
+                    if (left.nodetype=setconstn) then
+                      begin
+                        resulttype:=left.resulttype;
+                        tsetdef(resulttype.def).settype:=normset
+                      end
+                     else
+                      convtype:=tc_load_smallset;
+                  end
+                else
+                  convtype := tc_normal_2_smallset;
+                exit;
+              end
             else
              begin
                left.resulttype:=resulttype;
@@ -1274,7 +1283,8 @@ implementation
            @ttypeconvnode.first_nothing,
            @ttypeconvnode.first_nothing,
            @ttypeconvnode.first_class_to_intf,
-           @ttypeconvnode.first_char_to_char
+           @ttypeconvnode.first_char_to_char,
+           @ttypeconvnode.first_nothing
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -1466,7 +1476,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2001-09-02 21:12:06  peter
+  Revision 1.37  2001-09-03 13:27:42  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.36  2001/09/02 21:12:06  peter
     * move class of definitions into type section for delphi
 
   Revision 1.35  2001/08/29 19:49:03  jonas
@@ -1489,7 +1509,7 @@ end.
   Revision 1.33  2001/08/28 13:24:46  jonas
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
-      compilerproc implementations (using {$ifdef hascompilerproc} is not
+      compilerproc implementations (using (ifdef hascompilerproc) is not
       necessary in the compiler)
 
   Revision 1.32  2001/08/26 13:36:40  florian

compiler/types.pas

@@ -184,7 +184,8 @@ interface
           tc_intf_2_string,
           tc_intf_2_guid,
           tc_class_2_intf,
-          tc_char_2_char
+          tc_char_2_char,
+          tc_normal_2_smallset
        );
 
     function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
@@ -1783,7 +1784,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  2001-09-02 21:15:34  peter
+  Revision 1.47  2001-09-03 13:27:41  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.46  2001/09/02 21:15:34  peter
     * don't allow int64->real for delphi mode
 
   Revision 1.45  2001/08/19 21:11:21  florian

rtl/i386/set.inc

@@ -14,55 +14,89 @@
 
  **********************************************************************}
 
+{$ifndef hascompilerproc}
+type
+  fpc_small_set = set of 0..31;
+  fpc_normal_set = set of byte;
+{$endif hascompilerproc}
+
 {$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
-procedure fpc_set_load_small(p : pointer;l:longint);assembler;[public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif}
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif}
 {
   load a normal set p from a smallset l
 }
 asm
-        movl    p,%edi
+        movl    __RESULT,%edi
         movl    l,%eax
-        movl    %eax,(%edi)
-        addl    $4,%edi
         movl    $7,%ecx
+        movl    %eax,4(%edi)
+        addl    $4,%edi
         xorl    %eax,%eax
         rep
         stosl
-end;
+end ['EAX','ECX','EDI'];
 
 {$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
-procedure fpc_set_create_element(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+function fpc_set_create_element(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif}
 {
   create a new set in p from an element b
 }
 asm
+{$ifndef hascompilerproc}
         pushl   %eax
         pushl   %ecx
-        movl    p,%edi
+{$endif not hascompilerproc}
+        movl    __RESULT,%edi
         xorl    %eax,%eax
         movl    $8,%ecx
         rep
         stosl
         movb    b,%al
-        movl    p,%edi
+        movl    __RESULT,%edi
         movl    %eax,%ecx
         shrl    $3,%eax
         andl    $7,%ecx
         addl    %eax,%edi
         btsl    %ecx,(%edi)
+{$ifdef hascompilerproc}
+        movl    __RESULT,%edi
+{$else hascompilerproc}
         popl    %ecx
         popl    %eax
-end;
+{$endif hascompilerproc}
+end ['EAX','ECX','EDI'];
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
-procedure fpc_set_set_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_SET_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifdef hascompilerproc}
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+  add the element b to the set pointed by source
+}
+asm
+       movl $8,%ecx
+       movl source,%esi
+       movl __RESULT,%edi
+       movb b,%al
+       rep
+       movsl
+       andl $0xf8,%eax
+       subl $32,%edi
+       shrl $3,%eax
+       addl %eax,%edi
+       movb b,%al
+       andl $7,%eax
+       btsl %eax,(%edi)
+end ['EAX','ECX','EDI'];
+{$else hascompilerproc}
+function fpc_set_set_byte(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_SET_BYTE'];
 {
   add the element b to the set pointed by p
 }
 asm
        pushl %eax
-       movl p,%edi
+       movl __RESULT,%edi
        movb b,%al
        andl $0xf8,%eax
        shrl $3,%eax
@@ -72,17 +106,39 @@ asm
        btsl %eax,(%edi)
        popl %eax
 end;
+{$endif hascompilerproc}
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
-procedure fpc_set_unset_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_UNSET_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifdef hascompilerproc}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+  add the element b to the set pointed by source
+}
+asm
+       movl $8,%ecx
+       movl source,%esi
+       movl __RESULT,%edi
+       movb b,%al
+       rep
+       movsl
+       andl $0xf8,%eax
+       subl $32,%edi
+       shrl $3,%eax
+       addl %eax,%edi
+       movb b,%al
+       andl $7,%eax
+       btrl %eax,(%edi)
+end ['EAX','ECX','EDI'];
+{$else hascompilerproc}
+function fpc_set_unset_byte(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_UNSET_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif}
 {
   suppresses the element b to the set pointed by p
   used for exclude(set,element)
 }
 asm
        pushl %eax
-       movl p,%edi
+       movl __RESULT,%edi
        movb b,%al
        andl $0xf8,%eax
        shrl $3,%eax
@@ -92,20 +148,73 @@ asm
        btrl %eax,(%edi)
        popl %eax
 end;
+{$endif hascompilerproc}
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
-procedure fpc_set_set_range(p : pointer;l,h : byte);assembler;[public,alias:'FPC_SET_SET_RANGE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set;assembler; compilerproc;
+{
+  adds the range [l..h] to the set pointed to by p
+}
+asm
+        movzbl l,%eax               // lowest bit to be set in eax
+        movzbl h,%ebx               // highest in ebx
+        movl   $8,%ecx              // we have to copy 32 bytes
+        movl   __RESULT,%edi        // target set address in edi
+        movl   orgset, %esi         // source set address in esi
+        cmpl   %eax,%ebx            // high < low?
+        rep                         // copy source to dest (it's possible to do the range
+        movsl                       // setting and copying simultanuously of course, but
+                                    // that would result in many more jumps and code)
+        movl   %eax,%ecx            // lowest also in ecx
+        jb     .Lset_range_done     // if high > low, then dest := source
+        shrl   $3,%eax              // divide by 8 to get starting and ending byte
+        shrl   $3,%ebx              // address
+        andb   $31,%cl              // low five bits of lo determine start of bit mask
+        andl   $0x0fffffffc,%eax    // clear two lowest bits to get start/end longint
+        subl   $32,%edi             // get back to start of dest
+        andl   $0x0fffffffc,%ebx    // address * 4
+        movl   $0x0ffffffff,%edx    // edx = bitmask to be inserted
+        shll   %cl,%edx             // shift bitmask to clear bits below lo
+        addl   %eax,%edi            // go to starting pos in set
+        subl   %eax,%ebx            // are bit lo and hi in the same longint?
+        jz     .Lset_range_hi       // yes, keep current mask and adjust for hi bit
+        orl    %edx,(%edi)          // no, store current mask
+        movl   $0x0ffffffff,%edx    // new mask
+        addl   $4,%edi              // next longint of set
+        subl   $4,%ebx              // bit hi in this longint?
+        jz     .Lset_range_hi       // yes, keep full mask and adjust for hi bit
+.Lset_range_loop:
+        movl   %edx,(%edi)          // no, fill longints in between with full mask
+        addl   $4,%edi
+        subl   $4,%ebx
+        jnz    .Lset_range_loop
+.Lset_range_hi:
+        movb   h,%cl
+        movl   %edx,%ebx            // save current bitmask
+        andb   $31,%cl
+        subb   $31,%cl              // cl := (31 - (hi and 31)) = shift count to
+        negb   %cl                  // adjust bitmask for hi bit
+        shrl   %cl,%edx             // shift bitmask to clear bits higher than hi
+        andl   %edx,%ebx            // combine both bitmasks
+        orl    %ebx,(%edi)          // store to set
+.Lset_range_done:
+end;
+
+{$else hascompilerproc}
+
+function fpc_set_set_range(l,h : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_SET_RANGE'];
 {
   adds the range [l..h] to the set pointed to by p
 }
 asm
-        pushl   %eax
         movzbl l,%eax              // lowest bit to be set in eax
         movzbl h,%ebx              // highest in ebx
         cmpl   %eax,%ebx
         jb     .Lset_range_done
-        movl   p,%edi               // set address in edi
+        movl   __RESULT,%edi               // set address in edi
         movl   %eax,%ecx            // lowest also in ecx
         shrl   $3,%eax              // divide by 8 to get starting and ending byte
         shrl   $3,%ebx              // address
@@ -137,12 +246,22 @@ asm
         andl   %edx,%ebx            // combine both bitmasks
         orl    %ebx,(%edi)          // store to set
 .Lset_range_done:
-        popl %eax
 end;
-
+{$endif hascompilerproc}
 
 {$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
-procedure fpc_set_in_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_IN_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+{ can't use as compilerproc, it returns its results in the flags :/ }
+function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; compilerproc;
+begin
+  fpc_set_in_byte := false;
+  { make sure we won't accidentally call it }
+  runerror(216);
+end;
+{$endif hascompilerproc}
+
+function fpc_set_in_byte_i386(p: pointer; b : byte): boolean;assembler;[public,alias:'FPC_SET_IN_BYTE'];
 {
   tests if the element b is in the set p the carryflag is set if it present
 }
@@ -161,14 +280,23 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
-procedure fpc_set_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS'];
+{$endif hascompilerproc}
 {
   adds set1 and set2 into set dest
 }
 asm
       movl set1,%esi
       movl set2,%ebx
+{$ifdef hascompilerproc}
+      movl __RESULT,%edi
+{$else hascompilerproc}
       movl dest,%edi
+{$endif hascompilerproc}
       movl $8,%ecx
    .LMADDSETS1:
       lodsl
@@ -181,14 +309,23 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
-procedure fpc_set_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS'];
+{$endif hascompilerproc}
 {
   multiplies (takes common elements of) set1 and set2 result put in dest
 }
 asm
       movl set1,%esi
       movl set2,%ebx
+{$ifdef hascompilerproc}
+      movl __RESULT,%edi
+{$else hascompilerproc}
       movl dest,%edi
+{$endif hascompilerproc}
       movl $8,%ecx
   .LMMULSETS1:
       lodsl
@@ -201,14 +338,23 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
-procedure fpc_set_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS'];
+{$endif hascompilerproc}
 {
   computes the diff from set1 to set2 result in dest
 }
 asm
         movl set1,%esi
         movl set2,%ebx
-        movl dest,%edi
+{$ifdef hascompilerproc}
+      movl __RESULT,%edi
+{$else hascompilerproc}
+      movl dest,%edi
+{$endif hascompilerproc}
         movl $8,%ecx
     .LMSUBSETS1:
         lodsl
@@ -223,14 +369,23 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
-procedure fpc_set_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS'];
+{$endif hascompilerproc}
 {
    computes the symetric diff from set1 to set2 result in dest
 }
 asm
         movl set1,%esi
         movl set2,%ebx
-        movl dest,%edi
+{$ifdef hascompilerproc}
+      movl __RESULT,%edi
+{$else hascompilerproc}
+      movl dest,%edi
+{$endif hascompilerproc}
         movl $8,%ecx
     .LMSYMDIFSETS1:
         lodsl
@@ -244,7 +399,18 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
-procedure fpc_set_comp_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_COMP_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{$ifdef hascompilerproc}
+{ can't use as compilerproc, it returns its results in the flags :/ }
+function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
+begin
+  fpc_set_comp_sets := false;
+  { make sure we won't accidentally call it }
+  runerror(216);
+end;
+{$endif hascompilerproc}
+
+procedure fpc_set_comp_sets_i386(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_COMP_SETS'];
 {
   compares set1 and set2 zeroflag is set if they are equal
 }
@@ -269,7 +435,17 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
-procedure fpc_set_contains_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifdef hascompilerproc}
+{ can't use as compilerproc, it returns its results in the flags :/ }
+function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
+begin
+  fpc_set_contains_sets := false;
+  { make sure we won't accidentally call it }
+  runerror(216);
+end;
+{$endif hascompilerproc}
+
+procedure fpc_set_contains_sets_i386(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_CONTAINS_SETS'];
 {
   on exit, zero flag is set if set1 <= set2 (set2 contains set1)
 }
@@ -455,7 +631,17 @@ end;
 
 {
   $Log$
-  Revision 1.5  2001-08-01 15:00:10  jonas
+  Revision 1.6  2001-09-03 13:27:43  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.5  2001/08/01 15:00:10  jonas
     + "compproc" helpers
     * renamed several helpers so that their name is the same as their
       "public alias", which should facilitate the conversion of processor

rtl/inc/compproc.inc

@@ -24,8 +24,11 @@
 
 {$ifdef hascompilerproc}
 
+{ some dummy types necessary to have generic resulttypes for certain compilerprocs }
 type
   fpc_big_chararray = array[0..maxlongint] of char;
+  fpc_small_set = set of 0..31;
+  fpc_normal_set = set of byte;
 
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt); compilerproc;
 function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
@@ -186,18 +189,18 @@ Procedure fpc_Addref (Data,TypeInfo : Pointer); compilerproc;
 Procedure fpc_DecRef (Data,TypeInfo : Pointer);  compilerproc;
 procedure fpc_FinalizeArray(data,typeinfo : pointer;count,size : longint); compilerproc;
 
-procedure fpc_set_load_small(p : pointer;l:longint); compilerproc;
-procedure fpc_set_create_element(p : pointer;b : byte); compilerproc;
-procedure fpc_set_set_byte(p : pointer;b : byte); compilerproc;
-procedure fpc_set_unset_byte(p : pointer;b : byte); compilerproc;
-procedure fpc_set_set_range(p : pointer;l,h : byte); compilerproc;
-procedure fpc_set_in_byte(p : pointer;b : byte); compilerproc;
-procedure fpc_set_add_sets(set1,set2,dest : pointer); compilerproc;
-procedure fpc_set_mul_sets(set1,set2,dest:pointer); compilerproc;
-procedure fpc_set_sub_sets(set1,set2,dest:pointer); compilerproc;
-procedure fpc_set_symdif_sets(set1,set2,dest:pointer); compilerproc;
-procedure fpc_set_comp_sets(set1,set2 : pointer); compilerproc;
-procedure fpc_set_contains_sets(set1,set2 : pointer); compilerproc;
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; compilerproc;
+function fpc_set_create_element(b : byte): fpc_normal_set; compilerproc;
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
+function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; compilerproc;
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set; 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;
 
 {$ifdef LARGESETS}
 procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc;
@@ -237,7 +240,17 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
 
 {
   $Log$
-  Revision 1.7  2001-08-30 15:43:15  jonas
+  Revision 1.8  2001-09-03 13:27:43  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.7  2001/08/30 15:43:15  jonas
     * converted adding/comparing of strings to compileproc. Note that due
       to the way the shortstring helpers for i386 are written, they are
       still handled by the old code (reason: fpc_shortstr_compare returns

rtl/inc/generic.inc

@@ -496,12 +496,12 @@ begin
       exit;
     end;
 }
-  slen:=length(pstring(sstr)^);
+  slen:=length(sstr);
   if slen<len then
     len:=slen;
   { don't forget the length character }
   if len <> 0 then
-      move(sstr[0],result[0],len+1);
+    move(sstr[0],result[0],len+1);
 end;
 
 procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
@@ -606,7 +606,7 @@ begin
   if l>0 then
     move(p^,s[1],l);
   s[0]:=chr(l);
-  strpas := s;
+  fpc_pchar_to_shortstr := s;
 end;
 
 {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
@@ -617,11 +617,11 @@ function strpas(p:pchar):shortstring; [external name 'FPC_PCHAR_TO_SHORTSTR'];
 {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 
 {$ifdef hascompilerproc}
-function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
+function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
 var
   l: longint;
 {$else hascompilerproc}
-function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
+function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
 {$endif hascompilerproc}
 begin
 {$ifdef hascompilerproc}
@@ -891,7 +891,17 @@ end;
 
 {
   $Log$
-  Revision 1.20  2001-08-30 15:43:15  jonas
+  Revision 1.21  2001-09-03 13:27:43  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.20  2001/08/30 15:43:15  jonas
     * converted adding/comparing of strings to compileproc. Note that due
       to the way the shortstring helpers for i386 are written, they are
       still handled by the old code (reason: fpc_shortstr_compare returns

rtl/inc/genset.inc

@@ -14,38 +14,49 @@
 
  **********************************************************************}
 
- TYPE
-   { TNormalSet = array[0..31] of byte;}
-    TNormalSet = array[0..7] of longint;
-
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 { Error No pascal version of FPC_SET_LOAD_SMALL}
  { THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE!
    Not anymore PM}
 
-procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL'];
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; [public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif}
  {
   load a normal set p from a smallset l
  }
  begin
-   Fillchar(p^,SizeOf(TNormalSet),#0);
-   TNormalSet(p^)[0] := l;
+   fpc_set_load_small[0] := l;
+   FillDWord(fpc_set_load_small[1],7,0);
  end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
- procedure do_create_element(p : pointer;b : byte);[public,alias:'FPC_SET_CREATE_ELEMENT'];
+function fpc_set_create_element(b : byte): fpc_normal_set;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif}
  {
   create a new set in p from an element b
  }
  begin
-   Fillchar(p^,SizeOf(TNormalSet),#0);
-   TNormalSet(p^)[b div 32] := 1 shl (b mod 32);
+   FillDWord(fpc_set_create_element,SizeOf(fpc_set_create_element) div 4,0);
+   fpc_set_create_element[b div 32] := 1 shl (b mod 32);
  end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+
+{$ifdef hascompilerproc}
+ function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+ {
+  add the element b to the set "source"
+ }
+  var
+   c: longint;
+  begin
+    move(source,fpc_set_set_byte,sizeof(source));
+    c := fpc_set_set_byte[b div 32];
+    c := (1 shl (b mod 32)) or c;
+    fpc_set_set_byte[b div 32] := c;
+  end;
+{$else hascompilerproc}
  procedure do_set_byte(p : pointer;b : byte);[public,alias:'FPC_SET_SET_BYTE'];
  {
   add the element b to the set pointed by p
@@ -53,15 +64,32 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
   var
    c: longint;
   begin
-    c := TNormalSet(p^)[b div 32];
+    c := fpc_normal_set(p^)[b div 32];
     c := (1 shl (b mod 32)) or c;
-    TNormalSet(p^)[b div 32] := c;
+    fpc_normal_set(p^)[b div 32] := c;
   end;
+{$endif hascompilerproc}
 {$endif FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
- procedure do_unset_byte(p : pointer;b : byte);[public,alias:'FPC_SET_UNSET_BYTE'];
+
+{$ifdef hascompilerproc}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+ {
+   suppresses the element b to the set pointed by p
+   used for exclude(set,element)
+ }
+  var
+   c: longint;
+  begin
+    move(source,fpc_set_unset_byte,sizeof(source));
+    c := fpc_set_unset_byte[b div 32];
+    c := c and not (1 shl (b mod 32));
+    fpc_set_unset_byte[b div 32] := c;
+  end;
+{$else hascompilerproc}
+procedure do_unset_byte(p : pointer;b : byte);[public,alias:'FPC_SET_UNSET_BYTE'];
  {
    suppresses the element b to the set pointed by p
    used for exclude(set,element)
@@ -69,14 +97,33 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
   var
    c: longint;
   begin
-    c := TNormalSet(p^)[b div 32];
+    c := fpc_normal_set(p^)[b div 32];
     c := c and not (1 shl (b mod 32));
-    TNormalSet(p^)[b div 32] := c;
+    fpc_normal_set(p^)[b div 32] := c;
   end;
+{$endif hascompilerproc}
 {$endif FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+{$ifdef hascompilerproc}
+ function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
+ {
+   adds the range [l..h] to the set orgset
+ }
+  var
+   i: integer;
+   c: longint;
+  begin
+    move(orgset,fpc_set_set_range,sizeof(orgset));
+    for i:=l to h do
+      begin
+        c := fpc_set_set_range[i div 32];
+        c := (1 shl (i mod 32)) or c;
+        fpc_set_set_range[i div 32] := c;
+      end;
+  end;
+{$else hascompilerproc}
  procedure do_set_range(p : pointer;l,h : byte);[public,alias:'FPC_SET_SET_RANGE'];
  {
   bad implementation, but it's very seldom used
@@ -87,37 +134,34 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
   begin
     for i:=l to h do
       begin
-        c := TNormalSet(p^)[i div 32];
+        c := fpc_normal_set(p^)[i div 32];
         c := (1 shl (i mod 32)) or c;
-        TNormalSet(p^)[i div 32] := c;
+        fpc_normal_set(p^)[i div 32] := c;
       end;
   end;
-{$endif}
+{$endif hascompilerproc}
+{$endif ndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
 
-{ saveregisters is a bit of overkill, but this routine should save all registers }
-{ and it should be overriden for each platform and be written in assembler       }
-{ by saving all required registers.                                              }
- function do_in_byte(p : pointer;b : byte):boolean;[public,alias:'FPC_SET_IN_BYTE'];saveregisters;
+ function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; [public,alias:'FPC_SET_IN_BYTE']; {$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
  {
    tests if the element b is in the set p the carryflag is set if it present
  }
-  var
-    c: longint;
   begin
-    c := TNormalSet(p^)[b div 32];
-    if ((1 shl (b mod 32)) and c) <> 0 then
-     do_in_byte := TRUE
-    else
-     do_in_byte := FALSE;
+    fpc_set_in_byte := (p[b div 32] and (1 shl (b mod 32))) <> 0;
   end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
- procedure do_add_sets(set1,set2,dest : pointer);[public,alias:'FPC_SET_ADD_SETS'];
+{$ifdef hascompilerproc}
+ function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+ var
+   dest: fpc_normal_set absolute fpc_set_add_sets;
+{$else hascompilerproc}
+ procedure do_add_sets(const set1,set2: fpc_normal_Set; var dest : fpc_normal_set);[public,alias:'FPC_SET_ADD_SETS'];
  {
    adds set1 and set2 into set dest
  }
@@ -125,13 +169,20 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
     i: integer;
    begin
      for i:=0 to 7 do
-       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] or TNormalSet(set2^)[i];
+       dest[i] := set1[i] or set2[i];
    end;
+{$endif hascompilerproc}
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
- procedure do_mul_sets(set1,set2,dest:pointer);[public,alias:'FPC_SET_MUL_SETS'];
+{$ifdef hascompilerproc}
+ function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+ var
+   dest: fpc_normal_set absolute fpc_set_mul_sets;
+{$else hascompilerproc}
+ procedure do_mul_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_MUL_SETS'];
+{$endif hascompilerproc}
  {
    multiplies (takes common elements of) set1 and set2 result put in dest
  }
@@ -139,13 +190,19 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
     i: integer;
    begin
      for i:=0 to 7 do
-       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] and TNormalSet(set2^)[i];
+       dest[i] := set1[i] and set2[i];
    end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
- procedure do_sub_sets(set1,set2,dest:pointer);[public,alias:'FPC_SET_SUB_SETS'];
+{$ifdef hascompilerproc}
+ function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+ var
+   dest: fpc_normal_set absolute fpc_set_sub_sets;
+{$else hascompilerproc}
+ procedure do_sub_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_SUB_SETS'];
+{$endif hascompilerproc}
  {
   computes the diff from set1 to set2 result in dest
  }
@@ -153,13 +210,19 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
     i: integer;
    begin
      for i:=0 to 7 do
-       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] and not TNormalSet(set2^)[i];
+       dest[i] := set1[i] and not set2[i];
    end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
- procedure do_symdif_sets(set1,set2,dest:pointer);[public,alias:'FPC_SET_SYMDIF_SETS'];
+{$ifdef hascompilerproc}
+ function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+ var
+   dest: fpc_normal_set absolute fpc_set_symdif_sets;
+{$else hascompilerproc}
+ procedure do_symdif_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_SYMDIF_SETS'];
+{$endif hascompilerproc}
  {
    computes the symetric diff from set1 to set2 result in dest
  }
@@ -167,53 +230,57 @@ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL
     i: integer;
    begin
      for i:=0 to 7 do
-       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] xor TNormalSet(set2^)[i];
+       dest[i] := set1[i] xor set2[i];
    end;
 {$endif}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
-{ saveregisters is a bit of overkill, but this routine should save all registers }
-{ and it should be overriden for each platform and be written in assembler       }
-{ by saving all required registers.                                              }
- function do_comp_sets(set1,set2 : pointer):boolean;[public,alias:'FPC_SET_COMP_SETS'];saveregisters;
+ function fpc_set_comp_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'FPC_SET_COMP_SETS'];{$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
  {
   compares set1 and set2 zeroflag is set if they are equal
  }
    var
     i: integer;
    begin
-     do_comp_sets := false;
+     fpc_set_comp_sets:= false;
      for i:=0 to 7 do
-       if TNormalSet(set1^)[i] <> TNormalSet(set2^)[i] then
+       if set1[i] <> set2[i] then
          exit;
-     do_comp_sets := true;
+     fpc_set_comp_sets:= true;
    end;
 {$endif}
 
 
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
-{ saveregisters is a bit of overkill, but this routine should save all registers }
-{ and it should be overriden for each platform and be written in assembler       }
-{ by saving all required registers.                                              }
- function do_contains_sets(set1,set2 : pointer):boolean;[public,alias:'FPC_SET_CONTAINS_SETS'];saveregisters;
+ function fpc_set_contains_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'FPC_SET_CONTAINS_SETS'];{$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
  {
   on exit, zero flag is set if set1 <= set2 (set2 contains set1)
  }
  var
   i : integer;
  begin
-   do_contains_sets := false;
+   fpc_set_contains_sets:= false;
    for i:=0 to 7 do
-     if (TNormalSet(set1^)[i] and TNormalSet(set2^)[i]) <> TNormalSet(set1^)[i] then
+     if (set2[i] and not set1[i]) <> 0 then
        exit;
-   do_contains_sets := true;
+   fpc_set_contains_sets:= true;
  end;
 {$endif}
 
 {
   $Log$
-  Revision 1.4  2001-06-27 21:37:38  peter
+  Revision 1.5  2001-09-03 13:27:43  jonas
+    * compilerproc implementation of set addition/substraction/...
+    * changed the declaration of some set helpers somewhat to accomodate the
+      above change
+    * i386 still uses the old code for comparisons of sets, because its
+      helpers return the results in the flags
+    * dummy tc_normal_2_small_set type conversion because I need the original
+      resulttype of the set add nodes
+    NOTE: you have to start a cycle with 1.0.5!
+
+  Revision 1.4  2001/06/27 21:37:38  peter
     * v10 merges
 
   Revision 1.3  2001/05/18 22:59:59  peter