memtree.c

地球模拟器

   while ((a+c->l)->s >= size || (a+c->r)->s >= size) {  
                                 /* While either son is big enough */

     if ((a+c->l)->s > (a+c->r)->s)  /* If left son is the larger */

       if ((a+c->r)->s >= size)      /* If right son is adequate */
         pa = &c->r;                 /* Step down to the right */
       else                          /* Otherwise ... */
         pa = &c->l;                 /* Step down to the left */

     else                            /* If right son is larger ... */

       if ((a+c->l)->s >= size)
         pa = &c->l;      
       else              
         pa = &c->r;

     c = a + *pa;                /* Step down (to left or right) */
   
   }

   /* Allocate from left edge of area. At this point:

        a = addr of the memory array
        c = addr of the winning node
        pa = addr of `ptr' to node

        size is as supplied by caller      */

leftedge:
   y = c->p;                 /* Allocate from left edge */
   c->p += size;             /* Adjust addr of remainder */
   goto eitheredge;

   /* Allocate from right edge of area. On arrival:

        a = addr of the memory array
        c = addr of the winning node
        pa = addr of `ptr' to winner
        z = end addr of winning node

        size is as supplied by caller      */

rightedge:
   y = z - size;             /* Beginning addr for alloc */

   /* Adjust remaining size of area, and delete 
      or demote the winning node. At this point:

        a = addr of the memory array
        c = addr of the winning node
        pa = addr of `ptr' to node
        y = soup addr to allocate

        size is as supplied by caller      */

eitheredge:
   c->s -= size;             /* Size of remaining scrap */

   if (c->s == 0) {          /* If nothing left at all */
     delete (pa,c);          /* Delete the winning node */
     c->l = a->l;            /* Recycle the memory node */
     a->l = c-a;
   }
   else                      /* Otherwise ... */        
     demote (pa,c);          /* Demote the winning node */


   /* All successful paths join here. Keep `almond'
      informed, and deliver the soup.  On arrival:

        y = soup addr to allocate
        size = size to allocate                 */

foot:
   FreeMemCurrent -= size;   /* Maintain all the books */

#ifdef ALCOMM                /* Keep `almond' informed */
   if (MIsDFEnabled(TrtOrgLifeEvent))
     TRepBirth (y,size);
#endif

   return (y);               /* Supply this soup addr */


   /* Come here if there is insufficient system memory
      available to obtain an enlarged node array. Emit 
      an unfriendly msg and abort execution.        */ 

bust:
   FEError (-602,EXIT,WRITE,
            "Tierra MemAlloc error: insuf system memory avail");

}


/*  _____________________________________________________
   |                                                     | 
   |  Function MemDealloc -- Deallocate an area of soup  | 
   |_____________________________________________________|

   Call is:  MemDealloc (addr,size) 

   where:    addr and size are signed fullword integers

   and:      addr = soup addr of piece to be deallocated
             size = the size of the piece in instr slots

   Also:     FreeMem        = addr of memory node array  :  May be changed
             MaxFreeBlocks  = size of memory node array  :  as side effect 
             FreeMemCurrent = sum of unoccupied space    :  of call

             SoupSize = size of soup in instr slots      :  Not changed  */


