perl 5.002beta2 patch: toke.c
[p5sagit/p5-mst-13.2.git] / malloc.c
CommitLineData
a0d0e21e 1/* malloc.c
8d063cd8 2 *
8d063cd8 3 */
4
5#ifndef lint
a687059c 6#ifdef DEBUGGING
8d063cd8 7#define RCHECK
a687059c 8#endif
8d063cd8 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 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 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 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 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 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
81#ifdef MSTATS
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 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 107{
108 register union overhead *p;
109 register int bucket = 0;
ee0007ab 110 register MEM_SIZE shiftr;
8d063cd8 111
45d8adaa 112#ifdef safemalloc
113#ifdef DEBUGGING
ee0007ab 114 MEM_SIZE size = nbytes;
45d8adaa 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 121 }
122#endif /* MSDOS */
123#ifdef DEBUGGING
124 if ((long)nbytes < 0)
463ee0b2 125 croak("panic: malloc");
45d8adaa 126#endif
127#endif /* safemalloc */
128
8d063cd8 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 147 if ((p = (union overhead *)nextf[bucket]) == NULL) {
148#ifdef safemalloc
ee0007ab 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 155#endif
156 }
157
158#ifdef safemalloc
a0d0e21e 159 DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",
160 (unsigned long)(p+1),an++,(long)size));
45d8adaa 161#endif /* safemalloc */
162
8d063cd8 163 /* remove from linked list */
bf38876a 164#ifdef RCHECK
165 if (*((int*)p) & (sizeof(union overhead) - 1))
a0d0e21e 166 fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",
167 (unsigned long)*((int*)p),(unsigned long)p);
bf38876a 168#endif
169 nextf[bucket] = p->ov_next;
8d063cd8 170 p->ov_magic = MAGIC;
171 p->ov_index= bucket;
172#ifdef 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
2304df62 185 return ((Malloc_t)(p + 1));
8d063cd8 186}
187
188/*
189 * Allocate more memory to the indicated bucket.
190 */
a0d0e21e 191static void
8d063cd8 192morecore(bucket)
a687059c 193 register int bucket;
8d063cd8 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 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 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 218 /* take 2k unless the block is bigger than that */
219 rnu = (bucket <= 8) ? 11 : bucket + 3;
a687059c 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 223 rnu = (bucket <= 11) ? 14 : bucket + 3;
224#endif
8d063cd8 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 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 239 nblks--;
240 }
a687059c 241#else
242 /* Again, this should always be ok on an 80286 */
243#endif
8d063cd8 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 266#endif /* safemalloc */
267
8d063cd8 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 277 op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
278#else
279 warn("Bad free() ignored");
280#endif
8d063cd8 281 return; /* sanity */
378cc40b 282 }
8d063cd8 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 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 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
378cc40b 306 * ``reall_srchlen'' blocks in each list for a match (the variable
8d063cd8 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 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 324#ifdef safemalloc
325#ifdef DEBUGGING
ee0007ab 326 MEM_SIZE size = nbytes;
45d8adaa 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 333 }
334#endif /* MSDOS */
335 if (!cp)
ee0007ab 336 return malloc(nbytes);
45d8adaa 337#ifdef DEBUGGING
338 if ((long)nbytes < 0)
463ee0b2 339 croak("panic: realloc");
45d8adaa 340#endif
341#endif /* safemalloc */
342
8d063cd8 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 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 361 i = 0;
362 }
ee0007ab 363 onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
8d063cd8 364 /* avoid the copy if same size block */
365 if (was_alloced &&
a687059c 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 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 392 if (was_alloced)
393 free(cp);
394 }
395
396#ifdef safemalloc
397#ifdef DEBUGGING
a0d0e21e 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 403#endif
404#endif /* safemalloc */
2304df62 405 return ((Malloc_t)res);
8d063cd8 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 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
432#ifdef 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 */
ee0007ab 440void
8d063cd8 441mstats(s)
442 char *s;
443{
444 register int i, j;
445 register union overhead *p;
446 int totfree = 0,
447 totused = 0;
448
449 fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
450 for (i = 0; i < NBUCKETS; i++) {
451 for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
452 ;
453 fprintf(stderr, " %d", j);
454 totfree += j * (1 << (i + 3));
455 }
456 fprintf(stderr, "\nused:\t");
457 for (i = 0; i < NBUCKETS; i++) {
458 fprintf(stderr, " %d", nmalloc[i]);
459 totused += nmalloc[i] * (1 << (i + 3));
460 }
461 fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n",
462 totused, totfree);
463}
464#endif
a687059c 465#endif /* lint */