-- XMDebug.Mesa
-- Edited by:
--             Levin on November 16, 1978  11:21 AM

DIRECTORY
  AltoDefs: 	    FROM  "altodefs"
		    USING [PageSize, wordlength],
  BitBltDefs:	    FROM  "BitBltDefs"
		    USING [BBptr, BBTable],
  BootDefs:	    FROM  "bootdefs"
		    USING [BusyPage, FreePage, PageMap, SystemTableHandle],
  ControlDefs:	    FROM  "controldefs"
		    USING [GetReturnLink, GlobalFrameHandle, InstWord, Lreg, StateVector],
  DebugData:	    FROM  "debugdata"
		    USING [ESV],
  DebugUsefulDefs:  FROM  "debugusefuldefs"
		    USING [CopyRead, CopyWrite, SREAD],
  DebugUtilityDefs: FROM  "debugutilitydefs"
		    USING [AllocOnDrum, RemoveFromDrum, MapUserSegment],
  DebugXMDefs:	    FROM  "debugxmdefs",
  GlobalFrameDefs:  FROM  "globalframedefs"
		    USING [FrameCodeBase, GlobalFrameHandle],
  InlineDefs:	    FROM  "InlineDefs"
		    USING [DIVMOD],
  Mopcodes:	    FROM  "Mopcodes"
		    USING [zADD, zAND, zDUP, zLI1],
  NovaOps:	    FROM  "NovaOps"
		    USING [NovaJSR],
  ProcessDefs:	    FROM  "ProcessDefs"
		    USING [DisableInterrupts, EnableInterrupts],
  SDDefs:	    FROM  "SDDefs"
		    USING [SD],
  SegmentDefs:	    FROM  "segmentdefs"
		    USING [DeleteFileSegment, FileSegmentAddress, FileSegmentHandle,
			   FileSegmentObject, SegmentHandle, SegmentObject, SwapIn, Unlock],
  XMESA:	    FROM  "xmesaprivatedefs"
		    USING [Bank1X, Bank2X, Bank3X, InUseSeal,
			   XFileSegmentHandle, XFileSegmentObject, XMremote, XSegInfo],
  XMesaDefs:	    FROM  "xmesadefs"
		    USING [BankIndex, HighHalfPtr, LowHalfPtr, sXCOPY, XCOPY];


XMDebug: PROGRAM
  IMPORTS DDptr: DebugData, DebugUsefulDefs, DebugUtilityDefs, SegmentDefs, XMesaDefs
  EXPORTS DebugXMDefs, XMesaDefs
  SHARES XMESA, SegmentDefs =

BEGIN

GFH: TYPE = ControlDefs.GlobalFrameHandle;
SH: TYPE = SegmentDefs.SegmentHandle;
SO: TYPE = SegmentDefs.SegmentObject;
FSH: TYPE = SegmentDefs.FileSegmentHandle;
FSO: TYPE = SegmentDefs.FileSegmentObject;
XFSH: TYPE = XMESA.XFileSegmentHandle;
XFSO: TYPE = XMESA.XFileSegmentObject;
XSegInfo: TYPE = XMESA.XSegInfo;


-- Utilities

XMRead: PUBLIC PROCEDURE [from: LONG POINTER] RETURNS [data: UNSPECIFIED] =
  BEGIN
  XMesaDefs.XCOPY[from: from, to: LONG[@data], nwords: 1];
  RETURN
  END;

