-- Misc>ZoneImpl.mesa  (last edited by Luniewski on February 5, 1981  6:59 PM)

-- *** TO DO: ***
-- 1) Remove kludges for wrongSeal and wrongVersion statuses
-- 2) Make Zone.Handle be an exported type
-- 3) Make Recreate smarter (see comment above code)

-- A set of procedures to manage allocation within a zone.
-- Coalescing of free nodes occurs during allocation; all free nodes
-- following a candidate node are merged before any space is allocated.  The
-- logic is derived from a BCPL program by E. M. McCreight and was suggested
-- by an exercise in Knuth Volume I, p. 453 #19
--	This version was adapted for Pilot from the Free Storage Package of
-- the Mesa 4.0 System.  The principle differences are: (1) the zone is
-- managed in terms of 16-bit RELATIVE POINTERs relative to a client supplied
-- BASE; (2) no SIGNALs are raised, since the implementation is used by
-- resident parts of Pilot which cannot invoke the Signaller, and (3) the
-- mechanism for adding space to a zone is changed.

DIRECTORY
  Inline USING [BITAND, BITSHIFT, LongNumber],
  Process USING [InitializeMonitor],
  MiscPrograms USING [],
  Zone USING [Alignment, Base, BlockSize, Handle, SegmentHandle, Status],
  ZoneInternal USING [
    FreeNodePointer, InuseNodePointer, NodeHeader, NodePointer, OrderedBase,
    RPtr, SegmentHeader, SegmentPointer, ZoneHeader, ZonePointer, zoneSeal,
    zoneVersion];

ZoneImpl: MONITOR
  LOCKS LOOPHOLE[zH, ZoneInternal.ZonePointer].LOCK USING zH: Zone.Handle
  IMPORTS Inline, Process EXPORTS MiscPrograms, Zone, ZoneInternal =
BEGIN OPEN ZoneInternal;

-- ***TEMPORARY*** remove at next build, make Zone right...
StatusKludge: TYPE = CARDINAL [0..17B];
wrongSeal: Zone.Status =
  LOOPHOLE[LOOPHOLE[Zone.Status[nodeLoop], StatusKludge]+1];
wrongVersion: Zone.Status =
  LOOPHOLE[LOOPHOLE[Zone.Status[nodeLoop], StatusKludge]+2];

usedNodeSize: Zone.BlockSize = SIZE[inuse NodeHeader];
freeNodeSize: Zone.BlockSize = SIZE[free NodeHeader];
zoneHeaderSize: Zone.BlockSize = SIZE[ZoneHeader];
segmentHeaderSize: Zone.BlockSize = SIZE[SegmentHeader];
zoneOverhead: CARDINAL =
  SIZE[ZoneHeader] + SIZE[inuse NodeHeader];
nodeOverhead: CARDINAL = SIZE[inuse NodeHeader];
  -- NOTE: A zone whose largest possible node is N words, must have
  -- N + zoneOverhead + nodeOverhead words of storage
nilSeg: SegmentPointer = LOOPHOLE[0];
orderedRelativeNil: OrderedBase RELATIVE POINTER = LOOPHOLE[0];

-- Exported (READONLY) variables
minimumNodeSize: PUBLIC Zone.BlockSize _ freeNodeSize;
nil: PUBLIC Zone.Base RELATIVE POINTER _ LOOPHOLE[0];
nullSegment: PUBLIC Zone.SegmentHandle _ LOOPHOLE[nilSeg];

-- Module initialization:
--MiscPrograms.--InitializeZone: PUBLIC PROC =
  {--may be something here eventually--};

-- procedures

