{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 }