.SYMTAB 7001.,5000.		;-*- MIDAS -*-

TITLE DDT

IFNDEF NSSPGS,NSSPGS==25	;# PAGES FOR SYSTEM SYM TAB
; WARNING!!  DDT really screws up when NSSPGS is too small, or if anything
; goes wrong with the initial system mapping.  This should be fixed someday!!

IFNDEF NDSPGS,NDSPGS==10	;# PAGES FOR DDT SYM TAB
IFNDEF NUSPGS,NUSPGS==3		;# PAGES FOR DEFAULT SYMS THAT SYSTEM SUPPLIES.
IFNDEF JPDLL,JPDLL==8		;LENGTH OF $J RING BUFFER.
IFNDEF RADNUM,RADNUM==8		;DEFAULT IS 8 RAID REGISTERS.
IFNDEF DBGBFL,DBGBFL==20	;LENGTH OF DEBUG INFO BUFFER.

NLEVS==7	;LENGTH OF RING BUFFER OF .
LWTLNG==8	;LENGTH OF RING OF $Q
NINFP==8	;MAX NUM INF PROCEDURES
NBP==10		;NUMBER OF BREAK POINTS
SNLLEN==10	;NUMBER OF FILE DIRECTORIES TO REMEMBER
LPDL==300	;MAX LENGTH PUSH DOWN LIST
FTBLNG==60.	;FROB TABLE INCREMENT LENGTH (MUST BE EVEN)
GSCLNG==20.	;$Q*5= MAX # CHARS / FROB.
FDRCL==100	;LENGTH OF FDRC BUFFER.
NARGS==3	;# ARGS OPERATOR CAN HAVE.
4BLKNM==10	;NUM. 4-WD LIST ELEMENTS.
UNDFRS==4	;2* MAX # UNDEF REFS IN EXPRESSION.
TYOBFL==20	;# WORDS IN TTY OUTPUT BUFFER.

vpage==200	;temporary page
vpagad=vpage_10.
uprpag==201	;page for .BREAK 12,[..rpur,,<addr>]
upradr==uprpag_10.

ipage==210	;Start of INQUIR's space
iplen==20	;20 pages reserved for INQUIR database

F=0	;FLAGS
P=1	;PUSH DOWN
A=2	;POINTERS TO TABLES, CORE, ETC.
B=3
C=4	;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
D=5	;TRANSFER DATA
W1=6
W2=7
U=10	;DDT'S USER INDEX FOR CURRENT INF PROCEDURE
W3=11
I1=12
I2=13
I3=14
I4=15
W4=16	;ALWAYS POINTS TO TOP OF FROB STACK.

.XCREF A,B,C,D,P,U

CALL=PUSHJ P,
RET=POPJ P,
SAVE=PUSH P,
REST=POP P,

;LEFT HALF FLAGS

FL==1,,525252
FLQ==1		;RANDOM TEMPORARY IN COMMANDS
FLC==40		;RANDOM TEMPORARY IN COMMANDS
FLLT==20	;0 FOR $P, 1 FOR ^P, ETC.
FLNNUL==1	;NOT NULL
FLPNT==2	;POINT
FLNEGE==4	;NEGATIVE EXPONENT
FLRO==10	;REGISTER OPEN
FLLET==20	;LETTER
FLUNRD==100	;SET => RE-READ 1 CHAR IN RCH.
FLRUB==200	;RUB OUT
FLCTLL==1000	;SET IF RE-READING CHARS FOR ^L.
FLDEV==2000	;SET IF FILENAME READER READING ONLY DEV & SNAME.
FLST==4000	;$$! MODE
FLSTOP==10000	;SET AT INT. LEVEL TO SAY CURRENT JOB WANTS TO INT., STOP .HANGING.


;TS SYMBOLS

TYIC==1
TYOC==2
USRI==3
USRO==4
UTIC==5
UTOC==6
LPTC==7
FDRC==10
COMC==11
ERRC==12
PDP6C==13	;KEEPS PDP6 OPEN IF HAVE IT BUT NOT CURRENT JOB.
LSRC==14	;For accessing the INQUIR database
TYIFC==15	;FULL CHAR SET INPUT FOR .ITYIC
dirhc==16	;channel on which HSNAME directory is kept open

STB==,,-1	;BLOCK TYPES OF SYMBOL TABLE INFORMATION.
STBDEF==0	;BLOCK OF SYMBOL DEFINITIONS:  SQUOZE NAME ? VALUE
STBUND==1	;BLOCK OF UNDEFINED SYMBOL REFERENCES, AS IN WHAT UNDEFL(U)
		;POINTS AT.
STBFIL==2	;4 WORDS OF DEV, FN1, FN2, SNAME OF FILE TO LOOK FOR SYM TAB IN
STBINF==3	;RANDOM INFO COMPOSED OF SUB-BLOCKS.  EACH SUB-BLOCK IS
		;-<# WDS>,,<TYPE> FOLLOWED BY DATA WORDS.  SUBBLOCK TYPE 1
		;CONTAINS THESE WORDS:  XUNAME OF ASSEMBLY, DISK FORMAT DATE OF
		;ASSEMBLY, and DEV-FN1-FN2-SNAME OF SOURCE FILE.

APR==0		;DEFINE MOST COMMON PDP10 DEVICE CODES, SO WE CAN
PI==4		;PUT THEM IN OUR SYMBOL TABLE.
PTP==100
PTR==104
TTY==120
LPT==124
DIS==130

ERLOSS=50000,,	;INTERNAL ERROR, TYPE VARIOUS LOCATIONS AND @EFFECTIVE ADDRESS.
	;THIS IS UUO THAT GOES THRU SYSTEM SO WON'T CLOBBER .JPC.
7NRTYP=31000,,	;7TYPE THEN GSNLRT
ERSTRT=32000,,	;STRING RETURN ERROR MESSAGE
7TYPE=33000,,
CTYPE=34000,,	;TYPE EFF ADR AS CHAR
STRT=35000,,
OPNER=36000,,
TERR=37000,,

MINUUO==31

DEFINE TSOPEN A,B
IFSN A,FDRC,[	.OPEN A,B
		OPNER B]
IFSE A,FDRC,[	PUSHJ P,FDRCOP
		B
		OPNER FDRCO]
	TERMIN

DEFINE	TSCALL A
	.CALL A
	 ERLOSS
TERMIN

DEFINE	TSCLO A
	.CALL A
	 OPNER A
TERMIN

NIOCHN==20	;NUMBER OF ITS I/O CHANNELS.
BUSRC==100000	;USER-CONTROLLED BIT IN .USTP VARIABLE.

SNFUSER==60	;FOREIGN USER SYSTEM DEVICE CODE (.STATUS)

OPNLBP==220600	;B.P. TO OPEN-LOSS CODE FIELD IN .STATUS'S VALUE.

%PICL1==1	;BIT IN HAKINT FOR RQ'ING REPRINTING OF :SEND.
%pidir==40000,,0	;bit in HAKINT for RQ'int mail checking

DEFINE INFORM A,B
IF1,[PRINTX \A = B
\]TERMIN

DEFINE INSIRP A,B
IRPS FOO,,[B]
A,FOO
TERMIN TERMIN

DEFINE	SYSCLE A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
	 ERLOSS
TERMIN

DEFINE	SYSCAL A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN

define calblk a,b
setz ? sixbit /A/ ? b ((setz))
termin

DEFINE	SYSCLO A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
	 OPNER @.-1
TERMIN

;RIGHT HALF FLAGS
R.==525252
R.OUT==4	;OPDECODER FLAGS

R.NAF==200	;NEGATIVE ADDRESSES PERMISSABLE
R.BPLF==2	;BPLOC REF AS ADDR
R.OLOADF==10	;SET => :OLOAD, CLEAR FOR $L.

NAF==R.NAF ? BPLF==R.BPLF ? OLOADF==R.OLOADF

;FLAGS IN SQUOZE SYMBOL.
%SY==1,,537777	;BIT TYPEOUT MASK.

%SYHKL==400000	;1 => HALF-KILLED.
%SYKIL==200000	;1 => FULLY KILLED (IGNORE ALWAYS).
%SYLCL==100000	;1 => LOCAL SYMBOL.  EXCEPT FOR PROGRAM NAMES & BLOCK NAMES,
%SYGBL==040000	;1 => GLOBAL SYMBOL.	EITHER %SYGBL OR %SYLCL SHOULD BE ON.

%SYFLG==740000	;ALL THE FLAG BITS.  ALL 0 => PROGRAM NAME OR BLOCK NAME.

;ERROR COMMENTS

;TMJ=TOO MANY JOBS
;INT=RIGHT HALF INTERUPT
;CKS=CHECK SUM ERROR
;BIN=IOC ENCOUNTERED ON LOAD
;CFT=CAN'T FLUSH TTY
;JOB=NO CURRENT JOB
;UNF=UNFLAPPABLE (UDISMOUNT FAILED)
;DSN=DISOWN LOST
;LOGIN=YOU ARE NOT LOGGED IN
;PUR=TRIED TO WRITE IN READ ONLY CORE


LOC 41
	JSR UUOH
	
FORTY:	0
	JSR SUUOH	;HANDLE RETRUNABLE UUOS (THEY'RE ALL ERRORS)
	-TSINTL,,TSINT	;INTERRUPT TABLE POINTER.
lockw:	0		;lock chain pointer
	-crtlng,,crtab	;critical routines table
	0 ? 0 ? 0
	STBDDT		;WHEN DON'T HAVE SYMS, DO @52$$/ ^Y
VERSUN::
VRSADR:	.FNAM2		;VERSIO NUMBER TO APPEAR IN DDTBUG DUMP FILES.

;DDT'S USER VARIABLES, USUALLY INDEX OF U.
USRS:
UUNAME:	0
UJNAME:	0
INTBIT:	0	;INTERRUPT BIT IF INFERIOR, 0 IF FOREIGN, SIGN BIT IF PHONY INFERIOR (SYS, PDP6).
URANDM:	0	;RANDOM WORD, WITH FIELDS AS FOLLOWS:
$URBPT==000400	;0 => NORMAL; NOT 0 => WE ARE PROCEEDING FROM A BPT,
		;AND THIS FIELD IS THE BPT NUMBER. PREVENTS THAT BPT
		;FROM BREAKING THE NEXT TIME IT IS HIT.
%urdps==1000	;Deposit OK.  See N2ACR
%urctx==200	;Job has been ^X'd, and hasn't yet returned.
%urfrn==400	;Job is a foreign job, do not reown!
%urusr==160	;mask of bits that user can read and write.
%urmal==100	;set => no mail arrivals announced while this job is running
%urfrz==40	;set => no output permission for other jobs while this job runs
%urgag==20	;set => no unsolicited typeouts while this job is running.
$urgag==040100	;Byte Pointer to %URGAG

UINT:	0	;#0 => JOB INT'D DDT, IS WAITING TO RETURN.
UPI0:	0	;THE 1ST WD INTS THAT STOPPED THE JOB & CALLED DDT.
UPI1:	0	;THE 2ND WD INTS THAT DID SO.
PPC:	0	;PROGRAM COUNTER
XECPC:	0	;PC SAVE ON $X OR $G.
UINTWD:	0	;-5 => STOPPED BY SYSTEM CALL WHEN .UTRAP SET
		;-4 => STOPPED BY ..PERMIT=0.
		;-3 => STOPPED BY A MAR THAT ABORTED THE INSN (KA'S ONLY) (SIC)
		;-2 => MULTI-STEPPING RETURN ($^N OR ^N)
		;-1=>STOP ON RANDOM INT
		;0=> RUNNING (OR WAITING TO RETURN, IF UINT NOT 0)
		;1 - 8 => STOPPED BY THAT NUMBERED BREAKPOINT
		;16 => .BREAK 16,
		;21 => LOADED, NOT YET STARTED

XINTWD:	0	;SAVE UINTWD ON $X
JTIME:	0	;SEE FNJOB
UIND:	0	;JOB NUMBER (IN SYSTEM)
USTYPE:	0	;TYPE OF MULTI-STEPPING TO DO IN THIS JOB (BITS USTYPB - USTYPZ)
BPBEG::				;HERE THROUGH BPEND ZEROED BY ^K'ING.
MARADR:	0	;MAR SETTING (FOR TURNING BACK ON WHEN TRIPPIING TURNS IT OFF)
MARXCT:	0	;-> ASCII STRING IN JOB'S CORE, TO USE AS DDT CMDS WHEN MAR TRIPPED.
MARCON:	0	;CONDITIONAL MAR INSTRUCTION.
NBPTB:	0	;-1 ON CONDITIONAL BPT BREAK 0 NORMAL
BPCPC:	0	;PC SAVE ON CONDITIONAL BPT
CBPPS:	0	;RH UINT (SAVE BPT #) LH EFFECTIVE ADDRESS OF INSTRUCTION FOR PROCEED
INCNT:	0	;COUNT FOR LIMITED PROCEED
OIPCHK:	0	;$$^N STOP ADDRESS
USCNT:	0	;# TIMES TO MULTI-STEP, NEG => FOREVER.
BTADR:	0	;ADDR OF TEMP. BPT. PAIR (0 => NONE). LH < 20 => IT IS ADDR OF PDL
BTPDL:	0	;IF LH OF BTADR <20, THIS IS CONTENTS TO LOOK FOR IN PDL.
BTINS:	0 ? 0	;THESE HOLD INSNS REPLACED BY THE TEMP BPTS.
BPINFL:	0	;4.9 - BPTS INSERTED, 1.N - AUTO-PROC BPT N.
B1ADR:	0	;ADDRESS OF BPT(RH) LOC TO PRINT OUT (LH)
BPCON:	0	;CONDITIONAL BPT INSTRUCTION
B1CNT:	0	;PROCEED COUNT
B1INS:	0	;INSTRUCTION REPLACED BY .BREAK
BPL==B1INS-B1ADR+1
	BLOCK <NBP-1>*BPL
BPEND::
STARTA:	0	;0, OR JRST TO START ADDR.
LIMIT:	0	;LOW-DEFAULT-SEARCH-LIMIT,,HIGH-DEFAULT-LIMIT.
PERMIT:	0	;-1 => CAN EXECUTE VALRET STRINGS
SYSUUO:	-1	;0 => USE .UTRAP TO STOP AT SYSTEM CALLS.
PATCHL:	0	.SEE PATOPN	;IF PATCHING, PATCHED-FROM,,PATCH-AREA, ELSE 0.
LITCNT:	0	.SEE N2ARPR	;<# OF LAST DEFINED LITERAL>,,<# OF LAST ASKED-FOR LITERAL>
TPERCE:	0	;$% TYPEOUT MODE FOR THIS JOB.
TAMPER:	0	;$& MODE.
TDOLLA:	0	;$$ (ALT-DOLLAR) MODE.
TPRIME:	0	;$' MODE.
TDQUOT:	0	;$" MODE.
TNMSGN:	0	;$# MODE.
SAFE:	0	;-1 => OBJECT BEFORE KILLING THIS JOB AT USER'S REQUEST.
USPARE:	0	;THIS VARIABLE IS A SPARE, FOR PATCHING.
UFNAMD:	0	;LOADED FILE'S DEV, ETC.
UFNAM1:	0
UFNAM2:	0
UFNAMS:	0
UFILE:	0	;$L, $Y, ETC. FILE.
UFILE1:	0
UFILE2:	0
UFILES:	0
UFLSYS:	0	;SET IF DEV. SHOULD BE CLOBBERED TO DSK BY $Y.
UHACK:	0	;.BREAK 12, HACKS
UIACK:	0	;.BREAK 16, HACKS
UCHBUF:	0	;AOBJN -> COMMAND (:JCL) BUFFER. (IN SYM TAB SPACE)
BININF:	0	;AOBJN -> RANDOM INFO LOADED AND DUMPED.
UNDEFL:	0	;AOBJN -> LIST OF UNDEF SYM ENTRIES (IN SYMTAB SPACE)
RADAOB:	0	;AOBJN -> STORAGE FOR DISPLAY PROCESSOR DATA.
PRGM:	0	;SYMTAB TAIL -> HEADER OF CURRENT BLOCK.
JOBSYM:	0	;LEAVE JOBSYM LAST
USRLNG==.-USRS
	BLOCK USRLNG*<NINFP-1>


USREND=NINFP*USRLNG	;1ST USR-IDX NOT ALLOWED IN U.
L==USRLNG		;AS IN ITS
INFORM [Storage per Luser]\USRLNG

SUUOHA:	0
SUUOHD:	0

SUUOH:	0		;HANDLE ERLOSS AND SYSTEM-RETURNED UUOS.
	.SUSET [.RJPC,,UUOJPC]
	jrst suuohp		   ;Go hack this UUO in the PURE area

UUOH:	0			   ;save real local uuos.
	jrst uuohp		   ;Go hack the UUO in pure space
UERFLN:	SIXBIT /   ERR/
	2
UERFLC:	.

uopaca:	0		;saved A for OPNER's
uopacd:	0		;saved D for OPNER's

;USED IN --MORE-- PROCESSING.
MORONP:	0	;-1 => **MORE** TURNED OFF.
MORMSG:	0	;NONZERO => -> SPECIAL MSG TO USE INSTEAD "FLUSHED"
MORFLG:	0	;-1=> READ FROM TTY ONLY DESPITE INPTR
MORNRO:	0	;-1 => RUBOUT WON'T FLUSH AFTER NEXT --MORE--.
MORNHU:	0	;-1 => NEXT **MORE** WON'T BE FOLLOWED BY HOME-UP.
MORRET:	0	;PC AT CALL TO MORINI.
MORPRP:	0	;0 IF NO --MORE-- PROC., ELSE P AT CALL TO MORINI.
MOREXP:	0	;-1 IF EXPLICITLY CAUSING A --MORE-- OR --<ANYTHING ELSE>--.

;LOW-LEVEL INPUT PROC. VARS.
INNCTL:	0	;-1 => IGNORE ^B, ETC. IN FILES & VALRETS.
INPDL:	0	;0, OR -> HEAD OF INPUT SOURCE PDL.
INPTR:	0	;0 => INPUT FROM TTY.
		;<0 => INPUT FROM COMC.
		;>0 => IT IS B.P. TO VALRET STRING, INVAOB IS AOBJN -> WHOLE STRING.
LIMBO:	0	;MOST RECENTLY READ CHARACTER.
INVAOB:	0	;IF INPTR POSITIVE, THIS IS AOBJN -> VALRET STRING.
UNRCHF:	0	;-1 => RE-READ LIMBO.
UNECHF:	0	;IF UNRCHF -1, THIS -1 => RE-ECHO IT, TOO.
TTYUNR:	-1	;POS. => IT IS CHAR TO BE RE-READ WHEN INPUT FROM
		;TTY (NOT FILE OR VALRET STRING) IS DESIRED.

INIOPS:	0	;-1 => A CMD FILE HAS BEEN INPUSHED BUT NOT .IOPUSHED.
TOKTRM:	0	;SET BY RTOKEN IFF TOKEN ENDED WITH ^M OR ^J.
ratflg:	0	;-1 => @ and % terminate RTOKEN

IFILE:	SIXBIT/DSK   @     BIN/
	0		;ALTERNATE DEFAULT FOR $L.

CU:	-1	;CURRENT JOB'S IDX, OR -1 IF NO CURRENT JOB.
NJ1:	@	;COUNT USED FOR DETERMINING MOST RECENT JOB (SEE FNJOB)
NJ2:	@	;COUNT USED FOR DETERMINING LEAST RECENT JOB (")
UCHNLO:	0	;0 => NO USER OPEN, OR THIS JOB IS SYS.
		;+ => FOREIGN USER (INCLUDING SELF).
		;-1 => INFERIOR OR PDP6
SIXCTR:	0	;NUMBER OF JOBS THAT ARE THE PDP6.
SYSSW:	0	;SET IF JOB IS SYS.
DDTSW:	0	;SET IF THIS JOB IS SELF.
SYSDPS:	0
SYSSTB:	0	;SET IF HAVE SYS SYM TAB ABS PGS.
DEBUGP:	-1	;SET IF DEBUGGING DDT.
RUNFLG:	0	;-1 => DDT HAS BEEN RUN.

$X=34

ALARMV:	0	;0 => ALARM CLEAR. ELSE TIME ALARM WILL OR SHOULD HAVE
		;TRIPPED, IN 60THS, ASSUMING SYSTEM STARTED AT T=0.
ALARMW:	0	;TIME SINCE SYSTEM STARTUP FOR THE NEXT
		;PRINTING OF HAKKAH'S RANDOM TYPEOUTS, OR 0.
;DDT SHOULD BE AWAITING A REALTIME INT IFF EITHER OF THESE ISN'T 0.

MONMDL:	0	;TEMP. MONIT MODE (SET FROM MONMOD AT EACH ENTRY
		;TO MAIN LOOP; TURNED OFF IF THE PHONY : IS RUBBED OUT,
		;THUS TEMPORARILY LEAVING MONIT MODE.

NOMSGF:	1	;ZERO => DEFER ALL UNSOLICITED MSGS (EXCEPT SYSTEM DOWN WITHIN 15 MIN).
GAGF:	1	;ZERO => GAGGED AGAINST :SENDS.
TW2FL:	0	;TEMP. USED BY ^P AND $^P TO DISTINGUISH THEMSELVES.
		;0 FOR ^P, 1 FOR $^P, -1 FOR $$^P.  (See TW1FL, below)


SETBEG::	;User options (things allowable for the user to set) begin here

DIRDIR:	0	;-1 => $$^F (without numeric arg) uses arg for new PFILES.

DIRFN1:	SIXBIT /NAME1/	;Table of $$^F DIR: search options.
DIRFN2:	SIXBIT /UP/
	SIXBIT /FIRST/	;$$1^F finds FN1
	0		; can make sense to store FN2 as PFILE1
	SIXBIT /SECOND/	;$$2^F finds FN2
	SIXBIT /BIN/
	SIXBIT /CDATE/	;$$3^F ascending in creation age
	SIXBIT /DOWN/
	SIXBIT /SIZE/	;$$4^F descending in size
	SIXBIT /DOWN/
	SIXBIT /NOT/	;$$5^F not backed up
	SIXBIT /DUMPED/
	SIXBIT /ONLY/	;$$6^F just link pointers
	SIXBIT /LINKS/
DIRFNN==7.		;Total number of DIR: hacking slots.

NDROP:	BLOCK DIRFNN
NDRDEV:	REPEAT DIRFNN, <'DSK>,,PFILE
NDRDIR:	REPEAT DIRFNN, MSNAM,,PFILES
NDRFN1:	REPEAT DIRFNN, PFILE1
NDRFN2:	REPEAT DIRFNN, PFILE2

MONMOD:	0	;-1 => MONIT MODE (GENERATE COLONS FOR USER)

MSK:	-1 ? ,-1 ? -1,, ? 0 17, ? (17) ? 777000,, ? -1 ? -1  ;MASKS FOR $W, $N.

UNPURF:	-1	;NONZERO => AUTOMATIC UNPURIFY ON DEPOSIT IN INFERIOR.

MSTYPE:	USTYPU+USTYPB+USTYPP
		;DEFAULT USTYPE VAR. FOR NEWLY CREATED JOBS.

DOZTIM:	1	;# SECONDS TO WAIT EACH MULTI-STEP IF USTYPZ SET.

SENDRP:	-2	;# 60.'THS OF SECOND BETWEEN REPETITIONS OF :SENDS, ETC.
		;0 => DON'T REPEAT (EXCEPT ON RETURN TO DDT)
		;-1 => DON'T PRINT UNTIL RETURN TO DDT.

BELCNT:	5	;DEFAULT NUMBER OF BELLS WHEN DDT GRABS TTY

CLOBRF:	-1	;-1 => FOO^K WHEN JOB FOO EXISTS QUERIES THE USER.
		;ZEROED BY <NAME>$U. NOT CHANGED BY :LOGIN.
GENJFL:	-1	;NONZERO => :<PRGM> ACTS LIKE :NEW <PRGM>. 0 => LIKE ^K.

PCPNTF:	0	;NONZERO => WHEN NEXT INSN TO BE EXECUTED IS PRINTED,
		;ALSO OPEN THE AC AND EFF ADDR IT REFERENCES.

ckqflg:	-1	;-1 => read thru cr for ":FOO"
		;before trying to open TS FOO.
		;0 => Error out when getting the space after a command which is
		;not found
		;1 => Beep but do not error on getting the space after
		;non-existant command

NFVRBS:	-1	; -1 => Makes NFDIR searching be verbose.
		;  0 => Do not print directory name used for command.

delwarn:1	; 0 => no warnings.
		; 1 => "(Delete File)" warning on ^O.
		; 2 => warnings on a few other 1-char file commands.
		; 3 => Warn of impending lossage with LINKF and LINKNF commands

MORWARN:1	;0 => NO WARNINGS FOR --MORE--'S; 1 => SAY "(SPACE=YES, RUBOUT=NO)".

confrm:	1	;0 => No confirmation required for $$^X, $U and $^X

masscp:	0	;non-zero => $$^X. kills all jobs

linkp:	0	;>0 => $^O links files link :LINKNF, <0 => like :LINKF

TWAITF:	-1	;-1 => %TBINT BIT OF NEW JOBS IS SET; 0 => IT IS CLEARED.

TW1FL:	0	;0 => ^P CLEARS %TBWAT ALLOWING DTTY INTERRUPTS,
		 ;WHILE $^P SETS %TBWAT PREVENTING SUCH INTS.
		;-1 INTERCHANGES ^P AND $^P.

PROMPT:	CTYPE "* ;PROMPT-INSTRUCTION, IN CASE USER WANTS TO CLOBBER IT.
rprmpt:	7type [asciz /A[DDT]/]  ;prompt given on return to DDT

sndflg:	0	;nonzero means :SEND should run program "SEND"

omailf:	0	;zero means :prmail should offer to delete, negative means
		;rename to OMAIL, and positive to never delete or rename

pmlflg: 0       ;nonzero means $^A should act like :PRMAIL (i.e. ask whether
                ;or not to delete your mail)

PRMMCH:	0	;-1 => INCLUDE THE MACHINE'S NAME (AI, ML, ETC) IN THE PROMPT.

c.zprt:	-1 	;zero if wish simple [DDT] on ^Z and ^_D

OCOFL:	-1	;-1 => NON-REQUESTED (HAKKAH) TYPEOUTS CAN GO THROUGH COM MODE.

SMLINS:	MOVE	;# OF LINES OF A :SEND TO PRINT OUT BEFORE SAYING --MORE--
		;OR (N MORE LINES).

SYMOFS:	100	;LARGEST ALLOWED <N> FOR WHICH <SYM>+<N> MAY BE PRINTED OUT.

BYERUN:	0	;-1 => RUN :BYE AT LOGOUT TIME.

DPSTOK:	0	;-1 => $$^R OK on non-SYS jobs

JSTOPT:	0	;Job Status display (%PIJST handler) options.
		;The RH says what kind of info we like.
		;  -1 => Muzzled -- just dismiss.
		;   0 => If DDT has TTY, about DDT state.
		;   1 => If DDT has TTY, about ITS state.
		;   2 => About ITS state always.
%JS==:1,,525252 ;The LH bits detail the info's format:
%JSSYM==:400000	;Autoload syms for symbolic typeout (ha ha)
%JSRAD==:200000	;Show 1st RAID in place of UPC.
%JSTRA==:100000	;Show job tree trace to target.

SETEND::	;End of user-setable locations

INTACS:	BLOCK 16.
INTJPC:	0

;STUFF RELATING TO TYPEOUT MODES IS ON THIS PAGE.

;USED BY OP-CODE CONVERSION RTNS.
PNTR:	INST
CHP:	0
TXT:	BLOCK 2

SAVPDL:	0

INST:	0
TEM:	0
TEM1:	0

N2ACCS:	0	;LAST SYMBOL TYPED BY SPT SAVED HERE FOR $$^C.
SPTS:	JRST TOUT
TOCTEM:	0	;HOLDS RADIX DURING TOC.

TYPMOD::	;BEGINNING OF INFO THAT DEFINES THE CURRENT TYPEOUT MODE.

SATPC:	0	.SEE SATP	;MOST RECENT $T MASK.

BITPAT:	0	;PATTERN FOR MAIN BIT TYPEOUT MODE.
BITPA1:	0	;PATTERN FOR ALTERNATE BIT TYPEOUT MODE.
BITSYM:	0	;SYMBOL PREFIX FOR MAIN BIT TYPEOUT MODE.
BITSY1:	0	;SYMBOL PREFIX FOR ALTERNATE BIT TYPEOUT MODE.

;CURRENT MODE
SCH:	-1,,PIN	;MAIN TYPEOUT MODE - PIN,HLFW,TFLOT,SATP,ITEXO,PIN,FTOC
AR:	PADR	;ADDRESS TYPEOUT MODE (PADR OR PADA)
ODF:	10	;RADIX.
BITF:	0	;-1 => BIT MODE IS SELECTED.

TYPMOE::	TYPMOL==.-TYPMOD

SCHM:	 -1,,PIN	;PERMANENT MODE
ARM:	 PADR
ODFM:	 10
BITFM:	0

SCHMM:	-1,,TFLOT	;MODE TO RETYPE IN
ARMM:	PADR
ODFMM:	10
BITFMM:	0

RAIDFL:	-1	;NONZERO => AUTOMAITCALLY DISPLAY RAID REGISTERS WHEN JOB RETURN.
RADSIZ:	RADNUM	;# OR RAID REGISTERS TO ALLOCATE TO EACH JOB.
RADTOP:	1	;NONZERO => AUTOMATIC RAIDFLG DISPLAY IS AT SCREEN TOP, NOT AT CURSOR.
RADING:	0	;-1 WHILE DISPLAYING RAID REGS.
RADCLR:	0	;-1 IF HAVE DONE A CLEAR-SCREEN OR --MORE-- SINCE LAST RAID REG DISPLAY.

NOTTY:	0	;-1 => WE DON'T REALLY HAVE A TTY TO USE, SINCE "TTY:" WAS TRANSLATED
		;TO SOME OTHER SORT OF DEVICE.
DDTTY:	-1	;-1 =>TTY IN DDT
TTYSTL:	0	;-1 => HAVE TTY BUT IT'S STOLEN FROM INFERIOR, SHOULD GIVE IT BACK SOON.
		;-1 OR POSITIVE => OCO (IN TTYCOM) HAS BEEN BOUND ON, AND SHOULD
		;BE UNBOUND TO OLD VALUE IN TTYSCM SOON.
RSTDEL:	0	;SET BY RETURNING JOB => DON'T  .RESET TYIC, OR PUSH INPUT STREAM.
TTNRST:	0	;SET BY RUBOUT ERROR OR ^D => DON'T .RESET TYIC,

STOPWT:	0	;-1 => DDT MAIN PROGRAM LEVEL IS WAITING FOR CURRENT JOB
		;TO INTERRUPT AND SET FLSTOP.

TEM3:	0
XCRFSW:	0	;-1 => DON'T TYPE CRLF WHEN PROCEEDING

NALTXF:	0	;-1 WHILE DOING $X INSIDE DDT ITSELF - PREVENTS DDT BUG FILES
		;FROM BEING WRITTEN IF LOSER EXECUTES A LOSING INSTRUCTION.

;:MSGS STUFF
MSGDAT:	0	;DATE S.T. EARLIER MSGS AREN'T TYPED.
MSGLDT:	0	;BEFORE 1ST FILE, -1; ELSE DATE OF LAST FILE STARTED.
MSGTDT:	0	;TODAY'S DATE AND TIME (IN :MSGS)
MSGLOG:	0	;SET AT ENTRY TO AUTOMATIC :MSGS AT LOGIN.
msgloc:	0	;location of our MSGS database entry.

msgdip:	0	; pointer to DISTRIB field if found

msgpag==:340	;first page to map MSGS file into
msglen==:20	;up to 20 pages are allocated!

MSGF3:	'DSK,,
	0?0
MSGSNM:	SIXBIT /.MSGS./	;F.D. TO LOOK IN

XBLK.==25
CBPB==26
BPBLK==31
XBLK$X==34
XBLK$Q=37

26SAV:	0	;COND B.P. INSN
	.BREAK 16,110000
	.BREAK 16,310000
31SAV:	0	;PROCEED FROM BPT THAT SHOULDN'T BREAK.
	JRST
	JRST
34SAV:	0	;$X
	.BREAK 16,500000
	.BREAK 16,700000

clirpc:	0	;number of :SENDS not yet printed for last time.
clirpx:	0	;number of :SENDs received since last at DDT

clufn1:	0	;user being sent to <UNAME>.

malits:	0	;0 or ITS to hack for mail
;;;The next 3 words are indexed off w1 and must be in this order!
bugdev: 'COM,,
clidev:	sixbit /CLI/	;device to do CLI on (CLI, MCCLI, etc.)
	'DSK,,

bufbeg:	0		;Beginning of the message buffer
CLUXUN:	0	;XUNAME OF USER BEING :SENT TO, IN CASE HE LOGS OUT.

NCTLTA:	0	;ARG TO ^T, ^U PUT HERE.
NCTLTF:	BLOCK 9	;USED FOR FILENAMES BY ^T, ^U.

ERROPN:	'ERR,,
	3
	0	;STATUS WORD

HOLPPX:	POP D,.(D)	;USED BY HOLE

NLTNWX:	JUMPE\JUMPN I1,NALTN5

NCOMNM:	0	;0, OR NAME OF :-CMD NOW IN PROGRESS.
XRWI:	0	;-1 => SKIP AND RETURN ON MPV, 
	  ;UNPURIFY ON PUR (ONLY IF UNPURF SET), ASSUMES ADDR IN A.

UUOJPC:	0	;.JPC SAVED ON ERLOSS OR BAD UUO.

NCOLSB:	0	;B SAVED AT NCOL FOR DEBUGGING
NCOLSC:	0	;C
NCOLSD:	0	;D

DBGBFR:	BLOCK DBGBFL	;DEBUGGING BUFFER. RIGHT NOW, OPERATORS EXECUTED
DBGBFP:	DBGBFR		;ARE PUSHED ONTO IT FIRST.

TQUITR:	0	;NONZERO => DON'T QUIT NOW.
TQUITW:	-1	;NONNEG => ^G SEEN WHEN TQUITR SET.

dskful:	0	;The IOC error just gotten by HAKCLI was due to disk full

EFIELP:	0	;RESTORE P ON PDL OVERFLOW IN EFIELD.
ERRSTP:	0	;RESTORE P ON ERROR UUOS (EXCEPT ^D, ^G, ERLOSS)
ERRSTL:	[ERLOSS];RESTORE PC. ERROR BEFORE IT'S OK IS DDT BUG.

ERRNPP:	0	;LAST P RESTORED ON ERROR.
ERRNPC:	0	;LAST PC RESTORED ON ERROR.
ERROPP:	0	;P BEFORE LAST RESTORATION OF P ON ERROR.
FLSNPP:	0	;LAST P RESTORED BY MORE-FLUSHING.
FLSOPP:	0	;P BEFORE LAST RESTORATION DUE TO MORE-FLUSHING.

fdrcls:	0	;non-zero iff we don't want CTLF1 and friends to close FDRC
		;on EOF
CTLDFL:	0	;-1 => ^D HAS BEEN SEEN AT INT LVL, SEARCHES SHOULD STOP.
CTLZFL:	0	;-1 => ^Z SEEN AT INT LVL - ASSUME USER INTENDED IT FOR
		;SOME INFERIOR, SO STOP INFERIOR AT NEXT OPPORTUNITY
		;(CLEARED WHEN DDT NEEDS TTY INPUT)

VPAGCT:	-1	;>= 0 => HAVE FRESH PAGE AT VPAGE.
SYSSML:	0	;-1 + PAGE # OF LOWEST ABS PAGE OF ITS SYMBOLS WE HAVE MAPPED.
HCLOB:	0	;-1 => HACTRN HAS BEEN DEPOSITED IN.
HHACK:	-1	;location of last deposit, if hactrn has been deposited in
		;other than legitimately


;;; Switches for entry by PWORD program at starting address plus offset
;;; (offset <5)
pwordp:	0			   ; -1 -> entered at DDT + offset
initp:	-1			   ; -1 -> run init if logged in at startup
				   ; set 0 for even offfsets from DDT

VPATCH:	block 20		   ;Always 20 words of impure free, at least

INFORM [Top of low impure]\.-1

.=<.+1777>/2000*2000	;TO PAGE BNDRY
LIMPUR::		;REAL TOP OF LOW IMPURE PAGES.

SYSSMP==./2000
	BLOCK NSSPGS*2000	;SYS SYM TAB ABS PGS GO HERE.
SYSSYM==.-2000
SYSAOB==.-2			;DDT-2, AOBJN -> SYS SYM TAB (IN SYS ADDRESS SPACE)

	BLOCK NDSPGS*2000	;DDT SYM TAB GOES HERE IN PURE PGS.
STBDE:

STBSPG==./2000	;# OF 1ST OF 2 PAGES FOR USYMS AND CALLS.
	BLOCK NUSPGS*2000

MINPUR==<.+1777>/2000

uuohp:	save a
	SAVE D
NUUOPS==2
	LDB D,[331100,,40]
	CAIGE D,40
	 CAIGE D,MINUUO
	  CAIA		;SKIP IF INVALID UUO.
	   JRST UUOH1
	.SUSET [.RJPC,,UUOJPC]
	MOVE A,40
	MOVEM A,FORTY	;MAKE THE LDB D, IN SUUOHP DO THE RIGHT THING.
	REST D
	REST A
	HRROS SUUOH	;MARK THIS LOSSAGE AS DUE TO A USER-UUO SO THAT
	JRST SUUOHP	;PERSON ANALYZING CRASH WON'T THINK SUUOH HAS ADDR OF LOSSAGE.

UUOH1:	SKIPGE UUOTAB-MINUUO(D)
UUOH2:	PUSHJ P,ERTTY	;MAKE TTY OK TO USE FOR ERR MSG.
	JRST @UUOTAB-MINUUO(D)

suuohp:	movem a,suuoha
	MOVEM D,SUUOHD	;DON'T CLOBBER A PDL SLOT.
	SKIPE DEBUGP
	 .VALUE
	LDB D,[331100,,FORTY]
	CAIN D,ERLOSS_-33
	 JRST UERLOS
	JRST UUOH3


$$OVLY==1
$$ULNM==0
$$ULNP==0
$$UNAM==0
$$HSNM==1

lsrtns"E==d+1			   ;gotta have it (sigh)
datime"E==d+1			   ;(double sigh)

.insrt syseng;lsrtns >

.insrt syseng;msgs >

$$OUT==1			   ;We want the date output routines
.insrt syseng;datime >

crtab:				   ;Critical routines table for :MSGS database
msgs"critic
crtlng==.-crtab


;;; Try to map in the Inquire database.  Skips if mapped. 

maplsr:	movei a,lsrc		   ;channel for LSRTNS to hack
	push p,b
	move b,[-iplen,,ipage]	   ;AOBJN ptr to pages for LSRTNS to hack
	call lsrtns"lsrmap
	 jrst [	pop p,b
		ret ]
	pop p,b
	aos (p)
	ret

unmapl:	move b,[-iplen,,ipage]
	syscal corblk,[%climm,,0   ;delete the pages
	       %climm,,%jself
	       b]
	  erloss		   ;  huh?  can't delete them?
	.close lsrc,
	ret

;;; GETHSN takes the XUNAME in C, returns HSNAME in C.
;;; GETHS0 is similar but takes XUNAME in B and ITS name in C

geths0:	push p,a
	push p,b
	push p,d
	call maplsr		   ;Map in the Inquire database.
	 jrst [ move c,b	   ; If can't, just pretend HSNAME=XUNAME.
	 	jrst geths9 ]
	jrst geths1

gethsn:	push p,a
	push p,b
	push p,d
	call maplsr		   ;Map in the INQUIR database.
	 jrst geths9		   ; If can't, just pretend HSNAME=XUNAME.
	move b,c		   ;get the XUNAME in B
	setz c,			   ;0 means local site
geths1:	push p,b		   ;Remember the XUNAME for later
	movei a,lsrc		   ;channel for INQUIR database
	movei d,fdrc		   ;channel to hack for directory opens
	call lsrtns"lsrunm	   ;map in the LSRTNS entry
	  jrst [setz b,		   ;  no entry, note by clearing B
	        jrst .+2]
	  aos -4(p)		   ;skip since there's an INQUIR entry
	pop p,a			   ;Get our XUNAME
	call lsrtns"lsrhsn	   ;collect the HSNAME
	  jfcl			   ;  Might have been Device Not Available
	move c,d		   ;Get our answer
	.close fdrc,		   ;no more channels open
	call unmapl		   ;unmap the INQUIR database
geths9:	pop p,d			   ;restore the world
	pop p,b
	pop p,a
	ret

;; OPMAIL clobbers A, takes the XUNAME to look for in B, and either 0 in C
;; or an ITS to over-ride the one specified in INQUIR.  It will return
;; the HSNAME in A, the XUNAME in B, and the ITS name in C

opmail:	push p,d	;Don't clobber D
	push p,c	;remember the ITS name we were given
	push p,b	;save XUNAME for later
	call maplsr	;map in the database
	 jfcl		; Eh? Were gonna lose quick - here goes...
	movei a,lsrc
	movei d,fdrc
	call lsrtns"lsrunm	;find this person in INQUIR
	  jrst [setz b,	;  Remember that there was no INQUIR entry
	        jrst inqmal]  ;and get his HSNAME from INQUIR
	jumpn c,inqmal	;If we were given an explicit ITS, look only there
	movei a,lsrtns"i$neta  ;check out the network address field
	call lsrtns"lsritm  ;dig it out!
	  jrst inqmal
	movem a,netabp	;remember where this info is
	move d,a	;D gets the BP to the NET Adress
	call read6	;read a token
	  jrst inqmal
	caie c,"%	;Did he terminate in an % or @?
	  cain c,"@
	    jrst [call getits  ;yes, use this for the XUNAME
		    jrst inqmal	 ;somehow this is garbage!
		  jrst inqml0]  ;OK, NOW we got the site
	call mchokp	;Is this a valid ITS?
	  jrst [ call notits  ;  Tell him about forwarded mail
		 jrst inqmal]  ; and don't fuck with the machine name
inqml0:	movem a,-1(p)	;salt machine name away

inqmal:	move a,(p)	;remember our XUNAME
	movei d,fdrc	;channel to open the directory on
	move c,-1(p)	;remember our ITS
	skipn c		;is it unspecified?
	  move c,itsnam	;  Use current
	movem c,-1(p)	;and salt this improved version away
	call lsrtns"lsrhsn  ;get the HSNAME
	  jrst [ skipn ddtty	   ;If we've got the TTY, tell him he lost
		   7type [asciz /(Net or INQUIR error)
/]		        ;  Eh???  Tell the user.
		  move a,(p)  ;use our XUNAME as the HSNAME
		  jrst inqml5]
	  aos -3(p)	;  Skip return
	move a,d	;collect the HSNAME
inqml5:	call unmapl
inqml6:	pop p,b		;and the XUNAME
	pop p,c		;recover the ITS name
	pop p,d		;remember D (unchanged)
	ret


read6:	setz a,
	push p,b
	move b,[440600,,a]
6readl:	ildb c,d
	cain c,40
	 jrst 6readl		; spaces are ignored.
	cain c,"%		; % is a terminator
	  jrst mpopj1
	caie c,"@		; @, comma are terminators
	 cain c,",
	  jrst mpopj1
	cain c,^Q		; let ^Q quote a character.
	 ildb c,d
	caige c,40
	 jrst mpopj1		; control chars terminate even if ^Q'd
	cail c,140
	 subi c,40
	subi c,40
	tlne b,770000
	 idpb c,b
	jrst 6readl

mpopj1:	pop p,b
	skipe a			;unless this is a null entry
	aos (p)
	popj p,


;; person said FOO@BAR

getits: push p,a		   ;remember the FOO part
	pushj p,read6		   ;get more of it
	  setz a,		   ;  not there!  Fail return
	jumpe a,popaj		   ;if null, same as not there
	call mchokp		   ;is this a known machine?
	  jrst gtitsx		   ;If not an ITS, same as not there!
	move c,a		   ;That was the ITS name
	movei a,lsrc
	pop p,b			   ;recover our XUNAME
	movem b,-1(p)		   ;and set the XUNAME saved on the stack
	call lsrtns"lsrunm	   ;Find the new frobule
	  setz b,		   ;  No INQUIR entry for that XUNAME
	move a,c
	jrst popj1

gtitsx:	pop p,a
	move a,-2(p)		   ;use whatever ITS was specified!
	jrst notits		   ;Tell him the mail goes off of ITS

mchtab: irp machine,,[AI,ML,MC,MD,MX,DM]
sixbit /machine/
termin
mchcnt==:.-mchtab		;# ITS's

;;; Expects BP to net address in NETABP, prints same with message
notits:	7type [asciz /A(This person's mail is forwarded to /]
notit1:	ildb d,netabp	;get a char
	jumpe d,[ 7type [asciz /)
/]			;  if that's the end, that's all, so finish the line
		  popj p,]
	call tout	;type the char
	jrst notit1	;and get the next

;;; canonicalize and check the machine name.  (Handles MIT-MC and MC)
;;; Takes machine in A, returns canonicalized machine in A

mchokp:	camn b,[sixbit /DSK/]  ;= machine we're on
	  jrst [move a,itsnam ? jrst popj1]
	push p,b
	ldb b,[143000,,a]	;get the MIT- of MIT-xx
	camn b,[sixbit /  MIT-/]  ;Was it in that form?
	  jrst [ ldb a,[001400,,a]  ;Get the xx part
		 lsh a,30	;put it in it's place
		 jrst .+1]
	call mchok0		;is this a real machine?
	  caia
bret:	    aos -1(p)
	pop p,b
	popj p,			;no more nexts, bad!

mchok0:	camn a,[sixbit /DSK/]  ;is this the local machine?
	  jrst [ move a,itsnam ? jrst popj1]  ;then use that instead
	movsi b,-mchcnt		;for all the machines
mchok1:	camn a,mchtab(b)	;is it this one?
	  jrst popj1		;  yes, it's OK
	aobjn b,mchok1		;no, try next
	ret

;;; GTMAIL takes in A the FN2, B a XUNAME, an ITS name in C, or 0 meaning
;;; wherever his mail would normally be found, and opens on FDRC the mail file
;;; for that user. If it fails, it will not skip, and return a .CALL type error
;;; code in D.  It will also return the HSNAME in A, the XUNAME in B, and the
;;; ITS name in C.

gtmail:	movem a,tfile+2	;save the fn2 of the file we're after
	call opmail	;Find the mail to look at
	camn b,xuname	;is this the same XUNAME and
	  came c,itsnam	;  is this from this machine?
	    caia	;    no, gotta tell the user
	      jrst gtmal9  ;   yes, don't bother telling user.
gtmal5:	7type [asciz /A(Checking mail from /]
	movem b,tfile+1
	camn c,itsnam	;Is it from this ITS?
	  movsi c,'DSK	;  yes, use DSK instead
	movem c,tfile
	move b,a	;B has gotta be the SNAME
	movei a,tfile	;print out the filenames
	call lfile0
	move a,b	;recover A from it's hiding place in B
	move b,tfile+1	;recover B from it's hiding place in TFILE
	move c,tfile	;recover C from it's hiding place in TFILE
	ctype ")	;balance!
	call terpri	;new line!
	call tyofrc	;force out the message so he knows why he's waiting
gtmal9:	syscal open,[%clbit,,.bii ? %climm,,fdrc ? c ? b ? tfile+2 ? a
	             %clerr,,d]
	  caia		;  no skip
	    aos (p)	;    found it, skip return
	jumpe d,cpopj	;no error, we win!
	caie d,%ensfl	;Was it that the file wasn't there?
	  opner @gtmal9	;  No, bad lossage, tell him.
	ret

DDT:	jrst ddt.0		   ;entry for DDT^K and for systems without
				   ;pwords.
	jrst ddt.1		   ;entry for :LOGIN form
	jrst ddt.2		   ;entry for :LOGIN <user> -bf
	jrst ddt.3		   ;entry for <user>$U
	jrst ddt.4		   ;entry for <user>$0U


ddt.0:	SKIPE RUNFLG
	 JRST DD1B	;NOT FIRST START.
	SETOM RUNFLG	;FIRST, INITIALIZE.
 	JRST DDT2

ddt.4:	setzm initp	;note that we don't want the init run
ddt.3:	setzm clobrf	;set up for sophistcated users
	setzm morwarn
	setom c.zprt	;Sophisticated users understand PDP-10 instr
	jrst ddt.1	;go start up

ddt.2:	setzm initp	;note we don't want init file run
ddt.1:	.suset [.runame,,runame]  ;get our uname
	setzm logdin	;notice that we are already logged in
	setom pwordp	;and that we were started via PWORD
	jrst ddt.0	;and go do what DDT does!

;CHECK FOR POSSIBILITY THAT OUR UNAME HAS CHANGED, AND HANDLE IT IF IT DID.
;CLOBBERS B.
DDTUNM:	.SUSET [.RUNAM,,B]	;IF UNAME HAS CHANGED SINCE LAST LOOKED,
	CAMN B,RUNAME		;TELL THE USER, AND UPDATE INTERNAL VARS.
	 RET
	SAVE C
	SAVE D
	MOVE D,B
	CALL NUTYP2		;TYPE OUT THE NEW UNAME.
	CALL DDTUN1		;REALIZE THAT UNAME HAS CHANGED.
	REST D
	JRST POPCJ

NUTYP2:	CTYPE 40	;UNAME HAS CHANGED, SAY SO.
	PUSHJ P,SIXTYP
	CTYPE 33
	MOVEI D,"U
	JRST TOUT

;COPY SYSTEM'S VERSION OF UNAME INTO DDT'S VERSION.
;CLOBBERS B, D.
DDTUN1:	.SUSET [.RUNAM,,C]	;LOOK AT CURRENT UNAME, AND UPDATE VARS FROM IT
	.suset [.rxuname,,xuname]
	MOVEM C,RUNAME		;UPDATE ALL DDT'S MEMORIES OF THE UNAME.
	HLRZ B,C		;SET LOGDIN ACC. TO WHETHER WE ARE LOGGED IN.
	CAIE B,-1
	 SETZM LOGDIN
	SAVE C
	SAVE U
	SETZB U,D		;NOW, IF OUR UNAME CHANGED, OUR INFERIORS' DID TOO.
DDTUN7:	SKIPE UUNAME(U)		;LOOK AT JOBS WE KNOW AND FIND THEIR CURRENT NAMES.
	 SKIPN UJNAME(U)
	  JRST DDTUN8		;(DON'T LOOK AT UNUSED JOB SLOTS).
	SKIPGE INTBIT(U)	;FOR PHONY INFERIORS (SYS, PDP6)
	 JRST [	MOVE C,RUNAME
		MOVEM C,UUNAME(U)	;WE KNOW THE UNAME IS SUPPOSED TO CHANGE.
		JRST DDTUN8]
	move b,uind(u)	;get the user index for this job
	syscal OPEN,[ %clbit,,.bii\10  ;open without reowning
		      %climm,,fdrc ? [sixbit /USR/]
		      %climm,,%jsnum(b)	 ;open by job number
		      %climm,,0]  ;with JNAME=0
	  jrst ddtun8		;job nonexistent?? throw up hands.
	move c,[-4,,[ sixbit /UNAME/ ? movem uuname(u)	;get the new UNAME
		      sixbit /JNAME/ ? movem ujname(u)]]  ;and the new JNAME
	syscle USRVAR,[ %climm,,fdrc ? c]

DDTUN8:	ADDI U,USRLNG
	CAIGE U,USREND		;LOOK AT ALL JOB SLOTS.
	 JRST DDTUN7
	REST U
	JRST POPCJ

; Given (in C) the actual LOGIN-NAME, caluclate the XUNAME.
; Assumes you've just come in from PWORD, and if the XUNAME is
; different from the UNAME, don't change it, but do set the HSNAME.
; (The XUNAME can be different when the user said FOOBAR and got FOOBA0)

ddtunp:	camn c,xuname		   ; is the XUNAME different?
	  jrst ddtun0		   ;   no, do the last-digist checking
	move c,xuname		   ; get our real XUNAME
	movem c,tuname		   ; TUNAME starts out normal
	movem c,sndflt		   ; that's our SENDS default too!
	call gethsn		   ; get the HSNAME to use
	  jfcl			   ; Don't care if it's the default or not
	movem c,hsname		   ; just use it as our home directory
	.suset [.shsname,,c]	   ; both internally and in the system
	movem c,thsnam		   ; including for the temporary one
	jrst ddtmsp		   ; put the MSNAME where it goes, too.

;GIVEN (IN C) THE ACTUAL OR DESIRED LOGIN-NAME, CALCULATE THE XUNAME
;FROM IT BY PERHAPS FLUSHING TRAILING DIGIT, AND SET IT UP;
;ALSO SET THE MSNAME AND SOME OTHER SNAMES FROM THE XUNAME.

;ALSO, Set the HSNAME!

;CLOBBERS B, C, D.
ddtun0:	push p,c		;if there is an init file for the real uname,
	call gethsn		;If RJL1 has no HSNAME entry,
	 jrst ddtun9		;  then go compute winning one

	pop p,b
	movem b,xuname		;this UNAME is your "real" name
				;so after RJL1$U, XUNAME is still RJL1, not RJL
	movem b,tuname
	movem b,sndflt		;Make our ^A default our XUNAME
	movem c,hsname
	movem c,thsname
	.suset [.shsname,,hsname]
	jrst ddtmsp		;and hack the HSNAME

ddtun9:	setz b,			;b <- 6*< # chars @ end uname, flushed so far>
	move c,(p)		;-1(p) will have real uname.
	save c			;(p) has result of flushing any trailing digit
	syscal OPEN,[ %climm,,fdrc ? ['DSK,,] ? ['.FILE.] ? [SIXBIT /(DIR)/]
		      (p)]
	 caia
	  jrst ddtun2		;found a name that corresponds to a DSK dir?
ddtun5:	lsh c,(b)		;look at next char from the end
	andi c,77
	movei d,(c)		;remember the character
	JUMPE C,DDTUN4		;IF A SPACE, KEEP GOING FORWARD PAST IT.
	CAIL C,'0
	 CAILE C,'9
	  JRST DDTUN3		;NON-DIGIT => CAN'T IGNORE IT; GIVE UP.
DDTUN4:	SUBI B,6		;LAST CHAR IS SPACE OR DIGIT; FLUSH IT.
	CAMG B,[-44]
	 JRST DDTUN3		;ENTIRE UNAME IS SPACES & DIGITS?? HOPELESS!
	MOVNS B
	LSH C,-6(B)
	MOVNS B
	ANDCAB C,(P)		;FLUSH THAT DIGIT FROM THE END OF THE UNAME,
	jumpe d,ddtun5		;and try again, if that wasn't a non-blank
	call gethsn		;was non-blank, see if real user
	  jrst [ move c,(p)	;  Recover the name so far
		 jrst ddtun5]	;  and try again
	call ddtunh		;save the HSNAME where it belongs
	move c,(p)		;recover the XUNAME
	call ddtxun		;and salt that away where people care
	rest c			;and clean up the stack and exit
	rest b
	ret

DDTUN3:	REST C			;COME HERE TO GIVE UP ON ATTEMPT TO FLUSH
	REST C			;TRAILING DIGITS; USE REAL UNAME UNMODIFIED.
	JRST DDTUN6

ddtunx:	.suset [.rxuname,,c]  ;get the system provided XUNAME
	jrst ddtun6	;otherwise like DDTUN6


ddtxun:	movem c,xuname		;the XUNAME is your "real" name
				;so after FOO1$U, xuname is FOO.
	movem c,tuname
	movem c,sndflt		;Make our ^A default our XUNAME
	.suset [.sxunam,,c]
	ret

DDTUN2:	REST C			;COME HERE ON SUCCESSFUL TRUNCATION;
	REST B			;USE TRUNCATED UNAME (NOW IN C).
DDTUN6:	call ddtxun		;save away our XUNAME where it belongs
	call gethsn		;Convert XUNAME to HSNAME
	  jfcl			;  don't care at this point if default or not
ddtunh:	movem c,hsname		;set home dir
	movem c,thsnam
	syscal USRVAR,[ %climm,,%jself ? [sixbit /HSNAME/] ? c]
	  jfcl
	jrst ddtmsn
	
;; DDTMSP prints out what the home directory is, if it's not the same as
;; the XUNAME, and sets up the MSNAME

ddtmsp: move c,xuname		   ; check the XUNAME
	camn c,hsname		   ; do we have a directory of our own?
	  jrst ddtmsn		   ;   Yes, don't say anything!

	7type [asciz /A[Home dir=/]
	move d,hsname
	call sixtyp	;tell the user what his home directory is
	7type [asciz /]
/]
	call tyofrc
	move c,hsname		   ; recover the directory name again

;SET UP MSNAME FROM SIXBIT WORD IN C.
DDTMSN:	MOVEM C,MSNAM
IRPS X,,PFILE XFILEF WFILE IFILE FFILE opndev
	MOVEM C,X+3
TERMIN
	MOVEM C,LSNAM
	AOSN B,C	;IF NOT ______,
	POPJ P,
	SOJA B,NFDIR1	;PUT IN SNAME SEARCH LIST.

SSTATB:	calblk SSTATU,[
	%CLOUT,,D	;DIETIM
	%CLOUT,,A	;SYSDBG
	%CLOUT,,TEM	;SUSRS
	%CLOUT,,TEM2	;MEM ERRS
	%CLOUT,,TEM3	;TIME
	%clout,,itsnam]	;SIXBIT OF AI OR ML or MC or.

ddtdbm:	asciz /ITS being debugged!
/

;PRINT A SYSTEM-GOING-DOWN MESSAGE.
DDTGDM:	SAVE D
	MOVE D,ITSNAM	;TYPE NAME OF MACHINE - AI, ML OR DM.
	CALL SIXTYP
	REST D
	7TYPE [ASCIZ / ITS going down in /]
	IDIVI D,30.
	PUSHJ P,TMPT
	CALL CRF
	pushj p,fdrcop		   ;open the file
	[sixbit /SYS   DOWN  MAIL/]
	popj p,			   ;  No file
	call ctlf1		   ;print it out
	jrst terpri		   ;newline

MAXSHR:	61			;page # from SYS:TS MACSYM to share with
				;to count MACSYMA's.  Should be different than
				;the one PFTHMG uses!
KSSTAT:	PUSH P,[NLTL2]
KSSTA1:	call terpri
	TSCALL SSTATB
	SKIPE A
	  7TYPE DDTDBM
	JUMPL D,KSSTA2	;NEGATIVE=>FOREVER
	PUSHJ P,DDTGDM
KSSTA2:	MOVE A,TEM
	MOVE D,LOGDIN
	AOSN D
	  AOS A			   ;YOU'RE NOT LOGGED BUT SHOULD COUNT
	caig a,1		   ;you're the only one?
	  jrst [7type [asciz /You're all alone, Fair share = /]
	        jrst kssta3]
	PUSHJ P,G9PNT
	7TYPE [ASCIZ / Lusers, Fair Share = /]
kssta3:	MOVE A,SLOADU		;GET VALUE OF SLOADU IN SYSTEM SYM TAB.
	CALL FETCHA		;READ SLOADU OUT OF SYSTEM.
	 SETZ D,
	MOVEI A,10000.
	IDIVM A,D
	MOVEI W1,10.
	MOVEM W1,TOCTEM
	CALL TOCA		;DECIMAL PRINT 10000/SLOADU, NO PERIOD.
	CTYPE "%
	movsi a,(sixbit /MC/)
	came a,itsnam		;Is this on MC?
	  jrst kssta4		;  No, no MACSYMA's anyway!  Don't do the OPEN
	syscal open,[ %clbit,,.uii ? %climm,,fdrc ? [sixbit /SYS/]
		      [sixbit /TS/] ? [sixbit /MACSYM/]]
	  jrst kssta4		;Not there???
	syscal corblk,[ %climm,,%cbndr ? %climm,,%jself ? %climm,,ipage
					 %climm,,fdrc ? maxshr]	 ;Map in the
				;page 
	  jrst kssta4		;  Eh?  Punt!
	syscal cortyp,[ %climm,,ipage ? %clout,,a ? %clout,,a ? %clout,,a
			%clout,,a]  ;RH(A) gets 1+# of MACSYMA's
	  jrst kssta4		;  Eh?  Punt!!
	syscal corblk,[ %climm,,0 ? %climm,,%jself ? %climm,,ipage]  ;Delete
	  erloss						     ;the page
	.close fdrc,
	movei a,-1(a)		;A gets # of MACSYMA's
	jumpe a,[ 7type [asciz / No MACSYMAs./]
		  jrst kssta4]
	7type [asciz /, /]
	call g9pnt		;Print the # of MACSYMA's
	7type [asciz / MACSYMA/]
	sose a		;unless singular
	  ctype "s	;  make it plural
	ctype ".

kssta4:	SKIPN A,TEM2
	  POPJ P,
	call terpri
	CALL G9PNT
	7TYPE [ASCIZ / memory errors in /]
	MOVE A,TEM3
	IDIV A,[10800.]		;GET NUM HOURS SYS UP, TIMES 10.
	IDIVI A,10.
	SAVE B			;SAVE TENTHS OF HOURS.
	CALL G9PNT		;PRINT # HOURS, A DOT, AND # OF TENTHS.
	REST D
	CTYPE "0(D)
	7TYPE [ASCIZ / hours./]
	RET


;:VERSIO COMMAND - PRINT VERSIO NUMBERS OF DDT AND ITS,
;AND PRINT TTY #, UNAME AND JNAME.
KVERSI:	PUSH P,[NLTL2]
KVERS1:	call terpri		   ;be sure to start on a fresh line
	TSCALL SSTATB	;GET NAME OF SYSTEM (AI OR ML)
	MOVE D,ITSNAM
	CAMN D,[SIXBIT/DM/]
	 SETOM ESSYM	;ON DM, EVAL SYMS IN E&S SYM TAB.
	PUSHJ P,SIXTYP	;PRINT IT.
	STRT [SIXBIT / ITS./]
	.RSYSI D,
	PUSHJ P,SIXTYP
	7TYPE [ASCIZ /. DDT./]
	MOVE D,VERSUN
	PUSHJ P,SIXTYP
	CTYPE ".
	CALL CRF
	MOVE D,LOGDIN
	AOJE D,KVERS2
	MOVE D,RUNAME
	7TYPE [ASCIZ/USR:/]	;NOW PRINT UNAME AND JNAME OF DDT.
	CALL SIXTYP
	CALL TSPC
	.SUSET [.RJNAM,,D]
	CALL SIXTYP
	7TYPE [ASCIZ/, /]
KVERS2:	7TYPE [ASCIZ/TTY /]
	MOVE A,TTYNUM
	JRST G8PNT	;PRINT TTY NUMBER IN OCTAL.

; COLON-COMMAND TABLE; ENTRIES LOOK LIKE
;	SIXBIT/COMMAND/
;	[ASCIZ/DESCRIPTION/],,ROUTINE

DEFINE NCTABE A,B
	SIXBIT/A/
	B+IFB B,A
TERMIN

;IF YOU CHANGE THESE COMMANDS, BE SURE YOU CHANGE .INFO.;DDT :CMNDS
;(AS WELL AS DDTORD >)

NCTAB:	NCTABE 6TYPE,K6TYPE
	NCTABE 8TYPE,K8TYPE
	NCTABE ALARM,,
	NCTABE ALSO,KALSO
	NCTABE ASSIGN,KASSIGN,
	NCTABE ATB,KATB
	NCTABE ATTACH,KATTACH,
	NCTABE CHUNAM,KCHUNA,
	NCTABE CLEAR,KCLEAR,
	NCTABE CONTIN,KCONTIN,
	NCTABE COPY,KCOPYD,
	NCTABE COPYD,KCOPYD
	NCTABE COPYN,KCOPYN
	NCTABE CORBLK,KCORBL
	NCTABE CORPRT,KCORPRT
	NCTABE CORTYP,KCORTYP
	NCTABE CWD,KCWD
	NCTABE DATPRT,KDATPRT
	NCTABE DATWRD,KDATWRD
	NCTABE DDTMOD,KDDTMOD,
	NCTABE DDTSYM,KDDTSYM,
	NCTABE DELETE,KDELETE,
	NCTABE DESIGN,KDESIGN,
	NCTABE DETACH,KDETACH,
	NCTABE DISOWN,KDISOWN,
	NCTABE ELSE,KELSE
	NCTABE ERR,KERR,
	NCTABE EXISTS,KEXISTS,
	NCTABE FJOB,KFJOB
	NCTABE FLAP,KFLAP,
	NCTABE FORGET,KFORGET
	NCTABE GAG,KGAG,
	NCTABE GENJOB,KGENJOB,
	NCTABE GO,KGO,
	NCTABE GZP,KGZP,
	NCTABE HELP,KHELP,
	NCTABE IF,KIF,
	NCTABE INFLS,,
	NCTABE IOPEN,KIOPEN
	NCTABE ICHAN,KICHAN
	NCTABE INPOP,KINPOP,
	NCTABE INPUSH,KINPUS,
	NCTABE INTEST,KINTEST,
	NCTABE INTPRT,KINTPRT,
	NCTABE JCL,KJCL,
	NCTABE JCLPRT,KJCLPRT
	NCTABE JOB,KJOB,
	NCTABE JOBP,KJOBP
	NCTABE JUMP,KJUMP
	NCTABE KILL,KKILL,
	NCTABE LFILE,KLFILE,
	NCTABE LINK,LINK,
	NCTABE LINKF,LINKF,
	NCTABE LINKN,KLINKN
	NCTABE LISTB,KLSTB,
	NCTABE LISTF,,
	NCTABE LISTJ,KLSTJ,
	NCTABE LISTP,KLSTP,
	NCTABE LISTS,SLIST
	NCTABE LISTU,KLSTU,
	NCTABE LJCL,KLJCL
	NCTABE LOAD,KLOAD,
	NCTABE LOGIN,KLOGIN,
	NCTABE LOGOUT,,
	NCTABE LRUN,KLRUN
	NCTABE MAILNT,KMAILNT
	NCTABE MASSAC,,
	NCTABE MONMOD,KMONMOD,
	NCTABE MORE,KMORE,
	NCTABE MOVE,KMOVE
	NCTABE MSGS,,
	NCTABE NEW,KNEW
	NCTABE NEWTTY,KNEWTTY,
	NCTABE NFDIR,KNFDIR,
	NCTABE NOMSG,KNOMSG,
	NCTABE OFDIR,KOFDIR,
	NCTABE OLOAD,KOLOAD,
	NCTABE OMAIL,MAIL,
	NCTABE OMAILA,MAILA,
	NCTABE OMSG,KOMSG
	NCTABE OSEND,OSEND
	NCTABE OUTTES,KOUTTES,
	NCTABE PDUMP,KPDUMP,
	NCTABE PDUMPI,PDUMPI,
	NCTABE PMDATE,KPMDATE
	NCTABE PRGM,KPRGM,
	NCTABE PRINT,KPRINT,
	NCTABE PRMAIL,KPRMAIL,
	NCTABE PRSEND,KPRSEND
	NCTABE PROCED,NCTLP
	NCTABE PROCEE,NCTLP,
	NCTABE RAIDFL,KRAIDF
	NCTABE RAIDRP,KRAIDR
	NCTABE RATE,KRATE
	NCTABE REAP,KREAP
	NCTABE RENAME,KRENAME,
	NCTABE RETRY,KRETRY
	NCTABE RUN,KRUN
	NCTABE SELF,KSELF
	NCTABE SEND,SEND,
	NCTABE SFAUTH,KSFAUT
	NCTABE SFDATE,,
	NCTABE SMDATE,KSMDATE
	NCTABE SFDUMP,KSFDUM
	NCTABE SFREAP,KSFREA
	NCTABE SHOUT,KSHOUT,
	NCTABE SL,KSYMLO
	NCTABE SLEEP,KSLEEP,
	NCTABE SLIST,,
	NCTABE SNARF,KSNARF,
	NCTABE SSTATU,KSSTATU,
	NCTABE START,KSTART,
	NCTABE SYMLOD,KSYMLOD,
	NCTABE SYMADD,KSYMADD,
	NCTABE SYMTYP,KSYMTYP,
	NCTABE TAG,KTAG
	NCTABE TERPRI,KTERPRI
	NCTABE TPL,KTPL,
	NCTABE TPLN,KTPLN,
	NCTABE UINIT,KUINIT,
	NCTABE UJOB,KUJOB
	NCTABE UNPURE,KUNPURE,
	NCTABE V,KV,
	NCTABE VERSIO,KVERSIO,
	NCTABE VK,KVK,
	NCTABE VP,KVP,
	NCTABE WALBEG,KWALBEG,
	NCTABE WALEND,KWALEND,
	NCTABE WALLP,KWALLP,
	NCTABE XFILE,,
	NCTABE ?,QSN,
NLCOM==.-NCTAB

	BLOCK 4		;FOR PATCHING


RRFLB:	MOVEI C,UFILE(U)	;USE $L FILENAME.
	JUMPL U,QJERR
	; drops through to RRFL1

;; CALL THESE ONLY AFTER CALLING GSOA, UNLESS IN A COLON-CMD.
;; SET GSONUM IFF SHOULDN'T RE-READ PREVIOUS CHAR.
;; SET GSDNUM IFF SHOULD CLOBBER ^K-DEFAULTED SYS: OR SYS1; TO DSK:<MSNAME>;
;; GSENUM USED AS A FILENAME COUNTER.
;; GSFNUM SET WHEN DEVICE IS SPEC'D, TO PREVENT CLOBBERAGE TO DSK BY ";".
;; FLAG FLDEV SET READS DEV & SNAME ONLY (FOR :LISTF)
;; ON RETURN, FLNEGE IS SET IFF SNAME WAS EXPLICITLY SPEC'D.

RRFL1:	TLZA F,FLDEV
RRFL4:	 TLO F,FLDEV	;JUST READ IN DEV & SNAME.
	TLZ F,FLNEGE
	PUSH P,B	;FILENAME ADDRESS IN C.
	PUSHJ P,RFL9
	CAIN C,NCTLTF	;DON'T SET ^F DIR IN ^T, ^U.
	JRST POPBJ
	SKIPN A,3(C)
	 MOVE A,LSNAM	;IF SNAME WASN'T SPEC'D EVER, USE DEFAULT.
	MOVEM A,LSNAM
	MOVEM A,3(C)
	.SUSET [.SSNAM,,LSNAM]	;GET SET FOR OPENING.
	CAIE C,PFILE
	 JRST RRFL5
	MOVEM A,FFILES
	MOVE D,(C)	;WHEN DIRECTORY OF PFILE IS SET, SET IT FOR ^F TOO.
	MOVEM D,FFILE
	JRST RRFL5

RRFL3:	SAVE B
RRFL5:	MOVSI B,-SNLLEN	;ADD SNAME TO SNLIS1.
	MOVE D,A
RRFL2:	EXCH A,SNLIS1+1(B)
	CAME A,D	;FLUSH EXISTING OCCURRENCE.
	AOBJN B,RRFL2
POPBJ:	POP P,B
	POPJ P,

RFL9:	PUSH P,C
	MOVE A,GSCHRP
	HRRZ B,GSCHRA
	SKIPN GSONUM	;UNLESS CALLER SAID SHOULDN'T,
	 CAIN B,(A)
	  JRST RFL0	;OR NO CHARS READ YET,
	TLO F,FLUNRD	;RE-READ PREV. CHAR. IN CASE $ OR CR.

;DROPS THROUGH.

;DROPS THROUGH.
;READ IN A LINE AND PROCESS IT.
RFL0:	MOVEI B,RFLFN1-1	;SAVE DEFAULT FN1, FN2 FOR ^X, ^Y.
	MOVE C,(P)
	PUSH B,1(C)
	PUSH B,2(C)
	SETZM GSFNUM	;DEVICE HASN'T BEEN SPEC'D.
	SETZM GSENUM	;NEXT NAME WILL BE FN1.
	MOVE B,GSDNUM
	PUSHJ P,RLINEX	;READ UP TO CR OR ALTMD.
	JUMPE B,RFL1	;IF SHOULD CLOBBER SYS: TO DSK:,
	AOSE UFLSYS(U)	;DID ^K DEFAULT THE NAME?
	 JRST RFL1
	MOVSI B,'DSK	;YES, RESET TO DSK:<MSNAME>;
	MOVEM B,UFILE(U)	;SO USER WON'T ACCIDENTALLY DUMP ON SYS:
	MOVE B,MSNAM
	MOVEM B,UFILES(U)
RFL1:	PUSHJ P,RTOKEN	;READ 1 NAME.
	MOVE C,(P)
	PUSHJ P,RFLTN1	;EVERYTHING ELSE STORES PRECEDING NAME NORMALLY.
	CAIE D,^Y
	CAIN D,^X	;^X, ^Y THEN STORE ONE OF THE DEFAULT NAMES.
	JRST RFLCTX
	CAIE D,",
	CAIN D,^M	;THESE END ENTIRE SPEC.
	JRST POPCJ
	CAIN D,33	;ALTMODE - TYPE FILE SPEC'D, ASK FOR MORE.
	JRST RFLALT
	JRST RFL1	;ELSE JUST GET ANOTHER NAME.

;HANDLE THE NAME IN B
RFLTN1:	CAIN D,":
	 JRST RFLNC	;TERMINATED BY : => IT IS DEV NAME.
	CAIN D,";
	 JRST RFLNSC	;BY ; => IT IS SNAME.
RFLTND:	JUMPE B,CPOPJ	;DO NOTHING WITH NULL NAME.
	AOS A,GSENUM	;ELSE STORE IT AS NEXT NAME IN NORMAL SEQUENCE.
	TLNE F,FLDEV	;(BUT IF WE'RE JUST READING A DEV AND SNAME,
	 JRST RFLNSC	;STORE IT AS THE SNAME)
RFLSND:	JUMPE B,CPOPJ	;STORE A NAME AT A SPECIAL PLACE.
	CAIN A,4
	 TLO F,FLNEGE
	XCT RFLTAB-1(A)		;THE PLACE IDX SHOULD BE IN D.
	 CAIE C,UFILE(U)	;IF STOREING INTO $L DEFAULT,
	  RET			;(NOTE RFLTAB MAY SKIP TO HERE)
	MOVEI C,IFILE
	XCT RFLTAB-1(A)	;STORE INTO ALTERNATE ALSO.
	MOVEI C,UFILE(U)
	POPJ P,

RFLTAB:	MOVEM B,1(C)	;STORE THE FN1
	MOVEM B,2(C)	;STORE THE FN2
	CALL RFLTDV	;STORE THE DEV
	MOVEM B,3(C)	;STORE THE SNAME.
	SOSA B,GSENUM

RFLTDV:	MOVEM B,(C)
	SETOM GSFNUM
	CAIN C,UFILE(U)
	 SETZM UFLSYS(U)
	RET

RFLCTX:	MOVE B,RFLFN1-^X(D)	;GET DEFAULT FN1 OR FN2.
	PUSHJ P,RFLTND	;STORE IT IN NORMAL SEQUENCE.
	JRST RFL1

;SET THE SNAME, MAYBE DEFAULT DEV. TO DSK.
RFLNSC:	MOVEI A,4	;TELL RFLSND TO STORE SNAME.
	PUSHJ P,RFLSND
	SKIPE GSFNUM	;IF THE DEVICE WASN'T EXPLICITLY SPEC'D,
	 POPJ P,
	LDB B,[301400,,(C)]
	CAIE B,(SIXBIT / * /)
	CAIN B,' DK	;AND DOESN'T USE THE SNAME,
	POPJ P,
	CAIE B,' AI
	CAIN B,' ML
	POPJ P,
	CAIE B,' CL
	CAIN B,' PK
	POPJ P,
	CAIE B,' P0
	CAIN B,' D0
	 RET
	CAIE B,' MC
	CAIN B,' DM
	 RET
	CAIE B,' MX
	CAIN B,' MD
	 RET
	CAIE B,' KS
	CAIN B,' KL
	 RET
	cain b,' DN	;DNRF
	  ret
	MOVSI B,'DSK	;SET THE DEV. TO DSK.

;COLON, SET DEV.
RFLNC:	MOVEI A,3
	JRST RFLSND

RFLALT:	SKIPN B,3(C)
	 MOVE B,LSNAM	;GET THE SNAME TO BE USED.
	MOVEI A,(C)
	CALL CRF
	SAVE C
	CALL LFILE0	;PRINT THE FILE SPEC'D.
	REST C
	CALL LCT
	CALL GSOT
	JRST RFL0

RLINEC:	MOVEI D,200000	;READ LINE, STOPPING ON CR OR ^C OR ^_
	HRLM D,(P)
	JRST RLINE1

RLINEX:	MOVEI D,400000	;READ LINE, STOPPING ON ALTMODE OR CR.
	HRLM D,(P)
	JRST RLINE1

;FORCE RUBOUT-PROC. TILL END OF LINE
RLINE:	HRRZS (P)	;DON'T STOP ON ALTMODE.
RLINE1:	PUSH P,F	;SAVE FLUNRD.
	PUSHJ P,GSOC
	PUSH P,GSCHRP
RLINE2:	JSP W2,RCH
	CAIN D,^M
	JRST RLINE0	;ALWAYS STOP ON CR.
	MOVE W2,-2(P)
	CAIE D,^C
	 CAIN D,^_
	  TLNN W2,200000	;MAYBE STOP ON ^C OR ^_
	   CAIA
	    JRST RLINE0
	SKIPGE -2(P)
	CAIE D,33
	 JRST RLINE2	;MAYBE STOP ON ALTMODE.
RLINE0:	MOVE D,GSCHRP
	MOVEM D,GSCHRQ	;RE-PROCESS CHARS.
	POP P,GSCHRP	;STARTING WHERE WERE AT CALL.
	POP P,D
	TLZE D,FLUNRD
	TLO F,FLUNRD
	TLO F,FLRUB
	JRST GSOD	;UN-GSOC.


;Read 6BIT name into B, get machine in A, handling rubouts normally.
;handles FOO@MC or FOO%MC.
;Returns terminating character in D.

rmtoke:	setom ratflg	;note we want @ and % to terminate tokens
rmtok0:	call rtoken	;read the token
	skipn toktrm	;if no CR typed
	  jumpe b,rmtok0  ;and nothing read, keep reading
	caie d,"@
	  cain d,"%
	    jrst rmtok1
	setzm ratflg
	ret

rmtok1:	push p,b	;remember the user we got
rmtok2:	call rtoken	;get the machine we want
	move a,b	;machine goes in A
	pop p,b		;recover the user
	setzm ratflg
	ret

;READ 6BIT NAME INTO B, CLEAR A, HANDLING RUBOUTS NORMALLY.
;returns terminating char in D

RTOKEN:	PUSHJ P,GSOC	;TEMPORARY FAILURE-POINT FOR RUBOUT.
	CLEARB A,B
	MOVE C,[440600,,B]

RTOK2:	JSP W2,RCH	;READ CHAR, GO TO RTOK2 LOOP.
	CAIN D,^Z	;If we read a ^Z
	 JRST NCTLD	;  cancel all (like ^D).
	CAIN D,^S
	  JRST RTOK2
	caie d,"@	;these indicate mail/send on other machine sometimes
	  cain d,"%
	    jrst [skipe ratflg	;are we terminating on these?
		    jrst rtokx2	 ; yes!
		  jrst rtok3]  ;nope
rtok3:	caie d,^J
	  CAIN D,^M	;THESE TERMINATE & SET TOKTRM.
	    JRST RTOKX1
	CAIE D,":
	  CAIN D,";	;THESE TERMINATE, CLEAR TOKTRM.
	JRST RTOKX2
	CAIE D,^X
	  CAIN D,^Y
	    JRST RTOKX2
	CAIE D,33
	  CAIN D,^I
	    JRST RTOKX2
	CAIE D," 
	  CAIN D,",
	    JRST RTOKX2
	CAIN D,^Q	;^Q QUOTES CHAR.
	  JSP W2,RCH
	CAIL D,140
	  SUBI D,40	;UPPER CASE _ LOWER CASE.
	SUBI D,40
	TLNE C,770000	;PUT 6BIT CHR IN WD UNLESS WD FULL.
	IDPB D,C
	JRST RTOK2

RTOKX1:	SETOM TOKTRM
	TDZA A,A
RTOKX2:	SETZB A,TOKTRM
	JRST GSOD	;UNDO CALL TO GSOC.


;read in an expression, doing syllable-rubout, reads into A, sylable type in B
;skips unless rub back out of ronum.
ronum:	skipe toktrm	;if already saw a ^M, arrange to
	setom unrchf	;return null but will skip.
	pushj p,gtval
	 tlne c,4	;xcted by GTVAL
	popj p,		;fail if rub back out of GTVAL.
	move a,arg1	;pick up the value
	move b,arg1+1	;and it's type
	jrst cpopj1	;and skip return

;READ CHAR FROM INPUT, OR REPROCESS CHAR. CALL WITH JSP W2,
;CHARACTER RETURNED IN D.  CLOBBERS A.
RCH:	PUSHJ P,SLRPIN	;GET CHAR
	CAIN D,^D
	  JRST NCTLD	;^D - CANCEL ALL.
	CAIN D,^L	;^L - RETYPE CHARS READ SO FAR.
	  JRST SLRPCL
	CAIE D,177
	  JRST (W2)
SLRPDL:	MOVE A,GSCHRP	;GOT A RUB OUT
	PUSHJ P,DBP
SLRPD0:	CAMN A,GSOCRP	;IF PAST GSOC CALL'S PTR,
	  JRST SLRPD1	;FLUSH GSOC, USE GSOA'S FAILURE POINT.
	LDB D,A
	CALL RUBCHR	;RUB THE CHARACTER IN D OUT ON THE SCREEN.
SLRPD3:	PUSHJ P,DBP	;FLUSH THE CHAR BEING RUBBED (OR THE ^L, IF HERE FROM SLRPC2).
SLRPD4:	MOVEM A,GSCHRQ
	TLO F,FLRUB
	PUSHJ P,GSOB	;INIT BUFFER FETCHING.
	JRST SLRPD2	;RETURN TO AFTER CALL TO GSOA OR GSOC.

;; Come here to flush from non-GSOC-rubout-processed stuff.
rubflo:	skipe bughed	;if we've flushed the original input with a header
	  call slrpfx	;  redisplay everything
rubfls:	move a,gschrp
SLRPD1:	PUSHJ P,GSOD	;UN-GSOC.
	HRRZ C,GSCHRA
	CAIE C,(A)
	  JRST SLRPD0	;NOT AT BUFFER BEG.,RETRY.
	SOS GSOCRT	;ALL RUBBED, RETURN AFTER GSOA NON-SKIPPING, WITH 177 IN D.
SLRPD2:	MOVE P,GSOCPP	;RESTORE P AT CALL TO GSOC OR GSOA,
	JRST @GSOCRT	;RETURN (NORMALLY SKIPPING).

slrpcl:	call slrpff	;do redisplay stuff
slrpc2:	pushj p,gsod	;make sure start from very beginning.
	move a,gschrp	;flush the ^L from the buffer,
	tlo f,flctll
	jrst slrpd3	;go back up and abort back to re-process

slrpfx:	call terpri	;always terpri if we've flushed the header
	jrst slrpf0
slrpff:	skipn getty	;on datapt, screen was cleared by echo
	  call terpri	;printing tty, crlf instead.
slrpf0:	SETOM RADCLR
	CALL RADDTC	;REDISPLAY THE RAID REGISTERS IF APPROPRIATE.
	CALL GSOPOS	;GSOVPS AND GSOHPS GET CURRENT CURSOR POSITION.
	MOVE I1,FLDTBP
	ADD I1,[1,,]	;PTR TO NEXT FROB TO TYPE.
SLRPC0:	CAML I1,W4
	JRST SLRPC1	;AFTER ALL THE FROBS, TYPE CHARS IN BUFFER.
	MOVE A,1(I1)	;ELSE RETYPE THE NEXT FROB
	MOVE C,2(I1)	;(IN ORDER TYPED IN)
	ADD I1,[2,,2]
	SUB I1,FLDTBP	;(IN CASE FLD TAB MOVES)
	SAVE I1
	PUSHJ P,GFROBP
	REST I1
	ADD I1,FLDTBP
	JRST SLRPC0

SLRPC1:REPEAT NARGS,[
	MOVE A,ARG1+2*.RPCNT	;GET THE NEXT ARG, PRINT IT.
	SKIPN C,ARG1+1+2*.RPCNT
	  popj p,		;NULL ARG => NO MORE ARGS.
IFN .RPCNT,7TYPE [ASCIZ/, /]
	PUSHJ P,GFROBP
]
	ret

;; retype the contents of the GSOC buffer (for sake of BGREAD redisplay
;; processing, until the two schemems are combined)

gsocff:	push p,a
	push p,d
	push p,c
	push p,w1
	push p,b
	call slrpff	;type any saved up frobs (like ":")
	move a,gschra
	hrli a,010700	;A <= pointer to start of GSOC buffer
gsocf0:	camn a,gschrp	;Is this the end of the buffer?
	  jrst gsocf1
	ildb d,a	;get a character
	call toutec	;and type it
	jrst gsocf0
gsocf1:	pop p,b
	pop p,w1
	pop p,c
	pop p,d
	pop p,a
	ret


;assuming that D holds the char on the screen before the cursor,
;erase it or echo it.  may set FLCTLL meaning must retype whole line.

rubchr:	skipn erase	;erasable?
	  jrst toutec	;  on others, must just echo the rubbed character.

	caie d,33
	  cail D,40
	    cain d,177	;rubout and ctl chars can't be erased except by
	   jrst slrpd5	;  retyping whole syl.
	7type [asciz /X/]  ;other chars, just erase 1 backward.
	RET

SLRPD5:	MOVEI D,^P	;IF CAN'T USE ^PX, MUST RETYPE WHOLE SYL.
	CALL TYOFI1	;SO RESTORE THE HPOS REMEMBERED (BY GSOA) FROM START OF SYL.
	MOVEI D,"H
	CALL TYOFI1
	MOVE D,GSOHPS
	ADDI D,10
	CALL TYOFI1
	move b,ttyopt	;get info on what our TTY can do
	TLNN B,%TOMVU	;RESTORE VPOS TOO IF THAT WORKS ON THIS TTY.
	 JRST SLRPD7
	MOVEI D,^P
	CALL TYOFI1
	MOVEI D,"V
	CALL TYOFI1
	MOVE D,GSOVPS
	ADDI D,10
	CALL TYOFI1
slrpd7: skipe erase
	  7type [asciz /L/]	;clear rest of 1st line if that's possible.
	tlo f,flctll	;then re-read and re-type rest of syllable.
	ret

;READ CHAR OF FROB, LIKE RCH BUT DON'T CHECK FOR ^L, ^D, RUBOUT.
SLRPIN:	TLZE F,FLUNRD	;MAYBE RE-READ PREVIOUS CHAR, DON'T ECHO IF ^L'ING.
	 JRST [LDB D,GSCHRP ? RET]
	TLNE F,FLRUB
	 JRST SLRPIM
	SKIPL GTMALT	;IF $< LEFT SOME CHARS, READ THEM.
	 JRST SLRPI2
	CALL IN
	SKIPN UNRCHF	;IF CHAR WE JUST READ WAS A REPROCESSED CHAR THAT
	 SKIPN UNECHF	;SHOULDN'T RE-ECHO, DON'T DO THE SPECIAL ECHOING STUFF
	  CAILE D,^J	;FOR TAB AND LF. (SAVES SOME TIME AND COSTS NO MORE)
	   JRST SLRPI4
	CAIN D,^J
	 JRST SLRPI5
	CAIE D,^I	;WE HAVE TABS AND LF'S SET UP NOT TO ECHO
	 JRST SLRPI4
SLRPI5:	HRRZ A,GSORET	;BUT IN FACT, WE WANT TO ECHO THEM EXCEPT WHEN THEY
	CAIN A,ALTAM1
	 JRST SLRPI4
	CAIE A,GTFRPC	;APPEAR AS SYLLABLES IN THEMSELVES.
	 CALL TOUT	;WHEN WE ECHO THEM, LPT THEM TOO.
SLRPI4:	HLRE A,GSCHRA
	MOVNI A,3(A)
	ADD A,GSCHRA	;RH HAS ADDR JUST BELOW END OF FROB CHARACTER BUFFER.
	HRLI A,010700
	CAMN A,GSCHRP	;IS BUFFER ALMOST FULL?
	 CALL SLRPJN	;YES, EXTEND IT.
SLRPIQ:	IDPB D,GSCHRP
	POPJ P,

SLRPIM:	MOVE A,GSCHRP	;COME HERE IF RE-PROCESSING AFTER RUBOUT.
	CAMN A,GSCHRQ	;IF NO MORE STUFF TO REPROCESS, START REALLY READING AGAIN.
	 JRST [TLZ F,FLRUB\FLCTLL ? JRST SLRPIN]
	ILDB D,GSCHRP	;ELSE RE-READ & RETURN NEXT CHAR.
	TLNN F,FLCTLL	;IF RE-READING FOR ^L,
	 RET
TOUTEC:	CAIN D,^M	;RE-ECHO THE CHAR - NOTE ^M ECHOES AS CRLF.
	 JRST CRF
	JRST TOUT

SLRPI2:	MOVEI D,33
	SOSL GTMALT
	JRST SLRPI4
	AOS GTMALT
	MOVE A,GTPNTR
	ILDB D,A
	TLNN A,770000
	SETOM GTMALT
	ADDI D,"0
	MOVEM A,GTPNTR
	JRST SLRPI4

SLRPJN:	INSIRP PUSH P,W1 A C D GSCHRA
	HLRE W1,GSCHRA
	MOVNI W1,1(W1)	;CURRENT LENGTH - 1
	ADDM W1,(P)	;ADDRESS OF LAST WORD OF TABLE
	HRRZS (P)	;THAT IS THE PLACE TO ADD MORE WORDS TO THE TABLE.
	MOVEI W1,(P)	;SUPPLY THAT ADDRESS, IN WORD ON STACK, AS ARG TO HOLE
	MOVSI A,-20.	;GET 20. WORDS.
	CALL HOLE0
	MOVSI A,-20.
	ADDM A,GSCHRA	;UPDATE AOBJN TO TABLE, SINCE TABLE IS BIGGER NOW.
	INSIRP POP P,D D C A
	JRST POPW1J

;INITIALIZE RUBOUT PROCESSING, SET UP FAILURE-POINT AFTER CALL.
;FAILS BACK SKIPPING AFTER RUBOUT,
;NON-SKIPPING IF RUBOUT WITH NO CHARS IN BUFFER.
GSOA:	SKIPN A,NCOMNM	;IF RUBOUT BUFFER NOW HOLDS NAME
	JRST GSOA1
	MOVEM A,-1(W4)	;OF A :-CMD BEING EXECUTED,
	MOVEI A,NCOMPT	;REPLACE THE : ON THE FROB STACK WITH A FROB
	MOVEM A,(W4)	;THAT WILL RUB OUT AS : AND THE CMD NAME.
	SETZM NCOMNM	;DON'T DO THAT TWICE FOR SAME COMMAND.
GSOA1:	TLZ F,FLRUB+FLCTLL
	AOS (P)		;SKIP ARG (=RET. ON ALL RUBBED.).
	HRRZ A,GSCHRA
	HRLI A,010700	;B.P. TO END OF 1ST WDD OF FROB CHARACTER BUFFER.
	MOVEM A,GSOCRP
	PUSHJ P,GSOB
	POP P,GSORET	;SAVE RET. ADDR.,
	MOVEM P,GSOPDP	;FOR REST. ON RUBOUT.
	PUSH P,GSORET

;SET UP TEMPORARY FAILURE POINT FOR RUBBING OUT NOT PAST
;WHERE WE WERE AT CALL.
GSOC:	POP P,GSOCRT
	MOVEM P,GSOCPP
	MOVE A,GSCHRP
	MOVEM A,GSOCRP
	CALL GSOPOS	;GSOVPS AND GSOHPS GET CURRENT CURSOR POSITION.
	JRST @GSOCRT

;INIT. RUBOOUT PROC BUFFER.
GSOB:	SETZM TOKTRM
	MOVE A,GSOCRP
	MOVEM A,GSCHRP
GSOB1:	SETZM GSONUM
	MOVE A,[GSONUM,,GSONUM+1]
	BLT A,GSFNUC
	POPJ P,

GSOPOS:	CALL TYOFRC	;DON'T TRY TO READ POS WITH TYPEOUT STILL IN BUFFER.
	MOVE A,GSOVPS	;REMEMBER PREVIOUS "POS OF START OF SYL" IN GSOOVP, GSOOHP
	MOVEM A,GSOOVP	;IN CASE THIS IS A GSOC, SO THAT GSOD CAN GET THEM BACK.
	MOVE A,GSOHPS
	MOVEM A,GSOOHP
	.SUSET [.RTTY,,A]
	JUMPL A,GSOPO1	;DON'T HANG UP IF NO TTY.
	SKIPE TTYFLG	;IF NOT TYPING ON OR READING FROM TTY,
	 SKIPN INPTR	;AVOID TRYING TO USE IT (SO WE WIN IF DON'T HAVE TTY).
	  SYSCAL RCPOS,[%CLIMM,,TYOC ? %CLOUT,,A]
GSOPO1:	   SETZ A,
	HLRZM A,GSOVPS	;SAVE CURSOR POS IN GSOVPS, GSOHPS
	HRRZM A,GSOHPS
	RET

;UNDO A CALL TO GSOC.
GSOD:	PUSH P,A
	HRRZ A,GSCHRA
	HRLI A,010700	;B.P. TO END OF 1ST WDD OF FROB CHARACTER BUFFER.
	MOVEM A,GSOCRP
	MOVE A,GSOOVP
	MOVEM A,GSOVPS
	MOVE A,GSOOHP
	MOVEM A,GSOHPS
	MOVE A,GSORET
	MOVEM A,GSOCRT
	MOVE A,GSOPDP
	MOVEM A,GSOCPP
POPAJ:	POP P,A
	POPJ P,

;TYPE " ", THEN GSOA (CANCEL IF RUB BACK.)
GSOT:	POP P,GSOTRT'
	PUSHJ P,TSPC
	PUSHJ P,GSOA
	 JRST NRBERR
	TLNE F,FLCTLL	;ECHO SPACE FOR ^L.
	 PUSHJ P,TSPC
	MOVE B,(W4)
	MOVE A,-1(W4)
	JRST @GSOTRT

IFN 0,[
FROB:   FORMAT AS FOLLOWS:
EACH FROB IS 2 WDS.
BOTH 0 => NULL FROB.
1ST WD IS VALUE, 2ND WD DECODED TO GIVE TYPE.
2ND WD:  SIGN BIT ON => OPERATOR, 1ST WD IS INFIX ARG.
	BIT 4.8 (O.IFX) => INFIX ARG WAS GIVEN.
	BIT 4.7 (O.IFXD) => IT WAS DECIMAL, NOT OCTAL.
	BIT 4.6 (O.2ALT) => OP HAD EXACTLY 2 ALTMODES.
	BIT 4.5 (O.1ALT) => OP HAD EXACTLY 1 ALTMODE.
	BITS 3.1-3.7 => CHARACTER NAME OF OPERATOR.
	RH => ADDRESS OF WD SAYING WHAT TO DO WITH OPERATOR.
		THIS WORD IS USUALLY IN ONE OF THE DISPATCH TABLES
		 (OPTAB0, OPTAB1, OPTAB2) BUT NEED NOT BE.
		  ITS FORMAT IS DOCUMENTED BEFORE OPTAB0.

SIGN BIT OF 2ND WD OFF => THIS FROB IS SYLLABLE,
  1ST WD USUALLY HAS VALUE (BUT SEE SYMBOL)
BITS 4.6-4.8 GIVE SYLLABLE TYPE (FOR RUBBING IT OUT)
   0  => SPECIAL SYLLABLE, RH HAS RTN TO RETYPE SYLL IF RUBBED.
   1  => OCTAL NUMBER.
   2  => DECIMAL NUMBER.
   3  => FLOATING POINT NUMBER.
   4  => SYMBOL. 3 KINDS:
	BITS 1.1-4.5 OF 2ND WD ALL 0 =>
		UNEVALUATED, 1ST WD HAS SQUOZE.
	BITS 3.1-4.5 ALL 0, RH NOT 0 =>
		EVALUATED FUNNY SYMBOL, RH HAS FUNNYNESS,
		 1ST WD HAS ABSOLUTE PART OF VALUE.
	ELSE BITS 1.1-4.5 HAVE SQUOZE, 1ST WD HAS VALUE.
	SYMBOLS ARE TYPED IN AS UNEVALUATED SYMBOLS,
	BECOME EVALUATED WHEN ANOTHER OP. IS READ UNLESS OP
	 SAYS "INHIBIT EVAL".
	IF AN UNEVALUATED SYMBOL REMAINS UNTIL EFIELD,
	 IT GENERATES AN UNDEF SYM REF.

]

;SYLLABLE TYPES, GO IN LH OF 2ND WD.
SYL==1,,437777
SYLOCT==40000
SYLDEC==100000
SYLFLT==140000
SYLSYM==200000

;OPERATOR FLAGS.

O.==1,,527600
O.1ALT==10000	;1 ALTMODE OPERATOR.
O.2ALT==20000	;2 ALTMODE OPERATOR.
O.IFXD==100000	;DECIMAL INFIX NUMBER.
O.IFX==200000	;ANY INFIX NUMBER.
O.OP==400000	;1 => THIS IS AN OPERATOR.

dd1a:	call terpri
DD1B:	MOVE D,[SCHM,,SCH]
	BLT D,BITF
DD2:	MOVE P,[(-LPDL)PS]
	MOVE W4,FLDTBP
	ADD W4,[1,,]	;1ST WD OF FLDTAB UNUSED FOR FLDPUT'S SAKE.
	MOVEM W4,FLDSTR
	SETZM FLDTRM
	SETZM NCOMNM	;NO :-COMMAND IN PROGRESS.
	SETZM RELCP1	;NO SPECIAL PTR IN SYMTAB SPACE TO RELOCATE.
GBFQJ:	MOVEM P,ERRSTP	;SET UP PDL AN PC
	MOVEI B,GFLDER	;TO RESTORE ON ERRORS.
	MOVEM B,ERRSTL
	AND F,[FLRO\FLST,,]
	SETZM ABCNT
	SETOM GTMALT
GFLDER:	MOVE D,MONMOD	;RESET TEMP. MONIT MODE TO PERM.
	SKIPN FLDTRM	;IF WE ARE IN THE OUTER LEVEL
	 MOVEM D,MONMDL	;(THAT IS, NOT WITHIN GTVAL)
GFLD1:	SETZM UNDEFF	;SAY WE AREN'T JUST AFTER READING AN UNDEFINED SYMBOL.
GFLD1U:			;COME HERE AFTER READING AN UNDEFINED SYMBOL; SQUOZE IN UNDEFF.
	PUSHJ P,EVARGF	;NO LONGER HAVE ARGS EVALLED.
	SETZM UNDFRP	;NO UNDEF REFS NOT HANDLED.
	JUMPL U,GFLD1B
	CAME U,CU	;COMPLAIN IF U ISN'T CU OR CU ISN'T VALID.
	 ERLOSS
	MOVE A,U
	IDIVI A,USRLNG
	CAIGE U,USREND
	 JUMPE B,GFLD1D
	SETOM CU
	ERLOSS
GFLD1D:	HLRE A,JOBSYM(U) ;DEBUGGING CHECK: IF WE HAVE A CURRENT JOB,
	MOVNS A
	ADD A,JOBSYM(U)	;CHECK THAT END OF SYMBOL TABLE ISN'T ABOVE SYMTOP.
	ANDI A,-1
	CAMG A,SYMTOP
	 JRST GFLD1B
	MOVE A,JOBSYM(U)	;SAVE OLD VALUE FOR DEBUGGING.
	HRRZ B,SYMTOP
	HRRZM B,JOBSYM(U)	;IF IT IS, AT LEAST MAKE SURE WE WON'T TRIP THIS CHECK INFINITELY MANY TIMES,
	HRRZM B,PRGM(U)
	 ERLOSS		;THEN RECORD THE LOSSAGE.
GFLD1B:	SKIPN A,TYOUNI
	 JRST GFLD1C
	SETZM TYOUNI	;TYOUNI SHOULD BE 0 EXCEPT DURING --MORE-- PROCESSING.
	ERLOSS

GFLD1C:	MOVS A,LITCNT(U)
	TLNE F,FLRO
	 JRST GFLD1E	;IF NO LOCATION OPEN, AND
	CAME A,LITCNT(U) ;IF A LITERAL IS PENDING (LAST DEFINED NEQ LAST ASKED FOR),
	 SKIPE PATCHL(U) ;AND WE'RE NOT INSIDE A PATCH OR LITERAL NOW, GO DEFINE ONE
	  CAIA
	   CALL LITFIN	;PENDING LITERAL.  WE RETURN INSIDE IT, TO READ CMDS TO DEPOSIT IT.
GFLD1E:	SKIPN MONMDL	;IF LOOPING IN MONIT MODE,
	 JRST GFLD1M
	MOVE A,W4
	SUB A,[1,,]
	CALL RTYIC	;POP VALRET OR XFILE IF NO CHARS LEFT.
	 CAME A,FLDTBP	;MONIT MODE OFF IF SOMETHING IN FROB TABLE
	JRST GFLD1M	;OR IF WITHIN VALRET OR XFILE.
	MOVEI D,":
	MOVEM D,LIMBO	;STICK A COLON IN FRONT OF THE INPUT STREAM.
	SETOM UNRCHF
	SETOM UNECHF	;TYPE IT OUT WHEN READ.
GFLD1M:	PUSHJ P,GTFROB
	TLZ F,FLNNUL\FLPNT
	CAIN D,177
	 JRST GFRUB
GFLD1A:	JUMPE B,GFLD1
	JUMPL B,GFLD3	;JUMP IF OPERATOR
GFLD4:	PUSHJ P,FLDPUT	;PUT AWAY
	JUMPGE B,GFLD1	;NOT AN OPERATOR OR FLUSHED BY FLDPUT

;DROPS THROUGH

;DROPS THROUGH
;AN OPERATOR HAS JUST BEEN READ IN, AND PUSHED BY FLDPUT.
	MOVE W3,C	;OPERATOR
	SETZB C,D	;FOR ADDI A-B HACKS
	TLNN W3,50000	;IF TO BE EXECUTED, OR SET SCH, POP OFF STACK.
	JRST GFLD2A
	POP W4,B
	POP W4,A
GFLD2A:	TLNE W3,20000
	CAMN W4,FLDSTR	;NOTHING ELSE IN FLDTAB TEST
	JRST GFLD2B
	POP W4,D
	POP W4,C
	TLNN W3,40
	JRST GFLD2B
	PUSHJ P,NBITE	;MAKE SYM SIXBIT
GFLD2B:	TLNN W3,200
	JRST GFLD2C
	PUSH P,W3
	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSHJ P,EVARGS
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	POP P,W3
GFLD2C:	TLNN W3,100	;MAYBE CHECK FOR INFERIOR OR (INF. OR SELF).
	JRST GFLD2D
	TLNE W3,2
	SKIPN DDTSW
	PUSHJ P,QIJERR
GFLD2D:	SAVE A
	TLNE W3,400
	PUSHJ P,PLUNK1	;MAYBE DEPOSIT OPERATOR'S ARGUMENT.
	REST A
	SKIPE UNDFRP	;IF HAD UNDEF REFS AND DIDN'T CALL PLUNK1,
NUNDER:	ERSTRT [SIXBIT/ILGL UNDEF SYM?/]
	TLNE W3,40000	;$S, $$S, $C, ETC.?
	 CALL NSETX	;YES, SET SCH FROM RH(W3)
	TLNN W3,10000	;SKIP IF EXECUTE BIT ON
	JRST GFLD1
	PUSH W4,A	;PUT OP TO EXECUTE BACK ON STACK
	PUSH W4,B	;SO ^L WITHIN OP. WILL TYPE IT OUT.
	MOVEI W2,gferr
	MOVEM W2,ERRSTL	;BUT SHOULD REMOVE IT IF ERROR IN OP.
	PUSHJ P,(W3)	;EXECUTE THE OPERATOR,
GFLDE1:	SUB W4,[2,,2]	;THEN REMOVE IT FROM STACK.
	MOVEI W2,GFLDER	;(COMPLICATED INTERACTIONS WITH NCOL)
	MOVEM W2,ERRSTL	;ALREADY GONE, ERRORS SHOULDN'T REMOVE IT.
	SETZM NCOMNM	;NO LONGER HAVE : OF :-CMD ON TOP OF FROB STACK.
	SETZM UNDFRP	;NO UNDEF REFS ANY MORE
	SAVE A
	CALL EVARGF	;NO ARGS ANY MORE.
	REST A
	JRST GFLD1A	;GO PUSH THE FROB (IF ANY) RETURNED BY OP.

gferr:	setz b,
	jrst gflde1

GFLD3:	MOVE C,(B)
	TLNE C,10
	  JRST GFLD6
	SKIPE FLDTRM
	SKIPL C
	SKIPA
	JRST GFLD7
	TRNE C,-1
	JRST GFLD4
GFLD5:	CALL DBGPSH
	MOVEM B,@DBGBFP
	7TYPE [ASCII / OP/]

GFLD6:	SKIPL C
	AOS ABCNT	;<
	SKIPGE C
	SOS ABCNT	;>
	SKIPGE ABCNT
	SKIPN FLDTRM
	JRST GFLD4
GFLD7:	PUSHJ P,FLDPUT
	JUMPGE B,GFLD1
	SUB W4,[2,,2]
	POPJ P,

GTVAL:	PUSH P,FLDSTR
	PUSH P,FLDTRM
	PUSH P,ABCNT
	PUSH P,W4
	PUSH P,F
	PUSH P,ERRSTP	;GBFQJ WILL USE THESE.
	PUSH P,ERRSTL
NGVP==.-GTVAL
	MOVN D,FLDTBP	;MAKE SAVED FLDTAB PTRS BE RELATIVE
	ADDM D,-3(P)	;SINCE FLDTAB CAN MOVE AND EXPAND.
	ADDM D,-6(P)
	SETOM FLDTRM
	MOVEM W4,FLDSTR
GTVAL1:	PUSHJ P,GBFQJ
	XCT @-NGVP(P)
	JRST GTVAL2
	CAIN D,177
	JRST GTVAL3
	MOVE C,B
	CALL GFROBP
	PUSHJ P,NXERR
	JRST GTVAL1

GTVAL3:	SOS -NGVP(P)
GTVAL2:	PUSHJ P,EVARGS
	POP P,ERRSTL
	POP P,ERRSTP
	SKIPE UNDFRP	;UNDEF REFS ILLEGAL IN GTVAL.
	JRST NUNDER
	POP P,F
	MOVE W4,FLDTBP
	ADDM W4,(P)
	ADDM W4,-3(P)
	POP P,W4
	POP P,ABCNT
	POP P,FLDTRM
	POP P,FLDSTR
	JRST CPOPJ2

;INCREMENT THE DEBUG RING BUFFER POINTER.  TO PUSH A WORD, DO
;CALL DBGPSH ? MOVEM AC,@DBGBFP
DBGPSH:	SAVE A
	AOS A,DBGBFP
	CAIN A,DBGBFP
	 SUBI A,DBGBFL
	MOVEM A,DBGBFP
	JRST POPAJ	

;PUSH FROB IN A,B ONTO FROB TABLE.
;IF OPERATOR, RETURN DISPATCH WORD IN C.
;DOESN'T CLOBBER B.  CAN RETURN TO GFLD1U INSTEAD OF TO CALLER.
FLDPUT:	AOBJN W4,FLDPT7	;PUSH A ON FROB STACK,
	MOVEI W1,FLDTBP	;NO ROOM => EXPAND IT.
	SAVE A
	MOVSI A,-FTBLNG
	CALL HOLE0
	MOVN A,[FTBLNG,,FTBLNG]
	ADD W4,A
	ADDM A,FLDSTR	;UPDATE POINTERS IN FROB TABLE.
	REST A
FLDPT7:	MOVEM A,(W4)
	PUSH W4,B
	JUMPGE B,FLDPT0	;UNLESS THIS FROB IS OP. WITH EVAL-INHIBIT,
	MOVE C,(B)
	TLNE C,200000
	POPJ P,	;EVAL INHIBIT
FLDPT0:	LDB A,[400400,,-2(W4)]	;IF PREV. FROB IS UNEVALUATED SYMBOL,
	CAIE A,4
	POPJ P,
	LDB  A,[4000,,-2(W4)]
	JUMPN A,CPOPJ
	MOVE A,-3(W4)
	DPB A,[4000,,-2(W4)]	;EVALUATE IT.
	MOVEM A,SYM
	CAMN A,[SQUOZE 0,.]	;SYMBOL "." IS EVALUATED SPECIALLY.
	JRST FLDPT5
	PUSH P,C
	PUSHJ P,SEVL
	JRST FLDPT2
	HLRZ B,FNYLOC	;GET FUNNYNESS OF SYM, SET BY EVAL.
	JUMPE B,FLDPT1	;IF SYM IS FUNNY,
	DPB B,[4000,,-2(W4)]	;REPLACE NAME BY FUNNYNESS.
FLDPT1:	MOVEM D,-3(W4)
	MOVE B,(W4)	;ALLOW EVAL TO CLOBBER B.
POPCJ:	POP P,C
	POPJ P,

;COME HERE WHEN A SYMBOL BEING EVALLED IS UNDEFINED.
FLDPT4:	7TYPE [ASCIZ /?U/]
	SUB W4,[4,,4]
	MOVEI B,0
	MOVEI A,GFLD1U	;RETURN TO GFLD1U, TO AVOID ZEROING UNDEFF.
	MOVEM A,-1(P)
	MOVE A,SYM
	MOVEM A,UNDEFF	;SET FLAG SO THAT FOLLOWING "?" DOES SPECIAL THINGS.
	REST C
	CAME A,[SQUOZE 0,LOGON]
	 CAMN A,[SQUOZE 0,LOGIN]
	  7NRTYP [ASCIZ /Use :LOGIN (you must type the colon)./]
	came a,[squoze 0,logout]   ;is he losing?
	  camn a,[squoze 0,logoff] ;  Is he REALLY losing?
	    7nrtyp [asciz /Use :LOGOUT (you must type the colon)./]
	CAME A,[SQUOZE 0,HELP]
	 RET
	JRST KHELP

FLDPT5:	MOVE D,[O.OP+".,,[1000,,FLDPT6]]
	MOVEM D,-2(W4)	;REPLACE "." BY AN OPERATOR WITH SAME NAME
	SETZM -3(W4)	;NO INFIX ARG. OPERATOR WILL JRST FLDPT6
	POPJ P,		;FROM EFIELD.

FLDPT6:	HLLZ D,LLOC	;GET FUNNYNESS OF OPEN LOCATION,
	IORM D,FNYLOC	;STICK IN WITH FUNNYNESS OF OTHER SYMS.
	HRRZ C,LLOC	;GET ACTUAL ADDRESS OPEN,
	JRST EFOCTJ	;RETURN OCTAL NUM. TO EFIELD.

FLDPT2:	PUSHJ P,OPLK2
	JRST FLDPT4
	JRST FLDPT1
	JRST FLDPT1

;RUB OUT PREVIOUS SYLL.
GFRUB:	CAMN W4,FLDSTR
	JRST GFRUB3
	POP W4,C
	POP W4,A
	PUSHJ P,GFROBP
	JRST GFLD1

GFRUB3:	SKIPN FLDTRM	;TRYING TO RUB WHEN NO FROBS BUFFERED,
	 JRST NRBERR	;AT TOP LEVEL TYPE ??, TRY AGAIN;
	JRST GSNLRT	;DURING GTVAL, RETURN A NULL SYL.

;PRINT A FROB IN A,C.
GFROBP:	JUMPGE C,GFRUB1	;JUMP IF NOT OPERATOR
	LDB B,[360200,,C]	;GET NUM OF ALTS
	JUMPE B,GFRUB2
	CTYPE 33	;TYPE ALT
	SOJG B,.-1
GFRUB2:	TLNN C,200000
	JRST GFRUB4
	TLNN C,100000
	PUSHJ P,G8PNT
	TLNE C,100000
	PUSHJ P,G9PNT
GFRUB4:	LDB D,[220700,,C]
	PUSHJ P,TOUT
	TLNE C,40000
	PUSHJ P,TOUT
	POPJ P,

GFRUB1:	MOVE D,A	;PUT VALUE OF SYLL IN D FOR TYPEOUT ROUTINE.
	LDB B,[400300,,C]
	PUSH P,C
	PUSH P,[POPCJ]
	XCT GFRUBT(B)
	MOVEM D,(P)	;DIDN'T JUMP => ILLEGAL FROB TYPE.
	ERLOSS 1(P)

GFRUBT:	JUMPN C,(C)
	JRST G8PNT
	JRST G9PNT
	JRST TFLOT
	JRST GSPNT
REPEAT 3,JFCL

TMSQ:	;SQUOZE TYPEOUT MODE.
D5PNT:	MOVEI C,0
G5PNT:	CTYPE 33
	PUSH P,D
	LDB A,[400400,,D]
	LSH A,2
	PUSHJ P,G8PNT
	POP P,D
	CTYPE "&
	JRST GSPNT1

GSPNT:	TLNN C,37777
	TRNN C,-1
	JRST GSPNT1
	HRLI D,(C)	;EVALUATED FUNNY SYMBOL.
	JRST PAD

GSPNT1:	MOVE B,CJTOUT
	MOVEM B,SPTS
	TLZ D,%SYFLG
	TDNN C,[37777,,-1]
	JRST SPT1
	LDB D,[4000,,C]
	JRST SPT1

TMA:	;ASCII TYPEOUT MODE. ALSO, RUB OUT ASCII SYL.
D7PNT:	MOVE C,D
	CTYPE 33	;ALTMODE
	MOVEI D,"0	;0 OR 1 DEPENDING ON LOW BIT OF WD
	TRZE C,1
	 IORI D,1
	CALL TOUT
	CTYPE ""
G7PNT2:	SETZ D,
	ROTC C,7	;GET NEXT CHAR.
	CAIE D,"^	;UPARROW AND ^Q MUST BE QUOTED.
	CAIN D,^Q
	 JRST [CTYPE ^Q ? JRST G7PNT4]
	CAIE D,177	;RUBOUT PRINTS AS UPARROW-QUESTIONMARK.
	 CAIGE D,40
	  JRST G7PNT3	;CTL CHARS TREATED SPECIALLY.
G7PNT4:	PUSHJ P,TOUT
	JUMPE C,G7PNT1	;OMIT TRAILING ^@'S.
	JRST G7PNT2

G7PNT3:	CTYPE "^
	XORI D,100
	JRST G7PNT4

TM6:		;SIXBIT TYPEOUT MODE, ALSO RUBOUT 6BIT SYL.
D6PNT:	7TYPE [ASCIZ/1'/]
	PUSHJ P,SIXTYP
G7PNT1:	MOVEI D,33
	JRST TOUT

;EVALUATE ARGUMENTS
EVARGS:	PUSH P,ERRSTP	;EFIELD WILL SET THESE UP.
	PUSH P,ERRSTL
	SETZM PSTATE	;NOT INSIDE BRACKETS OR PARENS.
	SETZM FNYLOC	;REINIT ACCUMULATION.
	SETZM UNDFRP	;NO UNDEF REFS IN THE ARGS YET.
	PUSHJ P,EVARGF	;FLUSH THE OLD ARGS.
	MOVEI W3,W3
	MOVEM W3,RELCP1	;RELOCATE W3 (IN CASE HAKKAH MOVES FROB TAB)
	MOVE W3,FLDSTR
EVARG1:	PUSHJ P,VEARG
	JUMPE B,EVARG3
	MOVNI C,NARGS*2-2
EVARG2:	SKIPE ARG1+1+NARGS*2-2(C)
	AOJLE C,[AOJA C,EVARG2]
	JUMPG C,EVARG4
	MOVEM A,ARG1+NARGS*2-2(C)
	MOVEM B,ARG1+1+NARGS*2-2(C)
	JRST EVARG1

EVARG4:	MOVE C,[ARG1+2,,ARG1]
	BLT C,ARG1+1+NARGS*2-4
	MOVEM A,ARG1+NARGS*2-2
	MOVEM B,ARG1+1+NARGS*2-2
	JRST EVARG1

EVARG3:	MOVE W4,FLDSTR
	MOVSI A,600000	;CLEAR UNUSED FUNNYNESS BITS.
	ANDM A,FNYLOC
	POP P,ERRSTL
	POP P,ERRSTP
	SETZM RELCP1	;W3 SHOULD NO LONGER BE RELOCATED.
	POPJ P,

EVARGF:	SETZM ARG1
	MOVE A,[ARG1,,ARG1+1]
	BLT A,ARG1+2*NARGS-1
	POPJ P,

;EVALUATE SINGLE ARGUMENT
;SP 1 3
;COMMA 2 4
;I2 HOLDS 0 BEFORE 1ST FIELD;
;1 BEFORE 2ND, IF 1ST ENDED IN SPACE;
;2 BEFORE 2ND, IF 1ST ENDED IN COMMA;
;3 AFTER 2ND FIELD.
VEARG:	SETZM VALUE
	SETZB I2,VALUE+1
	SETZM PVALUE
	SETZM VALUEQ
	SETOM VALUER
VEARG1:	CAML W3,W4	;IF NO FROBS LEFT, NO ARG.
	 JRST GSNLRT
	SKIPL A,2(W3)	;IF 1ST FROB IS OPERATOR,
	 JRST VEARG2
	MOVE A,(A)	;IF IT'S A SPACE,
	CAME A,[100000,,1]
	 JRST VEARG2
	ADD W3,[2,,2]	;SKIP IT AND TRY AGAIN.
	JRST VEARG1

vearg2:	setzm undefp
	MOVEM I2,STATE
	save errstp		   ;Since EFIELD doesn't do this itself
	save errstl		   ;we do it for it!
	PUSHJ P,EFIELD	;GET FIELD VALUE
	 SKIPA D,[100000,,3]
	  MOVE D,(D)
	rest errstl
	rest errstp
	MOVE I2,STATE
	JUMPN I2,VEARG4	;JUMP IF NOT THE 1ST FIELD.
	IORM A,VALUE
	PUSHJ P,VERGNM
	MOVEI I2,2	;2 => COMMA
	TRNN D,1
	 JRST VEARG8
	HRRZ B,D
	CAIN B,3
	 JRST [	SKIPN VALUE+1
		 JRST VERG8A
		SKIPN VALUE	;FIELD TERMINATOR; IF ONLY 1 FIELD AND WAS 0,
		 HLLZS VALUER	;IT SPECIFIES THE ADDRESS FIELD.
		JRST VERG8A]
	MOVEI I2,1	;1 => SPACE
	setzm undefp		   ;undefineds are legal before a space
	MOVSI B,777000	;A ZERO BEFORE A SPACE IS CONSIDERED TO SET THE OP-CODE
	SKIPN VALUE
	 ANDCAM B,VALUER
VEARG8:	HRRZ B,D
	CAIG B,2
	 JRST VEARG2	;FIELD TERM

VERG8A:	MOVE A,PVALUE
	MOVEI B,0
	MOVSS A
	ROTC A,18.
	ADD A,VALUE
	ADD B,VALUE
	HRR A,B
	MOVE D,UNDFRP	;IF THERE ARE ANY UNDEFINED SYMBOLS IN THE VALUE,
VERG3A:	JUMPLE D,VERG3B	;COUNT EACH ONE AS SPECIFYING (FOR $>'S SAKE)
	HLRZ B,UNDFRL-1(D) ;THE HALFWORD IT IS SUPPOSED TO GO IN.
	SKIPN B
	 HLLZS VALUEQ
	SKIPE B
	 HRRZS VALUEQ
	SUBI D,2
	JRST VERG3A

VERG3B:	MOVE B,VALUER	;THOSE FIELDS THAT HAVE BEEN SPEC'D IN THE ARGUMENT,
	ANDM B,VALUEQ	;IGNORE IN THE DEFAULTS FROM THE $> IF ANY.
	TLNN A,700000	;GET THE OPCODE FROM THE NEW VALUE
	 SKIPA B,VALUEQ	;OR IF NONE THERE, FROM THE OLD.
	  MOVE B,A
	TLC B,7^5	;IF WE ARE HACKING AN I/O INSN, USE A DIFFERENT SET OF FIELDS.
	MOVEI D,7^5
	SKIPE KS10IO
	 MOVEI D,777^3
 	TLNN B,(D)	;SKIP IF NOT KA I/O INSTRUCTION
	 SKIPA B,[-5,,5]
	  MOVSI B,-5	;NOW LOOK AT EACH FIELD OF THE WORD, AND DEFAULT
VEARG3:	MOVE D,VEARG7(B) ;ANY FIELD WHICH WE DON'T KNOW TO HAVE BEEN SPEC'D
	AND D,VALUEQ	;TO THE "OLD" VALUE IN VALUEQ, SET BY $> IF THERE WAS ONE.
	TDNN A,VEARG7(B)
	 IOR A,D	;ANY NONZERO FIELD WE KNOW WAS SPEC'D.
	AOBJN B,VEARG3	;IN A FIELD IS OTHERWISE DETERMINED TO HAVE BEEN SPEC'D,
	MOVEM A,VALUE	; THE FIELD IN VALUEQ IS ZEROED.
	SKIPN B,VALUE+1	;WORD TERM
	MOVSI B,SYLOCT
	MOVEM B,VALUE+1
	POPJ P,

VEARG7:	777000,,;OP CODE
	0 17,0	;AC FIELD
	@	;INDIRECT BIT
	(17)	;INDEX FIELD
	,,-1	;ADDRESS
;FIELDS FOR I/O INSNS
	700340,,;OP CODE
	77400,,	;DEVICE
	@	;INDIRECT BIT
	(17)	;INDEX FIELD
	,,-1	;ADDRESS FIELD

;COME HERE FOR FIELD OTHER THEN 1ST. VALUE IS IN A, TYPE IN B.
VEARG4:	CAIN I2,3
	 JRST VEARG5	;NOT 2ND FIELD EITHER => ADD TO RH.
	CAME D,[100000,,2]
	 JRST VERG5B	;JUMP FOR SECOND FIELD AND NOT FOLLOWED BY COMMA.
	CAIE I2,1	;SKIP IF "FOO A,"; DON'T SKIP IF "FOO,A," OR "FOO,,".
	 JRST VEARG6
	skipe undefp
	  jrst nunde1
	SETCM I4,VALUE
	CALL VERG5D	;PUT VALUE OF THIS FIELD IN RIGHT PART OF WORD.
	ADDM A,VALUE
	JRST VERG5A

nunde1:	move w4,fldstr		   ;First clear off the FROB stack
	jrst nunder		   ;and then give the error

;GIVEN THE 1'S COMPLEMENT OF AN INSN IN I4, PUT THE VALUE IN A,B INTO THE
;AC FIELD OR THE DEVICE CODE FIELD ACCORDING TO WHETHER THE INSN IS AN I/O INSN.
;IF B INDICATES EXPLICITLY SPEC'D FIELD, SET VALUER TO REMEMBER THAT.
;LEAVES VALUE (SHIFTED APPRO.) IN A.  CLOBBERS I4.

VERG5D:	SKIPN KS10IO
	 TLZA I4,77000	;KA/KL HAVE MORE I/O INSTRUCTIONS
	  TLC I4,77000	;KS HAS APR, PI ONLY IN KA FORMAT
	TLNN I4,777000
	 JRST VERG5F
	ANDI A,17
	LSH A,27
	SKIPE B
	 DPB A,[270400,,VALUER]	;AC FIELD EXPLICITLY SPEC'D; PREFER SPEC'D ONE
	RET			;EVEN IF IT'S 0, IN CASE OF $>'ING.

VERG5F:	LDB I4,[900,,A]	;IO INST
	ANDI I4,774
	AND A,[077400,,]
	LSH I4,30
	IORB A,I4	;WIN FOR DEVICE CODES
	SKIPE B
	 DPB A,[320700,,VALUER]
	RET

;2ND FIELD, NOT FOLLOWED BY COMMA.
VERG5B:	CAIE I2,2
	 JRST VEARG5	;"A FOO" - "A" DOESN'T GO IN AC FIELD.
	SETCM I4,VALUEQ	;"A,FOO" FORMAT.
	EXCH A,VALUE	;SAVING FOO, GET A AND SHIFT IT TO RIGHT PLACE IN WORD.
	EXCH B,VALUE+1
	CALL VERG5D
	EXCH A,VALUE	;STORE IT BACK AND GET FOO AGAIN.
	EXCH B,VALUE+1
;COME HERE FOR FIELD OTHER THAN 1ST, TO ADD TO RH OF WORD.
VEARG5:	setzm undefp	;undefineds are legal here
	SKIPE B		;EXPLICIT "0" GOING INTO R.H. OVERRIDES $> DEFAULT.
	 HLLZS VALUER
	HRRZS A
	ADD A,VALUE
	HRRM A,VALUE
VERG5A:	PUSHJ P,VERGNM
VERG6A:	MOVEI I2,3
	JRST VEARG8

VEARG6:	JUMPN B,VEARG5	;"FOO,," FORMAT
	setzm undefp	;say undefineds are legal here
	MOVSI A,400000	;SAY ALL UNDEF REFS ARE SWAPPED REFS.
	MOVE B,UNDFRP
	SOJL B,.+3
	IORM A,UNDFRL(B)
	SOJG B,.-2
	HRLZS A,VALUE	;PUT 1ST FIELD INTO LH.
	SKIPE VALUE+1
	 HRRZS VALUER	;MAKE "0,,$>" CLEAR THE L.H.
	JRST VERG6A

VERGNM:	PUSH P,D
	MOVE D,VALUE+1
	PUSHJ P,NMODE
	POP P,D
	MOVEM B,VALUE+1
	POPJ P,

;EVALUATE FIELD
;RETURN SKIPPING WITH RESULT IN A & B AND
	;WITH FIELD TERMINATOR IN D
;OR NOT SKIPPING IF HIT END OF FROBS
EFIELD:	PUSH P,[-1]
	TLZ F,FLNNUL\FLPNT\FLLET
	SKIPN PSTATE
	 MOVEM P,EFIELP	;P TO RESTORE ON PDL OVERFLOW DUE TO NESTED OPERATORS.
	JRST EFLD3
	;FLLET=END OF WORLD

EFLD2:	ADD W3,[2,,2]
EFLD3:	MOVEI C,EFLD2	;SET UP ERROR RETURN
	MOVEM C,ERRSTL	;FOR EXECUTE-DURING-EVAL OPERATORS.
	MOVEM P,ERRSTP
	CAML W3,W4
	JRST EFLDEW	;END OF WORLD
	MOVE C,1(W3)
	MOVE D,2(W3)	;GET FROB
EFLD4:	JUMPGE D,EFLDNO	;NOT AN OPERATOR, PUSH ON STACK.
	MOVE I4,(D)
	TLNE I4,1000
	JRST (I4)	;EXECUTE DURING EVAL
	TLNE I4,100000
	JRST EFLDE	;END OF FIELD
	TLO F,FLNNUL
	LDB I2,[340200,,I4]	;GET PRIORITY
	SKIPN I2
	ERLOSS 2(P)	;UUOH WILL PUSH A, THEN D.
	SKIPGE (P)
	JRST EFLD8	;THIS IS PREFIX
	MOVE B,-2(P)
	AOJE B,EFLD8	;THIS IS FIRST OPR
EFLDEA:	SOS B
	MOVE I4,(B)
	LDB I3,[340200,,I4]
	SKIPL -3(P)	;IF PREV. OP. WAS PREFIX OR HIGHER PRIOR,
	CAMG I2,I3
	JRST EFLD8Z	;EXECUTE IT, REPLACE BY VALUE.
EFLD8:	CAML P,[-20,,]
	 JRST NPDLER
	PUSH P,D	;PUSH THIS OP IN ANY CASE.
	JRST EFLD2

EFLD8Z:	POP P,D		;POP 2ND ARG.
	POP P,C
	POP P,I2	;OP. TO EXECUTE.
	SKIPGE (P)	;IF PREFIX, DUMMY UP 1ST ARG,
	JRST EFLD8P
	POP P,B		;ELSE POP ACTUAL 1ST ARG.
	POP P,A
EFLD9P:	PUSHJ P,(I4)	;ACUALLY EXECUTE AN OPERATOR
	PUSH P,A	;REPLACE OP. AND ARGS BY VALUE.
	PUSH P,B
	JRST EFLD3

EFLDE:	TLNN F,FLNNUL
	CAME I4,[100000,,1]
	JRST EFLDE1
	JRST EFLD2	;LEADING SPACE FLUSHER

EFLD8P:	MOVE A,[0 ? 1 ? -1]-1(I3)
	MOVEI B,1
	TLNN I2,30000	;SKIP IF FLOAT
	JRST EFLD9P
	TLC A,232000
	FADR A,A
	JRST EFLD9P

EFLDNO:	TLO F,FLNNUL	;NOT AN OP - FIELD NOT NULL.
	SKIPL (P)	;PREVIOUS WASN'T OP => CONSEC. ARGS, ERROR.
	 JRST EFLNOS
	CAML P,[-20,,]
	 JRST NPDLER
	SAVE C	;ELSE JUST PUSH THIS ARG.
	SAVE D
	CAMN D,[SYLSYM,,]
	 JRST EFLDN1	;J IF UNEVALUATED SYMBOL.
	HLRZ I4,D	;CHECK FOR FUNNY SYMBOLS.
	HRLZI D,(D)
	CAIN I4,SYLSYM
	 IORM D,FNYLOC	;ACCUMULATE FUNNYNESS OF ALL SYMS IN ARGS.
	JRST EFLD2

EFLDN1:	setom undefp	;Say we just encountered an undefined.
	SETZM -1(P)	;UNEVALUATED SYMBOL HAS VALUE 0,
	MOVEI D,2
	ADD D,UNDFRP
	CAILE D,UNDFRS
	 JRST NUNDER	;(TOO MANY UNDEF SYMS IN 1 ARG)
	MOVEM D,UNDFRP	;CREATE AN UNDEF REF FOR THE SYMBOL.
	MOVEM C,UNDFRL-2(D)
	SETZM UNDFRL-1(D)	;SAY NORMAL REF, NOT SWAPPED.
	JRST EFLD2

EFLNOS:	7TYPE [ASCII / NOS/]
	MOVE D,[O.OP+"+,,OPTAB0+"+-1]	;+
	JRST EFLD4

EFLDEW:	TLO F,FLLET
EFLDE1:	TLNN F,FLNNUL
	 JRST EFLDE2	;NULL
	MOVNI I2,1	;EFLDEA WILL LOOK AT THIS .
	SKIPL B,(P)
	 JRST EFLDE5
	AOJE B,EFLDXX	;NOTHING ON STACK
	SAVE [0]
	SAVE [1]
EFLDE5:	MOVE B,-2(P)
	AOJE B,EFLDE8
	JRST EFLDEA

EFLDXX:	SKIPN B
EFLDE2:	SETZB A,B
	SUB P,[1,,1]	;FLUSH THE -1 PUSHED AT EFIELD.
	TLNE F,FLLET	;IF RAN OUT OF SYLLS, RETURN.
	POPJ P,
	ADD W3,[2,,2]	;ELSE PASS BY THE FIELD-TERMINATOR.
	JRST CPOPJ1

EFLDE8:	POP P,B
	POP P,A
	JRST EFLDXX

NPDLER:	MOVE P,EFIELP
	MOVEM P,ERRSTP
	ERSTRT [SIXBIT/PDL OVERFLOW - OPERATORS TOO NESTED?/]

;PARENTHESIS AND ANGEL BRAKET ROUTINES

NLPARN:	SKIPA A,[2]	;(
NLANGB:	MOVEI A,1	;<
	CAML P,[-20,,]
	 JRST NPDLER
	SAVE PSTATE
	MOVEM A,PSTATE
	SAVE PVALUE
	SAVE VALUE
	SAVE VALUE+1
	SAVE STATE
	SAVE VALUER
	SAVE F
	TLZ F,FLPNT\FLLET\FLNNUL
	ADD W3,[2,,2]
	push p,undfrp		   ;remember how many undefineds?
	call vearg		   ;get value within
	pop p,d			   ;get how many undefineds we did have
	came d,undfrp		   ;any undefineds?
	  call undflp		   ;  yes, flip them!
	MOVE C,VALUE
	MOVE D,VALUE+1
	REST F
	REST VALUER
	REST STATE
	REST VALUE+1
	REST VALUE
	REST PVALUE
	HRRZ B,PSTATE
	MOVE A,C	;PARENS WITH ZERO INSIDE ARE REGARDED AS SPECIFYING
	IORI A,-2(B)
	SKIPN A		;THE INDEX FIELD.
	 DPB A,[220400,,VALUER]
	SKIPL A,PSTATE
	 7TYPE NLCLSE-1(A)	;ERROR IF NO CLOSE SUPPLIED
	REST PSTATE
	TRNN A,2
	 JRST NLNGB2	;<>
	SKIPGE A,(P)	;()
	 AOJN A,NLPOP	;JUMP IF PRECEDED BY ARITH OP
	LSHC B,18.
	ADD C,PVALUE
	HLLM C,PVALUE
	ADD B,PVALUE
	HRRM B,PVALUE
	JRST EFLD3

;; Flip which half any undefineds appear in.
;; D has index (1 based) of first one not to flip

undflp:	movsi c,400000		   ;bit to toggle
	move b,undfrp		   ;get where things are to now
	subi d,(b)		   ;get -<# of undefineds to flip>
	jumpge d,cpopj		   ;safety check!
undfl1:	xorm c,undfrl(b)	   ;flip
	sos b			   ;previous entry
	aojl d,undfl1		   ;end of loop?
	ret


NLPOP:	MOVSS C
NLNGB2:	SUB W3,[2,,2]
	JRST EFLD4

NLCLSE:	ASCII / >/
	ASCII / )/

NRPARN:	SKIPA A,[2]	;)
NRANGB:	 MOVEI A,1	;>
	HRRZ B,PSTATE
	CAME A,B
	 7TYPE NRNMTC-1(A)	;ERROR ON UN-MATCHED CLOSE
	HRROM B,PSTATE
	MOVE D,[410000+" -1,,OPTAB1+" -1]	;$SP
	JRST EFLD4

NRNMTC:	ASCII / </
	ASCII / (/

;READ A FROB INTO A,B.
;RETURN LAST CHAR. READ IN D.
;(WILL BE RUBOUT IFF TRYING TO RUB PREVIOUS FROB)
GTFROB:	PUSHJ P,GSOA	;INIT. PROC, SET UP RET. ADDR.
	 JRST GSNLRT	;(RETN HERE IF WHOLE SYLL RUBBED)
GTFRPC:	TLZ F,FLNNUL\FLPNT\FLLET\FLNEGE
;DETERMINE IF FROB TO BE READ IS SYL OR OP
	JSP W2,RCH
	CAIL D,140
	SUBI D,40	;LOWER CASE TO UPPER.
	CAIL D,"0
	CAILE D,"9
	JRST FRBTY2
	JRST SLRPND

FRBTY2:	CAIL D,"A
	CAILE D,"Z
	JRST FRBTY4
	JRST SLRPND

FRBTY4:	CAIE D,".
	CAIN D,"$
	JRST SLRPND
	CAIN D,"%
	JRST SLRPND
	MOVEI W2,GOPND
	JRST GOPND

GSDECJ:	SKIPA B,[SYLDEC,,]
GSOCTJ:	MOVSI B,SYLOCT
	POPJ P,

GSEVLJ:	TLZA B,-1	;JSP B,GSEVLJ TO RETURN TYPE-0 SYLL.
GSNLRT:	SETZB A,B	;GET SYL NULL RETURN
	POPJ P,

GSFLTJ:
FMODE:	MOVSI B,SYLFLT
	POPJ P,

DBP:	ADD A,[70000,,]	;DECREMENT BYTE POINTER (7 BIT)
	TLNE A,400000
	 ADD A,[347777,,-1]
	POPJ P,


;COME HERE WITH 1ST CHAR IF IS SYLLABLE.
SLRPND:	JSP W2,SLRPN2

;PROCESS 1 CHAR OF SYLLABLE.
SLRPN2:	CAIL D,140
	SUBI D,40	;LOWER CASE TO  UPPER.
	CAIL D,"0
	CAILE D,"9
	JRST SLRNNM	;JUMP IF NOT DIGIT
	TLO F,FLNNUL	;NOT NULL
	PUSHJ P,GASSOD
	MOVE A,GSFNUM	;ASSEMBLE FLOATING
	MOVEI B,-"0(D)
	TLO B,232000
	FADR B,B
	TLNE F,FLPNT
	JRST SLRFN2	;JUMP IF AFTER POINT
	FMPR A,[10.0]
SLRFN3:	FADR A,B
	MOVEM A,GSFNUM
	SUBI D,"0-1	;CONVERT TO SQUOZE DIGIT
SLRSYM:	PUSHJ P,SYMPUT
	JSP W2,RCH
	JRST SLRPN2

GASSOD:	MOVE A,GSONUM	;ASSEMBLE OCTAL
	LSH A,3
	ADDI A,-"0(D)
	MOVEM A,GSONUM
	MOVE A,GSDNUM	;ASSEMBLE DECIMAL
	IMULI A,10.
	ADDI A,-"0(D)
	MOVEM A,GSDNUM
	POPJ P,

;PUT SQUOZE IN SYM
SYMPUT:	MOVE A,GSSSYM
	CAML A,[1*50*50*50*50*50]
	POPJ P,	;ALREADY A FULL SYMBOL
	IMULI A,50
	ADD A,D
	MOVEM A,GSSSYM
	POPJ P,

;FLOATING AFTER POINT
SLRFN2:	AOS C,GSFNUC
	FDVR B,[10.0]
	SOJG C,.-1
	JRST SLRFN3

;NOT A DIGIT
SLRNNM:	CAIL D,"A
	CAILE D,"Z
	JRST SLRNLT	;JUMP ON NOT LETTER
SLRLET:	TLNE F,FLLET
	 JRST SLRLE2
	CAIN D,"E
	 JRST SLRPE
SLRLE2:	SUBI D,"A-13
	SKIPA
SLR$%:	ADDI D,46-"$
	TLO F,FLLET\FLNNUL
	JRST SLRSYM

;NOT A LETTER
SLRNLT:	CAIE D,"$
	CAIN D,"%
	JRST SLR$%
	CAIN D,".
	JRST SLR.
SLRNNN:	SETOM UNRCHF
	TLNN F,FLNNUL\FLPNT
	JRST GSNLRT
	TLNE F,FLLET
	JRST GSYLET
	TLNE F,FLPNT
	JRST GSYDFN
	MOVE A,GSONUM
	JRST GSOCTJ

SLR.:	TLOE F,FLPNT
	TLO F,FLLET	;A LETTER IF NOT ONLY ONE
	TLZ F,FLNNUL	;TO TELL IF DEC OR FLOAT
	MOVEI D,45	;SQUOZE
	JRST SLRSYM

GSYLET:	MOVSI B,SYLSYM
	SKIPE A,GSSSYM	;SKIPE IN CASE $0&=, ETC.
GSYLE2:	CAML A,[1*50*50*50*50*50]
	POPJ P,
	IMULI A,50
	JRST GSYLE2

GSYDFN:	MOVE C,GSSSYM	;IF WAS JUST ., IS SYM.
	CAIN C,45
	JRST GSYLET
	MOVE A,GSDNUM
	TLNN F,FLNNUL	;ELSE MAY BE DECIMAL NUM.
	JRST GSDECJ
	MOVE A,GSFNUM	;OR MAY BE FLOATING.
	JRST GSFLTJ

;E FORMAT
SLRPE:	TLZN F,FLPNT
	 JRST SLRLE2
	SUBI D,"A-13
	PUSHJ P,SYMPUT
SLRPEL:	JSP W2,RCH
	CAIL D,140
	 SUBI D,40
	CAIN D,"+
	 JRST SLRPEM
	CAIN D,"-
	 JRST SLRPE1
	CAIL D,"0
	 CAILE D,"9
	  JRST SLRENN
	TLO F,FLLET
	MOVE A,GSENUM
	IMULI A,10.
	ADDI A,-"0(D)
	MOVEM A,GSENUM
	SUBI D,"0-1
	PUSHJ P,SYMPUT
	JRST SLRPEL

SLRPEM:	TLNE F,FLLET
	 JRST SLREM2
	JRST SLRPEL

SLRPE1:	TLNE F,FLLET
	 JRST SLREM2
	TLC F,FLNEGE
	JRST SLRPEL

SLRENN:	CAIL D,"A
	 CAILE D,"Z
	  JRST SLREN2
	TLO F,FLLET
	JRST SLRLET

SLREN2:	CAIE D,"$
	 CAIN D,"%
	  JRST SLRNLT
	CAIN D,".
	 JRST SLRPE.
SLREM2:	SETOM UNRCHF
	MOVE A,GSFNUM
	MOVE C,GSENUM
	ANDI C,77
	TLNE F,FLNEGE
	 JRST SLRPE4
SLRPE2:	SOJL C,GSFLTJ
	FMPR A,[10.0]
	JRST SLRPE2

SLRPE4:	SOJL C,GSFLTJ
	FDVR A,[10.0]
	JRST SLRPE4

SLRPE.:	TLOE F,FLPNT
	JRST SLRNLT
	MOVEI D,45
	PUSHJ P,SYMPUT
	JRST SLRPEL

;READ AN OPERATOR, RETURN IT IN A,B 
;W2 CONTAINS GOPND, WHICH PROCESSES 1 CHAR. RCH RETURNS TO IT.
;COME IN WITH THE 1ST CHAR FROM FRBTYP.

GOPND:	CAIN D,33
	JRST GOPALT
	CAIL D,"0
	CAILE D,"9
	JRST GOPNNM
	TLO F,FLLET
	PUSHJ P,GASSOD
	JRST RCH

GOPALT:	AOS A,GSENUM
	CAILE A,2
	 SOS GSENUM
	JRST RCH

GOPPNT:	TLNN F,FLLET
	 JRST GOPNN2	;$., $$.
	TLC F,FLPNT
	JRST RCH

GOPNNM:	CAIN D,".
	 JRST GOPPNT
GOPNN2:	CAIL D,140
	 SUBI D,40
	MOVEM D,GSFNUM
	MOVE A,GSONUM
	TLNE F,FLPNT
	 MOVE A,GSDNUM
	MOVSI B,O.OP	;OP
	TLNE F,FLLET
	 TLO B,O.IFX	;NUM PRESENT
	TLNE F,FLPNT
	 TLO B,O.IFXD	;DECIMAL
	MOVE C,GSENUM
	DPB C,[360200,,B]	;ALTS
	MOVE D,GSFNUM
	PUSHJ P,FIXOPC
	HRRI B,@GOPBT1(C)
	MOVE C,GSFNUM
	DPB C,[220700,,B]	;CHAR
	POPJ P,

FIXOPC:	CAIL D,33	;FLUSH IMPOSSIBLE OP CHARS
	SOS D
	CAIL D,"0-1
	SUBI D,"9-"0+1
	POPJ P,

GOPBT1:	OPTAB0(D)
	OPTAB1(D)
	OPTAB2(D)

ATSIGN:	MOVSI A,(@)	;@
	XORM A,VALUE
	ANDCAM A,VALUER	;SPEC'D INDIRECT BIT OVERRIDES OLD ($>) REGARDLESS OF VALUES.
ATSIG1:	TLO F,FLNNUL
	JRST EFLD2

NQMK:	SKIPGE CU	;?
	 JRST KHELP	;NO JOB; NORMAL FUNCTIONS ARE IMPOSSIBLE, SO GIVE USER HELP.
	SKIPE UNDEFF	;RIGHT AFTER A ?U? ERROR =>
	 JRST NQMK2	;MAKE AN UNDEF. REF. TO THE ERRONEOUS SYMBOL.
	HRRI B,[201000,,EFLD2]	;THESE BITS ARE SUCH AS FOUND IN OPTAB0, ETC.
	MOVE C,FLDTBP	;ARE WE FOLLOWING AN OPERATOR, OR THE 1ST FROB?
	ADD C,[3,,2]
	CAME C,W4
	 SKIPGE -2(W4)
	  HRRI B,[10200,,NQMK1]	;YES: WE MEAN "BIT TYPEOUT OF ARG OR $Q".
	RET		;OTHERWISE, WE MEAN "PRECEDING IS UNDEFINED SYMBOL REF"
			;WHICH IS HANDLED BY PROTECTING SYMBOL FROM EVALUATION
			;(WHICH WOULD SAY ?U?), AND BEING IGNORED AT EVAL TIME.
NQMK1:	HRROI C,TMH	;"?" COMES BACK HERE AFTER EVALLING ARGS; RETYPE IN $?$H MODE.
	SAVE BITF
	SETOM BITF
	CALL NSEM2
	REST BITF
	RET

NQMK2:	MOVE A,UNDEFF	;CREATE AN UNEVALUATED SYMBOL TO RETURN, JUST LIKE
	MOVSI B,SYLSYM	;THE ONE THAT CAUSED THE ?U? ERROR.
	SETOM UNRCHF	;MAKE THE "?" BE REPROCESSED AFTER THAT SYMBOL, TO
	RET		;PROTECT IT FROM EVALUATION.

NSIGN:	ADDI C,TNMSGN-TAMPER	;#, GET ADDR OF MODE IN CASE SHOULD TYPE OUT,
	SKIPA B,[SETZ ("#) [6000,,NSIGN1]]
NAMAND:	HRRI B,[6000,,NAMAN1] ;&
	ADDI C,TAMPER-TDQUOT
	MOVE A,FLDTBP
	ADD A,[3,,2]
	CAME A,W4	;NOT 1ST FROB =>
	 RET		;TURN INTO ARITH. OP.
NDQ:	ADDI C,TDQUOT-TPRIME	;"  RETYPE IN $" MODE.
NPRM:	ADDI C,TPRIME		;'  RETYPE IN $' MODE.
	HRLI C,-2	;GO INDIRECT THRU USER VAR IN RH(C).
	JRST NSEM2	;GET ARG AND TYPE IT.

NALTEQ:	TLNN B,O.IFX	;$=
	 JRST FEQL	;$= WITHOUT INFIX ARG IS FLOATING-POINT.
	CAIG A,1
	 JRST NAERR
	SAVE ODF	;$<N>= USES RADIX <N>.
	MOVEM A,ODF
	HRROI C,FTOC	;AND PRINTS AS A NUMBER.
	CALL NSEM2
	REST ODF
	RET

NEQL:	TRC C,FTOC#PIN		;=
NLFTA:	TRC C,PIN#TFLOT		;_
FEQL:	EQVI C,#TFLOT		;$=   THIS SETS SIGN OF C.
	JRST NSEM2	;GET ARG, SET $Q, CALL (C), RETURN NULL.

;$< AND $$< SET GTMALT, ETC. AS A SIGNAL TO SLRPIN
;TO READ SOME ALT'S AND THE INFIX ARG (IN OCTAL)
;BEFORE READING ANYTHING FROM THE TTY OR FILE OR VALRET, ETC.
ALTLES:	PUSHJ P,GTVAL
	TLNE C,10
	JRST ALTLE4
	MOVEI D,1	;CAUSE 1 ALTMODE TO BE READ.
	JRST ALTLE2

A2LES:	PUSHJ P,GTVAL
	TLNE C,10
	JRST ALTLE4
	MOVEI D,2	;READ 2 ALTMODES.
ALTLE2:	MOVEM D,GTMALT
	MOVE A,ARG1
	MOVEM A,GTFTEM	;HERE GOES ARG FOR SLRPIN TO READ.
	MOVE A,[440300,,GTFTEM]
	ILDB D,A
	TLNE A,770000
	JUMPE D,.-2
	ADD A,[30000,,]
	MOVEM A,GTPNTR	;SLRPIN GETS OCTAL DIGITS FROM THIS BP.
	POPJ P,

ALTLE4:	7TYPE [ASCIZ /</]
	POPJ P,

ALTEQ:	MOVSI W3,-<NARGS*2>	;$$=
ALTEQ2:	SKIPN C,ARG1+1(W3)
	JRST NLTL4
	MOVE A,ARG1(W3)
	CALL GFROBP
	PUSHJ P,CRF
	AOBJN W3,.+1
	AOBJN W3,ALTEQ2
	JRST NLTL4

LWTPUT:	PUSH P,B

	MOVE B,LWTP	;SET $Q FROM D .
	ADDI B,2
	CAIL B,LWTTAB+2*LWTLNG
	  MOVEI B,LWTTAB

	MOVEM D,(B)
	MOVEM D,LWT
	MOVSI D,SYLOCT
	MOVEM D,1(B)
	MOVEM D,LWT+1
	MOVE D,LWT

	MOVEM B,LWTP
	JRST POPBJ

GARGDQ:	MOVE D,LWT	;GET ARG OR $Q IN D.
	SKIPE ARG1+1
	  MOVE D,ARG1
	POPJ P,

NSEMIC:			; ";" - RETYPE IN LAST MODE SPECIFIED (EVEN IF SINCE RESET)

INSIRP PUSH P,SCH AR ODF BITF BITPAT BITPA1 BITSYM BITSY1

	call nasemi  ;was call NSEM2, but that leads to attempts to read from
		     ;(non-existant) inferior.  SYSBIN;DDT BIN for 657 does
		     ;call nasemi, and I believe it to be correct

INSIRP POP P,BITSY1 BITSYM BITPA1 BITPAT BITF ODF AR SCH
	RET


	
N2ASEM:	MOVE A,[SCHMM,,SCHM]	;$$;
	BLT A,BITFM
NASEMI:	MOVE A,[SCHMM,,SCH]	;$;
	BLT A,BITF
	MOVE C,SCHMM	;GET ADR OF TYPEOUT RTN.
	jrst nsem2

NSEM3:	PUSHJ P,LWTPUT
	CALL PVAL2	;(THIS RTN MAY SKIP TO AVOID TYPING SPACES)
LCTGNR:	7TYPE [ASCIZ/   /]
	JRST GSNLRT

;OUTPUT $Q OR NUMERIC ARG IN CURRENT MODE,
;DECREMENTING TTYFLG BY ONE, SO WE PRINT EVEN INSIDE ONE LEVEL OF ^W.
NSEM2:	SAVE TTYFLG
	SKIPE TTYFLG
	 SOS TTYFLG
	CALL GARGDQ
	CALL LWTPUT
	CALL PVAL2
	REST TTYFLG
	JRST LCTGNR

NCART:	TLZ F,FLST	;^M (CR)
	MOVE D,[SCHM,,SCH]
	BLT D,BITF
	jrst gsnlrt

;POP THE . RING BUFFER IF O.1ALT IS SET IN B.
;INFIX ARG (IN A) SAYS HOW MANY TIMES TO POP IT (0 => POP ONCE).
PLUNK2:	TLNN B,O.1ALT
	 RET
PLUNK3:	SAVE A
	MOVE A,PLCR
	MOVE D,LOCBF(A)
	SOSGE A
	MOVEI A,NLEVS-1
	MOVEM A,PLCR
	MOVEM D,LLOC
	REST A
	SOJG A,PLUNK3
	POPJ P,

;DEPOSIT THE ARG, IF ANY, IN THE OPEN REGISTER, IF ANY.
;CLOSES THE REGISTER IN ANY CASE.
PLUNK1:	MOVEM F,PLUNKF	;[ ;(^] MUST KNOW IF ANY LOC. HAD BEEN OPEN)
	TLZE F,FLRO
	 SKIPN ARG1+1
	  JRST CPOPJ
	MOVE D,ARG1
	PUSHJ P,LWTPUT	;SET $Q TO VALUE BEING STORED,
	MOVE A,LLOCO
	PUSHJ P,DEPRMV	;UPDATE UNDEF SYM REFS FOR LOCATION,
	MOVE D,LWT	;(DEPRMV CLOBBERED D)
	JRST DEPF	;THEN STORE IN IT.

NTAB3:	PUSHJ P,GARGDQ
	TLNE B,O.1ALT
	MOVSS D		;$TAB
	TLNN B,O.2ALT	;$$TAB => DO EFFEC. ADDR. CALC.
	JRST NTAB5
	PUSHJ P,EASETU	;AC'S UGH BLETCH
	PUSHJ P,NEFECC	;SOLVE IT
	MOVE D,I1	;GET RESULT
NTAB5:	HLL D,FNYLOC	;LH OF D GETS FUNNYNESS OF LOC. TO OPEN.
	POPJ P,

NACM:	PUSHJ P,PLUNK2	;$^M, POP . RING BUFFER.
	SKIPA D,LLOC
NNL2:	PUSHJ P,CRF
UBRKNL:	PUSHJ P,PLOC	;SET . AND LOCATION OPEN.
	PUSHJ P,PAD
	TLNN F,FLST
	CTYPE "/
	TLNE F,FLST
	7TYPE [ASCIZ /!/]
	JRST NTAB2A

NTAB:	PUSHJ P,NTAB3	;DEP ARG, CALC. ADDR TO OPEN.
	JRST NNL2	;GO OPEN IT.

;BEFORE CALLING, DISPATCHER CALLED PLUNK TO STORE ARG.
NNL:	PUSHJ P,PLUNK2	;^J, $^J. IF IS $^J, POP . RING BUFFER.
	MOVE D,LLOC	;GET POINT, INCREM BUT DON'T CHANGE LH.
	HRRI D,1(D)
	JRST NNL1	;GO CR, PRINT ADDR & CONTENTS.

NUPA:	PUSHJ P,PLUNK2
	MOVE D,LLOC	;UPARROW - SIMILAR BUT DECREMENT.
	HRRI D,-1(D)	;NOTE LH HAS FUNNYNESS (.USET OR DDT REF).
NNL1:	MOVEM D,LLOC	;CLOBBER RING BUFFER TOP SO WON'T PUSH.
	JRST NNL2

; \, $\, $$\
NBKSL:	PUSHJ P,NTAB3	;DEP. ARG, CALC. ADDR TO OPEN.
	MOVEM D,LLOCO	;OPEN BUT DON'T SET POINT .
NTAB2A:	HRROI C,POPJ1	;IN $$! MODE, DON'T TYPE VALUE OR SPACES.
	TLNN F,FLST
	 MOVE C,SCH	;ELSE TYPE IN CURRENT MODE.
	JRST NTAB2

NLBRAK:	MOVEI C,FTOC-PIN	;[, $[, $$[		;NOTE THESE BRKTS MATCH
NRBRAK:	ADDI C,PIN		;], $], $$]
	TLO C,-1	;INDICATE THIS TYPEOUT MODE IS DDT RTN.
	JRST NLRBK2	;WILL TYPE OUT IN MODE IN C.

A2XCL:	TLO F,FLST	;$$!, SUPPRESS TYPEOUT.
	TLZ B,O.2ALT	;(SO NTAB3 WON'T DO EFFEC ADDR CALC.)
	HRROI C,POPJ1	;"TYPEOUT MODE" WON'T TYPE ANYTHIING.
	JRST NLRBK2

NSLASH:	TLZ F,FLST	;/, $/, $$/
	MOVE C,SCH	;TYPE OUT IN CURRENT MODE.
NLRBK2:	PUSHJ P,NTAB3	;CALC ADDR TO OPEN.
	PUSHJ P,PLOC	;SET . .
;GET, MAYBE PRINT CONTENTS OF LOC. WHOSE ADDR IS IN LLOCO.
NTAB2:	PUSHJ P,LCT
	MOVE A,LLOCO
	TLZ F,FLRO
	PUSHJ P,FETCHF	;FUNNY FETCH SINCE MAY HAVE OPENED USET REF, ETC.
	 7NRTYP [ASCIZ/?? /]
	TLO F,FLRO
	JRST NSEM3	;SET $Q, CALL (C) TO PRINT VALUE.

;PUSH CONTENTS OF D ONTO . RING BUFFER.
PLOC:	MOVEM D,LLOCO
	CAMN D,LLOC
	POPJ P,
	AOS A,PLCR	;ADVANCE RING POINTER
	CAIL A,NLEVS
	SETZB A,PLCR
	EXCH D,LLOC
	MOVEM D,LOCBF(A)
	MOVE D,LLOC
	POPJ P,

NALTQ:	TLNE D,O.IFX	;$Q
	 JRST NALTQN	;JUMP IF NUM SUPPLIED
NALT0Q:	MOVEI A,LWT
NALTQ1:	MOVE C,(A)
	TLNE D,O.2ALT
	 MOVSS C	;$$Q - SWAP THE VALUE.
	MOVE D,1(A)
	JRST EFLDNO

NALTQN:	JUMPE C,NALT0Q
	JUMPL C,NXERR
	CAILE C,10
	 JRST NXERR
	MOVE A,LWTP
NALTQ2:	SUBI A,2
	CAIGE A,LWTTAB
	 MOVEI A,LWTTAB+2*LWTLNG-2
	SOJG C,NALTQ2
	JRST NALTQ1

;$. - JOB'S PC. EXECUTED DURING EVFLD.
NALT.:	PUSHJ P,QJERR
	MOVE C,PPC(U)
	SKIPE UINTWD(U)	;AN INFERIOR THAT'S STOPPED?  IF SO, DDT HAS THE PC.
	 SKIPG INTBIT(U)
	  SKIPGE INTBIT(U) ;ON PDP6, DON'T TRY TO DO THE .USETS.
	   JRST EFOCTJ
	MOVE A,[-2,,NALT.B]
	.USET USRI,A	;ASSUME RUNNING.
	TLNN C,10000	;RUNNING IN EXEC MODE?
	SOS C,B
EFOCTJ:	MOVSI D,SYLOCT
	JRST EFLDNO	;GO PUSH VALUE ON STACK.

NALT.B:	.RUPC,,C
	.RUUOH,,B

ALTGRT:	MOVE A,LWT	;$> - SET UP $Q AS THE "OLD" VALUE IN THE
	MOVEM A,VALUEQ	;CURRENT EVALUATION. THE "OLD" VALUE IS USED TO
	JRST ATSIG1	;DEFAULT ANY UNSPECIFIED FIELDS OF THE WORD.

NSIGN1:	TDCA A,C		;#
NSTAR:	IMUL A,C	;*
NMODE:	CAME B,D	;COMPUTE DOMINANT MODE.
	JRST APAT5	;MODES DIFFER, DEFAULT TO INSN.
	POPJ P,

NAMAN1:	AND A,C		;&
	JRST NMODE

NPLUS:	ADD A,C		;+
	JRST NMODE

NMINUS:	SUB A,C		;-
	JRST NMODE

n.or:	ior a,c		;^_
	popj p,

NEXCLM:	PUSH P,B	;!
	IDIV A,C
	POP P,B
	JRST NMODE

FPLUS:	FADR A,C	;$+
	JRST FMODE

FMINUS:	FSBR A,C	;$-
	JRST FMODE

FEXCLM:	FDVR A,C	;$!
	JRST FMODE

NSHIFT:	LSH A,(C)	;$_
	JRST NMODE

FSTAR:	FMPR A,C	;$*
	JRST FMODE

NFSC:	FSC A,(C)	;$$_
	JRST FMODE

ALTPCN:	ADDI C,TPERCE-TAMPER	;$%
ALTMPN:	ADDI C,TAMPER-TDOLLA	;$&
ALTDLN:	ADDI C,TDOLLA-TPRIME	;$$ (ALT-DOLLAR)
ALTPMN:	ADDI C,TPRIME-TDQUOT	;$'
ALTDQN:	ADDI C,TDQUOT-TNMSGN	;$"
ALTNMN:	ADDI C,TNMSGN		;$#
	HRLI C,-2	;USE MODE WHICH WILL INDIRECT THRU THAT USER VAR.
	CAIA
NSETX:	HRROI C,(W3)	;W3 HAS ADDR OF TYPEOUT RTN IN DDT.
NSET0:	MOVEI A,0
NSET:	MOVEM C,SCH(A)
	MOVEM C,SCHMM(A)
	MOVE D,SCH
	MOVEM D,SCHMM	;IF I DO $O OR $A IN $S MODE, THE ; MODE SHOULD BE SET TO $S.
	MOVE D,AR
	CAILE A,1	;SAME FOR $O IN $A MODE.
	 MOVEM D,ARMM
	TLNN B,O.2ALT	;SKIP IF $$ - SET PERMANENT MODE TOO.
	 JRST GSNLRT
	MOVEM C,SCHM(A)
	JRST LCTGNR

NALTD:	ADDI C,2	;$D, $$D
NALTO:	ADDI C,8	;$O, $$O
	MOVEI A,2
	JRST NSET

NALTR:	TLNE B,O.IFX
	 JRST NALTR2
	TRC C,PADR#TOC	;$R, $$R
NALTA:	TRC C,TOC	;$A, $$A
	SETZM BITF
	SETZM BITFMM	;TURN OFF BIT MODE.
	TLNE B,O.2ALT
	 SETZM BITFM
	MOVEI A,1
	JRST NSET

NALTT:	TLNN B,O.IFX	;$T, $$T
	JRST NALTT2	;JUMP IF NO NUM SUPPLIED
	JUMPL A,NALTT1	;INFIX ARG NEGATIVE => IT IS MASK.
	CAILE A,36.
	 JRST NAERR	;ELSE SHOULD BE BYTE SIZE.
	JUMPE A,ERR
	CAIN A,35.	;THE CODE BELOW FAILS IN THIS CASE.
	 JRST [HRROI A,-2 ? JRST NALTT1]
	MOVNS A		;NEGATE, WILL SHIFT RIGHT.
NALTT0:	TLC C,4^5	;CHANGE HIGH BIT,
	ASHC C,(A)	;GENERATE 1 BYTE OF THAT BIT,
	TLZ D,4^5	;ASHC SET D'S SIGN.
	JUMPE D,NALTT0	;KEEP GOING TILL HAVE DONE >36. BITS,
	JUMPGE C,NALTT0	;AND HIGH BIT IS 1.
	LSH D,1
	LSHC C,1	;GET ALL 36. BITS IN C.
	MOVE A,C
NALTT1:	MOVEM A,SATPC
NALTT2:	HRROI C,SATP
	JRST NSET0

NALTR2:	SOJLE A,NAERR	;$NR, $$NR
	AOS C,A
	MOVEI A,2
	JRST NSET

;HANDLE $? AND $$? - SET BIT TYPEOUT MODE.
NAQMK:	SETOM BITF
	TLNE B,O.IFX
	 JUMPE A,NAQMK0
NAQMK3:	JUMPE D,NAQMK1		;FOLLOWING NOTHING - NO ARG.
	JUMPL D,NAQMK4		;FOLLOWING AN OPERATOR - REPUSH THAT OPERATOR, AND NO ARG.
	LDB W1,[400300,,D]	;WE ARE SPECIFYING A WHOLE NEW BIT MODE
	CAIN W1,SYLSYM_-14.	;(IE, A NEW SYMBOL PREFIX)
	TLNN D,37777		;SO FIND THE SQUOZE - IT IS IN DIFFERENT PLACES
	 JRST NAQMK2		;IN EVALUATED AND UNEVALUATED SYMS
	LDB C,[4000,,D]
NAQMK2:	MOVE D,BITSYM	;WHEN A NEW PREFIX IS SPEC'D,
	MOVEM D,BITSY1	;THE OLD ONE BECOMES ALTERNATE, AND NEW ON IS MAIN.
	MOVE D,BITPAT
	MOVEM D,BITPA1
	MOVEM C,BITSYM
	TLNE B,O.IFX	;WHAT BIT MASK TO USE? MAYBE IT IS SPEC'D WITH
	 JUMPN A,NAQMK5	;A NONZERO INFIX ARGUMENT
	MOVE D,BITSYM
	SAVE B		;OTHERWISE IT MAY BE THE VALUE OF THE PREFIX SYMBOL,
	CALL SEVLD
	 SKIPA D,BITSYM		;OR THE VALUE OF THE SYMBOL WHOSE NAME IS "..B"
	  JRST NAQMK7
	IDIVI D,50*50*50	;FOLLOWED BY THE PREFIX SYMBOL,
	ADD D,[SQUOZE 0,..B]
	CALL SEVLD
	 MOVE D,[525252,,525252] ;OR THE DEFAULT.
NAQMK7:	MOVEM D,BITPAT
	REST B
	JRST NAQMK6

NAQMK4:	EXCH C,-1(W4)
	EXCH D,(W4)
	PUSH W4,C
	PUSH W4,D
NAQMK1:	TLNE B,O.IFX	;WE HAD NO PREFIX ARG, BUT MAYBE HAVE INFIX ARG TO SET BITPAT.
	 JUMPN A,NAQMK5

;TEMPORARY MODE IS NOW JUST RIGHT; SET THE ";" MODE, AND MAYBE THE PERMANENT MODE.
NAQMK6:	SETOM BITFMM
	TLNN B,O.2ALT
	 JRST GSNLRT
	SETOM BITFM
	JRST LCTGNR

NAQMK5:	MOVEM A,BITPAT
	JRST NAQMK6

NAQMK0:	MOVE W1,BITPAT
	EXCH W1,BITPA1
	MOVEM W1,BITPAT
	MOVE W1,BITSYM
	EXCH W1,BITSY1
	MOVEM W1,BITSYM
	JRST NAQMK3

ALTDQ:	TLNN B,O.IFX	;$", $N", $$", $$N"
	JRST ALTDQN	;NO NUM
	PUSHJ P,GSOA	;INIT RUBOUT PROC. OF ASCII CHARS.
	 JRST ALTDQX	;IF RUB OUT ALL, RETYPE THE OP.
	MOVE C,-1(W4)	;START THE VALUE OUT WITH LOW BIT TAKEN
	ANDI C,1	;FROM THE INFIX ARG'S VALUE.
	MOVEM C,GSSSYM
	MOVE C,[440700,,GSSSYM]
ALTDQ2:	JSP W2,RCH	;GET NEXT CHAR (BUT MIGHT BE ^ OR ^Q)
	CAIN D,33
	 JRST ALTDQR	;ALTMODE ENDS THE ARG.
	TLNN C,760000
	 JRST ALTDQ4	;NO ROOM IN WD, IGNORE CHAR OR DO LINEFEED.
	CALL ALTDQ5	;HAVE ROOM; LET ^ AND ^Q QUOTE NEXT CHAR.
	IDPB D,C
	JRST ALTDQ2

ALTDQI:	JSP W2,RCH
ALTDQ5:	CAIN D,^Q	;^Q => READ ANOTHER CHAR, DON'T ALTER.
	JRST [TLNE F,FLRUB	;ALLOW RUBOUT OF ^Q
	     TLNE F,FLCTLL	;PROVIDED ANOTHER CHAR WAS TYPED & RUBBED.
	      JRST SLRPIN
	     RET]
	CAIE D,"^	;^ => MAKE A CTRL CHAR.
	 RET		;ELSE NOT QUOTED.
	JSP W2,RCH
	CAIL D,140	;CONVERT FIRST TO UPPERCASE
	 SUBI D,40
	XORI D,100	;THEN TO CTL CHAR, S.T. ^? BECOMES RUBOUT.
	POPJ P,

ALTPRR:	SKIPA B,[D6PNT]
ALTDQR:	MOVEI B,D7PNT
	MOVE A,GSSSYM
	POPJ P,

ALTDQ4:	MOVE B,(W4)
	TLNE B,O.2ALT
	 JRST ALTDQP	;$$1", DO LINEFEED.
	CALL ALTDQ5	;IGNORE CHAR AND ANY CHAR IT QUOTES.
	JRST ALTDQ2

ALTDQP:	CTYPE 33
	PUSH P,B
	MOVE A,GSSSYM
	MOVSI B,SYLOCT
	SETOM UNRCHF
	SETOM UNECHF
	MOVEM A,ARG1
	MOVEM B,ARG1+1
	PUSHJ P,PLUNK1
	PUSHJ P,NNL
	PUSHJ P,ALTDQX	;RETYPE $$1" OR $$1' .
	CALL EVARGF	;FLUSH THE ARG (THE WORD ALREADY STORED) SO ^L DISPLAYS OK.
	POP P,B
	MOVE A,GSORET	;RETURN TO CALL TO GSOA.
	JRST -2(A)

;COME HERE FROM AN OPERATOR THAT READS STUFF, WHEN GSOA DOESN'T SKIP.
ALTDQX:	MOVE A,-1(W4)	;OP. BEING EXECUTED IS ON TOP OF FROB STACK.
	MOVE C,(W4)
	PUSHJ P,GFROBP
	JRST GSNLRT

ALTPRM:	TLNN B,O.IFX	;$', $N', $$', $$N'
	 JRST ALTPMN	;NO NUM
	PUSHJ P,GSOA	;INIT. RUBOUT PROC. OF 6BIT CHARS.
	 JRST ALTDQX
	SETZM GSSSYM
	MOVE C,[440600,,GSSSYM]
ALTPR2:	JSP W2,RCH
	CAIL D,140	;LOWER CASE TO UPPER.
	 SUBI D,40
	SUBI D,40	;STOP ON NON-6BIT CHAR, DON'T REREAD IT.
	JUMPL D,ALTPRR
	TLNN C,770000
	 JRST ALTPR4
	IDPB D,C
	JRST ALTPR2

ALTPR4:	TLNN B,O.2ALT
	 JRST ALTPR2	;ONLY ONE ALT
	JRST ALTDQP	;TWO, STORE THIS WD, RETURN TO ALTPR1.

ALTNM:	TLNN B,O.IFX	;$#, $N#, $$#, $$N#.
	 JRST ALTNMN	;NO NUMBER => SET TYPE OUT MODE.
	PUSHJ P,GSOA	;INIT RUBOUT PROC
	 JRST ALTDQX	;RETYPE "$1#" IF READ RUBOUT.
	PUSHJ P,ALTDQI	;READ CHAR, LET ^ AND ^Q QUOTE.
	MOVEI A,(D)
	JSP B,GSEVLJ	;WILL CALL AT .+1 TO RETYPE IF RUBBED.

;$# TYPEOUT ROUTINE. VALUE OF SYLL IN D.
TMCH:	SAVE D
	TRZ D,177	;PRINT OUT ALL BUT LOW 7 BITS SYMBOLICALLY,
	JUMPE D,TMCH0
	CALL PIN
	CALL TSPC
TMCH0:	REST D		;THEN LOW 7 BITS AS CHARACTER.
	7TYPE [ASCIZ/1#/]
	ANDI D,177
	CAIE D,^Q
	CAIN D,"^	;^Q AND UPARROW MUST BE QUOTED.
	JRST [CTYPE ^Q ? JRST TOUT]
	CAIN D,177
	 JRST TMCH1	;PRINT RUBOUT AS ^?
	CAIL D," 
	 JRST TOUT	;NOT CTL CHAR, JUST TYPE.
TMCH1:	CTYPE "^	;ELSE QUOTE WITH ^.
	XORI D,100
	     JRST TOUT

ALTAMP:	TLNN B,O.IFX	;$&, $N&, $$&
	JRST ALTMPN	;NO NUM
	PUSHJ P,GSOA	;INIT. RUBOUT PROC.
	 JRST ALTDQX
ALTAM1:	TLO F,FLLET+FLNNUL	;MAKE SURE READ AS SYMBOL,
	TLZ F,FLPNT+FLNEGE
	JSP W2,RCH	;SLRPND EXPECTS 1ST CHAR IN D.
	CALL SLRPND	;READ THE NAME (AS SQUOZE, IN A)
	MOVEI B,D5PNT
	MOVE C,-1(W4)	;GET BACK THE INFIX ARG FOR SQUOZE FLAGS.
	LSH C,-2
	LSH C,32.
	IOR A,C
	POPJ P,

;:TAG <TAG> IS A NO-OP WHEN EXECUTED.
KTAG:	CALL RTOKEN	;SKIP THE TAG
	JRST GSNLRT

;:JUMP <TAG> IN A VALRET OR EXECUTE FILE SETS THE READ POINTER TO AFTER
;THE MATCHING :TAG <TAG>.
KJUMP:	CALL RTOKEN		;READ THE TAG.
	JUMPE B,KJUMP		;SKIP OVER ANY SPACES BEFORE THE TAG.
	SKIPN INPTR
	 CALL INPOP		;IF :JUMP TYPED ON TTY, TRY POPPNG OUT TO VALRET OR FILE
	SKIPN INPTR		;IF WE CAN'T FIND ONE, THE :JUMP IS RIDICULOUS.
	 ERSTRT [SIXBIT /CAN'T :JUMP ON THE TTY?/]
	SKIPG INPTR		;NOW GO TO BEGINNING OF FILE IF IT'S THAT
	 .ACCESS COMC,[0]
	HRRZ A,INVAOB
	ADD A,[<010700,,>-1]
	SKIPL INPTR		;OR TO BEGINNING OF VALRET IF IT'S THAT.
	 MOVEM A,INPTR
	SETOM INNCTL		;NOW SEARCH FOR THE :TAG.  IGNORE ^V, ^W, ETC NOW.
KJUMP1:	CALL KGOIN		;READ THE NEXT CHARACTER.
KJUMP2:	CAIE D,":
	 JRST KJUMP1		;SEARCH FOR COLON FOLLOWED BY T, A, G AND SPACE.
IRPC X,,[TAG ]
	CALL KGOIN
	CAIE D,"X
	 JRST KJUMP2
TERMIN
	MOVE A,[440600,,B]	;NOW COMPARE THIS :TAG'S TAG WITH THE :JUMP'S TAG.
KJUMP3:	CALL KGOIN		;READ NEXT CHAR FROM EACH OF THEM.
	ILDB C,A
	CAIG D,40		;REACHED END OF :JUMP ARG => WE EITHER WIN OR LOSE RIGHT AWAY.
	 JRST KJUMP4
	ADDI C,40
	CAME D,C
	 JRST KJUMP2		;CHARS DON'T MATCH => FIND THE NEXT :TAG.
	JRST KJUMP3		;THEY DO MATCH => KEEP ON COMPARING.

KJUMP4:	JUMPN C,KJUMP1		;END OF :TAG ARG AND NOT END OF :JUMP ARG => MISMATCH.
	SETZM INNCTL		;END OF BOTH => THEY MATCH.  RESUME EXECUTION
	JRST GSNLRT		;AFTER THE :TAG ARG.

;READ CHAR FROM CURRENT VALRET OR FILE, AND ERR AT END OF IT.
KGOIN:	CALL IN2B
	SKIPG INPTR
	 CAIE D,^C
	  SKIPN D
	   ERSTRT [SIXBIT /UNDEFINED :JUMP TAG?/]
	CAIL D,140
	 SUBI D,40
	RET

;:IF <COND-NAME> <ARG>
;$( ..... $)
KIF:	CALL RTOKEN	;READ CONDITION NAME.
	JUMPE B,KIF
	MOVSI A,-KIFTBL	;SEARCH TABLE FOR IT.
KIF1:	CAMN B,KIFTB1(A)
	 JRST KIF2	;FOUND.
	AOBJN A,KIF1
	ERSTRT [SIXBIT/CONDITION?/]

KIF2:	MOVEM A,-1(W4)	;ARRANGE TO RETYPE :IF AND CONDITION
	MOVEI A,KIFRB	;ON RUBOUT OR ^L.
	MOVEM A,(W4)	;(CAN ALSO RETRIEVE KIFTB1 IDX FROM -1(W4))
	SETZM NCOMNM	;DON'T LET GSOA CLOBBER WHAT WE JUST DID.
KIF4:	CALL RONUM	;READ ARG.
	  JRST ALTDQX	 ;RUBBED BACK OUT OF ARG.
	JUMPE B,KIF4	;READ NOTHING => TRY AGAIN.
	MOVE C,-1(W4)	;GET KIFTB1 IDX OF CONDITION.
	SETOM SUCCES
	XCT KIFTB2(C)	;TEST CONDITION, ARG IN A.
	 JRST GSNLRT	;CONDITION TRUE.
KIFLOS:	SETZB A,SUCCES	;A USED AS PAREN COUNTER (CONDITION FALSE)
	SETOM INNCTL	;IGNORE ^V, ETC. IN FALSE CONDIT.
KIF3:	CALL RIN
	 JRST KIF3	;IGNORE RUBOUT.
	CAIN D,"(
	 AOJA A,KIF3	;( => INCREM. COUNT.
	CAIE D,")
	 JRST KIF3
	SOJG A,KIF3	;) => DECREM.
	SETZM INNCTL
	JRST GSNLRT	;THE ) THAT MATCHES THE 1ST (, DONE.

KIFRB:	7TYPE [ASCIZ/:IF /]	;GFROBP CALLS HERE, FROM ALTDQX.
	MOVE D,KIFTB1(D)	;D HAS 1ST WD OF SYL.
	CALL SIXTYP
	JRST TSPC

KIFMOR:	CALL MORFL1	;DO A **MORE** AND GET RESPONSE.
	 AOS (P)	;USER FLUSHED, MAKE COND. FAIL.
	RET

KIFTB1:
IRPS X,,E N L G LE GE MORE
SIXBIT/X/
TERMIN
KIFTBL==.-KIFTB1

KIFTB2:
IRPS X,,N E GE LE G L
SKIP!X A
TERMIN
	CALL KIFMOR
IFN .-KIFTB2-KIFTBL,.ERR 

;:ELSE SUCCEEDS IF PREV. CONDITIONAL FAILED.  :ALSO SUCCEEDS IF IT SUCCEEDED.
KALSO:	SKIPA B,SUCCES
KELSE:	 SETCM B,SUCCES
	SETOM SUCCES		;:ELSE AFTER A :ELSE SUCCEEDS IF THE PREV. :ELSE FAILED.
	JUMPL B,GSNLRT
	JRST KIFLOS

;$) EXECUTED IMPLIES IT IS THE END OF A SUCCESSFUL CONDITIONAL, SO MAKE SURE FOLLOWING
;CONDITIONAL KNOWS THAT (REGARDLESS OF WHAT CONDITIONALS INSIDE THE $( - $) DID).
NARPRN:	SETOM SUCCES
	JRST GSNLRT

;:DDTSYM FOO      EVALUATES FOO IN DDT SYM TAB.
KDDTSY:	CALL GTFROB	;READ SYMBOL (AS FROB, UNEVALUATED SYMBOL)
	JUMPE B,ALTDQX	;PASS SPACES.
	CAME B,[SYLSYM,,] ;NOT SYMBOL, DON'T EVAL.
	JRST GSDDTJ
	MOVEM A,SYM
	MOVE A,STBDDT
	CALL SLUP
	 2,,SEVLB1	;DDT SYM TAB HAS BLOCK STR.
	 7TYPE [ASCIZ/?U/]
	MOVE A,1(A)	;FOUND, RETURN THE VALUE.
GSDDTJ:	MOVE B,[SYLSYM,,4^5]	;RETURN DDT REF.
	RET

;:SYMTYP <SYMBOL>
;VALUE IS 0 IF SYMBOL UNDEFINED, ELSE
;BIT 4.9 => HALF KILLED, BIT 4.8 => INITIAL SYM,
;BIT 4.7 => DEFINED BUT NOT IN CURRENT BLOCK OR CONTAINING BLOCK,
;BIT 4.6 => DDT-REFERENCE, BIT 4.5 => .USET VARIABLE.
;RH HAS ADDR OF STE IN DDT (WON'T BE VALID IF MOVE SYM TAB)
;RH WILL BE 0 FOR AN INSTRUCTION NAME. (4.8 WILL BE ON)
KSYMTY:	CALL GTFROB	;READ SYMBOL NAME.
	JUMPE B,ALTDQX
	CAME B,[SYLSYM,,]
	 RET		;NOT SYMBOL, RETURN.
	MOVEM A,SYM
	CALL SEVL	;TRY TO EVAL.
	 JRST KSYMT3
	ANDI A,-1
	MOVEI B,2	;ASSUME INITIAL, SET WHAT WILL BE BIT 4.8.
	CAIGE A,DDTEND
	CAIGE A,STBSPG*2000
	 TRZ B,2	;NOT INITIAL.
	IOR B,FNYLOC	;FUNNYNESS WILL GO IN BITS 4.5,4.6.
	ROT B,-3
KSYMT4:	MOVE D,(A)	;SEE IF HALF-KILLED.
	TLNE D,%SYHKL
	 TLO B,4^5	;SIGN SET IF YES.
	HLL A,B		;ALSO HAVE ADDR OF STE IN RH.
	JRST GSOCTJ

KSYMT3:	CALL OPLK2	;NOT FOUND IN CURRENT BLOCK, TRY OP CODES AND OTHER BLOCKS.
	 JRST [SETZ A, ? JRST GSOCTJ]  ;NOT DEFINED.
	 JRST [MOVSI B,1^5 ? JRST KSYMT4]  ;FOUND IN OTHER BLOCK.
	MOVSI A,2^5	;OP CODE, SAY IS INITIAL.
	JRST GSOCTJ

NALTM:	SKIPN ARG1+1
	JRST NALTM2
	MOVE D,ARG1
	MOVEM D,MSK(A)
	JRST LCTGNR

NALTM2:	ADDI A,MSK	;NO ARG - RETURN THE FUNNY LOCATION OF THE MASK (IN DDT)
	JRST GSDDTJ	;RETURN EVALUATED FUNNY SYMBOL.

NALTEW:	MOVEI A,-1
NALTW:	SKIPA D,[JUMPN I1,]
NALTN:	MOVSI D,(JUMPE I1,)
	TDNN A,[-10]	;INFIX ARG > 7 => IT IS IMMEDIATE MASK;
	 MOVE A,MSK(A)	;ELSE IT IS INDEX INTO TABLE OF MASKS.
	MOVEM A,MSKUSE'	;SAVE VALUE OF MASK TO USE FOR THIS SEARCH.
	HLLM D,NLTNWX
	PUSHJ P,NAENW	;GET "ARGS"
	SETCAM A,WRD'
NALTN2:	PUSHJ P,GCBLKP	;GET BLOCK TO READ
	 JRST KLSTUX	;LIKE NLTL2 BUT FLUSHES THE MORINI!  THIS IS ESENTIAL!
NALTN4:	MOVE I1,(A)
	EQV I1,WRD
	AND I1,MSKUSE
	XCT NLTNWX	;SKIP UNLESS SATISFIES CONDITION.
	PUSHJ P,ENWPNT	;PRINT VALUE, SET $Q, TEST FOR END OF SCREEN.
NALTN5:	AOBJN A,NALTN4
	PUSHJ P,OUTTST	;SKIP IF OUTPUT IS GOING ANYWHERE.
	 JRST KLSTUX	;IT ISN'T, QUIT SEARCHING.
	JRST NALTN2

NALTE:	HRROI C,PES	;NO ARG => SET E&S TYPEOUT MODE.
	SKIPN ARG1+1
	 JRST NSET0
	SKIPN SYSSW
	 SKIPE DDTSW
	  JRST NALTEW
	PUSHJ P,NAENW
	HRRZM A,WRD
	PUSHJ P,EASETU
NALTE2:	PUSHJ P,GCBLKP
	 JRST KLSTUX
	SAVE D
NALTE4:	MOVE D,(A)		;GET NEXT WORD AND DO ADDRESS CALCULATION.
	PUSHJ P,NEFECC
	CAMN I1,WRD
	 PUSHJ P,ENWPNT		;IF ADDRESS MATCHES ARG, PRINT THIS LOCATION.
NALTE5:	TLNE A,177
	 JRST NALTE6
	CALL OUTTST		;EVERY 128 WORDS, CHECK FOR ^W OR ^E.
	 JRST [	REST D		;AND STOP IF OUTPUT BEING DISCARDED.
		JRST KLSTUX]
NALTE6:	AOBJN A,NALTE4		;SEARCH THROUGH THIS BLOCK OF MEMORY
	REST D
	JRST NALTE2		;THEN MAP IN THE NEXT ONE.

GCBLKP:	PUSHJ P,GCBLKR
	 POPJ P,
	SUB B,A
	SETCA B,	;NEGATE AND SUBTRACT ONE
	HRL A,B
	JRST CPOPJ1

;CALL ENWPNT TO PRINT OUT A LOCATION IN A SEARCH.  CAN POP1J IF OUTPUT FLUSHED.
;ASSUMES A HAS AOBJN POINTER IN DDT ADDRESS SPACE AND C HAS ADDR OF START OF THIS BLOCK
;IN THE SUBJOB'S ADDRESS SPACE.
ENWPNT:	PUSH P,D
	MOVE D,C
	SOS D
	PUSH P,C
	HRRZ C,A
	CAIL C,AC0
	 CAILE C,AC0+17
	  SKIPA
	   SUBI C,AC0	;WIN FOR ACS
	DPB C,[1200,,D]	;GET REAL ADR IN D
	MOVE C,(A)	;GET CONTENTS
	PUSH P,A	;SAVE AOBJN POINTER
	ANDI D,-1
	SAVE D		;SAVE ADDRESS OF LOCATION.
	SAVE C
	PUSHJ P,PAD
	7TYPE [ASCIZ \/   \]
	POP P,D
	PUSHJ P,ENWPAT
	CALL CRF
	SKIPN TTYFLG
	 CALL TYOFRC	;FORCE OUT TYO.
	SKIPN TTYFLG
	 .LISTEN D,	;WAIT FOR TYPEOUT TO FINISH.
	REST D		;NOW THAT WE'VE TYPED OUT, ANY **MORE** HAS ALREADY HAPPENED.
	CALL PLOC	;TYPEOUT OF THIS LOCATION WASN'T FLUSHED, SO OK TO SET POINT.
	AOSN CTLDFL	;^D HAS INTERRUPTED => STOP.
	 JRST POP4N4
	POP P,A
POPCDJ:	POP P,C
	POP P,D
	POPJ P,

POPAN2:	POP P,A
	JRST NLTL2

POP4N4:	SUB P,[4,,4]
	CALL MORFL2
	JRST NLTL4

ENWPAT:	PUSHJ P,LWTPUT
	JRST PVAL

;COMPUTE EFFECTIVE ADDRESS FROM ARG IN D.
;RESULT GOES IN I1. CONTENTS OF ACS ARE TAKEN FROM AC0, ETC.,
;USE EASETU TO SET THEM UP FOR CURRENTLY SELECTED JOB.
NEFECC:	SAVE D
	SAVE A
	SAVE B
	MOVEI I1,14
	MOVEM I1,TEM
NEFEC2:	LDB B,[220400,,D]
	JUMPE B,NEFEC3
	MOVE B,AC0(B)
	ADD B,D
	HRR D,B
NEFEC3:	HRRM D,TEM2
	TLNN D,20
	JRST NEFEC6
	HRR A,D
	SOSE TEM
	PUSHJ P,RFETCH
	JRST NEFEC6
	JRST NEFEC2

NEFEC6:	HRRZ I1,TEM2
	REST B
	JRST POPADJ

EASETU:	CALL QJERR
	.ACCESS USRI,[0]	;READ JOB'S ACS SO WE CAN DO EFFECTIVE ADDRESS CALC.
	MOVE A,[-20,,AC0]
	.IOT USRI,A
	POPJ P,

;GOBBLE ARGS TO $E, $N OR $W.
;COMPUTE BOUNDS OF SEARCH AND WHAT TO SEARCH FOR.
;RETURNS LOW LIM. IN C, HIGH LIM. IN D, OBJECT OF SEARCH IN A.
NAENW:	JUMPL U,QJERR
	HLRZ C,LIMIT(U)
	SKIPE ARG1+3
	 HRRZ C,ARG1	;GET 1ST ARG IF 2ND EXISTS, ELSE DEFAULT LOW LIM.
	HRRZ D,LIMIT(U)
	HLRZ A,ARG1
	SKIPE A
	 SKIPN ARG1+3	;GET LH OF 1ST ARG, IF NONZERO AND THERE'S A 2ND ARG;
	  CAIA		;ELSE BE CONTENT WITH THE DEFAULT (..LIMIT)
	   MOVE D,A
	SKIPE ARG1+5
	 HRRZ D,ARG1+2	;GET 2ND ARG IF 3RD EXISTS, ELSE LH(1ST) OR ..LIMIT
	CAMLE C,D
	 JRST NAERR	;LOW LIM > HIGH LIM?
	SKIPE SYSSW
	 JRST NAENW1
	.USET USRI,[.RMEMT,,A]
	CAIGE A,20	;SEARCH THROUGH AC'S EVEN IF THERE'S NO CORE.
	 MOVEI A,20
	CAIG A,(D)	;DON'T LOOK BEYOND MEM TOP (SAVES WORK)
	 SOS D,A
NAENW1:	SAVE D
	CALL MORINI
	 JRST POP2N4
	REST D
	MOVE A,LWT	;GET $Q OR LAST ARG IN A
	SKIPE ARG1+1
	MOVE A,ARG1
	SKIPE ARG1+3
	MOVE A,ARG1+2
	SKIPE ARG1+5
	MOVE A,ARG1+4
	JRST CRF

POP2N4:	SUB P,[2,,2]
	JRST NLTL4

GCBLKR:	TDZA B,B	;GET BLOCK 
GCBLKW:	MOVSI B,400
GCBLK0:	CAMLE C,D
	 JRST VPAGR1	;NO MORE WDS TO DO, DONE.
	SKIPGE FNYLOC
	 JRST GCBLK1
	SKIPE SYSSW
	JRST GCBLKS
	CAIG C,17
	JRST GCBLKA	;ACS
GCBLK1:	LDB A,[121000,,C]
	SKIPGE FNYLOC
	 IORI A,400000+VPAGE_9	;SEARCHING THROUGH DDT.
	SKIPL FNYLOC
	 IOR A,[2000+USRI,,400000+VPAGE_9]
	IOR A,B
GCBLK3:	.CBLK A,
	JRST GCBLK2
	LDB A,[1200,,C]
	TRO A,400000
	TRZ C,1777
	ADDI C,2000
	CAMLE C,D
	JRST GCBLK4
	MOVEI B,401777
	JRST CPOPJ1

GCBLKS:	JUMPN B,NXERR	;SYS
	CAIG D,20
	JRST NXERR
	CAIGE C,20
	MOVEI C,20
	LDB A,[121100,,C]
	IOR A,[1000,,400000+VPAGE_9]
	JRST GCBLK3

GCBLK2:	TRZ C,1777
	ADDI C,2000
	JRST GCBLK0

GCBLK4:	LDB B,[1200,,D]
	TRO B,400000
	JRST CPOPJ1

GCBLKA:	PUSHJ P,EASETU	;ACS UGH BLETCH
	MOVEI A,AC0
	ADD A,C
	MOVEI C,20
	MOVE B,D
	CAILE D,17
	MOVEI B,17
	ADDI B,AC0
	JRST CPOPJ1

;$$Z - FILL ALL OR A SPECIFIED RANGE OF CORE WITH ZERO OR A SPECIFIED CONSANT.
N2ALTZ:	CALL QI6JERR	;JOB MUST BE OUR INFERIOR OR THE PDP6, TO ZERO IT.
	SKIPN SAFE(U)
	 JRST N2LTZ1
	7TYPE [ASCIZ /--Zero Protected Job--/]
	CALL MORFL1
	 JRST ERR
N2LTZ1:	CALL N2AZ1	;GET LOW LIMIT IN C, HIGH LIMIT IN D.
	CAMLE C,D
	 JRST NAERR	;LOW > HIGH?
	MOVE I1,ARG1+4	;GET ZERO OR THIRD ARG IF SUPPLIED
N2LTZ2:	PUSHJ P,GCBLKW
	JRST NLTL2
	MOVEM I1,(A)
	HRLS A
	AOS A
	BLT A,(B)
	CAIE C,20
	JRST N2LTZ2
	.ACCES USRO,[0]	;WIN FOR ACS
	MOVE A,[-20,,AC0]
	.IOT USRO,A
	JRST N2LTZ2

N2AZ1:	HRRZ C,ARG1	;GET 0 OR 1ST ARG IF ANY.
	.USET USRI,[.RMEMT,,A]
	SOS D,A		;GET HIGHEST LEGAL LOC.,
	SKIPE ARG1+3
	HRRZ D,ARG1+2	;OR 2ND ARG IF ANY.
	RET

NCOL:	MOVEM B,NCOLSB	;SAVE B, C, D FOR DEBUGGING.
	MOVEM C,NCOLSC
	MOVEM D,NCOLSD
	JUMPE D,NCOM	;:, $:, $$:. CHECK FOR COLON-COMMAND.
	CAME D,[SYLSYM,,]
	JRST NCOL2
	TLNE B,O.1ALT+O.2ALT	;CHECK FOR $:, $$:.
	JRST NACOL
	JUMPL U,JERR	;DEFINE SYM, MUST HAVE JOB.
	PUSH P,C
	SUB W4,[2,,2]	;POP THE COLON OFF FROB TABLE.
	MOVEI D,GFLD1	;ERRORS SHOULDN'T RE-POP IT.
	MOVEM D,ERRSTL
	PUSHJ P,EVARGS
	POP P,SYM
	MOVE D,LLOCO
	SKIPE ARG1+1	;DON'T ALLOW DEFINING A SYMBOL TO A VALUE
	 MOVE D,FNYLOC	;WHICH IS A DDT ADDRESS OR .USET VARIABLE.
	TLNE D,-1
	 JRST ERR
	SKIPE ARG1+1
	 MOVE D,ARG1
	PUSHJ P,DEFIN
	PUSHJ P,LCT
	JRST ERR6	;NORMAL RETURN WOULD ASSUME FROB TAB UNCHANGED.

NCOL2:	EXCH C,-1(W4)
	EXCH D,(W4)
	PUSH W4,C
	PUSH W4,D

;HANDLE :-COMMANDS, COME AFTER RFEADING ":".
;FLC - WAS $: OR $^K, LOAD SYMS.
;FLLET - DEV OR SNAME SPEC'D - DON'T TRY USUAL DIRS.
;EITHER ONE -> DON'T USE BUILT-IN COMMANDS EXCEPT ":NEW".
NCOM:	PUSHJ P,GSOA	;COME BACK HERE ON RUBOUT.
	 JRST [ SETZM MONMDL	;: RUBBED, LEAVE MONIT MODE FOR A WHILE.
		MOVEI D,":
		CALL RUBCHR	;ERASE CHAR FROM SCREEN (OR ECHO ON PRINTING TTY)
		JRST GSNLRT]
	SETZM XCRFSW	;PREVENT :SENDD <RUB><RUB> ... FROM LEAVING XCRFSW SET.
	SETOM REOWNF	;REOWNF < 0 => IF JOB EXISTS, LOAD OVER IT.
	SOS REOWNF	;AND -2 IMPLIES SAY "--CLOBBER EXISTING JOB--" EVEN IF ..CLOBRF IS 0.
	SKIPE GENJFL
	 HRRZM P,REOWNF	;REOWNF > 0 => IF JOB EXISTS, MAKE ANOTHER JOB.
	TLZ F,FLQ	;SAY BUILT-IN COMMANDS ARE PERMITTED.
	JRST NCOM4

KRETRY:	SETOM REOWNF	;:RETRY => PREFER TO CLOBBER.
	CAIA
KNEW:	 HRRZM P,REOWNF	;:NEW => MAKE NEW JOB RATHER THAN CLOBBER.
	TLO F,FLQ	;SUPPRESS BUILT-IN COMMANDS; :NEW DUMP SHOULD LOAD TS DUMP.
NCOM4:	MOVE B,(W4)
	TLZ F,FLC+FLLET
	TLNE B,O.1ALT
	TLO F,FLC
	PUSHJ P,NCOMI	;INIT. DEV, SNAME, FLLET.
NCOM1:	PUSHJ P,RTOKEN	;B_COMMAND NAME (6BIT).
	CAIN D,33	;IF NO TOKEN, JUST ALTMODE,
	JUMPE B,NCOMC	;READ COMMENT.
	SKIPL TOKTRM
	JUMPE B,NCOM1	;IF NULL, AND NOT ^M, GET ANOTHER.
	JUMPE B,NLTL4	;NULL COMMAND
	CAIN D,":	;COLON - SET DEV, INHIBIT BUILT-IN COMMANDS.
	JRST [MOVEM B,SFILE ? JRST NCOM0]
	CAIN D,";	;SEMICOLON SIMILAR BUT SET SNAME.
	JRST NCOMS
	MOVEM B,NCOMNM	;REMEMBER NAME OF :-COMMAND.
	MOVE D,(W4)
	CAME B,['NEW,,] ;$: DOESN'T INHIBIT :NEW LIKE OTHER BUILT-INS.
	 CAMN B,[SIXBIT /RETRY/]
	  TLNE F,FLLET+FLQ	;:FOO;NEW AND :NEW NEW SHOULD RUN TS NEW.
	   TLNN F,FLC+FLLET+FLQ	;BUILT IN CMDS INHIBITED -> GO LOAD FILE..
	    TLNE D,O.2ALT	;$$: ALSO INHIBITS THEM (EVEN :NEW!).
	     JRST NCOM3
	call nclook		   ;look up the command in the table
	  caia			   ;  Didn't find it, must be a program
	    jrst ncl2		   ;    found it, dispatch.

NCOM3:	MOVEM B,SYSN2	;DUMMY UP "NAME^K".
	SETOM XCRFSW	;AN EXTRA CRLF WOULD LOOK BAD AFTER :FOO <CR>
	JRST ACTRLK

;;; look for a command in the command table, takes command in B,
;;; returns offset in NCTAB in A

nclook:	camn b,nctab(a)
	  jrst popj1		   ;  found the command, skip return
	caige a,nlcom-2
	  aoja a,[aoja a,nclook]
	ret			   ;Didn't find the command, fail return

NCL2:	HRRZ D,NCTAB+1(A)	;BUILT-IN COMMAND.
	SETZ A,			;TELL THE COMMAND ITS "INFIX ARGUMENT" WAS 0.
	JRST (D)

NCOMS:	MOVEM B,SFILE+3
NCOM0:	TLO F,FLLET
	JRST NCOM1

NCOMPT:	CTYPE ":	;RTN TO RETYPE A :-CMD'S NAME
	PUSHJ P,SIXTYP	;IF THE COMMAND IS RUBBED AS A SYLLABLE
	JRST TSPC	;(EG AFTER THE COMMAND CALLED GSOA,
	   ;WHICH WILL REPLACE THE : ON THE FROB STACK
	   ;WITH A SYLLABLE THAT WILL COME HERE TO BE RETYPED)

KMONMO:	SETOM MONMOD	;:MONMOD, ENTER MONIT MODE.
	SETOM MONMDL
	JRST NLTL4

KDDTMO:	SETZM MONMOD	;LEAVE MONIT MODE.
	SETZM MONMDL
	JRST NLTL4

NCOMI:	MOVEI D,'DSK
	HRLZM D,SFILE
	MOVE D,MSNAM	;DEFAULT IS DSK:<MSNAME>
	MOVEM D,SFILE+3
	TLZ F,FLLET	;BUT CAN TRY SYS; AND SNLIST.
	POPJ P,

NCOMC:	JSP W2,RCH	;COMMENT CONTINUES THRU NEXT ALTMODE.
	CAIN D,33
	 JRST NCOM1
	JRST NCOMC

;; :JCLPRT -- print JCL of the current job
kjclprt:
	call terpri	;fresh line
	skipl a,uchbuf(u)  ;get the JCL pointer
	  jrst [ 7type [asciz /[No JCL]/]  ;tell him there's none
		 jrst nltl4]
	7type (a)	;type it
	jrst nltl4	;prompt and return

;:JCL
KJCL:	PUSHJ P,QIJERR	;MUST HAVE INFERIOR OPEN TO RECEIVE .BREAK .
	SKIPN TOKTRM
	PUSHJ P,RLINEC	;ELSE READ IN COMMAND,
	PUSH P,[NLTL4]

;RLINE MUST HAVE BEEN CALLED BEFORE CALLING JCL .
;SET JOB'S COMMAND BUFFER.
JCL:	MOVEI W1,UCHBUF(U)
	CALL JCL0	;READ IN THE STRING, SET UCHBUF.
JCL3:	.USET USRI,[.SUSTP,,[-1]]
	.USET USRI,[.ROPTIO,,A]
	TLO A,OPTCMD+OPTBRK+OPTDDT	;SET JOB'S OPTBRK AND OPTDDT BITS,
	SKIPL UCHBUF(U)
	 TLZ A,OPTCMD	;SET OPTCMD BIT IFF HAVE COMMAND FOR IT.
	.USET USRI,[.SOPTIO,,A]
TSTOPX:	SKIPN UINT(U)	;UNSTOP A TEMPORARILY STOPPED JOB.
	 SKIPE UINTWD(U)
	  RET		;(BUT NOT PERMANENTLY STOPPED OR WAITING JOBS)
	SKIPG INTBIT(U)	;(AND NOT ON NON-INFERIOR JOBS WHICH WE CAN'T UNSTOP)
	 RET
	SKIPN UHACK(U)	;(OR JOBS WAITING FOR HAKKAH)
	 .USET USRI,[.SUSTP,,[0]]
	RET

;W1 HAS ADDR OF AOBJN PTR,
;READ A LINE INTO SYMTAB SPACE, PUT AOBJN TO IT THERE.
JCL0:	PUSH P,W1
	PUSHJ P,ELEC0	;FLUSH EXISTING COMMAND BUFFER.
	SKIPE TOKTRM	;IF ":JCL^M", LEAVE IT CLEAR.
	JRST POPW1J
	HRRZ B,GSCHRP	;GET PTR RE-READING FROM,
	HRRZ D,GSCHRQ	;AND PTR TO END,
	SUBI D,-1(B)	;MAX NUM. WDS WILL NEED TO HOLD COMMAND.
	PUSHJ P,ALLOC	;GET THAT MANY IN SYMTAB SPACE,
	MOVEM A,@(P)
	MOVEI B,(A)	;MAKE B.P. INTO OBJECT JUST ALLOCATED.
	HRLI B,440700
JCL2:	PUSHJ P,SLRPIN	;THEN READ CHARS AND STUFF INTO SPACE OBTAINED.
	IDPB D,B
	CAIE D,^_
	 CAIN D,^C	;UNTIL THE CR OR ^C.
	  JRST JCL4
	CAIE D,^M
	 JRST JCL2
JCL4:	LDB D,[360600,,B] ;ZERO OUT REST OF UNFILLED WORD.
	DPB D,[300600,,B]
	TLZ B,770000
	SETZ D,
	DPB D,B
	HRRZ D,@(P)	;AND IF THERE ARE MORE WORDS IN THE SPACE ALLOCATED,
	HLRE A,@(P)
	SUB D,A		;ZERO THE FIRST OF THEM, TOO.
	CAIE D,1(B)
	 SETZM 1(B)
	JRST POPW1J

;; Long JCL
kljcl:	call qijerr		   ;must have a real inferior to hack JCL
	call kljcl0		   ;read in the JCL now
	  jrst nltl4		   ;  prompt and return, we were aborted
	call kljcl1
	jrst nltl4		   ;prompt and exit

;; KLJCL1 takes the contents of the VPAGAD buffer and sticks it in the jobs
;; JCL buffer.

kljcl1:	movei d,vpagad
	move c,jclend		   ;recall the end of the buffer
	subi d,(c)		   ;-<# of words of JCL to hack>
	hrlzi a,(d)		   ;A <= -<# of words to jack>,,0
	push p,d		   ;save -<# of words of JCL>
	push p,a		   ;save -<# of words of JCL>,,0
	movei w1,uchbuf(u)	   ;AOBJN ptr for this job's JCL
	call elec0		   ;flush any JCL that used to be there
	movei w1,uchbuf(u)	   ;AOBJN ptr for this job's JCL
	move d,symtop		   ;make sure there's a pointer in there
	movem d,(w1)		   ;null ptrs have the same content as SYMTOP
	pop p,a			   ;get -<# of words of space>,,0 for HOLE0
	call hole0		   ;allocate the space
	pop p,c			   ;restore -<# of words of JCL>
	movns c			   ;<# of words of JCL>
	hrlzi d,vpagad		   ;From the beginning of the bufffer
	hrr d,uchbuf(u)		   ;ptr to the space its going into
	addi c,(d)		   ;C -> last word to transfer into
	blt d,(c)		   ;perform the transfer
	call vpagrt		   ;return the buffer page
	jrst jcl3		   ;and tell the job there's JCL
	
;;; KLJCL0 reads in a VPAGAD buffer full of stuff
kljcl0:	call vpaget		   ;get a buffer page
	move c,[010700,,vpagad-1]  ;start out at the beginning of the buffer
	movem c,bufbeg		   ;and allow rubouts all the way back to here
	call bgread		   ;read the JCL
	  popj p,		   ;  Aborted (via ^Z)
	call bugrdx		   ;Deposit our terminating character
	setz d,			   ;Pad the string with nulls
	repeat 5,[? came c,[010700,,vpagad+1777] ? idpb d,c ]
	movem c,jclend		   ;remember the end pointer of our JCL
	jrst popj1		   ;skip return, we got something

;;; :RUN <program> <JCL>
krun:	setzm lrunsw		   ;note we're not hacking long HCL
	caia
;;; :LRUN <program> <long-JCL>^C
klrun:	  setom lrunsw
	call rtoken		   ;read in a 6bit name
	save ttyflg		   ;remember flag state for later
	sosge ttyflg		   ;turn on the flag one level
	  setzm ttyflg		   ;  if over-on, just turn it on
	push p,[[ rest ttyflg ? ret]]  ;put on a frob to restore the stack
	call nclook		   ;look for the command
	  caia			   ;  not found, must be a program
	    jrst ncl2		   ;    found a built-in, let it do it's thing
	movem b,sysn2		   ;that's the JNAME to use
	setom insist		   ;we don't need the file yet, don't error yet
	skipn ckqflg		   ;if CKQFLG is zero
	  hrrzm p,insist	   ;  We barf now anyway
	skipl ckqflg		   ;If we want early checking of file
	  call fndcmd		   ;  Find the file to use
	skipe lrunsw		   ;otherwise
	  jrst klrun0		   ;  try to read long JCL, return here if win
	skipe toktrm		   ;did he already end his input?
	  jrst klrun1		   ;   then there's no JCL
	skipn lrunsw		   ;if we're not reading long JCL
	  call rlinec		   ;read in the line to get JCL from
klrun1:	skipn insist		   ;if we failed the first time,
	  opner ctlho		   ;  barf now.
	hrrzm p,insist		   ;we need the file for real now, barf if lost
	skipge ckqflg		   ;if we didn't already do it,
	  call fndcmd		   ;  Find the file to use
	setom reownf		   ;REOWNF gets -2 unless ..GENJFL is non-zero
	skipn genjfl		   ;unless GENJFL is set meaning to "GENJOB"
	  sos reownf		   ;  in which case it gets -1 to just clobber
	skipn lrunsw		   ;if we're not reading long JCL
	  jrst klrunx		   ;  do things the old way
klrun9:	call ctlh4		   ;create the job
	  call kljcl1		   ;  Get the JCL for the job the long way
	jrst ctlh8		   ;run the job

klrunx:	call ctlh4		   ;create the job
	  call jcl		   ;  get the JCL for it, one line only
	jrst ctlh8		   ;run the job

klrun0:	 call kljcl0	   ;  read in the JCL to use
	   jrst [ caie d,^Z  ;  Abort or rubout?
		    jrst rubfls ; over-rubout, fail back to the readin
		  jrst nltl4] ; He aborted it
	jrst klrun1		   ;all is normal, back to hacking


NGDEV:	JUMPE D,CPOPJ	;CONVERT SYL IN C,D TO DEVICE NAME.
	CAIN D,D6PNT
	 JRST NGDEV4	;SIXBIT SYL, USE SIXBIT AS DEV NAME.
	SKIPL C
	 CAILE C,10
	  JRST NGDEV4	;NOT NUMBER FROM 0 TO 8 => USE VALUE.
	SKIPN C
	 SKIPA C,['DSK]	;0 => DSK, N =>UTN.
	ADDI C,'UT0
	HRLZS C
NGDEV4:	MOVE D,C	;RETURN FULL WD IN C, 1ST 3 CHARS IN RH OF D.
	RET

NBITE:	JUMPL D,NBITE2	;IT'S AN OPERATOR, PUSH BACK ON FROB STACK.
	CAME D,[SYLSYM,,]
	 RET
	SAVE A
	MOVEM C,SYM	;SYMBOL, CONVERT NAME TO 6BIT, RETURN 6BIT SYL.
	MOVEI W1,SYM
	MOVE C,[404040,,404040]	;FILL WITH WHAT WILL BE SPACES.
	MOVE D,[IDPB D,A]	;THIS WILL GO IN SPTS
	MOVE A,[440600,,C]
	CALL .SPT
	MOVEI D,D6PNT	;RETURN 6BIT SYL.
	XOR C,[404040,,404040]	;.SPT DIDN'T SUBI 40 FROM ASCII CHARS.
	JRST POPAJ

NBITE2:	PUSH W4,C	;OPERATOR, REPUSH
	PUSH W4,D
	SETZB C,D
	RET

kcwd0:	call rtoken	; :CWD <msname> or :CWD<cr>
	skipn toktrm	; unless terminated
          jumpe b,kcwd0	;   More blankness, keep reading
	move c,b	;get the result in C
	jrst n2acs	;and set the MSNAME appropriately.

kcwd:	skipn toktrm	;has the carraige return already been typed?
	  jrst kcwd0	;  no, gotta read the frob
	setz c,		;start out with no arg!
n2acs:	skipn c		;null or zero arg?
	  move c,hsname	;  yes, use the HSNAME
	call ddtmsn	;for $$^S, set msname.
	move a,lsnam
	call rrfl3	;put sname in snlis1 .
	.suset [.ssname,,msnam]  ;For the sake of the wholine
	jrst nltl2

NACS:	jumpn d,nacs1		   ;$^S with arg set TUNAME and THSNAM
	move c,xuname		   ;$^S, WITHOUT ARG RESTORES TUNAME TO XUNAME.
	movem c,tuname
	move c,hsname
	movem c,thsnam
	jrst nltl2

nacs1:	movem c,tuname		   ;remember this as the temporary name
	call gethsn		   ;get the HSNAME for it
	  jfcl
	movem c,thsnam		   ;and remember it
	jrst nltl2


NCTLS:	JUMPE D,NLTL2	;^S, SET JOB'S
	SKIPGE UCHNLO	;DON'T USET UNLESS INFERIOR.
	.USET USRI,[.SSNAM,,C]
	JRST NLTL2

;BREAKPOINT ROUTINES
;(BPLF=>BPT NON VALUE COMMAND)

NALTB:	SKIPE ARG1+1
	JRST NBPS1
	TLNE B,O.IFX
	JRST NBPS2	;$NB, $$NB
	TLNN B,O.2ALT
	JRST NBPS6
	CALL NALTBS	;STOP JOB IF RUNNING, REMOVE BPTS IF IN.
	MOVEI D,B1ADR+1(U)	;$$B
	HRLI D,-1(D)	;FLUSH ALL BPTS
	SETZM B1ADR(U)
	BLT D,BPEND-1(U)
	HLLZS D,BPINFL(U)	;CLEAR ALL AUTO-PROCEED BITS.
	MOVE D,UINTWD(U)
	CAIG D,15	;IF JOB IS STOPPED AT A BREAKPOINT, FORGET THAT FACT.
	 SKIPG D	;OTHERWISE, IF USER SETS ANOTHER BPT WITH SAME NUMBER AS
	  JRST NALTBX	;THE ONE TH JOB HIT, WE WON'T STOP AT IT WHEN WE PROCEED.
	SETOM UINTWD(U)
NALTBX:	SKIPGE (P)	;IF BPTS HAD BEEN IN, PUT BACK IN.
	 CALL INSRTB
	CALL TSTOPX	;IF HAD BEEN RUNNING, RESTART.
	JRST LCTGNR

NBPS1:	MOVE D,ARG1
	TLNN B,O.IFX
	 JRST NBPS3
	JUMPE A,NBPSF	;N$0B	;FLUSH BPT AT N.
	TRO F,BPLF	;N$MB	;ADD BPT M
NBPS2:	CAIL A,1	;ENTER HERE FOR $$NB, FLUSH BPT N
	 CAILE A,11	;ALLOW $9B FOR HACKS IN USER AREA
	  JRST NAERR
NBPS7:	IMULI A,BPL
	ADDI A,B1ADR-BPL(U)
	TRZN F,BPLF
	 JRST GSDDTJ
	CAIN A,STARTA(U)		;MAKE FOO$9B WORK TO SET START ADDRESS WITHOUT
	 JRST [	MOVEM D,STARTA(U)	;ANY OF THE BREAKPOINT-INSERTION HAIR.
		JRST LCTGNR]
NBPS5:	CALL NALTBS	;TEMPORARILY STOP JOB & REMOVE BPTS.
	JUMPE D,NBPS9
	SAVE A		;INSERTING, CHECK FOR DUPLICATE
	CALL NBPS4
	    CAIN C,(D)
	 MOVEM A,(P)	;USE SAME SLOT
	SAVE D
	MOVEI A,(D)	;READ CONTENTS OF PLACE TO PUT BREAKPOINT,
	CALL RFETCH
	 JRST NXERR
	CALL DEP	;STORE BACK TO UNPURIFY OR TYPE PUR?
	REST D		;-> PLACE TO PUT BPT.
	REST A		;-> BREAKPOINT SLOT.
NBPS9:	MOVEM D,(A)
	SETZM 1(A)
	SETZM 2(A)
	SUBI A,B1ADR(U)
	SAVE B
	IDIVI A,BPL
	MOVE B,UINTWD(U)
	CAIN B,1(A)	;IF BPT BEING FLUSHED OR RESET WAS THE REASON JOB IS STOPPED,
	 SETOM UINTWD(U) ;FORGET THAT FACT.
	REST B
	CALL BUTOP1
	JRST NALTBX

NBPS6:	MOVE A,UINTWD(U)	;$B
	CAIL A,1	;FLUSH CURRENT BPT
	 CAILE A,10
	  JRST NXERR
	MOVEI D,0
	TRO F,BPLF
	JRST NBPS7

NBPS3:	CALL NBPS4	;N$B, N$$B
	   SKIPN C
	 JRST NBPS5
	ERSTRT [SIXBIT/TOO MANY BPTS?/]

;NOTE: NALTBS SETS THE WORD ON THE PDL UNDER THE RETURN ADDRESS!
NALTBS:	SAVE D
	SAVE A
	HLLZ D,BPINFL(U)
	HLLM D,-3(P)	;REMEMBER WHETHER BPTS ARE INSERTED (FOR NALTBX)
	SKIPG INTBIT(U)	;IF JOB ISN'T OUR INFERIOR, DON'T TRY TO STOP IT
	 JRST POPADJ
	.USET USRI,[.SUSTP,,[-1]]	;STOP JOB WHILE MUNG IT.
	CALL REMOVB	;REMOVE BPTS IF IN.
	JRST POPADJ

NBPS4:	MOVEI A,B1ADR(U)
NBPS4A:	HRRZ C,(A)
	XCT @(P)
	JRST CPOPJ1	;WIN
	ADDI A,BPL
	CAIGE A,BPEND(U)
	JRST NBPS4A
	JRST CPOPJ2	;LOSE

NBPSF:	PUSHJ P,NBPS4	;N$0B, FLUSH BPT AT N (WHICH IS IN D)
	CAIN C,(D)	;THIS INSN XCT'D BY NBPS4.
	CAIA		;FOUND BPT AT N.
	JRST NXERR	;NONE.
	SETZ D,		;FOUND THE BPT; GO CLEAR IT.
	JRST NBPS5

KLSTB:	PUSH P,U
KLSTB0:	MOVE A,(P)	;(P) HAS USR IDX + BPL*<NUM OF NEXT BPT>
	MOVE D,B1ADR(A)
	JUMPE D,KLSTB1	;THIS BPT NOT IN USE.
	PUSHJ P,CRF
	SUBI A,(U)
	IDIVI A,BPL	;NUM OF BPT
	CTYPE "1(A)
	7TYPE [ASCIZ/   /]
	PUSHJ P,HLFW 	;PRINT ADDR TO OPEN,,ADDR OF BPT.
	MOVE A,(P)
	MOVE D,BPCON(A)
	CTYPE ^I
	PUSHJ P,PIN	;PRINT CONDITIONAL BREAK INSN.
	MOVE A,(P)
	MOVE D,B1CNT(A)	;PROCEED COUNT
	CTYPE ^I
	PUSHJ P,FTOC
KLSTB1:	MOVEI A,BPL
	ADDB A,(P)	;ADVANCE TO NEXT BPT.
	CAIGE A,NBP*BPL(U)
	 JRST KLSTB0
	JRST POPAN2	;FLUSH TOP WD OF PDL, JRST NLTL2

NALTI:	SETZM MARCON(U)
	SETZM MARXCT(U)
	SKIPN D,ARG1+1	;$I
	 JRST NALTI2	;NO ARG => FLUSH MAR.
	HRRZ D,ARG1
	TLO D,3
	TLNE B,200000
	HRL D,A		;USE INFIX NUM ARG
	TLO D,4
	TLNE D,777770
	JRST NAERR
NALTI2:	syscall usrvar,[movei usri ? [sixbit /MARA/] ? move d]
	 jumpn d,[erstrt [sixbit "NO MAR?"]]
	MOVEM D,MARADR(U)
	JRST NLTL2

;;; :datprt <time word> prints the date as a time word
kdatprt:
	call ronum	;read in a number
	  jrst altdqx	;  rubbed out, abort
	skipn b		;if we didn't get anything
	  move a,lwt	;  use Q

	move d,[440700,,fdrctb]	   ;get Byte pointer to FDRC buffer (should be
				   ;  unused at MP level)
	call datime"twdasc	   ;send it down to the buffer
	7type fdrctb		   ;and print it out
	jrst lctgnr		   ;print spaces and return

;;; For now, value is the date word corresponding to the date read in, and
;;; expects to be terminated with a CR, so doesn't work too well in expressions
;;; Should eventually be made to work in expressions.

kdatwrd:
	call rdatew		   ;read in the date word into D
	move a,d		   ;return it
	movsi b,syloct		   ;Dunno why
	ret			   ;and that's it, I think

;:CORBLK PURE <ADDR> MAKES <ADDR>'S PAGE PURE.
;OTHER ALTERNATIVES ARE "NONE", "FRESH", "IMPURE".
KCORBL:	SKIPN DDTSW	;:UNPURE LEGAL ON INFERIOR OR SELF.
	 PUSHJ P,QIJERR
	CALL RTOKEN	;READ CONDITION NAME.
	JUMPE B,KCORBL
	MOVSI A,-KCORTL	;SEARCH TABLE FOR IT.
KCORB1:	CAMN B,KCORBS(A)
	 JRST KCORB2	;FOUND.
	AOBJN A,KCORB1
	ERSTRT [SIXBIT/CORBLK SUBCOMMAND?/]

KCORB2:	MOVEM A,-1(W4)	;ARRANGE TO RETYPE :CORBLK AND CONDITION
	MOVEI A,KCORRB	;ON RUBOUT OR ^L.
	MOVEM A,(W4)	;(CAN ALSO RETRIEVE KCORBX IDX FROM -1(W4))
	SETZM NCOMNM	;DON'T LET GSOA CLOBBER WHAT WE JUST DID.
KCORB4:	CALL RONUM	;READ ARG.
	 JRST ALTDQX	;RUBBED BACK OUT OF ARG.
	JUMPE B,KCORB4	;READ NOTHING => TRY AGAIN.
	MOVE W1,-1(W4)	;GET KIFTB1 IDX OF CONDITION.
	MOVEI C,USRI	;UNLESS SUBCOMMAND ALTERS THIS, GET PAGE FROM SAME JOB
	MOVEI D,%CBNDW	;AND GET WRITE PERMISSION.
	XCT KCORBX(W1)	;DISPATCH ON THE SUBCOMMAND AND LET IT CHANGE THEM.
			;"IMPURE" GOES OFF TO :UNPURE NOW.
	LSH A,-10.	;CONVERT ADDRESS TO PAGE NUMBER.
	SYSCLO CORBLK,[D ? %CLIMM,,USRI ? A ? C ? A]
	JRST NLTL4

KCORRB:	7TYPE [ASCIZ/:CORBLK /]	;GFROBP CALLS HERE, FROM ALTDQX.
	MOVE D,KCORBS(D)	;D HAS 1ST WD OF SYL.
	CALL SIXTYP
	JRST TSPC

;TABLES OF :CORBLK SUBCOMMANDS AND HOW TO HANDLE THEM.
KCORBS:
IRPS X,,PURE IMPURE NONE FRESH
	SIXBIT /X/
TERMIN
KCORTL==.-KCORBS

KCORBX:	MOVEI D,%CBNDR
	JRST UNPUR5
	MOVEI D,0
	MOVEI C,%JSNEW

;; :CORTYP <addr> gives info about type of page <addr> is on

kcortyp:
	jumpl u,njerr	;must have a job to do CORTYP on
	call ronum	;read address
	  jrst altdqx	;  rubbed out, flush
	jumpe b,kcortyp	;read nothing, try again
	7type pagmsg
	andi a,-1	;Ignore LH
	lsh a,-10.	;convert address to page number
	move d,a
	call g8pnt
	move b,uind(u)
	.call typblk	;Collect the info on the page in A
	  erloss	
	skipn a		;does the page even exist?
	  jrst [7type [asciz / (Non-existant)/]
	        jrst nltl4]  ;prompt and return
	call kcort0	;describe the page, since it exists.
	jrst nltl4	;prompt and return

kcort0:	skipe b		;Is this an absolute page?
	  jrst kcort1	;  no, give relevant info on user page

	7type [asciz /, System page # /]
	move a,c	;absolute page #
	call g8pnt	;print it
	popj p,		;that's it, return

kcort1:	tlne a,%cbwrt
	  7type [asciz /, Impure/]
	tlnn a,%cbwrt
	  7type [asciz /, Pure/]
	tlne a,%cbpub
	  7type [asciz /, Public/]
	tlne a,%cblok
	  7type [asciz /, Locked/]

	jumpl b,kcort2		   ;if second val is positive, page is shared
	7type [asciz /, Shared /]
	move a,d
	andi a,-1		   ;RH is # of sharers
	push p,d		   ;don't lose the sign bit to G9PNT
	call g9pnt
	pop p,d			   ;recover our arg
	7type [asciz / times/]

kcort2:	7type [asciz /, Swapped /]
	jumpge d,[7type [asciz /OUT/] ? popj p,]  ;If positive, it's
						     ;swapped 
	7type [asciz /IN/]
	popj p,


typblk:	setz ? sixbit /CORTYP/ ? %climm,,%jsnum(b) ? %climm,,(a)
	%clout,,a ? %clout,,b ? %clout,,c ? setz+<%clout,,d>

pagmsg:	asciz /APage # /

kcorprt: movsi a,-400	;page counter
kcorp1:	 push p,a	;save the page count
	 move b,uind(u)	;get user index of job
	 .call typblk	;get the info
	   erloss
	jumpe a,kcorp9	;if non-existant, don't print anything
	7type pagmsg	;tell what page #
	push p,a	;save the type info
	hrrz a,-1(p)	;get the page # 
	push p,d	;save D from the clutches of G8PNT
	call g8pnt	;print the page #
	pop p,d		;recover D
	pop p,a		;recover the type info
	call kcort0	;print the info on the page
kcorp9:	pop p,a		;recover the page count
	aobjn a,kcorp1	;and on to the next page
	jrst nltl4	;prompt and exit


;$$^M - UNPURIFY OPEN LOCATION IF ANY, THEN STORE ARG.
;NOTE THAT THIS OPERATOR DOES NOT EVAL ARGS.

N2ACM:	TLNN F,FLRO	;DON'T UNPURIFY IF NO LOCATION OPEN.
	 JRST N2ACM1
	MOVE A,LLOCO	;GET ADDR OF OPEN LOCATION, UNPURIFY PAGE.
	PUSHJ P,UNPUR0
N2ACM1:	HRROI B,[50600,,GSNLRT]
	RET		;RETURN AN OPERATOR THAT WILL EVAL ARGS,
			;DEPOSIT ITS ARG, AND DO NOTHING ELSE.

KUNPUR:
UNPURE:	SKIPN DDTSW	;:UNPURE LEGAL ON INFERIOR OR SELF.
	 PUSHJ P,QIJERR
	PUSHJ P,RONUM	;READ ADDRESS OF LOC. TO UNPURIFY.
	 JRST ALTDQX	 ;(TO RUB OUT THE :UNPURE)
	JUMPE B,UNPUR2	;NO ARG => UNPURIFY ALL BUT ABS PAGES.
UNPUR5:	PUSH P,[NLTL4]

;UNPURIFY THE PAGE THE ADDRESS IN A LIES IN.
UNPUR0:	PUSHJ P,VPAGET	;GET FRESH PAGE TO COPY THAT PAGE INTO.
	ANDI A,-2000	;GET ADDR OF START OF PAGE,
	.ACCES USRI,A
	MOVE B,[-2000,,VPAGAD]
	SAVE XRWI
	SETOM XRWI	;.IOT SHOULD SKIP IF IT GETS AN MPV.
	.IOT USRI,B	;COPY OLD PAGE INTO FRESH PAGE.
	 JRST UNPUR4	;NO MPV?
	ERSTRT [SIXBIT/MPV?/]

UNPUR4:	REST XRWI
	LSH A,-10.
	SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,USRI ? A
		%CLIMM,,%JSELF ? %CLIMM,,VPAGE]
	JRST ERR	;STICK THE COPY IN PLACE OF OLD PAGE.
	JRST VPAGRT	;LET GO OF THE COPY.

UNPUR2:	.USET USRI,[.RMEMT,,D]
	SETZ A,		;A -> 1ST WD OF NEXT PAGE TO HANDLE.
UNPUR3:	CAML A,D
	JRST NLTL4	;ALL PAGES HANDLED.
	PUSHJ P,UNPUR1	;UNPURIFY THIS PAGE IF NEC.
	 JFCL
	ADDI A,2000
	JRST UNPUR3	;GO ON TO CHECK NEXT PAGEOS 

;A HAS ADDR, UNPURIFY PAGE THAT ADDR LIES IN
;IF PAGE IS READ-ONLY OR SHARED, AND IS NOT ABSOLUTE.
;SKIP-RETURNS IF DID NOT UNPURIFY.
UNPUR1:	PUSH P,A
	LDB B,[121000,,A]	;GET PAGE NUM,
	SYSCLE CORTYP,[%CLIMM,,USRI ? B ? %CLOUT,,B ? %CLOUT,,A ? %CLOUT,,C ? %CLOUT,,C]
	POP P,A
	ANDI C,-1
	JUMPE C,POPJ1	;NO PAGE OR ABS PAGE, DO NOTHING.
	SOJG C,UNPUR0	;SHARED PAGE, UNPURIFY.
	JUMPG B,UNPUR0	;READ-ONLY, UNPURIFY.
	JRST POPJ1

APAT:	PUSHJ P,APATCK	;CHECK WHETHER CAN PATCH THIS JOB.
	CALL PATOPN	;SET PATCHL TO LOCATION PATCHED,,PATCH AREA.
	PUSHJ P,FETCH	;GET CONTENTS OF LOC OPEN
	 JRST NPERR
	PUSH P,D
	HRRZ D,PATCHL(U)	;GET LOCATION OF START OF PATCH
	PUSHJ P,NNL2
	MOVE D,(P)
	PUSHJ P,ENWPAT	;SET $Q AND PRINT.
	POP P,A
APAT5:	JSP B,GSEVLJ	;RETURN SYLL WHICH WILL RUB
	CTYPE "<	;OUT AS AN INSTRUCTION
	PUSHJ P,PIN
	MOVEI D,">	;BETWEEN ANGLE BRACKETS.
	JRST TOUT

NPERR:	SETZM PATCHL(U)	;SAY NO PATCH IN PROGRESS, AND CAUSE ERROR.
AEPAT:	CALL PATADJ	;ADJUST PATCH END ADDR ACCORDING TO ARG AND WHETHER LOC IS OPEN.
	PUSH P,B
	TLZN B,O.1ALT+O.2ALT	;[[ FOR $^] AND $$^] STORE THE INSN THE PATCH
	 JRST AEPAT1
	HLRZ A,PATCHL(U)	;WILL REPLACE,THEN LINEFEED.
	PUSHJ P,FETCH
	 JRST NXERR
	PUSHJ P,PDEP
AEPAT1:	HLRZ D,PATCHL(U)	;GET PLACE  PATCH WAS MADE FROM.
	MOVE B,(P)
	TLNE B,O.2ALT	;[ ;EXCEPT FOR $$^],
	 JRST AEPAT6
	PUSHJ P,AEPAT3	;PUT IN SOME JUMPA'S BACK TO THAT PLACE.
	PUSHJ P,AEPAT3
AEPAT6:	HLRZ D,PATCHL(U) ;GET PLACE PATCHED FROM, MINUS 1
	MOVEI D,-1(D)
	EXCH D,LLOC	;SET IT UP AS ".", SO CAN LINEFEED INTO PLACE PATCHED FROM.
	AOS D
	EXCH D,PATCHL(U)
	HRLI D,(JUMPA 3,) ;GET A JUMPA TO POINT TO THE PATCH, WITH AN AC FIELD
	POP P,B
	TLZE B,O.1ALT
	 HRLI D,(JUMPA 2,) ;SAYING HOW THE PATCH WAS ENDED, AS A SIGNAL TO AUPAT.
	TLZE B,O.2ALT
	 HRLI D,(JUMPA 4,) ;$$^] USES CODE 4 => UNPATCHING IS IMPOSSIBLE.
	PUSHJ P,PDEP
	HRRZ D,PATCHL(U)
;END A PATCH.  D HAS NEW VALUE FOR "PATCH".
PATCLS:	MOVE C,[SQUOZE 0,PATCH]
	MOVEM C,SYM
	PUSHJ P,DEFIN
	SETZM PATCHL(U)	;NO LONGER PATCHING.
	JRST NLTL2

PATADJ:	SKIPN PATCHL(U)
	 JRST NXERR	;ERROR IF NO PATCH STARTED.
	PUSHJ P,APATCK	;ERROR IF CAN'T WRITE THIS JOB.
	SKIPE ARG1+1	;IF HAVE ARG, PATCH ENDS WITH THE LOC. JUST CLOSED.
	 JRST CPOPJ
	MOVE D,LLOC
	SUBI D,1
	MOVE A,PLUNKF	;IF A LOC. HAD BEEN OPEN, PATCH ENDED BEFORE IT.
	TLNE A,FLRO	;IF NO LOC. HAD BEEN OPEN, PATCH ENDS WITH LOCATION ".".
	 HRRM D,LLOC	;LLOC POINTS AT LAST WORD OF PATCH.  "PATCH:" OR 1ST JUMPA
	RET		;GOES IN THE FOLLOWING WORD.

AUPAT:	PUSHJ P,APATCK	;ERROR IF CAN'T PATCH THIS JOB.
	TLNN F,FLRO	;^^
	 JRST NXERR
	MOVE A,LLOCO
	PUSHJ P,FETCH
	 JRST NXERR
	MOVE A,D
	TLC D,(JUMPA 2,)
	TLNN D,-1
	 JRST AUNPA1
	TLC D,(<JUMPA 2,>#<JUMPA 4,>)
	TLNN D,-1
	 ERSTRT [SIXBIT /CAN'T UNPATCH AFTER $$^]?/]
AUNPA2:	PUSHJ P,FETCH
	JRST NXERR
	PUSH P,[NLTL2]
	PUSH P,D
	JRST PDEPU

AUNPA1:	MOVEI W1,50.
AUNPA3:	PUSHJ P,FETCH
	JRST NXERR
	TLC D,(JUMPA 1,)
	TLNN D,-1
	SOJA A,AUNPA2
	SOJL W1,NXERR
	AOJA A,AUNPA3

;FIND WHERE THE PATCH AREA STARTS AND SET PATCHL(U) TO
 ;LOCATION PATCHED,,PATCH AREA
PATOPN:	MOVE D,[SQUOZE 0,PATCH]
	PUSHJ P,SEVLD
	 SKIPA D,[SQUOZE 0,PAT]
	  JRST PATOP1
	PUSHJ P,SEVLD
	 MOVEI D,50
PATOP1:	HRRZM D,PATCHL(U)	;LOOK UP PATCH, SET RH OF PATCHL(U).
	MOVE A,LLOC	;GET LOCATION OPEN NOW
	HRLM A,PATCHL(U)	;SAVE LOC. PATCHED FROM.
	RET

AEPAT3:	MOVEI D,1(D)
	HRLI D,(JUMPA 1,)
PDEP:	PUSH P,D
	SETZ B,		;NNL LOOKS AT B.
	PUSHJ P,NNL	;LINE FEED
	MOVE D,(P)
PDEPU:	PUSHJ P,ENWPAT
	HRRZ A,LLOC
	PUSHJ P,DEPRMV	;UPDATE UNDEF SYM REFS FOR LOCATION,
	REST D
	JRST DEP	;STORE IN IT.

;$$( - START A LITERAL.  USE THE $$( IN A WORD AS IF IT WERE A SYMBOL.
;DDT WILL PRINT OUT THE NAME OF A TAG THAT IDEFNTIFIES THE LITERAL.
;AS SOON AS IT CAN SAFELY DO SO, IT WILL OPEN THE PATCH AREA AND
;ALLOW YOU TO TYPE IN THE CONTENTS OF THE LITERAL.
N2ALPR:	CALL APATCK
	AOS A,LITCNT(U)
	CALL LITSYM	;GENSYM A NAME FOR THE CONSTANT.
	MOVSI C,SYLSYM
	SAVE D		;MAKE IT LOOK LIKE UNEVAL'D SYM TO PRINT IT.
	CALL GSPNT
	CTYPE ")
	REST A		;AND RETURN IT AS UNEVAL'D SYM IN PLACE OF THE $$(.
	MOVSI B,SYLSYM
	MOVEI D,"?
	MOVEM D,LIMBO	;MAKE SURE A "?" FOLLOWS IT SO IT WILL BE AN UNDEF SYM REF.
	SETOM UNRCHF
	RET

;COME HERE, WHEN THERE ARE PENDING LITERALS AND WE ARE NOT INSIDE
;A LITERAL OR A PATCH, TO START THE NEXT PENDING LITERAL.
LITFIN:	PUSHJ P,APATCK	;CHECK WHETHER CAN PATCH THIS JOB.
	CALL PATOPN	;FIND START OF PATCH AREA AND SET PATCHL TO .,,PATCH
	MOVSI D,1
	ADDB D,LITCNT(U)
	HLRZ A,D	;COMPUTE THE NAME WHICH WAS USED FOR THE NEXT PENDING LITERAL
	CALL LITSYM
	MOVEM D,SYM
	HRRZ D,PATCHL(U)
	CALL DEFIN	;DEFINE IT TO BE AT CURRENT START OF PATCH AREA.
	MOVEI W1,SYM
	CALL SPT	;TYPE THE SYMBOL AS THE NAME OF THE WORD NOW BEING OPENED.
	CTYPE "/
	HRRZ D,PATCHL(U)
	CALL PLOC	;SET POINT THERE,
	JRST NTAB2A	;OPEN THAT WORD, THE CONTENTS.

;GIVEN A NUMBER NNN IN A, RETURN THE SQUOZE FOR "$LTNNN" IN D.
LITSYM:	CALL SQZ3D
	ADD D,[SQUOZE 0,$LT]
	RET

;$$) - END A LITERAL DEFINITION.
N2ARPR:	CALL PATADJ	;SET LLOC TO . OR .-1 ACCORDING TO WHETHER HAD ARG, ETC.
	HRRZ D,LLOC
	HLRZ C,PATCHL(U)
	MOVEM C,LLOC	;(RESTORE . TO VALUE IT HAD WHEN THIS LITERAL WAS LITFIN'D).
	AOJA D,PATCLS	;THEN REDEFINE PAT TO THERE AND SAY NOT INSIDE A PATCH.

KVP:	SETOM XCRFSW	;:VP - SAY SHOULDN'T TYPE CRLF WHEN PROCEED.
	PUSH P,[PROCDT]	;GO PROCEED AFTER TURN ON TYPEOUT.
	CAIA
KVK:	PUSH P,[NLTL2]	;:VK - GO CRLF AND MAYBE * AFTER TURN ON.
	CAIA
KV:	PUSH P,[LCTGNR]	;:V
	SKIPE INPTR	;TYPED IN ON TTY, TURN ON TYPEOUT.
	 SOSGE TTYFLG	;ELSE JUST CANCEL 1 ^W
	SETZM TTYFLG
	POPJ P,

; :? -- LIST NAMES OF ALL :-COMMANDS, WITH SHORT DESCRIPTIONS.
QSN:	SYSCLO OPEN,[[2,,FDRC] ? ['DSK,,] ? ['DDT,,]
			[SIXBIT/:CMNDS/] ? ['.INFO.]]
	CALL FDRCO1	;INITIALIZE FDRC BUFFER FOR FDRCI
	JRST OPRINT	;TYPE OUT THE FILE.

KSLEEP:	CALL RONUM
	 JRST ALTDQX	;RETYPE ":SLEEP " IF RUB OUT OF RONUM.
	SKIPN B
	MOVEI A,15.
	CALL TYOFRC
	CALL HAKKAM	;PROCESS HAKKAH RQ'S, SAY TSINT CAN CALL HAKKAH.
	.SLEEP A,
	SETZM HAKOK	;TSINT CAN'T CALL HAKKAH ANYMORE.
	JRST NLTL4

KGAG:	PUSHJ P,RONUM
	 JRST ALTDQX	;IF RUB BACK OUT OF RONUM, TYPE ":GAG "
	JUMPE B,NXERR
	MOVEM A,GAGF
KGAG1:	MOVE A,GAGF	;PREVENT :SENDS IFF GAGGED OR NOMSG'D.
	IMUL A,NOMSGF	;THAT IS, EITHER GAGF OR NOMSGF IS 0.
	SKIPE A
	.SUSET [.SIMASK,,[%PICLI]]
	SKIPN A
	.SUSET [.SAMASK,,[%PICLI]]
	JRST NLTL4

KNOMSG:	CALL RONUM	;TURN OFF UNSOLICITED TYPEOUTS SUCH AS
	 JRST ALTDQX	;:SENDS, ALARM, SYS GOING DOWN
	MOVEM A,NOMSGF
	SKIPN NOMSGF	;IF THE ARG IS ZERO.
	 JRST KGAG1
	SETOM HAKTYP	;WHEN THEY'RE TURNED BACK ON,
	SETOM HAKRQ	;PRINT ANY PENDING MESSAGES.
	JRST KGAG1

;; :MAILNT 0 turns off mail notification, :MAILNT 1 turns it on with first-line
;; printing, and -1 without first-line printing
kmailnt:
	call ronum	;read a number
	  jrst altdqx	;  rubbed out!
	movem a,mailnt	;note if we want to know when we get mail, or not
	skipn mailnt	;if the arg is zero.
	 jrst hakml1	;  turn off the feature
	syscle OPEN,[ %climm,,dirhc ? [sixbit /DIRHNG/] ? %climm,,0 ? %climm,,0
		      hsname]  ; get an interrupt on writing on our HSNAME dir
	.suset [.simsk2,,[1_dirhc]]  ;enable these interrupts
	syscal rqdate,[ %clout,,mailtm]	 ;note time of last mail
	  setom mailtm
	call malckq	;check for mail now
	.close fdrc,	;no need for the file
	jrst nltl4	;all done, prompt

hakml1:	.suset [.samsk2,,[1_dirhc]]  ;disable interrupts
	.close dirhc,	;close the channel
	jrst nltl4	;that's it, return and prompt


;OP TYPES (IN RH(W1)):  MSG = 1	SEND = 0
;MAIL, BUG, MAILA, BUGA,   4.9 SET, AND -1 IN RH.
;BIT 3.1 ON => MAIL OR BUG, OFF => MAILA OR BUGA.
;BIT 3.2 ON => MAIL OR MAILA, OFF => BUG OR BUGA.
;IF BIT 3.2 OFF, BIT 3.3 OFF => DON'T MAIL TO SYS.
;IF OP=0 (SEND), BIT 3.4 ON => SHOUT, OFF => SEND.
;(NOTE THAT BUG AND BUGA NO LONGER EXIST, AND MAIL AND MAILA ARE
; NOW REALLY CALLED OMAIL AND OMAILA. :MAIL NOW RUNS A PROGRAM.
; :MAILA DOES NOT EXIST).

mail:	hrloi w1,400003	;op. type is MAIL
	jrst mail1

kshout:	movsi w1,10	;op type is SHOUT
	call sndset	;Set up the buffer, complete with "Message From"
	move a,[440700,,[asciz /Everybody:  /]]
	call bugcop	;put "Everybody:" and a terpri into the buffer
	movem c,bufbeg	;remember this as the begining of the buffer
	jrst bgred0	;gobble the rest of the message

send:	skipn sndflg	;do we use QSEND instead of send?
	  jrst osend	;  no, do our own variety
	move b,[sixbit /SEND/]
	movem b,sysn2	;fake a :SEND not a DDT command
	setom xcrfsw	;an extra crlf would look bad after :SEND FOO<cr>
	jrst actrlk

sndhlx:	call sndhl1	;give him help
	ret

osend:	setz w1,	;op. type is send.
send0:	call buglog	;maybe say (LOGIN?)
	movei a,sndhl1	;routine to call to provide help
	movem a,hlprtn
send01:	call rmtoke	;read user @ machine.
	camn b,[sixbit /?/]  ;is he wanting help?
	  jrst [ call sndhl1  ;give him help
		 7type [asciz /A:SEND /]
		 call tyofrc  ;be sure he sees the output
		 jrst send01]
	setz c,
	came a,itsnam	;If same machine,
	  skipn a	; or if no @ machine
	    movsi c,'CLI  ;  use CLI device
	jumpn c,sendx	;otherwise
	  move c,[sixbit /  CLI /]
	  add c,a
sendx:	movem c,clidev  ;use MLCLI device
	movem b,clufn1	;remember who we're sending to.
	movem a,malits	;Remember if any machine specified
	call bugsnd	;detect attempt to send to user who can't receive
	  jrst sendm	;and change to mail instead using qmail.
	call sndset	;set up the buffer for a send
	movem c,bufbeg	;remember this as the start of the buffer
	jrst bgred0	;gobble down a message

;;; create and set up the buffer with the "Message from" line

sndset:	call vpaget	;get the buffer page to hack
	move a,[[asciz /ÛMessage from /],,vpagad]
	blt a,vpagad+2	;Set up the message beginning in the buffer
	move c,[010700,,vpagad+2]  ;Start pointing from there
	call msgnam	;put this user's UNAME in the buffer
	call bugspc	;space over one
	call sndtim	;put the time in the buffer
	move a,[440700,,[asciz /]
/]]
	call bugcop
	setom tyisnd	;tell TYI and friends to let ^V and ^W through
	ret

;; copy from pointer to asciz string in A down ptr in C.  Clobbers B

bugcop:	ildb b,a	;grab a char
	jumpe b,cpopj	;end of the string?
	idpb b,c	;nope, send it along
	jrst bugcop

maila:	hrloi w1,400002	;op. type is MAILA
mail1:	call buglog	;Maybe say (LOGIN?)
	call rmtoke	;read <user>@<machine>
	movem b,clufn1	;remember who we're sending to.
	movem a,malits	;Remember if any machine specified
	setom unrchf	;put char terminating user name in mail.
	call vpaget	;get a fresh page to buffer the message.
	move c,[010700,,vpagad-1]

mail2:	movem c,bufbeg	;Remember this
	call msgnam	;put this user's UNAME in buffer.
	call bugdat
	movei a,40	;separate the frobs by a space
	idpb a,c
	call bugtim
	movei a,^M	;terpri now
	idpb a,c
	movei a,^J
	idpb a,c
bgred0:	setom buggsc	;note we don't want the :SEND FOO printed
	call bgread
	  jrst [call vpagrt ? jrst nltl4]  ;flush buffer and re-prompt
	jrst bugdon	;Send the message!

;;; BGREAD is the multiple-line edited reading routine
bgread:	setom tyisnd	;tell TYI that we want ^V and ^W to come through
	setzm bughed	;we haven't seen a header yet...
	setom tthelp	;let [HELP] through

	call rin	;get a character
	  jrst rubfls	;  rubout!  Abort back to last fail point

	cain d,^Q	;Quote?
	  jrst bgquot

	cain d,"?	;does he want help?
	  skipn morwarn	;  If he's a winner, he probably was just typing ?
	    caia	;    no help
	      jrst sndhlp  ;   yes, give him help

	skipn toktrm	;ended in space, and
	  caie d,^M	;  now we get a [RETURN] ?
	    jrst bugrd2	;    no, just use the character as is, else get new one

bugrd:	call rin	;now read in the message.
	 jrst bugrub	;rin doesn't skip iff rubout.
bugrd2:	cain d,^Q	;Quote?
	  jrst bgquot
	caie d,^_
	  cain d,^C
	    jrst bugxt2	;^_ or ^C => end of message.
	cain d,^Z
	  jrst bugxit	;save the text!
	cain d,^L
	  jrst bugff	;^L => retype buffer's contents.
	cain d,^W
	  jrst hakwrd	;^W => Kill word
	cain d,^U
	  jrst killin	;^U => Kill line
	cain d,^R
	  jrst bugprl	;^R => Reprint line
	cain d,^K
	  jrst bugvt	;^K => Reprint buffer without clear-screen
	cain d,^T
	  jrst bugtog	;^T => Switch last two characters
	cain d,%txtop+"H	   ;[HELP] ?
	  jrst sndhlp		   ;  yes, give help
	skipe a,rubsav  ;is there stuff to save?
	  call kilcpy	;  Yes, copy it to the kill buffer
	setzm rubsav	;ordinary char, flush any saved rubout position
	cain d,^Y
	  jrst rbundo	;^Y => Undo last deletions

bugrd1: call bugrdx	;normally, characters just go into the buffer
	jrst bugrd

bugrdx:	movei b,(c)
	cain b,vpagad+1777
	 jrst [	7type bufful
		jrst bugrd]
	IDPB D,C	;OTHER CHARS GO INTO BUFFER.
	CAIE D,^I
	 CAIN D,^J	;SYSTEM DOESN'T ECHO ^I, ^J
	  PUSHJ P,TOUT	;SO ECHO THEM NOW.
	CAIE D,^M
	 ret
	MOVEI D,^J	;AFTER ^M, PUT IN A ^J.
	IDPB D,C
	ret

bgquot:	ctype ":	;Prompt for a character
	call rin	;read in a character
	  movei d,177	;  Rubout is a rubout!
	cain d,%txtop+"H  ;Help?
	  jrst sndhlp	;  Yes, can't insert non-ascii into the buffer!
	caie d,^L	;Unless it's a ^L, 
	  jrst bugrd1	;  just insert the character
	call bugrdx	;^L's get inserted, but since they also cleared the
	jrst bugff	;screen, we must retype as well

bufful:	asciz / (BUFFER FULL) /

bugtog:	camn c,bufbeg		   ;if it's at the beginning of the buffer
	  jrst bugrd		   ;  do nothing
	ldb d,c
	move a,c		   ;copy our Byte Pointer
	call bugbka		   ;previous char
	ldb b,a			   ;now we have the characters involved
	dpb b,c			   ;first in second spot
	dpb d,a			   ;second in first spot
	skipe erase		   ;if we can erase the ^T and old chars
	  7type [ asciz /XXXX/]  ;do so
	push p,b		   ;remember the second character
	call tout		   ;type the characters
	pop p,d			   ;in their new order
	call tout
	jrst bugrd		   ;and on with the shew!

sndhlp:	call sndhl1		   ;give the help
	setom bughed		   ;pretend we saw the header
	jrst bgprl0		   ;retype the line and gobble more characters

sndhl1:	call terpri
	syscal open,[ %clbit,,.bai ? %climm,,fdrc ? [sixbit /DSK/]
		      [sixbit /DDT/] ? [sixbit /:SEND/] ? [sixbit /.INFO./]]
	  jrst [ 7type [asciz /Help file missing, sorry./]
		 jrst bgprl0]	   ;  Retype the line and continue
	call fdrco1		   ;initialize buffering
	call ctlf1		   ;print the file
	call tyofrc		   ;be sure he sees the output!
	ret

bugxit:	move a,bufbeg		   ;start of buffer
	camn a,c		   ;are we at the start of the buffer?
	  jrst nltl2		   ;  yes, nothing to save!
	call kilcop		   ;copy the buffer into the kill buffer
	setzm rubsav
	7type [asciz /A(Message copied into kill buffer)
/]

	movei d,^Z		   ;note we exited with a ^Z
	caia
bugxt2:	  aos (p)	;  skip return for successful BUGREAD
	setzm rubsav	;No more saved rubout position
	setzm tyisnd	;^V and ^W go back to normal now
	setzm tthelp	;[HELP] gets turned into a ? again
	setzm buggsc	;next time we won't ignore GSOC buffer unless set again
	setzm hlprtn	;SEND helper no longer useful
	popj p,


;; KILCOP copies into the kill buffer
;; it takes the Byte pointer to copy from in A, the end Byte pointer in C,
;; and clobbers A and B.
;; KILCPY copies between the Byte pointer in C and the Byte Pointer in RUBSAV
;; into the kill buffer.

kilbln==10	        ;block size of kill buffer

kilcpy:	move a,c	;
	save c		;we'll use the saved end as our C
	save d
	move c,rubsav
	call kilcop     ;save it away
	rest d
	rest c
	ret

kilcop:	move b,klbbeg	;find the start of the kill buffer
kilcp1:	camn a,c		   ;unless we're at the end
	  ret
	camn b,klbend		   ;is it the end of the buffer?
	  call kilhol		   ;  yes, get more space
	ildb d,a		   ;move the character
	idpb d,b		   ;into the kill-buffer
	movem b,klbipt		   ;remember how far we've gotten!
	jrst kilcp1

kilhol: save a
	save c		   ;HOLE0 would clobber C
	save w1
	save klbbeg	   ;these 3 don't move
	save klbipt
	movsi a,-kilbln   ;allocate kilbln more words
	movei w1,kilbpt
	call hole0	   ;make more room
	rest klbipt
	rest klbbeg
	rest w1
	rest c
	rest a
	ret

bugrub:	camn c,bufbeg	;If we try to rub out past the beginning
	  jrst rubfls	;  handle that by aborting back to last GSOA point
	ldb d,c		;get the char
	call bugrb1	;rub out a character
	jrst bugrd	;and on with the show!

;;bugrb1 handles doing the rubout of any character
bugrb1:	call bugbak	;back up the pointer
	cain d,^J	;LF ?
	  jrst brublf	;  Check it for stray, then hack EOL
	skipn erase	;Erasable?
	  jrst toutec	;  on others, must just echo the rubbed character.

	cain d,^I	;Tab?
	  jrst hakln1	;  Tab's we gotta re-type the line
	cain d,33	;altmode?
	  jrst ntsail	;  Not sail, so just ^PX
	cail d,40	;Control?
	  cain d,177	;  rubout
	    jrst mbsail	;    Might be sail, check it out

ntsail:	7type [asciz /X/]  ;flush it from the screen
	ret		;and that's that

bugbak:	add c,[70000,,]	;back up the buffer pointer.
	jumpge c,cpopj
	sub c,[430000,,1]
	ret

bugbka:	add a,[70000,,]	;back up the buffer pointer.
	jumpge a,cpopj
	sub a,[430000,,1]
	ret

mbsail:	syscal ttyget,[%climm,,tyoc ? %clout,,b ? %clout,,b ? %clout,,ttysts]
	  erloss	;Gotta find out the CURRENT state of sailification
	move b,ttysts
	tlne b,%tssai	;Do sail chars exist?
	  jrst hakln1	;  Yes, retype line to be sure to get it right
	7type [asciz /XX/]  ;No, just rubout two char positions
	ret		;and it's gone!

hakln1:	skipe erase
	  7type [asciz /HL/]  ;yes, start on this
	skipn erase	;line, otherwise
	  call crf	;  terpri
hakln0:	call fndlin	;find beginning of this line
	call bugff1	;and redisplay this line
	ret		;and that's it!

hakwrd:	skipn rubsav	;unless there's already a saved position
	  movem c,rubsav  ;restore this one
	skipe erase	;if it's erasable
	  7type [asciz /XX/]  ;rubout out the ^W
	caia		;and enter the loop in the middle!
hakwd1:	call bugrb1	;rub it out
	camn c,bufbeg	;if we're at the beginning
	  jrst bugrd	;  that's it, just read!
	ldb d,c		;check the previous char
	call alphap	;is it alphabetic?
	  jrst hakwd1	;  no, keep hacking

hakwd2:	call bugbak	;back up the pointer
	skipe erase	;if it's erasable
	  7type [asciz /B/]  ;alphapbetic, back over it
	camn c,bufbeg	;if we're at the beginning
	  jrst hakwd9	;  that's it, just read!
	ldb d,c		;is this alphabetic?
	call alphap
	  caia		;  Not alphabetic...
	jrst hakwd2	;keep looking for one that's not

hakwd9:	skipe erase	;if it's erasable
	  7type [asciz /L/]  ;flush the whole word at once!
	skipn erase	;otherwise
	  jrst bgprl0	;  print the rest of this line
	jrst bugrd	;and return to reading!

alphap:	caie d,"'	;' is part of words too
	  cain d,"|	;  a funny "alphabetic", nice for typeing LISP atoms
	    jrst popj1
	caig d,"z	;if it's > "z, it can't be
	  caige d,"0	;  similarly it can't be less than a digit
	    ret
	caige d,"a	;If it's > "a, it must be OK
	  caig d,"9	;  similarly, if it's a digit
	    jrst popj1
	cail d,"A	;If i'ts less than a letter
	  caile d,"Z	;  or greater
	    ret		;    it isn't alphabetic
	jrst popj1	;otherwise, it is.

killin:	skipn rubsav	;unless there's already a saved position
	  movem c,rubsav  ;  remember this one
	camn c,bufbeg	;if we're already at the beginning
	  jrst kiln9	;  then just flush the character (if possible)
	ldb d,c		;check the preceeding character
	call bugbak	;and back over it
	cain d,^J	;LF ?
	  call brublf	;  yes, make it go away
	call fndlin	;find the beginning of this line
	move c,a	;and make that our real position
	skipe erase	;If it's erasable
	  7type [asciz /HL/]  ;clear the line
	skipn erase	;otherwise
	  call crf	;can't clear, pretend by going to a fresh line
	jrst bugrd	;and continue reading

kiln9:	skipe erase	;if it's erasible
	  7type [asciz /XX/]  ;just wipe out the chars
	skipn erase	;otherwise
	  call terpri	;  just get a fresh line
	jrst bugrd	;and continue reading

;; hack a LF.  Check to see if the preceeding char is a CR, if so, flush it
;; too. 

brublf:	skipe erase	;if it's erasable
	  7type [asciz /SHLR/]  ;Kill any cruft on this line
	skipn erase	;too.  This can happen if the cursor isn't where you
	  call terpri	;expect, or after typing a ^U that is echoed at the
			;beginning of the line.
	ldb d,c		;get preceeding character
	cain d,^M	;Is it a legitimate TERPRI?
	  jrst brubcr	;  yes, hack that
	7type [asciz /UL/]  ;No, just move back up, if possible
	ret		;and that's it

brubcr:	call bugbak	;back up over the CR as well
	move b,ttyopt	;can this move up?
	tlne b,%tomvu	;if so,
	  7type [asciz /UHL/]  ;move up to beginning of previous line
	tlnn b,%tomvu	;otherwise
	  7type [asciz /A/]  ;just be sure to start on a fresh line
	jrst hakln0	;and retype the line


;; FNDLIN returns in A a Byte Pointer to the beginning of this line
fndlin: move a,c	;copy the Byte pointer
fndln0:	ldb d,a		;check a char
	call bugbka	;back up A
	cain a,bufbeg	;Is it to the beginning of the buffer?
	  ret		;  yes, that's the beginning of this line
	caie d,^J	;is it a LF?
	  jrst fndln0	;  no, try the next one
	ldb d,a		;yes, check for a CR
	caie d,^M	;is it a real live terpri?
	  jrst fndln0	;  no, keep hunting
	ibp a		;yes, point after the LF
	ret		;and that's it!

;;; Reprint the current line on a ^R
bugprl:	skipe erase	;if erasible
	  7type [asciz /HL/]
	skipn erase	;otherwise terpri
bgprl0:	  call terpri	;Can't get away with it, just terpri instead
	call fndlin	;find the beginning of the line
	call bugff1	;and type out from there
	jrst bugrd

rbundo: skipe erase	;can this TTY be erased?
	  jrst [ 7type [asciz /XX/]  ;it's ^PX'able
		 jrst rbund1]  ;so we take the easier way out
	call fndlin	;otherwise we retype the line
	call terpri	;on a fresh one
	call bugff1	;so we avoid the echoed ^Y

rbund1:	skipe rubsav	;if there is a saved position
	  jrst [ move a,c	; remember where we started from
	         move c,rubsav	; simply unsave it	
		 setzm rubsav	; clear it out
		 call bugff1	; display between here and there
		 jrst bugrd]	; and continue reading
	move a,klbbeg	;start at the beginning of the kill buffer
	camn a,klbipt	;is there no kill data?
	  jrst [ ctype 7	   ;  nope, beep at him!
		 jrst bugrd]	   ;  and on with the show.
rbund5:	camn a,klbipt	;are we at the end?
	  jrst bugrd	;yes, back to reading
	ildb d,a	;get it
	call tout	;type it
	movei b,(c)	;check our output pointer
	cain b,vpagad+1777	   ;are we at the end?
	  jrst [ 7type bufful	   ;  yes, complain
		 jrst bugrd]	   ;  and back to reading
	idpb d,c	;put the character in the buffer
	jrst rbund5	;and hack the next character.

bugvt:	7type [asciz /XXA/]  ;flush ^K, so we mightn't need new line
			;^L clears the screen, so ^K must add a TERPRI
bugff:	setom bughed	;Note that we've printed the header
	skipn buggsc	;do we have stuff from before this processing that
	  call gsocff	;  wants to be displayed?
	move a,[010700,,vpagad-1]  ;Start at the beginning of the buffer
	skipn getty	;and terpri first if this is is a paper TTY
	  call terpri
	call bugff1	;redisplay it up to the end
	jrst bugrd	;and read some more

bugff1:	skipn bughed	;have we never seen the header?
	  came a,bufbeg	;  and is it the first line?
	    caia	;    one of them not true
	      jrst [ skipn erase  ;Is this a display?
		       jrst .+1	 ;   No, so assume it's still visible.
		     move a,ttyopt  ;Both true
		     tlne a,%tomvu  ;if the terminal can move up
		       skipn toktrm  ;  And the :SEND was terminated with CR
		         caia
			   7type [asciz /UL/]  ;  Then move up to that line
		     move a,[010700,,vpagad-1]
		     setom bughed  ;	       had to have seen it now
		     jrst .+1]
	camn a,c	;If this is at the beginning don't do a thing
	  ret
	ildb d,a	;check out the first character
	camn a,[350700,,vpagad]	 ;If this is the first char of the buffer
	  caie d,177	;  and if it's not a rubout
	    call tout	;    type it
bugff2:	camn a,c	;When we get to the real input pointer
	  ret		;  we're all done
	ildb d,a
	call tout	;else retype the next.
	jrst bugff2

BUGDON:	PUSH P,[NLTL2]	;WHEN FINISHED, TYPE STAR
	PUSH P,[VPAGRT]	;AFTER FREEING BUFFER PAGE.
	TLNE W1,10
	 JRST KSHOU1	;SHOUT IS SPECIAL.
;KSHOUT CALLS BACK HERE. THIS ROUTINE MAY SKIP IFF W1 INDICATES OPERATION IS "SHOUT".
BUGDO2:	CAMN C,[010700,,VPAGAD-1]
	 JUMPLE W1,BUGCLS	;(NULL SENDS WOULD HANG TARGET DDT)
BUGDO3:	MOVE B,[1,,UTOC]
	SETZM FDRCIP
	JUMPL W1,BUGDM	;FOR MAIL, MUST FIGURE OUT WHICH DEVICE TO WRITE ON.
	.CALL BUGOPO	;OPEN OUTPUT FILE.
	 JRST BUGDO4	;DECODE FAILURE REASON, MAYBE TRY AGAIN.
BUGDO1:	MOVE A,[010700,,VPAGAD-1]
bugout:	save a			   ;remember the starting address
	call charad		   ;Get character address
	move d,b		   ;remember this
	move a,c		   ;calculate the final address
	call charad
	sub b,d			   ;and get final count
	rest a			   ;B has count, A has Byte Pointer to start
	syscle SIOT,[%climm,,utoc ? a ? b]  ;so send out the characters!

BUGCLS:	JUMPGE W1,BUGCL1	;FOR MAIL, MAILA, BUG, BUGA,
	.IOT UTOC,[^_]	;FOLLOW THE MSG BY A ^_ AND A CRLF.
	TLNE W1,1	;FOR MAIL AND BUG (NOT MAILA), PUT CRLF AFTER THE ^_
	 CALL BUGA3	;(FOR MAILA, ASSUME THERE ALREADY IS ONE).
	PUSHJ P,BUGCPY	;COPY OVER REST OF MAIL.
	SYSCAL RENMWO,[%CLIMM,,UTOC ? CLUFN1 ? ['MAIL_14]]
	 JFCL
BUGCL1:	.CLOSE UTOC,
	.CLOSE FDRC,
	popj p,




BUGDO4:	.STATUS UTOC,D	;COME HERE ON FAILURE OPENING CLI:
	LDB D,[OPNLBP,,D]
	CAIE D,%EFLDR	;IF THIS FAILURE IS ONE OF THOSE LIKELY TO BE TEMPORARY,
	 CAIN D,%ENAFL
	  CAIA		;WAIT A WHILE AND TRY AGAIN.
	   JRST [	;IF IT IS PROBABLY PERMANENT,
		CAME W1,[10,,]	;IF NOT SHOUTING, TURN INTO :MAIL.
		 JRST SNDMAL
		JRST POPJ1]	;IF SHOUTING, GIVE UP ON THIS GUY.  SKIP-RET FROM BUGDO2.
	MOVEI D,60.
	.SLEEP D,
	JRST BUGDO3

;HANDLE CASE THAT USER LOGS OUT OR GAGS WHILE A :SEND TO HIM IS BEING TYPED IN.
SNDMAL:	HLRE D,CLUFN1
	AOSN D
	 ERSTRT [SIXBIT/TARGET VANISHED?/]
	7TYPE [ASCIZ/ (Mail)/]
	SYSCLO OPEN,[[.UAO,,UTOC] ? ['DSK,,] ? [SIXBIT/MAIL/] ? [SIXBIT/>/] ? ['.MAIL.]]
	SAVE C
	SAVE TOUTXQ		;WRITE A FILE .MAIL.;MAIL > THAT LOOKS LIKE
	MOVE D,[.IOT UTOC,D]	;FROM:R"<SENDER>
	MOVEM D,TOUTXQ		;CLAIMED-FROM:<XUNAME>
	7TYPE [ASCIZ/FROM:Q"/]	;FROM-JOB:HACTRN   (OR WHATEVER).
	MOVE D,RUNAME		;TO:"<TARGET>
	CALL SIXTYP		;TEXT;-1
	MOVE D,XUNAME		;<TEXT OF MESSAGE>
	CAMN D,RUNAME
	 JRST SNDMA1
	7TYPE [ASCIZ /
CLAIMED-FROM:/]
	CALL SIXTYP
SNDMA1:	7TYPE [ASCIZ /
FROM-JOB:/]
	.SUSET [.RJNAME,,D]
	CALL SIXTYP
	7TYPE [ASCIZ/
TO:"/]
	SKIPN D,CLUXUN
	 MOVE D,CLUFN1
	CALL SIXTYP
	7TYPE [ASCIZ/
TEXT;-1
/]
	REST TOUTXQ
	REST C
	move a,bufbeg		   ;start at the beginning of user text
	jrst bugout		   ;and output the buffer

;HANDLE A :SEND TO SOMEONE WHO IS NOT INITIALLY PRESENT ON-LINE.
SENDM:	HLRE D,CLUFN1	;DON'T CHANGE TO :MAIL IF TARGET NAME
	AOSN D		;STARTS WITH "___".
	 ERSTRT [SIXBIT/NOT ON-LINE?/]
	7TYPE [ASCIZ/(Mail) /]
	CALL GSOD	;RE-PROCESS THE STRING "SEND FOO ", AS IF AFTER A RUBOUT,
	HRRZ A,GSCHRA	;EXCEPT REPLACE "SEND" BY "MAIL", SO TS MAIL WILL RUN.
	MOVE B,[ASCII/MAIL /]
	MOVEM B,1(A)	;ALSO DEPOSIT IN THE USER'S XUNAME, IF KNOWN, IN PLACE OF THE UNAME
	HRLI A,010700	;SINCE WHILE YOU MIGHT SEND TO THE UNAME YOU WANT TO MAIL TO XUNAME.
	aos a
	MOVEM A,GSCHRP
	SAVE TOUTXQ	;SET UP TOUTXQ TO MAKE TYPEOUT DEPOSIT IN THE COMMAND STRING BUFFER.
	MOVE A,[IDPB D,GSCHRP]
	MOVEM A,TOUTXQ
	SKIPN D,CLUXUN
	 MOVE D,CLUFN1
	CALL SIXTYP	;TYPE THE XUNAME AND A SPACE INTO THE BUFFER.
	CALL TSPC
	REST TOUTXQ
	MOVE A,GSCHRP	;NOW GO REPROCESS THAT COMMAND.
	JRST SLRPD4

BUGCPY:	SKIPN FDRCIP	;COPY OLD FILE IF IT'S OPEN.
	 POPJ P,
BUGCP1:	CALL FDRCI	;READ 1 CHAR FROM BUFFERED FDRC.
	 RET		;EOF MEANS ENTIRE INPUT FILE HAS BEEN COPIED.
	CAIN D,^L	;IGNORE ^L'S IN OLD FILE.
	 JRST BUGCP1
	.IOT UTOC,D
	JRST BUGCP1

;OPEN THE DESIRED FILE FOR COMMAND TYPE IN W1,
;THE NAMES ARE CORRECT FOR THE OUTPUT OPEN AT BUGDO3.
;B SHOULD HAVE <MODE>,,<CHANNEL>.
BUGOPO:	SETZ ? SIXBIT/OPEN/
	B ? bugdev+1(W1)
	CLUFN1 ? ['_MAIL'_ ? 'HACTRN ? '>_36]+1(W1)
	SETZ ['.MSGS.]	;(SNAME USED ONLY IF DEV IS DSK)

;COME HERE FROM BUGDON, FOR MAIL.
bugdm:	move b,clufn1	;for this user
	push p,c	;C has final pointer, can't clobber it
	move c,malits	;on the ITS specified, if any....
	call opmail	;find out where his mail lives.
	sysclo open,[[.uao,,utoc] ? c ? [sixbit/_MAIL_/] ? [sixbit /OUTPUT/]
				  a]
bugopn:	syscal open,[ %clbit,,.bai ? %climm,,fdrc ? c ? b ? [sixbit /MAIL/] ? a
		      %clerr,,d]
	  jrst [ caie d,%ensfl	   ;  No such file?
		   opner @bugopn   ;    No, it's something worse, might lose
				   ;    data if we proceed
		 pop p,c	   ;  Reccover our final pointer
		 jrst bugdo1]	   ;  No such file is OK.
	pop p,c		;recover our final pointer
	call fdrco1	;initialize the input buffer
	tlnn w1,1	;and it's MAILA, read and copy part of the old file.
	 call buga0
	jrst bugdo1

;COME HERE FOR :SHOUT, AFTER READING IN THE MESSAGE.
;SCAN THROUGH THE TTY FILE DIRECTORY FINDING ALL THE USERS,
;AND SEND TO EACH ONE.
KSHOU1:	.OPEN FDRC,['TTY ? '.FILE. ? '(DIR')_6]
	 JRST KSHOU1		;FAILS => MUST BE DO DIR. CHANNELS AVAIL.
	MOVE I1,[10,,'USR]	;SET UP TO DO .OPEN I1 LATER.
	MOVE I3,['HACTRN]	;UNAMES WILL BE CONSTRUCTED IN I2.
	.IOT FDRC,D
	CAIE D,"T		;FIND THE "TTY USER   JOB ..." LINE.
	 JRST .-2
;HERE TO PROCESS NEXT LINE OF DIRECTORY. NOTE THIS SKIPS THE FIRST, IRRELEVANT LINE.
KSHOU2:	.IOT FDRC,D		;FIND START OF NEXT LINE.
	CAIN D,^L
	 RET
	CAIE D,^J
	 JRST KSHOU2
	.IOT FDRC,D
	CAIN D,^L
	 RET			;LINE FOLLOWED BY FF => WHOLE DIR HAS BEEN HANDLED.
	CAIE D,"T		;LINE DOESN'T START WITH "T" => EITHER IT IS
	 JRST KSHOU2		;A DEVICE, NOT A CONSOLE, OR IT IS ONE OF THE TWO
				;UNINTERESTING LINES AT THE BOTTOM.
	.IOT FDRC,D		;IT'S AN INTERESTING LINE, SO SKIP
	.IOT FDRC,D		;THE REST OF THE TTY NUMBER.
	.IOT FDRC,D
	MOVE A,[440600,,I2]
KSHOU3:	.IOT FDRC,D		;BUILD THE UNAME AS SIXBIT IN I2.
	IDPB D,A
	TLNE A,770000		;READ EXACTLY 6 CHARS.
	 JRST KSHOU3
	XOR I2,[404040,,404040]	;FINISH CONVERTING ASCII TO 6BIT.
	CAMN I2,RUNAME		;DON'T SEND TO SELF - THAT'S DANGEROUS.
	 JRST KSHOU2
	.IOPUS FDRC,
	.OPEN FDRC,I1
	 JRST KSHOU4		;USER HAS NO HACTRN => GIVE UP ON HIM.
	.USET FDRC,[.RMASK,,A]
	TRNN A,%PICLI
	 JRST KSHOU4		;USER IS GAGGED => GIVE UP ON HIM.
	MOVEM I2,CLUFN1
	CALL BUGDO2		;OTHERWISE, SEND IT TO HIM.
	 CAIA			;SUCEEDED.
	  JRST KSHOU5		;FAILED TO OPEN CLI:
	CALL KSHOU6		;TYPE HIS NAME SO USER CAN FOLLOW PROGRESS.
KSHOU4:	CALL TYOFRC
	.IOPOP FDRC,		;LOOK FOR NEXT GUY TO SEND IT TO.
	JRST KSHOU2

KSHOU5:	CTYPE "(
	CALL KSHOU6
	7TYPE [ASCIZ/failed) /]
	JRST KSHOU4

;PRINT 6BIT WORD IN CLUFN1 AND SPACE, AND FORCE OUT. CLOBBERS D.
KSHOU6:	SAVE C
	MOVE D,CLUFN1
	CALL SIXTYP
	CALL TSPC
	JRST POPCJ

;FOR BUGA, MAILA, READ THRU OLD FILE TILL END OF PREVIOUS NOTE,
;COPYING INTO NEW FILE. DON'T COPY THE ^_ AFTER THE NOTE.
BUGA1:	CAIN B,40	;WAS THIS ENTRY THE RIGHT ONE?
	 JRST BUGA3	;YES, RETURN, PUTTING IN A CRLF (BETWEEN NEW MSG AND OLD).
	.IOT UTOC,[^_]	;NO, COPY THE ^_
BUGA0:	MOVE A,[010700,,VPAGAD-1]	;THE ACTUAL ENTRY POINT.
	SETO B,		;DON'T KNOW WHETHER NEXT NOTE'S THE ONE.
BUGA2:	CALL FDRCI
	 JRST [	SETZM FDRCIP	;EOF MEANS DON'T TRY, LATER, TO COPY THE REST.
		RET]
	CAIN D,^_	;NOTE ENDS BEFORE SENDER'S NAME =>
	 JRST BUGA1	 ;PASS IT BY.
	CAIN D,^L
	 JRST BUGA2	;IGNORE ^L IN MAIL FILES.
	.IOT UTOC,D	;ELSE COPY THE CHAR INTO OUTPUT FILE,
	JUMPE B,BUGA2	;THIS NOT THE ONE => JUST COPY IT.
	CAIE D,^M
	 CAIN D,^J	;JUST COPY CR AND LF - THEY DON'T AFFECT THE DECISION.
	  JRST BUGA2
	CAIN B,40
	 JRST BUGA2	;THIS CERTAINLY THE NOTE => COPY IT.
	CAMN A,C	;OUR UNAME SHORTER THAN THEIRS => NOT THE ONE.
	 JRST BUGA2
	ILDB B,A	;ELSE COMPARE THE NEXT CHARS OF EACH.
	CAIE B,(D)
	 SETZ B,	;MISMATCH => THIS ISN'T THE NOTE.
	JRST BUGA2

BUGA3:	.IOT UTOC,[^M]	;PUT A CRLF INTO THE OUTPUT MAIL FILE
	.IOT UTOC,[^J]
	RET


;:MSG <TOPIC> <MESSAGE> ^C.
KOMSG:	.RDATE D,
	AOJE D,NDATER	;MSGS FILE MUST HAVE A DATE.
	MOVEI W1,1	;OP. TYPE IS 1 FOR MSG.
	JRST MAIL1

;skip unless this is a :SEND to a user who is gagged or not logged in.

bugsnd:	jumpn w1,popj1	;do nothing if not send.
	skipn a
	  move a,ITSNAM
	call mchokp
	  jfcl
	setzm cluxun	;xuname corresponding to the uname is not known.
	move d,a
	add d,[sixbit /  USR /]
	camn a,itsnam	 ;if this is the same ITS
	  movsi d,(sixbit /USR/)  ;just use USR instead
	syscal OPEN,[ %clbit,,.uii\40  ;open as foreign only
		      %climm,,fdrc ? d ? clufn1 ? [sixbit /HACTRN/]]
	  ret		;he has no hactrn.
	    came a,itsnam	   ;  if we aren't on the same machine, assume
	      jrst popj1	   ;    OK, since we can't check for gaggedness
	.USET FDRC,[.RXUNAM,,CLUXUN]
	MOVE D,CLUFN1	;:SEND TO SELF MUST MAIL;
	CAMN D,RUNAME	;OTHERWISE MIGHT HANG DDT.
	 RET
	.USET FDRC,[.RMASK,,D]
	TRNE D,%PICLI	;SKIP IFF HE'S GAGGED.
	 AOS (P)
	RET

BUGLOG:	MOVE D,LOGDIN
	AOJN D,CPOPJ	;J IF USER LOGGED IN.
	7NRTYP [ASCIZ/(Login?) /]

VPAGET:	AOSE VPAGCT	;1 MORE RQ FOR VPAGE.
	 RET
	SYSCLO CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF
		%CLIMM,,VPAGE ? %CLIMM,,%JSNEW]
	RET		;MUST ACTUALLY GET IT FOR 1ST RQ.

VPAGRT:	SOSL VPAGCT	;1 LESS RQ FOR VPAGE.
	 POPJ P,
VPAGR1:	SYSCLE CORBLK,[%CLIMM,, ? %CLIMM,,%JSELF ? %CLIMM,,VPAGE]
	POPJ P,		;FLUSH IT IF NO RQS LEFT.

MSGNAM:	MOVE A,XUNAME	;PUT THIS USER'S UNAME IN BUFFER.
	TRNN W1,-1
	 MOVE A,RUNAME	;(USE REAL UNAME FOR :SEND)
	JSP W3,6TO7
	 IDPB B,C
	move a,[440700,,[asciz / at /]]  ;put in the host of origin, so if
	movei b,(w1)	;is this maybe :OMAIL?
	skipe b		;if so, use ITS-FORMAT frob so :MAILNT 1 can win on it
	  move a,[440700,,[asciz /@/]]
	call bugcop	;this mail is copied to another host, it will be clear
			;where it came from.
	MOVE A,ITSNAM
	JSP W3,6TO7
	 IDPB B,C
	JRST BUGSPC

BUGDAT:	.RDATE B,	;PUT DATE IN BUFFER.
	ROT B,12.	;SHIFT TO MONTH,DAY,YEAR
	MOVEI W3,"/	;SEPARATE NUMBERS WITH "/".
	MOVEI D,0
	JRST BUGTL1

BUGTIM:	.RTIME B,	;PUT TIME IN BUFFER.
	MOVEI W3,":
	MOVEI D,0
BUGTL1:	MOVEI A,0
	ROTC A,6
	ADDI A,40
	IDPB A,C
	jumpe b,cpopj
	MOVE A,W3
	TRNE D,1
	IDPB A,C
	AOJA D,BUGTL1

sndtim:	.rtime b,	;put time in buffer in human-format
	setz a,		;clear out A
	rotc a,14	;Get the hours
	move w3,[440700,,[asciz /am/]]	;Assume morning
	cail a,(sixbit / 12/)	;unless afternoon
	  move w3,[440700,,[asciz /pm/]]
	caile a,(sixbit / 12/)	;If it's after 12:59
	  jrst [subi a,100  ;  convert it.  Subtract the 10
	        ldb d,[000600,,a]  ;get the second digit
		caige d,'2  ;Is it less than 2?
		  subi a,000070  ;Must perform a borrow type operation
		cail d,'2  ;otherwise
		  subi a,2  ;  can just decrement by 2
		jrst .+1]
	cain a,(sixbit / 00/)  ;If it's in the first hour of the day
	  movei a,(sixbit / 12/)   ;call it 12:xx
	ldb d,[060600,,a]  ;Get the first digit
	addi d,40	;convert to ascii
	caie d,"0	;unless it's 0
	  idpb d,c	;  Send that digit down
	andi a,77	;isolate the second digit
	addi a,40	;and convert to ascii
	idpb a,c	;and send it down
	movei a,":	;Send down the ":"
	idpb a,c
	setz a,		;clear out A again
	rotc a,6	;get the 10's of minutes
	addi a,40	;convert to ascii
	idpb a,c	;and send it out
	setz a,
	rotc a,6	;get the minutes.
	addi a,40	;convert to ascii
	idpb a,c	;send out the minutes digit
	move a,w3	;get the Byte Pointer to the AM/PM string
	jrst bugcop	;and send it out

BUGSPC:	MOVEI A,40	;PUT A SPACE IN THE BUFFER.
	IDPB A,C
	POPJ P,

6TO7:	MOVEI B,0
	ROTC A,6
	ADDI B,40
	XCT (W3)
	JUMPN A,6TO7
	JRST 1(W3)


;;; Magic for converting ascii byte pointers into character addresses
;;; for purposes of arithmetic.  When a Byte pointer is multiplied by
;;; 5, via MULI, the first AC gets either -5 (in the case of the Byte Pointer
;;; being 440700,,<address>) or a number from 0 to 4 depending on the position
;;; of the Byte pointer in the word.  The second AC gets the low 21. bits as
;;; the character address of the beginning of the word.

;;; Character addresses are defined to start at 0 for 440700,,0 (010700,,-1)
;;; and continue linearly through 4,,777777 for 100700,,777777

;;; This table is the magic correction factor for the various positions of a
;;; byte pointer

	644300,,0	 ;-5 case
	0 ? 0 ? 0 ? 0	 ;no other negatives possible
chrmtb:	054277,,-5	 ;010700,, case
	104277,,-4	 ;100700,, case
	134277,,-3	 ;170700,, case
	164277,,-2	 ;260700,, case
	214277,,-1	 ;350700,, case

;;; converts Byte Pointer in A to Character Address.  Clobbers A and B, returns
;;; result in B.  Assumes the Byte pointer is not indexed or indirect.
charad:	muli a,5
	sub b,chrmtb(a)
	camn b,[5,,0]	 ;case that's supposed to be zero?
	  setz b,	 ;  Make it zero
	ret

;:ERR <ARG>   DECODE <ARG> AS IO-STATUS WORD.
;:ERR<CR>     DECODE MOST RECENT ERROR IN CURRENT JOB.
KERR:	SKIPE TOKTRM
	 JRST KERR3	;NO ARG => DECODE MOST RECENTLY ERRING CHANNEL.
	CALL RONUM	;ELSE EVAL THE ARG.
	 JRST ALTDQX	;RETURN HERE IF ARG IS "RUBOUT".
	CAIL A,NIOCHN
	 JRST KERR2	;ARG IS BIG => IT'S A STATUS WORD.
	JRST KERR4	;ARG IS SMALL => IT'S A CHANNEL NUMBER.

KERR3:	CALL QJERR
	.USET USRI,[.RBCHN,,A]
KERR4:	CALL QJERR
	HRLZI D,.RIOS(A)
	HRRI D,A
	.USET USRI,D
KERR2:	MOVEM A,ERROPN+2
	PUSHJ P,FDRCOP
	 ERROPN
	  JRST .-2
	JRST CTLF3

;DEFINITIONS FOR :MSGS

UNFN1==0	;COPIED FROM ITS, NEAR QSKO
UNFN2==1
UNRNDM==2
UNDATE==3
UNLINK==1
UNIGFL==200064	;BITS IN RH OF UNRNDM, SET => FILE INACCESSABLE.
LUNBLK==5	;LENGTH OF NAME-BLOCK.

; :MSGS COMMAND - PRINT MESSAGES SINCE COMMAND LAST GIVEN.
; :MSGS KWD1, KWD2, ... PRINTS MESSAGES WHOSE DISTRIB: FIELDS INCLUDE
;  AT LEAST ONE OF THE SPECIFIED KEYWORDS.
;IF MSGLOG IS SET, WE ARE DOING AN AUTOMATIC :MSGS, AS PART OF A :INTEST.
;KEYWORDS READ ARE PUSHED ON STACK, FOLLOWED BY POINTER TO STACK AS
;IT WAS BEFORE 1ST KEYWORD PUSHED.  IF NO KEYWORDS SPEC'D, THIS MACHINE'S NAME
;IS USED AS THE DEFAULT; IN THAT CASE TOKTRM IS LEFT -1, BUT IT IS ZEROED
;IF THERE ARE SPECIFIED KEYWORDS.

MSGS:	SETZM MSGLOG
MSGSL:	HLRE D,LOGDIN
	AOJE D,LOGQ
	SAVE P		;SAVE POINTER TO LAST THING BELOW OUR ARGS
	SKIPE TOKTRM	;:MSGS<CR> => DON'T TRY TO READ ANYTHING,
	 JRST MSGSR2
	CALL RLINE	;ELSE READ A LINE AHEAD AND PROCESS IT...
MSGSR1:	CALL RTOKEN	;READ AN ARG (A SIXBIT WORD) AND PUSH IT IF NOT BLANK.
	JUMPE B,MSGSR2
	EXCH B,(P)	;WE "PUSH" IT UNDERNEATH THE SAVED STACK POINTER.
	SAVE B
MSGSR2:	SKIPN TOKTRM	;LOOP AROUND TILL CR IS REACHED.
	 JRST MSGSR1
	MOVE B,ITSNAM	;CONS UP "*AI" OR "*ML" OR ...
	LSH B,-6
	TLO B,(SIXBIT/*/)
	REST D
	CAME D,P
	 SETZM TOKTRM
	CAMN D,P	;NOW, IF THERE WERE NO ARGS PUSHED,
	 SAVE B		;PUSH THE "*AI", ETC. AS A DEFAULT.
	SAVE D		;(UNDERNEATH THE SAVED STACK POINTER, OF COURSE)
	.RTIME D,
	AOJE D,NDATER
	SETOM SRFLAG
	call msgget		   ;get the entry (address in A and MSGLOC)
	skipn c,msgs"me$mdt(a)	   ;no data in entry?
	  jrst msgs2
	
MSGS8:	MOVEM C,MSGDAT		;PRINT A FILE IFF MORE RECENT THAN MSGDAT.
	SETOM MSGLDT		;NO FILES TYPED YET.
	SYSCLE RQDATE,[%CLOUT,,MSGTDT] ;READ IN TODAY'S DATE.
;READ IN THE .MSGS. (OR WHATEVER SNAME) DIRECTORY.
	.SUSET [.SSNAM,,MSGSNM]
	CALL VPAGET		;GET FRESH PAGE AT VPAGE.
	.OPEN FDRC,MSGF2	;OPEN DIR. IN IMAGE BLOCK MODE.
	 CAIA
	  JRST MSGS1		;SUCCESS.
	AOSE MSGLOG		;FAILURE - JUST RETURN IF LOGGING IN.
	 OPNER MSGF2		;ERROR IF EXPLICIT COMMAND.
MSGS2F:	REST D
	MOVE P,D
	JRST GSNLRT

MSGS1:	MOVE D,[-2000,,VPAGAD]
	.IOT FDRC,D		;READ THE WHOLE DIR.
	.CLOSE FDRC,
	MOVEI A,VPAGAD
	ADD A,VPAGAD+1		;ADDR. OF 1ST NAME-ENTRY.
	MOVEI B,VPAGAD+2000	;ADDR AFTER LAST.
	MOVSI C,400000		;DON'T INCLUDE ACCESS DATE IN SORT KEY.
	CALL SORT
	MOVEI A,VPAGAD-LUNBLK
	ADD A,VPAGAD+1
	JRST MSGSNF

; CALL SDIST
; Search for "DISTRIB: " field in message from FDRC, possibly skipping
; unfortunate "Recieved:" fields.  Skip if found.
sdst2:	call fdrci		; Search for start of new line
	 popj p,
	caie d,^J
	 jrst sdst2
sdist:	move d,fdrcip		; Save this so we can find the start
	movem d,msgdip		; of the DISTRIB easily
	call fdrci
	 popj p,
	caie d,"R		; Perhaps "Recieved:"
	 cain d,"r		; "recieved:" also possible I guess...
	  jrst sdst2		; OK before the "DISTRIB: "
	;; See that rest of line is "DISTRIB: ", if not, give up.
irp ch,,["D,"I,"S,"T,"R,"I,"B,72]
	cain d,ch
	 call fdrci
	  popj p,
termin
	cain d,40		; Final space?
	 aos (p)		; Yes, skip
	popj p,

;COME HERE TO LOOK AT THE NEXT FILE AND DECIDE WHETHER TO PRINT IT.
;A POINTS INTO THE DIRECTORY, AT THE PREVIOUS FILE.
MSGSNF:	ADDI A,LUNBLK		;LOOK AT NEXT FILE.
	CAIL A,VPAGAD+2000
	 JRST MSGSX		;IF ALL SEEN.
	SKIPN D,UNFN1(A)
	JRST MSGSNF		;IGNORE IF FN1 BLANK.
	MOVEM D,MSGF3+1		;SAVE FN1 FOR OPEN.
	SKIPN D,UNFN2(A)
	 JRST MSGSNF
	MOVEM D,MSGF3+2
	LDB D,[360600,,MSGF3+1]
	CAIN D,'_		;IGNORE FILE IF FN1 STARTS WITH _.
	 JRST MSGSNF
	MOVE D,UNRNDM(A)
	TLNE D,UNLINK\UNIGFL
	 JRST MSGSNF		;IGNORE LINKS AND INACCESSABLE FILES.
	MOVE C,UNDATE(A)
	CAMG C,MSGDAT
	 JRST MSGSNF		;IF PRINTED MESSAGES SINCE WAS CREATED, SKIP.
	CALL FDRCOP
	    MSGF3
	 JRST MSGSNF
	call sdist		; Search for "DISTRIB: "
	 jrst [	move d,[440700,,fdrctb]
		movem d,fdrcip
		jrst msgsd1 ]
MSGSD3:	MOVE B,[404040,,404040]
	MOVE C,[440600,,B]	;READ IN 1 SIXBIT WORD FROM THE FILE.
MSGSD5:	CALL FDRCI
	 JRST MSGSNF
	CAIL D,140
	 SUBI D,40
	CAIE D,",
	 CAIG D,40
	  JRST MSGSD4
	TLNE C,770000
	 IDPB D,C
	JRST MSGSD5

MSGSD4:	XOR B,[404040,,404040]
	JUMPE B,MSGSD6		;IGNORE NULL WORDS.
	MOVE W1,P		;NOW COMPARE THE WORD AGAINST THE ARGS ON THE STACK.
	POP W1,C		;GET THE POINTER TO BENEATH THE ARGS, FOR END TEST
MSGSD7:	CAMN B,(W1)		;POP 1 ARG AND COMPARE
	 JRST MSGSDW		;MATCH => IGNORE REST OF DISTRIB: LINE, AND PRINT MESSAGE
	POP W1,W2
	CAMN W2,[SIXBIT/*/]
	 JRST MSGSDW		;KEYWORD * MATCHES ANYTHING
	CAME W1,C
	 JRST MSGSD7
MSGSD6:	CAIL D,40		;THIS WORD LOSES.  IF NOT AT END OF LINE, READ ANOTHER.
	 JRST MSGSD3
				;THE WHOLE DISTRIB: LOSES - DON'T PRINT THIS FILE.
	CALL MSGEXP		;EVEN THOUGH WE WON'T PRINT IT, DELETE IT IF OLD ENOUGH.
	 JFCL
	JRST MSGSNF

;COME HERE IF THE FILE'S DISTRIB:  SAYS WE SHOULD PRINT IT.
MSGSDW:	CALL MSGEXP		;DON'T PRINT, AND MAYBE EVEN DELETE FILE, IF EXPIRED.
	 JRST MSGSNF
	CALL MSGIL		;NOT EXPIRED; SKIP PAST THE "EXPIRES:" LINE.
	 JRST MSGSNF		;NOTHING ELSE LEFT?
	JRST MSGSD1		;PRINT THE FILE.

;TEST FILE ON FDRC FOR HAVING EXPIRED.  SKIP IF IT HASN'T.

MSGEXP:	CALL MSGIL		;SKIP THE REST OF THE "DISTRIB:" LINE.
	 JRST MSGEXD		;NO MORE IN FILE => SAY IT LOSES.
	MOVEI W1,40
	CALL MSGI1		;SKIP PAST "EXPIRES: ".
	 JRST MSGEXD		 ;NO SPACE FINDABLE?
	MOVE W1,[CALL [	CALL FDRCI
			 MOVEI D,^C
			RET]]
	CALL RDATE		;READ THE EXPIRATION DATE.
	CAML C,MSGTDT		;EXPIRED BEFORE NOW?
	 JRST POPJ1		;NO, FILE SHOULD BE PRINTED.
MSGEXD:	RET			;YES, DON'T PRINT.

;IGNORE ONE LINE FROM THE FILE ON FDRC.
;SKIP NORMALLY;  DON'T SKIP IF EOF OR END OF PAGE REACHED.
MSGIL:	MOVEI W1,^J
MSGI1:	CALL FDRCI		;IGNORE UP TO THE CHAR IN W1.
	 RET
	CAIN D,^L
	 RET
	CAIE D,(W1)
	 JRST MSGI1
	JRST POPJ1

msgget:	move a,xuname
	movei b,lsrc
	move c,[-msglen,,msgpag]
	call msgs"usrget
	  movei a,dummy		   ;  Lost, use a dummy
	movem a,msgloc		   ;remember where our entry is
	popj p,

.scalar dummy(2)

;COME HERE WHEN WE HAVE DECIDED WITH CERTAINTY THAT THE OPEN FILE NEEDS PRINTING.
;ASK THE USER --MSGS--.
MSGSD1:	SKIPGE MSGLDT		;HERE FOR MSG WITH NO DISTRIB ENTRY,
	 CALL CRF		 ;OR FOR A MSG WHOSE DISTRIB IS OK (AFTER SKIPPING IT)
	setom mornro 		;SO RUBOUT WON'T FLUSH.
	MOVEI W1,MORDMS		;TYPE "DEFERRED" INSTEAD OF "FLUSHED"
	MOVEM W1,MORMSG
	7TYPE [ASCIZ/--MSGS--/]
	CALL MORFL4		;READ CHAR, MAYBE FLUSH.
	 JRST MSGSX1
MSGSA1:	MOVE D,UNDATE(A)
	MOVEM D,MSGLDT		;THIS FILE'S DATE IS DATE OF LAST STARTED.
	MOVE D,MSGF3+1		;PRINT THE FILE'S NAME.
	CALL SIXTYP
	CTYPE 40
	MOVE D,MSGF3+2
	CALL SIXTYP
	7TYPE [ASCIZ/:
/]
	MOVE D,[440700,,FDRCTB]
	SKIPN TOKTRM		;IF THIS :MSGS HAD EXPLICIT ARGUMENTS,
	 CAMN D,FDRCIP		;AND THIS MESSAGE HAD A DISTRIB: SKIPPED OVER,
	  JRST MSGSA2
	SAVE FDRCIP
	move d,msgdip
	MOVEM D,FDRCIP		;MOVE BACK TO THE DISTRIB: AND PRINT IT,
	CALL MSGSPL		;IN ADITION TO NORMAL 1ST LINE OF TEXT.
	 ERSTRT			 ; WE ALREADY KNOW FILE DOESN'T END IN THE DISTRIB:
	REST FDRCIP		;MOVE FWD AGAIN TO START OF TEXT.
MSGSA2:	CALL MSGSPL		;PRINT 1ST LINE OF MESSAGE'S TEXT.
	 JRST MSGS5		 ;GET HERE IF EOF INSIDE THAT LINE.
	JRST MSGSA9		;THERE'S MORE => PRINT --MORE-- AND PRINT THE REST.

;CALL TO PRINT 1 LINE OF FILE OPEN ON FDRC, USING FDRCI.  SKIPS IF NO EOF.
MSGSPL:	CALL FDRCI
	 RET
	CAIN D,^J		;A LF ENDS THE LINE. DOESN'T PRINT, BUT PRECEDING
	 JRST POPJ1		;CR PRINTED AS CRLF, SO CRLF WINS.
	CTYPE (D)
	CAIN D,^M		;MAKE STRAY CR PRINT AS CRLF, BUT NOT END THE LINE.
	 CTYPE ^J
	CAIN D,^L		;^L OR ^C MEANS STOP PRINTING, IN AN ANNOUNCEMENT.
	 RET
	JRST MSGSPL

;FINISHED PRINTING 1ST LINE OF FILE.
MSGSA9:	SAVE	A
	PUSHJ 	P,MORINI	;INIT. --MORE-- PROC.
	 JRST	MSGSA3		;RETURN TO THIS INSN ON FLUSHING.
	CALL	FDRCI		;ANY MORE CHARS LEFT?
	 JRST	MSGSA3		;NO, FINISHED WITH FILE.
	CALL	TYOFRC
	SETOM	MORNHU
	.SUSET	[.SIIFPI,,[1_TYOC]]
	SKIPGE	MORNHU
	 .HANG
	PUSHJ	P,CTLF7		;PRINT CONTENTS OF FILE.
	POP	P,A
MSGS5:	SETZM	SILNT
	PUSHJ	P,CRF		;IF FINISHED WHOLE 1ST PAGE.
MSGS4:	SKIPE	GETTY	;(DON'T BLATHER ON PRINTING CONSOLE)
	 7TYPE	[ASCIZ/ END MESSAGE
/]
	JRST	MSGSNF		;PRINT ANOTHER.

MSGSA3:	REST	A		;GET POINTER INTO DIR (CLOBBER BY FLUSHING **MORE**)
	CALL	MORFL2		;TURN OFF MORPRP.
	JRST	MSGS5		;JUST END THIS FILE.

;COME HERE WHEN --MSGS-- IS FLUSHED.
MSGSX1:	SKIPGE	D,MSGLDT	;IF HAVE SEEN NO MESSAGES,
	 JRST	MSGSX3		;DON'T UPDATE DATE.
	caia

msgsx:	move d,msgtdt		   ;get today's date & time.
	move c,msgloc		   ;get address of our entry in database
	movem d,msgs"me$mdt(c)	   ;set the message date entry

msgsx3:	call msgs"unmap		   ;release the pages 
	  jfcl
	.close fdrc,		   ;close the channel when done!
	CALL	VPAGRT	;RETURN PAGE USED FOR .MSGS. DIR.
	REST	D	;FLUSH THE SAVED ARGS FROM THE STACK.
	MOVE	P,D
	JRST	NLTL2

;come here at start of :MSGS if user has no data on file yet.
msgs2:
ifn 1,[	syscal OPEN,[ %climm,,fdrc ? [sixbit /DSK/] ? xuname
		      [sixbit /MSGS/] ? hsname]
	  caia
	    jrst msgs2y		   ;found a file
	syscal OPEN,[ %climm,,fdrc ? [sixbit /DSK/] ? [sixbit /_MSGS_/]
		      xuname ? hsname]
	  caia
	    jrst msgs2y
	syscal OPEN,[ %climm,,fdrc ? [sixbit /DSK/] ? [sixbit /_MSGS_/]
		      xuname ? [sixbit /_MSGS_/]]
	  caia
	    jrst msgs2y
] ; End IFN 1,

	setz c,
	SKIPL	MSGLOG	;IF EXPLICIT :MSGS COMMAND & NO DATE
	 JRST	MSGS8	;FILE, SHOW ALL MSGS AND CREATE FILE.
	7TYPE	[ASCIZ/
To see system messages, do ":MSGS<CR>"
/]
	JRST	MSGS2F

ifn 1,[
msgs2y:	tscall msgc1		   ;Get the file date in C
	move a,msgloc		   ;recover the location of our database entry
	movem c,msgs"me$mdt(a)	   ;save the date for posterity
	syscal delewo,[%climm,,fdrc]  ;Flush the file
	  erloss
	.close fdrc,
	jrst msgs8
] ;end ifn 1,

MSGF2:	SIXBIT/  &DSK.FILE.(DIR)/

MSGC1:	calblk RFDATE,[
	%climm,,FDRC
	%clout,,C]

SWPS==LUNBLK

;SORT THE .MSGS. DIRECTORY
;A POINTS TO FIRST ENTRY
;B POINTS TO LAST ENTRY + 1
;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON

SORT:	HRLM B,(P)	;SAVE UPPER BOUND
	CAIL A,-SWPS(B)
	JRST SORT7	;ONE OR ZERO ENTRIES
	PUSH P,A	;SAVE LOWER BOUND
SORT3:	TDNN C,UNDATE(A)	;BIT SET IN LOWER ENTRY?
	JRST SORT4	;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN
	SUBI B,SWPS	;YES, NOW BACK UP UPPER POINT	
	TDNE C,UNDATE(B)	;BIT CLEAR IN UPPER ENTRY?
	JRST SORT5	;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN
REPEAT SWPS,[		;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES
	MOVE D,.RPCNT(A)
	EXCH D,.RPCNT(B)
	MOVEM D,.RPCNT(A)
]
SORT4:	ADDI A,SWPS	;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY
SORT5:	CAME A,B	;ANY MORE ENTRIES LEFT?
	JRST SORT3	;YES, GO PROCESS THEM
		;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET
	ROT C,-1	;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT
	POP P,A		;RESTORE LOWER BOUND OF ENTIRE SORT
	JUMPL C,SORT6	;JUMP IF NO MORE KEY TO SORT ON
	PUSHJ P,SORT	;SORT BOTTOM PART OF TABLE
	HLRZ B,(P)	;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE)
	PUSHJ P,SORT	;SORT TOP PART OF TABLE
SORT6:	ROT C,1		;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C"
SORT7:	HLRZ A,(P)	;MAKE A POINT ABOVE TABLE ENTRIES SORTED
	POPJ P,

; :HELP COMMAND
KHELP:	call terpri		   ;^PA
	7TYPE KHELP1
	JRST NLTL2

KHELP1:	ASCIZ & You are typing at "DDT", the top level command interpreter/debugger
of the "ITS" time sharing system.
 Type control-S to abort output from DDT.
 DDT commands start with a colon and are usually terminated
by a carriage return.  Type :? <CR>  to list them.
 Type :LOGIN <your name>  to log in.  If you are new on the system,
do :INQUIR<cr> to tell the system who <your name> really is. 
 To list a file directory, type :LISTF <directory name><CR>.
To print a file, type :PRINT <file name><CR>.  The directory
".INFO." has many files documenting system programs.
 If a command is not recognized, it is tried as the name of
a system program to run.  :LUSER <CR>  runs a program that will
request help for you.  :INFO <CR> runs a documentation perusal
program.
 Type control-Z to return to DDT after running a program
(Some return to DDT by themselves when done, printing ":KILL").
 For full documentation on DDT, do :PRINT .INFO.;DDT DOC<CR>.&


;TYPE NAMES OF SYMBOLS.
SLIST:	JUMPL U,JERR
	CALL MORINI
	 JRST NLTL2	;(RETURN HERE IF FLUSH A **MORE**)
	MOVE W1,SYSAOB	;FOR SYS JOB, GET AOBJN -> SYS SYM TAB
	SUBI W1,772000-SYSSYM ;CHANGE ADDR IN SYSTEM TO ADDR IN DDT
	SKIPN SYSSW
	MOVE W1,JOBSYM(U)
	MOVEI I2,9.	;I2 COUNTS NUM. SYMS LEFT ON THIS LINE.
SLIST2:	JUMPGE W1,KLSTUX ;DONE?
	MOVE A,(W1)
	TLNE A,%SYKIL	;DON'T LIST FULLY KILLED SYMS.
	 JRST SLIST3
	TLNE A,%SYFLG	;BLOCK OR PROGRAM
	 SOJGE I2,SLIST1 ;OR FILLED UP THIS LINE =>
	CALL CRF	;GO TO NEXT LINE.
	MOVEI I2,8.	;# SYMS THIS LINE AFTER THIS SYM.
SLIST1:	TLNE A,%SYFLG	;INDENT ALL BUT BLOCK NAMES.
	 CALL TSPC
	PUSHJ P,SPT      ;SQUOZE SYMBOL PRINT
	MOVEI D,^I
	SKIPE I2	;DON'T TAB AFTER LAST SYM ON LINE.
	PUSHJ P,TOUT
SLIST3:	ADD W1,[2,,2]
	JRST SLIST2

KMORE:	SETZM TTYFLG	;MORFL1 REQUIRES THAT TTY OUTPUT BE ON.
	PUSHJ P,RLINE	;READ (AND ECHO) MESSAGE.
	PUSHJ P,MORFL1	;READ CHAR, MAYBE FLUSH.
	JRST [PUSHJ P,INPOP
	     JRST GSNLRT]  ;FLUSHED => END VALRET OR XFILE.
	JRST NLTL5	;ELSE CONTINUE.

KCLEAR:	PUSHJ P,FORMFA
	JRST GSNLRT

;UUO DISPATCH. SIGN SET => CALL ERTTY BEFORE DISPATCH.
UUOTAB:	U7NRTY
	SETZ UERSTRT	;ERSTRT
	U7TYP
	UCTYPE
	USTRT
	SETZ UOPNER
	SETZ UTERR

UTERR:	HRLZ I1,40	;TERR - DUMMY UP AN ERSTRT.
	IORI I1,'?_14	;PUT IN A ? TO STOP ERSTRT.
	ERSTRT I1

UUOH3:	AOSN NALTXF	;ILUUOS $X'D SHOULDN'T WRITE "DDTBUG" FILES.
	 JRST ERR
UERLOS:	.SUSET [.RBCHN,,A]
	LSH A,27
	IOR A,[.STATUS ERRSTA]
	XCT A
	MOVE A,UERLSU	;READ IN MANY RANDOM USER VARS TO GO IN BUG FILE.
	.SUSET A
	SETZM HAKOK	;DON'T ALLOW HAKKAH TO MESS US UP.
	SYSCAL OPEN,[[7,,ERRC] ? ['DSK,,] ? ['DDTBUG] ? ['>_14,,] ? DBGDIR]
	 ERSTRT [SIXBIT /DDT BUG, AND CAN'T WRITE DATA FILE?/]
	MOVE A,SUUOHA
	MOVSI D,-B
	.IOT ERRC,D	;WRITE WORDS 0 THROUGH A.
	MOVE D,SUUOHD	;THEN RESTORE D AND WRITE A+1 THROUGH LIMPUR,
	MOVE A,[B-LIMPUR,,B]
	.IOT ERRC,A
	MOVE A,[-2000,,HIMPUR]
	.IOT ERRC,A	;THEN WRITE MOST INTERESTING PART OF HIGH IMPURE.
	.CLOSE ERRC,
	CALL TQUIT0	;MAKE SURE WE RETURN ALL THE WAY TO TOP LEVEL.
	ERSTRT [SIXBIT /DDT BUG: PLEASE DO :BUG DDT DESCRIBING CIRCUMSTANCES./]

UERLSU:	-UERLSL,,.+1
	.RDF1,,ERRDF1
	.RDF2,,ERRDF2
	.RPIRQ,,ERRPIR
	.RIFPI,,ERRIFP
	.RPICL,,ERRPIC
	.RAPRC,,ERRAPR
	.RTTY,,ERRTTY
	.RBCHN,,ERRBCH
	.RJNAM,,ERRJNA
	.RMPVA,,ERRMPV
UERLSL==.-UERLSU-1

DBGDIR:	SIXBIT/CRASH/	;DIRECTORY FOR WRITING BUG FILES
DBGFN2:	SIXBIT />/


;ROUTINE TO READ IN A DDT BUG FILE.
;DO DDT$J $L SYSBIN;  DBGHAK$G TO READ IN DDTBUG >
DBGHAK:	SYSCAL OPEN,[[.BII,,ERRC] ? ['DSK,,] ? ['DDTBUG] ? DBGFN2 ?DBGDIR]
	 .VALUE
	.CORE 1+PURIFT_-12
	 .VALUE
	MOVSI A,-LIMPUR
	MOVEM A,PURIFT
	MOVE A,[-2000,,HIMPUR]
	MOVEM A,PURIFT+1
	.IOT ERRC,PURIFT
	.IOT ERRC,PURIFT+1
	.CLOSE ERRC,
	MOVEM A,PURIFT
	MOVE A,VRSADR
	CAME A,[.FNAM2]
	 .VALUE [ASCIZ /: Wrong DDT version 
/]
	MOVE A,PURIFT
	.BREAK 16,100000

;OPNER UUO COMES HERE. EA SHOULD -> A 3-WORD .OPEN BLOCK
;OR A NEW-STYLE OPEN BLOCK.
;This works for things in A, B, C, or D, but not for things in the stack,
;or indexing via A.  The current state is a kludge, but one that works.
;I should re-write sometime instead of leaving this kludge in place.

UOPNER:	HRRZ A,40
	AOSN SRFLAG	;IF ROUTINE WANTED SNAME RESTORED
	.SUSET [.SSNAM,,LSNAM]	;DO IT TO IT
	MOVE D,(A)
	CAMN D,[SETZ]
	  JRST UOPNR6
	.SUSET [.RSNAM,,B]
	PUSHJ P,LFILE0
	JRST UOPNR3

UOPNR6:	move d,(p)	;on top of P should be D
	movem d,uopacd
	move d,-1(p)	;below it should be A
	movem d,uopaca	;so remember it for later
	MOVE D,1(A)	;OPNER AFTER .CALL, DECODE IT.
	CAMN D,[SIXBIT/OPEN/]
	 JRST UOPNRO	;OPEN - PRINT FILENAMES.
	CAME D,[SIXBIT /DELETE/]
	 CAMN D,[SIXBIT /RENAME/]
	  JRST UOPNRR
	CALL SIXTYP	;OTHER NEW SYS CALL: PRINT NAME OF CALL,
	CTYPE ":
	JRST UOPNR3	;AND THE ERR-DEVICE MESSAGE (EG "NO CORE AVAILABLE")

UOPNRR:	SUBI A,1
UOPNRO:	MOVEI A,3(A)	;A-> ARG -> DEV. NAM.
	ldb d,[330300,,(a)]  ;check the op code field.
	skipe d		;if this isn't 0, assume we maybe have a control arg
	  aos a		;  or something, so skip it.  Assume only one.
	pop p,D		;d may hold an arg to open.

	PUSHJ P,UOPNL	;PRINT 4 (OR 3) ARGS STARTING THERE.
UOPNR3:	7TYPE [ASCIZ/ - /]
	.SUSET [.RBCHN,,UERFLC]
	.OPEN ERRC,UERFLN
	 JRST UOPNR5
UOPNR2:	.IOT ERRC,D
	JUMPL D,UOPNR4
	CAIGE D,40
	 JRST UOPNR4
	PUSHJ P,TOUT
	JRST UOPNR2

UOPNR5:	7TYPE [ASCIZ /CAN'T READ SYSTEM'S ERROR MESSAGE?/]
UOPNR4:	.CLOSE ERRC,
	CALL CRF
	CALL %RESET
	JRST ERR6

uoparg:	cain d,d	;is it to come from D?
	  movei d,uopacd  ;yes, substitute the saved D
	cain d,a	;is it to come from A?
	  movei d,uopaca  ;yes, substitute
	move d,(d)	;get the final contents
	ret

UOPNL:	PUSH P,C
	PUSH P,D
	movei d,@(a)	;get loc of name in 1st arg,
	call uoparg	;and get the arg
	call sixtyp	;and type it
	7TYPE [ASCIZ/: /]	;IT IS DEVICE NAME.
	MOVE D,(P)	;@3(A) MAY USE THESE ACS.
	MOVE C,-1(P)
	SKIPL 2(A)	;Unless only 3 args
	  jrst [movei d,@3(a)  ;get the address, and
	        call uoparg  ;get the arg
	        jumpe d,.+1  ;If null arg, better get SNAME
		jrst .+2]  ;  otherwise that's it, continue
	.SUSET [.RSNAM,,D]	;OR DEFAULT IF NONE SPEC'D.
	PUSHJ P,SIXTYP
	7TYPE [ASCIZ/; /]
UOPNL0:	MOVE D,(P)
	MOVE C,-1(P)
	movei d,@1(a)
	call uoparg	;get the arg
	PUSHJ P,SIXTYP	;PRINT FN1 & FN2.
	PUSHJ P,TSPC
	POP P,D
	POP P,C
	movei d,@2(a)
	call uoparg	;get the arg
	JRST SIXTYP

ERR:	ERSTRT [SIXBIT/?/]
LOGQ:	ERSTRT [SIXBIT/LOGIN?/]

UERSTR:	MOVEI A,ERR5	;STRING RETURN ERROR
	HRRM A,UUOH	;RETURN TO ERR5
	PUSHJ P,TSPC

USTRT:	PUSH P,UUOH
	MOVE A,40
	HRLI A,440600
UUOH11:	ILDB D,A
	ADDI D,40
	PUSHJ P,TOUT
	CAIN D,"?
	JRST UUOXIT
	CAIE D,".
	JRST UUOH11
UUOXIT:	POP P,UUOH
	REST D
	REST A
	JRST 2,@UUOH

ERR5:	PUSHJ P,%RESET	;ALL ERRORS COME THRU HERE.
	PUSHJ P,TSPC
ERR6:	MOVEM P,ERROPP
	MOVE P,ERRSTP	;RESTORE PDL AND PC
	MOVEM P,ERRNPP
	MOVE A,ERRSTL
	MOVEM A,ERRNPC
	JRST @ERRSTL	;TO THE ERROR-RETURN LOCATION.

%RESET:	TRZ F,-1
	TRNN P,-40
	 ERLOSS
	syscle UNLOCK,[%climm,,%jself]	;unlock any database locks we have on
	CALL VPAGR1	;CLEAR OUT VPAGE
	SETOM VPAGCT
	.CLOSE FDRC,
	.CLOSE ERRC,
	.CLOSE UTIC,
	.CLOSE UTOC,
	.close lsrc,
	PUSHJ P,INRST	;RESET TTY, PUSH VALRET OR XFILE
	SETOM MORONP
	SYSCLE USRVAR,[MOVEI %JSELF ? [SIXBIT /TTY/] ? MOVEI ? [TLO %TBINF]]
IRPS XX,,[SILNT MORPRP MORNRO MORMSG HAKIOP VALCOM TQUITR rubsav tthelp bughed
U7TCTN RSTDEL HAKOK HAKING HAKINT TOUTXQ INTING XCRFSW RADING tyisnd ctlsfl
INNCTL XRWI CTLDFL TYOUNI PVALFL NALTXF STOPWT MOREXP fdrcls ratflg buggsc
hlprtn clirpx clirpc ]
	SETZM XX
TERMIN
	MOVE U,CU
	AOSN FRNDEL	;IF WE'RE LOOKING AT FOREIGN JOB THAT WENT AWAY,
	 CALL MRDR	;DON'T KEEP THINKING IT EXISTS.
	SKIPGE U,CU
	 CALL NOJOB2	;IF NO CURRENT JOB, MAKE ALL VARS AGREE ON THAT.
	AOSN SRFLAG
	.SUSET [.SSNAM,,LSNAM]
	.SUSET [.SAMASK,,[1^5,,]]
	.SUSET [.SDF1,,[0]]
	.SUSET [.SDF2,,[0]]
	SKIPL TQUITW	;IF WANTED QUIT BUT HAD BEEN NON-QUITTING,
	 JRST TQUIT	;QUIT NOW.
	POPJ P,

U7NRTY:	PUSHJ P,U7TY0
	AOSN SRFLAG
	 .SUSET [.SSNAM,,LSNAM]
	SUB P,[NUUOPS,,NUUOPS]
	JRST GSNLRT

U7TYP:	PUSH P,UUOH
	PUSHJ P,U7TY0
	JRST UUOXIT

U7TY0:	MOVE A,40
U7TY2:	PUSH P,LPTFLG	;SUBROUTINE TO TYPE ASCIZ ARG.
	PUSH P,U7TCTN'
	SETZM U7TCTN	;HAVEN'T SEEN ^N IN ARG.
	HRLI A,440700
U7TY1:	ILDB D,A
	JUMPE D,U7TYC
IRPC X,,CENSVDF
	CAIN D,^X
	JRST U7TY!X
TERMIN			;HANDLE SPECIAL CTL CHARS.
	PUSHJ P,TOUT
	JRST U7TY1

U7TYV:	SETZM TTYFLG
	JRST U7TY1

U7TYD:	MOVEI A,ERR6	;^D - LIKE ^F BUT RET. TO ERRSET, NOT CALLER.
	MOVEM A,-2(P)
U7TYF:	MOVEI A,[ASCIZ/? /]	;^F - RESET THINGS LIKE ERSTRT.
	PUSHJ P,U7TY2
	PUSHJ P,%RESET
U7TYC:	POP P,U7TCTN
	POP P,LPTFLG
	POPJ P,

U7TYN:	SETOM U7TCTN
U7TYE:	AOS LPTFLG
	JRST U7TY1

U7TYS:	SETZM SILNT
	JRST U7TY1

;ROUTINE FOR CTYPE UUO - PRINT EFF. ADDR. AS AN ASCII CHARACTER.
UCTYPE:	PUSH P,UUOH
	HRRZ D,40
	SKIPN DDTTY
	 ERLOSS
	PUSHJ P,TOUT
	JRST UUOXIT

;	CALL FDRCOP ? FILEBLOCKADDR   OPENS THAT FILE ON FDRC IN ASCII BLOCK INPUT.
;ALSO INITAILIZES THE FDRC BUFFER. SKIPS IF SUCCESSFULE.
FDRCOP:	SAVE C		;FDRC OPEN
	MOVE C,@-1(P)
	AOS -1(P)
	MOVEI C,@C
	.CALL FDRCO
	 JRST POPCJ
	AOS -1(P)
	REST C
FDRCO1:	SAVE A		;NOW, TO INITIALIZE BUFFERING,
	SETZM FDRCND
	MOVE A,[-1-FDRCL,,FDRCTB]
	CALL FDRCO4	;READ IN, NOT EXPECTING THERE TO BE ANY LOOK-AHEAD YET.
	JRST POPAJ

;HERE TO REFILL BUFFER WHEN WE HAVE AWORD OF LOOK-AHEAD IN FDRCTE.
FDRCO3:	MOVE A,FDRCTE	;COPY LAST TIME'S LOOK-AHEAD WORD TO BEGINNING OF BFR,
	MOVEM A,FDRCTB	;AND TRY TO FILL THE REST, INCLUDING A NEW WORD OF LOOK-AHEAD.
	MOVE A,[-FDRCL,,FDRCTB+1]
FDRCO4:	.IOT FDRC,A
	ANDI A,-1
	CAIN A,FDRCTE+1	;IF WE GOT ALL WE ASKED FOR, SET FDRCEP TO LAST CHAR OF
	 JRST [	MOVE A,[010700,,FDRCTE-1] ;NEXT-TO-LAST WD, LEAVING LAST WD AS LOOK-AHEAD.
		JRST FDRCO6]
	SAVE B
	SETOM FDRCND
	HRLI A,350700	;OTHERWISE, POINT AT CHAR AFTER LAST ONE READ IN.
FDRCO5:	ADD A,[070000,,]
	SKIPGE A	;AND BACK UP TILL WE FIND SOMETHING THAT ISN'T PADDING.
	 SUB A,[430000,,1]
	CAMN A,[010700,,FDRCTB-1]
	 JRST FDRCO7
	LDB B,A
	CAIE B,^C
	 CAIN B,^@
	  JRST FDRCO5
FDRCO7:	REST B		;THAT IS THE LAST CHARACTER "REALLY THERE."  MAKE FDRCEP SAY SO.
FDRCO6:	MOVEM A,FDRCEP
fdrco8:	move a,[010700,,fdrctb-1]  ;start the pointer at the beginning 
	MOVEM A,FDRCIP
	RET

FDRCI1:	SKIPGE FDRCND
	 RET
	SAVE A		;HERE FROM FDRCI WHEN BUFFER IS EMPTY.
	CALL FDRCO3	;REFILL IT.
	REST A

;READ 1 CHAR FROM BLOCK-MODE FDRC.
FDRCI:	MOVE D,FDRCIP	;UNLESS PTR IS AT END OF BUFFER,
	CAMN D,FDRCEP
	  JRST FDRCI1
	ILDB D,FDRCIP
	JRST POPJ1

shfdrx:	irps x,,morprp mormsg mornhu mornro
	save x
	setzm x
termin

;PUSH FDRC, ITS BUFFER AND POINTERS. CALL WITH JSP I4, .
SHFDRC:	.IOPUSH FDRC,
	HRLI D,FDRCTB
	HRR D,P
	AOS D
	ADD P,[FDRCSE-FDRCTB,,FDRCSE-FDRCTB]
	SKIPL P
	 ERLOSS I4	;PDL OV.
	BLT D,(P)
	JRST (I4)

;UNDO A SHFDRC. CALL WITH JSP I4, .
OPFDRC:	.IOPOP FDRC,
	HRRZ D,P
	SUBI D,FDRCSE-1-FDRCTB
	HRLS D
	HRRI D,FDRCTB
	BLT D,FDRCSE-1
	SUB P,[FDRCSE-FDRCTB,,FDRCSE-FDRCTB]
	JRST (I4)

QIJERR:	SKIPGE INTBIT(U)  ;ERROR UNLESS REAL INFERIOR OPEN (NOT PDP6).
	 JRST JERR
QI6JER:	SKIPGE UCHNLO	;ERROR UNLESS INFERIOR OR PDP6 OPEN.
QOJERR:	SKIPE DDTSW	;ERROR UNLESS ORDINARY JOB (NOT SYS OR SELF)
	 JRST JERR
QJERR:	SKIPE UCHNLO	;ERROR UNLESS REAL JOB (NOT SYS) OPEN.
	 POPJ P,
JERR:	SKIPE UCHNLO
JERRI:	 ERSTRT [SIXBIT/JOB NOT INFERIOR?/]
	MOVE D,LOGDIN
	AOJE D,LOGQ	;COMPLAIN ABOUT NOT BEING LOGGED IN BEFORE ABOUT JOB
njerr:	TERR (SIXBIT /JOB/)

;; error if can't write current job's core.

apatck:	jumpl u,njerr	;must have a a job
	move a,urandm(u)  ;check out the patch-enable
	trne a,%urdps	;is this job enabled?
	  ret		;  yes!
	skipn ddtsw	;can patch self.
	  skipg uchnlo	;sys and inferiors.
	    ret
	jrst qijerr	;otherwise must have real inferior

QRERR:	SKIPE UINTWD(U)	;ERROR IF JOB RUNNING.
	 POPJ P,
NRERR:	SKIPE UINT(U)
	 ERSTRT [SIXBIT /JOB INTERRUPTING?/]
	ERSTRT [SIXBIT/JOB RUNNING?/]

NRBERR:	SETOM TTNRST	;RUBOUT WITH NOTHING TO RUB COMES HERE.
NXERR:	7NRTYP [ASCII /?/]

NSERR:	ERSTRT [SIXBIT/JOB NEVER STARTED?/]

NCTLD:	SETOM TTNRST	;^D - DON'T FLUSH USR'S TYPEIN.
	setzm tyisnd	;restore ^V and ^W to normal
	CALL TQUIT1	;RETURN TO VERY TOP, NOT TO ERRSET.
	TERR 'XXX
	
NODATE:	ASCIZ /
(ITS does not know the date, so messages cannot be reviewed right now.)
/
NDATER:	7TYPE NODATE
	7TYPE [ASCIZ//]	;SIGNAL AN ERROR.

NJGERR:	CALL MRDR2	;$J'D TO JOB THAT WENT AWAY, FORGET ABOUT IT.
	.CLOSE USRI,
NJGER1:	ERSTRT [SIXBIT/JOB GONE?/]

NSJERR:	ERSTRT [SIXBIT/NO SUCH JOB?/]

NAERR:	7NRTYP [ASCII/ ARG/]

NGOERR:	ERSTRT [SIXBIT/NO START ADDR?/]

N2AJ3:	7NRTYP [ASCII/ JOB ALREADY EXISTS/]


NLTL2:	MOVEI D,^M
	CALL LPTR
	MOVEI D,^J
	CALL LPTR

NLTL4:	call pprin	;print the prompt
NLTL5:	AOSN SRFLAG	;RESTORE SNAME IF WAS PUSHED.
	 .SUSET [.SSNAM,,LSNAM]
	TLZ F,FLRO
	JRST GSNLRT

pprin:	call tyofrc		   ;Be sure all typeout has already happened
				   ;If it happens in HAKKAH, no --MORE--'s!!
	skipe hakint		   ;If there are HAKKAH interrupts
	  setom hakrq		   ;Be sure there's a request!
	skipe hakrq
	  setom haktyp		   ;Be sure to print any messages from HAKKAH
	call hakkan
	7type [asciz/A/]
	MOVE D,ITSNAM
	SKIPE PRMMCH	;IF USER HAS RQ'D IT, INCLUDE MACHINE NAME IN PROMPT.
	  CALL SIXTYP
	SKIPN MONMDL	;DON'T PROMPT IN MONIT MODE, SINCE COLON SERVES AS ONE.
	  XCT PROMPT	;PUT PROMPT INSN IN IMPURE PAGE FOR EASE OF PATCHING.
	popj p,


RIN:	PUSHJ P,IN		;TIN:?
	CAIN D,^D
	  JRST NCTLD
	CAIE D,177
	  AOS (P)
	POPJ P,

IN4:	SETZM MORFLG
	MOVE D,LIMBO
	AOSN UNECHF	;IF ECHO DESIRED,
	CALL IN2D	;THEN MAYBE ECHO IT
	CALL TYI3B	;IGNORE ^B, ETC.
	 JRST IN
	POPJ P,		;OTHERWISE JUST RETURN


	;1) INPUT CHARACTER
	;2) CHECK FOR , , 
	;3) MAYBE PRINT AND LPT IT
	;4) CHECK FOR , 

LISTN:	PUSH P,D
	PUSHJ P,TYI
	JRST POPDJ
	SETOM UNRCHF	;FOUND A CHAR OTHER THAN ^V, ETC: MUST RE-READ IT.
POPDJ1:	AOS -1(P)
POPDJ:	POP P,D
	POPJ P,

IN3:	PUSHJ P,INPOP	;COME HERE ON END OF VALRET OR CMD FILE.

;READ A CHAR FROM INPUT SOURCE.
IN:	CALL TYOFRC	;FORCE OUT TTY BUFFER.
	SKIPGE MORFLG	;IF READING ANSWER TO --MORE--, USE PEEKED-AT CHARACTER
	 SKIPN INPTR	;ONLY IF IT CAME FROM THE TTY.  OTHERWISE, USE THE PEEKED-AT CHAR.
	  CAIA
	   JRST IN7
	AOSN UNRCHF
	 JRST IN4
IN7:	AOSN MORFLG	;IF READING ANSWER TO --MORE--, ALWAYS READ FROM TTY.
	 JRST IN5
	SKIPGE HAKRQ	;IF ANY HAKKAH RQS PENDING, PROCESSTHEM.
	 CALL HAKKAH
	SKIPE INPTR
	 JRST IN2
IN5:	CALL TYI3
	 JRST IN5	;CHAR WAS ^V, ETC.
	SKIPN MORFLG	;IF READING CHAR AFTER --MORE--,
	 RET		;DON'T LPT IT.
IN6:	CALL ECHOT	;WALLPAPER THE CHAR AS IT ECHOED.
	 CALL LPTR	;(ARG TO ECHOT)
	RET

TYI:	CALL TYOFRC	;.LISTEN IS SUPPOSED TO FORCE OUTPUT.
	.LISTEN D,
	JUMPE D,CPOPJ
TYI3:	CALL HAKKAM	;DO HAKKAH RQ'S, SAY DO ANY MORE WHEN QUEUED.
	SETZM CTLZFL
	SKIPGE D,TTYUNR
	  .IOT TYIC,D
	SETOM TTYUNR
	setzm hakok	;defer HAKKAH rq's again.
	skipn tthelp		   ;If [HELP] isn't desired
	  caie d,%txtop+"H	   ;  help key becomes question mark
	    caia
	      jrst [ skipe hlprtn  ;      is there a help routine?
		       jrst [ call @hlprtn  ; yes, call it
			      jrst tyi3]  ;   and get another character
		     movei d,"?	 ;	  no help routine, pretend we got a ?
		     jrst .+1]

	movem d,limbo
	cain d,^s	;un-silence when read ^S.
	  jrst [ setzm silnt	   ;was silenced at int. level.
		 skipe ctlsfl	   ;is control-S supposed to abort?
		   movei d,^D	   ;  Yes, so turn it into a control-D
		 jrst .+1]
	cain d,^Z		   ;Is this a control-Z
	  skipn ctlsfl		   ;  and is it supposed to abort?
	    caia		   ;    no
	      movei d,^D	   ;	  yes, turn it into a ^D
	jumpe d,cpopj	;ignore nulls.
	caie d,^B
	  cain d,^E
	    popj p,
	skipe tyisnd	;if we're hacking sends etc
	  jrst popj1	;  then ^V and ^W are OK.
	caie d,^V	;ignore ^V, ^W,
	  cain d,^W
	    popj p,
	jrst popj1

;IF THE CHAR IN D IS ^V, ^W, ^B, ^E OR ^S, PROCESS IT AND DON'T SKIP.
;OTHERWISE SKIP.
TYI3B:	cain d,^B
	  jrst tyi3bb
	cain d,^E
	  jrst tyi3be
	skipe tyisnd	;if in the middle of a send
	  jrst popj1	;  then it's not special
	cain d,^W
	  jrst tyi3bw
	cain d,^V
	  jrst tyi3bv
	jrst popj1

;^B - MAYBE TURN ON LPT OUTPUT (WON'T OPEN LPT)
TYI3BB:	SOSL LPTFLG	;FROM FILE, SOS LPTFLG UNLESS 0,
	SKIPE INTING
	SETZM LPTFLG	;FROM TTY, SET TO 0.
	RET

;^V - MAYBE TURN ON TTY OUTPUT.
TYI3BV:	SOSL TTYFLG	;FROM FILE OR VALRET, JUST COUNTER ONE ^W.
	SKIPE INTING
	SETZM TTYFLG	;FROM TTY, CANCEL ALL ^W'S.
	POPJ P,

TYI3BE:	AOSA LPTFLG	;^E - TURN OFF OUTPUT TO LPT (BUT DON'T CLOSE)
TYI3BW:	AOS TTYFLG	;^W - TURN OFF OUTPUT TO TTY.
	POPJ P,

KINPUS:	CALL INPUSH	;:INPUSH COMMAND
	JRST NLTL2

;SAVE CURRENT INPUT SOURCES, START INPUT FROM TTY.
;CALLED FROM :XFILE AND VALRET CODE.
INPUSH:	PUSHJ P,RTYIC	;POP CURRENT SOURCE IF IT'S AT EOF.
	 JFCL
	SKIPN D,4BLKF
	 ERSTRT [SIXBIT*VALRETS OR XFILES NESTED TOO DEEP?*]
	MOVE A,(D)	;REMOVE 1ST FREE 4BLK FROM FREE LIST.
	MOVEM A,4BLKF
	SKIPGE INPTR	;IF INPUSHING CMD FILE,
	 SETOM INIOPS	;DEFER .IOPUSH TILL NEED COMC AGAIN.
	SETZ A,
	AOSN UNRCHF
	 TLO A,400000	;COMPRESS LIMBO, UNRCHF, UNECHF INTO 1 WD.
	AOSN UNECHF
	 TLO A,200000
	IORM A,LIMBO
	MOVEI A,(D)
	HRLI A,INPDL
	BLT A,3(D)	;SAVE STATUS OF INPUT SOURCE IN THE 4BLK
	MOVEM D,INPDL	;WHICH NOW IS TOP OF INPUT STACK.
	SETZM INPTR	;SET CURRENT SOURCE TO TTY:
	POPJ P,

INFLS:	PUSH P,[NLTL2]	;:INFLS COMMAND.
INFLS1:	PUSHJ P,INPOP	;KEEP POPPING TILL STACK EMPTY.
	SKIPE INPDL
	 JRST INFLS1
	JRST INPOP	;& ONCE MORE TO BE SURE.

KINPOP:	SKIPE TOKTRM	;:INPOP COMMAND.
	JRST [	CALL INPOP	;:INPOP^M - POP INPUT RIGHT NOW.
		JRST NLTL4]
			;:INPOP <LINE> - POP AFTER EXECUTING <LINE>.
	SKIPG INPTR	;IF CURRENT SOURCE ISN'T VALRET,
	 SETZM INVAOB	;RANDOMNESS IN INVAOB MIGHT CONFUSE RELOC.
	PUSHJ P,RLINE	;READ IN A LINE, PREPARE TO RE-READ IT.
	MOVEI W1,INVAOB
	PUSHJ P,JCL0	;READ INTO SYMTAB SPACE, INVAOB GETS AOBJN -> IT.
	HRRZ A,INVAOB
	HRLI A,10700	;SET UP B.P. TO IT, MUST BE POSITIVE.
	SOS A
	MOVEM A,INPTR	;CLOBBER CURRENT SOURCE WITH IT.
	JRST NLTL4	;WILL READ THAT LINE, THEN POP.

;TERMINATE A VALRET OR CMD FILE, POP TO OUTER INPUT SOURCE.
INPOP:	PUSH P,A
	SKIPGE A,INPTR	;IF SOURCE IS CMD FILE, CLOSE IT.
	 JRST [.CLOSE COMC, ? JRST INPOP0]
	JUMPE A,INPOP0
	PUSH P,W1	;VALRET STRING: RELEASE STRING'S STORAGE.
	MOVEI W1,INVAOB
	PUSHJ P,ELEC0
	POP P,W1
INPOP0:	SETZM INPTR	;SET SOURCE TO TTY.
	SETZM UNRCHF
	SETZM UNECHF
	SKIPN D,INPDL	;IF NO SOURCE ON PDL, LEAVE IT THAT WAY.
	 JRST POPAJ
	MOVEI A,INPDL
	HRLI A,(D)
	BLT A,INVAOB	;SET CURRENT SOURCE FROM SAVED ONE.
	HLLZ A,LIMBO	;UNPACK UNRCHF, UNECHF FROM LIMBO.
	HRRZS LIMBO
	TLNE A,400000
	 SETOM UNRCHF
	TLNE A,200000
	 SETOM UNECHF
	EXCH D,4BLKF	;AND FREE THE PDL BLOCK.
	EXCH D,@4BLKF
	SKIPL INPTR	;IF POPPING INTO CMD FILE,
	 JRST POPAJ
	AOSE INIOPS	;.IOPOP INLESS WAS NEVER PUSHED.
	 .IOPOP COMC,
	JRST POPAJ

;RESET THE CURRENT INPUT STREAM.
INRST:	AOSE TTNRST	;FOR RUBOUT AND ^D, DON'T FLUSH TYPEIN.
	 .RESET TYIC,
	PUSHJ P,ERTTY1	;TURN ON TTY, TYPE ^V IF WAS OFF.
	PUSHJ P,RTYIC	;IF CURRENT SOURCE IS AT EOF,
	 JFCL		;RTYIC WILL POP IT. (SAVE INPDL SPACE).
	SKIPN INPTR	;IF INPUT NOT FROM TTY,
	 RET
	SKIPE 4BLKF	;PUSH INPUT IF ROOM IN INPDL,
	 JRST [7TYPE [ASCIZ/:INPUSH /] ? JRST INPUSH]
	PUSHJ P,INFLS1	;ELSE FLUSH ALL INPUT & TELL USER.
	JSP A,U7TY2
	ASCII /INPDL OVERFLOW - PDL RESET/

;	CALL ECHOT
;	 CALL TYPEOUT-RTN
;OUTPUT CHAR IN D VIA THAT RTN, AS IT WOULD ECHO.
ECHOT:	CAIE D,^I
	CAIN D,^J
	 JRST POPJ1	;THESE DON'T ECHO.
	CAIE D,^M
	 RET		;OTHERS ECHO AS THEY'RE OUTPUT.
	XCT @(P)	;^M EHCOES AS ^M
	MOVEI D,^J
	XCT @(P)	;FOLLOWED BY ^J.
	MOVEI D,^M	;DON'T CLOBBER D.
	JRST POPJ1

IN2B:	SKIPG INPTR	;INPTR -1 FOR CMD FILE,
	.IOT COMC,D
	SKIPL INPTR	;FOR VALRET, IS BYTE POINTER
	ILDB D,INPTR
	ANDI D,177	;MASK TO 7 BITS
	EXCH D,LIMBO
	CAIE D,^M	;IF PREV. CHAR WAS ^M,
	JRST IN2C
	MOVE D,LIMBO
	CAIN D,^J	;IGNORE ^J AFTER ^M.
	JRST IN2B
IN2C:	MOVE D,LIMBO
	CAIN D,^L	;IGNORE FORMFEED.
	JRST IN2B
	POPJ P,

IN2:	PUSHJ P,IN2B	;READ 1 CHAR FROM FILE OR VALRET STRING.
	SKIPG INPTR	;IF IN XCT FILE, ^C TERMINATES.
	 CAIE D,^C
	  SKIPN LIMBO	;^@ TERMINATES FILES AND VALRETS.
	   JRST IN3
	SKIPE INNCTL
	 JRST IN2D	;DON'T CHECK FOR ^B ETC IN FALSE CONDIT.
	PUSHJ P,TYI3B	;SET OR CLEAR VARIOUS FLAGS
	 JRST IN2	;CHAR READ WAS ^V, ETC, TRY AGAIN.
IN2D:	CALL ECHOT	;IF CHAR SHOULD ECHO,
	 CALL TOUT	;SIMULATE THAT.
	JRST TYOFRC

;PEEK AT A CHARACTER FROM THE INPUT FILE OR VALRET STRING AND SKIP,
;OR DON'T SKIP IF GETTING CHARS. FROM TTY
RTYIC:	SKIPN INPTR	;IF GETTING CHARACTERS FROM TTY,
	POPJ P,		;THEN JUST RETURN
	SKIPGE UNRCHF	;IF CHARACTER SAVED,
	JRST RTYIC2	;THEN USE IT (LEAVE UNRCHF ALONE)
	PUSHJ P,IN2B	;ACTUALLY GET THE CHAR.
	CAIE D,3	;IF NOT CONTROL C,
	JUMPN D,RTYIC3	;AND NOT ZERO, THEN USE IT, SET UNRCHF, AND SKIP-RETURN
	JRST INPOP	;END IT, DON'T LOOK AT NEXT ONE.

RTYIC2:	MOVE D,LIMBO	;RECOVER CHARACTER
	JRST CPOPJ1	;SKIP-RETURN

RTYIC3:	SETOM UNRCHF	;TELL INPUT ROUTINE TO USE IT
	SETOM UNECHF	;TELL INPUT ROUTINE TO ECHO IT
	JRST CPOPJ1

TYO1:	SKIPE LPTOPN	;COME IF TTY OUTPUT OFF,
	 SKIPE LPTFLG	;IS LPT OUTPUT ON AND LPT OPEN?
	  SKIPN MORPRP	;NO, FLUSH IF MORE-PROCCING.
	   RET
	SKIPE TYOUNI	;IF WE ARE TYPING A **MORE**,
	 RET		;DON'T FLUSH THE TYPEOUT - WOULD LEAVE INTS DEFERRED, ETC.
TYOFLS:	MOVEM P,FLSOPP
	MOVE P,MORPRP	;RESTORE PDL AND PC TO
	MOVEM P,FLSNPP
	SETZM MORPRP
	JRST @MORRET	;VALUES SET UP BY MORINI.

LPTR:	SKIPE LPTOPN	;OUTPUT CHAR IN D TO LPT IF OPEN & ON.
	SKIPE LPTFLG
	RET
	.IOT LPTC,D
	POPJ P,

LCT:	7TYPE [ASCIZ /   /]
	POPJ P,

;; type out a word as sixbit without any 1'...' stuff, for init files
k6type:	call getnum	;get a number to hack
	save ttyflg	;we're going to let this go through even if TTY is off
	sosge ttyflg	;(only if it's off once)
	  setzm ttyflg	;  If it was already on, don't let go negative
	move d,a	;get the arg in right place for SIXTYP
	skipn ttyflg	;unless it was off more than once
	  call sixtyp	;  type it, with no space
	rest ttyflg	;restore the flag to it's old state
	jrst nltl2	;return and prompt.

getnum:	call ronum	;read in the number to type
	  jrst altdqx	;  rubbed out, abort
	skipn b		;if we weren't given anything
	  move a,lwt	;  use Q instead
	ret

;; temporary hack, type a word as 8bit bytes ascii!
k8type:	call getnum	;get a number to type
	call terpri
	move b,[441000,,A]  ;pointer into A
repeat 4,[
	ildb d,b	;get a character
	trne d,200	;extra bit on?
	  ctype "~	;  yes, indicate it
	trnn d,200	;otherwise
	  ctype 40	;  keep alignment
	ctype (d)]	;type the character
	ctype ^I	;tab over
	jrst gsnlrt	;and that's all!

;; New line on the TTY if needed.  For init files.
kterpri:
	save ttyflg
	sosge ttyflg	;let this go through even if TTY is off
	  setzm ttyflg
	skipn ttyflg
	  call terpri	;  and terpri
	rest ttyflg	;restore the flag to it's old state
	jrst nltl2	;return and prompt (prompting only if TTY is on!)

terpri:	save d
	save u7tctn		   ;don't clobber, but
	setom u7tctn		   ;it would best to allow ^P codes
	movei d,^P
	call tout
	movei d,"A
	call tout
	rest u7tctn		   ;unclobber
	jrst popdj

;; type an unconditional carriage return
CRF:	PUSH P,D
	MOVEI D,^M
	PUSHJ P,TOUT
	MOVEI D,^J
	PUSHJ P,TOUT
	JRST POPDJ

;; MBYFF does a clear-to-EOF-and-home if too near the bottom of the
;; screen to trigger a --MORE--

mbyff:	tscall pcpntr	;get the current vpos
	hlrzs d
	sub d,ttymxv	;get - # of lines from bottom
	camge d,[-7]	;if it's far enough to cause a --MORE--
	  ret		;  don't clear the screen
	7type [asciz /ETL/] ;Otherwise wind our way around to the top
	ret

FORMF:	SKIPE SCROLL	;CLEAR SCREEN IF NON-SCROLLING DPY, ELSE CRLF.
	 JRST CRF
FORMFA:	7TYPE [ASCIZ/C/]	;SIMILAR, BUT CLEAR SCREEN EVEN IF IN SCROLL MODE.
	SETOM RADCLR	;THIS CLEARS OUT THE RAID REGISTERS.
	RET

;;; TOUT takes a character in D, and types it.

TSPC:	MOVEI D,40	;TYPE A SPACE
TOUT:	SKIPE TOUTXQ	;OUTPUT THE CHARACTER IN A, TO WHEREVER OUTPUT IS GOING
	 JRST [	XCT TOUTXQ ? RET]	;USE THE SPECIAL OUTPUT ROUTINE IF ANY.
	SKIPE MORPRP	;IF DOING --MORE-- PROC,
	 CALL HAKKAN	;PROCESS QUEUED HAKKAH RQ'S IF ANY.
	CALL LPTR	;OUTPUT CHAR TO LPT IF APPRO.
	SKIPN SILNT	;IS OUTPUT BEING SENT TO TTY?
	 SKIPE TTYFLG
	  JRST TYO1	;NO; SEE IF OUTPUT IS GOING ANYWHERE AT ALL.
	SKIPE U7TCTN	;IN A 7TYPE, AFTER A ^N, CURSOR CTL CODES ARE ALLOWED.
	 JRST TYOFI1
;OUTPUT CHAR. IN A TO THE TTY.
TYO2:	CAIN D,^P	;FOR ^P, TO AVOID CURSOR CTL,
	 JRST [	CALL TYOFI1	;OUTPUT "^PP" WHICH MEANS "SEND A ^P".
		MOVEI D,"P
		CALL TYOFI1
		MOVEI D,^P
		RET]
TYOFI1:	SKIPE TYOUNI	;UNIT MODE TYPEOUT NEEDED? (BECAUSE WE ARE WITHIN MORINT)
	 JRST TYOFI2
	SOSGE TYOCNT
	 CALL TYOFR0	;NO SPACE => EMPTY BUFFER AND RETURN TO TYOFI1.
	IDPB D,TYOPNT
	RET

TYOFI2:	SKIPN SILNT
TYOFR3:	 SYSCAL IOT,[%CLIMM,,TYOC ? D ? %CLBIT,,%TJMOR]
	  JFCL
	RET

;EMPTY OUT THE TTY OUTPUT BUFFER, AND RETURN TO THE INSN
;BEFORE THE CALL. ASSUME TYOCNT HAS BEEN SOS'D ONCE TOO MANY.
TYOFR0:	SOS (P)
	SOS (P)
	AOS TYOCNT
TYOFRC:	SKIPE DDTTY	;PREVENT HANGING UP ON IOT IN HERE
	 SKIPE TYOUNI	;IF OUTPUTTING IN UNIT MODE, DON'T NEED TO FORCE.
	  RET
	SAVE A		;EMPTY THE TTY OUTPUT BUFFER.
	MOVN A,TYOCNT
	ADDI A,TYOBFL*5	;# CHARS NOW IN BUFFER.
	JUMPE A,POPAJ
	SAVE B
	MOVE B,[440700,,TYOBUF]
	SKIPN SILNT
TYOFR2:	 SYSCAL SIOT,[%CLIMM,,TYOC ? B ? A]
	  JFCL
	REST B
TYOFR1:	MOVEI A,TYOBFL*5 ;RE-INIT ALL BUFFER INFO.
	MOVEM A,TYOCNT
	MOVE A,[010700,,TYOBUF-1]
	MOVEM A,TYOPNT
	JRST POPAJ

POPW1J:	POP P,W1
	POPJ P,

;CALL MORINI   ;WHEN STARTING TO TYPE A FILE, ETC.
;  RETURN HERE WHEN FLUSH WITH STACK RESTORED.
;RETURN HERE IMMEDIATELY.
MORINI:	POP P,D		;RET. ADDR.
	MOVEM D,MORRET	;SAVE IN CASE FLUSHED.
	MOVEM P,MORPRP	;RESTORE P, TOO.
	JRST 1(D)	;SKIP IN-CASE-FLUSHED INSN.

;SEARCHES CALL HERE. NO SKIP => SEARCH SHOULD BE TERMINATED.
OUTTST:	AOSN CTLDFL	;IF ^D HAS BEEN SEEN AT INT. LVL, STOP.
	 RET
	SKIPE LPTOPN	;IF OUTPUT IS GOING NOWHERE, STOP.
	 SKIPE LPTFLG
	  CAIA
	   JRST POPJ1
	SKIPN SILNT
	 SKIPE TTYFLG
	  RET
	JRST POPJ1

;;;Logging in.

NALTU:	JUMPN D,NALTU2		;Check for U prefix arg (a uname).
	SKIPN CONFRM		;If missing, means reload this user.
	 JRST NALTU1		;Only require confirmation if user wants it.
	PUSHJ P,RIN		;Read confirmation character.
	 JRST ALTDQX		; If rubout, retype the U.
	CAIE D,".		;Confirmed?
	 JRST NXERR		; No, abort.
NALTU1:	CALL LOGOU3		;If running jobs, let user change his mind.
	 JRST NLTL2
RELOAD:	SYSCAL RELOAD,[%CLIMM,,-1]
	 .VALUE			; Reload fails if not top level.
	ERLOSS			;RELOAD doesn't return.

NALTU2:	TLNE B,O.IFX		;Infix arg (CSTACY1U)?
	 JUMPN A,[CALL RTYIC	; Yes, turn TTY on and eliminates any empty
		 JFCL		; valrets/xfiles from the stack.
		SETZM TTYFLG
		JRST KLOGI1]	; Does not indicate we are a winner.
	SETZM CLOBRF		;Normally, U implies a sophisticated user.
	SETZM MORWARN
	SETOM C.ZPRT
	JRST KLOGI1

KLOGIN:	PUSHJ P,RTOKEN		;:LOGIN needs to read uname.
	JUMPE B,KLOGIN		;If none, try again.
	MOVE C,B		;C gets desired uname.
KLOGI1:	SKIPE LOGDIN		;Logged in already?
	 JRST KLOGI2		; No, so can try.
	7TYPE [ASCIZ /
Already logged in as "/]
	MOVE D,RUNAME		;Complain if already logged in.
	CALL SIXTYP
	7TYPE [ASCIZ /"/]

KLOGI2:	CALL MASACL		;Noisily massacre any jobs.
	SAVE C			;Stash uname on stack.
	CALL DDTUN0		;Compute the xuname and hsname.
	REST C			;Recover uname.
	SYSCAL LOGIN,[C ? TRMNAM ? XUNAME ? %CLERR,,A]	;Try to login.
	 CAIA
	JRST KLOGI6
	CAIN A,%EBDFN		;Trying to log in as ___xxx or something?
	 7TYPE [ASCIZ "Illegal UNAME"]
	CAIN A,%ENSMD		;Inferiors around?
	 ERLOSS			;  Should have already been killed.
	CAIN A,%EROJB		;Already logged in?
	 ERLOSS			; LOGDIN must be confused.
	CAIN A,%ETOP		;Not top level?
	 7TYPE [ASCIZ "Not top level"]
	CAIE A,%EEXFL		;Uname already in use?
	 ERLOSS			; No - some unknown failure mode.
	MOVE B,[440600,,C]	;Try to uniquify the uname.
KLOGI3:	ILDB D,B		;Get char from it.
	JUMPE D,KLOGI4		;Look for a blank to make into a number.
	TLNE B,770000		;Check all six chars.
	 JRST KLOGI3		;If no blanks, clobber the 6th character.
KLOGI4:	MOVEI D,'0		;CSTACY will become CSTAC0.
KLOGI5:	DPB D,B			;Permute the uname.
	SYSCAL LOGIN,[C ? TRMNAM ? XUNAME ? %CLERR,,A]	;Try again.
	 JRST [	CAIE A,%EEXFL	; We expect only this error.
		 JRST NXERR	;  Otherwise just barf mysteriously.
		AOJA D,KLOGI5 ]	; Keep AOS'ing until login succeeds.
	MOVE D,C		;Print out uname we finally succeeded with.
	CALL NUTYP2
KLOGI6:	.SUSET [.SHSNAME,,HSNAME] ;Fix vars LOGIN call screwed up.
	CALL DDTUN1		;Take note that uname has changed.
	MOVE D,MSNAM
	CAMN D,XUNAME		;If MSNAME set by DDTUNM to other than real uname
	 JRST [	CALL KINTAC	; Now offer to attach a detached tree, etc.
		 ERLOSS		; Shouldn't fail?
		JRST .+1 ]	;Continue.
	MOVE B,(W4)
	TLNE B,O.IFX
	 SKIPE -1(W4)		;If this is not NAME$0U, look for init file.
	  JRST KINTE3
				;For 0U, do the default things as if no init file.
KLOGI7:	MOVE B,XUNAME
	MOVE C,ITSNAM		;Tell PRMLOP to only look on this ITS!
	call prmlop		;try to open mail file on dsk or com.
	 JRST KLOGI8		;FAILED.
				;WIN - A HAS "DSK" OR "COM",
				;USED BY PRML2 TO DELETE AND RENAME.
	MOVEI D,MORDMS		;TYPE "POSTPONED" INSTEAD OF "FLUSHED"
	MOVEM D,MORMSG		;IF USER FLUSHES THE --MAIL--.
	7TYPE [ASCIZ/--Mail--/]
	CALL MORFL4		;ASK USER WHETHER HE WANTS TO SEE THE MAIL.
	 JRST KLOGI8
	CALL PRML2
KLOGI8:	.CLOSE FDRC,		;IN CASE PRMLOP SUCCEEDED BUT USER FLUSHED.
	SETOM MSGLOG
	SETOM TOKTRM		;PREVENT AN ATTEMPT TO READ ARGS FOR THE :MSGS.
	JRST MSGSL

MORDMS:	ASCIZ/Postponed/


;:CHUNAM <UNAME> - CHANGE UNAME TO <UNAME>.
KCHUNAM:MOVE D,LOGDIN
	AOJE D,LOGQ		;If not logged in yet, use "LOGIN".
	move d,itsnam
	camn d,[sixbit/mc/]
	 jrst [move d,[sixbit/rms/]
	       came d,xuname
	        jrst .+1	;nope
;	       7type [asciz/ACHUNAM not permited to RMS@MC/]
	       7type [asciz/ACHUNAM Invalid/]
	       jrst nltl4]
	CALL RTOKEN		;Read desired new UNAME.
	JUMPE B,.-1
	MOVE C,B		;C gets UNAME.
	7TYPE [ASCIZ /--Massacre and Reset--/]
	MOVEI D,[ASCIZ/Rescued
/]
	MOVEM D,MORMSG
	CALL MORFL1
	 JRST NLTL4
	CALL LOGOU3		;Maybe kill running jobs?
	 JRST ERR		; Not confirmed.
	CALL MASACL		;Massacre all jobs.
	SETZM BYERUN		;Don't run the BYE program.
	CALL KOUTT2		;Flush SENDS and OMAIL files as if logging out.
	.SUSET [.SUNAM,,C]	;Must be toplevel else will ILUUO.
KCHUN1:	.SUSET [.SXUNAM,,C]	;Interrupt rtns look for KCHUN1 as saved PC.
	CALL DDTUN0		;Compute our XUNAME from the new UNAME.
	SYSCLE TRANCL,[[600000,,-1]]	;Flush all translations.
	SYSCAL CNSGET,[%CLIMM,,TYIC ? %CLOUT,,A ? %CLOUT,,B ? %CLOUT,,C
		       %CLOUT,,D ? %CLOUT,,W1]
	 JRST RELOAD
	TLZ W1,%TOCLC+%TOROL+%TOSA1
	TLO W1,%TOMOR
	TLZ D,%TCQRY+%TCRFS+%TCOCO+%TCICO
	SYSCLO CNSSET,[%CLIMM,,TYIC ? A ? B ? C ? D ? W1]
	JRST RELOAD			;Go reload ourselves.


;IF THERE ARE ANY JOBS, KILL THEM AND TYPE ":MASSACRE"
MASACL:	SAVE C
	SKIPA C,[-NINFP,,]
MASAC5:	 ADDI C,USRLNG-1
	SKIPN UUNAME(C)
	 AOBJN C,MASAC5
	JUMPGE C,MASAC8	;NO JOBS TO KILL - DON'T FRIGHTEN USER.
	7TYPE [ASCIZ/:MASSACRE /]
	CALL MASAC1	;FOUND AT LEAST 1 JOB - KILL ALL, AND TELL USER.
MASAC8:	MOVSI C,400000
MASAC6:	.UTRAN C	;NOW FIND ALL FORGOTTEN JOBS AND KILL THEM.
	 JRST MASAC7	;TRY EACH INT BIT TO SEE IF A JOB HAS IT.
	SYSCAL OPEN,[%CLIMM,,FDRC ? ['USR,,] ? C+1 ? C+2]
	 ERLOSS
	.UCLOSE FDRC,
	 JFCL
MASAC7:	LSH C,-1
	TRZ C,-1
	JUMPN C,MASAC6
	JRST POPCJ


;:INTEST COMMAND.
KINTES:	CALL KINTAC	;FIRST, OFFER TO ATTACH ANY HEALTHY DETACHED JOB.
	 ERLOSS
KINTE1:	move c,xuname	;calculate MSNAME, SNAME, HSNAME from XUNAME
	movem c,xfilef+1  ;Set the FN1 of the XFILE default
	call gethsn	;get the HSNAME
	  jfcl
	movem c,hsname
	.suset [.shsname,,c]
	movem c,msnam
	movem c,lsnam
	movem c,xfilef+3  ;set the directory to get XFILE's from
	.suset [.ssnam,,c]
	SKIPE INPTR	;:INTEST INSIDE VALRET OR FILE DOES THE "NORMAL" STUFF
	 JRST KLOGI7	; :PRMAIL AND :MSGS.
KINTE3:	MOVE C,[SIXBIT /LOGIN/]
	CALL KINTE2	;TRY TO OPEN INIT FILE ON FDRC.
	 JRST KLOGI7	;NO INIT FILE, TRY TO PRINT MAIL AND MSGS.

	move d,xuname	;there's an init file. but if <xuname> # <uname>,
	camn d,runame	;ask the user before using the init file.
	 jrst xfile1
	syscle RFNAME,[%climm,,fdrc ? %clout,,c ? %clout,,w1 ? %clout,,c
				    %clout,,d]  ;get the 
	came w1,[sixbit /*/]	   ; if it's the naive init, don't even ask!
	  jrst kinte4		   ; (i.e. is it USERS1;* LOGIN ?)
	came d,[sixbit /GUEST1/]
	  camn d,[sixbit /USERS1/]
	    jrst xfile1
kinte4:	7TYPE [ASCIZ/--Init--/]
	CALL MORFL1
	 JRST [	.CLOSE FDRC,	;HE DOESN'T WANT HIS INIT FILE; DON'T WASTE DISK CHANNEL.
		JRST NLTL2]
	JRST XFILE1	;USER SAYS YES; USE THE INIT FILE.

;LOOK FOR INIT FILE (C HAS LOGIN) OR EXIT FILE (C HAS LOGOUT).

kinte2:	syscal open,[%climm,,fdrc ? ['DSK,,]
	   xuname ? c ? hsname]	;try <hsname>;xuname DDT
	  caia
	    jrst popj1		;That's it!
	syscal open,[%climm,,fdrc  ;Not there, try HSNAME;* DDT
	   ['DSK,,]
	   [sixbit /*/]  ? c ? hsname]
	  ret			;  no init at all!
	    jrst popj1		;init file!  (Even if it IS the default!)


;IF THERE IS A HEALTHY DETACHED JOB BELONGING TO THIS USER,
;OFFER TO ATTACH IT, AND DO SO IF THE USER SAYS YES (SPACE).
;OTHERWISE, KINTAC RETURNS SKIPPING.
KINTAC:	MOVE C,['HACTRN]
	SETZB D,A
KINTAL:	SYSCAL OPEN,[[10,,FDRC] ? ['USR,,] ? RUNAME ? C]
	 JRST KINTA1
	.USET FDRC,[.RAPRC,,B]
	JUMPGE B,KINTA1
	ADDI D,1	;RH(D) GETS COUNT OF RUNNING DETACHED TREES WE HAVE.
	.USET FDRC,[.RUSTP,,B]
	TLNN B,BUSRC	;IS THIS ONE RUNNABLE?
	 SKIPA A,C	;YES, A GETS JNAME OF HIGHEST-NAMED RUNNING ONE
	  ADD D,[<1,,>-1] ;NO, LH(D) COUNTS THE STOPPED DETACHED TREES.
KINTA1:	ADDI C,1
	CAME C,['HACTRT]
	 JRST KINTAL
	TLZE D,-1	;ARE THERE ANY STOPPED DETACHED TREES?
	 7TYPE [ASCIZ /You have at least one dead detached tree.
/]
	JUMPE D,POPJ1	;ANY RUNNING DETACHED TREES?
	.SUSET [.RSUPPR,,B]	;YES => OFFER TO ATTACH ONE, IF WE'RE TOP LEVEL.
	TSOPEN TYIC,[['TTY ? 0]]
	JUMPGE B,[7TYPE [ASCIZ /You have one or more attachable trees
/]
		  JRST POPJ1]
	MOVEI B,[ASCIZ /--Attach Your Detached Tree--/]
	CAIE D,1
	 MOVEI B,[ASCIZ /You have several attachable detached trees.
--Attach A Detached Tree--/]
	7TYPE (B)
	MOVEI D,[ASCIZ/Left Detached
/]
	MOVEM D,MORMSG
	CALL MORFL1
	 JRST POPJ1	;COME HERE IF THE USER FLUSHED THE QUERY; ELSE
	SETZ C,		;TRY TO ATTACH.  A HAS THE JNAME.
	MOVE D,A
	SAVE D
	CALL NJTYP2	;SAY WHICH JOB WE ARE TRYING TO ATTACH.
	REST D
	SETZM REOWNF
	movei a,%urfrn	;if it used to be a foreign-only job, undo that
	andcam urandm(u)  ;by clearing the magic bit that prevents reowning
	CALL OUSRNL	;OPEN AND REOWN IT,
	SKIPE UINT(U)	;AND UNLESS IT HAS STOPPED SINCE WE LOOKED,
	 JRST [	CALL MRDR
		7NRTYP [ASCIZ /Oops!  Couldn't attach it?/]]
	JRST KATTAC	;GO :ATTACH TO IT.

kprmai:	skipn toktrm
	  jrst prml6
kprma2:	move a,[sixbit /MAIL/]	;looking for MAIL files
	move b,xuname	;looking for OUR mail
	move c,itsnam	;look only on this ITS
	call gtmail	;open the mail file
	  jrst prml5	;  no mail!
	call fdrco1	;initialize buffering
prml2:	save a
	setom fdrcls	;actually print them, but don't close FDRC
	call ctlf1a
	rest a
	skipn fdrcls	;If FDRCLS is 0, a --MORE-- was flushed during typout
	  jrst nltl2	;  so don't bother him any more
	skiple omailf	;Does he never want it deleted?
	  jrst prml4	;  Don't offer
	skipe omailf	;does he want it renamed?
	  jrst [syscal DELETE,[ [sixbit /DSK/] ? xuname ? [sixbit /OMAIL/]
				hsname]
		  jfcl
		syscal RENMWO,[ %climm,,fdrc ? xuname ? [sixbit /OMAIL/]]
		  jrst prml4
		jrst prml4]
prmtyp:	7type [asciz /ADelete this mail?  (Y or N) /]
	call tyofrc
	call tyi3	;get a character
	  jfcl
	cail d,140	;is the lowercase?
	  subi d,40	;  yes, uppercasify
	cain d,"N	;did he say no?
	  jrst [ 7type [asciz /AMail Saved.
/]
		 jrst prml4]
	caie d,"Y	;did ye say yes?
	  jrst prmtyp	;  no, neither yes nor no, must be confused.
	syscal delewo,[%climm,,fdrc]  ;delete it!
	  jfcl
	7type [asciz /ADeleted.
/]
prml4:	.close utic,	;close the channel
	.close fdrc,	;close the channel
	setzm fdrcls
	jrst nltl2

PRML5:	call terpri
	SKIPE GETTY
	 7TYPE [ASCIZ /No Mail/]
	JRST nltl2

ifn 0,[			   ;Old way, with MAIL files on COMMON; or <user>;
PRMLO:	SETZ ? SIXBIT/OPEN/
	%CLBIT,,.bai
	%CLIMM,,FDRC
	a ? d ? mlfl ? setz d

] ; End IFN 0,  -- Old way, with MAIL files on COMMON; or <user>;


;   PRMLRO (for RMAIL/BABYL) and  PRMLOP (for MAIL).
;Try to open mail file for user with name in d. skip if succeed.
;Return in a the device for the new mail file (whether succeed or not).
;clobbers b. If file is opened, the fdrc buffer is set up.
;C is expected to contain the ITS to look on, initially or 0 meaning whichever
;is right for the user in D.

prmlro:	move a,[sixbit /RMAIL/]	;Initialize to read RMAIL, not MAIL.
	call gtmail
	 jrst [	move a,[sixbit /BABYL/]	
		call gtmail	;Maybe the user likes BABYL instead.
		 ret
		jrst .+1]
	aos (p)
	jrst fdrco1

prmlop:	move a,[sixbit /MAIL/]	;initialize to read MAIL, not RMAIL
IFN 0,[				   ;The old way, with MAIL on COMMON or <user>;
prmlo1:	movem a,mlfl
	 movsi a,'DSK	;try DSK first
	.call prmlo	;try it
	 CAIA
	  JRST PRML7	;DSK:USER;USER MAIL FOUND.
	.STATUS FDRC,B	;NOT FOUND; IF DISK DIR EXISTS,
	LDB B,[OPNLBP,,B]
	movsi a,'COM	;NO DISK DIR, OR NOT TRYING DISK, => TRY COM
	.CALL PRMLO
	  JRST PRML8	;NO OLD MAIL FILE =>
PRML7:	AOS (P)
	JRST FDRCO1
	
PRML8:	CAIE B,%ENSDR	;USE DISK UNLESS DISK DIR DOESN'T EXIST.
	  movsi a,'DSK
	RET
] ;END IFN 0 -- End of old way of having mail files on COMMON or <user>

ifn 1,[			;New way, with mail files on <hsname>;
prmlo1:	call gtmail	;open the mail file
	  ret		;  not found, just return
	aos (p)		;Found it, skip return
	jrst fdrco1
] ; End IFN 1, -- end of new way of having mail files on <HSNAME>;<xuname> mail

prml6:	call rmtoke	;read FOO@MC type spec
prml6a:	jumpe b,kprmai	;If no user was specified, do :PRMAIL<cr>
	skipn toktrm	;if there was no cr echoed, output one
	 call crf	;so things look nice.
	move c,a	;wants machine in C
	move a,[sixbit /MAIL/]	;and FN2 in A
	call prmlo1	;look for that user's mail
	 jrst prml5	;  not there, tell him so.
	call ctlf1	;found it => print it.
	jrst nltl2	;that's it!

kprsen:	skipe toktrm	;null arg (a cr) means self.
	  move b,runame
	setz a,		;assume no @MC found
	skipn toktrm
	  call rmtoke	;otherwise read name and maybe machine for sends to
			;read
	skipn a		;no device?
	  movsi a,'DSK	;  use DSK
kprse0:	call terpri	;Type a CRLF if needed
kprseo:	syscal OPEN,[[.bai,,fdrc] ? a ? b ? [sixbit /SENDS/]
		     [sixbit /.TEMP./] ? %clerr,,d]
	  jrst kprse1	;  Maybe we got the wrong directory?

kprse2:	call mbyff	;FF if too near bottom to trigger a --MORE--
	CALL FDRCO1	;SET UP FDRC BUFFER FOR FDRCI.
	CALL CTLF1
	JRST NLTL2

KPRSE1:	cain d,%ensfl	;no such file?
	  jrst kprse3	;  must have been right filenames
	caie d,%ensdr	;no such directory?
	  opner @kprseo	;  no, must have been some kind of lossage.  Inform
	syscal OPEN,[[.bai,,fdrc] ? a ? b ? [sixbit /SENDS/]
	            [sixbit /COMMON/]]
	  caia
	    jrst kprse2	;aha!  Machine doesn't use .TEMP.;

kprse3:	SKIPE GETTY
	 7TYPE [ASCIZ /No Sends/]
	JRST NLTL2


;;; <USER>^A prints <USER>'s sends
nctla:	move b,c	;Normally, we get an uname as a prefix
	move a,c	;A for MCHOKP's sake
	call mchokp	;Is it an ITS?
	  movsi a,'DSK	;  No, get from DSK:
	came a,[sixbit /DSK/]  ;Was that just DSK?
	  move b,sndflt	;         No, we got machine instead, so use old uname
	skipn c		;0^A means get ourself
	  move b,runame	;  So do that
	skipn d		;No argument?
	  move b,sndflt	;  Use the default
	movem b,sndflt	;Remember what send file
	call terpri
	came a,[sixbit /DSK/]  ;Is it DSK?
	  camn a,itsnam	;  Or this ITS?
	    caia
	      jrst ctlapr  ;  Neither, must print
	camn b,runame	;is it ourself?
	  jrst kprse0	;  Yes, don't bother printing
ctlapr:	7type [asciz /(Getting SENDS for /]
	move d,b	;Get the name to print
	call sixtyp	;print it
	came a,[sixbit /DSK/]  ;Is it DSK?
	  camn a,itsnam	;  Or this ITS?
	    jrst ctlapx	;    Yes, no need to specify where
	movei d,"@	;Tell him where it's coming from
	call tout
	move d,a	;Get the ITS name to print
	call sixtyp	;print it
ctlapx:	ctype ")	;Balance the parens
	jrst kprse0	;and print the messages

;;; <USER>$^A prints <USER>'s mail
naca:	call naca0	;get the right user in B
	came b,xuname   ;if it wasn't us,
	 jrst naca1     ;just print it.
	skipe pmlflg    ;be like :PRMAIL?
	 jrst [call crf ;be pretty
	       jrst kprma2]  ;print my mail.
naca1:	call prmlop	;open a MAIL file
	  jrst prml5	;  Print out NO MAIL message
	
nacapr:	call mbyff	;clear screen if too near bottom
	call terpri	;prettify, new line
	call ctlf1	;actually print it out!
	jrst nltl2

;;; <USER>$$^A reads USER's RMAIL or OMAIL
n2aca:	call naca0	;get the right user in B
	call prmlro	;open the RMAIL file
	  jrst prml5	;  nope, don't print yet!
	jrst nacapr	;print it out

naca0:	move a,c	;MCHOK0 expects in A
	move b,c	;Assume that we were give the XUNAME instead of device
	skipn c		;0$^A means get our own
	  move b,xuname	;  use our XUNAME instead
	save b		;MCHOK0 clobbers B
	skipe d		;if no arg was given
	  call mchok0	;  or the arg wasn't an ITS name
	    jrst [ setz c,  ; get from whichever machine is right
		   rest b  ;Use our original arg as the XUNAME
		   jrst naca01]
	rest b		;Clean up the stack.  This is thrown away now.
	caia		;  If it was an ITS, or...
naca01:	    skipn d	;    If we had no argument
	      move b,sndflt  ; use the default
	skipn d		;If no explicit arg
	  move c,sndits	;  use the same ITS as before
	movem b,sndflt	;set the default for next time
	movem c,sndits
	move d,b	;we return our result in D
	ret		;return


;:ATTACH - DELETE SELF LEAVING CURRENT JOB AS TOP LEVEL.
KATTAC:	CALL QIJERR
	SKIPN UINT(U)
	SKIPE UINTWD(U)
	 ERSTRT [SIXBIT/NOT RUNNING?/]
	CALL TTYLEV
	SYSCAL ATTACH,[%CLIMM,,USRI]
	 JRST NTOPERR
	JRST KATTA1

KOUTTE:	SAVE [GSNLRT]	;:OUTTEST COMMAND.
KOUTT1:	save ttyflg		;Turn tty on for asking silly
	setzm ttyflg		; questions.
	CALL ALRWRN	;NOTIFY USER OF ANY PENDING ALARM.
	CALL SAFETY	;IF ANY INFERIORS ARE PROTECTED, GET CONFIRMATION.
	CALL LOGOU3	;IF INFERIORS RUNNING, GET CONFIRMATION.
	 JRST ERR
	rest ttyflg		;Put tty back as it was.
	SKIPE GETTY
	 CALL FORMFA	;CLEAR SCREEN ON DISPLAYS, EVEN IN SCROLL MODE.
KOUTT2:	SYSCAL DELETE,[['DSK,,] ? RUNAME ? [SIXBIT/SENDS/] ? cladir]
	 JFCL
	SKIPN BYERUN	;IF USER WANTS TO RUN :BYE, DO THAT
	 RET
	CALL INPUSH	;BY SETTING UP COMMANDS TO DO IT (AND THEN FINISH LOGGING OUT).
	MOVE D,[010700,,[ASCIZ /:BYE
1U/]-1]
	MOVEM D,INPTR
	RET

LOGOUT:	MOVE C,[SIXBIT /LOGOUT/]
	TLNE B,O.IFX	;$$1U => LOGOUT, DOING NEITHER INIT FILE NOR DEFAULT ACTIONS.
	 jrst [jumpn a,katta1
	       setzm byerun
	       call koutt1	   ;perform default actions
	       jrst katta1]

;;This call to SAFETY seems spurious since all other paths go through
;;KOUTTE which calls SAFETY itself.  Additionally this prevents users from
;;testing things like this in their LOGOUT files.  -Alan 7/9/84
;;	CALL SAFETY	;LETS NOT FORGET PROTECTED JOBS... (MARC - 3/25/79)
	CALL KINTE2	;ELSE LOOK FOR THE EXIT FILE.
	 CAIA
	  JRST LOGOU4	;THERE IS ONE; XFILE IT AND THEN LOG OUT.
	CALL KOUTT1	;OTHERWISE PERFORM DEFAULT ACTIONS (=:OUTTEST).
	SKIPE BYERUN	;IF BYERUN IS SET, THAT SET UP SOME COMMANDS, SO GO DO THEM.
	 JRST GSNLRT	;THEY INCLUDE A $$1U TO FINISH LOGGING OUT.
KATTA1:	CALL TYOFRC
	.LOGOUT 1,	;GOOD BYE
NTOPER:	ERSTRT [SIXBIT/NOT TOP LEVEL?/]

LOGOU4:	CALL INPUSH	;XFILE THE EXIT FILE, BUT, UNDER IT ON THE INPUT STACK,
	MOVE D,[10700,,[ASCIZ/1U/]-1]
	MOVEM D,INPTR	;ARRANGE FOR A LOGOUT TO BE EXECUTED AFTER THE EXIT FILE.
	JRST XFILE1

LOGOU3:	MOVSI A,NINFP		;LOOK AT ALL INFERIORS.
LOGOU1:	SKIPLE INTBIT(A)	;NOT IN USE OR FOREIGN, OK.
	SKIPE UINTWD(A)
	 JRST LOGOU2
	MOVE C,UINT(U)
	JUMPN C,LOGOU2	;JOB TRYING TO RETURN => OK TO KILL IT.
	MOVE D,UIACK(U)
	TRNE D,60000	;JOB TRYING TO COMMIT SUICIDE => CERTAINLY OK.
	 JRST LOGOU2
	7TYPE [ASCIZ/--Kill Running Inferiors--/]
	CALL MORFL1	;READ FROM TTY, SKIP IF SPACE,
	 RET		;NOT SPACE, "FLUSHED" TYPED BY MORFL1.
	JRST POPJ1	;HE REALLY WANTS TO GO AHEAD.

LOGOU2:	ADDI A,USRLNG-1
	AOBJN A,LOGOU1
	JRST POPJ1	;NO RUNNING INFERIORS.

KDETAC:	MOVE D,LOGDIN
	AOJE D,LOGQ	;ILLEGAL UNLESS LOGGED IN.
	save ttyflg		; Bind TTYFLG so that user is sure to see
	setzm ttyflg		; the message.
	CALL ALRWRN	;WARN USER OF ANY PENDING ALARM.
	rest ttyflg
	.CLOSE TYOC,	;FORCE RE-OPEN WHEN NEXT USE TTY.
	SYSCLE DETACH,[%CLIMM,,-1]
	JRST NLTL2	;TYPE "*"; WILL CAUSE IOCERR WHICH WILL REOPEN TTY
			;BUT THAT WILL CAUSE DTTY INTERRUPT WHICH WILL
			;DETECT CHANGED UNAME.

ALRWRN:	SKIPN ALARMV
	 RET
	7TYPE [ASCIZ /--Despite Pending :Alarm--/]
	CALL MORFL1
	 JRST ERR
	RET

KOFDIR:
OFDIR:	SKIPE TOKTRM
	JRST OFDIR4	;J IF JUST :OFDIR^M.
	PUSHJ P,RLINE
OFDIR0:	SKIPE TOKTRM	;IF MORE NAMES, HANDLE ONE.
	JRST NLTL2
	PUSHJ P,OFDIR1
	JRST OFDIR0

OFDIR1:	PUSHJ P,RTOKEN	;READ NEXT NAME.
	JUMPE B,CPOPJ
OFDIR5:	MOVSI C,-SNLLEN	;PTR FOR FETCHING FROM SNLIST.
	MOVSI A,-SNLLEN	;PTR FOR STORING BACK.
OFDIR2:	MOVE D,SNLIST+1(C)
	CAMN B,D
	JRST OFDIR3
	MOVEM D,SNLIST+1(A)	;NOT THE ONE TO DELETE - RE-STORE IT.
	AOBJP A,CPOPJ
OFDIR3:	AOBJN C,OFDIR2
	SETZM SNLIST+1(C)
	AOBJN C,.-1	;FILL SNLIST WITH 0'S AT END.
	POPJ P,

OFDIR4:	SETOM SFDIR	;TURN OFF SEARCH FEATURE.
	MOVSI A,-SNLLEN
	SETZM SNLIST+1(A)
	AOBJN A,.-1	;CLEAR SNLIST.
	JRST NLTL2

KNFDIR:
NFDIR:	SETZM SFDIR	;TURN ON SEARCH.
	SKIPE TOKTRM
	JRST NLTL2
	PUSHJ P,RLINE
NFDIR0:	SKIPE TOKTRM
	JRST NLTL2
	CALL RTOKEN	;READ NAME,
	CALL NFDIR1	;PUT IT IN SNLIST.
	JRST NFDIR0

NFDIR1:	JUMPE B,CPOPJ
	CALL OFDIR5	;DELETE FROM SNLIST,
	MOVSI D,1-SNLLEN   ;ADD TO FRONT,
	EXCH B,SNLIST+1(D) ;MOVE REST DOWN.
	AOBJN D,.-1
	RET

;THIS IS THE DIRECTORY-SEARCHING FILE OPEN ROUTINE.
;B should point to a vector containing the DEVICE, FN1 and FN2, as sixbit whole
;words.  DDT's current sname should be the one to try first.
;it is tried, followed by all the SNAMEs in the two search lists.
;FLOCK skips if the file is successfully opened.
;In that case, SNLIST contains the SNAME that worked.
;the .SNAME variable is always restored to its original value.

FLOCK:	.SUSET [.RSNAM,,SNLIST]
	SETOM SRFLAG
	MOVE A,[.SSNAM,,SNLIST]
	MOVEM A,INSNAM
FLO2:	.SUSET INSNAM	;TRY THIS DIRECTORY
	.CALL FLOCKO
	 JRST FLO4
	HRRZ D,INSNAM
	MOVE D,(D)	;REALLY WANTS WHAT POINTS TO
	AOS (P)
	CAMN D,SNLIST
	JRST FLO5
	MOVEM D,SNLIST	;IF SKIP RETURN, SNLIST HAS SNAME USED.
	SKIPN NFVRBS	;If use wants us to be quiet,
	 JRST FLO3	;  do not tell about changed directories.
	PUSHJ P,SIXTYP	;Else loser changed directory, tell him.
	CTYPE ";
	PUSHJ P,CRF
FLO3:	SETZM SRFLAG
	JRST CPOPJ

FLO4:	MOVE D,(B)
	CAME D,['DSK,,]	;SEARCH-LIST FEATURE ENABLED ONLY FOR DSK,
	 CAMN D,ITSNAM	;OR FOR AN EQUIVALENT OF DSK.
	  SKIPE SFDIR	;TRY SEARCH CROCK?
	   POPJ P,	;FAILED, NO SKIP
	PUSHJ P,FLOERR	;UNLESS FILE NOT FOUND, REALLY AN ERROR.
	OPNER FLOCKO
	AOS INSNAM
	HRRZ D,INSNAM
	SKIPE (D)	;IF MORE IN THIS TBL, TRY THEM.
	JRST FLO2
	CAIG D,SNLIS1	;IF WERE SEARCHING 1ST, TRY 2ND.
	JRST FLO6
FLO5:	.SUSET [.SSNAM,,LSNAM]
	SETZM SRFLAG
	POPJ P,	;FAIL, NO SKIP

FLO6:	MOVEI D,SNLIS1
	HRRM D,INSNAM
	JRST FLO4

SMFLCK:	MOVS A,UFILE(U)
	CAIN A,(SIXBIT /TTY/)
	 TERR (SIXBIT /DEV/)
	RET

FLOERR:	.STATUS UTIC,A
	LDB A,[OPNLBP,,A]
	CAIE A,%ENSDR	;BAD SNAME?
	 CAIN A,%ENSFL	;FILE NOT FOUND?
	  JRST CPOPJ1
	RET		;ALL OTHERS ARE REALLY BAD.

FLOCKO:	SETZ ? SIXBIT/OPEN/
	[6,,UTIC]
	(B)
	1(B)
	SETZ 2(B)

;$$J AND JNAME$$J COMMANDS HERE.
N2AJ:	JUMPE D,N2AJ1
	PUSHJ P,QIJERR	;N$$J
	CAMN C,[SIXBIT/PDP6/]
	JRST NAERR
	CAME C,[SIXBIT /PDP10/]
	CAMN C,[SIXBIT /SYS/]
	JRST NAERR	;NOT SYS
	CAMN C,UJNAME(U)
	 JRST NLTL2	;DON'T BARF AT RENAMING JOB TO SAME NAME AS NOW.
	MOVE A,[10,,(SIXBIT/USR/)]
	MOVE B,UUNAME(U)	;TRY OPEN NEW NAME AS FOREIGN USR.
	.OPEN FDRC,A
	 CAIA
	  JRST N2AJ3
	.USET USRI,[.SJNAME,,C]	;SET NAME
	.USET USRI,[.SXJNAM,,C]
N2AJ2:	MOVEM C,UJNAME (U)	;DOCUMENT
	JRST NLTL2

N2AJ1:	JUMPL U,QJERR	;LOSERS THAT TYPE $$J WITH NO JOBS
	PUSHJ P,LCT	;$$J
	PUSHJ P,KLSTJ4
	JRST NLTL2

;OPEN A JOB BY NAME

KJOB:	SKIPE TOKTRM	;:JOB
	JRST ALTJ9
	PUSHJ P,RTOKEN
	MOVE D,B
	JRST NALTJ1


;; :JOBP FOO does a :JOB FOO iff it would succeed

kjobp:	skipe toktrm	;Did we terminate?
	  jrst kjob1	;  yes, must be no job specified, see if there are jobs
	call rtoken	;Try reading a name
	jumpe b,kjobp	;no job name yet, keep trying for one
	move d,b	;JOBPIK expects jname to find in D
	setzm reownf	;don't offer to clobber if disowned, just do it!
	call jobpik	;see if the job exists
	jumpn d,[ move u,cu  ;  It failed?  go back to our current job
		  move a,d  ;	our return value is JOBPIK's return value
		  call pprin  ;return it as an octal frob
		  jrst gsoctj]  ;and be sure to prompt
	setom cu	;say no current job in case OPUSR fails
	call opusr	;open the job
	  jrst [ call fnjob  ;find SOME job
		 movei a,1  ; note that we didn't succeed
		 jrst gsoctj]  ;and return 1 as an octal frob
	setz a,		;we succeeded, return zero
	call pprin	;as an octal value
	jrst gsoctj	;and prompt

kjob1:	setom cu	;if we have a job, be sure to get it back
	call fnjob	;J
	seto a,		;assume no jobs
	skipl cu	;Is there a job?
          setz a,	;  yes, so return success
	jrst gsoctj	;That's all.  prompting was done by FNJOB
	

KUJOB:	CALL RTOKEN	;:UJOB
	JUMPE B,KUJOB
	SAVE B
	CALL RTOKEN
	JUMPE B,.-1
	MOVE D,B
	REST C
	JRST KUJOB1

;;; :FJOB <jname> or :FJOB <UNAME> <JNAME>, access job, guarenteeing not
;;; to reown it.

kfjob:	call rtoken	;<jname> or <uname>
	jumpe b,kfjob	;null, try again
	push p,b	;remember the first arg
	skipe toktrm	;is that the end?
	  jrst kfjobj	;  yes, must have just been the jname
kfjob1:	call rtoken	;get the JNAME
	skipe toktrm	;is that the end?
	  jumpe b,kfjobj  ;  yes, and we didn't get a second arg, hack JNAME
	jumpe b,kfjob1	;not the end yet, but null?  Keep trying
	move c,(p)	;first arg was the UNAME, get it
	move d,b	;and our just-read arg was the JNAME
kfjob2:	movni a,4	;-4 REOWNF means to make it non-reownable
	movem a,reownf	;so OUSRNL won't open it as inferior
	jumpe c,[ push p,d  ;remember the JNAME we're hacking
		  call jobpik  ;try to find any job with that JNAME
		  pop p,a  ;recover the JNAME
		  exch a,d  ;A gets reason for failure, D gets JNAME again
		  jumpl a,njger1  ;job just vanished, that's an error
		  jumpg a,kfjob3  ;didn't find it, try maybe detached job
		  jrst kfjob9]	;found it, go hack it
kfjob3:	syscal open,[ %clbit,,10\.bii ? %climm,,fdrc ? [sixbit /USR/] ? c ? d]
	  jrst kfjobf
	.uset fdrc,[.rsuppro,,a]  ;check out the user index of it's superior
	.close fdrc,	;don't need it open any more...
	camn a,ruind	;Is this an inferior?
	  jrst [ 7type [asciz /A[Already an inferior!!]
/]
		 call njtyp  ;let him know he's still got the same job
		 pop p,c  ;   clear our first arg off the stack
		 jrst nltl4]  ;propmt and return, don't error out an XFILE
	call ousrnl	;select and open the job
kfjob9:	pop p,c		;recover our first argument
	skipn c		;if we didn't explicitly specify the UNAME
	  call njtyp	;  type the job name opened
	jrst nltl4	;and prompt and exit

;; Job is not found, report failure and clean up

kfjobf:	7type [asciz /A[No such job!!]
/]
	skipge cu		   ;Did we have a job?
	  jrst [ call nojob
		 pop p,c	   ;  Clean up the stack
		 jrst nltl4]	   ;  all done
	call njtyp		   ;let him know he's still got the same job
	call opusr		   ;And reselect it
	 jfcl
	pop p,c			   ;   clear our first arg off the stack
	jrst nltl4		   ;prompt, return, don't error (for XFILE's)

;; just got the JNAME only, use our UNAME
kfjobj:	setz c,		;0 UNAME, use JOBPIK to find the job
	move d,(p)	;recover our first arg as JNAME
	setzm (p)	;and pretend we didn't get a first arg
	jrst kfjob2	;and hack the rest

;; J or <job>J
NALTJ:	JUMPE D,ALTJ9	;$J   JUMP IF NO ARG.
	JUMPE C,NAERR
	MOVE D,C
NALTJ1:	SETZ C,
KUJOB1:	PUSHJ P,OUSR
	JRST NLTL2

OUSR:	SETZM REOWNF	;MAKE SURE WE GET A "!" FOR A NEW JOB.
	CALL OUSRNL
	SKIPE UINT(U)
	 JRST UBRK0
	RET

;OPEN JOB WITH NAMES IN C AND D.  UNAME = 0 => CREATE INFERIOR UNLESS
;JOB WITH MATCHING JNAME ALREADY KNOWN TO DDT.
OUSRNL:	CALL DDTUNM	;MAKE SURE WE KNOW OUR UNAME.
	SKIPGE U,CU	;START SCANNING JOB SLOTS AFTER CURRENT JOB, OR FROM 0.
	 MOVEI U,USREND-USRLNG	;SO IF >1 JOB WITH THIS JNAME, FIND THEM 1 BY 1
	MOVE B,U	;REMEMBER WHERE WE START SO KNOW WHEN TO STOP.
	SETO W1,	;SAY NO FREE SLOT FOUND.
OUSR2:	ADDI U,USRLNG	;ADVANCE TO NEXT JOB
	CAIN U,USREND
	 SETZ U,
	CAME D,UJNAME(U) ;DOES THIS JOB HAVE DESIRED JNAME?
	 JRST OUSR5	;NOT WHAT WE'RE LOOKING FOR.
	CAME C,UUNAME(U) ;HAS IT THE DESIRED UNAME?
	 JUMPN C,OUSR5	;NO, NO GOOD UNLESS ANY UNAME IS OK.
	MOVN A,REOWNF
	CAIE A,3	;FOR FOO^K
	 CAIN A,2	;OR :FOO (ONLY WHEN ..GENJFL/0 CAN IT GET HERE)
	  SKIPN CLOBRF	;IF THIS FEATURE ENABLED,
	   CAIA		;REOWNF=4 can get here 
	    CALL OUSR4E	;IF ABOUT TO CLOBBER A JOB, QUERY ABOUT IT.
	cain a,4	;Is this a :FJOB FOO
	  jrst [ movei a,%urfrn	 ;the magic bit that prevents reowning
		 iorm a,urandm(u)  ;turn it on in the URANDM word
		 jrst ousr21]  ;and continue with our :UJOB

ousr21:	JUMPN C,OUSR2B	;IF UNAME WASN'T EXPLICITLY SPEC'D (NOT :UJOB)
	MOVE A,UUNAME(U)
	CAME A,RUNAME	;AND ISN'T THE SAME AS OURS,
	 CALL NJTYP	;INFORM USER.
OUSR2B:	CALL OUSR2A	;IF JOB DOESN'T EXIST, IT WAS DELETED BY ITS OWNER.
	 JRST NJGERR
	CALL OPUSR	;FOUND JOB SUPPOSEDLY WHAT WE WANT.
	 JRST NJGER1
	RET

OUSR5:	CAML U,W1	;ALREADY SAW A LOWER-NUMBERED FREE SLOT =>
	 JUMPGE W1,OUSR6 ;DON'T NEED THIS ONE.
	SKIPN UJNAME(U)	;IF WE FIND FREE SLOT, REMEMBER IT.
	 MOVEI W1,(U)
OUSR6:	CAME U,B	;ALL CHECKED YET?
	 JRST OUSR2	;NO, KEEP TRYING
	SKIPGE U,W1	;YES, IF FOUND FREE SLOT, USE IT TO CREATE.
	 ERSTRT [SIXBIT /8 JOBS ALREADY?/]	.SEE NINFP	;WILL RELOAD U.
	JRST OUSR4

;HERE WHEN MUST SELECT A JOB NOT ALREADY KNOWN.  U HAS INDEX TO USE FOR IT.
;C HAS UNAME, AND D HAS JNAME.
OUSR4:	CAMN D,['SYS,,]
	 SKIPE C		;IF TRYING TO HACK OUR OWN INFERIOR NAMED "SYS",
	  JRST OUSR8
	MOVSI B,400000		;SAY IT'S A PHONY INFERIOR (AFFECTS OPUSR).
	MOVEM B,INTBIT(U)
OUSR8:	SKIPN C		;UNAME OF 0 SPEC'D => OK TO CREATE, AND USE OUR UNAME.
	 MOVE C,RUNAME
	MOVEM C,UUNAME(U)	;SET UP UNAME AND JNAME FOR NEW JOB
	MOVEM D,UJNAME(U)
	MOVEM D,UFILE1(U)
	setzm urandm(u)	;normally, URANDM is zero, but...
	movei d,%urfrn	;the magic bit to prevent reowning
	movn c,reownf	;check REOWNF for what kind of create this is
	cain c,4	;if -4, this is a :FJOB and we don't want to reown
	  movem d,urandm(u)  ;so set the magic bit in URANDM to prevent it
	MOVE D,MSNAM
	MOVEM D,UFILES(U)
	MOVSI D,'DSK
	MOVEM D,UFILE(U)
	MOVEI D,(SIXBIT/BIN/)
	MOVSM D,UFILE2(U)	;SET UP LOADING FILE NAMES.
	SETOB D,PERMIT(U)	;DON'T STOP BEFORE VALRET STRINGS
	SETOM SYSUUO(U)		;DON'T STOP BEFORE SYSTEM CALLS.
	HRRZM D,LIMIT(U)	;DEFAULT SEARCH LIMITS ALL OF ADDR SPACE.
	MOVE D,MSTYPE		;INIT. THE JOB'S MULTI-STEP BITS.
	MOVEM D,USTYPE(U)
	MOVE D,SYMTOP
	MOVEM D,BININF(U)  ;NO INFO ON WHO ASSEMBLED WHEN, ETC., IN THIS JOB.
	MOVEM D,UNDEFL(U)  ;NO UNDEF SYM REFS THIS JOB.
	MOVEM D,JOBSYM(U)  ;NO SYMBOLS.
	MOVEM D,PRGM(U)
	SETZM UINT(U)	;CLEAR INT WORD
	MOVEI D,TPERCE(U)
	HRLI D,MPERCE	;INIT. THE JOB'S TYPEOUT MODES.
	BLT D,TNMSGN(U)
	SAVE [0]	;FIND OUT WHETHER THE JOB ALREADY EXISTS
	MOVE A,[10,,USRI]
	.CALL OPNUSR
	 SETOM (P)
	PUSHJ P,OPUSR	;OPEN JOB
	 JRST NSJERR
	MOVN C,REOWNF
	cain c,4	;:FJOB should also tell it's a new job
	  ctype "!
	CAIE C,3
	 SKIPN REOWNF	;FOR $J, ^K AND ^H,
	  CTYPE "!	; INDICATE THAT THIS IS NEW JOB
	CALL TYOFRC
	REST C		;C IS NEGATIVE IF JOB IS NEWLY CREATED.
	SKIPE SYSSW	;DON'T CHECK WHETHER SYSTEM RUNNING.
	 JRST [MOVEI D,200000 ? MOVEM D,LIMIT(U) ? RET]
	MOVE D,UJNAME(U)
	CAME D,[SIXBIT/PDP6/]
	CAMN D,[SIXBIT/PDP10/]
	 JRST [	AOS SIXCTR
		MOVE A,[.BII,,PDP6C]
		.CALL OPNUSR	;KEEP OPEN ON PDP6C SO NOONE ELSE CAN STEAL IT.
		 JFCL		;SINCE WON'T BE OPEN ON USRI AFTER $J.
		JRST CPOPJ]
	MOVEI D,21
	MOVEM D,UINTWD(U)	;INDICATE JOB NOT YET STARTED
	CALL OUSR4F
OUSR4C:	SKIPLE INTBIT(U)
	 CALL JCL3	;ALSO SET OPTBRK BIT, CLEAR OPTCMD.
	SKIPN DDTSW
	 RET		;EXIT IF NOT OPENING SELF
	MOVE D,STBDDT	;SELF - SYM TAB IS DDT SYM TAB.
	MOVEM D,JOBSYM(U)
	MOVEM D,PRGM(U)
	RET

;TAKE USR IN U; SKIP IF SPEC'D JOB EXISTS. CLOBBERS A,D.
OUSR2A:	MOVE D,UJNAME(U)
	CAMN D,['SYS,,]
	 JRST POPJ1	;SYS JOB CONSIDERED TO EXIST.
	MOVE A,[10,,USRI]
	.CALL OPNUSR	;TRY TO OPEN AS FOREIGN JOB.
	 RET
	JRST POPJ1

;CLOBBERS D. C SHOULD HAVE -1 IF JOB IS NEWLY CREATED.
;ANALYZE THE JOB AND SET UP ITS STATE APPROPRIATELY;
;ALSO PRINT "REOWNED" IF NECESSARY, AND INIT SOME VARS IF NEC.
OUSR4F:	.USET USRI,[.RUSTP,,D]	;PICK UP STOP WORD
	TLNE D,100000	;SKIP IF JOB RUNNING
	JRST OUSR4B	;JOB STOPPED
	SETZM UINTWD(U)	;INDICATE JOB RUNNING
	JRST OUSR4D

OUSR4B:	.USET USRI,[.RUPC,,D]	;GET JOB'S PC
	MOVEM D,PPC(U)	;AND REMEMBER IT.
	CAME D,[10000,,0] ;IF JOB HAS BEEN RUN, SAY IT RETURNED
	SETOM UINTWD(U)	;(OTHERWISE UINTWD WILL STILL SAY "NEVER STARTED")
	JUMPL C,OUSR4A	;NEWLY CREATED JOB, SET SNAME TO MSNAME.
OUSR4D:	SKIPG INTBIT(U)	;IF OUR INFERIOR NOW, MUST HAVE BEEN DISOWNED.
	 RET
	7TYPE [ASCIZ/: Reowned 
/]
	syscal usrvar,[%climm,,usri ? %climm,,.roption ? %climm,,0
			[tlo %opddt\%opbrk]]  ;turn on those bits
	  jfcl

	SKIPN D,UINTWD(U)	;IF WE SHOULD BELIEVE IT'S RUNNING,
	 HRROS BPINFL(U)	;WE SHOULD ALSO BELIEVE ITS BREAKPOINTS ARE IN IT.
	CAIN D,21
	  JRST OUSR4E
	MOVEM D,UINT(U)
	SETZM UINTWD(U)
OUSR4E:	SKIPN REOWNF	;IF DOING FOO^K OR :FOO,
	 RET
	7TYPE [ASCIZ/--Clobber Existing Job--/]
	CALL MORFL1
	 JRST ERR
	RET

OUSR4A:	.USET USRO,[.SSNAM,,MSNAM] ;NEW JOB: INIT ITS SNAME.
    	SKIPGE D,TWAITF		   ;ALSO INIT TTYTBL ACCORDING TO TWAITF.
	 MOVSI D,%TBINT
	.USET USRO,[.STTY,,D]
	RET

;HERE TO RESELECT THE JOB IN U.  JOB NEED NOT EXIST YET,
;BUT UJNAME AND UUNAME MUST BE SET UP.  UIND(U) ASSUMED TO BE NONZERO IF OLD
;JOB.  Skips if successful

OPUSR:	JUMPL U,JERR	;COMPLAIN IF ILLEGAL JOB
	CALL NOJOB1	;INDICATE NO JOB OPEN IN CASE OPUSR BOMBS.
	AOS D,NJ1	;GET NEXT JTIME VALUE
	MOVEM D,JTIME(U)	;INDICATE THIS JOB MOST RECENT
	HRRZ D,JPDLP	;PUSH THIS JOB'S IDX ON THE PDL OF SELECTED JOBS.
	CAIN D,JPDLE-1
	 SUBI D,JPDLL
	HRRM D,JPDLP
	IDPB U,JPDLP
	MOVE D,JPDLC	;SAY THERE'S ONE MORE JOB IN IT, UNLESS IT'S FULL
	CAIE D,JPDLL-1	;IN WHICH CASE ADDING ONE FLUSHES THE BOTTOM ONE.
	 AOS JPDLC
	ANDI U,-1
	MOVS D,UJNAME(U)
	CAIN D,'SYS	;IS THIS A PHONY INFERIOR "SYS" JOB?
	 SKIPL INTBIT(U)
	  CAIA
	   JRST OPUSRS	;IF SO, DON'T ACTUALLY TRY TO OPEN IT.
	MOVE A,[.BII,,USRI]
	move b,urandm(u)  ;check out this job's foreign status
	trne b,%urfrn	;Is this supposed to remain a foriegn job?
	  tlo a,10	;  set the bit to not reown
	.CALL OPNUSR		;OPEN JOB FOR INPUT.
	 JRST OPUSR5		;LOSE
	.USET USRI,[.RUIND,,D]
	camn d,ruind	;compare his user index with ours
	  setom ddtsw	;job's usr idx = ours => it is us (or pdp6; see OPUSRB)
	MOVE C,UIND(U)		;OLD VALUE OF UIND IS 0 IFF JOB IS NEW.
	MOVEM D,UIND(U)		;REMEMBER JOB'S IDX (NONZERO, EXCEPT FOR SYS SYS).
	MOVE D,UJNAME(U)
	CAME D,[SIXBIT/PDP6/]	;DON'T TRY .RUNAME OR .RJNAME ON PDP6; THEY LOSE.
	 CAMN D,[SIXBIT/PDP10/]
	  JRST [MOVSI C,400000	;MARK THE PDP6 AS A "PHONY INFERIOR".
		MOVEM C,INTBIT(U)
		MOVE A,[.BIO,,USRO]
		TSCLO OPNUSR
		JRST OPUSRB]
	.USET USRI,[.RUNAM,,B]
	.USET USRI,[.RJNAM,,D]	;HAVE JOB NAMES CHANGED (EG BECAUSE OF REOWNING)?
	CAMN B,UUNAME(U)
	 CAME D,UJNAME(U)
	  JRST OPUSRU		;YES, TRY AGAIN TO OPEN, WITH NEW NAMES.
opusrx:	move a,urandm(u)  ;check out if this is supposed to remain foriegn
	trne a,%urfrn	;Is it?
	  jrst opusr6	;  yes, pretend we couldn't open for output
	MOVE A,[.BIO,,USRO]
	.CALL OPNUSR		;OPEN JOB AGAIN, FOR OUTPUT.
	 JRST OPUSR6		;WIN ON INPUT & LOSS ON OUTPUT => FOREIGN USER
	.USET USRI,[.RINTB,,D]	;PICK UP INTERRUPT BIT, AND SAVE IN INTBIT
	EXCH D,INTBIT(U)	;GET OLD VALUE OF INTBIT
	JUMPG D,OPUSRB		;IF IT'S 0, JOB WAS A FOREIGN JOB (OR IS NEW)
	JUMPE C,OPUSRB		;IF IT'S NOT NEW, MUST HAVE JUST BEEN RE-OWNED.
	CALL OUSR4F		;SO PRINT "REOWNED" IF NEC., ETC.
OPUSRB:	SETZM DDTSW	;CAN OUTPUT TO IT, SO IT CAN'T BE SELF.
			;(STUPID ITS GIVES OUR IDX AS PDP6'S IDX,
			;THIS IS THE ONLY WAY TO INSURE DON'T THINK 6 IS SELF)
	SETOM UCHNLO	;INDICATE BOTH CHANNELS OPEN
OPUSRA:	MOVEM U,CU	;JOB ALL SET UP, DON'T CLOSE ON ERROR.
	JRST POPJ1

;HERE WHEN FAIL TO OPEN JOB FOR WRITING;  OPEN FOR READING ALREADY WON.
OPUSR6:	CTYPE "#
	MOVEI D,-1
	MOVEM D,UCHNLO
	SETZM INTBIT(U)
	JRST OPUSRA

;ATTACHING DISOWNED JOB WHICH GOT RENAMED IN PROCESS.
;NEW UNAME IN B, NEW JNAME IN D.
OPUSRU:	MOVEM B,UUNAME(U)
	MOVEM D,UJNAME(U)	;STORE NEW NAMES.
	MOVE D,B
	CALL NJTYP1		;TYPE NEW NAMES.
	JRST OPUSRX

;COME HERE WHEN OPUSR'S INPUT OPEN FAILS.
OPUSR5:	SAVE UUNAME(U)	;USER TRYING TO OPEN JOB THAT DOESN'T EXIST
	CALL MRDR2	;DELETE THE JOB SLOT.
	REST D		;IF WERE TRYING TO OPEN FOREIGN JOB,
	CAME D,RUNAME	;NO SURPRISE THAT JOB DOESN'T EXIST.
	 RET
	.STATUS USRI,D
	LDB D,[OPNLBP,,D]
	CAIE D,%ENACR
	CAIN D,%EFLDV
	 ERSTRT [SIXBIT /SYSTEM FULL?/]
	ERSTRT [SIXBIT /INFERIOR-CREATION FAILED?/]

OPUSRS:	SETOM SYSSW	;SET SYS JOB FLAG
	SETZM UINTWD(U)
	JRST OPUSRA

NOJOB:	SETO U,		;CAUSE THERE TO BE NO CURRENT JOB.
NOJOB1:	SETOM CU	;SIMILAR BUT REMEMBER WHICH JOB WAS OPEN.
NOJOB2:	.CLOSE USRI,	;MAKE THAT BE TRUE.
NOJOB3:	SETZM UCHNLO	;NO USER CHANNEL OPEN,
	.CLOSE USRO,
	SETZM DDTSW	;NOT LOOKING AT SELF OR SYS.
	SETZM SYSSW
	RET

OPNUSR:	SETZ
	SIXBIT /OPEN/
	A			;Mode,,Channel
	[SIXBIT /USR/]
	UUNAME(U)
	UJNAME(U)
	SETZ ['FOO]

;COME HERE FOR $J WITH NO ARG.
ALTJ9:	TLNE B,O.IFX
	  JRST JPOP	;$1J => POP THE JOB PDL

fnjob:	call fnjob6	;select a new job.
	skipe uint(u)	;if it's interrupting, let it return.
	 jrst ubrk0
	jrst nltl2

;MAKE A REASONABLY USEFUL CHOICE OF A JOB TO SELECT.
FNJOB6:	CALL DDTUNM
	SKIPE UINT(U)
	 JUMPGE U,FNJOB7 ;CURRENT JOB CAN INT. IF IT WANTS TO.
	SETZ U,
FNJOB1:	SKIPE UINT(U)	;ELSE GIVE ALL OTHER JOBS A CHANCE.
	 JRST FNJOB7
	ADDI U,USRLNG
	CAIGE U,USREND
	 JRST FNJOB1
	SOS D,NJ2	;NO JOB WANTS TO INT; FIND MOST RECENTLY PREVIOUSLY SELECTED.
	SKIPL U,CU	;IF HAD A CURRENT JOB REMEMBER WHEN IT WAS CURRENT.
	 MOVEM D,JTIME(U) ;AND MAKE THIS ONE LOOK LEAST RECENT INSTEAD OF MOST.
	SETZB A,B
FNJOB4:	CAML A,JTIME(B)	;LOOK FOR LESS RECENT.
	 JRST FNJOB5
	MOVE A,JTIME(B)
	MOVE U,B
FNJOB5:	ADDI B,USRLNG
	CAIGE B,USREND
	 JRST FNJOB4
	JUMPLE A,NOJOB	;NO JOB FOUND.

FNJOB7:	CALL NJTYP	;SAY WE'RE HACKING THAT JOB.
	CALL OUSR2A	;SKIP IF JOB STILL EXISTS.
	 JRST FNJOB3	;JOB HAS VANISHED, DELETE ITS SLOT.
	SETZM REOWNF
	SETZM SILNT
	CALL OPUSR	;TYPE NEW JNAME AND OPEN.
	 JRST FNJOB2	;CAN'T OPEN, OPUSR DELETED THE SLOT.
	RET

FNJOB3:	CALL MRDR2
FNJOB2:	7TYPE [ASCIZ/:KILL /]
	JRST FNJOB6

JPOP1:	MOVEI A,1	;HERE TO POP JOB SELECTION PDL ONCE.

;POP THE JOB SELECTION PDL TO FIND A JOB TO SELECT NEXT.
;A HAS NUMBER OF TIMES TO POP.  WE EXIT TO NLTL2.
JPOP:	CALL DDTUNM
	SKIPN JPDLC
	 TERR 'JOB	;NO JOB ON PDL?
	HRRZ D,JPDLP
	SUBI D,1	;DECREMENT THE PDL POINTER
	CAIGE D,JPDLB	;RING IT AROUND IF BELOW BEGINNING OF PDL NOW
	 ADDI D,JPDLL
	HRRM D,JPDLP
	SOS JPDLC	;ONE JOB HAS BEEN POPPED.
	SOJG A,JPOP	;FOR $<N>J, POP <N> TIMES.
	HRRZ U,(D)	;GET JOB NOW THE TOP OF THE PDL.
	JUMPL U,[ CALL NOJOB	;IF "NO JOB" IS ON THE TOP OF PDL,
		  JRST NLTL2]	;SELECT NO JOB.
	SKIPN UUNAME(U)
	 JRST NJGER1	;THAT SLOT IS EMPTY => BARF.
	SAVE JPDLP	;WHEN WE SELECT THE JOB, IT WILL BE RE-PUSHED,
	SAVE JPDLC	;SO PREPARE TO UN-RE-PUSH IT.
	SAVE U
	CALL FNJOB7	;TRY TO SELECT THAT JOB.
	REST A
	CAME A,U	;THAT WASN'T THE ONE WE GOT => THE ONE WE WANTED
	 JRST QJERR	;HAS BEEN KILLED; ERROR.
	REST JPDLC
	REST JPDLP
	JRST NLTL2

NACX:	JUMPN D,NACX1	;JUMP IF IT'S <JOB>$^X.
	skipn confrm	;do we want confirmation?
	  jrst kkill	;  no, so don't ask!
	PUSHJ P,RIN	;$^X. - KILL CURRENT JOB.
	 JRST ALTDQX
	CAIE D,".	;MUST BE FOLLOWED BY A PERIOD.
	 JRST NXERR
KKILL:	JUMPL U,JERR	;:KILL COMES HERE.
	SAVE A
	SAVE B
	SKIPE SAFE(U)	;QUERY THE USER IF THIS JOB IS PROTECTED.
	 CALL SAFET1
	PUSHJ P,MRDR
	REST B
	REST A
	JRST ALTJ9	;NOW DO $J OR $<N>J.


;;; JOBPIK takes a JNAME in D, and tries to find a job with that JNAME.
;;; it will reown if needed, etc.  It returns with 0 in D if it succeeded,
;;; -1 if the job had been there and vanished, and 1 if it doesn't exist
;;; at all

jobpik:	save c		;restore C
	call ddtunm	;make sure we know our uname.
	skipge u,cu	;start scanning job slots after current job, or from 0.
	 movei u,usrend-usrlng	;so if >1 job with this jname, find them 1 by 1
	move b,u	;remember where we start so know when to stop.
	rest c		;restore C
	jrst jobpk3	;don't advance over current job first time!
jobpk2:	  addi u,usrlng	;advance to next job
	cain u,usrend	;is the end of ring?
	  setz u,	;  yes, start at beginning
	cain b,(u)	;Is this back to starting point?
	  jrst jobpk4	;  Yep, try seeing if it is disowned etc.
jobpk3:	came d,ujname(u)  ;does this job have desired jname?
	  jrst jobpk2	;   no, so hack the next instead
	call njtyp	;inform user.
	call ousr2a	;if job doesn't exist, it was deleted by its owner.
	  jrst [ call mrdr2  ;  flush the info on this job
		 seto d,
		 ret]
	setz d,		;note that we won
	ret

jobpk4:	syscal open,[%clbit,,10 ? %climm,,usri ? [sixbit /USR/] ? %climm,,0
				d]
	  jrst [ movei d,1  ;  no such job, note the fact
		 ret]	;      and return
	setz c,		;our UNAME
	call ousrnl	;open the frob
	setz d,		;note that we were successful
	ret

NACX1:	JUMPE C,NAERR
	MOVE D,C
	save u		;gotta remember U for later
	setzm reownf	;don't offer to clobber if reowned, just DO it
	call jobpik	;select the job we are supposed to kill
	jumpl d,njger1	;did job just vanish?
	jumpn d,[7type [asciz /  [No Such Job]A/]
	        jrst nacx4]
	SKIPE SAFE(U)
	 7TYPE [ASCIZ / (protected job) /]
	7TYPE [ASCIZ /--Kill--/]
	CALL MORFL1
	 JRST NACX4	;USER SAYS NO => POP BACK TO OLD CURRENT JOB.
	syscal open,[%clbit,,.uii ? %climm,,usri
	             [sixbit /USR/]
		     uuname(u)
		     ujname(u)]
	  jrst [7type [asciz /Job gone!/]
	        jrst nacx4]
	CALL MRDR	;ELSE KILL THE SPECIFIED ONE
nacx4:	rest u
	call nojob1	;Say there's no current job.
	jrst fnjob	;and get us a new (or our old) current job)

;DELETE JOB SLOT <- U, .UCLOSING TH JOB. CLOBBERS A,D,W1,I1
MRDR:	MOVE D,UJNAME(U)	;GETTING RID OF PDP6?
	CAME D,[SIXBIT/PDP6/]
	  CAMN D,[SIXBIT/PDP10/]
	    SOSE SIXCTR
	      CAIA
	        .CLOSE PDP6C,	   ;CLOSE ALL CHANNELS IT'S ON.
	.STATUS USRI,D
	SKIPE D		;IF REALLY HAVE A JOB, DELETE IT.
	.UCLOS USRI,
MRDR2:	MOVS I1,UJNAME(U)
	CAIN I1,'SYS
	 SETZM SYSDPS
	MOVEI W1,UCHBUF(U)	;FREE THE JOB'S COMMAND BUFFER.
	PUSHJ P,ELEC0
	MOVEI W1,BININF(U)	;FREE THE JOB'S BIN FILE'S RANDOM INFO.
	PUSHJ P,ELEC0
	MOVEI W1,UNDEFL(U)	;FREE THE UNDEF SYM REF LIST.
	PUSHJ P,ELEC0
	MOVEI W1,RADAOB(U)	;FREE THE RAID REGISTERS.
	CALL ELEC0
	CALL ELECTRON		;FREE THE SYMBOL TABLE.
	SKIPE HAKING	;IF .BREAK 16,20000, DON'T CHANGE
	 JRST MRDR3
	CALL NOJOB3	;INFO ON CURRENT JOB, ELSE SAY NONE.
	SETOM CU
MRDR3:	SETZM UUNAME(U)
	MOVSI D,UUNAME(U)
	HRRI D,UUNAME+1(U)
	BLT D,JOBSYM-1(U)
	RET

;IF THERE ARE ANY PROTECTED JOBS, QUERY THE USER AND ERR OUT IF HE FLUSHES.
SAFETY:	MOVSI A,-NINFP
SAFET0:	SKIPE SAFE(A)
	 JRST SAFET1
	ADDI A,USRLNG-1
	AOBJN A,SAFET0
	RET

SAFET1:	7TYPE [ASCIZ /--Kill Protected Job--/]
	CALL MORFL1
	 JRST ERR
	RET

MASSAC:	SAVE [NLTL2]	;:MASSACRE COMMAND - KILL ALL JOBS.
MASAC1:	CALL SAFETY
	SETZ U,
MASAC2:	SKIPN D,UJNAME(U)
	 JRST MASACX
	move a,urandm(u)  ;check the do-not-reown bit
	trne a,%urfrn	;Is this to remain a foreign job?
	  jrst [ call mrdr2  ;  yes, so flush our knowledge of it w/o killing
		 jrst masacx]  ;and hack the next job
	MOVE A,[.BII,,USRI]
	CAME D,[SIXBIT /SYS/]
	 .CALL OPNUSR
	  JFCL
	call mrdr
MASACX:	ADDI U,USRLNG
	CAIGE U,USREND
	  JRST MASAC2
	JRST NOJOB

MASAC4:	CALL NOJOB
	JRST NLTL2

KFORGET:	;:FORGET
	SKIPGE UCHNLO	;IF THIS IS A REAL INFERIOR,
	 SKIPG INTBIT(U)
	  JRST KDISO2
	CALL KDISO1	;PREPARE THE JOB (REMOVE BPTS, UPDATE PC).
	JRST KDISO2	;THEN JUST FLUSH ITS SLOT.  IT REMAINS AN INFERIOR, UNKNOWN.

KDISOW:	CALL KDISO1	;$$^K OR :DISOWN.  PREPARE THE JOB (REMOVE BPTS, UPDATE PC).
	SYSCLO DISOWN,[%CLIMM,,USRI ? %CLBIT,,(A)]
KDISO2:	PUSHJ P,MRDR2
	JRST FNJOB

KDISO1:	PUSHJ P,QIJERR		;PREPARE THE CURRENT JOB FOR BEING ABANDONED BY DDT.
	.USET USRI,[.SUSTP,,[-1]]
	.USET USRI,[.ROPTIO,,D]
	tlz d,%opddt\%opcmd\%opbrk  ;tell job it no longer has a DDT over it
	.USET USRI,[.SOPTIO,,D]
	SAVE A		;PRESERVE INFIX ARGUMENT, FOR CTL BITS OF THE DISOWN.
	CALL REMOVB
	CALL TSTOPX
	MOVE D,PPC(U)	;MAKE SURE JOB'S .UPC VARIABLE IS UP TO DATE,
	SKIPE UINTWD(U)	;BUT DON'T CLOBBER A RUNNING JOB.
	 .USET USRO,[.SUPC,,D]
	JRST POPAJ

NCTLC:	7NRTYP [ASCIZ /
/]		;^C

N2ACR:	SKIPN SYSSW	;$$^R
	  jrst n2acr0	;  Not the system?
	SETOM SYSDPS
	jrst n2acr9

n2acr0:	skipn dpstok	;Feature enabled?
	  jrst n2acr9	;  nope
	skipe intbit(U)	;Is it foreign?
	  jrst n2acr9	;  no, either SYS (special) or our own (OK anyway!)
	movei d,%URDPS
	iorm d,urandm(u)  ;turn on winnage
n2acr9:	7NRTYP [ASCIZ/ OP? /]

NJTYP:	move d,urandm(u)  ;check if this is a foreign-only job
	trne d,%urfrn	;foreign?
	  jrst njtyp0	;  yes, do the :UJOB whether same UNAME  or not
	MOVE D,UUNAME(U)
	CAME D,RUNAME
	 JRST NJTYP1
	PUSHJ P,TSPC
	MOVE D,UJNAME(U)	;TYPE JNAME OF CUR JOB AND "$J"
NJTYP2:	PUSHJ P,SIXTYP
	CTYPE 33
	MOVEI D,"J
	JRST TOUT

njtyp0:	7type [asciz / :FJOB /]
	jrst njtyp4
njtyp1:	move d,urandm(u)  ;check if this is a foreign-only job
	trne d,%urfrn	;is the magic bit on?
	  jrst njtyp0	;  Yes, you got this job by :FJOB FOO instead of :UJOB
	7type [asciz / :UJOB /]
njtyp4:	move d,uuname(u)
	CALL SIXTYP
	CALL TSPC
	MOVE D,UJNAME(U)
	CALL SIXTYP
	JRST TSPC

SIXTYP:	MOVE C,D	;PRINT C(D) AS SIXBIT STOPPING WHEN ZERO
SIXTP2:	MOVEI D,0
	ROTC C,6
	ADDI D,40
	CALL TOUT	;MUSN'T USE CTYPE SINCE CALLED FROM UERLOS.
	JUMPN C,SIXTP2
	POPJ P,

; :SELF is like HACTRNJ, but always gets the DDT being executed in no matter
; what the JNAME

KSELF:	move d,(w4)
	.suset [.rjname,,c]
	jrst naltj		   ;<jname>J

constants

;:SNARF <JOB> - ASSUMES THAT THE CURRENT JOB HAS AN
;INFERIOR NAMED <JOB>, DISOWNS IT FROM THE INFERIOR AND THEN
;OWNS IT DIRECTLY. CLOBBERS LOCATIONS 26-36 OF THE INFERIOR.
KSNARF:	JUMPL U,JERR	;NO JOB OPEN.
	CALL QIJERR	;NOT INFERIOR => ERROR.
	CALL RTOKEN	;READ <JOB NAME> AS SIXBIT IN B.
	JUMPE B,.-1
	SYSCAL OPEN,[[10+.BII,,FDRC] ? ['USR,,] ? RUNAME ? B]
	 JRST NSJERR	;COMPLAIN IF WE CAN'T FIND SUCH A JOB,
	.USET FDRC,[.RSUPPRO,,D]
	CAME D,UIND(U)	;OR IT'S NOT AN INFERIOR OF THE SELECTED JOB.
	 JRST NSJERR
	.CLOSE FDRC,
	SAVE B
	CALL NCTLX	;MAKE SURE FATAL INTS GET HANDLED.
	MOVE D,(P)	;DEPOSIT <JOB> IN 36
	MOVEI A,36
	CALL RDEP
	 TERR
	.ACCES USRO,[26]
	MOVE A,[-7,,KSNAR1]
	.IOT USRO,A	;PUT IN THE INFERIOR CODE TO DISOWN.
	HRROI A,RUNAME	;PUT UNAME IN 35
	.IOT USRO,A
	.USET USRI,[.RPICLR,,A]
	SAVE A		;REMEMBER AND SET .PICLR
	.USET USRI,[.SPICLR,,[0]] ;SO DISOWNING WON'T STOP.
	.USET USRI,[.RPIRQC,,A]
	SAVE A		;ALSO REMEMBER AND CLEAR FATAL INTERRUPTS.
	.USET USRI,[.SAPIRQC,,A]
	MOVEI A,26
	EXCH A,PPC(U)	;START HIM AT 26, RESETTING HIS PC
	MOVEM A,XECPC(U);WHEN HE RETURNS WITH $X RETURN.
	SETOM XINTWD(U)
	push p,urandm(u)	   ;remember the way it was
	movei a,%urctx		   ;note that we're expecing an interrupt
	iorm a,urandm(u)
	call procdx		   ;run him without TTY
	pop p,urandm(u)
	REST A
	.USET USRI,[.SIPIRQC,,A]
	REST A
	.USET USRI,[.SPICLR,,A]
	MOVE D,UIACK(U)
	TRNE D,200000	;DID HE RETURN SUCCESS?
	 JRST [REST D ? JRST NALTJ1]	;YES, GO $J <JOB>.
	ERSTRT [SIXBIT/COULDN'T OPEN JOB?/]

KSNAR1:	JFCL		;(26)
	.OPEN 0,34	;(27) OPEN <JOB>.
	 .BREAK 16,400000 ;(30) FAIL, CAUSE ERR MSG.
	.DISOWN 0,	;(31) DISOWN <JOB>.
	 JFCL		;(32)
	.BREAK 16,600000 ;(33) RETURN SUCCESS.
	1,,'USR		;(34) FILENAME BLOCK. MAKE SURE OPEN WILL FAIL IF NOT INFERIOR.
			;(35) WILL GET UNAME
			;(36) WILL GET JNAME.

;$$V ROUTINE.
KLSTJ:	call terpri
	SETZ U,
KLSTJ2:	SKIPE UUNAME(U)
	SKIPN D,UJNAME(U)
	JRST KLSTJ1
	MOVEI D," 
	CAMN U,CU
	MOVEI D,"*
	PUSHJ P,TOUT
	PUSHJ P,TSPC
	CALL KLSTJ4
	PUSHJ P,CRF
KLSTJ1:	ADDI U,USRLNG
	CAIGE U,USREND
	 JRST KLSTJ2
	MOVE U,CU
	JRST NLTL4

KLSTJ4:	SKIPE INTBIT(U)
	 JRST KLSTJ3
	MOVE D,UUNAME(U)
	PUSHJ P,SIXTYP
	PUSHJ P,TSPC
KLSTJ3:	MOVE D,UJNAME(U)
	PUSHJ P,SIXTYP
	PUSHJ P,TSPC
	MOVE D,UINTWD(U)
	CAIN D,21
	  JRST KLSTJM
	JUMPL D,KLSTJP
	JUMPE D,KLSTJR
	CAIL D,9
	 JRST KLSTJP	;AFTER .BREAK 16, AND TEMP BPTS, TYPE P.
	PUSHJ P,TOC
	MOVEI D,"B
KLSTJT:	PUSHJ P,TOUT
	PUSHJ P,TSPC
	HRRZ A,UIND(U)
	JRST G8PNT

KLSTJM:	MOVEI D,"-
	JRST KLSTJT

KLSTJR:	MOVEI D,"W
	SKIPN UINT(U)
	MOVEI D,"R
	JRST KLSTJT

KLSTJP:	MOVEI D,"P
	JRST KLSTJT

KLFILE:	PUSHJ P,QJERR	;:LFILE -- MUST HAVE JOB.
	PUSHJ P,TSPC	;TYPE SPACE, THEN NAME OF LOADED FILE.
	SKIPN D,UFNAMD(U)
	7NRTYP [ASCIZ /No File Loaded
/]
	MOVEI A,UFNAMD(U)
	call lfile	;print the filenames
	jrst nltl2	;prompt and return

;print name of file in block <- A
lfile:  move b,3(a)	;get the SNAME in B for historical reasons

;PRINT NAME OF FILE IN BLOCK <- A, SNAME IN B.
LFILE0:	SKIPN D,(A)
	 JRST LFILE1
	CAMN D,['NET,,]
	 JRST LFILN	;IF DEVICE IS NET:, THE FILENAMES ARE SOCKET
			;NUMBERS.
	came d,[sixbit /CHAOS/]	;For both CHAOS:
	 camn d,[sixbit /TCP/]	;and TCP:
	 jrst lflhst		;we perform hair.
	PUSHJ P,SIXTYQ
	CTYPE ":
	CTYPE " 
LFILE1:	SKIPN D,B
	 JRST LFILE2
	PUSHJ P,SIXTYQ
	CTYPE ";
	CTYPE " 
LFILE2:	SKIPN D,1(A)
	POPJ P,
	PUSHJ P,SIXTYQ
	CTYPE 40
	MOVE D,2(A)
SIXTYQ:	MOVE C,D	;PRINT C(D) AS SIXBIT STOPPING WHEN ZERO
SIXTP1:	MOVEI D,0
	ROTC C,6
	ADDI D,40
	CAIE D,":
	 CAIN D,";
	  CTYPE ^Q
	CAIE D,40
	 CAIN D,",
	  CTYPE ^Q
	CALL TOUT	;MUSN'T USE CTYPE SINCE CALLED FROM UERLOS.
	JUMPN C,SIXTP1
	RET


;;;For CHAOS: and TCP: names: SNAME is HOST number, FN1 is local
;;;port/index, FN2 is foreign port/index.
LFLHST:	pushj p,sixtyq
	save w1
	save a
	7type [asciz /: Host /]
	move a,3(a)
	call g8pnt
	7type [asciz /, Local /]
	move a,(p)
	move a,1(a)
	call g8pnt
	7type [asciz /, Foreign /]
	rest a
	move a,2(a)
	call g8pnt
	7type [asciz /
  /]
	jrst popw1j

LFILN:	SAVE W1		;HERE FOR :LFILE IF DEVICE IS NET:.
	SAVE A
	SAVE B
	7TYPE [ASCIZ /NET: loc soc = /]
	MOVE A,1(A)	;"FN1" IS LOAL SOCKET.
	CALL G8PNT
	7TYPE [ASCIZ /, host = /]
	REST A		;"SNAME" LOW 8 BITS IS HOST NUMBER.
	ANDI A,377
	CALL G8PNT
	7TYPE [ASCIZ /, frn soc = /]
	REST A
	MOVE A,2(A)	;"FN2" IS FOREIGN SOCKET.
	CALL G8PNT
	7TYPE [ASCIZ /
  /]
	JRST POPW1J

;ON THIS PAGE ARE HANDLED THE SPECIAL QUIRKY FEATURES OF ^H AND ^K:
;$^K LOADINNG SYMBOLS INTO EXISTING JOB, AND ^H PROCEDING AN EXISTING JOB.

CTLK:	MOVNI W1,3	;^K - (MAYBE QUERY AND) CLOBBER EXISTING JOB.
	MOVEM W1,REOWNF
	CAIA
			;^H - PROCEED AN EXISTING JOB
CTLH:	 SETZM REOWNF
	SETOM TOKTRM	;DON'T READ LINE LATER FOR JCL.
	MOVEM C,SYSN2
	TLZ F,FLC+FLLET
	TLNE B,O.1ALT	;$^H AND $^K LOAD SYMBOLS.
	 TLO F,FLC
	PUSHJ P,NCOMI	;INIIALIZE DEVICE AND SNAME TO DEFAULTS (DSK:<MSNAME>;)
	SKIPN REOWNF
	 JRST CTLH2	;JUMP IF ^H.
	SKIPE SYSN2
	 JRST ACTRLK	;SKIP IF ^K WITH NON-NULL PREFIX ARGUMENT.
	TLNN B,O.1ALT	;^K AND $^K WITH NO ARGUMENT COME HERE.
	 JRST NXERR	 ;^K WITH NO ARG IS MEANINGLESS.
	PUSHJ P,QJERR	;$^K - SAME AS :SL<CR>.
	MOVEI D,^M	;MAKE LAST CHAR BE ^M TO END
	DPB D,GSCHRP	;THE FILESPEC CSMI WILL READ.
	call terpri
	SETZM GSONUM	;PREVENT ANY INFIX ARG (AS IN $1^K) FROM SCREWING :SL.
	SETZM GSDNUM
	JRST CSMI	;NOW GO DO ":SL^M"

;COME HERE FOR ^H, WITH OR WITHOUT ARGUMENT.  EITHER SELECT AND CONTINUE
;AN EXISTING JOB, OR EXIT TO CREATE AND LOAD A NEW ONE.

CTLH2:	IRP X,,[40,"^,"H]
	   MOVEI D,X
	   CALL LPTR
	TERMIN			;ECHO SPACE AND ^H TO WALLPAPER FILE.
	MOVE D,TTYOPT
	TLNE D,%TOMVB		;AND SAME FOR THE TTY, BUT SOME TTY'S ECHO ^H
	  jrst [tlnn d,%tosa1	;AS UPARROW-H; THEY DON'T NEED ANYTHING DONE.
	          7type [asciz /F^H/]	;So echo according to whether
		tlne d,%tosa1	;it has SAIL graphics or not
		  7type [asciz /FH/]	 ;to get the right kind of uparrow
		jrst .+1]
	SKIPN D,SYSN2		;PUT JNAME IN D FOR OUSRNL.
	 JRST [	CALL FNJOB6	;^H WITH NO ARG SELECTS ANOTHER JOB,
		JUMPL U,JERR	;NO JOB?
		JRST CTLH0]
	SYSCAL OPEN,[[10,,FDRC] ? ['USR,,] ? RUNAME ? SYSN2]  ;DOES JOB EXIST?
	  jrst actrlk	 ;NO; ACT LIKE ^K;  CREATE AND LOAD IT.
	.CLOSE FDRC,	;YES; JUST $P OR $G IT.
	CALL DDTUNM	;MAKE SURE WE KNOW OUR UNAME.
	MOVE C,RUNAME	;INSIST ON OUR OWN UNAME;  IF NOT FOUND, CREATE A JOB.
	setzm reownf	;don't offer to clobber if reowned, just DO it
	call jobpik	;first select that job
	jumpl d,njger1	;If job used to exist but vanished, barf
	jumpn d,actrlk	;Not found somehow, create and load it.
	call opusr
	  jrst njgerr		;Shouldn't happen, but...
CTLH0:	CALL QIJERR
	SKIPN D,UINT(U)
	 MOVE D,UINTWD(U)	;IF JOB IS STOPPED AT A BREAKPOINT,
	CAIL D,1
	 CAILE D,8
	  CAIA
	   AOSA PPC(U)		;JUST PRINT STATUS.  AOS PC NOW SINCE UBRK0A WILL SOS IT.
	    SKIPGE UPI0(U)	;IF AFTER A .VALUE, PRINT STATUS, AND DO SOS PC.
	     JRST UBRK0A	;DON'T $P; JUST PRINT STATUS.
	push p,u		;remember which job it is
	SKIPE UINT(U)		;JOB INTERRUPTING => LET IT RETURN SO WE CAN $P IT.
	 CALL UBRK0
	pop p,d			;remember which job it was
	caie d,(u)		;Is this the same job as before?
	  jrst njger1		;  No, tell him it's gone and abort.
	MOVE D,UINTWD(U)
	CAIE D,21		;IF JOB ALREADY HAD BEEN RUN,
	 JRST [	7TYPE [ASCIZ /P/]	;JUST PROCEED IT.
		JRST NALTP]
	7TYPE [ASCIZ /G/]
	JRST CTLH8	;ELSE JUST START IT.

;HERE WE HANDLE FOO^H, FOO^K, :FOO ...<CR>, :NEW FOO ...<CR>, :RETRY FOO ... <CR>.
;REOWNF IS 0 FOR ^H, -3 FOR ^K, -1 FOR :RETRY, AND >0 FOR :NEW.
;FOR :FOO, REOWNF IS >0 IF GENJFL IS SET, OR -2 IF GENJFL IS 0.
;SYSN2 HOLDS THE NAME OF THE PROGRAM ("FOO").
;FLC => LOAD SYMBOLS.  FLLET => USER HAS SPECIFIED DEVICE OR SNAME EXPLICITLY.
ACTRLK:	MOVS D,SYSN2
	CAIE D,(SIXBIT/>/)
	 CAIN D,(SIXBIT/</)
	  ERSTRT [SIXBIT /RUN PROGRAM < OR >?/]
	TLNE F,FLLET	;UNLESS DEV OR SNAME SPEC'D
	 JRST CTLH1
	CAME D,[(SIXBIT/PDP6/)]
	 CAMN D,['TRNHAC] ;CHECK FOR SPECIAL JNAMES FOR WHICH ^K AND $J ARE THE SAME.
	  JRST CTLH3
	CAMN D,[(SIXBIT/PDP10/)]
	 JRST CTLH3
	CAIE D,'SYS
	 JRST CTLH1	;GO GET JOB&FILE
CTLH3:	SETZB C,REOWNF
	CAIE D,'SYS	;FOR SYS, MUST USE UNAME=0 TO GET PHONY INFERIOR.
	 MOVE C,RUNAME	;FOR OTHERS, THING TO DO IS INSIST ON OUR UNAME.
	MOVE D,SYSN2
	PUSHJ P,OUSRNL
	JRST NLTL2

;try to find the program to be loaded.
fndcmd:	move b,hsname	;Try loading from our HSNAME first
	tlnn f,fllet	;but if dev or SNAME spec'd, try no other
	  movem b,sfiles
	.call ctlho
	  caia			   ;  failed, try next
	    ret			   ;    won!
	tlnn f,fllet		   ;if dev or sname spec'd, try no other.
	  pushj p,floerr	   ;  or if bad error,
	    opner ctlho
	movei b,'SYS		   ;Next try the SYS; directory
	hrlzm b,sfiles
	.call ctlho		   ;msname failed - try SYS
	  caia
	    ret
	call floerr
	  opner ctlho
	movei b,(sixbit /1/)
	hrrm b,sfiles		   ;turn it into SYS1
	.call ctlho
	  caia
	    ret
	call floerr
	  opner ctlho
	movei b,(sixbit /2/)	   ;Try SYS2 next
	hrrm b,sfiles		   ;turn it into SYS2
	.call ctlho
	  caia
	    ret
	call floerr
	  opner ctlho
	movei b,(sixbit /3/)	   ;Try SYS3 next
	hrrm b,sfiles		   ;turn it into SYS3
	.call ctlho
	  caia
	    ret
	call floerr
	  opner ctlho
	movei b,sfile		   ;B gets filename block for FLOCK to use
	.suset [.ssname,,msnam]	   ;Look on our MSNAME first
	call flock		   ;and look all over creation for that file
	  jrst ctlher
	movs b,snlist		   ;if not found it on SYS,
	movsm b,sfiles		   ;set default sname to one found on.
	ret

ctlher:	movei d,'SYS	;print SYS: in error msgs, not DSK.
	hrlzm d,sfile
	aose insist	;If we are insisting on getting a file
	  opner ctlho	;  Give an error since we didn't find one
	ctype 7		;otherwise beep
	ret		;and return with insist being zero



ctlh1:	skipl ckqflg	;If it's -1 or 0, barf if the file isn't found
	  jrst ctlh7
	skipn toktrm	;if ^K, or ^H, or CR already seen, don't read a line.
	  call rlinec
	hrrzm p,insist	;barf immediately if file not found
	call fndcmd	;find the file with the commands
	jrst ctlh6	;

ctlh7:	hrrzm p,insist	;barf when we can't find the file
	skipe ckqflg	;but if CKQFLG > 0, don't barf until we've read JCL
	  setom insist	;  INSIST = -1 means don't barf, just zero INSIST
	call fndcmd	;Find the file with the commands
	skipn toktrm	;Unless this is ^H or ^K, or CR already seen
	  call rlinec	;  read JCL after :filename .
	skipn insist	;if INSIST is zero
	  opner ctlho	;  Then an FNDCMD lost, barf now
ctlh6:	call ctlh4	;load the file and gobble the JCL
	  call jcl	;  Read JCL normally

ctlh8:	setz b,		;make sure $G routine thinks it has no args.
	jrst naltg	;start the job.
	
;; CALL CTLH4
;;   <JCL reading routine>
;; runs a job with JNAME from SYSN2.
;; clobbers AC's with reckless abandon

ctlh4:	hlre d,logdin
	aosn d
	  7type [asciz /(Please Log In)
/]

	call ddtunm
	move d,sysn2
	SKIPLE REOWNF	;FOR ":FOO", COMPUTE AN UNUSED JNAME.
	 CALL GENJOB
	MOVE C,RUNAME
	CALL OUSRNL	;SELECT/CREATE THE JOB, AND QUERY FOR --CLOBBER...--?
	CALL QIJERR	;COMPLAIN IF NOT OUR INFERIOR.
	MOVE D,SYSN2
	.USET USRI,[.SXJNAM,,D]
	CAMN D,UJNAME(U) ;IF JNAME NOT SAME AS PROGRAM NAME,
	 JRST CTLH5
	CALL NJTYP	;SAY WHAT THE JNAME IS.
	CALL CRF
CTLH5:	MOVEI B,UFILE(U)	;COPY NAME OF FILE READ INTO $L DEFAULT.
	HRLI B,SFILE
	BLT B,UFILES(U)
	SETZM UFLSYS(U)
	TLNN F,FLLET		   ;BUT IF DEFAULTED TO SYS: OR SYS1;,
	 SETOM UFLSYS(U)	   ;CHANGE IT TO DSK: BEFORE $Y.
	SKIPL UCHNLO		   ;ERROR IF JOB OPEN IS NOT OUR INFERIOR.
	 JRST JERR
	xct @(p)		   ;call our JCL getting function
	MOVEI D,BPBEG+1(U)
	HRLI D,-1(D)		   ;CLEAR OUT ALL BREAKPOINTS, AND THE MAR.
	SETZM BPBEG(U)
	BLT D,BPEND-1(U)
	SETOM PERMIT(U)	;ALLOW .VALUE'S AND SYSTEM CALLS IN GENERAL.
	SETOM SYSUUO(U)
	SYSCALL USRVAR,[MOVEI USRO ? [SIXBIT /MARA/] ? MOVEI 0]
	 JFCL			; So maybe this is a KS10...
	CALL ALOAD
	.USET USRO,[.SXUNAM,,TUNAME]
	.USET USRO,[.SHSNAM,,THSNAM]
	MOVE D,XUNAME		   ;reset the temporary XUNAME
	MOVEM D,TUNAME
	move d,hsname		   ;reset the HSNAME too.
	movem d,thsnam
	.suset [.ssnam,,lsnam]
	setzm srflag
	jrst popj1		   ;return, skiping our argument

ctlho:	calblk OPEN,[ %clbit,,.bii ? %climm,,utic ? sfile ? sfile+1 ? sfile+2
		      sfile+3]

;ASSUMING D HAS DESIRED OR PRESENT JNAME OF JOB,
;"AOS" IT UNTIL IT IS NOT THE NAME OF ANY EXISTING JOB.
GENJOB:	SETZ C,		;HAVEN'T FOUND CHAR TO AOS YET.
	.IOPUS USRI,
	CALL GENJO3
	.IOPOP USRI,
	RET

GENJO3:	SYSCAL OPEN,[[10,,USRI] ? ['USR,,] ? RUNAME ? D]
	 RET		;THIS NAME IS GOOD.
	JUMPN C,[AOJA A,GENJO2] ;ALREADY KNOW WHERE TO AOS => DO SO.
	MOVE C,[440600,,D]
GENJO1:	ILDB A,C	;LOOK FOR FIRST BLANK
	TLNE C,770000	;OR LAST CHAR OF WORD.
	 JUMPN A,GENJO1
	MOVEI A,'0	;FIRST, TRY SETTING TO 0.
GENJO2:	DPB A,C
	JRST GENJO3

;RENAME THE CURRENT JOB AS A GENSYM.
KGENJOB:MOVE D,UJNAME(U)
	CALL GENJOB
	MOVE C,D
	JRST N2AJ

NCTLU:	TRZA B,-1	;^U, $^U, $$^U .
NCTLT:	HRRI B,1	;^T, $^T, $$^T .
	SAVE B
	MOVEM C,NCTLTA	;SAVE ARG (AIO)
	CALL WARN
	 XCT (B)[7TYPE [ASCIZ / (Remove Translation)/]
		 7TYPE [ASCIZ / (Make Translation)/]]
	CALL GSOT
	MOVEI C,NCTLTF
	MOVSI D,'*_14	;SET FILENAMES TO *.
	MOVEM D,NCTLTF+1
	MOVEM D,NCTLTF+2
	MOVEM D,NCTLTF+3
	MOVEM D,NCTLTF
	PUSHJ P,RRFL1	;READ 1ST NAME.
	MOVE D,[NCTLTF,,NCTLTF+5]
	BLT D,NCTLTF+8	;COPY TO BLOCK FOR .CALL .
	MOVE B,(P)
	TRNN B,1	;^U => ONLY ONE NAME TO READ.
	 JRST NCTLU1
	PUSHJ P,LINK2
	 7TYPE [ASCIZ/Into: /]	;PROMPT FOR ANOTHER LINE IF NEC.
	MOVEI C,NCTLTF
	PUSHJ P,RRFL1
NCTLU1:	MOVEI A,USRI	;START CONSTRUCTING 1ST ARG.
	REST B
	TLNE B,O.1ALT
	MOVEI A,-1	;$^T => ON SELF.
	TLNE B,O.1ALT+O.2ALT
	TLO A,200000	;1 OR 2 ALTS => INFERS ALSO.
	MOVE C,[440600,,NCTLTA]
NCTLU2:	ILDB D,C	;LOOK FOR A, I, O IN ARG.
	JUMPE D,NCTLU3
	SETZ W1,
IRPS X,,A J I O,Y,,400000 200000 1 2
	CAIN D,'X
	MOVEI W1,Y
TERMIN		;CHECK FOR MEANINGFUL CHARS.
	JUMPE W1,NAERR
	TLO A,(W1)
	JRST NCTLU2

NCTLU3:	TLCE A,3	;IF NEITHER I NOR O SPECIFIED, ASSUME BOTH.
	 TLC A,3
	MOVE C,[SIXBIT/TRANDLTRANAD/](B)
	.CALL NCTLUB
	JRST ERR
	JRST NLTL4

NCTLUB:	SETZ?SIXBIT/CALL/
	C	;EITHER TRANDL OR TRANAD
	A	;SAYS WHICH TRANSL LIST TO USE
	[-4,,NCTLTF+5]	;1ST (OR ONLY) NAMES
SETZ	[-4,,NCTLTF]	;2ND SET ( USED ONLY BY TRANAD)

;:LISTF <DIRECTORY-SPEC> <CR>
LISTF:	MOVEI C,PFILE
	PUSHJ P,RRFL4	;READ IN DEV & SNAME ONLY.
	JRST NCTLF1

NCTLF:	SKIPN C		;0^F MEANS SWITCH TO MSNAME.
	 MOVE C,MSNAM
	JUMPE D,NCTLF5	;NO ARG => USE DEFAULT DIRECTORY.
	SETOM SRFLAG
	.SUSET [.SSNAM,,C]
	.OPEN FDRC,[SIXBIT/   DSK.FILE.(DIR)/]
	 JRST NCTLF2
NCTLF3:	SETZM SRFLAG
	MOVEM C,FFILES
	MOVEM C,LSNAM
	MOVE A,C
	CALL RRFL3	;PUT THIS SNAME ON THE SNAME SEARCH LIST.
	MOVSI D,'DSK
CTLF0:	MOVEM D,FFILE	;PRINT DIR OF DEV IN RH(D), SNAME IN LSNAM.
	;;I'm not sure why the following check is here.  I found a similar
	;;check in the code following NCTLF2 that was using a different
	;;table of devices.  I changed it to use the same table
	;;that this one does.  As far as I can tell, however, the following
	;;check never does anything useful, and it is the other check that
	;;is the effective one.  -Alan 2/7/84
	movsi c,-nodfln
nctlf8:	camn d,nodflt(c);Is this something that doesn't set the :PRINT defaults
	  jrst nctlf1	;  Yes, don't set them
	aobjn c,nctlf8	;No, check next one

	TLNN B,O.1ALT	;$^F DOESN'T SET DEFAULTS EITHER.
	 CALL NCTLF4	;OTHERWISE SET :PRINT DEFAULTS.
NCTLF1:	MOVEI C,FFILE	;C MUST BE SET UP FOR OPNER (IN TSCALL)
	TSOPEN FDRC,FFILE
	JRST OPRINT

nodflt:	irp x,,[TTY,T,MCTTY,AITTY,MLTTY,MXTTY,MDTTY,KSTTY,KLTTY,D,DIR,MCDIR,AIDIR,MLDIR,MXDIR,MDDIR,KSDIR,KLDIR,DVR,DVS,GLP,LP7,LP8,LP9,LR7,7LP,7LR,TPL,CHAOS,CHA,COR,CLO,CLU,CLI,CLA]
	sixbit /x/
termin
	block 5			   ;For patching
nodfln==.-nodflt

NCTLF2:	MOVE D,C
	.STATUS FDRC,A	;COME HERE WHEN ^F'S DIRECTORY OPEN FAILS.
	LDB A,[OPNLBP,,A]
	CAIE A,%ENSDR	;IF NON-EX-SNAME, TRY USING ARG AS DEVICE.
	 JRST NCTLF3	 ;LOSES FOR OTHER REASON => ARG IS AN SNAME, DESPITE LOSS.
	SYSCAL OPEN,[[2,,FDRC] ? D ? ['.FILE.] ? [SIXBIT/(DIR)/] ? FFILES ? %CLERR,,A]
	 CAIE A,%ENSDV
	  CAIA
	   JRST NCTLF3	;DEVICE GETS NON-EX-DEVICE ERROR => TREAT ARG AS SNAME.
			;TRY THE SNAME AGAIN, SO IT WILL GO IN FFILES & IN ERR MESSAGE.
	MOVE C,FFILES	;DEVICE EXISTS, SO MAKE IT THE DEFAULT,
	MOVEM C,LSNAM	;AND MAKE THE SNAME WE USED THE DEFAULT.
	MOVEM D,FFILE
	.SUSET [.SSNAM,,LSNAM]
	SETZM SRFLAG
	SKIPE A		;IF WE FAILED IN OPENING THE DEVICE (EVEN THOUGH IT EXISTS)
	 OPNER FFILE	 ;GIVE USER THE APPROPRIATE ERROR MESSAGE.
	CALL FDRCO1	;SET UP FOR ILDB'ING FROM THE CHANNEL ALREADY OPEN
	movsi c,-nodfln		;See comment at CTLF0+1
nctlf9:	camn d,nodflt(c)	;Certain devices don't set the ^R defaults.
	 jrst oprint
	aobjn c,nctlf9
	TLNN B,O.1ALT	;$^F DOESN'T SET DEFAULTS EITHER.
	 CALL NCTLF4	;OTHERWISE SET :PRINT DEFAULTS.
	JRST OPRINT	;THEN PRINT THE DIRECTORY.

NCTLF5:	MOVE C,FFILES
	MOVEM C,LSNAM
	.SUSET [.SSNAM,,LSNAM]
	JRST NCTLF1

;;;<arg>$$<Narg> is a hairy directory lister.

n2acf:	setzi i1,		;Narg defaults to zero.
	tlne b,o.ifx
	 move i1,gsdnum
	cail i1,dirfnn		;If Narg is too big, use zero.
	 setzi i1,
	skipe a,ndrop(i1)	;Super hairy case?
	 jrst ndrhak
	lsh i1,1		;Compute index into table.
	skipe dirdir		;Wierd kludge:  If flag set,
	 jumpn d,[		; and arg explicitly given,
		tlne b,o.ifx	; and Narg explicitly not given,
		 jrst .+1	; then arg is new SNAME.
		skipn c		;0 => HSNAME
		 move c,hsname
		movem c,pfiles
		jrst n2acf1]	;Proceed as if no arg given.
	jumpn d,[		;Was arg given?
		skipn dirfn2(i1)	;If PFILE1 would have been used,
		 movem c,pfile1		; remember arg there for next time.
		jrst n2acf2]
n2acf1:	skipn c,dirfn2(i1)	;Use DIRFN2 as arg,
	 move c,pfile1		; or PFILE1 if that contained zero.
n2acf2:	hlr d,pfile
	hrli d,'DIR
	sysclo open,[[.bai,,fdrc] ? d ? dirfn1(i1) ? c ? pfiles]
	jrst kprin1

;;;Super hairy directory lister:
;;;Narg is used as an index into 5 tables:  NDRDEV, NDRDIR, NDRFN1, NDRFN2,
;;;and NDROP.  Each word in NDROP is divided into four 9-bit opcodes.  Each
;;;opcode controls the interpretation of one of the corresponding words
;;;found in the other tables as follows:
;;;
;;;	4.9 - 4.1 controls NDRDEV	(device)
;;;	3.9 - 3.1 controls NDRDIR	(directory)
;;;	2.9 - 2.1 controls NDRFN1	(first file name)
;;;	1.9 - 1.1 controls NDRFN2	(second file name)
;;;
;;;The nine bits in each opcode are interpreted the same for each table.
;;;After performing the operations specified by the opcodes, the resulting
;;;four words are used as a filename to be opened, and printed on the
;;;user's terminal.
;;;
;;;If all four opcodes are zero, then we perform the old behavior of $$^F
;;;and never even come here at all.
;;;
;;;The 9-bit opcode is interpreted as follows:
;;;
;;;	%2FIND	"Indirect bit".  Right half of word is to be taken as the
;;;		address of the word to return.  Otherwise the word itself is
;;;		returned.
;;;	%2FWBK	If %2FIND is set, this bit gives permission to write back into
;;;		the word addressed by the right half, so that if no
;;;		argument is given next time, the same thing will happen.
;;;	%2FARG	Any argument given applies to this operand.
;;;	%2F0L	If %2FIND is set, and an argument of 0 was given, then the
;;;		sixbit word addressed by the \left/ half of the word is to
;;;		be used.  This happens even if %2FARG is not set.
;;;		(MSNAM,,PFILES is useful here.)
;;;	%2F0LI	Similar to %2F0L, except the left half is directly taken to
;;;		be three sixbit characters.  (<'DSK>,,PFILE is useful here.)
;;;	%2FDIR	"DIR" is to be prefixed to the final result.  If %2FWBK is
;;;		also set, the prefixing is done BEFORE writing the result back.
;;;	%2FR2F	After everything, initialize ^F default for this component
;;;		from the corresponding ^R default.  Only works for device
;;;		and directory components.

%2FIND==:1_0
%2FWBK==:1_1
%2FARG==:1_2
%2F0L==:1_3
%2F0LI==:1_4
%2FDIR==:1_5
%2FR2F==:1_6

ndrhak:	move b,ndrfn2(i1)
	pushj p,ndrop1
	lsh a,-9
	move b,ndrfn1(i1)
	pushj p,ndrop1
	lsh a,-9
	move b,ndrdir(i1)
	pushj p,ndrop1
	move b,pfiles
	trne a,%2FR2F
	 movem b,ffiles
	lsh a,-9
	move b,ndrdev(i1)
	pushj p,ndrop1
	move b,pfile
	trne a,%2FR2F
	 movem b,ffile
	pop p,a			;Can't keep 'em on the PDL cause of
	pop p,d			; error UUO.
	pop p,b
	pop p,c
	sysclo open,[[.bai,,fdrc] ? a ? b ? c ? d]
	jrst kprin1
	
ndrop1:	trnn a,%2FIND		;%2FIND => indirect
	 jrst ndrop8
	skipe d			;If argument was not given,
	 trnn a,%2FARG		; or it doesn't apply,
	  skipa i2,(b)		; pick up word.
	   move i2,c		;Else argument.
	trne a,%2F0L+%2F0LI	;If %2F0L or %2F0L set,
	 jumpn d,[		; and arg given,
		jumpn c,.+1	; and it is 0.
		hlrz i2,b	;left half into I2
		trnn a,%2F0LI	;%2F0LI => immediate 3 chars.
		 skipa i2,(i2)	;%2F0L => address of 6 chars.
		  hrlz i2,i2
		jrst .+1]
	trne a,%2FWBK		;If %2FWBK set,
	 movem i2,(b)		; store it back.
	trnn a,%2FDIR		;%2FDIR => DIR prefix hack
	 jrst ndrop9
	hlr i2,i2
	hrli i2,'DIR
	jrst ndrop9

ndrop8:	skipe d			;If argument not given,
	 trnn a,%2FARG		; or it doesn't apply,
	  skipa i2,b		; use word.
	   move i2,c		;Else use argument.
ndrop9:	exch i2,(p)
	jrst (i2)


NCTLR:	CALL WARN
	 7TYPE [ASCIZ / (Print File)/]
	CALL GSOT
KPRINT:	CALL FDROPN
KPRIN1:	CALL FDRCO1	;FILL UP THE FDRC BUFFER.
OPRINT:	PUSHJ P,CTLF4
	JRST NLTL2

CTLF4:	PUSHJ P,FORMF
CTLF1:	setzm fdrcls	;we want to close FDRC after this
ctlf1a:	PUSHJ P,MORINI
	 jrst ctlf2a	;on flushing xct this.
CTLF3:	CALL FDRCI
	 JRST CTLF2
CTLF7:	CAIN D,^L
	 JRST CTLF6
	CAIN D,^M
	 JRST CTLF5
	CALL TOUT
	JRST CTLF3

CTLF6:	CALL FDRCI	;^L: IS THERE ANYTHING AFTER?
	 JRST CTLF2
	CTYPE ^L	;YES, OUTPUT ^L
	JRST CTLF7	;AND THE CHAR THAT FOLLOWED IT, ALREADY READ.

CTLF5:	CALL FDRCI
	 JRST CTLF2
	CAIN D,^J		;IF THE CR IS NOT STRAY, PRINT THE CRLF.
	 JRST [	CALL CRF
		JRST CTLF3]
	7TYPE [ASCIZ /H/]	;IF THE CR IS STRAY, ACHIEVE EFFECT USING A ^P CODE,
	SAVE D
	MOVEI D,^M		;BUT TO WALL PAPER FILE GIVE A REAL LIVE STRAY CR.
	CALL LPTR
	REST D			;THEN GO HANDLE WHAT FOLLOWED THE CR.
	JRST CTLF7

ctlf2a:	setzm fdrcls	;Note that we flushed the output
CTLF2:	CALL MORFL2	;UNDO CALL TO MORINI.
	skipn fdrcls	;if we want FDRC closed,
	  .CLOSE FDRC,	;  close it
	JRST GSNLRT

;:LINKN <FROM>,<TO> - IS WILLING TO DELETE AN OLD FILE NAMED <FROM>.
KLINKN:	call linkwn
linkn0:	MOVEI C,PFILE
	CALL RRFL1	;READ IN <FROM> WITHOUT ERRING IF IT IS OPENABLE.
	JRST LINK1

linkwn:	MOVE D,DELWARN
	CAILE D,2		   ;is DELWARN 3 or more?  Must be a loser!
	  7NRTYP [ASCIZ /
That is the wrong command for talking to another user/]
	ret

;:LINK <FROM>,<TO>
LINK:
	MOVE D,DELWARN
	CAILE D,2	;is DELWARN 3 or more?  Must be a loser!
	  7TYPE [ASCIZ /(Create link-file (NOT talk to people)) /]
linkf:	MOVEI C,PFILE
	CALL LINK5	;READ FROM-NAME, MAKE SURE NO FILE NOW HAS THAT NAME.
LINK1:	JSP A,LINKPF	;PUSH THE CURRENT PFILE.
	MOVE A,[PFILE,,NCTLTF]
	BLT A,NCTLTF+2
	PUSHJ P,LINK2	;WARN IF MUST READ ANOTHER LINE.
	 7TYPE [ASCIZ/To: /]
	PUSHJ P,RRFL1	;READ TO- FILE.
LINK4:	SYSCLO TRANS,[PFILE ? PFILE+1 ? PFILE+2 ? PFILE+3
		%CLOUT,,B ? %CLOUT,,NCTLTF+3 ? %CLOUT,,NCTLTF+4 ? %CLOUT,,NCTLTF+5]
	SETZ A,
	CAMN B,ITSNAM	;DEVICE AI: OK ONLY ON AI  MACHINE, ETC.
	 MOVE A,NCTLTF+5
	CAMN B,[SIXBIT/SYS/]
	MOVE A,B	;PHONY DISK DEVS TURN INTO SNAMES.
	CAMN B,['COM,,]
	 MOVE A,['COMMON]
	CAMN B,['TPL,,]
	 MOVE A,['.LPTR.]
	CAMN B,['DSK,,]
	 MOVE A,NCTLTF+5
	JSP D,LINKPP		;POP THE PUSHED FILENAMES BACK INTO PFILE.
	JUMPE A,[MOVS A,NCTLTF	;LINK FROM TPL TO NON-DSK?
		 CAIN A,'TPL
		  JRST LINK7	;COPY INSTEAD.
		 CAMN B,NCTLTF
		  JRST LINK3
		 JSP W2,LINK6	;LINK FROM ANYTHING ELSE TO NON-DISK => ERROR.
		 ASCIZ/ - LINK TO NON-DISK/]
	MOVEM A,NCTLTF+5
LINK3:	SYSCLO MLINK,[NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? LSNAM
			NCTLTF+3 ? NCTLTF+4 ? NCTLTF+5 ? %CLERR,,D]
	.CLOSE FDRC,
	JRST NLTL4

;HERE IF CAN'T MAKE LINK FROM TPL:;  COPY FILE TO TPL INSTEAD.
;B STILL HAS DEV NAME RETURNED BY "TRANS" SYSTEM CALL AT LINK4.
LINK7:	SYSCLO OPEN,[[.BAI,,FDRC] ? B ? NCTLTF+3 ? NCTLTF+4 ? NCTLTF+5]
	.OPEN UTOC,[.BAO,,'TPL]
	 OPNER @.-1
	JRST KCOPY0

LINKPF:	REPEAT 4,SAVE PFILE+.RPCNT	;PUSH THE FILENAMES IN PFILE. CALL WITH JSP A,.
	JRST (A)

LINKPP:	REST C			;POP BACK INTO PFILE.  CALL WITH JSP D,.
	MOVEM C,LSNAM		;NOW THAT WE HAVE READ IN THE LINK TARGET NAME,
	MOVEM C,FFILES
	MOVEM C,PFILE+3		;RESTORE THE SAVED FILENAMES AS THE CURRENT DEFAULTS.
	.SUSET [.SSNAM,,LSNAM]
	REST PFILE+2
	REST PFILE+1
	REST PFILE
	MOVE C,PFILE
	MOVEM C,FFILE
	JRST (D)

;	CALL LINK2
;	 7TYPE [ASCIZ/PROMPT/]
;IF AT END OF A TYPED-IN LINE, EXECUTE THE PROMPT INSTRUCTION,
;AND INITIALIZE FOR READIN OF A ANOTHER LINE.
;C SHOULD CONTAIN PFILE; ALL OTHER ACS ARE CLOBBERED.
LINK2:	SETOM GSONUM	;SAY DON'T RE-READ PREVIOUS CHAR. IN RRFL1.
	SKIPL TOKTRM	;IF USED UP LINE,
	JRST CPOPJ1
	SETZM TOKTRM	;FORCE TO READ ANOTHER.
	POP P,LINKRT'	;CAN'T POP AFTER GSOA.
	PUSHJ P,GSOA
	 JRST NRBERR
	TLNN F,FLCTLL
	 TLNN F,FLRUB
	  XCT @LINKRT	;DO CALLER'S ACTION THE FIRST TIME, AND FOR ^L, NOT FOR RUBOUT.
	MOVE A,LINKRT
	MOVEI C,PFILE
	JRST 1(A)	;RET. TO CALLER.

;READ FILE SPEC, ERROR IF FILE EXISTS.
;C SHOULD POINT TO FILENAME BLOCK.
LINK5:	PUSHJ P,RRFL1	;READ IN "FROM" FILE.
	MOVSI A,'>_14
	CAME A,1(C)	;IF EITHER FILENAME IS >,
	CAMN A,2(C)	;THE FILE "DOESN'T EXIST"
	 RET		;(EG WRITING THAT NAME WON'T CLOBBER ANYTHING)
	.CALL FDRCO
	 RET		;CAN'T OPEN, SO OK.
	.CLOSE FDRC,
	JSP W2,LINK6
	ASCIZ/ - File Exists/

;INTERNALLY GENERATED FILE ERROR MESSAGE: WITH FILENAMES IN PFILE, DO
;	JSP W2,LINK6
;	ASCIZ /MESSAGE/
LINK6:	MOVE B,PFILE+3	;GET SNAME,
	MOVEI A,PFILE	;ADDR OF BLOCK,
	PUSHJ P,LFILE0	;PRINT FILE'S NAME.
	7TYPE (W2)	;PRINT THE ERROR MESSAGE.
	JRST UOPNR4

;CALL WARN ? 7TYPE WARNING   PRINTS THE WARNING AND CAUSES AN ALTMODE TO BE READ
;AS THE NEXT CHARACTER, IF DELWARN > 1.
WARN:	MOVE D,DELWARN
	SOJLE D,POPJ1
WARN1:	MOVEI D,33
	MOVEM D,LIMBO
	SETOM UNRCHF
	SETOM UNECHF
	RET

;READ IN FILE NAMES AND OPEN ON FDRC.
FDROPN:	MOVEI C,PFILE
	CALL RRFL1
	TSCLO FDRCO
	RET

fdrco:	calblk OPEN,[ %clbit,,.bai ? %climm,,fdrc ? (c) ? 1(c) ? 2(c)]
fdrcou:	calblk OPEN,[ %clbit,,.bai\10 ? %climm,,fdrc ? (c) ? 1(c) ? 2(c)]
fdrcol:	calblk OPEN,[ %clbit,,.bai\20 ? %climm,,fdrc ? (c) ? 1(c) ? 2(c)]


opfls:	7nrtyp [asciz / OP? /]
NCTLO:	jumpg d,opfls
	SKIPN D,DELWARN
	 JRST NCTLO1	;THIS IS $^O, OR DELWARN=0, => NO WARNING.
	cail d,3	;dangerously ignorant person?
	  jrst opfls	;  Don't let him do this
	TLNE B,O.2ALT
	 JRST NCTLO3	;$$^O (RENAME) => CHECK FOR DELWARN=2.
	CALL WARN1
	7TYPE [ASCIZ/ (Delete File)/]
	setom ctlsfl	;make ^S flush this
NCTLO1:	PUSHJ P,GSOT	;TYPE " ", INIT RUBOUT PROC.
	SKIPA B,(W4)
KRENAM:	TLO B,O.2ALT	;SET 2-ALTMODE FLAG.
KDELET:	MOVEI C,PFILE
	PUSHJ P,RRFL1	;READ 1ST FILE NAME.
	setzm ctlsfl	;make ^S normal again
	MOVE A,[PFILE,,NCTLTF]
	BLT A,NCTLTF+4	;COPY FN1, FN2 INTO BLOCK.
	TLNN B,O.2ALT	;IF RENAME,
	 JRST KDELE1
	PUSHJ P,LINK2	;READ NAME TO RENAME AS.
	 7TYPE [ASCIZ/To: /]	;PROMPT IF NO COMMA.
	CALL LINK5	;READ FILESPEC, ERROR IF FILE EXISTS.
	MOVE A,NCTLTF
	MOVE B,NCTLTF+3
	CAMN A,PFILE	;DEVICE AND SNAME MUST BE THE SAME IN OLD FILENAMES AND NEW FILENAMS.
	 CAME B,PFILE+3
	  JRST [ JSP W2,LINK6
		 ASCIZ / -- CAN'T RENAME TO A DIFFERENT DIRECTORY/]
	SYSCLO RENAME,[
		NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? NCTLTF+3
		PFILE+1 ? PFILE+2]
	JRST NLTL4

KDELE1:	SYSCLO DELETE,[NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? NCTLTF+3]
	JRST NLTL4

NCTLO3:	CALL WARN	;FOR $$^O, PRINT WARNING ONLY IF DELWARN > 1.
	7TYPE [ASCIZ / (Rename File)/]
	JRST NCTLO1

;:TPL, :TPLN -- MAKE LINK FROM TPL TO SPEC'D FILE.
KTPLN:	TDZA B,B	;:TPLN - OK IF FILE DOESN'T EXIST.
KTPL:	SETO B,		;:TPL - FILE MUST BE OPENABLE NOW.
	MOVEI C,PFILE	;USE :PRINT DEFAULTS.
	PUSHJ P,RRFL1	;READ FILE NAMES.
	JUMPE B,KTPL1
	TSCLO FDRCO	;:TPL, TRY TO OPEN FILE.
KTPL1:	; This opens with gensymmed filenames if the machine has a -real-
	; TPL device.  We supply the input filenames in case it doesn't:
	sysclo open,[[.bao,,fdrc] ? [sixbit /TPL/] ? move 1(c) ? move 2(c)]
	MOVE A,[FDRC,,NCTLTF]
	.RCHST A,		;FIND OUT WHAT THE GENSYM WAS.
	HRRZ A,NCTLTF
	CAIE A,'DSK		;IF TPL: ISN'T REALLY ON DSK:,
	 JRST [	.IOPUS FDRC,	;CAN'T LINK FROM IT, SO COPY TO IT INSTEAD.
		.IOPOP UTOC,
		MOVEI C,PFILE
		TSCLO FDRCO
		JRST KCOPY0]
	MOVSI A,'TPL	;MAKE LINK FROM TPL WITH THAT NAME.
	MOVEM A,NCTLTF
	.CLOSE FDRC,
	JSP A,LINKPF	;PUSH PFILE NAMES ON STACK.
	JRST LINK4

XFILE:	MOVEI C,XFILEF
	PUSHJ P,RRFL1
	SYSCLO OPEN,[%CLIMM,,FDRC	;IF CAN'T OPEN, FAIL NOW
		XFILEF ? XFILEF+1 ? XFILEF+2]
XFILE1:	PUSHJ P,INPUSH
	AOSN INIOPS	;IF SOURCE PUSHED WAS ALSO CMD FILE...
	.IOPUSH COMC,
	.IOPUSH FDRC,
	.IOPOP COMC,
	SETOM INPTR	;INDICATE READING CMD FILE.
	JRST GSNLRT

; :WALLP - TURNS ON "LINE PRINTER" OUTPUT TO SPECIFIED FILE

KWALBE:			;ALSO :WALBEG.
KWALLP:	MOVE A,LOGDIN	;GET REAL USER NAME,
	AOJE A,LOGQ	;IF NOT LOGGED IN THEN COMPLAIN
	MOVEI C,WFILE	;GET PNTR TO FILE NAMES
	PUSHJ P,RRFL1	;READ IN FILE DESCRIPTION
	SETZM LPTOPN	;(IN CASE THE OPEN FAILS)
	SYSCLO OPEN,[[1,,LPTC] ? WFILE ? WFILE+1 ? WFILE+2]
	SETOM LPTOPN	;SUCCESS, LPT IS OPEN.
	SETZM LPTFLG	;TURN ON LPT OUTPUT.
	JRST NLTL4

;:WALEND - CLOSE WALLPAPER FILE.
KWALEN:	.CLOSE LPTC,
	SETZM LPTOPN
	JRST NLTL4

;:EXISTS <FILE>     ZERO IFF FILE CAN BE OPENED.
KEXIST:	MOVEI C,PFILE
	CALL RRFL1	;READ FILE NAMES.
	move b,pfile	;get the device
	movei d,fdrco	;Normally don't use 10 control bit
	came b,[sixbit /USR/]
	  camn b,[sixbit /MLUSR/]
	    movei d,fdrcou  ;  but for USR: devices, must have it set
	came b,[sixbit /MCUSR/]
	  camn b,[sixbit /AIUSR/]
	    movei d,fdrcou
	came b,[sixbit /MXUSR/]
	  camn b,[sixbit /MDUSR/]
	    movei d,fdrcou
	came b,[sixbit /KSUSR/]
	  camn b,[sixbit /KLUSR/]
	    movei d,fdrcou
	setz a,		;assume can be opened
	.call (d)	;call usring the right call block
	  call [.status fdrc,a	;failed, return status word.
		skipn a
		  seto a,	;but make sure don't return 0.
		ret]
	.close fdrc,
	jrst gsoctj	;return number.

KCOPYN:	CALL FDROPN	;:COPYN <FILE1>,<FILE2>. READ AND OPEN FILE 1.
	CALL KCOPYR	;READ IN NEW FILE NAMES AND OPEN FILE.
kcopy0:	call copfil	;copy from FDRC to UTOC
SFDAT1:	.CLOSE FDRC,
	JRST NLTL4

;;; copy from FDRC to UTOC
copfil:	call vpaget		   ;obtain a buffer
copfl1:	move a,[-2000,,vpagad]
	.IOT FDRC,A	;READ IN UP TO 1 K.
	HRLOI B,-1-VPAGAD(A)
	EQVI B,VPAGAD	;AOBJN -> WHAT WAS READ.
	.IOT UTOC,B
	JUMPGE A,copfl1	;FILLED UP THE BUFFER => TRY AGAIN.
	CALL VPAGRT	;EOF, RETURN BUFFER.
	SYSCAL RENMWO,[%CLIMM,,UTOC
		NCTLTF+1 ? NCTLTF+2]
	 JFCL
	.CLOSE UTOC,
	ret

;COPY, PRESERVING DATES AND USING REAL NAMES OF FROM-FILE AS DEFAULTS.
NACR:	CALL WARN
	 7TYPE [ASCIZ / (Copy File)/]
	CALL GSOT
KCOPYD:	CALL FDROPN	;READ FILENAME INTO PFILE, AND OPEN THE FILE.
	SKIPE TOKTRM	;IF USER MUST BE PROMPTED (BY LINK2),
	 CALL WARN1	;UNREAD AN ALTMODE TO SHOW USER THE NEW DEFAULTS.
	CALL KCOPYS	;READ IN TO-FILE NAMES AND OPEN ON UTOC.
	SYSCAL RFDATE,[%CLIMM,,FDRC ? %CLOUT,,A]
	 JRST KCOPY0
	SYSCAL SFDATE,[%CLIMM,,UTOC ? A]
	 JRST KCOPY0
	syscal RAUTH,[%climm,,fdrc ? %clout,,a]
	  jrst kcopy0
	syscal SAUTH,[%climm,,utoc ? a]
	  jrst kcopy0
	JRST KCOPY0

;READ IN FILE NAME AND OPEN FILE. USE AS DEFAULTS REAL NAME OF FILE OPEN ON FDRC.
KCOPYS:	JSP A,LINKPF
	SYSCLE RFNAME,[%CLIMM,,FDRC  REPEAT 4,[ ? %CLOUT,,PFILE+.RPCNT ] ]
	CAIA
;SIMILAR;  USE AS DEFAULTS THE NAMES IN PFILE, BUT DON'T CHANGE PFILE.
KCOPYR:	 JSP A,LINKPF	;PUSH PFILE.
	CALL LINK2	;PROMPT IF NECESSARY FOR NAME OF TO- FILE.
	   7TYPE [ASCIZ /To: /]
	CALL RRFL1	;READ <FILE2> INTO PFILE
	MOVE A,[PFILE,,NCTLTF]
	BLT A,NCTLTF+3	;AND MOVE IT TO NCTLTF
	JSP D,LINKPP	;POP <FILE1> INTO PFILE.
	move a,nctltf
	movsi d,-lrlnmdv
kcpyr9:	camn a,rlnmdv(d)
	 jrst kcpyr8
	aobjn d,kcpyr9
	SYSCLO OPEN,[[.BAO,,UTOC]
		 NCTLTF ? [SIXBIT /_COPY_/] ? ['OUTPUT] ? NCTLTF+3]
	RET

kcpyr8:	sysclo open,[[.bao,,utoc]
		 nctltf ? nctltf+1 ? nctltf+2 ? nctltf+3]
	ret

;;; Table of devices that really need to know output filenames at opening time.
rlnmdv:	irp x,,[LP7,LP8,LP9,LR7,7LP,7LR,TPL,CLO,CLU,CLI,CLA,JOB,OJB,USR]
	sixbit /x/
termin
	block 5			; For patching
lrlnmdv==:.-rlnmdv

kmove:	call fdropn	;read filename into PFILE, and open the file.
	skipe toktrm	;if user must be prompted (by LINK2),
	 call warn1	;unread an altmode to show user the new defaults.
	call kcopys	;read in to-file names and open on UTOC.
	syscal rfdate,[%climm,,fdrc ? %clout,,a]
	  jrst kmove0
	syscal SFDATE,[%climm,,utoc ? A]
	  jrst kmove0
	syscal RAUTH,[%climm,,fdrc ? %clout,,a]
	  jrst kmove0
	syscal SAUTH,[%climm,,utoc ? a]
	  jfcl
kmove0:	call copfil		   ;copy the file over
	syscal delewo,[%climm,,fdrc]  ;delete the from file
	  jfcl
	.close fdrc,		   ;close it up too.
	jrst nltl4		   ;and back to the command loop

;; Read a date word in D  Clobbers with unknown abondon  (I.e. I haven't
;; checked, and you should before depending on anything)

rdatew:	CALL LINK2	;PROMPT FOR DATE IF NONE.
	 7TYPE [ASCIZ/Date: /]
	CALL RLINE
	JSP W2,RCH	;SKIP LEADING BLANKS.
	CAIN D,40
	 JRST .-2
	CAIN D,"-	;"-" AS DATE MEANS SAY "DATE UNKNOWN"
	 JRST [	SETO D,	;WHICH IS A DATE FIELD OF -1.
		ret]
	TLO F,FLUNRD	;1ST NONBLANK NOT "-" => REREAD IT LOOKING FOR DIGIT.
	MOVE W1,[JSP W2,RCH]
	PUSHJ P,RDATE	;READ IN DATE,
	MOVE D,C
	ret

;SET FILE'S DATE.
SFDATE:	CALL FDROPN	;READ FILENAMES AND OPEN FILE.
	call rdatew
SFDAT2:	JSP W1,KSREA1	;EXECUTE THE FOLLOWING SYSTEM CALL, AND GIVE ERR MSG IF FAILS.
	SYSCAL SFDATE,[%CLIMM,,FDRC ? D]

SFDATB:	SETZ ? SIXBIT /SFDATE/
	%CLIMM,,FDRC ? SETZ C

;READ A DATE USING READ-CHAR INSTRICTION IN W1. DATE RETURNED IN C.
;CHAR THAT TERMINATED THE DATE IS LEFT IN D.
RDATE:	SETZ D,
	SAVE D
	CALL MSGNUM	;CREATION MONTH.
	CAIN D,^M
	 SKIPE C	;IF MONTH IS 0 AND WAS TERMINATED BY CR, ASSUME DATE NULL
	  CAIA		;AND USE TODAY'S DATE.
	   JRST [SYSCLE RQDATE,[%CLOUT,,C]
		 JRST POP1J]
	DPB C,[270400,,(P)]
	CALL MSGNUM	;CREATION DAY.
	DPB C,[220500,,(P)]
	CAIE D,^M	;IF USER ISN'T SPEC'ING THE YEAR,
	 JRST RDATE1
	SYSCLE RQDATE,[%CLOUT,,C]
	LDB C,[330700,,C]	;USE TODAY'S YEAR.
	JRST RDATE2

RDATE1:	CALL MSGNUM	;CREATION YEAR.
RDATE2:	DPB C,[330700,,(P)]
	CALL MSGNUM	;HOUR.
	IMULI C,3600.
	ADDM C,(P)
	CALL MSGNUM	;MINUTE.
	IMULI C,60.
	ADDM C,(P)
	CALL MSGNUM	;SECOND
	ADD C,(P)
	ADDI C,(C)	;DOUBLE THE R.H.
POP1J:	SUB P,[1,,1]
	RET

;READ IN A DECIMAL NUMBER, STOPPING AT A NON-DIGIT.
;USE THE INSTRUCTION IN W1 TO READ 1 CHARACTER.
MSGNUM:	SETZ C,
	CAIN D,^M	;DON'T GO ON PAST CR.
	 RET
MSGNU1:	XCT W1
	CAIL D,"0
	 CAILE D,"9		;TERMINATE ON NON-DIGIT.
	  RET
	IMULI C,10.
	ADDI C,-"0(D)
	JRST MSGNU1

;; Set MSGS date ... I.e. cutoff date for reading messages
ksmdate:
	call rdatew		   ;read in a date word
	camn d,[-1]		   ;Unknown?
	  setz d,		   ;  yes, use 0
	save d
	call msgget		   ;get the database entry
	rest msgs"me$mdt(a)	   ;set the entry now
	jrst nltl4		   ;and return

;; Print the MSGS date
kpmdate:
	call msgget		   ;get the database entry
	move a,msgs"me$mdt(a)	   ;get the time
	jumpe a,kmpdt1		   ;  Null, tell him so
	move d,[440700,,fdrctb]	   ;use the FDRC buffer, should be free now
	call datime"twdasc	   ;send the info into the buffer
	7type fdrctb		   ;and type the stuff
	jrst nltl2		   ;and return

kmpdt1:	7type [asciz /AAll messages will be printed./]
	jrst nltl2

KREAP:	CALL FDROPN	;READ IN FILE NAME
	JSP W1,KSREA1	;GO EXECUTE THE SRDATE AND GIVE ERR MSG IF FAILS.
	SYSCAL SRDATE,[%CLIMM,,FDRC ? [1041,,]] ;set to 1/01/01.

KSFREA:	JSP W1,KSFRE1
	SYSCAL SREAPB,[%CLIMM,,FDRC ? A]

KSFDUM:	JSP W1,KSFRE1
	SYSCAL SDMPBT,[%CLIMM,,FDRC ? A]

;DRIVER FOR :SFREAP AND :SFDUMP. W1 -> A SYSTEM CALL WHICH TAKES BIT VALUE IN A.
KSFRE1:	SAVE W1		;SAVE ADDRESS OF SYSTEM CALL.
	CALL FDROPN	;READ FILE NAMES AND OPEN FILE
	CALL LINK2
	 7TYPE [ASCIZ /(1 or 0): /]
	CALL RLINE
	JSP W2,RCH	;READ IN THE DESIRED BIT SETTING
	MOVEI A,-"0(D)
	REST W1
	JRST KSREA1	;GO DO THE WORK.

KSFAUT:	MOVEI C,PFILE
	CALL RRFL1
	TSCLO FDRCOL
	CALL LINK2
	 7TYPE [ASCIZ /Author: /]
	CALL RLINE
	CALL RTOKEN
	JSP W1,KSREA1
	SYSCAL SAUTH,[%CLIMM,,FDRC ? B]

KSREA1:	MOVEI C,PFILE
	XCT (W1)
	 OPNER FDRCO
	JRST SFDAT1

KFLAP:	CALL RDEV	;READ DEVICE (AS "UTN" OR "N")
	SUBI D,'UT0	;CONVERT DEV NAME TO UT #.
	.UDISMT D,
	ERSTRT [SIXBIT/UNFLAPPABLE?/]
	JRST NLTL2

KASSIG:	CALL RDEV	;ASSIGN DECTAPE
	SUBI D,'UT0
	.ASSIGN D,
	 JRST ERR
	JRST NLTL2

KDESIG:	CALL RDEV	;DEASSIGN DECTAPE
	SUBI D,'UT0
	.DESIGN D,
	 JRST ERR
	JRST NLTL2

KUINIT:	CALL RDEV	;CLEAR DECTAPE DIRECTORY.
	SUBI D,'UT0
	.UINIT D,
	 JRST ERR
	JRST NLTL2

RDEV:	SKIPE TOKTRM	;COMMAND ENDED WITH CR => USE DEFAULT DEV.
	 JRST [HLRZ D,FFILE ? POPJ P,]
	CALL GTFROB	;READ A FROB (DEV NAME)
	SETZM UNRCHF	;FLUSH THE CHARACTER THAT TERMINATED IT.
	MOVE D,B
	MOVE C,A
	CALL NBITE
	CALL NGDEV	;CONVERT NUMERIC ARG TO DEV NAME.
	MOVEM D,FFILE
	CALL NCTLF4
	HLRZS D
	RET

NCTLF4:	MOVEM D,PFILE	;IF ARG, SET ^O, $L DIRS.
	MOVE C,LSNAM
	MOVEM C,PFILE+3
	MOVEM C,IFILE+3
	MOVEM D,IFILE
	RET

;INTERRUPT VECTOR.
TSINT:	SETZ P				;INT STACK ADDR.
	%PIILO ? 0 ? 0 ? 0 ? ILOPR
	%PIMPV ? 0 ? 0 ? 0 ? MPVBRK
	%PIWRO ? 0 ? 0 ? 0 ? PURBR1
	%PIATY ? 0 ? %PIATY ? 0 ? TTYINT
	%PIIOC\%PIOOB ? 0 ? #%PIATY#%pimpv#%piwro#%piilo ? -1 ? TSIN0
	#%PICLI#%PIJST ? #<1_TYOC>
	    #%PIIOC#%PIILO#%PIMPV#%PIWRO#%PIOOB#%PIATY ? -1 ? TSIN0
	0 ? 1_TYOC ? 0 ? 0 ? MORINT
	%picli ? 1_dirhc ? #%piaty#%pimpv#%piwro#%piilo#%piioc ? -1 ? tsin0
	%PIJST ? 0 ? 0 ? 0 ? JSTINT
TSINTL==.-TSINT
	       block 5		   ;for patching

;W1 HAS POINTER TO RETURN ADDR. ON STACK.
MORINT:	SKIPN MOREXP	;--MSGS-- AND OTHER SUCH THINGS SHOULDN'T CAUSE A --MORE--.
	 SKIPE HAKING	;NEVER DO **MORE** WHILE WITHIN HAKKAH.
	  JRST UDISMX
	SAVE UUOH
	SAVE 40
	SAVE A
	SAVE D
	SAVE W1
	SYSCAL WHYINT,[%CLIMM,,TYOC ? %CLOUT,,A ? %CLOUT,,D]
	 JRST PURXT1
	CAIE A,%WYTYO
	 JRST PURXT1
	JUMPGE D,PURXT1
	SKIPGE TYOUNI
	 ERLOSS
	SETOM RADCLR	;RAID REGS ABOUT TO BE OVERWRITTEN.
	SAVE TYOUNI	;WE'RE IN THE MIDDLE OF OUTPUTTING TYOBUF,
	SETOM TYOUNI	;SO OUTPUT WE DO SHOULDN'T GO THROUGH TYOBUF.
	SAVE [MORXIT]
	MOVEI W1,-10.(P)
	7TYPE [ASCIZ/--More--/]

MORIN2:	skipn morwarn	;If user needs protection, tell him what to do now
	  jrst morin0	;  No protection needed
	movei d,[ASCIZ / (Space=yes, CR=no)/]
	skipl mornro	;Are we in :MSGS ?
	  movei d,[asciz / (Space=yes, Rubout=no)/]
	7type (d)	;aid him with the appropriate message.

MORIN0:	SYSCAL FINISH,[ %CLIMM,,TYOC]
	 JFCL
	SETOM MORFLG
	SAVE LIMBO
	CALL IN		;READ CHAR FROM TTY.
	REST LIMBO
	aos mornro
	  cain d,^S	;if was ^S, unsilence since ^S won't be read.
	 jrst [	setzm silnt
		skiple mornro	;unless after a --MSGS--,
		 jrst morinf	;^S flushes.
		jrst morin0]	;after a --MSGS--, ^S is ignored.
	AOS MORNHU
	CAIN D,40
	 JRST MORIGO
	CAIN D,177	;RUBOUT MAY OR MAY NOT FLUSH.
	 jrst [skipe mornro	;if flag wasn't set, flush.
		JRST MORINF
		JRST MORIGO]
	cain d,^M	;is it a RETURN
	  skipg mornro	;  that is a response to a --MSGS--
	    movem d,ttyunr  ;no, re-read the thing later
morinf:	skipe tyouni
	 call orest1	;flush output buffer up to current typeout, no .RESET
	SKIPE MORPRP	;IF RETURN-ON-FLUSH SET UP,
	 JRST [7TYPE MORFMS	;MESSAGE IS ALWAYS "FLUSHED",
		MOVEI A,TYOFLS
		MOVEM A,(W1)
		RET]
	SKIPG D,MORMSG	;IF NO SPECIAL MESSAGE WAS SPEC'D,
	 MOVEI D,MORFMS	;USE "FLUSHED".
	7TYPE (D)
	SETOM MORMSG	;TELL MAIN PRGM USER FLUSHED.
	RET

MORFMS:	ASCIZ/Flushed/

MORIGO:	SKIPE GETTY
	  SKIPE SCROLL	;NEVER HOME UP IN SCROLL MODE.
	    SETZM MORNHU
	setzm mormsg    ;Tell main program user didn't flush
	skipn mornhu
	  jrst crf
	move d,ttyopt
	tlne d,%toers		   ;is this a losing terminal
	  skipg mornro		   ;  or are we in :MSGS
	    jrst formfa		   ;    Yes, clear the screen
	7type [asciz /TL/]   ;otherwise merely home-up and CLEOL
	ret

MORXIT:	REST TYOUNI
PURXT1:	REST W1
	REST D
	REST A
	REST 40
	REST UUOH
	JRST UDISMX

;CALL HERE TO UNSET ON-FLUSHED-RETURN.
MORFL2:	SETZM MORPRP
	RET

MORFL1:	SETOM MORNHU
MORFL4:	CALL TYOFRC
	AOS MOREXP
	SAVE A
	SAVE D
	SAVE W1
	MOVEI W1,-3(P)
	CALL MORIN2
	REST W1
	REST D
	REST A
	SOS MOREXP
MORFL5:	SKIPL MORMSG
	 AOS (P)	;MORFL1 SKIPS IF DIDN'T FLUSH.
	SETZM MORMSG
	RET


;; General catch-all interrupt handler

TSIN0:	MOVEM 17,INTACS+17
	MOVEI 17,INTACS
	BLT 17,INTACS+16
	SKIPGE -6(P)
	 ERLOSS INTJPC
	PUSH P,UUOH
	PUSH P,40
	SETOM INTING	;NOW WE ARE PI-IN-PROG, CAN'T DO HAKKAH.
	MOVEI W1,-5(P)	;PDL ADDR OF PC TO DISMISS TO.
	SKIPE I1,-4(W1)	;IF ANY 1ST WD INTS,
	 CALL OTHERI	;HANDLE THEM.
	SKIPN I1,-3(W1)	;IF NO 2ND WD INTS,
	 JRST TSIN25	;DONE.
	TRZE I1,1_TYOC
	 .VALUE
	TRZE I1,1_<TYIC>
	 PUSHJ P,TSINTT
	TRZE I1,1_<COMC>
	 PUSHJ P,TSINTC
	TRZE I1,1_USRI
	  CALL TSINF	;FOREIGN JOB VANISHED UNDER OUR EXAMINATION.
	trze i1,1_dirhc	;a write on our HSNAME directory?
	  call dirint	;  request HAKKAH to take a look
	JUMPE I1,TSIN25
	SETZB U,INTIOP	;USR CHNLS NOT PUSHED YET THIS INT.
TSIN2:	TDZE I1,INTBIT(U)
	 JRST TSIN3
TSIN22:	ADDI U,USRLNG
	CAIGE U,USREND
	 JUMPN I1,TSIN2
	SKIPN INTIOP	;IF USR CHNLS WERE PUSHED, POP THEM.
	 JRST TSIN23
	.IOPOP USRO,
	.IOPOP USRI,
TSIN23:	AND I1,[7777,,]	;INTERRUPTS FROM FORGOTTEN JOBS =>
	IORM I1,JREMEM	;REMEMBER THEM ALL,
	JUMPE I1,TSIN25	;AND NOTIFY THE USER.
	SETOM HAKRQ
	SETOM HAKTYP
TSIN25:	SETZM INTING	;ABOUT TO BE NO LONGER PI-IN-PROG.
	MOVE U,CU	;;; HAKPRM ASSUMES THAT INTERRUPTS ON TYIC COME THRU HERE !!!
	SKIPE UINT(U)	;IF CURRENT JOB IS WAITING TO RETURN TO DDT
	 SKIPL STOPWT	;AND DDT IS WAITING FOR IT,
	  JRST TSIN24
	SETZM HAKOK	;DON'T CALL HAKKAH TILL IT HAS BEEN HANDLED,
	MOVSI A,FLSTOP	;AND TELL DDT IT'S TIME TO WAKE UP.
	IORM A,INTACS
TSIN24:	REST 40
	REST UUOH
	MOVSI 17,INTACS
	BLT 17,17
CLIBR1:	SKIPE HAKOK	;IF MAIN PROG SAYS OK TO EXIT TO HAKKAH,
	 SKIPL HAKRQ	;AND IF SOMEBODY WANTS HAKKAH,
	  JRST UDISMX
	SKIPE HAKING	;DON'T CALL HAKKAH RECURSIVELY.
	 JRST UDISMX
	SETOM HAKING	;ELSE SAY ENTERING HAKKAH.
	SUB P,[3,,3]	;FLUSH THE INTERRUPT DEBIUGGING INFO.
	POP P,-4(P)	;PUT PC IN LOWEST OF WDS PUSHED BY INT,
	SYSCLE DISMIS,[%CLIMM,,1(P) ? %CLIMM,,.+2] ;RESTORE DEFER WDS.
	SUB P,[3,,3]	;FLUSH EXTRA WDS FROM STACK.
	JRST HAKKAI	;PRETEND M.P. PUSHJ'D TO HAKKAH.

UDISMX:	SYSCLE DISMIS,[P ? %CLBIT,,400000]


OTHERI:	IORM I1,HAKINT	;SOME INTS JUST RQ ACTION AT HAKKAH LVL
	TDNE I1,[%PIDBG+%PIRLT+%PIDWN+%PICLI]
	 SETOM HAKTYP
	TDZE I1,[%PIDBG+%PIRLT+%PIDWN+%PICLI]
	 SETOM HAKRQ
	TRZE I1,%PIIOC
	 CALL IOCBRK
	CAIG I1,1
	 RET		;DISMISS UNLESS UNKNOWN INT.

dirint:	push p,a	;need an AC
	movsi a,(%pidir)  ;request the action at HAKKAH lvl
	iorm a,hakint
	setom haktyp	;tell HAKKAH there's typing to be done
	setom hakrq	;and that it should run
	rest a
	ret

BADINT:	AOSN NALTXF	;RANDOM INT DUE TO LOSING INSN $X'D ISN'T A DDT BUG.
	 JRST ERR
	ERLOSS (W1)


IOCBRK:	AOSN LOADF	;IOC ERROR DURING LOADING => JUST SAY THE FILE IS BAD.
	 JRST FILENG
	.suset [.rbchn,,i3]  ;Get the bad channel
	hrrz i2,(w1)	;Get the return address
	caie i2,clioc0	;Is this an ioc-error writing the SENDS file?
	  cain i2,clioc1  ;(only two places that do that)
	    jrst [aos (w1)  ;Make the instruction point to the next loc
		  syscle STATUS,[i3 ? %clout,,i3]  ;Get the channel status
		  ldb i3,[330500,,i3]
		  cain i3,11  ;Was it device full?
		    setom dskful  ;  yes, note the fact
		  ret]	;  And return to caller
	syscle rfname,[i3 ? repeat 4,[ ? %clout,,nctltf+.rpcnt ]]
	CAIN I3,UTOC	;IOC ERROR ON FILE BEING WRITTEN => DELETE IT.
	 JRST IOCOUT
	CAIE I3,TYIC	;IOC ERROR ON TTY CHANNEL => IF IT'S CHANNEL NOT OPEN,
	 CAIN I3,TYOC
	  CAIA
	   JRST IOCBK3
	LSH I3,27
	IOR I3,[.STATUS I4]
	XCT I3
	LDB I4,[330500,,I4]
	CAIN I4,8
	 JRST IOCOPN	;JUST GO OPEN THE TTY AND RETRY.
	JRST IOCBK3

;IOC ERROR WRITING AN OUTPUT FILE:  DELETE IT AND THEN ERROR MESSAGE.
IOCOUT:	SYSCAL DELEWO,[%CLIMM,,UTOC]
	 JFCL
IOCBK3:	CAIA		;SKIP INTO THE OPNER.  THE SYSCAL IS JUST AN ARG FOR THE OPNER.
	 SYSCLO OPEN,[I3 ? REPEAT 4,[ ? NCTLTF+.RPCNT ]]

;INTERRUPT FROM TRYING TO USE THE TTY WHEN DON'T HAVE IT.
TTYINT:	INSIRP PUSH P,UUOH 40 A D W1 B C I4
	CALL DDTUNM	;NOW CHECK FOR CHANGE IN UNAME DUE TO REOWNMENT.
	REST I4
	REST C
	REST B
	JRST PURXT1

;; This is available in case the luser types BACKNEXT-J to ITS.

; JSTINT looks at JSTOPT and prints out a wholine something like:
;
; 12:34:56 20 UNAME JNAME SNAME 500176 +DSKBI  5% 0:03:09.2 206K
; ^time                                ^status ^%runtime    ^core size
;          ^job #               ^upc              ^job runtime
;				|
;				+ if syms, symbolic PC yuck yuck

; Normally, in order to type something out we queue it for HAKKAH MP
; level output, which obeys SENDRP and .DTTYs (keeps the inferior
; informed about the TTY and stuff.)  
;
; Handling the %PIJST interrupt is a special case, because the user
; always wants the status display immediately, and does not want to
; perturb any TTY-owning inferior (with %PIATY interrupts, for example.)
;
; Here is some I/O code to just blast things at our console
; without any regard for whether we own it.  This should not
; normally be used; it is intended for use by JSTINT.

;Type out ASCII.
DEFINE	JS7TYP &STRING
	MOVEI I1,<.LENGTH STRING>
	MOVE I2,[440700,,[ASCII STRING]]
	SYSCAL SIOT,[%CLIMM,,TYOC ? I2 ? I1]
	 ERLOSS
TERMIN

;Type out (and smash) the octal number in I1.
;too bad we don't right-justify this
JSOTYP:	IDIVI I1,8		;Figure first digit.
	PUSH P,I2		;Push remainder.
	SKIPE I1		;Done?
	 CALL JSOTYP		; No compute next one.
	POP P,I1		;Yes, take out in opposite order.
	MOVEI I1,"0(I1)		;Make ASCII.
	SYSCLE IOT,[%CLIMM,,TYOC ? I1]	;Type it.
	RET

; Type a space, then type out A as word of sixbit.  Bashes I1 and I2.
js6typ:	movei i1,40
	syscle iot,[%climm,,tyoc ? i1]
	move i1,[440600,,a]
	repeat 6,[ildb i2,i1
	  addi i2,40	;make it ascii
	  syscle iot,[%climm,,tyoc ? i2]]
	ret

; This code really should worry about using TYOC without first making sure
; someone at main program level isn't halfway through a ^P sequence.

JSTINT:	INSIRP PUSH P,A b c d I1 I2 i3 i4
	SKIPE NOTTY	;If the TTY was translated away
	 JRST JSTI99	;  ignore the command (do I like this?)
	hrrz a,jstopt	;get option flag
	cain a,-1	;-1 means muzzle
	 jrst jsti99
	js7typ "A"	;we always start on a fresh line
	move i1,[440600,,a]	;and with the time
	.rtime a,
repeat 2,[
 repeat 2,[ildb i2,i1
	   addi i2,40	;make it ascii
	   syscle iot,[%climm,,tyoc ? i2]]
	 movei i2,":
	 syscle iot,[%climm,,tyoc ? i2]]
repeat 2,[ildb i2,i1
	  addi i2,40	;make it ascii
	  syscle iot,[%climm,,tyoc ? i2]]
	movei i2,40
	syscle iot,[%climm,,tyoc ? i2]
	skipe ddtty	;Does some inferior have the TTY?
	 jrst [ hrrz a,jstopt
		;; DDT might want to do something funny if waiting for
		;; e.g., an MLDEV or ARC
		jumpe a,jstjob
		JS7TYP "This is an ITS status message.A"
		JRST JSTI99 ]
jstjob:	syscle ttyget,[movei tyoc
			repeat 3,[ ? movem d]]
	hrrz i1,d	;Get index of job controlling the TTY in D.
	call jsotyp	;Print it.
	move c,[-10,,[sixbit /uname/ ? movem a
		      sixbit /jname/ ? movem i3
		      sixbit /sname/ ? movem i4
		      sixbit /upc/   ? movem b]]
	syscle usrvar,[movei i2,(d)%jsnum ? c]
	call js6typ
	move a,i3
	call js6typ
	move a,i4
	call js6typ
	movei i2,40
	syscle iot,[%climm,,tyoc ? i2]
	tlnn b,%pcusr	;user PC?
	 pushj p,[syscle usrvar,[movei i2,(d)%jsnum ? [sixbit /uuoh/]
				 movem b]
		  sos b
		  ret]	; nope, get get user's pc (sort of)
	hrrz i1,b
jstppc:	call jsotyp
	js7typ "A"
JSTI99:	INSIRP POP P,i4 i3 I2 I1 d c b A
	JRST UDISMX	;Done

PURBR1:	SKIPE TOUTXQ	;HANDLE WRITING IN READ-ONLY PAGE
	 ERLOSS
	SAVE UUOH
	SAVE 40
	SAVE A
	SAVE D
	SAVE W1
	SAVE B
	SAVE C
	SKIPGE XRWI	;ARE WE DOING A DEP OR RDEP?
	SKIPN UNPURF	;AUTO-UNPURE WANTED?
	 JRST PURBR2	;ONE OR OTHER WAS NO.
			;LETS UNPURIFY, GET ADDR WERE DEPOSTING IN.
	 JUMPL A,PURBR3	;WERE DEPOSITING IN ..DDT+MUMBLE.
	PUSHJ P,UNPUR1	;TRY TO UNPURIFY. (MAY FAIL & SKIP)
	 JRST [	SKIPN TTYFLG
		 SKIPN DDTTY
		  JRST PURXIT
		7TYPE [ASCIZ/ :UNPURE /]
		MOVE D,-4(P)
		CALL TOC
		CALL LCT
		JRST PURXIT]
PURBR2:	.SUSET [.RMPVA,,A]
	CAIL A,STBDE-NDSPGS*2000	;WERE WE WRITING IN DDT SYM TAB?
	 CAIL A,STBDE
	  JRST PURBR3
	CALL UNPUR1	;YES, UNPURIFY.
	 JRST PURXIT
PURBR3:	TERR 'PUR

PURXIT:	POP P,C
	POP P,B
	JRST PURXT1	;POP MORE STUFF, AND DISMISS INT.

;ILOPR INT CAN COME FROM LOAD SYSTEM CALL (CAN IT ANY MORE)?
;OR FROM $$J, AS WELL AS FROM EXAMINE/DEPOSIT ROUTINES.
ILOPR:	AOSN LOADF
	 JRST FILENG
	SAVE I2
	HRRZ I2,-4(P)
	CAIN I2,N2AJ2-1	;ILOPR IN .USET OF JNAME (FOO$$J WHEN FOO EXISTS) =>
	 JRST N2AJ3	;JUST GIVE AN ERROR MESSAGE.
	CAIN I2,KCHUN1-1
	 JRST ERR
	REST I2

;MPV OR ILOPR INT:  IF EXPECTED, MAKE THE LOSING INSN SKIP.  OTHERWISE, IT'S A BUG.
MPVBRK:	AOSE XRWI	;MAYBE EXPECTED BY EXAMINE OR DEPOSIT ROUTINE.
	 JRST BADINT
	AOS -3(P)
	AOS -3(P)
	JRST UDISMX

TSINTT:	SKIPA I3,[TYIFC]
TSINTC:	 MOVEI I3,COMC
	MOVEI I4,(I3)
	.ITYIC I3,
	 POPJ P,
	ANDCMI I3,%TXSFT ;THROW AWAY SHIFT & SHIFT LOCK.
	CAIN I3,^Z	;UNQUOTED CALL, OR ^Z ON NON-TV, CAUSES ^Z-INT
	 SETOM CTLZFL	;TO BE GIVEN TO INFERIOR AT NEXT OPPORTUNITY.
	TRNE I3,100	;CONVERT CHARACTER TO UPPERCASE
	 TRZ I3,40	;SO LOWERCASE CONTROL CHARS DON'T LOSE.
	TRZE I3,%TXCTL	;CANONICALIZE THE CHARACTER.
	 TRZ I3,100
	ANDI I3,177+%TXTOP ;PRESERVE %TXTOP SO THAT FUNNY GRAPHICS HAVE NO SPECIAL EFFECT.
	CAIN I3,^S	;MUST CHECK FOR ^S BEFORE TYI3B DOES.
	 JRST SILNCE
	CAIN I3,^D
	 SETOM CTLDFL	;^D SETS A FLAG TO STOP SEARCHES.
	MOVE D,I3
	CAIE I4,COMC	;IF FROM TTY,
	 PUSHJ P,TYI3B	;CHECK FOR ^V, ^W, ^B, ^E.
	  JFCL
	CAIE I3,^G
	 RET
	CALL ORESET
TSINF1:	MOVEI I3,TQUIT
	SKIPN TQUITR	;IF WE AREN'T IN NON-QUITTING CODE,
	 JRST [MOVEM I3,(W1)
		RET]	;QUIT WHEN DISMISS INTERRUPT.
	AOSE TQUITW	;ELSE IF NOT THE 1ST ^G, DON'T GIVE MORE TIME.
	 RET
	.SUSET [.SRTMR,,[200000]]
	.SUSET [.SIMASK,,[%pirun]]
	POPJ P,		;CAUSE "DDT BUG" MSG IF RUN 256 MSEC
			 ;WITHOUT QUITTING.

TQUITX:	SOSN TQUITR	;EXIT FROM NON-QUITTING CODE.
	SKIPGE TQUITW	;WANTED TO QUIT?
	 RET		;(STILL NON-QUITTING OR DON'T WANT TO QUIT)
TQUIT:	SETOM TQUITW	;NO LONGER TRYING TO QUIT.
	PUSHJ P,TQUIT0	;MUST RESET COMPLETELY.
	ERSTRT [SIXBIT/QUIT?/]

TQUIT0:	PUSHJ P,INFLS1	;RESET LOCAL IOPDL
	.IOPDL		;AND SYSTEM'S.
	SETZM INIOPS
	.CLOSE COMC,
TQUIT1:	MOVEI D,DD2	;RETURN TO ABSOLUTE TOP LEVEL
	MOVEM D,ERRSTL	;RATHER THAN THE ERROR-RETURN.
	REST D		;AND FLUSH THE PDL TO AVOID PDL OV PROBLEMS
	MOVE P,[-LPDL,,PS]	;(EG SUPPOSE WE QUIT OUT OF TYPING THE ERROR
	JRST (D)		;MESSAGE WHICH WILL FOLLOW THIS)

SILNCE:	SETOM SILNT	;THROW AWAY TYPEOUT, AND TURN OFF TILL INPUT READ.

ORESET:	.RESET TYOC,	;THROW AWAY AS MUCH TYPEOUT AS POSSIBLE.
orest1:	SAVE A		;W1 SHOULD POINT A WORD HOLDING PC WE WILL RETURN TO.
	HLRZ A,@(W1)	;IF HUNG AT TYOC IOT,
	CAIN A,(.IOT TYOC,)
	 AOS (W1)	;DON'T RETURN TO OUTPUT IOT
	HRRZ A,(W1)
	CAIE A,TYOFR2
	 CAIN A,TYOFR3
	  AOS (W1)
	JRST TYOFR1	;THROW AWAY WHAT'S IN TYOBUF.

TSINF:	.RESET TYOC,
	7TYPE [ASCIZ/
Foreign Job Being Examined Vanished, /]
	SETOM FRNDEL	;TELL %RESET TO DO A :KILL
	JRST TSINF1	;GO QUIT (AND THUS CALL %RESET)

KNEWTTY:	SAVE [NLTL2]	;COMMAND TO REOPEN THE TTY.
IOCOPN:	TSOPEN TYOC,[[21,,'TTY]]
	TSOPEN TYIC,[['TTY ? 0]]
	TSOPEN TYIFC,[[%TIFUL,,'TTY]]
	.CALL TTYGYP
	 JRST IOCOP2		;OPENING TTY: DIDN'T GET A TTY, MAYBE?
	MOVEM I4,TTYTYP
	.SUSET [.RTTY,,TTYNUM]	;GET NUMBER OF CONSOLE.
	HRRZS TTYNUM
	syscle cnsget,[%climm,,tyoc
		%clout,,ttymxv
		%clout,,ttymxh
		%clout,,tctyp
		%clout,,i4
		%clout,,ttyopt]
	move i4,[-6,,[ sixbit /OSPEED/ ? movem ospeed
		       sixbit /ISPEED/ ? movem ispeed
		       sixbit /SMARTS/ ? movem smarts]]
	syscle ttyvar,[%climm,,tyoc ? i4]  ;find out the speed of this TTY
	setzm getty	;getty is nonzero iff tty is a display.
	move i4,ttyopt
	setzm erase
	tlnn i4,%toers	;if the TTY is erasible
	  tlnn i4,%toovr  ;  or can't be overwritten,
	    setom erase	;   ^PX and friends will win!
	TLNE I4,%TOMVU
	 AOS GETTY
	TLZ C,%TSSAI+%TSROL+%TSMOR
	TLNE I4,%TOROL
	 TLO C,%TSROL	;GO INT O SCROLL MODE IF NEC.
	SETZM SCROLL	;SETTING SCROLL IF SO.
	TLNE I4,%TOROL
	 SETOM SCROLL
	TLNE I4,%TOSA1
	 TLO C,%TSSAI	;ENTER SAIL MODE IF NEC.
	TLNN I4,%TOMOR
	 TLO C,%TSMOR
	SETOM NOERASE
	TLNE I4,%TOMVU
	 TLNE I4,%TOERS
	  SETZM NOERASE	;NOERASE IS SET IF TTY IS A STORAGE TUBE.
	MOVEM C,TTYSTS
	TSCALL TTYSB1
	MOVE C,GETTY
	MOVEM C,PCPNTF
	MOVEM C,RAIDFL
	JRST DDTUNM	;MAYBE WE WERE REOWNED AFTER :DETACH & NEW UNAME.

TTYSB1:	SETZ ? 'TTYSET
	%CLIMM,,TYOC
	[232222,,222222]
	[230222,,220222]
	SETZ TTYSTS

TTYGYP:	SETZ
	SIXBIT /TTYGET/
	[TYOC]
REPEAT 2,%CLOUT,,I4
	%CLOUT,,C
	402000,,I4

IOCOP2:	.STATUS TYOC,C
	LDB C,[OPNLBP,,C]
	CAIE C,%EBDDV	;IS IT "WRONG TYPE DEVICE"?
	 ERLOSS
	SETZM TTYTYP
	SETZM TTYNUM
	SETZM TCTYP
	SETZB C,GETTY
	SETZM TTYOPT
	SETOM NOTTY
	SETZM RAIDFL
	SETZM PCPNTF
	JRST DDTUNM

ALARMM:	ASCIZ /AAlarm /

ALARM:	tlo f,flq\flunrd	;flq => relative time, flunrd => re-read d.
	jsp w2,rch
	cain d," 
	 jrst .-2	;ignore leading spaces
	cain d,^M
	 JRST ALARMC	;:ALARM<CR> => CLEAR ALARM.
	caie d,".	;:ALARM .+<TIME> => relative time.
	 tlz f,flq	;:ALARM <TIME> => absolute time.
	MOVE W1,[JSP W2,RCH]	;MSGNUM does XCT W1 to read a char.
	SETZ A,		;ACCUMULATE TIME OF ALARM IN A.
	hrroi i1,-3	; HH:MM:SS
ALARM1:	SAVE A
	movei w2,.+1	;top of loop
	cail d,"0	;ignore non-digits except CR
	 caile d,"9
	  cain d,^M
	   skipa
	    jrst rch		;read char, return to top of loop
	tlo f,flunrd	;re-read first digit
	PUSHJ P,MSGNUM	;READ 1 DECIMAL NUM (BUT DON'T READ PAST CR).
	REST A
	IMULI A,60.
	ADDI A,(C)	;PUT THIS BASE-60 DIGIT IN TIME.
	aojl i1,alarm1
	tlze f,flq
	 jrst alarm3	; relative time, ready to use in A.

	idivi a,24.*60.*60.	;absolute time, mod 24 hours
	move a,b
	.RTIME B,	; minus present time.
	MOVE W1,[-6,,[0 ? 10. ? 6 ? 10. ? 6 ? 10.]]
	MOVE I1,[440600,,B]	;BP IN CURRENT TIME (SIXBIT)
ALARM2:	ILDB D,I1	;NEXT DIGIT OF CURRENT TIME.
	IMUL C,(W1)	;EACH DIGIT HAS ITS OWN RADIX.
	ADDI C,-'0(D)
	AOBJN W1,ALARM2
	SUB A,C		;# SECONDS FROM NOW ALARM SHOULD RING.
	SKIPG A
	ADDI A,24.*60.*60.

alarm3:	PUSH P,A
	IMULI A,60.
	.RDTIM B,	;COMPUTE TIMME IN 60'THS BETWWEEN TIME OF ALARM
	LSH B,1		;AND TIME SYSTEM WAS STARTED.
	ADD A,B
	EXCH A,ALARMV
	CALL ALARM4	;RQ A REALTIME INT THEN.
	7TYPE ALARMM
	SKIPE A
	  7type [asciz /re/]
	7TYPE [ASCIZ /set for .+/]
	POP P,D
	pushj p,tmpa
	JRST NLTL2

ALARMC:	SETZM ALARMV
	CALL ALARM4
	7TYPE ALARMM
	7TYPE [ASCIZ /Cleared/]
	JRST NLTL2

;THERE ARE 2 POSSIBLE RQS FOR REALTIME INTS: ALARMV AND ALARMW.
;ASK ITS FOR A REALTIME INT AT WHICHEVER IS SOONER.
ALARM4:	MOVE C,ALARMV
	SKIPG ALARMW	;IF ALARMW IS 0, USE ALARMV
	 JRST ALARM5
	JUMPLE C,.+2	;ELSE IF ALARMV IS 0,
	CAML C,ALARMW	;OR LATER THAN ALARMW,
	 MOVE C,ALARMW	;USE ALARMW
ALARM5:	JUMPLE C,ALARM6	;NO RQ => CLEAR REALTIME INTS.
	.RDTIM B,	;ELSE COMPUTE TIME TO INT IN 60'THS,
	LSH B,1
	SUB C,B
	CAIGE C,1	;(IF INT SHOULD HAVE HAPPENED ALREADY,
	 MOVEI C,1	;MAKE IT HAPPEN VERY  SOON)
	SKIPA B,[TRN C]	; same as skipa b,[%rlfls\%rlset,,c]
ALARM6:	MOVSI B,400000
	.REALT B,
	RET

tmpa:	setz c,
	camge d,tmt1(c)
	 aos c
	jrst tmp3
TMPT:	MOVEI C,0
	JUMPE D,CPOPJ
	CAMGE D,TMT1(C)
	AOJA C,.-1
TMP3:	IDIV D,TMT1(C)
	CTYPE "0(D)
	MOVE D,W1
	TRNN C,1
	AOJA C,TMP3
	CAIL C,5
	POPJ P,
	CTYPE ":
	AOJA C,TMP3

TMT1:	36000.
	3600.
	600.
	60.
	10.
	1


COMPLN:	PUSHJ P,ERTTY
	MOVEI D,8
	MOVEM D,ODF	;SET CURRENT RADIX TO OCTAL
CMPLN2:	PUSHJ P,TSPC
	XCT @(P)
	PUSHJ P,TOC
	AOS (P)
	MOVEI D,",
	PUSHJ P,TOUT	;DON'T CHANGE TO A UUO, WILL CLOBBER 40, UUOH, ETC.
	JRST CMPLN2

ERTTY:	SETZM TTYSTL	;TTY NOW LEGITIMATELY DDT'S; SHOULDN'T TRY GIVING TTY BACK.
	SYSCLE USRVAR,[MOVEI %JSELF ? [SIXBIT /TTY/] ? MOVEI ? [TLO %TBINF]]
	.DTTY USRI,
	 JFCL
	SETZM TOUTXQ	;TOUT SHOULD DO NORMAL TTY OUTPUT
	SETOM DDTTY	;NOW DDT HAS TTY.
	SKIPE TYOUNI	;IF WE ERRED OUT OF **MORE** PROC, FLUSH THE TTY OUT BFR.
	 CALL [	SAVE A ? JRST TYOFR1]
ERTTY1:	SETZM MORPRP	;ELIMINATE ON-FLUSHED-RETURN.
	SETZM SILNT
	MOVE A,TTYFLG
	SETZM TTYFLG	;TURN ON TTY OUTPUT.
	JUMPE A,CPOPJ
	PUSH P,D
	MOVEI D,^V	;IF HAD BEEN OFF, TYPE "^V ".
	PUSHJ P,TOUT
	PUSHJ P,TSPC
	JRST POPDJ

TSIN3:	SKIPE INTIOP	;IF WE'VE PUSHED USR CHNLS, MUST RE-OPEN.
	JRST TSIN3B
	SKIPL HAKIOP	;IF HAKKAH PUSHED USR CHNLS
	SKIPL UCHNLO	;OR IF THEY AREN'T OPEN YET, CAN'T USE THEM.
	JRST TSIN3D
	CAMN U,CU	;UNLESS INT FROM CURRENT USER,
	JRST TSIN3C
TSIN3D:	.IOPUSH USRI,	;MUST PUSH AND RE-OPEN.
	.IOPUSH USRO,
	SETOM INTIOP
TSIN3B:	move a,urandm(u)  ;check if we're supposedly foreign
	trne a,%urfrn	;foreign?
	  erloss (u)	;  Yes, we must have blown it somewhere
	MOVE A,[.BII,,USRI]
	.CALL OPNUSR
	 JRST TSIN22
	MOVE A,[.BIO,,USRO]
	.CALL OPNUSR
	 JRST TSIN22
TSIN3C:	MOVE A,[-5,,[.RPIRQ,,I3
		     .RMASK,,W3
		     .RPICL,,W2
		     .RDF1,,I2
		     .ROPTI,,B]]
	.USET USRI,A
	ORCM I2,W2	;DEFERRED INTS.
	MOVE A,I2
	ORCM A,W3	;DEFERRED OR DISABLED INTS.
	AND A,I3	;DEFERRED OR DISABLED PENDING INTS.
	AND A,BADBTS	;CLASS 1 OR 2 INTS.
	MOVEM A,UPI0(U)	;COMMON FATAL INTS DETECTED ALREADY.
	ANDCM I3,I2	;PENDING UNDEFERRED INTS.
	AND I3,W3	;PENDING ENABLED UNDEFERRED INTS.
	SETZM UPI1(U)
	TRNN A,%PIB42	;DON'T GROVEL OER HIS INT TABLE IF IT'S INVALID.
	 TLNN B,OPTINT	;IF JOB USES NEW INTS, MUST CHECK
	  JRST JBIOLD	;ENABLED UNDEFERRED INTS FOR THOSE
			;NOT HANDLED BY THE INFERIOR.
	MOVE B,[-4,,[	.R40AD,,A
			.RIFPI,,I2
			.RMSK2,,D
			.RDF2,,C]]
	.USET USRI,B
	ORCM C,W2	;DEFERRED 2ND WD INTS.
	AND I2,D	;ENABLED PENDING 2ND WD INTS.
	ANDCM I2,C	;ENABLED UNDEFERRED PENDING " .
	SKIPN I2	;IF NO ENABLED UNDEFERRED PENDING INTS
	 JUMPE I3,JBIOLD ;IN EITHER WD, NO NEED TO GO ON.
	ADDI A,2	;GET ADDR OF USER'S "42".
	CALL RFETCH
	 JRST JBIOLD	;USER HAS A BADPI, GIVE UP.
	MOVEI C,1(D)	;ADDR OF 1ST 5-WD ENTRY IN INT. TAB.
	.ACCES USRI,C
	AOBJN D,.+1	;SKIP PAST THE INT PDL PTR ADDR.
	SAVE XRWI
	SETOM XRWI
JBINLP:	MOVE C,[-5,,JBIBUF]
	.IOT USRI,C	;READ ANOTHER INT. TAB. ENTRY.
	 CAIA
	  JRST JBINL1
	ANDCM I3,JBIBUF	;THE INTS THIS ENTRY HANDLES SHOULDN'T
	ANDCM I2,JBIBUF+1 ;BE HANDLED BY DDT, SO FORGET THEM.
	ADD D,[4,,4]
	AOBJN D,JBINLP	;HANDLE ALL INT TAB ENTRIES.
	IORM I3,UPI0(U)	;INTS NOT HANDLED BY USER ARE FOR DDT.
	MOVEM I2,UPI1(U)
JBINL1:	REST XRWI
JBIOLD:	MOVE I3,UPI0(U)
	MOVE I2,UPI1(U)
	MOVE A,[-4,,[	.SAPIR,,I3	;CLEAR RQS FOR INTS DDT HANDLES.
			.SAIFP,,I2
			.RUPC,,I2
			.RSV40,,I40]]
	.USET USRI,A
	MOVEM I2,IPC
	MOVEM I2,PPC(U)
	SKIPN UPI1(U)	;JUST ABOUT ALL FATAL INTS CAUSE STOP.
	TDNE I3,[#%PIBRK#%PIVAL#%PI1PR#%PIMAR#%PITRP]
	 JRST JBISTP
	TLNE I3,%PJTRP	;SYSUUO INTERRUPT => REPORT STOPPED BY SYSUUO.
	 JRST [	MOVNI I3,5
		JRST JBIBTS]
	TRNE I3,%PIBRK
	 JRST JBIBRK	;.BREAK => HANDLE IT.
	TRNE I3,%PIVAL
	 JRST JBIVAL
	TLNE I3,%PJDCL	;DEFERRED CALL MEANS STOP JOB BUT DON'T FLUSH INPUT.
	 JRST JBISNR
	TRNN I3,%PIMAR
	 JRST 1PROC
	SKIPN D,MARCON(U)
	 JRST JBISTP	;STOP ON UNCONDITIONAL MAR.
	SETOM UINT(U)
	JRST JBIBPC	;CONDITIONALIZED MAR: CHECK THE CONDITION.

JBIVAL:	MOVE I3,I40
	TRNN I3,-1	;IF .VALUE 0, GENERATE "VALU0" INTERRUPT.
	 JRST [MOVE I3,[SETZ %PIVAL] ? XORM I3,UPI0(U) ? JRST JBISTP]
	CAMN U,CU	;ELSE IF NOT FROM CURRENT JOB
	 SKIPE DDTTY	;OR DDT HAS TTY,
	  JRST JBISTP	;VALUE INTERRUPT WILL SOS PC, RETRY .VALUE.
	CALL TSTPRM	;DOES ..PERMIT ALLOW JOB TO DO VALRETS?
	 JRST JBIPRM	;SIMILAR IF JOB CAN'T DO VALRETS.
	HRRZM I3,VALCOM
JBISNR:	SETOM RSTDEL	;CAN DO .VALUE NOW, DON'T .RESET TYIC,.
JBISTP:	SETOM I3
JBIBTS:	MOVEM I3,UINT(U)
JBIBPS:	SKIPE STOPWT	;JOB STOPPED WHILE DDT WASN'T WAITING FOR IT =>
	CAME U,CU
	 JRST JBINCR		;TELL HAKKAH TO INFORM USER.
	SAVE TTYSTL	;$P'D JOB WANTS TO RETURN => TAKE BACK TTY IMMEDIATELY
	CALL TTYRET	;SO THAT HE CAN ^G DDT IF IT IS HUNG UP IN HAKKAH.
	REST TTYSTL	;TTY NO LONGER BELONGS TO THE INFERIOR, BUT
	HRRZS TTYSTL	;DON'T FORGET TO RESTORE OCO.
	JRST TSIN22	;LOOP BACK OVER OTHER INFERIORS IN CASE THEY INTERRUPTED.

JBINCR:	SETOM HAKTYP
	SETOM HAKRQ
	JRST TSIN22

;WHEN JOB WANTS TO SUICIDE OR WRITE IN DDT, TSTPRM SKIPS IF IT IS ALLOWED TO.
TSTPRM:	SKIPLE PERMIT(U)
	 SOSA PERMIT(U)
	  SKIPE PERMIT(U)
	   AOS (P)
	RET

JBIPRM:	MOVNI I3,4	;COME HERE TO STOP JOB IF TSTPRM FAILS TO SKIP.
	JRST JBIBTS	;WE ASSUME %PIBRK OR %PIVAL IS ON IN UPI0, SO UBRK3 WILL SOS PC.

;COME HERE WHEN TEMP. BPT. HIT.
JBIBT:	MOVEI A,%PIBRK	;CLEAR OUT THE .BREAK BIT SO THAT UBRK3
	ANDCAM A,UPI0(U) ;WON'T RE-SOS PPC AFTER UBRKT DOES.
	HLRZ A,BTADR(U)
	CAIGE A,20	;ARE THE TEMP BPTS WATCHING A PDL?
	PUSHJ P,RFETCH	;YES, SEE WHERE POINTS NOW.
	 JRST JBIBTS	 ;NO, INT. DDT, PUT 15 OR 17 IN UINT.
	MOVEI D,(D)	;COMPARE RH ONLY
	CAMG D,BTPDL(U)
	 JRST JBIBTS	;PDL BACK TO SAME DEPTH AS WHEN BPTS SET.
	MOVE W3,BTINS(U)
	CAIN I3,17	;NOT SAME DEPTH, PROCEED THRU BPT.
	MOVE W3,BTINS+1(U)
	JRST JBIBT1

1PROC:	TRC I3,%PI1PR	;STOP JOB UNLESS 1-PROC INT, NO OTHERS.
	JUMPN I3,JBISTP
	SKIPN INCNT(U)
	 JRST 1PROC4		;IF DIDN'T ^N.
	MOVNI I3,2	;IF WE STOP IT WILL BE WITH CODE "STEPPING-RETRN"
	MOVEM I3,UINT(U)
	SKIPN B,OIPCHK(U)
	 JRST 1PROC1
	CAIE C,(B)	;$$^N -- CHECK PC.
	 CAIN C,1(B)
	  JRST 1PROC3
	JRST 1PROC2

1PROC1:	MOVE D,USTYPE(U)
	TRNN D,USTYPY	;IN "CARE" MODE?
	 JRST 1PROC3
	MOVEI A,41
	CALL RFETCH	;YES, GET ADDR OF UUO HANDLER.
	 JRST 1PROC3
	MOVEI A,(D)
	CAIE A,-1(C)	;HAVE WE JUST ENTERED UUO HANDLER?
	 JRST 1PROC3
	CALL RFETCH	;YES, SET OIPBIT OF SAVED PC (ASSUME JSR IN 41)
	 JRST 1PROC3
	IOR D,OIPBIT
	CALL RDEP
	 JRST 1PROC3
	JRST GO		;PROCEED, RETURN WHEN USER'S UUOH JRSTF'S

1PROC3:	SOSN INCNT(U)	;HAS ^N COUNT RUN OUT?
	JRST [	HRRZ C,PPC(U)		;YES.  ARE WE INSIDE A BREAKPOINT-PROCEED?
		CALL GXBLKD
		CAIE C,BPBLK+1(D)	;YES => GO 1 MORE INSN TO FINISH UP.
		 CAIN C,BPBLK+2(D)
		  JRST [AOS INCNT(U) ? JRST 1PROC2]
		SETOM RSTDEL		;NO => STOP NOW.
		JRST JBIBTS]
1PROC2:	MOVE D,OIPBIT	;ELSE 1-PROC 1 MORE INSN.
	IORM D,IPC
	JRST GO

1PROC4:	SKIPE I3,MARADR(U)	;IF THERE'S A MAR ON INSN FETCH, TURN IT
	 .USET USRI,[.SMARA,,I3]	; BACK ON (IN CASE WE ARE
					; PROCEEDING FROM IT)
	.USET USRI,[.ROPTIO,,I3]
	TLO I3,OPTTRP		;IF WE ARE STOPPING BEFORE SYSTEM CALLS,
	SKIPN SYSUUO(U)		;TURN IT BACK ON  (").
	 .USET USRI,[.SOPTIO,,I3]
	JRST GO

JBIBRK:	MOVE I3,I40		;HERE IF INFERIOR GOT A .BREAK INTERRUPT.
	TLZ I3,(0 17,)		;THAT CAN BE DUE TO A .BREAK, OR TO A .LOGOUT <NONZERO>,
	MOVE A,[.BREAK 16,160000]
	CAMN I3,[.LOGOUT]	;WHICH SHOULD BE TREATED AS A .BREAK 16,160000 (SUICIDE).
	 MOVEM A,I40
	LDB I3,[270400,,I40]	;DECODE THE .BREAK BY AC FIELD.
	SETZM NBPTB(U)
	JRST @JBIBTB(I3)

JBIBTB:	JBISTP	;RANDOM INST., INTERRUPT DDT
	REPEAT NBP,JBIBPT	;REGULAR BPT
	REPEAT 11-NBP,JBISTP	;RANDOM
	JBIB12
	JBISTP
	JBISTP
	JBIBT		;TEMP. BPT. IN INSN+1
	TSINXX		;$X RETURN, COND BPT RETURN, USER RQ.
	JBIBT		;TEMP. BPT. IN INSN+2

;COME HERE TO HANDLE BREAKPOINTS.
JBIBPT:	LDB A,[$URBPT,,URANDM(U)]
	SETZ D,
	DPB D,[$URBPT,,URANDM(U)]
	MOVE D,I3
	MOVEM I3,UINT(U)
	IMULI I3,BPL
	ADDI I3,-BPL(U)
	CAIN A,(D)
	 JRST JBIBP1
	SOSG B1CNT(I3)
	JRST JBIBPS	;COUNT RAN OUT,BREAK TO DDT
	SKIPE D,BPCON(I3)
	JRST JBIBPC
JBIBP1:	MOVE W3,B1INS(I3)
JBIBT1:	HRR W3,I40
	TLZ W3,37
	JRST PROC	;PROCEED AND INTERPRET BPT INS

JBIBPC:	HRRE I3,UINT(U)
	MOVEM I3,CBPPS(U)
	MOVE A,I40
	HRLM A,CBPPS(U)
	MOVEM D,26SAV
	CALL GXBLKD
	 JFCL GXBLKL
	ADDI D,CBPB
	.ACCESS USRO,D
	MOVEM D,PPC(U)
	EXCH D,IPC
	MOVEM D,BPCPC(U)
	MOVE D,[-3,,26SAV]
	.IOT USRO,D
	JRST GO

;.BREAK 12, COMES HERE.
JBIB12:	MOVE I3,I40
	HRROM I3,UHACK(U)	;SAVE ITS EFFECTIVE ADDR. FOR HAKKAH.
	SETOM HAKRQ
	JRST TSIN22

;.BREAK 16, COMES HERE.
;2.9=$X RETURN, 2.8=EXTRA CR, 2.7=DON'T .RESET TYIC,
;2.6=:KILL, 2.5=DIE SILENTLY IF NOT CURRENT JOB.
;2.4 => COND. BPT RETURN. 2.3 => DON'T TYPE ANYTHING OR CLOSE OPEN LOC.
TSINXX:	MOVE I3,I40
	TRNE I3,10000
	 JRST TSBPC2	;IF COND. BPT. RETURN, SPECIAL.
	CALL TSTPRM	;ELSE IF THIS IS A SUICIDE, SEE IF JOB ALLOWED TO DO IT.
	 TRNN I3,60000
	  CAIA
	   JRST JBIPRM	;NO => JUST STOP.
	SKIPGE UCHNLO
	CAME U,CU	;IF FROM CURRENT JOB,
	JRST TSINX1
	SKIPE DDTTY	;IF DDT HAS TTY,
	JRST TSINX2	;LEAVE IT TILL $J OR $P.
	TRNE I3,100000	;ELSE CAN HANDLE NOW,
	SETOM RSTDEL	;MAYBE SUPPRESS .RESET OF TYIC,.
	TRZE I3,20000	;IF WANTS TO DIE AT HAKKAH LEVEL,
	TRO I3,40000	;KILL IT IMMEDIATELY INSTEAD.
TSINX2:	HRROM I3,UIACK(U)
	MOVEI I3,16	;INDICATE WAS .BREAK 16,.
	MOVEM I3,UINT(U)
	JRST JBIBPS

TSINX1:	MOVE I3,I40	;NOT CURRENT JOB.
	TRNE I3,640000	;CAN NOW HANDLE ONLY RETURNING,
	JRST TSINX2	;ELSE WAIT TILL THIS JOB BECOMES CURRENT.
	TRNE I3,20000	;KILL JOB IMMEDIATELY =>
	 JRST [SETOM HAKRQ	;TELL HAKKAH TO RUN,
		MOVEM I3,UIACK(U)	;SAY JOB WANTS TO DIE,
		JRST TSIN22]	;DON'T SET UINT.
	SETOM UINT(U)	;JUST WANTS TO RETURN,
	PUSHJ P,UBRKR	;REMOVE BPTS, ETC.
	JRST TSIN22	;DON'T REQUEST TO INTERRUPT DDT.

TSBPC2:	TRNN I3,200000	;COND BPT RETURN: DID IT SKIP?
	 JRST TSBPC1	;J IF NOT.
	MOVE D,BPCPC(U)
	MOVEM D,IPC
	MOVEM D,PPC(U)
	HRRE I3,CBPPS(U)
	SETOM NBPTB(U)
	MOVEI D,%PIMAR	;IF THIS WAS A CONDITIONAL MAR,
	SKIPGE I3
	 MOVEM D,UPI0(U)	;REMEMBER THAT THE MAR WAS HIT, AND DON'T BE CONFUSED BY .BREAK 16,.
	JRST JBIBTS

TSBPC1:	MOVE D,BPCPC(U)
	MOVEM D,IPC
	MOVEM D,PPC(U)
	HRRE D,CBPPS(U)
	JUMPL D,TSBPC4	;J IF CONDITIONAL MAR.
	IMULI D,BPL
	ADDI D,-BPL(U)
	MOVE W3,B1INS(D)
	HLR W3,CBPPS(U)
	TLZ W3,37
	JRST PROC

TSBPC4:	.USET USRI,[.RMARPC,,D]
	CALL PCPNTM	;IF THE MAR DIDN'T ABORT THE INSN, TURN MAR BACK ON.
	TLNE D,(@)
	 JRST GO
	MOVE D,OIPBIT	;OTHERWISE, PROCEED 1 INSN AND THEN TURN ON MAR.
	JRST TSBPC3

;COME HERE IF HIT BPT BUT SHOULDN'T STOP (COUNT NOT OUT, ETC)
;HAVE INSN TO SIMULATE IN W3, WITH ADDRESS CALC. ALREADY DONE.
PROC:	MOVEI B,100
	MOVE D,IPC		;SET UP THE TWO JRSTS IN 31SAV.
	HRLI D,(JRST)
	MOVEM D,31SAV+1
	HRRI D,1(D)
	MOVEM D,31SAV+2
PROC1:	SOJLE B,JBISTP
	LDB W2,[270400,,W3]
	LDB D,[331100,,W3]
	CAIN D,260
	JRST IPUSHJ
	CAIN D,264
	JRST IJSR
	CAIN D,265
	JRST IJSP
	CAIN D,266
	JRST IJSA
	CAIN D,256
	JRST IXCT
	TRNN D,700
	JRST IUUO
PROCR:	MOVEM W3,31SAV	;PUT INS IN 31,JRST INS+1 IN 32,JRST INS+2 IN 33
	CALL GXBLKD
	 JFCL GXBLKL
	ADDI D,BPBLK
	HRRM D,IPC
	.ACCESS USRO,D
	MOVE D,[-3,,31SAV]
	.IOT USRO,D
	MOVE D,OIPBIT
	SKIPLE INCNT(U)
TSBPC3:	IORM D,IPC
GO:	PUSHJ P,INSRTB
	MOVE A,[-2,,PCSTP0]	;START LOSER BACK UP
	.USET USRI,A
	SETZM UINT(U)
	JRST TSIN22	;FINISHED HACKING THIS INFERIOR; SEE IF ANY OTHERS INTERRUPTED.

PCSTP0:	.SUPC,,IPC
	.SUSTP,,[0]

IJSP:	TLCA W3,(MOVE#JSP)
IPUSHJ:	TLC W3,(PUSH#PUSHJ)
	HRRM W3,31SAV+1	;TURN THE FIRST JRST INTO A JRST TO THE SUBROUTINE.
	MOVE D,IPC	;THE SECOND JRST ISN'T NECESSARY, SO PUT OLD PC THERE
	MOVEM D,31SAV+2
	CALL GXBLKD	;AND XCT A MOVE OR A PUSH POINTING AT THAT PC.
	HRRI W3,BPBLK+2(D)
	JRST PROCR

;GET IN D THE ADDRESS OF THE 20-WORD XCT BLOCK IN THE INFERIOR,
;MINUS 20 (THE DEFAULT ADDRESS OF THAT BLOCK).  VERIFY THAT THE MEMORY EXISTS.
;FOLLOW THE CALL WITH  JFCL GXBLKL  TO GO TO JBIBPS INSTEAD OF JUST ERRORING.
GXBLKD:	.USET USRI,[.R40ADDR,,D]
	HLRZS D
	SKIPE D
	 MOVEI D,-20(D)
	SAVE D
	SAVE A
	MOVEI A,20(D)	;TRY TO WRITE IN THE 1ST WORD OF THE BLOCK.
	CALL RDEP
	 JRST GXBLK1
	ADDI A,17
	CALL RFETCH
	 JRST GXBLK1
	CALL RDEP	;WRITE IN THE LAST WORD.
	 CAIA
	  JRST POPADJ
GXBLK1:	MOVE A,@-2(P)	;XCT BLOCK DOESN'T EXIST.  WHAT DO WE DO?
GXBLKL:	CAME A,[JFCL GXBLKL]
	 ERSTRT [SIXBIT/NO CORE AT THE $X LOCATIONS?/]
	7TYPE [ASCIZ /No core at the $X locations!/]
	SKIPN UINT(U)
	 SETOM UINT(U)	;BE AWARE THAT THE JOB ISN'T BEING RESTARTED.
	SUB P,[2,,2]
	JRST JBIBPS

IJSR:	MOVE D,IPC
	HRRZ A,W3
IJSR1:	PUSHJ P,RDEP
	 JRST JBISTP
	HRLI W3,(JRST)
	AOJA W3,PROCR

IJSA:	HRRZ A,W2
	PUSHJ P,RFETCH
	JRST JBISTP
	HRRZ A,W3
	PUSHJ P,RDEP
	 JRST JBISTP
	HRRZ A,W2
	HRR D,IPC
	HRL D,W3
	JRST IJSR1

IXCT:	HRRZ A,W3
IXCT1:	PUSHJ P,RFETCH
	JRST JBISTP
	MOVE W3,D
	MOVEI A,100
	MOVEM A,TEM2
IXCT3:	LDB A,[220400,,D]
	JUMPE A,IXCT2
	PUSHJ P,RFETCH
	JRST JBISTP
	ADDI W3,(D)
IXCT2:	TLNE W3,20
	JRST IXCTIN
	TLZ W3,37
	JRST PROC1

IXCTIN:	SOSGE TEM2
	JRST JBISTP
	HRRZ A,W3
	PUSHJ P,RFETCH
	JRST JBISTP
	DPB D,[2700,,W3]
	MOVE D,W3
	JRST IXCT3

IUUO:	CAIN D,45
	 JRST IBPT
	CAIL D,40
	 JRST PROCR	;USER UUO
	MOVE D,W3
	MOVEI A,40
	PUSHJ P,RDEP
	 JRST JBISTP
	MOVEI A,41
	JRST IXCT1
IBPT:	MOVEM W3,I40
	JRST JBIBRK

;MAIN PROGRAM LEVEL CODE TO HANDLE .BREAK 12, REQUESTS, CLI INTS.
;MAY BE EXECUTED WHENEVER DDT IS READING INPUT, TYPING OR SLEEPING.
;INTERRUPT LEVEL SETOM'S HAKRQ TO SAY HAKKAH SHOULD BE CALLED.
;THE UHACK USER VARIABLE IF NONZERO SAYS THAT JOB WANTS SERVICE,
; RH HAS EFFECTIVE ADDRESS OF THE .BREAK 12, .
;UIACK USER VAR BIT 2.5 SAYS KILL THE JOB.
;HAKPRQ NONZERO IS ADDR OF A LOC. THAT WAS UNPURIFIED
 ;AUTOMATICALLY. A ":UNPURE <HAKPRQ>" MESSAGE IS NEEDED.
;HAKBLC IF >0 IS THE NUMBER OF RQ'S FOR BELLS TO BE TYPED
 ;DUE TO INTERRUPTS FROM INFERIORS THAT DIDN'T HAVE TTY.
;HAKINT BITS %PIDBG, %PIDWN, %PICL1 IF SET MEAN
 ;THAT THE RESPECTIVE INTS HAVE BEEN RECEIVED AND
 ;WANT STUFF TO BE TYPED OUT.
HAKKAM:	SETOM HAKOK	;TSINT CAN EXIT TO HAKKAH.
HAKKAN:	SKIPL HAKRQ	;DO HAKKAH IF ANY RQ'S QUEUED.
	 RET
HAKKAH:	SKIPE TOUTXQ	;DON'T DO HAKKAH WHEN CAN'T TYPE OUT.
	 RET
	SKIPN HAKING	;DON'T ALLOW RECURSIVE HAKKAH.
	 SKIPE INTING	;DON'T DO HAKKAH PI-IN-PROG.
	  RET		;(HAKRQ STILL -1 SO WILL CALL HERE AGAIN.)
HAKKAI:	SKIPE TYOUNI
	 SKIPN NOERASE	;ON STORAGE TUBES, WE CAN'T TYPE STUFF INSIDE A --MORE--.
	  CAIA
	   RET
	SETOM HAKING	;NOW WITHIN HAKKAH (IN CASE CALL HAKKAH)
	SAVE A		;SAVE ACS A THRU 16.
	MOVEI A,1(P)
	HRLI A,B
	ADD P,[14,,14]
	SKIPL P		;P'S VALUE AFTER THE PUSHING.
	  ERLOSS
	BLT A,(P)
	SAVE UUOH
	SAVE 40
	SAVE TTYFLG	;WE MAY TEMPORARILY TURN ON TTY OUTPUT.
	SAVE MORPRP	;DON'T LET HAKKAH EXIT TO M.P. DUE TO
	SETZM MORPRP	;A FLUSHED MORE.
	SETZM HAKRQ
	SETZM TTYFLG	;ALL TYPEOUTS EXCEPT :UNPURE COME OUT EVEN IF TTY OFF.
	skipn i3,hakint	;any ints rq'ing typeout?
	  jrst hakha8
	trze i3,%picli	;First, are there any CLI's pending?
	  call hakcli	;  yes, gobble down the message before doing anything
	aos haktyp
hakai1: skipe haktyp  ;if it's time for random typeouts, try them.
	  jrst hakham

	MOVE U,CU
	LDB A,[$URGAG,,URANDM(U)]
	SKIPL U
	 SKIPE UINTWD(U)
	  setz a,	;a nonzero iff current job running and wants :NOMSG 0.
	SKIPN A
	 SKIPN NOMSGF	;IN :NOMSG 0 MODE, EITHER FROM :NOMSG OR REQUESTED BY CURRENT JOB,
	  jrst [ sos haktyp
		 AND I3,[%PIDWN]
		 JUMPE I3,HAKHAM  ;PRINT ONLY "SYS GOING DOWN" MESSAGES,
		 .DIETIM A,
		 JUMPL A,HAKHAM	;NOT "REVIVED" MESSAGES,
		 CAIL A,10.*60.*30.
		   JRST HAKHAM	;AND PRINT ONLY IF GOING DOWN WITHIN 10 MINUTES
		 call %save1	;steal the tty if don't have it
		 CALL HAKDED	;PRINT,
		 ANDCAM I3,HAKINT ;SAY IT HAS BEEN HANDLED.
		 JRST HAKHAM]
	jumpe i3,hakha8
	skipl u		;no job?  Can't be inhibited from printing mail
	  skipn uintwd(u)  ;Job not running?
	    caia	;     legit job that's running,
	      jrst hakai2  ;    else skip over the rest of this checking
	skipge ddtty	;is the TTY in DDT?
	  jrst hakai3	;  yes, so don't defer
	skipge a,mailnt	;check out our notification flag
	  movns a	;  take the absolute value thereof
	cain a,2	;if it's 2, we defer when in any inferior at all
	  jrst hakai4	;  so do that
	move a,urandm(u)  ;otherwise, check the URANDM word
	trnn a,%urmal	;or it wants mail printing to be allowwed
	  jrst hakai3	;  then don't defer hacking this interrupt
hakai4:	    tdne i3,[%pidwn\%pidbg]  ;if we have something to print anyway
	      jrst hakai2  ;  then don't defer this
	    trne i3,%picl1  ;if we have SENDS
	      skipn clirpx  ;  and there's sends we haven't seen yet
	        caia
		  jrst hakai2  ; then don't defer this since we'll print anyway
	    tlz i3,(%pidir)  ;don't handle the mail interrupt at this time
	    setom haktyp  ;   but note that there's something to do
hakai3:	jumpe i3,hakha8	;If there's no interrupts left, don't feep!
hakai2:	tdnn i3,[%pidwn+%pidbg]	   ;If we're going to handle these
	  jrst hakai7		   ;  Then always do SEND's and mail
	move a,sendrp
	skipl ddtty		   ;Not at DDT level?
	  aose a		   ;  And ..SENDRP/-1
	    caia
	      tdz i3,[%pidir+%picl1]  ;Then don't handle SEND
	
hakai7:	skipe getty		   ;if printing terminal
	  skipge ddtty		   ;  or the TTY isn't stolen
	    andcam i3,hakint  ;say these ints are now handled, don't repeat
	
	tlne i3,(%pidir)  ;if a write has been done to our file directory
	  call malhak	;  check and see if maybe it was mail for us
	tdnn i3,[#%pidir]  ;if there are no other interrupts
	  jrst hakha8	;     then don't steal TTY and feep
	tlze i3,%pjdbg	;if a %PIDBG has been received
	  call hakdbg	;  print a message saying debugged or debugged-no-more
	trze i3,%picl1	;if we have messages to print, don't clear the bit
	  call cliprt	;  print any messages that may need printing
	trne i3,%pidwn	;clear %PIDWN's now since they get repeated by the
	 call hakded	;  system.
HAKHA8:	ANDCAM I3,HAKINT
	skipn alarmv	;IF ALARM IS SET, SEE IF IT HAS TRIPPEDD.
	  jrst hakhau
	call alarmh
hakhau:	SETZ U,		;IF ANY JOBS ARE WAITING TO RETURN, SAY SO.
HAKHA9:	SKIPE UINT(U)
	 CALL HAKJWT
	ADDI U,USRLNG
	CAIGE U,USREND
	 JRST HAKHA9
	SKIPE JREMEM	;REPORT ANY INTERRUPTS FROM :FORGOTTEN JOBS.
	 CALL HAKJRM
	SKIPGE TTYSCM
	 JRST HAKHAN
	SKIPE GETTY
	 SKIPL TTYSTL	;IF TTY IS DISPLAY BELONGING TO INFERIOR, & NOT IN COM MODE,
HAKHAN:	  SKIPGE ALARMV	;OR THERE'S AN ALARM,
	   JRST [CALL HAKWT0 ;TYPE THE MESSAGES AGAIN LATER.
		 JRST .+2]
	SETZM ALARMW
	CALL ALARM4
HAKHAM:	SETZ U,			   ;PROCESS ANY PENDING .BREAK 12,'S.
HAKHA2:	MOVE A,UIACK(U)
	TRNN A,20000		   ;IF JOB WANTS TO DIE,
	  SKIPE UHACK(U)	   ;OR DID A .BREAK 12,
	    PUSHJ P,HAKHAL	   ;HANDLE THIS JOB.
	ADDI U,USRLNG
	CAIGE U,USREND
	  JRST HAKHA2
	SKIPL HAKIOP	;IF PUSHED USR CHNLS, POP THEM.
	  JRST HAKHA3
	.IOPOP USRO,
	.IOPOP USRI,
HAKHA3:	SETZM HAKIOP
	CALL TYOFRC	;IF USING BLOCK MODE TYPEOUT, FORCE IT OUT.
	.LISTEN A,	;MAKE SURE INFERIOR DOESN'T SCREW THINGS BY .RESET OF TTY.
	SETZM HAKING
	REST MORPRP
	REST A		;RESTORE TTYFLG, BUT DON'T WIPE OUT
	ADDM A,TTYFLG	;ANY ^V OR ^W THAT INT'D DURING HAKKAH.
	REST 40
	REST UUOH
	HRLZI 16,-14(P)
	HRRI 16,A
	BLT 16,16
	SUB P,[15,,15]
	SKIPGE HAKRQ	;IF MORE RQ'S MIGHT HAVE BEEN QUEUED,
	 JRST HAKKAH	;PROCESS THEM.
.SEE %SAVE1	;WHICH STEALS THE TTY IF NEC.
%SAVEX:	SKIPN TTYSTL
	 JRST %SAVE5
	HLLZS TTYSTL
	SKIPN NOTTY
	 SKIPN OCOFL
	  JRST %SAVE4
	SYSCLE CNSSET,[%CLIMM,,TYIC ? [-1] ? [-1] ? [-1] ? TTYSCM] ;RESTORE STATE OF OCO.
%SAVE4:
	SKIPL TTYSTL	;IN HAKKAH, RETURN TTY IF STOLEN.
	 JRST %SAVE5
	AOSN CTLZFL	;IF USER TYPED ^Z WHILE DDT HAD STOLEN THE TTY,
	 .USET USRI,[.SIPIRQ,,[%pic.z]] ;PASS THE ^Z WHERE IT WAS MEANT TO GO.
	SETZM TTYSTL	;TTY NO LONGER STOLEN.
	SETZM DDTTY	;NO LONGER POSESSED.
	.ATTY USRI,
	 JFCL
	;;IF TTY BELONGS TO AN INFERIOR, MAYBE HE WANTS %TBINF OFF.
	SAVE A
	MOVE A,CU
	MOVE A,URANDM(A)
	TRNE A,%URFRZ
	 JRST POPAJ
	REST A
;OTHERWISE, TURN %TBINF ON SO INFERIORS CAN TYPE OUT.
%SAVE5:	SYSCLE USRVAR,[%CLIMM,,%JSELF ? ['TTY,,] ? 0 ? [TLO %TBINF]]
	RET

malck1:	syscal OPEN,[ %clbit,,.bii ? %climm,,fdrc ? [sixbit /DSK/] ? xuname
		      [sixbit /MAIL/] ? hsname]	 ;open the mail file
	  ret	;  not there?  can't be what was written
	syscle RFDATE,[ %climm,,fdrc ? %clout,,a]  ;get the date on the file
	jrst popj1

malckq:	call malck1	;open the mailfile and get the write-date into A
	  ret		;  not there?  can't be what was written, punt
	camn a,mailtm	;did it come?
	  ret		;  no, punt
	movem a,mailtm	;remember last time mail gotten
	skipe haking	;if in HAKKAH
	  call %save1	;  beep and get the TTY
	skipg mailnt	;does he want the from info?
	   ret		;  no, just wanted to feep at him, give up now
	call fdrco1	;init the buffering
	save fdrcip	;Ptr to first line of the message.
	move a,[440700,,[asciz /RECEIVED: /]]
	call hakml5	;Network headers might begin with Received lines.
	  caia
	    jrst [ rest a ? jrst hakml6 ]
	rest fdrcip	;Try looking at the first line again.
	move a,[440700,,[asciz /DATE: /]]
	call hakml5	;Network header might also begin with Date field.
	  caia		;  comparison fails, must be ITS format
	    jrst hakml6	;    comparison win, network format
	call fdrco8	;re-start at the beginning of the buffer
	7type malfrm	;mail from!
	movei a,"@	;FOO@MIT-AI, type up to the @
	call hakmlt	;not inclusive
	  jrst hakml7	;  EOF or EOL
	ctype "@	;type the @
	movei a,40	;and now type up to the space
	call hakmlt	;watching for EOF or EOL (bad format message!)
	  jrst hakml7	;  barf
	call malfll	;flush a line
	  jrst hakml7	;  huh?
	movei a,1	;ITS header has one line seen already
	call hakml8	;Say how many more lines there are.
	7type [asciz /
/]
	ret		;Done, go close up.

;;; compare string in A with buffer.  The stuff from the buffer is
;;; uppercasified before comparison, so the string pointed to by A had better
;;; be all upper-case.

hakml5:	ildb c,a	;get a comparison character
	jumpe c,popj1	;all the way through, that's a match
	call fdrci	;read in the character
	  ret
	cail d,"a	;uppercasify
	  caile d,"z
	    caia
	      subi d,40
	cain c,(d)	;match?
	  jrst hakml5	;  yes, keep comparing
	ret
;;; parsing error!
hakml7:	7type [asciz /[Bad format message in mail file]/]
	ret		;give up

;;; network format!
hakml6: setzm hakmct	;Count discarded header lines.
hakm61:	call malfll	;Flush up to second line.
	 jrst [	move a,hakmct	;See how many lines parsed.
		cail a,30.	;If already went through thirty
		 jrst hakml7	; Parse runs out, probably bad format.
		call fdrco1	;Else re-fill the buffer.
		jrst .+1 ]	;And look at the next line.
	aos hakmct	;Count another header line hacked.
	save fdrcip	;Remember this line in the buffer.
	move a,[440700,,[asciz /FROM: /]]
	call hakml5	;If this is the FROM line.
	 caia		; we know who the sender is.
	  jrst [ rest a ? jrst hakm62 ]
	rest fdrcip	;Else maybe it is a SENDER line.
	move a,[440700,,[asciz /SENDER: /]]
	call hakml5	;Try that on for size.
	 jrst hakm61	;  Nope, skip this line and try the next one.
hakm62:	7type malfrm	;Got it.  Type the "Mail from "
	movei a,^M	;up to the end of the line should be the sender
	call hakmlt
	  jrst hakml7	;  barf, how many ways are there to lose?
	aos hakmct
	move a,hakmct	;2 lines of network header have been parsed
	call hakml8	;Print out who it is from and length
	skipn mailns
	 jrst hakm68
	.acces fdrc,[0]	;Rewind the mailbox.
	call fdrco1	;Init the buffering.
	setzm hakmct	;Now search for Subject line.
hakm63:	aos hakmct	;Count header lines examined.
	call malfll	;Flush to next line.
	 jrst [	cain d,^_	; If end of message
		 jrst hakm68	;  give up.
		move a,hakmct	; If end of buffer
		cail a,30.	; and already checked 30 lines
		 jrst hakm68	;  give up.
		call fdrco1	; Else re-fill the buffer.
		jrst .+1 ]	; And look at the next line.
	move a,[440700,,[asciz /SUBJECT: /]]
	call hakml5	;Is this is the SUBJECT line?
	 jrst hakm63	; No, try the next one.
	7type [asciz / Re: /]	;Got it.
	movei a,^M	;Up to the end of the line should be the subject.
	call hakmlt	;Print it.
	 cai		; Eh?
hakm68:	7type [asciz /
/]
	ret		;All done, go close up, etc.


;;; Type out how many lines in the message.
;;; A/ count of lines already skipped
hakml8:	7type [asciz / (/]
hakml9:	call malfll	;print a line
	  aosa a	;  we've got the count, go type it etc.
	aoja a,hakml9	;keep counting
	call g9pnt
	7type [asciz / lines)/]
	ret

malhak:	jsp i4,shfdrx	;save more-relates and FDRC-buffer stuff
	call malckq	;check out the mail situation
	.close fdrc,	;don't need the file anymore
opfdrx:	jsp i4,opfdrc	;pop the FDRC buffer
	insirp pop p,mornro mornhu mormsg morprp
	ret

;; flush a line, ending on EOF or End-of-message, skipping otherwise
malfll:	call fdrci	;get a char
	  ret		;  eof
	cain d,^_	;EOM?
	  ret		;  yes, return on that too
	caie d,^J	;EOL?
	  jrst malfll	;  not yet
	jrst popj1	;yes, skip return

malfrm:	asciz /AMail from /

hakmlt:	call fdrci	;gobble a char
	  ret
	cain d,(a)	;is it the one we're looking for?
	  jrst popj1	;  yes, win
	cain d,^_	;EOM?
	  ret		;  yes, fail return
	call tout	;no, type it out, and
	jrst hakmlt	;keep on trucking


HAKWT0:	.RDTIM A,	;RQ A REALTIME INT 20 SEC FROM NOW,
	LSH A,1
HAKWT1:	ADD A,SENDRP
	MOVEM A,ALARMW
	SKIPG SENDRP	;..SEND HOLDS 0 => USER DOESN'T WANT REPETITION.
	 SETOM ALARMW
	RET

HAKHAL:	SKIPE UINTWD(U)
	 RET		;DON'T DO .BREAK 12, ON STOPPED JOB.
	SKIPGE HAKIOP	;IF WE'VE PUSHED USR CHNLS, RE-OPEN.
	JRST HAKHA4
	SKIPL UCHNLO	;USR CHNLS NOT OPEN => CAN'T USE THEM.
	 JRST HAKHA7
	CAMN U,CU	;ELSE IF NOT FOR CURRENT USR,
	JRST HAKHA5
HAKHA7:	SETOM HAKIOP	;PUSH AND RE-OPEN.
	.IOPUSH USRI,
	.IOPUSH USRO,
HAKHA4:	move a,urandm(u)  ;check if this isn't supposed to be an inferior
	trne a,%urfrn
	  erloss (u)	;  We blew it somewhere and reowned it!
	MOVE A,[.BII,,USRI]
	TSCALL OPNUSR
	MOVE A,[.BIO,,USRO]
	TSCALL OPNUSR
HAKHA5:	MOVE A,UIACK(U)
	TRNN A,20000	;KILL THE JOB IF THAT'S WHAT IT WANTS.
	 JRST HAKHA6
	CAME U,CU	;(BUT DON'T KILL CURRENT JOB HERE)
	PUSHJ P,MRDR	;THIS ALSO CLEARS USER VARS, SYMS ETC.
	POPJ P,

HAKHA6:	HRRZ A,UHACK(U)
	MOVEI C,0
	PUSHJ P,RFETCH
	  JRST HAKERC
	TLNN D,200000
	  JRST HAKONE
	TLNN D,400000
	  JRST HAKERC
	MOVE C,D
HAKNXT:	HRRZ A,C
	PUSHJ P,RFETCH
	  JRST HAKERC
HAKONE:	SAVE C
	HLRZ A,D
	TRZ A,400000
	JUMPE A,HAKERR
	CAMLE A,HAKDSL
	 JRST HAKERR
	HRRZ B,HAKDSP-1(A)
	JUMPGE D,HAKON1
	HLRZ B,HAKDSP-1(A)	;WRITING, USE LH OF DISP WD.,
	CALL TSTPRM		;BARF IF JOB CAN'T WRITE IN DDT.
	 JRST HAKPRM
HAKON1:	MOVEI A,(D)
	JRST (B)

HAKDSP:	WSTRT,,RSTRT
	WLFILE,,RLFILE
	HAKERR,,RSYML
	WSYMV,,RSYMV
	WSTR,,RSTR
	HAWFIL,,HARFIL
	HACY,,HA2ACY	;7   - ^Y OR $$^Y.
	HAKERR,,HALK	;8.  - CONVERT VALUE TO SYM & OFFSET.
	HAKERR,,HAKERR	;9.  - READ OR WRITE XUNAME (FLUSHED).
	HAKERR,,HAKERR	;10. - READ OR WRITE JOB'S XJNAME (FLUSHED).
	HAKERR,,HARLJB	;11. - READ USR IDX OF PREVIOUSLY SELECTED JOB.
	HAWRND,,HARRND	;12. - READ OR WRITE WORD OF RANDOM INFO.
	HAKPUR,,HAKPUR	;13. - Unpurify page of inferior.
	HAKERR,,HAKHSN	;14. - Lookup HSNAME for a user
	HAKERR,,HAKMAL	;15. - Lookup mail dir/xuname for a user
HAKDLG==.-HAKDSP
	BLOCK 2		;FOR PATCHING.
HAKDSL:	HAKDLG

HALERR:	SUB P,[1,,1]
HAKERR:	REST C
HAKERC:	CALL HAKWBK	;WRITE BACK POINTER IF BLOCK MODE.
	.USET USRI,[.ROPTIO,,A]
	TLNE A,OPTOPC	;IF JOB WANTS PC SOS'D, DO SO FOR IT.
	 SOS PPC(U)
	MOVE A,[-4,,HAKBLK-1]
	JRST HAKERT	;GIVE JOB AN ILOPR INTERRUPT & RESTART IT.

HAKPRM:	REST C		;HERE IF JOB WANTS TO WRITE & ..PERMIT FORBIDS IT.
	CALL HAKWBK	;WRITE BACK BLOCK-MODE AOBJN IF NEC.
	SETZM UHACK(U)	;CLEAR THE JOB'S .BREAK 12 REQUESTS
	MOVNI D,4
	MOVEM D,UINT(U)	;SAY IT IS TRYING TO RETURN BECAUSE OF ..PERMIT.	
	SKIPN STOPWT
	 CAME U,CU	;IF IT CAN'T RETURN RIGHT AWAY,
	  JRST HAKPR1
	SETOM HAKTYP	;MAKE HAKKAH LOOP AROUND AGAIN AND NOTIFY USER.
	SETOM HAKRQ
HAKPR1:	.SUSET [.SIIFPI,,[1_TYIC]]	.SEE TSIN23 ;MAYBE SET FLSTOP.
	RET

;IF BLOCK MODE, WRITE BACK AOBJN POINTER.  IF UNIT MODE, DO NOTHING.
HAKWBK:	JUMPGE C,CPOPJ
	MOVE D,C
	HRRZ A,UHACK(U)
	PUSHJ P,RDEP
	 JFCL
	RET

HARRND:	MOVE D,URANDM(U)
	AND D,[%URUSR]
	JRST HAREAD

RSTRT:	SKIPA D,STARTA(U)
RSYML:	MOVE D,JOBSYM(U)
HAREAD:	PUSHJ P,RDEP
	 JRST HAKERR
HAKWIN:	REST C
	JUMPE C,HAKXIW
	AOBJN C,HAKNXT
	MOVE D,C
	HRRZ A,UHACK(U)
	PUSHJ P,RDEP
	 JRST HAKERR
HAKXIW:	PUSHJ P,INSRTB	;PUT BPTS IN UNLESS ALREADY IN.
	SETZM UHACK(U)
	SKIPE INCNT(U)
	 SKIPA A,[-3,,HAKBLK]
	  MOVE A,[-2,,HAKBLK+1]
HAKERT:	SKIPL SYSUUO(U)
	 CALL OPTTRS
	MOVE B,PPC(U)
	.USET USRI,A
	POPJ P,

OPTTRS:	.USET USRI,[.ROPTIO,,B]
	TLO B,%OPTRP
	.USET USRO,[.SOPTIO,,B]
	RET

	.SIPIR,,[%PIILO]
HAKBLK:	.SIPIR,,[%PI1PR]
	.SUPC,,B
	.SUSTP,,[0]

HARLJB:	HRRZ D,JPDLP	;HERE TO GIVE USER THE INDEX OF THE PREVIOUSLY SELECTED JOB.
	SOS D
	CAIGE D,JPDLB
	 ADDI D,JPDLL
	MOVE D,(D)	;D GETS DDT'S TABLE INDEX.
	MOVE D,UIND(D)	;NOW GET SYSTEM JOB NUMBER.
	JRST HAREAD

; Job wants to set the name of the file he was loaded from.  Set both sets
; of names to oblige him. 
WLFILE:	SETZM UFLSYS(U)		; Don't let $Y change UFILE
IRPS X,,0 3 1 2
	PUSHJ P,FETDH
	MOVEM D,UFILE+X(U)
	MOVEM D,UFNAMD+X(U)
	AOS A
TERMIN
	JRST HAKWIN

; Job wants to read the name of the file he was loaded from.  If he wasn't
; actually loaded from anywhere just return the defaults.
RLFILE:	SKIPN D,UFNAMD(U)
	 JRST RLFIL1
	PUSHJ P,DEPNXT
IRPS X,,3 1 2
	MOVE D,UFNAMD+X(U)
	PUSHJ P,DEPNXT
TERMIN
	JRST HAKWIN

RLFIL1:
IRPS X,,0 3 1 2
	MOVE D,UFILE+X(U)
	PUSHJ P,DEPNXT
TERMIN
	JRST HAKWIN

DEPNXT:	PUSHJ P,RDEP
	  JRST HALERR
	AOJA A,CPOPJ

HARFIL:	
IRPS X,,0 3 1 2
	MOVE D,PFILE+X
	PUSHJ P,DEPNXT
TERMIN
	JRST HAKWIN

HAWFIL:	
IRPS X,,0 3 1 2
	PUSHJ P,FETDH
	MOVEM D,PFILE+X
IFE X,	MOVEM D,FFILE
IFE X-3,MOVEM D,FFILES
	AOS A
TERMIN
	JRST HAKWIN

FETDH:	PUSHJ P,RFETCH
	JRST HALERR
	POPJ P,

HAWRND:	CALL FETDH	;WRITE URANDM WORD (OR SUCH BITS AS USER IS ALLOWED TO WRITE).
	XOR D,URANDM(U)
	AND D,[%URUSR]
	XORM D,URANDM(U)
	JRST HAKWIN

WSTRT:	PUSHJ P,FETDH
	MOVEM D,STARTA(U)
	JRST HAKWIN

HACY:	CALL FETDH	;READ USER'S AOBJN PTR,
	JRST NCTLY1	;LOAD SYMS THRU IT.

HA2ACY:	CALL FETDH	;GET THE AOBJN,
	JRST N2ACY1	;STORE THE SYMTAB.

HALK:	CALL FETDH	;GET THE ARG,
	SAVE D
	SAVE A
	CALL SLUK1	;LOK UP IN SYM TAB.
	 JFCL		;MAY SKIP.
	REST A
	SKIPE D,W1	;IF NO SYM, PUT 0 IN D, ELSE
	 MOVE D,(D)	;GET THE SQUOZE.
	CALL DEPNXT	;THAT IS 1ST VALUE RETURNED.
	REST D		;GET BACK THE ARG,
	SKIPE W1	;IF FOUND A SYMBOL,
	 SUB D,1(W1)	;REPLACE BY OFFSET.
	CALL DEPNXT
	JRST HAKWIN

RSYMV:	JSP I4,%SYM
	PUSH P,A
	SAVE FNYLOC
	CALL SEVL
	 CAIA
	  JRST RSYMV1
	MOVE D,SYM	;READING VALUE OF "." RETURNS ADDR. OF OPEN LOCATION.
	CAMN D,[SQUOZE 0,.]
	 JRST [	MOVE D,LLOC ? JRST RSYMV1]
	CALL OPLK2
	 JRST SYMLOP
	  JFCL
RSYMV1:	REST FNYLOC
	POP P,A
	PUSHJ P,RDEP
	  JRST SYMLOS
	JRST SYMWIN

WSYMV:	JSP I4,%SYM
	PUSHJ P,RFETCH
	  JRST SYMLOS
	PUSHJ P,DEFIN
SYMWIN:	POP P,SYM
	JRST HAKWIN

SYMLOP:	REST FNYLOC
	POP P,A
SYMLOS:	SOS A
	POP P,SYM
	MOVEI D,0
	PUSHJ P,RDEP
	JRST HAKERR
	JRST HAKWIN

%SYM:	PUSHJ P,FETDH
	AOS A
	PUSH P,SYM
	MOVEM D,SYM
	JRST (I4)

RSTR:	SKIPL I3,UCHBUF(U)	;GET AOBJN -> CMD BUFFER,
	MOVEI I3,[0]	;OR -> 0 IF NONE.
RSTR2:	MOVE D,(I3)
	PUSHJ P,DEPNXT	;STORE THE NEXT WORD.
	JUMPE D,HAKWIN	;STOP AFTER STORING A 0.
	PUSHJ P,FETDH
	JUMPN D,HAKWIN	;STOP BEFORE CLOBBERING A NON-0.
	AOBJN I3,RSTR2
	JRST HAKWIN

WSTR:	MOVEI W1,UCHBUF(U)
	PUSHJ P,ELEC0	;FLUSH THE CMD BUFFER.
	CALL JCL3	;CLEAR OPTCMD BIT.
	JRST HAKWIN

;; Unpurify the page that the effective address points to.  Give an MPV
hakpur:	syscal corblk,[ %climm,,%cbndw\%cbndr ? %climm,,%jself ? %climm,,uprpag
			%climm,,%jsnew]
	  erstrt [sixbit /CORE?/]  ;  lost.  Assume unable to get it
	andi a,-2000	;get addr of start of page,
	.acces usri,a
	move b,[-2000,,upradr]
	save xrwi
	setom xrwi	;.iot should skip if it gets an MPV.
	.iot usri,b	;copy old page into fresh page.
	  caia		;no mpv?
	jrst hakerr	;MPV, give an ILOPR

	rest xrwi
	lsh a,-10.
	syscal corblk,[%climm,,%cbndw ? %climm,,usri ? a
		%climm,,%jself ? %climm,,uprpag]  ;replace old page with copy.
	  erloss
	syscal corblk,[%climm,,0 ? %climm,,%jself ? %climm,,uprpag]  ;flush it
	  erloss
	jrst hakwin		   ;we won, continue!

hakmal: call rfetch	;get the ITS name (or 0) from the job
	  jrst hakerr
	setz c,		;0 is ITS name if 0 is ITS name
	jumpe d,hakml0	;0 is OK as an ITS name
	push p,a	;MCHOKP uses A for it's arg
	move a,d	;get that arg now, the ITS name
	call mchokp	;is it an OK machine?
	  jrst halerr	;  nope, give him an error
	move c,a	;OPMAIL expects ITS name in C, MCHOKP returned in A
	pop p,a
hakml0:	aos a		;next word has XUNAME to look up
	call rfetch	;get the XUNAME from the job
	  jrst hakerr
	jumpe d,hakerr	;  0 is illegal as an XUNAME
	move b,d	;OPMAIL expects XUNAME in B, RFETCH returned in D
	push p,a	;OPMAIL clobbers A
	call opmail	;get the HSNAME
	  jfcl		;  don't worry whether it was explicit
	exch a,(p)	;Get address to store in, and save the HSNAME on stack.
	sos a		;back to first word of pair
	move d,c	;RDEP expects value in D, OPMAIL returned ITS in C
	call rdep	;deposit result in inferior
	  jrst halerr	;  must have been pure!  Turkey...
	move d,b	;RDEP expects value in D, OPMAIL returned XUNAME in B
	aos a		;so put it in the second word 
	call rdep	;deposit result in inferior
	  jrst halerr	;  must have been pure!  Turkey...
	pop p,d		;Recover HSNAME from the stack
	aos a		;so put it in the third word
	call rdep	;deposit result in inferior
	  jrst hakerr	;  must have been pure!  Turkey...	
	jrst hakwin	;Win!

;;; This code assumes that no LSRTNS hackery can be going on at the time.
;;; This should be the case if no LSRTNS hackery is done at interrupt level.

hakhsn: call rfetch	;get the ITS name (or 0) from the job
	  jrst hakerr
	setz c,		;result 0 if we have 0 now
	jumpe d,hakhs0	;0 is OK for ITS name
	save a		;need A for MCHOKP, so save the address
	move a,d	;A <- ITS name (check to be sure)
	call mchokp	;Is this a real ITS?
	  jrst halerr	;  no, give ILOPR
	move c,a	;GETHS0 expects ITS name in C, MCHOKP returned in D
	rest a		;recover address
hakhs0:	aos a		;next word has XUNAME to look up
	call rfetch	;get the XUNAME from the job
	  jrst hakerr
	move b,d	;GETHS0 expects XUNAME in B, RFETCH returned in D
	push p,a	;GETHS0 clobbers A
	.iopush fdrc,	;mustn't clobber the channel!
	call geths0	;get the HSNAME
	  jfcl		;  don't worry whether it was explicit
	.iopop fdrc,	;Restore the channel
	pop p,a
	move d,c	;RDEP expects value in D, GETHS0 returned HSNAME in C
	call rdep	;deposit result in inferior
	  jrst hakerr	;  must have been pure!  Turkey...
	jrst hakwin	;Win!


;HANDLE CLI INTERRUPT BY COPYING MESSAGE INTO <cladir>;<UNAME> SENDS
;AND REQUESTING THAT HAKKAH LEVEL TYPE THE MESSAGE OUT OF THE FILE.
;IF THE MESSAGE STARTS WITH A RUBOUT, THE USUAL PREFIX "MESSAGE FROM .."
;IS NOT CREATED.

HAKCLI:	setzm dskful	;DSK not known to be full, yet at least
	SAVE C
	SAVE D
	SAVE I4
	save a
	save b
	SAVE TOUTXQ
	JSP I4,SHFDRC	;PUSH FDRC AND FDRC BUFFER.
	.IOPUS UTOC,
	.suset [.sidf1,,[%picli]]  ;turn off ints while checking for more CLI's
	setom tquitr	;until we turn off flag saying we have some pending
			;to avoid losing messages when the interrupt comes
			;between the open failing and the clearing the bit.

CLIBRR:	CALL FDRCOP	;READ THE CLA:
	 ['CLA,,]
	 JRST CLIBRX	;NONE, GIVE UP.
	HRRZ D,FDRCEP	;NOTHING IN THE FILE => GIVE UP.
	CAIG D,FDRCTB+1
	 JRST CLIBRX


	aos clirpc	;Count of messages to print each time
	aos clirpx	;count of messages to print on return to DDT

	move d,[call cliwrt]  ;Since we must buffer rather than write to DSK:
	movem d,toutxq	;output heading & senders name to CLI buffer.
	move d,fdrctb	;save the UNAME
	movem d,cliunm	;and JNAME of the sending job for tracing
	move d,fdrctb+1	;unwanted messages
	movem d,clijnm

	MOVEI C,2
	ADDB C,FDRCIP	;SKIP OVER UNAME AND JNAME OF SENDER - DON'T READ THEM AS ASCII.
	ILDB D,C	;IF 1ST CHAR OF MESSAGE IS RUBOUT, JUST SKIP IT.
	CAIN D,177
	 JRST [	MOVEM C,FDRCIP
		JRST CLIBR5]
			;the following location named because MRC wants to
			;patch it out!

clibr6:	7TYPE [ASCIZ/Message from /]	;OTHERWISE, MAKE USUAL HEADER WITH
	MOVE D,FDRCTB			;NAME OF SENDING JOB.
	PUSHJ P,SIXTYP	;PRINT SENDER'S UNAME & JNAME.
	PUSHJ P,TSPC
	MOVE D,FDRCTB+1
	PUSHJ P,SIXTYP
	PUSHJ P,CRF

clibr5:	call fdrci	;Get a char
	  jrst clibr2	;  (no more!)
	call cliwrt	;Write the char to our special buffer
	cain d,^_	;Control-underscore?
	  call cliwrt	;  Double it up so we can detect them in messages
	jrst clibr5	;try next char

clibr2:	7type [asciz /
/]			;terminate the message
	setzm toutxq	;and no more typeout to the CLI buffer

	.suset [.sadf1,,[%picli]] ;interrupts, the critical code is past
	setzm tquitr

	sysclo OPEN,[[.uao,,utoc] ? ['DSK,,] ? ['_DDT..] ? [':SENDS] ? cladir]
	move a,cliptr	;calculate the char address of the end of the messages
	call charad
	move c,b	;remember it for latter
	move a,clibeg	;Now calculate the address of the beginning
	call charad
	sub c,b		;C gets # of chars in buffer
	move d,clibeg	;D gets pointer to start of it all
clioc0:	syscal siot,[ %climm,,utoc ? d ? c]  ;And send the messages out!
	  jrst clierr	;  IOC error, punt writing and just gripe
	syscal open,[ %clbit,,.uai ? %climm,,fdrc  ;open the old SENDS file
		      [sixbit /DSK/] ? runame ? [sixbit /SENDS/] ? cladir]
	  jrst clibr4	;there is none yet, so no more to copy.

clibr8:	move d,[440700,,FDRCTB]	   ;Pointer to buffer
	movei c,fdrcl*5		   ;# of chars that will fit in buffer
	sysclo siot,[%climm,,fdrc ? d ? c]
	movei i4,fdrcl*5	   ;I4 gets chars in buffer
	subi i4,(c)		   ;minus any left empty
	move d,[440700,,fdrctb]	   ;and output the buffer
clioc1:	syscal SIOT,[%climm,,utoc ? d ? i4]
	  jrst clierr		   ;  IOC error, just complain & print
	jumpe c,clibr8		   ;and output next batch, if wasn't EOF


;here when have finished writing the new sends file.

clibr4:	.suset [.sidf1,,[%picli]]  ;If we allowed quits we'd lose a message; 
	setom tquitr	;if we allowed new CLI's we'd forget we got them.

	syscal RENMWO,[%climm,,utoc ? runame ? [sixbit /SENDS/]]
	   jfcl		;  shouldn't happen, but don't lose messages!

	.close utoc,
	jrst clibrr	;see if another message came in since the interrupt.

clierr:	syscal delewo,[%climm,,utoc]  ;flush the output file
	  jfcl
	.close utoc,
	call %save1	;steal the TTY if not already stolen
	skipe dskful	;Was disk full detected?
	  7type [asciz /A
[Disk full!  Please delete any unnecessary files!]
/]			;Could be directory full or no channels, but....
	setzm tquitr	;Quits are allowed now
	7type [asciz /A
Unable to write SENDS file, held messages follow:
/]
	jrst clier1	;Don't flush buffer, and request later typeout of msgs
	
clibrx:	movei d,%picli
	andcam d,hakint	;No more CLI pending

	hrr d,cliend	;end
	hrrz a,clibeg	;beginning
	push p,clibeg	;remember the beginning; ELEC0 will screw it up
	subi d,(a)	;size
	movns d		;-size
	hrli a,(d)	;AOBJN ptr to CLI buffer
	push p,a	;put it on the stack where we can point to it
	movei w1,(p)	;w1 gets ptr to AOBJN ptr to CLI buffer
	call elec0	;make the CLI buffer go away
	pop p,a		;clean up the stack
	pop p,a		;recover the beginning
	movem a,clibeg	;and start it all there
	movem a,cliptr
	movem a,cliend

;Come here after printing error message on disk full

clier1:	movei d,%picl1	;tell HAKKAH that there's CLI messages to print
	iorm d,hakint
	iorm d,i3
	setom haktyp	;Say there's something to type.

	.suset [.sadf1,,[%picli]]  ;interrupts are OK now
	setzm tquitr	;since the bit will be set and not cleared

	.IOPOP UTOC,
	JSP I4,OPFDRC
	REST TOUTXQ
	rest b
	rest a
	REST I4
	REST D
	REST C
	ret		;All done.

;;; CLIWRT writes a character in D to the CLI buffer

cliwrt:	push p,a
	move a,cliptr	;get the pointer
	camn a,cliend	;is it to the end yet?
	  call clibgt	;  yes, make more room
	idpb d,cliptr	;salt away the char.
	pop p,a
	ret

;; CLI buffer get...add CLISIZ more words to the CLI buffer
;; The CLI buffer is permanantly in existance (although maybe of zero size)
;; to allow for future improvement of queuing messages to be written to
;; disk.
;; What the saving of CLIBEG and friends is about is that we APPEND
;; to the existing buffer by forcing everything after to move.

clibgt:	save d
	save w1
	hrrz a,cliend	;Use the beginning so as to be sure to relocate all
	save cliptr	;hole0 will clobber hole0, maybe clibeg
	save clibeg	;so prevent lossage
	push p,a	;and put the AOBJN ptr on the stack for HOLE0 can hack
	movei w1,(p)	;W1 -> AOBJN ptr to space
	movsi a,-clisiz	;ask for CLISIZ more space
	call hole0	;ask for more space
	pop p,a		;flush the temporary AOBJN ptr from the stack
	rest clibeg
	rest cliptr
	rest w1
	rest d
	ret		;t-t-t-that's all, f-f-f-olks

IFN 0,[
;;; BFALOC takes a buffer-pointer in A and allocates additional space for that
;;; buffer (amount to grow by is stored in the buffer).

;;; To do:  Define a BUFFER <increment>,[<no-relocate-on-grow>][relocate]
;;; Have it thread the buffers, and write code in RELOC which follows the
;;; threads for the buffers, and relocates those pointers.
;;; Maybe have it instead check for byte-pointers which are AFTER the current
;;; Byte Pointer, where "current" Byte Pointer is a slot in the buffer.

bfaloc:	save c
	save d
	save w1

	move c,%bfsav(a)   ;Get an AOBJN ptr to buffer pointers not to be
			   ;moved with the growth of the buffer
	jumpge c,nobsv0	   ;if none to be saved, just punt that part
	hlre d,c	   ;get -<# of frobs to save>
	movns d		   ;get positive #!
	movei w1,1(p)	   ;get where to move them to.
	hrli w1,(c)	   ;get  from,,to
	hrl d,d		   ;get size,,size
	add p,d		   ;make room on the stack
	skipl p		   ;check for PDL overflow
	  .suset [.sipirqc,,[%pipdl]]  ;lost, give interrupt
	blt w1,(p)

nobsv0:	save a		   ;remember which buffer we hack!

	move w1,%bfbpt(a)  ;get the AOBJN ptr to the buffer's extent
	movs a,%bfsiz(a)   ;get <size to grow by>,,0
	movns a		   ;get -<size to grow by>,,,0
	call hole0	   ;ask for more space

	rest a		   ;recover which buffer we hack!
	move c,%bfsav(a)   ;get AOBJN ptr to frobs on the stack to pop
	jumpge c,nobsv1	   ;if none, nothing to remove from the stack

	hlre d,c	   ;get -<# of frobs on the stack>
	movns d		   ;get pos #!
	hrl d,d		   ;get size,,size of block on PDL
	hrlz w1,c	   ;prepare the AC for the BLT
	hrr w1,p	   ;<block>,,<top of pdl>
	addi w1,1(d)	   ;<block>,,<saved block>
	movss w1	   ;<saved block>,,<block>
	addi c,-1(d)	   ;x,,<end of block>
	blt w1,(c)	   ;move the saved block home
	sub p,d		   ;done, pop the stack

nobsv1:	rest w1
	rest d
	rest c
	ret		;t-t-t-that's all, f-f-f-olks
]; End IFN 0,

;At HAKKAH level, print :SENDS received out of DSK:<cladir>;<uname> SENDS
;CLIRPC has the number of messages to be printed.
;CLIRPX has number of messages to be printed on return to DDT

	
cliprt:	move c,sendrp	;check out if we really want to print now
	aose c	        ;is SENDRP/-1 ?
	  jrst cliprg	;  No, handle it now
	skipl ddtty	;Unless DDT has the TTY already
	  ret		;  Don't print anything now
cliprg:	jsp i4,shfdrx	;save more-related stuff and FDRC buffer stuff
	movn c,clirpx	;Total number of messages since left DDT
	skipge ddtty	;If do not have the tty
	 skipge ttystl	; or have it only because stole it
	   movn c,clirpc	;then use number to print
	jumpe c,cliptx	;if the count is zero, don't print any at all

	call %save1	;Steal the TTY if needed, and beep at him

	move a,sendrp	;check out SENDRP
	camn a,[-2]	;-2 means only print them once!
	  setzm clirpc	;  so don't print again.

	skipe getty	;never repeat a msg on a printing tty.
	 skipl ttystl	;if in ddt, printing for last time.
	  setzm clirpc

	skipe getty	;Now do the same for the return-to-ddt message count
	 skipl ttystl	;if in ddt, printing for last time.
	  setzm clirpx

	move a,clibeg	;start our output at the beginning of the buffer
	movem a,cliopt
	movei a,clired	;and start it out from the buffer
	movem a,clisrc	;since there may be stuff there that hasn't made it to
			;the file yet

	move a,smlins	;how many lines before --MORE-- or (n More Lines)?
	skipe getty
	 skipge ttyscm	;don't do --MORE-- on printing TTY's or in com mode.
	  hrloi a,377777

clipr1:	call @clisrc	;Get a character of CLI messages, from whichever source
	  jrst cliprf
	caie d,^_	;^_ => end of one message.
	  jrst clipr3	;  nope, ordinary character
	call @clisrc	;check it to be sure it's not ^_^_
	  jrst cliprf
	caie d,^_	;is it a double ^_?
	  aoja c,clipr2	;  no, it marks the end of the message, on to the next
			;yes, double ^_, just continue with the loop

CLIPR3:	CALL TOUT	;PRINT THE MESSAGE ON THE TTY.
	CAIE D,^J
	 JRST CLIPR1
	SOJG A,CLIPR1	;COUNT OUT THE FIRST C(SMLINS) LINES.
	SKIPL TTYSCM	;IN COM MODE => CAN'T READ ANYTHING.
	 SKIPGE TTYSTL	;THEN, IF IN DDT (THIS IS LAST APPEARANCE OF MSG),
	  JRST CLIPR5
	7TYPE [ASCIZ/--More--/]
	SETOM MORNHU
	CALL MORFL4	;ASK USER IF HE WANTS TO SEE THE REST.
	 JRST CLIPR4	;NO => READ PAST THIS MESSAGE AND PRINT THE OTHERS IF APPRO.
	HRLOI A,377777
	JRST CLIPR1	;YES => PRINT ALL REST OF THIS ONE WITHOUT --MORE--.

clipr4:	call @clisrc	;skip to end of msg without printing, reading from
	  jrst cliprf	;  whichever source is current
	caie d,^_
	  jrst clipr4
	call @clisrc	;check it to be sure it's not ^_^_
	  jrst cliprf
	caie d,^_	;is it a double ^_?
	  aoja c,clipr2	;  no, it marks the end of the message, on to the next
	jrst clipr4	;yes, double ^_, just loop
			
;COME HERE AFTER C(SMLINS) LINES, IF CAN'T READ INPUT.
;JUST TELL USER HOW MANY LINES ARE LEFT IN THE MESSAGE AND GO TO NEXT ONE.
;NOTE THAT A HOLDS 0.
clipr5:	call @clisrc	;count # lines left in message in A.  Read from
	 JRST [	MOVEI D,^C  ;  the current source
		JRST CLIPR6]
	CAIN D,^J
	 AOJA A,CLIPR5
	CAIE D,^_
	 JRST CLIPR5
CLIPR6:	SAVE D		;HERE AFTER COUNTING LINES OF ENTIRE MESSAGE.
	CTYPE "(
	CALL G9PNT	;DECIMAL PRINT ARG IN A.
	7TYPE [ASCIZ/ More Lines)
/]
	REST D		;NOW, HANDLE THE ^_ THAT ENDED THIS MESSAGE,
	CAIN D,^C	;OR, IF EOF ENDED IT, STOP.
	 JRST CLIPRF
	aos c		;count the message

;come here on ^_ -- should we print the next message too?
;note that D contains a look-ahead character
clipr2:	move a,smlins
	skipe getty	;if so, re-init the --MORE-- line counter.
	 skipge ttyscm	;don't do --MORE-- on printing tty's or in com mode.
	  hrloi a,377777
	jumpl c,clipr3	;if not at end, go type our buffered char and loop
cliprf:	call terpri	;come here at eof, or end of last msg to be printed.
cliptx:	jsp i4,opfdrc	;pop FDRC & buffer.
	insirp pop p,mornro mornhu mormsg morprp
	ret

;;; Call CLIRED to get the next character of the CLI buffer.
;;; At the end of the buffer, it will switch CLISRC to FDRCI, after opening
;;; and initializing the FDRCI buffer, etc.

clired:	move a,cliopt	;get our pointer
	came a,cliptr	;is this the end of our buffered messages?
	  jrst [ildb d,cliopt ? jrst popj1]  ;No, give him his character
	
	movei a,fdrci	;Take the rest of our input from the file
	movem a,clisrc

	syscal open,[ %clbit,,.bai ? %climm,,fdrc  ;open the SENDS file
		     [sixbit /DSK/] ? runame ? [sixbit /SENDS/] ? cladir]
	  ret		;  No file, that's EOF!
	call fdrco1	;and initialize the FDRC buffer and copy
	jrst fdrci	;Get our input from the new source

;TELL USER THAT SOME JOB HAS INTERRUPTED.
HAKJWT:	SKIPE STOPWT
	 CAME U,CU	;DON'T TELL THE USER ABOUT A JOB THAT'S GOING TO
	  CAIA		;HAVE A CHANCE TO RETURN RIGHT AWAY WITHOUT USER INTERVENTION.
	   RET
	CALL %SAVE1	;STEAL TTY IF NEC.
	7TYPE [ASCIZ/Job /]
	MOVE D,UJNAME(U)
	CALL SIXTYP
	MOVE D,UPI0(U)
	SKIPN UPI1(U)	;MAYBE JOB MERELY GOT A DTTY INTERRUPT ..
	 CAME D,[%PITTY]
	  JRST HAKJW1
	7NRTYP [ASCIZ/ wants the TTY
/]

HAKJW1:	MOVE D,UIACK(U)	;IF HAKKAH WILL KILL JOB WHEN WE POPJ...
	TRNE D,60000
	 7NRTYP [ASCIZ/ finished
/]
	TRNE D,410000
	 JRST HAKJW2
	MOVE D,UINT(U)
	CAME D,[-2]
	CAIL D,15
	 7NRTYP [ASCIZ/ returning
/]
HAKJW2:	7TYPE [ASCIZ/ interrupted: /]
	MOVE C,UPI0(U)	;ELSE SAY WHAT INTS THE JOB GOT:
	CALL INT0PR
	MOVE C,UPI1(U)
	CALL INT1PR
	JRST CRF

;INFORM THE USER THAT FORGOTTEN JOBS HAVE INTERRUPTED.
;JREMEM HOLDS THEIR INTERRUPT BITS.
HAKJRM:	CALL %SAVE1
	MOVE W1,JREMEM	;GET THE SET OF INT. BITS.
HAKJR2:	MOVN A,W1
	AND A,W1	;GET JUST ONE OF THEM,
	ANDCM W1,A	;MARK IT AS HANDLED
	SKIPE GETTY	;(MAYBE PERMANENTLY).
	 SKIPL TTYSTL
	  ANDCAM A,JREMEM
	SAVE W1
	.UTRAN A	;GET UNAME IN B, JNAME IN C.
	 JRST HAKJR1
	7TYPE [ASCIZ /:Forgotten Job /]
	MOVE D,C
	CALL SIXTYP
	7TYPE [ASCIZ / interrupting
/]
HAKJR1:	REST W1
	JUMPN W1,HAKJR2
	RET

HAKDED:	call %save1	;steal the tty if don't have it
	.DIETIM A,
	JUMPL A,SYSDD2
	CAIL A,60.*60.	;IF GOING DOWN IN <1 MIN,
	 TRZ I3,%PIDWN	;DON'T RETYPE THIS MSG.
	JSP I4,SHFDRC
	MOVE D,A
	PUSHJ P,DDTGDM
	JSP I4,OPFDRC
	jrst terpri

SYSDD2:	MOVE D,ITSNAM
	CALL SIXTYP
	7TYPE [ASCIZ / ITS revived!/]
	jrst terpri

ALARMH:	.RDTIM D,
	LSH D,1		;HAS THE ALARM'S TTIME COME YET?
	CAMGE D,ALARMV
	 RET
	CALL %SAVE1	;YES, SAYY SO.
	SETOM ALARMV	;ALARM STILL SET BUT INT NO LONGER WANTED.
	7TYPE ALARMM
	7TYPE [ASCIZ /
Type :ALARM<CR> to clear/]
	JRST CRF

hakdbg:	call %save1	;steal the tty if don't have it
	syscle sstatu,[%clout,,a ? %clout,,a]  ;get SYSDBG
	call terpri	;be sure to start on a fresh line
	jumpe a,[7type [asciz /ITS not being debugged!!
/]
	         ret]
	7type ddtdbm
	ret

.SEE %SAVEX	;WHICH UNSTEALS THE TTY.
%SAVE1:	skipe ttystl	;is the TTY already stolen?
	  ret		;  yes, don't repeat the performance!
	SYSCLE USRVAR,[ %CLIMM,,%JSELF ? ['TTY,,] ? 0
			[TLZ %TBINF]]  ;Prevent inferiors from typeing
	SKIPE DDTTY	;IF DON'T HAVE TTY, STEAL IT.
	 JRST %SAVE2
	.DTTY USRI,
	 JFCL
	SETOM DDTTY	;HAVE TTY NOW.
	SETOM TTYSTL	;SAY TTY IS STOLEN.
%SAVE2:	SKIPE NOTTY
	 JRST %SAVE3
	SYSCLE CNSGET,[%CLIMM,,TYIC ? REPEAT 4,[ ? %CLOUT,,TTYSCM]]
	MOVE D,TTYSCM	;SAVE CURRENT SETTING OF %TCOCO
	TLON D,%TCOCO	;AND TURN IT ON.
	SKIPN OCOFL
	 JRST %SAVE3
	HRRM P,TTYSTL	;INDICATE THAT OCO SHOULD BE RESTORED.
	SYSCLE CNSSET,[%CLIMM,,TYIC ? [-1] ? [-1] ? [-1] ? D]
%save3:	call terpri
	SKIPE D,BELCNT
	 CTYPE ^G
	SOJG D,.-1
	RET

;SNARF A VALRET STRING FROM JOB THAT'S INTERRUPTING.
UBRKV:	PUSHJ P,INPUSH	; PUSH INPUT SOURCE
	.ACCESS USRI,VALCOM
	SETZM VALCOM
	HRRZ W1,SYMTOP	;READ VALRET STRING ABOVE SYM TABS.
UBRK2C:	HRRZI D,(W1)
	ADDI D,1777
	ANDI D,-2000
	CAIE D,(W1)	;IF NO SPACE THERE,
	JRST UBRK2
	ADDI D,2000
	PUSHJ P,RELC	;GET ANOTHER K.
	SKIPA D,[-2000]	;SAY HAVE 1 K SPACE.
UBRK2:	SUBM W1,D	;D HAS SPACE FOR READING IN.
	HRLI D,(W1)
	MOVS D,D	;D HAS AOBJN -> SPACE.
	SETOM XRWI
	PUSH P,D
	.IOT USRI,D
	JRST UBRK2A	;NO MPV DURING .IOT.
	SETZM (D)	;WAS MPV, PRETEND STRING ENDED NORMALLY WITH 0.
UBRK2A:	POP P,D		;GET BACK PTR -> ENTIRE SPACE.
UBRK2B:	MOVE A,(D)	;LOOK FOR A WORD ENDING WITH A ^@.
	TRNE A,376
	AOBJN D,UBRK2B	;ALSO STOP AFTER WHAT WAS READ IN.
	JUMPGE D,[MOVEI W1,(D) ? JRST UBRK2C]
	SETZM XRWI	;STRING WAS TERMINATED.
	ADDI D,1
	ANDI D,-1
	SUB D,SYMTOP	;GET # WDS READ IN.
	PUSHJ P,ALLOC	;OFFICIALLY ALLOCATE THOSE WDS,
	MOVEM A,INVAOB	;SAVE PTR SO CAN FREE THEM LATER.
	HRLI A,010700
	SOS A
	MOVEM A,INPTR	;SAVE B.P. (MUST BE POSITIVE)
	RET

UBREAK:	PUSHJ P,TTYRET	;CURRENT JOB INTERRUPTED WHEN IT HAD TTY.
UBRK0:	PUSHJ P,UBRKR	;REMOVE BREAKPOINTS, OTHER ESSENTIALS.
	SKIPE VALCOM	;IF JOB DID A HANDLEABLE .VALUE,
	 JRST [	SAVE [NLTL5]
		JRST UBRKV]	;GO SNARF THE STRING.
UBRK0A:	MOVE D,UINTWD(U)
	CAIN D,16
	 JRST UBRK16	;.BREAK 16, MAY NOT WANT CRF.
	call terpri
	CAMN D,[-2]
	 JRST UBRKS	;-2 == RETURN FROM STEPPING, SO KEEP STEPPING.
	JUMPL D,UBRK3	;RANDOM INTERRUPT
	CAIE D,15	;.BREAK 15, AND 17,  TEMP BPTS.
	 CAIN D,17
	  JRST UBRKT
	SETZM USCNT(U)	;STOP MULTI-STEPPING ON NON-STEPPING RETURN.
	JRST UBRK4	;JOB HIT BPT, GO PRINT STUFF.

UBRK16:	SETZM USCNT(U)
	MOVE D,UIACK(U)	;HERE IF JOB DID .BREAK 16,.
	TRNN D,400000
	 JRST UBRK1A
	MOVE A,XECPC(U)
	HRRM A,PPC(U)
	MOVE A,XINTWD(U)
	MOVEM A,UINTWD(U)
UBRK1A:	SAVE D
	CALL RADDT1	;DISPLAY RAID REGS IN SELECTED PLACE.
	REST D
	hrrz d,d	;clear left half, irrelevant
	cain d,500001	;If this is a :OPEN
	  jrst [ 7type [asciz /AFAILED:  /]
		 movei a,opndev	 ;filename block
		 call lfile  ;print the filenames
		 7type [asciz / - /]
		 hrrz a,opnchn	;get the channel
		 call kerr4  ;print the ERR device info on what went wrong
		 jrst nltl4]  ;prompt and return
	cain d,700001	;if this is a :OPEN
	  jrst [ 7type [asciz /A[OPENED:  /]
		 hrrz d,opnchn	;get the inferior's channel # to check
		 tscall infnam	;read in the inferior's channel's filenames
		 movei a,nctltf
		 call lfile  ;print out those filenames
		 ctype "]  ;type the closing bracket
		 jrst nltl4]
	cain d,700000	;If this is an $X return with skip
	  jrst [7type [asciz /A<SKIP>A/]  ;tell the user nicely
	        jrst ubrk1b]  ;And DON'T do the extra skip!
	TRNN D,4000	;UNLESS 2.3 "DON'T TYPE ANYTHING"...
	 CALL CRF
	TRNE D,200000
	  CALL CRF

ubrk1b:	TRNN D,60000
	 JRST [  TRNN D,4000	;NO TYPOUT => DON'T CLOSE .
		 JRST NLTL4
		JRST GSNLRT]
	TRNN D,4000
	 7TYPE [ASCIZ /:KILL /]
	JRST KKILL

UBRKR:	SKIPN OIPCHK(U)	;DO THE ESSENTIAL THINGS TO RETURN CURRENT JOB TO DDT.
	SETZM INCNT(U)
	MOVEI D,0
	EXCH D,UINT(U)
	MOVEM D,UINTWD(U)
	JRST REMOVB

;COME HERE IF JOB WAS STOPPED BY A BREAKPOINT.
UBRK4:	SAVE D
	CALL RADDTC	;DISPLAY THE RAID REGS AT SCREEN TOP, IF DESIRED.
	REST D
	.RDTIME C,
	SAVE C		;(FOR DOZING DOZTIM SECONDS)
	IMULI D,BPL	;BREAK POINT (D IS UINT+1)
	ADDI D,B1ADR-BPL(U)
	HRLI D,400000	;INDICATE ADDR. IS FUNNY (A DDT-REF)
	PUSH P,D
	PUSHJ P,PAD	;PRINT $<N>B WHERE <N> IS BPT. NUM.
	CTYPE ";
	CALL PCPNTI	;LIST THE JOB'S PENDING NONFATAL INTERRUPTS.
	CALL TSPC
	SOS D,PPC(U)	;MAKE RESTART PC -> BPT'ED LOCATION.
	ANDI D,-1
	CALL PCPNT0	;PRINT ADDR OF NEXT INSN, AND NEXT INSN.
	REST A
	HLRZ D,(A)
	JUMPE D,UBRK5
	CALL LCT	;IF THIS BPT IS SET TO OPEN SOME LOC.,
	HLRZ D,(A)
	CALL UBRKNL	;TYPE THE ADDRESS AND OPEN IT.
UBRK5:	REST C		;GET TIME STARTED TYPING.
	MOVE A,UINTWD(U)
	MOVEI B,1
	LSH B,-1(A)
	TDNN B,BPINFL(U)	;AUTO-PROC BPT? ($$P)
	JRST LCTGNR
	MOVE B,UPI0(U)
	TRNE B,%PI1PR	;DON'T AUTO-PROCEED IF WERE ^N'ING.
	 JRST LCTGNR
	PUSHJ P,UBRK6	;SLEEP A WHILE, SEE IF USER TYPED ANYTHING.
	JRST PROCDT
	ANDCAM B,BPINFL(U)	;TURN OFF AUTO-PROC AND STOP.
	JRST LCTGNR

UBRK6:	MOVE D,DOZTIM	;# SECS TO SLEEP.
	MOVNS C		;GET -<TIME STARTED PRINTING>
UBRK7:	CALL LISTN	;TYPED ANYTHING YET?
	 CAIA
	JRST POPJ1	;YES, STOP SLEEPING.
	SOJL D,CPOPJ	;WAITED LONG ENOUGH => GO ON.
	MOVNI A,30.
	ADDB A,C
	.SLEEP A,	;WAIT 1 MORE SEC.
	JRST UBRK7

UBRK3:	skipn hakint	;Are there HAKKAH interrupts?
	  jrst ubrk3x
	setom hakrq	;Be sure they're requested (%PICL1 can hang around)
	setom haktyp	;Say it's OK to type them
ubrk3x:	SETZM USCNT(U)	;LEAVE MULTI-STEP MODE.
	.uset usri,[.rftl1,,d]	;get the fatal interrupts
	move a,d		;remember for later
	tdne d,[#%pic.z#%pidcl]	 ;are there any non-^Z-type first word ints?
	  jrst ubrkp	;  yes, must print
	.uset usri,[.rftl2,,d]	;get the fatal second word ints (no handler)
	jumpn d,ubrkp	;if there are any second word ints, we need printout
	tlnn a,(%pidcl)	;If this is just an ordinary ^_D
	  skipn c.zprt	;  or a ^Z we want to print "[DDT]" for
	    caia	;    don't print the instruction
	      jrst ubrkp  ;    no, so print the instruction
			;it must have been one of ^_D or ^Z
	move d,urandm(u)  ;check for returning ^X
	trne d,%urctx	;is it both waiting for a ^X
	  trnn a,%pic.z	;  And stopped by a ^Z?
	    caia	;    no, one or the other not true, so don't print
	      jrst ubrkp  ;    yes, print!
	move d,%urctx	;no longer returning from ^X, if we were
	andcam d,urandm(u)  ;so clear the bit saying we were
	xct rprmpt	;execute return prompt, in impure for ease of patching
	jrst nltl4	;so just prod and go along.


ubrkp:	SAVE [LCTGNR]	;get ready to print it
PCPNT1:	movei d,%urctx	;So clear the bit saying we were
	andcam d,urandm(u)  ;no longer returning from ^X, if we were
	CALL RADDTC	;IF WANT TO DISPLAY RAID REGS AT SCREEN TOP, DO SO NOW.
	MOVE D,UPI0(U)
	TLNE D,%PJLOS
	 CALL LOS	;HANDLE A .LOSS INTERRUPT.
	MOVE D,UPI0(U)
	TRNN D,%PIMAR	;WAS THE MAR HIT?
	 JRST PCPNT6
	7TYPE [ASCIZ/MAR; /]
	.USET USRI,[.RMARPC,,D]	;TRY TO GET THE PC.
	SAVE D
	ANDI D,-1
	CALL PCPNT7	;TYPE ADDR AND INSN.
	CALL PCPNU	;OPEN ITS ADDRESSED LOCATIONS.
	REST D
	CALL PCPNTM	;IF D INDICATES MAR DIDN'T ABORT INSN, TURN MAR BACK ON.
	MOVNI A,3
	TLNN D,(@)
	 MOVEM A,UINTWD(U)	;OTHERWISE, ARRANGE TO GO 1 INSN, THEN TURN ON MAR.
	MOVE D,MARXCT(U)
	MOVEM D,VALCOM	;IF DESIRED, EXECUTE THE STRING OF DDT CMDS
	SKIPE D
	 CALL UBRKV	;ASSOCIATED WITH MAR.
	CALL CRF
PCPNT6:	MOVE D,UPI0(U)
	TRNE D,%PIIOC	;IOC ERRORS GET SPECIAL TREATMENT
	 CALL [	7TYPE [ASCIZ /IOCERROR: /]
		SETZ C,
		CALL LOSFIL
		JRST KERR3]
	MOVN C,UINTWD(U)
	CAIN C,4
	 7TYPE [ASCIZ /DDTWRITE; /]
	MOVE C,UPI0(U)
	ANDCM C,[%PILOS+%PIMAR+%PIVAL+%PIBRK+%PI1PR+%PIC.Z+%PIIOC+%pidcl]
	CALL INT0PRT
	MOVE C,UPI1(U)
	CALL INT1PRT
	CALL PCPNTI	;PRINT THE PENDING NONFATAL INTERRUPTS,  C NONZERO IF ARE ANY.
	IOR C,UPI0(U)
	ANDCM C,[%PILOS+%PIMAR+%PIVAL+%PIBRK+%PI1PR+%PIC.Z+%PIIOC+%pidcl]
	IOR C,UPI1(U)
	SKIPE C		;IF ANY INTERRUPT NAMES WERE JUST PRINTED ON THIS LINE,
	 CTYPE 40	;FOLLOW THEM WITH SPACE.
	MOVE A,PPC(U)
	MOVE D,UPI0(U)
	.USET USRI,[.ROPTIO,,B]
	TLNE B,OPTOPC
	 ANDI D,%PIBRK\%PIVAL
	TDNE D,IMSKS1	;ANY RANDOM ERROR => BACK UP THE PC.
	 SOS A,PPC(U)
	MOVEI D,(A)
	PUSHJ P,PCPNT5
	HRRM D,PPC(U)
	JRST PCPNT0

PCPNTM:	MOVE A,MARADR(U)
	TLNE D,(@)		;UNLESS WE STOPPED BEFORE THE MARRING INSN,
	 .USET USRI,[.SMARA,,A]	;MAR WAS TURNED OFF WHEN HIT.
	RET

;;; This symbol is stupid -- it's only used in the one place above.
IMSKS1:	2341,,23640	;THESE WANT TO BACK UP THE PC.


;CALL HERE TO HANDLE A .LOSE INTERRUPT IN AN INFERIOR.  THE .LOSE
;SUPPLIES AN 18-BIT LOSSAGE CODE WHICH IS DECODED HERE.
;THE CODES HAVE MEANINGS DEFINED ONLY BY THIS ROUTINE. THEY ARE:
;	0	NON-SPECIFIC ERROR.  MESSAGE IS JUST "ERROR;".
;	1 - 37.	SPECIFIES A 1ST-WORD INTERRUPT BIT (1 + # OF
;		ZEROS ABOVE THE BIT).  DDT PRETENDS THAT THE JOB GOT
;		THAT INTERRUPT AND IT WAS FATAL.  DDT IGNORES THE QUESTION
;		OF WHETHER THE JOB HAS ACTUALLY ENABLED THAT BIT.
;	1000	DDT DESCRIBES THE LAST SYSTEM CALL OR OPEN ERROR
;		THAT THE INFERIOR GOT.
;	1000+N	SIMILAR, BUT N IS USED AS THE ERROR CODE INSTEAD OF
;		THE ACTUAL ONE.
;	1400	DDT DESCRIBES THE LAST SYSTEM CALL ERROR, AND GIVES THE
;		NAME OF THE FILE OPEN ON THE CHANNEL THAT ERROR WAS ON.
;		IF THE PC POINTS AT AN OPEN, THE FILENAMES BEING OPENED
;		ARE DESCRIBED.
;	1400+N	SIMILAR, BUT USES N INSTEAD OF THE ACTUAL ERROR CODE.

LOS:	.USET USRI,[.RVAL,,D]
	HLRZ A,D		;LH OF .VAL LEFT IN A (ADDR OF "LOSING INSN")
	ANDI D,-1		;D NOW HAS THE .LOSE CODE.
	JUMPE D,LOSRND		;HERE HANDLE .LOSE 0
	CAILE D,36.
	 JRST LOS1
	MOVSI A,400000		;HERE HANDLE .LOSE 1 THRU .LOSE 36.
	MOVNS D
	LSH A,1(D)
	IORM A,UPI0(U)
	RET

LOSRND:	7TYPE [ASCIZ /ERROR; /]
	RET

LOS1:	CAIL D,2000		;IS THIS A 1000 CODE?
	 JRST LOSRND		 ;NO OTHERS ARE DEFINED YET.
	7TYPE [ASCIZ /ERROR: /]
	trz d,1000
	CALL LOSINS		;DECODE THE INSN THAT "LOST".
	 TDZA C,C		;C=0 IF INSN ISN'T A .CALL OPEN, RENAME OR DELETE
	  SETO C,		;C=1 IF IT IS.  A HAS ADDR OF SIXBIT NAME OF CALL.
	TRZE D,400		;IF USER WANTS, PRINT NAMES OF FILE BEING HACKED.
	 CALL LOSFIL
	JUMPE D,KERR3		;0 => DESCRIBE THE JOB'S LAST ERROR CODE.
	HRLZ A,D
	JRST KERR2		;ANY OTHER CODE GETS DESCRIBED AS A SYSTEM ERROR CODE.

;EXAMINE THE "INSTRUCTION THAT LOST".  IF IT IS A SYMBOLIC CALL, PRINT THE
;NAME OF THE CALL.  IF IT IS A SYMBOLIC OPEN, RENAME, OR DELETE,
;SKIP RETURN LEAVING A POINTING AT THE WORD HOLDING THE CALL'S NAME,
;WITH SIGN(A) SET IFF CALL IS "OPEN".
LOSINS:	SAVE D
	CALL FETCH		;REMEMBER A HAS LH(.VAL) = ADDR OF INSN THAT LOST.
	 JRST POPDJ
	HLRZ A,D		;GET JUST OPCODE AND AC FIELD OF INSN
	ANDCMI A,(@(17))
	CAIE A,(.CALL)		;WE DON'T YET UNDERSTAND ANYTHING BUT A .CALL 0,
	 JRST POPDJ
	CALL EASETU
	CALL NEFECC		;COMPUTE E.A. OF THE .CALL IN I1.
	MOVEI A,1(I1)
	CALL FETCH		;READ THE WORD THAT SHOULD HAVE THE CALL NAME IN SIXBIT.
	 JRST POPDJ
LOSIN1:	SAVE D
	CALL SIXTYP		;PRINT THE CALL NAME.
	7TYPE [ASCIZ /:  /]
	REST D
	camn d,[sixbit /sopen/]
	 jrst losin2
	CAME D,[SIXBIT/OPEN/]	;DOES THE CALL HAVE ITS FILENAMES INSIDE IT?
	 CAMN D,[SIXBIT /RENAME/]
	  AOS -1(P)		;IF SO, LOSINS SKIPS; ADDR OF CALL NAME STILL IN A.
	CAMN D,[SIXBIT /DELETE/]
LOSIN2:	 AOS -1(P)
	CAMN D,[SIXBIT /OPEN/]
	 HRLI A,400000
	CAME D,[SIXBIT /CALL/]	;OR "CALL" SYSTEM CALL (LIKE AN XCT INSN), TRACE THRU
	 JRST POPDJ
LOSIN3:	ADDI A,1
	CALL FETCH		;FETCH ADDR OF 1ST ARG (THE ACTUAL NAME OF THE CALL).
	 JRST POPDJ
	TLNE D,400000		;GIVE UP IF ONLY 0 OR 1 INPUT ARGS.  (IF 1 ARG,
	 JRST POPDJ		 ;MIGHT BE BETTER TO PRINT IT, BUT SMALL LOSS).
	TLNE D,6000		;SKIP OVER ALL EXCEPT INPUT ARGS TO FIND 1ST INPUT ARG
	 JRST LOSIN3		 ;WE LOSFIL WON'T MISS THEM ANYWAY.	
	SAVE A
	CALL NEFECC		;PERFORM ADDR CALCULATION
	MOVEI A,(I1)
	CALL FETCH		;FETCH THE VALUE OF THE ARG.  LOOP AROUND, USING IT AS
	 JRST POPADJ		;THE "NAME OF THE CALL".  A IS INCREMENTED BY 1
	REST A			;SO THAT LOSFIL WILL SKIP OVER THE ARG WE GOBBLED.
	JRST LOSIN1

;read sname in DEV, FN1, FN2 into NCTLTF, for channel in D
infnam:	calblk RFNAME,[%climm,,usri ? d
		%clout,,nctltf ? %clout,,nctltf+1 ? %clout,,nctltf+2
		%clout,,nctltf+3 ? %clout,,d]

;read sname in DEV, FN1, FN2 into NCTLTF, for channel in A and job in D
infnm1:	calblk RFNAME,[d ? a
		%clout,,nctltf ? %clout,,nctltf+1 ? %clout,,nctltf+2
		%clout,,nctltf+3 ? %clout,,d]

;CALL HERE TO DESCRIBE THE FILE BEING HACKED BY THE "LOSING INSTRUCTION",
;IF DESIRED.  IF C IS NONZERO, THE INSTRUCTION ITSELF CONTAINS THE FILENAMES
;(IT IS A SYMBOLIC OPEN, RENAME OR DELETE).  OTHERWISE, USE RFNAME TO GET THEM.

LOSFIL:	SAVE D
	JUMPN C,LOSFO
	.USET USRI,[.RBCHN,,D]		;READ # OF LOSING CHANNEL
	tscall infnam	;read inferior's channel's filename
	move b,nctltf+3	;get SNAME in B for LFILE0 (ugh)
LOSF3:	MOVEI A,NCTLTF
	CALL LFILE0			;PRINT THOSE FILENAMES.
	7TYPE [ASCIZ / - /]
	JRST POPDJ

;COME HERE FOR OPEN, RENAME, AND DELETE, TO DECODE THE FILENAMES SPECIFIED
;BY THE SYSTEM CALL.  RH(A) POINTS TO THE WORD HOLDING THE SIXBIT CALL NAME.
;SIGN(A) IS SET FOR OPEN ONLY.
LOSFO:	MOVEI C,0		;0 => 1ST ARG WE FIND IS THE DEV NAME.
	TLZE A,400000		;SIGN(A) => THIS IS AN OPEN, SO SKIP THE 1ST ARG
	 SUBI C,1
	MOVSI D,400000		;DEFAULT THE FILENAMES THE WAY SYSTEM DOES,
	MOVEM D,NCTLTF		;IN CASE THE SYSTEM CALL DOESN'T SPECIFY THEM.
	MOVEM D,NCTLTF+1
	MOVEM D,NCTLTF+2
	.USET USRI,[.RSNAM,,B]
LOSFL:	ADDI A,1
	CALL FETCH		;FETCH THE NEXT ARGUMENT.
	 JRST LOSF3
	TLNE D,6000		;IF IT'S NOT AN INPUT ARG, IGNORE IT.
	 JRST LOSF1
	SAVE D
	SAVE A
	CALL NEFECC		;COMPUTE ITS EFFECTIVE ADDRESS.
	TLNN D,1000		;IF ARG IS DIRECT, FETCH WORD ADDRESSED.
	 JRST [	HRRZ A,I1
		CALL FETCH
		 JRST POPADJ
		JRST LOSF2]
	HRRZ D,I1		;IF IMMEDIATE, GET THE ADDRESS.
LOSF2:	REST A
	XCT LOSFT1(C)		;PROCESS THE ARG ACCORDING TO ITS SEQUENCE #.
	REST D			;IF C=3, LOSFT1 JUMPS TO LOSF3 VIA LOSF4.
	AOS C
LOSF1:	TLNN D,400000		;IF THIS WASN'T THE LAST ARG, PROCESS MORE ARGS,
	 JRST LOSFL
	JRST LOSF3		;NOW WE HAVE THE FILENAMES STACHED, SO PRINT THEM.

	JFCL			;IGNORE 1ST ARG OF AN OPEN (CHANNEL #).
LOSFT1:	MOVEM D,NCTLTF		;1ST ARG (2ND IN OPEN) IS DEVICE NAME
	MOVEM D,NCTLTF+1	;2ND ARG (3RD IN OPEN) IS FN1.
	MOVEM D,NCTLTF+2	;3RD ARG (4TH IN OPEN) IS FN2.
	JRST LOSF4		;4TH ARG (5TH IN OPEN) IS SNAME, AND IGNORE THE REST.

LOSF4:	MOVE B,D		;SNAME GOES IN B FOR LFILE0.
	REST D			;ADJUST STACK TO PROPER LEVEL FOR LOSF3
	JRST LOSF3		;GO PRINT NAMES. NO NEED TO DECODE REMAINING ARGS.

;D HAS ADDR OF NEXT INSN TO BE EXECUTED BY INFERIOR.
;PRINT THE PC AND INSN, AND, IF DESIRED, OPEN THE AC AND MEMORY
;LOCATION OF THAT INSTRUCTION.  ALSO TYPE RAID REGS IN OUTPUT STREAM
;IF THAT IS ENABLED.
PCPNT0:	CALL PCPNT7	;FIRST, PRINT PC AND NEXT INSTRUCTION.
	ANDCM D,[0 @-1(17)]
	CAME D,[.CALL]	;DON'T OPEN ANY LOCATIONS FOR A .CALL, SO :CALPRT WINS.
	 CALL PCPNU	;OPEN THE LOCATIONS IT USES, IF DESIRED.
	SKIPN RAIDFL	;NOW, IF RAID REG DISPLAY WANTED,
	 RET
	SKIPE GETTY
	 SKIPN RADTOP	;AND CAN'T OR SHOULDN'T DO IT AT TOP OF SCREEN,
	  JRST RADDIS	;DO IT.
	SKIPE SCROLL
	 JRST RADDIS
	RET

PCPNTR:	SETZ ? SIXBIT/RCPOS/ ? %CLIMM,,TYOC ? SETZM D

;D HAS ADDR OF INSN; PRINT THAT ADDR, AND THE INSN, WITH
;">", ">>", OR ")" BETWEEN THEM.  SETS $Q.
PCPNT7:	SAVE D
	PUSHJ P,PADR	;TYPE ADDR OF NEXT INSN.
	CALL PCPNT3	;TYPE > OR >> OR ).
	REST A
	CALL RFETCH	;GET THE INSN.
	 JRST ERR
	CALL LWTPUT	;SET $Q TO INSN.
	SAVE D
	CALL PIN	;TYPE OUT THE INSN.
	JRST POPDJ

PCPNT3:	MOVEI D,2
	CAMN D,UPI0(U)
	JRST PCPNT2
	MOVEI D,">
	SKIPL NBPTB(U)
	PUSHJ P,TOUT
	JRST TOUT

PCPNT2:	MOVEI D,")
	PUSHJ P,TOUT
	JRST LCT

;CORRECT THE PC IN D IF IT WAS LEFT IN THE MIDDLE OF BREAKPOINT PROCEED.
PCPNT5:	.USET USRI,[.R40ADDR,,A]
	HLRZS A
	SKIPE A
	 SUBI A,20
	CAIE D,BPBLK(A)
	 RET
	MOVEI A,BPBLK+1
	CALL RFETCH
	 RET
	MOVEI D,-1(D)
	RET

;LIST ALL THE JOB'S PENDING NONFATAL INTERRUPTS.
PCPNTI:	.USET USRI,[.RIFPI,,D]
	.USET USRI,[.RPIRQ,,C]
	SKIPN C
	 JUMPE D,CPOPJ
	CTYPE "(
	SAVE D
	CALL INT0PRT
	REST C
	CALL INT1PRT
	CTYPE ")
	MOVEI C,1
	RET

;IF PCPNTF IS NONZERO, AND THE JOB WASN'T STOPPED BY A ^Z,
;OPEN THE LOCATIONS (MEM AND AC, AS APPROPRIATE) REFERENCED BY THE INSN IN $Q.
PCPNU:	MOVEI D,2
	SKIPE PCPNTF	;THEN, IF FEATURE IS ENABLED, AND JOB STOPPAGE
	 TDNE D,UPI0(U)	;IS NOT DUE TO A ^Z,
	  RET
	CALL LCT	;GO AHEAD AND OPEN AC AND MEMORY LOCATION.
	SAVE LWT	;REMEMBER THE INSN SO CAN FIND THE EFF. ADDR.
	LDB A,[331100,,LWT]	;NOW GET THE OPCODE
	IDIVI A,PCPNTP	;USE IT TO INDEX INTO PCPNTB, A VECTOR OF BYTES.
	MOVE A,PCPNTB(A)
	IMULI B,PCPNTS
	LSH A,(B)	;SELECT APPROPRIATE BYTE OF TABLE.
	LSH A,PCPNTS-36.
	SAVE A		;REMEMBER IT TILL WHEN WE HACK THE EFF. ADDR.
	LDB A,[331100,,LWT]
	TRCE A,700
	 TRNN A,700
	  TRCA A,700	;IS THIS INSN A UUO OR IO INSN?
	   JRST PCPNU1	;NO.
	CALL SQZ3D	;YES, CONVERT THE OPCODE TO SQUOZE
	ADD D,[SQUOZE 0,..U]	;NOW WE HAVE ..Unnn
	CALL SEVLD	;IF THAT SYM IS DEFINED,
	 JRST PCPNU1
	ANDI D,1_PCPNTS-1	;USE THE DEFINITION AS THE CODE FOR WHAT TO DO
	MOVEM D,(P)	;INSTEAD OF WHAT WE GOT OUT OF PCPNTB.
PCPNU1:	MOVE A,(P)
	LDB D,[270400,,LWT]
	SKIPN D		;IS THE AC FIELD 0?
	 ANDCMI A,2	;THE 2 BIT OF PCPNTB SAYS OPEN AC UNLESS AC # IS 0.
	TRNE A,3	;THE 1 BIT SAYS OPEN AC IN ANY CASE.
	 CALL UBRKNL	;OPEN THE AC IF DESIRED
	REST A
	REST D
	save a
	save d
	trne a,40	;40 bit says open (ac)
	  jrst [ldb a,[270400,,lwt]
	        call fetchf  ;get the contents of d
		  erloss  ;  can't happen!
		hrrzi d,(d)  ;only RH is address
		call ubrknl  ;print the stack location
		jrst .+1]
	rest d
	rest a
	TRNN A,4	;4 BIT OF PCPNTB BYTE SAYS OPEN THE MEMORY LOCATION.
	 TLNE D,(0 @(17)) ;OTHERWISE, IF INDEXED OR INDIRECT, PRINT E.A.
	  CAIA		;SO IN EITHER CASE, MUST FIRST COMPUTE THE E.A.
	   RET
	SAVE A
	CALL EASETU	;BEFORE THAT, GET JOB'S ACS SO WE CAN FIND EFF. ADDR.
	CALL NEFECC	;COMPUTE THE E.A. IN I1.
	EXCH D,I1
	REST A
	TRNE A,4
	 JRST UBRKNL	;INSN REFERENCES MEMORY, SO OPEN THE E.A.
	7TYPE [ASCIZ/E.A. _ /]
	CALL LWTPUT	;SET $Q.
	JRST PADR

;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.
;10 BIT => ADDRESS FIELD IS R.H. BITS, WHEN IN BIT TYPEOUT MODE.
;20 BIT => ADDRESS FIELD IS L.H. BITS.
;40 bit => Stack instruction, open the stack location

;HANDLE AN INSTRUCTION LIKE "AND" WHICH HAS DIRECT, IMMED., MEMORY AND BOTH.
DEFINE AIMB BITS
	5 ? 1+BITS ? 5 ? 5
TERMIN

PCPNTS==6		;6-BIT BYTES.
PCPNTP==36./PCPNTS	;6 PER WORD.

PCPNTB:	.BYTE PCPNTS
REPEAT 40,5	;USER UUOS: OPEN BOTH.
	4	;.IOT - OPEN MEMORY ONLY.
	4	;.OPEN - MEM ONLY.
	1	;.OPER'S - AC ONLY.
	4	;.CALL'S - MEM ONLY.
	4	;.USET - MEM ONLY.
	4	;.BREAK - MEM ONLY.
	4	;.STATUS - MEM ONLY.
	4	;.ACCESS - MEM ONLY.
REPEAT 30,5	;USER UUO'S MEDIATED BY SYSTEM: 50 THROUGH 77.
	5	;100
	5	;101
	4	;102 LPM
	4	;103 XCTR
REPEAT 24,5	;104-127 UNUSED.
	5	;UFA		130
	5	;DFN
	1	;FSC
	4	;IBP
	5	;ILDB
	5	;LDB
	5	;IDPB
	5	;DPB		137
REPEAT 40,5	;FLOATING POINT	140-177
REPEAT 4,[	;REPET OVER MOVE, MOVS, MOVN, MOVM	200-217
	5	;TO AC.
	1+IFE .RPCNT,[10]+IFE .RPCNT-1,[20]
		;IMMEDIATE; HANDLE MOVEI AND MOVSI SPECIALLY.
	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,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
	44	;POP
	40	;POPJ
	0	;JSR
	1	;JSP
	1	;JSA
	1	;JRA
	AIMB 0	;ADD			;270
	AIMB 0	;SUB
REPEAT 10,11	;CAI...		300-307
REPEAT 10,5	;CAM...		310-317
REPEAT 3,[	;REPEAT OVER JUMP,SKIP; AOJ,AOS; SOJ,SOS.  320-377
REPEAT 10,1	;JUMP, AOJ, SOJ.
REPEAT 10,6	;SKIP, AOS, SOS.
]
	1	;SETZ		400
	1	;SETZI
	4	;SETZM
	5	;SETZB
	AIMB 10	;AND		404
	AIMB 10	;ANDCA		410
	AIMB 10	;SETM		414
	AIMB 10	;ANDCM		420
	1	;SETA		424
	1	;SETAI
	5	;SETAM
	5	;SETAB
	AIMB 10	;XOR		430
	AIMB 10	;OR		434
	AIMB 10	;ANDCB		440
	AIMB 10	;EQV		444
	1	;SETCA		450
	1	;SETCAI
	5	;SETCAM
	5	;SETCAB
	AIMB	;ORCA		454
	5	;SETCM		460
	11	;SETCMI
	4	;SETCMM
	5	;SETCMB
	AIMB 10	;ORCM	 	464
	AIMB 10	;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+IFN .RPCNT&1,20
		;IMMEDIATE.
	5	;TO MEM.
	6	;TO SELF.
]
REPEAT 10,[	;REPEAT OVER HRR, HLR, HRRZ, ..., HLRE.	540-577
	5	;TO AC.
	1+IFE .RPCNT&1,10
		;IMMEDIATE.
	5	;TO MEM.
	6	;TO SELF.
]
REPEAT 4,[	;REPEAT OVER TRN, TRZ, TRC, TRO.	600-677.
REPEAT 10,11+IFN .RPCNT&1,10	;THE TR AND TL VARIANTS.
REPEAT 10,5	;THE TD AND TS VARIANTS.
]
;---WRONG FOR KS, BUT WHO CARES
REPEAT 100,4	;I-O INSTRUCTIONS HAVE NO AC FIELD.

IFN .BYTC-1000,.ERR WRONG LENGTH TABLE.

.BYTE

KINTPR:	SAVE [LCTGNR]
	MOVE C,LWT	;:INTPRT - INTERPRET $Q AS 2ND INT. BITS.
	TLNN C,400000
INT0PR:	  SKIPA W2,[INT0PE(D)]
INT1PR:	    MOVE W2,[INT1PE(D)]
INT1P0:	JFFO C,INT1P1
	RET

INT1P1:	MOVSI W1,400000
	MOVNI D,(D)
	LSH W1,(D)
	ANDCM C,W1
	MOVE D,@W2
	SAVE C
	CALL SIXTYP
	REST C
	CTYPE ";
	JRST INT1P0

;TABLE OF NAMES OF 1ST-WORD INTS.
INT0PT:	SIXBIT /TYPEIN/
	SIXBIT /^Z/
	SIXBIT /BADPI/
	SIXBIT /AROV/
	SIXBIT /DPY/
	SIXBIT /ILOPR/
	SIXBIT /SYSDED/
	SIXBIT /.VALUE/
	SIXBIT /IOC/
	SIXBIT /ILUAD/
	SIXBIT /.BREAK/
	SIXBIT /1PROC/
	SIXBIT /SCLOCK/
	SIXBIT /MPV/
	SIXBIT /MAR/
	SIXBIT /LTPEN/
	SIXBIT /PDLOV/
	SIXBIT /CLI/
	SIXBIT /ERROR/
	SIXBIT /SYSDBG/
	SIXBIT /<3.3>/
	SIXBIT /<3.4>/
	SIXBIT /<3.5>/
	SIXBIT /SYSUUO/
	SIXBIT /PURINS/
	SIXBIT /PURPG/
	SIXBIT /ARFOV/
	SIXBIT /PARERR/
	SIXBIT /DTTY/
	SIXBIT /ATTY/
	SIXBIT /^_D/
	SIXBIT /JBSTAT/
	SIXBIT /NXIO/
	SIXBIT /RUNTIM/
	SIXBIT /REALTM/
INT0PE:	SIXBIT /.VAL 0/

;TABLE OF NAMES OF 2ND-WORD INTS.
INT1PT:	SIXBIT /IOCH0/
	SIXBIT /IOCH1/
	SIXBIT /IOCH2/
	SIXBIT /IOCH3/
	SIXBIT /IOCH4/
	SIXBIT /IOCH5/
	SIXBIT /IOCH6/
	SIXBIT /IOCH7/
	SIXBIT /IOCH10/
	SIXBIT /IOCH11/
	SIXBIT /IOCH12/
	SIXBIT /IOCH13/
	SIXBIT /IOCH14/
	SIXBIT /IOCH15/
	SIXBIT /IOCH16/
	SIXBIT /IOCH17/
	SIXBIT /<2.8>/
	SIXBIT /<2.9>/
	SIXBIT /INF0/
	SIXBIT /INF1/
	SIXBIT /INF2/
	SIXBIT /INF3/
	SIXBIT /INF4/
	SIXBIT /INF5/
	SIXBIT /INF6/
	SIXBIT /INF7/
	SIXBIT /<3.9>/
	SIXBIT /<4.1>/
	SIXBIT /<4.2>/
	SIXBIT /<4.3>/
	SIXBIT /<4.4>/
	SIXBIT /<4.5>/
	SIXBIT /<4.6>/
	SIXBIT /<4.7>/
	SIXBIT /<4.8>/
INT1PE:	SIXBIT /<4.9>/

;COME HERE ON RETURNING JOB THAT HIT TEMP. BPT.
UBRKT:	SETZM BTADR(U)	;GET RID OF TEMP BPTS WHEN HIT.
	SOS PPC(U)	;POINT PC TO THE BPT'D INSN, NOT AFTER IT.

;COME HERE ON RETURN FROM 1-PROCEED.
UBRKS:	MOVE I1,USTYPE(U)
UBRKS9:	SETZM UPI0(U)	;DON'T SOS THE PC FOR 0^^.
	SETZM UPI1(U)
	HRRZ A,PPC(U)	;GET ADDR OF NEXT INSN TO DO,
	TLNN I1,USTYP2	;IF USER DID ^N, NOT ^^, DON'T CHECK FOR SETAI.
	PUSHJ P,NACN2	;GET IT, HANDLE XCT'S, PUT LH IN RH OF C, OPCODE IN B.
	 JRST UBRK3	;CAN'T FETCH THE INSN.
	TRZ C,37
	CAIN C,(SETAI)	;SETAI INSN SAYS USE BPTS FOR A WHILE.
	 JRST UBRKS8
	SKIPN USCNT(U)
	 JRST UBRK3	;NO MORE STEPPING TO DO, JUST RETURN.
	SKIPLE USCNT(U)
	 SOS USCNT(U)	;DECREMENT THE STEP COUNT UNLESS INDEFINITE.
	CAIN C,(.VALUE)
	 TLO I1,USTYP0	;SHOULD ALWAYS USE TEMP BPTS OVER .VALUE.
	CAIE B,(PUSHJ)
	CAIN B,(JSR)
	 JRST UBRKSC	;CHECK FOR SUBROUTINE CALLS.
	CAIE B,(JSP)
	CAIN B,(JSA)
	 JRST UBRKSC
	CAIL B,4^4	;CHECK FOR MONITOR CALLS.
	CAIL B,5^4
	CAIA
	 JRST [TLNN I1,USTYP1	;UNLESS JUST STARTING TO STEP,
		TRNN I1,USTYPM	;STOP ON MONITOR CALLS IF M FLAG.
		 JRST UBRKS1
		JRST UBRK3]
	CAIE B,(POPJ)
	CAIN B,(JRA)
	 JRST [TLNN I1,USTYP1	;UNLESS JUST STARTING TO STEP,
		TRNN I1,USTYPR	;R FLAG => STOP BEFORE RETURNS.
		 JRST UBRKS1
		JRST UBRK3]
	TLNN I1,USTYP1
	TRNN I1,USTYPJ	;IF SHOULD STOP BEFORE JUMPS,
	 JRST UBRKS0
	CAIN B,(JFFO)	;CHECK FOR JUMPS.
	 JRST UBRK3
	CAIG B,(SOJG)	;ELIMINATE MOST OF THE NON-JUMPS.
	CAIGE B,(AOBJP)
	 JRST UBRKS0
	CAIN C,(JFCL)	;NO-OP ISN'T A JUMP.
	 JRST UBRKS1
	CAILE B,(JFCL)
	CAIL B,(JUMPL)
	CAILE B,(JUMPG)
	CAIL B,(AOJL)
	CAILE B,(AOJG)
	CAIL B,(SOJL)
	 JRST UBRK3	;A JUMP.
	JRST UBRKS1	;NOT A JUMP.

UBRKSC:	TRNE I1,USTYPB	;MAYBE BPT SUBR CALLS.
	 TLO I1,USTYP0
	TLNN I1,USTYP1	;UNLESS THIS WILL BE 1ST STEP,
	TRNN I1,USTYPC	;MAYBE STOP BEFORE THEM.
	 JRST UBRKS1
	JRST UBRK3

UBRKS0:	CAIL B,1^5	;CHECK FOR UUOS.
	 JRST UBRKS1
	TRNE I1,USTYPV	;MAYBE SHOULD BPT THEM,
	 TLO I1,USTYP0
	TRNE I1,USTYPU	;MAYBE SHOULD TREAT THEM AS SUBR CALLS.
	 JRST UBRKSC
	TLNE I1,USTYP1	;UNLESS ABOUT TO DO 1ST STEP,
	 JRST UBRKS2
	TRNE I1,USTYPW	;MAYBE SHOULD STOP ON THEM.
	 JRST UBRK3
UBRKS1:	TRNE I1,USTYPP	;IF NOT PRINTING
	TLNE I1,USTYP1	;OR JUST STARTING TO STEP,
	 JRST UBRKS2	;JUST GO PROCEED.
	SKIPE DOZTIM	;IF SHOULD DOZE, GET TIME STARTED TO PRINT.
	 .RDTIME C,
	PUSH P,I1
	PUSH P,C
	PUSHJ P,PCPNT1	;DISPLAY RAID REGS, PRINT ADDR AND >> AND NEXT INSN.
	POP P,C
	POP P,I1
	CALL UBRK6	;WAIT A WHILE, SKIP IF CHAR TYPED IN.
	 JRST UBRKS2
	SETZM USCNT(U)
	JRST LCTGNR	;STOP STEPPING.

UBRKS2:	SETZB A,ARG1+1	;MAKE SURE GO ONLY 1 STEP.
	JUMPL I1,NACN	;UBRKS SET 4^5 TO SAY USE BPTS.
	MOVSI D,USTYP2	;TURN THIS BIT OFF TO DISTINGUISH FROM ^N
	ANDCAM D,USTYPE(U) ;TO MAKE SURE SETAI INSN HANDLED ON RETURN.
	JRST NCTLN1	;OTHERWISE NORMAL 1-PROC.

;MULTI-STEPPING THRU SETAI INSN
UBRKS8:	CALL NEFECC	;CALC. EFFEC. ADDR OF INSN.
	MOVEI A,(D)
	CALL RFETCH	;READ WD INSN POINTS TO.
	 JRST UBRK3
	JRST NACN1	;PROCEED TO THAT ADDR INVISIBLY.

;<LETTERS>$^^ OR <ARG> <LETTERS>$^^
;SET STEPPING-TYPE FROM LETTERS AND START STEPPING.
NACUPA:	MOVE I1,USTYPE(U)
	PUSHJ P,NACUP0	;HANDLE THE LETTERS, CHANGING I1.
	HRRZM I1,USTYPE(U)

;^^ - BEGIN MULTI-STEPPING.
NCUPA:	SKIPN UINTWD(U)
	 JRST NRERR	;CAN'T START STEPPING RUNNING PROGRAM.
	MOVE I1,USTYPE(U)
	TLO I1,USTYP1	;DON'T PRINT 1ST INSN TO BE DONE.
	TLZ I1,USTYP2	;DO HANDLE SETAI.
	SETOM USCNT(U)	;ASSUME NO ARG,INDEFINITE STEPPING.
	MOVE A,ARG1
	SKIPE ARG1+1	;IF ARG, IT IS # TIMES TO STEP.
NCUPA1:	MOVEM A,USCNT(U)
	SKIPE USCNT(U)	;IF WILL PRINT AN INSN BEFORE ANY STEPPING,
	TLNN I1,USTYP1
	PUSHJ P,CRF	;PRINT IT ON NEXT LINE.
	JRST UBRKS9	;PRETEND JUST DID A STEP, GO DO ANOTHER.

;<LETTERS>$$^^ - CHANGE NEW-JOB-DEFAULT STEPPING TYPE.
;<LETTERS>$$0^^  - SET THIS JOB'S DEFAULT TO CHANGED NEW-JOB-DEFAULT.
N2ACUP:	TLNE B,O.IFX
	PUSHJ P,QIJERR	;$$0^^ NEEDS JOB.
	MOVE I1,MSTYPE	;GET THE NEW-JOB-DEFAULT.
	PUSHJ P,NACUP0	;CHANGE ACC. TO LETTERS.
	MOVE D,(W4)	;GET THE $$^^ OPERATOR'S BITS BACK.
	TLNE D,O.IFX	;$$0^^ - SET THIS JOB'S DEFAULT.
	HRRZM I1,USTYPE(U)
	TLNN D,O.IFX	;$$^^ - SET THE NEW-JOB-DEFAULT.
	HRRZM I1,MSTYPE
	JRST LCTGNR

;ROUTINE TO HANDLE LETTERS (AS SIXBIT IN C)
;AND UPDATE THE STEPPING-TYPE BITS IN RH OF I1.
NACUP0:	MOVE B,[440600,,C]
NACUP1:	SETZ D,		;IF BP INCR'S INTO D, ILDB WILL FETCH 0.
	ILDB D,B	;GET NEXT LETTER.
	JUMPE D,CPOPJ	;DONE WHEN FINISH ALL LETTERS.
	MOVSI A,1-NACUPL	;AOBJN -> TABLE
NACUP2:	CAME D,NACUPT(A)	;SEARCH FOR THIS LETTER.
	AOBJN A,[AOBJN A,NACUP2]
	JUMPGE A,NACUP1	;LETTER NOT FOUND, IGNORE IT.
	TDZ I1,NACUPT+1(A)
	TSO I1,NACUPT+1(A)
	JRST NACUP1	;GET NEXT LETTER.


IRPC X,,BCJMPRUVWY
USTYP!X==1_.IRPCN
TERMIN		;DEFINE RH. FLAGS.

USTYP0==4^5	;TELLS UBRKS2 TO USE TEMP BPTS RATHER THAN 1-PROC.
USTYP1==2^5	;SET AT UBRKS9 SAYS THIS IS 1ST STEP, DON'T STOP BEFORE INSN.
USTYP2==1^5	;WHEN 1-PROC'ING, SET IF DUE TO ^N, CLEAR IF ^^.


NACUPT:	;LETTER ? BITS TO SET,,BITS TO CLEAR
	'B ? USTYPB,,USTYPC		;USE BPTS OVER SUBR CALLS.
	'C ? USTYPC,,USTYPB		;STOP BEFORE SUBR CALLS.
	'D ? USTYPB+USTYPC		;STEP THRU SUBR CALLS.
	'J ? USTYPJ,,			;STOP BEFORE ALL JUMPS.
	'K ? USTYPJ			;DON'T.
	'M ? USTYPM,,			;STOP BEFORE SYSTEM CALLS.
	'N ? USTYPM			;STEP THRU SYSTEM CALLS.
	'P ? USTYPP,,			;PRINT EACH INSN.
	'Q ? USTYPP			;PRINT ONLY INSN STOP BEFORE.
	'R ? USTYPR,,			;STOP BEFORE SUBROUTINE RETURNS.
	'S ? USTYPR			;STEP SUBR RETURNS.
	'U ? USTYPU,,USTYPV+USTYPW	;TREAT UUOS AS SUBR CALLS.
	'V ? USTYPV,,USTYPU+USTYPW	;USE BPTS OVER UUOS.
	'W ? USTYPW,,USTYPU+USTYPV	;STOP BEFORE UUOS.
	'X ? USTYPU+USTYPV+USTYPW	;STEP THRU UUOS (INTO UUOH)
	'Y ? USTYPY,,			;ENTER "CARE" MODE,
	'Z ? USTYPY			;LEAVE IT.
NACUPL==.-NACUPT

;$^N - PROCEED WITH TEMP. BPTS AFTER NEXT INSN.
NACN:	CALL NACNA	;A _ PLACE TO PUT 1ST TEMP. BPT.
	 JRST [	HRROM A,BTADR(U)
		JRST NACN3]
NACN1:	HRROM A,BTADR(U)
	HRRZ A,PPC(U)	;PUT -1 IN LH TO ASSUME NO PDL TO CHECK.
	SKIPN ARG1+1	;NO PDL CHECK IF PREFIX ARG GIVEN.
	PUSHJ P,NACN2	;GET WHAT WILL BE NEXT INSN.
	 JRST PROCDC	;CAN'T GET IT, DON'T BOTHER WITH PDL STUFF.
	LDB A,[270400,,D]
	CAIE B,(PUSHJ)
	 JRST NACN3	;NOT PUSHJ, ORDINARY.
	HRLM A,BTADR(U)	;REMEMBER ADDR OF PDL PTR,
	PUSHJ P,RFETCH
	 ERLOSS
	HRRZM D,BTPDL(U)	;REMEMBER WHAT IT NOW PTS TO.
NACN3:	MOVE B,(W4)
	TLNE B,O.IFX	;IF WE DIDN'T HAVE AN INFIX ARGUMENT,
	 JRST PROCDC
	HRRZ A,BTADR(U)	;LOOK FORWARD FROM INSN BEING STEPPED OVER
NACN4:	CALL RFETCH	;FOR FIRST REASONABLE INSTRUCTION
	 JRST PROCDC
	TLCE D,777000	;("REASONABLE" MEANS OPCODE > 0 AND < 774)
	 TLNN D,774000
	  AOJA A,NACN4
	HRRM A,BTADR(U)	;THAT'S THE PLACE TO PUT THE TEMP. BPT.
	JRST PROCDC	;(NOTE THIS DOESN'T HAPPEN IF THERE'S A PREFIX ARG).

NACN2:	PUSHJ P,RFETCH	;ASSUME A HAS ADDR OF INSN, FETCH IT.
	 POPJ P,		;FAIL IF CAN'T FETCH.
	HLRZ C,D	;PUT LH OF INSN IN C.
	MOVEI B,(C)
	ANDI B,777000	;IN B'S RH, PUT JUST THE OP-CODE.
	CAIE B,(XCT)	;REPLACE XCT'S BY XCT'D INSNS.
	 JRST POPJ1
	PUSHJ P,EASETU	;GET ACS FOR EFFECTIVE ADDR CALC.
	PUSH P,I1
	PUSHJ P,NEFECC	;GET ADDR OF XCT'D INSN,
	MOVEI A,(I1)	;USE IT AS ADDR OF INSN,
	POP P,I1
	JRST NACN2	;TRY AGAIN.

;COMPUTE PLACE TO STOP AT, FOR $^N AND $$^N COMMANDS.
;NO SKIP => DON'T DO SPECIAL PUSHJ STACK-LEVEL COMPARISON.
NACNA:	call qrerr	;Get unhappy if the job is already running
	MOVE D,UINTWD(U)
	CAIN D,21	;GET UNHAPPY IF JOB HASN'T BEEN RUN.
	 JRST NSERR
	HRRZ D,PPC(U)	;DEFAULT IS $.+1
	MOVEI D,1(D)
	SKIPE ARG1+1	;BUT PREFIX ARG OVERRIDES THAT.
	 MOVE D,ARG1
	TDNN D,[#<0 17,>]	;IF NOTHING BUT AC FIELD,
	 LSH D,-5	;MOVE IT TO IDX FIELD (IT IS PDL PTR)
	TLNN D,(@(17))	;IF INDEXED OR INDIRECT,
	 JRST [	AOS (P)
		JRST NACNA1]
	SAVE A
	CALL EASETU	;(GET ACS FROM JOB, FOR NEFECC)
	SAVE I1
	CALL NEFECC	;COMPUTE EFFECTIVE ADDR, IN I1.
	MOVEI A,(I1)
	CALL RFETCH	;AND USE CONTENTS OF WD POINTED TO
	 JRST ERR
	REST I1		;AS THE ADDR OF PLACE TO STOP.
	REST A		;((P)$^N GOES TILL AFTER NEXT POPJ)
NACNA1:	ADD A,D
	RET

;$$^N.
N2ACN:	CALL NACNA
	 JFCL
	SETZM INCNT(U)
	AOS INCNT(U)	;MAKE SURE >0 SO WILL 1-PROC.
	MOVEM A,OIPCHK(U)	;GO TILL GET THERE OR 1 AFTER.
	JRST PROCDC

naco:	jumpg d,opfls		   ;if we were given an arg, barf
	skipn linkp	;do we want this command?
	  7NRTYP [ASCIZ/ OP? /]
	call warn
	  7type [asciz / (Link File)/]
	call gsot
	skipl linkp	;does he want it to be LINKNF instead of LINKN?
	  jrst linkn0	;  yes
	  jrst linkf	;  no


NCTLP:	SETZM TW2FL	;^P
	JRST NCTLP1

NACP:	MOVEI A,1
	MOVEM A,TW2FL	;$^P ;TW2FL DISTINGUISHES $^P FROM ^P.
	JRST NCTLP1

N2ACP:	SETOM TW2FL	;$$^P - RUN WITHOUT TTY, BUT ALLOWED TO TYPE OUT.
	JRST NCTLP1

KCONTI:
NALTP:	TLZA F,FLLT	;$P, $$P
NCTLP1:	TLO F,FLLT	;$^P MERGES IN HERE.
	CALL QIJERR	;FOR :CONTIN & :PROCEED, CHECK FOR INFERIOR (ALREADY DONE FOR $P & ^P).
	SKIPN A,UINTWD(U)	;STOP JOB SO WON'T INT. AFTER WE CHECK.
	 .USET USRI,[.SUSTP,,[-1]]
	SKIPE UINT(U)
	 JRST NALTP3	;IF IT INTERRUPTED, LET IT RETURN.
NALTP2:	SOS A
	PUSHJ P,BUTOP1
	PUSHJ P,GARGD1
	JRST PROCDN

NALTP4:	TLZ F,FLLT	;DUMMIED UP $P; IF REALLY PROCEED, MUST TELL USER.
NALTP3:	SKIPN UPI1(U)	;JOB INTERRUPTED: IF IT WAS JUST TRYING TO USE TTY,
	 TLNE F,FLLT	;AND THIS IS $P, NOT ^P,
	  JRST UBRK0
	MOVE D,UPI0(U)
	TDNE D,[#%PITTY#%PIVAL]
	 JRST UBRK0	;THEN SIMPLY GIVE IT TTY AND START IT AGAIN
	CALL UBRK0	;IN ORDER TO DO WHICH, WE MUST "RETURN IT TO DDT" FIRST.
	7TYPE [ASCIZ/ P/]
	MOVE A,UINTWD(U)
	JRST NALTP2

GARGD1:	SKIPLE D,ARG1
	 SKIPN ARG1+1
	  MOVEI D,1
	POPJ P,

BUTOP1:	MOVEI W2,1	;SET OR CLR AUTO-PROC, BPT NUM IN A .
	LSH W2,(A)
	ANDCAM W2,BPINFL(U)
	TLNE B,O.2ALT
	 IORM W2,BPINFL(U)	;$$
	POPJ P,

NALTG:	MOVE D,ARG1	;$G, $$G
	HRLI D,(JRST)
	SKIPN ARG1+1
	 MOVE D,STARTA(U)
	JUMPE D,NGOERR
	SKIPN UINTWD(U)
	 JRST NRERR	;CAN'T START RUNNING PROGRAM.
	SKIPL UNDEFL(U)
	 JRST NALTG1
	7TYPE [ASCIZ /--Undefined Symbols--/]
	CALL MORFL1	;MAKE USER CONFIRM IF THERE UNFILLED FORWARD REFERENCES
	 JRST ERR
NALTG1:	TLNE B,O.2ALT
	 MOVEM D,STARTA(U)	;$$
	CALL SETPC	;SET THE PC, AND CLEAR SOME FLAGS.
	MOVE I1,USTYPE(U)
	TLNE B,O.IFX
	 JRST NCUPA1	;$<N>G, GO MULTI-STEP.
	JRST PROCDT	;ELSE JUST PROCEED.

;SET CURRENT JOB'S PC TO PROCEED AT FROM D.
SETPC:	SAVE PPC(U)
	REST XECPC(U)	;REMEMBER THE PC WE ARE ABOUT TO CLOBBER.
	SAVE UINTWD(U)	;SAVE UINTWD OVER $X.
	REST XINTWD(U)
	SETOM UINTWD(U)	;MAKE SURE PROCDN WON'T DO ANYTHING FUNNY.
	HRRM D,PPC(U)	;SET THE NEW PC.
	MOVE D,OIPBIT
	TLO D,%PCFPD	;CLEAR SOME FLAGS THAT MIGHT EMBARRASS US.
	ANDCAM D,PPC(U)
	RET

KGO:KSTART:
	TLZA F,FLLT	;:GO, :START.
KGZP:	TLO F,FLLT	;:GZP.	IDENTICAL BUT DOESN'T GIVE TTY.
	PUSHJ P,QIJERR
	PUSHJ P,QRERR
	PUSHJ P,RONUM
	 JRST ALTDQX	;(IF RUB PAST START OF RONUM)
	JUMPN B,KGZP1
	SKIPN A,STARTA(U)
	 JRST NGOERR
KGZP1:	MOVE D,A
	CALL SETPC
	SETOM XCRFSW	;DON'T TYPE CRLF.
	SETZM TW2FL	;:GXP IS LIKE ^P, NOT $^P.
	JRST PROCD1

;; :ICHAN <chan>  -- print filename and mode and such of <chan> in inferior

kichan:	jumpl u,njerr	;gotta have some job or other!
	call ronum	;fetch a number into A
	  jrst altdqx	;  rubbed out, abort
	caige a,20	;is it a real channel number?
	  skipge a	;  between 0 and 17?
	    jrst kicher	;    no good, barf at him!
	skipl d,ddtsw	;self?  Then use -1 to mean self
	  movei d,usri	;  no, we reference it by channel

	tsclo infnm1	;read the filenames of channel in A, job in D
	push p,d	;save the status returned by the RFNAME
	call terpri	;fresh line
	skipn nctltf	;is there anything open?
	  jrst [ 7type [asciz /[Channel Closed]/]
		 pop p,d  ; restore stack
		 jrst nltl4]  ;prompt and exit
	movei a,nctltf	;get set to print the file
	call lfile	;print the filenames
	pop p,d		;recover the filemode status
	7type [asciz / (/]
	trne d,7	;are there any of the .UAO series on?
	  ctype ".	;  yes, type the "." of that bunch
	trnn d,.bai	;unit mode?
	  ctype "u
	trze d,.bai	;block mode?
	  ctype "b
	trnn d,.uii	;ascii mode?
	  ctype "a
	trze d,.uii	;image mode?
	  ctype "i
	trnn d,.uao	;input?
	  ctype "i
	trze d,.uao	;output?
	  ctype "o
	jumpe d,kichn1	;if no other bits, close up now
	ctype "\	;or in more bits
	move a,d	;G8PNT takes arg in A
	call g8pnt	;print the rest of the bits
kichn1:	ctype ")	;close up
	jrst nltl4

sylhak:	movsi b,syloct	;make sure it looks like an octal frob
	call fldput	;save that number in the frob table
	setz a,
	move b,[setz+(o.1alt)+(",)+optab1+",-1]	 ;,
	jrst fldput

kicher:	7type [asciz /ANot a channel number.
/]
;; :IOPEN <chan>,<mode>,<file> -- open file in current job on chan with mode
kiopen:	call hgo2	;misc. setup, error checking, etc.
kiopn1:	call ronum	;read in a number
	  jrst altdqx	;  rubbed out, abort
	caige a,20	;a channel number must be < 20
	  skipge a	;  and >= 0
	    jrst kicher	;    no good, barf at him!
	hrrm a,opnchn	;that's the channel
	call sylhak
	call ronum	;read in a number
	  jrst altdqx	;  rubbed out, abort
	hrrm a,opnmod	;that's the mode
	call sylhak
	setzm arg1
	setzm arg1+1
	movei c,opndev	;filename block
	call gsoa	;ugh, wrong thing but loses less badly
	  jrst kiopn1
	tlz f,flunrd	;don't re-read the last char
	call rrfl1	;read a file name into our program block
	sub w4,[10,,10]	;pop 4 frobs off the stack
	call gxblkd	;check out the X locations for validity/existance
	addi d,20	;D <- location of superior-hacking block
	.access usro,d
	save d		;remember where we're starting
	call setpc
	movsi d,%pcpur	;on ai, prevent immediate purins error, no-op elsewhere
	andcam d,ppc(u)
	rest a		;get where we're going to put this stuff

;;; relocate each first item in each pair to point to each second item

irp x,,[[blk,prg],[dev,bdv],[fn1,bf1],[fn2,bf2],[snm,bsn]]
  irp y,z,[x]
	movei d,opn!y-opnprg(a)
	hrrm d,opn!z
	.istop
  termin
termin

	move d,[-prglen,,opnprg]  ;transfer the whole program to open the file
	.iot usro,d	;transfer!
	jrst xec1c	;and start it up running!

NALTX:	SKIPN ARG1+1	;$X
	 JRST NAERR
	SKIPL FNYLOC	;ARG FUNNY => XCT IN DDT.
	SKIPE DDTSW
	JRST NALTX1	;CURRENT JOB SELF, JUST XCT.
	MOVE D,ARG1
	JRST HGO

NALTX1:	PUSHJ P,CRF
	SETOM HCLOB	;SAY HACTRN "CLOBBERED" IN CASE MYSTERIOUS BUGS ARISE.
	SETOM NALTXF	;PREVENT BAD INSNS XCT'D FROM MAKING DDT BUG FILES.
	XCT ARG1
	 CAIA
	  7type [asciz /<SKIP>/]	;IF INSN SKIPS, TELL USER.
	CALL CRF
	SETZM NALTXF
	JRST NLTL2

nctlx:	skipe d,uint(u)	; ^X -- job waiting => let it return.
	  jrst nctlx1
	skipe d,uintwd(u)  ;If job is already stopped
	  jrst [ movei a,%pic.z	 ;make it print as if at a control-Z
		 iorm a,upi0(u)	 ;by faking an interrupt
		 cain d,21  ;  Has it never been started?
		   jrst nctlxx	;nope, tell him
		 hrrz d,ppc(u)	;get the PC
		 7type [asciz /A<Not Running> /]
		 call pcpnt0  ;and print out the instrucction
		 jrst lctgnr]	   ;and trailing spaces
	movei a,%urctx	;Make note that this job is waiting to return
	iorm a,urandm(u)
	MOVE A,[-2,,[ .sustp,,[-1] ? .sipirq,,[2] ]]
	.uset usri,a
	jrst procdz

nctlxx:	7type [asciz /A<Not started>/]
	jrst nltl2

NCTLX1:	MOVE A,UIACK(U)
	CAIN D,16	;UNLESS THE JOB JUST DID A .BREAK 16,
	TRNN A,60000	;TO KILL ITSELF,
	 JRST UBRK0	;SIMPLY LET IT RETURN.
	SETOM UINT(U)	;ELSE CANCEL RECORD OF THE .BREAK,
	SETZM UIACK(U)	;PCPNT WILL BACK UP THE PC.
	JRST UBRK0


hgo2:	call qijerr
	call qrerr	;job shouldn't be running.
	tlz f,fllt
	aos xcrfsw
	ret

HGO:	MOVEM D,34SAV
	MOVEI A,0	;DO TYPE CR WHEN RETURN.
HGO1:	DPB A,[130100,,34SAV+1]	;SAY WHTHER SHLD TYPE CR ON RETURN.
	call hgo2	;miscellaneous setup, check job not running, etc.
	call gxblkd	;check for core in the X locations, etc.
	addi d,xblk$x
	.acces usro,d	;move 34SAV etc. into inferior.
	call setpc
	movsi d,%pcpur	;on ai, prevent immediate purins error, no-op elsewhere
	andcam d,ppc(u)
	MOVE D,[-3,,34SAV]
	.IOT USRO,D
XEC1A:	SKIPE D,MARADR(U)
	 .USET USRI,[.SMARA,,D]
	SKIPL SYSUUO(U)		;TURN ON %OPTRP BIT IF STOP-ON-SYSTEM-CALL IN USE.
	 CALL OPTTRS
XEC1C:	CALL INSRTB
XEC1B:	SETZM UINTWD(U)	;NOW JOB IS "RUNNING".
	MOVE D,PPC(U)	;SET ITS PC.
	.USET USRI,[.SUPC,,D]
;COME HERE IF JOB ALREADY "RUNNING" (BUT IT SHOULD BE TEMPORARILY STOPPED)
PROCD4:	TLNN F,FLLT		;GIVE IT TTY?
	 JRST PROCD2
	.USET USRI,[.RTTY,,D]	;NO, JUST SET ITS TTYTBL BITS AND START IT AGAIN.
	TLZ D,%TBOUT+%TBWAT	;FIRST APPROXIMATION => CLEAR BOTH; MAYBE CHANGE LATER.
	SKIPGE A,TW2FL		;THIS IS 0 FOR ^P, 1 FOR $^P; TW1FL NORMALLY 0.
	 JRST [	TLO D,%TBOUT	;TW2FL -1 => $$^P, SO SET %TBOUT.
		JRST PROCD5]	;ALSO SET %TBWAT TO AVOID INTS WHILE :SENDS RCV'D.
	XOR A,TW1FL		;NORMALLY, $^P SETS %TBWAT AND ^P ZEROS IT.
	TRNE A,1		;TW1FL'S LOW BIT, IF 1, REVERSES THAT DECISION.
	 TLO D,%TBWAT
PROCD5:	.USET USRI,[.STTY,,D]
	.USET USRI,[.SUSTP,,[0]] ;TTYTBL ALTERED, SO RESTART JOB.
	JRST NLTL2

PROCD2:	AOS D,XCRFSW
	CAIE D,1	;IF SWITCH WASN'T SET,
	  call terpri	;then type CRLF
	PUSHJ P,RTYIC	;GET CHAR FROM VALRET OR FILE
	JRST PROCD3	;NONE AVAILABLE
	CAIE D,^V	;IF NEXT CHARACTER CONTROL V,
	JRST PROCD3	;...
	SETZM UNRCHF	;FLUSH THE ^V,
	SETZM UNECHF
	SOSGE TTYFLG	;PERFORM ACTION OF ^V.
	SETZM TTYFLG
PROCD3:	CALL TTYLEV
procdz:	TLZ F,FLSTOP
	SETOM STOPWT	;TELL INT LEVEL TO SET FLSTOP IF CURRENT JOB RETURNS.
	.USET USRI,[.SUSTP,,[0]]
	CALL HAKKAM	;DO QUEUED RQ'S, DO NEW RQ'S FROM TSINT.
	MOVSI A,FLSTOP
	TDNN A,F	;WAKE UP WHEN TSINT SETS FLSTOP.
	.HANG
	SETZM HAKOK
	SETZM STOPWT
	skipge haktyp
	 SETOM HAKRQ
	SKIPN ALARMW
	 JRST UBREAK
	SETOM HAKTYP	;REPEAT ANY RANDOM TYPEOUTS
	SETOM HAKRQ	;THAT HAPPENED WHILE JOB WAS RUNNING.
	JRST UBREAK	;RETURN CURRENT JOB TO DDT.

;^N
procdx:	setzm xcrfsw		   ;proceed, no CRLF, no "Not started" message
	tlz f,fllt		   ;and give it the TTY
	movei d,1		   ;proceed once
	call qijerr		   ;check it out, is it legit to hack this job?
	move a,uintwd(u)	   ;see what's cooking with this job
	jumpe a,procd4		   ;thinks it's already running, hack it
	jrst procdy		   ;and go!

NCTLN:	call qrerr	;Get unhappy if the job is running!
	MOVSI D,USTYP2
	IORM D,USTYPE(U)
NCTLN1:	SETZM OIPCHK(U)	;^N, $^N - LEAVE $$^N MODE.
	PUSHJ P,GARGD1	;GET ARG OR 1.
	MOVEM D,INCNT(U)	;NUM. INSNS TO DO.
PROCDC:	SETOM XCRFSW	;PROCEED ONCE, GIVING TTY, NO CRLF.
PROCDT:	TLZ F,FLLT	;PROCEED ONCE, GIVING TTY.
;ANYONE WHO COMES HERE WITH FLLT=1 MUST SET UP TW2FL.
PROCD1:	MOVEI D,1	;ONCE, GIVING TTY IFF FLLT CLEAR.
PROCDN:	AOS XCRFSW	;INCREMENT CRF SWITCH IN CASE OF ERROR
	PUSHJ P,QIJERR
	MOVE A,UINTWD(U)
	JUMPE A,PROCD4	;ALREADY RUNNING, MAYBE GIVE IT TTY.
	CAIN A,21
	 JRST NSERR	;CAN'T $P IF NEVER STARTED.
procdy:	camn a,[-4]	;if stopped by ..PERMIT=0, allow one DDT-WRITE
	 JRST [	SKIPN PERMIT(U)	;TO HAPPEN, BUT STOP THE NEXT ONE.
		 AOS PERMIT(U)
		JRST XEC1C]	;AVOIDED REENABLING MAR SO DON'T GET MAR,DDTWRITE,MAR.
	CAMN A,[-5]	;IF STOPPED BY SYSTEM CALL WHEN ..SCTRAP SET,
	 JRST [	.USET USRI,[.ROPTIO,,I3]
		TLZ I3,OPTTRP	;TURN OFF SYSTEM CALL TRAPPING AND GO 1 INSN
		.USET USRI,[.SOPTIO,,I3]
		JRST .+1]
	MOVE B,OIPBIT
	CAME A,[-5]
	 CAMN A,[-3]	;-3 MEANS A MAR THAT ABORTED;  GO 1 INSN, THEN TURN ON MAR.
	  JRST [IORM B,PPC(U)	;AVOID TURNING MAR BACK ON SO WE DON'T
		JRST XEC1C]	;GET SEQUENCE MAR,MAR OR MAR,SCTRAP,MAR.
	SKIPLE INCNT(U)
	 IORM B,PPC(U)
	JUMPL A,XEC1A	;STOPPED BY RANDOM INT, START IT BACK UP
	CAIL A,15		;SIMILAR AFTER .BREAK 16,
	JRST XEC1A
			;BPT - WE'LL HIT IT AGAIN IMMEDIATELY,
	DPB A,[$URBPT,,URANDM(U)]	;SO MAKE SURE IT DOESN'T BREAK THE 1ST TIME.
	IMULI A,BPL
	ADDI A,-BPL(U)
	MOVEM D,B1CNT(A)
	JRST XEC1C

;TAKE TTY AWAY FROM INFERIOR, NORMALLY (NOT DUE TO ERROR IN DDT).
;The job is checked for a ^_D interrupt; so UPI0(U) must be set up.

TTYRET:	move a,upi0(u)	;check the interrupts for
	tlne a,(%pidcl)	;a ^_D
	  setom ttnrst	;  yes, so don't reset input!
	move d,urandm(u)
	trne d,%urctx	;If we're expecting a ^X-initiated ^Z
	  trnn a,%pic.z	;  And we got one,
	    caia
	      setom ttnrst  ;  then don't reset input
	SYSCLE USRVAR,[%CLIMM,,%JSELF ? ['TTY,,] ? 0 ? [TLO %TBINF]]
	SETZM TTYSTL	;TTY ISN'T STOLEN, SHOULDN'T RETURN IT.
	SKIPN DDTTY	;RETURN TTY TO DDT
	 .DTTY USRI,
	  POPJ P,
	SETOM DDTTY

	AOSN RSTDEL	;UNLESS .BREAK 16, SAID NO, FLUSH INPUT.
	 POPJ P,
	AOSE PVALFL	;DETECT ABNORMAL RETURNS FROM USER-DEFINED TYPEOUT MODES
	 JRST INRST
	HRROI D,TMS	;AND WHEN ONE OCCURS, RESET SCH TO SYMBOLIC MODE
			;TO PREVENT INFINITE LOOP TRYING TO CALL THE USER-DEFINED MODE
	MOVEM D,SCH	;FROM PCPNT4.
	JRST INRST

;ROUTINE TO GIVE TTY TO CURRENT INFERIOR.
TTYLEV:	CALL TYOFRC	;FORCE OUT TYPEOUT FIRST.
	.USET USRI,[.RTTY,,D]
	TLC D,%TBWAT+%TBOUT
	TLOE D,%TBWAT+%TBOUT
	 .USET USRI,[.STTY,,D]
	AOSN CTLZFL	;IF USER HAS TYPED ^Z,
	 .USET USRI,[.SIPIRQ,,[2]] ;MAKE SURE IT ISN'T LOST BECAUSE TTY IS IN DDT.
	.ATTY USRI,	;TTY LEAVES DDT.
	 TERR (SIXBIT /CFT/)
	SETZM DDTTY
	MOVE D,URANDM(U)
	TRNN D,%URFRZ	;IF INFERIOR WANTS US TO, DENY ALL OTHER INFERIORS OUTPUT PERMISSION.
	 RET
	SYSCLE USRVAR,[%CLIMM,,%JSELF ? ['TTY,,] ? 0 ? [TLZ %TBINF]]
	RET

;INSERT BREAKPOINTS

INSRTB:	SKIPGE BPINFL(U)
	POPJ P,		;DON'T INSERT IF ALREADY IN.
	HRROS BPINFL(U)
	MOVEI B,B1ADR(U)
	MOVEI W1,(.BREAK 1,)
INSRT1:	PUSHJ P,INSRT0	;INSERT 1 ORDINARY BPT.
	 JRST INSRT3	;SUCCEEDED IN INSERTING.
	SETZM (B)	;FAILED; GET RID OF THE BPT AND TELL THE USER.
	7TYPE [ASCIZ / 0/]
	LDB C,[.BP (0 17,),W1]
	CTYPE "0(C)
	CTYPE "B
INSRT3:	MOVEM C,B1INS-B1ADR(B)
	ADDI W1,(0 1,)
	ADDI B,BPL
	CAIE B,BPEND(U)
	JRST INSRT1
	MOVEI B,BTADR(U)
	MOVEI W1,(.BREAK 15,)
	PUSHJ P,INSRT0	;INSERT 1ST TEMP BPT
	 JRST INSRT4
INSRT5:	SETZM BTADR(U)
	ERSTRT [SIXBIT/$^N CAN'T SET BPT?/]

INSRT4:	MOVEM C,BTINS(U)
	MOVEI W1,(.BREAK 17,)
	PUSHJ P,INSRT2	;INSERT THE SECOND.
	 CAIA
	  JRST INSRT5
	MOVEM C,BTINS+1(U)
	POPJ P,

;SKIPS IF FAILS.
INSRT2:	AOSA A		;INSERT OR REMOVE AT WD AFTER PREV. BPT.
INSRT0:	MOVE A,(B)	;DO IT AT ADDR IN WD <- B.
	SKIPN (B)
	 RET
	PUSHJ P,RFETCH	;GET WHAT'S THERE NOW.
	 JRST POPJ1	;CAN'T FETCH OR BPT NOT SET.
	MOVE C,D	;REMEMBER WHAT WAS THERE IN CASE INSERTING.
	TLZ D,777740	;CLEAR OUT OP CODE, AC FIELD,
	TLO D,(W1)	;REPLACE WITH SAME FIELDS OF ARG.
	PUSHJ P,RDEPCA
	 JRST POPJ1
	POPJ P,

;REMOVE BREAKPOINTS

REMOVB:	SKIPL BPINFL(U)
	POPJ P,		;DON'T REMOVE UNLESS IN.
	SETZ B,
	DPB B,[$URBPT,,URANDM(U)]
	HRRZS BPINFL(U)
	MOVEI B,BTADR(U)
	HLRZ W1,BTINS(U)
	CALL REMOV9	;REMOVE THE 1ST TEMPORARY BPT.
	 JFCL [ASCIZ /1st $^N bpt/]
	HLRZ W1,BTINS+1(U)
	CALL [	SAVE [REMOV8]	;REMOVE THE 2ND TEMP BPT.
		JRST INSRT2]	;INSRT2 CAN SKIP INTO REMOV8!
	 JFCL [ASCIZ /2nd $^N bpt/]
	MOVEI B,B1ADR(U)
REMOV1:	MOVS W1,B1INS-B1ADR(B)
	PUSHJ P,REMOV9
	 JFCL
	ADDI B,BPL
	CAIE B,BPEND(U)
	JRST REMOV1
	POPJ P,

;REMOVE A BREAKPOINT. B POINTS AT WORD HOLDING ADDRESS.
;W1 CONTAINS THE OLD INSTRUCTION.
;TYPES A WARNING IF THERE WAS NO BREAKPOINT THERE OR IF THERE WAS NO MEMORY.
;EITHER FOLLOW THE CALL WITH JFCL [ASCIZ/NAME OF BPT/]
; OR WITH JFCL 0 TO CAUSE THE BPT NUMBER TO BE CALCULATED FROM B.
REMOV9:	PUSHJ P,INSRT0
REMOV8:	 CAIA
	  JRST REMOVL
	LDB D,[.BP 777^9,C]
	SKIPE (B)	;NO BPT SET => DON'T COMPLAIN.  INSRT0 DID NOTHING.
	 CAIN D,.BREAK_-33
	  RET
	MOVE D,C
	CALL RDEPCA	;IF BPT WAS OVERWRITTEN, UNDO INSRTO'S CHANGES.
	 JFCL
REMOVL:	CALL CRF
	HRRZ C,@(P)
	JUMPE C,REMOV2
	7TYPE (C)
	JRST REMOV3

REMOV2:	7TYPE [ASCIZ /Bpt #/]
	MOVEI C,(B)
	SUBI C,B1ADR(U)
	IDIVI C,BPL
	CTYPE "1(C)
REMOV3:	7TYPE [ASCIZ / Clobbered/]
	RET

;;; DEP series deposits into job, expects address in A and value in D

DEPF:	TLNE A,200000	;A HAS ADDR, LH HAS FUNNYNESS.
	 JRST DEP2	;DEP. INTO USET VARIABLE.
	TLNE A,400000
	 JRST DEP5	;DEP INTO DDT LOCATION.
DEPCLA:	TLZ A,-1	;DEP REQUIRES 0 IN LH OF A.
DEP:	SKIPE SYSSW
	 JRST DEP0	;IF JOB IS SYS.
	SKIPE DDTSW
	 JRST DEP4	;IF JOB IS SELF.
	skiple uchnlo	;Is job foreign?
	  jrst dep7	;  yes, hack specially
dep8:	PUSHJ P,QI6JERR	;ELSE IF ISN'T INFERIOR, CAN'T DEPOSIT.
	PUSHJ P,RDEP
	 JRST NXERR
	POPJ P,


dep7:	move w1,urandm(u)  ;Has he enabled this job?
	trnn w1,%urdps
	  jrst dep8	;unenabled
	syscal usrmem,[%clbit,,400000 ? %climm,,usri ? a ? d]  ;Do it
	  terr 'PUR
	ret

DEP0:	SKIPL SYSDPS
	 JRST ERR
	PUSH P,C
	MOVSI C,D
	HRR C,A
	.SETLOC C,
	JRST POPCJ

DEP5:	SAVE A
	ANDI A,-1
	CAIN A,PPC(U)	;IF DEPOSITING IN ..PPC, AND JOB IS STOPPED,
	 SKIPN UINTWD(U)
	  CAIA		;PUT IT IN "PROCEEDABLE" STATE.
	   SETOM UINTWD(U)
	CAIE A,PERMIT(U)
	 JRST DEP5A
	MOVN A,UINTWD(U) ;DEPOSITING IN ..PERMIT TAKES JOB OUT OF "TRAPPED ON ..PERMIT".
	CAIN A,4
	 SETOM UINTWD(U)
	JRST DEP5X

DEP5A:	CAIN A,SYSUUO(U)	;IF DEPOSITING IN THE ..SYSUUO,
	 SKIPL UCHNLO		;OF A REAL INFERIOR,
	  JRST DEP5B
	.USET USRI,[.ROPTIO,,A]
	TLZ A,OPTTRP		;MAKE THE OPTTRP BIT REFLECT IT.
	SKIPN D
	 TLO A,OPTTRP
	.USET USRI,[.SOPTIO,,A]
	MOVN A,UINTWD(U)
	CAIN A,5	;AND LEAVE THE "TRAPPED ON SYSUUO" STATE IF WE'RE IN IT.
	 SETOM UINTWD(U)
	JRST DEP5X

DEP5B:	CAIN A,XUNAME
	 .SUSET [.SXUNAME,,D]
	CAIN A,HSNAME
	 .SUSET [.SHSNAM,,D]
DEP5X:	REST A
DEP4:	ANDI A,-1
	cail a,setbeg	;if he's been poking around in his HACTRN
	  cail a,setend	;  Where we haven't said it's OK
	    movem a,hhack  ; Then say what he did

	CAIL A,MINPUR_10.	;DEPOSITING INTO DDT'S PURE CODE => WARN MAINTAINERS.
	 CAIL A,NPUR_10.
	  CAIA
	   SETOM HCLOB
	SETOM XRWI	;TELL PURBR1 TO UNPURIFY.
	MOVEM D,(A)
	CAIA		;SUCCESS.
	 JRST NXERR	;WAS MPV.
	SETZM XRWI
	RET

DEP2:	SKIPE DDTSW	;IF DEPOSITING IN OWN .USET VAR,
	TLO A,400000	;MUST DO .SUSET, NOT .USET.
	TLNN A,400000
	 CALL QIJERR
	PUSH P,C
	MOVE C,[SETZ D]	;SET VAR FROM D.
	CALL [	SAVE C
		JRST FETCH7]
	 JRST NXERR
	JRST POPCJ

RDEPCA:	TLZ A,-1
RDEP:	PUSH P,C
	PUSH P,XRWI
	SETOM XRWI
	.ACCESS USRO,A
	HRROI C,D
	.IOT USRO,C
RDEP2:	AOS -2(P)
RDEP4:	POP P,XRWI
	JRST POPCJ


;FETCH FROM A POSSIBLY FUNNY LOCATION, FUNNYNESS IN LH OF A.
FETCHF:	TLNE A,200000
	JRST FETCH3	;FETCH FROM USET VAR.
	TLNE A,400000
	JRST FETCHB	;FETCH FROM LOC. IN DDT.

;FETCH FROM ORDINARY (NON-FUNNY) LOCATION.
FETCH:	SKIPE SYSSW
	JRST FETCHA	;FETCH FROM SYS JOB.
	SKIPE DDTSW
	JRST FETCHB	;FETCH FROM SELF
	PUSHJ P,QJERR

;FETCH FROM CURRENT JOB'S CORE.  Skip unless MPV  Return in D

RFETCH:	PUSH P,C
	PUSH P,XRWI
	HRRZ C,A
	.ACCESS USRI,C
	HRROI C,D
	SETOM XRWI	;SKIP ON MPV
	.IOT USRI,C
	JRST RDEP2	;POP XRWI, C, SKIP.
	JRST RDEP4	;WAS NXM, DON'T SKIP.

FETCH3:	PUSH P,C
	SKIPN UCHNLO
	JUMPGE A,POPCJ	;CAN'T DO USET REFS ON SYS.
	MOVEI C,D	;READ INTO D.
FETCH7:	TRNE A,400000	;REJECT VARS THAT WOULD TURN READING INTO SETTING.
	 JRST POPCJ
	TLO C,(A)	;SAY WHICH VAR TO READ OR SET.
	SETOM XRWI
	JUMPL A,[	;SETTING VAR. IN DDT:
		.SUSET C ;IF GET ILOPR, INT LVL WILL SKIP.
		 AOS -1(P)
		SETZM XRWI
		JRST POPCJ]
	.USET USRI,C
	AOS -1(P)
	SETZM XRWI
	JRST POPCJ

FETCHA:	HRLZI D,(A)
	HRRI D,D
	SETOM XRWI
	.GETLOC D,
	AOS (P)
	SETZM XRWI
	RET

FETCHB:	SETOM XRWI
	MOVE D,(A)
	AOS (P)
	SETZM XRWI	;DON'T SKIP-RETURN IF MPV.
	POPJ P,


pdumpi:	movei c,nctltf	;NCTLTF is where we'll put our indirect filenames
	hrli a,ufile(u)	;use the $L filenames for the default
	skipn ufnamd(u)	;if there's a loaded file
	  hrli a,ufnamd(u)  ;use that instead.
	hrri a,nctltf	;for indirection, as well.
	blt a,nctltf+3
	call pdump1	;Get the filenames to dump out to
	skipe toktrm	;if user must be prompted (by link2),
	 call warn1	;unread an altmode to show user the new defaults.
	movei c,nctltf	;ask for more filenames
	call link2	;prompt if necessary for name of TO- file.
	   7type [asciz /(File with Symbols)  /]
	movei c,nctltf
	setom gsdnum	;tell RRFL1 to clobber SYS: to DSK:
	call rrfl1	;read in the filenames
	move a,nctltf	;check out to see if they are the same
	move b,nctltf+1
	camn a,ufile(u)
	  came b,ufile+1(u)
	    jrst ncrcer	;    a difference was encountered, win!
	move a,nctltf+2
	move b,nctltf+3
	camn a,ufile+2(u)
	  came b,ufile+3(u)
	    caia
	      7nrtyp [
asciz /ADon't write indirect symbol table pointers to self!A/]

ncrcer:	call pdump2	;dump out the file
	call djblk	;write out the start address
	skipl b,bininf(u)  ;if there is BIN info, dump it.
	  jrst pdmpni	;  non, don't bother.
	movei a,stbinf  ;dump the random bin file info.
	call ndmps1
pdmpni:	movei a,stbfil  ;header for indirect symbol table
	movsi b,-4	;then output names of last file loaded
	hrri b,nctltf	;temporary filenames are found here
	call ndmps1	;write the symbol-table block
	call djblk	;write the start address again
	jrst kpdum2	;and finish up.

KPDUMP:	CALL NDMPSC	;WARN IF ABOUT TO LOSE SYMBOLS.
	call pdump1	;get our info, open our output file
	call pdump2	;dump it
	CALL NDMPS
KPDUM2:	SYSCLO RENMWO,[%CLIMM,,UTOC ? UFILE1(U) ? UFILE2(U)]
	SKIPGE (P)
	 CALL INSRTB
	CALL TSTOPX
	.CLOSE UTOC,
	JRST NLTL4

pdump1:	SETOM GSDNUM	;TELL RRFLB TO CLOBBER SYS: TO DSK:
	PUSHJ P,RRFLB
	TSCLO KPDUMO
	CALL NALTBS	;STOP JOB AND REMOVE BPTS; SETS LH OF (P).
	ret

;;; actually dump out the file
pdump2:	setz a,
	.call kpdum1
	  opner ufilo
	ret

KPDUMO:	SETZ ? SIXBIT/OPEN/
	[7,,UTOC]
	UFILE(U)
	[SIXBIT/_DUMP_/]
	['OUTPUT]
	SETZ UFILES(U)

UFILO:	SETZ ? SIXBIT/OPEN/
	A
	UFILE(U)
	UFILE1(U)
	UFILE2(U)
	SETZ UFILES(U)

KPDUM1:	SETZ		;USED FOR PURE DUMP
	SIXBIT /PDUMP/
	[USRI]
	[UTOC]
	400000,,A

NALTY:	JUMPL U,QJERR
	CALL WARN
	 7TYPE [ASCIZ / (Dump to File)/]
	PUSHJ P,GSOT
KDUMP:	SETOM GSDNUM
	PUSHJ P,RRFLB	;:DUMP COMMAND.
	TSCLO KPDUMO
	MOVE B,(W4)
	TLZ F,FLC
	TLNE B,O.IFX	;$0Y => DUMP AS IMAGE.
	  jrst [TLO F,FLC  ;Note that we want to dump as image
		jrst .+2]  ;and don't warn about symbols
	  CALL NDMPSC	; (ELSE) WARN IF ABOUT TO LOSE SYMBOLS.
	CALL NALTBS	;STOP JOB AND REMOVE BPTS
	PUSHJ P,NDMP	;DUMP THE JOB
	JRST KPDUM2	;IF NEC., RESTART AND INSERT BPTS.

NDMP:	MOVE A,[JRST 1]
	TLNN F,FLC	;NO JRST 1 IF DUMPING AS IMAGE.
	PUSHJ P,NDMPA
	CALL N2AZ1	;GET LOW LIMIT IN C, HIGH IN D.
	CAML D,C	;SKIP IF NO CORE TO DUMP.
NDMP2:	 PUSHJ P,GCBLKP
	  JRST NDMPS
	TLNE F,FLC	;AS IMAGE => DUMP ALL INTO FILE.
	 JRST [.IOT UTOC,A ? JRST NDMP2]
	SKIPN (A)	;LOOK FOR NON-ZERO
NDMP3:	AOBJN A,.-1
	JUMPGE A,NDMP2	;GET NEXT BLOCK
	HRRZM A,W1	;SAVE START
	CAIA		;DON'T CHECK 1ST WD FOR BEING ZERO.
			;AVOIDS SCREW IN CASE SOME OTHER JOB CHANGES IT FROM
			;NONZERO TO ZERO BETWEEN NDMP3 AND NDMP4.
	 SKIPE (A)	;LOOK FOR ZERO
NDMP4:	  AOBJN A,.-1
	JUMPGE A,NDMP5	;END, MAKE DUMP BLOCK
	AOBJP A,NDMP7	;NEXT WRD IS END
	SKIPE (A)	;SEE IF ONLY ONE ZERO
	JRST NDMP4
NDMP7:	SUB A,[1,,1]
NDMP5:	SUB A,[1,,1]
	MOVEM A,W2	;SAVE END
	MOVE A,C
	SOS A
	HRRZ B,W1
	CAIL B,AC0
	CAILE B,AC0+17
	SKIPA
	SUBI B,AC0
	DPB B,[1200,,A]	;GET TRUE ADDRESS
	HRRZ B,W2
	SUB B,W1
	SETCA B,
	HRL A,B
	PUSHJ P,NDMPA
	MOVE B,A
	HRR A,W1
	.IOT UTOC,A
	MOVE A,B
	HRR B,W1
NDMP6:	ROT A,1
	ADD A,(B)
	AOBJN B,NDMP6
	PUSHJ P,NDMPA
	MOVE A,W2
	JRST NDMP3

;WRITE OUT THE WORD IN A.
NDMPA:	HRROI B,A
	.IOT UTOC,B
	POPJ P,

;WRITE OUT THE SYMBOL TABLES AND START ADDRESSES AS APPROPRIATE.
NDMPS:	TLZE F,FLC	;DUMPING AS IMAGE => NO SYMS.
	 RET
	PUSHJ P,DJBLK
	MOVE B,BININF(U)
	MOVEI A,STBINF	;DUMP THE RANDOM BIN FILE INFO.
	CALL NDMPS1
	MOVE B,SYSAOB	;IF SYS JOB, GET SYS SYMTAB PTR,
	SUBI B,772000-SYSSYM
	SKIPN SYSSW
	 MOVE B,JOBSYM(U) ;ELSE GET JOB'S SYMTAB PTR.
	SKIPE UFNAM1(U)	;IF NO SYMS, BUT DO KNOW NAME OF LAST FILE LOADED,
	 JUMPGE B,NDMPSI	;DUMP AN "INDIRECT SYM TAB BLOCK" POINTING AT IT.
	MOVEI A,STBDEF
	CALL NDMPS1	;OTHERWISE WRITE THE SYMTAB ITSELF.
	MOVE B,UNDEFL(U) ;AFTER THE SYM TAB, DUMP THE UNDEF SYM TAB.
	MOVEI A,STBUND	;UNDEF SYM TAB IS BLOCK TYPE 1
	CALL NDMPS1
DJBLK:	SKIPE A,STARTA(U)
	 HRLI A,(JRST)	;THIS MAKES SURE SIGN NOT SET AND LH NOT 0.
	JRST NDMPA

NDMPSI:	SKIPN UFNAMD(U)
	 JRST DJBLK	;SKIP THE INDIR. SYMTAB PTR IF THERE'S NO FILENAME TO POINT IT AT.
	MOVE C,[-4,,STBFIL]
	MOVE A,C	;OUTPUT A HEADER FOR THE INDIRECT SYM TAB BLOCK.
	CALL NDMPA
	MOVSI B,-4	;THEN OUTPUT NAMES OF LAST FILE LOADED AS CONTENTS OF BLOCK,
	HRRI B,UFNAMD(U)
	CALL NDMPS2	;AUTOMATICALLY COMPUTING CHECKSUM.
	JRST DJBLK

;IF THE FILE WE ARE ABOUT TO DUMP WOULD CONTAIN AN
;INDIRECT SYMTAB POINTER TO ITSELF, WARN THE USER;  IF HE SAYS "GO AHEAD",
;AVOID DUMPING THE LOOPING POINTER AND JUST DUMP NO SYMBOLS.
NDMPSC:	SKIPGE JOBSYM(U)	;IF THE JOB HAS NO SYMBOLS,
	 RET
	MOVE A,UFNAMD(U)	;AND THE NAMES OF THE LOADED FILE
	MOVE B,UFNAM1(U)	;MATCH WHAT WE ARE DUMPING AS
	CAMN A,UFILE(U)
	 CAME B,UFILE1(U)
	  RET
	MOVE A,UFNAM2(U)
	MOVE B,UFNAMS(U)
	CAMN A,UFILE2(U)
	 CAME B,UFILES(U)
	  RET			;THEN ASK WHETHER TO GO AHEAD.
	7TYPE [ASCIZ /--Symbols not loaded.  Dump anyway--/]
	CALL MORFL1
	 JRST ERR
	SETZM UFNAMD(U)		;AND IF SO, DUMP A FILE WITH NO SYMS INSTEAD OF A LOOPING ONE.
	RET

;A HAS TYPE CODE, B HAS AOBJN TO DATA;  DUMP A SYMBOL TABLE BLOCK.
NDMPS1:	JUMPGE B,CPOPJ
	HLL A,B
	SAVE B
	PUSHJ P,NDMPA	;OUTPUT -<BLOCK SIZE>,,<TYPE CODE>
	REST B
	MOVE C,A	;START OFF CHECKSUM WITH THE AOBJN WD.
NDMPS2:	PUSHJ P,ALDRD1	;COMPUTE CHECKSUM IN C OF WORDS IN RANGE <- B.
	.IOT UTOC,B	;OUTPUT THE DATA
	MOVE A,C
	JRST NDMPA	;OUTPUT CHECKSUM.

KOLOAD:	TRO F,OLOADF	;:OLOAD - FORCE SORT AND ASSUME NO PROGRAM SORTED YET.
	JRST NALTL1

NALTL:	MOVEI A,[ASCIZ / (Load Bin File)/]
	TLNN B,O.IFX
	 JRST NALTL2
	MOVEI A,[ASCIZ / (Load Core Image)/]
	SKIPE -1(W4)
	 MOVEI A,[ASCIZ / (Load Without Symbols)/]
NALTL2:	CALL WARN
	 7TYPE (A)
	CALL GSOT	;$L - INIT READIN, TYPE SPACE.
NALTL1:	TLNE B,O.2ALT
	CALL [	MOVE D,UJNAME(U)
		CAME D,[SIXBIT/PDP6/]
		CAMN D,[SIXBIT/PDP10/]
		 RET	;$$L ALLOWED ON PDP6 EVEN THOUGH RUNNING.
		JRST QRERR]	;CAN'T $$L IF RUNNING.
KLOAD:	PUSHJ P,QI6JER
	SAVE A
	PUSHJ P,RRFLB	;GET FILE NAME TO LOAD.  PASSES INFO TO KLOADO IN FLNEGE.
	REST A
	TLO F,FLQ+4^5	;FLC ON => CAUSE LOADING OF SYMS.
	TLZ F,FLC
	TLNN B,O.2ALT
	 TLZ F,4^5	;SIGN ON => $$L (DON'T RESET)
	TLNN B,O.IFX
	 TLC F,FLQ+FLC	;FLQ ON => $0L.
	SKIPE A		;$1L MEANS LOAD WITHOUT SYMBOLS.
	 TLZ F,FLQ
	CALL KLOADO	;OPEN FILE TO LOAD, SEARCHING DIRECTORIES AS APPRO.
	SKIPN UINT(U)	;IF CLOBRF IS SET, ASK FOR CONFIRMATION BEFORE LOADING A RUNNING JOB.
	 SKIPE UINTWD(U)
	  JRST KLOAD1
	SKIPN CLOBRF
	 JRST KLOAD1
	7TYPE [ASCIZ/--Reload Running Job--/]
	CALL MORFL1
	 JRST ERR
KLOAD1:	CALL ALOAD1	;THEN ACTUALLY LOAD FROM UTIC.
	JRST NLTL4

;OPEN ON UTIC THE FILE SPEC'D IN UFILE(U), USING SNAME SEARCH LIST IF ENABLED AND FLNEGE=0.
KLOADO:	CALL SMFLCK	;GIVE ERROR IF DEV IS TTY: (DON'T CLOBBER TTYSET)
	TLNE F,FLNEGE
	 JRST NALTL4
	MOVEI B,UFILE(U)
	CALL FLOCK	;TRY SPEC'D NAMES ON VARIOUS DIRS, SKIP IF WIN.
	 JRST NALTL3	;TRY ALTERNATE DEFAULT.
	MOVE D,SNLIST
	MOVEM D,LSNAM
	MOVEM D,UFILES(U) ;DEFAULT SNAME IS DIR ACTUALLY FOUND ON.
	JRST TYOFRC

NALTL3:	.SUSET [.SSNAM,,IFILE+3]
	MOVEI B,IFILE
	CALL FLOCK
	 JRST NALTL4	;ALTERNATE FAILED, GO GIVE ERROR.
	MOVEI A,IFILE
	MOVE B,IFILE+3
	CAME B,SNLIST	;DON'T PRINT SNAME IF FLOCK DID.
	 SETZ B,
	CALL LFILE0	;PRINT ALTERNATE DEFAULT.
	CALL CRF
	
	MOVE D,SNLIST	;GET SNAME ACTUALLY USED.
	MOVEM D,IFILE+3
	MOVEM D,LSNAM
	MOVEI A,UFILE(U)
	HRLI A,IFILE	;COPY IT INTO NORMAL DEFAULT.
	BLT A,UFILES(U)
	SETZM UFLSYS(U)
	JRST TYOFRC

NALTL4:	.SUSET [.SSNAM,,LSNAM]
	MOVE A,[.BII,,UTIC]
	TSCLO UFILO
	JRST TYOFRC	;ORIGINAL NAME GOT CREATED.

ALOAD:	TLZ F,FLQ	;FROM ^K, NOT IMAGE LOAD.
ALOAD1:	SKIPN SAFE(U)
	 JRST ALOAD3
	7TYPE [ASCIZ /--Reload Protected Job--/]
	CALL MORFL1
	 JRST ERR
ALOAD3:	syscle rfname,[movei utic ? movem ufnamd(u) ? movem ufnam1(u)
			movem ufnam2(u) ? movem ufnams(u)]
	JUMPL F,ALD
	TLZ F,FLRO
	SETZM PATCHL(U)
	MOVE A,UJNAME(U)
	CAME A,[SIXBIT/PDP6/]
	 CAMN A,[SIXBIT/PDP10/]
	  JRST [ .RESET USRI,
		 JRST ALOAD2]
	.USET USRI,[.RTTY,,A]
	.RESET USRI,
	.USET USRI,[.STTY,,A]
	SYSCLE CORBLK,[%CLIMM,,0 ? %CLIMM,,USRI ? %CLIMM,,0]
			;.RESET MAKES A PAGE 0 - FLUSH IT.
	SETOM UINTWD(U)	;TELL JCL3 NOT TO RESTART THE JOB.
	CALL JCL3	;SET OPTBRK, MAYBE OPTCMD.
	.USET USRO,[.SSNAM,,MSNAM]	;SET SYSTEM NAME TO WORKING DIRECTORY.
ALOAD2:	HRRZS BPINFL(U)	;BPTS AREN'T IN NOW.
	SETZM BTADR(U)	;NO TEMP BPT.
	MOVEI D,21
	MOVEM D,UINTWD(U)
	PUSHJ P,ELECTRON
	MOVEI W1,BININF(U)
	PUSHJ P,ELEC0
	MOVEI W1,UNDEFL(U)
	PUSHJ P,ELEC0
	SETZM LITCNT(U)

;HERE WE ARE FINISHE RESETTING THE JOB.  DO THE ACTUAL LOAD.
ALD:	SAVE [ALDXIT]	;MAKE SURE WE CLOSE UTIC WHEN FINISHED.
	LDB D,[121000,,ARG1]
	SUBI D,1	;# OF LAST PAGE BELOW WHERE WE START LOADING (USUALLY -1)
	MOVEM D,ALDPAG
	TLNE F,FLQ	;FLQ => LOAD AS IMAGE.
	 JRST ALDIM
	SKIPE ARG1	;.CALL LOAD WON'T LOAD WITH OFFSET.
	 JRST ALDND
	SETOM LOADF	;FOR LOAD FAILURE DETECTION
	SYSCAL LOAD,[%CLIMM,,USRI ? %CLIMM,,UTIC ? 3000,,W1]
	 JRST [	SETZM LOADF
		CAIN W1,%EBDDV	;IF LOAD FAILS WITH WRONG-TYPE-DEVICE,
		 JRST ALDND	;TRY DOING THE LOAD "BY HAND".
		OPNER UFILO]	;ELSE COMPLAIN.
	SETZM LOADF
	PUSHJ P,GTWD
ALDJ:	JUMPL A,ALDJ1	;FOR :SL, DON'T SET START ADDR.
	JUMPE B,ALDJ1	;ZERO => NO START ADDRESS, SO DON'T CLOBBER.
	HRRZM B,PPC(U)
	MOVEM B,STARTA(U)
ALDJ1:	TLNN F,FLC	;UNLESS USER HAS SAID NO, GO LOAD THE SYMBOLS.
	 RET
	JRST ALDS

;LOADING BINARY FILES ($L) BUT NOT FROM A DISK
ALDND:	PUSHJ P,GTWD
	CAME B,[JRST 1]	;SKIP PAST THE SBLK LOADER, ETC.
	 JRST ALDND
	MOVEI A,-1	;INITIALLY, VPAGE IS EMPTY.
	CALL ALD1A	;LOAD THE SBLKS OF PROGRAM.  RETURN WITH START INSN IN B.
	JRST ALDJ	;GO SET START ADDR AND MAYBE LOAD THE SYMBOL TABLE WHICH FOLLOWS.

;LOAD THE DATA FROM AN SBLK FILE OPEN ON UTIC.  A SHOULD HOLD 0,,-1.
;IF A HAS -1,,-1 THEN THE DATA IS SKIPPED OVER AND DISCARDED.
;ON REACHING THE START INSTRUCTION (WHICH PRECEDES THE SYM TAB)
;RETURN WITH THE INSTRUCTION IN B.
ALD1A:	SAVE A
ALD1:	PUSHJ P,GTWD	;GET HEADER OF NEXT SBLK.
	JUMPGE B,POPAJ	;NONNEGATIVE => IT IS START ADDR.  WE ARE DONE.
	MOVE C,B
	ADD B,ARG1	;ARG TO $L => SHIFT UP THAT MUCH IN CORE.
ALD2:	LDB D,[121000,,B] ;WHAT PAGE LOADING INTO?
	SKIPL (P)	;MAYBE WE ARE SKIPPING THRU FOR :SYMLOD
	CAMN D,(P)
	 JRST ALD3	 ;OR ALREADY HAVE THAT PAGE IN VPAGE.
	MOVEI A,(B)
	CAIGE A,20	;MAYBE WE SHOULD LOAD THE ACS.
	 CALL ALDAC	;LOAD WHAT PART OF THIS BLOCK GOES IN THE ACS.
	JUMPGE B,ALDND1	;IF WHOLE THING WENT IN ACS, GET NEXT BLOCK.
;HERE WE MAP THE PAGE FROM THE INFERIOR.  IF FAIL, TRY TO CREATE THE PAGE.
	SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? %CLIMM,,VPAGE ? %CLIMM,,USRI ? D]
	 CALL ALDCOR
	MOVEM D,(P)	;SAY NOW HAVE THAT PAGE.
ALD3:	MOVE D,B	;SAVE REAL AOBJN,
	TRZ B,-2000	;MAKE B -> VPAGE, NOT ADDR IN INFERIOR.
	IORI B,VPAGAD
	MOVSI A,-VPAGAD-2000(B)
	CAML A,B
	HLL B,A		;DON'T GO BEYOND END OF THAT VPAGE.
	PUSHJ P,ALDRD
	HLRS B
	HRLI B,-1(B)
	SUBM D,B
	JUMPL B,ALD2
ALDND1:	PUSHJ P,GTWD
	CAME C,B
CKSERR:	ERSTRT [SIXBIT/CHECKSUM?/]
	JRST ALD1

FILENG:	TERR (SIXBIT/BIN/)

;MAKE THE INFERIOR'S PAGE WHOSE NUMBER IS IN D.
;RETURN TO INSN PRECEDING THE CALL.
ALDCOR:	SAVE D
	SAVE A
	AOS A,ALDPAG	;IF LOADING ABOVE CORE WE'VE CREATED,
	MOVEM D,ALDPAG	;WE MUST ALSO CREATE ALL PAGES IN BETWEEN.
	SUBM A,D	;GET # PAGES WE MUST CREATE
	HRLI A,-1(D)	;GET AOBJN TO PAGES WE MUST CREATE
	SYSCLO CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,USRI ? A ? %CLIMM,,%JSNEW]
	SOS -2(P)
	SOS -2(P)
	JRST POPADJ

ALDAC:	SAVE W1		;LOAD A BLOCK INTO THE ACS (AOBJN IN B)
	MOVE W1,B
ALDACL:	CALL GTWD	;TRANSFER ONE WORD
	ROT C,1		;UPDATING THE CHECKSUM IN C.
	ADD C,B
	MOVE D,B
	HRRZ A,W1
	CALL DEP
	ADDI A,1	;ADVANCE TO NEXT WORD.  EXIT AFTER XFERRING THE WHOLE BLOCK
	AOBJP W1,ALDACX
	CAIE A,20	;OR WHEN IT'S TIME TO LOAD A NON-AC.
	 JRST ALDACL
ALDACX:	MOVE B,W1
	REST W1
	RET

ALDRD:	MOVE A,B
	PUSHJ P,GTWD1
ALDRD1:	MOVE A,B
ALDRD2:	ROT C,1
	ADD C,(A)
	AOBJN A,.-2
	POPJ P,

GTWD:	HRROI A,B
GTWD1:	.IOT UTIC,A
	JUMPL A,FILENG
	POPJ P,

ALDIM:	CALL VPAGET	;IMAGE LOAD, GET A FRESH PAGE TO USE AS A BUFFER.
	.ACCESS USRO,ARG1	;START AT 1ST ARG.
	.USET USRI,[.RMEMT,,A]
	LSH A,-10.
	MOVEM A,ALDPAG	;DON'T TAKE TIME TO CORTYP ABOVE JOB'S ORIGINAL MEMT.
ALDIM1:	MOVE A,[-2000,,VPAGAD]
	LDB B,[.BP 1777,ARG1]	;DON'T READ SO MUCH THAT WE'D PASS A PAGE BOUNDARY
	TSO A,B			 ;IN THE JOB.
	.IOT UTIC,A	;READ UP TO 1 PAGE.
	MOVEI D,-VPAGAD(A)
	JUMPE D,ALDIM2	;NO MORE LEFT IN FILE?
	ADDB D,ARG1	;GET ADDR OF 1ST WORD WE AREN'T ABOUT TO WRITE.
	CAIG D,20	;WRITING ONLY IN ACS => DON'T NEED TO CREATE CORE.
	 JRST ALDIM3
	SUBI D,1
	LSH D,-10.
	CAML D,ALDPAG	;IF THIS PAGE IS ABOVE WHAT INFERIOR'S MEMT WAS,
	 JRST ALDIM4	;WE KNOW WE NEED TO MAKE CORE.
	SYSCLE CORTYP,[%CLIMM,,USRI ? D ? %CLOUT,,B]
	JUMPL B,ALDIM3	;IF THERE ISN'T A WRITEABLE PAGE THERE ALREADY, MAKE ONE.
ALDIM4:	SYSCLO CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,USRI ? D ? %CLIMM,,%JSNEW]
ALDIM3:	HRLOI B,-1-VPAGAD(A)
	EQVI B,VPAGAD	;AOBJN -> WHAT WAS READ.
	JUMPGE B,ALDIM2	;NOTHING WAS READ, DONE.
	.IOT USRO,B	;WRITE INTO INFERIOR.
	JUMPGE A,ALDIM1	;NO EOF => TRY FOR MORE.
ALDIM2:	MOVE D,ARG1
	CALL PLOC	;SET "." TO THE END OF THE DATA READ.
	JRST VPAGRT

ALDXIT:	.CLOSE UTIC,
	RET

;LOAD THE SYMBOLS FOR THE FILE OPEN ON UTIC, ASSUMING UTIC IS POSITIONED AT THE SYM TAB.
ALDS:	PUSH P,JOBSYM(U) ;(WILL WANT TO SEE LATER IF SYMTAB WAS ORIGINALLY EMPTY)
	SETO W2,	;SET FLAG SAYING ABOUT TO CALL SLOD0 THE 1ST TIME.
ALDS0:	PUSHJ P,GTWD	;NOW LOAD 1 SBLK -
	SKIPL A,B	;GET -LENGTH,, AS ARG.
	 JRST ALDS2	;NO MORE SYMS.
	ANDI B,-1
	CAIN B,STBUND	;DECODE BLOCK TYPE.  IT MAY CONTAIN UNDEFINED SYMBOL REFERENCES,
	 JRST ALDSU
	CAIN B,STBFIL	;THE NAME OF A FILE WHOSE SYMBOLS WE SHOULD LOAD,
	 JRST ALDSI
	CAIN B,STBINF	;THE RANDOM BIN FILE INFO (WHO ASSEMBLED AND WHEN, ETC).
	 JRST ALDSBI
	CAIE B,STBDEF	;OR SYMBOL DEFINITIONS.
	 JRST FILENG
	MOVEI B,GTWD1
	PUSHJ P,SLOD0	;READ IN THOSE SYMS.
	MOVE A,C	;GET AOBJN -> SPACE FILLED WITH SYMS READ.
	HLLZS C		;PUT HEADER OF SBLK INTO CKSUM.
ALDS3:	PUSHJ P,ALDRD2	;CALCULATE CKSUM.
	PUSHJ P,GTWD	;READ CHECKSUM.
	CAME C,B
	 JRST CKSERR
	JRST ALDS0

ALDSI:	HRRI A,NCTLTF	;LOAD SYMBOLS FROM ANOTHER FILE.
	CAME A,[-4,,NCTLTF]	;THERE SHOULD BE 4 WORDS OF FILENAMES IN THIS BLOCK.
	 JRST FILENG
	CALL GTWD1	;READ THEM IN, THEN IGNORE THE CHECKSUM.
	CALL GTWD
	CALL GTWD	;ANY BLOCKS IN THE FILE AFTER THIS ONE WILL BE IGNORED,
	JUMPL B,FILENG	;SO ANY FILE THAT HAS THEM IS A LOSER.
	SYSCLO OPEN,[ [.BII,,UTIC] ? NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? NCTLTF+3]
			;THEN OPEN THE FILE,
	REST A		;THROW AWAY JOBSYM(U) PUSHED AT ALDS.
	JRST CSMI2	;DO A :SYMLOD OF THE FILE NOW OPEN.

ALDSU:	MOVEI W1,UNDEFL(U)	;LOAD A BLOCK OF UNDEF. SYMBOL TABLE.
	SAVE A
	HRR A,UNDEFL(U)	;GET AOBJN TO THE NEW SPACE
	movei b,stbund	;RH for checksum
	JRST ALDSU1

ALDSBI:	MOVEI W1,BININF(U)
	SAVE A
	HRR A,BININF(U)
	movei b,stbinf	;RH for checksum
ALDSU1:	EXCH A,(P)
	CALL HOLE0	;MAKE SPACE TO READ INTO
	REST A
	MOVE C,A
	CALL GTWD1	;READ THE DATA IN
	MOVE A,C
	hrri c,(b)	;RH goes into the checksum
	JRST ALDS3	;CHECK THE CHECKSUM AND READ MORE OF FILE.

ALDS2:	POP P,A
	TRNE F,OLOADF	;ALWAYS SORT FOR :OLOAD.
	 JRST SSRT
	JUMPL A,SSRT	;IF MERGED FILE'S SYMS WITH OTHERS, MUST SORT.
	JUMPGE W3,SSRT	;IF FILE DIDN'T HAVE SORTED SYMS, SORT.
	JRST SGLOB	;ELSE SET PRGM -> GLOBAL BLOCK, DON'T SORT.

KSYMAD:	TDZA B,B	;DON'T FLUSH CURRENT SYMS.
KSYMLO:
CSMI:	MOVNI B,1
	HRLM B,(P)
	PUSHJ P,QOJERR	;CAN'T :SL IN SYS JOB OR SELF.
	PUSHJ P,RRFLB
	CALL KLOADO
	SKIPGE (P)
	 CALL ELECTRON
	MOVE A,[6,,UTIC]
	TSCLO UFILO
	SAVE [NLTL4]
	SAVE [ALDXIT]
;HERE TO LOAD SYMBOLS FROM A FILE JUST OPENED.  DOESN'T CLOSE IT.
CSMI2:	PUSHJ P,VPAGET
	PUSHJ P,GTWD
	JUMPN B,CSMI4	;SBLK  (FIRST WORD 0=> FILE PLOADED)
	MOVE B,[UTIC,,VPAGAD]
	.RCHST B,
	SKIPGE VPAGAD+4	;ACCESS POINTER
	ERSTRT [SIXBIT /PURE FILE NOT ON DISK?/]
	MOVE B,[-400,,VPAGAD] ;READ THE PAGE DESCRIPTOR WDS.
	.IOT UTIC,B
	MOVSI B,-400
	MOVEI W1,1	;THE DESCRIPTORS TAKE 1 PAGE OF FILE.
CSMI5:	SKIPLE VPAGAD(B)	;SOME DESCRIPTORS HAVE PAGES IN FILE.
	 AOJ W1,
	AOBJN B,CSMI5
	LSH W1,12	;CONVERT # PAGES TO ACCESS POINTER
	.ACCESS UTIC,W1	;SKIP TO END OF PROGRAM
	JRST CSMI3	;NOW LOAD SYMBOLS (1ST WORD >0)

CSMI4:	TDZA W1,W1	;SKIP TO THE SYM TAB OF AN SBLK FILE, THE HARD WAY.
	PUSHJ P,GTWD
	CAME B,[JRST 1]	;FIRST, SKIP PAST THE SBLK LOADER IF ANY.
	AOJA W1,.-2
CSMI3:	MOVNI A,1	;THEN, "LOAD" THE DATA, BUT INTO BIT BUCKET INSTEAD
	CALL ALD1A	;OF INTO THE INFERIOR'S CORE.
	CALL VPAGRT	;ALD1A RETURNS ON REACHING THE SYMBOL TABLE.
	JRST ALDS

;<ARG>^Y - ARG IS AOBJN -> SYMS TO LOAD.  $^Y FLUSHES EXISTING SYMS FIRST.
NCTLY:	CALL QOJERR
	TLNE B,O.1ALT
	 CALL ELECTRON
	CALL GARGDQ	;GET ARG OR $Q IN D.
NCTLY1:	JUMPGE D,NCTLYX	;DO NOTHING IF ADDING 0 SYMS.
	HRRZ B,D	;GET ADDRESS OF BEGINNING OF AREA
	.ACCESS USRI,B
	MOVE A,D	;GIVE AOBJN TO SLOD.
	PUSH P,[NCTLYX]
	SAVE JOBSYM(U)	;ALDS2 WILL LOOK AT & POP THIS.
	PUSH P,[ALDS2]	;MAYBE SORT SYM TAB AFTER LOADING.
	JSP B,SLOD
	SAVE XRWI
	SETOM XRWI	;MAKE MPV'S ON THE USR-IOT BELOW CAUSE THE IOT TO SKIP.
	.IOT USRI,A
	 CAIA
	  JRST ERR
	REST XRWI
	RET

n2acx:	skipn masscp	;do we want this command?
	  7NRTYP [ASCIZ/ OP? /]
	skipn confrm	;do we want confirmation?
	  jrst massac	;  no, so don't ask!
	PUSHJ P,RIN
	 JRST ALTDQX	;IF RUBOUT, RETYPE THE $U.
	CAIE D,".
	JRST NXERR
	jrst massac	;kill them all

N2ACY:	SKIPN ARG1+1	;$$^Y
	 JRST NXERR
	CALL QI6JERR	;JOB MUST BE INFERIOR OR PDP6 TO WRITE SYMTAB INTO IT.
	MOVE A,ARG1
	PUSHJ P,FETCH	;READ AOBJN POINTER.
	 JRST NXERR
N2ACY1:	SAVE A
	HLRE A,D	;GET LEFT HALF
	MOVMS A		;LENGTH OF EXISTING TABLE.
	ADDI A,(D)	;ADDR OF WD AFTER END OF TABLE.
	HLRE D,JOBSYM(U)
	ADD A,D	;START OF NEW SYM TAB.
	JUMPLE A,NXERR	;NO ROOM?
	.ACCESS USRO,A
	MOVE D,JOBSYM(U)
	SAVE XRWI
	SETOM XRWI
	.IOT USRO,D	;TRANSFER IT.
	 CAIA
	  TERR 'MPV
	REST XRWI
	MOVE D,A
	HLL D,JOBSYM(U)	;NEW AOBJN POINTER.
	REST A
	PUSHJ P,DEP
NCTLYX:	SKIPE HAKING
	 JRST HAKWIN
	JRST NLTL2

;LOAD SYMS FROM ARBITRARY SOURCE.
;B HOLDS ADDR OF ROUTINE TO TAKE AOBJN IN A AND READ IN SYMS.
;LH OF A IS -<SIZE OF TABLE>
;CLOBBERS A,B,C,D,W1,W2,W3.
SLOD:	SETO W2,	;ABOUT TO CALL SLOD0 THE 1ST TIME.
SLOD0:	JUMPGE A,CPOPJ	;NOTHING TO ADD.
	TLNE A,1
	 ERSTRT [SIXBIT /ODD LENGTH SYMBOL TABLE?/]
	ANDCMI A,-1	;MAKE SURE RH, CLEAR.
	SAVE [0]
	PUSH P,A
	JUMPE W2,SLOD1	;NOT 1ST TIME => DON'T INITIALIZE.
	SKIPL JOBSYM(U)
	 PUSHJ P,SINIT	;CREATE GLOBAL BLOCK IF NONE.
	HRRZ D,JOBSYM(U)
	HLRE A,JOBSYM(U)
	SUBM D,A	;GET ADDR OF WD AFTER SYMTAB.
	MOVEM A,PRGM(U)
	HRROI A,W2	;READ 1ST 2 WDS OF SYM TAB.
	PUSHJ P,(B)
	HRROI A,W3
	PUSHJ P,(B)
	MOVE A,(P)	;GET -<SPACE NEEDED>,,
	TLNE W2,%SYLCL	;1ST SYM LOCAL => NO BLOCK STR, PUT AT END.
	 JRST SLOD1
SLOD2:	PUSHJ P,SGLOB	;BLOCK STRUCTURED, LOAD BEFORE GLOBAL BLOCK.
	HRRZS PRGM(U)
	JUMPGE W3,SLOD1
	TLNN W2,%SYFLG
	 ADD A,[2,,]	;IF SYMTAB IS SORTED, OVERWRITE EXISTING GLOBAL HEADER
			;TO MERGE OUR GLOBAL BLOCK WITH FILE'S.
	MOVSI D,-2	;UPDATE PRGM PROPERLY
	MOVEM D,-1(P)	;NECESSARY IN CASE CALL SLOD0 2ND TIME.

SLOD1:	PUSH P,B
	MOVEI W1,PRGM(U)
	SAVE A
	SAVE JOBSYM(U)
	CALL HOLE0	;GET ROOM FOR SYMS.
	REST JOBSYM(U)
	REST A
	ADDM A,JOBSYM(U)
	POP P,B		;SYMBOL READIN RTN ADDR.
	POP P,A		;-<# WDS OF SYMS>,,
	REST D
	ADDM D,PRGM(U)
	HLL C,A		;AOBJN -> SPACE FOR THEM, LEAVE IN C FOR ALDS TO CALC. CKSUM.
	MOVE A,C
	JUMPE W2,(B)	;2ND TIME AND AFTER, JUST READ THEM.
	MOVEM W2,(A)	;1ST TIME, STORE THE 1ST 2 WDS.
	MOVEM W3,1(A)
	TLNE W2,%SYFLG	;NOT BLOCK STRUCTURED =>
	 SETZ W3,	;TELL ALDS2 MUST SORT IN ANY CASE.
	SETZ W2,	;NEXT TIME, DON'T INITIALIZE.
	AOBJP A,.+1
	AOBJN A,(B)
	POPJ P,	;THOSE 1ST 2 WDS WERE ALL!

;SORT THE SYM TAB.
SSRT:	SETZM PRGM(U)	;SAY HAVEN'T YET SEEN GLOBAL BLOCK.
	PUSHJ P,SSBG	;BUBBLE ALL GLOBALS TO END.
SSRT9:	MOVE A,JOBSYM(U)
SSRTB:	JUMPGE A,SSRT2
	MOVE D,(A)
	TLNE D,%SYFLG	;IF NO BLOCK NAME,
	 JRST SSRT2	;PUT GLOBAL BLOCK HERE.
	MOVSI C,4^5	;FOR :OLOAD, CLEAR SIGN SO WON'T
	TRNE F,OLOADF	;THINK THE BLOCK ALREADY SORTED.
	 ANDCAM C,1(A)
	HLRE C,1(A)	;THIS IS <0 IFF BLOCK WAS SORTED.
	JUMPGE C,SSRT3	;WASN'T SORTED => SORT IT.
	CAMN D,[SQUOZE 0,GLOBAL]	;ALWAYS SORT GLOBAL BLOCK.
	 JRST [MOVEM A,PRGM(U) ? JRST SSRT3]
	HRLI C,-1(C)	;DON'T SORT, JUST PASS
	SUB A,C	;THE BLOCK BY, TRY NEXT.
	JRST SSRTB

SSRT2:	SKIPE PRGM(U)	;AT END: IF NO GLOBAL BLOCK, MAKE ONE.
	 JRST [TRZ F,OLOADF ? RET]
	PUSHJ P,SSRTG
SSRT3:	SKIPE PRGM(U)
	SKIPA D,[%SYFLG,,] ;ONLY GLOBAL BLOCK CAN HAVE GLOBAL SYMS.
	MOVSI D,%SYLCL	;OTHER BLOCKS CAN'T.
	MOVE B,A
SSRT0:	ADD B,[2,,2]
	JUMPGE B,SSRT1	;MOVE B UP AFTER END OF THIS BLOCK.
	TDNE D,(B)
	JRST SSRT0

SSRT1:	MOVSI W2,4^5		;SORT 1ST ON TOP BIT.
	MOVE W1,[TDNE W2,1(A)]	;SORT ON BIT IN 2ND WD,
	MOVE C,[TDNN W2,1(B)]	;PUT STE'S WITH BIT ON FIRST.
	MOVEI W3,[HRLI W1,(TDNN W2,(A))
		HRLI C,(TDNE W2,(B))
		MOVEI W3,SSRTX	;REVERSE THAT LAST, ON THE REST OF THE BITS.
		JRST SSRTX]
	PUSH P,B	;SAVE NEXT BLOCK'S START ADDR.
	ANDI A,-1
	SKIPGE 1(A)	;IF THIS IS GLOBAL BLK BEING SORTED ANYWAY,
	 JRST SSRT4	;DON'T CLOBBER ITS LEVEL.
	AOS D,1(A)
	CAIL D,-1	;THIS IS PROGM NAME -> MAKE LEVEL 1,
	SETZM 1(A)
	AOS 1(A)	;ELSE 2+LEVEL OF BLOCK.
SSRT4:	SUBM A,B
	HRLM B,1(A)	;STORE -<SIZE OF BLOCK'S ENTRY>
	HRRZ B,(P)
	ADDI A,2	;DON'T INCLUDE BLOCK NAME IN SORT.
	PUSHJ P,SSRTX
	POP P,A
	JRST SSRTB	;SORT NEXT BLOCK.

;CREATE A GLOBAL BLOCK HEADER WHERE A POINTS,
;MAKE PRGM POINT THERE.
SSRTG:	HRRZM A,PRGM(U)	;PLACE TO PUT IT.
	PUSH P,A
	MOVEI W1,PRGM(U)
	MOVSI A,-2
	ADDM A,JOBSYM(U)
	PUSH P,JOBSYM(U)
	PUSHJ P,HOLE0	;MAKE SPACE.
	POP P,JOBSYM(U)
	POP P,A
	SUB A,[2,,]	;SYMTAB TAIL -> GLOBAL BLOCK HEADER.
	MOVEM A,PRGM(U)
	MOVE D,[SQUOZE 0,GLOBAL]
	MOVEM D,(A)	;PUT THE STUFF IN.
	MOVSI D,-2
	MOVEM D,1(A)
	POPJ P,

SSRTX:	HRLM B,(P)	;DO ONE PASS OF RADIX-EXCHANGE. SAVE END.
	CAIL A,-2(B)	;ONLY 1 ENTRY, NOTHING TO DO.
	 JRST SSRTX7
	PUSH P,A	;SAVE START.
SSRTX3:	XCT W1
	 JRST SSRTX4	;MOVE UP TO 1ST WITH BIT ON.
	SUBI B,2
	XCT C		;MOVE DOWN TO LAST WITH BIT OFF.
	 JRST SSRTX5
REPEAT 2,[
	MOVE D,.RPCNT(A)	;EXCHANGE THEM,
	EXCH D,.RPCNT(B)
	MOVEM D,.RPCNT(A)]
SSRTX4:	ADDI A,2
SSRTX5:	CAME A,B	;ALL DONE => DO NEXT BIT.
	 JRST SSRTX3	;MORE IN THIS PASS.
	ROT W2,-1	;NEXT BIT DOWN.
	POP P,A		;A -> START, B -> END OF 1ST HALF.
	JUMPL W2,SSRTX6	;ALL BITS IN WD DONE, STOP.
	PUSHJ P,(W3)	;DO NEXT BIT ON 1ST HALF.
	HLRZ B,(P)	;A -> END OF 1ST HALF, B -> END OF ALL.
	PUSHJ P,(W3)	;DO SECOND HALF.
SSRTX6:	ROT W2,1	;LEAVE W2 AS FOUND IT.
SSRTX7:	HLRZ A,(P)	;LEAVE A -> END OF AREA SORTED.
	POPJ P,

;BUBBLE ALL GLOBAL SYMS TO END OF SYM TAB.
;WON'T CHANGE ORDER OF NON-GLOBAL SYMS, MAY MESS UP ORDER OF GLOBALS.
SSBG:	MOVE A,JOBSYM(U)	;A -> 1ST OFF BUBBLE OF GLOBALS.
	MOVE B,JOBSYM(U)	;B -> 1ST SYM AFTER BUBBLE.
SSBG0:	JUMPGE B,CPOPJ	;ALL DONE IF BUBBLE AT END.
	MOVE C,(B)	;ELS IS NEXT SYM GLOBAL?
	TLNE C,%SYGBL
	 JRST SSBG1	;YES => INCLUDE IT IN BUBBLE.
	EXCH C,(A)	;NO => EXCHANGE WITH 1ST IN BUBBLE,
	MOVEM C,(B)	;MOVING WHOLE BUBBLE UP 1 STE.
	MOVE C,1(B)
	EXCH C,1(A)
	MOVEM C,1(B)
	ADD A,[2,,2]	;BEGINNING AND END BOTH MOVE UP.
SSBG1:	ADD B,[2,,2]
	JRST SSBG0

;SET D AND PRGM(U) -> GLOBAL BLOCK'S HEADER.
;(OR = JOBSYM(U) IF SYMTAB EMPTY)
SGLOB:	PUSH P,A
	SKIPL D,JOBSYM(U)
	 JRST SGLOB1
SGLOB0:	MOVE A,(D)
	CAMN A,[SQUOZE 0,GLOBAL]
	 JRST SGLOB1	;FOUND.
	ADD D,[2,,2]
	JRST SGLOB0

SGLOB1:	MOVEM D,PRGM(U)
	JRST POPAJ

;INITIALIZE SYM TAB WITH A GLOBAL BLOCK WITH NO SYMS.
SINIT:	SKIPGE JOBSYM(U)
	 ERLOSS JOBSYM(U)
	PUSH P,A
	MOVE A,JOBSYM(U)
	PUSHJ P,SSRTG
	JRST POPAJ

;:PRGM, PRINT CURRENT PROGRAM NAME.
KPRGM:	PUSHJ P,QJERR	;MUST HAVE JOB.
	SKIPL W1,PRGM(U)
	 7NRTYP [ASCIZ/No Syms   /]
	PUSHJ P,SPT	;PRINT BLOCK'S NAME.
	HRRZ D,1(W1)	;GET LEVEL.
	SOJL D,LCTGNR	;IF BLOCK IS GLOBAL BLOCK.
	SOJL D,[7NRTYP [ASCIZ/, Program   /]]
	7TYPE [ASCIZ/, Level /]	;A BLOCK IN PROGRAM.
	PUSHJ P,TOC
	JRST LCTGNR

;:LISTP - LIST STRUCTURE OF SYM. TAB.
KLSTP:	PUSHJ P,QJERR
	HLRE W1,JOBSYM(U)	;GET -LENGTH OF SYMTAB
	JUMPGE W1,NLTL2	;IF NO SYMS.
	CALL MORINI
	 JRST NLTL2	;STOP TYPING IF A **MORE** IS FLUSHED.
	MOVNS W1
	ADD W1,JOBSYM(U)
	ANDI W1,-1	;ADDR OF WD AFTER SYMTAB.
KLSTP1:	CAMN W1,JOBSYM(U)
	 JRST KLSTUX	;GOT TO START OF SYMTAB, DONE.
	SUB W1,[2,,2]	;MOVE BACK 1 SYM AT A TIME.
	MOVE D,(W1)
	TLNE D,%SYFLG
	 JRST KLSTP1	;NOT BLOCK, KEEP GOING.
	MOVE A,1(W1)
	CAMN A,[-2,,1]
	 JRST KLSTP1	;IGNORE PROGRAM NAMES WITH NO SYMS.
	PUSHJ P,CRF	;EACH NAME ON SEPARATE LINE.
	TRNE A,-2	;FOR BLOCKS, USE <LEVEL>-1.
	 SUBI A,1	;SO OUTERMOST BLOCK GETS 1 SPACE LIKE PROGRAM.
	TLZA A,-1	;GET <LEVEL> IN RH ALONE.
KLSTP2:	PUSHJ P,TSPC	;TYPE LEVEL SPACES.
	SOJGE A,KLSTP2
	PUSHJ P,SPT	;THEN TYPE NAME OF BLOCK OR PROGRAM.
	JRST KLSTP1

NACOL:	PUSHJ P,QJERR
	SKIPL A,JOBSYM(U) ;<BLOCK>$:, <BLOCK>$$:
	 JRST NACOLE
	HLRE D,A
	SUB A,D
	ANDI A,-1	;ADDR OF WD AFTER SYM TAB.
	SETZ D,		;ASSUME IT'S $: AND AREN'T CHECKING LEVEL.
	TLNN B,O.2ALT
	 JRST NACOL8
	MOVE A,PRGM(U)	;REALLY IT'S $$:, LOOK FOR CURRENT BLOCK'S INFER.
	MOVE D,1(A)
	AOS D,
NACOL8:	CAMN A,JOBSYM(U)	;CAN'T MOVE BACK PAST START.
NACOLE:	 ERSTRT [SIXBIT / U?/]
	SUB A,[2,,2]
	CAME C,(A)
	 JRST NACOL8	;HAVEN'T FOUND THE BLOCK, WRONG NAME OR NOT BLOCK.
	JUMPE D,NACOL6	;RIGHT NAME, TESTING LEVEL?
	HLL D,1(A)	;COMPARE ONLY THE RH'S.
	CAME D,1(A)
	 JRST NACOL8	;WE ARE AND IT DOESN'T MATCH.
NACOL6:	MOVEM A,PRGM(U)
	JRST LCTGNR

;;; How DDT's core allocator works:
;;; The basic idea is that there is a heap, objects in which are delimited by
;;; AOBJN ptrs into the area, and which may be grown or removed.
;;; Now the specifics:
;;;
;;; Pointers into SYMTAB space (the heap, remember?) are relocated when objects
;;; are moved, by the routine RELOC.  There are two IRPS's in there denoting
;;; the locations of the pointers needing relocating.  The first is the
;;; per-job items, (symbol-tables, JCL, etc.) the second is random global vars
;;; such as JCL, rubout processing, and the like.
;;;
;;; Initially such pointers (which don't have to be AOBJN ptrs,) should point
;;; to DDTEND.  They will be re-located as things are allocated.
;;;
;;; Space is provided for these items by calling HOLE0 with
;;; -<# words to expand by>,,0 in A and the address of the AOBJN ptr to expand
;;; in W1.  It isn't necessary that W1 point to an AOBJN ptr that's relocated
;;; by RELOC, you can have byte pointers relocated by RELOC and put an AOBJN
;;; ptr on the stack and have w1 point to that.
;;;
;;; Call ELEC0 to flush an object in SYMTAB space, with an AOBJN ptr in W1
;;; (It must be an AOBJN ptr this time)

;FLUSH THE CURRENT JOB'S SYMBOLS.
ELECTRON:	HRRZ W1,JOBSYM(U)
	CAIG W1,DDT	;DO NOTHING IF SELF OR SYSTEM.
	 RET
	HRRZ D,SYMTOP
	MOVEM D,PRGM(U)
	MOVEI W1,JOBSYM(U)

;FLUSH AN OBJECT IN SYMTAB SPACE.
;W1 POINTS TO AOBJN PTR OBJECT, PTR CLOBBERED TO SYMTOP.
ELEC0:	HLLZ D,(W1)	;-<CURRENT SIZE>,,
	JUMPE D,CPOPJ	;NOTHING TO DO IF ALREADY 0 SIZE.
	HRRZ A,(W1)	;CURRENT START.
	HRLI A,(A)
	SUB A,D		;END,,START
	HLRES D
	ADD D,SYMTOP	;NEW SYMTOP.
	CAIE D,(A)	;DON'T TRY BLT OF 0 WDS.
	  BLT A,-1(D)
	HRRZS (W1)
	HRRZ A,SYMTOP
	EXCH A,(W1)	;GET OLD START, OBJECT NOW EMPTY, -> TOP.
	SUB D,SYMTOP	;GET -<OLD SIZE>.

;RELOCATE ALL POINTERS INTO SYMTAB SPACE
;WHEN PART OF IT IS SHIFTED.
;A HAS OLD START OF OBJECT THAT CHANGED SIZE,
;D HAS AMOUNT OF CHANGE.
RELOC:	MOVSI W1,-NINFP
	PUSH P,B
	PUSH P,C
	CALL RELC	;FIRST, TRY CHANGING .MEMT, SINCE THAT IS MOST LIKELY THING TO FAIL.

rel0:			;For each per-job item in SYMTAB space
irps x,,jobsym prgm uchbuf bininf undefl radaob
	movei b,x(w1)
	pushj p,rel3	;relocate it
termin
	addi w1,usrlng-1  ;Next job
	aobjn w1,rel0	;(until end)

	MOVEI B,INPDL	;NOW RELOCATE VALRET STRING & ANY PUSHED VALRET STRINGS.
REL1:	MOVEI B,1(B)
	PUSHJ P,REL3
	MOVEI B,2(B)
	PUSHJ P,REL3
	SKIPE B,-3(B)
	JRST REL1
IRPS X,,FLDTBP FLDSTR W4 GSCHRP GSCHRQ GSOCRP GSCHRA CLIBEG CLIPTR CLIOPT CLIEND CLIBPT KILBPT KLBEND KLBBEG KLBIPT
	MOVEI B,X
	CALL REL3
TERMIN
	SKIPE B,RELCP1	;RELOC. SOME SPECIAL PTR (IF ANY)
	 CALL REL3
	ADDM D,SYMTOP
	HRRZS D,SYMTOP	;RELOCATE SYMTOP.
POPCBJ:	POP P,C
	JRST POPBJ

;; REL3 takes:
;;   ADDRESS of ptr where relocation is happening in A
;;   ADDRESS of 1 ptr to relocate in B
;;   Amount to grow in D.
;; it adjusts the pointer if the address of the ptr to relocate is the
;; same as or larger than the one that changed size.

REL3:	HRRZ C,(B)	;B HAS ADDR OF 1 PTR TO RELOCATE.
	CAIGE C,(A)	;RELOC IT ONLY IF AFTER OBJECT THAT CHANGED SIZE.
	  POPJ P,
	ADDI C,(D)
	HRRM C,(B)
	POPJ P,



HOLE0:	PUSH P,W1	;SAVE ADDR OF AOBJN PTR TO EXPAND.
	HRRZ C,(W1)	;MAKE SURE AOBJN TO BE EXPANDED
	CAMG C,SYMTOP	;POINTS INTO THE SYMTAB SPACE
	 CAIGE C,DDTEND
	  ERLOSS (W1)
	HLRE C,(W1)
	MOVNS C		;CURRENT SIZE.
	ADD C,(W1)	;RH HAS 1+CURRENT LAST WD.
	PUSH P,A
	HLRES A
	MOVNS A		;NUM. WDS TO EXPAND.
	HRRZ D,A
	PUSHJ P,RELC	;GET CORE BEFORE MOVE UP.
	HLLZ W1,(P)	;W1 <- 
	ADDM W1,@-1(P)
HOLE1:	HRRZ D,SYMTOP
	SOS D
	HRRM A,HOLPPX	;+#REGS NEW
	MOVEI W1,(SETZ D)	;400000+SYMTOP-1 (AVOID PDL OV)
	SUB W1,C
	HRL D,W1	;400000+#REGS TO MOVE-1,,SYMTOP-1
	SKIPGE D
HOLPOP:	XCT HOLPPX	;MOVE TOP OF SYM TAB UP BY LH(A)
	JUMPL D,.-1
	MOVEI D,(A)
	POP P,A		;GET -<NUM WDS INCREASE> IN LH,
	HRR A,@(P)	;ADDR OF CURRENT START IN RH.
	PUSH P,@(P)	;SAVE THE UPDATED AOBJN PTR
	PUSHJ P,RELOC	;SINCE RELOC WILL WRECK IT.
	POP P,@-1(P)
	JRST POPW1J

;ADJUST MEMORY BOUND OF SYTMAB SPACE PROPERLY WHEN SYMTOP IS TO CHANGE
;BY THE AMOUNT IN D.
RELC:	INSIRP PUSH P,B C D
	ADD D,SYMTOP
	ADDI D,1777
	LDB D,[121000,,D]
	CAIL D,VPAGE-1
	  ERSTRT [SIXBIT/CORE?/]
	MOVE C,NPAGES	;GET # 1ST PAGE SYMTAB SPACE DOESN'T HAVE,
	MOVEM D,NPAGES	;REPLACE W # 1ST PAGE IT DOESN'T NEED,
	MOVEI B,%CBNDW	;IF GROWING, ASK FOR WRITE,
	CAML C,D
	 TDZA B,B	;SHRINKING, DELETE.
	EXCH C,D
	SUBM D,C	;D HAS 1ST PG TO MUNG, C -<# PGS TO MUNG>
	HRLI D,(C)	;AOBJN -> PGS TO MUNG.
	JUMPGE D,PDCBJ	;NO PGS TO MUNG => DO NOTHING.
	SYSCLO CORBLK,[B ? %CLIMM,,%JSELF ? D ? %CLIMM,,%JSNEW]
PDCBJ:	REST D
	JRST POPCBJ

;ALLOCATE AN OBJECT AT TOP OF SYMTAB SPACE; #WDS IN D.
;RETURN AOBJN PTR TO OBJECT IN A.
ALLOC:	MOVNI A,(D)
	MOVSI A,(A)
	HRR A,SYMTOP	;CONSTRUCT THE AOBJN
	JRST RELOC	;WHICH IS JUST WHAT RELOC WANTS, TOO.

;DEFINE SYMBOL, SQUOZE IN SYM VALUE IN D.
;SETS GLOBAL BIT IN SYM. CLOBBERS A,C,D,W1.
DEFIN:	LDB A,[4000,,SYM]
	CAMN A,[SQUOZE 0,. ] ;DON'T ALLOW ".:".
	 JRST ERR
	PUSHJ P,DEFUND	;HANDLE UNDEF REFS TO SYM.
	SKIPE SYSSW
	JRST DEFINS
	PUSH P,B
	SAVE SYM
	MOVSI B,%SYFLG
	ANDCAM B,SYM	;CLEAR FLAGS IN SYM.
	PUSH P,D
	SKIPL JOBSYM(U)
	 PUSHJ P,SINIT	;CREATE GLOBAL BLOCK IF NONE.
	SAVE W2
	SAVE C
	MOVE A,PRGM(U)	;TRY TO FIND SYM IN CURRENT OR CONTAINING BLK.
	CALL SLUP
	 0,,SEVLB1
	 SKIPA A,PRGM(U) ;NOT FOUND => DEFINE IN CURRENT BLOCK.
	JRST DEF3
	SKIPE DDTSW
	 JRST DEFIND	;CAN'T CALL HOLE0 ON DDT SYM TAB.
	HLL A,1(A)
	ADD A,[2,,2]	;GET AOBJN -> CURRENT BLOCK.
	SAVE A
	MOVSI A,-2
	MOVEI W1,(P)	;MAKE SPACE AFTER THIS BLOCK'S SYMS.
	ADDM A,JOBSYM(U)	;SYM TAB & BLOCK BOTH LONGER.
	ADDM A,PRGM(U)
	MOVE B,PRGM(U)
	ADDM A,1(B)
	PUSHJ P,HOLE0
	MOVEI A,(C)	;GET ADDR OF SPACE JUST MADE.
DEF2:	POP P,W1
DEF3:	REST C
	REST W2
	POP P,1(A)	;PUT VALUE IN DEF.
	REST D		;ORIGINAL VALUE OF SYM.
	TLO D,%SYLCL
	MOVEM D,(A)	;PUT NAME IN, IN CASE NEW SYMBOL.
DEF4:	SUBI A,2
	MOVE D,(A)
	TLNE D,%SYFLG
	 JRST DEF4	;FIND START OF BLOCK DEFINED IN.
	MOVEI W1,(A)
	SUB W1,JOBSYM(U)
	HRLI W1,(W1)
	ADD W1,JOBSYM(U)	;GET AOBJN -> TAIL AT THAT BLOCK,
	HLL W1,1(W1)
	ADD W1,[2,,2]	;AND AOBJN -> BLOCK.
	PUSHJ P,SBUBL	;DO BUBBLE SORT OF THIS BLOCK.
	JRST POPBJ

DEFIND:	MOVN A,[2,,2]	;DEFINE SYM IN SELF.
	ADDM A,JOBSYM(U)
	ADDM A,STBDDT	;EXTEND DDT SYM TAB DOWNWARD.
	ADDB A,PRGM(U)
	MOVE B,2(A)	;MOVE THE GLOBAL HEADER DOWN 1 STE.
	MOVEM B,(A)
	MOVE B,3(A)
	ADD B,[-2,,]	;1 MORE SYM IN THE GLOBAL BLOCK.
	MOVEM B,1(A)
	MOVEI A,2(A)	;PUT NEW SYM WHERE HEADER WAS.
	JRST DEF3

DEFINS:	SKIPN SYSDPS
	JRST QIJERR
	MOVEM D,SYM1
	MOVSI D,%SYGBL
	IORM D,SYM
	MOVEI D,SYM
	.REDEF D,
	JRST NXERR
	POPJ P,

;DO BUBBLE SORT OF PORTION OF SYMTAB THAT W1 POINTS TO.
;DO ONE PASS UP, ONE DOWN; ASSUME ONLY ONE ENTRY OUT OF ORDER.
;CLOBBER A-D AND W1.
SBUBL:	MOVE B,[2,,2]	;INCREMENT FOR UPWARD PASS.
	MOVE C,[JUMPL A,SBUBL1]
	SUBI W1,2	;(WILL INCREMENT BEFORE ACTING)
	MOVE A,W1
	PUSHJ P,SBUBL2
	MOVNS B	;DECREMENT FOR DOWNWARD PASS.
	MOVE C,[CAMN A,W1]
	JRST SBUBL2

SBUBL1:	MOVE D,1(A)	;CHECK NEXT PAIR OF ENTRIES.
	CAMG D,3(A)
	 JRST SBUBL2	;IN CORRECT ORDER.
	EXCH D,3(A)
	MOVEM D,1(A)	;WRONG ORDER, EXCHANGE.
	MOVE D,(A)
	EXCH D,2(A)
	MOVEM D,(A)
SBUBL2:	ADD A,B		;MOVE TO NEXT ENTRY.
	XCT C		;TEST IF FINISHED.
	 POPJ P,
	JRST SBUBL1	;(NOT FINISHED)

NALTK:	CAME D,[200000,,]	;$K, $$K
	JRST NALTK2
N2ACC1:	MOVEM B,(W4)
	MOVEM C,SYM
	PUSHJ P,SEVL
	7NRTYP [ASCII / U/]
	MOVE B,(W4)	;SEVL CLOBBERED B.
	SKIPE SYSSW
	 JRST NALTK3
	MOVEI D,%SYHKL_-16.
	TLNE B,O.2ALT
	MOVEI D,%SYKIL_-16.
	DPB D,[420200,,(A)]
	JRST LCTGNR

NALTK3:	SKIPN SYSDPS
	 JRST JERR
	MOVE D,1(A)
	MOVE C,(A)
	TLZ C,%SYLCL+%SYKIL
	TLO C,%SYGBL+%SYHKL
	TLNE B,O.2ALT
	 TLO C,%SYFLG
	MOVEI B,C
	.REDEF B,
	 JRST ERR
	JRST LCTGNR

NALTK2:	JUMPN D,NAERR
	TLNN B,O.2ALT
	JRST NXERR
	PUSHJ P,ELECTRON
	JRST NLTL2

N2ACC:	MOVE C,N2ACCS	;$$^C,GET NAME OF LAST SYM TYPED OUT.
	TLZ C,%SYFLG
	TLZ B,O.2ALT	;TELL N2ACC1 SHOULD ONLY SEMI-KILL.
	SKIPE N2ACC1
	 CALL N2ACC1
	MOVE D,LWT
	CALL PVAL
	JRST LCTGNR

;LIST ALL UNDEF REFS IN CURRENT JOB.
KLSTU:	JUMPL U,JERR
	MOVE B,CJTOUT
	MOVEM B,SPTS	;SPT1 WILL CALL TOUT WITH EACH CHAR.
	SKIPGE B,UNDEFL(U) ;DON'T TYPE ANYTHING IF NO UNDEF REFS.
	CALL MORINI	;STOP TYPING AND RETURN IF A **MORE** IS FLUSHED.
	 JRST NLTL2
KLSTU0:	PUSHJ P,CRF	;HANDLE NEXT ONE,
	MOVE D,(B)
	PUSHJ P,SPT1	;PRINT SYMBOL NAME,
	PUSHJ P,LCT
	SKIPGE D,1(B)
	7TYPE [ASCIZ/S /]	;SAY SO IF SWAPPED REF.
	ANDI D,-1
	PUSH P,B
	PUSHJ P,PAD	;TYPE LOCATION REF IS FOR.
	POP P,B
	AOBJN B,.+1
	AOBJN B,KLSTU0
KLSTUX:	CALL MORFL2	;CLEAR MORPRP TO CANCEL THE MORINI.
	JRST NLTL2

;WHEN DEFINING SYMBOL (SQUOZE IN SYM W/ FLAGS CLEAR, VALUE IN D)
;SATISFY ITS UNDEF REFS. CLOBBRS W1.
DEFUND:	PUSH P,B
	SKIPL B,UNDEFL(U)
	JRST POPBJ	;NO UNDEF REFS IN JOB.
	PUSH P,A
	PUSH P,D
DEFU0:	MOVE A,(B)	;IS THIS UNDEF REF
	XOR A,SYM	;A REF FOR THIS SYMBOL?
	TDNE A,[237777,,-1]
	JRST DEFU2	;NO, LOOK AT NEXT.
	HRRZ A,1(B)	;GET ADDR. REF IS FOR.
	PUSHJ P,FETCH
	 JRST DEFU1	;CAN'T READ THAT LOC., FLUSH THE UNDEF REF.
	SKIPGE 1(B)	;IF SWAPPED REF, SWAP THE SYMBOL.
	MOVSS (P)
	ADD D,(P)	;ADD SYM TO LOC'S CONTENTS,
	SKIPGE 1(B)
	MOVSS (P)
	PUSHJ P,DEP	;STORE THE SUM BACK.
DEFU1:	PUSHJ P,REMUN	;FLUSH THE SATISFIED UNDEF REF.
DEFU2:	AOBJN B,.+1
	AOBJN B,DEFU0
	POP P,D
POPABJ:	POP P,A
	JRST POPBJ

;REMOVE THE UNDEFINED-SYMBOL ENTRY THAT B POINTS TO.
;LEAVE B POINTING TO THE ENTRY BEFORE THE ONE DELETED.
REMUN:	PUSH P,B
	HRRZ W1,SYMTOP	;IF IT'S THE LAST THING IN SYMTAB SPACE,
	CAIN W1,2(B)
	JRST REMUN1	;THERE'S NOTHING ABOVE IT TO BLT DOWN.
	HRLI B,2(B)	;ELSE BLT ALL ABOVE IT DOWN BY 2.
	BLT B,-2(W1)
REMUN1:	POP P,B
	SUBI B,2
	PUSH P,A
	MOVE A,UNDEFL(U)
	ADD A,[2,,]	;UNDEFL STARTS IN SAME PLACE BUT 1 LESS ENTRY.
	MOVNI D,2	;CHANGE IN SIZE IS -2.
	PUSHJ P,RELOC	;RELOCATE ALL OBJECTS THAT WERE BLTED.
	SKIPL A		;IF UNDEFL IS NOW EMPTY,
	HRRZ A,SYMTOP	;MAKE IT BE AT TOP OF SPACE.
	MOVEM A,UNDEFL(U)
	JRST POPAJ

;UPDATE UNDEFINED SYMBOL REFS WHEN DEPOSITING IN LOCATION
;WHOSE ADDRESS IS IN A. CLOBBERS C,D,W1.
DEPRMV:	PUSH P,B
	TLNE A,-1	;IF IT'S A FUNNY LOCATION, THERE CAN'T BE ANY UNDEF REFS IN IT
	 JRST DEPRM2	;(AND DON'T LOOK, SINCE THERE MIGHT NOT BE A CURRENT JOB EITHER)
	SKIPL B,UNDEFL(U)
	 JRST DEPRM1	;J IF NO UNDEF SYM REFS.
DEPRM0:	CAIE A,@1(B)	;ELSE REMOVE EACH UNDEF REF
	 JRST DEPRM1	;FOR THE WORD BEING DEPOSITED IN.
	PUSHJ P,REMUN
DEPRM1:	AOBJN B,.+1
	AOBJN B,DEPRM0
DEPRM2:	SKIPN B,UNDFRP	;ANY UNDEFS IN QTY BEING DEPOSITED?
	 JRST POPBJ	;J IF NONE.
	TLNE A,-1
	 JRST NUNDER	;UNDEF REFS NOT ALLOWED WHEN DEPOSITING IN FUNNY LOCATION.
	PUSH P,A
	MOVSI A,-2	;ELSE GET ROOM FOR 1 UNDEF REF.
	MOVEI W1,UNDEFL(U)
	PUSHJ P,HOLE0
	MOVE A,(P)	;GET BACK THE ADDRSS STORING IN.
	MOVE B,UNDFRP
	HLL A,UNDFRL-1(B)
	MOVEM A,1(C)	;STORE TYPE AND ADDRESS OF UNDEF.
	MOVE A,UNDFRL-2(B)
	MOVEM A,(C)	;STORE SYMBOLN NAME.
	POP P,A
	SUBI B,2	;REMOVE THE UNDEF SYM JUST HANDLED.
	MOVEM B,UNDFRP
	JRST DEPRM2	;LOOK FOR ANY MORE UNDEF SYMS.

OPLK2:	MOVE D,OPLK1
	MOVEI W1,SYM
	MOVE A,[(440700)TXT]
	PUSHJ P,.SPT
OPLK1:	IDPB D,A

;OPDECODER

OPEVAL:	MOVEM P,SAVPDL
	TRZA F,R.OUT
OPTYPE:	TRO F,R.OUT
	LSH D,-27.
	MOVEM D,INST
	MOVE D,[(440700)TXT]
	MOVEM D,CHP
	SETZB A,W1
	MOVE W2,BTAB
DC1:	ILDB D,W2
	CAILE D,40
	CAIL D,73
	SOJGE A,DC1
	JUMPG A,DC1
	SUBI D,40
	JUMPE D,DECX
	JUMPG D,DC2
	DPB D,[(340500)PNTR]
	TRZ D,-4
	AOS D
	DPB D,[(300600)PNTR]
	TRNN F,R.OUT
	JRST DC6
	LDB A,PNTR
	JRST DC1
DC2:	HRREI D,-33(D)
	JUMPL D,DECT
	MOVE W1,D
	IDIVI W1,4
	MOVE W2,BTAB(W2)
	ADDI W2,(W1)
	JRST DC1

BTAB:	REPEAT 4,<44-11*.RPCNT>_12.+1100,,TBL

DECT:	TRNE F,R.OUT
	JRST O1CZ
	ILDB W1,CHP
	CAIE W1,133(D)
	JRST LOSE
	JRST DC1

DECX:	TRNE F,R.OUT
	POPJ P,
	ILDB W1,CHP
	JUMPE W1,DC7
LOSE:	POP P,A
	POP P,W2
	POP P,PNTR
	POP P,CHP
LOSE1:	AOS A
	DPB A,PNTR
	LDB A,PNTR
	JUMPN A,DC6AA
	CAME P,SAVPDL
	JRST LOSE
	JUMPL U,CPOPJ
	SKIPE SYSSW
	 POPJ P,
	MOVE A,JOBSYM(U)
	PUSHJ P,SLUP	;SEARCH EVERY BLOCK.
	 2,,SEVLB1
	 POPJ P,	;NOT FOUND.
	MOVE D,1(A)	;GET THE VALUE.
	SETZM FNYLOC
	SKIPE HAKING	;OMIT THE REST IN .BREAK 12, .
	JRST CPOPJ1
	PUSH P,A
	PUSH P,D
	SAVE B		;REMEMBER PTR TO BLOCK FOUND IN.
LOSE6:	EXCH A,B
	PUSHJ P,[PUSH P,[SLUPR] ? JRST SEVLB2]
	 2,,SEVLB1	;KEEP ON SEARCHING.
	 JRST LOSE3	;NO MORE DEFINITIONS => UNIQUE.
	MOVE D,1(A)	;FOUND ANOTHER DEF,
	CAMN D,-1(P)	;DIFFERENT VALUE => VALUE NOT UNIQUE.
	 JRST LOSE6	 ;SAME => KEEP LOOKING.
	CTYPE ""
LOSE2:	REST W1		;MAKE BLOCK FOUND IN BE CURRENT,
	MOVEM W1,PRGM(U)
	PUSHJ P,SPT	;PRINT PRGM OR BLOCK'S NAME.
	7TYPE [ASCIZ/:/]
POPDA1:	POP P,D
POPAJ1:	POP P,A
CPOPJ1: POPJ1: AOS (P)
CPOPJ:	POPJ P,

LOSE3:	CTYPE "'
	JRST LOSE2

DC6:	MOVEI A,0
	DPB A,PNTR
DC6AA:	CAMN P,SAVPDL
	JRST DC6BB
	LDB D,-2(P)
	CAME D,(P)
	JRST LOSE1
DC6BB:	PUSH P,CHP
	PUSH P,PNTR
	PUSH P,W2
	PUSH P,A
	JRST DC1

DC7:	MOVE P,SAVPDL
	MOVE D,INST
	LSH D,27.
POPJ2:
CPOPJ2:	AOS (P)
	JRST CPOPJ1

O1CZ:	MOVEI D,133(D)
	PUSHJ P,TOUT
	JRST DC1

;********************************************************

TBL:
.BYTE 9

DEFINE HACK A
IRPS B,D,[A]
Z=="D
IFE Z-":,B==.BYTC
IFE Z-"/, B+73
IFE Z-"^, <B&70>_-1+B&7-1
IFE <Z-40>*<Z-15>,[
IRPC Q,,B
Z=="Q
IFE Z-".,Z=100
Z-40
TERMIN
]
TERMIN
TERMIN


;INITIAL DISPATCH
	HACK [63^. YFLO/ YHAK/ YACCP/ YBOOLE/ H YHWT/ T YACBM/ . ]

;BYTE AND FLOATING INST
	HACK [YFLO: 33^ YADJS/ YDPR/ YFXFL/ YBYTE/ FAD YA/ FSB YA/ FMP YA/ FDV YA:
	21^ YLMB/ R 02^ YLMB/ YI/ YLMB/ YLMB: 02^ . YL:L. YM:M. YB:B. 
	YADJS: 21^ . 02^ . ADJSP. . .
	YDPR: D 21^ F YDPRFL/ 02^ ADD. SUB. MUL. DIV.
		YDPRFL: 02^ AD. SB. MP. DV.
	YFXFL: 03^ DMOVE. DMOVN. FIX. EXTEND. DMOVEM. DMOVNM. FIXR. FLTR.
	YBYTE: 03^ UF YPA/ DF YN/ FS YC/ IB YP: P. I YLD/ YLD: LD YB/ I YDP/ YDP: DP YB/]

;FWT, FIXED POINT ARITH, MISC.
	HACK [YHAK: 33^ YMV/ YMV: MOV YMO/ YML/ YDV/ YSH/ YH1/ YJP/
	21^ ADD YIMB/ SU YBIMB: B YIMB: 02^ . YI:I. YM/ YB/ YMO: 22^
	YEIMS: E YIMS/ S YIMS/ N YIMS/ M YIMS: 02^ . YI/ YM/ YS: S. 
	YML: 21^ I YML1/ YML1: MUL YIMB/ YDV: 21^ I YDV1/ YDV1:
	DI YDV2: V YIMB/ YH1: 03^ EXC YS3/ BL YT: T. YAO/ YAO: AOBJ
	YAOB/ JRS YT/ JFC YL/ XC YT/ . YAOB: 01^ YP/ YN/
	YJP: 03^ YPU/ YPU: PUSH YPUS/ YPO/ YPO: POP YPOP/ JSR. 
	JS YP/ JS YPA: A. JR YPA/ YPUS: 01^  YJ: J.. YPOP:
	01^ . YJ/  YSH: 02^ A YS2/ ROT YS1/ L YS2: S YS3: H YS1/ 21^ JFFO. CIR YC/ 
	YS1: 21^ . YC: C. ]

;ARITH COMP, SKIP, JUMP
	HACK [YACCP: 42^ CA YCA1/ YSJ/ A YJS/ S YJS: O 31^
	J YCOMP/ S YCOMP/ YCA1: 31^ I YCOMP/ M YCOMP/
	 YSJ: 31^ JUM YPSJ/ SKI YPSJ: P YCOMP:
	03^ . YL/ YE: E. L YE/ YPA/ G YE/ YN: N. G. ]

;BOOLEAN
	HACK [YBOOLE: 24^ YST/ YAN: AND YB2/ YAN/ YST/ YAN/ YST/
	X YOR: OR YB2/ I YOR/ YAN/ EQ YDV2/ YST/ YOR/ YST/ YOR/ YOR/
	YST: SET YB2: 24^ Z YIMB/ YIMB/ YCA: C YTA/ YTM: M YIMB/
	YCM: C YTM/ YTA: A YIMB/ YIMB/ YIMB/ YCB: C YBIMB/ YIMB/ YCA/
	YCA/ YCM/ YCM/ YCB/ O YIMB/ ]

;HALF WORDS
	HACK [YHWT: 51^ YHW1/ 21^ R YHW2/ L YHW2: R YHW3/ YHW1:
	21^ L YHW4/ R YHW4: L YHW3: 32^ YIMS/ Z YIMS/ O YIMS/
	YEIMS/ ]

;TEST INST
	HACK [YACBM: 31^ YAC1/ 01^ D YAC2/ S YAC2/ YAC1: 01^ R YAC2/ L 
	YAC2: 42^ N YEAN/ Z YEAN/ C YEAN/ O YEAN: 12^ . YE/ YPA/ YN/ ]

.BYTE


;EVAL SYM WITH NAME IN D.
;IF FOUND, SKIP, WITH ADDR OF STE IN A, VALUE IN D, FUNNINESS IN FNYLOC
;CLOBBERS LOTS OF ACS.
SEVLD:	MOVEM D,SYM
SEVL:	JUMPL U,SEVL1	;NO JOB => JUST INITIAL SYM TABS.
	SKIPE SYSSW
	 JRST SEVLS	;SYS JOB SPECIAL.
	MOVE A,PRGM(U)
	PUSHJ P,SLUP	;SEARCH CURRENT BLOCK AND CONTAINING.
	 0,,SEVLB1
SEVL1:	SKIPA B,[-STBIOL,,STBIO]	;NOT FOUND, TRY ORDINARY INITIAL SYMS.
	 JRST SEVLW	;FOUND, SLUP SKIPPED 2.
	PUSHJ P,SEVLB1
	 SKIPA B,STBSO	;TRY SYSTEM DEFAULT ORDINARY SYMS.
	JRST SEVLW	;FOUND IN ORDINARY INITAIL SYMS.
	PUSHJ P,SEVLB1
	 SKIPA B,[-STBESA,,STBES]
	JRST SEVLW
	SKIPE ESSYM	;TRY E&S SYMS IF ..ESSYM SET, EG DYNAMOD
	CALL SEVLB1
	 SKIPA B,[-STBIFL,,STBIF] ;TRY INITIAL FUNNY SYMS.
	JRST SEVLW
	PUSHJ P,SEVLB1
	 SKIPA B,STBSF	;TRY SYSTEM DEFAULT FUNNY SYMS.
	JRST SEVLF
	PUSHJ P,SEVLB1
	 POPJ P,	;FOUND NOWHERE.
SEVLF:	MOVE D,1(A)	;GET VALUE (FUNNINESS IN LH)
	TLNN D,7^5	;ALL BITS OFF => 4.8 IS DEFAULT.
	 TLO D,2^5
	TLNE D,1^5	;4.7 => REL. TO U.
	 JUMPL U,CPOPJ
	TLZE D,1^5
	 ADDI D,(U)
	MOVEM D,FNYLOC	;REMEMBER FUNNYNESS,
	ANDI D,-1	;BUT REMOVE FROM VALUE.
	JRST POPJ1

SEVLS:	MOVE B,SYSAOB	;GET AOBJN -> SYS SYMA.
	SUBI B,772000-SYSSYM
	PUSHJ P,SEVLB1	;SYS SYM TAB JUST SYMS, NO BLOCKS.
	 JRST SEVL1
SEVLW:	MOVE D,1(A)	;FOUND ORDINARY SYMBOL.
	SETZM FNYLOC
	JRST POPJ1

;CALL SEVLB1 TO SEARCH AREA <- AOBJN IN B.
SEVLB2:	ADD B,[2,,2]
SEVLB1:	JUMPGE B,CPOPJ
	MOVE D,(B)
	TLZ D,%SYFLG
	CAME D,SYM
	 JRST SEVLB2
	MOVE D,(B)
	TLNE D,%SYKIL	;IGNORE IF DELETED.
	 JRST SEVLB2
	EXCH A,B
	JRST POPJ1

;PUSHJ P,SLUP ? FLAG,,RTN     WITH SYMTAB TAIL -> BLOCK HEADER IN A.
;ALSO PUTS IN B AOBJN -> SYMS IN THAT BLOCK.
;FLAG=0 => CALL FOR EACH GOOD BLOCK, =1 => FOR EACH BAD BLOCK,
;=2 => FOR EACH BLOCK.
;THE GOOD BLOCKS ARE THE CURRENT BLOCK AND ALL CONTAINING BLOCKS.
;AN AOBJN -> TAIL OF SYMTAB STARTING AT BLOCK HEADER WILL BE
;IN B WHEN RTN IS CALLED (WITH A PUSHJ).
;IF RTN SKIPS, SLUP WILL GIVE UP AND SKIP 2.
;OTHERWISE, SLUP WILL RETURN SKIPPING 1 AT END OF SYMTAB.

SLUP0:	MOVEI B,(A)	;B _ AOBJN -> SYMS IN BLOCK.
	HLL B,1(A)
	ADD B,[2,,2]
	HRRZ C,@(P)	;GET ADR OF RTN, CALL IT.
	PUSHJ P,(C)
SLUPR:	CAIA
	JRST POPJ2	;IF RTN SKIPPED, SO DO WE.
SLUP1:	HLRE B,1(A)
	MOVNI B,(B)
	HRLI B,(B)	;THIS PUTS IN A AN AOBJN ->
	ADD A,B		;SYMTAB TAIL -> NEXT BLOCK.
SLUP3:	JUMPGE A,POPJ1	;NO MORE BLOCKS.
	JUMPE W2,POPJ1	;QUIT AFTER DOING GLOBAL BLOCK.
	LDB B,[400400,,(A)]
	JUMPN B,POPJ1	;NOT BLOCK HEADER => IGNORE NTS DDT'S INITIAL SYMS.
	HLRZ C,@(P)	;GET FLAG (0, 1, OR 2)
	HRRZ B,1(A)	;NEXT BLOCK'S LEVEL.
	CAMN A,PRGM(U)
	 JRST SLUP2	;CURRENT BLOCK ALWAYS GOOD.
	CAIN B,1	;OTHER PROGRAMS & INNER BLOCKS NEVER GOOD.
	 JRST [MOVEI W2,1 ? JRST @SLUPF(C)]
	CAIN B,2	;OUTERMOST BLOCK OF GOOD PROGRAM IS GOOD.
	 JUMPL W2,SLUP2
	CAIL B,(W2)	;SOMETHING AT LOWER LEVEL IS GOOD.
	 JRST @SLUPF(C)
SLUP2:	MOVEI W2,(B)	;W2 HAS LEVEL OF LAST GOOD BLOCK.
	CAIN W2,1	;IF THIS IS PROGRAM NAME,
	JRST [HLRZ B,1(A)	;IF NO SYMBOLS IN IT,
		CAIE B,-2
		 JRST .+1
		HRRZ B,3(A)	;IF THAT'S DUE TO BLOCK STRUCTURE,
		CAIL B,2
		SETO W2,	;NEXT GOOD BLOCK IS OUTERMOST IN PROGRAM.
		JRST .+1]
	JRST @SLUPT(C)	;THIS IS A GOOD BLOCK.

SLUPT:	SLUP0
SLUPF:	SLUP1
	SLUP0
	SLUP0

SLUP:	MOVEI W2,1
	JRST SLUP3

;LOOK FOR VALUE IN D. LEAVES D UNCHANGED.
;IF FIND SYMBOL WITH THAT VALUE, TYPE NAME & DON'T SKIP, W1 -> STE.
;ELSE SKIP, WITH STE ADDR OF BEST FOUND IN W1. (OR 0 IN W1 IF NONE FOUND)
;CLOBBERS A,B,C,I1
SLUK:	SAVE [[JRST SPT ? JRST POPJ1]]
SLUK1:	SETZM PBMASK
SLUK2:	SETZ W1,	;NO BEST SO FAR YET.
	JUMPL U,POPJ1	;NO JOB => FAIL TO FIND IT.
	SKIPE SYSSW
	 SKIPA A,SYSAOB	;SYS JOB=> COMPUTE "JOBSYM", ELSE
	SKIPA A,PRGM(U)	;START LOOKING AT 1ST GOOD BLOCK.
	 SUBI A,772000-SYSSYM
	PUSHJ P,SLUP
	 0,,SLUKBB	;BINARY-SEARCH EACH BLOCK.
	 SKIPA A,JOBSYM(U)
	RET		;EXACT MATCH,RETURN NOT SKIPPING.
	PUSHJ P,SLUP	;LOOK THRU BAD BLOCKS.
	 1,,SLUKBB
	  SKIPA B,STBSO
	   RET
	SKIPE PBMASK	;CONSIDER SYSTEM ORDINARY SYMS ONLY IN BIT MODE,
	 CALL SLUKBB	;SINCE THEY'RE HALF-KILLED.
	  SKIPA B,[-STBIOL,,STBIO]
	   RET
	SKIPE PBMASK	;CONSIDER INITIAL ORDINARY SYMS FOR SAKE OF .BREAK 12 CODES.
	 CALL SLUKBB	;AGAIN, THEY'RE NEEDED ONLY IN BIT TYPEOUT MODE
	  JRST POPJ1	;NO EXACT MATCH, SKIP RETURN.
	RET		;EXACT, DON'T SKIP.

;BINARY SEARCH IN VECTOR OF STE'S <- AOBJN IN B
;FOR VALUE IN D.  CLOBBERS B,C,I1.
SLUKB:	SETZM PBMASK
SLUKBB:	AOJGE B,CPOPJ	;QUIT IF EMPTY; B -> 2ND WD OF STE.
	HLRE C,B
	HRLI B,C	;B IS INDEX OF C.
	MOVNS I1,C
;B -> INSIDE AREA, IDX OF C.
;C = SIZE OF LAST STEP.
;I1 = # WDS LEFT IN PART OF AREA AFTER B.
;LEAVES B POINTING TO LAST (IN CORE) SYMBOL WHOSE VALUE IS .LE. DESIRED VALUE.
;THEN GOES TO SLUKB1.
SLUKB0:	CAILE C,(I1)	;C_MAX(LAST STEP,SPACE LEFT)
	 MOVEI C,(I1)
	CAIN C,2	;ONLY 1 ENTRY TO SEARCH THRU => DONE.
	 SOJA B,SLUKB1	 ;(UNDO EFFECT OF AOJGE AT SLUKB)
	LSH C,-1	;STEP = .5* SIZE OF STUFF TO SEARCH.
	TRZE C,1	;ROUND UP TO EVEN NUMBER.
	 ADDI C,2
	CAMGE D,@B	;E.A. IS RH(B)+STEP.
	 JRST SLUKB0	 ;THAT'S TOO FAR, DON'T MOVE B.
	HRRI B,@B	;NOT TOO FAR, SET PTR THERE.
	SUBI I1,(C)	;WE'RE CLOSER TO END NOW.
	JRST SLUKB0

SLUKB3:	REST D
SLUKB2:	SUBI B,2
SLUKB1:	MOVE C,(B)	;FOUND THAT VALUE,
	SKIPN PBMASK	;IF BIT TYPEOUT MODE, HALFKILLED SYMBOLS ARE OK.
	 TLNN C,%SYHKL
	  TLNE C,%SYKIL
	   JRST SLUKB2	;MOVE BACK TILL SYM THAT'S OK TO USE.
	CAML D,1(B)	;(MAYBE ALL SYMS IN BLOCK ARE TOO LARGE)
	TLNN C,%SYFLG
	 POPJ P,	;REACHED HEADER => NO SYM THIS BLOCK.
SLUKS3:	MOVE C,1(B)	;GET THAT SYM'S VALUE.
	CAIE W1,	;NO PREVIOUS BEST OR
	 CAMLE C,1(W1)	;BETTER THAN PREVIOUS BEST =>
	  MOVEI W1,(B)	 ;IT IS BEST.
	CAME C,D	;EXACT MATCH?
	 RET
	SKIPN PBMASK	;YES: IF NOT BIT TYPEOUT MODE, END SEARCH RIGHT HERE.
	 JRST POPJ1
	HRRZ W1,B
	MOVE C,(W1)	;BIT TYPEOUT MODE: DOES SYMBOL BEGIN WITH DESIRED PREFIX?
	SUB C,PBSYM
	TLZ C,%SYFLG
	SAVE D
	IDIV C,PBMASK
	JUMPN C,SLUKB3	;NO, KEEP LOOKING THRU SYMTAB.
	JRST POPDJ1	;YES, STOP SEARCH.

;TYPE ARG IN D SYMBOLICALLY. ($$S MODE)
;CLOBBERS JUST ABOUT ALL ACS.
TMS:
PIN:	TLNN D,-1	;JUST AN ADDRESS =>
	 JRST PAD	 ;PRINT AS SUCH.
	PUSH P,D
	MOVE I2,D
	TLC I2,700000
	SKIPN KS10IO
	 TLZ I2,77000	;ON KS, ONLY APR, PI DEVICES USE I/O INSN FORMAT
	TLNN I2,777000
	 JRST PINIO	;I-O INSN (MAYBE)
	PUSHJ P,SLUK
	 JRST POPDJ	;FOUND SYMBOL WITH EXACTLY RIGHT VALUE.
	TLNN D,777^3
	 JRST HLFWPD	;(OP CODE IS 0)
	MOVSI I2,-3	;TRY LOOKING FOR USER-DEF OP CODES.
	LDB A,[331100,,D]
	CAIN A,.CALL_-33	;IF INSN IS A .CALL OR .OPER, DON'T USE A USER-DEFINED SYMBOL
	 MOVSI I2,-1		;THAT ISN'T AS GOOD AS THE SYSTEM SYMBOL FOR IT.
	CAIN A,.OPER_-33
	 MOVE I2,[-1,,1]
PIN0:	JUMPE W1,PININI	;(CAN GIVE UP FAST)
	MOVE D,(P)
	AND D,PINTB0(I2) ;LOOK FOR SOME PART OF VALUE.
	CAMLE D,1(W1)	;IF LARGEST < PREV. SEARCHED (WHICH WAS
	 JRST PIN1	 ;LARGER) IS TOO SMALL, WON'T FIND THIS.
	CAMN D,1(W1)	;MAYBE LAST TIME'S BEST IS WHAT WE WANT.
	 JRST PINUUO
	PUSHJ P,SLUK
	 JRST PINUU1	;FOUND USER INSN NAME.
PIN1:	AOBJN I2,PIN0
PININI:	MOVSI D,777000
	AND D,(P)	;GET OP-CODE FIELD ONLY.
	HLRZ A,D
	CAIL A,4^4
	 CAIL A,5^4
	  CAIA
	   JRST PINMON	;THIS IS A SYSTEM CALL.
	CAIN A,(ADJSP)
	 JRST PIN4
	CAIE A,257000
	CAIGE A,(DFAD)
	 JRST HLFWPD	;NOT AN INSTRUCTION.
	CAIL A,7^5	;I/O INSTRUCTIONS AREN'T KNOWN TO OPTYPE
	 JRST PINNEG
PIN4:	CALL OPTYPE	;PRINT THE INSN NAME.
	JRST PININS	;GO PRINT THE REST.

IFNDEF ADJSP,ADJSP==105000,,
IFNDEF DFAD,DFAD==110000,,

PINTB0:	777740,,	;FIRST TRY OPCODE & AC FIELD.
	777037,,-1	;THEN OPCODE & ADDRESS STUFF.
	777000,,	;THEN JUST OPCODE.

;VALUE IS A SYSTEM CALL.
PINMON:	CAIN A,(.CALL)	;IF A .CALL, INCLUDE AC FIELD.
	 JRST PINCAL
	CAIE A,(.OPER)	;IF .OPER, INCLUDE ADDRESSING STUFF.
	 JRST PINMO1	 ;OTHER SYSTEM CALLS, D HAS JUST OPCODE
	HRLOI D,777037
PINMO2:	AND D,(P)
PINMO1:	SETZ W1,
	MOVE B,STBSO	;SEARCH SYSTEM ORDINARY SYMS
	PUSHJ P,SLUKB	;FOR NAME OF SYSTEM CALL.
	 CAIA
	JRST PINUUO	 ;FOUND, TYPE IT AND THE REST.
	MOVSI D,777000	;.CALL OR .OPER WITH NO SPECIAL NAME,
	JRST PINMO2	;PRINT AS ".OPER ETC" OR ".CALL ETC".

PINCAL:	MOVSI D,777740	;HERE FOR .CALL N, - LOOK FOR SYSTEM SYMBOL CONTAINING
	AND D,(P)	;BOTH THE .CALL AND THE N,.
	SKIPE UCHNLO	;BUT IF .CALL 0, IF WE HAVE A JOB,
	 CAME D,[.CALL]
	  JRST PINMO2
	7TYPE [ASCIZ /.CALL/]	;PARSE THE ARGUMENT BLOCK THE .CALL POINTS TO.
	CALL [	SAVE -1(P)
		JRST PININS]	;AFTER PRINTING THE INSN ITSELF AS ".CALL " PLUS ADDRESS FIELD.
	CALL EASETU
	MOVE D,(P)
	CALL NEFECC	;GET E.A. OF THE .CALL INSN.
	HRRZ A,I1
	CALL RFETCH	;IS 1ST WORD OF ARG BLOCK A SETZ?
	 JRST POPDJ
	CAME D,[SETZ]
	 JRST POPDJ	;JUST GIVE UP IF ARG BLOCK MALFORMED.
	AOS A
	CALL RFETCH
	 JRST POPDJ
	7TYPE [ASCIZ / (/]
	CALL SIXTYP	;TYPE THE NAME OF THE CALL, IN PARENS.
	CTYPE ")
	JRST POPDJ

PININ1:	TLNE D,777000	;CALL HERE TO PRINT SOMETHING AS AN INSN EVEN IF OP-CODE
	 JRST PIN
	SAVE D		;IS MISSING (1,, PRINTS AS "(1)").  IF HANDED 0, WILL
	SAVE D		;PRINT NOTHING, SO WATCH OUT.
	JRST PININ2

PINUUO:	PUSHJ P,SPT	;PRINT INSN'S NAME.
PINUU1:	SKIPA A,1(W1)	;A_ THOSE BITS THAT INSN TOOK CARE OF.
PININS:	MOVSI A,777000	;(ASSUME THEY WERE OPCODE FIELD)
	ANDCA A,(P)	;GET WHAT'S LEFT TO HANDLE.
	JUMPE A,POPDJ
	PUSH P,A
	PUSHJ P,TSPC	;SPACE AFTER INSN NAME.
PININ2:	LDB D,[270400,,A]
	JUMPE D,PIN2
	CALL PAD
;SIGN OF (P) WILL BE SET IFF GOT HERE FROM PES.
PINIO1:	CTYPE ",
PIN2:	MOVE D,(P)
	TLZ D,777757	;HAVE IND. BIT AND ADDR FIELD.
	TLZE D,(@)
	 CTYPE "@	;TYPE @ IF INDIRECT.
	JUMPE D,PIN3	;PRINT ADDR IF NOT 0.
	TRO F,NAF	;ADDR FIELD MAY BE NEGATIVE.
	HLRZ A,-1(P)
	TRZ A,(0 17,(17))
	PUSHJ P,[
		ROT A,-11
		TLZN A,<(@)>_11
		 CAIN A,JFFO_-33
		  JRST PINAD	;PRINT ADDR IN CURRENT MODE
		CAIL A,240
		 CAILE A,247	;BUT IF NON-INDIRECT SHIFT INSN,
		  JRST PINAD
		   JRST PADA0]	;PRINT NUMERICALLY.
	TRZ F,NAF
PIN3:	LDB D,[220400,,(P)]
	SETO I1,
	MOVE A,-1(P)
	SKIPGE (P)
	LDB I1,[410300,,A] ;E&S INSN => GET CLASS OF INSN,
	CAIN I1,2	;FOR CLASS 2 INSN,
	TLNE A,17	;TYPE IDX FIELD EVEN IF 0 UNLESS INCLUDED IN INSN.
	JUMPE D,POPADJ	;PRINT INDEX FIELD IF NOT 0.
	CTYPE "(
	SAVE N2ACCS	;$$^C SHOULDN'T SEE SYMS IN INDEX FIELD.
	CALL [	JUMPL I1,PAD	;PDP10 INSN => TYPE AS ADDRESS.
		JRST PESIDX]	;E&S INSN => PRINT IDX SPECIALLY.
	REST N2ACCS
	CTYPE ")
POPADJ:	POP P,A		;(NOTE THIS ISN'T WHAT A HAD AT CALL)
	JRST POPDJ

;PRINT WHAT MIGHT BE AN IO INSTRUCTION.
PINIO:	JUMPL U,PINIO4	;NO JOB => SIMPLE TEST.
	SKIPGE JOBSYM(U) ;SAME IF NO SYMS OR SYS JOB.
	SKIPE SYSSW
	 JRST PINIO4
	MOVE A,UJNAME(U)
	CAME A,[SIXBIT/PDP10/]
	CAMN A,[SIXBIT/PDP6/]
	 JRST PINIO4	;PDP6 => IO INSNS OK.
	LDB D,[320700,,(P)]
	CAIE D,TTY/4	;DEVICES TTY, DIS, PI, APR ALWAYS AS IO INSN.
	CAIN D,DIS/4
	 JRST PINIO3
	SOJLE D,PINIO3	;(CHECK FOR 0,1 = APR,PI)
	LDB A,[320700,,(P)]
	LSH A,2		;GET DEVICE CODE AND MULTIPLY BY 4
	CALL SQZ3D	;CONVERT 3 DIGITS TO SQUOZE.
	ADD D,[SQUOZE 0,..D] ;HAVE SQUOZE 0,..D!DEV
	PUSHJ P,SEVLD
	 JRST PINNEG	;NOT DEF, DON'T PRINT AS IO INSN.
PINIO3:	LDB D,[270300,,(P)]
	LSH D,1		;WHICH IO INSN IS IT?
	MOVEI W1,PINIO9(D)
	PUSHJ P,SPT	;PRINT INSN NAME.
	PUSHJ P,TSPC
	MOVSI D,77400
	AND D,(P)	;GET DEVICE CODE.
	JUMPE D,PINIO5	;DEVICE 0, DON'T PRINT SYMBOLICALLY.
	PUSHJ P,SLUK
	 JRST PINIO2	;HAVE SYMBOL FOR IT.
PINIO5:	MOVE B,[-STBIOL,,STBIO]
	PUSHJ P,SLUKB	;LOOK FOR TTY,PTR,PI,DIS ETC.
	 JRST PINIO8
	CALL SPT
	JRST PINIO2	;FOUND ONE OF THEM.
PINIO8:	LSH D,-30
	PUSHJ P,TOC	;ELSE TYPE IN OCTAL.
PINIO2:	PUSH P,(P)
	MOVSI D,4^5	;SIGN OF (P) SHOULD BE CLEAR,
	ANDCAM D,(P)	;ELSE PIN WILL PRINT IDX AS E&S CRAP.
	JRST PINIO1

PINIO4:	CAMGE D,[BLKI 740,] ;OLD SIMPLE TEST, PRINT AS IO INSN
	 JRST PINIO3	 ;UNLESS LH IS SMALL NEGATIVE NUMBER.
PINNEG:	MOVN D,(P)	;NOT TO PRINT AS IO INSN; HALFWORD OR NEG. NUMBER.
	CAIL D,200000
	 JRST HLFWPD	;TOO LARGE FOR SMALL NEG NUM.
	POP P,D
	ANDI D,-1
	JRST PADA1	;GO TYPE "-", NEGATE AND PRINT RH.

;CONVERT 3 DIGITS IN A TO RIGHT-JUSTIFIED SQUOZE IN D.  NO ZERO SUPPRESSION.
SQZ3D:	PUSH P,C
	LDB D,[.BP 700,A]
	LDB C,[.BP 70,A]
	IMULI D,50
	ADDI D,51(C)
	IMULI D,50
	LDB C,[.BP 7,A]
	ADDI D,1(C)
	JRST POPCJ

;PRINT VALUE IN D IN CURRENT MODE.
;CLOBBERS ALL ACS.
PVAL:	MOVE C,SCH	;GET CURRENT MODE.
PVAL2:	HLRE A,C
	AOJE A,(C)	;LH IS -1 => RH IS ADDR OF RTN IN DDT.
	AOJN A,PVAL3
	ADDI C,(U)	;LH -2 => RH SPECS USER VAR TO GO THRU.
	SKIPGE U	;BUT IF NO JOB, USE CORRESP. MASTER VAR.
	 ADDI C,MAMPER-TAMPER+1
	MOVE C,(C)
	JRST PVAL2	;USE THE MODE HELD THERE.

PVAL3:	MOVEM C,34SAV	;ELSE IT'S INSN TO $X.
	SAVE D
	CALL GXBLKD
	MOVEI A,XBLK$Q(D)
	REST D
	CALL RDEP	;SAVE VALUE TO TYPE OUT  IN USER'S 37 (OR WHEREVER)
	 JRST PIN
	SUBI A,XBLK$Q-XBLK.
	MOVE D,LLOCO
	CALL RDEP	;STORE VALUE OF . IN WORD 25 OR WHEREVER.
	 JRST PIN
	SETOM PVALFL
	SETOM XCRFSW
	SAVE PPC(U)
	SAVE UINTWD(U)
	SAVE XECPC(U)
	SAVE XINTWD(U)
	SAVE UPI0(U)
	MOVEI A,1	;ARRANGE NOT TO CLOSE LOCATION WHEN
	CALL HGO1	;RETURN VIA .BREAK 16,  IN 35 .
	REST UPI0(U)
	REST XINTWD(U)
	REST XECPC(U)
	REST UINTWD(U)
	REST PPC(U)
	RET

;PRINT ARG (IN D) IN HALFWORD MODE.
TMH:
HLFW:	PUSH P,D
HLFWPD:	HLRZ D,(P)
	SETZM PBANGL
	AOS PBANGL	;WE NEED <->'S AROUND (-)'S IN THE LEFT HALF.
	CALL PADBL0	;PRINT L.H., USING BIT MODE IF ENABLED.
HLFW1:	7TYPE [ASCIZ /,,/]
	REST D
	ANDI D,-1	;NOW PRINT THE RH.
	JRST PADBR

;PRINT THE R.H. OF AN INSTRUCTION. THE VALUE SHOULD BE IN D.
;THE OPCODE OF THE INSTRUCTION SHOULD BE IN A.
;USES BIT TYPEOUT MODE IF IT IS SELECTED AND THE OPCODE SPECIFIES IT;
;OTHERWISE, USES PAD. CLOBBERS ALL ACS (EXCEPT P, W4).
PINAD:	IDIVI A,PCPNTP
	MOVE A,PCPNTB(A)
	IMULI B,PCPNTS
	LSH A,(B)
	LSH A,PCPNTS-36.
	TRNE A,20	;IF OPCODE SAYS ADDRESS FIELD IS L.H. BITS,
	 JRST PADBL	;TRY TO USE BIT MODE.
	TRNE A,10	;ALSO HACK R.H. BITS IF APPROPRIATE.
	 JRST PADBR

;PRINT AN ADDRESS (IN D) IN CURRENT MODE. CLOBBERS ALL ACS.
;NAF ON => IF NUMERIC, OK TO PRINT WITH MINUS SIGN.  ALWAYS TURNS NAF OFF.
PAD:	MOVE I2,F	;SAVE NAF AND TURN IT OFF.
	TRZ F,NAF
	TLNE D,-1
	 JRST PADF	;ADDR. IS FUNNY.
PAD1:	MOVE A,AR
	CAIE A,PADR	;CHECK FOR CLOBBERAGE OF AR.
	CAIN A,TOC
	 JRST (A)
	MOVEI A,PADR
	MOVEM A,AR
	ERLOSS

;PRINT THE VALUE IN D AS R.H. BITS IF POSSIBLE; OTHERWISE, AS AN ADDRESS.
PADBR:	TRZ F,NAF
	MOVEI I2,NAF
	SKIPN BITF	;CAN'T USE BIT MODE IF USER HASN'T TURNED IT ON.
	 JRST PAD1
	SETZM PBPARN	;BIT NAMES SHOULDN'T BE IN PARENS OR ANGLE BRACKETS.
	MOVE A,BITSYM
	SKIPL B,BITPAT	;DOES MAIN BIT MODE HAVE R.H. BITS?
	 TLNN B,1
	  JRST PADBR1	;YES, USE IT.
	MOVE A,BITSY1	;NO, TRY THE ALTERNATE BIT MODE.
	SKIPL B,BITPA1
	 TLNN B,1
	  JRST PADBR1
	JRST PAD1

PADBR1:	JUMPE B,PAD1	;DON'T TRY TO USE BIT MODE IF NONE EXISTS.
	MOVEM B,PBPAT
	MOVEM A,PBSYM
	JRST PBHWD

;PRINT THE VALUE IN D AS L.H. BITS, ASSUMING IT WILL APPEAR IN THE
;ADDRESS FIELD OF AN INSTRUCTION (IE WILL APPEAR IN A UNSWAPPED PLACE).
PADBL:	SETZM PBANGL	;WE DON'T NEED TO USE ANGLE BRACKETS AROUND PARENS, IF WE USE PARENS.
PADBL0:	TRZ F,NAF
	MOVEI I2,NAF	;(IN CASE WE GIVE UP AND GO TO PAD1)
	SKIPN BITF
	 JRST PAD1
	SETZM PBPARN
	MOVEI W1,BITSYM
	CALL PADBL1	;FIRST, CONSIDER MAIN BIT MODE.
	 JRST PADBR1	;IT WON.
	MOVEI W1,BITSY1
	CALL PADBL1	;ELSE, CONSIDER ALTERNATE BIT MODE.
	 JRST PADBR1	;IT WON.
	JRST PAD1

PADBL1:	MOVE A,(W1)
	SKIPGE B,BITPAT-BITSYM(W1)
	 JRST [	HLROS B
		AOS PBPARN
		RET]
	TLNN B,1
	 AOS (P)
	RET

PADR:	JUMPE D,TOC2FK	;$R ADDRESS TYPEOUT RTN.
	PUSHJ P,SLUK
	 POPJ P,	;EXACT MATCH FOUND.
	JUMPE W1,PADA	;NOTHING FOUND => NUMERICALLY.
	MOVE B,1(W1)	;VALUE OF BEST.
	CAIGE B,60	;SYM'S VALUE SMALL => DON'T USE.
	 JRST PADA
	ADD B,SYMOFS
	CAML D,B	;SYM'S VALUE TOO FAR BELOW => DON'T USE.
	 JRST PADA
PADR1:	SUB D,1(W1)	;ADDR-<BEST FOUND>
	PUSH P,D
	PUSHJ P,SPT	;PRINT BEST SYM FOUND.
	POP P,D
	CTYPE "+
	JRST TOC

PADA:	TRNE I2,NAF	;USUALLY TYPE IN OCTAL,
PADA0:	CAIGE D,-4000	;UNLESS NAF WAS SET AND VALUE IS SMALL NEGATIVE NUM.
	 JRST TOC
PADA1:	CTYPE "-	;IN THAT CASE, PRINT A NEGATIVE NUMBER.
	XORI D,-1	;NEGATE D'S RH.
	AOJA D,TOC

PADF:	TLNE D,177777	;ADDR. IS FUNNY, ONLY TOP 2 FUNNYNESS BITS OK.
	 ERLOSS D	;(WILL PUSH A, THEN D)
	TLNN D,200000	;IF .USET NUMBER,
	 JRST PADF1
PADF0:	TLZE D,400000	;IF DDT-REF, HANDLE THAT SIMPLY.
	 7TYPE [ASCIZ/..DDT+/]
	TLNN D,-1
	 JRST PADA	;IF THAT WAS ONLY FUNNYNESS, THE REST IS NORMAL ADDR.
PADF1:	SETZ W1,	;SLUKB WILL NEED THIS.
	TLZE D,200000
	 JRST PADU	;.USET REF => SEARCH SYSTEM FUNNY SYMS.
	MOVE B,[-STBIFL,,STBIF] ;ELSE INITIAL FUNNY SYMSFOR DDT REF.
	MOVEI A,(D)
	JUMPL U,PADD1	;NO JOB => CAN'T PRINT AS U-REL SYM.
	CAIG A,JOBSYM(U)	;ELSE SEE IF IN RANGE FOR U-REL SYM.
	CAIGE A,USRS(U)
	 JRST PADD1
	SUBI D,(U)	;YES, GET OFFSET.
	TLOA D,100000	;LOOK FOR A SYM WITH U-REL SET.
PADU:	MOVE B,STBSF
	PUSHJ P,SLUKB
	 JRST PADR1	;NOT EXACT => PRINT AS SYM+OFFSET.
	JRST SPT

PADD1:	PUSHJ P,SLUKB	;LOOK FOR NON-U-REL DDT REF.
	 JRST PADF0	;NOT EXACT => PRINT AS ..DDT+ADDR.
	JRST SPT

;THIS IS THE HEART OF BIT TYPEOUT MODE.
;EXPECTS VALUE TO PRINT IN RH(D), PATTERN IN PBPAT, PREFIX IN PBSYM.
PBHWD:	SETZM PBFND
	HRRZM D,PBVAL
	MOVEI C,18.
	MOVEM C,PBLMAR
	MOVE A,PBSYM	;COMPUTE THE SQUOZE FOR THE TRAILING BLANKS IN PBSYM.
	MOVEI C,1
PBSMSK:	IDIVI A,50
	JUMPN B,PBSMS1
	IMULI C,50
	JRST PBSMSK

PBSMS1:	MOVEM C,PBMASK

;NOW, TRY THE NEXT SUBFIELD.
PBLOOP:	MOVE A,PBPAT
	LSH A,@PBLMAR	;MOVE DOWN TO START OF SUBFIELD.
	MOVN C,PBLMAR
	ASH A,(C)	;BY EXTENDING SIGN FROM THERE TO TOP OF WORD.
	SKIPGE A
	 SETCA A,	;NORMALIZE TO POSITIVE, SINCE ONLY ALTERNATIONS MATTER.
	JFFO A,PBLOO1	;HOW MANY LEADING ZEROS?
	 MOVEI B,36.	;<=> HOW FAR DOWN IS END OF SUBFIELD?
PBLOO1:	MOVSI D,400000
	MOVNI W1,-1(B)
	ASH D,(W1)	;MASK TO THIS SUBFIELD AND STUFF ABOVE IT.
	LSH D,@PBLMAR
	LSH D,(C)
	MOVEM D,PBFELD
	MOVEM B,PBLMAR	;REMEMBER HOW FAR TO START OF NEXT SUBFIELD AT END OF THIS ONE.
	AND D,PBVAL
	JUMPE D,PBLOST
	CALL PBSLUK	;TRY LOOKING UP THE VALUE IN THIS SUBFIELD.
	 JRST PBLOO3
	MOVN D,PBFELD
	AND D,PBFELD	;GET LSB OF THIS FIELD
	CAMN D,PBFELD	;IS THIS FIELD JUST 1 BIT? IF SO, GIVE UP ON IT NOW.
	 JRST PBLOST
	CALL PBSLUK
	 JRST PBLOO2	;THAT WINS - PRINT AS <N>*LOWBIT
	MOVE D,PBFELD	;IF THERE'S A SYMBOL FOR THE WHOLE FIELD,
	CALL PBSLUK
	 JRST PBLOO5	;PRINT AS <QTY>&<FIELD-SYMBOL>
	JRST PBLOST	;IT LOST - DON'T HACK THIS SUBFIELD.

PBSLUK:	SKIPE PBPARN
	 HRLZS D
	JRST SLUK2

PBLOO5:	SKIPE PBFND	;PRINT AS <QTY>&<SYMBOL>
	 CTYPE "+
	MOVE D,PBFELD
	AND D,PBVAL	;GET THE QUANTITY.
	SAVE W1
	CALL TOC	;PRINT IT. W1 HAS ADDR OF SYMBOL.
	REST W1
	CTYPE "&
	CALL PBOPE1	;PRINT "(" OR "<", MAYBE.
	JRST PBLOO4	;AND THE SYMBOL.

PBLOO2:	CALL PBOPEN	;PRINT "+" IF NEC, AND "(" IF NEC.
	SKIPE PBPARN
	 HLRZS D
	MOVE B,PBVAL
	AND B,PBFELD
	IDIVM B,D	;GET THE COEFFICIENT OF THE LOW BIT.
	SAVE W1
	CALL TOC	;PRINT IT
	REST W1
	CTYPE "*	;TIMES
	JRST PBLOO4	;THE SYMBOL FOR THE LOW BIT.

PBLOO3:	CALL PBOPEN	;FOUND SYMBOL FOR VALUE IN FIELD - JUST PRINT IT
			;WITH "+" OR "(" IN FRONT IF NEC.
PBLOO4:	CALL SPT
	MOVE D,PBFELD	;MARK THIS FIELD AS HANDLED - NO LONGER NEEDING HANDLING
	IORM D,PBFND	;(IF NO SYMBOL FOUND, THIS ISN'T DONE)
PBLOST:	MOVE C,PBLMAR	;KEEP GOING TILL REACH BOTTOM OF HALFWORD.
	CAIE C,36.
	 JRST PBLOOP
	SKIPE PBFND	;THEN, CLOSE ANY ")" OR ">" THAT PBOPEN PRINTED.
	 SKIPN PBPARN
	  JRST PBCLOS
	CTYPE ")
	SKIPE PBANGL
	 CTYPE ">
PBCLOS:	MOVE D,PBVAL
	ANDCM D,PBFND	;WHAT PART OF VALUE WASN'T HANDLED BY BIT MODE?
	SKIPE PBFND
	 JUMPE D,CPOPJ
	MOVEI I2,NAF	;IF THERE IS ANY, PRINT IT BY OTHER MEANS.
	SKIPE PBFND
	 CTYPE "+
	JRST PAD1

PBOPEN:	SKIPE PBFND	;PRINT A "+" IF WE ALREADY PRINTED SOMETHING ELSE.
	 CTYPE "+
PBOPE1:	SKIPN PBFND	;PRINT A "(" BEFORE THE FIRST THING, IF PBPARN IS NONZERO
	 SKIPN PBPARN
	  RET
	SKIPE PBANGL	;AND PBANGL SAYS THAT PARENS NEED ANGLEBRACKETS AROUD THEM.
	 CTYPE "<
	CTYPE "(
	RET

TMT:
SATP:	MOVE C,D	;WILL SHIFT HIGH BITS OF ARG INTO D TO TYPE OUT.
	MOVE B,SATPC	;GET MASK (ALTERNATING BYTES OF 1'S AND 0'S)
	MOVEI A,36.	;COUNT # BITS HANDLED.
SATP0:	SETZ D,		;GET THE NEXT BYTE:
SATP1:	ROTC C,1	;GET NEXT BIT.
	LSH B,1
	SOJLE A,.+2	;END OF WORD?
	 JUMPL B,SATP1	 ;OR END OF WORD?
	CALL FTOC	;YES, TYPE THE BYTE
	CALL TSPC
	SETCA B,	;MAKE SURE MASK AGAIN STARTS WITH 1-BIT.
	JUMPG A,SATP0	;BITS NOT HANDLED => MORE BYTES.
	RET

;FLOATING POINT OUTPUT

TMF:
TFLOT:	MOVE A,D
NFLOT:	JUMPG A,TFL1
	JUMPE A,FP1A
	MOVNS A
	CTYPE "-
	TLZE A,400000
	JRST FP1A

TFL1:	MOVEI B,0
	TLNN A,400
	CTYPE "#	;NOT NORMALIZED
	CAMGE A,FT01
	JRST FP4
	CAML A,FT8
	AOJA B,FP4
FP1A:
FP3:	SETZB C,TEM1	;CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
	MULI A,400
	ASHC B,-243(A)
	MOVE A,B
	PUSHJ P,FP7
	CTYPE ".
	MOVNI A,10
	ADD A,TEM1
	MOVE W1,C
FP3A:	MOVE D,W1
	MULI D,12
	PUSHJ P,FP7B
	SKIPE W1
	AOJL A,FP3A
	POPJ P,

FP4:	MOVNI C,6
	MOVEI W2,0
FP4A:	ADDI W2,1(W2)
	XCT FCP(B)
	SOSA W2
	FMPR A,@FCP+1(B)
	AOJN C,FP4A
	PUSH P,EXPSGN(B)
	PUSHJ P,FP3
	MOVEI D,"E
	PUSHJ P,TOUT
	POP P,D
	PUSHJ P,TOUT
	MOVE A,W2

FP7:	SKIPE A	;AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
	AOS TEM1
	IDIVI A,12
	HRLM B,(P)
	JUMPE A,FP7A1
	PUSHJ P,FP7

FP7A1:	HLRZ D,(P)
FP7B:	ADDI D,"0
	JRST TOUT

	1.0^32.
	1.0^16.
FT8:	1.0^8
	1.0^4
	1.0^2
	1.0^1
FT:	1.0^0
	1.0^-32.
	1.0^-16.
	1.0^-8
	1.0^-4
	1.0^-2
FT01:	1.0^-1
FT0=FT01+1

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

EXPSGN:	"-
	"+

G9PNT:	SKIPA W1,[10.]	;DECIMAL TYPEOUT.
G8PNT:	MOVEI W1,8	;OCTAL.
	SKIPA D,A

;;; TMP, FTOC, G8PNT, and G9PNT all clobber D and W1

TMC:
FTOC:		;CURRENT RADIX TYPEOUT.
TOC:	HRRZ W1,ODF
	MOVEM W1,TOCTEM
	CAIN W1,12
	JRST TOC4
TOCA:	LSHC D,-43
	LSH W1,-1	;W1=D+1
TOC1:	DIVI D,@TOCTEM
	HRLM W1,0(P)
	JUMPE D,TOC2
	PUSHJ P,TOCA
TOC2:	HLRZ D,0(P)
TOC2FK:	ADDI D,"0
CJTOUT:	JRST TOUT	;DOES POPJ TO TOC2 OR EXIT

TOC4:	SKIPGE D
	 CTYPE "-
	MOVMS D
	PUSHJ P,TOCA
	MOVEI D,".
	JRST TOUT

SPT:	MOVE D,CJTOUT
	SAVE (W1)	;LEAVE NAME OF SYMBOL FOR $$^C.
	REST N2ACCS
.SPT:	MOVEM D,SPTS
	MOVE D,0(W1)	;SYMBOL PRINT
	TLZ D,740000
SPT1:	SAVE W1
SPT3:	IDIV D,[50*50*50*50*50]
	PUSHJ P,SPT2
	MOVE D,W1
	IMULI D,50
	JUMPN D,SPT3
	JRST POPW1J

SPT2:	ADDI D,260-1
	CAILE D,271
	ADDI D,301-272
	CAILE D,332
	SUBI D,334-244
	CAIN D,243
	MOVEI D,256
	XCT SPTS
	POPJ P,

PURIFY:	SKIPE SYSSTB
	 .VALUE		;HAS BEEN RUN OR IS PURE.
	JRST PURIF1

;RAID REGISTERS ARE THE DISPLAY FEATURE OF DDT.
;EACH JOB CAN HAVE RADNUM RAID REGISTERS, EACH OF WHICH REMEMBERS
;A LOCATION AND A TYPEOUT MODE FOR IT.  WHEN THE JOB RETURNS TO DDT
;ALL OF THE RAID REGISTERS ARE DISPLAYED.

;THE RAID REGISTERS LIVE IN DYNAMICALLY ALLOCATED STORAGE POINTED
;TO BY RADAOB(U). THE SPACE FOR RADNUM OF THEM IS ALLOCATED WHEN THE
;FIRST ONE IS SET.  RADAOB POINTS TO A VECTOR OF RADRGL-WORD BLOCKS,
;ONE FOR EACH REGISTER.  THE FIRST WORD OF THE BLOCK CONTAINS THE ADDRESS,
;WHICH MAY BE INDEXED OR INDIRECT;  IN ADDITION, IT MAY HAVE FNYLOC BITS
;IN THE TOP OF THE L.H.  THE NEXT TYPMOL WORDS ARE A COPY OF THE TYPEOUT
;MODE AS STORED IN TYPMOD ... TYPMOE-1.  THE LAST TWO WORDS HOLD
;INFO FOR RATE AND INVERSE-RATE TYPEOUT.


RADRGL==TYPMOL+5	;LENGTH OF DATA FOR EACH RAID REG.
RADOVL==TYPMOL+1	;RELATIVE IDX OF PREVIOUS VALUE, FOR RATE & ATB MODES.
RADOTM==TYPMOL+2	;RELATIVE IDX OF TIME OF LAST EXAMINATION, FOR RATE & ATB.
RADOAD==TYPMOL+3	;RELATIVE IDX OF E.A. OF LAST EXAMINATION.
RADOLD==TYPMOL+4	;THIS WORD, IF NONZERO, SAYS THAT THIS RAID REG
			;HAS BEEN DISPLAYED ALREADY, AND NEED NOT BE DISPLAYED AGAIN
			;UNLESS IT CHANGES.

RADDTC:	SKIPE GETTY		;RADDTC DISPLAYS RAID REGS AT SCREEN TOP,
	 SKIPN RAIDFL		;IFF THAT IS WANTED AND POSSIBLE.
	  RET			;OTHERWISE, IT IS A NO-OP.
	SKIPN SCROLL
	 SKIPN RADTOP
	  RET
;DISPLAY THE RAID REGISTERS AT SCREEN TOP, NOT CHANGING THE CURSOR POS
;UNLESS IT'S IN THE REGION DISPLAYED IN.
RADDTP:	SKIPN RADING
	 SKIPL A,RADAOB(U)	;FIRST, ARE ANY RAID REGS TURNED ON?
	  RET
	MOVNI B,1
	ADD A,[RADRGL,,RADRGL]
	CAMN B,-RADRGL(A)
	 JUMPL A,.-2
	JUMPGE A,CPOPJ		;NONE ARE ON, SO DON'T MESS WITH CURSOR.
	7TYPE [ASCIZ/ /]	;SPACE, BACKSPACE;  TRIGGERS --MORE-- BUT THAT'S ALL.
	CALL TYOFRC
	TSCLO PCPNTR
	hlrzs d			;isolate the vertical position
	SAVE D			;SAVE CURRENT CURSOR POSITION FIRST
	7TYPE [ASCIZ /SZ/]	;HOME DOWN SO RADDIS'S CRLF WILL GO TO SCREEN TOP.
	SETO D,
	CALL RADDS4		;THEN DISPLAY THE REGISTERS.  -1 IN D SAYS WE'RE AT SCREEN TOP
	CALL CRF
	CALL TYOFRC
	TSCLO PCPNTR
	HLRZS D
	REST C			;IS OUR REMEMBERED CURSOR POSITION INSIDE THE REGION THE
	caml d,c
	 call crf
	movei b,1(c)		   ;compensate for the 0-based indexing vs
				   ;1-based size
	caml b,ttymxv		   ;Were we at the bottom of the screen?
	  ret			   ;No, don't restore that position then!
	camge d,c
	 7TYPE [ASCIZ /R/] ;IF NOT, RESTORE THAT POSITION.
	RET

RADDT1:	SKIPE RADTOP	;DISPLAY THE RAID REGS, EITHER AT TOP OR IN THE STREAM.
	 SKIPN GETTY
	  JRST RADDIS
	SKIPE SCROLL
	 JRST RADDIS
	JRST RADDTP

;DISPLAY THE CONTENTS OF THE RAID REGISTERS IN THE OUTPUT STREAM AT THE CURSOR.
;PRINTS A CRLF BEFORE EACH LINE, BUT NONE AT THE END.
RADDIS:	SETZ D,
RADDS4:	JUMPL U,GSNLRT
	SKIPN RADING	;IF WE ARE ALREADY INSIDE RADDIS (EG USER TYPEOUT MODE LOST)
	 SKIPL B,RADAOB(U) ;THEN AVOID INFINITE RECURSIVE LOSSAGE.
	  JRST GSNLRT	;ALSO EXIT IF THERE ARE NO RAID REGS IN THIS JOB.
	SETOM RADING
	ADD P,[TYPMOL,,TYPMOL]
	MOVEI A,1-TYPMOL(P)
	HRLI A,TYPMOD	;PUSH THE CURRENT TYPEOUT MODE
	BLT A,(P)
	SAVE D		;-2(P) HAS -1 IFF WE ARE AT SCREEN TOP.
	SAVE [1]	;-1(P) HAS # OF THIS RAID REG.
	SAVE B		;(P) SAVES THE POINTER TO THIS RAID REG.
	SKIPN SYSSW
	 CALL EASETU	;SET UP FOR EFFECTIVE ADDRESS COMPUTATIONS.
RADDSL:	MOVE A,(B)	;HERE TO DISPLAY ONE RAID REGISTER.
	MOVEM B,(P)
	AOJE A,RADDS1	;JUMP IF THIS ONE HAS NOTHING IN IT.
	MOVSI A,1(B)	;THIS REGISTER'S IN USE; GET ITS TYPEOUT MODE AS CURRENT.
	HRRI A,TYPMOD
	BLT A,TYPMOE-1
	MOVE D,(B)	;GET ITS ADDRESS.
	HRRZ I1,D	;IF EXAMINING SYS JOB, "EFFECTIVE ADDR CALC" IS A NO-OP.
	SKIPN SYSSW
	 CALL NEFECC	;COMPUTE EFFECTIVE ADDRESS FROM IT.
	HLLZ D,(B)	;GET JUST THE FUNNY BITS
	TLZ D,#7^5
	IOR D,I1	;MERGE IN THE EFFECTIVE ADDRESS
	MOVEM D,LLOCO	;OPEN THAT LOCATION.
	MOVE A,(B)
	SKIPE RADCLR	;SCREEN CLEARED SINCE LAST RAID REG DISPLAY => MUST DISPLAY ALL.
	 JRST RADDS5
	SKIPE RADOLD(B)	;IF THIS RAID REG HAS BEEN DISPLAYED SINCE LAST ALTERED,
	 CAME D,RADOAD(B)	;AND E.A. AND CONTENTS ARE THE SAME AS THEN,
	  JRST RADDS5
	MOVE A,D
	SKIPE -2(P)	;AND DISPLAY IS AT SCREEN TOP SO ALWAYS IN SAME PLACE,
	 CALL FETCH
	  JRST RADDS5
	CAMN D,RADOVL(B)
	 JRST [	7TYPE [ASCIZ /D/]
		JRST RADDS1]	;THEN DON'T DISPLAY, JUST SKIP PAST THIS SCREEN LINE.
RADDS5:	MOVE D,LLOCO
	MOVEM D,RADOAD(B)
	7TYPE [ASCIZ /
 #/]
	MOVE A,-1(P)	;PRINT "<CRLF> #<NUMBER>   "
	CALL G8PNT
	CALL LCT
	MOVE D,(B)
	TLNN D,37	;IF ADDRESS IS INDEXED OR INDIRECT,
	 JRST RADDS2
	CALL PININ1	;PRINT ORIGINAL QUANTITY THAT E.A. WAS GOT FROM
	7TYPE [ASCIZ / -> /]
RADDS2:	MOVE D,LLOCO
	CALL PAD	;PRINT THE ADDRESS WE ARE OPENING.
	CTYPE "/
	HRROI C,FTOC
	CALL NTAB2	;AND THE CONTENTS AS A NUMBER
	MOVE C,SCH
	MOVE B,(P)	;GET RAID REG ADDR IN B, FOR RATE & ATB MODES.
	CALL NTAB2	;AND THE CONTENTS, IN THE SELECTED MODE.
	MOVE B,(P)
	SETOM RADOLD(B)	;SAY THIS RAID REG NOW ON SCREEN.
	MOVE D,LWT
	MOVEM D,RADOVL(B)
RADDS1:	AOS -1(P)
	MOVE B,[RADRGL,,RADRGL]
	ADD B,(P)	;ADVANCE TO NEXT RAID REGISTER.
	JUMPL B,RADDSL
	SUB P,[3,,3]
	MOVSI A,1-TYPMOL(P)
	HRRI A,TYPMOD	;POP THE OLD CURRENT MODE
	BLT A,TYPMOE-1
	SUB P,[TYPMOL,,TYPMOL]
	SETZM RADING
	SETZM RADCLR	;NOW NOT TRUE THAT SCREEN WAS CLEARED SINCE LAST RAID REG DISPLAY.
	JRST GSNLRT

;$V OF VARIOUS FORMS IS USED TO SET AND CLEAR RAID REGISTERS.
NALTV:	JUMPL U,JERR
	CALL RAD
NALTVX:	CALL RADDT1
	JRST NLTL2

RAD:	MOVE D,ARG1	;MERGE THE FUNNY BITS INTO THE ARG.
	CAME D,[-1]	;PREVENT USER FROM ACCIDENTALLY CREATING AN ADDRESS THAT
	 TLZ D,#(@(17))	;REFERS TO DDT OR A USET VAR.
	IOR D,FNYLOC
	MOVEM D,ARG1
	TLNN B,O.IFX	;GO TO RAD1 IF NO INFIX ARG
	 JRST RAD1
	JUMPE A,RAD0	;TO RAD0 FOR $0V.
	JUMPL A,NAERR	;$<-1>V ILLEGAL.
	SAVE A		;M$NV AND $NV HERE.
	CALL RADALC	;MAKE SURE THE STORAGE IS ALLOCATED, GET RADAOB IN A.
	REST D
	SUBI D,1
	IMULI D,RADRGL
	HRLI D,(D)
	ADD A,D		;ADVANCE A TO POINT AT THE SELECTED RAID REGISTER
	JUMPGE A,NAERR	;REGISTER # TOO LARGE?
	SKIPN ARG1+1
	 JRST RADSMD	;$NV WITH NO ARG JUST SETS REGISTER'S TYPEOUT MODE.
;SET RAID REGISTER POINTED AT BY A:  ADDRESS FROM 1ST ARGUMENT, TYPEOUT MODE FROM CURRENT.
RADSET:	MOVE D,(A)
	CAMN A,[-1]	;IF THIS RAID REG WAS FORMERLY NOT IN USE,
	 CALL RADUPD	;THEN ALL LATER ONES ARE MOVED DOWN ONE LINE, AND MUST BE REDISPLAYED.
	MOVE D,ARG1
	MOVEM D,(A)
RADSMD:	MOVSI D,TYPMOD
	HRRI D,1(A)
	BLT D,TYPMOL(A)
	SETZM RADOLD(A)	;EVEN IF ONLY CHANGING THE TYPEOUT MODE, MUST REDISPLAY THE RAID REG.
	RET

;COME HERE FOR $0V AND N$0V
RAD0:	SKIPE ARG1+1
	 JRST RADFLS	;<N>$0V => FLUSH A RAID REG SET AT <N>.
	SKIPE RAIDFL	;$0V COMPLEMENTS RAIDFL.
	 SETOM RAIDFL
	SETCMM RAIDFL
	RET

;COME HERE FOR $V AND N$V
RAD1:	SKIPN ARG1+1
	 SETOM RADCLR	;$V CAUSES A FULL REDISPLAY.  AND THAT'S ALL IT DOES.
	SKIPN ARG1+1
	 RET		;N$V SETS A REG AT N.
	CALL RADFLS	;FLUSH ONE REGISTER SET THERE ALREADY, IF ANY
RAD1A:	SETO D,
	CALL RADSRC	;FIND A FREE REGISTER, MAKE A POINT TO IT.
	 ERSTRT [SIXBIT /ALL RAID REGS IN USE?/]
	JRST RADSET	;GO PUT <N> AND CURRENT MODE IN IT.

;CLEAR THE RAID REGISTER (THE LOWEST NUMBERED, IF MORE THAN ONE EXIST)
;SET AT THE PLACE WHOSE ADDRESS IS IN ARG1.  NO COMPLAINT IF NONE EXISTED.
RADFLS:	SKIPL RADAOB(U)
	 RET
	MOVE D,ARG1
	CALL RADSRC
	 RET
	SETOM (A)
;MARK ALL RAID REGS FOLLOWING THE ONE <- A AS IN NEED OF UPDATING.
;THIS MUST BE DONE WHEN A RAID REG GOES IN OR OUT OF USE.
RADUPD:	SAVE A
RADUP1:	JUMPGE A,POPAJ
	ADD A,[RADRGL,,RADRGL]
	SETZM RADOLD(A)
	JRST RADUP1

;IF D HAS -1, SEARCH FOR A FREE RAID REG.  OTHERWISE, SEARCH FOR ONE SET AT THE
;ADDRESS IN D.  EITHER WAY, SKIP IF SUCCESSFUL, LEAVING ADDRESS OF THAT REGISTER IN A.
RADSRC:	SAVE D
	CALL RADALC
	REST D
RADSR1:	CAMN D,(A)
	 JRST POPJ1
	ADD A,[RADRGL,,RADRGL]
	JUMPL A,RADSR1
	RET

;GET AOBJN PTR TO THIS JOB'S RAID REGS IN A, ALLOCATING STORAGE IF NECESSARY.
RADALC:	SKIPGE A,RADAOB(U)
	 RET		;STORAGE ALLOCATED ALREADY => JUST RETURN PTR.
	MOVEI D,RADRGL
	IMUL D,RADSIZ
	CALL ALLOC	;ELSE ALLCATE IT
	MOVEM A,RADAOB(U)
	SETOM (A)	;AND MARK EACH REGISTER AS NOT IN USE.
	ADD A,[RADRGL,,RADRGL]
	JUMPL A,.-2
	JRST RADALC


;:RAIDFL -- THROW AWAY THE CURRENT JOB'S RAID REGISTERS (DEALLOCATE THE STORAGE)
KRAIDF:	JUMPL U,JERR
	MOVEI W1,RADAOB(U)
	CALL ELEC0
	JRST NLTL4

;:RAIDRP <N> -- DISPLAY THE RAID REGS EVERY <N> SECONDS.
KRAIDR:	CALL RONUM
	 JRST ALTDQX
	MOVEI D,5	;DEFAULT THE ARGUMENT TO 5 SEC IF IT IS 0.
	SKIPN ARG1
	 MOVEM D,ARG1
	.RDTIME C,	;GET A BASE TIME TO SLEEP FROM.  WE DON'T SLEEP <N> SECONDS,
	MOVNS C		;WE SLEEP TILL <N> SECS AFTER PREVIOUS WAKEUP.
	SETOM STOPWT	;SAY NO NEED FOR ANY "JOB FOO INTERRUPTED" MESSAGE
			;FROM THIS JOB, SINCE WE WILL LET IT RETURN SOON.
KRAID1:	SETZM HAKOK
	SKIPE UINT(U)
	 JRST [	SETZM STOPWT
		JRST UBRK0]
	SAVE C
	CALL RADDT1	;DISPLAY RAID REGS AT DESIRED PLACE.
	CALL TYOFRC
	MOVE D,ARG1	;GET TIME TO SLEEP, IN SECONDS
	REST C		;AND BASE TIME - TIME WE STARTED THE LAST DISPLAY.
	CALL HAKKAM
	CALL UBRK7
	 JRST KRAID1	;NO CHAR TYPED => REPEAT.
	SETZM STOPWT
	SETZM HAKOK
	JRST NLTL2	;CHAR WAS TYPED => RETURN.

;:RATE <X> SETS UP A RAID REGISTER SHOWING X'S RATE OF CHANGE
  ;(IN UNITS PER SECOND, WITH 3 DECIMAL PLACES).
;:ATB <X> SETS UP A RAID REGISTER SHOWING X'S INVERSE RATE OF CHANGE
  ;(AVG TIME BETWEEN CHANGES, IN SECONDS, WITH 3 DECIMAL PLACES).
KRATE:	SKIPA A,[-1,,RADRAT]	;SET UP RAID REG DISPLAYING RATE OF CHANGE.
KATB:	 HRROI A,RADATB		;SET UP REG SHOWING INVERSE RATE (AVG TIME BETWEEN)
	SAVE A
	CALL RONUM		;READ ARGUMENT (SPEC'D ADDRESS) INTO ARG1.
	 JRST [ REST A ? JRST ALTDQX]
	CALL RAD1A		;SET UP A RAID REG AT ADDRESS SPECIFIED.
	SAVE A
	MOVE A,ARG1		;GET THE CONTENTS OF THAT ADDRESS,
	CALL FETCHF
	 JFCL
	REST A
	MOVEM D,RADOVL(A)	;AND SET IT UP AS AN INITIAL VALUE,
	.RDTIME D,		;SAYING WHEN WE DID SO.
	MOVEM D,RADOTM(A)
	REST 1+SCH-TYPMOD(A)	;SET TYPEOUT MODE TO BE "RATE" OR "ATB".
	MOVEI D,10.
	MOVEM D,1+ODF-TYPMOD(A)	;IT SHOULD PRINT AS A DECIMAL NUMBER.
	JRST NALTVX		;GO REDISPLAY THE RAID REGS.

RADATB:	CALL RADDS3	;PRINT OUT AVG-TIME-BETWEEN. GET DELTA-T AND DELTA-X.
	MOVMS C		;WIN FOR VARS THAT GET SMALLER,.
	IMULI D,1000.	;EXPRESS DELTA-T IN 1/30 OF A MILLISEC
	IDIVI D,30.	;EXPRESS IT IN STRAIGHT MILLISECONDS.
	IDIV D,C	;GET MILLISEC PER EVENT.
	CALL RADPRT
	7NRTYP [ASCIZ / Sec/]

RADRAT:	CALL RADDS3	;PRINT OUT RATE: GET DELTA-T IN D, DELTA-X IN C.
	JUMPGE C,RADRA1
	CTYPE "-
	MOVNS C
RADRA1:	EXCH C,D
	IMULI D,30000.	;MULTIPLY BY 1000. FIRST, SO WE DON'T LOSE FRACTION.
	IDIV D,C	 ;(ALSO ACCOUNTS FOR TIME'S BEING IN 30'THS)
	CALL RADPRT
	7NRTYP [ASCIZ / Per Sec/]

;PRINT NUMBER IN D AS IF MULTIPLIED BY .001
RADPRT:	IDIVI D,1000.	;NOW SEPARATE INTEGER AND FRACTION PARTS OF RATE.
	SAVE W1
	MOVE A,D
	CALL G9PNT	;PRINT INTEGER AS DECIMAL.
	REST D
	IDIVI D,100.
	CTYPE "0(D)
	MOVE D,W1
	IDIVI D,10.
	CTYPE "0(D)
	CTYPE "0(W1)
	RET

;ASSUME B POINTS TO A RAID REG, AND ITS EXAMINED VALUE IS IN LWT.
;UPDATE RADOVL AND RADOTM IN THE RAID REG (PREVIOUS VALUE, AND TIME IT WAS THERE).
;RETURN DELTA-VALUE IN C, AND DELTA-T (IN 30'THS OF SECOND) IN D.
;CLEARS RADOAD(B) TO MAKE SURE THIS RAID REGISTER IS ALWAYS UPDATED.
;OTHERWISE RADDIS MIGHT WRONGLY THINK THAT IT "HADN'T CHANGED".
RADDS3:	.RDTIME A,	;GET TIME NOW
	MOVE D,A
	SUB D,RADOTM(B)		;TIME INTERVAL SINCE LAST DISPLAYED.
	MOVEM A,RADOTM(B)	;STORE THIS TIME AS TIME UPDATED LAST.
	MOVE C,LWT
	SUBM C,RADOVL(B)	;AMOUNT VARIABLE HAS CHANGED IN THAT MUCH TIME.
	EXCH C,RADOVL(B)	;STORE NEW VALUE AS OLD VALUE FOR NEXT TIME.
	SETOM RADOAD(B)
	RET

CONSTANTS
comment |		;Here so M-.OPTAB will find documentation on OPTABn
OPTAB::				   ;this tag is inside a comment
   4.9=>TERMINATE GET VAL
   4.8=>INHIBITE EVAL
   4.7=>FIELD TERM.
   4.6=>THIS SETS A PARTICULAR TYPEOUT MODE (IN RH OF DISPATCH)
   4.5=>POP INTO C,D
   4.4=>EXECUTE (AFTER POPPING INTO A,B)
   4.2-3=>PRECEDENCE=>NUMERIC OPER
   4.1=>EXECUTE DURING EVAL
   3.9=>CALL PLUNK1
   3.8=>EVARGS
   3.7=>ERROR IF INFERIOR PROCEDURE NOT OPEN (SEE 3.2)
   3.6=>IF 4.5 ON CALL NBITE
   3.4=>  < OR >
   3.3=>NORMAL GET VAL TERMINATE
   3.2 IF 3.7, HACTRN^K OK TOO.
   1.1-2.9=ROUTINE


|

;; ZERO ALT MODES
OPTAB0:	0		;^@
	230040,,NCTLA	;^A
	210000,,GSNLRT	;^B (SHOULDN'T GET PAST TYI)
	210000,,NCTLC	;^C
	210000,,NCTLD	;^D (SHOULDN'T GET PAST RCH)
	210000,,GSNLRT	;^E (SHOULDN'T GET PAST TYI)
	230040,,NCTLF	;^F
	210000,,NXERR	;^G?
	230040,,CTLH	;^H
	010600,,NTAB	;^I
	010600,,NNL	;^J
	230040,,CTLK	;^K
	0		;^L (SHOULDN'T GET PAST RCH)
	410604,,NCART	;^M
	10300,,NCTLN	;^N
	230000,,NCTLO	;^O
	010300,,NCTLP	;^P
	010600,,NUPA	;^Q
	210000,,NCTLR	;^R
	230040,,NCTLS	;^S
	230142,,NCTLT	;^T
	230142,,NCTLU	;^U
	210000,,GSNLRT	;^V (SHOULDN'T GET PAST TYI)
	210000,,GSNLRT	;^W (SHOULDN'T GET PAST TYI)
	210100,,NCTLX	;^X
	10200,,NCTLY	;^Y
	230000,,NXERR	;^Z?
	010600,,APAT	;^\
	010600,,AEPAT	;[ ;^]
	10300,,NCUPA	;^^
	2000,,n.or	;^_  Inclusive OR
	100000,,1	;SP
	4000,,NEXCLM	;!
	10200,,NDQ	;"
	10000,,NSIGN	;#
	REPEAT 2,0	;$, %
	10000,,NAMAND	;&
	10200,,NPRM	;'
	1000,,NLPARN	;(
	1000,,NRPARN	;)
	4000,,NSTAR	;*
	2000,,NPLUS	;+
	100000,,2	;,
	2000,,NMINUS	;-
	0		;.
	010200,,NSLASH	;/
	230000,,NCOL	;:
	10200,,NSEMIC	;;
	1010,,NLANGB	;<
	10200,,NEQL	;=
	401014,,NRANGB	;>
	210000,,NQMK	;?
	1000,,ATSIGN	;@
	REPEAT 26.,0	;A, B, ..., Z
	010200,,NLBRAK	;[
	010600,,NBKSL	;\
	010200,,NRBRAK	;]
	010600,,NUPA	;^
	10200,,NLFTA	;_

;ONE ALT MODE
OPTAB1:	0		;$^@
	230040,,NACA	;$^A
	210000,,GSNLRT	;$^B
	0		;$^C
	210000,,NCTLD	;$^D
	210000,,GSNLRT	;$^E
	230040,,NCTLF	;$^F
	210000,,NXERR	;$^G?
	230040,,CTLH	;$^H
	010600,,NTAB	;$^I
	010600,,NNL	;$^J
	230040,,CTLK	;$^K
	0		;$^L
	010600,,NACM	;$^M
	10300,,NACN	;$^N
	230000,,naco	;$^O
	010300,,NACP	;$^P
	010600,,NUPA	;$^Q
	210000,,NACR	;$^R
	230040,,NACS	;$^S
	230040,,NCTLT	;$^T
	230040,,NCTLU	;$^U
	210000,,GSNLRT	;$^V
	210000,,GSNLRT	;$^W
	230040,,NACX	;$^X
	10200,,NCTLY	;$^Y
	230000,,NXERR	;$^Z?
	0		;$^\
	010600,,AEPAT	;[ ;$^]
	230340,,NACUPA	;$^^
	0		;$^_
	100000,,3	;$SP
	4000,,FEXCLM	;$!
	10000,,ALTDQ	;$"
	10000,,ALTNM	;$#
	210000,,ALTDLN	;$$
	210000,,ALTPCN	;$%
	10000,,ALTAMP	;$&
	10000,,ALTPRM	;$'
	210000,,GSNLRT	;$(
	210000,,NARPRN	;$)
	4000,,FSTAR	;$*
	2000,,FPLUS	;$+
	500004,,4	;$,
	2000,,FMINUS	;$-
	1000,,NALT.	;$.
	010200,,NSLASH	;$/
	230000,,NCOL	;$:
	10200,,NASEMI	;$;
	210000,,ALTLES	;$<
	10200,,NALTEQ	;$=
	1000,,ALTGRT	;$>
	230000,,NAQMK	;$?
	0		;$@
	210000,,NALTA	;$A
	10300,,NALTB	;$B
	240000,,FTOC	;$C
	210000,,NALTD	;$D
	10200,,NALTE	;$E
	240000,,TFLOT	;$F
	010300,,NALTG	;$G
	240000,,HLFW	;$H
	10300,,NALTI	;$I
	230040,,NALTJ	;$J
	230000,,NALTK	;$K
	10200,,NALTL	;$L
	10200,,NALTM	;$M
	10200,,NALTN	;$N
	210000,,NALTO	;$O
	010300,,NALTP	;$P
	1000,,NALTQ	;$Q
	210000,,NALTR	;$R
	240000,,PIN	;$S
	210000,,NALTT	;$T
	630040,,NALTU	;$U
	10200,,NALTV	;$V
	10200,,NALTW	;$W
	10200,,NALTX	;$X
	10200,,NALTY	;$Y
	0		;$Z
	010200,,NLBRAK	;$[
	010600,,NBKSL	;$\
	010200,,NRBRAK	;$]
	010600,,NUPA	;$^
	6000,,NSHIFT	;$_

;OPERATORS WITH TWO ALT MODES
OPTAB2:	0		;$$^@
	230040,,N2ACA	;$$^A
	210000,,GSNLRT	;$$^B
	210000,,N2ACC	;$$^C
	210000,,NCTLD	;$$^D
	210000,,GSNLRT	;$$^E
	230040,,N2ACF	;$$^F
	210000,,NXERR	;$$^G
	10100,,KDISOW	;$$^H
	010600,,NTAB	;$$TAB
	0		;$$^J
	10100,,KDISOW	;$$^K
	0		;$$^L
	10102,,N2ACM	;$$^M
	10300,,N2ACN	;$$^N
	230000,,NCTLO	;$$^O
	010300,,N2ACP	;$$^P
	0		;$$^Q
	10200,,N2ACR	;$$^R
	230040,,N2ACS	;$$^S
	230142,,NCTLT	;$$^T
	230142,,NCTLU	;$$^U
	210000,,GSNLRT	;$$^V
	210000,,GSNLRT	;$$^W
	210000,,n2acx	;$$^X
	10200,,N2ACY	;$$^Y
	230000,,NXERR	;$$^Z?
	210000,,AUPAT	;$$^\
	010600,,AEPAT	;[ ;$$^]
	230040,,N2ACUP	;$$^^
	0 ? 0		;$$^_, $$SPACE
	010200,,A2XCL	;$$!
	10000,,ALTDQ	;$$"
	10000,,ALTNM	;$$#
	210000,,ALTDLN	;$$$
	210000,,ALTPCN	;$$%
	10000,,ALTAMP	;$$&
	10000,,ALTPRM	;$$'
	10000,,N2ALPR	;$$(
	10600,,N2ARPR	;$$)
	REPEAT 5,0
	010200,,NSLASH	;$$/
	230000,,NCOL	;$$:
	10200,,N2ASEM	;$$;
	210000,,A2LES	;$$<
	10200,,ALTEQ	;$$=
	0		;$$>
	230000,,NAQMK	;$$?
	0		;$$@
	210000,,NALTA	;$$A
	10300,,NALTB	;$$B
	240000,,FTOC	;$$C
	210000,,NALTD	;$$D
	10200,,NALTE	;$$E (SET PERM. E&S TYPEOUT MODE)
	240000,,TFLOT	;$$F
	010300,,NALTG	;$$G
	240000,,HLFW	;$$H
	0		;$$I
	230040,,N2AJ	;$$J
	230000,,NALTK	;$$K
	10200,,NALTL	;$$L
	0 ? 0		;$$M, $$N
	210000,,NALTO	;$$O
	010300,,NALTP	;$$P
	1000,,NALTQ	;$$Q
	210000,,NALTR	;$$R
	240000,,PIN	;$$S
	210000,,NALTT	;$$T
	010000,,LOGOUT	;$$U
	10000,,KLSTJ	;$$V
	0 ? 0		;$$W, $$X
	10200,,NALTY	;$$Y
	10200,,N2ALTZ	;$$Z
	010200,,NLBRAK	;$$[
	010600,,NBKSL	;$$\
	010200,,NRBRAK	;$$]
	0		;$$^
	6000,,NFSC	;$$_

;ORDINIARY INITIAL SYMS.
STBIO:
   PINIO9==STBIO+10	;USED BY PINIO TO FIND NAMES OF IO INSNS
IRP A,,[CLEAR,CLEARI,CLEARM,CLEARB,BLKI,DATAI,BLKO,DATAO,CONO,CONI,CONSZ,CONSO]
	SQUOZE 44,A
	A
TERMIN
	SQUOZE 4,APR ? 0
IRPS X,,START LFILE STP SYM JCL PFILE STB CONV XUNAME XJNAME LJB RND PURE HSNAME MAIL,Y,,[
.UAI .UAO .BAI .BAO .UII .UIO .BII .BIO]
IFNB Y,[
	SQUOZE 44,Y
	Y
]
	SQUOZE 44,..R!X
	.IRPCNT+1
TERMIN
	SQUOZE 44,$X ? 34
IRPS X,,START LFILE UNUSD SYM JCL PFILE STB UNUSD UNUSD UNUSD UNUSD RND PURE UNUSD UNUSD
IFSN X,UNUSD,[
	SQUOZE 44,..S!X
	400000+.IRPCNT+1
]
TERMIN
IRPS X,,.R .S ..R ..S
	SQUOZE 44,X
	1,,-1
TERMIN			;$? PREFIXES FOR DECODING ARGS TO .SUSET.
IRP A,,[PI,PTP,PTR,TTY,LPT,DIS]
	SQUOZE 4,A
	A_<8*3>
TERMIN
	SQUOZE 44,SXCT
	106000,,
	SQUOZE 44,ADJBP
	IBP
STBIOL==.-STBIO

;INITIAL FUNNY SYMS.
STBIF:	SQUOZE 4,..DDT
	400000,,
	SQUOZE 4,$M
	SETZ MSK

;THESE LOCATIONS MUST BE IN ASCENDING ORDER IN DDT
;OR TYPEOUT WILL FAIL!
	FOO==dirdir
IRPS X,,[dirdir dirfn1 dirfn2 ndrop ndrdev ndrdir ndrfn1 ndrfn2
MONMOD msk UNPURF  MSTYPE DOZTIM SENDRP BELCNT CLOBRF GENJFL PCPNTF
ckqflg nfvrbs DELWARN MORWARN CONFRM MASSCP LINKP TWAITF PROMPT RPRMPT
SNDFLG PRMMCH C.ZPRT OCOFL SMLINS SYMOFS BYERUN BITPAT BITSYM SCH RAIDFL TMSQ
TMA TM6 TMCH TMS TMH TMT TMF TMC TME PFILE MPERCE MAMPER MDOLLA
MPRIME MDQUOT MNMSGN XUNAME HSNAME MSNAM LPTFLG TTYFLG ESSYM]
IF2 IFL X-FOO,.ERR FUNNY SYM "X" OUT OF ORDER
IF2 FOO==X
	SQUOZE 4,..!X
	SETZ X
TERMIN
		;U-RELATIVE INITIAL SYMS. (NUMERICAL ORDER)
	UIWD==UINTWD
IRP X,,[UUNAME,UJNAME,INTBIT,URANDM,UINT
UPI0,UPI1,PPC,XECPC,UIWD,XINTWD,JTIME,UIND
USTYPE,MARADR,MARXCT,MARCON
NBPTB,BPCPC,CBPPS,INCNT,OIPCHK,USCNT
BTADR,BTPDL,BTINS,BPINFL]
	SQUOZE 4,..!X
	500000,,X
TERMIN

IRPC X,,12345678
	$!X!B=B1ADR+BPL*.IRPCN
	SQUOZE 4,$!X!B
	500000,,$!X!B
TERMIN

IRP X,,[STARTA,LIMIT,PERMIT,SYSUUO,PATCHL,LITCNT
TPERCE,TAMPER,TDOLLA,TPRIME,TDQUOT,TNMSGN
SAFE,USPARE,UFNAMD,UFILE,UHACK,UIACK,UCHBUF,BININF,UNDEFL,RADAOB,PRGM,JOBSYM]
	SQUOZE 4,..!X
	500000,,X
TERMIN
STBIFL==.-STBIF

PAT: PATCH: BLOCK 140

;E&S INSTRUCTION TYPEOUT OF VALUE IN D.
;ON LAST PAGE OF PURE SO WON'T SWAP IN UNLESS ESSYM SET
;(NORMALLY ONLY ON DM MACHINE)
TME:
PES:	SAVE D
	MOVE I2,[-PESTBL,,-1]
	TRZ D,-1	;GET JUST LH, SEARCH FOR THAT.
	JRST PES3

PES0:	JUMPE W1,PES2	;NO SYM < PREV => NONE < NEXT EITHER.
	MOVE D,PESTB(I2)
	AND D,(P)	;MASK TO CERTAIN FIELDS (PESTB SAYS WHICH)
	CAMLE D,1(W1)	;LARGER THAN LAST TIME'S BEST =>
	 JRST PES1	 ;WOULD BE LARGER THAN THIS TIME'S BEST.
	CAMN D,1(W1)	;EQUAL TO LAST TIME'S BEST =>
	 JRST PESFND	 ;LAST TIME'S BEST IS WHAT  WE'D LOOK FOR.
PES3:	SETZ W1,
	MOVE B,[-STBESL,,STBES]
	CALL SLUKB	;W1_ -> ES SYM WHOSE VAL IS CLOSEST TO C(D) BUT BELOW IT.
	 CAIA
	JRST PESFND	;EXACT MATCH.
PES1:	AOBJN I2,PES0	;KEEP TRYING VARIOUS COMBINATIONS OF FIELDS.
PES2:	HLRZ D,(P)	;PRINT LH OCTAL, RH AS ADDRESS.
	CALL FTOC
	JRST HLFW1

PESFND:	CALL SPT	;PRINT THE INSN NAME, (<- W1)
	MOVE  A,1(W1)	;GET VALUE OF INSN,
	ANDCA A,(P)	;GET PART OF ARG NOT IN INSN,
	TLO A,400000	;SET SIGN SO PIN3 WILL PRINT IDX SPECIALLY.
	SAVE A
	LDB I1,[410300,,-1(P)]	;GET CLASS OF E&S INSN.
	MOVE B,(W1)	;GET FLAGS OF THE INSN (FOR AC FIELD TYPEOUT)
PESFN0:	CALL TSPC
	LDB D,[270400,,(P)] ;GET AC FIELD(OR 0 IF INSN INCLUDSE iT)
	TLNN B,%SYLCL	;LOCAL FLAG SET IN INSN => IT DOESN'T INCLUDE AC FLD.
	 JUMPE D,PIN2	 ;(GO PRINT @ AND ADDR AS FOR PDP10 INSNS)
	LSH D,1		;PESCDR, PESDPR ARE 2 WDS/ENTRY.
	CAIE I1,3	;CLASS 3 INSN => PRINT AC AS CDIR,
	 ADDI D,PESDPR-PESCDR ;ELSE AS DPR
	MOVEI W1,PESCDR(D)
	CALL SPT
	JRST PINIO1	;PRINT ",", THEN @ AND ADDR.

PESIDX:	CAIN I1,3	;I1 HAS INSN CLASS; PRINT C(D) AS IDX FIELD.
	 JRST FTOC	;CLASS 3 E&S INSN.
	CAIE I1,2
	 JRST PESMD	;ORDINARY E&S INSN, AS MODE CHANGE.
	LSH D,1		;E&S CONDITIONAL INSN,
	MOVEI W1,PESCND(D)
	JRST SPT	;PRINT CONDITION NAME.

PESMD:	MOVE A,D	;PRINT C(D) AS MODE-CHANGE.
	MOVE W1,[-4,,PESMDT] ;AOBJN -> MODE NAMES & VALUES.
PESMD1:	TDZN A,1(W1)	;CHECK WHETHER THIS MODE'S BIT IS ON.
	 AOJA W1,PESMD2
	CALL SPT	;YES, PRINT ITS NAME.
	JUMPE A,CPOPJ	;ALL BITS DONE?
	CTYPE "+	;NO, SEPARATE NAMES WITH +.
	AOJ W1,
PESMD2:	AOBJN W1,PESMD1
	RET

;TABLE OF COMBINATIONS OF FIELDS INCLUDED IN E&S iNSNS.
;(IN DECREASING NUMERICAL ORDER SO EACH VALUE GIVEN
;TO SLUKB WILL BE SMALLER THAN THE PREVIOUS.)
PESTB:	777760,,	;INSN, AC, @.
	777757,,	;INSN, AC, IDX.
	777740,,	;INSN, AC.
	777037,,	;INSN, @ IDX.
	777020,,	;INSN, @.
	777017,,	;INSN, IDX.
	777000,,	;INSN.
	760740,,	;PART OF INSN, AC.
	760000,,	;PART OF INSN.
PESTBL==.-PESTB

CONSTA

STBES:	;E&S SYMBOLS. 1ST, THE INSNS, IN NUMERICAL ORDER:
;USE = TO HALFKILL, - TO FORCE TYPEOUT OF AC FIELD EVEN IF 0.
IRPS X,Y,[BOXSA 400000,BOXSR 401000,BOXA 402000,BOXR 405000
DOTSAA 412000,DOTSRA 413000,DOTSAR 414000,DOTSRR 415000
DRAWTA 422000,DRAWTR 425000,POLAA 432000,POLRA 433000,POLAR 434000,POLRR 435000
STARAA 442000,STARRA 443000,STARAR 444000,STARRR 445000
DRAWFA 452000,DRAWFR 455000,
SETPTA 462000,LINAA=462000,SETPTR 465000,LINRR=465000,LINAR 466000,LINRA 467000
POLIAA 532000,POLIRA 533000,POLIAR 534000,POLIRR 535000
LINIAA 562000,LINIRR 565000,LINIAR 566000,LINIRA 567000
NEWCRV 602020,DOTCRV 612020,DRACRV 622020,POLCRV 632020,SETCRV 662020
DOCHAR 700000
LI-0,XQTA 10,NOP 20,PROG 21,PEEL 22,RPT 24,XQT 30,JMP 100
LIS-20000,RJMP 20100,LIPSH-40000,PSH-40020,NWSTK 40140,
LIPSHM-60000,PSHM-60020,JMPPSH 60100,NWSTKM 60140
LIF-200000,JIF 200100,JIFDED 200117,LIFCL-210000,JIFCL 210100
LIFST-220000,JIFST 220100,IJNRCR 220110,IJNWCR 220111
IJPRCR 220130,IJPWCR 220131,LIFCM-230000,JIFCM 230100
LAL-240000,JAL 240100,LALCL-250000,CL 250020,JALCL 250100
LALST-260000,ST 260020,JALST 260100,STOP 260217,LALCM-270000,CM 270020,JALCM 270100
LOCLA-300000,LOCLR-301000,LOCLSA-302000,LOCLSR-303000,LOMM-304000
LOMMR-305000,LOMMP-306000,LOMDIR 307001,LOCB-314000,LOSBKL-316000,LOLITS 316301
STCL-320000,STMM-324000,NOMM 325020,POPMM-326020,STMDIR 327001
STCB-334000,STSBKL-336000,STKNOB=336000,STSWCH 336201
RTCLA-340020,RTCLR-341020,RTCLSA-342020,RTCLSR-343020
RTMM-344020,RTMMS-345020,RTMDIR 347021,RTCB-354020,RTSBKL-356020
SKCL-360020,SKMM-364020,SKMMS-365020,PUSHMM-366020,SKMDIR 367021
SKCB-374020,SKSBKL-376020]
IFE .IRPCN&1,[SQUOZE 4,X IFSE [Y]-,[(%SYLCL)] IFSE [Y]=,(%SYHKL)
]IFN .IRPCN&1,X,,
TERMIN
STBESL==.-STBES	;LENGTH OF INSN TABLE.

PESDPR:	;DEVICE REG NAMES.
IRPS X,,RAR WAR PC SP P1 P2 DSP UR RCR WCR DIR RSR SR MAR 16 17
SQUOZE 4,X ? .IRPCN
TERMIN

PESCND:	;CONDITION NAMES
IRPS X,,PF0 PF1 PF2 PF3 PF4 PF5 PF6 PF7 RCRN WCRN HITF AICF PF14 PF15 PF16 STOPF
SQUOZE 4,X ? .IRPCN
TERMIN

PESCDR:	;CDIR NAMES.
IRPS X,,[SAVELB SAVERT VIEWLB VIEWPT WINDLB WINDRT
INSTLB INSTRT NAME CDIR HITANG SELINT SAVE VIEW WIND INST]
SQUOZE 4,X ? .IRPCN
TERMIN

PESMDT:	;MODE CHANGE BITS.
IRPS X,,PROGM PEELM RPTM XQTM
SQUOZE 4,X ? 1_.IRPCN
TERMIN
STBESA==.-STBES

INFORM [Top of pure]\.-1
.=<.+1777>/2000*2000
NPUR==<.+1>/2000	;PURE PAGE HACK

HIMPUR::	;START OF HIGH IMPURE.

;^B, :WALLP FILE.
WFILE:	'DSK,,
	SIXBIT /WALL  PAPER/
	0		;SNAME GOES HERE

;:XFILE FILE.
XFILEF:	SIXBIT/DSK   FOO   LOGIN/
	0

;^K FILE.
SFILE:	'DSK,,
	SIXBIT/TS/
SYSN2:	0
sfiles:	0			   ;SNAME to look at goes here

;^F, :LISTF FILE.
FFILE:	'DSK,,
	SIXBIT /.FILE.(DIR)/
FFILES:	0

;:PRINT FILE.
PFILE:	'DSK,,
PFILE1:	SIXBIT /.FOO./
PFILE2:	SIXBIT />/
PFILES:	0


opnprg:	.call opnblk
	  .break 16,500001
	  .break 16,700001
opnblk:	setz ? sixbit /OPEN/
opnmod:	%clbit,,0	;mode put here
opnchn:	%climm,,0	;channel put here
opnbdv:	opndev
opnbf1:	opnfn1
opnbf2:	opnfn2
opnbsn:	setz opnsnm
opndev:	sixbit /DSK/
opnfn1:	sixbit /.TEMP./
opnfn2:	sixbit />/
opnsnm:	sixbit /HUH?/
prglen==.-opnprg

mailtm:	0	;Time last mail arrived
mailnt:	0	;-1 => Note mail arrival with beeps
		;-2 => Wait until we have the TTY for above
		;0  => Mail notification OFF
		;1  => Note mail arrival with beeps and one-line summary
		;2  => Wait until we have the TTY for above
mailns:	0	;-1 => show subjects in above summaries (experimantal)
sndflt:	0	;send default
sndits:	0	;ITS to look at in case of $^A and $$^A
netabp:	0	;BP to net address (to print for forwarded mail)

cladir:	sixbit /.TEMP./	;directory for SENDS files

tfile:	block 4

;TYPEOUT MODES TO INITIALIZE NEW JOBS, AND FOR USE IF NO JOB.
;ASSOCIATED RESP. WITH $%, $&, $$, $', $", $#.
MPERCE:	-1,,PIN
MAMPER:	-1,,TMSQ
MDOLLA:	-1,,PIN
MPRIME:	-1,,D6PNT
MDQUOT:	-1,,D7PNT
MNMSGN:	-1,,TMCH

PVALFL:	0	;-1 WHILE INVOKING USER-DEFINED TYPEOUT MODE.


LOGDIN:	-1	;-1 IF NOT LOGGED IN; 0 IF LOGGED IN.
RUNAME:	-1	;REAL UNAME (WHAT DDT THINKS ITS .UNAME IS)
XUNAME:	-1	;WHO IS SUPPOSEDLY REALLY USING THIS TREE (WHOSE MAIL & MSGS & INIT FILE TO USE).
ruind:	-1	;our own user index
TUNAME:	-1	;TEMPORARY XUNAME - THING TO SET NEXT ^K'D PROGRAM'S XUNAME TO.
THSNAM:	-1	;Temporary HSNAME, corresponding to the TUNAME in effect
HSNAME:	-1	;HOME DIRECTORY (SAME AS .HSNAME);  WHERE RMAIL FILE GOES.
MSNAM:	0	;INITIAL SNAME FOR NEW JOBS, AND DDT'S WORKING DIRECTORY.
LSNAM:	0	;DDT'S SUPPOSED SNAME.
SRFLAG:	0	;-1 SAYS RESTORE REAL SNAME FROM LSNAM.
SFDIR:	-1	;0 => SEARCH SNAME LIST FOR $L, ^K.
INSNAM:	0	;POINTER TO LIST BELOW (TEMP)
SNLIST:	0	;FLOCK PUTS SNAME ACTUALLY FOUND ON IN HERE.
	BLOCK SNLLEN
SNLIS1:	BLOCK SNLLEN+2

GETTY:	0	;NONZERO IF GRAPHICS TTY.
TYGTYP:
TTYTYP:	0	;TTY'S TTYTYP WORD (FOR GETTING LINE SPEED).
TRMNAM:	0	;TERMINAL NAME(SIXBIT), READ AT LOGIN IF REMOTE TTY.
TTYNUM:	0	;NUMBER OF JOB'S CONSOLE.
TTYOPT:	0	;TTY'S TTYOPT VARIABLE.
NOERAS:	0	;-1 IF TTY IS A NONERASABLE DISPLAY (STORAGE TUBE).
ERASE:	0	;-1 if ^PX and friends will win
TCTYP:	0	;TTY'S TCTYP VARIABLE.
TTYMXV:	0	;TTY's vertical size
TTYMXH:	0	;TTY's horizontal size
OSPEED:	0	;TTY's OSPEED variable
ISPEED:	0	;TTY's ISPEED variable
SMARTS:	0	;TTY's SMARTS variable
TTYSTS:	0	;NORMAL TTYSTS; **MORE** ENABLED.
TTYSCM:	0	;TTYCOM SAVED HERE TO RESTORE STATE OF OCO AT %SAVEX
SCROLL:	0	;-1 IFF TTY IS IN SCROLL MODE.
ITSNAM:	0	;NAME OF THIS MACHINE (AI OR ML)
SLOADU:	0	;ADDRESS IN SYSTEM OF SLOADU VARIABLE.
SILNT:	0	;-1 IF TYPEOUT SUPPRESSED BY ^S.
tthelp:	0	;0 -=> [HELP] is translated into '?'
hlprtn:	0	;if non-zero, is a help routine to provide help inresponse to
		;[HELP] 
tyisnd:	0	;-1 if TYI3 should let ^V and ^W through
ctlsfl:	0	;-1 if TYI should turn ^S and ^Z into ^D
rubsav:	0	;0, or saved buffer location for ^Y to undo to in :SEND's
bughed:	0	;in :SEND, we've shown the header.
jclend:	0	;Byte Pointer to end of VPAGAD buffer
lrunsw:	0	;non-zero if we're hacking long JCL (Meaninful to LRUN routine
		;  only!) 
buggsc:	-1	;if zero, suppresses ^L printing GSOC buffer in BGREAD
LPTOPN:	0	;NONZERO IFF WALLPAPER FILE IS OPEN.
LPTFLG:	0	;0 IF WALLPAPER FILE OUTPUT ON,
		;AOS'D BY ^E, SOS'D OR ZEROED BY ^E,
		;IRRELEVANT IF LPTFLG HOLDS 0.
TTYFLG:	0	;0 IF TTY ON (SOS'D OR ZEROED BY ^V, AOS'D BY ^W)
TOUTXQ:	0	;IF NONZERO, TOUT XCTS THIS INSTEAD OF NORMAL TYPEOUT.

reownf:	0	;-3 while handling ^K.  -2 for a :FOO when ..GENJFL is 0.
		;-1 for :RETRY FOO.
		;0 during $J and ^H.
		;>0 during :NEW FOO.
		;-4 during a :FJOB

insist:	0	;-1 => on error in FNDCMD, aos.  Any other value errors out
		;inside FNDCMD instead
LOADF:	0	;-1 AT IOC ERROR ==> ERROR ON LOADING
ALDPAG:	-1	;THIS + 1 IS 1ST PAGE THAT WE HAVEN'T CREATED DURING LOADING.

FRNDEL:	0	;-1 WHILE QUITTING CAUSE FRN JOB WENT AWAY WHILE CURRENT.
		;TELLS %RESET TO :KILL SO FORGET ABOUT THE JOB.

I40:	0	;TSINT USER'S SYS UUO.
IPC:	0	;TSINT USER'S PC.
INTING:	0	;-1 IF AT INT LEVEL.
INTIOP:	0	;-1 IF TSIN3 HAS PUSHED USR CHNLS.
HAKIOP:	0	;-1 IF HAKKAH HAS PUSHED USR CHNLS.
JBIBUF:	BLOCK 5	;1 5-WD ENTRY AT A TIME OF INFERIO'S INTERRUPT
		;TABLE IS READ INTO THIS BLOCK.
;;; These used to be in pure space; this seems as good a place as any
BADBTS:	0	;CLASS 1 AND 2 INTS (READ FROM SYSTEM AT STARTUP)
OIPBIT:	0	;THE BIT IN THE PC THAT CAUSES 1-PROCEED ON THIS MACHINE.
KS10IO:	0	;-1 => KS-10 I/O INSTRUCTIONS, 0 => KA/KI/KL

HAKOK:	0	;-1 => TSINT CAN EXIT TO HAKKAH IF IT QUEUES A RQ.
HAKRQ:	0	;-1 => THERE IS WORK FOR HAKKAH TO DO (.BREAK 12'S OR CLI INT)
HAKING:	0	;-1 => HAKKAH IN PROGRESS, PREVENTS RECURSIVE HAKKAH.
HAKTYP:	0	;-1 => PRINT THE "RANDOM TYPEOUTS" (:SENDS, ALARM, GOING DOWN)
HAKINT:	0	.SEE %PIDBG,%PIDWN,%PIRLT,%PICLI,%PICL1
		;IF ANY OF THOSE INTS OCCURS, THE BIT IN THIS WD IS SET
		;TO TELL HAKKAH TO HANDLE THE INT.
JREMEM:	0	;INT BITS OF FORGOTTEN JOBS THAT ARE INTERRUPTING.

VALCOM:	0	;IF NOT 0, HAS ADDR OF VALRET STRING WHICH CAN BE HANDLED IMMEDIATELY.

ESSYM:	0	;-1 => SEVL SHOULD LOOK AT E&S SYMS.

STBSO:	0	;AOBJN -> SYSTEM ORDINARY DEFAULT SYMS (IN STBSPG)
STBSF:	0	;AOBJN -> SYSTEM FUNNY DEFAULT SYMS
SYMTOP:	DDTEND	;-> AFTER ALL SYMBOLS.
NPAGES:	<DDTEND+1777>/2000	;# 1ST PAGE ABOVE SYMTAB SPACE.
STBDDT:	STBDE	;PURIF3 MAKES THIS -> DDT SYMBOL TABLE.
RELCP1:	0	;NONZERO => ADDR OF PTR INTO SYMTAB SPACE (TO RELOCATE IF NEC)
TEM2:	0
FNYLOC:	0	;FUNNYNESS OF SYMS EVALLED ACCUMULATES HERE,
		;400000,, => DDT REF; 200000,, => USET REF.
undefp:	0	;set if an undefined is encountered, cleared if it is
		;deterimined to be legal.  If this is found set when processing
		;a comma, time to barf about illegal U-turns
UNDFRP:	0	;INDEX OF LAST USED IN UNDFRL.
UNDFRL:	BLOCK UNDFRS	;HOLDS 2 UNDEF SYM REFS IN ARGS EVALLD.
UNDEFF:	0	;NONZERO => IT IS SQUOZE OF SYM, WHICH A ?U? ERROR WAS JUST GIVEN ABOUT.

4BLK:	0	;1ST WD OF 1ST 4BLK.
REPEAT 4BLKNM,[
	0?0?0	;LAST 3 WDS OF 4BLK.
	.-4	;START OF NEXT 4BLK (LAST TIME THROUGH, FREE LIST PTR)
]
4BLKF=.-1	;FREE 4BLK LIST PTR.

AC0:	BLOCK 20	;JOB'S ACS PUT HERE FOR ADDRESS CALC. ETC.

PS:	BLOCK LPDL+30	;PDL	;LEAVE ROOM FOR PDL OV RTNS AND HAKKAH.

;BUFFERED TYPEOUT HACKERY.
TYOCNT:	TYOBFL*5	;# CHARS SPACE LEFT IN TYOBUF.
TYOPNT:010700,,TYOBUF-1	;BP TO IDPB TYOBUF.
TYOBUF:	BLOCK TYOBFL	;BUFFER FOR BLOCK MODE TTY OUTPUT.
TYOUNI:	0	;-1 => USE UNIT MODE FOR TYPEOUT (SET BY MORE-PROCESSING
		;ROUTINES THAT WANT TO TYPE OUT WHILE THERE IS MAIN-PRGM
		;LEVEL STUFF SITTING IN TYOBUF).

;VARS FOR BIT TYPEOUT.
PBSYM:	0	;SYMBOL PREFIX, IN SQUOZE
PBMASK:	0	;50^<N>, WHERE <N> IS NUMBER OF BLANKS AT END OF PREFIX IN PBSYM.
PBPAT:	0	;THE PATTERN - A $T-STYLE VALUE DIVIDING HALFWORD INTO SUBFIELDS.
PBVAL:	0	;VALUE BEING PRINTED IN BIT MODE.
PBFND:	0	;ACCUMULATES 1'S IN SUBFIELDS THAT GET HANDLED BYY BIT MODE.
PBLMAR:	0	;# OF BITS FROM HIGH END TO NEXT SUBFIELD TO HANDLE.
PBFELD:	0	;MASK TO THE SUBFIELD BEING HANDLED.
PBPARN:	0	;NONZERO => BIT MODE SYMBOLS NEED PARENS AROUND THEM.
PBANGL:	0	;SET WITH PBPARN => ANGLE BRACKETS MUST SURROUND THE PARENS.

;VARS READ IN FROM ITS BEFORE WRITING OUT A DDTBUG FILE.
ERRDF1:	0	;.DF1
ERRDF2:	0	;.DF2
ERRPIR:	0	;.PIRQC
ERRIFP:	0	;.IFPIR
ERRPIC:	0	;.PICLR
ERRAPR:	0	;.APRC
ERRTTY:	0	;.TTY
ERRBCH:	0	;LAST CHANNEL TO GET UNHAPPY.
ERRSTA:	0	;STATUS OF THAT CHANNEL.
ERRJNA:	0	;DDT'S JNAME.
ERRMPV:	0	;LAST MPV/PUR INT FAULT PAGE'S FIRST ADDR.

GTPNTR:	0	;THESE 3 WDS USED BY $<
GTFTEM:	0
GTMALT:	0
	;FIRST 4 MUST BE IN ORDER
;USED FOR READING SYLS, CLEARED ON RUBOUT.
GSONUM:	0	;OCTAL NUMBER
GSDNUM:	0	;DECIMAL NUMBER
GSFNUM:	0	;FLOATING
GSSSYM:	0	;SQUOZE
GSENUM:	0	;NUMBER OF ALTMODES
GSFNUC:	0

RFLFN1:	0	;DEFAULT FN1, FN2 SAVED FOR ^X, ^Y BY RFL.
RFLFN2:	0

GSOCRT:	0	;GO THERE ON READING RUBOUT.
GSOCPP:	0	;RESTORE P ON RUBOUT.
GSOCRP:	0	;RESTORE GSCHRP ON RUBOUT.
GSOVPS:	0	;CURSOR POSITION OF CHAR GSOCRP POINTS AT.
GSOHPS:	0
GSOPDP:	0	;RESTORE GSOCRT, GSOCPP FROM THESE 2 WDS
GSORET:	0	;IF RUB BACK PAST GSOCRP .
GSOOVP:	0	;CURSOR POSITION OF START OF SYLLABLE (CHAR GSCHRP POINTS AT).
GSOOHP:	0
GSCHRP:	010700,,DDTEND	;NORMALLY, BP FOR STUFFING BUFFER.  IF REREADING, -> NEXT CHAR TO REREAD.
GSCHRQ:	0		;WHEN RE-READING CHARS AFTER RUBOUT OR ^L, THIS IS WHERE TO STOP.
GSCHRA:	DDTEND	;AOBJN PTR TO RUBOUT-PROCESSING CHARACTER BUFFER.  FOR STORAGE ALLOCATOR.

hakmct:	0		;Count of header lines examined in HAKML6.

cliunm:	0		  ;UNAME of last CLI
clijnm: 0		  ;JNAME of last CLI

clisiz==:20		  ;# of words to add to buffer at a time.
clibeg:	010700,,ddtend    ;buffer to use for SENDS until written to disk
cliptr:	010700,,ddtend    ;pointer to current char in CLI buffer
cliopt:	010700,,ddtend    ;pointer to stuff being output
cliend:	010700,,ddtend    ;Byte ptr to end of CLI buffer
clibpt:	ddtend		  ;AOBJN ptr to extent of buffer

clisrc: clired		  ;Routine to get next character of CLI frobule

;;; This is the buffer to hold killed text in :SEND's
klbbeg:	010700,,ddtend    ;start of buffer
klbend:	010700,,ddtend    ;end of buffer
klbipt:	010700,,ddtend    ;kill buffer input pointer
kilbpt:	ddtend		  ;AOBJN Pointer to extent of buffer

;this is the buffer used for reading files off of FDRC (:PRINT, ^F, etc).
;the following must be contiguous (they are BLT'ed onto the pdl)
fdrctb:	block fdrcl
fdrcte:	0
fdrcip:	0		;input byte pointer
fdrcep:	350700,,	;end byte pointer.
fdrcnd:	0		;-1 => have reached EOF;  buffer now has everything
fdrcse::		;end of range pushed by SHFDRC

SYM:	0	;ARGUMENT TO EVAL
SYM1:	0
FLDSTR:	0
FLDTBP:	DDTEND	;AOBJN -> FROB TABLE (IN SYMTAB SPACE)

ARG1:	BLOCK NARGS*2	;ARGS PUT HERE BY EVARGS, 2 WDS PER.
VALUE:	BLOCK 2
PVALUE:	0
VALUEQ:	0	;THE "OLD" VALUE, USUALLY 0 BUT SET BY $>.
		;USED BY VEARG TO DEFAULT UNSPECIFIED FIELDS.
VALUER:	-1	;1 IN THOSE BITS NOT EXPLICITLY SPEC'D IN EXPRESSION.
		;VALUEQ IS MERGED INTO ULTIMATE VALUE MASKED BY VALUER.
ABCNT:	0
FLDTRM:	0
STATE:	0	;WORD ASSEMBLY FROM FIELDS STATE
PSTATE:	0	;PAREN/ANG BRAKET STATE
NBITET:	0
SUCCES:	0	;-1 IF LAST :IF, :ELSE OR :ALSO WAS SUCCESSFUL.

LWT:	BLOCK 2		;$Q KEPT HERE (A SYLLABLE)
LWTP:	LWTTAB		;$Q RING BUFFER POINTER
LWTTAB:	BLOCK 2*LWTLNG	;$Q RING BUFFER, EACH ELT. IS A 2-WD SYLLABLE.
LLOC:	0		;VALUE OF POINT. LH HAS FUNNYNESS.
LLOCO:	0		;LAST LOCATION OPENED.   "   .
PLCR:	0		;POINT RING BUFFER POINTER (IDX IN LOCBF)
LOCBF:	BLOCK NLEVS	;POINT RING BUFFER, LH OF EACH WD A FUNNYNESS.

PLUNKF:	0		;PLUNK1 SAVES F HERE FOR AEPAT.

;EVERY JOB SELECTED HAS ITS IDX (IN DDT) PUSHED ONTO JPDL. $1J POPS JPDL.
JPDLP:	004400,,JPDLB+1	;POINTER INTO JPDL
JPDLB:	BLOCK JPDLL
JPDLE::
JPDLC:	0		;# OF VALID ENTRIES IN JPDL (BETWEEN 0 AND JPDLL)

	VARIAB
DDTEND:	INFORM [Start of SYMTAB space]\.-1
	Constants
ifn <.-ddtend>,[printx \
Alright, who's the turkey using CONSTANTS in high impure?\]

;ONCE-ONLY INITIALIZATION CODE CLOBBERED BY SYMTAB SPACE.
DDT2:	MOVE P,[(-LPDL)PS] ;COME HERE WHEN START DDT 1ST TIME.
	SETZB F,UCHNLO	;INDICATE NO USER CHANNEL OPEN
	MOVE U,CU	;NO JOB.

;;; I moved this here from PURIF3 because these are cpu-specific, and
;;; were breaking ^N on the KL -- Gumby 23 April 86:
IRPS CPUSYM,,BADBTS OIPBIT
	MOVE A,[SQUOZE 0,CPUSYM]
	.EVAL A,
	 .VALUE
	MOVEM A,CPUSYM
TERMIN
	MOVSS OIPBIT
	MOVE A,[SQUOZE 0,KS10P]
	.EVAL A,
	 MOVEI A,0
	MOVNM A,KS10IO

	SKIPN SYSSTB	;IF DON'D HAVE SYS AND DDT SYMS,
	 JSP W1,PURIF3	;GET THEM.
	CALL PURIF5
	;; Gotta enable that all-important Light-pen interrupt! (%PILTP)
	skipe debugp	;if debugging, don't catch illopr, iocerr.
	 skipa a,[%PIRLT\%PIATY\%PIWRO\%PIDBG\%PICLI\%PIPDL\%PILTP\%PIMPV\%PI1PR\%PIBRK\%PIOOB\%PIDWN\%PIB42\%PIC.Z\%pijst]
	  move a,[%PIRLT\%PIATY\%PIWRO\%PIDBG\%PICLI\%PIPDL\%PILTP\%PIMPV\%PI1PR\%PIBRK\%PIOOB\%PIIOC\%PIVAL\%PIDWN\%PIILO\%PIDIS\%PIB42\%PIC.Z\%pijst]
	hrroi b,1_tyic+1_comc+1_usri+1_tyoc
	move c,[-22,,[	SIXBIT /XUNAME/	? MOVEM XUNAME
			SIXBIT /40ADDR/	? MOVEI FORTY
			SIXBIT /TTY/	? TLO %TBINF
			SIXBIT /MASK/	? MOVE A
			SIXBIT /MSK2/	? MOVE B
			SIXBIT /PICLR/	? SETOI
			SIXBIT /UNAME/	? MOVEM RUNAME
			SIXBIT /UIND/	? MOVEM RUIND
			SIXBIT /OPTION/	? TLO %OPINT\%OPOPC\%OPLOK\%OPLKF
			]]
	SYSCLE USRVAR,[MOVEI %JSELF ? C]
	call ddtun1	;read UNAME from system.  Leaves it in C
	skipe pwordp	;If we were logged in by PWORD
	  call ddtunp	;  Gotta figure our XUNAME, too.
	skipn pwordp	;Otherwise
	  call ddtunx	;  read xuname from system,
	call iocopn	;OPEN TTY.
	.suset [.rsuppro,,a]	   ;check, are we a HACTRN?
	sosn a			   ;is it -1? (top level)
	  .suset [.sxjname,,[sixbit /HACTRN/]]
	SETOM TTNRST	;TELL %RESET NOT TO FLUSH TTY INPUT.
	CALL %RESET	;INIT MANY THINGS.

	syscal open,[%climm,,fdrc ? [sixbit /DSK/]  ;is .TEMP.; there?
				    [sixbit /.FILE./]
				    [sixbit /(DIR)/]
				    [sixbit /.TEMP./]]
	  jrst [move d,[sixbit /COMMON/]  ;  not there,
	        movem d,cladir	   ;	     so hack COMMON instead for SENDS
		jrst .+2]
	.close fdrc,

	skipn pwordp	;unless we've been started by PWORD
	  CALL FORMF    ;  CLEAR SCREEN IF DISPLAY CONSOLE

	MOVE D,[SQUOZE 0,SLOADU]
	.EVAL D,
	 SETZ D,
	MOVEM D,SLOADU	;GET ADDR OF SLOADU FROM SYSTEM.
	tscall  sstatb		   ;get the machine name and other info.
	MOVSI I1,-2	;DO WHAT FOLLOWS FOR STBSO, THEN STBSF.
DDT1:	MOVE D,[SQUOZE 0,SYSYMB ? SQUOZE 0,SYSUSB](I1)
	.EVAL D,	;GET ABS. ADDR OF START OF TABLE,
	 ERLOSS
	MOVE C,[SQUOZE 0,SYSYME ? SQUOZE 0,SYSUSE](I1)
	.EVAL C,	;GET ADDR OF LAST WD.
	 ERLOSS
	SUBM D,C	;1-LENGTH OF TABLE.
	HRLI D,-1(C)	;AOBJN -> TABLE.
	MOVEM D,STBSO(I1)
	AOBJN I1,DDT1
	MOVE A,STBSO	;THE ORDINARY SYMS COME FIRST.
	LDB D,[121000,,A] ;GET # OF ABS PAGE THE START IN.
	MOVE C,[-NUSPGS,,STBSPG] ;GET THAT PAGE & NEXT INTO STBSPG AND NEXT.
	SYSCLE CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? C ? %CLIMM,,%JSABS ? D]
	MOVEI D,STBSPG
	DPB D,[121000,,A] ;A HAS ADDR IN DDT'S ADDR. SPACE.
	SUBM A,STBSO	;STBSO HAS AMT TO RELOCATE BY.
	EXCH A,STBSO
	ADDB A,STBSF	;RELOCATE STBSF AS WELL.
	HLRE W1,STBSF
	SUB A,W1	;WHERE DOES THAT SYMTAB END?
	ANDI A,-1
	CAIL A,2000*<NUSPGS+STBSPG>
	 ERLOSS		;TOO FEW PAGES RESERVED FOR IT.
	MOVEI W1,GSCHRA	;MAKE INITIAL AMOUNT OF SPACE IN RUBOUT-PROCESSING BUFFER.
	MOVSI A,-10.
	CALL HOLE0
	skipe pwordp		   ;is this started by PWORD?
	  jrst ddt3		   ;  yes, don't print startup stuff
	PUSHJ P,KVERS1	;PRINT VERSION NOS., THEN SYSTEM STATUS.
	PUSHJ P,KSSTA1
	PUSHJ P,CRF
	.RDATE A,
	AOSN A
	 7TYPE NODATE
	MOVE A,LOGDIN
	AOJN A,DDT3	;LOGGED IN, DO INIT FILE INSTEAD SYSTEM MAIL.
	syscal STLGET,[%climm,,tyic ? %clout,,a]  ;is it a STY?
	  jrst ddt1a		   ;   No, go print the system mail
	came a,[sixbit /SUPSER/]   ; Is he coming in over the network?
	  camn a,[sixbit /TELSER/]
	    caia
	      jrst dd1b		   ;   No, so don't repeat these messages
ddt1a:	PUSHJ P,FDRCOP
	[SIXBIT /SYS   SYSTEMMAIL/]	;SEE IF THERE IS ANY SYSTEM MAIL
	 CAIA
	PUSHJ P,CTLF1	;YES, TYPE IT OUT
	call terpri	;make sure we got a newline
	MOVE A,TTYTYP
	TRNE A,2^5	;NOT PSEUDO-TTY =>
	 JRST DD1B
	PUSHJ P,FDRCOP	;PRINT LOCAL MAIL ALSO.
	[SIXBIT /SYS   LOCAL MAIL/]
	 CAIA
	PUSHJ P,CTLF1
	call terpri	;make sure we got a newline
	JRST DD1B

DDT3:	skipe pwordp		   ;are we logged in by PWORD logger?
	  jrst ddt3.0		   ;  yes, don't reset flags
	SETZM CLOBRF
	SETZM MORWARN
ddt3.0:	MOVEI A,DD1B
	MOVEM A,ERRSTL	;(IN CASE GET ERROR, ETC)
	CALL KINTAC
	 JRST DD1B
	skipn initp		   ;run an init?
	  jrst [xct prompt
		jrst dd1b]

	MOVE C,[SIXBIT /LOGIN/]
	CALL KINTE2	;TRY TO OPEN INIT FILE ON FDRC.
	 JRST [skipe pwordp	   ;  No INIT file, did we just log in?
	         call klogi7	   ;    yes, so try to read our mail
	       jrst DD1B]	   ;  on with the world
	skipe pwordp		   ;Are we logged in by PWORD logger?
	  jrst ddt3.3		   ;  yes, don't ask, run the init
	7TYPE [ASCIZ/--Init--/]
	CALL MORFL1	;READ CHAR FROM TTY, SKIP IF SPACE.
	 JRST [	.CLOSE FDRC, ? JRST DD1A]	;NOT SPACE. "FLUSHED" WAS ALREADY TYPED.
ddt3.3:	CALL XFILE1	;GO PUSH INTO INIT FILE.
	JRST DD1B

PURIF1:	.VALUE [ASCIZ \B ..BTAD/0
P\]
	JSP W1,PURIF3	;GET SYS SYM TAB ABS PAGES.
	MOVEI A,MINPUR+MINPUR_9+400000
PURIF2:	.CBLK A,	;PURIFY DDT
	.VALUE
	ADDI A,1001
	CAIE A,400000+NPUR_9+NPUR
	JRST PURIF2
	SETZM DEBUGP
	.VALUE [ASCIZ/:Purified
/]
	JRST DDT

; init of BADBTS and OIPBIT moved to DDT2
PURIF3:	MOVE A,[1000,,400375+SYSSYM_-1]
PURIF4:	.CBLK A,	;INSERT SYS SYM TAB AS ABS PGS
	 .VALUE
	SUBI A,1001
	LDB B,[1000,,A]
	LDB C,[121000,,SYSSYM+1776]
	CAMGE B,C
	  TRZ A,400000	;DELETE THOSE PGS NOT NEEDED.
ifn limpur-2000, trne a,376000	;don't delete page 1 or 0
ife limpur-2000, trne a,377000	;don't delete page 0
	  JRST PURIF4
	CAIGE C,SYSSMP
	 .VALUE
	SUBI C,1
	MOVEM C,SYSSML
	.VALUE [ASCIZ /STBDDT  P/]	;STORE SYMTAB IN DDT.

;	LDB A,[121000,,STBDDT]	;SEE WHAT PAGE SYMS START IN.
;	CAIGE A,STBDE/2000-NDSPGS
;	 .VALUE
;	HRLOI B,NDSPGS-STBDE/2000-1(A)
;	EQVI B,STBDE/2000-NDSPGS	;AOBJN -> PAGES NOT USED.
;	SYSCAL CORBLK,[%CLIMM,, ? %CLIMM,,%JSELF ? B]
;	 .VALUE
;	HRLI A,-STBDE/2000(A)
;	SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A]
;	 .VALUE		; ^ PURIFY THE ONES USED.

;;; No, it is better to just purify the pages of zeros for the benefit of
;;; people like DCP who define a lot of new symbols in their init files:
	move a,[-ndspgs,,stbde/2000-ndspgs]
	syscall corblk,[movei %cbred ? movei %jself ? a]
	 .value

	SETOM SYSSTB
	JRST (W1)

;IF WE NOW NEED MORE SYS SYM TAB ABS PAGES THAN WE DID WHEN WE WERE PURIFIED,
;GET THE EXTRA ONES. SYSSML CONTAINS THE NUMBER OF THE PAGE BELOW THE LOWEST
;SYS SYM TAB PAGE WE ALREADY HAVE.
PURIF5:	LDB A,[121000,,SYSSYM+1776]
PURIF6:	MOVEI B,SYSSYM_-10.-375(A)
	CAMLE A,SYSSML
	 RET
	CAIGE B,SYSSMP	;ABOUT TO CLOBBER THE LOW IMPURE?
	 ERLOSS
	SYSCAL CORBLK,[	%CLIMM,,%CBRED
			%CLIMM,,%JSELF
			%CLIMM,,(B)
			%CLIMM,,%JSABS
			%CLIMM,,(A)]
	 ERLOSS
	AOJA A,PURIF6

CONSTA
INFORM [Top of PURIFY]\.-1
PURIFH::
PURIFT==2000+<.&-2000>

END DDT
