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