COMMENT ⊗   VALID 00067 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00006 00002	SWITCHES:
C00009 00003	COMF←←200000	COMMA TYPED FLAG
C00010 00004	RIGHT HALF FLAGS
C00012 00005	DEFINE DEVICES
C00013 00006	BREAK POINT LOGIC
C00014 00007	BCOM:	0
C00016 00008	SAVE:	0		SAVE THE ACS AND PI SYSTEM
C00019 00009	XEC0:	MOVEM T,TEMDDT
C00020 00010	IFN EDDT&1,<STARTA:	0>	START ADDRESS FROM PAPER TAPE
C00021 00011	TBLK:	0
C00022 00012	IFN FTDSWP&EDDT&1,<
C00025 00013	INITIALIZE SWAPPING DDT!!!
C00027 00014	GETDDT   CALLED FROM SAVE TO GET DDT INTO CORE!
C00029 00015	GETBAK   CALLED FROM RESTORE TO UPDATE SYMBOL TABLE AND GET USER CORE BACK!
C00031 00016	DDTREAD   CALLED FROM GETDDT TO READ DDT AND SYMBOL TABLE FROM DISK
C00033 00017	SETSYM   CALLED TO READ OR WRITE SYMBOL TABLE
C00035 00018	SETBUF   CALLED FROM EXAMINE & DEPOSIT TO READ OR WRITE 32 WORDS OF USER CORE
C00037 00019	EXAMINE & DEPOSIT ROUTINES FOR SWAPPING DDT!
C00039 00020	CPOPJ1:	AOS (P)
C00043 00021		MOVE T,SYL
C00045 00022	RET:	MOVEI P,PS
C00047 00023	NUM:	ANDI T,17		T HOLDS CHARACTER
C00049 00024	NM1:	TLNE F,CF
C00051 00025	POWER:	TLNN F,FEF
C00052 00026	PERIOD:	MOVE T,LLOC
C00053 00027	EVAL0:	HRLOI W1,37777+DELI
C00060 00028	SIXBI1:	PUSHJ P,TEXIN     INPUT TEXT (SIXBIT)
C00062 00029	TAG:	TLNN F,LTF    NO LETTERS IS ERROR
C00064 00030	SETNAM:	SYMTST
C00067 00031	RPRN:	TLNN F,QF		)
C00068 00032	REGISTER EXAMINATION LOGIC
C00072 00033	LTAB:	MOVSS T		SWAP HALVES FIRST
C00074 00034	MODE CONTROL SWITCHES
C00077 00035	GO AND EXECUTE LOGIC
C00081 00036	IXCT4:	IFE EDDT&1,<	SUBI T,041
C00084 00037	IPUSHJ:	DPB W1,[POINT 4,CPUSHP,12]	STORE AC FIELD INTO A PUSH
C00086 00038	ALL $B COMMANDS OF FORM <A>$<N>B
C00088 00039	FETCH AND DEPOSIT INTO MEMORY
C00091 00040	FIRARG:	MOVEM T,DEFV
C00095 00041	CONSYM:	MOVEM T,LWT
C00097 00042	HLFW:	PRINT AS HALF WORDS
C00100 00043	MASK:	TLNE F,QF
C00102 00044	SEAR3:	PUSHJ P,FETCH
C00104 00045	SETUP:	TROA F,R20F	FOR ZERO ONLY
C00106 00046	TOCC:	TRO F,EQF	SET TO REAL NUMERIC MODE
C00109 00047	FLOATING POINT OUTPUT
C00111 00048	FP7:	JUMPE A,FP7A2
C00113 00049	IFN EDDT&1&<EDDT>B36,<
C00114 00050	IFN EDDT&1&<EDDT>B36,<
C00116 00051	IFN EDDT&1&<EDDT>B36,<
C00118 00052	IFN EDDT&1&<EDDT>B36,<
C00120 00053	IFN EDDT&1&<EDDT>B36,<
C00122 00054	CRN:	MOVEI T,15		CARRIAGE RETURN
C00123 00055	IFN EDDT&1,<
C00126 00056	IFE EDDT&1,<
C00129 00057	BDISP:	POINT 12,DISP(R),11
C00131 00058	FLGOUT:	SKIPN R,FLGPNT
C00134 00059		JRST DDT
C00136 00060	DESCRIPTION OF OP DECODER FOR DDT:
C00139 00061	41(8)-72(8)      THE ALPHABET IS ENCODED INTO THIS RANGE.
C00143 00062	OP DECODER
C00147 00063	BEGIN OPDEFS
C00153 00064	PNTR:	INST	POINTER TO BITS IN INST
C00155 00065	DECT:	TRNE F,OUTF
C00158 00066	PATCH:	BLOCK 10
C00159 00067	IFN UEDDTS,<
C00165 ENDMK
C⊗;
;SWITCHES:
;	NONE FOR NORMAL, USER DDT
;	UEDDTS←←1 FOR USER EXEC DDT
;	EXEC DDT SETTINGS:
;		EDDT&1=0		ASSUME UDDT
;		EDDT&2=2		ASSUME EDDT WITH PAPER TAPE
;		EDDT&10=10		ASSUME PDP-10 PAPER TAPE INSTEAD OF PDP-6
;		EDDT&20=20		ASSUME SYSTEM EXEC DDT AND COMPILE SPECIAL CODE!
;		EDDT&40=40		MAKE RELOCATABLE EXEC DDT
;		IF LEFT HALF OF EDDT IS NOT=0, DO A LOC<EDDT>B53

IFNDEF FTDDT,<FTDDT←-1>
IFN FTDDT,<				;THIS ENTIRE ASSEMBLY IS CONDITIONAL
	IFNDEF FTDSWP,<↓FTDSWP←←0>
	IFNDEF EDDT,<↓EDDT←←0>
	IFE EDDT&20,<↓FTDSWP←←0>
	IFN EDDT,<IFE EDDT&40,<BEGIN DDT>>
	SUBTTL	DDT 7 APRL 1968

IFNDEF SAVESW,<SAVESW←0>	;SET UP A STARTING ADRESS
IFNDEF UEDDTS,<UEDDTS←0>	;SET UP UEDDT

DEFINE XP' (X.,Y.),<
X.←←Y.
>

IFN EDDT&40,<TITLE DDT - EXEC MODE VERSION>
IFN EDDT,<SUBTTL DDT - EXEC MODE VERSION
	JOBREL←←37
	JOBSYM←←36
	ZLOW←←40>

IFE EDDT,<TITLE UDDT - USER MODE DDT
	EXTERN JOBREL,JOBSYM,JOBSA,JOBHRL,JOBFF
	ZLOW←←140>
IFN EDDT&1,<
F←←0		;FLAGS
R←←1		;POINTERS TO TABLES, CORE, ETC.
S←←2
IFE EDDT&20,<P←←3>	;SETUP PUSHDOWN POINTER IF NOT SYSTEM
W←←4		;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
T←←5		;TRANSFER DATA
W1←←6
W2←←7
SCH←←10		;MODE CONTROL SWITCH FOR OUTPUT
AR←←11		;MODE CONTROL SWITCH FOR OUTPUT
ODF←←12		;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX
A←←R
B←←S
TT←←13		;TEMPORARY
>
IFE EDDT&1,<
F←0		;FLAGS
P←1		;PUSH DOWN
R←2		;POINTERS TO TABLES, CORE, ETC.
S←3
W←4		;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
T←5		;TRANSFER DATA
W1←6
W2←7
SCH←10		;MODE CONTROL SWITCH FOR OUTPUT
AR←11		;MODE CONTROL SWITCH FOR OUTPUT
ODF←12		;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX
A←R
B←S
TT←13		;TEMPORARY
>


C←←W

PRS←←4
TTYY←←120
PTRR←←104
PTPP←←100

LPDL←←50		;MAX LENGTH PUSH DOWN LIST

COMF←←200000	;COMMA TYPED FLAG
TIF←←100000		;TRUNCATE TO 18 BITS -  SET BY SPACE OR COMMA
PTF←←100		; +, -, OR * HAS BEEN TYPED
CTF←←400
SF←←4		;SYLLABLE FLAG
QF←←1		;QUANTITY TYPED IN TO WORD ASSEMBLER

CF←←40		; $ TYPED
CCF←←10000		; $$ TYPED
MF←←2		;MINUS SIGN TYPED IN
LTF←←20		;LETTER TYPED IN TO CURRENT SYLLABLE
ROF←←10		;REGISTER OPEN FLAG
STF←←4000
FAF←←1000		; < TYPED
SAF←←2000		; > TYPED

FPF←←20000		; . TYPED IN
FEF←←400000		; E FLAG

MLF←←200		;*FLAG
DVF←←40000		;DIVIDE FLAG

PPID←←0		;=0 IF SYMBOL TABLE POINTER IS IN JOBSYM
;RIGHT HALF FLAGS

ITF←←2	;INSTRUCTION TYPED IF ITF=1
OUTF←←4	;OUTPUT IF OUTF=1
CF1←←400		;OUTPUT 1 REGISTER AS CONSTANT
LF1←←2000		;OUTPUT 1 REGISTER AS FORCED SYMBOLIC OR CONSTANT
Q2F←←1		;NUMBER TYPED AFTER ALT MODE 
R20F←←10	;TEMP FLAG USED IN SETUP
SBF←←20
NAF←←200		;NEGATIVE ADDRESSES PERMISSABLE
POWF←←4000		;ARGUMENT FOR EXPONENT COMING
EQF←←20000	;WANTS REAL NUMERIC MODE

GLOBAL←←040000		;GLOBAL SYMBOL
LOCAL←←100000
PNAME←←740000		;PROGRAM NAME
DELI←←200000		;DELETE INPUT
DELO←←400000		;DELETE OUTPUT
IFE EDDT&1,<
LOC 74
DDT		;DDT'S STARTING ADDRESS
IFN UEDDTS,<LOC 124
DDTREN>>
IFE EDDT&1,<RELOC 0>
IFN EDDT&<XWD -1,0>,<LOC <EDDT>B53>



INTERN DDT,$M,DDTEND

RADIX =10
NBP←←8
IFN EDDT&20,<NBP←←30>

RADIX =8

IFE UEDDTS,<DEFINE SYMTST<>>
IFN UEDDTS,<DEFINE SYMTST
<	SKIPE SYMLUZ
	PUSHJ P,SYMPR>
OPDEF SETPR2[CALLI 400052]
MAXPR←←400000	;MAX SIZE OF UPPER>
DEFINE DEVICES
<
XQ APR,0
XQ PI,4
XQ IOP,10
XQ PTP,100
XQ PTR,104
XQ CTY,120
XQ LPT,124
XQ DC,200
XQ DTC,210
XQ DTS,214
XQ DCSA,300
XQ DCSB,304
XQ TV,404
XQ PEN,414
XQ ARM,420
XQ AD,424
XQ DPY,430
XQ KBD,434
XQ DKB,310
XQ DDD,510
XQ IMP,400
XQ DSK,444
XQ PMP,500
XQ IBM,504
XQ PCLK,730
XQ DCB,204
XQ MTC,220
XQ MTS,224
XQ MTM,230	
XQ XGP,440
>;END DEVICES


IFN EDDT&1,<
IFE EDDT&20,<

DEFINE XQ(A,B)
<A←←B
>
DEVICES
>
>

XP OR,<<IOR>>
XP JOV,2554B11
XP JEN,2545B11
IFE EDDT&20,<XP HALT,2542B11>
;BREAK POINT LOGIC
;THE B
BP1:	REPEAT NBP,<	0		;JSR TO HERE FOR BREAKPOINT
	JSA T, BCOM
	0		;HOLDS INSTRUCTION WHILE BREAKPOINT IS IN PLACE
	0
>

B1INS←←BP1+2
BPN←←.-4
BCOM:	0
	POP T,LEAV		;MOVE INSTRUCTION TO LEAV
	MOVEI T,B1SKP-B1INS+1(T)
	HRRM T,BCOM3		;CONDITIONAL BREAK SETUP
	MOVEI T,B1CNT-B1SKP(T)
	HRRM T,BCOM2		;PROCEDE COUNTER SETUP
	MOVE T,BP1-B1CNT(T)
IFN EDDT&1,<	TLZ T,010000		;TURN OFF USER MODE BIT>
	HLLM T,LEAV1		;SAVE FLAGS FOR RESTORING
	EXCH T,BCOM
IFN FTDSWP,<
	CONSZ APR,MAOFF		;DON'T LET PDP-6 TAKE BREAKS IF NO DDT!
	JRST BCOM3
	SKIPE INDDT
	SKIPN KEEPIN
	HALT NOBREAK
>
BCOM3:	SKIPN B1SKP		;ADDR MOD TO LOOK AT COND. INST.
	JRST BCOM2
	XCT @BCOM3
	JRST NOBREAK
BCOM2:	SOSG B1CNT		;ADDR MOD TO LOOK AT PROCEED COUNTER
	JRST BREAK
NOBREAK:
	MOVEM T,AC0+T
	LDB T,[POINT 9,LEAV,8]	;GET INSTRUCTION
	CAIL T,264	;JSR
	CAILE T,266	;JSA,JSP
	TRNN T,700	;UUO
	JRST PROC1		;MUST BE INTERPRETED
	CAIE T,260	;PUSHJ
	CAIN T,256	;XCT
	JRST PROC1		;MUST BE INTERPRETED
	MOVE T,AC0+T
	JRST 2,@LEAV1		;RESTORE FLAGS, GO TO LEAV

LEAV1:	XWD 0,LEAV

PROC1:	MOVE T,AC0+T
	JSR SAVE
	JFCL
	JRST PROC2

LEAV:	0			;INSTRUCTION MODIFIED
	JRST @BCOM
	AOS BCOM
	JRST @BCOM

BREAK:	JSR SAVE
	JRST BREAKA
	JRST BREAKB
SAVE:	0		;SAVE THE ACS AND PI SYSTEM
	SKIPN SARS
	JRST SAV1
	AOS SAVE
	JRST SAV5
SAV1:	IFN EDDT&1,<
	CONI APR,SAVAPR
	CONI PRS,SAVPI
	CONO PRS, @SAVPI+1>
	MOVEM 17,AC17
	HRRZI 17,AC0
	BLT 17,AC0+16
	MOVE T, SAVE
	HLLM T, SAVPI
SAV5:	SETOM SARS
	MOVEI P,PS
IFN FTDSWP&EDDT&1,<
	PUSHJ P,GETDDT		;DO THE SWAPPABLE DDT THING!
>
	IFE EDDT&1,<PUSHJ P,TTYRET>	;IN USER MODE, GET INTO DDT MODE
	MOVEI F,0
	MOVE T,[XWD SCHM,SCH]
	BLT T,ODF		;LOAD THE ACS WITH MODE SWITCHES
	JRST @SAVE

XCTBUF:
	REPEAT 10,<CONO PRS,@SAVPI
		0
		SKIPA
		AOS .+1
		JRST .
		0
	>

XCTQ←←6

RESTORE: SETOM TEM3	;RESTORE ACS AND PI SYSTEM
RESTR1:	HRRM T,SAVE
IFN EDDT&1,<
	MOVE T,SAVAPR
	ANDI T,SYSCLB!7	
	TRNN T,SYSCLB
	CONO APR,CLRCLB(T)	;IF THE SYSTEM WASN'T CLOBBERED WHEN WE CAME 
				;IN, THEN IT ISN'T CLOBBERED NOW.
>
	MOVE T,SAVPI
	HLLM T, SAVE
	MOVEM W,TEMDDT
IFN EDDT&1,<
	AND T, SAVPI+1
	ANDI T,177
	IORI T, 2000	;TURN ON CHANNELS
	EXCH T, SAVPI>
	MOVEI W,XCTBUF
ZZ←←7
	REPEAT 7,<
	TRNE T,1⊗<17-ZZ>
	MOVEI W,XCTBUF+<XCTQ*ZZ>
ZZ←←ZZ-1
>
	HLL W,SAVE
	MOVEM W,RES2
	IFE EDDT&1,<AOS RES2>
	MOVE T,TEMDDT
	MOVEM T,1(W)
	HRRZ T,SAVE
	HRRM T,4(W)
	SKIPGE TEM3
	JRST RES3
	MOVE T,BCOM
	MOVEM T,5(W)
	MOVEI T,5(W)
	HRRM T,1(W)
RES3:
IFN EDDT&20,<
	MOVE TAC,MONPTR	; RECOMPUTE MONITOR CHECKSUM
	PUSHJ P,CHECK
	SKIPN $M-1	; ONLY IF COMMANDS COMING FROM KEYBOARD!
	MOVEM TAC1,MONSUM
IFN FTDSWP,<
	PUSHJ P,GETBAK		;DO THE SWAPPABLE DDT THING
>
>
	MOVSI 17,AC0
	BLT 17,17
	SETZM SARS
	JRST 2,@RES2

RES2:	0

XEC0:	MOVEM T,TEMDDT
	PUSHJ P,CRF
	PUSHJ P,TTYLEV
	PUSHJ P,INSRTB
	MOVE W,TEMDDT	;IN CASE OF INTERUPTS (JS STUFF)
	JSP T,RESTORE	;RESTORE WILL XCT W
XEC1:	JRST DDT		;USED  AT PROC0
	JSR SAVE
	PUSHJ P,REMOVB
	PUSHJ P,CRF
	JRST DD1


RETB:	HRRZ T,BCOM2	;SET UP TEXT STRING
	SKIPE T,1(T)
	HRLI T,(<POINT 7,0>)
	MOVEM T,STRING
	JRST RET
IFN EDDT&1,<STARTA:	0>	;START ADDRESS FROM PAPER TAPE
IOTBL:
IFN EDDT&1!UEDDTS,<
DEFINE XQ(A,B)
<	B
>
DEVICES
>
REPEAT 10,<-1>
IOTLG←.-IOTBL
SAVPI:	0
XP $I,SAVPI
	1037
SAVTTY:	0

IFN EDDT&1,<OUTLPT:	0
SAVAPR:	0	>
OUTRTN:0
STRING:	0
MSK:	XWD -1,-1
XP $M,MSK
MXINC:	100
BMASK:	0
FLGPTR:	0
B1ADR:	0
B1SKP:	0
B1CNT:	0
B1STR:	0

DEFINE DBPNT ' (Z.) <XP $'Z.'B,B1ADR+4*Z.-4>

RADIX =10
FOR QZ←1,NBP
<DBPNT (QZ)
>
RADIX =8
REPEAT NBP*4-4, <	0>

BNADR←←.-4
AUTOPI:	0

AC0:	BLOCK 17

AC17:	0

SCHM:	PIN		;DO NOT CHANGE ORDER
	PADSO
ODFM:	10

SARS:	0
TEM1:	0

PS:	BLOCK LPDL
TBLK:	0
TEMDDT:	0
BLOCK:	0
SVF:	0
SW1:	0
SVFB:	0
SVTB:	0
BLVL:	0
WRD:	0
WRD2:	0
PRNC:	0

FRASE:	0	;DONT CHANGE ORDER, SEE  SEARC+3
SYL:	0
LWT:	0
TEM2:	0
FRASE1:
TEM3:	0
DENDDT:	0

