/* alloc.c
   C transliteration of parts of the bcpl alloc package
   written by E. McCreight and friends.
   Last modified: Stewart  June 18, 1982  4:08 PM
   Last modified: Swinehart July 19, 1982  4:08 PM, Free(0) is OK, -size means Zero
   Stewart October 4, 1982  10:31 PM
   Stewart November 8, 1982  3:24 PM, extern largest, totav
   Stewart December 28, 1982  11:35 AM, SB.user added
   Stewart December 28, 1982  11:35 AM, wf removed, always Zero
 */

#include	"alloc.h"
#include	"ec.h"

#define data pSbNext
#define lZn (sizeof(struct ZN))
#define lSbOverhead 4	/* offset SB.data in words */
#define lZnOverhead 16   /* lZn + lSbOverhead */
#define offsetSbData 4
#define minLSbFree (sizeof(struct SB))

extern int end;	/* See endml.asm; end of static storage */
extern Zero();
extern Usc();
extern CallSwat();
extern UMax();
extern ReturnLoc();
extern MyFrame();
#define zoneTop	0xCFFE

struct ZN *GetAll() {
  /* Produces a zone from all available memory between the end of 
	statically allocated storage and location zoneTop */
  char *z;
  int len;
  struct ZN *zn;
  z = (char *) (((int) &end+1)&(-2));
  len = zoneTop - ((int) z);
  if (Usc(len, 0x7FFF) > 0) {
	zn = InitializeZone(z, 0x3FF0);
	AddToZone(zn, z+0x7FF0, (len-0x7FF0)>>1);
        };
  else zn = InitializeZone(z, len>>1);
  return(zn);
  };

struct ZN *InitializeZone(z, len)
  struct ZN *z;		/* first available address */
  int len;		/* length in words */
  {
  struct SB *firstfree;
  struct ZN *tempznp;
  z->anchor.length = 0;
  z->anchor.pSbPrevious = z->anchor.pSbNext = &z->anchor;
  /* set firstfree to first address after the ZN struct */
  /* this didn't work: firstfree = (struct SB *) (z+1); */
  tempznp = z+1;  /* first address after header */
  firstfree = (struct SB *) tempznp;
  z->rover = firstfree;
  z->minAdr = (int *) firstfree;
  z->maxAdr = (int *) firstfree;
  AddToZone(z, firstfree, len-(lZn>>1));
  return(z);
  };

AddToZone(z, s, len)
  struct ZN *z;		/* zone itself */
  struct SB *s;		/* first available address */
  int len;		/* available length */
  {
  int lSbFree, *sbLast;
  char *cp;
  len = len << 1;
  lSbFree = len-lSbOverhead;
  /* debugging */
  if ((lSbFree < minLSbFree) || (Usc(len, 077774) > 0)) CallSwat(ecAllocate+ 1);
  cp = (char *) s;
  cp = cp+lSbFree;
  sbLast = (int *) cp; /* address of the -1 */
  *sbLast = -1;	/* last word of free space */
  /* debugging */
  {
  int *min, *max, ti, tib;
  min = z->minAdr;
  if (Usc(s, min) < 0) {
    if (Usc(sbLast, min) >= 0) CallSwat(ecAllocate+2);
    ti = (int) sbLast;
    tib = (int) min;
    ti = ti - tib;
    *sbLast = ti;
    z->minAdr = (int *) s;
    };
  else {
    max = z->maxAdr;
    if (Usc(s, max) < 0) CallSwat(ecAllocate+3);
    ti = (int) max;
    tib = (int) s;
    ti = ti - tib;
    *max = ti;
    z->maxAdr = (int *) sbLast;
    };
  };
  s->length = -lSbFree;
  Free(z, &s->data);
  };

extern int largest
extern int totAv;

#asm
_Allocate:
#endasm

