;;; -*-Midas-*-

TITLE DSKDMP

.MLLIT==1

DEFINE SETF TEXT,FLG
IFDEF FLG,.STOP
.TAG FOOBAR 
PRINTC "TEXT
FLG="
.TTYMAC FLAG
.TTYFLG==.TTYFLG+1
PRINTX/FLAG
/
.TTYFLG==.TTYFLG-1
IFSE FLAG,YES,FLG==1
IFSE FLAG,NO,FLG==0
IFSE FLAG,Y,FLG==1
IFSE FLAG,N,FLG==0
IFNDEF FLG,FLG==FLAG
TERMIN
IFNDEF FLG,.GO FOOBAR
TERMIN

IF1,[
PRINTC "Configuration (KSRP06, KSRP07, KSRM03, KSRM80 or ASK) ? " 
.TTYMAC MACH
IFSE MACH,KSRP06,[
	HRIFLG==0
	RP06P==1
	KS10P==1
	NUDSL==500.
] ;KSRP06
IFSE MACH,KSRP07,[
	HRIFLG==0
	RP06P==0
	RP07P==1
	KS10P==1
	NUDSL==500.
] ;KSRP07
IFSE MACH,KSRM03,[
	HRIFLG==0
	RP06P==0
	RP07P==0
	RM03P==1
	KS10P==1
	NUDSL==500.
] ;KSRM03
IFSE MACH,KSRM80,[
	HRIFLG==0
	RP06P==0
	RP07P==0
	RM03P==0
	RM80P==1
	KS10P==1
	NUDSL==500.
] ;KSRM80
IFSN MACH,ASK,[
IFNDEF NUDSL,[ PRINTC /No known configuration for "MACH".
/ ]]
TERMIN
] ;IF1

SETF [Readin Mode Paper Tape?]HRIFLG
SETF [Assemble BOOT? (If no, full DSKDMP)]BOOTSW

SETF [RH11/RP06 disk system?]RP06P
IFE RP06P,[
SETF [RH11/RP07 disk system?]RP07P
IFE RP07P,[
SETF [RH11/RM03 disk system?]RM03P
IFE RM03P,[
SETF [RH11/RM80 disk system?]RM80P
IFE RM80P,[
SETF [RH10 (MC-KL) disk control?]RH10P
IFE RH10P,[
SETF [AIKA disk control? (no => RP02/RP03)]DC10P
]]]]]
IFN RP06P, RP07P==0
IFN RP06P+RP07P, RM03P==0
IFN RP06P+RP07P+RM03P, RM80P==0
IFN RP06P+RP07P+RM03P+RM80P, RH10P==0
IFN RP06P+RP07P+RM03P+RM80P+RH10P, DC10P==0
IFN RP06P+RP07P+RM03P+RM80P+RH10P+DC10P, RP10P==0
IFE RP06P+RP07P+RM03P+RM80P+RH10P+DC10P, RP10P==1

IFE BOOTSW, SETF [Number of dirs? (DM-KA: 200., ML-KA: 250., AI-KA: 440., all others: 500.)]NUDSL

SETF [KS10 processor?]KS10P
IFE KS10P, SETF [KL10 processor? (no => KA10)]KL10P
IFN KS10P, KL10P==0
IFN KS10P+KL10P, KA10P==0
IFE KS10P+KL10P, KA10P==1

RH11P==:RP06P+RP07P+RM03P+RM80P

DEFINE RP
IFN RP10P!TERMIN
DEFINE SC
IFN DC10P!TERMIN
DEFINE RH
IFN RH10P!TERMIN
DEFINE PH
IFN RH11P!TERMIN

DEFINE KA
IFN KA10P!TERMIN
DEFINE KL
IFN KL10P!TERMIN
DEFINE KS
IFN KS10P!TERMIN

IFN HRIFLG,[
NOSYMS			;MAKE PAPER TAPE SHORTER
RIM10
]

C=1			;C-A-B FOR LINKS
A=2
B=3
D=4
BLKIN=5			;PSEUDO-CORE BLOCK IN CBUF
WRITE=6			;NEG MEANS DUMP, RH 0 OR WRBIT
DIFF=7			;DIFF CONO ALSO TEMP
HEAD=10			;HEAD CONO ALSO TEMP
P=11			;JSP AC
BLOK=12
UNIT=13			;UNIT AND M.A. DATAO
CMD=14			;COMMAND CHAR
T=15			;VERY TEMP
TT=16			;ANOTHER JSP AC, ALSO VERY TEMP
BUFP=17			;DBUF PNTR--LAST WORD USED

IF1,[			;DON'T TAKE A WEEK AND A HALF TO ASSEMBLE.
RP, .INSRT SYSTEM;RP10 >
SC, .INSRT SYSTEM;DC10 >
RH, .INSRT SYSTEM;RH10 >
PH, .INSRT SYSTEM;RH11 >
IFN RP06P, .INSRT SYSTEM;RP06 >
IFN RP07P, .INSRT SYSTEM;RP07 >
IFN RM03P, .INSRT SYSTEM;RM03 >
IFN RM80P, .INSRT SYSTEM;RM80 >
IFE BOOTSW, .INSRT SYSTEM;FSDEFS >
IFE BOOTSW, KL,	.INSRT SYSTEM;EPT >
KS, .INSRT SYSTEM;KSDEFS >
KA, TTY==120
]

;PARAMETER FILE FOR DSKDMP

MEMSIZ=1000000 		;ACTUAL SIZE OF MEM
IFNDEF DBGSW,DBGSW==0	;1 TO DEBUG THIS WITH DDT
DDT==MEMSIZ-4000
IFN DBGSW,MEMSIZ==MEMSIZ-10000	;MOVE DOWN UNDER DDT IF DEBUG MODE
CORE==MEMSIZ-10000-<2000*NTUTBL>		;HIGHEST ADR ALWAYS IN CORE+1
CORES==CORE_<-12>	;BLK # OF ABOVE (FIRST OF BLKS SWAPPED OUT FOR BUFFER AREAS)
NSWBL==4+NTUTBL		;# BLOCKS SWAPPED OUT FOR BUFFER AREAS, +1 FOR DSKDMP ITSELF
HIGH==MEMSIZ-100	;HIGHEST ADR LOADED/DUMPED+1

NDSK==8			;MAX POSSIBLE.  L$n$ DEFINES WHICH ARE REALLY THERE
RP,ICWA=34
RH,ICWA=34

PH, UBPG==:17		; Use last (usable) page in Unibus map

KA, LPM=102000,,
KA, LPMR=LPM 2,
KL, PAG=<BLKI 10,>-<BLKI>

DEFINE INFORM A,B
IF1,[ PRINTX  A = B
] TERMIN

;COMMANDS ARE:
;   L$file	LOAD FILE INTO CORE
;   T$file	LOAD FILE INTO CORE AND GIVE SYMBOLS TO DDT AND START DDT
;   M$file	LOAD FILE INTO CORE WITHOUT CLEARING CORE FIRST, DOESN'T LOAD SYMBOLS
;   K$file	DELETE FILE
;   D$file	DUMP CORE INTO FILE
;   I$file	VERIFY FILE AGAINST CORE
;   G$		START AT STARTING ADDRESS
;   U$dir;	LIST DIRECTORY
;   F$		LIST CURRENT DIRECTORY
;   S$		LIST PACK IDS THEN MFD
;   nnn$	SET STARTING ADDRESS TO nnn
;   L$n$	PUT DISK n ONLINE
;   K$n$	TAKE DISK n OFFLINE

;ERROR MESSAGES ARE:
;   CMPERR	VERIFY FAILED TO MATCH
;   DIRFUL	DIRECTORY FULL
;   EOF		UNEXPECTED EOF
;   DIRNF	DIRECTORY DOES NOT EXIST
;   FNF		FILE NOT FOUND
;   PKNMTD	FILE IS ON PACK THAT IS NOT MOUNTED
;   CKSERR	CHECKSUM ERROR
;   DSKFUL	DISK FULL
;   NODDT	CAN'T ADDRESS DDT SYMBOL TABLE (BUG)
;   ?BUG?	BUG
;   SEEKFL	DISK SEEK ERROR
;   CLOBRD	DISK READ ERROR
;   CLOBWR	DISK WRITE ERROR
;   DIRCLB	DIR NAME DIFFERS, TUT DISAGREES WITH DIR
;   MFDCLB	M.F.D. CLOBBERED
;   DSKLUZ	DISK LOSSAGE (OFFLINE OR UNSAFE OR MASSBUS ERROR)

KS,	LOC 4000		; Avoid MTBOOT and KSRIM