PRGM:	0
FSV:	0
FH:	0
SYM:	0
SPSAV:	0	;POINTER TO LAST SYMBOL TYPED
DEFV:	0
ULIMIT:	0
LLOC:	0
LLOCO:	0
SAVLOC:	0
IOTFLG:	0
SYMP:IFN UEDDTS,<EXCSYM;	SO WE CAN DEBUG IT>	XWD PPID,JOBSYM
IFN FTDSWP&EDDT&1,<
COMMENT ⊗
INITIALIZATION ROUTINES FOR SWAPPING DDT AT 203 RESTART
SWAPPING DDT CONTROL CELLS AND THEIR MEANINGS:

DDTSWP:	-1	ENABLE SWAPPING DDT
		0	DISABLE SWAPPING DDT

→→→→→→→→→→→→→→→→THIS IS THE ONLY CELL YOU SHOULD SET!!!!!
		THIS CELL IS LOOKED AT ONLY AT 203 RESTARTS!
		THEREFORE IT IS NECESSARY TO DO A 203 RESTART TO CHANGE THE
		STATE OF SWAPPING DDT.

NOTDDT:	-1	FLUSH DDT ENTIRELY

KEEPIN:		-1	DDT STAYS IN CORE ALWAYS
		0	DDT IS SWAPPABLE

		EXAMINED AT GETBAK
		SET IN DDTINI AT 203 RESTART

INDDT:		-1	DDT IS IN CORE
		0	DDT IS ON DISK

EXMCOR:		0	EXAMINE & DEPOSIT IN RANGE DDTA TO END OF
			SYMBOL TABLE GO TO DISK
		-1	EXAMINE & DEPOSIT ALWAYS REFERENCE CORE!

⊗

DDTTRY←←10		;TRY THIS MANY TIMES ON ERROR

↑↑DDTSWP:	-1	;NORMALLY ENABLE SWAPPING
↑↑NOTDDT:	0	;START WITH DDT

↑↑KEEPIN:	-1	;DDT STAYS IN AT LEAST UNTIL THE FIRST START-UP

↑↑INDDT:	-1	;DDT STARTS OUT IN CORE!

↑↑SYMLOC:	0	;SET BY BEGIN TO CONTENTS OF DDTSYM BEFORE ONCE ONLY CODE

↑↑EXMCOR:	0	;REFERENCE CORE AT FIRST

↑↑DDTSUM:	0	;CHECKSUM OF DDT

DDTIOP:		0	;STATE OF IOP SAVED HERE WHEN DDT ENTERED!

SWPWRD:		0	;PLACE TO KEEP WORD WE ARE DEPOSITING!

USROFF:		0	;OFFSET FROM CORE TO DISK FOR EXAMINE AND DEPOSIT
			;SET BY SETUSR
;INITIALIZE SWAPPING DDT!!!

↑DDTINI:
	SKIPE DDTSUM		;THIS SHOULD TELL US IF DDT HAS
				;BEEN WRITTEN ON DISK YET!!!
	CONSZ DSK,1B27		;IS DISK THERE AT ALL
	SETZM DDTSWP		;ASK FOR NO SWAPPING
	SKIPN DDTSWP
	SKIPN INDDT
	CAIA
	JRST SETIN
	PUSHJ P,DDTREAD		;TRY TO READ DDT FROM DISK
	JRST CANTSWP		;COULDN'T GET DDT, LOSE BIG!
	CAIA			;COULDN'T GET SYMBOLS, STICK IT IN
	SKIPN DDTSWP
	JRST SETIN
SETOUT:	SETZM KEEPIN
	SETZM INDDT
	SETZM DDTSYM		;NO SYMBOLS, NOW
	SETZM EXMCOR		;EXAMINE DISK FOR USER
	MOVEI TAC,DDTA
	MOVEM TAC,SYSSIZ	;GIVE LOSERS ALL THIS CORE!
	POPJ P,
SETIN:	SETOM KEEPIN
	HLRE TAC,DDTSYM
	MOVMS TAC
	ADD TAC,DDTSYM
	JUMPN TAC,.+2
	MOVEI TAC,DDTEND
	HRRZM TAC,SYSSIZ
	SETOM EXMCOR		;EXAMINE CORE ONLY (DDT IS ALWAYS THERE)
	POPJ P,
CANTSWP:
	MOVE TAC,[HALT 201]
	MOVEM TAC,DDT
	JRST SETOUT
;GETDDT   CALLED FROM SAVE TO GET DDT INTO CORE!

GETDDT:	SKIPN INDDT		;IF DDT ALREADY IN,
	CONSO APR,MAOFF		;OR NOT PDP 10
	POPJ P,			;THEN NOTHING TO DO
	CONSO IOP,777770	;IS IOP ACTIVE?
	JRST IOPFRE		;NO
	MOVSI TAC,1
	CONSO IOP,IOPANY!IOPJDN	;WAIT FOR IT TO BECOME INACTIVE
	SOJG TAC,.-1		;IN CASE IT IS HUNG!
IOPFRE:	CONI IOP,TAC		;SAVE STATE OF IOP
	TRNN TAC,IOPRLY		;ANY IOP ERRORS WE CAN'T SAVE?
	CONSZ DSK,3770		;ANY DISK ERRORS WE CAN'T SAVE?
	TRO TAC,IOPMIS		;YES, SET DATA MISS FLAG
	MOVEM TAC,DDTIOP	;SAVE BITS HERE TO PUT BACK LATER!
	MOVEI TAC1,DDTTRY	;TRY THIS MANY TIMES
OUTLOS:	CONO DSK,0		;BLAST DISK
	CONO IOP,100		;WRITE THIS TIME
	PUSHJ P,SETUSR		;SET-UP USER ADDRESSES AND START TRANSFER
	SOJG TAC1,OUTLOS
	JUMPG TAC1,NOLOSO		;WIN
	JSP TAC,DDTMES
	ASCIZ/
FAILED TO GET USER WRITTEN OUT!
CONTINUE TO TRY TO GET DDT IN.
/
	HALT .+1
NOLOSO:	PUSHJ P,DDTREAD	;TRY TO READ IN DDT
	JRST NODDT
	JRST NOSYM
LOSCON:	CONO IOP,@DDTIOP
	POPJ P,			;ALL IS WELL
NODDT:	JSP TAC,DDTMES
	ASCIZ/
FAILED TO GET DDT IN AT ALL!
CONTINUE TO TRY AGAIN.
/
	HALT NOLOSO
NOSYM:	JSP TAC,DDTMES
	ASCIZ/
FAILED TO GET SYMBOL TABLE IN!
CONTINUE TO ENTER DDT ANYWAY.
/
	HALT LOSCON
;GETBAK   CALLED FROM RESTORE TO UPDATE SYMBOL TABLE AND GET USER CORE BACK!

GETBAK:	CONSO APR,MAOFF
	POPJ P,			;PDP-6 DOESN'T DO ANYTHING
	SKIPN KEEPIN		;DDT GOING OUT?
	SKIPN INDDT		;AND IN NOW
	POPJ P,			;NO
	SETZM DDTSYM		;NO DDT, NO SYMBOLS.
;THE FOLLOWING SEMICOLONED OUT TO KEEP SYMBOLS IN ONE PIECE!
;	MOVEI TAC1,DDTTRY	;UPDATE DDT ONLY IN SWAPPING DDT ENVIRONMENT
;WRTLOS:	CONO DSK,0
;	CONO IOP,100		;WRITE SYMBOL TABLE
;	PUSHJ P,SETSYM		;UPDATE SYMBOL TABLE!!!
;	SOJG TAC1,WRTLOS	;TRY AGAIN?
;	JUMPG TAC1,NOUPDATE	;DID WE WIN?
;	JSP TAC,DDTMES
;	ASCIZ/
;COULD'NT UPDATE YOUR SYMBOL TABLE ON THE DISK, SORRY!
;/
NOUPDATE:
	MOVEI TAC1,DDTTRY	;NOW TO RESTORE LOSER CORE
	SETZM INDDT		;DDT NO LONGER IN CORE
USRLOS:	CONO DSK,0
	CONO IOP,0		;READ LOSER THIS TIME
	PUSHJ P,SETUSR
	SOJG TAC1,USRLOS
	CONO IOP,@DDTIOP
	JUMPG TAC1,CPOPJ	;DID WE GET HIM BACK IN?
	JSP TAC,DDTMES
	ASCIZ/
FAILED TO RESTORE LOSER CORE!
CONTINUE TO IGNORE.
/
	HALT CPOPJ
;DDTREAD   CALLED FROM GETDDT TO READ DDT AND SYMBOL TABLE FROM DISK

DDTREAD:MOVEI TAC1,DDTTRY
DDTLOS:	CONO DSK,0
	CONO IOP,0		;READ THIS TIME
	MOVE TAC,[XWD DDTA-DDTEND-40,DDTA]
	ANDCMI TAC,37
	DATAO IOP,TAC
	MOVEI TAC,DDTA
	ASH TAC,-5
	PUSHJ P,SECTOR
	PUSHJ P,IOPWAIT
	SOJG TAC1,DDTLOS
	SETZM DDTSYM
	JUMPLE TAC1,CPOPJ
	SETOM INDDT		;FLAG DDT IN CORE
	MOVE TAC,[XWD DDTA-DDTEND,DDTA]
	PUSHJ P,CHECK		;CHECKSUM DDT!
	SKIPN DDTSUM		;IS THERE A CHECKSUM THERE?
	MOVEM TAC1,DDTSUM	;NO, USE THIS ONE
	CAMN TAC1,DDTSUM	;CHECKSUM OK?
	JRST SUMOK		;YES
	JSP TAC,DDTMES
	ASCIZ/
DDT CHECKSUM FAILURE!
/
SUMOK:	MOVEI TAC1,DDTTRY
SYMLOS:	CONO DSK,0
	CONO IOP,0		;READ SYMBOL TABLE
	PUSHJ P,SETSYM
	SOJG TAC1,SYMLOS
	JUMPLE TAC1,CPOPJ1	;LOSE ON SYMBOL TABLE READ
	MOVE TAC,SYMLOC
	ANDCMI TAC,777740
	ADDI TAC,DDTEND
	MOVEM TAC,DDTSYM	;THIS IS WHERE THE SYMBOL TABLE IS
	JRST CPOPJ2
;SETSYM   CALLED TO READ OR WRITE SYMBOL TABLE

SETSYM:	SKIPN TAC,SYMLOC
	POPJ P,
	HLLZS TAC
	ADD TAC,[XWD -40,DDTEND]
	DATAO IOP,TAC
	HRRZ TAC,SYMLOC
	ASH TAC,-5
	PUSHJ P,SECTOR
	JRST IOPWAIT		;SKIP RETURNS IF ALL OK

;SETUSR   CALLED TO READ OR WRITE USER CORE IN DDT REGION

SETUSR:	MOVSI TAC,DDTA-DDTEND-100	;LET'S BE CAREFUL
	ADD TAC,SYMLOC		;AND LENGTH OF SYMBOL TABLE
	HRRI TAC,DDTA
	ANDCMI TAC,37		;ROUND IT OFF TO NEAREST SECTOR
	DATAO IOP,TAC		;PHEW!
	HLRE TAC,SYMLOC		;LENGTH OF SYMBOL TABLE
	MOVMS TAC
	ADD TAC,SYMLOC
	HRRZS TAC
	JUMPN TAC,.+2
	MOVEI TAC,BLTBEG	;MAYBE SYMBOL TABLE LOSES?
	ADDI TAC,37
	ASH TAC,-5
	MOVEM TAC,USROFF
	PUSHJ P,USECTOR		;AND THEY'RE OFF	;REG 5-9-72
	MOVNI TAC,DDTA-37
	ASH TAC,-5
	ADDM TAC,USROFF
	JRST IOPWAIT
;SETBUF   CALLED FROM EXAMINE & DEPOSIT TO READ OR WRITE 32 WORDS OF USER CORE

SETBUF:	DATAO IOP,[XWD -40,DDTBUF]	;THE BUFFER IS EASY
	MOVE TAC,R
	ASH TAC,-5
	ADD TAC,USROFF
	PUSHJ P,USECTOR			;REG 5-9-72
	JRST IOPWAIT

;DDTMES   TYPES MESSAGE ON CTY
;CALLING SEQUENCE:
;	JSP TAC,DDTMES
;	ASCIZ/MESSAGE/
;	<RETURNS HERE>

DDTMES:	HRLI TAC,(<POINT 7,0>)
	JSR DDTTYPE
	JRST 1(TAC)		;SEE HOW CLEVER WE ARE!!!!

SECTOR:	CAIL TAC,2300		;NEXT TRACK?
	ADDI TAC,1B24-2300	;TAC←TAC-2300+1B24, WRAPAROUND TO NEXT ONE
	ADD TAC,SYSBAND
	DATAO DSK,TAC
	POPJ P,

USECTOR:	;SAME AS SECTOR, BUT USES DDTBAND, NOT SYSBAND
		;WRITE USERS HERE.   REG 5-9-72
	CAIL TAC,2300		;NEXT TRACK?
	ADDI TAC,1B24-2300	;TAC←TAC-2300+1B24, WRAPAROUND TO NEXT ONE
	ADD TAC,DDTBAND
	DATAO DSK,TAC
	POPJ P,

IOPWAIT:
	CONSZ DSK,1B27
	POPJ P,
	MOVSI TAC,2
	CONSO IOP,IOPANY!IOPJDN
	SOJG TAC,.-1
	JUMPE TAC,CPOPJ
	CONSO IOP,IOPANY
	CONSZ DSK,3770
	POPJ P,
	JRST CPOPJ1
;EXAMINE & DEPOSIT ROUTINES FOR SWAPPING DDT!
;
SWPEXM:	CONSO APR,MAOFF
	JRST CPOPJ2			;PDP-6 GETS CORE!
	SKIPN EXMCOR		;EXAMINING REAL CORE
	SKIPE KEEPIN		;IS THERE SOMETHING ON THE DISK?
	JRST CPOPJ2		;NO, DO NORMAL THING
	HLRE W,SYMLOC		;GET LENGTH OF SYMBOL TABLE (ON DISK)
	MOVNS W
	CAIL R,DDTA
	CAILE R,DDTA+100(W)	;IS THIS LOCATION ON DISK?
	JRST CPOPJ2		;NO
	MOVEI T,DDTTRY
	PUSH P,S
	PUSH P,R
EXMLOS:	CONO DSK,0
	CONO IOP,0
	PUSHJ P,SETBUF
	SOJG T,EXMLOS
	POP P,R
	POP P,S
	JUMPLE T,DSKLOS
	MOVE T,R
	ANDI T,37
	MOVE T,DDTBUF(T)
	POPJ P,			;GOT IT (OFF DISK)
DSKLOS:	PUSH P,TAC
	JSP TAC,DDTMES
	ASCIZ/
DISK REFERENCE LOST!
/
	POP P,TAC
	JRST CPOPJ1	;SO SWPDEP WON'T TRY TO WRITE

SWPDEP:	MOVEM T,SWPWRD
	PUSHJ P,SWPEXM
	JRST SWPDP1	;GOT IT IN!
	POPJ P,		;MAKE BELIEVE IT WON!!
	JRST CPOPJ1	;NOT ON DISK GET FROM CORE
SWPDP1:	MOVE W,R
	ANDI W,37
	MOVE T,SWPWRD
	MOVEM T,DDTBUF(W)
	MOVEI W,DDTTRY
	PUSH P,S
	PUSH P,R
DEPLOS:	CONO DSK,0
	CONO IOP,100	;WRITE
	PUSHJ P,SETBUF
	SOJG W,DEPLOS
	POP P,R
	POP P,S
	MOVE T,SWPWRD
	JUMPG W,CPOPJ
	SOS (P)			;DSKLOS WANTS TO SKIP RETURN
	JRST DSKLOS		;TELL THEM IT LOST

>
CPOPJ1:	AOS (P)
CPOPJ:	POPJ P,
IFN FTDSWP,<TMPTAC:	0>
DDT:
IFN FTDSWP,<
	CONSZ APR,MAOFF
	JRST DDTP1
	SKIPE INDDT
	SKIPN KEEPIN
	HALT DDT
DDTP1:	SKIPE NOTDDT
	JRST [	MOVEM TAC,TMPTAC
		MOVE TAC,[POINT 7,[ASCIZ/SORRY, CAN'T GET DDT!
/]]
		JSR DDTTYPE
		MOVE TAC,TMPTAC
		HALT DDT]
>
	JSR SAVE
IFN FTDSWP&EDDT&1,<
	JRST DDTA
	JRST DDTB


;MAKE SURE EVERYTHING WE NEED STAYS IN!!!!!!!!!
LIT
VAR

DDTBUF:	BLOCK 40
↑↑DDTA:
>;FTDSWP
	PUSHJ P,REMOVB
DDTB:	PUSHJ P,CHKSYM	;SEE IF SYMBOL TABLE HAS MOVED
	 HLRZ T,ESTU		;THIS SEQUENCE INITS SYM TABLE LOGIC
	 SUB T,ESTU
	 MOVE W,@SYMP
	 ADD T,W		;IF THE TOP OF THE UNDEFINED SYM TAB DOES
	 TRNE T,-1		; NOT POINT TO BOTTOM OF REGULAR SYM TAB,THEN
	 HRRZM W,ESTU		; RE-INIT UNDEFINED SYM TABLE POINTER, ESTU.
	 MOVE T,PRGM
	 SUB T,W		;IF THE SYM TABLE PNTR AND THE PROGRAM
	 TSC T,T		; NAME (PRGM) PNTR DO NOT END UP IN THE
	 MOVE W1,PRGM		; SAME PLACE, OR THEY DO NOT BOTH START ON
	 XOR W1,W		; AN EVEN (OR BOTH ON ODD) LOCATION, OR
	 TRNN W1,1		; PRGM .GE. 0, THEN RE-INIT PRGM.
	JUMPE T,DD1
	SETZM PRGM
	SETZM BLOCK		;RESET WORLD
DD1:	TLZ F,ROF		;CLOSE ANY OPEN REGISTER
	PUSHJ P,CRF
DD1.5:	MOVE T,[XWD SCHM,SCH]
	BLT T,ODF	;LOAD ACS
DD2:	SETZM  PRNC		;PARENTHESES COUNT
	MOVEI P,PS
LIS:	MOVE T,ESTU
	MOVEM T,ESTUT		;INIT UNDEFINED SYM ASSEM
	TDZ F,[XWD 777777-ROF-STF,LF1+CF1+SBF+ITF+EQF+Q2F]
	SETZM IOTFLG		;NOT AN IOT YET
LIS0:	TDZ F,[XWD 777777-ROF-STF-FAF-SAF,NAF]
	SETZM WRD
LIS1:	SETZM FRASE
LIS2:	MOVEI T,1
	MOVEM T,FRASE1
	TLZ F,MLF+DVF
L1:	TLZ F,CF+CCF+SF+FPF		;TURN OFF CONTROL, SYL, PERIOD FLAG
	SETZM SYL
L1RPR:	SETZM SYM
	MOVEI T,6
	MOVEM T,TEMDDT		;INIT SYMBOL COUNTER
	MOVE T,[POINT 7,TXT]	;SET UP POINTER FOR OPEVAL
	MOVEM T,CHP
	SETZM DENDDT
	SETZM WRD2

