-- PrintStorage.mesa
-- Edited by Levin, September 9, 1980  5:17 PM
-- Edited by Brotz, July 15, 1981  4:35 PM

DIRECTORY
  AltoDefs,
  FSPDefs,
  PrintDefs,
  Mopcodes,
  SegmentDefs,
  Storage,
  SystemDefs;

PrintStorage: PROGRAM
  IMPORTS FSPDefs, SegmentDefs, realSystemDefs: SystemDefs
  EXPORTS SystemDefs, Storage, PrintDefs = PUBLIC

BEGIN

-- Interface for Laurel Executive

clientPages: CARDINAL ← 0;
clientWords: CARDINAL ← 0;


-- SystemDefs Interface for Laurel Client BCDs

AllocatePages, AllocateResidentPages, Pages: PROCEDURE [npages: CARDINAL]
  RETURNS [base: POINTER] =
  BEGIN
  OPEN SegmentDefs;
  seg: DataSegmentHandle ← MakeDataSegment[DefaultMDSBase, npages, HardDown];
  seg.type ← 89;
  base ← DataSegmentAddress[seg];
  AddSegmentToList[base];
  END;

AllocateSegment, AllocateResidentSegment, Words: PROCEDURE [nwords: CARDINAL]
  RETURNS [base: POINTER] =
  {RETURN[AllocatePages[PgsForWords[nwords]]]};

FreePages, FreeSegment, FreeWords: PROCEDURE [base: POINTER] =
  BEGIN
  RemoveSegmentFromList[base];
  RealFreePages[base];
  END;

RealFreePages: PROCEDURE [base: POINTER] =
  BEGIN OPEN SegmentDefs;
    seg: DataSegmentHandle = VMtoDataSegment[base];
    IF seg # NIL THEN DeleteDataSegment[seg];
   END;


SegmentListRec: TYPE = RECORD [next: SegmentList, base: POINTER];
SegmentList: TYPE = POINTER TO SegmentListRec;

segmentList: SegmentList ← NIL;

AddSegmentToList: PRIVATE PROCEDURE [base: POINTER] =
  BEGIN
  sl: SegmentList ← AllocateHeapNode[SIZE[SegmentListRec]];
  sl↑ ← SegmentListRec[next: segmentList, base: base];
  segmentList ← sl;
  END;

RemoveSegmentFromList: PRIVATE PROCEDURE [base: POINTER] =
  BEGIN
  sl: SegmentList ← segmentList;
  slPrev: SegmentList ← NIL;
  UNTIL sl = NIL DO
    IF base = sl.base THEN
      {IF slPrev = NIL THEN segmentList ← sl.next ELSE slPrev.next ← sl.next; RETURN};
    slPrev ← sl;
    sl ← sl.next;
    ENDLOOP;
  END;

SegmentSize: PROCEDURE [base: POINTER] RETURNS [nwords: CARDINAL] =
  {RETURN[realSystemDefs.SegmentSize[base]]};

HeapZone: PROCEDURE RETURNS [FSPDefs.ZonePointer] =
  {IF execHeap = NIL THEN StartExecStorage[]; RETURN[execHeap]};

