ER[LISP];

*I = 426

LM[CP,17]; LM[PP,16]; LM[BR,15]; LM[VP,14]; LM[CBS,13]; LM[TP,12];
LM[CBSP,7]; LM[L6,6]; LM[L5,5]; LM[L4,4]; *L4 CAN ONLY BE READ

RVN[ROPCD];	*HOLDS OPCODE BEING EXECUTED FOR INSTRUCTION TRAPS

SLC[@BOPXT: E1[BLOPXT]];
SLC[@JCONDP: E1[JCONDP]];
SM[BST,15];		*ADDRESSES WORD 15 IN KUNIT BLOCKS
*FIELDS BELOW AND @WPCT ARE USED WITH XSPLIT_ TO LOAD AC_1, X_11,
*Y_ADDRESS OF WPC (BOUNDARY OF 4).
F[OPCF,0,10]; F[ACF,11,14]; F[IXF,16,21];
SLC[@WPCT: OPCF[B4TAB] ACF[1] IXF[11]];
SM[BIS,IP[20000 000000S]];
SM[MD2,IP[200 000000S]];	*BYTE-LISP FLAG IN F
MC[BIS&K,BIS,K];
SM[NOTFLAGS&BIS,IP[20037 777777S]];
*! MAXC1 ONLY
SVN[WPC];		*HOLDS INTERNAL REPRESENTATION OF BYTE POSITION
*!
SM[SZERO,IP[4000S]];	*LISP SMALL INTEGER 0
*ST = ATOM "T"
*SNIL = ATOM "NIL"
*SKPRGLM = ATOM "PROGLM"
*TYPTAB = ORIGINS OF BIT TABLE POINTERS AND TYPE TABLE - 1 (BTT,,TYPTAB-1)
SM[LISTT,IP[10S]];	*PAGE TYPE = LIST
SM[ATOMT,IP[14S]];	*PAGE TYPE = LITERAL ATOM
SET[FLOATT,20];		*PAGE TYPE = FLOATING POINT
SM[FIXT,IP[22S]];	*PAGE TYPE = LARGE INTEGER
SM[SMALLT,IP[24S]];	*PAGE TYPE = SMALL INTEGER
*DISPLACEMENT OF SMALL NUMBERS = 4000.  RANGE OF SMALL NUMBERS IS
*-3000 TO 2777

*MAIN MEMORY COMMUNICATION TABLE (AT 200)
*40 LOCATIONS FOR EVEN OPCODE 600-676 TRAPS, THEN
*40 UNUSED LOCATIONS, THEN
SM[CF,IP[300S]];	*POINTS AT CURRENT STACK FRAME
*LSTSWF 301		*POINTS AT LAST SWAPPED FRAME
SET[POPJTP,302];	*ADDRESS OF POPJ CP,
SM[BXNUM,IP[3S]];	*TRAP TO BOX LARGE INTEGER WITH RESULT AT 0(PP)
SM[BLIUBE,IP[104S]];	*TRAP FOR ARG NOT INTEGER
SM[RPLERX,IP[5S]];	*TRAP FOR ARG NOT LIST
SET[FNCTRP,306];	*ADDRESS OF TRAP FOR FUNCTION CALLS
*307 TRAP ADDRESS FOR DATA TYPE ERRORS
*310-316 UNUSED
SM[BRET,IP[317S]];	*ADDRESS OF FUNCTION RETURNS
SET[BRET1,321];		*ADDRESS OF UNBIND RETURNS
SET[BRET2,323];		*ADDRESS OF DUNBIND RETURNS
SM[BNDTRP,IP[324S]];	*ADDRESS OF BIND TRAP-1 FOR XCT 1(2)
SET[LFCALL,326];	*ADDRESS OF PUSHJ CP,5 FOR LINKED-FN CALLS-1
SET[BRET3,130];		*ADDRESS OF BLOCK CALL RETURNS

TARGET[ILC];

CAR:	LAC_P AND Q;
*OPERATIONS WITH ONE ARGUMENT PRODUCING A RESULT EXIT HERE
FIXSTK:	P_PP, AMASK[22], Q_777777R, GOTO[BWPPQ1X];

SWAP:	Q_LAC, P_P AND Q, WRESTART;
	MDR_Q, LAC_P, GOTO[FIXSTK];

CDR:	PQ RCY[22], SAMASK[22];
FIXSP:	LAC_P, GOTO[FIXSTK];

POQL22:	0Q RCY [22], Q_P, INHINT, RETURN;

PQQL22:	QQ RCY [22], Q_P, BAMASK[22], RETURN;

INCP:	P_P+1, RETURN;

*WRITE THE DATA IN MDR TO THE ADDRESS IN P AND EXIT.  MAPVA_ HAS
*ALREADY BEEN DONE AND 777777 IS IN Q.  SET PDOVF IF J=1.
*TIMING = 3
XPUSH:	WREF, Q_(REFADR_P AND Q) U (WLE), GOTO[MILLEG,G=1];
	P_ICTR, SETFC[PDOVF,J=1];
	ICTR_P+1, GOTO[XCTBYT,G=0]; *CAREFUL OF CLOBBERING Y HERE
*! MAXC1 ONLY
BWRX1:	LEFADR_Q, P_ISPLIT_WPC, Q_10772 777777R, CALL[ADVPC];
	Q_P, P_WMQ;
	PC_Q, Q_P, CALL[LOADMAP];
	WREF, REFADR_P, GOTO[BWRQXX];
*!
*~ MAXC2 ONLY
BWRX1:	LEFADR_Q, P_ISPLIT_BPC, CLEARF[BIS], CALL[QBPC];
	PC_Q, Q_P;
	BPC_Q;
	Q_WMQ, CALL[LOADMAP];
*WREF CANNOT FAULT AGAIN IF LOADMAP RETURNS
	WREF, GOTO[XCTBYT];

QBPC:	Q_BPC, RETURN;
*~

QPANDQ:	Q_P AND Q, RETURN;

*WRITE LAC AT P+Q+1 AND RETURN WITH RTEMP IN P
BWPPQ1R: MAPVA_P_P+Q+1, SAMASK[22], Q_LAC;
BWRQR:	WREF, MDR_Q, REFADR_P, GOTO[MILLEG,G=1];
	P_RTEMP, Q_(P) U (WLE), RETURN[G=0]; **NOTE: X # 11 HERE
RPUSH1:	Q_(LEFADR_Q) U (WLE), GOTO[.+2,K=1]; *SKIP IFF PC_PC-1
	LEFADR_Q;
	Q_WMQ, CALL[LOADMAP];
	WREF, SETSF[INTCONDH], GOTO[RPUSH2];
*WRITE MDR TO THE ADDRESS IN P AND RETURN RTEMP IN P, LTEMP IN Q.
*MAPVA_ HAS ALREADY BEEN DONE AND 777777 IS IN Q.  SET PDOVF IF J=1.
*TIMING = 4
RPUSH:	WREF, Q_(REFADR_P AND Q) U (BLTWLE), GOTO[MILLEG,G=1];
	P_ICTR, SETFC[PDOVF,J=1];
	ICTR_P+1, SETSF[INTCONDH], GOTO[RPUSH1,G=1];
RPUSH2:	P_RTEMP, Q_LTEMP, X_11S, RETURN[H=0];
*CALL PI ROUTINE RETURNING P AND Q UNCHANGED, 11 IN X.
*CLOBBERS LTEMP AND RTEMP.
**THIS ROUTINE MUST WORK FOR THE BLISP PDP-10 INSTRUCTION AS WELL AS BYTE
**LISP OPCODES, AND FOR BYTE LISP OPCODES ERRONEOUSLY EXECUTED FROM
**PDP-10 MODE.
****WORRY ABOUT NOT PRESERVING P BELOW****
BPI:	LTEMP_Q, Q_777777R, SETSF[MD2&G], GOTO[PI,K=1];
	RTEMP_P, Q_PC, P_Q, CALL[QPANDQ,G=0];
	SETSF[NOVA&H], DGOTO[RPUSH2];
	P_NOTFCOND, CALL[PIX];