L2:	PUSHJ P,TIN		;PICK UP CHARACTER
	CAIL T,"A"+40
	CAILE T,"Z"+40
	SKIPA
	TRC T,40
	TLNE F,CF		;CONTROL FLAG
	JRST L21
	CAIG T,"Z"		;Z
	CAIGE T,"A"		;A
	JRST .+2
	JRST LET
L21:	MOVE R,T
	CAILE T,137
	JRST ERR
	IDIVI R,3
	LDB W,BDISP(R+1)
	CAIGE W,MULT-DDT	;FIRST EVAL ROUTINE
	JRST DDT(W)
	MOVE T,SYL
	TLZN F,LTF
	JRST POWER
	MOVE T,[XWD OPEVAL,EVAL]	;LOOKUP ROUTINES IN CORRETC ORDER
	SKIPN WRD	;USE SYMBOL TABLE FST IF SOMETHING THERE
	MOVSS T
	MOVEM T,SAVE
	JRST L213
L212:	HLRZS T,SAVE
	JUMPE T,UND1	;NEITHER ONE
L213:	PUSHJ P,(T)
	JRST L212	;TRY NEXT ONE
L4:	TLZE F,MF
	MOVN T,T
	TLNN F,SF
	CAIE W,LPRN-DDT
	JRST .+2
	JRST LPRN

	EXCH T,FRASE1
	TLNN F,DVF
	IMULB T,FRASE1
	TLZE F,DVF
	IDIVB T,FRASE1
	CAIGE W,ASSEM-DDT
	JRST DDT(W)		;MULTIPLY OR DIVIDE
	ADDB T,FRASE
	CAIGE W,SPACE-DDT
	JRST DDT(W)		; + - @ ,

	ADD T,WRD
	TLNE F,TIF		;TRUNCATE INDICATOR FLAG
	HLL T,WRD		;TRUNCATE
	MOVEM T,WRD
	TLNN F,QF
	MOVE T,LWT
	SETZM R
	MOVE W1,ESTUT
	CAMN W1,ESTU
	JRST L5
	CAILE W,CARR-DDT
	JRST ERR
L5:	CAIG W,RPRN-DDT
	JRST DDT(W)
	PUSH P,KILRET
	SKIPN PRNC
	JRST DDT(W)

ERR:	MOVEI W1,"?"
	JRST WRONG1
UNDEF:	MOVEI W1,"U"
	JRST WRONG1
WRONG:	MOVE W1,[ASCII /XXX/]
WRONG1:	MOVEI P,PS
	PUSHJ P,TEXT
IFN EDDT&1,<PUSHJ P,LCT		;TYPE TAB
	PUSHJ P,LISTEN
	JFCL
	JRST DD2>
RET:	MOVEI P,PS
	PUSHJ P,LCT		;COMMON RETURN FOR TAB;,JRST LIS
	JRST DD2

UND1:	MOVE R,ESTUT		;UNDEFINED SYM ASSEMBLER
	HLRE S,ESTUT
	ASH S,-1		;SETUP EVAL END TEST
	HRLOI W1,37777+DELI+LOCAL
	PUSHJ P,EVAL2
	CAIN W,ASSEM-DDT
	TLNN F,ROF
	JRST UNDEF
	SKIPE PRNC
	JRST UNDEF
	MOVEI T,"#"
	CAIE W,ASSEM-DDT
	PUSHJ P,TOUT

	MOVN R,[XWD 2,2]
	ADDB R,ESTUT
	MOVE T,SYM
	TLO T,GLOBAL
	MOVEM T,(R)
	HRRZ T,LLOCO
	TLNE F,MF
	TLO T,400000
	MOVEM T,1(R)
	MOVEI T,0
	JRST L4

QUESTN:	PUSHJ P,CRF		;LIST UNDEFINED SYMBOLS
	MOVE R,ESTU
QUEST1:	JUMPGE R,DD1
	MOVE T, (R)
	SKIPA W1,ESTU

QUEST2:	ADD W1,[XWD 2,2]
	CAME T,(W1)
	JRST QUEST2

	CAME R,W1
	JRST QUEST4
	PUSHJ P,SPT
	PUSHJ P,CRF
QUEST4:	ADD R,[XWD 2,2]
	JRST QUEST1
NUM:	ANDI T,17		;T HOLDS CHARACTER
	TLNE F,CF+FPF
	JRST NM1
	MOVE W,SYL
	LSH W,3
	ADD W,T
	MOVEM W,SYL
	MOVE W,DENDDT
	IMULI W,12		;CONVERT TO DECIMAL
	ADD W,T
	MOVEM W,DENDDT
LE1:	AOJA T,LE1A

PERC:	MOVEI T,47+101-13	;PERCENT SIGN
LET:	TLC F,SF+FPF		;EXPONENT IFF LTF'*FEF'*(T=105)*SF*FPF=1
	TLZN F,LTF+FEF+SF+FPF
	CAIE T,105		; E
	TLOA F,LTF
	TLOA F,FEF
	JRST LET1
	TLZN F,MF
	SKIPA W1,SYL
	MOVN W1,SYL
	MOVEM W1,FSV
	SETZM  DENDDT
LET1:	SUBI T,101-13		;FORM RADIX 50 SYMBOL
LE1A:	TLO F,SF+QF
LE2:	MOVE W,SYM
	MOVEI R,101-13(T)	;SET UP IN SIXBIT FOR OPEVAL
	IMULI W,50		;CONVERT TO RADIX 50
	ADD W,T
	SOSGE TEMDDT		;IGNORE CHARACS AFTER 6
	JRST L2		;GO IGNORE
	IDPB R,CHP	;SAVE FOR OPEVAL
	MOVEM W,SYM
	JRST L2

NUM1:	EXCH T,WRD2		;FORM NUMBER AFTER $
	IMULI T,12
	ADDM T,WRD2
	TRO F,Q2F
	JRST L2

NM1:	TLNE F,CF
	JRST NUM1
	MOVEI W1,6		;FOM FLOATING POINT NUMBER
	AOS NM1A
NM1A:	MOVEI W2,0
	MOVSI R,201400
NM1A1:	TRZE W2,1
	FMPR R,FT(W1)
	JUMPE W2,NM1B
	LSH W2,-1
	SOJG W1,NM1A1
NM1B:	MOVSI W1,211000(T)
	FMPR R,W1
	FADRB R,FH
	MOVEM R,SYL
	AOJA T,LE1A

CHKSYM:	 HLRZ T,ESTU		;THIS SEQUENCE INITS SYM TABLE LOGIC
	 SUB T,ESTU
	 MOVE W,@SYMP
	 ADD T,W		;IF THE TOP OF THE UNDEFINED SYM TAB DOES
	 TRNE T,-1		; NOT POINT TO BOTTOM OF REGULAR SYM TAB,THEN
	 HRRZM W,ESTU		; RE-INIT UNDEFINED SYM TABLE POINTER, ESTU.
	 MOVE T,PRGM
	 SUB T,W		;IF THE SYM TABLE PNTR AND THE PROGRAM
	 TSC T,T		; NAME (PRGM) PNTR DO NOT END UP IN THE
	 MOVE W1,PRGM		; SAME PLACE, OR THEY DO NOT BOTH START ON
	 XOR W1,W		; AN EVEN (OR BOTH ON ODD) LOCATION, OR
	 TRNN W1,1		; PRGM .GE. 0, THEN RE-INIT PRGM.
	JUMPE T,CPOPJ
	SETZM PRGM
	SETZM BLOCK		;RESET WORLD
	POPJ P,
POWER:	TLNN F,FEF
	JRST L4		;NO EXPONENT
	CAIE W,PLUS
	CAIN W,MINUS
	TROE F,POWF
	TRZA F,POWF
	JRST (W)		; E+-

	MOVE W2,DENDDT
	SETZM  FRASE
	MOVEI W1,FT-1
	TLZE F,MF
	MOVEI W1,FT01
	SKIPA T,FSV
POW2:	LSH W2,-1
	TRZE W2,1
	FMPR T,(W1)
	JUMPE W2,L4
	SOJA W1,POW2
PERIOD:	MOVE T,LLOC
	TLNE F,SF		;SYLLABLE STARTED
	MOVE T,DENDDT
	MOVEM T,SYL
	TLNE F,FPF
	TLO F,LTF
	TLON F,FPF+SF+QF
	MOVEI T,0
	IDIVI T,400
	SKIPE T
	TLC T,243000
	TLC W1,233000
	FAD T,[0]
	FAD W1,[0]
	FADR T,W1
	MOVEM T,FH
	HLLZS NM1A
	MOVEI T,45		;RADIX 50 PERIOD
	JRST LE2

QUAN:	SKIPA T,LWT		;LAST QUANTITY TYPED
PILOC:	MOVEI T, SAVPI
QUAN1:	MOVEM T,SYL
QUAN2:	TLO F,SF+QF		;WRD,SYL STARTED
	TLZ F,CF+CCF
	JRST L2

CONTRO:
IFN EDDT&1, <				;SOME KIND OF ALTMODE
	MOVEI T,"$"	;$
	PUSHJ P,TOUT		;TYPE OUT $>
DOLLAR:	TLOE F,CF
	TLO F,CCF
	JRST L2

EVAL0:	HRLOI W1,37777+DELI
	HLRE S,@SYMP
	ASH S,-1	;SETUP END TEST
	JRST EVAL3

EVAL1:	ADD R,[XWD 2,2]
EVAL2:	SKIPL R
	MOVE R,@SYMP
	AOJG S,CPOPJ		;TRNASFER IF NO SYMBOL FOUND
EVAL3:	MOVE T,(R)
	XOR T,SYM
	TLNN T,PNAME
	TLOA W1,LOCAL
	TDNE T,W1
	JRST EVAL1
	TLNN T,340000
	JRST EVAL1
	MOVE T,1(R)
	AOS (P)		;FOUND SYMBOL, SKIP
	POPJ P,

;HERE IS THE WFW BLOCK STRUCTURE PATCH 
EVAL:	SYMTST
	MOVSI W1,DELI
	HLRE S,@SYMP
	ASH S,-1
	SKIPL R,TBLK
	JRST EVL1
	SETZM TBLK
	JRST EVL2
EVL1:	SKIPL R,BLOCK
	JRST EV5
EVL2:	MOVE T,1(R)
	MOVEM T,BLVL
	JRST EV1

EV3:	CAMN R,@SYMP
	JRST EV4
	AOJGE S,CPOPJ
EV1:	SUB R,[XWD 2,2]
	MOVE T,(R)
	TDNE T,W1
	JRST EV3
	LDB T,[POINT 4,(R),3]
	CAIN T,3
	JRST EV2
	SKIPN T
	TLOA W1,LOCAL
	SKIPA T,(R)
	JRST EV3
	XOR T,SYM
	TLZ T,740000
	JUMPN T,EV3
	MOVE T,1(R)
	JRST CPOPJ1

EV4:	HLRE R,@SYMP
	MOVNS R
	ADD R,@SYMP
	AOJL S,EV1
	POPJ P,

EV2:	MOVE T,1(R)
	CAMGE T,BLVL
	JRST EV2A
EV2B:	SUB R,[XWD 2,2]
	ADDI S,1
	LDB T,[POINT 4,(R),3]
	CAIE T,3
	JRST EV2B
	JRST EV2
EV2A:	MOVEM T,BLVL
	JRST EV3

EV5:	MOVEI T,1
	MOVEM T,BLVL
	SKIPGE R,PRGM
	JRST EV1
	HLRE R,@SYMP
	MOVNS R
	ADD R,@SYMP
	JRST EV1

;BIT 40 - DELETE OUTPUT
; 20 - DELETE INPUT
; 10 - LOCAL
; 04 -GLOBAL
; NO BITS - PROGRAM NAME

TEXI:	PUSHJ P,TEXIN		;INPUT TEXT
	MOVEM T,SYL
	MOVEI W1,5
	MOVEI T-1,0
	PUSHJ P,TEXIN
	TLNE F,CCF	;WAS IT DOUBLE ALTMODE?
	JRST TEXI4	;PERMIT ALTMODE AS FIRST CHR
	CAIN T,33		;NEW ALT MODE, ESCAPE
	JRST QUAN2
TEXI4:	TLNN F,CCF
	JRST TEXI5
	MOVE R,WRD2
	CAIE R,7
	JRST SIXBIN
	JRST TEXI6
TEXI5:	TLNE F,CF
	JRST SIXBIN
	SKIPA
TEXI2:	PUSHJ P,TEXIN
TEXI6:	CAMN T,SYL
	SOJA W1,TEXI3
	ROT T,-7
	LSHC T-1,7
	SOJG W1,TEXI2
	TLNN F,CCF
	JRST TEXI2
	LSHC T-1,-43
	PUSH P,F
	TLZ F,CF
	TLO F,QF
	PUSHJ P,DEPRA	;DEPOSIT
	POP P,F
	AOS LLOCO
	MOVEI T-1,0
	MOVEI W1,5
	JRST TEXI2

TEXI3:	LSHC T-1,-43
	JUMPL W1,TEXI7
	JUMPL W1,QUAN1
	LSH T,7
	SOJA W1,.-2
TEXI7:	TLNN F,CCF
	JRST QUAN1
	LSHC T-1,-43
	PUSH P,F
	TLZ F,CF
	TLO F,QF
	PUSHJ P,DEPRA	;DEPOSIT
	POP P,F
	AOS LLOCO
	MOVEI T,0
	JRST QUAN1

BYTI:	TRZN F,Q2F
	JRST PERC	;JUST PERC IF NO ALTMODE
	SKIPN T,WRD2	;GET NUMBER OF BITS/BYTE
	JRST BYTIM	;IF ZERO THEN USE BYTE MASK
	MOVEM T,SVBTI	;SAVE
	SETZM SVBTI1	;ASSEMBLED WORD
	MOVEI T,=36	;TOTAL NUMBER OF BITS
	MOVEM T,SVBTI2
BYTI4:	MOVEI T+1,0	;READ IN NUMBER
BYTI3:	PUSHJ P,TEXIN	;NEXT CHR
	CAIN T,","	;SEPERATES BYTES
	JRST BYTI1
	CAIN T,33	;ALTMODE TERMINATES
	JRST BYTI2
	CAIL T,"0"	;CHECK FOR DIGIT
	CAILE T,"7"
	JRST ERR
	IMULI T+1,10
	ADDI T+1,-"0"(T)
	JRST BYTI3
BYTI1:	PUSHJ P,BYTI1A
	JRST BYTI4
BYTI1A:	MOVN T+2,SVBTI	;GET SIZE
	ROT T+1,(T+2)	;GET THAT MANY BITS INTO LEFT END
	MOVE T,SVBTI1	;NOW THE PARTIALLY ASSEMBLED WORD
	MOVE T+2,SVBTI	;SIZE
	CAMLE T+2,SVBTI2	;MORE THAN WE NEED?
	MOVE T+2,SVBTI2	;YES, TAKE SMALLER
	LSHC T,(T+2)	;SHIFT BITS IN
	MOVNS T+2	;UPDATE NUUMBER OF BITS STILL NEEDED
	ADDM T+2,SVBTI2
	MOVEM T,SVBTI1	;SAVE WORD
	POPJ P,
BYTI2:	PUSHJ P,BYTI1A
	MOVE T,SVBTI1	;GET WORD
	LSH T,@SVBTI2	;SHIFT REST OF WAY
	JRST QUAN1	;GO PUT IT AWAY
BYTIM:	MOVEI T,=36	;36 BITS TOTAL
	MOVEM T,SVBTI	;SAVE FOR INPUT CHECK
	SETZM SVBTI1	;BUILD WORD HERE
	MOVE T+2,BMASK	;GET MASK BITS
BYTIM1:	MOVEI T+1,0	;BUILD NUMBER
BYTIM2:	PUSHJ P,TEXIN	;GET CHARACTER
	CAIN T,","	;COMMA FOR SEPERATOR
	JRST BYTIM3
	CAIN T,33	;ALTMODE TERMINATES
	JRST BYTIM6
	CAIL T,"0"	;CHECK FOR VALID DIGIT
	CAILE T,"7"
	JRST ERR
	IMULI T+1,10
	ADDI T+1,-"0"(T)	;ACCUMULATE NUMBER
	JRST BYTIM2	;LOOP
BYTIM3:	PUSHJ P,BYTIM4	;GO PROCESS NUMBER
	JRST BYTIM1
BYTIM4:	SKIPG SVBTI	;ROOM FOR MORE?
	POPJ P,	;NO, QUIT
	SETZM SVBTI2	;COUNT NUMBER OF BITS THIS POSITION
	SKIPL T+2	;START WITH 1 BITS IN LEFT
	SETCA T+2,0	;COMPLIMENT
BYTIM5:	LSH T+2,1	;GET NEXT BIT
	ROT T+1,-1	;MOVE ANOTHHER BIT OF NUMBER TO LEFT END
	AOS SVBTI2	;SAVE COUNT
	SOSLE SVBTI	;CHECK TO SEE IF WORD FULL
	JUMPL T+2,BYTIM5	;NEXT BIT PART OF SAME FIELD?
	MOVE T,SVBTI1	;NO, GET WORD
	LSHC T,@SVBTI2	;SHIFT CORRECT NUMBER OF BITS
	MOVEM T,SVBTI1	;AND SAVE AGAIN
	POPJ P,		;RETURN

BYTIM6:	PUSHJ P,BYTIM4	;PROCESS LAST NUMBER TYPED
	MOVE T,SVBTI1	;GET WORD
	LSH T,@SVBTI	;FINISH  SHIFTING
	JRST QUAN1	;ALL DONE
SVBTI:	0
SVBTI1:	0
SVBTI2:	0
SIXBI1:	PUSHJ P,TEXIN    ; INPUT TEXT (SIXBIT)
SIXBIN:	CAMN T,SYL
	JRST SIXBI2
	ANDI T,77
	TRC T,40
	ROT T,-6
	LSHC T-1,6
	SOJGE W1,SIXBI1
	TLNN F,CCF
	JRST SIXBI1
	MOVE T,T-1
	PUSH P,F
	TLZ F,CF
	TLO F,QF
	PUSHJ P,DEPRA
	POP P,F
	AOS LLOCO
	MOVEI T-1,0
	MOVEI W1,5
	JRST SIXBI1
SIXBI2:	MOVE T,T-1
	JUMPL W1,QUAN1
	LSH T,6
	SOJA W1,.-2

KILL:	TLNN F,LTF		;DELETE SYMBOLS
	JRST ERR
	PUSHJ P,EVAL
	JRST KILL1
	MOVEI T,DELO/200000		;DELETE OUTPUT
	TLNE F,CCF
	MOVEI T,DELI/200000		;NO INPUT OR OUTPUT
	DPB T,[POINT 2,(R),1]	;LEFT 2 BITS IN SYMBOL
KILRET:	JRST RET		;USED AS A CONSTANT


KILL1:	MOVE R,ESTU		;REMOVE UNDEFINED SYMS
	JUMPGE R,UNDEF
KILL2:	PUSHJ P,EVAL0
	JRST RET
	PUSHJ P,REMUN
	JRST KILL2