AddSegment: PUBLIC ENTRY PROC
  [zH: Zone.Handle, storage: LONG POINTER, length: Zone.BlockSize]
  RETURNS [sH: Zone.SegmentHandle, s: Zone.Status] =
  -- Adds a segment to the zone zH.  The storage must be capable of being
  -- addressed with 16-bit pointers relative to the zoneBase of the zone.
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  st: LONG ORDERED POINTER = LOOPHOLE[storage];
  sp: SegmentPointer = Relative[zb, st];
  fn: FreeNodePointer;
  an: InuseNodePointer;

  IF LOOPHOLE[length, CARDINAL]>LAST[Zone.BlockSize] THEN
    RETURN[nullSegment, storageOutOfRange];
  IF zb>st OR st+length-1 > zb+LAST[CARDINAL] THEN
    RETURN[nullSegment, storageOutOfRange];
  IF length < segmentHeaderSize+MAX[freeNodeSize, z.threshold]+usedNodeSize
    THEN RETURN[nullSegment, segmentTooSmall];
  IF length>LAST[Zone.BlockSize] THEN RETURN[nullSegment, storageOutOfRange];
  IF (s _ ValidateZone[zH])#okay THEN RETURN[sH: nullSegment, s: s];

  -- set up the bulk of the segment as a large free block.
  fn _ LOOPHOLE[sp+segmentHeaderSize];
  zb[fn] _ NodeHeader[
    length: length-(segmentHeaderSize+usedNodeSize),
    extension: free[fwdp: z.freeList, backp: z.node.backp]];
  z.node.backp _ zb[zb[fn].backp].fwdp _ fn;

  -- set up allocated node (smallest possible) at end of block.
  an _ LOOPHOLE[sp+(length-usedNodeSize)];
  zb[an] _ NodeHeader[length: usedNodeSize, extension: inuse[]];

  -- set up the segment header and link it into the chain of segments
  zb[sp] _ SegmentHeader[length: length, nextSegment: z.nextSegment];
  z.nextSegment _ sp;
  RETURN[LOOPHOLE[sp], okay];
  END;

CheckNode: PUBLIC PROC [zH: Zone.Handle, node: NodePointer]
  RETURNS [s: Zone.Status] =
  -- Checks to see that the node is properly part of this zone and is
  -- correctly linked to the free list
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;

  -- First check to see that node lies within this zone.
  BEGIN
  sp: SegmentPointer;
  rz: RPtr = Relative[zb, LOOPHOLE[zH]];
    -- get the zone pointer relative to the zone base
  endNode: RPtr = node + zb[node].length;
    -- the address of the end of the node
  IF node>rz AND endNode < rz+z.length THEN GOTO okay;
    --is node in primary part of zone?
  FOR sp _ z.nextSegment, zb[sp].nextSegment WHILE sp#nilSeg DO
    IF node>LOOPHOLE[sp] AND endNode<sp+zb[sp].length
	THEN GOTO okay; --is node in this segment of zone?
    ENDLOOP;
  RETURN[invalidNode]; --node is not in any segment of the zone
  EXITS okay => NULL;
  END;

  -- Now check that node is properly linked on the free list
  IF zb[node].state = free THEN
    DO
      WITH zb[node] SELECT FROM
        inuse => IF length = usedNodeSize THEN EXIT; -- end of zone
        free =>
          BEGIN
          IF zb[fwdp].backp # node OR zb[backp].fwdp # node THEN
            RETURN[invalidNode];
          IF length = 0 AND node # z.freeList THEN RETURN[invalidNode];
          END;
        ENDCASE;
      node _ node + zb[node].length;
      IF zb[node].state # inuse THEN EXIT;
      ENDLOOP;
  RETURN[okay]
  END;

CheckZone: PUBLIC PROC [zH: Zone.Handle] RETURNS [s: Zone.Status] =
  -- Checks that the zone is well-formed and that its free list is intact
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  node: FreeNodePointer;
  count: INTEGER;
  IF (s _ ValidateZone[zH])#okay THEN RETURN[s];
  count _ (LAST[Zone.BlockSize]-FIRST[Zone.BlockSize])/freeNodeSize+1;
  node _ z.freeList;
  DO
    IF (s _ CheckNode[zH, node])#okay THEN RETURN[invalidNode];
    IF (count _ count-1)<0 THEN RETURN[nodeLoop];
    IF (node _ zb[node].fwdp)=z.freeList THEN EXIT;
    ENDLOOP;
  RETURN[okay]
  END;

