1 (* Sets.mod provides a dynamic set module.
3 Copyright (C) 2009-2023 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 ;