:TITLE[LFV.mc, December 6, 1982  1:31 PM, Masinter];

   knowrbase[LTEMP0];
   TOP LEVEL;
   InsSet[LispInsSet, 1];

RME[FVEP, LTEMP1];
RME[FVNAME, LTEMP2];
RME[FVTMP, LTEMP3];
RME[FVCHAIN, LTEMP4];
RME[FVINDEX, NARGS];
RME[FVHI, DEFHI];
RME[FVLO, DEFLO];

:if[Reduced];
	UfnOps[54];
	UfnOps[57];
:else;

*--------------------------------------------------------------------
opEVAL:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1, call[TYPREV];
   T_ T and (rhmask);
   pd_ T - (atomType);
   branch[.evalatom, alu=0], pd_ T;
   branch[.evalother, alu=0], pd_ T - (add[FixpType!, 1]c);
   branch[.evalret, alu<0], pd_ T - (ListType);
   branch[.+2, alu=0], NARGS_ 1c;
	CallUFN;	* not atom, fixp, listp

.evalListp:
   DEFLO_ AT.EVALFORM, branch[DOCALLPUNT];

.evalother:
   CallUFN;	* let UFN decide

.evalret: NextOpCode;	* return self

.evalatom:
   FVNAME_ pd_ LTEMP1;	* note FVNAME= LTEMP2 really
   branch[.+2, alu#0], pd_ (FVNAME) - (AT.T);
	NextOpCode;	* eval of NIL=NIL
   branch[.+2, alu#0], T_ (FX.PVAR);
	NextOpCode;	* eval of T=T

   nop;	* funny placement constraint
   FVEP_ (PVAR) - T, call[DOLOOKUP];

   memBase_ ScratchLZBR;
   BrHi_ FVHI;

	PAGEFAULTOK;

   T_ (FETCH_ FVLO) + 1;
   T_ Md, fetch_ T;

	PAGEFAULTNOTOK;

   pd_ (FVHI) - (StackHi);
   branch[.+2, alu#0], pd_ T, memBase_ StackM2BR;
	branch[REPTMD];
   pd_ (1s) - (Md);
   branch[.+2, alu=0];
	branch[REPTMD];

   callUFN;	* value is NOBIND
regOP1[54, StackM2BR, opEVAL, noNData];
*--------------------------------------------------------------------
opSTKSCAN:
*--------------------------------------------------------------------
	T_ (fetch_ TSP) + 1;
	FVNAME_ Md, fetch_ T, T_ (FX.PVAR);
	FVNAME_ Md, pd_ FVNAME;
	branch[.+2, alu=0], pd_ FVNAME;
		CallUFN;	* not LITATOM
	branch[.+2, alu#0];
		CallUFN;	* NIL
	nop;
	FVEP_ (PVAR) - T, call[DOLOOKUP];
	memBase_ StackM2BR, T_ TSP;
	T_ (store_ T) + 1, dbuf_ FVHI;
	store_ T, dbuf_ FVLO, NextOpCode;

REGOP1[57, StackM2BR, opSTKSCAN, noNData];

:endif[Reduced];

*--------------------------------------------------------------------
SUBROUTINE;  FVLOOKUP:
*--------------------------------------------------------------------


* look up free variable # T/2 in current frame
* fill in location where value is bound
* preserve LTEMP0

   memBase_ ifuBR;

	PAGEFAULTOK;

   FETCH_ add[FNH.NLFV!]s;
   FVNAME_ T rsh 1;		* free variable index
   FVCHAIN_ (PVAR) + T + 1;	* where to fill in the indirection
   FVTMP_ MD;			* nlocals, fvoffset

	PAGEFAULTNOTOK;

   T_ rsh[FVTMP, 10];		* T_ NLOCALS
   FVTMP_ (FVTMP) and (rhmask);
   T_ (FVTMP) - T;
   T_ T + (FVNAME);
   fetch_ T;
   FVNAME_ Md, T_ (FX.PVAR);
   FVEP_ (PVAR) - T;
   memBase_ StackBR;
   store_ FVCHAIN, dbuf_ 0c, branch[.newframe];

*--------------------------------------------------------------------
DOLOOKUP:
*--------------------------------------------------------------------
* Scan for free variable FVNAME starting at FVEP, return
* in FVHI,FVLO the pointer to where it is bound
* if FVCHAIN is odd, store indirection pointer at stackspace
* should check for reschedule!!!

   FVCHAIN_ A0;

.newframe:
   T_ (FVEP) + 1, memBase_ StackBR;
   fetch_ T;
   FVEP_ Md;
   FVEP_ (FVEP) and not (1c);
   FVEP_ (FVEP) - (FX.PVAR);
   branch[.endofstack, alu=0], fetch_ FVEP;
   FVTMP_ Md;
   pd_ (FVTMP) and (FXNTValid);
   T_ (FVEP) + (FX.DEFLO), branch[.+2, alu=0];
	T_ (FVEP) + (FX.NTLO);
   T_ (fetch_ T) + 1;
   FVTMP_ Md, fetch_ T, T_ (rhmask);
   T_ T and (Md), memBase_ LScratchBR;
   BrHi_ T;
   BrLo_ FVTMP;
   FVINDEX_ FNH.FIRSTNAME;

.lookforvar:

	PAGEFAULTOK;

   FETCH_ add[FNH.NTSIZE!]s;	* can fault
   FVTMP_ Cnt_ MD;	* FVTMP = NTSIZE

	PAGEFAULTNOTOK;

.fvloop:	* this can really be done in a 2 inst loop
   branch[.newframe, Cnt=0&-1];
   FVINDEX_ (fetch_ FVINDEX) + 1;
   T_ Md;
   pd_ (FVNAME) xor T;
   branch[.fvloop, alu#0];

% this is what a 2 instruction loop would look like
   T_ A0;					* # FVNAME
   branch[.+2, Cnt#0], pd_ T-T-1;	* pd #0
	branch[.newframe];

   FVINDEX_ (fetch_ FVINDEX) + 1, branch[.fvfound, alu=0];
   T_ Md, pd_ (FVNAME) xor T, dblbranch[.notfound, .-1, Cnt=0&-1]


.fvfound:
   FVINDEX_ (FVINDEX) - (2c);

%

.fvfound:				* found a match
   T_ (FVTMP) - 1;   
   T_ T + (FVINDEX);		* add NTSIZE, note FVINDEX already incremented
   fetch_ T;
   FVHI_ Md, T_ (rhmask);
   T_ (T and (FVHI)) lsh 1, branch[.fvpfvar, R<0];

.fvivar:
   FVEP_ (FVEP) - 1, memBase_ StackBR;
   FVEP_ (fetch_ FVEP) + 1;
   FVLO_ T + Md;
   FVHI_ StackHi, branch[.donefvlookup];

.fvpfvar:
   T_ T + (FVEP), memBase_ StackBR;
   T_ T + (FX.PVAR);				* T is stack relative location
   T_ (fetch_ T) + 1;
   FVLO_ Md, fetch_ T;
   FVHI_ Md, pd_ (FVHI) and (40000c);	* check FVAR bit
	FVHI_ (FVHI) and (rhmask), branch[.fvfvar, alu#0];

.fvpvar:
   branch[.+2, R>=0], FVLO, FVLO_ T - 1, memBase_ LScratchBR;
	branch[.fvloop];	* unbound PVAR
   FVHI_ StackHi, branch[.donefvlookup];

.fvfvar:
   branch[.+2, R odd], FVLO;
	branch[.donefvlookup];

* should create chain here
   
   branch[.newframe];

.endofstack:
   FVLO_ (FVNAME) + (FVNAME);
   FVHI_ ValSpace, branch[.donefvlookup];

.donefvlookup:
   branch[.+2, R odd], FVCHAIN, memBase_ StackBR;
	return;

* kludge!!!	* STORE FVHI in both halves
   T_ LSH[FVHI, 10];
   T_ T + (FVHI);
   T_ (store_ FVCHAIN) - 1, dbuf_ T;
   store_ T, dbuf_ FVLO, return;