perl 5.0 alpha 9
[p5sagit/p5-mst-13.2.git] / malloc.c
1 /* $RCSfile: malloc.c,v $$Revision: 4.1 $$Date: 92/08/07 18:24:25 $
2  *
3  * $Log:        malloc.c,v $
4  * Revision 4.1  92/08/07  18:24:25  lwall
5  * 
6  * Revision 4.0.1.4  92/06/08  14:28:38  lwall
7  * patch20: removed implicit int declarations on functions
8  * patch20: hash tables now split only if the memory is available to do so
9  * patch20: realloc(0, size) now does malloc in case library routines call it
10  * 
11  * Revision 4.0.1.3  91/11/05  17:57:40  lwall
12  * patch11: safe malloc code now integrated into Perl's malloc when possible
13  * 
14  * Revision 4.0.1.2  91/06/07  11:20:45  lwall
15  * patch4: many, many itty-bitty portability fixes
16  * 
17  * Revision 4.0.1.1  91/04/11  17:48:31  lwall
18  * patch1: Configure now figures out malloc ptr type
19  * 
20  * Revision 4.0  91/03/20  01:28:52  lwall
21  * 4.0 baseline.
22  * 
23  */
24
25 #ifndef lint
26 /*SUPPRESS 592*/
27 static char sccsid[] = "@(#)malloc.c    4.3 (Berkeley) 9/16/83";
28
29 #ifdef DEBUGGING
30 #define RCHECK
31 #endif
32 /*
33  * malloc.c (Caltech) 2/21/82
34  * Chris Kingsley, kingsley@cit-20.
35  *
36  * This is a very fast storage allocator.  It allocates blocks of a small 
37  * number of different sizes, and keeps free lists of each size.  Blocks that
38  * don't exactly fit are passed up to the next larger size.  In this 
39  * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long.
40  * This is designed for use in a program that uses vast quantities of memory,
41  * but bombs when it runs out. 
42  */
43
44 #include "EXTERN.h"
45 #include "perl.h"
46
47 static int findbucket();
48 static int morecore();
49
50 /* I don't much care whether these are defined in sys/types.h--LAW */
51
52 #define u_char unsigned char
53 #define u_int unsigned int
54 #define u_short unsigned short
55
56 /*
57  * The overhead on a block is at least 4 bytes.  When free, this space
58  * contains a pointer to the next free block, and the bottom two bits must
59  * be zero.  When in use, the first byte is set to MAGIC, and the second
60  * byte is the size index.  The remaining bytes are for alignment.
61  * If range checking is enabled and the size of the block fits
62  * in two bytes, then the top two bytes hold the size of the requested block
63  * plus the range checking words, and the header word MINUS ONE.
64  */
65 union   overhead {
66         union   overhead *ov_next;      /* when free */
67 #if MEM_ALIGNBYTES > 4
68         double  strut;                  /* alignment problems */
69 #endif
70         struct {
71                 u_char  ovu_magic;      /* magic number */
72                 u_char  ovu_index;      /* bucket # */
73 #ifdef RCHECK
74                 u_short ovu_size;       /* actual block size */
75                 u_int   ovu_rmagic;     /* range magic number */
76 #endif
77         } ovu;
78 #define ov_magic        ovu.ovu_magic
79 #define ov_index        ovu.ovu_index
80 #define ov_size         ovu.ovu_size
81 #define ov_rmagic       ovu.ovu_rmagic
82 };
83
84 #define MAGIC           0xff            /* magic # on accounting info */
85 #define RMAGIC          0x55555555      /* magic # on range info */
86 #ifdef RCHECK
87 #define RSLOP           sizeof (u_int)
88 #else
89 #define RSLOP           0
90 #endif
91
92 /*
93  * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
94  * smallest allocatable block is 8 bytes.  The overhead information
95  * precedes the data area returned to the user.
96  */
97 #define NBUCKETS 30
98 static  union overhead *nextf[NBUCKETS];
99 extern  char *sbrk();
100
101 #ifdef MSTATS
102 /*
103  * nmalloc[i] is the difference between the number of mallocs and frees
104  * for a given block size.
105  */
106 static  u_int nmalloc[NBUCKETS];
107 #include <stdio.h>
108 #endif
109
110 #ifdef debug
111 #define ASSERT(p)   if (!(p)) botch("p"); else
112 static void
113 botch(s)
114         char *s;
115 {
116
117         printf("assertion botched: %s\n", s);
118         abort();
119 }
120 #else
121 #define ASSERT(p)
122 #endif
123
124 Malloc_t
125 malloc(nbytes)
126         register MEM_SIZE nbytes;
127 {
128         register union overhead *p;
129         register int bucket = 0;
130         register MEM_SIZE shiftr;
131
132 #ifdef safemalloc
133 #ifdef DEBUGGING
134         MEM_SIZE size = nbytes;
135 #endif
136
137 #ifdef MSDOS
138         if (nbytes > 0xffff) {
139                 fprintf(stderr, "Allocation too large: %lx\n", (long)nbytes);
140                 my_exit(1);
141         }
142 #endif /* MSDOS */
143 #ifdef DEBUGGING
144         if ((long)nbytes < 0)
145             croak("panic: malloc");
146 #endif
147 #endif /* safemalloc */
148
149         /*
150          * Convert amount of memory requested into
151          * closest block size stored in hash buckets
152          * which satisfies request.  Account for
153          * space used per block for accounting.
154          */
155         nbytes += sizeof (union overhead) + RSLOP;
156         nbytes = (nbytes + 3) &~ 3; 
157         shiftr = (nbytes - 1) >> 2;
158         /* apart from this loop, this is O(1) */
159         while (shiftr >>= 1)
160                 bucket++;
161         /*
162          * If nothing in hash bucket right now,
163          * request more memory from the system.
164          */
165         if (nextf[bucket] == NULL)    
166                 morecore(bucket);
167         if ((p = (union overhead *)nextf[bucket]) == NULL) {
168 #ifdef safemalloc
169                 if (!nomemok) {
170                     fputs("Out of memory!\n", stderr);
171                     my_exit(1);
172                 }
173 #else
174                 return (NULL);
175 #endif
176         }
177
178 #ifdef safemalloc
179 #if !(defined(I286) || defined(atarist))
180     DEBUG_m(fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size));
181 #else
182     DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size));
183 #endif
184 #endif /* safemalloc */
185
186         /* remove from linked list */
187 #ifdef RCHECK
188         if (*((int*)p) & (sizeof(union overhead) - 1))
189 #if !(defined(I286) || defined(atarist))
190             fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
191 #else
192             fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
193 #endif
194 #endif
195         nextf[bucket] = p->ov_next;
196         p->ov_magic = MAGIC;
197         p->ov_index= bucket;
198 #ifdef MSTATS
199         nmalloc[bucket]++;
200 #endif
201 #ifdef RCHECK
202         /*
203          * Record allocated size of block and
204          * bound space with magic numbers.
205          */
206         if (nbytes <= 0x10000)
207                 p->ov_size = nbytes - 1;
208         p->ov_rmagic = RMAGIC;
209         *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
210 #endif
211         return ((Malloc_t)(p + 1));
212 }
213
214 /*
215  * Allocate more memory to the indicated bucket.
216  */
217 static
218 morecore(bucket)
219         register int bucket;
220 {
221         register union overhead *op;
222         register int rnu;       /* 2^rnu bytes will be requested */
223         register int nblks;     /* become nblks blocks of the desired size */
224         register MEM_SIZE siz;
225
226         if (nextf[bucket])
227                 return;
228         /*
229          * Insure memory is allocated
230          * on a page boundary.  Should
231          * make getpageize call?
232          */
233 #ifndef atarist /* on the atari we dont have to worry about this */
234         op = (union overhead *)sbrk(0);
235 #ifndef I286
236         if ((int)op & 0x3ff)
237                 (void)sbrk(1024 - ((int)op & 0x3ff));
238 #else
239         /* The sbrk(0) call on the I286 always returns the next segment */
240 #endif
241 #endif /* atarist */
242
243 #if !(defined(I286) || defined(atarist))
244         /* take 2k unless the block is bigger than that */
245         rnu = (bucket <= 8) ? 11 : bucket + 3;
246 #else
247         /* take 16k unless the block is bigger than that 
248            (80286s like large segments!), probably good on the atari too */
249         rnu = (bucket <= 11) ? 14 : bucket + 3;
250 #endif
251         nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
252         if (rnu < bucket)
253                 rnu = bucket;
254         op = (union overhead *)sbrk(1L << rnu);
255         /* no more room! */
256         if ((int)op == -1)
257                 return;
258         /*
259          * Round up to minimum allocation size boundary
260          * and deduct from block count to reflect.
261          */
262 #ifndef I286
263         if ((int)op & 7) {
264                 op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
265                 nblks--;
266         }
267 #else
268         /* Again, this should always be ok on an 80286 */
269 #endif
270         /*
271          * Add new memory allocated to that on
272          * free list for this hash bucket.
273          */
274         nextf[bucket] = op;
275         siz = 1 << (bucket + 3);
276         while (--nblks > 0) {
277                 op->ov_next = (union overhead *)((caddr_t)op + siz);
278                 op = (union overhead *)((caddr_t)op + siz);
279         }
280 }
281
282 void
283 free(mp)
284         Malloc_t mp;
285 {   
286         register MEM_SIZE size;
287         register union overhead *op;
288         char *cp = (char*)mp;
289
290 #ifdef safemalloc
291 #if !(defined(I286) || defined(atarist))
292         DEBUG_m(fprintf(stderr,"0x%x: (%05d) free\n",cp,an++));
293 #else
294         DEBUG_m(fprintf(stderr,"0x%lx: (%05d) free\n",cp,an++));
295 #endif
296 #endif /* safemalloc */
297
298         if (cp == NULL)
299                 return;
300         op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
301 #ifdef debug
302         ASSERT(op->ov_magic == MAGIC);          /* make sure it was in use */
303 #else
304         if (op->ov_magic != MAGIC) {
305 #ifdef RCHECK
306                 warn("%s free() ignored",
307                     op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
308 #else
309                 warn("Bad free() ignored");
310 #endif
311                 return;                         /* sanity */
312         }
313 #endif
314 #ifdef RCHECK
315         ASSERT(op->ov_rmagic == RMAGIC);
316         if (op->ov_index <= 13)
317                 ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC);
318         op->ov_rmagic = RMAGIC - 1;
319 #endif
320         ASSERT(op->ov_index < NBUCKETS);
321         size = op->ov_index;
322         op->ov_next = nextf[size];
323         nextf[size] = op;
324 #ifdef MSTATS
325         nmalloc[size]--;
326 #endif
327 }
328
329 /*
330  * When a program attempts "storage compaction" as mentioned in the
331  * old malloc man page, it realloc's an already freed block.  Usually
332  * this is the last block it freed; occasionally it might be farther
333  * back.  We have to search all the free lists for the block in order
334  * to determine its bucket: 1st we make one pass thru the lists
335  * checking only the first block in each; if that fails we search
336  * ``reall_srchlen'' blocks in each list for a match (the variable
337  * is extern so the caller can modify it).  If that fails we just copy
338  * however many bytes was given to realloc() and hope it's not huge.
339  */
340 int reall_srchlen = 4;  /* 4 should be plenty, -1 =>'s whole list */
341
342 Malloc_t
343 realloc(mp, nbytes)
344         Malloc_t mp; 
345         MEM_SIZE nbytes;
346 {   
347         register MEM_SIZE onb;
348         union overhead *op;
349         char *res;
350         register int i;
351         int was_alloced = 0;
352         char *cp = (char*)mp;
353
354 #ifdef safemalloc
355 #ifdef DEBUGGING
356         MEM_SIZE size = nbytes;
357 #endif
358
359 #ifdef MSDOS
360         if (nbytes > 0xffff) {
361                 fprintf(stderr, "Reallocation too large: %lx\n", size);
362                 my_exit(1);
363         }
364 #endif /* MSDOS */
365         if (!cp)
366                 return malloc(nbytes);
367 #ifdef DEBUGGING
368         if ((long)nbytes < 0)
369                 croak("panic: realloc");
370 #endif
371 #endif /* safemalloc */
372
373         op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
374         if (op->ov_magic == MAGIC) {
375                 was_alloced++;
376                 i = op->ov_index;
377         } else {
378                 /*
379                  * Already free, doing "compaction".
380                  *
381                  * Search for the old block of memory on the
382                  * free list.  First, check the most common
383                  * case (last element free'd), then (this failing)
384                  * the last ``reall_srchlen'' items free'd.
385                  * If all lookups fail, then assume the size of
386                  * the memory block being realloc'd is the
387                  * smallest possible.
388                  */
389                 if ((i = findbucket(op, 1)) < 0 &&
390                     (i = findbucket(op, reall_srchlen)) < 0)
391                         i = 0;
392         }
393         onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
394         /* avoid the copy if same size block */
395         if (was_alloced &&
396             nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) {
397 #ifdef RCHECK
398                 /*
399                  * Record new allocated size of block and
400                  * bound space with magic numbers.
401                  */
402                 if (op->ov_index <= 13) {
403                         /*
404                          * Convert amount of memory requested into
405                          * closest block size stored in hash buckets
406                          * which satisfies request.  Account for
407                          * space used per block for accounting.
408                          */
409                         nbytes += sizeof (union overhead) + RSLOP;
410                         nbytes = (nbytes + 3) &~ 3; 
411                         op->ov_size = nbytes - 1;
412                         *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
413                 }
414 #endif
415                 res = cp;
416         }
417         else {
418                 if ((res = (char*)malloc(nbytes)) == NULL)
419                         return (NULL);
420                 if (cp != res)                  /* common optimization */
421                         Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
422                 if (was_alloced)
423                         free(cp);
424         }
425
426 #ifdef safemalloc
427 #ifdef DEBUGGING
428 #  if !(defined(I286) || defined(atarist))
429         if (debug & 128) {
430             fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
431             fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
432         }
433 #  else
434         if (debug & 128) {
435             fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
436             fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size);
437         }
438 #  endif
439 #endif
440 #endif /* safemalloc */
441         return ((Malloc_t)res);
442 }
443
444 /*
445  * Search ``srchlen'' elements of each free list for a block whose
446  * header starts at ``freep''.  If srchlen is -1 search the whole list.
447  * Return bucket number, or -1 if not found.
448  */
449 static int
450 findbucket(freep, srchlen)
451         union overhead *freep;
452         int srchlen;
453 {
454         register union overhead *p;
455         register int i, j;
456
457         for (i = 0; i < NBUCKETS; i++) {
458                 j = 0;
459                 for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
460                         if (p == freep)
461                                 return (i);
462                         j++;
463                 }
464         }
465         return (-1);
466 }
467
468 #ifdef MSTATS
469 /*
470  * mstats - print out statistics about malloc
471  * 
472  * Prints two lines of numbers, one showing the length of the free list
473  * for each size category, the second showing the number of mallocs -
474  * frees for each size category.
475  */
476 void
477 mstats(s)
478         char *s;
479 {
480         register int i, j;
481         register union overhead *p;
482         int totfree = 0,
483         totused = 0;
484
485         fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
486         for (i = 0; i < NBUCKETS; i++) {
487                 for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
488                         ;
489                 fprintf(stderr, " %d", j);
490                 totfree += j * (1 << (i + 3));
491         }
492         fprintf(stderr, "\nused:\t");
493         for (i = 0; i < NBUCKETS; i++) {
494                 fprintf(stderr, " %d", nmalloc[i]);
495                 totused += nmalloc[i] * (1 << (i + 3));
496         }
497         fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n",
498             totused, totfree);
499 }
500 #endif
501 #endif /* lint */