:Title[LSTACK.mc, StackFrame manipulations]; * * Edit History * March 22, 1985 masinter, Formatting only * January 17, 1985 11:32 PM, Masinter, add STORE.N, COPY.N * January 13, 1984 9:25 PM, JonL, LBIND merged in here * PUSHTMD, TL.ST0TMD, TL.PUSHNIL and TL.PUSHTRUE to LVARCONST, * removed PUSHQT (no users?) * January 6, 1984 4:55 AM, JonL, Note that REPNIL appears here (when ?) * added TL.REPNIL2 for CDR's benefit * January 3, 1984 8:32 PM, JonL, Removed FIXSTACKREGS (was * nowhere else referenced) and added lots of commentary * December 27, 1983 11:30 AM, JonL, moved opCOPY from LINST * December 26, 1983 3:11 PM, JonL, added subroutine ABFETCH, * SWAP starts out StackM2BR, and to use ABFETCH * December 21, 1983 7:48 AM, JonL, brought in opSWAP, opPOP, * and REPSMALLT; Moved NEXTOP to LOPS * December 15, 1983 3:49 PM -- added label REPTMD1 - JonL * December 9, 1983 1:14 PM -- Added ARG0 - JonL * Prior dates -- Masinter KnowRBase[LTEMP0]; TOP LEVEL; InsSet[LispInsSet, 1]; *-------------------------------------------------------------------- opCOPY: *-------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMemBase; T← Md, fetch← T, branch[PUSHTMD]; regOP1[144, StackM2BR, opCOPY, noNData]; *-------------------------------------------------------------------- opCOPYN: *-------------------------------------------------------------------- T← (TSP) - (T), TisID; T← (fetch← T) - 1, flipMemBase; T← Md, fetch← T, branch[PUSHTMD]; regOP2[75, StackM2BR, opCOPYN, noNData]; *-------------------------------------------------------------------- opSTOREN: *-------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMemBase; T← Md, LTEMP0 ← (fetch← T) - (3c); LTEMP0← (LTEMP0) - (T), TisID, branch[TL.ST0TMD]; regOP2[74, StackM2BR, opSTOREN, noNData]; *-------------------------------------------------------------------- opPOP: *-------------------------------------------------------------------- regOP1[277, StackBR, opPOP, noNData]; LEFT← (LEFT) + 1; TL.POP1: TSP← (TSP) - (2c), NextOpcode; *-------------------------------------------------------------------- opSWAP: *------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMembase, call[ABFETCH]; * Bhi in LTEMP0 * Blo in LTEMP1 LTEMP2← Md, T← (fetch← T) - 1; * Ahi in LTEMP2 LTEMP3← Md, * Alo in LTEMP3 T← (store← T) + 1, dbuf← LTEMP0; * Ahi← Bhi T← (store← T) + 1, dbuf← LTEMP1; * Alo← Blo T← (store← T) + 1, dbuf← LTEMP2; * Bhi← Ahi store← T, dbuf← LTEMP3, NextOpcode; * Blo← Alo regOP1[375, StackM2BR, opSWAP, noNData]; *-------------------------------------------------------------------- SUBROUTINE; ABFETCH: *-------------------------------------------------------------------- * For two-arguments A and B on stack (B in TOS) * Enter with fetch pending on Bhi, * T positioned over Blo, * membase is StackBr * typical entry starts membase at StackM2BR and does * T← (fetch← TSP) - 1, flipMembase, call[ABFETCH]; * Exit with Bhi in LTEMP0 * Blo in LTEMP1 * fetch pending on Ahi * T positioned over Alo LTEMP0← Md, T← (fetch← T) - (3c); * Hi.word in LTEMP0 LTEMP1← Md, T← (fetch← T) + 1, return; * Lo.word in LTEMP1 TOPLEVEL; *-------------------------------------------------------------------- opMYALINK: *-------------------------------------------------------------------- regOP1[146, StackBR, opMYALINK, noNData]; T← (PVAR) - (FXBACK[ALINK]); fetch← T, T← (177776c); T← T and Md; T← T - (FX.PVAR), branch[PUSHSMALLT]; UfnOps[145]; * MYARGCOUNT UfnOps[141]; * ARG0 % Someday, we'd like to do these two *-------------------------------------------------------------------- opMYARGCOUNT: *-------------------------------------------------------------------- regOP1[145, StackBR, opMYARGCOUNT, noNData]; T← (PVAR) - (FXBACK[ALINK]), call[.GETMYARGCOUNT]; * Get Alink wd to see if fastp branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR; StackCheck; TSP← (store← TSP) + 1, dbuf← SmallHi, branch[TL.PUSHT]; SUBROUTINE; .GETMYARGCOUNT: T← (fetch← T)+(FXDIF[BFLAGS,ALINK]); * T points to BFLAGS in BF LTEMP0← Md, fetch← T; *LTEMP0 holds Alink,fetch Bflags contents branch[.+2, R even], LTEMP0, LTEMP0 ← (BfPadded); TOP LEVEL; callUFN; SUBROUTINE; *Punt out if not fastp case pd ← (LTEMP0) and (Md); branch[.+2, alu=0], T← (T - (IVAR)) rsh 1; * and nargs ← # IVAR wds / 2 T← T - 1, RETURN; * when "padded", there is an extra cell. sub it off return; TOP LEVEL; *-------------------------------------------------------------------- opARG0: *-------------------------------------------------------------------- regOP1[141, StackM2BR, opARG0, noNData]; T← (fetch← TSP) + 1; * One arg, the index of IVAR T← Md, fetch← T; * wanted pd← T-(SmallHi), LTEMP1← Md; branch[.+2, alu=0], T← (LTEMP1) + (LTEMP1), flipMemBase;*punt if ~SMALLPOSP callUFN; * or if = 0 branch[.+2, alu#0], LTEMP2← T + (IVAR); * args are double wds callUFN; * BEGINNING OF TESTING nop; T← (PVAR) - (FXBACK[ALINK]), call[.GETMYARGCOUNT]; * at this point, T has MYARGCOUNT in it pd← (LTEMP1) - T - 1, flipMemBase; branch [.+2, carry']; callUFN;* arg too large! * end of test T← (fetch← LTEMP2) + 1; T← Md, fetch← T; T← Md, TSP ← (store← TSP) + 1, dbuf← T; TSP ← (store← TSP) - 1, dbuf← T, NextOpCode; % *-------------------------------------------------------------------- opBIND: *-------------------------------------------------------------------- * Binds n1 pvars to NIL and * n2 pvars to the n2 items on the stack * Last pvar stored into is N * pushes binding mark [-(n1+n2)-1,, 2*N] T← LTEMP0← Id; * n1 (first 4 bits) #NILs LTEMP1← Id, Cnt← T; * n2 (next 4 bits) #values T← (Id) lsh 1; * 2*N T← (PVAR) + (Q← T); branch[.endBindNils, Cnt=0&-1], LTEMP2← T + 1; .BindVarToNil: LTEMP2← (store← LTEMP2) - 1, DBuf← AT.NIL; LTEMP2← (store← LTEMP2) - 1, DBuf← 0c, branch[.BindVarToNil,Cnt#0&-1]; .endBindNils: Cnt← LTEMP1, T← LTEMP1; * #values to bind LEFT← (LEFT) + T; .BindVarToVal: T← (TSP) - 1, branch[.EndBind, Cnt=0&-1]; TSP← (fetch← T) - 1; T← Md, (fetch← TSP); T← Md, LTEMP2← (store← LTEMP2) - 1, dbuf← T; LTEMP2← (store← LTEMP2) - 1, DBuf← T, branch[.BindVarToVal]; .EndBind: T← (0s) - (LTEMP1); * -N2 T← T - (LTEMP0) - 1; * -N1-N2-1 PUSHTQ: branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR; StackCheck; :if[Debugging]; pd← T and not (77c); branch[.+2, alu=0]; uCodeCheck[badpushval]; :endif; TSP← (store← TSP) + 1, dbuf← T; TSP← (store← TSP) + 1, dbuf← Q, NextOpCode; IFUreg[21, 3, StackBR, 0, opBIND, noNData, 0, 1]; *-------------------------------------------------------------------- opUNBIND: *-------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMemBase; LTEMP0← Md, T← (fetch← T) - 1, flipMemBase; TSP← T, Q← Md, branch[opDUNBIND]; *-------------------------------------------------------------------- opDUNBIND: *-------------------------------------------------------------------- T← TSP← (fetch← TSP) - (2c); LTEMP1← Md, T← T + 1; branch[opDUNBIND, R>=0], LTEMP1, LTEMP1← not (LTEMP1); * T points (relative to StackM2BR) to the odd word * LTEMP1 has (n1+n2) flipMemBase; fetch← T; Cnt← LTEMP1; T← (PVAR) + (Md) + 1; .unbindvar: * Loop here branch[.unbindend, Cnt=0&-1], T← T - 1; :if[Debugging]; * check if slot was not bound fetch ← T; pd ← Md; branch[.+2, alu>=0]; uCodeCheck[UnBindNotBound]; :endif; T← (store← T) - 1, dbuf← AllOnes, branch[.unbindvar]; .unbindend: call[FIXLEFT]; pd← Id; branch[PUSHTQ, alu=0], T← LTEMP0; * Id=0 for unbind NextOpCode; regOP1[22, StackM2BR, opUNBIND, 0]; * UNBIND regOP1[23, StackM2BR, opDUNBIND, 1]; * DUNBIND