:TITLE[Fvarlookup.0mc, August 11, 1982  5:24 PM, van Melle];

onpage[pgFvar];

RM[FVep, IP[lspDefx1]];
RM[Name, IP[lspL2]];
RM[Loc, IP[lspL3]];
RM[Cnt, IP[lspDefx0]];
RM[Value, IP[lspL0]];
RM[ValueHi, IP[lspL1]];
RM[NamePtr, IP[lspGenBr]];
RM[NamePtrHi, IP[lspGenBrHi]];

* Called with T pointing to Fvar binding slot
Lookup:
	Loc ← T;
	PFetch1[lspIfuBr, Cnt, 7];	* Cnt ← Nlocals,,FvarOffset

	T ← lspEp;
	T ← (Loc) - T;
	Value ← T;			* word offset of binding slot past Ep

	T ← rsh[Cnt, 10];		* T ← NLocals
	Cnt ← (rhmask[Cnt]) - T;	* Cnt ← -NLocals + Fvaroffset

	T ← rsh[Value, 1];		* cell offset of binding slot

	T ← (Cnt) + T;		* T ← (Loc - Ep)/2 - NLocals + Fvaroffset
				*    = nametable offset
	PFetch1[lspIfuBr, Name];

* Called with name to lookup in Name
Lookup1:
	T ← (lspEp) - (12c);
	FVep ← T, UseCtask;		* FVep ← current FX
	T ← APC&APCTask;
	lspL5 ← T;			* save return link

NewFrame:
	T ← (FVep) + (1c);
	PFetch1[lspStkBr, FVep], task;	* FVep ← FVep:#Alink
	FVep ← (FVep) - (12c);
	T ← FVep ← (FVep) and not (1c);	* FVEp ← FX base
	goto[EndOfStack, alu=0];

	PFetch1[lspStkBr, Cnt];		* get frame flags,,usecount
	lu ← (Cnt) and (10000c);		* Test F bit
	lu ← (Cnt) and (1000c), skip[alu=0];	* test V = nametab valid bit
	  goto[NewFrame];		* skip frame if binds no vars

	T ← (FVep) + (2c), skip[alu=0];	* T ← offset of Fnheader (V=0)
	  T ← (FVep) + (6c);		* T ← offset of name table (V=1)
	PFetch2[lspStkBr, NamePtr];	* get one or the other
	T ← rhmask[NamePtrHi];
	NamePtrHi ← (lsh[NamePtrHi, 10]) or T;
				* why bother putting it in both halves?
	Cnt ← 4c, call[.+1];

SearchLoop:
	T ← Cnt ← (Cnt) + (4c);
	PFetch4[NamePtr, XBuf];		* Fetch next 4 words of nametable
	T ← Name;			* Name to compare against
	lu ← (XBuf) xor T;
Look1:
	lu ← (XBuf1) xor T, goto[Found0, alu=0];
Look2:
	lu ← (XBuf2) xor T, goto[Found1, alu=0];
Look3:
	lu ← (XBuf3) xor T, goto[Found2, alu=0];
	lu ← (XBuf3), goto[Found3, alu=0];
	goto[NewFrame, alu=0];		* Nametable ends in zero's
	return;				* ...to SearchLoop

Found0:	T ← Cnt, goto[Found];
Found1:	T ← Cnt ← (Cnt) + (1c), goto[Found];
Found2:	T ← Cnt ← (Cnt) + (2c), goto[Found];
Found3:	T ← Cnt ← (Cnt) + (3c), goto[Found];

Found:
	PFetch1[NamePtr, lspL4, 6], call[retLBL];	* L4 ← NTSIZE,
					* avoiding passaround failure
	T ← (lspL4) + T;			* offset of second NT slot
	PFetch1[NamePtr, lspL4];		* L4 ← flag,,offset
	T ← rhmask[lspL4];			* offset of var wherever
	lspL4 ← (lspL4) + T, goto[Ivar, R>=0];	* word offset

FPvar:						* L4[0:1] = 10 or 11
	T ← (FVep) + (12c);			* Find start of Pvars
	T ← (rhmask[lspL4]) + T;			* Look at Nth Pvar
	PFetch2[lspStkBr, Value];	* Fetch pvar value or fvar binding
	lu ← (lspL4) and (40000c);		* which are we looking at?
	goto[Pvar, alu=0];
	lu ← Value, goto[FoundVal, Reven];	* Value = fvar binding
						* May want to create chain
	goto[NewFrame];