Create: PUBLIC PROC [
  storage: LONG POINTER, length: Zone.BlockSize, zoneBase: Zone.Base,
  threshold: Zone.BlockSize, checking: BOOLEAN]
  RETURNS [zH: Zone.Handle, s: Zone.Status] =
  -- Makes a zone out of the storage provided by the caller.  The caller also
  -- provides a LONG BASE POINTER to which all addressing within the zone
  -- will be RELATIVE.  This LONG BASE POINTER must cover all of the storage.
  BEGIN
  fn: FreeNodePointer;
  an: InuseNodePointer;
  z: ZonePointer = LOOPHOLE[storage];
  zb: OrderedBase = LOOPHOLE[zoneBase];
  rp: RPtr = Relative[zb, z];
  freeList: FreeNodePointer = Relative[zb, @z.node];

  IF LOOPHOLE[length, CARDINAL] > LAST[Zone.BlockSize] THEN
    RETURN[LOOPHOLE[z, Zone.Handle], storageOutOfRange];
  IF zb>z OR z+length-1 > zb+LAST[CARDINAL] THEN
    RETURN[LOOPHOLE[z], storageOutOfRange];
  IF length < zoneHeaderSize+MAX[freeNodeSize, threshold]+usedNodeSize THEN
    RETURN[LOOPHOLE[z], zoneTooSmall];
  IF length > LAST[Zone.BlockSize] THEN
    RETURN[LOOPHOLE[z], storageOutOfRange];

  -- set up the bulk of the zone as a large free block.
  fn _ rp + zoneHeaderSize;
  zb[fn] _ NodeHeader[length: length-(zoneHeaderSize+usedNodeSize),
    extension: free[fwdp: freeList, backp: freeList]];

  -- set up allocated node (smallest possible) at end of block.
  an _ rp+(length-usedNodeSize);
  zb[an] _ NodeHeader[length: usedNodeSize, extension: inuse[]];

  -- set up the zone header
  z.seal _ zoneSeal; z.version _ zoneVersion; z.root _ orderedRelativeNil;
  z.rover _ fn; z.freeList _ freeList;
  z.length _ length; z.nextSegment _ nilSeg;
  z.zoneBase _ zb; z.threshold _ MAX[freeNodeSize, threshold];
  z.checking _ checking;
  z.node _ NodeHeader[length: 0, extension: free[fwdp: fn, backp: fn]];
  Process.InitializeMonitor[@z.LOCK];
  RETURN[LOOPHOLE[z], okay]
  END;

FreeNode: PUBLIC ENTRY PROC [zH: Zone.Handle, p: LONG POINTER]
  RETURNS [s: Zone.Status] =
  -- returns the node pointed to by p to the free list
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  pp: LONG ORDERED POINTER = LOOPHOLE[p];
  node: NodePointer = Relative[zb, p-usedNodeSize];

  IF pp < zb OR pp > zb + LAST[CARDINAL] THEN RETURN[invalidNode];
    -- Can't compress to a 16-bit relative pointer if not from this zone.

  IF z.checking THEN
    BEGIN
    IF (s _ CheckZone[zH])#okay THEN RETURN[invalidZone];
    IF (s _ CheckNode[zH, node])#okay THEN RETURN[invalidNode];
    END;
  WITH zb[node] SELECT FROM
    free => RETURN[invalidNode];
    inuse =>
      BEGIN
      zb[node] _ NodeHeader[length, free[z.freeList, z.node.backp]];
      z.node.backp _ zb[z.node.backp].fwdp _ LOOPHOLE[node, FreeNodePointer];
      END;
    ENDCASE;
  RETURN[okay]
  END;

GetAttributes: PUBLIC ENTRY PROC [zH: Zone.Handle]
  RETURNS [
    zoneBase: Zone.Base, threshold: Zone.BlockSize, checking: BOOLEAN,
    storage: LONG POINTER, length: Zone.BlockSize, next: Zone.SegmentHandle] =
  -- Returns the attributes of the zone (without checking)
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  RETURN[
    zoneBase: z.zoneBase,
    threshold: z.threshold,
    checking: z.checking,
    storage: @z,
    length: z.length,
    next: LOOPHOLE[z.nextSegment]]
  END;

GetRootNode: PUBLIC PROCEDURE [zH: Zone.Handle]
  RETURNS [node: Zone.Base RELATIVE POINTER] =
  {RETURN[LOOPHOLE[LOOPHOLE[zH, ZonePointer].root]]};

GetSegmentAttributes: PUBLIC ENTRY PROCEDURE [
  zH: Zone.Handle, sH: Zone.SegmentHandle]
  RETURNS [
    storage: LONG POINTER, length: Zone.BlockSize, next: Zone.SegmentHandle] =
  -- Returns the next segment in the chain, given sH; returns nullSegment if
  -- there is none.  This procedure does not check the zone or segment for
  -- validity
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer],
    seg: z.zoneBase[LOOPHOLE[sH, SegmentPointer]];
  sp: SegmentPointer = LOOPHOLE[sH];
  IF sH#nullSegment THEN
    RETURN[storage: @seg, length: seg.length,
      next: LOOPHOLE[seg.nextSegment]]
  END;

