:TITLE[Fvarlookup.0mc, October 23, 1983  4:48 PM, van Melle];

onpage[pgFvar];

RM[FVep, IP[lspDefx1]];
RM[Cnt, IP[lspDefx0]];
RM[NamePtr, IP[lspGenBr]];
RM[NamePtrHi, IP[lspGenBrHi]];

*
* Called with name (litatom) to lookup in FVarName
* Returns in FVarBinding/Hi a binding pointer
* Important that FVarName ne 0 !!
*
FVarLookupName:
	T _ (lspEp) - (12c);
	FVep _ T, UseCtask;			* FVep _ current FX
	T _ APC&APCTask;
:IF[FvarStatsMode];
	lspStatsPtr, goto[FvStartStat, R>=0];
:ENDIF;
	FVarReturnAddress _ 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?
	T _ Cnt _ 10c;		* Offset of names in nametable

SearchLoop:
	PFetch4[NamePtr, xBuf], call[retLBL];
				* Fetch next 4 words of nametable
	T _ FVarName;		* Name to compare against
				* Now compare T against each item in xBuf
				* DispTable arrangement is for Dispatch
				* following PVar1, which dispatches to the
				* odd locations
Look0:	lu _ (xBuf) xor T, disptable[10];			* [0]
Look1:	lu _ (xBuf1) xor T, dblgoto[Look2, Found0, alu#0];	* [1]
Found0:	T _ Cnt, goto[Found];					* [2]
Look2:	lu _ (xBuf2) xor T, dblgoto[Look3, Found1, alu#0];	* [3]
Found1:	T _ Cnt _ (Cnt) + (1c), goto[Found];			* [4]
Look3:	lu _ (xBuf3) xor T, dblgoto[Look4, Found2, alu#0];	* [5]
Found2:	T _ Cnt _ (Cnt) + (2c), goto[Found];			* [6]
Look4:	lu _ xBuf3, dblgoto[EndTest, Found3, alu#0];		* [7]
Found3:	T _ Cnt _ (Cnt) + (3c), goto[Found];
EndTest:
	T _ Cnt _ (Cnt) + (4c), dblgoto[SearchLoop, NewFrame, alu#0];
					* Nametable ends in zeroes


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[FoundAsIVar, 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, FVarBinding];	* Fetch pvar value or fvar binding
	lu _ (lspL4) and (40000c);		* which are we looking at?
	goto[FoundAsPVar, alu=0];
	lu _ FVarBinding, goto[FoundVal, R Even];	* has been looked up
						* May want to create chain
	goto[NewFrame];

FoundAsPVar:			* fetched FVarBinding out of a PVAR slot
	lu _ FVarBinding, goto[FailedAsPVar, R<0];	* unbound if high bit on
	FVarBinding _ T, goto[LookStackPtr];	* return ptr to this binding

FailedAsPVar:
	* unbound pvar--loop, since there may be a bound one in same frame
	* Need to get back into the main loop where we left off.  Cnt is
	* offset of this instance of FVarName.  We shift Cnt left one and
	* dispatch to 1 + that value of Cnt; e.g., if Cnt mod 4 = 2, then
	* go to Look3.

	T _ (lsh[Cnt, 1]) + 1;
	lspL4 _ T;
	Cnt _ (Cnt) and not (3c);	* Restore Cnt mod 4
	Dispatch[lspL4, 15, 3];		* Always odd
	T _ FVarName, disp[Look0];
			* Note that alu#0, so the first goto works right

FoundAsIVar:
	T _ (FVep) - 1;
	PFetch1[lspStkBr, FVarBinding];		* Fetch ptr to Ivar start
	T _ rhmask[lspL4];			* Add in offset
	FVarBinding _ (FVarBinding) + T;
LookStackPtr:
	T _ FVarBindingHi _ (StackSpaceR);
LookPtrHi:
	FVarBindingHi _ (lsh[FVarBindingHi, 10]) or T, goto[FoundVal];


EndOfStack:				* stack exhausted, point at value cell
	T _ lsh[FVarName, 1];		* atomnumber * 2
	FVarBinding _ T;
	T _ FVarBindingHi _ (VALspaceR), goto[LookPtrHi];	* Say it is global

:IF[FvarStatsMode];
FoundVal:
	lspStatsPtr, goto[FVExitStat, R>=0];
	APC&APCTask _ FVarReturnAddress;
:ELSE;
FoundVal:
	APC&APCTask _ FVarReturnAddress;
:ENDIF;
FVLookupExit:
	T _ SavedFvarOffset, return;	* T for benefit of FVar and FVar_

* 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];
	FVarName _ T, callp[FVarLookupName];
					* Returns FVarBinding = binding slot
	PFetch2[FVarBinding, 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];
	FVarName _ T, callp[FVarLookupName];
	T _ rsh[FVarBindingHi, 10];			* hiloc of binding ptr
	Stack&+1 _ T;
	T _ FVarBinding;
StkScanPush:
	Stack&+1 _ T, goto[nxiLBL];
StkScanNil:
	Stack&+1 _ (ValSpaceR), goto[StkScanPush];	* Note that T = 0

	:END[Fvarlookup];