:Title[LVARCONST];
*
* Edit History
* March 22 11:12AM, Masinter, formatting
* March 13, 1985 9:42 AM, Masinter, remove call to SAVEUCODESTATE
* January 8, 1985 4:12 AM, JonL, GVAR← and endofstack typos in constants
* January 6, 1985 2:50 AM, JonL, emmend GVAR, GVAR← and the global case of
* FVAR lookup to permit 16-bit litatom indices
*February 18, 1984 3:14 PM, JonL, labels PUSHSMALLT1 & PUSHTRUE1 for opRWMufMan
* January 31, 1984 1:30 AM, JonL, Added subroutine .aconstfetch
* January 13, 1984 9:05 PM, JonL, linst and lfv merged into this file
* PUSHTMD and TL.ST0TMD in from LSTACK
* December 30, 1983 3:33 PM, JonL, merged two insts in call to GCLOOKUP
* December 27, 1983 11:28 AM, JonL, opCOPY to LSTACK
* December 6, 1982 1:43 PM, Masinter
* Variable opcodes, including free variable lookup
* and Constants opcodes
knowrbase[LTEMP0];
TOP LEVEL;
InsSet[LispInsSet, 1];
*--------------------------------------------------------------------
* Some common tails for this file
*--------------------------------------------------------------------
*--------------------------------------------------------------------
PUSHTMD: * pushes T,,MD, bumps TSP, and decrements LEFT
*--------------------------------------------------------------------
PAGEFAULTNOTOK;
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
T← Md, TSP← (store← TSP) + 1, dbuf← T, branch[TL.PUSHT];
*--------------------------------------------------------------------
TL.ST0TMD:
T← Md, LTEMP0← (store← LTEMP0) + 1, dbuf← T, branch[TL.ST0];
*--------------------------------------------------------------------
TL.ST0:
store← LTEMP0, dbuf← T, NextOpCode;
*--------------------------------------------------------------------
*--------------------------------------------------------------------
opIVAR:
*--------------------------------------------------------------------
T← (ifetch← IVAR) + 1;
T← Md, ifetch← T, branch[PUSHTMD];
regOP1[100, StackBR, opIVAR, 0]; * IVAR
regOP1[101, StackBR, opIVAR, 2];
regOP1[102, StackBR, opIVAR, 4];
regOP1[103, StackBR, opIVAR, 6];
regOP1[104, StackBR, opIVAR, 10];
regOP1[105, StackBR, opIVAR, 12];
regOP1[106, StackBR, opIVAR, 14];
regOP2[107, StackBR, opIVAR, noNData]; * PVARX
*--------------------------------------------------------------------
opPVAR:
*--------------------------------------------------------------------
T← (ifetch← PVAR) + 1;
T← Md, ifetch← T, branch[PUSHTMD];
regOP1[110, StackBR, opPVAR, 0]; * PVAR
regOP1[111, StackBR, opPVAR, 2];
regOP1[112, StackBR, opPVAR, 4];
regOP1[113, StackBR, opPVAR, 6];
regOP1[114, StackBR, opPVAR, 10];
regOP1[115, StackBR, opPVAR, 12];
regOP1[116, StackBR, opPVAR, 14];
regOP2[117, StackBR, opPVAR, noNData]; * PVARX
*--------------------------------------------------------------------
opFVAR:
*--------------------------------------------------------------------
T← (ifetch← PVAR) + 1;
LTEMP0← Md, ifetch← T;
.retryfvar:
branch[.+2, R even], LTEMP0, T← Md, memBase← ScratchLZBR;
T← Id, branch[.FVFAIL];
T← T and (rhmask); * KLUDGE: LH IS DUPLICATED!!!!
BRHi← T;
PAGEFAULTOK;
LTEMP0← (FETCH← LTEMP0) + 1;
T← MD, fetch← LTEMP0, branch[PUSHTMD];
.FVFAIL:
* T = offset of free variable, fill in and continue
LTEMP0← T, call[FVLOOKUP]; * T passed and smashed by FVLOOKUP
T← LTEMP0;
T← T + (PVAR);
T← (fetch← T) + 1;
LTEMP0← Md, fetch← T, branch[.retryfvar];
regOP1[120, StackBR, opFVAR, 0]; * FVAR
regOP1[121, StackBR, opFVAR, 2];
regOP1[122, StackBR, opFVAR, 4];
regOP1[123, StackBR, opFVAR, 6];
regOP1[124, StackBR, opFVAR, 10];
regOP1[125, StackBR, opFVAR, 12];
regOP1[126, StackBR, opFVAR, 14];
regOP2[127, StackBR, opFVAR, noNData]; * FVARX
*--------------------------------------------------------------------
opGVAR: * alpha + beta form atom number of global to fetch
*--------------------------------------------------------------------
T← Id; * hi bits
T← LSH[T,10]; * shift left
LTEMP0← ((Id) + T);
branch[.+2, alu>=0], LTEMP0 ← (LTEMP0) lsh 1;
flipMemBase; * use Val2BR instead
PAGEFAULTOK;
LTEMP0← (FETCH← LTEMP0) + 1;
T← MD, fetch← LTEMP0, branch[PUSHTMD];
regOP3[140, ValSpaceBR, opGVAR, noNData];
*--------------------------------------------------------------------
opSETPVAR:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase;
T← Md, fetch← T;
LTEMP0← (Id) + (PVAR), branch[TL.ST0TMD];
regOP1[130, StackM2BR, opSETPVAR, 0]; * PVAR←
regOP1[131, StackM2BR, opSETPVAR, 2];
regOP1[132, StackM2BR, opSETPVAR, 4];
regOP1[133, StackM2BR, opSETPVAR, 6];
regOP1[134, StackM2BR, opSETPVAR, 10];
regOP1[135, StackM2BR, opSETPVAR, 12];
regOP1[136, StackM2BR, opSETPVAR, 14];
regOP2[137, StackM2BR, opSETPVAR, noNData]; * PVARX←
*--------------------------------------------------------------------
opSETPVARPOP:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase; * fetch TSP-2
T← Md, TSP← (fetch← T) - 1; * fetch TSP-1, TSP← TSP-2
LTEMP0← (Id) + (PVAR);
LEFT← (LEFT) + 1, BRANCH[TL.ST0TMD];
regOP1[270, StackM2BR, opSETPVARPOP, 0];
regOP1[271, StackM2BR, opSETPVARPOP, 2];
regOP1[272, StackM2BR, opSETPVARPOP, 4];
regOP1[273, StackM2BR, opSETPVARPOP, 6];
regOP1[274, StackM2BR, opSETPVARPOP, 10];
regOP1[275, StackM2BR, opSETPVARPOP, 12];
regOP1[276, StackM2BR, opSETPVARPOP, 14];
*--------------------------------------------------------------------
opSETIVAR:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase;
T← Md, fetch← T;
LTEMP0← (Id) + (IVAR), branch[TL.ST0TMD];
regOP2[142, StackM2BR, opSETIVAR, noNData]; * IVARX←
*--------------------------------------------------------------------
opFVARgets:
*--------------------------------------------------------------------
T← (ifetch← PVAR) + 1;
LTEMP0← Md, ifetch← T;
.retrysetfvar:
branch[.+2, R even], LTEMP0, T← Md, memBase← StackM2BR;
T← Id, branch[.setffail]; * Fvar not looked up yet
T← T and (rhmask); * KLUDGE - TOP BYTE IS FILLED IN TOO
pd← T xor (StackHi);
branch[.setfglobal, alu#0], TSP← (fetch← TSP) - 1, flipMemBase;
T← Md, TSP← (fetch← TSP) + 1, branch[TL.ST0TMD];
.setfglobal:
TSP← (TSP) + 1, memBase← LScratchBR, Branch[.setglobal];
.setffail:
LTEMP0← T, call[FVLOOKUP];
T← LTEMP0;
T← T + (PVAR);
T← (fetch← T) + 1;
LTEMP0← Md, fetch← T, branch[.retrysetfvar];
regOP2[143, StackBR, opFVARgets, noNData];
*--------------------------------------------------------------------
SUBROUTINE; SUB.PUSHT:
*--------------------------------------------------------------------
TSP← (store← TSP) + 1, dbuf← T, return;
TOP LEVEL;
*--------------------------------------------------------------------
* GVAR← alpha + beta form atom number of global to store TOS
*--------------------------------------------------------------------
:if[Reduced];
UfnOps[27];
:else;
opGVARgets:
LTEMP0← Id, memBase← LScratchBR;
LTEMP0← LSH[LTEMP0, 10];
LTEMP0← ((Id) + (LTEMP0));
branch[.+2, alu>=0], LTEMP0 ← (LTEMP0) lsh 1;
T← (add[VALspace!,1]c), branch[.setglobal]; * use Val2BR instead
T← VALspace, branch[.setglobal];
.setglobal:
BrLo← LTEMP0;
BrHi← T, LTEMP4← A0;
PAGEFAULTOK;
Case← T← (FETCH← 0s) + 1, Call[GCLOOKUP]; * deleteref old pointer
memBase← StackM2BR, Branch[RPLPTRTAIL]; * addref for new pointer
regOP3[27, ifuBR, opGVARgets, noNData];
:endif;
*--------------------------------------------------------------------
opNIL:
*--------------------------------------------------------------------
Branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
TSP← (store← TSP) + 1, dbuf← (AtomHiVal), Branch[TL.PUSHNIL];
TL.PUSHNIL:
TSP← (store← TSP) + 1, dbuf← (AT.NIL), NextOpCode;
regOP1[150, StackBR, opNIL, noNData];
*--------------------------------------------------------------------
opKT:
*--------------------------------------------------------------------
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
PUSHTRUE1:
TSP← (store← TSP) + 1, dbuf← (AtomHiVal), branch[TL.PUSHTRUE];
TL.PUSHTRUE:
TSP← (store← TSP) + 1, dbuf← AT.T, NextOpCode;
regOP1[151, StackBR, opKT, noNData];
*--------------------------------------------------------------------
op01SIC:
*--------------------------------------------------------------------
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
TSP← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← TSP) + 1, dbuf← T, TisID, NextOpCode;
regOP1[152, StackBR, op01SIC, 0]; * '0
regOP1[153, StackBR, op01SIC, 1]; * '1
regOP2[154, StackBR, op01SIC, noNData]; * SIC
*--------------------------------------------------------------------
opSNIC:
*--------------------------------------------------------------------
T← (Id) - (400c);
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
TSP← (store← TSP) + 1, dbuf← SmallNegHi, branch[TL.PUSHT];
regOP2[155, StackBR, opSNIC, noNData]; * SNIC
*--------------------------------------------------------------------
opSICX:
*--------------------------------------------------------------------
T← Id, Call[.aconstfetch];
PUSHSMALLT:
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
PUSHSMALLT1:
TSP← (store← TSP) + 1, dbuf← SmallHi, branch[TL.PUSHT];
TL.PUSHT:
TSP← (store← TSP) + 1, dbuf← T, NextOpCode;
regOP3[156, StackBR, opSICX, noNData]; * SICX
regOP3[160, StackBR, opSICX, noNData]; * ATOMNUMBER
*--------------------------------------------------------------------
opACONST:
*--------------------------------------------------------------------
T← Id, Call[.aconstfetch];
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
TSP← (store← TSP) + 1, dbuf← (AtomHiVal), branch[TL.PUSHT];
SUBROUTINE;
.aconstfetch:
T← LSH[T,10];
T← (Id) + (T), Return;
TOPLEVEL;
regOP3[147, StackBR, opACONST, noNData];
*--------------------------------------------------------------------
opGCONST:
*--------------------------------------------------------------------
* push 24 bit inline constant
* coded as a one byte jump opcode which jumps to .+4
LTEMP0← not (PCX'); * current pc
LTEMP0← (LTEMP0) + 1; * byte# of hi byte
T← (LTEMP0) rsh 1; * word# of hi byte
PAGEFAULTOK;
T← (FETCH← T) + 1; * fetch it & next word
branch[.+2, R even], LTEMP0, T← MD, FETCH← T;
T← T and (rhmask), branch[PUSHTMD];
LTEMP0← MD; * rh T,,lh Md has low word, lh T has hi word.
PAGEFAULTNOTOK;
LTEMP0← rcy[T, LTEMP0, 10];
T← rsh[T, 10];
PUSHT0: * pushes T,,LTEMP0, bumps TSP, and decrements LEFT
branch[.+2, R>=0], LEFT← (LEFT) - 1, memBase← StackBR;
StackCheck;
PAGEFAULTNOTOK;
T← (store← TSP) + 1, dbuf← T;
TSP← (store← T) + 1, dbuf← LTEMP0, NextOpCode;
IFUjmp[157, 1, ifuBR, 0, opGCONST, 4];
:if[Reduced];
UfnOps[57];
:else;
*--------------------------------------------------------------------
opSTKSCAN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
FVNAME← Md, fetch← T, T← (FX.PVAR);
FVNAME← Md, pd← FVNAME;
branch[.+2, alu=0], pd← FVNAME;
CallUFN; * not LITATOM
branch[.+2, alu#0];
CallUFN; * NIL
nop; * placement constraints
FVEP← (PVAR) - T, call[DOLOOKUP];
memBase← StackM2BR, T← TSP;
T← (store← T) + 1, dbuf← FVHI;
store← T, dbuf← FVLO, NextOpCode;
REGOP1[57, StackM2BR, opSTKSCAN, noNData];
:endif;
*--------------------------------------------------------------------
SUBROUTINE; FVLOOKUP:
*--------------------------------------------------------------------
* look up free variable # T/2 in current frame
* fill in location where value is bound
* preserve LTEMP0
memBase← ifuBR;
PAGEFAULTOK;
FETCH← add[FNH.NLFV!]s;
FVNAME← T rsh 1; * free variable index
FVCHAIN← (PVAR) + T + 1; * where to fill in the indirection
FVTMP← MD; * nlocals, fvoffset
PAGEFAULTNOTOK;
T← rsh[FVTMP, 10]; * T← NLOCALS
FVTMP← (FVTMP) and (rhmask);
T← (FVTMP) - T;
T← T + (FVNAME);
fetch← T;
FVNAME← Md, T← (FX.PVAR);
FVEP← (PVAR) - T;
memBase← StackBR;
store← FVCHAIN, dbuf← 0c, branch[.newframe];
*--------------------------------------------------------------------
DOLOOKUP:
*--------------------------------------------------------------------
* Scan for free variable FVNAME starting at FVEP, return
* in FVHI,FVLO the pointer to where it is bound
* if FVCHAIN is odd, store indirection pointer at stackspace
* should check for reschedule!!!
FVCHAIN← A0;
.newframe:
T← (FVEP) + 1, memBase← StackBR;
fetch← T;
FVEP← Md;
FVEP← (FVEP) and not (1c);
FVEP← (FVEP) - (FX.PVAR);
branch[.endofstack, alu=0], fetch← FVEP;
FVTMP← Md;
pd← (FVTMP) and (FXNTValid);
T← (FVEP) + (FX.DEFLO), branch[.+2, alu=0];
T← (FVEP) + (FX.NTLO);
T← (fetch← T) + 1;
FVTMP← Md, fetch← T, T← (rhmask);
T← T and (Md), memBase← LScratchBR;
BrHi← T;
BrLo← FVTMP;
FVINDEX← FNH.FIRSTNAME;
.lookforvar:
PAGEFAULTOK;
FETCH← add[FNH.NTSIZE!]s; * can fault
FVTMP← Cnt← MD; * FVTMP = NTSIZE
PAGEFAULTNOTOK;
.fvloop: * this can really be done in a 2 inst loop
branch[.newframe, Cnt=0&-1];
FVINDEX← (fetch← FVINDEX) + 1;
T← Md;
pd← (FVNAME) xor T;
branch[.fvloop, alu#0];
% this is what a 2 instruction loop would look like
T← A0; * # FVNAME
branch[.+2, Cnt#0], pd← T-T-1; * pd #0
branch[.newframe];
FVINDEX← (fetch← FVINDEX) + 1, branch[.fvfound, alu=0];
T← Md, pd← (FVNAME) xor T, dblbranch[.notfound, .-1, Cnt=0&-1]
.fvfound:
FVINDEX← (FVINDEX) - (2c);
%
.fvfound: * found a match
T← (FVTMP) - 1;
T← T + (FVINDEX); * add NTSIZE, note FVINDEX already incremented
fetch← T;
FVHI← Md, T← (rhmask);
T← (T and (FVHI)) lsh 1, branch[.fvpfvar, R<0];
.fvivar:
FVEP← (FVEP) - 1, memBase← StackBR;
FVEP← (fetch← FVEP) + 1;
FVLO← T + Md;
FVHI← StackHi, branch[.donefvlookup];
.fvpfvar:
T← T + (FVEP), memBase← StackBR;
T← T + (FX.PVAR); * T is stack relative location
T← (fetch← T) + 1;
FVLO← Md, fetch← T;
FVHI← Md, pd← (FVHI) and (40000c); * check FVAR bit
FVHI← (FVHI) and (rhmask), branch[.fvfvar, alu#0];
.fvpvar:
branch[.+2, R>=0], FVLO, FVLO← T - 1, memBase← LScratchBR;
branch[.fvloop]; * unbound PVAR
FVHI← StackHi, branch[.donefvlookup];
.fvfvar:
branch[.+2, R odd], FVLO;
branch[.donefvlookup];
* should create chain here
branch[.newframe];
.endofstack:
FVLO← (FVNAME) + (FVNAME);
FVHI← ValSpace, branch[.+2, carry'];
FVHI← (FVHI) xor (1c); * a bit like flipMembase
.donefvlookup:
branch[.+2, R odd], FVCHAIN, memBase← StackBR;
return;
* kludge!!! * STORE FVHI in both halves
T← LSH[FVHI, 10];
T← T + (FVHI);
T← (store← FVCHAIN) - 1, dbuf← T;
store← T, dbuf← FVLO, return;
TOPLEVEL;