/* poollo.c: LEAF POOL CLASS
 *
 * $Id$
 * Copyright (c) 2001-2020 Ravenbrook Limited.  See end of file for license.
 *
 * DESIGN
 *
 * .design: <design/poollo>.  This is a leaf pool class.
 */

#include "mpsclo.h"
#include "mpm.h"
#include "mps.h"

SRCID(poollo, "$Id$");


/* LOStruct -- leaf object pool instance structure */

#define LOSig           ((Sig)0x51970B07) /* SIGnature LO POoL */

typedef struct LOStruct *LO;

typedef struct LOStruct {
  PoolStruct poolStruct;        /* generic pool structure */
  PoolGenStruct pgenStruct;     /* generation representing the pool */
  PoolGen pgen;                 /* NULL or pointer to pgenStruct */
  Sig sig;                      /* design.mps.sig.field.end.outer */
} LOStruct;

typedef LO LOPool;
#define LOPoolCheck LOCheck
DECLARE_CLASS(Pool, LOPool, AbstractCollectPool);
DECLARE_CLASS(Seg, LOSeg, MutatorSeg);


/* forward declaration */
static Bool LOCheck(LO lo);


/* LOGSegStruct -- LO segment structure
 *
 * Colour is represented as follows:
 * Black: +alloc +mark
 * White: +alloc -mark
 * Grey: objects have no references so can't be grey
 * Free: -alloc ?mark
 */

typedef struct LOSegStruct *LOSeg;

#define LOSegSig      ((Sig)0x519705E9) /* SIGnature LO SEG */

typedef struct LOSegStruct {
  GCSegStruct gcSegStruct;  /* superclass fields must come first */
  BT mark;                  /* mark bit table */
  BT alloc;                 /* alloc bit table */
  Count freeGrains;         /* free grains */
  Count bufferedGrains;     /* grains in buffers */
  Count newGrains;          /* grains allocated since last collection */
  Count oldGrains;          /* grains allocated prior to last collection */
  Sig sig;                  /* design.mps.sig.field.end.outer */
} LOSegStruct;


/* forward decls */
static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args);
static void loSegFinish(Inst inst);
static Count loSegGrains(LOSeg loseg);
static Bool loSegBufferFill(Addr *baseReturn, Addr *limitReturn,
                            Seg seg, Size size, RankSet rankSet);
static void loSegBufferEmpty(Seg seg, Buffer buffer);
static Res loSegWhiten(Seg seg, Trace trace);
static Res loSegScan(Bool *totalReturn, Seg seg, ScanState ss);
static Res loSegFix(Seg seg, ScanState ss, Ref *refIO);
static void loSegReclaim(Seg seg, Trace trace);
static void loSegWalk(Seg seg, Format format, FormattedObjectsVisitor f,
                      void *p, size_t s);


/* LOSegClass -- Class definition for LO segments */

DEFINE_CLASS(Seg, LOSeg, klass)
{
  INHERIT_CLASS(klass, LOSeg, MutatorSeg);
  SegClassMixInNoSplitMerge(klass);
  klass->instClassStruct.finish = loSegFinish;
  klass->size = sizeof(LOSegStruct);
  klass->init = loSegInit;
  klass->bufferFill = loSegBufferFill;
  klass->bufferEmpty = loSegBufferEmpty;
  klass->whiten = loSegWhiten;
  klass->scan = loSegScan;
  klass->fix = loSegFix;
  klass->fixEmergency = loSegFix;
  klass->reclaim = loSegReclaim;
  klass->walk = loSegWalk;
  AVERT(SegClass, klass);
}


/* LOSegCheck -- check an LO segment */

ATTRIBUTE_UNUSED
static Bool LOSegCheck(LOSeg loseg)
{
  Seg seg = MustBeA(Seg, loseg);
  Pool pool = SegPool(seg);
  CHECKS(LOSeg, loseg);
  CHECKD(GCSeg, &loseg->gcSegStruct);
  CHECKL(loseg->mark != NULL);
  CHECKL(loseg->alloc != NULL);
  /* Could check exactly how many bits are set in the alloc table. */
  CHECKL(loseg->freeGrains + loseg->bufferedGrains + loseg->newGrains
         + loseg->oldGrains
         == PoolSizeGrains(pool, SegSize(seg)));
  return TRUE;
}


