; I T S DISK SERVICE ROUTINES AND FILE SYSTEM  -*-MIDAS-*-
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;; See the COPYING file at the top-level directory of this project.

DSKVRS==.IFNM2
IFN DC10P+RP10P+RH10P+RH11P-1, .ERR WRONG NUMBER OF DISK CONTROLLERS

;GET DISK PHYSICAL PARAMETERS BY .INSRT'ING APPROPRIATE FILE

IFN DC10P,[
$INSRT DC10
]

IFN RP10P,[
$INSRT RP10
]

IFN RH10P,[
$INSRT RH10
]

IFN RH11P,[
$INSRT RH11
IFE KS10P, .ERR RH11 on something other than a KS10?
IFN RP06P+RP07P+RM03P+RM80P-1, .ERR WRONG NUMBER OF KINDS OF DISK DRIVE
IFN RP06P,[
$INSRT RP06
]
IFN RP07P,[
$INSRT RP07
]
IFN RM03P,[
$INSRT RM03
]
IFN RM80P,[
$INSRT RM80
]
]

;GET FILE SYSTEM DEFINITIONS:
;	MFD	MASTER FILE DIRECTORY
;	TUT	TRACK (BLOCK) UTILIZATION TABLE
;	UFD	USER FILE DIRECTORY

$INSRT FSDEFS

IFN T300P,[
$INSRT T300
]

SUBTTL MISC FILE SYSTEM CALLS

ADMPCH:	UMOVE A,(J)	;SET OR READ STATUS OF DUMP BIT OF FILE OPEN ON
			; CHNL IN AC(RH)
	MOVEI T,POPJ1	;MAKE CHNDCD SKIP RETURN IF ALL OK.
	PUSHJ P,CHNDCD	;DECODE RH(A) AS CHNL NUM.
	 JRST ILUUO	;NO SKIP IMPLIES BAD CHNL NUM.
	TLNN R,%CLSQ
	 JRST ILUUO	;NOT DISK CHANNEL.
	PUSHJ P,QCHNLT	;DECODE THE CHNL FURTHER.
	MOVSI B,400000
	TLNE A,400000
	 IORM B,UNRNDM(C)
	TLNE A,200000
	 ANDCAM B,UNRNDM(C)
	MOVE D,QACTB
	TLNE A,600000
	 IORM D,QSNLCN(H)
	LDB A,[430100,,UNRNDM(C)]
	PUSHJ P,QUDULK
	JRST APTUAJ

NRFDATE:	PUSHJ P,QCHNLT	;READ FILE CREATION DATE WORD
	MOVE A,UNDATE(C)
NRDM1:	PUSHJ P,QUDULK
	JRST POPJ1	;STORE BACK IN USER MEM

NSRDATE:	PUSHJ P,QCHNLT	; SET REFERENCE DATE
	HLRS B
	DPB B,[UNREFD+UNREF(C)]
	JRST NSDM1

NRESRDT:	PUSHJ P,QCHNLT	; RESTORE REFERENCE DATE
	HLRZ A,OLDRDT(R)	; WHOEVER CHOSE R IN QCHNLC SHOULD BE SHOT
	DPB A,[UNREFD+UNREF(C)]
	JRST NSDM1

NSFDATE:	PUSHJ P,QCHNLT	;SET FILE CREATION DATE WORD
	MOVEM B,UNDATE(C)
NSDM1:	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
QUDUL1:	AOS (P)
	JRST QUDULK


NRDMPBT:	PUSHJ P,QCHNLT	;READ FILE DUMPED BIT
	LDB A,[430100,,UNRNDM(C)]
	JRST NRDM1

NSDMPBT:	PUSHJ P,QCHNLT	;SET FILE DUMPED BIT
	DPB B,[430100,,UNRNDM(C)]
	JRST NSDM1

NLNKEDP:
	PUSHJ P,QCHNLT		;RETURN NONZERO IF WE TRACED LINKS TO GET THIS FILE.
	MOVE T,QSRAC(R)
	LDB A,[.BP (%QALOP),T]
	JRST NRDM1

NFILBLK:PUSHJ P,QCHNLT	;READ ALL 5 PARAMETERS OF NAME AREA
	MOVE A,(C)
	MOVE B,1(C)
	MOVE D,3(C)
	MOVE E,4(C)
	MOVE C,2(C)
	JRST NRDM1	; UNLOCK DIR AND STORE ARGUMENTS

QCHNLT:	TLNN R,%CLSQ	;IS CHNL A DISK CHNL?
	 JRST [SUB P,[1,,1] ? JRST OPNL34]
	HLRZ R,H
	MOVE H,QUDPR(R)
	PUSHJ P,QUDLK
	MOVE C,QSNLCN(H)
	ADD C,QUDFPR(R)
	POPJ P,

IFN QAUTHP,[
ASAUTH:	PUSHJ P,QCHNLT	;SET AUTHOR OF FILE
	PUSH P,C
	JUMPE B,ASAUT4	;SETTING AUTHOR TO 0
	MOVE J,QSNMI(H)
	CAMN B,QSNUD(H)
	 JRST ASAUT1
	MOVE C,B
	PUSHJ P,QFL
	 SKIPA
	  JRST ASAUT1
	SETZM C
	MOVEI J,5
	MOVE TT,[440600,,B]
	MOVE I,[440600,,C]
	ILDB D,TT
	IDPB D,I
ASAUT2:	ILDB D,TT
	CAIG D,'Z
	CAIGE D,'A
	 JRST ASAUT3
	IDPB D,I
	SOJG J,ASAUT2
	JRST ASAUT4

ASAUT3:	PUSHJ P,QFL
ASAUT4:	 SETOM J
ASAUT1:	POP P,C
	DPB J,[UNAUTH+UNREF(C)]
	JRST NSDM1

ARAUTH:	PUSHJ P,QCHNLT	;READ CREATOR OF FILE
	LDB B,[UNAUTH+UNREF(C)]
	MOVEI A,0	;RETURN VALUE IS 0 IF UNKNOWN OR ILLEGAL AUTHOR
	CAIL B,NUDSL
	 JRST NRDM1
	LSH B,1
	MOVEI B,2000-<NUDSL*2>(B)
	ADD B,QMDRO
	MOVE A,(B)
	JRST NRDM1
];QAUTHP

ASREAP:	PUSHJ P,QCHNLT		;SET NO REAP BIT
	DPB B,[.BP (UNREAP),UNRNDM(C)]
	JRST NSDM1

ARQDAT:	CONO PI,CLKOFF	;GET DSK TIME AND DATE
	SKIPL A,QDATE
	HRR A,TIMOFF
	MOVE B,QDATEI	;2ND VALUE = DATE & TIME SYS CAME UP, IN DISK FORMAT.
	CONO PI,CLKON
	JRST POPJ1

ADSKUP:	PUSHJ P,QCHNLT	;SET CREATION DATE, REF DATE AND CLEAR DUMP BIT
	CONO PI,CLKOFF
	SKIPL TT,QDATE
	 HRR TT,TIMOFF
	CONO PI,CLKON
	MOVEM TT,UNDATE(C)
	HLRS TT
	DPB TT,[UNREFD+UNREF(C)]
	MOVSI TT,UNDUMP
	ANDCAM TT,UNRNDM(C)
	JRST NSDM1

DELEWO:	TLNN R,%CLSQ	;DELETE WHILE OPEN
	 JRST OPNL34	;WRONG TYPE DEVICE
	PUSHJ P,QCHNLT
	PUSH P,W
	PUSH P,C
	MOVEI W,4
	MOVE A,UNFN1(C)	;Get names of file being hacked.
	MOVE B,UNFN2(C)
	MOVE C,QSNUD(H)
	PUSHJ P,MNGDIR	;If this is a sanctified dir
	 PUSHJ P,SYSDSK	; get SYS job to tattle about it.
	POP P,C
	POP P,W
	MOVSI T,%QADEL	;SET DELETE BIT IN QSK CHNL
	IORM T,QSRAC(R)
	MOVSI T,UNCDEL	;AND IN FILE
	IORM T,UNRNDM(C)
	JRST NSDM1

;.CALL FILLEN
;RETURNS (1) FILE LENGTH IN BYTES (BYTE SIZE CURRENTLY OPEN IN)
;	 (2) BITS PER BYTE (BYTE SIZE CURRENTLY OPEN IN)
;	 (3) FILE LENGTH IN BYTES (BYTE SIZE WRITTEN IN)
;	 (4) BITS PER BYTE (BYTE SIZE WRITTEN IN)

NFILLEN:PUSHJ P,QCHNLT
	MOVE A,QSRAC(R)
	TLNE A,%QALNK
	 JRST OPNL34	;NOT A FILE
	SKIPGE QSCRW(R)
	 TLNE A,%QAMWO
	  JRST NFILL1	;READ CHANNEL OR WRITE-OVER, GET FILE'S STORED LENGTH.
	MOVE A,QFBLNO(R);NORMAL WRITE, GET ACCESS POINTER.
	SKIPGE QSMDN(R)
	 JRST NFILL2	;NO BUFFER ACTIVE
	ADD A,QMPBSZ(R)	;END OF CURRENT BUFFER
	SUB A,QSMPRC(R)	;BACK UP TO CURRENT LOC
NFILL2:	PUSHJ P,QUDULK
	LDB B,[QSBSIZ(R)]	;CURRENT BYTE SIZE
	MOVE D,B	;WRITTEN BYTE SIZE SAME AS CURRENT
	MOVE C,A	;WRITTEN LENGTH SAME AS CURRENT
	JRST POPJ1

NFILL1:	LDB TT,[UNDSCP+UNRNDM(C)]
	IDIVI TT,UFDBPW
	HLL TT,QBTBLI(I)	;GET DESCRIPTOR POINTER
	LDB E,[UNWRDC+UNRNDM(C)]
	SKIPN E
	 MOVEI E,2000		;E GETS NUMBER OF WORDS IN LAST BLOCK
	LDB D,[UNBYTE+UNREF(C)]	;D GETS BYTE INFO
	ANDI C,-2000		;C GETS BASE ADDR OF DIR
	ADDI TT,UDDESC(C)	;TT GETS DESC PNTR
	SETOM A			;INITIALIZE NUMBER OF BLOCKS IN FILE
	PUSHJ P,NFLLN1		;A GETS NUMBER OF BLOCKS IN FILE MINUS ONE
	PUSHJ P,QUDULK
	IMULI A,2000		;NUMBER OF WORDS IN COMPLETE BLOCKS
	ADD A,E			;ADD WORDS IN LAST BLOCK
	PUSHJ P,QBDCD		;D GETS BYTE SIZE, E NUMBER OF RESIDUE BYTES
	MOVEI Q,36.
	IDIV Q,D		;Q GETS BYTES PER WORD
	MOVE C,A		;C WRITTEN LENGTH, A CURRENT (B.S. DIFFERENT)
	IMUL C,Q		;CONVERT WORD LENGTH TO BYTES
	SUB C,E			;C NOW HAS CORRECT WRITTEN LENGTH
	IMUL E,D		;E GETS NUMBER OF RESIDUE BITS
	LDB B,[QSBSIZ(R)]	;B GETS BYTE SIZE OPENED IN
	IMULI A,@QSBYTE(R)	;A GETS LENGTH IN THOSE SIZE BYTES
	IDIV E,B		;NUMBER OF RESIDUE BYTES, -ROUNDING DOWN-
	SUB A,E			;ADJUST THE LENGTH
	JRST POPJ1		;RETURN VALUES IN A,B,C,D

NFLLN2:	ADD A,B		; NEXT N BLOCKS
NFLLN1:	ILDB B,TT	; GET NEXT DESC BYTE
	JUMPE B,CPOPJ	; NO MORE
	CAIG B,UDTKMX
	 JRST NFLLN2	; TAKE-N
	CAIGE B,UDWPH
	 AOJA A,NFLLN1	; SKIP-N, TAKE-1
	CAIN B,UDWPH
	 JRST NFLLN1	; IGNORE WRITE-PLACEHOLDER
REPEAT NXLBYT, IBP TT	; LOAD-ADDRESS, TAKE-1
	AOJA A,NFLLN1

;DIRSIZ - READ OR SET DISK QUOTAS, READ # BLOCKS IN ALL FILES IN DIRECTORY.
;1ST VALUE IS GRIM REAP QUOTA,,DIR SIZE
;2ND VALUE IS 0 OR PACK#,,ALLOCATION FOR DIR ALLOCATED TO SPECIFIC PACK
;LH OF 2ND ARG SETS GRIM REAP QUOTA; 3RD ARG SETS PACK#,,ALLOCATION
NDIRSI:	MOVE D,C
	PUSHJ P,QCHNLT
	MOVE C,QSNLCN(H)
	MOVE A,UDBLKS(C)
	JUMPL B,NDIRS1
	CAIE W,1
	 HLLM B,UDBLKS(C)
NDIRS1:	MOVE B,UDALLO(C)
	CAILE W,2
	 MOVEM D,UDALLO(C)
IFN QRSRVP,[
	HLRZS D			;PACK ALLOCATED TO
	SETO E,
	JUMPE D,NDIRS2
	MOVEI E,NQS-1		;UPDATE ALLOC DRIVE NUM
	CAME D,QPKID(E)
	 SOJGE E,.-1
NDIRS2:	MOVEM E,QSALLO(H)
];QRSRVP
	JRST NSDM1

SUBTTL DISK OPEN ROUTINES

%DO==1,,525252	;Special mode bits for disk opens.
%DOWOV==100000	;Write over mode
%DONRF==10	;Don't set ref-date
%DONLK==20	;Don't chase links; actually open the link itself.
%DORWT==40	;Make readers wait (used on opens for write or write-over).

IFN TPLP+UNSPLP,[
TPLO:	MOVE C,[SIXBIT /.LPTR./] ;PSEUDO LINE PRINTER (DISC)
	JUMPGE D,TPLO2
	MOVE B,UNAME(U)
	AOS A,TPLFNO	;GENERATE RANDOM FILE NAME
	JRST TPLO2
]

COMO:	SKIPA C,[SIXBIT /COMMON/]	;.OPEN ENTRY FOR "COM" DEVICE
SYSO:	 MOVSI C,(SIXBIT /SYS/)		; " FOR "SYS" DEVICE
TPLO2:	MOVEM C,USYSN1(U)
	MOVNI I,1
	JRST QSKO

QSKPO:	MOVSI TT,-NQS	;PACK # OPEN
	CAME I,QPKID(TT)
	 AOBJN TT,.-1	;I <= PHYSICAL UNIT WITH SPECIFIED PACK
	JUMPL TT,QSKPO1
	PUSHJ P,QPKNFP
	 JRST QSKPO
	CAIE W,4	;IF RENAME/DELETE, OK, DOESN'T TOUCH FILE ANYWAY
	 JRST OPNL16	;OTHERWISE COMPLAIN PACK NOT MOUNTED
QSKPO1:	HRRZ I,TT
QSKUO:	CAIGE I,NQS	;DISK UNIT # OPEN
	 SKIPE QACT(I)	;I <= UNIT #
	  JRST OPNL10	;BAD UNIT # OR NOT ENGAGED
IFE MCOND DM,[	;; Security check in reserved pack feature only on DM.
IFN QRSRVP,[
	JUMPN W,QSKOB	;WRITE-OVER OR RENAME OK.
	JUMPGE D,QSKOB	;READ OK.
	SKIPE QRESRV(I)	;WRITE: IS PACK ON THIS DRIVE RESERVED?
	 JRST OPNL10	;YES, CAN'T WRITE ON IT.
];QRSRVP
];DM
	JRST QSKOB

;DNRF: DEVICE IS LIKE DSK: BUT DOESN'T SET REFERENCE DATE
DNRFO:	TRO D,%DONRF/2	;SET MODE BIT AND DROP INTO QSKO

; Regular DSK: device
;
; RH(D) has open mode, rotated 1 bit right.
; W has operation code (0=r/w, 2=link, 4=del/rnm, 1=wov)

QSKO:	MOVNI I,1	;DSK OPEN, I <= # DETERMINED BY SYS
QSKOB:	MOVEM I,EPDL(U)	;SAVE DISK #
	MOVE C,USYSN1(U)
	CAIN W,4
	 JUMPE A,QSKOB2	;IF RENAME OF OPEN FILE TRAP OUT
QSKOA:	MOVE I,MDSK	;IS MFD IN?
	PUSHJ P,QMCH1	;READ IN MFD OF MASTER DISK
	CLEARM QLD(U)	;LINK DEPTH
QSKOL:	PUSHJ P,MFDCK
	 JRST SYSDS2
	JUMPN W,OPNL11
	JUMPL D,OPNL11	;MUST BE NORMAL READ
	JRST QMLSTF	;USER WANT TO READ THE MASTER DIRECTORY

MFDCK:	CAMN A,[SIXBIT /M.F.D./]
	CAME B,[SIXBIT /(FILE)/]
	 POPJ P,
	JRST POPJ1

SYSDS2:	PUSHJ P,QFLD	;H <= PTR TO USER DIR TABLE
	 PUSHJ P,QSKO1	;LOSER DIR NOT IN CORE
	SKIPG QSNNR(H)
	 BUG
	PUSHJ P,QUDLK	;RETURN WITH SOS OF QSNNR ON LSWPR
	MOVSI TT,40000
	TDNE TT,QSNLCN(H)
	 JRST QSKDP1	;PAW OVER USER DIRECTORY
QSKDP2:	PUSHJ P,QUDULK
	PUSHJ P,FLDRCK
	 JRST QSKDP9	;NOT SPECIAL DIRECTORY FILE
	JUMPN W,QPNL11
	JUMPL D,QPNL11
	JRST QLISTF	;USER WANTS TO READ HIS USER DIRECTORY

QSKDP9:	JUMPN W,QSKDPY	;If doing IO?
	 SKIPL D	; and reading
	  JRST QSKDPZ	;  then don't bother with "security".
QSKDPY:	PUSHJ P,MNGDIR	;Else if this is a sanctified dir
	 PUSHJ P,SYSDSK	; get SYS job to tattle about it.
QSKDPZ:	JUMPL D,QWRO	;WRITE
	CAIN W,4
	 JRST QRNAM	;RENAME/DEL
	CAIN W,2
	 JRST QALINK	;MAKE LINK
	JUMPN W,QPNL22
QWROR:	JUMPE A,QPNL11	;ALSO ENTER FOR VARIOUS WRITE OVER, COPY OVER MODES
	JUMPE B,QPNL11
	PUSHJ P,QCHNF	;GET CHANNEL FOR READ
	PUSHJ P,LOSSET
	    QCHNRT
	PUSHJ P,QUDLK	;LOCK USER DIR
	PUSHJ P,QLOOK	;LOOK UP FILE
	 JRST [	PUSHJ P,QROR1C	;Not found => decide whethe error or wait.
		 POPJ P,	;Error (error code already set up).
		PUSHJ P,QUDULK	;If retrying, first unlock directory,
		PUSHJ P,LSWPOP	;Return the channel,
		PUSHJ P,UDELAY	;Wait a little while,
		JRST QWROR]	;Try again.
	TRNE D,3	;SKIP IF UNIT ASCII MODE
	 JRST QSKO2
	MOVE J,[440700,,5] ;BYTE SIZE IS 7 BITS
	MOVEM J,QSBYTE(E)
QSKO2:	HLLZ J,QSBYTE(E) ;GET PROPER BYTE POINTER LH
	MOVEM J,QSMPRP(E)
	TRNN D,%DONRF/2	;3.4 BIT IN OPEN IMPLIES DONT SET REFERENCE DATE
	 PUSHJ P,QFREF	;"REFERENCE" FILE
	MOVE C,Q
	SUB C,QSNLCN(H)
	HRRZM C,QUDFPR(E)	;SET UP PTR FROM CHNL TO FILE NAME AREA
	LDB TT,[UNDSCP+UNRNDM(Q)]	;FOUND FILE SET UP CHNL
	MOVEM TT,QDIRP(E)	;SET UP CHAR PTR TO DESC AREA
	MOVE C,UNRNDM(Q)
	TLNE C,UNLINK
	 JRST QLINK	;FILE IS A LINK
	MOVSI C,%QALOP
	SKIPE QLD(U)	;IF WE TRACED A LINK TO OPEN THE FILE, REMEMBER THAT.
	 IORM C,QSRAC(E)
	MOVSI C,%QARWT
	TRNE D,%DORWT/2
	 IORM C,QSRAC(E)
	LDB J,[UNPKN+UNRNDM(Q)]	;GET PACK NUMBER FILE IS ON
	MOVSI I,-NQS
	CAME J,QPKID(I)
	 AOBJN I,.-1	;TRANSLATE LOGICAL TO PHYSICAL DISK UNIT
	JUMPGE I,QPKNF	;PACK NOT ON *
	HRRZM I,QDSKN(E)	;SET CHNL DISK NUMBER
	JUMPL D,QWROR1	;REALLY WANT TO WRITE OVER, ETC
	MOVEI TT,%QMRD	;PUT CHANNEL IN NORMAL READ MODE
	HRRM TT,QSRAC(E)
QOEX1:	PUSHJ P,QUDULK	;UNLOCK USER DIR
	PUSHJ P,LSWDEL	;QUSR ENTRY
	PUSHJ P,LSWDEL	;QSNNR ENTRY
	SKIPG QSNNR(H)
	 BUG
	PUSHJ P,QSTRTR
	MOVE C,D
	ROT C,1
	HRL A,E
	JSP Q,OPSLC7	;SET UP IOCHNM AND DEPART
	    DQUAI,,DQUAO
	    DQBI,,DQBO
	    DQUII,,DQUIO
	    DQBI,,DQBO

QWROR1:	SOJN W,OPNL12	;NORMAL WRITE OVER MODE
	HRRZS H		;CLEAR GARBAGE IN USER DIR NUM
	HRRZS E		;CLEAR GARBAGE IN CHNL NUM
	HRRZ J,QUDFPR(E) ;PICK UP LOCN OF FILE WITH U.F.D
	MOVSI I,-NQCHN	;MAKE SURE THIS FILE NOT OPEN FOR READING
QROR1A:	CAIE E,(I)	;DONT GET FAKED OUT BY OWN CHNL
	 SKIPGE QUSR(I)
	  JRST QROR1B
	CAMN H,QUDPR(I)
	 CAME J,QUDFPR(I)
	  JRST QROR1B
	JRST  OPNL23

QROR1B:	AOBJN I,QROR1A
	PUSHJ P,QAUTH
	MOVSI TT,UNWRIT
	IORM TT,UNRNDM(Q)	;SET WRITE BIT
	MOVSI TT,UNDUMP
	ANDCAM TT,UNRNDM(Q)
	PUSH P,D
	PUSH P,Q
	PUSH P,R
	PUSH P,E	;CONVERT FROM ORIGINAL BYTE SIZE TO ONE OPENED IN NOW
	LDB D,[UNBYTE+UNREF(Q)]
	PUSHJ P,QBDCD	;GET INFO FROM ORIGINAL WRITE OF FILE
	MOVEI Q,36.
	IDIV Q,D	;BYTES PER WORD
	SUB Q,E		;# VALID BYTES
	IMUL Q,D	;VALID BITS IN LAST WORD
	POP P,E		;RESTORE QSK CHNL #
	HRRZ R,QSBYTE(E);BYTES PER WORD IN NEW BYTE SIZE
	LDB J,[QSBSIZ(E)] ;BITS PER BYTE IN NEW BYTE SIZE
	IDIV Q,J	;NUMBER OF NEW-SIZE BYTES IN LAST WORD
	SUB R,Q		;RESIDUE IN NEW-SIZE BYTES
	LDB Q,[QSBSIZ(E)] ;NEW BYTE SIZE
	PUSHJ P,QBENC	;RH(Q) GETS NEW BYTE INFO
	MOVE R,-1(P)
	DPB Q,[UNBYTE+UNREF(R)] ;CLOBBER FILE'S BYTE SIZE
	POP P,R
	POP P,Q
	POP P,D
	CONO PI,CLKOFF
	SKIPL TT,QDATE
	 HRR TT,TIMOFF
	CONO PI,CLKON
	MOVEM TT,UNDATE(Q)
	HLRS TT
	DPB TT,[UNREFD+UNREF(Q)]
	HLLM TT,OLDRDT(E)
	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
	MOVSI TT,%QAMWO		;WRITE OVER MODE
	IORM TT,QSRAC(E)	;LEAVE %QMIDL UNTIL FIRST .IOT SINCE
	JRST QOEX1		; THE USER WILL PROBABLY DO A .ACCESS

;Call here if lookup fails on open.
;Either signal some error and return,
;or skip-return if caller should wait and retry the lookup.
;Assumes H has dir slot, Q has address of filename block,
;E has channel number allocated for this open.
;Clobbers C, J.
QROR1C:	HRRZ C,QSNLCN(H)
	SUBI Q,-LUNBLK(C)
	SKIPL Q		;SEE IF STILL POINTED INSIDE DIR
	CAILE Q,2000-LUNBLK
	 JRST QROR1D	;NO - REALLY FNF
	ADDI Q,(C)
	CAMN A,UNFN1(Q)	;DO NAMES MATCH?
	CAME B,UNFN2(Q)
	 JRST QROR1D	;NO - REALLY FNF
	HRRZ J,Q	;Find channel that has this file open.
	SUB J,QSNLCN(H)
	ANDI J,-1
	HRRZS H		;Clear garbage in user dir num
	HRRZS E		;Clear garbage in chnl num
	MOVSI I,-NQCHN
QROR1E:	CAIE E,(I)	;Dont get faked out by our own chnl.
	 SKIPGE QUSR(I)
	  JRST QROR1F
	CAMN H,QUDPR(I)
	 CAME J,QUDFPR(I)
	  JRST QROR1F
;Found the channel.  Does it want us to wait?
	MOVE I,QSRAC(I)
	TLNN I,%QARWT
	 JRST OPNL23	;He didn't say so => get "file locked".
	JRST POPJ1

QROR1F:	AOBJN I,QROR1E
	JRST POPJ1	;Cannot find channel => maybe was closed.  Retry.

QROR1D:	SKIPN QLD(U)
	 JRST OPNL4	;FILE NOT FOUND
	JRST OPNL47	;LINK WAS FOUND, BUT NOT THE FILE IT POINTED TO

;COME HERE FOR RENAME-WHILE-OPEN
QSKOB2:	HRRZ A,B	;DO RENAME WHILE OPEN HERE TO AVOID
	CAIL A,20	;IN CASE SYS NAME HAS CHANGED
	 JRST OPNL14
	SKIPE SRN3(U)
	 SKIPN SRN4(U)
	  JRST OPNL11
	ADD A,U
	HLRZ E,IOCHNM(A)
	MOVE H,QUDPR(E)
	MOVE A,SRN3(U)
	MOVE B,SRN4(U)
	PUSHJ P,MFDCK
	 JRST .+2
	  JRST QPNL11
	PUSHJ P,FLDRCK
	 JRST .+2
	  JRST QPNL11
	PUSHJ P,QUDLK
	MOVE Q,QUDFPR(E)
	ADD Q,QSNLCN(H)
	PUSHJ P,QGRLSC	;EITHER NAME > OR <?
	 JRST OPNL11	;BOTH-BARF
	  PUSHJ P,QFNG	;ONE- COMPUTE EFFECTIVE FILE NAME
	MOVE C,QSNUD(H)
	PUSHJ P,MNGDIR	;If RENMWOing in sanctified directory
	 PUSHJ P,SYSDSK	; Tattle.
	MOVE I,Q	;IN CASE GO TO QRNAM4
	LDB TT,[$QAMOD,,QSRAC(E)]
	SKIPL QSCRW(E)	;SKIP IF WRITE BLOCK (WRITE FILE) MAYBE 0 FOR WRITEOVER
	 JUMPE TT,QRNAM4	;JUMP IF READ FILE
	PUSHJ P,QRELOC
	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
	PUSHJ P,QUDULK
	JRST POPJ1

SUBTTL PAW OVER USER DIRECTORY

QSKDP1:	ANDCAB TT,QSNLCN(H)
	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,I
	PUSH P,W
	MOVE C,UDNAMP(TT)
	ADDI C,(TT)	;ADDR OF BEGINNING OF NAME AREA
	MOVEI D,2000(TT)	;D => FROM POINTER
	MOVE I,D	;I => TO POINTER
	HRLOI E,377777	;PREVIOUS FN1 (BIT 4.9 COMPLEMENTED)
	MOVE W,E	;FN2
	MOVEI J,0	;J NEGATIVE => NEED SORT, NON-ZERO => DIR MODIFIED
QSKDP4:	SUBI I,LUNBLK
QSKDP5:	SUBI D,LUNBLK
	CAMLE C,D
	 JRST QSKDP8	;THROUGH
	SKIPN A,UNFN1(D)
	 SKIPE UNFN2(D)
	  JRST QSKDP3
	HLLOS J
	JRST QSKDP5	;NAME BLOCK FREE

QSKDP3:	MOVE Q,UNRNDM(D)
	TLNN Q,UNIGFL
	 JRST QSKDPR	;NOT OPEN FOR WRITE OR BEING DELETED
	HLLOS J		;NEED TO WRITE OUT DIR
	SKIPN A,UNFN1(D)
	 MOVSI A,(SETZ)
	SKIPN B,UNFN2(D)
	 MOVSI B,(SETZ)
QSKDP7:	PUSHJ P,QGRLSC	;DON'T CREATE ANY FILE WITH NAME OF < OR >
	 AOJA A,QSKDPA	;CHANGE BOTH JUST TO BE SURE
	  AOJA A,QSKDPA
	MOVE Q,QSNLCN(H)	;SEE IF THAT NAME EXISTS
	MOVEI Q,2000-LUNBLK(Q)	;THERE MAY BE DUPLICATE ENTRIES
QSKDPU:	CAMN A,UNFN1(Q)	;DURING THIS SEARCH BUT IT DOESN'T
	 CAME B,UNFN2(Q)	;MATTER
	  JRST QSKDPT
	CAIE Q,(D)	;DON'T CHANGE NAME IF NOT DUPLICATE
QSKDPA:	 AOJA B,QSKDP7	;FOUND IT.  CHANGE SECOND NAME
QSKDPT:	SUBI Q,LUNBLK
	CAMG C,Q
	 JRST QSKDPU
	MOVEM A,UNFN1(D)
	MOVEM B,UNFN2(D)
	MOVSI Q,UNIGFL
	ANDCAM Q,UNRNDM(D)
QSKDPR:	CAMN D,I
	 JRST QSKDP6
	HRLZ Q,D	;RELOCATE FILE BLOCK
	HRR Q,I
	BLT Q,LUNBLK-1(I)
QSKDP6:	JUMPL J,QSKDP4	;ALREADY NEEDS SORT
	MOVE B,UNFN2(D)	;MAY NOT HAVE YET IF GOT HERE FASTEST WAY
	TLC A,(SETZ)
	TLC B,(SETZ)
	EXCH A,E
	EXCH B,W
	CAMLE A,E
	 JRST QSKDP4	;ORDER OK
	CAMN A,E
	 CAMGE B,W
	  MOVNI J,1	;NEED SORT
	JRST QSKDP4

QSKDP8:	ADDI I,LUNBLK	;I POINTED TO EMPTY SLOT
	MOVE D,I
	SUBI D,(TT)
	EXCH D,UDNAMP(TT)
	ADDI D,(TT)
	CAML D,I
	 JRST QSKDPV
	SETZM (D)	;CLEAR VACATED AREA
	HRLS D
	ADDI D,1
	BLT D,-1(I)
QSKDPV:	JUMPL J,QSKDPS	;SORT
	TRNN J,-1
	 JRST QSKDPK
QSKDPX:	MOVE I,QACTB
	IORM I,QSNLCN(H)
QSKDPK:	MOVE W,QSNLCN(H)
IFN QRSRVP,[
	HLRZ A,UDALLO(W)	;IF THIS DIR HAS ALLOCATION
	JUMPE A,QSKBK0
	MOVEI B,NQS-1		;CONVERT PACK # TO DRIVE #
	CAME A,QPKID(B)
	 SOJGE B,.-1
	SKIPGE A,B
QSKBK0:	 SETO A,		;ALLOCATED PACK NOT MOUNTED, USE ANY
	MOVEM A,QSALLO(H)	;SAVE DRIVE # (-1 IF NONE)
];QRSRVP
	HLLZS UDBLKS(W)
	MOVE A,UDNAMP(W)
	ADDI A,(W)
QSKBK1:	CAIL A,2000(W)	;COUNT BLOCKS USED
	 JRST QSKBK2
	MOVE B,UNRNDM(A)
	TLNE B,UNLINK
	 JRST QSKBK3
	LDB B,[UNDSCP+UNRNDM(A)]
	IDIVI B,UFDBPW
	HLL B,QBTBLI(C)
	ADDI B,UDDESC(W)	;B GETS BYTE PNTR TO DESC
QSKBK4:	ILDB C,B
	JUMPE C,QSKBK3
	CAIN C,UDWPH
	 JRST QSKBK4
	CAIG C,UDTKMX
	 JRST [ADDM C,UDBLKS(W) ? JRST QSKBK4]
	CAIG C,UDWPH
	 JRST [AOS UDBLKS(W) ? JRST QSKBK4]
	REPEAT NXLBYT, IBP B
	AOS UDBLKS(W)
	JRST QSKBK4

QSKBK3:	ADDI A,LUNBLK
	JRST QSKBK1

QSKBK2:	POP P,W
	POP P,I
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	JRST QSKDP2

QSKDPS:	MOVEI T,LUNBLK
	ADD P,[3,,3]
QSKDPB:	MOVEI Q,(I)	;BEGINNING OF NAME AREA
	SKIPGE T
	 MOVEI Q,2000-LUNBLK(TT)	;START AT END
	MOVEI W,2000(TT)
	SKIPGE T
	 MOVEI W,-LUNBLK(I)
	SETZM (P)
	TDZA J,J	;0 => SORTED  -1 => MAKE ANOTHER PASS
QSKDPE:	 ADD Q,T
	CAIE Q,(W)
	 JRST QSKDPC
	JUMPE J,QSKDPW
	MOVNS T
	JRST QSKDPB

QSKDPW:	SUB P,[3,,3]
	JRST QSKDPX

QSKDPC:	SKIPN A,UNFN1(Q)
	 SKIPE UNFN2(Q)
	  JRST QSKDPD
	BUG

QSKDPD:	MOVE B,UNFN2(Q)
	TLC A,(SETZ)
	TLC B,(SETZ)
	SKIPE E,(P)	;FIRST ENTRY
	 JRST QSKDPF
QSKDPG:	MOVEM A,-2(P)
	MOVEM B,-1(P)
QSKDPI:	MOVEM Q,(P)
	JRST QSKDPE

QSKDPF:	JUMPL T,QSKDPJ
	CAMLE A,-2(P)
	 JRST QSKDPG
	CAME A,-2(P)
	 JRST QSKDPH
	CAML B,-1(P)
	 JRST QSKDPG
QSKDPH:	REPEAT LUNBLK,[
	EXCH A,.RPCNT(E)
	EXCH A,.RPCNT(Q)
	EXCH A,.RPCNT(E)
]
	MOVNI J,1
	JRST QSKDPI

QSKDPJ:	CAMGE A,-2(P)
	 JRST QSKDPG
	CAME A,-2(P)
	 JRST QSKDPH
	CAMG B,-1(P)
	 JRST QSKDPG
	JRST QSKDPH

SUBTTL OPEN FOR WRITE

;RETURNS WITH QUSR(E) AND QSNLCN(E) ON LSWPR
QWRO2:	JUMPE A,QPNL11
	JUMPE B,QPNL11
	SKIPGE I,EPDL(U)	;PICK UP DESIRED DISK UNIT
	 JRST QWRO2A	;SYSTEMS CHOICE
QWRO2B:	CAIGE I,NQS
	 SKIPE QACT(I)
	  BUG		;WE LOST SOMEHOW...
	MOVE TT,QTUTO(I)
	SKIPL QDPWF(I)	;TUT IN BUT NOT PAWED OVER
	 TLNE TT,40000	;TUT NOT IN
	  PUSHJ P,QTCH1	;READ IN TUT OF DISK INVOLVED
	PUSHJ P,QCHNF	;GET CHANNEL
	PUSHJ P,LOSSET
	    QCHNRT
	MOVE TT,[440700,,5]
	TRNN D,3
	 MOVEM TT,QSBYTE(E) ;UNIT ASCII MODE, BYTE SIZE=7
	PUSHJ P,QUDLK	;LOCK USER DIRECTORY
	PUSHJ P,QGRLSC	;CHECK < AND >
	 JRST QPNLBN	;LOSE
	  PUSHJ P,QFNG	;REPLACE WITH COMPUTED EFFECTIVE NAME
	PUSHJ P,QFREEF	;FIND FREE FILE NAME AREA AND STORE IN QDIRP(E)
	 JRST QFDF	;FILE DIR FULL
	MOVSI TT,UNWRIT	;SET WRITE IN PROGRESS
	IORM TT,UNRNDM(Q)
	MOVE TT,QPKID(I)
	DPB TT,[UNPKN+UNRNDM(Q)]
	PUSHJ P,QAUTH	;SET FILE AUTHOR, MAY NOT PCLSR
	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
	SETOM QSCRW(E)	;SET CHNL WRITE SWITCH
	POPJ P,

QWRO2A:
IFN QRSRVP,[
	SKIPL I,QSALLO(H)
	 JRST QWRO2B	;THIS DIR GOES ON A PARTICULAR UNIT
]
	SKIPGE I,QWRU	;GET CURRENT WRITING UNIT
	 JRST QWRO2E	;NO CURRENT UNIT, GO FIND ONE
	MOVE TT,QSFT(I)
	CAML TT,QFTTHR
	 JRST QWRO2B	;ENOUGH ROOM ON PREFERRED UNIT
QWRO2E:	SETOB T,I	;NOT MUCH SPACE LEFT TRY OTHER UNITS
	MOVSI E,-NQS
QWRO2C:	SKIPGE QACT(E)	;SKIP ON UNIT ACTIVE
	 JRST QWRO2D
IFN QRSRVP,SKIPN QRESRV(E)	;DONT CHOOSE THIS PACK IF RESERVED
	 CAML T,QSFT(E)	;NOTE QSFT IS -1 IF TUT NEVER BEEN READ IN
	  JRST QWRO2D	;OTHERWISE CONTAINS VALID BLOCK COUNT
	MOVE T,QSFT(E)
	HRRZ I,E