IFE BOOTSW,[
ZZZ:	IFE DBGSW,[
	MOVE T,....		;THIS CODE BLTS THE FOLLOWING OFFSET CODE
	BLT T,MEMSIZ-1-1	;INTO HIGH MEMORY AND WRITES DSKDMP ON ITS
	MOVE T,PROG+MEMSIZ-2-BEG+1
	MOVEM T,BEG+MEMSIZ-2-BEG+1	;AVOID LOSING DUE TO -1 BLT LOSSAGE
]
	MOVSI T,-NDSK+1		;MAKE ALL BUT DISK 0 BE DEAD (MUST DO L$ TO MAKE THEM ALIVE)
	SETOM QDED+1(T)
	MOVNS QDED+1(T)
	AOBJN T,.-2
	SETZM QDED+0
RP,[	MOVEI T,ICWA+2		;SET UP CHANNEL JUMP
	MOVEM T,ICWA 		;IN INITIAL CHANNEL ADDRESS
	SETZM ICWA+1 		;AND CLEAR REMAINING STUFF
	SETZM ICWA+3
	DATAO DPC,SUNIT0
	DATAI DPC,B
	TRNN B,RP03BT
	 JRST WBOOT1
	MOVEI B,MBLKS		;UNIT 0 IS AN RP03, ADJUST WORLD
	HRRM B,CBLK
	MOVE B,RP3ADJ
	MOVSI A,-NSWBL
	XORM B,SWPSK(A)
	AOBJN A,.-1
WBOOT1:	HLLZS BOOT0
	MOVEI UNIT,BEG		;MAGIC BLOCK THEN STARTS IT
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL		;FIRST BLOCK AFTER CORE BUFFER IS WHERE DSKDMP LIVES
	MOVEI WRITE,10
	JSP TT,WRD3
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL+1
	MOVEI WRITE,10
	JSP TT,WRD3
	CONSZ DPC,ALLER
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,. 		;FORMERLY JRST MEMSIZ-400 (??)
	JRST BEG
];RP
PH,[	MOVEI T,%HYCLR		; Clear controller
	IOWRQ T,%HRCS2		; (Selects drive 0)
WBOOT0:	IORDQ T,%HRCS1
	TRNN T,%HXDVA
	 JRST WBOOT0		; Await drive available (well, it is a dual
				; ported drive...  perhaps someday?)
	MOVEI UNIT,BEG
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL		; FIRST BLOCK AFTER CORE BUFFER IS WHERE
				; DSKDMP LIVES
	MOVEI WRITE,10
	JSP TT,WRD3
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL+1
	MOVEI WRITE,10
	JSP TT,WRD3
	IORDQ TT,%HRCS1
	TRNE TT,%HXTRE+%HXMCP
IFN DBGSW, JRST DDT
IFE DBGSW, JRST 4,. 		; Formerly JRST MEMSIZ-400 (??)
	JRST BEG
];PH
RH,[	MOVEI T,ICWA+2		;SET UP CHANNEL JUMP
	MOVEM T,ICWA 		;IN INITIAL CHANNEL ADDRESS
	SETZM ICWA+1 		;AND CLEAR REMAINING STUFF
	SETZM ICWA+3
WBOOT0:	DATAO DSK,[%HRDCL,,]
	MOVEI A,20
	SOJG A,.
	DATAI DSK,A
	TRNN A,%HCDVA
	 JRST WBOOT0		;AWAIT DRIVE AVAILABLE
	MOVEI UNIT,BEG		;MAGIC BLOCK THEN STARTS IT
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL		;FIRST BLOCK AFTER CORE BUFFER IS WHERE DSKDMP LIVES
	MOVEI WRITE,10
	JSP TT,WRD3
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL+1
	MOVEI WRITE,10
	JSP TT,WRD3
	CONSZ DSK,%HIERR
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,. 		;FORMERLY JRST MEMSIZ-400 (??)
	JRST BEG
];RP
SC,[	MOVEI UNIT,BEG		;MAGIC BLOCK THEN STARTS IT
	MOVEI BLOK,NBLKS+NSWBL
	MOVEI WRITE,60
	JSP TT,WRD3
	MOVEI BLOK,NBLKS+NSWBL+1
	MOVEI WRITE,60
	JSP TT,WRD3
	DATAO DC0,.....
	CONSZ DC0,DSSACT
	JRST .-1
	CONSZ DC0,DSSERR
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,. 		;FORMERLY JRST MEMSIZ-400 (??)
	JRST BEG

.....:	DJMP .+1
	DWRITE
	DCOPY ......(-LRIBLK_2&37774)
	DHLT

......:	DWRITE+DUNENB+DADR		;FOR READIN
	DCOPY BEG(-2000_2&37774)
	DREAD+DADR1
	DCOPY BEG(-2000_2&37774)
	DHLT
];SC

IFE DBGSW,[
....:	PROG,,BEG

KA,	LOC 2000		; MAKE OFFSET CONVENIENT
KL,	LOC 2000
KS,	LOC 6000		; Avoid MTBOOT and KSRIM
PROG:	OFFSET CORE+<<NSWBL-1>*2000>-.
]IFN DBGSW,LOC MEMSIZ-2000

BEG:
KA,[	CONO 635550 		;ENTER HERE, CLEAR WORLD
	JRST .+1
	JFCL 1,[JRST 4,.]	;A PDP6??
	LPMR [0]-2 		;TURN OFF EXEC PAGING
]
KL,[	CONO 327740		;CLEAR APR
	CONSZ PAG,660000	;PAGING AND CACHE BETTER BE OFF
	 JRST 4,.
]
KS,[	CONO 127760		; Enable, and Clear all.
	RDEBR B
	TRNE B,60000		; Paging and Tops-20 better be off.
	 JRST 4,.
	SETZM 8SWIT0		; Clear 8080 Communications area to prevent
	MOVE B,[8SWIT0,,8SWIT0+1]	; mysterious IO behavior.
	BLT B,8RHBAS-1
	;; If the machine has just been powered on, there is likely to be
	;; bad parity all over the place.  I guess that isn't our problem
	;; as long as we don't touch any of it...
]
	MOVSI B,-NDSK 		;FOR NUMBER OF DISKS
	SETOM PKNUM(B)		;SET DISK TO UNKNOWN
	AOBJN B,.-1
	MOVE T,[JRST LOADG1]	;SET BOOTSTRAP TO MIDDLE OF WORLD
	MOVEM T,BOOT
	MOVE D,['DSKDMP]	;ANNOUNCE SELF
	JSP TT,PD
	JRST READ		;CRLF AND BEGIN READING COMMANDS

ERROR:	0
	CLEARM MEMSIZ-1 	;DON'T READ ANY MORE COMMANDS FROM MEMORY
	SOS T,ERROR 		;PICK UP ERROR CODE FROM THE AC FIELD OF
	LDB T,[270400+T,,]	;THE JSR ERROR
	MOVE D,ERMESS(T)
	JSP TT,PD 		;PRINT OUT APPROPRIATE COMMENT
	CAIL T,EBUG
	 JRST READ 		;BAD ERROR - NO MORE DISKING
LOADG1:
KA,	DATAI TTY,C 		;FLUSH RANDOM CHARACTER
KS,	SETZM 8CTYIN		; ".RESET"
	TRO CMD,10 		;MAKE SURE PSEUDO-CORE IN CORE
	JRST LOADG 		;BY SIMULATING END OF LOADING, NON-GOING COMMAND

ERMESS:	IRP XX,,[ECMP,EDIR,EEOF,ESNF,EFNF,EPNM,ECKS
EDSK,EDDT,EBUG,EC63,ECRD,ECWR,ECDR,EMFC,EDLZ]YY,,[CMPERR,DIRFUL
EOF,DIRNF,FNF,PKNMTD,CKSERR,DSKFUL,NODDT,?BUG?,SEEKFL
CLOBRD,CLOBWR,DIRCLB,MFDCLB,DSKLUZ]
XX==.-ERMESS
	SIXBIT \YY\
TERMIN

PD:	JSP P,CRLF 		;TYPE A CR
PD2:	MOVEI C,40
	JSP P,TYO 		;AND A SPACE
	MOVE B,[440600,,D]
PD1:	ILDB C,B 		;AND THE SIXBIT CONTENTS OF D
	ADDI C,40
	JSP P,TYO
	TLNE B,770000
	 JRST PD1
	JRST (TT)

PNO:
C12:	IDIVI C,10. 		;PRINT CONTENTS OF C AS A TWO-DIGIT
	DPB C,[60600,,A]	;DECIMAL NUMBER PRECEDED
	MOVEI D,(SIXBIT /#00/+A) ;BY <SPACE>#
	MOVE B,[300600,,D]
	JRST PD1

WRCB:	MOVEI UNIT,CBUF		;WRITE OUT CONTENTS OF CBUF
	LSH BLKIN,-12		;ON APPROPRIATE BLOCK
	HRRZ BLOK,CBLK
	ADDI BLOK,-CORES(BLKIN)
	JRST WRM

LODUMP:	MOVEI UNIT,CORE		;DEPENDING ON SIGN BIT OF WRITE, LOAD OR DUMP
	HRRZ BLOK,CBLK		;PSEUDO-CORE (766000-775777)
LODMP1:	JSP TT,WRDM
	ADDI UNIT,2000
	CAIGE UNIT,BEG
	 AOJA BLOK,LODMP1
	MOVEI BLKIN,CORE
	JRST (P)

FD:	HRRZ C,B 		;SET UP POINTER IN C TO FETCH OR DEPOSIT
	  			;CONTENTS OF ADDRESS IN RIGHT HALF OF B
IFN DBGSW, SKIPGE WRITE		;LOAD DDT WHEN IN DEBUG MODE
	CAIGE C,HIGH
	CAIGE C,40
	 JRST (P)
	CAIGE C,CORE 		;IF ADDR IS IN REAL CORE, RETURN IMMEDIATELY
	 JRST 1(P)
FDX:	CAIL C,(BLKIN)		;ADDR IS IN PSEUDO-CORE--CHECK IF RIGHT
	CAILE C,1777(BLKIN)	;BLOCK IS IN CBUF
	 JRST FD3 		;IT'S NOT THERE--READ IT IN
FD4:	SUBI C,-CORE(BLKIN)	;IT'S THERE--SET UP RIGHT POINTER IN C
	JRST 1(P) 		;AND RETURN
FD3:	JUMPLE WRITE,FD3A	;IF DUMP OR VERIFY DON'T BOTHER
	  			;TO WRITE OUT CURRENT BLOCK
FD3B:	JSP TT,WRCB 		;IF LOAD, WRITE CURRENT BLOCK FIRST
FD3A:	MOVEI UNIT,CBUF
	MOVE BLKIN,C
	ANDI BLKIN,776000
	LDB BLOK,[121000,,BLKIN]
	ADD BLOK,CBLK
	MOVEI BLOK,-CORES(BLOK)
	JSP TT,RDM 		;READ IN CORRECT BLOCK
	JRST FD4 		;SET UP POINTER AND RETURN

GBP:	IDIVI C,6 		;TURN USER DIRECTORY CHARACTER ADDR IN C
	IMULI A,-60000		;INTO A BYTE POINTER
	HRLI C,440600(A)
	ADDI C,DIR+UDDESC
	JRST (TT)

WD:	AOBJN BUFP,WD1		;READ, WRITE, OR VERIFY WORD IN D FROM, INTO,
	JSP TT,NXTBLK		;OR AGAINST WORD IN DBUF
	JSP TT,WRDB 		;TIME TO REFILL OR EMPTY DBUF
	MOVSI BUFP,-2000	;RESET BUFFER POINTER
WD1:	JUMPG WRITE,WD2		;JUMP ON LOAD
	JUMPL WRITE,WD3		;JUMP ON WRITE
	CAME D,DBUF(BUFP)	;HERE IF VERIFY
	 JSR ECMP,ERROR		;VERIFY COMPARE LOST
	JRST (P)
WD2:	SKIPA D,DBUF(BUFP)	;LOAD
WD3:	 MOVEM D,DBUF(BUFP)	;DUMP
	JRST (P)

NXTTUT:	HRRZ B,CU 		;SELECT NEXT UNIT AND READ ITS TUT
	AOJ B,
	CAIN B,NDSK
	 MOVEI B,0
	HRRM B,CU
	CAIN B,@MU
	 JRST 1(TT) 		;SKIP IF NO MORE
	SKIPE QDED(B)
	 JRST NXTTUT 		;UNIT NOT ON LINE
RDTUT:	MOVEI BLOK,TUTBLK	;READ TUT OF CURRENT UNIT
	MOVEI UNIT,TUT
	SETOM PKNUM(B)		;ALWAYS READ HEADER FOR TUT
IFG NTUTBL-1,[			;READ IN MULTI-BLOCK TUT
	HRRM TT,RDTUTX		;SAVE RETURN ADDRESS
REPEAT NTUTBL-1,[
	JSP TT,RD
	ADDI UNIT,2000
	AOS BLOK
]
RDTUTX:	MOVEI TT,.
]
	JRST RD

NXTBW3:	0
	IBP DIRPT 		;DO AN IDPB T,DIRPT CHECKING TO SEE IF
	LDB DIFF,[1200,,DIRPT]	;RUNNING INTO NAME AREA
	CAML DIFF,DIR+UDNAMP
	 JSR EDIR,ERROR
	DPB T,DIRPT
	JRST @NXTBW3

NXTBW:	MOVE BLOK,LBLOCK	;FIND NEXT FREE BLOCK TO WRITE
	MOVEI HEAD,1(BLOK)
	ILDB T,TUTPT
	JUMPN T,NXTBW1		;JUMP IF VERY NEXT BLOCK NOT FREE
	AOSG T,BLKCNT
NXTBW5:	 SOJA HEAD,NXTBW4	;GENERATE LOAD ADR IF FIRST TIME (COMPENSATE FOR LBLOCK OFF BY 1)
	CAIG T,UDTKMX-1
	 JRST NXTBW2 		;NO NEED TO MODIFY DIRECTORY YET
	CLEARM BLKCNT 		;14 IN A ROW--RESET COUNTER AND
NXTBW6:	JSR NXTBW3 		;DPB BYTE INTO DIRECTORY
NXTBW2:	MOVE BLOK,HEAD
	CAML BLOK,TUT+QLASTB
	 JSR EDSK,ERROR		;NO MORE DISK LEFT
	MOVEI T,1
	DPB T,TUTPT 		;MARK BLOCK USED IN TUT
	JRST WRDB1

NXTBW1:	ADDI HEAD,1 		;SEARCH FOR NEXT FREE BLOCK
	ILDB T,TUTPT
	JUMPN T,NXTBW1
	SUBM HEAD,BLOK
	SKIPLE T,BLKCNT		;COME UP WITH DESC BYTE FOR LAST FEW BLOCKS
	 JSR NXTBW3
	CLEARM BLKCNT
	JUMPL T,NXTBW5		;FIRST TIME
	MOVEI T,UDTKMX-1(BLOK)
	CAIGE T,UDWPH 		;CAN WE SAY SKIP N--TAKE 1?
	 JRST NXTBW6 		;YES
NXTBW4:	MOVEI BLOK,NXLBYT
	MOVE T,HEAD
	ROT T,-NXLBYT*6
	ADDI T,UDWPH+1
	JSR NXTBW3
	ROT T,6
	SOJG BLOK,.-2
	JRST NXTBW6

NXTBLK:	JUMPL WRITE,NXTBW	;GET NEXT BLOCK OF FILE--IF DUMP, FIND FREE
	MOVE BLOK,LBLOCK	;BLOCK
NXTB6:	SOSLE BLKCNT 		;HAVE WE RUN OUT OF "TAKE N"?
	 AOJA BLOK,WRDB1	;NO--TAKE NEXT BLOCK
	ILDB T,DIRPT 		;YES--GET NEXT DESC BYTE
	CAILE T,UDWPH
	 JRST NXTB1 		;IT'S A LOAD ADDR
	CAIE T,UDWPH
	 JUMPN T,NXTB2 		;IT'S A TAKE OR SKIP
	CAIE CMD,'D 		;IT'S 0 OR NULL--IF THIS IS A LOAD, IT'S AN
	CAIN CMD,'K 		;UNEXPECTED END OF FILE
	 JRST KILL1 		;IF DUMP OR KILL, O.K.
	JSR EEOF,ERROR

NXTB1:	MOVEI BLOK,-UDWPH-1(T)  ;LOAD ADR
	MOVEI BUFP,NXLBYTS
NXTB1A:	MOVEI T,0
	CAIE CMD,'D
	CAIN CMD,'K
	 DPB T,DIRPT 		;IF KILLING FILE, ZERO THIS BYTE (OTHERS ZEROED AT KILL)
	LSH BLOK,6
	ILDB T,DIRPT
	ADD BLOK,T 		;GET COMPLETE BLOCK NUMBER
	SOJG BUFP,NXTB1A
	JRST NXTB3

NXTB2:	MOVEM T,BLKCNT
	CAIG T,UDTKMX
	 AOJA BLOK,WRDB1	;TAKE N STARTING WITH NEXT ONE
	ADDI BLOK,-UDTKMX+1(T)	;SKIP N-<MAX TAKE> AND TAKE 1
NXTB3:	CLEARM BLKCNT
WRDB1:	MOVEM BLOK,LBLOCK
	JRST (TT)
;RP10 IO ROUTINE
RP,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,10		;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,10		;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	DPB WRITE,[360600,,DBLK]	;SET OP, UNIT SEL
	DPB WRITE,[DUNFLD SEEK]
	DPB WRITE,[DUNFLD RECAL]
	HRLI UNIT,-2000		;ADDRESS COMES IN IN `UNIT'
	MOVEM UNIT,@ICWA
	SOS @ICWA
	LDB UNIT,[300,,WRITE]	;ISOLATE FROM GARBAGE
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	HRRZ DIFF,BLOK
	IMULI DIFF,SECBLK
	IDIVI DIFF,NSECS
	DPB HEAD,[DSECT DBLK]
	IDIVI DIFF,NHEDS
	DPB HEAD,[DSURF DBLK]
	DPB DIFF,[DCYL DBLK]
	DPB DIFF,[DCYL SEEK]
	DATAO DPC,CLATT		;CLEAR ATTENTIONS
	LSH DIFF,-8		;EXTRA CYLINDER BIT FOR RP03
	DPB DIFF,[DCYLXB DBLK]
	DPB DIFF,[DCYLXB SEEK]
	DATAO DPC,SEEK
	DATAI DPC,DIFF
	TRNN DIFF,ALLATT
	 JRST .-2
	DATAO DPC,CLATT
	TLNN DIFF,(ONCYL)
	 JRST WRD0
	DATAO DPC,DBLK
	CONSO DPC,DONE
	 JRST .-1
	CONSO DPC,ALLER
	 JRST WRDX
	HRRZM BLOK,BADBLK
	AOSG ERRCT		;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD5		;TRY AGAIN
	TRNE WRITE,10		;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR		;WRITE ERRORS AND
	JSR ECRD,ERROR		;READ ERRORS

WRDX:	HRRZ UNIT,@ICWA		;RESTORE ADDR
	ADDI UNIT,1 		;COMPENSATE FOR IOWD LOSSAGE
	TRZ WRITE,-1		;FLUSH GARBAGE
	JRST (TT)

WRD0:	AOSLE ERRCT
	 JSR EC63,ERROR
	DATAO DPC,RECAL
	DATAI DPC,DIFF
	TRNN DIFF,ALLATT
	 JRST .-2
	JRST WRD5

DBLK:	ICWA
SEEK:	DSEEKC
RECAL:	DRCALC
CLATT:	DEASEC ALLATT
];RP
;RH11 IO ROUTINE
PH,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,10		;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,10		;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	TRNE UNIT,1777		; Better be on a page boundary!
	 JRST 4,.
	LDB DIFF,[111100,,UNIT]	; Point Unibus map at page in question
	TRO DIFF,%UQFST+%UQVAL
	IOWRQ DIFF,UBAPAG+UBPG_1
	ADDI DIFF,1
	IOWRQ DIFF,UBAPAG+UBPG_1+1
	LDB DIFF,[000300,,WRITE]	; Select drive
	IOWRQ DIFF,%HRCS2
	JSP HEAD,RHCHEK		; Check for immediate trouble
	MOVEI DIFF,%HMRDP	; Init the drive
	IOWRQ DIFF,%HRCS1
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	MOVNI DIFF,4000
	IOWRQ DIFF,%HRWC	; 4000 half words
	MOVEI DIFF,UBPG_14
	IOWRQ DIFF,%HRBA	; "Byte" base address
	HRRZ DIFF,BLOK
	IDIVI DIFF,NBLKSC
	IOWRQ DIFF,%HRCYL	; Desire cylinder
	MOVE DIFF,HEAD
	IMULI DIFF,SECBLK
	IDIVI DIFF,NSECS
	DPB DIFF,[$HATRK HEAD]
	IOWRQ HEAD,%HRADR	; Desire track and sector
	MOVEI DIFF,%HMRED
	TRNE WRITE,10
	 MOVEI DIFF,%HMWRT
	IOWRQ DIFF,%HRCS1	; Do it (implied seek)
WRD7:	IORDQ DIFF,%HRCS1
	TRNN DIFF,%HXRDY	; Wait for controller to finish
	 JRST WRD7
	TRNN DIFF,%HXTRE+%HXMCP	; Trouble?
	 JRST WRDX		; Nope, exit
	HRRZM BLOK,BADBLK
	AOSG ERRCT		;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD0		;RECALIBRATE AND TRY AGAIN
	TRNE WRITE,10		;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR		;WRITE ERRORS AND
	JSR ECRD,ERROR		;READ ERRORS

WRDX:	TRZ WRITE,-1		;FLUSH GARBAGE
	JRST (TT)

WRD0:	MOVEI DIFF,%HYCLR	; Clear controller
	IOWRQ DIFF,%HRCS2
	LDB DIFF,[000300,,WRITE]	; Select drive
	IOWRQ DIFF,%HRCS2
	MOVEI DIFF,%HMCLR	; Clear drive
	IOWRQ DIFF,%HRCS1
	JSP HEAD,RHCHEK		; Immediate lossage?
	MOVEI DIFF,%HMREC	; Recalibrate
	IOWRQ DIFF,%HRCS1
	MOVEI HEAD,100000.
WRD0A:	SOSGE HEAD
	 JSR EC63,ERROR
	IORDQ DIFF,%HRSTS
	TRNE DIFF,%HSPIP	; WAIT FOR DRIVE TO FINISH
	 JRST WRD0A
	ANDI DIFF,%HSDPR+%HSMOL+%HSVV+%HSRDY+%HSERR
	CAIE DIFF,%HSDPR+%HSMOL+%HSVV+%HSRDY
	 JSR EDLZ,ERROR
	JRST WRD5

;;; JSP HEAD,RHCHEK to check for errors.
RHCHEK:	IORDQ DIFF,%HRCS1
	TRNE DIFF,%HXTRE+%HXMCP
	 JSR EDLZ,ERROR
	JRST (HEAD)
];PH
;RH10 IO ROUTINE
RH,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,10		;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,10		;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	HRLI UNIT,-2000		;ADDRESS COMES IN IN `UNIT'
	CONI DSK,HEAD		;SET WORD COUNT TO ONE BLOCK
	TLNE HEAD,(%HID22)	;ACCORDING TO TYPE OF CHANNEL
	 HRLI UNIT,-2000_4
	MOVEM UNIT,@ICWA
	LDB UNIT,[300,,WRITE]	;ISOLATE FROM GARBAGE
	SOS @ICWA		;ADJUST FOR DF10 LOSSAGE
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	MOVSI DIFF,%HRDCL(UNIT)
	HRRI DIFF,%HMRDP	;INIT THE DRIVE
	JSP HEAD,RHSET
	HRRZ DIFF,BLOK
	IDIVI DIFF,NBLKSC
	EXCH DIFF,HEAD
	MOVEM HEAD,DBLK		;SAVE CYLINDER
	IMULI DIFF,SECBLK
	IDIVI DIFF,NSECS
	EXCH DIFF,HEAD
	DPB HEAD,[$HATRK DIFF]
	TLO DIFF,%HRADR(UNIT)
	JSP HEAD,RHSET
	MOVE DIFF,DBLK
	TLO DIFF,%HRCYL(UNIT)
	JSP HEAD,RHSET
	MOVSI DIFF,%HRCTL(UNIT)
	IORI DIFF,ICWA_6
	TRNE WRITE,10
	 TROA DIFF,%HMWRT
	  TRO DIFF,%HMRED
	JSP HEAD,RHSET		;DO IT (USE IMPLIED SEEK)
	CONSO DSK,%HIDON
	 JRST .-1
	CONSO DSK,%HIERR
	 JRST WRDX
	HRRZM BLOK,BADBLK
	AOSG ERRCT		;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD0		;RECALIBRATE AND TRY AGAIN
	TRNE WRITE,10		;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR		;WRITE ERRORS AND
	JSR ECRD,ERROR		;READ ERRORS

WRDX:	HRRZ UNIT,@ICWA		;RESTORE ADDR
	ADDI UNIT,1 		;COMPENSATE FOR IOWD LOSSAGE
	TRZ WRITE,-1		;FLUSH GARBAGE
	JRST (TT)

WRD0:	MOVSI DIFF,%HRDCL(UNIT)
	HRRI DIFF,%HMCLR
	JSP HEAD,RHSET
	MOVSI DIFF,%HRDCL(UNIT)
	HRRI DIFF,%HMREC
	JSP HEAD,RHSET
	MOVEI DIFF,100000.
	MOVEM DIFF,DBLK
WRD0A:	SOSGE DBLK
	 JSR EC63,ERROR
	MOVSI DIFF,%HRSTS(UNIT)
	JSP HEAD,RHGET
	TRNE DIFF,%HSPIP
	 JRST WRD0A
	ANDI DIFF,%HSVV+%HSRDY+%HSMOL+%HSERR
	CAIE DIFF,%HSVV+%HSRDY+%HSMOL
	 JSR EDLZ,ERROR
	JRST WRD5

;RH10 HACKING ROUTINES. CALL BY JSP HEAD,.  DIFF HAS REGISTER ADDRESS IN LH, DATA IN RH.
RHSET:	TLOA DIFF,%HRLOD
RHGET:	 TLZ DIFF,%HRLOD
	DATAO DSK,DIFF
	MOVEI DIFF,20
	SOJG DIFF,.
	DATAI DSK,DIFF
	TLNE DIFF,%HDERR
	 JSR EDLZ,ERROR
	ANDI DIFF,177777
	JRST (HEAD)

DBLK:	0
];RH
;SC DISK IO ROUTINE
SC,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,60#120	;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,60#120	;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:	TRC WRITE,120
WRD3:	DPB WRITE,[330700,,DBLK]	;SET OP, UNIT SEL
	DPB UNIT,[DCCA DBLK+1]	; & CORE ADDR
	DPB UNIT,[DCCA DBLK1+1]
	LDB UNIT,[400,,WRITE]	;ISOLATE FROM GARBAGE
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	HRRZ DIFF,BLOK
	IDIVI DIFF,NSECS
	DPB HEAD,[DSECT DBLK]
	IDIVI DIFF,NHEDS
	DPB HEAD,[DSURF DBLK]
	DPB DIFF,[DCYL DBLK]
	CONO DC0,DCCSET\DCDENB	;RESET ALL, THEN SET DCDENB
	CAIL DIFF,NCYLS
	 TDZA DIFF,DIFF
	  SKIPLE DIFF,PKNUM(UNIT)
	   JRST WRD4		;PKID IN
	MOVE DIFF,QTRAN(UNIT)	;READ PACK ID
	DPB DIFF,[DUNFLD GPKID]
	MOVEI DIFF,TUTCYL
	SKIPGE QTRAN(UNIT)
	 ADDI DIFF,NCYLS+XCYLS
	DPB DIFF,[DCYL GPKID]
	DATAO DC0,[DJMP GPKID]
	CONSZ DC0,DSSACT
	 JRST .-1
	CONSZ DC0,DSSERR
	 JRST WRD0
	CONO DC0,DCCSET\DCDENB	;RESET POSSIBLE "FUTURE" IP OR RLCERR
	LDB DIFF,[DPKID RPKID]
	MOVEM DIFF,PKNUM(UNIT)
WRD4:	DPB DIFF,[DPKID DBLK]
	MOVE DIFF,DBLK
	DPB DIFF,[3300,,DBLK1]
	MOVE DIFF,QTRAN(UNIT)
	DPB DIFF,[DUNFLD DBLK]
	JUMPGE DIFF,WRD4A
	LDB DIFF,[DCYL DBLK]	;2ND HALF UNIT
	ADDI DIFF,NCYLS+XCYLS
	DPB DIFF,[DCYL DBLK]
WRD4A:	DATAO DC0,[DJMP DBLK]
	CONSZ DC0,DSSACT
	 JRST .-1
	CONSO DC0,DSSERR
	 JRST WRDX	;XFER OK
	MOVE DIFF,ERRCT
	TRNN DIFF,2	;DO RECALIBRATE 2 OUT OF 4 RETRIES
	 JRST WRD2
WRD0:	AOSLE ERRCT	;POSITIONER ERROR--CHECK ERROR COUNT
	 JSR EC63,ERROR	;TOO MANY--GIVE UP
	DATAO DC0,[DSPC+DSRCAL+DSWINF]
	CONSO DC0,DSSATT
	 JRST .-1
	JRST WRD5	;TRY AGAIN AFTER RESETTING UNIT

WRD2:	HRRZM BLOK,BADBLK
	AOSG ERRCT	;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD5	;TRY AGAIN
	TRNE WRITE,40	;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR	;WRITE ERRORS AND
	JSR ECRD,ERROR	;READ ERRORS

WRDX:	DPB BLOK,[XWBLK XWDS]	;PNTR TO PREV BLOCK
	LDB UNIT,[DCCA DBLK+1]	;RESTORE ADR
	TRZ WRITE,-1	;FLUSH GARBAGE
	JRST (TT)

DBLK:	DREAD+DUNENB
	DCOPY .(-2000_2&37774)
	DCOPY XWDS(-4_2&37774)
DBLK1:	DRC
	DCOPY .(-2000_2&37774)
	DCOPY XWDS(-4_2&37774)
	DHLT

GPKID:	DSPC+DSCRHD+DSWIDX+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
	DCOPY RPKID(37774)
	DHLT
];SC

;JSP P,TYI RETURNS CHAR IN C.
;JSP P,TYI0 ALSO SKIPS IF NO INPUT AVAILABLE.
TYI:	ILDB C,MEMSIZ-1		;CHECK FOR COMMANDS FROM MEMORY
	JUMPN C,(P)		;FOUND ONE--RETURN
	CLEARM MEMSIZ-1
TYI0:				;ENTRY TO SKIP IF NO INPUT AVAILABLE
KA,[	CONSO TTY,40
	 JRST TYI1
	DATAI TTY,C
]
KS,[	SKIPN C,8CTYIN
	 JRST TYI1
	ANDI C,177
	SETZM 8CTYIN
]
KL,[	MOVEI C,3400		;DDT MODE INPUT
	SETZM DTEFLG
	MOVEM C,DTECMD
	CONO DTE,%DBL11
	SKIPN DTEFLG
	 JRST .-1
	MOVE C,DTEF11
	SETZM DTEFLG
	JUMPE C,TYI1
]	ANDI C,177
	CAIGE C,175
	CAIN C,33
	 JRST (P)		;DON'T ECHO GRITCHES
;DROP INTO TYO

;JSP P,TYO TYPES OUT CHAR IN C.  CLOBBERS A,C.
TYO:	;SKIPE MEMSIZ-1
	; JRST (P)		;DON'T ECHO COMMANDS FROM MEMORY
KA,[	HRRZ A,C		;COMPUTE PARITY
	IMULI A,40201
	AND A,[1111111]
	IMUL A,[1111111]
	TLNE A,1
	 IORI C,200
	CONSZ TTY,20
	 JRST .-1
	DATAO TTY,C
	ANDCMI C,200
]
KS,[	MOVE A,C
	ANDI A,177
	TRO A,400
	MOVEM A,8CTYOT
	CONI A
	IORI A,80INT
	CONO (A)
	SKIPE 8CTYOT
	 JRST .-1
]
KL,[	MOVE A,C
	ANDI A,177
	SETZM DTEFLG
	MOVEM A,DTECMD
	CONO DTE,%DBL11
	SKIPN DTEFLG
	 JRST .-1
	SETZM DTEFLG
]
	JUMPGE C,(P)		;CHECK FOR CRLF (AS OPPOSED TO ECHOING A CR)
	SKIPA C,C12		;TYPE AN LF
CRLF:	 HRROI C,15
	JRST TYO

TYI1:	HRRZ C,-1(P)		;NO INPUT AVAILABLE
	CAIE C,TYI0
	 JRST TYI		;WAIT FOR IT
	JRST 1(P)		;CALL WAS TO TYI0, SKIP RETURN

LINK:	CAIE CMD,'D
	CAIN CMD,'K
	 MOVSI WRITE,-1		;MAKE THIS INFO MORE CONVENIENT
	MOVE D,[440600,,C]
	MOVEI T,0
LINKL:	ILDB TT,DIRPT
	SKIPGE WRITE
	 DPB T,DIRPT		;CLOBBER CHARS READ FOR DUMP OR KILL
	CAIN TT,';
	 JRST LINKN
	CAIN TT,':
	 JRST LINKQ
	JUMPE TT,LINKN
LINKQ1:	IDPB TT,D
	TLNE D,770000
	 JRST LINKL
LINKN1:	CAMGE D,[600,,B]	;THROUGH WITH FN2?
	 JRST LINKL
	JUMPL WRITE,KILL1
	MOVEM A,FN1
	MOVEM B,FN2
	JRST MLOOK2

LINKN:	TLNN D,770000
	 JRST LINKN1
	IDPB T,D		;FILL OUT WITH SPACES
	JRST LINKN

LINKQ:	ILDB TT,DIRPT
	JUMPGE WRITE,LINKQ1
	DPB T,DIRPT
	JRST LINKQ1

READ:	MOVEI BLKIN,CORE
	JSP P,CRLF
	MOVEI CMD,0		;INITIALIZE COMMAND
READ1A:	MOVEI WRITE,0		;INITIALIZE NUMBER
	MOVSI B,(SIXBIT \@\)	;INITIALIZE 1ST FILE NAME
READ1:	MOVEM B,FN1
READ3A:	MOVSI B,(SIXBIT \@\)	;INITIALIZE CURRENT FILE NAME
	MOVE D,[440600,,B]
READ2:	JSP P,TYI
	CAIN C,177
	 JRST READ		;IF RUBOUT START OVER
	CAIGE C,175
	CAIN C,33
	 JRST ALTMOD		;JUMP IF 33, 175, 176
	ASH WRITE,3		;DOES NOT CHANGE SIGN OF WRITE
	CAIL C,"0
	CAILE C,"7
	 TLOA WRITE,400000	;NON-NUMERIC CHAR--MAKE WRITE NEGATIVE
	  ADDI WRITE,-"0(C)	;NUMERIC CHAR--ACCUMULATE NUMBER
	CAIN C,";
	 JRST READ3		;SET SYSTEM NAME
	CAIN C,40
	 JRST READ1		;SET FIRST FILE NAME
	CAIN C,^Q
	 JSP P,TYI		;QUOTED CHARACTER
	CAIGE C,140		;CHECK FOR LOWER CASE
	 SUBI C,40
	JUMPL C,DOIT		;IF LESS THAN 40 (EXC. ^Q) END OF COMMAND
	TLNE D,770000		;SKIP IF ALREADY SIX CHARS
	 IDPB C,D
	JRST READ2

READ3:	MOVEM B,SYSN
	CAIE CMD,'U
	 JRST READ3A
	JRST DOIT		;IF COMMAND IS U GO LIST DIRECTORY

ONOFF:	CAIGE WRITE,NDSK
	 DPB CMD,[100,,QDED(WRITE)]	;LOW BIT OF CMD DETERMINES ON/OFF LINE STATUS
	JRST READ  		; (K=13, L=14)

ALT1:	LDB CMD,D		;PICK UP COMMAND CHAR
	CAIE CMD,'K
	 TRNN CMD,2
	  JRST READ1A		;GET FILE NAME
	JRST DOIT		;DON'T WANT FILE NAME--GO TO WORK

ALTMOD:	MOVEI C,"$
	JSP P,TYO		;ECHO DOLLAR SIGN
	JUMPLE WRITE,ALT2	;JUMP IF NOT <NUMBER><ALTMODE> LAST TYPED
	JUMPN CMD,ONOFF		;JUMP IF <CMD><ALTMODE><NUMBER><ALTMODE>
	HRRM WRITE,SADR		;SET STARTING ADDR
	JRST READ

ALT2:	TLC D,360000
	TLCN D,360000		;SKIP IF SINGLE CHARACTER BEFORE <ALTMODE>
	 JUMPE CMD,ALT1		;JUMP IF NO COMMAND ALREADY TYPED
DOIT:	MOVEM B,FN2		;STORE SECOND FILE NAME
	HRRZ B,MU
	HRRM B,CU		;MAKE MASTER UNIT CURRENT UNIT
	MOVNI WRITE,1
	JSP P,LODUMP		;DUMP OUT PSEUDO-CORE
	CAIN CMD,'G
	 JRST LOADG0		;GO
	JSP TT,RDTUT
	MOVE C,SYSN
MLOOK2:	MOVSI WRITE,1		;MAKE WRITE INDICATE LOAD
	MOVEI BLOK,MFDBLK
	MOVEI UNIT,DIR
	JSP TT,RD		;READ MASTER DIRECTORY TO FIND WHERE USER DIRECTORY IS
	MOVE T,DIR+MDCHK
	CAME T,[SIXBIT/M.F.D./]
	 JSR EMFC,ERROR
	MOVE T,DIR+MDNUDS
	CAIE T,NUDSL
	 JSR EMFC,ERROR
	CAIN CMD,'S
	 JRST LISTS		;LIST DISK ID'S AND SYSTEM NAMES
	MOVE T,DIR+MDNAMP
MLOOK:	CAMN C,DIR+MNUNAM(T)	;LOOK UP SYSTEM NAME
	 JRST MLOOK1
	ADDI T,LMNBLK
	CAIGE T,2000
	 JRST MLOOK
	JSR ESNF,ERROR		;NOT FOUND

MLOOK1:	MOVEI BLOK,2*NUDSL-2000(T)	;CONVERT USER SLOT TO BLOCK NUMBER
	LSH BLOK,-1
	HRRM BLOK,UDBLK		;REMEMBER FOR KILL OR DUMP
	MOVEI UNIT,DIR
	JSP TT,RDM		;READ USER DIRECTORY
ULOOK:	CAME C,DIR+UDNAME
	 JSR ECDR,ERROR		;WRONG ONE??
	CAIE CMD,'F
	CAIN CMD,'U
	 JRST LISTFC		;LIST USER DIRECTORY
	MOVSI TT,UNIGFL
	MOVE T,DIR+UDNAMP
	MOVE A,FN1
	MOVE B,FN2
ULOOK1:	CAMN A,DIR+UNFN1(T)	;LOOK UP FILE NAME
	CAME B,DIR+UNFN2(T)
	 JRST ULOOK2
	TDNN TT,DIR+UNRNDM(T)	;IS THIS FILE FOR REAL?
	 JRST ULOOK3
ULOOK2:	ADDI T,LUNBLK
	CAIGE T,2000
	 JRST ULOOK1
	CAIE CMD,'D		;IF NOT FOUND BETTER BE DUMP
	 JSR EFNF,ERROR
	MOVE T,DIR+UDNAMP
ULOOK4:	SKIPN DIR+UNFN1(T)	;FIND FREE SLOT FOR NEW FILE
	 JRST DUMP
	ADDI T,LUNBLK
	CAIGE T,2000
	 JRST ULOOK4
	MOVNI T,LUNBLK		;NO FREE SLOTS--TRY TO EXTEND NAME AREA DOWN
	ADDM T,DIR+UDNAMP
	MOVE T,DIR+UDESCP
	IDIVI T,6
	ADDI T,UDDESC
	CAMGE T,DIR+UDNAMP	;DID WE RUN INTO DESCRIPTOR AREA?
	 JRST DUMP0
	JSR EDIR,ERROR		;YES

ULOOK3:	HRRM T,DMP4		;IF FILE FOUND, SAVE SLOT NUMBER FOR DUMP
	LDB C,[UNDSCP DIR+UNRNDM(T)]
	JSP TT,GBP
	MOVEM C,DIRPT		;SET UP DESCRIPTOR AREA BYTE POINTER
	MOVSI TT,UNLINK
	TDNE TT,DIR+UNRNDM(T)
	 JRST LINK		;FILE IS A LINK
	LDB A,[UNPKN DIR+UNRNDM(T)]
ULOOK5:	CAMN A,TUT+QPKNUM	;SEE IF IT'S MOUNTED
	 JRST LOAD
	JSP TT,NXTTUT
	 JRST ULOOK5
	JSR EPNM,ERROR

LOAD:	CAIE CMD,'D		;GET HERE IF FILE FOUND
	CAIN CMD,'K		;IF DUMP OR KILL, DELETE IT
	 JRST KILL
ZERO:	MOVEI TT,CORE-1
	TRNN CMD,20		;SKIP IF T$ SYMBOL LOADING COMMAND
	 JRST ZERO1
	MOVEI B,DDT-1		;ASSUME ALWAYS USING MOBY DDT
	JSP P,FD		;GET DDT'S SYMBOL TABLE POINTER
	 JSR EDDT,ERROR		;CAN'T GET IT??
	HRROS B,(C)		;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
	CAME B,[-1,,DDT-2]	;VERIFY THAT IT'S REALLY A MOBY DDT LIKE WE THOUGHT
	 JSR EDDT,ERROR
	SKIPE D,-2(C)		;FLUSH ALL BUT INITIAL SYMBOLS
	 MOVEM D,-1(C)
	MOVE D,-1(C)
	MOVEI TT,CORE-1
	CAILE TT,-1(D)
	 MOVEI TT,-1(D)		;DON'T ZERO SYMBOL TABLE NOR DDT
ZERO1:	TRNE CMD,1
	 JRST LOAD1		;NON-ZEROING COMMAND
	SETZM 40 		;BEGIN CLEARING CORE
	MOVE T,[40,,41]		;SET UP BLT POINTER
;CODE TO SKIP OVER NXM
ZERO2:	CAIG TT,10*2000-1(T)	;MORE THAN 8K LEFT TO ZERO?
	 JRST ZERO4 		;NO, ZERO REMAINING WORDS AND PROCEED
	MOVE D,T		;AVOID KA/KL INCOMPAT BY COPYING BLT PNTR
	BLT D,10*2000-1(T)	;ZERO NEXT 8K
ZERO3:	ADDI T,10*2000		;MOVE DEST OF BLT PNTR UP 8K
	ANDCMI T,1777 		;ROUND DOWN TO 1K BOUNDARY
KA,	CONO 10000 		;CLEAR NXM
	MOVES (T) 		;SET NXM IF HOLE
KA,	CONSZ 10000 		;NXM GENERATED?
KA,	 JRST ZERO3 		;YES, GO TO NEXT 8K
	JRST ZERO2 		;NO, CLEAR THIS 8K

ZERO4:	BLT T,(TT) 		;AND CLEAR TO TOP BOUNDARY
	TRNE CMD,20
	 JRST LOAD1		;IF SYMBOL-LOADING COMMAND, STOP THERE
	CLEARM CBUF
	MOVE T,[CBUF,,CBUF+1]
	BLT T,CBUF+1777
	MOVEI UNIT,CBUF
	MOVE BLOK,CBLK		;-NSWBL IN LH
	JSP TT,WRM		;CLEAR PSEUDO-CORE
	AOBJN BLOK,.-1
LOAD1:	SETZB BUFP,BLKCNT	;SET UP BUFP SO FIRST CALL TO WD WILL READ
LOAD2:	JSP P,WD		;FIRST BLOCK OF FILE
	CAME D,[JRST 1]		;LOOK FOR END OF SBLK LOADER
	 JRST LOAD2
	CAIN CMD,'I		;IF VERIFY, START SIMULATING DUMP
	 JRST DUMP.5
LOAD3:	JSP P,WD		;READ BLOCK HEADER
	JUMPGE D,LOADS		;IT'S A JUMP BLOCK
	MOVE A,D
	MOVE B,D
	JSR LOADB		;LOAD LOGICAL BLOCK INTO CORE
	JRST LOAD3

LOADB:	0
LOAD4:	JSP P,WD		;LOAD A LOGICAL BLOCK--AOBJN POINTER IN B,
	ROT A,1			;BLOCK HEADER IN A (FOR CHECKSUM)
	ADD A,D			;ADD NEW WORD INTO CHECKSUM
	JSP P,FD		;AND PREPARE TO SMASH IT AWAY
	 JRST .+2		;LOCATION CAN'T BE LOADED
	  MOVEM D,(C)		;SMASH WORD AWAY
	AOBJN B,LOAD4
	JSP P,WD
	CAMN A,D		;CHECK THE CHECKSUM
	 JRST @LOADB
	JSR ECKS,ERROR		;BAD CHECKSUM

LOADS:	CAIN CMD,'M
	 JRST LOADG0		;DON'T LOAD SYMBOLS NOR SADR
	MOVEM D,NXTBW3		;SAVE S.A.
	MOVEI B,DDT-1		;ASSUME IS ALWAYS MOBY DDT.
	JSP P,FD		;GET DDT'S SYMBOL TABLE POINTER
	 JSR EDDT,ERROR		;CAN'T GET IT??
	SKIPN (C)
	 JRST LOADJ		;AIN'T GOT NO DDT, IGNORE SYMBOLS	 
	HRROS B,(C)		;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
	CAMN B,[-1,,DDT-2]	;VERIFY THAT IT'S REALLY A MOBY DDT LIKE WE THOUGHT
	 JSP P,FD		;FETCH SYMBOL TABLE POINTER
	  JSR EDDT,ERROR
	MOVE D,(C)
	MOVEM D,DDTM2
LOADS1:	MOVE B,DDTM2		;GET LOWEST SYMBOL LOC SO FAR
	JSP P,WD		;GET SYMBOL BLOCK HEADER
	JUMPGE D,LOADS2		;JUMP IF END OF SYMBOLS
	TRNE D,-1		;SKIP IF REALLY SYMBOLS AND NOT SOME OTHER BRAIN-DAMAGED CRUFT
	 JRST LOADBD
	MOVSS D
	HRLI D,-1(D)
	ADD B,D			;EFFECTIVELY SUBTRACTS LENGTH OF BLOCK FROM BOTH HALVES
	MOVEM B,DDTM2		;OF SYMBOL TABLE POINTER
	HRL B,D			;SET UP AOBJN POINTER IN B
	HRLZ A,D		;AND RECREATE HEADER IN A
	JSR LOADB		;LOAD THE SYMBOLS
	JRST LOADS1

LOADBD:	HLRO B,D		;-# WORDS TO SKIP (NOT COUNTING CHECKSUM)
	JSP P,WD
	AOJLE B,.-1
	JRST LOADS1		;TRY NEXT SYMBOL BLOCK

LOADS2:	MOVE D,DDTM2		;GET UPDATED DDT SYMBOL PNTR
LOADS4:	MOVEI B,DDT-2		;WE KNOW WHERE IT ALWAYS GOES
	JSP P,FD		;PUT BACK SYMBOL TABLE POINTER
	 JSR EBUG,ERROR		;CAN'T PUT IT BACK??
	MOVEM D,(C)
	MOVEI B,DDT-4		;GIVE STARTING ADDRESS TO DDT
	JSP P,FD
	 JSR EBUG,ERROR
	MOVE D,NXTBW3
	MOVEM D,(C)
	MOVEI D,DDT		;AND SET DSKDMP START ADDRESS TO DDT
LOADJ:	HRRM D,SADR		;SET STARTING ADDRESS FROM JUMP BLOCK
LOADG0:	MOVE T,BOOTNS		;APPROP DISK WAIT FOR NON BUSY INSTR
	MOVEM T,BOOT
LOADG:	JSP TT,WRCB		;MAKE SURE ALL LOADED CRUFT IN PSEUDO-CORE IS OUT
	MOVEI WRITE,0
	JSP P,LODUMP		;AND LOAD IT ALL IN
	TRNE CMD,10
	 JRST READ		;NON-GOING COMMAND
GO:
PH,[	MOVSI B,-LSWPADR
GO1:	IORD DIFF,SWPCS1
	TRNN DIFF,%HXRDY	; Wait for controller
	 JRST GO1
	HRRZ DIFF,SWPVAL(B)
	IOWR DIFF,SWPADR(B)
	AOBJN B,GO1
];PH
RH,[	MOVE B,ERRWD
	CONI DSK,HEAD
	TLNE HEAD,(%HID22)
	 HRLI B,-1700_4
	MOVEM B,@ICWA
	MOVSI B,-6
GO1:	CONSZ DSK,%HIBSY
	 JRST .-1
	MOVE DIFF,SWPOU1(B)
	JSP HEAD,RHSET
	AOBJN B,GO1
];RH
RP,[	MOVE B,ERRWD
	MOVEM B,@ICWA
	DATAO DPC,SWPSK
	JSP P,SKWAIT
	DATAO DPC,SWPOU1
	CONSO DPC,DONE
	 JRST .-1
	DATAO DPC,SWPOU2
];RP
SC,	DATAO DC0,[DJMP SWPOUT]
	JRST WAIT

LISTS:	JSP P,CRLF
LISTS2:	JSP P,TYI0
	 JRST LOADG1		;SHUT UP IF KEY HIT
	MOVE C,TUT+QPKNUM	;TYPE PACK NUMBER
	JSP TT,PNO
	MOVE D,TUT+QPAKID	;AND I.D.
	JSP TT,PD2
	JSP TT,NXTTUT		;SAME FOR ALL DIRECTORIES
	 JRST LISTS2
	MOVE T,DIR+MDNAMP
LISTS1: CAIGE T,2000
	 JSP P,TYI0		;STOP TYPING IF TTI FLAG ON
	  JRST LOADG1
	SKIPE D,DIR+MNUNAM(T)
	 JSP TT,PD		;TYPE OUT USER NAME
	ADDI T,LMNBLK
	JRST LISTS1

LISTFC:	MOVE T,DIR+UDNAMP
LISTF1:	
KA,	CONSO TTY,40		;STOP TYPING IF TTI FLAG ON
KS,	SKIPN 8CTYIN		; Stop typing if character waiting
	 CAIL T,2000
	  JRST LOADG1
	SKIPN DIR+UNFN1(T)	;SKIP IF FILE IN THIS SLOT
	 JRST LISTF2
	JSP P,CRLF
	LDB C,[UNPKN DIR+UNRNDM(T)]
	JSP TT,PNO		;TYPE PACK NUMBER
	MOVE D,DIR+UNFN1(T)
	JSP TT,PD2		;TYPE FIRST FILE NAME
	MOVE D,DIR+UNFN2(T)
	JSP TT,PD2		;AND SECOND FILE NAME
LISTF2:	ADDI T,LUNBLK
	JRST LISTF1

KILL:	JSP TT,NXTB6		;GET HERE ON KILL OR DUMP OF EXISTING FILE
	MOVEI T,0		;ZERO BYTES IN USER DIRECTORY DESCIPTOR AREA
	DPB T,DIRPT		;NXTB6 JUMPS TO KILL1 AT END OF FILE
	MOVE C,BLOK
	JSP TT,GTP
	ILDB T,C
	CAIGE T,TUTLK-1		;SOS USAGE OF THIS BLOCK
	 SOJL T,[JSR ECDR,ERROR]
	DPB T,C
	JRST KILL

KILL1:	HRRZ T,DMP4		;CLEAR OUT USER DIRECTORY SLOT
	CLEARM DIR+UNFN1(T)
	CLEARM DIR+UNFN2(T)
	CLEARM DIR+UNRNDM(T)
	MOVSI WRITE,-1
	CAIN CMD,'K
	 JRST KILDMP		;IF KILL DON'T DUMP
	JRST DMP4		;MUST DUMP ON SAME UNIT

DUMP0:	MOVE T,DIR+UDNAMP	;GET HERE IF SLOT CREATED AT BOTTOM OF NAME AREA
DUMP:	HRRM T,DMP4		;GET HERE IF EMPTY SLOT FOUND IN NAME AREA
DMP0:	MOVEI D,0		;GET HERE IF USING SLOT OF OLD FILE
DMP1:	;MOVE C,TUT+QSWAPA
	MOVEI C,0		;NOTE START AT 0 NOT QSWAPA
	MOVE B,C
	SUB B,TUT+QLASTB
	HRLZ B,B		;LH(B) COUNTS BLOCKS, RH(B) COUNTS FREE BLOCKS
	JSP TT,GTP
DMP2:	ILDB T,C
	SKIPE T
KA,	 SUBI B,1		;THIS RELIES ON CARRY PROPAGATING FROM RH TO LH IN AOBJN
KL,	 HRRI B,-1(B)		;ON KI10, KL10 CHANGE SUBI B,1 TO HRRI B,-1(B)
KS,	 HRRI B,-1(B)		;KS too...
	AOBJN B,DMP2
	CAIG B,(D)		;RH OF D IS HIGHEST SO FAR, LH SAYS WHICH UNIT
	 JRST DMP5		;NOT BETTER THAN RECORD
	MOVE D,B		;NEW RECORD--RECORD IT
	HRL D,CU
DMP5:	JSP TT,NXTTUT		;TRY NEXT
	 JRST DMP1
			;FALLS THROUGH AT END
DMP3:	HLRM D,CU		;SET CURRENT UNIT TO ONE WITH MOST FREE BLOCKS
	JSP TT,RDTUT		;GET ITS TUT
DMP4:	MOVEI T,.
	MOVE A,FN1
	MOVE B,FN2
	MOVEM A,DIR+UNFN1(T)	;PUT CRUFT INTO SLOT
	MOVEM B,DIR+UNFN2(T)
	SETOM DIR+UNDATE(T)	; Unknown creation date
	HRROI C,777000		; Unknown reference date
	MOVEM C,DIR+UNREF(T)	; Unknown author, 36. bit bytes
SC,[	MOVEM A,XWDS+XWFN1
	MOVEM B,XWDS+XWFN2
	MOVE C,SYSN
	MOVEM C,XWDS+XWSYSN
]	MOVE C,DIR+UDESCP	;PUT DESCRIPTOR CHARACTER ADDRESS
	MOVE B,TUT+QPKNUM	;AND PACK NUMBER
	DPB B,[UNPKN C]
	MOVEM C,DIR+UNRNDM(T)	;INTO USER DIRECTORY SLOT
	;MOVE C,TUT+QSWAPA	;COMMENTED OUT INSN DUMPS INTO FILE AREA
	MOVEI C,0		;DUMP INTO SWAPPING AREA TO AVOID Y FILES
	MOVEM C,LBLOCK		;A DAEMON WILL COPY INTO FILE AREA AFTER SALVAGE
	JSP TT,GTP
	MOVEM C,TUTPT		;INITIALIZE TUT POINTER
	MOVE C,DIR+UDESCP
	JSP TT,GBP
	MOVEM C,DIRPT		;INITIALIZE DESCRIPTOR AREA POINTER
	SETOB WRITE,BLKCNT	;FORCE NXTBW TO LOAD ADR
KA,	HRLOI BUFP,-2001-1	;SET UP BUFP SO FIRST WORD GOES IN DBUF+0
KL,	HRLOI BUFP,-2001
KS,	HRLOI BUFP,-2001
	MOVE D,[JRST 1]
	JSP P,WD		;END OF SBLK LOADER
;DROPS THROUGH

;DROPS IN
DUMP.5:	MOVSI WRITE,-'I(CMD)	;GET HERE IF VERIFY--SET WRITE NEGATIVE IF
	MOVEI B,40		;DUMP AND ZERO IF VERIFY--FIRST ADDR DUMPED IS 40
	HRRM B,DUMP4
	HLLOS DUMP6
	SETZM DUMP9S
	SETZM DUMP9J
	SETZM DUMP9K
	MOVEI B,DDT-3		;SET UP TO NOT DUMP SYMBOLS AS PART OF CORE IMAGE
	JSP P,FD
	 JSR EBUG,ERROR
	SKIPN A,(C)		;GET PNTR TO BUILT IN SYMBOLS
	 JRST DUMP4		;NO DDT, DON'T HACK THIS
	HRRM A,DUMP7		;THIS IS WHERE WE START DUMPING AGAIN
	MOVEM A,DUMP9K		;THIS WILL BE INITIAL SYMBOL TABLE PNTR WHEN DDT LOADED
	MOVNI A,(A)
	ADD A,1(C)		;GET MINUS SIZE OF NON-BUILTIN SYMBOL TABLE IN RH(A)
	HRL A,1(C)		;GET PNTR TO SYMBOL TABLE
	HLRM A,DUMP6		;THIS IS WHERE WE STOP DUMPING
	MOVSM A,DUMP9S		;SAVE AOBJN PNTR TO NON-BUILTIN SYMBOLS
	MOVE A,-1(C)		;PICK UP START ADDRESS
	MOVEM A,DUMP9J		;SAVE 
	MOVE B,-2(C)		;DUMP LOW CORE (ACS) OUT OF PLACE SAVED IN DDT
	HLLZ A,B		;HERE B HAS ADDRESS DUMPING FROM
	JRST DUMP3B		;AND A AND D HAVE VIRTUAL ADDRESS

DUMP1:	 			;SKIP OVER NXM ON DUMPING
KA,[	CONSO 10000 		;NXM SET?
	 JRST DUMP1A 		;NO, CONTINUE IN SEQUENCE
	ADDI B,10*2000-1	;SKIP 8K
	TRZ B,1777 		;ROUND DOWN TO 8K BOUDARY
	CONO 10000 		;CLEAR NXM
DUMP1A:
];KA
DUMP6:	CAIGE B,.		;SKIP IF REACHED SYMBOL TABLE
	 JRST DUMP8
DUMP7:	MOVEI B,.		;SKIP OVER SYMBOLS, DUMP DDT
	HLLOS DUMP6		;DEFUSE TEST
DUMP8:	JSP P,FD
	 JRST DUMPJ		;TIME TO WRITE JUMP BLOCK AND SYMBOL TABLE
	SKIPN (C)		;LOOK FOR NON-ZEROES
	 AOJA B,DUMP1
	MOVE A,B		;SAVE START OF BLOCK
DUMP2:	TLZ A,-1		;LOOK FOR TWO CONSECUTIVE ZEROES
DUMP2A:	CAIL B,200(A)		;BUT DON'T DUMP MORE THAN 200 WORDS AT A TIME
	 JRST DUMP3
	XCT DUMP6
	 JSP P,FD
	  JRST DUMP3		;END OF CORE, WRITE OUT LAST BLOCK
	SKIPE (C)
	 AOJA B,DUMP2		;NONZERO
	TLON A,-1		;ZERO, WAS PREV LOC ZERO ALSO?
	 AOJA B,DUMP2A		;NO, CHECK FOLLOWING LOC
	SOJA B,DUMP3		;YES, DUMP THE NON-ZERO THAT PRECEDES IT

DUMP3:	HRRM B,DUMP4		;SAVE ADDRESS TO CONTINUE SEARCH
	SUBM A,B		;RH(B) GETS MINUS THE LENGTH OF THE BLOCK
	HRL A,B			;SET UP HEADER IN A
	MOVE B,A		;AND B
DUMP3B:	MOVE D,A		;AND D
	JSP P,WD		;WRITE HEADER
DUMP3A:	JSP P,FD
	 JSR EBUG,ERROR		;CAN'T FETCH WORD WE FETCHED BEFORE??
	MOVE D,(C)
	ROT A,1
	ADD A,D			;COMPUTE CHECKSUM
	JSP P,WD		;WRITE DATA WORD
	AOBJN B,DUMP3A
	MOVE D,A
	JSP P,WD		;WRITE OUT CHECKSUM
DUMP4:	MOVEI B,.		;AND CONTINUE SEARCHING
	JUMPN B,DUMP1		;IF MRC EVER SEES THIS --SELFMODIFYING CODE-- ....
	JRST DUMP9		;FINISHED DUMPING SYMBOLS

DUMPJ:	SKIPN DUMP9K
	 JRST DMP9J1
	HRROI D,DDT-2		;BUGGER THE SYMBOL TABLE
	MOVE A,D
	JSP P,WD
	MOVE D,DUMP9K
	ROT A,1
	JSP P,WD
	ADD D,A
	JSP P,WD
DMP9J1:	SKIPN D,DUMP9J
	 MOVE D,SADR
	JSP P,WD		;WRITE OUT JUMP BLOCK
	SKIPN B,DUMP9S		;WRITE SYMBOLS
	 JRST DUMP9		;NO SYMBOLS
	HLLZ A,B
	HLLZS DUMP4		;DUMP SYMBOL BLOCK, RETURN TO DUMP9
	JRST DUMP3B

DUMP9:	JUMPE WRITE,LOADG1	;IF VERIFY, THAT'S ALL
	SKIPN D,DUMP9J
	 MOVE D,SADR
	JSP P,WD		;SECOND JUMP BLOCK
	HRRZ T,DMP4		; GET POINTER TO NAME AREA
	AOS BUFP
	DPB BUFP,[UNWRDC+DIR+UNRNDM(T)]
	JSP TT,NXTBLK
	JSP TT,WRDB		;WRITE OUT LAST BLOCK
	SKIPE T,BLKCNT
	 JSR NXTBW3		;STORE LAST DESCRIPTOR BYTE
	MOVEI T,0
	JSR NXTBW3		;AND INDICATE END OF FILE
	LDB T,[360600,,DIRPT]
	IDIVI T,6
	HRRZ TT,DIRPT
	IMULI TT,6
	SUBI TT,6*<DIR+UDDESC>-5-1(T)
	HRRZM TT,DIR+UDESCP	;INDICATE NEW END OF DESCRIPTOR AREA
KILDMP:	MOVEI UNIT,TUT
	MOVEI BLOK,TUTBLK
	JSP TT,WRD		;WRITE OUT TUT ON THIS UNIT
REPEAT NTUTBL-1,[
	ADDI UNIT,2000
	ADDI BLOK,1
	JSP TT,WRD
]
	HRRZ B,CU
	HRRM B,KD2		;WRITE OUT USER DIRECTORY ON ALL UNITS
KD1:	ADDI B,1
	CAIN B,NDSK
	 MOVEI B,0
	HRRM B,CU
	SKIPE QDED(B)
	 JRST KD2
	MOVEI UNIT,DIR
UDBLK:	MOVEI BLOK,.
	MOVE TT,DIR+UDNAME
	CAME TT,SYSN
	 JSR EBUG,ERROR
	JSP TT,WR
KD2:	CAIN B,.
	 JRST LOADG1
	JRST KD1

GTP:	SKIPGE TUT+QPKNUM
	 JSR EBUG,ERROR		;MUST BE OLD-STYLE TUT?
	SUB C,TUT+QFRSTB
	JUMPL C,[JSR EBUG,ERROR]
	IDIVI C,TUTEPW
	IMULI A,-10000*TUTBYT
	HRLI C,440000+TUTBYT_6(A)
	ADDI C,TUT+LTIBLK
	JRST (TT)

SC,[	;LOGICAL TO PHYSICAL DISK MAPPING
QTRAN:	0	;INDEX BY LOG DSK #
	1	;4.9 => USE HIGH HALF OF DRIVE, RH = PHYS DRIVE #
	2	;(NO LONGER DOES ANYTHING, NOW THAT MEMOWRECKS ARE GONE,
	3	; BUT KEEP AROUND JUST IN CASE EVER NEEDED AGAIN.)
	4
	5
	6
	7
IFL .-QTRAN-NDSK,.ERR QTRAN LOSES!!
];SC

ERRCT:	0		;ERROR COUNTER
DDTM2:	0		;DDT SYMBOL TABLE POINTER
DUMP9J:	0		;START INSTRUCTION (AT DUMP9)
DUMP9S:	0		;SYMBOL TABLE POINTER (AT DUMP9)
DUMP9K:	0		;INITIAL SYMBOL TABLE PNTR (AT DUMP9)
LBLOCK:	0		;LAST BLOCK WRITTEN OR READ
BLKCNT:	0		;NUMBER OF BLOCKS READ OR WRITTEN CONSECUTIVELY
DIRPT:	0		;DESCRIPTOR AREA BYTE POINTER
TUTPT:	0		;TUT BYTE POINTER
FN1:	0		;FILE NAME 1
FN2:	0		;FILE NAME 2
PKNUM:	REPEAT NDSK,-1	;PACK NUMBER INDEXED BY DRIVE NUMBER
QDED:	BLOCK NDSK	;-1 IF DRIVE NOT TO BE USED
XWDS:	BLOCK 4
RPKID:	0
BOOTNS:	RP, CONSZ DPC,BUSY
	SC, CONSZ DC0,DSSACT
	RH, CONSZ DSK,%HIBSY
	PH, IORD B,SWPCS1	; UGH!

	CONSTANTS

IFL BEG+1677-., .ERR BLOAT
INFORM SPACE LEFT,\BEG+1677-.
BLOCK BEG+1677-.

BADBLK:	0		;BLOCK WITH HDWE ERROR
INFORM BADBLK,\.-1-BEG+<MEMSIZ-2000>

];END IFE BOOTSW
IFN BOOTSW,[
BEG=MEMSIZ-2000
LOC MEMSIZ-100
]

