ER[LISPM1];

*I = ?

%(1)  SEE <MAXC>BLISP.EARS FOR METAPROGRAMS AND OTHER DESCRIPTION

(2)  PDP-10 INTERPRETER MEMORY REFERENCE SUBROUTINES CANNOT BE USED
FROM BYTE LISP BECAUSE THE PC IS ADVANCED BEFORE EXECUTION BY
THE PDP-10, AFTERWARDS BY BYTE LISP.

(3)  TRAP INSTRUCTIONS FOR BYTE LISP OPERATIONS CAN ONLY BE JUMPA'S
BECAUSE PUSHJ'S, JSR'S, OR JSYS'S MIGHT SUFFER A PAGE REFERENCE FAULT
AND LOSE THE TWO EXTRA BITS OF PC NEEDED TO REMEMBER THE BYTE POSITION.
HENCE, PC AND FLAGS FOR TRAP ARE LEFT IN 7.

(4)  THE DIAGNOSTIC FOR CHECKING OUT THIS MICROCODE IS
<DIAGNOSTICS>BLDGA.SAV, WHICH RUNS IN EITHER USER OR MONITOR MODE.

THE MAIN LOOP HAS FOUR ENTRIES: "GNBYT" RETURNS THE NEXT BYTE IN P AND
ORIGINAL VALUE OF P IN Q, LEAVING K=0, J UNCHANGED;
"XCTBYT" EXECUTES THE NEXT BYTE; JUMPS FINISH AT "JMP0" WITH DISPLACEMENT
RELATIVE TO "PC" IN P-Q; JRSTF'S FROM PDP-10 MODE GOTO "LENTER".

AT EXIT FROM THE MAIN LOOP:
   AC/ 1
   X/ 11
   G=H=J=0 FOR ONE-BYTE INSTRUCTIONS, G=H=GARBAGE FOR MULTI-BYTE
   K=BIS
OPCODES 0-77: P/ 4 LOW BITS OF OPCODE, Q/ VP
OPCODES 100-177: P/ 4 LOW BITS OF OPCODE, Q/CBS
OPCODES 200-277: P/ 0,,PP-4 LOW OPCODE BITS-1, Q/ AC1
CONST (300-377): P/ 6 LOW OPCODE BITS, Q/ CBS
FNn (400-477): P/ 4 LOW BITS OF OPCODE, Q/ NEXT 4 BITS OF OPCODE
JMP (OPCODES 500-577): P/ 6 LOW BITS OF OPCODE, Q/ 20
EVEN OPCODES 600-676 TRAP AT LOCATIONS 200-237
ODD OPCODES 601-677 AND OPCODES 701-776 AS FOLLOWS:
TWO-BYTE OPCODES: P/ NEXTBYTE, Q/ AC1
SINGLE-BYTE OPCODES: P/ AC1, Q/ AC1
UNDEFINED ODD OPCODES 601-677 TRAP TO MONITOR 41 WITH OPCODE IN 40[0,10] AND
ADDRESS OF LAST MEMORY REFERENCE IN 40[22,43].

THE WORD CONTAINING THE INSTRUCTION BEING EXECUTED IS KEPT IN
"INSTR".  "PC" ALWAYS POINTS AT THE FIRST BYTE OF THE CURRENT
INSTRUCTION.  "WPC" ALWAYS POINTS AT THE LAST BYTE FETCHED BY
"GNBYT" OR "XCTBYT" AND HAS STATE INFORMATION IN THE L.H. TO
CONTROL THE SEQUENCING OF THE MAIN LOOP THROUGH THE FOUR BYTES
IN THE WORD.

TIMING FOR "GNBYT" = 3 + (4 + R IF BYTE 0)
TIMING FOR "XCTBYT" = 8 + (2 + R IF BYTE 0)
	+ (4 FOR OPCODES 0-277) + (2 FOR OPCODES 300-477)
	+ (5 FOR ODD OPCODES 601-677)
TIMING FOR "JMP" = 13 + R + 1 IF BACKWARDS

INTERRUPTED INSTRUCTIONS WHICH CANNOT BE RESTARTED FROM THE BEGINNING
SET THE "BIS" FLAG, LEAVE A CODE FOR THEIR PRESENT STATE IN THE "CBS"
ACCUMULATOR, AND CALL THE "GOSTAT" ROUTINE NEAR THE BEGINNING OF THEIR
EXECUTION.  "GOSTAT" DISPATCHES THROUGH THE "BSTDSP" TABLE IF "BIS" IS
SET.  EXECUTION MAY BE INTERRUPTED BY A PAGE FAULT ON ANY MEMORY REFERENCE
OR BY A PUSHDOWN OVERFLOW ON ANY PUSH OPERATION.  CONSEQUENTLY, WHEN
ANY MEMORY REFERENCE OCCURS, THE STATE OF THE INSTRUCTION MUST BE
CONTAINED IN THE ACCUMULATORS.