XMWrite: PUBLIC PROCEDURE [to: LONG POINTER, data: UNSPECIFIED] =
  BEGIN
  seg: SH;
  SegObj: SO;

  XMesaDefs.XCOPY[from: LONG[@data], to: to, nwords: 1];

  -- check for codesegment and write on Drum

  seg _ SegmentFromLongPointer[to];
  IF seg = BootDefs.BusyPage OR seg = BootDefs.FreePage THEN RETURN;
  DebugUsefulDefs.CopyRead[to: @SegObj, from: seg, nwords: SIZE[SO]];
  WITH s: seg SELECT FROM
    file =>
      IF s.class = code THEN
	BEGIN
	pi: POINTER TO ControlDefs.InstWord;
	chocolate: XFSH = @cSegObj;
	vanilla: FSH = @vSegObj;
	cSegObj: XFSO;
	vSegObj: FSO;
	xs: XSegInfo;
	dseg: FSH;
	ChocolateToVanilla[chocolate, vanilla, @s];
	dseg _ DebugUtilityDefs.MapUserSegment[@s];
	SegmentDefs.SwapIn[dseg];
	dseg.write _ TRUE;
	WITH c: chocolate SELECT FROM
	  remote =>
	    BEGIN
	    IF c.proc # XMESA.XMremote THEN ERROR;
	    DebugUsefulDefs.CopyRead[to: @xs, from: c.info, nwords: SIZE[XSegInfo]];
	    IF xs.seal # XMESA.InUseSeal THEN ERROR;
	    END;
	  ENDCASE => ERROR;
	pi _ SegmentDefs.FileSegmentAddress[dseg]+
	  (LOOPHOLE[XMesaDefs.LowHalfPtr[to], CARDINAL] - xs.XMpage*AltoDefs.PageSize);
	pi^ _ data;
	SegmentDefs.Unlock[dseg];
	SegmentDefs.DeleteFileSegment[dseg];
	VanillaToChocolate[vanilla, chocolate, @s];
	END;
    ENDCASE;
  RETURN
  END;

XMAllocOnDrum: PUBLIC PROCEDURE[g: GFH] RETURNS[p: POINTER] =
  BEGIN
  chocolate: XFSH = @cSegObj;
  vanilla: FSH = @vSegObj;
  cSegObj: XFSO;
  vSegObj: FSO;
  seg: FSH;

  seg _ SegmentFromFrame[g];
  ChocolateToVanilla[chocolate, vanilla, seg];
  p _ DebugUtilityDefs.AllocOnDrum[seg
	!UNWIND => VanillaToChocolate[vanilla, chocolate, seg]];
  VanillaToChocolate[vanilla, chocolate, seg];
  RETURN
  END;

XMFreeOnDrum: PUBLIC PROCEDURE[g: GFH] =
  BEGIN
  chocolate: XFSH = @cSegObj;
  vanilla: FSH = @vSegObj;
  cSegObj: XFSO;
  vSegObj: FSO;
  seg: FSH;

  seg _ SegmentFromFrame[g];
  ChocolateToVanilla[chocolate, vanilla, seg];
  DebugUtilityDefs.RemoveFromDrum[seg
	!UNWIND => VanillaToChocolate[vanilla, chocolate, seg]];
  VanillaToChocolate[vanilla, chocolate, seg];
  END;


ChocolateToVanilla: PROCEDURE [chocolate: XFSH, vanilla: FSH, seg: FSH] =
  BEGIN
  xs: XSegInfo;

  DebugUsefulDefs.CopyRead[to: chocolate, from: seg, nwords: SIZE[XFSO]];
  vanilla^ _ LOOPHOLE[chocolate^];
  WITH c: chocolate SELECT FROM
    remote =>
      BEGIN
      IF c.proc # XMESA.XMremote THEN ERROR;
      DebugUsefulDefs.CopyRead[to: @xs, from: c.info, nwords: SIZE[XSegInfo]];
      IF xs.seal # XMESA.InUseSeal THEN ERROR;
      END;
    ENDCASE => ERROR;
  vanilla.location _ disk[xs.hint];
  DebugUsefulDefs.CopyWrite[to: seg, from: vanilla, nwords: SIZE[FSO]];
  END;


