Google
 

Trailing-Edge - PDP-10 Archives - AP-4178E-RM - swskit-sources/ddt.mac
There are 55 other files named ddt.mac in the archive. Click here to see a list.
;<3A.MONITOR>DDT.MAC.16, 22-Jun-78 20:48:43, Edit by ENGEL
;ELIMINATE LOCAL SYMBOLS FOR EDDT AND MDDT
;<3A.MONITOR>DDT.MAC.15, 16-Jun-78 13:23:21, Edit by ENGEL
;<3.SM10-RELEASE-3>DDT.MAC.14, 23-Jan-78 14:03:05, Edit by MCLEAN
;<3.SM10-RELEASE-3>DDT.MAC.13, 11-Jan-78 19:09:32, Edit by MCLEAN
;<3.SM10-RELEASE-3>DDT.MAC.11, 11-Jan-78 18:42:33, Edit by MCLEAN
;FIX SO KS10 IS SERIAL # GT 4095
;<3.SM10-RELEASE-3>DDT.MAC.9, 11-Jan-78 18:22:22, Edit by MCLEAN
;<3.SM10-RELEASE-3>DDT.MAC.8, 12-Dec-77 00:46:30, Edit by MCLEAN
;MORE WORK ON I/O INSTRUCTIONS
;<3.SM10-RELEASE-3>DDT.MAC.7,  1-Dec-77 15:19:09, Edit by MCLEAN
;INSERT I/O DECODER STUFF FOR RDIO
;<3.SM10-RELEASE-3>DDT.MAC.6,  1-Dec-77 14:48:42, Edit by MCLEAN
;<3.SM10-RELEASE-3>DDT.MAC.5,  1-Dec-77 14:34:09, Edit by MCLEAN
;<3.SM10-RELEASE-3>DDT.MAC.4,  1-Dec-77 14:31:18, Edit by MCLEAN
;FIX EFFECTIVE ADDRESS CALCULATION FOR KS10 I/O INSTRUCTIONS
;<3.SM10-RELEASE-3>DDT.MAC.3, 29-Oct-77 20:10:16, Edit by MCLEAN
;<3.SM10-RELEASE-3>DDT.MAC.2, 29-Oct-77 20:08:21, Edit by MCLEAN
;STOP KEEP ALIVE FOR KS10 AND INSURE 8080 INTERRUPT ON OUTPUT
;<3-MONITOR>DDT.MAC.44, 10-Oct-77 14:37:08, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>DDT.MAC.43, 30-Sep-77 13:53:53, Edit by MCLEAN
;<3-MONITOR>DDT.MAC.42, 28-Sep-77 14:55:25, Edit by MCLEAN
;<3-MONITOR>DDT.MAC.41, 28-Sep-77 14:45:43, Edit by MCLEAN
;ADD KS10 STUFF
;<3-MONITOR>DDT.MAC.39, 28-Sep-77 01:28:54, Edit by MCLEAN
;SOME PREPARATION FOR KS10 STUFF
;<3-MONITOR>DDT.MAC.38, 23-Sep-77 16:34:21, Edit by LCAMPBELL
;<3-MONITOR>DDT.MAC.37, 23-Sep-77 16:30:03, Edit by LCAMPBELL
;MAKE $16R TYPE THINGS IN HEXADECIMAL (ALSO $11R THRU $37R WILL
; NOW DO THE "RIGHT" (ALBEIT PERVERSE) THING
;<3-MONITOR>DDT.MAC.36, 15-Sep-77 16:39:49, EDIT BY MURPHY
;<3-MONITOR>DDT.MAC.35,  2-Sep-77 15:11:40, EDIT BY MURPHY
;<3-MONITOR>DDT.MAC.34,  1-Sep-77 23:44:45, EDIT BY MURPHY
;<3-MONITOR>DDT.MAC.33, 31-Aug-77 17:41:49, EDIT BY MURPHY
;MAKE BREAKPOINTS WORK IN MONITOR EXTENDED ADDRESSING CONTEXT
;<3-MONITOR>DDT.MAC.32, 25-Aug-77 11:20:54, EDIT BY KIRSCHEN
;<3-MONITOR>DDT.MAC.31, 23-Aug-77 17:21:12, EDIT BY BOSACK
;<3-MONITOR>DDT.MAC.30, 23-Aug-77 15:39:05, EDIT BY BOSACK
;<3BOSACK>DDT.MAC.31, 22-Aug-77 22:21:05, EDIT BY BOSACK
;MOVE -20 EDDT TO INIT CODE
;<3BOSACK>DDT.MAC.30, 27-May-77 20:30:58, EDIT BY BOSACK
;<3BOSACK>DDT.MAC.29,  3-May-77 19:23:16, EDIT BY BOSACK
;<3BOSACK>DDT.MAC.28,  3-May-77 19:12:12, EDIT BY BOSACK
;<3-MONITOR>DDT.MAC.27,  1-Mar-77 13:45:20, Edit by HESS
;TCO 1747 - MAKE LPDL LARGER FOR MDDT
;<3-MONITOR>DDT.MAC.26,  7-Jan-77 10:41:35, EDIT BY HURLEY
;<3-MONITOR>DDT.MAC.25, 27-Dec-76 17:31:03, EDIT BY HURLEY
;<3-MONITOR>DDT.MAC.24, 10-Dec-76 12:57:52, EDIT BY MILLER
;<2-MONITOR>DDT.MAC.21, 10-Dec-76 11:37:05, EDIT BY MILLER
;<2-MONITOR>DDT.MAC.20, 10-Dec-76 11:34:24, EDIT BY MILLER
;DETERMINE VIRTUAL ADDRESS OF EPT BY SCANNING IF PAGING ON
;<3-MONITOR>DDT.MAC.22, 28-Nov-76 15:27:28, Edit by MCLEAN
;<3-MONITOR>DDT.MAC.21, 26-Nov-76 03:27:01, Edit by MCLEAN
;<2-MONITOR>DDT.MAC.19, 19-Nov-76 17:29:58, EDIT BY MURPHY
;TCO #1665 - USE CODE 3 FOR LF IN SFCOC WORD
;<2-MONITOR>DDT.MAC.18,  7-Nov-76 13:44:28, Edit by MCLEAN
;TCO 1652 USE EPT REFERENCES
;<2-MONITOR>DDT.MAC.17, 11-Oct-76 15:49:56, EDIT BY MURPHY
;<2-MONITOR>DDT.MAC.15, 11-Oct-76 15:13:51, EDIT BY MURPHY
;TCO #1587 - REMOVE UUO'S UNDER FTDEC20
;<2-MONITOR>DDT.MAC.14, 20-Aug-76 15:30:28, EDIT BY HURLEY
;MAKE MDDT TYPE OUT "MDDT" INSTEAD OF "DDT"
;<2-MONITOR>DDT.MAC.13,  6-Aug-76 17:26:22, EDIT BY MURPHY
;TCO #1483 - PREVENT ILLEGAL PROCEED
;<1B-MONITOR>DDT.MAC.12, 14-MAY-76 12:34:31, EDIT BY MURPHY
;TCO #1271 AGAIN
;<1B-MONITOR>DDT.MAC.11, 14-MAY-76 11:29:16, EDIT BY MILLER
;TCO 1271. MAKE EDDT POLL FOR MASTER -11 ON EACH ENTRY
;<1B-MONITOR>DDT.MAC.10, 13-MAY-76 18:00:37, EDIT BY MURPHY
;TCO #1271 - MORE CLEANUP
;<1B-MONITOR>DDT.MAC.14,  7-MAY-76 08:50:30, EDIT BY MILLER
;TCO 1282. FIX POLLING OF DTE'S
;<1B-MONITOR>DDT.MAC.13,  6-MAY-76 13:55:29, EDIT BY MURPHY
;<LEWINE>DDT.MAC.2,  6-MAY-76 13:12:30, EDIT BY LEWINE
;UPDATE EDIT NUMBER TO BE 177 TO AVOID CONFUSION WITH PREVIOUS
;	DDT VERSION 37'S
;<LEWINE>DDT.MAC.1,  6-MAY-76 13:06:28, EDIT BY LEWINE
;1. MAKE FILDDT PRESERVE E+3 WHEN UPDATING DEFAULT .EXT FROM
;	'XPN' TO 'EXE'
;2. MAKE FILDDT FIX UNDEFINED SYMBOL TABLE CORRECTLY
;3. FIX PROBLEMS WITH EOF ON $Y
;<1B-MONITOR>DDT.MAC.12,  5-MAY-76 17:45:04, EDIT BY MURPHY
;TCO #1271 - CLEANUP
;<1B-MONITOR>DDT.MAC.10,  5-MAY-76 11:34:06, EDIT BY MURPHY
;TCO #1148 AGAIN - FIX CLOBBERED AC
;<1B-MONITOR>DDT.MAC.9,  4-MAY-76 13:50:44, EDIT BY MILLER
;<1B-MONITOR>DDT.MAC.8,  3-MAY-76 17:41:36, EDIT BY MURPHY
;<1B-MONITOR>DDT.MAC.7,  3-MAY-76 14:16:01, EDIT BY MURPHY
;TCO #1275 - ADD FTEDIT
;<1B-MONITOR>DDT.MAC.3,  3-MAY-76 12:03:39, EDIT BY MILLER
;TCO 1271. ADD IN EPT RELATIVE ADDRESSING FOR FE COMMUNICATION
;<1B-MONITOR>DDT.MAC.2, 30-APR-76 12:45:35, EDIT BY MURPHY
;TCO #1271 - MERGE DDT SOURCES
;<1MONITOR>DDT.MAC.8, 25-MAR-76 20:10:03, EDIT BY BOSACK
;MORE TCO 1065 - RETURN 'EXISTS' BIT FROM CHKADR IN EXEC MODE
;<1MONITOR>DDT.MAC.7, 25-MAR-76 15:34:15, EDIT BY MURPHY
;TCO #1065 - CHECK 'EXISTS' ACCESS ON FETCH
;<1MONITOR>DDT.MAC.6, 17-MAR-76 17:58:59, EDIT BY MURPHY
;<1MONITOR>DDT.MAC.5, 15-MAR-76 11:31:04, EDIT BY MILLER
;TCO 1148 AGAIN. ADD CSHVER ROUTINE TO MAKE SURE CACHE STILL VALID
;<1MONITOR>DDT.MAC.4, 14-MAR-76 13:52:08, EDIT BY MILLER
;TCO 1148. FIX CACHE LOOKUP TO CHECK FOR NOT IN USE ENTRIES
;<1MONITOR>DDT.MAC.3,  3-MAR-76 15:44:02, EDIT BY MURPHY
;TCO #1148 - SYMBOL CACHE
;<1MONITOR>DDT.MAC.2, 27-FEB-76 15:17:52, EDIT BY MILLER
;MCO 21. POLL FOR MASTER -11
;<2MONITOR>DDT.MAC.45, 20-NOV-75 14:09:08, EDIT BY MILLER

SUBTTL 1-APR-75  /TW/PFC/TWE/DAL/DLM/EJW



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION

	SALL
	COMMENT \

TABLE OF CONTENTS FOR DDT

 1-APR-75  /TW/PFC/TWE/DAL/DLM/EJW
 MAKE JSYS DDT
 DEFINE DDT SYMBOLS
 WRITE DDT.VMX
 START DDT
 FILDDT -- COMMAND SCANNER
 FILDDT -- PROCESS .EXE FILE
 FILDDT -- SETUP SYMBOLS
 DDT COMMAND PARSER
 SYMBOL TABLE LOGIC
 TEXT COMMANDS (" AND $")
 REGISTER EXAMINATION LOGIC
 MODE CONTROL SWITCHES
 PATCH COMMAND  -- PATCH BEGIN
 PATCH COMMAND -- PATCH END
 PAGE TABLE CONTROL ($U)
 GO AND EXECUTE LOGIC
 SINGLE STEP EXECUTE LOGIC
 ENTER AND LEAVE DDT LOGIC
 BREAK POINT LOGIC
 MEMORY MANAGER SUBROUTINES
 BINARY TO SYMBOLIC CONVERSION
 SEARCH LOGIC
 OUTPUT SUBROUTINES
 PUNCH PAPER TAPE LOGIC
 TELETYPE IO LOGIC
 DDT COMMAND FILE LOGIC
 DISPATCH TABLE
 FANCY TERMINAL INPUT LOGIC
 OP DECODER
 VARIABLE STORAGE
 STORAGE -- $X LOGIC AND PATCH COMMAND
  STORAGE -- BREAKPOINTS
 STORAGE -- SYMBOL TABLE LOGIC
 STORAGE -- SAVE AREAS FOR PREVIOUS CONTEXT
 STORAGE -- STATE VARIABLES
 STORAGE -- PUSH DOWN LIST
\
;DDT VERSION IDENTIFICATION

$EDITN==201			;EDIT NUMBER
$VERSN==37			;VERSION NUMBER
%DDTVR==<$VERSN>B11+$EDITN	;COMPOSIT VERSION IDENT

;SWITCHES FOR DDT FEATURES
;FTEXEC		;EXEC MODE FACILITIES (ALSO RUNS IN USER MODE)
;FTPTP		;PAPER TAPE FACILITIES (EXEC MODE ONLY)
;FTFILE		;FILE DDT
;FTYANK		;PAPER TAPE INPUT FACILITIES ($Y)
;FTVMX		;BUILD DDT.VMX FOR TOPS10 VIRTUAL MEMORY
;FTDEC20	;DEC20 FACILITIES
;FTMON		;DEC20 MONITOR DDT
;FTEDIT		;INCLUDE FANCY EDITING FEATURES WITH DEC20 EDDT
;ABSDDT		;RELOCATABLE ASSEMBLY IF 0, ABSOLUTE ASSEMBLY
				;WITH ORIGIN GIVEN BY B0-17 OTHERWISE

   IFNDEF ABSDDT,<ABSDDT==0>
   IFNDEF FTEXEC,<FTEXEC==0>
   IFNDEF FTPTP,<FTPTP==0>
   IFNDEF FTFILE,<FTFILE==0>
   IFNDEF FTYANK,<FTYANK==0>
   IFNDEF FTVMX,<FTVMX==0>
   IFNDEF FTDEC20,<FTDEC20==0>
   IFNDEF FTMON,<FTMON==0>
   IFNDEF FTEDIT,<FTEDIT==0>

;NORMALIZE ALL SWITCH VALUES TO 0 OR -1 SO BOOLEAN EXPRESSIONS IN
;CONDITIONALS WORK CORRECTLY.

DEFINE ..N (SW)<
   IRP SW,<
	IFN SW,<SW==-1>>>

	..N <FTEXEC,FTPTP,FTFILE,FTYANK,FTVMX,FTDEC20,FTMON,FTEDIT>

   IFN FTDEC20,<
	SEARCH MONSYM,MACSYM
	OPDEF CALL [040B8]
	OPDEF MRPAC [JSYS 772]>

   IFE  FTFILE,<INTERN %DDTVR>
EXTERN .JBREL,.JBSA,.JBHRL,.JBSYM,.JBFF,.JBHSM,.JBHNM,.JBUSY,.JBDA

   IFE FTDEC20,<
   IFN FTEXEC,<
	TITLE EDDT -EXEC MODE DDT >
   IFN FTEXEC!FTFILE,<
	XJBSYM==36
	XJBUSY==32
	XZLOW==40>

   IFE FTEXEC,<
   IFE FTFILE,<
	TITLE UDDT -USER MODE DDT >
   IFN FTFILE,<
	TITLE FILDDT -FILE DDT
	CT.RES==5		;NUMBER OF PAGES TO KEEP IN CORE
	MX.SIZ==^D1024		;MAX PAGES IN FILE
	T30SYM==131>		;SPMON (10/30)
   >				;END IFE FTEXEC

ZLOW==140

INTERNAL .JBVER,.JBDDT
.JBDDT=74
.JBVER=137
   IFE FTEXEC,<
	LOC .JBVER		;DO NOT SET  IF EXEC DDT(OK USER OR FILDDT)
	%DDTVR			;PUT VERSION # IN .JBVER
   >

   IFE FTFILE!FTVMX,<
	LOC .JBDDT
	XWD DDTEND,DDTX
   >
RELOC 0

   IFE FTVMX,<IFN ABSDDT&<XWD -1,0>,<LOC <ABSDDT>B53>>

	OPDEF PAGE. [CALLI 145]	;PAGING UUO
	.GTUPM==100
   >				;END IFE FTDEC20
	SUBTTL MAKE TOPS20 DDT
   IFN FTDEC20,<
;IN ADDITION TO DIFFERENT MONITOR CALLS AND PAGING CONVENTIONS,
;THE FOLLOWING FUNCTIONAL DIFFERENCES EXIST UNDER FTDEC20:
; 1. EVAL ALWAYS CALLED BEFORE OPEVAL - ALLOWS USER REDEFINITION
;	OF BUILT-IN OPCODES.
; 2. PRESERVE PREVIOUSLY SAVED ACS WHEN SWITCHING USER/EXEC MODE.
;	DEC20 DUMP PROCEDURE ASSUMES CRASH ACS ARE SAVED IN EDDT.
; 3. FORCE SAVE OF ACS ALWAYS WHEN ENTERING BREAKPOINT.  HELPFUL
;	WHEN UNKNOWN BREAKPOINT ENCOUNTERED BECAUSE SET BY
;	ANOTHER PROCESS OR LEFT OVER FROM ABORTED DDT.
; 4. PRINT $ FOR EACH PC INCREMENT ON <INSTR>$X.
; 5. TRY FOR FULL-WORD MATCH ON BINARY TO SYMBOLIC CONVERSIONS.
;	NECESSARY FOR CORRECT JSYS MNEMONIC PRINTOUT.
; 6. USE 1000 AS MAX SYMBOL OFFSET FOR RELATIVE LOCATION PRINTOUT.

ZLOW==20			;LOWER LIMIT FOR $$Z

   IFE FTEXEC,<
   IFE FTMON,<

	TITLE UDDT		;DEC20 USER DDT
	INTERN PHDDT

RUNLOC==770000			;RUNTIME LOCATION OF CODE
VARLOC==776000			;RUNTIME LOCATION OF VARIABLES

;ONCE-ONLY CODE TO BLT DDT TO RUNTIME LOCATION. RUN IMMEDIATELY
;AFTER LOADING.

BLTDDT:	MOVEI 1,.FHSLF
	SETZB 2,3
	SCVEC			;FLUSH PA1050 INFO
	MOVE 2,[1,,DDT]
	SEVEC			;SET PROPER ENTRY VECTOR
	SETO 1,
	MOVE 2,[.FHSLF,,700]
	MOVE 3,[1B0+100]
	PMAP			;CLEAR PAGES AROUND RUN LOCATION
	MOVE 1,[PHDDT,,DDT]
	BLT 1,DDT+DDTEND-PHDDT	;MOVE PROGRAM
	MOVE 10,[PMAP]		;SETUP EXIT CODE IN ACS
	MOVE 11,[HALTF]
	SETO 1,			;SETUP TO CLEAR ALL PAGES
	MOVE 2,[.FHSLF,,0]
	MOVE 3,[1B0+700]
	JRST 10			;CLEAR MAP AND EXIT

	LIT
   >				;END OF USER DDT ONCE ONLY CODE
   IFN FTMON,<			;MONITOR DDT ONCE ONLY CODE

	TITLE MDDT		;DEC20 MONITOR DDT
	.PSECT NRCOD		;MDDT LIVES WITH SWAPPABLE CODE
	INTERN DDTSYM,DDTUSY

DDTSYM=DDT+1
DDTUSY=DDT+2			;PTR TO UNDEF SYMTAB
VARLOC==774000			;PRIVATE STG AREA, 1 PAGE MAX
   >				;END OF MDDT ONCE-ONLY CODE

PHDDT:
   IFE FTMON,<
	PHASE RUNLOC>		;PHASE IF USER VERSION ONLY
   >				;END IFE FTEXEC
   IFN FTEXEC,<

	TITLE EDDT		;DEC20 EXEC DDT
	.PSECT INCOD		;EDDT LIVES WITH INITIALIZATION CODE
	INTERN DDT,DDTX>
   >				;END IFN FTDEC20
	SUBTTL DEFINE DDT SYMBOLS

   IFN FTEXEC,<
	OPDEF SKPUSR [SKIPL USRFLG] ;SKIP IN USER MODE
	OPDEF SKPEXC [SKIPGE USRFLG] ;SKIP IN EXEC MODE
	OPDEF SKPKA [SKIPG KAFLG] ;SKIP FOR KA10
	OPDEF SKPKI [SKIPE KAFLG] ;SKIP FOR KI10
	OPDEF SKPKL [SKIPL KAFLG] ;SKIP FOR KL10
	OPDEF SKPNKL [SKIPGE KAFLG] ;SKIP NOT KL10
   >				;END IFN FTEXEC

   IFN FTFILE,<
CM==2				;DEFINE SOFTWARE CHANS.
DP==3
   >
;DEFINE ACCUMULATORS

F=0				;FLAGS
P=1				;PUSH DOWN
R=<A=2>				;POINTERS TO TABLES, CORE, ETC.
S=<B=3>
W=<C=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
TT=13				;TEMPORARY
TT1=14				;TEMPORARY
TT2=15				;TEMPORARY (USED FOR PTR INPUT ONLY)
				; AND FOR DTE COMMUNICATIONS

;DEFINE PUSH DOWN LENGTH
LPDL==50			;MAX LENGTH PUSH DOWN LIST

NXMKA==1B23			;NON-EX-MEM FLAG FOR KA10
NXMKI==1B29			;NON-EX-MEM FLAG FOR KI10
NXMKL==1B25			;NON-EX-MEM FLAG FOR KL10

NBP==^D8			;NUMBER OF BREAKPOINTS

   IFN FTDEC20,<
LPDL==100
   IFN FTMON,<LPDL==200>
T1=1
T2=2
T3=3
P=17>				;OVERRIDES P=1 ABOVE

TRPENB==1B22			;SAYS PAGING TRAPS ENABLED
;*** FLAGS IN F ***

FEF==   1B0			;"E" FLAG
COMF==  1B1			;COMMA TYPED
TIF==   1B2			;TRUNCATE TO 18 BITS - SET BY SPACE OR COMMA
DVF==   1B3			;DIVIDE
FPF==   1B4			;"." TYPED
CCF==   1B5			;"$$" TYPED
STF==   1B6			;SUPPRESS TYPEOUT
SAF==   1B7			;RIGHT ANGLEBRACKET TYPED
FAF==   1B8			;LEFT ANGLEBRACKET TYPED
;==     1B9			;NOT USED
MLF==   1B10			;MULTIPLY
PTF==   1B11			;ARITHMETIC OPERATOR TYPED
CF==    1B12			;"$" TYPED
LTF==   1B13			;LETTER TYPED IN CURRENT SYLLABLE
ROF==   1B14			;REGISTER OPEN
SF==    1B15			;SYLLABLE
MF==    1B16			;MINUS SIGN TYPED
QF==    1B17			;QUANTITY TYPED IN TO WORD ASSEMBLER

; 18-21 NOT USED
MDLCLF==1B22			;MULT DEF LOCAL SYMBOL (EVAL)
PNAMEF==1B23			;PROGRAM NAME SEEN IN SYM TABLE SEARCH
POWF==  1B24			;ARGUMENT FOR EXPONENT COMING
LF1==   1B25			;OUTPUT ONE REGISTER IN FORCED MODE
;==     1B26			;NOT USED
CF1==   1B27			;OUTPUT ONE REGISTER AS CONSTANT
NAF==   1B28			;NEGATIVE ADDRESSES PERMISSABLE
; 29-32 NOT USED
OUTF==  1B33			;OUTPUT
ITF==   1B34			;INSTRUCTION TYPED
Q2F==   1B35			;NUMBER TYPED AFTER $

;DEFINE SYMBOL TABLE SYMBOL TYPES
GLOBL==04B5			;GLOBAL SYMBOL
LOCL==10B5
PNAME==74B5			;PROGRAM NAME
DELI==20B5			;DELETE INPUT
DELO==40B5			;DELETE OUTPUT

;DEFINE UNDEFINED SYMBOL TABLE (.JBUSY) TYPES

STADD==1B0			;IF 1, THEN ADDITIVE REQUEST
STLH==1B1			;IF 1, THEN REQUEST FOR LEFT HALF
STNEG==1B4			;IF 1, THEN NEGATIVE REQUEST
   IFE FTDEC20,<
   IFE FTFILE,<
	INTERN DDTEND		;DECLARE END OF DDT AS INTERNAL, FOR
				; USER TO SEE (USER MODE) AND ONCE ONLY CODE
				; (MONITOR)
   IFE FTEXEC,< ENTRY DDT>
   IFN FTEXEC,<
	INTERNAL DDT
	ENTRY DDTX>>		;NEEDED BY MONITOR

   IFN FTEXEC!FTFILE,<

DEFINE OD(A,B),<
	A=:<B,,0>>

;KL10 "FUNNY" I/O INSTRUCTIONS
OD APRID,700000			;READ APR ID
OD WRFIL,700100			;WRITE CACHE REFIL ALGORITHM
OD RDERA,700400			;READ ERROR ADDRESS REGISTER
OD SBDIAG,700500		;S-BUS DIAG
OD RDPERF,702000		;READ PERF. COUNTER
OD RDMACC,702400		;READ MBOX ACCOUTING
OD RDEACC,702440		;READ EBOX ACCOUNTINT
OD WRPAE,702100			;WRITE PERF. ANALYSIS ENABLES
OD SWPIA,701440			;SWEEP INVALIDATE ALL
OD SWPVA,701500			; "   VALIDATE ALL
OD SWPUA,701540			; "   UNLOAD ALL
OD SWPIO,701640			; "   INVALIDATE 1 PAGE
OD SWPVO,701700			; "   VALIDATE 1 PAGE
OD SWPUO,701740			; "   UNLOAD 1 PAGE
   >				;END IFN FTEXEC!FTFILE
	SUBTTL WRITE DDT.VMX
   IFN FTVMX,<
   IFN FTFILE,<
	PRINTX ?CAN NOT BUILD BOTH VMDDT AND FILDDT
	END
   >
   IFN FTEXEC,<
	PRINTX %BUILDING BOTH EDDT AND VMDDT
   >

   IFE ABSDDT&<-1B17>,<
	PRINTX %VMDDT WITH AN OFFSET OF ZERO REQUESTED.
	PRINTX % OFFSET OF 700000 WILL BE USED
	ABSDDT==ABSDDT!7B2
   >

DEFINE MERR (TXT)<
	JRST [	OUTSTR [ASCIZ "
? TXT
"]
		 EXIT]
   >

MAKDDT:	RESET
	INIT 1,17
	SIXBIT /DSK/
	0
	 MERR CAN NOT INIT DEVICE DSK:
	ENTER 1,DDTVMX
	 MERR CAN NOT ENTER DSK:DDT.VMX
	OUT 1,IOWD
	SKIPA
	 MERR OUTPUT ERROR WRITING DSK:DDT.VMX
	CLOSE 1,
	STATZ 1,740000
	 MERR OUTPUT ERROR CLOSING DSK:DDT.VMX
	OUTSTR [ASCIZ "
DSK:DDT.VMX WRITTEN
"]
	EXIT

DDTVMX:	SIXBIT /DDT/
	SIXBIT /VMX/
	EXP 0,0
IOWD:	IOWD DDTEND-DDT+1,DDTORG
	EXP 0
	XLIST			;MAKDDT LITERALS
	LIT
	LIST

DDTORG:	PHASE ABSDDT_<-^D18>
   >
   >				;END IFE FTDEC20
	SUBTTL START DDT

DDTOFS:				;OFFSET BASE FOR DISPATCH TABLES

   IFE FTFILE,<
DDTX:
   IFN FTYANK,<
	SETZM COMAND		;INDICATE NO COMMAND FILE IF STARTING BY DDT COMMAND
   >
DDT: IFN FTDEC20&<^-FTEXEC>,<
MDDTX::	JRST .+2		;SKIP SYMTAB PTRS
	Z .DDSYM
	JUMP .DDUSY
	MOVEM T,SETRT1		;SAVE AN AC
	MOVE T,BP1+1
	CAMN T,[JSR BCOM]	;VARIABLES AREA INITIALIZED?
	JRST DDTIN1		;YES
	MOVE T,[PHVAR,,VARLOC]	;NO, DO IT
	BLT T,VAREND-1
DDTIN1:	MOVE T,SETRT1		;RESTORE SCRATCH AC
   >				;END IFN FTDEC20...
	JSR SAVE
	 PUSHJ P,REMOVB
   IFN FTEXEC!FTDEC20,<
	MOVE W1,[ASCII /DDT/]
   IFN FTEXEC,<
	SKPUSR
	MOVE W1,[ASCII /EDDT/]
   >
IFN FTMON,<
	MOVE W1,[ASCIZ/MDDT/]	;IF TOPS-20 MDDT, SAY "MDDT"
  >
	PUSHJ P,TEXT2		;TYPE MESSAGE SAYING WHICH DDT
   >				;END FTEXEC!FTDEC20
   >				;END FTFILE

   IFN FTVMX,<			;IF THIS IS VMDDT
	MOVE W1,[ASCII "VMDDT"]	;PREPARE TO SAY VMDDT
	PUSHJ P,TEXT2		;PRINT THE MESSAGE
   >				;END VMDDT SWITCH
	SUBTTL FILDDT -- COMMAND SCANNER
   IFN FTFILE,<
DDT:	CALLI
	SETZM COMAND		;CLEAR $Y FLAG
	SETZM FWAZER		;CLEAR BLOCK OF STORAGE
	MOVE T,[FWAZER,,FWAZER+1]
	BLT T,LWAZER
	MOVE P,[IOWD LPDL,PDL]	;PRESET PUSH DOWN LIST
	MOVSI T,'DSK'		;PRESET DEVICE
	MOVEM T,FILDEV+1
	OUTSTR [ASCIZ /File: /]
	SETOM DEPNCT		;PRESET DEPOSIT ERROR COUNT TO -1
	PUSHJ P,TINCH
	 JRST FDINO		;IN CASE NULL LINE TYPED IN
	SETOM CRASHS		;PRESET FOR FILE MODE
	MOVEI TT,0		;CLEAR NAME
	MOVE TT1,[POINT 6,TT]	;PRESET ACCUMULATOR

FDILP:	CAIN T,"/"		;SEE IF SWITCH
	JRST FDISW		;YES--GO DO IT
	CAIN T,":"		;SEE IF DEVICE
	JRST [	JUMPE TT,FDIERR
		 MOVEM TT,FILDEV+1
		 JRST  FDILNP]
	CAIN T,"."		;SEE IF EXTENSION FLAGGED
	JRST [	MOVEM TT,FILBLK
		 SETOM FDIDOT
		 JRST  FDILNP]
	CAIE T,"["		;SEE IF PPN FLAGGED
	JRST FDILET		;NO--MUST BE IN NAME
	PUSHJ P,FDIOCT		;YES--GET PROJECT
	JUMPLE TT2,FDIERR	;DISALLOW JUNK
	CAIG TT2,377777		;DISALLOW INVALID NUMBERS
	CAIE T,","		;VERIFY
	JRST FDIERR		;BOMB ERROR
	HRLZM TT2,FILBLK+3	;STORE
	PUSHJ P,FDIOCT		;GET PROGRAMMER
	JUMPLE TT2,FDIERR	;DISALLOW JUNK
	CAILE TT2,-1		;DISALLOW INVALID
	JRST FDIERR		;  NUMBERS
	HRRM TT2,FILBLK+3	;STORE
	JUMPE T,FDILDP		;EXIT IF DONE
	CAIE T,"]"		;SEE IF END OF PPN
	JRST FDIERR		;NO--BOMB OUT
	JRST FDILOP		;GET MORE WORDS
;STILL FTFILE

FDIOCT:	MOVEI TT2,0		;CLEAR ANSWER
FDIOC1:	PUSHJ P,TINCH		;GET CHAR
	 POPJ P,		;IF DONE
	TLNE TT2,(7B2)		;IF OVERFLOWING,
	POPJ P,			;  GIVE UP
	CAIL T,"0"		;SEE IF
	CAILE T,"7"		;  OCTAL
	POPJ P,			;NO--GIVE UP
	LSH TT2,3		;YES--MULT AC
	ADDI TT2,-"0"(T)	;INCREMENT
	JRST FDIOC1		;LOOP

FDILET:	CAIL T,"0"		;SEE IF ALPHA-NUM
	CAILE T,"Z"
	JRST FDIERR
	CAILE T,"9"
	CAIL T,"A"
	JRST .+2
	JRST FDIERR
	SUBI T,40		;YES--MAKE SIXBIT
	TLNE TT1,(77B5)		;DON'T OVERFLOW
	IDPB T,TT1		;STORE
	JRST FDILOP		;AND LOOP
;STILL FTFILE

FDIERF:	OUTSTR [ASCIZ /? Can't get at file
/]
	JRST FDIERE

FDIHLP:	ASCIZ \
Type  dev:file.ext[p,pn]/switches

/M  examine monitor
/P  patch monitor or file
	type ^Z to exit from file patching
/S  reload symbol table from file

   IF no spec, examine monitor
file defaults:  if /P or /S:  DSK:SYSTEM.XPN
		else:  DSK:CRASH.XPN

use $Y to read DSK:FILDDT.DDT and write LPT:FILDDT.LST

\

BADEXE:	OUTSTR [ASCIZ "
?BAD DIRECTORY IN .EXE FILE
"]
	JRST FDIERE
;STILL FTFILE

TINCH:	INCHWL T		;GET NEXT CHAR
	CAIE T,177
	CAIN T,15
	JRST TINCH
	CAIE T,40
	CAIN T,11
	JRST TINCH
	CAIE T,3
	CAIN T,32
	JRST [	RESET
		 EXIT 1,
		 JRST DDT]
	JUMPE T,TINCH
	CAIGE T,175
	CAIGE T,40
	JRST [	MOVEI T,0
		 POPJ  P,]
	CAIL T,140
	SUBI T,40
	JRST CPOPJ1


FDISW:	PUSHJ P,TINCH		;GET SWITCH
	 JRST FDIERR
	CAIN T,"H"		;HELP
	JRST [	OUTSTR FDIHLP
		 JRST   FDIERE]
	CAIN T,"P"		;PATCH
	JRST [	SETOM PATCHS
		 JRST FDILOP]
	CAIN T,"S"		;LOAD SYMBOLS
	JRST [	SETOM SYMGET
		 JRST  FDILOP]
	CAIN T,"M"		;MONITOR
	JRST [	SETZM CRASHS
		 JRST  FDILOP]
				;FALL INTO ERROR
;STILL FTFILE

				;FALL HERE FROM ABOVE
FDIERR:	OUTSTR [ASCIZ \? Command error -- type /H for help
\]

FDIERE:	CLRBFI			;CLEAR ANY TYPE AHEAD
	JRST DDT		;AND START OVER


FDILNP:	MOVEI TT,0		;CLEAR WORD
	MOVE TT1,[POINT 6,TT]	;RESET POINTER
FDILOP:	PUSHJ P,TINCH		;GET NEXT CHAR
	 SKIPA
	JRST FDILP		;LOOP BACK TO PROCESS IT

FDILDP:	SKIPE TT		;ALL DONE--SEE IF FILE NAME ASSEMBLED
	JRST [	SKIPE FDIDOT
		 HLLZM TT,FILBLK+1
		 SKIPN FDIDOT
		 MOVEM TT,FILBLK
		 JRST  .+1]

FDINO:	SKIPE PATCHS		;SEE IF /P
	SKIPN CRASHS		;AND NOT /M
	JRST .+2		;NO
	SETOM SYMGET		;YES--SET /S
	MOVEI T,17		;PRESET I/O MODE
	MOVEM T,FILDEV
	MOVE T,['CRASH ']
	SKIPE SYMGET		;SEE IF /S OR /P
	MOVE T,['SYSTEM']
	SKIPN FILBLK		;PRESET FILE NAME
	MOVEM T,FILBLK
	MOVSI T,'XPN'		;AND FILE EXT
	SKIPN FDIDOT
	HLLZM T,FILBLK+1
;STILL FTFILE

	SKIPN SYMGET		;SEE IF /S
	SKIPE CRASHS		;SEE IF /M
	JRST .+2		;/S OR -/M
	JRST FDINOT		;PROCEED IF NOT

	OPEN 1,FILDEV		;YES--OPEN FILE
	 JRST FDIERF
	PUSH P,FILBLK+3		;SAVE PPN
	LOOKUP 1,FILBLK		;LOOK IT UP
	 JRST [	HLRZ T,FILBLK+1
		 CAIE T,'XPN'
		 JRST FDIERF
		 MOVSI T,'EXE'
		 MOVEM T,FILBLK+1
		 MOVE T,(P)
		 MOVEM T,FILBLK+3
		 LOOKUP 1,FILBLK
		  JRST FDIERF
		 JRST .+1]
	HLRE T,FILBLK+3		;GET LENGTH
	SKIPGE T
	MOVNS T
	SKIPL FILBLK+3
	IMULI T,^D128
	MOVEM T,MONSIZ		;STORE AS WORDS
	POP P,FILBLK+3		;RESTORE PPN
	SKIPE PATCHS		;SEE IF PATCHING
	SKIPN CRASHS		;YES--SEE IF FILE
	JRST FDINOE		;NO--SKIP ENTER
	SETZM FILBLK+2		;CLEAR E+2
	HLLZS FILBLK+1		;CLEAR RH(E+1)
	ENTER 1,FILBLK		;/P AND -/M
	 JRST FDIERF
FDINOE:	USETI 1,1		;POSITION TO START
	INPUT 1,[IOWD 2003,WIND0
		   0]		;READ DIRECTORY
	STATZ 1,740000		;CHECK FOR ERRORS
	 JRST [	OUTSTR [ASCIZ \? I/O error\]
		 HALT   .-3]
	HLRZ T,WIND0		;GET FIRST WORD
	CAIE T,1776		;IS THIS IN .EXE FORMAT?
	JRST FDIXPN		;NO--SEE IF .XPN FORMAT
	SUBTTL FILDDT -- PROCESS .EXE FILE

;FILE IS IN .EXE FORMAT -- PROCESS DIRECTORY
	HRRZ W1,WIND0		;GET WORD COUNT
	TRZN W1,1		;IS WORD COUNT ODD?
	JRST BADEXE		;NO--SOMETHING IS WRONG
	LSH W1,-1		;CONVERT TO # OF ENTRIES
	MOVEI W2,WIND0+1	;FIRST ENTRY
FDIXL0:	HRRZ TT1,1(W2)		;GET PROCESS PAGE NUMBER
	CAIL TT1,MX.SIZ		;OUT OF RANGE
	JRST BIGEXE		;YES--FILE IS BIG
	ADDI TT1,PAGTBL		;FIRST PAGTBL SLOT
	MOVE TT2,(W2)		;GET ENTRY
	LDB TT,[POINT 9,1(W2),8] ;GET COUNT
FDIXL1:	TLNN TT2,1777		;JUNK IN LH
	CAIL TT1,PAGTBL+MX.SIZ	;IN TABLE?
	JRST BADEXE		;BAD DIRECTORY
	MOVEM TT2,(TT1)		;STORE IN PAGTBL
	TRNN TT2,3777		;ALLOCATED BUT ZERO?
	SETZM (TT1)		;YES--GIVE A ? ON FETCH
	ADDI TT1,1		;INCREMENT POINTERS
	TRNE TT2,3777		;DO NOT CHANGE ALLOCATED BUT
				; ZERO TO PAGE 1
	ADDI TT2,1		; ..
	SOJGE TT,FDIXL1		;LOOP OVER THIS ENTRY
	ADDI W2,2		;STEP TO NEXT ENTRY
	SOJG W1,FDIXL0		;LOOP OVER ENTRE DIRECTORY
	JRST FDISET
FDIXPN:	SETOM XPNFMT		;FLAG AS .XPN FORMAT
	SKIPE WIND0		;IN .XPN FORMAT
	JRST [	OUTSTR [ASCIZ /% Not in .XPN format
/]
		 SETZM SYMGET
		 JRST    .+1]
	MOVE T,MONSIZ		;SIZE OF FILE
	ADDI T,777		;ROUND UP
	LSH T,-9		;CONVERT TO PAGES
	CAIL T,MX.SIZ		;TOO BIG
	MOVEI T,MX.SIZ-1	;YES--ROUND DOWN
FDIXPL:	TLO T,(1B2)		;SET WRITEABLE BIT
	MOVEM T,PAGTBL(T)	;STORE POINTER
	TLZ T,-1		;CLEAR FLAGS
	SOJGE T,FDIXPL		;LOOP OVER WHOLE FILE
	SUBTTL FILDDT -- SETUP SYMBOLS

;PAGTBL IS SETUP MOVE AC'S (IF ARROUND) AND START DDT
FDISET:	SKIPE SYMGET		;SEE IF /S
	PUSHJ P,SYMFIX		;YES--GO GET THEM
	SKIPE CRASHS		;ARE WE LOOKING AT A CRASH
	SKIPE PATCHS		; AND NOT PATCHING?
	JRST FDIST1		;NO--CONTINUE
	SKIPE SYMGET		;GETTING SYMBOLS
	JRST FDIST1		;YES--LEAVE AC'S WHERE THEY ARE
	MOVE T,[RADIX50 0,CRSHAC]
	MOVEM T,SYM		;LOOKUP CRSHAC
	PUSHJ P,EVAL		; IN SYMBOL TABLE
	 JRST FDIST1		;CAN NOT FIND IT
	MOVSI W1,-20		;NUMBER OF AC'S
	HRRI R,(T)		;WHERE THE AC'S ARE
FDIGAC:	PUSHJ P,FETCH		;GET THE AC
	 JRST FDIST1		;CAN NOT FETCH
	MOVEM T,AC0(W1)		;STORE AC
	ADDI R,1		;POINT TO NEXT CELL
	AOBJN W1,FDIGAC		;GET THE AC'S
	OUTSTR [ASCIZ "[ACS COPIED FROM CRSHAC TO 0-17]
"]
FDIST1:	SKIPN CRASHS		;SEE IF REASON TO HOLD OPEN
	RELEAS 1,		;NO--CLEAR FILE
	SKIPE SYMGET		;SEE IF /S
	SKIPE PATCHS		;SEE IF /P
	JRST FDINOT		;CONTINUE IF /P OR -/S
	SKIPE CRASHS		;SEE IF -/M
	JRST DDT		;IF /S AND NOT /P OR /M, START OVER

FDINOT:	JRST DD1		;GO START DDT

BIGEXE:	OUTSTR [ASCIZ "?TOO MANY PAGES IN .EXE FILE
?REBUILD FILDDT WITH MX.SIZ SET LARGER
"]
	JRST FDIERE		;PUNT
;STILL FTFILE

EXTERN .JBREN,.JBCOR

SYMFIX:	PUSHJ P,SYMPTR		;GO GET SYMBOL POINTER IN T AND TT
	MOVEM TT,FIUPTR		;SAVE JOBUSY
	HLRES TT,TT
	MOVMS TT,TT
	MOVEM T,FISPTR		;SAVE IT
	HLRES T,T
	MOVMS T,T		;LENGTH OF SYMBOL TABLE
	SKIPN W,SAVEFF		;PICK UP START OF SYMBOL TABLE
	MOVE W,.JBFF		;GET FROM LOADER IF FIRST TIME
	MOVEM W,SAVEFF		;SAVE FOR FUTURE PASSES
	ADDI W,200		;LEAVE SPACE FOR EXTRA SYMBOL DEFNS.
	HRRZ W1,W		;SAVE LOC FOR COPY
	ADD W,T			;ADD TABLE LENGTH
	ADD W,TT		;INCLUDE USY TABLE
	HRRZM W,.JBFF		;UPDATE MONITOR TO END FOR ITS BUFFER
	HRLM W,.JBSA		; ALLOCATION MECHANISMS
	HRLM W,.JBCOR		;INDICATE SYMBOLS FOR SAVE
	CALLI W,11		;GET CORE
	 JRST [	OUTSTR [ASCIZ /? Not enough core
/]
		 JRST   DDT]

	MOVE R,FIUPTR		;GET USY POINTER
	JUMPGE R,SYMCPY		;SKIP IF NONE
	HRRM W1,FIUPTR
UCOPY:	PUSHJ P,FETCH
	 JRST ERR
	MOVEM T,(W1)
	AOS W1
	AOBJN R,UCOPY

SYMCPY:	MOVE R,FISPTR		;WHEREABOUTS OF MONITOR SYMBOLS
	HRRM W1,FISPTR		;NOW POINT TO FILDDT SYMBOLS
	JUMPGE R,CPOPJ		;RETURN IF NO TABLE
TCOPY:	PUSHJ P,FETCH		;GET A WORD
	 JRST ERR
	MOVEM T,0(W1)		;STASH IT
	AOS W1
	AOBJN R,TCOPY
	POPJ P,			;RETURN TO CALLER
;STILL FTFILE

REPEAT 0,<
THE MONITOR CAN BE LOADED IN ANY OF THREE WAYS(IN ORDER OF PREFERENCE):
	1. UNDER TIME SHARING WITH REGULAR LOADER AND COMMON
	2. UNDER SPECIAL 10/30 MONITOR(SPMON) WITH REGULAR 10/30 LOADER & COMMON
	3. UNDER SPECIAL 10/30 MONITOR(SPMON) WITH BUILD

THE 3 WAYS LEAVE XJBSYM(36),.JBSYM(116) & T30SYM(131) IN DIFFERENT STATES:

	XJBSYM          .JBSYM          T30SYM

	1.  JUNK            S.T.PTR         JUNK
	2.  JUNK            JUNK(NON-NEG)   S.T.PTR
	3.  S.T.PTR         S.T.PTR         JUNK

ALSO, MORE LIKELY, IS THAT EDDT HAS ALREADY RUN ONCE:
	S.T.PTR		OLD S.T.PTR JUNK
   >


SYMPTR:	MOVSI S,-LN.TRY		;PRESET TABLE FOR TRIES AT PTRS
SYMPT1:	HLRZ R,PTRTRY(S)	;GET USY LOCATION
	MOVEI T,0		;(IN CASE SKIP)
	JUMPE R,SYMPT2		;JUMP IF NONE
	PUSHJ P,FETCH		;GET IT
	 JRST ERR
SYMPT2:	MOVE TT,T		;SAVE AS ANSWER
	HRRZ R,PTRTRY(S)	;GET SYM LOCATION
	PUSHJ P,FETCH		;GET POINTER
	 JRST ERR
	JUMPL T,SYMPT3		;IF GOOD, CONTINUE
	AOBJN S,SYMPT1		;ELSE LOOP
SYMPT3:	MOVE S,PTRTRY(S)	;GOOD--PICK UP LOCATIONS
	JUMPGE TT,SYMPT4	;MAKE SURE USY TABLE IS OK
	HLRE W,TT		;  BY COMPARING
	MOVMS W			;  ITS END
	ADDI W,(TT)		;  WITH START OF SYM
	CAIE W,(T)		;IF EQUAL, OK
SYMPT4:	MOVEI TT,0		;NO--CLEAR USY POINTER
	POPJ P,			;RETURN

PTRTRY:	XJBUSY,,XJBSYM		;IN CASE EDDT HAS RUN
	.JBUSY,,.JBSYM		;REGULAR LOADER RAN LAST
	0,,T30SYM		;10/30 LOADER
	XJBUSY,,XJBSYM		;BUILD OR JUNK
LN.TRY==.-PTRTRY

   >				;END FTFILE
	SUBTTL DDT COMMAND PARSER

DD1:	PUSHJ P,CRF
DD1.5:	TLZ F,(ROF)		;CLOSE ANY OPEN REGISTER
	MOVE T,[XWD SCHM,SCH]
	BLT T,ODF		;LOAD ACS
	MOVS T,[SVBTS,,PSVBTS]
	BLT T,SVBTS+2
DD2:	CLEARM PRNC		;PARENTHESES COUNT
	MOVE P,[IOWD LPDL,PDL]
LIS:	SETZM WAKALL		;SET WAKEUP SET TO PUNCT AND CTRLS
   IFN FTDEC20,<
	MOVEI R,.JBSYM		;VALIDATE JOB DATA AREA - CHECK .JBSYM
	PUSHJ P,FETCH
	 SETZ T,		;CAN'T REF PAGE 0, NO JOBDAT
	SKIPL T			;VALID SYMTAB PTR?
	SETZM JDTFLG>		;NO, NOTE NO JOBDAT
	SKIPGE R,@USYMP		;GET UND SYM PTR, OK?
	PUSHJ P,FETCH		;MAYBE, SEE IF CAN REFERENCE IT
	 SETZM @USYMP		;NO GOOD, FLUSH IT
	MOVE T,@USYMP		;GET UNDEF SYMBOL POINTER
	JUMPL T,LIS0B		;IF POINTER OK, TRANSFER
	SKIPGE T,@SYMP		;IF POINTER NOT OK, USE .JBSYM ADR
	JRST LIS0A		; SO LONG AS IT IS NEGATIVE
   IFE FTFILE,<
	MOVEI R,.JBHSM		;IF LO ADR NOT OK, TRY HIGH
   IFN FTEXEC,<SKPEXC>		; UNLESS IN EXEC MODE
	PUSHJ P,HFETCH>		;GET HIGH SYM TABLE POINTER
	 MOVEI T,0		;IT DOESN'T EXIST
	JUMPG T,.-1		;IF POINTER .G. 0, GIVE 0 RESULT
LIS0A:	HRRZS T			;USE ADR OF SYM TABLE TO INIT
	MOVEM T,@USYMP		;  UNDEFINED SYM TABLE POINTER
LIS0B:	MOVEM T,ESTUT		;INIT UNDEFINED SYM ASSEMBLER
	TLZ F,(-1B17-ROF-STF)	;CLEAR FLAGS EXCEPT ROF, STF
	TRZ F,LF1+CF1+ITF+Q2F	;CLEAR FLAGS
LIS0:	TLZ F,(-1B17-ROF-STF-FAF-SAF) ;CLEAR FLAGS EXCEPT ...
	TRZ F,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
L1A:	SETZM SYL
L1RPR:	SETZM SYM
	MOVEI T,6
	MOVEM T,TEM		;INIT SYMBOL COUNTER
	MOVE T,[POINT 7,TXT]
	MOVEM T,CHP		;SETUP FOR OPEVAL SYMBOL
	SETZM DEN
	SETZM WRD2

;CONTINUED ON NEXT PAGE
L2:	PUSHJ P,TIN		;PICK UP CHARACTER
	CAIL T,"A"+40		;LOWER CASE A
	CAILE T,"Z"+40		;LOWER CASE Z
	JRST .+2
	TRC T,40		;CHANGE LOWER CASE TO UPPER CASE
	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		;DISPATCH TABLE HAS ENTRIES ONLY .LE. 137
	JRST ERR
	IDIVI R,3		;REMAINDER GIVES COLUMN, QUOTIENT GIVES ROW
	LDB W,BDISP(R+1)	;GET 12 BIT ADDRESS FROM DISPATCH TABLE
	CAIGE W,MULT-DDTOFS	;FIRST EVAL ROUTINE
	JRST DDTOFS(W)
	MOVE T,SYL
	TLZN F,(LTF)
	JRST POWER
	CAIN W,SPACE-DDTOFS	;IS TERMINATOR A SPACE?
	SKIPE WRD		;IS CONSTRUCTED WORD SO FAR ZERO?
	SKIPA T,[OPEVAL,,EVAL]	;SEARCH EVAL 1ST IFF: -SPACE .OR. (WRD).NE.0
	MOVS T,[OPEVAL,,EVAL]	;SEARCH OPEVAL 1ST IFF: SPACE .AND. (WRD)=0
	MOVEM T,SYMORD		;SAVE SYMBOL TABLE SEARCH ORDER
	JRST L213
L212:	HLRZS T,SYMORD		;GET ADDRESS OF THE OTHER LOOKUP ROUTINE
	JUMPE T,UND1		;IF ADR=0, THEN SYMBOL UNDEFINED
L213:	PUSHJ P,(T)		;CALL OPEVAL OR EVAL
	 JRST L212		;SYMBOL NOT FOUND
	CAIN W,ASSEM-DDTOFS	;DEFINED SYMBOL FOLLOWED BY #?
	JRST ERR		;IF DEFINED, DON'T ALLOW #
L4:	TLZE F,(MF)
	MOVN T,T
	TLNN F,(SF)
	CAIE W,LPRN-DDTOFS
	JRST .+2
	JRST LPRN

	EXCH T,FRASE1
	TLNN F,(DVF)
	IMULB T,FRASE1
	TLZE F,(DVF)
	IDIVB T,FRASE1
	CAIGE W,ASSEM-DDTOFS
	JRST DDTOFS(W)		;MULTIPLY OR DIVIDE
	ADDB T,FRASE
	CAIGE W,SPACE-DDTOFS
	JRST DDTOFS(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,@USYMP		;IF THERE ARE ANY UNDEFINED SYMBOLS IN
	JRST L5			;THE CURRENT EXPRESSION, ANYTHING EXCEPT
	CAILE W,CARR-DDTOFS	;FURTHER EXPRESSION INPUT, OR DEPOSITING
	JRST ERR		;  INTO MEMORY IS ILLEGAL
L5:	CAIG W,RPRN-DDTOFS
	JRST DDTOFS(W)
	PUSH P,KILRET		;WHEN INSIDE ( ), CURRENT EXPRESSION
	SKIPN PRNC		;INVALID FOR ANYTHING OTHER
	JRST DDTOFS(W)		;  THAN MORE EXPRESSION INPUT
	JRST ERR
WRONG:	MOVE W1,[ASCII /XXX/]
	PUSHJ P,TEXT
	JRST WRONG2

ERR:	MOVSI W1,(BYTE (7)"?","G"-100) ;QUESTION-DING
	JRST WRONG1

UNDEF:	MOVEI W1,"U"
WRONG1:	MOVE P,[IOWD LPDL,PDL]
	PUSHJ P,TEXT
	PUSHJ P,TTYCLR		;CLEAR INPUT BUFFER
WRONG2:	TLNN F,(ROF)		;REGISTER OPEN?
	JRST DD1		;NO, CRLF.  OTHERWISE, FALL INTO RET
RET:	MOVE P,[IOWD LPDL,PDL]
	PUSHJ P,LCT		;COMMON RETURN FOR TAB;,JRST LIS
	JRST DD2


UND1:	MOVE R,ESTUT		;UNDEFINED SYM ASSEMBLER
	JUMPE R,UNDEF		;UNDEFINED IF NO UNDEF SYM TABLE
	HLRE S,ESTUT
	ASH S,-1		;SETUP EVAL END TEST
	PUSHJ P,EVAL2
	CAIN W,ASSEM-DDTOFS
	TLNN F,(ROF)
	JRST UNDEF
	SKIPE PRNC
	JRST UNDEF
	MOVEI T,"#"
	CAIE W,ASSEM-DDTOFS
	PUSHJ P,TOUT

	MOVN R,[XWD 2,2]
	ADDB R,ESTUT
	MOVE T,SYM
	TLO T,(GLOBL)
	PUSHJ P,DSYMER		;DEPOSIT AND TYPE ? IF IT FAILS
	HRRZ T,LLOCO
	TLNE F,(MF)
	TLO T,(STNEG)		;SET FLAG TO SHOW SUBTRACTIVE REQUEST
	TLO T,(STADD)		;SET FLAG TO SHOW UNCHAINED REQUEST
	ADDI R,1
	PUSHJ P,DSYMER
	MOVEI T,0
	JRST L4
QUESTN:	PUSHJ P,CRF		;HERE FOR "?"
	TLNE F,(LTF)		;HAS A SYMBOL BEEN TYPED?
	JRST QLIST		;NO
	MOVE R,@USYMP		;YES, LIST UNDEFINED SYMBOLS
QUEST1:	JUMPGE R,DD1
	MOVE T, (R)
	SKIPA W1,@USYMP

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

QLIST:	PUSHJ P,SYMSET		;LIST REFERENCES TO THE SYMBOL
QLIST1:	SETZM QLPNT		;ZERO FLAG SHOWING REFERENCE
QLIST2:	MOVE T,(R)		;PICK UP SYMBOL
	TLZN T,(PNAME)		;A PROGRAM NAME?
	JRST QLIST6		;YES
	CAMN T,SYM		;NO, IS AN OCCURANCE FOUND?
	HRRZM R,QLPNT		;YES, REMEMBER WHERE
QLIST3:	AOBJN R,.+1		;LOOK THRU TABLE
	AOBJN R,QLIST4		;END OF TABLE SEGMENT?
   IFE FTFILE,<
	TRNN R,1B18		;YES, WRAP AROUND
	SKIPL R,SAVHSM
   >
	MOVE R,@SYMP
QLIST4:	AOJLE S,QLIST2		;THRU SEARCHING?
	JRST DD1		;YES

QLIST6:	SKIPN QLPNT		;FOUND THE SYMBOL?
	JRST QLIST3		;NO
	PUSHJ P,SPT1		;YES, PRINT THE PROGRAM NAME
	MOVE T,@QLPNT		;GET THE SYMBOL BACK AND
	TLNN T,(GLOBL)		; TEST FOR A GLOBAL SYMBOL
	JRST QLIST7		;NOT GLOBAL
	PUSHJ P,TSPC		;IS GLOBAL, TYPE " G"
	MOVEI T,"G"
	PUSHJ P,TOUT
QLIST7:	PUSHJ P,CRF
	SETZM QLPNT		;RESET FLAG
	JRST QLIST3		; AND SEARCH THE NEXT SET OF SYMBOLS
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,DEN
	IMULI W,12		;CONVERT TO DECIMAL
	ADD W,T
	MOVEM W,DEN
	AOJA T,LE1A

DOLLAR:	SKIPA T,[46+101-13]	;RADIX 50 $ TO BE
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
	CLEARM DEN
LET1:	SUBI T,101-13		;FORM RADIX 50 SYMBOL
LE1A:	TLO F,(SF+QF)
LE2:	SOSGE TEM		;IGNORE CHARACS AFTER 6
	JRST L2
	MOVEI W,50
	IMULM W,SYM		;MULTIPLY BY RADIX 50
	ADDM T,SYM		;  AND ADD NEW CHAR INTO SYM
	MOVEI T,"A"-13(T)	;CONVERT LETTERS BACK TO ASCII
	IDPB T,CHP
	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		;FORM FLOATING POINT NUMBER
	AOS NM1A
	XCT NM1A		;MOVEI W2,..
	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		;COMPUTE VALUE OF NEW DIGIT
	FADRB R,FH		;ADD VALUE INTO FLOATING NO.
	MOVEM R,SYL
	AOJA T,LE1A

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,DEN
	CLEARM 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,DEN
	MOVEM T,SYL
	TLNE F,(FPF)		;HAS A PERIOD BEEN SEEN BEFORE?
	TLO F,(LTF)		;YES, TWO PERIODS MAKES A SYMBOL
	TLON F,(FPF+SF+QF)
	MOVEI T,0
	IDIVI T,400
	SKIPE T
	TLC T,243000
	TLC W1,233000
	FAD T,[0]		;NORMALIZE T AND W1
	FAD W1,[0]
	FADR T,W1
	MOVEM T,FH
	HLLZS NM1A
	MOVEI T,45		;RADIX 50 PERIOD
	JRST LE2

   IFE FTFILE,<
PILOC:	MOVEI T,SAVPI>		;GET ADDRESS FOR $I
QUANIN:;TLO T,(DDTINT)		;(FUTURE) FLAG DDT INTERNAL REGISTERS
	JRST QUAN1

QUAN:	TLNN F,(CCF)		;$Q OR $$Q, WHICH?
	SKIPA T,LWT		;$Q STRAIGHT
QUANSW:	MOVS T,LWT		;$$Q SWAPPED (ALSO FOR $V)
QUAN1:	MOVEM T,SYL
QUAN2:	TLO F,(SF+QF)		;WRD,SYL STARTED
	TLZ F,(CF+CCF)
	JRST L2

;HERE WHEN ESC TYPED

CONTRO:	TLOE F,(CF)
	TLO F,(CCF)
	SETOM WAKALL		;SET WAKEUP ON EVERYTHING
	JRST L2

   IFN FTFILE,<PILOC==ERR>
SUBTTL SYMBOL TABLE LOGIC
;SYMBOL EVALUATION ROUTINE

EVAL:	PUSHJ P,CSHVER		;GO SEE IF CACHE IS USEFUL
	 JRST EVALC4		;ITS NOT. GO DO OLD STYLE LOOKUP
	MOVSI S,-NSYMCS		;SCAN SYMBOL CACHE FIRST
EVALC1:	SKIPN R,SYMCSH(S)	;GET POINTER
	JRST EVALC3		;NOT IN USE
	MOVE T,0(R)		;GET SYM
	TLZ T,(PNAME)		;FLUSH BITS
	CAMN T,SYM		;SAME?
	JRST EVALC2		;YES, DONE
EVALC3:	AOBJN S,EVALC1		;KEEP LOOKING
EVALC4:	PUSHJ P,SYMSET		;SET UP SYM TABLE POINTER AND COUNT

;CERTAIN CALLS ENTER HERE WITH S AND R ALREADY SETUP

EVAL2:	TRZ F,PNAMEF!MDLCLF	;CLEAR FLAGS FOR EVAL
	SETZM SYMPNT		;CLEAR LOCAL SYM POINTER
	JUMPE S,CPOPJ		;XFER IF SYM TABLE EMPTY
	JUMPGE R,CPOPJ		;XFER IF POINTER NOT VALID

EVAL3:	MOVE T,0(R)		;GET SYM FROM SYM TABLE
	TLZN T,(PNAME)		;PROGRAM NAME? ALSO CLEAR THE FLAGS
	JRST [	JUMPE T,EVAL4	;YES, IGNORE IF SYMBOL IS NULL
		TRO F,PNAMEF	;SET PROGRAM NAME FLAG
		JRST EVAL4]
	CAMN T,SYM		;SYMBOL MATCH?
	JRST EVAL6		;YES
EVAL4:	AOBJN R,.+1		;NO VALID MATCH, CONTINUE LOOKING
	AOBJN R,EVAL4A		;POINTER EXPIRED?
   IFE FTFILE,<
	TRNN R,1B18		;TEST FOR HIGH SEGMENT SYM TABLE
	SKIPL R,SAVHSM		;WAS LOW SEG, GET HIGH SEG POINTER, IF ANY
   >
	MOVE R,@SYMP		;WRAP AROUND TO LOW SEG END OF TABLE
EVAL4A:	AOJLE S,EVAL3		;TRANSFER IF ANY SYMBOLS LEFT
	SKIPN R,SYMPNT		;SEARCH FINISHED, ANY LOCAL SYMS OUTSIDE
	POPJ P,			;CURRENT PROGRAM AREA?
	TRNE F,MDLCLF		;YES, WITH A UNIQUE VALUE?
	JRST ERR		;NO, AMBIGIOUS
EVAL5:	HRRZ W1,R
	PUSHJ P,SYMCSI		;ADD SYM TO CACHE
EVALC2:	MOVE T,1(R)		;GET VALUE OF SYMBOL
CPOPJ1:	AOS (P)			;FOUND SYMBOL, SKIP
CPOPJ:	POPJ P,

EVAL6:	MOVE T,(R)		;SYM MATCHES, GET FLAGS BACK
	TLNE T,(DELI)		;IS SYMBOL DELETED FOR INPUT?
	JRST EVAL4		;YES
	TLNN T,(GLOBL)		;GLOBAL SYMS VALID ANYWHERE
	TRNN F,PNAMEF		;HAS SECOND PROGRAM TABLE BEEN STARTED?
	JRST EVAL5		;LOCALS ALWAYS VALID IN CURRENT PROGRAM
	SKIPN T,SYMPNT		;LOCAL OUTSIDE OF CURRENT PROGRAM
	JRST EVAL7		;YES, AND THE 1ST ONE OF THEM
	MOVE T,1(T)		;GET VALUE OF PREVIOUS LOCAL
	CAME T,1(R)		;IS IT THE SAME VALUE?
	TRO F,MDLCLF		;NO, MULTIPLY DEFINED
EVAL7:	MOVEM R,SYMPNT		;SAVE POINTER TO THIS LOCAL
	JRST EVAL4		;CONTINUE LOOKING FOR GLOBALS

;BIT 40 - DELETE OUTPUT
; 20 - DELETE INPUT
; 10 - LOCAL
; 04 -GLOBAL
; NO BITS - PROGRAM NAME
;SYMBOL TABLE POINTER AND COUNT SET UP ROUTINE

SYMSET:	IFE FTFILE,<
	MOVEI R,.JBHSM		;TRY TO GET HIGH SEG SYM TABLE POINTER
   IFN FTEXEC,<SKPEXC>		;NO HI SYM TABLE POINTER IN EXEC MODE
	PUSHJ P,HFETCH
	 MOVEI T,0		;NO HIGH SEGMENT
	MOVEM T,SAVHSM		;SAVE HIGH SEG POINTER (OR 0)
   >
	HLLZ S,@SYMP		;GET WORD COUNT FOR LOW SEG TABLE
   IFE FTFILE,<
	SKIPGE T		;IF .JBHSM .GT. 0, INVALID
	ADD S,T			;ADD WORD COUNT FOR HIGH SEG TABLE
   >
	ASH S,-^D19		;PUSH TO RIGHT HALF AND DIVIDE BY 2
	SKIPL T,PRGM		;GET $: POINTER, GOOD ONLY IF .LT. 0
	JRST SYMS4		;NOT GOOD, USE .JBSYM
   IFE FTFILE,<
	TRNE T,1B18		;POINTER FROM .JBSYM OR .JBHSM?
	JRST [	PUSH  P,T	;SAVE T
		 MOVEI R,.JBHNM	;NAME WORD
		 PUSHJ P,HFETCH	;GET FROM HISEG
		   SETCM T,SEGNAM ;SHOULD NEVER FAIL
		 MOVE  R,T	;SAVE IN BETTER AC
		 POP   P,T	;RESTORE T
		 CAME  R,SEGNAM	;SAME HISEG?
		 JRST  SYMS4	;NO
		 JRST  SYMS2]	;YES
   >
	SKIPL T,@SYMP		;PRGM CAME FROM .JBSYM
	JRST SYMS5		;.JBSYM POINTER INVALID
SYMS2:	HLRE R,T		;GET NEGATIVE LENGTH
	SUB T,R			;GET LAST ADR OF TABLE
	MOVS R,PRGM		;GET NEG. LENGTH FOR $: POINTER
	ADD R,T			; AND CALCULATE STARTING ADR
	HLL R,PRGM		; AND SET UP TABLE LENGTH
	JUMPL R,CPOPJ		;NO, POINTER IS OK AS LONG AS IT IS .LT. 0
SYMS4:	SKIPL R,@SYMP		;SET UP POINTER INTO LOW SEG TABLE
SYMS5:	IFE FTFILE,<
	MOVE R,SAVHSM		;LOW SEG POINTER BAD, TRY HI SEG
   >
   IFN FTFILE,<
	MOVEI R,0
   >
	POPJ P,
SETNAM:	SETZM PRGM		;FORGET OLD PROGRAM
	PUSHJ P,CLRCSH		;CLEAR SYMBOL CACHE
	SKIPGE R,@SYMP		;LOOK UP PROGRAM NAME FOR $:
	PUSHJ P,SETSUB		;SEARCH LO SEG SYM TABLE
	JUMPL R,SETN2		;XFER IF NAME FOUND
   IFE FTFILE,<
	MOVEI R,.JBHSM
   IFN FTEXEC,<SKPEXC>		;NO HI SYM TABLE POINTER IN EXEC MODE
	PUSHJ P,HFETCH		;GET .JBHSM
	 JRST UNDEF		;NO HI SEG, NAME$: UNDEFINED
	SKIPGE R,T		;IS HI SEG POINTER GOOD?
	PUSHJ P,SETSUB		;YES, LOOK THRU HI SYM TABLE
   >
	JUMPGE R,UNDEF		;UNDEFINED IF NOT IN HI SEG
   IFE FTFILE,<
	HRRI W,1B18		;SET FLAG SHOWING HI SEGMENT
	MOVEI R,.JBHNM		;GET ADR OF HI SEG PROGRAM NAME
   IFN FTEXEC,<SKPEXC>
	PUSHJ P,HFETCH		;  AND GO GET THE NAME
	 MOVEI T,0		;NO HI SEG NAME, OR EXEC MODE
	MOVEM T,SEGNAM >	;SAVE HI SEG NAME
SETN2:	MOVEM W,PRGM		;SAVE -WC IN LH, HISEG=1 FLAG IN RH
	JRST RET		;DONE, THANK YOU

				;SUBROUTINE TO SEARCH A SYM TABLE FOR A PROGRAM NAME
SETSB1:	MOVE T,(R)		;ENTRY POINT IS "SETSUB"
	CAMN T,SYM		;MATCH FOR PROGRAM NAME?
	POPJ P,			;YES, RETURN WITH "ANSWER" IN W
	ADD R,[2,,2]		;GO TO NEXT ENTRY
	TLNN T,(PNAME)		;WAS LAST ENTRY A PROG NAME?
SETSUB:	HLLZ W,R		;(ENTRY POINT) YES, SAVE POINTER TO HERE
	JUMPL R,SETSB1		;XFER IF ANY SYMBOLS LEFT
	POPJ P,			;SEARCH FAILED, RETURN
KILL:	TLNN F,(LTF)		;DELETE SYMBOLS
	JRST ERR
	PUSHJ P,EVAL
	JRST KILL1
	MOVE T,(R)		;GET SYM WITH FLAGS
	TLO T,(DELO)		;ASSUME DELETE OUTPUT
	TLNE F,(CCF)		;$$K?
	MOVSI T,(DELO!DELI!37777B17)	;MAKE SYM IMPOSSIBLE LOCAL, DELETED IN AND OUT
	PUSHJ P,DSYMER		;DEPOSIT IF LEGAL, ELSE ?
KILRET:	JRST RET		;USED AS A CONSTANT


KILL1:	SKIPL R,@USYMP		;REMOVE UNDEFINED SYMS
	JRST UNDEF
KILL1A:	HLRE S,R		;GET LENGTH OF UNDEFINED TABLE, AND
	ASH S,-1		;DIVIDE BY 2 TO GET # OF ENTRIES
   IFE FTFILE,<
	SETZM SAVHSM		;LOOK ONLY IN LOW SEG
   >
KILL2:	PUSHJ P,EVAL2
	JRST RET
REPEAT 0,<			;IF ASSEMBLED OUT, DON'T ZERO CHAINED ADDRESSES
	PUSH P,R
	SKIPL R,1(R)		;CHAINED REQUEST?
	JRST KILL4		;YES
KILL3:	POP P,R >
	PUSHJ P,REMUN
	 JRST ERR		;CAN'T MODIFY SYMTAB
	MOVE R,@USYMP		;START TABLE SEARCH OVER
	JRST KILL1A

REPEAT 0,<			;IF ASSEMBLED OUT, DON'T ZERO CHAINED ADDRESSES
KILL4A:	SKIPE R,S		;GET CHAIN ADR, STOP IF 0
KILL4:	PUSHJ P,FETCH		;GET NEXT ADR OF CHAIN
	 JRST KILL3		;FAILED, QUIT SEARCHING LIST
	HRRZ S,T		;SAVE CHAIN POINTER
	HLLZS T			;GET RID OF CHAIN ADDRESS, AND
	PUSHJ P,DEPMEM		;  DEPOSIT BACK INTO MEMORY
	 JFCL			;IGNORE IF WRITE LOCKED SEG
	JRST KILL4A >

REMUN:	MOVE S,@USYMP		;REMOVE ONE UNDEFINED SYMBOL
	MOVE T,(S)		;MOVE SYMBOL 2 LOCATIONS
	PUSHJ P,DEPSYM
	 POPJ P,		;CAN'T MODIFY SYMTAB
	MOVE T,1(S)
	ADDI R,1
	PUSHJ P,DSYMER
	SUBI R,1
	MOVE S,[2,,2]
	ADDB S,@USYMP
	JRST CPOPJ1
TAG:	TLNN F,(LTF)		; NO LETTERS IS ERROR
	JRST ERR		; GO SAY ERROR
	TLNE F,(FAF)		; DEFINE SYMBOLS
	JRST DEFIN		;A.LT.B:
	TLNE F,(CF)		;DEFINE SYMBOL AS OPEN REGISTER
	JRST SETNAM
	MOVE W,LLOCO
	HRRZM W,DEFV

DEFIN:	PUSHJ P,EVAL		;DEFINED SYMBOL?
	JRST DEF1		;NO - DEFINE
	MOVE T,0(R)		;YES, GET FLAGS FOR SYMBOL TYPE
	TLNE T,(PNAME)		;PROGRAM NAME?
	JRST DEF2		;NO, REDEFINE SYMBOL

DEF1:	SKIPL R,@SYMP		;DEFINE A NEW SYMBOL
   IFE FTFILE,<
	JRST [	MOVEI R,.JBHSM
		IFN FTEXEC,<SKPEXC> ;NO HI SYM POINTER IN EXEC MODE
		PUSHJ P,HFETCH	;GET HI SEG SYM POINTER
		 JRST ERR	;THERE IS NO SYM POINTER ANYWHERE
		SUB T,[2,,2]	;MAKE ROOM FOR ANOTHER ENTRY
		PUSHJ P,DSYMER	; AND STORE IT BACK
		MOVE R,T
		JRST DEF1A]
   >
   IFN FTFILE,<
	JRST ERR
   >
	SUB R,[2,,2]
	MOVEM R,@SYMP		;DECREMENT LO SEG SYM POINTER
DEF1A:	SKIPL @USYMP		;DOES AN UNDEFINED TABLE EXIST?
	JRST DEF2		;NO
	MOVE S,R
	SOS R,@USYMP		;MOVE HI NUMBERED ENTRY ON UNDEFINED
	MOVE T,1(S)		;  TABLE TO LOW END
	PUSHJ P,DSYMER
	SOS R,@USYMP		;SAME FOR SECOND WORD
	MOVE T,(S)
	PUSHJ P,DSYMER
	MOVE R,S		;GET DEFINED SYM POINTER BACK
DEF2:	MOVSI T,(GLOBL)
	IORB T,SYM
	PUSHJ P,DSYMER
	MOVE T,DEFV
	MOVEI R,1(R)
	PUSHJ P,DSYMER
	MOVE R,@USYMP
DEF3:	JUMPGE R,RET		;PATCH IN VALUE FOR UNDEF SYM ENTRY
	MOVE T,SYM
	TLO T,(GLOBL)		;UNDEFINED TABLE HAS GLOBAL ENTRIES
	CAME T,(R)
	JRST DEF4
	PUSH P,R		;SAVE POINTER INTO UNDEF TABLE
	SKIPL R,1(R)		;IS ENTRY AN ADDITIVE REQUEST?
	JRST DEF7		;NO, CHAINED IN RIGHT HALF
	PUSHJ P,FETCH		;GET OBJECT CELL
	 JRST ERR
	TLNN R,(STNEG)		;ADDITIVE OR SUBTRACTIVE?
	SKIPA S,DEFV		;ADDITIVE
	MOVN S,DEFV		;SUBTRACTIVE
	TLNE R,(STLH)		;RIGHT OR LEFT HALF?
	JRST [	HRLZS S		;LEFT HALF
		ADD T,S		;ADD INTO LEFT HALF
		JRST DEF5]
	ADD S,T			;RIGHT HALF, ADD HALVES
	HRR T,S			;  AND REPLACE RIGHT HALF
DEF5:	PUSHJ P,DMEMER		;STORE RESULT BACK INTO MEMORY
DEF6:	POP P,R			;GET UNDEF TABLE POINTER BACK
	PUSHJ P,REMUN
	 JRST ERR		;CAN'T MODIFY SYMTAB
DEF4:	ADD R,[XWD 2,2]		;REMOVE THE NOW DEFINED SYMBOL
	JRST DEF3

DEF7:	JUMPE R,DEF6		;JUMP IF ALL DONE
	PUSHJ P,FETCH		;GET OBJECT CELL
	 JRST ERR
	HRRZ S,T		;SAVE CHAIN POINTER
	HRR T,DEFV		;REPLACE WITH NEW VALUE
	PUSHJ P,DMEMER		; AND STORE BACK INTO MEMORY
	HRRZ R,S		;LOOP TO END
	JRST DEF7		;  OF CHAIN
	SUBTTL TEXT COMMANDS (" AND $")

TEXI:	TRZE F,Q2F		;QUANT AFTER $ ?
	JRST [	MOVE T,WRD2	;YES
		CAIE T,5	; $5" ?
		JRST ERR	;NO, ONLY CASE KNOWN
		MOVE T,SYM	;YES, TAKE PREVIOUS SYL AS RADIX50
		TLZ F,(FPF+FEF+LTF) ;REINIT SYL
		JRST QUAN1]
	HRRZ T,LLOCO		;GET ADR OF OPEN REG
	MOVEM T,TEM		;SAVE IT FOR LOCAL USE
	PUSHJ P,TEXIN0		;GET TERMINATOR
	MOVEM T,SYL		;SAVE TERMINATOR
	PUSHJ P,TEXIN		;GET FIRST CHARACTER
	CAIN T,33		;ESC?
	JRST QUAN2		;YES, EQUALS ONE ASCII/SIXBIT CHAR
	PUSHJ P,TEXIN1		;CONVERT TO SIXBIT IF NECESSARY
TEXI4:	MOVE W1,[POINT 7,W]	;SETUP TO BUILD WORD IN W
	TLNE F,(CF)		;SIXBIT?
	HRLI W1,(POINT 6,0)	;YES, MODIFY BYTE POINTER
	MOVEI W,0		;INIT WORD TO 0
TEXI2:	CAMN T,SYL		;REACHED TERMINATOR?
	JRST [	MOVE T,W	;GET LAST WORD
		HRRZ R,TEM
		CAMN R,LLOCO	;MULTIPLE-WORD INPUT?
		JRST QUAN1	;NO, JUST RETURN QUANTITY
		PUSHJ P,PSHLLC	;YES, SAVE OLD LOC
		MOVEM R,LLOC	;SET LOC TO END OF INPUT
		MOVEM R,LLOCO
		JRST QUAN1]	;GO USE AS QUANTITY
	TLNN W1,(76B5)		;ROOM FOR ANOTHER BYTE IN WORD?
	JRST TEXI3		;NO
	IDPB T,W1		;YES, STORE IT
	PUSHJ P,TEXIN0		;GET ANOTHER INPUT CHARACTER
	JRST TEXI2
;HERE WHEN WORD FULL

TEXI3:	MOVSI W1,(POINT 0,0)
	TLNN F,(ROF)		;REGISTER OPEN?
	JRST TEXI2		;NO, LOSE ANY ADDITIONAL INPUT
	PUSH P,T		;SAVE CHARACTER
	MOVE T,W		;GET FULL WORD
	HRRZ R,TEM		;GET LOC OF NEXT REGISTER
	PUSHJ P,DEPMEM		;STORE WORD
	 JRST ERR		;CAN'T
	AOS TEM			;BUMP LOC
	POP P,T			;RECOVER CHARACTER
	JRST TEXI4		;GO REINIT WORD AND CONTINUE INPUT

;GET INPUT CHARACTER, CONVERT TO SIXBIT IF NECESSARY

TEXIN0:	PUSHJ P,TEXIN		;GET CHAR
TEXIN1:	TLNN F,(CF)		;SIXBIT MODE?
	POPJ P,			;NO
CONV6:	CAIL T,"A"+40		;IS CHAR BETWEEN LOWER CASE "A" AND
	CAILE T,"Z"+40		; LOWER CASE "Z"?
	SKIPA			;NO
	TRC T,40		;YES, CONVERT TO UPPER CASE
	CAIL T," "		;IS CHAR IN SIXBIT SET?
	CAILE T,"_"
	JRST ERR		;NO
	ANDI T,77		;YES, MASK TO 6 BITS
	TRC T,40		;CONVERT TO SIXBIT FORM
	POPJ P,
;***ROUTINES BEYOND HERE EVALUATE THEIR ARGUMENT***

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:	PUSH P,F		;RECURSE FOR OPEN PAREN
	PUSH P,WRD
	PUSH P,FRASE
	PUSH P,FRASE1
	AOS,PRNC
	JRST LIS

INDIRE:	HRLZI W,20		;@
	IORB W,WRD
	TLO F,(QF)
	JRST LIS2

ACCF:	MOVE R,T		;COMMA PROCESSOR
	XCT ACCCF		;MOVEI T,..
	TLOE F,(COMF)		;COMMA TYPED BEFORE?
	JRST ACCF1		;YES
	HRRM R,ACCCF		;NO, SAVE LEFT HALF OF A,,B
	HLLZ T,R
	LDB W1,[POINT 3,WRD,2]	;CHECK FOR IO INSTRUCTION
	CAIN W1,7		;CHECK FOR 7
	JRST [	SKIPN SMFLAG	;CHECK FOR KS10
		JRST .+1	;NO
		LDB W1,[POINT 3,WRD,5] ;CHECK MORE OF OPCODE
		JUMPE W1,.+1	;NOT KS10 I/O SPECIFIC
		CAIE W1,2	;EITHER 1 OR 2 IS THE CORRECT FOR KS
		CAIN W1,1
		SKIPA
		JRST .+1
		SETZ W1,0
		JRST .+2]
	LDB W1,[POINT 3,WRD,2]
	IDIVI W1,7
	LSH R,27(W1)
	ADD T,R
	ADDB T,WRD
	JRST SPAC1

ACCF1:	ADD T,WRD		; FOR ",," GET LEFT HALF TOGETHER
	HRLZM T,WRD		; AND PUT IT IN LEFT HALF
	JRST SPAC1

SPACE:	TLNE F,(QF)
SPAC1:	TLO F,(TIF)
	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 L1A
SUBTTL REGISTER EXAMINATION LOGIC

LINEF:	PUSHJ P,DEPRA		;NEXT REGISTER
	PUSHJ P,CRN		;DO CR ONLY
	AOS T,LLOC		;BUMP LOC
LI1:	;PUSHJ P,LINCHK		;TRUNCATE ADRS (UNLESS INSIDE DDT)
	HRRZM T,LLOC
	HRRZM T,LLOCO
	PUSHJ P,PAD
	MOVEI T,"/"
	CAME SCH,SCHM		;TEMP MODE SAME AS PERM?
	JRST [	CAIN SCH,FTOC	;NO, CONSTANT?
		MOVEI T,"["	;YES
		CAIN SCH,PIN	;INSTRUCTION?
		MOVEI T,"]"	;YES
		JRST .+1]	;USE APPROPRIATE INDICATION
	TLNE F,(STF)
	MOVEI T,"!"
	PUSHJ P,TOUT
LI2:	TLZ F,(ROF)
	PUSHJ P,LCT
	MOVE R,LLOCO
	PUSHJ P,FETCH
   IFE FTDEC20,<
	JRST ERR>
   IFN FTDEC20,<
	 JRST [	TLO F,(ROF)	;SAY REGISTER OPENED
		MOVEI W1,"?"	;BUT ONLY TYPE "?"
		JRST TEXT]>
	TLO F,(ROF)
	TLNE F,(STF)
	JRST DD2
	JRST CONSYM		;RETURN IS A POPJ

;CRLF AND OPEN NEXT REGISTER SUBROUTINE

LI0:	PUSHJ P,CRF
	AOS T,LLOC
	JRST LI1

   REPEAT 0,<
LINCHK:	CAML T,[DDTINT SAVPI]	;TRUNCATE ADDRESSES
	CAMLE T,[DDTINT BNADR+2]
	HRRZS T
	MOVEM T,LLOC
	MOVEM T,LLOCO
	POPJ P,
   >

VARRW:	PUSHJ P,DEPRA		;^
	PUSHJ P,CRF
	SOS T,LLOC
	JRST LI1
CARR:	PUSHJ P,DEPRA		;CLOSE REGISTER
	PUSHJ P,TIN		;GLOBBLE UP FOLLOWING LINEFEED
CARR1:	SETZM CHINP		;REINIT INPUT LINE
	SETZM CHINC
	HRRZ T,LLOC		;GET CURRENT LOC
	TLNE F,(CF)		; $ PRECEEDED?
	JRST LI1		;YES, GO OPEN REGISTER
	JRST DD1.5
SLASH:	TLNN F,(CCF)		; $$/ ?
	JRST SLAS2		;NO
	SETCMM EFAFLG		;YES, COMPLEMENT EFF ADR FLAG
	JRST RET		;OPEN NO REGISTER

OCON:	TLNE F,(QF)		;QUANT TYPED?
	MOVEI SCH,FTOC		;YES, CHANGE TEMP MODE TO CONSTANT
	TRO F,LF1+CF1		;OPEN AS CONSTANT
	JRST SLAS2		;TYPE

OSYM:	TLNE F,(QF)		;QUANT TYPED?
	MOVEI SCH,PIN		;YES, CHANGE TEMP MODE TO INSTRUCTION
	TRZ F,CF1		;OPEN SYMBOLICALLY
	TROA F,LF1
SUPTYO:	TLOA F,(STF)		;SUPPRESS TYPEOUT
SLAS2:	TLZ F,(STF)		;TYPE OUT NOT SUPPRESSED
SLASH2:	PUSHJ P,CEFF		;COMPUTE EFF ADR
	TLNN F,(QF)		;WAS ANY QUANTITY TYPED?
	JRST SLAS1		;NO. DO NOT CHANGE MAIN SEQUENCE
	PUSHJ P,PSHLLC		;PUSH OLD SEQUENCE
	HRRZM T,LLOC		;SETUP NEW SEQUENCE
SLAS1:	HRRZM T,LLOCO
	JRST LI2

ICON:	PUSHJ P,DEPRS		;BACKSLASH
	PUSHJ P,CEFF		;COMPUTE EFF ADR
	JRST SLAS1

TAB:	PUSHJ P,DEPRS		;OPEN REGISTER OF Q
	PUSHJ P,CEFF		;COMPUTE EFF ADR
	MOVEI T,-1(T)
	PUSHJ P,PSHLLC		;PUSH OLD SEQUENCE
	MOVEM T,LLOC		;SETUP NEW SEQUENCE
	HRROI T,700000		;3 RUBOUTS
	PUSHJ P,TEXTT
	JRST LI0
;ROUTINE TO COMPUTE EFFECTIVE ADDRESS OF QUANTITY IN T.  COMPUTATION
;IS PERFORMED USING USER PROGRAM VARIABLES.
; T/ QUANTITY
;	PUSHJ P,CEFF
; RETURN +1 ALWAYS, T/ EFFECTIVE ADDRESS IN RH
;PRINTS "??" AND BOMBS OUT IF INDIRECT WORD NOT ACCESSIBLE

CEFF:	SKIPE EFAFLG		;PERMANENT MODE CHANGED?
	TLC F,(CF)		;YES, COMPLEMENT EFFECT OF ESC
	TLZN F,(CF)		;ESC BEFORE COMMAND?
	POPJ P,			;NO, USE RH ONLY
	TLNN T,17		;INDEXING?
	JRST CEFF1		;NO
	PUSH P,T		;YES, SAVE QUANTITY
	LDB R,[POINT 4,T,17]	;GET INDEX ADDRESS
	PUSHJ P,FETCH		;FETCH CONTENTS OF XR
	 JFCL			;ASSUME AC'S ALWAYS ACCESSABLE
	POP P,R			;RECOVER ORIGINAL QUANTITY
	ADD T,R			;T=Y+C(XR)
	HLL T,R			;KEEP ORIGINAL LH
CEFF1:	TLNN T,(Z @0)		;HAVE INDIRECTION?
	POPJ P,			;NO, DONE
	HRRZ R,T		;YES, GET INDIRECT ADDRESS
	PUSHJ P,FETCH		;FETCH CONTENTS
	 JRST CEFF2		;FETCH FAILED
	JRST CEFF		;REPEAT USING INDIRECT WORD

CEFF2:	MOVSI W1,(ASCII /??/)	;INDIRECT FETCH FAILED
	PUSHJ P,TEXT		;PRINT LOSS INDICATION
	JRST DD1		;LEAVE REGISTER NOT OPEN, DO CRLF, ETC.

;ROUTINES TO HANDLE RING BUFFER OF LOCATIONS

;'PUSH' CURRENT LOCATION

PSHLLC:	AOS TT,SAVLP		;BUMP POINTER
	CAIL TT,NSAVTB		;AT END OF TABLE?
	SETZB TT,SAVLP		;YES, WRAPAROUND
	PUSH P,LLOC		;GET CURRENT LOCATION
	POP P,SAVLTB(TT)	;ADD IT TO TABLE
	POPJ P,

;'POP' CURRENT LOCATION

POPLLC:	MOVE TT,SAVLP		;GET POINTER
	MOVE TT,SAVLTB(TT)	;REMOVE FROM TABLE
	MOVEM TT,LLOC		;SET AS CURRENT LOC
	SOS TT,SAVLP		;DECREMENT PTR
	JUMPGE TT,POPLC1	;AT TOP OF TABLE?
	MOVEI TT,NSAVTB-1	;YES, WRAPAROUND
	MOVEM TT,SAVLP
POPLC1:	POPJ P,
DEPRA:	TLNE F,(CF)		;$ PRECEEDED?
	PUSHJ P,POPLLC		;YES, POP OLD SEQUENCE
	TLNE F,(ROF)		;IF REGISTER IS BEING CHANGED
	TLNN F,(QF)		;REMOVE ALL PREVIOUS UNDEFINED
	JRST DEPRS		;SYMBOL REFERENCES TO IT
	MOVE R,@USYMP		;GET POINTER TO ALL OLD UNDEF ITEMS
	MOVEM W1,@USYMP		;INCLUDE THE NEW ITEMS IN UNDEF LIST
   IFN FTFILE,<
	SKIPN CRASHS		;SEE IF /M
	JRST DEPRS		;YES--NO UNDEF FIXUPS
   >
	MOVEM T,LWT		;SAVE T IN LWT, DEPRS DOES IT ANYWAY
DEPRA2:	JUMPGE R,DEPRA5		;IF JOBUSY SYM TABLE EDITED, STOP
	PUSH P,R
	MOVE W,1(R)		;GET FLAGS AND POINTER
	JUMPG W,DPRS3		;1B0=0 IMPLIES CHAINING
DEPRA4:	POP P,R
	HRRZ T,1(R)		;GET ADDRESS OF FIXUP
	SKIPE T			;DELETE ENTRY IF ADR=0, OR
	CAMN T,LLOCO		; IF ADR IS BEING CHANGED
	JRST [	PUSHJ P,REMUN	;REMOVE ENTRY FROM JOBUSY
		 JRST DEPRA5	;FAILED, NO UNDEF FIXUPS
		JRST .+1]
	ADD R,[2,,2]		;CONTINUE SEARCHING TABLE
	JRST DEPRA2

DEPRA5:	MOVE T,LWT		;RESTORE QUANTITY
	JRST DEPRS		;DO THE STORE

DPRS3:	HRROI S,1(R)		;GET 1ST CHAIN ADR FROM JOBUSY TABLE
				;  AND SET FLAG TO USE DEPSYM FIRST TIME
DPRS4:	HRRZ R,W		;GET NEXT ADR (AFTER ADR IN S)
	JUMPE R,DEPRA4		;STOP ON 0 ADR
	PUSHJ P,FETCH		;GET CONTENTS OF ADR IN R
	 JRST DEPRA4		;****UNDEFINED SYMBOL TABLE OR FIXUP
				; CHAIN POINTS TO ILL. MEM. TRY
				; TO CONTINUE.
	EXCH T,W
	EXCH S,R
	CAME S,LLOCO		;IS THIS WORD BEING CHANGED?
	JRST DPRS4		;NO, CONTINUE SEARCHING LIST
	HRR T,W			;PATCH CHAIN ADR AROUND ITEM
	TLNN R,-1		;SEE IF NEED TO USE DEPSYM
	TDZA TT1,TT1		;NO--USE DEPMEM
	MOVEI TT1,DEPSYM-DEPMEM	;YES.  NOTE THAT R CAME FROM S
				;  WHICH HAS -1 IN LH FIRST TIME AROUND
				;  LOOP AND 0 OTHER TIMES.
	PUSHJ P,DEPMEM(TT1)	;CALL EITHER DEPMEM OR DEPSYM
	 HALT .
	JRST DPRS4		;CONTINUE DOWN CHAIN
SUBTTL MODE CONTROL SWITCHES

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
HWRDS:	ADDI R,HLFW-TFLOT	;H
SFLOT:	ADDI R,TFLOT-PIN	;F
SYMBOL:	ADDI R,PIN-FTOC		;S
CON:	ADDI R,FTOC		;C
	HRRZM R,SCH
	JRST BASE1

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

BASECH:	MOVE T,WRD2		;$NR  CHANGE OUTPUT RADIX TO N, N .GT. 1
	CAIGE T,2
	JRST ERR
	HRRZM T,ODF
BASE1:	SKIPE S,OLDAR
	MOVE AR,S
BASE1S:	SETZM OLDAR
BASE1O:	MOVS S,[XWD SCHM,SCH]
	TLNN F,(CCF)
	JRST LIS1
	BLT S,ODFM		;WITH $$, MAKE MODES PERMANENT
	MOVE S,[SVBTS,,PSVBTS]
	BLT S,PSVBTS+2
	JRST RET

SEMIC:	MOVEM T,LWT		;SEMICOLON TYPES IN CURRENT MODE
	JRST @SCH

EQUAL:	TROA F,LF1+CF1		;=
PSYM:	TRZ F,CF1		;@
	TRO F,LF1
	PUSHJ P,CONSYM
	JRST RET
;OPEN ANGBKT, CLOSE ANGBKT

FIRARG:	TLNE F,(CF+CCF)		;$ PRECEEDED?
	JRST PTCH		;YES, PATCH COMMAND
	MOVEM T,DEFV		;NO, SET FIRST ARG
	TLO F,(FAF)
	JRST ULIM1

ULIM:	TLNE F,(CF+CCF)		;$ PRECEEDED?
	JRST PTCHE		;YES, PATCH END COMMAND
	TLO F,(SAF)		;NO, SET SECOND ARG
	HRRZM T,ULIMIT
ULIM1:	TLNN F,(QF)
	JRST ERR
	JRST LIS0
	SUBTTL PATCH COMMAND  -- PATCH BEGIN

PTCH:	TLNN F,(TIF+COMF+PTF+MF)	;EXPRESSION TYPED?
	TLNN F,(ROF)		;NO REGISTER OPEN?
	JRST ERR		;YES, ERROR
	TLNE F,(QF)		;ANYTHING TYPED?
	JRST [	PUSHJ P,EVAL	;YES, LOOKUP SYMBOL
		 JRST ERR	;STRANGE TYPEIN, LOSE
		JRST PTCH4]	;FOUND, USE VALUE AS PATCH LOC
	MOVSI W,-NPSYM		;SETUP TO SCAN PATCH SYMBOLS
PTCH1:	MOVE T,PCHSYM(W)	;GET A POSSIBLITY
	MOVEM T,SYM		;SET IT UP FOR EVAL
	PUSHJ P,EVAL		;TRY TO FIND VALUE
	 AOBJN W,PTCH1		;NOT FOUND, TRY NEXT SYMBOL
	JUMPGE W,[MOVEI R,.JBFF	;NONE OF THE SYMBOLS EXIST, USE .JBFF
		HRRZ T,0(R)
		JRST PTCH2]
PTCH4:	MOVEI R,1(R)		;POINT TO VALUE WORD
PTCH2:	CAIGE T,.JBDA		;HAVE REASONABLE PATCH ADDRESS?
	JRST ERR		;NO
	HRRZM T,PTLOC		;YES, SAVE IT
	HRLM R,PTLOC		;SAVE WHERE IT CAME FROM
	HRRZ R,LLOCO		;LOC OF OPEN REGISTER
	HRRZM R,PTLLC		;SAVE IT
	PUSHJ P,FETCH		;GET CONTENTS
	 JRST ERR		;FETCH FAILED
	MOVEM T,PTWRD		;SAVE ORIGINAL WORD
	PUSHJ P,DEPERR		;BE SURE IT CAN BE CHANGED, ERR IF NOT
	TLNE F,(CCF)		;SAVE BEFORE/AFTER FLAG
	HRROS PTLLC		;0 MEANS BEFORE, 1 (NEGATIVE) MEANS AFTER
	SKIPL PTLLC		;PATCH AFTER?
	JRST PTCH3		;NO
	HRRZ R,PTLOC		;YES, MOVE INSTRUCTION TO PTLOC NOW
	MOVE T,PTWRD
	PUSHJ P,DEPERR		;STORE IT
PTCH3:	PUSHJ P,CRF		;OPEN REG AT PTLOC AND PRINT CONTENTS
	HRRZ T,PTLOC
	PUSHJ P,LI1
	SKIPGE PTLLC		;PATCH AFTER?
	PUSHJ P,LI0		;YES, OPEN SECOND LOC IN PATCH AREA
	POPJ P,			;DONE FOR NOW

;TABLE OF SYMBOLS IDENTIFYING PATCH AREAS

PCHSYM:	RADIX50 0,PAT..		;USUAL LINK10 SYMBOL
	RADIX50 0,PAT		;TOPS-10 SYMBOL
	RADIX50 0,PATCH		;ANOTHER LIKELY POSSIBILITY
NPSYM==.-PCHSYM
	SUBTTL PATCH COMMAND -- PATCH END

PTCHE:	SKIPN PTLOC		;PATCH IN PROGRESS?
	JRST ERR		;NO, ERROR
	TLZ F,(CF+CCF)		;FLUSH FLAGS BEFORE DEPRA
	PUSHJ P,DEPRA		;STORE LAST WORD IF ANY
	SKIPGE PTLLC		;PATCH BEFORE?
	JRST PTCHE1		;NO
	HRRZ R,LLOC		;YES, MOVE ORIG INSTRUCTION NOW
	AOS R			;MOVE IT TO NEXT LOC
	MOVE T,PTWRD
	PUSHJ P,DEPERR		;STORE IT
	PUSHJ P,LI0		;OPEN FOR USER TO SEE
PTCHE1:	HRRZ R,LLOC		;STORE JUMPA 1,ORIG+1
	AOS R			; IN NEXT LOC
	HRRZ T,PTLLC
	ADD T,[JUMPA 1,1]
	PUSHJ P,DEPERR
	PUSHJ P,LI0		;OPEN FOR USER TO SEE
	HRRZ R,LLOC		;STORE JUMPA 2,ORIG+2
	AOS R			; IN NEXT LOC
	HRRZ T,PTLLC
	ADD T,[JUMPA 2,2]
	PUSHJ P,DEPERR
	PUSHJ P,LI0		;OPEN FOR USER TO SEE
	AOS T,LLOC		;GET NEXT FREE PATCH LOC
	HLRZ R,PTLOC		;UPDATE WORD THAT PATLOC CAME FROM
	HRRM T,0(R)
	HRRZ R,PTLLC		;GET ORIG ADDRESS
	HRRZ T,PTLOC		;PUT JUMPA PATCH INTO IT
	HRLI T,(JUMPA 0,)
	PUSHJ P,DEPERR
	PUSHJ P,CRF
	HRRZ T,R		;NOW OPEN ORIG REGISTER FOR USER TO SEE
	PUSHJ P,LI1
	SETZM PTLOC		;SAY NO PATCH IN PROGRESS
	POPJ P,			;DONE
	SUBTTL PAGE TABLE CONTROL ($U)

   IFE FTDEC20,<
   IFE FTEXEC!FTFILE,< SETPAG==ERR>
   IFN FTEXEC!FTFILE,<

;COMMAND TO MAKE LIFE EASIER ON THE KI10 AND KL10.
;FORMAT IS:
;	<USER-BASE>$<EXEC-BASE>U
;
; 1. $U - RESTORE NORMAL MODE
; 2. K$U - SET USER PAGING WITH UPT AT PAGE K
; 3. K$NU - SET EXEC PAGING WITH UPT AT K AND EPT AT N
;
SETPAG:	TLZE F,(QF)		;USER SPECIFIED
	JRST SETPG1		;YES--CHARGE AHEAD
	TRZE F,Q2F		;EXEC TYPED
	JRST ERR		;YES--ERROR
	SETZM EPTUPT		;JUST $U CLEAR FLAG WORD
	JRST RET		;DONE
SETPG1:	TRO T,400000		;DO NOT STORE ZERO
	PUSH P,EPTUPT		;SAVE OLD VALUE
	PUSH P,T		;SAVE NEW VALUE
	SETZM EPTUPT		;RESTORE PHYSICAL ADDRESSING
	MOVE R,T		;COPY ADDRESS
	LSH R,9			;CONVERT TO WORD ADDR
	TLNN R,777377		;TEST FOR JUNK
	PUSHJ P,FETCH		;TEST ADDRESS
	 JRST SETPGE		;ERROR
	TRZN F,Q2F		;EXEC GIVEN
	JRST SETPGX		;NO--DONE
	MOVE R,WRD2		;GET SECOND WORD
	TRO R,400000		;MAKE SURE NON-ZERO
	HRLM R,(P)		;STORE IN ANSWER
	LSH R,9			;TEST FOR VALID
	TLNN R,777377		; POINTER
	PUSHJ P,FETCH		; ..
	 JRST SETPGE		;BAD ADDRESS
SETPGX:	POP P,EPTUPT		;SET ANSWER
	POP P,T			;RESTORE T
	JRST RET		;DONE

SETPGE:	POP P,T			;UNDO THIS COMMAND
	POP P,EPTUPT		; ..
	JRST ERR		;SET ERROR
   >				;END EDDT AND FILDDT SWITCH
   >				;END IFE FTDEC20
SUBTTL GO AND EXECUTE LOGIC

   IFE FTFILE,<
CNTRLZ:	IFN FTEXEC,<
	SKPUSR			;SEE IF USER MODE
	JRST ERR>		;NO--ERROR  
   IFE FTDEC20,<
	MOVE T,[CALLI 1,12]>	;GET MONRET
   IFN FTDEC20,<
	MOVE T,[HALTF]>		;HALT THIS FORK
	JRST XEC0		;GO EXECUTE IT

GO:	HRLI T,(JRST)		;G
	TLOE F,(QF)		;DID USER TYPE AN ARG TO $G?
	JRST XEC		;YES, GO DO IT
   IFN FTDEC20,<
   IFN FTEXEC,<
	SKPUSR
	JRST ERR>		;NO SUCH COMMAND IN EDDT
	MOVEI T1,.FHSLF
	GEVEC			;GET ENTRY VECTOR
	HLRZ TT,T2		;GET ITS LENGTH
	CAIN TT,(JRST)		;TOPS10 FORMAT?
	JRST GO1		;YES
	CAIL TT,1000		;REASONABLE?
	JRST ERR		;NO
	HRR T,T2		;SETUP FIRST LOCATION
	TRNN F,Q2F		;SECOND QUANT? (I.E. $1G)
	SETZM WRD2		;NO, ASSUME ZERO
	CAMG TT,WRD2		;WITHIN RANGE?
	JRST ERR		;NO
	ADD T,WRD2		;ADD OFFSET WITHIN VECTOR
	JRST XEC		;NOW HAVE JRST ADR  IN T, XCT IT
GO1:>				;END IFN FTDEC20
	HRR T,.JBSA		;NO, GET ADDR FROM .JBSA
   IFN FTEXEC,<
	SKPEXC			;EXEC MODE HAS NO .JBSA, SO ERROR
   >
	TRNN T,-1		;WAS C(.JBSA) NONZERO?
	JRST ERR		;NO, SO ERROR
XEC:	TLNN F,(QF)		;SKIP IF QUANTITY TYPED
	TDZA T,T		;MAKE SURE COUNT IS ZERO
	TLNN T,777000		;SKIP IF VALID INSTRUCTION
	JRST $X			;GOTO SINGLE STEP EXECUTE ROUTINE
XEC0:	MOVEM T,TEM
	PUSHJ P,CRF
	PUSHJ P,INSRTB
	SETZM SKPCT		;INIT SKIP COUNT
	JSP T,RESTORE
	XCT TEM
XEC1:	 AOS SKPCT		;NOTE NOSKIP, SKIP, DOUBLE SKIP
	 AOS SKPCT
	JSR SAVE		;SAVE CONTEXT
	 PUSHJ P,REMOVB		;REMOVE BRKPTS
	MOVEI TT,3
	SUB TT,SKPCT		;COMPUTE AMOUNT OF PC INCREMENT
   IFE FTDEC20,<
	CAIG TT,1		;INSTRUCTION SKIPPED?
	JRST DD1		;NO
	MOVE W1,[ASCII "<SKP>"]	;MAKE SURE IT IS CLEAR
	PUSHJ P,TEXT2		; THAT THIS WAS A SKIP
	PUSHJ P,CRF		;TYPE 2 CR-LFEEDS
	JRST DD1
   >
   IFN FTDEC20,<
	MOVEI W1,"$"
	PUSHJ P,TEXT		;PRINT $ FOR EACH INCREMENT
	SOJG TT,.-2
	JRST DD1>
   >

   IFN FTFILE,<
BCOM==<XEC==<GO==ERR>>
   >
	SUBTTL SINGLE STEP EXECUTE LOGIC

   IFE FTFILE,<

;$X IS A  FEATURE THAT OPERATES AS FOLLOWS:
;	$X OR N$X OR $$X OR N$$X, WHERE N .LT. 2^27, WILL DISPATCH TO
;	THIS CODE.  THE FOLLOWING ACTIONS WILL BE PERFORMED:
;
;   $X EXECUTE A SINGLE INSTRUCTION, THEN INCREMENT THE PC.  THE
;	OPERANDS TO THE INSTRUCTION WILL BE PRINTED OUT AS THEY
;	EXIST **AFTER** EXECUTION OF THE INSTRUCTION.  AN EXTRA
;	LINE FEED WILL BE PRINTED IF THE INSTRUCTION SKIPPED OR
;	JUMPED.  THE NEXT INSTRUCTION WILL THEN BE PRINTED.
;	$P WILL ALWAYS DO THE RIGHT THING AFTER ANY NUMBER OF $X'S.
;
;  N$X REPEAT THE $X CYCLE N TIMES.
;
; N$$X SAME AS N$X EXCEPT THAT ALL PRINTOUT IS SUPPRESSED FOR
;	ALL BUT THE LAST $X CYCLE.
;
;  $$X PERFORM A NON-PRINTING $X CYCLE UNTIL THE PC REACHES EITHER
;	.+1 OR .+2; I.E. UNTIL ONE OF THE NEXT 2 INSTRUCTIONS IS
;	EXECUTED.  THIS IS USEFUL FOR TREATING A SUBROUTINE CALL
;	AS A SINGLE INSTRUCTION FOR THE PURPOSES OF $X.


;FLAGS USED IN $X LOGIC ONLY

	FAC== 1			;SIGNALS AC TO BE PRINTED
	DFAC== 2		;SIGNALS INST THAT USES 2 AC'S
	FLG== 4			;INST MODIFIES FLAGS (JRST,JFCL)
	IMM== 10		;SIGNALS IMMEDIATE MODE INST
	EA== 20			;SIGNALS MEMORY REFERENCE INST
	DEA== 40		;SIGNALS INST THAT REFERENCES 2 MEM LOCS
	FLA== 100		;SIGNALS FLOATING AC OPERAND
	FLE== 200		;SIGNALS FLOATING MEM OPERAND
;COME HERE FROM $X COMMAND, WITH T SET TO ZERO IF NO QUANTITY WAS
;   TYPED.

$X:	SKIPE CSECT		;USE IN EXT ADR CONTEXT?
	JRST ERR		;YES, $X NOT IMPLEMENTED
	MOVEM T,XTEM		;STORE REPETITION COUNT
	JUMPG T,$X00		;JUMP IF POSITIVE COUNT
	HRRZ T,PROC0		;ZERO, FETCH CURRENT PC
	MOVEM T,LOCSAV		;AND REMEMBER IT
	SETOM XTEM		;SET REPETITION COUNT NEGATIVE
	TLNN F,(CCF)		;$$X WITH NO ARG?
	MOVNS XTEM		;NO, ONLY $X. TREAT AS 1$X
$X00:	PUSHJ P,CRF		;OUTPUT CRLF TO START

;HERE ON REPEATED $X CYCLES

$X01:	SOSN XTEM		;DECREMENT AND TEST COUNTER
	TLZ F,(CCF)		;CLEAR $$ FLAG TO END REPETITIONS
	TLZ F,(QF!CF!STF)		;TURN OFF QUANT, $, ! FLAGS
	MOVEM F,FLAGS		;SAVE REGULAR DDT FLAGS
	HRRZI T,100		;SETUP MAX XCT DEPTH
	HRRZM T,XCTS
	HRRZ R,PROC0		;FETCH ADR OF CURRENT INST
	CAIN R,XEC1		;JUST HIT BREAKPOINT OR DID $X LAST?
	JRST ERR		;NO, JUST ENTERED DDT, SO ERROR
	SKIPL XTEM		;INDEFINITE $$X BEING EXECUTED?
	MOVEM R,LOCSAV		;NO, REMEMBER OLD PC FOR THIS INST
$X02:	PUSHJ P,FETCH		;FETCH CURRENT INSTRUCTION
	 JRST ERR		;ERROR
$XO3:	MOVEM T,I.NST		;STORE CURRENT INSTRUCTION
	JSR SWAP		;SWAP TO USER CONTEXT
	MOVEM T,SAFETY		;SAVE T
	SKIPN SMFLAG		;CHECK FOR KS10
	JRST EACLC		;DO EA CALCULATION
	LDB T,[POINT 3,I.NST,2] ;I/O INSTRUCTION?
	CAIE T,7
	JRST EACLC		;NOT I/O INSTRUCTION
	SETZM I.NSTEA		;NO EFFECTIVE ADDRESS NEEDED
	JRST NEACLC		;DON'T CALCULATE EFFECTIVE ADDRESS
EACLC:	MOVE T,SAFETY
	MOVEI T,@I.NST		;COMPUTE EFFECTIVE ADR OF INST
	DPB T,[POINT 23,I.NST,35] ;STORE COMPUTED ADR IN CURRENT INST
	HRRZM T,I.NSTEA		;REMEMBER IT AGAIN
NEACLC:	MOVE T,SAFETY		;RESTORE T
	JSR SWAP		;SWAP BACK TO DDT CONTEXT
	LDB W1,[POINT 4,I.NST,12] ;EXTRACT AC FIELD
	MOVEM W1,I.NSTAC	;STORE IT AWAY
	MOVSI T,777000		;MASK FOR OPCODE
	AND T,I.NST		;FETCH OPCODE
	HLRZ F,T		;SAVE IN RH FOR LATER
	CAMLE T,$XTBL(T)	;IN RANGE OF CURRENT TABLE ENTRY?
	AOJA T,.-1		;NO, KEEP SEARCHING
	JRST @$XTBL(T)		;YES, DISPATCH

   IFE FTEXEC,<
	MONUI== JUSTI		;IF USER DDT, TREAT MONITOR UUOS
	MONUE== JUSTE		;  AS HARDWARE INSTRUCTIONS
	MONUAI==SETI
	MONUAE==SETEA
	MONINI==ERR		;CANNOT TRACE INIT
   >
;OPCODE DISPATCH TABLE.
;   LH OF EACH ENTRY CONTAINS LARGEST OPCODE COVERED BY THAT ENTRY,
;   RH CONTAINS DISPATCH ADDRESS.

$XTBL:	SETZB SET		; 400-403  SETZX
	ORCBB CHECKI		; 404-473  ALL LOGICAL EXCEPT SETX
	SETOB SET		; 474-477  SETOX
	HLRES CHEKIS		; 500-577  HALFWORD
	TSON TESTS		; 600-677  TEST CLASS
	777000,,IOTS		; 700-777  I/O INSTRUCTIONS
	0 ,, ERR		;     000  ALWAYS ILLEGAL
	037000,,USRUUO		; 001-037  USER UUOS
	CALL MONUAE		;     040  CALL
	INIT MONINI		;     041  INIT
	CALLI MONUAI		; 042-047  UNDEFINED AND CALLI
	TTCALL MONUE		; 050-051  OPEN,TTCALL
	054000,,MONUAI		; 052-054  UNDEFINED
	OUT MONUE		; 055-057  RENAME,IN,OUT
	STATO MONUI		; 060-061  SETSTS,STATO
	GETSTS MONUE		;     062  GETSTS
	OUTBUF MONUI		; 063-065  STATZ,INBUF,OUTBUF
	OUTPUT MONUE		; 066-067  INPUT,OUTPUT
	USETO MONUI		; 070-075  CLOSE,RELEAS,MTAPE,UGETF,USETI,USETO
	ENTER MONUE		; 076-077  LOOKUP,ENTER
	103000,,SETI		; 100-103  UNDEFINED
	104000,,DOIT		;     104  JSYS
	107000,,SETI		; 105-107  UNDEFINED
	DFDV DFLOT		; 110-113  DFAD,DFSB,DFMP,DFDV		*** KI10
	117000,,SETI		; 114-117  UNDEFINED
	DMOVN DMOV		; 120-121  DMOVE,DMOVN			*** KI10
	FIX FXAFLE		;     122  FIX				*** KI10
	123000,,SETI		;     123  UNDEFINED
	DMOVNM DMOV		; 124-125  DMOVEM,DMOVNM		*** KI10
	FIXR FXAFLE		;     126  FIXR				*** KI10
	FLTR FLAFXE		;     127  FLTR				*** KI10
	UFA IUFA		;     130  UFA
	DFN IDFN		;     131  DFN
	FSC IFSC		;     132  FSC
	IBP JUSTE		;     133  IBP
	DPB SETEA		; 134-137  XLDB,XDPB
	FDVRB FLOAT		; 140-177  FADXX,FSBXX,FMPXX,FDVXX
;CONTINUATION OF OPCODE DISPATCH TABLE.

	MOVMS CHEKIS		; 200-217  MOVXX
	IMULB CHECKI		; 220-223  IMULX
	DIVB MULDIV		; 224-237  MULX,XDIVX
	LSH SETI		; 240-242  ASH,ROT,LSH
	JFFO IJFFO		;     243  JFFO
	LSHC DBLI		; 244-246  ASHC,ROTC,LSHC
	247000,,SETI		;     247  UNDEFINED
	EXCH SETEA		;     250  EXCH
	BLT SETI		;     251  BLT
	AOBJN IAOBJ		; 252-253  AOBJP,AOBJN
	JRST IJRST		;     254  JRST
	JFCL IJFCL		;     255  JFCL
	XCT IIXCT		;     256  XCT
	MAP SETEA		;     257  MAP				*** KI10
	PUSHJ IIPUSHJ		;     260  PUSHJ
	POP SETEA		; 261-262  PUSH,POP
	POPJ IPOPJ		;     263  POPJ
	JSR I.JSR		;     264  JSR
	JSP I.JSP		;     265  JSP
	JSA I.JSA		;     266  JSA
	JRA IAOBJ		;     267  JRA
	SUBB CHECKI		; 270-277  ADDX,SUBX
	CAIG SETI		; 300-307  CAIXX
	CAMG SETEA		; 310-317  CAMXX
	SOSG JMPSKP		; 320-377  JUMPXX,SKIPXX,AOJXX,AOSXX,SOJXX,SOSXX
;MONITOR UUO HANDLER

   IFN FTEXEC,<
MONUAI:	TLO F,FAC		;REMEMBER TO PRINT AC
MONUI:	SKPEXC			;SKIP IF EXEC MODE
	JRST JUSTI		;USER MODE, TREAT UUO AS SINGLE INST
	JRST MONUE		;EXEC MODE, TRACE THE UUO

MONUAE:	TLO F,FAC		;REMEMBER TO PRINT AC
MONUE:	SKPEXC			;SKIP IF EXEC MODE
	JRST JUSTE		;USER MODE, TREAT UUO AS SINGLE INST
	SKPKA			;CAN SIMULATE ON A KA
	JRST ERR		;PUNT ON A KL OR KI
	JRST USRUUO		;EXEC MODE, TRACE THE UUO

MONINI:	SKPEXC			;SKIP IF EXEC MODE
	JRST ERR		;USER MODE, CAN'T FOLLOW AN INIT
				;EXEC MODE, TRACE NORMALLY
   >
;USER UUO HANDLER

USRUUO:	MOVEI R,40		;SETUP JOBUUO
	EXCH F,FLAGS		;RESTORE REGULAR FLAGS
	MOVE T,I.NST		;FETCH INST WITH EFF ADR COMPUTED
	PUSHJ P,DEPMEM		;STORE USER UUO IN JOBUUO
	 JRST ERR		;ERROR
	EXCH F,FLAGS		;RESTORE $X FLAGS
	MOVE T,[XCT 41]		;PRETEND INSTRUCTION WAS AN XCT
	JRST $XO3

;INTERPRET UFA

IUFA:	TLOA F,FLA+FLE+DFAC	;REMEMBER FLTG PT, USES 2 AC'S

;INTERPRET DFN

IDFN:	TLO F,FLA!FLE		;DFN, REMEMBER AC AND E FLOAT
	JRST SETEA

;INTERPRET FLOATING POINT INSTRUCTIONS

FLOAT:	ANDI F,7000		;FLOATING PT, GET MODE
	CAIN F,1000		;LONG MODE?
	TLOA F,DFAC		;YES, PRINT 2 AC'S
	CAIE F,5000		;IMMEDIATE MODE?
	TLOA F,FLA+FLE+FAC+EA	;NO, PRINT AC AND E BOTH FLOATING
FLOATI:	TLO F,FLA+FLE+FAC+IMM	;YES, PRINT AC AND E IMMEDIATE FLTG
	JRST DOIT
;INTERPRET JRST

IJRST:	TLO F,IMM		;REMEMBER TO PRINT E
	TRNE W1,2		;IS INSTRUCTION JRSTF?
	TLO F,FLG		;YES, REMEMBER TO PRINT FLAGS
IJRST0:	PUSHJ P,FETCH		;FETCH INST OR INDIRECT WORD
	 JRST ERR		;ERROR
	MOVE W1,T		;COPY INTO W1
	LDB R,[POINT 4,T,17]	;LOAD INDEX FIELD
	JUMPE R,IJRST1		;JUMP IF NO INDEXING TO PERFORM
	MOVE T,AC0(R)		;FETCH CONTENTS OF INDEX REGISTER
	TLZ T,(Z @(17))		;CLEAR I AND X FIELDS IN INDEX REG
	ADDI T,(W1)		;COMPUTE INDEXED ADDRESS
	TLZ T,(Z @(17))		;CLEAR ANY OVERFLOW
IJRST1:	MOVEI R,(T)		;COPY RESULTING ADDRESS
	TLNE W1,(@)		;INDIRECT?
	JRST IJRST0		;YES, FOLLOW NEXT LEVEL OF INDIRECTION

;LH OF T NOW CONTAINS FLAGS THAT WILL BE RESTORED

   IFN FTEXEC!FTMON,<
   IFN FTEXEC,<			;DEC20 MONITOR DDT DOESN'T HAVE SKPEXC
	SKPEXC			;NOW IN EXEC MODE?
	JRST IJRST3		;NO, USER MODE
   >
	MOVE W1,I.NSTAC		;YES, FETCH AC FIELD OF JRST INST
	TRNE W1,1		;JUMP TO USER MODE?
	JRST JRSPRC		;YES, CAN'T TRACE. GO DO $P
	TRNE W1,2		;JRSTF?
	TLNN T,(1B5)		;YES, GOING TO ENTER USER MODE?
	JRST IJRST3		;NO TO EITHER, HANDLE NORMALLY
JRSPRC:	EXCH F,FLAGS		; $X OPERATION IMPOSSIBLE. RESTORE FLAGS
	TLZ F,(QF+CCF)		;CLEAR QUANT AND $$ FLAGS
	JRST PROCD1		;AND EXECUTE $P TO GO INTO USER MODE
   >

IJRST3:	HRRI T,NOSKIP		;MODIFY THE JRST EFFECTIVE ADR
	MOVEM T,BCOM		;STORE NEW FLAGS,,NOSKIP
	MOVE T,I.NST		;FETCH INST AGAIN
	HRRM T,PROC0		;STORE EFF ADR AS NEW PC
	HRRI T,BCOM		;TURN INTO JRST @BCOM
	TLO T,(@)
	MOVEM T,I.NST		;AND STORE
	JRST DOIT		;DO IT
;INTERPRET XCT

IIXCT:
   IFN FTEXEC!FTMON,<
	DPB W1,[POINT 4,I.XCT,12]> ; USE IN XCT PAGED
	MOVE F,FLAGS		;GET BACK NORMAL DDT FLAGS
	SOSG XCTS		;CHECK XCT COUNTER
	JRST ERR		;ERROR - DEPTH EXCEEDED
	TLNE F,(CCF)		;$$X?
	JRST IIXCT1		;YES, DON'T PRINT ANYTHING
	HRRZ T,I.NSTEA		;GET EFF ADR OF XCT
	PUSHJ P,PINST		;PRINT INST BEING XCT'ED
	PUSHJ P,CRF		;OUTPUT CRLF AFTER INST
IIXCT1:	HRRZ R,I.NSTEA		;GET EFF ADR OF XCT AGAIN
	JRST $X02		;PROCESS EXECUTED INST

;INTERPRET PUSHJ

IIPUSHJ:AOS T,PROC0		;GET CURRENT PC +1
	HLL T,SAVPI		;PUT FLAGS IN LH
	MOVEM T,I.NSTPC		;STORE AWAY TO BE STACKED
	MOVSI T,(1B4)		;CLEAR BIS FLAG IN NEW PC WORD
	ANDCAM T,SAVPI
	SOS T,I.NST		;GET EFF ADR OF PUSHJ, -1 TO FOOL DOIT
	HRRM T,PROC0		;STORE NEW PC -1
	HRLZI T,(<PUSH>-<PUSHJ>) ;WANT TO TURN PUSHJ INTO A PUSH
	DPB T,[POINT 5,I.NST,17] ;CLEAR I AND AC FIELD
	JRST IPOPJ2		;REST OF CODE COMMON WITH POPJ

;INTERPRET POPJ

IPOPJ:	EXCH F,FLAGS		;POPJ, RESTORE NORMAL DDT FLAGS
	HRRZ R,AC0(W1)		;FETCH CONTENTS OF CORRECT USER AC
	PUSHJ P,FETCH		;FETCH PCWORD IT POINTS TO
	 JRST ERR		;ERROR
	EXCH F,FLAGS		;RESTORE $X FLAGS
	HRRI T,-1(T)		;DECREMENT PC TO FOOL CODE AT DOIT
	HRRM T,PROC0		;STORE AS CURRENT PC
	HRLZI T,(<POP>-<POPJ>)	;SETUP TO TURN POPJ INTO POP

;COMMON CODE FOR PUSHJ, POPJ

IPOPJ2:	ADDM T,I.NST		;TURN PUSHJ INTO PUSH OR POPJ INTO POP
	HRRZI T,I.NSTPC		;SETUP ADR OF PC WORD FOR PUSHJ
	HRRM T,I.NST
	TLOA F,FAC		;REMEMBER TO PRINT AC

;INTERPRET FSC

IFSC:	TLO F,FAC+FLA+IMM	;FLOATING AC, FIXED IMMEDIATE E
	JRST DOIT
;INTERPRET JSA

I.JSA:	AOS T,PROC0		;JSA, SETUP RETURN PC
	HRL T,I.NSTEA		;PUT EFF ADR IN LH LIKE JSA DOES
	EXCH T,AC0(W1)		;STORE IN USER AC, GET OLD CONTENTS
	JRST I.JSR2		;STORE OLD CONTENTS LIKE JSR, THEN JUMP

;INTERPRET JSR

I.JSR:	AOS T,PROC0		;JSR, GET CURRENT PC
	HLL T,SAVPI		;SETUP LH OF PC WORD
	TLO F,FAC		;REMEMBER NOT TO PRINT AC FIELD
	MOVSI W1,(1B4)		;CLEAR BIS FLAG IN NEW PC WORD
	ANDCAM W1,SAVPI
I.JSR2:	TLO F,EA		;PRINT E NORMALLY
	EXCH F,FLAGS		;RESTORE NORMAL DDT FLAGS
	HRRZ R,I.NSTEA		;FETCH EFF ADR OF JSR OR JSA
	PUSHJ P,DEPMEM		;STORE PC WORD
	 JRST ERR		;ERROR
	EXCH F,FLAGS		;RESTORE $X FLAGS
	HRRZ T,I.NSTEA		;GET EFF ADR AGAIN
	AOJA T,I.JSR4		;INC PAST STORED PC WORD

;INTERPRET JSP

I.JSP:	AOS T,PROC0		;JSP, SETUP RETURN PC
	HLL T,SAVPI		;SETUP LH OF PC WORD
	MOVEM T,AC0(W1)		;STORE IN USER AC
	MOVSI T,(1B4)		;CLEAR BIS FLAG IN NEW PC WORD
	ANDCAM T,SAVPI
	HRRZ T,I.NSTEA		;GET BACK EFF ADR
I.JSR4:	HRRM T,PROC0		;STORE NEW PC
	TLC F,FAC		;REMEMBER TO PRINT AC
	JRST TELL		;GO PERFORM PRINTOUT


;INTERPRET KI10 INSTRUCTIONS

DFLOT:	TLO F,FLA+FLE		;REMEMBER THAT AC AND E ARE FLOATING
DMOV:	TLO F,DFAC+DEA		;REMEMBER AC AND E BOTH DOUBLE
	JRST SETEA

FXAFLE:	TLOA F,FLE		;REMEMBER THAT E FLOATS (FIX,FIXR)
FLAFXE:	TLO F,FLA		;REMEMBER THAT AC FLAOATS (FLTR)
	JRST SETEA
;INTERPRET JFFO

IJFFO:	TLO F,DFAC		;REMEMBER JFFO USES 2 AC'S

;INTERPRET JUMP AND SKIP INSTRUCTIONS

JMPSKP:	TRNE F,10000		;JUMP/SKIP, WHICH IS IT?
	JRST SKP		;SKIP CLASS

;INTERPRET AOBJN AND AOBJP

IAOBJ:	TLOA F,FAC+IMM		;HANDLE AS IMMEDIATE MODE INST WITH AC

;INTERPRET JFCL

IJFCL:	TLO F,FLG		;REMEMBER TO PRINT FLAGS
	MOVEI T,JMP		;JUMP CLASS OR AOBJ, COME BACK TO $X
	HRRM T,I.NST		;STORE MODIFIED INST
	JRST DOIT		;GO EXECUTE CONDITIONAL INST

;HERE AFTER EXECUTING CONDITIONAL JUMP INSTRUCTION THAT ACTUALLY
;   DOES JUMP

JMP:	EXCH T,I.NSTEA		;SAVE T, GET EFF ADR OF JUMP
	HRRM T,PROC0		;STORE EFF ADR AS NEW PC
	EXCH T,I.NSTEA
	JRST NOSKIP		;NOW DO PRINTOUT

;HERE FOR ALL SKIP INSTRUCTIONS

SKP:	JUMPN W1,SETEA		;SKIP CLASS - AC FIELD ZERO?
JUSTE:	TLOA F,EA		;YES, JUST PRINT E

;INTERPRET SHIFT COMBINED INSTRUCTIONS

DBLI:	TLO F,FAC+DFAC+IMM	;REMEMBER 2 AC'S USED, IMMEDIATE
	JRST DOIT		;EXECUTE NORMALLY

;INTERPRET TEST CLASS INSTRUCTIONS

TESTS:	TRNN F,10000		;SKIP ON TD OR TS BUT NOT ON TR OR TL
	TLOA F,FAC+IMM		;IMMEDIATE MODE
	TLO F,FAC+EA		;NORMAL MODE
	JRST DOIT
;I/O INSTRUCTIONS

IOTS:	SKIPN SMFLAG		;CHECK FOR SM10
	JRST IOTS1		;NOPE NORMAL STUFF
	TLO F,(CCF)		;DON'T ATTEMPT PRINTING STUFF
	SETZM I.NSTEA		;DON'T DO EFFECTIVE ADDRESS STUFF
IOTS1:	TRNE W1,4		;SKIP IF BLKI,DATAI,BLKO,DATAO
	CAIN W1,5		;SKIP IF NOT CONI
	TLOA F,EA		;MEM REF INSTRUCTION
JUSTI:	TLO F,IMM		;IMMEDIATE INST
	JRST DOIT

;ALL PATHS CONVERGE HERE

CHEKIS:	TRC F,3000		;HERE TO TEST FOR IMMEDIATE OR SELF MODE
	TRCE F,3000		;SKIP IF SELF MODE
	JRST CHECKI		;NO, CHECK IMMEDIATE
	JRST SKP		;YES, GO TEST FOR NONZERO AC FIELD
SET:	ANDI F,3000		;HERE FOR SETZX,SETOX
	CAIE F,2000		;SETZM,SETOM?
	TLO F,FAC		;NO, AC IS ALWAYS AFFECTED
	TRNE F,2000		;SETZM,SETZB,SETOM,SETOB?
	TLO F,EA		;YES, MEM IS ALWAYS AFFECTED
	JRST DOIT

;FIXED POINT MULTIPLY AND DIVIDE (NOT INCLUDING IMULX)

MULDIV:	ANDI F,3000		;MASK MODE BITS
	CAIE F,2000		;TO MEMORY ONLY?
	TLO F,DFAC		;NO, INST USES 2 AC'S
CHECKI:	TRNE F,1000		;TEST FOR IMMEDIATE MODE INST
	TRNE F,2000
SETEA:	TLOA F,FAC+EA		;MEM REF INSTRUCTION
SETI:	TLO F,FAC+IMM		;IMMEDIATE MODE INSTRUCTION
DOIT:	EXCH F,FLAGS		;RESTORE NORMAL DDT FLAGS
	PUSHJ P,TTYLEV		;RESTORE STATUS OF CTY (EXEC MODE)
	JSR SWAP		;SWAP TO USER CONTEXT
	XCT I.XCT		;EXECUTE THE INSTRUCTION (IF IN EXEC MODE
				; ON A KI10 THIS MAY BE EXECUTIVE XCT)
	 JRST IXS1		;NO SKIP, INCREMENT PC ONCE
	 JRST IXS2		;SKIP, INCREMENT PC TWICE
	AOS PROC0		;DOUBLE SKIP, INCREMENT PC THRICE
IXS2:	AOS PROC0
IXS1:	AOS PROC0
;HERE AFTER SIMULATING OR EXECUTING INSTRUCTION.
;  PERFORM REQUIRED PRINTOUT.

NOSKIP:	JSR SWAP		;RESTORE DDT CONTEXT
	PUSHJ P,TTYRET		;RESTORE DDT TTY MODES
	JRST .+2
TELL:	EXCH F,FLAGS		;GET DDT'S FLAGS
   IFN FTEXEC!FTMON,<
	MOVEI T,0		;CLEAR THE AC FIELD OF I.XCT
	DPB T,[POINT 4,I.XCT,12] ;SO NEXT INSTRUCTION HAPPENS OK
   >
	TLNE F,(CCF)		;IF $$X, DON'T PRINT ANYTHING
	JRST NXTIT
	EXCH F,FLAGS		;RESTORE $X'S FLAGS
	PUSH P,SCH		;SAVE CURRENT OUTPUT MODE
	TLNE F,FLA		;FLOATING AC?
	MOVEI SCH,TFLOT		;YES, SETUP TO OUTPUT IN FLOATING PT
	TLNE F,FAC		;AC TO BE PRINTED?
	PUSHJ P,FAC0		;YES, DO IT
	TLNE F,DFAC		;INST USE 2 AC'S?
	PUSHJ P,DBL0		;YES, PRINT LOW-ORDER AC
	TLNE F,FLG		;INSTRUCTION ACCESS THE FLAGS?
	PUSHJ P,FLG0		;YES, PRINT FLAGS
	MOVE SCH,(P)		;RESTORE OLD MODE
	TLNE F,FLE		;FLOATING MEMORY OPERAND?
	MOVEI SCH,TFLOT		;YES, SETUP FLTG OUTPUT
	TLNE F,IMM		;IMMEDIATE MODE?
	PUSHJ P,IMM0		;YES, JUST PRINT E
	TLNE F,EA		;MEM REF INST?
	PUSHJ P,EA0		;YES, PRINT C(E)
	TLNE F,DEA		;DOUBLE-WORD MEM OPERAND?
	PUSHJ P,DEA0		;YES, OUTPUT 2ND WORD
	POP P,SCH		;RESTORE CURRENT OUTPUT MODE
	EXCH F,FLAGS		;RESTORE DDT FLAGS
	PUSHJ P,CRF		;OUTPUT CRLF
;NOW TEST WHETHER TO CONTINUE, AND PRINT NEXT INST IF REQUIRED.

NXTIT:	HRRZ T,PROC0		;FETCH NEW PC
	MOVEI W1,1(T)		;COMPUTE PC+1
	HRRZM W1,BCOM		;STORE FOR $P
	HRRZ W1,LOCSAV		;FETCH OLD PC
	SKIPL XTEM		;INDEFINITE $$X IN PROGRESS?
	JRST NXT0		;NO
	CAIE T,1(W1)		;YES, ARE WE NOW AT OLD PC +1?
	CAIN T,2(W1)		;  OR +2?
	JRST $XQUIT		;YES, STOP ITERATION NOW
NXT0:	PUSHJ P,LISTEN		;NO, HAS USER TYPED ANYTHING?
	 JRST NXT1		;NO, CONTINUE
$XQUIT:	SETZM XTEM		;YES, STOP ITERATION BY ZEROING COUNTER
	TLZ F,(CCF)		;  AND CLEARING CONTROL FLAG
NXT1:	TLNE F,(CCF)		;$$ STILL IN EFFECT?
	JRST NXT2		;YES, DON'T PRINT ANYTHING
	HRRZ T,PROC0		;NO, GET CURRENT PC AGAIN
	CAIN T,1(W1)		;DOES IT EQUAL OLD PC +1?
	JRST NXT1A		;YES--JUST CONTINUE
	CAIN T,2(W1)		;SKIP OR JUMP
	SKIPA W1,[ASCII "<SKP>"] ;SKIP
	MOVE W1,[ASCII "<JMP>"]	;JUMP
	PUSHJ P,TEXT2		;SAY SKIP OR JUMP
	PUSHJ P,CRF		;ADD CRLF
NXT1A:	HRRZ T,PROC0		;FETCH CURRENT PC AGAIN
	PUSHJ P,PINST		;PRINT INSTRUCTION ABOUT TO BE EXECUTED
	SKIPE XTEM		;ARE WE STILL LOOPING?
	PUSHJ P,CRF		;YES, PRINT CRLF AFTER INST
NXT2:	SKIPE XTEM		;SKIP IF REPEAT COUNTER IS ZERO
	JRST $X01		;NONZERO, REPEAT $X CYCLE AGAIN
	JRST TTYCLR		;ZERO, FLUSH ANY WAITING INPUT CHARACTERS
				;   AND RETURN FROM $X INSTRUCTION
;OUTPUT ROUTINES

;ROUTINE TO PRINT SECOND ACCUMULATOR

DBL0:	AOS T,I.NSTAC		;INCREMENT AC NUMBER
	TRZA T,777760		;ENSURE 17 WRAPS AROUND TO 0

;ROUTINE TO PRINT CONTENTS OF ACCUMULATOR

FAC0:	MOVE T,I.NSTAC		;FETCH AC NUMBER
	JRST EA2

;ROUTINE TO PRINT THE FLAGS

FLG0:	PUSHJ P,LCT		;PRINT TAB
	HLRZ T,SAVPI		;GET LH OF PC WORD
	JRST IMM1		;PRINT FLAGS

;ROUTINE TO PRINT JUST E FOR AN IMMEDIATE MODE INSTRUCTION

IMM0:	PUSHJ P,LCT		;PRINT TAB
	HRRZ T,I.NSTEA		;FETCH E
	TLNE F,FLE		;FLTG PT MEM OPERAND?
	MOVS T,T		;YES, IMMEDIATE SWAPS HALVES
IMM1:	EXCH F,FLAGS		;RESTORE DDT FLAGS
	PUSHJ P,CONSYM		;OUTPUT CONTENTS OF T
	JRST EA6		;RESTORE $X FLAGS AND RETURN

;ROUTINE TO PRINT 2ND MEMORY OPERAND

DEA0:	AOS I.NSTEA		;INC TO ADR OF 2ND OPERAND

;ROUTINE TO PRINT MEMORY OPERAND

EA0:	MOVE T,I.NSTEA		;FETCH ADR OF MEM OPERAND
EA2:	EXCH F,FLAGS		;HERE FROM DBL0,FAC0
	PUSH P,T		;SAVE ARG
	PUSHJ P,LCT		;OUTPUT TAB
	POP P,T			;RESTORE ADR OF LOC TO BE PRINTED
	PUSHJ P,LI1		;PRINT ADR/ CONTENTS
EA6:	EXCH F,FLAGS		;RESTORE $X FLAGS
	POPJ P,

;ROUTINE TO PRINT INSTRUCTION ALWAYS IN SYMBOLIC DESPITE CURRENT MODE

PINST:	PUSH P,SCH		;SAVE CURRENT OUTPUT MODE
	MOVEI SCH,PIN		;SET TO PRINT SYMBOLIC INST MODE
	PUSHJ P,LI1		;OUTPUT INST
	POP P,SCH		;RESTORE CURRENT MODE
	POPJ P,
;ROUTINE TO SWAP BETWEEN DDT AND USER CONTEXTS.
;   AC'S AND FLAGS ARE SWAPPED, BUT BREAKPOINTS AND OTHER STUFF
;   ARE NOT TOUCHED, SINCE CONTROL IS EXPECTED TO RETURN TO DDT SOON.

SWAPG:	EXCH 0,AC0		;SWAP AC 0
	MOVEM 0,SAV0		;SAVE 0 FOR WORK
	HLLZ 0,SWAP		;GET CURRENT FLAGS
	HLR 0,SAVPI		;GET SAVED FLAGS
	HRLM 0,SWAP		;SWITCH FLAGS
	HLLM 0,SAVPI
	MOVE 0,[EXCH 1,AC0+1]	;SETUP INST FOR SWAPPING AC'S
SWAPL:	XCT 0			;SWAP AN AC
	ADD 0,[Z 1,1]		;INC AC AND MEM FIELDS
	TLNN 0,1000		;AC 20 REACHED?
	JRST SWAPL		;NO, LOOP
	MOVE 0,SAV0		;YES, RESTORE SAVED AC
	JRSTF @SWAP		;RETURN, RESTORING NEW FLAGS
   >				;END IFE FTFILE
SUBTTL ENTER AND LEAVE DDT LOGIC

;SKIPS IF CONTEXT ALREADY SAVED

   IFE FTFILE,<
SAVEG:				;SAVE THE ACS AND PI SYSTEM
   IFN FTEXEC,<
	SKIPN TRCON		;TRACE FACILITY IN USE?
	JRST SAVEG1		;NO
	DATAI PI,TRCDMP		;YES, DUMP CURRENT POINTER
	DATAO PI,[0]		;TURN IT OFF
SAVEG1:
	MOVEM T,TEM		;FREE AN AC
	XMOVEI T,.		;GET CURRENT SECTION
	HLLZM T,CSECT		;SAVE IT
   IFE FTDEC20,<
	JSP T,.+1		;GET USR FLAG
	XOR T,SAVPI		;COMPARE WITH OLD USR FLAG(LAST DDT EXIT)
	TLNE T,(1B5)		;SAME?
	SETZM SARS>		;NO, SAVE AC'S AND PC FOR EXIT
				; SO EXEC/USER MODE FLOP RESTORED AS ENTERED
	JSP T,.+1		;GET FLAGS
	SKIPE CSECT		;IN EXT SECTION?
	XSFM T			;YES, GET FLAGS
	ROT T,5			;ROTATE USER MODE BIT TO SIGN
	MOVEM T,USRFLG		; AND SAVE IT
	MOVE T,TEM		;RESTORE THE AC 
   >				;END FTEXEC

;NOW SAVE USER STATUSES AND MODES AND SETUP DDT MODES.  DON'T SAVE
;MODES IF ALREADY SAVED (I.E. WHEN REENTERING DDT), BUT DO SET DDT
;MODES IN CASE THEY WERE CHANGED.

	SKIPE CSECT		;WERE IN EXT SECTION?
	JRST @[.+1]		;YES, SWITCH TO SECTION 0
	SKIPE SARS		;ALREADY SAVED?
	AOS SAVE		;YES, SKIP RETURN
   IFN FTEXEC,<
	SKPEXC
	JRST SAV11
	SKIPE SARS		;ALREADY SAVED?
	JRST SAV3		;YES
	CONI PI,SAVPI
	HRRZS SAVPI+1
SAV3:	CONO PI, @SAVPI+1>
SAV11:	SKIPE SARS		;ALREADY SAVED?
	JRST SAV5		;YES
	MOVEM 17,AC17		;SAVE ACS
	HRRZI 17,AC0
	BLT 17,AC0+16
	MOVE T,SAVE		;SAVE PC FLAGS
	SKIPE CSECT		;EXT ADR?
	XSFM T			;YES, GET FLAGS
	HLLM T, SAVPI
SAV5:	MOVE P,[IOWD LPDL,PDL]	;SETUP STACK
	; ..
;IF EDDT, DETERMINE PROCESSOR
;TYPE.  USER DDT DOES NOT NEED TO KNOW PROCESSOR TYPE

   IFN FTEXEC!FTMON,<
OPDEF APRID [700000,,0]
	SETZM SMFLAG		;ASSUME NOT AN SM10
	MOVNI T,1		;LOAD T WITH ALL ONES
	AOBJN T,.+1		;ADD ONE TO BOTH HALFS
	MOVEM T,KAFLG		;0 MEANS KI10; 1,,0 MEANS KA10
	SETZ T,			;TEST FOR KL10
	BLT T,0			;NOP BLT
	CAME T,[1,,1]		;KL WILL STORE POINTER AS 1,,1
	JRST SAV10		;NOT A KL10
	APRID T1
	ERJMP .+2		;DOESN'T MATTER IF USER MODE
	TRNE T1,^D4096		;SERIAL NUMBER GT 4095
	SETOM SMFLAG		;KS10
	SETOM KAFLG		;A KL10
SAV10:
   IFE FTDEC20,<
	HRRI T,XJBSYM		;GET EXEC SYMBOL POINTER ADR
	SKPEXC			;EXEC MODE?
	HRRI T,.JBSYM		;NO, GET USER MODE SYM POINTER ADR
	HRRM T,SYMP		; AND SAVE IT
	HRRI T,XJBUSY		;GET EXEC UNDEF SYM TABLE POINTER ADR
	SKPEXC			;EXEC MODE?
	HRRI T,.JBUSY		;NO, GET USER MODE UNDEF SYM POINTER ADR
	HRRM T,USYMP		; AND SAVE RESULTING ADR
	SKPEXC
	JRST SAV12		;TRANSFER IF IN USER MODE
	SKPKA			;IS THIS A KA10?
	JRST SAV12		;NO--LEAVE APR ALONE
	CONI T			;GET APR FLAGS
	TRNE T,NXMKA		;TEST NXM FLAG AND
	TLO T,(1B0)		;  MOVE IT TO BIT 0
	TLZ T,37		;FLUSH I AND X SO INDIRECT WORKS
	MOVEM T,SAVAPR		;SAVE STATE OF APR REGISTER
SAV12:	>>			;END IFN EDDT
	; ..
;SAVE STATE AND SETUP DDT MODES...

   IFN FTDEC20,<
	SETOM LASTPG		;FORGET LAST PAGE ACCESS
   IFN FTEXEC,<
	SKPUSR
	JRST SAV2>
	MOVSI T,(1B0)
	MOVEI T1,.FHSLF
	SKPIR			;PSI SYSTEM ON?
	 SETZ T,		;NO
	SKIPN SARS		;SKIP IF ALREADY HAVE SAVED STATUS
	MOVEM T,SAVSTS		;REMEMBER STATUS
SAV2:>				;END IFN FTDEC20
	PUSHJ P,TTYRET		;INITIALIZE TTY
   REPEAT 0,<			;WAIT FOR 5.3 RELEASE FOR THIS TEST
   IFN FTYANK,<SKPEXC		;IF IN USER MODE, RETURNING FROM $G,$P
	SKIPN COMAND		;AND A COMMAND FILE WAS OPEN
	JRST SAV6
	MOVEIT T,CM		;MAKE SURE A RELEASE HASN'T BEEN DMNE
	CALLI T,4		;DEVCHR
	TRNN T,200000		;DEVICE PAT STILL INITED?
	SETZM COMAND		;NO, DONT READ ANY MORE
SAV6:	>			;END IFN FTYANK
   >				;END OF REPEAT 0 CONDITIONAL
	MOVEI F,0		;INIT FLAG REGISTER
	SETOM SARS		;FLAG PROTECTING SAVED REGISTERS
	MOVE T,[XWD SCHM,SCH]
	BLT T,ODF		;LOAD THE ACS WITH MODE SWITCHES
	HRRZS SAVE		;FLUSH POSSIBLE SECTION NUMBER
	JRST @SAVE
;RESTORE PROGRAM CONTEXT - AC'S, PI SYSTEM, CURRENT SECTION, ETC.
; 	JSP T,RESTOR

RESTOR:	MOVEM T,LEAV1		;SAVE LOCAL RETURN PC
	PUSHJ P,TTYLEV		;RESTORE STATUS OF CONSOL TTY (EXEC MODE)
	MOVE T,SAVPI
	TLZ T,010037		;DON'T TRY TO RESTORE USER MODE FLAG
	HLLM T,LEAV0		;SETUP FLAGS FOR RESTORE BELOW
	HLLM T,LEAV1
   IFN FTEXEC,<
	SKPEXC
	JRST RESTR2
	AND T, SAVPI+1
	IORI T, 2000		;TURN ON CHANNELS
	TRZ T,1000		;MAKE SURE WE DON'T ASK FOR BOTH
	HRRZM T, SAVPI
   >				;END FTEXEC
RESTR2:	SKIPE T,CSECT		;EXT ADR?
	HLLM T,LEAV1		;YES, SETUP SECTION TO RESTORE BELOW
	HRLZI 17,AC0
	BLT 17,17
	SETZM SARS
   IFN FTEXEC,<
	SKPEXC
	JRST RESTR3		;TRANSFER IF IN USER MODE
   IFE FTDEC20,<
	SKIPGE SAVAPR		;WANT NXM SET?
	MOVES 777777		;YES--ASSUME KA-10
   >
	SKIPE TRCON		;TRACE FACILITY ON?
	DATAO PI,TRCON		;YES, START TRACING
	CONO PI,@SAVPI
RESTR3:>
	SKIPE CSECT		;RESTORE SECTION?
	XJRSTF LEAV0		;YES
	JRST 2,@LEAV1
SUBTTL BREAK POINT LOGIC

BCOMG:	EXCH T,BCOM		;SAVE AC, GET LOCAL PC
	MOVEM T,LEAV
	XMOVEI T,.
	HLLZM T,CSECT		;SAVE CURRENT SECTION
	SKIPE CSECT		;EXT ADR?
	XSFM LEAV0		;YES, SAVE FLAGS
	MOVE T,@LEAV		;GET INSTRUCTION WHICH SHOULD BE AT BPT
	EXCH T,LEAV		;SAVE IT, GET BACK LOCAL PC
	MOVEI T,B1SKP-B1INS(T)
	HRRM T,BCOM3		;CONDITIONAL BREAK SETUP
	MOVEI T,B1CNT-B1SKP(T)
	HRRM T,BCOM2		;PROCEDE COUNTER SETUP
	MOVE T,BP1-B1CNT(T)	;GET PC WORD
	HLLM T,LEAV1		;SAVE FLAGS FOR RESTORING
	EXCH T,BCOM		; ALSO SAVE PC WORD IN BCOM

	XCT BCOM3		;(SKIPE) CONDITIONAL BPT SETUP?
	XCT @BCOM3		;YES, XCT IT
	XCT BCOM2		;(SOSG) PROCEED COUNTER NOW 0?
	JRST BREAK

	MOVEM T,AC0+T
	MOVEI T,LEAVG		;SETUP LOCAL JUMP
	HRRM T,LEAV1
	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
   IFN FTEXEC&^-FTDEC20,<
	MOVSI T,010000		;DON'T TRY TO RESTORE USER MODE BIT
	ANDCAM T,LEAV1 >
	MOVE T,AC0+T
	SKIPE CSECT		;EXT ADR?
	XJRSTF LEAV0		;YES, RESTORE FLAGS AND SECTION
	JRST 2,@LEAV1		;RESTORE FLAGS, GO TO LEAVG
BREAK: IFN FTDEC20,<
	SETZM SARS>		;BE SURE TO SAVE ACS ON BKPT
	JSR SAVE		;SAVE THE WORLD
	 PUSHJ P,REMOVB		;REMOVE BREAKPOINTS
	PUSHJ P,TTYCLR		;FLUSH WAITING TTY CHARACTERS FOR INPUT
	SOS T,BCOM3
	HRRZS T			;GET ADR OF CONDITIONAL BREAK INST
	SUBI T,B1ADR-3		;CHANGE TO ADDRESS OF $0B
	IDIVI T,3		;QUOTIENT IS BREAK POINT NUMBER
	HRRM T,BREAK2		;SAVE BREAK POINT #
	MOVE W1,[BYTE (7) "$","0","B",76,0] ;PRELIMINARY TYPEOUT MESSAGE
REPEAT 0,<IFN FTEXEC,<
	SKPUSR
	TRC W1,7_^D15		;IN EXEC MODE, TYPE "$NEG"
   >>
	SKIPG @BCOM2		;TEST PROCEED COUNTER
	TRO W1,76_1		;CHANGE T TO /$0BGG/
	DPB T,[POINT 4,W1,13]	;INSERT BREAK POINT # IN MESSAGE
	PUSHJ P,TEXT2
	MOVE T,BCOM
	SKIPE CSECT		;EXT ADR?
	HLL T,LEAV0		;YES, GET FLAGS
	HLLM T,SAVPI		;SAVE PROCESSOR FLAGS
	MOVEI T,-1(T)
	PUSHJ P,PSHLLC		;PUSH OLD SEQUENCE
	MOVEM T,LWT		;BKPT ADR BECOMES LAST WORD TYPED
	MOVEM T,LLOC		;BKPT ADR BECOMES CURRENT LOC
	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
	MOVEM T,LLOC		;EXAMINE ADR BECOMES CURRENT LOC
	PUSHJ P,LI1		;EXAMINE REGISTER C($NB)LEFT
BREAK1:	MOVSI S,400000
	XCT BREAK2		;ROT BY # OF BREAK POINT
	PUSHJ P,LISTEN		;DONT PROCEED IF TTY KEY HIT
	TDNN S,AUTOPI		;DONT PROCEED IF NOT AUTOMATIC
	JRST RET		;DONT PROCEED
	JRST PROCD1
PROCED:	HRRZ TT,BCOM2		;SEE IF PROCEED POSSIBLE
	JUMPE TT,ERR		;JUMP IF NOT SETUP
	TLNN F,(QF)		;N$P	;PROCEED AT A BREAKPOINT
	MOVEI T,1
	MOVEM T,@BCOM2
	HRRZ R,BCOM3
	PUSHJ P,AUTOP
PROCD1:	PUSHJ P,CRF
	XCT PROC0		;(HRRZI) GET ADR OF BPT
	PUSHJ P,FETCH
	 JRST BPLUP1		;ONLY GET HERE IF MEMORY SHRANK
	MOVEM T,LEAV
	PUSHJ P,INSRTB
	JRST PROC2

PROC1:	MOVE T,AC0+T
	JSR SAVE
	 JFCL
	MOVE T,BCOM		;STORE FLAGS WHERE "RESTORE"
	SKIPE CSECT		;EXT ADR?
	MOVE T,LEAV0		;YES, GET FLAGS
	HLLM T,SAVPI		;  CAN FIND THEM
PROC2:	MOVEI W,100
	MOVEM W,TEM1		;SETUP MAX LOOP COUNT
	HLLZS BCOM2		;CLEAR FLAG, PREVENT SECOND $P
	HLLZS BCOM2		;CLEAR FLAG, PREVENT SECOND $P
	JRST IXCT5
IXCT4:
   IFN FTEXEC,< SKPUSR
	JRST IXCT41>		;INIT NOT SPECIAL CASE IN EXEC MODE 
	SUBI T,041		;IS UUO "INIT"?
	JUMPE T,BPLUP
	AOJGE T,IXCT6		;DONT PROCEDE FOR INIT
				;DONT INTERPRET FOR SYSTEM UUOS
IXCT41:	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:	LDB T,[POINT 9,LEAV,8]	;GET INSTRUCTION
	CAIN T,254		;DON'T DO ANYTHING TO JRST
	JRST IXCT6
IXCT51:	SKIPE CSECT		;EXT ADR?
	JRST IXCT52		;YES, CAN'T COMPUTE EFF ADR THIS WAY
	HRLZI 17,AC0
	BLT 17,17
	MOVEI T,@LEAV
	DPB T,[POINT 23,LEAV,35] ;STORE EFFECTIVE ADDRESS
IXCT52:	LDB W1,[POINT 4,LEAV,12] ;PICK UP AC FIELD
	LDB T,[POINT 9,LEAV,8]	;PICK UP INSTRUCTION FIELD
	MOVE P,[IOWD LPDL,PDL]
	CAIN T,<PUSHJ>B62
	JRST  IPUSHJ		;INTERPRET PUSHJ
	CAIN T,<JSR>B62
	JRST IJSR		;INTERPRET JSR
	CAIN T,<JSP>B62
	JRST IJSP		;INTERPRET JSP
	CAIN T,<JSA>B62
	JRST IJSA		;INTERPRET JSA
	MOVE R,LEAV
	TRNN T,700
	JRST IXCT4		;INTERPRET UUO
	CAIN T,256
	JSP T,[JUMPE W1,IXCT	;INTERPRET XCT IF AC = 0
		TLNN T,(1B5)	;AC FIELD NOT 0 - IN EXEC MODE?
		JRST IXCT6	;YES, DON'T INTERPRET MAPPED XCT
		JRST IXCT]	;NO,  INTERPRET. IGNORE AC FIELD
IXCT6:	JSP T,RESTORE
LEAVG:	XCT LEAV		;DO BPT INSTRUCTION
	 JRST @BCOM
	 SKIPA			;SINGLE SKIP
	AOS BCOM		;DOUBLE SKIP
	AOS BCOM
	JRST @BCOM

BPLUP:	PUSHJ P,REMOVB		;BREAKPOINT PROCEED ERROR
BPLUP1:	JSR SAVE
	 JFCL
	JRST ERR
IPUSHJ:	DPB W1,[POINT 4,CPUSHP,12] ;STORE AC FIELD INTO A PUSH
	SKIPN T,CSECT		;GET CURRENT SECTION IF EXT ADR
	HLL T,SAVPI		;PICK UP FLAGS
	HLLM T,BCOM		;SET UP THE OLD PC WORD
	MOVSI T,(1B4)		;TURN OFF BIS FLAG IN NEW PC WORD
	ANDCAM T,SAVPI
	JSP T,RESTORE		;RESTORE THE MACHINE STATE
	XCT CPUSHP		;(PUSH ..,BCOM)
IJSR3:	MOVEI T,<JUMPA>B62	;CHANGE INSTRUCTION TO JUMPA SAME ADDRESS
	DPB T,[POINT 9,LEAV,8]
	MOVE T,AC0+T		;RESTORE THE LAST AC
	XCT LEAV		;DO IT

IJSA:	SKIPE CSECT		;EXT ADR?
	JRST ERR		;YES, JSA NOT SUPPORTED
	MOVE T,BCOM		;INTERPRET JSA
	HRL T,LEAV
	EXCH T,AC0(W1)
	JRST IJSR2

IJSR:	SKIPE CSECT		;EXT ADR?
	JRST IXJSR		;YES, TOTALLY DIFFERENT
	MOVE T,BCOM		;INTERPRET JSR
	HLL T,SAVPI		;SET UP THE OLD PC WORD
	MOVSI W,(1B4)		;TURN OFF BIS IN NEW PC WORD
	ANDCAM W,SAVPI
IJSR2:	MOVE R,LEAV
	PUSHJ P,DEPMEM
	 JRST BPLUP		;ERROR, CAN'T STORE
	AOS T,LEAV
	JRST RESTORE

IXJSR:	LDB T,[POINT 23,LEAV,35] ;GET I,X,Y
	TLO T,(XMOVEI T,0)	;CONSTRUCT AN XMOVEI TO GET EFF ADR
	MOVEM T,LEAV
	JSP T,RESTOR		;RESTORE CONTEXT
	XCT LEAV		;GET EFF ADR INTO T
	MOVEM T,TEM		;SAVE IT
	MOVE T,BCOM		;GET PC
	MOVEM T,@TEM		;STORE PC AT EFF ADR
	AOS TEM			;COMPUTE EFF ADR +1
	MOVE T,AC0+T		;RESTORE SCRATCH AC
	JRST @TEM		;RESUME PROGRAM

IJSP:	MOVE W,BCOM		;INTERPRET JSP
	HLL W,SAVPI		;PICK UP PC WORD FLAGS
	SKIPE CSECT		;EXT ADR?
	HLL W,CSECT		;YES, LH GETS SECTION
	MOVEM W,AC0(W1)		;INSERT OLD PC WORD INTO AC
	MOVSI T,(1B4)		;TURN OFF BIS FLAG IN NEW PC WORD
	ANDCAM T,SAVPI
	JSP T,RESTOR		;RESTORE CONTEXT
	JRST IJSR3		;JUMP TO EFF ADR
;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,DEPMEM
	 JFCL			;HERE ONLY IF CAN'T WRITE IN HIGH SEG
INSRT3:	ADDI S,3
	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,DEPMEM
	 JFCL			;HERE ONLY IF NO WRITE IN HIGH SEG
	SUBI S,3
	CAIL S,B1ADR
	JRST REMOV1
	POPJ P,
;ALL $B COMMANDS GET HERE IN FORM: <A>$<N>B


BPS:	TLZE F,(QF)		;HAS <A> BEEN TYPED?
	JRST BPS1		;YES
	TRZE F,Q2F		;NO, HAS <N> BEEN TYPED?
	JRST BPS2		;YES
	MOVE T,[XWD B1ADR,B1ADR+1] ;NO, COMMAND IS $B - CLEAR ALL BREAKPOINTS
	CLEARM B1ADR
	BLT T,AUTOPI		;CLEAR OUT ALL BREAKPOINTS AND AUTO PROCEDE REGESTER
	JRST RET

BPS1:	MOVE R,T
	PUSHJ P,FETCH		;CAN BREAKPOINT BE INSERTED HERE?
	 JRST ERR		;NO
	PUSHJ P,DEPERR		; AGAIN NO
	TRZN F,Q2F		;HAS <N> BEEN TYPED?
	JRST BPS3		;NO
	TRO F,2			;YES, PROCESS THE COMMAND A$NB
BPS2:	MOVE T,WRD2
	CAIL T,1
	CAILE T,NBP
	JRST ERR
	IMULI T,3
	ADDI T,B1ADR-3
	TRZN F,2
	JRST MASK2
	EXCH R,T
	JRST BPS5
BPS3:	MOVE T,R		;PUT THE BREAKPOINT ADR BACK IN T
	MOVEI R,B1ADR		;PROCESS THE COMMAND A$B
BPS4:	HRRZ W,(R)
	CAIE W,(T)
	SKIPN (R)
	JRST BPS5
	ADDI R,3
	CAIG R,BNADR
	JRST BPS4
	JRST ERR
BPS5:	MOVEM T,(R)
	SETZM 1(R)
	SETZM 2(R)

AUTOP:	SUBI R,B1ADR		;AUTO PROCEDE SETUP SUBROUTINE
	IDIVI R,3
	MOVEI S,1
	LSH S,(R)
	ANDCAM S,AUTOPI
	TLNE F,(CCF)
	IORM S,AUTOPI
	POPJ P,

   >				;END FTFILE

   IFN FTFILE,<BPS==<PROCEDE==ERR>>
SUBTTL MEMORY MANAGER SUBROUTINES

;DEPOSIT INTO MEMORY SUBROUTINE

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
	JRST DMEMER

;DEPOSIT INTO MEMORY SUBROUTINE

   IFE FTFILE,<
DEPSYM:
DEPMEM:	IFE FTDEC20,<
	PUSHJ P,CHKPAG		;GET PAGE ACCESS BITS INTO TT1
	JUMPL TT1,CPOPJ		;ILLEGAL ADDRESS IF NEGATIVE
	TLNE TT1,(1B1)		;IS PAGE KNOWN TO BE WRITEABLE?
	JRST DEP1		;YES--GO DO THE DEPOSIT RIGHT AWAY
	JUMPN TT1,DEP4		;IF WE KNOW ANYTHING THEN IT MUST BE
				; A WRITE LOCKED HISEG
	JSP TT1,CHKADR		;LEGAL ADDRESS?
	JRST DEP4		;YES BUT IN HI SEGMENT
DEP1:	TRNN R,777760
	JRST DEPAC		;DEPOSIT IN AC
	MOVEM T,(R)
	JRST CPOPJ1		;SKIP RETURN

DEPAC:	MOVEM T,AC0(R)		;DEPOSIT IN AC
	JRST CPOPJ1		;SKIP RETURN

DEP4:	IFN FTEXEC,<
	SKPUSR			;IN EXEC MODE WE CAN NOT DO
	POPJ P,0		; SETUWP -- INDICATE ERROR
   >
	MOVEI TT1,0
	SETUWP TT1,		;IS HI SEGMENT PROTECTED? TURN OFF
	 POPJ P,		;PROTECTED, NO SKIP RETURN
	MOVEM T,(R)		;STORE WORD IN HI SEGMENT
	TRNE TT1,1		;WAS WRITE PROTECT ON?
	SETUWP TT1,		;YES, TURN IT BACK ON
	 JFCL
	JRST CPOPJ1		;SKIP RETURN
   >				;END IFE FTDEC20
   IFN FTDEC20,<		;DEPSYM, DEPMEM FOR DEC20
	TRNN R,777760		;AC?
	JRST [	MOVEM T,AC0(R)	;YES, DO IT
		JRST CPOPJ1]
	PUSHJ P,CHKADR		;GET ACCESS
	JUMPE TT,DEP2		;EMPTY PAGE OK
	TLNN TT,(PM%WT+PM%CPY)	;WRITE OR COPY-WRITE?
	POPJ P,			;NO, FAIL
DEP2:	SETOM LASTPG		;WRITE MAY CHANGE ACCESS
	MOVEM T,0(R)		;DO IT
	JRST CPOPJ1
   >				;END IFN FTDEC20

DSYMER:	PUSHJ P,CLRCSH		;DEPOSIT FOR SYM TABLE ROUTINES
   >				;END IFE FTFILE
DEPERR:
DMEMER:	PUSHJ P,DEPMEM		;DEPOSIT AND GO TO ERR IF IT FAILS
	 JRST ERR
	POPJ P,
   IFN FTFILE,<
DSYMER:	PUSHJ P,DEPSYM		;TRY SYMBOL TABLE DEPOSIT
	 HALT .		;GIVE UP
	POPJ P,			;AND RETURN

DEPSYM:	PUSH P,TT		;SAVE THREE LOCATIONS
	PUSH P,TT1		;  TO PROTECT FILDDT
	PUSH P,R		; ..
	MOVE TT,FISPTR		;GET DEF POINTER
	HLRE TT1,TT		;GET LENGTH
	SUB TT,TT1		;COMPUTE END OF SYMBOLS
	TLZ TT,-1		;CLEAR JUNK
	MOVE TT1,FIUPTR		;GET START OF UNDEF S.T.
	CAMLE TT1,ESTUT		; IN THE CASE OF UND1 CODE ALREADY
				; TRYING TO EXTEND S.T.
	MOVE TT1,ESTUT		;YES--USE THAT VALUE
	SKIPL TT1		;MIGHT NOT BE ANY UNDEFINED SYMBOLS
	MOVE TT1,FISPTR		;FAILING THAT, GET START OF SYMBOLS
	TLZ TT1,-1		;CLEAR JUNK
	TLZ R,-1		; ..
	CAIG TT1,(R)		;SEE IF TOO LOW
	CAIGE TT,(R)		;OR TOO HIGH
	HALT .			;YES--QUIT
	POP P,R
	POP P,TT1		;OK--RESTORE TEMPS
	POP P,TT		; AND PROCEDE
	CAME T,(R)		;SEE IF DIFFERENT
	SETOM CHGSFL		;YES--FLAG THAT SYMBOLS CHANGED
	MOVEM T,(R)		;STORE NEW VALUE
	JRST CPOPJ1		;RETURN
DEPMEM:	HRRZ TT1,R		;COPY ADDRESS
	CAIG TT1,17		;IS IT AN AC?
	JRST [	MOVEM T,AC0(TT1) ;STORE
		 JRST CPOPJ1]
	SKIPN PATCHS		;SEE IF PATCHING
	JRST DEPNPT		;NO--GIVE NOOP
	PUSHJ P,CVTADR		;CHANGE ADDRESS PER $U
	 POPJ P,0		;ERROR
	SKIPN CRASHS		;SEE IF CRASHING
	JRST MONPOK		;NO--POKE MONITOR
	PUSH P,T		;PRESERVE T
	PUSHJ P,FETCH		;YES--GET WORD
	 JRST [	POP P,T
		 POPJ P,]
	POP P,T			;RESTORE WORD TO STORE
	MOVSI TT2,(1B5)		;SET CHANGED BIT
	CAME T,@FETADR		;UNLESS NO CHANGE
	IORM TT2,@FETPAG	; ..
	MOVEM T,@FETADR		;CHANGE WINDOW
DEPRET:	JRST CPOPJ1		;GIVE GOOD RETURN

MONPOK:	PUSH P,T		;SAVE ARGUMENT
	MOVEM T,POKER+2		;SET AS NEW VALUE
	HRRZM R,POKER		;SET ADDRESS
				;NOTE--LAST TYPEOUT IS IN POKER+1
				;  SO THAT USER MUST KNOW WHAT
				;  HE IS CHANGING
	MOVE T,[3,,POKER]	;GET POINTER
	CALLI T,114		;POKE. MONITOR
	 JRST ERR		;COMPLAIN IF WE CAN'T
	POP P,T			;RESTORE VALUE
	JRST CPOPJ1		;SKIP RETURN

POKER:	BLOCK 3			;ARGUMENTS FOR POKING

DEPNPT:	AOSG DEPNCT		;FIRST TRY?
	OUTSTR [ASCIZ \
?Patching was not enabled by /P
\]
	JRST CPOPJ1
DEPNCT:	BLOCK 1
;STILL UNDER FTFILE

;HERE WHEN ^Z TYPED TO CLOSE OUT

CNTRLZ:	SKIPE CRASHS		;SEE IF NOT /M
	SKIPN PATCHS		;OR NOT /P
	JRST NOCHNZ		;RIGHT--JUST WRAP UP
	SKIPN CHGSFL		;SEE IF SYMBOL TABLE CHANGED
	JRST NOSCPY		;JUMP IF NOT
	PUSHJ P,SYMPTR		;YES--REFETCH FILE POINTER
	HLRE W1,FIUPTR		;GET LENGTH OF UNDEFINED S.T.
	HLRE R,FISPTR		;GET LENGTH OF STANDARD S.T.
	ADD W1,R		;ADD TOGETHER
	MOVM W1,W1		;MAKE POSITIVE
	HRRZ R,TT		;GET BASE OF UNDEFINED S.T.
	SKIPN TT		;IN CASE NOTHING THERE
	HRRZ R,T		;USE BASE OF DEFINED S.T.
	ADD W1,R		;ADD BASE AND LENGTH OF TABLES
	MOVEM W1,MONSIZ		;STORE AS NEW SIZE OF .XPN FILE
	MOVE W1,FIUPTR		;PREPARE TO
	MOVE R,T
	JUMPGE W1,NOUCPY	;JUMP IF NONE
	JUMPE TT,NOUCPY
	MOVE R,TT		;  COPY UNDEF SYMS
OUCPY:	MOVE T,(W1)
	PUSHJ P,DMEMER
	AOS R
	AOBJN W1,OUCPY

NOUCPY:	HRRZ T,TT		;GET START
	HLL T,FIUPTR		;GET NEW LENGTH
	PUSH P,R		;SAVE START OF SYMBOLS
	HLRZ R,S		;GET LOCATION POINTER IS KEPT
	PUSHJ P,DMEMER		;STORE NEW POINTER

	HRRZ R,(P)		;START AT BEGINNING
	MOVE W1,FISPTR		;PREPARE TO COPY SYMS
	JUMPGE W1,NOSCP
OSCPY:	MOVE T,(W1)
	PUSHJ P,DMEMER
	AOS R
	AOBJN W1,OSCPY

NOSCP:	POP P,T			;GET START
	HLL T,FISPTR		;GET NEW LENGTH
	HRRZ R,S		;GET LOCATION POINTER IS KEPT
	PUSHJ P,DMEMER		;STORE NEW POINTER
;STILL UNDER FTFILE

NOSCPY:	SETZM WINNUM		;START WITH WINDOW ZERO
WRTLP:	MOVE T,WINNUM		;GET WINDOW NUMBER
	MOVE T,WINDIR(T)	;GET PAGTBL ADDRESS
	MOVSI TT1,(1B5)		;SEE IF PAGE CHANGED
	TDNE TT1,(T)		; ..
	PUSHJ P,WRTWIN		;WRITE THE WINDOW
	AOS T,WINNUM		;STEP TO NEXT WINDOW
	CAIGE T,CT.RES		;MORE
	JRST WRTLP		;NO--KEEP GOING
	MOVSI TT,-MX.SIZ	;LOOK FOR CHNAGED BITS
	MOVSI TT1,(1B5)		; ..
	TDNN TT1,PAGTBL(TT)	; ..
	AOBJN TT,.-1		; ..
	SKIPG TT		;ANY FOUND
	OUTSTR [ASCIZ "
?FILDDT INTERNAL ERROR -- VERIFY YOUR PATCHES
"]
	CLOSE 1,
	STATZ 1,760000		;ALL OK
	OUTSTR [ASCIZ "
?OUTPUT ERROR ON CLOSE
"]
NOCHNZ:	CALLI 12
   >				;END FILDDT CASE
;FETCH FROM MEMORY SUBROUTINE

;HFETCH GETS A WORD FROM THE HISEG GIVEN AN OFFSET INTO THE SEGMENT
;CALL WITH:
;	R = HISEG OFFSET
;	PUSHJ P,HFETCH
;	  NO HISEG RETURN
;	HERE WITH WORD IN T
;
HFETCH:
   IFN FTEXEC,<
	SKPUSR			;NO HISEG SYMBOLS IN EXEC MODE
	POPJ P,0>		; ..
	PUSHJ P,GETHSO		;GET START OF HISEG
	JUMPE T,CPOPJ		;EXIT IF NONE
	ADD R,T			;RELOCATE
;FALL INTO FETCH

;SUBROTINE GET A WORD FROM MEMORY
;CALL WITH:
;	R = JUNK,,ADDRESS
;	PUSHJ  P,FETCH
;	  HERE IF ADDRESS IS NOT VALID
;	HERE WITH WORD IN T AND R UNCHANGED
;	
;AC'S TT1 AND TT2 CHANGED

FETCH: IFE FTDEC20,<
   IFE FTFILE,<
	PUSHJ P,CHKPAG		;GET ACCESS BITS FOR PAGE
	JUMPL TT1,CPOPJ		;ERROR IF PAGE DOES NOT EXIST
	TLNE TT1,(1B2)		;IS PAGE READABLE?
	JRST FET1		;YES--GO READ IT
	JUMPN TT1,CPOPJ		;EXIT IF KNOW CONCEALED
	JSP TT1,CHKADR		;LEGAL ADDRESS?
	JFCL			;HIGH OR LOW OK FOR FETCH
FET1:	TRNN R,777760		;ACCUMULATOR?
	SKIPA T,AC0(R)		;YES
	MOVE T,(R)		;NO
	JRST CPOPJ1>		;SKIP RETURN ONLY FOR LEGAL ADDRESS 
   >				;END OF IFE FTDEC20
   IFN FTDEC20,<		;FETCH FOR DEC20
	TRNN R,777760		;AC?
	JRST [	MOVE T,AC0(R)	;YES, DO IT
		JRST CPOPJ1]
	PUSHJ P,CHKADR		;GET ACCESS
	TLNE TT,(PA%EX)		;EXISTS?
	TLNN TT,(PM%RD)		;HAVE READ?
	POPJ P,			;NO, FAIL
	MOVE T,0(R)		;YES, DO IT
	JRST CPOPJ1
   >				;END IFN FTDEC20
   IFN FTFILE,<
	HRRZ TT1,R		;STRIP OF COUNT
	CAIG TT1,17		;IS IT AN AC
	JRST [	MOVE T,AC0(TT1)	;YES--GET THE AC
		 JRST CPOPJ1]	;GIVE GOOD RETURN
	PUSH P,R		;SAVE JUNK IN R
	TLZ R,-1		;CLEAR JUNK
	PUSHJ P,CVTADR		;MAP THE ADDRESS
	 SKIPA			;ERROR
	PUSHJ P,FETX		;GET THE WORD
	 SOS -1(P)		;ERROR
	POP P,R			;RESTORE R
	JRST CPOPJ1		;RETURN
FETX:	SKIPN CRASHS		;CRASH.SAV EXIST?
	JRST MONPEK		;NO - GO PEEK AT RUNNING MONITOR
	HRRZ TT1,R		;STRIP OFF POSSIBLE COUNT
	LSH TT1,-9		;CONVERT TO PAGE #
	CAIL TT1,MX.SIZ		;TOO BIG?
	POPJ P,0		;YES--PUNT
	SKIPN PAGTBL(TT1)	;SOMETHING THERE?
	POPJ P,0		;NO--ERROR
	ADDI TT1,PAGTBL		;SET TO START OF TABLE
	MOVEM TT1,FETPAG	;SAVE FOR LATER
	LDB T,[POINT 9,@FETPAG,17] ;GET WINDOW NUMBER
	SOJGE T,INCORE		;JUMP IF IN CORE
	AOS T,WINNUM		;STEP TO NEXT WINDOW
	CAIL T,CT.RES		;ARE THERE THAT MANY?
	SETZB T,WINNUM		;NO--WRAP AROUND
	MOVEI TT2,1(T)		;STORE WINDOW # PLUS 1
	DPB TT2,[POINT 9,@FETPAG,17] ;IN PAGTBL
	MOVSI TT1,(1B5)		;CHANGE BIT
	TDNE TT1,@WINDIR(T)	;DID THIS PAGE CHANGE?
	PUSHJ P,WRTWIN		;YES--WRITE OUT WINDOW
	MOVE T,WINNUM		;GET WINDOW NUMBER BACK
	MOVEI TT1,0		;MARK CURRENT PAGE AS NOT IN CORE
	DPB TT1,[POINT 9,@WINDIR(T),17]
	MOVE TT1,FETPAG		;FIX UP DIRECTORY
	MOVEM TT1,WINDIR(T)	; ..
	PUSHJ P,REDWIN		;READ NEW DATA
	MOVE T,WINNUM		;GET NUMBER OF CURRENT WINDOW
INCORE:	LSH T,9			;CONVERT TO WORDS
	ADDI T,WIND0		;BUMP TO BASE OF WINDOWS
	LDB TT1,[POINT 9,R,35]	;GET WORD OFFSET
	ADD T,TT1		;ADDRESS OF WORD
	MOVEM T,FETADR		;SAVE FOR DEPOSIT
	MOVE T,(T)		;GET DATA
	JRST CPOPJ1		;GOOD RETURN
MONPEK:	HRRZ T,R
	CALLI T,33
	JRST CPOPJ1

WRTWIN:	SKIPA T,[OUT 1,TT1]
REDWIN:	MOVE T,[IN 1,TT1]
	PUSH P,T		;SAVE UUO
	MOVE T,WINNUM		;GET CURRENT WINDOW NUMBER
	MOVSI TT2,(1B5)		;CLEAR MODIFIED BIT
	ANDCAM TT2,@WINDIR(T)	; IN THE PAGE TABLE
	HRRZ TT1,@WINDIR(T)	;GET FILE PAGE #
	LSH TT1,2		;CONVERT TO BLOCK
	USETI 1,1(TT1)		;POINT FILSER
	LSH T,9			;CONVERT WINDOW # TO WORDS
	ADDI T,WIND0		;BASE OF WINDOWS
	MOVSI TT1,-1000		;NEGATIVE WORD COUNT
	HRRI TT1,-1(T)		;IOWD
	MOVEI TT2,0		;TERMINATE LIST
	POP P,T			;RESTORE UUO
	XCT T			;DO I/O
	 POPJ P,0		;DONE
	GETSTS 1,T
	SETSTS 1,17
	TLNN T,740000
	POPJ P,0		;JUST EOF
	OUTSTR [ASCII "?FATAL I/O ERROR
"]
	CALLI 1,12		;SAY .
	SETSTS 1,17		;CLEAR ERROR BITS
	POPJ P,0		;IGNORE ERROR
   >				;END FILDDT CONDITIONAL
   IFE FTDEC20,<
CHKADR:	HRRZ TT,.JBREL		;GET HIGHEST ADDRESS IN LOW SEGMENT
   IFN FTEXEC,<
	SKPUSR
	JRST CHKA4		;DO MAP IN EXEC MODE
   >
	CAIL TT,(R)		;CHECK FOR WITHIN LOW SEGMENT
	JRST 1(TT1)		;ADDRESS IS OK IN LOW SEGMENT, SKIP RETURN
	SKIPN .JBHRL		;ANY HISEG?
	POPJ P,0		;NO--ERROR
	PUSH P,T		;SAVE T
	PUSHJ P,GETHSO		;GET START OF HISEG
	HRRZ TT,R		;COPY DESIRED ADDRESS
	SUB TT,T		;GET OFFSET INTO HISEG
	POP P,T
	JUMPL TT,CPOPJ		;MUST BE POSITIVE
	HRRZ TT,.JBHRL		;TOP OF HISEG
	CAIGE TT,(R)		;IS ADDRESS TOO BIG?
	POPJ P,0		;YES--ERROR
	JRST (TT1)		;NO--INDICATE HISEG

CHKPAG:	IFN FTEXEC,<
	MOVEI TT1,0		;PRESET UNKNOWN ANSWER
	SKPUSR			;SKIP IF IN USER MODE
	POPJ P,0		;DO NOT DO UUO'S IN EXEC MODE
   >
	HRRZ TT1,R		;COPY ADDRESS
	LSH TT1,-9		;SHIFT LEFT 9 BITS
	HRLI TT1,6		;FUNCTION TO GET ACCESS BITS
	PAGE. TT1,		;ASK THE MONITOR
	 TDZA TT1,TT1		;RETURN ZERO IF UNKNOWN
	TRO TT1,1		;MAKE SURE NON-ZERO IF UUO WON
	POPJ P,0		;ELSE RETURN GOOD STUFF
GETHSO:	IFN FTEXEC,<
	SKPUSR
	JRST [	MOVEI T,400000
		 POPJ  P,0]
   >
	MOVE T,[-2,,.GTUPM]
	GETTAB T,
	 MOVEI T,0
	HLRZ T,T
	CAIGE T,777
	MOVEI T,400000
	POPJ P,
   >				;END IFE FTDEC20
   IFN FTDEC20,<
CHKADR:	IFN FTEXEC,<
	SKPUSR
	JRST CHKA4>
	PUSH P,T2
	PUSH P,R
	HRRZ T2,0(P)		;GET DESIRED ADDRESS
	XOR T2,LASTPG		;COMPARE WITH LAST ONE TESTED
	TRNN T2,777000		;SAME PAGE?
	JRST CHKA1		;YES, ALREADY HAVE ACCESS
	XORM T2,LASTPG		;NO, SET NEW LAST PAGE
	JSP T1,.+1		;GET USER FLAG
	TLNN T1,(PC%USR)	;IN USER MODE?
	JRST [	HRRZ T1,0(P)	;NO, MONITOR. GET ADDRESS
		MRPAC		;READ MONITOR PAGE ACCESS
		JRST CHKA2]	;RETURN IT
	LDB T1,[POINT 9,0(P),26] ;GET PAGE NUMBER
	HRLI T1,.FHSLF
	RPACS			;READ PAGE ACCESS
CHKA2:	HLLM T2,LASTPG		;SAVE ACCESS WITH ADDRESS
CHKA1:	HLLZ TT,T2		;RETURN ACCESS IN TT
	POP P,R
	POP P,T2
	POPJ P,
   >				;END FTDEC20
   IFN FTEXEC,<
CHKA4:	SKPNKL			;KL10?
	JRST [	MAP TT,0(R)	;YES, GET PAGING DATA
		TLNN TT,(1B8)	;MAPPED REF?
		JRST CHKA5	;NO, ALLOW IT
		TLNN TT,(1B1)	;HARD PAGE FAIL?
		TLNN TT,(1B2)	;OR NO ACCESS?
		JRST CHKA3	;YES
		TLNN TT,(1B3+1B4) ;WRITE ALLOWED?
		JRST CHKA7	;NO
		JRST CHKA5]	;YES
	SKPKI			;KI10?
	JRST CHKA8		;NO, NO MAP INSTRUCTION
	MAP TT,0(R)		;GET ACCESS BITS FOR PAGE
	TRNN TT,1B18		;PAGE FAIL?
	JRST CHKA6		;NO, GO INSPECT DATA
	TRNE TT,1B22		;YES, HAVE MATCH?
	JRST CHKA3		;NO, PAGE HAS NO ACCESS
CHKA6:	TRNN TT,1B20+1B22	;WRITABLE OR NO MATCH? (UNMAPPED REF)
   IFN FTDEC20,<
CHKA7:	SKIPA TT,[PM%RD+PA%EX]	;NO
CHKA8:
CHKA5:	MOVSI TT,(PM%RD+PM%WT+PA%EX) ;YES
	POPJ P,

CHKA3:	MOVSI TT,(1B5)		;SAY NO ACCESS
	POPJ P,
   >
   IFE FTDEC20,<
CHKA7:	JRST (TT1)		;CAN NOT WRITE -- INDICATE HISEG
CHKA5:	JRST 1(TT1)		;CAN WRITE -- INDICATE LOWSEG
CHKA3:	POPJ P,0		;PAGE FAIL -- INDICATE ERROR
CHKA8:	CONO APR,NXMKA		;CLEAR NXM FLAG
	MOVE TT,(R)		;SEE IF NXM SETS
	CONSO APR,NXMKA		;TEST NXM FLAG
	JRST 1(TT1)		;OK
	POPJ P,0		;ERROR
   >>				;END FTEXEC AND FTDEC20

   IFN FTDEC20,<
GETHSO:
   IFN FTEXEC,<
	SKPUSR
	JRST GETHSZ>		;NO HIGHSEG IN EXEC MODE
	SKIPN JDTFLG		;JOB DATA AREA VALID?
	JRST GETHSZ		;NO, ASSUME NO HIGHSEG
	MOVE T,.JBHSO		;CHECK SPECIAL LOSEG CELL
	LSH T,^D9		;MAKE PAGE INTO ADDRESS
	SKIPN T			;BUT IF NOTHING SETUP,
	MOVEI T,400000		;ASSUME USUAL
	SKIPN .JBHRL		;ANY HIGHSEG?
GETHSZ:	SETZ T,			;NO, SAY NO HIGHSEG
	POPJ P,
   >				;END IFN FTDEC20
   IFN FTFILE,<
;MAP AN ADDRESS
CVTADR:	SKIPN EPTUPT		;$U GIVEN
	JRST CPOPJ1		;NO
	HLRZ T,EPTUPT		;EXEC PAGING
	JUMPE T,CVTAD2		;NO
	LDB T,[POINT 9,R,26];GET PAGE #
	CAIGE T,340		;IS THERE A MAP ENTRY?
	JRST CPOPJ1		;NO--LOOK IN PHYSICAL CORE
	CAIL T,400		;PER PROCESS
	JRST CVTAD1		;NO--JUST LIKE USER
	PUSH P,R		;SAVE ARGUMENT
	LSH T,-1		;CONVERT TO 1/2 WORD
	HRRZ R,EPTUPT		;GET ADDRESS OF UPT
	ANDI R,17777		;JUST PAGE #
	LSH R,9			;CONVERT TO WORD
	ADDI R,400-<340/2>(T)	;FOR THIS PAGE
	JRST CVTAD3		;COMPUTE ADDRESS
CVTAD1:	HLRZ T,EPTUPT		;GET EPT ADDRESS
	SKIPA
CVTAD2:	HRRZ T,EPTUPT		;GET UPT ADDRESS
	ANDI T,17777		;JUST PAGE #
	PUSH P,R		;SAVE R
	LSH T,9			;CONVERT TO WORD
	LSH R,-12		;CONVERT TO 1/2 WORD IN MAP
	ANDI R,377		;MASK OUT JUNK
	ADD R,T			;ADDRESS OF MAP ENTRY
CVTAD3:	PUSHJ P,FETX		;FETCH PAGE TABLE ENTRY
	 MOVEI T,017000	;ERROR
	POP P,R			;RESTORE R
	TRNN R,1000		;ODD PAGE
	HLRZ T,T		;NO--FLIP ENTRY
	TRZN T,400000		;VAILD ENTRY
	POPJ P,0		;NO--ERROR
	ANDI T,17777		;JUST PAGE #
	LSH T,9			;CONVERT TO PAGE #
	ANDI R,000777		;GET NEW ADDRESS
	IOR R,T			; ..
	JRST CPOPJ1		;GIVE GOOD RETURN
   >				;END FTFILE
SUBTTL BINARY TO SYMBOLIC CONVERSION

;	PUSHJ P,LOOK		;AC T CONTAINS BINARY TO BE INTERPRETED
;	  RETURN 1		;NOTHING AT ALL FOUND THAT'S USEFUL
;	  RETURN 2		;SOMETHING FOUND, BUT NO EXACT MATCH
;	  RETURN 3		;EXACT MATCH FOUND AND PRINTED

LOOK:	MOVEM T,TEM		;SAVE VALUE BEING LOOKED UP
	PUSHJ P,CSHVER		;SEE IF CACHE IS USEFUL
	 JRST LOOKC2		;ITS NOT. DO IT THE OLD WAY
	MOVE T,TEM		;RECOVER VALUE
	MOVSI R,-NSYMCS		;CHECK SYMBOL CACHE FIRST
LOOKC1:	SKIPE W1,SYMCSH(R)	;GET POINTER AND CHECK IN USE
	CAME T,1(W1)		;VALUE SAME?
	SKIPA			;NO. DON'T LOOK AT IT THEN
	JRST [	MOVE W2,0(W1)	;CHECK SYMBOL
		TLNE W2,(DELI+DELO) ;DELETED?
		JRST .+1	;YES, IGNORE IT
		MOVEM W1,SYMPNT	;GOOD ONE
		JUMPL W1,LOOKO2	;WAS OUTSIDE LOCAL
		JRST LOOKO4]	;WAS GLOBAL OR PROGRAM
	AOBJN R,LOOKC1
LOOKC2:	PUSHJ P,SYMSET		;SET UP SYM SEARCH POINTER AND COUNT
	SETZM SYMPNT		;INIT "OUTSIDE LOCAL" FLAG
	TRZ F,MDLCLF!PNAMEF	;INIT FLAGS
	TLZ F,(1B0)		;CLEAR SYMBOL TYPED FLAG
	MOVE T,TEM		;RESTORE VALUE BEING LOOKED UP
	JUMPGE R,CPOPJ		;RETURN, NOTHING FOUND

LOOK1:	MOVE W2,(R)		;GET FLAGS FOR SYMBOL
	TLNN W2,(PNAME)		;PROGRAM NAME?
	JRST [	JUMPE W2,LOOK3	;YES, IGNORE NULL PROGRAM NAMES
		TRO F,PNAMEF	;SET PROGRAM NAME FLAG
		JRST LOOK3]	;GET NEXT SYMBOL
	CAML T,1(R)		;VALUE TOO LARGE?
	TLNE W2,(DELI!DELO)	;DELETED?
	JRST LOOK3		;YES, GET NEXT SYMBOL
	TLNN W2,(GLOBL)		;NOT PROGRAM NAME. GLOBAL SYMBOL?
	TRNN F,PNAMEF		;LOCAL SYMBOL. INSIDE SPECIFIED PROGRAM?
	JRST LOOK5		;CHECK FOR BEST VALUE SO FAR
	CAIGE T,20		;QUANT IS IN AC RANGE?
	JRST LOOK3		;YES, IGNORE OUTSIDE LOCALS
	MOVE W,1(R)		;GET VALUE
	XOR W,T			;COMPARE
	JUMPL W,LOOK3		;REJECT IF SIGNS DIFFERENT
	SKIPN W2,SYMPNT		;HAVE ANY OUTSIDE LOCAL NOW?
	JRST LOOK2		;NO, USE THIS ONE
	MOVE W,1(R)		;COMPARE VALUES
	SUB W,1(W2)
	JUMPLE W,LOOK3		;REJECT UNLESS BETTER
LOOK2:	TRZ F,MDLCLF		;NOTE NO AMBIGUITY NOW
	HRRZM R,SYMPNT		;SAVE POINTER TO SYMBOL
LOOK3:	AOBJN R,.+1
	AOBJN R,LOOK3A		;ADVANCE POINTER TO NEXT SYM. ANY LEFT?
   IFE FTFILE,<
	TRNN R,1B18		;HIGH SEGMENT SEARCH?
	SKIPL R,SAVHSM		;NO, SEARCH HIGH SEG TABLE , IF ANY
   >
	MOVE R,@SYMP		;NO, WRAP AROUND END OF TABLE
LOOK3A:	AOJLE S,LOOK1		;TRANSFER IF MORE SYMBOLS TO LOOK AT
	SKIPE W2,SYMPNT		;OUTSIDE LOCALS FOUND?
	TRNE F,MDLCLF		;THAT ARE NOT MULTIPLY SYMBOLED?
	JRST LOOK4		;NO
	JUMPGE F,LOOKO1		;JUMP IF NO REGULAR SYMBOL FOUND
	MOVE W,1(W2)		;GET OUTSIDE LOCAL VALUE
	CAMG W,1(W1)		;BETTER THAN REGULAR SYM VALUE?
	JRST LOOK4		;NO, USE REGULAR SYM
LOOKO1:	HRLI W1,(1B0)		;FLAG OUTSIDE LOCAL
	PUSHJ P,SYMCSI		;ADD TO SYMBOL CACHE
LOOKO2:	MOVE W1,SYMPNT		;PICK UP POINTER TO SYMBOL
	CAME T,1(W1)		;VALUE IDENTICAL?
	JRST [	SUB T,1(W1)	;NO, COMPUTE DIFFERENCE
		JRST CPOPJ1]	;RETURN INEXACT
	PUSHJ P,SPT0		;YES, TYPE IT OUT
	MOVEI T,"#"
	PUSHJ P,TOUT		;TYPE # TO SHOW POSSIBLE AMBIGUITY
	JRST LOOKO3		;DOUBLE SKIP RETURN

LOOK4:	SETZM SYMPNT		;FORGET ANY OUTSIDE LOCAL SEEN
	JUMPGE F,CPOPJ		;RETURN 1 IF NO GOOD SYMBOLS FOUND
	SUB T,1(W1)		;SOMETHING FOUND, CALCULATE HOW FAR OFF
	JRST CPOPJ1		;RETURN 2, SOMETHING FOUND BUT NOT EXACT

LOOK5:	MOVE W2,1(R)		;GET VALUE FROM TABLE
	XOR W2,T		;COMPARE SIGNS
	JUMPL W2,LOOK3		;REJECT IF SIGNS DIFFERENT
	JUMPGE F,LOOK6		;TRANSFER IF NOTHING FOUND YET
	MOVE W,1(R)		;GET VALUE FROM TABLE
	SUB W,1(W1)		;COMPARE WITH BEST VALUE SO FAR
	JUMPLE W,LOOK3		;REJECT IF WORSE
LOOK6:	HRR W1,R		;SAVE AS BEST VALUES SO FAR
	TLO F,(1B0)		;SET FLAG SHOWING SOMETHING FOUND
	JUMPN W2,LOOK3		;IF NOT PERFECT, CONTINUE LOOKING
	HRLI W1,0		;FLAG GLOBAL OR PROGRAM LOCAL
	PUSHJ P,SYMCSI		;ADD TO SYMBOL CACHE
LOOKO4:	PUSHJ P,SPT0		;PERFECT, TYPE IT OUT
LOOKO3:	AOS (P)			;SKIP TWICE
	JRST CPOPJ1

;ADD SYMBOL TO SYMBOL CACHE

SYMCSI:	AOS W2,SYMCSP		;ROUND-ROBIN INSERT
	CAIL W2,NSYMCS		;WRAPAROUND?
	SETZB W2,SYMCSP		;YES
	MOVEM W1,SYMCSH(W2)	;STORE POINTER
	POPJ P,


;VERIFY CACHE IS NOW USEFUL, I.E. IT POINTS TO THE PROPER SYMBOL
;TABLE

CSHVER:	PUSHJ P,SYMSET		;GET CURRENT POINTERS
	CAMN R,OLDSYM		;SAME AS PREVIOUS?
	JRST CPOPJ1		;YES. GO USE IT
	MOVEM R,OLDSYM		;SAVE CURRENT SYMBOL POINTER
				; AND FALL THROUGH TO FLUSH CACHE
;CLEAR SYMBOL CACHE

CLRCSH:	MOVE TT1,[SYMCSH,,SYMCSH+1]
	SETZM -1(TT1)
	BLT TT1,SYMCSH+NSYMCS-1
	POPJ P,
CONSYM:	MOVEM T,LWT
   IFN FTFILE,<
	MOVEM T,POKER+1>	;STORE FOR /P/M LOGIC
	TRNN F,LF1
	JRST @SCH		;PIN OR FTOC
	TRNE F,CF1
	JRST  FTOC

PIN:	TLC T,700000		;PRINT INSTRUCTION
	TLCN T,700000
	JRST INOUT		;IN-OUT INSTRUCTION OR NEG NUM
	AND T,[XWD 777000,0]	;EXTRACT OPCODE BITS
	JUMPE T,HLFW		;TYPE AS HALF WORDS
   IFN FTDEC20,<
	TLNE T,(700B8)>		;NO BUILT-IN OPCODES .L. 100
	PUSHJ P,OPTYPE
   IFN FTDEC20,<
	TRNE F,ITF		;INSTRUCTION TYPED?
	JRST PFULI1		;YES
	MOVE T,LWT		;NO, GET WORD
	PUSHJ P,LOOK		;TRY FOR FULL WORD MATCH
	 JRST PFULI1		;NOT FOUND
	 JRST PFULI1		;CLOSE IS NOT GOOD ENOUGH
	POPJ P,			;FOUND AND PRINTED

PFULI1: >
	MOVSI T,777000
	AND T,LWT
	TRNE F,ITF		;HAS INSTRUCTION BEEN TYPED?
	JRST PIN2		;YES
	PUSHJ P,LOOK		;NO, LOOK IN SYMBOL TABLE
	 JRST HLFW		;NOTHING FOUND, OUTPUT AS HALFWORDS
	 JRST HLFW		;NO EXACT MATCH, OUTPUT AS HALFWORDS
PIN2:	  TRO F,NAF		;EXACT MATCH TYPED, ALLOW NEG ADDRESSES
	PUSHJ P,TSPC
	LDB T,[XWD 270400,LWT]	;GET AC FIELD
	JUMPE T,PI4
	HLRZ W,LWT
	CAIL W,(JRST)
	CAILE W,256777		;IS INST BETWEEN JRST AND XCT?
	JRST [	PUSHJ P,PAD	;NO, PRINT SYMBOLIC AC
		JRST PI3A]
	PUSHJ P,TOC		;YES, PRINT NUMERIC AC
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
   IFN FTDEC20,<
	MOVE W1,W		;GET COPY
	TRC W1,600
	TRNN W1,710		;IS INST TRXX OR TLXX?
	JRST [	PUSHJ P,TOC	;YES, PRINT ADDRESS NUMERIC
		JRST PI7]>	;END IFN FTDEC20
	CAIL W,240
	CAILE W,247
	JRST PI8		;ALL (EXCEPT ASH,ROT,LSH) HAVE SYMBOLIC ADRS
	TLNN W1,20
	CAIN W,<JFFO>_-33
	JRST PI8		;JFFO AND @ GET SYMBOLIC ADDRESSES
	PUSHJ P,PADS3A		;ONLY ABSOLUTE ADDRESSING FOR LSH, ASH, AND ROT
PI7:	TRZ F,NAF
	LDB R,[XWD 220400,LWT]	;INDEX REGISTER CHECK
	JUMPE R,CPOPJ		;EXIT
	MOVEI T,"("
	PUSHJ P,TOUT
	MOVE T,R
	PUSHJ P,PAD
	MOVEI T,")"
	JRST TOUT		;EXIT

PI8:	PUSHJ P,PAD
	JRST PI7
HLFW:	REPEAT 0,< MOVE T,LWT
	CAML T,[DDTINT SAVPI]
	CAMLE T,[DDTINT BNADR+2]
	SKIPA
	JRST PAD>
	HLRZ T,LWT		;PRINT AS HALF WORDS
	JUMPE T,HLFW1		;TYPE ONLY RIGHT ADR IF LEFT ADR=0
	TRO F,NAF		;ALLOW NEGATIVE ADDRESSES
	PUSHJ P,PAD
	MOVSI W1,(ASCII /,,/)
	PUSHJ P,TEXT2		;TYPE ,,
HLFW1:	HRRZ T,LWT

;PRINT ADDRESSES (ARG USUALLY 18 BITS BUT CAN BE 36 BITS)

PAD:	ANDI T,-1
	JRST @AR		;PADSO OR PAD1

PADSO:	JUMPE T,FP7B		;PRINT A ZERO
	PUSHJ P,LOOK
	 JRST PADS3		;NOTHING FOUND, TYPE NUMERIC
	 SKIPA W2,1(W1)	;SOMETHING FOUND, GET VALUE
	 POPJ P,		;EXACT MATCH FOUND AND TYPED
   IFN FTDEC20,<
	CAIGE T,1000>
   IFE FTDEC20,<
   IFE FTEXEC!FTFILE,<
	CAIGE T,100>		;IN USER MODE, PRINT NUMERIC IF SYMBOL OFF
   IFN FTEXEC!FTFILE,<
	CAIGE T,1000>		;  BY 100(8) OR MORE- 1000(8) FOR EXEC DDT OR FILDDT
   >
	CAIGE W2,60		;PRINT ADRS .LT. 60 NUMERICALLY
	JRST PADS3		;PRINT ADDRESS NUMERICALLY
	MOVE W2,TEM		;GET ORIGINAL QUANTITY
	CAIL W2,-100		;ADDRESS BETWEEN -100 AND -1?
	JRST PADS3		;YES, PRINT NUMERICALLY
	MOVEM T,TEM
	PUSHJ P,SPT0
	MOVEI T,"#"
	SKIPE SYMPNT		;SYMBOL IS OUTSIDE LOCAL?
	PUSHJ P,TOUT		;YES, FLAG
	MOVEI T,"+"
PADS1A:	PUSHJ P,TOUT
	HRRZ T,TEM
PAD1:	JRST TOC		;EXIT

PADS3:	MOVE T,TEM
PADS3A:	TRNE F,NAF
	CAIGE T,776000
	JRST TOC
PADS3B:	MOVNM T,TEM
	MOVEI T,"-"
	JRST PADS1A
INOUT:	TDC T,[XWD -1,400000]	;IO INSTRUCTION OR NEG NUM
	TDCN T,[XWD -1,400000]
	JRST PADS3B		;TYPE AS NEG NUM
	LDB R,[POINT 7,T,9]	;PICK OUT IO DEVICE BITS
	CAIL R,700_-2		;IF DEVICE .L. 700, THEN TYPE
	JRST HLFW		;TYPE AS HALF WORDS
	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
	MOVSI T,077400
	AND T,LWT
	JUMPE T,PI4
	PUSHJ P,LOOK		;LOOK FOR DEVICE NUMBER
	 JRST INOUT2		;NOTHING FOUND, PRINT AS OCTAL
	 JRST INOUT2		;NO EXACT MATCH, PRINT AS OCTAL
	 JRST PI3A		;EXACT MATCH TYPED
INOUT2:	MOVE T,TEM
	LSH T,-30
	PUSHJ P,TOC
	JRST PI3A

MASK:	TLNE F,(QF)
	JRST MASK1
   IFE FTFILE,<
	MOVEI T,MSK
MASK2:	MOVEI W,1
	MOVEM W,FRASE1
	JRST QUANIN
   >
   IFN FTFILE,<JRST ERR>
MASK1:	MOVEM T,MSK
	JRST RET
SUBTTL SEARCH LOGIC

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-DEN-1	;PREVENT TYPE OUT OF DDT PARTS
	SETCMM FRASE(T)
	AOBJN T,.-1
	MOVE T,ULIMIT
	TLNE F,(SAF)
	TLO F,(QF)		;SIMULATE A $Q TYPED
	PUSHJ P,SETUP
	PUSHJ P,CRF
SEAR1:	PUSHJ P,FETCH
   IFE FTDEC20,<
	JRST SEAR2B>
   IFN FTDEC20,<
	 JRST [	MOVEI R,777	;FETCH FAILED, BUMP TO NEXT PAGE
		IORB R,DEFV
		JRST SEAR2A]>	;CONTINUE SEARCH
	TLNE F,(LTF)		;CHECK FOR EFFECTIVE ADDRESS SEARCH
	JRST EFFEC0
	EQV T,WRD
	AND T,MSK
SEAR2G:	XCT SEAR2		;(JUMPE T, OR JUMPN T,) TO SEAR3 IF FOUND
SEAR2A:	AOS R,DEFV		;GET NEXT LOCATION
	TRNN R,777		;CHECK LISTEN ONLY ONCE PER PAGE
	PUSHJ P,LISTEN		;ANYTHING TYPED?
	 CAMLE R,ULIMIT		;OR END OF SEARCH?
	JRST SEARFN		;YES
	JRST SEAR1		;NO, LOOK SOME MORE

   IFE FTDEC20,<
SEAR2B:	MOVEI R,400000-1	;MOVE UP TO HI SEGMENT
	IORB R,DEFV		;PUT IN MEMORY TOO
	TRNN R,400000		;ALREADY IN HI SEGMENT?
	JRST SEAR2A>		;NO
SEARFN:	SETCMM LWT		;COMPLEMENT BITS BACK AND STOP SEARCH
	JRST DD1
SEAR3:	PUSHJ P,LISTEN		;ANY TYPEIN?
	 SKIPA			;NO
	JRST SEARFN		;YES, TERMINATE SEARCH
	MOVE R,DEFV
	PUSHJ P,FETCH
	JRST ERR
	TLZ F,(STF)		;GET RID OF SUPPRESS TYPEOUT MODE
	MOVE T,DEFV
	PUSHJ P,PSHLLC		;PUSH OLD LOCATION COUNTER
	PUSHJ P,LI1		;CALL REGISTER EXAMINATION LOGIC TO TYPE OUT
	PUSHJ P,CRF
	SETCMM LWT
	SETCMM TEM
SEAR4:	JRST  SEAR2A

EFFEC0:	MOVEI W,100
	MOVEM W,TEM
EFFEC1:	MOVE W,T
	LDB R,[POINT 4,T,17]	;GET IR FIELD
	JUMPE R,EFFEC2
	PUSHJ P,FETCH
	JRST ERR
	HRRZS T			;GET RID OF BITS IN LEFT IN ORDER
	ADDI T,(W)		;  PREVENT AROV WHEN ADDING ADDRESSES
EFFEC2:	HRR R,T
	TLNN W,20		;INDIRECT BIT CHECK
	JRST EFFEC3
	SOSE,TEM
	PUSHJ P,FETCH
	JRST SEAR4
	JRST EFFEC1
EFFEC3:	EQV T,WRD
	ANDI T,777777
	JRST SEAR2G
SETUP:	TLNN F,(QF)		;QUANTITY TYPED?
   IFE FTDEC20,<
	MOVEI T,777777>		;NO, DEFAULT HIGH ADR IS TOP OF MEMORY
   IFN FTDEC20,<
   IFN FTEXEC,<
	HRRZ T,.JBFF>		;DEFAULT UPPER LIMIT
   IFE FTEXEC,<
	MOVEI T,777777>>
	HRRZM T,ULIMIT		;SAVE LAST ADDRESS OF SEARCH
	HRRZS R,DEFV		;GET 1ST ADDRESS
	TLNN F,(FAF)		;WAS A 1ST ADR SPECIFIED?
	SETZB R,DEFV		;NO, MAKE IT ZERO
	CAMLE R,ULIMIT		;LIMITS IN A REASONABLE ORDER?
	JRST ERR		;NO
	POPJ P,			;YES, RETURN
ZERO:	TLNN F,(CCF)
	JRST ERR
	PUSHJ P,SETUP
	HRRZ S,@SYMP		;GET 1ST ADR OF SYMBOL TABLE
	HLRE W1,@SYMP		;GET LENGTH OF SYM TABLE
	SUB W1,S		;GET NEG OF LAST ADR
	MOVNS W1		;GET POS LAST ADR
	MOVEI T,0		;0 TO STORE IN MEMORY
ZERO1:	TRNN R,777760
	JRST ZEROR		;OK TO ZERO AC'S
   IFE FTDEC20,<
   IFN FTEXEC,<
	SKPUSR
   >
   IFN FTEXEC!FTFILE,<
	JRST [	CAIGE R,XZLOW
		MOVEI R,XZLOW	;IN EXEC MODE, DON'T ZERO 20-40
		JRST ZERO3 ] >
   >
   IFE FTFILE,<
	CAIGE R,ZLOW
	MOVEI R,ZLOW		;DON'T ZERO 20 THRU ZLOW
ZERO3:	CAIL R,DDTX
	CAILE R,DDTEND
	JRST .+2
	MOVEI R,DDTEND		;DON'T ZERO DDT
   IFE FTDEC20,<
	CAML R,S
	CAMLE R,W1>
	JRST .+2
	HRRZ R,W1		;DON'T ZERO SYMBOL TABLE
   >
   IFN FTFILE,<
ZERO3:>
ZEROR:	CAMLE R,ULIMIT		;ABOVE LIMITS?
	JRST DD1		;YES, STOP
	PUSHJ P,DEPMEM		;DEPOSIT T
   IFE FTFILE,<
	 TROA R,377777		;
	AOJA R,ZERO1
	TRNN R,400000		;HI SEGMENT?
	AOJA R,ZERO1		;NO, KEEP GOING
   >
	JRST DD1		;FINISH
   IFN FTFILE,<AOJA R,ZERO1>
SUBTTL OUTPUT SUBROUTINES

FTOC:				;NUMERIC OUTPUT SUBROUTINE
TOC:	HRRZ W1,ODF
	CAIN W1,10		;IS OUPUT RADIX NOT OCTAL, OR
	TLNN T,-1		;ARE THERE  NO LEFT HALF BITS?
	JRST TOCA		;YES, DO NOTHING SPECIAL
	HRRM T,TOCS		;NO, TYPE AS HALF WORD CONSTANT
	HLRZS T			;GET LEFT HALF
	PUSHJ P,TOC0		;TYPE LEFT HALF
	MOVSI W1,(ASCII /,,/)
	PUSHJ P,TEXT2		;TYPE ,,
	XCT TOCS		;GET RIGHT HALF BACK
TOCA:	HRRZ W1,ODF		;IS OUTPUT RADIX DECIMAL?
	CAIN W1,12
	JRST TOC4		;YES,TYPE SIGNED WITH PERIOD
TOC0:	LSHC T,-43
	LSH W1,-1		;W1=T+1
	DIVI T,@ODF
	HRLM W1,0(P)
	SKIPE T
	PUSHJ P,TOC0
	HLRZ T,0(P)
	ADDI T,"0"
	CAIL T,72		;IS DIGIT .GT. 9 (I.E., HEX)
	ADDI T,7		;YES, TYPE APPROPRIATE LETTER
	JRST TOUT

TOC4:	MOVE A,T		;TYPE AS SIGNED DECIMAL INTEGER
	JUMPGE T,TOC5
	MOVEI T,"-"
	PUSHJ P,TOUT
TOC5:	PUSHJ P,FP7		;DECIMAL PRINT ROUTINE
TOC6:	MOVEI T,"."
	JRST TOUT

;SYMBOL OUTPUT SUBROUTINE

SPT0:	HRRZM W1,SPSAV		;SAVE POINTER TO TYPED SYM
SPT:				;RADIX 50 SYMBOL PRINT
	LDB T,[POINT 32,0(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
	MOVEI T,256
	JRST TOUT
SYMD:				;$D ;DELETE LAST SYM & PRINT NEW
	HRRZ R,SPSAV		;PICK UP POINTER TO LAST SYM
	JUMPE R,ERR
	MOVE T,(R)		;PICK UP SYMBOL
	TLO T,(DELO)		;TURN ON "SUPPRESS OUTPUT" BIT
	PUSHJ P,DSYMER		;STORE BACK IN SYMBOL TABLE
	MOVE T,LWT
	JRST CONSYM		;PRINT OUT NEXT BEST SYMBOL
;FLOATING POINT OUTPUT

TFLOT:	MOVE A,T
	JUMPGE A, TFLOT1
	MOVNS A
	JFCL			;PREVENT OVERFLOW MESSAGE
				; FROM FORTRAN PROGRAMS
	MOVEI T,"-"
	PUSHJ P,TOUT
	TLZE A,400000
	JRST FP1A
TFLOT1:	TLNN A, 400
	JRST TOC5		;IF UNNORMALIZED, TYPE AS DECIMAL INTEGER

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)
	SETZM TEM1		;INIT 8 DIGIT COUNTER
	SKIPE A,B		;DON'T TYPE A LEADING 0
	PUSHJ P,FP7		;PRINT INTEGER PART OF 8 DIGITS
	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,W2		;SAVE EXPONENT
	PUSH P,FSGN(B)		;SAVE "E+" OR "E-"
	PUSHJ P,FP3		;PRINT OUT FFF.FFF PART OF NUMBER
	POP P,W1		;GET "E+" OR "E-" BACK
	PUSHJ P,TEXT
	POP P,A			;GET EXPONENT BACK
FP7:	IDIVI A,12		;DECIMAL OUTPUT SUBROUTINE
	MOVMS B			;MAKE POSITIVE
	AOS TEM1
	HRLM B,(P)
	JUMPE A,FP7A1
	PUSHJ P,FP7

FP7A1:	HLRZ T,(P)
FP7B:	ADDI T,260
	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)
	Z FT0(C)

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		;7 BIT ASCII TEXT OUTPUT SUBROUTINE
	LSHC T,7
	PUSHJ P,TOUT
	JUMPN W1,TEXT2
	POPJ P,

R50PNT:	LSH T,-36		;RADIX 50 SYMBOL PRINTER
	TRZ T,3
	PUSHJ P,TOC
	PUSHJ P,TSPC
	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,

CRN:	MOVEI T,15		;CARRIAGE RETURN
	JRST TOUT


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

LCT: IFE FTDEC20,<
	MOVEI T,11
   IFN FTEXEC,<
	SKPEXC >
	JRST TOUT>		;IN USER MODE, TYPE A TAB
   IFN FTEXEC!FTDEC20,<
	PUSHJ P,TSPC
	PUSHJ P,TSPC >

TSPC:	MOVEI T,40		;SPACE
	JRST TOUT
BITO:	MOVEI R,BITT		;BYTE OUTPUT SUBROUTINE
	SKIPN OLDAR
	MOVEM AR,OLDAR
	HRRZI AR,TOC
	TRZN F,Q2F
	JRST ERR
	MOVE T,WRD2
	MOVEM T,SVBTS
	MOVEI T,^D36
	IDIV T,WRD2
	SKIPE T+1
	ADDI T,1
	MOVEM T,SVBTS2
	HRRZ SCH,R
	JRST BASE1O

BITT:	MOVE T,SVBTS2
	MOVEM T,SVBT2
	MOVE T+1,LWT
	MOVEM T+1,SVBT3
	PUSH P,LWT
BITT2:	MOVEI T,0
	MOVE T+2,SVBTS
	LSHC T,(T+2)
	MOVEM T,LWT
	MOVEM T+1,SVBT3
	CAIE AR,PADSO
	PUSHJ P,TOCA
	CAIE AR,TOC
	PUSHJ P,PIN
	SOSG SVBT2
	JRST BITT4
	MOVEI T,","
	PUSHJ P,TOUT
	MOVE T+1,SVBT3
	JRST BITT2

BITT4:	POP P,LWT
	POPJ P,
SUBTTL PUNCH PAPER TAPE LOGIC

   IFN FTPTP,<IFN FTEXEC,<


PUNCH:	SKPEXC
	JRST ERR		;PAPER TAPE STUFF ILLEGAL IN USER MODE
	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,4		;PUNCH 4 FEED HOLES
	PUSHJ P,FEED
	TLNE F,(CF)		;PUNCH NON-ZERO BLOCKS?
	JRST PUNZ		;YES
	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			;INIT CHECKSUM
	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
;PUNCH NON-ZERO BLOCKS

PUNZ0:	AOS DEFV		;LOOK AT NEXT WORD
PUNZ:	HRRZ W,DEFV		;ENTER HERE - GET STARTING ADDRESS
	MOVE R,W
	SUB W,TEM1		;CALCULATE NEGATIVE LENGTH
	HRL R,W			;SET UP AOBJN POINTER
	JUMPGE R,RET		;FINISHED?
	CAMG R,[XWD -40,0]	;BLOCK LONGER THAN 40?
	HRLI R,-40		;YES, FIX IT UP
	MOVSI W1,400000		;W1 NEGATIVE MEANS FLUSH 0 WORDS
PUNZ2:	PUSHJ P,FETCH		;GET WORD FROM MEMORY
	JRST ERR
	JUMPE T,[AOJA W1,PUNZ4]	;IF WORD IS 0, INDEX 0 WORD COUNTER
	MOVEI W1,0		;CLEAR 0 WORD COUNTER
PUNZ4:	JUMPL W1,PUNZ0		;FLUSH 0 WORD, GET ANOTHER
	CAIL W1,3		; NOSKIP FOR 3RD 0 WORD AFTER NON 0 WORD
	AOSA R			;ADVANCE R TO LAST ADR+1
	AOBJN R,PUNZ2
	ADD W1,DEFV		;CALCULATE DEFV-R+W1=-WORD COUNT
	SUB W1,R
	HRLM W1,DEFV		;PUT -WC IN LEFT HALF OF FA
	EXCH R,DEFV		;SAVE ADR FOR NEXT BLOCK, GET POINTER
	JRST PBLK
LOADER:	SKPUSR
	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,20
LOAD2:	PUSHJ P,FEED
	JRST RET

BLKEND:	SKPEXC
	JRST ERR
	TLNN F,(QF)		;BLOCK END
	MOVE T,[JRST 4,DDT]
	TLNN T,777000		;INSERT JRST IF NO OPCODE
	TLO T,(JRST)
	PUSH P,T
	MOVEI T,20
	PUSHJ P,FEED
	POP P,T
	PUSHJ P,PWRD
	PUSHJ P,PWRD		;EXTRA WORD FOR READER TO STOP ON
	MOVEI T,400
	JRST LOAD2

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

FEED:	CONSZ PTP,20
	JRST .-1
	CONO PTP,10
	DATAO PTP,FEED1
	SOJN T,FEED
FEED1:	POPJ P,0		;ADDRESS USED AS A CONSTANT
LOADB:

PHASE 0				;RIM10B CHECKSUM LOADER
	XWD -16,0
BEG:	CONO PTR,60
	HRRI AA,RD+1
RD:	CONSO PTR,10
	JRST .-1
	DATAI PTR,@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
   >>				;END OF IFN FTPTP
	;FOR PAPER TAPE IO
SUBTTL TELETYPE IO LOGIC

   IFN FTEXEC,<			;EXECUTIVE MODE TELETYPE I/O

	DTE==200
	DTEII=142		;DTE20 INTERRUPT INST
	DTEUNS=143		;UNUSED
	DTEEPW=144		;EXAMINE PROTECTION WORD
	DTEERW=145		;EXAMINE RELOCATION WORD
	DTEDPW=146		;DEPOSIT PROTECTION WORD
	DTEDRW=147		;DEPOSIT RELOCATION WORD
	DTEFLG=444
	DTEF11=450
	DTECMD=451
	DTEMTD=455
	DTEMTI=456
	.DTMTO==10B27
	.DTMMC==11B27
	.DTNMC==12B27

	DTEN==4			;MAX NUMBER OF DTE'S
	TO11DB==1B22		;TO 11 DOORBELL
	CL11PT==1B26		;CLEAR TO 10 DOORBELL
	PI0ENB==1B32		;PI CHANNEL 0 ENABLE
	PIENB==1B31		;ENABLE PI SETTING
	DTEPRV==1B20		;RESTRICTED BIT
;APR INTERNAL CLOCK SERVICE

;CONI/CONO MTR,

MTR==024			;DEVICE CODE

MTRLOD==1B18			;LOAD  BITS 21-23
;	19-20			;UNUSED, MBZ
MTREPA==1B21			;ENABLE EXEC PI ACCOUNTING
MTRENA==1B22			;ENABLE EXEC NON-PI ACCOUNTING
MTRAMN==1B23			;ACCOUNTING METERS ON
MTRTBF==1B24			;TIME BASE OFF
MTRTBN==1B25			;TIME BASE ON
MTRCTB==1B26			;CLEAR TIME BASE
;	27-32			;UNUSED, MBZ
MTRPIA==7B35			;PI ASSIGNMENT

;CONI/CONO TIM

TIM==020			;DEVICE ASSIGNMENT

TIMCIC==1B18			;CLEAR INTERVAL COUNTER
;	19-20			;UNUSED, MBZ
TIMITO==1B21			;INTERVAL TIMER ON
TIMDON==1B22			;DONE/CLEAR DONE
TIMICO==1B23			;COUNTER OVERFLOW
;GET TYPEIN CHARACTER - EXEC MODE

XTIN:	PUSHJ P,XLISTE		;TELETYPE CHARACTER INPUT
	 JRST .-1
	JUMPE T,XTIN		;FILTER NULLS
	CAIE T,175
	CAIN T,176
	MOVEI T,33		;CHANGE ALL ALT MODES TO NEW
   IFN FTDEC20&<^-FTEDIT>,<	;IF NO FANCY EDITING...
	CAIE T,"U"-100		;^U?
	CAIN T,177		;RUBOUT?
	JRST WRONG		;YES, TYPE XXX
   >
   IFE FTDEC20&<^-FTEDIT>,<	;IF FANCY EDITING...
	CAIE T,177		;DON'T ECHO EDIT CHARACTERS
	CAIN T,"U"-100
	JRST XTIN1
	CAIE T,"R"-100
	CAIN T,"W"-100
	JRST XTIN1>
	CAIN T,15		;CR?
	JRST [	MOVEI T,12	;YES, PRESET LF FOR NEXT TIME
		MOVEM T,XNXTCH
		MOVEI T,15	;ECHO AND RETURN CR NOW
		JRST .+1]
	SKIPN TEXINF		;DON'T ECHO TAB UNLESS TEXT INPUT
	CAIE T,11
	PUSHJ P,ECHO		;ECHO THE CHAR
XTIN1:	POPJ P,

;TYPEOUT CHARACTER FROM T

XTOUT:	SKPNKL			;KL10?
	JRST KLXTYO		;YES
	HRLM T,(P)
	IMULI T,200401		;GENERATE PARITY
	AND T,[11111111]
	IMUL T,[11111111]
	HLR T,(P)
	TLNE T,10
	TRC T,200		;MAKE PARITY EVEN
	CONSZ TTY,20
	JRST .-1
	DATAO TTY,T
	ANDI T,177		;FLUSH PARITY
	POPJ P,0

KLXTYO:	SKIPE SMFLAG		;IS THIS A SM10?
	JRST SMXTYO		;YES
	PUSHJ P,EBRIDX		;GET INDEX OF EPR IN TT2
	MOVEI T,.DTMTO(T)	;GET MONITOR OUTPUT COMMAND AND CHAR IN T
	MOVEM T,DTECMD(TT2)	;PUT IN COMMAND WORD
	SETZM DTEMTD(TT2)	;CLEAR DONE FLAG.
	XCT DING11		;RING THE DOORBELL
	SKIPN DTEMTD(TT2)	;DONE YET?
	JRST .-1		;NO, LOOP
	ANDI T,377		;CLEAN UP CHARACTER IN T
	POPJ P,0		;RETURN
;SKIP IF HAVE INPUT CHAR AND RETURN IT IN T

XLISTE:	SKIPE T,XNXTCH		;PRESET CHAR?
	JRST [	SETZM XNXTCH	;YES, RETURN IT ONCE
		JRST XLIST1]
   IFN FTYANK,<
	SKIPE COMAND		;COMAND FILE?
	JRST XPTRIN		;YES, READ IT
   >
	SKPNKL
	JRST KLXLIS		;DO KL10 INPUT
	CONSO TTY,40		;NO, LISTEN FOR TTY
	POPJ P,
	DATAI TTY,T
XLIST1:	ANDI T,177
	JRST CPOPJ1

KLXLIS:	SKIPE SMFLAG		;IS THIS AN KS10?
	JRST SMXLIS		;YES.
	PUSHJ P,EBRIDX		;GET EPT INDEX IN TT2
	SKIPN DTEMTI(TT2)	;ANY INPUT YET?
	POPJ P,			;NO
	MOVE T,DTEF11(TT2)	;GET IT
	SETZM DTEMTI(TT2)	;YES
	JRST XLIST1
;SAVE USER STATUS ('RETURN' TO DDT)

XTTYRE:	SKPNKL
	JRST LTTYRE		;DO KL10 SAVE STATUS
	SKIPE SAVTTY		;ALREADY HAVE IT?
	JRST TTY1		;YES
	CONI TTY,SAVTTY	;SAVE PI ASSMT
	CONO TTY,0		;SET PI ASSMT TO 0
	MOVSI W2,(1000000)
	CONSZ TTY,120		;WAIT FOR PREVIOUS ACTIVITY TO FINISH
	SOJG W2,.-1		;BUT DON'T WAIT FOREVER
	CONI TTY,W2		;UPDATE STATUS BITS
	DPB W2,[POINT 15,SAVTTY,32]
	DATAI TTY,W2
	HRLM W2,SAVTTY
TTY1:	CONO TTY,3410		;INIT TTY FOR DDT
	POPJ P,

;RESTORE USER STATUS ('LEAVE' DDT)

XTTYLE:	SKPNKL
	JRST LTTYLE		;DO KL10 RESTORE STATUS
	CONSZ TTY,120		;WAIT FOR LAST OUTPUT
	JRST .-1
	CONO TTY,1200		;CLEAR DONE FLAGS
	MOVE T,SAVTTY
	CONO TTY,0(T)		;RESTORE USER STATE
	SETZM SAVTTY		;NOTE USER STATE NOW IN EFFECT
	POPJ P,
;ROUTINES TO SAVE AND RESTORE KL10 TTY STATUS
; WHICH AMOUNTS TO SAVING AND RESTORING DTE INTERRUPT 
; INSTRUCTION IN LOCATION DTEII

LTTYLE:	SKIPE SMFLAG		;IS THIS A KS10?
	JRST SMTTLE		;YES.
	MOVE T,MSTRDT		;GET ID OF MASTER DTE
	LSH T,3			;FIND EPT CHUNK
	MOVE W2,SAVEBR		;THE OLD EBR
	LSH W2,^D9		;MAKE IT A CORE ADDRESS
	ADDI W2,0(T)		;POINT TO BEGINNING OF EPT CHUNK
	MOVEI T,DTEII(W2)	;WHERE TO DO RESTORE
	HRLI T,SAVTTY		;WHERE TO RESTORE FROM
	BLT T,DTEDRW(W2)	;UP THROUGH DEPOSIT, LAST WORD
	HRRZ T,MTRCNI		;GET SAVED MTR CONI
	CONO MTR,MTRLOD(T)	;RESTORE ALL STATES
	HRRZ T,TIMCNI		;GET SAVED TIM CONI
	TRZ T,TIMDON+TIMICO	;FLUSH CONI-ONLY BITS
	CONO TIM,0(T)		;RESTORE STATE
	SETZM SAVTTY		;NOTE PGM MODES NOW IN EFFECT
	CONSZ PAG,TRPENB	;IS PAGING NOW ENABLED?
	SKIPN DTEEPW(W2)	;YES SECONDARY PROTOCOL IN EFFECT,
	POPJ P,			;JUST RETURN, DON'T TURN IT OFF
	MOVEI T,.DTNMC		;WE WERE IN REGULAR PROTOCOL, SETUP OFF COMMAND
	JRST DTEDCM		;DO COMMAND
;CODE TO SAVE TTY STATE (I.E. THE DTE STATE FOR THE MASTER -11)

LTTYRE:	SKIPE SMFLAG		;IS THIS A KS10?
	JRST SMTTRE		;YES
	SKIPE SAVTTY		;PGM MODES IN EFFECT?
	JRST LTTYR1		;NO, DON'T SAVE
	CONI MTR,MTRCNI		;SAVE MTR STATE
	CONI TIM,TIMCNI		;SAVE TIM STATE
	CONI PAG,T		;READ EBR
	ANDI T,017777
	CONSO PAG,TRPENB	;PAGING ON NOW?
	JRST LTTYR0		;NO. EBR IS BOTH PHYSICAL AND VIRTUAL
	MOVEI W1,0		;YES. MUST SCAN MAP FOR VIRTUAL ADDRESS
	LSH T,^D9		;MAKE THIS A PHYSCIAL ADDRESS
LTTYR5:	MAP W2,0(W1)		;GET PHYSICAL ADDRESS
	TLNN W2,(1B2)		;ACCESSIBLE?
	JRST LTTYR6		;NO. SKIP THIS PAGE
	AND W2,[37777777]	;GET PHYSICAL ADDRESS
	CAMN W2,T		;IS THIS ONE THE EBR?
	JRST [	MOVE T,W1	;YES. GET VIRTUAL ADDRESS
		LSH T,-^D9	;MAKE IT A PAGE
		JRST LTTYR0]	;AND DONE
LTTYR6:	ADDI W1,1000		;NEXT PAGE
	CAIG W1,777777		;SCANNED ENTIRE SECTION?
	JRST LTTYR5		;NO. LOOK AT SOME MORE PAGES
	HALT .			;YES. CAN'T FIND EPT.
LTTYR0:	MOVEM T,SAVEBR		;SAVE EPT VIRTUAL ADDRESS
	MOVSI T,-DTEN		;POLL ALL DTES
	MOVE W2,[CONSO DTE,DTEPRV] ;GET TEST WORD
	MOVE W1,[CONSO DTE,PI0ENB+7] ;TEST FOR PI0 ENABLED
				;   OR PI ASSIGNMENT UP
	MOVE W,[CONO DTE,0]	;PROTOTYPE CONO
LTTYR2:	XCT W1			;PI 0 UP ON THIS GUY?
	JRST [	HRRI W,PIENB+PI0ENB ;NO. SET PI0
		XCT W
		XCT W1		;NOW UP?
		JRST LTTYR4	;NO. DOESN'T EXIST THEN
		TRZ W,PI0ENB	;TURN OFF ZERO
		XCT W		;DO IT
		JRST .+1]	;AND PROCEED
	XCT W2			;THIS THE MASTER?
	JRST [	MOVEI T,0(T)	;YES. GET ITS NUMBER
		MOVEM T,MSTRDT	;SAVE IT
		LSH T,^D<35-9>	;POSITION CODE IN B9
		ADD T,[CONO DTE,TO11DB] ;GET THE INSTRUCTION
		MOVEM T,DING11	;SAVE IT
		JRST LTTYR3]	;AND DONE
LTTYR4:	ADD W2,[1B9]		;NEXT DTE
	ADD W,[1B9]
	ADD W1,[1B9]		;ADJUST ALL I/O INSTRUCTIONS
	AOBJN T,LTTYR2		;POLL ALL OF THEM
	HALT .			;CAN'T HAPPEN!!!!!!!!!!!!!
LTTYR3:	MOVE T,SAVEBR		;GET EBR AGAIN
	LSH T,^D9		;MAKE IT A CORE ADDRESS
	MOVE W2,MSTRDT		;GET MASTER'S NUMBER
	LSH W2,3		;HIS CHUNK
	ADD T,W2		;THE POSITION IN THE EPT
	MOVE W2,T		;SAVE EBR FOR INDEXING
	MOVSI T,DTEII(T)	;START OF EPT LOCATIONS TO SAVE
	HRRI T,SAVTTY		;WHERE TO SAVE THEM
	BLT T,SAVDRW
	SKIPN DTEEPW(W2)	;USING PRIMARY PROTOCAL?
	JRST LTTYR1		;NO. GO ON
	MOVE T,MSTRDT		;GET MASTER'S ID
	LSH T,^D<35-9>		;POSITION CODE IN B9
	ADD T,[CONSZ DTE,TO11DB] ;GET TEST INSTRUCTION
	XCT T			;WAIT FOR -11 TO ANSWER ALL DOORBELLS
	JRST .-1		;THE WAIT
LTTYR1:	CONO MTR,MTRLOD+MTRTBF	;TURN OFF ALL METERS AND TIME BASE
	CONO TIM,0		;TURN OFF INTERVAL TIMER
	MOVSI T,(HALT)
	MOVEM T,DTEII(W2)	;NO INTERRUPTS
	SETZM DTEEPW(W2)	;CLEAR EXAMINE PROTECTION WORD
	MOVEI T,.DTMMC		;TURN ON SECONDARY TTY I/O SYSTEM
DTEDCM:	PUSHJ P,EBRIDX		;GET EPT INDEX IN TT2
	SETZM DTEFLG(TT2)	;CLEAR DONE FLAG
	MOVEM T,DTECMD(TT2)	;STORE COMMAND FOR 11
	XCT DING11		;RING HIS DOORBELL
	SKIPN DTEFLG(TT2)	;WAIT FOR FINISH
	JRST .-1
	POPJ P,			;RETURN

;ROUTINE TO LOAD EPT ADDRESS IN TT2. CALLED BY ROUTINES WISHING
;TO LOCATE THE MONITOR PROTOCOL LOCATIONS

EBRIDX:	MOVE TT2,SAVEBR		;GET EBR ADDRSSS
	LSH TT2,^D9		;MAKE IT A CORE ADDRESS
	POPJ P,			;AND DONE
   >				;END IFN FTEXEC
;TELETYPE OUTPUT - COMMON START POINT

TOUT:	SETZM CHINP		;RESET INPUT LINE
	SETZM CHINC
ECHO:	PUSH P,T		;SAVE ORIG CHAR
	CAIN T,33		;CONVERT ESC
	JRST [	MOVEI T,"$"
		JRST ECHO1]
	CAIE T,15		;CR OR LF?
	CAIN T,12
	JRST ECHO1		;YES, NO CONVERSION
	CAIN T,"G"-100		;BELL?
	JRST ECHO1		;NO CONVERSION
	CAIN T,11		;TAB?
   IFE FTEXEC,<
	JRST ECHO1>		;NO CONVERSION OF TAB IN USER MODE
   IFN FTEXEC,<
	JRST [	SKPEXC
		JRST ECHO1	;DITTO
		MOVEI T," "	;CONVERT TAB TO SPACES IN EXEC MODE
		PUSHJ P,TOUT0
		MOVEI T," "
		PUSHJ P,TOUT0
		MOVEI T," "
		JRST ECHO1]
   >				;END FTEXEC
	CAIL T,40		;CONTROL CHAR?
	JRST ECHO1		;NO
	MOVEI T,"^"		;YES, INDICATE
	PUSHJ P,TOUT0
	MOVE T,0(P)		;RECOVER ORIG CHAR
	ADDI T,100		;CONVERT TO PRINTING EQUIVALENT
ECHO1:	PUSHJ P,TOUT0		;DO DEVICE-DEPENDENT OUTPUT
	POP P,T
	POPJ P,

   IFE FTDEC20,<
OPDEF TTCALL [51B8]

TOUT0:
   IFN FTEXEC,< SKPUSR
	JRST XTOUT >
   IFN FTFILE,< SKIPE COMAND	;IS THERE A COMMAND FILE?
	JRST PUTCHR>		;YES 

	TTCALL 1,T		;OUTPUT A CHARACTER
	POPJ P,
>
IFN FTEXEC,<
;KS10 TELETYPE DRIVER

;IO INSTRUCTIONS
	OPDEF RDTIME [702200,,0]
	OPDEF WRTIME [702600,,0]
	OPDEF TIOE [710B8]
	OPDEF TION [711B8]
	OPDEF RDIO [712B8]
	OPDEF WRIO [713B8]
	OPDEF BSIO [714B8]
	OPDEF BCIO [715B8]
	OPDEF TIOEB [720B8]
	OPDEF TIONB [721B8]
	OPDEF RDIOB [722B8]
	OPDEF WRIOB [723B8]
	OPDEF BSIOB [724B8]
	OPDEF BCIOB [725B8]


;UNIBTS BIT NUMBERS
EBIT0=1
EBIT1=2
EBIT2=4
EBIT3=10
EBIT4=20
EBIT5=40
EBIT6=100
EBIT7=200
EBIT8=400
EBIT9=1000
EBIT10=2000
EBIT11=4000
EBIT12=10000
EBIT13=20000
EBIT14=40000
EBIT15=100000


;CTY DEFINITIONS FOR KS10

CTYIWD=32		;CTY INPUT WORD
CTYIRD=400		;INPUT READY FLAG
CTYOWD=33		;CTY OUTPUT WORD
CTYORD=400		;OUTPUT READY

INT80=1B25!1B23!3B35	;INTERRUPT 8080
;SUBROUTINE TO TYPE ON CTY
;CALL WITH:
;	T/ BYTE TO TYPE
;RETURNS WITH T UNCHANGED AND TT2 WIPED

SMXTYO:	MOVE TT2,CTYOWD		;OUTPUT WORD
	TRNE TT2,CTYORD		;OUTPUT READY?
	CONO 0,INT80		;INTERRUPT 8080
SMXTOR:	MOVE TT2,CTYOWD		;OUTPUT WORD
	TRNE TT2,CTYORD		;OUTPUT READY?
	JRST SMXTOR		;NO WAIT
	IORI T,CTYORD
	MOVEM T,CTYOWD		;STORE OUTPUT CHARACTER
	CONO 0,INT80		;INTERRUPT 8080
	POPJ P,0		;RETURN

;SUBROUTINE TO RREAD A BYTE FROM THE CTY
;CALL WITH:
;	PUSHJ P,SMXLIS
;	RETURN HERE IF NO DATA THERE
;	RETURN HERE WITH BYTE IN T2
;
SMXLIS:	MOVE T,CTYIWD		;PICK UP INPUT WORD
	TRNN T,CTYIRD		;CHECK FOR INPUT READY
	POPJ P,0		;NO RETURN -- NO CHARACTER FOUND
	SETZM CTYIWD	
	CONO 0,INT80		;INTERRUPT 8080
	ANDI T,177		;MASK TO 7 BITS
	JRST CPOPJ1		;YES CHARACTER FOUND RETURN +2
;SUBROUTINE TO REMBER TTY STATE

SMTTRE:	RDTIME MTRCNI		;SAVE TIMEBASE
	MOVE T,31		;GET KEEP ALIVE STATE
	MOVEM T,MSTRDT		;USE MASTER DTE LOCATION
	TLZ T,10000		;STOP KEEP ALIVE
	MOVEM T,31		;RESTORE
	POPJ P,0		;RETURN

;SUBROUTINE TO RESTORE TTY STATE

SMTTLE:	MOVEI T1,1000		;RESET CLOCK
	ADDM T1,MTRCNI+1
	WRTIME MTRCNI		;RE-WRITE TIMEBASE
	MOVE T1,MSTRDT		;GET KEEP ALIVE
	MOVEM T1,31
	POPJ P,0
>		;END IFN FTEXEC
   IFE FTDEC20,<
LISTEN:
   IFN FTEXEC,< SKPUSR
	JRST XLISTE >
   IFE FTFILE,<
   IFN FTYANK,<
	SKIPE COMAND
	JRST PTRIN>>
   IFN FTFILE,<			;FILDDT?
	SKIPE COMAND		;STILL READING COMAND FILE?
	POPJ P,0		; IF YES, DO NOT LOOK FOR INPUT
				; 1. SPEED UP FILDDT AND
				; 2. ALLOW USER TO TYPE AHEAD
				;  (ONE CONTROL C)
   >
	SOSLE LCNT		;TIME TO DO TTCALL
	POPJ P,0		;NO--RETURN
	MOVEI T,12		;YES--RESET COUNT
	MOVEM T,LCNT		; ..
	TTCALL 2,T		;GET NEXT CHAR, NO IO WAIT
	POPJ P,			;NO CHARACTER EXISTED, RETURN
	JRST CPOPJ1		;CHARACTER WAS THERE, SKIP RETURN

   IFN FTEXEC,<
TTYRET:	SKPUSR
	JRST XTTYRET
	POPJ P, >
   IFE FTEXEC,<TTYRET==CPOPJ>

TTYCLR:
   IFN FTEXEC,< SKPEXC >
	TTCALL 14,		;CLEAR ^O, SKIP ON INPUT CHARS
	 POPJ P,		;NO INPUT CHARS, OR EXEC MODE
	TTCALL 11,		;FLUSH ALL
	PUSHJ P,LISTEN
	 JFCL
	POPJ P,			;WAITING INPUT CHARACTERS

   IFN FTEXEC,<
TTYLEV:	SKPUSR
	JRST XTTYLEV
	POPJ P, >

   IFE FTEXEC,<TTYLEV==CPOPJ>

   >				;END IFE FTDEC20
TEXIN:	AOSA TEXINF		;NOTE TEXT INPUT
TIN:	SETZM TEXINF		;NOTE NOT TEXT INPUT
   IFN FTDEC20&FTEXEC&<^-FTEDIT>,<
	SKPUSR			;EXEC MODE?
	JRST XTIN>		;YES, SIMPLE INPUT
TIN1:	SOSGE CHINC		;CHARACTER LEFT IN LINE BUFFER?
	JRST CHIN1		;NO, GO REFILL BUFFER
	ILDB T,CHINP		;GET CHARACTER
	POPJ P,

;REFILL LINE BUFFER WITH EDITING

   IFN FTDEC20,<
CHIN1:
   IFN FTEXEC&FTEDIT,<
	SKPUSR			;EXEC MODE?
	JRST XCHIN1>		;YES, USE SIMULATION ROUTINES
	SKIPE T1,CHINP		;REINIT LINE?
	JRST CHIN2		;NO
	MOVEI T1,NLINBF*5	;YES, SETUP MAX CHAR COUNT
	MOVEM T1,LINSPC
	MOVE T1,LINBP		;SETUP POINTER
	MOVEM T1,CHINP
CHIN2:	MOVEM T1,TEXTIB+.RDBKL	;SET BACKUP LIMIT
	SKIPG LINSPC		;ROOM LEFT IN BUFFER?
	JRST ERR		;NO, TOO MUCH TYPIN
	SETZ T1,
	SKIPE WAKALL		;WAKEUP ON EVERYTHING?
	MOVEI T1,ONES4		;YES, USE WAKEUP TABLE
	MOVEM T1,ETXTB
	PUSH P,LINSPC		;SAVE CURRENT SPACE
	PUSH P,CHINP		;AND POINTER
	SKIPN TEXINF		;TEXT INPUT?
	PUSHJ P,TTYTOF		;NO, SUPPRESS TAB ECHO
	MOVEI T1,TEXTIB		;POINT TO ARG BLOCK
	TEXTI			;INPUT TO NEXT BREAK CHAR
	 JRST ERR		;BAD ARGS (IMPOSSIBLE)
	PUSHJ P,TTYTON		;RESTORE NORMAL TAB ECHO
	POP P,CHINP		;RESTORE POINTER TO CHARS JUST TYPED
	MOVE T1,TEXTIB+.RDFLG	;GET FLAGS
	TXNE T1,RD%BFE+RD%BLR	;DELETIONS?
	JRST CHIN3		;YES
	POP P,T1		;RECOVER OLD SPACE COUNT
	SUB T1,LINSPC		;COMPUTE NUMBER CHARS JUST TYPED
	MOVEM T1,CHINC		;SETUP COUNT
	JRST TIN1		;GO RETURN NEXT CHAR
;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE
;LINE MUST BE REPROCESSED FROM BEGINNING.  POSSIBLY ALL TEXT HAS BEEN
;DELETED.

CHIN3:	MOVEI T1,NLINBF*5	;COMPUTE NUMBER CHARS NOW IN LINE
	SUB T1,LINSPC
	JUMPE T1,WRONG		;JUMP IF WHOLE LINE DELETED
	MOVEM T1,CHINC		;LINE NOT NULL, SETUP CHAR COUNT
	MOVE T1,LINBP		;REINIT POINTER
	MOVEM T1,CHINP
	JRST DD2		;CLEAR WORLD AND REDO LINE
   >				;END IFN FTDEC20
   IFN <^-FTDEC20>!<FTEXEC&FTEDIT>,<
   IFNDEF T1,<
	T1==A
	PURGT1==-1
   >
   IFE FTDEC20,<
CHIN1:>
XCHIN1:	SKIPE T1,CHINP		;REINIT LINE?
	JRST XCHIN2		;NO
	MOVEI T1,NLINBF*5	;YES, SETUP MAX CHAR COUNT
	MOVEM T1,LINSPC
	MOVE T1,LINBP		;SETUP POINTER
	MOVEM T1,CHINP
XCHIN2:	MOVEM T1,LINDB		;SET BEGINNING OF DELETE BUFFER
	SKIPG LINSPC		;ROOM LEFT IN BUFFER?
	JRST ERR		;NO, TOO MUCH TYPIN
	MOVEI T1,LINBP-TEXTIB	;SIZE OF BLOCK
	SKIPE WAKALL		;WAKEUP ON EVERYTHING?
	MOVEI T1,ETXTB-TEXTIB	;YES, INCLUDE WAKEUP TABLE
	MOVEM T1,TEXTIB		;SET SIZE IN BLOCK
	PUSH P,LINSPC		;SAVE CURRENT SPACE
	PUSH P,CHINP		;AND POINTER
	MOVEI T1,TEXTIB		;POINT TO ARG BLOCK
	PUSHJ P,TXTI
	 JRST ERR		;BAD ARGS (IMPOSSIBLE)
	POP P,CHINP		;RESTORE POINTER TO CHARS JUST TYPED
	POP P,T1		;RECOVER OLD SPACE COUNT
   IFN FTYANK,<
	AOSN PTDFLG		;EOF ON COMMAND FILE
	JRST [	SETZM CHINC
		SETZM CHINP
		JRST DD2]	;YES--GET BACK TO TOP LEVEL
   >				;END FTYANK
	SKIPN 0(P)		;REPROCESS NEEDED?
	JRST [	MOVEI T1,NLINBF*5
		SUB T1,LINSPC	;YES, COMPUTE NUMBER CHARS IN LINE
		JUMPE T1,WRONG	;JUMP IF WHOLE LINE DELETED
		MOVEM T1,CHINC	;LINE NOT NULL, SETUP CHAR COUNT
		MOVE T1,LINBP	;REINIT POINTER
		MOVEM T1,CHINP
		JRST DD2]	;CLEAR WORLD AND REDO LINE
	SUB T1,LINSPC		;COMPUTE NUMBER CHARS JUST TYPED
	JUMPG T1,[MOVEM T1,CHINC ;SETUP COUNT
		JRST TIN1]	;GO RETURN NEXT CHAR

;CONTINUED ON NEXT PAGE
;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE LINE
;MUST BE REPROCESSED FROM BEGINNING. POSSIBLY ALL TEXT HAS BEEN
;DELETED.

	PUSHJ P,RDBKIN
	SETZM 0(P)		;REQUEST REPROCESS OF LINE
	MOVE T1,LINBP		;RESET DELETE BOUNDARY TO BEGINNING OF LINE
	JRST XCHIN2

   IFDEF PURGT1,<IFL PURGT1,< PURGE PURGT1,T1>>
   >				;END IFN ^-FTDEC20...

ONES4:	OCT -1,-1,-1,-1		;WAKEUP MASK
   IFN FTDEC20,<
TOUT0: IFN FTEXEC,<
	SKPUSR
	JRST XTOUT>
	EXCH T1,T
	PBOUT			;CHAR TO TTY FROM T1
	EXCH T1,T
	POPJ P,

LISTEN:	IFN FTEXEC,<
	SKPUSR
	JRST XLISTE>
	EXCH T1,T
	MOVEI T1,.PRIIN		;PRIMARY INPUT (TTY)
	SIBE			;INPUT BUFFER EMPTY?
	 AOS 0(P)		;NO, GIVE SKIP RETURN
	EXCH T1,T
	POPJ P,			;RETURN NOSKIP
;HANDLE TTY WHEN RETURNING TO DDT FROM USER CONTEXT

TTYRET:	IFN FTEXEC,<
	SKPUSR
	JRST XTTYRET>
	SKIPE SAVTTY		;ALREADY HAVE STATE?
	JRST TTYR1		;YES
	MOVEI T1,.PRIIN
	RFMOD			;GET MODES
	MOVEM T2,SAVTTY
	RFCOC			;GET CC MODES
	MOVEM T2,SAVTT2
	MOVEM T3,SAVTT3
TTYR1:	MOVEI T1,.PRIIN
	RFMOD
	TXZ T2,TT%WAK+TT%DAM
	TXO T2,<TT%WKF+TT%WKN+TT%WKP+TT%ECO+FLD(.TTASC,TT%DAM)>
	SFMOD
	MOVE T2,TTYCC2
	MOVE T3,TTYCC3
	SFCOC			;SETUP PROPER DDT MODES
	MOVEI T1,.FHSLF
   IFN FTEXEC,<
	SKPEXC>
	DIR
	POPJ P,

TTYLEV:	IFN FTEXEC,<
	SKPUSR
	JRST XTTYLE>
	MOVEI T1,.PRIIN
	MOVE T2,SAVTTY
	SFMOD			;RESTORE MODES
	MOVE T2,SAVTT2
	MOVE T3,SAVTT3
	SFCOC			;RESTORE CC MODES
	MOVEI T1,.FHSLF
	SKIPGE SAVSTS		;PSI SYSTEM ON FOR USER?
	EIR			;YES
	SETZM SAVTTY		;NOTE USER MODES IN EFFECT
	POPJ P,

TTYCLR:	MOVEI T1,.PRIIN
   IFN FTEXEC,<
	SKPEXC>			;SKIP CFIBF IF EXEC
	CFIBF
	PUSHJ P,LISTEN
	 JFCL
	POPJ P,0

;ROUTINES TO TURN TAB ECHO ON/OFF

TTYTOF:	MOVE T1,TTYCC2		;NORMAL MODE WORD
	TRZA T1,3B19		;TURN TAB OFF
TTYTON:	MOVE T1,TTYCC2
	PUSH P,T2		;PRESERVE REGS
	PUSH P,T3
	MOVEM T1,T2
	MOVEI T1,.PRIIN
	MOVE T3,TTYCC3
	SFCOC			;SET CONTROL CHAR MODES
	POP P,T3
	POP P,T2
	POPJ P,

TTYCC2:	BYTE (2) 0,1,1,1,1,1,1,2,1,2,3,1,1,2,1,1,1,1
TTYCC3:	BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1
   >				;END IFN FTDEC20
   IFE FTDEC20,<
SUBTTL DDT COMMAND FILE LOGIC

;START PAPER TAPE INPUT
   IFN FTYANK,<
TAPIN:
   IFN FTEXEC,< SKPEXC		;SKIP IF EXEC MODE
	JRST UTAPIN		;USER MODE
	CONSO PTR,400		;TAPE IN READER?
	JRST ERR		;NO - ERROR
	SETZM EPTPTR		;YES. INDICATE START READING IN
	SETOM COMAND		;SHOW THERE IS A COMMAND FILE
	JRST RET
   >				;END IFN EEDT&1
UTAPIN:
	HIADDR=W		; NEW JOB BOUNDARY(.JBREL)
	CM=17			;CHAN FOR COMMANDS
	INIT CM,0		; ASCII MODE
	SIXBIT /DSK/		;ALWAYS ON DEVICE DSK
	XWD 0,CBUF		; ESTABLISH RING HEADER
	JRST ERR		; NOT ASSIGNED, ERROR
	TLNE F,(QF)		;NAME GIVEN?
	SKIPA T,SYL		;YES. USE IT
   IFE FTFILE,<
	MOVE T,[SIXBIT /PATCH/]	;NO, DEFAULT=PATCH
   >
   IFN FTFILE,<
	MOVE T,[SIXBIT /FILDDT/]
   >
	MOVEM T,COMNDS		;SAVE NAME IN LOOKUP BLOCK
	MOVSI T,'DDT'		;EXTENSION
	MOVEM T,COMNDS+1	; ..
	SETZM COMNDS+3		;CLEAR PPN
	LOOKUP CM,COMNDS	; LOOKUP CMD FILE(IN CASE DIR DEV)
	JRST ERR		; NOT FOUND
	MOVE T,.JBFF		; LOAD .JBFF
	MOVEM T,SVJBFF		; AND SAVE IT
   IFE FTFILE,<
	HRRZ T,.JBREL		; LOAD .JBREL
	MOVEI HIADDR,2000(T)	; NEEDED, NOW PRPARE NEW .JBREL
	IORI HIADDR,1777	; NEW .JBREL TO ASK FOR
	HRRZ TT,@SYMP		; BOTTM OF SYM TBL
	HLRE TT1,@SYMP		; NEG LENGTH
	SUB TT,TT1		; TOP OF SYMBOL TBL
	MOVEM TT,.JBFF		; ASSUME THIS NEW .JBFF AND SAVE IT
	SUB T,TT		; COMPUTE WDS BETWEEN SYM TOP AND .JBREL
	CAILE T,207		; ENUFF FOR DSK BUFF+FUDGE FACTOR?
	JRST HAVECM		; YES
	CALLI HIADDR,11		; NO, GET ANOTHER 1K
	JRST ERR		; NOT AVIL, TREAT AS NO CMD FILE
   >				;END FTFILE
HAVECM:	SETOM COMAND		; FLAG CMD FILE FOUND
	SETZM CHINP
	SETZM CHINC
	INBUF CM,1		; 1 BUFFER ONLY
   IFN FTFILE,<
	INIT DP,1		;ALSO DO LISTING FILE
	 SIXBIT /LPT/
	 XWD LBUF,0
	 JRST [	SETZM COMAND
		 JRST  ERR]
	MOVSI TT,'LST'
	MOVEM TT,COMNDS+1
	SETZM COMNDS+3
	SETZM COMNDS+2
	ENTER DP,COMNDS
	 JRST [	SETZM COMAND
		 JRST  ERR]
	OUTBUF DP,2
   >
	JRST RET
   >				;END IFN FTYANK
   IFN FTYANK,<
   IFN FTEXEC,<
XPTRIN:	PUSHJ P,PTRXNX		;GET NEXT CHAR FROM PTR
	 JRST PTRDON		;THROUGH
	JRST PTRCHR		;PROCESS THE CHAR.
   >
PTRIN:	PUSHJ P,PTRNX		;GET NEXT CHAR
	 JRST PTRDON		;EOF ON COMMAND FILE
PTRCHR:	CAIE T,177		;RUBOUT?
	SKIPN TT2,T		;NULL?
	JRST PTRNXT		;IGNORE IT
   IFN FTEXEC,<
	SKPEXC			;EXEC MODE?
	JRST PTRCH2
	CAIE T,15		;YES. CR?
	JRST CPOPJ1		;NO. ECHO OF CHAR WILL HAPPEN LATER
	PUSHJ P,PTRXNX		;READ (AND IGNORE) NEXT CHAR
	 JFCL			; WHICH OUGHT TO BE A LINE-FEED
	MOVEI T,15		;RETURN CR AS CHAR
	JRST CPOPJ1
PTRCH2:		>;END IFN FTEXEC
	CAIE T,33		;ESCAPE?
	CAIL T,175		;ALT-MODE?
	MOVEI T,"$"		;YES, ECHO "$"
	PUSHJ P,ECHO		;ECHO CHAR
	MOVE T,TT2		;RESTORE T
	JRST CPOPJ1		;SKIP-RETURN WITH DATA

PTRNXT:
   IFN FTEXEC,< SKPUSR
	JRST XPTRIN>
	JRST PTRIN

;THROUGH WITH  COMMAND FILE
PTRDON:	SETZM COMAND
	PUSH P,CHINC
	PUSH P,CHINP
	PUSHJ P,CRF		;2 CR-LFS
	PUSHJ P,CRF
	POP P,CHINP
	POP P,CHINC
	SETOM PTDFLG
	POPJ P,			;NON-SKIP RETURN
;COMMAND FILE IO
PTRNX:	SOSLE CBUF+2		;DATA LEFT?
	JRST PTRNX1		;YES
	INPUT CM,		;GET NEXT BUF
	STATZ CM,740000		;ERROR?
	HALT .+1		;TOO BAD
	STATZ CM,20000		;EOF?
	JRST PTRNX2		;YES
PTRNX1:	ILDB T,CBUF+1
	JRST CPOPJ1		;SKIP-RETURN WITH DATA
PTRNX2:	RELEASE CM,		;EOF - DONE
   IFN FTFILE,<
	CLOSE DP,
	RELEAS DP,
   >
	MOVE TT,SVJBFF
	MOVEM TT,.JBFF		;RESET .JBFF
	POPJ P,			;NON-SKIP MEANS DONE WITH COMMAND FILE
   IFN FTEXEC,<
PTRXNX:	SKIPE TT2,EPTPTR	;DATA IN PTR BUF?
	JRST PTRXN3		;YES
	MOVE TT2,[POINT 7,EPTRBF] ;NO SET UP TO STORE IN PTR BUFFER
	SETZM EPTRBF		;SWITCH FOR END OF TAPE TEST
	CONO PTR,20		;START PTR GOING
PTRXN1:	CONSO PTR,400		;EOT?
	JRST PTRXN4		;YES
	CONSO PTR,10		;DATA?
	JRST PTRXN1		;WAIT SOME MORE
	DATAI PTR,T		;READ A CHAR
	JUMPE T,PTRXN1		;IGNORE NULLS
PTRXN2:	IDPB T,TT2		;SAVE IN DATA BUFFER
	CAIE T,12		;LF
	CAMN TT2,EPTRND		; OR BUFFER FULL?
	SKIPA TT2,[POINT 7,EPTRBF] ;YES. START TAKING CHARS OUT OF BUF
	JRST PTRXN1		;NO - READ ANOTHER
	CONO PTR,0		;SHUT OFF PTR BEFORE READING NEXT CHAR

PTRXN3:	ILDB T,TT2		;GET A CHAR
	CAIE T,12		;LF
	CAMN TT2,EPTRND		; OR END OF BUFFER?
	SETZ TT2,		;YES, START PTR FOR NEXT CHAR
	MOVEM TT2,EPTPTR	;SAVE PNTR FOR NEXT CHAR
	JRST CPOPJ1		;HAVE A CHAR RETURN

;EOT
PTRXN4:	SKIPN EPTRBF		;ANY DATA?
	POPJ P,			;NO - DONE RETURN
	SETZ T,			;YES -  FILL REST OF BUFFER WITH 0'S
	JRST PTRXN2

EPTPTR:	0
EPTRBF:	BLOCK 5			;BUFFER SO PTR WONT CHATTER
EPTRND:	POINT 7,EPTRBF+4,34	;PNTR FOR LAST CHAR IN BUF
   >				;END IFN FTEXEC
COMAND:	0
SVJBFF:	0
CBUF:	BLOCK 3
COMNDS:	SIXBIT /PATCH/
	SIXBIT /DDT/
	0
	0
   >				;END FTYANK
   IFN FTFILE,<
PUTCHR:	SOSLE LBUF+2		;ANY ROOM?
	JRST PUTOK		;YES
	OUTPUT DP,
	STATZ DP,740000		;ERRORS?
	HALT .+1		;YES

PUTOK:
	IDPB T,LBUF+1		;DEPOSIT CHAR.
	POPJ P,

   >				;END OF IFN FTFILE
   >				;END IFE FTDEC20
SUBTTL DISPATCH TABLE

BDISP:	POINT 12,DISP(R),11
	POINT 12,DISP(R),23
	POINT 12,DISP(R),35
DISP:
DEFINE D (Z1,Z2,Z3)<
	BYTE (12) Z1-DDTOFS,Z2-DDTOFS,Z3-DDTOFS
   IFN <<Z1-DDTOFS>!<Z2-DDTOFS>!<Z3-DDTOFS>>&<-1,,770000>,
	<PRINTX Z1, Z2, OR Z3 TOO LARGE FOR DISPATCH TABLE> >
;THIS MACRO PACKS 3 ADDRESSES INTO ONE WORD; EACH ADR IS 12 BITS

   IFE FTYANK,<TAPIN=ERR>
   IFE FTEXEC&FTPTP,< PUNCH==ERR
	BLKEND==ERR
	LOADER==ERR>
   IFN FTDEC20,<SETPAG==ERR>

D (ERR,ERR,ERR);	(0)
D (CNTRLZ,ERR,ERR);	(3)
D (ERR,ERR,VARRW);	(6)
D (TAB,LINEF,ERR);	(11)
D (ERR,CARR,ERR);	(14)
D (ERR,ERR,ERR);	(17)
D (PUNCH,ERR,ERR);	(22)
D (ERR,ERR,ERR);	(25)
D (ERR,ERR,CNTRLZ);	(30)
D (CONTROL,ERR,ERR);	(33)
D (ERR,ERR,SPACE);	(36)
D (SUPTYO,TEXI,ASSEM);	(41)
D (DOLLAR,PERC,ERR);	(44)
D (DIVD,LPRN,RPRN);	(47)
D (MULT,PLUS,ACCF);	(52)
D (MINUS,PERIOD,SLASH);	(55)
D (NUM,NUM,NUM);	(60)
D (NUM,NUM,NUM);	(63)
D (NUM,NUM,NUM);	(66)
D (NUM,TAG,SEMIC);	(71)
D (FIRARG,EQUAL,ULIM);	(74)
D (QUESTN,INDIRE,ABSA);	(77)
D (BPS,CON,SYMD);	(102)
D (EFFEC,SFLOT,GO);	(105)
D (HWRDS,PILOC,BLKEND);	(110)
D (KILL,LOADER,MASK);	(113)
D (NWORD,BITO,PROCEDE);	(116)
D (QUAN,RELA,SYMBOL);	(121)
D (TEXO,SETPAG,ERR);	(124)
D (WORD,XEC,TAPIN);	(127)
D (ZERO,OCON,ICON);	(132)
D (OSYM,VARRW,PSYM);	(135)

;THIS TABLE DOES NOT HAVE ENTRIES FOR CHARS .GE. 140; THESE
; ARE DETECTED AS ERRORS NEAR L21:
	SUBTTL FANCY TERMINAL INPUT LOGIC

   IFN ^-FTDEC20!<FTEXEC&FTEDIT>,<
TXTI:
DOTXTI:	PUSH P,A		;SAVE ALL AC'S USED
	PUSH P,B
	PUSH P,C
	PUSH P,T
	PUSH P,W1
	PUSH P,W2
	MOVE W1,LINSPC		;COUNT OF BYTES IN DESTINATION
	SKIPN W2,LINDB		;WAS IT NON-ZERO?
	MOVE W2,CHINP		;NO. USE DEFAULT

; VERIFY ALL OF THE STRING POINTERS

RDTXT1:	MOVE A,CHINP		;HAVE A DEST POINTER?
	PUSHJ P,RDCBP		;YES. CHECK IT OUT
	MOVEM A,CHINP		;GET CONVERTED POINTER
	SKIPN A,LINBP		;HAVE A ^R BUFFER?
	JRST RDTOPM		;NO. GO AROUND THEN
	PUSHJ P,RDCBP		;YES. VERIFY IT
	MOVEM A,LINBP		;STORE VERIFIED POINTER
RDTOPM:	MOVE A,W2		;GET TOP OF BUFFER
	PUSHJ P,RDCBP		;VERIFY IT
	MOVE W2,A		;ALL VERIFIED NOW
	JUMPLE W1,WRAP0		;MAKE SURE COUNT HAS ROOM IN IT
	; ..
;MAIN LOOP - DOES INPUT OF BYTE AND DISPATCH ON CHARACTER CLASS
;ACTION ROUTINES EXIT TO:
; INSRT - APPEND CHARACTER AND CONTINUE
; NINSRT - CONTINUE WITHOUT APPENDING CHARACTER
; DING - BUFFER NOW EMPTY, POSSIBLE RETURN TO USER
; WRAP, WRAP0 - RETURNS TO USER

NINSRT:	MOVEM W1,LINSPC		;STORE COUNT
	PUSHJ P,RDBIN		;DO BIN
	MOVE A,B		;SAVE BYTE
	IDIVI B,CHRWRD		;SETUP TO GET CHAR CLASS
	LDB B,CCBTAB(C)		;GET IT FROM BYTE TABLE
	IDIVI B,2		;SETUP TO REF DISPATCH TABLE
	JUMPE C,[HLRZ T,DISPTC(B) ;GET LH ENTRY
		JRST .+2]
	HRRZ T,DISPTC(B)	;GET RH ENTRY
	MOVE B,A		;ROUTINES GET BYTE IN B
	JRST 0(T)		;DISPATCH TO ACTION ROUTINE

;RETURN FROM ACTION ROUTINE TO APPEND CHARACTER AND CONTINUE.
; B/ CHARACTER

INSRT:	SKIPE WAKALL		;BREAK ON EVERYTHING?
	JRST WRAP		;YES. WRAP IT UP THEN
	IDPB B,CHINP		;APPEND BYTE TO USER STRING
	SOJG W1,NINSRT		;CONTINUE IF STILL HAVE COUNT
	JRST WRAP0		;COUNT EXHAUSTED, RETURN
;RETURNS TO USER.

;RETURN TO USER IF BUFFER EMPTY

NDING:	CAME W2,CHINP		;BUFFER EMPTY?
	JRST NINSRT		;NO, GO GET MORE INPUT
	JRST WRAP0

;APPEND LAST CHARACTER AND RETURN

WRAP:	IDPB B,CHINP		;APPEND BYTE
	SUBI W1,1		;UPDATE COUNT

;STORE NULL ON STRING AND RETURN

WRAP0:	JUMPLE W1,WRAP1		;DON'T STORE NULL IF COUNT EXHAUSTED
	SETZ B,
	MOVE A,CHINP
	IDPB B,A		;STORE NULL WITHOUT CHANGING USER PTR

;UPDATE USER VARIABLES AND RETURN

WRAP1:	MOVEM W1,LINSPC		;UPDATE USER'S BYTE COUNT
	POP P,W2
	POP P,W1
	POP P,T
	POP P,C
	POP P,B
	POP P,A
	JRST CPOPJ1
;PARAMETERS FOR CLASS TABLE

CCBITS==4			;BITS/BYTE
CHRWRD==^D36/CCBITS		;BYTES/WORD

;DEFINED CHARACTER CLASSES:

TOP==0				;TOPS10 BREAK
BRK==1				;REGULAR BREAK SET
ZER==2				;NULL
EOLC==3				;EOL
PUN==4				;PUNCTUATION
SAFE==5				;ALL OTHERS
RUBO==6				;DELETE A CHARACTER
RTYP==7				;RETYPE THE LINE
KLL==10				;DELETE THE LINE
KWRD==11			;DELETE A WORD
RDCRC==12			;CARRIAGE RETURN
RDQTC==13			;QUOTE CHARACTER
;TABLE OF BYTE PTRS TO REFERENCE CLASS TABLE

	XX==CCBITS-1
	XALL
CCBTAB:	REPEAT CHRWRD,<
	 POINT CCBITS,CTBL(B),XX
	 XX=XX+CCBITS>
	SALL

;CLASS DISPATCH TABLE

DISPTC:	WRAP,,WRAP
	ZNULL,,EOL1
	WRAP,,INSRT
	DELC,,RTYPE
	DELIN,,KLWORD
	RDCR,,RDQT
;CHARACTER CLASS TABLE

DEFINE CCN (A,B)<
	REPEAT B,<
	 CC1 (A)>>

DEFINE CC1 (C)<
	QQ=QQ+CCBITS
   IFG QQ-^D35,<
	 QW
	 QW=0
	 QQ=CCBITS-1>
	QW=QW+<C>B<QQ>>

	QW==0
	QQ==-1

CTBL:	CC1(ZER)		;0
	CCN(PUN,6)		;1-6
	CC1(TOP)		;7
	CCN(PUN,2)		;10-11
	CC1(EOLC)		;12
	CC1(PUN)		;VT
	CC1(TOP)		;FF
	CC1(RDCRC)		;CR
	CCN(PUN,4)		;16-21 (^N-^Q)
	CC1(RTYP)		;^R
	CCN(PUN,2)		;^S,^T
	CC1(KLL)		;^U
	CC1(RDQTC)		;^V
	CC1(KWRD)		;^W
	CCN(PUN,2)		;^X,^Y
	CCN(BRK,2)		;^Z,$
	CCN(PUN,4)		;34-37
	CCN(PUN,^D16)		;40-/
	CCN(SAFE,^D10)		;0-9
	CCN(PUN,7)		;:-@
	CCN(SAFE,^D26)		;A-Z
	CCN(PUN,6)		;]-140
	CCN(SAFE,^D26)		;A-Z
	CCN(PUN,4)		;173-176
	CC1(RUBO)		;177
	QW			;GET LAST WORD IN
;LOCAL ROUTINES TO DO LOGICAL BIN AND BOUT.

RDBIN:	SKIPE B,SAVCHR		;WANT TO BACK UP?
	JRST [	SETZM SAVCHR	;ONLY ONCE
		 POPJ P,0]	;RETURN
   IFN FTEXEC,<
	SKPUSR
	JRST [	PUSH P,T	;SAVE T
	   IFN FTYANK,<
		SKIPE COMAND
		PUSHJ P,XPTRIN>
		PUSHJ P,XTIN	;GET A BYTE
		MOVE B,T	;PUT IN CORRECT PLACE
		POP P,T	;RESTORE T
		JRST RDBIN1]	;SKIP NEXT INST
   >
   IFN FTDEC20,<HALT DDT>	;SHOULD NOT BE HERE IN USER MODE
   IFE FTDEC20,<
   IFN FTYANK,<
	PUSH P,T		;SAVE AN AC
	SKIPE COMAND		;COMMAND FILE OPEN?
	PUSHJ P,PTRIN		;READ COMMAND FILE
	JRST [	MOVEI T," "	;ASSUME EOF
		SKIPL PTDFLG	;WAS IT EOF?
		INCHRW T	;NO--READ A BYTE
		JRST .+1]	;CONTINUE
	MOVE B,T		;COPY BYTE
	POP P,T>		;RESTORE T
   IFE FTYANK,<INCHRW B>>	;READ BYTE UNDER TOPS-10
RDBIN1:	MOVEM B,LASCHR		;SAVE LAST CHAR READ
	POPJ P,0		;RETURN


;RDBOUT
; B/ BYTE
;	PUSHJ P,RDBOUT
; RETURN +1 ALWAYS

RDBOUT:	PUSH P,T		;SAVE AN AC
	PUSH P,CHINC
	PUSH P,CHINP
	MOVE T,B		;SET FOR ECHO
	PUSHJ P,TOUT		;TYPE IT
	POP P,CHINP
	POP P,CHINC
	POP P,T
	POPJ P,0
;RDSOUT - OUTPUT STRING ALA RDBOUT
; B/ STRING PTR
;	PUSHJ P,RDSOUT
; RETURN +1 ALWAYS

RDSOUT:	MOVE A,B		;COPY POINTER
	PUSHJ P,RDCBP
RDSL:	ILDB B,A
	JUMPE B,CPOPJ		;EXIT ON NULL
	PUSHJ P,RDBOUT
	JRST RDSL

;CHECK BYTE POINTER GIVEN AS ARGUMENT
; A/ BYTE POINTER
;	PUSHJ P,RDCBP
; RETURN +1: OK, LH INITIALIZED IF NECESSARY

RDCBP:	HLRZ B,A		;GET LH
	CAIN B,-1		;IS DEFAULT?
	HRLI A,(<POINT 7,0>)	;YES, FILL IN 7-BIT
	LDB B,[POINT 6,A,11]	;CHECK BYTE SIZE
	CAIGE B,7		;7 OR GREATER?
	HALT .			;BAD BYTE SIZE
	IBP A			;INCR IT AND DECR IT ONCE SO WILL
	JRST DBP		; BE IN KNOWN STATE FOR COMPARES
;LOCAL ROUTINES FOR EDITING FUNCTIONS

;DELETE CHARACTER FROM DESTINATION - BACKUP PTR AND CHECK
;FOR TOP OF BUFFER
;	PUSHJ P,BACK
; RETURN +1: AT TOP OF BUFFER, NO CHARACTER TO DELETE
; RETURN +2: CHARACTER DELETED

BACK:	CAMN W2,CHINP		;AT TOP OF BUFFER?
	POPJ P,0		;YES
	MOVE A,CHINP		;GET DEST PTR
	PUSHJ P,DBP		;DECREMENT IT
	MOVEM A,CHINP		;PUT IT BACK
	AOJA W1,CPOPJ1		;UPDATE COUNT AND RETURN

;PUT BYTE BACK INTO SOURCE
; B/ BYTE
;	PUSHJ P,RDBKIN
; RETURN +1 ALWAYS

RDBKIN:
DOBKIN:	MOVE A,LASCHR		;GET LAST BYTE READ
	MOVEM A,SAVCHR		;MAKE NEXT BYTE READ
	POPJ P,0
;FIND BEGINNING OF CURRENT LINE.
;	PUSHJ P,FNDLIN
; RETURN +1: AT TOP OF BUFFER
; RETURN +2: A/ BACKED-UP BYTE PTR TO BEGINNING OF LINE
;	B/ BYTE COUNT CONSISTENT WITH CHINP IN A

FNDLIN:	CAMN W2,CHINP		;AT TOP OF BUFFER?
	POPJ P,0		;YES
	PUSH P,CHINP		;SAVE CURRENT LINE VARIABLES
	PUSH P,W1
FNDLN1:	MOVE A,CHINP		;BACKUP ONE CHARACTER
	PUSHJ P,DBP
	MOVEM A,CHINP
	ADDI W1,1
	CAMN W2,CHINP		;NOW AT TOP OF BUFFER?
	JRST FNDLN2		;YES, RETURN
	LDB B,CHINP		;NO, LOOK AT NEXT CHAR TO BE DELETED
	CAIN B,12		;EOL OR LF?
	JRST FNDLN2		;YES, RETURN
	JRST FNDLN1		;NO, KEEP LOOKING

FNDLN2:	MOVE A,CHINP		;RETURN NEW LINE VARIABLES
	MOVE B,W1
	POP P,W1		;RESTORE OLD LINE VARIABLES
	POP P,CHINP
	JRST CPOPJ1

;ACTION ROUTINES

;ZERO BYTE

ZNULL:	SKIPE WAKALL		;USER HAVE A MASK?
	JRST INSRT		;YES. GO SEE ABOUT IT THEN
	JRST WRAP0		;NO. ALWAYS BREAK THEN
;CARRIAGE RETURN - IF LINE FEED FOLLOWS, TREAT LIKE EOL

RDCR:	CAIGE W1,2		;ROOM FOR CR AND LF?
	JRST [	PUSHJ P,RDBKIN	;NO, PUT THE CR BACK
		JRST WRAP0]	;WILL GET IT NEXT TIME
	PUSHJ P,RDBIN		;GET THE NEXT CHAR
	CAIN B,12		;LF?
	JRST RDCR1		;YES, NORMAL NEWLINE
	PUSHJ P,RDBKIN		;NO, PUT BACK THE SECOND BYTE
	MOVEI B,15		;APPEND A REAL CR
	JRST WRAP

RDCR1:	MOVEI B,15
	IDPB B,CHINP		;APPEND CR
	SOS W1
RDCR2:	MOVEI B,12
EOL1:	JRST WRAP		;YES

;QUOTE CHARACTER (^V) - INHIBITS EDITING ACTION OF FOLLOWING CHARACTER

RDQT:	CAIGE W1,2		; ROOM FOR BOTH?
	JRST [	PUSHJ P,RDBKIN	; NO. BACK UP
		JRST WRAP0]	; AND WAIT FOR NEXT TIME
	IDPB B,CHINP		;STORE QUOTE
	SOS W1			; ONE LESS
	PUSHJ P,RDBIN		;GET THE NEXT CHAR
	JRST WRAP		;YES
;DELETE CHARACTER (RUBOUT)

DELC:	PUSHJ P,BACK		;BACKUP PTR
	 JRST WRAP0		;NOTHING LEFT IN BUFFER
	MOVE T,CHINP
	ILDB B,T		;GET CHAR JUST DELETED
	CAIN B,12		;WAS IT LF?
	JRST DELC2		;YES
	PUSHJ P,RDBOUT		;TYPE IT OUT
	MOVEI B,"\"		;INDICATE DELETION
	PUSHJ P,RDBOUT
DELC4:	JRST NINSRT		;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.

DELC2:	CAMN W2,CHINP		;AT BEGINNING OF DEST BUFFER?
	JRST DELC1		;YES
	LDB B,CHINP		;NO, CHECK CHARACTER PRECEEDING LF
	CAIE B,15		;A CR?
	JRST DELC1		;NO, LEAVE IT ALONE
	PUSHJ P,BACK		;YES, DELETE IT ALSO
	 JRST WRAP		;(CAN'T HAPPEN)
DELC1:	HRROI B,[ASCIZ /
/]
	PUSHJ P,RDSOUT		;DO CRLF WHEN DELETING EOL OR CRLF
	JRST DELC4
;DELETE LINE (CONTROL-U)

DELIN:	MOVEI C,0
	PUSHJ P,FNDLIN		;FIND BEGINNING OF LINE
	 JRST NDING		;NOTHING IN BUFFER
	LDB C,CHINP		;GET LAST CHAR IN BUFFER
	MOVEM A,CHINP		;SET LINE VARIABLES TO BEGINNING
	MOVEM B,W1
	JRST NDING		;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;DELETE WORD (CONTROL-W)

KLWORD:	PUSHJ P,BACK		;DELETE AT LEAST ONE CHARACTER
	 JRST WRAP0		;WASN'T ONE
	MOVE T,CHINP
	ILDB B,T		;GET CHAR JUST DELETED
	CAIN B,12		;LF OR EOL?
	JRST BWRD3		;YES, DON'T DELETE
BWRD1:	PUSHJ P,BACK		;DELETE NEXT CHARACTER
	 JRST BWRD2		;NO MORE LEFT
	MOVE T,CHINP		;LOOK AT CHARACTER JUST DELETED
	ILDB B,T
	IDIVI B,CHRWRD		;GET ITS CHARACTER CLASS
	LDB B,CCBTAB(C)
	CAIN B,SAFE		;IS IT A WORD SEPARATOR?
	JRST BWRD1		;KEEP DELETING
BWRD3:	IBP CHINP		;YES, KEEP THAT CHARACTER
	SUBI W1,1
BWRD2:	MOVEI B,"_"		;INDICATE WORD DELETION
	PUSHJ P,RDBOUT
	JRST NINSRT		;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;RETYPE LINE (CONTROL-R)

RTYPE:	PUSHJ P,RTYPES		;DO THE WORK
	JRST NINSRT

;SUBROUTINE TO RETYPE LINE

RTYPES:	HRROI B,[ASCIZ /
/]
	PUSHJ P,RDSOUT		;NON-DISPLAY, GET CLEAN LINE
	PUSHJ P,FNDLIN		;FIND BEGINNING OF LINE
	 MOVE A,W2		;AT TOP OF BUFFER - USE IT
	MOVE T,A		;SAVE PTR TO BEGINNING OF LINE
	CAME T,W2		;BEG OF LINE IS TOP OF BUFFER?
	JRST RTYP1		;NO, DON'T TYPE ^R BFR
	SKIPE T,LINBP		;GET ^R BFR IF ANY
RTYW1:	CAMN T,W2		;UP TO TOP OF BFR?
	JRST RTYP4		;YES, DONE WITH ^R BFR
	ILDB B,T		;GET CHAR FROM ^R BFR
	JUMPN B,[PUSHJ P,RDBOUT	;TYPE IT
		JRST RTYW1]
RTYP4:	MOVE T,W2		;DONE WITH ^R BFR, NOW DO MAIN BFR
RTYP1:	CAMN T,CHINP		;BACK TO END OF LINE?
	POPJ P,0		;YES
	ILDB B,T		;NO, GET NEXT BYTE
	PUSHJ P,RDBOUT		;TYPE IT
	JRST RTYP1		;LOOP UNTIL AT END OF BUFFER
;DECREMENT BYTE POINTER
; A/ BYTE PTR
;	PUSHJ P,DBP
; RETURNS +1, CLOBBERS B AND C

DBP:	LDB B,[POINT 6,A,5]	;GET P
	LDB C,[POINT 6,A,11]	;GET S
	ADD B,C			;NEW P = P + S
	CAIGE B,^D36		;NEW P .GE 36?
	JRST DBP1		;NO, BYTE IS IN SAME WORD.
	HRRI A,-1(A)		;DECREMENT ADDRESS
	MOVEI B,^D36		;MAKE P = REMAINDER (36,S)
	IDIV B,C
	MOVEI B,0(C)
DBP1:	DPB B,[POINT 6,A,5]
	POPJ P,0
   >				;END IFN ^-FTDEC20...
	SUBTTL OP DECODER

;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 OR ARE THE EXTEND BYTE, 41-73(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) THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
;	IS A TRANSFER BYTE BUT MUST HAVE THE ADDRESS EXTENDED
;	BY <1000-74*2+FIR.> FIRST.
;
;74(8)-777(8) THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
;	CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE 
;	<A-74(8)+FIR.>RD BYTE IN THE TABLE.
;
;MACROS 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 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
;	TREE SEARCH METHOD IS USED.
REPEAT 0,<

DEFINE REDEF (XX)<
DEFINE INFO (AA,BB)<
AA XX'BB>>


DEFINE BYT9 (L)<
XLIST
REDEF %
	ZZ==0
	ZZZ==0
	ZZM==1

	IRPC L,<
	Z=="L"
   IFE Z-":",<INFO <>,<==CLOC>
		IFNDEF FIR.,<FIR.==CLOC>
		IFGE CLOC+73-1000-FIR.,<PRINTX OPTABLE TOO LONG>
		Z==0>
   IFE Z-"/",<IF1 <OUTP 1>
		IF2,<INFO OUTP,+73-FIR.>
		Z==0>
   IFE Z-"^",<OUTP <ZZ&70/2+ZZ&7-1>
	Z==0>
   IFE <Z-",">*<Z-".">*<Z-40>,<IFN ZZZ,<
				REPEAT 5,<ZZ==ZZZ&77
					IFN ZZ,<OUTP ZZ>
					ZZZ==ZZZ/100>>
				IFE Z-".",<OUTP 40>
				Z==0>
   IFN Z,<INFO REDEF,L
	ZZ==ZZ*10+Z&7
	ZZZ==ZZZ+<Z-40>*ZZM
	ZZM==ZZM*100>
   IFE Z,<REDEF %
	ZZ==0
	ZZZ==0
	ZZM==1>>
LIST>

DEFINE OUTP (A)<
	BINRY==BINRY*400+BINRY*400+A
	BINC==BINC-1
   IFE BINC,<EXP BINRY
		BINRY==0
		BINC==4>
	CLOC==CLOC+1>
TBL:				;OPDECODER BYTE TABLE
	.XCREF			;KEEP THIS MESS OUT OF CREF

BINRY==0
CLOC==0				;SET BYTE LOCATION COUNTER TO 0
BINC==4				;INIT BYTES/WORD COUNTER

BYT9 <63^UUO/FLO/HAK/ACCP/BOOLE/H HWT/T ACBM/>

;IO INSTRUCTIONS
BYT9 <21^BD/CON,11^OI/S,01^Z/O/>
BYT9 <BD:01^BLK,IO/DATA,IO:11^I/O/OI:01^O/I/>

;UUOS
BYT9 <UUO:51^.,32^U40/U50/U60/21^U703/11^USET/01^>
BYT9 <LOOKU,P/ENTE,R/USET:USET,01^I/O/>
BYT9 <U40:03^CAL/INI T/.....,CALL I/>
BYT9 <U60:21^U603/01^IN,BPUT/OUT,BPUT:11^BU,F:F.,PU,T/>
BYT9 <U603:01^U6062/STAT,11^O:O.,Z:Z.,U6062:11^S,U62/G,U62:ETST,S/>
;BYTE AND FLOATING INSTRUCTIONS

BYT9 <FLO:51^BYTE/F 32^ AD A/SB A/MP A/DV A:>
BYT9 <21^LMB/R,IMB/LMB:02^.,L:L.,M:M.,B:B.,BYTE:32^.,I110//,I120/,03^UF,PA/DF,N/>
BYT9 <FS C/IB P:P.,I LD/LD:LD B/I DP/DP:DP B/>

;FWT,FIXED POINT ARITH,MISC.

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

;ARITH COMP,SKIP,JUMP

BYT9 <ACCP:42^CA CA1/SJ/A JS/S JS:O 31^>
BYT9 <J COMP/S COMP/CA1:31^I COMP/M COMP/>
BYT9 <SJ:31^JUM PSJ/SKI PSJ:P COMP:>
BYT9 <03^.,L/E:E.,L E/PA/G E/N:N.,G.,>
;HALF WORDS

BYT9 <HWT:51^HW1/21^R HW2/L HW2:R HW3/HW1:>
BYT9 <21^L HW4/R HW4:L HW3:32^IMS/Z IMS/O IMS/EIMS/>

;TEST INSTRUCTIONS

BYT9 <ACBM:31^AC1/01^D AC2/S AC2/AC1:01^R AC2/L,>
BYT9 <AC2:42^N EAN/Z EAN/C EAN/O EAN:12^.,E/PA/N/>


;BOOLEAN

BYT9 <BOOLE:24^ST/AN:AND B2/AN/ST/AN/ST/>
BYT9 <X OR:OR B2/I OR/AN/EQ DV2/ST/OR/ST/OR/OR/>
BYT9 <ST:SET B2:24^Z IMB/IMB/CA:C TA/TM:M IMB/>
BYT9 <CM:C TM/TA:A IMB/IMB/IMB/CB:C BIMB/IMB/CA/>
BYT9 <CA/CM/CM/CB/O IMB/>

;INSTRUCTION GROUP 120
BYT9 <I120:11^ DMOV/ 01^ FIX,FIX2/ 21^.,FLT,FIX2: 21^. R/>
BYT9 <DMOV:DMOV,01^ E,EM// N,EM:21^. M/>

;MORE UUO'S
BYT9 <U50:03^OPE,N/TT,CAL:CAL L/...,RENAM,E/I,N/OU,T/>
BYT9 <U703:02^CLOS,E/RELEA,S/MTAP,E/UGET,F/>

;INSTRUCTION GROUP 110 - DF ARITHMETIC
BYT9 <I110:21^DF DF// ., DF:02^AD.,SB.,M P/ DV.>

REPEAT BINC,<BINRY==BINRY*400+BINRY*400>
   IFN BINRY,<EXP BINRY>
	.CREF			;TURN CREF BACK ON
   >				;END OF REPEAT 0
;THE FOLLOWING IS AN ALTERNATE SET OF MACROS FOR BUILDING THE OP
;TABLE.  THEY ASSEMBLE MUCH FASTER THAN THE ONES ABOVE. THEY ARE:
;.ADR - DECLARE TAG; .TRA - TRANSFER BYTE; .TRAX - EXTENDED TRANSFER
;BYTE; .DIS - DISPATCH BYTE; .TXT - TEXT BYTES; .END - TEXT BYTES
;FOLLOWED BY STOP BYTE.

DEFINE BYT9 (A) <
	XLIST
	IRP A,<
A>
	LIST>

   IF1,<

DEFINE .ADR (A) <
%'A== CLOC
FIR.== CLOC
DEFINE .ADR (B) <
%'B== CLOC
LASTB==CLOC+74-FIR.>>

DEFINE .TRA (A)<CLOC==CLOC+1>
DEFINE .TRAX (A)<CLOC==CLOC+2>

SYN .TRA, .DIS

DEFINE .TXT (A) <
   IFNB <A>, <IRPC A,<CLOC==CLOC+1>>>

DEFINE .END (A) <
   IFNB <A>, <IRPC A,<CLOC==CLOC+1>>
CLOC== CLOC+1>

   >				;END OF IF1
   IF2,<

DEFINE .ADR (A)<IFN %'A-CLOC,<PRINTX PHASE ERR AT: %'A>>

DEFINE .TRA (A) <OUTP %'A+74-FIR.>

DEFINE .TRAX (A),<OUTP 73
	OUTP 74+<Z1==%'A-FIR.-1000+74>
   IFL Z1,<PRINTX "A" TOO SMALL FOR .TRAX>>

DEFINE .DIS (A) <OUTP A&70/2+A&7-1>

DEFINE .TXT (A) <IFNB <A>,<IRPC A,<OUTP "A"-40>>>

DEFINE .END (A) <
   IFNB <A>, <IRPC A,<OUTP "A"-40>>
OUTP 40>

DEFINE OUTP (A)<
   IFGE <A>-1000,<PRINTX OPTABLE BYTE "A" TOO BIG>
   IFE <BINC==BINC-9>-^D27,<BINR1==A>
   IFE BINC-^D18,<BINR2==A>
   IFE BINC-9,<BINR3==A>
   IFE BINC,< BYTE (9) BINR1,BINR2,BINR3,<A>
	BINC==^D36>
CLOC==CLOC+1 >
   >
TBL:	.XCREF			;OPDECODER BYTE TABLE

CLOC== 0			;SET BYTE LOCATION COUNTER TO 0
BINC== ^D36			;INIT BYTES/WORD COUNTER

;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO
;**************TERMINATES AT THE NEXT COMMENT WITH: **************

   IFN FTDEC20,<
	BYT9 <
.DIS 63,.END,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
	.TXT H,.TRA HWT,.TXT T,.TRA ACBM>
   >				;END FTDEC20

   IFE FTDEC20,<
	BYT9 <
.DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
	.TXT H,.TRA HWT,.TXT T,.TRA ACBM>
   >				;END FTDEC20

	BYT9 <

;IO INSTRUCTIONS

.DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O
.ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O
	.ADR OI,.DIS 01,.TRA O,.TRA I
;UUOS

.ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60
	.DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01
.TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O
.ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I
.ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT
	.ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T
.ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT
	.ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S

;BYTE AND FLOATING INSTRUCTIONS

.ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB
	.TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A
.DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT
	.ADR L,.END L,.TXT,.ADR M,.END M,.TXT
.ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.TRAX I100,.TRAX I110,.TRA I120,.TXT
	.DIS 03,.TXT UF,.TRA PA,.TXT DF,.TRA N
.TXT FS,.TRA C,.TXT IB,.ADR P,.END P,.TXT,.TXT I,.TRA LD
	.ADR LD,.TXT LD,.TRA B,.TXT I,.TRA DP,.ADR DP,.TXT DP,.TRA B
;FWT-FIXED POINT ARITH-MISC

.ADR HAK,.DIS 33,.TRA MV,.ADR MV,.TXT MOV,.TRA MO,.TRA ML,.TRA DV
	.TRA SH,.TRA H1,.TRA JP
.DIS 21,.TXT ADD,.TRA IMB,.TXT SU,.ADR BIMB,.TXT B,.ADR IMB,.DIS 02,.END,.TXT
	.ADR I,.END I,.TXT,.TRA M,.TRA B,.ADR MO,.DIS 22
.ADR EIMS,.TXT E,.TRA IMS,.TXT S,.TRA IMS,.TXT N,.TRA IMS,.TXT M
	.ADR IMS,.DIS 02,.END,.TXT,.TRA I,.TRA M,.ADR S,.END S,.TXT
.ADR ML,.DIS 21,.TXT I,.TRA ML1,.ADR ML1,.TXT MUL,.TRA IMB
	.ADR DV,.DIS 21,.TXT I,.TRA DV1
.ADR DV1,.TXT DI,.ADR DV2,.TXT V,.TRA IMB,.ADR H1,.DIS 03,.TXT EXC,.TRA S3,.TXT BL
	.ADR T,.END T,.TXT,.TRA AO,.ADR AO,.TXT AOBJ
.TRA AOB,.TXT JRS,.TRA T,.TXT JFC,.TRA L,.TXT XC,.TRA T,.TXT MA,.TRA P
	.ADR AOB,.DIS 01,.TRA P,.TRA N
.ADR JP,.DIS 03,.TRA PU,.ADR PU,.TXT PUSH,.TRA PUS,.TRA PO
	.ADR PO,.TXT POP,.TRA POP,.TXT JS,.ADR R,.END R,.TXT
.TXT JS,.TRA P,.TXT JS,.ADR PA,.END A,.TXT,.TXT JR,.TRA PA
	.ADR PUS,.DIS 01,.ADR J,.END J,.END,.TXT,.ADR POP
.DIS 01,.END,.TXT,.TRA J,.ADR SH,.DIS 02,.TXT A,.TRA S2,.TXT ROT,.TRA S1,.TXT L
	.ADR S2,.TXT S,.ADR S3,.TXT H,.TRA S1,.DIS 21,.TXT JFF,.TRA O,.END
	.ADR S1,.DIS 21,.END,.TXT,.ADR C,.END C,.TXT

;ARITH COMP-SKIP-JUMP

.ADR ACCP,.DIS 42,.TXT CA,.TRA CA1,.TRA SJ,.TXT A,.TRA JS,.TXT S
	.ADR JS,.TXT O,.DIS 31
.TXT J,.TRA COMP,.TXT S,.TRA COMP,.ADR CA1,.DIS 31,.TXT I,.TRA COMP,.TXT M,.TRA COMP
.ADR SJ,.DIS 31,.TXT JUM,.TRA PSJ,.TXT SKI,.ADR PSJ,.TXT P,.ADR COMP
.DIS 03,.END,.TXT,.TRA L,.ADR E,.END E,.TXT,.TXT L,.TRA E,.TRA PA,.TXT G,.TRA E
	.ADR N,.END N,.TXT,.END G,.TXT
;HALF WORDS

.ADR HWT,.DIS 51,.TRA HW1,.DIS 21,.TXT R,.TRA HW2,.TXT L,.ADR HW2,.TXT R,.TRA HW3
.ADR HW1,.DIS 21,.TXT L,.TRA HW4,.TXT R,.ADR HW4,.TXT L
	.ADR HW3,.DIS 32,.TRA IMS,.TXT Z,.TRA IMS,.TXT O,.TRA IMS,.TRA EIMS

;TEST INSTRUCTIONS

.ADR ACBM,.DIS 31,.TRA AC1,.DIS 01,.TXT D,.TRA AC2,.TXT S,.TRA AC2
	.ADR AC1,.DIS 01,.TXT R,.TRA AC2,.TXT L
.ADR AC2,.DIS 42,.TXT N,.TRA EAN,.TXT Z,.TRA EAN,.TXT C,.TRA EAN,.TXT O
	.ADR EAN,.DIS 12,.END,.TXT,.TRA E,.TRA PA,.TRA N

;BOOLEAN

.ADR BOOLE,.DIS 24,.TRA ST,.ADR AN,.TXT AND,.TRA B2,.TRA AN,.TRA ST,.TRA AN,.TRA ST
.TXT X,.ADR OR,.TXT OR,.TRA B2,.TXT I,.TRA OR,.TRA AN,.TXT EQ
	.TRA DV2,.TRA ST,.TRA OR,.TRA ST,.TRA OR,.TRA OR
.ADR ST,.TXT SET,.ADR B2,.DIS 24,.TXT Z,.TRA IMB,.TRA IMB
	.ADR CA,.TXT C,.TRA TA,.ADR TM,.TXT M,.TRA IMB
.ADR CM,.TXT C,.TRA TM,.ADR TA,.TXT A,.TRA IMB,.TRA IMB,.TRA IMB
	.ADR CB,.TXT C,.TRA BIMB,.TRA IMB,.TRA CA
.TRA CA,.TRA CM,.TRA CM,.TRA CB,.TXT O,.TRA IMB
;INSTRUCTION GROUP 120
.ADR I120,.DIS 11,.TRAX DMOV,.DIS 01,.TXT FIX,.TRAX FIX2,.DIS 21,.END EXTEND
	.TXT FLT,.ADR FIX2,.DIS 21,.END,.TRA R
.ADR DMOV,.TXT DMOV,.DIS 01,.TXT E,.TRAX EM,.TXT N
	.ADR EM,.DIS 21,.END,.TRA M

;MORE UUO'S

.ADR U50,.DIS 03,.TXT OPE,.TRA N,.TXT TT,.ADR CAL,.TXT CAL,.TRA L,.END,.END,.END
	.TXT,.TXT RENAM,.TRA E,.TXT I,.TRA N,.TXT OU,.TRA T
.ADR U703,.DIS 02,.TXT CLOS,.TRA E,.TXT RELEA,.TRA S
	.TXT MTAP,.TRA E,.TXT UGET,.TRA F

;INSTRUCTION GROUP 110 - DF ARITHMETIC
.ADR I110,.DIS 21,.TXT DF,.TRAX DF,.TXT D,.TRAX FXDP,.ADR DF,.DIS 02
	.END AD,.END SB,.TXT M,.TRA P,.END DV

;KL10 FIXED POINT DOUBLE PRECISION OPERATIONS
.ADR FXDP,.DIS 02,.END ADD,.END SUB,.END MUL,.END DIV

;OPCODES 100 TO 107 COME HERE
.ADR I100,.DIS 21,.END,.DIS 02,.END,.END ADJSP,.END,.END
;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT******
   >

   IF1,< BLOCK <CLOC+3>/4>
   IF2,< IFN BINC-^D36,<BYTE (9) BINR1,BINR2,BINR3,0> >

   IFNDEF CLOC.,<CLOC.==CLOC>
   IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>

	.CREF			;TURN CREF BACK ON
BTAB:	POINT 9,TBL		;TABLE USED TO GET NEXT BYTE POINTER
	POINT 9,TBL,8		;FOR TRANSFER BYTE
	POINT 9,TBL,17
	POINT 9,TBL,26

OPEVAL:	MOVEI T,0		;EVALUATE FOR AN OP CODE
	IDPB T,CHP		;INSERT NULL IN TEXT FOR SYMBOL
	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
	CLEARB R,W1
	MOVE W2,BTAB
DC1:	ILDB T,W2		;GET NEXT BYTE IN TBL
	CAILE T,40
	CAIL T,74
	SOJGE R,DC1		;SKIP OVER # BYTES = C(R)
	JUMPG R,DC1		;SKIP OVER ALPHA TEXT (AND EXTEND BYTES) 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)		;TOTAL SUBTRACTED NOW IS 73
	JUMPL T,DECT		;TYPE OUT A LETTER
	JUMPG T,DC3		;XFER IF BYTE .GE. 74
	ILDB T,W2		;BYTE IS EXTEND BYTE (73), GET NEXT
	MOVEI T,1000-74*2+1(T)	; BYTE AND ADD IN EXTENSION (-OFFSET)
DC3:	MOVEI W1,FIR.-1(T)	;BYTE IS AN XFER (1ST XFER IS 74)
	IDIVI W1,4
	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
	LDB R,[POINT 3,T,8]
	TLC T,700000
	TLCN T,700000
	DPB R,[POINT 10,T,12]	;ONLY DONE FOR IO INSTRUCTIONS
	JRST CPOPJ1		;SYMBOL FOUND, SKIP RETURN

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

	XLIST
	LIT
	LIST
END.C:				;END OF CODE

SUBTTL VARIABLE STORAGE

   IFN FTDEC20,< IFDEF VARLOC,<
PHVAR:	PHASE VARLOC>>		;PHASE VARIABLES FOR UDDT AND MDDT

BEG.V:				;BEGINNING OF VARIABLES
NM1A:	MOVEI W2,0
ACCCF:	MOVEI T,.-.		;LEFT HALF OF A,,B
SEAR2:	JUMPE T,SEAR3		;OR JUMPN T
TOCS:	MOVEI T,.-.		;GET RIGHT HALF BACK

;VARIABLES FOR LINE BUFFER INPUT

TEXINF:	0			;NON-0 FOR TEXT INPUT MODE
CHINC:	0			;COUNT OF CHARACTERS
WAKALL:	0			;NON-0 TO WAKEUP ON EVERYTHING
;*** DO NOT REORDER THE FOLLOWING ***
TEXTIB:	10			;TEXTI ARG BLOCK - SIZE
   IFN FTDEC20,<
	RD%BRK+RD%TOP+RD%PUN+RD%RND+RD%JFN+RD%BBG+RD%SUI ;FLAGS
	.PRIIN,,.PRIOU		;INPUT/OUTPUT JFNS
   >
CHINP:	0			;POINTER TO NEXT CHAR
LINSPC:	0			;FREE SPACE COUNT
LINDB:	POINT 7,LINBF		;BEGINNING OF BUFFER
LINBP:	POINT 7,LINBF		;BEGINNING OF ^R BUFFER
ETXTB:	0			;WAKEUP TABLE (ALL ONES)
	0			;BACKUP LIMIT POINTER
;***END OF "DO NOT REORDER" BLOCK***

   IFN ^-FTDEC20!<FTEXEC&FTEDIT>,<
SAVCHR:	0			;PRESET RESULT FOR NEXT CALL TO RDBIN
LASCHR:	0			;ANSWER FROM LAST CALL TO RDBIN
   >

NLINBF==^D20
LINBF:	BLOCK NLINBF		;LINE BUFFER
	SUBTTL STORAGE -- $X LOGIC AND PATCH COMMAND

   IFE FTFILE,<
;VARIABLES USED IN $X LOGIC

I.XCT:	XCT I.NST
I.NST:	0			;INSTRUCTION BEING EXECUTED
SAV0:	0			;SAVES AC 0 IN SWAP ROUTINE
XCTS:	0			;XCT DEPTH COUNTER
I.NSTAC:0			;AC FIELD OF INST BEING EXECUTED
I.NSTEA:0			;E FIELD OF INST BEING EXECUTED
XTEM:	0			;$X REPEAT COUNTER
I.NSTPC:0			;PC OF INST BEING EXECUTED
FLAGS:	0			;SAVES DDT FLAG REGISTER
LOCSAV:	0			;SAVES LOCATION OF INST BEING EXECUTED
SAFETY:	0			;SAVES T
   >				;END FTFILE

;VARIABLES FOR PATCH COMMAND

PTLOC:	0			; SOURCE OF PATCH ADR ,, PATCH ADR
PTLLC:	0			; BEFORE/AFTER FLAG ,, OLD LLOCO
PTWRD:	0			; ORIGINAL WORD AT OLD LLOCO
	SUBTTL  STORAGE -- BREAKPOINTS
   IFE FTFILE,<
SAVE:	0			;SAVE THE ACS AND PI SYSTEM
	JRST SAVEG

BP1:	REPEAT NBP,<
	0			;JSR TO HERE FOR BREAKPOINT
	JSR BCOM
	0			;HOLDS INSTRUCTION WHILE BREAKPOINT IS IN PLACE
   >

B1INS=BP1+2
BPN=.-3
BCOM:	0
	JRST BCOMG
BCOM3:	SKIPE 0			;ADDR MOD TO LOOK AT COND. INST.
BCOM2:	SOSG 0			;ADDR MOD TO LOOK AT PROCEED COUNTER

CSECT:	0			;NON-0 (CURRENT SECTION) IF EXT ADDRESSING
LEAV0:	0			;FIRST WORD OF 2-WORD PC IN EXT ADR
LEAV1:	XWD 0,LEAVG
BREAK2:	ROT S,.-.		;ROT BY # OF BREAK POINT
PROC0:	HRRZI R,XEC1		;MODIFIED TO ADDR OF BREAKPOINT
LEAV:	0			;INSTRUCTION MODIFIED
CPUSHP:	PUSH .-.,BCOM		;GETS MODIFIED IN AC FIELD
SWAP:	0
	JRST SWAPG
   >				;END IFE FTFILE

SVBTS:	0
SVBTS2:	0
OLDAR:	0
SVBT3:	0
SVBT2:	0
PSVBTS:	BLOCK 3
	SUBTTL STORAGE -- SYMBOL TABLE LOGIC

PNTR:	EXP 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
WRD:	0
WRD2:	0
PRNC:	0

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

SAVHSM:	BLOCK 1			;C(.JBHSM), USED BY EVAL, LOOK
SEGNAM:	0			;THE HIGH SEGMENT NAME (OR 0)
				;WHEN $: IS SUCCESSFULLY DONE
PRGM:	0
ESTUT:	0
FSV:	0
FH:	0
SYM:	0
   IFE FTDEC20,<
   IFE FTFILE,<
SYMP:	Z .JBSYM		;POINTS TO LOW SEG SYM TABLE POINTER
USYMP:	Z .JBUSY		;POINTS TO UNDEF SYM TABLE POINTER
   >
   IFN FTFILE,<
SYMP:	Z FISPTR
USYMP:	Z FIUPTR
   >>
   IFN FTDEC20,<
   IFN FTEXEC,<
SYMP:	Z .JBSYM
USYMP:	Z .JBUSY>
   IFE FTEXEC,<
SYMP:	Z .DDSYM
USYMP:	Z .DDUSY
   >
JDTFLG:	-1			;JOB DATA AREA VALID IF NON-0
   >				;END IFN FTDEC20
SYMPNT:	0			;USED BY SYM TABLE SEARCHES
SPSAV:	0			;POINTER TO LAST SYMBOL TYPED
DEFV:	0
ULIMIT:	0
LLOC:	0
LLOCO:	0
SAVLP:	0			;POINTER TO SAVLOC TABLE
NSAVTB==20			;SIZE OF SAVLOC TABLE (RING BUFFER)
SAVLTB:	BLOCK NSAVTB		;SAVLOC TABLE
SYMORD:	0			;HOLDS ADDRESSES OF EVAL-OPEVAL ROUTINES
				;SPECIFYING WHICH ORDER TO SEARCH THEM FOR SYMBOLS
QLPNT:	0			;USED IN "QLIST" AS POINTER TO A SYMBOL
LCNT:	12			;USED IN LISTEN
SKPCT:	0			;SKIP COUNT FOR XCT
EFAFLG:	0			;EFF ADR COMP MODE
   IFN FTEXEC!FTFILE,<
EPTUPT:	0			;LH - EPT POINTER , RH - UPT POINTER
PTDFLG:	0			;EOF SEEN ON COMMAND FILE
   >
	SUBTTL STORAGE -- SAVE AREAS FOR PREVIOUS CONTEXT

   IFE FTFILE,<
SAVAPR:	0			;USED TO SAVE APR REGISTER IN EXEC MODE
SAVPI:	0
	1177

;THESE LOCATIONS MUST BE IN ORDER - THEY ARE USED TO SAVE AND
;RESTORE THE STATE OF DTE FOR KL10

SAVTTY:	0
   IFN FTEXEC,<
SAVUNS:	0
SAVEPW:	0
SAVERW:	0
SAVDPW:	0
SAVDRW:	0

SAVEBR:	0			;SAVED EXEC BASE REG
MTRCNI:	0			;RESULT OF CONI MTR,
TIMCNI:	0			;RESULT OF CONI TIM,
MSTRDT:	0			;ID OF MASTER -11
DING11:	0			;PROTOTYPE CONO WORD FOR DTE
   >				;END IFN EDDT

   IFN FTDEC20,<
SAVTT2:	0
SAVTT3:	0
LASTPG:	0
SAVSTS:	0
   >				;END IFN FTDEC20
   >				;END IFE FTFILE
MSK:	XWD -1,-1
   IFN FTEXEC,<			;CELLS FOR TRACE FACILITY
TRCON:	0			;ASSUMED AT $M+1
TRCDMP:	0>			;ASSUMED AT $M+2
   IFE FTFILE,<
B1ADR:	0
B1SKP:	0
B1CNT:	0

REPEAT NBP*3-3, < 0>

BNADR=.-3
AUTOPI:	0

AC0:	BLOCK 17

AC17:	0
   >
	SUBTTL STORAGE -- STATE VARIABLES

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

SARS:	0
TEM:	0
TEM1:	0

NSYMCS==40			;SIZE OF SYMBOL TABLE CACHE
SYMCSH:	BLOCK NSYMCS		;SYMBOL TABLE CACHE
SYMCSP:	BLOCK 1			;POINTER TO NEXT FREE ENTRY
OLDSYM:	BLOCK 1			;REMEMBER CACHE SYMBOL TABLE
   IFN FTEXEC!FTMON,<
USRFLG:	0			;-1 IN USER MODE, 0 IN EXEC MODE
KAFLG:	0			;0 FOR KI10; 1,,0 FOR KA10 OR PDP-6
XNXTCH:	0			;PRESET INPUT CHAR AT XLISTE
   >				;END IFN FTEXEC
SMFLAG:0			;0 IF NOT SM10
   IFN FTFILE,<			;FILDDT STUFF
FWAZER:!			;START OF AREA TO ZERO
FILDEV:	BLOCK 3			;OPEN BLOCK FOR CRASH FILE
FILBLK:	BLOCK 4			;LOOKUP BLOCK FOR CRASH FILE
LBUF:	BLOCK 3
SYMGET:	Z			;-1 IF /S, 0 IF NOT
CRASHS:	Z			;-1 IF CRASH.SAV ON DISK ,0 IF PEEK AT MONITOR
FDIDOT:	Z			;-1 IF . TYPED IN, 0 IF NOT
PATCHS:	Z			;-1 IF PATCHING MODE
CHGSFL:	Z			;CHANGED SYMBOL TABLE
AC0=.
AC17=.+17
CRSHAC:	BLOCK 20		;CRASH AC'S
FETPAG:	BLOCK 1			;ADDRESS OF PAGTBL ENTRY FOR LAST
				; CALL TO FETCH
FETADR:	BLOCK 1			;INCORE ADDRESS OF DATA WORD FROM LAST
				; CALL TO FETCH
WINNUM:	BLOCK 1			;WINDOW TO READ OR WRITE
WINDIR:	BLOCK CT.RES		;ADDRESS OF PAGTBL ENTRY FOR
				; EACH WINDOW SLOT
PAGTBL:	BLOCK MX.SIZ		;1 WORD FOR EVERY VIRT. PAGE
				;BITS 0-4 .EXE FORMAT FLAGS
				;BIT 5 PAGE IN CORE CHANGED
				;BITS 9-17 WINDOW # PLUS 1
				;RH - FILE PAGE NUMBER
WIND0:	BLOCK CT.RES*1000	;WINDOWS
XPNFMT:	BLOCK 1			;FILE IS IN .XPN FORMAT
LWAZER==.-1			;END OF AREA TO ZERO

FISPTR:	Z			;POINTER TO SYMBOLS
FIUPTR:	Z			;POINTER TO UNDEF SYMS

MONSIZ:	BLOCK 1			;HIGHEST LOC+1 IN CRASH.SAV FILE
				;(USED SO WE WON'T EXAMINE PAST END)
SAVEFF:	Z			;WHERE TO LOAD SYMBOLS IF /S
   >				;END IFN FTFILE
	SUBTTL STORAGE -- PUSH DOWN LIST

PDL:	BLOCK LPDL		;STORAGE FOR PUSH DOWN LIST

END.V==.