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