DURING EXECUTION, REGISTERS ARE USED AS FOLLOWS:
   CP/ CONTROL PUSH-DOWN STACK POINTER
   PP/ PARAMETER PUSH-DOWN STACK POINTER
   BR/ JUNK FOR SWAPPED CALLS (NOT TOUCHED BY MICROCODE)
   VP/ POINTS AT FIRST ARG OF CURRENT FRAME-1
   CBS[22,43]/ ADDRESS OF ZEROTH CONSTANT IN POINTER AREA
   CBS[0]/ 0 IF ZEROTH CONSTANT IS IN LEFT HALF-WORD ELSE 1
   CBS[1,5]/ "STATE" OF INSTRUCTION IF F[BIS]=1
   CBS[6,11]/ "DEPTH" OF PROG/LAMBDA NESTING IN CURRENT FUNCTION
   CBSP/ USED AS DISPLACEMENT RELATIVE TO CBS WHEN GETTING POINTERS
   1/ DUPLICATES 0(PP) IF AT LEAST ONE ITEM HAS BEEN PUSHED IN THE CURRENT FRAME
%

TARGET[ILC];

GNB0:	P_Q;
	MAPVA_P_P+1, SAMASK[22], CALL[BXMEM];
	WPC_Q, CALL[PMDR];
	INSTR_P, BAMASK[11], PQ RCY [33], X_11S, Q_LTEMP, RETURN;

GNBYT:	P_XSPLIT_WPC, LTEMP_P, Q_10772 777777R;
	Q_P-Q-1, P_INSTR, X_11S, GOTO[GNB0,G=0];
	WPC_Q, PQ RCY [Y], Q_LTEMP, XMASK, RETURN;

XCTB2:	P_Q, BAMASK[22], Q_1S, ICTR_P+1;
*ENTER HERE FROM JRSTF TO MACHINE 1 WITH NEW PC IN P+Q
LENTER:	P_MAPVA_P+Q, Q_3 777777L, SETF[MD2];
LENTM:	XREF, Q_P AND Q, P_777777S, GOTO[MILLEG,G=1];
*POSITION PC[20,21] IN LOW BITS OF OPCODE FIELD FOR XSPLIT_
	PC_Q, Q_NOT P AND Q, P_Q, BAMASK[22];
	Q_(REFADR_P) U (XNLE), PQ RCY [33], GOTO[.+3,G=0];
	LEFADR_Q, Q_XMQ, CALL[LOADMAP];
	P_PC, Q_3 777777L, GOTO[LENTM];
*AC_1, X_11, Y_ADDRESS OF WPCT + PC[20,21]
	XSPLIT_(@WPCT) U (P), Q_REFADR;
*Y_SHIFT COUNT FOR BYTE, P_OLD WPC VALUE
	P_FSPLIT_(Q) U (SY), Q_10772 777777R;
	Q_P-Q-1, P_MDR, SETSF[INTCONDH];
	PQ RCY [Y], XMASK, INSTR_P, Q_700L, WPC_Q, CALL[BPI,H=1];
SPBYTE:	Y_(P-Q-1) U (Q), SETSF[BIS&K];
*KNOW 2P HAS ALU VALUE=3, BLDISP IS AT 677
	NPC_STACK_D, PQ RCY [6], AMASK[3], ROPCD_2P, GOTO[DECBYT,ALU<0];
	RTEMP_A1, P_Q_LAC, SETSF[7S], CALL[GNBYT,B>=0];

OPXDIS:	Y_P+Q, Q_(ROPCD) RSH 1, DGOTO[.-1];
	NPC_STACK_SY, GOTO[FCALLX,Q EVEN];

*WRITE LAC AT P+Q+1 AND EXIT
BWPPQ1X: MAPVA_P_P+Q+1, SAMASK[22], Q_LAC;
BWRQX:	WREF, MDR_Q, SETSF[J], REFADR_P, GOTO[MILLEG,G=1];
BWRQXX:	Q_(P) U (WLE), GOTO[BWRX1,G=1];
XCTBYT:	P_XSPLIT_WPC, Q_10772 777777R;
XCTB1:	Q_P-Q-1, P_ICTR, CLEARF[BIS&K], X_BIS&K, GOTO[XCTB2,G=0];
	WPC_Q, INCX, ICTR_P+1, P_3 777777L;
	Q_P AND Q, P_INSTR, SETSF[INTCONDH], DGOTO[SPBYTE];
	PC_Q, PQ RCY [Y], XMASK, Q_700L, CALL[BPI,H=1];

XCTBL:	LAC_P AND Q, P_XSPLIT_WPC, Q_10772 777777R, GOTO[XCTB1];

*HAVE BYTE BEING INTERPRETED IN Q
BLDSP:	NPC_STACK_SY;
	RTEMP_A1, SETSF[7S], CALL[GNBYT,B>=0];

XBLDSP:	NPC_STACK_SY, P_NOT P, Q_PP;
	MAPVA_P_P+Q, SAMASK[22], Q_LAC;

*HERE FOR OPCODES 0-700 WITH DGOTO PENDING.
*HAVE 11 IN X, 1 IN AC, 2*OPCODE IN ROPCD, LEFT 3 BITS OF OPCODE IN P.
DECBYT:	B_(3730S) U (P), P_(ROPCD) RSH [1], NPC_B, GOTO[.+1];
	PQ RCY [4], AMASK[4], SETSF[7S], Q_677R, DGOTO[COPY1];

E[3730]; *JRST IS AT 3740

*MUST BE BOUNDARY OF 8.  HAVE 3 OPCODE BITS IN P, ADDRESS OF BLDISP IN Q
	Y_P+Q, P_(ROPCD) RSH [1], SAMASK[4], Q_VP, GOTO[BLDSP]; *IVAR, LFNX, SETI, DSETI
	Y_P+Q, P_(ROPCD) RSH [1], SAMASK[4], Q_CBS, GOTO[BLDSP]; *SVAR, SSET, SDSET, FNX
	Y_P+Q, P_(ROPCD) RSH [1], SAMASK[4], GOTO[XBLDSP]; *XVAR, XSET, XDSET, LCALL (200-277)
	P_(ROPCD) RSH [1], AMASK[6], Q_CBS, CALL[GETCON]; *CONST (300-377)
	Q_P, P_(ROPCD) RSH [1], SAMASK[4], GOTO[FNOPC]; *FN0, FN1, FN2, FN3
	P_(ROPCD) RSH [1], AMASK[6], Q_777777 777760S, GOTO[JMP]; *JMP (500-577)
*EVEN OPCODES 600-677 TRAP, ODD DISPATCH
	P_(ROPCD) RSH [2], AMASK[5], Q_@BOPXT, GOTO[OPXDIS];
MILEG1:	INSTR_P, P_Q, STACK_D, GOTO[UUOM];

TARGET[ILC];

*RETURN NEXT PC IN P, NOT FLAGS IN Q. P_ISPLIT_WPC, Q_10772 777777R AT CALL.
ADVPC:	P_P-Q-1, BAMASK[24], Q_(NOT F) U (NOTFLAGS&BIS), RETURN[G=1];
	P_P+1, BAMASK[22], RETURN;

*FCALLX ADVANCES PC BEFORE TRAP.  HAVE TRAP DISPLACEMENT IN P.
FCALLX:	RTEMP_P, SETF[MD2&G], GOTO[.+1];
	P_ISPLIT_WPC, Q_10772 777777R, CALL[ADVPC];
	CBSP_P OR NOT Q, P_RTEMP, BAMASK[7], Q_200S; *SIMULATE JSP 7,ADDR
	MAPVA_P_P+Q, Q_1R, CLEARF[BIS&MD0&MD1&MD2&J], GOTO[REMAP1];

*FCALLY DOES NOT ADVANCE PC BEFORE TRAP
FCALLY:	RTEMP_P, P_PC, DGOTO[.-2];
	SETF[MD2&G], Q_A1, CALL[ADVPC];

COPY1:	P_LAC_P AND Q, GOTO[PPPUSH];


*DISPATCH TABLE FOR OPCODES 0-277
*SIGNIFICANT OPCODE BITS IN P, 0 IN LTEMP, G=H=J=0

*FIRST FOUR HAVE VP IN Q
SI[BLDISP,0,IVAR,COPY1,SCRASH];		*LVAR
SIS[BLDISP,1,GOSTAT,LFNX,SCRASH];	*LFNX
SI[BLDISP,2,BWPPQ1X,SCRASH,SCRASH];	*LSET
SI[BLDISP,3,BWPPQ1R,PPOP,SCRASH];	*LDSET

