]>
Commit | Line | Data |
---|---|---|
1eee94d3 | 1 | (* Indexing provides a dynamic array of pointers. |
83ffe9cd | 2 | Copyright (C) 2015-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
3 | |
4 | This file is part of GNU Modula-2. | |
5 | ||
6 | GNU Modula-2 is free software; you can redistribute it and/or modify it under | |
7 | the terms of the GNU General Public License as published by the Free | |
8 | Software Foundation; either version 3, or (at your option) any later | |
9 | version. | |
10 | ||
11 | GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY | |
12 | WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
13 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
14 | for more details. | |
15 | ||
16 | You should have received a copy of the GNU General Public License along | |
17 | with gm2; see the file COPYING. If not, write to the Free Software | |
18 | Foundation, 51 Franklin Street, Fifth Floor, | |
19 | Boston, MA 02110-1301, USA. *) | |
20 | ||
21 | IMPLEMENTATION MODULE Indexing ; | |
22 | ||
23 | FROM libc IMPORT memset, memmove ; | |
24 | FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ; | |
25 | FROM SYSTEM IMPORT TSIZE, ADDRESS, WORD, BYTE ; | |
26 | FROM mcDebug IMPORT assert ; | |
27 | ||
28 | CONST | |
29 | MinSize = 128 ; | |
30 | ||
31 | TYPE | |
32 | PtrToAddress = POINTER TO ADDRESS ; | |
33 | PtrToByte = POINTER TO BYTE ; | |
34 | ||
35 | Index = POINTER TO RECORD | |
36 | ArrayStart: ADDRESS ; | |
37 | ArraySize : CARDINAL ; | |
38 | Used, | |
39 | Low, | |
40 | High : CARDINAL ; | |
41 | Debug : BOOLEAN ; | |
42 | Map : BITSET ; | |
43 | END ; | |
44 | ||
45 | (* | |
46 | InitIndex - creates and returns an Index. | |
47 | *) | |
48 | ||
49 | PROCEDURE InitIndex (low: CARDINAL) : Index ; | |
50 | VAR | |
51 | i: Index ; | |
52 | BEGIN | |
53 | NEW(i) ; | |
54 | WITH i^ DO | |
55 | Low := low ; | |
56 | High := 0 ; | |
57 | ArraySize := MinSize ; | |
58 | ALLOCATE(ArrayStart, MinSize) ; | |
59 | ArrayStart := memset(ArrayStart, 0, ArraySize) ; | |
60 | Debug := FALSE ; | |
61 | Used := 0 ; | |
62 | Map := BITSET{} | |
63 | END ; | |
64 | RETURN( i ) | |
65 | END InitIndex ; | |
66 | ||
67 | ||
68 | (* | |
69 | KillIndex - returns Index to free storage. | |
70 | *) | |
71 | ||
72 | PROCEDURE KillIndex (i: Index) : Index ; | |
73 | BEGIN | |
74 | WITH i^ DO | |
75 | DEALLOCATE(ArrayStart, ArraySize) | |
76 | END ; | |
77 | DISPOSE(i) ; | |
78 | RETURN( NIL ) | |
79 | END KillIndex ; | |
80 | ||
81 | ||
82 | (* | |
83 | DebugIndex - turns on debugging within an index. | |
84 | *) | |
85 | ||
86 | PROCEDURE DebugIndex (i: Index) : Index ; | |
87 | BEGIN | |
88 | i^.Debug := TRUE ; | |
89 | RETURN( i ) | |
90 | END DebugIndex ; | |
91 | ||
92 | ||
93 | (* | |
94 | InBounds - returns TRUE if indice, n, is within the bounds | |
95 | of the dynamic array. | |
96 | *) | |
97 | ||
98 | PROCEDURE InBounds (i: Index; n: CARDINAL) : BOOLEAN ; | |
99 | BEGIN | |
100 | IF i=NIL | |
101 | THEN | |
102 | HALT | |
103 | ELSE | |
104 | WITH i^ DO | |
105 | RETURN( (n>=Low) AND (n<=High) ) | |
106 | END | |
107 | END | |
108 | END InBounds ; | |
109 | ||
110 | ||
111 | (* | |
112 | HighIndice - returns the last legally accessible indice of this array. | |
113 | *) | |
114 | ||
115 | PROCEDURE HighIndice (i: Index) : CARDINAL ; | |
116 | BEGIN | |
117 | IF i=NIL | |
118 | THEN | |
119 | HALT | |
120 | ELSE | |
121 | RETURN( i^.High ) | |
122 | END | |
123 | END HighIndice ; | |
124 | ||
125 | ||
126 | (* | |
127 | LowIndice - returns the first legally accessible indice of this array. | |
128 | *) | |
129 | ||
130 | PROCEDURE LowIndice (i: Index) : CARDINAL ; | |
131 | BEGIN | |
132 | IF i=NIL | |
133 | THEN | |
134 | HALT | |
135 | ELSE | |
136 | RETURN( i^.Low ) | |
137 | END | |
138 | END LowIndice ; | |
139 | ||
140 | ||
141 | (* | |
142 | PutIndice - places, a, into the dynamic array at position i[n] | |
143 | *) | |
144 | ||
145 | PROCEDURE PutIndice (i: Index; n: CARDINAL; a: ADDRESS) ; | |
146 | VAR | |
147 | oldSize: CARDINAL ; | |
148 | b : ADDRESS ; | |
149 | p : POINTER TO POINTER TO WORD ; | |
150 | BEGIN | |
151 | WITH i^ DO | |
152 | IF NOT InBounds(i, n) | |
153 | THEN | |
154 | IF n<Low | |
155 | THEN | |
156 | HALT | |
157 | ELSE | |
158 | oldSize := ArraySize ; | |
159 | WHILE (n-Low)*TSIZE(ADDRESS)>=ArraySize DO | |
160 | ArraySize := ArraySize * 2 | |
161 | END ; | |
162 | IF oldSize#ArraySize | |
163 | THEN | |
164 | (* | |
165 | IF Debug | |
166 | THEN | |
167 | printf2('increasing memory hunk from %d to %d\n', | |
168 | oldSize, ArraySize) | |
169 | END ; | |
170 | *) | |
171 | REALLOCATE(ArrayStart, ArraySize) ; | |
172 | (* and initialize the remainder of the array to NIL *) | |
173 | b := ArrayStart ; | |
174 | INC(b, oldSize) ; | |
175 | b := memset(b, 0, ArraySize-oldSize) | |
176 | END ; | |
177 | High := n | |
178 | END | |
179 | END ; | |
180 | b := ArrayStart ; | |
181 | INC(b, (n-Low)*TSIZE(ADDRESS)) ; | |
182 | p := b; | |
183 | p^ := a ; | |
184 | INC(Used) ; | |
185 | IF Debug | |
186 | THEN | |
187 | IF n<32 | |
188 | THEN | |
189 | INCL(Map, n) | |
190 | END | |
191 | END | |
192 | END | |
193 | END PutIndice ; | |
194 | ||
195 | ||
196 | (* | |
197 | GetIndice - retrieves, element i[n] from the dynamic array. | |
198 | *) | |
199 | ||
200 | PROCEDURE GetIndice (i: Index; n: CARDINAL) : ADDRESS ; | |
201 | VAR | |
202 | b: PtrToByte ; | |
203 | p: PtrToAddress ; | |
204 | BEGIN | |
205 | WITH i^ DO | |
206 | IF NOT InBounds(i, n) | |
207 | THEN | |
208 | HALT | |
209 | END ; | |
210 | b := ArrayStart ; | |
211 | INC(b, (n-Low)*TSIZE(ADDRESS)) ; | |
212 | p := VAL(PtrToAddress, b) ; | |
213 | IF Debug | |
214 | THEN | |
215 | IF (n<32) AND (NOT (n IN Map)) AND (p^#NIL) | |
216 | THEN | |
217 | HALT | |
218 | END | |
219 | END ; | |
220 | RETURN( p^ ) | |
221 | END | |
222 | END GetIndice ; | |
223 | ||
224 | ||
225 | (* | |
226 | IsIndiceInIndex - returns TRUE if, a, is in the index, i. | |
227 | *) | |
228 | ||
229 | PROCEDURE IsIndiceInIndex (i: Index; a: ADDRESS) : BOOLEAN ; | |
230 | VAR | |
231 | j: CARDINAL ; | |
232 | b: PtrToByte ; | |
233 | p: PtrToAddress ; | |
234 | BEGIN | |
235 | WITH i^ DO | |
236 | j := Low ; | |
237 | b := ArrayStart ; | |
238 | WHILE j<=High DO | |
239 | p := VAL(PtrToAddress, b) ; | |
240 | IF p^=a | |
241 | THEN | |
242 | RETURN( TRUE ) | |
243 | END ; | |
244 | (* we must not INC(p, ..) as p2c gets confused *) | |
245 | INC(b, TSIZE(ADDRESS)) ; | |
246 | INC(j) | |
247 | END | |
248 | END ; | |
249 | RETURN( FALSE ) | |
250 | END IsIndiceInIndex ; | |
251 | ||
252 | ||
253 | (* | |
254 | RemoveIndiceFromIndex - removes, a, from Index, i. | |
255 | *) | |
256 | ||
257 | PROCEDURE RemoveIndiceFromIndex (i: Index; a: ADDRESS) ; | |
258 | VAR | |
259 | j, k: CARDINAL ; | |
260 | p : PtrToAddress ; | |
261 | b : PtrToByte ; | |
262 | BEGIN | |
263 | WITH i^ DO | |
264 | j := Low ; | |
265 | b := ArrayStart ; | |
266 | WHILE j<=High DO | |
267 | p := VAL(PtrToAddress, b) ; | |
268 | INC(b, TSIZE(ADDRESS)) ; | |
269 | IF p^=a | |
270 | THEN | |
271 | DeleteIndice(i, j) | |
272 | END ; | |
273 | INC(j) | |
274 | END | |
275 | END | |
276 | END RemoveIndiceFromIndex ; | |
277 | ||
278 | ||
279 | (* | |
280 | DeleteIndice - delete i[j] from the array. | |
281 | *) | |
282 | ||
283 | PROCEDURE DeleteIndice (i: Index; j: CARDINAL) ; | |
284 | VAR | |
285 | p: PtrToAddress ; | |
286 | b: PtrToByte ; | |
287 | BEGIN | |
288 | WITH i^ DO | |
289 | IF InBounds(i, j) | |
290 | THEN | |
291 | b := ArrayStart ; | |
292 | INC(b, TSIZE(ADDRESS)*(j-Low)) ; | |
293 | p := VAL(PtrToAddress, b) ; | |
294 | INC(b, TSIZE(ADDRESS)) ; | |
295 | p := memmove(p, b, (High-j)*TSIZE(ADDRESS)) ; | |
296 | DEC(High) ; | |
297 | DEC(Used) | |
298 | ELSE | |
299 | HALT | |
300 | END | |
301 | END | |
302 | END DeleteIndice ; | |
303 | ||
304 | ||
305 | (* | |
306 | IncludeIndiceIntoIndex - if the indice is not in the index, then | |
307 | add it at the end. | |
308 | *) | |
309 | ||
310 | PROCEDURE IncludeIndiceIntoIndex (i: Index; a: ADDRESS) ; | |
311 | BEGIN | |
312 | IF NOT IsIndiceInIndex(i, a) | |
313 | THEN | |
314 | IF i^.Used=0 | |
315 | THEN | |
316 | PutIndice(i, LowIndice(i), a) | |
317 | ELSE | |
318 | PutIndice(i, HighIndice(i)+1, a) | |
319 | END | |
320 | END | |
321 | END IncludeIndiceIntoIndex ; | |
322 | ||
323 | ||
324 | (* | |
325 | ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j]) | |
326 | *) | |
327 | ||
328 | PROCEDURE ForeachIndiceInIndexDo (i: Index; p: IndexProcedure) ; | |
329 | VAR | |
330 | j: CARDINAL ; | |
331 | q: IndexProcedure ; | |
332 | BEGIN | |
333 | j := LowIndice (i) ; | |
334 | q := p ; | |
335 | WHILE j <= HighIndice (i) DO | |
336 | assert (q = p) ; | |
337 | p (GetIndice (i, j)) ; | |
338 | INC (j) | |
339 | END | |
340 | END ForeachIndiceInIndexDo ; | |
341 | ||
342 | ||
343 | END Indexing. |