This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_01: makedepend.SH
[perl5.git] / malloc.c
CommitLineData
a0d0e21e 1/* malloc.c
8d063cd8 2 *
8d063cd8
LW
3 */
4
5#ifndef lint
a687059c 6#ifdef DEBUGGING
8d063cd8 7#define RCHECK
a687059c 8#endif
8d063cd8
LW
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
135863df 21#include "EXTERN.h"
135863df
AB
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
8d063cd8 29
8d063cd8
LW
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 */
39union overhead {
40 union overhead *ov_next; /* when free */
85e6fe83 41#if MEM_ALIGNBYTES > 4
c623bd54 42 double strut; /* alignment problems */
a687059c 43#endif
8d063cd8
LW
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
a0d0e21e
LW
58#ifdef debug
59static void botch _((char *s));
60#endif
61static void morecore _((int bucket));
62static int findbucket _((union overhead *freep, int srchlen));
63
8d063cd8
LW
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
78static union overhead *nextf[NBUCKETS];
79extern char *sbrk();
80
c07a80fd 81#ifdef DEBUGGING_MSTATS
8d063cd8
LW
82/*
83 * nmalloc[i] is the difference between the number of mallocs and frees
84 * for a given block size.
85 */
86static u_int nmalloc[NBUCKETS];
87#include <stdio.h>
88#endif
89
90#ifdef debug
91#define ASSERT(p) if (!(p)) botch("p"); else
ee0007ab 92static void
8d063cd8
LW
93botch(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
2304df62 104Malloc_t
8d063cd8 105malloc(nbytes)
ee0007ab 106 register MEM_SIZE nbytes;
8d063cd8
LW
107{
108 register union overhead *p;
109 register int bucket = 0;
ee0007ab 110 register MEM_SIZE shiftr;
8d063cd8 111
45d8adaa
LW
112#ifdef safemalloc
113#ifdef DEBUGGING
ee0007ab 114 MEM_SIZE size = nbytes;
45d8adaa
LW
115#endif
116
117#ifdef MSDOS
118 if (nbytes > 0xffff) {
ee0007ab 119 fprintf(stderr, "Allocation too large: %lx\n", (long)nbytes);
79072805 120 my_exit(1);
45d8adaa
LW
121 }
122#endif /* MSDOS */
123#ifdef DEBUGGING
124 if ((long)nbytes < 0)
463ee0b2 125 croak("panic: malloc");
45d8adaa
LW
126#endif
127#endif /* safemalloc */
128
8d063cd8
LW
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);
45d8adaa
LW
147 if ((p = (union overhead *)nextf[bucket]) == NULL) {
148#ifdef safemalloc
ee0007ab
LW
149 if (!nomemok) {
150 fputs("Out of memory!\n", stderr);
79072805 151 my_exit(1);
ee0007ab 152 }
45d8adaa 153#else
8d063cd8 154 return (NULL);
45d8adaa
LW
155#endif
156 }
157
158#ifdef safemalloc
a0d0e21e
LW
159 DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",
160 (unsigned long)(p+1),an++,(long)size));
45d8adaa
LW
161#endif /* safemalloc */
162
8d063cd8 163 /* remove from linked list */
bf38876a
LW
164#ifdef RCHECK
165 if (*((int*)p) & (sizeof(union overhead) - 1))
a0d0e21e
LW
166 fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",
167 (unsigned long)*((int*)p),(unsigned long)p);
bf38876a
LW
168#endif
169 nextf[bucket] = p->ov_next;
8d063cd8
LW
170 p->ov_magic = MAGIC;
171 p->ov_index= bucket;
c07a80fd 172#ifdef DEBUGGING_MSTATS
8d063cd8
LW
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
2304df62 185 return ((Malloc_t)(p + 1));
8d063cd8
LW
186}
187
188/*
189 * Allocate more memory to the indicated bucket.
190 */
a0d0e21e 191static void
8d063cd8 192morecore(bucket)
a687059c 193 register int bucket;
8d063cd8
LW
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 */
ee0007ab 198 register MEM_SIZE siz;
8d063cd8
LW
199
200 if (nextf[bucket])
201 return;
202 /*
203 * Insure memory is allocated
204 * on a page boundary. Should
205 * make getpageize call?
206 */
ee0007ab 207#ifndef atarist /* on the atari we dont have to worry about this */
8d063cd8 208 op = (union overhead *)sbrk(0);
a687059c 209#ifndef I286
8d063cd8 210 if ((int)op & 0x3ff)
a687059c
LW
211 (void)sbrk(1024 - ((int)op & 0x3ff));
212#else
213 /* The sbrk(0) call on the I286 always returns the next segment */
214#endif
ee0007ab 215#endif /* atarist */
a687059c 216
ee0007ab 217#if !(defined(I286) || defined(atarist))
8d063cd8
LW
218 /* take 2k unless the block is bigger than that */
219 rnu = (bucket <= 8) ? 11 : bucket + 3;
a687059c
LW
220#else
221 /* take 16k unless the block is bigger than that
ee0007ab 222 (80286s like large segments!), probably good on the atari too */
a687059c
LW
223 rnu = (bucket <= 11) ? 14 : bucket + 3;
224#endif
8d063cd8
LW
225 nblks = 1 << (rnu - (bucket + 3)); /* how many blocks to get */
226 if (rnu < bucket)
227 rnu = bucket;
ee0007ab 228 op = (union overhead *)sbrk(1L << rnu);
8d063cd8
LW
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 */
a687059c 236#ifndef I286
8d063cd8 237 if ((int)op & 7) {
ee0007ab 238 op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
8d063cd8
LW
239 nblks--;
240 }
a687059c
LW
241#else
242 /* Again, this should always be ok on an 80286 */
243#endif
8d063cd8
LW
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
94b6baf5 256Free_t
352d5a3a 257free(mp)
2304df62 258 Malloc_t mp;
8d063cd8 259{
ee0007ab 260 register MEM_SIZE size;
8d063cd8 261 register union overhead *op;
352d5a3a 262 char *cp = (char*)mp;
8d063cd8 263
45d8adaa 264#ifdef safemalloc
a0d0e21e 265 DEBUG_m(fprintf(stderr,"0x%lx: (%05d) free\n",(unsigned long)cp,an++));
45d8adaa
LW
266#endif /* safemalloc */
267
8d063cd8
LW
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
378cc40b 274 if (op->ov_magic != MAGIC) {
8990e307 275#ifdef RCHECK
a687059c 276 warn("%s free() ignored",
8990e307
LW
277 op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
278#else
279 warn("Bad free() ignored");
280#endif
8d063cd8 281 return; /* sanity */
378cc40b 282 }
8d063cd8
LW
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);
8990e307 288 op->ov_rmagic = RMAGIC - 1;
8d063cd8
LW
289#endif
290 ASSERT(op->ov_index < NBUCKETS);
291 size = op->ov_index;
292 op->ov_next = nextf[size];
293 nextf[size] = op;
c07a80fd 294#ifdef DEBUGGING_MSTATS
8d063cd8
LW
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
378cc40b 306 * ``reall_srchlen'' blocks in each list for a match (the variable
8d063cd8
LW
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 */
378cc40b 310int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
8d063cd8 311
2304df62 312Malloc_t
352d5a3a 313realloc(mp, nbytes)
2304df62 314 Malloc_t mp;
ee0007ab 315 MEM_SIZE nbytes;
8d063cd8 316{
ee0007ab 317 register MEM_SIZE onb;
8d063cd8
LW
318 union overhead *op;
319 char *res;
320 register int i;
321 int was_alloced = 0;
352d5a3a 322 char *cp = (char*)mp;
8d063cd8 323
45d8adaa
LW
324#ifdef safemalloc
325#ifdef DEBUGGING
ee0007ab 326 MEM_SIZE size = nbytes;
45d8adaa
LW
327#endif
328
329#ifdef MSDOS
330 if (nbytes > 0xffff) {
331 fprintf(stderr, "Reallocation too large: %lx\n", size);
79072805 332 my_exit(1);
45d8adaa
LW
333 }
334#endif /* MSDOS */
335 if (!cp)
ee0007ab 336 return malloc(nbytes);
45d8adaa
LW
337#ifdef DEBUGGING
338 if ((long)nbytes < 0)
463ee0b2 339 croak("panic: realloc");
45d8adaa
LW
340#endif
341#endif /* safemalloc */
342
8d063cd8
LW
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)
378cc40b 354 * the last ``reall_srchlen'' items free'd.
8d063cd8
LW
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 &&
378cc40b 360 (i = findbucket(op, reall_srchlen)) < 0)
8d063cd8
LW
361 i = 0;
362 }
ee0007ab 363 onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
8d063cd8
LW
364 /* avoid the copy if same size block */
365 if (was_alloced &&
a687059c
LW
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
45d8adaa 385 res = cp;
a687059c 386 }
45d8adaa
LW
387 else {
388 if ((res = (char*)malloc(nbytes)) == NULL)
389 return (NULL);
390 if (cp != res) /* common optimization */
ee0007ab 391 Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
45d8adaa
LW
392 if (was_alloced)
393 free(cp);
394 }
395
396#ifdef safemalloc
397#ifdef DEBUGGING
a0d0e21e
LW
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 }
45d8adaa
LW
403#endif
404#endif /* safemalloc */
2304df62 405 return ((Malloc_t)res);
8d063cd8
LW
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 */
ee0007ab 413static int
8d063cd8
LW
414findbucket(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
c07a80fd 432#ifdef DEBUGGING_MSTATS
8d063cd8
LW
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 */
ee0007ab 440void
c07a80fd 441dump_mstats(s)
8d063cd8
LW
442 char *s;
443{
444 register int i, j;
445 register union overhead *p;
c07a80fd
PP
446 int topbucket=0, totfree=0, totused=0;
447 u_int nfree[NBUCKETS];
8d063cd8 448
c07a80fd 449 for (i=0; i < NBUCKETS; i++) {
8d063cd8
LW
450 for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
451 ;
c07a80fd
PP
452 nfree[i] = j;
453 totfree += nfree[i] * (1 << (i + 3));
8d063cd8 454 totused += nmalloc[i] * (1 << (i + 3));
c07a80fd
PP
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]);
8d063cd8 464 }
c07a80fd
PP
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
472void
473dump_mstats(s)
474 char *s;
475{
8d063cd8
LW
476}
477#endif
a687059c 478#endif /* lint */