:Title[LCALL.mc, December 7, 1982  4:38 PM, Masinter];

*--------------------------------------------------------------------
* Function call
*--------------------------------------------------------------------

   KnowRBase[LTemp0];
   top level;
   InsSet[LispInsSet, 1];

*--------------------------------------------------------------------
* UFN entries
*--------------------------------------------------------------------
* Utility functions; fetch defindex and arg count from UFNtable
* format of table:	defindex[0:15] left word;
*			nargs[8:15] right word

* call UFN according to byte at PC
* branched to from various places

opUFN:
   T← LTEMP1← not(PCX'), branch[.ufnPC1];

ufnPC:   GLOBAL,
   T← LTEMP1← not(PCX'), branch[.ufnPC1];	* T, LTEMP0 ← current PC

.ufnPC1:
   LTEMP0← T rsh 1;	* word address

	CHECKPCX;
	PAGEFAULTOK;

   LTEMP0← (fetch← LTEMP0) + 1;	* fetch word containing current instruction

   T← Md, fetch← LTEMP0;
   branch[.ufnPCR, R odd], LTEMP1, LTEMP1← Md;

.ufnPCL:
   LTEMP1← RCY[T, LTEMP1, 10];
   T← RSH[T, 10], branch[.ufnPC2];

.ufnPCR:
   T← (T) and (rhmask), branch[.ufnPC2];

.ufnPC2:
   memBase← ufnBR, T← T + T;

	PAGEFAULTNOTOK;

   T← (fetch← T) + 1;
   DEFLO← Md, fetch← T;
   NARGS← Md, memBase← StackBR;
   T← RSH[NARGS, 10];
   LTEMP0← BDispatch← T;
   NARGS← (NARGS) and (rhmask), branch[.ufns];

.ufns:   DISPTABLE[3],
   branch[.ufnPC3];
   T← (store← TSP) + 1, dbuf← SmallHi, branch[.ufnpsh1];
   T← (store← TSP) + 1, dbuf← SmallHi, branch[.ufnpsh2];


.ufnpsh2:
   TSP← (store← T) + 1, dbuf← LTEMP1, branch[.ufnPC3];

.ufnpsh1:
   LTEMP1← RSH[LTEMP1, 10], branch[.ufnpsh2];

.ufnPC3:
   LTEMP0← (LTEMP0) - (PCX'), call[FIXLEFT];
   memBase← StackBR, branch[.DOF1];

DOCALLPUNT:		* from unbox, etc. enter with DEFLO, NARGS set
   T← Id, call[FIXLEFT];
   T← Id, memBase← StackBR, branch[.DOF0];

*--------------------------------------------------------------------
* FN0-4 operators
*--------------------------------------------------------------------
opFN:
   NARGS← Id;
   T← Id;				* High bits of fnname
   T← LSH[T,10];
   DEFLO← (Id) + T;			* 16 bit function number

.DOF0:
   LTEMP0← Id - (PCX') - 1;		* return PC

	CHECKPCX;

.DOF1:
   T← (PVAR) - (FXBACK[PC]);
   store← T, dbuf← LTEMP0;		* store FX.pc ← PC

RESTARTCALL0:
   PSTATE← T-T-1, memBase← DefBR;

.DOF2:
   T← (DEFLO) + (DEFLO);
   T← (FETCH← T) + 1;			* CAN FAULT
   LTEMP0← MD, fetch← T, T← (rhmask);	* LTEMP0← hi def

   branch[.+2, R<0], T← Md, LTEMP0← T and (LTEMP0), memBase← ifuBR;
	DEFHI← A0, branch[.notCCODE];
   BrHi← LTEMP0;
   LTEMP1← BrLo← T;				* LTEMP1← fnLo

   FETCH← 0s;					* CAN FAULT!!!

   T← LSH[LTEMP0, 10];
   LTEMP0← (LTEMP0) + T;			* recompute fnheader

   T← MD, fetch← 1s;
   T← (ESP) - T;
   pd← T - (TSP);				* ESP - #WORDS - TSP
   branch[.+2, carry], LTEMP2← Md, T← (fetch← 2s) + 1;	* LTEMP2← def.na
	DEFHI← A0, branch[.fnstkov];

:if[FNStats];
   LTEMP3← Md, fetch← T, branch[.nofnstat, R<0], FnStatsPtr;  * LTEMP3← def.pv
   PCF← Md, PSTATE← A0; call[FNSTAT];
   branch[.afterfnstat];

:else;
   LTEMP3← Md, fetch← T;			* LTEMP3← def.pv
:endif;

.nofnstat:
   PCF← Md, PSTATE← A0;		* start IFU early, no faults after here

.afterfnstat:

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*    KLUDGE FOR FINDING OUT WHO IS CALLED: SMASH DEF WITH BIT     *
*    FETCH← (4S); IVAR← MD;                                       *
*    BRANCH[.+2, R<0], IVAR← IVAR OR (100000C);                   *
*    STORE← (4S), DBUF← IVAR;                                     *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

   T← (NARGS) + (NARGS), memBase← StackBR;

	PCXBAD;

   IVAR← (TSP) - T;
   T← (PVAR) - (FXBACK[NEXT]);
   store← T, dbuf← IVAR;			* store FX.next

   branch[.NoAdj, R<0], T← LTEMP2;
   T← (NARGS) - T;

.tryagain:
   branch[.NoAdj', alu=0], pd← T;
   branch[.TooMany, alu>0];

   TSP← (store← TSP) + 1, dbuf← 0c;
   TSP← (store← TSP) + 1, dbuf← 0c;
   T← T+1, branch[.tryagain];

.TooMany:
   TSP← (TSP) - (2c);
   T← T-1, branch[.tryagain];

.NoAdj':
   pd← (TSP) and (2c), branch[.+2];
.NoAdj:
   pd← (TSP) and (2c);
   branch[.QuadP,  alu=0], T← (store← TSP) + 1, dbuf← BFBlock;
   T← (store← TSP) + 1, dbuf← 0c;
   T← (store← T) + 1, dbuf← 0c;
   T← (store← T) + 1, dbuf← (add[BFBlock!, BFPadded!]c);

.QuadP:
   T← (store← T) + 1, dbuf← IVAR;		* new IVAR
   T← (store← T) + 1, dbuf← FxtnBlock;		* default flags
   T← (store← T) + 1, dbuf← PVAR;		* old PVAR
   T← (store← T) + 1, dbuf← LTEMP1;		* fn address hi
   store← T, dbuf← LTEMP0;			* fn address lo
   T← PVAR← T + (FXDIF[PVAR, DEFHI]);
   dblbranch[.StorePVS, .endfn, R>=0], Cnt← LTEMP3;

.StorePVS:
   T← (store← T) + 1, dbuf← AllOnes;
   T← (store← T) + 1, dbuf← AllOnes;
   T← (store← T) + 1, dbuf← AllOnes;
   T← (store← T) + 1, dbuf← AllOnes, dblbranch[.StorePVS, .endfn, Cnt#0&-1];

.endfn:
   T← TSP← T + (4c);
   T← ((ESP) - T) rsh 1;
   LEFT← T - (LeftOffset), NextOpCode;

.notCCODE:
   T← (TSP), memBase← StackBR;
   T← (store← T) + 1, dbuf← DEFHI;
   TSP← (store← T) + 1, dbuf← DEFLO;
   NARGS← (NARGS) + 1;
   DEFLO← AT.INTERPRETER, branch[RESTARTCALL0];


.fnstkov:
   memBase← StackBR, Call[ADDSTK];
   branch[RESTARTCALL0];

IFUpause[10, 3, StackBR, 0, opFN, 0, 0, 0];	*FN0
IFUpause[11, 3, StackBR, 0, opFN, 1, 0, 0];	*FN1
IFUpause[12, 3, StackBR, 0, opFN, 2, 0, 0];	*FN2
IFUpause[13, 3, StackBR, 0, opFN, 3, 0, 0];	*FN3
IFUpause[14, 3, StackBR, 0, opFN, 4, 0, 0];	*FN4

*--------------------------------------------------------------------
opFNX:
*--------------------------------------------------------------------
* Takes 3 argument bytes; first is NARGS, 2nd and 3rd are fn #.
* since IFU won't handle 4 byte instructions, the first arg is
* gotten from the IFU, and the fn is fetched directly. Things are
* much simpler if the opcode happens to be word aligned. 

   NARGS← Id;
   DEFLO← T← (Id)-(PCX')-1;	* Id is length- get byte# of 3rd byte
   LTEMP0← T rsh 1;		* word which contains hi byte of fn

	PAGEFAULTOK;

   LTEMP0← (FETCH← LTEMP0) + 1;
   branch[.+2, R odd], DEFLO← MD, T← T+(2c);	* T has new PC
	LTEMP0← T, memBase← StackBR, branch[.DOF1];

FNXsplit:

   LTEMP0← T, FETCH← LTEMP0;	* save PC, fetch lo byte
   memBase← StackBR, T← MD;	* T has lo byte of fn in hi byte

	PAGEFAULTNOTOK;

   DEFLO← Rcy[DEFLO, T, 10], branch[.DOF1];	* and fix up

IFUpause[15, 2, ifuBR, 0, opFNX, noNData, 0, 0];

*--------------------------------------------------------------------
opAPPLYFN:
*--------------------------------------------------------------------
* TOS = FN TO CALL, TOS- = NARGS

   T← (fetch← TSP) + 1;			* fetch defhi
   DEFHI← Md, T← (fetch← T) - (3c);	* fetch deflo
   DEFLO← Md, T← (fetch← T) + 1;	* fetch narghi
   T← Md, fetch← T, flipMemBase;
   NARGS← Md, pd← T xor (SmallHi);
   branch[.+2, alu=0], TSP← (TSP) - (4c);
	UCodeCheck[BadRetCall];
   LTEMP0← Id - (PCX') - 1;
   T← (PVAR) - (FXBACK[PC]);
   store← T, dbuf← LTEMP0;
   PSTATE← T-T-1, memBase← DefBR;
   pd← DEFHI;
   branch[.+2, alu=0];
	branch[.notCCODE];
   branch[.DOF2];

IFUpause[16, 1, StackM2BR, 0, opAPPLYFN, NoNData, 0, 0];	*APPLYFN

:if[Reduced];
	UfnOps[17];
:else;

*--------------------------------------------------------------------
opCKAPPLY:
*--------------------------------------------------------------------
* TOS = FN TO CALL

   T← (fetch← TSP) + 1;	
   LTEMP0← Md, fetch← T;		* hiloc
   T← Md, memBase← DefBR, pd← LTEMP0;
   branch[.+2, alu=0], T← T + T;
   	CallUFN;			* not litatom

	PAGEFAULTOK;

   FETCH← T;
   LTEMP0← MD;

	PAGEFAULTNOTOK;

   branch[.+2, R<0], pd← (LTEMP0) and (20000c);
	CallUFN;			* not CCODEP
   branch[.+2, alu=0];
   	CallUFN;	* not argtype=0, 2
   NextOpCode;

regOP1[17, StackM2BR, opCKAPPLY, NoNData];	*CKAPPLY

:endif;