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