CBOOT:	CLEARM MEMSIZ-1		;BOOTSTRAP
RP,[
BOOT:
IFE BOOTSW,	JRST BEG	;OR CONSZ DPC,BUSY OR JRST LOADG1
IFN BOOTSW,	CONSZ DPC,BUSY
	 JRST .-1
	MOVEI B,ICWA+2		;SET UP CHANNEL PROG
	MOVEM B,ICWA
	SETZM ICWA+1
	SETZM ICWA+3
	DATAO DPC,CLATT1
	DATAO DPC,SUNIT0
	DATAI DPC,B
BOOT0:	TRNN B,RP03BT
	 JRST BOOT1
	MOVEI B,MBLKS		;UNIT 0 IS AN RP03, ADJUST WORLD
	HRRM B,CBLK
	MOVE B,RP3ADJ
	MOVSI A,-NSWBL
	XORM B,SWPSK(A)
	AOBJN A,.-1
BOOT1:	HLLZS BOOT0		;PREVENT TRNN FROM SKIPPING AGAIN
	MOVE B,ERRWD
	MOVEM B,@ICWA
	DATAO DPC,SWPSK
	JSP P,SKWAIT
	DATAO DPC,SWPIN1
	CONSO DPC,DONE
	 JRST .-1
	DATAO DPC,SWPIN2
	CONSO DPC,DONE
	 JRST .-1
	JRST BEG

ERRWD:	-1700,,BEG-1
CLATT1:	DEASEC ALLATT
SWPSK:	DSEEKC+200._22.
SWPIN1:	DWRITC+200._22.+3_17.+2._12.+ICWA	;NBLKS 4
SWPIN2:	DREADC+200._22.+4_17.+8._12.+ICWA
SWPOU1:	DWRITC+200._22.+4_17.+8._12.+ICWA
SWPOU2:	DREADC+200._22.+3_17.+2_12.+ICWA
IFN NSWBL-5, .ERR THE PRECEDING 4 CONSTANTS ARE WRONG!
CBLK:	-NSWBL,,NBLKS			;DISK ADDR OF CORE BUFFER, - # BLOCKS IN LH
RP3ADJ:	<<MCYLS#NCYLS>&377>_22.+<.BM DCYLXB>
SUNIT0:	DNOOPC

SKWAIT:	DATAI DPC,A		;AWAIT SEEK DONE UNIT 0
	TRNN A,ALLATT
	 JRST SKWAIT
	DATAO DPC,CLATT1
	MOVEI A,30.
	SOJG A,.
	DATAI DPC,A
	TLNN A,(ONCYL)
	 JRST SKWAIT
	JRST (P)

WAIT:	CONSO DPC,DONE
	 JRST .-1
];RP