/* loSegInit -- Init method for LO segments */

static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
{
  LOSeg loseg;
  Res res;
  Size tableSize;      /* # bytes in each control array */
  Arena arena = PoolArena(pool);
  /* number of bits needed in each control array */
  Count grains;
  void *p;

  /* Initialize the superclass fields first via next-method call */
  res = NextMethod(Seg, LOSeg, init)(seg, pool, base, size, args);
  if(res != ResOK)
    goto failSuperInit;
  loseg = CouldBeA(LOSeg, seg);

  AVER(SegWhite(seg) == TraceSetEMPTY);

  grains = PoolSizeGrains(pool, size);
  tableSize = BTSize(grains);
  res = ControlAlloc(&p, arena, 2 * tableSize);
  if(res != ResOK)
    goto failControlAlloc;
  loseg->mark = p;
  loseg->alloc = PointerAdd(p, tableSize);
  BTResRange(loseg->alloc, 0, grains);
  loseg->freeGrains = grains;
  loseg->bufferedGrains = (Count)0;
  loseg->newGrains = (Count)0;
  loseg->oldGrains = (Count)0;

  SetClassOfPoly(seg, CLASS(LOSeg));
  loseg->sig = LOSegSig;
  AVERC(LOSeg, loseg);

  return ResOK;

failControlAlloc:
  NextMethod(Inst, LOSeg, finish)(MustBeA(Inst, seg));
failSuperInit:
  AVER(res != ResOK);
  return res;
}


/* loSegFinish -- Finish method for LO segments */

static void loSegFinish(Inst inst)
{
  Seg seg = MustBeA(Seg, inst);
  LOSeg loseg = MustBeA(LOSeg, seg);
  Pool pool = SegPool(seg);
  Arena arena = PoolArena(pool);
  Size tablesize;
  Count grains;

  loseg->sig = SigInvalid;

  grains = loSegGrains(loseg);
  tablesize = BTSize(grains);
  ControlFree(arena, loseg->mark, 2 * tablesize);

  NextMethod(Inst, LOSeg, finish)(inst);
}


ATTRIBUTE_UNUSED
static Count loSegGrains(LOSeg loseg)
{
  Seg seg = MustBeA(Seg, loseg);
  Pool pool = SegPool(seg);
  Size size = SegSize(seg);
  return PoolSizeGrains(pool, size);
}


/* loSegBufferFill -- try filling buffer from segment */

static Bool loSegBufferFill(Addr *baseReturn, Addr *limitReturn,
                            Seg seg, Size size, RankSet rankSet)
{
  Index baseIndex, limitIndex;
  LOSeg loseg = MustBeA_CRITICAL(LOSeg, seg);
  Pool pool = SegPool(seg);
  Count requestedGrains, segGrains, allocatedGrains;
  Addr segBase, base, limit;

  AVER_CRITICAL(baseReturn != NULL);
  AVER_CRITICAL(limitReturn != NULL);
  AVER_CRITICAL(SizeIsAligned(size, PoolAlignment(pool)));
  AVER_CRITICAL(size > 0);
  AVER_CRITICAL(rankSet == RankSetEMPTY);

  requestedGrains = PoolSizeGrains(pool, size);
  if (loseg->freeGrains < requestedGrains)
    /* Not enough space to satisfy the request. */
    return FALSE;

  if (SegHasBuffer(seg))
    /* Don't bother trying to allocate from a buffered segment */
    return FALSE;

  segGrains = PoolSizeGrains(pool, SegSize(seg));
  if (loseg->freeGrains == segGrains) {
    /* Whole segment is free: no need for a search. */
    baseIndex = 0;
    limitIndex = segGrains;
    goto found;
  }

  if (!BTFindLongResRange(&baseIndex, &limitIndex, loseg->alloc,
                          0, segGrains, requestedGrains))
    return FALSE;

found:
  AVER(baseIndex < limitIndex);
  allocatedGrains = limitIndex - baseIndex;
  AVER(requestedGrains <= allocatedGrains);
  AVER(BTIsResRange(loseg->alloc, baseIndex, limitIndex));
  /* Objects are allocated black. */
  /* TODO: This should depend on trace phase. */
  BTSetRange(loseg->alloc, baseIndex, limitIndex);
  BTSetRange(loseg->mark, baseIndex, limitIndex);
  AVER(loseg->freeGrains >= allocatedGrains);
  loseg->freeGrains -= allocatedGrains;
  loseg->bufferedGrains += allocatedGrains;

  segBase = SegBase(seg);
  base = PoolAddrOfIndex(segBase, pool, baseIndex);
  limit = PoolAddrOfIndex(segBase, pool, limitIndex);
  PoolGenAccountForFill(PoolSegPoolGen(pool, seg), AddrOffset(base, limit));

  *baseReturn = base;
  *limitReturn = limit;
  return TRUE;
}


