:TITLE[Frame.0mc, August 12, 1982  1:58 PM, van Melle];

*********
*
* function call microcode- CallFn
*
*  Callfn
*  Nargs=number of args, Defx0/Defx1= Expression to be called
*
*  Can page fault on the fetch of the function cell, or the fetch of the header
*  Can cause a stack overflow if NIL arguments are being added, or if it needs room for FE
*
* Regs to set up:
*	lspIfuBr, BrHi contain current function header
*	IBaseX contains address of first IVar
*******

	onpage[pgFrame];

lspCallFn0:			* call atom lspDefx1
	lspDefx0 _ 0c, goto[lspCallFn];

lspCallFn:
	T _ lsh[lspIfuBr, 1];
	T _ (lsh[PCB, 1]) - T;
	T _ (PCFreg) + T;
	lspLN _ T;		* PC = PCF + 2*(lspIfuBr-PCB)

	T _ (lspEp) - (10c);
	PStore4[lspStkBr, lspIfuBr];
				* store fn header, Next (garbage), PC

	lu _ rhmask[lspDefx0];		* Undefined function if not an atom
	lspGenBrHi _ (DEFspace), goto[Udf-expr', alu#0];
IFE[DEFbase!,0,,ER[DEFbase.not.zero]];

lspDof1:
	T _ lspGenBr _ (DEFbase);

	qBuf1 _ T, loadpage[opPage3];	* clear part of this buf for later
	lspInstFlag _ (InCallState), callp[ReturnOp];
			* opcode 374.  Does a return, but also latches SStkp
			* and PCX so that we can resume from here (from
			* DoApplyFn) if there is a fault
	T _ lsh[lspDefx1,1];		* Get address of function cell
	PFetch2[lspGenBr, lspL0];	* Fetch function cell, this can fault
					* Memory busy for 10. cycles now
	XBuf2 _ (FxtnBlock);		* Start preparing new BF & FX
	T _ lspEp;
	XBuf3 _ T;			* Alink for future FX
	qBuf3 _ Zero;			* clear part of this buf for later

*	L0,1 contains definition cell, which is
*	ccodep[0], fast[1], ArgType[2:3], code address [10:37]

	T _ rhmask[lspL0], goto[Udf-expr, R>=0];	* punt if not ccodep

	T _ (lsh[lspL0, 10]) or T;	* duplicate in left half
	lspIfuBrHi _ T;
	PCBhi _ T;			* Setup PCBhi

	T _ lspL1, task;
	lspIfuBr _ T;			* low half of base reg

	PFetch4[lspIfuBr, IBuf, 0];	* This may fault
				* This fetchs the function header words:
				* #Stack words, #Args, NF+NP-1, Start PC

				* Memory busy for 8 cycles now reading IBuf

	lu _ (lspL0) and (40000c);	* test fast bit in fndef
	T _ lspTsp, skip[alu=0];
	  XBuf2 _ (XBuf2) or (10000c);	* set fast bit in FX

	T _ (lspEsp) - T;		* Amount of space left on stack
	IBuf _ (IBuf) + (40c);		* Add a little slop
	lu _ (IBuf) - T, loadpage[pgFrame3];	* compare with what's needed
	T _ lspNargs, dblgoto[lspSubovPunt, lspAdjust, Carry];
				* proceed if negative, i.e. enough room
				* punt (stack overflow) otherwise


Udf-expr': nop;				* allocation constraint
Udf-expr:				* Call lisp fn to do the call
					* extra arg is the def
	T _ lspDefx0, loadpage[pgFrame2];
	Stack&+1 _ T;
onpage[pgFrame2];
	T _ lspDefx1, call[lspCallPushT];
	lspDefx1 _ (ExprApplyAtom);
	lspNargs _ (lspNargs) + 1, loadpage[pgFrame];
	lspDefx0 _ 0c, goto[lspDof1];

lspCallPushT:
	Stack&+1 _ T;
	StkState _ lsh[StkState, 1], return;

* Adjust the number of arguments
* No more faults are possible

* T = Nargs = number of arguments supplied
* IBuf1	= number of arguments expected
* IBuf2	= NF+NP-1
* IBuf3	= Start PC
* IFUbr	= base register for FN Header

	onpage[pgFrame3];

lspAdjust:
	IBuf1 _ (IBuf1) - T, skip[R>=0];		* IBuf1<0 => nospread
	  IBuf1 _ 0c;

IF[StatsMode];
	lspStatsPtr, goto[FNStat, R>=0];
:ENDIF;

FNStatDone:
	lu _ ldf[SStkP&NStkP, 16, 1];
	XBuf _ (BFBlock), goto[lspDocall1, alu=0];
		* Stkp-1 is quad aligned (stkp read complemented).
		* If we just stuck the BF next, it would not be quad aligned,
		* so pad with a NIL.
		* After this we will push/pop only an even number of cells,
		* and IBuf1 is odd iff BF is truly padded
	  lspNargs _ (lspNargs) + 1, loadpage[pgFrame2];
	  T _ Stack&+1 _ 0c, call[lspCallPushT];
	  IBuf1 _ (IBuf1) - 1;

lspDocall1:
	lspTsp _ (lspTsp) - (2c);
	StkState _ rcy[StkState, 1], call[fClrHStk1];

fClrHStk1:
	dispatch[lspTsp, 14, 2];
	lspTsp _ (lspTsp) + (4c), disp[fClrHStkDisp0];

fClrHStkDisp0:
	PStore4[lspTsp, Hstack4, 0], goto[fClrHStack1], disptable[4];
	PStore4[lspTsp, Hstack10, 0], goto[fClrHStack1];
	PStore4[lspTsp, Hstack14, 0], goto[fClrHStack1];
	PStore4[lspTsp, Hstack0, 0], goto[fClrHStack1];

fClrHStack1:
	StkState _ rcy[StkState, 2], skip[R Odd];
	  return;			* to fClrHStk1

:IF[StkDebug];
	loadpage[pgHStack];
	callp[ChkStk];
:ENDIF;

* Stack is flushed out now.
* Tsp points at last quad of frame (last two args)

	T _ (lspTsp) + (4c);
	T _ (lsh[lspNargs, 1]) - T, task;
	T _ lspIBasex _ (Zero) - T;	* IVAR => First arg
	XBuf1 _ T, loadpage[pgFrame4];

* Now adjust args.  IBuf1 = number of missing args (maybe negative)

	T _ IBuf1, goto[lspDocall3, R Even];
onpage[pgFrame4];
	  XBuf _ (BFBlockPad);
	  T _ IBuf1 _ (IBuf1) + 1;
lspDocall3:				* IBuf1 is now even
	qBuf2 _ (Zero) - 1, goto[lspDocall, alu=0];
	T _ IBuf1 _ lsh[IBuf1, 1], dblgoto[PopExargs, PadArgs, R<0];
					* IBuf1 now expressed in words

PadArgs:		* not enough args supplied: push IBuf1 words of NIL
	qBuf _ 0c;			* qBuf1,3 already 0
	qBuf2 _ 0c;
	IBuf1 _ (IBuf1) - (4c), call[.+1];

	IBuf1 _ (IBuf1) - (4c), goto[EndAdjust, R<0];
	PStore4[lspTsp, qBuf, 4];	* Push 2 NIL's on stack
	lspTsp _ (lspTsp) + (4c), return;


PopExargs:				* too many args supplied
	lspTsp _ (lspTsp) + T;		* Pop extra arguments
					* Wait for lspTsp to write
EndAdjust:
	qBuf2 _ (Zero) - 1;

* Close old frame extension and create the new basic frame and new frame extension
* XBuf is now completely filled in with new BF & FX

lspDocall:				* even
	PStore4[lspTsp, XBuf, 4];
				* Store BF flags, IVar, FX flags, Alink

	T _ (lspEp) - (6c);
	PStore1[lspStkBr, lspIBasex];	* Store "Next" field of old extension
					* Same as new IVar
					* MC1 busy for 13 cycles now
	T _ lspTsp _ (lspTsp) + (20c);	* point tsp at Pvar region
	lspEp _ T;

* Clear pvar and fvar slots

* IBuf2	= (NF+NP+1)/2 - 1
* IBuf3	= Start PC
* IFUbr = Base register for FN header
* Tsp   = pointer to start of pvar area
* IBasex = pointer to start of BF

FinCall:
	qBuf _ (Zero) - 1, call[lspClearP];	* qBuf _ all ones
					* Will set them to unbound
					* qBuf1,3 were cleared earlier,
					* though probably not necessary
lspClearP:
	IBuf2 _ (IBuf2) - 1, goto[CallDone, R<0];
	PStore4[lspTsp, qBuf, 0];
	lspTsp _ (lspTsp) + (4c), return;

CallDone:				* Now figure out where StkP goes
	T _ IP[HStack2]c;
	T _ (ldf[lspTsp, 14, 4]) + T + 1;
	lspL4 _ T, loadpage[pgJump];
	T _ rsh[IBuf3, 1];
onpage[pgJump];			* Must be on pgJump since pfetch4 can fault
	PFetch4[lspIfuBr, IBuf];
	PCB _ T;		* Bypasss kludge: PCB_ addr of start of code
	PCF _ RZero;

	lspInstFlag _ (NormalState);

	Stkp _ lspL4;			* Set stack pointer
	lspTsp _ (lspTsp) - (2c);	* => last cell in Pvar region
	StkState _ 376c, goto[IFE[StatsMode, 1, CheckCallOvfl, CallDone1]];
CallDone1:
	lu _ NextInst[IBuf];
	StkState _ (StkState) or (3400c), NIRET;	* StkState _ 3776

:IF[StatsMode];
CheckCallOvfl:
	lu _ (lspStatsPtr) - (StatsBufferBoundary), goto[CallDone1, R<0];
	  StkState _ (StkState) or (3400c), skip[alu>=0];
	    goto[CallDone1];			* NextOpCode
	goto[StatsPunt];
:ENDIF;

	:END[Frame];