/*
 * File: rmemexp.c - memory management functions for expandable regions
 *  Contents: initalloc, reclaim, malloc, calloc, free
 */

/*
 * Prototypes.
 */

hidden	novalue moremem	Params((uword units));
hidden	novalue	reclaim	Params((int region));

word xcodesize;

/*
 * initalloc - initialization routine to allocate memory regions
 */

novalue initalloc(codesize)
word codesize;
   {

   xcodesize = codesize;

   /*
    * Establish icode region
    */
   code = (char *)sbrk((word)0);

   /*
    * Set up allocated memory.	The regions are:
    *
    *	Static memory region
    *	Allocated string region
    *	Allocate block region
    *	Qualifier list
    */

   statfree = statbase = (char *)((uword)(code + codesize + 3)  & ~03);

/*
 * The following code is operating-system dependent [@rmemexp.01].  Set end of
 *  static region, rounding up if necessary.
 */

#if PORT
   statend = (char *)(((uword)statbase) + mstksize + statsize);
Deliberate Syntax Error
#endif					/* PORT */

#if AMIGA || HIGHC_386 || OS2 || ((MVS || VM) && !SASC)
   /* use fixed regions */
#endif					/* AMIGA  || HIGHC_386 || ... */

#if MSDOS
   statend =
      (char *)(((uword)statbase) + (((mstksize + statsize + 511)/512) * 512));
#endif					/* MSDOS */

#if MACINTOSH
#if MPW
   statend = (char *)(((uword)statbase) + mstksize + statsize);
#endif					/* MPW */
#endif					/* MACINTOSH */

#if ATARI_ST || SASC || UNIX || VMS
   statend = (char *)(((uword)statbase) + mstksize + statsize);
#endif					/* ATARI_ST || SASC || UNIX || VMS */

/*
 * End of operating-system specific code.
 */

   strfree = strbase = (char *)((uword)(statend + 63) & ~077);
   blkfree = blkbase = strend = (char *)((((uword)strbase) + ssize +
      63) & ~077);
   equallist = (dptr *)(blkend =
      (char *)((((uword)(blkbase) + abrsize + 63)) & ~077));

   /*
    * Try to move the break back to the end of memory to allocate (the
    *  end of the string qualifier list) and die if the space isn't
    *  available.
    */
   if ((int)brk((char *)equallist) == -1)
      error("insufficient memory");
   currend = (char *)sbrk((word)0);	/* keep track of end of memory */
   }

/*
 * reclaim - reclaim space in the allocated memory regions. The marking
 *  phase has already been completed.
 */