*PUSH VALUE IN P ON PARAMETER STACK, THEN EXIT
*TIMING = 5
PPPUSH:	MDR_P, P_PP, Q_(2 000002R) RSH 1, SETSF[J];
PPPSH1:	PP_MAPVA_P_P+Q+J, Q_777777R, GOTO[XPUSH];

*HERE WITH PP IN P, RESULT TO BE PUSHED IN MDR AND Q
PPPSHX:	LAC_Q, Q_(2 000002R) RSH 1, SETSF[J], GOTO[.-1];

*PUSH VALUE IN P ON PARAMETER STACK AND RETURN
PPPSHR:	MDR_P, P_PP, Q_(2 000002R) RSH 1, SETSF[J];
PPSHR1:	PP_MAPVA_P_P+Q+J, Q_777777R, GOTO[RPUSH];

*SUBROUTINE USED BY "CALLFN" TO ADVANCE STATE AND THEN PUSH THE VALUE
*IN P ON THE CP STACK
PDPCPP:	RTEMP1_P, P_CBS, Q_767777 777777S;
PDPCP1:	CBS_P-Q-1, P_RTEMP1;
*PUSH VALUE IN P ON CONTROL STACK AND RETURN.
*TIMING = 6
CPPUSH:	MDR_P, P_CP, Q_(2 000002R) RSH 1, SETSF[J];
	CP_MAPVA_P_P+Q+J, Q_777777R, GOTO[RPUSH];

	Q_RMQ, CALL[LOADMAP];
*TIMING = R+2
BRMEM:	RREF, P_(REFADR_P) U (BRLE), GOTO[MILLEG,G=1];
	LEFADR_P, X_11S, GOTO[.-2,G=1];
	P_MDR, Q_777777R, SETSF[13S], RETURN[K=0];
	PQ RCY [22], BAMASK[22], RETURN;

BRMEM1:	RTEMP_P, P_PP, Q_1S;
FPMQ:	MAPVA_P_P-Q, SAMASK[22], GOTO[BRMEM];

BRMEM2:	RTEMP_P, P_PP, Q_2S, GOTO[FPMQ];

CDRP:	PQ RCY [22];
READP:	MAPVA_P, SAMASK[22], GOTO[BRMEM];

*HAVE AC1 IN Q, FRAME DEPTH IN P FROM NEXTBYTE
ARGX:	RTEMP_P-1, P_Q, CALL[UNBOX]; *P_UNBOXED N, Q_DEPTH-1
AQQ:	AQ, RETURN;

ARGX1:	P_P-1, Q_VP, CALL[PVAR,ALU>=0];
*FETCH P+Q+1
IVAR:	MAPVA_P_P+Q+1, SAMASK[22], GOTO[BRMEM];

	Q_RMWMQ, CALL[LOADMAP];
BRMWM:	RMWREF, REFADR_P, Q_BRMWLE, INHINT, GOTO[MILLEG,G=1];
	LEFADR_P OR Q, X_11S, GOTO[.-2,G=1];
	P_MDR, Q_777777R, SETSF[3S], RETURN;

BRMWPP:	P_PP, Q_1S;
BRMWPMQ: MAPVA_P_P-Q, SAMASK[22], GOTO[BRMWM];

*TIMING = R+5
SETL:	MAPVA_P_P+Q+1, SAMASK[22], CALL[BRMWM];
	P_P AND Q, Q_LAC, WRESTART, CALL[POQL22];
	MDR_P OR Q, P_PP, Q_(2 000002R) RSH 1, SETSF[7S], RETURN;

*TIMING = R+4
SETR:	MAPVA_P_P+Q+1, SAMASK[22], CALL[BRMWM];
	Q_P AND NOT Q, P_LAC, SAMASK[22], WRESTART, GOTO[.-2];

*RETURN Q FOR OP OF 2 OR 3 ARGS IF ALU#0, ELSE RETURN WITH [P] IN P, 777777 IN Q
CRDPQ:	MAPVA_P, SAMASK[22], GOTO[BRMEM,ALU=0];
*REDUCE PP BY 1000001 IF H=0 OR BY 2000002 IF H=1, THEN STORE Q INTO 0(PP) AND EXIT.
*TIMING = 5 (+1 IF H=1)
PRQ:	LAC_Q;
PR1:	P_PP, Q_(2 000002R) RSH 1, MDR_Q, CALL[QL1,H=1];
	MAPVA_P_PP_P-Q, SAMASK[22], DGOTO[MILLEG];
	WREF, REFADR_P, GOTO[BWRQXX,G=0];

*READ THE ADDRESS IN P, RETURNING DATA IN MDR, RTEMP IN P,
*22044,,ADDRESS IN Q FOR "GNBYT"
	LEFADR_P, P_RTEMP, Q_(Q) U (22044 000000S), RETURN[G=0];
	Q_RMQ, CALL[LOADMAP];
BXMEM:	RREF, P_(Q_REFADR_P) U (BRLE), GOTO[.-2,G=0];
MILLEG:	Q_REFADR, Y_P_NULL, SETF[MD2&G], GOTO[MILEG1];

