{File name RplPtr.mc
Description:  part of DandeLion InterLisp Emulator
Author: Charnley
Last edited by Charnley:    27-Oct-83 14:23:29
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
}

@GVARg:	opcode[27'b],
	TT ← VALbase, L3 ← L3.RplGvar,	c1;
	TT ← TT LRot8,	c2;
	Rx ← ib, L1 ← L1.NoFixes, XLDisp,	c3;

	Rx ← Rx LRot8, BRANCH[GVValLo, GVValHi, 1],	c1;
GVValLo:
	Q ← VALspace, GOTO[GVVal],	c2;
GVValHi:
	Q ← VALspaceHi, GOTO[GVVal],	c2;
GVVal:
	Rx ← Rx or ibNA,	c3;

	Rx ← LShift1 Rx, SE ← 0,	c1;
	TT ← TT + Rx,	c2;
	rhTT ← Q LRot0, GOTO[RplMap],	c3;

{	RPLPTR
	delref value at [tos - 1] + alpha
	addref tos
	store tos at [tos - 1] + alpha, preserving hi byte of destination
	return value is tos - 1
}

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

	MAR ← [rhS, S - 1],	c1;
	TT ← Rx + ibNA, CarryBr, CANCELBR[$, 2],	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, XwdDisp{XDirtyDisp},	c3;

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

RplRemap:
	CALL[WLMapFix],	c2, at[0, 4, RplRemap];
	CALL[WLMapFix],	c2, at[2, 4, RplRemap];
	CALL[WLMapFix],	c2, at[3, 4, RplRemap];

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
	  }

RplGo:
	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;
	,	c3;

	Q ← Q.DelRef, CALL[GcLookup],	c1;

	{GcLookup Subroutine here}

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

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

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

	MAR ← TT ← [TT, TOSH + 0],	c1;{merge bytes -- not memory ref}
	Rx ← uSavAddr{saved Addr},	c2;
	rhRx ← uuRx,	c3;

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

	MAR ← [rhRx, Rx + 1], L3Disp,	c1;
	MDR ← TOS, DISP4[RplEnd], LOOPHOLE[wok],	c2;

RplPop:
	{POP}
	,	c3, at[L3.RplPtr, 10, RplEnd];

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

	MAR ← [rhS, S - 1],	c1;
	Ybus ← uGcLov{set by GcLookup}, NZeroBr, CANCELBR[$, 2],	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 GCSCAN }
	S ← S - 2, L3{ib's} ← 1,	c1;
	Rx ← AtomGCSCAN {371'b}, c2;
RplFNXIT:
	IB ← Rx LRot0,	c3;

	MAR ← Q ← [rhS, S + 1], IBPtr ← 0, GOTO[FN1Ext],	c1;

GVAREnd:
	Xbus ← ib, Ybus ← TT, ZeroBr, L3{ib's} ← 2,	c3, at[L3.RplGvar, 10, RplEnd];
	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:
	GOTO[RplFNXIT], c2;

	{ E N D }