static novalue reclaim(region)
int region;
{
   register word stat_extra, str_extra, blk_extra;
   register char *newend;

   stat_extra = 0;
   str_extra = 0;
   blk_extra = 0;

   /*
    * Collect available co-expression blocks.
    */
   cofree();

   /*
    * If there was no room to construct the qualifier list, the string
    *  region cannot be collected and the static region cannot be expanded.
    */
   if (!qualfail) {
      /*
       * Check whether the static region needs to be expanded. Regions cannot
       *  be expanded if someone else has moved the end of allocated storage.
       */
      if (statneed && currend == sbrk((word)0)) {
         /*
          * Make sure there is space for the requested static region expansion.
          *  The check involving equallist and newend appears to only be
          *  required on machines where the above addition of statneed might
          *  overflow.
          */
         newend = (char *)equallist + statneed;
         if ((uword)newend >= (uword)(char *)equallist &&
             (int)brk((char *)newend) != -1) {
               stat_extra = statneed;
               statneed = 0;
               statend += stat_extra;
               equallist = (dptr *)newend;
               currend = sbrk((word)0);
               }
         }
   
      /*
       * Collect the string space, indicating that it must be moved back
       *  extra bytes.
       */
      scollect(stat_extra);
   
      if (region == Strings && currend == sbrk((word)0)) {
         /*
          * Calculate a value for extra space.  The value is (the larger of
          *  (twice the string space needed) or (a quarter of the string space))
          *  minus the unallocated string space.
          */
         str_extra = (Max(2*strneed, ((uword)strend - (uword)strbase)/4) -
               ((uword)strend - (uword)strfree) + (GranSize-1)) & ~(GranSize-1);
         while (str_extra > 0) {
            /*
             * Try to get str_extra more bytes of storage.  If it can't be
             *  gotten, decrease the value by GranSize and try again.  If
             *  it's gotten, move back equallist.
             */
            newend = (char *)equallist + str_extra;
            if ((uword)newend >= (uword)(char *)equallist &&
                (int)brk((char *)newend) != -1) {
                   equallist = (dptr *) newend;
                   currend = sbrk((word)0);
                   break;
                   }
            str_extra -= GranSize;
            }
         if (str_extra < 0)
            str_extra = 0;
         }
      }

   /*
    * Adjust the pointers in the block region.
    */
   adjust(blkbase, blkbase + stat_extra + str_extra);

   /*
    * Compact the block region.
    */
   compact(blkbase);

   if (region == Blocks && currend == sbrk((word)0)) {
      /*
       * Calculate a value for extra space.  The value is (the larger of
       *  (twice the block region space needed) or (one quarter of the
       *  block region)) plus the unallocated block space.
       */
      blk_extra = (Max(2*blkneed, ((uword)blkend - (uword)blkbase)/4) -
               ((uword)blkend - (uword)blkfree) + (GranSize-1)) & ~(GranSize-1);
      while (blk_extra > 0) {
         /*
          * Try to get blk_extra more bytes of storage.  If it can't be gotten,
          *  decrease the value by GranSize and try again.  If it's gotten,
          *  move back equallist.
          */
         newend = (char *)equallist + blk_extra;
         if ((uword)newend >= (uword)(char *)equallist &&
             (int)brk((char *)newend) != -1) {
                equallist = (dptr *) newend;
                currend = sbrk((word)0);
                break;
                }
         blk_extra -= GranSize;
         }
      if (blk_extra < 0)
         blk_extra = 0;
   }
                
   if (stat_extra + str_extra > 0) {
      /*
       * The block region must be moved.  There is an assumption here that the
       *  block region always moves up in memory, i.e., the static and
       *  string regions never shrink.	With this assumption in hand,
       *  the block region must be moved before the string space lest the
       *  string space overwrite block data.  The assumption is valid,
       *  but beware if shrinking regions are ever implemented.
       */
      mvc((uword)blkfree - (uword)blkbase, blkbase, blkbase + stat_extra +
         str_extra);
      blkbase += stat_extra + str_extra;
      blkfree += stat_extra + str_extra;
      }
   blkend += stat_extra + str_extra + blk_extra;

   if (stat_extra > 0) {
      /*
       * The string space must be moved up in memory.
       */
      mvc((uword)strfree - (uword)strbase, strbase, strbase + stat_extra);
      strbase += stat_extra;
      strfree += stat_extra;
      }
   strend += stat_extra + str_extra;
   }

/*
 * These are Icon's own versions of the allocation routines.  They are
 *  not used for the fixed-regions versions of memory management.  They
 *  normally overload the corresponding library routines. If this is not
 *  possible, they are re-named and calls to them are renamed.
 */

static HEADER base;		/* start with empty list */
static HEADER *allocp = NULL;	/* last allocated block */

#if LATTICE || LSC
#define nothing 0
int free(ap)
#else					/* LATTICE || LSC */
#define nothing
novalue free(ap)		/* return block pointed to by ap to free list */
#endif					/* LATTICE || LSC */
pointer ap;
   {
   register HEADER *p, *q;

/* free may be called to free a block before the static region is
 *  initialized.
 */
   if (statbase == (char *)NULL || (char *)ap < statbase)
      return nothing;

   p = (HEADER *)ap - 1;	/* point to header */

#ifdef MemMon
   if (p->s.bsize > 1)	{
      if (*(int *)(p + 1) != T_Coexpr)
         MMStat((char *)ap, (word)((p->s.bsize - 1) * sizeof(HEADER)), 'F');
      *(int *)(p + 1) = FREEMAGIC;
      }
#endif					/* MemMon */

   if (p->s.bsize * sizeof(HEADER) >= statneed)
     statneed = 0;
   for (q = allocp; !((uword)p > (uword)q && (uword)p < (uword)q->s.ptr);
      q = q->s.ptr)
         if ((uword)q >= (uword)q->s.ptr && ((uword)p > (uword)q ||
            (uword)p < (uword)q->s.ptr))
               break; 		/* at one end or the other */
   if ((uword)p + sizeof(HEADER) * p->s.bsize
      == (uword)q->s.ptr) {	/* join to upper */
      p->s.bsize += q->s.ptr->s.bsize;
      if (p->s.bsize * sizeof(HEADER) >= statneed)
         statneed = 0;
      p->s.ptr = q->s.ptr->s.ptr;
      }
   else
      p->s.ptr = q->s.ptr;
   if ((uword)q + sizeof(HEADER) * q->s.bsize ==
      (uword)p) {		/* join to lower */
         q->s.bsize += p->s.bsize;
         if (q->s.bsize * sizeof(HEADER) >= statneed)
            statneed = 0;
         q->s.ptr = p->s.ptr;
         }
   else
      q->s.ptr = p;
   allocp = q;
   }

