/*******************************************************************************
* YORKTOWN ADVANCED SGML PARSER (YASP)                                         *
*         An SGML Parser conforming to International Standard ISO 8879 --      *
*         Standard Generalized Markup Language                                 *
*------------------------------------------------------------------------------*
* Written 1987 - 1993 by                                                       *
*         Pierre G. Richard                                                    *
*         IBM T.J. Watson Research Center                                      *
*         Yorktown Heights, New York                                           *
*         petrus@watson.ibm.com                                                *
*------------------------------------------------------------------------------*
* FUNCTION NAME    = YASP / General Library                                    *
* STATUS           = Version 0, Release 1, Level 16 and up                     *
* COMPONENT NAME   = plmgr.c                                                   *
* DESCRIPTIVE NAME = Manages the Heap in Pools                                 *
* DATE_WR          = 07/17/1987                                                *
* AUTHOR           = Pierre G. Richard - PETRUS at YKTVMX                      *
*                                                                              *
* FUNCTIONAL DESCRIPTION =                                                     *
*                                                                              *
* CHANGE HISTORY =                                                             *
* Number Date     Inits    Change & reason (brief)                             *
*      1 12/02/88 PETRUS   -- removed (3/19/89) --                             *
*      2  3/19/89 PETRUS   Made it portable for any kind of address            *
*                          segment DOS, V segment (OS2), sequential.           *
*      3 08/28/91 PETRUS   pl_clrp() function added (for vanishing subpools)   *
*      4 12/04/91 PETRUS   Avoid round up overflow for big chunk in morecore() *
*******************************************************************************/

/*-------------+
|Include Files |
+-------------*/
#include "machine.h"
#include "portable.h"
#include "yaspapi.h"
#include "global.h"
#include "usrlib.h"

/*---------------+
|Local Structures|
+---------------*/
typedef int ALIGN;

typedef union t_HDR {
   struct {
      union {
         uint  N_off;           /* When freed: offset of next free block */
         uint  id;              /* When allocated: SP id # */
      }_;
      uint sz;                  /* Allocated or Freed: size (rounded) */
   }_;
   ALIGN x;
}HDR;

typedef struct t_SBPOOL {
   struct t_SBPOOL *pN;         /* address of next subpool */
   union  t_HDR *H_pC;          /* address of the current free block */
   uint total_size;             /* total size of this subpool */
   uint no_such_sz;             /* this doesn't mean smaller will fit in ! */
   uint id;                     /* sub-pool # */
   HDR  H_0;                    /* to get started and avoid to vanish ! */
}SBPOOL;

/*---------------+
|Local Functions |
+---------------*/

/* Add one entry more for the SBPOOL and Round Up to sizeof (HDR) */
#define ROUNDED(sz) sizeof(HDR)*(1+((sz+sizeof(HDR)-1)/sizeof(HDR)))

/* sizeof(SBPOOL) rounded up to sizeof(HDR) */
#define SBPOOL_SIZE sizeof(HDR)*((sizeof(SBPOOL)+sizeof(HDR)-1)/sizeof(HDR))

/* to make it more readable */
#define GA_sp_pC    (GA(pool_C).sp_p)
#define GA_C_idmax  (GA(pool_C).idmax)

static void  LP_FCT morecore (GA_P, uint);

/*---------------------------------------------------------------------pl_accs-+
| Access to a given pool - return the pool that was in use                     |
| Exit in error if invalid poolid: tough, but sure !                           |
+-----------------------------------------------------------------------------*/
int P_FCT pl_accs(GA_P gbla_p, int new_poolid)
{
   uint old_poolid;
   SBPOOL dummy_sp;      /* for initialization */

   if ((new_poolid < 0) || (new_poolid > POOLID_MAX)) exit(101);
#if (defined(C6_00))                                 /* Microsoft C6.00 bug */
   /* Optimizer bug: GA(pool_C) has wrong address */
   GA(pool)[GA(poolid_C)] = GA(pool_C);              /* save old poolid */
   old_poolid=GA(poolid_C);
#else
   GA(pool)[old_poolid=GA(poolid_C)] = GA(pool_C);   /* save old poolid */
#endif
   GA(pool_C) = GA(pool)[GA(poolid_C)=new_poolid];   /* set up the new */
   if (!GA_C_idmax) {                                /* at first time */
      GA_sp_pC = dummy_sp.pN = &dummy_sp;            /* use a dummy sub-pool */
      morecore(gbla_p,0);                            /* and call morecore */
      ((SBPOOL *)GA_sp_pC)->pN = (SBPOOL *)GA_sp_pC; /* unlink the dummy */
   }
   return(old_poolid);
}