/* loSegBufferEmpty -- empty buffer to segment */

static void loSegBufferEmpty(Seg seg, Buffer buffer)
{
  LOSeg loseg = MustBeA(LOSeg, seg);
  Pool pool = SegPool(seg);
  Addr segBase, bufferBase, init, limit;
  Index initIndex, limitIndex;
  Count unusedGrains, usedGrains;

  AVERT(Seg, seg);
  AVERT(Buffer, buffer);
  segBase = SegBase(seg);
  bufferBase = BufferBase(buffer);
  init = BufferGetInit(buffer);
  limit = BufferLimit(buffer);
  AVER(segBase <= bufferBase);
  AVER(bufferBase <= init);
  AVER(init <= limit);
  AVER(limit <= SegLimit(seg));

  initIndex = PoolIndexOfAddr(segBase, pool, init);
  limitIndex = PoolIndexOfAddr(segBase, pool, limit);

  if (initIndex < limitIndex)
    BTResRange(loseg->alloc, initIndex, limitIndex);

  unusedGrains = limitIndex - initIndex;
  AVER(unusedGrains <= loseg->bufferedGrains);
  usedGrains = loseg->bufferedGrains - unusedGrains;
  loseg->freeGrains += unusedGrains;
  loseg->bufferedGrains = 0;
  loseg->newGrains += usedGrains;

  PoolGenAccountForEmpty(PoolSegPoolGen(pool, seg),
                         PoolGrainsSize(pool, usedGrains),
                         PoolGrainsSize(pool, unusedGrains), FALSE);
}


/* loSegReclaim -- reclaim white objects in an LO segment
 *
 * Could consider implementing this using Walk.
 */

