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