home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 15 / BBS in a box XV-2.iso / Files II / Prog / M / MacPerl 4.13 source.sit / Perl Source ƒ / Perl / malloc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-23  |  13.1 KB  |  525 lines  |  [TEXT/MPS ]
  1. /* $RCSfile: malloc.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 14:28:38 $
  2.  *
  3.  * $Log:    malloc.c,v $
  4.  * Revision 4.0.1.4  92/06/08  14:28:38  lwall
  5.  * patch20: removed implicit int declarations on functions
  6.  * patch20: hash tables now split only if the memory is available to do so
  7.  * patch20: realloc(0, size) now does malloc in case library routines call it
  8.  * 
  9.  * Revision 4.0.1.3  91/11/05  17:57:40  lwall
  10.  * patch11: safe malloc code now integrated into Perl's malloc when possible
  11.  * 
  12.  * Revision 4.0.1.2  91/06/07  11:20:45  lwall
  13.  * patch4: many, many itty-bitty portability fixes
  14.  * 
  15.  * Revision 4.0.1.1  91/04/11  17:48:31  lwall
  16.  * patch1: Configure now figures out malloc ptr type
  17.  * 
  18.  * Revision 4.0  91/03/20  01:28:52  lwall
  19.  * 4.0 baseline.
  20.  * 
  21.  */
  22.  
  23. #ifndef lint
  24. /*SUPPRESS 592*/
  25. static char sccsid[] = "@(#)malloc.c    4.3 (Berkeley) 9/16/83";
  26.  
  27. #ifdef DEBUGGING
  28. #define RCHECK
  29. #endif
  30. /*
  31.  * malloc.c (Caltech) 2/21/82
  32.  * Chris Kingsley, kingsley@cit-20.
  33.  *
  34.  * This is a very fast storage allocator.  It allocates blocks of a small 
  35.  * number of different sizes, and keeps free lists of each size.  Blocks that
  36.  * don't exactly fit are passed up to the next larger size.  In this 
  37.  * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long.
  38.  * This is designed for use in a program that uses vast quantities of memory,
  39.  * but bombs when it runs out. 
  40.  */
  41.  
  42. #include "EXTERN.h"
  43. #include "perl.h"
  44.  
  45. static findbucket(), morecore();
  46.  
  47. /* I don't much care whether these are defined in sys/types.h--LAW */
  48.  
  49. #define u_char unsigned char
  50. #define u_int unsigned int
  51. #define u_short unsigned short
  52.  
  53. /*
  54.  * The overhead on a block is at least 4 bytes.  When free, this space
  55.  * contains a pointer to the next free block, and the bottom two bits must
  56.  * be zero.  When in use, the first byte is set to MAGIC, and the second
  57.  * byte is the size index.  The remaining bytes are for alignment.
  58.  * If range checking is enabled and the size of the block fits
  59.  * in two bytes, then the top two bytes hold the size of the requested block
  60.  * plus the range checking words, and the header word MINUS ONE.
  61.  */
  62. union    overhead {
  63.     union    overhead *ov_next;    /* when free */
  64. #if ALIGNBYTES > 4
  65.     double    strut;            /* alignment problems */
  66. #endif
  67.     struct {
  68.         u_char    ovu_magic;    /* magic number */
  69.         u_char    ovu_index;    /* bucket # */
  70. #ifdef RCHECK
  71.         u_short    ovu_size;    /* actual block size */
  72.         u_int    ovu_rmagic;    /* range magic number */
  73. #endif
  74.     } ovu;
  75. #define    ov_magic    ovu.ovu_magic
  76. #define    ov_index    ovu.ovu_index
  77. #define    ov_size        ovu.ovu_size
  78. #define    ov_rmagic    ovu.ovu_rmagic
  79. };
  80.  
  81. #define    MAGIC        0xff        /* magic # on accounting info */
  82. #define OLDMAGIC    0x7f        /* same after a free() */
  83. #define RMAGIC        0x55555555    /* magic # on range info */
  84. #ifdef RCHECK
  85. #define    RSLOP        sizeof (u_int)
  86. #else
  87. #define    RSLOP        0
  88. #endif
  89.  
  90. /*
  91.  * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
  92.  * smallest allocatable block is 8 bytes.  The overhead information
  93.  * precedes the data area returned to the user.
  94.  */
  95. #define    NBUCKETS 30
  96. static    union overhead *nextf[NBUCKETS];
  97. extern    char *sbrk();
  98.  
  99. #ifdef MSTATS
  100. /*
  101.  * nmalloc[i] is the difference between the number of mallocs and frees
  102.  * for a given block size.
  103.  */
  104. static    u_int nmalloc[NBUCKETS];
  105. #include <stdio.h>
  106. #endif
  107.  
  108. #ifdef debug
  109. #define    ASSERT(p)   if (!(p)) botch("p"); else
  110. static void
  111. botch(s)
  112.     char *s;
  113. {
  114.  
  115.     printf("assertion botched: %s\n", s);
  116.     abort();
  117. }
  118. #else
  119. #define    ASSERT(p)
  120. #endif
  121.  
  122. #ifdef safemalloc
  123. static int an = 0;
  124. #endif
  125.  
  126. MALLOCPTRTYPE *
  127. malloc(nbytes)
  128.     register MEM_SIZE nbytes;
  129. {
  130.       register union overhead *p;
  131.       register int bucket = 0;
  132.       register MEM_SIZE shiftr;
  133.  
  134. #ifdef safemalloc
  135. #ifdef DEBUGGING
  136.     MEM_SIZE size = nbytes;
  137. #endif
  138.  
  139. #ifdef MSDOS
  140.     if (nbytes > 0xffff) {
  141.         fprintf(stderr, "Allocation too large: %lx\n", (long)nbytes);
  142.         exit(1);
  143.     }
  144. #endif /* MSDOS */
  145. #ifdef DEBUGGING
  146.     if ((long)nbytes < 0)
  147.         fatal("panic: malloc");
  148. #endif
  149. #endif /* safemalloc */
  150.  
  151.     /*
  152.      * Convert amount of memory requested into
  153.      * closest block size stored in hash buckets
  154.      * which satisfies request.  Account for
  155.      * space used per block for accounting.
  156.      */
  157.       nbytes += sizeof (union overhead) + RSLOP;
  158.       nbytes = (nbytes + 3) &~ 3; 
  159.       shiftr = (nbytes - 1) >> 2;
  160.     /* apart from this loop, this is O(1) */
  161.       while (shiftr >>= 1)
  162.           bucket++;
  163.     /*
  164.      * If nothing in hash bucket right now,
  165.      * request more memory from the system.
  166.      */
  167.       if (nextf[bucket] == NULL)    
  168.           morecore(bucket);
  169.       if ((p = (union overhead *)nextf[bucket]) == NULL) {
  170. #ifdef safemalloc
  171.         if (!nomemok) {
  172.             fputs("Out of memory!\n", stderr);
  173.             exit(1);
  174.         }
  175. #else
  176.           return (NULL);
  177. #endif
  178.     }
  179.  
  180. #ifdef safemalloc
  181. #ifdef DEBUGGING
  182. #  if !(defined(I286) || defined(atarist))
  183. #ifdef macintosh
  184.     if (debug & 128)
  185.         fprintf(perldbg,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
  186. #else
  187.     if (debug & 128)
  188.         fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
  189. #endif
  190. #  else
  191.     if (debug & 128)
  192.         fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
  193. #  endif
  194. #endif
  195. #endif /* safemalloc */
  196.  
  197.     /* remove from linked list */
  198. #ifdef RCHECK
  199.     if (*((int*)p) & (sizeof(union overhead) - 1))
  200. #if !(defined(I286) || defined(atarist))
  201.         fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
  202. #else
  203.         fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
  204. #endif
  205. #endif
  206.       nextf[bucket] = p->ov_next;
  207.     p->ov_magic = MAGIC;
  208.     p->ov_index= bucket;
  209. #ifdef MSTATS
  210.       nmalloc[bucket]++;
  211. #endif
  212. #ifdef RCHECK
  213.     /*
  214.      * Record allocated size of block and
  215.      * bound space with magic numbers.
  216.      */
  217.       if (nbytes <= 0x10000)
  218.         p->ov_size = nbytes - 1;
  219.     p->ov_rmagic = RMAGIC;
  220.       *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
  221. #endif
  222.       return ((MALLOCPTRTYPE *)(p + 1));
  223. }
  224.  
  225. /*
  226.  * Allocate more memory to the indicated bucket.
  227.  */
  228. static
  229. morecore(bucket)
  230.     register int bucket;
  231. {
  232.       register union overhead *op;
  233.       register int rnu;       /* 2^rnu bytes will be requested */
  234.       register int nblks;     /* become nblks blocks of the desired size */
  235.     register MEM_SIZE siz;
  236.  
  237.       if (nextf[bucket])
  238.           return;
  239.     /*
  240.      * Insure memory is allocated
  241.      * on a page boundary.  Should
  242.      * make getpageize call?
  243.      */
  244. #ifndef atarist /* on the atari we dont have to worry about this */
  245.       op = (union overhead *)sbrk(0);
  246. #ifndef I286
  247.       if ((int)op & 0x3ff)
  248.           (void)sbrk(1024 - ((int)op & 0x3ff));
  249. #else
  250.     /* The sbrk(0) call on the I286 always returns the next segment */
  251. #endif
  252. #endif /* atarist */
  253.  
  254. #if !(defined(I286) || defined(atarist))
  255.     /* take 2k unless the block is bigger than that */
  256.       rnu = (bucket <= 8) ? 11 : bucket + 3;
  257. #else
  258.     /* take 16k unless the block is bigger than that 
  259.        (80286s like large segments!), probably good on the atari too */
  260.       rnu = (bucket <= 11) ? 14 : bucket + 3;
  261. #endif
  262.       nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
  263.       if (rnu < bucket)
  264.         rnu = bucket;
  265.     op = (union overhead *)sbrk(1L << rnu);
  266.     /* no more room! */
  267.       if ((int)op == -1)
  268.           return;
  269.     /*
  270.      * Round up to minimum allocation size boundary
  271.      * and deduct from block count to reflect.
  272.      */
  273. #ifndef I286
  274.       if ((int)op & 7) {
  275.           op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
  276.           nblks--;
  277.       }
  278. #else
  279.     /* Again, this should always be ok on an 80286 */
  280. #endif
  281.     /*
  282.      * Add new memory allocated to that on
  283.      * free list for this hash bucket.
  284.      */
  285.       nextf[bucket] = op;
  286.       siz = 1 << (bucket + 3);
  287.       while (--nblks > 0) {
  288.         op->ov_next = (union overhead *)((caddr_t)op + siz);
  289.         op = (union overhead *)((caddr_t)op + siz);
  290.       }
  291. }
  292.  
  293. void
  294. free(mp)
  295.     MALLOCPTRTYPE *mp;
  296. {   
  297.       register MEM_SIZE size;
  298.     register union overhead *op;
  299.     char *cp = (char*)mp;
  300.  
  301. #ifdef safemalloc
  302. #ifdef DEBUGGING
  303. #  if !(defined(I286) || defined(atarist))
  304. #ifdef macintosh
  305.     if (debug & 128)
  306.         fprintf(perldbg,"0x%x: (%05d) free\n",cp,an++);
  307. #else
  308.     if (debug & 128)
  309.         fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
  310. #endif
  311. #  else
  312.     if (debug & 128)
  313.         fprintf(stderr,"0x%lx: (%05d) free\n",cp,an++);
  314. #  endif
  315. #endif
  316. #endif /* safemalloc */
  317.  
  318.       if (cp == NULL)
  319.           return;
  320.     op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
  321. #ifdef debug
  322.       ASSERT(op->ov_magic == MAGIC);        /* make sure it was in use */
  323. #else
  324.     if (op->ov_magic != MAGIC) {
  325.         warn("%s free() ignored",
  326.             op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
  327.         return;                /* sanity */
  328.     }
  329.     op->ov_magic = OLDMAGIC;
  330. #endif
  331. #ifdef RCHECK
  332.       ASSERT(op->ov_rmagic == RMAGIC);
  333.     if (op->ov_index <= 13)
  334.         ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC);
  335. #endif
  336.       ASSERT(op->ov_index < NBUCKETS);
  337.       size = op->ov_index;
  338.     op->ov_next = nextf[size];
  339.       nextf[size] = op;
  340. #ifdef MSTATS
  341.       nmalloc[size]--;
  342. #endif
  343. }
  344.  
  345. /*
  346.  * When a program attempts "storage compaction" as mentioned in the
  347.  * old malloc man page, it realloc's an already freed block.  Usually
  348.  * this is the last block it freed; occasionally it might be farther
  349.  * back.  We have to search all the free lists for the block in order
  350.  * to determine its bucket: 1st we make one pass thru the lists
  351.  * checking only the first block in each; if that fails we search
  352.  * ``reall_srchlen'' blocks in each list for a match (the variable
  353.  * is extern so the caller can modify it).  If that fails we just copy
  354.  * however many bytes was given to realloc() and hope it's not huge.
  355.  */
  356. int reall_srchlen = 4;    /* 4 should be plenty, -1 =>'s whole list */
  357.  
  358. MALLOCPTRTYPE *
  359. realloc(mp, nbytes)
  360.     MALLOCPTRTYPE *mp; 
  361.     MEM_SIZE nbytes;
  362. {   
  363.       register MEM_SIZE onb;
  364.     union overhead *op;
  365.       char *res;
  366.     register int i;
  367.     int was_alloced = 0;
  368.     char *cp = (char*)mp;
  369.  
  370. #ifdef safemalloc
  371. #ifdef DEBUGGING
  372.     MEM_SIZE size = nbytes;
  373. #endif
  374.  
  375. #ifdef MSDOS
  376.     if (nbytes > 0xffff) {
  377.         fprintf(stderr, "Reallocation too large: %lx\n", size);
  378.         exit(1);
  379.     }
  380. #endif /* MSDOS */
  381.     if (!cp)
  382.         return malloc(nbytes);
  383. #ifdef DEBUGGING
  384.     if ((long)nbytes < 0)
  385.         fatal("panic: realloc");
  386. #endif
  387. #endif /* safemalloc */
  388.  
  389.     op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
  390.     if (op->ov_magic == MAGIC) {
  391.         was_alloced++;
  392.         i = op->ov_index;
  393.     } else {
  394.         /*
  395.          * Already free, doing "compaction".
  396.          *
  397.          * Search for the old block of memory on the
  398.          * free list.  First, check the most common
  399.          * case (last element free'd), then (this failing)
  400.          * the last ``reall_srchlen'' items free'd.
  401.          * If all lookups fail, then assume the size of
  402.          * the memory block being realloc'd is the
  403.          * smallest possible.
  404.          */
  405.         if ((i = findbucket(op, 1)) < 0 &&
  406.             (i = findbucket(op, reall_srchlen)) < 0)
  407.             i = 0;
  408.     }
  409.     onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
  410.     /* avoid the copy if same size block */
  411.     if (was_alloced &&
  412.         nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) {
  413. #ifdef RCHECK
  414.         /*
  415.          * Record new allocated size of block and
  416.          * bound space with magic numbers.
  417.          */
  418.         if (op->ov_index <= 13) {
  419.             /*
  420.              * Convert amount of memory requested into
  421.              * closest block size stored in hash buckets
  422.              * which satisfies request.  Account for
  423.              * space used per block for accounting.
  424.              */
  425.             nbytes += sizeof (union overhead) + RSLOP;
  426.             nbytes = (nbytes + 3) &~ 3; 
  427.             op->ov_size = nbytes - 1;
  428.             *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
  429.         }
  430. #endif
  431.         res = cp;
  432.     }
  433.     else {
  434.         if ((res = (char*)malloc(nbytes)) == NULL)
  435.             return (NULL);
  436.         if (cp != res)            /* common optimization */
  437.             Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
  438.         if (was_alloced)
  439.             free(cp);
  440.     }
  441.  
  442. #ifdef safemalloc
  443. #ifdef DEBUGGING
  444. #  if !(defined(I286) || defined(atarist))
  445. #ifdef macintosh
  446.     if (debug & 128) {
  447.         fprintf(perldbg,"0x%x: (%05d) rfree\n",res,an++);
  448.         fprintf(perldbg,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
  449.     }
  450. #else
  451.     if (debug & 128) {
  452.         fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
  453.         fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
  454.     }
  455. #endif
  456. #  else
  457.     if (debug & 128) {
  458.         fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
  459.         fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size);
  460.     }
  461. #  endif
  462. #endif
  463. #endif /* safemalloc */
  464.       return ((MALLOCPTRTYPE*)res);
  465. }
  466.  
  467. /*
  468.  * Search ``srchlen'' elements of each free list for a block whose
  469.  * header starts at ``freep''.  If srchlen is -1 search the whole list.
  470.  * Return bucket number, or -1 if not found.
  471.  */
  472. static int
  473. findbucket(freep, srchlen)
  474.     union overhead *freep;
  475.     int srchlen;
  476. {
  477.     register union overhead *p;
  478.     register int i, j;
  479.  
  480.     for (i = 0; i < NBUCKETS; i++) {
  481.         j = 0;
  482.         for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
  483.             if (p == freep)
  484.                 return (i);
  485.             j++;
  486.         }
  487.     }
  488.     return (-1);
  489. }
  490.  
  491. #ifdef MSTATS
  492. /*
  493.  * mstats - print out statistics about malloc
  494.  * 
  495.  * Prints two lines of numbers, one showing the length of the free list
  496.  * for each size category, the second showing the number of mallocs -
  497.  * frees for each size category.
  498.  */
  499. void
  500. mstats(s)
  501.     char *s;
  502. {
  503.       register int i, j;
  504.       register union overhead *p;
  505.       int totfree = 0,
  506.       totused = 0;
  507.  
  508.       fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
  509.       for (i = 0; i < NBUCKETS; i++) {
  510.           for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
  511.               ;
  512.           fprintf(stderr, " %d", j);
  513.           totfree += j * (1 << (i + 3));
  514.       }
  515.       fprintf(stderr, "\nused:\t");
  516.       for (i = 0; i < NBUCKETS; i++) {
  517.           fprintf(stderr, " %d", nmalloc[i]);
  518.           totused += nmalloc[i] * (1 << (i + 3));
  519.       }
  520.       fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n",
  521.         totused, totfree);
  522. }
  523. #endif
  524. #endif /* lint */
  525.