{File name LispEval.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, XRefBr,	c3;

	MAR _ [rhRx, TT + 0], BRANCH[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 }