PH,[	;; Initially we could not use IORDQ or IOWRQ because they were
	;; macros that used a literal.  There is nothing to stop us now,
	;; except the fact that this code works fine and is as small as you
	;; could possibly want.

BOOT:
IFE BOOTSW, JRST BEG		; or IORD B,SWPCS1 or JRST LOADG1
IFN BOOTSW, IORD B,SWPCS1
	TRNN B,%HXRDY
	 JRST BOOT
KS,	WREBR 0			; No paging or caching
	MOVEI A,0
	IOWR A,SWPCS2		; Select drive
BOOT0:	IORD A,SWPCS1
	TRNN A,%HXDVA
	 JRST BOOT0		; Await drive available
	MOVSI B,-LSWPADR
BOOT1:	HLRZ A,SWPVAL(B)
	IOWR A,SWPADR(B)
BOOT2:	IORD A,SWPCS1
	TRNN A,%HXRDY		; Wait for controller
	 JRST BOOT2
	TRNE A,%HXTRE+%HXMCP	; Lossage?
	 JRST 4,.		; Foo!
	AOBJN B,BOOT1
	JRST BEG

ZZ1==<NSWBL-1>*SECBLK	;BLOCK CONTAINING CORE SWAPPED OUT TO BRING DSKDMP IN
ZZ2==<NSWBL>*SECBLK	;DSKDMP RESIDENCE BLOCK
ZZ3==ZZ1/NSECS
ZZ4==ZZ2/NSECS
ZZ1==ZZ3*400+<ZZ1-NSECS*ZZ3>	;CONVERT ADDR TO DISK FORMAT
ZZ2==ZZ4*400+<ZZ2-NSECS*ZZ4>

SWPADR:	UBAQ,,UBAPAG+UBPG_1	; Set up Unibus map
	UBAQ,,UBAPAG+UBPG_1+1
	UBAQ,,%HRCS2		; Clear controller
SWPCS2:	UBAQ,,%HRCS2		; Select drive
SWPCS1:	UBAQ,,%HRCS1		; Initialize
	UBAQ,,%HRCYL		; Desire cylinder
	UBAQ,,%HRWC		; Set (half) word count
	UBAQ,,%HRBA		; Set Unibus address
	UBAQ,,%HRADR		; Desire track and sector
	UBAQ,,%HRCS1		; Write
	UBAQ,,%HRWC		; Reset (half) word count
	UBAQ,,%HRBA		; Reset Unibus address
	UBAQ,,%HRADR		; Desire track and sector
	UBAQ,,%HRCS1		; Read
LSWPADR==:.-SWPADR

IFN BEG&1777, .ERR BEG does not lie on a page boundary?

;;; LH FOR SWAP IN, RH FOR SWAP OUT
SWPVAL:	%UQVAL+%UQFST+BEG_-9,,%UQVAL+%UQFST+BEG_-9	; Set up Unibus map
	%UQVAL+%UQFST+BEG_-9+1,,%UQVAL+%UQFST+BEG_-9+1
	%HYCLR,,%HYCLR		; Clear controller
	0,,0			; Select drive
	%HMRDP,,%HMRDP		; Initialize
	NCYLS,,NCYLS		; Desire cylinder
	-1700*2,,-1700*2	; Set (half) word count
	UBPG_14,,UBPG_14	; Set Unibus address
	ZZ1,,ZZ2		; Desire track and sector
	%HMWRT,,%HMWRT		; Write
	-1700*2,,-1700*2	; Reset (half) word count
	UBPG_14,,UBPG_14	; Reset Unibus address
	ZZ2,,ZZ1		; Desire track and sector
	%HMRED,,%HMRED		; Read
IFN .-SWPVAL-LSWPADR, .ERR SWPVAL wrong length.

CBLK:	-NSWBL,,NBLKS

WAIT:	IORD B,SWPCS1
	TRNN B,%HXRDY
	 JRST WAIT
];PH