static void loSegReclaim(Seg seg, Trace trace)
{
  LOSeg loseg = MustBeA(LOSeg, seg);
  Pool pool = SegPool(seg);
  PoolGen pgen = PoolSegPoolGen(pool, seg);
  Addr p, base, limit;
  Buffer buffer;
  Bool hasBuffer = SegBuffer(&buffer, seg);
  Count reclaimedGrains = (Count)0;
  Format format = NULL; /* suppress "may be used uninitialized" warning */
  STATISTIC_DECL(Count preservedInPlaceCount = (Count)0)
  Size preservedInPlaceSize = (Size)0;
  Bool b;

  AVERT(Trace, trace);

  base = SegBase(seg);
  limit = SegLimit(seg);

  b = PoolFormat(&format, pool);
  AVER(b);

  /* i is the index of the current pointer,
   * p is the actual address that is being considered.
   * j and q act similarly for a pointer which is used to
   * point at the end of the current object.
   */
  p = base;
  while(p < limit) {
    Addr q;
    Index i;

    if (hasBuffer) {
      if (p == BufferScanLimit(buffer)
          && BufferScanLimit(buffer) != BufferLimit(buffer)) {
        /* skip over buffered area */
        p = BufferLimit(buffer);
        continue;
      }
      /* since we skip over the buffered area we are always */
      /* either before the buffer, or after it, never in it */
      AVER(p < BufferGetInit(buffer) || BufferLimit(buffer) <= p);
    }
    i = PoolIndexOfAddr(base, pool, p);
    if(!BTGet(loseg->alloc, i)) {
      /* This grain is free */
      p = AddrAdd(p, pool->alignment);
      continue;
    }
    q = (*format->skip)(AddrAdd(p, format->headerSize));
    q = AddrSub(q, format->headerSize);
    if(BTGet(loseg->mark, i)) {
      STATISTIC(++preservedInPlaceCount);
      preservedInPlaceSize += AddrOffset(p, q);
    } else {
      Index j = PoolIndexOfAddr(base, pool, q);
      /* This object is not marked, so free it */
      BTResRange(loseg->alloc, i, j);
      reclaimedGrains += j - i;
    }
    p = q;
  }
  AVER(p == limit);

  AVER(reclaimedGrains <= loSegGrains(loseg));
  AVER(loseg->oldGrains >= reclaimedGrains);
  loseg->oldGrains -= reclaimedGrains;
  loseg->freeGrains += reclaimedGrains;
  PoolGenAccountForReclaim(pgen, PoolGrainsSize(pool, reclaimedGrains), FALSE);

  STATISTIC(trace->reclaimSize += PoolGrainsSize(pool, reclaimedGrains));
  STATISTIC(trace->preservedInPlaceCount += preservedInPlaceCount);
  GenDescSurvived(pgen->gen, trace, 0, preservedInPlaceSize);
  SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));

  if (loseg->freeGrains == PoolSizeGrains(pool, SegSize(seg)) && !hasBuffer) {
    AVER(loseg->bufferedGrains == 0);
    PoolGenFree(pgen, seg,
                PoolGrainsSize(pool, loseg->freeGrains),
                PoolGrainsSize(pool, loseg->oldGrains),
                PoolGrainsSize(pool, loseg->newGrains),
                FALSE);
  }
}

/* Walks over _all_ objects in the segnent: whether they are black or
 * white, they are still validly formatted as this is a leaf pool, so
 * there can't be any dangling references.
 */
static void loSegWalk(Seg seg, Format format, FormattedObjectsVisitor f,
                      void *p, size_t s)
{
  Addr base;
  LOSeg loseg = MustBeA(LOSeg, seg);
  Pool pool = SegPool(seg);
  Index i, grains;

  AVERT(Format, format);
  AVER(FUNCHECK(f));
  /* p and s are arbitrary closures and can't be checked */

  base = SegBase(seg);
  grains = loSegGrains(loseg);
  i = 0;

  while(i < grains) {
    /* object is a slight misnomer because it might point to a */
    /* free grain */
    Addr object = PoolAddrOfIndex(base, pool, i);
    Addr next;
    Index j;
    Buffer buffer;

    if (SegBuffer(&buffer, seg)) {
      if(object == BufferScanLimit(buffer) &&
         BufferScanLimit(buffer) != BufferLimit(buffer)) {
        /* skip over buffered area */
        object = BufferLimit(buffer);
        i = PoolIndexOfAddr(base, pool, object);
        continue;
      }
      /* since we skip over the buffered area we are always */
      /* either before the buffer, or after it, never in it */
      AVER(object < BufferGetInit(buffer) || BufferLimit(buffer) <= object);
    }
    if(!BTGet(loseg->alloc, i)) {
      /* This grain is free */
      ++i;
      continue;
    }
    object = AddrAdd(object, format->headerSize);
    next = (*format->skip)(object);
    next = AddrSub(next, format->headerSize);
    j = PoolIndexOfAddr(base, pool, next);
    AVER(i < j);
    (*f)(object, pool->format, pool, p, s);
    i = j;
  }
}


/* LOVarargs -- decode obsolete varargs */