*HAVE VARIABLE DEPTH IN P[33,35], DISPLACEMENT IN P[36,43]
*RETURN FRAME POINTER IN Q, DISPLACEMENT IN P
*TIMING = 3 (+2R+6 + (R+3)*DEPTH IF DEPTH # 0)
LVARX:	Q_P, PQ RCY [6], SAMASK[3]; *P_FRAME DEPTH
	RTEMP_P-1, P_Q, SAMASK[6]; *P_DISPLACEMENT
	Q_VP, RETURN[ALU<0];
PVAR:	RTEMP1_P, P_MAPVA_CF, ACFS, CALL[BRMEM]; *FETCH PTR TO CURRENT FRAME
*HAVE FRAME POINTER IN P, REMAINING DEPTH IN RTEMP.  FETCH PP IN,,ALINK
	MAPVA_P_P+1, SAMASK[22], CALL[BXMEM];
	RTEMP_P-1;
	P_MDR, GOTO[.-2,ALU>=0];
	MAPVA_P_P, SAMASK[22], CALL[BXMEM]; *FETCH PTR TO 1ST ARG -1
	P_RTEMP1, Q_MDR, RETURN; **NOTE: X # 11 HERE

XVARX:	Q_NOT P, P_PP, RETURN;

BINDA0:	Q_CBS, AC_2S, GOTO[BNDRET,ALU>=0];
%HAVE CBS IN Q.  RETURNS CONSTANT [P]+CBS IN Q, ORIGINAL P IN P AND CBSP.
CBS USED AS FOLLOWS:  [1,5]=STATE, [6,11]=DEPTH, [0] AND [22,43]=
CONSTANT BASE REGISTER.
TIMING = R+6 +1 IF EVEN HALF-WORD
%
GETCON:	Q LCY 1, CBSP_P, SETSF[INTCONDH];
GETC2:	(Q_P+Q) ARSHC 1, CALL[BPI,H=1];
	MAPVA_P, SAMASK[22], DGOTO[BRMEM];
	SETFB[K,Q EVEN], GOTO[BRMEM,Q EVEN]; *CAN'T TEST Q AFTER SLOW LOAD

GTCON:	Q_CBS, GOTO[GETCON];

PSNIL:	P_PP, Q_MDR_SNIL, RETURN;
PST:	P_PP, Q_MDR_ST, RETURN;
PSSTK:	P_PP, Q_MDR_STACK, GOTO[PPPSHX];

QNIL:	Q_SNIL, P_LAC, RTEMP_P, BAMASK[22], RETURN;

*Q_BOXED 0, ALU=0 FOR "NTYP"
QZERO:	Q_SZERO, A0, RETURN;

SIC:	Q_STACK;
	Q_MDR_P+Q, P_PP, POP, GOTO[PPPSHX]; *Q_MDR_NEXTBYTE-400+4000


*CONDITIONAL JUMP ON ALU#0.  HAVE JUMP BYTE IN P, 400 IN Q
*TIMING = R+5 (+1 IF H=1) ON NO JUMP
*	= R-X+13 ON JUMP NO POP
*	= 2R-X+14 ON JUMP AND POP
JNEQT:	P AND Q, SETSF[K], GOTO[JCONDP,ALU#0];
*POP PP ONCE IF H=0, TWICE IF H=1.  JUMP WITH DISPLACEMENT IN Q IF K=1
PPOP:	P_PP, Q_(2 000002R) RSH 1, STEMP_Q, CALL[QL1,H=1];
PPOP1:	RTEMP_MAPVA_P_P-Q, SAMASK[22], CALL[BXMEM];
	PP_P, P_ICTR, Q_STEMP, GOTO[JMP1,K=1];
	P_MDR, Q_777777R, GOTO[XCTBL];

*HERE ON JUMP INSTRUCTIONS WITH JUMP DISPLACEMENT IN Q, ICTR IN P.
*TIMING = R-X+10
JMP1:	ICTR_P+1, 0Q RCY [22], Q_PC;
	P_P+Q, Q_3 777777L, CLEARF[BIS&K], DGOTO[LENTER,K=0];
*Q_NON-OVERFLOW, P_OVERFLOW
	Q_P AND Q, PQ RCY [24], SAMASK[20], CALL[JMPNEG,ALU<0];
	Q_P+Q, P_MDR;
	LAC_P, P_NULL, GOTO[LENTER];

JMPNEG:	P_(P) U (777777 600000S), RETURN;

JMP0:	Q_P-Q, P_ICTR, CLEARFC[K,H=0], GOTO[JMP1,H=0];
	P_PP, Q_(2 000002R) RSH 1, STEMP_Q, GOTO[PPOP1];

*HERE ON JUMPX, ARG BYTE IN P
JUMPX:	Q_777777 777400S, RETURN;

*HERE ON JUMPXX, FIRST ARG BYTE IN Q, 2ND IN P
JUMPXX:	Q_(P) U (777777 400000S), PQ RCY [33];
JMP:	Q_P+Q, P_ICTR, SETSF[K], GOTO[JMP1];

*CONDITIONAL JUMP ON ALU=0.  HAVE JUMP BYTE IN P, 400 IN Q
JEQT:	P AND Q, SETSF[K], GOTO[PPOP,ALU#0];
JCONDP:	P_P AND NOT Q, Q_(200R) RSH 1, SETF[K], GOTO[JMP0,ALU=0];
	Q_P-Q, GOTO[PPOP];

PPOP2:	P_PP, Q_2 000002R, RETURN;
PPOP3:	P_PP, Q_3 000003S, RETURN;

*RETURN THE TYPE OF Q IN P, ORIGINAL P IN Q
*TIMING = R+5
LDT:	LTEMP_P, QQ RCY [11], XMASK, Q_TYPTAB, CALL[IVAR];
	AMASK[6], Q_LTEMP, MDR_102S, RETURN; *MDR_102 FOR DATA TYPE ERRORS

*HAVE TYPE IN Q, CONDITIONAL JUMP BYTE IN P.
*RETURN ALU=(TYPE OF LAC)-TYPE, CONDITION-JUMP BYTE IN P, 400 IN Q
*TIMING = R+7
TTYPE:	RTEMP_P, P_Q, Q_LAC, CALL[LDT];
JCOND1:	P-Q, P_RTEMP, Q_400S, RETURN;

*JUMP IF P .G. Q
*HAVE H=1 IF P-Q OVERFLOWED--THEN MUST DO COMPLEMENT TEST
TG:	FRZBALUBC, NPC_@JCONDP, GOTO[.+3,H=1];
	P AND Q, SETF[H], GOTO[PPOP,ALU<=0];
TLE:	FRZBALUBC, NPC_@JCONDP, GOTO[.-1,H=1];
	P AND Q, SETF[H], GOTO[PPOP,ALU>0];

*JUMP IF P .GE. 0
*HAVE H=1 IF P-Q OVERFLOWED--THEN MUST DO COMPLEMENT TEST
TGE:	FRZBALUBC, NPC_@JCONDP, GOTO[.+3,H=1];
	P AND Q, SETF[H], GOTO[PPOP,ALU<0];
*JUMP IF P .L. 0
TL:	FRZBALUBC, NPC_@JCONDP, GOTO[.-1,H=1];
	P AND Q, SETF[H], GOTO[PPOP,ALU>=0];

*TEST INTEGERS EQUAL
TEH:	P-Q, SETF[H], P_L5, Q_400R, RETURN;

*COMPARE INTEGERS, H_1 IF OVERFLOW
TE:	P-Q, SETHOVF, P_L5, Q_400R, RETURN;

*RETURN ALU=(P AND Q)#LAC, RTEMP IN P, 400 IN Q, H=1
TEQ:	P_P AND Q, Q_LAC, SETF[H], GOTO[JCOND1];

*RETURN P IN P, 400 IN Q, ALU=0 IFF TYPE OF Q=LISTT
TTLIST:	RTEMP_P, QQ RCY [11], XMASK, Q_TYPTAB, CALL[IVAR];
	AMASK[6], Q_LISTT, GOTO[JCOND1];

*RETURN ALU#0 IF TYPE OF LAC .L. STACK OR .G. SMALLT WITH NEXTBYTE IN P,
*400 IN Q; ELSE RETURN ALU=0.
TATTYP:	RTEMP_P, QQ RCY [11], XMASK, Q_TYPTAB, CALL[IVAR];
	AMASK[6], Q_STACK;
	P-Q, Q_SMALLT, POP;
	P-Q-1, P_RTEMP, Q_400S, RETURN[ALU<0];
	AQ, RETURN[ALU>=0];
	A0, RETURN;


*CLEAR STATE AND ADD Q TO CBS
SSTATQ:	P_CBS;
*HERE WITH CBS IN P.  CLEAR STATE AND ADD Q
ADVSTT:	Q_(NOT P) U (370000 000000S), P_Q;
CBSPQ:	P_CBS_P-Q-1, Q_RTEMP, RETURN;

*HERE TO INCREMENT STATE IN CBS
INCSTT:	P_CBS, Q_767777 777777S, GOTO[CBSPQ];

*TRAP IF TYPE OF -1(PP) IS NOT LISTT, ELSE RETURN WITH -1(PP) IN P, 777777 IN Q.
RPLSUP:	P_PP, Q_1R, CALL[FPMQ];
	Q_P_P AND Q, CALL[TTLIST];
	Q_777777R, MDR_100S, RETURN[ALU=0];
*ALSO GET HERE WITH 102 IN MDR FOR DATA TYPE ERRORS
TYPERR:	P_(RPLERX) U (MDR), GOTO[FCALLX];

RPL:	Q_P_REFADR, PP_P-Q, SAMASK[22], GOTO[XCTBL];

GETPLP:	L5_P AND Q, P_ICTR, SETSF[INTCONDH], DGOTO[GETP3];
	ICTR_P+1, P_L5, CALL[BPI,H=1];

GETP:	P_PP, Q_(2 000002R) RSH 1,  A0, GOTO[FPMQ,K=0]; *FPMQ RETURNS TO GETP1
GETP2:	P_L5, AMASK[22], Q_SNIL, GOTO[PRQ,ALU#0];
GETP3:	MAPVA_P, SETF[BIS&K], CALL[BRMEM]; *P_PROPLIST OR CDR
	RTEMP_P, PQ RCY [11], XMASK, Q_TYPTAB, CALL[IVAR];
GETL2:	AMASK[6], Q_LISTT;
*EXIT WITH RESULT NIL IF CDR IS NOT A LIST, ELSE P_CDDR,CADR
	P#Q, P_RTEMP, Q_SNIL, CALL[CRDPQ];
	RTEMP_P, PQ RCY [33], XMASK, Q_TYPTAB, CALL[IVAR];
	AMASK[6], Q_LISTT;
	P#Q, P_RTEMP, BAMASK[22], Q_LAC; *CDDR A LIST?
	P#Q, P_RTEMP, Q_SNIL, GOTO[PRQ,ALU#0]; *CADR EQ PROPERTY?
	PQ RCY [22], Q_777777R, GOTO[GETPLP,ALU#0];
	MAPVA_P_P AND Q, CALL[BRMEM];
PAQR:	Q_LAC_P AND Q, SETSF[H], GOTO[PR1];

GETL1:	RTEMP_L5_P AND Q, PQ RCY [11], XMASK, Q_TYPTAB, GOTO[IVAR];

*HERE WITH -1(PP) IN P, 777777 IN Q
GETP1:	L5_P AND Q, PQ RCY [11], XMASK, Q_TYPTAB, CALL[IVAR];
	AMASK[6], Q_ATOMT, GOTO[JCOND1]; *RETURNS TO GETP2

*HAVE ARG1 IN P, 777777 IN Q, ARG2 IN LAC.  DETERMINE IF ARG1 IS EQ
*SOME ELEMENT OF THE LIST ARG2.
FMEMB1:	P_RTEMP, CALL[BPI,H=1];
FMEMB:	RTEMP_P, P_LAC, Q_SNIL, CALL[JCOND1]; *RTEMP_ARG1, NIL TEST ON ARG2
	P_LAC, AMASK[22], Q_SNIL, GOTO[PRQ,ALU=0];
	MAPVA_P, CALL[BRMEM]; *CAR(ARG2), CDR(ARG2)
	Q_P AND Q, PQ RCY [22], BAMASK[22], SETSF[INTCONDH]; *Q_CAR, P_CDR
	LAC_P, P_RTEMP, BAMASK[22];
	P#Q, P_ICTR, DGOTO[PAQR];
	ICTR_P+1, Q_LEFADR, P_777777S, GOTO[FMEMB1,ALU#0];

*HAVE ARG1 IN P, 777777 IN Q, REMAINING LIST IN RTEMP AND AC1
ASSOC:	ROPCD_P AND Q;
ASSOC1:	P_LISTT, Q_LAC, CALL[LDT]; *P_TYPE OF LAC, Q_LISTT
*EXIT WITH RESULT NIL IF LAC IS NOT A LIST, ELSE P_CDR,,CAR
	P#Q, P_LAC, Q_SNIL, CALL[CRDPQ];
	MAPVA_RTEMP_P, SAMASK[22], CALL[BRMEM]; *P_CDAR,,CAAR
	SAMASK[22], Q_ROPCD, CALL[JCOND1]; *P_CDR,,CAR, ALU=0 IF CAAR=ARG1
	Q_REFADR, PQ RCY [22], SAMASK[22], GOTO[PRQ,ALU=0];
	LAC_P, P_ICTR, SETSF[INTCONDH], DGOTO[ASSOC1];
	ICTR_P+1, CALL[BPI,H=1];

%DEIMPLEMENTED FOR LACK OF STORAGE
*HAVE REMAINING LIST IN AC1
LENGTH:	P_L5, CALL[ZEROP,K=0];
*HAVE LENGTH IN P, POINTER TO REST OF LIST IN Q
LENG1:	SETSF[K], CALL[TTLIST]; *RTEMP_P_LENGTH, ALU=0 IF A LIST
	Q_3000S, RETURN[ALU#0];
	P_LAC, SETF[BIS&K], CALL[READP]; *P_CDR(AC1)
	Q_LAC_P, P_RTEMP, DGOTO[LBPCK];
	L5_P+1, P_ICTR, SETSF[INTCONDH], DGOTO[LENG1];
%

*RETURN POINTER TO THE LAST ELEMENT OF A LIST
LAST:	P_SNIL, GOTO[TTLIST,K=0]; *TTLIST RETURNS TO LAST1
*L5/ RESULT IF NOT A LIST, Q/ POINTER TO TAIL
LAST0:	P_L5, AMASK[22], SETSF[K], CALL[TTLIST];
*P/ RESULT IF NOT LIST, LAC/ TAIL OF LIST, ALU=0 IF TAIL IS A LIST
LAST1:	Q_LAC, SETF[BIS&K], GOTO[FIXSP,ALU#0];
	MAPVA_L5_P_AQ, SAMASK[22], CALL[BRMEM]; *AC5_AC1, P_CDR(AC1)
	Q_LAC_P, P_ICTR, SETSF[INTCONDH], DGOTO[LAST0];
LBPCK:	ICTR_P+1, P_L5, CALL[BPI,H=1];


*DATA TYPE ROUTINES

BFETCH:	RTEMP_P AND Q, P_LAC, SETF[J], GOTO[STORE];
BFET1:	MAPVA_RTEMP_P_P+Q, SAMASK[22], CALL[BXMEM];
*RTEMP,P/ BYTE POINTER TO DATUM, MDR/ WORD AFFECTED
	ISPLIT_Q_P, CALL[BDPB]; *G_0 IF MUST BOX BYTE
	PQ RCY [Y], XMASK, GOTO[IREMN,G=0];
	LAC_Q_P, SETSF[H], GOTO[PR1];

*TRAP IF THE TYPE OF THE DATUM IS .NE. TYPE OF DESCRIPTOR.
*IF J=1, GOTO BFET1 WITH THE SELECTED ITEM IN P+Q, G=0 IF BOX/UNBOX.
*AT CALL:  P/ POINTER TO DESCRIPTOR, RTEMP/ POINTER TO DATUM
STORE:	MAPVA_P, SAMASK[22], CALL[BRMEM];
	L6_P, PQ RCY [11], SAMASK[7], DGOTO[.+1];
	Q_P, GOTO[.+2,ALU=0];
	Q_RTEMP, CALL[LDT];
*P/ TYPE OF DATUM, Q/ TYPE OF DESCRIPTOR, 6/ DESCRIPTOR, RTEMP/ PTR TO DATUM
*MDR/ TRAP DISPLACEMENT FOR DATA TYPE ERROR
	P#Q, P_L6, Q_777000S, DGOTO[BFET1,J=1];
	ISPLIT_P_P AND NOT Q, Q_RTEMP, GOTO[TYPERR,ALU#0];
	Q_RTEMP_P+Q, P_LAC, INCAC, X_11S, CALL[UNBOX,G=0];
*HAVE BYTE TO BE STORED IN P, BYTE POINTER IN Q AND RTEMP
	LAC_P, P_Q, Q_NULL, CALL[BRMWPMQ];
	Q_RTEMP, A0, CALL[BDPB];
	Q_LAC, SETF[H], GOTO[PR1];

*UNBOX RETURNS UNBOXED INTEGER P IN P, RTEMP IN Q
*UNBOX1 RETURNS UNBOXED INTEGER -1(PP) IN P, RTEMP IN Q
*UNBSP RETURNS UNBOXED Q IN Q, UNBOXED -1(PP) IN P, ORIGINAL P IN L5
UNBSP:	L5_P, P_Q, CALL[UNBOX];
UNBOX1:	RTEMP_P, P_PP, Q_1S, CALL[FPMQ];
UNBOX:	L6_Q_P, P_SMALLT, CALL[LDT];
	P#Q, Q_FIXT;
	P#Q, P_L6, Q_SZERO, GOTO[PMQ,ALU=0];
	Q_P, P_BLIUBE, GOTO[FCALLY,ALU#0]; *ARG NOT INTEGER?
	MAPVA_P_AQ, SAMASK[22], CALL[BXMEM];
*! MAXC1 ONLY
	X_11S;
	P_MDR, Q_RTEMP, RETURN;
*!
*~ MAXC2 ONLY
	P_MDR, Q_RTEMP, BAX[11], RETURN;
*~

*ROUTINE TO BOX INTEGER RESULT IN "RTEMP" FOR OPERATION WITH TWO ARGUMENTS
IBOX:	PP_P-Q-1, P_RTEMP, Q_3000S;
*ROUTINE TO BOX INTEGER RESULT IN P FOR OPERATION WITH ONE ARGUMENT
IBOX0:	P-Q, MDR_100S;
	P+Q, Q_SZERO, GOTO[.+2,ALU>=0];
IBOX1:	LAC_P+Q, MDR_100S, GOTO[FIXSTK,ALU>=0]; *SMALL INTEGER RESULT
	LAC_P, P_(BXNUM) U (MDR), GOTO[FCALLX];

BIDIV:	Q_P, P_Q, GOTO[IDIV];
IQUOT:	RTEMP_Q, P_PP, Q_1 000000S, GOTO[IBOX];
IREMN:	RTEMP_P, P_PP, Q_1 000000S, GOTO[IBOX];
IAND2:	RTEMP_P AND Q, P_PP, Q_1 000000S, GOTO[IBOX];
IOR2:	RTEMP_P OR Q, P_PP, Q_1 000000S, GOTO[IBOX];
IXOR2:	RTEMP_P#Q, P_PP, Q_1 000000S, GOTO[IBOX];
IDIF2:	RTEMP_P-Q, SETOVPC01, P_PP, Q_1 000000S, GOTO[IBOX];
IPLUS2:	RTEMP_P+Q, SETOVPC01, P_PP, Q_1 000000S, GOTO[IBOX];

*HAVE SHIFT COUNT IN Q, INTEGER IN P
BLLSH:	YSHIFT_Q, Q_P, GOTO[LSH];
BLASH:	YSHIFT_Q, Q_P, GOTO[ASH];

IPLUS1:	P_P+Q, SETOVPC01, Q_3000S, GOTO[IBOX0];

QFM1:	Q_A1, RETURN;

%DEIMPLEMENTED FOR LACK OF STORAGE
*HAVE NEXTBYTE IN P, AC1 IN Q.  SETUP FOR ZERO TEST.
ZEROT:	Q_SZERO, P_LAC, RTEMP_P, BAMASK[22], RETURN;
%

*! MAXC1 ONLY
FNOPC:	CALL[GOSTAT];	*HERE FOR FN0, FN1, FN2, AND FN3
*!
*HAVE NUMBER OF ARGS IN Q, NAME DISPLACEMENT IN RTEMP, 1 IN AC
*TIMING = R + 43
FNX:	LAC_Q, P_RTEMP, AC_2S;
	P_NOT P, Q_CBS, CALL[GETCON]; *P_FUNCTION NAME, Q_777777
LFNC:	LAC_P AND Q, DECAC;
	P_CBS, Q_370000 000000S;
*PUSH CP,CBS.  SAVED STATE = DON'T CARE
	CBS_P_P AND NOT Q, SETF[BIS], CALL[CPPUSH];
*! MAXC1 ONLY
ST0:	P_ISPLIT_WPC, Q_10772 777777R, CALL[ADVPC];
	RTEMP1_P OR NOT Q, P_CBS, Q_767777 777777S, CALL[PDPCP1];
*!
*~ MAXC2 ONLY
ST0:	ISPLIT_BPC, CLEARF[BIS], P_CBS, Q_7777 777777R;
	CBS_P+Q+1, Q_TENF, SETF[BIS];
	P_(Q) U (BPC), CALL[CPPUSH];
*~
ST1:	Q_BRET, P_PP;
PLAM:	RTEMP_Q, BAMASK[22], Q_LAC, AC_17S;
 *VP_POINTER TO ARG 0 - 1
	VP_Q_P-Q, P_RTEMP, CLEARF[BIS&MD0&MD1&MD2&J], CALL[POQL22];
	MDR_P OR Q, Q_CBS, P_7777 777777R, SETSF[J];
	CBS_P+Q+1, DGOTO[FNCTRP]; *INCREMENT STATE FOR "BIND" AND "DBIND"
*FINISH WITH PDP-10 MODE PUSH CP,MDR
	PC_NPC, P_LAC, Q_(2 000002R) RSH 1, GOTO[PUSH0];

*HAVE NUMBER OF ARGS IN Q, DISPLACEMENT OF TWO-WORD BLOCK IN RTEMP, 1 IN AC
*EFNCAL WILL EXECUTE THE PUSHJ CP,5 AT LFCALL.
LFNX:	LAC_Q, P_RTEMP, AC_2S;
	P_CBS, Q_P+1, CALL[FPMQ]; *P_HCCALBITS,,DEF
	MAPVA_P_40S, ACFS, Q_P, CALL[BWRQR]; *SIMULATE UUO STORE
	Q_RTEMP, P_CBS, CALL[FPMQ]; *P_NAME,,JUMP ADDRESS
	Q_(P AND Q) U (324000 000000S), PQ RCY [22], BAMASK[22];
	L6_Q, Q_201100 000000S, DGOTO[LFCALL]; *AC6_JUMPA UUOROUTINE OR DEF
	L5_P OR Q, P_NPC, Q_777777R, GOTO[LFNC]; *AC5_MOVEI 2,NAME

ZUNBND:	P_NULL, GOTO[UNBIND];
*"RETURN" AND "XRETURN" COME HERE--SBCAL DOES THE SWAP FIX UP FOR "RETURN"
BRETRN:	RTEMP_P, P_CBS, Q_7400 000000S;
*UNBIND COMES HERE WITH 0 IN P
UNBIND:	P AND Q, P_CBS, Q_400 000000S, DGOTO[FCALLY];
*RETURN TO "FCALLX" FOR "UNBIND" AND "RETURN", TO "XRETRN" FOR "XRETURN"
	CBS_P-Q, Q_RTEMP, P_102S, RETURN[ALU=0];

%POP PP ACCORDING TO THE ARG BYTE.  PDP-10 CODE AT "BRET3" IS:
	MOVEM 1,0(PP)
	BFRET CBS,0(CP)
%
XRETRN:	QQ RCY [22];
	Q_P OR Q, P_PP, DGOTO[BRET3];
	PP_P-Q, P_NPC, GOTO[FCALLX];


%BLOCK CALL TO BYTE LISP FUNCTION NOT BUILDING FRAME.  4 OPCODE BITS AND
NEXTBYTE FORM A 13-BIT NUMBER SUCH THAT NUMBER - 10000 IS THE DISPLACEMENT
FROM THE WORD CONTAINING "LCALL" TO THE "BLISP INSTRUCTION BEGINNING THE
SUBROUTINE.
%
LCALL:
*! MAXC1 ONLY
	P_(ROPCD) RSH [1], SAMASK[4], CALL[GNBYT];
*!
	Q_(P) U (777777 770000S), PQ RCY [33];
	P_P+Q, Q_PC;
*K=1 IF ALREADY PUSHED CBS.  SAVE NEW PC IN "LTEMP" FOR "PUSHJ1"
	LTEMP_P+Q, AC_17S, GOTO[.+2,K=1];
	P_CBS, SETF[BIS], CALL[CPPUSH];
*! MAXC1 ONLY
	P_ISPLIT_WPC, Q_10772 777777R, CALL[ADVPC]; *ADVPC CLEARS BIS
	MDR_P OR NOT Q, P_LAC, Q_(2 000002R) RSH 1, CLEARF[BIS&MD0&MD1&MD2&J], GOTO[PUSHJ1];
*!
*~ MAXC2 ONLY
	ISPLIT_BPC, CLEARF[BIS&MD0&MD1&MD2&J], CALL[QBPC];
	MDR_(Q) U (TENF) U (MD2), P_LAC, Q_(2 000002R) RSH 1, GOTO[PUSHJ1];
*~

%6 AND Q/  -NARGS TO DO,,PTR TO NEXT-1
5/  NARGS ALREADY ON STACK
CBSP/ DISPLACEMENT OF NEXT ARG RELATIVE TO CBS IN POINTER AREA
STATE = CALLER OF BINDA
%
BINDA4:	L5_P-1, P_Q_SNIL; *PUSH NIL FOR ANONYMOUS ARGS NOT ON STACK
*PUSH VCELL-PTR,, OLD VALUE FOR NAMED ARGS
BINDA3:	MDR_P OR Q, P_PP, Q_(2 000002R) RSH 1, SETSF[J], CALL[PPSHR1,ALU<0];
ST7:
BINDA2:	Q_L6;
BINDA:	ROPCD_Q, P_CBSP, CALL[BINDA0]; *GETCON OR EXIT IF DONE
	RTEMP_P AND Q, P_L5, MDR_SNIL; *RTEMP_VCELL POINTER
	RTEMP1_P, P_L6, SETFB[H,ALU=0], GOTO[BINDA1,ALU=0]; *GO IF ANONYMOUS
	MAPVA_P_P+1, SAMASK[22], CALL[BXMEM,ALU>0]; *MDR_NEW VALUE (OR LEAVE NIL)
	P_MDR, Q_777777R;
	LTEMP_P AND Q, P_RTEMP, Q_NULL, CALL[BRMWPMQ]; *LTEMP_NEW VALUE
	LPGRT_P AND Q, WRESTART; *LPGRT_OLD VALUE
	P_P AND NOT Q, Q_LTEMP, SETSF[H], INHINT;
BINDA1:	MDR_P OR Q, P_CBSP, Q_(2 000002R) RSH 1; *R.H. MDR_NEW VALUE
	CBSP_P+1, P_ROPCD;
	L6_P+Q, P_RTEMP1, GOTO[BINDA4,H=1];
	L5_P-1, Q_RTEMP;
	0Q RCY [22], Q_LPGRT, FRZBALUBC, GOTO[BINDA3,ALU<0];
*WRITE VCELL-PTR,,OLD VALUE ON TOP OF NEW VALUE ON STACK
	P_L6, Q_P OR Q, SAMASK[22], DGOTO[BINDA2];
	MAPVA_P, CALL[BWRQR];

BIND:	CALL[GOSTAT];
*HAVE N1.N2 IN Q, N IN RTEMP
	QQ RCY [5], BAMASK[4]; *P_N1 = NARGS TO NAME
	MDR_L5_Q_P, P_Q, SAMASK[5]; *P_N2 = NARGS TO GET NIL
	LAC_Q_P+Q, P_NULL, SETF[BIS]; *1_NARGS TOTAL
	RTEMP1_P-Q, P_PP, Q_MDR, SAMASK[22]; *RTEMP1_-NARGS TOTAL, Q_NARGS TO NAME
	P_P-Q, Q_RTEMP1, SAMASK[22], CALL[POQL22]; *P_-NARGS TOTAL,,0  Q_PTR TO 1ST ON STK-1
	L6_P OR Q, Q_70000 000000S, CALL[SSTATQ];
	CBSP_Q, CALL[BINDA2]; *CBSP_ RTEMP = N
*NOTE FANCY USE OF EXTRA RETURN IN STATE DISPATCH AFTER ST7
*2_BNDTRP-1 = DUMMY ATOM FOR XCT 1(2)
*! MAXC1 ONLY
BINDR:	LAC_Q, Q_(NOT F) U (NOTFLAGS), DECAC;
	Q_(NOT Q) U (PC), P_PP;
*!
*~ MAXC2 ONLY
BINDR:	LAC_Q, Q_(TENF) U (PC), DECAC;
	P_PP;
*~
	L6_Q, Q_STACK, GOTO[PLAM];

*FUNCTION SETUP IN PDP-10 MODE RESUMES BIND AT ST8.
ST8:	P_CBS, Q_10400 000000S;
	CBS_P+Q, P_SKPRGLM, CALL[PPPSHR]; *PUSH FN NAME, ADD 1 TO DEPTH & STATE
ST9:	P_CBS, Q_2S, CALL[BNDFIX];
	P_P AND Q, Q_PP, WRESTART, AC_1S, CALL[POQL22]; *HRLM PP,-2(CP)
	MDR_P OR Q, P_LEFADR, Q_1R, CALL[BRMWPMQ];
	RTEMP_P_P AND Q, Q_LAC, WRESTART, AC_3S, CALL[POQL22];
	MDR_P OR Q, Q_RTEMP, DGOTO[XCTBL]; *HRLM 1,-3(CP)
	VP_Q, MAPVA_P_CF, ACFS, CALL[BRMEM];

*SKIP TWO MORE STACK ITEMS IN A SWAPPED FUNCTION
BNDFIX:	ISPLIT_2P, P_CP, DGOTO[BRMWPMQ];
	MAPVA_P_P-Q, SAMASK[22], GOTO[BRMWM,G=1];	*GO IF NOT SWAPPED

*RETURN WITH Q UNCHANGED, P IN RTEMP IF BIS=0, ELSE DISPATCH TO STATE
*WITH 1 IN AC, K=0
GOSTAT:	RTEMP_P, P_(CBS) RSH [1], BAMASK[42], SETSF[BIS&K];
	BSPLIT_P, PQ RCY [35], BAMASK[1], RETURN[K=0];
	POP, YKPTR_Y; *FLUSH REGULAR RETURN FROM STACK
	P, NPC_STACK_BST;
	SETSF[K], GOTO[RETN,ALU#0]; *RETURN ILLEGAL AFTER STACK_

%HAVE BLISP INSTRUCTION IN "INSTR" IN PDP-10 MODE.  CARRY OUT
FUNCTION ENTRY.  "INSTR" USED AS FOLLOWS:
   B[11,14] = A = NUMBER OF ARGUMENTS EXPECTED (1 FOR NO-SPREAD)
   B[15] = SWAPPED FUNCTION
   B[16] = VARIABLE NUMBER OF ARGUMENTS (NO SPREAD)
   B[17] = EVALUATE ARGUMENTS
   B[20] = ALL ARGS LOCALVARS
   B[21] = NO FRAME
   B[22,43] = DISPLACEMENT IN HALF-WORDS TO FIRST CONSTANT FROM PC
INSTRUCTION TRAP IF PC IS 0-17.  HAVE NARGS PASSED IN 1, FN NAME IN 2
TIMING = M+2R+56 +[2+8/ARG IF ALL ARGS LOCALVARS]
%
BL:	P_INSTR, AMASK[27], Q_17 000000S;	*PRESERVE "SWAPPED" BIT
	MAPVA_Q_PC, ACFS, P_P AND NOT Q, CALL[BL0];
*HAVE STATE 12 (STA), DEPTH 0, CBS IN Q, NO-FRAME BIT IN RTEMP[21]
*HAVE REST OF STUFF IN "INSTR"
	CBS_Q, P_Q_RTEMP, BAMASK[22];
	P#Q, P_INSTR, DGOTO[QL1]; *"QL1" = Q LSH 1 RETURNS TO "BL6"
*P_NARGS EXPECTED, G_SPREAD
	ISPLIT_Q_2P, PQ RCY [27], SAMASK[4], GOTO[BLXIT,ALU#0];

BL0:	P_Q, Q_(P) U (240000 000000S), GOTO[ILLIO,G=1]; *PC= 0 TO 17 TRAPS
*BACKUP PC, SO THAT IF INSTRUCTION IS INTERRUPTED IT WILL BE
*RESTARTED.  ADD PC TO RIGHT 18 INSTRUCTION BITS RCY 1 TO FORM "CBS"
	OLDPC_Q_P-1, AC_1S, QQ RCY [1], DGOTO[GOSTAT];
	PC_Q, Q_P+Q, P_INSTR, BAMASK[23]; *"GOSTAT" RETURNS TO "BL"+1

*RTEMP_L5_NARGS EXPECTED, J_1 IF SPREAD, G_0 IF EVALUATE ARGS
BL6:	RTEMP_L5_P, ISPLIT_Q, SETFB[J,G=1], DGOTO[.+3,G=1];
*P_NARGS PASSED, Q[15]_SWAPPED, LEAVE J=1 IF NOT LAMBDA ATOM
	P_LAC, Q_INSTR, SETFC[J,G=1], GOTO[.+2,G=1];
	RTEMP_P+1; *NARGS ON STACK=NARGS PASSED+1 FOR LAMBDA ATOMS
	ISPLIT_Q, CBSP_A0; *G_0 IF SWAPPED
	P_CP, Q_A1, AC_4S, CALL[QF1,G=0];
	P_LAC_P-Q-1, Q_3S, CALL[BRMWPMQ]; *4_CP IF UNSWAPPED, CP-2 IF SWAPPED
	P_P AND Q, Q_RTEMP, AC_1S, WRESTART, CALL[POQL22];
*HRLM A,-3(CP) OR -5(CP), P_NARGS PASSED, Q_NARGS EXPECTED.
	MDR_P OR Q, P_LAC, SETF[BIS], Q_RTEMP, GOTO[BL3,J=0];
	P_Q_P-Q, BAMASK[22]; *P_Q_SURPLUS ARGS
	Q_P, 0Q RCY [22], GOTO[BL7,ALU>0]; *REDUCE PP IF SURPLUS
	P_LAC, Q_RTEMP; *P_NARGS PASSED, Q_NARGS EXPECTED
*P_NARGS EXPECTED,,0.  Q_NARGS PASSED.  SKIP IF NARGS EXPECTED IS .LE. PASSED
	P-Q, 0Q RCY [22], Q_LAC;
	GOTO[.+2,ALU>=0];
	L5_Q; *L5_MIN(NARGS PASSED,NARGS EXPECTED)
BL2:	P_PP, SAMASK[22], Q_P OR Q;
BL4:	P_L6_P-Q, Q_NULL; *L6_-NARGS TO BIND,,PTR TO 1ST-1
*SKIP THE BL1 CALL IF NO ARGS TO BIND
	NOT(P)Q RCY [22], Q_L5, DGOTO[BL5,ALU>=0]; *P_NARGS TO BIND-1
	TP_P-Q, CALL[INCSTT]; *TP_NARGS TO BIND-NARGS ON STK-1
STB:	P_INSTR, Q_2 000000S, CALL[BL1];
BL5:	AC_2S;		*NEEDED FOR NO-ARGS CASE
	P_CBS, Q_767777 777777S, CALL[CBSPQ];
	P_LAC, CALL[PPPSHR]; *PUSH FUNCTION NAME
STC:	P_L4, Q_2S, CALL[BRMWPMQ];
	P_P AND Q, Q_PP, WRESTART, CALL[POQL22]; *HRLM PP,-2(CP) OR -4(CP)
	MDR_P OR Q, CLEARF[BIS];
BLXIT:	P_PC, Q_(2 000002R) RSH 1, GOTO[LENTER];

*HERE ON EXACT OR SURPLUS ARGS PASSED WITH -SURPLUS IN P[0,21] AND Q[22,43]
BL7:	P_PP, Q_P OR Q, DGOTO[BL2];
	PP_P-Q, P_Q_RTEMP, SAMASK[22], CALL[POQL22];

*HERE FOR LAMBDA NO-SPREAD FUNCTIONS
BL3:	MDR_(SZERO) U (P), P_PP, Q_(2 000002R) RSH 1, CALL[PPSHR1];
STA:	Q_(2 000002R) RSH 1, P_PP, SAMASK[22], GOTO[BL4];

*CHOOSE "LBIND" OR "BIND" ACCORDING TO ALL-ARGS-ARE-LOCALVARS BIT
BL1:	P AND Q, AC_2S, Q_L6;
	GOTO[BINDA,ALU=0];
*TP/ COUNT OF PUSHES LEFT TO DO-1
	P_TP, SETSF[14S], DGOTO[.];
	P, Q_PP, MDR_SNIL, CALL[.+1];
	TP_P-1, P_Q, Q_(2 000002R) RSH 1, AC_2S, GOTO[PPSHR1,ALU>=0];
BNDRET:	Q_BNDTRP, POP, GOTO[RETN];

RMWHPPQ: MAPVA_P_P+Q, SAMASK[22], GOTO[RMWHARG];

%PDP-10 INSTRUCTION "RETFR" REPLACING FUNCTION RETURN CODE IN LISP.MAC
HAVE [E]=0(CP)=CLINK IN RTEMP, 3 IN AC.
TIMING = M + 6R + 41 + (2R+12)/NAMED VALUE UNBOUND + (R+9)/ANONYMOUS
%
RETFR:	P_CBS, Q_60000 000000S, CALL[ADVSTT];
	LAC_Q, MAPVA_P_CF, ACFS, CALL[RHARG]; *3_0(CP), P_CF, Q_777777
	MAPVA_P_P AND Q, CALL[RHARG]; *P_NARGS,,PP OR 1ST ARG-1
*P_-NARGS-1,,PP OR 1ST ARG-1
	P_P=Q, Q_(2 000002R) RSH 1, GOTO[RETFR5];

*GOSTAT COMES HERE IF INTERRUPTED AFTER THE ABOVE STUFF
ST6:	P_L5, Q_A0, AC_3S, SETSF[3S], GOTO[RETFR5];

RETFR2:	MAPVA_P_AQ, CALL[RHARG]; *READ ARG ON STACK
*RTEMP_OLD VALUE AND P_NAME OR ELSE P_ZEROES IN ALL BITS EXCEPT 200
	MDR_P AND Q, PQ RCY [22], BAMASK[22], Q_200R, SETSF[INTCONDH];
	P AND NOT Q, STEMP_MDR, GOTO[PI,H=1]; *TEST FOR ANONYMOUS
	MAPVA_P, CALL[RMWHARG,ALU#0];
	MDR_(P AND NOT Q) U (STEMP), WRESTART, P_L5, Q_(2 000002R) RSH 1;
RETFR5:	L5_P_P+Q, Q_777777R, SETF[BIS];
	Q_P AND Q, P_LAC, GOTO[RETFR2,ALU<0];
	MAPVA_P, SAMASK[22], CALL[RHARG]; *FETCH 0(3)
	VP_P AND Q, P_(2 000002R) RSH [1], Q_2 000002R;
	P_CP, Q_P+Q;
	MAPVA_OLDPC_P_P-Q, SAMASK[22], CALL[SRARG]; *P_PP OUT OF CALLER
	RTEMP_P, P_LAC, Q_2S, CALL[RMWHPPQ]; *RTEMP[22,43]_PP OUT
	Q_P-Q-1, WRESTART; *DECREMENT USE COUNT IN L.H. OF P
	STEMP_Q, P_PP, Q_RTEMP, AMASK[22], INHINT, GOTO[.+2,ALU<0];
	MDR_STEMP;
	P_Q_P-Q, SAMASK[22], CALL[POQL22]; *Q_PP-PP OUT, P_PP-PP OUT,,0
	Q_P OR Q, P_PP, B_STEMP;
	PP_P-Q, P_OLDPC, DGOTO[REMAPPC,B>=0]; *EXIT TO PC+1 IF USE COUNT#0
	CP_P, CLEARF[BIS&K], DGOTO[POPJTP];
	PC_NPC, P_LAC, AMASK[22], GOTO[.+1]; *PC_ADDRESS OF POPJ CP,
	MAPVA_P_CF, ACFS, Q_P, GOTO[WREFQ];

%NEW OPCODE FOR DISPATCHING TO UUOS.  ACCEPTS ADDRESS OF DISPATCH
TABLE IN E.  DOES A PUSHJ AC,@E+OPCODE (WHERE THE OPCODE IS OBTAINED
FROM LOCATION 40).
TIMING = M+R+15
%
UPSHJ:	RTEMP_P, P_MAPVA_40S, ACFS, CALL[RARG];
	PQ RCY [33], AMASK[11], Q_RTEMP, SETSF[G], GOTO[BINDE];

*NEW OPCODE FOR LOADING THE TYPE OF A POINTER
LDTYPE:	PQ RCY [11], AMASK[11], Q_TYPTAB;
BTLU1:	MAPVA_P_P+Q+1, SAMASK[22], GOTO[RHARG];

*NEW PDP-10 OPCODE FOR BIT TABLE LOOKUP.  HAVE AC IN Q.
*ALWAYS USED AS BTLU 1,--
BTLU:	QQ RCY [11], Q_TYPTAB, AMASK[11], CALL[PQQL22]; *P_BTT, Q_PAGE NUMBER
	MAPVA_P_P+Q, SAMASK[22], CALL[RARG]; *FETCH POINTER TO BIT TABLE FROM "BTT"
	Q_P, QQ RCY [5], BAMASK[4]; *Q_PTR TO BIT TABLE, P_DISPLACEMENT
	MAPVA_P_P+Q, SAMASK[22], CALL[RTOMDR]; *MDR_BIT TABLE WORD, P_LAC
	BAMASK[5], Q_400000 000000S;
	Y_P, P_REFADR, INCAC, CALL[RETN];
	QQ RCY [Y], LAC_P, DECAC; *AC+1_WORD POINTER
	LAC_P, Q_MDR, GOTO[APANDQ];

*ALWAYS GIVEN AS CHASE 1,CHASX
CHASE:	INCAC, P_LAC, RTEMP_P, CALL[LDTYPE];
	LAC_P, Q_100 000000S, DGOTO[RALUZ]; *Q_SYSBIT
	P AND Q, Q_CP, P_RTEMP, AC_17S, DGOTO[PUSHJ];

%REWIND OPCODE FOR REVERSING SHALLOW-DEEP BINDINGS IN A FRAME.
CALLED WITH AN AOBJN POINTER TO THE ARGS OF A FRAME IN AC.
IF AN ARG IS NOT A LOCALVAR THE CONTENTS OF THE VCELL AND THE FRAME
ARE INTERCHANGED.  WHEN ALL ARGS ARE DONE, THE "SWPBIB" BIT IS
COMPLEMENTED.
%
REWIND:	P_LAC, Q_(2 000002R) RSH 1, SETSF[INTCONDH], INCAC; *USE AC+1 AS TEMPORARY
	MAPVA_RTEMP_P+Q, P_-1L, SAMASK[43], GOTO[PI,H=1];
*AC+1_SWPBIB
	LAC_P+1, P_RTEMP, SAMASK[22], GOTO[RMWARG,ALU>=0]; *EXIT?
	DECAC, CALL[RHARG]; *P_FRAME WORD, Q_777777
	Q_RTEMP1_P AND NOT Q, BAMASK[22]; *Q_RTEMP1_NAME, P_VALUE
	MDR_P, QQ RCY [22], BAMASK[22], Q_200R; *P_VCELL PTR
	STEMP_MDR, P AND NOT Q; *STEMP_FRAME VALUE, TEST LOCALVAR
	MAPVA_P, Q_-1L, CALL[RMWHARG,ALU#0]; *CALL IFF NOT LOCALVAR
*VCELL_ORIGINAL L.H.,,FRAME R.H., WRESTART IS NOOP AND ALU=0 IF LOCALVAR
	MDR_(P AND NOT Q) U (STEMP), WRESTART, Q_RTEMP, CALL[RETN];
*HAVE VALUE FOR AC UPDATE IN Q, ALU=0 IFF LOCALVAR
*IF NOT LOCALVAR, HAVE VCELL CONTENTS IN P
	LAC_MAPVA_Q, SAMASK[22], Q_RTEMP1, GOTO[REWIND,ALU=0];
*WRITE ORIGINAL L.H.,VCELL R.H. BACK INTO FRAME.  NOTE THAT IF
*A MEMORY TRAP OCCURS, WRITE WILL BE COMPLETED.
	MDR_P OR Q, WREF, P_LAC, Q_777777R, GOTO[ILLIO,G=1];
	P_(REFADR_P AND Q) U (BLTWLE), GOTO[REWIND,G=0];
	LEFADR_P, Q_WMQ, CALL[LOADMAP];
	WREF, GOTO[REWIND]; *ANOTHER MAP FAULT IMPOSSIBLE


%PDP-10 INSTRUCTION FOR RETURN TO BLISP FUNCTION EQUIVALENT TO
MOVE AC,E; MOVE PC,E+1; SUB CP,[2,,2]
ALWAYS USED AS BFRET CBS,-1(CP)
HAVE [E] IN P, LAC IN Q AT ENTRY
I = 7
TIMING = M+2R+18
%
BFRET:	LAC_P, P_REFADR;
	MAPVA_P_P+1, SAMASK[22], CALL[RHARG];
	MDR_P, P_CP, Q_2 000002R, SETF[MD2];
	CP_P-Q, SAMASK[0], Q_MDR, GOTO[LENTER];


%PDP-10 INSTRUCTION FOR LISP FUNCTION CALL EQUIVALENT TO
	MOVEI AC,1(CP); EXCH AC,CF; HRLM CP,3(AC)
	PUSH CP,VP; PUSH CP,AC; PUSH CP,AC; XCT E
ALWAYS USED AS CALLFN 3,0(CP)
HAVE E IN RTEMP HERE (LEFT BY GOSTAT)
I = 10 HERE + "PDPCPP" ROUTINE EARLIER
TIMING = M+2R+44
%
CALLFN:	MAPVA_P_CF, ACFS, CALL[RMWHARG];
	LAC_P, WRESTART, SETF[BIS];
	P_CP, BAMASK[22], Q_20000 000000S, INHINT;
	MDR_P+1, P_CBS, CALL[ADVSTT]; *SET STATE=2
ST2:	P_LAC, Q_3S, CALL[RMWHPPQ]; *HRLM CP,3(AC)
	P_P AND Q, Q_CP, WRESTART, CALL[POQL22];
	MDR_P OR Q, P_VP, SETF[K], CALL[PDPCPP]; *PUSH CP,VP
ST3:	P_LAC, SETF[K], CALL[PDPCPP]; *PUSH CP,AC
ST4:	P_LAC, SETF[K], CALL[PDPCPP]; *PUSH CP,AC
ST5:	P_RTEMP, AC_NULL, SETSF[K];
	MAPVA_P, GOTO[XCT]; *XCT E

*B4TAB DEFINED IN PISYS

*ST DISPATCH TABLE
TARGET[XSLC];
SM[XSLC,415]; E1[ST0], E2[ST1], E3[SCRASH];
SM[XSLC,435]; E1[ST2], E2[ST3], E3[SCRASH];
SM[XSLC,455]; E1[ST4], E2[ST5], E3[SCRASH];
SM[XSLC,475]; E1[ST6], E2[ST7], E3[BINDR];
SM[XSLC,515]; E1[ST8], E2[ST9], E3[SCRASH];
SM[XSLC,535]; E1[STA], E2[STB], E3[SCRASH];
SM[XSLC,555]; E1[STC], E2[MILLEG], E3[SCRASH];
SM[XSLC,575]; E1[MILLEG], E2[MILLEG], E3[SCRASH];

*NOTE:  DIS DOES GNBYT, DI DOES NOT BEFORE TRIPLE DISPATCH
*PDP-10 OPCODES
DIS[107,BL,BL6,SCRASH];	*PDP-10 INSTRUCTION BLISP
DM[DLC,110]; REPEAT[4,DLC[E1[UUOM] E2[60] E3[4061]]]; *ILLEGAL INSTS.
DI[114,RARG,GOSTAT,RETFR];	*RETFR (ALWAYS USED AS RETFR 3,0(CP))
DI[115,UPSHJ,PUSHJ,SCRASH];	*UPSHJ
DI[116,LDTYPE,PAQA,SCRASH];	*LDT
DI[117,BTLU,ESKIP,SCRASH];	*BTLU
DI[120,RARG,BFRET,SCRASH];	*BFRET
DI[121,GOSTAT,CALLFN,SCRASH];	*CALLFN
DM[DLC,122]; REPEAT[6,DLC[E1[UUOM] E2[60] E3[4061]]]; *ILLEGAL INSTS.
DI[247,CHASE,REMAPPC,SCRASH];	*CHASE
DI[257,REWIND,PXQM,SCRASH];	*REWIND