MakeNode: PUBLIC ENTRY PROC [
  zH: Zone.Handle, n: Zone.BlockSize, alignment: Zone.Alignment]
  RETURNS [node: Zone.Base RELATIVE POINTER, s: Zone.Status] =
  -- Allocates a node of size n from the free list.  The node is aligned on a
  -- multiple-word boundary determined by alignment.  Search for a suitable
  -- node begins with z.rover; adjacent free nodes are coalesced on the way;
  -- a large node is split in two if the remainder after allocating the node
  -- is larger than z.threshold
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  rover: FreeNodePointer _ z.rover;
  temp, neighbour: NodePointer;
  nodelength, nl: Zone.BlockSize;

  n _ MAX[n + usedNodeSize, freeNodeSize];
    --add the node overhead to the length of the request
  IF z.checking THEN IF (s _ CheckZone[zH])#okay THEN RETURN[nil, s];

  -- start cycling through the free list
  DO
    nodelength _ zb[rover].length;

    --	first coalesce all free nodes adjacent to the rover
    FOR neighbour _ rover + nodelength, neighbour + nl DO
      WITH zb[neighbour] SELECT FROM
	inuse => EXIT;
	free =>
	  BEGIN -- coalesce
	  IF (nl _ length)=0 THEN EXIT; -- end of zone
	  zb[fwdp].backp _ backp;
	  zb[backp].fwdp _ fwdp;
	  z.rover _ rover; -- in case neighbor was z.rover
	  nodelength _ nodelength + nl;
	  END;
	ENDCASE;
      ENDLOOP;

    -- if the node pointed to by rover is big enough
    -- and alignment is not required, allocate it
    IF alignment=a1 AND nodelength>=n THEN
      BEGIN -- if it was too big, first split off the remainder
      IF (nl _ (nodelength-n)) > z.threshold THEN
	BEGIN -- split the block
	z.rover _ rover;
	zb[rover].length _ nl;
	temp _ LOOPHOLE[rover+nl];
	nodelength _ n;
	END
      ELSE
	BEGIN
	zb[zb[rover].fwdp].backp _ zb[rover].backp;
	z.rover _ zb[zb[rover].backp].fwdp _ zb[rover].fwdp;
	temp _ LOOPHOLE[rover];
	END;
      zb[temp] _ NodeHeader[nodelength, inuse[]];
      RETURN[LOOPHOLE[temp+usedNodeSize], okay]
      END

      -- otherwise, either this node is not big enough or
      -- special alignment is required
    ELSE zb[rover].length _ nodelength;

    -- if multiple word alignment is required, see if we can carve up
    -- this node to fit
    IF alignment#a1 THEN
      BEGIN
      zr: LONG ORDERED POINTER = LOOPHOLE[@zb[rover]];
      mask: WORD = Inline.BITSHIFT[177777B, LOOPHOLE[alignment, INTEGER]];
      aPtr: MACHINE DEPENDENT RECORD [
	SELECT OVERLAID * FROM
	  lp => [lp: LONG ORDERED POINTER],
	  num => [lowbits, highbits: CARDINAL],
	  ENDCASE];
      aPtr.lp _ zr + nodelength - n + usedNodeSize;
	--address of the node (without node overhead)
      aPtr.lowbits _ Inline.BITAND[aPtr.lowbits, mask];
	--address rounded down to be aligned
      aPtr.lp _ aPtr.lp - usedNodeSize; --subtract the node overhead again

      -- check if node fits exactly
      IF aPtr.lp=zr THEN
	BEGIN
	zb[zb[rover].fwdp].backp _ zb[rover].backp;
	z.rover _ zb[zb[rover].backp].fwdp _ zb[rover].fwdp;
	temp _ LOOPHOLE[rover];
	END

      -- check if we can safely break off and free the front of the node
      ELSE IF aPtr.lp >= zr+z.threshold THEN
	BEGIN -- split the block
	diff: Inline.LongNumber;
	diff.lc _ aPtr.lp-zr;
	z.rover _ rover;
	zb[rover].length _ diff.lowbits;
	temp _ LOOPHOLE[rover+diff.lowbits];
	nodelength _ nodelength - diff.lowbits;
	END

      -- otherwise, we failed to allocate from this node
      ELSE GO TO failure;
      zb[temp] _ NodeHeader[nodelength, inuse[]];
      [] _ Split[zH, temp, n];
      RETURN[LOOPHOLE[temp+usedNodeSize], okay];
      EXITS failure => NULL
      END;
    -- Check to see if we have gone around the chain of free nodes
    IF (rover _ zb[rover].fwdp) = z.rover THEN EXIT;
    ENDLOOP;
  RETURN[nil, noRoomInZone];
  END;

