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