*** empty log message ***

rtl/i386/set.inc

@@ -14,6 +14,7 @@
 
  **********************************************************************}
 
+{$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 procedure do_load_small(p : pointer;l:longint);assembler;[public,alias:'FPC_SET_LOAD_SMALL'];
 {
   load a normal set p from a smallset l
@@ -29,7 +30,7 @@ asm
         stosl
 end;
 
-
+{$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
 procedure do_create_element(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_CREATE_ELEMENT'];
 {
   create a new set in p from an element b
@@ -53,6 +54,8 @@ asm
         popl    %eax
 end;
 
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
 procedure do_set_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_SET_BYTE'];
 {
   add the element b to the set pointed by p
@@ -71,6 +74,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
 procedure do_unset_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_UNSET_BYTE'];
 {
   suppresses the element b to the set pointed by p
@@ -90,6 +94,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
 procedure do_set_range(p : pointer;l,h : byte);assembler;[public,alias:'FPC_SET_SET_RANGE'];
 {
   adds the range [l..h] to the set pointed to by p
@@ -123,7 +128,7 @@ asm
         subl   $4,%ebx
         jnz    .Lset_range_loop
 .Lset_range_hi:
-        movb   h,%cl              
+        movb   h,%cl
         movl   %edx,%ebx            // save current bitmask
         andb   $31,%cl
         subb   $31,%cl              // cl := (31 - (hi and 31)) = shift count to
@@ -136,6 +141,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
 procedure do_in_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_IN_BYTE'];
 {
   tests if the element b is in the set p the carryflag is set if it present
@@ -154,7 +160,7 @@ asm
 end;
 
 
-
+{$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
 procedure do_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS'];
 {
   adds set1 and set2 into set dest
@@ -174,7 +180,7 @@ asm
 end;
 
 
-
+{$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
 procedure do_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS'];
 {
   multiplies (takes common elements of) set1 and set2 result put in dest
@@ -194,6 +200,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
 procedure do_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS'];
 {
   computes the diff from set1 to set2 result in dest
@@ -215,6 +222,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
 procedure do_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS'];
 {
    computes the symetric diff from set1 to set2 result in dest
@@ -235,6 +243,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
 procedure do_comp_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_COMP_SETS'];
 {
   compares set1 and set2 zeroflag is set if they are equal
@@ -257,7 +266,10 @@ asm
     .LMCOMPSETEND:
 end;
 
+
+
 {$IfNDef NoSetInclusion}
+{$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
 procedure do_contains_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_CONTAINS_SETS'];
 {
   on exit, zero flag is set if set1 <= set2 (set2 contains set1)
@@ -447,11 +459,14 @@ end;
 
 {
   $Log$
-  Revision 1.3  2000-09-21 16:09:19  jonas
+  Revision 1.4  2001-05-09 19:57:07  peter
+  *** empty log message ***
+
+  Revision 1.3  2000/09/21 16:09:19  jonas
     + new, much faster do_set_range based on the PowerPC version (which
       will be committed tomorrow)
 
   Revision 1.2  2000/07/13 11:33:41  michael
   + removed logs
- 
+
 }

rtl/inc/generic.inc

@@ -756,7 +756,7 @@ end;
 procedure int_boundcheck(l : longint; range : pointer);[public,alias: 'FPC_BOUNDCHECK'];
   type
     prange = ^trange;
-    trange = record
+    trange = packed record
                min,max : longint;
              end;
 begin
@@ -771,7 +771,10 @@ end;
 
 {
   $Log$
-  Revision 1.9  2001-04-21 12:16:28  peter
+  Revision 1.10  2001-05-09 19:57:07  peter
+  *** empty log message ***
+
+  Revision 1.9  2001/04/21 12:16:28  peter
     * int_str cardinal fix (merged)
 
   Revision 1.8  2001/04/13 18:06:28  peter

rtl/inc/genset.inc

@@ -0,0 +1,209 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2001 by the Free Pascal development team
+
+    Include file with set operations called by the compiler
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ TYPE
+   TNormalSet = array[0..31] of byte;
+
+{$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! }
+
+{ procedure do_load_small(p : pointer;l:longint);[public,alias:'FPC_SET_LOAD_SMALL'];}
+ {
+  load a normal set p from a smallset l
+ }
+{ begin
+   for i:=0 to 3 do
+    TNormalSet(p^)[i] := l shr (8*i);
+   RunError(255);
+ 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'];
+ {
+  create a new set in p from an element b
+ }
+ begin
+   Fillchar(p^,32,#0);
+   TNormalSet(p^)[b div 8] := 1 shl (b mod 8);
+ end;
+{$endif FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+ procedure do_set_byte(p : pointer;b : byte);[public,alias:'FPC_SET_SET_BYTE'];
+ {
+  add the element b to the set pointed by p
+ }
+  var
+   c: byte;
+  begin
+    c := TNormalSet(p^)[b div 8];
+    c := (1 shl (b mod 8)) or c;
+    TNormalSet(p^)[b div 8] := c;
+  end;
+{$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'];
+ {
+   suppresses the element b to the set pointed by p
+   used for exclude(set,element)
+ }
+  var
+   c: byte;
+  begin
+    c := TNormalSet(p^)[b div 8];
+    c := c and not (1 shl (b mod 8));
+    TNormalSet(p^)[b div 8] := c;
+  end;
+{$endif FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+ procedure do_set_range(p : pointer;l,h : byte);[public,alias:'FPC_SET_SET_RANGE'];
+ {
+  bad implementation, but it's very seldom used
+ }
+  var
+   i: integer;
+   c: byte;
+  begin
+    for i:=l to h do
+      begin
+        c := TNormalSet(p^)[i div 8];
+        c := (1 shl (i mod 8)) or c;
+        TNormalSet(p^)[i div 8] := c;
+      end;
+  end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
+ function do_in_byte(p : pointer;b : byte):boolean;[public,alias:'FPC_SET_IN_BYTE'];
+ {
+   tests if the element b is in the set p the carryflag is set if it present
+ }
+  var
+    c: byte;
+  begin
+    c := TNormalSet(p^)[b div 8];
+    if ((1 shl (b mod 8)) and c) <> 0 then
+     do_in_byte := TRUE
+    else
+     do_in_byte := FALSE;
+  end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
+ procedure do_add_sets(set1,set2,dest : pointer);[public,alias:'FPC_SET_ADD_SETS'];
+ {
+   adds set1 and set2 into set dest
+ }
+  var
+    i: integer;
+   begin
+     for i:=0 to 31 do
+       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] or TNormalSet(set2^)[i];
+   end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
+ procedure do_mul_sets(set1,set2,dest:pointer);[public,alias:'FPC_SET_MUL_SETS'];
+ {
+   multiplies (takes common elements of) set1 and set2 result put in dest
+ }
+   var
+    i: integer;
+   begin
+     for i:=0 to 31 do
+       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] and TNormalSet(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'];
+ {
+  computes the diff from set1 to set2 result in dest
+ }
+   var
+    i: integer;
+   begin
+     for i:=0 to 31 do
+       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] and not TNormalSet(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'];
+ {
+   computes the symetric diff from set1 to set2 result in dest
+ }
+   var
+    i: integer;
+   begin
+     for i:=0 to 31 do
+       TnormalSet(dest^)[i] := TNormalSet(set1^)[i] xor TNormalSet(set2^)[i];
+   end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
+ function do_comp_sets(set1,set2 : pointer):boolean;[public,alias:'FPC_SET_COMP_SETS'];
+ {
+  compares set1 and set2 zeroflag is set if they are equal
+ }
+   var
+    i: integer;
+   begin
+     do_comp_sets := false;
+     for i:=0 to 31 do
+       if TNormalSet(set1^)[i] <> TNormalSet(set2^)[i] then
+         exit;
+     do_comp_sets := true;
+   end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
+ function do_contains_sets(set1,set2 : pointer):boolean;[public,alias:'FPC_SET_CONTAINS_SETS'];
+ {
+  on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+ }
+ var
+  i : integer;
+ begin
+   do_contains_sets := false;
+   for i:=0 to 31 do
+     if (TNormalSet(set1^)[i] and TNormalSet(set2^)[i]) <> TNormalSet(set1^)[i] then
+       exit;
+   do_contains_sets := true;
+ end;
+{$endif}
+
+{
+  $Log$
+  Revision 1.2  2001-05-09 19:57:07  peter
+  *** empty log message ***
+
+}
+

rtl/inc/system.inc

@@ -104,6 +104,9 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 
 { Include set support which is processor specific}
 {$I set.inc}
+{ Include generic pascal routines for sets if the processor }
+{ specific routines are not available.                      }
+{$I genset.inc}
 
 
 {****************************************************************************
@@ -636,7 +639,10 @@ end;
 
 {
   $Log$
-  Revision 1.12  2001-04-13 18:06:28  peter
+  Revision 1.13  2001-05-09 19:57:07  peter
+  *** empty log message ***
+
+  Revision 1.12  2001/04/13 18:06:28  peter
     * removed rtllite define
 
   Revision 1.11  2000/12/16 15:56:19  jonas

rtl/inc/systemh.inc

@@ -76,7 +76,6 @@ Type
   ValReal = Real;
 
   {$define SUPPORT_SINGLE}
-  {$define SUPPORT_DOUBLE}
 {$endif}
 
 { Zero - terminated strings }
@@ -492,7 +491,10 @@ const
 
 {
   $Log$
-  Revision 1.20  2001-04-23 18:25:45  peter
+  Revision 1.21  2001-05-09 19:57:07  peter
+  *** empty log message ***
+
+  Revision 1.20  2001/04/23 18:25:45  peter
     * m68k updates
 
   Revision 1.19  2001/04/13 18:06:07  peter

rtl/linux/i386/prt0_10.as

@@ -63,7 +63,10 @@ ___fpc_brk_addr:
 
 #
 # $Log$
-# Revision 1.1  2000-10-15 09:09:24  peter
+# Revision 1.2  2001-05-09 19:57:07  peter
+# *** empty log message ***
+#
+# Revision 1.1  2000/10/15 09:09:24  peter
 #   * startup code also needed syslinux->system updates
 #
-#
+#