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