static void LOVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs)
{
  args[0].key = MPS_KEY_FORMAT;
  args[0].val.format = va_arg(varargs, Format);
  args[1].key = MPS_KEY_ARGS_END;
  AVERT(ArgList, args);
}


/* LOInit -- initialize an LO pool */

static Res LOInit(Pool pool, Arena arena, PoolClass klass, ArgList args)
{
  LO lo;
  Res res;
  ArgStruct arg;
  Chain chain;
  unsigned gen = LO_GEN_DEFAULT;

  AVER(pool != NULL);
  AVERT(Arena, arena);
  AVERT(ArgList, args);
  UNUSED(klass); /* used for debug pools only */

  res = NextMethod(Pool, LOPool, init)(pool, arena, klass, args);
  if (res != ResOK)
    goto failNextInit;
  lo = CouldBeA(LOPool, pool);

  /* Ensure a format was supplied in the argument list. */
  AVER(pool->format != NULL);

  if (ArgPick(&arg, args, MPS_KEY_CHAIN))
    chain = arg.val.chain;
  else {
    chain = ArenaGlobals(arena)->defaultChain;
    gen = 1; /* avoid the nursery of the default chain by default */
  }
  if (ArgPick(&arg, args, MPS_KEY_GEN))
    gen = arg.val.u;

  AVERT(Format, pool->format);
  AVER(FormatArena(pool->format) == arena);
  AVERT(Chain, chain);
  AVER(gen <= ChainGens(chain));
  AVER(chain->arena == arena);

  pool->alignment = pool->format->alignment;
  pool->alignShift = SizeLog2(pool->alignment);

  lo->pgen = NULL;

  SetClassOfPoly(pool, CLASS(LOPool));
  lo->sig = LOSig;
  AVERC(LOPool, lo);

  res = PoolGenInit(&lo->pgenStruct, ChainGen(chain, gen), pool);
  if (res != ResOK)
    goto failGenInit;
  lo->pgen = &lo->pgenStruct;

  EVENT2(PoolInitLO, pool, pool->format);

  return ResOK;

failGenInit:
  NextMethod(Inst, LOPool, finish)(MustBeA(Inst, pool));
failNextInit:
  AVER(res != ResOK);
  return res;
}


/* LOFinish -- finish an LO pool */

static void LOFinish(Inst inst)
{
  Pool pool = MustBeA(AbstractPool, inst);
  LO lo = MustBeA(LOPool, pool);
  Ring node, nextNode;

  RING_FOR(node, &pool->segRing, nextNode) {
    Seg seg = SegOfPoolRing(node);
    LOSeg loseg = MustBeA(LOSeg, seg);
    AVER(!SegHasBuffer(seg));
    AVERT(LOSeg, loseg);
    AVER(loseg->bufferedGrains == 0);
    PoolGenFree(lo->pgen, seg,
                PoolGrainsSize(pool, loseg->freeGrains),
                PoolGrainsSize(pool, loseg->oldGrains),
                PoolGrainsSize(pool, loseg->newGrains),
                FALSE);
  }
  PoolGenFinish(lo->pgen);

  lo->sig = SigInvalid;

  NextMethod(Inst, LOPool, finish)(inst);
}


static Res LOBufferFill(Addr *baseReturn, Addr *limitReturn,
                        Pool pool, Buffer buffer,
                        Size size)
{
  LO lo = MustBeA(LOPool, pool);
  Res res;
  Ring node, nextNode;
  RankSet rankSet;
  Seg seg;
  Bool b;

  AVER(baseReturn != NULL);
  AVER(limitReturn != NULL);
  AVERC(Buffer, buffer);
  AVER(BufferIsReset(buffer));
  AVER(BufferRankSet(buffer) == RankSetEMPTY);
  AVER(size > 0);
  AVER(SizeIsAligned(size, PoolAlignment(pool)));

  /* Try to find a segment with enough space already. */
  rankSet = BufferRankSet(buffer);
  RING_FOR(node, PoolSegRing(pool), nextNode) {
    seg = SegOfPoolRing(node);
    if (SegBufferFill(baseReturn, limitReturn, seg, size, rankSet))
      return ResOK;
  }

  /* No segment had enough space, so make a new one. */
  res = PoolGenAlloc(&seg, lo->pgen, CLASS(LOSeg),
                     SizeArenaGrains(size, PoolArena(pool)),
                     argsNone);
  if (res != ResOK)
    return res;
  b = SegBufferFill(baseReturn, limitReturn, seg, size, rankSet);
  AVER(b);
  return ResOK;
}


