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