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