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