home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP11.ARK / ALLOC.C < prev    next >
Text File  |  1986-10-12  |  3KB  |  123 lines
  1. /*
  2.     Full K&R malloc() and free() for AZTEC C II
  3.  
  4. This module adapted for the CP/M environment from source code in Brian
  5. W. Kernighan and Dennis M. Ritchie's "The C Programming Language" by
  6. William C. Colley III -- 4 OCT 1982.
  7.  
  8. This module implements the functions alloc(), morecore(), xsbrk(), and
  9. free() as per pp. 173-7 of Kernighan and Ritchie.  Since xsbrk() is
  10. responsible for preventing collision between the allocated data and
  11. the stack, it must know how much space to leave for the stack.  Thus,
  12. a function rsvstk() is provided to override the default 1024 bytes.
  13.  
  14. The functions in this package are:
  15.  
  16.     char *alloc(nb)            allocates a block of nb bytes and
  17.     unsigned nb;            returns a pointer to it.  If no such
  18.                     block is available, the value NULL (0)
  19.                     is returned.
  20.  
  21.     free(blk)            Attaches the storage allocation block
  22.     char *blk;            blk to the free list.  Returns no
  23.                     meaningful value.
  24.  
  25.     HEADER *morecore(nb)        Gets a storage allocation block of
  26.     unsigned nb;            size nb from the heap and returns a
  27.                     pointer to it.  Returns NULL (0) if
  28.                     not enough space is available.
  29.  
  30.     char *xsbrk(nb)            Gets nb bytes from the heap.  Returns
  31.     unsigned nb;            a pointer to the bytes or -1 if not
  32.                     enough bytes are available.
  33.  
  34.     char *xsettop(nb)        Gets nb bytes from the heap.  Returns
  35.     unsigned nb;            a pointer to the bytes or NULL (0) if
  36.                     not enough bytes are available.
  37.  
  38.     rsvstk(stk)            Changes the minimum allowable remaining
  39.     unsigned stk;            stack size at a call to xsbrk() to stk
  40.                     bytes.  Default value is 1024 bytes.
  41. */
  42.  
  43. #define    NULL    0
  44.  
  45. union header {
  46.     struct {
  47.         union header *ptr;
  48.         unsigned size;
  49.         } s;
  50.     long l;
  51. };
  52.  
  53. typedef union header HEADER;
  54.  
  55. static HEADER base, *allocp = NULL;
  56.  
  57. char *alloc(nb)
  58. unsigned nb;
  59. {
  60.     HEADER *morecore();
  61.     register HEADER *p, *q;
  62.     register unsigned nu;
  63.  
  64.     nu = ((nb + 3) >> 2) + 1;
  65.     if ((q = allocp) == NULL) {
  66.         base.s.ptr = allocp = q = &base;
  67.         base.s.size = 1;
  68.         }
  69.     for (p = q->s.ptr; ; q = p, p = p->s.ptr) {
  70.         if (p->s.size >= nu) {
  71.             if (p->s.size == nu) q->s.ptr = p->s.ptr;
  72.             else {
  73.                 p->s.size -= nu;
  74.                 p += p->s.size;
  75.                 p->s.size = nu;
  76.                 }
  77.             allocp = q;  return (char *)(p + 1);
  78.             }
  79.         if (p == allocp)
  80.             if ((p = morecore(nu)) == NULL) return NULL;
  81.         }
  82. }
  83.  
  84. HEADER *morecore(nu)
  85. unsigned nu;
  86. {
  87.     char *xsbrk();
  88.     register char *cp;
  89.     register HEADER *up;
  90.  
  91.     if ((int)(cp = xsbrk(nu << 2)) == -1) return NULL;
  92.     up = (HEADER *)cp;
  93.     up->s.size = nu;
  94.     free((char *)(up + 1));
  95.     return allocp;
  96. }
  97.  
  98. free(blk)
  99. char *blk;
  100. {
  101.     register HEADER *p, *q;
  102.  
  103.     p = (HEADER *)blk - 1;
  104.     for (q = allocp; !(p > q && p < q->s.ptr); q = q->s.ptr)
  105.         if (q >= q ->s.ptr && (p > q || p < q->s.ptr)) break;
  106.  
  107.     if (p + p->s.size == q->s.ptr) {
  108.         p->s.size += q->s.ptr->s.size;
  109.         p->s.ptr = q->s.ptr->s.ptr;
  110.         }
  111.     else p->s.ptr = q->s.ptr;
  112.     if (q + q->s.size == p) {
  113.         q->s.size += p->s.size;
  114.         q->s.ptr = p->s.ptr;
  115.         }
  116.     else q->s.ptr = p;
  117.     allocp = q;
  118. }
  119.  
  120. /*  The functions xsbrk(), xsettop(), and rsvstk() live in the module xsbrk.mac
  121.     as they have to beat on machine things like the stack pointer.    */
  122.  
  123.