REMUN:	MOVE S,[XWD 2,2]	;REMOVE ONE UNDEFINED SYMBOL
	ADDB S,ESTU
	MOVE W,-2(S)
	MOVEM W,(R)
	MOVE W,-1(S)
	MOVEM W,1(R)
	POPJ P,

TAG:	TLNN F,LTF   ; NO LETTERS IS ERROR
	JRST ERR   ; GO SAY ERROR
	TLNE F,FAF   ; DEFINE SYMBOLS
	JRST DEFIN		;A<B:
	TLNE F,CF		;DEFINE SYMBOL AS OPEN REGISTER
	JRST SETNAM
	MOVE W,LLOCO
	HRRZM W,DEFV

DEFIN:	PUSHJ P,EVAL
	JRST DEF1
	JRST DEF2		;NO, REDEFINE
DEF1:	MOVN R,[XWD 2,2]
	ADDB R,@SYMP	;MOVE UNDEFINED TABLE 2 REGISTERS
	HRRZ T,ESTU
	SUBI T,2
	HRL T,ESTU
	HRRM T,ESTU
	SKIPGE ESTU
	BLT T,-1(R)
DEF2:	MOVE T,DEFV
	MOVEM T,1(R)		;PUT IN NEW VALUE
	MOVSI T,GLOBAL
	IORB T,SYM
	MOVEM T,(R)		;PUT IN NEW SYM AS GLOBAL
	MOVE R,ESTU

DEF3:	JUMPGE R,RET		;PATCH IN VALUE FOR UNDEF SYM ENTRY
	MOVE T,SYM
	CAME T,(R)
	JRST DEF4
	MOVE S,DEFV
	SKIPGE 1(R)
	MOVN S,S
	PUSH P,R
	MOVE R,1(R)
	PUSHJ P,FETCH
	JRST ERR
	ADD S,T
	HRRM S,T
	PUSHJ P,DEP
	POP P,R
	PUSHJ P,REMUN
DEF4:	ADD R,[XWD 2,2]		;REMOVE THE NOW DEFINED SYMBOL
	JRST DEF3
SETNAM:	SYMTST
	MOVE R,@SYMP		;SET PROGRAM NAME - DOLLAR COLON
REPEAT 0,<SET1:	MOVE W,R
SET2:	JUMPGE R,UNDEF
	MOVE T,(R)
	ADD R,[XWD 2,2]
	TLNE T,PNAME
	JRST SET2
	CAME T,SYM
	JRST SET1
	MOVEM W,PRGM
	JRST RET>

SET1:	JUMPGE R,UNDEF
	MOVE T,(R)
	CAMN T,SYM
	JRST SET2
	ADD R,[XWD 2,2]
	JRST SET1
SET2:	MOVEM R,PRGM
	SETZM BLOCK
SET3:	CAMN R,@SYMP
	JRST RET
	SUB R,[XWD 2,2]
	LDB T,[POINT 4,(R),3]
	JUMPE T,RET
	CAIE T,3
	JRST SET3
	MOVE T,(R)
	XOR T,SYM
	TLZ T,740000
	JUMPN T,SET3
	JRST SBPRM

SETBLK:	TLNN F,LTF
	JRST ERR
	SKIPL R,PRGM
	JRST ERR
	SYMTST
SB1:	CAMN R,@SYMP
	JRST UNDEF
	SUB R,[XWD 2,2]
	LDB T,[POINT 4,(R),3]
	JUMPE T,UNDEF
	CAIE T,3
	JRST SB1
	MOVE T,(R)
	XOR T,SYM
	TLZ T,740000
	JUMPN T,SB1
	TLNE F,CF
	JRST SBPRM
	MOVEM R,TBLK
	JRST L1RPR
SBPRM:	MOVEM R,BLOCK
	JRST RET

MULT:	TLOA F,PTF+MLF		;*
DIVD:	TLO F,DVF+PTF		;SINGLE QUOTE
	JRST L1

ASSEM:	JRST PLUS		;#
MINUS:	TLO F,MF
PLUS:	TLO F,PTF
	JRST LIS2

LPRN:	CAML P,[XWD LPDL-4,0]	;LEFT PARENTHESIS
	JRST ERR
	PUSH P,F		;RECURSE FOR OPEN PAREN
	PUSH P,WRD
	PUSH P,FRASE
	PUSH P,FRASE1
	AOS PRNC
	JRST LIS

INDIRECT:	HRLZI W,20		;@
	IORB W,WRD
	TLO F,QF
	JRST LIS2

ACCF:	MOVE R,T		;COMMA
	TLOE F,COMF	;A COMMA SEEN, WAS IT SECOND?
	JRST ACCCF	;YES, GO PROCESS
	ADD T,WRD	;GET TOTAL
	HRRM T,ACCCF	;AND SAVE
	HLLZ T,R	;GET LEFT HALF BACK
	LSH R,27
	SKIPE IOTFLG	;IS THIS AN IOT?
	LSH R,1		;THEN SHIFT ONE MORE
	ADD T,R
	ADDB T,WRD
	JRST SPACE+1
ACCCF:	MOVSI T,0	;MODIFIED TO BE LEFT HALF ON ,,
	MOVEM T,WRD
	JRST SPACE+1	;AND GO

SPACE:	TLNE F,QF
	TLO F,TIF
SPAC1:	TLZ F,MF+PTF
	JRST LIS1
RPRN:	TLNN F,QF		;)
	MOVEI T,0
	MOVS T,T
	SOSGE PRNC
	JRST ERR
	POP P,FRASE1
	POP P,FRASE
	POP P,WRD
	POP P,F
	TLNE F,PTF
	TLNE F,SF
	JRST RPRN1
	MOVEM T,SYL
	TLO F,QF+SF
	JRST L1RPR
RPRN1:	ADDB T,WRD
	TLO F,QF
	JRST L1RPR-1
;REGISTER EXAMINATION LOGIC

LINEF:	PUSHJ P,DEPRA	;NEXT REGISTER
IFE EDDT&1,<PUSHJ P,CRNRB
	JRST .+2>
LI0:	PUSHJ P,CRF
	AOS T,LLOC
LI1:	HRRZS T
	HRRZM T,LLOC
	HRRZM T,LLOCO
	PUSHJ P,PAD
	MOVEI T,"/"
	TLNE F,STF
	MOVEI T,"!"
	PUSHJ P,TOUT
LI2:	TLZ F,ROF
	PUSHJ P,LCT
	MOVE R,LLOCO
	PUSHJ P,FETCH
	JRST ERR
	TLO F,ROF
	TLNE F,STF
	JRST DD2
	JRST CONSYM		;RETURN IS A POPJ

VARRW:	PUSHJ P,DEPRA		;↑
	PUSHJ P,CRF
	SOS T,LLOC
	JRST LI1

IFN UEDDTS,<			;IN UEDDT, DOWN ARROW (CNTL A) MEANS 
				;CARRIAGE RETURN, PLUS WRITE ON L'SCOPE
DARRW:	MOVE	R,LLOCO 	;PICK UP ADDRESS TO DEPOSIT
	SKIPE	SPCFLG		;HAVE WE BEEN REENTERED?
	CAML	R,SYSTOP	;IS THIS DEPOSIT WITHIN THE SYSTEM AREA?
	JRST	DARRW1		;NO.  DON'T PATCH THE DISK
	LSH	R,-5
	MOVEM	R,WCMA+2	;SAVE SECTOR ADDRESS
	MOVEI	R,40
	MOVEM	R,WCMA+1	;SAVE WORD COUNT
	MOVEI	R,FBDATA	;GET ADDRESS OF DATA AREA
	MOVEM	R,WCMA		;SAVE IT
	MOVEI	R,400100	;CHANGE THIS WHEN SYSTEM MOVES FROM BAND 100
	FBREAD	R,WCMA		;READ
	JRST	DARRRE		;OOPS.
	MOVE	R,LLOCO		;GET THE ADDRESS AGAIN
	ANDI	R,37		;GET DISPLACEMENT ONLY
	CAMN	T,FBDATA(R)	;SAME AS DISK?
	JRST	DARRW1		;YES. DON'T BOTHER TO WRITE
	MOVEM	T,FBDATA(R)	;SAVE DATA
	MOVEI	R,400100
	FBWRT	R,WCMA		;WRITE IT
	JRST	DARRWE		;OOPS
DARRW1:
	PUSHJ	P,DEPRA		;CLOSE REGISTER, ETC.
	JRST	DD1		;RETURN TO MAIN LOOP

DARRRE:	OUTSTR	[ASCIZ/
FAST BAND READ FAILED./]
	JRST	DARRE

DARRWE:	OUTSTR	[ASCIZ/
FAST BAND WRITE FAILED./]
DARRE:	OUTSTR	[ASCIZ/
WILL NOT STORE IN CORE EITHER./]
	JRST	DD1
;>DARRW←←ERR			;IN OTHER DDT'S DOWN ARROW IS AN ERROR

CARR:	PUSHJ P,DEPRA		;CLOSE REGISTER
	IFN EDDT&1,<JRST DD1>
	IFE EDDT&1,<JRST DD1.5>


OCON:	TROA F,LF1+CF1		;OPEN AS CONSTANT
OSYM:	TRZ F,CF1		;OPEN SYMBOLICALLY
	TROA F,LF1
SUPTYO:	TLOA F,STF		;SUPPRESS TYPEOUT
SLASH:	TLZ F,STF		;TYPE OUT REGISTER
	TLNN F,CF		;WAS $ USED?
	JRST SLAS2		;NO
	PUSHJ P,EFFECA		;TRY EFFECTIVE ADR
	JRST ERR		;WE LOST
SLAS2:	TLNN F,QF
	JRST SLAS1
	MOVE R,LLOC
	MOVEM R,SAVLOC	;SAVE FOR $CR ETC.
	HRRZM T,LLOC		;QUANTITY TYPED
SLAS1:	HRRZM T,LLOCO
	JRST LI2

ICON:	TLNN F,ROF	;REGISTER OPENED OR ERR
	JRST ERR
	PUSHJ P,DEPRS
	TLNN F,CF		;CHECK FOR ALTMODE
	JRST SLAS1
	PUSHJ P,EFFECA
	JRST ERR	;LOSE
	JRST SLAS1
LTAB:	MOVSS T		;SWAP HALVES FIRST
	CAIA		;DON'T DEPOSIT WITH SWAPPED HALVES
TAB:	PUSHJ P,DEPRS	;OPEN REGISTER OF Q
	TLNN F,CF
	JRST TAB1
	PUSHJ P,EFFECA
	JRST ERR
TAB1:	MOVEI T,-1(T)
	EXCH T,LLOC
	MOVEM T,SAVLOC		;AGAIN, SAVE IT
	HRROI T,700000
	PUSHJ P,TEXTT
	JRST LI0

DEPRA:	MOVE R,SAVLOC
	TLNE F,CF	;WAS THERE AN ALTMODE?
	EXCH R,LLOC	;RESTORE OLD LOC
	MOVEM R,SAVLOC	;AND SAVE THIS
	TLNE F,ROF		;IF REGISTER IS BEING CHANGED
	TLNN F,QF		;REMOVE ALL PREVIOUS UNDEFINED
	JRST DEPRS		;SYMBOL REFERENCES TO IT
	MOVE R,ESTU
	MOVEM W1,ESTU
DEPRA2:	JUMPGE R,DEPRS
	HRRZ W,1(R)
	CAMN W,LLOCO
	PUSHJ P,REMUN
	ADD R,[XWD 2,2]
	JRST DEPRA2

EQUAL:	TLNE F,CF	;IF $≡
	TRO F,EQF	;THEN REAL NUMERIC MODE
	TROA F,LF1+CF1		;=
PSYM:	TRZ F,CF1		;@
	TRO F,LF1
	PUSHJ P,CONSYM
	JRST RET

R50PNT:	LSH T,-36	;RADIX 50 SYMBOL PRINTER
	TRZ T,3
	PUSHJ P,TOC
	PUSHJ P,TSPC
	SETZM SVFB	;NO BLOCK NAME
	MOVEI W1,LWT	;SETUP FOR SPT
	JRST SPT

SIXBP:	MOVNI W2,6		;SIXBIT PRINTER
	MOVE W1,LWT
SIXBP1:	MOVEI T,0
	ROTC T,6
	ADDI T,40
	PUSHJ P,TOUT
	AOJL W2,SIXBP1
	POPJ P,
;MODE CONTROL SWITCHES

;SET JOB NUMBER TO EXAMINE
JOBSET:
IFE UEDDTS,<
	JRST ERR
>;IFE UEDDTS
IFN UEDDTS,<
	MOVE T,WRD2
	SKIPL T
	CAMLE T,400222		;LEGAL JOB NUMBER?
	JRST UNDEF		;NO
	MOVEM T,EXJOBN
	JUMPE T,[MOVEI R,37	;THIS IS EXEC JOBREL
		JRST .+1]
	MOVEI R,44		;THIS IS LOSER JOBREL
	PUSHJ P,FETCH
	SETZ T,			;NOT FOUND!!!
	MOVEM T,MEMSIZ		;THIS IS MAX LOC WE ARE LOOKING AT
	SKIPE EXJOBN		;FORCE SYSTEM SYMS IF LOOKING AT SYSTEM
	TLNN F,CCF		;DOES HE WANT LOSER SYMS?
	TDZA T,T		;NO
	SETO T,			;YES
	EXCH T,EXSYMS
	CAMN T,EXSYMS		;CHANGING MODE?
	JUMPE T,RET		;NO, IF STAYING WITH EXEC SYMS, NO RE-INIT
	PUSHJ P,COPSYM		;SETUP SYMBOLS!!!
	JRST DDTB		;FIXUP SYMS!
>;IFN UEDDTS

TEXO:	MOVEI R,TEXTT-HLFW	;$T ASSUME 7 BIT ASCII
	MOVE T,WRD2
	CAIN T,6		;CHECK FOR $6T
	MOVEI R,SIXBP-HLFW	;SET MODE SWITCH FOR SIXBIT
	CAIN T,5		;CHECK FOR $5T
	MOVEI R,R50PNT-HLFW	;SET MODE SWITCH FOR RADIX 50
	CAIN T,11		;CHECK FOR $9T
	MOVEI R,TEXTT9-HLFW	;SET MODE SWITCH FOR 9 BIT ASCII
HWRDS:	ADDI R,HLFW-TFLOT		;H
SFLOT:	ADDI R,TFLOT-PIN		;F
SYMBOL:	ADDI R,PIN-TOCC		;S
CON:	ADDI R,TOCC-FTOC		;C
UCON:	ADDI R,FTOC		;U
	HRRZ SCH,R
	JRST BASE1

RELA:	TRZE F,Q2F		;CHANGE ADDRESS MODE TO RELATIE
	JRST BASECH
	MOVEI R,PADSO-TOC
ABSA:	ADDI R,TOC		;A
	HRRZ AR,R
	JRST BASE1

BASECH:	MOVE T,WRD2		;$NR  CHANGE OUTPUT RADIX TO N, N>1
	CAIGE T,2
	JRST ERR
	HRRZ ODF,T
BASE1:	MOVS S,[XWD SCHM,SCH]
	TLNN F,CCF
	JRST LIS1
	BLT S,ODFM	;WITH $$, MAKE MODES PERMANENT
	JRST RET

SEMIC:	MOVEM T,LWT		;SEMICOLON TYPES IN CURRENT MODE
	JRST (SCH)
;GO AND EXECUTE LOGIC

STR:
GO:	HRLI T,254000             ;G
	TLOE F,QF
	JRST XEC0
	IFN EDDT&1,<	SKIPE T,STARTA>	;LOAD TAPE START ADDRESS
	IFE EDDT&1,<	HRR T,JOBSA>	;GET STARTING ADDRESS

XEC:	TLNN F,QF		;X
	JRST ERR
	JRST XEC0		;RETCH!!!

BREAKA:	PUSHJ P,REMOVB		;REMOVE BREAKPOINTS
BREAKB:	PUSHJ P,CHKSYM	;RESET PRGM AND BLOCK IF SYMBOLS MOVED
	SOS T,BCOM3
	HRRZS T			;GET ADDR OF BREAKPOINT JUST HIT
	SUBI T,B1ADR-4
	IDIVI T,4
	HRRM T,BREAK2	;WE WANT IT LATER
	MOVE W1,BRKNAM-1(T)	;GET THE RIGHT JUNK
	PUSHJ P,TEXT2		;AND PRINT
		;<<<<<<< THESE BALANCE THE >'S IN THE NEXT FEW LINES
	MOVSI W1,(<ASCIZ />/>)		;TYPE > FOR COND BREAK
	SKIPG @BCOM2		;TEST PROCEED COUNTER
	MOVSI W1,(<ASCIZ />>/>)	;TYPE >> FOR PROCEED COUNTER BREAK
	PUSHJ P,TEXT2
	MOVE T,BCOM
	HLLM T, SAVPI		;SAVE PROCESSOR FLAGS
	MOVEI T,-1(T)
	PUSHJ P,PAD		;TYPE PC AT BREAK
	HRRZ T,@BCOM3
	HRRM T,PROC0		;SETUP ADDRESS OF BREAK
	HLRZ T,@BCOM3
	JUMPE T,BREAK1		;TEST FOR REGISTER TO EXAMINE
	PUSHJ P,LCT		;PRINT TAB
	HLRZ T,@BCOM3
	PUSHJ P,LI1		;EXAMINE REGISTER C($NB)LEFT
BREAK1:	MOVSI S,400000
BREAK2:	ROT S,0	;WILL BE MODIFIED WITH BREAK NUM
	PUSHJ P,LISTEN		;DONT PROCEED IF TTY KEY HIT
	TDNN S,AUTOPI		;DONT PROCEED IF NOT AUTOMATIC
	JRST RETB		;DONT PROCEED
	MOVEI T,2	;COMPENSATE FOR SOS
	ADDB T,@BCOM2
	JUMPL T,PROCD1	;GO IF STILL LESS THAN
	ANDCAM S,AUTOPI	;TURN OFF AUTOPI
	JRST RETB	;AND BREAK

RADIX =10
BRKNAM:	FOR @% I←1,NBP
<	ASCII /$%I%B/
>
RADIX =8

PROCEDE: TLNE F,QF		;N$P	;PROCEED AT A BREAKPOINT
	JRST PROC3
	MOVEI T,1
	TLNE F,CCF	;IF $$P
	MOVSI T,200000	;THEN VERY LARGE COUNT
PROC3:	TLNE F,CCF	;IF AUTOPROC
	MOVNS T		;NEGATE
	MOVEM T,@BCOM2
	HRRZ R,BCOM3
	PUSHJ P,AUTOP
PROCD1:	PUSHJ P,CRF
	PUSHJ P,TTYLEV
PROC0:	HRRZI R,XEC1		;MODIFIED TO ADDR OF BREAKPOINT
	PUSHJ P,FETCH
	JRST BPLUP1		;ONLY GET HERE IF MEMORY SHRANK
	MOVEM T,LEAV
	PUSHJ P,INSRTB
	JRST PROC2

PROC2:	MOVEI W,100
	MOVEM W,TEM1		;SETUP MAX LOOP COUNT
	JRST IXCT5