/*--------------------------------------------------------------------pl_sppsh-+
| Access to a new pool                                                         |
+-----------------------------------------------------------------------------*/
void P_FCT pl_sppsh(GA_P gbla_p)
{
   pl_accs(gbla_p,GA(poolid_C)+1);
}

/*--------------------------------------------------------------------pl_sppop-+
| Back to previous pool                                                        |
+-----------------------------------------------------------------------------*/
void P_FCT pl_sppop(GA_P gbla_p)
{
   pl_accs(gbla_p,GA(poolid_C)-1);
}

/*--------------------------------------------------------------------pl_clean-+
| Release all accessed pools                                                   |
| Warning: no more malloc are allowed, unless pl_accs has been re-issued       |
|          (at least, do pl_accs(0) )                                          |
| Note: This function is also called in case the Parser must EXIT:             |
|       code must not assume ERH_T_SEV or EXIT does not return !               |
+-----------------------------------------------------------------------------*/
void P_FCT pl_clean(GA_P gbla_p)
{
   int poolid = -1;

   GA(pool)[GA(poolid_C)] = GA(pool_C);              /* update current poolid */
   while (++poolid <= POOLID_MAX) {
      if ((GA(pool)[poolid]).idmax) {
         GA(pool_C) = GA(pool)[GA(poolid_C)=poolid]; /* set up a new */
         pl_rels(gbla_p);
      }
   }
}

/*---------------------------------------------------------------------pl_rels-+
| Release the current pool                                                     |
| Note: This function is also called in case the Parser must EXIT:             |
|       code must not assume ERH_T_SEV or EXIT does not return !               |
+-----------------------------------------------------------------------------*/
void P_FCT pl_rels(GA_P gbla_p)
{
   SBPOOL *sp_p, *sp_pN;
   uint count;
   PAC *pac_p;
   int rc;

   pac_p = GA(pac_p);
   sp_p = (SBPOOL *)GA_sp_pC;
   count = GA_C_idmax + 1;
   while (--count) {
      sp_pN = sp_p->pN;
      pac_p->stg.len = sp_p->total_size; /* set size of storage to free */
      pac_p->stg._.p = (uchar *)sp_p;    /* address in stg.p */
      pac_p->func = SFRE_PFC;            /* "free storage" service */
      switch(rc=pac_p->ase(pac_p)) {
      case 0:
         break;
      default:
         GA_C_idmax = count;             /* Pretend this subpool freed */
         GA_sp_pC = sp_pN;               /* in case exit will not return */
         exit(rc);                       /* else (recovering) exit returns */
         break;                          /* .. and lands here */
      }
      sp_p = sp_pN;                      /* get next subpool */
   }
   GA_sp_pC = (SBPOOL *)0;
   GA_C_idmax = 0;
}

/*---------------------------------------------------------------------pl_clrp-+
| Clear the current pool, but do not release the allocated memory.             |
| This function must be used for temporary memory that is cyclically           |
| mallocated by chunks then totally freed.                                     |
| For performance reason, repetitive calls to SGET_PFC and SFRE_PFC should be  |
| avoided.  A call to pl_clrp() makes available again all the memory gained    |
| by previous malloc() calls, but doesn't release the memory like pl_rels().   |
| This strategy also assumes an almost constant average of bytes.              |
+-----------------------------------------------------------------------------*/
void P_FCT pl_clrp(GA_P gbla_p)
{
   SBPOOL *sp_p;
   uint count;
   HDR *H_pX;

   sp_p = (SBPOOL *)GA_sp_pC;
   count = GA_C_idmax + 1;
   while (--count) {
      H_pX = (HDR *)((uchar *)sp_p + SBPOOL_SIZE); /* first free header */
      H_pX->_._.N_off = offsetof(SBPOOL,H_0);      /* Next == base_header */
      sp_p->no_such_sz = 1 + (
         H_pX->_.sz=sp_p->total_size - SBPOOL_SIZE /* remainding size */
      );
      sp_p->H_0._.sz = 0;                          /* base H_p: always free */
      sp_p->H_0._._.N_off = SBPOOL_SIZE;           /* see implementation note */
      sp_p->H_pC = &(sp_p->H_0);                   /* is the current header */
      sp_p = sp_p->pN;                             /* get next subpool */
   }
}