pointer malloc(nbytes)
msize nbytes;
   {
   register HEADER *p, *q;
   register uword nunits;
   register pointer xbase;
   int attempts;

   if (statbase == NULL) {
     if ((xbase = sbrk(nbytes)) == (pointer)-1)
        syserr("malloc: failed during startup");
     return xbase;
     }

   nunits = 1 + (nbytes + sizeof(HEADER) - 1) / sizeof(HEADER);

   if ((q = allocp) == NULL) {	/* no free list yet */
      base.s.ptr = allocp = q = &base;
      base.s.bsize = 0;
      }

   for (attempts = 2; attempts--; q = allocp) {
      for (p = q->s.ptr;; q = p, p = p->s.ptr) {
         if (p->s.bsize >= nunits) {	/* block is big enough */
            if (p->s.bsize == nunits)	/* exactly right */
               q->s.ptr = p->s.ptr;
            else {			/* allocate tail end */
               p->s.bsize -= nunits;
               p += p->s.bsize;
               p->s.bsize = nunits;
               }
            allocp = q;

#ifdef MemMon
            if (nunits > 1)   {
               MMStat((char *)(p + 1), (word) nbytes, 'A');
               *(int *)(p + 1) = 0;	/* clear FREEMAGIC flag */
               }
#endif					/* MemMon */

            return (char *)(p + 1);
            }
         if (p == allocp) {	/* wrap around */
            moremem(nunits);	/* garbage collect and expand if needed */
            break;
            }
         }
      }

      return NULL;
   }

#define FREESIZE 2	/* units sizeof(HEADER) that justify free() */

/*
 *  realloc() allocates a block of memory of a requested size (amount) to
 *  contain the contents of the current block (curmem) or as much as will
 *  fit.  Blocks are allocated in units of sizeof(HEADER)
 */

pointer realloc(curmem,newsiz)
register pointer curmem;		/* the current memory pointer */
msize newsiz;				/* bytes needed for new allocation */
   {
   register int cunits;		/* currently allocated units */
   register int nunits;		/* new units required */
   char *newmem;		/* the new memory pointer */
   register HEADER *head;	/* all blocks used or free have a header */

   /*
    * First establish the unit sizes involved.
    */

   nunits = 1 + (newsiz + sizeof(HEADER) - 1) / sizeof(HEADER);
   head = ((HEADER *)curmem) - 1;	/* move back a block header */
   cunits = (int)head->s.bsize;

   /*
    * Now allocate or free space as required.
    */

   if (nunits <= cunits) {	/* we already have the space */
      if (cunits - nunits < FREESIZE)
         return curmem;
      else {			/* free space at end of current block */
         head->s.bsize = nunits;	/* reduce space used */
         head += nunits;		/* move to free space */
         head->s.bsize = cunits - nunits;
         free((pointer)(++head));	/* free this new block */
         return curmem;
         }
      }
   else {				/* more space needed */
      if ((newmem = malloc((msize)newsiz)) != NULL) {
         memcopy(newmem,curmem,(word)((cunits - 1) * sizeof(HEADER)));
         free(curmem);
         return newmem;
         }
      }
   return NULL;
   }

/*
 * calloc() allocates ecnt number of esiz-sized chunks of zero-initialized
 * memory for an array of ecnt elements.
 */

pointer calloc(ecnt,esiz)
   register msize ecnt, esiz;
   {
   register char *mem;			/* the memory pointer */
   register msize amount;		/* the amount of memory needed */

   amount = ecnt * esiz;
   if ((mem = malloc(amount)) != NULL) {
      memfill(mem,0,(word)amount);		/* initialize it to zero */
      return mem;
      }
   return NULL;
   }

static novalue moremem(nunits)
uword nunits;
   {
   register HEADER *up;
   register word rnu;
   word n;

   rnu = NALLOC * ((nunits + NALLOC - 1) / NALLOC);
   n = rnu * sizeof(HEADER);
   if (((uword)statfree) + n > (uword)statend) {
      statneed = ((n / statincr) + 1) * statincr;
      coll_stat++;
      collect(Static);
      }
   /*
    * See if there is any room left.
    */
   if ((uword)statend - (uword)statfree > sizeof(HEADER)) {
      up = (HEADER *) statfree;
      up->s.bsize = ((uword)statend - (uword)statfree) / sizeof(HEADER);
      statfree = (char *) (up + up->s.bsize);
      free((pointer)(up + 1));	/* add block to free memory */
      }
   }