IXCT4:	IFE EDDT&1,<	SUBI T,041
	JUMPE T,IINIT
	AOJGE T,IXCT6>				;DONT PROCEDE FOR INIT
				;DONT INTERPRET FOR SYSTEM UUOS
	MOVEM R,40		;INTERPRET FOR NON-SYSTEM UUOS
	MOVEI R,41
IXCT:	SOSL TEM1
	PUSHJ P,FETCH
	JRST BPLUP		;BREAKPOINT LOOPING OR FETCH FAILED
	MOVEM T,LEAV
IXCT5:	IFN EDDT&1,<
	LDB T,[POINT 9,LEAV,8]	;GET INSTRUCTION
	CAIN T,254		;DON'T DO ANYTHING TO JRST IN EXEC MODE
	JRST IXCT6>
	HRLZI 17,AC0
	BLT 17,17
	MOVEI T,@LEAV
	DPB T,[POINT 23,LEAV,35]	;STORE EFFECTIVE ADDRESS
	LDB W1,[POINT 4,LEAV,12]	;PICK UP AC FIELD
	LDB T,[POINT 9,LEAV,8]		;PICK UP INSTRUCTION FIELD
	MOVEI P,PS
	CAIN T,260
	JRST  IPUSHJ		;INTERPRET PUSHJ

	CAIN T,264
	JRST IJSR		;INTERPRET JSR
	CAIN T,265
	JRST IJSP		;INTERPRET JSP
	CAIN T,266
	JRST IJSA		;INTERPRET JSA
	MOVE R,LEAV
	TRNN T,700
	JRST IXCT4		;INTERPRET UUO
	CAIN T,256
	JRST IXCT		;INTERPRET XCT

IXCT6:	MOVE W,LEAV	;FOR RESTORE TO XCT
	MOVEI T,@BCOM	;GET RETURN ADR
	JRST RESTORE


BPLUP:	PUSHJ P,REMOVB		;BREAKPOINT PROCEED ERROR
BPLUP1:	JSR SAVE
	JFCL
	JRST ERR

IFE EDDT&1,<IINIT:	MOVE T,LEAV
	MOVEM T,INITL	;SET UP TO DO THE INIT HERE
	MOVEI R,@BCOM	;THE LOC OF INIT+1
	PUSHJ P,FETCH
	JRST BPLUP
	MOVEM T,INITL+1
	ADDI R,1
	PUSHJ P,FETCH
	JRST BPLUP
	MOVEM T,INITL+2
	MOVEI T,2
	ADDM T,BCOM	;INCREMENT RETURN ADR
INITL:	0
	0
	0
	SKIPA
	AOS BCOM
	MOVEI T,@BCOM	;GET RETURN ADR
	JRST IJSR4	;AND MAKE LIKE A JSR>
IPUSHJ:	DPB W1,[POINT 4,CPUSHP,12]	;STORE AC FIELD INTO A PUSH
	SETZM TEM3
	MOVE W,CPUSHP		;GET A PUSH INSTR
	MOVE T,LEAV
	JRST RESTR1

CPUSHP:	PUSH

IJSA:	MOVE T,BCOM		;INTERPRET JSA
	HRL T,LEAV
	EXCH T,AC0(W1)
	JRST IJSR2

IJSR:	MOVE T,BCOM		;INTERPRET JSR
	HLL T,SAVPI
IJSR2:	MOVE R,LEAV
	PUSHJ P,DEP
	AOSA T,LEAV
IJSR3:	MOVE T,LEAV
IJSR4:	MOVSI W,(<JFCL>)
	JRST RESTORE

IJSP:	MOVE W,BCOM		;INTERPRET JSP
	HLL T,SAVPI
	MOVEM W,AC0(W1)
	JRST IJSR3

;INSERT BREAKPOINTS

INSRTB:	MOVE S,[JSR BP1]
INSRT1:	SKIPE R,B1ADR-BP1(S)
	PUSHJ P,FETCH
	JRST INSRT3
	MOVEM T,B1INS-BP1(S)
	MOVE T,S
	PUSHJ P,DEP
INSRT3:	ADDI S,4
	CAMG S,[JSR BPN]
	JRST INSRT1
	POPJ P,

;REMOVE BREAKPOINTS

REMOVB:	MOVEI S,BNADR
REMOV1:	MOVE T,B1INS-B1ADR(S)
	SKIPE R,(S)
	PUSHJ P,DEP
	SUBI S,4
	CAIL S,B1ADR
	JRST REMOV1
	IFN EDDT&1,<JRST TTYRET>
	IFE EDDT&1,<POPJ P,>

;IN EXEC MODE, SAVE UP TTY STATUS
;IN USER MODE, DONE BY SAVE
;ALL $B COMMANDS OF FORM <A>$<N>B

BPS:	TLZE F,QF
	JRST BPS1
	TRZE F,Q2F
	JRST BPS2
	MOVE T,[XWD B1ADR,B1ADR+1]
	SETZM  B1ADR
	BLT T,AUTOPI	;CLEAR OUT ALL BREAKPOINTS AND AUTO PROCEDE REGESTER
	JRST RET

BPS1:	TRZN F,Q2F
	JRST BPS3
	MOVE R,T
	TRO F,2
BPS2:	MOVE T,WRD2
	CAIL T,1
	CAILE T,NBP
	JRST ERR
	IMULI T,4
	ADDI T,B1ADR-4
	TRZN F,ITF
	JRST MASK2
	EXCH R,T
	JRST BPS5

BPS3:	MOVEI R,B1ADR		;PROCESS THE A$B
BPS4:	HRRZ W,(R)
	CAIE W,(T)
	SKIPN (R)
	JRST BPS5
	ADDI R,4
	CAIG R,BNADR
	JRST BPS4
	JRST ERR
BPS5:	MOVEM T,(R)
	SETZM 1(R)
	SETZM 2(R)
	SETZM 3(R)
IFN EDDT&20,<
	CONSO APR,MAOFF		;WHICH INST SHALL WE USE?
	SKIPA S,[CONSZ APR,MAOFF]
	MOVE S,[CONSO APR,MAOFF]
	MOVEM S,B1SKP-B1ADR(R)	;MAKE BREAK POINTS CONDITIONAL!
>
AUTOP:	SUBI R,B1ADR		;AOUT PROCEED SETUP
	IDIVI R,4
	MOVEI S,1
	LSH S,(R)
	ANDCAM S,AUTOPI
	TLNE F,CCF
	IORM S,AUTOPI
	POPJ P,

;FETCH AND DEPOSIT INTO MEMORY


DEPRS:	MOVEM T,LWT		;DEPOSIT REGISTER AND SAVE AS LWT
	MOVE R,LLOCO	;QUAN TYPED IN REGIS EXAM
	TLZE F,ROF
	TLNN F,QF
	POPJ P,0
DEP:	TRNN R,777760
	JRST DEP1
IFE UEDDTS,<IFE EDDT&1,<
	TRNE R,400000
	SKIPA W,JOBHRL
	MOVE W,JOBREL
	HRRZS W		>
IFN EDDT&1,<
	IFN FTDSWP,<
		PUSHJ P,SWPDEP
		POPJ P,		;DEPOSIT DONE, OR LOST!
	>
	HRRZ W,JOBREL>
	CAILE W,(R)
	MOVEM T,0(R)>

IFN UEDDTS,<
	SKIPE	EXJOBN		;EX-DEP IN JOB??
	POPJ	P,		;YES, LOSE
	CAMG	R,MEMSIZ	;ADDRESS IN BOUNDS?
	SKIPN	SPCFLG		;YES. HAS PROGRAM BEEN REENTERED?
	POPJ	P,		;ILLEGAL ADDRESS OR NOT REENTERED,
	MOVEM	T,SPCWRD	;SAVE DATA FOR SPACEWAR
	MOVEM	R,SPCADR	;SAVE ADDRESS FOR SPACEWAR
	SPCWAR	0,DDTSPC	;ZERO TIC'S WILL DO
	SKIPE	SPCADR		;WAIT FOR SPACEWAR
	JRST	.-1
>
	POPJ P,0
DEP1:	MOVEM T,AC0(R)
	POPJ P,0

FETCH:
IFE UEDDTS,<
IFE EDDT&1,<
	TRNE R,400000
	SKIPA T,JOBHRL
	MOVE T,JOBREL
	HRRZS T
>;IFE EDDT&1
IFN EDDT&1,<
IFN FTDSWP,<
	PUSHJ P,SWPEXM
	JRST CPOPJ1		;EXAMINE DONE, OR LOST
	JRST CPOPJ1		;DISK REF FAILED!
>;IFN FTDSWP
	HRRZ T,JOBREL
>;IFN EDDT&1
	CAIGE T,(R)
	POPJ P,
	TRNN R,777760
	SKIPA T,AC0(R)
	MOVE T,(R)
	JRST CPOPJ1
>;IFE UEDDTS

IFN UEDDTS,<
	SKIPE EXJOBN		;EXAMINING JOB?
	JRST JEXM		;YES, DO IT!
	MOVEI T,@PROFF
	CAMLE T,PRMAX
	JRST [	HRRZ T,R
		CAMLE T,MEMSIZ
		POPJ P,
		PUSHJ P,PRSET
		JRST FETCH]
	MOVE T,400000(T)
	JRST CPOPJ1

JEXM:	TRNE R,777760		;AC?
	JRST JEXM1
	MOVE T,[-1,,JOBPC↑]	;GET PC WORD
	MOVEM T,EXJOBN+1
	MOVEI T,EXJOBN
	JOBRD T,
	POPJ P,			;LOSE
	MOVE T,EXJWRD		;GET LOSERS PC
	TLNE T,10000		;USRMOD?
	ADDI R,20		;YES, AC'S ARE REALLY HERE
JEXM1:	HRRM R,EXJOBN+1
	MOVNI T,1
	HRLM T,EXJOBN+1		;IN CASE WE HAD AN ERROR PREVIOUSLY
	MOVEI T,EXJOBN
	JOBRD T,		;EXAMINE LOSER CORE
	POPJ P,			;LOSE
	MOVE T,EXJWRD
	JRST CPOPJ1
>;IFN UEDDTS
FIRARG:	MOVEM T,DEFV
	TLO F,FAF
	JRST ULIM1
ULIM:	TLO F,SAF
	HRRZM T,ULIMIT
ULIM1:	TLNN F,QF
	JRST ERR
	JRST LIS0


REPEAT 0,<LOOK:	SKIPL R,PRGM	;LOOK UP SYMBOL
	MOVE R,@SYMP
	HLRE S,@SYMP
	ASH S,-1	;SETUP COUNT FOR LENGTH OF SYM TABLE
	TLZ F,400000
	HRLZI W2,DELO+DELI
	MOVEM T,TEMDDT

LOOK1:	TDNE W2,(R)
	JRST LOOK3
	MOVE T,(R)
	TLNN T,PNAME	;NAME
	TLOA W2,LOCAL
	SKIPA T,TEMDDT
	JRST LOOK3
	MOVE W,1(R)
	XOR W,T
	JUMPL W,LOOK3
	SUB T,1(R)
	JUMPL T,LOOK3
	JUMPGE F,LOOK2
	MOVE W,1(R)
	SUB W,1(W1)
	JUMPLE W,LOOK3
LOOK2:	HRR W1,R		;POINTER BEST VALUE SO FAR
	TLO F,400000
	JUMPE T,SPT0
LOOK3:	ADD R,[XWD 2,2]
	SKIPL R
	MOVE R, @SYMP
	AOJLE S,LOOK1	;TERMINATING CONDITION
	MOVE T,TEMDDT
	TLNE F,400000
	SUB T,1(W1)
	JRST CPOPJ1>
LOOK:	SETZM SVFB
	SETZM SVTB
	SETZM BLVL
	SYMTST
	HLRE S,@SYMP
	ASH S,-1
	TLZ F,600000
	MOVEM F,SVF
	HRLZI W2,DELO+DELI
	MOVEM T,TEMDDT
	SKIPL R,PRGM
	JRST TOPDWD
LOOK1:	SUB R,[XWD 2,2]
	TDNE W2,(R)
	JRST LOOK3
	LDB T,[POINT 4,(R),3]
	CAIN T,3
	JRST BLNME
	JUMPE T,PNAM
	MOVE T,TEMDDT
	MOVE W,1(R)
	XOR W,T
	JUMPL W,LOOK3
	SUB T,1(R)
	JUMPL T,LOOK3
	JUMPGE F,LOOK2
	MOVE W,1(R)
	SUB W,1(W1)
	JUMPLE W,LOOK3
LOOK2:	HRR W1,R
	TLO F,400000
	TLNE F,200000
	JRST LOOK2A
	MOVE W,SVTB
	MOVEM W,SVFB
LOOK2A:	TLNE W2,LOCAL
	SETZM SVFB
	JUMPE T,LOOK4
LOOK3:	CAMN R,@SYMP
	JRST TOPDWN
LOOK3A:	AOJLE S,LOOK1
	MOVE T,TEMDDT
	TLNE F,400000
	SUB T,1(W1)
	JUMPE T,SPT0
	JRST CPOPJ1

TOPDWD:	TLO W2,LOCAL
TOPDWN:	HLRE R,@SYMP
	MOVNS R
	ADD R,@SYMP
	JRST LOOK3A

BLNME:	MOVEM R,SVTB
	MOVE T,1(R)
	CAMN R,BLOCK
	JRST BLNM1
	CAML T,BLVL
	JRST BLNM2
BLNM1:	MOVEM T,BLVL
	TLNE F,200000
	JRST LOOK3
	EXCH F,SVF
	EXCH W1,SW1
	TLO F,200000
	JRST LOOK3

BLNM2:	TLNN F,200000
	JRST LOOK3
PNAM1:	EXCH F,SVF
	EXCH W1,SW1
	JRST LOOK3

PNAM:	TLO W2,LOCAL
	TLNN F,200000
	JRST LOOK3
	JUMPGE F,LOOK5
	MOVE F,SVF
	JUMPGE F,PNAM2
	MOVE T,1(W1)
	EXCH W1,SW1
	CAMGE T,1(W1)
	JRST LOOK5A
	MOVE W1,SW1
PNAM2:	SETZM SVFB
	TLO F,400000
	TLZ F,200000
	JRST LOOK3

LOOK4:	TLZN F,200000
	JRST LOOK3
	SETZM SVFB
	JRST SPT0

LOOK5:	EXCH F,SVF
	EXCH W1,SW1
LOOK5A:	MOVE T,1(W1)
	CAMN T,TEMDDT
	JRST SPT0
	JRST LOOK3
CONSYM:	MOVEM T,LWT
	TRNN F,LF1
	JRST (SCH)		;PIN OR FTOC
	TRNE F,CF1
	JRST  FTOC

LFPIN:	JFCL
RFPIN:	JFCL		;FOR L AND V MODES (JUST SO THEY ARE NOT PIN)
PIN:				;PRINT INSTRUCTION
	TLC T,700000
	TLCN T,700000
	JRST INOUT		;IN-OUT INSTRUCTION OR NEG NUM
	AND T,[XWD 777000,0]
	JUMPE T,HLFW
	PUSHJ P,OPTYPE
PIN1:	MOVSI	T,777000
	AND 	T,LWT
	TRNN F,ITF		;HAS INSTRUCTION BEEN TYPED?
	PUSHJ P,LOOK		;NO, LOOK IN SYMBOL TABLE
	TROA F,NAF		;INSTRUCTION TYPED, ALOOW NEG ADDRESSES
	JRST HLFW		;NOT FOUND, OUTPUT AS HALFWORDS
	PUSHJ P,TSPC
	LDB T,[XWD 270400,LWT]	;GET AC FIELD
	JUMPE T,PI4
	PUSHJ P,PAD
PI3A:	MOVEI W1,","
	PUSHJ P,TEXT
PI4:	MOVE W1,LWT
	MOVEI T,"@"
	TLNE W1,20		;CHECK FOR INDIRECT BIT
	PUSHJ P,TOUT
	HRRZ T,LWT
	LDB W,[XWD 331100,LWT]	;INSTRUCTION BITS
	CAIL W,240
	CAILE W,247
	JRST PI8
	TLNN W1,20	;INDIRECT
	CAIN W,<JFFO>⊗-33
	JRST PI8	;AND JFFO GET SYMBOLIC
	PUSHJ P,PADS3A
PI7:	TRZ F,NAF	
	LDB R,[XWD 220400,LWT]	;INDEX REGISTER CHECK
	JUMPE R,PADS1		;EXIT
	MOVEI T,"("
	PUSHJ P,TOUT
	MOVE T,R
	PUSHJ P,PAD
	MOVEI T,")"
	JRST TOUT		;EXIT

PI8:	CAIN SCH,LFPIN	;IN ONE OF THE SPECIAL MODES?
	JRST LFFLG
	CAIN SCH,RFPIN
	JRST RFFLG
PI8A:	PUSHJ P,PAD
	JRST PI7

HLFW:	;PRINT AS HALF WORDS
	HLRZ T,LWT
	JUMPE T,HLFW1
	TRO F,NAF	;ALLOW NEGATIVE
	PUSHJ P,PAD
	MOVSI W1,(<ASCII /,,/>)
	PUSHJ P,TEXT2
HLFW1:	HRRZ T,LWT

PAD:	;PRINT ADDRESS
	JRST (AR)		;PADSO OR PAD1
PADSO:	JUMPE T,TOC2+1
	PUSHJ P,LOOK
PADS1:	POPJ P,0
	MOVE W2,1(W1)
	CAMGE T,MXINC
	CAIGE W2,60
	JRST PADS3
	MOVEM T,TEMDDT
	JUMPGE F,PAD1
	PUSHJ P,SPT0
	MOVEI T,"+"
PADS1A:	PUSHJ P,TOUT
	HRRZ T,TEMDDT
PAD1:	JRST TOC		;EXIT

PADS3:	MOVE T,TEMDDT
PADS3A:	TRNE F,NAF
	CAIGE T,776000
	JRST TOC
PADS3B:	MOVNM T,TEMDDT
	MOVEI T,"-"
	JRST PADS1A

INOUT:	TLC T,-1	;IS IT PERHAPS NEGATIVE
	TLCN T,-1
	JRST PADS3B
	TLC T,777000
	TLCN T,777000	;THIS IS ALMOST AS GOOD
	JRST HLFW	;PRINT AS A HALF WORD
	MOVSI R,-IOTLG	;GET LENGTH OF IOT DEVICE TABLE
	LDB W2,[POINT 7,T,9]	;GET DEVICE NUMBER
	LSH W2,2
CKIOT:	CAMN W2,IOTBL(R)	;THERE?
	JRST ISIOT	;YES
	AOBJN R,CKIOT
	JRST PIN1	;PRINT AS AN INSTRUCTION
ISIOT:	LDB R,[POINT 3,T,12]
	DPB R,[POINT 6,T,8]	;MOVE IO BITS OVER FOR OP DECODER
	PUSHJ P,OPTYPE
	PUSHJ P,TSPC
	LDB T,[POINT 7,LWT,9]
	JUMPE T,INOU1
	LSH T,2