VanillaToChocolate: PROCEDURE [vanilla: FSH, chocolate: XFSH, seg: FSH] =
  BEGIN
  xs: XSegInfo;

  DebugUsefulDefs.CopyRead[to: vanilla, from: seg, nwords: SIZE[FSO]];
  chocolate.file _ vanilla.file;
  chocolate.base _ vanilla.base;
  chocolate.pages _ vanilla.pages;
  chocolate.lock _ vanilla.lock;
  WITH v: vanilla SELECT FROM
    disk =>
      WITH c: chocolate SELECT FROM
	remote =>
	  BEGIN
	  DebugUsefulDefs.CopyRead[to: @xs, from: c.info, nwords: SIZE[XSegInfo]];
	  IF xs.seal # XMESA.InUseSeal THEN ERROR;
	  xs.hint _ v.hint;
	  DebugUsefulDefs.CopyWrite[to: c.info, from: @xs, nwords: SIZE[XSegInfo]];
	  END;
	ENDCASE => ERROR;
    ENDCASE => ERROR;
  DebugUsefulDefs.CopyWrite[to: seg, from: chocolate, nwords: SIZE[XFSO]];
  END;


SegmentFromFrame: PROCEDURE [g: GFH] RETURNS [FSH] =
  BEGIN
  seg: SH;
  segment: SO;
  c: GlobalFrameDefs.FrameCodeBase;
  DebugUsefulDefs.CopyRead[from: @LOOPHOLE[g, GlobalFrameDefs.GlobalFrameHandle].code,
	    to: @c, nwords: SIZE[GlobalFrameDefs.FrameCodeBase]];
  IF c.highByte # 0 THEN RETURN[c.handle];
  seg _ SegmentFromLongPointer[c.codebase];
  IF seg = BootDefs.FreePage OR seg = BootDefs.BusyPage THEN ERROR;
  DebugUsefulDefs.CopyRead[from: seg, to: @segment, nwords: SIZE[SO]];
  WITH segment SELECT FROM file => RETURN[LOOPHOLE[seg]]; ENDCASE => ERROR
  END;

