]> pd.if.org Git - pdclib/blob - functions/stdlib/malloc.c
Comment cleanups.
[pdclib] / functions / stdlib / malloc.c
1 /* void * malloc( size_t )
2
3    This file is part of the Public Domain C Library (PDCLib).
4    Permission is granted to use, modify, and / or redistribute at will.
5 */
6
7 #include <stdlib.h>
8 #include <stdint.h>
9 #include <stdbool.h>
10
11 #ifndef REGTEST
12
13 #include <_PDCLIB_glue.h>
14
15 /* TODO: Primitive placeholder. Much room for improvement. */
16
17 /* Keeping pointers to the first and the last element of the free list. */
18 struct _PDCLIB_headnode_t _PDCLIB_memlist = { NULL, NULL };
19
20 void * malloc( size_t size )
21 {
22     if ( size == 0 )
23     {
24         return NULL;
25     }
26     if ( size < _PDCLIB_MINALLOC )
27     {
28         size = _PDCLIB_MINALLOC;
29     }
30     {
31     struct _PDCLIB_memnode_t * current = _PDCLIB_memlist.first;
32     struct _PDCLIB_memnode_t * previous = NULL;
33     struct _PDCLIB_memnode_t * firstfit = NULL;
34     struct _PDCLIB_memnode_t * firstfit_previous = NULL;
35     /* Trying exact fit */
36     while ( current != NULL )
37     {
38         if ( current->size == size )
39         {
40             /* Found exact fit, allocate node */
41             if ( previous != NULL )
42             {
43                 /* Node in the middle of the list */
44                 previous->next = current->next;
45             }
46             else
47             {
48                 /* Node is first in list */
49                 _PDCLIB_memlist.first = current->next;
50             }
51             if ( _PDCLIB_memlist.last == current )
52             {
53                 /* Node is last in list */
54                 _PDCLIB_memlist.last = previous;
55             }
56             return (char *)current + sizeof( struct _PDCLIB_memnode_t );
57         }
58         else if ( current->size > size && ( firstfit == NULL || current->size < firstfit->size ) )
59         {
60             /* Remember previous node in case we do not get an exact fit.
61                Note that this is the node *pointing to* the first fit,
62                as we need that for allocating (i.e., changing next pointer).
63             */
64             firstfit_previous = previous;
65             firstfit = current;
66         }
67         /* Skip to next node */
68         previous = current;
69         current = current->next;
70     }
71     /* No exact fit; go for first fit */
72     if ( firstfit != NULL )
73     {
74         bool node_split = false;
75         if ( ( firstfit->size - size ) > ( _PDCLIB_MINALLOC + sizeof( struct _PDCLIB_memnode_t ) ) )
76         {
77             /* Oversized - split into two nodes */
78             struct _PDCLIB_memnode_t * newnode = (struct _PDCLIB_memnode_t *)( (char *)firstfit + sizeof( struct _PDCLIB_memnode_t ) + size );
79             newnode->size = firstfit->size - size - sizeof( struct _PDCLIB_memnode_t );
80             newnode->next = firstfit->next;
81             firstfit->next = newnode;
82             firstfit->size = firstfit->size - newnode->size - sizeof( struct _PDCLIB_memnode_t );
83             node_split = true;
84         }
85         if ( firstfit_previous != NULL )
86         {
87             /* Node in the middle of the list */
88             firstfit_previous->next = firstfit->next;
89         }
90         else
91         {
92             /* Node is first in list */
93             _PDCLIB_memlist.first = firstfit->next;
94         }
95         if ( _PDCLIB_memlist.last == firstfit )
96         {
97             /* Node is last in list */
98             if ( node_split )
99             {
100                 _PDCLIB_memlist.last = firstfit->next;
101             }
102             else
103             {
104                 _PDCLIB_memlist.last = firstfit_previous;
105             }
106         }
107         return (char *)firstfit + sizeof( struct _PDCLIB_memnode_t );
108     }
109     }
110     {
111     /* No fit possible; how many additional pages do we need? */
112     size_t pages = ( ( size + sizeof( struct _PDCLIB_memnode_t ) - 1 ) / _PDCLIB_PAGESIZE ) + 1;
113     /* Allocate more pages */
114     struct _PDCLIB_memnode_t * newnode = (struct _PDCLIB_memnode_t *)_PDCLIB_allocpages( (int)pages );
115     if ( newnode != NULL )
116     {
117         newnode->next = NULL;
118         newnode->size = pages * _PDCLIB_PAGESIZE - sizeof( struct _PDCLIB_memnode_t );
119         if ( ( newnode->size - size ) > ( _PDCLIB_MINALLOC + sizeof( struct _PDCLIB_memnode_t ) ) )
120         {
121             /* Oversized - split into two nodes */
122             struct _PDCLIB_memnode_t * splitnode = (struct _PDCLIB_memnode_t *)( (char *)newnode + sizeof( struct _PDCLIB_memnode_t ) + size );
123             splitnode->size = newnode->size - size - sizeof( struct _PDCLIB_memnode_t );
124             newnode->size = size;
125             /* Add splitted node as last element to free node list */
126             if ( _PDCLIB_memlist.last == NULL )
127             {
128                 _PDCLIB_memlist.first = splitnode;
129             }
130             else
131             {
132                 _PDCLIB_memlist.last->next = splitnode;
133             }
134             splitnode->next = NULL; /* TODO: This is bug #7, uncovered by testdriver yet. */
135             _PDCLIB_memlist.last = splitnode;
136         }
137         return (char *)newnode + sizeof( struct _PDCLIB_memnode_t );
138     }
139     }
140     /* No fit, heap extension not possible - out of memory */
141     return NULL;
142 }
143
144 #endif
145
146
147 #ifdef TEST
148 #include <_PDCLIB_test.h>
149 #include <string.h>
150 #include <stdarg.h>
151 #include <stdio.h>
152
153
154 #ifndef REGTEST
155
156 /* Effective page size, i.e. how many bytes can be allocated and still be on
157    one page of memory.
158 */
159 #define EFFECTIVE _PDCLIB_PAGESIZE - sizeof( struct _PDCLIB_memnode_t )
160 #define MEMTEST( ptr, size ) ( ( ptr = malloc( size ) ) != NULL ) && ( memset( ptr, 0, size ) == ptr )
161
162 char * pages_start = 0;
163 int test_nodes( char const * const, int, ... );
164 void PRINT( char const * const, ... );
165
166 /* This can be enabled to give a dump of node information */
167 #if 0
168 void PRINT( char const * const format, ... )
169 {
170     va_list( ap );
171     va_start( ap, format );
172     vprintf( format, ap );
173 }
174 #else
175 void PRINT( char const * const format, ... )
176 {
177     /* EMPTY */
178 }
179 #endif
180
181 /* Helper function checking number of allocated memory pages and the nodes
182    in the free memory list against expectations.
183 */
184 int test_nodes( char const * const action, int expected_pages, ... )
185 {
186     static int count = 1;
187     int result = 1;
188     PRINT( action );
189     /* Determining the amount of allocated pages */
190     int allocated_pages = ( (intptr_t)_PDCLIB_allocpages( 0 ) - (intptr_t)pages_start ) / _PDCLIB_PAGESIZE;
191     PRINT( "Test #%2d, %d allocated pages", count++, allocated_pages );
192     if ( allocated_pages != expected_pages )
193     {
194         PRINT( " - MISMATCH, expected\n          %d pages\n", expected_pages );
195         result = 0;
196     }
197     else
198     {
199         PRINT( "\n" );
200     }
201     /* Now moving through the free nodes list */
202     va_list( ap );
203     va_start( ap, expected_pages );
204     struct _PDCLIB_memnode_t * tracer = _PDCLIB_memlist.first;
205     int firstnode = 0;
206     int lastnode = 0;
207     while ( tracer != NULL )
208     {
209         /* Data from node */
210         size_t node_location = (char *)tracer - (char *)pages_start;
211         PRINT( "   - node %.4p, size %#.4x", node_location, tracer->size );
212         /* Expected data */
213         size_t expected_location = va_arg( ap, size_t );
214         if ( expected_location == 0 )
215         {
216             PRINT( " - UNEXPECTED NODE\n" );
217             result = 0;
218             continue;
219         }
220         /* Memorizing first and last expected node for later comparison. */
221         if ( firstnode == 0 )
222         {
223             firstnode = expected_location;
224         }
225         lastnode = expected_location;
226         /* Comparing expected node against current node */
227         size_t expected_size = va_arg( ap, size_t );
228         if ( ( node_location != expected_location ) || ( tracer->size != expected_size ) )
229         {
230             PRINT( " - MISMATCH, expected values\n          %.4p       %#.4p\n", expected_location, expected_size );
231             result = 0;
232         }
233         else
234         {
235             PRINT( "\n" );
236         }
237         tracer = tracer->next;
238     }
239     /* Comparing first and last node in memlist against expectations. */
240     PRINT( "   - memlist first: %#.4x - last: %#.4x",
241             ( _PDCLIB_memlist.first == NULL ) ? NULL : (char *)_PDCLIB_memlist.first - (char *)pages_start,
242             ( _PDCLIB_memlist.last == NULL ) ? NULL : (char *)_PDCLIB_memlist.last - (char *)pages_start );
243     if ( ( firstnode != 0 ) && 
244          ( ( ( (char *)_PDCLIB_memlist.first - (char *)pages_start ) != firstnode )
245          || ( ( (char *)_PDCLIB_memlist.last  - (char *)pages_start ) != lastnode ) ) )
246     {
247         PRINT( " - MISMATCH, expected values\n                    %#.4x - last: %#.4x\n", firstnode, lastnode );
248         result = 0;
249     }
250     else
251     {
252         PRINT( "\n" );
253     }
254     PRINT( "\n" );
255     return result;
256 }
257
258 #endif 
259
260 /* Note that this test driver heavily tests *internals* of the implementation
261    above (and of free() and realloc(), too). That means that changes in the
262    implementation must be accompanied with appropriate changes of the test
263    driver. It does *not* make a good regression tester for the implementation,
264    I am afraid, and thus there is no REGTEST equivalent.
265 */
266
267 int main( void )
268 {
269 #ifndef REGTEST
270     void * ptr1, * ptr2, * ptr3, * ptr4, * ptr5, * ptr6, * ptr7, * ptr8, * ptr9, * ptrA, * ptrB, * ptrC;
271
272     pages_start = _PDCLIB_allocpages( 0 );
273     PRINT( "\nEffective is: %#.4x\nsizeof( memnode ) is: %#.2x\n\n", EFFECTIVE, sizeof( struct _PDCLIB_memnode_t ) ); 
274
275     /* Allocating 10 bytes; expecting one page allocation and a node split */
276     TESTCASE( MEMTEST( ptr1, 10 ) );
277     TESTCASE( test_nodes( "Allocating 10 bytes.", 1,
278                sizeof( struct _PDCLIB_memnode_t ) + 10, EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - 10,
279                0 ) );
280
281     /* Allocating the rest of the page; expecting no page allocation and assignment of the remaining node */
282     TESTCASE( MEMTEST( ptr2, EFFECTIVE - 10 - sizeof( struct _PDCLIB_memnode_t ) ) );
283     TESTCASE( test_nodes( "Allocating the rest of the page.", 1,
284                0 ) );
285
286     /* Allocating a full page; expecting one page allocation, no node split */
287     TESTCASE( MEMTEST( ptr3, EFFECTIVE ) );
288     TESTCASE( test_nodes( "Allocating a full page.", 2,
289                0 ) );
290
291     /* Allocating *almost* a full page; expecting one page allocation, no node split */
292     TESTCASE( MEMTEST( ptr4, EFFECTIVE - 4 ) );
293     TESTCASE( test_nodes( "Allocating *almost* a full page.", 3,
294                0 ) );
295
296     /* Freeing and re-allocating the "almost" full page; expecting no page allocation, no node split */
297     free( ptr4 );
298     TESTCASE( MEMTEST( ptr5, EFFECTIVE - 4 ) );
299     TESTCASE( ptr4 == ptr5 );
300     TESTCASE( test_nodes( "Freeing and re-allocating the \"almost\" full page.", 3 ) );
301
302     /* Freeing the full page from test #3; expecting a full-sized free node. */
303     free( ptr3 );
304     TESTCASE( test_nodes( "Freeing the full page from test #3.", 3,
305                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
306                0 ) );
307
308     /* Allocating two full pages; expecting two page allocations, no node split */
309     TESTCASE( MEMTEST( ptr3, EFFECTIVE + _PDCLIB_PAGESIZE ) );
310     TESTCASE( test_nodes( "Allocating two full pages.", 5,
311                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
312                0 ) );
313
314     /* Re-allocating to size of 10 bytes; expecting no page allocation, no node split */
315     /* TODO: Shouldn't realloc() split the now much-too-large node? */
316     TESTCASE( realloc( ptr3, 10 ) == ptr3 );
317     TESTCASE( test_nodes( "Re-allocating to size of 10 bytes.", 5,
318                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
319                0 ) );
320
321     /* Re-allocating to size of two full pages; expecting no page allocation, no node split */
322     TESTCASE( realloc( ptr3, EFFECTIVE + _PDCLIB_PAGESIZE ) == ptr3 );
323     TESTCASE( test_nodes( "Re-allocating to size of two full pages.", 5,
324                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
325                0 ) );
326
327     /* Re-allocating to size of three full pages; expecting three page allocation, freeing of two-page node */
328     TESTCASE( realloc( ptr3, EFFECTIVE + _PDCLIB_PAGESIZE * 2 ) != ptr3 );
329     TESTCASE( test_nodes( "Re-allocating to size of three full pages.", 8,
330                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
331                _PDCLIB_PAGESIZE * 3, EFFECTIVE + _PDCLIB_PAGESIZE,
332                0 ) );
333
334     /* Allocating two full pages; expecting allocation of the available two-page node */
335     TESTCASE( MEMTEST( ptr4, EFFECTIVE + _PDCLIB_PAGESIZE ) );
336     TESTCASE( test_nodes( "Allocating two full pages.", 8,
337                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
338                0 ) );
339
340     /* Allocating zero bytes; expecting no change */
341     TESTCASE( ! MEMTEST( ptr6, 0 ) );
342     TESTCASE( test_nodes( "Allocating zero bytes.", 8,
343                _PDCLIB_PAGESIZE * 1, EFFECTIVE,
344                0 ) );
345
346     /* Allocating 4 bytes; expecting upsizing of requestupsizing of size, node split */
347     TESTCASE( MEMTEST( ptr7, 4 ) );
348     TESTCASE( test_nodes( "Allocating 4 bytes.", 8,
349                _PDCLIB_PAGESIZE * 1 + _PDCLIB_MINALLOC + sizeof( struct _PDCLIB_memnode_t ),
350                EFFECTIVE - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ),
351                0 ) );
352
353     /* Allocating the rest of the page; expecting no page allocation and assignment of the remaining node */
354     TESTCASE( MEMTEST( ptr8, EFFECTIVE - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ) ) );
355     TESTCASE( test_nodes( "Allocating the rest of the page.", 8, 0 ) );
356
357     /* Freeing the node from the previous test; expecting node to re-appear in free list */
358     free( ptr8 );
359     TESTCASE( test_nodes( "Freeing the node from the previous test.", 8,
360                _PDCLIB_PAGESIZE * 1 + _PDCLIB_MINALLOC + sizeof( struct _PDCLIB_memnode_t ),
361                EFFECTIVE - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ),
362                0 ) );
363
364     /* Allocating one byte more than available in free node; expecting page allocation */
365     TESTCASE( MEMTEST( ptr8, EFFECTIVE + 1 - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ) ) );
366     TESTCASE( test_nodes( "Allocating one byte more than available in free node.", 9,
367                _PDCLIB_PAGESIZE * 1 + _PDCLIB_MINALLOC + sizeof( struct _PDCLIB_memnode_t ),
368                EFFECTIVE - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ),
369                0 ) );
370
371     /* Re-allocating with NULL pointer; expecting no page allocation, no node split */
372     ptr9 = realloc( NULL, EFFECTIVE - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ) );
373     TESTCASE( ptr9 != NULL );
374     TESTCASE( memset( ptr9, 0, EFFECTIVE - _PDCLIB_MINALLOC - sizeof( struct _PDCLIB_memnode_t ) ) == ptr9 );
375     TESTCASE( test_nodes( "Re-allocating with NULL pointer.", 9, 0 ) );
376
377     /* Allocating a bit more than half a page; expecting page allocation, node split */
378 #define TESTSIZE 3000
379     TESTCASE( MEMTEST( ptrA, TESTSIZE ) );
380     TESTCASE( test_nodes( "Allocating a bit more than half a page.", 10,
381                _PDCLIB_PAGESIZE * 9 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
382                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
383                0 ) );
384
385     /* Allocating a bit more than half a page; expecting page allocation, node split */
386     TESTCASE( MEMTEST( ptrB, TESTSIZE ) );
387     TESTCASE( test_nodes( "Allocating a bit more than half a page.", 11,
388                _PDCLIB_PAGESIZE * 9 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
389                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
390                _PDCLIB_PAGESIZE * 10 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
391                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
392                0 ) );
393
394     /* Allocating a bit more than half a page; expecting page allocation, node split */
395     TESTCASE( MEMTEST( ptrC, TESTSIZE ) );
396     TESTCASE( test_nodes( "Allocating a bit more than half a page.", 12,
397                _PDCLIB_PAGESIZE * 9 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
398                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
399                _PDCLIB_PAGESIZE * 10 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
400                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
401                _PDCLIB_PAGESIZE * 11 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
402                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
403                0 ) );
404
405     /* Freeing the middle node */
406     free( ptrB );
407     TESTCASE( test_nodes( "Freeing the middle node.", 12,
408                _PDCLIB_PAGESIZE * 9 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
409                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
410                _PDCLIB_PAGESIZE * 10 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
411                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
412                _PDCLIB_PAGESIZE * 11 + sizeof( struct _PDCLIB_memnode_t ) + TESTSIZE,
413                EFFECTIVE - sizeof( struct _PDCLIB_memnode_t ) - TESTSIZE,
414                _PDCLIB_PAGESIZE * 10,
415                TESTSIZE,
416                0 ) );
417
418 #else
419     puts( " NOTEST malloc() test driver is PDCLib-specific." );
420 #endif
421     return TEST_RESULTS;
422 }
423
424 #endif