-- XCoreMap.Mesa
-- Edited by  Levin on October 16, 1978  3:37 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [PageSize],
  BcdDefs: FROM "bcddefs" USING [MTHandle, MTIndex, NameRecord, NameString],
  BootDefs: FROM "bootdefs" USING [BusyPage, FreePage, PageMap, SystemTableHandle],
  ControlDefs: FROM "controldefs" USING [GFT, GlobalFrameHandle],
  DebugData: FROM "debugdata" USING [debugPilot, ESV],
  DebugMiscDefs: FROM "debugmiscdefs" USING [CommandNotAllowed, ControlDEL],
  DebugUsefulDefs: FROM "debugusefuldefs" USING [AddCommand, AREAD, MREAD, SREAD],
  DebugUtilityDefs: FROM "debugutilitydefs" USING [LoadStateInvalid],
  GlobalFrameDefs: FROM "globalframedefs" USING [FrameCodeBase, GlobalFrameHandle],
  InlineDefs: FROM "inlinedefs" USING [BITAND],
  IODefs: FROM "iodefs" USING [CR, NumberFormat, Rubout, SP, WriteChar, WriteLine, WriteNumber,
	WriteOctal, WriteString],
  LoaderBcdUtilDefs: FROM "loaderbcdutildefs" USING [BcdBase, EnumerateModuleTable, ReleaseBcdSeg,
	SetUpBcd],
  LoadStateDefs: FROM "loadstatedefs" USING [BcdAddress, BcdSegFromLoadState, ConfigIndex,
	EnumerateLoadStateBcds, FileSegmentHandle, InitializeRelocation, InputLoadState,
	ReleaseLoadState, ReleaseRelocation, Relocation],
  SegmentDefs: FROM "segmentdefs" USING [FileSegmentHandle, PageCount, PageNumber, SegmentHandle],
  StreamDefs: FROM "streamdefs" USING [ControlDELtyped],
  StringDefs: FROM "stringdefs" USING [AppendSubString, SubStringDescriptor],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, AllocateHeapString, AllocateSegment,
	FreeHeapNode, FreeHeapString, FreeSegment, PruneHeap],
  XMESA: FROM "XMesaPrivateDefs" USING [Bank1X, Bank2X, Bank3X, XMremote, XSegInfo, XSegmentHandle,
	XSegmentObject],
  XMesaDefs: FROM "XMesaDefs" USING [BankIndex, HighHalfPtr, LowHalfPtr, MaxXPage, PagesPerBank];


DEFINITIONS FROM AltoDefs, SystemDefs, IODefs, SegmentDefs;

XCoreMap: PROGRAM 
  IMPORTS DDptr: DebugData, DebugMiscDefs, DebugUsefulDefs, DebugUtilityDefs, LoadStateDefs,
    IODefs, SystemDefs, StringDefs, StreamDefs, LoaderBcdUtilDefs
  SHARES XMESA, SegmentDefs =