/* Synchronise the buffer with the alloc Bit Table in the segment. */


/* loSegPoolGen -- get pool generation for an LO segment */

static PoolGen loSegPoolGen(Pool pool, Seg seg)
{
  LO lo = MustBeA(LOPool, pool);
  AVERT(Seg, seg);
  return lo->pgen;
}


/* loSegWhiten -- whiten a segment */

static Res loSegWhiten(Seg seg, Trace trace)
{
  LOSeg loseg = MustBeA(LOSeg, seg);
  Pool pool = SegPool(seg);
  PoolGen pgen = PoolSegPoolGen(pool, seg);
  Buffer buffer;
  Count grains, agedGrains, uncondemnedGrains;

  AVERT(Trace, trace);
  AVER(SegWhite(seg) == TraceSetEMPTY);

  grains = loSegGrains(loseg);

  /* Whiten allocated objects; leave free areas black. */
  if (SegBuffer(&buffer, seg)) {
    Addr base = SegBase(seg);
    Index scanLimitIndex = PoolIndexOfAddr(base, pool, BufferScanLimit(buffer));
    Index limitIndex = PoolIndexOfAddr(base, pool, BufferLimit(buffer));
    uncondemnedGrains = limitIndex - scanLimitIndex;
    if (0 < scanLimitIndex)
      BTCopyInvertRange(loseg->alloc, loseg->mark, 0, scanLimitIndex);
    if (limitIndex < grains)
      BTCopyInvertRange(loseg->alloc, loseg->mark, limitIndex, grains);
  } else {
    uncondemnedGrains = (Count)0;
    BTCopyInvertRange(loseg->alloc, loseg->mark, 0, grains);
  }

  /* The unused part of the buffer remains buffered: the rest becomes old. */
  AVER(loseg->bufferedGrains >= uncondemnedGrains);
  agedGrains = loseg->bufferedGrains - uncondemnedGrains;
  PoolGenAccountForAge(pgen, PoolGrainsSize(pool, agedGrains),
                       PoolGrainsSize(pool, loseg->newGrains), FALSE);
  loseg->oldGrains += agedGrains + loseg->newGrains;
  loseg->bufferedGrains = uncondemnedGrains;
  loseg->newGrains = 0;

  if (loseg->oldGrains > 0) {
    GenDescCondemned(pgen->gen, trace,
                     PoolGrainsSize(pool, loseg->oldGrains));
    SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
  }

  return ResOK;
}


static Res loSegScan(Bool *totalReturn, Seg seg, ScanState ss)
{
  LOSeg loseg = MustBeA(LOSeg, seg);
  Pool pool = SegPool(seg);
  Addr p, base, limit;
  Buffer buffer;
  Bool hasBuffer = SegBuffer(&buffer, seg);
  Format format = NULL; /* suppress "may be used uninitialized" warning */
  Bool b;

  AVER(totalReturn != NULL);
  AVERT(Seg, seg);
  AVERT(ScanState, ss);

  base = SegBase(seg);
  limit = SegLimit(seg);

  b = PoolFormat(&format, pool);
  AVER(b);

  p = base;
  while (p < limit) {
    Addr q;
    Index i;

    if (hasBuffer) {
      if (p == BufferScanLimit(buffer)
          && BufferScanLimit(buffer) != BufferLimit(buffer)) {
        /* skip over buffered area */
        p = BufferLimit(buffer);
        continue;
      }
      /* since we skip over the buffered area we are always */
      /* either before the buffer, or after it, never in it */
      AVER(p < BufferGetInit(buffer) || BufferLimit(buffer) <= p);
    }
    i = PoolIndexOfAddr(base, pool, p);
    if (!BTGet(loseg->alloc, i)) {
      p = AddrAdd(p, PoolAlignment(pool));
      continue;
    }
    q = (*format->skip)(AddrAdd(p, format->headerSize));
    q = AddrSub(q, format->headerSize);
    if (BTGet(loseg->mark, i)) {
      Res res = TraceScanFormat(ss, p, q);
      if (res != ResOK)
        return res;
    }
    p = q;
  }
  AVER(p == limit);

  return ResOK;
}


