{File name QLispEval.mc
Description:  DandeLion InterLisp Emulator Eval
Author: Charnley
Last modified: Charnley           1-May-84 12:05:28
Created: 21-Dec-83  9:48:14
}


{- - - - - - - - - - - - - - - - - - - - - - - - - -
 54      EVAL        0        0                  \EVAL

	takes single argument ARG
	If ARG=NIL or T return ARG
	If ARG= smallp or smallneg return ARG
	if ARG = FIXP or FLOATP return ARG]
	If ARG is a list, exit thru AtomEVALFORM{370'b}
	If ARG is an atom {not NIL or T} attempt free variable lookup:
		If bound, return value
		If top value is not NOBIND (atom #1), return top value
		else ufn-punt
	else ufn-punt

- - - - - - - - - - - - - - - - - - - - - - - - - -}

@EVAL:	opcode[54'b],
	Q ← TOSH and 0FF, L2 ← L2.Eval,	c1; {set L2 for NewTyp}
	Ybus ← Q xor smallpl, ZeroBr,  L1 ← L1.fixFV,	c2; {set L1 for evLookUp}
	Ybus ← Q xor smallneg, ZeroBr, BRANCH[$, evSmallPl],	c3;

	BRANCH[$, evSmallNeg],	c1;
	uChain ← Q, ZeroBr,	c2; {set uChain to 0 for evLookUp}
	uTOS ← TOS, BRANCH[$, evAtom],	c3; {set uTOS to TOS for evLookUp}

	TT ← 0, CALL[NewTyp],	c1;

	MAR ← [rhRx, Rx + 0],	c1, at[L2.Eval, 10, NewTypRet];
	PC ← PC - PC16,{undo}	c2;
	Q ← MD and Q,	c3;

	Ybus ← Q xor FixpType, ZeroBr,	c1;
	Ybus ← Q xor FloatpType, ZeroBr, BRANCH[$, evFixp], c2;
	Ybus ← Q xor ListType, ZeroBr, BRANCH[$, evFloatp],	c3;

	BRANCH[$, evListp],	c1;
	
	GOTO[ufnX3],	c2;{can't deal with}

evSmallPl:	{simple ret}
	CANCELBR[IB.pc1],	c1;

evSmallNeg:	{simple ret}
	GOTO[evFixp],	c2;

evFixp:	{simple ret}
	CANCELBR[evFloatp],	c3;

evFloatp:	{simple ret}
	CANCELBR[IB.pc1],	c1;

evAtom:	
	uName ← TOS, ZeroBr, CANCELBR[$],	c1; {set uName to name for evLookUp}
	Q ← TOS xor KTval, BRANCH[$, evNIL],	c2;
	Ybus ← Q, ZeroBr, L3 ← L3.Eval,	c3; {set L3 for evLookUp}

	uPV ← PV, BRANCH[evLookUp, evT],	c1;{set uPV to PV for evLookUp}

evNIL:	{simple ret}
	GOTO[evFloatp],	c3;

evT:	{simple ret}
	GOTO[evNIL],	c2;

evListp:
	Rx ← AtomEVALFORM{370'b}, L3{ib's} ← 0, c2;
	IB ← Rx LRot0,	c3;

	MAR ← Q ← [rhS, S + 1], IBPtr ← 0, GOTO[FN1Ext],	c1;


evLookUp:
{	GOTO[ufnX3],	c2; EvalLabel:}
	{free var lookup on tos, which is an atom}
{	look up variable in current frame; fill in binding pointer
	(chaining not implemented)

This code assumes that NAMETABLE is contiguous in real memory {either it is on the stack, or within a code header which is non-page crossing}

on Entry:	c1
uTOS	restored to TOS if fault
uTOSH	restored to TOSH if fault
PV	current frame (point to PV region)
Q	{uChain}  (odd) stack pointer to variable to be looked up (Pv + ib + 1)
rhTT, TT	virtual address of name table (usually function header)
L3	caller's return link at[L3, 10, fvCaller] also used with fvfixup after fault

uses during subroutine:
rhRx, Rx	real address of name table
PV	frame extension pointers (point to PV region)(travel up alinks)
uPV	save local PV
TOS	used
uChain	TOSH{chain}
rhTOSH	nRhS {set once at odd time; must be left}{*} used with TOSH{chain}
uName	TOSH{name} ← [UvCL + T/2 {- UvCL.nlocals} + UvCL.fvaroffset]
ntSize, offset, L0, L1

on Return:	c1
	preserves S, PV, PC, L2, uTOS, uTOSH
	smashes TOS, TOSH {but preserved in uTOS, uTOSH}
rhTT, TT	virtual address of free value
@(chain)	filled in binding pointer
L1	binding type{fvStack, fvGlobal} Dispatch pending

on Fault:	TOS ← uTOS, TOSH ← uTOSH, PV ← uPV
}

	uTOSH ← TOSH,	c2;
	TOSH ← TOS, CALL[fvFF],	c3;{start search at current frame}

EvalGet:
	Map ← [rhTT, TT], CANCELBR[$, 0F],	c1, at[L3.Eval, 10, fvCaller];
	L1 ← L1.fixFV,	c2;
	Rx ← rhRx ← MD, ReadXRefBr,	c3;

	MAR ← [rhRx, TT + 0], ReadBRANCH[EvalMap, $],	c1, at[L0.RedoEval, 10, RMapFixCaller];
	,	c2;
	TOSH ← MD,	c3;
	
	MAR ← [rhRx, TT + 1],	c1;
	L3Disp, CANCELBR[$, 2],	c2;
	TOS ← MD, RET[EvalGetRet],	c3;

	Ybus ← TOSH, ZeroBr,	c1, at[L3.Eval, 10, EvalGetRet];
	Ybus ← TOS xor 1, ZeroBr, BRANCH[$, evalTosh0],	c2;
	CANCELBR[$],	c3;

evalEND:
	PC ← PC + PC16, GOTO[IB.nop],	c1;

evalTosh0:
	BRANCH[$, evalUnbound],	c3;

	PC ← PC + PC16, GOTO[IB.nop],	c1;

evalUnbound:
	GOTO[ufnZ2],	c1;

	PV ← uPV, GOTO[NoFixes],	c3, at[L3.Eval, 10, fvfixup];

EvalMap:
	GOTO[RLMapFix], L0 ← L0.RedoEval,	c2;

	{ E N D }