:Title[LCALLRET]; * * Edit History * March 13, 1985 9:45 AM, Masinter, remove calls to SAVEUCODESTATE * January 6, 1985 12:18 AM, JonL, let .ATOMICFN flipMembase when * litatom index number has the 2↑15 bit on * 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. *-------------------------------------------------------------------- T← (DEFLO) + (DEFLO), memBase← DefBR; * T← word index of defcell PSTATE← T-T-1, branch[.+2, carry']; flipMemBase; * 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; PCF← Md, PSTATE← A0; call[FNSTAT]; branch[.afterfnstat]; :else; LTEMP3← Md, fetch← T; :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': T← (store← TSP) + 1, dbuf← BFBlock, branch[.+2]; .NoAdj: T← (store← TSP) + 1, dbuf← BFBlock; % .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 * 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 .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, T← A0, RBase← RBase[LTEMP0]; * May come here from totally random places, so do a little cleanup :if[StackEmpty!]; T← StackEmpty; * otherwise, T← A0 handled it :endif; StkP← T, Branch[opUFN]; * Resets the hardware stack *-------------------------------------------------------------------- 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];