*NEXT FOUR HAVE CBS IN Q
SI[BLDISP,4,GETCON,IVAR,COPY1];		*SVAR
SI[BLDISP,5,GETCON,SETR,XCTBYT];	*SSET
SI[BLDISP,6,GETCON,SETR,PPOP1];		*SDSET
SIS[BLDISP,7,GOSTAT,FNX,SCRASH];	*FNX

*NEXT FOUR HAVE PP IN Q, MAPVA_P_(NOT 4 OPCODE BITS)+PP+1, SAMASK[22], Q_LAC
*HAS BEEN DONE
SI[BLDISP,10,BRMEM,COPY1,XCTBYT];	*XVAR
SI[BLDISP,11,BWRQX,SCRASH,SCRASH];	*XSET
SI[BLDISP,12,BWRQR,PPOP,SCRASH];	*XDSET
SI[BLDISP,13,LCALL,SCRASH,SCRASH];	*LCALL


*DISPATCH TABLE FOR ODD OPCODES 600-677 (EVEN OPCODES TRAP)
*DISPATCH WITH -1 IN RTEMP, AC1 IN P AND IN Q
SIS[BLOPXT,0,GTCON,IVAR,COPY1];		*SVARX
SIS[BLOPXT,1,LVARX,IVAR,COPY1];		*LVARX
SIS[BLOPXT,2,XVARX,IVAR,COPY1];		*XVARX
SIS[BLOPXT,3,ARGX,ARGX1,CAR];		*ARG
SIS[BLOPXT,4,GTCON,COPY1,SCRASH];	*CONSTX
SIS[BLOPXT,5,GTCON,SETR,PPOP1];		*SDSETX
SIS[BLOPXT,6,GTCON,SETR,XCTBYT];	*SSETX
SIS[BLOPXT,7,LVARX,BWPPQ1R,PPOP];	*LDSETX
SIS[BLOPXT,10,LVARX,BWPPQ1X,SCRASH];	*LSETX
SIS[BLOPXT,11,XVARX,BWPPQ1R,PPOP];	*XDSETX
SIS[BLOPXT,12,XVARX,BWPPQ1X,SCRASH];	*XSETX
SIS[BLOPXT,13,GNBYT,JUMPXX,SCRASH];	*JUMPXX
SI[BLOPXT,14,GETP,GETL1,GETL2];		*GETLIST
SI[BLOPXT,15,BRMEM1,ASSOC,SCRASH];	*ASSOC
SI[BLOPXT,16,UNBSP,IMUL,IREMN];		*ITIMES2
SI[BLOPXT,17,UNBSP,BIDIV,IQUOT];	*IQUOT
SI[BLOPXT,20,UNBSP,BIDIV,IREMN];	*IREMN
SI[BLOPXT,21,UNBOX,UNBOX1,IOR2];	*IOR2
SI[BLOPXT,22,UNBOX,UNBOX1,IXOR2];	*IXOR2
SI[BLOPXT,23,UNBSP,BLLSH,IREMN];	*BLSH
SI[BLOPXT,24,UNBSP,BLASH,IREMN];	*BASH
SI[BLOPXT,25,LDT,QZERO,IBOX1];		*NTYP
*SI[BLOPXT,?,LENGTH,IBOX0,SCRASH];	*LENGTH (DEIMPLEMENTED--NO SPACE)
*SI[BLOPXT,?,ZEROT,JCOND1,JNEQT];	*JNZERO
*SI[BLOPXT,?,ZEROT,JCOND1,JEQT];	*JZERO
REPEAT[12,XSLC[E1[UUOM] E2[60] E3[4061]]];