IFN EDDT&1!UEDDTS,<	MOVSI W1,-IOTB2L	;GET NAME TABLE LENGTH
IOTLK:	MOVE W,IOTB2(W1)	;GET NAME AND NUMBER
	ANDI W,177	;MASK FOR NUMBER
	LSH W,2		;SHIFT DEVICE NUMBER BACK TO COMPARE
	CAMN T,W
	JRST IOTFD	;GOODY WE FOUND THE NUMBER
	AOBJN W1,IOTLK	;GO LOOK SOME MORE>
	PUSHJ P,LOOK		;LOOK FOR DEVICE NUMBER
	JRST PI3A
	MOVE T,TEMDDT
	PUSHJ P,TOC
	JRST PI3A
IFE EDDT&1!UEDDTS,<INOU1:	JRST PI4>
IFN EDDT&1!UEDDTS,<IOTFD:	MOVE W1,IOTB2(W1)	;GET NAME AND NUMBER
	TRZA W1,177	;MASK OUT NUMBER AND PRINT
INOU1:	MOVE W1,[ASCII /APR/]
	PUSHJ P,TEXT2
	JRST PI3A

DEFINE XQ (A,B)
<<ASCII /A/>!<B⊗-2>
>
IOTB2:
DEVICES
IOTB2L←.-IOTB2>
MASK:	TLNE F,QF
	JRST MASK1
	MOVEI T,MSK
MASK2:	MOVEI W,1
	MOVEM W,FRASE1
	JRST QUAN1
MASK1:	MOVEM T,MSK
	JRST RET

EFFEC:	TLO F,LTF
	HRRZ T,T
WORD:	MOVEI R,322000-326000	;JUMPE-JUMPN
NWORD:	ADDI R,326000+40*T	;JUMPN T,
	HRLM R,SEAR2

	TLZN F,QF
	JRST ERR
	SETCAM T,WRD
	MOVSI T,FRASE-DENDDT-1		;PREVENT TYPE OUT OF DDT PARTS
	SETCMM FRASE(T)
	AOBJN T,.-1
	MOVE T,ULIMIT
	TLNE F,SAF
	TLO F,QF
	PUSHJ P,SETUP1
	PUSHJ P,CRF
SEAR1:	PUSHJ P,FETCH
	JRST SEAR2A
	TLNE F,LTF	;CHECK FOR EFFECTIVE ADDRESS SEARCH
	JRST EFFEC0
	EQV T,WRD
	AND T,MSK
SEAR2:	JUMPE T,SEAR3		;OR JUMPN T
SEAR2A:	PUSHJ P,LISTEN	;QUIT ON TELETYPE
	CAIA
	JRST SEAR2B
	CAMN R,[-1]	;LOSING AOBJN WILL SCREW THIS UP!!!!
	JRST SEAR2B	;END
	AOBJN R,SEAR1
	TLNE R,777777	;DID IT JUST GET TO 0 OR IS IT LARGER THAN 128K?
	JRST SEAR1	;BIG SEARCH
SEAR2B:	SETCMM LWT
	JRST DD1
SEAR3:	PUSHJ P,FETCH
	JRST ERR
	TLZ F,STF	;TURN OFF SUPRESS OUTPUT
	MOVEM R,TEM2
	MOVEM R,T
	PUSHJ P,LI1
	PUSHJ P,CRF
	SETCMM LWT
	SETCMM TEMDDT
SEAR4:	MOVE R,TEM2
	JRST  SEAR2A

EFFEC0:	TLNE F,CCF	;DOUBLE ALTMODE?
	JRST EFFECR	;YES, NO @() CHECK -- RPH 5-12-73
	MOVEM R,TEM2
	PUSHJ P,EFFECA
	JRST SEAR4	;LOST ON EFF ADR CALC
	MOVE R,TEM2
EFFECR:	EQV T,WRD
	ANDI T,777777
	JRST SEAR2
EFFECA:	MOVEI W,100
	MOVEM W,TEMDDT
EFFEC1:	MOVE W,T
	LDB R,[POINT 4,T,17]	;GET IR FIELD
	JUMPE R,EFFEC2
	HRRZ T,AC0(R)
	ADD T,W
EFFEC2:	HRR R,T
	TLNN W,20		;INDIRECT BIT CHECK
	JRST EFFEC3
	SOSE TEMDDT
	PUSHJ P,FETCH
	POPJ P,		;ERROR RETURN
	JRST EFFEC1
EFFEC3:	HRRZS T		;HALFWORD ONLY
	JRST CPOPJ1	;SKIP RETURN

SETUP:	TROA F,R20F	;FOR ZERO ONLY
SETUP1:	TRZ F,R20F
	TLNN F,SAF
IFE UEDDTS,<MOVE T,JOBREL>
IFN UEDDTS,{MOVE T,MEMSIZ	;SYSTEM JOBREL PTR.}
	HLLI	T,
	MOVEM T,ULIMIT
IFE UEDDTS,<CAMLE T,JOBREL>
IFN UEDDTS,{CAMLE T,MEMSIZ}
	JRST ERR
	HRRZ R,DEFV
	TLNN F,FAF
	MOVEI R,0
	CAML R,ULIMIT
	JRST ERR
	MOVEM R,DEFV
	MOVEI W,-1(R)			;RPH 3-17-72
	SUB W,ULIMIT
	HRLM W,R
	POPJ P,0

ZERO:	TLNN F,CCF
	JRST ERR
	MOVE W2,T
	TLNN F,QF
	MOVEI W2,0
	HRRZ T,ULIMIT
	PUSHJ P,SETUP
ZERO1:	TRNE R,777760
	JRST ZERO2
	MOVEM W2,AC0(R)
	AOBJN R,ZERO1
	JRST DD1
ZERO2:	HRRZ R, R
	CAIGE R,ZLOW
	MOVEI R,ZLOW		;DON'T ZERO 20-ZLOW
	HRRZ S,T
	CAIL S, DDT
	MOVEI S, DDT 
	CAMLE S,R
	JSP W,ZEROR
	HRRZ R,R
	CAIG R, DDTEND  ; DON'T ZERO OUT
	MOVEI R, DDTEND  ; DDT
	HRRZ S,T
	CAMLE S, R
	JSP W,ZEROR
	JRST DD1

ZEROR:	HRL R,R
	MOVEM W2,(R)
	ADDI  R, 1
	BLT R, -1(S)
	JRST (W)

TOCC:	TRO F,EQF	;SET TO REAL NUMERIC MODE
FTOC:
TOC:	HRRZ W1,ODF
	CAIN W1,12
	JRST  TOC4
	TRZE F,EQF
	JRST TOCA
	CAIN W1,10
	TLNN T,-1	;IF RADIX NOT 10, OR LEFT HALF EMPTY
	JRST TOCA	;PRINT
	HRRM T,TOCS	;SAVE RIGHT HALF
	HLRZS T
	PUSHJ P,TOCA	;PRINT LEFT HALF
	MOVSI W1,(<ASCII /,,/>)
	PUSHJ P,TEXT2
TOCS:	MOVEI T,0	;MODIFIED TO HAVE RIGHT HALF
TOCA:	LSHC T,-43
	LSH W1,-1		;W1=T+1
TOC1:	DIVI T,(ODF)
	HRLM W1,0(P)
TOC3:	JUMPE T,TOC2
	PUSHJ P,TOCA
TOC2:	HLRZ T,0(P)
	ADDI T,"0"
	JRST TOUT	;DOES POPJ TO TOC2 OR EXIT

TOC4:	MOVM W1,T
	JUMPGE T,TOC5
	MOVEI T,"-"
	PUSHJ P,TOUT
TOC5:	MOVEI T,0
	PUSHJ P,TOC1
TOC6:	MOVEI T,"."
	JRST TOUT

SPT0:	HRRZM W1,SPSAV		;SAVE POINTER TO TYPED SYM
SPT:	;RADIX 50 SYMBOL PRINT
	MOVE T,SVFB
	JUMPE T,SPT1W
	CAMN T,BLOCK
	JRST SPT1W
	PUSH P,W1
	LDB T,[POINT 32,(T),35]
	PUSHJ P,SPT1
	MOVEI T,"&"
	PUSHJ P,TOUT
	POP P,W1
SPT1W:	LDB T,[POINT 32,(W1),35]	;GET SYMBOL
SPT1:	IDIVI T,50
	HRLM W1,0(P)
	JUMPE T,SPT2
	PUSHJ P,SPT1
SPT2:	HLRZ T,0(P)
	JUMPE T,CPOPJ		;FLUSH NULL CHARACTERS
	ADDI T,260-1
	CAILE T,271
	ADDI T,301-272
	CAILE T,332
	SUBI T,334-244
	CAIN T,243
SPT3:	MOVEI T,256
	JRST TOUT

SYMD:	MOVEI T,DELO/200000	;$D ;DELETE LAST SYM & PRINT NEW
	HRRZ R,SPSAV		;PICK UP POINTER TO LAST SYM
	JUMPE R,ERR
	DPB T,[POINT 2,(R),1]	;STORE SEMI-DELETE BITS IN SYMBOL
	MOVE T,LWT
	JRST CONSYM		;PRINT OUT NEXT BEST SYMBOL

;THESE 2 ARE HERE BECAUSE SWAPPING DDT DOESN'T SAVE THE
;UNDEFINED SYMBOL TABLE!!!!!!!
ESTU:	0
ESTUT:	0
;FLOATING POINT OUTPUT

TFLOT:	MOVE A,T
	JUMPG A, TFLOT1
	JUMPE A,FP1A
	MOVNS A
	MOVEI T,"-"
	PUSHJ P,TOUT
	TLZE A,400000
	JRST FP1A
TFLOT1:	
	TLNN A, 400
	JRST FP7A	;UNNORMALIZED FLOATING PRINT AS DECIMAL

FP1:	MOVEI B,0
	CAMGE A,FT01
	JRST FP4
	CAML A,FT8
	AOJA B,FP4
FP1A:	MOVEI C,0

FP3:	MULI A,400
	ASHC B,-243(A)
	MOVE A,B
	SETZM TEM1
	PUSHJ P,FP7
	PUSHJ P,TOC6		;PRINT DECIMAL POINT
	MOVNI A,10
	ADD A,TEM1
	MOVE W1,C
FP3A:	MOVE T,W1
	MULI T,12
	PUSHJ P,FP7B
	SKIPE W1
	AOJL A,FP3A
	POPJ P,

FP4:	MOVNI C,6
	MOVEI W2,0
FP4A:	ASH W2,1
	XCT FCP(B)
	JRST FP4B
	FMPR A,@FCP+1(B)
	IORI W2,1
FP4B:	AOJN C,FP4A
	PUSH P,FSGN(B)
	PUSHJ P,FP3
	POP P,W1
	MOVE A,W2
	PUSHJ P,TEXT
FP7:	JUMPE A,FP7A2
	IDIVI A,12
	AOS TEM1
	HRLM B,(P)
	JUMPE A,FP7A1
	PUSHJ P,FP7
FP7A1:	HLRZ T,(P)
FP7B:	ADDI T,260
	JRST TOUT
FP7A:	PUSHJ P,FP7
	MOVEI T,"."
	JRST TOUT	;PRINT WITH A .
FP7A2:	MOVEI T,"0"
	JRST TOUT

	353473426555	;1.0E32
	266434157116	;1.0E16
FT8:	233575360400	;1.0E8
	216470400000	;1.0E4
	207620000000	;1.0E2
	204500000000	;1.0E1
FT:	201400000000	;1.0E0
	026637304365	;1.0E-32
	113715126246	;1.0E-16
	146527461671	;1.0E-8
	163643334273	;1.0E-4
	172507534122	;1.0E-2
FT01:	175631463146	;1.0E-1
FT0←←FT01+1

FCP:	CAMLE A, FT0(C)
	CAMGE A, FT(C)
	XWD C,FT0

FSGN:	ASCII .E-.
	ASCII .E+.

TEXTT:	MOVE W1,T
TEXT:	TLNN W1,774000		;LEFT JUSTIFIED UNLESS LEFT CHAR IS NULL
	LSH W1,35
TEXT2:	MOVEI T,0
	LSHC T,7
	CAILE T,04		;EOT
	PUSHJ P,TOUT
	JUMPN W1,TEXT2
	POPJ P,

;RPH 7-29-72  TYPE OUT TTY INPUT BUFFERS
TEXTT9:	MOVE W1,T
TEXTT0:	MOVEI T,0
	LSHC T,11
	PUSH P,T
	LSH T,-7
	PUSH P,T
	SKIPA T,["↑"]
	PUSHJ P,TOUT
	SOSL (P)
	JRST .-2
	POP P,(P)
	POP P,T
	ANDI T,177
	SKIPE T
	PUSHJ P,TOUT
	JUMPN W1,TEXTT0
	POPJ P,
IFN EDDT&1&<EDDT>B36,<


PSR:	TLNN F,ROF
	JRST ERR
	MOVEM T,LWT
	PUSHJ P,DEPRS
	HRRZM R,DEFV		;R CONTAINS LLOCO
	MOVE T,R
	JRST PUN2

PUNCH:	TLC F,FAF+QF
	TLCE F,FAF+QF
	JRST ERR		;ONE ARGUMENT MISSING
PUN2:	ADDI T,1
	HRRZM T,TEM1
	SUB T,DEFV
	JUMPLE T,ERR

PUN1:	MOVEI T,10
	PUSHJ P,FEED
	HRRZ R,DEFV
	IORI R,37
	ADDI R,1
	CAMLE R,TEM1
	MOVE R,TEM1
	EXCH R,DEFV
	MOVE T,R
	SUB T,DEFV
	HRL R,T
	JUMPGE R,RET		;EXIT OR PUNCH

PBLK:	MOVE T,R
	SOS W,T
	PUSHJ P,PWRD
PBLK1:	PUSHJ P,FETCH
	JRST ERR
	ADD W,T
	PUSHJ P,PWRD
	AOBJN R,PBLK1
	MOVE T,W
	PUSHJ P,PWRD
	JRST PUN1

>
IFN EDDT&1&<EDDT>B36,<


LOADER:	TLNE F,QF
	JRST ERR
	MOVEI T,400
	PUSHJ P,FEED
	MOVE R,LOADE
LOAD1:	MOVE T,0(R)
	PUSHJ P,PWRD
	AOBJN R,LOAD1
	MOVEI T,100
LOAD2:	PUSHJ P,FEED
	JRST RET

BLKEND:	TLNN F,QF		;BLOCK END
	MOVE T,[JRST 4,DDT]
	TLO T,254000		;JRST
	PUSH P,T
	MOVEI T,100
	PUSHJ P,FEED
	POP P,T
	PUSHJ P,PWRD
	PUSHJ P,PWRD	;EXTRA WORD FOR READER TO STOP ON
	MOVEI T,500
	JRST LOAD2

PWRD:	MOVEI W1,6
PWRD2:	ROT T,6
	CONSZ PTPP,20
	JRST .-1
	CONO PTPP,50
	DATAO PTPP,T
	SOJG W1,PWRD2
	POPJ P,0

FEED:	CONSZ PTPP,20
	JRST .-1
	CONO PTPP,10
	DATAO PTPP,FEED1
	SOJN T,FEED
FEED1:	POPJ P,0

>
IFN EDDT&1&<EDDT>B36,<


VERIFY:	TLO F,LTF
CORE:	PUSHJ P,SETUP1		;LOAD TAPES INTO CORE
	CONO PTRR,60
CORE1:	CONSO PTRR,10
	JRST .-1
	DATAI PTRR,T
	CAME T,LOADE-1		;JRST 1
	JRST CORE1
	PUSHJ P,CRF
	PUSHJ P,BLOCKQ

CORE2:	PUSHJ P,GETW
	CAML R,DEFV
	CAML R,ULIMIT
	JRST VER3
	TLNE F,LTF
	JRST VER2
	PUSHJ P,DEP
	JRST VER3

VER2:	MOVEM T,TEM2
	PUSHJ P,FETCH
	JRST ERR
	MOVEM T,TEM3
	XOR T,TEM2
	AND T,MSK
	JUMPE T,VER3
	PUSH P,S
	PUSH P,R
	HRRZ T,R
	PUSHJ P,PAD
	MOVEI T,257		;SLASH
	PUSHJ P,TOUT
	PUSHJ P,LCT
	MOVE T,TEM3		;CORE CONTENTS
	PUSHJ P,CONSYM
	PUSHJ P,LCT
	MOVE T,TEM2		;TAPE CONTENTS
	PUSHJ P,CONSYM
	PUSHJ P,CRF
	POP P,R
	POP P,S
VER3:	PUSHJ P,LISTEN
	AOJA R,CORE2
RUNEND:	PUSHJ P,BLOCKQ
	JRST .-1


>
IFN EDDT&1&<EDDT>B36,<



GETW:	JUMPL S,GETW1
	PUSHJ P,BLOCKQ
GETW1:	MOVE T,1(S)
	AOBJP S,.+1
	POPJ P,0

BLOCKS:	CONO PTRR,60		;READ DATA BLOCKS
BLOCKQ:	CONSO PTRR,10
	JRST .-1
	DATAI PTRR,W
	JUMPL W,BLK1
	MOVEM W,STARTA
	CONO PTRR,0		;TURN OFF READER
	JRST DD1
BLK1:	MOVEM W,W1
	TLC W,777740
	TLCE W,777740
	JRST ERR		;BLOCK TOO BIG
	ADDI W,1
	HRRZM W,R
	HRRI W,BUFF-1
	MOVEM W,S
BLK2:	CONSO PTRR,10
	JRST .-1
	BLKI PTRR,W
	JRST BLK3
	ADD W1,0(W)
	JRST BLK2
BLK3:	ADD W1,0(W)
	CONSO PTRR,10
	JRST .-1
	DATAI PTRR,W
	CAMN W,W1
	POPJ P,0
	CONO PTRR,0		;CHECKSUM ERROR
	JRST 4,BLOCKS

;R CONTAINS RIGHT HALF OF FIRST LINE
;S CONTAINS (-WC,BUFF-1)


>
IFN EDDT&1&<EDDT>B36,<


LOADB:	

IFE EDDT&10,<
DATAI PTRR,1
	XWD -1,-22
DATAI PTRR,2
	CONSO PTRR,10
DATAI PTRR,3
	JRST 2
MOVE 4,37
HRLI 4,710441                          ;DATAI PTRR,0(1)
DATAI PTRR,5
	AOJN 1,2
DATAI PTRR,6
	JRST -6(4)
JRST 2


MOVE 0,1
CONSO PTRR,10
JRST -21(4)
DATAI PTRR,0(1)
ROT 0,1
ADD 0,(1)
AOBJN 1,-21(4)
CONSO PTRR,10
JRST -13(4)
DATAI PTRR,1
CAME 1,0
JRST 4,-6(4)
CONSO PTRR,10
JRST -6(4)
DATAI PTRR,1
JUMPL 1,-22(4)
CONO PTRR,0
JRST 1

>
IFN EDDT&10,<
PHASE 0		;RIM10B CHECKSUM LOADER
	XWD -16,0
BEG:	CONO PTRR,60
	HRRI PTRR,10
RD:	CONSO PTRR,10
	JRST .-1
	DATAI PTRR,@TBL1-RD+1(AA)
	XCT TBL1-RD+1(AA)
	XCT TBL2-RD+1(AA)
AA:	SOJA AA,
TBL1:	CAME CKSM,ADR
	ADD CKSM,1(ADR)
	SKIPL CKSM,ADR
TBL2:	JRST 4,BEG
	AOBJN ADR,RD
