-- MesaCompatible.mesa; edited by Levin, October 16, 1978  3:14 PM

DIRECTORY
  AllocDefs: FROM "allocdefs" USING [GetAllocationObject],
  AltoDefs: FROM "AltoDefs" USING [MaxVMPage, PageNumber, PageSize, wordlength],
  BitBltDefs: FROM "BitBltDefs" USING [BBptr, BBTable],
  ControlDefs: FROM "controldefs" USING [GlobalFrameHandle, GetReturnLink, Lreg, StateVector],
  FrameDefs: FROM "framedefs" USING [SwapInCode],
  GlobalFrameDefs: FROM "globalframedefs" USING [GlobalFrameHandle],
  CodeDefs: FROM "codedefs",
  InlineDefs: FROM "InlineDefs" USING [BITAND, COPY, DIVMOD, LongCARDINAL],
  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 [
    DataSegmentHandle, FileSegmentHandle, SegmentHandle, SwapError, Unlock],
  XMESA: FROM "XMesaPrivateDefs" USING [BankMasks, memoryConfig, XDataSegmentHandle, XFileSegmentHandle,
		XMremote],
  XMesaDefs: FROM "XMesaDefs" USING [BankIndex, HighHalfPtr, LowHalfPtr, MaxXPage, MemoryConfig,
		PagesPerBank, sXCOPY];

DEFINITIONS FROM ControlDefs, XMesaDefs;

MesaCompatible: PROGRAM
  IMPORTS AllocDefs, FrameDefs, SegmentDefs, XMesaDefs
  EXPORTS CodeDefs, XMESA, XMesaDefs
  SHARES XMESA = BEGIN


-- Procedures Exported to CodeDefs

  CodeHandle: PUBLIC PROCEDURE [frame:GlobalFrameHandle]
    RETURNS [SegmentDefs.FileSegmentHandle] =
    BEGIN OPEN f: LOOPHOLE[frame, GlobalFrameDefs.GlobalFrameHandle];
    RETURN[IF f.code.highByte # 0 THEN frame.codesegment
      ELSE XVMtoFileSegment[f.code.codebase]];
    END;

  Codebase: PUBLIC PROCEDURE [frame:GlobalFrameHandle] RETURNS [LONG POINTER] =
    BEGIN OPEN f: LOOPHOLE[frame, GlobalFrameDefs.GlobalFrameHandle];
    FrameDefs.SwapInCode[frame];
    RETURN[IF f.code.highByte # 0 THEN LONG[f.code.shortCodebase] ELSE f.code.codebase]
    END;

  ReleaseCode: PUBLIC PROCEDURE [frame:GlobalFrameHandle] =
    BEGIN OPEN SegmentDefs;
    seg: FileSegmentHandle = CodeHandle[frame];
    IF seg # NIL THEN Unlock[seg];
    RETURN
    END;

-- Procedures Exported to XMesaDefs

  ImmovableSegmentInHighBank: PUBLIC SIGNAL [SegmentDefs.FileSegmentHandle] = CODE;
  InvalidLongPointer: PUBLIC ERROR [ptr: LONG POINTER] = CODE;
  InvalidXMPage: PUBLIC ERROR [page: AltoDefs.PageNumber] = CODE;

  PAGEDISP: TYPE = MACHINE DEPENDENT RECORD[
    page: [0..AltoDefs.MaxVMPage],
    disp: [0..AltoDefs.PageSize)];

  LongAddressFromPage: PUBLIC PROCEDURE[page: AltoDefs.PageNumber] RETURNS[lp: LONG POINTER] =
    BEGIN
    bank: BankIndex; relpn: AltoDefs.PageNumber;
    lc: InlineDefs.LongCARDINAL;
    IF page ~IN [0..MaxXPage] THEN ERROR InvalidXMPage[page];
    [bank, relpn] ← InlineDefs.DIVMOD[page, PagesPerBank];
    lc ← [lowbits: LOOPHOLE[PAGEDISP[page: relpn, disp: 0]], highbits: bank];
    RETURN[LOOPHOLE[lc]];
    END;

  PageFromLongAddress: PUBLIC PROCEDURE[lp: LONG POINTER] RETURNS[page: AltoDefs.PageNumber] =
    BEGIN
    bank: BankIndex ← HighHalfPtr[lp];
    IF bank ~IN BankIndex THEN ERROR InvalidLongPointer[lp];
    RETURN[bank*PagesPerBank+LOOPHOLE[LowHalfPtr[lp],PAGEDISP].page];
    END;

  XVMtoSegment: PUBLIC PROCEDURE [a: LONG POINTER] RETURNS [SegmentDefs.SegmentHandle] = 
    BEGIN
    RETURN[AllocDefs.GetAllocationObject[].status[PageFromLongAddress[a]].seg]
    END;

  XSegmentAddress: PUBLIC PROCEDURE [seg: SegmentDefs.SegmentHandle] RETURNS [LONG POINTER] = 
    BEGIN
    WITH s: seg SELECT FROM
      data => RETURN[XDataSegmentAddress[@s]];
      file => RETURN[IF ~s.swappedin THEN NIL ELSE XFileSegmentAddress[@s]];
      ENDCASE
    END;

  XVMtoDataSegment: PUBLIC PROCEDURE [a: LONG POINTER] RETURNS [SegmentDefs.DataSegmentHandle] = 
    BEGIN
    seg: SegmentDefs.SegmentHandle ← XVMtoSegment[a];
    IF seg # NIL THEN
      WITH ds: seg SELECT FROM data => RETURN[@ds]; ENDCASE;
    RETURN[NIL]
    END;

  XDataSegmentAddress: PUBLIC PROCEDURE [seg:SegmentDefs.DataSegmentHandle] RETURNS [LONG POINTER] =
    BEGIN OPEN s: LOOPHOLE[seg, XMESA.XDataSegmentHandle];
    vmpage: AltoDefs.PageNumber ← IF s.VMpage # 0 THEN seg.VMpage ELSE s.XMpage;
    RETURN[LOOPHOLE[LOOPHOLE[LONG[vmpage],LONG INTEGER]*AltoDefs.PageSize]]
    END;

  XVMtoFileSegment: PUBLIC PROCEDURE [a: LONG POINTER] RETURNS [SegmentDefs.FileSegmentHandle] =
    BEGIN
    seg: SegmentDefs.SegmentHandle ← XVMtoSegment[a];
    IF seg # NIL THEN
      WITH fs: seg SELECT FROM file => RETURN[@fs]; ENDCASE;
    RETURN[NIL]
    END;

  XFileSegmentAddress: PUBLIC PROCEDURE [seg: SegmentDefs.FileSegmentHandle] RETURNS [LONG POINTER] =
    BEGIN
    vmpage: AltoDefs.PageNumber ← seg.VMpage;
    IF ~seg.swappedin THEN ERROR SegmentDefs.SwapError[seg];
    WITH xs: LOOPHOLE[seg, XMESA.XFileSegmentHandle] SELECT FROM
	remote => IF xs.proc = XMESA.XMremote THEN vmpage ← xs.info.XMpage;
	ENDCASE;
    RETURN[LongAddressFromPage[vmpage]]
    END;

-- the remainder of this module is XCOPY

-- Types

NovaBBArgBlock: TYPE = MACHINE DEPENDENT RECORD
	[
	fill: [0..37777B],
	bank: 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

XMNotAvailable: PUBLIC ERROR = CODE;

InvalidXCOPY: PUBLIC ERROR = CODE;


-- Code

XBitBlt: PUBLIC PROCEDURE[bbt:BitBltDefs.BBptr, bank:BankIndex] =
    BEGIN
    OPEN XMesaDefs, XMESA;
    arg: NovaBBArgBlock ← [fill: 0, bank: bank, bbt: bbt];
    IF (bank ~IN BankIndex) OR
       ((bbt.sourcealt OR bbt.destalt) AND
        ~(memoryConfig.useXM AND (InlineDefs.BITAND[BankMasks[bank],memoryConfig.banks] # 0))) THEN
	    ERROR XMNotAvailable;
    [] ← NovaOps.NovaJSR[code: JSR, address: @NovaCode, arg: @arg];
    END;

XCOPYSaysBadArgs: PUBLIC PROCEDURE = BEGIN ERROR InvalidXCOPY END;

XCOPYSaysNoXM: PUBLIC PROCEDURE = BEGIN ERROR XMNotAvailable 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: BankIndex;
    nwords: CARDINAL;
    bbt: BitBltDefs.BBptr;
    state: ControlDefs.StateVector;

    state ← STATE;
    ProcessDefs.DisableInterrupts[];
    state.dest ← ControlDefs.GetReturnLink[];
    state.source ← 0;
    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 BEGIN state.source ← 0; GO TO SimpleCOPY END
	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;
    IF ~(memoryConfig.useXM AND InlineDefs.BITAND[BankMasks[arg.bank],memoryConfig.banks] # 0) THEN
	GO TO CantDoIt;

    -- 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
    SimpleCOPY => InlineDefs.COPY[from: bbt.sbca, to: bbt.dbca, nwords: nwords];
    CantDoIt => state.dest ← XCOPYSaysNoXM;
    BogusArguments => state.dest ← XCOPYSaysBadArgs;
    END;
    ENDLOOP;
    END;  -- of XCOPYproc


-- Memory configuration

memoryConfig: MemoryConfig;

InitMemoryConfig: PUBLIC PROCEDURE =
  BEGIN
  memoryConfig ← XMESA.memoryConfig↑;
  IF LOOPHOLE[XMESA.memoryConfig, POINTER TO CARDINAL]↑ = 77400B THEN -- Swat Breakpoint
    memoryConfig ← [reserved: 0, AltoType: unknown, useXM: FALSE, unused: 0, secondROM: FALSE, banks: 10B,
		    mesaMicrocodeVersion: 0, XMMicrocodeVersion:0];
  END;

GetMemoryConfig: PUBLIC PROCEDURE RETURNS [MemoryConfig] =
  BEGIN
  RETURN[memoryConfig];
  END;

-- Main Body

InitMemoryConfig[];
SDDefs.SD[sXCOPY] ← XCOPYproc[];

END...