SegmentFromLongPointer: PROCEDURE [p: LONG POINTER] RETURNS [seg: SH] =
  BEGIN
  bank: XMesaDefs.BankIndex;
  page: [0..256);
  table: BootDefs.SystemTableHandle = DDptr.ESV.tables;

  bank _ XMesaDefs.HighHalfPtr[p];
  IF bank ~ IN XMesaDefs.BankIndex THEN ERROR;
  page _ LOOPHOLE[XMesaDefs.LowHalfPtr[p], 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;


-- here follows the code for XCOPY

NovaBBArgBlock: TYPE = MACHINE DEPENDENT RECORD
	[
	fill: [0..37777B],
	bank: XMesaDefs.BankIndex,
	bbt: BitBltDefs.BBptr
	];

XCOPYProc: TYPE = PROCEDURE [from, to: LONG POINTER, nwords: CARDINAL];

-- Constants

maxRasterWidth: CARDINAL = 3777B;

initialBBT: BitBltDefs.BBTable =
	[
	pad: 0,
	sourcealt: FALSE, destalt: FALSE,
	sourcetype: block,
	function: replace,
	unused: 0,
	dbca: NIL,			-- will be filled in
	dbmr: maxRasterWidth,
	dlx: 0,
	dty: 0,
	dw: 0*AltoDefs.wordlength,	-- will be filled in
	dh: 0,				-- will be filled in
	sbca: NIL,			-- will be filled in
	sbmr: maxRasterWidth,
	slx: 0,
	sty: 0,
	gray0: 0, gray1: 0, gray2: 0, gray3: 0
	];

-- Global Frame Data

bbTable: ARRAY [0..SIZE[BitBltDefs.BBTable]+1) OF UNSPECIFIED;

arg: NovaBBArgBlock;

NovaCode: ARRAY [0..16) OF CARDINAL _
	[
	54415B,		-- STA	3 saveret
	115000B,	-- MOV	0 3		AC3: @arg
	22415B,		-- LDA	0 @bankno
	40413B,		-- STA	0 savebank	savebank _ EmulatorBankRegister
	21400B,		-- LDA	0 0,3
	42412B,		-- STA	0 @bankno	EmulatorBankRegister _ arg.bank
	31401B,		-- LDA	2 1,3		AC2: arg.bbt
	126400B,	-- SUB	1 1		AC1: 0
	61024B,		-- BITBLT
	20405B,		-- LDA	0 savebank
	42405B,		-- STA	0 @bankno	EmulatorBankRegister _ savebank
	34402B,		-- LDA	3 saveret
	1400B,		-- JMP	0 3
	0B,		-- saveret: 0
	0B,		-- savebank: 0
	177740B		-- bankno: 177740
	];

-- Signals

InvalidXCOPY: PUBLIC ERROR = CODE;


-- Code

XCOPYSaysBadArgs: PROCEDURE = BEGIN ERROR XMesaDefs.InvalidXCOPY END;

MakeItEven: PROCEDURE[arg: POINTER] RETURNS[POINTER] =
    MACHINE CODE BEGIN
    Mopcodes.zDUP; Mopcodes.zLI1; Mopcodes.zAND; Mopcodes.zADD
    END;

XCOPYproc: PROCEDURE RETURNS[XCOPYProc] =
    BEGIN
    OPEN XMESA;
    fromBank, toBank: XMesaDefs.BankIndex;
    nwords: CARDINAL;
    bbt: BitBltDefs.BBptr;
    state: ControlDefs.StateVector;

    state _ STATE;
    ProcessDefs.DisableInterrupts[];
    state.dest _ ControlDefs.GetReturnLink[];
    state.stkptr _ 1;
    state.stk[0] _ REGISTER[ControlDefs.Lreg];	-- first time return LocalFrameHandle
    bbt _ MakeItEven[@bbTable];
    arg _ [fill: 0, bank: 0, bbt: bbt];
    DO
    ProcessDefs.EnableInterrupts[];
    TRANSFER WITH state;

    -- Enter here from KFCB sXCOPY

    ProcessDefs.DisableInterrupts[];
    state _ STATE;
    state.dest _ state.source;
    state.stkptr _ 0;

    bbt^ _ initialBBT;
    fromBank _ state.stk[1];  bbt.sbca _ state.stk[0];
    toBank _ state.stk[3];  bbt.dbca _ state.stk[2];
    nwords _ state.stk[4];

    BEGIN -- for error exit
    IF fromBank = 0 THEN
	IF toBank = 0 THEN GO TO BogusArguments		-- "impossible" in the debugger
	ELSE
	    BEGIN
	    arg.bank _ toBank;
	    bbt.destalt _ TRUE
	    END
    ELSE
	BEGIN
	arg.bank _ fromBank;
	SELECT toBank FROM
	    = 0 => bbt.sourcealt _ TRUE;
	    = fromBank => bbt.sourcealt _ bbt.destalt _ TRUE;
	    ENDCASE => GO TO BogusArguments;
	END;

    -- BitBlt legal and necessary

    state.source _ 0;
    IF nwords > maxRasterWidth THEN
	BEGIN				-- large segment requires 2 BitBlts
	rem: [0..maxRasterWidth);
	wordsInFirstBitBlt: CARDINAL;
	bbt.dw _ maxRasterWidth*AltoDefs.wordlength;
	[bbt.dh, rem] _ InlineDefs.DIVMOD[nwords, maxRasterWidth];
	wordsInFirstBitBlt _ nwords-rem;
	[] _ NovaOps.NovaJSR[code: JSR, address: @NovaCode, arg: @arg];
	IF (nwords _ rem) # 0 THEN
	    BEGIN
	    bbt.dbca _ bbt.dbca + wordsInFirstBitBlt;
	    bbt.sbca _ bbt.sbca + wordsInFirstBitBlt
	    END
	ELSE LOOP
	END;
    bbt.dw _ nwords*AltoDefs.wordlength;
    bbt.dh _ 1;
    [] _ NovaOps.NovaJSR[code: JSR, address: @NovaCode, arg: @arg];
    EXITS
    BogusArguments => state.dest _ XCOPYSaysBadArgs;
    END;
    ENDLOOP;
    END;  -- of XCOPYproc


-- Main Body

SDDefs.SD[XMesaDefs.sXCOPY] _ XCOPYproc[];

END...