1 (* Sets.mod provides a dynamic set module.
3 Copyright (C) 2009-2022 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
8 GNU Modula-2 is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Modula-2 is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Modula-2; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. *)
22 IMPLEMENTATION MODULE Sets
;
24 FROM SYSTEM
IMPORT ADDRESS
, BYTE
;
25 FROM SymbolTable
IMPORT FinalSymbol
;
26 FROM M2Error
IMPORT InternalError
;
27 FROM Storage
IMPORT ALLOCATE
, REALLOCATE
, DEALLOCATE
;
28 FROM libc
IMPORT memset
, memcpy
;
29 FROM M2Printf
IMPORT printf0
, printf1
, printf2
;
30 FROM Assertion
IMPORT Assert
;
34 BitsetSize
= SIZE(BITSET) ;
35 MaxBitset
= MAX(BITSET) ;
36 BitsPerByte
= (MaxBitset
+1) DIV BitsetSize
;
40 PtrToByte
= POINTER TO BYTE
;
41 PtrToBitset
= POINTER TO BITSET ;
42 Set
= POINTER TO RECORD
56 PROCEDURE growSet (i
: CARDINAL; bytes
: CARDINAL) ;
58 printf2("i = %d, bytes = %d\n", i
, bytes
)
63 checkRange - checks to make sure, i, is within range and
64 it will extend the set bitmap if required.
67 PROCEDURE checkRange (s
: Set
; i
: CARDINAL) ;
77 InternalError ('set element is too low and out of bounds')
80 InternalError ('set element is too high and out of bounds')
82 j
:= bytes
* BitsPerByte
;
88 printf2("previous bitset size %d bytes, need %d bits\n",
95 WHILE i
>= bytes
*BitsPerByte
DO
106 printf2("new allocated bitset size %d bytes, holds %d bits\n", bytes
, bits
) ;
109 InternalError ('buffer is too small')
112 (* a := memset(b, 0, bytes) ; *)
115 Assert (memset (v
, 0, bytes
-o
) = v
) ;
116 Assert (memcpy (b
, pb
, o
) = b
) ;
119 printf1("deallocating old bitset size %d bytes\n", o
)
133 findPos - returns a pointer to the BITSET which will contain, i.
136 PROCEDURE findPos (pb
: PtrToBitset
; i
: CARDINAL) : PtrToBitset
;
140 IF (((i
DIV (MaxBitset
+1)) * (MaxBitset
+1)) DIV BitsPerByte
) MOD BitsetSize#
0
142 InternalError ('must be a multiple of bitset size')
145 INC(v
, ((i
DIV (MaxBitset
+1)) * (MaxBitset
+1)) DIV BitsPerByte
) ;
146 pb
:= PtrToBitset(v
) ;
152 InitSet - initializes and returns a set. The set will
153 never contain an element less than, low.
156 PROCEDURE InitSet (low
: CARDINAL) : Set
;
174 KillSet - deallocates Set, s.
177 PROCEDURE KillSet (s
: Set
) : Set
;
182 DEALLOCATE(pb
, bytes
)
191 DuplicateSet - returns a new duplicated set.
194 PROCEDURE DuplicateSet (s
: Set
) : Set
;
201 ALLOCATE(pb
, bytes
) ;
202 Assert (memcpy (pb
, s^.pb
, bytes
) = pb
)
209 ForeachElementInSetDo - for each element e in, s, call, p(e).
212 PROCEDURE ForeachElementInSetDo (s
: Set
; p
: PerformOperation
) ;
221 b
:= findPos(pb
, i
) ;
222 j
:= i
MOD (MaxBitset
+1) ;
223 WHILE (i
<=end
) AND (c
>0) DO
232 INC(v
, BitsetSize
) ; (* avoid implications of C address arithmetic in mc PtrToByte *)
233 b
:= PtrToBitset(v
) ;
241 END ForeachElementInSetDo
;
245 IsElementInSet - returns TRUE if element, i, is in set, s.
248 PROCEDURE IsElementInSet (s
: Set
; i
: CARDINAL) : BOOLEAN ;
254 b
:= findPos(pb
, i
) ;
255 RETURN( (i
MOD (MaxBitset
+1)) IN b^
)
261 NoOfElementsInSet - returns the number of elements in a set, s.
264 PROCEDURE NoOfElementsInSet (s
: Set
) : CARDINAL ;
266 RETURN( s^.elements
)
267 END NoOfElementsInSet
;
271 ExcludeElementFromSet - excludes element, i, from set, s.
274 PROCEDURE ExcludeElementFromSet (s
: Set
; i
: CARDINAL) ;
280 b
:= findPos(pb
, i
) ;
281 IF (i
MOD (MaxBitset
+1)) IN b^
284 EXCL(b^
, i
MOD (MaxBitset
+1))
287 END ExcludeElementFromSet
;
291 IncludeElementIntoSet - includes element, i, into set, s.
294 PROCEDURE IncludeElementIntoSet (s
: Set
; i
: CARDINAL) ;
300 b
:= findPos(pb
, i
) ;
301 IF NOT ((i
MOD (MaxBitset
+1)) IN b^
)
304 INCL(b^
, i
MOD (MaxBitset
+1)) ;
305 IF (start
=0) OR (start
>i
)
309 IF (end
=0) OR (end
<i
)
315 END IncludeElementIntoSet
;