{	QLispRplX.mc
Created:   14-Feb-84 10:54:19 by don
Last edit:   23-Oct-85 15:01:50 by don
}

SetTask[0];

#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

{	returned value is: tos-1}

- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      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
	if cdrcode<200Q
	{a}	rplptr cell+2*cdrcode with tos
{bcd}	elseif tos is NIL
		{c}	if CDRCODE #{>} 200, deleteref cell.base+2*(cdrcode-200)
			change cdrcode to 200
		{d}	else return
	elseif tos is on same page as cell
	{b}	if cdrcode#200,
			addref TOS
			deleteref cell.base+2*(cdrcode-200)
			change cdrcode to 200+(cell# of TOS)
		else call UFN {this punts on cases where RPLACD must allocate space}

{	returned value is: tos-1}

- - - - - - - - - - - - - - - - - - - - - - - - - -
}

{	all these start by verifying that tos-1 is a LISTP 
}
@RPLACA:	opcode[30'b],
	MAR _ [rhS, S - 1], L3 _ L3.RPLACA,	c1;
	rhRx _ crhTypeTable, CANCELBR[rplTypC3, 2],	c2;

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

rplTypC3:
	rhTT _ TT _ MD,	c3;

	MAR _ [rhS, S + 0],	c1;
	,	c2;
	Rx _ MD,	c3;

	Q _ Rx,	c1;
	,	c2;
	,	c3;

	MAR _ Rx _ [Rx, TT + 0],	c1;{byte merge}
	Rx _ Rx LRot8, 	c2;
	Rx _ Rx RShift1, getTypemsBit,	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],	c1;
	Ybus _ Rx - 1, PgCarryBr,	c2;
	rhRx _ Rx _ MD, XwdDisp, BRANCH[$, rplUfn],	c3;

	uTOSm1 _ TT, DISP2[rplxremap],	c1, at[L0.RedoRplX, 10, WxMapFixCaller];
	Q _ rhTT,	c2, at[PgDirty, 4, rplxremap];
	uTOSHm1 _ Q,	c3;

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

	MAR _ [rhRx, Rx + 1], GOTO[rplad],	c1, at[L3.RPLACA, 10, rpls];
	MAR _ [rhRx, Rx + 1], GOTO[rplad],	c1, at[L3.RPLACD, 10, rpls];
rplad:
	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 _ uGcLov, 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;
	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;{cdrcode >= 200'b}
	uGcLov _ 0, BRANCH[rpldnextb, rpldnextcd],	c2;

rpldnextcd:	{tos = NIL}
	Ybus _ Rx - 1, PgCarryBr,	c3;{test if cdrcode = 200'b}

	BRANCH[rpldnextd, rpldnextc],	c1;

rpldnextc:	{cdrcode > 200}
	{change cdrcode to 200}
	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 {c2}
	  Q _ Q.AddRef or Q.DelRef
	  Trashes rhTT and rhRx
	  }

	Rx _ uTOSHm1, L2 _ L2.rplx1,	c3;

	TT _ uTOSm1,	c1;
	TOS _ uuRx,	c2;
	Q _ Q.DelRef,	c3;

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

	{GcLookup Subroutine here}

		at[L2.rplx1,10,GcLookRet],
	GOTO[rplxC3xx],	c2;

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

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

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

rplxhinok:
	GOTO[ufnX2],	c1;

rplxhiok:
	Q _ TOS xor Q,	c1;
	Ybus _ Q and ~u0FF, ZeroBr,	c2;
	BRANCH[rplxlonok, rplxlook],	c3;


rplxlonok:
	GOTO[ufnX2],	c1;

rplxlook:
{	current state:
	uuRx and Rx low 8 bits contain  2 * (cdrcode - 200'b)
	uTOSHm1,,uTOSm1 contains VA of cell
	TT contains cell low contents
	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 high contents
	}
	{change cdrcode to 200'b + cell#[tos]}
	TT _ uSavOldHi,	c1;
	TT _ TT and 0FF,	c2;
	Rx _ RShift1 TOS,	c3;

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

	TT _ TT or Rx,	c1;
	Rx _ uSavAddr,	c2;
	Q _ Q.AddRef{for later},	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	MDR _ TT,	c2;
	{addref tos}

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

	TT _ TOS, CALL[GcLookup],	c1;

	{GcLookup Subroutine here}

		at[L2.rplx2, 10, GcLookRet],
	{if old cdrcode # 200, then delref  rhTT,,TThi,,Rxlo}
	Rx _ uuRx,	c2;{for low 8 bits of delref}
	TT _ uTOSm1,	c3;{for mid 8 bits of delref}

	{setup for delref  rhTT,,TThi,,Rxlo}
	MAR _ TT _ [TT, Rx + 0], L2 _ L2.rplx1,{shares exit}	c1;{byte merge}
	Rx _ uSavOldHi,	c2;
	Rx _ Rx LRot8,	c3;

	Rx _ LShift1 Rx, SE _ 0,	c1;
	Ybus _ Rx - 1, PgCarryBr,	c2;
	Rx _ uTOSHm1, BRANCH[rplxDfin, $],	c3;

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

	{GcLookup Subroutine here}

rplxDfin:
	,	c1;
	GOTO[rplxC3xx],	c2;


{	exceptions }

	GOTO[WxLMapFix],	c2, at[PgClean, 4, rplxremap];
	GOTO[WxLMapFix],	c2, at[PgProt, 4, rplxremap];
	GOTO[WxLMapFix],	c2, at[PgVacant, 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 dirtyFlag, L0Disp, GOTO[ReWxrite],	c2, at[1,4,FixWxFlags];
	GOTO[RWTrap],	c2, at[3,4,FixWxFlags];

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

	{ E N D }