{
LispRplX.mc
Created:   14-Feb-84 10:54:19 by don
Last edit:   14-Feb-84 10:54:23 by don
}

SetTask[0];

Set[L2.rplx1, 0A];{RPLACD}
Set[L2.rplx2, 0B];{RPLACD}
#LispRplX:


{
- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
 30      RPLACA      0        -1                 RPLACA

if TOS-1 not LISTP, call UFN
Fetch @[TOS-1].
if cdrcode=0, follow indirect
Do RPLPTR with TOS
value is TOS-1.

{	returned value is: tos-1}

[not required; in Dorado; not in D0]


- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
 31      RPLACD      0        -1                 RPLACD

if tos-1 not listp, call ufn
fetch @ tos-1
if cdrcode=0, follow indirect
{a}	if cdrcode<200Q
		rplptr cell+2*cdrcode with tos
{cd}	elseif TOS is NIL
	{c}	if CDRCODE#200, deleteref cell+2*(cdrcode-200)
		change cdrcode to 200
{b}	elseif TOS is on same page as cell
		addref TOS
		if cdrcode#200, deleteref cell+2*(cdrcode-200)
		change cdrcode to 200+(cell# of TOS)
	else (can call UFN on this case)
		(this punts on cases where RPLACD must allocate space)

{	returned value is: tos-1}

[not required; in Dorado; not in D0]

- - - - - - - - - - - - - - - - - - - - - - - - - -
}

{	all these start by verifying that tos-1 is a LISTP 
}

@RPLACA:	opcode[30'b],
	MAR _ [rhS, S - 1], L3 _ L3.RPLACA,	c1;
	rhRx _ MDSTYPEspaceReal, CANCELBR[rplTypC3, 2],	c2;

@RPLACD:	opcode[31'b],
	MAR _ [rhS, S - 1], L3 _ L3.RPLACD,	c1;
	rhRx _ MDSTYPEspaceReal, CANCELBR[rplTypC3, 2],	c2;

rplTypC3:
	rhTT _ TT _ MD,	c3;

	MAR _ [rhS, S + 0],	c1;
	Xbus _ TT LRot12, XDisp,	c2;
	Rx _ MD, DISP4[rplTypDisp, 3],	c3;{check if virtual address > 22 bits}

	Q _ Rx,	c1, at[03, 10, rplTypDisp];
	,	c2;
	,	c3;

	MAR _ Rx _ [Rx, TT + 0],	c1;{byte merge}
	Rx _ Rx LRot8, 	c2;
	Rx _ Rx RShift1, SE_1,	c3;

	MAR _ [rhRx, Rx + 0], L1 _ L1.NoFixes,	c1;
	Rx _ ListType,	c2;
	Rx _ MD xor Rx, L0 _ L0.RedoRplX,	c3;

rplxmap:
	Map _ TT _ [rhTT, Q], L3Disp,	c1;
	Ybus _ Rx - 1, PgCarryBr, DISP4[rpls],	c2;
	rhRx _ Rx _ MD, XwdDisp, BRANCH[rplNoUfn, rplUfn],	c3, at[L3.RPLACA, 10, rpls];
	rhRx _ Rx _ MD, XwdDisp, BRANCH[rplNoUfn, rplUfn],	c3, at[L3.RPLACD, 10, rpls];

rplNoUfn:
	MAR _ Q _ [rhRx, Q + 0], DISP2[rplxremap],	c1, at[L0.RedoRplX, 10, WxMapFixCaller];
	uSavAddr _ Q,	c2, at[1, 4, rplxremap];
	rhTT _ TT _ MD,	c3;

	MAR _ [rhRx, Q + 1],	c1;
	Rx _ TT LRot8, CANCELBR[$, 2],	c2;
	Q _ MD,	c3;

	Ybus _ Rx - 1, PgCarryBr,	c1;
	uSavOldHi _ TT, BRANCH[rplindir, rpldir],	c2;

rplindir:
	Rx _ 0, GOTO[rplxmap],	c3;	{cdrcode = 0'b}

rpldir:
	TT _ Q, L3Disp,	c3;

	DISP4[rplacxNow],	c1;

		at[L3.RPLACA, 10, rplacxNow],
	,	c2;
	GOTO[RplGo],	c3;

{	RplGo:
	performs delref on cell contents
	performs addref on tos
	replaces cell contents with tos, but retains high byte
	setup:
	  TOSH has high tos value
	  TOS has low tos value
	  uSavOldHi has high contents of cell
	  TT has low contents of cell
	  rhRx has high real addr of cell
	  uSavAddr has low real addr of cell
	L3 used for return via RplEnd
	TT returns with uGcLov { # 0 if overflows from GcLookup}
	trashes Q, Rx, rhTT, L2
	no ufns or faults can occur
	}

rplxC3xx:
		at[L3.RPLACA, 10, RplEnd],
	,	c3;

rplxC1xx:
	MAR _ [rhS, S + 0],	c1;
	,	c2;
	TOS _ MD,	c3;

	MAR _ [rhS, S - 1],	c1;
	Ybus _ TT, NZeroBr, CANCELBR[$, 2],	c2;
	TOSH _ MD, BRANCH[rplxNoOvXit, rplxOvXit],	c3;

rplxNoOvXit:	S _ S - 2, GOTO[IB.pc1],	c1;
	
rplxOvXit:
	{if overflow entries, exit via GCSCAN }
	S _ S - 2, L3{ib's} _ 0,	c1;
	Rx _ AtomGCSCAN {371'b}, GOTO[RplFNXIT], c2;

{	end of rplaca -- start of rplacd }

		at[L3.RPLACD, 10, rplacxNow],
	{if cdrcode < 200'b, then rplptr page[tos-1] + (2 * cdrcode) with tos}
	Rx _ Rx + Rx, PgCarryBr,	c2;
	uuRx _ Rx, BRANCH[rpldnexta, rpldnextbcd],	c3;

	{rplptr page[tos-1] + (2 * cdrcode) with tos}
rpldnexta:
	TT _ Rx,	c1;{cdrcode < 200'b}
	L3 _ L3.RPLACA{share exit from RplPtr},	c2;
	Rx _ uSavAddr,	c3;

	MAR _ Rx _ [Rx, TT + 0],	c1;{byte merge}
	,	c2;
	,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	uSavAddr _ Rx,	c2;
	TT _ MD,	c3;

	MAR _ [rhRx, Rx + 1],	c1;
	uSavOldHi _ TT, CANCELBR[$, 2],	c2;
	TT _ MD, GOTO[RplGo],	c3;

rpldnextbcd:
	Ybus _ TOS or TOSH, ZeroBr,	c1;
	uGcLov _ 0, BRANCH[rpldnextb, rpldnextcd],	c2;

rpldnextcd:	{tos = NIL}
	Ybus _ Rx - 1, PgCarryBr,	c3;

	BRANCH[rpldnextd, rpldnextc],	c1;

rpldnextc:	{cdrcode > 200}
	{change cdrcode to 200}
	GOTO[ufnX3],	c2;extralabel:
	Rx _ uSavAddr,	c2;
	TT _ uSavOldHi,	c3;

	TT _ TT and 0FF,	c1;
	TT _ LShift1 TT,	c2;
	TT _ RShift1 TT, SE _ 1,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	MDR _ TT,	c2;

	{delref cell page + 2 * cdrcode}

	{setup for GcLookup:
	  Rx _ addrHi & 0FF
	  TT _ addrLo
	  uGcLov _ 0 {before first call only}
	  L2 used for return via GcLookRet {c3}
	  Q _ Q.AddRef, Q.DelRef, or Q.StkRef
	  Trashes rhTT and rhRx
	  }

	Rx _ 0FF, L2 _ L2.rplx1,	c3;

	MAR _ [rhS, S - 1],	c1;
	TOS _ uuRx, CANCELBR[$, 2],	c2;
	Rx _ MD and Rx,	c3;

	MAR _ [rhS, S + 0],	c1;
	Q _ Q.DelRef,	c2;
	TT _ MD,	c3;

	MAR _ TT _ [TT, TOS + 0], CALL[GcLookup],	c1;{byte merge}

	{GcLookup Subroutine here}

		at[L2.rplx1,10,GcLookRet],
	GOTO[rplxC1xx],	c3;

rpldnextd:	{cdrcode = 200}
	{all thru}
	TT _ 0, GOTO[rplxC3xx],	c2;

rpldnextb:	{tos # NIL}
	{test if tos on same page as cell { = rhTT,,TT } }
	{if not then can ufn}
	Q _ rhTT,	c3;

	Q _ Q xor TOSH,	c1;
	Q _ Q - 1, PgCarryBr,	c2;
	Q _ TT xor TOS, BRANCH[rplxhiok, rplxhinok],	c3;

rplxhinok:
	GOTO[ufnX2],	c1;

rplxhiok:
	Q _ Q and uFF00,	c1;
	Ybus _ Q, ZeroBr,	c2;
	BRANCH[rplxlonok, rplxlook],	c3;

rplxlonok:
	GOTO[ufnX2],	c1;

rplxlook:
{	current state:
	Rx low 8 bits contain  2 * (cdrcode - 200'b)
	TT contains cell virtual addr low
	rhTT contains cell virtual addr high
	tos is in TOSH,,TOS
	rhRx contains cell real addr high
	uSavAddr contains cell real addr low
	uSavOldHi contains cell cdrcode and virtual addr high
	}
	{addref tos}

	{setup for GcLookup:
	  Rx _ addrHi & 0FF
	  TT _ addrLo
	  uGcLov _ 0 {before first call only}
	  L2 used for return via GcLookRet {c3}
	  Q _ Q.AddRef, Q.DelRef, or Q.StkRef
	  Trashes rhTT and rhRx
	  }
	GOTO[ufnX2],	c1;randomlabel:
	uRx _ Rx,	c1;
	uTT _ TT,	c2;
	,	c3;

	,	c1;
	Q _ rhRx,	c2;
	urh _ Q,	c3;

	uGcLov _ 0,	c1;
	Rx _ TOSH and 0FF,	c2;
	TT _ TOS, L2 _ L2.rplx2,	c3;

	Q _ Q.AddRef, GOTO[GcLookup],	c1;

	{GcLookup Subroutine here}

		at[L2.rplx2, 10, GcLookRet],
	{change cdrcode to 200'b + cell#[tos]}
	TT _ uSavOldHi,	c3;

	rhRx _ urh,	c1;
	TT _ TT and 0FF,	c2;
	Rx _ RShift1 TOS,	c3;

	Rx _ Rx or 80,	c1;
	Rx _ Rx and 0FF,	c2;
	Rx _ Rx LRot8,	c3;

	Q _ 0FF,	c1;
	TT _ TT or Rx,	c2;
	Rx _ uSavAddr,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	MDR _ TT,	c2;
	{if old cdrcode # 200, then delref  rhTT,,TThi,,Rxlo}
	Ybus _ Q and uRx, ZeroBr,	c3;

	BRANCH[$, rplxDfin],	c1;
	{delref  rhTT,,TThi,,Rxlo}
	Rx _ uRx,	c2;
	TT _ uTT,	c3;

	MAR _ TT _ [rhTT, Rx + 0],	c1;{byte merge}
	Rx _ uSavOldHi,	c2;
	Rx _ Rx and 0FF, L2 _ L2.rplx1,{shares exit}	c3;

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

	{GcLookup Subroutine here}

rplxDfin:
	TT _ uGcLov, GOTO[rplxC3xx],	c2;


{	exceptions }

	GOTO[ufnX2],	c1, at[07, 10, rplTypDisp];
	GOTO[ufnX2],	c1, at[0B, 10, rplTypDisp];
	GOTO[ufnX2],	c1, at[0F, 10, rplTypDisp];

	GOTO[WxLMapFix],	c2, at[0, 4, rplxremap];
	GOTO[WxLMapFix],	c2, at[2, 4, rplxremap];
	GOTO[WxLMapFix],	c2, at[3, 4, rplxremap];

rplUfn:
	CANCELBR[ufnX2, 3],	c1;

{*************************
	Write Map Update Subroutine {extra}
**************************}
{Timing: 4 cycles}
{Enter at cycle 3, returns to cycle1}
{returns thru L0 if map fixed ok}
{returns thru L1 if wants to trap}

WxLMapFix:	Xbus _ Rx LRot0, XwdDisp,	c3;
	Map _ [rhTT, TT], DISP2[FixWxFlags, 1],	c1;

FixWxFlags:
	MDR _ Rx or 030, L0Disp, GOTO[ReWxrite],	c2, at[1,4,FixWxFlags];
	GOTO[RWTrap],	c2, at[3,4,FixWxFlags];

ReWxrite:
	Xbus _ 1, XDisp, RET[WxMapFixCaller],	c3;

	{ E N D }