This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
3acc579cd0f335700c06e46ecd0cec571a4afa11
[perl5.git] / malloc.c
1 /* $Header: malloc.c,v 4.0 91/03/20 01:28:52 lwall Locked $
2  *
3  * $Log:        malloc.c,v $
4  * Revision 4.0  91/03/20  01:28:52  lwall
5  * 4.0 baseline.
6  * 
7  */
8
9 #ifndef lint
10 static char sccsid[] = "@(#)malloc.c    4.3 (Berkeley) 9/16/83";
11
12 #ifdef DEBUGGING
13 #define RCHECK
14 #endif
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
27 #include "EXTERN.h"
28 #include "perl.h"
29
30 static findbucket(), morecore();
31
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
37
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  */
47 union   overhead {
48         union   overhead *ov_next;      /* when free */
49 #if ALIGNBYTES > 4
50         double  strut;                  /* alignment problems */
51 #endif
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 */
67 #define OLDMAGIC        0x7f            /* same after a free() */
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
81 static  union overhead *nextf[NBUCKETS];
82 extern  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  */
89 static  u_int nmalloc[NBUCKETS];
90 #include <stdio.h>
91 #endif
92
93 #ifdef debug
94 #define ASSERT(p)   if (!(p)) botch("p"); else
95 static
96 botch(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
107 char *
108 malloc(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 */
136 #ifdef RCHECK
137         if (*((int*)p) & (sizeof(union overhead) - 1))
138 #ifndef I286
139             fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
140 #else
141             fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
142 #endif
143 #endif
144         nextf[bucket] = p->ov_next;
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  */
166 static
167 morecore(bucket)
168         register int bucket;
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);
183 #ifndef I286
184         if ((int)op & 0x3ff)
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
191         /* take 2k unless the block is bigger than that */
192         rnu = (bucket <= 8) ? 11 : bucket + 3;
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
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          */
209 #ifndef I286
210         if ((int)op & 7) {
211                 op = (union overhead *)(((int)op + 8) &~ 7);
212                 nblks--;
213         }
214 #else
215         /* Again, this should always be ok on an 80286 */
216 #endif
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
229 void
230 free(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
242         if (op->ov_magic != MAGIC) {
243                 warn("%s free() ignored",
244                     op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
245                 return;                         /* sanity */
246         }
247         op->ov_magic = OLDMAGIC;
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
270  * ``reall_srchlen'' blocks in each list for a match (the variable
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  */
274 int reall_srchlen = 4;  /* 4 should be plenty, -1 =>'s whole list */
275
276 char *
277 realloc(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)
300                  * the last ``reall_srchlen'' items free'd.
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 &&
306                     (i = findbucket(op, reall_srchlen)) < 0)
307                         i = 0;
308         }
309         onb = (1 << (i + 3)) - sizeof (*op) - RSLOP;
310         /* avoid the copy if same size block */
311         if (was_alloced &&
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
331                 return(cp);
332         }
333         if ((res = malloc(nbytes)) == NULL)
334                 return (NULL);
335         if (cp != res)                  /* common optimization */
336                 (void)bcopy(cp, res, (int)((nbytes < onb) ? nbytes : onb));
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  */
347 static
348 findbucket(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  */
374 mstats(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
398 #endif /* lint */