ADR:	JRST BEG+1
CKSM←←ADR+1

DEPHASE
>
LOADE:	XWD LOADB-.,LOADB
>

CRN:	MOVEI T,15		;CARRIAGE RETURN
	JRST TOUT

IFE EDDT&1,<
CRNRB:	PUSHJ P,CRN
	MOVEI T,177
	JRST TOUT	>

CRF:	PUSHJ P,CRN
	MOVEI T,12		;LINE FEED
	JRST TOUT

LCT:	IFN EDDT&1,<PUSHJ P,TSPC
	PUSHJ P,TSPC>
	IFE EDDT&1,<MOVEI T,11
	JRST TOUT>

TSPC:	MOVEI T,40		;SPACE
	JRST TOUT

IFN EDDT&1,<

TINSTR:	ILDB T,STRING
	JUMPE T,TIN3	;THERE IS A CHR
	CONSZ TTYY,40
	JRST TIN3
	CAIE T,15
	JRST TIN2
	ILDB T,STRING
	CAIN T,12
	JRST TIN4
	MOVSI T,70000
	ADDM T,STRING
TIN4:	MOVEI T,15
	JRST TIN2
TIN3:	SETZM STRING	;ZERO AND READ TTY
TIN:	SKIPE STRING
	JRST TINSTR	;GET IT FROM THE STRING
	PUSHJ P,LISTEN
	JRST .-1
TIN2:	CAIE T,175
	CAIN T,176
	MOVEI T,33	;CHANGE ALL ALT MODES TO NEW
	CAIN T,177
	JRST WRONG
	TRNE T,140
TOUT:	CAIG T,4
	POPJ P,
	SKIPE OUTRTN
	JRST @OUTRTN
IFN EDDT&1,<
	SKIPE OUTLPT
	JRST LPOUT
>
	HRLM T,(P)
	IMULI T,200401
	AND T,[11111111]
	IMUL T,[11111111]
	HLR T,(P)
	TLNE T,10
	TRC T,200
	CONSZ TTYY,20
	JRST .-1
	DATAO TTYY,T
	ANDI T,177
	POPJ P,0

IFN EDDT&1,<
LPOUT:	IDPB T,LPPTR
	SOSLE LPCNT
	POPJ P,
	PUSH P,T
	MOVEI T,5
	MOVEM T,LPCNT
	DATAO LPT,LPWRD
	MOVE T,[POINT 7,LPWRD]
	MOVEM T,LPPTR
	CONSO LPT,100
	JRST .-1
	POP P,T
	POPJ P,

LPPTR:	POINT 7,LPWRD
LPWRD:	0
LPCNT:	5
>

LISTEN:	CONSO TTYY,40	;LISTEN FOR TTY
	POPJ P,
	DATAI TTYY,T
	ANDI T,177
	JRST CPOPJ1

TTYRET:	MOVEI  T,3410
TTY1:	MOVEI W2,40000
	CONSZ TTYY,120
	SOJG W2,.-1
	CONI TTYY,SAVTTY
	DATAI TTYY,W2
	HRLM W2,SAVTTY
	CONO TTYY,(T)
	POPJ P,
TTYLEV:	MOVE T,SAVTTY
	TRZ T,160
	TRO T,3600
	TRNE T,10
	TRZ T,200
	JRST TTY1

TEXIN:	PUSHJ P,TIN
	TRNN T,140
	JRST TOUT
	POPJ P,

>
IFE EDDT&1,<

TIN:	MOVE T,POUTBF		;GET NEXT CHARACTER ROUTINE
	CAME T,[POINT 7,INBFF]
	PUSHJ P,FINOUT
	SKIPE STRING
	JRST TINSTR
;	ILDB T,PINBFF
	INCHRW T		;RPH 5-22-71
	CAIN T,15
	INCHRW 1(P)		;THROW THE LF DOWN ON THE STACK
TIN3:	CAIE T,176
	CAIN T,175
	MOVEI T,33	;CHANGE TO NEW ALT MODE
	CAIN T,177
	JRST WRONG
	JUMPN T,CPOPJ
;	MOVE T,[POINT 7,INBFF]
;	MOVEM T,PINBFF
;	CALL T,[SIXBIT /DDTIN/]
TIN2:	SETZM STRING
	JRST TIN

TINSTR:	ILDB T,STRING
	JUMPE T,TIN2	;ALL DONE
	CAIN T,33	;NOT THIS ONE STUPID
	MOVEI T,"$"	;DO IS AS $
	SKIPN OUTRTN
	JRST TIN4
	PUSHJ P,@OUTRTN
	JRST TIN3
TIN4:	IDPB T,POUTBF	;DUPLEX
	JRST TIN3	;AND EAT

TOUT:	JUMPE T,CPOPJ
	SKIPE OUTRTN
	JRST @OUTRTN
	CAIE T,177		;IS IT THIS GODDAMN CHAR?
	JRST NOTDEL		;NO
	SETO T,
	TTYUUO 6,T
	TLNE T,526000		;WILL HE IGNORE A 177?
	POPJ P,			;NO, SKIP IT
	MOVEI T,177		;CHANGE BACK TO 177
NOTDEL:	IDPB T,POUTBF
	CAIE T,12
	POPJ P,
TTYLEV:
FINOUT:	MOVEI T,0
	IDPB T,POUTBF
	MOVE T,[POINT 7,INBFF]
;	MOVEM T,PINBFF
	MOVEM T,POUTBF
;	CALL T,[SIXBIT /DDTOUT/]
	OUTSTR INBFF
	SETZM  INBFF
	POPJ P,

;PINBFF:	POINT 7,INBFF
POUTBF:	POINT 7,INBFF

IFE UEDDTS,<
LISTEN:	INCHRS T
	POPJ P,
	CLRBFI
	JRST CPOPJ1
>;UEDDTS
IFN UEDDTS,<
LISTEN:	POPJ P,		;DON'T WASTE TIME CHECKING TTY
>;UEDDTS	RPH 7-30-72
INBFF:	BLOCK 31

TTYRET:
	MOVE T,[POINT 7,INBFF]
	MOVEM T,POUTBF
;	MOVEM T,PINBFF
	SETZM  INBFF
	POPJ P,


TEXIN←←TIN
>
BDISP:	POINT 12,DISP(R),11
	POINT 12,DISP(R),23
	POINT 12,DISP(R),35

DISP:	
DEFINE D' (Z1,Z2,Z3)<
	(Z1-DDT)*1B11+(Z2-DDT)*1B23+Z3-DDT
	LIST>

IFE EDDT&1&<EDDT>B36,<
	PUNCH←←ERR
	BLKEND←←ERR
	LOADER←←ERR
	VERIFY←←ERR
	CORE←←ERR>



D ERR,DARRW,ERR
D ERR,ERR,JOBSET
D ERR,ERR,VARRW
D TAB,LINEF,ERR
D ERR,CARR,ERR
D ERR,ERR,ERR
D PUNCH,ERR,ERR
D ERR,ERR,ERR
D ERR,ERR,ERR
D CONTROL,ERR,LTAB
D ERR,ERR,SPACE
D SUPTYO,TEXI,ASSEM
D DOLLAR,BYTI,SETBLK
D DIVD,LPRN,RPRN
D MULT,PLUS,ACCF
D MINUS,PERIOD,SLASH
D NUM,NUM,NUM
D NUM,NUM,NUM
D NUM,NUM,NUM
D NUM,TAG,SEMIC
D FIRARG,EQUAL,ULIM
D QUESTN,INDIRECT,ABSA
D BPS,CON,SYMD
D EFFEC,SFLOT,STR
D HWRDS,PILOC,FLGMOD
D KILL,LFTT,MASK
D NWORD,BITO,PROCEDE
D QUAN,RELA,SYMBOL
D TEXO,UCON,RFTT
D WORD,XEC,CORE
D ZERO,OCON,ICON
D OSYM,VARRW,PSYM


FLGOUT:	SKIPN R,FLGPNT
	JRST HLFW	;IF NO POINTER USE HALFWORD
	MOVSI W1,400000	;SET FOR HIGH ORDER BIT
FLGLP2:	PUSHJ P,PRNTIT
	JUMPE W1,[SKIPE EXFLAG	;WAS THERE SOMETHING PRINTED
		POPJ P,		;YES, EXIT
		MOVEI T,"0"	;NO, PRINT A 0
		JRST TOUT]
	SKIPN EXFLAG
	JRST FLGLP2
	PUSH P,T
	MOVEI T,","
	PUSHJ P,TOUT
	PUSHJ P,TOUT
	POP P,T
	JRST FLGLP2

GETPTR:	SKIPN R,FLGPTR
	POPJ P,
FLGSLP:	HRRZM R,FLGPNT#
	TRNE F,Q2F
	SOSGE WRD2
	JRST CPOPJ1
	HLRZS R
	JUMPE R,CPOPJ
	SKIPE R,(R)
	JRST FLGSLP
	POPJ P,

PRNTIT:	HRLI R,-=18	;SET FOR HALF WORD
	SETZM FLGNUM#
	SETZM EXFLAG#	;NO ! AND NO NUMERIC
FLGLP:	TDNN T,W1
	JRST NOBIT
	SKIPN (R)	;TEST FOR NAME
	JRST	[IORM W1,FLGNUM	;SAVE BIT
		JRST NOBIT]
	PUSH P,T
	PUSH P,W1
	MOVEI T,"!"
	SKIPE EXFLAG
	PUSHJ P,TOUT
	MOVE T,(R)
	PUSHJ P,SPT1
	SETOM EXFLAG	;WE HAVE PUT OUT SOMETHING
	POP P,W1
	POP P,T
NOBIT:	LSH W1,-1
	AOBJN R,FLGLP
	SKIPE FLGNUM
	JRST	[PUSH P,T
		PUSH P,W1
		MOVEI T,"!"
		SKIPE EXFLAG
		PUSHJ P,TOUT
		MOVE T,FLGNUM
		TRNN T,-1	;CHECK TO SEE IF LEFT HALF
		MOVSS T
		PUSHJ P,TOCC
		POP P,W1
		POP P,T
		SETOM EXFLAG
		POPJ P,]
	POPJ P,

FLGMOD:	PUSHJ P,GETPTR
	SETZM FLGPNT
	MOVEI SCH,FLGOUT
	JRST BASE1
LFTT:	PUSHJ P,GETPTR
	SETZM FLGPNT
	MOVEI SCH,LFPIN
	JRST BASE1
RFTT:	PUSHJ P,GETPTR
	SETZM FLGPNT
	MOVEI SCH,RFPIN
	JRST BASE1

LFFLG:	SKIPN R,FLGPNT
	JRST PI8A	;NONE THERE
COMFLG:	MOVEI W1,400000
	PUSHJ P,PRNTIT
	MOVEI T,"0"
	SKIPN EXFLAG
	PUSHJ P,TOUT
	JRST PI7
RFFLG:	SKIPN R,FLGPNT
	JRST PI8A
	ADDI R,=18
	JRST COMFLG
	JRST DDT
BITO:	MOVEI R,BITT	; PATCH FOR BYTE OUTPUT WW 12-9-66
	HRRZI AR,TOC
	TRZN F,Q2F
	JRST ERR
	MOVE T,WRD2
	MOVEM T,SVBTS
	MOVEI T,=36
	IDIV T,WRD2
	SKIPE T+1
	ADDI T,1
	MOVEM T,SVBTS2
	HRRZ SCH,R
	JRST BASE1
BITT:	MOVE T+1,T
	SKIPN SVBTS	;0 IS MASK CONDITION
	JRST BITTM
	MOVE T,SVBTS2
	MOVEM T,SVBT2
	MOVEM T+1,SVBT3
BITT2:	MOVEI T,0
	MOVE T+2,SVBTS
	LSHC T,(T+2)
	MOVEM T+1,SVBT3
	CAIE AR,PADSO
	PUSHJ P,FTOC
	CAIE AR,TOC
	PUSHJ P,PIN
	SOSG SVBT2
	POPJ P,
	MOVEI T,","
	PUSHJ P,TOUT
	MOVE T+1,SVBT3
	JRST BITT2
BITTM:	MOVEI T,=36	;SET OUTPUT COUNT
	MOVEM T,SVBT3
	MOVE T+2,BMASK	;GET MASK BITS
BITTM1:	MOVEI T,0	;SET TO SHIFT WORD
	SKIPL T+2	;START WITH 1 BITS
	SETCA T+2,
BITTM2:	LSHC T,1	;NEXT BIT
	LSH T+2,1	;SHIFT MASK
	SOSLE SVBT3	;ALL BITS GONE?
	JUMPL T+2,BITTM2	;PART OF SAME FIELD
	MOVEM T+2,SVBT2	;SAVE MASK
	MOVEM T+1,SVBT4	;AND PARTIAL MASK
	CAIE AR,PADSO	;DO PROPER OUTPUT
	PUSHJ P,FTOC
	CAIE AR,TOC
	PUSHJ P,PIN
	SKIPG SVBT3	;ANY MORE?
	POPJ P,		;NO, RETURN
	MOVEI T,","	;COMMA
	PUSHJ P,TOUT
	MOVE T+1,SVBT4	;GET WORD BACK
	MOVE T+2,SVBT2	;AND MASK
	JRST BITTM1	;PRINT NEXT FIELD

SVBT4:	0
SVBTS:	0
SVBTS2:	0
SVBT3:	0
SVBT2:	0	;END OF PATCH  WW 12-9-66

;DESCRIPTION OF OP DECODER FOR DDT:
;
;         THE ENTIRE INSTRUCTION SET FOR THE PDP-6 CAN BE COMPACTED INTO
;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL.  THIS OCCURS
;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN
;FOR THE PDP-6.  FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL
;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY
;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH
;BEGIN WITH 110(2).
;
;     	THE TABLE TBL IN DDT CONSISTS OF 9 BIT BYTES, 4 TO A WORD.
;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE:
;0-37(8):	THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER.
;	LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS
;	EQUAL P.
;
;	THE CONTENTS OF INST (INSTRUCTION) CONTAIN IN THE RIGHT
;	MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION.
;	P AND N REFER TO THE CONTENTS OF INST, AND THE OP DECODER
;	WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS
;	OF INSTX N+1 GIVES THE NUMBER OF BITS IN INST; P GIVES THE
;	POSITION (FROM THE RIGHT EDGE) OF THE N+1 BITS.
;
;	EXAMPLE: P = 6
;	         N = 2
;
;;	C(INST) = .010 101 100(2)
;
;	THE RESULT- D = 010(2) = 2(8)
;
;	D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
;	IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
;	PRINT TEXT, 41-72(8)) ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
;	THE INTERPRETATION.
;
;40(8)	THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
;	IS FINISHED.
;41(8)-72(8)      THE ALPHABET IS ENCODED INTO THIS RANGE.
;	        41- A
;	        42- B
;	        72- Z
;	        WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
;	        LETTER IS TYPED.
;
;73(8)-777(8)     THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
;	        CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE A-73(8)RD
;	        BYTE IN THE TABLE.
;
;MAROS ASSEMBLE THE TABLE TBL:
; 1.   A NUMBER FOLLOWED BY ↑ ASSEMBLES A DISPATCH BYTE.  THE FIRST
;      DIGIT IS THE POSITION; THE SECOND DIGIT IS THE SIZE.
; 2.   A POINT (.) ASSEMBLES A STOP CODE.
; 3.   A NAME FOLLOWED BY A SLASH ASSEMBLES A TRANSFER TO THE
;      SYMBOLICALLY NAMED BYTE.
; 4.   A STRING OF LETTERS TERMINATED BY A SPACE, COMMA, OR POINT,
;      ASSEMBLE INTO A STRING OF BYTES, EACH BYTE BEING ONE LETTER.
;
;EXAMPLE OF BINARY TO SYMBOLIC DECODING:
;      THE MACHINE CODE FOR JRST IAS 254
;          INST    0  1  0  1  0  1  1  0  0
;      THE INTERPRETER STARTS WITH THE FIRST BYTE IN THE TABLE (63↑).
;      THE RESULT OF APPLYING THIS TO C(INST) GIVES 2.  SKIPPING OVER
;      2 BYTES IN THE TABLE AND INTERPRETING THE THIRD RESULTS IN
;      HAK/ BEING INTERPRETED.  AT HAK:, THERE IS A 33↑.  APPLYING
;      THIS TO C(INST) RESULTS IN 5 NON PRINTING BYTES BEING SKIPPED
;      OVER:
;          1.  MV/
;               MOV      PRINTING TEXT
;          2.  MO/
;          3.  ML/
;          4.  DV/
;          5.  SH/
;
;H1/ IS THE NEXT BYTE INTERPRETER.  AT H1: 03↑ IS FOUND SO
;4 BYTES ARE SKIPPED OVER:
;              EXC      PRINTING TEXT
;          1.  S3/
;              BL       PRINTING TEXT
;              T        PRINTING TEXT
;          2.  .
;          3.  AO/
;          4.  AOB/
;          THE NEXT LETTERS JRS ARE TYPED OUT.  THEN T/ IS FOUND.  AT
;T; A T IS TYPED OUT; THEN A "." IS FOUND AND EVERYTHING STOPS.
;
;          THE TABLE IS ALSO USED GOING FROM SYMBOLIC TO BINARY BUT A
SUBTTL OP DECODER

;41-72      THE ALPHABET IS ENCODED INTO THIS RANGE.
;	        41- A
;	        42- B
;	        72- Z
;	        WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
;	        LETTER IS TYPED.
;
;73-777     THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
;	        CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE A-73(8)RD
;	        <A-73+FIR.>BYTE IN THE TABLE.
;
;MAROS ASSEMBLE THE TABLE TBL:
; 1.   A NUMBER FOLLOWED BY ↑ ASSEMBLES A DISPATCH BYTE.  THE FIRST
;      DIGIT IS THE POSITION; THE SECOND DIGIT IS THE SIZE.
; 2.   A POINT (.) ASSEMBLES A STOP CODE.
; 3.   A NAME FOLLOWED BY A SLASH ASSEMBLES A TRANSFER TO THE
;      SYMBOLICALLY NAMED BYTE.
; 4.   A STRING OF LETTERS TERMINATED BY A SPACE, COMMA, OR POINT,
;      ASSEMBLE INTO A STRING OF BYTES, EACH BYTE BEING ONE LETTER.
;
;EXAMPLE OF BINARY TO SYMBOLIC DECODING:
;      THE MACHINE CODE FOR JRST IS 254
;          INST    0  1  0  1  0  1  1  0  0
;      THE INTERPERTED STARTS WITH THE FIRST BYTE IN THE TABLE (63↑).
;      THE RESULT OF APPLYING THIS TO C(INST) GIVES 2.  SKIPPING OVER
;      2 BYTES IN THE TABLE AND INTERPRETING THE THIRD RESULTS IN
;      HAK/ BEING INTERPRETED.  AT HAK:, THERE IS A 33↑.  APPLYING
;      THIS TO C(INST) RESULTS IN 5 NON PRINTING BYTES BEING SKIPPED
;      OVER:
;          1.  MV/
;               MOV      PRINTING TEXT
;          2.  MO/
;          3.  ML/
;          4.  DV/
;          5.  SH/
;
;H1/ IS THE NEXT BYTE INTERPRETER.  AT H1: 03↑ IS FOUND SO
;4 BYTES ARE SKIPPED OVER:
;              EXC      PRINTING TEXT
;          1.  S3/
;              BL       PRINTING TEXT
;              T        PRINTING TEXT
;          2.  .
;          3.  AO/
;          4.  AOB/
;          THE NEXT LETTERS JRS ARE TYPED OUT.  THEN T/ IS FOUND.  AT
;T: A " T " IS TYPED OUT; THEN A "." IS FOUND AND EVERYTHING STOPS.
;
;          THE TABLE IS ALSO USED GOING FROM SYMBOLIC TO BINARY BUT A
BEGIN OPDEFS
XLIST
DEFINE P' (A)
<OUTP A&70/2+A&7-1
>
DEFINE G' (A)
<OUTP A+73
>
DEFINE T' (A)
<FOR Bε<A> <OUTP "B"-40
>>
DEFINE S' (Q)
<OUTP 40
>
DEFINE L' (A)
<IFGE CLOC+73-2000,<PRINTX OPTABLE TOO LONG>
A←←CLOC
>
DEFINE OUTP' (A)
<CLOC←←CLOC+1
>
DEFINE BYT9' (A)
<FOR B⊂(A) <B
>>