RH,[
BOOT:
IFE BOOTSW,	JRST BEG	;OR CONSZ DSK,%HIBSY OR JRST LOADG1
IFN BOOTSW,	CONSZ DSK,%HIBSY
	 JRST .-1
KL,	CONSZ PAG,660000	;PAGING AND CACHE MUST BE DISABLED
KL,	 JRST 4,.
	MOVEI B,ICWA+2		;SET UP CHANNEL PROG
	MOVEM B,ICWA
	SETZM ICWA+1
	SETZM ICWA+3
BOOT0:	DATAO DSK,[%HRDCL,,]
	MOVEI A,20
	SOJG A,.
	DATAI DSK,A
	TRNN A,%HCDVA
	 JRST BOOT0		;AWAIT DRIVE AVAILABLE
	MOVE B,ERRWD
	CONI DSK,A
	TLNE A,(%HID22)
	 HRLI B,-1700_4
	MOVEM B,@ICWA
	MOVSI B,-6
BOOT1:	DATAO DSK,SWPIN1(B)
	MOVEI A,20
	SOJG A,.
	CONSZ DSK,%HIBSY
	 JRST .-1
	AOBJN B,BOOT1
	CONSZ DSK,%HIERR
	 JRST 4,.
	JRST BEG

ZZ1==<NSWBL-1>*SECBLK	;BLOCK CONTAINING CORE SWAPPED OUT TO BRING DSKDMP IN
ZZ2==<NSWBL>*SECBLK	;DSKDMP RESIDENCE BLOCK
ZZ3==ZZ1/NSECS
ZZ4==ZZ2/NSECS
ZZ1==ZZ3*400+<ZZ1-NSECS*ZZ3>	;CONVERT ADDR TO DISK FORMAT
ZZ2==ZZ4*400+<ZZ2-NSECS*ZZ4>

ERRWD:	-1700,,BEG-1
SWPIN1:	%HRLOD+%HRDCL,,%HMRDP
SWPIN2:	%HRLOD+%HRCYL,,NCYLS+1	;AVOID CYLINDER 406 WHICH KLDCP USES
SWPIN3:	%HRLOD+%HRADR,,ZZ1
SWPIN4:	%HRLOD+%HRCTL,,%HMWRT+ICWA_6
SWPIN5:	%HRLOD+%HRADR,,ZZ2
SWPIN6:	%HRLOD+%HRCTL,,%HMRED+ICWA_6

SWPOU1:	%HRLOD+%HRDCL,,%HMRDP
SWPOU2:	%HRLOD+%HRCYL,,NCYLS+1	;AVOID CYLINDER 406 WHICH KLDCP USES
SWPOU3:	%HRLOD+%HRADR,,ZZ2
SWPOU4:	%HRLOD+%HRCTL,,%HMWRT+ICWA_6
SWPOU5:	%HRLOD+%HRADR,,ZZ1
SWPOU6:	%HRLOD+%HRCTL,,%HMRED+ICWA_6

CBLK:	-NSWBL,,NBLKS+NBLKSC	;AVOID CYLINDER 406 WHICH KLDCP USES

WAIT:	CONSO DSK,%HIDON
	 JRST .-1
];RH