QWRO2D:	AOBJN E,QWRO2C
	SKIPGE I
	 BUG		;NO ACTIVE UNRESERVED UNITS
	CAMN I,QWRU
	 JRST QWRO2B	;DON'T WRITE MFD IF UNCHANGED
	MOVEM I,QWRU
	MOVE E,QACTB
	IORB E,QMDRO
	MOVEM I,MPDWDK(E)
	JRST QWRO2B

QWRO:	JUMPN W,QWROR	;REALLY WANT TO MODIFY OR OTHERWISE HACK AN EXISTING FILE
	PUSHJ P,QWRO2	;MAKING NEW FILE, DECIDE WHICH UNIT TO PUT IT ON
	SETOM QMFTP(E)	;TRACK TO SCAN IN TUT
	SETOM QMTTR(E)
	CLEARM QMPTN(E)
	CLEARM QMPTC(E)
	MOVEI TT,%QMWRT	;ENTER NORMAL WRITE MODE
	HRRM TT,QSRAC(E)
	MOVSI TT,%QARWT
	TRNE D,%DORWT/2
	 IORM TT,QSRAC(E)
	JRST QOEX1	;EXIT


SUBTTL	File hacking tracking

; MNGDIR checks the file name (sname in C) 
; Fails to skip if the file is an important system file.
; Skips if the file is of the everyday sort.

MNGDIR:	HLRZ TT,C
IFN KL10P, CAME C,[SIXBIT /.KLFE./]
	CAIN TT,'SYS	;A sys directory?
	 POPJ P,
	CAME C,[SIXBIT /ACOUNT/]
	 CAMN C,[SIXBIT /./]
	  POPJ P,
	CAME C,[SIXBIT /DEVICE/]
	 CAMN C,[SIXBIT /CHANNA/]
	  POPJ P,
	AOS (P)		;Not a system directory. skip return.
	POPJ P,

; SYSDSK notifies the SYS job to print a message on the
; console about the file being hacked.
; File names in C;A B, the opcode in W (or zero) specifies the hacking.

SYSDSK:	JUMPE U,CPOPJ		;Avoid deadly embrace!
	MOVSI T,SCLWRT		;Writing on SYS directory.
	PUSHJ P,CWAIT		;Take turns like nice little lusers.
	    TDNE T,SUPCOR	;Wait for previous req to finish.
	MOVE TT,W		;Check file operation code.
	CAILE TT,4		;If impossible opcode
	 SETZ TT,		; probably supposed to be R/W.
	MOVEM TT,SWMOD		;Store opcode.
	MOVE TT,UNAME(U)
	MOVEM TT,SWUNAM		;Luser.
	MOVE TT,JNAME(U)
	MOVEM TT,SWJNAM
	MOVEM A,SWFN1
	MOVEM B,SWFN2
	MOVEM C,SWFN3		;Sname.
	IORM T,SUPCOR		;Notify the SYS job.
	JRST CLKONJ		;Turn on the clock and return.


SUBTTL DIRECTORY ROUTINES

QFREEF:	PUSH P,A	;Q_PTR TO USER DIR FREE FILE  QDIRP(E)_PTR TO FREE DESC AREA
	PUSH P,B	;GET FREE FILE AREA
	PUSH P,I
	MOVEI I,0	;SIGNAL NO GC YET
QFREFA:	SETZM QUDFPR(E)	;CLEAR SO WILL NOT POINT TO RANDOMNESS IN CASE OF G C
	MOVE TT,QSNLCN(H)
	SKIPL Q,UDESCP(TT)
	 CAIL Q,2000*UFDBPW
	  BUG		;FREE DESC POINTER OUT OF RANGE
	IDIVI Q,UFDBPW
	MOVE C,UDNAMP(TT)
	CAIL Q,-UDDESC-7-LUNBLK(C)
	 JRST QAGARB	;NOT ENOUGH ROOM BETWEEN DESC AND NAME AREAS
	PUSHJ P,QLGLK	;FIND WHERE FILE OUGHT TO GO
	 JRST QFREFF	;DIR WAS EMPTY
	TRNN J,1777
	 JRST QFREFE	;GOES AT END OF DIR
QFREFC:	CAMN A,UNFN1(J)
	 CAME B,UNFN2(J)
	  JRST QFREFE
	MOVE C,UNRNDM(J)
	TLNE C,UNIGFL	;* FILES MUST COME AFTER NON * FILES
	 JRST QFREFE	;OF SAME NAME
	ADDI J,LUNBLK
	CAIGE J,2000(TT)
	 JRST QFREFC
QFREFE:	CAMN Q,J
	 JRST QFREFF	;GOES AT BEGINNING
	PUSHJ P,QINSRT
	JRST QFREFD

QFREFF:	SUBI Q,LUNBLK		;Q -> NAME BLOCK FILE WILL GO IN
QFREFD:	MOVNI T,LUNBLK		;ALLOCATE MORE SPACE FOR NAME AREA
	ADDM T,UDNAMP(TT)
	HRRZ A,UDESCP(TT)	;FIRST FREE DESCRIPTOR LOC
	DPB A,[UNDSCP+UNRNDM(Q)];STORE IN FILE AREA
	MOVEM A,QDIRP(E)	;STORE IN CHANNEL
	MOVEI B,6*UFDBPW+1	;ENOUGH FOR A LINK WITH EVERY CHAR QUOTED PLUS ONE ZERO
	ADDM B,UDESCP(TT)	;ALLOCATE MORE SPACE FOR DESC AREA
	MOVE B,Q
	SUB B,QSNLCN(H)
	HRRZM B,QUDFPR(E)	;ASSOCIATE CHANNEL WITH FILE
	CONO PI,CLKOFF
	SKIPL B,QDATE		;GET TIME AND DATE
	 HRR B,TIMOFF
	CONO PI,CLKON
	MOVEM B,UNDATE(Q)	;SET CREATION DATE
	HLLM B,OLDRDT(E)
	HLRS B
	DPB B,[UNREFD+UNREF(Q)]	;SET REFERENCE DATE
	IDIVI A,UFDBPW		;GET WRD AND CHAR ADRS
	HLLZ B,QBTBLI(B)
	ADDI B,UDDESC(A)
	HRRZ A,QSNLCN(H)
	ADD B,A
	ILDB A,B
	SKIPE A
	 BUG			;DESCRIPTOR AREA ALREADY OCCUPIED
	MOVEI A,UDWPH
	DPB A,B
	ILDB A,B
	SKIPE A
	 BUG			;NOT FOLLOWED BY ZERO
	POP P,I
	POP P,B
	POP P,A
	MOVEM A,UNFN1(Q)	;SET FILE NAMES
	MOVEM B,UNFN2(Q)
	JRST POPJ1

QAGARB:	JUMPL I,QNOFRE	;IF GC WAS ALREADY TRIED, DON'T TRY IT AGAIN - GIVE UP.
	PUSHJ P,QGC	;GC.  BTW, IT IS OK TO PCLSR HERE.
	 JFCL
	MOVNI I,1	;SIGNAL GC HAS BEEN TRIED
	JRST QFREFA

;MAKE ROOM FOR FILE BEFORE J.  Q POINTS TO NEW EMPTY FILE SLOT
QINSRT:	PUSH P,A
	PUSH P,TT
	HRRZ TT,QSNLCN(H)
	HRRZ A,UDNAMP(TT)
	PUSH P,A
	ADDI A,(TT)
	HRLS A
	SUBI A,LUNBLK
	BLT A,-LUNBLK-1(J)
	SETZM -LUNBLK(J)
	HRRZI A,-LUNBLK+1(J)
	HRLI A,-LUNBLK(J)
	BLT A,-1(J)
	SUB J,QSNLCN(H)
	MOVSI A,-NQCHN
QINSR1:	HRRZ TT,QUDPR(A)
	SKIPL QUSR(A)
	CAIE TT,(H)
	JRST QINSR2
	MOVE TT,QUDFPR(A)
	CAMGE TT,(P)
	JRST QINSR2
	CAIGE TT,(J)
	SUBI TT,LUNBLK
	MOVEM TT,QUDFPR(A)
QINSR2:	AOBJN A,QINSR1
	ADD J,QSNLCN(H)
	HRRZI Q,-LUNBLK(J)
	SUB P,[1,,1]
	POP P,TT
	POP P,A
	POPJ P,

;DIR NOT IN CORE.  GET IT FROM DISK, CREATE IT IF DOESN'T ALREADY
; EXIST, OR GIVE NO SUCH DIRECTORY ERROR.
;C HAS SNAME.  RETURNS DIRECTORY NUMBER IN H.

QSKO1:	PUSHJ P,SWTL
	    QSKOSW	;PREVENT TIMING ERROR IF TWO PCS SHOULD
	PUSHJ P,QFLD	; ATTEMPT TO BRING IN SAME DIRECTORY
	 JRST QSKO11
	MOVEI T,2	;SOMEONE ELSE BROUGHT IT IN, RELEASE QSKOSW
	JRST LSWPON	;BUT LEAVE QSNNR(H) LOCKED.

QSKO11:	PUSH P,J
	PUSH P,I
	PUSHJ P,QFL	;LOOK UP DIR IN MFD, RET TRACK IN J
	 JRST QSKON	;NON EXISTENT
	PUSHJ P,QFLDF	;FIND FREE LOSER DIR SLOT
	MOVE I,MDSK
	PUSHJ P,QCHNF	;FIND FREE CHNL (TO READ IN DIR)
	MOVEM C,QSNUD(H)	;SET USER NAME IN DIR SLOT
	MOVEM J,QSLGL(E)	;REQUEST READ IN OF USER DIR FROM TRACK IN J
	MOVEI TT,%QMUDR
	MOVEM TT,QSRAC(E)
QSKON1:	MOVEI T,2
	PUSHJ P,LSWPON	;RELEASE QSKOSW, LEAVE SOSSET OF QSNNR(H)
	POP P,I		;GO AWAY WILL HANG UP WAITING IN QUDLK
	POP P,J		;DIR IS LOCKED BUT NOT ON LSWPR, PI WILL UNLOCK AFTER READIN
	JRST QSTRTR

QNOFRE:	POP P,I		;NO FREE FILES AVAIL
	JRST POPBAJ

QPNL24:	PUSHJ P,OPNL24
	JRST URET

QPNL20:	PUSHJ P,OPNL20
	SKIPE QLD(U)
	 PUSHJ P,OPNL47	;FOUND LINK, BUT IT POINTS TO NON-EXISTENT DIRECTORY
	JRST URET

AUTOCR:			;AUTOMATICALLY CREATED DIRECTORIES
IFN TPLP+UNSPLP,SIXBIT /.LPTR./	;FOR TPL SPOOLING
	SIXBIT /.MSGS./		;FOR MESSAGES TO ALL LOSERS
	SIXBIT /.MAIL./		; Programs like to write mail here
	SIXBIT /CRASH/		; Programs like to dump themselves here
	SIXBIT /.TEMP./		; Programs like to write randomness here
NATOCR==.-AUTOCR

QSKON:	JUMPE C,QPNL20	;DON'T ALLOW ZERO USER NAME
	PUSH P,TT
	MOVSI TT,-NATOCR
QSKONA:	CAMN C,AUTOCR(TT)
	 JRST QSKONB
	AOBJN TT,QSKONA
	CAMN A,[SIXBIT /..NEW./]
	 CAME B,[SIXBIT /(UDIR)/]
	  JRST [POP P,TT
		JRST QPNL20]
	BUG INFO,[DSK: DIR ],SIXBIT,C,[CREATED BY ],SIXBIT,UNAME(U),SIXBIT,JNAME(U) 
QSKONB:	POP P,TT
	SKIPG NQFUS
	 JRST QPNL24	;NO MFD SLOTS AVAILABLE
	PUSH P,A
	PUSH P,B
	PUSH P,C
QSKONE:	PUSHJ P,QFLDF	;FIND FREE DIR SLOT
	PUSHJ P,QMLOCK
	PUSHJ P,TCALL
	 JRST IOMQ
	  JRST [PUSHJ P,LSWPOP	;QMDRO
		PUSHJ P,LSWPOP	;QSNNR
		PUSHJ P,UDELAY	;HOPEFULLY MEMORY WILL APPEAR SHORTLY
		JRST QSKONE]
	MOVEM C,QSNUD(H)
	SOS NQFUS	;NO TIMING ERR DUE TO QSKOSW
	MOVEI J,MU23UD
	DPB J,[MUR,,MEMBLT(A)]
	DPB H,[MNUMB,,MEMBLT(A)]
	LSH A,10.
	HRRM A,QSNLCN(H)
	SETZM (A)
	HRLS A
	AOS B,A
	BLT A,2000-2(B)
	MOVEI A,2000
	MOVEM A,UDNAMP-1(B)
	MOVE A,QSNUD(H)
	MOVEM A,UDNAME-1(B)
	MOVE B,QACTB		;NOW PUT UFD INTO MFD
	IORB B,QMDRO
	MOVE TT,MDNAMP(B)	;LOOK FOR A FREE SLOT
	ADDI TT,(B)
QSKONC:	TRNN TT,1777
	 JRST QSKOND
	SKIPN MNUNAM(TT)
	 JRST QSKONF
	ADDI TT,LMNBLK
	JRST QSKONC

QSKONF:	SUBI TT,(B)
	JRST QSKONG

QSKOND:	MOVNI TT,LMNBLK		;NO FREE SLOTS, SO EXTEND DOWNWARD
	ADDB TT,MDNAMP(B)
QSKONG:	ADDI B,(TT)
	MOVEM A,MNUNAM(B)
	SUBI TT,2000-2*NUDSL	;GET DISK BLOCK NUMBER
