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