PVar:					* fetched Value out of a PVAR slot
	lu ← Value, goto[Pvar1, R<0];	* unbound if high bit on
	Value ← T;			* return pointer to this binding
LookStackPtr:
	ValueHi ← (StackSpace);
	ValueHi ← (ValueHi) or (StackSpaceR), goto[FoundVal];

Pvar1:	* unbound pvar--loop, 'cause there may be a bound one in same frame

	T ← (Cnt) and not (3c);
	PFetch4[NamePtr, XBuf];		* is this redundant?
	T ← Name, call[.+2];
	  goto[SearchLoop];	* Return at end of searchloop returns here
	Dispatch[Cnt, 16, 2];
	Cnt ← (Cnt) and not (3c), Disp[.+1];
	goto[Look1], DispTable[4];
	goto[Look2];
	goto[Look3];
	goto[SearchLoop];

Ivar:
	T ← (FVep) - 1;
	PFetch1[lspStkBr, Value];		* Fetch ptr to Ivar start
	T ← rhmask[lspL4];			* Add in offset
	Value← (Value) + T, goto[LookStackPtr];


EndOfStack:				* stack exhausted, point at value cell
	T ← lsh[Name, 1];		* atomnumber * 2
	Value ← T;
	ValueHi ← (VALspace);		* Say it is global
	ValueHi ← (ValueHi) or (VALspaceR), goto[FoundVal];
					* Combine this with LookStackPtr+1

FoundVal:
	APC&APCTask ← lspL5;
	T ← Loc, return;

* Eval, op 54

Eval:
	call[lspTyp], opcode[54];	* get type in LN, pop TOS into L3,2
	loadpage[pgEval];
	T ← (lspType) - (listType);	* is it Listp?
onpage[pgEval];
	FreezeResult, goto[EvalList, alu=0];	* yes, do evalform
	skip[alu<0], lu ← (lspType) - (atomType);	* is TOS atom or less?
	  lspUFN ← 54c, goto[ufnLBL];	* types greater than listp punt
	T ← lspL2, skip[alu=0];		* Skip if type atom
	  NextOpCode;			* Smallp, fixp, floatp eval to self

					* TOS is atom.  Thus L3=0, L2 = atom#
	lu ← (lspL2) - (KtVal), skip[alu#0];
	  NextOpCode;			* NIL evals to self
	skip[alu#0];
	  NextOpCode;			* so does T
	loadpage[pgFvar];
	Name ← T, callp[Lookup1];	* "Name" is really lspL2, so noop
					* Returns Value = binding slot
	PFETCH2[Value, lspL2, 0];
	T ← lspL2;			* test L2,3 = NOBIND
	lu ← (lspL3) - (atomNOBIND), goto[EvalOk, alu#0];
	skip[alu#0];
	  lspUFN ← (54c), goto[ufnLBL];	* punt if var's value is NOBIND
				* Note this is not right if var is
				* actually BOUND to NOBIND, but who cares?
	nop;			* allocation constraint
EvalOk:
	Stack&-1 ← T;		* = L2, hi half of value
	T ← lspL3;
	Stack&+1 ← T, goto[nxiLBL];

EvalList:			* Eval a list.  Do this by calling a
				* special fn, rather than normal ufn, thus
				* saving a frame in the interpreter.
				* T is conveniently zero from previous lu
	lspDefx1 ← atomEVALFORM;
	lspDefx0 ← T, loadpage[pgFrame];	* ← 0
	lspNargs ← 1c, gotop[lspCallFn];



* StkScan, op 57: TOS -> binding pointer of TOS

StkScan:
	T ← Stack&-1, opcode[057];
	lu ← Stack&-1, goto[StkScanNil, alu=0];
	skip[alu=0];				* Is hiloc of TOS zero?
	  lspUFN ← 57c, goto[ufnLBL];		* no, punt
	loadpage[pgFvar];
	Name ← T, callp[Lookup1];
	T ← rsh[ValueHi, 10];			* hiloc of binding ptr
	Stack&+1 ← T;
	T ← Value;
StkScanPush:
	Stack&+1 ← T, goto[nxiLBL];
StkScanNil:
	Stack&+1 ← (ValSpaceR), goto[StkScanPush];	* Note that T = 0

	:END[Fvarlookup];