IFN KA10P, SKIPGE TT
IFE KA10P, CAIGE TT,2		; Don't clobber 'HOM' blocks
	 BUG			;TOO MANY UFDS (NQFUS CHECK DIDN'T WORK)
	LSH TT,-1
	MOVEM TT,QSNMI(H)	
	MOVE TT,QACTB		;UNLOCK UFD AND CAUSE IT TO GET WRITTEN
	HLLM TT,QSNLCN(H)
	PUSHJ P,QMULK		;UNLOCK MFD
	POP P,C
	POP P,B
	POP P,A
	JRST QSKON1

SUBTTL MAKE LINK

QALINK:	MOVE I,MDSK	;ENTER WITH QSNNR ON LSWPR
	MOVEM I,EPDL(U)
	PUSHJ P,QWRO2	;MAKES NEW FILE WITH MINIMUM OF 37 BYTES OF DESC SPACE
	MOVSI A,UNLINK	; AND ADDS QUSR AND QSNLCN ON LSWPR
	IORM A,UNRNDM(Q)	;SET LINK BIT
	MOVE A,E	;QSK CHANNEL NUMBER
	MOVE C,SRN5(U)	;SNAME LINKED TO
	PUSHJ P,LDEP
	 PUSHJ P,QUDS
	MOVE C,SRN3(U)	;FN1 LINKED TO
	PUSHJ P,LDEP
	 PUSHJ P,QUDS
	MOVE C,SRN4(U)	;FN2 LINKED TO
	PUSHJ P,LDEP
	 JFCL
	MOVE E,A	;QSK CHANNEL NUMBER FOR QCHNRT
	MOVEI R,EPDL(U)	;DON'T CLOSE A REAL IOCHNM WORD
	PUSHJ P,QSOCL4	;CLOSE CHNL & FILE
	PUSHJ P,LSWDEL	;DELETE QUSR, HAS BEEN SETOM'ED
	PUSHJ P,LSWDEL	;DELETE QSNRR, HAS BEEN SOS'ED
	JRST POPJ1

LDEP:	MOVEI E,6	;STORE SIXBIT FROM C INTO LINK DESC
LDEPL:	MOVEI B,0	;GET NEXT CHAR
	LSHC B,6
	JUMPE B,LDEPS	;*THIS ALLOWS EMBEDDED BLANKS.
	CAIE B,';
	 CAIN B,':
	 JRST LDEPS
LDEPS2:	MOVE D,B
	PUSHJ P,QUDS
	SOS E		;NUMBER OF CHARACTERS LEFT IN WORD
	JUMPN C,LDEPL	;JUMP IF ANY MORE NON-BLANK CHARS TO STORE
	MOVEI D,';
	JUMPE E,POPJ1	;JUMP IF STORED 6 CHARACTERS
	POPJ P,		;STORED FEWER, NEED TERMINATOR

LDEPS:	MOVEI D,':	;THIS CHAR NEEDS TO BE QUOTED
	PUSHJ P,QUDS
	JRST LDEPS2

;LINK ENCOUNTERED DURING LOOKUP

QLINK:	TRNE D,%DONLK/2	;CHECK 3.5 BIT IN OPEN MODE
	 JRST QOLINK	;JUMP IF DON'T CHASE LINKS MODE
	AOS A,QLD(U)
	CAIL A,100.
	 JRST OPNL27	;LINK DEPTH EXCEEDED
	PUSH P,E	;SAVE XR NEEDED BY LSWPOP OF QUSR ENTRY
	MOVE E,TT
	IDIVI E,UFDBPW
	ADD E,QSNLCN(H)
	ADDI E,UDDESC
	MOVE TT,QBTBLI(TT)
	HRR TT,E
	MOVE I,[440600,,A]
	SETZB A,B
	SETZ C,
QL1:	ILDB J,TT
	JUMPE J,QL3	;END DESC
	CAIN J,':
	 JRST QL4	;QUOTE NEXT CHAR
	CAIN J,';
	 TLZA I,770000	;TERMINATE THIS WORD
QL5:	  IDPB J,I
	JRST QL1

QL4:	ILDB J,TT	;GET CHAR THAT WAS QUOTED
	JRST QL5

QL3:	EXCH A,C	;END OF DESC REACHED
	EXCH A,B	;MAKE A FN1 B FN2 C SNM
	SKIPN C
	 MOVE C,USYSN1(U)
	PUSHJ P,QUDULK	;UNLOCK DIR
	POP P,E		;RESTORE XR USED BY LSWPOP OF QUSR ENTRY
	PUSHJ P,LSWPOP	;QUSR ENTRY
	PUSHJ P,LSWPOP	;QSNNR ENTRY
	PUSHJ P,OPBRK	;IF TRYING TO BE PCLSRED, SUBMIT
	JRST QSKOL

QOLINK:	MOVSI TT,%QALNK	;OPENING UP A LINK
	IORM TT,QSRAC(E);DON'T ALLOW FILE-ONLY OPERATIONS SUCH AS IOT
	JUMPL D,QWROR1	;LEAVE RH(QSRAC)=%QMIDL SO PI LEVEL WON'T MESS WITH IT
	JRST QOEX1	;AND FINISH OPENING

SUBTTL PAW OVER MFD

QMCH1:	CONO PI,UTCOFF
	MOVE TT,QMDRO
	TLNE TT,40000
	AOJE TT,QMCH2	;NOT ON WAY IN
QMCH3:	CONO PI,UTCON
	SKIPGE QMDRO
	 PUSHJ P,UFLS
	MOVSI E,2
	TDNN E,QMDRO
	 POPJ P,	;PAWED OVER
	PUSHJ P,QMLOCK
	ANDCAM E,QMDRO
	HRRZ E,QMDRO
	MOVE TT,MDCHK(E)
	CAME TT,[SIXBIT /M.F.D./]
	 BUG HALT,[MFD CLOBBERED]
QMCH1A:	MOVEI E,2000-LMNBLK*NUDSL(E)
IFN KA10P, SETZM NQFUS
IFE KA10P,[
	MOVNI TT,2		;PROTECT DEC 'HOM' BLOCKS SO KLDCP OR 8080
	MOVEM TT,NQFUS		; CAN FIND ITS CRUFT
] ;IFE KA10P
QMCH1E:	LDB TT,[1200,,E]
	JUMPE TT,QMULK
	SKIPN (E)
	 AOS NQFUS
	ADDI E,LMNBLK
	JRST QMCH1E

QMCH2:	SOS QMDRO	;INDICATE ON WAY IN
	CONO PI,UTCON
	SKIPG QFCHN
	 BUG		;DON'T WANT TO WAIT FOR CHANNEL?
	PUSHJ P,QCHNF
	MOVEI TT,MFDBLK	;MFD TRACK
	MOVEM TT,QSLGL(E)
	MOVEI TT,%QMMDR
	MOVEM TT,QSRAC(E)
	PUSHJ P,QSTRTR
	JRST QMCH3

SUBTTL PAW OVER TUT

QTCH1:	CONO PI,UTCOFF
	MOVSI TT,200000
	TDNE TT,QTUTO(I)
	 JRST QTCH2	;GO READ IT IN
	CONO PI,UTCON
QTCH1A:	PUSHJ P,QTLOCK	;TO MAKE SURE IT'S IN
	AOSE QDPWF(I)
	 JRST QTULK	;ALREADY PAWED OVER
	PUSH P,A
	PUSH P,B
	MOVE T,QTUTO(I)
	MOVE E,QSWAPA(T)
	IDIVI E,DECADE
	SKIPE TT
	 ADDI E,1
	IMULI E,DECADE	;ROUND SWAPPING ALLOC TO MULTIPLE OF A DECADE
	MOVEM E,QSWAPA(T)
	PUSH P,D
	PUSH P,E	;FIRST TRACK OF NON-SWAPPING (FILE) AREA
	MOVE E,QTUTP(T)	;ROUND TUT POINTER TO MULTIPLE OF A DECADE
	ADDI E,DECADE-1
	IDIVI E,DECADE
	IMULI E,DECADE
	CAMGE E,(P)	;KEEP IT WITHIN THE FILE AREA
	 MOVE E,(P)
	MOVEM E,QTUTP(T)
	MOVE E,QPKNUM(T)
IFN DC10P,[
	CAME E,QPKID(I)
	 BUG HALT,[PACK ID ],OCT,E,[IN TUT FOR UNIT ],DEC,I,[DIFFERS FROM HARDWARE PACK ID],OCT,QPKID(I)
]
IFE DC10P,	MOVEM E,QPKID(I)
	MOVE E,QPAKID(T)
	MOVEM E,QPKNM(I)
IFN QRSRVP,[
	MOVE E,QTRSRV(T)
	MOVEM E,QRESRV(I)
]
;DROPS THROUGH
;DROPS IN
	CLEARM QSFTS(I)	;FREE SPACE IN SWAPPING AREA
	SETZB D,QSFT(I)
	MOVE B,QTUTO(I)
	HRLI B,(TUTBP)
	ADDI B,LTIBLK
QTCH1D:	ILDB A,B
	JUMPN A,QTCH1F
	CAML D,(P)
	 AOS QSFT(I)	;BLOCK IN NON-SWAPPING AREA
	CAMGE D,(P)
	 AOS QSFTS(I)	;BLOCK IN SWAPPING AREA
QTCH1F:	ADDI D,1
	CAMGE D,QLASTB(T)
	 JRST QTCH1D
	SUB P,[1,,1]
	POP P,D
	POP P,B
	POP P,A
	JRST QTULK

QTCH2:	SETOM QDPWF(I)
	ANDCAM TT,QTUTO(I)
	CONO PI,UTCON
	SKIPG QFCHN
	 BUG			;DON'T WANT TO WAIT FOR CHANNEL?
	PUSHJ P,QCHNF
	HRRZM I,QDSKN(E)
	MOVEI TT,MFDBLK		;TELL PI LEVEL TO READ IT ALL IN
	SUB TT,NTBL(I)
	MOVEM TT,QSLGL(E)
	LDB TT,[121000,,QTUTO(I)]
	MOVEM TT,QSCABN(E)
	MOVEI TT,%QMTTR
	MOVEM TT,QSRAC(E)
	PUSHJ P,QSTRTR
	JRST QTCH1A

;ROUTINE TO ACCESS TUT
;CALL WITH DISK UNIT NUMBER IN I, BLOCK NUMBER IN D
;RETURNS IN D AN LDB-STYLE POINTER TO THE TUT AND IN B THE BYTE
;THAT YOU WOULD GET BY LDB'ING THAT POINTER.
;CLOBBERS E
;CALLER MUST LOCK TUT

TUTPNT:	MOVE B,QTUTO(I)
	CAML D,QFRSTB(B)
	CAML D,QLASTB(B)	
	 BUG			;BLOCK NUMBER NOT IN RANGE COVERED BY TUT
	SUB D,QFRSTB(B)
	IDIVI D,TUTEPW
	ADDI D,LTIBLK(B)
	HLL D,TBTBL(E)
	LDB B,D
	POPJ P,

QSTRTR:
IFN DC10P,[
QSTRT1:	CONSO DC0,DSKCHN
	 SETOM QHUNGF		;SOMEONE PUSHED RESET BUTTON, RECOVER AT PI LEVEL
	CONO DC0,DCSET+DCIENB+DSKCHN	;ENABLE IDLE INTERRUPT
]
IFN RP10P+RH10P+RH11P,[
	CONO PI,UTCOFF
	PUSHJ P,QSTRT1
	CONO PI,UTCON
]
	POPJ P,

IFN RP10P+RH10P+RH11P,[	;START DISK WITH UTC ALREADY OFF
QSTRT1:	SETOM QGTBZY	;NOTE: TURNS UTC BACK ON BUT NOT CLOCK
IFN RP10P,	CONSO DPC,20	;ONLY IF DISK IDLE
IFN RH10P,	CONSO DSK,%HIBSY
IFN RH11P,	IORDQ TT,%HRCS1
IFN RH11P,	TRNE TT,%HXRDY
	 CONO PI,DSKRQ
	POPJ P,
]

;TRY TO FLUSH UNNEEDED UFDS FROM CORE.
;ARG IN C IS ROUTINE TO FREE THE MEMORY.
;CALL WITH UDRSW SIEZED, OR WITH PI 2 IN PROGRESS AND UDRSW NOT LOCKED BY ANYONE
;CLOBBERS H, TT.  DOESN'T SKIP.
QDFLS:	MOVSI H,-QNUD
QDFLS1:	SKIPE QSNUD(H)
	 SKIPE QSNNR(H)
QDFLS2:	  AOBJN H,QDFLS1	;CAN'T FLUSH IF SLOT NOT USED OR CHANNELS OPEN IN DIR
	JUMPGE H,CPOPJ
	MOVE TT,QACTB
	TLO TT,600000
	TDNE TT,QSNLCN(H)
	 JRST QDFLS2		;CAN'T FLUSH IF LOCKED OR NOT WRITTEN OUT
	PUSHJ P,QDFCHK		;CHECK THAT NO POINTERS TO THIS DIRECTORY REMAIN
	CLEARM QSNUD(H)		;FLUSH
	AOS QFUD
	PUSH P,A
	HRRZ A,QSNLCN(H)
	LSH A,-10.
	PUSHJ P,(C)		;RETURN THE MEMORY
	POP P,A
	JRST QDFLS2		;TRY FLUSHING SOME MORE

;CALL WITH UFD SLOT# IN H, WHEN YOU THINK THAT UFD IS FREE.
QDFCHK:	PUSH P,C
	PUSH P,J
	MOVSI C,-NQCHN
QDFCH1:	SKIPGE QUSR(C)
	 AOBJN C,QDFCH1
	JUMPGE C,QDFCH2
	HRRZ J,QUDPR(C)
	CAIN J,(H)
	 BUG		;IT WASN'T REALLY FREE, MAYBE QSNNR IS SCREWED UP?
	AOBJN C,QDFCH1
QDFCH2:	POP P,J
	POP P,C
	POPJ P,

;FIND A FREE UFD SLOT, RETURN INDEX IN H.  PUTS QSNNR ON LSWPR.
;CLOBBERS T, TT.

QFLDF:	PUSHJ P,SWTL
	    UDRSW
	MOVSI H,-QNUD
	SKIPLE QFUD
	 JRST QFLDF1
	PUSH P,C	;ALL UFD SLOTS IN USE, TRY FLUSHING SOME
	MOVEI C,MEMR
	PUSHJ P,QDFLS
	POP P,C
	MOVSI H,-QNUD
	SKIPLE QFUD
	 JRST QFLDF1
	PUSHJ P,LSWPOP	;UDRSW
	PUSHJ P,UDELAY	;WAIT 1/2 SECOND THEN TRY AGAIN, INCLUDING QDFLS
	JRST QFLDF

QFLDF1:	SKIPN QSNNR(H)	;SLOT ALREADY GOBBLED
	 SKIPE QSNUD(H)	;OR ALREADY OCCUPIED
	  AOBJN H,QFLDF1 ;MEANS CAN'T TAKE IT
	SKIPL H
	 BUG		;NONE FREE, QFUD OUT OF PHASE WITH REALITY
	HRRZS H
	SOS QFUD
	MOVSI TT,600000	;DOUBLE LOCK
	MOVEM TT,QSNLCN(H)
	AOSG QSNNR(H)
	 BUG
	PUSHJ P,LSWPOP	;UDRSW
	PUSHJ P,LOSSET
	    QFLDRT
	POPJ P,

;LOSSET ROUTINE
QFLDRT:	SKIPL A,AC0S+H(U)
	 CAIL A,QNUD
	  BUG		;H CLOBBERED
	SOSGE T,QSNNR(A)
	 BUG
	JUMPG T,CPOPJ	;HOW DID SOMEONE ELSE GET IT?
	SKIPN QSNUD(A)
	 AOS QFUD	;READ-IN NEVER STARTED, SLOT BECOMES FREE
	POPJ P,		;OK TO LEAVE 600000,, SET IN QSNLCN

;C HAS DIR NAME.
;IF IN CORE, SET H TO UFD SLOT#, AOS QSNNR, PUT ON LSWPR, AND SKIP.
;IF DIRECTORY NOT IN CORE, NO SKIP.  CLOBBERS T,TT.
QFLD:	PUSHJ P,SWTL
	    UDRSW
QFLD1A:	MOVSI H,-QNUD
QFLD1:	CAME C,QSNUD(H)
	 AOBJN H,QFLD1
	JUMPGE H,LSWPOP	;JUMP ON FAILED TO FIND USER.
QFLD2A:	AOSG QSNNR(H)
	 BUG		;MUST HAVE GOTTEN NEGATIVE SOMEHOW
	PUSHJ P,LSWPOP	;UDRSW
;	PUSHJ P,SOSSET
;	    QSNNR(H)
;THIS IS AN ATTEMPT TO FIND A BUG.
	PUSH P,T
	MOVEI T,QSNNR(H)
	MOVEM T,IOTBTS(U)
	PUSHJ P,LOSSET
	    [ SOSGE @IOTBTS(U)
	       BUG
	      POPJ P, ]
	POP P,T
;END TEMPORARY CODE
	JRST POPJ1

;C <=SYS NAME,   RETURNS TRACK ADDR OF DIR IN J, SKIPS IF FINDS LOSER
QFL:	PUSHJ P,QMLOCK
	PUSHJ P,QFL0
	 JRST QMULK
	AOS (P)
	JRST QMULK	

QFL0:	PUSH P,Q
	HRRZ Q,QMDRO
	ADD Q,MDNAMP(Q)	;PTR TO USER AREA
QFL1:	LDB J,[1200,,Q]
	JUMPE J,QFL3
	CAMN C,MNUNAM(Q)
	 JRST QFL2
	ADDI Q,LMNBLK
	JRST QFL1

QFL2:	SUBI J,2000-LMNBLK*NUDSL	;J <= TRACK ADDR OF USER DIR
	LSH J,-1
	AOS -1(P)	;SUCCESS
QFL3:	POP P,Q
	POPJ P,

;ROUTINE TO ASSIGN A DISK CHANNEL.
;ARGS:	U USER TO GO IN QUSR, H UFD SLOT# TO GO IN QUDPR, I DSK# TO GO IN QDSKN
;RETURNS QSK CHNL INDX IN E.
;DOESN'T DO A LOSSET OF QCHNRT, BUT CALLER MAY WANT TO.
;CLOBBERS T.  NEVER SKIPS.

QCHNF:	PUSHJ P,SWTL	;PREVENT ANYONE ELSE FROM ALLOCATING CHANNELS
	    QCHSW
	MOVSI E,-NQCHN
	SKIPLE QFCHN
	 JRST QCH2	;SOME CHANNELS ARE AVAILABLE, GO FIND ONE
	PUSHJ P,LSWPOP	;QCHSW
	SKIPG QFCHN
	 PUSHJ P,UFLS
	JRST QCHNF

QCH2:	SKIPGE QSRAC(E)	.SEE %QALOK
	 JRST QCH3
	SKIPGE QUSR(E)
	 JRST QCH1
QCH3:	AOBJN E,QCH2
	BUG		;WHERE DID THAT FREE CHANNEL GO?

QCH1:	HRRZS E		;CHANNEL ALLOCATED, INITIALIZE VARIABLES
	HRRZM I,QDSKN(E)
	SETOM QSCABN(E)
	SETOM QSGL(E)
	SETOM QSLGL(E)	;IN CASE OF WRITE-OVER ON 0-LENGTH FILE.
	SETZM QBFP(E)
	SETZM QSBFS(E)
	CLEARM QSLBLK(E)
	SETOM QSMDN(E)
	SETZM QSCRW(E)
	SETZM QSBI(E)
	SETZM QSRAC(E)	.SEE %QMIDL
	CLEARM QFBLNO(E)
	SETZM QSMPRC(E)
	SETZM QSMPRP(E)
	MOVE T,[444400,,1]	;ASSUME BYTES=WORDS, WILL BE FIXED LATER
	MOVEM T,QSBYTE(E)
	SETZM QPCLSR(E)
	HRRZM H,QUDPR(E)
	SETZM QUDFPR(E)	;NOT YET SET UP TO ANY PARTICULAR FILE
	MOVEM U,QUSR(E)	;CHANNEL IS NOW IN-USE
	SOSGE QFCHN
	 BUG
	JRST LSWPOP	;QCHSW

;LOSSET ROUTINE TO RETURN TENTATIVELY ASSIGNED QSK CHNL
;E HAD BETTER CONTAIN THE QSK CHANNEL NUMBER AT "ALL" TIMES
QCHNRT:	SKIPL T,AC0S+E(U)
	 CAIL T,NQCHN
	  BUG		;E CLOBBERED
	HRRZ A,U	;LSWPOP MESSES WITH LH(U)
	CAME A,QUSR(T)
	 BUG
	SETOM QUSR(T)
	AOS QFCHN
	POPJ P,

SUBTTL DELETE, RENAME
;COME HERE FOR DELETE, OR RENAME NOT WHILE OPEN, ON DISK.

QRNAM:	SKIPN SRN3(U)
	 JRST QDEL
	PUSH P,A
	PUSH P,B
	SKIPN B,SRN4(U)
	 JRST QPNL11
	MOVE A,SRN3(U)
	PUSHJ P,MFDCK
	 JRST .+2
	  JRST QPNL13
	PUSHJ P,FLDRCK
	 JRST .+2
	  JRST QPNL13
	POP P,B
	POP P,A
	PUSH P,SRN3(U)
	PUSH P,SRN4(U)
	PUSHJ P,QUDLK
	PUSHJ P,QLOOK
	 JRST [	SUB P,[2,,2]
		JRST QROR1C ]	;GIVE FILE NOT FOUND OR FILE LOCKED
	MOVE I,Q
	POP P,B
	POP P,A
	PUSHJ P,QGRLSC
	 JRST QPNLBN	;FILE ALREADY EXISTS
	PUSHJ P,QFNG
QRNAM4:	PUSHJ P,QLOOK
	 JRST QRNAM3
	CAME I,Q	;ALLOW RENAME THAT DOESN'T CHANGE NAMES.
	 JRST QPNL13
QRNAM3:	MOVE Q,I
	MOVSI TT,UNDUMP	;SAY FILE NOT DUMPED.
	ANDCAM TT,UNRNDM(Q)
	MOVNI E,1	;TELL QFREF NOT TO CLOBBER NON-EX DISK CHNL.
	PUSHJ P,QFREF	;"REFERENCE" FILE
	PUSHJ P,QRELOC	;STORE NEW NAMES IN DIR
QRNAM2:	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
QRNAM1:	MOVE U,USER	;U MAY NOT HAVE USER IF CAME HERE FROM LOGOUT
	PUSHJ P,LSWCLR
	JRST POPJ1

QGRLSC:	CAME A,[SIXBIT />/]	;SKIP NONE IF BOTH A+B ARE SPECIAL
	CAMN A,[SIXBIT /</]	;ONCE IF ONE IS
	 SOS (P)
	CAME B,[SIXBIT />/]	;AND TWICE IF NEITHER
	CAMN B,[SIXBIT /</]
	 SOS (P)
	AOS (P)
	JRST POPJ1


;MOVE FILE POINTED TO BY Q SO THAT NEW NAMES A AND B WILL BE IN
;ALPHABETICAL ORDER
QRELOC:	PUSH P,TT
	PUSH P,E
	PUSH P,J
	PUSH P,Q
	PUSH P,D
	PUSH P,W
	PUSH P,R
	PUSHJ P,QLGLK	;SEE WHERE FILE MUST GO
	 BUG		;DIR WAS EMPTY
	HRRZ TT,QSNLCN(H)
QRLOCK:	CAIL J,2000(TT)
	 JRST QRLOCJ
	CAMN A,UNFN1(J)
	CAME B,UNFN2(J)
	 JRST QRLOCJ
	MOVE Q,UNRNDM(J)
	TLNE Q,UNIGFL
	 JRST QRLOCJ
	ADDI J,LUNBLK
	JRST QRLOCK

QRLOCJ:	HRRZ Q,-3(P)	;WHERE FILE IS NOW
	CAIE J,LUNBLK(Q)
	 CAMN J,Q
	  JRST QRLOCS	;SAME PLACE
REPEAT LUNBLK,	PUSH P,.RPCNT(Q)
	CAMG Q,J
	 JRST QRLOCB
	MOVEI TT,(Q)
QRLOCC:	SUBI TT,LUNBLK
	HRLZ D,TT
	HRRI D,LUNBLK(TT)
	BLT D,2*LUNBLK-1(TT)
	CAILE TT,(J)
	 JRST QRLOCC
QRLOCA:
REPEAT LUNBLK,	POP P,LUNBLK-.RPCNT-1(J)
	MOVEM A,UNFN1(J)
	MOVEM B,UNFN2(J)
	HRRZ TT,QSNLCN(H)
	SUB Q,TT
	SUB J,TT
	CAML J,Q
	 JRST QRLOCD
	MOVEI D,LUNBLK
	HRRZ W,J
	HRRZ R,Q
QRLOCE:	MOVSI TT,-NQCHN
QRLOCF:	HRRZ E,QUDPR(TT)
	SKIPL QUSR(TT)
	 CAIE E,(H)
	  JRST QRLOCG
	HRRZ E,QUDFPR(TT)
	CAIN E,(Q)
	 JRST QRLOCI
	CAIL E,(W)
	 CAIL E,(R)
	  JRST QRLOCG
	ADD E,D
	HRRZM E,QUDFPR(TT)
QRLOCG:	AOBJN TT,QRLOCF
QRLOCH:	POP P,R
	POP P,W
	POP P,D
	POP P,Q
	POP P,J
	POP P,E
	POP P,TT
	POPJ P,

QRLOCB:	HRRZ D,Q
	HRLI D,LUNBLK(Q)
	BLT D,-1-LUNBLK(J)
	SUBI J,LUNBLK
	JRST QRLOCA

QRLOCD:	MOVNI D,LUNBLK
	HRRZI W,LUNBLK(Q)
	HRRZI R,LUNBLK(J)
	JRST QRLOCE

QRLOCI:	HRRZM J,QUDFPR(TT)
	JRST QRLOCG

QRLOCS:	MOVEM A,UNFN1(Q)
	MOVEM B,UNFN2(Q)
	JRST QRLOCH

QDEL:	PUSHJ P,QUDLK
	PUSHJ P,QLOOK
	 JRST QDFNF
	MOVE TT,UNRNDM(Q)
	TLNE TT,UNLINK
	 JRST QDEL5A
	LDB J,[UNPKN+UNRNDM(Q)]
QDELTA:	MOVSI I,-NQS
	CAME J,QPKID(I)
	 AOBJN I,.-1
	JUMPGE I,QPKNF6	;PACK OF FILE NOT MOUNTED
QDEL5:	PUSHJ P,QUDULK
	PUSHJ P,QDELA
	 JRST QDFNF	;GONE AWAY BETWEEN LOCKS
	JRST QRNAM1

QDEL5A:	;DELETE LINK
	MOVE I,MDSK	;RANDOM EXISTANT UNIT
	JRST QDEL5

QPKNF6:	PUSHJ P,QUDULK
	PUSHJ P,QPKNFP	;MAYBE JUST TUT NOT IN YET?
	 JRST QDEL	;YUP, GOT IT NOW, TRY AGAIN
	PUSHJ P,QUDLK	;NO, FILE IS ON NOT-MOUNTED PACK
	PUSHJ P,QLOOK	;SO GET IT AGAIN
	 JRST QDFNF	;GONE AWAY BETWEEN LOCKS, LOSE
			;AND DELETE IT WITHOUT HACKING TUT
QDFPK:	LDB A,[UNDSCP+UNRNDM(Q)]	;POINTER TO DESCRIPTION AREA
	PUSHJ P,QSQSH	;REMOVE ENTRY
	IDIVI A,UFDBPW
	ADD A,QSNLCN(H)
	ADDI A,UDDESC
	HLL A,QBTBLI(B)
	MOVEI C,0
QNFDL2:	ILDB B,A
	DPB C,A
	TRNE B,40
	 JRST QNFDL3
	JUMPN B,QNFDL2
	JRST QRNAM2

QNFDL3:	REPEAT NXLBYT,[IDPB C,A
]
	JRST QNFDL2

IFN QAUTHP,[
QAUTH:	PUSH P,B	;STORE UFD INDEX OF FILE'S CREATOR
	PUSH P,C	;THIS IS NOT ALLOWED TO PCLSR.  WE SEARCH THE MFD
	PUSH P,J	;WITHOUT LOCKING IT WHICH SHOULD BE ALL RIGHT SINCE
	PUSH P,I	;UFD'S DON'T MOVE AROUND AND THE MFD IS WIRED IN 1 PLACE IN CORE.
	MOVE J,QSNMI(H)
	MOVE C,UNAME(U)
	CAMN C,QSNUD(H)
	 JRST QAUTH1	;UNAME = SNAME
	PUSHJ P,QFL0
	 SKIPA 		;NOT FOUND IN MFD
	  JRST QAUTH1
	SETZM C
	MOVEI J,5	;STRIP OFF ANY NUMERICS
	MOVE TT,[440600,,UNAME(U)]
	MOVE I,[440600,,C]
	ILDB B,TT
	IDPB B,I
QAUTH2:	ILDB B,TT
	CAIG B,'Z
	CAIGE B,'A
	 JRST QAUTH3
	IDPB B,I
	SOJG J,QAUTH2
	SKIPA		;NO NON-LETTERS

QAUTH3:	PUSHJ P,QFL0
	 SKIPA C,HSNAME(U)	;CAN'T CONVERT UNAME IN ANY FORM, TRY HSNAME AS LAST RESORT
	  JRST QAUTH1
	PUSHJ P,QFL0
	 SETOM J		;CAN'T ENCODE AUTHOR AT ALL
QAUTH1:	DPB J,[UNAUTH+UNREF(Q)]
	POP P,I
	POP P,J
	POP P,C
	POP P,B
	POPJ P,
]		;END IFN QAUTHP
.ELSE QAUTH==CPOPJ

;Q=0 => LOOK UP FILE TO DELETE
;Q .NE. 0 => DELETE FILE POINTED TO BY QUDFPR OF CHNL IN D
;H MUST HAVE DIR SLOT INDEX
QDELA:	MOVEI Q,0
QDLA1:	PUSHJ P,SLUGH
	    QCHSW
	    1000,,QSNLCN(H)
	    1000,,QTUTO(I)
	JUMPN Q,QDLA2
	PUSHJ P,QLOOK
	 JRST QDEL4A	;FNF
	SETO D,		;NO ASSOCIATED CHANNEL
QDLA3:	LDB A,[UNLNKB+UNRNDM(Q)]
	LDB TT,[UNPKN+UNRNDM(Q)]
	CAME TT,J
	 JUMPE A,QDELA1	;ON DIFFERENT DISK (DIDN'T LOCK RIGHT TUT TRY AGAIN)
	MOVE A,Q
	SUB A,QSNLCN(H)
	MOVSI J,-NQCHN
QDEL1:	CAIN D,(J)
	 JRST QDEL2	;IGNORE CHANNEL (IF ANY) WHOSE CLOSING CAUSED THIS
	HRRZ TT,QUDPR(J)
	SKIPL QSCRW(J)	;ONLY LOOK AT READ CHNLS
	 CAIE TT,(H)
	  JRST QDEL2
	HRRZ TT,QUDFPR(J)
	SKIPL QUSR(J)
	 CAIE TT,(A)
	  JRST QDEL2
	MOVSI TT,%QADEL		;FOUND CHNL WITH THIS FILE OPEN
	IORM TT,QSRAC(J)	;DELETE FILE WHEN THIS CHNL CLOSED
	MOVSI TT,UNCDEL		;SET DELETED BIT
	IORM TT,UNRNDM(Q)
QDEL4:	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
	MOVE TT,DCHBT(I)
	IORM TT,QTUTO(I)
QDEL4B:	PUSHJ P,QTULK
	PUSHJ P,QUDULK
	PUSHJ P,LSWPOP
	JRST POPJ1

QDLA2:	MOVE Q,QUDFPR(D)	;COMPUTE FILE ADR FROM CHNL IN D
	ADD Q,QSNLCN(H)	;DIR MAY HAVE MOVED
	JRST QDLA3

QDEL4A:	SOS (P)
	JRST QDEL4B

QCDLWO:	PUSH P,R	;OUTPUT CLOSE BUT FILE WAS DELEWO'ED
	SETZM QSCRW(D)	;FAKE OUT ERROR CHECK AT QSQSH6
	PUSHJ P,QUDULK
QSICLD:	MOVE H,QUDPR(D)	;ENTRY FROM INPUT CLOSE, FILE WAS DELETED
	MOVE I,QDSKN(D)
	PUSHJ P,QUDLK
	MOVE Q,QSNLCN(H)
	ADD Q,QUDFPR(D)
	MOVE J,QPKID(I)
	PUSHJ P,QUDULK
	PUSH P,D
	PUSHJ P,QDLA1
	 BUG		;FILE ISNT THERE?
	POP P,D
	MOVE H,QUDPR(D)	;DIRECTORY NUMBER
	SETOM QUSR(D)	;FREE THE DISK CHANNEL
	AOS QFCHN
	JRST QICLX

QDELA1:	PUSHJ P,QDEL4B	;NOT OUR DISK IN J
	 JFCL
	MOVE J,TT	;DISK ITS REALLY ON
QDELA2:	MOVSI I,-NQS	;TRANSLATE PACK # IN J TO DRIVE # IN I
	CAME J,QPKID(I)
	  AOBJN I,.-1
	JUMPGE I,QPKNF1
	JRST QDELA

QSOCLD:	PUSH P,D	;DELETE FILE WHEN CLOSING OVER IT
	PUSH P,R
	LDB J,[UNPKN+UNRNDM(Q)]
	PUSHJ P,QUDULK
	PUSHJ P,QDELA2
	 JFCL
QPKNF7:	POP P,R
	POP P,D
	POPJ P,

QPKNF1:	PUSHJ P,QPKNFP	;MAYBE TUT NOT IN YET?
	 JRST QDELA2	;YUP, TRY AGAIN
	PUSHJ P,QUDLK
	PUSHJ P,QLOOK
	 JRST QUDULK	;GONE AWAY BETWEEN LOCKS
	JRST QDFPK	;GO DELETE OFF OF NON-MOUNTED PACK

QDL2:	PUSHJ P,QTULK	;DELETE LINK
	MOVEI T,2
	PUSHJ P,LSWPON	;UNLOCK QCHSW
QDLINK:	LDB E,[UNDSCP+UNRNDM(Q)]
	IDIVI E,UFDBPW
	ADD E,QSNLCN(H)
	ADDI E,UDDESC
	HLL E,QBTBLI(TT)
	ILDB A,E
	SKIPN E
	 BUG		;NULL LINK?
	MOVEI B,0
QDL1:	DPB B,E			;CLEAR OUT THE CHAR
	CAIN A,':
	 IDPB B,E		;CLEAR A QUOTED CHAR WITHOUT LOOKING AT IT
	ILDB A,E
	JUMPN A,QDL1
	PUSHJ P,QSQSH	;REMOVE ENTRY
	MOVE TT,QACTB
	IORM TT,QSNLCN(H)
	PUSHJ P,QUDULK
	JRST POPJ1

QDEL2:	AOBJN J,QDEL1		;CHECK NEXT DISK CHANNEL
	MOVE C,UNRNDM(Q)	;NOT OPEN, SO REALLY DELETE IT
	TLNE C,UNLINK
	 JRST QDL2
	ANDI C,.BM UNDSCP
	IDIVI C,UFDBPW
	ADD C,QSNLCN(H)
	ADDI C,UDDESC
	HLL C,QBTBLI(D)		;GET DESCRIPTOR POINTER IN C AND TT
	MOVE TT,C
	MOVEI A,0
	PUSHJ P,NFLLN1		;A GETS NUMBER OF BLOCKS IN FILE
	PUSH P,A
	SKIPN D,QSFBT(H)	;SEE IF ENOUGH QSFBT STORAGE EXISTS
	 JRST QDEL11
QDEL10:	HLRE B,(D)		;NUMBER OF FREE LOCATIONS IN THIS PAGE
	ADD A,B			;DECREASE LOCATIONS NEEDED
	MOVE D,1(D)		;CDR
	JUMPN D,QDEL10
QDEL11:	JUMPLE A,QDEL12		;JUMP IF SUFFICIENT STORAGE EXISTS
	PUSHJ P,TCALL		;GET MORE
	    JRST IOMQ
	 JRST [	MOVE U,USER	;U MAY NOT HAVE USER IF CAME FROM LOGOUT
		PUSHJ P,LSWCLR	;HAVE TO WAIT FOR MEMORY
		PUSHJ P,MQTEST	;AVOID DEADLOCKS BY UNLOCKING EVERYTHING
		 PUSHJ P,UFLS
		JRST UUOTRO ]
	MOVEI D,MU23FB
	DPB D,[MUR,,MEMBLT(A)]
	LSH A,10.
	MOVEI D,2(A)
	HRLI D,-1776
	MOVEM D,(A)
	MOVE D,A
	EXCH A,QSFBT(H)		;ADD TO FRONT OF LIST
	MOVEM A,1(D)
	MOVE A,(P)		;GET BACK NUMBER OF BLOCKS NEEDED
	JRST QDEL10		;SEE IF THERE ARE ENOUGH NOW

QDEL12:	POP P,A			;GET RID OF BLOCKS COUNT
	PUSHJ P,QSQSH		;REMOVE ENTRY, CANNOT PCLSR AFTER THIS
	CLEARB J,D		;J GETS NUMERIC TRACK NUMBER, D BYTE POINTER TO TUT
	MOVE TT,QTUTO(I)	;D ZERO SO WILL HALT IF DESC DOESN'T START WITH LOAD-ADDR!
	MOVE Q,QSFBT(H)		;Q -> AOBJN POINTER FOR STORING BLOCK NUMBERS
QDEL3:	ILDB B,C		; INTO QSFBT AS DESCRIPTORS ARE ZEROED OUT
	MOVEI A,0		;I DISK, C BP TO DESCRIPTOR, A,B,E TEMP.
	DPB A,C
	JUMPE B,QDEL4		;END OF FILE DESCRIPTION
	TRNE B,40
	 JRST QDEL6
	CAILE B,UDTKMX
	 JRST QDEL7
QDEL8:	SKIPN Q
	 BUG			;OOPS, OUT OF QSFBT STORAGE
	SKIPL E,(Q)		;PICK UP AOBJN POINTER
	 JRST [	MOVE Q,1(Q)	;THIS PAGE FULL, TRY NEXT
		JRST QDEL8 ]
	MOVEM J,(E)		;STORE DISK,,BLOCK FOR LATER FREEING
	AOBJN E,.+1
	MOVEM E,(Q)		;INCREMENT POINTER
	MOVE E,QSNLCN(H)	;DECREASE DIR'S BLOCKS-USED
	HRRZ A,UDBLKS(E)
	SOSL A
	 HRRM A,UDBLKS(E)
	ILDB A,D		;CHECK TUT
	SKIPN A
	 BUG			;TUT SHOWS TRACK NOT USED
	AOS J			;DO NEXT BLOCK IN CONTIGUOUS GROUP
	SOJG B,QDEL8
	JRST QDEL3

IFN NXLBYT-2, .ERR THIS ROUTINE AND OTHERS KNOW IMPLICITLY THAT NXLBYT=2
QDEL6:	MOVEI D,0		;LOAD ADDRESS
	DPB B,[140500,,D]
	ILDB B,C
	DPB B,[060600,,D]
	DPB A,C			;A HAS ZERO FROM QDEL3
	ILDB B,C
	DPB B,[0600,,D]
	DPB A,C
	MOVE J,D
	HRL J,I
	PUSHJ P,TUTPNT
	ADD D,[TUTBYT_14,,]	;MAKE INTO ILDB-TYPE POINTER
	JRST QDEL7A

QDEL7:	CAIN B,UDWPH
	 JRST QDEL3
	SUBI B,UDTKMX
	ADD J,B
	IBP D
	SOJG B,.-1
QDEL7A:	MOVEI B,1	;LOAD ADDRESS OR SKIP AND TAKE, SO ONLY ONE TRACK
	JRST QDEL8

QDFNF:	PUSHJ P,OPNL4
	JRST URET

QDELB:	CONO PI,UTCON
	JRST QDELA

;PERFORM BLOCK-FREEING SPECIFIED BY QFBTS
QDLFBT:	CONO PI,UTCOFF		;PROTECT QFBTS
	SKIPN B,QFBTS
	 JRST UTCONJ
	MOVE T,1(B)
	MOVEM T,QFBTS
	CONO PI,UTCON
	HRRZ T,(B)		;FIRST FREE LOCATION
	SUBI T,2(B)		;NUMBER OF LOCATIONS TO DO
	HRLO A,T
	EQVI A,1(B)
	AOBJP A,QDLFB9		;A NOW -> BLOCKS TO FREE, & CHECK FOR EMPTY
	SETO I,			;NO TUT LOCKED YET
QDLFB1:	HLRZ J,(A)		;DISK NUMBER
	CAMN J,I		;MAKE SURE RIGHT TUT IS LOCKED
	 JRST QDLFB2
	SKIPL I
	 PUSHJ P,QTULK
	MOVE I,J
	PUSHJ P,QTLOCK
QDLFB2:	HRRZ D,(A)		;BLOCK NUMBER TO FREE
	PUSHJ P,TUTPNT
	CAIGE B,TUTMNY		;USED IN "MANY" FILES(1,2,...,TUTMNY,TUTLK)
	 SOJL B,[JRST 4,.]	;HALT IF TUT SHOWS TRACK NOT USED
	JUMPN B,QDLFB3		;NOT LAST USE
	HRRZ T,(A)		;BLOCK NUMBER AGAIN
	MOVE TT,QTUTO(I)
	CAML T,QSWAPA(TT)
	 AOSA QSFT(I)
	  AOS QSFTS(I)		;TRACK IN SWAPPING AREA
QDLFB3:	DPB B,D			;DECREASE USAGE COUNT IN TUT
	AOBJN A,QDLFB1
	PUSHJ P,QTULK
QDLFB9:	MOVEI A,-1(A)		;GET AN ADDRESS ON THAT PAGE
	LSH A,-10.		;DONE WITH THIS PAGE, FREE IT
	PUSHJ P,TMEMR		;RETURN PAGE TO FREE AND TRY FOR MORE
	    MU23FB
	JRST QDLFBT

;REMOVE HOLE FROM NAME AREA AT Q
QSQSH:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,TT
	HRRZ TT,QSNLCN(H)
	MOVE A,UDNAMP(TT)
	CAILE A,2000
	 BUG		;UDNAMP BAD
	ADDI A,(TT)
	HRRZ C,Q
	SUB C,A
	SKIPL C
	CAIL C,2000-UDDESC
	 BUG		;Q BAD
	HRRZ C,Q
QSQSH1:	SUBI C,LUNBLK
	CAMLE A,C
	 JRST QSQSH2
	HRLZ B,C
	HRRI B,LUNBLK(C)
	BLT B,2*LUNBLK-1(C)
	JRST QSQSH1

QSQSH2:
REPEAT LUNBLK,SETZM .RPCNT(A)
	SUBI A,-LUNBLK(TT)
	HRRZM A,UDNAMP(TT)
	HRRZ C,Q
	SUBI C,(TT)	;INDEX OF DELETED FILE
	HRRZI TT,-LUNBLK(A)	;INDEX OF OLD BEGINNING OF NAME AREA
	MOVSI A,-NQCHN
QSQSH3:	HRRZ B,QUDPR(A)
	SKIPL QUSR(A)
	 CAIE B,(H)
	  JRST QSQSH4
	SKIPN B,QUDFPR(A)
	 JRST QSQSH4
	CAIGE B,(TT)
	 BUG
	CAIN B,(C)
	 JRST QSQSH6	;PNTR TO FLUSHED HOLE, CHECK IF READ CHNL
	CAIG B,(C)	;IF AFTER DELETED FILE DON'T RELOCATE
	 ADDI B,LUNBLK
	HRRZM B,QUDFPR(A)
	SKIPL QSCRW(A)
	 JRST QSQSH4	;READ CHNL
	ADD B,QSNLCN(H)
	MOVE B,UNRNDM(B)
	TLNN B,UNWRIT
	 BUG		;CHNL WRITING BUT BEING WRITTEN BIT NOT SET
QSQSH4:	AOBJN A,QSQSH3
	POP P,TT
	POP P,C
	POP P,B
	POP P,A
	POPJ P,

QSQSH6:	MOVE B,QSRAC(A)	;FOUND PNTR TO DELETED FILE
	TLNE B,%QADEL	;SKIP IF NOT DELETE AFTER CLOSE
	 SKIPGE QSCRW(A) ;ALSO ERROR IF NOT READ CHNL
	  BUG
	JRST QSQSH4	;WAS DELETE AFTER CLOSE ON READ CHNL

SUBTTL DIRECTORY LOOK UP, > FEATURE

;A contains the FN1 and B contains the FN2.
;H is the index of the directory slot.  The dir must be locked.

;Returns the address of the filename block in Q.
;Clobbers C.

;Internally, J and Q point to the bottom and top of the
;area of the dir we are still searching.
;Bit 4.9 of J is set to indicate one of the names is ">".
;C used as a flag: sign bit says creating a file.
;Bit 1.1 of C says FN2 is > or <.

;Look for place to create new file,
;and generate new version for >.
QFNG:	MOVEM Q,EPDL3(U)
	SKIPA C,[SETZ]
;Look for existing files only
QLOOK:	 MOVEI C,0
	PUSH P,J
	HRRZ J,QSNLCN(H)
	MOVEI Q,2000-LUNBLK(J)
	ADD J,UDNAMP(J)
	CAMN A,[SIXBIT />/]
	 TLOA J,400000
	  CAMN A,[SIXBIT /</]
	   JRST QLOOKA	;4.9 BIT OF J SET IF >
	CAMN B,[SIXBIT />/]
	 TLOA J,400000
	  CAMN B,[SIXBIT /</]
	   AOJA C,QLOOK1
	PUSHJ P,QLGLK
	 JRST POPJJ	;FNF
	TRNN J,1777
	 JRST POPJJ	;J IS OFF THE END OF THE BLOCK
	PUSH P,C
	EXCH Q,J
QLK1:	CAMN A,UNFN1(Q)
	 CAME B,UNFN2(Q)
	  JRST QLK3	;FNF
	MOVE C,UNRNDM(Q)
	TLNN C,UNIGFL	;BEING WRITTEN OR DELETED
	 JRST QLK2	;FOUND IT
	SUBI Q,LUNBLK	;SEARCH THROUGH * FILES
	CAML Q,J
	 JRST QLK1
QLK3:	POP P,C
	JRST POPJJ

QLK2:	AOS -2(P)
	JRST QLK3

QFNF2:	SUB P,[2,,2]
	JRST OPNL4

	;REFERENCE FILE POINTED TO BY Q
QFREF:	LDB C,[UNREFD+UNREF(Q)]
	CAME E,[-1]	;IF A DISK CHNL IN USE,
	 HRLM C,OLDRDT(E) ;SAVE OLD REF DATE IN DSK CHNL VAR
	SKIPGE T,QDATE		; If date unknown
	 POPJ P,		; don't clobber
	HLRZ T,T		; Just get date part
	CAMN C,T		; If same as old date
	 POPJ P,		; no need to do anything
	DPB T,[UNREFD+UNREF(Q)]
	MOVE T,MDSK	;MAKE MDSK WRITE OUT
	MOVE T,DCHBT(T)
	IORM T,QSNLCN(H)
	POPJ P,

QLOOKA:	CAME B,[SIXBIT /</]
	CAMN B,[SIXBIT />/]
	 JRST POPJJ	;MUST BE READ RETN FILE NOT FOUND
QLOOK1:	JUMPGE C,QLOOK9
	CAMN B,[SIXBIT /</]
	 TLO J,400000	;IF WRITING, TURN "<" INTO ">"
QLOOK9:	PUSH P,D
	PUSH P,TT
	PUSH P,I
	PUSH P,[-1]	;BEST INDEX
	PUSH P,[SETZ]	;BEST "NUMERIC" PART
	PUSH P,[SETZ]	;BEST ALPHA PART
QLOOK4:	CAIGE Q,(J)
	 JRST QLOOK2
	XCT QLKI1(C)
	 JRST QLOOK3
	MOVE D,UNRNDM(Q)
	TLNE D,UNIGFL
	 JUMPGE C,[ SKIPGE -2(P)	;FILE LOCKED, REMEMBER IT IF WE HAVE NO BETTER,
		     HRRM Q,-2(P)	; BUT DON'T CONSIDER IT IF READING
		    JRST QLOOK3 ]	;BUT IF WRITING, CONSIDER ALL FILES
	SKIPE TT,@QLKI1+1(C)
QLOOK6:	 TRNE TT,77	;RIGHT ADJ
	  JRST QLOOK5
	LSH TT,-6
	JRST QLOOK6

QLOOK5:	MOVEI I,0
QLOOK8:	LDB D,[600,,TT]
	CAIL D,'0
	CAILE D,'9
	 JRST QLOOK7	;NOT A DIGIT
QLOK5B:	TRNE I,77	;RIGHT ADJ LOW NON NUM PART
	 JRST QLOK5A
	LSH I,-6
	JUMPN I,QLOK5B
QLOK5A:	TLC TT,400000	;AVOID CAM LOSSAGE
	TLC I,400000
	SKIPGE -2(P)
	 JRST QLOK5D	;FIRST MATCH
	JUMPGE J,QLOK5E	;GET LEAST
	CAMGE TT,-1(P)	;GET GREATEST
	 JRST QLOOK3
	CAME TT,-1(P)
	 JRST QLOK5D
	CAMGE I,(P)
	 JRST QLOOK3	;NOT AS GOOD
QLOK5D:	HRRZM Q,-2(P)
	MOVEM TT,-1(P)
	MOVEM I,(P)
QLOOK3:	SUBI Q,LUNBLK
	JRST QLOOK4

QLOK5E:	CAMLE TT,-1(P)
	 JRST QLOOK3
	CAME TT,-1(P)
	 JRST QLOK5D
	CAMLE I,(P)
	 JRST QLOOK3
	JRST QLOK5D

QLOOK7:	LSHC TT,-6	;LOW DIGIT NOT NUMERIC
	JUMPN TT,QLOOK8	;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?)
	JUMPL J,QLOK5B	;IF LOOKING FOR GREATEST, LET THIS BE LEAST
	MOVNI TT,1	;GREATEST IF LOOKING FOR LEAST
	JRST QLOK5B

QLOOK2:	JUMPL C,QFNG1	;REALLY WANT TO MAKE F.N.'S FOR WRITE
	SUB P,[1,,1]
	POP P,C	;BEST "NUMERIC" PART
	POP P,Q	;ADR
	POP P,I
	POP P,TT
	POP P,D
	AOJE Q,POPJJ
	MOVE A,UNFN1-1(Q)	;ACTUAL MATCHED FILE NAMES
	MOVE B,UNFN2-1(Q)
	SOJGE Q,POPJJ1		;FOUND A FILE THAT WASN'T LOCKED
	MOVEI Q,-LUNBLK(Q)
	JRST POPJJ

QFNG1:	SKIPGE -2(P)
	 JRST QFNG2	;NOT FOUND START W/ 1
	MOVE TT,-1(P)
	TLC TT,400000
	MOVE I,[600,,TT]
QFNG3:	LDB D,I
	CAIL D,'0
	CAILE D,'9
	 JRST QFNG4	;REACH END OF NUMERIC FIELD
	AOS D
	CAILE D,'9
	 JRST QFNG5
	DPB D,I
QFNG5A:	TLNE TT,770000
	 JRST QFNG3A
	LSH TT,6
	JRST QFNG5A

QFNG2:	MOVSI TT,(SIXBIT /1/)
QFNG3A:	MOVEM TT,A(C)	;STORE INTO A OR B AS APPRO
	SUB P,[3,,3]
	POP P,I
	POP P,TT
	POP P,D
	MOVE Q,EPDL3(U)
	JRST POPJJ

QFNG5:	MOVEI D,'0
	DPB D,I
	ADD I,[60000,,]
	JUMPL I,QFNG5A
	JRST QFNG3

QFNG4:	TLNN TT,770000	;SKIP ON ALREADY 6 CHAR NAME
	 LSH TT,6
	MOVEI D,'1
	DPB D,I
	MOVEI D,'0
QFNG4B:	TLNN I,770000
	 JRST QFNG5A
	IDPB D,I
	JRST QFNG4B

QLKI1:	CAME B,UNFN2(Q)
	CAME A,UNFN1(Q)
	UNFN2(Q)

QPKNF:	MOVE C,QSNUD(H)
	PUSHJ P,QUDULK	;UNLOCK DIR
	PUSHJ P,LSWPOP	;QUSR ENTRY
	PUSHJ P,LSWPOP	;QSNNR ENTRY
	PUSHJ P,QPKNFP
	 JRST QSKOL
	PUSHJ P,OPNL16	;PACK NOT MOUNTED
	JRST URET

QPKNFP:	MOVSI I,-NQS
QPKNF3:	SKIPGE QACT(I)
	 JRST QPKNF4
	MOVE TT,QTUTO(I)
	SKIPL QDPWF(I)
	 TLNE TT,40000
	  JRST QPKNF2	;PACK NOT IN OR NOT PAWED OVER
QPKNF4:	AOBJN I,QPKNF3
	JRST POPJ1

QPKNF2:	JRST QTCH1	;MAYBE THIS UNIT HAS GOODIES

QFDF:	PUSHJ P,OPNL5	;FILE DIR FULL ON WRITE
	JRST URET

QPNL13:	PUSHJ P,OPNL13
	JRST URET

QPNL22:	PUSHJ P,OPNL22
	JRST URET

QPNLBN:
QPNL11:	PUSHJ P,OPNL11
	JRST URET

;ROUTINE TO FIND PLACE IN DIRECTORY WHERE A B WOULD GO
;SKIPS ONLY IF DIRECTORY CONTAINS AT LEAST ONE FILE
;FOR INSERTION, FILE GOES BEFORE PNTR RETURNED IN J
;RETURNS PNTR IN Q TO BEGINNING OF NAME AREA
;(ONLY WORKS FOR LUNBLK = 5)
QLGLK:	HRRZ J,QSNLCN(H)
	HRRZ Q,UDNAMP(J)
	ADDI Q,(J)
	CAIL Q,2000(J)
	 POPJ P,	;DIRECTORY EMPTY
	TLC A,(SETZ)
	TLC B,(SETZ)
	PUSH P,D
	PUSH P,E
	ADDI J,600	;128. NAME BLOCKS FROM END
REPEAT 7,[		;THIS CODE DELIBERATELY NOT INDENTED. NEED 4 DIMENSIONS.
	CAMGE J,Q
	JRST .+6
	MOVE D,UNFN1(J)
	TLC D,(SETZ)
	CAMN A,D
	JSP E,QLGLE
	CAML A,D
	ADDI J,<1_<7-.RPCNT>>*LUNBLK
	SUBI J,<1_<6-.RPCNT>>*LUNBLK
]
	CAMGE J,Q
	 ADDI J,LUNBLK
	CAMGE J,Q
	 BUG
	MOVE D,UNFN1(J)
	TLC D,(SETZ)
	CAME A,D
	 JRST QLGL1
	MOVE D,UNFN2(J)
	TLC D,(SETZ)
	CAMLE B,D
QLGL2:	 ADDI J,LUNBLK
QLGL3:	TLC A,(SETZ)
	TLC B,(SETZ)
	POP P,E
	POP P,D
	JRST POPJ1

QLGL1:	CAML A,D
	 JRST QLGL2
	JRST QLGL3

;CALL BY JSP E,QLGLE
QLGLE:	MOVE D,UNFN2(J)
	TLC D,(SETZ)
	CAMN B,D
	 JRST QLGL3
	CAML B,D
	 JRST 1(E)
	JRST 2(E)

SUBTTL LOCKING ROUTINES

QMLOCK:	PUSHJ P,LSWTL
	    QMDRO
	POPJ P,

QMULK:	PUSH P,U
	MOVE U,USER
	MOVE U,LSWPR(U)
	HRRZ U,(U)
	CAIE U,QMDRO
	 BUG
	POP P,U
	JRST LSWPOP

QTLOCK:	PUSHJ P,LSWTL
	    QTUTO(I)
	POPJ P,

QTULK:	PUSH P,U
	MOVE U,USER
	MOVE U,LSWPR(U)
	HRRZ U,(U)
	CAIE U,QTUTO(I)
	 BUG
	POP P,U
	JRST LSWPOP

QUDLK:	PUSHJ P,LSWTL
	    QSNLCN(H)
	POPJ P,

QUDULK:	PUSH P,U
	MOVE U,USER
	MOVE U,LSWPR(U)
	HRRZ U,(U)
	CAIE U,QSNLCN(H)
	 BUG
	POP P,U
	JRST LSWPOP

SBTBLI:
QBTBLI:	440600,,	;IF GOING TO ILDB
SBTBL:
QBTBL:	360600,,
	300600,,
	220600,,
	140600,,
	060600,,
	000600,,

TBTBL=.+1
TBTBLI:	REPEAT 1+TUTEPW, TUTBP-<.RPCNT*TUTBYT*010000,,>

SUBTTL DIRECTORY GARBAGE COLLECTOR

; MOVE H, directory number
; lock the directory
; PUSHJ P,QGC
;  return if directory full.
;  return if won.
; No ACs clobbered.
; All pointers to directory relocated appropriately.

; Called from disk open routines if a new file is to be created
; and there are less than 6+LUNBLK words in the free area of the directory.
; Called from QSBWG if %QAFUL is set in QSRAC.
; %QAFUL means "must have successful GC before committing another track to this file."

;NOTE NOTE NOTE:
; This GC allocates an extra block of core for temporary storage.
; If no memory is free in low half, waits without unlocking directory.
; Can possibly PCLSR.  No deadly embrace to not unlock directory since
; it can't be flushed from core anyway and it's not holding anything else in.

QAPBMN==NXLBYT+3	;minimum number of descriptor bytes which
			; must be available at the end of a file to
			; commit another track to the file.
			;1 for a take-N, NXLBYT+1 for jump, 1 for ending zero.
QAPBMX==36.		;maximum number of descriptor bytes to allocate at a time.

QGC:	IRPC X,,ABCDQIJTR
	 PUSH P,X
	TERMIN

;Old GC prints message on system console.  Any reason to with fast one?

; validate the directory

QGC00:	SKIPL A,QSNLCN(H)
	 BUG			;directory not locked
	MOVE C,UDNAME(A)
	MOVEM C,LASTGC		;save name of last dir GCed
	CAME C,QSNUD(H)
	 BUG			;directory clobbered
	SKIPLE C,UDNAMP(A)
	CAILE C,2000
	 BUG			;name pointer out of bounds
	IMULI C,UFDBPW
	SKIPL D,UDESCP(A)
	CAIL D,-UDDESC*UFDBPW(C)
	 BUG			;descriptor/name overlap

; Get a block of core to use for temporary storage.
; The block is left in the "in-process" state.

	HRRZ Q,A
	PUSHJ P,TCALL
	    JRST IOMQ
	 JRST [	PUSHJ P,UDELAY	;no core available in low half
		JRST QGC00 ]	;so wait, then loop back to beginning
	LSH A,10.
	MOVEI B,1(A)		;zero it out
	HRL B,A
	SETZM (A)
	BLT B,1777(A)
	EXCH Q,A		;A -> directory, Q -> temporary core
;Drops through
;Drops in
; Scan the directory and count:
;  I	all files
;  J	files open for writing
;  R	active bytes of descriptor

	SETZB I,J
	SETZ R,
	MOVEI B,2000(A)		;end of name area
	ADD A,UDNAMP(A)		;start of name area
QGC10:	CAML A,B
	 JRST QGC19		;jump if all files done
	SKIPE UNFN2(A)
	SKIPN UNFN1(A)
	 BUG			;zero name block?
	AOJA I,QGC12		;file exists

QGC11:	ADDI A,LUNBLK		;advance to next file
	AOJA R,QGC10		;also count the zero byte that ends the descriptor

QGC12:	MOVE C,UNRNDM(A)
	TLNE C,UNWRIT
	 ADDI J,1
	ANDI C,.BM UNDSCP	;get descriptor ptr (undscp has pos=0)
	IDIVI C,UFDBPW
	HLL C,QBTBLI(D)
	ADDI C,UDDESC-2000(B)
	MOVE D,UNRNDM(A)
	TLNE D,UNLINK
	 JRST QGC14
QGC13:	ILDB T,C		;get byte of descrip
	JUMPE T,QGC11		;eof
	CAIG T,UDWPH
	 AOJA R,QGC13		;1-byte desc
REPEAT NXLBYT, IBP C		;multi-byte desc
	ADDI R,NXLBYT+1
	JRST QGC13

QGC14:	ILDB T,C		;count bytes of link descriptor
	JUMPE T,QGC11
	CAIN T,':
	 AOJA R,[IBP C		;quoted
		 AOJA R,QGC14 ]
	AOJA R,QGC14


; Compute number of bytes of descriptor to add after each
; file open for output.  If > QAPBMX, set to QAPBMX.
; If < QAPBMN, take directory-full exit.

QGC19:	MOVE C,I		;save number of files
	IMULI I,LUNBLK*UFDBPW	;number of bytes in name area
	ADDI R,UDDESC*UFDBPW(I)	;R := total number of bytes claimed
	MOVEI A,2000*UFDBPW-1
	SUB A,R			;A := number of bytes left
	SKIPE J
	 IDIV A,J		;number of bytes available to extend open files
	CAIGE A,QAPBMN
	 JRST QGC69		;if < minimum, dir. full
	CAILE A,QAPBMX
	 MOVEI A,QAPBMX		;limit to at most QAPBMX bytes at a time
;Drops through
;Drops in
; A = number of bytes of room to leave after each file open for writing
; B -> name block under consideration
; C -> old descriptors
; D = disk channel number under consideration.  Also D = C+1
; J counts new descriptor bytes generated
; Q -> new descriptors (in temporary core block)
; R -> base of directory

	SETZ J,
	HRRZ R,QSNLCN(H)	;old dir
	ADDI Q,UDDESC		;new dir
	HLL Q,QBTBLI
	MOVE B,UDNAMP(R)
	ADD B,R

; Loop over files

QGC20:	CAIL B,2000(R)
	 JRST QGC40		 ;all files done
	LDB C,[UNDSCP UNRNDM(B)] ;get old desc ptr
	DPB J,[UNDSCP UNRNDM(B)] ;store new desc ptr

; Loop over all disk channels, relocating the ones that point to this file

	MOVSI D,-NQCHN
QGC31:	HRRZ T,QUDPR(D)
	SKIPL QUSR(D)
	 CAIE T,(H)
	  AOBJN D,QGC31		;not in use or not same directory
	JUMPGE D,QGC39		;jump if all disk channels done
	LDB T,[1200,,B]
	CAME T,QUDFPR(D)
	 JRST QGC32		;not same file
	MOVE T,J		;relocate descriptor pointer
	SUB T,C
	ADDM T,QDIRP(D)
QGC32:	AOBJN D,QGC31

QGC39:	IDIVI C,UFDBPW		;make desc pntr into byte pointer
	HLL C,QBTBLI(D)
	ADDI C,UDDESC(R)
	MOVE T,UNRNDM(B)
	TLNE T,UNLINK
	 JRST QGC22
QGC21:	ILDB T,C		;copy descriptor bytes of a file into temporary core
	IDPB T,Q
	JUMPE T,QGC23
	CAIG T,UDWPH
	 AOJA J,QGC21
REPEAT NXLBYT,[
	ILDB T,C
	IDPB T,Q
]	ADDI J,NXLBYT+1
	JRST QGC21

QGC22:	ILDB T,C		;copy descriptor bytes of a link into temporary core
	IDPB T,Q
	JUMPE T,QGC23
	CAIN T,':
	 AOJA J,[ILDB T,C
		 IDPB T,Q
		 AOJA J,QGC22 ]
	AOJA J,QGC22

QGC23:	MOVE T,UNRNDM(B)
	TLNN T,UNWRIT
	 JRST QGC25
	ADD J,A			;file being written, increase desc area
	MOVE T,A
	IBP Q
	SOJG T,.-1

QGC25:	ADDI B,LUNBLK		;next file
	AOJA J,QGC20		;also account for final zero at end of descriptor

; Paranoia:  check that all disk channels to this directory look OK

QGC40:	MOVEM J,UDESCP(R)	;store free-desc pointer
	LDB A,[1200,,Q]		;last word used by descriptors
	CAML A,UDNAMP(R)
	 BUG			;overlap
	ANDI Q,-2000		;base of temp core block again
	MOVSI A,-NQCHN
QGC41:	HRRZ T,QUDPR(A)
	SKIPL QUSR(A)
	 CAIE T,(H)
	  AOBJN A,QGC41		;channel not in use, or to some other dir
	JUMPGE A,QGC49		;all channels done
	SKIPN B,QUDFPR(A)	;get file open on this channel
	 JRST QGC42		;channel not set up to any particular file
	CAIGE B,2000
	 CAMGE B,UDNAMP(R)
	  BUG			;file pointer screwed
	ADD B,R
	SKIPL J,QDIRP(A)	;get descriptor pointer
	 CAMLE J,UDESCP(R)
	  BUG			;descriptor pointer screwed
	LDB C,[UNDSCP UNRNDM(B)]
	CAIGE B,2000-LUNBLK(R)	;skip if last file in dir
	 LDB D,[UNDSCP UNRNDM+LUNBLK(B)] ;else get desc pntr for next file
	CAIL B,2000-LUNBLK(R)
	 MOVEI D,2000*UFDBPW	;but if last file, get infinity
	CAML J,C		;verify that QDIRP points to this file
	 CAML J,D
	  BUG
QGC42:	AOBJN A,QGC41		;do next channel

; If you thought that was paranoid, get a load of this:

QGC49:	MOVE B,UDNAMP(R)
	ADD B,R
QGC50:	CAIL B,2000(R)
	 JRST QGC60
	LDB C,[UNDSCP UNRNDM(B)]
	SOS C
	IDIVI C,UFDBPW		;NOTE if UNDSCP = 0 we depend on bytes
	HLL C,QBTBL(D)		; off left end of word LDB'ing as zero
	ADDI C,UDDESC(Q)
	LDB T,C
	SKIPE T
	 BUG			;descriptor not preceeded by zero
	MOVE J,UNRNDM(B)
	TRZ J,#.BM UNDSCP	;LH(J) flags, RH(J) just desc pntr
	TLNE J,UNLINK
	 JRST QGC52
QGC51:	ILDB T,C
	JUMPE T,QGC53
	CAIG T,UDWPH
	 AOJA J,QGC51
REPEAT NXLBYT, IBP C
	ADDI J,NXLBYT+1
	JRST QGC51

QGC52:	ILDB T,C
	JUMPE T,QGC53
	CAIE T,':
	 AOJA J,QGC52
	IBP C
	ADDI J,2
	JRST QGC52

QGC53:	TLNE J,UNWRIT		;RH(J) has desc pntr to the zero that ends the file
	 ADDI J,QAPBMN		;if being written, needs room for one more track
	CAIL B,2000-LUNBLK(R)	;now set D to point to next descriptor area
	 SKIPA D,UDESCP(R)	;do this instr if last file in dir
	  LDB D,[UNDSCP UNRNDM+LUNBLK(B)]	;else get next file's desc pntr
	CAIG D,(J)
	 BUG			;descriptors overlap
	ADDI B,LUNBLK	
	JRST QGC50

; Copy the descriptors back into the directory

QGC60:	MOVSI C,UDDESC(Q)	;make BLT pointer to copy it back
	HRRI C,UDDESC(R)
	MOVE B,UDNAMP(R)	;use same BLT to zero out the free area
	ADD B,R
	BLT C,-1(B)

; Take win return.

	AOS -9(P)
QGC69:	LDB A,[121000,,Q]	;core block number of temporary page
	PUSHJ P,TMEMR		;return it
	    MUINP		;verifying that it is the right one.
	IRPC X,,RTJIQDCBA
	 POP P,X
	TERMIN
	POPJ P,

SUBTTL INTERPRET DESCRIPTORS

QFNTR:	MOVE H,QUDPR(A)	;BYTE # IN Q CHNL # IN A
	PUSHJ P,QUDLK	;DONT SKIP IF OFF FILE
	MOVE T,QSNLCN(H) ;RETN BLOCK IN QSLGL(A) AND QSBI(A)  DIR PNTR IN QDIRP(A)
	ADD T,QUDFPR(A)	;FIRST ADR OF BLOCK IN QFBLNO(A)
	LDB TT,[UNDSCP+UNRNDM(T)]	;CHAR ADR OF FILE BEG
	MOVEM TT,QDIRP(A)	;SKIPS IF FINDS BLOCK AND LEAVES USER DIR LOCKED
	CLEARM QSBI(A)
	CLEARM QFBLNO(A)
	CLEARB J,QSLGL(A)	;J HAS ORG OF FIRST NON-EX-BLOCK IF OFF END OF FILE
QFNT1A:	PUSHJ P,QFNT1
	 JRST QUDULK	;OFF END OF FILE RETN NOT SKIPPING
	CAMLE J,Q
	 JRST QFNT7	;LOCATED BLOCK CONTAINING WORD
	MOVEM J,QFBLNO(A)
	JRST QFNT1A

QFNTN:	MOVE H,QUDPR(A)	;LIKE ABOVE BUT SCAN FORWARD ONLY FROM CURRENT SPOT
	PUSHJ P,QUDLK
	PUSHJ P,QFNT1
	 CAIA		;EOF, DON'T SKIP RETURN
	  AOS (P)
	MOVEM J,QFBLNO(A)
	JRST QUDULK

QFNT1:	SKIPE QSBI(A)	;DECODE NEXT BLOCK, CHNL IN A, SKIP UNLESS EOF.
	 JRST QFNT2	;BLOCK # IN QSLGL FILE ADR IN J (TAKE N PENDING)
QFNT3:	PUSHJ P,QMPDCH	;GOBBLE NEXT CHR OF DESC IN R (POINTED TO BY QDIRP) INCR QDIRP
	CAIN R,UDWPH	;ALSO RET BYTE PNTR IN TT
	 JRST QFNT3	;NULL
	JUMPN R,QFNT8	;NOT OFF END OF FILE
	SOS QDIRP(A)
	POPJ P,

QFNT8:	TRNE R,40
	 JRST QFNT4
	CAILE R,UDTKMX
	 JRST QFNT6	;SKIP AND TAKE
	MOVEM R,QSBI(A)
QFNT2:	SOS QSBI(A)
	AOS QSLGL(A)
QFNT5:	MOVEI J,2000	;ACTIVE BYTES IN BLOCK
	IMULI J,@QSBYTE(A)
	ADD J,QFBLNO(A)
	JRST POPJ1

QFNT7:	MOVSI T,%QALBK	;SET UP PROC LAST BLOCK FLG AND RETN
	ANDCAM T,QSRAC(A)	;CLEAR LAST BLOCK OF FILE BIT
	SKIPE QSBI(A)
	 JRST QFNT7A	;NOT LAST BLOCK
	ILDB R,TT	;GET NEXT CHR IN DIR
	JUMPN R,QFNT7A
	IORM T,QSRAC(A)	;PROCESSING LAST BLOCK
QFNT7A:	AOS QSBI(A)	;FAKE OUT PI ROUTINE WHICH WILL TRY TO INCREMENT
	SOS QSLGL(A)
	JRST POPJ1

QFNT4:	MOVEI J,0	;LOAD ADR
	DPB R,[140400,,J]
	PUSHJ P,QMPDCH
	DPB R,[060600,,J]
	PUSHJ P,QMPDCH
	DPB R,[0600,,J]
	MOVEM J,QSLGL(A)
	JRST QFNT5

QFNT6:	MOVEI J,1-UDTKMX(R)
	ADDM J,QSLGL(A)
	JRST QFNT5
EBLK

SUBTTL DISK CHANNEL DATA AREAS

QBFP:	BLOCK NQCHN	;BUFFER LIST LH LAST RH FIRST
			;READ: PI IN MP OUT.  WRITE: MP IN PI OUT.
SINLST:	BLOCK NQS	;SWAP-IN LISTS FOR EACH DISK
SOUTLS:	BLOCK NQS	;SWAP-OUT LISTS FOR EACH DISK

;READ/WRITE LISTS LINK THROUGH MLO IN MEMBLT.
;LH(MEMPNT) HAS DISK ADDR, RH(MEMPNT) HAS # BYTES IN BLOCK IF FILE READ
;MWC IN MEMBLT HAS WORD COUNT IF WRITE (FOR EXTRA-WORDS)

QFCHN:	NQCHN		;NUMBER OF FREE QSK CHNLS (NOT COUNTING DIR WRITE AND SWAP CHANNELS)

QUSR:	REPEAT NQCHN,-1	;USER
DWUSR:	-1	;0 IF DIR WRITE ACTIVE
SWUSR:	REPEAT NQS,-1	;0 IF SWAP XFER ACTIVE
QDIRP:	BLOCK NQCHN	;CHAR ADR PNTR TO DESC AREA FOR FILE
QSLBLK:	BLOCK NQCHN+NQS+1	;LAST BLOCK NUMBER OF FILE WRITTEN
QSLGL:	BLOCK NQCHN	;LAST QSGL
QSGL:	REPEAT NQCHN+NQS+1,-1	;-1 IDLE + ACTIVE TRACK
			;LAST NQS+1 FOR FD WRITE AND SWAPPING
QSBI:	BLOCK NQCHN	; COUNT CONSECUTIVE BLOCKS
QSBFS:	BLOCK NQCHN	;NUMBER OF BUFFS THIS CHNL +1 IF EOF AT PI WITH QSBFS=0
QPCLSR:	BLOCK NQCHN	;PCLSR STATUS OF MAIN PROGRAM - LOAD SYSTEM CALL
QSMDN:	BLOCK NQCHN	;MAIN PRGM ACTIVE BUFFER NUM
OLDRDT:	BLOCK NQCHN	;STORAGE FOR PREVIOUS REFERENCE DATE
QSRAC:	BLOCK NQCHN+1
	REPEAT NQS, %QMSWP ;SWAPPING CHANNELS START OUT IN SWAP MODE
 %QA==525252(1)
 %QALOK==400000		;4.9 CHNL LOCKED (NOT USED)
 %QAEFR==200000		;4.8 EOF REACHED READ
 %QAEFW==100000		;4.7 EOF WRITE
 %QACTH==40000		;4.6 DONT RELOAD. CORE JOB HUNG ON ACTIVE BUFFER
 %QAFUL==20000		;4.5 GC DIR BEFORE COMMITTING ANOTHER BLOCK TO FILE
 %QADEL==10000		;4.4 DELETE WHEN CLOSED
 %QAACC==4000		;4.3 FILE ADDRESS ALTERED BY .ACCESS OR OTHERWISE
 %QAPAR==2000		;4.2 NON RECOV PARITY ERR (OR OTHER DISK ERR) AT PI
 %QAOUT==1000		;4.1 ASSOC USER OUT DONT RELOAD (NOT IMPLEM.)
 %QALBK==400		;3.9 READ CHNL PROCESSING LAST BLOCK FLAG
 %QAMPU==200		;3.8 UPDATE QSMPRP, QSMPRC ON NEXT BUFFER GOBBLE
 %QAWOV==100		;3.7 FILLING OUT LAST BLK OF FILE IN WRITE OVER MODE PAST ORIG EOF
 %QALNK==40		;3.6 FILE IS REALLY A LINK
 %QALOP==20		;3.5 LINKS WERE TRACED IN OPENING THIS FILE.
 %QARWT==10		;3.4 MAKE WOULD-BE READERS WAIT (RATHER THAN GETTING FILE LOCKED ERROR)
 %QAFNY==4		;3.3 "FUNNY BLOCK", WORD COUNT IN LAST WORD
			; 8/20/90 No longer ever gets set.
 $QAMOD==220200		;3.2-3.1 READ/WRITE MODE 0 NORMAL 1 WRITE OVER 2 COPY OVER WRITE
 %QAMWO==1		;3.1=1 => WRITE-OVER MODE.
 %QM==777777		;RH CHANNEL MODE.  INDEX INTO ACTION TABLES USED AT PI LEVEL.
.SEE %QMIDL		;FOR TABLE OF CHANNEL MODES

QDSKN:	BLOCK NQCHN	;DISK UNIT NUMBER
DWSKN:	0		;DISK WRITING DIR ON
SWSKN:	REPEAT NQS,.RPCNT	;DISK SWAP XFER
QSCRW:	BLOCK NQCHN	;0 READ -1 WRITE
	-1		;D.W.
	BLOCK NQS	;SWAP
QSCABN:	BLOCK NQCHN	;ACTIVE BUFFER NUMBER PI LEVEL OR -1 IF NONE
DWABN:	-1		;DISK D.W. A.B.N
SWABN:	REPEAT NQS,-1	;SWAP ABN
QUDPR:	BLOCK NQCHN	;NUMBER OF ASSOCIATED USER DIR PNTR
QUDFPR:	BLOCK NQCHN	;RELATIVE PNTR TO FILE AREA, ZERO IF NO PARTICULAR FILE
QMPTN:	BLOCK NQCHN	;HAS LAST TRACK STORED IN DIRECTORY
QMPTC:	BLOCK NQCHN	;MAIN PRGM TRACK COUNT
QMTTR:	BLOCK NQCHN	;TRACK RESERVED OR -1
QMFTP:	BLOCK NQCHN+1	;TRACK NUMBER FOR SCAN FOR FREE TRACKS IN TUT ON WRITE
	REPEAT NQS,NUDSL; DITTO FOR SWAP CHANNELS
QERRS:	BLOCK NQCHN+NQS+1 ;NUMBER ERRORS TRYING LAST OP
QSMPRP:	BLOCK NQCHN	;MAIN PRGM BYTE POINTER
QSMPRC:	BLOCK NQCHN	;M.P. COUNT (BYTES LEFT IN BUFFER)
QSBYTE:	BLOCK NQCHN	;LH BYTE PNTR (P=44), RH BYTES PER WORD
QSBSIZ==300600,,QSBYTE	;BYTE POINTER TO CHANNEL BYTE SIZE
QFBLNO:	BLOCK NQCHN	;BYTE # IN FILE OF BEG OF BLOCK BEING PROCESSED AT M.P. LEVEL
QRADAD:	BLOCK NQCHN	;DESIRED BYTE ADR (LOOKED AT IF %QAACC OR %QAMPU IN QSRAC SET)
QPIBSZ:	BLOCK NQCHN	;NUMBER OF BYTES IN BLOCK ACTIVE AT P.I. LEVEL (READ)
			;BIT 4.9 => GET FROM LAST WORD IN BLOCK (%QAFNY)
			; 8/20/90 %QAFNY can no longer happen.
QMPBSZ:	BLOCK NQCHN	;NUMBER OF BYTES IN MN PROG ACTIVE BUFFER
QLDPTR:	BLOCK NQCHN	.SEE NLDSBQ ;DURING SBLK LOADING, HOLDS THE AOBJN POINTER
			;INTO USER CORE FOR DOING A DISK TRANSFER ON.
QSMMP:	BLOCK NQS	;MMP ADDRESS OF BLOCK ACTIVE ON SWAPPING CHANNEL

;VARIABLES FOR CURRENT TRANSFER

QSDU:	-1		;UNIT TRANSFERING DATA, -1 IF NONE.
QSDCH:	-1		;CHNL READY TO BE TRANSFERED ON QSDU
QERS1:	-1		;ERR VERIFY SWITCH -1 NO ERR 0 EXPECTING COMPLETION OF VERIFY OP
QDWIP:	0		;NUMBER OF DIR WRITE IN PROGRESS 4.9=1=>MASTER

IFN T300P,[
QSDU1:	-1		;QSDU FOR OTHER CONTROLLER
QSDCH1:	-1		;ASSOCIATED CHANNEL
QTUNT1:	-1		;UNIT TO TRANSFER NEXT
QTCHN1:	-1		;CHANNEL TO TRANSFER NEXT
NRXFR1:	0		;METERS
NWXFR1:	0
NSRXF1:	0
NSWXF1:	0
LQTM1:	0		;TIME LAST TRANSFER STARTED
];T300P

;MASTER FILE DIRECTORY

QMDRO:	-1		;ORIGIN OF MASTER DIR 4.9 IF LOCKED
			;-2 ON WAY IN 
			;4.6 NOT IN
			;4.5, 4.4, 4.3, ... CHANGED + NOT WRITTEN UNIT 0, 1, 2, ...
			;3.2=1 NOT RECONCILED (NQFUS NOT SET UP)
			;3.1-3.5 MUST BE ZERO (AT LEAST AFTER ITS RECONCILED)
QAMDNO:	-1		;ASCENDING MASTER DIRECTORY NUMBER, -1 NOT SET UP
NQFUS:	0		;NUMBER OF FREE LOSER SLOTS IN MFD

;TRACK UTILIZATION TABLES

QTUTO:	REPEAT NQS,-1	;ADDRESS OF TUT.  LH SIMILAR TO QMDRO
			;4.9 LOCK
			;4.8 READ-IN NOT STARTED YET
			;4.6 NOT READ IN YET
			;CHANGED AND NOT WRITTEN ON UNIT
			;0 = 4.5  1 = 4.4  2 = 4.3  3 = 4.2  4 = 4.1
			;5 = 3.9  6 = 3.8
			;3.1-3.5 MUST BE ZERO
QDPWF:	BLOCK NQS	;-1 TUT NOT RECONCILED (CALL QTCH1)
QTWRTM:	BLOCK NQS	;TIME TUT LAST WRITTEN
QSFT:	REPEAT NQS,-1	;NUMBER TRACKS FREE IN USER AREA
QSFTS:	BLOCK NQS	;NUMBER TRACKS FREE IN SWAPPING AREA
QPKNM:	BLOCK NQS	;NAME OF PACK
QPKID:	REPEAT NQS,-1	;PACK ID OF DISK ON DRIVE
IFN QRSRVP,[
QRESRV:	REPEAT NQS,-1	;NON-ZERO => PACK ON THIS DRIVE RESERVED.  SET FROM TUT.
			;NOT 0 AND NOT -1 => SIXBIT DEVICE NAME FOR "SECONDARY" PACK
];QRSRVP
NTBL:	 		;NUMBER OF BLOCKS IN TUT ON THIS DRIVE
IFE T300P, REPEAT NQS, NTUTBL
IFN T300P,[
	REPEAT T300P, NTUTBL
	REPEAT NQS-T300P, NTUTB1
];T300P

;POSITIONER VARIABLES (INDEXED BY PHYSICAL DRIVE)

QSKT1:	REPEAT NQS,-1	;CHANNEL POSITIONER SET FOR OR -1 IF NONE
QRCAL:	REPEAT NQS,0	;-1 IF RECALIBRATING
QSPPS:	REPEAT NQS,-1	;INTENDED POSITIONER POSITION (NOT USED???)
QSEEK:	BLOCK NQS	;-1 IF SEEKING
QPOS:	REPEAT NQS,-1	;CURRENT CYLINDER
QPOSGL:	BLOCK NQS	;CYLINDER TRYING TO POSITION TO
IFN DC10P,[
QRCTIM:	BLOCK NQS	;RECALIBRATE TIMEOUT IN HALF SECONDS.  THE ATTNS
];DC10P			; TEND TO GET LOST FOR SOME REASON

;MISCELLANEOUS DISK VARIABLES

QACT:	REPEAT NQS,0	;ONLY USE UNITS WITH 0
QACTB:	0		;4.5 UNIT 0 ACT  4.4 1 ACT  4.3 2  4.2 3  4.1 4
			;3.9 5  3.8 6
QWBUFS:	0		;TOTAL NUMBER OF WRITE BUFFERS ACTIVE

QWBFMX:	10.*DC10P+15.*RP10P+30.*RH10P+20.*RH11P  ;MAX # ALLOWED.  SHOULD BE
						 ; ABOUT 1 SEC DISK XFER.
QHUNGF:	0		;-1 => DISK CONTROL HUNG, PI LEVEL SHOULD RESET, RECALIBRATE, RETRY
NTQHNG:	BLOCK NQS	;NUMBER OF TIMES TRANSFER HUNG ON THIS UNIT

QTUNT:	0	;UNIT TO TRANSFER ON NEXT
QTCHN:	0	;CHNL ..
QLCHN:	0	.SEE QINT2C
QWRU:	-1	;DEFAULT WRITE UNIT (-1 if there isn't a default unit yet)
MDSK:	0	;DRIVE # OF MASTER DISK
QACTTM:	-1	;SETOM ON READ OR WRITE DATA TRANSFER
		;AOS AT SSLCK IF + OK TO WRITE DIRS
		;IE DON'T TIE UP DISK TO WRITE DIR UNLESS THINGS ARE QUIET
QDWFAR:	-10.	.SEE QINT3	;WRITE DIRS SOME OF THE TIME ANYWAY
LQTM:	0	;TIME AT WHICH LAST COMMAND GIVEN TO DISK
QFTTHR:	600.	;IF FREE TRKS ON QWRU GOES BELOW THIS, SWITCH TO UNIT WITH MOST FREE TRACKS
QRDAHD:	IFE MCOND DM,[0] .ELSE 2	;NUMBER OF BLOCKS TO READ AHEAD

LASTGC:	0	;NAME OF LAST DIRECTORY TO GET GC'ED

;USER DIRECTORIES

QNUD==40.		;NUMBER USER DIRECTORIES

QFUD:	QNUD		;NUMBER OF FREE UFD SLOTS

QSNUD:	BLOCK QNUD	;USER NAME OR 0 IF FREE
QSNLCN:	BLOCK QNUD	;4.9 LOCKED, 4.8 ALSO NOT IN CORE RH CORE ADR
	 .SEE DCHBT	;4.6 =1 NOT PAWED OVER 4.5 CHNGD AND NOT WRITTEN ON UNIT 0
			;4.4 UNIT 1 4.3 UNIT 2 4.2 UNIT 3 4.1 UNIT 4
			;3.9 UNIT 5 3.8 UNIT 6 3.7 UNIT 7
 %QUDWM==40		;3.6 WRITE IMMEDIATELY ON MASTER DISK
			;@ + XR BITS MUST = 0

QSNNR:	BLOCK QNUD	;NUMBER PC'S LOOKING AT THIS IE
			;+1 FOR FILE OPEN AND USER IN CORE(?)
QSNMI:	BLOCK QNUD	;TRACK N OF USER DIR IF NOT NEWLY CREATED
QSFBT:	BLOCK QNUD	;FREED-BLOCKS-TABLE.  HEAD OF A LIST OF PAGES,
			;THREADED THROUGH THE SECOND WORD AND ENDING WITH
			;ZERO.  FIRST WORD IS AOBJN POINTER TO FREE PART
			;OF PAGE.  FROM THIRD WORD UP TO BELOW WHERE AOBJN
			;POINTS ARE WORDS UNIT,,BLOCK WHICH RECORD DISK
			;BLOCKS TO BE FREED ONCE THE DIR HAS BEEN WRITTEN
			;OUT TO THE MASTER DISK.  ELIMINATES REUSED ADDRESS
			;PROBLEMS BY GUARANTEEING THAT IF THE SYSTEM SHOULD
			;CRASH AT ANY TIME, THERE CANNOT BE TWO DIRECTORIES
			;ON DISK THAT BOTH POINT TO THE SAME BLOCK.

IFN QRSRVP,[
QSALLO:	BLOCK QNUD	;-1 OR DRIVE # DIRECTORY ALLOCATED TO
]

;LOCKS

UDRSW:	-1	;USER DIR AREA LOCKED
	0
QCHSW:	-1	;CHNL AREA LOCKED
	0
QSKOSW:	-1	;QSKO1 LOCKED (USER DIR READIN)
	0

;LIST OF PAGES CONTAINING BLOCKS WHICH CAN NOW BE FREED.  MOVED TO
;HERE FROM QSFBT WHEN THE DIR IS WRITTEN OUT.  THE ACTUAL FREEING
;IS DONE BY THE CORE JOB.

QFBTS:	0

;VARIABLES FOR SYSTEMS CONCEPTS DISK CONTROL

IFN DC10P,[
QRCSW:	105	;- NO READ COMPARE 0 COMPARE WRITES + COMPARE ALL
QCST:	0	;CONI DC0, AT QINT
QERST:	0	;HAS CONI DC1, BITS WHEN AN ERROR HAPPENS
PKIDM:	0	;-1 WAITING FOR PACK ID TO BE READ
RPKID:	-1	;PACK ID READ INTO HERE BY DISK CONTROL
QDRSTS:	0	;DRIVE STATUS WORD STORED BY DISK CONTROL
]
IFE DMDSK,[
	0	;FOR BLT INTO QXWDS
QXWDS:	BLOCK NXWDS
]
IFN DC10P,[
QCHPRG:	0
QCHPR2:	DCOPY (-2000_2&37774)
	DCOPY (-NXWDS_2&37774)QXWDS
QCHPR4:	DHLT	;OR DRC
QCHPR3:	DCCOMP (-2000_2&37774)
	DCCOMP (-NXWDS_2&37774)QXWDS
	DHLT

GPKID:	DSPC+DSCRHD+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
	DCOPY RPKID(37774)
	DHLT
QRECAL:	DSPC+DSRCAL+DUNENB
]

;VARIABLES FOR DEC RP10 DISK CONTROL

IFN RP10P,[
QERST:	0	;CONI DPC, ON ERROR
QERDTI:	0	;DATAI DPC, ON ERROR
QCST:	0	;CONI DPC, AT QINT
QCHPRG:	0	;SEEK COMM
IFN KA10P, QIOWD: -2000,,	;XFER DATA (HRRM ADR-1 IN RH)
IFE DMDSK,[
	-NXWDS,,QXWDS-1
	-200+NXWDS,,0
];DMDSK
	0

QRECAL:	700000,,
QGTBZY:	0	;FLAG FOR SOFTWARE AT INT
];RP10P
IFN QRDCMP,[
QRCSW:	0	;NON-ZERO TO ENABLE READ-COMPARING
RDCPHS:	0	;0 NORMAL, -1 DOING OPERATION WHICH SHOULD BE READ-COMPARED
		; AFTERWARD, + DOING READ-COMPARE
IFN KA10P,[
RCIOWD:	BLOCK 2	;CHANNEL PROGRAM FOR READ INTO QRCBUF
];KA10P		;ON KL WE HAVE TO PUT IT IN THE EPT!
QRCBUF:	BLOCK 2000
];QRDCMP

;VARIABLES FOR DEC RH10 DISK CONTROL

IFN RH10P,[
QCHPRG:	0	;DATA TRANSFER COMMAND
QCHPGA:	0	;ADDRESS (CYL IN LH, TRACK-SECTOR IN RH)
NCSHI:	0	;NUMBER OF CACHE INVALIDATES
NCSHIL:	0	;NUMBER OF LOOPS WAITING FOR CACHE INVALIDATES
NCSHU:	0	;NUMBER OF CACHE UNLOADS
NCSHUL:	0	;NUMBER OF LOOPS WAITING FOR CACHE UNLOADS
QERST:	0	;CONI AT LAST ERROR (LEAVE THIS THROUGH QECPAT IN SAME ORDER)
	0	;DATAI AT LAST ERROR
QERSTS:	0	;%HRSTS AT LAST ERROR
QERER1:	0	;%HRER1 AT LAST ERROR
QERER2:	0	;%HRER2 AT LAST ERROR
QERER3:	0	;%HRER3 AT LAST ERROR (IBM WOULD CALL THIS A CHANNEL LOGOUT AREA)
QERDCL:	0	;%HRDCL AT LAST ERROR
QECPOS:	0	;%HRPOS AT LAST ERROR
QECPAT:	0	;%HRPAT AT LAST ERROR
QCST:	0	;CONI AT LAST INTERRUPT
QGTBZY:	0	;FLAG FOR SOFTWARE-CAUSED INTERRUPT
QECCS:	BLOCK NQS	;NUMBER OF ECC CORRECTED ERRORS, PER DRIVE
QECCAD:	BLOCK NQS	;DISK ADDRESS OF MOST RECENT ECC CORRECTED ERROR
RHDATO:	-1		;LAST DATAO DSK, FOR DEBUGGING
ECCPAG:	BLOCK 8		;TEMP FOR SAVING PAGE MAP VARS AT QECC (WITH SPM)
NQDRE:	BLOCK NQS	;# MASSBUS TIMEOUTS PER DRIVE.
NQSATN:	BLOCK NQS	;# SPURIOUS ATTENTIONS IN MID-TRANSFER
NQEATN:	BLOCK NQS	;# ATTENTIONS REPORTING ERRORS
]

;VARIABLES FOR DEC RH11 DISK CONTROL (ON THE KS10 UNIBUS)

IFN RH11P,[
QCHPRG:	0	;DATA TRANSFER COMMAND
QCHPGA:	0	;ADDRESS (CYL IN LH, TRACK-SECTOR IN RH)
QIOWD:	0	; BA,,WC for RH11
QCST:	0	;CS1 AT LAST INTERRUPT
QGTBZY:	0	;FLAG FOR SOFTWARE-CAUSED INTERRUPT

QERST::		;Gubbish saved at last error
QERCS1:	0	; CS1	Control & Status 1
QERCS2:	0	; CS2	Control & Status 2
QERSTS:	0	; STS	Drive status
QERBA:	0	; BA	Unibus address for transfer
QERWC:	0	; WC	Word count for transfer
QERER1:	0	; ER1	Error 1
QERER2:	0	; ER2	Error 2
QERER3:	0	; ER3	Error 3
QERPOS::
QECPOS:	0	; POS	ECC position
QERPAT::
QECPAT:	0	; PAT	ECC pattern
QERMAP:	0 ? 0	; Unibus map to disk buffer

QECCS:	BLOCK NQS	;NUMBER OF ECC CORRECTED ERRORS, PER DRIVE
QECCAD:	BLOCK NQS	;DISK ADDRESS OF MOST RECENT ECC CORRECTED ERROR

NQSATN:	BLOCK NQS	;# SPURIOUS ATTENTIONS IN MID-TRANSFER
NQEATN:	BLOCK NQS	;# ATTENTIONS REPORTING ERRORS
NQOFFL:	BLOCK NQS	;# TIMES DISK WENT OFFLINE
]

DIRHNG:	0	;LH POINTS TO LIST OF DIRHNG DEVICE CHANNELS,
		;CHAINED THROUGH LH'S OF IOCHNM WORDS.
		;0 MEANS END OF LIST
		;MODIFY ONLY WITH THE CLOCK OFF.
	;EACH DIRHNG DEVICE CHANNEL'S IOCHST WORD RH CONTAINS THE
	;TRACK NUMBER OF THE DIRECTORY IT IS LOOKING AT.

BBLK

;DISK CONSTANTS

IFN RP10P,[
QATTNS:	REPEAT NQS,500000+.RPCNT_14,,1_<10-.RPCNT>
;WORDS TO CLEAR ATTNS AND SELECT DRIVES
]

SWAPL:	SINLST(Q)
	SOUTLS(Q)

DCHBT:	20000,,	;BIT SET IF DIR NOT WRITTEN OUT ON UNIT
	10000,,
	4000,,
	2000,,
	1000,,
	400,,
	200,,
	100,,
IFL .-DCHBT-NQS,.ERR YOU BETTER FIND ANOTHER BIT FOR QACTB,QSNLCN,QTUTO

IFN DC10P,[
QTRAN:	0	;FORMERLY MAPPED 203 CYL VIRTUAL DRIVES TO 406 CYL CALCOMPS
	1	;4.9 => 2ND HALF OF PHYSICAL DRIVE
	2	;(DOESN'T DO ANYTHING NOW THAT MEMOWRECKS ARE GONE,
	3	; BUT KEEP AROUND IN CASE EVER NEEDED AGAIN.)
	4
	5
	6
	7
IFL .-QTRAN-NQS,	.ERR BARF AT QTRAN
]

SUBTTL DISK CLOSE ROUTINES

QICL:	PUSH P,R
	SKIPGE QUSR(A)
	 BUG
	MOVSI Q,%QAACC
	ANDCAM Q,QSRAC(A)	;FLUSH RANDOM ACCESS HACKERY
	PUSHJ P,QICLW1		;WAIT FOR INPUT TO STOP
	MOVE TT,QSRAC(D)
	TLNE TT,%QADEL	;DELETE?
	 JRST QSICLD	;YES
	MOVE H,QUDPR(D)		    ;DIRECTORY NUMBER
	SETOM QUSR(D)
	AOS QFCHN
QICLX:	SOSGE QSNNR(H)		    ;FREE DIRECTORY CHANNEL HAD BEEN USING
	 BUG
	POP P,R
	SETZM (R)
	POPJ P,

QICLW1:	MOVE D,A		;IDLE CHANNEL AND FLUSH READ BUFFERS
	CONO PI,UTCOFF
	SKIPGE QSGL(D)
	 JRST QSICL3
	SKIPL QSCABN(D)
	 JRST QSICL4
	SETOM QSGL(D)

QSICL3:	HLLZS QSRAC(D) .SEE %QMIDL ;STOP PI
	CONO PI,UTCON
QSICL5:	PUSHJ P,QSBRB1	;RETURN M.P. BUFFER IF ANY
QOCL7:	HRRZ A,QBFP(D)	;ALSO ENTER TO RETURN UNUSED READ BUFFER ON WRITE OVER MODE
QSICL2:	JUMPE A,QSICL6
	LDB C,[MLO,,MEMBLT(A)]
	PUSHJ P,MEMR
	MOVE A,C
	SOS QSBFS(D)
	JRST QSICL2

QSICL6:	SETZM QBFP(D)
	POPJ P,

QSICL4:	MOVEI A,%QMRD1	;STOP PI AFTER THIS BLOCK
	HRRM A,QSRAC(D)
	CONO PI,UTCON
	SKIPL QSGL(D)	;WAIT FOR CHANNEL TO DEACTIVATE
	 PUSHJ P,UFLS
	JRST QSICL5

;OUTPUT CLOSE
QOCL:	PUSHJ P,QSOCL5	;CLEAN UP THE DISK CHANNEL
QSOCL4:	MOVE D,A	;ENTRY FROM QALINK
QSOCL6:	MOVE Q,QUDFPR(D)
	MOVE H,QUDPR(D)
	ADD Q,QSNLCN(H)
	MOVE TT,QSRAC(D)
	TLNE TT,%QADEL
	 JRST QCDLWO	;DELETED (PRESUMABLY VIA DELEWO)
	MOVE A,UNFN1(Q)	;Get names of file being hacked.
	MOVE B,UNFN2(Q)
	PUSHJ P,QLOOK	;FILING OVER ANYTHING?
	 JRST QSOCL3
	HRRZ I,QSNLCN(H)
	ADD I,QUDFPR(D)
	CAMN I,Q	;BEING WRITTEN BITS WENT AWAY?
	 BUG		;TRYING TO DELETE THE FILE WE'RE WRITING
	PUSHJ P,QSOCLD	;YES FLUSH IT
	PUSHJ P,QUDLK	;RELOCK DIR UNLOCKED BY QSOCLD ETC
	JRST QSOCL6	;MAKE SURE ONE HASN'T REAPPEARED WHILE DIR UNLOCKED

QSOCL5:	LDB H,[$QAMOD,,QSRAC(A)]
	JUMPN H,QOCL6	;DONT HACK ACTIVE WD COUNT IN WRITEOVER MODE
QOCL6A:	MOVN D,QSMPRC(A)	;- NUMBER OF BYTES IN BLOCK NOT USED
	ADDB D,QMPBSZ(A)	;ADJUST BYTE COUNT OF LAST BLOCK TO REFLECT WHATS USED
	CLEARM QSMPRC(A)	;SO WILL BE A NOOP IF PCLSR OUT AND COME BACK THRU HERE
QOCL4:	MOVSI Q,%QAEFW
	IORM Q,QSRAC(A)		;SET EOF BIT FOR QSBWW AND QUDS
	JUMPN H,QOCL5
	SKIPL QSMDN(A)		;NO M.P. BUFFER ANYWAY
	 JUMPE D,QOCL1		;ABOUT TO WRITE NULL BLOCK, DON'T
QOCL5:	PUSHJ P,QSBWW
QOCL2:	MOVE T,A
	PUSHJ P,[ SKIPGE QSCRW(T)	;WAIT FOR CHANNEL EITHER LEAVING WRITE MODE
		   SKIPN QSBFS(T)	;OR WRITING OUT ALL ITS BUFFERS, I.E. PI LEVEL
		    JRST POPJ1		;ISN'T GOING TO DO ANYTHING MORE TO IT.
		  POPJ P, ]
	 PUSHJ P,UFLS
	SKIPE QBFP(A)		;MAKE SURE IF QSBFS NON-ZERO THAT IS ONLY EOF
	 BUG			;NOT A BUFFER SITTING AROUND FORGOTTEN
QOCL3:	MOVE H,QUDPR(A)
	PUSHJ P,QUDLK
	SKIPN D,QMPTC(A)	;SKIP ON NEXT "N" STILL PENDING
	 POPJ P,
	PUSHJ P,QUDS		;STORE IT AWAY
	CLEARM QMPTC(A)
	POPJ P,

QOCL6:	SKIPGE QSCRW(A)	;WAIT FOR CHANNEL TO IDLE OR HANG UP IN READ
	 PUSHJ P,UFLS
	SKIPL QSGL(A)
	 PUSHJ P,UFLS
	MOVE D,A
	PUSHJ P,QOCL7
	MOVE A,D
	MOVE Q,QSRAC(A)
	MOVE B,QSBFS(A)
	JUMPE B,QOCL6B
	TLNE Q,%QAEFW
	 JRST QOCL6B
	TLNE Q,%QAEFR
	 SOS B,QSBFS(A)	;COMPENSATE FOR EXTRA AOS ON EOF READ
QOCL6B:	CAILE B,1
	 BUG
	TLNE Q,%QAWOV
	 JRST QOCL6A	;HACKING LAST BLOCK PAST EOF, UPDATE ACTIVE WD COUNT
	JRST QOCL4

QOCL1:	PUSHJ P,QSBRB	;DISCARD BUFFER
	SOS QSBFS(A)
	SOS QWBUFS
	MOVE D,QDSKN(A)
	AOS QSFT(D)	;RESTORE TRACK
	JRST QOCL2

QSOCL3:	MOVE Q,QUDFPR(D)
	MOVE TT,QSNLCN(H)
	ADDI Q,(TT)
	MOVSI T,UNWRIT
	ANDCAM T,UNRNDM(Q)	;CLEAR WRITE IN PROG
	MOVE TT,QSNLCN(H)
	MOVE T,UDNAMP(TT)	;MAKE SURE IT GOES BEFORE * FILE OF SAME NAME
	ADDI T,(TT)
	CAMN T,Q
	 JRST QSOC3E	;NO PREV FILE
	MOVE J,Q
QSOC3A:	SUBI J,LUNBLK
	CAMN A,UNFN1(J)
	CAME B,UNFN2(J)
	 JRST QSOC3B	;PREV FILE HAS DIFFERENT NAME
	CAILE J,(T)
	 JRST QSOC3A
QSOC3C:	CAMN J,Q
	 JRST QSOC3E
REPEAT LUNBLK,	PUSH P,.RPCNT(J)
	MOVE T,J
	HRL T,Q
	BLT T,LUNBLK-1(J)
REPEAT LUNBLK,	POP P,LUNBLK-.RPCNT-1(Q)
	SUB Q,J
	SUBI J,(TT)
	MOVSI T,-NQCHN
QSOC3D:	HRRZ A,QUDPR(T)
	SKIPL QUSR(T)
	 CAIE A,(H)
	  JRST QSOC3F
	HRRZ A,QUDFPR(T)
	CAIN A,(J)
	 ADD A,Q
	MOVEM A,QUDFPR(T)
QSOC3F:	AOBJN T,QSOC3D
QSOC3E:	SETOM QUSR(D)	;FREE THE DISK CHANNEL
	AOS QFCHN
	MOVE C,QSNUD(H)
IFN TPLP+UNSPLP,[
	MOVEI TT,SCRTPC
	CAMN C,[SIXBIT /.LPTR./]
	 IORM TT,SUPCOR	;CLOSING FILE ON TPL DEVICE SO SET FLAG FOR SYS JOB
];TPLP
	CAMN C,[SIXBIT/.MAIL./]
	 AOS NQMFWR	;CLOSING FILE ON .MAIL. => BUMP COUNT TO WAKE MAILER DEMON
IFN XGP,[
	CAMN C,[SIXBIT/.XGPR./]
	 AOS NXGPFW	;WAKE XGPSPL
];XGP
	MOVE A,QSNMI(H)	;TELL DIRHNG DEVICE ABOUT IT
	PUSHJ P,DIRSIG
	MOVE TT,QACTB	;DIR CHANGED (AT LEAST WRITE-IN-PROG BIT TURNED OFF)
	IORM TT,QSNLCN(H)	
	PUSHJ P,QUDULK
	SOSGE QSNNR(H)
	 BUG
	PUSHJ P,QSTRTR
	SETZM (R)	;CLEAR IOCHNM WORD.
	POPJ P,

QSOC3B:	ADDI J,LUNBLK
	JRST QSOC3C

QOCLR:	MOVE Q,QSRAC(A)	;CLOSE UNIT ASCII OUTPUT
	TLNN Q,%QAWOV
	 TLNN Q,%QAMWO+%QALNK
	  PUSHJ P,QOCLPD	;PUT NEEDED PADDING UNLESS NOT A FILE OR NOT AT END
	JRST QOCL

QOCLPD:	LDB Q,[360600,,QSMPRP(A)] ;NUMBER OF BITS NOT WRITTEN IN LAST WORD
	CAIL Q,44
	 POPJ P,	;LAST WORD NOT WRITTEN AT ALL
	LSH Q,18.+6	;FILL THOSE BITS WITH ^CS
	HRR Q,QSMPRP(A)
	MOVE C,[EOFWRD]
	SKIPLE QSMPRC(A) ;INHIBIT STORE IF NO BUFFER ETC.
	 DPB C,Q
	POPJ P,

SUBTTL DISK INTERRUPT ROUTINES

OVHMTR QIN	;DISK INTERRUPT LOW-LEVEL

IFN RP10P,[

QINT:	AOS QGTBZY
	MOVEM TT,QCST
IFN DMDSK,[
	TRNN TT,200000	;END OF CYLINDER
	 JRST QINT0
	SKIPGE C,QSDCH
	 BUG
	MOVE D,QSGL(C)
	IDIVI D,NBLKSC	;IS IT LEGITIMATE?
	SKIPL QSDU	;IF NO TRANSFER IN PROGRESS, IGNORE
	 CAIN E,NBLKSC-1	;IS LEGITIMATE FOR LAST BLOCK IN CYLINDER
	  CAIA		;IGNORE
	   BUG PAUSE,[MAYBE DISK CONTROL IS WRITING ALL OVER THE DISK AGAIN]
QINT0:	];DMDSK
	TDNE TT,[17177700]	;ANY ERRORS?
	 JRST QINTE
QINTN2:	DATAI DPC,R
	SKIPGE QSDU	;DONT CLOB CMD BUF TO CLR ATTS DURING DATA XFER
	 TRNN R,776	;ANY ATTNS
	  JRST QINTA	;NO
	LDB I,[11000,,R]	;YES,FIND WHICH DRIVE
	JFFO I,.+1	;CLOBBERS Q
	SUBI Q,28.

QINTAT:	DATAO DPC,QATTNS(Q)	;CLEAR ATTNS
	DATAI DPC,E
	TLNN E,40
	 JRST QRECAT		;NOT ON CYLINDER, RECALIBRATE
	LDB A,[DCYLI E]
	TRNE E,.BM DCYLXI
	 ADDI A,400
	CAME A,QPOSGL(Q)
	 JRST QRECAT	;SEEK TO THE WRONG PLACE (CALCOMPS LIKE TO DO THIS)
	MOVEM A,QPOS(Q)	;REMEMBER WHERE IT IS AT
	SETZM QSEEK(Q)
	SETZM QRCAL(Q)
	JRST QINT	;TRY AGAIN

QINTA:	SKIPGE Q,QSDU
	 JRST QINT1	;NOT EXPECTING DATA COMPLETION - FIND NEW TRANSFER
	CONSO DPC,400000
	CONSO DPC,10
	 JRST DSKEX	;TRANSFER STILL IN PROGRESS, DISMISS
	CONSZ DPC,20
	 JRST .-1	;BUSY?
	AOSN QHUNGF
	 JRST QHE	;XFER HUNG, RECALIBRATE AND RETRY
	JRST QINTA1	;TRANSFER COMPLETE...

QINTE:	DATAI DPC,R
	CONI DPC,TT	;THIS LOOKS REDUNDANT BUT APPARENTLY IS NECESSARY
			;DUE TO TIMING OF THE DISK-NOT-READY CONDITION
	CONO DPC,175700+DSKCHN	;RESET CONDITIONS
	MOVEM TT,QERST
	MOVEM R,QERDTI
	CONSZ DPC,20	;WAIT FOR UNBUSY
	 JRST .-1
	MOVE Q,QSDU	;FOR QOVR
	MOVE E,QCHPRG
	TRNE TT,20000	;OVERRUN
	 JRST QOVR
	TRNE TT,2000	;NOT READY
	 JRST QNRDY
	TDNE TT,[12010700]	;BITS 14,16,23,27-29 ARE LOSERS
	 BUG HALT,[DSK: TOTALLY FATAL ERROR, CONI=],OCT,QERST
	TLNE TT,5	;WD OR SECTOR PARITY ERROR
	 JRST QDE
	TRNE TT,1000	;WRITE LOCKED
	 JRST QIRWRE
	TRNE TT,40000	;SEARCH FAILED
	 JRST QHE
	TRNN TT,100000	;POWER FAILURE
	 JRST QINTE1
	CONSZ DPC,100000	;TRY IT AGAIN
	 JRST 4,.-1
	JRST QHE

QINTE1:	TLNE R,10	;FILE UNSAFE--NEED OPERATOR INTERVENTION
	 BUG PAUSE,[DSK: FILE UNSAFE UNIT ],DEC,Q
	TLNE R,4
	 BUG	;NO SUCH DRIVE
	TLNE R,110	;POSITION FAILURE (OR PROCEEDED FILE UNSAFE)
	 JRST QHE
	AOS NQSE(Q)	;SPURIOUS ERROR
	JRST QINTX	;IGNORE

QIRWRE:	BUG PAUSE,[DSK: WRITE LOCKED UNIT ],DEC,Q
	JRST QHE

QNRDY:	LDB Q,[410300,,R]	;WHICH DPC
	SKIPN QSEEK(Q)
	 SKIPGE QRCAL(Q)	;NOT SEEKING OR RECALIBRATING IS ERROR
	  JRST QINTN2
	BUG PAUSE,[DSK: UNIT ],DEC,Q,[NOT READY]
	JRST QREC
] ;END IFN RP10P

IFN DC10P,[

QINT:	MOVEM TT,QCST
	SKIPL PKIDM	;GETS SPURIOUS DIPE WHEN READING PACK ID
	 CONSO DC1,7777	;RUMOR THAT DSSERR DOESN'T ALWAYS SET
	  TRNE TT,DSSERR
	   JRST QINTE
	TRNE TT,DSSATT
	 JRST QINTAT
QINTA:	SKIPGE Q,QSDU
	 JRST QINT1	;NOT EXPECTING DATA COMPLETION, FIND NEW TRANSFER
	CONSZ DC0,DSSRUN+DSSACT
	 JRST DSKEX	;ACTIVE OR RUN, TRANSFER IN PROGRESS, DISMISS
	AOSN PKIDM	;SKIP IF NOT FINISHED READING PACK ID
	 JRST QSPKID
	AOSN QHUNGF
	 JRST QHE	;XFER HUNG, RECALIBRATE AND RETRY
	SKIPL QERS1
	 JRST QEROK	;OK ON VERIFY
	JRST QINTA1	;TRANSFER COMPLETE...

QINTE:	CONI DC1,TT
	CONO DC0,DCCLR+DCERR+DSKCHN	;CLEAR ERRORS
	MOVEM TT,QERST
	MOVE Q,QSDU
	CONSZ DC0,DSSRUN+DSSACT
	 JRST .-1	;ACTIVE OR RUN?
	SKIPL QERS1
	 JRST QERL1	;VERIFY ALSO LOST
	TRNE TT,DOFFL+DPROT+DDOBSY+DNXM+DCPERR
	 JRST QINTE1	;REALLY LOST BIG
	TRNE TT,DOVRRN
	 JRST QOVR
	TRNE TT,DWTHER+DFUNSF	;SEEK INC, END DISK, WATCHDOG, OR UNSAFE
	 JRST QHE	;TRY TO RECALIBRATE
	SKIPGE PKIDM
	 TRZ TT,DRLNER	;IGNORE LENGTH ERROR IF READING PACK #
	TRNE TT,DIPE+DRLNER+DRCER+DCKSER
	 JRST QDE	;TRY AGAIN
	SKIPGE PKIDM
	 TRNE TT,-1
	  AOS NQSE	;SPURIOUS ERROR (NOT LENGTH ERROR IN PKIDM)
	JRST QINTX	;SPURIOUS ERROR

QINTE1:	TRNE TT,DOFFL
	 BUG PAUSE,[DSK: UNIT ],DEC,Q,[OFFLINE]
	TRNE TT,DPROT
	 BUG PAUSE,[DSK: UNIT ],DEC,Q,[WRITE PROTECTED]
	TRNE TT,DDOBSY
	 BUG PAUSE,[DSK: DATAO WHEN BUSY]
	TRNE TT,DNXM+DCPERR
	 BUG PAUSE,[DSK: MEM PAR OR NXM ERROR]
	JRST QOVR

QINTAT:	CONI DC1,Q
	CONO DC0,DCCLR+DCCATT+DSKCHN	;CLEAR ATTENTION
	LDB Q,[DSATDN Q] ;ATTENTION DRIVE NUMBER
	CAIGE Q,NQS
	 SKIPL QRCAL(Q)
	  JRST QINTX
	SETZM QRCAL(Q)
	CONO DC0,DCCLR+DCATEB+DSKCHN	;CLEAR ATTENTION ENABLE
	JRST QINTX

;THIS IS CALLED EVERY HALF SECOND
QRCTMO:	MOVEI Q,NQS-1
	SKIPL QRCAL(Q)
QRCTM1:	 SOJGE Q,.-1
	JUMPL Q,CPOPJ
	SOSL QRCTIM(Q)
	 JRST QRCTM1
	BUG INFO,[DSK: RECAL TIMEOUT UNIT],DEC,Q
	SETZM QRCAL(Q)
	CONO DC0,DCCLR+DCATEB+DSKCHN	;CLEAR ATTENTION ENABLE I GUESS
	JRST QRCTM1
];DC10P

IFN RH11P,[

;;; RHCLRC(Q)	Clear controller errors and select drive Q
;;; RHSLCT(Q)	Select drive Q
;;; RHCMD(A)	Command in A to current drive
;;; RHCLRD	Clear current drive
;;; RHCHEK	Check for immediate bad news
;;;	All return CS1 in A

RHSLCT:	IOWRQ Q,%HRCS2
RHCHEK:	IORDQ A,%HRCS1
	TRNE A,%HXTRE+%HXMCP
	 BUG HALT,[DSK: MASSBUS ERROR, CS1=],OCT,A
	POPJ P,

RHCLRC:	IOWRQ Q,%HRCS2		; Must select drive before clearing controller
	MOVEI A,%HXTRE+%HXIE+%HMNOP
RHCMD:	TROA A,%HXIE
RHCLRD:	 MOVEI A,%HXIE+%HMCLR
	IOWRQ A,%HRCS1
	JRST RHCHEK

EBLK
DSKBRK:	0
BBLK
	JSR UTCSAV
QINT:	AOS QGTBZY
	MOVE Q,QSDU
	IORDQ TT,%HRCS1
	MOVEM TT,QCST
	TRNE TT,%HXTRE+%HXMCP
	 JRST QINTE
	TRNN TT,%HXSC		; Perhaps some drive needs attention?
	 JRST QINT0		; Not unless SC is set!
	IORDQ A,%HRATN
	JFFO A,QINTAT
QINT0:	SKIPGE Q,QSDU
	 JRST QINT1		; Not expecting completion of transfer.
	TRNN TT,%HXRDY
	 JRST DSKEX		; Transfer still in progress.
	AOSN QHUNGF
	 JRST QHE		; Transfer hung, recalibrate and retry.
	PUSHJ P,RHSLCT		; Select that drive.
	IORDQ A,%HRSTS		; Get its status.
	TRNE A,%HSERR		; Just in case %HXTRE didn't get set (by
	 JRST QINTE		;  analogy with RH10)...
	JRST QINTA1		; Transfer complete...

QINTAT:	MOVNI Q,-35.(B)
	HRRZS Q
	MOVEI A,1
	LSH A,(Q)
	IOWRQ A,%HRATN		; Turn off attention bit.
	CAIL Q,NQS
	 JRST QINT0
	CAMN Q,QSDU
	 JRST [	AOS NQSATN(Q)	; Ignore attention in mid-transfer.
		JRST QINTA2 ]
	SKIPE QACT(Q)
	 JRST QINTA2		; Ignore this drive.
	PUSHJ P,RHSLCT
	IORDQ B,%HRSTS		; Get status of drive with attention.
	TRC B,%HSMOL+%HSDPR+%HSRDY
	TRNN B,%HSMOL+%HSDPR+%HSRDY+%HSVV
	 PUSHJ P,QOFFL		; Went offline and came back online
	TRNE B,%HSERR+%HSPIP
	 JRST [	PUSHJ P,RHCLRD	; Drive barfing not during transfer
		AOS NQEATN(Q)	;  so clear it
		JRST .+1]	;THEN CLEAR SEEK AND RECALIBRATE FLAGS
	SETZM QSEEK(Q)		;POSITIONING COMPLETION
IFDEF %HRCCY,[			;Current Cyl register only on RP disks
	IORDQ A,%HRCCY
	MOVEM A,QPOS(Q)		;UPDATE CURRENT CYLINDER
	CAME A,QPOSGL(Q)
	 SETOM QSKT1(Q)		;SEEK TO WRONG PLACE
];IFDEF %HRCCY
IFNDEF %HRCCY,[
	MOVE A,QPOSGL(Q)	;On RMxx, jump to conclusion
	MOVEM A,QPOS(Q)
];IFNDEF %HRCCY
	SETZM QRCAL(Q)		;NO LONGER RECALIBRATING
	JRST QINT0		;IF NO XFER ACTIVE, MAYBE CAN START ONE ON
				; THIS UNIT NOW

QINTA2:	SETOM QSKT1(Q)		;DON'T TRUST POS
	JRST DSKEX

; Went offline and came back online
QOFFL:	TRC B,%HSMOL+%HSDPR+%HSRDY	;Recover %HRSTS
	IORDQ C,%HRER1	
	IORDQ D,%HRER2
IFDEF %HRER3,[
	IORDQ E,%HRER3
	BUG INFO,[DSK: UNIT #],DEC,Q,[CAME BACK ONLINE, CS1=],OCT,A,[STS=],OCT,B,[ER1=],OCT,C,[ER2=],OCT,D,[ER3=],OCT,E
]
IFNDEF %HRER3,[
	BUG INFO,[DSK: UNIT #],DEC,Q,[CAME BACK ONLINE, CS1=],OCT,A,[STS=],OCT,B,[ER1=],OCT,C,[ER2=],OCT,D
]

	AOS NQOFFL(Q)
	MOVEI A,%HMCLR		;Clear the drive
	PUSHJ P,RHCMD
	MOVEI A,%HMRDP		;I said, clear the drive!
	PUSHJ P,RHCMD
	MOVEI A,0
	IOWRQ A,%HROFS		;No offset, 18 bits, ECC on, HCI off
	MOVEI A,%HMACK		;Turn %HSVV back on so drive will work
	PUSHJ P,RHCMD
	POPJ P,

QINTE:
IRPS X,,[CS1 CS2 BA WC POS PAT] ; First get status of controller
	IORDQ A,%HR!X
	MOVEM A,QER!X
TERMIN
	IORDQ A,UBAPAG+QUBPG_1	; Unibus map counts as part of
	MOVEM A,QERMAP		;  controller status.
	IORDQ A,UBAPAG+QUBPG_1+1
	MOVEM A,QERMAP+1
	SKIPGE Q		; Try hard to guess the drive.
	 LDB Q,[$HYDSK QERCS2]
	PUSHJ P,RHCLRC		; Clear controller errors and select drive
				; so that we can read its status too.
	TRNN A,%HXRDY		; Why would controller be busy?  (RH10
	 BUG			;  code checks for this...)

IRPS X,,[STS ER1 ER2]
	IORDQ A,%HR!X
	MOVEM A,QER!X
TERMIN
	MOVE A,QERCS1		; A: CS1
	MOVE R,QERCS2		; R: CS2
IFDEF %HRER3,[			; Disks with ER2 -and- ER3
	IORDQ A,%HRER3
	MOVEM A,QERER3
	SKIPN QERER2		; Bad news
	 SKIPE QERER3
	  JRST UNSAFE
]
IFNDEF %HRER3,[			; Disks with just ER2
	SKIPE QERER2
	 JRST UNSAFE
]
	TRNN A,%HXMCP		; Real bad news
	 TRNE R,%HYWCE+%HYPE+%HYNED+%HYNEM+%HYPGE+%HYMXF
	  BUG HALT,[DSK: UNIT #],DEC,Q,[LOSING.  CS1=],OCT,A,[ CS2=],OCT,R
	TRNE R,%HYDLT+%HYMDP	; Data bus losing?
	 JRST QINTE1
	MOVE A,QERSTS		; Check Drive Status
	TRC A,%HSVV+%HSRDY+%HSDPR+%HSMOL	; Better be all on!
	TRCE A,%HSVV+%HSRDY+%HSDPR+%HSMOL
	 BUG
	TRNN A,%HSERR
	 JRST [	AOS NQSE(Q)	; Spurious?
		JRST QINT0]
	MOVE B,QERER1		; Check the main error register
	TRNE B,#<%H1ECC+%H1DTE+%H1CRC+%H1HCE+%H1ECH+%H1FER+%H1PAR>
	 JRST UNSAFE		; Those not listed above are considered "hard"
	CAIN B,%H1ECC		; Correct correctable error if that is the
	 JRST QECC		;  only problem.
	PUSHJ P,QINTER		; Else print message and reset drive
	TRNE B,%H1DTE+%H1CRC+%H1HCE+%H1FER	; These require recalibration
	 JRST QHE
	TRNE B,%H1ECC+%H1ECH+%H1PAR	; These require reread
	 JRST QDE
	JRST QOVR		; No error bits set?  (How can this
				; happen?)  Go and retry...

;;; Controller error:
QINTE1:	BUG INFO,[DSK: ERR UNIT #],DEC,Q,[CS1=],OCT,QERCS1,[CS2=],OCT,QERCS2
	JRST QOVR

;;; Drive error:
IFDEF %HRER3,[
QINTER:	BUG INFO,[DSK: ERR UNIT #],DEC,Q,[ER1=],OCT,QERER1,[ER2=],OCT,QERER2,[ER3=],OCT,QERER3,[STARTING DISK ADDR=],OCT,QCHPGA
]
IFNDEF %HRER3,[
QINTER:	BUG INFO,[DSK: ERR UNIT #],DEC,Q,[ER1=],OCT,QERER1,[ER2=],OCT,QERER2,[STARTING DISK ADDR=],OCT,QCHPGA
]
	JRST RHCLRD		; Reset error status in drive

;;; Come here for drive unsafe and similar bad things.  May be set to
;;; either halt or attempt retry (via USFHLT variable).  Note that when we
;;; get here the state of the drive has not yet been disturbed.
UNSAFE:	SKIPE USFHLT
	 BUG PAUSE,[DSK: TOO MANY ERRORS]
	MOVEI A,2		;HALT IF ANOTHER ERROR WITHIN 1/2 - 1 SECOND
	MOVEM A,USFHLT
	PUSHJ P,QINTER		;GIVE ERROR MESSAGE AND RESET DRIVE
	SKIPL QSDU
	 JRST QHE		;RECALIBRATE AND RETRY
	JRST QREC		;Just recalibrate, no transfer to retry

QECC:	PUSHJ P,RHCLRD		; Reset drive
	CAME Q,QSDU		; ECC error better be for transfer in
	 BUG			; progress...
	MOVE A,QCHPRG
	TRNN A,10	.SEE %HMRED
	 BUG			; ECC error should only happen during read.
	LDB A,[$UPPAG QERMAP]
	IORI A,600000
	DPB A,[.PAREP+EXEUMP]	; Point parity error page at buffer.
	CLRPT 400000+PAREP_12	; Get it into our map now.
	CLRPT 401000+PAREP_12	; Both halves...
	MOVE J,QERBA
	SUBI J,1000+QUBPG_14	; Correct to relative byte address of start
				; of losing sector.
	TRNE J,770777		; Should always be aligned on sector boundary
	 BUG			;  and within a single block, right?
	LSH J,-2		; J: Address of first word of losing sector
				;  within block.
	MOVE A,QECPOS		; Get error position
	SOJL A,QDE		;HARDWARE POS IS OFF BY 1; IF 0 NOT CORRECTABLE
	IDIVI A,36.		;CONVERT TO WORD NO AND BIT NO
	CAIL A,177
	 JRST [	ADDI B,36.	;LAST WORD IN SECTOR - HACK IT TO AVOID NXM
		SOJA A,.+1]
	ADDI J,400000+PAREP_12(A)	; J: Address of losing word-pair
					; (In parity error page.)
	MOVE U,B		;SAVE BIT NUMBER
	MOVS B,(J)		;GET FIRST LOSING WORD
	MOVS C,1(J)		;GET SECOND LOSING WORD
	MOVE D,QECPAT		;GET ERROR PATTERN
	SETZ E,			;MAKE INTO DOUBLE-WORD
	ROTC D,(U)		;ALIGN IT
	XOR B,D			;FIX THE BAD BITS
	XOR C,E
	MOVSM B,(J)		;PUT CORRECTED DATA BACK
	MOVSM C,1(J)
	MOVEI A,0
	DPB A,[.PAREP+EXEUMP]	;FLUSH THE DISK BUFF FROM MAP
	CLRPT 400000+PAREP_12
	CLRPT 401000+PAREP_12	; Both halves...

	AOS QECCS(Q)		;LOG THE LOSS
	LDB E,[111000,,QERBA]	; E: Number of sectors transferred (including
	SUBI E,QUBPG_3		;  ECC sector)
	MOVE A,QCHPGA
	LDB B,[$HASEC A]	;Compute disk address of failing sector:
	ADDI B,-1(E)
	IDIVI B,NSECS		; C: sector
	DPB C,[$HASEC A]
	LDB D,[$HATRK A]
	ADD B,D			; B: track
	DPB B,[$HATRK A]
	MOVEM A,QECCAD(Q)
	HLRZ A,A		; A: cylinder
	MOVE D,QSDCH		; D: chnl
	BUG INFO,[DSK: ECC CORRECTED ERROR, UNIT #],DEC,Q,[CYL ],DEC,A,[HEAD ],DEC,B,[SEC ],DEC,C,[QSRAC],OCT,QSRAC(D)
	CAIL E,SECBLK
	 JRST QINTA1		;XFER COMPLETE

	LDB B,[$HASEC QCHPGA]	;NOW DETERMINE WHERE TO RESUME TRANSFER
	ADD B,E
	IDIVI B,NSECS
	DPB C,[$HASEC QCHPGA]
	LDB C,[$HATRK QCHPGA]
	ADD C,B
	DPB C,[$HATRK QCHPGA]	;NO NEED TO IDIVI A,NHEDS SINCE NEVER CROSS
				; CYLINDERS

	HRL E,QERWC		; Reassemble "iowd" from
	HRR E,QERBA		; saved parts.  (Don't trust stuff saved
	MOVEM E,QIOWD		; in controller more than we have to.)
	HRRZ C,QSDCH		;FOR QECCX
	JRST QECCX		;MORE TO DO, CONTINUE XFER

] ;RH11P

IFN RH10P,[

QINT:	AOS QGTBZY
	MOVE Q,QSDU
	MOVEM TT,QCST
	TRNE TT,%HIERR
	 JRST QINTE
	TRNN TT,%HIATN
	 JRST QINT0
	MOVSI A,%HRATN		;FIND DRIVES NEEDING ATTENTION
	PUSHJ P,RHGET
	JFFO A,QINTAT
QINT0:	SKIPGE Q,QSDU
	 JRST QINT1		;NOT EXPECTING COMPLETION OF TRANSFER
	TRNN TT,%HIDON
	 JRST DSKEX		;NO COMPLETED TRANSFER
	CONSZ DSK,%HIBSY
	 JRST 4,.-1		;TRANSFER STILL IN PROGRESS??
	AOSN QHUNGF
	 JRST QHE		;XFER HUNG, RECALIBRATE AND RETRY
	MOVSI A,%HRSTS(Q)	;SOMETIMES %HSERR SETS AND %HIERR DOESN'T!
	PUSHJ P,RHGET
	TRNE A,%HSERR
	 JRST QINTE
	JRST QINTA1		;XFER COMPLETE...

QINTAT:	MOVNI Q,-35.(B)		;LOW BIT IS DRIVE 0
	HRRZS Q
	MOVEI A,1		;TURN OFF ATTENTION (DRIVE MAY BE LOSING
	LSH A,(Q)		;IN SUCH A WAY THAT READING %HRSTS DOESN'T CLEAR ATTN)
	HRLI A,%HRATN
	PUSHJ P,RHSET
	CAMN Q,QSDU
	 JRST [	AOS NQSATN(Q)	;IGNORE ATTN IN MID-TRANSFER
		JRST QINTA2 ]
	MOVSI A,%HRSTS(Q)	;GET STATUS OF DRIVE WITH ATTENTION
	PUSHJ P,RHGET		;THIS ALSO CLEARS THE ATTENTION BIT
	SKIPE QACT(Q)
	 JRST QINTA2		;IGNORE THIS DRIVE
	TRNE A,%HSERR+%HSPIP
	 JRST [	MOVSI A,%HRDCL(Q)
		HRRI A,%HMCLR	;DRIVE REPORTING ERROR NOT DURING TRANSFER
		PUSHJ P,RHSET	;SO CLEAR THE DRIVE
		AOS NQEATN(Q)
		JRST .+1 ]	;THEN CLEAR SEEK AND RECALIBRATE FLAGS
	SETZM QSEEK(Q)		;POSITIONING COMPLETION
	MOVSI A,%HRCCY(Q)
	PUSHJ P,RHGET
	MOVEM A,QPOS(Q)		;UPDATE CURRENT CYLINDER
	CAME A,QPOSGL(Q)
	 SETOM QSKT1(Q)		;SEEK TO WRONG PLACE
	SETZM QRCAL(Q)		;NO LONGER RECALIBRATING
	JRST QINT0		;IF NO XFER ACTIVE, MAYBE CAN START ONE ON THIS UNIT NOW

QINTA2:	SETOM QSKT1(Q)		;DON'T TRUST POS
	JRST DSKEX

;INPUT FROM MASSBUS -  ADDRESS IN LH(A), RETURNS DATA IN A

RHGET:	TLZA A,%HRLOD

;OUTPUT TO MASSBUS -  ADDRESS IN LH(A), DATA IN RH(A)

RHSET:	 TLO A,%HRLOD
	DATAO DSK,A
	MOVEM A,RHDATO		;SAVE FOR REBUGGING
	MOVEI A,5		;WAIT 3 USEC FOR BUS CYCLE
	SOJG A,.
	DATAI DSK,A
	TLNE A,%HDERR
	 BUG HALT,[DSK: MASSBUS ERROR, DATAO=],OCT,RHDATO,[DATAI=],OCT,A
	ANDI A,177777		;RETURN 16-BIT REGISTER CONTENTS
	POPJ P,

QINTE:	CONI DSK,TT
	DATAI DSK,R
	CONO DSK,%HOCLR+%HORAE+%HOATN+DSKCHN	;RESET CONTROLLER SO DRIVE STATUS MAY BE READ
	CONSZ DSK,%HIBSY
	 JRST .-1		;SOMETIMES CONTROLLER IS BUSY??
	MOVEM TT,QERST
	MOVEM R,QERST+1
	SKIPGE Q		;TRY HARD TO GUESS THE RIGHT DRIVE!
	 LDB Q,[$HCDRV R]	;CURRENTLY SELECTED DRIVE
	IRPS X,,[%HRSTS %HRER1 %HRER2 %HRER3 %HRDCL %HRPOS %HRPAT]
	 MOVSI A,X(Q)		;GET STATUS OF DRIVE
	 PUSHJ P,RHGET
	 MOVEM A,QERST+.IRPCNT+2
	TERMIN
	SKIPN QERER2		;FILE UNSAFE
	 SKIPE QERER3
	  JRST UNSAFE
	TRZE TT,%HIDRE
	 AOS NQDRE(Q)		;THIS BIT SUSPECTED OF BEING SET RANDOMLY.
	;;CHECK FOR IRRECOV (?) HARDWARE LOSSAGE. EVEN MORE SO THAN 'UNSAFE'
	TDNE TT,[%HIILF+%HISDE+%HINXM+%HIDRE+%HIILC+%HIPWR]	
	 BUG HALT,[DSK: UNIT ],DEC,Q,[ LOSING. RH10 CONI= ],OCT,QERST
IFN KS10P, .ERR So whats this all about?
IFN KL10P,[
	TLNN TT,(%HIDPE+%HICPE)	;IF CHANNEL DETECTS PARITY ERROR, CAUSE
	 JRST QINTE0		;PROCESSOR PARITY SWEEP WHICH WILL PROBABLY
	MOVSI A,SCLPAR		;CRASH THE SYSTEM ANYWAY.  BEATS LOOPING!
	TDNN A,SUPCOR		;BUT DON'T CAUSE CLKB1E+7 HALT
	 CONO 10407
	BUG CHECK,[DSK: MEM PAR ERR, QICWA/],OCT,QICWA,OCT,QICWA+1,[QIOWD/],OCT,QIOWD
QINTE0:
];KL10P
	TDNE TT,[%HIOVR+%HICOV+%HIDPE+%HICPE+%HIBPE]
	 JRST QINTE1		;OVERRUN OR PARITY ON CONTROL BUS OR CHANNEL BUS - RETRY
	MOVE A,QERSTS		;DRIVE EXCEPTION, CHECK DRIVE STATUS
	TRC A,%HSVV+%HSRDY+%HSDPR+%HSMOL	;THESE BITS BETTER ALL BE ON
	TRCE A,%HSVV+%HSRDY+%HSDPR+%HSMOL
	 BUG			;DRIVE TURNED OFF?  MAYBE 11 HACKING THIS DRIVE?
	TRNN A,%HSERR
	 JRST [	AOS NQSE(Q)	;SPURIOUS?
		JRST QINT0 ]
	MOVE B,QERER1		;CHECK THE MAIN ERROR REGISTER
	TRNE B,#%H1SOF		;ANY HARD ERRORS?
	 JRST UNSAFE
	CAIN B,%H1ECC		;IF JUST A CORRECTABLE ERROR,
	 JRST QECC		;GO CORRECT IT
	PUSHJ P,QINTER		;OTHER SOFT ERROR, PRINT MESSAGE AND RESET DRIVE
	TRNE B,010620		;SEARCH ERROR, OR HEADER READ OR FORMAT ERROR OR DRIVE TIMING 
	 JRST QHE		;REQUIRES RECALIBRATE
	TRNE B,100110		;BUS PARITY OR ECC "HARD"
	 JRST QDE		;REQUIRES RE-READ, GIVE UP AFTER N
	JRST QOVR		;NO ERROR BITS, PRINT MESSAGE AND RETRY

;CONTROLLER ERROR
QINTE1:	BUG INFO,[DSK: ERR UNIT #],DEC,Q,[CONI=],OCT,QERST,[DCL=],OCT,QERDCL
	JRST QOVR

;DRIVE ERROR
QINTER:	BUG INFO,[DSK: ERR UNIT #],DEC,Q,[ER1=],OCT,QERER1,[ER2=],OCT,QERER2,[ER3=],OCT,QERER3,[STARTING DISK ADDR=],OCT,QCHPGA
	MOVSI A,%HRDCL(Q)	;NOW RESET ERROR STATUS IN DRIVE
	HRRI A,%HMCLR
	JRST RHSET

;COME HERE FOR DRIVE UNSAFE AND SIMILAR BAD THINGS.  MAY BE SET TO
;EITHER HALT OR ATTEMPT RETRY (VIA USFHLT VARIABLE).  NOTE THAT WHEN
;WE GET HERE THE STATE OF THE DRIVE HAS NOT YET BEEN DISTURBED.
UNSAFE:	SKIPE USFHLT
	 BUG PAUSE,[DSK: TOO MANY ERRORS]
	MOVEI A,2		;HALT IF ANOTHER ERROR WITHIN 1/2 - 1 SECOND
	MOVEM A,USFHLT
	PUSHJ P,QINTER		;GIVE ERROR MESSAGE AND RESET DRIVE
	JRST QHE		;RECALIBRATE AND RETRY

QECC:	MOVSI A,%HRDCL(Q)	;RESET ERROR STATUS IN DRIVE
	HRRI A,%HMCLR
	PUSHJ P,RHSET
	CAME Q,QSDU		;CORRECT AN ECC ERROR
	 BUG			;BARF ... NO TRANSFER IN PROGRESS
	MOVE A,QCHPRG
	TRNN A,10
	 BUG			;BARF ... SHOULDN'T HAPPEN DURING WRITE
	SKIPN A,QICWA+1		;GET ADDRESS OF LAST WORD READ
	 JRST 4,.-1		;CHANNEL OUGHT TO HAVE STORED CONTROL WORD BY NOW
	SOS J,A
	TDZ J,[177+.BM $DFCWA]	;J := ADDRESS OF FIRST WORD IN LOSING SECTOR
	LDB A,[$DFCAD QIOWD]
	SUBM J,A
	SOS H,A			;# WORDS SUCCESSFULLY XFERED.
	CAIL H,0		;CHECK IF CHANNEL STORED BAD ADDRESS
	 CAILE H,2000-200
	  JRST QDE		;THIS SHOULD NEVER HAPPEN, BUT IT DOES, FREQUENTLY
	MOVE A,QECPOS		;GET ERROR POSITION
	SOJL A,QDE		;HARDWARE POS IS OFF BY 1; IF 0 NOT CORRECTABLE
	IDIVI A,36.		;CONVERT TO WORD NO AND BIT NO
	CAIL A,177
	 JRST [	ADDI B,36.	;LAST WORD IN SECTOR - HACK IT TO AVOID NXM
		SOJA A,.+1]
	ADD J,A			;J := ADDRESS OF LOSING WORD-PAIR
	LDB A,[121400,,J]
	ANDI J,1777		;GET ADDR OF PAR ERR PAG
	ADDI J,400000+2000*PAREP ;IN EXEC ADDRESS SPACE
	IORI A,600000		;MAKE THAT PAGE POINT TO THE DISK BUFFER
	DPB A,[.PAREP+EXEUMP]
	SPM ECCPAG		;GET IT INTO OUR MAP.
	LPMR ECCPAG
	MOVE U,B		;SAVE BIT NUMBER
	MOVS B,(J)		;GET FIRST LOSING WORD
	MOVS C,1(J)		;GET SECOND LOSING WORD
	MOVE D,QECPAT		;GET ERROR PATTERN
	SETZ E,			;MAKE INTO DOUBLE-WORD
	ROTC D,(U)		;ALIGN IT
	XOR B,D			;FIX THE BAD BITS
	XOR C,E
	MOVSM B,(J)		;PUT CORRECTED DATA BACK
	MOVSM C,1(J)
	MOVEI A,0
	DPB A,[.PAREP+EXEUMP]	;FLUSH THE DISK BUFF FROM MAP
	LPMR ECCPAG

	AOS QECCS(Q)		;LOG THE LOSS
	MOVE A,QCHPGA
	MOVEI E,200(H)
	LSH E,-7		;NUMBER OF SECTORS TRANSFERRED (INCLUDING ECC SECTOR)
	LDB B,[$HASEC A]	;GET DISK ADDR OF FAILING SECTOR
	ADDI B,-1(E)
	IDIVI B,NSECS
	DPB C,[$HASEC A]
	LDB D,[$HATRK A]
	ADD B,D
	DPB B,[$HATRK A]	;NO NEED TO DIVIDE BY NHEDS SINCE NEVER CROSS CYLINDERS
	MOVEM A,QECCAD(Q)
	HLRZ A,A
	MOVE D,QSDCH
	BUG INFO,[DSK: ECC CORRECTED ERROR, UNIT ],DEC,Q,[CYL ],DEC,A,[HEAD ],DEC,B,[SEC ],DEC,C,[QSRAC],OCT,QSRAC(D)
	LDB B,[$HASEC QCHPGA]	;NOW DETERMINE WHERE TO RESUME TRANSFER
	ADD B,E
	IDIVI B,NSECS
	DPB C,[$HASEC QCHPGA]
	LDB C,[$HATRK QCHPGA]
	ADD C,B
	DPB C,[$HATRK QCHPGA]	;NO NEED TO IDIVI A,NHEDS SINCE NEVER CROSS CYLINDERS
	HRRZ C,QSDCH		;FOR QECCX
	LDB A,[$DFCWA QICWA+1]	;LAST CONTROL WORD PROCESSED
	SUBI A,1		;CRETINOUS DF10
	CAIE A,QIOWD
	 BUG			;CHANNEL STORED BAD ADDRESS?
	HRRZM A,QICWA
	MOVEI A,200(H)		;# WORDS ALREADY DONE.
	DPB A,[$DFWC A]		;PUT IT IN BOTH FIELDS.
	ADDB A,@QICWA		;ADVANCE C.W. TO REMAINING STUFF
	TLNE A,(.BM $DFWC)
	 JRST QECCX		;MORE TO DO, CONTINUE XFER
	AOS QICWA		;ELSE ADVANCE TO NEXT C.W.
	SKIPE @QICWA
	 JRST QECCX		;MORE TO DO, CONTINUE XFER
	JRST QINTA1		;XFER COMPLETE
]

IFN T300P,[
T3INT:	SETZM DSCDON		;CLEAR DONE FLAG THAT GOT US HERE
	SKIPGE QSDU1		;OPERATION COMPLETE?
	 JRST QINT1		;NO, GO FIND SOMETHING TO DO
	HRRZ Q,DSCDRV		;YES, GET DRIVE OPERATION WAS ON
	ADDI Q,T300P
	CAIGE Q,NQS
	 CAME Q,QSDU1		;TERMINATION ON DRIVE WE EXPECTED?
	  BUG			;DRIVE NUMBER CLOBBERED?
	SETZM QRCAL(Q)		;PRESUMABLY NOT RECALIBRATING ANY MORE.
	MOVE A,DSCCMD		;COMMAND THAT JUST COMPLETED
	CAIN A,%DMREC		;WAS IT A RECALIBRATE?
	 JRST QINT1E		;IF SO, CONTROLLER IS IDLE NOW
	MOVE C,QSDCH1		;CHANNEL
	HRLZ E,DSCFLT		;CHECK FOR ERRORS
	HRR E,DSCSTS
	JUMPE E,QINTI		;OPERATION COMPLETED UNEVENTFULLY
	MOVE D,DSCHED		;GET DISK ADDRESS AS CYL,,HEAD_9+SECTOR
	LSH D,9
	IOR D,DSCSEC
	HRL D,DSCCYL
	SKIPN QERRS(C)		;PRINT ONLY ONCE, NOT ON RETRIES
	 BUG INFO,[DSK: T-300 ERR UNIT ],DEC,Q,[FAULT=],OCT,DSCFLT,[STATUS=],OCT,DSCSTS,[CMD=],OCT,DSCCMD,[CYL-SURF-SEC=],OCT,D
	TRZE E,%DSRTR+%DSECC	;THESE ARE NOT ERRORS	
	 AOS QECCS(Q)
	JUMPE E,QINTI		;OPERATION COMPLETED SUCCESSFULLY (WITH INTERVENTION OF 2561)
	MOVE T,E
	TRZ T,%DSECH+%DSIDE+%DSHCE
	JUMPN T,T3INT2		;CONSIDER USING ERROR RECOVERY FEATURES
	TRNE A,%DMRED		;IF COMMAND IS A READ
	 TRNE A,10		;AND WE HAVEN'T TRIED THEM ALL
	  JRST T3INT2
	AOS NQSE(Q)		;COUNT "SOFT ERRORS" (NOT "SPURIOUS" IN T-300 CASE)
	AOJA A,T3IO1		;GO RETRY OPERATION USING NEXT FEATURE

T3INT2:	TLNN E,-1		;ANY FAULT?  PROBABLY UNRECOVERABLE BUT TRY RECALIBRATE
	 TRNE E,%DSIDE+%DSHCE+%DSSKE+%DSOFL+%DSFLT	;DISK CONDITION THAT CALLS FOR RECAL
	  JRST T3HE
	JRST T3DE		;TRY OPERATION AGAIN.  PROBABLY WILL LOSE BUT TRY.
];T300P

OVHMTR QSC	;DISK SCHEDULER (AND HIGHER-LEVEL INTERRUPT STUFF)

QINTA1:	SKIPL C,QSDCH		;XFER COMPLETE
QINTI:	SKIPGE A,QSCABN(C)	;CHANNEL IN C
	 BUG			;MEMBLT INDEX IN A
	MOVE R,A		;BUFFER ADDRESS IN R
IFN KL10P,[			;QSRAC IN D, QSK# IN Q
	SKIPL QSCRW(C)		;IF READ, FLUSH CACHE AGAIN
	 JRST [	PUSHJ P,CSHSWP	;SINCE USER MIGHT HAVE TOUCHED ABS PAGE
		    CAIA
		MOVE A,R	;A WAS CLOBBERED
		JRST .+1 ]
]
IFN KS10P,[
	SKIPL QSCRW(C)		;ON KS, CAN ONLY CLEAR THE WHOLE CACHE
	 CLRCSH
]
	LSH R,10.
	MOVE D,QSRAC(C)
IFN RP10P,[
	HRRZ TT,QICWA+1
	CAIE TT,1777(R)
	 TLNE D,%QAPAR		;IGNORE IF LOSING ANYWAY (E.G. SEARCH ERR)
	  CAIA
	   JRST QDFLOS
];RP10P
IFN QRDCMP,[
	SKIPE TT,RDCPHS		;NEED TO READ-COMPARE?
	 JRST QRC1		;READ-COMPARE STARTING OR FINISHED
QRC0:
];QRDCMP
	TRNE D,-%QMMAX
	 BUG
	XCT .+1(D)		;INVOKE COMPLETION HANDLER
	OFFSET -.
%QMIDL::JRST 4,QINT1		;IDLE - SHOULDN'T BE ACTIVE
%QMRD::	JRST QRDFIN		;READ
%QMWRT::JRST QWRFIN		;WRITE
%QMWOV::JRST QWOVFN		;WRITE-OVER MODE
%QMRD1::JRST QRD1FN		;READ BLOCK AT A TIME MODE
	JRST 4,QINT1		;ILL CODE
%QMUDR::JRST QUDRIN		;USER DIR IN
%QMMDR::JRST QMDRIN		;MASTER DIR IN
%QMTTR::JRST QTUTIN		;TUT IN
%QMUDW::JRST QUFDWF		;USER DIR WRITE
%QMMDW::JRST QMFDWF		;MASTER DIR WRITE
%QMTTW::JRST QTUTWF		;TUT WRITE
%QMSWP::JRST QSWPFN		;SWAP FINISHED
	JRST 4,QINT1		;ILL CODE
	JRST 4,QINT1		;ILL CODE
	JRST 4,QINT1		;ILL CODE
%QMMAX::OFFSET 0
IFN %QMMAX-20, .ERR %QMMAX MUST BE A POWER OF 2

IFN RP10P,[
;CHANNEL DIDN'T TRANSFER EXACTLY 2000 WORDS
QDFLOS:	MOVEI D,1777(R)		;EXPECTED TERMINATION ADDRESS
	HRRZ B,QICWA+1		;ACTUAL TERMINATION ADDRESS
	CAIL B,(D)
	 SKIPL QSCRW(C)
	  JRST QDFLZ1
	BUG HALT,[DSK: CHANNEL TRANSFERRED UP TO ],OCT,B,[RATHER THAN],OCT,D,[DISK IS CLOBBERED NOW.]

QDFLZ1:	BUG PAUSE,[DSK: CHANNEL TRANSFERRED UP TO ],OCT,B,[RATHER THAN],OCT,D
	JRST QOVR
];RP10P

;;; SOFTWARE READ-COMPARE ROUTINES

IFN QRDCMP,[
IFE RP10P+RH10P, .ERR READ-COMPARE ONLY CODED FOR RP-10 AND RH10
;IFE KA10P, .ERR READ-COMPARE ONLY CODED FOR KA-10

;;; REGULAR OPERATION COMPLETE, DO A READ-COMPARE TO BE SURE
QRC1:
IFN T300P, CAIGE Q,T300P	;NO READ/COMPARE IF THIS IS T-300 CONTROLLER
	TLNE D,%QAPAR		;GIVING UP WITH FATAL ERR?
	 JRST QRC0		;NO READ-COMPARE THEN
	JUMPG TT,QRC2		;JUMP IF READ-COMPARE COMPLETED
	MOVE E,QSGL(C)		;DISK BLOCK
	PUSHJ P,QPOSR		;E GETS DATAO WORD
IFN RP10P,[
	IOR E,[DREADC+7000+RCICWA]	;MAKE READ COMMAND
	CONO DPC,175700+DSKCHN
	MOVE T,[-2000,,QRCBUF-1]	;STORE CHANNEL PROGRAM
	MOVEM T,RCIOWD
	SETZM RCIOWD+1
	MOVEI T,RCIOWD
	MOVEM T,RCICWA
	SETZM RCICWA+1
	DATAO DPC,E		;START DISK
];RP10P
IFN RH10P,[
	MOVE T,[-2000_4,,QRCBUF-1]	;DF10-C CHANNEL PROGRAM
	MOVEM T,RCIOWD
	SETZM RCIOWD+1
	MOVEI T,RCIOWD
	MOVEM T,RCICWA
	SETZM RCICWA+1
	SWPUA			;DUMP CACHE
	CONSZ 200000		;IT'S INEFFICIENT, BUT WHAT THE HELL
	 JRST .-1
	CONO DSK,%HOCLR+%HORAE+%HOATN+DSKCHN
	MOVSI A,%HRADR(Q)
	HRR A,E			;HEAD AND SECTOR (CYL DOESN'T CHANGE)
	PUSHJ P,RHSET
	MOVEI A,%HMRED+<RCICWA_6>
	TLO A,%HRCTL(Q)
	PUSHJ P,RHSET		;START DISK
];RH10P
	MOVEM T,RDCPHS		;RDCPHS POSITIVE MEANS DOING RD/CMP NOW
	JRST DSKEX		;AWAIT COMPLETION

;;; READ-COMPARE COMPLETED.  CHECK IT.
QRC2:	SPM PARPG		;SET UP MAP TO PAGE BEING READ/WRITTEN
	MOVEI T,600000+PMCSHM(A)
	DPB T,[.PAREP+EXEUMP]
	LPMR PARPG
	MOVEI H,0		;H DIFFERENCE COUNT
IFN KA10P,[
	PUSH P,A		;WILL DO COMPARE LOOP IN ACS
	PUSH P,C
	PUSH P,D
	MOVSI E,-2000		;E ADDRESS WITHIN PAGE
	MOVSI D,[ MOVE T,400000+PAREP*2000(E)	;A
		  CAMN T,QRCBUF(E)		;B
		   AOBJN E,A			;C
		  JRST QRC3 ]			;D
	HRRI D,A
	BLT D,D
	JRST A
];KA10P
.ELSE [
	MOVSI E,-2000		;E ADDRESS WITHIN PAGE
	MOVE T,400000+PAREP*2000(E)
	CAMN T,QRCBUF(E)
QRC2A:	 AOBJN E,.-2
];NOT KA10P
QRC3:	JUMPGE E,QRC5		;JUMP IF DONE
	JUMPG H,QRC4		;COMPARE ERROR, REPORT IT
	AOS NQCMPE(Q)
IFN KA10P,[
	MOVE T,-1(P)		;SAVED C
	BUG INFO,[DSK: READ-COMPARE ERROR #],DEC,NQCMPE(Q),[UNIT=],DEC,Q,[BLK=],OCT,QSGL(T)
];KA10P
.ELSE	BUG INFO,[DSK: READ-COMPARE ERROR #],DEC,NQCMPE(Q),[UNIT=],DEC,Q,[BLK=],OCT,QSGL(C)
QRC4:	ADDI H,1
	HRRZ T,E
	CAIG H,4		;ONLY REPORT FIRST 4 BAD WORDS
	 BUG INFO,[DSK: READ-COMPARE DIFFERENCE ],OCT,T,OCT,400000+PAREP*2000(E),OCT,QRCBUF(E)
IFN KA10P,JRST C
.ELSE	JRST QRC2A

QRC5:
IFN KA10P,[
	POP P,D
	POP P,C
	POP P,A
];KA10P
	MOVEI T,0		;CLEAR MAP
	DPB T,[.PAREP+EXEUMP]
	LPMR PARPG
	JUMPE H,QRC0		;NO DIFFERENCE, I/O OPERATION IS DONE
	CAILE H,4		;FAILED, DO IT ALL OVER AGAIN
	 BUG INFO,[DSK: READ-COMPARE DIFFERENCES TOTAL],DEC,H
	JRST QOVR
];QRDCMP

QUFDWF:	MOVE TT,QDWIP
	CAMN Q,MDSK		;WRITTEN TO MASTER DISK?
	 SKIPN E,QSFBT(TT)	;AND HAVE SOME BLOCKS TO FREE?
	  JRST QUDWF1
	SETZM QSFBT(TT)		;YES, TRANSFER THEM TO QFBTS LIST
	MOVE T,E		;E FINDS LAST OF LIST, T RPLACD'D IN THERE
	EXCH T,QFBTS		;NCONC QSFBT ONTO FRONT OF QFBTS
	SKIPE 1(E)
	 JRST [	MOVE E,1(E)
		JRST .-1 ]
	MOVEM T,1(E)
	SKIPN T
	 AOS NCORRQ		;WAKE UP CORE JOB IF QFBTS HAD BEEN EMPTY
QUDWF1:	JSP D,QDWF
	    QSNLCN(TT)

QMFDWF:	JSP D,QDWF
	    QMDRO

QTUTWF:	AOS T,QSGL(C)		;NEXT BLOCK TO GO OUT
	AOS QSCABN(C)		;FROM NEXT CORE PAGE
	CAIGE T,MFDBLK		;SKIP IF DONE
	 JRST QINT1E		;WRITE MORE
	JSP D,QDWF
	    QTUTO(TT)

QDWF:	MOVSI E,(SETZ)		;UNLOCK DIR THAT WAS WRITTEN
	IOR E,DCHBT(Q)		;COPY ON THIS DISK IS NOW UP TO DATE
	MOVE TT,QDWIP
	ANDCAM E,@(D)
	HLLZS QSRAC(C) .SEE %QMIDL	;IDLE THE CHANNEL
	SETOM DWUSR
	JRST QINT1A		;DON'T COUNT THIS AS DISK ACTIVITY

QUDRIN:	MOVE TT,QUDPR(C)	;USER DIR IN OK
	MOVE D,UDNAME(R)
	CAME D,QSNUD(TT)	;COMPARE UNAME IN DIR WITH RQ'ED
	 JRST QUDER1
	TLO R,40000		;NOT PAWED OVER
	MOVEM R,QSNLCN(TT)
	MOVE R,QSLGL(C)
	MOVEM R,QSNMI(TT)
	MOVEI R,MU23UD		;USER DIRECTORY
	PUSH P,A
	PUSH P,C
	MOVE C,TT
	PUSHJ P,QDIRCK		;VERIFY NOT TOTALLY BASHED TO BEGIN WITH
	POP P,C			;CLOBBERS A,B,I
	POP P,A
QINTU4:	DPB R,[MUR,,MEMBLT(A)]
	DPB TT,[MNUMB,,MEMBLT(A)]
QTUTI1:	SETOM QUSR(C)		;FREE THE DISK CHANNEL
	AOS QFCHN
	JRST QINT1A

QMDRIN:	TLO R,2			;NOT RECONCILED
	MOVEM R,QMDRO		;MASTER DIRECTORY IN
	MOVE TT,MDCHK(R)
	CAME TT,[SIXBIT /M.F.D./]
	 BUG HALT,[MFD CLOBBERED]
	MOVE TT,MDNUDS(R)
	CAIE TT,NUDSL
	 BUG HALT,[MFD HAS WRONG NUMBER OF DIRECTORIES]
	MOVE TT,(R)		;ASCENDING DIR #
	SKIPGE QAMDNO
	 MOVEM TT,QAMDNO	;FIRST DISK IN STORE ASCENDING #
	MOVEI R,MU23MD		;MASTER DIRECTORY
	MOVE TT,Q		;DISK NO
	JRST QINTU4

QTUTIN:	AOS T,QSGL(C)		;NEXT BLOCK TO COME IN
	AOS QSCABN(C)		;INTO NEXT CORE PAGE
	CAIGE T,MFDBLK		;SKIP IF DONE
	 JRST QINT1E		;READ MORE
	HRRZS QTUTO(Q)		;UNLOCK TUT, BUT QDPWF IS STILL SET
	JRST QTUTI1

QSWPFN:	MOVE Q,QDSKN(C)
	TLNE D,%QAPAR
	 JRST QSWPF2		;SWAP READ ERROR (I HOPE)
	MOVSI E,MMPTMP		;PAGE NO LONGER IN TRANSIT
	TDNN E,@QSMMP(Q)
	 BUG			;ALREADY WASN'T?
	ANDCAM E,@QSMMP(Q)
	SKIPL QSCRW(C)
	 JRST QSWPIF
	PUSHJ P,IMEMR		;SWAP-OUT COMPLETE, RETURN MEMORY
	MOVSI E,MMPPGB
	ANDCAM E,@QSMMP(Q)
	MOVSI E,MMPWOD		;PAGE HAS BEEN WRITTEN ON DISK.  AND NO LONGER
	IORB E,@QSMMP(Q) 	;BEING PAGED BEHIND.
	TLNN E,MMPGON
	 JRST QSWPF2
	MOVE A,QSMMP(Q) 	;WE'RE SUPPOSED TO RETURN THE MMP ENTRY
	PUSHJ P,RETMMP
QSWPF2:	SETOM SWUSR(Q)		;SWAPPING IDLE
	JRST QINT1B

QSWPIF:
;SOME ERROR CHECKING
	MOVE E,QSMMP(Q)
	HLLZ TT,1(E)
	JUMPE TT,QSWPF3		;ON INITIAL-SWAP-IN, ADDRESS IN MMP IS SUPPOSED TO BE ZERO
	LDB TT,[$MMPUN,,(E)]
	CAME TT,Q
	 BUG
	HLRZ TT,1(E)
	CAME TT,QSGL(C)
	 BUG
QSWPF3:	LDB TT,[MMMPX,,MEMBLT(A)]
	CAIE TT,-MMP(E)
	 BUG
;END ERROR CHECKING
	MOVEI TT,MURUSR		;SWAP IN OF PAGE COMPLETED
	DPB TT,[MUR,,MEMBLT(A)]
	SETZM MMSWP(A)
	MOVE D,(E)
	SKIPL CIRPSW
	 JRST QSWPF2		;CAN'T PUT IN MAPS IF CIRPSW NOT AVAILABLE.
	MOVSI D,(TDNE T,)	;SET UP CHECK USED BY PRIVELEGED USER FEATURE
	HRR D,QSMMP(Q)
	PUSH P,C
	PUSH P,Q
	MOVE C,[2200,,MEMPNT(A)]
	PUSHJ P,PPIUM		;PUT PAGE INTO USERS' MAPS
	POP P,Q
	POP P,C
	JRST QSWPF2

QWOVFN:	CLEARM QSCRW(C)		;WRITE OVER SWITCH TO READ MODE
	HRRI D,%QMRD1
	TLZE D,%QAEFW
	 HRRI D,%QMIDL		;TRYING TO CLOSE, STOP CHANNEL
	MOVEM D,QSRAC(C)
	AOS QWBUFS		;COMPENSATE FOR EXTRA SOS BELOW

QWRFIN:	TLNN D,%QACTH		;WRITE COMPLETE, RETURN BUFFER
	 PUSHJ P,IMEMR
	TLNE D,%QACTH
	 PUSHJ P,CIMEMR
	SOS QSBFS(C)
	SOS QWBUFS
	MOVE TT,QSGL(C)
	MOVEM TT,QSLBLK(C)
	JRST QINT1B

QRD1FN:	HLLZS QSRAC(C) .SEE %QMIDL	;BLOCK-AT-A-TIME READ COMPLETE, IDLE THE CHANNEL

QRDFIN:	MOVEI B,.BM MLO		;NORMAL READ COMPLETED
	ANDCAM B,MEMBLT(A)	;THREAD ONTO CHANNEL LIST
	HLRZ B,QBFP(C)
	SKIPE B
	 DPB A,[MLO,,MEMBLT(B)]
	SKIPN B
	 MOVEM A,QBFP(C)
	HRLM A,QBFP(C)
	SKIPL B,QPIBSZ(C)	;GET BYTE COUNT OF BLOCK
	 JRST QRDFN1
	HRRZ B,1777(R)		;FUNNY BLOCK, GET FROM LAST WORD
				; 8/20/90 No more funny blocks
	HRRZ TT,QSBYTE(C)	;AND MAKE SURE IT'S NOT TOO BIG
	IMULI TT,2000
	CAMLE B,TT
	 MOVE B,TT
QRDFN1:	HRRZM B,MEMPNT(A)	;PASS TO MAIN PROGRAM
	AOS QSBFS(C)
IFE DMDSK,	LDB B,[XWBLK QXWDS]
     .ALSO	MOVEM B,QSLBLK(C)

;XFER COMPLETE, DEACTIVATE CHANNEL

QINT1B:	SETOM QACTTM
QINT1A:	SETOM QSGL(C)
	SETOM QSCABN(C)
QINT1E:
IFE DC10P, SETOM QSKT1(Q)
IFN DC10P,[
	MOVE TT,QTRAN(Q)
	SETOM QSKT1(TT)
] ;DC10P
IFN T300P,[
	CAIL Q,T300P
	 SETOM QSDU1
	CAIGE Q,T300P
	 SETOM QSDU
];T300P
.ELSE	SETOM QSDU
;DROPS THROUGH
;DROPS IN

;ACTIVATE CHANNELS, LOOK FOR SEEKS AND TRANSFERS TO BE DONE

QINT1:	SETZM QHUNGF
	SETOM QTUNT		;NO UNIT SELECTED YET
IFN T300P, SETOM QTUNT1
	MOVE C,QTCHN		;START SCAN IN SUITABLE PLACE
	MOVEM C,QLCHN
	JRST QINT2D

QINT2L:	CAIGE C,NQCHN		;IF DIR-WRITE OR SWAP CHANNEL, DON'T CHECK QUSR
	 SKIPL QUSR(C)
	  SKIPGE D,QSRAC(C)	.SEE %QALOK
	   JRST QINT2C		;CHANNEL LOCKED OR NOT OPEN, SKIP IT
	MOVE Q,QDSKN(C)
	SKIPL E,QSGL(C)
	 JRST QINT4		;JUMP IF CHANNEL ACTIVE ALREADY
	TLNE D,%QACTH+%QAOUT
	 JRST QINT2C		;CHANNEL BLOCKED BY CORE JOB, DON'T ACTIVATE
	TRNE D,-%QMMAX
	 BUG
	XCT .+1(D)		;INVOKE ACTIVATE HANDLER
	OFFSET -.
%QMIDL::JRST QINT2C		;IDLE - DON'T ACTIVATE
%QMRD::	JRST QRDACT		;READ
%QMWRT::JRST QWRACT		;WRITE
%QMWOV::JRST QWRACT		;WRITE OVER
%QMRD1::JRST QRDACT		;READ 1 BLOCK
	JRST 4,QINT2C		;ILL CODE
%QMUDR::JRST QDRACT		;UFD READ
%QMMDR::JRST QDRACT		;MFD READ
%QMTTR::JRST QDRACT		;TUT READ
%QMUDW::JRST 4,QINT2C		;UFD WRITE - SHOULDN'T LEAVE THIS MODE AROUND
%QMMDW::JRST 4,QINT2C		;MFD WRITE - ..
%QMTTW::JRST QINT5		;TUT WRITE - MAY BE WRITING SECOND PAGE
%QMSWP::JRST SWPACT		;SWAP
	JRST 4,QINT2C		;ILL CODE
	JRST 4,QINT2C		;ILL CODE
	JRST 4,QINT2C		;ILL CODE
%QMMAX::OFFSET 0

; ACTIVATION ROUTINES

SWPACT:	SKIPL SWUSR(Q)
	 BUG			;SWAPPING ALREADY ACTIVE ON THIS DISK
	MOVE A,MEMFR
	SUB A,NCBCOM
	MOVEI B,0		;CHECK FIRST FOR SWAP IN OR OUT
	CAIGE A,6		;ACCORDING TO AVAIL MEM
	 MOVEI B,1
	SKIPN @SWAPL(B)		;IF NO TRAFFIC THAT DIRECTION, CHECK THE OTHER.
	 TRC B,1
	HRRZ E,@SWAPL(B)
	JUMPE E,QINT2C		;NO SWAPPING TRAFFIC THIS DISK.
	LDB A,[MLO,,MEMBLT(E)]	;TAKE BLOCK OFF LIST
	SKIPN A
	 SETZM @SWAPL(B)	;LAST BLOCK, LIST IS NOW EMPTY
	HRRM A,@SWAPL(B)	;SET NEW FIRST BLOCK
	LDB D,[MMMPX,,MEMBLT(E)]
	ADD D,MMPEAD		;GET MMP ADDRESS
	LDB TT,[410200,,(D)]
	TRNN TT,1
	 BUG			;THIS PAGE SHOULD BE MARKED IN TRANSIT
	HRRZM D,QSMMP(Q)
	SOS SILNG(B)
	CAIGE E,TSYSM
	CAIGE E,SYSB
	 BUG
	HRRZM E,QSCABN+NQCHN+1(Q)
	CLEARM SWUSR(Q)		;CHNL ACTIVE
	HLRZ E,MEMPNT(E)
	MOVEM E,QSGL+NQCHN+1(Q)	;DISK BLOCK
	HRRZS QSRAC+NQCHN+1(Q)	.SEE %QMSWP
	MOVNM B,QSCRW+NQCHN+1(Q) ;DIRECTION
	CLEARM QERRS+NQCHN+1(Q)	;NO ERRORS (YET)
	JRST QINT4		;CHANNEL SUCCESSFULLY ACTIVATED


; MORE ACTIVATION ROUTINES 

QRDACT:	TLNE D,%QAACC		;ACTIVATE READ CHANNEL
	 JRST QINT2C		;NOT IF USER HACKING RANDOM ACCESS NOW
	SETZM QERRS(C)
	MOVE J,QUDPR(C)
	SKIPGE QSNLCN(J)
	 JRST QINT2C		;USER DIRECTORY OUT OR LOCKED
	MOVE A,QSBFS(C)
	SKIPL QSMDN(C)
	 AOS A			;A := TOTAL NUMBER OF BUFFERS
	CAMLE A,QRDAHD		;HOW MUCH SHOULD BE READ AHEAD
	 JRST QINT2C		;BLOATED, DON'T ACTIVATE
	SKIPE QSBI(C)
	 JRST QINT4A		;BLOCKS LEFT FROM LAST TIME
QINT4B:	PUSHJ P,QIDRCH		;GET NEXT DESC BYTE IN A, ALSO RET BYTE PNTR IN TT
	CAIN A,UDWPH
	 JRST QINT4B
	JUMPE A,QEOF		;REACHED READ EOF
	TRZE A,40
	 JRST QINT4C
	CAILE A,UDTKMX
	 JRST QINT4D		;SKIP AND TAKE
	MOVEM A,QSBI(C)		;TAKE NEXT N
QINT4A:	SOS QSBI(C)
	AOS E,QSLGL(C)
QINT4G:	MOVEM E,QSGL(C)
	MOVSI B,%QALBK
	ANDCAM B,QSRAC(C)	;CLEAR PROCESSING LAST BLOCK IN FILE BIT
	HRRZ A,QSBYTE(C)
	IMULI A,2000		;NUMBER OF BYTES IN A FULL BLOCK
IFN DMDSK,[
	MOVSI D,%QAFNY		;FUNNY FILE
	TDNE D,QSRAC(C)
	 SETO A,
]
	MOVEM A,QPIBSZ(C)	;SET FUNNY BIT
	SKIPE QSBI(C)
	 JRST QINT4		;IF MORE BLOCKS FOLLOW DON'T CHECK EOF
	PUSHJ P,QIDRCH		;GET NEXT DESCR BYTE
	SOS QDIRP(C)		;CORRECT PNTR
	JUMPN A,QINT4
	MOVE A,QUDFPR(C)	;THIS IS LAST BLOCK
	ADD A,QSNLCN(J)
	LDB D,[UNBYTE+UNREF(A)]
	PUSHJ P,QBDCD
	IMUL D,E		;NUMBER OF UNUSED BITS IN LAST WORD
	LDB E,[QSBSIZ(C)]	;(DEPEND ON DIVIDE ROUNDING DOWN)
	IDIV D,E		;NUMBER OF UNUSED BYTES (IN SIZE OPEN)
	LDB E,[UNWRDC+UNRNDM(A)];NUMBER OF USED WORDS IN LAST BLOCK
	SKIPN E
	 MOVEI E,2000
	IMULI E,@QSBYTE(C)	;CONVERT TO NUMBER OF BYTES
	SUB E,D			;NUMBER OF VALID BYTES IN BLOCK
	HRRM E,QPIBSZ(C)	;STORE BYTE COUNT OF LAST BLOCK
	IORM B,QSRAC(C) .SEE %QALBK
	MOVE E,QSGL(C)
	JRST QINT4

QINT4D:	MOVEI E,1-UDTKMX(A)	;SKIP N AND TAKE 1
	ADDB E,QSLGL(C)
	JRST QINT4G

QWRACT:	SKIPN I,QBFP(C)		;ACTIVATE WRITE CHANNEL
	 JRST QINT2C		;END OF WRITE LIST FOR NOW
	HRRZM I,QSCABN(C)
	LDB H,[MLO,,MEMBLT(I)]
	HRRM H,QBFP(C)
	SKIPN H
	 SETZM QBFP(C)		;LAST BLOCK, LIST NOW EMPTY
	HLRZ E,MEMPNT(I)
	MOVEM E,QSGL(C)
	JRST QINT4

QDRACT:	MOVE E,QSLGL(C)		;ACTIVATE DIRECTORY-READ CHANNEL
	MOVEM E,QSGL(C)
;	JRST QINT4		;DROPS THROUGH
;DROPS IN
QINT4:	SKIPL QSCABN(C)		;SKIP IF NEED MEMORY
	 JRST QINT5
	PUSHJ P,IOMQ		;GET MEMORY FOR READ BUFFER
	 JRST QINT2C		;CAN'T
QINT5A:	MOVEM A,QSCABN(C)
	MOVEI D,MU23B
	DPB D,[MUR,,MEMBLT(A)]
	DPB C,[MNUMB,,MEMBLT(A)]

QINT5:
IFN DC10P, MOVE TT,QTRAN(Q)
.ELSE	   MOVE TT,Q
	SKIPN QSEEK(TT)		;IGNORE SEEKING DRIVE
	 SKIPGE QRCAL(TT)	;IGNORE RECALIBRATING DRIVE
	  JRST QINT2C
IFN T300P,[			;IGNORE IF FOR CONTROLLER THAT IS NOT READY
	CAIL TT,T300P
	 JRST [	SKIPGE QSDU1
		 SKIPL QTUNT1	;NOTE CODE HERE IS SIMILAR TO THAT AT QINT2F
		  JRST QINT2C	;T-300 CONTROLLER BUSY OR ALREADY COMMITTED
		HRRZM Q,QTUNT1	;WILL TRANSFER ON THIS UNIT
		HRRZM C,QTCHN1	;FOR THIS CHANNEL
		JRST QINT2C ]	;T-300 CODE IS SIMPLIFIED SINCE NO SEEK OVERLAPS
	SKIPL QSDU
	 JRST QINT2C
];T300P
	HRRZ B,QSKT1(TT)
	CAIN B,(C)
	 JRST QINT2F		;ALREADY SET FOR ME
	SKIPL QSKT1(TT)
	 JRST QINT2C		;SET FOR SOME OTHER CHNL
	HRRZM C,QSKT1(TT)	;AVAILABLE, SET IT FOR ME
	PUSHJ P,QPOSR		;CONVERT DISK ADDRESS TO PHYSICAL
IFN DC10P,[			;AND INITIATE SEEK
	ADD E,[DSEEK]
	CONSZ DC0,DSSRUN+DSSACT
	 JRST .-1
	DATAO DC0,E
	LDB B,[DCYL E]
	MOVE TT,QTRAN(Q)	;PRETEND SEEK ALREADY COMPLETE
	MOVEM B,QPOSGL(TT)
	MOVEM B,QPOS(TT)
	JRST QINT2F		;DON'T WAIT FOR SEEK, START TRANSFER RIGHT AWAY
] ;DC10P
IFN RP10P,[
	TLO E,(DSEEKC)		;DSK SEEK
	CONSZ DPC,20
	 JRST 4,.-1
	LDB TT,[DCYL E]
	TRNE E,.BM DCYLXB
	 ADDI TT,400
	CAMN TT,QPOS(Q)
	 JRST QINT2F		;IF WE'RE THERE, DON'T SEEK
	MOVEM TT,QPOSGL(Q)
	DATAO DPC,E
	MOVEM E,QSEEK(Q)
	JRST QINT2C		;THIS ONE SEEKING, GO GET ANOTHER
] ;RP10P
IFN RH11P,[
	PUSHJ P,RHSLCT		; Select drive
	HRRZ A,E
	IOWRQ A,%HRADR		; Set track and sector
	HLRZ A,E
	IOWRQ A,%HRCYL		; Set cylinder
	CAMN A,QPOS(Q)
	 JRST QINT2F		; On cylinder, don't seek
	MOVEM A,QPOSGL(Q)
	MOVEI A,%HMSEK
	PUSHJ P,RHCMD		; Start seeking
	SETOM QSEEK(Q)
	JRST QINT2C		; Start other drives now?
] ;RH11P
IFN RH10P,[
	MOVSI A,%HRCYL(Q)	;STORE ADDRESS IN DRIVE
	HLR A,E
	PUSHJ P,RHSET
	MOVSI A,%HRADR(Q)
	HRR A,E
	PUSHJ P,RHSET
	HLRZ TT,E		;GET CYLINDER PART OF ADDRESS
	CAMN TT,QPOS(Q)
	 JRST QINT2F		;ON CYLINDER, DON'T SEEK
	MOVEM TT,QPOSGL(Q)
	MOVSI A,%HRDCL(Q)	;START SEEK
	HRRI A,%HMSEK
	PUSHJ P,RHSET
	SETOM QSEEK(Q)
	JRST QINT2C		;THIS ONE SEEKING, START OTHER DRIVES
] ;RH10P

IFN KL10P,[
;CALL HERE TO SWEEP THE CACHE.  CORE PAGE # IN R.
;INSTRUCTION AT CALL+1 SHOULD SKIP IF READING INTO CORE.
;CLOBBERS A,B,D,E,TT.

CSHSWP:	SETZB A,B		;A COUNTS WAIT TIME, B IS SWEEP INSTRUCTION
	XCT @(P)
	 TLOA B,(SWPUO (R))	;WRITE - UNLOAD PAGE FROM CACHE
	  MOVSI B,(SWPIO (R))	;READ - CLEAR PAGE FROM CACHE
	LSH R,1			;HARDWARE PAGES ARE 1/2 K
	XCT B			;SWEEP FIRST HALF-PAGE
	MOVE D,[CONSZ 200000]
	MOVE E,[AOJA A,D]
	MOVSI TT,(POPJ P,)
	PUSHJ P,D		;WAIT IN ACS TO MINIMIZE MBOX INTERFERENCE
	AOS R			;SWEEP SECOND HALF-PAGE
	XCT B
	PUSHJ P,D
	XCT @(P)
	 AOSA NCSHU		;COUNT NUMBER OF TIMES THIS DONE
	  AOSA NCSHI
	   JRST [ ADDM A,NCSHUL ? JRST .+2 ]
	  ADDM A,NCSHIL		;AND COUNT NUMBER OF LOOPS IN ACS
	LSH R,-1
	JRST POPJ1
]

;VARIOUS EXITS FROM CHANNEL-CHECKING ROUTINES

QINT2F:	SKIPL QTUNT		;THIS CHANNEL IS READY TO TRANSFER
	 JRST QINT2C		;ALREADY FOUND A TRANSFER
	HRRZM Q,QTUNT		;WILL TRANSFER ON THIS UNIT
	HRRZM C,QTCHN		;FOR THIS CHANNEL
QINT2C:	CAMN C,QLCHN		;CONTINUE CHANNEL SCAN
	 JRST QINT2E		;UNLESS CHECKED ALL CHANNELS
QINT2D:	CAIL C,NQCHN+1+NQS-1	;SKIP IF NOT TIME TO WRAP AROUND
	 SETO C,
	AOJA C,QINT2L		;CHECK ANOTHER

QINT2E:
IFN T300P,[
	MOVE C,QTCHN1
	SKIPL Q,QTUNT1		;FOUND XFER FOR T-300?
	 JRST QDE1		;YES
];T300P	
	SKIPGE Q,QTUNT		;FOUND XFER?
	 JRST QINT3		;IDLE
	MOVE C,QTCHN
;Q DISK TO TRANSFER ON, C CHANNEL.  START (OR RESTART) TRANSFER ON THEM.
QDE1:	MOVE R,QSCABN(C)
IFN KL10P,[
	PUSHJ P,CSHSWP
	  SKIPGE QSCRW(C)
];KL10P
IFN KS10P,[
	SKIPL QSCRW(C)
	 CLRCSH
];KS10P
IFE T300P, MOVEM C,QSDCH
IFN T300P,[
	CAIL Q,T300P
	 JRST T3IO		
	CAIGE Q,T300P
	 MOVEM C,QSDCH
];T300P
	SKIPGE B,QSCRW(C)	;LOAD R/W STATUS IN B
	 JRST QINT6W
;READ - DROPS IN
IFN RP10P,[
	MOVSI T,(DREADC)
QINT6A:	IORI T,7000+QICWA	;DON'T STOP FOR PARITY ERRORS (PLUS INITIAL CHNL ADR)
	MOVEM T,QCHPRG
	DPB Q,[DUNFLD+QCHPRG]
	HLLZS QIOWD
	DPB R,[121000,,QIOWD]
	LDB E,[100300,,R] 	;MA15-17
	TRC E,7
	DPB E,[410300,,QIOWD]	;SET UP HIGH ADDR BITS.
	MOVE TT,QIOWD
	SOS TT
	HRRM TT,QIOWD
	SETZM QIOWD+1
	MOVEM Q,QSDU
	MOVE E,QSGL(C)
	PUSHJ P,QPOSR
	IORM E,QCHPRG
QOVR:	CONSZ DPC,20
	 JRST QOVR
	SKIPGE Q,QSDU
	 BUG
	CONO DPC,175700+DSKCHN
IFN QRDCMP,[
	SETZM RDCPHS		;ASSUME NO READ-COMPARE WANTED
	SKIPE QRCSW
	 SETOM RDCPHS		;REMEMBER TO READ-COMPARE LATER
];QRDCMP
	MOVEI TT,QIOWD
	HRRZM TT,QICWA
	MOVE E,QCHPRG
	LDB TT,[DCYL E]
	TRNE E,.BM DCYLXB
	 ADDI TT,400
	CAME TT,QPOS(Q)
	 BUG			;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
	SETZM QICWA+1
	DATAO DPC,QCHPRG	;ENTRY ON OVERRUN
	MOVE A,TIME
	MOVEM A,LQTM
	MOVEM Q,QSDU
	CAILE C,NQCHN
	 JRST .+5
	  SKIPL B
	   AOSA NRXFR
	    AOS NWXFR
	  JRST QINTX
	SKIPL B
	 AOSA NSRXFR
	  AOS NSWXFR
QINTX:	JRST DSKEX

QHUNG:	CONO DPC,DCLEAR+20+DSKCHN	;DISK NOTICED TO BE HUNG, RESET IT
	SETOM QHUNGF			;TELL P.I. LEVEL TO RETRY OPERATION
	MOVE Q,QSDU
	AOS NTQHNG(Q)
	BUG INFO,[DSK: HUNG ON UNIT ],DEC,QSDU,[QCHPRG=],OCT,QCHPRG
	POPJ P,
]
;READ - DROPS IN

IFN RH11P,[
	MOVEI T,%HMRED
QINT6A:	MOVEM T,QCHPRG
	MOVEM Q,QSDU
	LSH R,1			; Set up Unibus map for RH11 to point at
	TRO R,%UQVAL+%UQFST	;  the block in question.
	IOWRQ R,UBAPAG+QUBPG_1
	ADDI R,1
	IOWRQ R,UBAPAG+QUBPG_1+1
	MOVE E,[-4000,,QUBPG_14]
	MOVEM E,QIOWD
	MOVE E,QSGL(C)
	PUSHJ P,QPOSR
	MOVEM E,QCHPGA
QOVR:	IORDQ TT,%HRCS1		; Enter here to recover from PI level lossage
	TRNN TT,%HXRDY
	 JRST QOVR
	SKIPGE Q,QSDU
	 BUG
QECCX:	;; Enter here from ECC correction code
	PUSHJ P,RHCLRC		; Clear controller errors and select drive
	HLRZ TT,QCHPGA
	CAME TT,QPOS(Q)
	 JRST DSKEX		; Punt if not positioned in right place
	IOWRQ TT,%HRCYL		; Store cylinder in drive
	HRRZ TT,QCHPGA
	IOWRQ TT,%HRADR		; Store track and sector
	HLRZ TT,QIOWD
	IOWRQ TT,%HRWC		; Store halfword count
	HRRZ TT,QIOWD
	IOWRQ TT,%HRBA		; Store Unibus base address
	MOVE A,QCHPRG
	PUSHJ P,RHCMD		; Go!
	MOVE A,TIME
	MOVEM A,LQTM
	CAILE C,NQCHN
	 JRST .+5
	  SKIPL B
	   AOSA NRXFR
	    AOS NWXFR
	  JRST QINTX
	SKIPL B
	 AOSA NSRXFR
	  AOS NSWXFR
QINTX:	JRST DSKEX

QHUNG:	MOVEI A,%HYCLR		; Sock controller in jaw
	IOWRQ A,%HRCS2
	MOVE Q,QSDU
	PUSHJ P,RHSLCT		; Select drive
	PUSHJ P,RHCLRD		; Redundantly clear drive
	SETOM QHUNGF
	AOS NTQHNG(Q)
	BUG INFO,[DSK: HUNG ON UNIT #],DEC,QSDU,[ADDR=],OCT,QCHPGA
	POPJ P,

] ;RH11P
;READ - DROPS IN

IFN RH10P,[
	MOVEI T,%HMRED
QINT6A:	IORI T,QICWA_6	.SEE $HCICWA
	TLO T,%HRCTL(Q)
	MOVEM T,QCHPRG
	MOVEM Q,QSDU
	LSH R,10.		;ASSEMBLE DF10-C CONTROL WORD
	SUBI R,1
	MOVNI E,2000
	DPB E,[$DFWC R]
	MOVEM R,QIOWD
	SETZM QIOWD+1
	MOVE E,QSGL(C)
	PUSHJ P,QPOSR
	MOVEM E,QCHPGA
QOVR:	CONSZ DSK,20		;ENTER HERE FOR RECOVER FROM PI HALT, OVERRUN
	 JRST QOVR
	SKIPGE Q,QSDU
	 BUG
	MOVEI TT,QIOWD
	HRRZM TT,QICWA
QECCX:	SETZM QICWA+1		;ENTER HERE FROM ECC CORRECTION CODE
	CONO DSK,%HOCLR+%HORAE+%HOATN+DSKCHN
	HLRZ TT,QCHPGA
	CAME TT,QPOS(Q)
	 JRST DSKEX		;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
	MOVSI A,%HRCYL(Q)	;STORE ADDRESS IN DRIVE
	HLR A,QCHPGA
	PUSHJ P,RHSET
	MOVSI A,%HRADR(Q)
	HRR A,QCHPGA
	PUSHJ P,RHSET
	MOVE A,QCHPRG
	PUSHJ P,RHSET
IFN QRDCMP,[
	SETZM RDCPHS		;ASSUME NO READ-COMPARE WANTED
	SKIPE QRCSW
	 SETOM RDCPHS		;REMEMBER TO READ-COMPARE LATER
];QRDCMP
	MOVE A,TIME
	MOVEM A,LQTM
	CAILE C,NQCHN
	 JRST .+5
	  SKIPL B
	   AOSA NRXFR
	    AOS NWXFR
	  JRST QINTX
	SKIPL B
	 AOSA NSRXFR
	  AOS NSWXFR
QINTX:	JRST DSKEX

QHUNG:	CONO DSK,%HOCLR+%HORST+%HOSTP+DSKCHN	;HUNG, CLEAR CONTROLLER
	SETOM QHUNGF
	MOVE Q,QSDU
	AOS NTQHNG(Q)
	MOVSI A,%HRDCL(Q)
	HRRI A,%HMCLR		;CLEAR DRIVE
	PUSHJ P,RHSET
	BUG INFO,[DSK: HUNG ON UNIT ],DEC,QSDU,[ADDR=],OCT,QCHPGA
	POPJ P,
]
;READ - DROPS IN
IFN DC10P,[
	MOVSI T,(DREAD)
QINT6A:	MOVEM T,QCHPRG
	MOVEM Q,QSDU
	DPB R,[DCBN+QCHPR2]	;MEM BLOCK #
	DPB R,[DCBN+QCHPR3]	;FOR POSSIBLE READ COMPARE
	MOVE E,QSGL(C)
	PUSHJ P,QPOSR	;QPOSR ALSO STORES MAPPED UNIT IN QCHPRG
	IORB E,QCHPRG
	CLEARM QCHPR4	;STORE DHALT FOR NO RCC
	CAILE C,NQCHN
	 JRST QINT6S	;SWAPPING CHNL
	SKIPL B
	 AOSA NRXFR
	  AOS NWXFR
	CAIE C,NQCHN	;ALWAYS R COMPARE DIR WRITES
	 SKIPLE QRCSW	;SKIP ON NOT READ COMP EVERYTHING
	  JRST QINT6B	;RCC
	SKIPL QRCSW
	 JUMPL B,QINT6B	;RCC WRITES
	HRRZ D,QSRAC(C)
	CAIL D,%QMUDR
	CAILE D,%QMTTR
	 JRST QINT6C	;NOT DIR READ
QINT6B:	TLZ E,340000	;CHANGE TO READ COMPARE
	MOVEM E,QCHPR4
QINT6C:	SETOM QERS1	;ERR VERIFY IND
QOVR:	CONSZ DC0,DSSRUN+DSSACT
	 JRST QOVR
	DATAO DC0,[DJMP QCHPRG]	;ENTRY ON OVERRUN
QOVR1:	CONO DC0,DCSET+DCIENB+DSKCHN	;INTERRUPT WHEN DONE
	MOVE A,TIME
	MOVEM A,LQTM
QINTX:	JRST DSKEX

QINT6S:	SKIPL B
	 AOSA NSRXFR
	  AOS NSWXFR
	JUMPL B,QINT6B	;RCC WRITES
	JRST QINT6C	;NOT READS

QHUNG:	CONO DC0,DCCSET+DSKCHN	;HUNG, CLEAR CONTROLLER
	SETOM QHUNGF
	MOVE Q,QSDU
	AOS NTQHNG(Q)
	BUG INFO,[DSK: HUNG ON UNIT ],DEC,QSDU,[QCHPRG=],OCT,QCHPRG
	POPJ P,
]

QINT6W:IFE DMDSK,[
	MOVE T,[QXWDS-1,,QXWDS]
	BLT T,QXWDS+3
	CAIL C,NQCHN
	 JRST QNT6W2	;SWAP OR DIR WRITE
	MOVE A,QUDPR(C)
	MOVE T,QSNUD(A)
	MOVEM T,QXWDS+XWSYSN
	HRRZ A,QSNLCN(A)
	ADD A,QUDFPR(C)
	MOVE T,UNFN1(A)
	MOVEM T,QXWDS+XWFN1
	MOVE T,UNFN2(A)
	MOVEM T,QXWDS+XWFN2
	MOVE T,QSLBLK(C)
	DPB T,[XWBLK+QXWDS]
	LDB T,[MWC,,MEMBLT(R)]
	DPB T,[XWAWC+QXWDS]
QNT6W2:
]
IFN DC10P,	MOVSI T,(DWRITE)
IFN RP10P,	MOVSI T,(DWRITC)
IFN RH10P,	MOVEI T,%HMWRT
IFN RH11P,	MOVEI T,%HMWRT
	JRST QINT6A

IFN T300P,[
T3IO:	MOVEM C,QSDCH1		;THIS IS MORE OR LESS QINT6A FOR T-300
	MOVEM Q,QSDU1
	MOVEI A,%DMRED
	SKIPGE B,QSCRW(C)
	 MOVEI A,%DMWRT
T3IO1:	MOVE R,QSCABN(C)	;RE-ENTER HERE TO RETRY WITH COMMAND IN A
	LSH R,10.		;FIRST ADDRESS IN TRANSFER
	TLO R,730000		;12-BIT BYTES, START WITH FIRST BYTE IN WORD
	MOVSI E,-4		;SET UP BYTE POINTERS
	MOVEM R,DSCPNT(E)
	ADDI R,400
	AOBJN E,.-2
	MOVE D,QSGL(C)		;DO LIKE QPOSR
	CAIL D,NBLKS1
	 BUG
	IDIVI D,NBLKC1
	MOVEM D,DSCCYL
	IMULI E,SECBL1
	IDIVI E,NSECS1
	MOVEM E,DSCHED
	MOVEM TT,DSCSEC
	PUSHJ P,T3CMD
	CAILE C,NQCHN
	 JRST .+5
	  SKIPL B
	   AOSA NRXFR1
	    AOS NWXFR1
	  JRST QINTX
	SKIPL B
	 AOSA NSRXF1
	  AOS NSWXF1
	JRST QINTX

;START T-300, COMMAND IN A, DRIVE IN Q
T3CMD:	MOVEI TT,2561
	MOVEM TT,DSCCHK
	MOVE TT,TIME
	MOVEM TT,LQTM1
	MOVEI TT,-T300P(Q)
	MOVEM TT,DSCDRV
	HRRZM A,DSCCMD
	SETZM DSCDON
	MOVEI T,1
	MOVEM T,DSCREQ
	CONO DLC,100040+TTYCHN	;INTERRUPT 11
	POPJ P,

QHUNG1:	MOVE Q,QSDU1
	AOS NTQHNG(Q)
	BUG INFO,[DSK: HUNG ON T-300 UNIT ],DEC,QSDU
	MOVEI TT,5*60.*30.	;SHUT UP FOR FIVE MINUTES
	ADDM TT,LQTM1
	POPJ P,
];T300P

QDE:	MOVE C,QSDCH
IFN RP10P, PUSHJ P,QERSOFT
IFN DC10P, AOSE PKIDM
	 SKIPGE Q,QSDU
	  BUG
IFN DC10P,[
	TRNE TT,DCKSER
	 JRST .+3	;GET CKS ERR
	  TRNE TT,DRCER
	   AOS NQCMPE(Q) ;# COMPARE ERRORS [WITH NO OTHER ERROR]
];DC10P
IFN T300P,T3DE:		;ENTER HERE FOR ERROR ON T-300
	AOS NQDE(Q)
	SKIPL R,QSCRW(C)
	 AOSA NQRDE(Q)
	  AOS NQWDE(Q)
IFN DC10P,	JUMPL R,QERV1	;DO ANOTHER RD/COMP TO SEE IF OK ON DSK (IF WRITE)
QERV2:	AOS R,QERRS(C)
	TRNN R,10	;TRY 8 TIMES BEFORE AND AFTER REPOSITION
	 JRST QDE1
	TRNN R,1000
	 JRST QDE2	;TRY REPOSITION ONCE
QERV3:	MOVE D,QSRAC(C)
	TRNE D,-%QMMAX
	 BUG
	XCT .+1(D)	;INVOKE IRRECOV ERROR HANDLER
QERV:	OFFSET -.
%QMIDL::JRST 4,QERV+.	;IDLE CHANNELS SHOULDN'T GET HERE
%QMRD::	JRST QPE2D	;USER DATA
%QMWRT::JRST QDE1	;WRITE KEEP TRYING
%QMWOV::JRST QDE1	;..
%QMRD1::JRST QPE2D
	JRST 4,QERV+.	;ILL CODE
%QMUDR::JRST QUDER1
%QMMDR::JRST QDE1
%QMTTR::JRST QDE1
%QMUDW::JRST QDE1
%QMMDW::JRST QDE1
%QMTTW::JRST QDE1
%QMSWP::JRST QSWPER
	JRST 4,QERV+.	;ILL CODE
	JRST 4,QERV+.	;ILL CODE
	JRST 4,QERV+.	;ILL CODE
%QMMAX::OFFSET 0

QSWPER:	SKIPGE CIRPSW		;TRY XFER AGAIN IF CIRPSW NOT AVAILABLE
	SKIPGE QSCRW(C)
	 JRST QDE1		;DON'T TRY TO DO ANYTHING ABOUT WRITE ERRORS
	MOVE A,QSCABN(C)	;READ - GIVE ALL USERS OF PAGE PARITY ERR
	PUSH P,C
	PUSH P,Q
	MOVE C,[2200,,MEMPNT(A)]
	PUSHJ P,UCPRL
	  400000,,QSWER1
	LDB Q,[2200,,MEMPNT(A)]
	DPB Q,C			;REMOVE MEM FROM LOOP
	PUSHJ P,IMEMR		;AND GIVE BACK MEM
	POP P,Q			;ALTERNATIVELY, COULD LEAVE THE MEM BUT SET MMPBAD
	POP P,C			;TO INDICATE THAT THAT MEM COPY OF THE PAGE IS NO GOOD.
	MOVEI D,2
	DPB D,[410200,,@QSMMP(Q)]	;PAGE IS OUT
	JRST QPE2D

QSWER1:	PUSH P,T
	MOVSI T,%PJPAR
	IORM T,PIRQC(U)
	JRST POPTJ

IFN DC10P,[
QERV1:	SKIPN QCHPR4
	 JRST QERV2	;NOT SET FOR RCC
	CLEARM QERS1
QERL2:	CONSZ DC0,DSSRUN+DSSACT
	 JRST .-1
	DATAO DC0,[DJMP QCHPR4]
	JRST QOVR1

QERL1:	AOS Q,QERS1
	CAIGE Q,50.
	 JRST QERL2
	AOSA NQWIRE
QEROK:	 AOS NQWRE
	MOVE C,QSDCH
	MOVE Q,QSDU
	SETOM QERS1
	JRST QERV2
]
QDE2:	MOVEI R,1000
	MOVEM R,QERRS(C)	;CLOBBER QERRS
	JRST QREC		;AND TRY REPOSITIONING

IFN RP10P,[
QERSOFT:LDB A,[DCYL+QCHPRG]	;PARSE STARTING DISK ADDRESS
	LDB B,[DCYLXB+QCHPRG]
	LSH B,8
	IOR A,B
	LDB B,[DSURF+QCHPRG]
	LDB D,[DSECT+QCHPRG]
	SKIPN QERRS(C)		;PRINT ONLY ONCE, NOT ON RETRIES
	 BUG INFO,[DSK: SOFT ERR UNIT ],DEC,Q,[CYL ],DEC,A,[STARTING HEAD ],DEC,B,[SEC ],DEC,D,[CONI=],OCT,QERST,[DATAI=],OCT,QERDTI
	POPJ P,

QRECAT:	CONI DPC,A
	BUG INFO,[DSK: SEEK ERR DATAO=],OCT,QSEEK(Q),[CONI=],OCT,A,[DATAI=],OCT,E
	SETZM QSEEK(Q)
	JRST QREC
];RP10P

QHE:	MOVE C,QSDCH
IFN RP10P, PUSHJ P,QERSOFT
	SKIPGE Q,QSDU
	 BUG
IFN T300P,T3HE:		;ENTER HERE FOR ID ERROR ON T-300
	AOS NQHE(Q)
	AOS E,QERRS(C)
	CAIL E,5.
	 JRST QHE2
QREC:
IFN T300P,[
	CAIL Q,T300P
	 JRST [	SETOM QRCAL(Q)
		MOVEI A,%DMREC
		PUSHJ P,T3CMD
		MOVEM Q,QSDU1	;CONTROLLER IS TIED UP BY RECAL BECAUSE
		JRST QINT1 ]	;IT'S TOO DAMNED PSEUDO-INTELLIGENT
];T300P
IFN DC10P,[
	MOVE TT,QTRAN(Q)
QREC0:	DPB TT,[DUNFLD+QRECAL]
	SETOM QRCAL(TT)
	SETOM QSKT1(TT)
	CLEARM QSPPS(TT)
	CLEARM QPOSGL(TT)
	SETOM QPOS(TT)
	MOVEI T,10.		;5-SECOND RECALIBRATE TIMEOUT
	MOVEM T,QRCTIM(TT)
	DATAO DC0,QRECAL
	CONO DC0,DCSET+DCATEB+DSKCHN	;ENABLE ATTENTION
]
IFN RP10P,[
	DPB Q,[DUNFLD+QRECAL]
	SETOM QPOS(Q)
	DATAO DPC,QRECAL
	CLEARM QSPPS(Q)
	SETOM QSKT1(Q)
	SETOM QRCAL(Q)	;INDICATE RECALIBRATING THIS DISK
	CLEARM QPOSGL(Q)
]
IFN RH11P,[
	PUSHJ P,RHSLCT		; Select drive
	PUSHJ P,RHCLRD		; Clear errors
	MOVEI A,%HMREC
	PUSHJ P,RHCMD		; Recalibrate
	CLEARM QSPPS(Q)
	CLEARM QPOSGL(Q)
	SETOM QPOS(Q)
	SETOM QSKT1(Q)
	SETOM QRCAL(Q)
] ;RH11P
IFN RH10P,[
	MOVSI A,%HRDCL(Q)
	HRRI A,%HMCLR
	PUSHJ P,RHSET		;CLEAR ERROR OUT OF DRIVE.
	MOVSI A,%HRDCL(Q)
	HRRI A,%HMREC		;RECALIBRATE
	PUSHJ P,RHSET		;MAYBE SHOULD TRY OFFSET FIRST?
	CLEARM QSPPS(Q)
	CLEARM QPOSGL(Q)
	SETOM QPOS(Q)
	SETOM QSKT1(Q)
	SETOM QRCAL(Q)
]
	SETOM QSDU
	JRST QINT1	;LOOK FOR SOME OTHER TRANSFER

QHE2:	SKIPL QSCRW(C)	;HANG UP OR POSITIONING ERR (AFTER 5 TRIES)
	 JRST QERV3	;IF READ, PERFORM RECOVERY

QPE2D:	MOVSI R,%QAPAR	;IRRECOVERABLE ERROR
	IORM R,QSRAC(C)
	AOS QIRRCV
	MOVE D,QSGL(C)
	MOVEM D,QIRCBK	;BLOCK # AT IRRCV ERR
	MOVEM Q,QIRUNT	;SAVE UNIT TOO
	CAILE C,NQCHN
	 AOS NIRSWE	;# IRRCV SWAPPING ERRS
	MOVE I,Q
	SKIPGE QTUTO(I)
	 JRST QPE2E	;DON'T MESS WITH LOCKED TUT
	PUSHJ P,TUTPNT
	CAIN B,TUTLK	;PRINT MESSAGE IF NOT YET LOCKED OUT
	 JRST QINTI
	MOVEI B,TUTLK
	DPB B,D
QPE2E:	BUG INFO,[DSK: IRREC DATA ERR #],DEC,QIRRCV,[UNIT=],DEC,QIRUNT,[BLK=],OCT,QIRCBK
	JRST QINTI

QUDER1:	MOVEI R,1(Q)	;TRY TO READ DIR FROM OTHER DISKS
QUDER2:	CAIL R,NQS
	 MOVEI R,0
	CAME R,QDSKN(C)
	 JRST QUDER4
	JRST QDE1	;NO OTHER DISK AVAIL TO READ FROM, TRY AGAIN

QUDER4:	SKIPGE QACT(R)
	 AOJA R,QUDER2
	HRRZM R,QDSKN(C)	;TRY THIS DISK
IFN T300P,[
	CAIL Q,T300P
	 JRST [	SETOM QSDU1	;FREE DRIVE FORMERLY HACKING
		SETOM QTUNT1
		JRST T3UDE4 ]
];T300P
IFE DC10P, SETOM QSKT1(Q)	;FREE DRIVE FORMERLY HACKING
IFN DC10P,[
	MOVE TT,QTRAN(Q)
	SETOM QSKT1(TT)
]
	SETOM QSDU
	SETOM QTUNT
IFN T300P,T3UDE4:
	MOVE E,QSGL(C)
	MOVE Q,QDSKN(C)
	SETZM QERRS(C)
	JRST QINT5

QIDRCH:	MOVE TT,QDIRP(C)	;CHNL IN C PNTR TO QSNUD IN J LOAD NEXT CHR INTO A
	AOS QDIRP(C)		;ALSO RET BYTE PNTR IN TT
	IDIVI TT,UFDBPW
	HLL TT,QBTBL(I)
	HRRZ I,QSNLCN(J)
	ADDI TT,UDDESC(I)
	LDB A,TT
	POPJ P,

QMPDCH:	MOVE TT,QDIRP(A)	;CHNL IN A PNTR TO QSNUD IN H LOADS NEXT CHR IN R
	AOS QDIRP(A)		;USED AT M.P. LEVEL
QMPDC1:	IDIVI TT,UFDBPW		;ALSO RETN BYTE PNTR IN TT
	HLL TT,QBTBL(I)
	HRRZ I,QSNLCN(H)
	ADDI TT,UDDESC(I)
	LDB R,TT
	POPJ P,

;REACHED EOF ON READ
QEOF:	SOS QDIRP(C)		;AVOID GC UNHAPPINESS
	MOVSI I,%QAEFR
	IORM I,QSRAC(C)
	HLLZS QSRAC(C) .SEE %QMIDL ;IDLE THE CHANNEL
	AOS QSBFS(C)		;TO UNHANG M.P. WHICH IS WAITING FOR BUF TO APPEAR
	JRST QINT2C

QINT4C:
; 8/20/90 DM "funny" bit no longer supported.  Allows for huge RP07 block
; numbers.  Commenting this out means that %QAFNY can no longer get set
; under any circumstances, so I am leaving a certain amount of dead code in
; other places.
; IFN DMDSK,[
; 	MOVSI E,%QAFNY
; 	ANDCAM E,QSRAC(C)
; 	TRZE A,20	; FUNNY FILE BLOCK
; 	 IORM E,QSRAC(C); INDICATE SO
; ]
	MOVEI E,0
	DPB A,[140500,,E]
	PUSHJ P,QIDRCH
	DPB A,[060600,,E]
	PUSHJ P,QIDRCH
	DPB A,[0600,,E]
	MOVEM E,QSLGL(C)
	JRST QINT4G

;DECODE UNBYTE SPEC IN D.
;RETURNS BYTE SIZE IN D, NUMBER OF UNUSED BYTES IN LAST WORD IN E.
QBDCD:	TRZE D,400
	 JRST [ IDIVI D,100 ? POPJ P, ]
	TRZE D,200
	 JRST [ IDIVI D,20 ? POPJ P, ]
	SUBI D,44
	JUMPGE D,[ IDIVI D,4 ? POPJ P, ]
	MOVNS D
	SETZ E,
	POPJ P,

;ENCODE BYTE SIZE IN Q AND RESIDUE IN R INTO UNBYTE SPEC IN RH(Q)
QBENC:	CAIG Q,3
	 JRST [ IMULI Q,100 ? ADDI Q,400(R) ? POPJ P, ]
	CAIG Q,7
	 JRST [ IMULI Q,20 ? ADDI Q,200(R) ? POPJ P, ]
	CAIG Q,18.
	 JRST [ IMULI Q,4 ? ADDI Q,44(R) ? POPJ P, ]
	MOVNI Q,-44(Q)
	POPJ P,

QINT3:	SKIPL DWUSR
	 JRST QINT3X	;DIR CHNL IN USE
IFN T300P,[
	SKIPGE QSDU	;DON'T GET PAST HERE UNLESS BOTH CONTROLLERS ARE IDLE
	 SKIPL QSDU1
	  JRST QINT3X
];T300P
	AOSL QDWFAR
	 JRST [	MOVNI H,10.
		MOVEM H,QDWFAR
		JRST .+3 ]
	   SKIPG QACTTM	;LAST ACTIVITY TOO RECENT
	    JRST QUDW
	SKIPGE H,QMDRO
	 JRST QTDW
	MOVE J,QACTB
	TDNN J,H
	 JRST QTDW
	MOVSI Q,-NQS
QMDW:	SKIPGE QACT(Q)
	 JRST QMDWA	;UNIT NOT ACTIVE
	MOVE J,DCHBT(Q)
	TDNN J,QMDRO
	 JRST QMDWA
	HRLI Q,(SETZ)	;INDICATE MFD WRITE IN PROGRESS
	MOVEM Q,QDWIP
	HRRZM Q,DWSKN
	MOVEI TT,%QMMDW
	HRRZM TT,QSRAC+NQCHN
	MOVSI TT,(SETZ)
	IORB TT,QMDRO
	MOVE C,MDCHK(TT)
	CAME C,[SIXBIT /M.F.D./]
	 BUG HALT,[MFD CLOBBERED]
	HRRZ C,Q
	CAMN C,MDSK
	 AOSA C,QAMDNO
	  MOVE C,QAMDNO
	MOVEM C,MDNUM(TT)
	SETZM DWUSR
	MOVEI TT,MFDBLK
	MOVEM TT,QSGL+NQCHN
	HRRZ TT,QMDRO
	LSH TT,-10.
	MOVEM TT,QSCABN+NQCHN
	JRST QINT1

QMDWA:	AOBJN Q,QMDW
QTDW:	SKIPG QACTTM
	 JRST QUDW
	MOVSI Q,-NQS
QTDW1:	SKIPGE QACT(Q)
	 JRST QTDWA
	MOVE J,DCHBT(Q)
	SKIPL QTUTO(Q)
	TDNN J,QTUTO(Q)
	 JRST QTDWA
	MOVSI H,240000
	TDNE H,QTUTO(Q)
	 JRST QTDWA1
	MOVE TT,TIME		;DON'T WRITE TUTS TOO OFTEN
	SUB TT,QTWRTM(Q)	;BECAUSE THE TUT IS LOCKED WHILE IT'S BEING WRITTEN
	CAIGE TT,100.
	 JRST QTDWA
	ADDM TT,QTWRTM(Q)
	HRLI Q,200000
	MOVEM Q,QDWIP
	HRRZM Q,DWSKN
	MOVEI TT,%QMTTW
	HRRZM TT,QSRAC+NQCHN
	MOVSI TT,(SETZ)
	IORB TT,QTUTO(Q)
	MOVE H,QPKNM(Q)		;VERIFY THAT TUT IS NOT BEING CLOBBERED
	MOVE C,QPKID(Q)
	CAMN H,QPAKID(TT)
	 CAME C,QPKNUM(TT)
	  BUG HALT,[TUT ],DEC,Q,[CLOBBERED]
	SETZM DWUSR
	MOVEI TT,MFDBLK		;INITIATE WRITING OF FIRST BLOCK OF TUT
	SUB TT,NTBL(Q)
	MOVEM TT,QSGL+NQCHN
	LDB TT,[121000,,QTUTO(Q)]
	MOVEM TT,QSCABN+NQCHN
	JRST QINT1

QTDWA1:	ANDCAM J,QTUTO(Q)
QTDWA:	AOBJN Q,QTDW1
QUDW:	MOVSI C,-QNUD
QDW4A:	MOVE J,QACTB	;BITS CORRESP TO ACTIVE DISKS
QDW4:	SKIPE TT,QSNUD(C)
	SKIPGE QSNLCN(C)
	 JRST QDW3	;SLOT VACANT OR LOCKED
	TDNE J,QSNLCN(C)
	 JRST QUDW1	;NEEDS TO BE WRITTEN ON SOME UNIT
QDW3:	AOBJN C,QDW4A
QINT3X:	;HERE IF DISK GOING IDLE.  CLEAR DONE FLAG.
	;IN 2-CONTROLLER CASE, MAKE SURE WE ONLY DO IT TO THE RIGHT CONTROLLER.
IFN T300P,[
	SKIPL QSDU
	 JRST DSKEX	;STUFF NEEDS TO BE DONE BUT CANT NOW
] ;T300P
IFN DC10P, CONO DC0,DCCLR+DCIENB+DSKCHN
IFN RP10P, CONO DPC,177710+DSKCHN	;MUST CLEAR "DONE"
IFN RH10P, CONO DSK,%HOCLR+%HOATN+%HORAE+DSKCHN
IFN RH11P, ;; RH11 doesn't need this?
	JRST DSKEX	;STUFF NEEDS TO BE DONE BUT CANT NOW

QUDW1:	MOVSI J,%QUDWM	;WRITE RIGHT AWAY IF %QUDWM IS ON
	TDNN J,QSNLCN(C)
	 SKIPE QSFBT(C)	;OR DISK BLOCKS (AND CORE) WAITING TO BE FREED
	  JRST QUDW6
	SKIPG QACTTM	; ACTIVITY TOO RECENT
	 SKIPN QSNNR(C)	; THEN ONLY WRITE IF NOTHING POINTING TO DIRECTORY
	  SKIPA
	   JRST QDW3
	MOVSI Q,-NQS
QUDW4:	SKIPGE QACT(Q)
	 JRST QUDW3
	MOVE J,DCHBT(Q)
	TDNE J,QSNLCN(C)
	 JRST QUDW2
QUDW3:	AOBJN Q,QUDW4
	JRST QDW3

QUDW6:	ANDCAM J,QSNLCN(C)	;TURN OFF %QUDWM
	MOVE Q,MDSK		;AND WRITE ON MASTER DISK (ASSUME MDSK IS ACTIVE AND BIT IN QSNLCN IS SET)

QUDW2:	MOVE I,QMDRO
	TLNE I,40000	;IS THIS CODE OBSOLETE? LEFT FROM DAYS OF 1 MFD PER DRIVE?
	 JRST QUDW2B	;MASTER DIR NOT IN
	HRRZS Q
	CAMN Q,MDSK	;SKIP IF NOT WRITING ON MASTER DISK
	 PUSHJ P,QDIRCK	;BLESS THIS UFD!!!
	MOVSI TT,(SETZ)
	IORB TT,QSNLCN(C)	;LOCK USER DIRECTORY
	MOVEI J,%QMUDW
	HRRZM J,QSRAC+NQCHN
	MOVE A,1(TT)		;NAME AREA PTR
	MOVE J,QSNUD(C)
	CAMN J,UDNAME(TT)	;MAKE SURE NOT ABOUT TO WRITE BAD DIRECTORY
	 CAILE A,2000
	  JSP TT,QUDCLB
	SUBI A,11.
	IMULI A,6
	SKIPL J,(TT)
	CAMLE J,A	;FS PTR BAD?
	 JSP TT,QUDCLB
	CLEARM DWUSR
	MOVEM Q,DWSKN
	MOVE TT,QSNMI(C)
	MOVEM TT,QSGL+NQCHN
	HRRZ TT,QSNLCN(C)
	LSH TT,-10.
	MOVEM TT,QSCABN+NQCHN
	HRRZM C,QDWIP
	CLEARM QERRS+NQCHN
	JRST QINT1

QUDW2B:	ANDCAM J,QSNLCN(C)	;CLEAR BIT + GO AWAY
	JRST QUDW3

;GENERALLY GET HERE BY JSP TT,
QUDCLB:	BUG HALT,[DIR ],OCT,C,SIXBIT,QSNUD(C),[CLOBBERED]

QDIRCK:	PUSH P,TT	;CHECKS FILES FOR REASONABLE DESCRIPTORS -
			; PRECEDING BYTE =0, FIRST BYTE NOT=0
	HRRZ A,QSNLCN(C)
	MOVEI B,1777(A)	;END OF NAMES
	ADD A,1(A)	;BEGIN NAMES
QDIRC1:	CAMG B,A
	 JRST POPTTJ	;DONE
	SKIPN (A)
	 JRST QDIRC2	;0 NAME=NO FILE
	LDB TT,[1500,,UNRNDM(A)]	;DESC PTR
	SOS TT		;TRICK - IF DESC PTR = 0 LDB BELOW GETS 0 BECAUSE P FIELD = 44
	IDIVI TT,6
	HLL TT,SBTBL(I)	;BYTE POINTER
	ADDI TT,UDDESC-1777(B)
	LDB I,TT
	JUMPN I,QUDCLB
	ILDB I,TT
	JUMPE I,QUDCLB
QDIRC2:	ADDI A,LUNBLK
	JRST QDIRC1

IFN RP10P,[
QPOSR:	CAIL E,MBLKS
	 BUG			;TOO BIG EVEN FOR RP03
IFN DMDSK,[
	IMULI E,SECBLK
	IDIVI E,NSECS
	SETZM D
	DPB TT,[DSECT+D]
	IDIVI E,NHEDS
	DPB TT,[DSURF+D]
	DPB E,[DCYL+D]
	MOVEM E,QSPPS(Q)
	LSH E,-8
	DPB E,[DCYLXB+D]
	DPB Q,[DUNFLD+D]
]
IFE DMDSK,[
	MOVEI D,0
	IDIVI E,NBLKSC
	DPB E,[DCYL+D]
	MOVEM E,QSPPS(Q)
	LSH E,-8
	DPB E,[DCYLXB+D]
	MOVE E,TT
	IMULI E,NSSECS
	IDIVI E,NHSECS
	DPB E,[DSURF+D]
	DPB TT,[DSECT+D]
	DPB Q,[DUNFLD+D]
]
	MOVE E,D
	POPJ P,
]
IFN RH10P+RH11P,[
IFE DMDSK, .ERR CHANGE QPOSR FOR 9-SECTOR BLOCKS!
QPOSR:	CAIL E,NBLKS
	 BUG
	IDIVI E,NBLKSC
	HRLZ D,E		;CYLINDER IN LH
	MOVEM E,QSPPS(Q)
	MOVE E,TT
	IMULI E,SECBLK
	IDIVI E,NSECS
	LSH E,8
	IOR E,D			;SURFACE IN 1.9-2.4
	IOR E,TT		;SECTOR IN 1.1-1.5
	POPJ P,
] ;RH10P+RH11P

IFN DC10P,[
QPOSR:	CAIL E,NBLKS
	 BUG
	IDIVI E,NSECS
	MOVSI D,(DUNENB)
	DPB TT,[DSECT+D]
	IDIVI E,NHEDS
	DPB TT,[DSURF+D]
	SKIPGE TT,QTRAN(Q)
	 ADDI E,NCYLS+XCYLS
	DPB E,[DCYL+D]
	MOVEM E,QSPPS(TT)
	MOVE E,D
	DPB TT,[DUNFLD+E]
	DPB TT,[DUNFLD+QCHPRG]
	SKIPGE TT,QPKID(Q)
	 JRST QPOSRI
	DPB TT,[DPKID+E]
	POPJ P,

QPOSRI:	MOVE TT,QTRAN(Q)	;NEED PACK ID BEFORE PROCEEDING
	DPB TT,[DUNFLD+GPKID]
	SETOM QSKT1(TT)
	MOVEI A,TUTCYL
	SKIPGE QTRAN(Q)
	 ADDI A,NCYLS+XCYLS
	DPB A,[DCYL+GPKID]
	MOVEM A,QPOS(TT)	;WILL SEEK TO HERE AUTOMATICALLY
	MOVEM A,QPOSGL(TT)
	DATAO DC0,[DJMP GPKID]
	MOVEM Q,QSDU
	SETOM PKIDM
	JRST QINTX

QSPKID:	CONSZ DC1,1777
	 BUG		;ERRORS
	LDB TT,[DPKID+RPKID]
	MOVEM TT,QPKID(Q)
	SETOM QSDU
	JRST QINT1
]

SUBTTL DISK IOT ROUTINES

OVHMTR UUO	;MORE RANDOM UUOS

;BECAUSE .ACCESS MERELY DROPS ITS ARG IN A VARIABLE AND SETS %QAACC,
;ALL IOT ROUTINES MUST TEST %QAACC AND DO THE REAL WORK OF CHANGING
;THE ACCESS POINTER IF NECESSARY.

QBO:	MOVEI T,BLKT
	JRST QUO1

	SKIPA T,[SIOKT]
QUIO:
QUAO:	 MOVEI T,CHRKT
QUO1:	PUSH P,T
	PUSH P,TT
	PUSH P,D
	MOVE T,QSRAC(A)
	TLNE T,%QAACC+%QALNK
	 PUSHJ P,QBWRA1	;RANDOM ACCESS MODE HACK
	POP P,D
	POP P,TT
	MOVE E,QSBYTE(A)
	JSP B,CPOPJ	;TRANSFER TO CHRKT, SIOKT, OR BLKT
QBOV:	SETZ QSMPRP(A)
	QSMPRC(A)
	QSBWG
	SETZ QSBWW
	JRST QOCL
	TRNA

QBI:	MOVEI T,BLKT
	JRST QUI1

	SKIPA T,[SIOKT]
QUII:
QUAI:	 MOVEI T,CHRKTI
QUI1:	PUSH P,T
	PUSH P,TT
	MOVE T,QSRAC(A)
	TLNE T,%QAACC+%QALNK
	 PUSHJ P,QBRRA1
	POP P,TT
	MOVE E,QSBYTE(A)
	JSP B,CPOPJ		;TRANSFER TO CHRKTI, SIOKT, OR BLKT
QBIV:	QSMPRP(A)
	QSMPRC(A)
	QSBGB
	QSBRB
	JRST QICL
	SKIPG QSBFS(A)

QBWRA1:	TLNE T,%QALNK
	 JRST IOCR10
	LDB T,[$QAMOD,,QSRAC(A)]	;SET RANDOM ACCESS PNTRS ON WRITE
	SOJN T,QBWRA2		;IN ORDINARY WRITE MODE
	SKIPGE QSCRW(A)		;WAIT FOR CHANNEL TO BECOME IDLE OR HANG UP IN READ
	 PUSHJ P,UFLS		; WAITING FOR %QAACC TO TURN OFF
	SKIPL QSGL(A)
	 PUSHJ P,UFLS
	SKIPGE QSMDN(A)
	 JRST QBWRA2
	MOVE T,QRADAD(A)	;DESIRED ADDRESS
	SUB T,QFBLNO(A)		;ACTUAL ADDRESS OF BEG OF CURRENT BUFFER
	JUMPL T,QBWRA2		;XFER ON BEFORE CURRENT BLOCK
	MOVE Q,T
	SUB T,QMPBSZ(A)		;SIZE OF CURRENT BUFFER IN BYTES
	JUMPL T,QBWRA3		;SAME BLOCK AS NOW
QBWRA2:	PUSH P,R
	PUSH P,I
	PUSH P,C
	PUSHJ P,QSOCL5		;CLEAR ANY CURRENT BUFFERS ETC
	PUSHJ P,QUDULK
	MOVE Q,QRADAD(A)
	PUSHJ P,QFNTR		;LOCKS DIR IF SKIPS
	 JRST QBWRA4		;OFF END OF FILE
QBWRA5:	PUSHJ P,QUDULK
QBWRA9:	POP P,C
	POP P,I
	POP P,R
	CLEARM QSCRW(A)		;SWITCH TO WRITE OVER MODE
	MOVSI Q,%QAMPU+%QAMWO	;SET UPDATE ADR AND WRITE OVER
	IORM Q,QSRAC(A)
	CLEARM QSMPRC(A)
	MOVSI Q,%QAEFR+%QAEFW+%QAACC	;CLEAR EOF, WRITE EOF, AND ACCESS FLAGS
	ANDCAM Q,QSRAC(A)
	MOVEI Q,%QMRD1		;AND READ IN THE CURRENT BLOCK
	HRRM Q,QSRAC(A)
	POPJ P,

QBWRA4:	JUMPE Q,QBWRA0
	CAME J,Q		;MIGHT BE ADDING TO END OF FULL BLOCK
	 JRST IOCER2
	JRST QBWRA9

QBWRA0:	PUSHJ P,QLWO		;OFF END OF FILE AND WAS ACCESSING WD 0
	MOVSI C,%QAACC		;SO SWITCH TO NORMAL WRITE MODE AND
	ANDCAM C,QSRAC(A)	;TURN OFF RANDOM ACCESS BIT
	POP P,C
	POP P,I
	POP P,R
	POPJ P,

QBWRA3:	SKIPGE TT,QSMDN(A)
	 BUG			;NO BUFFER REALLY ACTIVE AT M.P.
	MOVSI J,%QAWOV
	TDNN J,QSRAC(A)
	 JRST QBWRA7
	ANDCAM J,QSRAC(A) 	;WAS WRITING IN LAST BLK PAST EOF,
	MOVN D,QSMPRC(A)	; UPDATE ACTIVE BYTE COUNT
	ADDM D,QMPBSZ(A)	;DECREASE SIZE OF BUFFER TO AMT ACTUALLY WRITTEN
QBWRA7:	LSH TT,10.		;ADDRESS OF BUFFER
	MOVE T,Q		;SAVE RELATIVE BYTE ADDR WITHIN BUFFER
	IDIVI Q,@QSBYTE(A)	;Q = WDS, J = BYTES
	ADD TT,Q		;ADDRESS OF DESIRED WORD
	HLL TT,QSBYTE(A)	;BYTE POINTER TO FIRST BYTE IN THAT WORD
	JUMPE J,.+3		;ADVANCE TO APPROPRIATE BYTE
	 IBP TT
	 SOJG J,.-1
	MOVEM TT,QSMPRP(A)
	SUB T,QMPBSZ(A)		;MINUS # BYTES LEFT IN BLOCK
	MOVNM T,QSMPRC(A)
QBRRA4:	MOVSI Q,%QAACC
	ANDCAM Q,QSRAC(A)
	POPJ P,

QSKFRC:	MOVN B,QSMPRC(A)
	ADD B,QMPBSZ(A)		;NUMBER OF BYTES WRITTEN IN BLOCK
	MOVE C,QSRAC(A)
	TLNE C,%QAMWO
	 TLNE C,%QAWOV
	  JRST [MOVEM B,QMPBSZ(A)	;IS LAST BLOCK, CHANGE LENGTH
		PUSHJ P,QOCLPD	;AND PAD IT (GUARANTEED NO-OP IF WORD MODE CHNL)
		JRST .+1 ]
	SETZM QSMPRC(A)		;BUFFER WILL BE DISPOSED OF
	MOVSI E,%QUDWM
	SKIPGE QSMDN(A)
	 SETZB B,E		;NO BUFFER AFTER ALL
	ADD B,QFBLNO(A)		;CURRENT POSITION IN FILE
	MOVSI C,%QAACC
	TDNN C,QSRAC(A)
	 MOVEM B,QRADAD(A)	;ACCESS BACK ON NEXT IOT
	IORB C,QSRAC(A)
	PUSHJ P,[TLNE C,%QAWOV	;WRITE OUT THE BUFFER
		  JUMPN E,QSBWO2
		 JRST QSBWW ]
	SKIPE QMPTC(A)
	 MOVSI E,%QUDWM
	PUSHJ P,QOCL2		;STORE QMPTC IF NECESSARY
	IORM E,QSNLCN(H)	;WRITE OUT DIR FAST IF CHANGED
	PUSHJ P,QUDULK
	JRST POPJ1

;.CALL FINISH ON DISK OUTPUT CHANNEL
QSKFIN:	HRRZ T,QSRAC(A)
	CAIN T,%QMWOV		;IF WRITE-OVER MODE
	 JRST [	SKIPE QSCRW(A)	;THEN WAIT FOR IT TO SWITCH TO READ MODE
		 PUSHJ P,UFLS
		JRST QSKFIN ]
	CAIN T,%QMWRT		;IF WRITE MODE
	 JRST [	SKIPE QSBFS(A)	;THEN WAIT FOR ALL BUFFERS TO GET WRITTEN
		 PUSHJ P,UFLS
		JRST .+1 ]
	MOVE H,QUDPR(A)
	MOVE T,MDSK		;HAS THE DIR BEEN CHANGED AND NOT WRITTEN
	MOVE T,DCHBT(T)		;YET TO THE MASTER DISK?
	TDNN T,QSNLCN(H)
	 JRST POPJ1
	MOVSI TT,%QUDWM		;YES, WRITE IT OUT IMMEDIATELY
	IORM TT,QSNLCN(H)	;AND DON'T RETURN UNTIL IT IS WRITTEN
	TDNE T,QSNLCN(H)
	 PUSHJ P,UFLS
	JRST POPJ1

QBRRA1:	TLNE T,%QALNK
	 JRST IOCR10
	SKIPGE QSMDN(A)
	 JRST QBRRA2		;NO MAIN PRGM BUFFER
	MOVE T,QRADAD(A)
	SUB T,QFBLNO(A)
	JUMPL T,QBRRA2
	MOVE Q,T
	SUB T,QMPBSZ(A)		;SIZE OF CURRENT BUFFER
	JUMPL T,QBRRA3		;SAME BLOCK AS NOW
QBRRA2:	PUSH P,R
	PUSH P,I
	PUSH P,C
	PUSHJ P,QICLW1		;STOP THE CHANNEL AND FLUSH CURRENT BUFFERS
	MOVE A,D
	CLEARM QSBFS(A)		;FLUSH POSSIBLE EXTRA AOSES WHEN PI HIT EOF
	MOVE Q,QRADAD(A)
	PUSHJ P,QFNTR
	 JRST QBRRA5		;OFF END OF FILE (DIR ALREADY UNLOCKED)
	POP P,C
	POP P,I
	POP P,R
	CLEARM QSMPRC(A)
	MOVSI Q,%QAMPU
	IORM Q,QSRAC(A)		;SET FLAG TO SET QSMPRP AND QSMPRC ON NEXT BUFFER LOAD
	MOVSI Q,%QAEFR+%QAACC	;CLEAR EOF AND .ACCESS FLAGS
	ANDCAM Q,QSRAC(A)
	MOVEI Q,%QMRD		;START READING AGAIN
	HRRM Q,QSRAC(A)
	JRST QUDULK

QBRRA5:	POP P,C
	POP P,I
	POP P,R
	CAME J,Q
	 JRST IOCER2		;ACCESS OFF END OF FILE IS ERROR
	MOVSI TT,%QAEFR		;BUT ACCESS TO EXACTLY EOF IS OK
	IORM TT,QSRAC(A)	;IMITATES WHAT QEOF DOES
	AOS QSBFS(A)
	SETZM QSMPRC(A)		;AND READS ZERO WORDS
	JRST QBRRA4

QBRRA3:	SKIPGE TT,QSMDN(A)
	 JRST QBRRA2
	JRST QBWRA7

;BLKT-SIOKT-CHRKT GET BUFFER ROUTINE FOR WRITE-OVER MODE.
QWOG1:	SKIPGE QSCRW(A)	;FETCH BLOCK WRITEOVER MODE
	 JRST QWOG2	;STILL WRITING PREVIOUS ONE, WAIT
	MOVEI Q,%QMRD1	;SWITCH INTO READ MODE
	SKIPG QSBFS(A)	;IF A BUFFER HAS TO BE READ
	 HRRM Q,QSRAC(A)
	SKIPG QSBFS(A)
	 PUSHJ P,UFLS
	POP P,A
;BLKT-SIOKT-CHRKT GET-BUFFER ROUTINE FOR DISK INPUT.
QSBGB:	MOVSI Q,%QAPAR
	TDNE Q,QSRAC(A)
	 JRST QSBGB2
	CONO PI,UTCOFF
	HRRZ Q,QBFP(A)
	JUMPE Q,[MOVSI J,%QAEFR	;SAID TO BE BUFFERS, BUT NONE THERE
		 TDNN J,QSRAC(A)
		  BUG		;SHOULDN'T HAPPEN EXCEPT AT EOF
		 JRST QSBGB5 ]
	LDB J,[MLO,,MEMBLT(Q)]
	HRRM J,QBFP(A)
	SKIPN J
	 SETZM QBFP(A)		;LAST BLOCK, LIST NOW EMPTY
	HRRZ J,MEMPNT(Q)	;GET SIZE OF BUFFER IN BYTES
	MOVEM J,QMPBSZ(A)
	LDB TT,[$QAMOD,,QSRAC(A)]
	SKIPN TT		;DONT SOS IF IN WRITE OVER MODE
	 SOS QSBFS(A)
QSBWG4:	MOVE TT,Q
	LSH TT,10.		;RETURN ADDR OF BUFFER
	MOVEM Q,QSMDN(A)
	CONO PI,UTCON
	HLL TT,QSBYTE(A)
	MOVSI Q,%QAMPU
	TDNN Q,QSRAC(A)
	 JRST SIOBG2
	MOVE Q,QRADAD(A)	;DIDDLE PNTRS TO TAKE CARE OF RANDOM ACCESS WITHIN BLOCK
	SUB Q,QFBLNO(A)		;DESIRED OFFSET WITHIN BLOCK
	SUB J,Q
	JUMPL J,IOCER2		;OFF END OF FILE
	JUMPL Q,IOCER2		;OFF FRONT OF FILE (NEGATIVE .ACCESS PNTR)
	PUSH P,J
	IDIVI Q,@QSBYTE(A)
	ADD TT,Q		;ADJUST BYTE POINTER
	JUMPE J,.+3
	 IBP TT
	 SOJG J,.-1
	POP P,J
	MOVSI Q,%QAMPU		;NOW IS SAFE TO TURN OFF FLAG
	ANDCAM Q,QSRAC(A)
	JRST SIOBG2

;GET-BUFFER DETECTED EOF ON INPUT OR WRITE-OVER.
QSBGB5:	CONO PI,UTCON
	MOVE Q,QSRAC(A)
	TLNE Q,%QALNK
	 JRST IOCR10
	LDB Q,[$QAMOD,,QSRAC(A)]
	SOJN Q,POPJ2	;ON INPUT, SKIP TWICE TO SIGNAL EOF.
	PUSHJ P,QLWO	;LEAVE WRITE OVER MODE
	JRST QSBWG	;START NORMAL WRITE

QWOG2:	SKIPGE QSCRW(A)		;WAIT FOR WRITE TO FINISH
	 PUSHJ P,UFLS
	JRST POPAJ		;NOW RECYCLE AND WAIT FOR READ

;LEAVE WRITE OVER MODE
QLWO:	MOVE H,QUDPR(A)
	PUSHJ P,QUDLK
	CONO PI,UTCOFF
	SETZM QBFP(A)		;WRITEOVER MODE EXTEND FILE (SWITCH TO NORMAL MODE)
	CLEARM QSBFS(A)
	SETOM QSCRW(A)
	MOVE Q,QSLGL(A)
	HRRZM Q,QMPTN(A)	;STORE BASE TRACK
	MOVSI Q,%QAEFR+%QAMWO	;CLEAR EOF AND WRITEOVER
	ANDCAM Q,QSRAC(A)
	MOVEI Q,%QMWRT		;NORMAL WRITE MODE
	HRRM Q,QSRAC(A)
	CLEARM QMPTC(A)		;TRACK COUNT FOR TAKE N
	SETOM QMTTR(A)		;NO TRACK RESERVED
	SETOM QMFTP(A)		;GET NEW DECADE RESERVATION
	CONO PI,UTCON
	MOVE TT,QDIRP(A)	;SEE IF GARBAGE COLLECTION NEEDED
	PUSH P,R
	PUSH P,I
	PUSHJ P,QMPDC1		;CONV CHAR ADR TO BYTE PNTR (AND LDB IN R)
	POP P,I
	SKIPE R
	 BUG
	MOVE R,QDIRP(A)
	ADDI R,NXLBYT+2
	CAMGE R,@QSNLCN(H)
	 JRST QLWO1		;DON'T NEED TO EXPAND F.S.
	MOVEI R,LUNBLK(TT)
	MOVE Q,QSNLCN(H)
	SUBI R,(Q)
	CAML R,UDNAMP(Q)
	 JRST QSBWG7		;DON'T HAVE ROOM.  GC
	MOVEI R,3*6		;HAVE ROOM
	ADDM R,(Q)
QLWO1:
REPEAT NXLBYT+2,[
	ILDB R,TT
	JUMPN R,QSBWG7
]
	JRST QSBWG8		;OK

QSBWG7:	MOVSI R,%QAFUL		;NO ROOM, GC BEFORE COMMITTING NEXT TRACK
	IORM R,QSRAC(A)
QSBWG8:	POP P,R
	JRST QUDULK

QSBGB2:	ANDCAM Q,QSRAC(A)	;DISK READ ERROR
	JRST IOCER3		;TELL USER

;DISK OUTPUT GET-BUFFER ROUTINE.  PRESERVES D FOR BENEFIT OF PDUMP.
QSBWG:	MOVE Q,QSRAC(A)
	TLNE Q,%QALNK+%QAACC	;DON'T WRITE TO LINK, DON'T LET PDUMP GET
	 JRST IOCR10		; FAKED OUT BY USE FORCE OR ACCESS
	PUSH P,A
	TLNE Q,%QAMWO
	 JRST QWOG1		;JUMP IF WRITE OVER MODE
	HRRZ Q,QBFP(A)		;NORMAL MODE
	JUMPE Q,QSBWG1		;CAN ALWAYS HAVE ONE BUFFER
	MOVE Q,QWBUFS
	CAML Q,QWBFMX
	 JRST POPAJ		;TOO MANY WRITE BUFFERS QUEUED
QSBWG1:	PUSHJ P,QSTWG
	PUSHJ P,TCALL
	  JRST IOMQ
	 JRST QSBWG5		;MEM FROZE OR NOT AVAILABLE
	MOVE Q,(P)		;DISK CHNL #
	DPB Q,[MNUMB,,MEMBLT(A)]
	MOVEI Q,MU23B
	DPB Q,[MUR,,MEMBLT(A)]
	MOVE Q,A
	POP P,A
	AOS QSBFS(A)
	AOS QWBUFS
	HRRZ J,QSBYTE(A)
	IMULI J,2000
	MOVEM J,QMPBSZ(A)	;FRESH BLOCK SIZE
	JRST QSBWG4

QSTWG:	MOVSI Q,%QAFUL
	TDNE Q,QSRAC(A)		;ROUTINE TO COMMIT A TRACK
	 JRST QSTWG1		;DIR FULL, NEED GC BEFORE GROWING FILE
	MOVE H,QUDPR(A)		;IF THIS DIRECTORY HAS AN ALLOCATION
	MOVE Q,QSNLCN(H)	; ENFORCE IT
IFN QRSRVP,[
	HRRZ J,UDALLO(Q)
	JUMPE J,QSTWG0		;NO ALLOCATION
	HRRZ H,UDBLKS(Q)	;GET BLOCKS USED
	CAML H,J
	 JRST IOCR13		;HAS ALLOCATION AND USER IS TRYING TO EXCEED IT
]
QSTWG0:	MOVE J,QDSKN(A)
	SOSL QSFT(J)		;RESERVE A TRACK
	 POPJ P,
	AOS QSFT(J)		;DISK FULL, GIVE BACK THE TRACK
	SKIPE QFBTS		;WAIT FOR ANY PENDING FILE DELETIONS
	 PUSHJ P,UFLS		; TO COMPLETE AND FREE THEIR BLOCKS
	SOSL QSFT(J)		;GOT SPACE NOW?
	 POPJ P,
	AOS QSFT(J)		;NO, GIVE UP AND ERR OUT
	JRST IOCER9

QSTWG1:	MOVE H,QUDPR(A)
	PUSHJ P,QUDLK
	PUSHJ P,QGC
	 JRST IOCR12		;DIR FULL
	PUSHJ P,QUDULK
	ANDCAM Q,QSRAC(A) .SEE %QAFUL
	JRST QSTWG

QSBWG5:	POP P,A			;GET BACK QSK CHANNEL #
	MOVE J,QDSKN(A)
	AOS QSFT(J)		;NO MEMORY; GIVE EVERYTHING BACK
	POPJ P,

;DISK OUTPUT RELEASE-BUFFER ROUTINE FOR BLKT, SIOKT, CHRKT.
QSBWW:	SKIPGE QSMDN(A)		;WRITE BUFFER FROM MN PROG TO CHAIN FOR PI
	 POPJ P,		;NO WRITE BUFFER ACTIVE
	LDB TT,[$QAMOD,,QSRAC(A)]
	SOJE TT,QSBWO1		;WRITE OVER MODE
	SKIPL D,QMTTR(A)
	 JRST QTG1		;TRACK ALREADY RESERVED
	PUSH P,I
	MOVE I,QDSKN(A)
	PUSHJ P,QGTRK		;GET A TRACK
	POP P,I
	MOVEM D,QMTTR(A)
QTG1:	MOVE H,QUDPR(A)		;TRACK IN D
	PUSHJ P,QUDLK
	MOVE TT,QSNLCN(H)
	AOS UDBLKS(TT)
	MOVE TT,QMPTN(A)	;GET PREVIOUS TRACK#
	CAIN D,1(TT)
	 JRST QTG2		;THIS TRACK IS CONSECUTIVE
	SKIPN QMPTC(A)		;THIS TRACK NOT CONSEC CHECK COUNT OF PREV CONSEC BLOCKS
	 JRST QTG3
	PUSH P,D		;NON-ZERO SO STORE IN USER DIRECTORY
	MOVE D,QMPTC(A)
	CLEARM QMPTC(A)
	PUSHJ P,QUDS
	POP P,D
QTG3:	MOVE J,QMTTR(A)		;DESCRIPTOR WILL BE STORED
	MOVEM J,QMPTN(A)
	SUB D,QMPTN(A)		;CAN TRACK BE SKIPPED TO?
	SOJL D,QTG4		;CAN'T BE SKIPPED TO (NOTE QMPTN HAS NOT BEEN AOS'D)
	CAILE D,UDWPH-UDTKMX-1
	 JRST QTG4		;ALSO NO
	ADDI D,UDTKMX		;NEXT BLOCK WITHIN N
	PUSHJ P,QUDS		;STORE APPROPRIATE SKIP
QTG5A:
QTG5:	MOVE Q,QSMDN(A)		;CORE BLOCK NUM BEING WRITTEN
	MOVE D,QMPTN(A)		;TRACK NUM OF BLOCK ADDING TO FILE
	HRLZM D,MEMPNT(Q)	;STORE TRACK NUM
	SETOM QMTTR(A)		;INDICATE TRACK USED
	MOVE J,QMPBSZ(A)	;LENGTH OF THIS BLOCK
	ADDM J,QFBLNO(A)	;INCR BYTE ADR OF START OF CURRENT BLOCK IN FILE
	HRRM J,MEMPNT(Q)	;SAVE BYTE COUNT
	PUSH P,R
	IDIVI J,@QSBYTE(A)	;CONVERT TO WORD COUNT
	JUMPE R,QTG7		;EXACT MULTIPLE OF WORD
	AOS J
	MOVNS R
	ADDI R,@QSBYTE(A)	;# BYTES RESIDUE IN LAST WORD
QTG7:	DPB J,[MWC,,MEMBLT(Q)]	;STORE ACTIVE WORD COUNT
	MOVE D,QSRAC(A)
	LDB TT,[$QAMOD,,QSRAC(A)]
	TLNN D,%QALBK		;LAST BLOCK OF WRITE OVER POSSIBLY
	 SOJE TT,QTG6		;WRITEOVER MODE AND NOT LAST BLOCK, DONT UPDATE LAST BLOCK WORD COUNT
	MOVE H,QUDPR(A)		;SET UP DIRECTORY CHANNEL
	MOVE D,QUDFPR(A)
	ADD D,QSNLCN(H)
	DPB J,[UNWRDC+UNRNDM(D)] ;SET WORD COUNT OF LAST BLOCK
	LDB Q,[QSBSIZ(A)]
	PUSHJ P,QBENC		;ENCODE BYTE CRUFT
	DPB Q,[UNBYTE+UNREF(D)]
	MOVE J,QACTB
	IORM J,QSNLCN(H)
QTG6:	POP P,R
	PUSHJ P,QUDULK
	MOVE Q,QSMDN(A)
	MOVEI J,.BM MLO
	ANDCAM J,MEMBLT(Q)	;SET END OF LIST INDICATOR IN MEMORY BLOCK
	CONO PI,UTCOFF
	HLRZ J,QBFP(A)		;STORE MEMORY BLOCK IN OUTPUT LIST
	JUMPE J,QSBWW1
	DPB Q,[MLO,,MEMBLT(J)]
QSBWW2:	HRLM Q,QBFP(A)
	CONO PI,UTCON
	SETOM QSMDN(A)		;MN PROG BUFFER NOW WRITTEN
	JRST QSTRTR		;START ACTION IF 2311 IDLE AND RETURN

QSBWO1:	MOVE Q,QSRAC(A)		;PUT BUFFER IN WRITE-OVER MODE
	TLNE Q,%QALBK		;IF NOT HACKING LAST BLOCK
	 TLNE Q,%QAEFW		;OR HACKING CLOSE
	  JRST QSBWO2		;THEN JUST WRITE IT
	HRRZ D,QSBYTE(A)
	IMULI D,2000
	SUB D,QMPBSZ(A)
	JUMPE D,QSBWO2		;BLOCK REALLY FULL
	TLNE Q,%QAMPU		;DID WE IOCER2 AT QSBWG4?
	 JRST IOCER2		;YES, QSMPRP NOT SET UP, DON'T WRITE ANYTHING
	MOVEM D,QSMPRC(A)	;LAST BLOCK NOT REALLY USED UP ("SPRUNG BACK TO LIFE")
	ADDM D,QMPBSZ(A)	;EXTRA ROOM IN LAST BLOCK TO FILL UP
	MOVSI D,%QAWOV
	IORM D,QSRAC(A)		;FILLING LAST BLK PAST ORIG EOF
	POPJ P,			;FINISH OUT BLOCK

QSBWO2:	MOVSI D,%QAWOV
	ANDCAM D,QSRAC(A)
	MOVE D,QSLGL(A)		;WRITE TRACK BACK WHERE IT CAME FROM
	MOVEM D,QMPTN(A)	;PUT TRACK NO WHERE QTG5 CAN FIND IT
	MOVE H,QUDPR(A)
	PUSHJ P,QUDLK
	SETOM QSCRW(A)		;SWITCH TO WRITE MODE
	MOVEI Q,%QMWOV
	HRRM Q,QSRAC(A)
	JRST QTG5


QTG4:	LDB D,[140500,,QMTTR(A)] ;WRITE LOAD ADDRESS
	IORI D,40
	PUSHJ P,QUDS
	LDB D,[060600,,QMTTR(A)]
	PUSHJ P,QUDS
	LDB D,[0600,,QMTTR(A)]
	PUSHJ P,QUDS
	JRST QTG5A
 
QGTRK:	PUSHJ P,QTLOCK		;GET TRK CHNL IN A DSK IN I RET IN D CLOBBERS E,TT,Q,J,B
QGTK4:	PUSH P,R		;ENTER HERE FROM SWAP OUT WITH UTCOFF
	PUSH P,B
	PUSH P,E
	HRRZ R,QTUTO(I)
QGTK4A:	SKIPGE Q,QMFTP(A)
	 JRST QGTK3A		;FIRST TRACK
	IDIVI Q,DECADE
	HRREI J,-DECADE(J)	;COMPUTE TRACKS REMAINING IN DECADE
	MOVE D,QMFTP(A)
	PUSHJ P,TUTPNT
	ADD D,[TUTBYT_14,,]	;MAKE INTO ILDB-TYPE POINTER
	MOVE TT,QMFTP(A)
	EXCH D,TT
QGTK3:	CAML D,QLASTB(R)
	 JRST QGTK3A		;REACHED END OF DISK
	ILDB Q,TT
	JUMPE Q,QGTK2
	AOJGE J,QGTK3A		;DECADE OUT
	AOJA D,QGTK3

QGTK3A:	CAILE A,NQCHN
	 JRST QGTK3C		;SWAP CHANNEL
QGTK3D:	MOVEI Q,DECADE
	ADDB Q,QTUTP(R)
QGTK3B:	MOVEM Q,QMFTP(A)
	CAMGE Q,QLASTB(R)
	 JRST QGTK4A
	MOVE Q,QSWAPA(R)	;REACHED END OF DSK, RESET TO END OF SWAPPING AREA
	ADDI Q,DECADE-1		;ROUND UP TO A MULTIPLE OF A DECADE
	IDIVI Q,DECADE
	IMULI Q,DECADE
	MOVEM Q,QTUTP(R)
	JRST QGTK3B

QGTK2:	MOVEI B,1
	DPB B,TT
	MOVEM D,QMFTP(A)
	MOVE J,DCHBT(I)
	IORM J,QTUTO(I)
	POP P,E
	POP P,B
	POP P,R
	CAILE A,NQCHN
	 POPJ P,		;CALLED FROM SWAP OUT
	JRST QTULK

QGTK3C:	CAML D,QSWAPA(R)
	 JRST QGTK3D		;IN NON-SWAP AREA
	AOS D
	CAMN D,QSWAPA(R)
	 MOVEI D,NUDSL
	MOVEM D,QMFTP(A)
	JRST QGTK4A
;STORE CHR IN D CHNL IN A USER DIR PNTR IN H
;CANNOT PCLSR NOR GC

QUDS:	PUSH P,I
	PUSH P,Q
	MOVE I,QDIRP(A)
	CAIGE I,2000*UFDBPW
	CAML I,@QSNLCN(H)	;UDESCP
	 BUG			;WRITING ABOVE F.S. PNTR?
	AOS QDIRP(A)
	IDIVI I,UFDBPW
	MOVE Q,QBTBL(Q)
	ADD Q,I
	SKIPL I,QSNLCN(H)
	 BUG			;UFD WAS NOT LOCKED
	ADDI Q,UDDESC(I)
	LDB I,Q
	CAIE I,UDWPH		;OK TO CLOBBER UDWPH (NORMALLY DOES AT START OF FILE)
	 JUMPN I,[JRST 4,.]	;ABOUT TO CLOBBER SOMETHING IN UFD
	DPB D,Q
	ILDB I,Q		;MAKE SURE FILE DESC WILL ALWAYS BE FOLLOWED BY ZERO
	SKIPE I
	 BUG
REPEAT NXLBYT+2,[		;MAKE SURE THERE'S ROOM FOR ONE MORE TRACK
	ILDB I,Q
	JUMPN I,QUDS1
]
	MOVE I,QDIRP(A)
	ADDI I,NXLBYT+2
	CAMGE I,@QSNLCN(H)	;UDESCP
	 JRST QUDSX		;DESC AREA NOT COLLIDING WITH LIM OF DESC SPACE
	MOVEI Q,LUNBLK(Q)
	MOVE I,QSNLCN(H)
	SUBI Q,(I)
	CAML Q,UDNAMP(I)
	 JRST QUDS1		;NO ROOM.
	MOVEI Q,3*UFDBPW	;EXPAND DESC AREA
	ADDM Q,UDESCP(I)
	JRST QUDSX

QUDS1:	MOVSI Q,%QAFUL		;NEED GC BEFORE STARTING ON NEXT TRACK
	IORM Q,QSRAC(A)
QUDSX:	MOVE Q,QACTB
	IORM Q,QSNLCN(H)	;SET DIRECTORY CHANGED
	POP P,Q
	POP P,I
	POPJ P,

QSBWW1:	HRRM Q,QBFP(A)
	JRST QSBWW2

QSBRB1:	MOVE A,D
QSBRB:	PUSH P,A
	SKIPGE A,QSMDN(A)
	 JRST POPAJ
	PUSHJ P,MEMR
	POP P,A
	HRRZ TT,QMPBSZ(A)
	ADDM TT,QFBLNO(A)	;INCREMENT BYTE ADR IN FILE OF BEG OF NEXT BLOCK
	SETOM QSMDN(A)
	JRST QSTRTR

QTG2:	MOVE J,QMTTR(A)		;INDICATE WE WILL STORE DESCRIPTOR FOR NEXT TRACK.
	MOVEM J,QMPTN(A)
	AOS D,QMPTC(A)		;NEXT BLOCK IS CONSECUTIVE
	CAIGE D,UDTKMX
	 JRST QTG5A
	SETZM QMPTC(A)		;MAX # CONSECUTIVE BLOCKS, STORE DESC NOW
	PUSHJ P,QUDS
	JRST QTG5A

SUBTTL	DIRHNG DEVICE

;WHENEVER THE DIRECTORY SPECIFIED AS THE SNAME WHEN DIRHNG IS OPENED
;IS MODIFIED, YOU GET AN INTERRUPT ON THE DIRHNG DEVICE CHANNEL.

;HERE TO OPEN THE DIRHNG DEVICE.  IOCHNM ADDR IN R, SNAME IN USYSN1(U).
DIRHO:	MOVE C,USYSN1(U)
	PUSHJ P,QFL	;LOOK UP THIS DIRECTORY
	 JRST OPNL20	;CALL FAILS IF DIRECTORY DOES NOT EXIST.
	HRRZM J,IOCHST-IOCHNM(R)	;DIR EXISTS;  STORE TRACK NUMBER IN IOCHST.
DIRHP1:	CONO PI,CLKOFF
	HLLZ A,DIRHNG	;ADD THIS CHANNEL'S IOCHNM TO THE LIST OF DIRHNG CHANNELS.
	HRRI A,DNDIRH
	MOVEM A,(R)	;SET UP THE IOCHNM WITH IOTTB INDEX AND LIST CHAIN.
	HRLZM R,DIRHNG
	JRST CLKOJ1

;CLOSE A DIRHNG DEVICE CHANNEL.
DIRHCL:	PUSHJ P,DIRHPS	;REMOVE IT FROM THE LIST, AND
	SETZM (R)	;MARK IT CLOSED.
	POPJ P,

;IOPUSH A DIRHNG DEVICE CHANNEL.  REMOVE IT FROM THE LIST OF ALL SUCH.
DIRHPS:	MOVEI A,DIRHNG
	CONO PI,CLKOFF
;FIND THE PLACE THAT POINTS AT THIS IOCHNM WORD.
DIRHC1:	HLRZ B,(A)
	CAIN B,(R)
	 JRST DIRHC2
	SKIPN A,B	;END OF LIST REACHED =>
	 BUG		;THIS IOCHNM ISN'T IN THE LIST.  BUT IT IS SUPPOSED TO BE!
	JRST DIRHC1

;A POINTS AT IOCHNM THAT POINTS AT THIS ONE.  PATCH THIS ONE OUT OF LIST.
DIRHC2:	HLRZ B,(B)	;THE ONE AFTER THIS ONE
	HRLM B,(A)
	JRST CLKONJ

;IOPUSH OR IOPOP THE DIRHNG CHANNEL WITH R -> IOCHNM WORD.  I SAYS WHICH OPERATION.
DIRHIP:	JUMPE I,DIRHPS	;IOPUSH REMOVES CHANNEL FROM LIST OF ALL DIRHNG CHANNELS.

;IOPOP A DIRHNG DEVICE CHANNEL.  JUST LIKE OPENING IT EXCEPT THAT
;THE DIRECTORY TRACK NUMBER IS ALREADY IN THE IOCHST.
;ALSO, WE SHOULD GIVE AN INTERRUPT NOW,
;IN CASE THE DIRECTORY WAS WRITTEN IN WHILE THE CHANNEL WAS PUSHED.
DIRHPP:	PUSHJ P,DIRHP1		;FIRST, REOPEN THE CHANNEL.  LINK IT INTO THE DIRHNG LIST.
	 BUG
	MOVE A,R
	SUBI A,IOCHNM(U)	;COMPUTE CHANNEL NUMBER FROM IOCHNM WORD ADDRESS.
	MOVE A,CHNBIT(A)	;GET BIT CORRESPONDING TO CHANNEL.
	AND A,MSKST2(U)		;GIVE THE INT IF THE INT IS ENABLED.
	IORM A,IFPIR(U)
	POPJ P,

;HERE WITH A/ DIRECTORY'S TRACK NUMBER (AS RETURNED BY QFL)
;TO SIGNAL A WRITE IN THAT DIRECTORY TO ALL DIRHNG DEVICES THAT ARE LOOKING.
;CLOBBERS B, C, D.
DIRSIG:	CONO PI,CLKOFF
	MOVEI B,DIRHNG
DIRSI0:	HLRZ B,(B)	;GET IOCHNM ADDR OF NEXT DIRHNG DEVICE.
	JUMPE B,CLKONJ
	HRRZ C,IOCHST-IOCHNM(B)
	CAIE C,(A)	;DOES IT LOOK AT THIS DIRECTORY?
	 JRST DIRSI0
	MOVEI C,-IOCHNM(B)	;YES => FIGURE OUT USER INDEX OF JOB IT BELONGS TO.
	IDIVI C,LUBLK
	IMULI C,LUBLK	;C NOW HAS USER INDEX.
	MOVNI D,IOCHNM(C)
	ADD D,B		;D GETS CHANNEL NUMBER
	MOVE D,CHNBIT(D)
	AND D,MSKST2(C)	;INTERRUPT THE USER ON THAT CHANNEL, IF IT'S ENABLED.
	IORM D,IFPIR(C)
	JRST DIRSI0