NodeSize: PUBLIC PROC [p: LONG POINTER] RETURNS [Zone.BlockSize] =
  BEGIN
  -- Returns the actual size of the allocated node (not including the
  -- overhead).  The node is not checked for validity
  node: LONG POINTER TO NodeHeader = p-usedNodeSize;
  RETURN[node.length-usedNodeSize]
  END;

LongPointerDifference: TYPE = MACHINE DEPENDENT RECORD [
  lowHalf: RPtr, highHalf: CARDINAL];

Recreate: PUBLIC PROCEDURE [storage: LONG POINTER, zoneBase: Zone.Base]
  RETURNS [zH: Zone.Handle, rootNode: Zone.Base RELATIVE POINTER, s: Zone.Status] =
  -- **NOTE: Currently the storage pointer and base supplied MUST be offset
  -- by the same amount that they were before the zone was recreated.  This
  -- should be fixed someday.
  BEGIN
  z: ZonePointer _ LOOPHOLE[storage];
  zH _ LOOPHOLE[z];
  IF z.seal # zoneSeal THEN {s _ wrongSeal; RETURN};
  IF z.version # zoneVersion THEN
    {rootNode _ LOOPHOLE[z.root]; s _ wrongVersion; RETURN};
  z.zoneBase _ LOOPHOLE[zoneBase];
  rootNode _ LOOPHOLE[z.root];
  s _ ValidateZone[zH];
  IF s#okay THEN RETURN;
  Process.InitializeMonitor[@z.LOCK];
  RETURN;
  END;

Relative: PROC [base, p: LONG POINTER] RETURNS [RPtr] =
  -- computes a RELATIVE POINTER with respect to the zoneBase of zone z.
  -- No check is made to see that p is within range of base
  INLINE {RETURN[LOOPHOLE[p-base, LongPointerDifference].lowHalf]};

RemoveSegment: PUBLIC ENTRY PROC [zH: Zone.Handle, sH: Zone.SegmentHandle]
  RETURNS [storage: LONG POINTER, s: Zone.Status] =
  -- short description of what this procedure does
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  sp: SegmentPointer = LOOPHOLE[sH];
  lastNode: NodePointer =
    LOOPHOLE[sp + zb[sp].length - usedNodeSize];
  t: SegmentPointer;
  node: NodePointer;
  nl: Zone.BlockSize;
  storage _ @zb[sp];
  IF (s _ ValidateZone[zH])#okay THEN RETURN[storage, s];
  IF z.checking THEN IF (s _ CheckZone[zH])#okay THEN RETURN[storage, s];
  IF sp = nilSeg THEN RETURN[storage, invalidSegment];
  -- Check to see if segment is empty
  FOR node _ LOOPHOLE[sp+segmentHeaderSize], node+nl
    WHILE node<lastNode DO
    nl _ zb[node].length;
    WITH zb[node] SELECT FROM
      inuse => RETURN[storage, nonEmptySegment];
      ENDCASE;
    ENDLOOP; --	Remove segment from chain
  IF sp = z.nextSegment THEN z.nextSegment _ zb[sp].nextSegment
  ELSE
    FOR t _ z.nextSegment, zb[t].nextSegment WHILE t ~= nilSeg DO
      IF sp = zb[t].nextSegment THEN GOTO unlink;
      REPEAT
	unlink => zb[t].nextSegment _ zb[sp].nextSegment;
	  --remove the segment from the chain
	FINISHED => RETURN[storage, invalidSegment];
	  --OOPS! The segment was not part of this zone
      ENDLOOP; -- Remove all free nodes from free list
  FOR node _ LOOPHOLE[sp + segmentHeaderSize],
    node + nl WHILE node < lastNode DO
    nl _ zb[node].length;
    WITH zb[node] SELECT FROM
      inuse => EXIT;
      -- as a result of previous checking,
      -- we are guaranteed to be at end of segment now.
      free => BEGIN zb[backp].fwdp _ fwdp; zb[fwdp].backp _ backp; END;
      ENDCASE;
    ENDLOOP;
  z.rover _ z.node.fwdp; --reset rover to be outside segment
  RETURN[storage, okay];
  END;

SetChecking: PUBLIC ENTRY PROC [zH: Zone.Handle, checking: BOOLEAN]
  RETURNS [s: Zone.Status] =
  -- sets the checking attribute of the zone;
  -- if this is true, the zone is checked
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  z.checking _ checking;
  s _ IF checking THEN CheckZone[zH] ELSE okay;
  END;

