{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 }