{
LispRplX.mc
Created: 14-Feb-84 10:54:19 by don
Last edit: 14-Feb-84 10:54:23 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[1, 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[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 }