BEGIN

  byte: NumberFormat = NumberFormat[8,FALSE,TRUE,3];
  pageNF: NumberFormat = NumberFormat[8,FALSE,TRUE,4];
  word: NumberFormat = NumberFormat[8,FALSE,TRUE,6];

  CopyRead: PROCEDURE [from, to: POINTER, nwords: CARDINAL] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..nwords) DO
      (to+i)↑ ← DebugUsefulDefs.SREAD[from+i];
      ENDLOOP;
    RETURN
    END;

  PrintPages: PROCEDURE [
    page:PageNumber, count:PageCount, state:PageState] =
    BEGIN
    WriteNumber[page,pageNF]; WriteChar[SP];
    WriteLongPointer[LongAddressFromPage[page]];
    WriteString["     "L];
    WriteNumber[count,pageNF];
    WriteLine[SELECT state FROM
      free => " free"L,
      data => " data"L,
      file => " file"L,
      busy => " busy"L,
      ENDCASE => " ?"L];
    RETURN
    END;

  WriteLongPointer: PROCEDURE [p: LONG POINTER] =
    BEGIN
    i: CARDINAL = (IF LOOPHOLE[XMesaDefs.LowHalfPtr[p], CARDINAL] > 77777B THEN 1 ELSE 0)
			+ 2*XMesaDefs.HighHalfPtr[p];
    WriteChar[IF i = 0 THEN '  ELSE '0 + i];
    WriteNumber[InlineDefs.BITAND[LOOPHOLE[XMesaDefs.LowHalfPtr[p], WORD], 77777B],[8,i # 0,TRUE,5]];
    RETURN
    END;

  LongAddressFromPage: PROCEDURE [page: PageNumber] RETURNS [LONG POINTER] =
    BEGIN
    RETURN[LOOPHOLE[LONG[page]*PageSize]]
    END;

  BaseFromSeg: PROCEDURE [seg: XMESA.XSegmentHandle] RETURNS [p: PageNumber] =
    BEGIN
    WITH s: seg SELECT FROM
      data => RETURN[IF s.VMpage= 0 THEN s.XMpage ELSE s.VMpage];
      file =>
	WITH xs: s SELECT FROM
	  disk => RETURN[xs.VMpage];
	  remote => 
	    IF xs.proc = XMESA.XMremote THEN
		BEGIN
		info: XMESA.XSegInfo;
		CopyRead[to: @info, from: xs.info, nwords: SIZE[XMESA.XSegInfo]];
		RETURN[info.XMpage]
		END
	    ELSE RETURN[xs.VMpage];
	  ENDCASE;
      ENDCASE
    END;

  PrintSegment: PROCEDURE [seg: XMESA.XSegmentHandle] RETURNS [state: PageState, size: PageCount] =
    BEGIN
    copiedSeg:  XMESA.XSegmentObject;
    segBase: PageNumber;
    CopyRead[to: @copiedSeg, from: seg, nwords: SIZE[ XMESA.XSegmentObject]];
    segBase ← BaseFromSeg[@copiedSeg];
    WITH s: copiedSeg SELECT FROM
      data => BEGIN PrintPages[segBase, s.pages, data]; RETURN[data, s.pages] END;
      file =>
	BEGIN
	WriteNumber[segBase,pageNF]; WriteChar[SP];
	WriteLongPointer[LongAddressFromPage[segBase]]; WriteChar[SP];
	WriteNumber[s.base,byte];  WriteChar[SP];
	WriteNumber[s.pages,pageNF]; WriteChar[SP];
	WriteString["SN"L];
	WriteOctal[DebugUsefulDefs.AREAD[@s.file.fp.serial.part2]];
	SELECT s.class FROM
	  code => WriteString[" code"L];
	  ENDCASE;
	IF s.read OR s.write THEN WriteChar[' ];
	IF s.read THEN WriteChar['R];
	IF s.write THEN WriteChar['W];
	WITH xs: s SELECT FROM
	  remote => IF xs.proc = XMESA.XMremote THEN WriteChar['X] ELSE WriteString[" remote"L];
	  ENDCASE;
	IF s.lock > 0 THEN
	  BEGIN
	  WriteString[" lock="L];
	  WriteOctal[s.lock];
	  END;
	SELECT s.class FROM
	  code => PrintFileName[LOOPHOLE[seg]];
	  ENDCASE;
	WriteChar[CR];
	RETURN[file, s.pages]
	END;
      ENDCASE
    END;

  PrintFileName:  PROCEDURE [seg:  FileSegmentHandle] =
    BEGIN
    node:  POINTER TO NameItem;
    found: BOOLEAN ← FALSE;
    FOR node ← NameList, node.next UNTIL node = NIL DO
      IF node.code = seg THEN
        BEGIN
        WriteChar[SP];
        WriteString[node.module];
        found ← TRUE;
        END;
      ENDLOOP;
    RETURN
    END;

  NameItem:  TYPE = RECORD [
     next:  POINTER TO NameItem,
     code: FileSegmentHandle,
     module:  STRING];

  NameList: POINTER TO NameItem ← NIL;

SegmentFromFrame: PROCEDURE [g: ControlDefs.GlobalFrameHandle]
	RETURNS [seg: FileSegmentHandle] =
  BEGIN
  c: GlobalFrameDefs.FrameCodeBase;
  CopyRead[from: @LOOPHOLE[g, GlobalFrameDefs.GlobalFrameHandle].code,
	    to: @c, nwords: SIZE[GlobalFrameDefs.FrameCodeBase]];
  seg ← SegmentFromCodePointer[c];
  IF seg = BootDefs.FreePage OR seg = BootDefs.BusyPage THEN ERROR;
  RETURN
  END;

SegmentFromCodePointer: PROCEDURE [c: GlobalFrameDefs.FrameCodeBase]
	RETURNS [seg: FileSegmentHandle] =
  BEGIN
  bank: XMesaDefs.BankIndex;
  page: [0..256);
  table: BootDefs.SystemTableHandle = DDptr.ESV.tables;

  IF c.highByte # 0 THEN RETURN[c.handle];
  bank ← c.highHalf;
  IF bank ~ IN XMesaDefs.BankIndex THEN ERROR;
  page ← LOOPHOLE[c.shortCodebase, CARDINAL]/AltoDefs.PageSize;
  IF table # NIL THEN
    BEGIN OPEN DebugUsefulDefs;
    page0map: POINTER TO BootDefs.PageMap ← SREAD[@table.pagemap];
    pagemap: POINTER TO BootDefs.PageMap;

    pagemap ←
      SELECT bank FROM
	1 => SREAD[@page0map[XMESA.Bank1X]],
	2 => SREAD[@page0map[XMESA.Bank2X]],
	3 => SREAD[@page0map[XMESA.Bank3X]],
	ENDCASE => page0map;
    IF pagemap = NIL THEN ERROR;
    RETURN[SREAD[@pagemap[page]]]
    END
  ELSE ERROR
  END;

  FindFrameNames: PROCEDURE = 
    BEGIN OPEN LoaderBcdUtilDefs, DebugUsefulDefs, LoadStateDefs;
    bcd: BcdBase; 
    proc: PROCEDURE [config: ConfigIndex, bcdAddr: BcdAddress]
    RETURNS [BOOLEAN] =
      BEGIN
      rel: Relocation ← InitializeRelocation[config];
      bcdseg: FileSegmentHandle ← BcdSegFromLoadState[config];
      code: FileSegmentHandle;
      FindNames: PROCEDURE [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
       RETURNS [BOOLEAN] =
        BEGIN OPEN ControlDefs;
        frame: GlobalFrameHandle ← MREAD[@GFT[rel[mth.gfi]].frame];
        code ← SegmentFromFrame[frame];
        AddName[code, bcd, mth.name];
        RETURN[FALSE];
        END;
      [] ← EnumerateModuleTable[bcd ← SetUpBcd[bcdseg],FindNames];
      ReleaseRelocation[rel];
      ReleaseBcdSeg[bcdseg];
      RETURN[FALSE];
      END;

    BEGIN
    [] ← InputLoadState[ ! DebugUtilityDefs.LoadStateInvalid => GOTO noNames];
    [] ← EnumerateLoadStateBcds[recentfirst,proc];
    ReleaseLoadState[];
    EXITS
      noNames => NULL;
    END;
    END;

  AddName: PROCEDURE [code: FileSegmentHandle, bcd: LoaderBcdUtilDefs.BcdBase,
    name: BcdDefs.NameRecord] =
    BEGIN
    ssb: BcdDefs.NameString = LOOPHOLE[bcd+bcd.ssOffset];
    ss: StringDefs.SubStringDescriptor ←
      [base: @ssb.string, offset: name, length: ssb.size[name]];
    s: STRING ← SystemDefs.AllocateHeapString[ssb.size[name]];
    node: POINTER TO NameItem ← AllocateHeapNode[SIZE[NameItem]];
    StringDefs.AppendSubString[s, @ss];
    node↑ ← [next: NameList, code: code, module: s];
    NameList ← node;
    END;

  FreeNames: PROCEDURE =
    BEGIN
    node:  POINTER TO NameItem;
    FOR node ← NameList, NameList UNTIL node = NIL DO
      NameList ← node.next;
      SystemDefs.FreeHeapString[node.module];
      SystemDefs.FreeHeapNode[node];
      ENDLOOP;
    [] ← SystemDefs.PruneHeap[];
    END;

  PageState: TYPE = {free,data,file,busy};

  PageMap: DESCRIPTOR FOR ARRAY OF XMESA.XSegmentHandle ← DESCRIPTOR[NIL,XMesaDefs.MaxXPage+1];

  StateFromPage: PROCEDURE [p: PageNumber] RETURNS [XMESA.XSegmentHandle, PageState] =
    BEGIN
    RETURN[
     PageMap[p],
     SELECT LOOPHOLE[PageMap[p], SegmentHandle] FROM
      BootDefs.FreePage => free,
      BootDefs.BusyPage => busy,
      ENDCASE => data] -- well it doesn't really matter
    END;


  CopyPageMap: PROCEDURE [map: POINTER, start: PageNumber] =
    BEGIN
    i: PageNumber;
    IF map = NIL THEN
      FOR i IN [0..XMesaDefs.PagesPerBank) DO PageMap[start+i] ← LOOPHOLE[BootDefs.BusyPage] ENDLOOP
    ELSE
      CopyRead[from: map, to: @PageMap[start], nwords: XMesaDefs.PagesPerBank];
    END;

  xcoremap: PUBLIC PROCEDURE =
    BEGIN
    seg: XMESA.XSegmentHandle;
    i: XMesaDefs.BankIndex;
    segSize: PageCount;
    count: PageCount ← 0;
    page, hole: PageNumber ← 0;
    state, next: PageState ← free;
    table: BootDefs.SystemTableHandle = DDptr.ESV.tables;
    pagemap: POINTER TO BootDefs.PageMap ← DebugUsefulDefs.SREAD[@table.pagemap];
    IF DDptr.debugPilot THEN
      BEGIN
      IODefs.WriteString["Debugging Pilot--"];
      SIGNAL DebugMiscDefs.CommandNotAllowed;
      END;
    PageMap ← DESCRIPTOR [AllocateSegment[LENGTH[PageMap]], LENGTH[PageMap]];
    BEGIN ENABLE UNWIND => 
      BEGIN
      FreeSegment[BASE[PageMap]];
      FreeNames[];
      END;
      CopyRead[from:@pagemap[0], to: @PageMap[0], nwords: XMesaDefs.PagesPerBank];
      FOR i IN [1..LAST[XMesaDefs.BankIndex]] DO
	CopyPageMap[DebugUsefulDefs.SREAD[@pagemap[XMESA.Bank1X+i-1]], i*XMesaDefs.PagesPerBank];
	ENDLOOP;
      FindFrameNames[];
      WriteChar[CR];  page ← 0;
      UNTIL page >= LENGTH[PageMap] DO
        ENABLE Rubout => EXIT;
        [seg, next] ← StateFromPage[page];
        IF next # state AND count#0 THEN
          BEGIN
          PrintPages[hole,count,state];
          hole ← hole + count; count ← 0;
          END;
	segSize ← 1;
	SELECT next FROM
	  free => state ← free;
	  busy => state ← busy;
	  ENDCASE => [state, segSize] ← PrintSegment[seg];
        page ← page + segSize;
        SELECT state FROM
          data, file => hole ← page;
          ENDCASE => count ← count+1;
        IF StreamDefs.ControlDELtyped[] THEN SIGNAL DebugMiscDefs.ControlDEL;
        REPEAT
          FINISHED => IF count#0 THEN
            PrintPages[hole,count,state];
        ENDLOOP;
      END;
    FreeSegment[BASE[PageMap]];
    FreeNames[];
    WriteChar[CR];
    RETURN
    END;

  DebugUsefulDefs.AddCommand["XCoreMap", xcoremap];

  END...