static Res loSegFix(Seg seg, ScanState ss, Ref *refIO)
{
  LOSeg loseg = MustBeA_CRITICAL(LOSeg, seg);
  Pool pool = SegPool(seg);
  Ref clientRef;
  Addr base;
  Index i;

  AVERT_CRITICAL(ScanState, ss);
  AVER_CRITICAL(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY);
  AVER_CRITICAL(refIO != NULL);

  clientRef = *refIO;
  base = AddrSub((Addr)clientRef, pool->format->headerSize);

  /* Not a real reference if out of bounds. This can happen if an
     ambiguous reference is closer to the base of the segment than the
     header size. */
  if (base < SegBase(seg)) {
    AVER(ss->rank == RankAMBIG);
    return ResOK;
  }

  /* Not a real reference if unaligned. */
  if (!AddrIsAligned(base, PoolAlignment(pool))) {
    AVER(ss->rank == RankAMBIG);
    return ResOK;
  }

  i = PoolIndexOfAddr(SegBase(seg), pool, base);

  /* Not a real reference if unallocated. */
  if (!BTGet(loseg->alloc, i)) {
    AVER(ss->rank == RankAMBIG);
    return ResOK;
  }

  if(!BTGet(loseg->mark, i)) {
    ss->wasMarked = FALSE;  /* <design/fix#.was-marked.not> */
    if(ss->rank == RankWEAK) {
      *refIO = (Addr)0;
    } else {
      BTSet(loseg->mark, i);
    }
  }

  return ResOK;
}


/* LOTotalSize -- total memory allocated from the arena */
/* TODO: This code is repeated in AMS */

static Size LOTotalSize(Pool pool)
{
  LO lo = MustBeA(LOPool, pool);
  return lo->pgen->totalSize;
}


/* LOFreeSize -- free memory (unused by client program) */
/* TODO: This code is repeated in AMS */

static Size LOFreeSize(Pool pool)
{
  LO lo = MustBeA(LOPool, pool);
  return lo->pgen->freeSize;
}


/* LOPoolClass -- the class definition */

DEFINE_CLASS(Pool, LOPool, klass)
{
  INHERIT_CLASS(klass, LOPool, AbstractCollectPool);
  klass->instClassStruct.finish = LOFinish;
  klass->size = sizeof(LOStruct);
  klass->varargs = LOVarargs;
  klass->init = LOInit;
  klass->bufferFill = LOBufferFill;
  klass->segPoolGen = loSegPoolGen;
  klass->totalSize = LOTotalSize;
  klass->freeSize = LOFreeSize;
  AVERT(PoolClass, klass);
}


/* mps_class_lo -- the external interface to get the LO pool class */

mps_pool_class_t mps_class_lo(void)
{
  return (mps_pool_class_t)CLASS(LOPool);
}


/* LOCheck -- check an LO pool */

ATTRIBUTE_UNUSED
static Bool LOCheck(LO lo)
{
  CHECKS(LO, lo);
  CHECKC(LOPool, lo);
  CHECKD(Pool, &lo->poolStruct);
  CHECKC(LOPool, lo);
  if (lo->pgen != NULL) {
    CHECKL(lo->pgen == &lo->pgenStruct);
    CHECKD(PoolGen, lo->pgen);
  }
  return TRUE;
}


/* C. COPYRIGHT AND LICENSE
 *
 * Copyright (C) 2001-2020 Ravenbrook Limited <https://www.ravenbrook.com/>.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 *
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the
 *    distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
 * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */