{File name nRplPtr.mc
Description:  part of DandeLion InterLisp Emulator
Author: Charnley
Last edited by Charnley:    2-Sep-83 11:30:42
Created by Charnley: 17-Jun-83 12:12:27
}

SetTask[0];

{*******************************************************************
	RPLPTR	GVAR←
*******************************************************************}


{	GVAR←
	store TOS at VALSPACE + 2 * (alpha,,beta), preserving hi byte of destination
		delref value at VALSPACE + 2 * (alpha,,beta)
		addref tos
}

ufn[27];
{Set[LoVALspace, Rshift[VALspaceL, 8]];

GVARufn:	Rx ← 27'b, GOTO[ufn2],	c1;

GVARg:	opcode[27'b],

{	Q ← uLispOptions,	c1;
	Ybus ← Q and 4, ZeroBr,	c2;
	BRANCH[$, GVARufn],	c3;
}
	Q ← VALspace, L3 ← 0,	c1;
	TT ← LoVALspace,	c2;
	TT ← TT LRot8,	c3;

	Rx ← ib, L1 ← L1.NoFixes,	c1;
	Rx ← Rx LRot8,	c2;
	Rx ← Rx or ibNA,	c3;

	Rx ← LShift1 Rx, SE ← 0,	c1;
	TT ← TT + Rx,	c2;
	rhTT ← Q LRot0, GOTO[RplMap],	c3;
}
{	RPLPTR
	store TOS at alpha + [tos - 1], preserving hi byte of destination
		delref value at [tos - 1] + alpha
		addref tos
		pop
}

RPLPTR:		opcode[24'b],
		MAR ← [rhS, S + 0], L3 ← 1,	c1;
	L1 ← L1.NoFixes,	c2;
	Rx ← MD{TOS-1.Lo},	c3;

	MAR ← [rhS, S - 1],	c1;
	TT ← Rx + ibNA, CarryBr, CANCELBR[$, 0],	c2;
	rhTT ← MD{TOS-1.Hi}, BRANCH[RplMap, RplFixVHi],	c3;

RplFixVHi:	Q ← rhTT + 1, LOOPHOLE[byteTiming],	c1;
	rhTT ← Q LRot0,	c2;
	c3;

RplMap:
	{map the address}
	Map ← Q ← [rhTT, TT], L0 ← L0.RedoRpl,	c1;
	,	c2;
	Rx ← rhRx ← MD, XDirtyDisp,	c3;

RplGet:	{mapping this reference can fault}
	{get contents of address}
	MAR ← Q ← [rhRx, Q + 0], BRANCH[RplRemap, $, 1],	c1,at[L0.RedoRpl,10,WMapFixCaller];
	uSavAddr ← Q,	c2;
	TT{oldHi} ← MD, GOTO[Rpl2ndwd],	c3;

RplRemap:
	CALL[WLMapFix],	c2;
	
Rpl2ndwd:
	MAR ← [rhRx, Q + 1],	c1;
	uSavOldHi ← TT, CANCELBR[$, 2],	c2;
	TT{oldLo} ← MD,	c3;
	{no faults from here on}

	{setup for GcLookup:
	  Rx ← addrHi & 0FF
	  TT ← addrLo
	  uGcLov ← 0 {before first call only}
	  L2 ← subr #
	  Q ← 0 if addref, 1 if delref, 2 if stkref
	  Trashes rhTT and rhRx
	  }

	Rx ← uSavOldHi,	c1;
	Rx ← Rx and 0FF,	c2;
	uGcLov ← 0{init for GcLookup to mark}, L2 ← L2.RplDel,	c3;
RplDel:	{del ref to gotten}

	Q ← rhRx,	c1;{save rhRx cuz gets smashed}
	uuRx ← Q,	c2;
	Q ← Q.DelRef, c3;

	TOSH ← TOSH and 0FF, CALL[GcLookup],	c1;

	{GcLookup Subroutine here}

	TT ← TOS, L2 ← L2.RplAdd,	c2,at[L2.RplDel,10,GcLookRet];
	Rx ← TOSH,	c3;

RplAdd:	{add ref to tos}
	Q ← Q.AddRef, CALL[GcLookup],	c1;
	
	{GcLookup Subroutine here}

RplBuild:
	{fix TOS high byte}
	Rx ← uSavOldHi{old hi},	c2,at[L2.RplAdd,10,GcLookRet];
	Rx ← Rx and ~0FF,	c3;

	TOSH ← TOSH or Rx,	c1;
	Rx ← uSavAddr{saved Addr},	c2;
	rhRx ← uuRx,	c3;

RplPut:
	{put TOSH,,TOS to address}
	MAR ← [rhRx, Rx + 0],	c1;
	MDR ← TOSH,	c2;
	TT ← uGcLov{set by GcLookup},	c3;

	MAR ← [rhRx, Rx + 1], {L3Disp,}	c1;
	MDR ← TOS, {BRANCH[GVAREnd, $, 2],}CANCELBR[$, 2], LOOPHOLE[wok],	c2;

RplPop:
	{POP}
	,	c3;

	MAR ← [rhS, S + 0],	c1;
	Xbus ← ib,	c2;
	TOS ← MD,	c3;

	MAR ← [rhS, S - 1],	c1;
	Ybus ← TT, NZeroBr, CANCELBR[$, 0],	c2;
	TOSH ← MD, BRANCH[RplNoOvXit, RplOvXit],	c3;

RplNoOvXit:	S ← S - 2,	c1;
	PC ← PC + 1, IBDisp, L2 ← L2.0, GOTO[DNI.nop],	c2;
	
RplOvXit:
	{if overflow entries, exit via GCTableScan ???}
GCTableScanExit:
	{the following works for two byte opcodes's only!}
	Rx ← AtomGCSCAN {371'b}, L3{ib's}←1, c1;
	IB ← Rx LRot0, GOTO[RplFNXIT],	c2;

RplFNXIT:
	S ← S - 2,	c3;

	MAR ← Q ← [rhS, S + 1], IBPtr ← 0, GOTO[FN1Ext],	c1;
{
GVAREnd:
	Xbus ← ib, Ybus ← TT, NZeroBr, L3{ib's}←2,	c3;
	Rx ← AtomGCSCAN {371'b}, BRANCH[GVAROvXit, GVARNoOvXit],	c1;

GVARNoOvXit:
	PC ← PC + 1, IBDisp, L2 ← L2.0,	c2;
	PC ← PC + PC16, L2 ← L2.0, DISPNI[OpTable],	c3;

GVAROvXit:
	IB ← Rx LRot0, GOTO[RplFNXIT], c2;
}


	{ E N D }