PruneHeap, Prune: PROCEDURE RETURNS [BOOLEAN] =
    BEGIN RETURN[execHeap # NIL AND FSPDefs.PruneZone[execHeap]] END;

Even: PROCEDURE [u: UNSPECIFIED] RETURNS [UNSPECIFIED] =
  {RETURN[realSystemDefs.Even[u]]};

Quad: PROCEDURE [u: UNSPECIFIED] RETURNS [UNSPECIFIED] =
  {RETURN[realSystemDefs.Quad[u]]};

UsedNodeSize: FSPDefs.BlockSize = SIZE[inuse FSPDefs.NodeHeader];
FreeNodeSize: FSPDefs.BlockSize = SIZE[free FSPDefs.NodeHeader];
ZoneHeaderSize: FSPDefs.BlockSize = SIZE[FSPDefs.ZoneHeader];

execHeap: FSPDefs.ZonePointer ← NIL;

LargeNode: CARDINAL = 150;

Node, AllocateHeapNode: PROCEDURE [nwords: CARDINAL] RETURNS [p: POINTER] =
    BEGIN OPEN FSPDefs;
    IF execHeap = NIL THEN StartExecStorage[];
    IF INTEGER[nwords] < 0 THEN ERROR ZoneTooSmall[execHeap];
    IF nwords + UsedNodeSize > LargeNode THEN
      BEGIN
      p ← Pages[PgsForWords[nwords + UsedNodeSize]];
      p↑ ← NodeHeader[length: nwords + UsedNodeSize, extension: inuse[]];
      clientWords ← clientWords + FSPDefs.NodeSize[p + 1];
      RETURN[p + 1]
      END;
    p ← MakeNode[execHeap, nwords
      ! NoRoomInZone =>
        BEGIN
        Expand[PgsForWords[nwords + ZoneOverhead + UsedNodeSize]];
        RESUME
        END];
    clientWords ← clientWords + FSPDefs.NodeSize[p];
    END;

Expand: PROCEDURE [pages: CARDINAL] =
BEGIN
FSPDefs.AddToNewZone[z: execHeap, base: GetMorePages[pages],
    length: pages*AltoDefs.PageSize, deallocate: RealFreePages];
END;

GetMorePages: PROCEDURE [pages: CARDINAL] RETURNS [POINTER] =
BEGIN OPEN SegmentDefs;
seg: DataSegmentHandle ← MakeDataSegment[DefaultMDSBase, pages, HardDown];
seg.type ← 89;
RETURN[DataSegmentAddress[seg]];
END;

Free, FreeHeapNode: PROCEDURE [p: POINTER] =
BEGIN OPEN SegmentDefs, FSPDefs;
pp: POINTER;
IF p = NIL THEN RETURN;
clientWords ← clientWords - FSPDefs.NodeSize[p];
IF LOOPHOLE[(pp ← p - 1), POINTER TO inuse NodeHeader].length > LargeNode
  AND DataSegmentAddress[VMtoDataSegment[pp]] = pp THEN
  {FreePages[pp]; RETURN};
FreeNode[execHeap, p];
END;

String, AllocateHeapString: PROCEDURE [nchars: CARDINAL] RETURNS [s: STRING] =
BEGIN
s ← AllocateHeapNode[WdsForString[nchars]];
s↑ ← StringBody[length: 0, maxlength: nchars, text:];
RETURN[s]
END;

PgsForWords: PRIVATE PROCEDURE [nwords: CARDINAL] RETURNS [CARDINAL] = INLINE
  {RETURN[(nwords + AltoDefs.PageSize - 1) / AltoDefs.PageSize]};

WdsForString: PRIVATE PROCEDURE [nchars: CARDINAL] RETURNS [CARDINAL] = INLINE
  {RETURN[2 + (nchars + 1) / 2]};

FreeString, FreeHeapString: PROCEDURE [s: STRING] = LOOPHOLE[Free];

CopyString: PROCEDURE [s: STRING, longer: CARDINAL ← 0] RETURNS [STRING] =
    BEGIN
    ns: STRING;
    IF s = NIL THEN RETURN[IF longer = 0 THEN NIL ELSE String[longer]];
    ns ← AllocateHeapString[s.length + longer];
    CPY[from: @s.text, to: @ns.text, nwords: (s.length + 1)/2];
    ns.length ← s.length;
    RETURN[ns];
    END;

ExpandString: PROCEDURE [s: POINTER TO STRING, longer: CARDINAL ← 0] =
    BEGIN
    ns: STRING;
    IF s↑ = NIL THEN {IF longer # 0 THEN s↑ ← String[longer]; RETURN};
    ns ← AllocateHeapString[s.maxlength + longer];
    CPY[from: @s.text, to: @ns.text, nwords: (s.length + 1)/2];
    ns.length ← s.length;
    FreeHeapString[s↑];
    s↑ ← ns;
    END;

CPY: PRIVATE PROCEDURE [from: POINTER, nwords: CARDINAL, to: POINTER] =
  MACHINE CODE {Mopcodes.zBLT};

StartExecStorage: PROCEDURE =
  {execHeap ← FSPDefs.MakeNewZone
      [GetMorePages[2], 2*AltoDefs.PageSize, RealFreePages]};

FinishPrintStorage: PROCEDURE =
  BEGIN
  UNTIL segmentList = NIL DO
    FreePages[segmentList.base];
    ENDLOOP;
  IF execHeap # NIL THEN {FSPDefs.DestroyZone[execHeap]; execHeap ← NIL};
  END;


END.  -- of PrintStorage --