SetRootNode: PUBLIC PROCEDURE
  [zH: Zone.Handle, node: Zone.Base RELATIVE POINTER] =
  {LOOPHOLE[zH, ZonePointer].root _ LOOPHOLE[node]};

Split: PROC [zH: Zone.Handle, node: NodePointer, n: Zone.BlockSize]
  RETURNS [s: Zone.Status] = -- does the actual work of splitting a node
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  lastpart: FreeNodePointer;
  t: INTEGER;

  IF z.checking THEN IF (s _ CheckZone[zH])#okay THEN RETURN[s];
  n _ MAX[n + usedNodeSize, freeNodeSize];

  --ensure that node remains large enough to free
  WITH zb[node] SELECT FROM
    free => RETURN[invalidNode];
    inuse =>
      IF (t _ zb[node].length - n) >= z.threshold THEN
	BEGIN --fabricate a free node out of the last part of the split node
	zb[node].length _ n; --adjust size of remaining node
	lastpart _ LOOPHOLE[node+n];
	zb[lastpart] _ NodeHeader[
	  length: t, extension: free[fwdp: z.freeList, backp: z.node.backp]];
	z.node.backp _ zb[zb[lastpart].backp].fwdp _ lastpart;
	END;
    ENDCASE;
  RETURN[okay]
  END;

SplitNode: PUBLIC ENTRY PROC [
  zH: Zone.Handle, p: LONG POINTER, n: Zone.BlockSize]
  RETURNS [s: Zone.Status] =
  -- Splits a node, keeping the first n words and freeing the rest.
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  node: NodePointer = Relative[zb, p - usedNodeSize];
  RETURN[Split[zH, node, n]]
  END;

ValidateZone: PUBLIC PROC [zH: Zone.Handle] RETURNS [Zone.Status] =
  -- Checks to see that the zone is well-formed
  BEGIN OPEN z: LOOPHOLE[zH, ZonePointer];
  zb: OrderedBase = z.zoneBase;
  lastNodePointer: LONG POINTER =
    LOOPHOLE[zH, ZonePointer] + z.length - usedNodeSize;
  -- to get around a compiler bug (this constant could be embedded in the declaration of the next one
  lastNode: NodePointer;
  sp: SegmentPointer;

  -- Check seal and version
  IF z.seal # zoneSeal THEN RETURN[wrongSeal];
  IF z.version # zoneVersion THEN RETURN[wrongVersion];

  -- Check that primary storage of zone is okay
  lastNode _ Relative[zb, lastNodePointer];
  SELECT TRUE FROM
    (z.node.length # 0), (zb[lastNode].length # usedNodeSize),
      (zb[z.node.fwdp].backp # z.freeList OR zb[z.node.backp].fwdp #
        z.freeList) => RETURN[invalidZone];
    ENDCASE;

  -- Check that additional segments of zone are okay
  FOR sp _ z.nextSegment, zb[sp].nextSegment WHILE sp # nilSeg DO
    lastNode _ LOOPHOLE[sp + zb[sp].length - usedNodeSize,
      NodePointer];
    IF zb[lastNode].length # usedNodeSize THEN RETURN[invalidSegment]
    ENDLOOP;
  RETURN[okay]
  END;


END.

LOG
Time: February 21, 1979  11:38 AM	By: Lauer
	Action: Created file
Time: April 25, 1979  3:56 PM	By: Lauer
	Action: Integrated into Pilot
Time: June 1, 1979  4:45 PM	By: Lauer
	Action: Added facility for allocating aligned nodes (using the
	temporary interface ZoneExtensions)
Time: July 16, 1979  7:29 PM	By: Knutsen
	Action: MakeNode now creates aligned nodes.  The temporary interface
	ZoneExtension is folded into ZoneImpl.
Time: April 7, 1980  2:30 PM	By: Luniewski
	Action: Split off ZoneInternal.  Fixed ARs 2854 & 2892.
April 16, 1980  11:54 AM	By: Knutsen
	Action: Now STARTed by InitializeZone.
September 19, 1980  5:03 PM	By: Forrest
	Action: Convert to PlainText.
December 22, 1980  1:23 PM	By: Gobbel
	Action: Make CheckNode, CheckZone, ValidateZone be PUBLIC.
January 9, 1981  4:06 PM	By: Gobbel
	Action: Add GetRootNode, SetRootNode, Recreate.
February 5, 1981  6:59 PM	By: Luniewski
	Action: Change status arg in Recreate to s as per public interface.
(1792)