ER[LISPM2];

*I = 468

%(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
EVEN OPCODES 600-676 TRAP AT LOCATIONS 200-237
ODD OPCODES 601-677 AND OPCODES 0-577 AND 701-777 AS FOLLOWS:
MULTI-BYTE OPCODES: P/ NEXTBYTE, Q/ AC1
SINGLE-BYTE OPCODES: P/ AC1, Q/ AC1
UNDEFINED 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.  "BPC" ALWAYS POINTS AT THE LAST BYTE FETCHED BY
"GNBYT" OR "XCTBYT".

TIMING FOR "GNBYT" = 2 + (4 + R IF BYTE 0)
TIMING FOR "XCTBYT" = 5 + (3 + R IF BYTE 0)
TIMING FOR "JMP" = 12 + 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];

GNBNEW:	MAPVA←P←BPC, AQ, SAMASK[22], CALL[BXMEM];
	P←MDR;
	INSTR←P, BAMASK[11], PQ RCY [33], X←11S, Q←LTEMP, RETURN;

GNBYT:	P←INSTR, Q←XSPLIT←BPC, LTEMP←P, GOTO[GNBNEW,NEWWORD];
	PQ RCY [Y], AMASK[11], Q←LTEMP, X←11S, RETURN;

XBPI:	SETSF[NOVA&H];
	P←NOTFCOND, CALL[PIX];
	Q←PC, P←LTEMP, GOTO[SPBYTE];

*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:	Q←XSPLIT←BPC, CLEARF[BIS&K], P←INSTR, GOTO[XCTB1,NEWWORD];
XCTB2:	RTEMP←A1, Q←BPC, PQ RCY [Y], BAMASK[11], SETSF[INTCONDH];
SPBYTE:	LTEMP←Y←P, P←ICTR, SETSF[7S], GOTO[XBPI,H=1];
	ICTR←P+1, NPC←STACK←D1, P←LTEMP, GOTO[.+2,Y<0];
	PC←Q, AMASK[4], Q←VP, CALL[GNBYT,B>=0];
	P←Q←LAC, PC←Q, AX[11], CALL[GNBYT,B>=0];

XCTBL:	LAC←P AND Q, Q←XSPLIT←BPC, CLEARF[BIS&K], P←INSTR, GOTO[XCTB2,OLDWORD];
XCTB1:	MAPVA←P←BPC, AQ, Q←3 777777L, GOTO[.+2];
*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←BPC←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);
*Y←SHIFT COUNT FOR BYTE
	FSPLIT←SY, RTEMP←A1;
	P←MDR, SETSF[BIS&K], DGOTO[SPBYTE];
	PQ RCY [Y], XMASK, INSTR←P, SETSF[INTCONDH], Q←BPC;

MILEG1:	INSTR←P, P←Q, STACK←D, GOTO[UUOM];

CONSTD:	P←STACK, Q←CBS;
	Q LCY 1, CBSP←P, SETSF[INTCONDH], CALL[GETC2];
COPY1:	P←LAC←P AND Q, GOTO[PPPUSH];

JMPD:	P←LTEMP, AMASK[6], Q←777777 777760S, GOTO[JMP];

XVARD:	P←NOT P, Q←PP;
	MAPVA←P←P+Q, SAMASK[22], Q←LAC, RETURN;

FN0:	Q←NULL, P←LTEMP, AMASK[4], RETURN;
FN1:	Q←1S, P←LTEMP, AMASK[4], RETURN;
FN2:	Q←2S, P←LTEMP, AMASK[4], RETURN;
FN3:	Q←3S, P←LTEMP, AMASK[4], RETURN;

UNDEFX:	P←(LTEMP) RSH [1], AMASK[5];
*MUST FORCE BIS=0 TO PREVENT ANOMALIES
*HAVE TRAP DISPLACEMENT IN TABLE STARTING AT 200 IN P AT CALL
FCALLX:	XSPLIT←BPC, GOTO[.+1];	*ENTER HERE TO ADVANCE PC
	Q←BPC, CLEARF[BIS], GOTO[.+1];
	Q←(TENF) U (Q);
	CBSP←Q, Q←200S, BAMASK[7];	*SIMULATE JSP 7,ADDR
	MAPVA←P←P+Q, Q←1R, CLEARF[BIS&MD0&MD1&MD2&J], GOTO[REMAP1];

FCALLY:	Q←PC, DGOTO[.-3];	*ENTER HERE TO NOT ADVANCE PC
	CLEARF[BIS];

*FILL IN TABLES IN SM USED BY MAXC1 BUT UNUSED ON MAXC2

SM[XSLC,IP[BLDISP]];
REPEAT[14,XSLC[E1[SCRASH] E2[SCRASH] E3[SCRASH]]];
SM[XSLC,IP[BLOPXT]];
REPEAT[37,XSLC[E1[SCRASH] E2[SCRASH] E3[SCRASH]]];

*FILL IN UNUSED PDP-10 OPCODES

DM[DLC,701];
REPEAT[11,DLC[E1[UUOM] E2[60] E3[4061]]];
DM[DLC,713];
REPEAT[63,DLC[E1[UUOM] E2[60] E3[4061]]];


DM1[D1LC,0];
REPEAT[20,D1LC[E1[IVAR] E2[COPY1] E3[ADD[4000,IP[SCRASH]]]]]; *LVAR
REPEAT[20,D1LC[E1[GOSTAT] E2[LFNX] E3[SCRASH]]]; *LFNX
REPEAT[20,D1LC[E1[BWPPQ1X] E2[SCRASH] E3[ADD[4000,IP[SCRASH]]]]]; *LSET
REPEAT[20,D1LC[E1[BWPPQ1R] E2[PPOP] E3[ADD[4000,IP[SCRASH]]]]]; *LDSET

REPEAT[20,D1LC[E1[GTCON] E2[IVAR] E3[ADD[4000,IP[COPY1]]]]]; *SVAR
REPEAT[20,D1LC[E1[GTCON] E2[SETR] E3[ADD[4000,IP[XCTBYT]]]]]; *SSET
REPEAT[20,D1LC[E1[GTCON] E2[SETR] E3[ADD[4000,IP[PPOP1]]]]]; *SDSET
REPEAT[20,D1LC[E1[GNBYT] E2[GOSTAT] E3[ADD[4000,IP[FNX]]]]]; *FNX

REPEAT[20,D1LC[E1[XVARD] E2[BRMEM] E3[ADD[4000,IP[COPY1]]]]]; *XVAR
REPEAT[20,D1LC[E1[XVARD] E2[BWRQX] E3[ADD[4000,IP[SCRASH]]]]]; *XSET
REPEAT[20,D1LC[E1[XVARD] E2[BWRQR] E3[ADD[4000,IP[PPOP]]]]]; *XDSET
REPEAT[20,D1LC[E1[GNBYT] E2[LCALL] E3[ADD[4000,IP[SCRASH]]]]]; *LCALL

SET[XZOT,0];
REPEAT[100,D1LC[E1[CONSTD] E2[XZOT] E3[ADD[4000,IP[SCRASH]]]]
	SET[XZOT,ADD[XZOT,1]]]; *CONST

REPEAT[20,D1LC[E1[FN0] E2[GOSTAT] E3[ADD[4000,IP[FNX]]]]]; *FN0
REPEAT[20,D1LC[E1[FN1] E2[GOSTAT] E3[ADD[4000,IP[FNX]]]]]; *FN1
REPEAT[20,D1LC[E1[FN2] E2[GOSTAT] E3[ADD[4000,IP[FNX]]]]]; *FN2
REPEAT[20,D1LC[E1[FN3] E2[GOSTAT] E3[ADD[4000,IP[FNX]]]]]; *FN3

REPEAT[100,D1LC[E1[JMPD] E2[SCRASH] E3[ADD[4000,IP[SCRASH]]]]]; *JMP

*DISPATCH WITH -1 IN RTEMP, AC1 IN P AND IN Q
DI1[600,UNDEFX,FCALLX,SCRASH];
DI1S[601,GTCON,IVAR,COPY1];	*SVARX
DI1[602,UNDEFX,FCALLX,SCRASH];
DI1S[603,LVARX,IVAR,COPY1];	*LVARX
DI1[604,UNDEFX,FCALLX,SCRASH];
DI1S[605,XVARX,IVAR,COPY1];	*XVARX
DI1[606,UNDEFX,FCALLX,SCRASH];
DI1S[607,ARGX,ARGX1,CAR];	*ARG
DI1[610,UNDEFX,FCALLX,SCRASH];
DI1S[611,GTCON,COPY1,SCRASH];	*CONSTX
DI1[612,UNDEFX,FCALLX,SCRASH];
DI1S[613,GTCON,SETR,PPOP1];	*SDSETX
DI1[614,UNDEFX,FCALLX,SCRASH];
DI1S[615,GTCON,SETR,XCTBYT];	*SSETX
DI1[616,UNDEFX,FCALLX,SCRASH];
DI1S[617,LVARX,BWPPQ1R,PPOP];	*LDSETX
DI1[620,UNDEFX,FCALLX,SCRASH];
DI1S[621,LVARX,BWPPQ1X,SCRASH];	*LSETX
DI1[622,UNDEFX,FCALLX,SCRASH];
DI1S[623,XVARX,BWPPQ1R,PPOP];	*XDSETX
DI1[624,UNDEFX,FCALLX,SCRASH];
DI1S[625,XVARX,BWPPQ1X,SCRASH];	*XSETX
DI1[626,UNDEFX,FCALLX,SCRASH];
DI1S[627,GNBYT,JUMPXX,SCRASH];	*JUMPXX
DI1[630,UNDEFX,FCALLX,SCRASH];
DI1[631,GETP,GETL1,GETL2];	*GETLIST
DI1[632,UNDEFX,FCALLX,SCRASH];
DI1[633,BRMEM1,ASSOC,SCRASH];	*ASSOC
DI1[634,UNDEFX,FCALLX,SCRASH];
DI1[635,UNBSP,IMUL,IREMN];	*ITIMES2
DI1[636,UNDEFX,FCALLX,SCRASH];
DI1[637,UNBSP,BIDIV,IQUOT];	*IQUOT
DI1[640,UNDEFX,FCALLX,SCRASH];
DI1[641,UNBSP,BIDIV,IREMN];	*IREMN
DI1[642,UNDEFX,FCALLX,SCRASH];
DI1[643,UNBOX,UNBOX1,IOR2];	*IOR2
DI1[644,UNDEFX,FCALLX,SCRASH];
DI1[645,UNBOX,UNBOX1,IXOR2];	*IXOR2
DI1[646,UNDEFX,FCALLX,SCRASH];
DI1[647,UNBSP,BLLSH,IREMN];	*BLSH
DI1[650,UNDEFX,FCALLX,SCRASH];
DI1[651,UNBSP,BLASH,IREMN];	*BASH
DI1[652,UNDEFX,FCALLX,SCRASH];
DI1[653,LDT,QZERO,IBOX1];	*NTYP
*DI1[?,LENGTH,IBOX0,SCRASH];	*LENGTH (DEIMPLEMENTED--NO SPACE)
*DI1[?,ZEROT,JCOND1,JNEQT];	*JNZERO
*DI1[?,ZEROT,JCOND1,JEQT];	*JZERO
DI1[654,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,655]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[656,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,657]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[660,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,661]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[662,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,663]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[664,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,665]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[666,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,667]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[670,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,671]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[672,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,673]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[674,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,675]; D1LC[E1[UUOM] E2[60] E3[4061]];
DI1[676,UNDEFX,FCALLX,SCRASH];
DM1[D1LC,677]; D1LC[E1[UUOM] E2[60] E3[4061]];

*NOTE:  DI1S DOES GNBYT, DI1 DOES NOT BEFORE TRIPLE DI1SPATCH

DM1[D1LC,700]; D1LC[E1[UUOM] E2[60] E3[4061]]; *UNDEFINED (I/O ON MAXC1)
DM1[D1LC,701]; D1LC[E1[UUOM] E2[60] E3[4061]]; *UNDEFINED (I/O ON MAXC1)
DI1[702,PSSTK,3777,SCRASH];	*MINONE
DI1[703,PSSTK,4000,SCRASH];	*ZERO
DI1[704,PSSTK,4001,SCRASH];	*ONE
DI1[705,PSSTK,4002,SCRASH];	*TWO
DI1S[706,SIC,3400,SCRASH];	*SIC
DI1[707,PSNIL,PPPSHX,SCRASH];	*NIL
DI1[710,PST,PPPSHX,SCRASH];	*T
DI1[711,PPPUSH,SCRASH,SCRASH];	*COPY
DI1[712,PPOP,SCRASH,SCRASH];	*POP
DM1[D1LC,713]; D1LC[E1[UUOM] E2[60] E3[4061]]; *UNDEFINED (I/O ON MAXC1)
DI1[714,PPOP2,PPOP1,SCRASH]	*POP2
DI1[715,PPOP3,PPOP1,SCRASH];	*POP3
DI1[716,UNBOX,FIXSP,SCRASH];	*VAG
DI1[717,UNBOX,UNBOX1,IPLUS2];	*IPLUS2
DI1[720,UNBOX,UNBOX1,IDIF2];	*IDIF
DI1[721,UNBOX,UNBOX1,IAND2];	*IAND2
DI1[722,UNBOX,QF1,IPLUS1];	*ADD1
DI1[723,UNBOX,QFM1,IPLUS1];	*SUB1
DM1[D1LC,724]; D1LC[E1[UUOM] E2[60] E3[4061]]; *UNDEFINED
*DI1S[725,GNBYT,BIND,BRET2];	*DBIND--THESE FORMS ARE NO GOOD BECAUSE
*DI1S[726,GNBYT,BIND,BRET1];	*BIND--BRET1 AND BRET2 ARE INTEGERS
DM1[D1LC,725]; D1LC[E1[GNBYT] E2[BIND] E3[BRET2]];	*DBIND
DM1[D1LC,726]; D1LC[E1[GNBYT] E2[BIND] E3[BRET1]];	*BIND
DI1[727,ZUNBND,FCALLX,SCRASH];	*UNBIND
DI1[730,BRETRN,FCALLX,SCRASH];	*RETURN
DI1S[731,BRETRN,XRETRN,SCRASH];	*XRETURN
DI1S[732,QNIL,JCOND1,JEQT];	*JUMP IF 0(PP) = NIL
DI1S[733,QNIL,JCOND1,JNEQT];	*JUMP IF 0(PP) # NIL
DI1S[734,BRMEM1,TEQ,JNEQT];	*JUMP IF 0(PP) # -1(PP)
DI1S[735,BRMEM1,TEQ,JEQT];	*JUMP IF 0(PP) = -1(PP)
DI1S[736,TATTYP,14,JNEQT];	*JUMP IF 0(PP) IS NOT AN ATOM
DI1S[737,TATTYP,14,JEQT];	*JUMP IF 0(PP) IS AN ATOM
DI1S[740,TTLIST,JNEQT,SCRASH];	*JUMP IF 0(PP) IS NOT A LIST
DI1S[741,TTLIST,JEQT,SCRASH];	*JUMP IF 0(PP) IS A LIST
DI1S[742,TATTYP,FLOATT,JNEQT];	*JNNUM
DI1S[743,TATTYP,FLOATT,JEQT];	*JNUM (TYPE .E. FLOATT TO SMALLT)
DI1S[744,TATTYP,22,JNEQT];	*JNFIXP
DI1S[745,TATTYP,22,JEQT];	*JFIXP (TYPE .E. FIXT TO SMALLT)
DI1S[746,GNBYT,TTYPE,JNEQT];	*JUMP IF 0(PP) IS NOT OF TYPE = NEXTBYTE
DI1S[747,GNBYT,TTYPE,JEQT];	*JUMP IF 0(PP) IS OF TYPE = NEXTBYTE
DI1S[750,UNBSP,TEH,JNEQT];	*JUMP IF -1(PP) .NE. 0(PP)
DI1S[751,UNBSP,TEH,JEQT];	*JUMP IF -1(PP) .E. 0(PP)
DI1S[752,UNBSP,TE,TGE];		*JUMP IF -1(PP) .GE. 0(PP)
DI1S[753,UNBSP,TE,TL];		*JUMP IF -1(PP) .L. 0(PP)
DI1S[754,UNBSP,TE,TG];		*JUMP IF -1(PP) .G. 0(PP)
DI1S[755,UNBSP,TE,TLE];		*JUMP IF -1(PP) .LE. 0(PP)
DI1S[756,JUMPX,JMP,SCRASH];	*JUMPX
DI1[757,BRMWPP,SWAP,SCRASH];	*SWAP
DI1[760,LAST,LAST1,SCRASH];	*LAST
DI1[761,BRMEM1,BFETCH,SCRASH];	*FETCHFIELD
DI1[762,BRMEM2,BRMEM1,STORE];	*REPLACEFIELD
DI1[763,BRMEM1,SETL,RPL];	*FRPLACD
DI1[764,BRMEM1,SETR,RPL];	*FRPLACA
DI1[765,RPLSUP,SETL,RPL];	*RPLACD
DI1[766,RPLSUP,SETR,RPL];	*RPLACA
DI1[767,GETP,GETP1,GETP2];	*GETP
DI1[770,READP,CDRP,CDR];	*CDDR
DI1[771,READP,IVAR,CDR];	*CDAR
DI1[772,READP,CDRP,CAR];	*CADR
DI1[773,READP,IVAR,CAR];	*CAAR
DI1[774,READP,CDR,SCRASH];	*CDR
DI1[775,READP,CAR,SCRASH];	*CAR
DI1[776,BRMEM1,FMEMB,SCRASH];	*FMEMB
DM1[D1LC,777]; D1LC[E1[UUOM] E2[60] E3[4061]]; *UNDEFINED (I/O ON MAXC1)