Google
 

Trailing-Edge - PDP-10 Archives - mit_emacs_170_teco_1220 - emacs/iddt.mac
There is 1 other file named iddt.mac in the archive. Click here to see a list.
; <GERGELY.NEMACS>NDDT.MAC.10, 19-Feb-82 09:27:48, Edit by GERGELY
; Increase the breakpoints and fix the blank screen to work at DREA
;<SOURCES>NDDT.MAC;6 19-Mar-81 14:39:03, Edit by MMCM
;FIX TENEX ASSEMBLY
;<SYS.UNSUPPORTED>NDDT.MAC.180, 1-Nov-80 18:32:00, Edit by TAA
; Update JSYS table
;<SYS.UNSUPPORTED>NDDT.MAC.179, 24-Sep-80 21:00:32, Edit by MT
; If error string not found for ;?, say so and show number
;<SYS.UNSUPPORTED>NDDT.MAC.178, 17-Aug-80 02:36:49, Edit by MT
; Put ERJMPs after STIWs so can be used under batch (with no ^C cap)
;<SOURCES.UNSUPPORTED>NDDT.MAC.175, 11-May-80 16:15:56, Edit by MT
; Make file commands require confirmation
; Change $B to delete current bpt, $$B deletes all
;<SOURCES.UNSUPPORTED>NDDT.MAC.173, 15-Apr-80 00:33:35, Edit by MT
; Fondle TIW
;<SOURCES.UNSUPPORTED>NDDT.MAC.172, 14-Apr-80 21:19:47, Edit by MT
; Made some typeouts prettier
; Fixes in fork handling for release 4
; Changed around reason table so it knows about quota exceeded
;<SOURCES.UNSUPPORTED>NDDT.MAC.170, 14-Apr-80 16:22:36, Edit by MT
; Made ;R work
;<SOURCES.UNSUPPORTED>NDDT.MAC.169,  9-Apr-80 14:08:45, Edit by MT
; Leave LH(1) 0 in RFSTS calls for Rel4
;<SOURCES.UNSUPPORTED>NDDT.MAC.168,  8-Apr-80 17:31:40, Edit by MT
; Don't SETNM to weird things
;<SOURCES.UNSUPPORTED>NDDT.MAC.167, 10-Mar-80 17:28:40, Edit by MT
; Updated JSYS table 
;<SOURCES.UNSUPPORTED>NDDT.MAC.166,  9-Mar-80 20:15:12, Edit by MT
; Don't lose when opening cells in nonexistant pages
;<SOURCES.UNSUPPORTED>NDDT.MAC.165,  7-Mar-80 03:14:36, Edit by MT
; Don't lose in ;J if JFN is unassigned
;<SOURCES.UNSUPPORTED>NDDT.MAC.164,  5-Mar-80 16:36:12, Edit by MT
; take care of <arg>^[ and altmoded equivalents
;<SOURCES.UNSUPPORTED>NDDT.MAC.163,  4-Mar-80 00:30:33, Edit by MT
; Try looking for PAT.. of PATCH not found
; Take care of $^[ and $$^[ properly
; DEP will always try to unprotect page if neccessary
; Bug fixes in 8 and 9 bit text typeout
;<HIC>IDDT.MAC	    9-June-78 		Edit by HIC
; Finish adding ^N single stepping mode to look like ITS DDT.
; Add $. which returns the current PC.
; Default escape character is now ^D
;<MMCM>IDDT.MAC.35, 19-Apr-78 22:57:40, Edit by MMCM
; Fix up CR after LF lossage for rel 3
;<MMCM>IDDT.MAC.34, 27-Dec-77 23:19:23, Edit by MMCM
; Added address break command ($$U) and related trap stuff
;<MMCM>IDDT.MAC.33, 14-Aug-77 22:11:13, Edit by MMCM
; Changes for Tops20 Jsys traps calling sequence
;<MMCM>IDDT.MAC.32, 19-Mar-77 06:51:30, Edit by MMCM
; Fixed multiple single stepping aobjn's
; Fixed ;;U and tag: incompatibility
;<MMCM>IDDT.MAC.30,  7-Mar-77 01:25:48, Edit by MMCM
; Changed to use Tops20 editting conventions
;<MMCM>IDDT.MAC.29, 26-Feb-77 01:15:03, Edit by MMCM
; Added KL opcodes
;<MMCM>IDDT.MAC.28, 15-Feb-77 15:39:35, Edit by MMCM
; Added tops20 jsys's and fixed up single stepping after breakpoint.
;<MMCM>IDDT.MAC;109   8-Jan-77 21:05:30    EDIT BY MMCM
; Added $Y single stepping
;<MMCM>IDDT.MAC;108	  7-Jan-77 02:47:02    EDIT BY MMCM
; Added $J single stepping, fancy editting (delch);
; Made levtab, etc. typeout symbolic
;<MMCM>IDDT.MAC;108	  6-Jan-77 00:53:23    EDIT BY MMCM
; Added various isi bug fixes and ;;jobstat and ;interrupt status
;<SOURCES>IDDT.MAC;46     1-Dec-76 13:59:29    EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;45     1-Dec-76 12:11:24    EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;44     1-Dec-76 11:35:30    EDIT BY PLUMMER
; FIX CHKA3A TO AVOID CHACING @ PTRS ALL THE WAY INTO FILE
; FIX 0$NB TO WORK.
;<SOURCES>IDDT.MAC;43     8-Nov-76 17:59:38    EDIT BY PLUMMER
; FIX UP / SO / AFER EXAMINE OF CELL WITH 1B5 ON WORKS
;<SOURCES>IDDT.MAC;42    13-Sep-76 17:01:18    EDIT BY PLUMMER
; $9T MODE FOR BCPL STRINGS AND $8T FOR NETBUFS ETC
; GIVE PROPER ERRORS IF BPTS CANNOT BE INSERTED OR REMOVED
; CONVERT TO KL20 PMAP AND TTY STUFF
; BIG CHANGES TO CHKADR
;<SOURCES>IDDT.MAC;41     6-Jul-76 11:57:23    EDIT BY PLUMMER
; FIX PRFRK TO SAVE W OVER CALLS TO FSTAT
;<SOURCES>IDDT.MAC;38    16-Jun-76 12:03:58    EDIT BY PLUMMER
; TURN ON FORKSTAT CODE
;<SOURCES>IDDT.MAC;35    11-Jun-76 16:00:12    EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;34    11-Jun-76 15:52:22    EDIT BY PLUMMER
; REPAIRS TO FORK STAT, ^T, INOUT, BREAKPOINT SETTER
; MAKE N;;F BE FORK SELECTION.  ;F TOTAL FORKSTAT, N;F SPECIFIC FORKSTAT
;<SOURCES>IDDT.MAC;33    10-Jun-76 14:44:53    EDIT BY PLUMMER
; FIX UP FORKSTAT
;<SOURCES>IDDT.MAC;32     9-Jun-76 14:37:04    EDIT BY PLUMMER
;<PLUMMER>IDDT.MAC;23     9-Jun-76 14:01:44    EDIT BY PLUMMER
; REVISE THE HFK: CASE AGAIN
;<PLUMMER>IDDT.MAC;22     9-Jun-76 12:57:37    EDIT BY PLUMMER
; INIT MAIN STACK AT SPLICD ENTRY SO THAT CALL SETTRP WILL WORK
;<PLUMMER>IDDT.MAC;21     9-Jun-76 11:51:22    EDIT BY PLUMMER
;<PLUMMER>IDDT.MAC;20     8-Jun-76 17:48:59    EDIT BY PLUMMER
; ;;U COMMAND TO COPY IDDT SYMTAB TO USER SPACE AND THEN DO A ;U
; ;Y ETC SET $X LOCATION FROM DEFINITION OF PAT..
; ;;U DEFINES PAT.. FROM VALUE IN $X TO PRESERVE PATCHES
;<PLUMMER>IDDT.MAC;17     4-Jun-76 12:13:15    EDIT BY PLUMMER
; FIX UUO INTERPRETER, ADD INTERPRETER FOR USER JSYS'S
;<PLUMMER>IDDT.MAC;16     3-Jun-76 23:38:52    EDIT BY PLUMMER
; CHANGE SEQUENCE SAVING LOGIC IN SLASH
;<PLUMMER>IDDT.MAC;12     3-Jun-76 13:45:04    EDIT BY PLUMMER
; NEWFRK: MOVE FFORK AFTER CALL SETTRP TIL JSYS TRAP BUG FIXED
;<PLUMMER>IDDT.MAC;11     3-Jun-76 10:24:11    EDIT BY PLUMMER
; SOUP IN ALL OF TOMLINSON'S MULTI-FORK CODE
;<PLUMMER>IDDT.MAC;7     2-Jun-76 14:56:59    EDIT BY PLUMMER
; ;JFN STATUS COMMAND
;<PLUMMER>IDDT.MAC;3     2-Jun-76 12:01:34    EDIT BY PLUMMER
; UPDATE JSYS TABLE
; ^T TYPES GROUP LOAD INSTEAD OF LOAD AV.
; ^T AND ;V VIEW CELL LOGIC
; JSYS INSTRUCTION TYPER EVALUATES EFFECTIVE ADDRESS
; <PAGE>;A COMMAND
; FIX INTERPRETATION OF PUSHJ AND POV
; USE DEBRK .+1 RATHER THAN CIS AT ENTRIES
; FIX THE HANDLING OF INTERRUPTS FROM HALTED FORKS
;<SOURCES>IDDT.MAC;31     1-APR-74 16:06:45	EDIT BY PLUMMER
; FIX THE ^T "RUNNING AT ?" BUG
;<SOURCES>IDDT.MAC;30    21-MAR-74 12:36:28	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;29    20-MAR-74 13:12:54	EDIT BY PLUMMER
; ADD "LOCKED BY USER" TYPEOUT TO ;A
;<SOURCES>IDDT.MAC;28    20-MAR-74 12:37:50	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;27    19-MAR-74 00:19:33	EDIT BY PLUMMER
; FIX ;S (MISSING INSTR DUE TO NEW ;? CODE)
; TEXT INPUT INTERRUPTIBLE
; DONT FLUSH BPT'S AFTER ^C REENTER OUT OF USER PROG.
; JSYS DEFS FOR JSYS TRAP INSTRS
; ADD ^T ROUTINE
;<SOURCES>IDDT.MAC;22    12-MAR-74 00:30:11	EDIT BY PLUMMER
; $$Z FIXED (AGAIN)
; $P AFTER HALTF, HFORK CONTINUES PROGRAM (AGAIN)
;<SOURCES>IDDT.MAC;21    11-MAR-74 23:59:16	EDIT BY PLUMMER
 ;?  COMMAND
; FIX ;M
; ADD VERSION NUMBER STUFF
;<SOURCES>IDDT.MAC;17    23-AUG-73 10:58:55	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;16    23-AUG-73 01:23:56	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;15    23-AUG-73 00:34:42	EDIT BY PLUMMER
; $X ETC, PUSHES THE BREAK INSTRUCTION
; PDL OVF DURING PUSHJ INTERPRET DOES IIC ON USER'S POV CHN
; FLUSH SFORKS
; FLUSH SYMP POINTER TO LOCATION CONTAINING SYMPTR
; POLISH FLOATING FRACTION GATHERING
;<SOURCES>IDDT.MAC;13    14-AUG-73 12:03:15	EDIT BY PLUMMER
; RUBOUT DOES CIS
; CIS'S RATHER THAN DEBRK TO .+1
; FORK TERMINATION NO LONGER AN INTERRUPT
; FIX FLOATING INPUT BUG IN "POWER"
;<SOURCES>IDDT.MAC;12     3-JUN-73 20:39:35	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;11     1-JUN-73 00:04:40	EDIT BY PLUMMER
; FIX FLSSYM -- HRL'S SHOULD HAVE BEEN HRLI'S
;<SOURCES>IDDT.MAC;10    17-APR-73 10:46:42	EDIT BY PLUMMER
; GET SYMS IF NONE BEFORE AT INIT3
; JOBSYM INITIALLY 0 IN LEFT HALF NOW
;<SOURCES>IDDT.MAC;9    13-APR-73 11:11:08	EDIT BY PLUMMER
; REPAIR ESCAPE CHR DETECTION IN GETC
; ADD CIS AT INTERRUPT OUT OF USER
;<SOURCES>IDDT.MAC;8    11-APR-73 15:35:39	EDIT BY PLUMMER
; FIX $$B
; FIX AUTO PROCEED SO THAT IT SEES INTERRUPTS
;<SOURCES>IDDT.MAC;7    10-APR-73 22:30:19	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;6    10-APR-73 13:38:34	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;5     4-APR-73 01:09:59	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;4     4-APR-73 00:23:33	EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;3     4-APR-73 00:10:12	EDIT BY PLUMMER
; CLEANUP START/REENTER/SPLICD ENTRIES
;<SOURCES>IDDT.MAC;2     3-APR-73 23:53:32	EDIT BY PLUMMER
; ^A FEATURE FOR ATOMS
; REPAIR SEARCHS
; REPAIR BPT INSERT/REMOVE
; FLUSH TEST AND COMPARE MACROS, FIX EA CALC ON $P
; DO ATI IN ;E ROUTINE
; ALLOW ;E TO TYPE IN ESCAPE CHR
; REMOVE EXTRA INSTRUCTIONS AT TBRK
; USE SIN FOR ;O
; USE SOUT FOR ;W
; FIX ;O AND ;W TYPEOUTS
;<2SOURCES>IDDT.MAC;290     8-MAR-73 10:29:42	EDIT BY PLUMMER
;<2SOURCES>IDDT.MAC;289     7-MAR-73 23:06:11	EDIT BY PLUMMER
; REARRANGE CALLS TO TEXT TYPERS IN FILE COMMANDS
; MORE PATCH MODE STUFF
;<2SOURCES>IDDT.MAC;288     7-MAR-73 21:31:08	EDIT BY PLUMMER
; RUBDVOUT'S TYPED IN WHILE IN IDDT BEHAVE LIKE THE ESCAPE CHR
;<2SOURCES>IDDT.MAC;287     7-MAR-73 15:23:34	EDIT BY PLUMMER
;<2SOURCES>IDDT.MAC;285     5-MAR-73 22:49:06	EDIT BY PLUMMER
; PATCH MODE STUFF STARTED
;<2SOURCES>IDDT.MAC;279     1-MAR-73 13:40:55	EDIT BY PLUMMER
; "GETJFN" ROUTINE THAT ALLOWS ESCAPE CHAR TO BE TYPED IN
; ALLOW ^C ETC FOR ESCAPE CHR
; REMOVED OLD FLAG "SBF" -- NOT USED
;<2SOURCES>IDDT.MAC;277    28-FEB-73 17:41:08	EDIT BY PLUMMER
; SWITCH BACK TO ONLY ONE INTERRUPT CHR (MOBY CHANGE)
;<2SOURCES>IDDT.MAC;274    27-FEB-73 22:32:11	EDIT BY PLUMMER
; FLUSH UNCOMMON DEF A AC'S B AND C
;<2SOURCES>IDDT.MAC;273    23-FEB-73 17:15:55	EDIT BY PLUMMER
; RE-DID THE CFIBF/CFOBF AT INTERRUPT SITUATION
;<2SOURCES>IDDT.MAC;272    21-FEB-73 17:16:46	EDIT BY PLUMMER
; ;R CLEARS SEMI FLAGS, FORKSTAT CALLS TYPE, MOVE PATCH SPACE
; CHANGE RELOC'S, SAY "IDDT" UPON HALTF ETC FROM USER
; RUBOUT FROM USER AND ERRORS CLEAR TYPE-AHEAD
;<2SOURCES>IDDT.MAC;271    20-FEB-73 22:19:47	EDIT BY PLUMMER
; "." HANDLED PROPERLY WHEN INSIDE IDDT
; /, [, ], !, AND \ DON'T SAVE OLD SEQUENCE
; $X MOVED TO LOCATION 20
;<2SOURCES>IDDT.MAC;267    19-FEB-73 14:36:58	EDIT BY PLUMMER
; GET SYMS AFTER ANY KIND A ENTRY
; READY FOR BPT'S TO REPORT AS STATUS 6
; BACK TO OLD "SETUP" FOR $$Z
; FLUSH "ZLOW" PARAMETER
; SWITCH TO CALL AND RET
;<2SOURCES>IDDT.MAC;266     6-FEB-73 00:00:19	EDIT BY PLUMMER
; FIX $$Z
;<2SOURCES>IDDT.MAC;265     1-FEB-73 23:38:39	EDIT BY PLUMMER
; ADDED SEMICOLON SPACE COMMAND -- LIKE OLD ;
;<2SOURCES>IDDT.MAC;264    17-JAN-73 18:09:46	EDIT BY PLUMMER
; CHANGE DEPOSIT TO REMEMBER RIGHT ACCESS
; ADRSPC UNMAPS USER PAGE
;<2SOURCES>IDDT.MAC;263    14-JAN-73 21:55:27	EDIT BY PLUMMER
; HALTF, HFORK ARE PROCEDABLE
; CHANGE COC WORDS
; FIXED SWITCHING BETWEEN USER AND IDDT
; IDDT CHANGES ACCESS OF USER'S PAGE SO BPT'S ETC. NEVER FAIL
;  TO GO IN OR COME OUT
;<2SOURCES>IDDT.MAC;259    14-JAN-73 17:37:35	EDIT BY PLUMMER
;<2SOURCES>IDDT.MAC;257    14-JAN-73 16:26:55	EDIT BY PLUMMER
; ADDR;S  COMMAND
; PROVISIONS MADE FOR "SPLICED" ENTRY FROM EXEC
;<2SOURCES>IDDT.MAC;251     9-JAN-73 14:41:50	EDIT BY PLUMMER
; UPDATE JSYS TABLE TO STENEX.MAC;42
;<2SOURCES>IDDT.MAC;250     9-JAN-73 12:44:51	EDIT BY PLUMMER
; SEMICOLON DISPATCH INSTALLED
; XCT CHASER FIXED
;<2SOURCES>IDDT.MAC;249    27-DEC-72 16:05:13	EDIT BY PLUMMER
; FIXED  /  WITHOUT ARG
;<2SOURCES>IDDT.MAC;248     4-DEC-72 11:52:05	EDIT BY PLUMMER
; FILE LOGIC DEFAULTING CLEANED UP
;<2SOURCES>IDDT.MAC;245    19-OCT-72 11:00:27	EDIT BY PLUMMER
;<PLUMMER>IDDT.MAC;17    26-SEP-72 11:10:06	EDIT BY PLUMMER
; W, E, N SEARCHES TAKE COUNT    105$3W stopes on the 3rd find
; $$nZ fills core with n (assumed 0 if not given)
;<PLUMMER>IDDT.MAC;13    13-SEP-72 13:39:40	EDIT BY PLUMMER
; OPCODE TABLE EXPLAINATION CLEANED UP
; OLD TABLE DISCARDED
;<PLUMMER>IDDT.MAC;12    13-SEP-72 11:58:43	EDIT BY PLUMMER
; JSYS TABLE UPDATED
; ^S COMMAND TO STORE SYMBOLS
; NEW $$Y TO READ NEW STYLE SYMBOL FILES
; DEFAULT EXTENTIONS FOR FILE COMMANDS
;<PLUMMER>IDDT.MAC;8    12-SEP-72 17:47:54	EDIT BY PLUMMER
; SYMBOL FILE COMMAND
;<PLUMMER>IDDT.MAC;3    11-SEP-72 23:26:13	EDIT BY PLUMMER
; ENTRY VECTOR STUFF CLEANED UP (USES 0-LENGTH FEATURE)
; HALT, HALTF ARE SILENT RETURNS TO IDDT
;<PLUMMER>IDDT.MAC;2    11-SEP-72 22:19:55	EDIT BY PLUMMER
; SAVE/RESTORE USER'S TTY  TAB SETTINGS
; SAVE BREAKS-IN-PROGRESS WORD IN $I+3
; LEFT AND RIGHT HALF SYMBOL FIXUPS
; AUTOMATIC  $: AT STARTUP
; ALLOW TAGS WITH OPCODE NAMES
; ? COMMAND IMPROVED
;<2SOURCES>IDDT.MAC;243    25-AUG-72 17:52:06	EDIT BY PLUMMER
; SMACRO ASSEMBLY
; MOVED FROM 667000 TO 740000
;<2SOURCES>IDDT.MAC;242    26-JUL-72 19:51:00	EDIT BY PLUMMER
; FIX JSYS EVAL
	TITLE		NDDT
	SUBTTL	W.W.PLUMMER, NOVEMBER 71
	SEARCH	CPUNUM,MONSYM,MACSYM	; [PJG] PUT THE SEARCHES TOGETHER

	HOME==740000		;WHERE NDDT LIVES

BLAST:	MOVEI	4,770-<HOME/1000>
	MOVE	2,[400000,,<HOME/1000>-1]
	SETOM	1
	SETZ	3,		;WATCH OUT FOR KL20
	AOS	2
	PMAP
	SOJN	4,.-2
	MOVE	0,[LOW,,HOME]
	BLT	0,DDTEND-1
	HRLZ	0,116
	HRRI	0,DDTEND
	HLRE	1,116
	MOVEI	2,DDTEND-1
	SUB	2,1
	BLT	0,0(2)

	MOVEI	0,DDTEND
	HLL	0,116
	MOVEM	0,116
	MOVEM	0,@770001

	HRROI	1,[ASCIZ \Output NDDT to \]
	PSOUT

	HRLOI	1,(GJ%FOU!GJ%MSG!GJ%FNS!GJ%SHT!GJ%CFM)
	MOVE	2,[.PRIIN,,.PRIOU]
	GTJFN
	 0
	MOVEM	1,JFN

	MOVEI	1,400000
	MOVE	2,[3,,EVEC]
	SEVEC

	MOVE	0,[PROTO,,1]
	BLT	0,16
	JRST	4


PROTO:	-1			;1
	400000-1,,-1		;2
	0			;3
	AOS	2			;4
	PMAP			;5
	CAME	2,16		;6
	JRST	4			;7
	HRR	1,JFN		;10
	HRLI	1,400000		;11
	MOVE	2,15		;12
	SSAVE			;13
	JRST	INIT		;14
	-1000,,560000		;15
	400000,,<HOME/1000>-1	;16

	LIT
	
;DEFINE ACCUMULATORS

F=0		;FLAGS
R=<A==2>	;POINTERS TO TABLES, CORE, ETC.
S=3		;USED IN EVAL, FP1, FP4
W=4		;CONTAINS DISPATCH ADDRESS, USED IN FP1A, FP4
T=5		;TRANSFER DATA
W1=T+1
W2=7
SCH=10		;MODE CONTROL SWITCH FOR OUTPUT - CONTENT TYPER
AR=SCH+1	;MODE CONTROL SWITCH FOR OUTPUT - ADDRESS TYPER
ODF=AR+1	;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX
TT=13		;TEMPORARY
TT1=TT+1	;TEMPORARY
TT2=15		;TEMPORARY
TT3=16		;TEMPORATY
P=17		;PUSH DOWN


IFNdef	gpldf,<		gpldf==0>	; Gpld jsys exists?
IFNdef 	isigff,<	isigff==<1-KL20F>>	; Isi's version of gfrks (no skip)
IFNdef	delchf,<	delchf==<1-KL20F>>	; Delch jsys (for nifty editting)?
IFNdef	adbrkf,<	adbrkf==KL20F>	; Address break stuff
IFNDEF MIT,<MIT==1>			;ASSUME FOR MIT

IFN DELCHF,<IFNDEF DELCH,<OPDEF DELCH [JSYS 625]>>
;DEFINE BITS FOR USE IN LEFT HALF OF ACCUMULATOR F
COMF==200000	;COMMA TYPED FLAG
TIF==100000	;TRUNCATE TO 18 BITS -  SET BY SPACE OR COMMA
PTF==100	; +, -, OR * HAS BEEN TYPED
CTF==400
SF==4		;SYLLABLE FLAG
QF==1		;QUANTITY TYPED IN TO WORD ASSEMBLER

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

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

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

;DEFINE BITS FOR USE IN RIGHT HALF OF ACCUMULATOR F

ITF==2		;INSTRUCTION TYPED IF ITF=1
OUTF==4		;OUTPUT IF OUTF=1
CF1==400	;OUTPUT 1 REGISTER AS CONSTANT
LF1==2000	;OUTPUT 1 REGISTER AS FORCED SYMBOLIC OR CONSTANT
Q2F==1		;NUMBER TYPED AFTER ALT MODE 
NAF==200	;NEGATIVE ADDRESSES PERMISSABLE
POWF==4000	;ARGUMENT FOR EXPONENT COMING
XEQ==40		;WE'RE IN A $X
SSTEPF==20	; WE ARE SINGLE STEPPING
YSTEPF==40000	; WE ARE IN $Y SINGLE STEP MODE VS $J MODE
CONDX==1000	;WE'RE EXECUTING THE CONDITIONAL BREAK INSTR.
TEMF==10000	;TEMPORARY FLAG
TEM2F==10	;ANOTHER TEMPORARY, USED ONLY IN ;O STUFF
		; And in merge not to clear
INTFLG==20000	;EXPR CONTAINS DDT INTERNAL REGISTER
SEMIF==100	;SEMICOLON TYPED
SEMIF2==100000	;TWO SEMICOLI TYPED
SUPTEM==200000	;SUPER-TEMPORARY TYPEOUT MODE
;RANDOM THINGS
MAXJFN==155	;HIGHEST JFN NUMBER
STRBFL==10	;STRING (ATOM) BUFFER LENGTH

;DEFINE PUSH DOWN LENGTH
LPDL==100	;MAX LENGTH PUSH DOWN LIST
PCSL==150	;OLD PC STACK LENGTH


;DEFINE SYMBOL TABLE SYMBOL TYPES
GLOBAL==040000	;GLOBAL SYMBOL
LOCAL==100000
PNAME==740000	;PROGRAM NAME
DELI==200000	;DELETE INPUT
DELO==400000	;DELETE OUTPUT

;DEFINE UDEFINED SYMBOL TABLE TYPES
STADD==1B0	;IF 1, THEN ADDITIVE REQUEST
STLH==1B1	;IF 1, THEN REQUEST FOR LEFT HALF
STNEG==1B4	;IF 1, THEN NEGATIVE REQUEST

;FLAG SAYING ADDRESS IS IN NDDT'S ADDRESS SPACE
;MUST BE DIFFERENT THAN UNDEFINED SYMTAB TYPE BITS
DDTINT==1B5

NRBL==50	;NUMBER OF RING-BUGGER LOCATIONS (FOR SAVING OF EXAMINED LOCS)
NBP==20		;NUMBER OF BREAKPOINTS
NTBPTS==3	;NUMBER OF TEMPORARY BREAKPOINTS

OPDEF TYO [PBOUT]
OPDEF TYI [PBIN]
OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]

DEFINE INTOFF <
	MOVEI	1,400000
	MOVSI	2,(1B0)
	DIC>

DEFINE	INTON	<
	MOVEI	1,400000
	MOVSI	2,(1B0)		;THE RUBOUT CHANNEL
	AIC>
LOW:	PHASE	HOME
NDDT:

;ENTRY VECTOR
EVEC:	JRST	INIT		;"START"
	JRST	INIT		;"REENETER"
	JRST	SPLICD		;INFERIOR HAS BEEN SPLICED BY EXEC
VERSN:	1
PATVER:	0


;FORK HANDLE SUPPLIED IN AC1 FROM EXEC
SPLICD:	MOVEM	1,TPFORK		;SAY WE HAVE AN INFERIOR
	MOVEM	1,FORK
	MOVE	P,PS		;GET A STACK
IFN KL20F,<	ffork>
	CALL	SETTRP		; SET JSYS TRAP FOR BPT


INIT:	INTOFF			;PREVENT SURPRISES DURING INIT
	MOVE	P,PCSTAK
	MOVEM	P,PCSPTR	;RESET STACK OF PC'S
	MOVE	P,PS		;MAIN STACK
	MOVEI	1,.FHSLF	;SET UP CAPABILITIES
	RPCAP
	SETOM	3		;TRY FOR EVERYTHING
	EPCAP
	SKIPLE	TPFORK		;DOES USER ALREADY EXIST?
	 JRST	INIT3		;YES
	MOVEI	1,100
	SIBE			;ANY TYPE AHEAD?
	 JRST	INIT09		;YES
	MOVEI	1,101
	HRROI	2,[ASCIZ /NDDT./]
	SETZ	3,
	SOUT
	MOVE	2,VERSN
	MOVEI	3,^D10
	NOUT
	 JFCL
	SKIPN	PATVER
	 JRST	INIT09
	MOVEI	2,"."
	BOUT
	MOVE	2,PATVER
	MOVEI	3,^D10
	NOUT
	 JFCL
INIT09:	CALL	NEWFRK		;GET A NEW FORK

repeat 0,<
;COPY TO INFERIOR FORK
	MOVEI	1,400000
	GEVEC
	CAMN	2,[3,,EVEC]
	SETZM	2
	SEVEC
	HRLZI	1,410001
	HRROI	2,[ASCIZ /CORE-SWAP.NDDT/]
	GTJFN
	 0
	HRLI	1,400000
	MOVE	2,[-<HOME/1000>,,560000]
	SETZM	3
	SSAVE
	HRLZI	1,1
	HRROI	2,[ASCIZ /CORE-SWAP.NDDT/]
	CALL	GETFIL		;GET INTO INFERIOR FORK
	MOVEI	1,400000
	MOVE	2,[3,,EVEC]
	SEVEC			;SET IT BACK AGAIN
	MOVSI	1,100001
	HRROI	2,[ASCIZ /CORE-SWAP.NDDT/]
	GTJFN
	 JRST	INIT3
	DELF
	 JFCL
>

INIT3:	MOVNI	1,5
	RUNTM
	MOVEM	1,TIMUSD
	MOVEM	3,TIMCON
	MOVE	1,TPFORK
	FFORK			;FREEZE THE USER
	AOSE	USRFLG		;WERE WE IN THE USER BEFORE ^C, REE??
	 JRST	INIT4		;NO, NDDT HAS USER INFO ALREADY
	CALL	USTATE		;GET COMPLETE STATE OF USER FORK
	SKIPL	SYMPTR		;DO WE ALREADY HAVE SYMBOLS?
	CALL	SYMVEC		;GET SYMBOLS, ENT. VEC.

;SETUP INTERRUPT SYSTEM ON NDDT FORK
INIT4:	MOVEI	1,400000
	MOVE	2,[LEVTAB,,CHNTAB]
	SIR			;SETUP
	CIS
	EIR
IFE ADBRKF,<	MOVSI 2,(1B0!1B1!1B2)>	;RUBOUT, ^T, AND BPT CHANS
IFN ADBRKF,<	MOVE 2,[1B0!1B1!1B2!1B19]>	;INFERIOR TERMINATION TOO
	AIC
	JRST	DDT

;ENTRIES FROM USER

;RUBOUT HIT, MAKE BELIEVE INSTR TRAP HAPPEND
RUBOUT:	AOSE	USRFLG	;WE'RE WE IN USER?
	JRST	RENWRG	;NO, REENTER NDDT AT WRONG
	MOVEI	1,100
	CFIBF		;FLUSH TYPE-AHEAD
	JRST	TRAP

;BPT INTERRUPT
BPTINT:	MOVE	1,TPFORK
	FFORK		; STOP THE WORLD.
	RTFRK		; READ WHICH FORK HIT BPT
IFE KL20F,<	 JRST BPTIN1>
IFN KL20F,<	erjmp	bptin1>

BPTIN4:
IFE KL20F,<	HLRZS 1>
	CAME	1,FORK
	 CALL	UNMAP
	MOVEM	1,FORK
	UTFRK
	INTOFF
	MOVEI	1,BPTIN0
	MOVEM	1,IPC1
	DEBRK
BPTIN0:	SETZM	BPTFLG
	CALL	USTATE
	MOVSI	1,6
	JRST	TRAPD1

BPTIN1:	MOVSI	2,-14
BPTIN2:	MOVEI	1,BPTS
BPTI2A:	HRRZ	3,7(1)
	CAIN	3,400001(2)
	 JRST	BPTIN3		; FORK HANDLE IN USE -- SKIP IT
	ADDI	1,NBPTV
	CAIE	1,<BPTS+<NBP*NBPTV>>
	 JRST	BPTI2A
	MOVEI	1,400001(2)
	CAME	1,FORK
	CAMN	1,TPFORK
	 JRST	BPTIN3
	RFRKH
BPTIN3:	AOBJN	2,BPTIN2
	RTFRK
IFE KL20F,<	 0	>
	JRST	BPTIN4


;INSTR. TRAP. COULD BE ILL INSTR, ETC.
TRAP:	INTOFF
	MOVE	1,TPFORK
	CAME	1,FORK
	CALL	UNMAP
	MOVEM	1,FORK
	MOVE	1,TPFORK
	FFORK
IFE KL20F,<	MOVEI 1,TRAPD
	MOVEM	1,IPC2
	DEBRK>
	CIS
TRAPD:	SETZM	BPTFLG	;ASSUME NOT FROM BPT
	CALL	USTATE	;GET USER STATE
	TLZ	1,400000	;INTERRUPT --> 0
TRAPD1:	MOVEM	1,WHY
	HLRZ	W,1	;W HAS TERMINATION REASON
	HRRZS	1		;1 HAS REASON WHY ILLEGAL IF W NOT = 2
	SETZM	TRAPWD
	SETZM	WDATA
IFN ADBRKF,<	CAIE W,7	;ADDRESS BREAK HIT?
	CAIN	W,10	;OR JOB WANTS THE TTY
	 JRST	TRAP7>	;YES
	CAIE	W,6	;NEW BPT CLASS
	CAIN	W,2	;HALTF, HFORK, BPT
	JRST	TRAP2
	CAIN	W,3	;ILL INST., ILL MEM REF, ETC
	JRST	TRAP3

;INTERRUPT, IO WAIT, FORK WAIT
TR014:	MOVEI	1,10	;HANDLE AS INTERRUPT, WHY=10 FOR  XXX:
	HRRM	1,WHY
	JRST	NOTMT	;GO TYPE BREAK MESSAGE


IFN ADBRKF,<
TRAP7:	MOVEI	1,25-7(W)	;FAKE REASON (ABK: OR TTY:)
	HRRM	1,WHY
	JRST	NOTMT>

;FORCED TERMINATION CLASS
TRAP3:	CAIL	1,20
	CAILE	1,22
	JRST	NOTMT	;NOT A MEMORY TRAP

;MEMORY ACCESS VIOLATION
MEMTRP:	MOVE	1,FORK
	GTRPW
	MOVEM	1,TRAPWD
	MOVEM	2,WDATA
	TLNN	1,12	;READ AND EXECUTE TRAPS LEAVE GOOD PC
	SOS	PC		;WRITE LEAVES IT STEPPED, AND BIT-5 ON(R/W/X)

NOTMT:	TRNN	F,CONDX	;ARE BPT'S IN?
	 CALL	REMOVB	;YES, PULL THEM OUT
	MOVEI	1,100
	CFIBF		;CLEAR TYPE-AHEAD AT ERROR
	JRST	TBRK	;TYPE THE BREAK MESSAGE
;VOLUNTARY TERMINATION (HFORK, HALTF, BPT)
;GET ACTUAL INSTRUCTION THAT CAUSED TRAP
TRAP2:	HRRZ	R,PC
TRAP21:	CALL	FETCH	;FETCH AN INSTR
	 SETZM	T	;PROTECTED, MAKE LIKE ILLEGAL INSTR.
TRAP22:	LDB	W1,[POINT 9,T,8]
	CAIE	W1,<<XCT 0>/1B8>	;IS THIS AN XCT?
	JRST	TRAP23
TRAP29:	LDB	R,[POINT 4,T,17]
	CAIE	R,0	;ANY XR SPECIFIED?
	MOVE	R,AC0(R)	;YES, GET IT
	ADD	R,T		;DO INDEX ADDITION
	HRRZS	R
	TLNN	T,(@)	;ANY INDIRECTION?
	JRST	TRAP21	;NO, CHECK FOR ANOTHER XCT
	CALL	FETCH	;FETCH INDIRECT ADDR
	 SETZM	T
	JRST	TRAP29

TRAP23:	PUSH	P,T	;SAVE IT
	PUSH	P,R
	TRNN	F,CONDX
	CALL	REMOVB		;PULL OUT BPT'S IF THEY ARE IN
	POP	P,R
	POP	P,T
	CAMN	T,[BPT]
	 JRST	CHKBPT		;POSSIBLE BPT HIT
	CAME	T,[HFORK]
	CAMN	T,[HALTF]
	AOSA	PC			;SO A $P WILL CONTINUE
	 JRST	TRAP27
	MOVSI	W1,(1B5)
	IORM	W1,REALPC
	MOVE	W1,[ASCIZ "NDDT"]
	CALL	TEXT
	JRST	DD1

;HERE IS AN OBSCURE CASE.  THE FORK HAS BEEN HALTED BY A SUPERIOR
;OF NDDT.  THE RIGHT THING TO DO IS JUST RFORK (IE JRST TOUSER).
;HOWEVER THE WFORK WILL IMMEDIATELY COMPLETE AGAIN AND WE WILL BE
;IN A GIANT LOOP, BURNING CYCLES.  TO AVOID THIS WE WILL HANDLE IT
;JUST LIKE A RUBOUT INTERRUPT, USING THE TIME IT TAKES THE
;USER TO TYPE $P AS A DELAY.

;THE GENERAL PROBLEM IS THAT THE USER FORK HAS TWO PROCESSES WRITING
;ON ITS STATUS -- NDDT AND THE SUPERIOR.  THIS REQUIRES SOME FORM OF
;COOPERATION BETWEEN THE WRITES AS NOT TO CONFUSE THINGS!

TRAP27:	MOVEI	W,16	;FAKE BREAK NUMBER
	MOVEM	W,WHY
	JRST	NOTMT		;GO TYPE THE HFK:... MSG

CHKBPT:	TRNE	F,CONDX	;HIT BPT, WERE THEY IN?
	JRST	CHKBP2	;NO,  TRY FOR $X COMPLETION, ETC.

;SEE IF IT IS A BPT
	PUSH	P,R
	JSP	TT1,CHKADR		; GET OWNING FORK
	MOVE	R,(P)
	ANDCMI	R,777000		; FLUSH PAGE
	HRRZ	T,LASFPG
	LSH	T,9
	IOR	R,T
	MOVEI	T,BPTS
CHKBP1:	HRRZ	W,0(T)	;WHERE THIS BPT IS PLANTED
	HLRZ	W1,LASFPG
	XOR	W1,7(T)
	CAMN	R,W	;WHERE ONE ENCOUNTERED
	TRNE	W1,777777
	 JRST	CHKB1A
	POP	P,R
	JRST	BCOM

CHKB1A:	ADDI	T,NBPTV
	CAIE	T,BPTS+NBP*NBPTV
	 JRST	CHKBP1
	POP	P,R

;IS IT A PSEUDO BPT -- $X COMPLETION, ETC
CHKBP2:	MOVEM	R,TT
	HRRZ	W1,XRG		;WHERE $X HAPPENS IN USER
	SUB	TT,W1
	JUMPLE	TT,CHKBPZ	;WITHIN ALLOWED RANGE OF SKIPS?
	CAILE	TT,3
	 JRST	CHKBPZ		;NO, CALL IT ILLEGAL

;PSEUDO BPT HIT, SEE WHY
	TRNE	F,XEQ		;IN $X?
	 JRST	XCOM		;YES.
	TRNE	F,SSTEPF		;SINGLE STEPPING?
	 JRST	JSTEP2
	TRNE	F,CONDX		;IN A CONDITIONAL BREAK EVAL?
	 JRST	CONCOM		;YES.
	JRST	ILLINS		;HUH?

;NOT LEGAL AS $X, BUT MIGHT BE $^N COMPLETION
CHKBPZ:	MOVEM	R,TT
	HRRZ	W1,$CTRLN+3	;LOCATION OF FIRST BPT
	SUB	TT,W1
	JUMPL	TT,ILLINS		;WITHIN ALLOWED RANGE OF SKIPS?
	CAIL	TT,3
	 JRST	ILLINS		;NO, CALL IT ILLEGAL
	TRNN	F,SSTEPF		;SINGLE STEPPING?
	 JRST	ILLINS		;NOPE, MUST BE ILL INS
	MOVE	TT,R
	SUB	TT,$CTRLN		;TT GETS AMOUNT TO OFFSET REALPC BY
	JRST	JSTCTN
;TYPE SOFTWARE GENERATED (NDDT) ILLEGAL INSTRUCTION
ILLINS:	MOVEI	W,17	;ILL:
	MOVEM	W,WHY


;TYPE BREAK MESSAGE,  WHY SAYS WHICH

TBRK:	CALL	CRF	;CARRIAGE RETURN
	HRRZ	W,WHY
TBRK1:	MOVE	W1,MSG(W)	;TEXT OF BREAK REASON
	CALL	TEXT2	;TYPE IT
	HRRZ	T,PC
	CAIN	T,20	;WAS THIS AT STUPID BREAKPOINT OR ^N HACK?
	 HRRZ	T,LLOC	;GET REAL LOCATION
	SETOM	PINFF	;PRINT APPROPRIATE AC AND EFF ADR
	CALL	LI1	;EXAMINE THE BREAK LOCATION, SETUP "."
	CALL	LCT
	HRRZ	W,WHY
	CAIE	W,10	;INTERRUPT CODE
	 TRNN	F,XEQ!CONDX
	JRST	DD2
	CALL	UNSET	;POP PREVIOUS $X CONTEXT
	JRST	DD1
;READ THE USER'S STATE
;SWITCH TTY AND SUBSYS TO NDDT

USTATE:	MOVEI	1,100
	RFMOD
	MOVEM	2,SAVTTY
	RFCOC
	MOVEM	2,SAVTT2
	MOVEM	3,SAVTT3
	MOVE	2,TTYCC2
	MOVE	3,TTYCC3
	SFCOC
	GTABS
	MOVEM	2,USRTB2
	MOVEM	3,USRTB3
	MOVEM	4,USRTB4
	MOVE	2,DDTTB2
	MOVE	3,DDTTB3
	MOVE	4,DDTTB4
	STABS
	GETNM
	MOVEM	1,SUBSYS
	MOVE	1,['NDDT  ']
	SETNM			;SET SUBSYSTEM NAME
	CALL	GETUSR		; GET STATE OF USER FORK
	RET

;GET STATE OF USER FORK INTO NDDT SPACE

GETUSR:	MOVE	1,FORK
	RWM
	MOVEM	1,USRPSI+0	;USER CHANNELS WITH WAITING REQ.
	MOVE	1,FORK
	RCM
	MOVEM	1,USRPSI+1	;ACTIVE USER CHANNELS
	MOVEM	2,USRPSI+2	;BREAKS IN PROGRESS
	MOVE	1,FORK
	SETOM	USRPSI+3
	SKPIR			;SEE IF USR HAS INTERRUPTS ON
	SETZM	USRPSI+3
	DIR
	TLO	1,(RT%DIM)
	RTIW			; Terminal interrupt word
	DMOVEM	2,USRPSI+4
	HRRI	1,.FHJOB
	RTIW
	DMOVEM	2,USRPSI+6
	SETZB	2,3
	STIW
	 ERJMP	.+1		; Can fail if no ^C capability
	MOVEI	1,.FHJOB
	MOVE	2,[060000,,100000]
	STIW
	 ERJMP	.+1
	MOVE	1,FORK
	MOVEI	2,AC0
	RFACS			;GET USER'S AC'S
	RFSTS
	MOVEM	2,REALPC
	TLNN	2,(1B5)	;MONITOR MODE PC?
	SOS	2		;YES, BACK IT UP SO . WILL APPEAR OK
	MOVEM	2,PC	;AND HIS PC
	SETZM	USRFLG		;WE'RE NOT IN THE USER.
	RET

; SET STATE OF USER FORK FROM NDDT SPACE

SETUSR:	MOVE	1,FORK
	MOVEI	2,AC0
	SFACS		;GIVE BACK HIS AC'S
	SETOM	2
	DIC		;DEASSIGN ALL CHANNELS
	MOVE	2,USRPSI+1	;TURN ON ONES WHICH SHOULD BE ACTIVE
	AIC
	SKIPE	USRPSI+3
	EIR		;INTERRUPTS ARE SUPPOSED TO BE ON
IFN KL20F,<
	TLO	1,(ST%DIM)	; TERMINAL INTERRUPT WORD
>;IFN KL20F
	DMOVE	2,USRPSI+4
	STIW
	 ERJMP	.+1		; Can fail if no ^C capability
	HRRI	1,-5
	DMOVE	2,USRPSI+6
	STIW
	 ERJMP	.+1
TOUSR6:	MOVE	1,FORK
	RFSTS		;GET PC
	MOVE	1,FORK
	CAMN	2,REALPC	;SAME AS IT WAS AT ENTRY?
	 RET	;YES, RFORK TO RESUME
	MOVE	2,REALPC	;NO, SET IT TO WHAT IT SHOULD BE
	SFORK		;IT IS FROZEN
	RET
DDT:	SETZM	STRING	;GET COMMANDS FROM TTY, NOT STRING AT BPT
	CALL	CHKSYM	;INITIALIZE SYMBOL TABLE
	CALL	PGMST	;DO A $: IF POSSIBLE
DD1:	CALL	CRF	;TYPE CAR.RET.  LINE FEED

;CARR. RET. ETC., COME BACK HERE
DD1.5:	TLZ	F,ROF		;CLOSE ANY OPEN REGISTER
DD1.6:	MOVE	T,[SCHM,,SCH]
	BLT	T,ODF		;LOAD MODE CONTROL SWITCHES
DD2:	TRZE	F,SUPTEM
	 MOVE	SCH,SCHSAV	;RESTORE IF SUPER-TEMPORARY MODE
	SETZM	PRNC		;PARENTHESES COUNT
	INTOFF			;SOME COMMANDS DO INTON
	MOVE	P,PS
	CALL	REMTBP		;REMOVE TEMPORARY BPTS (PUT IN FOR $^N)

;OPEN PAREN COMES BACK HERE
LIS:	MOVE	T,ESTU
	MOVEM	T,ESTUT		;INIT UNDEFINED SYM ASSEM
	MOVEI	1,100
	RFMOD
	ANDCMI	2,17B23!3B25!3B29
	IORI	2,16B23!2B25!1B29	;DON'T AWAKEN ON ALPHA
	SFMOD
	TDZ	F,[777777-ROF-STF,,LF1+CF1+ITF+Q2F]

; < AND > COME BACK HERE
WHICH==SEMIF!SEMIF2!NAF!CONDX!TEMF!TEM2F!INTFLG
LIS0:	TDZ	F,[777777-ROF-STF-FAF-SAF,,WHICH]
	SETZM	WRD

;SPACE AND , HERE
LIS1:	SETZM	FRASE

;+ - @ ETC. HERE
LIS2:	MOVEI	T,1
	MOVEM	T,FRASE1
	TLZ	F,MLF+DVF

;* / HERE
L1:	TLZ	F,CF+CCF+SF+FPF	;TURN OFF CONTROL, SYL, PERIOD FLAG
L1A:	SETZM	SYL		;NO SYL YET

;^ ETC. HERE
L1RPR:	SETZM	SYM
	MOVEI	T,6
	MOVEM	T,TEM		;INIT CHR PER SYMBOL COUNTER
	MOVE	T,[POINT 7,TXT]
	MOVEM	T,CHP		;SETUP FOR OPEVAL SYMBOL
	SETZM	TXT
	SETZM	TXT+1		;TO KEEP JSYS LOOKUP HAPPY
	SETZM	DEN		;DECIMAL NUMBER ACCUMULATOR
	SETZM	WRD2		;NUMBER TO RIGHT OF $ IN COMMAND
	MOVE	T,[POINT 7,STRBUF-1,34]
	MOVEM	T,STRIP
	MOVEM	T,STROP		;INIT ATOM BUFFER POINTERS
;NUMBERS, LETTERS COME BACK HERE FOR MORE OF SYMBOL
L2:	MOVE	1,[^D20,,1]	;^T TO CHANNEL 1
	ATI
	MOVE	1,ESCCOD		;THE CURRENT ESCAPE CODE (^D)
	DTI
	CALL	TIN		;PICK UP CHARACTER
LZ:	HRLZ	1,ESCCOD		;ASSIGN TO CHAN. 0
	ATI
	CAIL	T,"A"+40		;LOWER CASE A
	 CAILE	T,"Z"+40		;LOWER CASE Z
	  CAIA			;NOT LOWERCASE
	   TRC	T,40		;CHANGE LOWER CASE TO UPPER CASE
	TRNN	F,SEMIF		;SEMICOLON CONTROL, OR...
	 TLNE	F,CF		;ALT. MODE CONTROL FLAG?
	  JRST	L21		;CONTROL
	CAIG	T,"Z"		;Z
	 CAIGE	T,"A"		;A
	  JRST	L21		;NOT A LETTER
	JRST	LET


;CONTROL OR NOT-LETTER
L21:	CAILE	T,137
	 JRST	ERR
	TRNE	F,SEMIF
	 ADDI	T,140		;USE OTHER TABLE
	MOVE	R,T
	IDIVI	R,3		;REMAINDER GIVES COLUMN, QUOTIENT GIVES ROW
	LDB	W,BDISP(R+1)	;GET 12 BIT ADDRESS FROM DISPATCH TABLE
	CAIGE	W,MULT-DDT	;FIRST EVAL ROUTINE
	 JRST	DDT(W)		;NO EVAL


	MOVE	T,SYL
	TLZN	F,LTF
	 JRST	POWER

	CAIN	W,SPACE-DDT	;IS TERMINATOR A SPACE?
	 SKIPE	WRD		;AND WORD SO FAR ZERO?
	  SKIPA	T,[OPEVAL,,EVAL];NO, SEARCH EVAL 1ST
	   MOVS	T,[OPEVAL,,EVAL];YES, DO OP SEARCH
	MOVEM	T,TEM1
	JRST	L213
L212:	HLRZS	T,TEM1		;GET ADDRESS OF THE OTHER LOOKUP ROUTINE
	JUMPE	T,UND1		;IF ADR=0, THEN SYMBOL UNDEFINED
L213:	CALL	(T)		;CALL OPEVAL OR EVAL
	 JRST	L212		;SYMBOL NOT FOUND
	CAIN	W,ASSEM-DDT	;DEFINED SYMBOL FOLLOWED BY #?
	 JRST	ERR

;EXPONENT ROUTINE COMES BACK HERE
L4:	TLZE	F,MF
	 MOVN	T,T
	TLNN	F,SF
	 CAIE	W,LPRN-DDT
	  SKIPA
	   JRST	LPRN

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

	ADD	T,WRD
	TLNE	F,TIF		;TRUNCATE INDICATOR FLAG
	 HLL	T,WRD		;TRUNCATE
	MOVEM	T,WRD
	TLNN	F,QF
	 MOVE	T,LWT
	SETZM	R
	MOVE	W1,ESTUT		;W1 IS USED IN DEPRA
	CAMN	W1,ESTU
	 JRST	L5
	CAILE	W,CARR-DDT
	 JRST	ERR
L5:	CAIG	W,RPRN-DDT
	 JRST	DDT(W)
	PUSH	P,[JRST RETX]
	SKIPN	PRNC
	 JRST	DDT(W)
;GIVE GENERALIZED ERROR COMMENT
ERR:	SETZM	STRING
	SETZM	BBC		;KILL THE BUFFERED CHARACTER IF AN ERROR
	MOVEI	W1,"?"
	JRST	WRONG1


;UNDEFINED SYMBOL TYPED.
UNDEF:	MOVEI	W1,"U"
	JRST	WRONG1


;RUBOUT FROM INSIDE NDDT
;REENTER NDDT AT WRONG
RENWRG:	MOVEI	1,100
	CFIBF
	MOVEI	1,101
	CFOBF
IFE KL20F,<	MOVEI 1,WRONG
	MOVEM	1,IPC2
	DEBRK>
IFN KL20F,<	cis>

WRONG:	MOVE	W1,[ASCII /XXX/]
WRONG1:	MOVE	P,PS
	CALL	TEXT
	TLNN	F,ROF		;REG OPEN?
	JRST	DD1		;NO, CR AND RESET


;COMMON RETURN
RETX:	MOVE	P,PS
	CALL	LCT		;COMMON RETURN FOR TAB;,JRST LIS
	JRST	DD2
UND1:	MOVE	R,ESTUT		;UNDEFINED SYM ASSEMBLER
	JUMPE	R,UNDEF		;UNDEFINED IF NO UNDEF TAB
	HLRE	S,ESTUT
	ASH	S,-1		;SETUP EVAL END TEST
	HRLOI	W1,37777+DELI+LOCAL
	CALL	EVAL2
	CAIN	W,ASSEM-DDT
	TLNN	F,ROF
	JRST	UNDEF
	SKIPE	PRNC
	JRST	UNDEF
	MOVEI	T,"#"
	CAIE	W,ASSEM-DDT
	CALL	TOUT

	MOVN	R,[2,,2]
	ADDB	R,ESTUT
	MOVE	T,SYM
	TLO	T,GLOBAL
	MOVEM	T,(R)
	HRRZ	T,LLOCO
	TLNE	F,MF
	TLO	T,(STNEG)	;SET FLAG TO SHOW SUBTRACTIVE REQUEST
	TLO	T,(STADD)	;SET FLAG TO SHOW UNCHAINED REQUEST
	MOVEM	T,1(R)
	MOVEI	T,0
	JRST	L4
;? COMMAND
QUESTN:	CALL	CRF	;LIST UNDEFINED SYMBOLS
	INTON
	TLNE	F,LTF	;HAS A SYMBOL BEEN TYPED?
	JRST	QLIST	;NO
	MOVE	R,ESTU
QUEST1:	JUMPGE	R,DD1
	MOVE	T, (R)
	SKIPA	W1,ESTU

QUEST2:	ADD	W1,[2,,2]
	CAME	T,(W1)
	JRST	QUEST2
	CAME	R,W1
	JRST	QUEST4
	CALL	SPT
	CALL	CRF
QUEST4:	ADD	R,[2,,2]
	JRST	QUEST1

QLIST:	HLRE	S,SYMPTR
	ASH	S,-1	;NUMBER OF ENTRIES
	SKIPL	R,SYMPTR
	JRST	RETX	;NO SYM TAB
QLIST1:	SETZM	QLPNT	;SAY NO REFERENCE YET
QLIST2:	MOVE	T,(R)	;GET SYM
	TLZN	T,PNAME	;A PROG NAME?
	JRST	QLIST6	;YES
	CAMN	T,SYM	;NO, IS AN OCCURANCE FOUND?
	HRRZM	R,QLPNT	;YES, REMEMBER WHERE
QLIST3:	AOBJN	R,.+1	;MOVE TO NEXT TAB ENTRY
	AOBJN	R,QLIST4	;END OF TABLE?
	MOVE	R,SYMPTR	;YES RING PTR
QLIST4:	AOJLE	S,QLIST2	;DONE ALL SYMS?
	JRST	DD1	;YES
QLIST6:	SKIPN	QLPNT	;FOUND THE SYM?
	JRST	QLIST3	;NO, KEEP LOOKING
	CALL	SPT1	;PRINT PROGRAM NAME
	MOVE	T,@QLPNT	;GET SYM BACK
	TLNN	T,GLOBAL
	JRST	QLIST7	;NOT GLOBAL
	CALL	TSPC	;TYPE SPACE AND G
	MOVEI	T,"G"
	CALL	TOUT
QLIST7:	CALL	CRF
	SETZM	QLPNT	;RESET FIND FLG
	JRST	QLIST3	;RESUME SEARCH
;DIGITS, ADD IN TO OCTAL
;ACCUMULATOR (SYL), FLOATING NUM (FH,SYL)
;AND DECIMAL NUMBER (DEN), THEN HANDLE AS A LETTER
NUM:	ANDI	T,17		;T HOLDS CHARACTER
	TLNE	F,CF+FPF		;$ TYPED OR EXPONENT
	JRST	NM1		;FORM WRD2
	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

;$ SIGN
DOLLAR:	SKIPA	T,[46+"A"-13]	;RADIX 50 $ TO BE

;PER CENT SIGN
PERC:	MOVEI	T,47+"A"-13	;PERCENT SIGN

;LETTERS, ADD IN TO SYMBOL (SYM) BEING TYPED IN
LET:	TLC	F,SF+FPF		;EXPONENT IFF LTF'*FEF'*(T=105)*SF*FPF=1
	TLZN	F,LTF+FEF+SF+FPF
	CAIE	T,"E"
	TLOA	F,LTF
	TLOA	F,FEF
	JRST	LET1
	TLZN	F,MF
	SKIPA	W1,SYL
	MOVN	W1,SYL
	MOVEM	W1,FSV
	SETZM	DEN
LET1:	SUBI	T,"A"-13		;FORM RADIX 50 SYMBOL
LE1A:	TLO	F,SF+QF

;PACK CHARACTER INTO SYM
LE2:	MOVE	W,SYM
	MOVEI	R,"A"-13(T)
	IMULI	W,50		;CONVERT TO RADIX 50
	ADD	W,T
	SOSGE	TEM		;IGNORE CHARACS AFTER 6
	JRST	L2
	MOVEM	W,SYM
	IDPB	R,CHP
	JRST	L2
;FORM NUMBER AFTER $
NUM1:	EXCH	T,WRD2
	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	W2,NPWR10		;GET THE NEGATIVE POWER OF TEN
	MOVSI	R,(1.0)
NM1A:	TRZE	W2,1
	FMPR	R,FT(W1)
	JUMPE	W2,NM1B
	LSH	W2,-1
	SOJG	W1,NM1A
NM1B:	MOVSI	W1,211000(T)	;UNNORMALIZED FP VALUE OF DIGIT
	FMPR	R,W1		;COMPUTE VALUE OF NEW DIGIT
	FADRB	R,FH		;ADD VALUE INTO FLOATING NO.
	MOVEM	R,SYL
	AOJA	T,LE1A
;THIS SEQUENCE INITIALIZES THE SYM TAB LOGIC
CHKSYM:	HLRZ	T,ESTU
	SUB	T,ESTU
	MOVE	W,SYMPTR
	ADD	T,W		;IF THE TOP OF THE UNDEFINED SYM TAB DOES
	TRNE	T,-1	; NOT POINT TO BOTTOM OF REGULAR SYM TAB,THEN
	HRRZM	W,ESTU	; RE-INIT UNDEFINED SYM TABLE POINTER, ESTU.


	MOVE	T,PRGM
	SUB	T,W		;IF THE SYM TABLE PNTR AND THE PROGRAM
	TSC	T,T		; NAME (PRGM) PNTR DO NOT END UP IN THE
	MOVE	W1,PRGM	; SAME PLACE, OR THEY DO NOT BOTH START ON
	XOR	W1,W	; AN EVEN (OR BOTH ON ODD) LOCATION, OR
	TRNN	W1,1	; PRGM .GE. 0, THEN RE-INIT PRGM.
	JUMPE	T,CHKSY0
	SETZM	PRGM
	SETZM	BLOCK	;RESET WORLD

;SETUP $X LOCATION FROM DEFINITION OF PAT..

CHKSY0:	MOVE	S,SYMPTR		;SEARCH LOW TO HIGH.  PAT.. IS 1ST!
CHKSY1:	MOVE	T,0(S)		;GET A SYMBOL
	AOBJN	S,.+1		;BUMP POINTER TO VALUE
	XOR	T,[RADIX50 4,PAT..];WHAT WE ARE LOOKING FOR
	TDNE	T,[177777,,777777]	;BITS WHICH MATTER
	AOBJN	S,CHKSY1		;NO MATCH.  TRY NEXT SYM.
	SKIPGE	S		;DID WE FIND IT?
	 SKIPA	T,0(S)		;YES.  GET THE VALUE
	  MOVEI	T,20		;NO. DEFAULT $X LOCATION
	HRRZM	T,XRG		;WHERE $X WILL BE DONE. (PATCHES TOO)
	RET
;AUTOMATIC $: FOR PROGRAM CONTAINING THE START ADDRESS
PGMST:	MOVE	1,FORK
	GEVEC
	JUMPE	2,CPOPJ		;NO ENTRY VECTOR
	HRRZ	W,2		;SA
	SKIPL	PRGM		;DON'T IF ALREADY SET
	SKIPL	R,SYMPTR		;OR IF NO SYMTAB
	 RET
	MOVSI	T,1		;BIG NUMBER
	JRST	PGMS19

PGMST0:	MOVE	T,0(R)		;GET ENTRY
	TLNE	T,(17B3)		;PROGRAM NAME?
	JRST	PGMST2		;NO, SKIP IT
PGMST1:	HRRZ	T,1(R)		;LOW BREAK
	SUB	T,W			;COMPARE WITH SA
	MOVN	T,T		;Make sign right.
	JUMPL	T,PGMST2		;THIS PRGM'S BRK IS BELOW THE SA
	CAML	T,TEM		;BREAK CLOSER THAN LAST ONE?
	JRST	PGMST2		;NO
	MOVEM	R,PRGM		;CURRENT BEST PROGRAM
PGMS19:	MOVEM	T,TEM		;CUNNENT BEST DISTANCE
PGMST2:	AOBJN	R,.+1
	AOBJN	R,PGMST0		;TRY NEXT ENTRY
	SETZM	BLOCK
	SKIPL	R,PRGM		;DID IT GET SET?
	 RET
	MOVE	T,0(R)		;THE PROGRAM NAME
	MOVEM	T,SYM		;SETUP FOR SB1
	CALL	SB1		;LOOK FOR BLK NAME = PRGM NAME
	 RET			;NONE(UGH! EVAL WILL LOOP AROUND EV2B)
	MOVEM	R,BLOCK		;DO  $&  TOO
	RET
POWER:	TLNN	F,FEF
	JRST	L4		;NO EXPONENT
	CAIE	W,PLUS-DDT
	CAIN	W,MINUS-DDT
	TROE	F,POWF
	TRZA	F,POWF
	JRST	DDT(W)	; E+-

	MOVE	W2,DEN
	SETZM	FRASE
	MOVEI	W1,FT-1
	TLZE	F,MF
	MOVEI	W1,FT01
	SKIPA	T,FSV
POW2:	LSH	W2,-1
	TRZE	W2,1
	FMPR	T,(W1)
	JUMPE	W2,L4
	SOJA	W1,POW2
PERIOD:	MOVE	T,DEN		;VALUE OF DECIMAL NUMBER
	TLNE	F,SF		;SYLLABLE STARTED?
	 JRST	PERIO2		;YES, TAKE AS DECIMAL NUMBER
	MOVE	T,LLOC		; VALUE OF "." IN CURRENT SEQUENCE
	TLZE	F,CF!CCF		;IF $ OR $$ THEN USE PC
	 HRRZ	T,PC
	TLNN	T,(DDTINT)		; "." INTERNAL TO NDDT?
	 JRST	PERIO2		;NO
	TROE	F,INTFLG		;SAY THIS EXPR IS INTERNAL
	 JRST	ERR		;INTERNAL ARITHMETIC
PERIO2:	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
	SETZM	NPWR10		;NUM OF DIGITS PASSED THE DEC. PT.
	MOVEI	T,45		;RADIX 50 PERIOD
	JRST	LE2		;PROCESS AS SYMBOL CONSTITUENT


;$Q  VALUE OF LAST THING TYPED BY NDDT OR USER
QUAN:	TLNN	F,CCF
	 SKIPA	T,LWT		;$Q, GET LAST WORD TYPED
	  MOVS	T,LWT		;$$Q, GET IT SWAPPED
	JRST	QUAN1


;$V  LEVT HALF --  $$V TO GET SIGN EXTENDED
LEFT:	HLRE	T,LWT
	TLNN	F,CCF
	 HRRZS	T
	JRST	QUAN1


;HERE TO EXAMINE AN INTERNAL REGISTER -- READ SIXBIT NAME AND LOOKUP
INTSYM:	TRZ	F,SEMIF!SEMIF2	;CLEAR SEMICOLON TYPED FLAGS
	MOVEI	W1,6		;ALLOW SIX CHARACTERS
	PUSH	P,[0]		;BUILD SIXBIT ON TOP OF STACK
	MOVE	W2,[POINT 6,(P)]
INTSY2:	CALL	TIN
	MOVEM	T,BBC		;SAVE BUFFERED-BACK CHARACTER
	CAIL	T,"a"
	 CAILE	T,"z"
	  SKIPA
	   SUBI	T,"a"-"A"	;IF LOWERCASE CONVERT TO UPPERCASE
	CAIL	T,"A"		;MUST BE ALPHABETIC
	 CAILE	T,"Z"
	  JRST	INTSY1		;NOT, SO TRY NUMERIC
INTSY3:	SUBI	T," "		;MAKE SIXBIT
	SETZM	BBC		;NO LONGER BUFFERED, WE USED IT
	SOJL	W1,INTSY2		;ONLY PUT 6 CHARACTERS INTO T
	 IDPB	T,W2
	JRST	INTSY2	
INTSY1:	CAIL	T,"0"
	 CAILE	T,"9"		;NUMERIC?
	  SKIPA
	   JRST	INTSY3		;YES, SO BUILD UP MORE SIXBIT
	SETZI	W1,
	POP	P,T			;GET SIXBIT
	 JUMPE	T,INTXIT		;NULL, SO RETURN 0
	MOVEI	W2,INSYMB		;GET START OF INTERNAL SYMBOL TABLE
INTSY4:	HLRZ	TT,(W2)		;THE POINTER TO THE SIXBIT
	CAMN	T,(TT)		;MATCH THIS INTERNAL SYMBOL?
	 JRST	INTXI1		;YUP, READ VALUE AND MAKE INTERNAL
	CAIGE	W2,INSYME		;DONE WITH TABLE?
	 AOJA	W2,INTSY4		;NOPE, TRY NEXT ENTRY
	JRST	ERR		;ELSE SYMBOL NOT FOUND

INTXI1:	HRRZ	T,(W2)		;PICK UP SYMBOL'S VALUE
INTXIT:

;;; FALL INTO QUANIN

;;; FALL IN FROM INTSYM

;HERE TO EXAMINE INTERNAL REGISTER
;ADDRESS OF IT IN T
;USED BY $G  $X  ETC.
QUANIN:	TLO	T,(DDTINT)		;MARK FOR ADR INTERNAL TO DDT
	TROE	F,INTFLG		;DOES EXPR ALREADY CONTAIN INT SYM?
	 JRST	ERR		;YES.
	MOVEI	W,1
	MOVEM	W,FRASE1
QUAN1:	MOVEM	T,SYL
QUAN2:	TLO	F,SF+QF		;WRD,SYL STARTED
	TLZ	F,CF+CCF
	JRST	L2
;SEMICOLON TYPED
SEMIC:	TROE	F,SEMIF		;SEEN ONE ALREADY?
	TRO	F,SEMIF2		;YES
	JRST	CONTR1


; $ TYPED
CONTRO:	TLOE	F,CF		;HAVE ALREADY SEEN ONE?
	TLO	F,CCF		;YES
CONTR1:	PUSH	P,2
	MOVEI	1,100
	RFMOD
	IORI	2,17B23		;WAKEUP ON EVERYTHING
	SFMOD
	POP	P,2
	JRST	L2
;BIT 40 - DELETE OUTPUT
; 20 - DELETE INPUT
; 10 - LOCAL
; 04 -GLOBAL
; NO BITS - PROGRAM NAME
;LOCAL+GLOBAL=BLOCK NAME, VALUE IS BLOCK LEVEL
;S IS -NUMBER OF SYMBOLS LEFT TO BE CONSIDERED
;R IS CURRENT SYM TAB POINTER
;SYM HAS SYMBOL BEING LOOKED UP
;W1 HAS CODE BITS WHICH WILL CAUSE THE CURRENT
;	ENTRY TO BE SKIPPED OVER
;PRGM IS 0 OR POINTER TO CURRENT PROGRAM'S SYMBOLS
;BLOCK IS 0 OR POINTER TO CURRENT BLOCK'S SYMBOLS
;TBLK IS THE TEMPORARY BLOCK POINTER IF NOT 0
;BLVL IS THE HIGHEST LEVEL BLOCK ALREADY SCANNED


;LOOKUP LOCAL IN THIS PROGRAM, OR ELSE GLOBAL ANYWHERE
;FOR PURPOSE OF KILLING ($$K) A SYMBOL
EVAL0:	HRLOI	W1,37777+DELI	;IGNORE HALF-KILLED SYMBOLS
	HLRE	S,SYMPTR
	ASH	S,-1	;SETUP END TEST (- NUM OF ENTRIES IN TABLE)
	JRST	EVAL3

EVAL1:	ADD	R,[2,,2]
EVAL2:	SKIPL	R
	 MOVE	R,SYMPTR
	AOJG	S,CPOPJ	;TRANSFER IF NO SYMBOL FOUND
EVAL3:	MOVE	T,(R)
	XOR	T,SYM
	TLNN	T,PNAME	;WHEN PROGRAM NAME ENCOUNTERD,...
	 TLOA	W1,LOCAL	; STOP LOOKING AT LOCAL SYMS
	  TDNE	T,W1	;REJECT THIS ENTRY?
	   JRST	EVAL1	;YES, WRONG TYPE OR NAME DOESN'T MATCH
	TLNN	T,340000	;IS THIS ENTRY DELETED?
	 JRST	EVAL1	;YES. FORGET IT
	MOVE	T,1(R)	;GET DEFINITION
CPOPJ1:	AOS	(P)		;FOUND SYMBOL, SKIP
CPOPJ:	RET

;MAIN SYMBOL LOOKUP.
EVAL:	CALL	EVALA	;SEARCH UP THE SYMBOL TREE
	 JRST	EV9	;NOT FOUND. SEARCH WHOLE TREE
	JRST	CPOPJ1	;FOUND, SKIP.
;SCAN UP THE SYMBOL TREE.
;DON'T CONSIDER SYMS IN BLKS ON
; SAME OR DEEPER LEVELS.
EVALA:	MOVSI	W1,DELI	;IGNORE HALF-KILLED SYMS
	HLRE	S,SYMPTR
	ASH	S,-1	;END CHK.  - # OF TAB ENTRIES
	SKIPL	R,TBLK
	 JRST	EVL1
	SETZM	TBLK
	JRST	EVL2

;NO BLOCK SET
EVL1:	SKIPL	R,BLOCK
	 JRST	EV5	;NO PERM BLOCK EITHER.

;GET LEVEL FROM DEF OF CURRENT BLOCK
EVL2:	MOVE	T,1(R)
	MOVEM	T,BLVL	;BLKS DEEPER THAN BLVL WON'T BE CONSIDERED
	JRST	EV1	;START SCAN WITH THIS BLOCK'S SYMS


EV3:	CAMN	R,SYMPTR	;JUST CHECKED LOWEST ENTRY?
	JRST	EV4	;YES, RING R TO TOP AND CONTINUE
	AOJGE	S,CPOPJ	;NOTHING FOUND IF ALL ENTRIES SCANNED


;MAIN LOOP
EV1:	SUB	R,[2,,2]	;MOVE TO NEXT ENTRY
	MOVE	T,(R)	;GET NAME AND TYPE
	TDNE	T,W1	;TEST TYPE BITS
	JRST	EV3	;THIS TYPE BEING REJECTED
	LDB	T,[POINT 4,(R),3]	;GET TYPE BITS
	CAIN	T,3
	JRST	EV2	;BLOCK NAME
	SKIPN	T 	;PROGRAM NAME?
	TLOA	W1,LOCAL	;YES. START REJECTING LOCALS
	SKIPA	T,(R)	;RESTORE T IF NOT PRGM NAME
	JRST	EV3	;RESUME SCAN AFTER PROGRAM NAME
	XOR	T,SYM	;SEE IF ENTRY MATCHES KEY
	TLZ	T,740000	;FLUSH TYPE BITS FROM CONSIDERATION
	JUMPN	T,EV3	;NO MATCH. KEEP LOOKING
	MOVE	T,1(R)	;GET DEFINITION
	JRST	CPOPJ1	;SKIP.

;SCAN HIT BOTTOM OF TABLE, RING TO TOP
EV4:	HLRE	R,SYMPTR
	MOVNS	R		;GET POSITIVE LENGTH
	ADD	R,SYMPTR	;ONE ENTRY PASSED TOP
	AOJL	S,EV1	;KEEP SCANNING IF ALL NOT CHECKED
	RET		;NOT FOUND

;BLOCK NAME ENCOUNTERED
EV2:	MOVE	T,1(R)	;DEF. IS LEVEL OF NEW BLOCK'S SYMBOLS
	CAMGE	T,BLVL	;LEVEL < LEVELS ALREADY CONSIDERED?
	JRST	EV2A	;YES. SCAN THEM
EV2B:	SUB	R,[2,,2]	;NO. SKIP OVER THIS BLOCK
	ADDI	S,1	;LOOK FOR ANOTHER BLOCK WHICH ENCLOSES THIS ONE
	LDB	T,[POINT 4,(R),3]
	CAIE	T,3
	JRST	EV2B	;NOT A BLOCK NAME. KEEP LOOKING
	JRST	EV2	;BLOCK NAME. CHECK ITS LEVEL
EV2A:	MOVEM	T,BLVL	;SAVE LEVEL OF ENCLOSING BLOCK
	JRST	EV3	;SO NO DEEPER BLOCKS WILL BE SCANNED


;HERE WHEN EVALA CALLED AND NO CURRENT TBLK OR BLOCK
EV5:	MOVEI	T,1
	MOVEM	T,BLVL	;SET LEVEL TO 1 (MAIN)
	SKIPGE	R,PRGM	;IS THERE A PRGM SET?
	JRST	EV1	;YES, SEARCH ITS SYMBOLS,ALL LEVELS
	HLRE	R,SYMPTR	;RESET R TO TOP OF TAB
	MOVNS	R
	ADD	R,SYMPTR
	JRST	EV1
;SCAN WHOLE SYMBOL TREE LOOKING FOR PROGRAM AND
; BLOCK WHICH CONTAIN SYM.  TYPE PRGM AND BLK
; IF APPROPRIATE.
EV9:	SETZM	SVTB
	SETZM	SVFB
	SETOM	SVF	;INDICATE NO MATCH FOUND YET
	HLRE	T,SYMPTR
	JUMPGE	T,CPOPJ	; EMPTY SYMBOL TABLE
	MOVNS	T
	ADD	T,SYMPTR
	HRRZ	R,T	;R POINTS AT END OF TABLE + 2
EV9A:	SUB	R,[2,,2]	;MOVE DOWN ONE ENTRY
	CAMN	R,SYMPTR	;LOOKING AT BOTTOM ENTRY?
	 JRST	EV9B	;YES
	LDB	T,[POINT 4,(R),3]	;GET TYPE BITS
	CAIN	T,3
	 JRST	EV9C	;BLOCK NAME
	CAIN	T,0
	 JRST	EV9D	;PROGRAM NAME
	TRNE	T,4
	 JRST	EV9A	;DELETED, IGNORE
	MOVE	T,(R)
	XOR	T,SYM
	TLZ	T,740000	;FLUSH TYPE BITS FROM CONSIDERATION
	JUMPN	T,EV9A	;DOESNT MATCH KEY, TRY NEXT
	AOSE	SVF	;IS THIS THE FIRST FIND?
	 JRST	EV9E	;NO
	MOVEM	R,BLVL	;YES. REMEMBER BLOCK LEVEL
	MOVE	T,1(R)
	MOVEM	T,SVBTS
	JRST	EV9A	;RESUME SCAN

;NOT FIRST MATCH
EV9E:	MOVE	T,1(R)
	CAME	T,SVBTS	;DEFINITION SAME AS FIRST MATCH?
	 RET		;NO, REPORT FAILURE
	SETZM	SVF	;MUST BE -1 OR 0 (0 FOR ON)
	JRST	EV9A	;RESUME SCAN
;BLOCK NAME ENCOUNTERED
EV9C:	SKIPN	SVF	;HAS A MATCH BEEN SEEN ALREADY?
	 JRST	EV9A	;YES, KEEP LOOKING
	MOVEM	R,SVFB	;NO, REMEMBER WHICH BLOCK WE'RE AT
	JRST	EV9A	;IN CASE WE GET A FIND IN THIS ONE



;PROGRAM NAME ENCOUNTERED
EV9D:	SKIPN	SVF	;HAS A MATCH BEENSEEN ALREADY?
	 JRST	EV9A	;YES. KEEP SCANNING
	MOVEM	R,SVTB	;NO. REMEMBER IN CASE MATCH IS FOUND
	SETZM	SVFB	;NEW PRGM. DON'T KNOW BLK YET
	JRST	EV9A	;KEEP SCANNING

;SCAN HIT BOTTOM ENTRY IN TABLE
EV9B:	SKIPE	SVF	;MATCH FOUND?
	 RET		;NO. REPORT FAILURE
	AOS	(P)	;SET FOR SKIP RETURN
	MOVEI	T,"'"
	CALL	TOUT
	SKIPE	R,SVTB	;DO WE HAVE A PRGM NAME,
	 CAMN	R,PRGM	;AND IS IT SAME AS CURRENT ONE?
	  JRST	EV9B1	;YES. DON'T BOTHER PRINTING PRGM NAME
	MOVE	T,(R)	;FROM NOW ON WHEN WE TYPE FOO$:, WE DO IT TOO!
	PUSH	P,R
	CALL	SPT1
	MOVSI	T+1,(ASCIZ /$:/)
	CALL	TEXT2
	POP	P,R
	CALL	SSBLK
	JRST	EV9B2

EV9B1:	MOVE	W1,BLVL
	CALL	SPT0
EV9B2:	MOVE	R,BLVL	;RETURN WHERE IN TABLE
	MOVE	T,1(R)	;AND VALUE
	RET

;COME HERE TO DO A $: WHEN A SYMBOL IS NOT IN THE CURRENT BLOCK

SSBLK:	MOVE	T,(R)
	MOVEM	T,SYM
	MOVE	R,SYMPTR	;SET PROGRAM NAME - DOLLAR COLON
SSET1:	JUMPGE	R,UNDEF
	MOVE	T,(R)
	CAMN	T,SYM
	 JRST	SSET2
	ADD	R,[2,,2]
	JRST	SSET1
SSET2:	MOVEM	R,PRGM
	SETZM	BLOCK
	CALL	SB1
	 CAIA
	MOVEM	R,BLOCK
	POPJ	P,
TEXTYP:	MOVE	R,LLOC
	MOVE	W1,[POINT 7,[ASCIZ /$0"/]]
	CALL	TYPE
	PUSH	P,R
TEXTL1:	CALL	FETCH
	 JRST	TEXTL3
	MOVE	TT2,T
	MOVNI	W1,5
	MOVE	TT1,[440700,,TT2]
TEXTL2:	ILDB	T,TT1
	JUMPE	T,TEXTL3
	CALL	TOUT
	AOJN	W1,TEXTL2
	AOS	R,(P)
	JRST	TEXTL1

TEXTL3:	POP	P,R
	MOVEI	T,"$"
	CALL	TOUT
	JRST	RETX

TEXCHR:	MOVEI	R,CHRO
	JRST	TEXHER

TEXSQZ:	MOVEI	R,R50PNT
	JRST	TEXHER

TEXSIX:	SKIPA	R,[SIXBP]	;OUTPUT . IN SIXBIT
TEXASC:	 MOVEI	R,TEXTT		;OUTPUT . IN ASCII
TEXHER:	TRNE	F,SUPTEM
	 MOVEM	SCH,SCHSAV	;SUPER TEMPORARY. SO SAVE
	MOVEM	R,SCH
	MOVS	S,[SCHM,,SCH]	;MODE SWITCHES TO MEMORY
	TLNE	F,CCF
	 BLT	S,ODFM		;WITH $$, MAKE MODES PERMANENT
	TLO	F,QF
	MOVE	T,LLOC
	PUSH	P,[RETX]
	JRST	LI2A

CHRO:	MOVE	W1,[POINT 7,[ASCIZ /$0#/]]
	CALL	TYPE
	MOVE	R,LLOC
	CALL	FETCH
	 JRST	ERR
	CALL	TOUT
	JRST	RETX

CHRI:	TRO	F,SUPTEM
	TLNN	F,CF
	 JRST	TEXCHR
	TRZ	F,SUPTEM
	TLNN	F,CCF
	 TRNN	F,Q2F
	  JRST	TEXCHR
	PUSH	P,[QUAN1]
	JRST	TEXI1

SQZI:	TRO	F,SUPTEM
	TLNN	F,CF		;NO $S TYPED. THIS IS SUPER TEMPORARY
	 JRST	TEXSQZ		;SO PRINT IT AND SET SUPTEM FLAG
	TRZ	F,SUPTEM	;NOT SUPER-TEMPORARY
	TLNN	F,CCF		;WAS IT $$&?
	 TRNN	F,Q2F		;WAS THERE A $& WITHOUT A NUMBER TYPED
	  JRST	TEXSQZ		;IF EITHER, GO AND TYPE IT
	PUSH	P,[SQZIN]
	JRST	TEXI1

SIXI:	TRO	F,SUPTEM
	TLNN	F,CF		;NO $S TYPED. THIS IS SUPER TEMPORARY
	 JRST	TEXSIX		;SO PRINT IT AND SET SUPTEM FLAG
	TRZ	F,SUPTEM	;NOT SUPER-TEMPORARY
	TLNN	F,CCF		;WAS IT $$'?
	 TRNN	F,Q2F		;WAS THERE A $' WITHOUT A NUMBER TYPED
	  JRST	TEXSIX		;IF EITHER, GO AND TYPE IT
	PUSH	P,[SIXBIN]
	JRST	TEXI1

TEXI:	TRO	F,SUPTEM
	TLNN	F,CF		;NO $'S TYPED. THIS IS SUPER TEMPORARY
	 JRST	TEXASC		;SO PRINT IT AND SET SUPTEM FLAG
	TRZ	F,SUPTEM	;NOT SUPER-TEMPORARY
	TLNN	F,CCF		;WAS IT $$"?
	 TRNN	F,Q2F		;WAS THERE A $" WITHOUT A NUMBER TYPED
	  JRST	TEXASC		;IF EITHER, GO AND TYPE IT
	PUSH	P,[TEXI2+1]	;THIS MUST BE $0", SO GET INPUT
	SETZM	TXUPRW
	SETZM	TXQUOT
TEXI1:	PUSH	P,2
	INTON
	MOVEI	1,100
	RFMOD
	IORI	2,17B23		;WAKEUP ON EVERYTHING
	SFMOD
	POP	P,2
	MOVEI	T,33
	MOVEM	T,SYL		;TERMINATE ON ALTMODE ALWAYS
	MOVEI	W1,5
	MOVEI	T-1,0
	CALL	TIN
	CAIN	T,33		;NEW ALT MODE, ESCAPE
	 JRST	[MOVE	W1,WRD2
	         IORM	W1,T
	         SETZM	WRD2
		 JRST	QUAN2]
	POP	P,A
	JRST	(A)

TEXI2:	CALL	TIN
	SKIPE	TXQUOT
	 JRST	TXQT
	CAMN	T,SYL
	 JRST	TEXI3
	SKIPE	TXUPRW
 	 JRST TXUPR  
	CAIN	T,"Q"-100
	 JRST	[SETOM TXQUOT
	         JRST	TEXI2]
	CAIN	T,"^"
	 JRST	[SETOM TXUPRW
	         JRST	TEXI2]
TEXI2A:	ROT	T,-7
	LSHC	T-1,7
	SOJG	W1,TEXI2
	MOVE	T,WRD2
	IORM	T,W		; SET BIT
	CALL	TEXDEP		; DEPOSIT THIS WORD OF TEXT
	JRST	TEXI2+1		; AND CONTINUE

TEXI3:	LSHC	T-1,-43
	JUMPLE	W1,[MOVE W1,WRD2
		   IORM W1,T
		   SETZM WRD2
		   JRST QUAN1]
	LSH	T,7
	SOJA	W1,.-2

TXQT:	SETZM	TXQUOT
	JRST	TEXI2A

TXUPR:	SETZM	TXUPRW
	CAIN	T,"?"
	 JRST	TXDEL
	SUBI	T,100
	JUMPL	T,ERR
	JRST	TEXI2A

TXDEL:	MOVEI	T,177
	JRST	TEXI2A

TEXDEP:	TLNN	F,ROF		; IS A REGISTER OPEN?
	JRST	TEXDE2
	CALL	TIN
	CAMN	T,SYL
	TLNE	F,CCF
	JRST	.+2
	RET
	PUSH	P,T
	MOVE	T,-1(P)
	XCT	1(T)
	MOVE	R,LLOCO
	CALL	DEP
	JRST	ERR
	POP	P,T
	AOS	LLOCO
	MOVEI	W1,5
	MOVEI	T-1,0
	RET
TEXDE2:	AOS	(P)		; Skip return
	CALL	TTPEEK		; Look ahead
	CAME	T, SYL		; Terminator?
	SKIPA	T, SYL		; Type for him
	JRST	TIN
	JRST	TOUT
SIXBIN:	SKIPA	W1,[6]
SIXBI1:	CALL	TIN		; INPUT TEXT (SIXBIT)
	CAMN	T,SYL
	 JRST	SIXBI2
	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
	ROT	T,-6
	LSHC	T-1,6
	SOJG	W1,SIXBI1
	CALL	TEXDEP		; DEPOSIT THIS WORD OF TEXT
	JRST	SIXBI1+1
SIXBI2:	MOVE	T,T-1
	JUMPLE	W1,[SETZM WRD2
		    JRST QUAN1]
	LSH	T,6
	SOJA	W1,.-2

SQZIN:	PUSH	P,[0]
	SKIPA	W1,[6]
SQZIN1:	CALL	TIN
	CAMN	T,SYL
	 JRST	SQZIN2
	CAIL	T,"A"+40
	 CAILE	T,"Z"+40
	  SKIPA
	   TRC	T,40
SQZIN3:	CAIL	T,"A"
	 CAILE	T,"Z"
	  JRST	.+3
	   SUBI	T,66
	   JRST	SQZIN4
	CAIL	T,"0"
	 CAILE	T,"9"
	  JRST	.+3
	   SUBI	T,57
	   JRST	SQZIN4
	CAIN	T,"."
	 JRST	[MOVEI T,45
	       JRST	SQZIN4]
	CAIN	T,"$"
	 JRST	[MOVEI T,46
	       JRST	SQZIN4]
	CAIN	T,"%"
	 JRST	[MOVEI T,47
	       JRST	SQZIN4]
	CAIE	T,"#"
	 JRST	[SUB P,[1,,1]
	       JRST	ERR]
SQZIN4:	MOVEI	2,50
	IMULM	2,(P)
	ADDM	T,(P)
	SOJG	W1,SQZIN1
	CALL	TEXDEP
	 JRST	SQZIN1+1

SQZIN2:	CALL	SQZFIX
	JUMPLE	W1,[PUSHJ P,SQZFIX
		   POP P,1
		   SETZM WRD2
		   JRST QUAN1]
	IMULI	T,50
	SOJA	W1,.-2

SQZFIX:	MOVE	1,WRD2
	IDIVI	1,12
	IMULI	1,10
	ADD	1,2
	LSH	1,36
	TLZ	1,37777
	MOVE	T,-1(P)
	IORM	1,T
	POPJ	P,

; ;R --  TAKE PRECEEDING SYMBOL AS RADIX 50

RDX50:	MOVE	T,SYM
	MOVEM	T,SYL
	TLZ	F,FPF!FEF!LTF!SF
	TRZ	F,SEMIF!SEMIF2	;ALLOW $ MODIFIERS
	JRST	L1RPR

;<SYM>$K -- KILL SYMBOL FOR OUTPUT
;<SYM>$$K -- KILL FOR INPUT AND OUTPUT
;SYM HAS THE SYMBOL
KILL:	TLNN	F,LTF		;DOES SYM CONTAIN A LETTER?
	JRST	KILTAB		;NO
	CALL	EVAL
	JRST	KILL1		;CANT FIND A DEFINED SYM BY THAT NAME

;FOUND.  R POINTS AT NAME-VALUE PAIR IN SYM TAB
	MOVEI	T,DELO/200000	;DELETE OUTPUT
	TLNE	F,CCF
	MOVEI	T,DELI/200000	;NO INPUT OR OUTPUT
	DPB	T,[POINT 2,(R),1]	;LEFT 2 BITS IN SYMBOL
	JRST	RETX


KILL1:	MOVE	R,ESTU		;REMOVE UNDEFINED SYMS
	JUMPGE	R,UNDEF		;EMPTY
KILL2:	CALL	EVAL0
	JRST	RETX
	CALL	REMUN
	JRST	KILL2



;REMOVE ONE SYMBOL FROM THE UNDEFINED TABLE
REMUN:	MOVE	S,[2,,2]
	ADDB	S,ESTU		;SHORTEN UNDEF TABLE AND MOVE ORG UP
	MOVE	W,-2(S)		;PUT SYM WHICH FELL OFF BOTTOM
	MOVEM	W,(R)		;IN PLACE OF SYM BEING DELETED
	MOVE	W,-1(S)
	MOVEM	W,1(R)
	RET

;$$K -- KILL ENTIRE SYMBOL TABLE
KILTAB:	TLNN	F,CCF		;HOW MANY $'S
	JRST	ERR		;NOT ENOUGH
	CALL	FLSSYM
	JRST	RETX

;SYMBOL TABLE FLUSHER
FLSSYM:	SKIPL	T,SYMPTR	;OLD SYMBOL POINTER
	MOVE	T,[-2,,HOME-2]
	MOVEM	T,SYMPTR
	CAMN	T,[-2,,HOME-2]
	JRST	FLSUNS	;NO OLD SYMS PAGES TO WORRY ABOUT
	HRLZI	R,0(T)
	TLZ	R,777000
	SUB	T,R
	ASH	T,-11
	TRZ	T,777000
	SETZ	3,		;WATCH OUT FOR KL20
FLSSP:	HRR	2,T		;PAGE
	HRLI	2,400000	;NDDT FORK
	SETOM	1		;DISMISS IT
	PMAP
	AOBJN	T,FLSSP
	MOVE	T,[-2,,HOME-2]	;"NULL" SYM PTR
	MOVEM	T,SYMPTR
	SETZM	PRGM
	SETZM	BLOCK
	SETZM	TBLK


;FLUSH UNDEFINED SYMBOL TABLE
FLSUNS:	SKIPL	T,ESTU
	 RET			;NONE
	HRLZI	R,0(T)
	TLZ	R,777000
	SUB	T,R
	ASH	T,-11
	TRZ	T,777000
	SETZ	3,		;WATCH OUT FOR KL20
FLSUN1:	HRR	2,T		;PAGE
	HRLI	2,400000	;NDDT FORK
	SETOM	1		;DISMISS IT
	PMAP
	AOBJN	T,FLSUN1
	SETZM	ESTU
	SETZM	ESTUT
	RET
;SYM HAS SYMBOL TO LEFT OF :
;DEFV HAS VALUE OF A IN A<B:
TAG:	TLNN	F,LTF   	; NO LETTERS IS ERROR
	JRST	ERR   	; GO SAY ERROR
	TLNE	F,FAF   	; DEFINE SYMBOLS
	JRST	tag0	;A<B:
	TLNE	F,CF	;$ TYPED?
	JRST	SETNAM	;<PROGRAM>$:
	MOVE	W,LLOCO	;<TAG>: COMMAND,  LLOCO=VALUE OF .
	TLNE	F,(DDTINT)
	JRST	ERR	; . WAS INSIDE OF NDDT
	HRRZM	W,DEFV

tag0:	call	defin
	jrst	retx	; Return
;DEFINE A SYMBOL
;SYM AND DEFV HAVE THE NAME AND VALUE

DEFIN:	CALL	EVALA	;DEFINED SYMBOL?
	 JRST	DEF1	;NO - DEFINE
	 JRST	DEF2	;YES, REDEFINE
DEF1:	MOVN	R,[2,,2]
	ADDB	R,SYMPTR	;MOVE UNDEFINED TABLE 2 REGISTERS
	HRRZ	T,ESTU
	SUBI	T,2
	HRL	T,ESTU
	HRRM	T,ESTU
	SKIPGE	ESTU
	BLT	T,-1(R)
DEF2:	MOVE	T,DEFV
	MOVEM	T,1(R)	;PUT IN NEW VALUE
	MOVSI	T,GLOBAL
	IORB	T,SYM
	MOVEM	T,(R)	;PUT IN NEW SYM AS GLOBAL
	MOVE	R,ESTU

DEF3:	JUMPGE	R,CPOPJ	;PATCH IN VALUE FOR UNDEF SYM ENTRY
	MOVE	T,SYM
	TLO	T,GLOBAL	;UNDEFINED TAB HAS GLOBAL ENTRIES
	CAME	T,(R)
	JRST	DEF4
	PUSH	P,R	;SAVE PTR
	SKIPL	R,1(R)	;IS ENTRY AN ADDITIVE REQUEST?
	JRST	DEF7	;NO, CHAINED IN RIGHT HALF
	CALL	FETCH
	 JRST	ERR
	TLNN	R,(STNEG)	;ADDITIVE OR SUBTRACTIVE?
	SKIPA	S,DEFV	;ADDITIVE
	MOVN	S,DEFV	;SUBTRACTIVE
	TLNE	R,(STLH)	;RIGHT OR LEFT HALF?
	JRST	DEF8	;LEFT
	ADD	S,T		;RIGHT
	HRRM	S,T
DEF5:	CALL	DEP
	 JFCL
DEF6:	POP	P,R
	CALL	REMUN
DEF4:	ADD	R,[2,,2]	;REMOVE THE NOW DEFINED SYMBOL
	JRST	DEF3
DEF7:	JUMPE	R,DEF6	;JUMP IF ALL DONE
	CALL	FETCH
	 JRST	ERR
	HRRZ	S,T	;SAVE CHAIN PTR
	HRR	T,DEFV	;REPLACE WITH NEW VALUE
	CALL	DEP
	 JRST	ERR	;LEAVES DANGLING CHAIN!!!
	HRRZ	R,S
	JRST	DEF7

DEF8:	HRLZS	S		;LEFT HALF FIXUP
	ADD	T,S
	JRST	DEF5
;<PROGRAM>$: COMMAND
SETNAM:	MOVE	R,SYMPTR	;SET PROGRAM NAME - DOLLAR COLON
SET1:	JUMPGE	R,UNDEF
	MOVE	T,(R)
	CAMN	T,SYM
	JRST	SET2
	ADD	R,[2,,2]
	JRST	SET1
SET2:	MOVEM	R,PRGM
	SETZM	BLOCK
	CALL	SB1
	 JRST	RETX
SBPRM:	MOVEM	R,BLOCK
	JRST	RETX


;SEARCH SYMBOLS IN PROGRAM BEGINNING AT R
;FOR BLOCK NAMED SYM
SB1:	CAMN	R,SYMPTR
	 RET		;HIT BOTTOM OF TAB.
	SUB	R,[2,,2]
	LDB	T,[POINT 4,(R),3]
	JUMPE	T,CPOPJ	;BEGINNING OF NEXT PROGRAM
	CAIE	T,3
	 JRST	SB1	;NOT A BLOCK NAME
	MOVE	T,(R)
	XOR	T,SYM
	TLZ	T,740000
	JUMPN	T,SB1	;NAME DOESN'T MATCH
	JRST	CPOPJ1

SETBLK:	TLNN	F,LTF
	 JRST	SQZI	;NO LETTERS GIVEN
	SKIPL	R,PRGM
	 JRST	ERR	;NO PROGRAM NAMED
	CALL	SB1
	 JRST	UNDEF
	TLNE	F,CF	;$ OR $$ COMMAND?
	JRST	SBPRM	;$: TO SET PROGRAM NAME
	MOVEM	R,TBLK
	JRST	L1RPR	;$$: TO SET BLOCK NAME
;FILE LOGIC

;THE FLAG TEMF IS USED TO CONTROL WHETHER OR NOT THE FORK IS
; TO BE STARTED AFTER THE GET ASSOCIATED WITH THE COMMAND (;Y, ;M
; ;L, OR $L). ON SUPPRESS RUNNING IT.

; ;Y -- YANK, BUT DON'T START A FILE
YANK:	MOVE	W1,[POINT 7,[ASCIZ /ank file: /]]
	TLNE	F,CF		; ALT-SEMI-Y
	 MOVE	W1,[POINT 7,[ASCIZ /ank data file: /]]
	TRO	F,TEMF	;SUPPRESS RUNNING IT
	JRST	LODFIL


; ;M -- MERGE FILE INTO CURRENT USER FORK
MERGE:	MOVE	W1,[POINT 7,[ASCIZ /erge file: /]]
	TRO	F,TEMF		;SUPPRESS RUNNING IT
	JRST	LODFIL		;BYPASS NEWFORK GETTER

; ;L -- RUN THE NAMED FILE
LOADGO:	MOVE	W1,[POINT 7,[ASCIZ /oadgo:   /]]
	TRZ	F,TEMF	;ALLOW IT TO RUN

LODFIL:	CALL	TYPE
LODFI2:
IFN	KL20F,<	HRROI 1,[ASCIZ /EXE/]>
IFE	KL20F,<	hrroi	1, [asciz /SAV/]>
	MOVEM	1,DEFALT+5
	MOVSI	1,(gj%old!gj%cfm)
	MOVEM	1,DEFALT
	MOVEI	1,DEFALT
	MOVEI	2,0
	JRST	ASJFN

;$L -- RUN THE LOADER
LOADER:
IFE	KL20F,<	MOVE W1,[POINT 7,[ASCIZ /oader [Confirm]/]]>
IFN	KL20F,<	MOVE W1,[POINT 7,[ASCIZ /ink [Confirm]/]]>
	CALL	TYPE
 	MOVEI	1,.PRIIN
	CFIBF		; RESET BUFFER AND ASK
	PBIN
	CAIE	1,15	; OK ON CRLF
	 CAIN	1,12
	  CAIA
	   JRST	[MOVE W1,[POINT 7,[ASCIZ / Aborted?/]]
		 CALL TYPE
		 JRST	DD1.5]
	TLZ	F,CF
	CALL	KILFRK
	CALL	NEWFRK
	TRZ	F,TEMF	;ALLOW IT TO RUN
	HRLZI	1,100001
IFE	KL20F,<	HRROI 2,[ASCIZ /<SUBSYS>LOADER.SAV/]>
IFN	KL20F,<	hrroi	2, [asciz /SYS:LINK.EXE/]>

; 1,2 ARE SET FOR GTJFN

ASJFN:	PUSH	P,2
	PUSH	P,1
	MOVE	1,FORK
	GEVEC		;MAYBE NULL
	POP	P,1
	EXCH	2,0(P)	;SAVE OLD EV
	CALL	GETFIL	;LOAD FILE
	CALL	SYMVEC	;GET SYMS, ENT. VEC TO R
LODDN1:	MOVEM	R,0(P)
	MOVEI	2,0(R)
	TLO	2,(1B5)	;USERMODE
	MOVEM	2,PC
	MOVEM	2,REALPC
	POP	P,2
	MOVE	1,FORK
	SEVEC
	TRNE	F,TEMF	;ARE WE SUPPOSED TO RUN IT?
	 JRST	DDT	;NO
	CALL	CRF
	JRST	TOUSER
; ;O -- OBTAIN SYMBOL FILE
OBTAIN:
YNKSYM:	MOVE	W1,[POINT 7,[ASCIZ /btain symbol file: /]]
	CALL	TYPE
	CALL	FLSSYM	;FLUSH PAGES CONTAINING PREVIOUS SYMS
	HRROI	1,[ASCIZ /SYMBOLS/]
	MOVEM	1,DEFALT+5
	MOVSI	1,(gj%old!gj%cfm)
	MOVEM	1,DEFALT
	MOVEI	1,DEFALT
	MOVEI	2,0
	CALL	GETJFN
	 JRST	SYMSO4	;NO SYMBOLS??
	MOVEM	1,TEM1
	MOVE	2,[44B5!1B19]
	OPENF
	 JRST	SYMSO3

YNKSY1:	BIN
	JUMPGE	2,YNKSY9		;NO DEFINED TAB
	HLRE	3,2		;THE NEGATIVE LENGTH

YNKSY2:	MOVEI	T,HOME
	ADD	T,3			;LOWEST ADDR OF DEF SYMTAB
	HRL	T,3			;MAKE AOBJN PTR
	MOVEM	T,SYMPTR		;THAT'S THE SYMTAB PTR
	MOVSI	2,(POINT 36,0)
	HRR	2,T			;36-BIT POINTER
	SIN

YNKSY3:	BIN			;UNDEF TAB IOWD
	JUMPGE	2,YNKSY8		;NO UNDEFINED TABLE
	HLRE	3,2		;GET NEG. LENGTH
	MOVE	T,SYMPTR		;PUT UNDER DEFINED TAB
	ADD	T,3			;BASE OF UNDEF TAB
	HRL	T,3			;MAKE AOBJN PTR
	MOVEM	T,ESTU		;THAT'S THE UNDEF. PTR
	MOVSI	2,(POINT 36,0)
	HRR	2,T
	SIN

YNKSY4:	MOVE	1,TEM1
	CLOSF
	 JRST	ERR
	JRST	DD1

YNKSY8:	SETZM	ESTU	;SAY NO UNDEF SYMTAB
	JRST	YNKSY4	;GO CLOSE FILE

YNKSY9:	MOVE	T,[-2,,HOME-2]	;DUMMY UP A GOOD PTR
	MOVEM	T,SYMPTR
	JRST	YNKSY3	;LOOK FOR UNDEF. SYMTAB
;GET FILE, SYMBOLS, AND ENTRY VECTOR (IF ANY)
;1,2 ARE SETUP FOR GTJFN

GETFIL:	CALL	GETJFN		;ONLY FLUSH STUFF IF GETJFN WINS
	 JRST	[MOVE W1,[POINT 7,[ASCIZ / GTJFN Failed?/]]
	       CALL	TYPE
	       CALL	CRF
	       JRST	DD1.5]
	HRRZM	1,SUBSYS
	HRRZM	1,JFN
	HRROI	1,JFNDIR
	MOVEM	1,DEFALT+.GJDIR
	MOVE	2,JFN
	MOVSI	3,(JS%DIR)
	SETZ	4,
	JFNS
	HRROI	1,JFNNAM
	MOVEM	1,DEFALT+.GJNAM
	MOVSI	3,(JS%NAM)
	JFNS
	CALL	UNMAP		;FLUSH PAGE IN WINDOW
	CALL	KILFRK
	CALL	NEWFRK
	TLNE	F,CF
	 JRST	GETDFL
	HRL	1,FORK
	HRR	1,JFN
	GET
	RET

;GET A FILE OF NON-RUNNABLE STUFF (LIKE $0L ON ITS)
GETDFL:	HRRZ	1,JFN
	MOVE	2,[444400,,OF%RD]
	OPENF
	 JRST	[MOVE W1,[POINT 7,[ASCIZ / Can't open file?/]]
	       CALL	TYPE
	       JRST	GETDF2]
	MOVEM	1,GDFROM
	MOVE	1,FORK
	MOVEM	1,GDTO

GDENTR:	SKIPN	1,DEFV			; GET LOWER LIMIT
	 MOVE	1,SYL
	MOVEM	1,DEFV			; SAVE AWAY
	MOVEM	1,SYL			; TEMP
	SKIPN	1,ULIMIT
	 MOVEI	1,777777
	MOVEM	1,ULIMIT			; SAVE UPPER LIMIT
	SETZ	2,
GETDLP:	HRLZ	1,GDFROM
	HRR	1,DEFV
	PUSH	P,2
	RPACS				; FIND THIS PAGE
	TLNN	2,10000
	 JRST	[POP P,2
	         JRST	GETDF0]		; IF DOESN'T EXIST, STOP
	POP	P,2
	HRL	2,GDTO
	MOVSI	3,(PM%RD+PM%CPY)
	MOVE	TT1,GDFROM
	CAMN	TT1,FORK
	 JRST	[PUSH P,1
	       PUSH	P,2
	       MOVE	R,DEFV
	       LSH	R,9
	       ADDI	R,100
	       CALL	FETCH
	        JRST	ERR
	       CALL	DEP
	        JRST	ERR
	       POP	P,2
	       POP	P,1
	       JRST	.+1]
	PMAP				; KEEP THOSE PAGES COMING
	AOS	1,DEFV
	CAMG	1,ULIMIT
	 AOJA	2,GETDLP
GETDF0:	CALL	CRF
	MOVE	T,DEFV
	SUB	T,SYL			; #PAGES TRANSFERRED
	MOVEM	T,TT2
	JUMPE	T,[MOVE W1,[POINT 7,[ASCIZ /No pages./]]
		 CALL TYPE
		 JRST GETDF1]
	CALL	TOC
	MOVE	W1,[POINT 7,[ASCIZ / page/]]
	CALL	TYPE
	MOVEI	1,TT2
	CAIE	1,1
	 JRST	[MOVE W1,[POINT 7,[ASCIZ /s/]]
	       CALL	TYPE
	       JRST	.+1]
	MOVE	W1,[POINT 7,[ASCIZ / starting with page /]]
	CALL	TYPE
	MOVE	T,SYL
	CALL	TOC
	MOVEI	T,"."
	CALL	TOUT
	HRRZ	1,GDTO
	CAME	1,FORK
	 JRST	GETDF3
	MOVE	1,JFN
	MOVE	2,SYL
	LSH	2,9
	SFPTR
	 JRST	ERR
	MOVE	2,[444400,,AC0]
	MOVNI	3,20
	SIN
	MOVE	1,FORK
	MOVEI	2,AC0
	SFACS

GETDF1:	HRRZ	1,JFN
	CLOSF
	 JFCL
GETDF2:	SUB	P,[2,,2]
GETDF4:	SETZM	DEFV
	SETZM	ULIMIT
	JRST	DDT

GETDF3:	MOVE	1,GDTO
	HRLI	1,12
	SETO	2,
	MOVE	3,TT2
	LSH	3,9
	CHFDB
	MOVE	1,GDTO
	CLOSF
	 JFCL
	JRST	GETDF4

;DO AN ITS $0Y (UN-ALT-SEMI-Y)

UNASY:	MOVE	W1,[POINT 7,[ASCIZ /nyank data to file: /]]
	CALL	TYPE
	HRROI	1,[ASCIZ /EXE/]
	MOVEM	1,DEFALT+.GJEXT
	MOVSI	1,(gj%fou!gj%msg!gj%cfm)
	MOVEM	1,DEFALT+.GJGEN
	MOVEI	1,DEFALT
	MOVEI	2,0
	CALL	GETJFN
	 JRST	ERR
	MOVEM	1,TT1
	MOVE	2,[440000,,OF%WR]
	OPENF
	 JRST	ERR
	MOVEM	1,GDTO
	MOVE	1,FORK
	MOVEM	1,GDFROM
	MOVEI	2,AC0
	RFACS
	MOVE	1,GDTO
	MOVEI	2,AC0
	MOVNI	3,20
	SOUT
	JRST	GDENTR

;DO A GTJFN, ALLOWING THE CURRENT ESCAPE CHARACTER
;TO BE TYPED IN.
GETJFN:	PUSH	P,1
	MOVE	1,ESCCOD
	DTI			;ALLOW IT TO BE TYPED IN
	POP	P,1
	GTJFN
	 JRST	GETJF7		;SEE IF TERMINATOR WAS ESCAPE CHARACTER

GETJF5:	PUSH	P,1
	HRLZ	1,ESCCOD
	ATI
	POP	P,1
	JRST	CPOPJ1		;SAY OK TO CALLER

GETJF7:	CAIE	1,GJFX4		;ILLEGAL CHR IS REASON FOR LOSAGE?
	 JRST	GETJF8		;NO
	HLRZ	1,2		;GET INPUT JFN
	SKIPN	1
	HLRZ	1,DEFALT+1
	CAIN	1,100
	BKJFN
	 JRST	GETJF8		;NOT TTY: OR BKJFN BAD
	BIN			;GET PREVIOUS CHR
	CAMN	2,ESCCHR		;IS IT THE ESCAPE CHR?
	 JRST	WRONG		;YES (ATI WILL HAPPEN IN MAIN LOOP)

GETJF8:	HRLZ	1,ESCCOD
	ATI
	RET			;NO SKIP


;GET A NEW FORK
NEWFRK:	SETZ	1,
	CFORK
	 JRST	ERR
	MOVEM	1,FORK
	MOVEM	1,TPFORK
	FFORK			;NDDT DEALS ONLY WITH FROZEN FORKS
	CALL	SETTRP
	MOVEI	1,400000		;NDDT
	RPCAP
	SETZ	3,			;PASS CAP'S BUT NOT ENABLED
	MOVE	1,FORK
	EPCAP
	MOVNI	1,5
	RUNTM
	MOVEM	1,TIMUSD
	MOVEM	3,TIMCON
	RET


KILFRK:	CALL	UNMAP		;FLUSH ANY MAPPED PAGE
	MOVE	1,TPFORK
	KFORK
	SETZM	FORK
	SETZM	USRPSI
	SETZM	USRPSI+1
	SETZM	USRPSI+2
	SETZM	USRPSI+3
	SETZM	BPTFLG
	SETZM	SYMPTR
	SETZM	ESTU
	SETZM	PRGM
	SETZM	BLOCK
	SETZM	TBLK
	MOVE	TT,PCSTAK
	MOVEM	TT,PCSPTR
	RET

;SET JSYS TRAPS FOR BPT IN TPFORK
SETTRP:	MOVE	1,TPFORK
IFE KL20F,<	HRLI 1,(1B6)>
IFN KL20F,<	hrli 1, .tfres>
	TFORK			; RESET JSYS TRAPS
IFE KL20F,<	 HALTF>
IFE KL20F,<	HRLI 1,(1B3)>
IFN KL20F,<	hrli 1, .tfsps>
	MOVSI	2,2
	TFORK			; TURN ON TRAPS FOR BPT
IFE KL20F,<	 HALTF
	HRLI	1,(1B0)
	MOVEI	2,JTAB>
IFN KL20F,<	hrli 1, .tfset
	movei	3, jtab>
	TFORK
IFE KL20F,<	 HALTF>
	RET

.R.==<BPT>&777
.Q.==.R./^D36
.R.==.R.-<.Q.*^D36>
JTAB:	REPEAT	.Q.,<0>
	1B<.R.>
	REPEAT	^D<<512+35>/36>-.Q.-1,<0>
;GET NEW SYMBOLS, ENTRY VECTOR
;FLUSH BREAKPOINTS, AND PAGES CONTAINING OLD SYMTAB FIRST.
SYMVEC:	CALL	FLSBPT		;FLUSH BREAKPOINTS
	CALL	FLSSYM		;FLUSH OLD SYMBOLS

NEWSYM:	MOVEI	R,116		;JOBSYM
GTSYMS:	CALL	FETCH		;ENTRY FROM ;S
	 MOVE	T,[-2,,HOME-2]	;JOBSYM READ-PROTECTED??
	JUMPE	T,.-1
	MOVEM	T,SYMPTR
	CAMN	T,[-2,,HOME-2]
	JRST	ENTVEC		;NO SYMS LOADED
	HRLZI	R,0(T)
	TLZ	R,777000
	SUB	T,R
	ASH	T,-11
	TRZ	T,777000
	MOVE	W1,T
;SHARE THE SYMBOL TABLE
SHRTAB:	HRR	1,W1	;PAGE
	HRL	1,FORK	;USER'S FORK
	RPACS
	TLNE	2,(1B10)	;PRIVATE ?
	JRST	SHRTA2	;YES, COPY IT

;SHARE THE PAGE
	RMAP
	HRR	2,W1	;SAME PAGE
	HRLI	2,400000	;NDDT'S FORK
	MOVSI	3,(1B2!1B4!1B9)	;R,C,X
	PMAP
SHRTA0:	AOBJN	W1,SHRTAB
SHRTA1:	JRST	ENTVEC	;NOW HANDLE THE ENTRY VECTOR

;COPY PRIVATE PAGE FROM USER TO NDDT
SHRTA2:	HRRZ	R,W1	;PAGE NUMBER
	LSH	R,11	;FIRST ADDRESS
	CAIGE	R,20
	MOVEI	R,20	;DON'T COPY AC'S.
SHRTA3:	CALL	FETCH	;READ FROM USER FORK
	 JRST	ENTVEC	;READ PROTECTED??
	MOVEM	T,0(R)	;INTO NDDT FORK
	MOVEI	R,1(R)
	TRNE	R,777	;HIT NEXT PAGE?
	JRST	SHRTA3	;NO, COPY ANOTHER WORD
	JRST	SHRTA0	;YES, WORRY ABOUT IT

;HANDLE ENTRY VECTOR
ENTVEC:	CALL	CHKSYM
	MOVE	1,FORK
	GEVEC
	RET
; ;U  UNLOAD THE CURRENT CORE IMAGE
; ;;U  UNLOAD CORE AFTER HAVING COPIED SYMBOL TABLE BACK
; OPPOSITE OF ;Y

SEMI.U:	TLNE	F,CF
	 JRST	UNASY
	TLNE	F,QF!CF		;REASONABLE COMMAND?
	 JRST	ERR
	TRNN	F,SEMIF2		;HOW MANY SEMICOLI?
	 JRST	UNGET		;ONLY ONE

UNLOAD:	MOVE	W1,[ASCIZ /nload/]
	CALL	TEXT
	MOVE	T,[RADIX50 4,PAT..];SETUP FOR DEFINE
	MOVEM	T,SYM
	MOVE	R,XRG		;CURRENT PATCH LOCATION ($X)
	MOVEM	R,DEFV
	CALL	DEFIN		;DO THE DEFINITION
	HRRZ	T,ESTU		;WHERE UNDEFINED TABLE IS
	SKIPL	ESTU		;BUT IS THERE ONE?
	 HRRZ	T,SYMPTR		;NO, USE DEFINED TABLE
	JUMPE	T,UNLOA9		;JUMP IF NO SYMBOLS AT ALL
	HRRZ	R,XRG		;$X LOCATION
	SUB	T,R			;GET AMOUNT OF FREE SPACE LEFT
	CAIL	T,10		;ENOUGH FOR NEXT TIME?
	 TDZA	T,T		;YES.  DON'T MOVE SYMTAB
	 SUBI	T,100		;NO. MAKE 100 FREE LOCATIONS FOR PATCHES
	MOVNS	T			;MAKE OFFSET POSITIVE
	CALL	STOSYM		;STORE SYMTAB BACK INTO USER SPACE
	JRST	UNLOA9		;NOW GO DO A ;U
;MAKE A COPY OF NDDT'S VERSION OF THE USER'S TABLE IN THE USER SPACE
; T/  OFFSET TO MOVE SYMTABLE UP BY

STOSYM:	PUSH	P,T		;SAVE OFFSET FOR BELOW
	HLLZ	S,SYMPTR		;NEG. LENGTH OF DEFINED TABLE
	ADD	S,ESTU		;ACCOUNT FOR UNDEFINED TABLE
	HLRES	S
	MOVNS	S			;TOTAL LENGTH OF BOTH TABLES
	HLRE	R,SYMPTR
	MOVNS	R
	ADD	R,SYMPTR
	HRRZS	R			;TOP+1 (SOURCE IN NDDT)
	ADD	T,R
	HRRZS	T			;TOP+1 (DEST. IN USER)
	TRO	F,TEMF		;SAY IT IS FIRST TIME THROUGH

STOSY0:	PUSH	P,T		;SAVE TARGET ADDRESS
	SUBI	R,1		;MOVE TO NEXT DATA ADDRESS
	MOVE	T,0(R)		;PICK UP A DATA WORD
	EXCH	R,0(P)		;GET TARGET ADDR, SAVE SOURCE
	TRZN	F,TEMF		;1ST TIME, OR
	TRNN	R,777		;GOING INTO NEW PAGE?
	 SOJA	R,STOSY1		;YES.  MUST MAP THE PAGE
	 SOJA	R,STOSY2		;NO.  IT IS MAPPED FROM LAST TIME

STOSY1:	PUSH	P,R		;SAVE TARGET ADDR
	CALL	DEP		;MAP AND STORE
	 JRST	ERR		;FAILED.  JUST GET OUT
	JRST	STOSY3

STOSY2:	PUSH	P,R		;SAVE TARGET ADDR
	ANDI	R,777		;SAVE OFFSET INTO PAGE
	MOVEM	T,UCORE(R)	;STORE THE WORD

STOSY3:	POP	P,T			;RESTORE TARGET ADDRESS
	POP	P,R			;AND SOURCE
	SOJG	S,STOSY0		;AND DO MORE IF NEEDED.

	MOVE	T,SYMPTR
	ADD	T,0(P)		;COMPUTE NEW SYMPTR
	MOVEI	R,116
	SKIPGE	T
	CALL	DEP
	 JFCL
	POP	P,T
	ADD	ESTU		;OFFSET UNDEFINED POINTER TOO
	MOVEI	R,117
	SKIPGE	T
	CALL	DEP
	 JFCL
	RET
; ;U COMMAND

UNLOA9:	SKIPA	W1,[POINT 7,[ASCIZ / to file: /]]
UNGET:	MOVE	W1,[POINT 7,[ASCIZ /nget to file: /]]
	CALL	TYPE
IFN ka10f!ki10f,<	HRROI 1,[ASCIZ /SAV/]>
IFN KL20F,<		hrroi	1, [asciz /EXE/]>
	MOVEM	1,DEFALT+5
	MOVSI	1,(gj%fou!gj%msg!gj%cfm)
	MOVEM	1,DEFALT+0	;FLAGS
	MOVEI	1,DEFALT
	MOVEI	2,0
	CALL	GETJFN
	 JRST	ERR
	MOVEM	1,TT1

UNGET0:	MOVE	1,FORK
	GEVEC
	JUMPN	2,UNGET2

UNGET1:	MOVE	W1,[POINT 7,[ASCIZ /
Start address is /]]
	CALL	TYPE
	HRRZ	T,LLOCO
	MOVE	1,FORK
	HRLI	2,1	;LEN 1
	HRR	2,T		;AT "."
	SEVEC
	CALL	PAD

UNGET2:	HRR	1,TT1
	HRL	1,FORK
	MOVE	2,[-1000,,520000]
	SETZM	3
	SSAVE
	JRST	DD1
; ;W -- WRITE OUT SYMBOL FILE

SYMSOT:	MOVE	W1,[POINT 7,[ASCIZ /rite symbols on file: /]]
	CALL	TYPE
	TRO	F,TEMF!TEM2F	;SAY BOTH TABS EXIST
	SKIPGE	R,SYMPTR
	CAMN	R,[-2,,HOME-2]
	 TRZ	F,TEMF		;NO MAIN SYMTAB
	SKIPL	R,ESTU
	 TRZ	F,TEM2F		;NO UNDEF TAB
	TRNN	F,TEMF!TEM2F
	JRST	SYMSO4		;NOTHING TO WRITE

SYMSO1:	HRROI	1,[ASCIZ /SYMBOLS/]
	MOVEM	1,DEFALT+5
	MOVSI	1,(1B0!1B4)
	MOVEM	1,DEFALT
	MOVEI	1,DEFALT
	MOVEI	2,0
	CALL	GETJFN
	 JRST	ERR
	MOVEM	1,TEM1
	MOVE	2,[44B5!1B20]
	OPENF
	 JRST	SYMSO3

SYMSO2:	TRNE	F,TEMF
	SKIPL	T,SYMPTR
	 SETZM	T
	CALL	WRTSYM
	TRNE	F,TEM2F
	SKIPL	T,ESTU
	 SETZM	T
	CALL	WRTSYM
	MOVE	1,TEM1
	CLOSF
	 JFCL
	JRST	DD1

SYMSO3:	MOVE	1,TEM1
	CLOSF
	 JFCL
	JRST	ERR

SYMSO4:	MOVE	W1,[POINT 7,[ASCIZ/	No symbols??/]]
	CALL	TYPE
	JRST	ERR


WRTSYM:	PUSH	P,3
	HLL	2,T			;GET NEG. LENGTH
	HRRI	2,-1(T)		;MAKE IOWD
	BOUT
	HRLI	2,004400		;POINT 36,.-.,-1
	HLRE	3,T		;NEG. LENGTH
	SKIPGE	3
	SOUT
	POP	P,3
	RET
; ;E COMMAND -- CHANGE ESCAPE CHARACTER

ESCAP:	MOVE	W1,[POINT 7,[ASCIZ /scape character is: /]]
	CALL	TYPE
	MOVE	1,ESCCOD		;THE OLD ESCAPE CODE
	DTI
	MOVEI	1,400000		;NDDT
	RPCAP
	MOVE	TT,3

	MOVNI	1,5		;SAY WHOLE JOB
	RTIW			;GET CURRENT TIW
	PUSH	P,2
	TLNE	TT,(1B0)		;SEE IF ^C CAP IS ENABLED
	SETZB	2,3
	STIW			;ALLOW EVERYTHING TO BE TYPED IN
ESCAP0:	TYI
	MOVE	T,1
	MOVNI	1,5
	SETZM	3
	POP	P,2
	STIW			;RESTORE THINGS AS THEY WERE
	PUSH	P,T
	CAIN	T,177		;RUBOUT?
	MOVEI	T,^D28		;YES
	CAIN	T,40		;SPACE
	MOVEI	T,^D29
	CAILE	T,^D29		;REST ARE ILLEGAL
	JRST	ERR

ESCAP1:	PUSH	P,T		;SAVE FOR LATER
	MOVNS	T
	MOVSI	W,(1B0)		;A SINGLE BIT
	ROT	W,0(T)		;CONVERT TO MASK
	TDNN	W,[1B0!17B10!1B13!3B29]	;DID TENEX ECHO PROPERLY?
	JRST	ESCAP3		;YES
	MOVEI	T,"^"
	CALL	TOUT
	MOVE	T,-1(P)		;THE CHARACTER
	TRC	T,100		;MAKE INTO NON-CONTROL EQUIVALENT
	CALL	TOUT

ESCAP3:	POP	P,ESCCOD		;NEW ESCAPE CODE
	POP	P,ESCCHR		;NEW ESCAPE CHARACTER

ESCAP4:	MOVE	R,SAVCOC
	DPB	R,COCPTR		;POINTER INTO CCOC WORD

ESCAP5:	MOVE	TT,ESCCHR		;NEW ESCAPE CHARACTER
	IDIVI	TT,^D18
	ASH	TT1,1
	MOVNS	TT1
	ADDI	TT1,^D34		;NUMBER OF BITS LEFT IN WHICHEVER WORD
	ADD	TT,[2B11+TTYCC2]	;TWO BIT BYTE POINTER
	DPB	TT1,[POINT 6,TT,5]	;INSERT POSITION
	MOVEM	TT,COCPTR
	LDB	R,TT		;GET CURRENT SETTING
	MOVEM	R,SAVCOC
	MOVEI	R,0
	DPB	R,TT		;TURNOFF ECHOING FOR THAT CHAR

ESCAP6:	MOVEI	1,101
	MOVE	2,TTYCC2
	MOVE	3,TTYCC3
	SFCOC
	HRLZ	1,ESCCOD
	ATI
	JRST	DD1
;***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:	CAML	P,[LPDL-4,,0]	;LEFT PARENTHESIS
	JRST	ERR
	PUSH	P,F		;RECURSE FOR OPEN PAREN
	PUSH	P,WRD
	PUSH	P,FRASE
	PUSH	P,FRASE1
	AOS,PRNC
	JRST	LIS

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

ACCF:	MOVE	R,T		;COMMA PROCESSOR
ACCX:	XCT	ACCCF		;MOVEI T,"A" AS IN A,,B
	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
	IDIVI	W1,7
	LSH	R,27(W1)
	ADD	T,R
	ADDB	T,WRD
	JRST	SPAC1

ACCF1:	ADD	T,WRD		;SET LEFT HALF OF A,,B
	HRLZM	T,WRD
	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
; ;S --  SNARF SYMBOLS
;ARGUMENT IS ADDRESS CONTAINING POINTER TO TABLE
;ARG IS TAKEN AS 116 IF NOT SUPPLIED

SNARF:	TLNN	F,QF		;ARG?
	MOVEI	T,116		;NO, DEFAULT
	MOVE	R,T
	PUSH	P,R
	CALL	FETCH
	 JRST	ERR		;READ PROTECTED
	JUMPGE	T,ERR		;BAD PTR
	TLNE	T,1		;MUST BE AN EVEN NUMBER LONG
	JRST	ERR
	CALL	FLSSYM		;FLUSH OLD SYMBOL TABLE
	POP	P,R
	CALL	GTSYMS		;GET AND CHECK NEW TABLE
	JRST	DDT
;  ;?  TYPE THE MOST RECENT ERROR STRING
; NUM;?  TYPE VALUE OF NUM AS ERSTR

SEM.QU:	PUSH	P,T
	CALL	CRF
	POP	P,T
	HRROI	1,STRBUF		;DUMP INTO STRING BUFFER FOR OUTPUT
	SETO	2,
	TLNE	F,QF
	 MOVEI	2,0(T)
	HRL	2,FORK
	SETZ	3,
	ERSTR
	 JRST	SEMQU1		; No string for number
	 JRST	ERR
	SETZ	2,
	IDPB	2,1		;MAKE ASCIZ
	MOVE	W1,[POINT 7,STRBUF]
	CALL	TYPE		;COMMON OUTPUT ROUTINE
	JRST	DD1		;SO "OUTPUT TO FILE" WILL WORK

; No string for number
SEMQU1:	TLZ 2,-1
	CAIE 2,-1
	 JRST ERR		; User specified bad number
	MOVE 1,FORK
	GETER
	HRROI 1,[ASCIZ /No string for error /]
	PSOUT
	TLZ 2,-1
	MOVEI 1,.PRIOU
	MOVEI 3,10
	NOUT
	 JRST ERR
	JRST DD1
;REGISTER EXAMINATION LOGIC

;LLOCO  HAS CURRENTLY OPEN REGISTER. SET FROM C(LLOC) BY / ETC.
;LLOC   HAS CURRENT SEQUENCE. RESTORED FROM SAVLOC BY $LF ETC.
;SAVLOC HAS SAVED SEQUENCE. SET FROM LLOC BY TAB ETC.


;PRINT ADDRESS AND EXAMINE REGISTER
;ENTER HERE FROM TAB, ^, BS, LF, OR FROM $E, $N, OR $W
LI1:	MOVEM	T,LLOC		;MAY HAVE DDTINT FLAG ON IN LEFT HALF
	MOVEM	T,LLOCO
	INTON
	CALL	PAD
	MOVEI	T,"/"
	CAME	SCH,SCHM		; TEMP MODE SAME AS PERM MODE?
	JRST	LI3
LI4:	TLNE	F,STF
	MOVEI	T,"!"
	CALL	TOUT

;ENTER HERE FROM /, [, ], !, \
;ADDRESS HAS BEEN PRINTED, EXAMINE CONTENTS
LI2:	TLZ	F,ROF		;CLOSE REGISTER(IN CASE OF SEARCHES ETC)
	CALL	LCT
LI2A:	MOVE	R,LLOCO
	CALL	FETCH
	 JRST	LINCR
	TLO	F,ROF		;REGISTER IS NOW OPEN
	TLNE	F,STF		;IN SUPPRESSED TYPE-OUT MODE?
	 JRST	DD2		;YES
	JRST	CONSYM		;GO PRINT IN PROPER MODE AND RET


LI3:	CAIN	SCH,FTOC		; NO, IF CONSTANT MODE
	 MOVEI	T,"["		; USE [
	CAIN	SCH,PIN		; IF SYMBOLIC MODE
	 MOVEI	T,"]"		; USE ]
	JRST	LI4

LINCR:	TLO	F,ROF		;PAGE NOT ASSIGNED, PRETEND WAS OPENED
	MOVEI	W1,"?"		;BUT TYPE OUT ?
	JRST	TEXT		;RETURN IS A POPJ
;LINEFEED COMMAND
LINEF:	CALL	DEPRA		;NEXT REGISTER
IFE KL20F,<			;LF WILL GENERATE CRLF (SEE SFCOC WORDS)
	CALL	CRN		;HE TYPE THE LINEFEED, JUST NEED CAR RET
>				;<LF><CR> CAUSES LOSSAGE ON SOME TERMINALS
	TLNE	F,CF		;$ MODIFIER?
	 JRST	LINEF1		;YES, POP RING BUFFER AND ADD 1
	AOS	T,LLOC		;MOVE  . TO NEXT LOCATION
	JRST	VARRW1

LINEF1:	TLNE	F,CCF		;BUT TWO $'S TYPED?
	 SKIPA	T,LLOC		;YES, JUST CLOSE PATCH
	CALL	PTRB		;POP THE RING BUFFER
	AOJA	T,VARRW1

; ^ AND BACKSPACE COMMANDS
VARRW:	CALL	DEPRA
	CALL	CRF
	TLNN	F,CF		;POP RING BUFFER?
	 SKIPA			;NOPE
	  TLNE	F,CCF		;BUT TWO $'S TYPED?
	   SKIPA	T,LLOC		;YES, JUST CLOSE PATCH
	    CALL	PTRB		;POP THE RING BUFFER
	SOS	T			;PREVIOUS LOCATION
VARRW1:	MOVEM	T,LLOC
	INTON
	SETZM	PINFF		;DON'T PRINT AC AND/OR EFF ADR
	JRST	LI1		;DO THE EXAMINE

;RETURN COMMAND
CARR:	CALL	DEPRA		;CLOSE THE REGISTER
	TLNN	F,CF		;$CR  CHANGES SEQUENCE
	 JRST	DD1.5
	TLNE	F,CCF		;DOUBLE ALTMODE?
	 JRST	DD1.5		;YES, THAT IS ALL WE WANT TO DO
	CALL	PTRB		;ELSE POP THE RING BUFFER
	SETZM	PINFF		;NO LONG INSTRUCTION PRINT
	PBIN			;READ THE NEXT CHARACTER
	CAIE	1,12		;IF <LF> THEN FLUSH IT
	 MOVEM	1,BBC		;ELSE BUFFER IT
	JRST	LI1		;PRINT THE LOCATION AND GO ON


; [ COMMAND -- OPEN AS A CONSTANT
OCON:	TLNE	F,QF		; QUANTITY TYPED?
	MOVEI	SCH,FTOC		; YES SET TEMPORARY MODE
	TRO	F,LF1+CF1		;OPEN AS CONSTANT
	JRST	SLASH

; ] COMMAND -- OPEN SYMBOLICALLY
OSYM:	TLNE	F,QF
	MOVEI	SCH,PIN
	TRZ	F,CF1		;OPEN SYMBOLICALLY
	TROA	F,LF1

; !  COMMAND -- LIKE / BUT DOESN'T TYPE CONTENTS
SUPTYO:	TLOA	F,STF		;SUPPRESS TYPEOUT

; / COMMAND
SLASH:	TLZ	F,STF		;TYPE OUT REGISTER
	HRRZS	T			;FLUSH BITS LIKE DDTINT
	TLNN	F,QF		;WAS ANY QUANTITY TYPED?
	 JRST	SLAS1		;NO. DO NOT CHANGE MAIN SEQUENCE
	MOVE	R,LLOC
	MOVEM	R,SAVLOC		;ADDRESS TYPED; SAVE OLD SEQ.
	CALL	ATRB		;ADD THE LOCATION TO THE RING BUFFER
	TRNE	F,INTFLG		;ARG IS WITHIN NDDT?
	 TLO	T,(DDTINT)		;YES
	MOVEM	T,LLOC		;VALUE OF "."
SLAS1:	MOVEM	T,LLOCO		;TEMP VALUE OF "."
	SETZM	PINFF		;DON'T WANT LONG INSTRUCTION TYPEOUT
	JRST	LI2

; \ COMMAND -- LIKE / OR ! BUT DOESN'T CHANGE "."
ICON:	TLNN	F,ROF		;REGISTER OPENED?
	JRST	SUPTYO		;NO. MAKE LIKE !
	CALL	DEPRS
	HRRZ	T,LWT
	JRST	SLAS1

;TAB -- SET LOC TO ADDRESS PART AND DO A / OPERATION
TAB:	MOVE	R,LLOC		;CURRENT SEQUENCE
	HRRZM	R,TEM		;IN CASE WE ARE IN PATCH MODE
	CALL	DEPRS		;OPEN REGISTER OF Q
	CALL	CRF
	MOVE	T,LLOC		;SET UP NEW SEQUENCE AND
	MOVEM	T,SAVLOC		;SAVE OLD SEQUENCE
	PUSH	P,R		;ADD THIS LOCATION TO RING BUFFER
	MOVE	R,T
	CALL	ATRB
	POP	P,R
	MOVE	T,LWT
	TLNE	F,CF		;$ BEFORE TAB?
	 MOVSS	T		;YES, USE LH THEN
	HRRZS	T			;NEW VALUE FOR .
	SETZM	PINFF		;DON'T PRINT AC OR EFF ADR
	JRST	LI1
;HERE FOR PATCHING
;CONTROL-SHIFT-L FOR OPENING PATCH
;CONTROL-SHIFT-M FOR CLOSING PATCH
;LIKE ITS DDT, HUH?

NPTCH:	TRNE	F,SEMIF2
	 JRST	NPTCH2
	MOVSI	TT,(DDTINT)
	TDNE	TT,LLOC		;NOT NICE TO FOOL MOTHER NDDT!
	 JRST	ERR
	MOVE	W,[SQUOZE 0,PATCH]
	MOVEM	W,SYM
	CALL	EVAL		;FIND HIS PATCH SPACE
	 JRST [	MOVE W,[SQUOZE 0,PAT..] ; Not there, try PAT..
		MOVEM W,SYM
		CALL EVAL
		 JRST [  MOVEI T,50
			 MOVEM T,DEFV
			 CALL DEFIN	;GIVE HIM PATCH: AT 50
			 MOVEI T,50	;ITS NOT SAVED, I GUESS
			 JRST .+1]
		ADDI T,4	; Make it +4, so BPTs don't interfere
		JRST .+1]
	MOVE	R,LLOC
	MOVEM	R,PATLOC	;SAVE HIS CURRENT LOCATION
	MOVEM	T,PATPNT
	MOVEM	T,LLOC		;MAKE HIS CURRENT LOCATION BE PATCH
	MOVEM	T,LLOCO
	CALL	FETCH
	 JRST	ERR
	PUSH	P,T		;SAVE CONTENTS OF OLD LOCATION
	CALL	CRF
	MOVE	T,LLOC		;GET PATCH LOCATION IN T
	CALL	LI1		;PRINT THE LOCATION
	CALL	LCT
	MOVE	T,(P)
	CALL	CONSYM		;PRINT OLD VALUE
	POP	P,T
	MOVEM	T,WRD
	TLO	F,ROF+QF
	TRZ	F,SEMIF+SEMIF2
	JRST	QUAN1		;MAKE THIS CURRENT VALUE IF <CR> TYPED

NPTCH2:	PUSH 	P,T		; Save possible arg
	CALL	CRF
	TLNN	F,QF		; arg given?
	 JRST	NPTCH5
	MOVE	R,LLOC		; Yes, deposit it
	POP	P,T
	CALL	DEP
	 JRST	ERR
	AOSA	LLOC	
NPTCH5:	POP	P,T
	TLNN	F,CF+CCF	; $^[ or $$^[ ?
	 JRST	NPTCH3		; No
	MOVE	R,PATLOC	; Yes, retrieve patched-over instruction
	CALL	FETCH
	 JRST	ERR
	MOVE	R,LLOC
	CALL	PTPRT
	TLNE	F,CCF		; $$^[ ?
	 JRST	NPTCH4
	AOSA	R,LLOC
NPTCH3:	MOVE	R,LLOC
	MOVEI	W,2(R)
	PUSH	P,W		;SAVE NEW PATCH LOCATION
	MOVSI	T,(JUMPA 1,)
	HRR	T,PATLOC
	ADDI	T,1
	CALL	PTPRT
	ADDI	R,1
	ADDI	T,1
	CALL	PTPRT
NPTCH4:	MOVE	R,PATLOC	;GET OLD INSTRUCTION LOCATION
	MOVSI	T,(JUMPA 3,)
	HRR	T,PATPNT
	CALL	PTPRTN
	POP	P,DEFV		;GET NEW PATCH VALUE
	MOVE	W,[SQUOZE 0,PATCH]
	MOVEM	W,SYM
	CALL	DEFIN		;AND DEFINE IT SUCH
	MOVE	R,PATLOC
	MOVEM	R,LLOC
	MOVEM	R,LLOCO		;SET THE CURRENT LOCATION
	JRST	RETX

;IN R, THE LOCATION
;IN T, THE NEW VALUE

PTPRTN:	TDZA	W1,W1
PTPRT:	 SETO	W1,
	PUSH	P,W1
	PUSH	P,R
	PUSH	P,T
	MOVE	T,R
	CALL	LI1		;PRINT ADDRESS AND VALUE
	CALL	LCT		;THEN TAB
	MOVE	T,(P)
	MOVE	R,-1(P)
	CALL	DEP		;NEW DEPOSIT NEW VALUE
	 JRST	ERR
	CALL	CONSYM		;PRINT NEW VALUE
	SKIPE	-2(P)
	 CALL	CRF
	POP	P,T
	POP	P,R
	SUB	P,[1,,1]
	RET
;FLUSH ALL UDEFINED SYMBOL REFERNECES TO THIS REGISTER.

DEPRA:	HRRZ	R,LLOC		;WHERE "." IS NOW
	MOVE	R,SAVLOC
	TLNE	F,CF		;RESTORE OLD SEQUENCE IF $CR,$LF, OR
	 EXCH	R,LLOC		;IF $^ OR $BS WAS TYPED
	MOVEM	R,SAVLOC		;SETUP "NEW" 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,ESTU
	MOVEM	W1,ESTU		;INCLUDE ALL #-D SYMS IN UNDEF TAB
DEPRA2:	JUMPGE	R,DEPRS
	HRRZ	W,1(R)
	CAMN	W,LLOCO
	CALL	REMUN
	ADD	R,[2,,2]
	JRST	DEPRA2


;IF SOMETHING TYPED AND A REGISTER IS OPEN
;UPDATE THE OPEN REGISTER AND LWT
DEPRS:	MOVEM	T,LWT		;DEPOSIT REGISTER AND SAVE AS LWT
	MOVE	R,LLOCO		;QUAN TYPED IN REGIS EXAM
	TLZE	F,ROF		;TEST AND CLOSE REGISTER
	 TLNN	F,QF
	  RET
	CALL	DEP		;STORE AWAY
	 JRST	ERR		;CAN'T STORE
	RET

EQUAL:	TROA	F,LF1+CF1		;=
PSYM:	TRZ	F,CF1		;@
	TRO	F,LF1
	SETZM	PINFF		;NEVER LONG INS PRINTOUT
	CALL	CONSYM
	JRST	RETX

;ROUTINE TO ADD ONE LOCATION TO THE RING-BUFFER - LOCATION IN R
ATRB:	PUSH	P,T
	AOS	T,RBPT		;GET NEW RING-BUFFER POINTER
	CAILE	T,LRB		;AT END OF BUFFER?
	 MOVEI	T,RB		;YES, LOOP TO BEGINNING
	MOVEM	T,RBPT		;UPDATE CURRENT POINTER
	MOVEM	R,(T)		;INSERT ADR IN RING-BUFFER
	POP	P,T
	RET

;ROUTINE TO "POP" THE RING-BUFFER, ADR RETURNED IN T
PTRB:	PUSH	P,R
	SOS	R,RBPT		;GET THE PREVIOUS LOCATION
	MOVE	T,1(R)		;THE WORD POINTED TO BY THE TOP OF THE STACK
	CAIGE	R,RB		;IF GONE TOO FAR,
	 MOVEI	R,LRB		; USE THE LAST LOCATION
	MOVEM	R,RBPT
	POP	P,R
	RET

;RADIX-50 SYMBOL PRINTER

R50PNT:	PUSH	P,T
	MOVEI	T,"$"
	CALL	TOUT
	POP	P,T
	LSH	T,-36		;RADIX 50 SYMBOL PRINTER
	TRZ	T,3
	CALL	TOC
	MOVEI	T,"&"
	CALL	TOUT
	SETZM	SVFB
	MOVEI	W1,LWT		;SETUP FOR SPT
	JRST	SPT

SIXBP:	MOVE	W1,[POINT 7,[ASCIZ /$1'/]]
	CALL	TYPE
	MOVNI	W2,6		;SIXBIT PRINTER
	MOVE	W1,LWT
SIXBP1:	MOVEI	T,0
	ROTC	T,6
	JUMPE	T,SIXBP2
	ADDI	T,40
	CALL	TOUT
	AOJL	W2,SIXBP1
SIXBP2:	MOVEI	T,"$"
	CALL	TOUT
	RET
;MODE CONTROL SWITCHES

TEXO:	MOVEI	R,TEXTT-HLFW	;$T ASSUME 7 BIT ASCIZ
	MOVE	T,WRD2
	CAIN	T,9		;CHECK FOR $9T (BCPL STRINGS)
	MOVEI	R,TEXT9-HLFW
	CAIN	T,8		;CHECK FOR $8T (NETBUFS ETC)
	MOVEI	R,TEXT8-HLFW
	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		;TEMPORARY MODE
	JRST	BASE1

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

;VARIOUS  R  COMMANDS
BASECH:	MOVE	T,WRD2		;$NR, CHANGE OUTPUT RADIX TO N
	CAIGE	T,2
	JRST	ERR
	HRRZM	T,ODF		;TEMPORARY RADIX CELL
BASE1:	MOVS	S,[SCHM,,SCH]	;MODE SWITCHES TO MEMORY
	TLNN	F,CCF
	 JRST	LIS1
	BLT	S,ODFM		;WITH $$, MAKE MODES PERMANENT
	JRST	RETX


; SEMICOLON-SPACE COMMAND -- RETYPE ACCORDING TO CURRENT MODES

SEMSPA:	MOVEM	T,LWT
	JRST	@SCH
;VARIOUS "GO" COMMANDS
GO:	TLNN	F,CCF		;ONE <ESC> TYPED?
	 JRST	GOSET		;SETUP NEW START ADR OR START PROGRAM
	TRNE	F,Q2F		;TWO ESC'S TYPED
	 JRST	GO1		;USE ENTRY VECTOR
GOS1:	TLNE	F,QF
	 JRST	GO5		;ARG TYPED IN
GO0:	SETZM	WRD2
GO1:	TLNE	F,QF
	 JRST	ERR		;FOO$$3G  ??
	MOVE	1,FORK
	GEVEC
	HLRZ	1,2		;EV LENGTH
	JUMPE	1,ERR
	CAIL	1,10000		;SKIP IF TENEX EV (1 HAS LENGTH)
	 SKIPN	1,WRD2		;10/50, ALLOW ONLY $$0G
	  CAMGE	1,WRD2		;EV LENGTH > THAN REQUESTED INDEX?
	   JRST	ERR
	ADD	2,WRD2
	HRRZ	T,2		;ENTRY ADDR
	
GO3:	HLL	T,PC		;FLAGS
	MOVEM	T,PC		;NEW PC
	MOVE	2,T
	TLNN	F,CCF
	 JRST	GO4

;ENTRY FROM $L ETC.
GO2:	MOVE	1,FORK
	CIS			;$$G COMMANDS CLEAR INTERRUPTS
	SETZM	USRPSI
	SETZM	USRPSI+1
	SETZM	USRPSI+2
	SETZM	USRPSI+3
GO4:	TLO	2,(1B5)		;INSIST ON USERMODE PC
	MOVEM	2,REALPC
	MOVE	TT,PCSTAK
	MOVEM	TT,PCSPTR		;NOT UNDER $X ETC ANY MORE
	TRZ	F,XEQ!CONDX
	CALL	CRF
	JRST	TOUSER

GO5:	TRNN	F,INTFLG		;DID ADDR CONTAIN AN INTERNAL SYMBOL?
	 JRST	GO3		;NO, DO THE $G
	JRST	ERR		;ATTEMPT TO GO INSIDE NDDT

;SETUP NEW START ADR, EXAMINE IT AS WITH ^N, BUT DO NOT START
GOSET:	TRNN	F,Q2F		;ARG TYPE AFTER <ESC>?
	 JRST	GOS1		;NOPE, IS NORMAL START THEN
	TRNE	F,INTFLG		;DID ADDR CONTAIN INTERNAL SYMBOL?
	 JRST	ERR
	TLNN	F,QF		;FOR ALT-0-G
	 JRST	GOSET1
GOSET2:	PUSH	P,T
	CALL	CRF
	POP	P,T
	HRRM	T,PC		;STORE NEW PC
	SETOM	PINFF		;LONG PRINTOUT
	JRST	LI1		;THEN EXAMINE AS IN ^N

GOSET1:	MOVE	1,FORK		;HERE FOR $<N>G
	GEVEC
	HLRZ	1,2		;EV LENGTH
	JUMPE	1,ERR
	CAIL	1,10000		;SKIP IF TENEX EV (1 HAS LENGTH)
	 SKIPN	1,WRD2		;10/50, ALLOW ONLY $$0G
	  CAMGE	1,WRD2		;EV LENGTH > THAN REQUESTED INDEX?
	   JRST	ERR
	ADD	2,WRD2
	HRRZ	T,2
	JRST	GOSET2
;CONTROL-L -- CLEAR THE SCREEN
CTRLL:	MOVEI	1,.PRIOU		;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY
	RFMOD			;CHANGE TO
	PUSH	P,2
	TRZ	2,TT%DAM		;BINARY MODE
	SFMOD
	GTTYP
	MOVE	1,BLNKTB(2)		; [PJG] Get the right magic
	TLOE	1,-1			; [PJG] More than 5 chars?
	 HRROI	1,BLNKTB(2)		; [PJG] No, then use immediate
	PSOUT
	MOVEI	1,.PRIOU
	POP	P,2
	SFMOD
	JRST	DD1.5

DEFINE CLRASCII <BYTE (7) .CHESC,"H",.CHESC,"J",0>;ASCII screen clear
DEFINE CLRANSI <[BYTE (7) .CHESC,"[","H",.CHESC,"[","J",0]> ;ANSI standard

BLNKTB:
	REPEAT	4, <BYTE (7) 15,12,0>	; 0-3
IFE DREASW,<
IFE MIT,<
	BYTE	(7) "Z"-100,0		; 4 ADM3
>
IFN MIT,<
	BYTE	(7) 177,220-176,0		; 4 IMLACS
>
	BYTE	(7) 35,36,0		; 5 DM
	BYTE	(7) 33,"H",33,"J",0	; 6 HP2640
	REPEAT	4,<BYTE (7) 15,12,0>	; 7-10
	BYTE	(7) 33,"H",33,"J",0	; 11 VT50
	BYTE	(7) 15,12,0		; 12
	BYTE	(7) 33,"(",177,0		; 13 LP
	BYTE	(7) 15,12,0		; 14
	BYTE	(7) 33,"H",33,"J",0	; 15 VT52
	REPEAT	3,<BYTE (7) 15,12,0>	; ETC
>
IFN DREASW,<
	BYTE (7) .CHCNZ,0		; [PJG] 4 ADM-3
	BYTE (7) .CHCRB,.CHCUN,.CHCUN,0	; [PJG] 5 Datamedia 2500
	CLRANSI				; [PJG] 6 VT132 in native mode
	BYTE (7) .CHESC,"?",.CHESC,.CHCNC,0	; [PJG] 7 Concept 100
	REPEAT	2,<BYTE (7) 15,12,0>	; [PJG] 8-9
	BYTE (7) .CHCRB,.CHCUN,.CHCUN,.CHCUN,0	; 10 VT05
	CLRASCII			; [PJG] 11 VT50
	BYTE	(7) 15,12,0		; [PJG] 12 LA30
	BYTE (7) .CHCRB,.CHCUN,0	; [PJG] 13 GT40
	BYTE	(7) 15,12,0		; [PJG] 14 LA36
	CLRASCII			; [PJG] 15 VT52
	CLRANSI				; [PJG] 16 VT100
	REPEAT	2,<BYTE (7) 15,12,0>	; ETC
>

;$$^N -- FUNNY BUSINESS TO FIXUP BLOWING IT (^N INSTEAD OF $^N)
;IF AC GIVEN, USE (AC)
;IF ADDRESS GIVEN, USE CONTENTS OF THAT ADDRESS
;SO, IF IN UUO HANDLER, USE UUOH$$^N

CTRLNX:	MOVEI	W1,17		;USE AC 17 IF NOT SUPPLIED
	TLNE	F,QF		;ARGUMENT?
	 MOVE	W1,WRD		;ELSE USE HIS
	CAIG	W1,17
	 CAIGE	W1,0
	  JRST	[HRRZ	R,W1	;GET RH -> POINTER TO LOCATION IN CORE
		 CALL	FETCH
	 	  JRST	ERR	;OOPSx2
		 JRST	CTLNX1]	;USE THIS ADDRESS
	HRRZ	R,AC0(W1)	;GET VALUE OF AC
	CALL	FETCH		;GET (P) OR EQUIVALENT
	 JRST	ERR
CTLNX1:	TRZ	F,XEQ!CONDX
	HRRZS	T		;NO LEFT HALF, PLEASE
	SETZM	BPTFLG
	MOVE	R,PC
	MOVEM	R,REALPC	;SAVE PC
	PUSH	P,T		;SAVE ADDRESS FOR TEMP BP'S
	CALL	CRF		;REQUIRED CRLF
	HRRZM	R,$CTRLN
	POP	P,R		;RESTORE THE ADDRESS,
	JRST	JSTAN1+1	;I.E. START OF TEMP BP'S AND GO

;CONTROL-N -- ITS-LIKE SINGLE STEPPING
ctrln:	TLNE	F,CCF
	 JRST	CTRLNX
	setom	fctrln		; Fake a $y, and flag it as such
	tlnn	f, cf		; An <esc> turns $y fake to $j fake
	 troa	f, ystepf
	  trz	f, ystepf
	jrst	ctrlna

; $Y -- single step, just doing one instruction, special handling
ystep:	troa	f, ystepf
; $J -- single step, interpretting subrs as single instrs
; num(foo)$J proceed until num instructions excecuted or value of
; foo changed foo$$J proceed until foo changed
jstep:	trz	f, ystepf
	setzm	fctrln		; Losing output
ctrlna:	trz	f, xeq!condx	; Not $x and for ddt
	setzm	bptflg		; Any bpt will not be from user
	tlne	f, ccf
	 hrlos	t		; Arg$$J like infinty(arg)$J
	tlnn	f, qf!ccf	; No arg given?
	 movei	t, 1		; Just once
	jumpe	t, jstep3	; 0$j toggles verbose switch
	hrrzm	t, stepct	; Number of times
	hlrz	r, t		; Get location to write protect
	movem	r, wrprot
	tlnn	f, qf		; Quantity typed?
	 setzb	r, wrprot	; So $$J works after breakpoint
	move	T, pc		; In case of breakpoint
	movem	T, realpc
	PUSH	P,R
	MOVE	R,T
	SETZM	CNXBPT
	PUSHJ	P,BPCHK
	 SETOM	CNXBPT
	POP	P,R	
	jumpe	r, jstep1	; None.
	call	fetch		; Get contents
	 jrst	err
	movem	t, wrcont	; Save it
jstep1:	call	crf		; Always want a leading <CR><LF>
	tro	f, sstepf	; Say we are single stepping
	hrrz	r, realpc	; Get next instruction from user
 	call	fetch		; Get it
	 jrst	err
	trne	f, ystepf	; Need special handling?
	 jrst	ystep2
	skipn	fctrln		; $^N rather than $J?
	 jrst	jstp1a		; Nope, do it the wrong way
	hrrzm	r, $ctrln	; This is the PC
jstan1:	aoj	r,		; Initially, C(R) is C(REALPC)
	call	fetch
	 jrst	jstp1b		; Failed, use normal, losing method
	tlce	t, 777000	; Find next reasonable instruction
	 tlnn	t, 774000	; 0 < Opcode < 774
	  jrst	jstan1		; No, keep looking
	tlc	t, 777000	; Return instruction to normal
	movei	w1, 3		; Put in three breakpoints
	movem	w1, $ctins	; Also remember in memory in case of interrupts
jstan2:	movem	r, $ctrln(w1)	; Location of breakpoint
	cain	w1,3
	 jrst	jstan3		; No need to do extra work if we have the ins
	call	fetch
	 jrst	jstanu		; Undo damage and use losing method
jstan3:	movem	t, $ctins(w1)	; Save the instruction
	move	t, [BPT]	; Then insert the breakpoint
	call	dep
	 jrst	jstanu		; Undo and use losing method
	sosle	w1, $ctins	; Any locoations left to do?
	 aoja	r, jstan2	; Yup, so go to next one and proceed
	call	doset		; Save perishable stuff
	jrst	touser		; Then start up user's program

jstctn:	call	remtbp		; Here when returning from the user
	jrst	jstep2

jstanu:	call	remtbp		; Remove any temp bpt's that are in
jstp1b:	hrrz	r, realpc
	call	fetch
	 jrst	err
jstp1a:	call	setesi		; Set up user's memory for xec
	jrst	touser
jstep2:	call	unset
	addm	tt, realpc	; Update user pc
jstp2a:	move	tt, realpc
	movem	tt, pc
	skipe	sstepv		; Verbose?
	 call	jstep5		; Yes, check things
	call	jstep4		; In any case print the instruction
	sosg	stepct		; More?
	 jrst	jstpdd		; Back to ddt with no extra <CR>
	move	r, wrprot	; Get new contents
	jumpe	r, jstep1
	call	fetch
	 jrst	err
	camn	t, wrcont	; Changed?
	 jrst	jstep1		; No back for more
	move	w1, [ascii /(WP)/]
	call	text2
	hrrz	t, pc
	call	pad
	call	lct
	move	t, wrprot	; Type attempted new contents
	setzm	pinff		;never print ac or eff adr
	call	li1
	hrrz		r, wrprot
	move	t, wrcont
	call	dep		; Restore old contents (should we?)
	 jrst	err
	jrst	jstpdd
	
jstpdd:	call	lct
	jrst	dd1.6

ystep2:	movem	t, binstr	; Save instruction we are handling
	call	proc12		; Do interpretation
	 jrst	jstp1a		; Ok for regular handling
	jrst	jstp2a		; Taken care of, see if more to do, etc.

jstep3:	setcmm	sstepv		; Toggle verbose switch
	ret			; And return

; Print out current instruction and save AC's and view reg for printing changes
jstep4:	push	p, t
	push	p, r
	hrrz	t, realpc
	setzm	pinff		; Asumme quiet mode
	skipe	sstepv		; Is that the case?
	 setom	pinff		; No, print eff adr and/or ac
	call	li1		; Print out instruction
	move	t, [ac0,,ssacs]
	blt	t, ssacs+17	; Save user acs
	skipge	r, vaddr	; Anything in view cell?
	 jrst	jstp4a		; Nope
	hrrzs	r
	call	fetch
	 caia			; Forget it
	movem	t, ssacs+20	; Save it
jstp4a:	pop	p, r
	pop	p, t
	ret

; Print changes to AC's if fctrln is off, also print change to view reg
jstep5:	setz	t,
	skipe	fctrln		; Should we print changes?
	 jrst	jstp5z		; Nope, only do view register
jstp5a:	move	r, ac0(t)
	came	r, ssacs(t)	; Has it changed
	 call	jstep6		; Yes, say so
	caige	t, 17		; Done?
	 aoja	t, jstp5a
jstp5z:	skipge	r, vaddr	; Anything here?
	 ret
	hrrzs	r
	skipe	fctrln		; Next test only valid if not ^N
	 jrst	jstp5y
	caig	r, 17		; Is it an ac?
	 ret			; Yes, already done it
jstp5y:	call	fetch
	 ret
	camn	t, ssacs+20	; Changed?
	 ret
	move	r, vaddr
	setzm	pinff
	call	li1
	jrst	crf

; Print c(c(t)), a trailing <CR>, then return
jstep6:	push	p, t
	setzm	pinff
	call	li1		; Type out new contents
	call	crf
	pop	p, t
	ret

;Routine to remove temporary breakpoints -- for now, these are set up only
; by $^N
remtbp:	skipge	$ctins		; Any temporary breakpoints?
	 ret			; Nope, return right away
	push	p, tt
	movei	w1, ntbpts	; Assume maximum number of breakpoints
	sub	w1, $ctins	; Calculate actual number of things to undo
	movei	w2, $ctins+ntbpts
remtb1:	jumple	w1, remtb3	; Return when done
	move	r, $ctrln-$ctins(w2) ; Get address of instruction
	move	t, (w2)		; And get the actual instruction
	call	dep
	 jrst	remtb2		; Can't undo, so turn off future attemps
	soj	w2,		; Point to next item
	soja	w1, remtb1	; And go on until done

remtb2:	setom	$ctins		; Flag that there are no temp bpts
	jrst	err

remtb3:	setom	$ctins
	pop	p, tt
	ret
; $X COMMAND -- EXECUTE AN INSTRUCTION
; INSTRUCTION TO EXECUTE IS IN T

XEC:	MOVEM	T,R
	MOVEI	T,XRG	;IN CASE ITS A $X EXAMINE
	TLNN	F,QF	;WAS <INSTR> TYPED?
	JRST	QUANIN	;NO, EXAMINE $X REGISTER
	MOVE	T,R
	CALL	SETESI	;SET UP USER'S MEMORY
	TRO	F,XEQ	;WE'RE IN A $X
	CALL	CRF
	JRST	TOUSER

;$X COMMAND COMPLETION
;PSEUDO BPT HIT
;TT HAS NUMBER OF SKIPS
XCOM:	MOVEI	W1,"$"
	CALL	TEXT
	SOJG	TT,.-2
	CALL	UNSET	;POP BACK TO PREVIOUS $X CONTEXT
	JRST	DD1
;GO TO USER
;PC SAYS WHERE
;XEQ, CONDX BITS SAY WHY
;AND TELL WHERE TO RETURN IN NDDT

TOUSER:	CALL	UNMAP		;FLUSH THE USER'S PAGE
	TRNN	F,CONDX		;USER WILL RUN FOR DDT'S PURPOSES,
				; NOT HIS. THEREFORE, DON'T
	CALL	INSRTB		;PUT BPT'S BACK IN
	MOVEI	1,100
	MOVE	2,SAVTTY
	SFMOD
	MOVE	2,SAVTT2
	MOVE	3,SAVTT3
	SFCOC
	MOVE	2,USRTB2
	MOVE	3,USRTB3
	MOVE	4,USRTB4
	STABS
	MOVE	1,SUBSYS
	TLNE	1,(77B5)	; Make sure name is meaningful
	 SETNM			;RESTORE USER'S SUBSYSTEM NAME
	CALL	SETUSR		; SET STATE OF USER FORK FROM NDDT
TOUSR8:	MOVE	1,TPFORK
IFN KL20F,<
	TLO	1,(SF%CON)	; Continue the fork
	SFORK	
>;IFN KL20F
	MOVE	1,TPFORK
	RFORK
	SETOM	USRFLG		;WE'RE NOW IN THE USER.
	INTON
	MOVE	1,TPFORK
WAITPC:	WFORK			;WAITPC BAD BETTER POINT TO THE WFORK (ADBRK)
	FFORK			;FREEZE IT IMMEDIATLY
	JRST	TRAP		;FORK TERMINATED

IFN ADBRKF,<
;INFERIOR FORK TERMINATION INTERRUPT (OR FORCED FREEZE -- ADBRK)
FRKTRM:	PUSH	P,1
	PUSH	P,2
	MOVE	1,FORK
	RFSTS
	 ERJMP	FRKTR2		;IGNORE LOSSAGE HERE
	TLNN	1,(RF%FRZ)
	 JRST	FRKTR2		;NOT FROZEN (IE NOT FORCED) WILL FALL THRU OK
	HRRZ	1,IPC1		;SEE WHAT WE WERE DOING
	CAIE	1,WAITPC
	 CAIN	1,WAITPC+1
	 JRST	[	MOVSI 1,1000
		IORM 1,IPC1	;FORCE IT TO FALL THRU
		JRST FRKTR2]
FRKTR2:	POP	P,2
	POP	P,1
	DEBRK
>	;ADBRKF
;BREAK POINT LOGIC


;HERE WHEN BPT HIT
;T POINTS AT PRIVATE BLOCK FOR THE BPT

;PRIVATE BLOCK FORMAT IS:
;WORD-0:	LH HAS TRACE EXP., RH HAS ADDR. WHERE BPT SET
;WORD-1:	0 OR CONDITIONAL BREAK SKIP INSTR.
;WORD-2:	PROCEED COUNT
;WORD-3:	0 OR STRING POINTER, FED TO DDT WHEN BPT HIT
;WORD-4:	SAVED INSTRUCTION WHILE USER IS RUNNING
;WORD-5:	0 OR ELSE -1 IF AUTO-PROCEED
;WORD-6:	ASCIZ NAME OF THIS BPT, LIKE $3B
;WORD-7:	RH HAS FORK IN WHOSE ADR SPACE THE BPT IS SET

BCOM:	MOVEM	T,BPTFLG	;INDICATE WHICH BPT WE'RE AT
	SKIPE	CNXBPT
	 JRST	BCOM3

;ARE WE GOING TO BREAK?

BCOM1:	SKIPE	W1,1(T)	;DOES A CONDITIONAL INSTR. EXIST?
	 CALL	DOCNDX	;DO THE CONDITIONAL IN THE USER
	  SOSG	TT,2(T)	;GUNCH THE PROCEED COUNT
	   JRST	BREAK	;YES!

;DON'T BREAK, PROCEED
BCOM3:	SETZM	CNXBPT
	MOVE	T,4(T)
	JRST	PROCX

BCOM2:	MOVE	T,4(T)	;THE BREAK INSTRUCTION
	JRST	PROC1
;DO THE CONDITIONAL BREAK INSTRUCTION FOR THE USER

DOCNDX:	MOVE	T,1(T)		;GET THE INSTRUCTION
	CALL	SETESI
	TRO	F,CONDX		;WHY WE'RE GOING TO USER
	JRST	TOUSER

;RETURN FROM USER HERE
;TT HAS THE NUMBER OF SKIPS
CONCOM:	TRNN	TT,1		;ONLY THE LOW BIT COUNTS
	AOS	0(P)		;MAKE DOCNDX SKIP
	CALL	UNSET		;POP BACK TO PREVIOUS CONTEXT
	MOVE	T,BPTFLG		;GET BACK WHICH BPT WE'RE AT
	RET

;WE'RE REALLY BREAKING
BREAK:	PUSH	P,T		;POINTER TO BPT PRV BLK
	CALL	CRF		;NEED A LEADING CRLF WHEN BREAKING
	MOVE	T,(P)
	TDZ	F,[-1,,-1-XEQ]	;CLEAR ALL FLAGS EXECPT XEQ
	MOVE	2,FORK
	CAMN	2,TPFORK
	 JRST	BREAKT
	MOVEI	1,"("
	PBOUT
	MOVEI	1,101
	MOVEI	3,10
	ANDI	2,77
	NOUT
	 JFCL
	MOVEI	1,")"
	PBOUT
BREAKT:	MOVE	W1,6(T)		;ASCIZ NAME OF BREAK POINT -- $3B
	CALL	TEXT2		;PRINT IT
	MOVSI	W1,(<ASCIZ />/>)	;TYPE > FOR COND BREAK
	SKIPG	2(T)		;TEST PROCEED COUNTER
	 MOVSI	W1,(<ASCIZ />>/>);TYPE >> FOR PROCEED COUNTER BREAK
	CALL	TEXT2
	MOVE	W1,LLOC		;SAVE CURRENT SEQUENCE
	MOVEM	W1,SAVLOC
	PUSH	P,R
	MOVE	R,W1
	CALL	ATRB		;ADD PREVIOUS LOCATION TO RING BUFFER
	POP	P,R
	HRRZ	T,PC
	HRRZM	T,LLOC		;SET CURRENT SEQ TO BREAK ADR
	SETOM	PINFF
	CALL	LI1		;TYPE PC AT BREAK
	HLRZ	T,@0(P)		;GET TRACE LOCATION
	JUMPE	T,BREAK1		;TEST FOR REGISTER TO EXAMINE
BREA1A:	CALL	LCT		;PRINT TAB
	HLRZ	T,@0(P)
	SETZM	PINFF		;DON'T PRINT EFF ADR AND/OR AC
	CALL	LI1		;EXAMINE REGISTER C($NB)LEFT
BREAK1:	POP	P,T			;GET BPT BLK PTR BACK
	SKIPN	5(T)		;SKIP IF AUTO
	JRST	RETB		;DONT PROCEED
BREAK2:	MOVEI	TT,2		;1 FOR SOS AT BCOM1, 1 FOR
	ADDB	TT,2(T)		;PROCEEDING
	JUMPGE	TT,BREAK3	;NOT AUTOPROCEEDING ANYMORE
	 CALL	CRF
	 JRST	PROC0		;DO THE PROCEED
BREAK3:	SETZM	5(T)		;CLEAR AUTO PROCEED

;START UP DDT, T POINTS AT BPT BLK
RETB:	SKIPE	T,3(T)		;IS THERE A COMMAND STRING?
	HRLI	T,(<POINT 7,0>)
	MOVEM	T,STRING
	JRST	RETX
;<NUM>$P -- PROCEED THROUGH THIS BPT NUM TIMES
;<NUM> IN T (IF ANY TYPED IN)
PROCED:	MOVE	TT,T	;SO T CAN POINT TO BPT BLK
	CALL	CRF
	SKIPN	T,BPTFLG	;PROCEEDING FROM BPT?
	JRST	TOUSER	;NO. JUST RUN HIM AT HIS PC.
	TLNE	F,QF	;WAS AN ARG TYPED IN?
	JRST	PROCD3	; YES, USE IT.
	MOVEI	TT,1	; NO, ASSUME 1
	TLNE	F,CCF	;IF $$P
	MOVSI	TT,200000	;THEN VERY LARGE COUNT
PROCD3:	TLNE	F,CCF	;IF AUTOPROC
	MOVNS	TT		;NEGATE
	MOVEM	TT,2(T)	;STORE COUNT FOR THIS BREAK IN $<N>B+1
	SETZM	5(T)	;ASSUME NOT AUTOPROCEED
	TLNE	F,CCF
	SETOM	5(T)	;IT IS AUTOPROCEED

;ENTER HERE FROM AUTOPROCEED

;USER MAY HAVE CHANGED THE CONTENTS OF THE BREAK
;LOCATION BETWEEN THE TIME THE BPT WAS HIT AND THIS $P
PROC0:	HRRZ	R,@BPTFLG	;ADDRESS OF LAST BPT HIT
	CALL	FETCH	;GET INSTRUCTION TO PROCEED FROM
	 JRST	ERR

;PROCX. ENTER HERE FROM FUNNY ALT-CONTROL-N HACK
PROCX:	MOVEM	T,BINSTR
	MOVEI	1,400000
	RWM
	JUMPGE1	1,PROC12
	JRST	PROC1A

;ENTER HERE FROM NON-BREAKING BPT HIT
PROC1:	MOVEM	T,BINSTR		;INSTRUCTION TO LEAVE FROM
	MOVEI	1,400000
	RWM			;SEE IF RUBOUT INTERRUPT WAITING
	JUMPGE	1,PROC14		;NO, KEEP AUTOPROCEEDING
PROC1A:	INTON
	 WAIT			;LET IT RIP

PROC14:	TRZ	F,SSTEPF!YSTEPF	;NOT SINGLE STEPPING
PROC12:	MOVEI	S,100		;MAX @ DEPTH ALLOWED FOR EA CALCULATION
	MOVEM	S,TEM1
	LDB	W1,[POINT 9,T,8]	;OPCODE.
	LDB	W2,[POINT 4,T,12]	;GET AC FIELD
	CAIE	W1,<XCT>/1B8
	CAIN	W1,<PUSHJ>/1B8
	 JRST	IXCT1		;CALCULATE EA AND INTERPRET
	CAIE	W1,<JSR>/1B8
	CAIN	W1,<JSA>/1B8
	 JRST	IXCT1
	CAIE	W1,<JSYS>/1B8
	CAIN	W1,<JSP>/1B8
	 JRST	IXCT1
	TRNN	W1,700
	 JRST	IUUO
	TRNN	F,YSTEPF		;SINGLE STEPPING?
	 JRST	PROC2		; NO, ENUF INTERPRETATION
	CAIE	W1,<POPJ>/1B8
	CAIN	W1,<JRA>/1B8
	 JRST	IXCT1
	CAIE	W1,<AOBJN>/1B8
	CAIN	W1,<AOBJP>/1B8
	 JRST	IXCT1
	CAIE	W1,<JFFO>/1B8
	CAIN	W1,<JRST>/1B8
	 JRST	IXCT1
	ANDI	W1,770		; REMOVE LOW 3 BITS OF OPCODE
	CAIE	W1,<AOJ>/1B8	; AOJ-SOMETHING
	CAIN	W1,<SOJ>/1B8
	 JRST	IXCT1
	CAIN	W1,<JUMP>/1B8	; SOME FLAVOR JUMP
	 JRST	IXCT1

;USE THE HARDWARE TO INTERPRET ALL ELSE.
;T HAS THE INSTRUCTION
PROC2:	TRNE	F, YSTEPF	; ARE WE SINGLE STEPPING?
	 RET		; YES, GIVE SINGLE RETURN
	HRRZ	R,XRG	;LOCATION OF $X REGISTER
	CALL	DEP
	 JRST	ERR
	MOVEI	S,3
	HRRZ	T,PC	;WORK ON COPY IN CASE DEP FAILS
PROC3:	AOS	T
	HRLI	T,(JRST)
	AOS	R
	CALL	DEP
	 JRST	ERR
	SOJG	S,PROC3
	HLL	R,PC	;FLAGS
	TLO	R,(1B5)	;BE SURE IT'S USERMODE
	HRR	R,XRG
	MOVEM	R,REALPC	;WHAT FORK'S PC SHOULD BE
	JRST	TOUSER
;THESE ROUTINES INTERPRET PC SAVING INSTRUCTIONS.

;R POINTS TO THE INSTRUCTION
;T,BINSTR HAVE THE INSTRUCTION
;W1 HAS THE OP CODE
;W2 HAS AC FIELD

;INTERPRET UUO
IUUO:	JUMPE	T,PROC2		;ILLEGAL INSTRUCTION
	CAIL	W1,40
	JRST	PROC2		;DEC 10/50 UUO, USE HARDWARE.
	MOVEI	R,40
	CALL	DEP
	 JRST	ERR
	MOVEI	R,41		;NOW EXECUTE LOCATION 41.


;INTERPRET XCT
IXCT:	SOSL	TEM1		;TOO MUCH @'ING?
	CALL	FETCH		;CODE PROTECTED?
	 JRST	ERR		;YES.
	MOVEM	T,BINSTR


;GET EFFECTIVE ADDRESS
IXCT1:	MOVE	T,BINSTR		;THE INSTRUCTION
	call	eff2		; Evaluate effective address
	 jrst	err

;CHECK XCT'D OR UUO'D INSTRUCTION TO SEE IF IT MUST BE INTERPRETED.
IXCT3:	HRRZS	W1
	DPB	W1,[POINT 23,BINSTR,35]	;SMASH WITH EA
	LDB	W2,[POINT 4,BINSTR,12]	;AC FIELD
	LDB	W1,[POINT 9,BINSTR,8]	;GET OP. CODE
	MOVE	T,BINSTR			;GET INSTR WITH EA COMPUTED
	CAIN	W1,<PUSHJ>/1B8
	 JRST	IPUSHJ
	CAIN	W1,<JSR>/1B8
	 JRST	IJSR
	CAIN	W1,<JSA>/1B8
	 JRST	IJSA
	CAIN	W1,<JSP>/1B8
	 JRST	IJSP
	HRRZ	R,BINSTR
	CAIN	W1,<JSYS>/1B8
	 JRST	IJSYS
	CAIN	W1,<XCT>/1B8
	 JRST	IXCT
	TRNN	W1,700
	JRST	IUUO		;ANOTHER ONE.  TEM1 WILL RUN OUT.
	trnn	f, ystepf	; More interpretation needed?
	JRST	PROC2		;OK, USE HARDWARE
	cain	w1, <popj>/1b8
	 jrst	ipopj
	cain	w1, <jra>/1b8
	 jrst	ijra
	caie	w1, <aobjn>/1b8
	cain	w1, <aobjp>/1b8
	 caia
	cain	w1, <jffo>/1b8
	 jrst	[push	p, w1
		 jrst	ijumps]
	cain	w1, <jrst>/1b8
	 jrst	ijrst
	push	p, w1
	andi	w1, 770
	caie	w1, <aoj>/1b8
	cain	w1, <soj>/1b8
	 jrst	ijumps
	cain	w1, <jump>/1b8
	 jrst	ijumps
	pop	p, w1
	jrst	proc2



;INTERPRET JSYS
IJSYS:	CAIGE	R,1000		;USER JSYS?
	 JRST	PROC2		;NO.  MONITOR-CALLING TYPE
	CALL	FETCH		;GET RETPTR,,JUMPADDR
	 JRST	ERR
	PUSH	P,T
	HRLZ	R,T		;WHERE TO STORE PC,,FLAGS
	AOS	T,PC		;RETURN ADDRESS FOR JSYS
	CALL	DEP
	 JRST	ERR
	POP	P,R			;WHERE TO JUMP TO
	JRST	IPJ2

; Compute effective address 
; Instruction in T, returns eff adr in W1 and contents of
; Effective address in T if 1st instruction used an indirect reference
effadr:	movei	w1, 100
	movem	w1, tem1	; Maximum indirection count
eff2:	ldb	w1, [point 4, T, 17]	; Get index field
	skipe	w1		; use 0 if xr=0
	 move	w1, ac0(w1)	; Else his xr
	add	w1, t
	tlne	t, <(@)>	; Indirect?
	 jrst	.+3		; Yep, keep going
	aos	(p)		; Return skip
	ret
	hrrz	r, w1
	sosl	tem1			; Too  much indirection?
	 call	fetch			; Get contents
	  ret				; Error of some sort
	jrst	effadr			; Back for more
;INTERPRET PUSHJ
IPUSHJ:	MOVE	T,AC0(W2)		;USER'S PUSH POINTER
	MOVE	TT,T		;SAVE UN-GUNCHED POINTER
	AOBJN	T,.+1
	XOR	TT,T		;SEE IF SIGN CHANGED
	JUMPL	TT,IPJ3		;JUMP IF SO
IPJ1:	MOVEM	T,AC0(W2)
	HRRZM	T,R
	AOS	T,PC
	CALL	DEP		;DO PUSH FOR HIM
	 JRST	ERR		;PROTECTED
	HRRZ	R,BINSTR		;EA OF PUSHJ
IPJ2:	HLL	R,PC		;HIS NEW PC
	TLO	R,(1B5)		;MUST BE USERMODE
	MOVEM	R,REALPC		;TOUSER WILL DO SFORK
	trne	f, ystepf	; Single stepping?
	 jrst	cpopj1		; Yes, give double return (taken care of)
	JRST	TOUSER

IPJ3:	MOVE	1,FORK
	MOVSI	2,(1B9)
	IIC			;GOOSE USER'S CHN, LET HIM TRAP IT
	JRST	IPJ1		;DOES INT HAPPEN BEFORE PUSHJ????

ipj4:	hrrz	r, pc
	jrst	ipj2

;INTERPRET JSA
IJSA:	AOS	T,PC
	HRL	T,BINSTR		;FORM  EA.RET
	EXCH	T,AC0(W2)
	JRST	IJSR2

;INTERPRET JSR
IJSR:	AOS	T,PC
IJSR2:	HRRZ	R,BINSTR
	CALL	DEP
	 JRST	ERR
	AOSA	R,BINSTR
IJSR3:	MOVE	R,BINSTR
IJSR4:	JRST	IPJ2

;INTERPRET JSP
IJSP:	AOS	W,PC
	MOVEM	W,AC0(W2)
	JRST	IJSR3
; Interpret popj
ipopj:	hrrz	r, ac0(w2)	; Get pushdown pointer
	call	fetch
	 jrst	err
	movem	t, pc
	move	t, ac0(w2)
	sub	t, [1,,1]
	movem	t, ac0(w2)
	jrst	ipj4

; Interpret jra
ijra:	hrrz	t, binstr
	hrrzm	t, pc		; Pc_Ea
	hlrz	r, ac0(w2)	; Get ac
	call	fetch
	 jrst	err
	movem	t, ac0(w2)	; Restore ac
	jrst	ipj4

ijrst:	hrrz	t, binstr
	movem	t, pc
	jrst	ipj4

; Interpret jumps, aobjn, aobjp, jffo, aojs, sojs, etc.
ijumps: movei	t, t
	hllz	r, binstr		; Get instruction
	dpb	t, [point 4, r, 12]	; Substitute t for original ac
	hrri	r, ijump2		; Substitute for ea
	move	t, ac0(w2)		; Get real user ac
	xct	r			; Ha Ha!
	aos	pc			; Didnt jump, so increment pc
	jrst	ijump3
ijump2:	hrrz	r, binstr		; Get ea
	movem	r, pc			; Fake jump
ijump3:	movem	t, ac0(w2)		; Update ac
	pop	p, t
	cain	t, <jffo>/1b8
	 movem	w1, ac0+1(w2)		; Update ac+1 for jffo
	jrst	ipj4
;INSERT BREAKPOINTS

INSRTB:	MOVEI	W1,BPTS
	PUSH	P,FORK		; SAVE CURRENT FORK
INSRT1:	HRRZ	R,0(W1)
	JUMPE	R,INSRT3		;NOT IN USE
	HRRZ	1,7(W1)		; GET THE PERTINENT FORK
	CALL	SETFRK
	 JRST	[SETZM 0(W1)	; FORK HAS GONE, CANCEL BPT
		 JRST INSRT3]
	CAIN	R,$CTRLN		;THIS WHERE THE TEMPORARY BREAKPOINT GOES?
	 JRST	INSRT3		;YES, DON'T INSERT THE BREAKPOINT
	CALL	FETCH		;GET THE USER'S INSTRUCTION
	 JRST	INSRT4		;PAGE IS READ PROTECTED.  ABORT.
	MOVEM	T,4(W1)
	MOVE	T,[BPT]
	CALL	DEP		;STUFF IT INTO THE USER
	 JRST	INSRT5		;PAGE IS WRITE PROTECTED
INSRT3:	ADDI	W1,NBPTV		;MOVE TO NEXT BPT
	CAIE	W1,<BPTS+<NBP*NBPTV>>
	 JRST	INSRT1
	POP	P,1
	CALL	SETFRK		; BACK TO ORIGINAL FORK
	 JFCL
	RET

INSRT4:	SKIPA	1,[POINT 7,[ASCIZ /? Can't read instruction under breakpoint /]]
INSRT5:	MOVE	1,[POINT 7,[ASCIZ /?Can't insert breakpoint /]]
	PUSH	P,W1		;SAVE BPT BLOCK PTR
	MOVE	W1,1		;SETUP FOR TYPE
	CALL	TYPE
	MOVE	A,0(P)
	SUBI	A,BPTS		;GET BACK THE NUMBER
	IDIVI	A,NBPTV
	ADDI	A,1
	CALL	TOC5		;PRINT NUMBER AND PERIOD.
	POP	P,W1		;RESTORE THE BPT BLOCK POINTER
	POP	P,FORK		;GIVE REMOV0 SOMETHING TO PUSH
	CAIE	W1,BPTS		;ANY NEED REMOVING?
	 CALL	REMOV0		;YES
	JRST	ERR

;REMOVE BREAKPOINTS

REMOVB:	MOVEI	W1,<BPTS+<NBP*NBPTV>-NBPTV>	;ADDR OF LAST BPT
REMOV0:	PUSH	P,FORK		; SAVE CURRENT FORK
REMOV1:	MOVE	T,4(W1)	;SAVED INSTRUCTION
	HRRZ	R,0(W1)
	JUMPE	R,REMOV2		; NOT IS USE
	HRRZ	1,7(W1)
	CALL	SETFRK		; SWITCH TO THIS FORK
	 JRST	[	SETZM 0(W1)	; FORK GONE. CANCEL BPT
		JRST REMOV2]
	CALL	DEP
	 JRST	REMOV3		;WRITE PROTECTED PAGE
REMOV2:	SUBI	W1,NBPTV		;MOVE TO NEXT BPT
	CAIL	W1,BPTS		;DONE ALL?
	 JRST	REMOV1		;NO
	POP	P,1
	CALL	SETFRK
	 JFCL
	RET

REMOV3:	PUSH	P,W1
	MOVE	W1,[POINT 7,[ASCIZ /?Can't remove breakpoint /]]
	CALL	TYPE
	MOVE	A,0(P)
	SUBI	A,BPTS
	IDIVI	A,NBPTV
	ADDI	A,1
	CALL	TOC5
	CALL	CRF
	POP	P,W1
	JRST	REMOV2
;ALL $B COMMANDS OF FORM <A>$<N>B

;A$NB  A$B  $NB  $B

BPS:	TLNE	F,QF
	 JRST	BPS1	;A$NB OR A$B
	TRNE	F,Q2F
	 JRST	BPS2	;$NB

;$B OR $$B -- DELETE BREAK POINTS

	TLNN	F,CCF		; $$B ?
	 JRST	BPS0		; No, remove current breakpoint
	CALL	FLSBPT
	JRST	RETX

;$B - DELETE CURRENT BREAKPOINT
BPS0:	SKIPN T,BPTFLG		; Get ptr to bpt block
	 JRST ERR		; Not at one
	SETZ R,
	JRST BPS5

;A$NB  OR  A$B
BPS1:	HRRZ	R,T
	JUMPE	R,[TRNN F,Q2F	;DELETE MUST NAME A SPECIFIC BPT
		  JRST ERR	;0$B DOESN'T MEAN ANYTHING
		 JRST BPS2]	;0$NB (CLEAR SPECIFIC BPT)
	PUSH	P,T	; SAVE ADDR
	CALL	FETCH	; CREATE IF NECESSARY
	 JRST	ERR
	CALL	DEP	; MAKE COPY IF NECESSARY
	 JRST	ERR
	POP	P,R		; GET BACK ADDRESS
	HRRZ	T,LASFPG	; GET PAGE NUMBER IN OWNER
	LSH	T,9
	ANDCMI	R,777000	; FLUSH PAGE ADDRESS
	IOR	R,T		; CONVERT TO ADDRESS IN OWNER
	TRNN	F,Q2F
	 JRST	BPS3	;A$B

;PROCESS THE $NB (A$NB TO SET, 0$NB TO CLEAR, $NB TO EXAMINE)
BPS2:	MOVE	T,WRD2
	CAIL	T,1
	CAILE	T,NBP
	 JRST	ERR	;NO SUCH BPT NUMBER
	IMULI	T,NBPTV
	ADDI	T,BPTS-NBPTV
	TLZN	F,QF
	 JRST	QUANIN	;$NB  EXAMINE
	JRST	BPS5	;A$NB (SET BPT) OR 0$NB (CLEAR BPT)

;A$B (NOT 0$B). SEARCH FOR A FREE BPT TO USE
BPS3:	MOVEI	T,BPTS	;PROCESS THE A$B
BPS4:	HRRZ	W,(T)	;WHERE BPT IS TO BE PUT
	HLRZ	W1,LASFPG	; GET OWNING FORK
	XOR	W1,7(T)	; COMPARE TO FORK OF BPT
	TRNN	W1,777777	; SAME FORK
	CAIE	W,(R)	;AND SAME ADDRESS?
	SKIPN	(T)	;IS THIS BPT NOT IN USE?
	JRST	BPS5	;YES, USE THIS BPT
	ADDI	T,NBPTV	;NO, TRY NEXT
	CAIE	T,<BPTS+<NBP*NBPTV>>
	JRST	BPS4
	JRST	ERR	;NONE AVAILABLE
;USE THE BREAKPOINT POINTED TO BY T
;ADDR AT WHICH TO SET IT IN R
BPS5:	HRRZ	W,0(T)	;WHERE THIS BPT IS PLACED
	HLRZ	W1,LASFPG	; OWNING FORK FOR NEW BPT
	XOR	W1,7(T)
	CAME	T,BPTFLG	;CHANGING BPT JUST HIT?
	 JRST	BPS6
	CAIN	W,0(R)	;TO A DIFFENERT PLACE?
	TRNE	W1,777777
	 CALL	GOODPC	;YES. DON'T PROCEED FROM OLD ONE.
BPS6:	MOVEM	R,0(T)	;INSERT LOCATION
	SETZM	1(T)
	SETZM	2(T)
	SETZM	3(T)
	SETZM	5(T)	;ASSUME NOT AUTOPROCEED
	HLRZ	R,LASFPG
	HRRM	R,7(T)
	TLNN	F,CCF
	 JRST	RETX
	SETOM	5(T)	;IT IS AN AUTOPROCEED
	MOVSI	R,600000	;A MODERATLY NEGATIVE INFINITY/2
	MOVEM	R,2(T)	;FOR PROCEED COUNT
	JRST	RETX

;FLUSH ALL BREAKPOINTS
FLSBPT:	MOVEI	T,BPTS		;ADDRESS OF 1ST BPT BLK
	SETZM	0(T)		;DELETE THE BPT. 0-->ADDR
	ADDI	T,NBPTV		;MOVE TO NEXT
	CAIE	T,<BPTS+<NBP*NBPTV>>
	JRST	.-3		;DO ANOTHER

;MAKE PC GOOD FOR $P
GOODPC:	SETZM	BPTFLG	;NO LONGER AT A BPT
SETPC:	PUSH	P,2
	MOVSI	2,(1B5)
	IORB	2,PC
	MOVEM	2,REALPC
	POP	P,2
	RET
;CHECK WHETHER THERE IS A BREAKPOINT AT THE ADDRESS POINTED
;AT IN R.  IF THERE IS, DON'T SKIP.  IF THERE ISN'T, SKIP.
;SORT OF BACKWARDS, HUH?

BPCHK:	PUSH	P,W1
	PUSH	P,TT1
	PUSH	P,R
	HRRZS	R
	MOVEI	W1,BPTS
BPCHKL:	HRRZ	TT1,(W1)
	CAMN	TT1,R
	 JRST	BPCHK1
	ADDI	W1,NBPTV
	CAIE	W1,<BPTS+<NBP*NBPTV>>
	 JRST	BPCHKL
	AOS	-3(P)
BPCHK1:	POP	P,R
	POP	P,TT1
	POP	P,W1
	POPJ	P,

;PRINT SOME BREAKPOINT INFORMATION (LIKE :LISTB ON ITS)
PRBRK:	MOVE	W1,[POINT 7,[ASCIZ /reakpoints
Name   Location           Break Skip    Proceed Count/]]
	CALL	TYPE
	MOVEI	W1,BPTS
PRBRKL:	SKIPN	TT1,(W1)		; ONE HERE?
	 JRST	PRNXTB
	CALL	CRF		; CR
	PUSH	P,W1
	MOVEI	W1,6(W1)
	HRLI	W1,440700
	CALL	TYPE		; NAME
	MOVEI	T,10
	CALL	TALIGN
	MOVE	T,TT1
	CALL	CONSYM		; PRINT OUT VALUE,,LOCN
	MOVEI	T,35
	CALL	TALIGN
	MOVE	W1,(P)
	MOVE	T,1(W1)
	CALL	CONSYM		; 0 OR CONDITIONAL BREAK SKIP
	MOVEI	T,55
	CALL	TALIGN
	MOVE	W1,(P)
	MOVE	T,2(W1)
	CALL	TOC		; PROCEED COUNT
	POP	P,W1
PRNXTB:	ADDI	W1,NBPTV
	AOS	(P)
	CAIE	W1,<BPTS+<NBP*NBPTV>>
	 JRST	PRBRKL
	JRST	DD1
;UNPROTECT PAGES IN USER'S FORK
;A<B$NU		;GIVES PROTECTION N TO PAGES A THRU B
;A$NU		;GIVES PROTECTION M TO PAGE A
;$NU		;GIVES PROTECTION N TO THE CURRENT PAGE
;4-BIT OF N MEANS READ ACCESS
;2-BIT OF N MEANS WRITE ACCESS
;1-BIT OF N MEANS EXECUTE ACCESS
;N ASSUMED TO BE 7 IF NOT SPECIFIED

UNPRO:	TLNE	F,CCF
IFE ADBRKF,<	JRST ERR>
IFN ADBRKF,<	JRST DADBRK>	;SET UP ADDRESS BREAK
	MOVE	TT,WRD2	;NUMBER TO RIGHT OF $
	TRNN	F,Q2F	;IF NOT GIVEN,
	MOVEI	TT,7	; ASSUME RWX
	JUMPL	TT,ERR
	CAILE	TT,7
	JRST	ERR
	ROT	TT,-5	;STANDARD POSTION
	TLNE	TT,(1B3)	;ASKING FOR WRITE ACCESS?
	TLO	TT,(1B9)	;YES, GIVE WRITE COPY IF CAN'T GET WRITE
UNPRO1:	TLNE	F,QF	;NUMBER TO LEFT OF $ ?
	JRST	UNPRO2	; YES.
	MOVE	T,LLOC	;.
	TLNE	T,(DDTINT)
	 JRST	ERR	;NICE TRY, RAY.
	LSH	T,-11	;MAKE INTO PAGE NUMBER
UNPRO2:	TLNN	F,FAF	; <  SEEN?
	MOVEM	T,DEFV	;NO, MAKE FIRST AND LAST PAGES THE SAME
	CAIG	T,777
	CAMGE	T,DEFV
	JRST	ERR	;TOO BIG, OR WRONG ORDER
	hrrz	w, lastpg	; Will we change the access of this page?
	lsh	w, -11
	caml	w, defv
	 camle	w, t
	 caia			; Ok, no problem
	call	unmap		; Map it out if we will
	SKIPA	1,DEFV
UNPRO3:	AOS	1,DEFV
	camle	1, t
	JRST	DD1	;DONE
	HRL	1,FORK
	RPACS
	TLNN	2,(1B5)	;EXISTS?
	JRST	UNPRO3
	MOVE	2,TT	;NEW ACCESS
	SPACS
	JRST	UNPRO3
IFN ADBRKF,<
;SET AND REMOVE ADDRESS BREAK
;$$U		REMOVE ADDRESS BREAK
;<LOC>$$<N>U	SET ADDRESS BREAK WITH MASK N FOR LOCATION <LOC>
;N ASSUMED TO BE 2 (BREAK ON WRITE) IF NOT SPECIFIED

DADBRK:	TLNN	F,QF		;ANY LOCATION GIVEN
	 JRST	DADBRR		;NO, GO REMOVE ALL ADDRESS BREAK
	MOVE	3,WRD2		;GET BREAK MASK
	TRNN	F,Q2F
	 MOVEI	3,2		;OR 2 IF NOT GIVEN
	JUMPL	3,ERR
	CAILE	3,7		;RANGE CHECK IT
	 JRST	ERR
	ROT	3,-3		;NORMALISE IT
	JUMPL	T,ERR
	CAILE	T,777777		;RANGE CHECK ADDRESS TOO
	 JRST	ERR
	MOVEI	2,(T)		;ADDRESS TO BREAK WITH
	HRRZ	1,FORK		;THE FORK TO DO IT IN
	ADBRK			;SET IT UP
	RET			;AND DONE

DADBRR:	HRRZ	1,FORK		;THE FORK TO DO IT IN
	HRLI	1,2		;CLEAR ADDRESS BREAK
	ADBRK
	RET			;AND RETURN
>
; ;R -- GET JCL FOR RSCAN BUFFER

RJCL:	MOVE	W1,[POINT 7,[ASCIZ /scan (JCL): /]]
	CALL	TYPE
	SETZM	JCL			; CLEAR BUFFER
	MOVE	1,[JCL,,JCL+1]
	BLT	1,ENDJCL
	HRROI	1,JCL			; Set up TEXTI block
	MOVEM	1,TXTBLK+.RDDBP
	MOVEI	1,20*5
	MOVEM	1,TXTBLK+.RDDBC
	MOVEI	1,TXTBLK
	TEXTI				; READ IN SOME STUFF
	 JFCL
	MOVE	1,TXTBLK+.RDFLG
	TLNE	1,(RD%BFE)		; DELETED PAST START?
	 JRST	WRONG
	HRROI	1,JCL
	RSCAN				; PUT JCL IN BUFFER
	 JRST 	WRONG
	JRST	DD1.5
; ;J -- JFN STATUS
; <JFN>;J STATUS OF JUST THAT JFN


SEMI.J:	TRNE	F,SEMIF2
	 JRST	jobst		; ;;J?
	TLNE	F,QF		;HAVE AN ARG?
	 JRST	SEMIJ1		;YES
	MOVE	W1,[POINT 7,[ASCIZ /fn status:
/]]
	CALL	TYPE
	INTON
	MOVEI	T,MAXJFN
	CALL	JSTAT
	SOJGE	T,.-1
	JRST	DD1

SEMIJ1:	JUMPL	T,ERR
	CAILE	T,MAXJFN
	 JRST	ERR
	INTON
	PUSH	P,T
	TLNN	F,QF
	 CALL	CRF
	TLNE	F,QF
	 CALL	LCT
	POP	P,T
	CALL	JSTAT
	JRST	DD1
;TYPE STATUS OF JFN IN T

JSTAT:	HRRZ	1,T		;THE JFN
	GTSTS
	TLNE	2,(1B10)	;NO GOOD? (+++ apparently this doesn't catch all cases)
	 JRST	JSTAT0		;NOT SO.
	MOVE	W1,[POINT 7,[ASCIZ / not assigned/]]
	TLNE	F,QF		;<JFN>;J ?
	 CALL	TYPE		;YES.
	RET

JSTAT0:	PUSH	P,T
	PUSH	P,2		;SAVE STATUS
	MOVEI	1,101
	HRRZ	2,T
	MOVE	3,[4,,10]
	TLNN	F,QF		;DONT TYPE JFN AGAIN IF N;J
	NOUT
	 CALL	TSPC
	CALL	LCT		;TYPE A TAB
	MOVEI	1,101
	HRRZ	2,-1(P)		;THE JFN
	SETZ	3,			;DEFAULT FORMAT
	JFNS
	 ERJMP [HRROI 1,[ASCIZ /Unassigned/]
		PSOUT
		POP P,TT
		JRST JSTA10]
	CALL	LCT
	TRZ	F,TEMF		;USED BY MMAP14
	POP	P,TT		;GET THE STATUS WORD
	MOVE	W1,[POINT 7,[ASCIZ /not open/]]
	TLNN	TT,(1B0)
	 CALL	TYPE
	MOVSI	W1,(ASCII / R/)
	TLNE	TT,(1B1)
	 CALL	MMAP14		;MAYBE TYPE A COMMA AND THE LETTER
	MOVSI	W1,(ASCII / W/)
	TLNN	TT,(1B4)
	MOVSI	W1,(ASCII / A/)
	TLNE	TT,(1B2)
	 CALL	MMAP14		;OK TO WRITE AND MAYBE CHANGE POINTER
	MOVSI	W1,(ASCII / X/)
	TLNE	TT,(1B3)
	 CALL	MMAP14
	MOVE	W1,[ASCII / PPT/]
	TLNE	TT,(1B5)
	 CALL	MMAP14
	MOVE	W1,[ASCII / PRC/]
	TLNE	TT,(1B6)
	 CALL	MMAP14
	MOVE	W1,[ASCII / ERR/]
	TLNE	TT,(1B9)
	 CALL	MMAP14
	MOVE	W1,[ASCII / EOF/]
	TLNE	TT,(1B8)
	 CALL	MMAP14
	TLNE	TT,(1B1!1B2)
	TLNN	TT,(1B0)
	 JRST	JSTA10
	TLNE	TT,(1B3!1B6)
	 JRST	JSTA10
	HRRZ	1,0(P)		;THE JFN
	RFPTR
	 JRST	JSTA10
	PUSH	P,2
	MOVEI	T,","
	CALL	TOUT
	CALL	TSPC
	MOVEI	1,101
	POP	P,2
	MOVEI	3,12
	NOUT
	 JRST	JSTA10
	MOVEI	T,"."
	CALL	TOUT
JSTA10:	CALL	CRF
	POP	P,T
	RET
; ;A --TYPE ADDRESS SPACE --  MEMSTAT
;JUST LIKE THE EXEC'S


ADRSPC:	CALL	UNMAP
	TLNE	F,QF		;DO WE HAVE AN ARG?
	 JRST	ADRSP1		;YES.

MEMSTA:	MOVE	W1,[POINT 7,[ASCIZ /ddress space
/]]
	CALL	TYPE
	INTON
	HRLZ	1,FORK		;USER'S FORK
	PUSH	P,[1000]		;HOW MANY PAGES TO DO
	SETZB	T,W		;CURRENT PAGE
MEMS1:	RPACS
	TLNE	2,(1B5)		;EXISTS?
	AOS	W,T			;YES,COUNT IT
	AOS	1			;NEXT PAGE
	SOSLE	0(P)		;COUNT DOWN NUMBER OF PAGES LEFT
	 JRST	MEMS1
	SUB	P,[1,,1]		;FLUSH JUNK
	CALL	TOC		;T,W = NUMBER OF PAGES WHICH EXIST
	MOVE	W1,[POINT 7,[ASCIZ / Pages/]]
	CALL	TYPE

MEMS2:	MOVE	1,FORK
	GEVEC
	JUMPE	2,MEMS3		;NO ENTRY VECTOR
	PUSH	P,2
	MOVE	W1,[POINT 7,[ASCIZ /, Entry vector location /]]
	CALL	TYPE
	HRRZ	T,0(P)
	push	p, w
	CALL	pad
	pop	p, w
	MOVEI	W1,[ASCIZ / length /]
	CALL	TYPE
	POP	P,T
	HLRZS	T
	CALL	TOC

MEMS3:	CALL	CRF
	JUMPE	W,DD1
	CALL	CRF
MMAP:	SETZM	W
MMAP1:	HRL	1,FORK
MMAP2:	CAIL	W,1000
	JRST	DD1		;DONE
	HRR	1,W
	RPACS
	TLNN	2,(1B5!1B6)	;EXISTS OR @
	AOJA	W,MMAP2		;NO, TRY NEXT
	CALL	PAGID		;GET FULL IDENTITY
	 JRST	.+2
	 JRST	.+1
	MOVE	TT,TT2		;SAVE ID FOR LATER
	MOVE	TT1,TT3		;PRINTING, TESTING
	SETZM	W2		;HOW MANY IN THIS GROUP
	HRRZ	T,W
	CALL	TOC		;GROUP START, PAGE NUMBER

;HAVE THE FIRST PAGE, LOOK AT NEXT ONE TO SEE IF IT IS SAME GROUP
	CALL	NPAGID		;NEXT PAGE ID, STEPS W
	 SOJA	W2,MMAP10		;DIFFERENT, TYPE OUT
	 JRST	MMAP6		;NEXT(CONSECUTIVE) PAGE IN SAME GROUP

;2ND PAGE IDENTICAL TO FIRST PAGE, SEE HOW MANY MORE ARE
	CALL	NPAGID
	 JRST	.+3
	 JRST	.+2
	JRST	.-3		;IDENTICAL, KEEP GOING
	SETZM	W2		;SAY IDENTICAL, NO CONSECUTIVE PAGES
	JRST	MMAP7

;2ND PAGE IS NEXT HIGHER AFTER 1ST, IN SAME FORK/FILE. HOW MANY MORE
MMAP6:	CALL	NPAGID
	 JRST	.+2		;DIFFERENT
	 JRST	.-2		;CONSECUTIVE, KEEP GOING
;PRINT LAST PAGE NUMBER OF GROUP
MMAP7:	MOVEI	T,"-"
	CALL	TOUT
	MOVEI	T,-1(W)
	CALL	TOC		;FINAL PAGE NUMBER

;PRINT IDENTITY OF PAGES(S) IN GROUP
MMAP10:	CALL	LCT		;TAB
	CALL	TSPC		;SPACE
	TLNE	TT1,(1B6)
	JRST	MMAP09
MMAP08:	TLNN	TT1,(1B5)
	JRST	MMAP70
	TLNE	TT1,(1B10)
	JRST	MMAP71
	CAMN	TT,[-1]
	JRST	MMAP72
	LDB	2,[POINT 9,TT,17]	;JFN OR FORK #
	TLNE	TT,(1B0)		;ON IF FORK
	JRST	MMAP69
	MOVEI	1,101		;TTY OUTPUT
	SETZM	3			;NO SPECAIL OPTIONS
	JFNS			;PRINT FILE NAME
MMAP11:	CALL	LCT
	HRRZ	T,TT
	CALL	TOC		;PAGE # IN FORK/FILE
	JUMPLE	W2,MMAP13	;0 => ONLY ONE PAGE
	MOVEI	T,"-"
	CALL	TOUT
	HRRZ	T,TT
	ADDI	T,-1(W2)
	CALL	TOC		;LAST PAGE IN GROUP
	JRST	MMAP13

MMAP09:	MOVSI	W1,(ASCII /@ /)
	CALL	TEXT2
	JRST	MMAP08
MMAP69:	MOVE	W1,[POINT 7,[ASCIZ /Fork /]]
	CALL	TYPE
	MOVE	T,2		;FORK NUMBER
	CALL	TOC
	JRST	MMAP11

MMAP70:	MOVE	W1,[POINT 7,[ASCIZ /No page/]]
	JRST	MMAP12

MMAP71:	MOVE	W1,[POINT 7,[ASCIZ /Private/]]
	JRST	MMAP12

MMAP72:	MOVE	W1,[POINT 7,[ASCIZ /Forgotten file/]]
MMAP12:	CALL	TYPE
MMAP13:	TRZ	F,TEMF		;SUPPRESS COMMA IN LIST
	MOVSI	W1,(ASCII / R/)
	TLNE	TT1,(1B2)
	CALL	MMAP14
	MOVSI	W1,(ASCII / W/)
	TLNE	TT1,(1B3)
	CALL	MMAP14
	MOVSI	W1,(ASCII / C/)
	TLNE	TT1,(1B9)
	CALL	MMAP14
	MOVSI	W1,(ASCII / X/)
	TLNE	TT1,(1B4)
	CALL	MMAP14
	MOVSI	W1,(ASCII / L/)
	TLNE	TT1,(1B7)
	CALL	MMAP14
	CALL	CRF
	TLNE	F,QF		;<PAGE>;A COMMAND?
	 JRST	DD1		;YES.  WE'RE DONE
	JRST	MMAP1		;DO NEXT GROUP

;TYPE ITEM IN ACCESS CAPABILITY LIST
MMAP14:	MOVEI	1,","
	TROE	F,TEMF
	CALL	TOUT+1
	JRST	TEXT2
;<PAGE>;A

ADRSP1:	SKIPL	W,T
	CAIL	W,1000
	 JRST	ERR		;BAD ARG
	HRL	1,FORK
	HRR	1,W
	RPACS
	TLNN	2,(1B5!1B6)
	 JRST	ADRSP2
	CALL	PAGID
	 JRST	.+2
	 JRST	.+1
	MOVE	TT,TT2
	MOVE	TT1,TT3
	SETZM	W2
	JRST	MMAP10

ADRSP2:	MOVE	W1,[POINT 7,[ASCIZ /  No page/]]
	CALL	TYPE
	CALL	CRF
	JRST	DD1
;NEXT PAGE ID
NPAGID:	ADDI	W,1		;PAGE UNDER CONSIDERATION
	ADDI	W2,1		;HOW MANY IN CURRENT GROUP

;GET PAGE IDENTIFICATION
PAGID:	MOVE	1,W
	SETZM	TT2		;FOR NON-EXISTENT OR PRIVATE PAGE
	CAIL	1,1000
	JRST	PAGID7
	HRL	1,FORK
	RPACS
	HLLZ	TT3,2		;RETURN ACCESS
	TLNE	2,(1B5)		;DOESN'T EXIST?
	TLNE	2,(1B10)		;PRIVATE?
	JRST	PAGID8		; ALL INFO REQUIRED
	RMAP
	MOVE	TT2,1		;RETURN ID

;COMPARE PRINTING INFO AGAINS SAME FOR PREVIOUS PAGE
PAGID8:	MOVE	1,TT2
	XOR	1,TT
	TLNE	1,-1
	JRST	PAGID9		;DIFFERENT FILES OR FORKS
	MOVE	2,TT3
	XOR	2,TT1
	TLNE	2,(37B6!1B7!3B10)
	JRST	PAGID9		;DIFFERENT ACCESS
	TRNE	1,-1
	JRST	PAGID6
	AOS	(P)
	AOS	(P)
PAGID9:	RET

PAGID6:	MOVE	1,W2
	ADD	1,TT
	SUB	1,TT2
	TRNE	1,-1
	RET
	JRST	PAGID9-1

PAGID7:	HRLZI	TT3,(1B5)	;PAGES > 777 DON'T EXIST
	JRST	PAGID8
;SETUP TO EXECUTE A SINGLE INSTRUCTION
;T HAS THE INSTR.
;$X SAYS WHERE IN USER'S MEMORY TO DO IT

SETESI:	HRRZ	R,XRG	;WHERE
	CALL	DEP
	 JRST	ERR	;CAN'T DO IT IN PROTECTED MEMORY
	MOVEI	W1,3
SETES1:	MOVE	T,[BPT]
	AOS	R
	CALL	DEP	;INSERT PSEUDO BREAKPOINTS
	 JRST	ERR
	SOJG	W1,SETES1
	CALL	DOSET
	HLL	R,PC	;GET FLAGS
	HRR	R,XRG	;WHERE $X SHOULD BE DONE
	MOVEM	R,PC	;HIS TEMPORARY PC
	MOVEM	R,REALPC
	RET


;SETUP A SAVE FRAME ON THE AUXILIIARY STACK
DOSET:	EXCH	P,PCSPTR
	PUSH	P,F
	PUSH	P,LLOC
	PUSH	P,LLOCO
	PUSH	P,TRAPWD
	PUSH	P,WDATA
	PUSH	P,BPTFLG	;WHICH BREAKPOINT WERE AT
	PUSH	P,BINSTR	;CURRENT BREAK INSTRUCTION
.RPCNT==0
REPEAT <NTBPTS+1>*2,<PUSH P,$CTRLN+.RPCNT
.RPCNT==.RPCNT+1>
	MOVSI	R,(1B5)	;USERMODE FLAG
	IORM	R,PC
	PUSH	P,PC	;SAVE HIS OLD PC
	EXCH	P,PCSPTR
	RET

;UNSET THE ABOVE
UNSET:	EXCH	P,PCSPTR
	HLL	TT1,REALPC	;FLAGS RETURNED FROM $X ETC.
	POP	P,PC
	HRR	TT1,PC
	MOVEM	TT1,PC	;WHAT TO TYPE FOR $G
	MOVEM	TT1,REALPC	;WHERE TO DO SFORK (IN TOUSER)
.RPCNT==0
REPEAT <NTBPTS+1>*2,<POP P,$CTRLN+<<NTBPTS+1>*2-1>-.RPCNT
.RPCNT==.RPCNT+1>
	POP	P,BINSTR
	POP	P,BPTFLG
	POP	P,WDATA
	POP	P,TRAPWD
	POP	P,LLOCO
	POP	P,LLOC
	POP	P,F
	EXCH	P,PCSPTR
	RET
;;J COMMAND -- JOBSTAT

JOBST:	CALL	UNMAP	;WILL USE THAT AREA FOR BUFFER
	FRKTAB=UCORE
	MOVEI	W1,[ASCIZ /ob status
/]
	CALL	TYPE
	INTON
	MOVEI	W1,[ASCIZ/ Tss job /]
	CALL	TYPE
	GJINF
	HRLM	1,4			;SAVE DIRECTORY LOGGED IN
	MOVEI	1,101
	MOVE	2,3			;GET TSS JOB NUMBER
	HRRZI	3,^D10
	NOUT				;PRINT IT OUT
	MOVEI	W1,[ASCIZ/, user /]
	CALL	TYPE
	HLRZ	2,4			;GET DIRECTORY NUMBER
	DIRST				;PRINT IT OUT
	 JFCL
	MOVEI	T,","
	CALL	TOUT
	CALL	TSPC			;TYPE A SPACE
	HRRE	2,4			;GET THE DEVICE
	DEVST				;PRINT THE TTY NUMBER
	SKIPA	W1,[[ASCIZ/det/]]	;PRINT OUT DET
	TRNA				;SKIP
	CALL	TYPE			;TYPE IT OUT
	CALL	CRF			;FOLLOWED BY CARRIAGE RETURN

;TYPE FORK STRUCTURE
	MOVEI	1,400000		;SAY START AT SELF
IFN KL20F,<jrst frkst2>
JOBST1:	movsi	2,(1B0)		;SAY ASSIGN HANDLES
	MOVEI	2,FRKTAB		;USE BUFFER
	GFRKS			;GET FORK STRUCTURE
	HRRZ	W2,FRKTAB		;POINTER TO FORKS INFERIOR
	SETZ	W,			;INITIALIZE LEVEL COUNTER
	CALL	FSTRUC		;USE COMMON DISPLAY FORK
	JRST	DD1		;STRUCTURE ROUTINE


;FSTRUC
;RECURSIVE SUBR TO TYPE FORK STRUCTURE OF JOB.
;FOR EACH FORK, TYPES HANDLE AND STATUS.
;  FILE NAME OR "PROGRAM" WOULD ALSO BE DESIRABLE IF IT WERE AVAILABLE.
;STRUCTURE INDICATED BY PUTTING A FORK'S INFERIORS RIGHT AFTER IT,
;  INDENTING 3 COLUMNS PER LEVEL.
;THUS PARELLEL FORKS ARE THOSE WHICH APPEAR AT SAME INDENTATION WITH
;  NO LESS-INDENTED ENTRIES BETWEEN THEM.
;TAKES: S: POINTER TO GFRKS TABLE, SET UP BY CALLER.
;	W: LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER.

;ENTRY POINT IS AT END BUT COMES RIGHT HERE.
;TYPE STUFF FOR THIS FORK.

FSTR1:	CALL	TSPC
	MOVE	1,W
	CALL	LCT		;INDENT 3 SPACES PER LEVEL BELOW FIRST.
	SOJGE	1,.-1
	MOVEI	W1,[ASCIZ/Fork /]
	CALL	TYPE

	HRRZ	2,1(W2)		;GET THIS FORK'S HANDLE FROM TABLE
	JUMPE	2,[MOVEI W1,[ASCIZ /**/]	;NO HANDLE ASSIGNED
		CALL TYPE
		JRST FSTR2]
	TRZ	2,(1B0)		;PRINT IN FORM ## NOT 4000##
	MOVEI	1,101
	MOVEI	3,10
	NOUT			;FORK HANDLE, OCTAL
	 JRST	ERR		;JSYS ERROR ROUTINE FOR ERROR NUM IN C
FSTR2:	MOVEI	W1,[ASCIZ/: /];
	CALL	TYPE
	HRRZ	1,1(W2)		;HANDLE AGAIN
	CALL	FSTAT		;TYPE ITS STATUS
	CALL	CRF
;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION.
	PUSH	P,W2
	HRRZ	W2,(W2)		;INFERIOR PTR FROM GFRKS TABLE.
	AOS	W			;DOWN LEVEL
	CALL	FSTRUC		;RECURSIVE CALL TO DO ENTIRE SUBTREE
	SOS	W			;UP LEVEL
	POP	P,W2
	HLRZ	W2,(W2)		;PARALLEL PTR FROM GFRKS TABLE

;ENTRY POINT.  NOP IF 0 PTR GIVEN.
FSTRUC:	JUMPN	W2,FSTR1
	RET
; ;I -- Interrupt  STATUS
;PSI IS OFF, LEVTAB=NNNNNN, CHNTAB=NNNNNN, CHN MASK=NNNNNNNNNNNN, BIP=N

PSIST:	MOVEI	W1,[ASCIZ/nterrupt status
/]
	CALL	TYPE
	INTON
	CALL	TSPC
	SKIPGE	1,FORK
	JRST	[	MOVEI W1,[ASCIZ /No program/]
		CALL	TYPE
		JRST CRF]
	MOVEI	W1,[ASCIZ /PSI is /]
	CALL	TYPE
	MOVEI	W1,[ASCIZ /on/]
	SKIPN	USRPSI+3	;SKIP IF HIS PSI SYSTEM IS ON
	MOVEI	W1,[ASCIZ /off/]
	CALL	TYPE
	RIR
	HLRZ	4,2		;LEVTAB
	HRRZ	TT3,2		;CHNTAB
	MOVEI	W1,[ASCIZ/, Levtab at /]
	CALL	TYPE
	MOVEI	t,(4)
	call	pad
	MOVEI	W1,[ASCIZ/, Chntab at /]
	CALL	TYPE
	MOVEI	t,(TT3)
	call	pad
	MOVEI	W1,[ASCIZ/
 Channels active:       /]
	CALL	TYPE
	MOVE	1,USRPSI+1
	CALL	BITTYP
PSIST2:	MOVEI	W1,[ASCIZ/ Breaks waiting:        /]
	CALL	TYPE
	MOVE	1,USRPSI+0
	CALL	BITTYP
	MOVEI	W1,[ASCIZ/ Levels in progress:    /]
	CALL	TYPE
	MOVSI	1,(17B3)
	AND	1,USRPSI+2
	CALL	BITTYP
	MOVEI	W1,[ASCIZ/
 Fork tiw:      /]
	CALL	TYPE
	MOVEI	1,101
	MOVE	2,USRPSI+4
	MOVE	3,[1B0+^D8]			;PRINT MAGNITUDE IN OCTAL
	NOUT
	 JFCL
	MOVEI	W1,[ASCIZ/
 Job tiw:       /]
	CALL	TYPE
	MOVNI	1,5
	RTIW
	MOVEI	1,101
	MOVE	3,[1B0+^D8]			;PRINT IN Octal
	NOUT
	 JFCL
	CALL	CRF
	JRST	DD1
;
;	ROUTINE TO TYPE OUT THE BIT NUMBERS IN REGISTER 1.
;		IF REGISTER 1 CONTAINS 500000,,0 THEN THIS
;		ROUTINE WOULD PRINT 0, 1 FOLLOWED BY A CRLF
;
BITTYP:	SKIPE	4,1			;GET THE ARGUMENT
	JRST	BITYP1			;JUMP IF THERE ARE BITS ON
	MOVEI	W1,[ASCIZ/None
/]						;PRINT NONE IF ALL ZEROES
	JRST	TYPE			;AND RETURN DIRECTLY FROM TYPE
BITYP1:	MOVEI	1,101
	MOVSI	TT3,400000
	SETZ	2,
BITYP2:	SETZ	3,
	LSHC	3,1			;ROTATE A BIT INTO 3

	JUMPE	3,BITYP3		;JUMP IF BIT OFF
	MOVEI	3,^D10			;PRINT MAGNITUDE
	NOUT
	 JFCL				;IGNORE ERRORS
	JUMPE	4,CRF			;CRLF AND EXIT IF NO MORE ON
	CALL	BEFORE			;PRINT , IF NECESSARY
BITYP3:	AOJA	2,BITYP2		;NEXT BIT NUMBER
; ;V COMMAND -- SET ^T VIEW ADDRESS

SEMI.V:	TRNE	F,SEMIF2
	 JRST	ERR		;TOO MANY SEMICOLI
	TLNN	F,QF		;HAVE AN ARG?
	 JRST	SEMIV1		;NO
	TLNE	T,-1		;REASONABLE ADDRESS?
	 JRST	ERR		;NO
	CAIA
SEMIV1:	SETO	T,
	MOVEM	T,VADDR		;LEAVE FOR ^T TO SEE
	JRST	DD1
;F COMMAND -- FORKSTAT

SEMI.F:	TRNN	F,SEMIF2		; ;;F OR ;F?
	 JRST	FRKST		; ;F GO DO FORK STAT
	TLNN	F,QF		; N;;F?
	 JRST	ERR		;NO
	CAIL	T,0
	CAIL	T,16
	 JRST	ERR	; BAD FORK NUMBER
	SKIPN	T
	 MOVE	T,TPFORK
	IORI	T,400000
	MOVE	1,T
	TLNN	F,FAF		; TWO ARGS?
	 JRST	SEM.F1		;NO
	MOVE	2,DEFV		; GET ARG
	IORI	2,400000		; INSURE ITS A FORK HANDLE
	GFRKH			; GET FORK HANDLE
	 JRST	ERR		; SOME KIND OF ERROR
	PUSH	P,1
	MOVEI	2,-400000(1)
	HRROI	1,[ASCIZ /(fork /]
	PSOUT
	MOVEI	1,101
	MOVEI	3,10
	NOUT
	 JFCL
	HRROI	1,[ASCIZ /) /]
	PSOUT
	POP	P,1
SEM.F1:	CALL	SETFRK
	 JRST	ERR
	JRST	DD1
FRKST:	CALL	UNMAP	;WILL USE THAT AREA FOR BUFFER
	FRKTAB=UCORE
	TLNE	F,QF		; N;;F?
	 JRST	FRKST1		;YES
	MOVE	W1,[POINT 7,[ASCIZ /ork status
/]]
	CALL	TYPE
	INTON
FRKST2:
IFN KA10F,<	MOVE 2,[1B0+FRKTAB]>
IFN KL20F,<	MOVSI 2,(1B0)
		MOVE 3,[-1000,,FRKTAB]
	   >
	GFRKS
IFE isigff,<	JRST ERR>
IFN isigff,<	JFCL>
	HRRZI	W,FRKTAB	;WHAT TO PRINT
	MOVEI	TT,1	;LEVEL TO PRINT IT AT
	CALL	PRFRK	;PRINT FORKS
	JRST	DD1

PRFRK:	JUMPE	W,CPOPJ
	PUSH	P,W		;SAVE FOR BELOW
	PUSH	P,TT		;SAVE PRINTING LEVEL
	CALL	TSPC		;TYPE A SPACE
	SOJG	TT,.-1
	HRRZ	T,1(W)	;FORK HANDLE
	ANDI	T,77
	CALL	TOC	;PRINT IT
	CALL	LCT		;AND A TAB
	HRRZ	1,1(W)		;THE FORK HANDLE
	CALL	FSTAT		;PRINT THE STATUS
	CALL	CRF		;AND A CARRIAGE RETURN
	POP	P,TT		;RESTORE LEVEL
	HRRZ	W,@(P)		;POINTER TO INFERIORS
	AOS	TT		;LEVEL OF INFERIORS
	CALL	PRFRK	;PRINT THEM
	SOS	TT		;NOW BACK TO THIS LEVEL
	POP	P,W
	HLRZ	W,0(W)	;PARALLEL FORKS
	JRST	PRFRK

FRKST1:	JUMPL	T,ERR		;BAD ARG
	CAIL	T,20
	 JRST	ERR		;BAD ARG
	PUSH	P,T
	CALL	LCT
	POP	P,1
	TRO	1,400000		;MAKE INTO A GOOD FORK HANDLE
	CALL	FSTAT		;PRINT STATUS
	CALL	CRF
	JRST	DD1

;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE.
;USED FOR AVAILABLE TERMINALS, AVAILABLE DEVICES, AND FILSTAT.
;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT.

BEFORE:	PUSH	P,1
	PUSH	P,2
	MOVEI	1,101
	RFPOS
	MOVEI	2,(2)		;MASK COLUMN POSITION
	CAIL	2,^D65
	JRST	[	CALL	CRF
		JRST .+4]
	MOVEI	T,","
	TLOE	TT3,(1B0)		;SUPPRESS COMMA BEFORE FIRST ONE
	CALL	TOUT
	CALL	TSPC		;SPACE AFTER COMMA OR EOL
	JRST	[	POP P,2
		POP P,1
		RET]
;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT".
;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A
;    DEVICE CHARACTERISTICS WORD (A LA "DVCHR" EXCEPT B5) IN	2,
;    -1 OR JOB # ASSIGNED TO IN C.
;RETURNS +2.
;DESTROYS 1, 2, 3, 4.
DEVNAM==6
DEVCHR==7
DEVUNT==10

DEVLUP:	SETO	4,
	HRL	1,TT2
	HRRI	1,DEVNAM	;GET # DEVICES FROM TABLE 6
	GETAB
	 JFCL
	HRLZ	4,1		;AOBJN COUNT,,ABLE INDEX
DEVL1:	HRL	1,4
	HRRI	1,DEVCHR	;GET DEVICE CHARACTERISTICS WORD FROM TABLE 7
	GETAB
	 JFCL
	MOVE	2,1
	HRL	1,4
	HRRI	1,DEVUNT	;GET JOB # ASS TO, OR -1, FROM LH TABLE 8
	GETAB
	 JFCL
	HLRE	3,1
	HRL	1,4
	HRRI	1,DEVNAM	;GET DEVICE NAME IN SIXBIT FROM TABLE 6
	GETAB
	 JFCL
	PUSH	P,4
	XCT	@-1(P)
	POP	P,4
	AOBJN	4,DEVL1
	JRST	[	AOS (P)
		RET]

;TYPE SIXBIT SYMBOL FROM A.

SIXPRT:	PUSH	P,2
	MOVE	2,1
SIXPR1:	SETZ	1,
	LSHC	1,6
	ADDI	1,40
	PBOUT
	JUMPN	2,SIXPR1
	JRST	[	POP P,2
		RET]
;ARG<  COMMAND
FIRARG:	MOVEM	T,DEFV		;VALUE OF ARG TO DEFINITION VALUE
	TLO	F,FAF		;INDICATE A < HAS BEEN SEEN
	JRST	ULIM1		;GIVE ERROR IF ARG NULL


;ARG> COMMAND
ULIM:	TLO	F,SAF		;INDICATE A > HAS BEEN SEEN
	HRRZM	T,ULIMIT		;UPPER LIMIT FOR $Z, $W ETC.


ULIM1:	TLNN	F,QF		;ON IF ARG WAS TYPED
	JRST	ERR
	JRST	LIS0		;GET REST OF COMMAND


;$I COMMAND -- NAME OF INTERRUPT STUFF FOR USER PSI SYSTEM
INTRUP:	TLNN	F,QF		;MUST HAVE NO ARG
	TLNE	F,CCF		;AND ONLY ONE $ SIGN
	JRST	ERR		;ELSE, DIFFERENT COMMAND
	MOVEI	T,USRPSI
	JRST	QUANIN

; ;H -- HALTF BACK TO EXEC
HALT:	MOVE	1,ESCCOD
	DTI
	HALTF			;LIKE @QUIT
	JRST	DDT
;LOOK FOR BEST FIT FOR SYMBOL TYPE-OUT
LOOK:	TLNN	T,-1		;IF LEFT HALF NON-0, OR
	 CAIGE	T,140		;VALUE LESS THAN 140,
LOOKE:	  TLOA	F,(1B2)		;SKIP LOCALS OUTSIDE CURRENT PGM
	   TLZ	F,(1B2)		;OTHERWISE, ALLOW LCLS AND SAVE CONTEXT
	SETZM	SVFB
	SETZM	SVTB
	SETOM	BLVL
	HLRE	S,SYMPTR
	ASH	S,-1
	TLZ	F,600000
	HRLZI	W2,DELO+DELI
	MOVEM	T,TEM
	SKIPL	R,PRGM
	 JRST	TOPDWN
LOOK1:	SUB	R,[2,,2]
	TDNE	W2,(R)
	 JRST	LOOK3
	LDB	T,[POINT 4,(R),3]
	CAIN	T,3
	 JRST	BLNME
	JUMPE	T,PNAM
	TRNE	T,LOCAL/40000
	 TLZA	F,(1B1)
	  TLO	F,(1B1)
	MOVE	T,TEM
	MOVE	W,1(R)
	XOR	W,T
	JUMPL	W,LOOK3
	SUB	T,1(R)
	JUMPL	T,LOOK3
	JUMPGE	F,LOOK2
	MOVE	W,1(R)
	SUB	W,1(W1)
	JUMPL	W,LOOK3
	JUMPG	W,LOOK2
	SKIPN	SVTB		; THIS SYMBOL NO PREFIX
	 SKIPN	SVFB		; AND LAST SYMBOL WITH PREFIX?
	  JRST	LOOK3		; NO
LOOK2:	HRR	W1,R
	TLO	F,(1B0)		; REMEMBER WE HAVE FOUND SOME SYMBOL
	MOVE	W,SVTB
	TLNE	F,(1B1)		; IF THIS SYMBOL IS GLOBAL,
	 MOVEI	W,0		; THEN DON'T SAVE BLOCK
	MOVEM	W,SVFB
	SKIPN	W			; ANY PREFIX?
	 JUMPE	T,SPT0		; NO, THEN EXACT MATCH IS BEST
LOOK3:	CAMN	R,SYMPTR
	 JRST	TOPDWN
LOOK3A:	AOJLE	S,LOOK1
	MOVE	T,TEM
	TLNE	F,(1B0)
	 SUB	T,1(W1)
	JUMPE	T,SPT0
	JRST	CPOPJ1

TOPDWN:	TLNE	F,(1B2)
	 TLO	W2,LOCAL
	HLRE	R,SYMPTR
	MOVNS	R
	ADD	R,SYMPTR
	JRST	LOOK3A

PNAM:	TLNE	F,(1B2)
	 TLO	W2,LOCAL
	SKIPA	T,[-1]		; PROGRAM NAMES LIKE BLOCKS OF LEVEL -1
BLNME:	 MOVE	T,1(R)		; GET BLOCK LEVEL
	MOVEM	R,SVTB		; SAVE THIS BLOCK LOCATION
	CAMN	R,BLOCK		; IS THIS THE CURRENT BLOCK?
	 JRST	BLNM1		; YES
	CAML	T,BLVL		; IS BLOCK BELOW CURRENT?
	 JRST	LOOK3		; YES, RETAIN PREFIX
BLNM1:	SETZM	SVTB		; THIS IS CURRENT OR ABOVE
	MOVEM	T,BLVL
	JRST	LOOK3
CONSYM:	MOVEM	T,LWT
CONSY1:	TRNN	F,LF1
	 JRST	(SCH)		;PIN OR FTOC
	TRNE	F,CF1
	 JRST	FTOC

PIN:				;PRINT INSTRUCTION
	LDB	T,[POINT 9,T,8]	;GET OPCODE
	JUMPE	T,HLFW		;0.  TYPE AS HALF WORDS
	CAIL	T,700		;CONO, CONI, ETC?
	 JRST	INOUT		;YES.  TYPE AS IN/OUT INSTRUCTION
	CAIN	T,<JSYS>/1B8
	 JRST	JSTYPE		;TYPE JSYS INSTRUCTION
PIN0:	HLLZ	T,LWT
	TLZ	T,777
	CALL	OPTYPE
PIN1:	TRNE	F,ITF		;INSTRUCTION TYPED?
	 JRST	PFULI1		;YES
	MOVE	T,LWT		;TRY TO FIND FULL WORD MATCH
	TLNE	T,777		;BUT NOT IF AC, @, OR X FIELDS NON-0
	 JRST	PFULI1
	CALL	LOOK
	 JRST	PADS1		;FOUND
PFULI1:	MOVSI	T,777000
	AND	T,LWT
	TRNN	F,ITF		;HAS INSTRUCTION BEEN TYPED?
	 CALL	LOOK		;NO, LOOK IN SYMBOL TABLE
	TROA	F,NAF		;INSTRUCTION TYPED, ALLOW NEG ADDRESSES
	 JRST	HLFW		;NOT FOUND, OUTPUT AS HALFWORDS
	CALL	TSPC
	LDB	T,[POINT 4,LWT,12]	;GET AC FIELD
	JUMPE	T,PI4
	CALL	PAD
PI3A:	MOVEI	W1,","
	CALL	TEXT
PI4:	MOVE	W1,LWT
	MOVEI	T,"@"
	TLNE	W1,20		;CHECK FOR INDIRECT BIT
	CALL	TOUT
	HRRZ	T,LWT
	LDB	W,[POINT 9,LWT,8]	;INSTRUCTION BITS
	TLNE	W1,20
	JRST	PI8
	CAIL	W,240
	CAILE	W,247
	JRST	PI8A		;ALL (EXCEPT ASH,ROT,LSH) HAVE SYMB. ADRS
	CAIN	W,<JFFO>_-33
	JRST	PI8		;JFFO AND @ GET SYMBOLIC ADDRESSES
	CALL	PADS3A		;ONLY ABSOLUTE ADDRESSING FOR LSH, ASH, AND ROT
PI7:	TRZ	F,NAF	
	LDB	R,[POINT 4,LWT,17]	;INDEX REGISTER CHECK
	JUMPE	R,PIZ		;EXIT
	MOVEI	T,"("
	CALL	TOUT
	MOVE	T,R
	CALL	PAD
	MOVEI	T,")"
	CALL	TOUT		;EXIT
PIZ:	SKIPN	PINFF		;PRINT INSTRUCTION AC/EFF ADR?
	 RET			;NOPE RETURN NOW
	SETZM	PINFF		;NEVER CHANCE RECURSION...
	LDB	T,[POINT 9,LWT,8]	;GET OPCODE
	MOVE	T,PCPNTB(T)	;GET TABLE ENTRY
	LDB	R,[POINT 4,LWT,12]	;GET AC FIELD
	PUSH	P,LWT		;SAVE LWT OVER PRINTING
	TRNE	T,1		;OPEN THE AC?
	 JRST	PIZAC		;YES... 
	TRNN	T,2		;OPEN AC UNLESS IT IS ZERO?
	 JRST	PIZNAC		;NOPE, SO NEVER PRINT AC
	JUMPE	R,PIZNAC
PIZAC:	CALL	LCT
	MOVE	T,R		;ADDRESS INTO T
	CALL	LI1		;PRINT THE CONTENTS
PIZNAC:	LDB	T,[POINT 9,(P),8]	;GET OPCODE
	MOVE	T,PCPNTB(T)	;GET TABLE ENTRY
	TRNN	T,4		;PRINT EFF ADR?
	 JRST	PIZEA		;NOPE, WE ARE DONE
	CALL	LCT
	MOVE	T,(P)		;FOR EFFADR
	CALL	EFFADR
	 JRST	PIZFAI
	HRRZ	T,W1		;ADR MUST BE IN T FOR LI1
	CALL	LI1		;PRINT
PIZRET:	POP	P,T
	RET

PIZFAI:	MOVEI	T,"?"
	CALL	TOUT
	JRST	PIZRET

PIZEA:	MOVE	T,(P)		;EVEN THOUGH WE DON'T PRINT EA, MAYBE SHOW IT
	TLNN	T,37		;ANY AC OR INDIRECT BITS?
	 JRST	PIZRET		;NOPE, SO DONE
	CALL	LCT
	MOVEI	W1,[ASCIZ \E.A. _ \]
	CALL	TYPE
	MOVE	T,(P)		;FOR EFFADR
	CALL	EFFADR
	 JRST	PIZFAI
	HRRZ	T,W1		;ONLY WANT ADDRESS, NOT LEFT HALF BITS
	TRZ	F,CF1		;SWIPED FROM '_' CODE
	TRO	F,LF1
	PUSH	P,LWT
	CALL	CONSYM		;BUT DON'T DESTROY LWT
	POP	P,LWT
	JRST	PIZRET


PI8A:	CAIL	W,600		; IS THIS A TEST INSTRUCTION?
	CAILE	W,677
	JRST	PI9
	TRNE	W,10		; DIRECT OR SWAPPED?
	JRST	PI8		; YES, PRINT SYMBOLIC ADDRESS
	CALL	PADFLG		; TLXX OR TRXX, PRINT ADDRESS AS FLAGS
	JRST	PI7

PI8:	CALL	PAD
	JRST	PI7

PI9:	LDB	W,[POINT 13,LWT,12]
	ANDI	W,16007
	CAIL	W,16003		; OP GREATER THAN DATAO?
	CAIN	W,16005		; AND NOT CONI?
	JRST	PI8		; NO
	CALL	PADFLG
	JRST	PI7		; YES CONO, CONSZ AND CONSO PRINT BITS
HLFW:	HLRZ	T,LWT		;PRINT AS HALF WORDS
	JUMPE	T,HLFW1		;TYPE ONLY RIGHT ADR IF LEFT ADR=0
	TRO	F,NAF		;ALLOW NEGATIVE ADDRESSES
	CALL	PAD
	MOVSI	W1,(ASCII /,,/)
	CALL	TEXT2		;TYPE ,,
HLFW1:	HRRZ	T,LWT

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

PAD:	TLZE	T,(DDTINT)
	 JRST	PADINT		;INTERNAL TO NDDT
	ANDI	T,-1
	JRST	@AR		;PADSO OR PAD1

PADSO:	JUMPE	T,FP7B		;PRINT A ZERO
	CALL	LOOK
PADS1:	 RET
	JUMPGE	F,PADS3		;PRINT NUMBER OF NO SYMBOL FOUND
	MOVE	W2,1(W1)
	CAMG	T,SYMOFS		;MAXIMUM OFFSET TO PRINT
	 CAIGE	W2,60
	  JRST	PADS3
	MOVEM	T,TEM
	CALL	SPT0
PADS0A:	MOVEI	T,"+"
PADS1A:	CALL	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
;PRINT INTERNAL ADDRESS
PADINT:	MOVEI	TT,777777		;INITIAL DIFFERENCE = ./.
	MOVE	S,[INTTAB-INTEND,,INTTAB]
PADIN1:	HRRZ	R,0(S)
	SUBM	T,R
	JUMPL	R,PADIN0		;NEGATIVE IS NOT SMALLER THAN 0
	CAMLE	R,TT
	 JRST	PADIN0		;NOT A BETTER MATCH
	MOVEM	R,TT		;NEW DIFFERENCE
	HLRZ	W1,0(S)		;NAME POINTER
PADIN0:	AOBJN	S,PADIN1
PADIN2:	JUMPE	TT,PADIN3		;EXACT MATCH
	CAIL	T,FRSTIR		;LOWER THAN 1ST INTERNAL REGISTER
	 CAIL	T,LASTIR		;GREATER THAN LAST INTERNAL
	  JRST	ERR
	MOVEM	TT,TEM
	CALL	PADIN3
	JRST	PADS0A

PADIN3:	MOVEI	W1,0(W1)		;GET ASCIZ
	CALL	TYPE
	RET
; PRINT ADDRESS AS FLAGS

PADFLG:	PUSH	P,T		; SAVE ADDRESS
	MOVEI	W1,3		;COUNT BITS TO SEE IF MORE THAN 3
	MOVN	W2,T		;FIND RIGHTMOST ONE IN T
	TDZE	T,W2		;SKIP IF NO MORE
	SOJGE	W1,.-2		;STOP COUNTING IF MORE THAN 3
	JUMPL	W1,PADFL6		;GO TYPE NUMBER IF MORE THAN 3 BITS
	MOVEI	T,400000		; START WITH LEFT MOST BIT
PADFL1:	TDNN	T,(P)		; IS THIS BIT IN THE THING
	JRST	PADFL2		; NO, GO TO NEXT BIT
	CALL	LOOKE		; LOOK UP THIS BIT
	JRST	PADFL3		; EXACT MATCH FOUND AND PRINTED
	JRST	PADFL4

PADFL3:	MOVE	T,TEM
	ANDCAM	T,(P)		; REMOVE BIT FROM ADDRESS
	SKIPN	(P)		; ANY MORE TO BE OUTPUT?
	JRST	PADFL5		; NO
	MOVEI	T,"+"
	CALL	TOUT		; YES, TYPE !
PADFL4:	MOVE	T,TEM
PADFL2:	ASH	T,-1		; SHIFT TO NEXT BIT
	CAILE	T,10		;DONE BITS 18-31?
	JRST	PADFL1		;NO, GO DO NEXT BIT
PADFL6:	POP	P,T			; ELSE TYPE OUT THE REST AS A NUMBER
	JRST	TOC

PADFL5:	POP	P,T
	RET
INOUT:	MOVE	T,LWT
	TDC	T,[-1,,400000]	;IO INSTRUCTION OR NEG NUM
	TDCN	T,[-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
	CALL	OPTYPE
	CALL	TSPC
	MOVSI	T,077400
	AND	T,LWT
	JUMPE	T,PI4
	CALL	LOOK		;LOOK FOR DEVICE NUMBER
	JRST	PI3A
	MOVE	T,TEM
	LSH	T,-30
	CALL	TOC
	JRST	PI3A
;PRINT AS JSYS
; ONLY IF EXACT MATCH IS FOUND.
; IF NOT PRINTED, RETURNS TO PIN TO CALL OPTYPE TO
; GET THE INSTRUCTION PRINTED LIKE  JSYS 501
JSTYPE:	MOVEI	T,100
	MOVEM	T,TEM1		;SET MAX @ COUNTER
	MOVE	T,LWT
JSTYP0:	LDB	W1,[POINT 4,T,17]	;GET XR
	CAIE	W1,0		;NONE?
	 MOVE	W1,AC0(W1)	;NO. GET THE XR
	ADD	W1,T		;ADD IN XR
	TLNN	T,(@)
	 JRST	JSTYP1		;NO INDIRECT TO WORRY ABOUT
	HRRZ	R,W1
	SOSL	TEM1
	CALL	FETCH		;GET MEM(R) TO T
	 JRST	ERR		;CANNOT GET IT
	JRST	JSTYP0

JSTYP1:	HRRZM	W1,TEM1		;SAVE EFFECTIVE ADDRESS
	HRRZ	T,W1
	HRLI	T,(JSYS)		;CONSTRUCT A JSYS
	CALL	LOOK		;LOOK UP IN SYMTAB
	 RET			;FOUND, EXIT FROM PIN
	HRRZ	TT,TEM1		;JSYS NUMBER
	MOVE	T,TT
	IDIVI	TT,<JSYEND-JSYTAB>/2
	ASH	TT1,1
	MOVE	TT3,TT1		;END CHECK

	MOVEI	TT2,2
	HRRZ	W1,JSYTAB+1(TT1)
	CAMG	T,W1		;SEARCH FORWARD ?
	MOVNS	TT2		;NO.

PJSN:	ADD	TT1,TT2		;MOVE TO NEXT ENTRY
	SKIPGE	TT1		;OFF BOTTOM
	MOVEI	TT1,JSYEND-2-JSYTAB	;YES, RING TO TOP
	CAIL	TT1,JSYEND-JSYTAB	;AT TOP?
	MOVEI	TT1,0		;YES, RING TO BOTTOM
	HRRZ	W1,JSYTAB+1(TT1)
	CAMN	T,W1
	JRST	PRJSY		;FOUND
	CAME	TT1,TT3		;DONE ALL?
	JRST	PJSN		;NO
	JRST	PIN0		;CAN'T PRINT AS KNOWN JSYS

PRJSY:	MOVE	W1,JSYTAB(TT1)
	CALL	TEXT2		;PRINT NAME, EXIT FROM PIN
	JRST	LCT
; $M COMMAND -- SET SEARCH MASK
MASK:	TLNE	F,CCF		;HOW MANY $'S ?
	 JRST	ERR		;2
	MOVE	R,T
	MOVEI	T,MSK
	TRNE	F,Q2F		;ARGUMENT AFTER THE ESC
	 ADD	T,WRD2
	TLNN	F,QF
	 JRST	QUANIN		;INTERNAL REGISTER EXAMINATION SETUP
	MOVEM	R,(T)		;SET THE MASK
	JRST	RETX
; $W -- WORD EQUALITY SEARCH
WORD:	TLNE	F,QF			;ARG TYPED?
	 JRST	EFWRD			;YES, DO WORD SEARCH
	MOVEI	T,TRAPWD		;NO, EXAMINE $W REGISTER
	JRST	QUANIN

; $E -- EFFECTIVE ADDRESS SEARCH
EFFEC:	TLNE	F,CCF		;HOW MANY $'S ?
	JRST	ERR		;2
	TLO	F,TEMF
	HRRZ	T,T


EFWRD:	MOVEI	R,(<JUMPE T,0>-<JUMPN T,0>)

; $N -- WORD NON-EQUALTIY SEARCH (R IS 0)
NWORD:	ADDI	R,(<JUMPN T,0>)
	HRLM	R,SEAR2
	MOVEI	TT1,MSK		;LOOK AT MASK
	TRNE	F,Q2F
	 ADD	TT1,WRD2	;BUT IF $<N>N USE THAT MAST
	MOVE	TT1,(TT1)	;GET VALUE
	MOVEM	TT1,CURMSK	;AND SAVE IT
	INTON
	TLZN	F,QF		;QUANTITY TYPED IN?
	 JRST	ERR		;NO ARGUMENT
	SETCAM	T,WRD
	MOVE	T,ULIMIT		;WHAT TO USE IF SECOND ARG TYPED
	TLNE	F,SAF		;IF 2ND ARG...
	 TLO	F,QF		;FOOL SETUP
	CALL	SETUP		;1ST ADDR TO DEFV, LAST TO ULIMIT
	CALL	CRF
SEAR1:	CALL	FETCH		;OF R
	 JRST	SEAR2B
	TLNE	F,TEMF		;CHECK FOR EFFECTIVE ADDRESS SEARCH
	JRST	EFFEC0		;DO E.A. COMPARE, RETURN TO SEAR2X
	EQV	T,WRD
	AND	T,CURMSK

;GO TO SEAR3 IF A FIND HAS OCCURRED
SEAR2X:	XCT	SEAR2		;A JUMPE T,SEAR3 OR JUMPN T,SEAR3
SEAR2A:	AOS	R,DEFV		;GET NEXT LOCATION
	CAMG	R,ULIMIT		;END OF SEARCH?
	JRST	SEAR1		;NO, LOOK SOME MORE

;AT END OF SEARCH
SEARFN:	SETCMM	LWT		;COMPLEMENT BITS BACK AND STOP SEARCH
	SETZM	DEFV
	SETZM	ULIMIT
	JRST	DD1

SEAR2B:	MOVEI	R,777
	IORB	R,DEFV		;SKIP TO NEXT PAGE
	JRST	SEAR2A
;FOUND A MATCH,  R IS WHERE
SEAR3:	MOVE	R,DEFV
	CALL	FETCH
	 JRST	ERR
	TLZ	F,STF		;GET RID OF SUPPRESS TYPEOUT MODE
	MOVE	T,DEFV
	SETZM	PINFF		;DON'T PRINT EFF ADR OR AC
	CALL	LI1		;EXAMINE REGISTER
	CALL	CRF
	SETCMM	LWT
	SETCMM	TEM
	JRST	SEAR2A

;CALCULATE EFFECTIVE ADDRESS AND DO
;COMPARE FOR INSTRUCTION AT  R
EFFEC0:	MOVEI	W,20		;@ CHAIN DEPTH, MAX.
	MOVEM	W,TEM
EFFEC1:	MOVE	W,T
	LDB	R,[POINT 4,T,17]	;GET XR FIELD
	JUMPE	R,EFFEC2		;NO XR SPECIFIED, TRY FOR @
	CALL	FETCH		;THE XR
	 JRST	ERR
	ADD	T,W			;ADD IN THE XR

;T HAS THE INDEXED ADDRESS, SEE IF @
EFFEC2:	HRR	R,T
	TLNN	W,(@)		;INDIRECT BIT CHECK
	JRST	EFFEC3		;NONE, R HAS EFFECTIVE ADDR
	SOSE	TEM		;CHECK @ CHAIN LENGTH
	CALL	FETCH		;GET INDIRECT WORD
	 JRST	SEAR2A		;CAN'T GET IT => NO MATCH
	JRST	EFFEC1		;GO BACK AND TRY TO INDEX

;GOT IT. DO COMPARE ON ADDRESS
EFFEC3:	EQV	T,WRD
	ANDI	T,777777
	JRST	SEAR2X
;SETUP SEARCH LIMITS
;1ST ADDR (0) TO R AND DEFV, LAST TO ULIMIT
;USED BY SEARCHES (W,N,E) AND ZERO (Z)
SETUP:	TLNN	F,QF		;QUANTITY TYPED (2ND ARG)?
	MOVEI	T,777777		;NO, DEFAULT LAST ADDRESS
	HRRZM	T,ULIMIT		;SAVE TOP OF SEARCH/ZERO
	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
	RET			;YES, RETURN


;$$Z  ZERO MEMORY FROM ZLOW TO ULIMIT AND AC'S
ZERO:	TLNN	F,CCF
	JRST	ERR
	CALL	UNMAP		;FORGET ABOUT ANY MAPPED PAGE
	CALL	SETUP
ZERO0:	CAIL	R,700000
	CAIL	R,740000
	 JRST	ZERO2		;NOT ZERO'ING COMPATIBILITY
	MOVE	1,FORK
	PUSH	P,R
	SETZB	2,3
	SCVEC			;FLUSH PAT
	POP	P,R
ZERO2:	MOVE	T,WRD2		;0 (OR WHATEVER) TO STORE IN MEMORY
ZERO3:	CAMLE	R,ULIMIT		;ABOVE LIMITS?
	 JRST	DD1		;YES, STOP
	TRNN	R,777		;START OF PAGE?
	JRST	ZERO4		;YES, CHECK FOR EXISTENCE
ZERO33:	CALL	DEP		;DEPOSIT T AT USER LOC IN R
	 JRST	ZERO5		;WOULDN'T DEPOSIT
	AOJA	R,ZERO0

ZERO4:	JUMPN	T,ZERO33		;NOT REALLY ZEROING
	MOVE	TT,ULIMIT
	SUB	TT,R		;NUMBER OF WORDS LEFT TO ZERO
	CAIGE	TT,777		;LESS THAN A PAGE?
	JRST	ZERO33		;YES, ZERO THEM
ZERO5:	MOVE	TT,R		;R=2
	HRRZS	2
	LSH	2,-11
	HRL	2,FORK
	SETZ	3,			;WATCH OUT FOR KL20
	SETOM	1
	PMAP
	MOVE	R,TT
	IORI	R,777		;TOP OF THIS PAGE
	AOJA	R,ZERO0		;DO NEXT PAGE

BITO:	MOVEI	R,BITT		;BYTE OUTPUT SUBROUTINE
	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	BASE1

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
	CALL	TOCA
	CAIE	AR,TOC
	CALL	PIN
	SOSG	SVBT2
	JRST	BITT4
	MOVEI	T,","
	CALL	TOUT
	MOVE	T+1,SVBT3
	JRST	BITT2

BITT4:	POP	P,LWT
	RET
;NUMERIC OUTPUT SUBROUTINE
FTOC:
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
	CALL	TOC0		;TYPE LEFT HALF
	MOVSI	W1,(ASCII /,,/)
	CALL	TEXT2		;TYPE ,,
TOCSX:	XCT	TOCS		;A MOVEI T,.-. TO 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
	CALL	TOC0
	HLRZ	T,0(P)
	cail	t, ^d10
	 addi	t, "A"-"0"-^d10
	ADDI	T,"0"
	JRST	TOUT

TOC4:	MOVM	A,T		;TYPE AS SIGNED DECIMAL INTEGER
	JUMPGE	T,TOC5
	MOVEI	T,"-"
	CALL	TOUT
TOC5:	CALL	FP7		;DECIMAL PRINT ROUTINE
TOC6:	MOVEI	T,"."
	JRST	TOUT
;SYMBOL OUTPUT SUBROUTINE

SPT0:	HRRZM	W1,SPSAV		;SAVE POINTER TO TYPED SYM
SPT:	MOVE	T,SVFB
	JUMPE	T,SPT1W
	CAMN	T,BLOCK
	 JRST	SPT1W
	PUSH	P,W1
	LDB	T,[POINT 32,(T),35]
	CALL	SPT1
	MOVEI	T,"&"
	CALL	TOUT
	POP	P,W1
SPT1W:	LDB	T,[POINT 32,(W1),35]	;GET SYMBOL


;RADIX 50 SYMBOL PRINT
SPT1:	IDIVI	T,50
	HRLM	W1,0(P)
	JUMPE	T,SPT2
	CALL	SPT1
SPT2:	HLRZ	T,0(P)
	JUMPE	T,CPOPJ		;FLUSH NULL CHARACTERS
	ADDI	T,260-1
	CAILE	T,271
	 ADDI	T,301-272
	CAILE	T,332
	 SUBI	T,334-244
	CAIN	T,243
SPT3:	 MOVEI	T,256
	JRST	TOUT

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

TFLOT:	MOVE	A,T
	JUMPG	A, TFLOT1
	JUMPE	A,FP1A
	MOVNS	A
	MOVEI	T,"-"
	CALL	TOUT
	TLZE	A,400000
	JRST	FP1A
TFLOT1:	TLNN	A, 400
	JRST	TOC5		;IF UNNORMALIZED, TYPE AS DECIMAL INTEGER

FP1:	MOVEI	S,0
	CAMGE	A,FT01
	JRST	FP4
	CAML	A,FT8
	AOJA	S,FP4
FP1A:	MOVEI	W,0

FP3:	MULI	A,400
	ASHC	S,-243(A)
	SETZM	TEM1		;INIT 8 DIGIT COUNTER
	SKIPE	A,S		;DON'T TYPE A LEADING 0
	CALL	FP7		;PRINT INTEGER PART OF 8 DIGITS
	CALL	TOC6		;PRINT DECIMAL POINT
	MOVNI	A,10
	ADD	A,TEM1
	MOVE	W1,W
FP3A:	MOVE	T,W1
	MULI	T,12
	CALL	FP7B
	SKIPE,W1
	AOJL	A,FP3A
	RET

FP4:	MOVNI	W,6
	MOVEI	W2,0
FP4A:	ASH	W2,1
	XCT,FCP(S)
	JRST	FP4B
	FMPR	A,@FCP+1(S)
	IORI	W2,1
FP4B:	AOJN	W,FP4A
	PUSH	P,W2		;SAVE EXPONENT
	PUSH	P,FSGN(S)		;SAVE "E+" OR "E-"
	CALL	FP3		;PRINT OUT FFF.FFF PART OF NUMBER
	POP	P,W1		;GET "E+" OR "E-" BACK
	CALL	TEXT
	POP	P,A			;GET EXPONENT BACK
FP7:	IDIVI	A,12		;DECIMAL OUTPUT SUBROUTINE
	AOS,TEM1
	HRLM	S,(P)
	JUMPE	A,FP7A1
	CALL	FP7

FP7A1:	HLRZ	T,(P)
FP7B:	ADDI	T,260
	JRST	TOUT

FCP:	CAMLE	A, FT0(W)
	CAMGE	A, FT(W)
	Z	FT0(W)

;8,9-BIT TEXT TYPERS
TEXT8:	SKIPA	1,[8]		;8 AND 9 BIT TYPERS DONT GUESS ABOUT
TEXT9:	MOVEI	1,9		;LEFT BYTE
	MOVE	W1,T
	PUSH	P,[-4]
	JRST	ALLTXT


TEXTT:	MOVE	W1,T		;MAKE IT <ALT><NUM><QUOTE>FOOBAR<ALT>
	MOVEI	T,"$"
	CALL	TOUT
	MOVEI	T,"0"
	TRZE	W1,1
	 MOVEI	T,"1"
	CALL	TOUT
	MOVEI	T,42
	CALL	TOUT
	SETZ	2,
	PUSH	P,[-5]
	JRST	TEXTXX

TEXT:	SETO	2,
	PUSH	P,[-1000]
TEXTX:	TLNN	W1,774000		;LEFT JUSTIFIED UNLESS LEFT CHAR IS NULL
	LSH	W1,35
	JRST	TEXTXX

TEXT2:	SETO	2,
	PUSH	P,[-1000]

TEXTXX:	MOVEI	1,7		;7-BIT BYTES IN W1
ALLTXT:	PUSH	P,1		;TEXT IN W1. BYTESIZE IN 1
ALLTX1:	MOVEI	T,0
	LSHC	T,@0(P)
	SKIPN	T
	 JRST	[MOVEI T,"^"
	       CALL	TOUT
	       MOVEI	T,"@"
	       JRST	.+1]
	CAIG	T,26
	 JRST	[SKIPE 2
		  JRST .+1
		 MOVE TT1,T
		 MOVEI T,"^"
		 CALL TOUT
		 MOVEI T,"A"-1(TT1)
		 JRST .+1]
	CALL	TOUT
	AOSE	-1(P)		;COUNTER
 	 JUMPN W1,ALLTX1
	MOVEI	T,"$"
	SKIPN	2
	 CALL	TOUT
	POP	P,1
	POP	P,1
	RET


;STRING TYPER, ANY LENGTH
;W1 HAS BYTE POINTER
TYPE:	TLNN	W1, -1
	 HRLI	W1, <(POINT 7,)>
	EXCH	W1, 1
	PSOUT
	EXCH	W1, 1
	RET
;TYPE CARRIAGE RETURN
CRN:	MOVEI	T,15
	SETZM	HPOS
	JRST	TOUT

;TYPE NEW LINE
CRF:	CALL	CRN
	MOVEI	T,12
	JRST	TOUT

;TYPE LOWER CASE AND TAB, FROM PDP-1!!!
LCT:	CALL	TSPC
	CALL	TSPC

;TYPE SPACE
TSPC:	MOVEI	T," "		;SPACE

;CHARACTER OUTPUT FROM AC1
TOUT:	EXCH	1,T
	TYO
	EXCH	1,T
	AOS	HPOS
	RET

;ALIGNMENT (MAYBE)
;IN T, THE NUMBER YOU WANT
TALIGN:	CAMG	T,HPOS
	 POPJ	P,	 
	PUSH	P,T
	MOVEI	T," "
	CALL	TOUT
	POP	P,T
	JRST	TALIGN
TIN:	SKIPN	T,BBC		;ANY BUFFER-BACK CHARACTER?
	 JRST	TINZ		;NOPE, NORMAL PROCESSING
	SETZM	BBC		;CLEAR THE CHARACTER
	RET			;AND RETURN
TINZ:	SKIPE	STRING		; ARE WE INPUTTING FROM A STRING?
	 JRST	TINST
TIN0:	TDNE	F,[CF,,SEMIF]	;NEED TO SEE EACH CHR AS IT COMES IN?
	 JRST	TIN6		;YES
	MOVE	T,STRIP		;IN PTR
	CAME	T,STROP		;OUT PTR
	 JRST	TIN4		;NON-EMPTY BUFFER
TIN1:	MOVE	T,[POINT 7,STRBUF-1,34]
	MOVEM	T,STRIP
	MOVEM	T,STROP
IFE	KL20F,<
TIN2:	CALL	GETC
	CAIE	T,177
	CAIN	T,"A"-100
	 JRST	TINCA		;^A
	CAIN	T,"V"-100
	 CALL	TINCV		;^V
	IDPB	T,STRIP		;STORE IT IN BUF
	MOVE	T,STRIP
	CAMN	T,[POINT 7,STRBUF+STRBFL-1,34]
	 JRST	ERR		;BUFFER FULL

TIN3:	LDB	T,STRIP		;GET BACK THE CHR
	CAIL	T,"A"
	 CAILE	T,"Z"
	  CAIA
	   JRST	TIN2		;UPPERCASE LETTER, KEEP GOING
	CAIL	T,"A"+40
	 CAILE	T,"Z"+40
	  CAIA
	   JRST	TIN2		;LOWERCASE LETTER
	CAIL	T,"0"
	 CAILE	T,"9"
	  CAIA
	   JRST	TIN2
TIN4:	ILDB	T,STROP		;RETURN NEXT CHR FROM BUFFER
TIN5:	CAIN	T,37		;TENEX EOL CHARACTER
	 MOVEI	T,15		;EOL BECOMES CR ON WAY OUT
	RET

TIN6:	CALL	GETC
	JRST	TIN5

;CONTROL V (QUOTE NEXT CHARACTER)
TINCV:	TYI			;CHARACTER INTO 1
	MOVE	T,1
	CAIE	T,33
	 RET
	MOVEI	T,"$"
	CALL	TOUT		;ECHO $ FOR ALTMODE
	MOVEI	T,33
	RET

;CONTROL A (DELETE PREVIOUS CHARACTER)
TINCA:	MOVE	T,STRIP
	CAMN	T,STROP
	 JRST	WRONG		;BUFFER EMPTY

TINCA0:	
IFN DELCHF,<
	MOVEI	1, 101
	DELCH
	 JRST	.+4
	 JRST	.+3
	 JRST	TINCA2
	 JFCL
>
TINCA1:	MOVEI	T,"\"
	CALL	TOUT
	LDB	T,STRIP
	CALL	TOUT
TINCA2:	SOS	STRIP		;UNDEX BYTE PTR
	REPEAT	4,<IBP STRIP>
	JRST	TIN2

>	; Kl20f
IFN	KL20F,<
	movem	t, textib+.rddbp	; Set up byte pointer
	movei	t, strbfl*5		; Buffer length
	movem	t, textib+.rddbc	; Set up count

tin2:	movei	1, textib
	texti				; Get the poop
	 jrst	err			; Lossage
	move	t, textib+.rddbp	; Get updated pointer
	camn	t, [point 7, strbuf-1, 34]
	 jrst	wrong			; Nothing new
	ldb	1, t			; Get char that made it wake up
	camn	1, escchr		; User's escape?
	 jrst	wrong			; Yes
	movem	t, strip		; Update pointer
	caie	1, 33			; ESC?
	 jrst	tin4			; Nope
	movei	t, "$"
	call	tout			; Echo as $

tin4:	ildb	t, strop		; Get first char
	ret

tin6:	jrst	getc			; Get char


textib:	7
	rd%rnd!rd%jfn!rd%sui
	.priin,,.priout
	point	7, strbuf
	strbfl*5
	0
	0
	textim

; Break character set for texti
textim:	-1			; All controls
	747764,,001760		; Not on $,%,. or 0-9
	400000,,000760		; No letters
	400000,,000760		; Or lowercase letters

>	; KL20F

ttpeek:	move	t, strop	; opt buffer pointer
	camn	t, strip	; Buffer empty?
	 tdza	t, t		; Return 0
	ildb	t, t		; Else get char
	ret

;INPUT FROM STRING AT BPT
TINST:	ILDB	T,STRING
	JUMPN	T,TINST1		;NOT END OF STRING
	SETZM	STRING		;SAY NO MORE
	JRST	TIN0		;GET FROM TTY

TINST1:	CAIE	T,33
	CALL	TOUT		;SAY WHAT WE READ
	JRST	GOTC


;GET CHARACTER AND CHECK FOR ESCAPE CHR
GETC:	TYI			;INPUT MAY BE FROM FILE (REDIRECT)
	MOVE	T,1
GOTC:	CAIE	T,33
	 JRST	GETC2
	MOVEI	T,"$"
	CALL	TOUT
	MOVEI	T,33
GETC2:	CAIE	T,"U"-100
	CAMN	T,ESCCHR
	 JRST	WRONG
	SKIPE	CRFLAG		;WAS LAST CHAR A CR?
	CAIE	T,12		;AND THIS ONE AN LF?
	 JRST	GETC3		;NO.
	SETZM	CRFLAG		;YES.  FORGET ABOUT THE PAIR
	JRST	GETC		;AND TRY AGAIN.

GETC3:	SETZM	CRFLAG
	CAIN	T,15
	SETOM	CRFLAG
	RET
;DEPOSIT INTO MEMORY SUBROUTINE
;R HAS ADDRESS, T HAS VALUE
;LH OF R INDICATES IF IT IS INTERNAL TO DDT -- LIKE $3B, ETC.

DEP:	TLNE	R,(DDTINT)
	 JRST	DEPINT		;DEPOSIT IN INTERNAL REGISTER
	TRNN	R,777760
	 JRST	DEPAC		;DEPOSIT IN AC
	PUSH	P,R		;SAVED FOR REST OF DDT
	CALL	UNMAP
	JSP	TT1,CHKADR		;CHECK ADDRESS, MAP INTO UCORE
	JUMPE	TT,DEP2		;IF NO PAGE, OK TO STORE
	TLNE	TT,(1B3+1B9)	;STORE OK IF WRITE OR WRITE-COPY
	 JRST	DEP2
	HRRZ	1,(P)		; Try to unprotect page
	LSH	1,-^D9
	HRL	1,FORK
	MOVSI	2,(PA%RD+PA%WT+PA%EX+PA%CPY)
	SPACS
	 ERJMP [POP	P,R	; Failed
		RET]
	PUSH 	P,T
	PUSH 	P,1
	CALL 	LCT		; Inform the user
	POP	P,T
	HRRZI	T,(T)
	CALL	TOC
	PUSH	P,W1
	MOVE	W1,[POINT 7,[ASCIZ /$U/]]
	CALL	TYPE
	POP	P,W1
	POP	P,T
	MOVE	R,(P)
	JSP 	TT1,CHKADR	; Try again

DEP2:	MOVEM	T,UCORE(R)
	POP	P,R			;USER'S ADDRESS
	JRST	CPOPJ1		;SKIP RETURN

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

DEPINT:	MOVEI	TT,PC
	CAIE	TT,0(R)
	 JRST	DEPIN4		;NOT CHANGING PC
DEPIN1:	HRRZ	TT,PC		;GET ADDRESS PART
	CAIE	TT,0(T)		;CHANGING TO SOMETHING DIFFERENT?
	 SETZM	BPTFLG		;YES, DONT RESUME AT CURRENT BREAKPT.
	CAIE	TT,0(T)
	 JRST	DEPIN3		;TURN ON USERMODE, TO GET SFORK

DEPIN2:	MOVSI	TT,(1B5)
	TDNE	TT,PC		;COPY USERMODE BIT FROM OLD PC WORD
DEPIN3:	 TLO	T,(1B5)
	MOVEM	T,REALPC
	JRST	DEPIN5

DEPIN4:	MOVEI	TT,USRPSI		;SEE IF TRYING TO CHANGE REQUESTS.
	CAIN	TT,0(R)
	 RET			;CAN'T DO THAT.
DEPIN5:	MOVEM	T,0(R)		;STORE INTO INTERNAL REGISTER
	JRST	CPOPJ1		;SKIP RETURN
;FETCH FROM MEMORY SUBROUTINE
;R HAS ADDRESS. LH INDICATES INTERNAL OR NOT

FETCH:	TLNE	R,(DDTINT)
	 JRST	FETINT		;INTERNAL REGISTER READ
	TRNN	R,777760		;IN AC?
	 JRST	FETAC		;YES
	PUSH	P,R		;SAVE USER'S ADDR
	JSP	TT1,CHKADR
	TLNE	TT,(1B2)		;READ ACCESS?
	 JRST	.+3		;YES
	  POP	P,R
	  RET
	MOVE	T,UCORE(R)	
	 ERJMP 	[POP	P,R	; Page may not exist
		 RET ]
	POP	P,R			;GET USER'S ADDR BACK
	JRST	CPOPJ1		;SKIP RETURN ONLY FOR LEGAL ADDRESS

FETAC:	MOVE	T,AC0(R)
	JRST	CPOPJ1

FETINT:	MOVE	T,0(R)		;FROM INTERNAL REGISTER IN DDT
	JRST	CPOPJ1

SETFRK:	PUSH	P,2
	PUSH	P,1
	CALL	UNMAP
	RFSTS
	TLC	1,-1
	TLNN	1,-1
	 JRST	FCHK1
	CALL	SETUSR
	POP	P,FORK
	CALL	GETUSR
	MOVE	1,FORK
	POP	P,2
	JRST	CPOPJ1

FCHK1:	POP	P,1
	POP	P,2
	RET
;CHECK USER'S ADDRESS IN R (=2)
;BRING IT INTO UCORE IF NOT ALREADY THERE
CHKADR:	PUSH	P,1
	PUSH	P,3
	PUSH	P,2
	MOVEI	1,0(R)	;DESIRED ADDRESS
	LSH	1,-9	;DESIRED PAGE
	HRL	1,FORK	;FORM FORK,,PAGE
	MOVE	2,IDPACS	;ACCESS TO CURRENTLY MAPPED PAGE
	TLNE	2,(1B5)	;DOES NOT EXIST, OR
	CAME	1,LASTPG	;DIFFERENT PAGE?
	 JRST	CHKA2	;YES

;PAGE IS ALREADY MAPPED.  MAKE R HAVE AN OFFSET INTO UCORE
CHKA1:	POP	P,R		;ORIGINAL ADDRESS REQUESTED
	ANDI	R,777	;CONVERT TO OFFSET INTO MAPPED PAGE
	HLLZ	TT,IDPACS	;TT IS WHERE ACCESS INFO IS RETURNED
	POP	P,3
	POP	P,1
	JRST	0(TT1)

;MAP USER'S PAGE INTO NDDT'S UCORE
CHKA2:
CHKA3:	MOVEM	1,LASTPG	;SAVE FOR NEXT TIME
CHKA3A:	MOVE	3,1	;SAVE FOR CHKA3B
	RPACS		;GET ITS REAL ACCESS
	HLLM	2,IDPACS	;SAVE ACCESS
	TLNN	2,(1B6)	;INDIRECT?
	 JRST	CHKA3B	;NO, FOUND
	RMAP		; YES, CHASE DOWN THE CHAIN
	CAMN	1,[-1]	;INDIRECT TO NOWHERE?
	 JRST	ERR	;YES.  AVOID AWFUL DEATH
	JUMPL	1,CHKA3A	;NO. IF TO FORK, CHASE IT.

CHKA3B:	MOVE	1,3
	MOVEM	1,LASFPG	; SAVE FOR LATER
CHKA4:	MOVE	2,[400000,,UCORE/1000]	;NDDT'S FORK,,PAGE
	MOVSI	3,(1B2!1B3!1B4)	;R,W,X
	PMAP
	JRST	CHKA1

;UNMAP THE PAGE CURRENTLY MAPPED INTO UCORE
UNMAP:	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	SETZB	3,IDPACS	;CLEAR BIT 5, AND 3 FOR KL20
	SETOB	1,LASTPG	;IMPOSSIBLE PAGE NUMBER
	MOVE	2,[400000,,UCORE/1000]
	PMAP		;AWAY!
	POP	P,3
	POP	P,2
	POP	P,1
	RET
;TABLE SAYING WHAT TO DO ABOUT EACH INSN VIS-A-VIS OPENING ITS AC
;AND MEMORY ADDRESS. EACH OP CODE HAS A 4-BIT BYTE.
;1 BIT => OPEN THE AC.
;2 BIT => OPEN THE AC UNLESS THE AC FIELD IS 0.
;4 BIT => OPEN THE MEMORY LOCATION.

;HANDLE AN INSTRUCTION LIKE "AND" WHICH HAS DIRECT, IMMED., MEMORY AND BOTH.
DEFINE AIMB (BITS)<EXP 5, 1+BITS, 5, 5>
PCPNTB:
REPEAT 40,<EXP 0>;USER UUOS: OPEN BOTH.
REPEAT 40,<EXP 0>;UUO'S MEDIATED BY SYSTEM: 50 THROUGH 77.
REPEAT 4,<EXP 0>
	0	;104 JSYS
REPEAT 23,<EXP 5>;104-127 UNUSED.
	5	;UFA		130
	5	;DFN
	1	;FSC
	4	;IBP
	5	;ILDB
	5	;LDB
	5	;IDPB
	5	;DPB		137
REPEAT 40,<EXP 5>;FLOATING POINT	140-177
REPEAT 4,<	;REPEAT OVER MOVE, MOVS, MOVN, MOVM	200-217
	5	;TO AC.
	1	;IMMEDIATE
	5	;TO MEMORY.
	6	;TO SELF.
>
REPEAT 4,<	;REPEAT OVER IMUL, MUL, IDIV, DIV	220-237
	AIMB	0	;TO AC, IMMED, TO MEM, TO BOTH.
>
REPEAT 10,<EXP 1>;SHIFTS, AND JFFO	240-247
	5	;EXCH			250
	1	;BLT
	1	;AOBJP
	1	;AOBJN
	0	;JRST
	0	;JFCL
	4	;XCT
	5	;UNUSED
	0	;PUSHJ			260
	4	;PUSH
	4	;POP
	0	;POPJ
	0	;JSR
	1	;JSP
	1	;JSA
	1	;JRA
	AIMB	0	;ADD			;270
	AIMB	0	;SUB
REPEAT 10,<EXP 1>;CAI...		300-307
REPEAT 10,<EXP 5>;CAM...		310-317
REPEAT 3,<	;REPEAT OVER JUMP,SKIP; AOJ,AOS; SOJ,SOS.  320-377
REPEAT 10,<EXP 1>;JUMP, AOJ, SOJ.
REPEAT 10,<EXP 6>;SKIP, AOS, SOS.
>
	1	;SETZ		400
	1	;SETZI
	4	;SETZM
	5	;SETZB
	AIMB	0	;AND		404
	AIMB	0	;ANDCA		410
	AIMB	0	;SETM		414
	AIMB	0	;ANDCM		420
	1	;SETA		424
	1	;SETAI
	5	;SETAM
	5	;SETAB
	AIMB	0	;XOR		430
	AIMB	0	;OR		434
	AIMB	0	;ANDCB		440
	AIMB	0	;EQV		444
	1	;SETCA		450
	1	;SETCAI
	5	;SETCAM
	5	;SETCAB
	AIMB	;ORCA		454
	5	;SETCM		460
	11	;SETCMI
	4	;SETCMM
	5	;SETCMB
	AIMB	0	;ORCM	 	464
	AIMB	0	;ORCB		470
	1	;SETO		474
	1	;SETOI
	4	;SETOM
	5	;SETOB
REPEAT 10,<	;REPEAT OVER HLL, HRL, HLLZ, ..., HRLE.	500-537
	5	;TO AC.
	1	;IMMEDIATE.
	5	;TO MEM.
	6	;TO SELF.
>
REPEAT 10,<	;REPEAT OVER HRR, HLR, HRRZ, ..., HLRE.	540-577
	5	;TO AC.
	1	;IMMEDIATE.
	5	;TO MEM.
	6	;TO SELF.
>
REPEAT 4,<	;REPEAT OVER TRN, TRZ, TRC, TRO.	600-677.
REPEAT 10,<EXP 1>;THE TR AND TL VARIANTS.
REPEAT 10,<EXP 5>;THE TD AND TS VARIANTS.
>
REPEAT 100,<EXP 4>;I-O INSTRUCTIONS HAVE NO AC FIELD.
;TYPE OP CODE OF INSTR IN LWT
;OP CODE EVALUATER.  TXT, TXT+1 HAVE 6 OR LESS ASCII
; CHARACTERS PACKED WITH A 7 BIT IDPB.  JSYS TABLE HAS SAME
; FORMAT WITH THE JSYS NUMBER IN THE RIGHT 9 BITS OF THE 2ND WORD.
OPEVAL:	MOVE	S,[<JSYTAB-JSYEND>,,0]
OPTRY:	MOVE	T,JSYTAB+0(S)	;FIRST WORD OF THIS ENTRY
	HLLZ	TT,JSYTAB+1(S)	;SECOND
	CAMN	T,TXT
	CAME	TT,TXT+1
	JRST	OPENXT
	HRRZ	T,JSYTAB+1(S)	;FOUND. GET NUMBER
	HRLI	T,(JSYS 0)		;MAKE INTO JSYS
	JRST	CPOPJ1		;SKIP RETURN

OPENXT:	AOBJP	S,.+1
	AOBJN	S,OPTRY		;TRY NEXT ENTRY IN JSYSTABLE


OLDOEV:	MOVEI	T,0		;NOT A JSYS SO DO USUAL OP EVAL
	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,[POINT 7,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 WITHOUT COUNTING
	SUBI	T,40
	JUMPE	T,DECX		;TRANSFER ON ASTOP CODE
	JUMPG	T,DC2
	DPB	T,[340500,,PNTR]	;SETUP R ON A DISPATCH BYTE
	TRZ	T,-4
	AOS	T
	DPB	T,[300600,,PNTR]
	TRNN	F,OUTF
	JRST	DC6		;FOR OPEVAL ONLY
	LDB	R,PNTR		;GET # BYTES TO SKIP OVER
	JRST	DC1

DC2:	HRREI	T,-33(T)
	JUMPL	T,DECT		;TYPE OUT A LETTER
	jumpg	t, dc3			; Byte .ge. 74?
	ildb	t, w2
	movei	t, 1000-74*2+1(t)	; Add in extension
dc3:	MOVEI	W1,FIR.-1(T)	;BYTE IS A TRANSFER
	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
	RET			;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
	RET			;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)
	CALL	TOUT		;OUTPUT A LETTER
	SETZM	SPSAV		;SO $D WONT TRY TO DELETE OP CODES
	JRST	DC1
	SUBTTL	CONTROL-T INTERRUPT HANDLER

CT.PSI:	PUSH	P,TEM
	PUSH	P,TEM1
	PUSH	P,SVFB
	PUSH	P,SVTB
	PUSH	P,SPSAV
	PUSH	P,BLVL
	ADD	P,[20,,20]
	JUMPGE	P,CT.PSY
	MOVEM	0,-17(P)
	HRLI	0,1
	HRRI	0,-16(P)
	BLT	0,0(P)

CT.PS1:	MOVEI	1,-1		;CTY:
	RFCOC
	PUSH	P,2
	PUSH	P,3
	MOVE	2,TTYCC2
	MOVE	3,TTYCC3
	SFCOC			;SETUP TTY FOR NDDT

CT.PS2:	CALL	CRF
	MOVE	1,FORK		;DO CURRENT FORK
	CALL	FSTAT
IFN gpldf,<	CALL GRPLOD>	; Group lodav, if it exists
	CALL	USED		;RETURNS DELTA CPU AND CONSOLE IN 1,2
	CALL	VIEW
	CALL	CRF

CT.PS9:	POP	P,3
	POP	P,2
	MOVEI	1,-1
	SFCOC

CT.PSX:	HRLI	0,-16(P)
	HRRI	0,1
	BLT	0,17
	MOVE	0,-17(P)
CT.PSY:	SUB	P,[20,,20]
	POP	P,BLVL
	POP	P,SPSAV
	POP	P,SVTB
	POP	P,SVFB
	POP	P,TEM1
	POP	P,TEM
	DEBRK
;DO FORK STATUS FOR FORK HANDLE IN 1

FSTAT:	RFSTS
IFN KL20F,<erjmp	fstatd>
	HLRZ	3,1
	CAIN	3,-1
	 JRST	FSTATD
	PUSH	P,2		;SAVE THE PC FOR LATER

FSTAT1:	TRZ	3,(1B0)		;FROZEN BIT
	CAIN	3,6
	 JRST	FSTAT2
	CAIE	3,2
	CAIN	3,3
FSTAT2:	TLZ	1,(1B0)
	MOVE	W1,[POINT 7,[ASCIZ /Interrupted from /]]
	TLNE	1,(1B0)
	 CALL	TYPE

FSTAT3:	MOVSI	W1,(POINT 7,)
	HRR	W1,[[ASCIZ /Running/]
		[ASCIZ /IO wait/]
		[ASCIZ /Halt/]
		[ASCIZ /Halt: /]
		[ASCIZ /Fork wait/]
		[ASCIZ /Sleep/]
		[ASCIZ /JSYS trap/]
		[ASCIZ /Address break/]
		[ASCIZ /TTY wait/]](3)
	CALL	TYPE
	MOVE	1,WHY
	MOVE	W1,MSG(1)
	CAIN	3,3
	 CALL	TEXT2

FSTAT4:	MOVE	W1,[ASCIZ / at /]
	CALL	TEXT
	POP	P,T			;THE PC
	MOVEI	T,0(T)		;ONLY THE PC BITS!
	CALL	PAD
	RET


FSTATD:	MOVE	W1,[POINT 7,[ASCIZ /Fork disappeared/]]
	CALL	TYPE
	RET
;TYPE THE LOAD AVERAGE

IFN gpldf,<
GRPLOD:	MOVNI	1,1
	GPLD
	 RET
	PUSH	P,2
	CALL	LCT		;PRINT TAB
	MOVE	W1,[ASCIZ /  GL=/]
	CALL	TEXT
	MOVEI	1,-1
	POP	P,2
	MOVE	3,[00B1!00B3!1B4!1B6!00B8!1B11!04B17!04B23!02B29]
	FLOUT
	 JFCL
	RET>



;TYPE TIME USED ETC SINCE LAST RESET
; RETURNS  DELTA CPU TIME IN 1 AND DELTA CONSOLE TIME IN 2

USED:	CALL	LCT
	MOVNI	1,5
	RUNTM
	SUB	1,TIMUSD
	PUSH	P,1		;CPU
	PUSH	P,2		;TICK/SEC
	SUB	3,TIMCON
	PUSH	P,3		;CONSOLE

USED1:	MOVE	W1,[ASCIZ /used /]
	CALL	TEXT
	MOVE	T,-2(P)
	MOVE	TT,-1(P)
	CALL	TIMPRT

USED3:	MOVE	W1,[ASCIZ / in /]
	CALL	TEXT
	MOVE	T,0(P)
	MOVE	TT,-1(P)
	CALL	TIMPRT

USEDX:	POP	P,2
	SUB	P,[1,,1]
	POP	P,1
	RET

;TIME PRINTER

;	T:	TIME TO BE PRINTED IN SECONDS
;	TT:	NUMBER OF TICKS PER SECOND

TIMPRT:	PUSH	P,T
	PUSH	P,TT
	IDIVI	T,0(TT)		;GET SECONDS
	PUSH	P,T+1
	CALL	TOC4		;DECIMAL PRINT OF T, WITH "."

TIMPR1:	MOVE	1,-1(P)
	IDIVI	1,^D10		;TICKS PER 1/10 TH OF A SECOND
	MOVE	T,0(P)		;FRACTION OF SEC IN TICKS
	IDIVI	T,0(1)		;FIND OUT HOW MANY TENTHS
	ADDI	T,"0"		;ASCIIFICATE
	CALL	TOUT
	SUB	P,[3,,3]
	RET
;PRINT THE CELL TO BE VIEWED (SET BY ;V)

VIEW:	SKIPGE	R,VADDR		;IS THERE ANYTHING?
	 RET			;NO. WE ARE DONE
	HRRZS	R
	CALL	FETCH		;MEM(R) TO T
	 RET			;CAN'T SO FORGET IT
	PUSH	P,T
	CALL	LCT		;TYPE A TAB
	HRRZ	T,VADDR
	CALL	PAD		;PRINT THE ADDRESS
	MOVEI	T,"/"
	CALL	TOUT
	CALL	LCT		;TYPE A TAB
	POP	P,T
	SETZM	PINFF		;NEVER WANT LONG INSTRUCTION PRINTOUT
	JRST	CONSYM		;TYPE AS CONSTANT OR SYMBOLIC
;READ-ONLY AREA
RO:
;INTERNAL REGISTER MAP
;LH HAS POINTER TO TEXT FOR NAME
;RH HAS POINTER TO VALUE
DEFINE	INTDIS	(X) <
	$'X'B+6,,$'X'B>

	QZ==1
	RADIX	10
INTTAB:	REPEAT	NBP,<
	INTDIS	\QZ
	QZ==QZ+1>
	RADIX	8
	[ASCIZ /$X/],,XRG
	[ASCIZ /$G/],,PC
	[ASCIZ /$W/],,TRAPWD
	[ASCIZ /UUO/],,UUOL
	[ASCIZ /$M/],,MSK
	[ASCIZ /$1M/],,MSK+1
	[ASCIZ /$2M/],,MSK+2
	[ASCIZ /$3M/],,MSK+3
	[ASCIZ /$4M/],,MSK+4
	[ASCIZ /$5M/],,MSK+5
	[ASCIZ /6M/],,MSK+6
	[ASCIZ /7M/],,MSK+7
	[ASCIZ /$I/],,USRPSI
	[ASCIZ /;.SYMOFS/],,SYMOFS
	[ASCIZ /;.PC/],,PC
INTEND:

INSYMB:
	[SIXBIT /SYMOFS/],,SYMOFS
	[SIXBIT /PC/],,PC
INSYME:

	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
BDISP:	POINT	12,DISP(R),11
	POINT	12,DISP(R),23
	POINT	12,DISP(R),35


DEFINE D (Z1,Z2,Z3)<
IFG <Z1-DDT-7777>,<PRINTX Z1 TOO FAR FROM DDT>
IFG <Z2-DDT-7777>,<PRINTX Z2 TOO FAR FROM DDT>
IFG <Z3-DDT-7777>,<PRINTX Z3 TOO FAR FROM DDT>
<Z1-DDT>_30+<Z2-DDT>_14+Z3-DDT>
	;THIS MACRO PACKS 3 ADDRESSES INTO ONE WORD
	; EACH ADR IS 12 BITS, RELATIVE TO DDT

DISP:	
D ERR,ERR,ERR		;-    -    -
D ERR,ERR,ERR		;-    -    -
D ERR,ERR,VARRW		;-    -    BACKSPACE(^H)
D TAB,LINEF,ERR		;TAB <LF>  -
D CTRLL,CARR,CTRLN	;^L  <CR>  ^N
D ERR,ERR,ERR		;-    -    -
D ERR,ERR,ERR		;-    -    -
D ERR,ERR,SUPTYO	;-    -    ^W
D ERR,ERR,ERR		;-    -    -
D CONTROL,NPTCH,NPTCH2	;ESC  -    -
D ERR,ERR,SPACE		;-    -   SPACE
D DIVD,TEXI,CHRI	;!    "    #
D DOLLAR,PERC,SETBLK	;$    %    &
D SIXI,LPRN,RPRN	;'    (    )
D MULT,PLUS,ACCF	;*    +    ,
D MINUS,PERIOD,SLASH	;-    .    /
D NUM,NUM,NUM		;0    1    2
D NUM,NUM,NUM		;3    4    5
D NUM,NUM,NUM		;6    7    8
D NUM,TAG,SEMIC		;9    :    ;
D FIRARG,EQUAL,ULIM	;<    =    >
D QUESTN,INDIRECT,ABSA	;?    @    A
D BPS,CON,SYMD		;B    C    D
D EFFEC,SFLOT,GO	;E    F    G
D HWRDS,INTRUP,JSTEP	;H    I    J
D KILL,LOADER,MASK	;K    L    M
D NWORD,BITO,PROCED	;N    O    P
D QUAN,RELA,SYMBOL	;Q    R    S
D TEXO,UNPRO,LEFT	;T    U    V
D WORD,XEC,YSTEP	;W    X    Y
D ZERO,OCON,ICON	;Z    [    \
D OSYM,VARRW,PSYM	;]    ^    _
;SEMICOLON DISPATCH
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,ERR			;-    -    -
D ERR,ERR,SEMSPA		;-    -  SPACE
D ERR,TEXTYP,ERR		;!    "    #
D ERR,ERR,ERR			;$    %    &
D ERR,ERR,ERR			;'    (    )
D ERR,ERR,ERR			;*    +    ,
D ERR,INTSYM,ERR		;-    .    /
D NUM,NUM,NUM			;0    1    2
D NUM,NUM,NUM			;3    4    5
D NUM,NUM,NUM			;6    7    8
D NUM,ERR,SEMIC			;9    :    ;
D ERR,EQUAL,ERR			;<    =    >
D SEM.QU,INDIRECT,ADRSPC	;?    @    A
D PRBRK,ERR,ERR			;B    C    D
D ESCAP,SEMI.F,ERR		;E    F    G
D HALT,PSIST,SEMI.J		;H    I    J
D ERR,LOADGO,MERGE		;K    L    M
D ERR,OBTAIN,ERR		;N    O    P
D ERR,RJCL,SNARF		;Q    R    S
D ERR,SEMI.U,SEMI.V		;T    U    V
D SYMSOT,ERR,YANK		;W    X    Y
D ERR,ERR,ERR			;Z    [    \
D ERR,ERR,ERR			;]    ^    _
;DESCRIPTION OF OP DECODER FOR DDT:
;
;THE ENTIRE INSTRUCTION SET FOR THE PDP-10 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-10.  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 INST.  N+1 IS THE NUMBER OF BITS IN INST WHICH ARE
;       TO BE CONSIDERED.  P GIVES THE
;	POSITION (NUMBER OF BITS FROM THE RIGHT EDGE) OF THE N+1 BITS.
;
;	EXAMPLE: P = 6
;	         N = 2
;
;	C(INST) = .010 101 100(2)
;
;	THE RESULT = D = 010(2) = 2(8)
;
;	D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
;	IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
;	PRINT TEXT, 41-72(8)) ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
;	THE INTERPRETATION.
;
;40(8)	THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
;	IS FINISHED.
;41(8)-72(8)      THE ALPHABET IS ENCODED INTO THIS RANGE.
;	        41- A
;	        42- B
;	        72- Z
;	        WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
;	        LETTER IS TYPED.
;
;73(8)-777(8)     THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
;	        CONSIDERED TO BE A, TRANSFER INTERPRETATION
;		TO THE A-73(8) BYTE IN THE TABLE.
;
;MACROS TO ASSEMBLE THE OPCODE TREE
;
;.TRA FOO	CAUSES INTERPRETER TO TRANSFER TO THE POINT IN THE
;		TREE TAGGED "FOO".
;
;.ADR FOO	CAUSES THIS POINT IN THE TREE TO BE TAGGED "FOO".
;
;.END 		MARKS A LEAF (A DEEPEST POINT) IN THE TREE. 
;		INTERPRETATION RESUMES AT THE NEXT HIGHEST
;		BRANCH.
;
;.TXT STUFF	CAUSES THE TEXT "STUFF" TO BE PACKED AS ONE ASCII
;		CHARACTER PER 9-BIT BYTE IN THE TREE.  THE
;		INTERPRETER TAKES NO ACTION IF IT ENCOUNTERS TEXT.
;
;.DIS MN	WHERE M AND N ARE TWO ONE-DIGIT INTEGERS.  M IS THE
;		NUMBER OF BITS TO THE RIGHT OF THE FIELD OF INTEREST.
;		N  IS THE NUMBER OF BITS TO CONSIDER.  FOR INSTANCE
;		.DIS 63  WILL CONSIDER THE LEFT THREE BITS OF A 9-BIT
;		OPCODE STORED IN  INST.  THE INTERPRETER DISPATCHES
;		0 TO 7 BYTES TO THE RIGHT DEPENDING ON THE VALUE
;		OF THE SELECTED FIELD.
;
;
;WHEN USED TO LOOKUP AN OPCODE (OPEVAL),  THE INTERPRETER
;OPERATES BY TYPING OUT ALL OPCODES A CHARACTER AT A TIME,
;CHECKING EACH CHARACTER FOR EQUALITY AGAINST THE KEY THAT IS
;BEING LOOKED UP.  THUS, TO LOOK UP "JRST", THE INTERPRETER
;TRIES ALL TOP LEVEL BRANCHES UNTIL IT FINDS ONE WHICH WILL TYPE OUT
;A "J",  AND THEN PROCEEDS TO SEE IF THE REST OF THAT BRANCH WILL
;TYPE OUT  "RST".  ETC.
SUBTTL	OP	DECODER

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

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:  ;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: **************
;;	TO INCLUDE UUOS IN THE DECODER TABLE, REPLACE THE FIRST
;;	.DIS 63,.END WITH .DIS 63,.TRA UUO

BYT9 <

.DIS 63,.END,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
	.TXT H,.TRA HWT,.TXT T,.TRA ACBM


;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,.TRAX JSYS,.TRAX ADJS,,.END,.END
	.ADR JSYS,.END JSYS,.ADR ADJS,.END ADJSP
;**********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>

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
FSGN:	ASCII	.E-.
	ASCII	.E+.
;JSYS INSTRUCTIONS

DEFINE DEFJS (NAME,NUM)<
	ASCII	/'NAME'/
	NUM>


JSYTAB:
DEFJS LOGIN,1
DEFJS CRJOB,2
DEFJS LGOUT,3
DEFJS CACCT,4
DEFJS EFACT,5
DEFJS SMON,6
DEFJS TMON,7
DEFJS GETAB,10
DEFJS ERSTR,11
DEFJS GETER,12
DEFJS GJINF,13
DEFJS TIME,14
DEFJS RUNTM,15
DEFJS SYSGT,16
DEFJS GNJFN,17
DEFJS GTJFN,20
DEFJS OPENF,21
DEFJS CLOSF,22
DEFJS RLJFN,23
DEFJS GTSTS,24
DEFJS STSTS,25
DEFJS DELF,26
DEFJS SFPTR,27
DEFJS JFNS,30
DEFJS FFFFP,31
DEFJS RDDIR,32
DEFJS CPRTF,33
DEFJS CLZFF,34
DEFJS RNAMF,35
DEFJS SIZEF,36
DEFJS GACTF,37
DEFJS STDIR,40
DEFJS DIRST,41
DEFJS BKJFN,42
DEFJS RFPTR,43
DEFJS CNDIR,44
DEFJS RFBSZ,45
DEFJS SFBSZ,46
DEFJS SWJFN,47
DEFJS BIN,50
DEFJS BOUT,51
DEFJS SIN,52
DEFJS SOUT,53
DEFJS RIN,54
DEFJS ROUT,55
DEFJS PMAP,56
DEFJS RPACS,57
DEFJS SPACS,60
DEFJS RMAP,61
DEFJS SACTF,62
DEFJS GTFDB,63
DEFJS CHFDB,64
DEFJS DUMPI,65
DEFJS DUMPO,66
DEFJS DELDF,67
DEFJS ASND,70
DEFJS RELD,71
DEFJS CSYNO,72
DEFJS PBIN,73
DEFJS PBOUT,74
DEFJS PSIN,75
DEFJS PSOUT,76
DEFJS MTOPR,77
DEFJS CFIBF,100
DEFJS CFOBF,101
DEFJS SIBE,102
DEFJS SOBE,103
DEFJS DOBE,104
DEFJS GTABS,105
DEFJS STABS,106
DEFJS RFMOD,107
DEFJS SFMOD,110
DEFJS RFPOS,111
DEFJS RFCOC,112
DEFJS SFCOC,113
DEFJS STI,114
DEFJS DTACH,115
DEFJS ATACH,116
DEFJS DVCHR,117
DEFJS STDEV,120
DEFJS DEVST,121
DEFJS MOUNT,122
DEFJS DSMNT,123
DEFJS INIDR,124
DEFJS SIR,125
DEFJS EIR,126
DEFJS SKPIR,127
DEFJS DIR,130
DEFJS AIC,131
DEFJS IIC,132
DEFJS DIC,133
DEFJS RCM,134
DEFJS RWM,135
DEFJS DEBRK,136
DEFJS ATI,137
DEFJS DTI,140
DEFJS CIS,141
DEFJS SIRCM,142
DEFJS RIRCM,143
DEFJS RIR,144
DEFJS GDSTS,145
DEFJS SDSTS,146
DEFJS RESET,147
DEFJS RPCAP,150
DEFJS EPCAP,151
DEFJS CFORK,152
DEFJS KFORK,153
DEFJS FFORK,154
DEFJS RFORK,155
DEFJS RFSTS,156
DEFJS SFORK,157
DEFJS SFACS,160
DEFJS RFACS,161
DEFJS HFORK,162
DEFJS WFORK,163
DEFJS GFRKH,164
DEFJS RFRKH,165
DEFJS GFRKS,166
DEFJS DISMS,167
DEFJS HALTF,170
DEFJS GTRPW,171
DEFJS GTRPI,172
DEFJS RTIW,173
DEFJS STIW,174
DEFJS SOBF,175
DEFJS RWSET,176
DEFJS GETNM,177
DEFJS GET,200
DEFJS SFRKV,201
DEFJS SAVE,202
DEFJS SSAVE,203
DEFJS SEVEC,204
DEFJS GEVEC,205
DEFJS GPJFN,206
DEFJS SPJFN,207
DEFJS SETNM,210
DEFJS FFUFP,211
DEFJS DIBE,212
DEFJS FDFRE,213
DEFJS GDSKC,214
DEFJS LITES,215
DEFJS TLINK,216
DEFJS STPAR,217
DEFJS ODTIM,220
DEFJS IDTIM,221
DEFJS ODCNV,222
DEFJS IDCNV,223
DEFJS NOUT,224
DEFJS NIN,225
DEFJS STAD,226
DEFJS GTAD,227
DEFJS ODTNC,230
DEFJS IDTNC,231
DEFJS FLIN,232
DEFJS FLOUT,233
DEFJS DFIN,234
DEFJS DFOUT,235
DEFJS CRDIR,240
DEFJS GTDIR,241
DEFJS DSKOP,242
DEFJS SPRIW,243
DEFJS DSKAS,244
DEFJS SJPRI,245
DEFJS STO,246
DEFJS ARCF,247
DEFJS ASNDP,260
DEFJS RELDP,261
DEFJS ASNDC,262
DEFJS RELDC,263
DEFJS STRDP,264
DEFJS STPDP,265
DEFJS STSDP,266
DEFJS RDSDP,267
DEFJS WATDP,270

IFE KL20F,<
DEFJS ATPTY,274
>
IFN KL20F,<
DEFJS GTNCP,272
DEFJS GTHST,273
DEFJS ATNVT,274>
DEFJS CVSKT,275
DEFJS CVHST,276
DEFJS FLHST,277
DEFJS GCVEC,300
DEFJS SCVEC,301
DEFJS STTYP,302
DEFJS GTTYP,303
DEFJS BPT,304
DEFJS GTDAL,305
DEFJS WAIT,306
DEFJS HSYS,307
DEFJS USRIO,310
DEFJS PEEK,311
DEFJS MSFRK,312
DEFJS ESOUT,313
DEFJS SPLFK,314
DEFJS ADVIS,315
DEFJS JOBTM,316
DEFJS DELNF,317
DEFJS SWTCH,320
DEFJS TFORK,321
DEFJS RTFRK,322
DEFJS UTFRK,323
DEFJS SCTTY,324
DEFJS CFGRP,325
DEFJS OPRFN,326
IFE KL20F,<
DEFJS CGRP,327
DEFJS VACCT,330
DEFJS GDACC,331
DEFJS ATGRP,332
DEFJS GACTJ,333
DEFJS GPSGN,334
DEFJS GFACC,335
> ;IFE KL20F
DEFJS SETER,336
IFE KL20F,<
DEFJS ASPTY,360
DEFJS REPTY,361
DEFJS PSTI,362
DEFJS PSTO,363
DEFJS SRUBA,365
DEFJS DLON,400
DEFJS DLOFF,401
DEFJS DLPUT,402
DEFJS DLGET,403
DEFJS DLOPR,404
> ;IFE KL20F
DEFJS PUPI,441
DEFJS PUPO,442
DEFJS PUPNM,443
DEFJS PUPSK,444
IFN KL20F,<
DEFJS RSCAN,500
DEFJS HPTIM,501
DEFJS CRLNM,502
DEFJS INLNM,503
DEFJS LNMST,504
DEFJS RDTXT,505
DEFJS SETSN,506
DEFJS GETJI,507
DEFJS MSEND,510
DEFJS MRECV,511
DEFJS MUTIL,512
DEFJS ENQ,513
DEFJS DEQ,514
DEFJS ENQC,515
DEFJS SNOOP,516
DEFJS SPOOL,517
DEFJS ALLOC,520
DEFJS CHKAC,521
DEFJS TIMER,522
DEFJS RDTTY,523
DEFJS TEXTI,524
DEFJS UFPGS,525
DEFJS SFPOS,526
DEFJS SYERR,527
DEFJS DIAG,530
DEFJS SINR,531
DEFJS SOUTR,532
DEFJS RFTAD,533
DEFJS SFTAD,534
DEFJS TBDEL,535
DEFJS TBADD,536
DEFJS TBLUK,537
DEFJS STCMP,540
DEFJS SETJB,541
DEFJS GDVEC,542
DEFJS SDVEC,543
DEFJS COMND,544
DEFJS PRARG,545
DEFJS GACCT,546
DEFJS LPINI,547
DEFJS GFUST,550
DEFJS SFUST,551
DEFJS ACCES,552
DEFJS RCDIR,553
DEFJS RCUSR,554
DEFJS MSTR,555
DEFJS STPPN,556
DEFJS PPNST,557
DEFJS PMCTL,560
DEFJS PLOCK,561
DEFJS BOOT,562
DEFJS UTEST,563
DEFJS USAGE,564
DEFJS WILD,565
DEFJS VACCT,566
DEFJS NODE,567
DEFJS ADBRK,570
DEFJS SINM,571
DEFJS SOUTM,572
DEFJS SWTRP,573
DEFJS GETOK,574
DEFJS RCVOK,575
DEFJS GIVOK,576
DEFJS SKED,577				;SCHEDULER CONTROL JSYS
DEFJS MTU,600				;MTU JSYS
DEFJS XRIR,601				;EXTENDED RIR
DEFJS XSIR,602				;EXTENDED SIR
DEFJS PDVOP,603				;MANIPULATE PROGRAM DATA VECTORS
DEFJS NTMAN,604				;DECNET NETWORK MANAGEMENT INTERFACE
DEFJS XSFRK,605				;START FORK AT GLOBAL PC
DEFJS XGVEC,606				;GET FULL ENTRY VECTOR
DEFJS XSVEC,607				;SET FULL ENTRY VECTOR
DEFJS RSMAP,610				;READ SECTION MAP
DEFJS XRMAP,611				;EXTENDED RMAP
DEFJS XGTPW,612				;EXTENDED GET TRAP WORD
DEFJS XSSEV,613				;EXTENDED SET SPECIAL ENTRY VECTOR
DEFJS XGSEV,614				;EXTENDED GET SPECIAL ENTRY VECTOR

;TEMPORARY JSYS DEFINITIONS

DEFJS SEND,740
DEFJS RECV,741
DEFJS OPEN,742
DEFJS CLOSE,743
DEFJS SCSLV,744
DEFJS STAT,745
DEFJS CHANL,746
DEFJS ABORT,747

DEFJS SNDIM,750
DEFJS RCVIM,751
DEFJS ASNSQ,752
DEFJS RELSQ,753

DEFJS SNDIN,754
DEFJS RCVIN,755
DEFJS ASNIQ,756
DEFJS RELIQ,757

DEFJS METER,766
DEFJS SMAP,767
DEFJS THIBR,770
DEFJS TWAKE,771
DEFJS MRPAC,772
DEFJS SETPV,773
DEFJS MTALN,774
DEFJS TTMSG,775
DEFJS MDDT,777
>; IFN KL20F
IFE KL20F,<
DEFJS TVPIC,600		
DEFJS FIFOP,601		
DEFJS CNTSZ,605		
DEFJS SKUSR,606		
DEFJS PSTIN,611		
DEFJS RAND,612		
DEFJS DELCH,625		
DEFJS SJPCT,626
DEFJS RJPCT,627
DEFJS IIT,630		
DEFJS PARRD,631
DEFJS PARST,632
DEFJS STCHA,633
DEFJS GTSIG,730
DEFJS RLSIG,731
DEFJS WTFOR,732
DEFJS SIGNL,733
DEFJS ABORT,737
DEFJS SEND,740
DEFJS RECV,741
DEFJS OPEN,742
DEFJS CLOSE,743
DEFJS INTRP,744
DEFJS STAT,745
DEFJS CHANL,746
DEFJS FORKX,747		
DEFJS SNDIM,750
DEFJS RCVIM,751
DEFJS ASNSQ,752
DEFJS RELSQ,753
DEFJS GPGC,764		
DEFJS CADSK,770		
DEFJS MRPAC,772
DEFJS DSKCV,774
DEFJS TTMSG,775
DEFJS EXEC,777
> ;IFE KL20F

JSYEND:
;LEVEL TABLE FOR INTERRUPTS FROM USER
LEVTAB:	IPC1
	IPC2
	IPC3

;CHANNEL TABLE FOR USER INTERRUPTS
CHNTAB:	2,,RUBOUT	;RUBOUT
	2,,CT.PSI	;^T INTERRUPT
	1,,BPTINT	; BREAKPOINT
	0,,ERR
	0,,ERR
	0,,ERR
	0,,ERR	;INTEGER OVERFLOW
	0,,ERR	;FLOATING POINT OVERFLOW
	0,,ERR
	0,,ERR	;PUSHDOWN OVERFLOW
	0,,ERR	;END OF FILE
	0,,ERR	;DATA TRANSMISSION ERROR
	0,,ERR	;QUOTA EXCEEDED OR DISK FULL (+++)
	0,,ERR
	0,,ERR
	0,,ERR	;ILLEGAL INSTRUCTION
	0,,ERR	;ILLEGAL MEMORY READ
	0,,ERR	;ILLEGAL MEMORY WRITE
	0,,ERR	;ILLEGAL MEMORY EXECUTE
IFE ADBRKF,<	0,,ERR>	;SUBSIDIARY FORK TERMINATION
IFN ADBRKF,<	1,,FRKTRM>
	0,,ERR	;MACHINE SIZE EXCEEDED
	REPEAT	CHNTAB+36-.,<0,,ERR>

;TRAP MESSAGE TABLE -- OFFSET BY 6, SEE TBRK
MSG=.-6
	ASCII	/IOV:/	;INTEGER OVERFLOW
	ASCII	/FOV:/	;FLOATING POINT OVERFLOW
	ASCII	/XXX:/	;RUBOUT (FAKE BREAK)
	ASCII	/POV:/	;PUSHDOWN OVERFLOW
	ASCII	/EOF:/	;END OF FILE
	ASCII	/DTE:/	;DATA TRANSMISSION ERROR
	ASCII	/QOT:/	;QUOTA EXCEEDED OR DISK FULL
	ASCII	/FOO:/	;RESERVED
	ASCII	/FOO:/	;RESERVED
	ASCII	/ILL:/	;ILLEGAL INSTRUCTION
	ASCII	/IMR:/	;ILLEGAL MEMORY READ
	ASCII	/IMW:/	;ILLEGAL MEMORY WRITE
	ASCII	/IMX:/	;ILLEGAL MEMORY EXECUTE (RESERVED ON KL)
	ASCII	/FKT:/	;SUBSIDIARY FORK TERMINATION
	ASCII	/MSE:/	;MACHINE SIZE EXCEEDED
	ASCII	/FOO:/	;RESERVED
	ASCII	/NXP:/	;NON-EXISTANT PAGE
	ASCII	/ABK:/	;ADDRESS BREAK (FAKE)
	ASCII	/TTY:/	;JOB WANTS THE TTY (FAKE BREAK)
	ASCII	/HFK:/	;FORK HALTED BY SUPERIOR OF NDDT (FAKE BREAK)

	LIT
;READ/WRITE/EXECUTE AREA
		QZQZ==<.+777>&777000
		DEPHASE
		RELOC QZQZ-NDDT+LOW
		PHASE QZQZ
RWX:
TBLK:	0
TEM:	0	;GENERAL TEMPORARY
GDTO:	0	;USED IN ALT-SEMI-Y
GDFROM:	0	;AND ALT-SEMI-U
TXUPRW:	0	;FOR ASCII INPUT MODE
TXQUOT:	0	;FOR ASCII INPUT MODE
HPOS:	0	;FOR ALIGNMENT
SCHSAV:	PIN	;TEMPORARY MODE SAVED HERE IN SUPER-TEMPORARY MODE
JFNS1:		;FOR DEFAULT NAMES
JFNDIR:	BLOCK	10
JFNNAM:	BLOCK	7
JFNS2:	0
BLOCK:	0
SVF:	0
SW1:	0
SVFB:	0
SVTB:	0
BLVL:	0	;CURRENT BLOCK LEVEL IN SYM TAB
WRD:	0	;VALUE OF EXPRESSION TYPED
WRD2:	0	;VALUE OF EXPRESSION TO RIGHT OF $
PRNC:	0	;PAREN COUNT
NPWR10:	0	;NEG POWER OF 10 DURING FRACTION PART OF FP NUM

FRASE:	0	;****DONT CHANGE ORDER, SEE  SEARC+3***********
SYL:	0	;NUMBER TYPED, TAKEN AS OCTAL
LWT:	0	;LAST WORD TYPED IN OR OUT
TEM2:	0
FRASE1:
TEM3:	0
DEN:	0	;NUMBER TYPED, TAKEN AS DECIMAL

PRGM:	0	;0 OR POINTER TO THIS PROGRAM'S SYMBOLS
ESTU:	0	;BEGINNING OF UNDEFINED SYMBOL TABLE
ESTUT:	0
FSV:	0
FH:	0
SYM:	0	;RADIX 50 SYMBOL BEING GATHERED
SPSAV:	0	;POINTER TO LAST SYMBOL TYPED
DEFV:	0	;DEFINITION VALUE FOR SYMBOLS, FA FOR SEARCH
ULIMIT:	0	;LA FOR SEARCH, ETC.
LLOC:	0	;TEMPORARY VALUE OF .
LLOCO:	0	;VALUE OF .
SAVLOC:	0	;THE ADR OF OLD REGISTER EXAMINATION SEQUENCE
PATLOC:	0	;LOCATION ON INSTRUCTION BEING PATCHED UPON
PATPNT:	0	;"." DURING A PATCH
STRING:	0	;0 OR POINTER TO STORED COMMAND STRING
BBC:	0	;BUFFERED BACK CHARACTER

CNXBPT:	0
pinff:	0	; non-zero means print c(eff adr) and C(ac) of instruction
wrprot:	0	; Location to be monitored in single stepping
wrcont:	0	; Contents thereof
stepct:	1	; Number of single steps
sstepv:	-1	; Verbose single stepping
fctrln:	0	; -1 means winning ^N, 0 means losing $y/$j
$ctrln:	0	; First word is pc of instruction
	block	ntbpts ; Saved PC's of temp BPT's
$ctins:	-1	; 1st word is 3-<# of saved locs>, rest is displaced instr's
	block	ntbpts
ssacs:	block	20; User ac's before single step
JCL:	BLOCK	17
ENDJCL:	0
STRIP:	0	;STRING BUFFER INPUT PTR
STROP:	0	;STRING BUFFER OUTPUT PTR
STRBUF:	BLOCK	STRBFL

TIMUSD:	0	;CPU TIME USED AT LAST RESET
TIMCON:	0	;CONSOLE TIME USED AT LAST RESET
VADDR:	-1	;^T VIEW ADDRESS
JFN:	0	;JFN FOR PROGRAM UNDER $L,$Y
IPC1:	0		;INTERRUPT PC'S
IPC2:	0
IPC3:	0
SYMPTR:	0,,HOME		;INITIAL (EMPTY) SYM. TAB. PTR.


;THE USER'S TTY STATE
SAVTTY:	0
SAVTT2:	0		;TTY CONTROL CHARACTER MODES
SAVTT3:	0
USRTB2:	0		;TTY TAB SETTINGS
USRTB3:	0
USRTB4:	0

;DDT'S TTY STATE (CHANGE TTYCC2,3 MEAN CHANGE TO LITERAL AFTER ESCAP2)
CRFLAG:	0		;NON-0 IF LAST CHR IN WAS A CR
TTYCC2:
IFE KL20F,<
	BYTE	(2) 0,0,1,1,1,1,1,2,0,0,2,1,1,2,1,1,1,1
>
IFN KL20F,<
	BYTE	(2) 0,1,1,1,1,1,1,2,0,0,3,1,1,2,1,1,1,1
>
TTYCC3:
IFE KL20F,<
	BYTE	(2) 1,1,0,0,1,1,1,1,1,0,1,1,1,2
>
IFN KL20F,<
	BYTE	(2) 1,1,0,1,1,1,1,1,1,0,1,1,1,2
>
DDTTB2:	401002,,4010	;NDDT'S TTY TAB SETTINGS
DDTTB3:	20040,,100200
DDTTB4:	401002,,4010

TOCS:	MOVEI	T,.-.	;GET RIGHT HALF BACK
SEAR2:	JUMPE	T,SEAR3	;OR JUMPN T,SEAR3
ACCCF:	MOVEI	T,.-.	;LEFT HALF OF A,,B

BPTFLG:	0		;ADDR OF BPT BLK IF A $P WILL BE FROM A BPT
QLPNT:	0		;USED IN ? COMMAND AS PTR
			;0 IF IT WILL BE FROM ILLINST OR RUBOUT
USRFLG:	-1		;-1 WHILE USER RUNNING, >=0 IF IN DDT
LASTPG:	0		;FORK,,PAGE  CURRENTLY MAPPED IN
LASFPG:	0		;CURRENTLY MAPPED OWNINGFORK,,PAGE 
IDPACS:	0		;ACCESS OF MAPPED PAGE
REALPC:	0		;WHAT FORK'S PC SHOULD BE WHEN NEXT RUN

;ESCAPE CHARACTER CONTROL
ESCCHR:	"D"-100		;THE ASCII CHARACTER
ESCCOD:	"D"-100		; AND TERM CODE
SAVCOC:	00		;SAVED CCOC (2-BIT) FIELD
COCPTR:	POINT	2,TTYCC3,9;POINTER TO ABOVE FIELD


;DEFAULT VALUES FOR FILE GTJFN'S
DEFALT:	0		;OR 1B0
	100,,101
	0
	0
	0
	0		;SYMBOLS OR SAV
	0
	0
	0

;BLOCK FOR TEXTI
TXTBLK:	4
	RD%BEL!RD%RND!RD%JFN!RD%SUI
	.PRIIN,,.PRIOU
	-1,,JCL
	<20*5>
;INTERNAL REGISTERS


;BREAK POINTS
DEFINE BPTBLK(Z.)<
$'Z.'B:	0
	0
	0
	0
	0
	0
	ASCIZ	/$'Z.'B/
	0
>
	RADIX	10


FRSTIR==.		;MARKS BEGINNING OF INTERNAL  REGISTER LIST
	QZ==1
BPTS:	REPEAT	NBP,<BPTBLK \QZ
	QZ==QZ+1>
NBPTV==<.-BPTS>/NBP	;NUMBER OF BPT VARIABLES
	RADIX	8
RB:	BLOCK	NRBL	;RING-BUFFER OF EXAMINED ADDRESSES
LRB==.-1
RBPT:	RB		;RING-BUFFER POINTER: START AT HEAD OF BUFFER
SYMOFS:	777		;MAXIMUM OFFSET FROM SYMBOL TO PRINT
TRAPWD:	0		;TRAP STATUS WORD
WDATA:	0		;WRITE DATA DURNING INSTR TRAP
XRG:	20		;LOCATION WHERE $X IS DONE
PC:	0		;INDICATED USER'S PC
CURMSK:	0		;THE MASK USED FOR A PARTICULAR SEARCH
UUOL:	0
MSK:	-1,,-1		;MASK FOR SEARCHES
	0,,-1		;AND OTHERS....
	-1,,0
	740,,0
	17,,0
	-1000,,0
	-1		;LAST TWO ARE USER DEFINED...
	-1
USRPSI:	0
	0
	0
	0
	0
	0
	0
	0
FORK:	-1		;FORK HANDLE OF CURRENT USER FORK
SUBSYS:	'NDDT'		;SUBSYSTEM NAME FOR USER
TPFORK:	-1		; FORK HANDLE OF TOP FORK OF USER
LASTIR==.		;MARKS END OF INTERNAL REGISTERS
BINSTR:	0		;INSTR. TO INTERPRET WHEN PROCEEDING

WHY:	0		;WHY NDDT ENTERED, RH OF FORK STATUS

;USER'S ACCUMULATORS, WHILE IN DDT
AC0:	BLOCK	20

;PERMANENT CONTROL SWITCHES (AC'S 10,11,12 ARE TEMP EQUIV'S)
SCHM:	PIN		;DO NOT CHANGE ORDER
ARM:	PADSO
ODFM:	10


TEM1:	0

SVBTS:	0
SVBTS2:	0
SVBT3:	0
SVBT2:	0

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		;PDL PTR SAVED DURING OPEVAL
LITS:	LIT
	VAR


PS:	IOWD	LPDL,.+1
	BLOCK	LPDL
PCSPTR:	0		;OLD PC STACK POINTER
PCSTAK:	IOWD	PCSL,.+1
	BLOCK	PCSL

PATCHS:PAT:		;PATCH SPACE

	QZQZ==<.+777>&777000
	DEPHASE
	RELOC	QZQZ-DDT+LOW
	PHASE	QZQZ


;WINDOW INTO USER'S CORE
UCORE:	BLOCK	1000

DDTEND:	DEPHASE
; LOCAL MODES:
; MODE: MIDAS
; END:

	END	BLAST