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