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