/*---------------------------------------------------------------------pl_copy-+
| This function is used when a bunch of bytes must be copied to dynamic memory |
| which is under the control of another global_area.                           |
| Note: The target memory is supposed to have been mallocated once, and        |
|       is re-allocated here.  I can't pretend this is very clean, nor safe.   |
|       Use it sparingly.                                                      |
+-----------------------------------------------------------------------------*/
void * P_FCT pl_copy(
   GA_P gbla_p,
   GLOBAL_AREA *target_gbla_p, void *target_a_p, void *source_a_p, int size
)
{
   POOL source_pool_C = GA(pool_C);

   GA(pool_C) = target_gbla_p->pool_C;
   memcpy((target_a_p = realloc(target_a_p, size)), source_a_p, size);
   target_gbla_p->pool_C = GA(pool_C);
   GA(pool_C) = source_pool_C;
   return(target_a_p);
}

/*STATIC--------------------------------------------------------------morecore-+
| Get more core from the system - new sub-pool in GA_sp_pC                     |
| Exit if unable to get core from the system.                                  |
|                                                                              |
| SGET return codes:  0 (OK)                                                   |
|                     END_PARSE_RC (Storage not allocated)                     |
|                                                                              |
| IMPLEMENTATION NOTE:                                                         |
|                                                                              |
| At least, one block must stay free for the sanity of the algorithms.         |
| In a fully allocated subppol, the base header (H_0) will act as the          |
| last unallocated and unallocable block.                                      |
| The size of H_0 is zero to serve 2 purposes:                                 |
|   1) H_p0 is ensured to be always free, as the minimal allocation            |
|      (pl_allo(0)) results in a size of "sizeof(HDR)"                         |
|   2) it cannot be merged: (X_off == P_off + P_size) is always FALSE          |
|      when P is H_0                                                           |
+-----------------------------------------------------------------------------*/
static void LP_FCT morecore(GA_P gbla_p, register uint sz)
{
   HDR *H_pX;
   SBPOOL *sp_pC = (SBPOOL *)GA_sp_pC;
   SBPOOL *sp_p;
   PAC *pac_p;
   int rc;

   /*---------------------------------------------+
   |First: set up the no_such_sz value into the   |
   |current subpool - It means that no larger area|
   |exist in the this subpool, but doesn't mean a |
   |smaller area does exist.                      |
   +---------------------------------------------*/
   if (sz < sp_pC->no_such_sz) sp_pC->no_such_sz = sz;

   /*---------------------------------------------+
   |Now try to find in any already gotten subpool |
   |if one area might be big enough.  If so, let  |
   |caller find out if it does fit.               |
   +---------------------------------------------*/
   for (sp_p = sp_pC->pN; sp_p != sp_pC; sp_p = sp_p->pN) {
      if (sz < sp_p->no_such_sz) {                 /* might fit... */
         GA_sp_pC = sp_p;
         return;                                   /* try it */
      }
   }
   /*---------------------------------------------+
   |No subpool contains such an area: create a new|
   |subpool.  Allocate SBPOOL_SIZE bytes more to  |
   |store the subpool header.                     |
   |Round up to 1<< NALLOC_PWR.                   |
   +---------------------------------------------*/
   if (!sz) {   /* at init time only */
      sz = SBPOOL_SIZE + sizeof(HDR);
   }else {
      if (sz > ((uint)~0) - ((1<<NALLOC_PWR) + SBPOOL_SIZE - 1)) {
        sz += SBPOOL_SIZE;               /* Avoid round up overflow */
      }else {
        sz = (sz + SBPOOL_SIZE - 1 + (1<<NALLOC_PWR)) & (~0<<NALLOC_PWR);
      }
   }
   pac_p = GA(pac_p);                    /* get PAC pointer */
   pac_p->stg.len = sz;                  /* set size of storage to get */
   pac_p->func = SGET_PFC;               /* "get storage" service */
   switch(rc = pac_p->ase(pac_p)) {
   case 0:                               /* all is fine */
      break;
   default:                              /* cannot allocate storage */
      exit(rc);                          /* tough, but sure */
   }
   sp_p = (SBPOOL *)(pac_p->stg._.p);    /* else get storage address */

   /*---------------------------------------------+
   |Initialize the new subpool: enter it in the   |
   |ring, set up the current pointers in GLOBAL   |
   +---------------------------------------------*/
   sp_p->pN = sp_pC->pN;                           /* break the ring */
   GA_sp_pC = sp_pC->pN = sp_p;                    /* to add the new subpool */
   H_pX = (HDR *)((uchar *)sp_p + SBPOOL_SIZE);    /* first free header */
   H_pX->_.sz = sz - SBPOOL_SIZE;                  /* remainding size */
   H_pX->_._.N_off = offsetof(SBPOOL,H_0);         /* Next == base_header */
   sp_p->H_0._.sz = 0;                             /* base H_p: always free */
   sp_p->H_0._._.N_off = SBPOOL_SIZE;              /* see implementation note */
   sp_p->H_pC = &(sp_p->H_0);                      /* is the current header */
   sp_p->total_size = sz;
   sp_p->no_such_sz = 1 + sz - SBPOOL_SIZE;
   sp_p->id = ++GA_C_idmax;
}

