: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];