:Title[LCALLRET];
*
* Edit History
* February 9, 1984 1:07 AM, JonL, fixed screwup in label ufnPC:
* February 2, 1984 11:04 AM, JonL, fixes to callers of SAVEUCODESTATE
* January 31, 1984 5:02 PM, temporarily add call to SAVEUCODESTATE
*to opUFN, ufnPC, and callers of DOCALLPUNT
* January 24-27, 1984, JonL, Globalize DOCALLPUNT
* January 13, 1984 8:07 PM, JonL, call and return code into one file
* January 4, 1984 7:26 PM, JonL, moved in some subroutines from
*LSTACK.mc -- ADDSTK from LSTACK; ufnPC resets Hardware stack
* December 31, 1983 12:51 PM, JonL, set memBase at ufnPC so code can
*branch directly to it; added some commentary
* November 29, 1983 2:42 PM, JonL, removed spurious BrLo← DEFLO.
* December 7, 1982 4:38 PM, Masinter - - -
*--------------------------------------------------------------------
* Function call
*--------------------------------------------------------------------
KnowRBase[LTemp0];
TOPLEVEL;
InsSet[LispInsSet, 1];
*--------------------------------------------------------------------
opFN:* FN0-4 operators
*--------------------------------------------------------------------
NARGS← Id;
T← Id;
T← LSH[T,10];
DEFLO← (Id) + T;* 16 bit atom index
*--------------------------------------------------------------------
.FNCALL1:* Entry for DOCALLPUNT
*--------------------------------------------------------------------
LTEMP0← Id - (PCX’) - 1;* Return PC, for a n-byte op
CHECKPCX;
*--------------------------------------------------------------------
.FNCALL2:* Entry for FNx and opUFN
*--------------------------------------------------------------------
T← (PVAR) - (FXBACK[PC]);* Suspend the current frame
store← T, dbuf← LTEMP0, Branch[.ATOMICFN];* by saving the PC
.atfXtnd:
memBase← StackBR, Call[ADDSTK];
*--------------------------------------------------------------------
.ATOMICFN:* Build a frame and start running the function whose
*index is DEFLO; NARGS args are on stack already.
*--------------------------------------------------------------------
PSTATE← T-T-1, memBase← DefBR;
T← (DEFLO) + (DEFLO);* T← word index of defcell
* CAN FAULT!!!
T← (FETCH← T) + 1;* Fetch contents of defcell
LTEMP0← MD, fetch← T, T← (rhmask);* LTEMP0← hi def
branch[.+2, R<0], LTEMP0← T and (LTEMP0),* SignBit of defcell is
T← Md, memBase← ifuBR; * flag for compiled code
DEFHI← (atomHiVal), Branch[.notCCODE];
BrHi← LTEMP0;
LTEMP1← BrLo← T;* LTEMP1← fnLo
* CAN FAULT!!!
FETCH← 0s;* Fetch first word of
T← LSH[LTEMP0, 10];* function header
LTEMP0← (LTEMP0) + T;* Recompute fnheader
T← MD, fetch← 1s;
T← (ESP) - T;
pd← T - (TSP);* ESP - #WORDS - TSP
branch[.+2, carry], LTEMP2← Md,* LTEMP2← def.na
T← (fetch← 2s) + 1;
DEFHI← (atomHiVal), Branch[.atfXtnd];
:if[FNStats];
branch[.nofnstat, R<0], LTEMP3← Md,
FnStatsPtr, fetch← T; * 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
.afterfnstat:
* No faults after here
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* 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’:
Branch[.+2], pd← (TSP) and (2c);
.NoAdj:
pd← (TSP) and (2c);
branch[.QuadP, alu=0], T← (store← TSP) + 1, dbuf← BFBlock;
T← (store← TSP) + 1, dbuf← 0c;* Smash in a cell of 0’s if not
T← (store← T) + 1, dbuf← 0c;* quadword aligned; new BF wd
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;* "Pvars", in multiples
T← (store← T) + 1, dbuf← AllOnes;* of 2 cells
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[.ATOMICFN];
*--------------------------------------------------------------------
SUBROUTINE;ADDSTK: * add space to stack frame for FNCALL etc
*--------------------------------------------------------------------
T← (fetch← ESP) + 1;* next stack word
T← Md, fetch← T;
pd← T xor (FreeStackBlock);
branch[.+2, alu=0];
TOP LEVEL;Branch[STKOVPUNT]; TOPLEVEL;
ESP← (ESP) + (Md);
.mergefree:
T← (fetch← ESP) + 1;
T← Md, fetch← T;
pd← T xor (FreeStackBlock);
branch[.+2, alu=0], T← ESP;
LEFT← T - (TSP), Branch[FIXLEFT1];
ESP← (ESP) + (Md), branch[.mergefree];
TOPLEVEL;
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[.FNCALL2];
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[.FNCALL2];* and fix up
IFUpause[15, 2, ifuBR, 0, opFNX, noNData, 0, 0];
*--------------------------------------------------------------------
opAPPLYFN:
*--------------------------------------------------------------------
* TOS = FN TO CALL, TOS-1 = NARGS, TOS-... = arguments to FN
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;* Save return PC
T← (PVAR) - (FXBACK[PC]);
store← T, dbuf← LTEMP0;
pd← (DEFHI) xor (AtomHiVal);* Check for atomic fn
branch[.+2, alu=0];
branch[.notCCODE];
branch[.ATOMICFN];
IFUpause[16, 1, StackM2BR, 0, opAPPLYFN, NoNData, 0, 0];*APPLYFN
:if[NotReduced];
*--------------------------------------------------------------------
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
:else;
UfnOps[17];
:endif;
*--------------------------------------------------------------------
opUFN:
*--------------------------------------------------------------------
* All "undefined" entries in the IFU memory come here, with
*membase← ifuBr; a call is manufactured to the function fetched
* from the UFN table, according to byte at PC.
* Format of table:defindex[0:15]left word;
*nargs[8:15]right word
LTEMP3← T, T← Link, Call[SAVEUCODESTATE];
.ufn0:
memBase← ifuBR;
T← LTEMP1← not(PCX’);* T← current PC (byte offset)
LTEMP0← T rsh 1;* LTEMP0← current PC word address
CHECKPCX;
PAGEFAULTOK;
LTEMP0← (fetch← LTEMP0) + 1;* fetch word containing current op
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);
.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];
.ufnpsh1:
LTEMP1← RSH[LTEMP1, 10];* Only an "alpha" byte
.ufnpsh2:
TSP← (store← T) + 1, dbuf← LTEMP1;* Push the opcode databytes
.ufnPC3:
LTEMP0← (LTEMP0) - (PCX’), call[FIXLEFT];
memBase← StackBR, branch[.FNCALL2];
*--------------------------------------------------------------------
* ufnPC: GLOBAL,
*--------------------------------------------------------------------
* CallUFN macro just turns into "SaveLink← Link, Call[ufnPC]"
ufnPC: GLOBAL,
RBase← RBase[LTEMP0];
LTEMP3← T, T← Link, Call[SAVEUCODESTATE];
nop;* foo, break up rings!
*May come here from totally random places, so do a little cleanup
:if[StackEmpty!];
T← (StackEmpty);
RBase← RBase[LTEMP0];
:else;
T← A0, RBase← RBase[LTEMP0];
:endif;
StkP← T, Branch[.ufn0]; * Resets the hardware stack
%
memBase← ifuBR, Branch[opUFN];
%
*--------------------------------------------------------------------
DOCALLPUNT:GLOBAL,* Called from unbox, etc.
*--------------------------------------------------------------------
* Enter with DEFLO the atom index of fnname to call
* NARGS has number of arguments to pass
* Flush out Id, recompute up LEFT
T← Id, call[FIXLEFT];
T← Id, memBase← StackBR, branch[.FNCALL1];
*--------------------------------------------------------------------
* RETURN
*--------------------------------------------------------------------
KnowRBase[LTEMP0];
top level;
InsSet[LispInsSet, 1];
opRETURN:
T← (fetch← TSP) - 1, FlipMemBase;
LTEMP0← Md, fetch← T, T← (FXBACK[ALINK]);
LTEMP1← Md, T← (PVAR) - T;
fetch← T, LTEMP3← (rhmask);* get alink field
LTEMP2← Md;
branch[.nquick, R odd], LTEMP2, T← (LTEMP2) - (FXBACK[IVAR]);
T← (fetch← T) + (FXDIF[DEFLO, IVAR]);
Q← IVAR, IVAR← Md, T← (fetch← T) + 1;* new IVAR
DEFLO← Md, T← (fetch← T) + (FXDIF[PC, DEFHI]);
T← Md, PVAR← (fetch← T) + (FXDIF[PVAR, PC]);
T← T and (LTEMP3), memBase← ifuBR;* new PVAR
BrLo← DEFLO;
:if[FNStats];
BrHi← T, branch[.retstat, R>=0], FnStatsPtr;
:else;
BrHi← T;
:endif;
T← ESP, PCF← Md;
.finishret:
LEFT← T - Q, memBase← StackBR;
T← (store← Q) + 1, dbuf← LTEMP0;
TSP← (store← T) + 1, dbuf← LTEMP1;
LEFT← (LEFT) rsh 1;
LEFT← (LEFT) - (add[LeftOffset!, 1]c), NextOpCode;
:if[FNStats];
.retstat:
DEFHI← T; PCF← Md, call[.storeretstat];* finish this operation
T← ESP, branch[.finishret];
:endif;
IFUpause[20,1,StackM2BR,0,opReturn,noNData, 0, 0];
*--------------------------------------------------------------------
* NQUICK cases of return
*--------------------------------------------------------------------
m[HardReturn, CallUFN];
.nquick:
T← (PVAR) - (FXBACK[ALINK]);
T← (fetch← T) + (FXDIF[CLINK, ALINK]);
LTEMP2← Md, T← (fetch← T) + (FXDIF[BLINK, CLINK]);
pd← (LTEMP2) - (Md) - 1, branch[.+2, R odd];
UCodeCheck[BadFrame];
branch[.+2, alu=0], LTEMP2← (LTEMP2) - 1;
HardReturn;* alink#clink
* LTEMP2 is returnee
T← (LTEMP2) - (FXBACK[FLAGS]);
fetch← T;* flagword
T← Md;
:if[Debugging];
LTEMP3← T and (StackMask);
pd← (LTEMP3) xor (FxtnBlock);
branch[.+2, alu=0];
uCodeCheck[BadFrame];
:endif;
pd← T and (rhmask);
branch[.+2, alu=0], T← (LTEMP2) - (FXBACK[NEXT]);
HardReturn;* usecnt of returnee # 0
fetch← T, T← FreeStackBlock;
LTEMP3← fetch← Md;* LTEMP3 points to returnee’s next
pd← T xor (Md);* T ← flags
branch[.+2, alu#0], T← IVAR;
branch[DORETURN];
* check for contiguous BF
pd← T xor (LTEMP3);* is IVAR=returnee’s next?
branch[.+2, alu=0], T← (PVAR) - (FXBACK[BLINK]);
HardReturn;
fetch← T;
T← Md;
fetch← T;
T← Md;
pd← T and (rhmask);
DblBranch[DORETURN, DOHARDRETURN, alu=0];
DOHARDRETURN:
HardReturn;
DORETURN:* do return to LTEMP2
T← (PVAR) - (FXBACK[BFLAGS]);
fetch← T, T← add[BfResidual!, rhmask!]c;
pd← T and Md;
branch[.freefx, alu=0], T← IVAR;
:if[Debugging];
.checkfreebf:
T← (PVAR) - (FXBACK[ALINK]);
fetch← T;
LTEMP3← Md;
branch[.+2, R odd], LTEMP3;
UCodeCheck[ShouldBeSlowFrame];
T← (PVAR) - (FXBACK[BLINK]);
:else;
.checkfreebf:
T← (PVAR) - (FXBACK[BLINK]);
:endif;
fetch← T, T← (rhmask);
LTEMP3← fetch← Md;* get bf flags
LTEMP4← Md, pd← T and Md;
branch[.nqnz, alu#0], T← (LTEMP3) + (2c);
:if[Debugging];
T← (LTEMP3) + 1;
T← (fetch← T) + 1;
pd← (IVAR) - (Md);
branch[.+2, alu=0];
uCodeCheck[IVARWRONG];
:endif;
T← T - (IVAR);
IVAR← (store← IVAR) + 1, dbuf← FreeStackBlock;
store← IVAR, dbuf← T, branch[.clresid];
.nqnz:* leave BF alone, decrement use count
T← (LTEMP4) - 1;
store← LTEMP3, dbuf← T;
.clresid:
T← (PVAR) - (FXBACK[BFLAGS]);
:if[Debugging];
fetch← T;
LTEMP3← Md;
pd←(LTEMP3) and (BFResidual);
branch[.+2, alu#0];
uCodeCheck[StackBad];
nop;
:endif;
.freefx:* make from T to ESP into a free block
ESP← (ESP) - T;
T← (store← T) + 1, dbuf← FreeStackBlock;
store← T, dbuf← ESP;
PVAR← LTEMP2;
*--------------------------------------------------------------------
RTN2:* return to frame at PVAR with LTEMP0,,LTEMP1
*--------------------------------------------------------------------
memBase← StackBR;
:if[Debugging];
T← (PVAR) - (FXBACK[FLAGS]);
fetch← T;
T← Md;
T← T and (StackMask);
pd← T xor (FxtnBlock);
branch[.+2, alu=0];
uCodeCheck[BadFrame];
:endif;
T← (PVAR) - (FXBACK[IVAR]);
T← (fetch← T) + (FXDIF[NEXT,IVAR]);
IVAR← Md, fetch← T;
ESP← Md;
TSP← Md, fetch← Md;
.extend:
ESP← (fetch← ESP) + 1;
T← Md;
pd← T xor (FreeStackBlock);
branch[.+2, alu#0], T← ESP← (fetch← ESP) - 1;
ESP← (ESP) + (Md), branch[.extend];
T← (T - (TSP)) rsh 1;
branch[.+2, carry], LEFT← T - (LeftOffset);
uCodeCheck[noStackAtPunt];
T← (PVAR) - (FXBACK[FLAGS]);
fetch← T;
LTEMP2← Md;
pd← (LTEMP2) and (FXInCall);
branch[.retcall, alu#0], pd← (LTEMP2) and (FXNoPushReturn);
branch[.nopush, alu#0], Q← TSP;
T← (store← Q) + 1, dbuf← LTEMP0;
TSP← (store← T) + 1, dbuf← LTEMP1;
branch[.retfe2, R>=0], Left← (Left) - 1;
uCodeCheck[NoStackAtPunt];
.nopush:
LTEMP2← (LTEMP2) and not (FXNoPushReturn);
store← T, dbuf← LTEMP2;* turn off no pushbit
.retfe2:
T← (PVAR) - (FXBACK[IVAR]);
T← (fetch← T) + (FXDIF[DEFLO, IVAR]);
IVAR← Md, T← (fetch← T) + 1;
DEFLO← Md, T← (fetch← T) + (FXDIF[PC, DEFHI]);
DEFHI← Md, fetch← T, T← (rhmask);
DEFHI← (DEFHI) and T, memBase← ifuBR;
BrHi← DEFHI;
BrLo← DEFLO;
PCF← Md;
:if[FNStats];
branch[.+2, R<0], FnStatsPtr;
call[.storeretstat];
NextOpCode;
:else;
nop;
NextOpCode;
:endif;
.retcall:
LTEMP2← (LTEMP2) and not (FXInCall);
store← T, dbuf← LTEMP2;
T← (TSP) - 1;
T← (fetch← T) - 1;
DEFLO← Md, T← (fetch← T) - 1;
DEFHI← Md, T← (fetch← T) - 1;
NARGS← Md; fetch← T;
:if[Debugging];
pd← DEFHI;
branch[.+2, alu=0], LTEMP0← Md;
uCodeCheck[BadRetCall];
pd← (LTEMP0) xor (SmallHi);
branch[.+2, alu=0];
uCodeCheck[BadRetCall];
:endif;
TSP← T, branch[.ATOMICFN];