/*--------------------------------------------------------------------pl_zallo-+
| Allocate a block of "sz" bytes long and zero it                              |
+-----------------------------------------------------------------------------*/
void * P_FCT pl_zallo(GA_P gbla_p, uint sz)
{
   return(memset(pl_allo(gbla_p,sz),'\0',sz));
}

/*---------------------------------------------------------------------pl_allo-+
| Allocate a block of "sz" bytes long.                                         |
| WARNING: size cannot be greater than MAX_ALLOC (defined in USRLIB.H)         |
| -- Optimized --                                                              |
+-----------------------------------------------------------------------------*/
void * P_FCT pl_allo(GA_P gbla_p, uint sz)
{
   HDR *H_pX, *H_pP, *H_pC;
   SBPOOL *sp_pC;

   sp_pC = (SBPOOL *)GA_sp_pC;
   sz = ROUNDED(sz);
   H_pX = H_pC = (sp_pC = (SBPOOL *)GA_sp_pC)->H_pC;
   for (;;) {
      H_pX = (HDR *)((uchar *)sp_pC + (H_pP=H_pX)->_._.N_off);
      if (H_pX->_.sz >= sz) break;
      if (H_pX == H_pC) {                          /* Loop has been looped */
         morecore(gbla_p,sz);                      /* ask for more core */
         H_pX = H_pC = (sp_pC = (SBPOOL *)GA_sp_pC)->H_pC;
      }
   }
   if (H_pX->_.sz == sz) {                         /* if exactly sized */
      H_pP->_._.N_off = H_pX->_._.N_off;           /* unlink it */
   }else {                                         /* if too big */
      H_pX->_.sz -= sz;                            /* unlink and cut */
      H_pX = (HDR *)((uchar *)H_pX + H_pX->_.sz);  /* point the new */
      H_pX->_.sz = sz;                             /* set its size */
   }
   H_pX->_._.id = sp_pC->id;                       /* identify subpool */
   sp_pC->H_pC = H_pP;                             /* before the new */
   return((void *)(H_pX+1));                       /* return -> core */
}

/*---------------------------------------------------------------------pl_free-+
| Free the block allocated by pl_allo                                          |
| -- OPTIMIZED --                                                              |
+-----------------------------------------------------------------------------*/
void P_FCT pl_free(GA_P gbla_p, void *c_p)
{
   register uint X_off;
   uint   sz, P_off, N_off;
   SBPOOL *sp_pC;
   HDR   *H_pP, *H_pN;                             /* P: Previous, N: Next */
   HDR   *H_pX = (HDR *)c_p - 1;

   /*-----------------------------------+
   |look where to insert the freed block|
   |First: find the right subpool, then |
   |find the previous and next free     |
   |block around H_pX.                  |
   +-----------------------------------*/
   {
      register uint id = H_pX->_._.id;             /* Optimized FOR loop */

      sp_pC = (SBPOOL *)GA_sp_pC;
      if (sp_pC->id != id) while ((sp_pC = sp_pC->pN)->id != id);
   }
   P_off = (uchar *)sp_pC->H_pC - (uchar *)sp_pC;
   X_off = (uchar *)H_pX - (uchar *)sp_pC;
   for (;;) {
      N_off = ((HDR *)((uchar *)sp_pC + P_off))->_._.N_off;
      if (X_off > P_off) {
         if ((X_off < N_off) || (P_off >= N_off)) break;
      }else {
         if ((X_off < N_off) && (P_off >= N_off)) break;
      }
      P_off = N_off;
   }
   sp_pC->H_pC = H_pP = (HDR *)((uchar *)sp_pC + P_off);

   /*-------------------+
   |Try to merge blocks |
   +-------------------*/
   if (N_off == X_off + H_pX->_.sz) {              /* if next adjacent */
      H_pN = (HDR *)((uchar *)sp_pC + N_off);
      sz = (H_pX->_.sz += H_pN->_.sz);             /* concatenate to X */
      H_pX->_._.N_off = H_pN->_._.N_off;
   }else {                                         /* ifnot */
      sz = H_pX->_.sz;
      H_pX->_._.N_off = N_off;                     /* link X to next  */
   }
   if (X_off == P_off + H_pP->_.sz) {              /* if prev adjacent */
      sz = (H_pP->_.sz += sz);                     /* concatn X to it */
      H_pP->_._.N_off = H_pX->_._.N_off;
   }else {                                         /* ifnot */
      H_pP->_._.N_off = X_off;                     /* link prev to X */
   }
   if (sz >= sp_pC->no_such_sz) sp_pC->no_such_sz = sz + 1;
   GA_sp_pC = sp_pC;                               /* activate this subpool */
}

