source: trunk/minix/lib/ack/libm2/Storage.mod@ 9

Last change on this file since 9 was 9, checked in by Mattia Monga, 13 years ago

Minix 3.1.2a
File size: 7.4 KB
Line 
1(*
2 (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
3 See the copyright notice in the ACK home directory, in the file "Copyright".
4*)
5
6(*$R-*)
7IMPLEMENTATION MODULE Storage;
8(*
9 Module: Dynamic Storage Allocation
10 Author: Ceriel J.H. Jacobs
11 Adapted from a version in C by Hans Tebra
12 Version: $Header: /cvsup/minix/src/lib/ack/libm2/Storage.mod,v 1.1 2005/10/10 15:27:46 beng Exp $
13*)
14(* This storage manager maintains an array of lists of objects with the
15 same size. Commonly used sizes have their own bucket. The larger ones
16 are put in a single list.
17*)
18 FROM Unix IMPORT sbrk, ILLBREAK;
19 FROM SYSTEM IMPORT ADDRESS, ADR;
20 FROM Traps IMPORT Message;
21
22 CONST
23 NLISTS = 20;
24 MAGICW = 0A5A5H;
25 MAGICC = 175C;
26
27 TYPE
28 ALIGNTYPE =
29 RECORD
30 CASE : INTEGER OF
31 1: l: LONGINT |
32 2: p: ADDRESS |
33 3: d: LONGREAL
34 END
35 END; (* A type with high alignment requirements *)
36 BucketPtr = POINTER TO Bucket;
37 Bucket =
38 RECORD
39 CASE : BOOLEAN OF
40 FALSE:
41 BNEXT: BucketPtr; (* next free Bucket *)
42 BSIZE: CARDINAL; | (* size of user part in UNITs *)
43 TRUE: BXX: ALIGNTYPE
44 END;
45 BSTORE: ALIGNTYPE;
46 END;
47
48 CONST
49 UNIT = SIZE(ALIGNTYPE);
50
51 VAR
52 FreeLists: ARRAY[0..NLISTS] OF BucketPtr; (* small blocks *)
53 Llist: BucketPtr; (* others *)
54 Compacted: BOOLEAN; (* avoid recursive reorganization *)
55 FirstBlock: BucketPtr;
56 USED: ADDRESS;
57
58 PROCEDURE MyAllocate(size: CARDINAL) : ADDRESS;
59 VAR nu : CARDINAL;
60 b : CARDINAL;
61 p, q: BucketPtr;
62 pc: POINTER TO CHAR;
63 brk : ADDRESS;
64 BEGIN
65 IF size > CARDINAL(MAX(INTEGER)-2*UNIT + 1) THEN
66 RETURN NIL;
67 END;
68 nu := (size + (UNIT-1)) DIV UNIT;
69 IF nu = 0 THEN
70 nu := 1;
71 END;
72 IF nu <= NLISTS THEN
73 b := nu;
74 IF FreeLists[b] # NIL THEN
75 (* Exact fit *)
76 p := FreeLists[b];
77 FreeLists[b] := p^.BNEXT;
78 p^.BNEXT := USED;
79 IF p^.BSIZE * UNIT # size THEN
80 pc := ADR(p^.BSTORE) + size;
81 pc^ := MAGICC;
82 END;
83 p^.BSIZE := size;
84 RETURN ADR(p^.BSTORE);
85 END;
86
87 (* Search for a block with >= 2 units more than requested.
88 We pay for an additional header when the block is split.
89 *)
90 FOR b := b+2 TO NLISTS DO
91 IF FreeLists[b] # NIL THEN
92 q := FreeLists[b];
93 FreeLists[b] := q^.BNEXT;
94 p := ADDRESS(q) + (nu+1)*UNIT;
95 (* p indicates the block that must be given
96 back
97 *)
98 p^.BSIZE := q^.BSIZE - nu - 1;
99 p^.BNEXT := FreeLists[p^.BSIZE];
100 FreeLists[p^.BSIZE] := p;
101 q^.BSIZE := nu;
102 q^.BNEXT := USED;
103 IF q^.BSIZE * UNIT # size THEN
104 pc := ADR(q^.BSTORE) + size;
105 pc^ := MAGICC;
106 END;
107 q^.BSIZE := size;
108 RETURN ADR(q^.BSTORE);
109 END;
110 END;
111 END;
112
113 p := Llist;
114 IF p # NIL THEN
115 q := NIL;
116 WHILE (p # NIL) AND (p^.BSIZE < nu) DO
117 q := p;
118 p := p^.BNEXT;
119 END;
120
121 IF p # NIL THEN
122 (* p^.BSIZE >= nu *)
123 IF p^.BSIZE <= nu + NLISTS + 1 THEN
124 (* Remove p from this list *)
125 IF q # NIL THEN q^.BNEXT := p^.BNEXT
126 ELSE Llist := p^.BNEXT;
127 END;
128 p^.BNEXT := USED;
129 IF p^.BSIZE > nu + 1 THEN
130 (* split block,
131 tail goes to FreeLists area
132 *)
133 q := ADDRESS(p) + (nu+1)*UNIT;
134 q^.BSIZE := p^.BSIZE -nu -1;
135 q^.BNEXT := FreeLists[q^.BSIZE];
136 FreeLists[q^.BSIZE] := q;
137 p^.BSIZE := nu;
138 END;
139 IF p^.BSIZE * UNIT # size THEN
140 pc := ADR(p^.BSTORE) + size;
141 pc^ := MAGICC;
142 END;
143 p^.BSIZE := size;
144 RETURN ADR(p^.BSTORE);
145 END;
146 (* Give part of tail of original block.
147 Block stays in this list.
148 *)
149 q := ADDRESS(p) + (p^.BSIZE-nu)*UNIT;
150 q^.BSIZE := nu;
151 p^.BSIZE := p^.BSIZE - nu - 1;
152 q^.BNEXT := USED;
153 IF q^.BSIZE * UNIT # size THEN
154 pc := ADR(q^.BSTORE) + size;
155 pc^ := MAGICC;
156 END;
157 q^.BSIZE := size;
158 RETURN ADR(q^.BSTORE);
159 END;
160 END;
161
162 IF Compacted THEN
163 (* reorganization did not yield sufficient memory *)
164 RETURN NIL;
165 END;
166
167 brk := sbrk(UNIT * (nu + 1));
168 IF brk = ILLBREAK THEN
169 ReOrganize();
170 Compacted := TRUE;
171 brk := MyAllocate(size);
172 Compacted := FALSE;
173 RETURN brk;
174 END;
175
176 p := brk;
177 p^.BSIZE := nu;
178 p^.BNEXT := USED;
179 IF p^.BSIZE * UNIT # size THEN
180 pc := ADR(p^.BSTORE) + size;
181 pc^ := MAGICC;
182 END;
183 p^.BSIZE := size;
184 RETURN ADR(p^.BSTORE);
185 END MyAllocate;
186
187 PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL);
188 BEGIN
189 Allocate(a, size);
190 END ALLOCATE;
191
192 PROCEDURE Allocate(VAR a: ADDRESS; size: CARDINAL);
193 BEGIN
194 a := MyAllocate(size);
195 IF a = NIL THEN
196 Message("out of core");
197 HALT;
198 END;
199 END Allocate;
200
201 PROCEDURE Available(size: CARDINAL): BOOLEAN;
202 VAR a: ADDRESS;
203 BEGIN
204 a:= MyAllocate(size);
205 IF a # NIL THEN
206 Deallocate(a, size);
207 RETURN TRUE;
208 END;
209 RETURN FALSE;
210 END Available;
211
212 PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL);
213 BEGIN
214 Deallocate(a, size);
215 END DEALLOCATE;
216
217 PROCEDURE Deallocate(VAR a: ADDRESS; size: CARDINAL);
218 VAR p: BucketPtr;
219 pc: POINTER TO CHAR;
220 BEGIN
221 IF (a = NIL) THEN
222 Message("(Warning) Deallocate: NIL pointer deallocated");
223 RETURN;
224 END;
225 p := a - UNIT;
226 IF (p^.BNEXT # BucketPtr(USED)) THEN
227 Message("(Warning) Deallocate: area already deallocated or heap corrupted");
228 a := NIL;
229 RETURN;
230 END;
231 WITH p^ DO
232 IF BSIZE # size THEN
233 Message("(Warning) Deallocate: wrong size or heap corrupted");
234 END;
235 BSIZE := (size + (UNIT - 1)) DIV UNIT;
236 IF (BSIZE*UNIT # size) THEN
237 pc := a + size;
238 IF pc^ # MAGICC THEN
239 Message("(Warning) Deallocate: heap corrupted");
240 END;
241 END;
242 IF BSIZE <= NLISTS THEN
243 BNEXT := FreeLists[BSIZE];
244 FreeLists[BSIZE] := p;
245 ELSE
246 BNEXT := Llist;
247 Llist := p;
248 END;
249 END;
250 a := NIL
251 END Deallocate;
252
253 PROCEDURE ReOrganize();
254 VAR lastblock: BucketPtr;
255 b, be: BucketPtr;
256 i: CARDINAL;
257 BEGIN
258 lastblock := NIL;
259 FOR i := 1 TO NLISTS DO
260 b := FreeLists[i];
261 WHILE b # NIL DO
262 IF ADDRESS(b) > ADDRESS(lastblock) THEN
263 lastblock := b;
264 END;
265 be := b^.BNEXT;
266 b^.BNEXT := NIL; (* temporary free mark *)
267 b := be;
268 END;
269 END;
270
271 b := Llist;
272 WHILE b # NIL DO
273 IF ADDRESS(b) > ADDRESS(lastblock) THEN
274 lastblock := b;
275 END;
276 be := b^.BNEXT;
277 b^.BNEXT := NIL;
278 b := be;
279 END;
280
281 (* Now, all free blocks have b^.BNEXT = NIL *)
282
283 b := FirstBlock;
284 WHILE ADDRESS(b) < ADDRESS(lastblock) DO
285 LOOP
286 be := ADDRESS(b)+(b^.BSIZE+1)*UNIT;
287 IF b^.BNEXT # NIL THEN
288 (* this block is not free *)
289 EXIT;
290 END;
291 IF ADDRESS(be) > ADDRESS(lastblock) THEN
292 (* no next block *)
293 EXIT;
294 END;
295 IF be^.BNEXT # NIL THEN
296 (* next block is not free *)
297 EXIT;
298 END;
299 (* this block and the next one are free,
300 so merge them, but only if it is not too big
301 *)
302 IF MAX(CARDINAL) - b^.BSIZE > be^.BSIZE THEN
303 b^.BSIZE := b^.BSIZE + be^.BSIZE + 1;
304 ELSE
305 EXIT;
306 END;
307 END;
308 b := be;
309 END;
310
311 (* clear all free lists *)
312 FOR i := 1 TO NLISTS DO FreeLists[i] := NIL; END;
313 Llist := NIL;
314
315 (* collect free blocks in them again *)
316 b := FirstBlock;
317 WHILE ADDRESS(b) <= ADDRESS(lastblock) DO
318 WITH b^ DO
319 IF BNEXT = NIL THEN
320 IF BSIZE <= NLISTS THEN
321 BNEXT := FreeLists[BSIZE];
322 FreeLists[BSIZE] := b;
323 ELSE
324 BNEXT := Llist;
325 Llist := b;
326 END;
327 b := ADDRESS(b) + (BSIZE+1) * UNIT;
328 ELSE
329 b := ADDRESS(b) +
330 ((BSIZE + (UNIT - 1)) DIV UNIT + 1) * UNIT;
331 END;
332 END;
333 END;
334 END ReOrganize;
335
336 PROCEDURE InitStorage();
337 VAR i: CARDINAL;
338 brk: ADDRESS;
339 BEGIN
340 FOR i := 1 TO NLISTS DO
341 FreeLists[i] := NIL;
342 END;
343 Llist := NIL;
344 brk := sbrk(0);
345 brk := sbrk(UNIT - brk MOD UNIT);
346 FirstBlock := sbrk(0);
347 Compacted := FALSE;
348 USED := MAGICW;
349 END InitStorage;
350
351BEGIN
352 InitStorage();
353END Storage.
Note: See TracBrowser for help on using the repository browser.