{LispFmemb.mc
cal: 13-Dec-84 13:53:18
}
{- - - - - - - - - - - - - - - - - - - - - - - - - -
# name len-1 stk level effect UFN table entry
34 FMEMB 0 -1 FMEMB
(FMEMB arg list)
if list=NIL, return NIL
if list is not LISTP, call UFN
if (CAR list)=arg, return list
list ← (CDR list)
loop
}
@FMEMB: opcode[34'b],
{fetch tos-1}
MAR ← [rhS, S - 1], L3 ← L3.fmemb, c1;
Ybus ← TOSH or TOS, ZeroBr, CANCELBR[fmcomm, 2], c2;{test if tos = nil}
fmcomm:
TT ← MD, BRANCH[$, commretnil] c3;{hi 16 bits of tos-1}
MAR ← [rhS, S + 0], c1;
uTOSHm1 ← TT, c2;{uTOSHm1 ← hi 16 bits of tos-1}
TT ← MD, c3;{lo 16 bits of tos-1}
uTOSm1 ← TT, c1;{uTOSm1 ← lo 16 bits of tos-1}
TT ← TOSH and 0FF, c2;
Rx ← TOS, CALL[CADR] c3;
{
CADR SUBROUTINE: takes ptr to CONS cell, returns CAR and CDR of cell
Rx has lo bits of VA of cell
TT has hi bits of VA of cell
L3 used for return thru CADRret
trashes Q, L0, L1, rhRx, rhTT
trashes uTT, uRx, UQSave
returns:
TT has hi bits of CDR of cell
Rx has lo bits of CDR of cell
uCARlo has lo bits of CAR of cell
uCARhi has hi bits of CAR of cell
will ufnX if cdrcell not NIL or type list
will pagefault {NoFixes} if cell page faults
}
at[L3.fmemb, 10, CADRret],
{test if CAR = tos-1}
Q ← uTOSm1, c1;
Q ← Q xor uCARlo, c2;
Ybus ← Q , ZeroBr, c3;
Q ← uTOSHm1, BRANCH[fmlonok, $], c1;
Q ← Q xor uCARhi, c2;
Ybus ← Q - 1, PgCarryBr, c3;
BRANCH[fmCARequaltosm1, fmhinok], c1;
fmlonok:
Ybus ← Rx or TT, ZeroBr, GOTO[fmgoagain], c2;
fmhinok:
Ybus ← Rx or TT, ZeroBr, GOTO[fmgoagain], c2;
fmgoagain:
TOS ← Rx, MesaIntBr, BRANCH[fmtestint, fmretnil], c3;{will use old return point}
fmCARequaltosm1: {tos-1 = car}
S ← S - 2, IBDisp, L2 ← L2.0, GOTO[DNI.pc1], c2;{return current TOSH TOS}
commretnil:
GOTO[fmnilexit], c1;
fmretnil: {return nil}
CANCELBR[fmnilexit], c1;
fmnilexit:
TOSH ← 0, c2;
TOS ← 0, GOTO[fmexit] c3;
fmexit:
S ← S - 2, GOTO[IB.pc1], c1;
{test for interrupt}
fmtestint:
TOSH ← TT and 0FF, BRANCH[fmnoint1, fmtestint1], c1;
fmtestint1:
Ybus ← uWP, ZeroBr, c2;
Ybus ← uWDC, NZeroBr, BRANCH[$, fmnoint2], c3;
uWP ← 0, BRANCH[fmIntNow, fmnoint3], c1;
fmIntNow:
, c2;
GOTO[BLTIntNow], c3;
{ ClrIntErr, Rx ← 1, c1;
uWDC ← Rx,{off interrupts} c2;
Rx ← KbdFXP, L2 ← 0, GOTO[PUNT], c3;
}
fmnoint2: CANCELBR[$], c1;
fmnoint3: GOTO[fmNOint], c2;
fmnoint1: GOTO[fmNOint], c2;
fmNOint: CALL[CADR], c3;
{- - - - - - - - - - - - - - - - - - - - - - - - - -
# name len-1 stk level effect UFN table entry
26 ASSOC 0 -1 FASSOC
(ASSOC key alist)
returns the first sublist of alist whose car is EQ key
else returns nil
- - - - - - - - - - - - - - - - - - - - - - - - - -}
{
if (CAR (CAR alist) ) = key then return (CAR alist)
alist ← (CDR alist)
interrupt test and loopback
}
@ASSOC: opcode[26'b],
MAR ← [rhS, S - 1], L3 ← L3.fassoc1, c1;
Ybus ← TOSH or TOS, ZeroBr, CANCELBR[fmcomm, 2], c2;
{
SUBROUTINE: takes ptr to CONS cell, returns CAR and CDR of cell
Rx has lo bits of VA of cell
TT has hi bits of VA of cell
L3 used for return thru CADRret
trashes Q, L0, L1, rhRx, rhTT
trashes uTT, uRx, uPV
returns:
TT has hi bits of CDR of cell
Rx has lo bits of CDR of cell
uCARlo has lo bits of CAR of cell
uCARhi has hi bits of CAR of cell
will ufnX if cdrcell not NIL or type list
will pagefault {NoFixes} if cell page faults
}
at[L3.fassoc1, 10, CADRret],
{save CDR}
uCDRhi ← TT, c1;
uCDRlo ← Rx, c2;
{save CAR}
TT ← uCARhi, L3 ← L3.fassoc2, c3;
Rx ← uCARlo, c1;
uCARsavlo ← Rx, c2;
uCARsavhi ← TT, CALL[CADR], c3;
at[L3.fassoc2, 10, CADRret],
{compare CAR with tos-1}
Q ← uTOSHm1, c1;
Q ← Q xor uCARhi, c2;
Rx ← Q, c3;
Q ← uTOSm1, c1;
Q ← Q xor uCARlo, c2;
Ybus ← Q or Rx, ZeroBr, c3;
BRANCH[fassocback, fassocfound], c1;
fassocback:
TT ← uCDRhi, L3 ← L3.fassoc1, c2;
Rx ← uCDRlo, c3;
Ybus ← TT or Rx, ZeroBr, c1;
TOS ← Rx, BRANCH[$, fassocretnil], c2;
GOTO[fmtestint], c3;
fassocfound:
TOSH ← uCARsavhi, c2;
TOS ← uCARsavlo, GOTO[fmexit], c3;
fassocretnil:
TOSH ← 0, GOTO[fmexit], c3;
{- - - - - - - - - - - - - - - - - - - - - - - - - -
# name len-1 stk level effect UFN table entry
47 LISTGET 0 -1 ??
(LISTGET plist prop)
returns the first value of plist whose property is EQ prop
else returns nil
- - - - - - - - - - - - - - - - - - - - - - - - - -}
{
if (CAR plist) = prop then return (CAR (CDR plist) )
plist ← (CDR (CDR plist) )
interrupt test and loopback
}
@LISTGET: opcode[47'b],
MAR ← [rhS, S - 1], L3 ← L3.fprop1, c1;
TT ← 0FF, CANCELBR[$, 2], c2;
TT ← MD and TT, c3;{hi 16 bits of tos-1}
MAR ← [rhS, S + 0], c1;
, c2;
Rx ← MD, c3;{lo 16 bits of tos-1}
Ybus ← TT or Rx, ZeroBr, c1;
BRANCH[$, lgretnil], c2;
CALL[CADR], c3;
lgretnil:
GOTO[commretnil], c3;
at[L3.fprop1, 10, CADRret],
{test if CAR = tos}
Q ← TOS, L3 ← L3.fprop2, c1;
Q ← Q xor uCARlo, c2;
Ybus ← Q , ZeroBr, c3;
Q ← TOSH, BRANCH[fplonok, $], c1;
Q ← Q xor uCARhi, c2;
Ybus ← Q - 1, PgCarryBr, c3;
BRANCH[fpCARequaltosm1, fphinok], c1;
fplonok:
GOTO[fpgoagain], c2;
fphinok:
GOTO[fpgoagain], c2;
fpgoagain:
{plist ← (CDR (CDR plist) ) . . loopback}
CALL[CADR], c3;
at[L3.fprop2, 10, CADRret],
Ybus ← Rx or TT, ZeroBr, L3 ← L3.fprop1, c1;
BRANCH[$, fpretnil], c2;
, c3;
MAR ← [rhS, S - 1], c1;
MDR ← TT, CANCELBR[$, 2], LOOPHOLE[wok], c2;
, c3;
MAR ← [rhS, S + 0], c1;
MDR ← Rx, c2;
MesaIntBr, c3;
BRANCH[fmnoint1, fmtestint1], c1;
fpretnil:
, c3;
, c1;
TOSH ← 0, c2;
TOS ← 0, GOTO[fmexit], c3;
fpCARequaltosm1:
{return (CAR (CDR plist) )}
L3 ← L3.fprop3, GOTO[fpgoagain], c2;
at[L3.fprop3, 10, CADRret],
TOSH ← uCARhi, c1;
TOS ← uCARlo, c2;
GOTO[fmexit], c3;
{ E N D }