/* int *Allocate(z, ln) struct ZN *z; int ln; { return Alloc(z, ln); }; */
int *Alloc(z, numWords)
  struct ZN *z;
  int numWords;
  {
  int lSbData, ia, ib, lSb, extra, siz, zeroRqst;
  struct SB *s, *sbRover, *sbOriginalRover, *sbNext;
  largest = totAv = zeroRqst = 0;
  if (numWords<0 && numWords>=-2000) { numWords = -numWords; zeroRqst=-1; };
  lSbData = numWords << 1;
  if (numWords==0) lSbData = 0xFFF0; /* Testing largest avail. */
  lSb = UMax(lSbData + lSbOverhead, minLSbFree)
  /* CheckZone(z, 0) */
  sbOriginalRover = sbRover = z->rover;
  /* do { with } while (sbRover != sbOriginalRover); at end didn't work */
  for (;;)  {
  for (;;) {
    /* loop while next neighbor is free, coalescing with rover */
    /* next line didn't work */
    /* sbNext = (struct SB *) (((int *) sbRover) + sbRover->length); */
    ia = (int) sbRover;
    ia = ia + sbRover->length; 
    sbNext = (struct SB *) ia;
    if (sbNext->length <= 0) break;
    if (sbNext == sbOriginalRover) sbOriginalRover = sbNext->pSbNext;
    /* remove sbNext from his chains */
    sbNext->pSbNext->pSbPrevious = sbNext->pSbPrevious;
    sbNext->pSbPrevious->pSbNext = sbNext->pSbNext;
    // and add him to us
    sbRover->length += sbNext->length;
    };
  /* next line didn't work */
  /* s = (struct SB *) (((int *) sbNext) - lSb); */
  ia = (int) sbNext;
  ia = ia - lSb;
  s = (struct SB *) ia;
  /* extra and siz are integer numbers of words */
  /* check code generated by next two lines! */
  ib = (int) sbRover;
  extra = ia - ib;
  ia = (int) sbNext;
  siz = ia - ib; /* (int *) sbNext - (int *) sbRover */
  largest = UMax(siz, largest);
  totAv += siz;
  /* loop if block not big enough, or if request too large
     to be legal. */
  if ((extra < 0) || (lSb < 0)) {
    sbRover = sbRover->pSbNext;
    if (sbRover == sbOriginalRover) break;
    continue;
    };

  if (extra >= minLSbFree) {
    /* split block */
    sbRover->length = extra;
    z->rover = sbRover;
    /* set length and mark new block used */
    s->length = -lSb;
    };
  else {
    /* remove rover from his chains */
    sbRover->pSbNext->pSbPrevious = sbRover->pSbPrevious;
    sbRover->pSbPrevious->pSbNext = sbRover->pSbNext;
    z->rover = sbRover->pSbNext;
    /* and mark the new block used */
    s = sbRover;
    s->length = (-s->length);
    };
  s->user = ReturnLoc(MyFrame());   /* survey of callers of Alloc */
  ia = ((int) s) + offsetSbData;
  /* if (zeroRqst) (always!) */
  Zero(ia, numWords);
  return (ia);
  }; /* didn't work:  while (sbRover != sbOriginalRover); */
  z->rover = sbRover;
  if (numWords!=0) CallSwat(ecAllocate+5);
  /* numWords was 0; caller wanted to set up totAv and largest */
  return 0;
  };

Free(z, s)
  struct ZN *z;
  int *s;
  {
  struct SB *sbp, *sbAnchor, *sbT;
  int ia;
  /* boundary tag */
  /* next line didn't work */
  /* sbp = (struct SB *) (s-offsetSbData);  */
  if (s==0) return; /* God damn it! */
  ia = (int) s;
  ia = ia-offsetSbData;
  sbp = (struct SB *) ia;
  if (sbp->length >= 0) CallSwat(ecAllocate+6);
  sbAnchor = &z->anchor;
  CheckZone(z, 0);
  /* mark the block free */
  sbp->length = -sbp->length;
  CheckBounds(z, sbp);
  CheckFreeNode(z, sbAnchor);
  /* insert between anchor and anchor.next */
  sbT = sbAnchor->pSbNext;
  sbp->pSbPrevious = sbAnchor;
  sbp->pSbNext = sbT;
  sbAnchor->pSbNext = sbp;
  sbT->pSbPrevious = sbp;
  };

CheckZone(z, p)
  struct ZN *z;
  int p;
  {
  int freecount, addit, ia, cnt;
  struct SB *s, *sbAnchor;
  if (*z->maxAdr != -1) CallSwat(ecAllocate+7);
  freecount = 0;
  ia = (int) z->minAdr;
  s = (struct SB *) ia;
  for (;;) {
    if (Usc(z->maxAdr, s) <= 0) break;
    addit = s->length;
    if (addit >= 0) {
/*
      if (p) wf4("%04x, %5d, %04x, %04x\r", s, addit, s->pSbPrevious, s->pSbNext);
 */
      CheckFreeNode(z, s);
      freecount += 1;
      };
    else {
      addit = (-addit);
/*
      if (p) wf2("%04x, %5d\r", s, addit);
 */
      };
    ia = ia+addit;
    if (Usc(ia, s) <= 0) CallSwat(ecAllocate+8);
    s = (struct SB *) ia;
    };
  if (((int *) s) != z->maxAdr) CallSwat(ecAllocate+9);
  /* go through free list, checking, decrementing free count */
  cnt = -22000;
  sbAnchor = &z->anchor;
  s = sbAnchor->pSbNext;
  for (;;) {
    if (s == sbAnchor) break;
    CheckFreeNode(z, s);
    freecount -= 1;
    cnt -= 1;
    if (cnt == 0) CallSwat(ecAllocate+10);
    s = s->pSbNext;
    };
  if (freecount != 0) CallSwat(ecAllocate+11);
  };

CheckFreeNode(z, s)
  struct ZN *z;
  struct SB *s;
  {
  CheckBounds(z, s);
  CheckBounds(z, s->pSbNext);
  CheckBounds(z, s->pSbPrevious);
  if ((s != &z->anchor) && (s->length < minLSbFree)) CallSwat(ecAllocate+12);
  if (s->pSbNext->pSbPrevious != s) CallSwat(ecAllocate+13);
  };

CheckBounds(z, s)
  struct ZN *z;
  struct SB *s;
  {
  int tip;
  if (s != &z->anchor) {
    tip = (int) s;
    if ((Usc(tip+s->length, z->maxAdr) > 0) || (Usc(s, z->minAdr) < 0)) CallSwat(ecAllocate+14);
    };
  };

#asm
PUBLIC _Allocate
#endasm