; -*- Midas -*-
.SYMTAB 3607.,5003.
.NSTGW

IF1,	TITLE	NSALVATION
IF2,[	PRINTX /
/
	.TYO6 .FNAM1
	PRINTX / /
	.TYO6 .FNAM2
	PRINTX/
/]

IFNDEF $$DBG,	$$DBG==0	; Debugging the Salvager.
IFNDEF $$EXTRA,	$$EXTRA==0	; Assemble code apparently never used.

DEFINE DBG
IFN $$DBG!TERMIN

DEFINE EXTRA
IFN $$EXTRA!TERMIN

SUBTTL	Basic definitions

MEMSIZ=1000000			;The size of memory.
PG$BTS==10.			;# Bits in page addr.
PG$SIZ=1_PG$BTS			;ITS page size in words.
PG$DEC=PG$SIZ/2			;DEC page size in words.
PG$MSK==PG$SIZ-1		;Mask for page address bits.

;;; Accumulators.

Z=0		;ZERO
A=1		;A-E general purpose
B=2
C=3
D=4
E=5
N=6
W=7
U=W+1
I=11		;Unit #.
Q=12
T=13		;Temporaries
TT=T+1
J=15		;Block #.
K=J+1
P=17		;Stack pointer
PDLLEN==256.	;Stack length.

.SEE CHKR	;SALVAGER
.SEE GOGO	;SALVAGER - (AUTO FOR ALL DRIVES)

.SEE GETSTS	;GET CONTROLLER AND CURRENT DRIVE STATUS
.SEE MARK	;FORMAT PACK
.SEE COPY	;COPY BLOCK TO BLOCK
.SEE UCOP	;COPY UDIRS FROM DRIVE TO DRIVE
.SEE DUP	;DUPLICATE ENTIRE DISC PACK
.SEE UNLOCK	;TEST & UNLOCK A BLOCK
.SEE LISTF	;PRINT USER DIRECTORY ON LPTR

.SEE ZAP	;ZERO DIR BLOCKS, WRITE OUT EMPTY TUT,MFD, WRITE READIN BLOCK
.SEE TRAN	;LOAD FROM MAG TAPE UNIT 5
		; (KS code ignores unit number says JTW)
.SEE CTRAN	;LOAD FROM CHAOS NET
.SEE NEWUFD	;CREATE NEW USER DIR
.SEE MFDR	;TRY TO RECONSTRUCT MFD FROM USER DIRS
.SEE REMAP	;REMAP PACK #S AND FIX UFDS
.SEE RDHEAD	;READ HEADER FROM TRACK
.SEE SPKID	;SET PACK ID IN TUT
.SEE SECOND	;SET SECONDARY PACK NAME
.SEE MARK69	;FINISH FORMATTING PACK
.SEE READ	;READ and WRITE the disk

.SEE FESET	;Set pointer to front end filesystem for KS10'S 8080 console

.SEE QACT	;Active disks
.SEE HCRASH	;VARIABLE TO BE SET NON-ZERO IF DUP'ING A DISK AFTER HEAD CRASH
.SEE NOQUES	;IF NON-ZERO, NO QUESTIONS IN GOGOX MODE
.SEE FERRS	;COUNT OF CORRECTABLE ERRORS
.SEE CERRS	;COUNT OF ECC-CORRECTED ERRORS (RP04/6 ONLY)

;;; MIDAS extensions.

;;; Canonical symbol definition macro, FOO==BAR with error check.
IFNDEF DEFSYM,[	
	DEFINE DEFSYM X/
	IRPS Z,,[X]
	IFNDEF Z,X
	.ELSE [	$$TEM1==Z
		X
		IFN Z-$$TEM1,.ERR Z MULTIPLY .QUOTE`.QUOTE/DEFINED/`
	      ]
	.ISTOP
	TERMIN TERMIN
	$$TEMP==1
];DEFSYM
.ELSE	$$TEMP==0

;;; Concatentation.

DEFINE CONC A,B
A!B!TERMIN

;;; IFCE - Like IFSE but ignores case.

DEFINE IFCE A,B
IFE SIXBIT/A/-SIXBIT/B/,TERMIN

;;; IFNDEZ "Error msg",FOO,BAR,BAZ,QUUX
;;; Sets the undefined symbols to zero and complains unless something defined.

DEFINE	IFNDEZ &ERMSG,-ARGS
	.DEZ==0 ;Count of mutually exclusive symbols d e f i n e d so far.
	IRPS Z,,[ARGS]
	   IFNDEF Z, Z==0 
	   .DEZ==.DEZ+Z
        TERMIN
 ;Now ensure that one and only one symbol was d e f i n e d.
 IFE .DEZ,   .FATAL ERMSG not deffd
 IFG .DEZ-1, .ERR ERMSG multiply deffd
TERMIN


;;; CRLF while assembling

DEFINE .CRLF
	.TYO 15
	.TYO 12
TERMIN

;;; INFORMation.

DEFINE INFORM A,B,C,D,E,F,G
PRINTX \A!B!C!D!E!F!G
\
TERMIN

;;; INFORMation about the length of something.  (In decimal.)

DEFINE SAYSIZ FOO,MSG
ORADIX==10
RADIX 10.
SAYSZ1 \FOO,[MSG]
RADIX ORADIX
TERMIN

DEFINE SAYSZ1 FOO,MSG
PRINTX /FOO!. MSG
/
TERMIN

;;; TMPLOC <loc>,<parenthesized arg> - puts argument at given LOC
;;; without changing location counter outside macro call.

DEFINE TMPLOC VAL,ARG
	%%%TLC==.
	LOC VAL
	ARG
	LOC %%%TLC
TERMIN


SUBTTL	Configuration

;;; Specify for each machine:
;;;  o processor type
;;;  o number of physical and virtual units (usually both the same)
;;;  o the first and last packs which must be mounted in GOGO mode
;;;  o number of user file directories in the file system
;;;  o disk drive and controller types
;;;  o width of console TTY
;;;  o device code for console lights (or zero)
;;;  o if it has a Chaos interface and associated addresses for the
;;;	MINI36 user in CTRAN to use

IF1,[
PRINTX /Which machine? /
.TTYMAC MCHN
 IFCE MCHN,AI,[
	;;; The new AI KS10 machine.
	KS10P==1
	NDRIVE==2	;# physical units
	NUNITS==2	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP06P==1	;RP06 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;Has Unibus Chaosnet board
	LHOST==3130	;Local chaos host address (AI)
	RHOST==3131	;Remote chaos host (MC)
	GWHOST==RHOST
	];AI

 IFCE MCHN,MC,[
	;;; The new Mail Computer KS10.
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP06P==1	;RP06 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11 (For mounting the pack on AI)
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;Has Unibus Chaosnet board
	LHOST==3131	;Local chaos host address (MC)
	RHOST==3130	;Remote chaos host (AI)
	GWHOST==RHOST
	];MC

 IFCE MCHN,ML,[
	;;; The Math Lab KS10.
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP06P==1	;RP06 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11 (For mounting the pack on AI)
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;Has Unibus Chaosnet board
	LHOST==3133	;Local chaos host address (ML)
	RHOST==3130	;Remote chaos host (AI)
	GWHOST==RHOST
	];ML

 IFCE MCHN,MD,[
	;;; The Mostly Development KS10.
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RM80P==1	;RM80 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11 (For mounting the pack on AI)
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;Has Unibus Chaosnet board
	LHOST==3132	;Local chaos host address (MD)
	RHOST==3130	;Remote chaos host (AI)
	GWHOST==RHOST
	];MD

 IFCE MCHN,SI,[
	;;; Stacken ITS
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP06P==1	;RP06 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11 (For mounting the pack on AI)
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	];SI

 IFCE MCHN,FU,[
	;;; Australian KS10
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP06P==1	;RP06 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11 (For mounting the pack on AI)
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	];FU

 IFCE MCHN,PM,[
	;;; MRC'S PandaMonium KS10
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RM03P==1	;RM03 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	];PM

 IFCE MCHN,DX,[
	;;; DigeX's KS10
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RM03P==1	;RM02/3 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	];DX

 IFCE MCHN,KSRP06,[
	;;; Generic KS10 with one RP06 and one TM03
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP06P==1	;RP06 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;May well have Unibus Chaosnet board
	LHOST==3130	;Local chaos host address (AI, can be patched)
	RHOST==3131	;Remote chaos host (MC, can be patched)
	GWHOST==RHOST
	];KSRP06

 IFCE MCHN,KSRP07,[
	;;; Generic KS10 with one RP07 and one TM03
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RP07P==1	;RP07 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;May well have Unibus Chaosnet board
	LHOST==3130	;Local chaos host address (AI, can be patched)
	RHOST==3131	;Remote chaos host (MC, can be patched)
	GWHOST==RHOST
	];KSRP07

 IFCE MCHN,KSRM03,[
	;;; Generic KS10 with one RM03 and one TM03
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RM03P==1	;RM03 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;May well have Unibus Chaosnet board
	LHOST==3130	;Local chaos host address (AI, can be patched)
	RHOST==3131	;Remote chaos host (MC, can be patched)
	GWHOST==RHOST
	];KSRM03

 IFCE MCHN,KSRM80,[
	;;; Generic KS10 with one RM80 and one TM03
	KS10P==1
	NDRIVE==1	;# physical units
	NUNITS==1	;# virtual units
	FIRSPK==0	;First pack that must be mounted in GOGO mode.
	LASTPK==0	;Last GOGO pack (only 1 disk on the machine!)
	NUDSL==500.
	RM80P==1	;RM80 on RH11 UNIBUS controller.
	TM03P==1	;Tape on a TM03/RH11
	TCMXH==120.	;DECwriter.
	LIGHTS==0	;There aren't any (sob!)
	CHAOSP==1	;May well have Unibus Chaosnet board
	LHOST==3130	;Local chaos host address (AI, can be patched)
	RHOST==3131	;Remote chaos host (MC, can be patched)
	GWHOST==RHOST
	];KSRM80

 IFCE MCHN,MCKL,[
	;;; The Macsyma Consortium machine.
	KL10P==1
	SA=105*2000	; MC-KL system is big, need to push SALV higher.
	FIRSPK==0
	LASTPK==1
	NUDSL==500.
	RH10P==1	;RP04 on RH10 MASSBUS controller.
	T300P==3	;UNIT 3 IS FIRST T-300 UNIT
	TM10P==1	;TM10 Tape code
	TCMXH=100.	;LA36
	LIGHTS==500	;KL-UDGE
	NDRIVE==6	;8 DOESN'T FIT IN 128K
	NUNITS==6
	];MCKL

 IFCE MCHN,MLKA,[
	;;; The original Mathlab machine (R.I.P.)
	KA10P==1
	FIRSPK==2
	LASTPK==3
	NUDSL==250.
	RP10P==1
	TCMXH=55.
	LIGHTS==4	;PI
	NLPTP=464
	];MLKA

 IFCE MCHN,DM,[
	;;; The Dynamod machine (R.I.P.)
	KA10P==1
	FIRSPK==17.
	LASTPK==21.
	NUDSL==200.
	RP10P==1
	TTLPTP==100
	TCMXH=55.
	LIGHTS==4	;PI
	NLPTP=464
	];DM

 IFCE MCHN,AIKA,[
	;;; The original ITS machine (R.I.P.)
	KA10P==1
	FIRSPK==1
	LASTPK==5
	NUDSL==440.
	DC10P==1
	TCMXH=55.
	LIGHTS==4	;PI
	NLPTP=464
	];AIKA

 IFCE MCHN,ITS,ITS==1
 IFCE MCHN,TS,ITS==1
 IFNDEF ITS,ITS==0
 IFN ITS,[
	ITS==1		;Timesharing version.
	KL10P==1	;Pretend to be KL10 I suppose.
	TM10P==0	;Don't bother with tape code.
	FIRSPK==0
	LASTPK==5
	TCMXH=79.
	LIGHTS==0
	NUDSL==500.
	TTYI==1		;TTY typein channel
	TTYO==2		;TTY typeout channel
	LPTC==3		;LPT channel
;Busted	NLPTP==1	;Pretend to have LPT
	QIN==4		;Disk input channel
        ];TS

IFNDEF FIRSPK,	.FATAL Unknown machine "MCHN"
TERMIN

IFNDEF NUDSL,	.FATAL Number of UFDs undeffd
IFNDEF LIGHTS,	.FATAL Lights undeffd

DEFINE TS
IFN ITS!TERMIN

DEFINE NTS
IFE ITS!TERMIN

IFNDEZ "Processor type",KA10P,KL10P,KS10P

IFNDEF T300P,T300P==0
IFNDEZ "Disk/control types",DC10P,RP10P,RH10P,RP06P,RP07P,RM03P,RM80P,ITS

;;; Select at most one kind of tape subsystem.

IFNDEF TM03P,TM03P==0
IFNDEF TM10P,TM10P==0
NTS, IFG TM10P+TM03P-1,.FATAL Too many tape controller types selected.
TS, IFN TM03P+TM10P,.ERR Tape code in timesharing SALV?
IFN TM03P, IFE KS10P, .FATAL TM03 Tapes only supported on KS10.
IFN TM10P, IFN KS10P, .FATAL TM10 on KS10?

IFNDEF CHAOSP, CHAOSP==0

DEFINE KA
IFN KA10P!TERMIN

DEFINE KL
IFN KL10P!TERMIN

DEFINE KS
IFN KS10P!TERMIN

DEFINE KLKS	;Code common to KL and KS machines.
IFN KS10P+KL10P!TERMIN

DEFINE KAKL	;Code common to KL and KA machines.
IFN KA10P+KL10P!TERMIN

DEFINE DC 	;Calcomp on Systems Concepts controller.
IFN DC10P!TERMIN

DEFINE RP	;RP03 on DEC controller.
IFN RP10P!TERMIN

DEFINE RH 	;RP04 on RH10 MASSBUSS controller.
IFN RH10P!TERMIN

RH11P==RP06P+RP07P+RM03P+RM80P

; "PH" stands for phucked, I guess...
DEFINE PH	;RP06 or RP07 or RM03 or RM80 on RH11 UNIBUS controller.
IFN RH11P!TERMIN

DEFINE RHPH	;Code common to RH10 and RH11.
IFN RH10P+RH11P!TERMIN

DEFINE DCRH	;Code common to DC10 and RH10.
IFN DC10P+RH10P!TERMIN

DEFINE SH	;Code common to drives with pack # in Sector Header
IFN DC10P+RH10P+RP06P!TERMIN

DEFINE T300	;Trident T300 on PDP11 "controller".
IFN T300P!TERMIN

DEFINE	TM10	;TM10A or TM10B tape subsystem.
IFN TM10P!TERMIN

DEFINE	TM03	;TM03 on RH11
IFN TM03P!TERMIN

DEFINE TMXX	;Any tape
IFN TM10P+TM03P!TERMIN

;;; Lineprinter definition.

IFNDEF OLPTP,	OLPTP==0
IFNDEF NLPTP,	NLPTP==0
IFNDEF TTLPTP,	TTLPTP==0

DEFINE LPT
IFN OLPTP+NLPTP+TTLPTP!TERMIN

DEFINE OLPT
IFN OLPTP!TERMIN

DEFINE NLPT
IFN NLPTP!TERMIN

DEFINE TLPT
IFN TTLPTP!TERMIN

];IF1

;;; Unless the "virtual drive" hack is being used, default the number
;;; of disk drives to the maximum possible and find out at run time how
;;; many there really are on-line with the right packs.

IFNDEF NDRIVE, NDRIVE==8	;# physical units
IFNDEF NUNITS, NUNITS==8	;# virtual units

SA=100*2000		;Our starting address.
NTS,DDT=MEMSIZ-4000	;Well-known address of Exec DDT.

.YSTGW			; OK, now you can output stuff

LOC SA			;Code begins assembling here.
	JRST GOGO	;Make easy to start from ITS.
SALVRT:	0		;System may JSR here.
	JRST SALVAG

;;; Device definitions.

IF2,[
KA,	INFORM KA-10 processor
KL,	INFORM KL-10 processor
KS,	INFORM KS-10 processor
TS	INFORM Runs under time-sharing (fake KL)

OLPT, INFORM Old LPT Interface
NLPT, INFORM New LPT Interface
TLPT, INFORM LPT on MTY line number ,\TTLPTP&77

TM03,	INFORM TM03/TUxx on RH11
TM10,	INFORM TM10A/B Magtape on IO Bus or Data Channel
];IF2
     
KA,[
APR==0			;Processor.
PI==4			;Interrupt system.
TTY==120		;TTY.
PTP==100		;Paper tape.
MTY==400		;Scanner.

;;; Disk channel program words.

DEFSYM SLVICWA=20
DEFSYM SLVIOWD=22

];KA

KS,[
;Include KS10 defs
EPT==:0			; This MUST be the same as in ITS itself!
HSB==:500
.INSRT SYSTEM;KSDEFS

PIOFF==: 000400		; Turn off PI system
PICLR==: 010000		; Clear PI system
APRCHN==:3		; APR channel.
];KS

KL,[
APR==0			;Processor.
PI==4			;Interrupt system.
PAG==10			;Pager.
T300,	DLB==60		;DL-10
 .ALSO 	DLC==64

;;; Include KL10 defs (DTE, DL10, etc).
.INSRT SYSTEM;EPT >
..D010==0

;;; Set up addr for the "DDT" KLDCP command.
ZZ==.
LOC EPTDDT
JRST DDT	;FOR 'DDT' COMMAND IN KLDCP
LOC ZZ

;;; Tell DDT about cache intructions.

SWPIA=701440,,0
SWPUO=701740,,0
SWPIO=701640,,0
SWPUA=701540,,0
];KL


;;; DL10 communications area in non-encached low core.
;;; Actual storage layout defined in ITS and in T300 defs.
T300,	DL10AR==500	

IF2,[
DC,	INFORM Systems Concepts disk control
RP,	INFORM RP03 on RP10 control
RH,	INFORM RP04 on RH10 MASSBUS control
IFN RP06P,	INFORM RP06 on RH11 UNIBUS control
IFN RP07P,	INFORM RP07 on RH11 UNIBUS control
IFN RM03P,	INFORM RM03 or RM02 on RH11 UNIBUS control
IFN RM80P,	INFORM RM80 on RH11 UNIBUS control
T300,	INFORM T-300 disk on PDP-11 control

ORADIX==10
RADIX 10.
INFORM Number of disk drives = ,\NDRIVES
;INFORM Number of virtual units = ,\NUNITS
RADIX ORADIX
];IF2

;;; Disk physical parameters.
DC,	.INSRT SYSTEM;DC10
RP,	.INSRT SYSTEM;RP10
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

TS,	NTUTBL==4	;Maximum number of blocks per TUT on any ITS

RHPH,[
	SECTOR==128.		;Disk sector size in PDP10 words.
SH,	HSECTOR==:SECTOR+2	; Two word header if pack # stored there
.ELSE,[
IFN RP07P, HSECTOR==:SECTOR+4	; RP07 has lots of sector header bits....
.ELSE,	HSECTOR==:SECTOR+1	; Else just one word
]
];RHPH

;;; File system parameters.
.INSRT SYSTEM;FSDEFS >

;;; Maybe T-300s too.
T300,	.INSRT SYSTEM;T300 >
T300, MXTUTB==NTUTB1	;MAXIMUM OF NTUTBL AND NTUTB1
.ELSE MXTUTB==NTUTBL


IF2,[
TS,[ ;;; Fake ITS file system definitions.
	NBLKS==10000.	;Fake
	TBLKS==10000.	;Fake
	MFDBLK==-1	;JUST TO AVOID UNDEF SYM ERROR, VALUE NEVER USED
;	TUTBLK==-1	;..
	TUTPAG==600000	;Read TUT by mapping in absolute page
	NBLKSC==47	;Fake blks/cyl
];TS
];IF2

DC,[
DEFINE QCOPY A,B
DCOPY A(-<B>_2&37774)!TERMIN
];DC



;;; Instructions

CALL=<PUSHJ P,>		;Procedure call.
X==<PUSHJ P,>		;(Old name for it.)
RET=<POPJ P,>		;Return.
CALRET==:JRST		;Tail-recursive call.
KA,   NOP=<JFCL>
.ELSE NOP=<CAI>
NTS, HALT=<JRST 4,>	;Halting.

TS,[
DEFINE	HALT NEWPC
	.CALL [SETZ ? SIXBIT /LOSE/ ? MOVEI 0 ? SETZI NEWPC]
TERMIN

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

DEFINE	EVAL SYM,PLACE
	MOVE T,[SQUOZE 0,SYM]
	.EVAL T,
	 .VALUE [ASCIZ ":Symbol initialization error"]
	MOVEM T,PLACE
TERMIN
];TS


;;; Initialize ACs

DEFINE	ACINIT
	SETZI 0,
	MOVEI P,1
	BLT P,P
	MOVE P,[-PDLLEN,,PDL-1]	;Init the stack.
TERMIN


;;; PUSHER/POPPER for saving/restoring ACs.

DEFINE PUSHER AC,LIST
IRP LOC,,[LIST]
PUSH AC,LOC
TERMIN
TERMIN

DEFINE POPPER AC,LIST
IRP LOC,,[LIST]
POP AC,LOC
TERMIN
TERMIN

;;; ROUND -  Check for a remainder in AC+1 and round AC up.
;;; Useful after IDIVI instructions.
	  
DEFINE	ROUND AC
	SKIPE AC+1
	 AOS AC
TERMIN

;;; HNRLZ - Halfword Negated Right to Left
;;; An idiom for making AOBJN pointers.

DEFINE	HNRLZ AC1,AC2
	MOVN AC1,AC2
	HRLZ AC1,AC1
TERMIN


;;; Approximate time delays.

; In theory DELAY should have different values on different CPUs.
; In practice, this macro isn't worth much, since people don't really
; compute these things this accurately.  If I were to fix this to
; -really- delay 4 US when you asked for such a delay, then (on the KL)
; it would actually delay considerably -less- than it does now.
; Better just leave it alone and on the KS the delays will just be
; longer...
DEFINE DELAY SCALE,TIM
IFCE SCALE,MS, MOVEI Z,2000.*TIM
IFCE SCALE,US, MOVEI Z,TIM
	SOJG Z,.
TERMIN

;;; PUNT, BARF, and ERR  are various flavors of copping out.

IF2, PUNT=:JRST TODDT
IF2, BARF=:JRST ERRDDT

DEFINE	ERR
	SKIPE GOGOX
	 BARF
TERMIN



SUBTTL	I/O Utilities

;;; LIGHTUP for hacking console lights.

IFN LIGHTS,[
LIGHTUP=:DATAO LIGHTS,
]
IFE LIGHTS,[
LIGHTUP==:NOP
]

;;; RHQGET and RHQSET hack the disk controller registers.

RHPH,[

DEFINE	RHQGET REG
	MOVSI A,REG
	CALL RHGET
TERMIN

DEFINE	RHQSET REG,<ADR>
	MOVSI A,REG		;LH A gets addr of IO ptr
	HRR A,ADR		;RH A gets the data.
	CALL RHSET
TERMIN
];RHPH


;;; QCNVT - Convert physical unit number to virtual unit number.
;;; A/ physical unit number
;;; Returns in B the virtual unit number (from QTRAN).
;;; Non-skip means unit was unknown to QTRAN.

QCNVT:	MOVSI B,-NUNITS
	CAMN A,QTRAN(B)
	 AOBJN B,.-1
	JUMPGE B,CPOPJ		; Not found, don't skip
	MOVEI B,(B)		; Found, extract virtual unit number
	JRST POPJ1		;  and skip


;;; FINDPK - Find unit pack is mounted on.
;;; (QPKN must be set up.)
;;; Takes in C the pack number and returns in C the unit number.
;;; Returns -1 if pack not mounted.

FINDPK:	PUSH P,B
	MOVEI B,NUNITS-1	;This many units.
FINDP1:	CAMN C,QPKN(B)		;This pack?
	 JRST [	HRRZ C,B	; Yes, get unit #.
		JRST FINDP9 ]	; Return it in C.
	SOJGE B,FINDP1		;Else keep looking.
	SETOM C			;When bored, fail.
FINDP9:	POP P,B
	RET



DBG,[
;;; Zap the buffer in A, length in C.

BUFZAP:	SETZM (A)
	HRLI T,(A)
	HRRI T,1(A)
	ADDI C,-1(A)
	BLT T,(C)
	PUNT
];DBG

;;; Include ALAN's winning FORMAT package.  Yow!

DEFINE	TYPE S,&STRING&,ARGS
	CALL [	CALL FMTIN
		ZZZ==-1
	IRP ARG,,[ARGS]
		PUSH P,ARG
		ZZZ==.IRPCNT
	TERMIN
		HRROI A,[ASCII STRING]
		MOVEI B,.LENGTH STRING
		MOVNI C,ZZZ+1
		CALRET FORMAT"FORMAT ]
TERMIN


FMTIN:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,[FMTOUT]
	JRST @-4(P)

FMTOUT:	POP P,C
	POP P,B
	POP P,A
	POP P,(P)
	RET

;;; LOSE dumps us into DDT.

DEFINE	LOSE &STRING&,ARGS
	CALL [	TYPE T,STRING,[ARGS]
		BARF ]
TERMIN

;;; If FORMAT runs into problems it should LOSE to!

EQUALS FORMAT"FMTERR,LOSE

;;; QLOSE does a GSTS before going to DDT.

DEFINE	QLOSE &STRING&,ARGS
	JRST [	TYPE T,STRING,[ARGS]
		CALL GSTS
		BARF ]
TERMIN

;;; ASKYN uses format to query for a Y or N response.

DEFINE ASKYN &STRING&,ARGS
	CALL [	TYPE T,STRING,[ARGS]
		JRST YORNP ]
TERMIN


$$IERR==1		;Handle errors ourselves.
$$PFN==0		;Don't bother
$$ERRS==0		;No ERR: device available
$$ENGL==0		;English numbers feature
$$ITAB==1
$$UTAB==0		
NTS, $$ITS==0		;Nothing above us
NTS, $$PCODE==0		;No ^P handler in OUTSTR
TS,  $$ITS==1		;(unless under timesharing)
TS,  $$PCODE==1
.INSRT SYSENG;FORMAT

;;; CRR outputs just a carriage return.
;;; LPRCRR of course does it on the LPT.
;;; LPRTAB tabs on the LPT.

CRR=:CALL .
$CRR:	TYPE T,"~%"
	RET

LPRCRR=:CALL .
$LPCRR:	TYPE LPT,"~%"
	RET

LPRTAB=:CALL .
$LPTAB:	TYPE LPT,"	"
	RET


;;; OUTSTR  - Outputs a string on the system console
;;; This is called by the FORMAT package.
;;; A/ byte ptr
;;; B/ count of chars

TS,[
OUTSTR:	SYSCAL SIOT,[MOVEI TTYO ? A ? B]	;Type out a string.
	 .LOSE %LSSYS
	RET
];TS

NTS,[
OUTSTR:	JUMPE B,CPOPJ
	ILDB T,A		;Get a charater
	CAIN T,^M		;Dig ^M (but not ^H or others.)
	 JRST [	CALL TYO
		SETZM CTYXH	; Zero the pos.
		JRST OUTST6 ]
	MOVE T,CTYXH		;Else count the char.
	CAIL T,TCMXH		;If we are going to overrun
	 JRST [	MOVEI T,^M	; CR
		CALL TYO
		MOVEI T,^J	; LF
		CALL TYO
		SETZM CTYXH	; Zero the pos.
		JRST .+1]
	LDB T,A			; Restore T
	CALL TYO		;Type it out.
OUTST6:	SOJG B,OUTSTR		;Loop for B chars.
	RET			;Does not skip.
];NTS

;;; GETPOS reads our horizontal cursor position for FORMAT.

NTS,[
GETPOS:	MOVE A,CTYXH
	RET
];NTS

TS,[
GETPOS:	SYSCAL RCPOS,[MOVEI TTYO ? MOVEM A]
	 MOVEI A,-1
	HRRE A,A
	RET
];TS

     
;;; TYO types character on the console TTY.
;;; T/ char to type
;;; Bashes no ACs; Never skips.

LINPOS::
CTYXH:	0			;CTY horizontal cursor position.

TYO:
TS,	.IOT TTYO,A
NTS,[
	AOS CTYXH		; Track horizontal position.
KA,[	CONSZ TTY,20
	 JRST .-1
	DATAO TTY,A
];KA
KL,[	PUSH P,T
	ANDI T,177
	CALL DTEXIO
	POP P,T
];KL
KS,[	PUSH P,T
	ANDI T,177		;ASCII only.
	IORI T,400		;Set CTY-char-pending
	MOVEM T,8CTYOT		;Store in comm area
	CONO 80INT\APRCHN
	SKIPE 8CTYOT		;Wait for completion
	 JRST .-1
	POP P,T
];KS
];NTS
	RET


;;; TYI - Read character from console TTY.
;;; Skip returns with char in T, else fails.

TYI:
TS,	.IOT TTYI,T
NTS,[
KA,[	CONSO TTY,40
	 RET
	DATAI TTY,T
];KA
KL,[	MOVEI T,3400		;DDT mode input req
	CALL DTEXIO
	JUMPE T,CPOPJ
];KL
KS,[	SKIPN T,8CTYIN		;Chars stored here by 8080.
	 RET
	SETZM 8CTYIN		;Remember to clear it.
];KS
	ANDI T,177		;ASCIIfy.
	CALL TYO		;Echo it.
];NTS
	CAIE T,^C		; General punting feature...
	 CAIN T,^Z
	  PUNT
	JRST POPJ1

;;; DTE20 Communication Routine ...( copied from DEC "SUBRTN" program.)

KL,[
DTEXIO:	SETZM DTEFLG
	MOVEM T,DTECMD
	SETZM DTEF11
	CONO DTE,%DBL11
	SKIPN DTEFLG
	 JRST .-1
	SETZM DTEFLG
	MOVE T,DTEF11
	RET
];KL

;;; TYIPSE - Return to DDT if character typed.

TYIPSE:	
TS,[	.LISTEN T,
	JUMPE T,CPOPJ
];TS
	CALL TYI
	 RET
	PUNT


;;; NTYI reads a digit into A and should skip.

NTYI:	CALL TYI
	 JRST NTYI
	MOVE A,T
	CAIL A,"0
	CAILE A,"9
	 RET
	SUBI A,"0
	JRST POPJ1


;;; DTYI reads a decimal number into A.
;;; OTYI reads an octal number into A.
;;; Never skips.

DTYI:	PUSH P,B
	MOVEI B,0
DTYI1:	CALL NTYI
	 JRST DTYI2
	IMULI B,10.
	ADD B,A
	JRST DTYI1

DTYI2:	MOVE A,B
	POP P,B
	RET 

OTYI:	PUSH P,B
	MOVEI B,0
OTYI1:	CALL NTYI
	 JRST DTYI2
	LSH B,3
	ADD B,A
	JRST OTYI1

;;; 6TYI - Sixbit input into B and don't skip.


6TYI:	PUSHER P,[A,C]
	MOVE C,[440600,,B]
	MOVEI B,0
6TYL:	CALL TYI
	 JRST 6TYL
	MOVE A,T
	CAIN A,^M
	 JRST 6TYI9
	TRZN A,100
	 TRCA A,40		; Sixbitify character
	 TRO A,40
	JUMPLE A,6TYI9
	TLNE C,77^4
	 IDPB A,C
	JRST 6TYL
6TYI9:	POPPER P,[C,A]
	RET


;;; Y or N querying.
;;; Returns for negative, skips for affirmative.
;;; Groks Y,N in either case, and  SPACE,RUBOUT.

YORNP:	TYPE T," (Y or N) "
	CALL TYI
	 JRST .-1
	CAIN T,177
	 JRST CPOPJ
	CAIN T,40
	 JRST POPJ1
	CAIN T,"Y
	 JRST POPJ1
	CAIN T,"N
	 JRST CPOPJ
	CAIN T,"y
	 JRST POPJ1
	CAIN T,"n
	 JRST CPOPJ
	TYPE T,""
	JRST YORNP

;;; RFNAME - Read File Names
;;; Prompts with  the default and reads new filename.
;;; Sets up filename block in B

RFN"$$RFN==:1
RFN"$$RUC==:1
.INSRT DSK:SYSENG;RFN

RUC:	CALL TYI
	 JRST RUC
	MOVE A,T
	CAIL A,"a
	 CAILE A,"z
	  RET
	SUBI A,"a-"A
	RET

RSIXTP:	CAIE A,177
	 CAIN A,33
	  AOS (P)
	RET

RFNAME:	PUSHER P,[A,C,D,E]
RFNM1:	TYPE T,"~&   ~F    ",B
	CALL RFN"RFN
	CAIE A,177
	 CAIN A,33
	  JRST RFNM1
	POPPER P,[E,D,C,A]
	RET

SUBTTL	Crufty LPT routines

NOLPT:	0	;-1 for no LPT
LPBUST:	0	;-1 LPT is busted don't keep asking

;;; UPLPT - Up your LPT!

UPLPT:	
LPT,[	.ERR If you want to use the LPT, you'll have to fix this code.
	SKIPE LPBUST		;If known to be busted
	 JRST UPLP9		; flush this noise.
	SKIPE NOLPT		;If no LPT wanted
	 JRST UPLP9		; don't bother loser again.
	SETOM NOLPT		;Assume no LPT wanted.
	SETOM LPFRST'		;Find out what user wants.
	ASKYN "Want LPT"
	 CAIA
TS,[	JRST [ASKYN "~&Want LPT output to DSK?"
	        CALRET [ SYSCAL OPEN,[%CLBIT,,.UAO
				%CLIMM,,LPTC
			 	[SIXBIT /LPT/]]
			  .LOSE %LSFIL
			 SETZM NOLPT
			 SETZM LPBUST
			 RET ]
	      SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,LPTC
				[SIXBIT /DSK/]
				[SIXBIT /NSALV/]
				[SIXBIT /OUTPUT/]]
		 .LOSE %LSFIL
	      RET ]
];TS
LPTUP2:	
NTS, 	LOSE "~&Only REAL programmers use line printers."
];LPT
UPLP9:	RET


SUBTTL	Misc.

POPJ1:	AOS (P)
CPOPJ:	RET

POPBAJ:	POP P,B
POPAJ:	POP P,A
	RET

POPBJ:	POP P,B
	POPJ P,

POPTJ:	POP P,T
	RET

CONTIN:	ASKYN " Continue"
	 RET
	JRST POPJ1

UUOHLT:
KA, 	0			;KA10 JSRs here.
	LOSE "~&UUO in Salvager??"

KL, SALVPF: LOSE "~&Page failure in Salvager. PC=~H PFW=~H",[PFOPC,EPTPFW]

KS, SALVPF: LOSE "~&Page failure in Salvager. PC=~H PFW=~H",[EPTPFO,EPTPFW]

ERRDDT:	TYPE T,"~&*** ERROR *** THE SYSTEM MAY NOT BE BROUGHT UP"
ERRDD1:	SETZM SALVRT		;Can't return to system.
TODDT:	TYPE T,"~2&"		;Get us to a fresh line please.
	SKIPE SALVRT		;If invoked from another system
	 JRST @SALVRT		; jump back into it.
	TYPE T,"DDT"
	SKIPN DDT		;Something where DDT should be?
	 HALT .			; No.
	JRST DDT		;Yes - imagine it is DDT and jump into it.

ZAPLUZ:	LOSE "Lossage."		;Quick and losing way to DDT.

TS,[
DDT:	.BREAK 16,100000
	JRST DDT
];TS

SUBTTL	Main Program

;;; Vector Of Mysteries (in case up creek without symbol table)

GOGO: 	JRST [ 	JSR INIT ? JRST GOGO2 ]
SALVAG:	JRST [	JSR INIT
		SETOM NOQUES	;If started by BEG$G in ITS, be fast
		JRST GOGO2 ]	;(no routine typeout)

CHKR:	JRST CHKR0
	NOP LPBUST		;-> LPT BUSTED FLAG
	NOP NOQUES		;-> NO QUESTIONS FLAG
	NOP GOODUN		;-> ONLY RTN THAT KNOWS WHICH ARE "RIGHT" PACKS
	NOP GETSTS		;-> ROUTINE TO TYPEOUT CURRENT DISK STATUS
	NOP DSKTST		;-> SIMPLE READ/WRITE TEST
	NOP SEKTST		;-> SIMPLE SEEK TEST (READ ONLY)
	NOP DUP			;-> DISK COPYING ROUTINE
	NOP HCRASH		;-> AS FAST AS POSSIBLE FLAG


INIT:	0
	ACINIT
TS,[	.CLOSE TTYI,		;If under timesharing, open TTY.
	.CLOSE TTYO,
	SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI  ? [SIXBIT /TTY/]]
	 .LOSE %LSFIL
	SYSCAL OPEN,[%CLBIT,,.UAO+%TJDIS ? %CLIMM,,TTYO ? [SIXBIT /TTY/]]
	 .LOSE %LSFIL
];TS

NTS,[
KA,[	CONO 675550		;Reset APR
	CONO PI,710000		;Reset PI
	MOVE TT,[JSR UUOHLT]	;Halt on UUOs.
	SKIPN 41
	 MOVEM TT,41
	MOVEI A,SA		;Ensure all necessary memory is present.
INIT0:	MOVE B,(A)
	CONSZ 10000
	 LOSE "~%NXM in Salvager memory"
	ADDI A,2000
	CAIGE A,THEEND
	 JRST INIT0
];KA

KS,[	CLRCSH			;Clear the cache.
	WRPI PICLR\PIOFF	;Turn off interrupts.
	WRHSB [HSB]		;Set up the halt status block.
	WREBR 400000+<EPT/PG$DEC> ;ITS paging, Off, set up EPT.
	WRUBR [100^9+EPT]	;UPT=EPT
	MOVEI TT,SALVPF		;Routine to call upon page failures.
	MOVEM TT,EPTPFN
	MOVEI TT,UUOHLT		;Routine to call upon exec mode UUO.
	SKIPN EPTUEN
	 MOVEM TT,EPTUEN
	MOVEI A,SA		;Ensure all necessary memory is present.
INIT0:	MOVE B,(A)		;Touch a page.
	CONSZ 400		;NXM?
	 LOSE "~%NXM in Salvager memory"
	ADDI A,2000		;Nope, go to next page.
	CAIGE A,THEEND
	 JRST INIT0
];KS

KL,[	SETZM DTEOPR		;BTB IF QUIT OUT AND RESTART
	CONO 267760		;I/O reset, clear + disable all flags
	CONO PI,010000		;Clear PI system
	CONSO PAG,600000	;If cache off
	 SWPIA			; invalidate entire cache.
	CONSZ PAG,600000	;If cache on
	 SWPUA			; unload entire cache.
	CONSZ 200000		;Clear the entire cache.
	 JRST .-1
	MOVEI TT,SALVPF		;Set to halt on page fail (e.g. parity error)
	MOVEM TT,PFNPC
	CONO PAG,600000+EPT/PG$DEC	;Set up EPT, enable cache,
					;Disable paging and traps.
	DATAO PAG,[100000,,400000+EPT/PG$DEC]	;UPT=EPT
	MOVEI TT,UUOHLT
	SKIPN EPT+430		;Halt on kernel UUO
	 MOVEM TT,EPT+430
	MOVEI A,SA		;Ensure all necessary memory is present
INIT0:	MOVE B,(A)
	CONSZ 2000
	 LOSE "~%NXM in Salvager memory"
	ADDI A,PG$DEC
	CAIGE A,THEEND
	 JRST INIT0
];KL
];NTS

TS,[	.CORE <THEEND+1777>_-12	;Make core exist.
	 .VALUE [ASCIZ ":Can't get core."]
	EVAL NQS,NQS		;Find # disks this machine.
	EVAL QACT,SQACT		;Find active unit table.
	EVAL NUDSL,NUDS		;Find # special blocks.
	EVAL MFDBLK,MFDBK	;Find MFD block.
	EVAL NTUTBL,B		;Find NTUTBL.
	MOVEI C,NUNITS-1
	MOVEM B,NTBL(C)
	SOJGE C,.-1
	CAILE B,MXTUTB
	 .VALUE	[ASCIZ ":Not assembled for big enough TUTs"]
	MOVE B,[SQUOZE 0,T300P]	;Need kludges for 2 sizes OF TUT.
	.EVAL B,
	  MOVEI B,0
	JUMPE B,INI03
	EVAL NTUTB1,C
	CAILE C,MXTUTB
	 .VALUE	[ASCIZ ":Not assembled for big enough TUTs"]
	MOVEM C,NTBL(B)
	CAIGE B,NUNITS-1
	 AOJA B,.-2
INI03:	EVAL NBLKS,SNBLKS
	MOVE A,SNBLKS
	SUBI A,1
	MOVEM A,SNBLKS-1
];TS

NTS,[
KL,[
RH,[	CONI DSK,TT
	TLNN TT,(%HID22)
	 LOSE "~%SALV: The DF10 is in KA mode"
];RH
IFN T300,[			;Turn on DL10 to access T-300
	CONO DLC,400000		;MR CLR
	CONO DLB,1		;Turn off excess lights
	CONO DLB,2		;..
	CONO DLB,3		;..
	CONO DLB,DL10AR		;64 words for pdp11 #0 at DL10AR
	DATAO DLC,[200001,,]	;KA interrupt mode
	CONO DLC,100020		;Enable pdp11 port #0 no interrupts
];T300
];KL

INIT2:
DC,	SETZM ENCS
RH,	SETZM MARKF
RP,[	DATAI DPC,A
	TLNN A,NOWRIH
	 TYPE T,"~%[RP Write Headers enabled]"
];RP
];NTS
KAKL,[	MOVEI A,SLVIOWD		;Set up channel program area
	MOVEM A,SLVICWA
	SETZM SLVIOWD+1
	SETZM SLVICWA+1
];KAKL
	SETOM DRIVE		;For now, assume all drives on-line.
	MOVE A,[DRIVE,,DRIVE+1]
	BLT A,DRIVE+NDRIVE-1
	MOVEI A,NUNITS-1	;Say TUTs not in yet
	SETOM QPKN(A)
	SOJGE A,.-1
	SETZM GOGOX		;Not in automatic mode.
	SETZM NOQUES		;Ask questions.
NTS,[
TM10,[	CONSZ MTC,7		;If Data Channel Magtape subsystem?
	 SETOM TMDCP
];TM10
];NTS
	CALL UPLPT		;Turn on lineprinter if any.
INIT99:	JRST @INIT		;End of initialization.


CHKR0:	JSR INIT		;Ask questions mode.
	TYPE T,"~2&Salvager ~S~&",[VERSHN]
	MOVEI A,NUNITS-1
	SETZM QACT(A)
	SOJGE A,.-1
	TYPE T,"~&Active unit numbers? "
CHKR1:	CALL NTYI		;Get a digit.
	 JRST CHKR2
	CAIGE A,NUNITS
	 SETOM QACT(A)
	JRST CHKR1

CHKR2:	CALL ACTUN
CHKR3:	TYPE T,"~&Use MFD from unit: "
	CALL NTYI
	 JRST CHKR3
	CAIGE A,NUNITS
	 SKIPN QACT(A)
	  JRST CHKR3
	MOVEM A,MDSK
	CALL DRPHAS		;Verify all dirs on all packs are in phase.
	SETZM CKFLSW
	SETZM CKFIX
DC,	ASKYN "~&Check files for clobbered blocks?"
.ELSE	ASKYN "~&Read all blocks of all files?"
	 CAIA
	  SETOB A,CKFLSW
	JUMPGE A,CHKR4
DC,[	SETZM CKFIX
	ASKYN "~&Fix pointers then?"
	 CAIA
	 SETOM CKFIX
];DC
CHKR4:	TYPE T,"~&Get user dirs from unit: "
	CALL NTYI
	 JRST CHKR4
	CAIGE A,NUNITS
	 SKIPN QACT(A)
	  JRST CHKR4
	MOVEM A,UDSK
	CRR
	JRST SALV1

GOGO2:	TYPE T,"~2&Salvager ~S~&",[VERSHN]
	SETOM GOGOX		;Automatic mode.
	MOVEI A,NUNITS-1	;Assume all units are active.
	SETOM QACT(A)
	SOJGE A,.-1
	CALL ACTUN		;Activate all units that are really on-line.
	CALL GOODUN		;Ensure that packs are mounted.
	MOVEM I,MDSK		;First active unit (to get MFD and UFD from).
	MOVEM I,UDSK
	CALL DRPHAS		;Verify that UFDs on all packs are in phase.
	SETZM CKFLSW		;Don't check all blocks.
	JRST SALV1


SUBTTL	Activating the Disks

;;; RSTALL - Reset all active disks

RSTALL:	PUSH P,I		;Don't smash I.
	MOVEI I,0		;Start with lowest disk.
RSTAL1:	SKIPE QACT(I)		;If it is active
	 CALL RESET		; reset it.
	CAIGE I,NUNITS-1	;Do this for all disks.
	 AOJA I,RSTAL1
	POP P,I
	RET

;;; ACTUN - Activate all units which are on line.

ACTUN:	MOVEI C,NUNITS-1
ACTUN2:	SKIPN QACT(C)
	 JRST ACTUN1
	MOVE I,C
	CALL RESET
	SKIPN QACT(C)		;Still there?
	 JRST ACTUN1
	MOVE I,C
	MOVE A,QOTUTO(I)
	CALL RDTUT
	JUMPL T,ACTUE1
	MOVE I,QOTUTO(C)
	MOVE A,QPKNUM(I)
	ANDI A,37
	MOVEM A,QPKN(C)
	SKIPE NOQUES
	 JRST ACTUN1
	MOVE A,QPAKID(I)
	MOVE B,QPKNUM(I)
	TYPE T,"~&Unit #~D. ID is ~S, Pack #~D",[C,A,B]
SH,[
	MOVE A,PKNUM(C)		;If we have hardware pack number
	CAMN A,QPKNUM(I)	; don't bother if they agree.
	 JRST ACTUN4		;Print 'em if virtual units.
T300,[	CAIL C,T300P		;If hacking T-300s,
	 JRST ACTUN4		; PKNUM not really set up.
];T300
	TYPE T," (hardware says ~D.)",[A] 
];SH
ACTUN4:	SKIPN A,QTRSRV(I)
	 JRST ACTUN5
	CAMN A,[-1]
	 JRST [	TYPE T,"(Reserved)"
		JRST ACTUN5 ]
	TYPE T," ~S:",[A]
ACTUN5:	CRR
ACTUN1:	SOJGE C,ACTUN2
	SETOM ACTIVE
	RET


NTS,[

;;; GOODUN - Make sure all necessary packs are mounted
;;; Returns master disk # in I.

GOODUN:	MOVEI A,FIRSPK
GOODN1:	MOVEI C,NUNITS-1
GOODN2:	SKIPE QACT(C)
	 CAME A,QPKN(C)
	  SOJGE C,GOODN2
	SKIPGE C
	 LOSE "~&Pack #~D not mounted.",[A]
	CAIGE A,LASTPK
	 AOJA A,GOODN1
	MOVEI A,LASTPK-FIRSPK+1	;Number of primary packs.
	MOVEI C,NUNITS-1	;Scan for secondary packs.
GOODN4:	SKIPN QACT(C)
	 JRST GOODN5
	MOVE B,QOTUTO(C)
	SKIPE B,QTRSRV(B)
	 CAMN B,[-1]
	  JRST GOODN5
	ADDI A,1		;This secondary pack is ok to have mounted.
GOODN5:	SOJGE C,GOODN4
	MOVEI C,NUNITS-1	;Find master disk (lowest numbered active unit)
	SKIPE QACT(C)		;Compute good packs - all packs in A.
	 JRST [	MOVE I,C
		SOJA A,.+1 ]
	SOJGE C,.-2
	JUMPGE A,CPOPJ
	LOSE "~&Extra packs mounted."
];NTS

TS, GOODUN: RET


SUBTTL	SALVATION - Main Salvager

;;; DRPHAS - Check that directories are in phase on all packs
.SEE MDNUM	

NTS,[
DRPHAS:	MOVEI I,NUNITS-1	;This many disks.
DRPHS1:	SKIPN QACT(I)		;First, get all the MFDs.
	 JRST DRPHS2		; When gots, check phase.
	MOVE J,MFDBK		;Find where MFD block will be on disk.
	MOVE A,QNTUTO(I)	;Ptr to this disk's MFD in core.
	CALL READ		;Slurp.
	JUMPL T,ACTUE3		; Eh?
DRPHS2:	SOJGE I,DRPHS1		;Hack next disk.
	MOVE I,MDSK		;Get MFDs from here.
	MOVE A,@QNTUTO(I)	;Get that ascending directory number.
	MOVE B,A		;Don't bash it.
	SUBI B,1		;Allowed to be off at most by 1 less.
	MOVEI I,NUNITS-1	;Now compare againts the other MDNUMs.
DRPHS3:	SKIPE QACT(I)		;Only check disks which are active.
	 JRST [	CAMG B,@QNTUTO(I)
		 CAMGE A,@QNTUTO(I)
		  JRST DRPHS6	; Looks bad.
		JRST .+1 ]	;Else check next MDNUM.
	SOJGE I,DRPHS3
	RET

DRPHS6:	TYPE T,"~&Directories out of phase."
	MOVEI I,0		;Start with lowest numbered disk.
DRPHS4:	SKIPN QACT(I)		;If not active
	 JRST DRPHS5		; check next disk.
	HRRZ A,I		;Unit number.
	MOVE B,QPKN(I)		;Get pack number.
	MOVE C,@QNTUTO(I)	;Get MDNUM.
	TYPE T,"~&Unit #~O, Pack ~D. Ascending dir number is ~O",[A,B,C]
DRPHS5:	CAIGE I,NUNITS-1	;All disks mentioned?
	 AOJA I,DRPHS4		; No, do next one.
	TYPE T,"~&Verify that the proper packs are mounted.~@
		  If you aren't sure, get help.  If they are proper,~@
		  and one is just coming on-line after being off for~@
		  a while, you will have to UCOP to it."
	ERR
	RET

];NTS

TS, DRPHAS: RET


;;; SALV1 - Main entrypoint for salvaging.
;;;
;;; Rebuilds TUTs, Checks NUDSLs; Garbage collects empty UFDs.

SALV1:	SETZM MFDWRT		;MFD not hacked yet (ie., no UFDs GC'd)
	SETZM SHARED		;No shared blocks found yet.
	MOVEI I,NUNITS-1	;# disks.
SALV2:	SKIPN QACT(I)		;Frob only active disks.
	 JRST SALV3
	HRRZ B,QNTUTO(I)	;Gonna rebuild the TUT.
	HRL B,B			;Ptr to new TUT.
	SETZM (B)		;Gonna zap new TUT.
	MOVE A,B
	AOS B
	BLT B,2000*MXTUTB-1(A)	;Fresh slate.
	HRRZ B,QNTUTO(I)	;Ptr to old TUT.
	HRL B,QOTUTO(I)
	MOVE A,B
	BLT A,LTIBLK-1(B)	;Copy random info from old TUT to new.
	HRRZ A,QNTUTO(I)
	CALL TUTFIL		;Fill in blocks area of TUT.
SALV3:	SOJGE I,SALV2		;Do all active TUTs.
	MOVE I,MDSK		;Get master disk.
	MOVEI A,MFD		;Want an MFD.
	MOVE J,MFDBK		;Block on disk.
	CALL READ		;Get it.
	JUMPL T,ACTUE3		; Bogus QACT?
	SETZM LUFDS		;No UFDs checked yet.
	MOVE A,MFD+MDNUDS	;Check NUDSLs.
	CAME A,NUDS
	 LOSE "~&Wrong NUDSL:  ~D.",[A]
	MOVE A,MFD+MDCHK	;Get check word.
	CAME A,MFDCHK		;OK?
	 JRST [ TYPE T,"~&MFD check word garbaged? ~S",[A]
		SKIPN GOGOX	;Unless in automatic mode
		 CALL CONTIN	; Ask user if we should bother.
		  BARF		;  Otherwise lose now.
		JRST .+1]	; Keep going.
	MOVE Q,MFD+MDNAMP	;Now check name area.
	ADDI Q,MFD		;Ptr to it.
MFDLUP:	CAIL Q,MFD+2000		;Past name area?
	 JRST MFDFIN		; Yes, done.
	SKIPN A,MNUNAM(Q)	;User name?
	 JRST MFDLU1		; No, try next name.
	CALL USRLUP		;Look up UFD.
	SKIPN LFILES		;Gots any files?
	 CALL DELUSR		; No, GC this directory.
MFDLU1:	ADDI Q,LMNBLK		;Check next name in MFD.
	JRST MFDLUP		;Loop for all names.



SUBTTL	Main Salvager - Write MFD & TUT

MFDFIN:	SKIPE NOISE
	 TYPE T,"~&Checking TUT differences."
	MOVEI I,0		;Use disk zero.
MFDFN0:	SKIPE QACT(I)		;If it is active
	 CALL TUTCMP		; compare TUTs.
	CAIGE I,NUNITS-1	;Compared all units?
	 AOJA I,MFDFN0		; No, keep trucking.
	SKIPN MFDWRT		;If te MFD does not need writing
	 JRST SHARCK		; proceed directly to hack shared blocks.
MFDWR0:	SKIPE NOQUES		;Else maybe ask permission from user.
	 JRST MFDWR1		; If in no-questions mode just do it.
	ASKYN "~&Write out changes in MFD"
	 JRST SHARCK		; Use may elect not to update MFD (ha!)
MFDWR1:	MOVE J,MFDBK		;OK, gonna write out the MFD.
	MOVEI I,NUNITS-1	;On each unit.
MFDWR2:	MOVEI A,MFD		;MFD in core.
	SKIPE T,QACT(I)		;For each active disk
	 CALL WRITE		; Write out the MFD.
	SKIPGE T		;  Oh, shit.
	 JRST [ TYPE T,"~&Error writing out the MFD:~%"
		CALL GSTS	;  Print controller status.
		SKIPE GOGOX	;  If in automatic mode
		 BARF		;    just lose.
		JRST MFDWR0 ]	;  Else ask if we should proceed.
MFDWR3:	SOJGE I,MFDWR2		;Loop for all disks.
				;Fall in to SHARCK.

SUBTTL	Main Salvager - Track Down Shared Blocks

SHARCK:	SKIPN SHARED		;Any shared blocks?
	 JRST [	SKIPE NOISE	; No, all done!
		 TYPE T,"~&Done Salvaging ~D user directories.",[LUFDS]
		PUNT ]
	TYPE T,"~&Tracking down shared blocks."
	MOVE I,MDSK		;Get master disk.
	MOVEI A,MFD		;Gonna get an MFD from it.
	MOVE J,MFDBK		;Into the usual place.
	CALL READ		;Read it.
	JUMPL T,ACTUE3		; Bogus QACT?
	MOVE Q,MFD+MDNAMP	;Fetch name pointer.
	ADDI Q,MFD		;Check user name blocks.
SMFDLP:	CAIL Q,MFD+2000		;When checked them all
	 JRST SHRCKF		; Yow, are we confused yet!
	SKIPN A,MNUNAM(Q)	;Get username.
	 JRST SMFDL1		; Missing? Try next.
	CALL SUSRLP		;OK, check.
SMFDL1:	ADDI Q,LMNBLK		;Next name block.
	JRST SMFDLP		;Loop for all name blocks.

SHRCKF:	SKIPN GOGOX		;Hmmm, thought there were
	 PUNT			;shared blocks but could 
	BARF			;not find them.

;;; SUSRLP - Check for shared blocks.
;;; Q/ MFD ptr to UFD we are hacking

SUSRLP:	HRREI J,-MFD-2000(Q)	;Convert MFD index to block number.
	ASH J,-1
	ADD J,NUDS
	MOVEM A,USRNAM		;Remember UFD we're hacking.
	PUSH P,Q
	MOVE I,UDSK
	PUSH P,UDSK
SUSRL1:	MOVEI A,OUSRD
	CALL READ		;Read it in.
	JUMPGE T,SDIRL1		;OK.
	MOVEM J,DBLK		;Remember which block.
	TYPE T,"User Directory parity error block #~D, unit ~D~%",[DBLK,I]
	CALL GSTS		;Print controller status.
	ERR
	ASKYN "Try next drive"
	 BARF
	MOVE I,UDSK		;Start with disk read UFD from.
SUSRER:	AOS I			;Try next one.
	CAIL I,NUNITS		;If no next one
	 SUBI I,NUNITS		; try counting down instead.
	SKIPN QACT(I)		;Make sure it's active.
	 JRST SUSRER
	MOVEM I,UDSK		;OK, it's active
	MOVE J,DBLK		;Block where UFD 
	JRST SUSRL1		;Try UFD from this disk.

SDIRL1:	MOVEI Q,2000-LUNBLK+OUSRD
	MOVEI J,OUSRD		;Examine UFD.
	ADD J,UDNAMP(J)		;Ptr to name area.
	PUSH P,J		;Popped off later.
SDIRL2:	CAML Q,J		;Checked last file?
	 JRST SDIRL3		; No, keep going
SUSRFN:	POP P,J			;All done.
	POP P,UDSK
	POP P,Q
	RET

SDIRL3:	MOVEM Q,LASTQ		;Check this file.
	SKIPE A,UNFN1(Q)	;Get FN1.
	 JRST .+3
	  SKIPN UNFN2(Q)	;Get FN2.
	   JRST SDIRLP		;Missing filename - try next file.
	LDB C,[UNPKN UNRNDM(Q)]	  ;Get pack the file is on.
	LDB A,[UNDSCP UNRNDM(Q)]  ;Get ptr to descriptor.
	IDIVI A,UFDBYT		;Number of bytes.
	ADDI A,OUSRD+UDDESC
	HLL A,QBTBLI(B)
	TLNE A,400000		;Ptr into UFD.
	 SUB A,[440000,,1]	; (Starts before first byte.)
	MOVE N,A
	MOVEI J,0
	ILDB B,A		;Get byte.
SDIRL4:	MOVE E,UNRNDM(Q)	;Get random bits.
	TLNE E,UNLINK		;If this is a link
	 JRST SDIRLP		; do next file.
	CALL FINDPK		;Where is the pack mounted.
	SKIPL C
	 SKIPN QACT(C)		;Make sure drive is active.
	  JRST SDIRLP		;Pack not mounted, try next file.
	CAIG B,UDWPH		;If this is just a write-place-holder.
	 JRST SDIRLP		; try next file.
STRLUP:	ILDB B,N		;Check blocks this file.
	JUMPE B,SDIRLP		;If end of desc, hack next file.
	CAIN B,UDWPH		;If write-place-holder
	 JRST STRLUP		; hack next file.
	CAIGE B,UDWPH		;If not a take-n code
	 JRST STRSKP		; skip it.
SLOAD:	;; 8/20/90 DM "funny" bit officially gone
	;; ANDCMI B,20		;Flush the DM funny bit.
	MOVEI J,-UDWPH-1(B)	;Compute load address for
	MOVEI K,NXLBYT		;the block.
SLOAD1:	ILDB B,N
	LSH J,6
	ADD J,B
	SOJG K,SLOAD1		;J gets entire load address.
	MOVE Q,J		;Remember it.
	MOVE I,C		;Unit where file's pack is mounted.
	CALL TUTPNN		;Get Bp to TUT.
	ADD J,[TUTBYT_14,,]	;Compensate for ILDB.
	MOVEI B,1		;Only check one block.
	JRST STLUP1		;So, go check it already!

;;; Here to skip some blocks.

STRSKP:	CAIG B,UDTKMX		;If not blocks to skip
	 JRST STLUP
	SUBI B,UDTKMX		;Else compute # blocks to skip.
STRSK1:	IBP J			;Skip them.
	AOS Q
	SOJG B,STRSK1		;Skip all blocks we're supposed to.
	MOVEI B,1		;We need to tattle on one block only.
STLUP:	AOS Q			;Ptr back to file it belongs to.
STLUP1:	ILDB D,J		;Get reference count for this block.
	CAIE D,1		;If more than one user of it
	 CALL [	PUSHER P,[A,B,C];  It's a nasty ole' shared block.
		EXCH Q,LASTQ	;  Which we're gonna tattle on.
		MOVE A,UNFN1(Q)	;  Nasty old FN1
		MOVE B,UNFN2(Q)	;  Nasty old FN2.
		HRRZ D,C	;  Unit the file is on.
		TYPE LPT,"~&~S	;~S ~S  ~D-~D, TUT=~D",[USRNAM,A,B,C,LASTQ,D]
		EXCH Q,LASTQ
		POPPER P,[C,B,A]
		RET ]
	SOJG B,STLUP		;Tattle on each nasty ole block.
	JRST STRLUP		;When done, 
SDIRLP:	MOVE Q,LASTQ		;Find next file.
	SUBI Q,LUNBLK
	MOVE J,(P)		;Recover name area ptr.
	JRST SDIRL2		;Go see if we checked the last file.


SUBTTL	Garbage Collect a UFD
;;; DELUSR - Flush UFD from Q.

DELUSR:	MOVE A,MNUNAM(Q)	;Get UFD name.
	CAME A,[SIXBIT /.LPTR./];Don't flush this directory.
	 CAMN A,[SIXBIT /.KLFE./]	;Make these UFDs sacred.
	  JRST DELUS9
	TYPE T,"~&~S has no files, User File Directory DELETED",[A]
	SETZM MNUNAM(Q)		;Zap his name.
	SETOM MFDWRT		;Say we munged the MFD.
DELUS9:	RET


SUBTTL	Main Salvager - Check a UFD

USRLUP:	MOVEM A,USRNAM		;Remember who we're hacking.
	SETZM UFDLOS		;Not losing yet.
	SETZM UFDSEE		;Don't print the UFD upon lossage.
	SETZM LFILES		;No files found yet.
	MOVE J,Q
	SUBI J,MFD+2000		;Map MFD entry into UFD block.
	IDIVI J,LMNBLK		;-Nth UFD.
	ADD J,NUDS		;End of user dir area -N.
	PUSH P,Q
	PUSH P,UDSK		;Save UFD disk, might change if UFD is bad.
	MOVEM J,DBLK		;Remember directory number.
	MOVE I,UDSK		;Start with this disk.
USRLU1:	MOVEI A,OUSRD		;Come back to here on try next drive.
	CALL READ		;Read the UFD from this disk.
	JUMPGE T,USRLU2		;Got it.
	TYPE T,"~&UFD Read Error"
	SETOM HARDER		;Fuck me harder.
USRLER:	TYPE T," ~S;~%",[USRNAM]
	SKIPE HARDER		;If hardware lost
	 CALL GSTS		; print controller status.
	SETZM HARDER		;Reset hardware losing flag.
	ERR			;Maybe continue.
	ASKYN "~&Try next drive?"
	 PUNT			;Maybe not.
	MOVE I,UDSK		;Disk to get UFD from.
USRL2B:	AOS I			;Try next disk.
	CAIL I,NUNITS		;If there is no next disk
	 SUBI I,NUNITS		; use the highest numbered one.
	SKIPN QACT(I)		;If the disk is not active
	 JRST USRL2B		; Try next higher disk.
	MOVEM I,UDSK		;(Will get popped before next user)
	SETOM UFDLOS		;Cause dir to be written on all drives.
	MOVE J,DBLK		;Remember which losing UFD to hack.
	JRST USRLU1		;Retry.

USRLU2:	MOVE Q,OUSRD+UDNAME	;All disks should have the same UFD here.
	CAMN Q,USRNAM		;If they do
	 JRST USRLU3		; things are OK.
	TYPE T,"~&UFD on unit ~D block ~D is ~S, but expected ~S.",[I,DBLK,USRNAM,OUSRD+UDNAME]
	ERR
	ASKYN "Correct it? (taking MFD entry as good)"
	 BARF
	MOVE A,USRNAM		;Else use user name from master disk MFD.
	MOVEM A,OUSRD+UDNAME	;Change name of old UFD.
	MOVEI A,OUSRD
	CALL WRITE		;Write it back out to disk.
	JUMPL T,WRERR
USRLU3:	MOVE Q,[OUSRD,,NUSRD]	;Ptr from original to copy.
	BLT Q,NUSRD+1777	;Copy old for garbage check.
	MOVEI Q,2000-LUNBLK+OUSRD	;Q gets addr of old name block.
	MOVEI J,OUSRD		;J gets addr of old UFD.
	ADD J,UDNAMP(J)		;Origin of file name area (lowest file name block).
	CAIG J,OUSRD+2000	;Make sure ptr to file is within UFD,
	 CAIGE J,OUSRD+UDDESC	; and inside descriptor area.
	  JRST [ TYPE T,"~&User directory name-pointer scrambled"
		JRST USRLER ]
	MOVE T,OUSRD+UDESCP	;Get ptr to descriptor area.
	IDIVI T,UFDBYT		;Before using it, see if plausible ptr.
	ADDI T,OUSRD+UDDESC
	CAML T,J
	 JRST [ TYPE T,"Name area, descriptor area overlap"
		JRST USRLER ]
	PUSH P,J		;Stash file name ptr.
	JRST DIRL1		;First time falls in.


;;; DIRLUP - Per file loop.
;;;   Q/ addr of old UFD name block
;;;   J/ addr of old UFD

DIRLUP:	SKIPN BADFIL		;Retrieval error?
	 JRST DIRLP1		; No, hack next file.
	TYPE T,"Bad retrieval: "
	CALL PNTNAM		;Print file name.
DIRLP1:	MOVE Q,LASTQ		;Start with file last block.
	MOVE J,(P)		;Recover ptr to name area.
	MOVSI A,UNMARK		;Reset GC  bit for this file.
	ANDCAM A,UNRNDM(Q)	;GC unmark.
	SUBI Q,LUNBLK		;Point back to name block.

;;; First, examine the name area.

DIRL1:	CAMGE Q,J		;If past beginning of UFD
	 JRST USRFIN		; finish up by checking for extra garbage
	SETOM FILEER		;Print file name only on first error.
	SETZM BADFIL		;No bad retrievals discovered yet.
	MOVEM Q,LASTQ		;Stash ptr to file.
	SKIPN A,UNFN1(Q)	;Get FN1.
	SKIPE UNFN2(Q)		;Get FN2.
	 CAIA
	  JRST DIRLUP		; Eh?
	AOS LFILES		;Ok, here's a file.
	LDB C,[UNPKN UNRNDM(Q)]	;Get pack number.
	LDB A,[UNDSCP UNRNDM(Q)];Get ptr to desc wds.
	CAML A,OUSRD+UDESCP	;If it points outside the descriptor area.
	 JRST [	CALL LPTNAM
		TYPE LPT,"~%Desc points out of desc area"
		ERR
		SETOM UFDSEE	; Too weird!
		JRST DIRLUP ]	; Next UFD, please.

;;; Now examine the UFD file descriptor area.

	IDIVI A,UFDBYT		;Cons up a Bp into the UFD.
	ADDI A,OUSRD+UDDESC	;The first descriptor.
	HLL A,QBTBLI(B)		;Retrieve Bp.
	TLNE A,400000		;First word?
	 SUB A,[440000,,1]	; Yes, back up one.
	MOVEI Z,0		;Accumulate new descriptor bits here.
	LDB B,A			;Get last word of previous descriptor.
	JUMPN B,[ CALL LPTNAM	; All descriptors end with a zero word.
		  TYPE LPT,"File not preceeded by zero~%"
		   ERR
		  SETOM UFDSEE	; Saw a weird UFD.
		JRST DIRL2 ]	; Examine the rest of it.
DIRL2:	MOVE N,A		;Get Bp to descriptor.
	MOVEI J,0
	ILDB B,A		;Get first word of descriptor.
	JUMPE B,[ CALL LPTNAM	; Slot should not be free.
		  TYPE LPT,"File points to zero~%"
		  ERR
	          SETOM UFDSEE	; Saw a weird UFD.
		JRST .+1 ]
DIRL3:	MOVE E,UNRNDM(Q)	;Get random bits.
	TLNE E,UNLINK		;If this is a link
	 JRST DIRLNK		; go hack it.
	SETZM NOTUT		;Otherwise probably a file (TUT active).
	CALL FINDPK		;Find which pack file lives on.
	SKIPL C			;Pack mounted?
	 SKIPN QACT(C)		; Yes, Active unit?
	  SETOM NOTUT		;  File on unmounted pack, don't hack TUT.
	MOVEM C,FUNIT		;Remember which unit file's on.
	SETZM LSTBLK		;Dont know last block yet.
	SETZM ADRSET		;Address not set.
TRLUP:	MOVE E,N		;Bp to descriptor.
	ADDI E,NUSRD-OUSRD	;Point into new descriptor.
	IDPB Z,E		;Put bits into this copy.
	ILDB B,N		;Get descriptor byte.
	JUMPE B,DIRLUP		;Not expecting descriptor end: Bad retrieval.
	CAIN B,UDWPH		;Null file?
	 JRST TRLUP		; skip this write-place-holder.
	CAIL B,UDWPH		;Take-N code?
	 JRST LOAD		; Yes, get load address.
	CAILE B,UDTKMX		;If larger than highest Take-N
	 CALL SKIPF		; Skip some.
	JRST TLUP

SKIPF:	SUBI B,UDTKMX		; Subtract highest Take-N code.
	IBP J			; Next block number.
	AOS Q			; (Next block number.)
	SOJG B,.-2
	MOVEI B,1
	RET


LOAD:	SETOM ADRSET		;Say we have a load address.
	;; 8/20/90 DM "funny" bit officially gone
	;; ANDCMI B,20		;Ignore DM funny bits (whatever those are).
	MOVEI J,-UDWPH-1(B)	;J gets load address first part.
	MOVEI K,NXLBYT		;Need above 5 bits plus NXLBYT bits.
LOAD1:	MOVE E,N		;Get Bp to descriptor.
	ADDI E,NUSRD-OUSRD	;Point into new UFD.
	IDPB Z,E		;Zap some more bits into it.
	ILDB B,N		;Get next descriptor byte.
	LSH J,UFDBYT			;Swish it over.
	ADD J,B			;Add in to get load address.
	SOJG K,LOAD1		;Get the entire load address.
	MOVE Q,J		;Q gets load address (file block).
	SKIPE NOTUT		;If TUT not active for this file
	 JRST LOAD2		; no TUT ptr.
	MOVE I,C		;Disk unit this file is on.
	CALL TUTPNN		;J gets ptr  to new TUT.
	 JUMPE J,[ LOSE "~&LOAD tried to find TUT for unTUTed file block ~D.",[Q] ]
	ADD J,[TUTBYT_14,,]	;Back up for ILDB.
LOAD2:	MOVEI B,1		;Hack only one block.
	JRST TLUP1

;;; Examine the TUT to be sure that the file's blocks are properly in use.

TLUP:	 AOS Q			;Each time through loop check next block.
TLUP1:	MOVE A,Q		;Block to check.
	SKIPE ADRSET		;If address set
	 JRST TLUP2		; Read in block's TUT info.
	CALL LPTNAM		;Else complain
	TYPE LPT,"Starting Address not set"
DIRLER:	LPRCRR			;Here for TUT errors.
	ERR
	SETOM UFDSEE
	JRST CKFL3

TLUP2:	SKIPE NOTUT		;File on active unit?
	 JRST CKFL3		; No, skip it.
	MOVE D,QOTUTO(C)	;Get old TUT.
	CAMGE A,QLASTB(D)	;Block may not be after last TUTed block
	 CAML A,QFRSTB(D)	; Or before first block.
	  JRST TLUP3		;  If outside range, complain.
	CALL LPTNAM
	TYPE LPT,"Block points off dsk (past last TUTed block) ~D",[A]
	JRST DIRLER

TLUP3:	CAMGE A,NUDS		;Block should be past special hacking area.
 	 JRST DIRLE1
CKFL2A:	MOVSI D,-LSBTAB		;Check against all special blocks.
	CAMN A,SBTAB(D)
	   JRST DIRLE1
	AOBJN D,.-2		;Loop through all special blocks.
	MOVE D,MFDBK
	SUB D,NTBL(C)
	CAML A,D		;Is block part of TUT?
	 CAMLE A,MFDBK		; or part of MFD?
	  CAIA			;   No.
DIRLE1:	   JRST [ CALL LPTNAM	;Here when block is in reserved area.
		TYPE LPT,"Block in reserved area: ~D",[A] 
		JRST DIRLER ]
NTS,	SKIPGE CKFLSW		;Checking for clobbered file blocks?
NTS,	 CALL CKFL		; Yes, do so.
	MOVEM Q,LSTBLK		;Remember last block in file.
	SKIPN NOTUT		;TUT active?
	 SKIPN ADRSET		; Yes, address set?
	  JRST CKFL3		;  No, check next file.
	MOVE D,J		;Bp to block info.
	SUBI D,NTUT0-OTUT0	;In old TUT.
	ILDB D,D		;Get block state.
	CAIN D,TUTLK		;Blocked already locked out? 
	 JRST [	CALL LPTNAM	; Yes, mention it.
		TYPE LPT,"File contains locked block ~D~%",[Q] 
		SETZM SALVRT	;Don't allow auto startup of ITS.
		JRST .+1 ]
	ILDB D,J		;Get usage count.
	SKIPE D			;If not in use
	 JRST [	LPRCRR
		CALL LPTNAM
		TYPE LPT,"Shares block with some other file"
		AOS SHARED		;Shared block flag.
		SETZM SALVRT		;NO automatic sys start.
		JRST .+1 ]
	CAIGE D,TUTMNY		;Unless maximum count
	 AOS D			; count it again.
	DPB D,J			;Update usage count in new TUT.
	MOVE K,J
	SUBI K,NTUT0-OTUT0	;K gets same ptr in old TUT.
	LDB D,K			;Update usage count in old TUT too.
	SKIPN D			;If usage count zero
	 JRST [ SKIPE NOQUES	; Complain.
		 JRST CKFL3
		TYPE LPT,"~%File unprotected in old TUT, Block ~D. - ",[Q]
		CALL LPTNAM
		JRST CKFL3 ]
CKFL3:	SOJG B,TLUP		;Do next block.
	JRST TRLUP

;;; Here to examine a link.

DIRLNK:	MOVE E,N		;Bp into descriptor.
	ADDI E,NUSRD-OUSRD	;Point into new UFD.
	CALL LTYPE		;Check sname.
	 JRST DIRLN6
	CALL LTYPE		;Check FN1.
	 JRST DIRLN6
	CALL LTYPE		;Check FN2.
	 JRST DIRLUP
	ILDB B,N		;Get terminator.
	JUMPE B,DIRLUP		;Link should be follwed by a zero.
	TYPE LPT,"~&Link not followed by a zero"
	JRST DIRLN7

DIRLN6:	CALL LPTNAM		;Here if not three names long.
	TYPE LPT,"~&Link not three names"
DIRLN7:	ERR			;Here when something wrong with link.
	SETOM UFDSEE		;Better print UFD later.
	JRST DIRLUP		;Do next file.

;;; LTYPE - Hack a link name.
;;; Skip returns if encounters zero (error).

LTYPE:	MOVEI B,6
LTYPE2:	IDPB Z,E		;Z accumulates the link.
	ILDB A,N		;Get a byte.
	JUMPE A,CPOPJ		;Not expecting zeros in the link.
	CAIN A,':		;Quoting character?
	 JRST [	ILDB A,N	; No, get char.
		IDPB Z,E	; Stuff it.
		JRST LTYPE3]	; Get another.
	CAIE A,';               ;
LTYPE3:	 SOJG B,LTYPE2		;Get all words.
	JRST POPJ1		;Skip return if ends naturally.



;;; Finish up our examination of this UFD.

USRFIN:	AOS LUFDS
	MOVE Z,NOISE
	CAMN Z,[-2]
	 TYPE T,"~&Finishing #~D~16T~S~26TQ=~D,~32TJ=~D.",[LUFDS,USRNAM,Q,J]
	SETZM GARBF		;No garbage in free area yet.
	SETZM EXGARB		;No extra garbage in UFD yet.
	CLEARB Z,J		;Z will accumulate bits.
	MOVE Q,[440600,,NUSRD+UDDESC]	;Bp to new descriptor words.
GARB2:	CAML J,OUSRD+UDESCP	;Check ptr to descriptor area.
	 JRST USRFN2		; OK if really points into right area.
GARB4:	ILDB B,Q		;Otherwise, what are these bits about?
	JUMPE B,GARB3		;Better be zero.
	SETOM UFDSEE		;Else garbage in descriptor area
	SKIPN EXGARB		;Tell user about it.
	 JRST [	TYPE LPT,"~&Extra garbage in UFD ~S; block #~D.",[USRNAM,DBLK]
		ERR
		SETOM UFDLOS	;UFD losing.
		SETOM EXGARB	;Extra garbage seen.
		JRST .+1 ]
	TYPE T,"~&~O ~O",[J,B]	;Print out garbage words.
	MOVE E,Q		;Get back Bp to new descriptors.
	SUBI E,NUSRD-OUSRD	;Point into old UFD.
	DPB Z,E		;Clear out extra garbage in old UFD.
GARB3:	AOJA J,GARB2		;Check all descriptor words.

USRFN2:	TLNE Q,770000		;Done this descriptor word?
	 JRST GARB4		; No.
	MOVEI Q,-NUSRD+1(Q)	;Check free space pointer.
GARB6:	CAML Q,NUSRD+UDNAMP	;Likely?
	 JRST GARB5		; Yes, done hacking this UFD.
	SKIPN NUSRD(Q)		;If ptr not already in new UFD?
	 AOJA Q,GARB6		; go insert it.
	SETOM UFDSEE		;Else extra garbage is in the free area.
	SKIPN GARBF
	 JRST [	TYPE LPT,"~&Garbage in free area~%~S; block ~D~%",[USRNAM,DBLK]
		ERR
		SETOM UFDLOS
		SETOM GARBF
		JRST .+1 ]
	MOVE A,NUSRD(Q)		;Get garbage from new UFD.
	ANDCAM A,OUSRD(Q)	;Clear out the garbage in the old version.
	TYPE LPT,"~&Pointer= ~O, Garbage is ~O",[Q,A]
	AOJA Q,GARB6		;Do next block.
	
GARB5:	SKIPE UFDSEE		;Saw a weird cookie UFD.
	 CALL UFDPR		;Print it out.
	SKIPN UFDLOS		;Garbage found in UFD?
	 JRST USRFN5		; No, done.
	SKIPE NOQUES		;If no questions
	 JRST GARB5A		; just fix it.
	ASKYN "UFD needs update - Write"
	 JRST USRFN5
GARB5A:	MOVEI A,OUSRD		;UFD.
	MOVEI I,NUNITS-1	;This many disks.
	MOVE J,DBLK		;This directory block.
GARB7:	SKIPE QACT(I)		;Use only online units.
	 JRST [ CALL WRITE	; Write out this UFD.
		JUMPL T,WRERR
		JRST .+1 ]
	SOJGE I,GARB7		;Loop for all drives.

USRFN5:	POP P,J			;Done.
	POP P,UDSK
	POP P,Q
	RET


;;; CKFL - Check all blocks of a file for clobberage.
;;; Note well: Only tries to fix errors on a DC-10 controller!
;;; A/ block
;;; C/ unit file is on
;;; Returns in Q the last block of the file.

CKFIX:	0	;-1 iff auto fix retrieval pointers
UNIT:	0	;unit   

CKFL:	PUSHER P,[J,I]
	SETOM XWDSEE		;Haven't typed out extra words.
	MOVE J,A		;Get  block number.
	MOVEI A,FDBUF		;Reading into buffer.
	MOVE I,C		;Unit file is on.
	CALL READ		;Read it in.
CKFLBP:	JUMPL T,CKFLE1		; If lossage, report it.
CKFL4:				;If DC-10 controller, try to fix it.
DC,[	MOVE A,RXWDS+XWSYSN
	CAME A,USRNAM
	JRST CKFLE2
CKFL5:	LDB A,[XWBLK RXWDS]
	CAME A,LSTBLK
	JRST CKFL6
CKFL6A:	SKIPE CKFIX			;FIX ERRORS?
	SKIPGE XWDSEE			;ANY ERRORS?
	JRST CKFL7
	LDB A,[XWAWC RXWDS]
	DPB A,[XWAWC WXWDS]
	MOVE A,LSTBLK
	DPB A,[XWBLK WXWDS]
	MOVE A,USRNAM
	MOVEM A,WXWDS+XWSYSN
	MOVE Q,LASTQ
	MOVE A,UNFN1(Q)
	MOVEM A,WXWDS+XWFN1
	MOVE A,UNFN2(Q)
	MOVEM A,WXWDS+XWFN2
	MOVEI A,FDBUF
	CALL WRITE
	MOVEI A,FDBUF
	CALL READ
	JUMPL T,CKFLE1
	TYPE LPT,"Retrieval now:"
	CALL LPTXWD
	SETOM XWDSEE
	JRST CKFL4
];DC
CKFL7:	POPPER P,[I,J]
	RET

CKFLE1:	CALL PNTNAM
	TYPE T,"Error reading block "
CKFLE3:	MOVE A,J
	TYPE T,"~D~%",[J]
	CALL PNTXWD
	CALL GSTS
	JRST CKFL4
DC,[
CKFLE2:	JRST CKFL6A		;JFCL THIS IF YOU HATE ARCHIVES
	AOS BADFIL
	CALL LPTNAM
	LPRTAB
	CALL LPTXWD
	LPRTAB
	TYPE LPT,"Retrieval User-name differs"
	LDB A,[XWBLK RXWDS]
	CAMN A,LSTBLK		;Checking the last block?
	JRST [	LPRCRR		; Yeah, kerchink.
		JRST CKFL6A]
	TYPE LPT,","
	JRST CKFLE4

CKFL6:	JRST CKFL6A		;JFCL THIS IF YOU HATE ARCHIVES
	AOS BADFIL
	CALL LPTNAM
	LPRTAB
	CALL LPTXWD
	LPRTAB
CKFLE4:	TYPE LPT,"Chain ptr wrong, Last block= ~D~%",[LSTBLK]
	JRST CKFL6A
];DC

EXTRA,[
OLDFIL:	SETOM UFDSEE		;Say to print whole UFD later.
	AOSE FILEER		;File error detected.
	 JRST CKFL2A		; Continue checking.
	TYPE T,"!!! Over-writing user-directory area block ~D, by",[Q]
	CALL PNTNAM
	JRST CKFL2A
];EXTRA


SUBTTL	Main Salvager - TUT hackery

TUTCMP:	SETZM TUTDFR		;No TUT differences encountered yet.
	SETZM NLKBKS'		;Let's hack the 'tute...
	SETZM TUTCHG		;Make summary table of differences
	MOVE Q,[TUTCHG,,TUTCHG+1]
	BLT Q,TUTCHG+<TUTMAX*TUTMAX>-1	;Zap it.
	MOVE Q,QTTBLI		;Get Bp to TUT.
	HRR Q,QNTUTO(I)		;Into new TUT.
	ADDI Q,LTIBLK		;First byte which maps the disk.
	MOVE J,Q		;Get it.
	HRR J,QOTUTO(I)		;Bp to old TUT.
	MOVE E,QFRSTB(J)	;Get first block TUTed.
	MOVE B,QLASTB(J)	;Get last block TUTed.
	SOS B			;The one before it.
	MOVEM B,TUTHIB'		;is the highest block #.
	ADDI J,LTIBLK
TUTC1:	ILDB B,Q		;Get old block info.
	ILDB D,J		;Get new block into.
	CAMN B,D		;If they are the same
	 JRST TUTC2		; everything's cool.
	CAIN D,TUTLK		;If new TUT says block locked
	 JRST [	MOVE B,D	; Keep it locked.
		DPB B,Q		; Update the old TUT.
		AOS NLKBKS	;Count blocks locked due to disk errors.
		HRRZ A,I	;A gets TUT unit #.
		SKIPN GOGOX	;If in CHKR mode, report locked blocks.
		 TYPE T,"~&Locked block ~D-~D",[A,E]
		JRST TUTC2 ]	;Hack next block.
	IMULI B,TUTMAX		;Ptr to summary table.
	ADD B,D
	MOVE T,QOTUTO(I)
	CAML E,NUDS
	 CAML E,QSWAPA(T)	;Don't list TUT changes in swapping area.
	  AOS TUTCHG(B)
	AOS TUTDFR		;Count TUT differences.
TUTC2:	CAMGE E,TUTHIB		;If more disk blocks TUTed
	 AOJA E,TUTC1		; do another one.
	SKIPN NOQUES		;Else we are done checking the TUT.
	 SKIPN NLKBKS		;Any error-locked blocks?
	  SKIPA
	   TYPE T,"~&~D locked block~P on unit #~D",[NLKBKS,I]
	SKIPN TUTDFR		;If TUT has not changed,
	 JRST TUTCM9		; all done hacking the TUT.

;;; TUTCM0 Print TUT differences (falls in).

TUTCM0:	SKIPE NOQUES		;Here when TUT has differences.
	 JRST TUTCM3		;If no-questions mode, just write.
	MOVEI A,TUTMAX*TUTMAX-1	;See if any TUT diffs not in swapping area
	SKIPN TUTCHG(A)
	 SOJGE A,.-1
	JUMPL A,TUTCM4		;None, go ask if should write.
	TYPE T,"~&TUT #~D",[I]	;Otherwise, summarize TUT differences.
	MOVEI B,TUTMAX-1
TUTSM1:	MOVEI E,TUTMAX-1
TUTSM2:	MOVE C,B
	IMULI C,TUTMAX
	ADD C,E
	SKIPE C,TUTCHG(C)
	 TYPE T," ~D ~D_~D",[C,B,E]
TUTSM3:	SOJGE E,TUTSM2
	SOJGE B,TUTSM1
	ASKYN "~&Print?"
	 JRST TUTCM4
	SETZM TUTDFR		;Print out the TUT.
	MOVE Q,QTTBLI
	HRR Q,QNTUTO(I)		;Bp to new TUT.
	ADDI Q,LTIBLK
	MOVE J,Q
	HRR J,QOTUTO(I)		;Bp to old TUT.
	MOVE E,QFRSTB(J)	;Start with first block TUTed.
	MOVE B,QLASTB(J)	;Finish with last one.
	SOS B
	MOVEM B,TUTHIB'		;Highest block #
	ADDI J,LTIBLK
TUTCM1:	ILDB B,Q		;Get old TUT data.
	ILDB D,J		;Get new TUT data.
	CAME B,D		;If they differ
	 CALL TUTDIF		; mention it.
TUTCM2:	CAMGE E,TUTHIB		;Done comparison?
	 AOJA E,TUTCM1		; No, keep going.
TUTCM4:	ASKYN "~%TUT #~D need updating - Write",[I]
	 JRST TUTCM9
TUTCM3:	MOVE A,QNTUTO(I)	;Get new TUT.
	CALL WRTUT		;Write it out.
	SKIPGE T		;Should work.
	 JRST [ TYPE T,"~&Error writing the TUT."
		CALL GSTS	; Shit.
		SKIPN GOGOX	; If in CHKR mode
		 JRST TUTCM4	;  ask again.
		BARF ]		; Else don't continue in automatic mode.
TUTCM9:	 RET



;;; TUTDIF - Print TUT a difference if it's relavent
;;; I/ disk
;;; E/ block
;;; Clobbers A.
;;; Does not skip.

TUTDIF:	MOVE T,QOTUTO(I)	;TUT info differs.
	CAML E,NUDS		;See if relavent.
	 CAML E,QSWAPA(T)
	 CAIA
	  JRST TUTDF9		;Ignore differences in swapping area.
	HRRZ Z,I		;Get TUT unit.
	SKIPN TUTDFR		;Print heading just once.
	 JRST [ TYPE T,"~&TUT differences for drive ~D~%",[Z]
		SETZ A,		;Count frobs printed.
		JRST .+1 ]
	CAIE A,5.		;Print 5 per line.
	 JRST TUTDF6
	CRR
	SETZ A,
TUTDF6:	TYPE T,"~D ~O_~O  ",[E,B,D]
	AOS A			;Count frobs printed.
	SETOM TUTDFR		;Say we printed herald.
TUTDF9:	RET


DBG,[
IFN 0,[
;;; TUTX - Print out the TUT information for a file.
;;; Q/ ptr to file in UFD

TUTX:	PUSHER P,[Z,A,B,C,D,E,N,W,U,I,Q,T,TT,J,K]	;Smash nothing!
	CRR
	CRR
	MOVE A,UNFN1(Q)
	MOVE B,UNFN2(Q)
	TYPE T,"~&~S; ~S ~S is ",[USRNAM,A,B]
	MOVE E,UNRNDM(Q)	;Get random bits.
	TLNE E,UNLINK		;If this is a link
	 JRST [	TYPE T,"a link."
		JRST TUTX90 ]
	LDB C,[UNPKN UNRNDM(Q)]	;Pack #.
	MOVE D,C
	CALL FINDPK		;Get disk # in C.
	LDB A,[UNDSCP UNRNDM(Q)];Descriptor offset.
	TYPE T," on pack ~D (mounted on unit ~O)~%FS desc offset = ~O",[D,C,A]
	IDIVI A,UFDBYT
	ADDI A,OUSRD+UDDESC	;The first descriptor.
	HLL A,QBTBLI(B)		;Retrieve Bp.
	TLNE A,400000		;First word?
	 SUB A,[440000,,1]	; Yes, back up one.
	MOVEI Z,0		;Accumulate new descriptor bits here.
	LDB B,A			;Get last word of previous descriptor.
	JUMPN B,[ TYPE T,"~&Error: File not preceeded by zero"
		  JRST TUTX90 ]
	MOVE N,A		;Get Bp to descriptor.
	MOVEI J,0
	ILDB B,A		;Get first word of descriptor.
	JUMPE B,[ TYPE T,"~&Error: File points to zero"
		  JRST TUTX90 ]
TUTX10:	MOVE E,N		;Bp to descriptor.
	ADDI E,NUSRD-OUSRD	;Point into new descriptor.
	TYPE T,"~&Bp to (old) descriptor is ~H, descriptor byte: ",[N]
	IDPB Z,E		;Put bits into this copy.
	ILDB B,N		;Get descriptor byte.
	TYPE T,"~O",[B]
	JUMPE B,[ TYPE T,"~&Error: Unexpected descriptor end"
		  JRST TUTX90 ]
	CAIN B,UDWPH		;Null file?
	 JRST TUTX10		; skip this write-place-holder.
	CAIL B,UDWPH		;Take-N code?
	 JRST TUTX20		; Yes, get load address.
	CAILE B,UDTKMX		;If larger than highest Take-N
	 CALL SKIPF
	JRST TUTX40

TUTX20:	TYPE T,"~&Computing load address.."
	;; 8/20/90 DM "funny" bit officially gone
	;; ANDCMI B,20		;Ignore DM funny bits (whatever those are).
	MOVEI J,-UDWPH-1(B)	;J gets load address first part.
	MOVEI K,NXLBYT		;Need above 5 bits plus NXLBYT bits.
TUTX21:	MOVE E,N		;Get Bp to descriptor.
	ADDI E,NUSRD-OUSRD	;Point into new UFD.
	IDPB Z,E		;Zap some more bits into it.
	ILDB B,N		;Get next descriptor byte.
	LSH J,UFDBYT			;Swish it over.
	ADD J,B			;Add in to get load address.
	SOJG K,TUTX21		;Get the entire load address.
	MOVE Q,J		;Block of the file we want.
	MOVE I,C		;Disk unit this file is on.
	CALL TUTPNN		;Get in B ptr  to new TUT.
	TYPE T,"Block ~D has new TUT ptr = ~H",[Q,J]
	ADD J,[TUTBYT_14,,]	;Back up for ILDB.
	MOVEI B,1		;Hack only one block.
	CAIA
TUTX40:	 AOS Q
TUTX41:	MOVE A,Q
	MOVE D,J		;Copy Bp to block info.
	SUBI D,NTUT0-OTUT0	;In old TUT.
	ILDB A,D		;Get block state.
	ILDB B,J		;Get usage count.
	TYPE T,"~&Old count ~D, New count ~D",[A,B]
TUTX90:	POPPER P,[K,J,TT,T,Q,I,U,W,N,E,D,C,B,A,Z]
	RET

];0
];DBG



SUBTTL	Print out UFD

;;; PNTNAM - Print UFD name and file name on console.
;;; LPTNAM - Print UFD name and file name on LPT.
;;; LPTFIL - Print just the file name on LPT.

PNTNAM:	PUSH P,NOLPT		;Kludge kludge.
	SETOM NOLPT		;Fake out LPT routines.
	CALL LPTNAM		;Do output.
	POP P,NOLPT		;Restore LPT state.
	RET			;That's all.

LPTNAM:	TYPE LPT,"~S;",[USRNAM]
LPTFIL:	 PUSHER P,[A,B,C,D,E]
	MOVE A,LASTQ		;Last block frobbed should be UFD.
	MOVE B,UNFN1(A)		;Get FN1 from it.
	MOVE D,UNFN2(A)
	LDB C,[UNPKN UNRNDM(A)]
	TYPE T,"~S ~S  Pack ~D.",[B,D,C]
	CALL FINDPK		;Find pack file is on
	SKIPL C
	 TYPE LPT,", Unit #~D",[C]
LPTFI1:	TYPE LPT," "
	POPPER P,[E,D,C,B,A]
	RET

;;; PNTXWD - Print extra words on the console.
;;; LPTXWD - Print extra words on the LPT.
;;; Note well: these routines only do something useful on a DC-10 disk.

PNTXWD:	PUSH P,NOLPT
	SETOM NOLPT
	CALL LPTXWD
	POP P,NOLPT
	RET

LPTXWD:
DC,[	PUSH P,A
	TYPE LPT,"Extra words: Block #~D-~O  ~S;~S ~S ",[UNIT,BLK,RXWDS+XWSYSN,RXWDS+XWFN1,RXWDS+XWFN2]
	LDB A,[XWBLK RXWDS]
	TYPE LPT,"Chain pointer=~O",[A]
	LDB A,[XWAWC RXWDS]
	TYPE LPT,", Active Wd Cnt=~O~%",[A]
	POP P,A
];DC
	SETZM XWDSEE		.SEE CKFL6A
	RET


USBYTE:	TYPE LPT,"~2<~;0~O~> ",[B]
	RET

; For laughs, here is what CStacy's fevered brain had turned this code
; into:
;
;	;;; USBYTE prints some bytes.
;	;;; It was coded in this obscure fashion originally.
;	USBYTE:	PUSHER P,[A,B]
;		LDB A,[30300,,(P)]
;		LDB B,[300,,(P)]
;		TYPE LPT,"~6<~;0~O~>. ~6<~;0~O~>",[A,B]
;		POPPER P,[B,A]
;		RET

;;; UFDPR - Print out a losing UFD in all its glory.

UFDPR:	SETZM SALVRT		;No auto sys startup.
	SKIPN NOLPT
	 TYPE T,"~2&Errors in directory ~S",[OUSRD+UDNAME]
USEE0:	MOVE Q,OUSRD+UDNAME
	TYPE LPT,"~&User Directory: ~S;~%",[Q]
DBG,	JRST USEEF
	MOVEI J,OUSRD
	ADD J,UDNAMP(J)
	CAIG J,OUSRD+2000
	CAIGE J,OUSRD+UDDESC
	 JRST [ TYPE LPT,"~&UFD Name Area ptr out of range"
		JRST USEEF ]
	MOVE T,OUSRD+UDESCP
	IDIVI T,UFDBYT
	ADDI T,OUSRD+UDDESC
	CAML T,J
	 JRST [	TYPE LPT,"~&Descriptor Free ptr overlaps Name Area"
		JRST USEEF ]
	MOVEM J,LAST
	MOVEI Q,OUSRD+2000-LUNBLK
USEE1:	CAMGE Q,LAST		;Per file loop.
	 JRST USEEF
	MOVEM Q,LASTQ
	SKIPN A,UNFN1(Q)
	 SKIPE UNFN2(Q)
	  CAIA
	   JRST USEELP
	CALL LPTFIL
	LPRCRR
	LDB C,[UNPKN UNRNDM(Q)]
	CALL FINDPK
	MOVEM C,FUNIT		;Kludge Kludge (looks at TUTs).
	LDB A,[UNDSCP UNRNDM(Q)]
	CAML A,OUSRD+UDESCP
	 JRST [	TYPE LPT,"~&File descriptor ptr points outside Descriptor Area"
		JRST USEELY ]
	IDIVI A,UFDBYT
	ADDI A,OUSRD+UDDESC
	HLL A,QBTBLI(B)
	TLNE A,400000
	 SUB A,[440000,,1]
	LDB B,A
	LPRTAB
	CALL USBYTE
	TYPE LPT,"(INITIAL ZERO)"
	JUMPN B,[ TYPE LPT," - is not present"
		  JRST USEELY ]
	LPRCRR
USEE2:	MOVE N,A
	MOVEI J,0
	ILDB B,A		;Peek at next byte
	JUMPE B,[ CALL USBYTE
		  TYPE LPT," (First byte should be non-zero) "
		  JRST USEELY]
	LDB A,[UNDSCP UNRNDM(Q)]
	TYPE LPT,"~O",[A]		;Show desc addr before first desc byte.
USEE3:	MOVE E,UNRNDM(Q)
	TLNE E,UNLINK
	 JRST USLINK
	SETZM ADRSET
USLUP:	ILDB B,N		;Get file desc bits.
	LPRTAB
	CALL USBYTE		;Print em.
	JUMPE B,[ TYPE LPT,"(STOP)~%"
		  JRST USEELP]
	CAIN B,UDWPH
	 JRST [	TYPE LPT,"(WRITE-PLACE-HOLDER)~%"
		JRST USLUP]
	CAIL B,UDWPH
	 JRST USLOAD
	CAILE B,UDTKMX
	 JRST USSKIP
	TYPE LPT,"(TAKE-N BLOCKS) "
USLP1:	AOS Q			;Next block #.
USLP2:	TYPE LPT,"~O ",[Q]	;Print block #.
	SKIPGE E,FUNIT		;Make sure file on active unit.
	 JRST USLP3
	MOVE E,QOTUTO(E)	;Old TUT entry.
	CAMGE Q,QLASTB(E)	;Block in range of TUT?
	 SKIPN ADRSET		; Or starting addr known?
	  JRST USLPE		;No - bad block out of range this TUT.
	ILDB E,J		;Ok - get TUT entry.
	CAMGE Q,NUDS		;Make sure not in hacking area.
	 JRST USLPE		; Those blocks not supposed to be TUTed.
	MOVSI D,-LSBTAB		;AOBJN to hacker's area.
	CAMN Q,SBTAB(D)		;Make sure not in there.
	 JRST USLPE		; Bad desc if so.
	AOBJN D,.-2		;Hands off reserved disk area.
	MOVE A,FUNIT		;Get unit file is on.
	MOVE D,MFDBK		;We want the MFD.
	SUB D,NTBL(A)		;How many blocks this TUT.
	CAML Q,MFDBK		;Must not overlap MFD.
	 CAMLE Q,D		; Or TUT.
	  CAIA
	   JRST USLPE		;Else is bad block.
	SKIPL FUNIT		;If file not on active unit
	 CAIN E,1		
	  JRST USLP3
	MOVE A,E		;Print weird TUT entry.
	TYPE LPT,"~&?? TUT = ~D ??",[A]
USLP3:	SOJG B,USLP1
	LPRCRR
	JRST USLUP
USLPE:	TYPE LPT,"?? BAD BLOCK # ?? "
	JRST USLP3

USEELP:	MOVE Q,LASTQ
	SUBI Q,LUNBLK
	JRST USEE1


USEELY: LPRCRR
USSELP:	MOVE Q,LASTQ
	SUBI Q,LUNBLK
	JRST USEE1

USEEF:	LPRCRR
	RET

USLOAD:	SETOM ADRSET
	;; 8/20/90 DM "funny" bits officially gone
	;; ANDCMI B,20		;DM FUNNY BITS
	MOVEI J,-UDWPH-1(B)
	MOVEI K,NXLBYT
USLOD1:	ILDB B,N
	CALL USBYTE
	LSH J,6
	ADD J,B
	SOJG K,USLOD1
	MOVE Q,J
	SKIPGE I,FUNIT
	 TDZA J,J		;NO TUT
	  CALL TUTPNO		;GET PTR TO OLD TUT
	ADD J,[TUTBYT_14,,]	;BACK UP FOR ILDB
	TYPE LPT,"(JUMP ~O) ",[Q]
	MOVEI B,1
	JRST USLP2

USSKIP:	SUBI B,UDTKMX
	TYPE LPT,"(SKIP ~O) ",[B]
USSKI1:	IBP J
	AOS Q
	SOJG B,USSKI1
	MOVEI B,1
	JRST USLP1

;;; Print out a link entry.
;;; Smashes E.

USLINK:	TYPE LPT,"	(Link) "
	CALL USLINP		;Get SNAME.
	 JRST USLIN3		; Eh?
	TYPE LPT,"~S;",[E]	;Print FN2.
	CALL USLINP		;Get FN1.
	 JRST USLIN3		; Eh?
	TYPE LPT,"~S ",[E]	;Print FN1.
	CALL USLINP		;Get FN2.
	 ADD N,[060000,,]	; Ends with zero.
	ILDB B,N		;Re-read the zero byte.
	TYPE LPT,"~S	",[E]	;Print FN2.
	CALL USBYTE		;Print last byte.
	TYPE LPT,"(ZERO)"
	JUMPE B,USLIN4
	TYPE LPT,"?? no end zero ??"
USLIN4:	LPRCRR
	JRST USEELP
	
USLIN3:	TYPE LPT,"?? ends early ??"
	JRST USLIN4

;;; USLINP - Get sixbit link name.
;;; Does not skip if premature end, else result is in E.

USLINP:	MOVE T,[440600,,E]	;Bp to result.
	SETZ E,
	MOVEI B,6		;Number of chars.
USLIN2:	ILDB A,N		;Get char.
	JUMPE A,CPOPJ		;Should not be zero.
	CAIN A,';
	 JRST POPJ1		;Skip return on end.
	CAIN A,':		;Quote char?
	 ILDB A,N		; Yes, get real char.
	IDPB A,T		;Accumulate sixbit.
	SOJG B,USLIN2		;All the way.
	JRST POPJ1		;Skip return when happy.




;;; LISTF - Dump out user directory

LISTF:	JSR INIT
	SKIPL ACTIVE		;If need to reset drives.
	 CALL ACTUN		; Do so.
	TYPE T,"Directory name? "
	CALL 6TYI		;Get UFD name to list.
	JUMPE B,TODDT		;If none, punt.
	MOVEI I,NUNITS-1	;Units.
	SETOM FUNIT		;Assume pack not mounted.
LISTF3:	SKIPN QACT(I)		;Look for it.
	 JRST LISTF2
	MOVEM I,FUNIT		;Use this drive.
	MOVE A,QNTUTO(I)	;Get TUT.
	CALL RDTUT		;Read it in.
	JUMPL T,[ TYPE T,"~&Error reading TUT #~D~%",[I]
		  CALL GSTS
		  CALL CONTIN	;Want to go on?
		 PUNT	; No, punt.
		JRST LISTF2]
LISTF2:	SOJGE I,LISTF3		;Try another disk.
	MOVEM B,USRNAM		;Remember UFD to get
	MOVEI A,MFD
	MOVE J,MFDBK		;We want the MFD too.
	SKIPGE I,FUNIT		;Use first active unit.
	 LOSE "No active unit to get dir from!"
	CALL READ		;Read MFD.
	JUMPL T,[ TYPE T,"~&Error reading MFD #~D~%",[I]
		  CALL GSTS
		  CALL CONTIN	;Want to go on?
		 PUNT	; No, punt.
		JRST .+1 ]
	MOVE D,USRNAM		;UFD.
	MOVE Q,MFD+MDNAMP	;Seach for it in MFD.
LISTF1:	CAIL Q,2000		;Missing?
	 LOSE "~&Can't find UFD ~S",[D]
	CAME D,MFD(Q)		;Found it?
	 JRST [	ADDI Q,LMNBLK	; No, offset to next name.
		JRST LISTF1]	; Keep looking.
	SUBI Q,2000		;Cleverly compute which UFD block.
	IDIVI Q,LMNBLK
	HRRZ J,Q
	ADD J,NUDS
	MOVEM J,DBLK		;Remember UFD block.
	MOVE I,FUNIT		;Use first active unit.
	MOVEI A,OUSRD
	CALL READ		;Read UFD.
	JUMPL T,[ TYPE T,"~&Error reading UFD~%"
		  CALL GSTS
		  CALL CONTIN	;Want to go on?
		 PUNT	; No, punt.
		JRST .+1 ]
	CALL USEE0		;Now print it allllll out.
	PUNT		;Then punt to DDT.



SUBTTL	UNIBUS Routines
KS,[

;;; The UNIBUS address space is divided into 64 sections, each of
;;; which has a corresponding page map register.  Each section
;;; represents 1 DEC block (512 PDP-10 words), so you need two
;;; sections per ITS page.  Note that only the bottom 32 sections can
;;; be addressed using a 16 bit UNIBUS address.
;;;
;;; QUBMAP - Map UNIBUS address space for disk to KS10 address space.
;;; Expects:	A/ LH: # ITS pages to map
;;;    		   RH: first ITS page number
;;; Does not skip.
;;;	This routine maps UNIBUS space to KS10 space sequentially,
;;;	starting with the first UBA PAGING RAM register (UNIBUS address
;;;     zero).

QUBMAP:	PUSHER P,[A]
	HLRZ T,A		;# PDP10 core pages required.
	LSH T,1			;UNIBUS pages are 1/2 size.
	HNRLZ T,T		;T gets AOBJN pointer.
	HRRZ A,A		;Base PDP10 page number.
	LSH A,1			;Convert to "DEC" page number.
	TRO A,%UQVAL+%UQFST	;Set VALID and FAST.
QUBMA1:	IOWRQ A,UBAPAG(T)	;Map the page.
	AOS A			;Next "DEC" core page.
	AOBJN T,QUBMA1		;Next paging register.
	POPPER P,[A]
	RET			;Never fails.
];KS

TS,[	;Under time sharing, all UNIBUS hackery is a NOOP.
QUBMAP:	NOP ? RET
];TS


SUBTTL	Timesharing "Disk Routines"

TS,[
WRITT:	MOVE I,TOU
WRITE:	HRRZM J,LBLK
	HRRZ TT,I
	CAML TT,NQS
	 .VALUE [ASCIZ ":Cannot write random blocks."]
	HRRZ TT,J
	CAIGE TT,TBLKS
	SKIPGE TT
	 .VALUE [ASCIZ ":Cannot write - no such block."]
	JRST SUCCESS

READ:	HRRZ TT,I
	CAIL TT,NUNITS
	 .VALUE [ASCIZ ":Cannot read - no such unit."]
	HRRZ TT,J
	CAMN TT,MFDBK
	 JRST [	SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,QIN 
				[SIXBIT /DSK/]
			   	[SIXBIT /M.F.D./]
				[SIXBIT /(FILE)/]]
		 .LOSE %LSSYS
		JRST RDIN ]
	CAML TT,NUDS
	 .VALUE [ASCIZ ":Cannot read random blocks."]
	.SUSET [.SSNAM,,USRNAM]
	SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,QIN 
			[SIXBIT /DSK/]
		   	[SIXBIT /.FILE./]
			[SIXBIT /(DIR)/]]
		 .LOSE %LSSYS
RDIN:	HRLI A,-PG$SIZ
	.IOT QIN,A
	.CLOSE QIN,
SUCCES:	MOVEI T,30.
	RET
];TS


SUBTTL	RH11 Controller Routines
NTS,[
PH,[
;;; RHQCMD commands the disk.

DEFINE	RHQCMD OP
	MOVEI A,OP
	CALL RH6CMD
TERMIN

;;; RH6CMD - Command a disk.
;;;  A/ command (for CS1, including GO bit)
;;;  I/ unit number
;;; Returns 16 bits IO register contents right-justified in A.

RH6CMD:	IOWRQ I,%HRCS2		;Select drive.
  	IORDQ T,%HRCS1		;Read CS1 (don't clobber %HXIE.)
	DPB A,[$HXCMD T]	;Insert opcode + GO.
	IOWRQ A,%HRCS1		;Command the disk.
	JRST RHCHK		;Go check status.

;;; RHGET/RHSET - Read/Set an IO register.
;;; A/ LH: ptr to IO register addr, RH: 16 bits of data.
;;; I/ unit number
;;; Skip returns with 16 bits right-justified in A.
;;; If non-skip, RAE or something happened - see CS2 in A.

RHGET:	IOWRQ I,%HRCS2		;Select drive.
	HLRZ T,A		;T gets register addr.
	IORDQ A,(T)		;Read contents of desired reg into A.
	JRST RHCHK		;Go check status.

RHSET:	IOWRQ I,%HRCS2		;Select drive.
	HLRZ T,A		;T gets register addr.
	IOWRQ A,(T)
				;Fall into RHCHK.
RHCHK:	DELAY US,3.		; (Ensure 3 usec delay to allow 
				;  MASSBUS transaction to complete.)
	IORDQ T,%HRCS2		;Check for errors.
	TRNE T,%HYNED		;Drive nonexistant?
	 JRST RHRAE		; No - register access error.
	IORDQ T,%HRCS1		;Read status register.
	TRNE T,%HXMCP		;Ctrl bus parerr?
	 JRST RHRAE
	ANDI A,177777		;Data is only 16 bits.
	JRST POPJ1

RHRAE:	TYPE T,"~&RH11 disk RAE, CS2 = ~H",[T]
	CALL RHCLR
	RET

;;; RHQCLR - Clear disk and controller errors:
;;; RHCLR - Clear controller errors.
;;; I/ disk unit.
;;; Smashes no ACs and does not skip.

RHQCLR:	IOWRQ I,%HRCS2		;Select drive.
	MOVEI T,%HMCLR		;Clear ctlr and drive.
	IOWRQ T,%HRCS1		;Command the disk.
	DELAY US,3
	;; Falls in:
RHCLR:	IOWRQ I,%HRCS2		;Select known unit to avoid Massbus parerr.
	MOVEI T,%HYCLR		;Reset controller errors.
	IOWRQ T,%HRCS2
	MOVEI T,%HXTRE+%HXIE	;Int enable, transfer err bit.
	IOWRQ T,%HRCS1		;Clear errors (doesn't reset drive.)
	IORDQ A,%HRCS2
	RET
];PH
];NTS


SUBTTL	Disk I/O  - RH11
NTS,[
PH,[

;;; Disk routine variables

RHCMD:	0			;Command for the disk
RHIOW:	0			;-#wds,,addr-1 for xfer
RHPGA:	0			;Cylinder,,Head_8+Sector (RH is like RPDA)

RHIOWC:	0			; WC for each xfer.
RHIOBA:	0			; BA for each xfer.

OFFSTF:	0			;-1 iff need to centerline disk heads

OFFSTB:				;Head offsets
IFN RP06P, 230 ? 30 ? 220 ? 20 ? 210 ? 10
IFN RP07P, 0			; Actually, you can't offset an RP07...
IFN RM03P, 220 ? 20
IFN RM80P, 200 ? 0
LOFFSTB==.-OFFSTB		;Retry disk operations this many times.

;;; Smart IO for an RP06, RP07, RM03 or RM80 disk on an RH-11 controller.
;;; READ and WRITE transfer a single ITS block (1024 words).
;;; RW1 is the continuation of other IO routines.
;;;
;;; These routines will break big jobs into multiple xfers and hack the page map.
;;;
;;;   I/ disk unit number
;;;   J/ disk block number
;;;   A/ core address
;;;
;;; Returns T -- Negative for failure.
;;; Never skips.

WRITT:	MOVE I,TOU		;TO unit is often set up here.
WRITE:	HRRZM J,LBLK		;Enter here for writing on disk.
	SKIPA TT,[%HMWRT]
READ:	 MOVEI TT,%HMRED	;Enter here for reading from disk.
T300,[	CAIL I,T300P		;If this is a T-300 unit
	 JRST T3IO ]		; use the T-300 rtns of course.
	MOVEM TT,RHCMD		;Remember command.
	HRRZ T,J		;Get disk block #.
	CAIL T,TBLKS		;Ensure it's in range of total blocks.
	 LOSE "~&No such disk block ~D",[T]
	IDIVI T,NBLKSC		;T gets cylinder, TT gets blocks into it.
	HRLZM T,RHPGA		;Remember which cylinder we want.
	MOVE T,TT		;Blocks into cylinder.
	IMULI T,SECBLK		;Sectors into cylinder.
	IDIVI T,NSECS		;T gets track, TT gets sector.
	LSH T,8			;Gonna complete disk addr format.
	IOR T,TT
	HRRM T,RHPGA		;Remember head_8+sector too.
	MOVEI T,-1(A)		;Xfer destination is addr-1.
	HRLI T,-PG$SIZ		;Xfer length is 1 ITS block.
	MOVEM T,RHIOW		;Remember xfer parameters.

;;; Other IO routines enter here with xfer variables set up.
;;;
;;; RHPGA LH/ cylinder
;;; 	  RH/ device addr (track and sector)
;;;
;;; RHIOW should have the -# PDP10 words to xfer and
;;;       the core address minus one.  From this we compute
;;;	  a UNIBUS address and count used inside the transfer routines.
;;;
;;; Inside these routines:
;;;	Q is the retry count
;;;
;;; (The return protocol described for READ/WRITE is implemented here.)
   
RW1:	PUSHER P,[A,B,C,Q,E,K]	;Smash no ACs.
	MOVEI Q,LOFFSTB		;Number of retries.
QTRY:	CALL QGO		;Attempt disk operation.
	 JRST QWIN		; Won!
	SKIPN HCRASH		;Lost.
	 JRST QRTRY		;Retry under normal circumstances.
	JRST QLOST		;If the pack is crashed, we have failed.

QLOST:	SKIPGE Q		;If there were real disk errors.
	 AOS FERRS		; count them.
	SETO T,			;Failure.
	CAIA
QWIN:	 MOVE T,Q		;Return value in T.
QDONE:	MOVEI A,%HMCEN		;Command to center heads.
	AOSN OFFSTF		;If need to return to centerline
	 CALL RH6CMD		; issue command to do it.
	  NOP			; (Also reset the flag.)
	POPPER P,[K,E,Q,C,B,A]	;Smash no ACs.
	RET

;;; Here for retries.

QRTRY:	DELAY MS,10.		;Wait a bit for good luck (???).
DBG,	TYPE T,"~%Disk retry #~D.",[Q]
	CALL QGO		;Attempt disk operation retry.
	 JUMPGE Q,QWIN		; Won!
	SOJL Q,QLOST		;Don't retry forever.
	MOVSI A,%HROFS		;Let's try offsetting the heads.
	HRR A,OFFSTB(Q)		;Use a different offset each retry.
	SETOM OFFSTF		;Remember to return to centerline later.
	CALL RHSET		;Attack offset register.
	 JRST QLOST		; Eh? 
	RHQCMD %HMOFS		;Offset the heads a little.
	 JRST QLOST		; Eh?
	JRST QRTRY		;If at first you don't succeed...

;;; QGO Attempts an actual disk transfer.
;;; If it succeeds, does NOT skip.
;;; Skip returns if lost.
;;; If really losing, will go directly to QLOST throwing away the return
;;; address on the stack.
;;; The transfer is determined solely by looking at
;;; RHIOW:  -<word count>,,<base address>-1
;;; RHPGA:  <cylinder>,,<track & sector>
;;; RHCMD:  <%HMxxx command>
;;; Each QGO, we map needed space starting with UNIBUS address zero.

QGO:	HLRE T,RHIOW
	MOVNS T			; T: # wds to xfer.
	JUMPLE T,CPOPJ		; The easy case!
	;; Maximum transfer size is 36000, this keeps us in the
	;; low half of the Unibus paging RAM (the part addressable using
	;; 16. bits of Unibus address) even in the worst unaligned case.
	CAILE T,36000
	 MOVEI T,36000
	LSH T,1			; T: # UNIBUS words
	MOVNM T,RHIOWC		; For loading %HRWC

	MOVE T,RHIOW
	MOVEI T,1(T)		; starting address
	LDB A,[090900,,T]	; A: DEC page number
	ANDI T,777		; DEC line number
	LSH T,2			; ... measured in bytes
	MOVEM T,RHIOBA		; For loading %HRBA

	HRLZI T,-32.		; Might as well set up the whole map.
	TRO A,%UQVAL\%UQFST	; Valid and Fast
QGOMAP:	IOWRQ A,UBAPAG(T)
	AOS A
	AOBJN T,QGOMAP

QXBUSY:	CALL RHCLR		;Clear (just) the controller.
	MOVEI B,80000.		;Wait for the disk (up to 1/2 second.)
QXFR2:	RHQGET %HRSTS		;Get drive status register.
	 JRST QXLUZ		; Eh?
	TRNE A,%HSPIP		;Positioning in progress?
	 JRST QXFR3		; Maybe offsetting heads.
	TRNE A,%HSERR		;If errors.
	 JRST [	CALL RHQCLR	; Try clearing drive and controller.
		RHQGET %HRSTS	; Check status now.
		 JRST QXLUZ	;     Really losing.
		TRNE A,%HSERR	; Any errors?
		 JRST QXLUZ	;     Yes.
		JRST .+1 ]
	TRC A,%HSVV+%HSMOL+%HSRDY  ;Valid, Online, and Ready?
	TRCE A,%HSVV+%HSMOL+%HSRDY ;Now is the time for all good bits...
QXFR3:	 SOJG B,QXFR2		;Wait for a little more.
	JUMPLE B,QXLUZ		;Timeout waiting for the disk to look
				; yummy.
	HLRZ A,RHPGA		;OK to gobble the disk.
	TLO A,%HRCYL
	CALL RHSET		;Set Cylinder.
	 JRST QXLUZ
	HRRZ A,RHPGA
	TLO A,%HRADR
	CALL RHSET		;Set Disk Address (track-sector).
	 JRST QXLUZ
	RHQSET %HRWC,RHIOWC	;Set the word count.
	 JRST QXLUZ
	RHQSET %HRBA,RHIOBA	;Reset UNIBUS address for xfer.
	 JRST QXLUZ
	MOVE A,RHCMD		;Get the command.
	SKIPE NOISE
	 CALL [	TYPE T,"~&Disk command: ~D. ",[A]
		CALL GSTS
		RET ]
	CALL RH6CMD		;Do it!
	 JRST QXFR4		; Eh?
	CALL QWAIT		;Wait for completion.
	 JRST QXFR4		; Problem: see what went wrong.
	SKIPE NOISE
	 CALL [	TYPE T,"~&Disk op success: "
		CALL GSTS
		RET ]
	RHQGET %HRWC		;Xfer has succeeded.
	 JRST QXFR4		;Check the resulting word count.
	SKIPE A			;It should have counted down all the way.
	 LOSE "~&Undetected incomplete disk xfer."
	RHQGET %HRBA
	 JRST QXFR4
	SUB A,RHIOBA		; A: # bytes xfered according to BA
	MOVN B,RHIOWC
	LSH B,1			; B: # bytes we intended to xfer
	CAME A,B
	 LOSE "~&Disk xfer confused: Word Count and Bus Address disagree."
	LSH B,-2		; B: # PDP10 words xfered this time
	HRLI B,(B)
	ADDM B,RHIOW		; Update the IO pointer
QXFREX:	RHQGET %HRADR		;Read the updated disk address.
	 JRST QXFR4
	HRRM A,RHPGA		;New disk addr.
	JRST QGO		;Continue until no more to do.

QXFR4:	TYPE T,"~&Disk transfer error on unit ~D.",[I]
	SKIPE NOISE
	 CALL GSTS
	RHQGET %HRSTS		;Transfer has gone awry.
	 JRST QXLUZ		; Eh?
	TRNN A,%HSERR		;Transfer error?
	 JRST QXLUZ		; What the hell?
	RHQGET %HRER2		;Check for unsafes.
	 JRST QXLUZ
	JUMPN A,QUNSAF
IFDEF %HRER3,[
	RHQGET %HRER3
	 JRST QXLUZ
	JUMPN A,QUNSAF
]
	RHQGET %HRER1		;Some kind of soft error.
	 JRST QXLUZ
	TRNE A,%H1OPI+%H1DTE+%H1WLK+%H1IAE+%H1AOE+%H1CRC+%H1WCF+%H1FER+%H1RMR+%H1ILR+%H1ILF			;If really gross error
	 JRST QXLUZ		; abort.
	TRZE A,%H1ECC		;If correctable data error
	 JUMPE A,QECC		; go fix it.
	JRST POPJ1		;Else maybe a retry will work.

QUNSAF: TYPE T,"~&Disk Unit ~O UNSAFE.",[I]
QXLUZ:	POP P,(P)		;Transfer loses completely.
	JRST QLOST

;;; QWAIT - Wait for disk IO completion.
;;; Skip returns unless there were xfer errors.

QWAIT:	PUSHER P,[A]
QWAIT1:	IORDQ A,%HRSTS		;Check drive status.
	TRNN A,%HSPIP		; Wait if positioning in progress.
	 TRNN A,%HSRDY		; Wait until drive ready.
	  JRST QWAIT1		; Wait for transfer completion.
	IORDQ A,%HRCS1		;Check CS1.
	TRNN A,%HXTRE		;Transfer error?
	 AOS -1(P)		; Lossage return.
QWAIT9:	POPPER P,[A]
	RET


SUBTTL	RH11 Error Correction Code

;ERROR CORRECTION CODE -- TAKEN FROM MAINDEC-10-DDRPF
; THAT CODE HAD NO HOPE WHATSOEVER OF WORKING.  RETAKEN FROM ITS.
; THAT CODE DIDN'T WORK EITHER.  TAKEN FROM NEWER ITS.
; MODIFIED FOR RH-11 CONTROLLER (UNIBUS).
; THAT WAS WRONG TOO, SO MOON TOLD US HOW TO FIX IT.  (BUT WE HAVEN'T
; DONE IT YET.)
; Alan finally wrote this based on the RH11 version in ITS.

QECC:	MOVE TT,RHCMD		;Examine command.
	TRNN TT,10		;If writing just retry
	 JRST [	TYPE T,"~&ECC Error while writing?"
		RET ]
	PUSHER P,[A,B,C,D,E]
	RHQGET %HRPOS
	 JRST QECCLZ
	MOVE D,A		; D: ECC error position
	RHQGET %HRPAT
	 JRST QECCLZ
	MOVE B,A		; B: ECC error pattern.
	SOJL D,QECCLZ		; Hardware position is off by 1.  If 0,
				; error is not correctable.
	IDIVI D,36.		; D, E: Word # within sector, Bit #
	CAIL D,177		; If last word in sector,
	 JRST [	ADDI E,36. ? SOJA D,.+1 ]	; hack it to avoid NXM
	RHQGET %HRBA
	 JRST QECCLZ
	SUB A,RHIOBA
	TRNE A,777
	 LOSE "~&Didn't stop at sector boundary?"
	LSH A,-2		; A: # of words transfered
	ADDI D,-200(A)		; D: Word # within transfer
	HRRZ C,RHIOW		; C: Transfer base address - 1
	ADDI D,1(C)		; D: Word # in memory
	SETZI C,
	ROTC B,(E)
	MOVS B,B
	MOVS C,C		; B!C: bits to correct
RWECCB::			;SET BREAKPOINT HERE IF DON'T TRUST.
	XORM B,0(D)
	XORM C,1(D)
	HRLI A,(A)
	ADDM A,RHIOW		; Update the IO pointer
	RHQGET %HRADR		;Read the updated disk address.
	 JRST QECCLZ
	HRRM A,RHPGA		;New disk addr.
	HLRZ A,RHPGA
	LDB B,[$HATRK RHPGA]
	LDB C,[$HASEC RHPGA]
	SOJL C,[
	  MOVEI C,NSECS-1
	  SOJGE B,.+1
	  MOVEI B,NHEDS-1
	  JRST .+1 ]
	TYPE T,"~&ECC Corrected error: Unit #~O Cylinder ~O Head ~O Sector ~O",[I,A,B,C]
	AOS CERRS		; Count an ECC performed.
	POPPER P,[E,D,C,B,A]
	JRST QGO		;Continue until no more to do.

QECCLZ:	POPPER P,[E,D,C,B,A]
	TYPE T,"~&ECC lost."
	JRST QXLUZ		;Transfer loses.

];PH
];NTS


SUBTTL	RH10 Controller Routines

;ROUTINES TO ACCESS RH10 CONTROLLER AND DRIVE REGISTERS
;CALL WITH
;	I  UNIT NUMBER
;	A  REGISTER NUMBER IN LH
; NON-SKIP RETURN IF RAE ERROR
; SKIP RETURN IF WIN
;CLOBBERS ONLY A

;SET REGISTER.  TAKES DATA TO GO IN REGISTER IN RH OF A
;CLOBBERS A (PROBABLY)

NTS,[
RH,[

RHSET:	TLOA A,%HRLOD		;TELL HARDWARE IS SET INSTEAD OF GET
				;AND FALL INTO RHGET

;GET REGISTER.  RETURNS 16 BITS RIGHT-JUSTIFIED IN A

RHGET:	 TLZ A,%HRLOD
	TLO A,(I)		;INSERT PHYS DRV NO
	DATAO DSK,A		;TELL RH10 TO FETCH REGISTER
	MOVEM A,RHLAST'		;SAVE FOR REBUGGING
	MOVEI A,4		;ENSURE 3 USEC DELAY BEFORE DATAI
	SOJG A,.		;TO ALLOW MASSBUS TRANSACTION TO COMPLETE
	DATAI DSK,A		;GET REG CONTENTS AND FLAGS
	TLNE A,%HDERR		;ERROR?
	 JRST RHRAE		;YES, GO REPORT
	ANDI A,177777		;MASK TO 16 BITS
	AOS (P)			;AND TAKE SUCCESS RETURN
	RET

RHRAE:	MOVSI A,%HRRAE+%HRLOD(I)
	DATAO DSK,A		;CLEAR RAE REGISTER IN CONTROLLER
	RET			;AND TAKE NON-SKIP RETURN

;DISK ROUTINE VARIABLES

RHCMD:	0	;%HMRED OR %HMWRT
RHIOW:	0	;IOWD -NWDS,,ADR-1 FOR TRANSFER
RHTIOW:	0	;TEMPORARY IOWD FOR CONTINUING FROM ECC
RHPGA:	0	;DISK ADDRESS CYL,,HED_8+SEC
RHTPGA:	0	;TEMPORARY DISK ADDRESS FOR CONTINUING FROM ECC
RHSUCC:	0	;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED BEFORE ECC

];RH
];NTS

SUBTTL	Disk I/O - RH10
      
NTS,[
RH,[
; ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
.SEE RHCMD ;VARIABLES CONTROLLING WHAT GOES ON HERE
;INSIDE RW2 TT GENERALLY HAS THE DISK COMMAND AND T HAS THE RETRY COUNT
;ONLY T AND TT CLOBBERED
;ON RETURN T MINUS IF ERROR

WRITT:	MOVE I,TOU
WRITE:	HRRZM J,LBLK
	SKIPA TT,[%HMWRT]
READ:	 MOVEI TT,%HMRED
T300,[	CAIL I,T300P
	 JRST T3IO
	SETZM T3IOP
];T300P
	MOVEM TT,RHCMD
	HRRZ T,J
	CAIL T,TBLKS
	 JRST 4,.
	IDIVI T,NBLKSC		;TT:=CYLINDER, T:=BLOCKS INTO CYLINDER
	HRLZM T,RHPGA		;SAVE CYLINDER
	MOVE T,TT		;GET BLOCKS INTO CYLINDER
	IMULI T,SECBLK		;SECTORS INTO CYLINDER
	IDIVI T,NSECS		;TT:=HEAD, T:=SECTOR
	LSH T,8		;FORM ADDRESS WORD
	IOR T,TT
	HRRM T,RHPGA		;COMPLETE THE ADDRESS
	MOVEI T,-1(A)		;SET UP IOWD TO TRANSFER ONE BLOCK
	HRLI T,-2000
	MOVEM T,RHIOW
;ENTER HERE WITH RHCMD, RHIOW, AND RHPGA SET UP.  I HAS UNIT#.
RW1:	MOVEI Q,5		;INIT LOSAGE COUNT
	CALL RW2		;TRY
	 JRST RW7		;FAILED
;HERE TO RETURN.  T SAYS WHETHER WINNING OR LOSING.
RW5:	MOVE A,[%HRDCL,,%HMCEN]	;RETURN TO CENTER-LINE IF NECESSARY
	AOSN OFFSTF
	 CALL RHSET
	  NOP
	SKIPGE Q		;Retry countdown in Q.
	 AOS FERRS
	MOVE A,RHIOW		;RESTORE A
	MOVEI A,1(A)
	MOVE T,Q		;Return value in T.
	RET

;HERE IF LOSING.
RW7:	SKIPE HCRASH
	 JRST RWL0		;SPEED IS OF THE ESSENCE, TRY ONLY ONCE
	CALL RW2		;HMM, TRY AGAIN
	 JRST RWLOSS		;STILL LOSING, COGITATE
	JRST RW5		;WINNING NOW

RWLOSS:	MOVSI A,%HROFS		;ATTACK OFFSET REGISTER
	HRR A,OFFSTB(Q)		;SET APPROPRIATE OFFSET VALUE
	SETOM OFFSTF'		;REMEMBER TO RETURN TO CENTERLINE LATER
	CALL RHSET
	 JRST RWL0		;WHAT??
	MOVE A,[%HRDCL,,%HMOFS]
	CALL RHSET
	 JRST RWL0
	MOVEI A,20000.		;WAIT 10 MS OR SO FOR GOOD LUCK
	SOJG A,.
	CALL RW2		;TRY IT NOW
	 SOJGE Q,RWLOSS		;LOSE, TRY WITH DIFFERENT OFFSET
	JUMPGE Q,RW5		;WON, SO TAKE WIN RETURN
RWL0:	SETO Q,			;COMPLETE LOSS, RETURN NOW
	JRST RW5

OFFSTB:	260
	60
	240
	40
	220
	20
;RH10 I/O ROUTINE PROPER
;FIRST STEP IS TO SET UP CHANNEL COMMAND LIST
RW2:	MOVE TT,RHIOW		;SET UP ADDRESSES
	MOVEM TT,RHTIOW
	MOVE TT,RHPGA
	MOVEM TT,RHTPGA
;RE-ENTER HERE AFTER ECC ERROR
RW2OVR:	PUSH P,B
	PUSH P,C
	MOVE A,[-6,,SLVIOWD]	;POINTS TO WHERE CCWS WILL BE STORED
	HLRO C,RHTIOW		;MINUS NUMBER OF WORDS TO TRANSFER
	MOVNS C			;POSITIVE
	HRRZ B,RHTIOW		;ADDRESS MINUS ONE
RW2CC1:	MOVN TT,C		;WORDS TO TRANSFER IN THIS CCW
	CAIL C,40000-200	;WC IS ONLY A 14-BIT FIELD
	 MOVNI TT,40000-200
	MOVEM B,(A)		;STORE CA
	DPB TT,[$DFWC (A)]	;STORE WC
	ADD C,TT		;LESS WORDS TO DO
	SUB B,TT		;ADVANCE ADDRESS
	AOBJP A,[HALT .]	;ADVANCE CCW PTR, HALT IF TOO BIG!
	JUMPG C,RW2CC1		;NEED MORE WORDS
	SETZM (A)		;END CCW LIST
	HRRZI A,SLVIOWD		;POINT CHANNEL AT IT
	MOVEM A,SLVICWA
	SETZM SLVICWA+1		;INIT FOR CONTROL WORD WRITING
	POP P,C
	POP P,B
	MOVEI A,SLVICWA		;BUILD DATAO CMD
	MOVE TT,RHCMD
	DPB A,[$HCICWA TT]
	TLO TT,%HRCTL		;FILL OUT COMMAND WORD
		;NOW BEFORE GIVING COMMAND CHECK STATUS
	CONSZ DSK,%HIBSY	;WAIT FOR DSK CONTROL
	 JRST .-1
	CONO DSK,%HOCLR		;CLEAR ANY LEFT-OVER ERROR INDICATORS
RW2A:	MOVSI A,%HRSTS		;CHECK DRIVE STATUS
	CALL RHGET
	 JRST RW3		;DRIVE VANISHED??
	TRNE A,%HSPIP		;WAIT FOR POSITIONING
	 JRST RW2A		;(MIGHT BE OFFSETTING HEADS?)
	TRNE A,%HSERR		;ANY ERRORS IN DRIVE?
	 JRST RW6		;YES, TRY TO RECOVER
	TRC A,%HSVV+%HSMOL+%HSRDY ;CHECK FOR ALL READY BITS ON
	TRCE A,%HSVV+%HSMOL+%HSRDY
	 JRST RW3		;NOT READY??
	HLRZ A,RHTPGA		;SET CYLINDER
	TLO A,%HRCYL
	CALL RHSET
	 JRST RW3
	HRRZ A,RHTPGA		;SET TRACK-SECTOR
	TLO A,%HRADR
	CALL RHSET
	 JRST RW3
KL,[	MOVE A,RHTIOW		;SWEEP THE CACHE
	AOS A			;RH ADDRESS OF BUFFER, LH - # WDS
	LSH A,-9.
	TRZ A,777000
	TLO A,777000		;A NOW HAS AOBJN PTR TO PAGES
RWSWP3:	TRNE TT,10		;SWEEP ONE PAGE
	 SWPIO (A)		;IF READING, INVALIDATE
	TRNN TT,10
	 SWPUO (A)		;IF WRITING, UNLOAD
	CONSZ 200000	;WAIT UNTIL SWEEPER WAKES
	 JRST .-1
	AOBJN A,RWSWP3
	SWPUO 0			;STORE CHANNEL PROGRAM IN CORE
	CONSZ 200000
	 JRST .-1
];KL
;DROPS THROUGH
;DROPS IN
RWGO:	MOVE A,TT		;ISSUE I/O COMMAND
	CALL RHSET
	 JRST RW3
	CONSO DSK,%HIDONE	;WAIT FOR COMPLETION
	 JRST .-1
	MOVSI A,%HRSTS		;CHECK DISK STATUS, ERRORS DON'T ALWAYS SHOW UP IN CONI
	CALL RHGET
	 JRST RW3
	TRNN A,%HSERR
	 CONSZ DSK,%HIERR
	  CAIA
	   JRST POPJ1		;NO ERROR, SKIP RETURN FROM RW2
;FOLLOWING TWO LINES CAUSE ECC NOT TO WORK
;	CONSO DSK,%HIEXC
;	 RET		;NOT DRIVE EXCEPTION, PROBABLY CORRIGIBLE BY RETRY
	TRNN A,%HSERR		;ANYTHING IN ERR REGS?
	 JRST RW3		;FOO, WHAT IS GOING ON??
	MOVSI A,%HRER2		;MAKE SURE NO UNSAFES
	CALL RHGET
	 JRST RW3
	JUMPN A,RW3
IFDEF %HRER3,[
	MOVSI A,%HRER3
	CALL RHGET
	 JRST RW3
	JUMPN A,RW3
]
	MOVSI A,%HRER1		;GET ERROR1 REG
	CALL RHGET
	 JRST RW3
	TRNE A,077067		;GROSS ERROR?
	 JRST RW3		;YES, ABORT
	TRZE A,100000		;SEE IF CORRECTABLE DATA ERROR
	 JUMPE A,RWECC		;YES, GO FIX IT
	RET			;ERROR, BUT RETRY MAY WIN
	  
RW6:	MOVE A,[%HRDCL,,%HMCLR]	;ERROR IN DRIVE, TRY CLEARING
	CALL RHSET
	 JRST RW3
	MOVSI A,%HRSTS
	CALL RHGET
	 JRST RW3
	TRNN A,%HSERR
	 JRST RW2A		;WON
				;LOST, FALL INTO RW3

RW3:	POP P,(P)		;UNCORRECTABLE ERROR, RW FAILS
	JRST RWL0


SUBTTL	RH10 Error Correction Code

;ERROR CORRECTION CODE -- TAKEN FROM MAINDEC-10-DDRPF
; THAT CODE HAD NO HOPE WHATSOEVER OF WORKING.  RETAKEN FROM ITS.
; THAT CODE DIDN'T WORK EITHER.  TAKEN FROM NEWER ITS.

RWECC:	TRNN TT,10		;SKIP IF READ
	 RET		;RETRY IF WRITE
	PUSHER P,[B,W,U,J,K,E]
		DW1==W		;FIRST WORD IN ERROR
		DW2==U		;SECOND WORD IN ERROR
		EP1==J		;FIRST WORD OF ERROR PATTERN
		EP2==K		;SECOND WORD OF ERROR PATTERN
		ADR==E		;ADDRESS OF LOSING WORDS
		;B		;SO CAN DIVIDE A
	SKIPN A,SLVICWA+1	;GET ADDRESS OF LAST WORD TRANSFERRED
	 JRST 4,.-1		;CHANNEL SHOULD HAVE STORED CONTROL WORD
	SOS ADR,A		;LAST WORD TRANSFERRED (SUPPOSEDLY)
	ANDI ADR,-200		;IN ANY CASE, THIS MAKES ADR TO START OF SECTOR
	HRRZ A,RHTIOW		;ADR-1 OF START OF TRANSFER
	SUBM ADR,A
	SOS B,A			;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED
	MOVEM B,RHSUCC		;SAVE
	HLRO K,RHTIOW
	MOVNS K
	CAIL B,0		;CHECK FOR CHANNEL LYING
	 CAILE B,-200(K)
	  JRST RWECC3		;FRAUD, TRANSFERRED NEGATIVE OR TOO MANY WORDS
	MOVSI A,%HRPOS		;GET ERROR POSITION
	CALL RHGET
	 JRST RWECC3
	SOJL A,RWECC3		;WHICH IS OFF BY 1.  IF ZERO, LOSE.
	IDIVI A,36.		;CONVERT TO WORD AND BIT
	ADD ADR,A
	MOVS DW1,(ADR)		;FETCH THE TWO LOSING WORDS
	MOVS DW2,1(ADR)
	MOVSI A,%HRPAT		;GET ERROR PATTERN
	CALL RHGET
	 JRST RWECC3
	MOVE EP1,A
	SETZ EP2,
	ROTC EP1,(B)		;ALIGN IT
	XOR DW1,EP1		;FIX THE ERRONEOUS BITS
	XOR DW2,EP2
RWECCB:		;SET BREAK HERE IF DON'T TRUST...
	MOVSM DW1,(ADR)		;PUT CORRECTED DATA BACK
	MOVSM DW2,1(ADR)
	POPPER P,[E,K,J,U,W]

	AOS CERRS		;COUNT NUMBER OF TIMES ECC DONE
	MOVEI A,%HMCLR		;CLEAR THE ECC-ERROR CONDITION
	CALL RHSET
	 NOP
	MOVEI A,200		;ALLOW FOR THE SECTOR WE CORRECTED
	ADDB A,RHSUCC		;GET BACK NUMBER OF WORDS TRANSFERRED
	IDIVI A,200		;NUMBER OF SECTORS TRANSFERRED INCLUDING CORRECTED ONE
	LDB B,[$HASEC RHTPGA]	;UPDATE DISK ADDRESS
	ADD A,B
	IDIVI A,NSECS
	DPB B,[$HASEC RHTPGA]
	LDB B,[$HATRK RHTPGA]
	ADD A,B
	DPB A,[$HATRK RHTPGA]	;NO NEED TO IDIVI A,NHEDS SINCE ALL XFERS WITHIN CYLINDER
	MOVE A,RHSUCC		;NOW ADVANCE CCW
	HRL A,A
	ADDB A,RHTIOW
	POP P,B
	TLNE A,-1
	 JRST RW2OVR		;NOT EXHAUSTED, CONTINUE DISK XFER
	JRST POPJ1		;ECC IN LAST SECTOR OF XFER, XFER COMPLETED SUCCESSFULLY

RWECC3: POPPER P,[E,K,J,U,W,B]
	JRST RW3
];RH10
];NTS

SUBTTL	Disk I/O - DC10

NTS,[
DC,[
WRITT:	MOVE I,TOU
WRITE:	HRRZM J,LBLK
	SKIPA T,[DWR]
READ:	 MOVEI T,DRD		;A/ CORE LOCN, I/ DRIVE  J/TRACK #
	HRRM T,DGO
	PUSH P,B
	MOVE B,T
	HRRZM J,BLK
	MOVEM I,UNIT
	HRRZ TT,I
	CAIL TT,NUNITS
	 HALT .
	HRRZ TT,J		;Get block #.
	CAIGE TT,TBLKS		;Make sure in range.
	 SKIPGE TT
	  HALT .
	MOVE TT,QTRAN(I)	;Get physical drive #.
	DPB TT,[DUNFLD (B)]	;Stuff into command.
	DPB A,[DCCA 1(B)]
	DPB A,[DCCA 4(B)]
	POP P,B
	HRRZ T,J		;Get block #.
	CAIL T,NBLKS+XBLKS
	 HALT .
	IDIVI T,NSECS
	DPB TT,[DSECT @DGO]
	IDIVI T,NHEDS
	DPB TT,[DSURF @DGO]
	MOVE TT,T
	SKIPGE QTRAN(I)
	 ADDI TT,NCYLS+XCYLS	;MAP INTO 2ND HALF OF CALCOMP
	DPB TT,[DCYL @DGO]
	MOVE TT,PKNUM(I)
	CAIL T,NCYLS
	 MOVEI TT,0
	DPB TT,[DPKID @DGO]
	HRRZ T,DGO
	MOVE TT,(T)
	TLZ TT,340000		;CHANGE TO READ COMPARE
	MOVEM TT,3(T)
RW1:	MOVEI Q,30.
	SKIPE HCRASH
	 MOVEI Q,0		;SPEED IS OF THE ESSENCE - TRY ONLY ONCE
RW2:	CONO DC0,DCCSET\DCDENB
	DATAO DC0,DGO
	MOVSI TT,3		;WAIT AT MOST 3 SECONDS
	CONSZ DC0,DSSACT
	 SOJGE TT,.-1
	JUMPL TT,[ PUSHER P,[T,TT]
		   CALL RECAL
		   POPPER P,[TT,T]
		   JRST .+2 ]
	CONSZ DC0,DSSERR
	 SOJGE Q,RW2
	SKIPGE Q
	 AOS FERRS
	MOVE T,Q		;Return result in T.
	RET

DGO:	DJMP .

DRD:	DREAD+DUNENB
	DCOPY .(-2000_2&37774)
	DCOPY RXWDS(-4_2&37774)
	DRC
	DCCOMP .(-2000_2&37774)
	DCCOMP RXWDS (-4_2&37774)
	DHLT

DWR:	DWRITE+DUNENB
	DCOPY .(-2000_2&37774)
	DCOPY WXWDS(-4_2&37774)
	DRC
	DCCOMP .(-2000_2&37774)
	DCCOMP WXWDS(-4_2&37774)
	DHLT

];DC
];NTS


SUBTTL	Disk I/O - T300

NTS,[
T300,[    ;;;  (Fall in from WRITE)

;ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
; TT %HMWRT OR %HMRED
;ONLY T AND TT CLOBBERED
;ON RETURN T MINUS IF ERROR

T3IO:	PUSHER P,[A,B,C,D]
	SETOM T3IOP'
	CAIE TT,%HMRED		;GET READ OR WRITE COMMAND
	 SKIPA D,[%DMWRT]
	  MOVEI D,%DMRED
T3IO1:	HRRZ A,J		;GUBBISH IN LH
	IDIVI A,NBLKC1		;A CYLINDER, B BLOCK WITHIN CYLINDER
	MOVEM A,DSCCYL
	IMULI B,SECBL1		;B SECTOR WITHIN CYLINDER
	IDIVI B,NSECS1		;B HEAD, C SECTOR
	MOVEM B,DSCHED
	MOVEM C,DSCSEC
	MOVE B,-3(P)		;ORIGINAL ADDRESS
	HRLI B,730000		;12-BIT BYTES, START WITH FIRST BYTE IN WORD
	MOVE C,[-4,,DSCPNT]	;SET UP BYTE POINTERS
	MOVEM B,(C)
	ADDI B,400
	AOBJN C,.-2
KL,[	SWPUA			;DUMP EVERYTHING OUT OF CACHE
	CONSZ 200000
	 JRST .-1
];KL
	CALL T3CMD		;PERFORM THE OPERATION
	JUMPE T,T3IO2		;RETURN IF SUCCESS
	MOVE A,T		;SEE IF ERROR MAY BE RECOVERABLE
	TRZ A,%DSECH+%DSIDE+%DSHCE
	JUMPN A,T3IO3		;IF IRRECOVERABLE
	TRNE D,%DMRED		;OR IF NOT A READ COMMAND
	 CAIN D,%DMRED+10	;OR IF TRIED ALL RECOVERY FEATURES
T3IO3:	  TLOA T,(SETZ)		;ENSURE T NEGATIVE TO INDICATE ERROR
	   AOJA D,T3IO1		;OTHERWISE RETRY USING NEXT ERROR RECOVERY FEATURE
T3IO2:	POPPER P,[D,C,B,A]
	RET

;;; Do command in D on drive number in I, return status in T (0 if ok)
;;; You must set up DSCCYL, etc. before calling
;;; LH(T) gets DSCFLT, RH(T) gets DSCSTS

T3CMD:	MOVEI T,2561
	MOVEM T,DSCCHK
	MOVEM D,DSCCMD
	MOVEI T,-T300P(I)
	MOVEM T,DSCDRV
	SETZM DSCDON
KL,[	SWPUO 0			;UNLOAD PAGE 0 FROM THE CACHE
	CONSZ 200000
	 JRST .-1
];KL
	MOVEI T,1
	MOVEM T,DSCREQ
KL,[	SWPUO 0			;UNLOAD PAGE 0 FROM THE CACHE
	CONSZ 200000	;AGAIN SO 11 WILL SEE DSCREQ ON IN INTERRUPT
	 JRST .-1
];KL
	CONO DLC,100040		;INTERRUPT 11
	MOVEI T,60000.		;I THINK THIS TIMEOUT IS ABOUT 3 SECONDS
				;UNFORTUNATELY, THIS TIMEOUT DOESN'T WORK ANYWAY
				;REALLY, BECAUSE IF DRIVE 0 IS OFFLINE THE
				;CONTROLLER HANGS AND EXECUTES COMMANDS WRONG
				;AND OTHERWISE LOSES ITS ASS.
T3CMD1:
KL,[	SWPUO 0			;UNLOAD PAGE 0 FROM THE CACHE
	CONSZ 200000	;AGAIN SO DSCDON GETS PICKED UP FROM MAIN MEMORY
	 JRST .-1
];KL
	SKIPN DSCDON
	 SOJG T,T3CMD1
	JUMPLE T,[ MOVSI T,(SETZ)	;SIGNAL TIMEOUT (DRIVE OFFLINE?)
		   RET ]	;DSCFLT & DSCSTS WILL SAY NON-ERROR
	SETZM DSCDON
	CONO DLC,10		;11 IS TRYING TO INTERRUPT -10, TURN IT OFF
	HRLZ T,DSCFLT
	HRR T,DSCSTS
	TRZE T,%DSRTR+%DSECC	;THESE ARE NOT ERRORS	
	 AOS CERRS
	RET

];T300P
];NTS


SUBTTL	Disk I/O - RP10

NTS,[
RP,[


;;; VARIABLES SET UP TO CONTROL TRANSFER
;;; WHEN AN ERROR OCCURS, IT GOES INTO SECTOR AT A TIME MODE, AND 
;;; THESE VARIABLES ARE STEPPED ALONG TO REFLECT THAT.
;;;
;;; Unit is in I

RPAOBJ:	0	;AOBJN ptr to words to be transferred
RPIOCY:	0	;Cylinder to start at
RPIOHD:	0	;Head to start at
RPIOSC:	0	;Sector to start at
RPIOOP:	0	;Command word. SLVICWA already added in

DRD:	DREADC+SLVICWA+5000	;Disable parity error stops.
DWR:	DWRITC+SLVICWA

WRITT:	MOVE I,TOU		;Set TO block.
WRITE:	HRRZM J,LBLK		;Remember block we're hacking.
	SKIPA T,DWR		;Get disk op.
READ:	 MOVE T,DRD
	MOVEM T,RPIOOP		;Remember op.
	HRRZ T,J		;Get block.
	CAIL T,MBLKS+XBLKS	;Make sure it exists.
	 HALT .
	IMULI T,SECBLK		;Set up command.
	IDIVI T,NSECS
	MOVEM TT,RPIOSC
	IDIVI T,NHEDS
	MOVEM TT,RPIOHD
	MOVEM T,RPIOCY
	MOVEM A,RPAOBJ
	MOVNI T,2000
	HRLM T,RPAOBJ

;;; High-level I/O routine.  Tries to do it all at once,
;;; if that loses twice tries it a sector at a time.
;;; If HCRASH is set, try only once.
;;; Smashes T, TT.  Returns T negative if error.

RPIO:	PUSH P,A
	SETZM SLVIOWD+1
	MOVE T,RPAOBJ
	SOS T
	MOVEM T,SLVIOWD
	CALL RPXIO		;Try it.
	 JRST RPIO1
	MOVEI T,102		;Won!
	JRST RPIO9

RPIO1:	SETOM T			;Flag failure.
	SKIPE HCRASH		;If pack crashed
	 JRST RPIO9		; give up.
	CALL RPRCAL		;Else recalibrate, then
	CALL RPXIO		;try it again.
	 JRST RPIO2		; Lost twice try sector at a time.
	MOVEI T,101		;Won!
RPIO9:	SKIPGE T		;If retries
	 AOS FERRS		; Count disk errors.
	POP P,A			;Don't smash ACs.
	RET			;All done.

;;; Sector at a time mode

RPIO2:	MOVEI T,100
	SKIPL TT,RPAOBJ
	 JRST RPIO9		;Transfer exhausted, won.
	SOS TT
	HRLI TT,-200
	MOVEM TT,SLVIOWD
	MOVEI T,10.		;Try this sector 10 times.
	CALL RPXIO
	 SOJGE T,.-1
	JUMPL T,RPIO9		;Give up.
	MOVE T,[200,,200]	;Advance to next sector.
	ADDM T,RPAOBJ
	AOS T,RPIOSC
	CAIGE T,NSECS
	 JRST RPIO2
	SETZM RPIOSC
	AOS T,RPIOHD
	CAIGE T,NHEDS
	 JRST RPIO2
	SKIPL RPAOBJ
	 JRST RPIO2
	HALT .			;Cylinder overflow?

;;; Low-level IO, just do the operation specified in the variables.
;;; Clobber A,TT.
;;; Skip if success.

RPXIO:	MOVEI TT,SLVIOWD	;Set up DF10 command.
	HRRZM TT,SLVICWA
	SETZM SLVICWA+1
	PUSH P,T		;Don't clobber retry count.
	CALL SEEK		;Make sure at desired cylinder.
	 JRST POPTJ		; Seek failed?
	POP P,T			;Recover try count.
	MOVE A,RPIOOP		;Set up DATAO.
	DPB I,[DUNFLD A]
	MOVE TT,RPIOCY
	DPB TT,[DCYL A]
	LSH TT,-8		;For an RP03.
	DPB TT,[DCYLXB A]
	MOVE TT,RPIOHD
	DPB TT,[DSURF A]
	MOVE TT,RPIOSC
	DPB TT,[DSECT A]
	CONO DPC,DCLEAR
	SKIPN HCRASH		;If pack crashed
	 DATAO LIGHTS,A		; Maybe luser monitoring something in lights?
	DATAO DPC,A		;Issue command
	CONSO DPC,DONE		;Await done.
	 JRST .-1
	CONSZ DPC,ALLER		;Skip-return unless error.
	 RET
	HLRO TT,RPAOBJ		;Seems successful, check the channel control word stored
	HRRZ A,RPAOBJ
	SUB A,TT		;Supposed end of transfer.
	HRRZ TT,SLVICWA+1
	CAIE A,1(TT)		;Finished?
DF10FK:	 RET			; No, channel trying to fuck you over.
	JRST POPJ1		;Yes.

;;; Recalibrate unit in I, smashes T,TT.

RPRCAL:	CONO DPC,DCLEAR
	MOVE T,[DEASEC 776]
	DPB I,[DUNFLD T]	;LEAVE PROPER UNIT SELECTED FOR GETSTS
	DATAO DPC,T		;CLEAR ATTNS
	DPB I,[DUNFLD DRST]
	DATAO DPC,DRST
RPRCL1:	DATAI DPC,TT
	TLNN TT,(ONLINE)
	 RET			;OFF LINE
	TLNE TT,(NSCHDR)
	 RET			;NO SUCH DRIVE
	TRNN TT,776
	 JRST RPRCL1		;AWAIT ATTENTION
	DATAO DPC,T		;GOT ATTENTION, CLEAR IT
RPRCL2:	TLNE TT,(ONCYL+SKINC)
	 RET			;DONE
	DATAI DPC,TT
	JRST RPRCL2		;ON CYLINDER SOMETIMES TAKES A WHILE TO SET

;;; Seek to cylinder in RPIOCY on unit I.
;;; Smashes T,TT, Skips on success.

SEEKC:	0

SEEK:	MOVEI TT,10.
	MOVEM TT,SEEKC
SEEK1:	CONSZ DPC,BUSY
	 JRST .-1
	DATAO DPC,[DEASEC 776]
	MOVSI TT,(DSEEKC)
	DPB I,[DUNFLD TT]
	MOVE T,RPIOCY
	DPB T,[DCYL TT]
	LSH T,-8		;FOR RP03
	DPB T,[DCYLXB TT]
	SKIPN HCRASH
	 DATAO LIGHTS,TT
	CONO DPC,DCLEAR
	DATAO DPC,TT
	MOVE T,[DEASEC 776]
	DPB I,[DUNFLD T]	;LEAVE PROPER UNIT SELECTED FOR GETSTS
	CALL RPRCL1		;AWAIT COMPLETION
	TLNE TT,(ONCYL)		;SUCCEED IF ON CYLINDER
	 JRST POPJ1
	SOSGE T,SEEKC		;COUNT FAILURES
	 RET			;GIVE UP
	CALL RPRCAL		;RECALIBRATE
	JRST SEEK1		;AND TRY AGAIN
];RP
];NTS


SUBTTL	Cylinder I/O  for RH10/RH11

NTS,[
RHPH,[
READCY:	SKIPA TT,[%HMRED]
WRITCY:	 MOVEI TT,%HMWRT
T300,[	CAIL I,T300P
	 LOSE "~&SALV:Cylinder IO not implemented for T-300s"
];T300
	MOVEM TT,RHCMD		;Set up command.
	HRLZM J,RHPGA		;First half Addr: Track 0, sector 0.
	MOVEI T,-1(A)		;Specify cylinder.
	HRL T,[-SECTOR*NHEDS*NSECS] ;Xfer entire cylinder.
	MOVEM T,RHIOW
	CALRET RW1		;Continue into smart disk code.
];RHPH
];NTS


SUBTTL	Cylinder I/O for RP10

NTS,[
RP,[

;;; RP10 cylinder I/O always succeeds.  If problems occur, goes sector
;;; at a time, typing out what is going on, zeroing sectors that can't be read,
;;; then returns claiming to have won.

READCY:	SKIPA T,DRD
WRITCY:	 MOVE T,DWR
	MOVEM T,RPIOOP
	MOVEM J,RPIOCY
	SETZM RPIOHD
	SETZM RPIOSC
	MOVEM A,RPAOBJ
	MOVNI T,NBLKSC*2000
	HRLM T,RPAOBJ
RPCY0:	CALL RPIO
	JUMPGE T,CPOPJ		;WON

IFN 0,[				;Someone doesn't think this code works
	SKIPE HCRASH
	 RET
	MOVE T,RPIOOP
	CAMN T,DWR
	 JRST [	TYPE WRITE ERROR ON BLOCK 
		JRST .+3 ]
	  TYPE READ ERROR ON BLOCK 
	PUSH P,A
	PUSH P,B
	MOVE A,I
	CALL DPT
	TYPE -
	MOVE A,RPIOHD
	IMULI A,NSECS
	ADD A,RPIOSC
	IDIVI A,SECBLK
	MOVE B,RPIOCY
	IMULI B,NBLKSC
	ADD A,B
	CALL DPT
	CRR
	POP P,B
	POP P,A
	CALL GSTS		;EXPLAIN WHAT HAPPENED TO THIS SECTOR
	MOVE T,RPIOOP		;IF READ, ZERO THE BUFFER
	HRLZ TT,RPAOBJ		;IF WAS REALLY IN SECTOR AT A TIME MODE
	CAMN T,DRD
	 CAIE TT,-200
	  JRST RPCY1
	MOVE TT,RPAOBJ
	SETZM (TT)
	HRLZ T,TT
	HRRI T,1(TT)
	BLT T,177(TT)
RPCY1:	AOS T,RPIOSC		;ADVANCE TO NEXT SECTOR
	CAIGE T,NSECS
	 JRST RPCY2
	SETZM RPIOSC
	AOS T,RPIOHD
	CAIL T,NHEDS
	 RET		;MUST BE DONE
RPCY2:	MOVE T,[200,,200]
	ADDB T,RPAOBJ
	JUMPL T,RPCY0		;GO DO THE REST OF THE CYLINDER
];IFN0
	RET			;HMM, MUST BE DONE
];RP
];NTS


SUBTTL	Cylinder I/O for DC10
NTS,[
DC,[

READCY:	SKIPA T,[DREADC+DUNENB]		;READ CONTINUOUS
WRITCY:	MOVSI T,(DWRITC+DUNENB)		;WRITE CONTINUOUS
	MOVE TT,QTRAN(I)
	DPB TT,[DUNFLD T]
	MOVE TT,J
	SKIPGE QTRAN(I)
	 ADDI TT,NCYLS+XCYLS
	DPB TT,[DCYL T]
	DPB TT,[DCYL CYLCM3]
CYL1:	SKIPLE TT,PKNUM(I)
	 JRST CYL2
	PUSH P,T
	CALL RESET
	POP P,T
	JRST CYL1

CYL2:	CAIL J,NCYLS
	 MOVEI TT,0
	DPB TT,[DPKID T]
	DPB TT,[DPKID CYLCM3]
	MOVEM T,CYLCOM
	DPB A,[DCCA CYLCM1]
	DPB A,[DCCA CYLCM2]
	MOVEI T,CYLCOM
RW0:	HRRM T,DGO
	JRST RW1		;TRY TRANSFER UNTIL SUCCEEDS

CYLCOM:	0
	DALU+DLDBWC+DLLB -2004*NBLKSC(3)	;LOAD WORD COUNT WITH -2004*NO. OF BLOCKS/CYL
CYLCM1:	DCOPY .
CYLCM3:	DRCC			;READ COMPARE CONTINUOUS
	DALU+DLDBWC+DLLB -2004*NBLKSC(3)
CYLCM2:	DCCOMP .
	DHLT

CYLRIR:	DREAD+DUNENB
	DCOPY CYLBUF(-LRIBLK_2&37774)
CYLRIW:	DWRITE+DUNENB
	DCOPY CYLBUF(-LRIBLK_2&37774)
	DHLT
];DC
];NTS


SUBTTL	Print Disk/Controller Status

;;; WPERR and CPERR are jumped to by various routines.

WRERR:	LOSE "~&Write error."
CPERR:	LOSE "~&Read Error."

;;; Salvaging routines bomb into ACTUEn (QACT problem.)

ACTUE1:	QLOSE "~&Error reading TUT block"
ACTUE3:	QLOSE "~&Error reading MFD block"

;;; For each kind of controller there is a slightly different version of
;;; GETSTS (and GSTS, the workhorse subroutine) which prints the status of
;;; the disk controller and disk registers.  GETSTS is the hand-callable
;;; routine (and ends in DDT with a new stack).  See the next page.

TS,[  	;; Not very useful in timesharing.
GETSTS:	NOP
T3STS:	NOP
GSTS:	RET 
];TS

;;; TYPSTS - Type Status Bits
;;; C/ addr of IO flags table
;;; D/ LH: right justified bits to test

TYPSTS:	PUSHER P,[A,B,C,D]
TYPST1:	SKIPN A,(C)		;A gets a bit and a name string.
	 JRST TYPST9		; Zero marks end of table.
DC,	HLRZ B,A		;Get a bit's mask.
RH,	HLLZ B,A		;(DC10 has them backwards).
RP,	HLLZ B,A
PH,	HRRZ B,A
	TDNN D,B		;Is this one on?
	 JRST TYPST8		; No, try another.
	HLRZ T,A		;Yes - get name string of bit.
	HRLI T,440700		;Bp to it
	TYPE T,"~A  ",[T]	;Type the bit's name.
TYPST8:	AOJA C,TYPST1		;Go for next bit.
TYPST9:	POPPER P,[D,C,B,A]
	RET

;;; Macro to name bit positions in a status word.

DEFINE	STS BIT,MEANS/
	[ASCIZ \MEANS\],,BIT
TERMIN


;;; RH11 version of GSTS

NTS,[
PH,[
GETSTS: ACINIT			;Init stack
	PUSH P,[DDT]		;and return to DDT when done.
GSTS:
T300,[	CAIL I,T300P		;If current disk is a T-300
	 JRST T3STS ]		; Use T300 rtns of course.
	PUSHER P,[A,B,C,D,E,I]	;Smash no ACs.
	TYPE T,"~&RH-11 disk ctl status:  "
	IORDQ T,%HRCS2		;Read CS2.
	LDB A,[$HYDSK T]	;Get controller current unit.
	TYPE T,"I = ~O; Current drive is #~O, which is ",[I,A]
	CALL QCNVT		;Convert to virtual unit.
	 LOSE "not active in the virtual unit table (QTRAN)!"
	TYPE T,"virtual unit #~O",[B]
	IORDQ T,%HRATN
	TYPE T,"~&Disk Attention Summary: ~16<~;0~B~>",[T]
GSTS10:	MOVSI E,-LGSTSR		;Display some IO register's bits.
GSTS12:	MOVE D,GSTSRT(E)
	MOVE A,RHRGTB(E)	;Get Bp to ASCIZ register name.
	HRLI A,440700
	TYPE T,"~&~A = ",[A]	;Type it out.
	HRLZ A,D		;A gets register ptr.
	CALL RHGET		;Read the IO register.
	 JRST [ TYPE T,"~&Error reading IO register ~H",[D]
		JRST GSTS90 ]
	TYPE T,"(~O)~20T",[A]	;Type register contents octally.
	HLRZ C,D		;C gets status bit table ptr.
	MOVE D,A		;Right-justified IO bits.
	CALL TYPSTS		;Type register contents symbolicly.
	AOBJN E,GSTS12		;Loop for all IO registers in GSTSRT.
GSTS20:	IORDQ A,%HRWC		;Word count in 14 bit twos complment.
	JUMPE A,GSTS21
	TDC A,[177777]		;Convert to normal positive number.
	AOS A			;En Guard!
GSTS21:	IORDQ B,%HRBA		;Type other interesting registers.
	TYPE T,"~&Word Count = ~D., Unibus Address = ~O",[A,B]
	IORDQ A,%HRCYL
IFDEF %HRCCY,[
	IORDQ B,%HRCCY
	TYPE T,"~&Desired Cyl = ~D., Current Cyl = ~D.",[A,B]
]
IFNDEF %HRCCY,[
	TYPE T,"~&Desired Cyl = ~D.",[A]
]
	IORDQ A,%HRADR
	LDB B,[$HATRK A]
	LDB C,[$HASEC A]
	TYPE T,"~&Desired Addr = ~O  (Track ~D.  Sector ~D.)",[A,B,C]
	MOVEI A,UBAQ
	ASKYN "~&Do you want to see all the UNIBUS registers "
	 CAIA
	  CALL UBSTS
GSTS90:	POPPER P,[I,E,D,C,B,A]
	RET


DBG,[	;;; Quickie GSTS for debugging.
QGSTS:	PUSHER P,[A,B,C,D]
	IORDQ B,%HRCS2
	LDB A,[$HYDSK B]
	IORDQ B,%HRCS1
	IORDQ C,%HRCS2
	IORDQ D,%HRADR
	TYPE T,"Disk ~O: CS1=~O, CS2=~O, DA=~O, ",[A,B,C,D]
	IORDQ A,%HRCYL
%IFDEF %HRCCY,[
	IORDQ B,%HRCCY
	TYPE T,"DC=~O, CC=~O, ",[A,B]
]
IFNDEF %HRCCY,[
	TYPE T,"DC=~O ",[A]
]
	IORDQ A,%HRBA
	IORDQ B,%HRWC
	MOVE C,B
	JUMPE C,QGSTS1
	TDC C,[177777]
	AOS C
QGSTS1:	TYPE T,"BA=~O, WC=~O (~D.)",[A,B,C]
	POPPER P,[D,C,B,A]
	RET
];DBG


;;; RH11 disk bits

;Implementation note for someday:  Perhaps these tables should be
;generated by a macro available under some switch in each of the
;drive-description insert files.  Information such as the register
;names and the names of the bits is already available in the comments
;there.  The macro for the table of interesting bits could take a mask.
;Then we could at least write something like:
;	GSTS-REG REGNAME %HRCS1,%HRCS1,[QBITS %HRSTS,777777]
;Instead of typing in all this duplicate information in several tables.


GSTSRT:	BLOCK 10.		;Table of register nums and bits.
RHRGTB:	BLOCK 10.		;Names of above registers.

;;; Macro to define table of IO registers which GSTS will display.

LGSTSR==0
DEFINE	GSTSRE BITPTR,REG,&NAME
ZZZ==.
	LOC GSTSRT+LGSTSR
	REG,,BITPTR
	LOC RHRGTB+LGSTSR
	[ASCIZ NAME]
LGSTSR==LGSTSR+1
LOC ZZZ
TERMIN

GSTSRE %HRSTS,STSDS,"Drive Status"
GSTSRE %HRCS1,STSCS1,"Ctrl & Status 1"
GSTSRE %HRCS2,STSCS2,"Ctrl & Status 2"
GSTSRE %HROFS,STSOF,"Offset"
GSTSRE %HRER1,STSER1,"Error 1"
GSTSRE %HRER2,STSER2,"Error 2"
IFDEF %HRER3,[
GSTSRE %HRER3,STSER3,"Error 3"
]

STSCS1:	STS      1,GO
	STS    200,READY
	STS   2000,PORT-SELECT
	STS   4000,DRIVE-AVAILABLE
	STS  20000,MASS-IO-CTL-BUS-PARITY-ERROR
	STS  40000,TRANSFER-ERROR
	STS 100000,SPECIAL-CONDITION
	0	

STSCS2:	STS     20,PARITY-TEST
	STS     40,CONTROLLER-CLEAR
	STS    100,SILO-INPUT-READY
	STS    200,SILO-OUTPUT-READY
	STS    400,MASS-DATA-BUS-PARITY-ERROR
	STS   1000,MISSED-TRANSFER
	STS   2000,PROGRAM-ERROR
	STS   4000,UNIBUS-ADDR-NXM 
	STS  10000,NONEXISTANT-DRIVE
	STS  20000,PARITY-ERROR
	STS  40000,WRITE-CHECK-ERROR
	STS 100000,DATA-LATE
	0

STSDS:
IFN RP07P,[
	STS 1,OFFSET-MODE
	STS 2,EARLY-WARNING
	STS 4,INTERLEAVED-SECTORS
]
	STS 100,VOLUME-VALID
	STS 200,DRIVE-READY
	STS 400,DRIVE-PRESENT
	STS 2000,LAST-SECTOR-XFERD
	STS 4000,WRITE-LOCK
	STS 10000,MEDIUM-ONLINE
	STS 20000,POSITIONING-IN-PROGRESS
	STS 40000,ERR
	STS 100000,ATTENTION
	0

STSER1:	STS 1,ILL-FUNC
	STS 2,ILL-REG
	STS 4,REG-MOD-REFUSE
	STS 10,BUS-PARITY-ERR
	STS 20,PACK-FORMAT-ERR
	STS 40,WRITE-CLOCK-FAIL
	STS 100,ECC-HARD-ERR
	STS 200,HEADER-COMPARE-ERROR
	STS 400,HEADER-CRC-ERR
	STS 1000,ADDR-OVERFLOW
	STS 2000,INVALID-ADDR
	STS 4000,WRITE-LOCK-ERR
	STS 10000,DRV-TIMING-ERR
	STS 20000,OP-NOT-COMPLETE
	STS 40000,UNSAFE
	STS 100000,DATA CHECK
	0

IFN RP06P,[
; RP06 version of ERROR 2 Register
STSER2:	STS 1,WRITE-CURRENT-UNSAFE
	STS 2,CURRENT-SINK-FAILURE
	STS 4,WRITE-SELECT-UNSAFE
	STS 10,CURRENT-SWITCH-UNSAFE
	STS 20,MOTOR-SEQUENCE-ERR
	STS 40,TRANSITIONS-DET-FAIL
	STS 100,TRANSITIONS-UNSAFE
	STS 200,UNSAFE-EXCEPT-R/W
	STS 400,WRITE-READY-UNSAFE
	STS 1000,MULTIPLE-HEAD-SELECT
	STS 2000,NO-HEAD-SELECT
	STS 4000,INDEX-ERROR
	STS 10000,30-VOLT-UNSAFE
	STS 20000,PHASE-LK-OSC-UNSAFE
	STS 100000,AC-UNSAFE
	0
]
IFN RM03P+RM80P,[
;RMxx version of ERROR 2
STSER2:	STS 10,DATA-PARITY-ERROR
	STS 40,SKIP-SECTOR-ERROR
	STS 200,DEVICE-CHECK
	STS 2000,LOST-BITCHECK
	STS 4000,LOST-SYSTEM-CLOCK
	STS 10000,INVALID-COMMAND
	STS 20000,OPERATOR-PLUG-ERROR
	STS 40000,SEEK-INCOMPLETE
	STS 100000,BAD-SECTOR
	0
]

IFN RP07P,[
; RP07 version of ERROR 2 Register
STSER2:	STS 400,WRITE-READY-UNSAFE
	STS 1000,WRITE-OVERRUN
	STS 2000,NO-WRITE-TRANS
	STS 4000,GT-ONE-HEAD-SELECTD
	STS 10000,WRITE-CURRENT
	STS 20000,8080-HUNG
	STS 40000,CROM-PARITY-ERROR
	STS 100000,PROGRAM-ERROR
	0
]

IFN RM03P+RM80P,[
;RMxx version of ERROR 2
STSER2:	STS 10,DATA-PARITY-ERROR
	STS 40,SKIP-SECTOR-ERROR
	STS 200,DEVICE-CHECK
	STS 2000,LOST-BITCHECK
	STS 4000,LOST-SYSTEM-CLOCK
	STS 10000,INVALID-COMMAND
	STS 20000,OPERATOR-PLUG-ERROR
	STS 40000,SEEK-INCOMPLETE
	STS 100000,BAD-SECTOR
	0
]

IFN RP06P,[
; RP06 version of ERROR 3 Register
STSER3:	STS 1,PACK-SPEED-UNSAFE
	STS 2,VELOCITY-UNSAFE
	STS 10,UNSAFE-EXCEPT-R/W
	STS 40,AC-LOW
	STS 100,DC-LOW
	STS 40000,SEEK-INCOMPLETE
	STS 100000,OFF-CYLINDER
	0
]

IFN RP07P,[
; RP07 version of ERROR 3 register
STSER3:	STS 1,RUN-TIMEOUT
	STS 2,SYNC-CLOCK-FAIL
	STS 4,SYNC-BYTE-ERROR
	STS 10,WRITE-DATA-PARITY-ERR
	STS 20,SERDES-DATA-FAILURE
	STS 40,DC-LOW
	STS 100,INDEX-UNSAFE/BAD-HEADER
	STS 200,DEVICE-CHECK
	STS 400,8080-NOT-RESPONDING
	STS 1000,LOSS-OF-CYLINDER
	STS 2000,LOSS-OF-BIT-CLOCK
	STS 4000,LOGIC-CONTROL-FAILURE
	STS 10000,WRITE-CURRENT-FAILURE
	STS 20000,DEFECT-SKIP-ERROR
	STS 40000,SEEK-INCOMPLETE/SEE-ER2
	STS 100000,BAD-SECTOR
	0
]

STSOF:	STS 2000,HDR-COMPARE-INH
	STS 4000,ECC-INHIBIT
	STS 10000,PDP-11-FORMAT
IFN RP07P, STS 40000,MOVE-TRACK-DESCRIPTOR
IFN RP06P, STS 100000,SIGN-CHANGE
IFN RP07P, STS 100000,COMMAND-MODIFIER
	0

];PH


;;; DC10 version of GSTS

DC,[
GETSTS:	ACINIT
	PUSH P,[DDT]
GSTS:	PUSHER P,[A,B,C,D]
	CONI DC0,D
	MOVEI C,DC0STS
	TYPE T,"Controller status:"
	CALL TYPSTS
	CONI DC1,D
	MOVEI C,DC1STS
	CALL TYPSTS
	CONO DC0,DCCSET+DCDENB
	DATAO DC0,[DJMP GETUNT]
	CONSZ DC0,DSSACT
	 JRST .-1
	LDB A,[DUNFLD GOTUNT]
	DPB A,[DUNFLD STOSTS]
	TYPE T,"~&Current unit= ~D, Drive Status:",[A]
	DATAO DC0,[DJMP STOSTS]
	CONSZ DC0,DSSACT
	 JRST .-1
	MOVE D,STATUS
	LSH D,-15.
	MOVEI C,DRVSTS
	CALL TYPSTS
	LDB A,[101100,,STATUS]
	TYPE T,"~%Cylinder=~O",[A]
	POPPER P,[D,C,B,A]
	RET

GETUNT:	DJSR .+1
GOTUNT:	0
	DHLT

STOSTS:	DSDRST+DUNENB STATUS(74)
	DHLT
STATUS:	0


;;; DC10 disk bits

DC0STS:	STS 4000,ERROR-FLG
	STS 1000,ATTENTION
	STS 200,RUN
	STS 100,ACTIVE
	0

DC1STS:	STS 4000,INTERNAL-PARITY-ERROR
	STS 2000,RECORD-LENGTH
	STS 1000,READ-COMPARE
	STS 400,OVERRUN
	STS 200,CHECKSUM/DECODER
	STS 100,BARK!!
	STS 40,FILE-UNSAFE/SEEK-INCOMPLETE/END-OF-DISC
	STS 20,OFF-LINE/MULTIPLE-SELECT
	STS 10,RDG-KEY/PROTECT/READONLY
	STS 4,DATAO-WHILE-BUSY
	STS 2,NON-EX-MEM
	STS 1,CORE-PARITY-ERROR
	0

DRVSTS:	STS 4,UNIT-SELECTED
	STS 10,ON-LINE
	STS 20,READY
	STS 40,SEEK-INCOMPLETE
	STS 100,READ-ONLY
	STS 200,UNSAFE
	STS 400,WRITE-CURRENT-SENSED(?)
	0

];DC

;;; RP version of GSTS

RP,[
GETSTS:	ACINIT
	PUSH P,[DDT]
GSTS:	PUSHER P,[A,B,C,D]
	TYPE T,"~&Disk Status:"
	CONI DPC,D
	MOVEI C,CNLSTS
	TLNE D,-1
	 CALL TYPSTS
	MOVSS D
	MOVEI C,CNISTS
	CALL TYPSTS
	DATAI DPC,D
	TLC D,1			;REVERSE SENSE OF WRITE HEADER LOCKOUT SWITCH
	MOVEI C,DTISTS
	CALL TYPSTS
	LDB A,[DUNFLI D]
	LDB B,[DCYLI D]
	TRNE D,.BM DCYLXI
	 ADDI B,400
	TYPE T,"~&Current unit =~D., Cylinder =~O, ",[A,B]
	TYPE T,"Last addressed cyl=~O, Surf=~O, Sec=~O",[RPIOCY,RPIOHD,RPIOSC]
	POPPER P,[D,C,B,A]
	RET


;;; RP disk bits

; CONI STATUS TABLE (RH)

CNISTS:	STS 400000,SEARCH DONE
	STS 200000,END OF CYLINDER
	STS 100000,POWER FAILURE
	STS 040000,SEARCH ERROR
	STS 020000,OVERRUN
	STS 010000,NXM
	STS 002000,DRIVE NOT READY
	STS 001000,WRITE PROTECT
	STS 000400,DATAO WHEN BUSY
	STS 000200,SECTOR ADDRESS ERROR
	STS 000100,SURFACE ADDRESS ERROR
	STS 000020,BUSY
	STS 000010,DONE
	0

; CONI STATUS TABLE (LH)

CNLSTS:	STS 000010,CONTROL WORD PARITY ERROR
	STS 000004,SECTOR PARITY ERROR
	STS 000002,MEMORY WORD PARITY ERROR
	STS 000001,DISK WORD PARITY ERROR
	0

; DATAI STATUS TABLE (LH)

DTISTS:	STS 000100,SEEK INCOMPLETE
	STS 000040,ON CYLINDER
	STS 000020,DISK ON-LINE
	STS 000010,FILE UNSAFE
	STS 000004,NON EXISTENT DRIVE
	STS 000002,DRIVE IS READ-ONLY
	STS 000001,WRITE HEADER LOCKOUT OFF!!
	0
];RP

;;; RH10 version of GSTS

RH,[
GETSTS:	MOVEI P,PDL
	PUSH P,[DDT]
GSTS:
T300,[	SKIPE T3IOP
	 JRST T3STS ] ;T300P
	PUSHER P,[A,B,C,D,I,K]
	TYPE T,"~&RH10 Controller Status:"
	CONI DSK,D
	MOVEI C,CNLSTS
	TLNE D,-1
	 CALL TYPSTS
	MOVSS D
	MOVEI C,CNISTS
	CALL TYPSTS
	TYPE T,"~&Current register: "
	DATAI DSK,D
	CALL TYPRGN
	MOVE A,D
	TYPE T,"~O",[A]		;TYPE REG NO, STATUS, AND CONTENTS IN OCTAL
	JUMPL D,GSTS0		;DO FOLLOWING ONLY FOR DRIVE REGS
	 TYPE T,","
	 MOVEI C,DIBSTS
	 CALL TYPSTS
	 CAIA			;DON'T GIVE BLANK LINE
GSTS0:	CRR
	LDB A,[$HCDRV D]
	TYPE T,"Current Drive=~D.~%",[A]
	MOVEI I,NUNITS-1	;CONVERT BACK TO VIRTUAL UNIT
	CAME A,QTRAN(I)		;TO MAKE RHGET HAPPY
	 SOJGE I,.-1
	JUMPL I,GSTS3		;FOO!! ADDRESSING NON EXISTENT DRIVE

	MOVSI K,-LGSTSR		;DISPLAY DRIVE REGS SPEC'ED IN TABLE
GSTS1:	MOVE D,GSTSRT(K)
	CALL TYPRGN		;TYPE REG NAME
	HRRZ C,D		;C -> STATUS BIT TABLE
	HLLZ A,D		;A := REG NUMBER
	CALL RHGET		;GET CONTENTS OF REG
	 JRST GSTSER		;??
	TYPE T,"~O ",[A]		;GIVE CONTENTS IN OCTAL
	MOVS D,A		;AND SYMBOLICLY
	CALL TYPSTS
	AOBJN K,GSTS1
GSTS3:	POPPER P,[K,I,D,C,B,A]
	RET

GSTSER:	TYPE T,"BARF:"
	MOVE D,A
	MOVEI C,DIBSTS
	CALL TYPSTS
	JRST GSTS3		;DON'T TRY ANY MORE REGS

TYPRGN:	LDB A,[360600,,D]	;TYPE NAME OF REGISTER ADDRESSED BY D
	ROT A,-1	
	HRRO B,RHRGTB(A)
	JUMPL A,.+2
	 MOVSS B
	TYPE T,"~A= ",[B]
	RET


;;; RH-10 disk and ctrlr bits 

; CONI STATUS (LH)

CNLSTS:	STS 400000,AR FULL
	STS 200000,CB FULL
	STS 040000,CC INH
	STS 020000,CHANNEL ACTIVE
	STS 010000,CHANNEL PULSE
	STS 004000,22-BIT CHANNEL
	STS 000400,CXR ILL FUNC
	STS 000200,CXR DRIVE ACCESS ERR
	STS 000004,MEMORY PARITY
	STS 000002,CONTROL WORD PARITY
	STS 000001,NXM
	0

; CONI STATUS (RH)

CNISTS:	STS 400000,DATA BUS PARITY
	STS 200000,DRIVE EXCEPTION
	STS 100000,CHANNEL ERROR
	STS 020000,CHANNEL OVERRUN
	STS 010000,DRIVE RESPONSE ERR
	STS 004000,CXR ILL CMD
	STS 002000,CXR POWER FAIL
	STS 000200,CONTROL BUS OVERRUN
	STS 000100,RAE INTR
	STS 000040,ATTN INTR
	STS 000020,BUSY
	STS 000010,DONE
	0




;TABLE OF DRIVE REGISTERS THAT NEED TO BE DISPLAYED
; LH = REG ADDR, RH = STATUS BITS TABLE ADDR

GSTSRT:	%HRDCL,,[0]
	%HRSTS,,STSSTS
	%HRCYL,,[0]
IFDEF %HRCCY,[
	%HRCCY,,[0]
]
	%HRADR,,[0]
	%HROFS,,OFSSTS
	%HRER1,,ER1STS
	%HRER2,,ER2STS
IFDEF %HRER3,[
	%HRER3,,ER3STS
]
LGSTSR==.-GSTSRT

; REGISTERS

ZZ==-1
XX==0
YY==0
DEFINE REG N,T/
IFLE N-ZZ, .ERR REG OUT OF ORDER
REPEAT N-ZZ-1, REGH [ASCIZ\????\]
	REGH [ASCIZ\T\]
TERMIN

DEFINE REGH [A]
ZZ==ZZ+1
IFE XX, YY==A
IFN XX, YY,,A
XX==1-XX
TERMIN

RHRGTB:	REG 0,DRV CTL
	REG 1,DRV STATUS
	REG 2,DRV ER1
	REG 3,DRV MAINT
	REG 4,ATTENTION
	REG 5,DRV TRACK-SECTOR
	REG 6,DRV TYPE
	REG 7,DRV LOOK-AHEAD
	REG 10,DRV SERIAL NO
	REG 11,DRV OFFSET
	REG 12,DRV DESIRED CYL
	REG 13,DRV CURRENT CYL
	REG 14,DRV ER2
	REG 15,DRV ER3
	REG 16,DRV ECC POS
	REG 17,DRV ECC PAT
	REG 40,CONTROL
	REG 44,INTR ADDR
	REG 50,DATA BUFFER
	REG 54,RAE STATUS
	REG 74,CHANNEL BUFFER
	REG 100,FOO
LOC RHRGTB+40
EXPUNGE REG,REGH,XX,YY,ZZ

; BITS IN DIB REGISTER

DIBSTS:	STS 004000,CTL-TO-DRIVE
	STS 002000,CTL BUS TIMEOUT
	STS 001000,CTL BUS PARITY
	STS 000400,DIB DATA LATE
	STS 000200,DIB ILL CMD
	0

; DRIVE STATUS REGISTER

STSSTS:	STS 1,FWD 5 IPS
	STS 2,FWD 20 IPS
	STS 4,INNER GUARD BAND
	STS 10,GO REVERSE
	STS 20,DIFF < 64
	STS 40,DIFF = 1
	STS 100,VOLUME VALID
	STS 200,DRIVE READY
	STS 400,CONN THIS CTRLR
	STS 2000,LAST SECTOR XFERD
	STS 4000,WRITE LOCK
	STS 10000,MEDIUM ONLINE
	STS 20000,POSITIONING IN PROGRESS
	STS 40000,ERR
	STS 100000,ATTENTION
	0

; DRIVE ERROR REGISTER 1

ER1STS:	STS 1,ILL FUNC
	STS 2,ILL REG
	STS 4,REG MOD REFUSE
	STS 10,BUS PARITY ERR
	STS 20,PACK FORMAT ERR
	STS 40,WRITE CLOCK FAIL
	STS 100,ECC HARD ERR
	STS 200,HEADER WRONG
	STS 400,HEADER CRC ERR
	STS 1000,ADDR OVERFLOW
	STS 2000,INVALID ADDR
	STS 4000,WRITE LOCK ERR
	STS 10000,DRV TIMING ERR
	STS 20000,OP NOT COMPLETE
	STS 40000,UNSAFE
	STS 100000,DATA CHECK
	0

; DRIVE ERROR REGISTER 2

ER2STS:	STS 1,WRITE CURRENT UNSAFE
	STS 2,CURRENT SINK FAILURE
	STS 4,WRITE SELECT UNSAFE
	STS 10,CURRENT SWITCH UNSAFE
	STS 20,MOTOR SEQUENCE ERR
	STS 40,TRANSITIONS DET FAIL
	STS 100,TRANSITIONS UNSAFE
	STS 200,"UNSAFE EXCEPT R/W"
	STS 400,WRITE READY UNSAFE
	STS 1000,MULTIPLE HEAD SELECT
	STS 2000,NO HEAD SELECT
	STS 4000,INDEX ERROR
	STS 10000,30 VOLT UNSAFE
	STS 20000,PHASE LK OSC UNSAFE
	STS 100000,AC UNSAFE
	0

; DRIVE ERROR REGISTER 3

ER3STS:	STS 1,PACK SPEED UNSAFE
	STS 2,VELOCITY UNSAFE
	STS 10,UNSAFE EXCEPT R/W
	STS 40,AC LOW
	STS 100,DC LOW
	STS 40000,SEEK INCOMPLETE
	STS 100000,OFF CYLINDER
	0

; DRIVE OFFSET REGISTER

OFSSTS:	STS 2000,HDR COMPARE INH
	STS 4000,ECC INHIBIT
	STS 10000,PDP-11 FORMAT
	0
];RH


;;; T-300 version of GSTS

T300,[ ;Print status of T300 (error from last command.)

T300ST:	MOVEI P,PDL
	PUSH P,[DDT]
T3STS:	PUSHER P,[A,B,C,D,I,K] 
	TYPE T,"~&T-300 and 2561 status: "
	SKIPN D,DSCFLT
	 JRST T3STS2
	TRNN D,%DFRST+%DFCQE+%DFNXM+%DFPAR
	 JRST T3STS1
	MOVEI C,[	STS %DFRST,CONTROLLER POWER-CYCLED AND RESET
			STS %DFCQE,COMMAND-QUEUE ERROR
			STS %DFNXM,RQB NXM
			STS %DFPAR,RQB PARITY ERROR
			0 ]
	MOVSS D			;TYPSTS WANTS BITS IN LEFT HALF
	CALL TYPSTS
	LDB A,[000200,,DSCFLT]
	LSH A,16.
	IOR A,DSCSTS
	TYPE T,", PDP-11 error address= ~O",[A]
T3STS9:	CRR
	JRST GSTS3

;;; Fault code

T3STS1:	CAILE D,17
	 JRST [	TYPE T,"~&Illegal fault code=~O",[D]
		JRST T3STS9 ]
	MOVE B,(D)[	[ASCIZ/FAULT CODE 0?/]
			[ASCIZ/DRIVE NOT READY/]
			[ASCIZ/ILLEGAL HEAD OR SECTOR/]
			[ASCIZ/SEEK TIMEOUT/]
			[ASCIZ/DISK STATUS BAD AFTER ON-CYLINDER (FAULT CODE 4)/]
			[ASCIZ/TIME OUT WRITING SECTOR ID (FAULT CODE 5)/]
			[ASCIZ/FIFO ERROR IN FORMAT WRITE (FAULT CODE 6)/]
			[ASCIZ/WRITE TIMEOUT (FAULT CODE 7)/]
			[ASCIZ/SEEK TIMEOUT (FAULT CODE 10)/]
			[ASCIZ/HEADS NOT LOADED/]
			[ASCIZ/READ TIMEOUT (FAULT CODE 12)/]
			[ASCIZ/INDEX TIMEOUT (FAULT CODE 13)/]
			[ASCIZ/SECTOR TIMEOUT (FAULT CODE 14)/]
			[ASCIZ/FAULT CODE 15?/]
			[ASCIZ/DMA TIMEOUT (FAULT CODE 16)/]
			[ASCIZ/DMA TIMEOUT IN ECC (FAULT CODE 17)/] ]
	HRLI B,440700
	TYPE T,"~A~%",[B]
;;; Command OK, check ordinary error status
T3STS2:	MOVE D,DSCSTS
	MOVEI C,[	STS %DSRTR,COMMAND WAS RETRIED
			STS %DSECH,UNCORRECTABLE DATA ERROR
			STS %DSECC,CORRECTED DATA ERROR
			STS %DSIDE,ID ERROR
			STS %DSHCE,HEADER COMPARE ERROR
			STS %DSPRT,WRITE-PROTECTED SECTOR
			STS %DSALT,ALTERNATE-SECTOR FLAG
			STS %DSOVR,OVERRUN
			STS %DSSKE,SEEK ERROR
			STS %DSOFL,DRIVE OFF-LINE OR FAULT
			STS %DSFLT,DRIVE FAULT
			STS %DSNXM,PDP11 MEMORY NXM
			STS %DSPAR,PDP11 MEMORY PARITY ERROR
			STS %DSSFL,SYSTEM FAULT
			STS %DSWLK,DRIVE WRITE-LOCKED
			0 ]
	MOVSS D			;TYPSTS WANTS D IN LEFT HALF
	CALL TYPSTS
	TYPE T,"~&Disk command: ~O ",[DSCCMD]
	MOVEI B,[ASCIZ/(UNKNOWN?)/]
	CAIN A,%DMSNS
	 MOVEI B,[ASCIZ/(SENSE)/]
	CAIN A,%DMTST
	 MOVEI B,[ASCIZ/(DIAGNOSTICS)/]
	CAIN A,%DMREC
	 MOVEI B,[ASCIZ/(RECALIBRATE)/]
	CAIN A,%DMSEK
	 MOVEI B,[ASCIZ/(SEEK)/]
	CAIN A,%DMWRT
	 MOVEI B,[ASCIZ/(WRITE)/]
	TRNE A,%DMRED
	 JRST [ CAIG A,%DMRED+10
		 MOVE B,(A)[	[ASCIZ/(READ)/]
				[ASCIZ/(READ EARLY-DATA-STROBE)/]
				[ASCIZ/(READ LATE-DATA-STROBE)/]
				[ASCIZ/(READ POSITIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ NEGATIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ EARLY-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ EARLY-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ LATE-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ LATE-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
			    ]-%DMRED
		JRST .+1 ]
	HRLI B,440700
	TYPE T,"~A, Drive=~O, Cyl=~O, Head=~O, Sec=~O",[B,DSCDRV,DSCHED,DSCSEC]
	JRST T3STS9
];T300P
];NTS


SUBTTL	Print UNIBUS status

KS,[
;;; UBSTS - Print Unibus status register and memory map.
;;; A/ UNIBUS adaptor number

TS,UBSTS: NOP

UBSTS:	PUSHER P,[A,B,C,D]
	HRLZ A,A		;UNIBUS adaptor we're interested in.
	HRRI A,UBASTA		;Status register for this UBA.
	IORD D,A		;Read it.
	TYPE T,"~&UBA Status register contents: ~12<~;0~D~>",[D]
	HLRZ D,D		;Get bits in D.
	MOVEI C,UBSTST		;Names for status reg bits.
	CALL TYPSTS		;Print them out.
	HRRI A,UBAPAG		;1st UBA PAGING RAM register there.
UBSTS1:	TYPE T,"~&UBA Paging RAM:"
	MOVEI C,UBPGST		;Names for bits.
	MOVEI B,UBALEN		;Gonna check each paging register.
UBSTS2:	IORD D,A		;Read the register.
	TYPE T,"~&~7<~;0~O~>  ~12<~;0~O~>~40T",[A,D]
	HLRZ D,D		;Get bits in D.
	CALL TYPSTS		;Print them.
	AOS A			;Do next paging register.
	SOJGE B,UBSTS2		;Do entire PAGING RAM.
	POPPER P,[D,C,B,A]
	RET

;;; Names of bits in the UBA Paging RAM.

UBPGST:	STS 100000,RAM-PARITY
	STS  40000,FRC-RD-PAUSE-WR
	STS   4000,DISABLE-UPPER-2
	STS   2000,FAST-MODE-ENABLE
	STS   1000,VALID
	STS    400,PAG-RAM-PAR-VALID
	0

;;; Names of bits in the UBA Status Register.

UBSTST:	STS 400000,UNIBUS-ARBITRATOR-TIMEOUT
	STS 200000,BAD-MEM-DATA-OR-NPR-XFER
	STS 100000,KS10-BUS-PARITY-ERROR
	STS  40000,NX-DEVICE
	STS   4000,INT-RQ-BR6-BR7
	STS   2000,INT-RQ-BR5-BR4
	STS   1000,POWER-LOW
	STS    200,DISABLE-XFER-OR-UNCORRECTABLE-DATA
	0
];KS




SUBTTL	RESET a disk drive

;;; RESET and recalibrate the disk drive in I.

NTS,[
PH,[
RESET:	MOVE T,QTRAN(I)		;Get physical drive number.
T300,[	CAIL I,T300P		;Is this is a T-300
	 JRST T3RST ]		; use the T300 rtns of course.
	SKIPL DRIVE(T)		;Drive thought to be offline?
	 JRST [	SETZM QACT(I)	; Yes, mark it as down.
		RET ]
	PUSHER P,[A,B]
	CALL RHQCLR
	RHQCMD	%HMRDP		;Readin Preset. 
	 JRST RESETL
	RHQSET %HROFS,[0]	;No offset, 18 bits, ECC on, HCI off.
	 JRST RESETL
	RHQSET %HRWC,[0]	;Reset Word Count register.
	 JRST RESETL
	RHQGET %HRTYP		;Get drive type
	 JRST RESETL
	TRZ A,4000		; Ignore DRQ bit
IFN RP06P, CAIE A,20022
IFN RP07P, CAIE A,20042
IFN RM80P, CAIE A,20026
IFN RM03P,[
	.ERR Determine drive type for RM02
	; and change CAI below to be CAIN
	CAIE A,20024		; RM03
	 CAI A,20023		; RM02 also acceptable
	  CAIA
] ; RM03P
	 JRST [	TYPE T,"~&Unit ~O has unexpected type: ~O",[I,A]
		JRST RESETL ]
	RHQCMD %HMACK		;Acknowledge pack.
	 JRST RESETL
	RHQGET %HRSTS		;Get drive status register.
	 JRST RESETL
	TRNN A,%HSMOL		;Medium online?
	 JRST [	SETZM QACT(I)
		ERR
		TYPE T,"~&Drive ~O offline",[I]
		JRST RESETL ]
	RHQCMD %HMREC		;Recalibrate drive.
	 JRST RESETL
	MOVEI B,80000.		;A little over 1/2 sec.
RESET1:	RHQGET %HRSTS		;Check drive status.
	 JRST RESETL		; Drive vanished?
	TRNE A,%HSERR		;Got error recalibrating?
	 JRST RESETL
	TRC A,%HSVV+%HSMOL+%HXRDY	;Valid, Online, and Ready?
	TRCE A,%HSVV+%HSMOL+%HXRDY	;Now is the time for all good bits...
	 SOJG B,RESET1		;Wait for a little more.
	JUMPG B,RESET5		;Winning.
RESETL:	SETZM QACT(I)		;Here when drive is losing.
	SKIPE GOGOX		;If in automatic mode
	 JRST RESET9		; GOGO mode will check for right packs mounted.
	HRRZ A,QTRAN(I)
	TYPE T,"~2&Disk ~O (unit ~O) is losing.",[I,A]
	RHQGET %HRCS2
	 JRST RESETL
	TRNE A,%HYNED
	 TYPE T,"~&Non-existant drive."
	RHQGET %HRCS1
	 JRST RESETL
	TRNE A,%HXMCP
	 TYPE T,"~&Register Access Error"
	CALL GSTS
	JRST RESET9

RESET5:	SKIPE NOISE
	 TYPE T,"~&RESET: Disk ~O online and recalibrated.",[I]
SH,[
RESET6:	SKIPE MARKF		;Pack online.
	 JRST RESET9		; But not formatted, so punt.
;;; A formatted disk pack is online.
;;; Read pack number from Sector Header
;;; (This really only has to read two words, but CStacy thought he was
;;; reading in the TUT when he wrote it...)
	MOVE A,[2,,CYLPAG]	;Two pages starting in CYLBUF.
	CALL QUBMAP		;Map it.
	RHQSET %HRBA,[0]	;Reset UNIBUS address.
	 JRST RESETL
	RHQSET %HRCYL,[TUTCYL]	;We desire the TUT cylinder.
	 JRST RESETL
	RHQSET %HRADR,[0]	;We desired track 0.
	 JRST RESETL
	RHQSET %HRWC,[-4000]	;One ITS block.
	 JRST RESETL
	RHQCMD %HMRHD		;Read headers and data.
	 JRST RESETL		; Lossage.
	CALL QWAIT		;Wait for completion.
	 JRST RESETL
	HRRZ A,CYLBUF+1		;ITS pack number from sector header.
	HLRZ B,CYLBUF+1		;Get drive serial # formatted on.
	MOVEM A,PKNUM(I)	;Remember it.
	SKIPE NOISE
	 TYPE T,"~&Pack ~D. is online. (Formatted by drive ~D.)",[A,B]
];SH
RESET9:	POPPER P,[B,A]
	RET


];PH
];NTS


NTS,[
DC,[
RECAL:	CONO DC0,DCCSET+DCDENB
	MOVE T,QTRAN(I)
	SKIPL DRIVE(T)		;SKIP IF DRIVE NOT KNOWN TO BE DEAD ALREADY
	 JRST [	SETZM QACT(I)
		RET]
	DPB T,[DUNFLD DRST]
	DPB T,[DUNFLD STOSTS]
	DATAO DC0,[DJMP STOSTS]
	CONSZ DC0,DSSACT
	 JRST .-1
	MOVE T,STATUS
	TDNN T,[DDSONL]		;ON LINE
	 JRST OFFL1
	DATAO DC0,DRST
	CONSO DC0,DSSATT
	 JRST .-1
	CONSO DC1,20		;OFF LINE OR MULTIPLE SELECT
	 RET
OFFL1:	SETZM QACT(I)
	SKIPE GOGOX
	 RET		;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	PUSH P,A
	HRRZ A,QTRAN(I)
	SETZM DRIVE(A)
	TYPE T,"~&Drive off line #~D.",[A]
	POP P,A
	RET
];DC


RP,[
RESET:	PUSH P,A
	CONSZ	DPC,BUSY
	 JRST	.-1
	DATAO	DPC,[DEASEC 776]
	DPB	I,[DUNFLD DRST]
	DATAO	DPC,DRST
RESET0:	DATAI	DPC,T
	TLNE T,20
	 JRST RESET1
	SKIPE GOGOX
	 JRST RESET9	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE T,"~&OFF LINE #~D.",[I]
	JRST RESET9

RESET1:	TLNN T,4
	 JRST RESET2
	SKIPE GOGOX
	 JRST RESET9	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE T,"~&NO SUCH DRIVE #~D.",[I]
	JRST RESET9

RESET2:	TRNN	T,776
	 JRST RESET0
	DATAO	DPC,[DEASEC 776]
	JRST POPAJ

RESET9:	SETZM QACT(I)		;THIS DRIVE LOST
	JRST POPAJ

DRST:	DRCALC
];RP

DC,[
RESET:	CALL RECAL
	MOVE T,QTRAN(I)		;GET PACK ID FROM HARDWARE
	DPB T,[DUNFLD GPKID]
	MOVEI T,TUTCYL
	SKIPGE QTRAN(I)
	 ADDI T,NCYLS+XCYLS
	DPB T,[DCYL GPKID]
	CONO DC0,DCCSET+DCDENB
	DATAO DC0,[DJMP GPKID]
	CONSZ DC0,DSSACT
	 JRST .-1
	LDB T,[DPKID RPKID]
	MOVEM T,PKNUM(I)
	RET

DRST:	DSPC+DSRCAL+DSWINF+DUNENB
GPKID:	DSPC+DSCRHD+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
	DCOPY RPKID(37774)
	DHLT
];DC

RH,[
RESET:	MOVE T,QTRAN(I)			;GET PHYS DRIVE
T300,[
	CAIL I,T300P
	 JRST T3RST
];T300P
	SKIPL DRIVE(T)
	 JRST [	SETZM QACT(I)		;DRIVE ALREADY KNOWN TO BE DOWN
		RET ]
	PUSH P,A
	MOVE A,[%HRDCL,,%HMCLR]		;CLEAR THE DRIVE
	CALL RHSET
	 JRST RESETL			;HMM, NO DRIVE
	MOVE A,[%HRDCL,,%HMRDP]		;I SAID, "CLEAR THE DRIVE"!
	CALL RHSET
	 JRST RESETL
	MOVE A,[%HROFS,,0]		;CLEAR THE FRIGGING DRIVE!!!
	CALL RHSET
	 JRST RESETL
	MOVSI A,%HRTYP			;GET DRIVE TYPE
	CALL RHGET
	 JRST RESETL			;??
	TRNE A,140000
	 JRST RESETL			;TAPE?
	TRNN A,020000
	 JRST RESETL			;FIXED HEADS?
	MOVE A,[%HRDCL,,%HMACK]		;PACK ACKNOWLEDGE
	CALL RHSET
	 JRST RESETL
	MOVSI A,%HRSTS
	CALL RHGET
	 JRST RESETL
	TRNN A,%HSMOL
	 JRST RESET4			;PACK NOT MOUNTED
	MOVE A,[%HRDCL,,%HMREC]		;RECALIBRATE
	CALL RHSET
	 JRST RESETL
	MOVEI B,80000.			;A LITTLE OVER 1/2 SEC
RESET0:	MOVSI A,%HRSTS			;GET STATUS
	CALL RHGET
	 JRST RESETL			;DRIVE VANISHED?
	TRNE A,%HSERR
	 JRST RESETL			;GOT ERROR RECALIBRATING?
	TRC A,%HSVV+%HSMOL+%HSRDY	;CHECK FOR GOOD BITS
	TRCE A,%HSVV+%HSMOL+%HSRDY
	 SOJG B,RESET0			;BITS NOT ALL ON, WAIT MORE
	JUMPG B,RESET5			;WON.
					;TIMED OUT, FALL INTO RESETL

RESETL:	SETZM QACT(I)			;LOST
	SKIPE GOGOX
	 JRST POPAJ	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	CONSZ DSK,%HIDRE
	 JRST RESET1
	CONSZ DSK,%HIILC
	 JRST RESET2
	TYPE T,"~&MISC ERROR DRIVE #"
	MOVEI A,GSTS			;CALL GSTS BEFORE RETURNING
	EXCH A,(P)
	PUSH P,A
	JRST RESET3

RESET2:	TYPE T,"~&ILC OR RAE DRIVE #"
	JRST RESET3

RESET1:	TYPE T,"~&DRIVE NOT PRESENT #"
RESET3:	HRRZ A,QTRAN(I)
	TYPE T,"~D.",[A]
	JRST POPAJ

RESET4:	SETZM QACT(I)
	SKIPE GOGOX
	 JRST POPAJ	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE T,"~&DRIVE OFF LINE #"
	JRST RESET3

RESET5:	SKIPE MARKF
	 JRST POPAJ			;PACK NOT FORMATTED YET
	MOVSI A,%HRCYL
	HRRI A,TUTCYL
	CALL RHSET
	 JRST RESETL
	MOVSI A,%HRADR
	CALL RHSET
	 JRST RESETL
	MOVE A,[-2_4,,SLVIOWD-1]
	MOVEM A,SLVICWA
	SETZM SLVICWA+1
KL,[	SWPUO 0
	CONSZ 200000
	 JRST .-1
]
	MOVE A,[%HRCTL,,SLVICWA_6+%HMRHD]
	CALL RHSET
	 JRST RESETL
	CONSO DSK,%HIDONE
	 JRST .-1
	CONSZ DSK,%HIERR
	 JRST RESETL
	HRRZ A,SLVIOWD+1		;GET I.T.S. PACK NUMBER
	MOVEM A,PKNUM(I)
	JRST POPAJ
];RH

T300,[
T3RST:	PUSH P,D
	MOVEI D,%DMSNS		;FIRST, SENSE STATUS (RECALIBRATE HANGS IF
	CALL T3CMD		; DRIVE OFF LINE, AND TIMEOUT LEAVES 11 WEDGED)
	JUMPL T,T3RSTL		;TIMEOUT, 11 MUST BE DOWN
	TDNE T,[%DFRST,,%DSOFL+%DSSFL]
	 JRST T3RSTL		;DRIVE OFF-LINE, LEAVE IT ALONE
	MOVEI D,%DMREC		;SEND A RECALIBRATE
	CALL T3CMD
	JUMPN T,T3RSTL		;JUMP IF ERROR
	SETOM PKNUM(I)		;PACK NUMBER NOT GOTTEN FROM HARDWARE!
	POP P,D
	RET

T3RSTL:	SETZM QACT(I)		;OFF LINE
	POP P,D
	SKIPN GOGOX
	 JRST T3STS
	RET
];T300
];NTS


TS,[
RESET:	PUSH P,A
	HRRZ A,QTRAN(I)
	SKIPL DRIVE(A)
	 JRST OFFL2
	CAML I,NQS
	 JRST OFFL2
	HRRZ A,SQACT		;SYSTEM QACT TABLE
	ADD A,I
	MOVSS A
	HRRI A,A
	.GETLOC A,		;COPY SYSTEMS QACT
	SKIPE A			;0 MEANS ON-LINE TO ITS
	 JRST OFFLIN
	POP P,A
	RET
OFFLIN:	TYPE T,"~&Drive off line #"
	HRRZ A,QTRAN(I)
	SETZM DRIVE(A)
	TYPE T,"~D.",[A]
OFFL2:	SETZM QACT(I)
	POP P,A
	RET
	JRST POPAJ
];TS




SUBTTL	RH-11 and RH-10  Pack Formatting

NTS,[
RHPH,[
MARK:	JSR INIT		;Reset the world.
	SETZM CERRS
KL,[	SWPUA			;Turn the cache off.
	CONSZ 200000
	 JRST .-1
	CONI PAG,A
	TRZ A,600000
	CONO PAG,(A) ];KL
MARK1:	TYPE T,"~&Format pack on unit #"
	CALL NTYI		;Read unit number.
	 JRST MARK1
	CAIL A,NUNITS		;Does unit possibly exist?
	 JRST [	TYPE T,"There aren't that many disk units here"
		JRST MARK1 ]
	MOVE I,A		;Unit in I.
	MOVEM I,TOU		;Remember, it's the disk to hack.
	SETOM MARKF		;Say pack not formatted yet.
	CALL RESET		;Recalibrate drive.
PH,	CALL RHQCLR		;Clear ctrlr errors.
	SETZM MARKF
	ASKYN "~&Are you sure you want to format pack on drive # ~O",[I]
	 PUNT		; Allow user to abort.
	TYPE T,"~&Pack no ?"
	CALL DTYI		;Read desired pack number.
	MOVEM A,PKNUM(I)	;Remember it.
	MOVE B,A
RH,	RHQGET %HRSER
PH,	RHQGET %HRSER		;Read drive serial number.
	 JRST RHMKER		; Eh? 
	TYPE T,"~&Pack ~D., Drive #~O is serial #~D.",[B,I,A]
SH,[
	HRLZ D,A		;Keyword has (3.1-4.7) the serial
	TLZ D,600000		;number of drive we formatted on,
	HRR D,PKNUM(I)		;second key is ITS pack number.
];SH
	SETZB A,B		;A is offset, B is disk addr.
RHFMP1:	MOVEM B,CYLBUF(A)	;Write Disk Address into each sector.
IFN RM80P,[
	MOVSI C,140000		; Say that the sector is OK.
	HLLM C,CYLBUF(A)	; (The documentation is not clear...)
] ;RM80P
SH,	MOVEM D,CYLBUF+1(A)	;Write key into each sector.
	ADDI A,HSECTOR-SECTOR	;Advance to first data word.
	SETZB C,E		;Fill sector with worst case pattern.
RHFMP2:	MOVE T,RHWC(E)		;Get pattern.
	MOVEM T,CYLBUF(A)	;Stuff into buffer.
	AOS E			;Count pattern words stuffed.
	CAIL E,RHWCL		;Got them all?
	 MOVEI E,0		; Yes, start pattern over.
	AOS A			;Next word.
	CAIGE C,SECTOR-1	;128 words (1 sector) filled?
	 AOJA C,RHFMP2		; No, keep filling.
	CAIE B,NSECS-1		;All sectors in track filled?
	 AOJA B,RHFMP1		; No, do next sector.
	CAIE A,HSECTOR*NSECS	;Ensure right amount of cruft here.
	 LOSE "~&Filled ~D. words for track formatting pattern.",[A]
RHFM10:
PH,[	HRLZI A,1+<HSECTOR*NSECS>/PG$SIZ	;# PDP10 pages.
	HRRI A,CYLPAG		;Use CYLBUF.
	CALL QUBMAP		;Map it in.
];PH

	;; Now copy the pattern into each track on the disk.
	MOVEI J,NCYLS+XCYLS	;Format sectors in ALL cylinders.
	TYPE T,"~&Begin formatting ~D. cylinders....",[J]
RHFM20:	SOJL J,RHFM50
	MOVEI K,NHEDS		;K counts tracks.
RHFM30:	SOJL K,RHFM20		;On end-of-cyl, do next cyl.
PH,[	RHQSET %HRBA,[0]	;Reset UNIBUS address.
	 JRST RHMKER		; Eh?
];PH
	MOVEI B,NSECS		;Adjust the header disk addresses.
	MOVEI C,0		;Sector counts already in format.
RHFM40:	DPB J,[221200,,CYLBUF(C)] ;Say which cylinder this is.
	DPB K,[100500,,CYLBUF(C)] ;Say which track this is.
	ADDI C,HSECTOR		;Find beginning of next sector header.
	SOJG B,RHFM40		;Update all the headers.

RH,[	MOVSI A,%HRADR		;Set up address in drive.
	DPB K,[$HATRK A]	;Track from K.
	CALL RHSET		;Set it.
	 JRST RHMKER		; Eh?
	MOVSI A,%HRCYL		;Leave cylinder number in RH10 "DIB" lights.
	HRR A,J			;Cylinder from J.
	CALL RHSET		;Set it.
	 JRST RHMKER		; Eh?
	SETZM SLVICWA+1
	MOVSI A,%HRCTL		;Set up program.
RHFMT:	HRRI A,%HMWHD		;Command is Write Headers And Data.
	MOVEI B,SLVICWA		;Ptr to channel program
	DPB B,[$HCICWA A]	;with sizes and address.
	CALL RHSET		;Write a track.
	 JRST RHMKER
	CONSO DSK,%HIDONE	;Done yet?
	 JRST .-1		; Wait for completion.
	CONSZ DSK,%HIERR	;Anything go wrong?
	 JRST RHMKER		; Foo!
	JRST RHFM30		;OK, do next track.
];RH
PH,[	MOVSI A,%HRADR		;Move to desired track.
	DPB K,[$HATRK A]	;Whole track (from its 0 sector) each xfer.
	CALL RHSET
	 JRST RHMKER
	MOVSI A,%HRWC		;Gonna do entire track, plus header words.
	HRR A,[-2*<HSECTOR*NSECS>]
	MOVEM A,RHIOWC		;-# UNIBUS wds to xfer (in each track).
	CALL RHSET
	 JRST RHMKER
	MOVSI A,%HRCYL		;Move to desired cylinder.
	HRR A,J
	CALL RHSET
	 JRST RHMKER
RHFMT:
IFN RP07P,[
	MOVE A,[%HROFS,,100000]	; Must ask permission of RP07...
	CALL RHSET
	 JRST RHMKER
]
	RHQCMD %HMWHD		;Write Headers and Data.
	 JRST RHMKER
	CALL QWAIT		;Wait for completion.
	 JRST RHMKER
	JRST RHFM30
];PH
RHFM50:	TYPE T,"Hardware formatting complete."
	ASKYN "~&Verify pack?"
	 JRST RHFMTX
RHFVFY:	TYPE T,"~&Verification begins."
	MOVEI J,NCYLS+XCYLS-1
RHFM51:	MOVEI A,CYLBUF
	SKIPE NOISE
	 TYPE T,"~&Verifying cylinder ~D.",[J]
	CALL READCY
	JUMPG T,RHFM60
	TYPE T,"~2&Cylinder ~O in error.",[J] 
	SKIPE NOISE
	 CALL GSTS
	ASKYN "~&Verify this cylinder?"
	 JRST RHFM70
;;; Verify data.  Relies on sector size being a multiple of RHWCL.
RHFM60:	SETZB A,E
RHFM65:	MOVE B,CYLBUF(A)
	CAME B,RHWC(E)
	 CALL [	PUSHER P,[A,B,C]
		MOVE C,RHWC(E)
		TYPE T,"~&Word ~O Cyl ~O  Correct= ~O (~S), Actual= ~O (~S)",[A,J,C,C,B,B]
		POPPER P,[C,B,A]
		RET ]
	ADDI E,1
	CAIL E,RHWCL
	 MOVEI E,0
	CAIGE A,SECTOR*NSECS
	 AOJA A,RHFM65
RHFM70:	SOJGE J,RHFM51
	SKIPN A,CERRS		;Any corrected errors?
	 JRST RHFMTX		; If so, report them.
	TYPE T,"~&~D ECC-corrected errors during verification.",[CERRS]
RHFMTX:	CRR
	JRST MARK69		;Hardware formatted, do software part.

RHMKER:	TYPE T,"~&Disk Error!"
	CALL GSTS
	PUNT

IFN RP06P\RP07P,[
RHWC:	;; RP06 worst case pattern
	;; (Where did CStacy get this from?)
	;; Use this for RP07 too?  Who knows?  What the heck!
	555555555753
	666666765555
	333372666666
	573333333333
	555555555753
	666666765555
	333372666666
	573333333333
RHWCL==.-RHWC
] ;IFN RP06P\RP07P

IFN RM03P\RM80P,[
RHWC:	;; RM03 worst case pattern
	;; I got this from T20's FORMAT.MAC which also uses this pattern
	;; for RP04/5/6's.  Probably they didn't know if this was a good
	;; test of an RM03 (or RM80) either.  What the heck.
	726666,,666676
	555555,,555753
	333333,,337266
	666666,,765555
	555557,,533333
	333372,,666666
	667655,,555555
	573333,,333333
RHWCL==.-RHWC
] ;IFN RM03P\RM80P

RH,[
RHWC:	;; RP04 10-mode worst case pattern
	726666666676
	555555555753
	333333337266
	666666765555
	555557533333
	333372666666
	667655555555
	573333333333
RHWCL==.-RHWC
];RH

];RHPH
];NTS

SUBTTL	DC-10 Pack Formatting

NTS,[
DC,[
MARK:	JSR INIT
	TYPE T,"~&Format pack on unit #"
	CALL NTYI		;Read unit number.
	 JRST MARK1
	CAIL A,NUNITS		;Does unit possibly exist?
	 JRST [	TYPE T,"There aren't that many disk units here"
		JRST MARK1 ]
	HRRZ TT,QTRAN(A)
	CONO DC1,(TT)		;Setup drive # for latency timer.
	MOVEM A,TOU
	MOVE I,A
	CALL RECAL		;Recalibrate drive.
	CONSO DC1,DFUNSF\DOFFL
	 JRST MARK1
	ASKYN "~&Are you sure you want to format pack on drive # ~O?",[I]
	 PUNT		; Allow user to abort.

MARK1:	MOVE A,[DSPC+DSCWIM+DSWIDX+DSWNUL]
	MOVEM A,CYLBUF
	MOVEI D,CYLBUF+1
	CALL RDLAT		;Read latency timer.
	JUMPE A,.-1
MARK1A:	CONI DC1,A
	CONI DC1,C
	LDB A,[DSLAT A]
	LDB C,[DSLAT C]
	CAME A,C
	 JRST MARK1A
	JUMPN A,[MOVE B,A
		 JRST MARK1A]
IFN 0,[		;THIS HARDWARE HAS BEEN BROKEN FOR YEARS
	PUSH P,B
	MOVE A,B
	IDIVI A,10.		;NO. OF MILLISECONDS
	PUSH P,B
	CALL TDPT
	MOVEI A,".
	CALL TYO
	POP P,A
	ADDI A,"0
	CALL TYO
	TYPE  MILLISECONDS ROTATION TIME
	CRR
	POP P,B
	CAIGE B,254.		;LIKELY JUST NO INDEX ON THIS PACK
	 JRST MARK1B
	TYPE TOO DAMN LONG TO BE CREDIBLE, USING 24.5 MS.
	CRR
];IFN 0
	MOVEI B,245.
MARK1B:	IMULI B,PG$DEC		;Convert to number of bits/track.
	IDIVI B,36.		;# words per sector.
	AOJ B,
	MOVEM B,MAXT'
	SETZ A,
	CALL STOBLK		;Enough ones to wipe out this track.
	MOVE J,MAXT
	IDIVI J,NSECS
	CAIL K,NSECS/2
	 AOJ J,			;Inter-sector gap length.
	SUBI J,3+3+7+3011	;Header code+header data+"ones"+block+checksum.
	MOVEI Q,NSECS
MARK1C:	MOVEI B,(D)
	HRLI B,HBLK		;Setup COPYS for header preamble,data,postamble.
	ADDI D,3
	BLT B,-1(D)
	MOVNI B,-NSECS(Q)
	IMULI B,3
	ADDI B,DHEDR
	HRRM B,-2(D)		;Point copy to this sectors encoded data.
	MOVEI B,103.		;103 blocks of 10 zeros (encoded)
	MOVE A,[QCOPY EZERS,15.,]
	CALL STBLK
	SOJLE Q,MARK1D
	MOVE B,J		;Enough ones to fill out remaining part of sector.
	CALL STOBLK
	JRST MARK1C

;;; Setup stuff for possibly writing READIN block.

MARK1D:	MOVE A,[QCOPY EONES,3,]
	MOVEM A,(D)
	AOJ D,
	MOVSI A,(DOPR+DOHXFR)
	MOVEM A,(D)
	MOVEM D,RIWP'
	ADDI D,2
	MOVE B,J
	SUBI B,3+3+7+LRIBLK*3/2+3	;Header+LRIBLK+Checksum.
	LSH B,-1
	SUBI B,3*3
	CALL STOBLK
	MOVEI B,(D)
	HRLI B,WRTRI
	ADDI D,5
	BLT B,-1(D)
	MOVSI A,(DJMP)		;Patch JUMP around RIBLK code, will be clobbered for block 0 only.
	ADDI A,(D)
	MOVE B,RIWP
	MOVEM A,1(B)
	MOVEI B,(D)
	MOVEM B,ENDP'
	AOS ENDP
	HRLI B,RCBLK
	ADDI D,5
	BLT B,-1(D)
	MOVEI B,-3(D)		;Patch AOJN .-1 address.
	HRRM B,-2(D)
	TYPE T,"~&Pack no ?"
	CALL DTYI		;Read desired pack number.
	MOVE I,TOU
	MOVEM A,PKNUM(I)
	MOVE I,[440300,,RIHEDR]	;Encode READIN header.
	CALL ENCI
	MOVEI I,RIHED0
	CALL HCOMP
	MOVEI J,<NBLKS+XBLKS>/NSECS-1
	MOVEM J,TRKN'


;;; WRITE IMAGE COMMAND - (START AT SECTOR PULSE)
;;; COPY <ENCODED ONES>	;ENOUGH TO WIPE OUT FULL TRACK
;;; (THEN FOR EACH SECTOR):

;HEADER PREAMBLE
;	ONES FOLLWED BY SINGLE ZERO
;	8 BYTES OF 10101
;	TWO 28 BIT HEADER WORDS
;	A SERIES OF ONES FOLLWED BY 01
;ENCODED ZEROS FOR DATA BLOCK (2004) WORDS + 2 WORDS CHECKSUM
;ENOUGH ENCODED ONES TO FILL OUT REST OF SECTOR (EXCEPT ON LAST SECTOR)

;AFTER LAST SECTOR
;A FEW ONES
;	NORMALLY:			FOR BLOCK 0:
;RIWP:	HANG FOR END OF TRANSFER	WRITE ONES
;	JUMP AROUND WRITE READIN	WRITE ONES
;					READIN HEADER PREAMBLE
;					READIN HEADER
;					READIN HEADER POSTAMBLE
;					READIN BLOCK
;					ONES TO PAD OUT REST OF TRACK
;	DALU SETUP CONTROL COUNTER
;ENDP:	READ COMPARE COMMAND
;	COPY 4 WORDS ZEROS
;	AOJN CC,.-1
;	HALT .

MARK2:	MOVEI K,5
	MOVEM K,NTRYS'
	SETZM DHED0
	CAIL J,NBLKS/NSECS
	 JRST MARK2C
	MOVE I,TOU
	MOVE A,PKNUM(I)
	DPB A,[DPKID DHED0]	;PACK ID FOR HEADER
	DPB A,[DPKID @ENDP]	;PACK ID FOR READ-COMPARE COMMAND
	JUMPN J,MARK2C
	MOVE B,RIWP
	MOVE A,[QCOPY EONES,3,]
	MOVEM A,(B)
	MOVEM A,1(B)
MARK2C:	IDIVI J,NHEDS
	PUSH P,J
	MOVE W,TOU
	SKIPGE QTRAN(W)
	 ADDI J,NCYLS+XCYLS	;OFFSET IF DOUBLE SIZE PHYSICAL PACK
IRP A,,[CYLBUF,@ENDP,DHED0]	;SETUP INITIAL WRITE-IMAGE COMMAND
	DPB J,[DCYL A]		;  " READ-COMPARE COMMAND
	DPB K,[DSURF A]		;  " HEADER WORD
TERMIN
	POP P,J			;VIRTUAL CYLINDER #
	MOVEI W,0
	DPB W,[DHNXAD DHED1]
	MOVEI W,1		;END OF TRACK
	CAIN K,NHEDS-1
	 MOVEI W,2		;END OF CYLINDER
	CAIE J,NCYLS-1
	CAIN J,NCYLS+XCYLS-1
	 TRO W,1		;END OF DISK
	MOVE I,[440300,,DHEDR]
	CALL ENCI
	MOVEI I,DHED0
	MOVEI Q,NSECS
MARK2B:	CAIN Q,1		;PUT IN INCREMENT CODE
	 DPB W,[DHNXAD DHED1]
	CALL HCOMP		;ENCODE HEADERS
	AOS DHED0
	SOJG Q,MARK2B
MARK2A:	CONO DC0,DCCSET\DCDENB
	DATAO DC0,[DJMP CYLBUF]
	MOVE A,[DWLUP,,14]
	BLT A,16
	JRST 14		;WAIT IN AC'S FOR DISC, THEN FALL THRU
MARK2D:	CONSO DC0,DSSERR
	 JRST MARK4
	CONSZ DC1,DCPERR\DNXM\DDOBSY
	 JRST MARK3A
	CONSZ DC1,DPROT
	 JRST MARK3B
	CONSZ DC1,DOFFL\DFUNSF
	 JRST MARK3C
	CONSO DC1,DWTHER\DCKSER\DOVRRN\DRCER\DRLNER
	 JRST MARK3D
MTROV:	SOSLE NTRYS
	 JRST MARK2A
	CONSZ DC1,DOVRRN
	 JRST MARK3A
	LOSE "Disk Bad"

DWLUP:	CONSZ DC0,DSSACT
	 JRST 14
	JRST MARK2D

MARK3A:	LOSE "MACHINE LOSSAGE"
MARK3B:	LOSE "NOT WRT ENABLED"
MARK3C:	LOSE "DRIVE LOSSAGE"
MARK3D:	LOSE "CONTROLLER LOSSAGE"

MARK4:	SOSL J,TRKN
	 JRST MARK2

HCOMP:	SETOM HPAR'
	MOVEI J,(I)
	HRLI J,-2
HCOMP1:	MOVEI B,14.
	MOVE A,(J)
	XORM A,HPAR
	LSH A,-2
	SOJG B,.-2
	AOBJN J,HCOMP1

	MOVE B,(I)
	CALL ENCH
	MOVE B,HPAR
	ANDI B,3
	LSH B,20.
	XORB B,1(I)
	CALL ENCH
	MOVSI B,770000
HCOMP2:	TDNN B,DSKBP
	 RET
	CALL ENCDO
	JRST HCOMP2

ENCO:	SKIPA A,C1
ENCZ:	 MOVEI A,0
ENC:	ANDI A,1
	HRRZ T,ENCS'
	JRST @ENCT(T)

ENCT:	ENC1
	ENC2
	ENC1
	ENCZ2

ENCDO:	SKIPA A,[3]
ENCDZ:	 MOVEI A,0
ENCD:	ANDI A,3
	HRRZ T,ENCS
	JRST @ENCDT(T)

ENCDT:	ENC2A
	[HALT .]
	ENCZ2A
	[HALT .]

ENC1:	HRLM A,ENCS
ENC1A:	AOS ENCS
	RET

ENC2:	ROT A,-1
	HLR A,ENCS
	ROT A,2
	JRST ENC2B
ENC2A:	LSH A,1
	AOS ENCS
ENC2B:	JUMPE A,ENC1A
C1:	TRO A,1
	IDPB A,DSKBP'
ENC3:	SETZM ENCS
	RET

ENCZ2:	ROT A,-1
	HLR A,ENCS
	JRST .+2
ENCZ2A:	 ROT A,-1
	ASH A,2
	TRO A,2
	IDPB A,DSKBP
	ROT A,2
	TRO A,5
	IDPB A,DSKBP
	JRST ENC3

ENCH:	LSH B,36.-28.
	SKIPA C,[14.]
ENCW:	 MOVEI C,18.
	LSHC A,2
	CALL ENCD
	SOJG C,.-2
	RET

ENCI:	MOVEM I,DSKBP
	SETZM ENCS
	RET

RDLAT:	CONI DC1,A		;READ LATENCY TIMER INTO A
	LDB A,[DSLAT A]
RDLAT2:	MOVEM A,T
	CONI DC1,A
	LDB A,[DSLAT A]
	CAME A,T
	 JRST RDLAT2
	RET

STBLK:	MOVEM A,(D)		;STORE C(A) IN B WORDS AT D
	SOJLE B,[AOJA D,CPOPJ]
	HRLI D,1(D)
	ADDI B,1(D)
	MOVS D,D
	EXCH B,D
	BLT B,-1(D)
	RET

STOBLK:	MOVE A,[QCOPY EONES,LOBLK,]
	IDIVI B,LOBLK
	JUMPE B,STOBL3		;LESS THAN ONE BLOCK NEEDED??
	JUMPE C,STOBL2
	CAIL C,3
	 JRST STOBL2
	SOJ B,
	ADDI C,LOBLK
STOBL2:	CALL STBLK
STOBL3:	CAIGE C,3
	 MOVEI C,3
	MOVNI C,(C)
	DPB C,[DCWC A]
	MOVEM A,(D)
	AOJA D,CPOPJ

HBLK:	QCOPY PREAMB,3,		;NORMAL HEADER
	QCOPY .,3,
	QCOPY POSTMB,7,

WRTRI:	QCOPY PREAMB,3,		;READIN HEADER, DATA BLOCK
	QCOPY RIHEDR,3,
	QCOPY POSTMB,7,
	QCOPY EZERS,<LRIBLK*3/2+3>,
	QCOPY EONES,3,

RCBLK:	DALU+DLCC+DLLB -401*NSECS(3)	;READ COMPARE "LOOP" FOR DATA WORDS
	DRCC
	QCOPY ZERS,4
	DJMP+DAOJNC .
	DHLT

LOBLK==60

DHED0:	0
DHED1:	-2004&37777
DHEDR:	BLOCK 3*NSECS


RIHED0:	0
RIHED1:	-LRIBLK&37777
RIHEDR:	BLOCK 3

EZERS:	REPEAT LRIBLK*3/2+3,252525252525

EONES:	REPEAT LOBLK+3,-1

PREAMB:	-1			;ONES
	-26			;ONES...0.1010
	655326553265		;1.10101.10101.10101.10101.10101.10101.10101

POSTMB:	REPEAT 6,-1		;ONES...01
	-3

ZERS:	BLOCK 4
];DC
];NTS


SUBTTL	RP-10 Pack Formatting

NTS,[
RP,[

MARK:	JSR INIT
KL,[	SWPUA			;Turn the cache off.
	CONSZ 200000
	 JRST .-1
	CONI PAG,A
	TRZ A,600000
	CONO PAG,(A) ];KL
	TYPE T,"~&Format pack on unit #"
	CALL NTYI
	 JRST MARK
	CAIL A,NUNITS
	 JRST MARK
	MOVE I,A
	MOVEM I,TOU
	SETOM MARKF
	CALL RESET
	SETZM MARKF
	MOVSI A,(DNOOPC)	;Determine type of drive.
	DPB I,[DUNFLD A]
	DATAO DPC,A
	DATAI DPC,A
	MOVEI B,"2
	MOVEI C,NCYLS+XCYLS
	TRNN A,2000
	 JRST .+3
	  MOVEI B,"3
	  MOVEI C,MCYLS+XCYLS
	MOVEM C,LAST
	TLNE A,1
	 LOSE "~&Write Header Lockout switch is on"
	ASKYN "~&Are you sure you want to format pack on RP0~C#~O",[B,I]
	 PUNT
	TYPE T,"~&Pack No ="
	CALL DTYI
	MOVEM A,PKNUM(I)
	SETZB A,B		;Generate template track.
RPFMP1:	MOVEI T,31.		;Sync zone of 30 zero words.
	SETZM CYLBUF(A)
	AOS A
	SOJG T,.-2
	AOS CYLBUF-1(A)		;And one word containing 1 in bit 35.
	MOVEM B,CYLBUF(A)	;Then address word.
REPEAT 4,SETZM CYLBUF+1+.RPCNT(A) ;Then addr parity word and 3 zero words sync.
	ADDI A,5
	MOVE T,RPWC		;Then 128 data words of worst case pattern.
	MOVEM T,CYLBUF(A)
	MOVSI T,CYLBUF(A)
	HRRI T,CYLBUF+1(A)
	BLT T,CYLBUF+177(A)
	ADDI A,200
	CAIGE B,NSECS-1		;Do next sector.
	 AOJA B,RPFMP1
	CAIE A,244*NSECS
	 HALT .			;Wrong amount of cruft generated?
	MOVE A,[-244*NSECS,,CYLBUF-1]	;Set up IOWD.
	MOVEM A,SLVIOWD
	SETZM SLVIOWD+1
	MOVEI A,SLVIOWD
	MOVEM A,SLVICWA
	JRST RPFMT0		;GO FORMAT

RPMKER:	TYPE DISK ERROR
	X CRR
	CALL GSTS
	JRST DDT

RPFMT0:	MOVE J,LAST		;HIGHEST CYLINDER # + 1
RPFMT1:	SOJL J,RPFMT4		;LOOP ON CYLINDERS
	MOVEI K,NHEDS
RPFMT2:	SOJL K,RPFMT1		;LOOP ON SURFACES
	MOVEI B,NSECS		;ADJUST THE HEADER WORDS
	MOVEI C,0
RPFMT3:	DPB J,[121100,,CYLBUF+37(C)]
	DPB K,[050500,,CYLBUF+37(C)]
	MOVE D,CYLBUF+37(C)	;COMPUTE HEADER PARITY WORD
	MOVEI T,36.
	MOVSI TT,(SETZ)		;ODD PARITY
RPFMTP:	TRNE D,1
	 TLC TT,(SETZ)
	ROT D,1
	SOJG T,RPFMTP
	MOVEM TT,CYLBUF+40(C)
	ADDI C,244
	SOJG B,RPFMT3
	MOVSI A,300000		;WRITE FORMAT
	ADDI A,SLVICWA
	DPB J,[DCYL A]
	ROT J,-8		;EXTRA BIT FOR RP03
	DPB J,[DCYLXB A]
	ROT J,8
	DPB K,[DSURF A]
	DPB I,[DUNFLD A]
	MOVEM J,RPIOCY
	CALL SEEK
	 JRST RPMKER
	DATAO DPC,A
	CONSO DPC,DONE
	 JRST .-1
	CONSZ DPC,ALLER
	 JRST RPMKER
	JRST RPFMT2

RPFMT4:	TYPE T,"~&Formatting complete, verification begins."
	SOS J,LAST
RPFMT5:	MOVEI A,CYLBUF
	CALL READCY
	JUMPGE T,RPFMT6
	TYPE T,"~&Cylinder ~O doesn't read -- giving up on it.",[J]
	CALL GSTS
	CRR
	JRST RPFMT9

RPFMT6:	SETZB A,E		;VERIFY DATA.
	MOVE D,RPWC
	LSH D,1			;CONTROL DROPS ONE BIT DURING WRITE FORMAT
RPFMT7:	MOVE B,CYLBUF(A)
	CAME B,D
	 CALL RPFMT8
	CAIGE A,200*NSECS
	 AOJA A,RPFMT7
RPFMT9:	SOJGE J,RPFMT5
	CRR
	JRST MARK69		;Hardware formatted, do software

RPFMT8:	PUSH P,A
	TYPE T,"~&Word ~O of Cylinder ~O  Correct ~O Actual ~O",[A,J,RPWC,B]
	JRST POPAJ

RPWC:	714533,,462556		;Worst case pattern.
];RP
];NTS


SUBTTL	Pack Formatting Part 2 - Initialize MFD and TUT
;;; Args: TOU and PKNUM+n

NTS,[
MARK69:	MOVE I,TOU		;Set disk unit.
	CALL MFDINN		;Init the MFD. 
	TYPE T,"~&Swapping Alloc? "
	CALL OTYI
	CALL TUTINI		;Init TUT.
	MOVE A,PKNUM(I)		;Get pack number.
	MOVEM A,TUT+QPKNUM
	TYPE T,"~&Pack #~D.  ID?",[A]
	CALL 6TYI
	MOVEM B,TUT+QPAKID
	MOVEI A,MFD		;MFD in buffer.
	MOVE J,MFDBK		;Going to disk.
	CALL WRITT		;Write it.
	JUMPL T,WRERR
	MOVE A,TUT+QSWAPA	;Finish setting up TUT.
	CAMGE A,NUDS		;Set free space pointer.
	 MOVE A,NUDS
	ADDI A,NBLKSC-1		;In case QSWAPA not on cylinder boundary.
	IDIVI A,NBLKSC
	IMULI A,NBLKSC
	MOVEM A,TUT+QTUTP
	MOVEI A,TUT
	CALL WRTUT		;Write the TUT out.
	JUMPL T,WRERR
	PUNT

];NTS

SUBTTL	Initialize Master File Directory (MFD)

MFDINN:	SETZM MFD
	MOVE A,[MFD,,MFD+1]
	BLT A,MFD+1777
	MOVE A,MFDCHK
	MOVEM A,MFD+MDCHK
	MOVE A,NUDS
	MOVEM A,MFD+MDNUDS
	MOVEI A,PG$SIZ
	MOVEM A,MFD+MDNAMP
	RET



SUBTTL	Initialize Track Usage Table (TUT)

;;; TUTINI - Initialize the TUT
;;; I/ unit number
;;; A/ swapping alloc

TUTINI:	SETZM TUT
	MOVE B,[TUT,,TUT+1]
	BLT B,TUT+<2000*MXTUTB>-1
	MOVEM A,TUT+QSWAPA
	MOVE K,A
	CAMGE K,NUDS
	 MOVE K,NUDS		;K has base of file area.
	MOVEI J,NBLKS		;Determine how many blocks this drive.
RP,[	MOVSI A,(DNOOPC)
	DPB I,[DUNFLD A]	;Select drive.
	DATAO DPC,A	
	DATAI DPC,A
	TRNE A,2000
	 MOVEI J,MBLKS		;RP03 HAS MORE BLOCKS
];RP
T300,[
	CAIL I,T300P
	 MOVEI J,NBLKS1
];T300P
	MOVEM J,TUT+QLASTB	;LAST REGULAR BLOCK IS LAST TUT'ED
T300,[
	MOVEI A,<2000*NTUTBL-LTIBLK>*TUTEPW
	CAIL I,T300P
	 MOVEI A,<2000*NTUTB1-LTIBLK>*TUTEPW
	SUB J,A
];T300P
.ELSE	SUBI J,<2000*NTUTBL-LTIBLK>*TUTEPW	;Subtract max number of TUTable blocks.

	CAMLE J,K		;Make sure there is room for all of file area.
	 LOSE "~&SALV'TUTINI:Not enough room for file area."
	SKIPGE J
	 MOVEI J,0
	MOVEM J,TUT+QFRSTB
	MOVEI A,TUT
TUTFIL:	MOVEI K,TUTLK		;ENTER HERE FROM SALV1, A -> TUT
	MOVSI D,440000+TUTBYT_6
	ADDI D,LTIBLK(A)
	MOVE B,NUDS
	SUB B,QFRSTB(A)
	JUMPLE B,TUTI1A
TUTI1:	IDPB K,D		;Mark out user dir area.
	SOJG B,TUTI1

TUTI1A:	MOVEI B,(A)
	MOVSI D,-LSBTAB
TUTI2:	SKIPGE J,SBTAB(D)
	 JRST TUTI3		;Not really there.
	CALL TUTPNT
	MOVEI K,TUTLK
	DPB K,J			;Mark out block.
TUTI3:	AOBJN D,TUTI2
	MOVE D,NTBL(I)		;Mark out TUT (size varies.)
TUTI4:	MOVE J,MFDBK
	SUB J,D
	CALL TUTPNT
	MOVEI K,TUTLK
	DPB K,J
	SOJG D,TUTI4
	RET



;;; SPKID - SET PACK ID IN TUT

SPKID:	JSR INIT
	CAIA
SPKID0:	CRR
	TYPE T,"~&Set pack id on unit #"
	CALL NTYI
	 JRST SPKID0
	CAIL A,NUNITS
	 JRST SPKID0
	CRR
	MOVE I,A
	CALL RESET
	MOVEI A,TUT
	CALL RDTUT
	JUMPL T,ZAPLUZ
	TYPE T,"Pack Number= ~D.",[TUT+QPKNUM]
	TYPE T,"~&Change id from ~S to? ",[TUT+QPAKID]
	CALL 6TYI
	JUMPE B,ZAPLUZ
	MOVEM B,TUT+QPAKID
	MOVEI A,TUT
	CALL WRTUT
	JUMPL T,ZAPLUZ
	PUNT


;;; SECOND - SET SECONDARY PACK NAME (KEPT IN TUT)

SECOND:	JSR INIT
	CAIA
SECND0:	CRR
	TYPE T,"~&Set secondary pack name of pack on unit #"
	CALL NTYI
	 JRST SECND0
	CAIL A,NUNITS
	 JRST SECND0
	CRR
	MOVE I,A
	CALL RESET
	MOVEI A,TUT
	CALL RDTUT
	JUMPL T,ZAPLUZ
	TYPE T,"Pack Number= ~D.  ID= ~S",[TUT+QPKNUM,TUT+QPAKID]
	SKIPN T,TUT+QTRSRV
	 JRST SECND1
	TYPE T,"~&Change secondary pack name from ~S: to? ",[TUT+QTRSRV]
	JRST SECND2

SECND1:	TYPE T,"~&Set secondary pack name to be? "
SECND2:	CALL 6TYI
	JUMPE B,ZAPLUZ
	MOVEM B,TUT+QTRSRV
	MOVEI A,TUT
	CALL WRTUT
	JUMPL T,ZAPLUZ
	PUNT


KS,[
;;; FESET - Set pointer to front end filesystem for KS10'S 8080 console
;;; For an explanation of the procedure for creating and installing a new
;;; FE filesystem, see the comments in the KSFEDR program.
FESET:	JSR INIT
FESET1:	TYPE T,"~&Set FE filesystem directory pointer on the pack on unit #"
	CALL NTYI
	 JRST FESET1
	MOVE I,A
	TYPE T,"~&Directory address: "
	CALL OTYI
	SETZM FDBUF
	MOVE TT,[FDBUF,,FDBUF+1]
	BLT TT,FDBUF+177
	MOVSI TT,(SIXBIT /HOM/)
	MOVEM TT,FDBUF+0
	MOVEM A,FDBUF+103
	MOVE TT,[FDBUF,,FDBUF+200]
	BLT TT,FDBUF+1777
	MOVEI J,0
	MOVEI A,FDBUF
	CALL WRITE
	SKIPGE T
	 TYPE T,"Error writing first 'HOM' block."
	MOVEI J,1
	MOVEI A,FDBUF
	CALL WRITE
	SKIPGE T
	 TYPE T,"Error writing second 'HOM' block."
	PUNT
];KS

;;; TUTPNT - Access the TUT
;;; J/ block number
;;; B/ ptr to TUT
;;; 
;;; Clobbers K.  Never skips. 
;;; Returns byte pointer in J (0 if block not TUT'ed)
;;;
;;; TUTPNN - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO NEW TUT ADDR
;;; TUTPNO - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO OLD TUT ADDR

TUTPNN:	SKIPA B,QNTUTO(I)
TUTPNO:	 MOVE B,QOTUTO(I)
TUTPNT:	CAMGE J,QLASTB(B)
	 CAMGE J,QFRSTB(B)
	  TDZA J,J
	   CAIA
	    RET			;Block not TUT'ed, return J=0.
	SKIPGE QPKNUM(B)
	 LOSE  "~&Old format TUT?"
	SUB J,QFRSTB(B)
	IDIVI J,TUTEPW
	HLL J,QTTBL(K)
	ADDI J,LTIBLK(B)
	RET



SUBTTL	Read & Write TUT

;;; WRTUT and RDTUT.
;;; I/ unit
;;; A/ core buffer
;;; Never skips; returns T negative if failure.

NTS,[
WRTUT:	MOVE J,MFDBK
	SUB J,NTBL(I)
WRTUT0:	CALL WRITE
	JUMPL T,CPOPJ
	ADDI A,2000
	ADDI J,1
	CAMGE J,MFDBK
	 JRST WRTUT0
	RET
];NTS

NTS,[
RDTUT:	MOVE J,MFDBK
	SUB J,NTBL(I)
RDTUT0:	CALL READ
	JUMPL T,CPOPJ
	ADDI A,2000
	ADDI J,1
	CAMGE J,MFDBK
	 JRST RDTUT0
	RET
];NTS



TS,[

WRTUT: JRST SUCCESS

RDTUT:	MOVE T,NTBL(I)		;Size of TUT on this drive.
	MOVE J,[SQUOZE 0,QTUTO]	;Find absolute location in ITS.
	.EVAL J,
	 .LOSE
	PUSHER P,[A,I]
	ADD J,I
	MOVSS J
	HRRI J,J
	.GETLOC J,
	HRRZS J
	LSH J,-10.
	MOVN I,T
	HRL J,I
RDTUT1:	.CALL [	SETZ
		'CORBLK
		MOVEI 210000	;Read only
		MOVEI -1	;Into Self
		MOVEI TUTPAG/2000
		MOVEI 400000	;From System
		SETZI (J) ]
	 .LOSE %LSSYS
	MOVSI I,TUTPAG
	HRRI I,(A)
	BLT I,1777(A)		;Copy in a block of TUT.
	ADDI A,2000
	AOBJN J,RDTUT1
	POPPER P,[I,A]
	SKIPGE QPKNUM(A)
	 .VALUE [ASCIZ ":TUT in old format?"]
	SKIPN QLASTB(A)
	 .VALUE [ASCIZ ":TUT in older format?"]
	JRST SUCCESS
];TS


SUBTTL	Reassign Pack#s and Fix UFDs

NTS,[
REMAPP:	REPEAT 40, -1		;Index by pack #.
				;LH:new pack #, RH: disk addr offset
REMAP:	JSR INIT
	TYPE T,"Remap the copy of the UFDs on unit # "
	CALL NTYI
	CAIL A,NUNITS
	 JRST [	TYPE T,"~&There aren't that many disk units here"
		JRST REMAP ]
	MOVE I,A
	MOVEI A,MFD		;Get MFD
	MOVE J,MFDBK
	CALL READ
	JUMPL T,ACTUE3
	MOVE Q,MFD+MDNAMP
REMAP1:	CAIL Q,2000		;NEXT UFD
	 PUNT
	SKIPN B,MFD+MNUNAM(Q)
	 JRST REMAP9
	MOVEM B,USRNAM
	MOVE J,Q
	SUBI J,2000
	IDIVI J,LMNBLK
	ADD J,NUDS		;UFD BLOCK NUMBER
	MOVEI A,OUSRD
	CALL READ
	JUMPL T,CPERR
	CAME B,OUSRD+UDNAME
	 JRST CPERR
	MOVE K,OUSRD+UDNAMP
REMAP2:	CAIL K,2000		;NEXT FILE
	 JRST REMAP6
	MOVSI C,UNLINK
	TDNE C,UNRNDM+OUSRD(K)
	 JRST REMAP5		;DON'T MANGLE LINKS
	LDB C,[UNDSCP UNRNDM+OUSRD(K)]
	IDIVI C,UFDBPW
	HLL C,QBTBLI(D)
	ADDI C,UDDESC+OUSRD	;C HAS DESC POINTER
	LDB D,[UNPKN UNRNDM+OUSRD(K)] ;D HAS PK #
	SKIPGE A,REMAPP(D)	;Get mapping.
	 HALT .			; Loser forgot to patch it in.
	HLRZ D,A		;Get new pack #
	DPB D,[UNPKN UNRNDM+OUSRD(K)]	;CHANGE IT
	HRRE D,A		;D HAS BLOCK # OFFSET
REMAP3:	MOVE E,C
	ILDB A,C		;GET DESC
	JUMPE A,REMAP5		;EOF
	CAIG A,UDWPH
	 JRST REMAP3		;DOESN'T DEPEND ON ABS DISK ADDRESSES
	ANDI A,37		;MASK OUT LOAD-ADDR-BIT
REPEAT NXLBYT,[
	LSH A,UFDBYT
	ILDB B,C
	ADD A,B
]
	ADD A,D			;RELOCATE THE ADDRESS
	REPEAT 6,NOP		;PATCH AREA
	MOVE C,E		;GET BACK B.P. TO START OF LOAD-ADDR DESCRIPTOR
	MOVE E,[<UFDBYT*NXLBYT+UFDBYT>_36+UFDBYT_30+A] 
REPEAT NXLBYT+1,[
	ILDB B,E
IFE .RPCNT,	ADDI B,40
	IDPB B,C
]
	JRST REMAP3

REMAP5:	ADDI K,LUNBLK
	JRST REMAP2

REMAP6:	MOVEI A,OUSRD
	CALL WRITE
	JUMPL T,WRERR
REMAP9:	ADDI Q,LMNBLK
	JRST REMAP1

];NTS


SUBTTL	Zero Dir Blocks, Write Empty TUT & MFD

NTS,[
ZAP:	JSR INIT
	TYPE T,"~&Init dirs on unit # "
	CALL NTYI
	 JRST ZAP
	CAIL A,NUNITS		;Does unit possibly exist?
	 JRST [	TYPE T,"~&There aren't that many disk units here"
		JRST ZAP ]
	MOVEM A,TOU		;Remember To unit.
	MOVE I,A
SH,	CALL RESET		;If hardware pack #, just reset
.ELSE,[	TYPE T,"~&Pack No?"	;If no pack # in hardware,
	CALL DTYI		;Get it from human.
	MOVEM A,PKNUM(I)	;Remember pack number.
	CALL RESET		;Then reset (should leave PKNUM alone)
];NOT SH
	MOVE A,[WXWDS-1,,WXWDS]	;Use "extra words" buffer.
	BLT A,WXWDS+3		;Zap it.
	SETZM MFD		;MFD needs zapping too.
	MOVE A,[MFD,,MFD+1]
	BLT A,MFD+1777
	MOVN J,NUDS		;Get AOBJN ptr to UFD blocks.
	HRLZ J,J
KL,	ADD J,[2,,2]		;Protect KLDCP.
KS,	ADD J,[2,,2]		;Protect 8080 'HOM' sectors.
	MOVEI A,MFD		;Empty MFD.
ZAPL:	CALL WRITE		;Write it out.
	JUMPL T,[ TYPE T,"~&Lost."
		  PUNT ]
	AOBJN J,ZAPL		;Zap all UFDs too.
DC,[	CONO DC0,DCCSET+DCDENB
	DATAO DC0,[DJMP DZAP]
	CONSZ DC0,DSSACT
	 JUMPA .-1
	CONSO DC0,DSSERR
];DC
	 JRST MARK69		;Finish formatting pack.

DC,[
DZAP:	DWRITE			;Zero the Read-In block.
	DCSKIP (-LRIBLK_2&37774)
	DHLT
];DC
];NTS


SUBTTL	Reconstruct MFD From UFDS
NTS,[

;;; MFDR - Reconstruct MFD by getting names from UFD'S

IMNFLG:	0			;MFD inited flag.

MFDR:	ACINIT
	TYPE T,"~&Reconstruct MFD from unit #"
	CALL NTYI		;Get unit number.
	 JRST MFDR
	CRR
	MOVE I,A
	CALL MFDINN		;Make a blank MFD.
	SETOM IMNFLG
	MOVEI J,0
MFDR1:	MOVEI A,TUT
	CALL READ
	JUMPL T,MFDRL
	MOVE B,TUT+UDESCP	;Look like legit UFD?
	TLNE B,-1
	 JRST MRUFDL		;Should be fs pntr
	CAIL B,<2000.-11.>*6
	 JRST MRUFDL
	MOVE B,TUT+UDNAMP
	SKIPE TUT+UDNAME	;User name?
	 TLNE B,-1
	  JRST MRUFDL		;Pntr to beg of name area.
	MOVEI B,(J)		;Convert block no to MFD index.
	SUB B,NUDS
	LSH B,1
	ADDI B,2000
	MOVE C,TUT+UDNAME	;User name.
	MOVEM C,MFD(B)
	AOSN IMNFLG
	 MOVEM B,MFD+MDNAMP
	JRST MRUFDW

MFDRL:	HALT .+1
MRUFDL:	NOP
MRUFDW:	ADDI J,1
	CAMGE J,NUDS
	 JRST MFDR1
	ASKYN "~&Write"
	 PUNT
MFDWR:	MOVEI A,MFD
	MOVE J,MFDBK
	CALL WRITE
	PUNT

];NTS


SUBTTL	Read & Type Out Headers (DC-10 only)

NTS,[
DC,[				;FOR NOW, DC10 ONLY
RDHDHD==20			;2WORDS PER SEC, MANY SECS

RDHEAD:	JSR INIT		;READ ALL HEADERS ON A TRACK
	TYPE T,"~&Unit ="
	CALL NTYI
	CAIL A,NUNITS
	 JRST [	TYPE T,"There aren't that many disk units here"
		JRST RDHEAD ]
	MOVEM A,TOU
	MOVE I,A
	CALL RESET
RDHD1:	TYPE T,"~&Cyl="
	CALL NTYI
	CAIL A,NCYLS+XCYLS
	 JRST [	TYPE T,"~&Guess again"
		JRST RDHD1 ]
	SKIPGE QTRAN(I)
	 ADDI A,NCYLS+XCYLS
	DPB A,[DCYL READHD]
	TYPE T,"Surf="
	CALL NTYI
	 SETZ A,
	CAIL A,NHEDS
	 JRST [	TYPE T,"~&Guess again"
		JRST RDHD1 ]
	DPB A,[DSURF READHD]
	DATAO DC0,[DJMP READHD]
	CONSZ DC0,DSSACT
	 JRST .-1
	CONSZ DC0,DSSERR
	 JRST [	TYPE T,"ERROR---"
		CALRET GETSTS]
	SETOM SECT0'
	SETOM FIRST'
	SETZ T,
RDHD2:	MOVE D,HEADBF(T)
	TLZ D,777000
	CAMN D,SECT0
	 JRST RDHD1		;GONE AROUND ONCE
	AOSN FIRST
	 MOVEM D,SECT0
	LDB A,[DPKID HEADBF(T)]
	TYPE T,"PKID=~O,",[A]
	MOVE D,HEADBF(T)
	CALL TYPLOC
	CRR
	MOVE A,HEADBF+1(T)
	TLNE A,1000		;INDIRECT BIT OF HEADER
	 JRST [	TYPE T,"@"
		MOVE D,HEADBF+1(T)
		CALL TYPLOC
		JRST RDHD6]
	MOVN A,HEADBF+1(T)
	LDB A,[1600,,A]		;LENGTH FIELD
	TYPE T,"LENGTH=~O",[A]
	LDB A,[270200,,HEADBF+1(T)]
	JUMPE A,RDHD3		;ANY NEXT-ADDRESS CODE?
	HRRO B,NXTADR(A)	;Yes, get string.
	TYPE T,"~A",[B]		;Print it.
RDHD3:	MOVE A,HEADBF+1(T)
	TLNE A,200
	 JRST [	TYPE T,",WRITE PROTECT,"
		JRST .+1]
RDHD6:	SETO C,		;PARITY
	HRLI T,-2
RDHD4:	MOVEI D,14.
	MOVE A,HEADBF(T)
	XORM A,C
	LSH A,-2
	SOJG D,.-2
	AOBJN T,RDHD4
	TRNN C,3		;BOTH ODD?
	 JRST RDHD5
	TYPE T,",BAD PARITY!!"
RDHD5:	CRR
	CAIL T,RDHDHD*NSECS
	 JRST RDHD1
	JRST RDHD2

READHD:	DSPC+DSWIDX+DSWNUL+DSCRHD	;WAIT FOR INDEX, THENREAD HEADERS
	QCOPY HEADBF,RDHDHD*NSECS
	DHLT

HEADBF:	BLOCK RDHDHD*NSECS

NXTADR:	0
	[ASCIZ /,END-OF-TRACK/]
	[ASCIZ /,END-OF-CYLINDER/]
	[ASCIZ /,END-OF-DISC/]

TYPLOC:	PUSHER P,[A,B,C]
	LDB A,[DCYL D]
	LDB B,[DSURF D]
	LDB C,[DSECT D]
	TYPE T,"Cyl=~O, Surf=~O, Sect=~O",[A,B,C]
	POPPER P,[C,B,A]
];DC
];NTS


SUBTTL	Copy Block To Block

NTS,[
COPY:	JSR INIT
	TYPE T,"~&Copy block from unit #"
	CALL NTYI
	 JRST COPY
	CAIL A,NUNITS
	 JRST COPY
	MOVEM A,FROM
	MOVE I,A
	CALL RESET
CP1:	CRR
	TYPE T,"~&Block #"
	CALL OTYI
	CAIL A,TBLKS
	 JRST CP1
	MOVEM A,FMBLK
CP2:	CRR
	TYPE T,"~&onto unit #"
	CALL NTYI
	 JRST CP2
	CAIL A,NUNITS
	 JRST CP2
	MOVEM A,TOU
	MOVE I,A
	CALL RESET
CP3:	TYPE T,"Block #"
	CALL OTYI
	CAIL A,TBLKS
	 JRST CP3
	MOVEM A,TOBLK
	MOVEI A,TUT
	MOVE J,FMBLK
	MOVE I,FROM
	CALL READ
	JUMPL T,CPERR
COPYB:	MOVEI A,TUT		;HANDY PLACE FOR A BREAKPOINT
	MOVE J,TOBLK
	CALL WRITT
	PUNT
];NTS

SUBTTL	Copy Directories from Drive to Drive

NTS,[
UCOP:	JSR INIT
	TYPE T,"~&Copy directories"
	CALL DUP1
	MOVEI A,D0
	MOVE J,MFDBK
	CALL READFN
	CALL WRITT
	MOVEI Q,2000
UCOPL:	SUBI Q,LMNBLK
	CAMGE Q,D0+MDNAMP
	 JRST DDT
	SKIPN B,D0(Q)
	 JRST UCOPL
	HRREI J,-2000(Q)	;Convert MFD index to block #.
	ASH J,-1
	ADD J,NUDS
	MOVEI A,OUSRD
	CALL READFN
	CAME B,OUSRD+UDNAME
	 HALT .
	CALL WRITT
	JUMPL T,WRERR
	JRST UCOPL

READFN:	SKIPA I,FROM
READT:	 MOVE I,TOU
	CALL READ
READC:	JUMPL T,[HALT .]
	RET

];NTS


SUBTTL	Copy Entire Pack

NTS,[
DUP:	JSR INIT
	SETZM USRDS'
	SETZM USWRTS'
	SETZM DUPRER
	SETZM DUPWER
RH,	SETZM CERRS
	TYPE T,"Duplicate disk"
	CALL DUP1
	MOVE I,FROM
DC,	MOVE A,QTRAN(I)
DC,	DPB A,[DUNFLD CYLRIR]
SH,[	MOVE A,PKNUM(I)
	MOVE I,TOU
	CAME A,PKNUM(I)
	 JRST DUPLUZ
];SH
.ELSE,	MOVE I,TOU
DC,	MOVE A,QTRAN(I)
DC,	DPB A,[DUNFLD CYLRIW]
	MOVEI J,NCYLS+XCYLS-1	;Determine how many cylinders this drive.
RP,[	MOVSI A,(DNOOPC)
	DPB I,[DUNFLD A]	;Select destination drive.
	DATAO DPC,A
	DATAI DPC,B
	MOVE I,FROM
	DPB I,[DUNFLD A]	;Select source drive.
	DATAO DPC,A
	DATAI DPC,A
	XOR A,B
	TRNE A,2000
	 LOSE "~&Can't copy RP02 to RP03 or vice versa."
	TRNE B,2000
	 MOVEI J,MCYLS+XCYLS-1	;Drives are RP03s, more cylinders to copy.
];RP
T300,[
	CAIL I,T300P
	 JRST T3DUP		;Have to do it the slow way.
	MOVE I,FROM
	CAIL I,T300P
	 LOSE "~&Can only go T-300 to T-300."
];T300P
	MOVEI A,CYLBUF
DLUP:	MOVE I,FROM
	CALL READCY
	JUMPL T,DLUP1		;Lost, try block at a time.
	MOVE I,TOU
	CALL WRITCY
	JUMPL T,DLUP1
DLUP2:	SOJGE J,DLUP
DC,	MOVEI T,CYLRIR		;Copy read-in block.
DC,	CALL RW0
RH,[	SKIPN A,CERRS
	 PUNT
	TYPE T,"~&~D. ECC corrected errors.",[A]
	PUNT
]
.ELSE	PUNT

DUPLUZ:	LOSE "~&Pack # differs.~%"
	PUNT


DUP1A:	CRR
DUP1:	TYPE T,"~&From unit #"
	CALL NTYI
	 JRST DUP1A
	CAIL A,NUNITS
	 JRST DUP1A
	MOVE I,A
	CALL RESET

;;; DUP2 - read TOU
;;; A/ FROM unit
;;; Resets the FROM disk.
;;; Sets up TOU, smashing A.  Never skips.

DUP2:	MOVEM A,FROM
TO:	CRR
	TYPE T,"~&onto unit #"
	CALL NTYI
	 JRST TO
	CAIL A,NUNITS
	 JRST TO
	MOVEM A,TOU
	ASKYN "~&Copy from unit #~D onto unit #~D, OK",[FROM,TOU]
	 PUNT
	MOVE I,TOU
	CALL RESET
	RET


T300,[
T3DUP:	MOVE I,FROM
	CAIGE I,T300P
	 LOSE "~&Can only go T-300 to T-300."
	TYPE T,"~&This will take a while..."
	MOVEI J,NBLKS1+XBLKS1-1
T3DUP1:	MOVEI A,CYLBUF
	MOVE I,FROM
	CALL READ
	JUMPL T,CPERR
	MOVE I,TOU
	CALL WRITE
	JUMPL T,WRERR
	SOJGE J,T3DUP1
	PUNT
];T300P

IFE RH10P,[			;Block at a time.
DLUP1:	PUSH P,J
	IMULI J,NBLKSC
	SETZM DLUPT
DLUP3:	MOVE I,FROM
	MOVEI A,CYLBUF
	CALL READ
	JUMPL T,DLUPE1
	MOVE I,[RXWDS,,WXWDS]
DLUPEW:	BLT I,WXWDS+4-1
	CALL WRITT
	JUMPL T,DLUPE2
DLUPEX:	AOS TT,DLUPT
	CAIGE TT,NBLKSC
	 AOJA J,DLUP3
	POP P,J
	JRST DLUP2
]
RH,[				;SECTOR AT A TIME ON RP04 SO GET EXTRA SECTORS
DLUP1:	MOVEI T,NHEDS*NSECS
	MOVEM T,DLUPT
DLUP3:	SOS W,DLUPT		;NEXT SECTOR (GOING BACKWARDS THROUGH CYLINDER)
	IDIVI W,NSECS		;TRACK IN W, SECTOR IN U
	LSH W,8
	IOR W,K
	HRL W,J			;NOW W HAS DISK ADDRESS
	MOVEM W,RHPGA
	MOVE K,[-200,,CYLBUF-1]
	MOVEM K,RHIOW
	MOVE I,FROM
	MOVEI TT,%HMRED
	MOVEM TT,RHCMD
	CALL RW1
	JUMPL T,DLUPE1
DLUPEW:	MOVE I,TOU
	MOVEI TT,%HMWRT
	MOVEM TT,RHCMD
	CALL RW1
	JUMPL T,DLUPE2
DLUPEX:	SKIPE DLUPT
	 JRST DLUP3
	JRST DLUP2
];RH

DLUPT:	0

DLUPE1:	AOS DUPRER
	SKIPE HCRASH
	 JRST DLUPE4		;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
	TYPE T,"~&Read error on block #"
	CALL DLUPE3
DLUPE4:	SETZM CYLBUF		;COULDN'T READ THE BLOCK, SUBSTITUTE ALL ZEROS
	MOVE A,[CYLBUF,,CYLBUF+1]
	BLT A,CYLBUF+2000-1
	MOVE I,[DLUPE5,,WXWDS]	;WITH SPECIAL EXTRA WORDS
	JRST DLUPEW		;RESUME DLUP AT WRITE

DLUPE3:	TYPE T,"~D-",[I]
IFE RH10P, MOVE A,J
IFN RH10P,[
	HLRZ A,RHPGA		;CYLINDER
	IMULI A,NBLKSC
	LDB W,[101000,,RHPGA]	;HEAD
	IMULI W,NSECS
	LDB K,[001000,,RHPGA]	;SECTOR
	ADD W,U
	IDIVI W,SECBLK
	ADD A,W			;INACCURATE IF UNUSED SECTOR AT END OF CYLINDER
];RH10P
	TYPE T,"~D~%",[A]
	CALRET GSTS		;HARDWARE STATUS

DLUPE2:	AOS DUPWER
	SKIPE HCRASH
	 JRST DLUPEX		;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
	TYPE T,"~&Write error on block #"
	CALL DLUPE3
	JRST DLUPEX

;SUITABLE EXTRA WORDS FOR BLOCKS THAT COULDN'T BE READ

DLUPE5:	0			;WORD COUNT=2000, LAST BLOCK=0
	SIXBIT /??????/		;DUMMY DIRECTORY
	SIXBIT /(DISK)/
	SIXBIT/LOSSAG/
];NTS

TS,DUP:	RET


SUBTTL	Test and Unlock Some Blocks

NTS,[
UNLOCK:	JSR INIT
	TYPE T,"~&Unlock blocks on unit #"
	CALL NTYI
	 JRST UNLOCK
	CAIL A,NUNITS
	 JRST UNLOCK
	MOVEM A,FROM
	MOVE I,A
	CALL RESET
UNLK1:	TYPE T,"~&Block #"
	CALL DTYI
	CALL UNLOCB
	 NOP
	JRST UNLK1		;Use ^Z to get out.

;;; UNBLOB - Unlock a block
;;;    A/ block number
;;; FROM/ disk unit

UNLOCB:	PUSHER P,[J,K,Q,D,B]
	MOVE J,A
	MOVEM J,FMBLK
	SETZM CYLBUF			;ZERO OUT IN CASE CAN'T READ
	MOVE A,[CYLBUF,,CYLBUF+1]
	BLT A,CYLBUF+4000-1
	MOVE I,FROM
	MOVEI A,CYLBUF
	CALL READ
	JUMPGE T,UNLK2
	TYPE T,"~&Read Error~%"
	CALL GSTS
	ASKYN "~&Proceed"
	 JRST UNLOCX
UNLK2:	MOVE A,[RXWDS,,WXWDS]
	BLT A,WXWDS+4-1
	MOVEI A,CYLBUF
	CALL WRITE
	JUMPL T,WRERR
	MOVEI A,CYLBUF+2000
	CALL READ
	JUMPL T,[ TYPE T,"~&Read-back error"
		  CALL GSTS
		  JRST UNLOCX]
	MOVSI T,-2000
UNLK3:	MOVE TT,CYLBUF(T)
	CAME TT,CYLBUF+2000(T)
	 JRST [	TYPE T,"~&Read-back compare error"
		JRST UNLOCX]
	AOBJN T,UNLK3

	MOVEI A,TUT
	CALL RDTUT
	JUMPL T,CPERR
	MOVE J,FMBLK
	MOVEI B,TUT
	CALL TUTPNT
	JUMPE J,[ TYPE T,"~&Can't access TUT"
		  JRST UNLOCX ]
	MOVEI B,1		;Safest - next salvage will correct it.
	DPB B,J
	MOVEI A,TUT
	X WRTUT
	JUMPL T,WRERR
	AOS -5(P)		;Winning skip return
UNLOCX:	POPPER P,[B,D,Q,K,J]
	RET

];NTS



SUBTTL	Simple Disk Tests

NTS,[

;;; DSKTST -  Writes a single block, reads it back, and checks
;;; that it's the same.

DSKTST:	JSR INIT
	SETOM HCRASH		;DON'T DO ERROR RETRY
	TYPE T,"~&Test unit #"
	CALL NTYI
	 JRST DSKTST
	CAIL A,NUNITS
	 JRST DSKTST
	MOVE I,A
	ASKYN "~&Got a scratch pack on unit #~D.?",[I]
	 LOSE "~&Silly loser!"
DSKTS0:	CALL RESET
	MOVEI J,NBLKSC*15.	;Randomly use cylinder 15.
	MOVSI A,-PG$SIZ
	MOVEI B,1		;First part of pattern is floating 1s.
DSKT0A:	MOVEM B,D0(A)
	LSH B,1
	SKIPE B
	 AOBJN A,DSKT0A
	HRROI B,-2		;Next is floating 0s.
DSKT0B:	MOVEM B,D0(A)
	JUMPGE B,DSKT0C
	LSH B,1
	AOS B
	AOBJN A,DSKT0B
DSKT0C:	MOVEM A,D0(A)		;The rest is an address pattern.
	AOBJN A,DSKT0C
	MOVEI A,D0
	CALL WRITE
	JUMPL T,WRERR
DSKTS1:	MOVEI A,D1
	CALL READ
	CALL TYIPSE
	MOVSI B,-PG$SIZ
DSKT1A:	MOVE A,D1(B)
	CAMN A,D0(B)
DSKTS2:	 AOBJN B,DSKT1A
	JUMP [	;; Change to JUMPA for no typeout.
		LIGHTUP [0]	
		JUMPGE B,DSKTS1
		MOVE A,B
		XOR A,CYLBUF(B)
		LIGHTUP A
		JRST DSKTS2 ]
	JUMPGE B,[ JUMPGE T,DSKTS1
		   CALL GSTS
		   JRST DSKTS1 ]
	HRRZ A,B
	TYPE T,"~6<~;0~D~>/ ",[A]
	MOVE A,D0(B)
	MOVE A,D1(B)
	TYPE T,"~H ",[A]
	MOVE A,D0(B)
	XOR A,D1(B)
	TYPE T,"~H~%",[A]
	JRST DSKTS2


;;; SEKTST - Loops over all heads, and optionally loops over different
;;; length seeks.  It doesn't write, but is a test of seeking and searching.
;;; SETOM HCRASH if you want to do no error retries on read/search errors
;;; (but seek incompletes will always be retried.)

SEKTST:	JSR INIT
	TYPE T,"~&Seek test unit #"
	CALL NTYI
	 JRST SEKTST
	CAIL A,NUNITS
	 JRST SEKTST
	MOVE I,A
	CALL RESET
	SETZM SEKINC
	MOVEI A,10.*NBLKSC
	ASKYN "~&Always do full length seeks"
	 CAIA
	  MOVEM A,SEKINC'	;If no, do decreasing length seeks.
SEKTS0:
RP,[	MOVSI A,(DNOOPC)	;Determine how many cylinders this drive
	DPB I,[DUNFLD A]
	DATAO DPC,A
	DATAI DPC,B
	MOVEI A,<NCYLS-1>*NBLKSC	;RP02.
	TRNE B,2000
	 MOVEI A,<MCYLS-1>*NBLKSC ]	;RP03.
.ELSE	MOVEI A,<NCYLS-1>*NBLKSC	;RP04/6.
T300,[	CAIL I,T300P
	 MOVEI A,<NCYLS1-1>*NBLKC1 ]	;T-300.
	MOVEM A,SEKCY2'
	SETZM SEKCY1'
SEKTS1:	SETZM SEKHDN'		;Reset head.
SEKTS2:	MOVE J,SEKCY1		;Block address of outer cylinder.
	ADD J,SEKHDN		;Select a block on the desired head.
	MOVEI A,CYLBUF
	CALL READ		;Read it
	SKIPGE T
SEKTS3:	 CALL GSTS
	MOVE J,SEKCY2		;Block address of inner cylinder.
	ADD J,SEKHDN		;Select same head.
	MOVEI A,CYLBUF
	CALL READ		;Read it.
	SKIPGE T
	 XCT SEKTS3
	CALL TYIPSE
	MOVEI J,NSECS/SECBLK	;Advance to next head.
	ADDB J,SEKHDN
	CAIGE J,NBLKSC		;Touched all heads?
	 JRST SEKTS2		; No.
	MOVN B,SEKINC		;Yes, change cylinders.
	ADDB B,SEKCY2
	MOVE C,SEKINC
	ADDB C,SEKCY1
	CAMG C,B
	 JRST SEKTS1
	JRST SEKTS0		;Recycle.
];NTS

TS,DSKTST: NOP ? RET
TS,SEKTST: NOP ? RET


SUBTTL	Mag Tape routines

NTS,[

;;; Tape variables

TMDCP:	0	;-1 iff TM10B unit.
ITAPE:	0	; -1 => tape is rewound
MAGBFP:	0	;Bp to tape buffer.
MTRYS:	0	;Tape operation retry count.
MAGHD:	0
EOFCNT:	0	;Count of EOFs.  (Nothing seems to look at this.)
EOFLG:	0	;EOF seen.  (Used by MREAD internally.)
EOTFLG:	0	;EOT seen.  (Not used anywhere???)

EOUF:	0	; This is the EOF flag for callers of MREAD.

SHORTL:	0	; The TM10 version of MREAD uses this internally.  The
		; TM03 version maintains it, but never looks at it, so
		; it might even be doing it wrong...

LNKFLG:	0	;-1 iff reloading a link
LNKNM1:	0	;Link FN1
LNKNM2:	0	;Link FN2
LNKSNM:	0	;Link SNAME

;;; Tapeset info block.

THBLK:	-LTHBLK,,0
THTPN:	0	;Tape #,,reel # in this DUMP
THDATE:	0	;Tape creation date
THTYPE:	0	;Tape type: 0=>Random  >0 => Full   <0 => Incr
LTHBLK==.-THBLK

;;; File header block.

MHBLK:	-LMHBLK,,0
MHSNM:	0	;SNAME
MHFN1:	0	;FN1
MHFN2:	0	;FN2
LMHBKZ==.-MHBLK		; Header must be at least this long
MHPKN:	0	;Link Flag,,Pack #
MHDATE:	0	;Creation Date
			; Next two added 7/15/89 by Alan
MHRDAT:	0	;Reference Date, Author Index, Byte Size, Byte Count
MHLEN:	0	;Length in words
LMHBLK==.-MHBLK		; Header must be no longer than this


TM10,[

;;; TM10A (IO Bus) & TM10B (Data Channel) Macro Tape Subsystems.

MTC==340		;Mag tape channel for functions
MTS==344		;Mag tape channel for stopping and status

;;; Shifts for fields in CONO MTC,
UNITNO==15.
PARITY==14.
CDUMP==13.
FUNC==9.
DENSTY==6.
800BPI==2

MAGCOM=5_<UNITNO>+1_<PARITY>+800BPI_<DENSTY>+1_<CDUMP>

;;; Functions

NOOP1=0_<FUNC>+MAGCOM	;Clear interrupt flags
NOOP2=10_<FUNC>+MAGCOM	;Interrupt when transport idle
REWIND=1_<FUNC>+MAGCOM	;Rewind
REED=2_<FUNC>+MAGCOM	;Read
SPACR=7_<FUNC>+MAGCOM	;Space reverse

;;; Flags
;;; Note: TM10B has DATA PIA (CONI MTC, 1.1-1.3) stuck at 7

JOBDON==100
DATREQ==1
EOFF==10000
EOTF==4000



;;; REW - Rewind the tape

REW:	SETZM EOFCNT		;No EOFs seen.
	SETZM MAGBFP
	SETZM SHORTL
	CONO MTC,NOOP1		;Clear interrrupt flags
	CONO MTC,REWIND		;Initiate rewind
	CONSO MTS,JOBDON	;Wait for rewind to begin
	 JRST .-1
	CONO MTC,NOOP2		;Set job done when transport idle
	CONSO MTS,JOBDON	;Wait for job done
	 JRST .-1
	SETOM ITAPE		;Say tape rewound.
	RET			;Rewind done.


;;; READ - Read from the tape.

MREAD:	MOVEI T,0
	PUSHER P,[B]		;Do not smash ACs.
MREAD7:	SKIPGE B,MAGBFP
	 JRST [	HLRE C,B
		CAMG B,A
		 HLRE C,A
		HRLZS B
		HRR B,A
		MOVNS C
		HRLS C
		ADDI C,-1(A)
		BLT B,(C)
		HLRS C
		ADD A,C
		ADDM C,MAGBFP
		ADDI T,(C)
		JUMPGE A,MREADZ
		JRST MREAD7 ]
	SKIPN EOFLG		;EOF seen?
	 JRST MREAD1		; No, go read.
	SETZM EOFLG		;Complete.
	SETOM EOUF
MREADZ:	POPPER P,[B]
	RET

MREAD1:	MOVEI B,10.		;Retry ten times.
	MOVEM B,MTRYS		;Remember count.
MERR2:	MOVE B,[-2000,,MAGBUF]	;Set up Bp.
	MOVEM B,MAGBFP		;Remember it.
	SETZM SLVIOWD
	CONO MTC,NOOP1		;Clear flags.
	SKIPE TMDCP
	 JRST [ KA, MOVE B,[-2000,,MAGBUF-1]
		KL, MOVE B,[-2000_4,,MAGBUF-1]
		MOVEM B,SLVIOWD		;Store channel program.
		SETZM SLVICWA+1
		SETZM SLVIOWD+1
		DATAO MTS,[SLVICWA]
		KL,[	SWPUA		;Unload the cache.
			CONSZ 200000
			 JRST .-1 ]
		JRST .+1 ]
	CONO MTC,REED		;Issue read command.
MREAD2:	CONSO MTS,DATREQ+EOFF+JOBDON+EOTF
	 JRST .-1		;Wait for next request.
	DELAY US,20.		;Wait a little longer.
	CONI MTS,C		;Read tape state.
	TRNE C,EOTF		;End of tape encountered?
	 JRST MREOT		; Yes, handle it.
	TRNN C,JOBDON		;Job done?
	 JRST [ TRNE C,DATREQ	;  No. 
		 SKIPE TMDCP	;  Data request (yes if TM10B)?
		  JRST MREAD2	;    No, keep waiting.
		DATAI MTC,(B)	;  Read request.
		SKIPE SHORTL
		 HALT .
		AOBJN B,MREAD2	; Keep trying.
		JRST MREAD4 ]
	TRNN C,EOFF		;End of file?
	 JRST MREAD6		; No.
	AOS EOFCNT		;Count end of file.
	SETOM EOFLG		;Say we saw it.
	SETZM SHORTL
	CAIA
MREAD6:	 SETOM SHORTL
	SKIPN TMDCP		;Data channel tape?
	 JRST [	HLLZS B		; No.  Get buffer ptr
		MOVNS B		; # wds xfered.
		ADDM B,MAGBFP	; Update ptr.
		JRST MREAD4 ]
	HRRZ B,SLVICWA+1	;Else must wait for Channel response.
	JUMPE B,.-1
	MOVNI B,1-MAGBUF(B)	;Get updated buffer ptr from channel.
	SKIPE EOFLG		;If EOF seen
	 MOVSI B,0		; No words were read.
	HRLM B,MAGBFP		;Else store back buffer ptr.
	JRST MREAD4		;Go see if done now.

MREAD4:	CONO MTS,1		;Stope the tape.
	CONSO MTS,JOBDON	;Done?
	 JRST .-1		; Keep waiting.
	CONSZ MTS,440000	;Xfer hung or illegal operation?
	 HALT MERR		; Yes, halt.
MREAD8:	CONSO MTS,20600		;Error bits on?
	 JRST MREAD7		; No, keep trucking.
MERR:	SOSG MTRYS		;Exhausted yet?
	 JRST [ AOS FERRS	; Count an error
		JRST MREAD7 ]	; But ignore it.
	SETZM SLVIOWD		;Else clear tape program.
KL,[	SWPUO 0			;Unload page zero from cache.
	CONSZ 200000
	 JRST .-1 
];KL
	CONO MTC,NOOP1		;Clear interrupt flags.
	CONO MTC,SPACR		;Backup the tape.
	SKIPN TMDCP		;If IO Bus tape device
	 JRST [	CONSO MTS,DATREQ	;Wait for tape.
		 JRST .-1
		DATAO MTC,
		JRST .+1 ]
	CONO MTS,1		;Stop the tape.
	CONSO MTS,JOBDON	;Wait for it.
	 JRST .-1
	JRST MERR2		;Continue on our way.

MREOT:	CONO MTS,1		;Stop tape if still moving.
	CONO MTC,NOOP1		;Clear interrupt flags.
	TYPE LPT,"~&EOT"	;Announce end of tape.
	PUNT			;Dump back into DDT

];TM10

TM03,[

;;; KS10/RH11/TM03 tape support

.INSRT SYSTEM;TM03S >

;Default tape device
IFNDEF TMBTC,TMBTC==0		;TM03 number on RH
IFNDEF TMBTS,TMBTS==0		;Slave number on TM03

;TMCCLR - Reset controller and formatter
;TMFCLR - Reset formatter only
;
TMCCLR:	MOVEI B,%TM2CC		;Controller reset bit
	IOWRI B,%TMCS2		;Clear controller logic
	MOVEI B,TMBTC		;Get appropriate TM03 to boot from
	IOWRI B,%TMCS2		;Reselect TM03
TMFCLR:	MOVEI B,TMBTS		;Get slave used for booting
	IOWRI B,%TMTC		;Make sure this slave is selected
	MOVEI C,10.		;Try 10 times to clear drive
TMFC.1:	MOVEI B,%TMCLR		;Clear formatter
	IOWRI B,%TMCS1		;Do it
	IORDI B,%TMFS		;Get status
	TRNN B,%TMSES		;Still have error
	 JRST TMFC.2		;No, OK
	SOJG C,TMFC.1		;Retry up to 10 times
	LOSE "~&Tape controller won't clear"
TMFC.2:	RET

;;; REW - Reset the controller and drive, rewind the tape

REW:	SETZM EOFCNT		;No EOFs seen.
	SETZM MAGBFP
	SETZM SHORTL
	CALL TMCCLR		;Reset tape
	IORDI B,%TMFS
	TRNE B,%TMSOL		;On line?
	 JRST REW.0
	TYPE T,"~&Tape Offline"
	PUNT
REW.0:	MOVEI B,%TMREW
	IOWRI B,%TMCS1		;Start rewind operation
REW.1:	IORDI B,%TMCS1
	TRNE B,%TM1GO		;Still executing command?
	 JRST REW.1		;Yah.
REW.2:	IORDI B,%TMFS		;Get formatter status
	TRNE B,%TMSPP		;Still rewinding?
	 JRST REW.2		;Wait.
	TRNE B,%TMSES		;Error?
	 LOSE "~&Tape error on rewind."
	TRNN B,%TMSBT		;Not BOT?
	 LOSE "~&Tape not at BOT after rewind?"
	SETOM ITAPE		;Say tape rewound.
	RET			;Rewind done.

;;; READ - Read from the tape.
;
;Call with A/ -count,,address
;Return A/ Updated pointer, T/ total read

IUTPG==1			;First unibus page (UBA I) to map tape buffers
IF2,IFN MAGBUF&1777,.FATAL MAGBUF must be on a page boundary.

MREAD:	MOVEI T,0
	PUSHER P,[B,C,D,E]	;Do not smash ACs.
MREADL:	SKIPGE B,MAGBFP		;Have any data buffered already?
	 JRST [	HLRE C,B	;Yes. Get -count of words to move.
		CAMG B,A	;Use # of words left in MAGBUF, unless caller..
		 HLRE C,A	; asked for less, use caller's request size.
		HRLZS B		;Build BLT ptr. Source is current pos in MAGBUF
		HRR B,A		;Get destination address from argument
		MOVNS C		;Get positive count
		HRLS C		;Save count safely in LH of C
		ADDI C,-1(A)	;RH of C gets last address to move
		BLT B,(C)	;Do it
		HLRS C		;Get count back - C == count,,count
		ADD A,C		;Adjust argument pointer
		ADDM C,MAGBFP	;Adjust MAGBUF pointer
		ADDI T,(C)	;Count total words moved
		JUMPGE A,MREADZ	;Got enough data? Exit if so.
		JRST MREADL ]	;Need more, go back and read it.
	SKIPN EOFLG		;No buffered data. EOF seen?
	 JRST MREAD1		; No, go read.
	SETZM EOFLG		;Complete.
	SETOM EOUF
MREADZ:	POPPER P,[E,D,C,B]
	RET

;Here to read a tape record into MAGBUF
;
MREAD1:	MOVEI B,10.		;Retry ten times.
	MOVEM B,MTRYS		;Remember count.
MERR2:	MOVE B,[0,,MAGBUF]	;Set up BP - no data yet
	MOVEM B,MAGBFP		;Remember it.
	IORDI B,%TMFS		;Get current formatter status
	TRNN B,%TMSES\%TMSSC	;Showing error or slave status change?
	 JRST MREAD2
	MOVEI B,%TM1TE
	IOWRI B,%TMCS1		;Clear RH11 errors and...
	CALL TMFCLR		; reset formatter at slightest provocation

MREAD2:	MOVEI B,<%TMD16_8.>+<%TMFCD_4.>+TMBTS
	IOWRI B,%TMTC		;Tell TM03
	MOVEI B,%TMNOP		;You may need this to set status values
	IOWRI B,%TMCS1		; but I'm not really sure
	IORDI B,%TMCS1
	TRNE B,%TM1GO		;Wait till done
	 JRST .-2
	IORDI B,%TMFS		;Get status
	TRNE B,%TMSOL		;On line?
	 TRNN B,%TMSFR		;Formatter ready?
	  LOSE "~&Tape offline or controller not ready"
	MOVEI B,-2000*2		;2000 words * 2 gives unibus word count
	IOWRI B,%TMWC		;Set UB WC. Only 16 bits, MOVEI above OK
	SETZ B,			;Set FC to zero
	IOWRI B,%TMFC		;Maybe the controller does this for you?
	MOVEI B,MAGBUF/PG$SIZ	;Get ITS page to transfer to
	LSH B,1			;Convert ITS pg # to DEC pg #
	TRO B,%UQVAL
	IOWRI B,UBAPAG+IUTPG_1	;Set up first half of UBA mapping
	TRO B,1			;Next DEC page number
	IOWRI B,UBAPAG+IUTPG_1+1;Set second half of UBA mapping
	MOVEI B,IUTPG_14	;Unibus address for DMA
	IOWRI B,%TMBA		;Tell controller
	CLRCSH			;All that work for one lousy page.
	MOVEI B,%TMRDF		;Read forward
	IOWRI B,%TMCS1		;Start controller
	IORDI B,%TMCS1		;Get RH status
	TRNE B,%TM1GO		;Wait till command is finished
	 JRST .-2
	TRNE B,%TM1MP		;Massbus control channel parity error?
	 LOSE "~&Fatal MASSBUS control error on tape read"
	IORDI C,%TMFS		;Get formatter status
	TRZE C,%TMSET		;EOT?
	 JRST MREOT
	TRNN B,%TM1TE		;Masbus transfer error?
	 TRNE C,%TMSES		; or formatter error of some kind?
	  JRST MRERR		;Yep, go handle error
				;+++ Need UBA herror check.
MREAD3:	TRNE C,%TMSTM		;Read a tape mark?
	 JRST [	AOS EOFCNT	;Yes. Count EOFs
		SETOM EOFLG	;Note EOF
		SETZM SHORTL
		JRST MREAD4 ]
	SETOM SHORTL
	IORDI D,%TMFC		;Get record size in tape frames
	ADDI D,4		;Round up to PDP10 words.
	IDIVI D,5		;Get record size in PDP10 words
	MOVNS D			;Get -count
	HRLM D,MAGBFP		;Update available word count in ptr.

MREAD4:	JRST MREADL		;Back to main read loop

;B/CS1 C/FS
MRERR:	SOSG MTRYS		;Exhausted yet?
	 JRST MRERRQ
	IORDI D,%TMERR		;Get formatter error register
	TRNE D,%TMERM\%TMEUS\%TMEFS\%TMEIR\%TMEIF\%TMEMC\%TMECT\%TMENX
	 JRST MRERRF		;Fatal errors
	TRNN C,%TMSOL		;On line?
	 JRST MRERRF		;This isn't so good either
	TRZ D,%TMEFC\%TMENG	;Ignore NSG, Frame count error
	TRNE C,%TMSPE		;Phase encoded (1600BPI) mode?
	 TRZ D,%TMECE\%TMECS	;If so, ignore errors hardware already fixed
	TRZN D,%TMECE\%TMECS\%TMEFC\%TMENG\%TMEFL\%TMEMD\%TMEIC ;Retryable?
	 JRST MRERR1		;Nothing retrying will help, just use it
	TRNE C,%TMSTM		;Tape mark?
	 JRST MRERR2		;Yes, no point in retrying
	JRST MRRT		;OK, go retry read

;Formatter seems happy. Check channel status before returning
MRERR1:	TRNE D,177777		;Sanity check. Shouldn't be any errors left
	 JRST MRERRF
	TRNE B,%TM1TE		;Transfer error?
	 TRNE C,%TMSES		;And not formatter error?
	  CAIA
	   JRST MRERRF		;Just lose for now
MRERR2:	JRST MREAD3

;Fukt
MRERRQ:	AOS FERRS		; Count an error
	TYPE T,"~&Irrecoverable tape data error."
	ASKYN "~&Continue, using bad data?"
MRERRF:	 LOSE "~&Quit, fatal tape error"
	JRST MREADL

;Retry tape read
;
MRRT:	MOVEI B,%TM1TE		;Reset RH errors
	IOWRI B,%TMCS1
	CALL TMFCLR		;Clear and reset TM03
	SETO B,
	IOWRI B,%TMFC		;1 record
	MOVEI B,%TMSPR		;Space backwards command
	IOWRI B,%TMCS1		;Do it
MRRT.1:	IORDI B,%TMCS1
	TRNE B,%TM1MP		;Massbus gone
	 JRST MRERRF
	TRNE %TM1GO		;Done?
	 JRST MRRT.1		;Wait
	JRST MERR2		;Continue on our way.

;EOT. Clear tape system
MREOT:	CALL TMCCLR		;Reset everything.
	TYPE LPT,"~&EOT"	;Announce end of tape.
	PUNT			;Dump back into DDT

];TM03
];NTS


SUBTTL	Load From Mag Tape

NTS,[
TMXX,[

TRAN:	CALL REW		;Rewind the tape.
TRAN1:	JSR INIT		;Reset the world.
	CRR
	MOVEI I,0		;Start with lowest disk.
	CALL RSTALL
	MOVEI A,5		;Use tape unit 5 for reading.
				; (KS code ignores this apparently)
	CALL DUP2		;Go get disk unit to load onto.
	MOVEI A,TUT		;We want the TUT in core.
	MOVE I,TOU
	CALL RDTUT		;Read in disk's TUT.
	JUMPL T,READC		; Aeuuagh.
	MOVEI A,MFD		;We want the MFD in core.
	MOVE J,MFDBK
	CALL READT		;Read MFD from disk.
TNAML:	CALL MAGOP		;Start reading the tape.
	 JRST MREOT		; punt when end of tape.
	MOVE A,MHFN1		;Don't reload directories!
	MOVE B,MHFN2
	CAMN A,[SIXBIT/.FILE./]	;Magic file names of UFDs.
	 CAME B,[SIXBIT/(DIR)/]
	  CAIA
	   JRST TIGNF
	CAMN A,[SIXBIT/M.F.D./]	;Magic file names of MFD.
	 CAME B,[SIXBIT/(FILE)/]
	  CAIA
	   JRST TIGNF
	TYPE LPT,"~&~S;~S ~S ",[MHSNM,MHFN1,MHFN2]
	SETZM FERRS		;No errors reloading yet.
	MOVE B,MHSNM
	MOVE A,MFD+MDNAMP
	SETZM IBLK
TMLKP:	CAIL A,2000
	 JRST TNEWU		;New UFD.
	SKIPN C,MFD+MNUNAM(A)
	 JRST [	MOVEM A,IBLK
		JRST TMLKL ]
	CAMN B,C
	 JRST TOLDU		;Old UFD.
TMLKL:	ADDI A,LMNBLK
	JRST TMLKP

TOLDU:	HRREI J,-2000(A)	;Convert MFD index to block #.
	ASH J,-1
	ADD J,NUDS
	MOVEM J,UFDTA
	MOVEI A,NUSRD
	CALL READT		;Read UFD from disk.
	CAME B,NUSRD+UDNAME	;Should read the right amount.
	 HALT .			; else losing big.
	JRST TOLDUR

TNEWU:	MOVE A,[NUSRD,,NUSRD+1]	;Make an empty UFD in core.
	SETZM NUSRD
	BLT A,NUSRD+1777	;Zap.
	MOVEM B,NUSRD+UDNAME	;Store UFD name.
	MOVEI A,2000
	MOVEM A,NUSRD+UDNAMP	;Initial name are ptr.
	SKIPN A,IBLK
	 JRST [ MOVNI A,LMNBLK
		ADDB A,MFD+MDNAMP
		JRST .+1 ]
	MOVEM B,MFD+MNUNAM(A)	;Now insert UFD into the MFD.
	HRREI J,-2000(A)	;Convert MFD index to block #.
	ASH J,-1
	ADD J,NUDS
	MOVEM J,UFDTA

TOLDUR:	MOVE B,MHFN1		; UFD (new or old) is now in core.
	MOVE C,MHFN2		;See if the file is already extant.
	MOVE A,NUSRD+UDNAMP	;Get name area ptr.
	SETZM IBLK		;Starting with block zero.
TULKP:	CAIL A,2000		; Loop looking for file.
	 JRST TNEWF		; If you get to the end, file is new.
	MOVSI T,UNCDEL		;Else check old file status.
	TDNE T,NUSRD+UNRNDM(A)	;Delete when closed?
	 JRST TULKD
	SKIPN T,NUSRD+UNFN1(A)
	 JRST TULKZ
	CAME B,T		;FN1 on tape the same?
	 JRST TULKL		; No, keep searching for file.
	CAMN C,NUSRD+UNFN2(A)	;If tape FN2 the same
	 JRST TOLDF		; we have found an old file.
TULKL:	ADDI A,LUNBLK		;Else try next file.
	JRST TULKP		;Keep looking.

TULKZ:	SKIPN NUSRD+UNFN2(A)
TULKD:	 MOVEM A,IBLK		; IBLK: index of empty space in UFD
	JRST TULKL		;Keep looking.

TOLDF:	TYPE LPT,"exists~%"
TIGNF:	CALL IGFIL
	JRST TNAML

IGFIL2:	MOVE A,[-2000,,FDBUF]	;Ignore block.
	CALL MREAD		;Read next from tape.
IGFIL:	SKIPN EOUF
	 JRST IGFIL2
	SETZM EOUF
	RET

TNEWF:	SKIPE A,IBLK
	 JRST TNEWCK
	MOVNI A,LUNBLK
	ADDB A,NUSRD+UDNAMP
TNEWCR:	MOVE T,NUSRD+UDESCP
	IDIVI T,6
	CAIL T,-UDDESC(A)
	 HALT .
	MOVEM B,NUSRD+UNFN1(A)
	MOVEM C,NUSRD+UNFN2(A)
DC,	MOVEM B,WXWDS+XWFN1
DC,	MOVEM C,WXWDS+XWFN2
	MOVE B,NUSRD+UDNAME
DC,	MOVEM B,WXWDS+XWSYSN
DC,	SETZM WXWDS+XWBWC
	SETZI B,
	SKIPE LNKFLG
	 MOVSI B,UNLINK
	MOVEM B,NUSRD+UNRNDM(A)
	MOVE B,NUSRD+UDESCP
	DPB B,[UNDSCP NUSRD+UNRNDM(A)]
	MOVE B,MHDATE
	MOVEM B,NUSRD+UNDATE(A)	; Set creation date
	MOVE B,MHRDAT		; Reference date and byte info from tape
	TRO B,777000		; Unknown author
	MOVEM B,NUSRD+UNREF(A)
	MOVE B,TUT+QPKNUM
	DPB B,[UNPKN NUSRD+UNRNDM(A)]
	MOVEI A,NUSRD+UNRNDM(A)
	HRLI A,(UNWRDC)
	MOVEM A,TRNDEP		;DPB WC OF LAST BLOCK LATER
	SETZM CBYT
	SETZM OBLKS
	SETZM IBLK
	SETZM LBLK
	SKIPE LNKFLG
	 JRST TRNLNK		;JUMP IF APPENDING LINK
TBLKL:
TBLKL1:	MOVE A,[-2000,,FDBUF]
	CALL MAGRD
	JUMPE T,TBLKL2
DC,	DPB T,[XWAWC WXWDS+XWBWC]
	DPB T,TRNDEP		;STORE WORD COUNT IN DIRECTORY
	MOVE T,LBLK
DC,	DPB T,[XWBLK WXWDS+XWBWC]
	AOS IBLK
	CALL WRBLK
TBLKL2:	SKIPN EOUF
	 JRST TBLKL
	SETZM EOUF
	JRST TBDON

TNEWCK:	SKIPN NUSRD+UNFN1(A)
	SKIPE NUSRD+UNFN2(A)
	 HALT .
	JRST TNEWCR

TBDON:	MOVEI D,NUSRD
	CALL EBYT
	MOVEI J,UDWPH
	SKIPN LBLK
	 CALL BYDEP
TBDON1:	MOVEI J,0
	MOVEI D,NUSRD
	CALL BYDEP
TMDON:	MOVE J,[WXWDS,,WXWDS+1]
	SETZM WXWDS
	BLT J,WXWDS+3
	MOVE A,TUT+QTUTP
	IDIVI A,NBLKSC
	IMULI A,NBLKSC
	MOVEM A,TUT+QTUTP
	MOVEI A,TUT
	MOVE I,TOU
	CALL WRTUT
	MOVEI I,0
TMDON2:	SKIPL QACT(I)
	 JRST TMDON1
	MOVE J,MFDBK
	MOVEI A,MFD
	CALL WRITE
	MOVE J,UFDTA
	MOVEI A,NUSRD
	CALL WRITE
TMDON1:	CAIGE I,NUNITS-1
	 AOJA I,TMDON2
	SKIPN FERRS
	 TYPE LPT,"OK~%"
	JRST TNAML

TRNLNK:	MOVE A,LNKSNM
	CALL TRNLK1
	MOVE A,LNKNM1
	CALL TRNLK1
	MOVE A,LNKNM2
	CALL TRNLK1
	JRST TBDON1

TRNLK1:	MOVE K,A
	MOVEI A,6
TRNLK2:	MOVEI J,0
	LSHC J,6
	JUMPE J,TRNLK4
	CAIE J,':	
	CAIN J,';
	 JRST [	PUSH P,J
		MOVEI J,':
		MOVEI D,NUSRD
		CALL BYDEP
		POP P,J
		JRST .+1 ]
	MOVEI D,NUSRD
	CALL BYDEP
	SOJG A,TRNLK2
	RET

TRNLK4:	MOVEI J,';
	MOVEI D,NUSRD
	JRST BYDEP

WRBLK:	MOVE J,TUT+QTUTP
	AOS TUT+QTUTP
	CAML J,TUT+QLASTB
	 JRST WRLUZ
	MOVEM J,LBLK
	SETZM TUTLUZ
	MOVEI B,TUT
	CALL TUTPNT
	LDB B,J
	JUMPN B,WRBLK
	MOVEI B,1
	DPB B,J
	MOVE J,LBLK
	MOVEI A,FDBUF
	CALL WRITT
	SUB J,OBLKS
	ADDM J,OBLKS
	MOVEI D,NUSRD
	CAIN J,1
	 JRST WRBC
	CALL EBYT
	CAIG J,UDWPH-UDTKMX
	 JRST WRBS
	MOVE J,OBLKS
	LSHC J,-NXLBYT*6
	MOVEI U,NXLBYT+1
	ADDI J,UDWPH+1
	MOVEI D,NUSRD
WRBL:	CALL BYDEP
	LSHC J,6
	SOJG U,WRBL
	RET

WRLUZ:	SETCMB J,TUTLUZ
	JUMPE J,[ LOSE "~&Disk Full" ]
	MOVE J,TUT+QSWAPA
	CAMGE J,TUT+QFRSTB
	 MOVE J,TUT+QFRSTB
	MOVEM J,TUT+QTUTP
	JRST WRBLK


MAGOP:	AOSE ITAPE
	 JRST MTR1
	HRROI A,MAGHD
	CALL MREAD
	JUMPE T,MBDTHD		; EOT?
	MOVE A,MAGHD
	TRNE A,-1
	 JRST MBDTHD		; Bad tape header
	CAMGE A,[-LTHBLK,,]
	 JRST MBDTHD		; Tape header too long
	ADD A,[1,,THBLK+1]
	CALL MREAD
	JUMPL A,MBDTHD		; Tape header isn't all there
	HLRZ A,THTPN
	TYPE T,"~&Tape #~D",[A]
MTR1:	HRROI A,MAGHD
	CALL MREAD
	JUMPE T,CPOPJ		;EOF
	MOVE A,MAGHD
	TRNE A,-1
	 JRST MBADHD		; Bad header
	CAMGE A,[-LMHBLK,,0]
	 JRST MBADHD		; Header too long
	CAMLE A,[-LMHBKZ,,0]
	 JRST MBADHD		; Header too short
	SETZM MHPKN		; Default to pack 0
	SETOM MHDATE		; Unknown creation date
	HRROI T,777000		; Unknown reference date and author
	MOVEM T,MHRDAT		; 36. bit bytes
	SETOM MHLEN		; Unknown length
	ADD A,[1,,MHBLK+1]
	CALL MREAD
	JUMPL A,MBADHD		; Header isn't all there
	MOVNS MHLEN		; For MAGRD (see below...)
	SETZM LNKFLG
	HLRZ B,MHPKN
	JUMPE B,POPJ1		;NOT A LINK
	SETOM LNKFLG
	MOVE A,[-3,,LNKNM1]	;READ LINK INFO
	CALL MAGRD
	CAIE T,3
	 JRST MBDLNK
	AOS (P)			; Skip return
	JRST IGFIL		; after throwing away any extra words

MBDLNK:	TYPE LPT,"~&Bad Link~%"
	CALL IGFIL
	JRST MTR1

MBADHD:	TYPE LPT,"~&Bad Header~%"
	CALL IGFIL
	JRST MTR1

MBDTHD:	LOSE "Bad tape header"
];TMXX
];NTS

; Like MREAD, but respect length in MHLEN.
; MAGOP sets MHLEN to 1 if the length is implicit, else it sets it to
; minus the number of words that are -supposed- to follow on the tape.
; Extra words must be discarded.  EOUF must be maintained.  A and T must
; be corrected.
MAGRD:	SKIPLE MHLEN
	 JRST MREAD		; Length is implicit on the tape.
	CALL MREAD
	ADDM T,MHLEN
	SKIPLE MHLEN		; Words to be discarded?
	 JRST MAGRD1		; Go flush 'em
	SKIPE EOUF		; If EOF seen
	 SKIPL MHLEN		; and still expecting more data...
	  RET
	TYPE LPT,"~&File ~S;~S ~S too short on tape -- ~
		it will be truncated.~%",[MHSNM,MHFN1,MHFN2]
	RET

.VECTOR MGARB(LMGARB==:40)	; A place to read garbage into

MAGRD1:	SUB T,MHLEN		; Correct T
	HRLS MHLEN
	SUB A,MHLEN		; Correct A
	SETZM MHLEN		; Just for consistency...
MAGRD2:	SKIPE EOUF		; So, was that EOF?
	 RET			; Yes, return
	PUSHER P,[A,T]
	MOVE A,[-LMGARB,,MGARB]
	CALL MREAD		; No, keep reading until it happens
	POPPER P,[T,A]
	JRST MAGRD2

SUBTTL	Create User Directory

NEWUFD:	JSR INIT
	MOVE I,MDSK		;Reset the MFD "master" disk.
	CALL RESET
	MOVEI A,MFD		;MFD lives here in core.
	MOVE J,MFDBK		;Here on the disk.
	CALL READ		;Read MFD into core.
	JUMPL T,ACTUE3
	TYPE T,"~&User? "
	CALL 6TYI		;B gets sixbit new UFD name.
	MOVEI C,NUSRD		;Will build UFD here in core.
	CALL UFDLUK		;Find UFD on disk.
	 CAIA
	  LOSE "~&~S - User File Directory Already Exists.",[B]
	MOVE T,[NUSRD,,NUSRD+1]	;Make an empty UFD in core.
	SETZM NUSRD
	BLT T,NUSRD+1777	;Zap.
	MOVEM B,NUSRD+UDNAME	;Put UFD name into UFD.
	MOVEI Q,2000		;Initialize UFD's name area ptr.
	MOVEM Q,NUSRD+UDNAMP
	MOVE Q,MFD+MDNAMP	;Search the MFD for a free slot.
NEWUF1:	CAIL Q,2000		;Search for a free slot.
	 JRST NEWUF3
	SKIPE MFD+MNUNAM(Q)	;Occupied?
	 JRST [	ADDI Q,LMNBLK	; Yes, try next slot.
		JRST NEWUF1 ]	; Loop for all names.
	CALL UFDADR
	JRST NEWUF2

NEWUF3:	MOVE Q,MFD+MDNAMP
	SUBI Q,LMNBLK
	CALL UFDADR
	MOVEM Q,MFD+MDNAMP
NEWUF2:	MOVEM B,MFD+MNUNAM(Q)	;Insert UFD into MFD here.
	AOS MFD+MDNUM		; What the heck...
	MOVE C,J		; C: remember UFD block number
	MOVEI I,0
NEWUF8:	SKIPN QACT(I)
	 JRST NEWUF9
	MOVE J,C
	MOVEI A,NUSRD
	CALL WRITE
	MOVE J,MFDBK
	MOVEI A,MFD
	CALL WRITE
NEWUF9:	CAIGE I,NUNITS-1
	 AOJA I,NEWUF8
	PUNT

;;; Convert MFD offset in Q into UFD block number in J.
UFDADR:	HRREI J,-2000(Q)
	ASH J,-1
	ADD J,NUDS
KA,	SKIPGE J		; Ensure UFD fits.
KL,	CAIGE J,2		; On KL and KS avoid magic 'HOM' sectors.
KS,	CAIGE J,2
	 LOSE "~&M.F.D. FULL"
	RET

SUBTTL	Additional Randomness
		    
;;; UFDLUK - Lookup up a UFD.
;;; A/ ptr to MFD already in core
;;; B/ UFD in sixbit
;;; C/ ptr to read in UFD
;;; UDSK/ disk to get UFDs from.
;;;
;;; Skips if UFD found; Errs if directory garbaged or disk problems.
;;; Non-skip means UFD does not exist.
;;; Returns D/ MFD index  and  DBLK/ UFD block

UFDLUK:	PUSHER P,[A,B,C,I,Q]
	MOVE A,MFD+MDCHK	;Get check word.
	CAME A,MFDCHK		;OK?
	 LOSE "~&MFD check word garbaged"
	MOVE A,MFD+MDNUDS	;Check NUDSLs.
	CAME A,NUDS
	 LOSE "~&Wrong NUDSL:  ~D.",[A]
	MOVE Q,MFD+MDNAMP	;First UFD from MFD name area.
	ADDI Q,MFD		;De-relativized.
	SETZ D,			;MFD index of user directory.
UFDL10:	CAIL Q,MFD+2000		;If past name area
	 JRST UFDL90		; UFD not found
	CAMN B,MNUNAM(Q)	;When we find the UFD
	 JRST UFDL20		; go hack it.
	ADDI Q,LMNBLK		;Check next name in MFD.
	AOS D
	JRST UFDL10		;Loop for all names.

UFDL20:	HRREI J,-MFD-2000(Q)
	ASH J,-1
	ADD J,NUDS
	MOVEM J,DBLK		;Remember directory block.
	MOVE I,UDSK		;UFDs come from this disk.
	SKIPN QACT(I)		;If the disk is not active
	 LOSE "~&UFD disk ~D not active",[I]
	MOVE A,C		;Going into here.
	MOVEM B,USRNAM		;Remember who we're hacking.
	CALL READ		;Read the UFD.
	JUMPL T,[LOSE "~&UFD Read Error"]
	MOVE A,(C)UDNAME	;All disks should have same UFD here.
	CAME A,B
	 LOSE "~&UFD on disk unit ~D is ~S, not ~S.",[I,A,B]
	AOS -5(P)
UFDL90:	POPPER P,[Q,I,C,B,A]
	RET



;;; FILLUK - Look Up File in UFD
;;; A/ ptr to UFD in core
;;; B/ FN1
;;; C/ FN2
;;;
;;; Looks for the best slot in the UFD for the named file.
;;; Non-skip means file does not exist and the UFD is full.
;;; Returns in Q/ core ptr into UFD name area.

FILLUK:	MOVE Q,UDNAMP(A)
	ADDI Q,(A)		;Get absolute UFD name area ptr.
	SETZI TT,		; TT: best slot so far or 0 if none.
FILLU1:	CAIL Q,2000(A)		;If past name area
	 JRST FILLU3		; Search failed.
	MOVSI T,UNCDEL		;Check file status.
	TDNE T,UNRNDM(Q)	;Delete when closed?
	 MOVEM Q,TT		; Possible slot to use.
	SKIPN UNFN1(Q)		;There is an  FN1.
	 JRST [	SKIPN UNFN2(Q)	; Is there an FN2?
		 MOVEM Q,TT	;  No, but bogus slots are possibilities.
		JRST FILLU2 ]	;Keep checking files.
	CAME B,UNFN1(Q)		;FN1 matches
	 JRST FILLU2
	CAMN C,UNFN2(Q)		;FN2 matches also!
	 JRST POPJ1		; We found it, so skip. 
FILLU2:	ADDI Q,LUNBLK		;Else try next file.
	JRST FILLU1		;Keep looking.

FILLU3:	SKIPE Q,TT		; Found one?
	 JRST POPJ1		; Yes: skip return it.
	MOVE Q,UDNAMP(A)
	SUBI Q,LUNBLK		; Q: new candidate
	MOVE T,UDESCP(A)
	IDIVI T,UFDBPW
	CAIL T,-UDDESC-7(Q)	; Plenty of room between descriptors and names?
	 RET			; Nope: don't skip
	MOVEM Q,UDNAMP(A)	; OK, allocate it
	ADDI Q,(A)		; and return pointer to entry
	JRST POPJ1

;;; QFOWRT - Open a file for writing
;;;  A/ FN1
;;;  B/ FN2
;;;  C/ Pointer to UFD
;;;  I/ disk unit (TUT must be set up)
;;;  Q/ UFD name area core ptr to file

QFOWRT:	MOVEM A,UNFN1(Q)	;Set FN1.
	MOVEM B,UNFN2(Q)	;Set FN2.
	SETZM UNRNDM(Q)
	SETOM UNDATE(Q)		; Unknown creation date
	HRROI TT,777000		; Unknown reference date
	MOVEM TT,UNREF(Q)	; Unknown author, 36. bit bytes
	MOVE TT,UDESCP(C)	; Get descriptor pointer from UDF
	DPB TT,[UNDSCP+UNRNDM(Q)]	; Store it.
	MOVE TT,TUT+QPKNUM	;Get pack number from TUT.
	DPB TT,[UNPKN+UNRNDM(Q)]	;Set file pack #.
	MOVEI TT,UNRNDM(Q)	;Make BP to word count last block (mod 2000).
	HRLI TT,(UNWRDC)
	MOVEM TT,TRNDEP		; Save it for later.
	RET

TRNDEP:	0
CBYT:	0
OBLKS:	0
IBLK:	0
TUTLUZ:	0

;;; QFWRBK - Write a Block to Disk
;;; D/ core ptr to UFD
;;; Writes FDBUF onto next free block and updates the TUT.
;;; Smashes J.
;;; Skips unless disk full.

QFWRBK:	PUSHER P,[A,B,J,U]
QFWRB1:	MOVE J,TUT+QTUTP	;Get free space pointer.
	AOS TUT+QTUTP		;Gobble a block.
	CAML J,TUT+QLASTB	;If we are at the last block
	 JRST [	SETCMB J,TUTLUZ
		JUMPE J,QFWRB9
		MOVE J,TUT+QSWAPA
		CAMGE J,TUT+QFRSTB
		 MOVE J,TUT+QFRSTB
		MOVEM J,TUT+QTUTP
		JRST QFWRB1 ]
	MOVEM J,LBLK		;Else use this block.
	SETZM TUTLUZ		;TUT not lost.
	MOVEI B,TUT
	CALL TUTPNT		;Get Bp into TUT.
	LDB B,J			;Get usage count of block.
	JUMPN B,QFWRB1		;Should be free.
	MOVEI B,1		;Say block gobbled once.
	DPB B,J
	MOVE J,LBLK		;Get block to write.
	MOVEI A,FDBUF		;Data from buffer.
	CALL WRITT		;Write it out.
	SUB J,OBLKS		;Count block output.
	ADDM J,OBLKS
	CAIN J,1		;Update count and pointers in UFD.
	 JRST [	CALL WRBC
		JRST QFWRB8 ]
	CALL EBYT
	CAIG J,UDWPH-UDTKMX
	 JRST [ CALL WRBS
		JRST QFWRB8 ]
	MOVE J,OBLKS
	LSHC J,-NXLBYT*6
	MOVEI U,NXLBYT+1
	ADDI J,UDWPH+1
QFWRB2:	CALL BYDEP
	LSHC J,6
	SOJG U,QFWRB2
QFWRB8:	AOS -4(P)
QFWRB9:	POPPER P,[K,J,B,A]
	RET


;;; QFWDON - Finish File Output
;;; Completes update of UFD, updates and writes out TUT.
;;; Writes new MFD and UFD on each active disk.
;;;
;;;  D/ core ptr to UFD.
;;; Skips on success.

QFWDON:	PUSHER P,[A,B,J,I]
	CALL EBYT		;Finish updating UFD.
	MOVEI J,UDWPH
	SKIPN LBLK
	 CALL BYDEP
QFWDO1:	MOVEI J,0
	CALL BYDEP
	MOVE J,[WXWDS,,WXWDS+1]	;Zap the extra words.
	SETZM WXWDS
	BLT J,WXWDS+3
	MOVE A,TUT+QTUTP	;Get free pointer.
	IDIVI A,NBLKSC
	IMULI A,NBLKSC
	MOVEM A,TUT+QTUTP
	MOVEI A,TUT
	MOVE I,TOU
	CALL WRTUT		;Update TUT to disk.
	MOVEI I,0		;Gonna write new directories to all disks.
QFWDO2:	SKIPN QACT(I)		;This disk online?
	 JRST QFWDO3		; no, 
	MOVE J,MFDBK
	MOVEI A,MFD
	CALL WRITE		;Write out MFD.
	MOVE J,DBLK
	MOVE A,D
	CALL WRITE		;Write out UFD.
QFWDO3:	CAIGE I,NUNITS-1	;Loop for all units.
	 AOJA I,QFWDO2
	SKIPN FERRS		;If no errors
	 AOS -4(P)		; Skipwin.
	POPPER P,[I,J,B,A]
	RET

;;; WRBS, BYDEP, WRBC, EBYT - File pointer hackery.
;;;  D/ Pointer to UFD
;;;  J/ byte to hack into it
;;; Smashes args and CBYT!

WRBS:	ADDI J,UDTKMX-1		;Hack take-n codes.
BYDEP:	MOVE T,UDESCP(D)	;Get ptr to desc area.
	AOS UDESCP(D)		;Advance it.
	IDIVI T,UFDBYT		;Find # UFD bytes in.
	ADDI T,UDDESC		;Compute new desc area byte.
	CAML T,UDNAMP(D)	;See if desc in range.
	 LOSE "~&UFD descriptors won't fit."
	ADD T,D
	HLL T,QBTBL(TT)		;Make bp to desc.
	DPB J,T			;Update the UFD.
	RET

WRBC:	AOS J,CBYT
	CAIGE J,UDTKMX
	 RET
EBYT:	PUSH P,J
	SKIPN J,CBYT
	 JRST POPJJ
	CALL BYDEP
	SETZM CBYT
POPJJ:	POP P,J
	RET


SUBTTL	Chaosnet File Downloading

NTS,[
KS,[
IFN CHAOSP,[

RFBLK::	;; Remote filenames
RFDEV:	SIXBIT /DSK/
RFFN1:	SIXBIT /.BAR./
RFFN2:	SIXBIT /(BAZ)/
RFSNM:	SIXBIT /FOO/

LFBLK::	;; Local filenames
LFDEV:	SIXBIT /DSK/
LFFN1:	0
LFFN2:	0
LFSNM:	SIXBIT /FOO/

;;; CTRAN - Chaosnet Transport Files Onto Disk 

CTRAN:	JSR INIT		;Reset the world.
	TYPE T,"~&Remote filename:"
	MOVEI B,RFBLK
	CALL RFNAME
	MOVE TT,RFFN1
	MOVEM TT,LFFN1
	MOVE TT,RFFN2
	MOVEM TT,LFFN2
	TYPE T,"~&Local filename:"
	MOVEI B,LFBLK
	CALL RFNAME		;Get filename.
	MOVSI TT,(SIXBIT /DSK/)
	CAME TT,LFDEV
EBDFN:	 LOSE "~&Bad local filename:  ~F",[B]
	MOVSI TT,(SIXBIT />/)
	CAME TT,LFFN1
	 CAMN TT,LFFN2
	  JRST EBDFN
	MOVSI TT,(SIXBIT /</)
	CAME TT,LFFN1
	 CAMN TT,LFFN2
	  JRST EBDFN
	MOVE A,CRHOST		;Announce the server network host.
	TYPE T,"~&Copy from host #~O onto unit #",[A]
	CALL NTYI		;Get the disk unit.
	MOVE I,A
	CAIL I,NUNITS		;Make sure disk exists.
	 LOSE "~&No such disk."
	SKIPN QACT(I)		;Make sure it is active.
	 LOSE "~&Disk not active."
	MOVEM I,TOU		;Remember it's TO disk.
	CALL RESET		;Reset the disk.
	MOVEI A,TUT
	CALL RDTUT		;Read in TUT.
	JUMPL T,ACTUE1
	MOVEI A,MFD
	MOVE J,MFDBK
	CALL READ		;Read in MFD.
	JUMPL T,ACTUE3
	MOVE B,LFSNM
	MOVEI C,OUSRD
 	CALL UFDLUK		;Find and read in UFD.
	 LOSE "~&~S - Non-Existant Directory",[B]
	MOVE B,LFFN1
	MOVE C,LFFN2
	MOVEI A,OUSRD
	CALL FILLUK		;Search for file name slot.
	 LOSE "~&~S - Directory Full",[LFSNM]
	MOVE A,LFFN1
	MOVE B,LFFN2
	MOVEI C,OUSRD
	MOVE I,TOU
	CALL QFOWRT		;Open file for writing, E has disk ptr.
	MOVE A,RFDEV
	MOVE B,RFSNM
	MOVE C,RFFN1
	MOVE D,RFFN2
	CALL CHOPEN		;Open file over MINI36 Chaosnet conn.
	SETZM CBYT		
	SETZM IBLK		;No blocks input yet.
	SETZM OBLKS		;No blocks output yet.
	SETZM LBLK		;Not hacking any block yet.
CTRA10:	MOVE B,[-PG$SIZ,,FDBUF]
	MOVE A,B		;AOBJN to file data buffer.
	CALL CHREAD		;Read in over Chaosnet.
	SUB A,B			;Find how much xfrd.
	HLRZ A,A		;# wds in A.
	JUMPE A,CTRA20
	DPB A,TRNDEP		;Count words in UFD.
	AOS IBLK		;Count an input block.
	MOVEI D,OUSRD		;UFD to update.
	CALL QFWRBK		;Write out file block, update UFD ptrs.
	 LOSE "~&Disk Full"
	CAIN A,PG$SIZ		;If xfered whole block
	 JRST CTRA10		;Get another block.
CTRA20:	MOVEI D,OUSRD		;UFD to update.
	CALL QFWDON		;Finally update UFD, MFD, and TUT.
	 TYPE T,"~&~D disk errors.",[FERRS]
	TYPE T,"~&Done."
	PUNT


;;; Chaosnet hardware and software definitions.

.INSRT SYSTEM;KSNET
.INSRT SYSTEM;CHSDEF

IF2, INFORM Chaosnet User ,\LHOST ,  MINI36 Server at ,\RHOST  ,\GWHOST

.VECTOR CHFNM(4)		;Name of file to download.

CLHOST:	LHOST			;Local host number (for patching)
CRHOST:	RHOST			;Remote host number (for patching)
CGWHOS:	GWHOST			;Gateway host number (for patching)
XPKT:	BLOCK %CPMXW		;Transmit packet buffer
RPKT:	BLOCK %CPMXW+2		;Receive packet buffer
FRNADR:	<.BYTE 16. ? RHOST ? 0>	;Foreign host and index
LCLADR:	<.BYTE 16. ? LHOST ? 5>	;Local host and index
XMTNUM:	0			;Last packet out
RCVNUM:	0			;Last packet in
CHRBYP:	0			;Byte pointer to available data
CHRBYC:	0			;Count of available 16-bit bytes


;;; Open connection, file name in A-D (DEV, SNM, FN1, FN2)

CHOPEN:	MOVE T,[A,,CHFNM]	;Save sixbit file name
	BLT T,CHFNM+3
	MOVE T,CLHOST		;Initialize
	DPB T,[242000,,LCLADR]
	MOVE T,CRHOST
	DPB T,[242000,,FRNADR]
	LDB T,[042000,,LCLADR]	;Uniquize
	ADDI T,1
	TRNN T,177777
	 ADDI T,1
	DPB T,[042000,,LCLADR]
	SETZM XMTNUM		;Start with packet 1
	SETZM CHRBYC		;No data available yet
	MOVEI A,%CORFC
	MOVEI C,6
	CALL INIPKT
	MOVE A,[440700,,[ASCII/IMIN63/]]	;Contact name byte swapped
	HRLI B,440800
	ILDB T,A
	IDPB T,B
	SOJG C,.-2
CHOPN1:	CALL CHSIO0		;Transmit this packet and get a response
	CAIE A,%COOPN		;Look for an OPN response
	 JRST CHOPN1		;Ignore anything else
	MOVE T,%CPKS+RPKT	;Save foreign address
	MOVEM T,FRNADR
	LDB T,[$CPKPN RPKT]	;Save packet number
	MOVEM T,RCVNUM
CHOPN2:	CALL CHOSTS		;Tell him our window size
	CALL CHSXMT
	MOVEI A,%CODWD		;Send file name desired
	MOVEI C,24.
	CALL INIPKT
	MOVE A,[441400,,CHFNM]	;Send those 12-bit bytes
	MOVEI C,12.
	ILDB T,A
	IDPB T,B
	SOJG C,.-2
	CALL CHSIO0		;Transmit this packet and get a response	
	CAIN A,%COSTS		;Wait until a STS comes back
	 RET
	SOS XMTNUM		;Send file name with same pkt# as before
	JRST CHOPN2		;Try again, maybe our STS was lost

;;; Get data from connection
;;; A is aobjn pointer to buffer to fill in, it gets advanced
;;; This is like .IOT on a .BII channel in ITS.

CHREAD:	PUSH P,B
	PUSH P,C
CHRD1:	JUMPGE A,CHRD6		;Buffer filled, we're done
	SKIPE C,CHRBYC		;Data left from last time?
	 JRST CHRD3		;Yes, use it
	PUSH P,A		;No, need another packet
CHRD2:	CALL CHSIO
	CAIE A,%CODWD		;Data?
	 JRST [	CAIE A,%COEOF	;Not data
		 LOSE "Connection dead?  Bad packet received, opcode ~O",[A]
		JRST CHRD5 ]	;End of file
	JUMPE C,CHRD2		;Packet empty
	MOVEM B,CHRBYP
	MOVEM C,CHRBYC
	CALL CHOSTS		;Acknowledge what we just received
	POP P,A
	JRST CHRD1

CHRD3:	HLRO T,A		;Get space left in buffer
	MOVNS T
	IMULI T,3		;12-bit bytes
	CAMLE C,T
	 MOVE C,T		;C is number of bytes to do
	MOVE B,A		;Where to store
	HRLI B,441400
	MOVN T,C
	ADDM T,CHRBYC		;Number of bytes left for next time
	MOVE T,C
	IDIVI T,3		;Words!
	HRL T,T
	ADD A,T			;Advance AOBJN pointer
CHRD4:	ILDB T,CHRBYP		;Copy bytes into caller's buffer
	IDPB T,B
	SOJG C,CHRD4
	JRST CHRD1		;Okay, now what

CHRD5:	POP P,A
CHRD6:	POP P,C
	POP P,B
	RET

;;; Initialize packet, opcode in A, length in C
;;; Returns with B byte pointer to 16-bit data

INIPKT:	SETZM XPKT
	MOVE T,[XPKT,,XPKT+1]	;Make sure all unused bits cleared
	BLT T,XPKT+%CPMXW-1
	DPB A,[$CPKOP XPKT]	;Fill in packet header
	DPB C,[$CPKNB XPKT]
	MOVE T,FRNADR
	MOVEM T,%CPKD+XPKT
	MOVE T,LCLADR
	MOVEM T,%CPKS+XPKT
	AOS T,XMTNUM		;Next packet out
	DPB T,[$CPKPN XPKT]
	MOVE T,RCVNUM		;Acknowledge last packet in
	DPB T,[$CPKAN XPKT]
	MOVE B,[442000,,%CPKDT+XPKT]
	RET

;;; Send STS packet

CHOSTS:	MOVEI A,%COSTS		;Acknowledge that
	MOVEI C,4
	SOS XMTNUM		;Doesn't count
	CALL INIPKT
	MOVE T,RCVNUM		;Receipt
	IDPB T,B
	MOVEI T,1		;Window size
	IDPB T,B
	RET

;;; Keep transmitting packet in XPKT until valid packet
;;; returned in RPKT.  A opcode, B byte pointer, C byte count
;;; 16-bit bytes

CHSIO:	CALL CHSIO0
	CAIE A,%COSNS		;Ignore SNS and STS
	 CAIN A,%COSTS
	  JRST CHSIO
	MOVE T,%CPKS+RPKT	;Make sure packet is from right source
	CAME T,FRNADR
	 JRST CHSIO		;Nope, try again
	LDB T,[$CPKPN RPKT]	;Make sure it's right number
	SUBI T,1
	ANDI T,177777
	CAME T,RCVNUM		;Should be 1 + last packet in
	 JRST CHSIO
	LDB T,[$CPKPN RPKT]	;Save packet number
	MOVEM T,RCVNUM
	RET

CHSIO0:	CALL CHSXMT		;Transmit packet
	CALL CHSRCV		;Receive a packet
	 JRST CHSIO0		;Time out, try retransmitting
	MOVE T,%CPKD+RPKT	;Make sure packet is for me
	CAME T,LCLADR
	 JRST CHSIO0		;Nope, try again
	RET

;;; Receive packet into RPKT
;;; Skip if actual packet received
;;; Decode it into A,B,C
CHSRCV:	MOVEI A,50000.		;1/2 second delay
CHSRC0:	MOVEI T,%CARCL		;Enable receiver
	IOWR T,[CAICSR]
CHSRC1:	IORD T,[CAICSR]		;Check for received packet
	TRNN T,%CARDN
	 SOJG A,CHSRC1		;Nothing received yet
	JUMPE A,CPOPJ		;Timed out
	TRNE T,%CAERR
	 JRST CHSRC0		;CRC error, try again
	MOVE B,[442000,,RPKT]
	IORD C,[CAIRBC]		;Number of bits in packet - 1
	ADDI C,1		; including the three extra hardware words
	ASH C,-4		;16-bit word count
	CAIL C,<%CPMXW*2>+3
	 MOVEI C,<%CPMXW*2>+3	;Paranoia
CHSRC2:	IORD T,[CAIRBF]		;Copy out the packet
	IDPB T,B
	SOJG C,CHSRC2
	IORD T,[CAICSR]
	TRNE T,%CAERR		;Make sure it came out of RAM okay
	 JRST CHSRC0		;Garbage, try again
	IORD T,[CAIRBC]		;Make sure counter didn't spazz
	CAIE T,7777
	 JRST CHSRC0
	LDB A,[$CPKOP RPKT]
	LDB C,[$CPKNB RPKT]
	ASH C,-1
	MOVE B,[442000,,%CPKDT+RPKT]
	AOS (P)
	RET

;;; Transmit packet in XPKT
CHSXMT:	PUSH P,B
	PUSH P,C
	MOVEI T,%CATDN		;Reset transmitter
	IOWR T,[CAICSR]
	MOVE B,[442000,,XPKT]
	LDB C,[$CPKNB XPKT]
	ADDI C,<%CPKDT*4>+1
	ASH C,-1		;Number of 16-bit words
CHSXM1:	ILDB T,B
	IOWR T,[CAIWBF]
	SOJG C,CHSXM1
	MOVE T,CGWHOST		;Hardware destination
	IOWR T,[CAIWBF]
	IORD T,[CAIXMT]		;Start transmission
	MOVEI B,50000.		;Wait up to 1/2 second for xmt done
CHSXM2:	IORD T,[CAICSR]
	TRNN T,%CATDN
	 SOJG B,CHSXM2
	POP P,C			;Return regardless of whether it worked
	POP P,B
	RET

];IFN CHAOSP
];KS
];NTS

SUBTTL	Storage

LOC <<.+PG$SIZ-1>/PG$SIZ>*PG$SIZ	;Round up to page boundary

PAT:
PATCH:	BLOCK 400

PDL:	BLOCK PDLLEN

VERSHN:	.FNAM2

GOGOX:	0	;-1 Automatic mode
NOQUES:	0	;-1 Ask no questions (only effective in GOGOX mode)
NOISE:	0	;-1 Make extra noise mode, -2 make even more noise!
HCRASH:	0	;-1 if operating on a crashed pack (do things quickly)
MARKF:	0	;Set when marking a pack (mounted pack has no file system)
ACTIVE:	0	;-1 if already have reset drives
CKFLSW:	0	;-1 if should check all files for clobbered blocks

MDSK:	0	;Disk to get MFD from
UDSK:	0	;Disk to get UFD's from
FROM:	0	;Unit to read from
TOU:	0	;Unit to write to
LBLK:	0	;Disk block number to hack
FMBLK:	0	;From block
TOBLK:	0	;To block
DC,BLK:	0	;Last block read or written from

FERRS:	0	;Transfer error count
CERRS:	0	;Errors corrected by ECC logic
DUPRER:	0	;DUP read error count
DUPWER:	0	;DUP write error count
HARDER:	0	;-1 iff had disk hardware error.

UBSTSP:	0	;Controls whether UBSTS prints invalid UNIBUS maps.
UFDSEE:	0	;Need to print funny looking UFD
XWDSEE:	0	;-1 iff haven't typed "extra" words yet

MFDWRT:	0	;-1 if MFD has changed
TUTDFR:	0	;-1 if TUT has changed
FILEER:	0	;Error in file
UFDLOS:	0	;Some garbage in UFD
GARBF:	0	;Garbage in Free Area
EXGARB:	0	;Extra garbage in UFD
BADFIL:	0	;Blocks in file with retrieval errors
SHARED:	0	;Count of nasty ole' shared blocks.
TUTCHG:	BLOCK TUTMAX*TUTMAX	;Summary of TUT differences.

USRNAM:	0	;M.F.D. usr name
LUFDS:	0
LASTQ:	0	;Storage place for Q
DBLK:	0	;Storage for directory block number
LFILES:	0	;# files in directory
FILEPK:	0	;Pack file is on
FUNIT:	0	;Unit file is on, -1 if pack not mounted
NOTUT:	0	;TUT not active for this file
ADRSET:	0	;File address set
LSTBLK:	0	;Last block storage
LAST:	0	;Last file in UFD
UFDTA:	0	;UFD disk block #.


MFDCHK:	SIXBIT /M.F.D./

;;; QBTBLI is a table of pre-computed byte pointers into the UFD descriptor words.
.SEE UFDBYT
QBTBLI:	440600,,
QBTBL:	360600,,
	300600,,
	220600,,
	140600,,
	60600,,
	600,,

NUDS:	NTS,[NUDSL]+0	;Number of User Directory blockS
SBTAB:	-1	;Special block table.
	-1	;(For Patching)
	-1
	-1
MFDBK:	MFDBLK	;Special reserved blks.
;;; TUT used to be here, but no longer
LSBTAB==.-SBTAB

;;; NTBL is an array indexed by unit giving the number of
;;; blocks in the TUT on that unit.

NTBL:
IFE T300P, REPEAT NUNITS, NTUTBL
IFN T300P,[
	REPEAT T300P, NTUTBL
	REPEAT NUNITS-T300P, NTUTB1
];T300P

RXWDS:	BLOCK 4	;The extra words
	0	;For BLT.
WXWDS:	BLOCK 4


;;; Physical/Virtual unit translation hack.
;;; RH of entry is physical drive.
;;;   "4.9 means second half 
;;;     (No longer does anything, now that Memowrecks have been
;;;     flushed, but keep around in case ever needed again.)"
.SEE QCNVT

QTRAN:	DC,[ 0 ? 1 ? 2 ? 3 ? 4 ? 5 ? 6 ? 7 ]
	.ELSE REPEAT NDRIVE, .RPCNT
IFN .-QTRAN-NUNITS,.ERR BARF AT QTRAN!!

QTTBLI:	REPEAT 36./TUTBYT+1,	440000+TUTBYT_6-TUTBYT_12.*.RPCNT,,
QTTBL=QTTBLI+1

TS,[
NQS:	0	;System's number of drives
SQACT:	0	;Location of QACT in ITS
];TS
	NBLKS-1			;SNBLKS-1
SNBLKS:	NBLKS			;System NBLKS (init'ed in TS)
DRIVE:	REPEAT NDRIVE,-1	;-1 if drive on line
QACT:	REPEAT NUNITS,-1	;-1 if unit active         .SEE ACTUN
QPKN:	REPEAT NUNITS,-1	;Pack # according to TUT   .SEE FINDPK
PKNUM:	BLOCK NUNITS		;Pack # according to hardware

DC,[
RPKID:	0
]

CONS==.
CONSTANTS
VARS==.
VARIABLES

IF2, .CRLF
IF2, SAYSIZ .-VARS,variables
IF2, SAYSIZ VARS-CONS,constants 

LOC <<.+PG$SIZ-1>/PG$SIZ>*PG$SIZ	;Round up to page boundary
IF2, INFORM Buffers begin at ,\.

IRP A,,[OTUT,NTUT]
Q!A!O:	REPEAT NUNITS,CONC A,\.RPCNT,
TERMIN

CYLBUF==:<.+1777>&776000
CYLPAG==:CYLBUF/PG$SIZ
LOC CYLBUF
OUSRD:	BLOCK 2000		;Old UFD
NUSRD:	BLOCK 2000		;New UFD
FDBUF:	BLOCK 2000		;File block buffer
MFD:	BLOCK 2000		;MFD
MAGBUF:	BLOCK 2000		;Magtape buffer
IRPS A,,OTUT NTUT		;Old and New TUTs for each unit:
REPEAT NUNITS,CONC A,\.RPCNT,:	BLOCK 2000*MXTUTB
TERMIN
D0==OTUT0
IFDEF OTUT1,D1==OTUT1
      .ELSE D1: BLOCK 2000*MXTUTB
TUT=NTUT0
DC, CYLSIZ=NBLKSC*2004
RH, CYLSIZ=SECTOR*NHEDS*NSECS
PH, CYLSIZ=NBLKSC*2000
RP, CYLSIZ=NBLKSC*2000
NTS,IFL .-CYLBUF-CYLSIZ,LOC CYLBUF+CYLSIZ

THEEND:

;For KA10s (R.I.P.) we must fit in 128K to avoid hitting possible holes.
;For KL10  there can never be holes in the low 256K anyway.
;For KS10s we will never run the machine with less than 512K anyway.

IF2,[	;; Last gasps...

INFORM Start addr = ,\SA , Highest addr used = ,\THEEND
SAYSIZ .-SA,words long
IFG THEEND-400000, .ERR  Note: Salvager is too moby for 128K

;;; This MUST be last!  Since it makes the symbols in question useless
;;; except for use in DDT:
KL, PAG=<BLKO PAG,>-<BLKO>
KS,[
IRP DEV,,[PAG,.RD.,.WR.]
.TEM.==<BLKO DEV,>-<BLKO>
EXPUNGE DEV
DEV=:.TEM.
TERMIN
] ;KS
] ;IF2

CONSTANTS	;Flush out these guys before following
VARIABLES	;error check...
IFN .-THEEND, .FATAL Cruft after THEEND

END DDT		;Start manually Salvager from DDT.
		;ITS knows about "SA" and starts there.


;;; Local Modes:
;;; Comment Column: 32
;;; Fill Column: 72
;;; End:
