{
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
{ 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+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+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 ← 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:
uTOSm1 ← TT, DISP2[rplxremap], c1, at[L0.RedoRplX, 10, WxMapFixCaller];
Q ← rhTT, c2, at[1, 4, rplxremap];
uTOSHm1 ← Q, c3;
MAR ← Q ← [rhRx, TT + 0], c1;
uSavAddr ← Q, c2;
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;{cdrcode >= 200'b}
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 or Q.DelRef
Trashes rhTT and rhRx
}
Rx ← 0FF, L2 ← L2.rplx1, c3;
Q ← uTOSHm1, c1;
TT ← uTOSm1, c2;
TOS ← uuRx, c3;
MAR ← TT ← [TT, TOS + 0], c1;{byte merge}
Rx ← Q and Rx, c2;
, c3;
Q ← Q.DelRef, CALL[GcLookup], c1;
{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 { = uTOSHm1,,uTOSm1 } }
{if not then can ufn}
Q ← uTOSHm1, c3;
Q ← Q xor TOSH, c1;
Q ← Q - 1, PgCarryBr, c2;
Q ← uTOSm1, BRANCH[rplxhiok, rplxhinok], c3;
rplxhinok:
GOTO[ufnX2], c1;
rplxhiok:
Q ← TOS xor Q, c1;
Q ← Q and uFF00, c2;
Ybus ← Q, ZeroBr, c3;
BRANCH[rplxlonok, rplxlook], c1;
rplxlonok:
GOTO[ufnX3], c2;
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[ufnX3], c2;randomlabel:
uRx ← Rx, c2;
, c3;
uTT ← TT, 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 }