*NOTE:  DIS DOES GNBYT, DI DOES NOT BEFORE TRIPLE DISPATCH
*BYTE-LISP OPCODES (DUE TO KLUDGE AT "SPBYTE" USER OPCODE N MAPS INTO N+1 HERE)
DI[701,PSSTK,3777,SCRASH];	*MINONE (USER OPCODE 702)
DI[702,PSSTK,4000,SCRASH];	*ZERO
DI[703,PSSTK,4001,SCRASH];	*ONE
DI[704,PSSTK,4002,SCRASH];	*TWO
DIS[705,SIC,3400,SCRASH];	*SIC
DI[706,PSNIL,PPPSHX,SCRASH];	*NIL
DI[707,PST,PPPSHX,SCRASH];	*T
DI[710,PPPUSH,SCRASH,SCRASH];	*COPY
DI[711,PPOP,SCRASH,SCRASH];	*POP
*712 IS PDP-10 I/O
DI[713,PPOP2,PPOP1,SCRASH]	*POP2
DI[714,PPOP3,PPOP1,SCRASH];	*POP3
DI[715,UNBOX,FIXSP,SCRASH];	*VAG
DI[716,UNBOX,UNBOX1,IPLUS2];	*IPLUS2
DI[717,UNBOX,UNBOX1,IDIF2];	*IDIF
DI[720,UNBOX,UNBOX1,IAND2];	*IAND2
DI[721,UNBOX,QF1,IPLUS1];	*ADD1
DI[722,UNBOX,IPLUS1,SCRASH];	*SUB1
DM[DLC,723]; DLC[E1[UUOM] E2[60] E3[4061]]; *UNDEFINED
DIS[724,GNBYT,BIND,BRET2];	*DBIND
DIS[725,GNBYT,BIND,BRET1];	*BIND
DI[726,ZEROP,UNBIND,FCALLX];	*UNBIND
DI[727,BRETRN,FCALLX,SCRASH];	*RETURN
DIS[730,BRETRN,XRETRN,SCRASH];	*XRETURN
DIS[731,QNIL,JCOND1,JEQT];	*JUMP IF 0(PP) = NIL
DIS[732,QNIL,JCOND1,JNEQT];	*JUMP IF 0(PP) # NIL
DIS[733,BRMEM1,TEQ,JNEQT];	*JUMP IF 0(PP) # -1(PP)
DIS[734,BRMEM1,TEQ,JEQT];	*JUMP IF 0(PP) = -1(PP)
DIS[735,TATTYP,14,JNEQT];	*JUMP IF 0(PP) IS NOT AN ATOM
DIS[736,TATTYP,14,JEQT];	*JUMP IF 0(PP) IS AN ATOM
DIS[737,TTLIST,JNEQT,SCRASH];	*JUMP IF 0(PP) IS NOT A LIST
DIS[740,TTLIST,JEQT,SCRASH];	*JUMP IF 0(PP) IS A LIST
DIS[741,TATTYP,FLOATT,JNEQT];	*JNNUM
DIS[742,TATTYP,FLOATT,JEQT];	*JNUM (TYPE .E. FLOATT TO SMALLT)
DIS[743,TATTYP,22,JNEQT];	*JNFIXP
DIS[744,TATTYP,22,JEQT];	*JFIXP (TYPE .E. FIXT TO SMALLT)
DIS[745,GNBYT,TTYPE,JNEQT];	*JUMP IF 0(PP) IS NOT OF TYPE = NEXTBYTE
DIS[746,GNBYT,TTYPE,JEQT];	*JUMP IF 0(PP) IS OF TYPE = NEXTBYTE
DIS[747,UNBSP,TEH,JNEQT];	*JUMP IF -1(PP) .NE. 0(PP)
DIS[750,UNBSP,TEH,JEQT];	*JUMP IF -1(PP) .E. 0(PP)
DIS[751,UNBSP,TE,TGE];		*JUMP IF -1(PP) .GE. 0(PP)
DIS[752,UNBSP,TE,TL];		*JUMP IF -1(PP) .L. 0(PP)
DIS[753,UNBSP,TE,TG];		*JUMP IF -1(PP) .G. 0(PP)
DIS[754,UNBSP,TE,TLE];		*JUMP IF -1(PP) .LE. 0(PP)
DIS[755,JUMPX,JMP,SCRASH];	*JUMPX
DI[756,BRMWPP,SWAP,SCRASH];	*SWAP
DI[757,LAST,LAST1,SCRASH];	*LAST
DI[760,BRMEM1,BFETCH,SCRASH];	*FETCHFIELD
DI[761,BRMEM2,BRMEM1,STORE];	*REPLACEFIELD
DI[762,BRMEM1,SETL,RPL];	*FRPLACD
DI[763,BRMEM1,SETR,RPL];	*FRPLACA
DI[764,RPLSUP,SETL,RPL];	*RPLACD
DI[765,RPLSUP,SETR,RPL];	*RPLACA
DI[766,GETP,GETP1,GETP2];	*GETP
DI[767,READP,CDRP,CDR];		*CDDR
DI[770,READP,IVAR,CDR];		*CDAR
DI[771,READP,CDRP,CAR];		*CADR
DI[772,READP,IVAR,CAR];		*CAAR
DI[773,READP,CDR,SCRASH];	*CDR
DI[774,READP,CAR,SCRASH];	*CAR
DI[775,BRMEM1,FMEMB,SCRASH];	*FMEMB (USER OPCODE 776)

SET[LASTOK,3730];