From 8bf13fd185210754667da31c04a5b5da0d0836be Mon Sep 17 00:00:00 2001 From: peter Date: Wed, 9 May 2001 19:57:07 +0000 Subject: [PATCH] *** empty log message *** --- rtl/i386/set.inc | 27 +++-- rtl/inc/generic.inc | 7 +- rtl/inc/genset.inc | 209 ++++++++++++++++++++++++++++++++++++++ rtl/inc/system.inc | 8 +- rtl/inc/systemh.inc | 6 +- rtl/linux/i386/prt0_10.as | 7 +- 6 files changed, 251 insertions(+), 13 deletions(-) create mode 100644 rtl/inc/genset.inc diff --git a/rtl/i386/set.inc b/rtl/i386/set.inc index 19ee383f96..c199831884 100644 --- a/rtl/i386/set.inc +++ b/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 - + } diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 102120fc6a..e54ba518a9 100644 --- a/rtl/inc/generic.inc +++ b/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 diff --git a/rtl/inc/genset.inc b/rtl/inc/genset.inc new file mode 100644 index 0000000000..110d8371c5 --- /dev/null +++ b/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 *** + +} + diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 1ab255a111..f22ac955e4 100644 --- a/rtl/inc/system.inc +++ b/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 diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 1dbf62d919..24ac3666d1 100644 --- a/rtl/inc/systemh.inc +++ b/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 diff --git a/rtl/linux/i386/prt0_10.as b/rtl/linux/i386/prt0_10.as index 4fd220bbb2..827f006436 100644 --- a/rtl/linux/i386/prt0_10.as +++ b/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 # -# \ No newline at end of file +#