/*---------------------------------------------------------------------pl_ralo-+
| Reallocate a block allocated by pl_allo                                      |
| If the block must be shrunk, it is guaranteed its address will stay          |
| unchanged.                                                                   |
+-----------------------------------------------------------------------------*/
void * P_FCT pl_ralo(GA_P gbla_p, void *old_p, uint new_sz)
{
   void *new_p;
   register uint X_off;
   uint   sz, old_sz, P_off, N_off;
   SBPOOL *sp_pC;
   HDR    *H_pN, *H_pX;

   old_sz = (H_pX = (HDR *)old_p - 1)->_.sz;
   new_sz = ROUNDED(new_sz);

   if (new_sz >= old_sz) {
      if (new_sz == old_sz) {
         return(old_p);
      }else {
         pl_free(gbla_p,old_p);
         new_p = pl_allo(gbla_p,new_sz);
         if (new_p != old_p) memmove(new_p,old_p,old_sz - sizeof(HDR));
         return(new_p);
      }
   }else {                  /* new_sz < old_sz: must shrink */
      /*---------------------------------------------------+
      |The H_pX block cannot be freed directly by a call to|
      |pl_free, because it could be merged with a previous |
      |free block.  This would violate the rule "shorter   |
      |block are not relocated".  However, the beginning of|
      |this code is similar to (and copied from) "pl_free".|
      +---------------------------------------------------*/
      /*-----------------------------------+
      |look where to insert the freed block|
      |First: find the right subpool, then |
      |find the previous and next free     |
      |block around H_pX.                  |
      +-----------------------------------*/
      {
         register uint id = H_pX->_._.id;             /* Optimized FOR loop */

         sp_pC = (SBPOOL *)GA_sp_pC;
         if (sp_pC->id != id) while ((sp_pC = sp_pC->pN)->id != id);
      }
      P_off = (uchar *)sp_pC->H_pC - (uchar *)sp_pC;
      X_off = (uchar *)H_pX - (uchar *)sp_pC;
      for (;;) {
         N_off = ((HDR *)((uchar *)sp_pC + P_off))->_._.N_off;
         if (X_off > P_off) {
            if ((X_off < N_off) || (P_off >= N_off)) break;
         }else {
            if ((X_off < N_off) && (P_off >= N_off)) break;
         }
         P_off = N_off;
      }

      H_pX->_.sz = new_sz;
      H_pX = (HDR *)((uchar *)H_pX + new_sz);       /* next free block */
      X_off += new_sz;
      sz = old_sz - new_sz;
      /*---------------------------------+
      |Try to merge the freed bottom part|
      |with the next free block          |
      +---------------------------------*/
      if (N_off == X_off + sz) {                   /* if next adjacent */
         H_pN = (HDR *)((uchar *)sp_pC + N_off);
         sz += H_pN->_.sz;                         /* concatenate to X */
         H_pX->_._.N_off = H_pN->_._.N_off;
      }else {                                      /* ifnot */
         H_pX->_._.N_off = N_off;                  /* link X to next  */
      }
      H_pX->_.sz = sz;
                                                   /* link prev to X */
      (sp_pC->H_pC = (HDR *)((uchar *)sp_pC + P_off))->_._.N_off = X_off;
      if (sz >= sp_pC->no_such_sz) sp_pC->no_such_sz = sz + 1;
      GA_sp_pC = sp_pC;                            /* activate this subpool */
      return(old_p);                               /* no other changes */
   }
}
/******************************************************************************/