void MemDealloc (addr,size)  I32s addr,size;  {

Pmf   a,         /* Addr of memory node array */
      c,         /* Addr of current memory node */
      e;         /* Addr of the second neighbour */

I32s  Hp d,      /* Addr of parental `ptr' to e */
      Hp pa,     /* Addr of ptr to inserted node */
      pas,       /* Size of node containing ptr */

      Hp lh,     /* Left hook for root insertion */
      Hp rh,     /* Right hook for root insertion */

      oc,        /* Offset of node `c' in array */
      opa,       /* Offset of `pa' in node array */

      x,         /* Beg addr of (combined) piece */
      z;         /* End addr of (combined) piece */

MemFr scratch;   /* Scratch node */


#ifdef ERROR

   if (addr<0 || addr>=SoupSize)
     FEError (-601,EXIT,WRITE,
              "Tierra MemDealloc error: invalid soup addr %ld",addr);

   if (size<=0 || size>SoupSize)
     FEError (-601,EXIT,WRITE,
              "Tierra MemDealloc error: invalid size %ld",size);

   if (addr+size > SoupSize)
     FEError (-601,EXIT,WRITE,
              "Tierra MemDealloc error: invalid soup args");

#endif

   a = FreeMem;              /* Addr of node array */

   x = addr;                 /* Given beginning addr */
   z = x + size;             /* Ending addr of area */

   pa = &a->r;               /* Addr of `ptr' to root */
   pas = LONG_MAX;           /* Dummy indefinite size */

   c = a + *pa;              /* The addr of the root */

   /* Perform a passive binary search for the given piece 
      until I encounter a neighbour, or a node whose son 
      is no longer than the given piece.               */

   while (c->s > size) {     /* While among big nodes */
    
    if (c->p > z)            /* If node is to right */
      pa = &c->l;            /* Descend to the left */  
    else
      if (c->p + c->s >= x)  /* If neighbour or overlap */
        goto highneigh;      /* Handle situation below */
      else
        pa = &c->r;          /* Descend to the right */

    pas = c->s;              /* Size of my new father */
    c = a + *pa;             /* Descend to this node */

  }


  /* Arrive here if I reach a point where I can insert
     a node describing the piece being deallocated before
     encountering a neighbour (or discovering invalid over-
     lap).  Start inserting a new node here (and continue 
     to watch for neighbours).  If it turns out there are 
     no neighbours, this will be the correct place for the
     node; and even if there are neighbour(s), it *may* be 
     the correct place. (At worst, I will have to promote 
     the node later.)  At this point:

        a = addr of the node array
        c = addr of the descendant node
        pa = addr of `ptr' to this node
        pas = size of the paternal node

        x = addr of piece being deallocated
        y = size of piece being deallocated
        z = endad of piece being deallocated         

        addr,size are as supplied by caller

     Use my scratch node for the time being (a new node 
     will not actually be needed if it turns out there 
     is a neighbour further down).                    */

   lh = &scratch.l;          /* Init hooks (scratch node) */
   rh = &scratch.r;

   while (c != a)            /* Until I fall from the tree */

     if (c->p > z) {         /* If this node is on right */
       *rh = c - a;          /* Attach to the right hook */
       rh = &c->l;           /* And descend to the left */
       c = a + c->l;
     }

     else if (c->p + c->s >= x)  /* If neighbour or overlap */
       goto lowneigh;            /* Handle situation below */

     else {                  /* If node is to the left */
       *lh = c - a;          /* Attach to the left hook */
       lh = &c->r;           /* And descend to the right */
       c = a + c->r;
     }


   /* Arrive here if I complete the insertion without 
      encountering any neighbours (or discovering any 
      overlap). Clear both the hooks; and replace the
      scratch node by a proper one.  At this point:

        a = the addr of the node array
        pa = addr of `ptr' to scratch node

        x = addr of piece being deallocated
        y = size of piece being deallocated
        z = endad of piece being deallocated         

        addr,size are as supplied by caller

      See note in `memnode' on relocation of ptrs.  */

   *lh = *rh = 0;            /* Clear both the hooks */

   opa = pa - (I32s Hp)a;    /* Convert ptr to offset */

   oc = memnode();           /* Acquire new memory node */
   
   if (oc == 0)              /* If insufficient memory */
     goto bust;              /* Handle situation below */

   a = FreeMem;              /* Addr of (new) node array */

   pa = (I32s Hp)a + opa;    /* Relocated parental ptr */
   c = a + oc;               /* Addr of new memory node */

   c->l = scratch.l;         /* Copy ptrs from scratch */
   c->r = scratch.r;

   c->p = addr;              /* Set soup addr and size */
   c->s = size;

   *pa = c - a;              /* Attach new node to pa */
   goto foot;                /* Handle the rest below */


   /* Come here if I encounter a neighbour (or discover
      overlap) after I have started inserting the scratch
      node in the tree. Find the second neighbour, if any
      (and continue checking for overlap). If all is well,
      coalesce the 2 (or 3) pieces, using (and promoting) 
      the node that previously described the first neigh-
      bout (the higher one).  At this point:

        a = addr of the node array
        c = addr of possible neighbour

        pa = addr of `ptr' to scratch node
        pas = the size of the paternal node

        lh,rh = addr of left hook, right hook

        x = addr of piece being deallocated
        z = endad of piece being deallocated         

        addr,size are as supplied by caller          */

lowneigh:
   *lh = c->l;                  /* Attach subtrees to hooks */
   *rh = c->r;

   if (c->p == z) {             /* If this is right neigh */
     
     if (*lh != 0) {            /* If left subtree exists */
       while ((a+*lh)->r != 0)  /* Find rightmost node */
         lh = &(a+*lh)->r;      /* in the left subtree */
       e = a + *lh;             /* This is the ultimate node */
       if (e->p + e->s > x)     /* Watch for invalid overlap */
         goto recover;
       if (e->p + e->s == x) {  /* If this is left neigh */
         x = e->p;              /* Expand node to left */
         *lh = e->l;            /* Remove left neighbour */
         e->l = a->l;           /* And recycle the node */
         a->l = e-a;
       }
     }

     z += c->s;                 /* Expand node to the right */

   }

   else if (c->p + c->s == x) { /* If this is left neigh */
       
     if (*rh != 0) {            /* If right subtree exists */
       while ((a+*rh)->l != 0)  /* Find leftmost node */
         rh= &(a+*rh)->l;       /* in right subtree */
       e = a + *rh;             /* This is the ultimate node */
       if (e->p < z)            /* Watch for invalid overlap */
         goto recover;
       if (e->p == z) {         /* If this is right neigh */
         z += e->s;             /* Expand node to right */
         *rh = e->r;            /* Remove right neighbour */
         e->l = a->l;           /* And recycle the node */
         a->l = e-a;
       }
     }

     x = c->p;                  /* Expand node to the left */

   }

   else                         /* Or if invalid overlap */
     goto recover;              /* Handle situation below */

   c->l = scratch.l;            /* Tree ptrs from scratch */
   c->r = scratch.r;

   goto weigh;                  /* Promote node if needed */


   /* Come here if I encounter a neighbour (or discover
      overlap) before making any alterations to the tree.
      Find the second neighbour, if any (and continue to 
      check for overlap).  If all goes well, coalesce the
      2 (or 3) pieces, using the node that previously de-
      scribed the first neighbour (the higher one).  At
      this pt:

        a = addr of the node array
        c = addr of possible neighbour

        pa = addr of `ptr' to scratch node
        pas = the size of the paternal node

        x = addr of piece being deallocated
        z = endad of piece being deallocated         

        addr,size are as supplied by caller          */

highneigh:
   if (c->p == z) {             /* If this is right neigh */
     
     if (c->l != 0) {           /* If left subtree exists */
       d = &c->l;               /* Find rightmost node ... */
       while ((a+*d)->r != 0)   /* ... in left subtree */
         d = &(a+*d)->r;
       e = a + *d;              /* This is the ultimate node */
       if (e->p + e->s > x)     /* Watch for invalid overlap */
         goto overlap;
       if (e->p + e->s == x) {  /* If this is left neigh */
         x = e->p;              /* Expand node to left */
         *d = e->l;             /* Remove left neighbour */
         e->l = a->l;           /* And recycle the node */
         a->l = e-a;
       }
     }

     z += c->s;                 /* Expand node to the right */

   }

   else if (c->p + c->s == x) { /* If this is left neigh */
       
     if (c->r != 0) {           /* If right subtree exists */
       d = &c->r;               /* Find leftmost node ... */
       while ((a+*d)->l != 0)   /* ... in right subtree */
         d = &(a+*d)->l;
       e = a + *d;              /* This is the ultimate node */
       if (e->p < z)            /* Watch for invalid overlap */
         goto overlap;
       if (e->p == z) {         /* If this is right neigh */
         z += e->s;             /* Expand node to right */
         *d = e->r;             /* Remove right neighbour */
         e->l = a->l;           /* And recycle the node */
         a->l = e-a;
       }
     }