:Title[LSTACK.mc, StackFrame manipulations];
*
* Edit History
* 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];

*--------------------------------------------------------------------
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

%
T← (TSP) - 1;
T← (fetch← T) - 1;
LTEMP1← Md, T← (fetch← T) - 1;
LTEMP0← Md, T← (fetch← T) - 1;
LTEMP2← Md, fetch← T;
LTEMP0← Md, T← (store← T) + 1, dbuf← LTEMP0;
T← (store← T) + 1, dbuf← LTEMP1;
T← (store← T) + 1, dbuf← LTEMP0;
store← T, dbuf← LTEMP2, NextOpcode;
%

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