SC,[
BOOT:
IFE BOOTSW,	JRST BEG	;OR CONSZ DC0,DSSACT OR JRST LOADG1
IFN BOOTSW,	CONSZ DC0,DSSACT
	 JRST .-1
	DATAO DC0,SWPINJ
	CONSZ DC0,DSSACT
	 JRST .-1
	JRST BEG

SWPINJ:	DJMP SWPIN

DADR==NCYLS_13+<<NSWBL-1>/2>_6+<<NSWBL-1>&1>	;ADDR OF LAST BLOCK IN CORE BUFFER
DADR1==NCYLS_13+<NSWBL/2>_6+<NSWBL&1>		;ADDR OF NEXT BLOCK (CONTAINS
SWPIN:	DWRITE+DUNENB+DADR			; WORKING COPY OF DSKDMP)
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DRC+DADR
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DREAD+DADR1
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DRC+DADR1
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DHLT

SWPOUT:	DWRITE+DUNENB+DADR1
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DRC+DADR1
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DREAD+DADR
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DRC+DADR
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DHLT

CBLK:	-NSWBL,,NBLKS		;DISK ADDR OF CORE BUFFER, - # BLOCKS IN LH
WAIT:	CONSZ DC0,DSSACT
	 JRST .-1
];SC
SADR:	JRST BOOT		;AND GO TO PROGRAM TO BE STARTED
SYSN:	SIXBIT /./		;CURRENT DIRECTORY
IFG .+1-MEMSIZ,.ERR BOOT BLOAT

IFE BOOTSW,{			;CURLY BRACKETS TO AVOID ERROR MESSAGE
	OFFSET 0
	LOC CORE

;THESE ARE THE BLOCKS THAT GET WRITTEN ON DISK
; STARTING AT THE BEGINNING OF THE FIRST EXTRA CYLINDER

CBUF:	BLOCK 2000		;PSEUDO-CORE BUFFER
DBUF:	BLOCK 2000		;DISK BUFFER
DIR:	BLOCK 2000		;DIRECTORY BUFFER
TUT:	BLOCK 2000*NTUTBL	;TUT BUFFER
IFN .-BEG,.ERR BLOCKS LOST
;	BLOCK 2000		;CORE OVERLAYED BY DSKDMP
;	BLOCK 2000		;COPY OF DSKDMP
;	BLOCK 2000		;SPARE COPY OF DSKDMP

END ZZZ
};END IFE BOOTSW
IFN BOOTSW, END CBOOT