↑TBL:
BINRY←←0
CLOC←←0
BINC←←3

DEFINE TABLE <
BYT9 <P 63,G %UUO,G %FLO,G %HAK,G %ACCP,G %BOOLE,T H,G %HWT,T T,G %ACBM>
BYT9 <P 21,G %BD,T CON,P 11,G %OI,T S,P 01,G %Z,G %O>
BYT9 <L %BD,P 01,T BLK,G %IO,T DATA,L %IO,P 11,G %I,G %O,L %OI,P 1,G %O,G %I>
BYT9 <L %UUO,P 51,S,P 32,G %U40,G %U50,G %U60,P 21,G %U703,P 11,G %USET>
BYT9 <P 1,T LOOKU,G %P,T ENTE,G %R,L %USET,T USET,P 1,G %I,G %O>
BYT9 <L %U40,P 3,G %U47,T INI,G %T,S,T SPCWA,G %R,S,S,S,L %U47,T CALL>
BYT9 <P 1,S,G %I,L %U60,P 21,G %U603,P 1,T IN,G %BPUT,T OUT,L %BPUT>
BYT9 <P 11,T BU,L %F,T F,S,T PU,G %T,L %U50,P 3,T OPE,G %N,S,S,S,S>
BYT9 <T RENAM,G %E,T I,G %N,T OU,G %T,L %U603,P 1,G %U6062,T STAT>
BYT9 <P 11,L %O,T O,S,L %Z,T Z,S,L %U6062,P 11,T S,G %U62,T G,L %U62>
BYT9 <T ETST,G %S,L %U703,P 2,T CLOS,G %E,T RELEA,G %S,T MTAP,G %E>
BYT9 <T UGET,G %F>

BYT9 <L %FLO,P 51,G %BYTE,T F,P 32,T AD,G %A,T SB,G %A,T MP,G %A,T DV>
BYT9 <L %A,P 21,G %LMB,T R,L %LMB,P 2,S,L %L,T L,S,L %M,T M,S,L %B>
BYT9 <T B,S,L %BYTE,P 32,S,S,S,P 3,S,S,T FS,G %C,T IB,L %P,T P,S>
BYT9 <T I,G %LD,L %LD,T LD,G %B,T I,G %DP,L %DP,T DP,G %B>

BYT9 <L %HAK,P 33,G %MV,L %MV,T MOV,G %MO,G %ML,G %DV,G %SH,G %H1>
BYT9 <G %JP,P 21,T ADD,G %IMB,T SU,L %BIMB,T B,L %IMB,P 2>
BYT9 <S,L %I,T I,S,G %M,G %B,L %MO,P 22,L %EIMS,T E,G %IMS,T S>
BYT9 <G %IMS,T N,G %IMS,T M,L %IMS,P 2,S,G %I,G %M,L %S,T S,S>
BYT9 <L %ML,P 21,T I,G %ML1,L %ML1,T MUL,G %IMB,L %DV,P 21,T I,G %DV1>
BYT9 <L %DV1,T DI,L %DV2,T V,G %IMB,L %H1,P 3,T EXC,G %S3,T BL,L %T>
BYT9 <T T,S,G %AO,L %AO,T AOBJ,G %AOB,T JRS,G %T,T JFC,G %L,T XC,G %T>
BYT9 <T CON,G %S,L %AOB,P 1,G %P,G %N,L %JP,P 3,G %PU,L %PU,T PUSH>
BYT9 <G %PUS,G %PO,L %PO,T POP,G %POP,T JS,L %R,T R,S,T JS,G %P>
BYT9 <T JS,L %PA,T A,S,T JR,G %PA,L %PUS,P 1,L %J,T J,S,S,L %POP>
BYT9 <P 1,S,G %J,L %SH,P 2,T A,G %S2,T ROT,G %S1,T L,L %S2,T S,L %S3>
BYT9 <T H,G %S1,P 21,T JFF,G %O,T FIX,S,L %S1,P 21,S,L %C,T C,S>

BYT9 <L %ACCP,P 42,T CA,G %CA1,G %SJ,T A,G %JS,T S,L %JS,T O,P 31>
BYT9 <T J,G %COMP,T S,G %COMP,L %CA1,P 31,T I,G %COMP,T M,G %COMP>
BYT9 <L %SJ,P 31,T JUM,G %PSJ,T SKI,L %PSJ,T P,L %COMP>
BYT9 <P 3,S,G %L,L %E,T E,S,T L,G %E,G %PA,T G,G %E,L %N,T N,S,T G,S>

BYT9 <L %HWT,P 51,G %HW1,P 21,T R,G %HW2,T L,L %HW2,T R,G %HW3,L %HW1>
BYT9 <P 21,T L,G %HW4,T R,L %HW4,T L,L %HW3,P 32,G %IMS,T Z,G %IMS,T O>
BYT9 <G %IMS,G %EIMS>

BYT9 <L %ACBM,P 31,G %AC1,P 1,T D,G %AC2,T S,G %AC2,L %AC1,P 1,T R>
BYT9 <G %AC2,T L,L %AC2,P 42,T N,G %EAN,T Z,G %EAN,T C,G %EAN,T O>
BYT9 <L %EAN,P 12,S,G %E,G %PA,G %N>

BYT9 <L %CB,T C,G %BIMB,L %BOOLE,P 24,G %ST,L %AN,T AND,G %B2,G %AN>
BYT9 <G %ST,G %AN,G %ST,T X,L %OR,T OR,G %B2,T I,G %OR,G %AN,T EQ>
BYT9 <G %DV2,G %ST,G %OR,G %ST,G %OR,G %OR,L %ST,T SET,L %B2>
BYT9 <P 24,T Z,G %IMB,G %IMB,L %CA,T C,G %TA,L %TM,T M,G %IMB,L %CM>
BYT9 <T C,G %TM,L %TA,T A,G %IMB,G %IMB,G %IMB,T C,G %BIMB,G %IMB,G %CA>
BYT9 <G %CA,G %CM,G %CM,G %CB,T O,G %IMB>>
TABLE
DEFINE OUTP (A)
<BINRY←←BINRY⊗12+A
BINC←←BINC-1
IFE BINC,<XLIST
BINRY⊗6
BINRY←←0
BINC←←3
>
CLOC←←CLOC+1
>
CLOC←←0
TABLE
REPEAT BINC,<BINRY←←BINRY⊗12>
IFN BINRY,<BINRY⊗6>

LIST
BEND
PNTR:	INST	;POINTER TO BITS IN INST
INST:	0		;BINARY FOR INSTRUCTION
CHP:	0		;CHAR POINTER INTO TXT, TXT+1
TXT:	BLOCK 2		;STORE INPUT TEXT FOR OPEVAL
SAVPDL:	0		;SAVE PUSH DOWN LIST POINTER

BTAB:	POINT 10,TBL	;TABLE USED TO GET NEXT BYTE POINTER
	POINT 10,TBL,9	;FOR TRANSFER BYTE
	POINT 10,TBL,19

OPEVAL:	MOVEI T,0		;EVALUATE FOR AN OP CODE
	IDPB T,CHP
	MOVEM P,SAVPDL
	TRZA F,OUTF
OPTYPE:	TRO F,OUTF		;TYPE AN OPCODE SYMBOLICALLY
	LSH T,-33
	MOVEM T,INST		;GET OPCODE INTO RIGHT 9 BITS
	MOVE T,[XWD 440700,TXT]
	MOVEM T,CHP		;FOR OPEVAL,SETUP POINTER TO INPUT TEXT
	TRZ F,ITF		;CLEAR INSTRUCTION TYPED FLAG
	SETZB  R,W1
	MOVE W2,BTAB
DC1:	ILDB T,W2		;GET NEXT BYTE IN TBL
	CAILE T,40
	CAIL T,73
	SOJGE R,DC1		;SKIP OVER # BYTES = C(R)
	JUMPG R,DC1		;SKIP OVER ALPHA TEXT WITHOUT COUNTING
	SUBI T,40
	JUMPE T,DECX		;TRANSFER ON ASTOP CODE
	JUMPG T,DC2
	DPB T,[XWD 340500,PNTR]	;SETUP R ON A DISPATCH BYTE
	TRZ T,-4
	AOS T
	DPB T,[XWD 300600,PNTR]
	TRNN F,OUTF
	JRST DC6		;FOR OPEVAL ONLY
	LDB R,PNTR		;GET # BYTES TO SKIP OVER
	JRST DC1

DC2:	HRREI T,-33(T)
	JUMPL T,DECT		;TYPE OUT A LETTER
	MOVE W1,T		;BYTE IS A TRANSFER
	IDIVI W1,3
	MOVE W2,BTAB(W2)	;CALCULATE POINTER TO NEXT BYTE
	ADDI W2,(W1)
	JRST DC1

DECT:	TRNE F,OUTF
	JRST DC8	;TYPE OUT A LETTER
	ILDB W1,CHP	;GET NEXT INPUT LETTER
	CAIE W1,133(T)	;COMPARE WITH ASSUMED NEXT LETTER
	JRST NOMAT	;DOESNT MATCH
	JRST DC1	;MATCHES, TRY NEXT

DECX:	TRNE F,OUTF	;STOP (CODE 40) HAS BEEN SEEN
	POPJ P,		;IF FOR OUTPUT, RETURN
	ILDB W1,CHP	;GET NEXT INPUT CHAR IF ANY
	JUMPE W1,DC7	;DOES # OF CHARS MATCH
NOMAT:	POP P,R		;NO, BACK UP AND TRY SOME MORE
	POP P,W2
	POP P,PNTR
	POP P,CHP
NOMAT1:	AOS R		;ASSUME NEXT NUMBER FOR BIN VALUE
	DPB R,PNTR	;STUFF INTO ANSWER
	LDB R,PNTR
	JUMPN R,DC6AA	;IF =0, BYTE WAS TOO BIG
	CAME P,SAVPDL
	JRST NOMAT	;NOT AT TOP LEVEL
	POPJ P,		;UNDEFINED, FINALLY

DC6:	MOVEI R,0	;ASSUME 0 FOR INITIAL BINARY VALUE
	DPB R,PNTR
DC6AA:	CAMN P,SAVPDL
	JRST DC6BB
	LDB T,-2(P)	;OLD VALUE OF PNTR
	CAME T,(P)
	JRST NOMAT1
DC6BB:	PUSH P,CHP
	PUSH P,PNTR
	PUSH P,W2
	PUSH P,R
	JRST DC1

DC7:	MOVE P,SAVPDL		;RESTORE PUSH DOWN POINTER
	MOVE T,INST
	LSH T,33		;PUSH BINARY INTO POSITION FOR OPEVAL
	TLC T,700000
	TLCE T,700000
	JRST CPOPJ1
	SETOM IOTFLG	;IT IS AN IOT
	LDB R,[POINT 3,T,8]
	DPB R,[POINT 10,T,12]	;ONLY DONE FOR IO INSTRUCTIONS
	JRST CPOPJ1

DC8:	TRO F,ITF		;SET INSTRUCTION TYPED FLAG
	MOVEI T,133(T)
	PUSHJ P,TOUT		;OUTPUT A LETTER
	SETZM  SPSAV		;SO $D WONT TRY TO DELETE OP CODES
	JRST DC1
PATCH:	BLOCK 10

IFN EDDT&1&<EDDT>B36,<
BUFF:	BLOCK 40>
IFN UEDDTS,<
FBDATA:	BLOCK	40				;FOR DATA FROM/TO L'SCOPE
UESTRT:	SETZM EXJOBN		;JOB WE ARE EXAMINING!
	SETZM EXSYMS
	MOVEI S,37
	CALL S,['PEEK  ']
	MOVEM S,MEMSIZ#
	MOVE T,S
	ANDI S,MAXPR-1
	HRLZM S,PRSIZ#
	ANDI T,¬<MAXPR-1>
	MOVEM T,PRTOP#
	SETZM SYMSYS#
	SETZM SYMLUZ#
	MOVEI	S,265
	CALLI	S,33		;PEEK ADDRESS OF SYSTOP
	CALLI	S,33		;PEEK SYSTOP ITSELF
	MOVEM	S,SYSTOP#
	MOVEI T,
	MOVEI P,PS
	PUSHJ P,PRSET
	MOVEI S,DDTEND
	MOVE T,74
	CAIN T,DDT		;ARE WE "THE" DEBUGGER?
	MOVEM S,JOBFF		;FLUSH SYMS IF NOT BEING DEBUGGED
	SKIPN S,400036
	JRST SYMCOP
	OUTSTR[ASCIZ/COPY SYMBOLS?/]
	INCHRW W
	CAIN W,15
	INCHRW W
	CAIE W,"Y"
	CAIN W,"y"
	JRST SYMCOP
	TRO S,400000
	MOVEM S,EXCSYM#		;LOOK DIRECTLY INTO SYSTEM FOR SYMBOLS
	MOVE S,JOBFF		;MAYBE SHRINK?
	CALLI S,11
	JFCL
	SETOM SYMSYS
	JRST NOCOP

SYMCOP:	MOVEI P,PS		;GET A STACK
	PUSHJ P,COPSYM		;GET SOME SYMBOLS
NOCOP:	SETZM SPCFLG#
	JRST DDT

COPSYM:	SKIPE EXSYMS		;WHOSE SYMBOLS ARE WE LOOKING AT?
	JRST USYMS
ESYMS:	SETZM EXSYMS		;IN CASE WE JUMPED HERE
	SKIPN R,400036	;EXEC SYMBOL POINTER
	JRST NOSYMS	;TRY DISK
	JRST CSYMS	;COPY THEM IN

USYMS:	MOVEI R,JOBSYM
	PUSHJ P,FETCH	;FETCH LOSER JOBSYM
	SETZ T,
	JUMPE T,ESYMS	;IF NO SYMBOLS, TRY SYSTEM SYMS
	MOVE R,T
CSYMS:	HLRO T,R
	MOVNS T
	ADD T,JOBFF
	IORI T,1777
	CALLI T,11
	JRST NOCORE
	HLRO W1,R
	ADD W1,JOBREL
	HLL W1,R
	HRRM W1,EXCSYM
	HLLM R,EXCSYM
UELP1:	PUSHJ P,FETCH
	SETZ T,		;STORE A 0
	MOVEM T,(W1)
	ADDI R,1
	AOBJN W1,UELP1
	POPJ P,

NOSYMS:	SETZM EXCSYM	;NO SYMBOLS YET!
	MOVE W,JOBFF
	MOVEI S,42(W)	;MAKE ENOUGH ROOM FOR ONE SECTOR
	CALLI S,11	;GET IT
	JRST NOCORE	;CAN'T
	MOVEI S,400100	;SYSBAND
	MOVEM W,WCMA	;WHERE TO
	MOVEI W2,40
	MOVEM W2,WCMA+1	;# OF WORDS
	SETZM WCMA+2	;SECTOR 0
	FBREAD S,WCMA
	JRST FBERR
	SKIPN W2,36(W)	;GET EXCSYM FROM DISK
	JRST NOSYM1	;NONE THERE EITHER!
	MOVEI W1,(W2)	;ADDR OF SYMBOLS
	LSH W1,-5	;SECTOR
	MOVEM W1,WCMA+2	;TO MEM
	HLRO W1,W2	;-# OF WORDS
	MOVNS W1
	ADDI W1,40	;BUGGER
	MOVEM W1,WCMA+1	;COUNT
	ADDI W1,2(W)	;NEW TOP OF CORE
	CALLI W1,11		;GET MORE CORE
	JRST NOCORE
	FBREAD S,WCMA
	JRST FBERR
	MOVEI W1,(W2)
	ANDI W1,37
	ADD W1,W		;LOC OF NEW SYMBOL TABLE
	HRRM W1,EXCSYM
	HLLM W2,EXCSYM
	POPJ P,

NOCORE:	OUTSTR[ASCIZ/CAN'T GET CORE/]
	POPJ P,

FBERR:	OUTSTR[ASCIZ/FAST BAND ERROR!/]
	POPJ P,

NOSYM1:	OUTSTR[ASCIZ/NO SYMBOLS ANYWHERE???/]
	POPJ P,

WCMA:	BLOCK 3

EXSYMS:	0
EXJOBN:	0
	-1,,0
	EXJWRD
EXJWRD:	0

DDTREN:	SETOM SPCFLG
	SETZM SPCADR
	JRST DDT

DDTSPC:	SKIPN SPCADR
	CALLI 400024
	MOVE 1,SPCADR#
	MOVE 3,SPCWRD#
	CONSO 1B24
	TDZA 4,4
	MOVEI 4,1
	DATAO 104,[0]		;DISABLE SYS WR DETECTOR
	HRROS 2
	DATAO 2
	MOVNS 2
	ADD 1,2
	MOVEM 3,(1)
	DATAO 104,4
	SETZM SPCADR
	CALLI 400024

SYMPR:	HRRZ T,EXCSYM
	TRZ T,400000
PRSET:	ANDI T,¬<MAXPR-1>
	CAME T,PRTOP
	TLOA T,<MAXPR-1>&376001
	HLL T,PRSIZ
	SETPR2 T,
	JRST PRLUZ
	TLO T,1777
	HLRZM T,PRMAX#
	MOVNS T
	HRRM T,PROFF
	SKIPN SYMSYS
	POPJ P,
	ADD T,EXCSYM
	SETZM SYMLUZ
	MOVEI T,-400000(T)
	CAMLE T,PRMAX
	SETOM SYMLUZ
	POPJ P,

PRLUZ:	OUTSTR [ASCIZ /SETPR2 FAILED!
/]
	JRST 4,.

PROFF:	(R)
>

;KEEP IT ALL TOGETHER FOR SWAPPING DDT
LIT
VAR

XP DDTEND,.
↑↑DDTEND←DDTEND

IFE EDDT&1,<IFE UEDDTS!SAVESW,<END>
	IFN UEDDTS,<END UESTRT>
	IFN SAVESW,<END DDT>>
IFE EDDT&41-1,<BEND>
IFN EDDT&40,<END>
>