Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - filio.mac
There are 17 other files named filio.mac in the archive. Click here to see a list.
TITLE FILIO LEVEL-D DISK SERVICE ROUTINE  V617
SUBTTL DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW 22 MAR 77
	SEARCH	F,S
	$RELOC
	$HIGH
;***COPYRIGHT 1973,1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
XP VFILIO,617

;ASSEMBLY INSTRUCTIONS: FILIO,FILIO/C_S,FT50S,FILIO
	ENTRY	FILIO
FILIO::

;ASSEMBLY PARAMETER FOR FNDFIL INTERLOCK

;BITS IN THE ACCESS TABLE STATUS WORD
ACPCRE==:40
ACPSUP==:20
ACPUPD==:10
ACPREN==:200
ACRSUP==:2
ACPNIU==:400000
ACMCNT==:377400
ACPSMU==:4

IOSMON==400000	;THIS FILE IS CURRENTLY DOING MONITOR IO
IOSAU==200000	;THIS FILE HAS THE ALTER-UFD RESOURCE
IOSUPR==100000	;SUPER USETI/USETO DONE ON THIS CHAN
IOSDA==40000	;THIS FIL HAS DISK ALLOCATION QUEUE
IOSRIB==20000	;RIB IS IN MONITOR BUFFER
IOSRDC==10000	;THIS USER CHANNEL HAS READ COUNT UP FOR FILE
IOSWLK==4000	;FILE (WHOLE STR) IS SOFTWARE WRITE-=LOCKED
		; EITHER FOR ALL JOBS OR FOR THIS JOB ONLY
IOSALC==2000	;DONT CHANGE ACCALC WHEN GIVING UP BLOCKS OF A FILE
IOSFIR==1000	;COMPUTE AND STORE OR CHECK THE CHECKSUM
IOSHMS==IOBEG	;HUNG-DEVICE MESSAGE ALREADY TYPED
IOSRST==IOFST	;RESET (RELEASE) WAS DONE ON A SPOOLED DEVICE

;THE FOLLOWING S BITS ARE DEFINED IN COMMON.MOD
;BECAUSE THEY WANT TO BE IN THE SAME POSITION IN S AS IN RIB STATUS WORD
;IOSHRE=100	;HARD READ ERROR ENCOUNTERED
;IOSHWE=200	;HARD WRITE ERROR ENCOUNTERED
;IOSSCE=400	;SOFTWARE CHECKSUM ERROR ENCOUNTERED OR HARD POSITIONING ERROR

;IOSERR=IOSHRE+IOSHWE+IOSSCE
;IOSMER=-IOSERR
DEFINE	NOSCHEDULE <>
DEFINE SCHEDULE <>
IFE	FTCBDB,<
DEFINE	CBDBUG<>
>

IFN	FTCBDB,<
DEFINE	CBDBUG(A,B)<
	AOSA	.+1
	0
IFIDN	<A>,<Y><
	PUSH P,T1
	MOVE T1,JOB##
	CAME T1,CBUSER##
	HALT	.
	POP	P,T1
>
IFIDN	<B>,<Y><
PUSHJ	P,CKBAS##
>
>
>
REPEAT	0,<
NOTE ABOUT STATES OF CHANNELS, KONTROLLERS, UNITS, FILES:

			C	K	U	F
IDLE		I	I	I	I	I
SEEK WAIT	SW			SW
SEEK		S			S
POSITION WAIT	PW			PW	PW
POSITION	P			P	P
TRANSFER WAIT	TW			TW	TW
TRANSFER(BUSY)	T OR B	B	B	T	T

NOTE ABOUT QUEUES:
THERE ARE 2 QUEUES OF FILES
	SW/PW QUEUE FOR EACH UNIT
	TW	QUEUE FOR CHANNEL
A FILE IS ONE AND ONLY ONE OF THE FOLLOWING CONDITIONS:WITH RESPECT TO QUEUES
	A.THE ONLY FILE IN SW/PW QUEUE FOR A UNIT (UNIT IN SW STATE)
	B.ONE OF PERHAPS MANY FILES IN PW QUEUE FOR A UNIT(UNIT IN PW,P,TW,OR T STATE)
	C.ONE OF PERHAPS MANY IN TW QUEUE FOR CHANNEL(CHAN AND KONTROL IN B STATE)
	D.NONE OF THE ABOVE (FILE IN I,P, OR T STATE)

NOTE:	#MEANS INSTRUCTION IS EXECUTED WITH ALL DISK PI CHANNELS OFF
	%MEANS INSTRUCTION IS EXECUTED WHILE JOB## HAS CB RESOURCE
	*MEANS INSTRUCTION MAY BE EXECUTED AT INTERRUPT LEVEL
	(TO SAVE TYPING USED ONLY FOR INSTRUCTIONS NOT IN INTERRUPT MODULE ITSELF)

THE FOLLOWING TECO MACRO WILL PRODUCE A LISTING OF ONLY THE SUBROUTINE
NAMES AND COMMENTS PRIOR TO THEM:
ERDEV1:FILSER.MAC$EWDEV2:FILSER.SUB$
<_;SUBROUT$;0L.U1  !NTST! :S:$"GA ONTST$'.U20L1A-59"E LONTST$' Q2JI

$Q1,.PW 0,.K>EF



>
	SUBTTL	ALLOCATION/DEALLOCATION
CLASIZ=:^D23
TALSIZ=:^D36-CLASIZ
CLAPOS=:^D35
TALPOS=:^D35-CLASIZ
CLAMAX=1B<TALPOS>-1	;MAX CLUSTER ADDR. (BYTE OF ALL 1'S)
DSKSCN=100000	;SCANNING SATS FROM DISK
STRTAD=200000	;ALLOCATE STARTING AT A SPECIFIED LOCATION
SATCHG=400000	;SAT TABLE IN CORE DIFFERS FROM SAT TABLE ON DISK (SIGN BIT)



;SUBROUTINE TO GET A CHUNK OF BLOCKS (ANYWHERE IN STR)
;ENTER WITH T2=HOW MANY TO GET, U=PREFERRED UNIT
;EXIT CPOPJ1 IF GOT ALL (OR SOME) ON DESIRED UNIT
;EXIT CPOPJ IF GOT ALL (OR SOME) ON A DIFFERENT UNIT, WITH T3=UNIT-CHANGE POINTER
;EXIT CPOPJ WITH T3=0 IF GOT NONE (STR FULL).
;THIS ROUTINE GETS EITHER ALL, OR THE LARGEST AVAILABLE CHUNK IN STR
;RETURNS WITH T2=RETRIEVAL POINTER, T1=NUMBER OF BLOCKS OBTAINED
TAKCHK::PUSHJ	P,SAVE2##		;SAVE P1,P2
	MOVE	P1,U		;FOR END-TEST
	SETZ	P2,		;INDICATE NO BEST UNIT YET
	HRRZS	T2		;WANT EXACTLY C(T2) BLOCKS
;THE ABOVE INSTRUCTION WAS CHANGED FROM HRROS SINCE, WHEN THE DISKS GET FULL,
; THIS LOOP CONSUMES LOTS OF TIME. EVENTUALLY, WE WILL CHANGE IT SO THAT
; THE LARGEST HOLE IN A SAT GETS STORED IN CORE, AT WHICH POINT THIS
; WILL GO BACK THE WAY IT WAS
TAKCH1:	SETZ	T1,		;WANT THEM ANYWHERE ON UNIT
	PUSHJ	P,TAKBLK	;TRY TO GET THE BLOCKS
	  JRST	TAKCH2		;CANT GET THAT MANY ON THIS UNIT
	CAIN	U,(P1)		;GOT ALL WE ASKED FOR. SAME UNIT?
	PJRST	CPOPJ1##	;YES - SKIP RETURN
	LDB	T3,UNYLUN##	;NO. GET LOG. UNIT NO.
	TRO	T3,RIPNUB##	;MAKE A UNIT-CHANGE POINTER
	POPJ	P,		;AND NON-SKIP RETURN

;HERE ON NOT-AVAILABLE RETURN FROM TAKBLK
TAKCH2:	CAIG	T2,(P2)		;THIS UNIT BEST SO FAR?
	JRST	TAKCH3		;NO
	MOVE	P2,T2		;YES. SAVE SIZE OF LARGEST HOLE
	HRL	P2,U		;SAVE UNIT OF LARGEST HOLE
TAKCH3:	HLRZ	U,UNISTR##(U)	;STEP TO NEXT UNIT IN STR
	JUMPN	U,TAKCH4	;END OF STR CHAIN?
	HRRZ	U,UNISTR##(P1)	;YES, STR DATA BLOCK LOC
	HLRZ	U,STRUNI##(U)	;1ST UNIT IN STR
TAKCH4:	HRRZ	T2,T1		;RESTORE NUMBER OF BLOCKS TO GET
	CAIE	U,(P1)		;BACK WHERE WE STARTED?
	JRST	TAKCH1		;NO, TRY THIS UNIT
	JUMPE	P2,CPOPJ##	;RETURN IF STR IS FULL
	HLRZ	U,P2		;NOT FULL - SET BEST UNIT
	HRRZ	T2,P2		;LARGEST CONTIGUOUS CHUNK AVAILABLE
	JRST	TAKCH1		;GO SETTLE FOR LARGEST HOLE
;ROUTINE TO ALLOCATE BLOCKS FROM DISK
;ENTER WITH T1= WHERE TO START (OR 0 IF DONT CARE)
;T2= HOW MANY TO ALLOCATE 
;LH(T2)=0 IF TAKE N OR LESS
;LH(T2)=-1 IF TAKE EXACTLY N
;RETURNS CPOPJ IF UNSUCCESSFUL WITH T2=LARGEST HOLE FOUND, T1= ORIGINAL T2, T3=0
;RETURNS CPOPJ1 IF OK, WITH T1= NUMBER OF BLOCKS TAKEN T2 = CLUSTER POINTER FOR GROUP
;T3 POINTS TO FILE STRUCTURE DATA BLOCK
TAKBLK::
	PUSHJ	P,SAVE4##	;SAVE P1-P4
	PUSH	P,W		;SAVE W
	HLL	W,T2		;SAVE LH(T2) (=-1 IF EXACTLY N BLOCKS)
	HRRZS	T2		;SET T2=POSITIVE NUMBER
	SKIPN	T2		;MORE THAN 18 BITS WORTH?
	MOVEI	T2,-1		;YES, ASK FOR MAX
	SKIPN	DINITF##	;IN ONCE-ONLY (REFRESHER)?
	CAMG	T2,UNITAL##(U)	;NO, REQUESTING MORE THAN ARE AVAILABLE?
	JRST	TAKBL		;NO. GET SOME BLOCKS
	MOVE	T3,T2		;YES. AMONT TO GET INTO T3
	SKIPLE	T2,UNITAL##(U)	;ANY BLOCKS AT ALL?
	JUMPGE	W,TAKBL		;YES. REQUEST  MAXIMUM OF UNITAL BLOCKS
	MOVEI	T2,0
	TLNE	F,OCLOSB	;NO. IS CLOSE HAPENING?
	AOJA	T2,TAKBL	;YES. TRY TO GET 1 BLOCK ANYWAY
;(THERE ARE BLOCKS IN SAT TABLES WHICH ARE NOT IN UNITAL, AND ARE ONLY
;GIVEN UP DURING A CLOSE UUO)
	MOVE	T1,T3		;NOT CLOSE. INDICATE 0 SPACE FOUND
	JRST	TAKBLT		;AND TAKE ERROR RETURN

TAKBL:
	LDB	T4,UNYBPC##	;NUMBER OF BLOCKS PER CLUSTER
	HRRZ	P3,T2		;DESIRED NUMBER OF BLOCKS
	ADDI	P3,-1(T4)	;CONVERT TO NUMBER OF CLUSTERS
	IDIV	P3,T4
	MOVE	T3,UNISTR##(U)
	SETO	T2,		;COMPUTE LARGEST ALLOWED GROUP SIZE
	LDB	T2,STYCNP##(T3)	;LARGEST FIELD
	CAIGE	T2,(P3)		;ASKING FOR TOO MUCH?
	HRR	P3,T2		;YES, REDUCE REQUEST
	PUSHJ	P,SUPDA		;QUEUE FOR DISK ALLOCATION IF DONT ALREADY HAVE (ENTER)
	SKIPN	DEVUNI##(F)
	JRST	TAKBLU
	HLRZ	P1,UNISAB##(U)	;LOC OF FIRST SAT BUFFER
	JUMPE	T1,TAKBLA	;GO IF NO START ADDRESS SPECIFIED
;HERE WHEN A START ADDRESS SPECIFIED
	SETZ	T2,
	CAML	T1,UNIBPU##(U)	;REQUESTED BLOCK ABOVE TOP OF UNIT?
	JRST	TAKBLM		;YES, ERROR RETURN
	IDIV	T1,T4		;NO, CONVERT TO CLUSTER ADDRESS
	PUSH	P,T1		;SAVE CLUSTER ADDRESS
	PUSHJ	P,CHKNEW	;TEST FOR NEWLY-MOUNTED STR
	MOVE	T1,(P)		;RESTORE ADR
	PUSHJ	P,FNSAT		;GET SAT BUFFER FOR THIS BLOCK
	SKIPN	DEVUNI##(F)	;IF UNIT WAS REMOVED,
	PJRST	TAKBL3		; TAKE ERROR RETERN
	HRLM	P1,UNISAB##(U)	;SAVE BUFFER LOC IN UNISAT
	HLRE	T1,SABSCN##(P1)	;-LENGTH OF WHOLE SAT DATA AREA
	ADDI	P1,SABBIT##(T2)	;SET RH(P1)=FIRST SAT WORD FOR ADDRESS
	ADD	T1,T2		;T1=-NUMBER OF DATA WORDS AFTER THIS ONE
	HRLM	T1,P1		;P1=AOBJN WORD TO SCAN TABLE
TAKBL1:	MOVEI	P2,0		;P2 WILL CONTAIN LARGEST HOLE FOUND
	MOVE	T1,(P1)		;FIRST WORD TO LOOK AT
	LSH	T1,(T3)		;POSITION TO RIGHT BIT
	JUMPL	T1,TAKBL3	;HOLE=0 IF 1ST BIT SET
	HRLM	T2,P2		;SAVE POSITION OF HOLE
	DPB	T3,[POINT 6,P3,17]
	MOVNS	T3
	MOVEI	T4,^D36(T3)	;SET NUMBER OF BITS LEFT IN WORD
	JFFO	T1,.+2		;COMPUTE NUMBER OF LEADING 0'S
	MOVEI	T2,^D36(T3)	;REST OF WORD EMPTY
	TLO	P3,STRTAD	;INDICATE START ADDR. SPECIFIED
	PUSH	P,P1		;SAVE LOC OF 1ST DATA WORD
	PUSHJ	P,GETZR##	;TRY TO GET N 0'S
	  JRST	TAKBL2		;CANT GET ENOUGH

	POP	P,T1		;FOUND THEM  REMOVE GARBAGE FROM PD LIST
	HLRZ	P2,UNISAB##(U)	;LOC OF SAT BUFFER
	JRST	TAKBLQ		;MARK BLOCKS, HOUSEKEEP AND EXIT

;HERE WHEN WE COULDNT GET N CONTIGUOUS BLOCKS
TAKBL2:	POP	P,P1		;PICK UP DATA LOC AGAIN
	JUMPL	W,TAKBL3	;GO IF EXACTLY N NEEDED
	HRR	P3,P2		;WE CAN DO WITH LESS GET LARGEST AVAILABLE
	LDB	T3,[POINT 6,P3,17]
	HLRZ	T2,P2		;RESTORE POSITION
	JRST	TAKBL1		;GO GET THEM

;HERE WHEN N NOT AVAILABLE, WE NEEDED EXACTLY N BLOCKS
TAKBL3:	POP	P,T1		;TAKE STUFF OFF PD LIST
	HRRZ	T2,P2		;LARGEST HOLE AVAILABLE (CLUSTER COUNT)
	JRST	TAKBLM		;CONVERT TO BLOCK COUNT, ERROR RETURN


;HERE WHEN A STARTING ADDRESS WAS NOT SPECIFIED
TAKBLA:	PUSHJ	P,CHKNEW	;MAKE SURE SATS HAVE BEEN READ
	TLZ	P3,677777	;LH(P3) WILL HAVE INDEX OF LARGEST HOLE FOUND
	MOVEI	P2,0		;LH(P2) WILL HAVE SIZE OF LARGEST HOLE
				;THE LEFT HALF OF ACS ARE BEING USED
				;BECAUSE THE PD LIST GETS VERY LONG
				;IF SAT BLOCKS MUST BE READ
	MOVE	T1,UNIDES##(U)
	TLNN	T1,UNPMSB##	;DOES THE UNIT HAVE ONLY 1 SAT TABLE?
	JRST	TAKBLC		;YES, SKIP THE FANCY STUFF

;TRY TO FIND A SAT BLOCK IN CORE CONTAINING ENOUGH CONSECUTIVE 0'S
TAKBLB:	HRRZ	T1,SABTAL##(P1)	;FREE BLOCKS LEFT IN THIS SAT
	CAIGE	T1,(P3)		;ENOUGH TO SATISFY USER?
	JRST	TAKBLG		;NO. LOOK AT NEXT SAT BUFFER

;HERE WHEN THE CURRENT SAT TABLE MAY HAVE ENOUGH CONTIGUOUS CLUSTERS
;SCAN FIRST FROM WHERE THE SCAN LEFT OFF THE LAST TIME
TAKBLC:	MOVE	T1,SABHOL##(P1)	;BIGGEST HOLE IN SAT
	CAIGE	T1,(P3)		;TRYING FOR MORE THAN BIGGEST?
	JUMPGE	T1,TAKBLF	;YES, SKIP SCAN IF WE KNOW SIZE OF HOLE
				; (SABHOL=-1 IF WE DONT KNOW THE SIZE)
	MOVSI	T1,SABBIT##(P1)	;SET UP AN AOBJN WORD  FOR SCAN
	HRLZ	T2,SABSCN##(P1)	;COMPUTE DISTANCE FROM START TO C(SABSCN)
	SUB	T2,T1		;=+N
	ADD	T2,SABSCN##(P1)	;LH=DISTANCE FROM C(SABSCN) TO TOP
				;RH=WHERE TO START LOOKING
	PUSH	P,P1		;SAVE THE BUFFER LOC
	MOVE	P1,T2		;AOBJN WORD FOR SCAN
	HRRI	P2,0		;SET BEST SO FAR TO 0
	PUSHJ	P,GETZ##	;AND TRY TO GET N 0'S
TAKBLD:	  SKIPA	T2,(P)		;COULDN'T GET THEM
	JRST	TAKBLP		;FOUND THEM - UPDATE AND EXIT
;HERE WHEN N WERENT AVAILABLE FROM WHERE SCAN LAST LEFT OFF
;RESCAN TABLE FROM THE START
	MOVEI	P1,SABBIT##(T2)	;FIRST DATA LOC IN BUFFER
	HLL	P1,SABSCN##(T2)	;-LENGTH OF ENTIRE DATA AREA
	PUSHJ	P,GETZ##	;SCAN WHOLE SAT TABLE
	  SKIPA	T1,P2		;STILL CANT FIND ENOUGH
	JRST	TAKBLP		;FOUND THEM - WRAP UP

;HERE WHEN THE CURRENT SAT BUFFER DOESN'T HAVE ENOUGH
	POP	P,P1		;RESTORE BUFFER LOC

TAKBLF:	HRR	P2,T1
	HRRZM	P2,SABHOL##(P1)	;SAVE SIZE OF LARGEST HOLE
	HLRZ	T1,P2		;PREVIOUS MAXIMUM
	CAIL	T1,(P2)		;WAS THIS SAT TABLE BETTER?
	JRST	TAKBLG		;NO
	HRLS	P2		;YES. SAVE SIZE IN LH(P2)
	HRR	P2,P1		;SET RH(P2)=BUFFER LOC
	LDB	T1,SAYNDX##	;GET INDEX OF SAT
	DPB	T1,[POINT 11,P3,17] ;SAVE INDEX IN LH(P3)
TAKBLG:	HRR	P2,P1		;RH(P2)=CURRENT BUFFER
	MOVE	T1,UNIDES##(U)	;DOES THIS UNIT HAVE ONLY 1 SAT?
	TLNN	T1,UNPMSB##
	JRST	TAKBLL		;YES. CANT GET ENOUGH
	TLNE	P3,DSKSCN	;NO. SCANNING SATS FROM DISK?
	JRST	TAKBLI		;YES. READ NEXT ONE
	HLRZ	P1,SABRNG##(P1)	;NO. STEP TO NEXT IN-CORE SAT TABLE
	HLRZ	T1,UNISAB##(U)	;BACK WHERE WE STARTED?
	CAME	P1,T1
	JRST	TAKBLB		;NO. TRY RHIS SAT TABLE
;HERE WHEN ALL SAT TABLES IN CORE ARE THROUGH
;NOTICE THAT WHILE WE WERE LOOKING AT ONLY IN-CORE SAT TABLES WE
;SCANNED ONLY THOSE WHICH HAD A CHANCE OF SUCCESS.
;NOW ALL SAT'S WILL BE LOOKED AT SINCE WE WANT TO FIND
;THE MAXIMUM NUMBER OF CONTIGUOUS BITS IF WE CANT GET ENOUGH
	TLO	P3,DSKSCN	;INDICATE READING SATS FROM DISK
	HLR	P2,UNISAB##(U)	;POINT P2 TO CURRENT SAT
	TROA	P4,-1		;START AT SAT TABLE 0
TAKBLI:	LDB	P4,SAYNDX##	;INDEX OF LAST SAT LOOKED AT
	ADD	P4,UNISPT##(U)	;COMPUTE ABSOLUTE ADDR. OF ITS POINTER
TAKBLJ:	SKIPN	1(P4)		;IS TABLE EXHAUSTED?
	JRST	TAKBLL		;YES. CANT GET ENOUGH
	LDB	T1,[POINT TALSIZ,1(P4),TALPOS]	;FREE COUNT OF THIS SAT
	HLRZ	T3,P2		;LARGEST HOLE FOUND SO FAR
	CAIG	T1,(T3)		;THIS SAT HAVE AT LEAST THAT MANY FREE BITS?
	AOJA	P4,TAKBLJ	;NO. DONT BOTHER SCANNING IT
	SUB	P4,UNISPT##(U)	;YES. COMPUTE INDEX OF SATSPT TABLE
	MOVEI	P4,1(P4)
	PUSHJ	P,SDWNDA	;UNQUEUE,REQUEUE FOR DISK ALLOCATION
	PUSHJ	P,SUPDA		;SO ANY WAITING REQUEST WILL BE
				; SATISFIED BEFORE WE DO IO
	SKIPN	DEVUNI##(F)
	JRST	TAKBLU
	PUSHJ	P,SATST		;GET THE CORRESPONDING SAT TABLE
	MOVE	T1,SABHOL##(P2)	;SIZE OF BIGGEST HOLE IN SAT
	HLRZ	T2,P2		;BIGGEST HOLE FOUND SO FAR
	CAMGE	T1,T2		;WORTH WHILE TO SCAN THE SAT?
	JUMPGE	T1,TAKBLI	;NOT IF WE REALLY KNOW (SABHOL POSITIVE)
	PUSH	P,P2		;SAVE BUFFER LOC
	HRRI	P2,0		;PRESET LARGEST HOLE IN SAT
	JRST	TAKBLD		;GO SCAN THE SAT (FROM BEGINNING)
;HERE WHEN ALL SATS SCANNED, NONE HAS ENOUGH
TAKBLL:	TLNE	P2,-1		;FIND ANY AT ALL?
	JUMPGE	W,TAKBLN	;YES, NEED EXACTLY N?
	HLRZ	T2,P2		;YES. T2=LARGEST HOLE FOUND
TAKBLM:	HRRZ	T1,P3		;T1=SIZE REQUESTED
	LDB	T3,UNYBPC##	;CONVERT BOTH CLUSTER COUNTS
	IMUL	T1,T3		;TO BLOCK NUMBERS
	IMUL	T2,T3
	SETZ	T3,		;T3=0 ON ERROR
	POP	P,W		;RESTORE W
	PJRST	SDWNDA		;GIVE UP DA QUEUE AND ERROR RETURN

;HERE WHEN NOT ENOUGH WERE FOUND, BUT A LESSER AMOUNT WILL DO
TAKBLN:	LDB	P4,[POINT 11,P3,17]	;INDEX OF BEST SAT TABLE
	PUSHJ	P,SATST		;GET CORRESPONDING SAT BLOCK IN
	PUSH	P,P2		;SAVE BUFFER LOC
	HLRZ	P3,P2		;SIZE OF LARGEST HOLE
TAKBLO:	MOVE	T1,(P)		;SET UP AN AOBJN WORD
	HLL	P1,SABSCN##(T1)	; FOR THE BUFFER
	HRRI	P1,SABBIT##(T1)
	MOVEI	P2,0		;SET LARGEST HOLE TO 0
	PUSHJ	P,GETZ##	;GET THE BLOCKS
	  JRST	TAKBLR		;SOMEBODY SNUCK IN!

;HERE WHEN A BUNCH OF BLOCKS HAVE BEEN OBTAINED
;THE BUFFER LOC IS ON THE PD LIST
TAKBLP:	POP	P,P2		;GET BUFFER LOC
	HRRZ	T1,P4		;POSITION OF HOLE
	SUBI	T1,SABBIT##(P2)	;CONVERT TO A CLUSTER NUMBER
	IMULI	T1,^D36
	HLRZ	T2,P4
	MOVNS	T2		;-BIT POSITION IN WORD
	ADDI	T1,^D36(T2)	;CLUSTER NO RELATIVE TO START OF SAT
	LDB	T2,[POINT CLASIZ,SABFIR##(P2),CLAPOS]	;FIRST ADDRESS IN SAT
	ADD	T1,T2		;COMPUTE ACTUAL CLUSTER NUMBER (RELATIVE TO UNIT)
	PUSH	P,T1		;SAVE IT ON THE LIST
	HRRM	P4,SABSCN##(P2)	;SET WHERE TO START NEXT TIME
;HERE WITH CLUSTER ADDRESS ON PD LIST
TAKBLQ:	PUSHJ	P,SETOS##	;MARK THE BLOCKS IN THE SAT TABLE
	STOPCD	.+1,DEBUG,BAO,	;++BIT ALREADY ONE
	HRRZS	P3		;P3=PLUS NUMBER OF CLUSTERS GOTTEN
	PUSHJ	P,FIXCNT	;UPDATE COUNTS
	POP	P,T2		;RESTORE CLUSTER ADDRESS
	MOVE	T3,UNISTR##(U)	;LOC OF STRUCTURE DB
	DPB	P3,STYCNP##(T3)	;SAVE CLUSTER COUNT IN T2
	PUSHJ	P,SDWNDA	;GIVE UP DA QUEUE (EXCEPT IF SIM UPDATE)
	JRST	WPOPJ1##	;AND TAKE GOOD RETURN

;HERE WHEN THE BEST-SO-FAR WHICH WE CAREFULLY COMPUTED IS NO LONGER
;THERE - SOMEONE HAS SNUCK IN WHEN WE UNQUEUED AND GRABBED A CHUNK
;OUT OF THE HOLE WE REMEMBERED
TAKBLR:	JUMPE	P2,TAKBLS	;START ALL OVER IF NOTHING LEFT IN SAT
	MOVE	P3,P2		;SOMETHING LEFT - SETTLE FOR IT
	JRST	TAKBLO		;GO TAKE THE BLOCKS


TAKBLS:	POP	P,T1		;REMOVE JUNK FROM PD LIST
	SKIPLE	T2,UNITAL##(U)	;ANY BLOCKS AT ALL IN UNIT?
	JRST	TAKBLA		;YES. TRY OVER FROM BEGINNING
	HRRZ	T1,P3		;NO. RESTORE AMOUNT REQUESTED
TAKBLT:	POP	P,W		;RESTORE W
	PUSH	P,T1		;SAVE ACS
	PUSH	P,T2
	TLNE	S,IOSDA
	PUSHJ	P,SDWNDA	;GIVE UP THE DA RESOURCE
	MOVEI	T4,.ERFUL	;STR - FULL ERROR
	MOVE	T1,UNISTR##(U)	;STR DB LOC
	SKIPG	STRTAL##(T1)	;STR FULL?
	PUSHJ	P,SETINJ	;YES, SET UP FOR INTERCEPT
	  JFCL			;NOT ENABLED OR STR NOT FULL
	SETZ	T3,		;T3=0 ON ERROR
	POP	P,T2		;RESTORE ACS
	PJRST	TPOPJ##		;AND EXIT

;HERE IF THE UNIT WAS YANKED (DEVUNI=0)
TAKBLU:	SETZB	T2,T3		;INDICATE NO ROOM
	PUSHJ	P,DWNDA		;GIVE UP DA
	PJRST	TPOPJ##		;AND REURN

IFN	FTCCIN!FTDAEM!FTOPRERR,<
;ROUTINE TO CALL SETINT
SETINJ::PUSH	P,J		;SAVE J
	PUSH	P,M		;SETINT CLOBBERS M
	LDB	J,PJOBN##	;JOB NUMBER
	MOVE	R,JBTADR##(J)	;SET R
	SKIPE	J		;SKIP IF SWAP I/O
	PUSHJ	P,SETINT##	;TEST INTERCEPT
	  SOS	-2(P)		;SET FOR NON-SKIP RETURN
	POP	P,M		;RESTORE M
	PJRST	JPOPJ1##	;INTERCEPT SET
>				;END FTCCIN!FTDAEM!FTOPRERR
;SUBROUTINE TO RETURN BLOCKS (DEALLOCATE)
;ENTER WITH T1= DISK ADDRESS  T2= HOW MANY TO DEALLOCATE
GIVBLK::PUSHJ	P,SAVE4##		;SAVE P1-P4
	PUSHJ	P,UPDA		;GET DA RESOURCE
	HLRZ	P1,UNISAB##(U)	;LOC OF FIRST SAT TABLE
	LDB	T4,UNYBPC##	;NUMBER OF BLOCKS PER CLUSTER
	ADDI	T2,-1(T4)	;CONVERT BLOCK COUNT TO CLUSTERS
	IDIV	T2,T4
	MOVNM	T2,P3		;P3=-N FOR UPDATING COUNTS
	IDIV	T1,T4		;CONVERT TO CLUSTER ADDRESS
	PUSHJ	P,FNSAT		;FIND THE SAT  FOR THIS ADDRESS
	MOVEI	T4,SABBIT##(P1)
	ADDI	T4,(T2)		;POSITION IN TABLE
	MOVEI	T1,^D36
	SUBI	T1,(T3)		;POSITION
	MOVN	T3,P3		;COUNT
	PUSHJ	P,CLRBTS##	;CLEAR THE BITS
	  STOPCD	DWNDA,DEBUG,BAZ,	;++BIT ALREADY ZERO
	SETOM	SABHOL##(P1)	;INDICATE SIZE OF LARGEST HOLE IN SAT UNKNOWN
	HRRZ	P2,P1		;SET BUFFER LOC
	PUSHJ	P,FIXCNT	;UPDATE SOME COUNTS
	PJRST	DWNDA		;GIVE UP DA RESOURCE AND RETURN
;SUBROUTINE TO UPDATE SOME COUNTS
;ENTER WITH P3 = HOW MANY CLUSTERS  (PLUS-ALLOCATION, NEG - DEALLOCATION)
; P2=LOC OF SAT BUF.
;RETURNS WITH T1=NUMBER OF BLOCKS
FIXCNT:	SKIPE	DINITF##	;IF IN ONCE-ONLY
	JRST	FIXCN2		;JUST SET SATCHG BIT
	MOVN	T1,P3		;-NUMBER OF CLUSTERS
	LDB	T4,UNYBPC##
	IMUL	T1,T4		;-NUMBER OF BLOCKS
	MOVN	T2,P3		;-NUMBER OF CLUSTERS
	ADDM	T1,UNITAL##(U)	;UPDATE UNIT FREE-TALLY
	MOVE	T3,UNISTR##(U)	;UPDATE STR FREE-TALLY
	JUMPE	T3,FIXCN3	;IF SUPER I/O
	ADDM	T1,STRTAL##(T3)
	MOVE	T3,DEVUFB##(F)	;UPDATE USERS QUOTA
	JUMPE	T3,FIXCN1	;CANT UPDATE QUOTA IF NO UFD
	MOVE	T4,UFBTAL##(T3)
	ADDM	T1,UFBTAL##(T3)
	JUMPLE	T1,FIXCN1	;IF INCREASING UFBTAL,
	JUMPL	T4,FIXCN1	; UFBTAL WAS POSITIVE
	SKIPGE	UFBTAL##(T3)	; AND UFBTAL HAS OVERFLOWED
	HRLOS	UFBTAL##(T3)	; MAKE IT HUGELY POSITIVE AGAIN
FIXCN1:	HRRZ	T3,DEVACC##(F)	;UPDATE HIGHEST BLOCK ALLOCATED
	JUMPE	T3,FIXCN3
	MOVNS	T1
	TLNN	S,IOSALC	;LEAVE ACCALC ALONE IF BIT IS ON
	ADDM	T1,ACCALC##(T3)
FIXCN3:	ADD	T2,SABTAL##(P2)
	TRNE	T2,400000	;COUNT GO NEGATIVE?
	MOVEI	T2,0		;YES, SET TO 0
	HRRM	T2,SABTAL##(P2)
	LDB	T3,SAYNDX##	;AND IN SATSPT TABLE
	ADD	T3,UNISPT##(U)
	DPB	T2,[POINT TALSIZ,(T3),TALPOS]
FIXCN2:	MOVSI	T4,SATCHG	;INDICATE THAT THE SAT
	ORM	T4,SABFIR##(P2)	; BLOCK HAS CHANGED
IFE	FTCCIN!FTDAEM!FTOPRERR,<
SETINJ::
>
	POPJ	P,		;AND RETURN
;SUBROUTINE TO FIND THE SAT BUFFER ASSOCIATED WITH A GIVEN DISK ADDRESS
;IT MAY WRITE OUT A CURRENT SAT AND READ IN A NEW ONE
;ENTER WITH P1=LOC OF 1ST SAT BUFFER IN RING, T1 = DESIRED CLUSTER ADDRESS
;EXIT WITH T2=RELATIVE LOC IN SAT TABLE WITHIN SAT BLOCK
;  T3=BIT POSITION  P1=BUFFER LOC
;P3,T1 UNCHANGED, P1,P2, P4 CHANGED
FNSAT:	HRRZ	T2,UNICPS##(U)	;NUMBER OF CLUSTERS/SAT TABLE
	MOVE	P2,P1		;USE P2 FOR END TEST

;TRY TO FIND A SAT IN CORE FOR THIS CLUSTER ADDRESS
FNSA1:	LDB	T3,[POINT CLASIZ,SABFIR##(P1),CLAPOS]	;FIRST DISK ADDRESS IN SAT BUFFER
	CAMGE	T1,T3		;IN THIS SAT?
	JRST	FNSA2		;NO
	ADD	T3,T2		;MAYBE, CHECK IF OVER TOP
	CAMGE	T1,T3		;THIS THE ONE?
	JRST	FNSA4		;YES, COMPUTE POSITION
FNSA2:	HLRZ	P1,SABRNG##(P1)	;STEP TO NEXT SAT BUFFER
	CAME	P1,P2		;THROUGH?
	JRST	FNSA1		;NO. TEST IT

;HERE WHEN THE DESIRED SAT IS NOT IN CORE. READ IT FROM DISK
	PUSH	P,T1		;SAVE CLUSTER ADDRESS
	IDIV	T1,T2		;COMPUTE INDEX TO SATPFI TABLE
	MOVE	P4,T1		;STUFF IT IN P4
	PUSHJ	P,NEWSAT	;WRITE THE CURRENT SAT, READ IN NEW
	POP	P,T1		;RESTORE CLUSTER ADDRESS


;HERE WHEN DESIRED SAT IS IN CORE
;T1=CLUSTER ADDRESS,  P1 = LOC OF BUFFER
FNSA4:	LDB	T2,[POINT CLASIZ,SABFIR##(P1),CLAPOS]	;1ST ADDRESS OF SAT
	SUBM	T1,T2		;-DESIRED ADDRESS
	IDIVI	T2,^D36		;COMPUTE WORD COUNT, SHIFT NUMBER
	POPJ	P,
;SUBROUTINE TO ENTER REQUEST IN DISK-ALLOCATION QUEUE
;ALL ACS RESPECTED
;CALL SUPDA IF MIGHT ALREADY HAVE DA

SUPDA::	TLNN	S,IOSDA		;DONT GET DA IF ALREADY HAVE IT
UPDA::	PUSHJ	P,DAWAIT##	;HAVE TO WAIT
	TLO	S,IOSDA		;HAVE DA QUEUE,LIGHT BIT
	PJRST	STRIOS		;SAVE S AND RETURN

;SUBROUTINE TO UNQUEUE DA REQUEST
;ALL ACS RESPECTED

SDWNDA::
IFN FTDSIM,<
;SUBROUTINE TO GIVE UP DA EXCEPT FOR A SIM UPDATE FILE
;ALL ACS RESPECTED
	PUSH	P,T1		;SAVE AN AC
	HRRZ	T1,DEVACC##(F)	;A.T. LOC
	JUMPE	T1,SDWND1	;JUMP IF NO A.T. (SUPER I/O OR THE REFRESHER)
	MOVE	T1,ACCSMU##(T1)
	TRNE	T1,ACPSMU	;SIM UPDATE?
	JRST	TPOPJ##		;YES, DONT GIVE UP DA
SDWND1:	POP	P,T1		;NO, GIVE UP DA RESOURCE
>
DWNDA::	TLZN	S,IOSDA		;CLEAR THE BIT
	STOPCD	CPOPJ,DEBUG,DHD,;++ DON'T HAVE DA
	PUSHJ	P,DAFREE##	;DECREMENT REQUEST COUNT
	PJRST	STRIOS		;STORE S IN DDB AND RETURN
;SUBROUTINE TO GET THE AU RESOURCE
;ALL ACS RESPECTED
UPAU::
	PUSHJ	P,AUWAIT##	;WAIT A WHILE
	TLO	S,IOSAU		;HAVE IT NOW
	PJRST	STOIOS##	;RETURN

;SUBROUTINE TO RELEASE AU RESOURCE
;ALL ACS RESPECTED
DWNAU::	TLZN	S,IOSAU		;CLEAR THE BIT
	STOPCD	CPOPJ,DEBUG,DHA,;++DON'T HAVE AU
	PUSHJ	P,AUFREE##	;DECREMENT COUNT
	PJRST	STOIOS##	;SAVE S AND RETURN
;SUBROUTINE TO FIND A PARTICULAR SAT IN THE
;SAT-BUFFER RING.  IF NOT FOUND, READ IT IN
;ENTER WITH P2 = LOC OF SAT BUFFER, P4 = INDEX OF SAT ADDRESS TABLE TO READ
;P2 ON EXIT CONTAINS THE BUFFER LOC. LH(P2) UNCHANGED.
SATST:	HRRZ	T2,P2		;LOC OF BUFFER (FOR END TEST)
SATS2:	LDB	T3,SAYNDX##	;INDEX OF THIS SAT
	CAIN	T3,(P4)		;RIGHT ONE?
	POPJ	P,		;YES. RETURN
	HLR	P2,SABRNG##(P2)	;NO. STEP TO NEXT
	CAIE	T2,(P2)		;THROUGH?
	JRST	SATS2		;NO. TEST THIS BUFFER
				;YES. READ THE SAT

;SUBROUTINE TO (POSSIBLY) WRITE THIS SAT, READ IN NEW ONE
;ENTER WITH P2 = LOC OF SAT BUFFER, P4 = INDEX OF SAT ADDRESS TABLE TO READ
NEWSAT:	SKIPG	SABFIR##(P2)	;CURRENT SAT BEEN CHANGED?
	PUSHJ	P,SATWRT	;YES. WRITE IT OUT
				;READ NEW SAT
;SUBROUTINE TO READ A NEW SAT BLOCK INTO CORE
;THE SAT DISK ADDRESS IS SPECIFIED BY P4 (INDEX INTO ADDRESS TABLE)
;P2 POINTS TO THE IN-CORE BUFFER
SATRED::DPB	P4,SAYNDX##	;SAVE INDEX TO SATPFI IN MON BUFFER
	MOVE	T4,P4		;INDEX TO SATSPT INTO T4
	PUSHJ	P,SATADR	;SET UP PARAMETERS TO READ
	HRRM	T3,SABTAL##(P2)	;SAVE FREE SPACE FOR THIS SAT
	PUSH	P,DEVUNI##(F)	;SAVE DEVUNI
	MOVEM	U,DEVUNI##(F)	;UNIT WE'RE TALKING TO
	PUSHJ	P,MONRED	;READ THE SAT
	POP	P,DEVUNI##(F)	;RESTORE DEVUNI
	LDB	T4,SAYNDX##	;RESET INDEX
	HRRZ	T1,UNICPS##(U)	;NO. OF CLUSTERS PER SAT
	IMUL	T1,T4		;TIMES INDEX = FIRST ADDR OF SAT
	DPB	T1,[POINT CLASIZ,SABFIR##(P2),CLAPOS]	;SAVE IN BUFFER
	MOVEI	T1,SABBIT##(P2)	;START SCAN AT 1ST LOC OF TABLE
	HRRM	T1,SABSCN##(P2)	;SAVE IN SCAN LOC
	SETOM	SABHOL##(P2)	;DONT KNOW SIZE OF LARGEST HOLE
	SKIPE	DINITF##	;IF IN ONCE-ONLY
	PJRST	SATW2		;DONT CHECK FOR CONSISTENCY
	HLL	T1,SABRNG##(P2)	;STEP TO NEXT SAB IN RING
	HLLM	T1,UNISAB##(U)	;THIS WILL BE NEXT TO BE READ INTO
	MOVE	T1,SABSCN##(P2)	;AOBJN WORD FOR SAT BITS
	JUMPN	T3,SATBAD	;CHECK FOR ERRORS DETECTED IN MONRED
	PUSHJ	P,SATCN		;COUNT 0'S IN SAT
	HRRZ	T1,SABTAL##(P2)	;DONE. # OF 0'S WE EXPECT
	CAIN	T1,(T2)		;RIGHT?
	PJRST	SATW2		;YES. ZERO SATCHG AND RETURN
SATBAD:	MOVSI	T2,UNPSER##	;NO. COUNT NO OF SOFTWARE ERRS
	ADDM	T2,UNIMCT##(U)	; UP BY ONE IN UNIT DB
	MOVNS	T1		;DECREASE UNIT AND STR TALLIES
	ADDM	T1,UNITAL##(U)	;BY THE AMOUNT WE EXPECTED
	HRRZ	T3,UNISTR##(U)
	ADDM	T1,STRTAL##(T3)
	SETZ	T1,		;T1=0
	ADD	T4,UNISPT##(U)	;POINT TO RIGHT SPT WORD
	DPB	T1,[POINT TALSIZ,(T4),TALPOS]	;SET COUNT IN THIS SAT TO 0
	HRRM	T1,SABTAL##(P2)	;SET SABTAL FOR THIS SAT TO 0
	MOVE	T1,SABSCN##(P2)	;SET ALL BITS IN THE SAT TO 1
	SETOM	(T1)
	AOBJN	T1,.-1
	PJRST	SATW2		;ZERO SATCHG (SO SAT WONT BE WRITTEN) AND EXIT
;ROUTINE TO COUNT 0 BITS IN A TABLE
;ARGS: T1=AOBJN POINTER TO TABLE
;VALUES: T2=NO. OF 0-BITS IN TABLE
;RESPECTS T4
SATCN::	SETZ	T2,		;T2 WILL COUNT 0'S FOUND
	PUSH	P,T4
SATR1:	MOVE	T3,(T1)		;COUNT 0-BITS IN 0(T1)
	SETCMB	T4,T3		;ITS EASIER TO COUNT 1'S
	LSH	T4,-1
	AND	T4,[333333,,333333]
	SUB	T3,T4
	LSH	T4,-1
	AND	T4,[333333,,333333]
	SUBB	T3,T4		;EACH OCTAL DIGIT REPLACED BY NUMBER OF 1S IN IT
	LSH	T4,-3
	ADD	T3,T4
	AND	T3,[070707,,070707]
	IDIVI	T3,77		;CASTING OUT 63'S
	ADDI	T2,(T4)		;ACCUMULATE ANSWER IN T2
	AOBJN	T1,SATR1	;COUNT BITS IN NEXT WORD
	PJRST	T4POPJ##	;DONE, ANSWER IN T2
;SUBROUTINE TO WRITE OUT A SAT BLOCK
;THE BUFFER IS SPECIFIED BY P2
SATWRT::TLNE	S,IOSDA		;JOB HAVE DA RESOURCE?
	JRST	SATW1		;YES
	PUSHJ	P,UPDA		;NO, GET IT  (PROBABLY COMING FROM WTUSAT)
	PUSHJ	P,SATW1		;WRITE THE SAT
	PJRST	DWNDA		;GIVE UP DA AND RETURN
SATW1:	LDB	T4,SAYNDX##	;INDEX TO SATPFI
	PUSHJ	P,SATADR	;SET PARAMETERS FOR WRITE
	PUSH	P,DEVUNI##(F)
	MOVEM	U,DEVUNI##(F)	;UNIT WE'RE TALKING TO
	PUSHJ	P,MONWRT	;WRITE THE SAT
	POP	P,DEVUNI##(F)
SATW2:	MOVSI	T1,SATCHG	;ZERO SAT-CHANGED BIT
	ANDCAM	T1,SABFIR##(P2)
	POPJ	P,		;AND RETURN


;SUBROUTINE TO SET UP PARAMETERS FOR A SAT-BLOCK READ OR WRITE
;ENTER WITH T4=INDEX TO SATSPT TABLE P2=BUFFER ADDRESS
;EXIT WITH T1=IOWD FOR THE SAT  T2= DISK ADDRESS T3=NO. OF FREE CLUSTERS
SATADR:	ADD	T4,UNISPT##(U)	;COMPUTE ADDRESS OF SATSPT ENTRY
	LDB	T2,[POINT CLASIZ,(T4),CLAPOS]	;GET DISK ADDRESS
	LDB	T3,UNYBPC##	;NO OF BLOCKS PER CLUSTER
	IMUL	T2,T3		;CONVERT CLUSTER ADR TO BLOCK ADR
	LDB	T3,[POINT TALSIZ,(T4),TALPOS]	;GET FREE COUNT
	MOVEI	T1,SABBIT##-1(P2)	;ADDRESS FOR IOWD
	HLL	T1,SABSCN##(P2)	;LENGTH OF DATA
	POPJ	P,		;RETURN


;SUBROUTINE TO CHECK FOR VIRGIN SAB RING (NEWLY MOUNTED F/S)
;   IF NEW RING (CLUST. ADR.=-1), READ SATS FROM DISK INTO ALL SABS
;CALL WITH P1=1ST SAB ADR
CHKNEW:	LDB	T1,[POINT CLASIZ,SABFIR##(P1),CLAPOS]	;CLUSTER ADDR.
	CAME	T1,[EXP CLAMAX]	;-1?
	POPJ	P,		;NO. OK
	PUSHJ	P,SAVE4##	;YES-THIS IS NEW F/S, NEED TO GET SATS
	SETZM	P4		;P4=1ST INDEX (SABNDX)
	MOVE	P2,P1		;P2=1ST SAB ADDR
CHKNE2:	PUSHJ	P,SATRED	;READ THE SAT
	HLRZ	P2,SABRNG##(P2)	;STEP TO NEXT SAB
	CAIE	P2,(P1)		;BACK WHERE WE STARTED?
	AOJA	P4,CHKNE2	;NO - BUMP INDEX AND READ NEXT SAT
	POPJ	P,		;YES - FINISHED
;SUBROUTINE TO CHECK THE AMOUNT OF SPACE A USER WANTS TO ALLOCATE AGAINST HIS QUOTA
;ALSO CHECKS TO SEE THAT THERE IS SPACE ON THE STR
;ENTER WITH T2= AMOUNT TO ALLOCATE, LH(T2)=-1 IF FROM OUTPUT
;EXIT WITH T2 = AMOUNT ALLOWED (MAY BE 0)
;IF 0 IOBKTL HAS BEEN SET IN S, DEVIOS
CHKQTA::PUSH	P,T2		;SAVE AMOUNT TO ALLOCATE
	TLZ	T2,400000	;MAKE SURE ITS POSITIVE
	MOVE	T4,DEVUFB##(F)	;CHECK AGAINST QUOTA
	MOVE	T3,UNISTR##(U)
	SKIPG	STRTAL##(T3)	;ROOM ON STR?
	JRST	CHKQT1		;NO, COMPLAIN TO USER
IFE FTDQTA,<		;IF NO QUOTAS,
	PJRST	TPOPJ##		;OK RETURN IF STR NOT FULL
>
IFN FTDQTA,<
	MOVE	T1,UFBTAL##(T4)
	TLNN	F,OCLOSB	;DOING A CLOSE?
	CAMG	T2,T1		; OR BELOW QUOTA?
	PJRST	TPOPJ##		;YES. OK
	SUB	T1,STROVR##(T3)	;CHECK MAX OVERDRAW ALLOWED IN STR
	CAML	T2,T1		;TAKE LESSER OF KOYGRP, AMOUNT LEFT
	SKIPLE	T2,T1		;IF 0 OVERDRAW USED UP
	JRST	CHKQT2		;CHECK IF QUOTA JUST GOING NEGATIVE
;HERE IF QUOTA IS NOW EXHAUSTED OR STR IS FULL
CHKQT1:	MOVEI	T4,.ERFUL
	PUSHJ	P,SETINJ	;IS USER INTERCEPTING DISK FULL?
	  SKIPA			;NO, STOP JOB
	JRST	CHKQ1B		;YES, LIGHT AN ERROR BIT AND RETURN
>;END FTDQTA
IFE FTDQTA,<
CHKQT1:
>
	MOVE	T1,JOB##
	MOVE	T1,JBTSTS##(T1)	;DOES JOB WANT TO STOP ON FULL?
	TRNE	T1,JS.SFL
	PUSHJ	P,SAVSTS	;YES, SAVE A RECORD OF RESOURCES JOB OWNS
	  JRST	CHKQ1B		;OWNS MON BUF - LOSE
	SKIPGE	-1(P)		;IF CAME FROM OUTPUT,
	SOS	DEVRET##(F)
	PUSH	P,S
	TRO	S,DR
	PUSHJ	P,DSKFUL	;COMPLAIN TO USER, STOP JOB
	POP	P,S
	MOVEM	S,DEVIOS(F)
	POP	P,T3		;CONTINUED - RECORD OF RESOURCES
	PUSHJ	P,RESSTS	;GET BACK RESOURCES
	POP	P,T2		;RESTORE AMOUNT TO GET
	JUMPGE	T2,CHKQTA
	AOS	DEVRET##(F)
	JRST	CHKQTA		;AND TEST AGAIN


;HERE FOR ERROR RETURN
CHKQ1B:	POP	P,(P)		;REMOVE AMOUNT TO GET FROM LIST
	SETZ	T2,		;INDICATE CANT GET ANY BLOCKS
	PJRST	ERRFUL		;LIGHT BIT AND RETURN
IFN FTDQTA,<
;HERE WHEN QUOTA IS NEGATIVE OR ABOUT TO GO NEGATIVE.
;IF QUOTA IS GT 0 TYPE A WARNING MESSAGE TO USER
CHKQT2:	SKIPGE	UFBTAL##(T4)	;QUOTA ALREADY NEG?
	PJRST	TPOPJ##		;YES. MESSAGE ALREADY TYPED

	HRRM	T2,(P)		;SAVE REDUCED AMOUNT
	MOVEI	T4,.ERQEX	;QUOT1 - EXHAUSTED ERROR
	PUSHJ	P,SETINJ	;SET INTERCEPT IF HE WANTS IT
	  SKIPA			;NO ENABLED - TYPE MESSAGE
	JRST	CHKQT4		;INTERCEPTING - SKIP MESSAGE
	PUSH	P,S		;SAVE ACS WHICH SCNSER WILL USE
	PUSH	P,U
	PUSH	P,J
	PUSH	P,F
	MOVEI	U,0
	PUSHJ	P,TTYFNU##	;FIND TTY FOR CURRENT JOB; SET U,J,F
	JUMPE	U,CHKQT3
	PUSHJ	P,INLMES##
	ASCIZ	/
[EXCEEDING QUOTA ON /
IFN FTSTR,<
	MOVE	T2,(P)		;DDB
	MOVE	T2,DEVACC##(T2)	;AT
	LDB	T1,ACYFSN##	;FSN
	MOVE	T1,TABSTR##(T1)	;STR DATA BLOCK LOC
>	;END CONDITIONAL ON FTSTR
IFE FTSTR,<
	MOVE	T1,TABSTR##	;ADDT OF STR DATE BLOCK
>
	MOVE	T2,STRNAM##(T1)	;STR NAME
	PUSHJ	P,PRNAME##	;TYPE IT
	PUSHJ	P,INLMES##
	ASCIZ	/]
/
	PUSHJ	P,TTYSTR##	;START TTY TYPING (LEAVE JOB RUNNING, IN USER MODE)
CHKQT3:	POP	P,F		;RESTORE ACS
	POP	P,J
	POP	P,U
	POP	P,S
CHKQT4:	HRRZ	T2,(P)
	PJRST	TPOPJ##		;RETURN TO CALLER
>	;END CONDITIONAL ON FTDQTA
;SUBROUTINE TO STOP JOB ON DISK FULL OR QUOTA EXHAUSTED
;TYPES "?DISK FULL OR QUOTA EXHAUSTED FOR XXX "
;CONTINUE RETRIES
DSKFUL::MOVEM	S,DEVIOS(F)	;SAVE S FROM SCNSER
	PUSH	P,F		;SAVE F
	PUSHJ	P,TTYFUW##	;FIND USERS TTY
	PUSHJ	P,TSETBI##	;CLEAR TYPE-AHEAD
	PUSHJ	P,PRQM##	;"?"
	PUSHJ	P,INLMES##	;AND THE MESSAGE....
IFN	FTDQTA,<
	ASCIZ	/QUOTA OR STORAGE EXHAUSTED ON /
>
IFE FTDQTA,<
	ASCIZ	/STORAGE EXHAUSTED ON /
>
	MOVE	T1,(P)		;GET F
	MOVE	T1,DEVUNI##(T1) ;UNIT
	MOVE	T1,UNISTR##(T1) ;STR NAME
	MOVE	T2,STRNAM##(T1) ;TELL USER THE NAME
	PUSHJ	P,PRNAME##	;START TYPING
	PUSHJ	P,HOLD0##
	POP	P,F		;RESTORE F
	PJRST	WSCHED##	;AND RESCHEDULE
;SUBROUTINE TO SEE IF THE CURRENT POINTER CAN BE UPDATED
;ENTER WITH T2=NUMBER OF BLOCKS DESIRED
;DEVRET(F) POINTING TO CURRENT RETRIEVAL POINTER
;EXIT WITH T2= LESSER OF ORIGINAL VALUE, AMOUNT LEFT IN CURRENT POINTER
;T1= ORIGINAL T2   IF T2=0 THE CURRENT POINTER IS FULL
CHKADD::
IFN FTDSIM,<
	MOVE	T1,DEVACC##(F)	;IF A SIM UPDATE FILE WITH MORE THAN 1 WRITER,
	LDB	T3,ACYWCT##	; IF A PNTR IS ADDED TO AND THE ADDING DDB CLOSES FIRST,
	SOJG	T3,CHKAD0	; THE NEW PNTR WILL BE OVERWRITTEN, SO
				; DONT ALLOW ADDING TO PNTRS IF GTR THAN 1 WRITER
>
	MOVEM	T2,T1		;DESIRED AMOUNT
	MOVE	T2,@DEVRET##(F)	;CURRENT POINTER
	MOVE	T4,UNISTR##(U)	;STR ADR
	LDB	T3,STYCNP##(T4)	;NO OF CLUSTERS IN CURRENT POINTER
	LDB	T2,STYCLP##(T4)	;ADR OF 1ST CLUSTER
	ADD	T2,T3		;HIGHEST ADR(+1) IN PNTR
	HRRZ	T3,UNICPS##(U)	;NO OF CLUSTERS IN A SAT
	IDIV	T2,T3		;LAST CLUSTER IN PNTR=LAST IN SAT?
	JUMPE	T3,CHKAD1	;YES, CANT ADD TO CURRENT PNTR
				;(ELSE PROBLEMS IN DELETING BLOCKS)
	SETO	T2,		;NO
	MOVE	T3,UNISTR##(U)	;STRUCTURE DB LOC
	LDB	T4,STYCNP##(T3)	;LARGEST LLOWED FIELD
	MOVE	T2,@DEVRET##(F)	;CURRENT POINTER
	LDB	T2,STYCNP##(T3)	;CURRENT GROUP SIZE
	SUBM	T4,T2		;MAX ADDITIONAL CLUSTERS
	CAMLE	T2,T1		;SKIP IF REQUESTED TOO MUCH
	MOVE	T2,T1		;CAN HAVE ALL WE REQUESTED
	POPJ	P,		;RETURN

;HERE IF BLOCK IS FIRST IN NEW SAT
IFN FTDSIM,<
CHKAD0:	MOVE	T1,T2		;ORIGINAL T2 INTO T1
>
CHKAD1:	SETZ	T2,		;RETURN CANT ADD
	POPJ	P,
IFN FTDHIA&FTATTACH,<
ATTCOD==0
DETCOD==1
XCHCOD==2
;HERE TO SWITCH TWO UNITS BUT LEAVE THE DATA BASE ALONE -
;EG TO PUT DSKB2 ON DPA5 WHEN DPA2 GOES DOWN, LEAVE SATS, ETC THE SAME
XCHDSK::PUSHJ	P,SAVE3##	;SAVE SOME ACS
	PUSHJ	P,COMUNI	;SET UP U FOR FIRST UNIT
	  POPJ	P,		;NO UNIT OR LOGICAL-UNIT MATCH
	MOVE	P1,U		;SAVE FIRST UNIT
	LDB	P3,UNYPUN##	;GET ITS NUMBER
	POP	P,U		;RESTORE U FOR COMCON
	PUSHJ	P,COMUNI	;GET SECOND UNIT
	  POPJ	P,		;NONE OR LOGICAL MATCH
	LDB	P2,UNYPUN##	;NUMBER OF SECOND UNIT
	HRRZ	T1,UNIKON##(U)	;KONTROLLER
	HRRZ	T2,UNIKON##(P1)
	CAIE	T1,(T2)		;UNITS ON SAME KONTROLLER?
	JRST	UPOPJ##		;NO, CANT EXCHANGE THEM
	MOVE	T1,UNIBPU##(U)	;IF UNIBPU DOESNT MATCH,
	CAME	T1,UNIBPU##(P1)
	JRST	UPOPJ##		; THEN DIFFERENT TYPE UNITS, CANT EXCHANGE THEM
	DSKOFF		;CANT ALLOW DISK INTERRUPTS WHILE FIDDLING
	SKIPE	T1,UNISTS##(U)	;UNIT IDLE
	CAIL	T1,OWCOD##	; OR IN SOME OPR WAIT STATE?
	SKIPA	T1,UNISTS##(P1)	;YES, 1ST UNIT IS OK
	JRST	XCHUN2		;NO, CANT EXCHANGE
	CAIGE	T1,OWCOD##	;2ND UNIT IDLE OR IN OPR WAIT?
	JUMPN	T1,XCHUN2	;CANT EXCHANGE IF NOT
	MOVEI	T1,O2COD##	;IF UNITS ARENT IN OPR WAK
	SKIPN	UNISTS##(U)	; PUT THEM THERE, ELSE A
	MOVEM	T1,UNISTS##(U)	; WRONG PACK COULD BE WRITTEN
	SKIPN	UNISTS##(P1)
	MOVEM	T1,UNISTS##(P1)
	DPB	P3,UNYPUN##	;OK - EXCHANGE THE UNITS
	MOVEM	U,@KONPTR##(T2)	;MAKE INTERRUPTS FOR 1 UNIT POINT
	EXCH	P1,U		; AT THE OTHER UDB,
	DPB	P2,UNYPUN##	;MAKE THE UDB POINT AT DIFFERENT 
	EXCH	P2,P3		; PHYSICAL UNITS,
	MOVEM	U,@KONPTR##(T2)
	MOVE	T1,UNINAM##(U)	;CHANGE PHYSICAL NAMES IN THE UDBS
	EXCH	T1,UNINAM##(P1)
	MOVEM	T1,UNINAM##(U)
IFN FTDUAL,<
	MOVE	T1,UNI2ND##(U)	;GET ALTERNATE UNITS
	MOVE	T2,UNI2ND##(P1)
	MOVEM	T2,UNI2ND##(U)	;EXCHANGE THEM
	MOVEM	T1,UNI2ND##(P1)
	HRRM	U,UNI2ND##(T2)	;EXCHANGE THE BACKWARDS POINTERS
	HRRM	P1,UNI2ND##(T1)
>

;STILL IN FTDHIA&FTATTACH CONDITIONAL
	MOVEI	T1,UNIHCT##(U)	;MAKE THE ERROR STATE
	MOVEI	T2,UNIHCT##(P1)	; STAY WITH THE DRIVE
	HRLI	T1,-3		; EXCHANGE UNIHCT,SCT,MCT
XCHUN1:	MOVE	T3,(T1)
	EXCH	T3,(T2)
	MOVEM	T3,(T1)
	ADDI	T2,1
	AOBJN	T1,XCHUN1
	AOS	-1(P)		;INDICATE WE WON
XCHUN2:	DSKON			;ALLOW DISK INTERRUPTS AGAIN
	MOVE	F,P1		;GET 1ST UDB INTO F
	HRLZI	T1,XCHCOD	;CODE FOR XCH
	PUSHJ	P,DSKCSC	;CALL DAEMON
	JRST	UPOPJ##		;RESTORE U AND RETURN TO COMCON

;HERE TO TAKE A UNIT OFF-LINE
;RETURNS CPOPJ IF NOT A DSK
;RETURNS CPOPJ1 IF CANT DETACH
;RETURNS CPOPJ2 IF OK
DETDSK::PUSHJ	P,COMUNT	;SET UP U (COMCON ALREADY HAS U PUSHED)
	  POPJ	P,		;NO UNIT OR LOGICAL MATCH
IFN FTDUAL,<
	JUMPL	U,[MOVEI T1,O2COD## ;IF AN ALTERNATE UNIT
		MOVEM T1,UNISTS##(U) ;JUST MARK SO IT WONT BE USED
		JRST DETDS2]
>
	HRRZ	T1,UNISTR##(U)	;UNIT IN A STR?
	JUMPN	T1,UPOPJ1##	;CANT DETACH IF IT IS
IFN FTDUAL,<
	SKIPG	T1,UNI2ND##(U)	;DOES THIS HAVE AN ALTERNATE PATH?
	JRST	DETDS2		;NO
	HRROS	UNI2ND##(U)
	HRRZS	UNI2ND##(T1)	;YES, SWITCH MAIN AND ALTERNATE UNITS
	MOVE	T2,UNISYS##(U)
	HLLM	T2,UNISYS##(T1)	;UNLINK MAIN UNIT, INSERT ALTERNATE
	HRLM	T1,UNISYS##(T4)
	MOVEI	T2,O2COD##
	MOVEM	T2,UNISTS##(U)	;SET SO THIS UNIT WONT BE USED
DETDS2:>
	MOVEI	T1,UNVDWN##	;OK, INDICATE UNIT IS DOWN
	DPB	T1,UNYUST##
	HRLZI	T1,DETCOD	;CODE TO SAY DETACH
	PUSHJ	P,DSKCSC	;CALL DAEMON
	POP	P,U
	PJRST	CPOPJ2##	;AND RETURN

;STILL IN FTDHIA&FTATTACH CONDITIONAL
;HERE TO ATTACH A UNIT
;RETURNS NON-SKIP IF UNIT IS DOWN
;CPOPJ1 IF WE CANT CALL CPY ROUTINE NOW (TRY LATER)
;CPOPJ2 IF ALL IS OK
ATTDSK::PUSHJ	P,COMUNT	;SET UP U
	  JRST	[TLO U,400000	;NO MATCH
		 POPJ P,]
	LDB	T1,UNYUST##	;GET UNIT STATUS
	CAIE	T1,UNVDWN##	;DOWN?
	JRST	UPOPJ##		;NO, CANT ATTACH IT
	PUSH	P,J		;YES, SAVE J FOR COMCON
	MOVE	J,UNIKON##(U)	;KONTROLLER DATA BLOCK
	MOVSI	T1,KOPDWN##	;CLEAR KONTROL-IS-DOWN BIT
	ANDCAM	T1,KONDWN##(J)
	SKIPGE	KONCPY##(J)	;CAN WE CALL CPY ROUTINE IF KONTROL BUSY?
	SKIPL	KONTAB##(J)	;NO, IS KONTROLLER BUSY?
	TLZA	J,-1		;WE CAN TELL UNIT TYPE NOW
	JRST	ATTUN4		;CANT GET KONTROL - TRY LATER
	PUSHJ	P,@KONCPY##(J)	;DETERMINE UNIT TYPE, CAPACITY
	  JRST	ATTUN5		;UNIT DOWN
	MOVEM	T1,UNIBPU##(U)	;SAVE BLOCKS PER UNIT
	MOVEM	T2,UNIBPM##(U)	;SAVE BLKS PER UNIT INCL. MAINT CYLS
IFN FTRP04,<
	MOVEM	T3,UNIBUC##(U)	;SAVE BLOCKS PER UNIT IN 10/11 COMPAT. MODE
>
	DPB	W,UNYBPY##	;SAVE # BLOCKS PER CYLINDER
	HLRZ	T3,W		;NO OF BLOCKS PER TRACK
	DPB	T3,UNYBPT##	;BLOCKS/TRACK
	DPB	T4,UNYUTP##	;UNIT TYPE
IFN FT22BIT,<
	MOVSI	T1,CP.22B##
	HRRZ	T3,UNICHN##(U)
	TLNE	T4,KOP22B##
	JRST	ATTUN1		;22-BIT CHAN?
	MOVSI	T2,1		;NO, IF MORE THAN 256K,
	CAMGE	T2,MEMSIZ##
	JRST	ATTUN5		; CAN'T USE THE UNIT
	ANDCAM	T1,CHB22B##(T3)	;OK - CLEAR THE BIT IN CDB
	JRST	ATTUN2
ATTUN1:	IORM	T1,CHB22B##(T3)	;22-BIT CHAN - SET THE BIT
>

;STILL IN FTDHIA&FTATTACH CONDITIONAL
ATTUN2:	AOS	-2(P)		;CPOPJ2 IS GOODNESS
	MOVEI	T1,UNVNPM##	;INDICATE NO PACK MOUNTED
	DPB	T1,UNYUST##	; (EG, UNIT IS UP)
	MOVSI	T1,UNPOFL##
	SKIPG	KONPOS##(J)
	ANDCAM	T1,UNIUST##(U)
	SETZM	UNISTS##(U)
IFN FTDUAL,<
	JUMPGE	U,ATTUN3	;GO IF NOT AN ALTERNATE PATH
	SETZM	UNISTS##(U)	;ALTERNATE - MARK IT USABLE
	JRST	ATTUN4		;CALL DAEMON AND EXIT
ATTUN3:	HLRZ	T1,J		;GET SERIAL NUMBER
	HLL	T1,UNISER##(U)	;DRIVE TYPE
	PUSHJ	P,MATUN		;SEARCH FOR A MATCH
	  JRST	ATTUN4		;NO MATCH
	HRROM	T2,UNI2ND##(U)	;MATCH, MAKE THIS AN ALTERNATE
	HRRZM	U,UNI2ND##(T2)	;POINT MAIN UNIT AT THIS ONE
	PUSHJ	P,UNLUN		;UNLINK UNIT FROM SYSUNI CHAIN
>
ATTUN4:	POP	P,J		;RESTORE J
	HRLZI	T1,ATTCOD	;CODE TO SAY ATTACH
	PUSHJ	P,DSKCSC	;CALL DAEMON
	JRST	UPOPJ1##	;RESTORE U AND RETURN

ATTUN5:	MOVEI	T1,UNVDWN##	;UNIT IS STILL DOWN - SET THE BYTE
	DPB	T1,UNYUST##	;IN UNISTS AGAIN
	SOS	-2(P)		;NON-SKIP RETURN
IFN FTDUAL,<
	JRST	ATTUN3
>
IFE FTDUAL,<
	JRST	ATTUN4
>
;ROUTINE TO SET UP U FOR THE COMMAND
;RETURNS WITH ORIGINAL U ON PD LIST
COMUNI:	PUSHJ	P,SETLGL##	;PRIV'D JOB?
	  POPJ	P,		;NO, ERROR RETURN
	PUSHJ	P,CTXDEV##	;YES, GET DEVICE TYPED BY USER
	MOVE	T1,T2		;DEVICE INTO T1 FOR DEVSRC
COMUNT:	EXCH	U,(P)		;SAVE U ON LIST
	PUSH	P,U
	SETO	T2,		;NEED A COMPLETE MATCH ON UNIT NAME
	PUSHJ	P,SRUNI##	;FIND MATCHING UNIT
	  JFCL			;NO SUCH UNIT
	  CAIA			;LOGICAL MATCH
	JRST	CPOPJ1##	;PHYSICAL MATCH - GOOD RETURN
IFN FTDUAL,<
	HLRZ	U,SYSUNI##	;START AT 1ST UNIT
COMUN2:	SKIPLE	T2,UNI2ND##(U)	;IS THERE AN ALTERNATE TO UNIT?
	CAME	T1,UNINAM##(T2);YES, IS IT OUR UNIT?
	JRST	COMUN3		;NO
	HRROI	U,(T2)		;YES, SET LH(U)=-1 AS A FLAG
	JRST	CPOPJ1##	;AND TAKE FOUND-RETURN
COMUN3:	HLRZ	U,UNISYS##(U)	;NO MATCH, TRY NEXT
	JUMPN	U,COMUN2
>
	MOVE	U,(P)		;RESTORE U
	EXCH	U,-1(P)
	JRST	T2POPJ##		;TAKE GARBAGE OFF STACK AND BADNESS-RETURN
;ROUTINE TO PICK UP OPERATOR COMMENTS AND CALL
;DAEMON FOR DISK CONFIGURATION STATUS CHANGE
;CALL WITH CODE FOR ATT, DET, XCH IN T1, F + U SETUP
;CALLED WITH U FOR COMCON ON -1 OF STACK
DSKCSC:	EXCH	U,-1(P)		;GET LDB FOR COMCON
	PUSH	P,T1
	PUSHJ	P,SKIPS1##	;SKIP OVER TO OPR COMMENTS
	  TDZA	T2,T2		;NONE THERE
	PUSHJ	P,CTEXT##	;PICK THEM UP
	POP	P,T1
	EXCH	U,-1(P)		;GET BACK UDB
	ROT	T2,^D12		;GET FIRST TWO CHARS OR RIGHT
	DPB	T2,[POINT 12,T1,11]  ;AND PUT THEM INTO T1
	HRRI	T1,.ERCSC	;GET CODE FOR DAEMON
	PUSH	P,J		;SAVE J
	PUSHJ	P,DAEEIM##	;WAKE DAEMON
	JRST	JPOPJ##		;RETURN
>	;END FTDHIA&FTATTACH


IFN FTDUAL,<
;ROUTINE TO TEST IF MATCHING SERIAL-NUMBERS (EG DUAL-PORTED DRIVES) EXIST
;CALL WITH T1= DRIVE SERIAL NUNBER, U=UNIT
;RETURNS CPOPJ IF NO MATCH
;RETURNS CPOPJ1 IF A MATCH, T2= MATCHING UNIT
;PRESERVES T4
MATUN::	JUMPE	T1,CPOPJ##	;NO MATCH IF NO SERIAL NUMBER
	HLRZ	T2,SYSUNI##	;START AT FIRST UNIT IN SYSTEM
MATUN1:	CAMN	T1,UNISER##(T2) ;MATCH?
	CAIN	T2,(U)		;YES, FOR A DIFFERENT UNIT?
	CAIA			;NO MATCH
	JRST	CPOPJ1##	;FOUND A MATCH, SKIP RETURN
	HLRZ	T2,UNISYS##(T2) ;STEP TO NEXT UNIT
	JUMPN	T2,MATUN1	;AND TEST IT
	POPJ	P,		;NO MATCH, NON-SKIP

;SUBROUTINE TO UNLINK A UNIT FROM UNISYS CHAIN
;ENTER WITH U=UNIT
;PRESERVES T4
UNLUN::	MOVEI	T1,DIFUSY##	;PRESET PREDECESSOR
UNLUN1:	HLRZ	T2,UNISYS##(T1) ;START AT 1ST UNIT
	JUMPE	T2,CPOPJ##	;SYSTEM ERROR?
	CAIN	T2,(U)		;MATCH?
	JRST	UNLUN2		;YES, UNLINK IT
	MOVE	T1,T2		;NO, RESET PREDECESSOR
	JRST	UNLUN1		;AND TRY NEXT UNIT
UNLUN2:	MOVE	T3,UNISYS##(U)	;GET THIS UNIT'S LINK
	HLLM	T3,UNISYS##(T1) ;AND SAVE IT IN PREDECESSOR'S
	POPJ	P,		;AND RETURN
>	;END FTDUAL
	SUBTTL	USETI/USETO
USETI0::
	HRRE	W,M		;BLOCK NUMBER
	CAME	W,[-1]		;BLOCK -1 MEANS END OF FILE, IS IT?
	CAML	W,MUSTMX##	;TRYING TO READ AN EXTENDED RIB?
	CAIA			;YES
	TLZ	W,-1		;NO, CLEAR HIGH BITS FOR COMPATIBILITY.
FUSETI::
IFN FTSPL,<
	SKIPGE	DEVSPL(F)	;IF THIS IS A SPOOLED DDB,
	POPJ	P,		;USETI IS A NO-OP
>
	PUSHJ	P,WAIT1##	;MAKE SURE ALL I/O IS DONE
	TLNN	F,LOOKB		;LOOKUP DONE?
	JRST	SETSUP		;NO. SUPER USETI IF PRIVILEGED
	HRRZ	U,DEVUNI(F)
	JUMPE	U,CPOPJ##	;GO AWAY IF UNIT WAS REMOVED
	PUSHJ	P,CLSNAM##	;SET RIGHT NAME IN DDB FOR RIBCHK
				; (FILE MIGHT BE RENAMED)
	HRRZ	T1,DEVACC##(F)	;YES. LOC OF ACCESS TABLE
	PUSHJ	P,SAVE1##	;SAVE P1
IFN FTDMRB,<			;IF MULTIPLE RIBS
	MOVE	P1,M		;GET USETI ARGUMENT TO P1
	CAMGE	P1,MUSTMX##	;SKIP IF RH(M) POSSIBLE EXTEDNED RIB
	JRST	USETI2		;NOT LOOKING FOR EXTENDED RIBS
	AOJGE	P1,USETI2	;IF -1 OR POSITIVE, NOT EXTENDED
	HRRZ	U,DEVUNI##(F)	;GET CURRENT UNIT
	PUSHJ	P,PTRTST	;READ POINTERS, RE-WRITE IF CHANGED
	  PJRST	GVMNB0		;ERROR READING RIB
	SKIPL	DEVRIB##(F)	;PRIME RIB?
	JRST	USETI1		;YES, GET EXTENDED
	PUSHJ	P,REDRIB	;NO, READ PRIME RIB
	  PJRST	GVMNB0		;ERROR READING RIB
USETI1:	PUSHJ	P,PTRNXT	;GET EXTENDED RIB
	  JRST	USET1B		;EITHER RIB ERROR OR NONE
	AOJN	P1,USETI1	;JUMP BACK IF NOT THIS RIB
	HRRM	T2,DEVUNI(F)	;(NEW) UNIT
	PUSHJ	P,PTRBLT	;GET POINTERS TO DDB
	MOVE	T1,DEVMBF##(F)	;IOWD TO MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T1)	;GET RELATIVE BLOCK NUMBER OF RIB
	MOVE	T3,T2		;ALSO GET TOT3 FOR SCNPTR
	MOVEI	T1,DEVRB1##(F)	;ADDRESS OF IN CORE POINTERS
	HRLI	T1,MPTRLN##	;MAKE AOBJN WORD
	PUSHJ	P,SCNPTR	;SET UP DEVBLK, DEVREL, DEVLFT
	  PJRST	GVMNB0		;THIS IS SO "OUTTA SIGHT" IT SHOULD HALT
	MOVNS	DEVREL##(F)	;FLAG SO OUTPUT NEXT IS ILLEGAL
	PUSHJ	P,GVMNB0	;GIVE UP MONITOR BUFFER
	TLZ	S,IOSFIR	;RIBS AREN'T CHECKSUMMED
	JRST	USETI4		;AND EXIT.
USET1B:	SKIPN	T3		;ERROR READING RIB?
	TRO	S,IOBKTL	;NO, NON-EXISTANT, SET IOBKTL
	PJRST	GVMNB0		;GIVE UP MONITOR BUFFER AND EXIT
>				;END CONDITIONAL ON FTDMRB
USETI2:	MOVE	P1,ACCWRT##(T1)	;HIGHEST RELATIVE BLOCK WITH DATA IN THE FILE
	JUMPL	W,USETI5	;OK UNLESS USETI -1
	CAML	P1,W		;ASKING FOR A BLOCK PAST EOF?
	TLOA	P1,400000	;NO, SET P1 NEGATIVE AS A SWITCH
USETI5:	MOVE	W,P1		;YES, INITIALLY SCAN FOR LAST BLOCK
	PUSHJ	P,USET00	;FIND THE PNTR TO THE BLOCK
	  POPJ	P,		;RIB ERROR
	SKIPL	DEVBLK##(F)
	JRST	USETI3
	MOVEM	W,DEVREL##(F)
	PUSHJ	P,FNDPTR
	  POPJ	P,
USETI3:	JUMPL	P1,USETI4	;GO IF NOT PAST EOF
	AOS	DEVBLK##(F)	;PAST EOF - UPDATE PNTRS IN DDB
	AOS	DEVREL##(F)	;SO NEXT INPUT/OUTPUT WILL GET LAST BLOCK
	SOS	DEVLFT##(F)	; OF FILE PLUS 1
	TLZ	S,IOSFIR
	TDOA	S,[XWD IOEND,IODEND]	;INDICATE USETI PAST EOF
USETI4:	TDZ	S,[XWD IOEND,IODEND]	;OK - ZERO EOF BITS
IFN FTDMRB,<
	PUSHJ	P,EXTCKS	;LIGHT IOSFIR IF 1ST BLOCK IN EXT. RIB
>
	PJRST	STOIOS##	;STORE S AND TAKE GOOD RETURN
USETO0::
	HRRE	W,M		;BLOCK NUMBER
	CAME	W,[-1]		;IF NOT USETO TO LAST BLOCK OF THE FILE
	TLZ	W,-1		; CLEAR HIGH ORDER BITS
FUSETO::
IFN FTSPL,<
	SKIPGE	DEVSPL(F)	;IF THIS IS A SPOOLED DDB,
	POPJ	P,		; USETO IS A NOOP
>
	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO FINISH
	TLNN	F,ENTRB		;ENTER BEEN DONE?
	JRST	SETSUP		;NO. (FIRST) SUPER USETO IF LEGAL
	MOVE	T1,W		;YES, ARGUMENT
	AOJN	T1,USETO7	;USETO -1 MEANS LAST BLOCK XFERRED
	MOVE	T1,DEVREL##(F)	;IS THERE A LAST BLOCK?
	SOJG	T1,USET0A	;YES, DO A USETO TO IT
	MOVE	T1,DEVACC##(F)	;NO, UPDATE FILE?
	HRLZ	T1,ACCSTS##(T1)
	TLNE	T1,ACPUPD
	HLRZ	T1,DEVLRL##(F)	;YES. GET DEVREL BEFORE ENTER
USET0A:	MOVE	W,T1		;DO USETO TO THAT BLOCK
USETO7:
IFN FTDMRB,<
	MOVE	T1,DEVACC##(F)	;LOC OF A.T
	MOVE	T1,ACCWRT##(T1)	;HIGHEST WRITTEN BLOCK
	CAML	T1,W		;TRY TO SETO PAST HIGHEST.
	JRST	USETO6		;NO, OK
	PUSH	P,W		;YES. FIRST FIND HIGHEST
	MOVE	W,T1		;SO THAT LAST RIB WILL BE
	PUSHJ	P,USET00	;READ AND DEYRBC SET RIGHT
	  PJRST	TPOPJ##		;RIB ERROR
	POP	P,W		;RESTORE W
>
	PUSHJ	P,GETALC	;GET ADJUSTED ACCALC
	CAMG	T1,W		;WANT ONE BELOW HIGHEST?
	JRST	USETO1		;NO. HAVE TO ALLOCATE
USETO6:	PUSHJ	P,USET00	;YES. SET UP CORRECT POINTERS
	  POPJ	P,		;RIB ERROR
IFN FTDMRB,<			;IF MULTIPLE RIBS
	AOSE	DEVBLK(F)	;IF DEVBLK=-1, CAN'T FIND BLOCK
	JRST	USETO8		;USETO TO ALLOCATED BLOCKS
IFN FTDSIM,<
	PUSHJ	P,GETALC	;SINCE ANOTHER JOB MAY HAVE ALLOCATED,
	CAMG	T1,W		; AND ACCWRT ISN'T YET TO ITS FINAL VALUE,
	JRST	USETO1		; WE MUST REPEAT THE TEST (DEVRIB NOW POINTS TO LAST RIB)
>

;HERE IF DOING A USETO TO LAST BLOCK IN RIB
	PUSHJ	P,USETO9	;ZERO ALLOCATED, UNWRITTEN BLOCKS
	SUBI	W,1		;POINT W TO LAST "REAL" BLOCK
	PUSHJ	P,USET00	;GET POINTERS INTO CORE (SHOULD ALSO GET HIGHEST)
	 POPJ	P,		;RIB ERROR
	MOVE	T3,DEVLPC##(F)	;GET LAST POINTER IN CORE FLAG
	TLZN	T3,DEPLPC##	;CLEAR IT TO FOOL SCNPTR
	STOPCD	CPOPJ##,DEBUG,DBZ,	;++DEPLPC BIT ZERO
	MOVEM	T3,DEVLPC##(F)	;RETURN TO DDB
	MOVE	T3,W		;GET LAST BLOCK ALLOCATED
	ADDI	T3,1
	MOVE	T2,DEVFLR##(F)	;INITIAL BLOCK IN DDB
	MOVEI	T1,DEVRB1##(F)	;SCAN POINTERS IN DDB
	HRLI	T1,MPTRLN##	;STARTING AT DEVRB1
	PUSHJ	P,SCNPTR	;FIND THE POINTER
	STOPCD	.+1,DEBUG,HIF,	;++HOLE IN FILE
	HRRZM	T1,DEVRET##(F)	;SET DEVRET TO LAST POINTER
	HRROS	DEVRSU##(F)	;SET DEVRSU TO -1
	HLLZS	DEVLFT##(F)	;CLEAR DEVLFT SO NXTBLK WILL NOT FIND
	HRLZI	T1,DEPLPC##	;LIGHT DEPLPC AGAIN
	IORM	T1,DEVLPC##(F)	;IN DDB
	POPJ	P,		;AND EXIT
USETO8:	SOS	DEVBLK##(F)	;RETURN DEVBLK TO PROPER VALUE
	PUSHJ	P,EXTCKS	;SET IOSFIR IF FIRST BLOCK IN EXTENDED RIB
>	;END FTDMRB CONDITIONAL
	MOVEM	S,DEVIOS(F)	;SAVE S
;CHECK TO SEE IF A USETO IS SETTING OUTOUT PAST THE LAST BLOCK WRITTEN
; IF SO, WRITE 0'S IN THE INTERVENING BLOCKS
USETO9:	SKIPN	T1,W		;SETTING BLOCK 0?
	POPJ	P,		;YES. THIS IS NON-ALLOCATING
	SUBI	T1,1		;LAST BLOCK TO ZERO
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	CAMG	T1,ACCWRT##(T2)	;PAST HIGHEST BLOCK WRITTEN?
	POPJ	P,		;NO, OK
	PUSHJ	P,SAVE2##	;YES, SAVE SOME ACS
	HRRZ	P1,DEVACC##(F)	;LOC OF A.T.
	MOVE	P2,T1		;HIGHEST BLOCK TO ZERO
USETZ1:	MOVE	T1,ACCWRT##(P1)	;BLOCK-1 TO ZERO
	AOS	W,T1		;BLOCK WE WANT TO ZERO
	PUSHJ	P,USET00	;SET DEVBLK FOR THIS BLOCK
	  POPJ	P,		;RIB ERROR
	SKIPGE	DEVBLK##(F)	;SEMI-GOOD RETURN!
	POPJ	P,		;SHOUD NEVER HAPPEN, BUT....
	PUSHJ	P,GTMNBF	;GET MON BUF
	MOVSI	T2,1(T1)	;1ST WORD IN MON BUF
	HRRI	T2,2(T1)	;SET TO ZERO MON BUF
	SETZM	1(T1)
	BLT	T2,BLKSIZ##(T1)	;ZERO THE BUFFER
	MOVE	T2,DEVBLK##(F)	;BLOCK TO WRITE
IFN FTDSIM,<
	CAMG	W,ACCWRT##(P1)	;SOMEBODY JUST WRITE THE BLOCK?
	JRST	[PUSHJ P,GVMNB0	;YES, WE'RE DONE
		 JRST  USETZ2]
	MOVSI	T3,DEPUWZ##	;INDICATE USETO WRITING ZEROES
	IORM	T3,DEVUWZ##(F)	; IN CASE ANOTHER DDB IS CURRENTLY
				; WRITING THIS BLOCK, ACCWRT NOT YET  UPDATED
>
	PUSHJ	P,MONWRT	;WRITE A BLOCK OF 0'S
IFN FTDSIM,<
	MOVSI	T3,DEPUWZ##	;USETO NOT NOW WRITING ZEROES
	ANDCAM	T3,DEVUWZ##(F)
	MOVE	T1,DEVREL##(F)	;IF THIS WRITE DIDN'T HAPPEN (REAL WRITER SNUCK IN)
	CAMLE	T1,ACCWRT##(P1)	; THEN DON'T CHANGE ACCWRT
>
	AOS	ACCWRT##(P1)	;BUMP NUMBER OF BLOCKS WRITTEN
	PUSHJ	P,GVMNB0	;RETURN MON BUF (DONT WANT TO MONOPOLIZE IT)
	LDB	J,PJOBN##	;JOB NUMBER
	MOVE	T1,JBTSTS##(J)	;JBTSTS
	TLNN	T1,CNTRLC	;JOB TYPED ^C?
	JRST	USETZ2		;NO
	PUSH	P,F
	PUSHJ	P,STOP1##	;YES, RETURN TO MONITOR MODE
	POP	P,F		;RESTORE ACS WIPED BY STOP,
	MOVE	S,DEVIOS(F)
	PUSHJ	P,WSCHED##	;STOP JOB
				;CONTINUE TYPED
				;FALL INTO USETZ2
USETZ2:	CAMLE	P2,ACCWRT##(P1)	;HAVE WE FINISHED YET?
	JRST	USETZ1		;NO, WRITE NEXT BLOCK
	AOS	W,P2		;YES, SET M FOR BLOCK WE ORIGINALLY WANTED
	PUSHJ	P,USET00	;SET DDB POINTERS
	  POPJ	P,		;RIB ERROR
	MOVEM	S,DEVIOS(F)	;SAVE S (NEW IOSFIR)
	MOVE	T2,DEVACC(F)	;GET LOC OF A.T.
	MOVEI	T1,BLKSIZ##	;GET SIZE OF BLOCK
	DPB	T1,ACYLBS##	;FORCE AS FINAL BLOCK'S WORD COUNT
	POPJ	P,		;THROUGH - RETURN

;SUBROUTINE TO OBTAIN THE HIGHEST BLOCK ALLOCATED
;RETURNS WITH NUMBER IN T1
GETALC::MOVE	T1,DEVACC##(F)	;LOC OF A.T
	MOVE	T1,ACCALC##(T1)	;ACCALC
IFN FTDMRB,<
	LDB	T2,DEYRBC##	;CURRENT RIB NUMBER
	LSH	T2,1		;2 NON-DATA BLOCKS PER RIB
	SUB	T1,T2		;ADJUST ACCALC
>
	POPJ	P,		;AND RETURN
UDSD==100			;USER WANTS TO WRITE FORMAT
UDSX==200			;FILIO WANTS TO WRITE FORMATS
MNTCYL==100000		;ON IF USER WANTS MAINTENANCE CYLS

;HERE ON SUSET. UUO
USUSET::
IFN FTDSUP,<
	MOVE	W,M		;SAVE AC BYTE
	MOVE	M,T1		;SAVE ARGUMENT
	PUSHJ	P,VALUUO	;DSK INITED ON THIS CHAN?
	  PJRST	IOIERR##	;"IO TO UNASSIGNED CHAN"
	TLO	M,400000	;YES, INDICATE SUSET.
	AOS	(P)		;SET FOR SKIP (GOOD) RETURN
	JRST	SETSU0		;AND DO SUPER USETI/O
>

SETSUP:
IFN FTDSUP,<	;IF SUPER USETI/USETO
	JFCL	ILLINS##	;CHANGE TO JRST TO MAKE SUPER USETI/O ILLEGAL
SETSU0:	HRRZ	U,TABST0##	;LOC OF 1ST FS
	HLRZ	U,STRUNI##(U)	;U=LOC OF 1ST UNIT IN 1ST STR
	MOVE	T1,DEVNAM(F)	;NAME USER INITED
	PUSHJ	P,ALIASD##	;IS NAME AN ALIAS FOR "DSK"?
	  JRST	SETIMP##	;YES, GIVE THE USER IO.IMP
	PUSHJ	P,SRSTR##	;NO. AN STR NAME?
	  SKIPA			;NO
	JRST	SETSU1		;YES.
	PUSHJ	P,SRUNI##	;A UNIT NAME?
	  POPJ	P,		;NO - RETURN WITHOUT DOING ANYTHING
	  JFCL
	PUSHJ	P,PRVJB##	;YES. PRIVILEGED?
	  JRST	SETSU7		;NO. ILLEGAL
SETSUX:	SKIPL	T1,M		;BLOCK NOT IN M IF SUSET.
	PUSHJ	P,GETWDU##	;UNIT NAME - GET BLOCK NUMBER
	TLZ	T1,777740
	HRRM	U,DEVUNI##(F)	;SAVE UNIT IN DDB
	SETOM	DEVREL##(F)	;INDICATE UNIT WAS INITED(NOT STR)
	TRNN	S,UDSD		;WRITE FORMAT?
	TRZA	S,UDSX		;NO, CLEAR THE BIT
	TRO	S,UDSX		;YES, INDICATE WRITING FORMATS
	JRST	SETSU2		;AND CONTINUE
SETSU1:	TRZ	S,UDSX		;INDICATE NOT WRITING FORMATS
	PUSHJ	P,PRVJB##	;PRIV'D
	  JRST	SETS3A		;NO. ILLEGAL
	JUMPG	M,SETS1A	;GO IF SUPER USET
	MOVE	T1,M		;GET BLOCK NO
	TLZ	T1,777740	;CLEAR UNWANTED BITS
	CAMN	T1,[37,,-1]	;SUSET. TO LAST BLOCK XFERRED?
	SETO	T1,		;YES, MAKE IT -1
	JRST	SETS1B
SETS1A:	PUSHJ	P,GETWDU##	;GET BLOCK NUMBER
SETS1B:	CAME	T1,[-1]		;USETO TO LAST BLOCK XFERRED?
	JRST	SETS1C		;NO
	HRRZ	U,DEVUNI##(F)	;YES, GET RIGHT UNIT
	SOS	T1,DEVBLK##(F)	;GET BLOCK NUMBER
	JRST	SETSU4		;AND CONTINUE
SETS1C:	PUSHJ	P,ADR2UN##	;SET U TO RIGHT UNIT IN STR FOR THIS BLOCK
	  JRST	SETSU3		;ILLEGAL BLOCK NUMBER - LIGHT IOBKTL
SETSU2:	CAML	T1,UNIBPU##(U)	;HIGHER THAN HIGHEST BLOCK ON UNIT?
	JRST	SETSU6		;YES. LIGHT IOBKTL
	JUMPL	T1,SETSU3
	TLNE	M,MNTCYL	;WANT MAINT CYL?
	JRST	SETSU3		;YES, ERROR (THIS BLOCK NOT IN MAINT CYLS)
	MOVEM	T1,DEVBLK##(F)	;NO, SAVE BLOCK NO IN DDB
SETSU4:	SUB	T1,UNIBPU##(U)	;-DISTANCE TO END OF UNIT
SETSU5:	MOVNS	T1		;NO OF BLOCKS LEFT TO END OF UNIT
	TLNE	T1,-1		;MORE THAN 256 K BLOCKS?
	MOVEI	T1,-1		;YES, MAX TRANSFER IS 256K
	HRRM	T1,DEVLFT##(F)	;SAVE IN DEVLFT
	TLZ	S,IOSFIR	;MAKE SURE IOSFIR=0
	TLOA	S,IOSUPR	;INDICATE SUPER USETI/USETO
>	;END CONDITIONAL ON FTDSUP
ERRFUL:
SETSU3:	TRO	S,IOBKTL	;INDICATE TOO HIGH A BLOCK NUMBER
	PJRST	STOIOS##	;SAVE S AND RETURN


SETS3A:	JUMPGE	M,SETSU3	;GO IF SUPER USETI/O
SETS3B:	SOS	(P)		;SUSET, - NON-SKIP RETURN
	MOVE	M,W		;RESTORE AC (PUUOAC)
	PJRST	RTM1##
;HERE IF BLOCK ABOVE HIGHEST BLOCK ON UNIT
IFN FTDSUP,<
SETSU6:
IFN FTRP04,<
	MOVSI	T2,DEPCPT##	;COMPATABILITY MODE?
	TDNN	T2,DEVCPT##(F)
	JRST	SETSU8		;NO
	CAMLE	T1,UNIBUC##(U)	;YES, IS IT A LEGAL BLOCK?
	JRST	SETSU3		;NO, LIGHT AN ERROR BIT
	MOVEM	T1,DEVBLK##(F)	;YES, SAVE BLOCK NUMBER
	SUB	T1,UNIBUC##(U)	;DISTANCE TO END OF UNIT
	JRST	SETSU5		; AND FINISH UP
SETSU8:>
	CAMG	T1,UNIBPM##(U)	;MAINT CYL?
	SKIPL	DEVREL##(F)	;YES, UNIT (NOT STR) INITED?
	JRST	SETSU3		;NO - IOBKTL
	TLNN	M,MNTCYL	;WANT MAINT CYL (OR SUPER USET)?
	JRST	SETSU3		;NO, ERROR
	MOVEM	T1,DEVBLK##(F)	;YES, SAVE BLOCK
	SUB	T1,UNIBPM##(U)	;DISTANCE TO END OF MAINT CYL
	JRST	SETSU5		;FINISH UP
;HERE IF UNPRIU'S SUSET/USET TO A UNIT
SETSU7:	JUMPGE	M,SETSU3	;ERROR IF SUPER USET
	MOVE	T1,.C0JOB##	;SUSET.
	MOVE	T1,JBTPPN##(T1)	;PPN OF REGISTER
	CAMN	T1,UMDPPN##	;USER-MODE DIAGNOSTICS? [6,6]
	TLNN	M,MNTCYL	;TO MAINT CYL?
	JRST	SETS3B		;NO, ERROR
	JRST	SETSUX		;YES, OK
>	;END FTDSUP
;HERE IF THE REQUESTED BLOCK IS HIGHER THAN THE HIGHEST ALLOCATED
USETO1:	PUSHJ	P,SAVE2##	
	MOVE	P1,W		;SAVE REQUESTED BLOCK
	MOVE	P2,T1		;SAVE 1ST UNALLOCATED BLOCK NUMBER
	SOS	W,T1		;SET RH(M) TO HIGHEST ALLOCATED
	PUSHJ	P,USET00	;GET POINTERS INTO CORE FOR HIGHEST BLOCK
	  POPJ	P,		;RIB ERROR
IFN FTDMRB,<
	SKIPL	DEVBLK(F)	;FIND THE BLOCK?
	JRST	USET1A		;YES
	MOVSI	T1,DEPLPC	;NO, IS IT REALLY THERE?
	TDNN	T1,DEVLPC(F)
	STOPCD	CPOPJ,DEBUG,PLP,;++ PAST LAST POINTER
	HRROS	DEVRSU(F)	;YES, SET DEVRSU TO EXTEND THE RIB
USET1A:
>

	MOVE	T2,P1		;TOP BLOCK TO ALLOCATE
	MOVE	T1,P2		;FIRST BLOCK TO ALLOCATE
	SUB	T2,T1		;TOTAL NUMBER TO ALLOCATE
	ADDI	T2,1
IFN FTDQTA,<
	PUSH	P,T2		;SAVE NUMBER REQUESTED
	PUSHJ	P,CHKQTA	;CAN WE GET THAT MANY?
	JUMPLE	T2,TPOPJ##	;NO. ERROR RETURN (IOBKTL SET)
	CAMGE	T2,(P)		;DID WE GET ALL WE ASKED FOR?
	TRO	S,IOBKTL	;NO, TELL THE USER HE ONLY GOT SOME
>	;END CONDITIONAL ON FTDQTA
IFE FTDQTA,<
	PUSHJ	P,CHKQTA	;CHECK IF STR FULL
>
	MOVEM	P1,DEVREL##(F)	;SAVE REQUESTED BLOCK IN DDB
IFE FTDSIM,<
	MOVEM	T2,P1		;SAVE NUMBER TO GET
>
IFN FTDSIM,<
	MOVEM	T2,P2		;NUMBER TO GET
>
IFN FTDQTA,<
	POP	P,T1		;NUMBER REQUESTED
	SUBM	T2,T1		;MINUS NUMBER ALLOWED
	ADDM	T1,DEVREL##(F)	;ADJUST REQUESTED BLOCK BY NO. OBTAINED
>	;END CONDITIONAL ON FTDQTA
IFN FTDSIM,<
	MOVE	T1,DEVACC##(F)
	MOVE	T1,ACCSMU##(T1)	;SIM UPDATE FILE?
	TRNN	T1,ACPSMU
	JRST	USET1C		;NO, CONTINUE
	PUSHJ	P,GTMB2		;YES, GET MON BUF NOW TO AVOID DEADLY EMBRACE
	PUSHJ	P,UPDA		; (MUST GET MON BUF BEFORE DA, SIM UPDATE NEEDS BOTH)
	PUSHJ	P,GETALC	;GET CURRENT NO OF BLOCKS ALLOCATED
	AOS	W		;HAS IT CHANGED (ANOTHER USETO ALLOCATING)
	CAMN	T1,W
	SOJA	W,USET1C	;NO, WE'RE OK
	MOVE	W,P1		;YES, EXTRICATE OURSELVES
	POP	P,(P)
	POP	P,P2
	POP	P,P1		;MAKE STACK RIGHT
	PUSHJ	P,DWNDA		;GIVE UP RESOURCES
	PUSHJ	P,GVMNB0
	JRST	USETO7		;AND TRY AGAIN
USET1C:	MOVE	P1,P2		;RESTORE NUMBER TO GET
>	;END FTDSIM
	PUSHJ	P,CHKADD	;CAN WE ADD TO CURRENT POINTER?
	JUMPLE	T2,USETO3	;NO. GET SPACE ANYWHERE
	AOSE	T1,DEVBLK##(F)	;YES SET T1= 1ST BLOCK
	PUSHJ	P,TAKBLK	;GET BLOCKS AT PREVIOUS END
	  JRST	USETO3		;CANT GET ANY THERE
	PUSHJ	P,ADDPTR	;GOT SOME - ADD TO CURRENT POINTER
USETO2:	SUB	P1,T1		;DECREMENT AMOUNT TO GET
	JUMPLE	P1,USETO5	;FINISH UP IF GOT ENOUGH
;HERE TO GET BLOCKS ANYWHERE 
USETO3:	AOS	T1,DEVRET##(F)	;POINT DEVRET TO 1ST EMPTY POINTER LOC
	MOVSI	T3,1		;DECREMENT TOTAL NO. OF POINTERS
	ADDB	T3,DEVRSU##(F)	;TOO MANY?
	JUMPGE	T3,USET3B	;YES, TRY TO GET AN EXTENDED RIB
	SETZ	T3,
	CAILE	T1,DEVRBN##(F)	;FILLED THE DDB?
	PUSHJ	P,WRTPTR	;YES. WRITE THE POINTERS
	JUMPN	T3,USETO4	;RETURN WITH IOBKTL IF RIB ERR
	MOVE	T2,P1		;NUMBER TO GET
	MOVEI	T1,0		;ANYWHERE
	PUSHJ	P,TAKBLK	;GET SOME BLOCKS
	  SKIPA			;NOT AVAILABLE ON THIS UNIT
	JRST	USET3A		;GOT THEM
	HLRE	T1,DEVRSU##(F)	;IF 1 SLOT LEFT,
	AOJGE	T1,USET5A	;CANT EXTEND RIB,
	PUSHJ	P,NEXTUN	;STEP TO ANOTHER UNIT IN STR
	  JRST	USET5A		;ALL UNITS FULL - SETTLE FOR WHAT WE GOT SO FAR
USET3A:	MOVEM	T2,@DEVRET##(F)	;SAVE POINTER (OR UNIT-CHANGE) IN DDB
	HRRZ	T3,DEVACC##(F)	;LOC OF A.T.
	MOVEI	T4,ACP1PT##	;ENSURE THAT 1PT IS OFF
	ANDCAM	T4,ACCUN1##(T3)	;SINCE WE JUST GENERATED A NEW POINTER
	TLO	S,IOSFIR	;INDICATE CHECKSUM MUST BE COMPUTED
	JRST	USETO2		;GET MORE BLOCKS IF NEEDED
USET3B:
IFN FTDMRB,<			;IF MULTIPLE RIBS
	MOVN	T1,P1		;GET -NUMBER OF BLOCKS LEFT TO GET
	ADDM	T1,DEVREL##(F)	;SET DEVREL TO END OF RIB FOR EXTRIB
	PUSHJ	P,EXTRIB	;CREATE AN EXTENDED RIB
IFE FTDSIM,<
	  JRST	USETO4		;COULDN'T GET THE RIB, ERROR
>
IFN FTDSIM,<
	  JRST	[PUSHJ	P,USETO4
		 PJRST	DOWNIF]
>
	ADDM	P1,DEVREL##(F)	;RESET DEVREL TO BLOCK TO GET
	ADDI	P1,2		;ACCOUNT FOR REDUNDANT AND EXTENDED RIB
	SUB	P1,T1		;DECREMENT AMOUNT TO GET
	ADDI	P1,2		;ACCOUNT FOR 2 RIBS
	PUSHJ	P,CPYEXT##	;SET UP THE DDB
IFE FTDSIM,<
	  POPJ	P,		;RIB ERROR
>
IFN FTDSIM,<
	  JRST	DOWNIF
>
	JUMPLE	P1,USETO5	;FINISH UP IF GOT ENOUGH
	JRST	USETO3		;NOT ENOUGH, GO GET MORE
>				;END OF CONDITIONAL FTDMRB
USETO4:	PUSHJ	P,ERRFUL	;TOO MANY POINTERS,LIGHT IOBKTL
	MOVNS	P1		;AMOUNT WE WERE UNABLE TO GET
	ADDM	P1,DEVREL##(F)	;ADJUST DEVREL
	POPJ	P,		;AND RETURN TO USER

;HERE IF UNIT OR RIB FULL
USET5A:	PUSHJ	P,USETO4	;LIGHT AN ERROR BIT, ADJUST DEV REL
	SOS	DEVRET##(F)	;ADJUST DEVRET
	MOVSI	T1,-1
	ADDM	T1,DEVRSU##(F)	; AND DEVRSU (INCR'D AT USETO3)


;HERE WHEN ALL BLOCKS HAVE BEEN ALLOCATED
USETO5:	MOVE	W,DEVREL##(F)	;RESET W TO REQUESTED BLOCK
	SKIPLE	P1		;IF COULDN'T GET ALL WE REQUESTED,
	SUB	W,P1		;ADJUST BLOCK NUMBER
	PUSHJ	P,WRTPTR	;WRITE OUT RET POINTERS LEFT IN DDB
	JUMPN	T3,USETO4	;RETURN WITH IOBKTL IF RIB ERR
IFN FTDSIM,<
	PUSHJ	P,DOWNIF	;RETURN DA IF WE OWN IT
	SKIPE	T1,DEVMBF##(F)	;HAVE MON BUF (SIM UPD)?
	PUSHJ	P,GVMNBF	;YES, RETURN IT
>
	PUSH	P,DEVRSU##(F)	;SAVE DEVRSU (USETZ1 MAY CHANGE IT)
	PUSHJ	P,USETO6	;ZERO ALLOCATED, UNWRITTEN BLOCKS
	POP	P,DEVRSU##(F)	;RESTORE DEVRSU
	PJRST	STRIOS		;SAVE S AND EXIT THE UUO

IFN FTDSIM,<
;SUBROUTINE TO GIVE UP THE DA IF WE OWN IT
;ALWAYS RETURNS CPOPJ
DOWNIF::
	TLNE	S,IOSDA		;HAVE DA (SIM UPDATE)?
	PJRST	DWNDA		;YES, RETURN IT
	POPJ	P,
>
;SUBROUTINE TO ADD TO CURRENT POINTER
;ENTER WITH ACS SET AS IN GOOD RETURN FROM TAKBLK-
;T2=CLUSTER POINTER FOR NEW GROUP, T3=ADDRESS OF STRUCTURE DB
;EXIT WITH T1= NUMBER OF NEW BLOCKS GOTTEN
;AND UPDATED POINTER IN @DEVRET AND T2
ADDPTR::PUSH	P,T1		;SAV NO. OF BLOCKS GOTTEN
	LDB	T1,STYCNP##(T3)	;NO. OF CLUSTERS GOTTEN (AT END)
	MOVE	T2,@DEVRET##(F)	;CURRENT POINTER
	LDB	T4,STYCNP##(T3)	;CLUSTER COUNT
	ADD	T4,T1		;PLUS NEW AMOUNT
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	CAME	T2,ACCPT1##(T1)	;IS THIS PNTR THE 1ST?
	SETZ	T1,		;NO. INDICATE BY T1=0
	DPB	T4,STYCNP##(T3)	;SAVE NEW CLUSTER COUNT
	MOVEM	T2,@DEVRET##(F)	;SAVE POINTER
	JUMPE	T1,TPOPJ##	;IS THIS 1ST PNTR?
	MOVEM	T2,ACCPT1##(T1)	;YES. SAVE IT IN A.T.
	JRST	TPOPJ##		;RESTORE T1 AND RETURN


;SUBROUTINE TO STEP TO NEXT UNIT IN FILE STRUCTURE WHICH HAS SPACE LEFT
;IF ALL SPACE IS GONE, RETURN CPOPJ WITH IOBKTL SET
;GOOD RETURN WITH U=DEVUNI= LOC OF NEW UNIT, AND T1=0

;AND A CHANGE-UNIT POINTER STORED IN @DEVRET AND LEFT IN T2
NEXTUN::HRRZ	T1,UNISTR##(U)	;LOC OF STR DB
	HLRZ	T1,STRUNI##(T1)	;LOC OF 1ST UNIT IN STR
	SKIPA			;TEST IF IT HAS ANY SPACE
NEXTU1:	HLRZ	T1,UNISTR##(T1)	;STEP TO NEXT UNIT IN STR
	JUMPE	T1,ERRFUL	;STR IS FULL IF AT END OF UNITS
	SKIPG	UNITAL##(T1)	;NO. UNIT HAVE ANY SPACE?
	JRST	NEXTU1		;NO. TRY NEXT UNIT
	MOVE	U,T1		;YES. SET U
	HRRM	U,DEVUNI##(F)	;AND DEVUNI
	LDB	T2,UNYLUN##	;GET LOGICAL UNIT NUMBER
	TRO	T2,RIPNUB##	;MAKE SURE NON-0
	MOVEM	T2,@DEVRET##(F)	;SAVE IN DDB
	SETZ	T1,		;MAKE SURE T1=0
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN

;SUBROUTINE TO DO THE WORK FOR USETO/USETI
;HALTS IF NO POINTERS TO THE BLOCK
;RETURNS CPOPJ IF THERE IS A RIB ERROR
;SKIP - RETURN IF EVERYTHING IS OK
;ENTER WITH RH(M)=DESIRED BLOCK
;EXIT WITH DEVRET, DEVBLK, DEVLFT, DEVREL SET UP
USET00:	HRRZ	U,DEVUNI##(F)
	JUMPE	U,CPOPJ##	;ERROR IF UNIT WAS YANKED
	HRRZ	U,DEVFUN##(F)	;UNIT FOR 1ST POINTER IN DDB
	HRRM	U,DEVUNI##(F)	;SAVE IN DEVUNI (WILL CHANGE IF UNIT-CHANGE IS READ)
	MOVE	T2,DEVFLR##(F)	;LOWEST REL BLOCK OF POINTERS IN DDB
	MOVE	T3,W		;BLOCK NUMBER TO GET
	CAML	T2,T3		;IS DESIRED BLOCK BELOW THIS FLOOR?
	JRST	USTRIB		;YES. READ IN WHOLE RIB
	MOVEI	T1,DEVRB1##(F)	;NO. SCAN THE POINTERS IN CORE
	HRLI	T1,MPTRLN##	; STARTING AT DEVRB1
	PUSHJ	P,SCNPTR	;TRY TO FIND POINTER TO BLOCK
	  JRST	USTRIB		;NOT THERE - READ WHOLE RIB
				;FOUND IT. DEVBLK,DEVREL,DEVLFT ARE SET UP
	HRRZ	T2,DEVRET##(F)	;CURRENT POINTER LOC
	CAIN	T2,DEVRBN##(F)	;POINTING TO LAST PNTR SLOT?
	SKIPE	DEVRB2##(F)	;YES, IS 2ND PTR 0? (YES IF SET DDB FROM
				;A.T., MORE PNTRS LEFT IN RIB)
	HRRM	T1,DEVRET##(F)	;NO, SET DEVRET TO THIS POINTER
	SUB	T1,T2		;DISTANCE BY WHICH WE CHANGED DEVRET
	HRLZS	T1		;IN LH
	ADDM	T1,DEVRSU##(F)	;UPDATE DEVRSU BY THAT AMOUNT
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN


IFN FTDMRB,<
;SUBROUTINE TO TURN ON IOSFIR FOR FIRST BLOCK IN EXTENDED RIB
EXTCKS:	MOVE	T1,DEVUNI##(F)	;NEWUX WIPES RH (DEVUNI)
	LDB	T2,DEYRBU##	;UNIT OF RIB
	PUSHJ	P,NEWUX
	  JFCL
	EXCH	T1,DEVUNI##(F)	;RESET DEVUNI GET RIB UNIT
	MOVE	T2,DEVRIB##(F)	;POINTER TO (EXTENDED) RIB
	PUSHJ	P,GRPAD		;GET BLOCK NUMBER OF RIB
	ADDI	T2,1		;FIRST BLOCK PAST RIB?
	CAME	T2,DEVBLK##(F)
	POPJ	P,		;NO
	CAMN	T1,DEVUNI##(F)	;YES, RIGHT UNIT?
	TLO	S,IOSFIR	;YES, CHECKSUM TIME
	PJRST	STOIOS##
>
;HERE IF THE POINTERS IN THE DDB DON'T ENCOMPASS THE DESIRED BLOCK
;READ IN THE RIB, AND SCAN IT FROM THE BEGINNING
USTRIB:	PUSHJ	P,PTRTST	;READ POINTERS, REWRITE RIB IF POINTERS HAVE CHANGED
	  JRST	GVMNB0		;ERROR READING RIB
	PUSHJ	P,SAVE1
	SETO	P1,
USTRB5:
IFN FTDMRB,<			;IF MULTIPLE RIBS
	LDB	T2,DEYRBU##	;GET UNIT OF CURRENT RIB
	PUSHJ	P,NEWUX		;SET U
	  STOPCD	GVMNB0,DEBUG,NSU,	;++NO SUCH UNIT
	MOVE	T2,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T2)  ;FIRST WORD OF CURRENT RIB
	SKIPL	DEVRIB##(F)	;IF POSITIVE COULD BE OLD TYPE RIB
>
	MOVEI	T2,0		;WHICH HAS NO RIBFLR WORD
	MOVE	T3,W		;BLOCK NUMBER TO GET
IFN FTDMRB,<			;IF MULTIPLE RIBS
	CAML	T2,T3		;BLOCK BELOW FLOOR OF CURRENT RIB?
	JUMPN	T2,USTRB6	;JUMP IF PRIME RIB
>
	PUSHJ	P,SCNPT0	;SCAN THE CURRENT RIB
IFN FTDMRB,<		;IF MULTIPLE RIBS
	  JRST	USTRB7		;NOT HERE, LOOK IN NEXT RIB
>
IFE FTDMRB,<			;IF NO MULTIPLE RIBS
	  PJRST	GVMNB0
>
	MOVEM	T2,DEVFLR##(F)	;SET LOWEST RELATIVE BLOCK IN DDB
	HRRM	U,DEVFUN##(F)	;SET CORRESPONDING UNIT
	PUSHJ	P,PTRBLT	;BLT POINTERS TO DDB
	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	GVMNB0		;RETURN MONITOR BUFFER AND EXIT

IFN FTDMRB,<			;IF MULTIPLE RIBS
;HERE WHEN WE MUST START LOOKING AT THE PRIME RIB
USTRB6:
	AOJN	P1,GVMNB0
	PUSHJ	P,REDRIB	;READ THE PRIME RIB
	PJRST	GVMNB0		;ERROR READING THE RIB
	PUSHJ	P,SPTRW		;SET UP AOBJN WORD FOR THE RIB
	JRST	USTRB8		;SET UP TO SCAN THE PRIME RIB
>				;END CONDITIONAL ON FTDMRB
;HERE TO GET THE NEXT RIB IN THE CHAIN
IFN FTDMRB,<
USTRB7:	PUSHJ	P,PTRNXT	;GET THE NEXT RIB IN THE CHAIN
				;IF MULTIPLE RIBS
	  JRST	USTRB9		;EITHER ERROR OR COULDN'T FIND THE BLOCK
USTRB8:	MOVE	T3,W		;BLOCK NUMBER TO GET
	JRST	USTRB5		;SCAN THE RIB

;HERE ON NON-SKIP RETURN FROM PTRNXT, EITHER RIB ERROR OR NO NEXT RIB
USTRB9:	PJUMPN	T3,GVMNB0	;RETURN CPOPJ IF RIB ERROR
	PUSHJ	P,GVMNB0	;NO NEXT RIB, GIVE UP THE BUFFER
	SETOM	DEVBLK##(F)	;SET DEVBLK TO -1 AS A FLAG
	PUSHJ	P,DDBZRO##	;ZERO DDB PNTR SPACE SINCE DEYRLC IS WRONG
	JRST	CPOPJ1##	;TAKE A SEMI-GOOD RETURN
>				;END CONDITIONAL ON FTDMRB

;SUBROUTINE TO READ THE POINTERS INTO CORE, COMPARE THE OLD POINTERS IN THE
;RIB WITH THE NEW POINTERS IN THE DDB, AND REWRITE THE RIB IF THEY DIFFER
;SUBROUTINE GETS A MONITOR BUFFER AND RETURNS WITH THE RIB IN IT
;RETURNS WITH T1=AOBJN WORD FOR WHOLE GROUP OF PNTRS IN RIB
;RETURNS CPOPJ IF ERROR READING RIB (STILL WITH MON BUF
;RETURNS CPOPJ1 NORMALLY
PTRTST:
IFN FTDSIM,<
	HRRZ	T1,DEVACC##(F)
	JUMPE	T1,PTRTS0
	MOVE	T1,ACCSTS##(T1)	;SIM UPDATE FILE?
	TRNN	T1,ACPSMU
	JRST	PTRTS0
	PUSHJ	P,GTMNBF	;YES, GET MON BUF
	PUSHJ	P,UPDA		;AND DA TO PREVENT RACE IF WE WRITE RIB
PTRTS0:>
	PUSHJ	P,PTRCUR	;READ THE POINTERS INTO CORE
IFE FTDSIM,<
	JUMPN	T3,CPOPJ##	;RETURN IF ERROR READING RIB
>
IFN FTDSIM,<
	JUMPN	T3,DOWNIF
>
	HLRZ	T3,DEVEXT(F)	;EXTENSION
	LDB	T4,PUUOAC##	;CHAN NUMBER
	MOVE	T4,USRJDA##(T4)	;WAS AN ENTER DONE ON THIS CHAN?
	TLNE	T4,ENTRB+OUTPB	; (IF NOT THIS DDB DIDN'T CHANGE THE PNTRS)
	CAIN	T3,(SIXBIT /UFD/) ;"UFD"?
	JRST	USTRB4		;YES, PNTRS IN THE RIB ARE RIGHT

;HERE WHEN THERE ARE PNTRS IN THE DDB WHICH MAY NOT BE IN THE RIB - CHECK THEM
	MOVE	T3,UNISTR##(U)	;GET ADDRESS OF STRUCTURE DATA BLOCK
	SETO	T2,		;PUT ONE'S IN T2
	LDB	T4,STYCLP##(T3)	;CREATE MASK FOR CLUSTER POINTER
				;PART OF RETRIEVAL POINTER
	LDB	T2,DEYRLC##	;POINTER LOC IN THE RIB
	ADD	T1,T2		;POINT TO 1ST RIB PNTR - CORRESPONDING TO DEVRB1
	MOVEI	T2,DEVRB1##(F)	;POINT T2 TO DDB POINTERS
	HRLI	T2,MPTRLN##	;MAKE T2 AN AOBJN WORD
USTRB1:	SKIPN	T3,(T2)		;GET A PNTR FROM DDB
	JRST	USTRB3		;ALL DONE
	CAMN	T3,(T1)		;SAME AS PNTR IN RIB?
	JRST	USTRB2		;YES
	EXCH	T3,(T1)		;NO. SAVE PNTR IN MON BUF
	JUMPE	T3,USTR1A	;IF OLD PNTR=0, OK
	XOR	T3,(T1)		;XOR RIB WITH MON BUF
	TDNE	T3,T4		;IF PNTR PARTS EQUAL, SKIP
	STOPCD	.+1,DEBUG,PNE,	;++POINTERS NOT EQUAL
				;FALL INTO USTR1A
USTR1A:	TLZ	T1,-1		;ZERO LH(T1) - WAS MRIBLN
USTRB2:	AOBJP	T2,USTRB3	;SKIP IF ALL DDB PNTRS LOOKED AT
	AOJA	T1,USTRB1	;LOOK AT NEXT POINTER

;HERE WHEN ALL POINTERS HAVE BEEN COMPARED, CHANGED PNTRS STORED IN MON BUF
USTRB3:	SKIPL	T1		;T1 NEG IF ALL PNTRS COMPARED
	PUSHJ	P,WRTRIB	;WRITE THE MON BUF AS 1ST RIB
USTRB4:
IFN FTDSIM,<
	PUSHJ	P,DOWNIF	;RETURN DA IF WE OWN IT
>
	PUSHJ	P,SPTRW		;SET T1 AS AN AOBJN WD FOR PNTRS AGAIN
	JRST	CPOPJ1##	;AND TAKE GOOD-RETURN
;SUBROUTINE TO SCAN A BLOCK OF RETRIEVAL POINTERS TO FIND THE GROUP POINTER
;FOR A PARTICULAR BLOCK
;ENTER WITH:
;T1=AOBJN WORD FOR THE SET OF POINTERS
;T2=INITIAL RELATIVE BLOCK OF THE SET OF POINTERS
;T3=DESIRED RELATIVE BLOCK
;ENTER AT SCNPT0 TO SCAN WHOLE RIB (IN MON BUF)
;EXIT WITH:
;T1=ADDRESS OF THE POINTER, LH=-NUMBER OF POINTERS LEFT
;T2=RELATIVE BLOCK NUMBER OF POINTER
;DEVLFT,DEVBLK,DEVREL SET IN THE DDB
;EXIT CPOPJ IF THE POINTER WAS NOT FOUND
;SKIP-RETURN IF THE POINTER WAS FOUND

SCNPT0::PUSHJ	P,SPTRW		;SET T1=AOBJN WORD FOR WHOLE RIB
SCNPTR::PUSHJ	P,SAVE2##		;SAVE P1,P2
	LDB	T4,UNYBPC##	;NUMBER OF BLOCKS PER CLUSTER
	PUSH	P,T3		;SAVE DESIRED BLOCK
	SUB	T3,T2		;T3=RELATIVE BLOCK NUMBER IN SET
	IDIV	T3,T4		;T3=DESIRED CLUSTER
	MOVE	T2,UNISTR##(U)	;LOC OF FILE STRUCTURE DB
	HLLZ	P1,STYCNP##(T2)	;SET UP POS, SIZE  OF POINTER COUNT FIELD
	TLO	P1,T1		;POINTER TO CLUSTER COUNT
	SETZ	P2,		;CLEAR REGISTER TO ACCUMULATE BLOCK COUNT

SCNPT1:	LDB	T2,P1		;GET NUMBER OF CLUSTERS IN THIS POINTER
	JUMPN	T2,SCNPT2	;REAL POINTER IF NON-0
	SKIPN	T2,(T1)		;UNIT CHANGE OR END OF POINTERS
	PJRST	TPOPJ##		;END OF POINTERS. ERROR RETURN
	TRZ	T2,RIPNUB##	;REMOVE BIT 18 (REST IS A LOGICAL UNIT NUMBER)
	PUSHJ	P,NEWUNI	;SET UP U, DEVUNI(F)
	  JRST	TPOPJ##		;INVALID UNIT -NOT FOUND RETURN
SCNPT3:	AOBJN	T1,SCNPT1	;GO BACK TO TEST NEXT POINTER
	JRST	TPOPJ##		;RAN OUT OF POINTERS, ERROR RETURN
;HERE WHEN A REAL POINTER HAS BEEN FOUND
SCNPT2:	ADD	P2,T2		;PLUS LENGTH OF GROUP
	CAML	T3,P2		;IS DESIRED CLUSTER IN THIS POINTER?
	JRST	SCNPT3		;NO, STEP TO NEXT
	LDB	P1,UNYBPC##	;YES. NUMBER OF BLOCKS PER CLUSTER
	SUB	P2,T2		;SET P2 BACK TO BEGINNING OF GROUP
	SUB	T3,P2		;T3=CLUSTER IN GROUP
	IMUL	T3,P1		;T3=BLOCK NUMBER IN GROUP
	ADD	T3,T4		;T3= DISTANCE OF BLOCK FROM START OF PNTR
	POP	P,T4		;BLOCK NUMBER TO GET
	SKIPE	T3		;AT 1ST BLOCK OF A GROUP?
	CAIN	T4,1		;IS IT BLOCK 1?
	TLOA	S,IOSFIR	;YES, SET CHECKSUM BIT
	TLZ	S,IOSFIR	;NO, CLEAR CHECHSUM BIT
	IMUL	T2,P1		;T2=RELATIVE BLOCK NUMBER OF START OF PNTR
	SUB	T2,T3		;COMPUTE NUMBER OF BLOCKS LEFT IN GROUP
	HRRM	T2,DEVLFT##(F)	;SAVE IN DDB
IFN FTDMRB,<
	HRRZ	T2,T1		;GET ADDRESS PORTION OF POINTER
	CAIG	T2,DEVRBN##(F)	;SKIP IF NOT POINTING TO DDB
	CAIGE	T2,DEVRB1##(F)	;SKIP IF POINTING TO DDB
	JRST	SCNP2A		;NOT IN DDB, MUST BE IN MONITOR BUFFER
	MOVE	T2,DEVLPC##(F)	;GET WORD CONTAINING LAST POINTER FLAG
	TLNN	T2,DEPLPC##	;IS POINTER IN DDB?
	JRST	SCNP2D		;NO, PROCEED
	SKIPE	1(T1)		;YES, IS NEXT SLOT EMPTY?
	JRST	SCNP2A		;NO, CHECK TO SEE IF THIS IS LAST SLOT
	HRRZ	T2,DEVLFT##(F)	;IS LAST, MAKE LAST BLOCK UNAVAILABLE
	SOJE	T2,CPOPJ##	;JUMP IF NO BLOCKS AVAILABLE
	JRST	SCNP2C		;STORE THE NEW VALUE OF DEVLFT
SCNP2A:	HRRZ	T2,DEVLFT##(F)	;RETURN DEVLFT TO T4
	AOBJN	T1,SCNP2B	;ABOUT TO RUN OUT OF POINTERS?
	SOJE	T2,SCNP2E	;YES, MAKE LAST BLOCK UNAVAILABLE
SCNP2B:	SUB	T1,[XWD 1,1]	;RESTORE AOBJN WORD
SCNP2C:	HRRM	T2,DEVLFT##(F)	;STORE IN DDB
>				;END FTDMRB
SCNP2D:	MOVEM	T4,DEVREL##(F)	;=CURRENT RELATIVE BLOCK
	MOVE	T2,T4		;GET DEVREL INTO T2
	SUB	T2,T3		;SET TO RELATIVE BLOCK OF START OF GROUP
	SKIPN	T4		;USETI/O TO BLOCK 0?
	TLZ	S,IOSFIR	;YES. DONT COMPUTE CHECKSUM (ITS FOR BLOCK 1)
	MOVE	T4,UNISTR##(U)
	MOVE	T4,STYCLP##(T4)	;SET T4=POINTER TO CLUSTER ADDRESS
	HRRI	T4,(T1)
	LDB	T4,T4		;T4=CLUSTER ADDRESS
	IMUL	T4,P1		;1ST LOGICAL BLOCK ADR. IN POINTER
	ADD	T3,T4		;+DISTANCE TO DESIRED BLOCK
	MOVEM	T3,DEVBLK##(F)	;=LOGICAL ADR. OF DESIRED BLOCK
	JRST	CPOPJ1##	;TAKE GOOD RETURN
IFN FTDMRB,<
SCNP2E:	MOVSI	T1,DEPLPC##	;TELL CALLER WHY HE LOST
	IORM	T1,DEVLPC##(F)
	POPJ	P,
>



;SUBROUTINE TO READ A RIB BLOCK, AND STORE THE POINTERS IN THE DDB
;ENTER AT RDPTRA IF THE POINTERS ARE ALREADY IN THE MON BUF
RDPTRS::PUSHJ	P,PTRGET	;READ THE RIB BLOCK INTO A MON BUF
RDPTRA::PUSHJ	P,PTRCPY	;COPY CURRENT POINTERS FROM MON BUF TO DDB
	PJRST	GVMNB0		;GIVE UP MON BUF AND RETURN


;SUBROUTINE TO WRITE POINTERS
WRTPTR:	PUSHJ	P,PTRCUR	;READ THE RIB
	SKIPN	T3		;DONT TRUST ANYTHING IF RIB ERR
	PUSHJ	P,PTRWRT	;BLT POINTERS INTO MON BUF, WRITE THEM
	PJRST	GVMNBX		;GIVE UP MON BUF AND RETURN

;SUBROUTINE TO GET THE CURRENT POINTERS INTO CORE
;RETURNS T3=0 IF OK, NON-0 IF RIB ERROR
PTRCUR::SKIPN	DEVMBF##(F)	;SKIP IF WE ALREADY HAVE BUFFER
	PUSHJ	P,GTMNBF	;GET THE MONITOR BUFFER
	PUSHJ	P,RIBCUR	;READ THE CURRENT RIB
	PJRST	SPTRW		;SET UP A POINTER AND RETURN


;SUBROUTINE TO COPY POINTERS INTO MON BUF AND WRITE IT
;ENTER WITH T1=AOBJN WORD FOR ENTIRE MONITOR BUFFER
;RETURNS WITHOUT GIVING UP THE MON BUFFER
PTRWRT::PUSHJ	P,DD2MN		;COPY DDB POINTERS INTO MONITOR BUF
	STOPCD	.+1,DEBUG,TMP,	;++TOO MANY POINTERS
				;SHOULDN'T HAPPEN SINCE DEVRSU DIDNT GO POSITIVE
	HRRZ	T2,T1		;SAVE CURRENT POINTER LOC
	PUSHJ	P,SPTRW		;MINUS ORIGINAL POINTER LOC
	SUBI	T2,-1(T1)
	DPB	T2,DEYRLC##	;=CURRENT POSITION IN MON BUF
	PJRST	WRTRIB		;WRITE THE RIB AND RETURN
;SUBROUTINE TO FIND WRITING DDBS ASSOCIATED WITH A FILE
;CALL FNDDDB THE FIRST TIME, TO FIND OTHER DDBS CALL FNDDDN WITH
; T2 AS RETURNED FROM THE FIRST CALL
;CALL WITH T1= L(AT)
;RETURNS CPOPJ IF NO MORE (OR NONE) WRITING DDBS
;RETURNS CPOPJ1 NORMALLY, WITH T2=ADR OF NEXT DDB
FNDDDB:	MOVEI	T2,DSKDDB##	;START AT FIRST
FNDDDN:	HLRZ	T2,DEVSER(T2)	;STEP TO NEXT
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	MOVSI	T3,DVDSK
FNDDD1:	TDNN	T3,DEVMOD(T2)	;DSK DDB?
	POPJ	P,		;NO
	HRRZ	T4,DEVACC##(T2) ;YES, POINTING AT RIGHT A.T.?
IFN FTDSIM,<
	CAIE	T2,(F)		;IGNORE OUR OWN DDB
>
	CAME	T4,T1
	JRST	NXTDDB		;NO, TRY NEXT
	MOVE	T4,DEVWRT##(T2) ;YES, IS THIS DDB WRITING?
	TRNE	T4,DEPWRT##
	JRST	CPOPJ1##	;YES, FOUND THE GUY
NXTDDB:	HLRZ	T2,DEVSER(T2)	;NO, TRY NEXT
	JUMPN	T2,FNDDD1
	POPJ	P,		;COULDNT FIND THE DDB - RETURN NON SKIP
;SUBROUTINE TO FIND CURRENT POINTERS FOR A FILE IN SOME DDB
;CALLED WHEN THE ACCESS TABLE INDICATES POINTERS SHOULD BE THERE,
; BUT THE POINTERS ARE NOT IN THE DDB
;SOME DDB HAS ALLOCATED NEW BLOCKS, THE NEW POINTERS AREN'T YET IN THE RIB
;NON-SKIP RETURN IF COULDN'T FIND THE BLOCK
;NORMAL RETURN IS CPOPJ1
FNDPTR:	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T2,ACCCNT##(T1) ;STATUS OF FILE
	TRNE	T2,ACPUPD	;UPDATE?
	TRNN	T2,ACMCNM##	;YES, IS THIS THE ONLY READER?
	JRST	FIXDDB		;YES, CANT FIND A WRITING DDB
	PUSHJ	P,FNDDDB	;FIND THE WRITER
	  JRST	FIXDDB		;NONE THERE - REREAD THE RIB

;HERE WHEN THE RIGHT DDB HAS BEEN FOUND
	MOVSI	T1,DEVRB1##(T2) ;COPY THE CURRENT PNTRS INTO DDB
	HRRI	T1,DEVRB1##(F)	; (MAY INCLUDE POINTERS WHICH ARE ALREADY

	BLT	T1,DEVRBN##(F)	; IN THE RIB)
	MOVE	T1,DEVLPC##(F)	;SET UP ALL THE DDB PARAMETERS
	MOVE	T3,DEVLPC##(T2)
	TLNE	T3,DEPLPC##
	TLOA	T1,DEPLPC##
	TLZ	T1,DEPLPC##
	MOVEM	T1,DEVLPC##(F)
	LDB	T1,DEXRLC##
	DPB	T1,DEYRLC##
	HLRE	T1,DEVRSU##(T2)
	HRLM	T1,DEVRSU##(F)
	MOVE	T3,DEVRET##(T2)
	SUBI	T3,DEVRB1##(T2)
	ADDI	T3,DEVRB1##(F)
	HRRM	T3,DEVRET##(F)
	MOVE	T1,DEVFLR##(T2)
	MOVEM	T1,DEVFLR##(F)
	MOVE	T1,DEVRIB##(T2)
	MOVEM	T1,DEVRIB##(F)
	MOVE	T1,DEVFUN##(T2)
	HRRM	T1,DEVFUN##(F)


;DDB IS ALL SET (IF WE FOUND THE WRITER). CALL USETI TO SET FOR THE RIGHT BLOCK
; WILL FIND IT IN THE DDB POINTERS IF THERE, IF THE UPDATER CLOSED THEY SHOULD
; HAVE BEEN WRITTEN BACK INTO THE RIB (COULDN'T FIND THE RIGHT DDB)
FIXDDB:	PUSH	P,W		;SAVE W
	MOVE	W,DEVREL##(F)	;BLOCK WE'RE LOOKING FOR
	PUSHJ	P,USET00	;GO SET UP FOR IT
	  CAIA
	SKIPG	DEVBLK##(F)	;SEMI-GOOD RETURN?
	SOS	-1(P)		;STILL COULDN'T FIND THEM (SYSTEM ERROR?)
	POP	P,W		;RESTORE W
	PJRST	CPOPJ1##	;EVERYTHING WORKED!
;SUBROUTINE TO READ THE CURRENT RIB
;RETURNS CPOPJ, IF T3 NON-ZERO, ERROR READING RIB
;RETURNS UNIT OF RIB IN T2
RIBCUR::PUSH	P,U		;SAVE CURRENT UNIT
	LDB	T2,DEYRBU##	;GET CURRENT RIB LOGICAL UNIT NUMBER
	PUSHJ	P,NEWUNI	;SET UP U,DEVUNI
	STOPCD	UDEERR,DEBUG,UDE, ;++UNIT DOESN'T EXIST
	LDB	T2,DEYRBA##	;GET CURRENT RIB CLUSTER ADDRESS
	LDB	T3,UNYBPC##	;BLOCKS PER CLUSTER FOR THIS UNIT
	IMUL	T2,T3		;BLOCK NUMBER IN T2
	MOVE	T1,DEVMBF##(F)	;GET IOWD FOR MONITOR BUFFER
	PUSHJ	P,MONRED	;READ THE BLOCK
	PUSHJ	P,RIBCHK	;MAKE SURE ITS A VALID RIB
UDEERR:	SKIPA	T3,[-1]		;RIB ERROR, SET T3=-1
	SETZ	T3,		;T3=0 INDICATES RIB OK
	MOVE	T2,U		;RIB-UNIT IN T2
	POP	P,U		;RESTORE CURRENT UNIT
	HRRM	U,DEVUNI##(F)	;AND SAVE IN DDB
	POPJ	P,		;AND RETURN

IFN FTDMRB,<			;IF MULTIPLE RIBS
;SUBROUTINE TO GET THE NEXT RIB IN A CHAIN INTO CORE
;RETURNS CPOPJ1 WITH NEXT RIB IN CORE, CPOPJ IF NONE OR ERROR
;IF CPOPJ RETURN AND T3 NON-0, ERROR,T3=0,NO NEXT RIB
PTRNXT::SETZ	T3,		;T3=0 INDICATES NO RIB ERROR
	MOVE	T2,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	SKIPL	DEVRIB##(F)	;IS CURRENT RIB EXTENDED
	SKIPN	RIBFLR##+1(T2)	;NO, IS THIS AN EXTENDABLE FILE
	SKIPN	T2,RIBXRA##+1(T2)	;GET THE NEXT RIB ADDRESS
	POPJ	P,		;NONE, END OF CHAIN
	MOVEM	T2,DEVRIB##(F)	;MAKE NEXT RIB CURRENT RIB
	PUSHJ	P,PTRCUR	;READ THE RIB
	JUMPN	T3,CPOPJ##	;NON-SKIP RETURN IF ERROR
	JRST	CPOPJ1##	;GOOD RETURN
>	;END CONDITIONAL ON FTDMRB
	SUBTTL	MISCELLANEOUS FUNCTIONS
IFN FTRP04,<

;UNLOAD A DRIVE
UNLOAD::PUSHJ	P,GETWDU	;GET USERS ARGUMENT
	MOVNI	T2,1		;WHOLE WORD MUST MATCH
	PUSHJ	P,SRUNI##	;IS IT A UNIT NAME?
	  PJRST	ECOD1##		;NO - ERROR 1
	  JFCL
	SKIPN	UNILOG##(U)	;YES, IS IT IN A FILE STRUCTURE?
	SKIPE	UNISTS##(U)	;NO, IS IT IDLE?
	PJRST	ECOD2##		;NOT IDLE OR IN AN STR - ERROR 2
	MOVE	J,UNIKON##(U)	;KONTROLLER DATA BLOCK
	SKIPGE	KONUNL##(J)	;DOES DEVICE UNLOAD?
	PJRST	ECOD3##		;NO, ERROR 3
	PUSHJ	P,@KONUNL##(J)	;YES, UNLOAD IT
	  JFCL			;IGNORE IF UNIT NOT READY
	MOVEI	T2,O2COD##	;MARK UNIT AS DOWN,
	MOVEM	T2,UNISTS##(U)	; NO ONCE-A-MINUTE TYPOUT
IFN FTDUAL,<
	SKIPE	T1,UNI2ND##(U)
	MOVEM	T2,UNISTS##(T1)
>
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

IFN FTDSUP,<
SETCPT::SKIPA	T1,[IORM T1,DEVCPT##(F)]
CLRCPT::MOVE	T1,[ANDCAM T1,DEVCPT##(F)]
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVE	P1,T1		;SET TO CLEAR/SET THE BIT
	PUSHJ	P,GETWDU##	;GET USERS ARG
	PUSHJ	P,DVCNSG##	;FIND THE DDB
	  PJRST	ECOD1##		;NONE SUCH - ERROR 1
	PUSHJ	P,VALUUX	;LEGAL?
	  PJRST	ECOD1##		;NO, ERROR 1
	MOVE	U,DEVUNI##(F)	;YES, GET UNIT (IF SET UP)
	JUMPE	U,SETCP1
	MOVE	J,UNIKON##(U)	;KONTROLLER DATA BLOCK LOC
	SKIPG	KONRDC##(J)	;DOES DEVICE HAVE COMPAT. MODE?
	PJRST	ECOD2##		;NO, ERROR 2
SETCP1:	MOVSI	T1,DEPCPT##	;YES, GET THE BIT
	XCT	P1		;SET/CLEAR BIT IN DDB
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN
>
IFE FTDSUP,<
SETCPT::
CLRCPT::POPJ	P,0
>>
IFE FTRP04,<
SETCPT::
CLRCPT::
UNLOAD::POPJ	P,0
>
	SUBTTL	DIAG	DIAGNOSTIC UUO
IFN FTDHIA,<
DIAUUO::PUSH	P,T1
	HRR	M,T1		;ADR OF BLOCK
	PUSHJ	P,GETWDU##	;GET ARG
	CAIN	T1,7		;WANT KON/UNIT NUMBER?
	JRST	DIAKUN		;YES, TELL HIM
IFN FTVM,<
	SKIPE	.UPMP+.UPVRT
	JRST	[POP	P,(P)
		 JRST	DIAVRT]
>
	SETZ	T1,		;SAY WE WANT USER-IOT
	PUSHJ	P,STOTAC##	;TRPSET CALLS GETTAC
	PUSHJ	P,TRPSET##	;CHECK PRIVS, SET USRIOT
;IF GOING TO DO IO HE'D BETTER BE ALL IN CORE
	  JRST	[POP P,(P)	;NO PRIVS, LOSE
		JRST DIANPV]
	POP	P,T1		;OK, RESTORE ARGUMENT
	PUSHJ	P,STOTAC##	;TRPSET STORES 0 IN THE AC
	HLRE	T2,T1		;NUMBER OF ARGUMENTS
	JUMPGE	T2,WRONGN	;ILLEGAL N
	PUSHJ	P,SAVE3##
	MOVN	P1,T2		;P1=NUMBER OF ARGS
	CAIGE	P1,2		;LEGAL?
	JRST	WRONGN		;ILLEGAL N
	HRR	M,T1		;LOC OF ARG BLOCK
	PUSHJ	P,GETWDU##	;GET FUNCTION
	CAILE	T1,MXDIAG	;LEGAL?
	JRST	BADFNC		;ILLEGAL FNCN
	MOVE	P2,T1		;P2=FUNCTION CODE
	PUSHJ	P,GETWD1##	;GET KON/UNIT WORD
	LDB	T2,[POINT 7,T1,6] ;CONTROLLER NUMBER
	HLRZ	U,SYSUNI##	;FIND IT
DIADRS:	HRRZ	P3,UNIKON##(U)
	MOVE	T3,KONREG##(P3)
	ADDI	T3,KONEBK##(P3)	;POINT AT FIRST IO WORD IN KDB
	LDB	T3,[POINT 7,(T3),9] ;KON NUM FROM KDB
	CAIN	T3,(T2)		;MATCH?
	JRST	DIAUNI		;YES, WE HAVE KON
	HLRZ	U,UNISYS##(U)	;NO, STEP TO NEXT
	JUMPN	U,DIADRS	;AND TEST IT
	JRST	ILLKON		;ILLEGAL CONTROLLER NUMBER
DIAUNI:	LDB	T1,[POINT 3,T1,29] ;UNIT
DIAUN1:	LDB	T2,UNYPUN##	;UNIT FROM UDB
	CAMN	T1,T2		;RIGHT ONE?
	JRST	DIAUN2		;YES, SEE IF SAME KON
	HLRZ	U,UNISYS##(U)	;NO, TRY NEXT
	JUMPN	U,DIAUN1
	JRST	ILLUNI		;NO MATCH, YOU LOSE
DIAUN2:	HRRZ	T1,UNIKON##(U)	;ON SAME KONTROLLER?
	CAIE	T1,(P3)
	JRST	ILLUNI		;ILLEGAL UNIT

;STILL IN FTDHIA CONDITIONAL
DIADSP:	MOVE	F,.PDDIA##(W)	;SET UP F
	PUSHJ	P,@DIAFNC-1(P2)	;AND DISPATCH
NOUIO:	  SKIPA	T1,[XC.UIO]	;LOST - CLEAR USRIOT
	JRST	CPOPJ1##	;;WON - SKIP RETURN
	ANDCAM	T1,JOBPD1##(R)
	MOVSI	T1,NSWP!NSHF	;JOB IS NOW MOVABLE
	LDB	T2,PJOBN##
	ANDCAM	T1,JBTSTS##(T2)
	POPJ	P,

DIAFNC:	DIAASU			;(1)ASSIGN SINGLE UNIT
	DIAAAU			;(2)ASSIGN ALL UNITS
	DIARCU			;(3)RELEASE CHAN AND ALL UNITS
	DIASCP			;(4)SPECIFY CHANNEL PROGRAM
	DIARCP			;(5)RELEASE CHAN PROGRAM
	DIAGCS			;(6)GET CHAN STATUS
	DIAKUN			;(7)GET KONTROLLER AND UNIT
MXDIAG==.-DIAFNC
;STILL IN FTDHIA CONDITIONAL
;HERE TO ASSIGN SOME UNIT
DIAASU:	JUMPN	F,DIUNAA	;ALREADY HAVE SOME UNITS ASS'D
	HRRZ	T1,UNISTR##(U)	;TEST DIAG-MODE WHEN INPL'D
	JUMPN	T1,UNNDMD	;NOT IN DIAGNOSTIC MODE
	HLRZ	T1,UNIDIA##(U)	;JOB WHICH OWNS THIS UNIT
	CAME	T1,.C0JOB##	;SOME OTHER JOB HAVE IT?
	JUMPN	T1,UNAAJB	;UNIT ASS'D TO ANOTHER JOB
	JUMPN	T1,DIAHVF	;HAVE A DDB SET IF F NON-0
	PUSHJ	P,FAKDDB##	;GET A DDB
	  JRST	DINEFC		;NOT ENOUGH "FREE" CORE
	HRL	F,.C0JOB##	;SET UNIDIA=JOB,,DDB
	MOVEM	F,UNIDIA##(U)
	JRST	DIAHVF		;AND CONTINUE

;HERE TO ASSIGN ALL UNITS ON A CHANNEL
DIAAAU:	JUMPN	F,DIUNAA	;ALREADY HAVE SOME UNITS ASS'D
	HRRZ	T1,U		;SAVE STARTING-POINT
DIAAA1:	HRRZ	T2,UNISTR##(T1)	;TEST DIAG MODE WHEN IMPL'D
	JUMPN	T2,UNNDMD	;NOT IN DIAG MODE
	HLRZ	T2,UNIDIA##(T1)	;UNIT IN DIAG FOR SOME OTHER JOB?
	CAME	T2,.C0JOB##
	JUMPN	T2,UNAAJB	;UNIT ASS'D TO ANOTHER JOB
	SKIPE	T2		;HAVE A DDB SET UP ALREADY?
	HRRZ	F,UNIDIA##(T1)	;YES, SAVE IT
	HLRZ	T1,UNICHN##(T1)	;STEP TO NEXT UNIT ON CHAN
	CAIE	T1,(U)		;BACK WHERE WE STARTED?
	JRST	DIAAA1		;NO, TEST IT
	JUMPN	F,DIAAA2	;GO IF WE HAVE A DDB
	PUSHJ	P,FAKDDB##	;NONE, GET ONE
	  JRST	DINEFC		;NOT ENOUGH CORE
DIAAA2:	HRL	F,.C0JOB##	;SET JOB,,DDB IN EVERY UNIT
	HRRZ	T1,U		; ON THE CHANNEL
DIAAA3:	SKIPN	UNIDIA##(T1)
	MOVEM	F,UNIDIA##(T1)	;(IF NONE THERE ALREADY)
	HLRZ	T1,UNICHN##(T1)
	CAIE	T1,(U)
	JRST	DIAAA3

DIAHVF:	HRRZ	F,UNIDIA##(U)	;MAKE SURE F IS RIGHT
	MOVEM	U,DEVUNI##(F)	;SAVE U IN DDB
	MOVEM	F,.PDDIA##(W)	;SAVE DDB IN PDB
DIAHV1:	SKIPN	T1,DIADSK##	;SOME OTHER JOB IN DIAG ALREADY?
	JRST	DIASCH		;NO
	MOVEI	T1,2		;YES, SLEEP FOR A WHILE
	PUSHJ	P,SLEEP##	;AND THEN TRY AGAIN
	JRST	DIAHV1
;STILL IN FTDHIA CONDITIONAL
DIASCH:	HRRZM	F,DIADSK##	;INDICATE WE WANT TO STOP IO
	DPB	T1,PDVTIM##	;NO HUNG TIMER TILL WE START
	MOVSI	T1,NSWP!NSHF	;SO SCHEDULER WONT TRY TO
	IORM	T1,JBTSTS##(J)	; SWAP US (STORE JOB IN FORCE)
	PUSHJ	P,SETACT##	;SET DDB IOACT
	HRRZ	T2,UNICHN##(U)	;SAY WHAT CHANNEL WE WANT TO STOP IO ON
	MOVEM	T2,DIACHN##
	PUSHJ	P,WINDWN	;ANNY IO GOING?
	  PUSHJ	P,WAIT1##	;YES, WAIT FOR IT TO STOP

;HERE WHEN ALL IO IS STOPPED ON THE DESIRED CHANNEL.
	HRROS	DIADSK##	;INDICATE WE'RE IN MIDDLE OF TEST
	SETZM	@DIACHN##	;CHAN IS BUSY
	CAIGE	P1,3		;TIME LIMIT GIVEN?
	TDZA	T1,T1		;NO, SET FOR 1 MINUTE
	PUSHJ	P,GETWD1##	;YES, GET IT
	IDIVI	T1,^D1000	;CONVERT TO SECS
	SKIPN	T1		;IF LESS THAN 1 SEC (OR NONE),
	MOVEI	T1,^D60		; SET TIMER FOR 1 MINUTE
	IDIVI	T1,^D120	;CONVERT TO 2-MINUTE CHUNKS
	MOVEM	T1,DEVDIA##(F)	;REMAINDER IN 2-MINUTE UNITS
	JFFO	T2,.+2		;COMPUTE N SUCH THAT 2^N .GT. TIME
	MOVEI	T3,44-1
	MOVNS	T3
	ADDI	T3,44
	DPB	T3,PDVTIM##	;STORE N IN DDB
	PUSHJ	P,SETACT##	;MAKE SURE IOACT IS ON
	SUBI	M,1		;POINT AT KON/UNIT WORD
	PUSHJ	P,GETWDU
	HLLZ	T2,T1		;GET KONTROLLER DEVICE CODE
	LSH	T2,-3
	TLO	T2,(CONO)	;MAKE A CONO DEV,0
	XCT	T2		; AND EXECUTE IT
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;STILL IN FTDHIA CONDITIONAL
;HERE FROM STOP1A ON ^C OR EXIT, HALT,...  ;OR FROM HNGDSK
DIACLR::PUSHJ	P,FNDPDB##	;FIND FDB
	  POPJ	P,		;THERE ISN'T ONE
	SKIPN	F,.PDDIA##(W)	;DIAG GOING?
	POPJ	P,		;NO
	MOVE	U,DEVUNI##(F)	;YES, SET UP U
	PUSHJ	P,SAVE3##
	HRRZ	P3,UNIKON##(U)	;AND P3
	TLOA	F,-1		;INDICATE FROM DIACLR


;HERE TO RELEASE ALL UNITS
DIARCU:	JUMPE	F,CPOPJ1##	;EXIT IF NO DIAG SET UP
	PUSHJ	P,DIARCX	;GIVE UP IOWD BLOCK IF ONE EXISTS
	PUSH	P,U		;SAVE U
DIARC1:	HRRZ	T1,UNIDIA##(U)	;DDB WHICH HAS UNIT
	CAME	T1,.PDDIA##(W)	;OURS?
	JRST	DIARC2		;NO
	SETOM	UNICYL##(U)	;YES, SET SO WE'LL SEEK ON IT
	SETZM	UNIDIA##(U)	;NOW NO DIAG FOR IT
DIARC2:	HLR	U,UNICHN##(U)	;STEP TO NEXT UNIT
	CAME	U,(P)		;BACK WHERE WE STARTED?
	JRST	DIARC1		;NO, TEST IT
	SETZM	.PDDIA##(W)	;DONT HAVE A DIAG GOING
	SETZM	DIADSK##
	SETOM	@DIACHN##	;CHAN IS FREE
	SKIPL	F
	PUSHJ	P,NOUIO		;CLEAR SOME BITS
	PUSHJ	P,CLRDDB##	;RETURN DDB SPACE
	MOVE	T1,[CRNKUP,,1]	;CAUSE CANT START IO ON UUO LEVEL
	IDPB	T1,CLOCK##	; SO COME BACK WITH PD LIST NOT MAPPED
	IDPB	U,CLOCK##	;SAY WHICH UNIT (CHAN)
	JUMPL	F,TPOPJ##	;NON-SKIP IF CALLED FROM DIACLR
	SETZ	T1,		;MAKE SURE CRNKUP IS CALLED BEFORE JOB CAN
	PUSHJ	P,SLEEP##	; DO ANOTHER DIAG.
	JRST	TPOPJ1##	;AND TAKE SKIP-RETURN
;STILL IN FTDHIA CONDITIONAL
;HERE TO SET UP A SCHANNEL PROGRAM
DIASCP:	JUMPE	F,NOASUN	;NO ASS'D UNITS
	PUSHJ	P,DIARCX	;RETURN ANY IOWD
	PUSHJ	P,GETWD1##	;GET IOWD
	MOVEM	T1,DEVDMP##(F)	;UNRELOCATED IOWD
	HLRE	T2,T1		;LENGTH OF IOWD
	JUMPE	T2,IOWCPB	;TOO BIG IF 0
	MOVEI	T1,1(T1)	;START ADDRESS
	MOVNS	T2		;+LENGTH
	ADDI	T2,-1(T1)	;TOP ADDRESS
	TRC	T2,(T1)		;LEGAL?
	TRNE	T2,777000
	JRST	[SETZM DEVDMP##(F) ;IOWD CROSSES PAGE BOUNDARY
		JRST IOWCPB]
	HRR	M,T1		;DO ADDRESS CHECKING WITH GETWD
	PUSHJ	P,GETWDU##	; TO INSURE THAT THE PAGE IS IN CORE
IFN FTKA10,<
	HRRZ	P2,KONCOM##(P3)	;WHERE IOWD IS TO GO
	MOVE	T2,DEVDMP##(F)	;IOWD
	ADDI	T2,(R)		;RELOCATE IT
	MOVEM	T2,(P2)		;AND SAVE IN LOW CORE
	SETZM	1(P2)		;TERMINATE LIST
>
IFN FTKI10!FTKL10,<
	MOVE	P3,UNICHN##(U)	;CHAN (FOR MAPIO)
	SETZ	P1,		;SAY FIRST CALL
	MOVE	T2,DEVDMP##(F)	;GET IOWD
	ADDI	T2,(R)		;RELOCATE IT
	HLL	T2,DEVDMP##(F)	;LH MIGHT HAVE INCR'D
	PUSHJ	P,MAPIO##	;RELOCATE THE IOWD
	  JRST	[SETZM DEVDMP##(F)
		JRST DINEFC]	;NO LOW-CORE BLOCKS
	SETZM	(P1)		;TERMINATE LIST
>
	MOVE	T1,UNIKON##(U)	;LOC OF KDB
	MOVE	T1,KONIOC##(T1) ;INITIAL CONTROL WD ADDR
	MOVEM	P2,(T1)		;POINT ICWA AT CORE-BLOCK
	PUSHJ	P,STOTAC##	;TELL USER ICWA
IFN FTKL10,<
	PUSHJ	P,CSDMP##	;SWEEP CACHE
>
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN

;STILL IN FTDHIA CONDITIONAL
;HERE TO RETURN A CHAN PROGRAM
DIARCP:	JUMPE	F,CPOPJ1##	;NOTHING TO DO IF NO DDB
	AOS	(P)
DIARCX:	SKIPN	DEVDMP##(F)	;NOTHING TO DO IF NO IOWD
	POPJ	P,
	SETZM	DEVDMP##(F)	;NOW NO IOWD
IFN FTKI10!FTKL10,<
	MOVE	T1,@KONIOC##(P3) ;GET LOC OF CORE-BLOCK
	PJRST	RTNIOW##	;RETURN THE SPACE
>
IFN FTKA10,<
	POPJ	P,
>


;HERE TO TELL USER FINAL CHAN STATS
DIAGCS:	JUMPE	F,CPOPJ1##	;NOTHING TO DO IF NO DDB
	MOVE	P2,KONIOC##(P3)	;GET ICWA
	CAILE	P1,4		;ASKING FOR TOO MUCH?
	MOVEI	P1,4		;YES, MAX HE CAN GET
DIAGC1:	MOVE	T1,(P2)		;GET A WORD FROM LOW CORE
	PUSHJ	P,PUTWD1##	;TELL USER
	SOJLE	P1,CPOPJ1##	;DONE IF 0
	AOJA	P2,DIAGC1	;GET NEXT WORD

;STILL IN FTDHIA CONDITIONAL
;HERE TO TEST IF IO IS GOING ON A CHANNEL
;RETURNS NON-SKIP IF YES, SKIPS IF CHAN IS NOW IDLE
WINDWN:	DSKOFF
	SKIPL	@DIACHN##	;#IO XFER HAPPENING?
	JRST	WINDW2		;#YES, NON-SKIP
	MOVE	T2,U		;#NO, TEST UNITS FOR POSITIONING
WINDW1:	MOVE	T1,UNISTS##(T2)	;#UNIT SEEKING?
	CAIE	T1,PCOD##
	CAIN	T1,SCOD##
	JRST	WINDW2		;#YES, NON-SKIP
	HLR	T2,UNICHN##(T2)	;#NO, TEST NEXT UNIT
	CAME	T2,U		;#BACK WHERE WE STARTED?
	JRST	WINDW1		;#NO
	AOS	(P)		;#YES, ALL IS NOW QUIET
WINDW2:	DSKON
	POPJ	P,

;ROUTINE TO START UP IO ON A CHANNEL AGAIN
;CALLED ON PI7 SINCE CANT START IO FOR DIFFERENT JOB ON UUO LEVEL
CRNKUP:	PUSHJ	P,SAVE1##
	MOVE	U,T1
	MOVE	P1,DIACHN##	;POINT P1 AT CHANNEL
	SETZM	@DIACHN##	;SO ON-CYLINDER UNITS WONT START IO
	PUSH	P,U
CRNKU1:	HLR	U,UNICHN##(U)	;NEXT UNIT
	DSKOFF
	MOVE	T1,UNISTS##(U)	;#DOES IT WANT POSITIONING?
	CAIN	T1,PWCOD##
	PUSHJ	P,CRNPOS	;#YES, START THE SEEK GOING
	CAME	U,(P)		;#BACK WHERE WE STARTED?
	JRST	CRNKU1		;#NO, TEST NEXT UNIT
	POP	P,(P)		;#YES, REMOVE JUNK FROM PDL
	MOVE	J,UNIKON##(U)	;#GO START AN XFER IF CHNQUE NOT EMPTY
	DSKOFF			;#FIGHT RACE
	SKIPL	KONTAB##(J)	;#DID A SEEK FINISH?
	PJRST	PIKTRX		;#NO, START IO IF CHNQUE NOT EMPTY
	DSKON			;#YES, FORGET IT
	POPJ	P,		;# SINCE IO IS ALREADY GOING

;STILL IN FTDHIA CONDITIONAL
;HERE TO GET KONTROLLER/UNIT
DIAKUN:	POP	P,(P)		;REMOVE SAVED T1
	PUSHJ	P,GETWD1##	;GET DEVICE NAME
	PUSHJ	P,DEVSRG##	;FIND IT
IFE FTDUAL,<
	  JRST	ILLUNI		;NO SUCH UNIT
>
IFN FTDUAL,<
	  JRST	TRYALT
>
	MOVE	T2,DEVMOD(F)
	TLNE	T2,DVMTA	;IS IT A MAG TAPE?
	JRST	DIAMTA##	;YES, LET TAPUUO DO IT
	CAIE	F,DSKDDB##	;NO, SOME FLAVOR OF DISK
	MOVE	T1,DEVNAM(F)
	PUSHJ	P,MSKUNI##	;SET UP A MASK
	PUSHJ	P,SRUNI##	;FIND UDB
	  JRST	ILLUNI		;NOT A DISK UNIT
	  JFCL
DIAKU1:	MOVE	T1,UNIKON##(U)	;KONTROLLER
	MOVE	T2,KONREG##(T1)
	ADDI	T2,KONEBK##(T1) ;POINT TO FIRST I/O INST IN KDB
	LDB	T2,[POINT 7,(T2),9] ;GET KONTROLLER CODE
	LDB	T1,UNYPUN##	;UNIT NUMBER
	LSH	T1,3		;POSITION IT
	LSH	T2,2		;POSITION KONTROLLER DEVICE CODE
	HRL	T1,T2
	AOS	(P)		;SET FOR SKIP-RETURN
	PJRST	STOTAC##	;TELL USER KON,,UNIT AND RETURN
IFN FTDUAL,<
;HERE ON NO UNIT, TEST SECOND UNITS
TRYALT:	HLRZ	T2,SYSUNI##	;START AT BEGINNING
TRYAL1:	SKIPLE	T3,UNI2ND##(T2)	;IS THERE A SECOND UNIT?
	CAME	T1,UNINAM##(T3)	;YES, RIGHT ONE?
	CAIA
	JRST	TRYAL2		;WE FOUND IT
	HLRZ	T2,UNISYS##(T2)	;NO MATCH, TRY NEXT
	JUMPN	T2,TRYAL1
	PJRST	ILLUNI		;NO SUCH UNIT, ERROR
TRYAL2:	MOVE	U,T3		;POINT U AT SECOND UNIT
	JRST	DIAKU1		;AND TELL HIM WHAT IT IS
>
ERCODE	DIANPV,1		;NOT ENOUGH PRIVS
ERCODE	WRONGN,2		;ILLEGAL NUMBER OF ARGS
ERCODE	ILLKON,3		;ILLEGAL CONTROLLER NUMBER
ERCODE	ILLUNI,4		;ILLEGAL UNIT NUMBER
ERCODE	DIUNAA,5		;SOME UNITS ALREADY ASSIGNED
ERCODE	UNNDMD,6		;UNIT NOT IN DIAG MODE
ERCODE	UNAAJB,7		;UNIT ASS'D TO ANOTHER JOB
ERCODE	DINEFC,10		;NOT ENOUGH FREE CORE
ERCODE	NOASUN,11		;NO ASSIGNED UNITS
ERCODE	IOWCPB,12		;IOWD CROSSES PAGE BOUNDARY
ERCODE	BADFNC,13
ERCODE	DIAVRT,14
>		;END FTDHIA
	SUBTTL	MONITOR MODE IO ROUTINES
;SUBROUTINE TO COPY POINTERS FROM DDB TO MONITOR BUFFER
;ENTER WITH T1=AOBJN WORD FOR ENTIRE MONITOR BUFFER
;EXIT CPOPJ IF MON BUF IS FULL AND THERE ARE MORE POINTERS IN DDB
;EXIT CPOPJ1 NORMALLY, WITH T1=LOC OF LAST PNTR STORED
;PRESERVES T4
DD2MN::	MOVE	T3,UNISTR##(U)	;GET ADDR OF STR DATA BLOCK
	SETO	T2,		;CREATE MASK FOR
	LDB	T2,STYCLP##(T3)	;CLUSTER POINTER
	MOVEM	T2,MSKLOC	;STORE IT FOR LATER
	MOVSI	T2,DEPLPC##	;LAST POINTER IN CORE BIT
	ANDCAM	T2,DEVLPC##(F)	;CLEAR THE BIT IF IT WAS ON
	LDB	T2,DEYRLC##	;CURRENT POINTER LOC
	HRLS	T2
	ADD	T1,T2		;UPDATE AOBJN WORD
	MOVSI	T2,MPTRLN##	;LENGTH OF A BUNCH OF POINTERS
	HRRI	T2,DEVRB1##(F)	;LOC OF 1ST POINTER
	HRRM	T2,DEVRET(F)	;SET DEVRET=DEVRB1
	SKIPE	(T2)		;FIRST POINTER EMPTY
	JUMPGE	T1,CPOPJ##	;NO, POPJ IF NO SLOTS
DD2MN2:	SKIPN	T3,(T2)		;GET A POINTER FROM DDB
	SOJA	T1,CPOPJ1##	;ALL POINTERS COPIED - RETURN
	EXCH	T3,(T1)		;STUFF IT IN MON BUF
	JUMPE	T3,DD2MN3	;IF OLD PNTR=0, OK
	XOR	T3,(T1)		;XOR RIB & MON BUF
	TDNE	T3,MSKLOC	;IF PNTRS EQUAL, SKIP
	STOPCD	.+1,DEBUG,PDA,	;++POINTERS WITH DIFFERENT ADDRESSES
DD2MN3:	SETZM	(T2)		;ZERO THE WORD IN DDB
	AOBJP	T2,CPOPJ1##	;THROUGH WHEN DDB RUNS OUT
	AOBJN	T1,DD2MN2	;DO ANOTHER
	SKIPN	(T2)		;MON BUF FULL. MORE POINTERS?
	SOJA	T1,CPOPJ1##	;NO, TAKE SKIP-RETURN
TWOLOC:	POPJ	P,2		;MON BUF FULL AND MORE TO GO
	$LOW
MSKLOC:	Z			;WORD FOR MASK FOR CLUSTER POINTER
	$HIGH
;SUBROUTINE TO READ RIB POINTERS INTO CORE
;GETS A MONITOR BUFFER AND READS THE RIB INTO IT
;RETURNS T3=0 IF OK, T3=-1 IF ERROR; AND T1=AOBJN WORD FOR THE POINTERS
PTRGET::PUSHJ	P,BUFRIB	;GET MON BUF, READ RIB INTO IT
	  SKIPA	T3,[-1]		;RIB ERROR - RETURN T3=-1
	SETZ	T3,		;OK - T3=0
	PJRST	SPTRW		;SET T1=AOBJN WORD AND RETURN


;SUBROUTINE TO COPY CURRENT POINTERS FROM MON BUF TO DDB
;ENTER WITH RIB IN MON BUF, T1=AOBJN WORD FOR POINTERS
;EXIT WITH POINTERS COPIED INTO DDB, DEYRLC UPDATED
PTRCPY::LDB	T2,DEYRLC##	;PREVIOUS POINTER RELATIVE LOC
	SKIPN	DEVRB2(F)	;DEVRB2=0?(PNTR CAME FROM A.T. IF YES)
	SKIPA	T2,TWOLOC	;YES. START AT 3RD ENTRY IN PNTRS
	ADDI	T2,PTRLEN##	;+LENGTH OF A BUNCH OF POINTERS
	HRLS	T2
	ADD	T1,T2		;UPDATE AOBJN WORD (WAS FOR WHOLE POINTER AREA)
				;AND FALL INTO PTRBLT
;SUBROUTINE TO BLT POINTERS FROM MONITOR BUFFER TO DDB
;ENTER WITH T1=AOBJN WORD FOR CURRENT POINTERS IN MONITOR BUFFER
PTRBLT::MOVE	T3,T1		;SAVE CURRENT AOBJN WRD
	PUSHJ	P,SPTRW		;GET AOBJN WRD FOR WHOLE MON BUF
	HRRZ	T2,T3		;CURRENT PNTR LOC
	SUBI	T2,(T1)		;-ORIGINAL PNTR LOC=NEW DEYRLC
	MOVE	T1,T3		;RESTORE CURRENT AOBJN WORD

;SUBROUTINE TO COPY POINTERS FROM MON BUF TO DDB
; STORE DEVRLC WITHOUT COMPUTING
;ENTER T1=AOBJN WORD FOR POINTERS
PTRBL1::DPB	T2,DEYRLC##	;SAVE IN DDB
	HLLM	T1,DEVRSU##(F)	;-NO OF PNTRS LEFT
	MOVSI	T2,MPTRLN##
	HRRI	T2,DEVRB1##(F)	;AOBJN WORD FOR DDB
	HRRM	T2,DEVRET##(F)
PTRBL2:	SKIPA	T3,(T1)		;NEXT POINTER
PTRBL3:	SETZ	T3,		;POINTERS DONE-ZERO
	MOVEM	T3,(T2)		;SAVE IN DDB
	AOBJP	T2,PTRBL4	;COUNT DDB WORD
	AOBJN	T1,PTRBL2	;GET NEXT POINTER
	JRST	PTRBL3		;THOUGH WITH MON BUF

PTRBL4:	MOVE	T3,DEVLPC##(F)	;GET LAST POINTER IN CORE WORD
	AOBJN	T1,PTRBL5	;JUMP IF MORE POINTER SLOTS IN RIB
	PUSHJ	P,GTLPT##	;GET LAST RIB POINTER
	SKIPE	T2		; DONT LIGHT DEPLPC IF 0
	TLOA	T3,DEPLPC##	;NO MORE LEFT, LAST POINTER IS IN CORE
PTRBL5:	TLZ	T3,DEPLPC##	;LAST IS NOT IN CORE
	MOVEM	T3,DEVLPC##(F)	;RESTORE THE FLAG
IFE FTDSIM,<
	POPJ	P,		;AND RETURN
>
IFN FTDSIM,<
;IF ACYWCT .GTR. 0 ,ACPSBC=1, THEN IF A WRITER CHANGES A CHECKSUM
; AND THE NEW PNTR ISNT IN SOME OTHER WRITER'S DDB, IF THE 2ND WRITER
; THEN CHANGES THE CHECKSUM OF THAT PNTR AND CLOSES BEFORE THE 1ST WRITER
; (ORIGINAL ALLOCATER), THEN WHEN THE 1ST WRITER CLOSE WE HAVE A 
; CHECKSUM ERROR IN THE FILE.
;HENCE, WE HAVE TO SCAN DDBS FOR A WRITER WITH THIS PNTR, USE THE PNTER
; FROM THE FOUND DDB.

;STILL IN FTDSIM CONDITIONAL
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	JUMPE	T1,CPOPJ##
	LDB	T2,ACYWCT##	;ARE THERE MULTIPLE WRITERS?
	SOJLE	T2,CPOPJ##
	MOVE	T2,ACCSBC##(T1)	;YES, HAS CHECKSUM CHANGED?
	TRNN	T2,ACPSBC##
	JRST	CPOPJ##		;NO
	MOVE	T3,UNISTR##(U)	;YES, SET UP A MASK FOR
	SETO	T2,		; ADDR PORTION OF RETRIEVAL POINTERS
	LDB	T2,STYCLP##(T3)
	MOVEM	T2,MSKLOC	;AND SAVE IT AWAY
	PUSHJ	P,FNDDDB	;FIND A WRITING DDB FOR THE FILE
	  POPJ	P,		;NONE (DDB COULD BE IN EXTRIB)
PTRBL6:	HRRZ	T3,DEVUNI##(T2)	;SAME UNIT?
	CAIE	T3,(U)
	JRST	PTRBLB		;NO, TRY NEXT DDB
	MOVEI	T3,DEVRB1##(F)	;YES, SET AN AOBJN WORD FOR OUR DDB
	HRLI	T3,MPTRLN##
PTRBL7:	MOVEI	T1,DEVRB1##(T2)	;SET AOBJN WORD FOR POINTERS
	HRLI	T1,MPTRLN##	; FOR THE FOUND-DDB
PTRBL8:	MOVE	T4,(T1)		;GET A DDB POINTER
	JUMPE	T4,PTRBL9	;KEEP GOING IF 0 (PNTR MIGHT BE IN DEVRBN)
	XOR	T4,(T3)		;IS IT IN OUR DDB?
	TDNN	T4,MSKLOC
	JRST	PTRBLA		;YES, COPY PNTRS TO OUR DDB
PTRBL9:	AOBJN	T1,PTRBL8	;NO, TRY NEXT PNTR
	SKIPE	1(T3)		;ANY MORE PNTRS IN OUR DDB?
	AOBJN	T3,PTRBL7	;YES, TRY TO MATCH NEXT POINTER
	JRST	PTRBLB		;NO MATCH - TRY NEXT DDB

;HERE WHEN WE FOUND A MATCH BETWEEN THE WRITING DDB AND OUR DDB
PTRBLA:	MOVE	T4,(T1)		;GET PNTR FROM THE FOUND DDB
	MOVEM	T4,(T3)		;AND STUFF IT IN OURS
	AOBJP	T3,CPOPJ##	;THROUGH IF OUR DDB FULL
	SKIPN	(T3)		; OR IF NO MORE PNTRS IN OUR DDB
	JRST	CPOPJ##
	SKIPE	1(T1)		;IS THERE ANOTHER PNTR IN FOUND DDB?
	AOBJN	T1,PTRBLA	;YES, COPY INTO OUR DDB
PTRBLB:	PUSHJ	P,FNDDDN	;NO, FIND ANOTHER WRITING DDB
	  POPJ	P,		;NO - DONE
	JRST	PTRBL6		;FOUND ANOTHER - TEST ITS PNTRS
>


;SUBROUTINE TO SET AN AOBJN WORD FOR POINTERS IN THE MONITOR BUFFER
;ENTER WITH LOC OF MON BUF IN DEVMBF,  EXIT WITH T1=AOBJN WORD
;T2-T4 RESPECTED
SPTRW::	HRRZ	T1,DEVMBF##(F)	;LOC OF MON BUF (-1)
	ADD	T1,RIBFIR##+1(T1)	;AOBJN WORD (-1)
	AOJA	T1,CPOPJ##	;MAKE REAL AOBJN WORD AND RETURN
;SUBROUTINE TO GET A MONITOR BUFFER
;RETURNS WITH DEVMBF=T1=AN IOWD FOR THE BUFFER
IFN FTDSIM,<
;PRESERVES T2
GTMB2:	PUSH	P,T2		;SAVE T2
	PUSHJ	P,GTMNBF	;GET THE MON BUF
	PJRST	T2POPJ##	;RESTORE T2 AND RETURN
>
GTMNB:
;(SAME AS GTMNBF, PRESERVES T3)
GTMNBF::SKIPE	T1,DEVMBF##(F)	;JOB ALREADY HAVE MONITOR BUFFER?
	STOPCD	CPOPJ##,DEBUG,AHB, ;++ALREADY HAVE BUFFER
GTMNB0::SETZ	T4,		;DONT ADJUST MQREQ THE FIRST TIME
GTMNB4:	PUSHJ	P,MQWAIT##	;GET A MON BUF, WAIT IF NONE FREE
	ADDM	T4,MQREQ##	;ADJUST MQREQ IF THIS IS SECOND TRY TO GET THE BUFFER
GTMNB1::HRRZ	T1,BUFLST##	;GOT ONE - SCAN LIST FOR A FREE BUF
	NOSCHEDULE
GTMNB2:	SKIPL	T2,(T1)		;THIS BUFFER FREE?
	JRST	GTMNB3		;YES. MARK IT
	HRRZ	T1,T2		;NO. STEP TO NEXT IN LIST
	JUMPN	T1,GTMNB2	;TRY THIS ONE
	MOVNI	T4,1		;ADJUST MQREQ AFTER NEXT CALL TO MQWAIT
				;(CANT SOS MQREQ NOW, AS THAT COULD MAKE MQREQ=-1)
	JRST	GTMNB4		;COUNTS ARE OFF - REQUEUE THIS REQUEST
				;(CAN HAPPEN IF SCHED GIVES MON BUF TO A USER WHO IS
				;SWAPPED, AND  NEXT MON BUF IS RELEASED- MQFRE1 IS OFF)
GTMNB3:	HRROS	(T1)		;MARK BUFFER AS TAKEN
	SCHEDULE
	HRLI	T1,MBLKSZ##	;SET T1 AS AN IOWD FOR THE BUFFER
	MOVEM	T1,DEVMBF##(F)	;SAVE IOWD IN DDB
	LDB	T2,PJOBN##	;JOB NUMBER
	MOVEM	T2,MBFJOB##(T1)	;SAVE IN BUFFER
	PJRST	MBFCNT		;COUNT CURRENT NO OF MON BUFS AND RETURN
GVMNBX::
IFN FTDSIM,<
	TLNE	S,IOSDA		;HAVE DA?
	POPJ	P,		;YES, KEEP MON BUF
>
;SUBROUTINE TO RTURN MONITOR BUFFER
;ENTER WITH DEVMBF(F)= LOC OF MONITOR BUFFER
GVMNB0::SKIPN	T1,DEVMBF##(F)	;LOC OF MON BUFFER
	STOPCD	CPOPJ##,DEBUG,DHB, ;++DON'T HAVE BUFFER


;SUBROUTINE TO RETURN THE MONITOR BUFFER
;ENTER WITH T1 = ADDRESS OF THE BUFFER
;(PRESERVES T3 ON THE SLY)
GVMNBF::HRRZS	(T1)		;MARK BUFFER FREE
	HRLZS	MBFJOB##(T1)	;SAVE LAST USER
	PUSHJ	P,MQFREE##	;BUMP COUNT OF FREE BUFFERS
	TLZ	S,IOSRIB	;NO LONGER HAVE RIB IN MONITOR BUFFER
	SETZM	DEVMBF##(F)	;NO LONGER HAVE MONITOR BUFFER

;COUNT THE NUMBER OF FREE MONITOR BUFFERS
;NEEDED SINCE IF 2 JOBS GIVE UP 2 DIFFERENT MON BUFS BEFORE THE SCHEDULER HAS LOOKED AT MQREQ
;ONLY 1 JOB WILL BE GIVEN A MON BUF, AND THE OTHER BUF WILL NOT BE USED AGAIN
MBFCNT:	SKIPE	DINITF##	;ONCE-ONLY?
	PJRST	STRIOS		;YES--RETURN
	SETOM	MQFRE1##	;INITIALIZE COUNT
	HRRZ	T2,BUFLST##	;LOC OF 1ST MON BUF
	SKIPL	T2,(T2)		;FREE?
	AOS	MQFRE1##	;YES. INCREMENT NO OF FREE BUFS-1
	HRRZS	T2		;ADR FIELD ALONE
	JUMPN	T2,.-3		;TEST NEXT MON BUF
	PJRST	STRIOS		;RETURN WITH MQFRE1=# OF MON BUFS -1
;SUBROUTINE TO GET THE MONITOR BUFFER, READ RIB INTO IT
;RETURNS CPOPJ IF ERROR, CPOPJ1 NORMALLY, T1=IOWD
BUFRIB::PUSHJ	P,GTMNBF	;GET MONITOR BUFFER
				;AND FALL INTO REDRIB
;SUBROUTINE TO READ THE PRIME RIB, T1=IOWD
;RETURNS CPOPJ IF ERROR, CPOPJ1 NORMALLY
REDRIB::JSP	T4,SAVUN	;PUSH U, SET UP U FOR RIB
	PUSHJ	P,PRMRIB	;SET UP TO READ THE PRIME RIB
	SKIPN	T1,DEVMBF##(F)	;GET IOWD TO MONITOR BUFFER
	STOPCD	RESUNI,DEBUG,MHB, ;++MUST HAVE BUFFER
	PUSHJ	P,MONRED	;READ THE RIB INTO MON BUF
	PUSHJ	P,RIBCHK	;CHECK RIB
	  JRST	RESUNI		;RIB ERR - NON SKIP RETURN
	AOS	-1(P)		;GOOD RIB - SET FOR SKIP RETURN
				;FALL INTO RESUNI AND RETURN

;SUBROUTINE TO RESTORE DEVUNI
;ENTER WITH CURRENT U SAVE ON PD LIST
RESUNI:	POP	P,U		;CURRENT U
	SKIPE	DEVUNI##(F)	;UNLESS UNIT(STR) WAS REMOVED
	HRRM	U,DEVUNI##(F)	;SAVE IN DDB
	POPJ	P,		;AND RETURN


;SUBROUTINE TO WRITE A RIB
WRTRIB::PUSHJ	P,SAVE1##
	PUSH	P,U		;SAVE CURRENT UNIT
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	JUMPE	T1,WRTRB1
	MOVE	P1,ACCSTS##(T1)	;STATUS OF FILE
	TRNN	P1,ACPUPD	;UPDATE?
	JRST	WRTRB1		;NO
	MOVE	T4,DEVMBF##(F)	;MON BUF
	SKIPE	T3,ACCWRT##(T1)	;NO OF BLOCKS IN FILE
	SUBI	T3,1
	LSH	T3,BLKLSH##	;CONVERT TO WORDS
	HRRZ	T2,T1
	LDB	T1,ACYLBS##	;SIZE OF LAST BLOCK
	ADD	T3,T1		;NO OF WORDS IN FILE
	MOVEM	T3,RIBSIZ##+1(T4)  ;SAVE IN RIB
	MOVE	T1,ACCALC##(T2)	;NO OF BLOCKS ALLOCATED
	EXCH	T1,RIBALC##+1(T4)  ;SAVE IN RIB
	CAMN	T1,RIBALC##+1(T4)  ;DID THE SIZE CHANGE?
	JRST	WRTRB1		;NO
	SETZ	P1,		;YES, SET P1=0 AS A FLAG
	PUSHJ	P,RIBSAT##	;YES, WRITE CHANGED SATS (IN CASE OF A CRASH)
;HERE WITH SATS WRITTEN IF NECCESSARY
WRTRB1:	LDB	T2,DEYRBU##	;GET CURRENT RIB LOGICAL UNIT NUMBER
	PUSHJ	P,NEWUNI	;SET UP U,DEVUNI
	STOPCD	RESUNI,DEBUG,NXU, ;++NON X UNIT
	LDB	T2,DEYRBA##	;GET CURRENT RIB CLUSTER ADDRESS
	LDB	T3,UNYBPC##	;BLOCKS PER CLUSTER, THIS UNIT
	IMUL	T2,T3		;BLOCK NUMBER IN T2
	SKIPN	T1,DEVMBF##(F)	;GET IOWD TO MONITOR BUFFER
	STOPCD	RESUNI,DEBUG,NMB, ;++NEED MONITOR BUFFER
	MOVEM	T2,RIBSLF##+1(T1)  ;SAVE BLOCK NUMBER
	MOVEI	T3,CODRIB##
	MOVEM	T3,RIBCOD##+1(T1)  ;INDICATE BLOCK IS A RIB
	PUSHJ	P,MONWRT	;WRITE HE MON BUF
IFN FTDMRB,<
	JUMPN	P1,WRTRB3	;IF AN UPDATE FILE
	SKIPL	P1,DEVRIB##(F)	; AND IN EXTENDED RIB
	JRST	WRTRB3
	PUSH	P,RIBALC##+1(T1)  ;SAVE RIBSIZ, RIBALC
	PUSH	P,RIBSIZ##+1(T1)
	PUSHJ	P,REDRIB	;READ THE PRIME RIB
	  JRST	[POP P,(P)	;RIB ERROR
		 POP P,(P)
		 JRST WRTRB2]
	POP	P,RIBSIZ##+1(T1)
	POP	P,RIBALC##+1(T1)  ;RESTORE RIBSIZ, RIBALC
	PUSHJ	P,RIBAD		; FOR USE IN CASE OF CRASH
	JSP	T4,RIBUN
	PUSHJ	P,MONWRT	;REWRITE PRIME RIB
WRTRB2:	MOVEM	P1,DEVRIB##(F)
	PUSHJ	P,RIBCUR	;REREAD EXTENDED RIB
	  JFCL
WRTRB3:>	;END FTDMRB
	POP	P,U		;RESTORE CURRENT UNIT
	HRRM	U,DEVUNI##(F)	;AND SAVE IN DDB
	POPJ	P,		;AND RETURN
;SUBROUTINE TO SET UP TO READ THE PRIME RIB
;RETURNS CPOPJ WITH DEVRIB SET UP IN DDB
PRMRIB::PUSHJ	P,RIBAD		;COMPUTE ADR OF RIB
	SETZM	DEVRIB##(F)	;CLEAR DEVRIB FOR DPB'S
	LDB	T3,UNYLUN##	;GET RPIME RIB LOGICAL UNIT NUMBER
	DPB	T3,DEYRBU##	;DEPOSIT IN DDB
	PUSH	P,T2		;SAVE T2
	HRRZ	T2,DEVACC##(F)	;GET ADDRESS OF A.T.
	MOVE	T2,ACCPT1##(T2)	;GET FIRST POINTER FOR FILE
	LDB	T3,STYCLP##(T4)	;GET CLUSTER ADDRESS
	DPB	T3,DEYRBA##	;DEPOSIT IN DDB
	PJRST	T2POPJ##	;RESTORE T2 AND RETURN


;SUBROUTINE TO SAVE CURRENT DEVUNI
;U CHANGED, ALL OTHER ACS RESPECTED
;SAVES THE CURRENT U ON THE PUSH DOWN LIST
;ENTER AT SAVUN TO SAVE CURRENT U, AT RIBUN JUST TO SET U FOR RIB UNIT
;CALLED WITH JSP T4
SAVUN::	PUSH	P,U		;SAVE CURRENT U
RIBUN::	HLRZ	U,DEVUNI##(F)	;UNIT OF RIB
	HRRM	U,DEVUNI##(F)	;SAVE AS CURRENT UNIT
	JRST	(T4)		;AND RETURN


;SUBROUTINE TO COMPUTE A RIB ADDRESS FROM THE ACCESS TABLE
;EXIT WITH T2=BLOCK NUMBER, T4=LOC OF STR DATA BLOCK
;T1 RESPECTED
RIBAD::	HRRZ	T2,DEVACC##(F)	;LOC OF ACCESS TABLE
	MOVE	T2,ACCPT1##(T2)	;GET 1ST POINTER FROM A.T.

;SUBROUTINE TO COMPUTE A DISK ADDRESS FROM A GROUP POINTER
;ENTER WITH GROUP POINTER IN T2
;EXIT WITH T2=BLOCK NUMBER, T4=LOC OF STR DATA BLOCK
;T1 RESPECTED
GRPAD::	MOVE	T4,UNISTR##(U)	;GET BYTE POINTER FOR ADDRESS OF CLUSTER
	LDB	T2,STYCLP##(T4)	;CLUSTER ADDRESS
	LDB	T3,UNYBPC##	;COMPUTE BLOCK ADDRESS (NOTE THAT
	IMUL	T2,T3		; RELATIVE BLOCK 0 OF 1ST POINTER IS RIB LOC)
	POPJ	P,		;AND RETURN
;SUBROUTINE TO READ A UFD RIB
;ENTER WITH T2=BLOCK NUMBER
;RETURNS CPOPJ IF ERROR, CPOPJ1 NORMALLY WITH T1=IOWD, T2=BLOCK
UFDRED::MOVE	T1,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	PUSHJ	P,MONRED	;READ THE RIB
	MOVE	T4,T2		;BLOCK NUMBER (FOR RIBERR)
	JUMPN	T3,RIBERR	;CHECK FOR ERRORS DETECTED IN MONRED
	CAME	T2,RIBSLF##+1(T1)	;CHECK BLOCK NUMBER
	JRST	RIBERR		;BAD
	MOVEI	T3,CODRIB##	;OK. CHECK RIB CODE WORD
	CAME	T3,RIBCOD##+1(T1)
	JRST	RIBERR		;BAD
	HLRZ	T3,RIBEXT##+1(T1)	;OK. CHECK EXT="UFD"
	CAIN	T3,(SIXBIT .UFD.)
	SKIPA	T3,RIBNAM##+1(T1) ;OK, GET PPN
	JRST	UFDRE2		;NOT "UFD", CHECK IF "SFD"
	CAME	T3,DEVPPN(F)	;UFD, CHECK PPN
	CAMN	T3,DEVFIL(F)
	SKIPA	T3,RIBSTS##+1(T1)	;OK, GET STATUS WD
	JRST	RIBERR		;BAD
	TROE	T3,RIPABC##	;RIPABC ON?
	PJRST	CPOPJ1##	;YES
	MOVEM	T3,RIBSTS##+1(T1)	;NO, LIGHT IT (UFD WRITTEN BY OLDER MON)
	PUSHJ	P,MONWRT	;REWRITE THE UFD RIB

	JRST	CPOPJ1##	;OK, RETURN

;HERE IF EXTENSION ISN'T "UFD"
UFDRE2:
IFN	FTSFD,<
	CAIE	T3,(SIXBIT .SFD.) ;IS IT "SFD"?
	JRST	RIBERR		;NO, BAD RIB
	HRRZ	T3,DEVSFD##(F)	;YES, GET NAME OF SFD
	MOVE	T3,NMBNAM##(T3)	; FROM ITS ACCESS TABLE
	CAMN	T3,RIBNAM##+1(T1) ;CHECK NAME IN RIB
	JRST	CPOPJ1##	;OK, SKIP-RETURN
>
	JRST	RIBERR		;ERROR


;SUBROUTINE TO READ A RIB INTO THE MONITOR BUFFER
;ENTER WITH T2 = DISK ADDRESS OF RIB
;RETURNS CPOPJ IF ERROR, CPOPJ1 NORMALLY
RIBRED::MOVE	T1,DEVMBF(F)	;T1=IOWD FOR THE DATA
	PUSHJ	P,MONRED	;READ THE RIB
				;AND FALL INTO RIBCHK
;SUBROUTINE TO CHECK THE VALIDITY OF A RIB
;ENTER WITH T1 = IOWD, T2 = DISK ADDRESS
;RETURNS CPOPJ IF ERROR, CPOPJ1 NORMALLY, T1=IOWD
RIBCHK:	MOVE	T4,T2		;BLOCK (FOR RIBERR)
	TRNN	T3,IOIMPM+IODTER+IODERR+IOBKTL	;ERROR BIT FORM READ?
	CAME	T2,RIBSLF##+1(T1)	;BLOCK NUMBER IN RIB RIGHT?
	JRST	RIBERR		;NO. ERROR
	MOVEI	T2,CODRIB##	;YES. IS THIS BLOCK A RIB?
	CAME	T2,RIBCOD##+1(T1)
	JRST	RIBERR		;NO. ERROR
	MOVE	T2,DEVFIL(F)	;YES. FILE NAME
	CAME	T2,RIBNAM##+1(T1)	;MATCH NAME IN RIB?
	JRST	RIBERR		;NO. ERROR
	HLLZ	T2,DEVEXT(F)	;YES. FILE EXTENSION
	HLLZ	T3,RIBEXT##+1(T1)	;EXT STORED IN RIB
	CAME	T2,T3		;MATCH?
	JRST	RIBERR		;NO. ERROR
	HRRZ	T3,RIBFIR##+1(T1)	;YES. REL LOC OF 1ST PNTR IN RIB
	CAILE	T3,BLKSIZ##-2	;LEGAL?
	JRST	RIBERR		;NO. ERROR
	MOVE	T2,DEVPPN(F)	;YES. PPN OF FILE
	CAME	T2,RIBPPN##+1(T1)	;MATCH PPN IN RIB?
	JRST	RIBERR		;NO,RIB ERR
	TLNN	F,RENMB		;DON'T CHECK RIBUFD ON RENAME
				;  ONLY ON RENAME FOR EXTENDED RIBS
	PUSHJ	P,GTUFR##	;YES, COMPUTE RIBUFD WORD
	  PJRST	CPOPJ1##		;NOT YET SET UP, ASSUME OK
	CAMN	T2,RIBUFD##+1(T1)	;MATCH?
	PJRST	CPOPJ1##	;YES, OK RETURN
	ADDI	T2,1		;THE OLD REFRESHER PUT THIS NUMBER 1 TOO LOW
	CAMN	T2,RIBUFD##+1(T1)	; SO ALLOW THAT CASE TO WIN
	PJRST	CPOPJ1##
	MOVE	T4,RIBSLF##+1(T1)  ;RESTORE BLOCK NUMBER
;HERE WHEN THE RIB INFORMATION IS NOT CORRECT.
RIBERR::MOVEI	T1,UNPRER##	;SET UP A BIT
	ADDM	T1,UNIMCT##(U)	;COUNT IN SOFTWARE-ERROR WORD FOR UNIT
	TDO	S,[XWD IOSSCE##,IOIMPM]	;LIGHT ERROR BITS
IFN FTDAEM,<
	SKIPGE	UNIECT##(U)	;IF NOT IN ERROR RECOVERY
	MOVEM	T4,UNIHBN##(U)	; SAVE BLOCK FOR DAEMON
	MOVEI	T1,.ERDPE	;SAY DISK ERROR TO DAEMON
	HRL	T1,F		;PUT DDB ADDR IN LH FOR DAEMON
	PUSHJ	P,DAEERR##	;AND CALL DAEMON LOG ERROR
>
IFN FTDBAD,<
	PUSHJ	P,SAVE2##	;SLFND USES P-ACS
	MOVE	T1,UNISTR##(U)	;STR LOC
	MOVE	T1,STRNAM##(T1)	;STR NAME
	MOVE	P1,U		;SRSTR WIPES U
	PUSHJ	P,SRSTR##	;FIND STR NUMBER
	  JRST	STRIOS		;WHAT???
	MOVE	U,P1		;RESTORE U
	HRRZ	T1,T4		;STR NUMBER
	MOVE	P2,SYSSRC##	;THIS STR IN SYS SEARCH-LIST?
	PUSHJ	P,SLFNA##
	  PJRST	STRIOS		;NO
	AOS	T1,RIBTOT##	;YES, COUNT AN ERROR
	CAMG	T1,RIBECT##	;ABOVE THE THRESHOLD?
	PJRST	STRIOS		;NO, DONT TELL OPR
	PUSH	P,U		;YES, INFORM THE OPR
	HRRZ	U,OPRLDB##	;WHERE TO TYPE THE MESSAGE
	PUSHJ	P,INLMES##
	ASCIZ	/
RIB ERROR ON /
	PUSHJ	P,PRTDDB##	;"STR:NAM.EXT[PPN]"
	PUSHJ	P,PCRLF##
	POP	P,U		;RESTORE U
>	;END FTDBAD CONDITIONAL
	PJRST	STRIOS		;STORE S AND RETURN
;SUBROUTINE TO WRITE A BLOCK (OR SERIES OF BLOCKS)
;ENTER WITH T1= IOWD   T2=BLOCK NUMBER
MONWRT::PUSH	P,S		;SAVE S
	TLO	S,IO		;INDICATE WRITING
	PJRST	MONIO		;DO IO


;SUBROUTINE TO READ A BLOCK (OR SERIES OF BLOCKS)
;ENTER WITH T1 = IOWD FOR THE DATA   T2= BLOCK NUMBER
;RETURNS WITH T2 = BLOCK NUMBER READ, T1 = IOWD,
; AND T3=ERROR BITS SET ON THIS OPERATION
;INSTEAD OF ERROR RETURN - S SET WITH ERROR BITS IN RH. U AND F SET UP
MONRED::PUSH	P,S		;SAVE S
	TLZ	S,IO		;INDICATE READING
MONIO:	TRNE	S,IOACT		;IO IN PROGRESS?
	STOPCD	.,STOP,IIP,	;++ IO IN PROGRESS - ERROR
	SKIPGE	T2
	STOPCD	.,STOP,BIN,	;IO TO A NEGATIVE BLOCK #
	MOVEI	T3,IODTER	;SET FOR ERROR
	CAML	T2,UNIBPU##(U)	;REQUESTED BLOCK ABOVE HIGHEST ON UNIT?
	JRST	MONIO2		;YES. ERROR RETURN
	TRZ	S,IOIMPM+IOBKTL+IODTER+IODERR	;ZERO THE TEMP ERR BITS
	TLO	S,IOSMON	;INDICATE MONITOR IO
	MOVEM	S,DEVIOS(F)	;STORE NEW S IN DDB
	PUSH	P,DEVDMP##(F)	;SAVE CURRENT DEVDMP
	MOVEM	T1,DEVDMP##(F)	;IOWD TO READ THE DATA
	PUSH	P,DEVBLK##(F)	;SAVE CURRENT BLOCK NUMBER
	MOVEM	T2,DEVBLK##(F)	;BLOCK WE WANT TO READ
	PUSHJ	P,UNICHK	;MAKE SURE UNIT IS OKAY.
	  JRST	MONIO1		;NO GOOD - WRITING FROM MON-BUF, UNIT OFF LINE
	HRRZ	J,UNIKON##(U)	;LOC OF KONTROLLER DATA BLOCK
	PUSHJ	P,UUOPWQ	;GO PUT IN QUEUE STRUCTURE
	PUSHJ	P,PWAIT1	;WAIT T1LL DATA IS IN
MONIO1:	ANDI	S,IOIMPM+IODERR+IODTER+IOBKTL	;GET ERROR BITS FROM S
	MOVE	T3,S		;AND SAVE IN T3
	MOVE	T2,DEVBLK##(F)	;RESTORE BLOCK NO. TO T2
	MOVE	T1,DEVDMP##(F)	;AND IOWD TO T1
IFN FTDUAL,<
	HRRZ	U,DEVUNI##(F)	;RESET U
>
	POP	P,DEVBLK##(F)	;RESTORE THE CHANGED STUFF TO THE DDB
	POP	P,DEVDMP##(F)
MONIO2:	POP	P,S
	OR	S,T3		;SET ANY ERROR BITS INTO S
STRIOS::MOVEM	S,DEVIOS(F)
	POPJ	P,		;AND RETURN TO CALLER
IFN FTDHNG,<
;HERE IF THE MONITOR CALLS FILSER ON A HUNG DEVICE
HNGDSK::MOVE	U,DEVUNI##(F)	;UNIT DB
	JUMPE	U,CPOPJ##	;JUST IN CASE F/S HAS BEEN JERKED OUT
IFN FTDUAL,<
	HRRZ	U,DEVCUR##(F)
>
IFN FTDHIA,<
	LDB	J,PJOBN##	;SET UP J
	PUSHJ	P,FNDPDB##	;SET UP W
	  JRST	HNGDSD		;MUST BE SWAPPER
	CAME	F,.PDDIA##(W)	;IN DIAG?
	JRST	HNGDSD		;NO
	SOSGE	DEVDIA##(F)	;YES, HUNG TIME GONE?
	JRST	DIACLR		;YES, RESTART THE IO ON THE CHANNEL
	AOS	(P)		;NO, SET FOR OK RETURN
	MOVEI	T1,7		;SET FOR 2-MINUTE INTERVALS
	DPB	T1,PDVTIM##
	PJRST	SETHNG##	;RESET HUNG TIMER AND KEEP ON GOING
HNGDSD:>
IFN FTVM,<
	SKIPL	DEVSWP(F)	;SWAPPER?
	JRST	HNGDSX
	SETZ	J,		;YES, INDICATE "UUO" LEVEL
	PUSHJ	P,SWPSCN##	;START IO AGAIN
	  AOSA	(P)
	PJRST	CPOPJ1##	;OK, NO MSG
	PJRST	SWPHNG##
HNGDSX:>
	HRRZ	J,UNIKON##(U)	;KONTROLLER DB
	SKIPE	T1,UNISTS##(U)	;STATUS OF UNIT
	CAIN	T1,TWCOD##	;TW OR IDLE?
	SKIPL	@KONCHN##(J)	;YES. IS CHAN FREE?
	JRST	HNGDS0		;NO
	AOS	UNIHNG##(U)	;COUNT TOTAL NUMBER OF HUNG TIMEOUTS
	AOS	(P)		;SET FOR NO ERROR MESSAGE (WE RECOVERED)
	HRRZ	P1,KONCHN##(J)	;SET P1 TO CHAN DB LOC
	JUMPE	T1,UUOTWQ	;GO START I/O IF UNIT IS IDLE
	PJRST	PIKTRN		;TW- REMOVE FILE FROM CHAN Q AND START IO
;HERE IF UNIT NOT IN IDLE OR TW, OR CHAN NOT FREE
HNGDS0:	CAIGE	T1,OWCOD##	;UNIT IN OPERATOR WAIT?
	JRST	HNGDS7		;NO, TEST FOR T OR P STATE
	SKIPL	KONPOS##(J)	;DOES KONTROLLER POSITION?
	JRST	HNGD0A		;YES
	SETZM	UNISTS##(U)	;NO, HENCE NO FREE INTERRUPT
	CAIN	T1,OWCOD##	; RETRY OPERATION IF OW
	PUSHJ	P,UUOPWQ	; SINCE UNIT MIGHT HAVE BEEN FIXED
	PJRST	CPOPJ1##	;AND RETURN WITH NO MESSAGE
HNGD0A:
	LDB	J,PJOBN##	;YES, GET JOB NUMBER
	JUMPE	J,CPOPJ1##	;SWAP I/O
	PUSH	P,F		;SAVE FILE IN QUESTION
	HRRZ	F,TTYTAB##(J)	;HUNG JOB'S TTY DDB
	PUSHJ	P,CTLJBD##	;FIND THE CONTROLLING JOB IF THERE IS ONE
	POP	P,F		;RESTORE POINTER TO DSK DDB
	HRRZ	U,DEVUNI##(F)	;RESTORE UNIT
	SKIPG	T1		;SKIP IF THE CURRENT JOB IS CONTROLLED
	TDZA	T2,T2		;IF NOT CONTROLLED, THE CONTROLLING JOB ISN'T SWAPPED
	MOVE	T2,JBTSTS##(T1)	;JOB STATUS OF THE CONTROLLING JOB
	MOVE	T1,JBTSTS##(J)	;STATUS OF JOB
	TLNN	T2,SWP		;IS IT SWAPPED OUT?
				; IF YES, HUNG DEVICE MESSAGE (ELSE THIS IS
				;  DEADLY EMBRACES
	TLNE	T1,CNTRLC	;^C TYPED?
	JRST	HNGDS3		;YES, GIVE HUNG DEVICE
	TLNE	S,IOSHMS	;NO, MESSAGE ALREADY TYPED?
	JRST	HNGDS2		;YES, DONT TYPE IT AGAIN
	PUSH	P,F		;NO, SAVE F
	PUSHJ	P,TTYFND##	;FIND USER'S TTY
	PUSHJ	P,INLMES##	;TYPE THE MESSAGE:
	ASCIZ	/
DISK IS OFF-LINE, WAITING FOR OPERATOR ACTION
TYPE ^C TO GET HUNG MESSAGE (IN 15 SECONDS).
DON'T TYPE ANYTHING TO WAIT FOR THE OPERATOR TO FIX THE DRIVE.
/
	PUSHJ	P,FLSDR##	;DOES HE HAVE A RESOURCE?
	  JRST	HNGDS1		;NO
	PUSHJ	P,INLMES##	;YES, TELL HIM HE'S HUNG THE SYSTEM
	ASCIZ	/(THE SYSTEM WILL DO NO USEFUL WORK UNTIL THE
DRIVE IS FIXED OR YOU TYPE ^C)
/
HNGDS1:	POP	P,F		;RESTORE F
HNGDS2:	MOVE	S,DEVIOS(F)	;S BITS
	TLO	S,IOSHMS	;BIT INDICATING MSG WAS TYPED
	PUSHJ	P,STOIOS##	;SAVE S, RESET HUNG TIME
	PJRST	CPOPJ1##	;RETURN WITH NO ERROR MESSAGE


;HERE IF ^C WAS TYPED - FINISH OUT THE OPERATION
HNGDS3:	DSKOFF
	PUSHJ	P,RETRES	;GIVE UP MONITOR RESOURCES
	LDB	T1,DEYCOD##	;STATE OF FILE (FORMER STATE OF UNIT)
	CAIE	T1,TCOD##	;TRANSFER
	CAIN	T1,PCOD##	; OR POSITION?
	JRST	HNGDS6		;YES
	HRRZ	U,DEVUNI##(F)	;NO, IN A QUEUE
	PUSHJ	P,SAVE2##	;SAVE P1,P2
	MOVEI	P2,MINDVQ##(T3)	;P2=1ST POSSIBLE PRED

;HERE TO FIND ACTUAL PREDECESSOR
HNGDS5:	HLRZ	P1,DEVQUE##(P2)	;FILE THIS ONE POINTS TO
	CAIN	P1,(F)		;POINTING TO OUR FILE?
	JRST	HNGD6A		;YES, GO UNQUEUE
	SKIPE	P2,P1		;NO, LOOK AT NEXT IN Q
	JRST	HNGDS5
	MOVEI	T1,O2COD##	;COULDNT FIND PREDECESSOR (SYSTEM ERROR?)
	MOVEM	T1,UNISTS##(U)	;SET UNIT INTO OPR WAIT
	DSKON		;RESTORE PIS
	POPJ	P,		;AND RETURN

HNGD6A:	MOVE	J,UNIKON##(U)
	SKIPA	P1,KONCHN##(J)
;HERE IF FILE WAS IN POSITION OR TRANSFER STATE
HNGDS6:	AOSA	UNISTS##(U)	;CHANGE UNIT STATE TO O (FROM OW)
				;(INDICATING DONT START IO ON FREE INTERRUPT)
	PUSHJ	P,UNQUEX	;UNQUEUE THE REQUEST
	DSKON
	POPJ	P,		;AND GIVE ERROR MESSAGE RETURN
;STILL IN FTDHNG CONDITIONAL
;HERE IF UNIT MAY BE IN TRANSFER OR POSITION STATE
HNGDS7:	PUSHJ	P,SAVE1##	;SAVE P1
	HRRZ	T1,UNICDA##(U)	;DDB WE'RE TALKING TO
	CAIE	T1,(F)		;SAME AS THIS DDB?
	JRST	HNGD7B		;NO, IT MUST BE IN A QUEUE
	AOS	T1,UNIRCV##(U)	;YES, COUNT NUMBER OF ATTEMPTS AT RECOVERY
	CAIG	T1,10		;TRIED ENOUGH?
	JRST	HNGD7A		;NO, TRY AGAIN
HNGDWN:	HRRZ	P1,KONCHN##(J)	;YES, SET UP P1
	MOVEI	T1,KOPOFL##	;TELL BADUNI TO GRUMBLE AT OPR
	PUSH	P,U
	PUSHJ	P,BADUNI	;GIVE UP, SHOUT AT OPR OVER THIS UNIT
	POP	P,U
	AOS	UNISTS##(U)	;SET STATE OCOD INSTEAD OF OWCOD
	MOVSI	S,IOSMON
	ANDCAB	S,DEVIOS(F)	;MAKE SURE IOSMON=0
	SKIPE	DEVRHB##(F)	;IF NOT REREADING HOME BLOCKS,
	POPJ	P,		; LET USER GET HUNG DEVICE MESSAGE
	PUSHJ	P,CLRDDB##	;REREADING HOME BLOCKS. RETURN THE DDB
	PJRST	CPOPJ1##	;AND DONT GIVE ERROR MESSAGE
HNGD7A:	SKIPL	UNIECT##(U)	;IN ERROR RECOVERY?
	JRST	HNGD7B		;YES, LEAVE REGS ALONE
	SETZM	UNIECT##(U)	;NO, SET SO DAEMON WILL BE CALLED ON RECOVERY
	SETZM	UNIERR##(U)
IFN FTRP04,<
	PUSHJ	P,@KONRRG##(J)	;GO READ ALL DRIVE REGISTERS NOW
	PUSHJ	P,FSTREG	;COPY REGISTERS TO UDB
>
HNGD7B:	MOVE	T1,UNISTS##(U)	;RESET T1=UNIT STATUS
	CAIE	T1,TCOD##	;IS UNIT IN TRANSFER STATE?
	JRST	HNGDS8		;NO
	MOVSI	P1,UNPHRC##	;ASSUME WE'LL RECOVER
	PUSHJ	P,@KONSTP##(J)	;STOP UNIT AND CAUSE AN INTERRUPT
	  MOVSI	P1,UNPHNR##	;COUNT NOT-RECOVERED INSTEAD
	ADDM	P1,UNIHNG##(U)
	MOVEM	T2,UNISOF##(U)	;STORE (BEFORE) CONI STATUS
	MOVEM	T3,UNISDI##(U)	;STORE (BEFORE) DATAI STATUS
	PUSHJ	P,STOIOS##	;RESTORE HUNG-TIME
	PJRST	CPOPJ1##	;SKIP RETURN - NO ERROR MESSAGE

;STILL IN FTDHNG CONDITIONAL
HNGDS8:	LDB	T2,DEYCOD##	;STATUS OF FILE
	CAIE	T2,PCOD##	;FILE IN TRANSFER?
	PJRST	CPOPJ1##	;NO, RETURN WITH NO ERROR MESSAGE
				;(UNIT PROBABLY HUNG, THIS JOB IN QUEUE)
	HRRZM	T1,UNISTS##(U)	;RESET SIGN BIT IF ON
	JUMPL	T1,HNGDWN	;GIVE UP IF DIDN'T RECOVER
	MOVEI	T2,UNPHPS##	;YES, INCREMENT HUNG POSITION COUNT
	ADDM	T2,UNIHNG##(U)
	DSKOFF
	SKIPG	KONTAB##(J)	;#KONTROLLER FREE?
	JRST	HNGDS9		;#NO, PUT IN QUEUE
	MOVSI	T1,400000	;#INDICATE PHUNG RECOVERY
	IORM	T1,UNISTS##(U)
	PUSHJ	P,SETHNG##
	PUSHJ	P,@KONRCL##(J)	;#TRY A RECAL
	  JRST	[MOVEI	T1,OWCOD##	;UNIT IS DOWN
		 MOVEM	T1,UNISTS##(U)	; SET UNISTS FOR
		 JRST	.+1]		; ONCE A MINUTE TYPEOUT
	DSKON			;#
	PJRST	CPOPJ1##	;AND RETURN WITH NO ERR MESSAGE
HNGDS9:	MOVEI	T1,PWCOD##	;#INDICATE UNIT IN PW
	MOVEM	T1,UNISTS##(U)	;#
	MOVEI	T1,UNIQUE##(U)	;#PUT FILE IN POSITION QUEUE
IFN FTVM,<
	HRRZ	P1,UNICHN##(U)	;POINT P1 AT CHAN BLOCK
>
	PUSHJ	P,PUTQUE	;# FOR THE UNIT
	PJRST	CPOPJ1##	;AND RETURN W/ NO MSG
>	;END CONDITIONAL ON FTDHNG
IFE FTDHNG,<
HNGDSK==:CPOPJ1##
>

;ROUTINE TO RETURN ANY RESOURCES A DDB HAS
;ENTER WITH JOB NUMBER IN J; EXITS WITH IOACT OFF IN DDB
RETRES::SKIPE	T1,DEVMBF##(F)	;HAVE MON BUF?
	PUSHJ	P,GVMNBF	;YES, RETURN IT
	TLNE	S,IOSDA		;HAVE DA?
	PUSHJ	P,DWNDA
	TLNE	S,IOSAU		;HAVE AU?
	PUSHJ	P,DWNAU
	JUMPE	J,CLRACT##
	CAMN	J,CBUSER##	;HAVE CB?
	PUSHJ	P,GVCBJ##
	PJRST	CLRACT##	;RESET IOACT + POPJ

;SUBROUTINE TO CALL WAIT1
;THIS IS NEEDED SINCE WAIT1 CLOBBERS P1-P4

;THIS INSTRUCTION IS USED TO RESTORE PWAIT1 AFTER RESTART (SEE WTSATS)
PWAITZ::PJRST	WAIT1##

PWAIT1:: PJRST	WAIT1##		;GO TO WAIT1
;HERE TO PUT A SWAPPING REQUEST IN THE QUEUE
;S,F,U SET, T2=IOWD FOR DATA, T1=LOGICAL BLOCK NUMBER


SWAPIO::
IFE FTVM,<
	TLO	S,IOSMON	;SET MONITOR I/O BIT
	HRRM	U,DEVUNI##(F)	;SAVE U (RESET IN UUOSET)
	MOVEM	T1,DEVBLK##(F)	;LOGICAL BLOCK NUMBER
	MOVEM	T2,DEVDMP##(F)	;IOWD
	MOVEM	S,DEVIOS(F)	;S
	PJRST	UUOPTR		;PUT REQUEST IN QUEUE AND RETURN
>	;END IFE FTVM
IFN FTVM,<
	SKIPE	SQREQ##		;ANY REQUESTS?
	SKIPL	DEVSWP(F)	;YES, IS THIS THE SWAPPER?
	STOPCD	.+1,DEBUG,SFU,	;++SWAPPER FOULED UP
	MOVE	S,[IOSMON,,IOACT] ;OK, INDICATE ACTIVE MONITOR IO
	MOVEM	S,DEVIOS(F)
	MOVEI	J,0		;INDICATE ON UUO LEVEL
	PJRST	SWPSCN##	;GO CRANK THINGS UP
>	;END FTVM
SUBTTL UUO LEVEL MODULE
IFN FTDSEK,<
;HERE TO START A SEEK
UUOSEK::PUSHJ	P,VALUUO	;DSK CHAN?
	  POPJ	P,		;NO
	HRRZ	T1,DEVACC##(F)	;IF NOT SUPER I/O,
	TLNN	S,IOSUPR
	JUMPE	T1,CPOPJ##	; DO NOTHING IF LOOKUP/ENTER NOT DONE
	PUSHJ	P,UUOSET	;YES, SET UP U, J AND GET NEXT BLOCK
	  POPJ	P,		;EOF - RETURN
	SKIPL	KONPOS##(J)	;DOES CONTROLLER POSITION?
	SKIPE	UNISTS##(U)	;YES. IS UNIT IDLE?
	POPJ	P,		;NO. IGNORE SEEK REQUEST
IFN FTDHIA,<
	SKIPE	DIADSK##
	POPJ	P,
>
	NOSCHEDULE		;YES. THIS CODE MUST BE INTERLOCKED
	DSKOFF			;SINCE WE ARE DIDDLING QUEUES
	SKIPL	KONTAB##(J)	;#IS CONTROL BUSY
	JRST	UUOSK1		;#NO, START POSITION
	MOVEI	T1,SWCOD##	;#YES, PUT UNIT INTO SW
	MOVEM	T1,UNISTS##(U)	;#PUT FILE INTO SW/PW QUEUE
IFN FTVM,<
	PUSHJ	P,SAVE1##	;PUT QUE USES CHNWAT(P1)
	MOVE	P1,KONCHN##(J)	; SO SET P1 TO CHAN DB LOC
>
	JRST	UUOPW3		;#FOR THIS UNIT AND RETURN

;HERE WHEN CONTROLLER IS FREE - START POSITION (UNLESS UNIT ALREADY POSITIONED)
UUOSK1:	PUSHJ	P,CYLCOM	;#COMPUTE DISTANCE TO TARGET CYLINDER
	JUMPE	T1,SEKRET	;#ALREADY THERE IF DISTANCE =0
	MOVEI	T1,SCOD##	;#NOT POSITIONED, PUT UNIT INTO S STATE
	MOVEM	T1,UNISTS##(U)	;#
	PJRST	STRPS1		;#START POSITION AND RETURN

;HERE IF UNIT IS ALREADY POSITIONED - TURN ON PI AND RETURN
SEKRET:	DSKON			;#
	SCHEDULE
	POPJ	P,		;RETURN
>				;END CONDITIONAL ON FTDSEK
;SUBROUTINE TO ENSURE THAT A CALLI IS FOR A DSK CHAN
;RETURNS CPOPJ IF NOT, CPOPJ1 IF SO
VALUUO::LDB	T1,PUUOAC##
	CAMG	T1,USRHCU##	;CHAN NO LEGAL?
	SKIPN	F,USRJDA##(T1)	;YES, DEVICE ASSIGNED?
	JRST	IOIERR##	;NO, "IO TO UNASSIGNED CHAN"
VALUUX:	MOVE	T1,DEVMOD(F)	;IS DEVICE A DSK?
	TLNN	T1,DVDSK
	POPJ	P,		;NO, IMMEDIATE RETURN
	MOVE	S,DEVIOS(F)
	PJRST	CPOPJ1##	;YES, SKIP RETURN
UUOPTR:	PUSHJ	P,UUOSET	;SET U, J  AND GO TO NXTBLK
	  POPJ	P,		;EOF OR QUOTA EXHAUSTED

UUOPWQ::JUMPN	U,UUOPWR	;JUST IN CASE F/S HAS BEEN JERKED OUT
	TRO	S,IOIMPM	;   LIGHT ERROR BIT
	PJRST	STOIOS##
UUOPWR:
IFN FTDPRI,<
	MOVE	T1,DEVPRI##(F)	;DISK - PRIORITY WORD
	TRNE	T1,DEPUUO	;PRIORITY SET BY UUO?
	JRST	UUOPWS		;YES
	LDB	T1,PJOBN##	;NO, GET DISK-PRIORITY OF JOB
	LDB	T1,JBXPRI##
	DPB	T1,DEYPRI##	;AND SAVE IT IN DDB
UUOPWS:>
IFN FTDSUP,<	;SUPER USETI/USETO
	TLNN	S,IOSUPR	;SUPER USETI/USETO?
>
	SKIPE	DEVBLK##(F)	;NO. 0 BLOCK REQUESTED?
	JRST	UUOPWZ		;NO. OK
IFN FTRP04,<
	SKIPN	DINITF##	;RP04 READS BLOCK 0 TO CHECK FORMAT ERROR
>
	SKIPN	DEVUNI##(F)	;STR BEEN REMOVED?
	JRST	UUOPWZ	;YES, DON'T HALT
	MOVE	T1,DEVPPN(F)	;REQUESTING BLOCK 0 -
	CAME	T1,SYSPPN##	;[1,4]?
	JRST	UUOPWY		;NO - ERROR
	MOVE	T2,DEVFIL(F)	;SINCE HOME BLOCKS ARE WRITTEN AT THE FRONT OF
	CAME	T2,[SIXBIT .HOME.]	; THE DISK, CHECK FOR HOME[1,4]
UUOPWY:	STOPCD	.,JOB,IBZ,	;++I/O TO BLOCK ZERO
UUOPWZ:	PUSHJ	P,SAVE1##	;SAVE P1
UUOPW0:	HRRZ	P1,KONCHN##(J)	;SET P1 = CHANNEL DB
	TLZ	S,IOSHMS	;RESET HUNG-DEVICE MESSAGE BIT
	TRO	S,IOACT		;SET FILE ACTIVE(IO ACT=1)
	MOVEM	S,DEVIOS(F)	;CANT USE SETACT-IOW MAY BE ON
	NOSCHEDULE
	DSKOFF			;#TURN OFF ALL DSK CONTROLLER PI CHANS.
	SKIPG	T2,KONPOS##(J)	;#DOES KONTROL POSITION?
	PJRST	UUOTWQ		;#NO, PUT FILE TW OR T
	SKIPN	T1,UNISTS##(U)	;#IS UNIT IDLE?
	JRST	UUOPW1		;#YES,GO SET PW,P,TW, OR T
IFN FTMDA,<
	LDB	T3,PJOBN##	;NO, IS UNIT IN MDA WAIT?
	CAIN	T1,MDACOD##	; (AFTER FREE INTERRUPT, MDA SHOULD REREAD HOME BLOCKS)
	CAME	T3,MDCJOB##	;YES, IS THIS MDA?
	CAIA			;NO
	JRST	UUOTWQ		;YES, LET IT HAPPEN
>
	CAIE	T1,SWCOD##	;#NO,IS UNIT SW?
	JRST	UUOPW2		;#NO, SET FILE PW
	SETZB	T1,UNIQUE##(U)	;#YES. ERASE QUEUE FOR UNIT
				;#CAN ONLY BE 1 SEEK WAITER IF ANY FILE IN SW/PW QUEUE
	MOVEM	T1,UNISTS##(U)	;#AND SET UNIT STATE=I
UUOPW1:
IFN FTDHIA,<
	SKIPE	DIADSK##	;TRYING TO SHUT DOWN IO?
	CAME	P1,DIACHN##	;YES, FOR THIS CHAN?
	CAIA			;NO
	JRST	UUOPW2		;YES, JUST QUEUE THIS REQUEST
>
IFN FTRP04,<
	TLNN	T2,KOPPWX##	;UNIT/KONTROLLER POSITION WHILE TRANFERRING?
>
	SKIPL	KONTAB##(J)	;#IS KONTROL BUSY?
	JRST	UUOPOS		;#NO, PUT FILE P, TW OR T
IFN FTDUAL,<
	SKIPE	T1,UNI2ND##(U)	;IS THERE AN ALTERNATE PATH?
	SKIPE	UNISTS##(T1)	;YES, IS THE UNIT USEABLE?
	JRST	UUOPW2		;NO
	MOVE	T2,UNIKON##(T1) ;YES, T1=UNIT T2=KON
IFN FTDHIA,<
	HRRZ	T3,KONCHN##	;ALTERNATE CHAN
	SKIPE	DIADSK##	;DIAG IN PROGRESS FOR IT?
	CAME	T3,DIACHN##
>
	SKIPGE	KONTAB##(T2)	;KONTROLLER IDLE?
	JRST	UUOPW2		;NO
	HRRM	F,UNICDA##(U)	;YES, 1ST UNIT ALSO IS THIS DDB
	HRRZ	U,T1		;SET UP NEEDED ACS
	HRRZ	J,T2
	HRRZ	P1,KONCHN##(J)
	JRST	UUOPOS		;AND GO START SEEK (OR MAYBE XFER)
>
UUOPW2:	MOVEI	T1,PWCOD##	;#YES, PUT FILE PW
	SKIPN	UNISTS##(U)	;#UNIT IDLE?
	MOVEM	T1,UNISTS##(U)	;#YES SET UNIT PW
	DPB	T1,DEYCOD##	;#SET FILE PW
UUOPW3:	MOVEI	T1,UNIQUE##(U)	;#QUEUE ON WHICH TO INSERT FILE
	PJRST	PUTQUE		;#PUT FILE ON PWQ AND RETURN

UUOPOS:	PUSHJ	P,CYLCOM	;#IS UNIT ALREADY POSITIONED?
	JUMPN	T1,STRPOS	;#NO, START POSITIONING IF 0
	PJRST	UUOTWQ		;#YES, SET FILE+UNIT TO T, KONCHN TO B
				;# OR FILE+UNIT TO TW AND ADD TO TWQ
;SUBROUTINE TO CHECK STATUS OF A UNIT
;RETURNS CPOPJ1 IF OK (MAY HAVE HAD TO CALL HNGSTP)
;RETURNS CPOPJ IF NG - UNIT OFF-LINE, DDB HAS MON-BUF TO WRITE
UNICHK:	SKIPE	T1,UNISTS##(U)	;STATUS OF UNIT
	CAIGE	T1,MDACOD##	;OKAY ?
	PJRST	CPOPJ1##	;YES
IFN FTMDA,<
	MOVE	J,.C0JOB##	;NO, IS UNIT IN MDA WAIT
	CAMN	J,MDCJOB##	;AND THIS JOB=MDA?
	CAIE	T1,MDACOD##	;IF SO, LET MDA DO THE IO
>
	SKIPGE	DEVSWP##(F)	;IS IT THE SWAPPER?
	PJRST	CPOPJ1		;YES, LET IT TRY ANYWAY
	PUSHJ	P,SAVSTS	;SAVE A RECORD OF JOB'S RESOURCES
	  JRST	UNICH1		;HAS MON BUF AND WRITING - LOSE
	PUSHJ	P,HNGSTP##	;TELL OPR AND USER ABOUT THE PROBLEM
	POP	P,T3		;RECORD OF RESOURCES
	PUSHJ	P,RESSTS	;GET THEM AGAIN
	JRST	UNICHK		;AND TRY AGAIN

UNICH1:	TRO	S,IODERR	;LOSE - LIGHT ERROR BIT
	POPJ	P,		;AND RETURN

;SUBROUTINE TO MAKE A RECORD OF RESOURCES JOB OWNS
;RETURNS WITH THE RECORD ON THE PD LIST AND NO RESOURCES
;RETURNS CPOPJ IF HAS MON-BUF, ELSE CPOPJ1
; (CANT CONTINUE IF THE JOB HAS A MON-BUF SINCE IT HAS ALREADY SET UP
; THE IOWD IN THE DDB, MIGHT GET THE OTHER BUFFER BACK ON CONTINUE)
SAVSTS::SKIPE	T1,DEVMBF##(F)	;NO. HAVE MON BUF?
	POPJ	P,		;YES, THIS OPERATION LOSES
	MOVE	J,JOB##		;NO, OK TO ATTEMPT RECOVERY
	HLR	T1,S		;SAVE IOSDA,IOSAU BITS
	CAMN	J,CBUSER##	;JOB HAVE CB?
	TLO	T1,1		;YES, LIGHT A BIT
	PUSH	P,T1		;SAVE RECORD OF RESOURCES
	PUSHJ	P,RETRES	;GIVE UP ALL RESOURCES JOB OWNS
	POP	P,T1		;RECORD
	EXCH	T1,(P)		;PUT BACK ON STACK
	PJRST	1(T1)		;AND TAKE SKIP-RETURN

;SUBROUTINE TO GET BACK THE RESOURCES
;ENTER WITH T3 = THE RECORD AS SET BY SAVSTS
;PRESERVES T2
RESTS::
RESSTS: HRRZ	U,DEVUNI##(F)	;RESET U
	MOVE	S,DEVIOS(F)	;AND S
	TLNE	T3,1		;WANT CB?
	PUSHJ	P,GETCB##
	TLNE	T3,-200		;WANT MON BUF?
	PUSHJ	P,GTMNB		;YES
	TRNE	T3,IOSDA	;GET DA IF NEEDED
	PUSHJ	P,UPDA
	TRNE	T3,IOSAU	;GET AU IF NEEDED
	PUSHJ	P,UPAU
	POPJ	P,		;AND RETURN TO CALLER
;SUBROUTINE TO SET UP U AND J, EXIT TO NXTBLK (WHICH RETURNS CPOPJ 
;OR CPOPJ1 DEPENDING ON WHETHER ANOTHER BLOCK OF THE FILE EXISTS
UUOSET::HRRZ	U,DEVUNI##(F)	;SET U(UNIT DATA BLOCK)
	JUMPE	U,CPOPJ##	;JUST IN CASE F/S HAS BEEN JERKED OUT
	PUSHJ	P,UNICHK	;MAKE SURE UNIT IS OKAY.
	  POPJ	P,		;UNIT IS DOWN
	HRRZ	J,UNIKON##(U)	;SET J(KONTROL DATA BLOCK)
;FALL INTO NXTBLK,  GET THE NEXT BLOCK OF THE FILE AND RETURN

;SUBROUTINE TO OBTAIN THE NEXT BLOCK ADDRESS
;ENTER WITH J,F,U,S SET UP
;INTERRUPT LEVEL CHECKS BEFORE CALLING TO MAKE SURE STILL POINTERS IN CORE SO NO IO
;RETURNS CPOPJ IF EOF OR DISK FULL OR PNTR BLOCK FULL
;RETURNS CPOPJ1 IF OK
NXTBLK:	JUMPL	S,CPOPJ1##	;*RETURN IF A MONITOR READ
	MOVMS	DEVREL##(F)	;NEGATIVE DEVREL IS FLAG FROM USETI -N
	HRRZ	T1,DEVLFT##(F)	;*NO, NUMBER  OF BLOCKS LEFT IN CURRENT GROUP
	HRRZ	T2,DEVACC##(F)	;*YES. LOC OF A.T.
	MOVE	T2,ACCWRT##(T2)	;*ACTUAL NUMBER OF BLOCKS WRITTEN
	TLNE	S,IO+IOSUPR	;*READING?
	JRST	NXTBLA		;*NO
	CAMGE	T2,DEVREL##(F)	;*TRYING TO READ MORE THAN WAS WRITTEN?
	POPJ	P,		;*YES. TAKE EOF RETURN
	JRST	NXTBL0		;NO, CONTINUE
NXTBLA:	LDB	T3,DEYFNC##	;WRITING, FILE APPEND ONLY ?
IFN FTDSUP,<	;SUPER USETI/USETO
	TLNN	S,IOSUPR	;AND NOT SUPER USETO ?
>
	CAIE	T3,FNCAPP##
	JRST	NXTBL0		;NO
	CAML	T2,DEVREL##(F)	;YES.  WRITING IN THE MIDDLE ?
	POPJ	P,0		;YES, RETURN IOBKTL
NXTBL0:	SOJGE	T1,CPOPJ1##	;*NO, IF BLOCKS LEFT, RETURN (THIS PNTR OK)
IFN FTDSUP,<	;SUPER USETI/USETO
	TLNE	S,IOSUPR	;*SUPER USETI/USETO?
	POPJ	P,		;*YES - NO PNTRS TO READ
>


NXTBL1:	MOVSI	T2,1		;*DECREMENT NO. OF POINTERS
	SKIPG	DEVRSU##(F)	;* IF RIB WASNT ALREADY FULL
	ADDB	T2,DEVRSU##(F)	;*RIB NOW FULL?
	JUMPGE	T2,NXTB1B	;*YES, LIGHT IOBKTL
	AOS	T1,DEVRET##(F)	;*STEP TO NEXT POINTER IN CORE
	CAIG	T1,DEVRBN##(F)	;*RUN OUT OF IN-CORE POINTERS?
	JRST	NXTBL5		;*NO, CONTINUE
	MOVE	T1,DEVREL##(F)	;YES, UPDATE RELATIVE BLOCK NUMBER
	MOVEM	T1,DEVFLR##(F)	;OF LOWEST BLOCK IN DDB POINTERS
	HRRM	U,DEVFUN##(F)	;AND UNIT OF 1ST PNTR IN DDB
	TLNN	S,IO		;READING?
	JRST	NXTBL4		;YES
;HERE WHEN WRITING AND THE DDB POINTER SPACE IS FULL
	TLNN	F,OCLOSB	;OUTPUT CALLED BY CLOSE?
	JRST	NXTBL2		;NO. CONTINUE

;HERE IF THE OUTPUT IS FROM CLOSE
	SKIPN	DEVMBF##(F)	;HAVE MONITOR BUFFER?
	PUSHJ	P,GTMNBF	;GET MONITOR BUFFER
	PUSHJ	P,RIBCUR	;READ THE CURRENT RIB
	JUMPN	T3,CPOPJ##	;NON-ZERO T3 MEANS ERROR READING RIB
	PUSHJ	P,SPTRW		;SET AOBJN WORD FOR POINTERS
	MOVE	T4,T1		;SAVE ORIGINAL POINTER WORD
	PUSHJ	P,DD2MN		;COPY POINTERS INTO MON BUF
	  JFCL
	SUBM	T1,T4		;COMPUTE NEW FREE-POINTER COUNT
	AOS	T2,T4
	DPB	T4,DEYRLC##	;AND SAVE IT IN DDB
	AOBJN	T1,.+1		;POINT T1 AT NEXT GROUP OF POINTERS
	SKIPE	(T1)		;MORE POINTERS? (PRE-ALLOCATED SPACE)
	PUSHJ	P,PTRBL1	;YES, COPY THEM TO DDB
	MOVEI	T2,DEVRB1##(F)	;RESET DEVRET
	HRRM	T2,DEVRET##(F)
	HLRE	T2,DEVRSU##(F)	;NUMBER OF PNTRS LEFT
	AOJGE	T2,NXTB1A	;GO IF LAST PNTR
	SKIPL	DEVRIB##(F)	;NOT LAST, PRIME RIB?
	TLOA	S,IOSRIB	;YES, SET FLAG TO INDICATE TO CLOSE CODE
NXTB1A:	TLZ	S,IOSRIB	;RIB NOT PRIME, BETTER WRITE IT OUT
	PUSHJ	P,WRTRIB	;WRITE OUT THE RIB
	JRST	NXTBL3		;AND CONTINUE

;HERE IF THE CURRENT RIB IS FULL
NXTB1B:	TLNE	S,IO		;READING?
	JRST	NXTB1D		;NO
	PUSHJ	P,PTRCUR	;READ THE CURRENT RIB
	JUMPN	T3,CPOPJ##	;ERROR IF T3 NON-ZERO
IFN FTDMRB,<			;IF MULTIPLE RIBS
	PUSHJ	P,PTRNXT	;YES, GET THE NEXT RIB
	  PJRST	GVMNB0		;RIB ERROR
	PUSHJ	P,CPYEXT##	;COPY FIRST POINTERS FROM EXTENDED RIB
	  POPJ	P,		;RIB ERROR
	HRRZ	T1,DEVLFT##(F)	;GET COUNT OF NUMBER OF BLOCKS LEFT IN PNTR
	JRST	NXTBL7		;AND CONTINUE
>
;IF NO MULTIPLE RIBS, FALL INTO POPJ AT NXTBID
;HERE WHEN WRITING AND WE'VE RUN OUT OF ROOM IN THE CURRENT RIB
NXTB1D:
IFE	FTDMRB,<
	POPJ	P,		;RIB FULL - ERROR RETURN
>
IFN FTDMRB,<			;IF MULTIPLE RIBS
	PUSHJ	P,EXTRIB	;YES, ALLOCATE ANOTHER RIB
IFE FTDSIM,<
	  POPJ	P,		;ERROR
>
IFN FTDSIM,<
	  PJRST	DOWNIF		;ERROR- RETURN DA AND EXIT
	PUSHJ	P,DOWNIF	;OK - GIVE UP DA IF WE HAVE IT
>
	PUSHJ	P,CPYEXT##	;SET UP THE DDB
	  POPJ	P,		;RIB ERROR
	JRST	NXTBLK		;USE THE NEW BLOCKS ACQUIRED
>

;HERE IF THE OUTPUT IS NOT FROM CLOSE
NXTBL2:	PUSHJ	P,PTRCUR	;GET THE RIB
	JUMPN	T3,GVMNB0	;ERROR IN RIB KILLS US
	PUSHJ	P,PTRWRT	;SAVE POINTERS AND WRITE (KEEP THE MON BUF)
	PUSHJ	P,SPTRW		;SET T1 TO AN AOBJN WORD FOR ALL THE PNTRS
	LDB	T2,DEYRLC##	;NEW POINTER LOC
	HRLS	T2		;SET TO ADD TO AOBJN WORD
	ADD	T1,T2
	SKIPE	(T1)		;POINTERS (PRE-ALLOCATED SPACE)?
	PUSHJ	P,PTRBLT	;COPY THE NEW POINTERS INTO DDB
	PUSHJ	P,GVMNB0	;GIVE UP MONITOR BUFFER
NXTBL3:	SETZM	DEVBLK##(F)	;INDICATE NO CONTIGUITY
	JRST	NXTBL5		;AND CONTINUE

;HERE WHEN THE POINTERS RAN OUT ON INPUT

NXTBL4:	PUSHJ	P,CLSNAM##	;MAKE SURE NAME IN DDB IS RIGHT
				; (FILE MIGHT BE RENAMED)
	PUSHJ	P,PTRTST	;READ NEW POINTERS, WRITE THESE IF CHANGED (CHECKSUM)
	  JFCL
	PUSHJ	P,RDPTRA	;COPY NEW SET OF POINTERS INTO DDB
	SKIPE	DEVRB1##(F)	;GET NEW POINTERS?
	JRST	NXTBL5		;YES
	PUSHJ	P,FNDPTR	;NO, FIND THEM IN A DDB
	  POPJ	P,		;COULDN'T FIND THEM
;HERE WITH DEVRET POINTING TO NEXT RETRIEVAL POINTER (OR 0)
NXTBL5:	SKIPE	T2,@DEVRET##(F)	;*IS THERE ANOTHER POINTER?
	JRST	NXTBL6		;*YES

	MOVE	T1,DEVACC##(F)	;NO, ARE WE UP TO END OF FILE?
IFN FTDSIM,<
	TLNN	S,IO		;IF READING,
	SKIPA	T1,ACCWRT##(T1)	;USE NUMBER OF BLOCKS WRITTEN
	PUSHJ	P,GETALC	;ELSE USE NUMBER OF BLOCKS ALLOCATED
>
IFE FTDSIM,<
	MOVE	T1,ACCWRT##(T1)	;ELSE USE NUMBER OF BLOCKS WRITTEN
>
	CAMG	T1,DEVREL##(F)
	JRST	NXTB5A		;YES, RETURN EOF OR ALLOCATE BLOCKS
	TLNN	S,IO		;NOT AT EOF. READING?
	JRST	FNDPTR		;YES, FIND POINTERS IN SOME DDB
IFE FTDSIM,<
	JRST	OUTGRP		;NO, ALLOCATE SOME MORE (SYSTEM ERROR?)
>
IFN FTDSIM,<
	JRST	FIXDDB		;NO, FIND NEWLY-ALLOCATED PNTRS IN RIB
>

;HERE IF WE ARE UP TO THE END OF THE FILE
NXTB5A:	TLNN	S,IO		;READING?
	POPJ	P,		;YES - EOF
				;NO, FALL INTO OUTPUT ALLOCATION
;HERE TO ALLOCATE SOME MORE SPACE FOR AN OUTPUT FILE
OUTGRP:	HRRZ	T1,UNISTR##(U)	;LOC OF STR DATA BLOCK
	HLRZ	T2,UNIGRP##(U)	;YES, NUMBER OF CLUSTERS TO ALLOCATE
	TLO	T2,400000	;TELL CHKQTA THAT THE CALL IS FROM OUTPUT
	PUSHJ	P,CHKQTA	;CHECK USERS QUOTA OR DISK FULL
IFN FTDQTA,<
	JUMPLE	T2,OUTG5A	;CAN'T GET ANY MORE RETURN (IOBKTL SET)
>
;HERE WITH T2 = AMOUNT TO ALLOCATE, STR HAS SOME SPACE
IFN FTDSIM,<
	MOVE	T1,DEVACC##(F)	;IF SIMULT UPDATE FILE
	MOVE	T1,ACCSMU##(T1)	; GET MON BUF NOW, BEFORE GETTING DA
	TRNE	T1,ACPSMU	; TO AVOID A DEADLY EMBRACE
	PUSHJ	P,GTMB2
>
	SKIPN	T1,DEVBLK##(F)	;CONTIGUITY ALLOWED?
	JRST	OUTGR3		;NO. GET SPACE ANYWHERE
	SOS	DEVRET##(F)	;YES. POINT TO CURRENT RETRIEVAL PTR
	PUSHJ	P,CHKADD	;ROOM LEFT IN POINTER?
	JUMPLE	T2,OUTGR2	;NO. GET SPACE ANYWHERE
	MOVE	T1,DEVBLK##(F)	;YES. GET SPACE PAST 1ST UNALLOCATED BLOCK
	PUSHJ	P,TAKBLK	;YES. GET SPACE AT END
	  JRST	OUTGR2		;TRY FOR SPACE ANYWHERE ON UNIT
	PUSHJ	P,ADDPTR	;ADD NEW BLOCKS TO CURRENT POINTER
	MOVSI	T2,-1		;DEVRSU WAS INCREMENTED AT NXTBL1,
	ADDM	T2,DEVRSU##(F)	; SO DECREMENT IT BACK DOWN
IFN FTDSIM,<
	TLNE	S,IOSDA		;IF A SIM UPDATE FILE,
	JRST	OUTG4A		; REWRITE RIB WITH NEW POINTERS IN IT
>
	JRST	NXTBL8		;STORE NEW DEVLFT AND CONTINUE

;HERE WHEN CANT GET SPACE CONTIGUOUS WITH THE OLD SPACE
OUTGR2:	AOS	DEVRET##(F)	;POINT TO NEW POINTER LOC
	MOVE	T2,T1		;RESTORE AMOUNT TO GET
OUTGR3:	MOVEI	T4,TAKCHK	;SET TO TAKE N BLOCKS ON ANY UNIT
	HLRE	T1,DEVRSU##(F)	;UNLESS THERE IS ONLY ROOM FOR 1 POINTER
	CAMLE	T1,[EXP -2]	;IN WHICH CASE, SET TO STAY ON THIS UNIT
	MOVEI	T4,TAKBLK
	AOJN	T1,OUTG3A	;JUMP IF NOT LAST POINTER
	MOVSI	T1,DEPLPC##	;IS LAST, SET LAST POINTER IN CORE BIT
	IORM	T1,DEVLPC##(F)	;SO BLOCK WILL BE RESERVED FOR REDUNDANT RIB
OUTG3A:	SETZ	T1,		;GET BLOCKS ANYWHERE
	PUSHJ	P,(T4)		;GET SOME BLOCKS
	  JRST	OUTGR5		;ON NEW UNIT
OUTGR4:	MOVEM	T2,@DEVRET##(F)	;GOT SPACE ON SAME UNIT - SAVE POINTER IN DDB
IFN FTDSIM,<
	TLNN	S,IOSDA		;SIM UPDATE FILE?
	JRST	OUTG4B		;NO, CONTINUE
OUTG4A:	PUSHJ	P,WRTPTR	;YES, REWRITE RIB WITH NEW PNTRS
	PUSHJ	P,DWNDA		;GIVE UP DA NOW THAT RIB WRITTEN
	PUSHJ	P,GVMNB0
	PJRST	FIXDDB		;CALL USETI TO GET PNTRS BACK INTO CORE
				; (DD2MN ZEROES THE DDB)
OUTG4B:>
	HRRZ	T3,DEVACC##(F)	;LOC OF A.T.
	MOVEI	T4,ACP1PT##	;MAKE SURE THAT 1PT
	ANDCAM	T4,ACCUN1##(T3)	; IS OFF IN THE UN1 WORD
	JRST	NXTBL6		;AND CONTINUE
;GOT SOME SPACE ON A NEW UNIT, OR STR FULL
OUTGR5:	JUMPE	T3,OUTGR6	;IF GOT ANY
	MOVSI	T1,1
	ADDB	T1,DEVRSU##(F)	;UPDATE DEVRSU
	JUMPGE	T1,OUTGR6	;ERROR IF ALL SLOTS TAKEN (SHOULD NEVER HAPPEN)
	AOBJN	T1,OUTG5B
	MOVSI	T1,DEPLPC##
	IORM	T1,DEVLPC##(F)
OUTG5B:	MOVEM	T3,@DEVRET##(F)	;SAVE UNIT-CHANGE IN DDB
	HRRM	U,DEVUNI##(F)	;SAVE NEW UNIT IN DDB
	AOS	T1,DEVRET##(F)	;POINT TO NEXT PNTR SLOT
	CAIG	T1,DEVRBN##(F)	;DDB FULL?
	JRST	OUTGR4		;NO, STORE REAL POINTER IN DDB
	PUSH	P,T2		;YES, SAVE PNTR
	PUSHJ	P,WRTPTR	;COPY PNTRS TO RIB, WRITE
	POP	P,T2		;RESTORE NEW RETRIEVAL POINTER
	JUMPE	T3,OUTGR4	;CONTINUE IF NO RIB ERR
	PUSHJ	P,CNVPTR	;RIB ERR- GIVE BACK THE BLOCKS
	  JFCL			;BAD UNIT!
	  STOPCD OUTGR6,DEBUG,LNP,  ;++LAST POINTER NOT A POINTER
	MOVE	T2,T1		;SET TO GIVE BACK THE BLOCKS
	MOVE	T1,DEVBLK##(F)
	PUSHJ	P,GIVBLK	;RETURN THE BLOCKS, UPDATE COUNTS
	JRST	OUTGR6		;UPDATE DEVRSO AND ERROR RETURN

;HERE WHEN STRUCTURE IS FULL, RETURN DEVRSU TO PRE-CALL STATE
OUTG5A:
	MOVEI	T4,.ERFUL	;STR FULL INTERCEPT
	PUSHJ	P,SETINJ	;LET JOB KNOW
	  JFCL			;DON'T CARE IF NOT ENABLED

;HERE WHEN THERE ARE NO FREE BLOCKS LEFT IN THE STR
OUTGR6:	SOS	DEVRET##(F)	;POINT DEVRET BACK TO LAST REAL POINTER
	MOVSI	T1,-1		;DECR DEVSRU
	ADDM	T1,DEVRSU##(F)	;(INCREMENTED AT NXTBL1)
	PJRST	ERRFUL		;LIGHT AN ERROR BIT AND RETURN
;HERE WHEN WE HAVE A POINTER IN T2 (MAY BE UNIT CHANGE)
NXTBL6:	PUSHJ	P,CNVPTR	;*CONVERT POINTER TO BLK, COUNT
	  JRST	OUTGR6		;BAD UNIT-CHANGE PTR-LOSE
	  JRST	NXTBL1		;*WAS A UNIT-CHANGE.  TRY NEXT

;HERE WITH T1=BLOCK COUNT, DEVBLK SET UP
	TLO	S,IOSFIR	;*INDICATE CHECKSUM MUST BE COMPUTED
	MOVEM	S,DEVIOS(F)	;*SAVE S IN DDB
	TLNE	S,IO		;*READING?
	JRST	NXTBL8		;*NO, ANY ALLOCATED BLOCK IS OK
NXTBL7:	HRRZ	T2,DEVACC##(F)	;*YES, MAKE SURE THESE BLOCKS ARE ALL WRITTEN IN
	MOVE	T2,ACCWRT##(T2)	;*HIGHEST BLOCK WRITTEN
	SUB	T2,DEVREL##(F)	;*-1ST RELATIVE BLOCK OF GROUP
	AOJLE	T2,CPOPJ##	;*EOF IF NO BLOCKS LESS THAN HIGHEST WRITTEN
NXTBL8:	MOVE	T2,DEVLPC##(F)	;GET WORD TO TEST FOR LAST POINTER
	TLNN	T2,DEPLPC##	;LAST POINTER IN CORE?
	JRST	NXTBL9		;NO, NO NEED TO WORRY
	HRRZ	T2,DEVRET##(F)	;GET ADDRESS OF CURRENT POINTER IN DDB
	CAIE	T2,DEVRBN##(F)	;POINTING TO LAST SLOT IN DDB?
	SKIPN	1(T2)		;NO, NEXT SLOT EMPTY?
	SOJE	T1,NXTBL1	;YES, JUMP IF CURRENT POINTER EXHAUSTED
NXTBL9:	HRRM	T1,DEVLFT##(F)	;*AND SAVE IN DDB
	HRRZ	J,UNIKON##(U)	;*RIB MIGHT BE ON ANOTHER KONTROLLER
	JRST	CPOPJ1##	;*AND TAKE SKIP RETURN
IFN FTDMRB,<			;IF MULTIPLE RIBS
;SUBROUTINE TO CREATE AN EXTENDED RIB
; RETURNS CPOPJ IF ERROR OR RIB NOT EXTENDABLE
; RETURNS CPOPJ1 WITH NEW RIB IN THE MONITOR BUFFER AND T1=NUMBER OF NEW BLOCKS ADDED
EXTRIB:
IFN FTDSIM,<
	MOVE	T1,DEVACC##(F)
	MOVE	T1,ACCSMU##(T1)	;SIM UPDATE FILE?
	TLNN	S,IOSDA		; AND DDB WITHOUT DA (OR MON BUF)?
	TRNN	T1,ACPSMU
	JRST	EXTRB0
	PUSHJ	P,GTMNBF	;YES, GET DA BEFORE READING RIB
	PUSHJ	P,UPDA		; CAUSE ANOTHER JOB MIGHT TRY TO EXTEND RIB
EXTRB0:>
	PUSHJ	P,PTRCUR	;GET CURRENT RIB INTO CORE
	JUMPN	T3,GVMNB0	;RIB ERROR IF T3 NON-0
	PUSHJ	P,DD2MN		;COPY POINTERS FROM DDB TO RIB
	STOPCD	CPOPJ##,DEBUG,NPD,	;++NO POINTERS IN DDB
	MOVE	T1,DEVMBF##(F)	;IOWD TO MONITOR BUFFER
	SKIPG	DEVRIB##(F)	;CURRENT RIB EXTENDED?
	JRST	EXTRB1		;YES, CAN EXTEND AGAIN
	SKIPE	RIBFLR+1(T1)	;PRIME RIB. RIBFLR=0?
	PJRST	EXTRB3		;NO, CANNOT EXTEND THIS RIB
EXTRB1:	SKIPE	T2,RIBXRA##+1(T1) ;RIB ALREADY EXTENDED?
	JRST	EXTRB2		;YES, GO GET THE NEXT RIB
	PUSHJ	P,SAVE1##
	MOVEI	T1,DEPWRT##	;MAKE SURE FNDDDB DOESN'T
	ANDCAM	T1,DEVWRT##(F)	; FIND THIS DDB WHILE NUMBERS ARE CHANGING
	PUSHJ	P,GETALC	;GET "REAL" ACCALC
	MOVE	P1,T1		;RIBFLR=ACCALC - 2 RIB BLOCKS
	SUBI	P1,2
	PUSHJ	P,GTLPT##	;GET LAST RIB POINTER
	PUSHJ	P,CNVPTR	;DECODE THE POINTER
	  JFCL
	  STOPCD CPOPJ##,DEBUG,UPI,	;++UNIT POINTER ILL.
;STILL IN FTDMRB CONDITIONAL
	SOJ	T1,		;DECREMENT NUMBER OF BLOCKS LEFT
	ADDM	T1,DEVBLK##(F)	;NOW DEVBLK IS LAST BLOCK IN THE RIB
	MOVE	T1,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	MOVE	T2,DEVBLK##(F)	;GET ABSOLUTE BLOCK NUMBER OF REDUNDANT RIB
	MOVEM	T2,RIBSLF##+1(T1) ;STORE IN THE RIB
	MOVEI	T2,CODRIB##	;RIB IDENTIFICATION CODE
	MOVEM	T2,RIBCOD##+1(T1) ;STORE IN THE RIB
	SETZ	T1,		;TELL TAKBLK TO GET BLOCKS ANYWHERE
	HRROI	T2,3		;LOOK FOR 2 BLOCKS (RIBS + 1 DATA)
	PUSHJ	P,TAKBLK	;ALLOCATE SOME BLOCKS 
	  PJRST	EXTRB3		;ERROR, COULDN'T GET THE BLOCKS
	PUSH	P,T1		;SAVE NUMBER OF BLOCKS JUST TAKEN
	MOVEM	T2,DEVRB1##(F)	;STORE NEW POINTER IN DDB
	PUSH	P,DEVRIB##(F)	;SAVE CURRENT RIB POINTER
	LDB	T4,DEYRBC##	;NUMBER OF CURRENT RIB
	MOVSI	T1,400000	;TURN ON BIT 0 IN T1
	MOVEM	T1,DEVRIB##(F)	;NEGATIVE DEVRIB MEANS CURRENT RIB IS EXTENDED
	ADDI	T4,1		;INCREMENT RIB NUMBER
	DPB	T4,DEYRBC##	;AND SAVE IN DDB
	MOVE	T4,UNISTR##(U)	;GET ADDRESS OF SDB FOR CURRENT RIB UNIT
	LDB	T1,STYCLP##(T4)	;EXTRACT CLUSTER ADDRESS FROM POINTER
	DPB	T1,DEYRBA##	;SAVE IN DEVRIB
	LDB	T1,UNYLUN##	;GET CURRENT RIN LOGICAL UNIT NUMBER
	DPB	T1,DEYRBU##	;SAVE IN DEVRIB
;STILL IN FTDMRB CONDITIONAL
	MOVE	T1,DEVMBF##(F)	;IOWD TO MONITOR BUFFER
	MOVE	T2,DEVRIB##(F)	;POINTER TO NEXT RIB ON CHAIN
	MOVEM	T2,RIBXRA##+1(T1) ;SAVE IN CURRENT RIB
	POP	P,DEVRIB##(F)	;RESTORE POINTER TO CURRENT RIB
	MOVE	T2,RIBSLF##+1(T1) ;GET BLOCK NUMBER FOR REDUNDANT RIB WRITE
	PUSHJ	P,MONWRT	;WRITE THE REDUNDANT RIB
	PUSHJ	P,WRTRIB	;WRITE THE WORKING COPY OF THE RIB
	MOVE	T1,DEVMBF##(F)	;GET THAT IOWD AGAIN
	MOVE	T2,RIBXRA##+1(T1) ;POINTER TO EXTENDED RIB
	MOVEM	T2,DEVRIB##(F)	;NEW CURRENT RIB
	PUSHJ	P,SPTRW		;SET UP POINTER TO RIB
	MOVE	T4,T1		;MOVE POINTER TO T4
	SETZM	(T1)		;CLEAR THE POINTER LOCATION
	AOBJN	T1,.-1		;CLEAR ALL POINTERS IN THE RIB
	MOVE	T1,DEVMBF##(F)	;GET IOWD TO MONITOR BUFFER
	MOVEM	P1,RIBFLR##+1(T1) ;SET UP RIBFLR TO FIRST BLOCK NUMBER IN RIB
	SETZM	RIBXRA##+1(T1)	;CLEAR POINTER TO NEXT(NON-EXISTANT) RIB
	MOVE	T2,RIBFIR##+1(T1) ;GET AOBJN WORD
	MOVE	T2,DEVRB1##(F)	;GET FIRST POINTER IN RIB
	MOVEM	T2,(T4)		;SAVE FIRST POINTER IN RIB
	SETZM	DEVRB1##(F)	;CLEAR THE POINTER LOCATION
	PUSHJ	P,GRPAD		;COMPUTE DISK ADDRESS FROM POINTER
	MOVEM	T2,RIBSLF##+1(T1) ;SAVE IN THE RIB
	PUSHJ	P,WRTRIB	;WRITE THE RIB
	MOVEI	T1,DEPWRT##	;ITS OK FOR FNDDDB TO
	IORM	T1,DEVWRT##(F)	; SEE US AGAIN
	JRST	TPOPJ1##	;GOOD RETURN

;HERE WHEN THIS RIB ALREADY IS EXTENDED
EXTRB2:	PUSH	P,T2
	PUSHJ	P,WRTRIB	;WRITE CURRENT RIB (NEW CHECKSUMS
	POP	P,DEVRIB##(F)	;SET UP POINTER TO NEXT RIB
	PUSHJ	P,RIBCUR	;READ THE NEXT RIB
	PJUMPN	T3,CPOPJ##	;ERROR READING RIB IF T3 NON-ZERO
	JRST	CPOPJ1##	;HAPPY RETURN

;HERE WHEN THE RIB CAN'T BE EXTENDED
EXTRB3:	PUSHJ	P,WRTRIB	;WRITE THE RIB (WITH NEW PNTRS)
	MOVEI	T1,DEPWRT##	;ITS OK FOR FNDDDB TO
	IORM	T1,DEVWRT##(F)	; SEE US AGAIN
IFN FTDSIM,<
	PUSHJ	P,DOWNIF	;GIVE UP DA IF WE OWN IT
>
	PJRST	GVMNB0		;GIVE UP MON-BUF AND RETURN
>	;END CONDITIONAL ON FTDMRB
;SUBROUTINE TO CONVERT A RETRIEVAL POINTER
;ENTER WITH T2=POINTER
;EXIT CPOPJ LF BAD UNIT-CHANGE PNTR
;EXIT CPOPJ1 (WITH NEW U SET UP) IF CHANGE-UNIT POINTER
;EXIT CPOPJ2 WITH DEVBLK SET AND T1=COUNT IF A REAL POINTER
CNVPTR::TLNE	T2,-1		;*REAL POINTER?
	JRST	CNVPT2		;*YES
	TRZ	T2,RIPNUB##	;*CHANGE UNIT. REMOVE BIT 18
CNVPT1:	PUSHJ	P,NEWUNI	;*SET U, DEVUNI
	  TDZA	T2,T2		;*INVALID U - SET TO 0
	JRST	CPOPJ1##	;*OK - RETURN
	SOS	(P)
	JRST	CNVPT1		;*SET U TO 1ST UNIT IN STR AND RETURN

CNVPT2:	MOVE	T4,UNISTR##(U)	;*STR DB LOCATION
	LDB	T1,STYCLP##(T4)	;*CLUSTER ADDRESS
	LDB	T3,UNYBPC##	;*BLOCKS PER CLUSTER
	IMUL	T1,T3		;*BLOCK ADDR
	MOVEM	T1,DEVBLK##(F)	;*SAVE IN DDB
	LDB	T1,STYCNP##(T4)	;*GROUP COUNT FIELD
	IMUL	T1,T3		;*BLOCK COUNT
	JRST	CPOPJ2##	;*RETURN

;SUBROUTINE TO RESET U, DEVUNI(F) TO A NEW VALUE
;ENTER WITH LOGICAL UNIT NUMBER IN T2
;EXIT WITH U, DEVUNI SET TO NEW VALUE
;RETURNS CPOPJ IF NO SUCH UNIT, CPOPJ1 NORMALLY
;NEWUX SAME, PRESERVES T1,T3,T4
NEWUX:
NEWUNI::HRRZ	U,UNISTR##(U)	;*LOC OF FILE STRUCTURE DB
	JUMPE	U,CPOPJ##	;*RETURN NON-SKIP IF NOT IN A F/S
	HLRZ	U,STRUNI##(U)	;*LOC OF UNIT 0 IN STRUCTURE

;SUBROUTINE TO RESET U,DEVUNI(F) TO A NEW VALUE
;ENTER WITH POINTING TO 1ST UNIT IN STR
;EXIT WITH U,DEVUNI(F) SET TO NEW VALUE
;T1,T3,T4 RESPECTED
NEWUN::	SOJL	T2,NEWUN2	;*DONE IF T2 COUNTS OUT
	HLRZ	U,UNISTR##(U)	;*STEP TO NEXT UNIT OF STRUCTURE
	JUMPN	U,NEWUN		;*TRY NEXT
	JRST	NEWUN3		;*DESIRED UNIT WAS HIGHER THAN LAST UNIT IN STRUCTURE
NEWUN2:	HRRM	U,DEVUNI##(F)	;*SET DDB
	HRRZ	J,UNIKON##(U)	;*SET UP J
	JRST	CPOPJ1##	;*AND EXIT

NEWUN3:	TRO	S,IOBKTL	;*ILLEGAL UNIT - LIGHT ERROR BIT
	JRST	STRIOS		;*SAVE S AND ERROR RETURN
	SUBTTL	FILINT  - INTERRUPT HANDLING MODULE
FILINT::PUSHJ	P,SAVE4##	;SAVE P1-P4
	PUSH	P,T3		;SAVE DATAI WORD
	PUSH	P,T2		;SAVE CONI WORD
	PUSH	P,T1		;SAVE COMMUNICATION WORD
;SET UP P1 AS A GLOBAL IN FILINT MODULE = ADDRESS OF CHAN DATA BLOCK
	HRRZ	P1,KONCHN##(J)	;SET UP P1=LOC OF CHAN DB
	HLLZ	P2,T1		;GET INTERRUPT BITS
	TLZ	P2,1777		;MASK OUT UNIT
	ANDCAM	P2,(P)		;MASK OUT OF COMMUNICATION WORD
	SETZM	P4		;P4 WILL KEEP THE DRIVE NUMBER
POSTST:	JFFO	P2,.+2		;ANY MORE POSITIONS?
	JRST	POSDON		;NO, CLEAN UP TRANSFER
	LSH	P2,1(P3)	;YES. SET P2 FOR NEXT DRIVE TEST
	ADDB	P4,P3		;COMPUTE THE DRIVE 
	SKIPN	U,@KONPTR##(J)	;SET U=UNIT BLOCK ADR
	JRST	FINPS2		;NO UNIT BLOCK - IGNORE THE INTERRUPT
IFN FTDUAL,<
	MOVE	T1,UNICYL##(U)	;IF THIS IS PART OF DUAL-PORT DRIVE
	SKIPE	T2,UNI2ND##(U)
	MOVEM	T1,UNICYL##(T2) ;THEN BOTH UNITS ARE ON SAME CYL
>
	SKIPE	T1,UNISTS##(U)	;GET STATE OF UNIT
	CAIL	T1,OWCOD##	;OPERATOR WAIT?
	JRST	FREINT		;IDLE OR OPR WAIT
	JUMPL	T1,RECALH	;IF NEGATIVE WE'RE IN PHUNG RECOVERY
	CAIN	T1,TCOD##	;IS UNIT IN TRANSFER STATE?
	JRST	RECALR		;YES - POSITIONING INT. FROM XFERRING DRIVE
	CAIE	T1,SCOD##	;NO, WAS UNIT S?
	JRST	FINPS1		;NO,
	SETZM	UNISTS##(U)	;YES, SET STATUS =0 (IDLE)
	SKIPN	UNIQUE##(U)	;ANY POSITIONS WAITING?
	AOJA	P4,POSTST	;NO. TEST NEXT POSITION BIT
	PUSH	P,KONCUA##(J)	;YES, SAVE KONCUA (STARTING
				; A POSITION WILL CHANGE IT)
	PUSHJ	P,UNIPOS	;START UNIT POSITIONING (FORGET SEEK)
	POP	P,T1		;KONCUA
	MOVE	T2,UNISTS##(U)	;STATE OF UNIT
	CAIE	T2,TCOD##	; TRANSFER?
	MOVEM	T1,KONCUA##(J)	;NO, RESET KONCUA (CHANGED
				; SINCE UNIT WAS POSITIONED, POSDON
				; WILL CHECK STATE OF UNIT
	AOJA	P4,POSTST	;AND GO TEST NEXT POSITION BIT

;CALLED BY KON ROUTINE WHEN A UNIT GOES OFF-LINE
;PRESERVES T1
FILDN::	MOVEI	T2,O2COD##	;IF  IDLE SAY OFF-LINE, NO MESSAGE
	SKIPN	UNISTS##(U)	; (IF BUSY HNGDSK WILL CATCH IT)
	MOVEM	T2,UNISTS##(U)	; AND RETURN
	POPJ	P,
;HERE ON AN UNSOLICITED INTERRUPT, UNIT IDLE OR OPR WAIT
FREINT:	SKIPG	KONPOS##(J)	;DOES UNIT DO POSITIONING?
	STOPCD	FINPS2,DEBUG,FDP,	;++FIXED-HEAD DEVICE POSITION
	MOVSI	T2,UNPUNO##	;CLEAR 'OFF-LINE' AND FILE UNSAFE BITS
	ANDCAM	T2,UNIDES##(U)
OWRSET:	CAIE	T1,OW2COD##
	CAIN	T1,OWCOD##	;WAS THERE A FILE IN T STATE ON THIS UNIT?
IFE FTDUAL,<
	JRST	OWRSE1		;YES, ASSUME POWERED UP IN RESPONSE TOO TELOPR
>
IFN FTDUAL,<
	JRST	OWRSED
>
	SKIPE	DINITF##	;IF STILL IN ONCE-ONLY
	JRST	FREIN2		; DONT DO ANYTHING FANCY
	SKIPE	UNILOG##(U)	;IS THIS PACK KNOWN TO THE SYSTEM?
	JRST	FREIN1		;YES, REREAD HOME BLOCKS
IFN FTMDA,<
	PUSHJ	P,CALMDA	;NO, TELL MOUNTABLE DEVICE ALLOCATOR
	  JRST	FREIN2		;NOT RUNNING, CONTINUE
	PUSHJ	P,SET4MD	;SET SO ONLY MDA CAN READ DRIVE
	AOJA	P4,POSTST	;AND TEST NEXT DRIVE
>
IFE FTMDA,<
	JRST	FREIN2
>

;HERE IF PACK KNOWN TO SYSTEM
FREIN1:	MOVSI	T2,UNPRHB##	;ALREADY GOTTEN AN INTERRUPT FROM DRIVE?
	TDNN	T2,UNIDES##(U)
	AOS	HOMFLG##	;NO, COUNT UP NO OF HOMES TO READ
	IORM	T2,UNIDES##(U)	;INDICATE THIS UNIT NEEDS REREADING
	SETZM	UNISTS##(U)	;MAKE IDLE SO WONT START A SEEK
	AOJA	P4,POSTST	;AND GO TEST NEXT UNIT
FREIN2:	SKIPE	T1,UNIQUE##(U)	;FILES WAITING TO START POSITIONING?
	MOVEI	T1,PWCOD##	;YES
	MOVEM	T1,UNISTS##(U)	;SET UNIT IDLE OR PW
	JUMPE	T1,FINPS2	;TEST NEXT UNIT IF IDLE
	PUSHJ	P,SETID1	;POSITIONERS WAITING - START ONE GOING
	AOJA	P4,POSTST	;AND TEST NEXT UNIT
;SUBROUTINE TO SET THINGS UP SUCH THAT ONLY MDA CAN READ A UNIT
SET4MD:	MOVEI	T1,MDACOD##
	MOVEM	T1,UNISTS##(U)	;SET SO ONLY MDA CAN READ THE DRIVE
	MOVSI	T1,UNPWMD##	;SET THAT UNIT IS WAITING FOR MDA
	IORM	T1,UNIDES##(U)	; SO WILL GO BACK TO MDA WAIT AFTER A READ
	POPJ	P,		;AND RETURN

;HERE FOR POSITION INTERRUPT, DRIVE IN TRANSFER STATE
;THIS HAPPENS ON RECALIBRATE AFTER DATA ERROR
RECALR:	MOVE	F,UNICDA##(U)	;CURRENT DDB
	MOVE	S,DEVIOS(F)	;S WORD (SO STARTE WILL KNOW IF READ OR WRITE)
	SKIPL	T1,CHNECT##(P1)	;RECALIBRATE INTERRUPT?
	JRST	RECAL1		;NO - START DATA AGAIN
	SETZM	CHNECT##(P1)	;YES - REPOSITION DRIVE
IFN FTRP04,<
	AOJN	T1,RECAL1	;IF CHNECT=-1,,0 OFFSET COMPLETED
>
RECALH:	HRRZS	UNISTS##(U)	;CLEAR SIGN BIT (PHUNG RECOVERY)
	PUSHJ	P,@KONPOS##(J)	;START POSITION
	  PUSHJ	P,BADUNI	;DRIVE IS NOW DOWN
	AOJA	P4,POSTST	;GO HANDLE OTHER ATTENTION INTERRUPTS
RECAL1:	PUSHJ	P,STARTE	;START DATA TRANSFER
	AOJA	P4,POSTST	;AND TEST NEXT ATTENTION BIT
IFN FTDUAL,<
OWRSED:	HRRZ	T1,(P)		;COMMUNICATION OWRD
	TRZE	T1,IODTER+IODERR ;IS AN ERROR UP
	CAIE	T1,OPPOS##	; AND JUST A POSITION COMPLETE?
	JRST	OWRSE2		;NO, "REAL" FREE INTERRUPT
	LDB	T1,[POINT 3,(P),17] ;YES, DID THIS DRIVE HAVE THE ERROR
	CAIN	T1,(P4)
	JRST	FINPS2		;YES, IT ISN'T THE INTERRUPT WE WANT
OWRSE2:	PUSH	P,U		;NO, FREE INTERRUPT
	JRST	OWRSE1		;GO REDO THE OPERATION
>

;HERE FOR POSITION INTERRUPT, DRIVE NOT IN S OR T STATE
FINPS1:	TRNE	T1,1		;IS UNIT CURRENTLY IN A WAIT STATE?
	JRST	FINPS2		;YES, SPURIOUS INTERRUPT
	HRRZ	F,UNICDA##(U)
	MOVE	S,DEVIOS(F)
	TLNE	S,IOSMON	;MONITOR OR SWAPPER IO?
	AOSA	UNIMSC##(U)	;YES. COUNT 1 MORE MONITOR OR SWAP SEEK
	AOS	UNIUSC##(U)	;NO. COUNT 1 MORE USER SEEK
	SKIPN	DEVUNI##(F)	;UNIT BEEN YANKED?
	JRST	FINPS3		;YES
IFN FTDUAL,<
	PUSH	P,U
>
	CAIN	T1,PCOD##	;IF UNIT WAS IN POSITION,
OWRSE1:	PUSHJ	P,SETTTW	;SET FILE TO TW, OR T AND START TRANSFER
IFN FTDUAL,<
	POP	P,U		;IF WE STARTED IO ON ALTERNATE UNIT
	HRRZ	J,UNIKON##(U)	;THEN U, J AND P1 WERE CHANGED
	HRRZ	P1,KONCHN##(J)	;SO RESET THEM
>
FINPS2:	AOJA	P4,POSTST	;GO TEST NEXT POSITION INTERRUPT

;HERE IF UNIT WAS YANKED DURING A SEEK
FINPS3:	MOVEI	U,0
	PUSHJ	P,UNIYNK	;FIX UP DDB,UDB
	AOJA	P4,POSTST	; AND TEST NEXT POSITION INT.

;SUBROUTINE TO PUT THE DRIVE POINTED TO BY U IN T OR TW
;P1= CHAN DATA BLOCK ADR.
;IF PUT THE DRIVE IN T1, START TRANSFERRING DATA
;UUOTWQ IS CALLED FROM UUO LEVEL

SETTTW:	DSKOFF			;TURN ALL DISK PI'S OFF
	HRRZ	F,UNICDA##(U)	;*SET F TO FILE
IFN FTVM,<
	MOVE	T1,UNIBLK##(U)	;IN CASE OF SWAPPING ON 2 DF10'S
	SKIPL	DEVSWP##(F)
	JRST	UUOTWQ
	MOVEM	T1,DEVBLK##(F)	; DEVBLK MAY BE TIMESHARED
	PUSHJ	P,SWPCHK##	;CAN WE START IO NOW?
	  JRST	SETTW0		;NO, QUEUE TILL LATER
>
UUOTWQ:
IFN FTDHIA,<
	SKIPE	DIADSK##	;SHUTTING DOWN IO
	CAME	P1,DIACHN##	; FOR THIS CHANNEL?
	JRST	UUOTWR		;NO
	CONSO	PI,PIPROG##	;YES, ON UUO LEVEL?
	JRST	SETTW0		;YES, PUT REQUEST IN TW QUEUE
UUOTWR:>
	AOSG	@KONCHN##(J)	;#CHAN AVAILABLE?
IFN FTDUAL,<
	JRST	UUOTWS		;#YES, START IO
	SKIPE	T1,UNI2ND##(U)	;#NO, IS THIS A DUAL-PORTED DRIVE?
	SKIPE	UNISTS##(T1)	;#YES, IS THE 2ND DRIVE USEABLE?
	JRST	SETTW0		;#NO, QUEUE THE REQUEST ON 1ST CHAN
	MOVE	T2,UNIKON##(T1)	;#YES, T1=UNIT  T2=KON
	SKIPL	KONTAB##(T2)	;KONTROLLER IDLE?
	AOSE	@KONCHN##(T2)	;#YES, CHAN IDLE?
	JRST	SETTW0		;CANT START IT NOW
	HRRM	F,UNICDA##(U)	;SAVE DDB IN MAIN UDB
	MOVE	T3,UNISTR##(U)	;WILL NEED UNISTR LATER
	MOVEM	T3,UNISTR##(T1)	;(CHKSUM), SO SET IT UP
	MOVE	T3,UNIBPC##(U)	;WILL NEED UNIBPL
	MOVEM	T3,UNIBPC##(T1)	; IF WE GO TO NXTBLK
	HRRZ	J,T2		;WE CAN START THE IO ON THE ALTERNATE UNIT
	HRRZ	U,T1		; SO SET UP NEEDED ACS
	MOVE	P1,KONCHN##(J)
UUOTWS:>
IFE FTDSIM,<
	PJRST	STRTIO		;#YES, START IO
>
IFN FTDSIM,<
	PJRST	SETBS1		;HAVE TO CHECK FOR WRITE/USETO RACE
>
SETTW0:	MOVEI	T1,TWCOD##	;#TRANSFER WAIT STATE CODE
	DPB	T1,DEYCOD##	;MAKE DDB TW
IFN FTVM,<
	SKIPL	DEVSWP##(F)	;#IF THIS IS THE SWAPPER,
	JRST	SETTW1
	SETZM	UNISTS##(U)
	JRST	PUTQU3		;# DONT PUT IN CHAN QUEUE (START IT AT SWPPIK ONLY)
SETTW1:
>
				;#PUT IN TWQ AND RETURN
	CONSO	PI,PI.IPA-PI.IP7  ;IF ON UUO LEVEL,
	SKIPN	UNISTS##(U)	; DON'T CHANGE UNISTS IF NON-0
	MOVEM	T1,UNISTS##(U)	;ELSE MAKE UNIT TW STATE
IFN FTDUAL,<
	PUSHJ	P,SECCOD	;#MAKE OTHER UNIT STATE = THIS ONE
	HRRM	U,DEVCUR##(F)	;#SAVE CURRENT UNIT IN DDB
>
	MOVEI	T1,CHNQUE##(P1)	;#T1= QUEUE ON WHICH TO PUT FILE
IFN FTDUAL,<
REPEAT 0,<	;NOT NEEDED UNTIL WE GET A FIXED-HEAD DUAL-PORTED DRIVE
	SKIPLE	T2,UNI2ND##(U)	;IF A MAIN-UNIT
	SKIPN	UNISTS##(T2)
	JRST	PUTQUX		; WHICH HAS AN ALTERNATE UNIT
	MOVE	T1,UNICHN##(T2)	;IF THE ALTERNATE UNIT IS BUSY THE REQUEST
	MOVEI	T1,CHNQUE##(T1)	; SHOULD BE PUT ON THE ALTERNATE CHAN QUEUE
>	;END REPEAT 0
>	;END FTDUAL
				;AND FALL INTO PUTQUX
;SUBROUTINE TO ENTER A FILE IN A QUEUE
;  PUTQUX FOR CHANNEL (XFER WAIT) QUEUES
;	  P1=ADDR. CHAN. DATA BLOCK
;  PUTQUE FOR UNIT (POSITION WAIT) QUEUES
;	  U=ADDR. UNIT DATA BLOCK
;C(T1)=LOC OF QUEUE POINTER   F POINTS TO FILE
;LH OF QUEUE POINTER CONTAINS FIRST FILE (DDB) ADR., RH=0
;THESE ARE REALLY LISTS NOT QUEUES, SINCE ARE REMOVED IN RANDOM ORDER
PUTQUX:
IFN FTDSTT,<			;IF KEEPING DISK STATISTICS
	AOSA	CHNQUL##(P1)	;  INCREMENT XFER QUEUE LENGTH
>
PUTQUE:
IFN FTDSTT,<
IFE FTVM,<
	AOS	UNIQUL##(U)	;  OR POSITION QUEUE
>
IFN FTVM,<
	AOSA	UNIQUL##(U)
>
>
IFN FTVM,<
	AOS	CHNWAT##(P1)
>
IFE FTDPRI,<
	MOVE	T2,(T1)		;CURRENT FIRST IN "QUEUE"
	HRLM	F,(T1)		;MAKE THIS FIRST
	HLLM	T2,DEVQUE##(F)	;POINT THIS AT NEXT
				; TO BE ADR. FILE(DDB)BEING ADDED 
>
IFN FTDPRI,<	;IF DISK PRIORITY
	MOVEI	T4,MINDVQ##(T1)	;SET TO POINTER-OFFSET (FIRST PREDECESSOR)
	SKIPN	(T1)		;EMPTY?
	JRST	PUTQU2		;YES, GO
	PUSHJ	P,SAVE1##	;NO, SAVE P1
	PUSHJ	P,DFPRI		;COMPUTE PRIORITY
	MOVE	P1,T2		;IN P1
	HLRZ	T3,(T1)		;FIRST ITEM IN QUEUE
PUTQU1:	PUSHJ	P,D3PRI		;PRIORITY OF FILE IN QUEUE
	CAMGE	T2,P1		;IS NEW ENTRY HIGHER?
	JRST	PUTQU2		;YES. INSERT IT HERE
	MOVE	T4,T3		;NO, SAVE AS PREDECESSOR
	HLRZ	T3,DEVQUE##(T3)	;STEP TO NEXT IN QUEUE
	JUMPN	T3,PUTQU1	;TEST THAT ONE
PUTQU2:	HLLZ	T2,DEVQUE##(T4)	;POINTER TO NEXT IN QUEUE
	HRLM	F,DEVQUE##(T4)	;LINK THIS FILE TO IT
	HLLM	T2,DEVQUE##(F)	;INSERT NEW LINK TO NEXT
>
PUTQU3:	DSKON			;#TURN ALL DISK PI'S BACK ON
	SCHEDULE
	SETZ	T1,		;SET HUNG-TIME TO ZERO
	DPB	T1,PDVCNT##	; SO WONT TIME OUT WHILE IN A QUEUE
	POPJ	P,		;AND RETURN


IFN FTDPRI,<
;SUBROUTINE TO COMPUTE PRIORITY OF A DISK FILE
;ENTER AT D3PRI IF DDB ADR IN T3, AT DFPRI IF IN F
;EXIT WITH T2=PRIORITY.  RESPECTS ALL ACS EXCEPT T2
D3PRI:	LDB	T2,DEZPRI##	;PNTR INDEX = T3
	CAIA
DFPRI:	LDB	T2,DEYPRI##	;INDEX=
	TRZE	T2,MINDPR	;PRIORITY NEGATIVE?
	MOVNS	T2		;YES, MAKE T2 NEGATIVE
	POPJ	P,		;AND RETURN
>
;ROUTINE TO SET UP R (POSSIBLY AN INTERRUPT LEVEL)
ADRINT:	LDB	T1,PJOBN##	;JOB NUMBER
	SKIPN	R,JBTADR##(T1)	;GET ADDRESS
	SKIPG	DEVSWP##(F)	;NONE - SWAPPER OR REREADING HOME BLOCKS?
	POPJ	P,		;HAVE R=ADDR, OR SWAPPER
	SKIPE	DINITF##	;NOTHING - ONCE CODE?
	POPJ	P,		;YES, OK RETURN
	STOPCD	CPOPJ##,DEBUG,JNC,	;++JOB NOT IN CORE
;SUBROUTINE TO START IO ON FILE POINTED TO BY F
;P1= CHAN. DATA BLOCK ADR.
;ALSO CALLED AT UUO LEVEL
STRTIO::MOVSI	T1,400000	;#SET KONTROL BUSY	
	ORM	T1,KONTAB##(J)	;#
IFN FTPDBS,<
	IOSMON==IOSMON		;FOR CREF. BIT IS ALREADY IN T1
	SKIPGE	DEVSWP##(F)	;IS THIS THE SWAPPING DDB?
	IORM	T1,DEVIOS(F)	;YES--MAKE SURE IOSMON IS SET IN DDB.
> ;END FTPDBS
	MOVEI	T1,TCOD##	;#SET FILE, UNIT TO T1
	PUSHJ	P,FILCOD	;SETPAR EXPECTS T1 TO STILL CONTAIN TCOD
				; FOR METER POINT
	PUSHJ	P,SETPAR	;SET KONCUA,UNICDA,UNIBLK
IFN FTDUAL,<
	HRRM	U,DEVCUR##(F)	;SAVE CURRENT UNIT IN DDB
	PUSHJ	P,SECCOD	;MAKE OTHER UNIT STATE = THIS ONE
>
	DSKON			;#TURN ALL DISK PI'S BACK ON
	SCHEDULE
	MOVE	S,DEVIOS(F)	;S WORD
	PUSHJ	P,ADRINT	;SET UP R FROM JBTADR
	PUSHJ	P,SETLST	;SET UP IOLST, NUMBER OF BLOCKS
IFN FTKL10,<
	PUSHJ	P,CFDMP		;INVALIDATE CACHE, VALIDATE MEMORY
>
	SETZM	CHNECT##(P1)	;ZERO ERROR COUNT LOC
	SETZM	CHNRCT##(P1)	;ZERO RECALIBRATE-COUNT
	SETZM	UNIRCV##(U)	;ZERO HUNG UNIT RETRY-COUNTER
	MOVSI	T1,UNPFIR##	;SET SIGN BIT IN UNIECT
	ORM	T1,UNIECT##(U)	; TO INDICATE NO ERRORS YET
	JUMPL	S,STARTE	;NO CHECKSUMS IF MONITOR IO
	TLNE	S,IO		;DATA - READING?
	TLZN	S,IOSFIR	;WRITING DATA - CHECKSUM TIME?
	JRST	STARTE		;NO
	MOVEM	S,DEVIOS(F)	;YES, SAVE S IN DDB
	PUSHJ	P,CHKSUM	;COMPUTE CHECKSUM
	SKIPN	T2,@DEVRET##(F)	;GET RETRIEVAL PNTR
	MOVE	T2,DEVRB1##(F)	;JUST 1 PNTR IN DDB, STORED IN DEVRB1
	MOVE	T3,UNISTR##(U)	;LOC OF STR DB
	MOVE	T4,T2		;SAVE OLD POINTER
	DPB	T1,STYCKP##(T3)	;SAVE CHKSUM IN PNTR
	CAMN	T4,T2		;DID CHECKSUM CHANGE?
	JRST	STARTE		;NO, CRANK UP THE IO
	SKIPN	@DEVRET##(F)	;YES, JUST 1 PNTR IN DDB?
	MOVEM	T2,DEVRB1##(F)	;YES. SAVE NEW PNTR BACK OVER OLD
	SKIPE	@DEVRET##(F)
	MOVEM	T2,@DEVRET##(F)	;SAVE PNTR IN DDB
	HRRZ	T1,DEVACC##(F)	;ACCESS TABLE
	MOVE	T3,DEVREL##(F)	;RELATIVE BLOCK OF FILE
	SOJN	T3,STRTI1	;IF 1ST BLOCK,
	MOVEM	T2,ACCPT1##(T1)	; SO ANOTHER JOB CAN READ THIS FILE (UPDATE)
STRTI1:	MOVE	T3,ACCSTS##(T1)	;FILE STATUS
	TRNN	T3,ACPUPD	;FILE BEING UPDATED?
	JRST	STARTE		;NO
	MOVEI	T4,ACPSBC##	; SO DDBS WHICH HAVE POINTER IN CORE ALREADY
	ORM	T4,ACCSBC##(T1)	; WON'T GET SPURIOUS CHECKSUM ERRORS

IFN  FTDSIM,<
;MIGHT GET A WRONG CHECKSUM INTO THE RIB OF A SIM-UPDATE FILE IF WE
; LEAVE A BAD CHECKSUM IN SOME OTHER DDB, SO FIND ALL WRITERS OF THE FILE
; AND CHANGE THE CHKSUMS IN THEIR DDB'S
	LDB	T3,ACYWCT##	;IF WE'RE THE ONLY WRITER,
	SOJLE	T3,STARTE	; FORGET IT
	PUSH	P,T2		;OTHER WRITERS - SAVE THE NEW PNTR
	MOVE	T3,UNISTR##(U)	;SET UP A MASK FOR PNTR ADDRESSES
	SETO	T2,
	LDB	T2,STYCLP##(T3)
	MOVEM	T2,MSKLOC	;AND SAVE IT
	PUSHJ	P,FNDDDB	;FIND A WRITING DDB
	  JRST	STRTI6		;NONE THERE (SYSTEM ERROR?)
	HRRZ	T3,DEVUNI##(T2)	;UNIT
	CAIE	T3,(U)		;SAME UNIT?
	JRST	STRTI5		;NO, FIND ANOTHER DDB

;HERE WHEN WE FOUND A WRITING DDB
STRTI2:	MOVEI	T1,DEVRB1##(T2) ;SET A POINTER FOR THE
	HRLI	T1,MPTRLN##	;RETRIEVAL PNTRS OF FOUND DDB
STRTI3:	SKIPN	T3,(T1)		;GET A RET PNTR FROM THE DDB
	JRST	STRTI4
	XOR	T3,(P)		;DOES IT MATCH NEW PNTR?
	TDNE	T3,MSKLOC
	JRST	STRTI4		;NO, TRY NEXT PNTR
	MOVE	T3,(P)		;YES, SUBSTITUTE NEW PNTR
	MOVEM	T3,(T1)		;IN THE FOUND DDB
	JRST	STRTI5		;AND TEST FOR ANOTHER WRITER
STRTI4:	AOBJN	T1,STRTI3	;TES NEXT PNTR IN FOUND DDB
STRTI5:	PUSHJ	P,FNDDDN	;LOOK FOR ANOTHER WRITER
	  JRST	STRTI6		;NONE THERE, DONE
	JRST	STRTI2		;FOUND ONE, LOOK FOR PNTR IN THIS DDB
STRTI6:	POP	P,(P)		;DONE - REMOVE PNTR FROM STACK
>	;END FTDSIM
STARTE::MOVEI	T1,KONRDS##(J)	;SET TO READ - STOP ON ERROR FOR F.S.
				; ALL BUT LAST TRY SO KNOW BAD BLOCK+WORD
	TLNE	S,IO
	MOVEI	T1,KONWTS##(J)	; WRITE DATA - STOP ON ERROR FOR F.S.
				; ALL BUT LAST TRY SO KNOW BAD BLOCK+WORD
IFN FTDSUP,<
	TLNN	S,IOSUPR	;SUPER I/O MODE?
	JRST	STARTF		;NO, START THE IO
	TRNE	S,UDSX		;YES, READ/WRITE HEADERS AND DATA?
	AOJA	T1,STARTF	;YES, RDF/WTF = RDS/WTS +1
IFN FTRP04,<
	MOVSI	T2,DEPCPT##	;NO, COMPATABILITY MODE?
	TDNE	T2,DEVCPT##(F)
	ADDI	T1,2		;YES, ENTRY POINT = RDS(WTS)+2
>>
STARTF:	MOVEM	S,DEVIOS(F)	;SAVE S
	DSKOFF			;MAKE SURE NO INTERRUPTS HAPPEN
	PUSHJ	P,@(T1)		;#START READ OR WRITE
	  JRST	BADUNI		;#UNIT NOT OK
	DSKON			;#
	POPJ	P,

;SUBROUTINE TO SET STATE OF FILE,UNIT TO C(T1)
;THIS ROUTINE RESPECTS AC T1
FILCOD:	DPB	T1,DEYCOD##	;#SET STATE OF FILE
	MOVEM	T1,UNISTS##(U)	;#SET STATE OF UNIT
	POPJ	P,		;#AND RETURN

IFN FTDUAL,<
;ROUTINE TO SET 2ND UNIT'S STATE CODE = THIS UNIT'S
SECCOD:	SKIPL	T1,UNI2ND##(U)	;IS THIS AN ALTERNATE UNIT?
	POPJ	P,		;NO
	MOVE	T2,UNISTS##(U)	;YES, GET STATE WORD OF UNIT
	MOVEM	T2,UNISTS##(T1)	;AND SAVE IN UDB FOR PRIME UNIT
	POPJ	P,		;AND RETURN
>

;SUBROUTINE TO SET UP AN IOLIST BLOCK
;ENTER WITH J,U,F AND S SET UP
;P1=CHAN.DATA BLOCK ADR.
;ALSO CALLED AT UUO LEVEL
;RETURNS WITH THE LIST IN CORE, POINTED TO BY @KONIOC(J)
SETLST:	PUSHJ	P,NXTBLK	;GET NEXT BLOCK OF FILE
	  STOPCD .,JOB,BWA,	;++BLOCK WENT AWAY
IFN FTKA10,<
	MOVE	T4,KONCOM##(J)	;AOBJN POINTER FOR IO LIST BLOCK
>
IFE FTVM,<
	HRRZM	T4,@KONIOC##(J)	;SET KONIOC TO LOC OF IOLIST BLOCK
>
IFN FTKI10!FTKL10,<
	PUSHJ	P,SAVE4##	;YES, SAVE P1-P4
	HRLZ	P3,J		;SAVE J
	HRR	P3,P1		;SAVE CHAN DB ADR
	TLO	P3,400000	;TELL MAPIO TO STORE EXPECTED TERM WD
	LDB	J,PJOBN##	;JOB NUMBER
IFN FTSWAP,<
IFE FTVM,<
	SKIPGE	DEVSWP##(F)	;SWAPPER?
	MOVM	J,FINISH##	;YES, GET THE SEGMENT NUMBER
>
IFN FTVM,<
	SKIPLE	DEVSWP##(F)	;"THIS" MAKES JOB ADDRESSABLE ITSELF
>
>	;END FTSWAP
	PUSHJ	P,SVEUB##	;SET UP UBR
	SETZB	P1,P2		;P1=FREE CORE LOC
>	;END FTKI10
	PUSH	P,U		;SAVE U
	MOVE	T2,DEVBLK##(F)	;BLOCK TO START AT
	HRRZ	T1,UNIBPY##(U)	;NUMBER OF BLOCKS PER CYLINDER
	IDIVI	T2,(T1)		;T3=RELATIVE BLOCK IN CYL
	SUBI	T1,(T3)		;T1=DISTANCE TO END OF CYLINDER
	CAMLE	T1,MAXTRN##	;GTR THAN THE MAX NUMBER OF BLOCKS ALLOWED?
	MOVE	T1,MAXTRN##	;YES, REDUCE COUNT (SO HIGH PRIORITY REQUESTS
				; WONT GET LOCKED OUT TOO LONG)
	HRRZ	T3,DEVLFT##(F)	;NO OF BLOCKS LEFT IN CURRENT GROUP
	SKIPL	S		;ASSUME ALL BLOCKS TO EOL OK IF MON MODE
	CAMLE	T3,T1		;MORE THAN TO END OF CYLINDER?
	MOVE	T3,T1		;YES, REDUCE COUNT
	TLNE	S,IO+IOSUPR+IOSMON	;READING DATA?
	JRST	SETLS0		;NO. USE ALL OF GROUP
	MOVE	T2,DEVACC##(F)	;YES. GET LOC OF A.T.
	MOVE	T2,ACCWRT##(T2)	;NO OF DATA BLOCKS IN FILE
	SUB	T2,DEVREL##(F)	;NO OF DATA BLOCKS LEFT (FROM CURRENT POSITION)
	CAIGE	T2,-1(T3)	;MORE IN GROUP THAN HAVE DATA?
	MOVEI	T3,1(T2)	;YES, ONLY READ BLOCKS WITH DATA
SETLS0:	JUMPL	S,SETDMP	;SAME AS DUMP IF MONITOR MODE
	LDB	T1,PIOMOD##
	CAIL	T1,SD		;NO, DUMP MODE?
	JRST	SETDMP		;YES
	HRLZ	T1,T3		;BUFFERRED MODE. NUMBER OF BLOCKS LEFT IN GROUP
	MOVNS	T1		;SET FOR AOBJN POINTER
	TLNN	S,IO		;READING?
	SKIPA	T2,DEVIAD(F)	;YES. USE DEVIAD
	MOVE	T2,DEVOAD(F)	;WRITING, USE DEVOAD
	HRLI	T2,MBLKSZ##	;SET LH(T2) FOR AN IOWD
	HLRZ	U,R		;SET U TO USERS PROTECTION
	SUBI	U,BLKSIZ##	;-200 FOR ADRRESS CHECK
	MOVEI	T3,1(T2)	;STARTING BUFFER LOC
	HRLM	T3,DEVUVA##(F)	;SAVE UVA-1 OF CHKSUM WORD
	SUBI	T3,1

SETLS1:	CAMLE	T2,[XWD MBLKSZ##,JOBPFI##]	;IS BUFFER LOC ABOVE JOBPFI
	CAIGE	U,(T2)		;AND BELOW TOP OF USER'S SPACE?
	JRST	SETLS5		;NO  - LET UUOCON GIVE ADR ERROR MESSAGE
IFN FTKA10,<
	ADDI	T2,(R)		;YES, RELOCATE
>
IFN FTVM,<
	EXCTUU	<MAP P4,-1(T2)>	;IS THE PAGE IN CORE?
IFN FTKI10,<
	TRNN	P4,420000
>
IFN FTKL10,<
	PUSHJ	P,SFLTST	;CALL COPY OF FLTST FOR FILSER
>
	EXCTUU	<MAP P4,BLKSIZ+1(T2)>
IFN FTKI10,<
	TRNN	P4,420000
>
IFN FTKL10,<
	PUSHJ	P,SFLTST	;CALL COPY OF FLTST FOR FILSER
>
	  JRST	SETL1B		;NO PAGE FAILURE, CONTINUE
	JRST	SETLS5		;PAGE FAILURE WILL OCCURR, TERMINATE THE IO LIST
SETL1B:>	;END FTVM
	TLNN	S,IO
	JRST	SETLS2
	EXCTUX	<SKIPL (T2)>	;WRITING - IS NEXT BUFFER FULL?
	JRST	SETLS5		;NO, DONE
	JRST	SETLS3		;YES. SET IOWORD FOR BUFFER
SETLS2:	EXCTUX	<SKIPG (T2)>	;READING - IS NEXT BUFFER FREE?
	JRST	SETLS5		;NO. DONE
SETLS3:	ADDI	T2,1		;INCREMENT BY 1 FOR WORDCOUNT WORD
IFN FTKI10!FTKL10,<
	JUMPGE	S,SETL30	;IF MONITOR I/O,
	MOVE	P4,T2		;SAVE IOWD IN P4
IFN FTKL10,<
	MAP	T2,(T2)		;CONVERT TO UNMAPPED FOR MAPIO
	HLL	T2,P4		;GET WORD COUNT BACK
>
SETL30:	ADDI	T2,(R)
	HRLI	T2,MBLKSZ##
	MOVEI	P4,0
	PUSHJ	P,MAPIO##	; STORE THE IOWD IN FREE-CORE
	  JRST	PUNTB		;NOT ENOUGH MONITOR FREE-CORE
	SUBI	T2,(R)
	HRLI	T2,MBLKSZ##
>	;END FTKI10!FTKL10
IFN FTKA10,<
	MOVEM	T2,(T4)		;SAVE THE IOWD
>
	TLNE	S,IO		;READING?
	JRST	SETL3C		;NO
	EXCTXU	<HLREM T2,(T2)>	;YES, SAVE -WDCNT IN BUFFER WORD 0
	EXCTUU	<MOVNS (T2)>	;SET +WDCNT


SETL3C:	EXCTUX	<HRR T2,-1(T2)>	;STEP TO NEXT BUFFER
	CAIE	T3,(T2)		;BACK TO THE BUFFER WE STARTED AT?
	TRNE	S,IOCON		;OR DISCONTINUOUS MODE?
	AOJA	T4,SETLS4	;YES, IOWDS ARE ALL SET
IFN FTKA10,<
	AOBJP	T4,SETLS4	;COUNT THE IOWD, THROUGH IF NO MORE ROOM IN BLOCK
>
	AOBJN	T1,SETLS1	;COUNT THE BLOCK AND TRY FOR ANOTHER IOWD
	JRST	SETLS5		;NO BLOCKS LEFT IN THIS POINTER


IFN FTKL10&FTVM,<
;COPY OF FLTST FOR FILSER. CALL WITH RESULT OF MAP INSTRUCTION
; IN P4. SKIP RETURN IF FAULT WILL OCCUR, NON SKIP IF OK.
; (THIS IS BACKWARDS W.R.T. THE REAL FLTST)

SFLTST:	TLNN	P4,(1B8)	;PAGED REF?
	POPJ	P,		;NO, WILL NOT FAULT
	TLNN	P4,(1B1)	;BAD FAIL OR
	TLNN	P4,(1B2)	;NO ACCESS ALLOWED AND
	JRST	CPOPJ1##	;WE WILL FAULT
	POPJ	P,		;OTHERWISE WE WILL NOT

>;END IFN FTKL10&FTVM
;HERE WHEN THE IOLIST IS COMPLETELY SET UP
SETLS4:	AOS	T1
SETLS5:
IFN FTKI10!FTKL10,<
SETL5A:	HLRZ	J,P3		;RESTORE KONTROLLER DB LOC
	TRZ	J,400000
IFN FTKL10,<
	MOVEM	T2,KONCNT##(J)	;SAVE ACTUAL WRDCNT IF DUMP-MODE
	MAP	P2,(P2)		;CONVERT VIRTUAL ADDRESS TO PHYSICAL ADDRESS
>
	HRRZS	P2		;JUST ADDRESS (DF10-STYLE JUMP)
IFN FTKL10&FT22BIT,<
	JUMPE	P2,SETL5C	;ALL ZERO IF NO IOWDS
	MOVE	T2,CHB22B##(P3)	;RH20?
	TLNE	T2,CP.RH2##
	TLO	P2,RH2JMP##	;YES, MAKE IT THAT FLAVOR OF JUMP
>
SETL5C:	MOVEM	P2,@KONIOC##(J)	;SAVE LOC OF 1ST IOWD IN KONTROL BLOCK
IFN FTKL10&FT22BIT,<
IFN FTVM,<
	SKIPGE	DEVSWP##(F)	;SWAPPER?
	JRST	SETL5B		;YES, THIS ALREADY FIXED THINGS
>
	TLNE	P2,-1		;RH20?
	PUSHJ	P,RH2ND##	;YES, FINISH THE LIST
>
SETL5B:	MOVE	P1,P3
SETLS6:>	;END FTKI10!FTKL10
IFN FTKA10,<
	SETZM	(T4)		;TERMINATE IO LIST
	HLRE	T2,-1(T4)	;GET NEGATIVE WORD COUNT
	HRRZ	T3,-1(T4)	;ISOLATE ADDRESS
	SUB	T3,T2		;DETERMINE FINAL DATA ADDRESS
	HRL	T3,T4		;GET IOWD LIST TERMINATION ADDRESS
	MOVEM	T3,CHNTCW##(P1)	;SAVE AS EXPECTED TERMINATION CONTROL WD
>
SETLS7:	HRRZM	T1,CHNNUM##(P1)	;NUMBER OF BLOCKS TO TRANSFER
				; CLEAR LH (ERROR FLAG)
	JRST	UPOPJ##
;HERE TO SET UP A DUMP-MODE LIST
;ASSUMES THE CURRENT IOWD (RELOCATED) IS IN DEVDMP(F)
;UPDATES DEVDMP(F) BY NUMBER OF WORDS TRANSFERRED
;IF THE IOWD IS FINISHED, DEVDMP WILL BE POSITIVE
SETDMP:
IFN FTVM,<
	SKIPGE	DEVSWP##(F)	;IS IT THE SWAPPER?
	JRST	SETSWP		;YES, DO IT DIFFERENTLY
>
IFN FTKI10!FTKL10,<
	HLRZ	T4,P3
	TRZ	T4,400000
	MOVEI	T1,KONDMP##(T4)
	PUSH	P,T1
>
	HLLZ	T1,DEVDMP##(F)	;NUMBER OF WORDS IN IOWD
	MOVNS	T1		;+N
	HRLZ	T2,T3		;NUMBER OF BLOCKS LEFT IN GROUP
	LSH	T1,MBKLSH##	;NUMBER OF BLOCKS IN IOWD
	JUMPE	T2,SETDM2	;0 IS OK
IFN FTDSUP,<
	TDC	S,[IOSUPR,,UDSX]
	TDCN	S,[IOSUPR,,UDSX]	;FORMATTING?
	JRST	SETDM2		;YES, ASSUME HE REALLY KNOWS
>
	CAMLE	T1,T2		;MORE REQUESTED THAN IN GROUP?
	MOVE	T1,T2		;YES, TAKE LESSER AMOUNT
SETDM2:	LSH	T1,BLKLSH##	;CONVERT BACK TO WORDS
	MOVNM	T1,T3		;SAVE N
	MOVE	T2,DEVDMP##(F)	;CURRENT IOWD
	SKIPN	DINITF##	;IF NOT IN ONCE-ONLY,
IFN FTKA10,<
	MOVEM	T2,KONDMP##(J)	;SAVE IN KONT DATA BLOCK IN CASE UNIT IS OFF-LINE
>
IFN FTKI10!FTKL10,<
	MOVEM	T2,@0(P)
	POP	P,(P)		;REMOVE THIS WORD FROM PD LIST
>
	HLL	T2,T3		;SET LH OF IOWD
IFN FTKI10!FTKL10,<
	MOVEI	P4,0
	PUSHJ	P,MAPIO##	;SAVE THE IOWD IN FREE-CORE
	  JRST	PUNTD		;NOT ENOUGH FREE CORE
	SKIPA			;AND CONTINUE
>
	MOVEM	T2,(T4)		;STORE IOWD IN BLOCK
SETD2B:	JUMPL	S,SETDM3	;GO IF MONITOR MODE
	ADDM	T1,DEVDMP##(F)	;UPDATE WDCNT
	HLRZ	T2,T1
	ADD	T2,DEVDMP##(F)	;UPDATE ADDRESS
	HRRM	T2,DEVDMP##(F)	; (DON'T PROPOGATE CARRY)
	TLNE	T3,BLKSIZ##-1	;EVEN NUMBER OF WRDS FOR BLOCK?
	TLNN	S,IO		;NO. WRITING?
	JRST	SETDM3		;NO. OK
	SKIPN	DEVMBF##(F)	;HAVE MON BUF?
	JRST	SETDM3		;NO, HARDWARE MUST WRITE 0'S IN REST OF BLOCK
	TLO	T3,MBLKSZ##	;YES. MAKE SURE T3 .GT. -200
	MOVNS	T3		;PARTIAL-BLOCK WORD COUNT
IFN FTKI10!FTKL10,<
	ADD	T3,[XWD MBLKSZ##,0]	;-NO OF WDS LEFT
	HRRZ	T2,DEVMBF##(F)	;MAKE AN IOWD FOR 0'S
	ADD	T2,T3
	TLO	S,IOSMON	;SO MAPIO WON'T UNRELOCATE THE IOWD
	PUSHJ	P,MAPIO##	;SAVE IT
	  JRST	PUNTA
	TLZ	S,IOSMON
	JRST	SETDM3		;AND CONTINUE

IFN FTVM,<
;HERE TO SET UP AN IO LIST FOR THE SWAPPER
SETSWP:	PUSHJ	P,SWPP1		;POINT P1 AT THE SWPLST ENTRY
				;T3=MAXIMUM NUMBER OF BLOCKS TO DO
	PUSHJ	P,THIS##	;GO SET THE IO LIST
				;RETURNS T1= NO OF BLOCKS, P3=L(LIST)
	JRST	SETL5A		;GO FINISH UP THE IO LIST STUFF

;SUBROUTINE TO POINT P1 AT SWPLST ENTRY
;PRESERVES T1
SWPP1:
IFN FTDUAL,<
	SKIPGE	T2,UNI2ND##(U)
	SKIPA	P1,UNISWA##(T2)
>
	MOVE	P1,UNISWA##(U)
	POPJ	P,
>	;END FTVM
>	;END FTKI10
	HLRZ	T2,T3		;SAVE IT
	ADDB	T3,(T4)		;MAKE LAST IOWD EVEN NO OF BLOCKS
	HLRES	T3		;GOOD WDCNT OF LAST IOWD
	MOVNS	T3		;+N
	ADD	T3,(T4)		;ADR-1 OF 1ST WORD IN PARTIAL BLOCK
	HRL	T3,DEVMBF##(F)	;ADR-1 OF MON BUF
	MOVSS	T3		;SET FOR BLT
	AOBJN	T3,.+1
	ADDI	T2,-1(T3)	;LAST DATA WORD
	BLT	T3,(T2)		;COPY PARTIAL BLOCK TO MON BUF
	MOVE	T2,DEVMBF##(F)	;IOWD FOR PARTIAL BLOCK
	SKIPGE	(T4)		;IF LAST IOWD STILL POINTS TO DATA,
	ADDI	T4,1		; POINT TO NEXT IOWD SLOT
	MOVEM	T2,(T4)		;STORE IOWD FOR WRITING TERMINATING 0'S
SETDM3:
IFN FTKL10,<
	HLRZ	T2,T1		;SAVE ORIGINAL WRDCNT (RH20 MAY NEED IT)
>
	ADD	T1,[XWD BLKSIZ##-1,0]	;ACCOUNT FOR PARTIAL BLOCKS
	LSH	T1,MBKLSH##-^D18	;CONVERT T1 TO BLOCKS
	AOJA	T4,SETLS5	;ZERO IOLIST+1, SET CHNNUM AND RETURN
IFN FTKI10!FTKL10,<
;HERE WHEN NO MONITOR FREE-CORE LEFT
PUNTB:
	JUMPN	P1,SETLS5	;AT NEW IOWD, JUST DO FEWER BUFS
PUNTA:	TLZ	S,IOSMON
PUNTC:	JUMPE	P1,PUNTXX	;IF GOT SOME CORE
	SUB	P1,[XWD 1,1]	; POINT TO LAST FULL IOWD
	SETZM	1(P1)		;ZERO LAST (PARTIAL) IOWD
PUNTD:	JUMPE	P1,PUNTXX	;NO FREE-CORE IF 0
IFE FT22BIT,<
	MOVEI	T1,-1		;GOT SOME, COUNT NO OF WORDS
>
IFN FT22BIT,<
	MOVEI	T4,0		;SET INDEX INTO POINTER-TABLE
	SKIPGE	CHB22B##(P3)	;0 IF 18-BIT CHAN,
	MOVEI	T4,1		;1 IF 22-BIT CHAN
	MOVE	T1,MSK22B##(T4) ;GET MASK FOR ADDRESS
>
	MOVE	T2,P2		;INITIAL ADR OF IOWDS
PUNTE:	SKIPN	T3,(T2)		;GET NEXT IOWD
	JRST	PUNTG		;DONE-DO PARTIAL LIST
	TLNN	T3,-1
	JRST	PUNTF		;GO TO WORD IF POSITIVE
	SUB	T1,T3		;COUNT THE WORDS
IFE FT22BIT,<
	TROA	T1,-1		;IGNORE THE ADDRESS
>
IFN FT22BIT,<
	TDOA	T4,MSK22B##(T4)
>
PUNTF:	SOS	T2,T3		;POINT TO NEW IOWD
	AOJA	T2,PUNTE	;GO DO NEXT IOWD
PUNTG:
IFN FT22BIT,<
	SKIPE	T4
	ASH	T1,-4
>
	HLRS	T1		;SET TO UPDATE DEVDMP
	JRST	SETD2B		;FIX IOLIST AND START IO

;HERE IF COULDN'T GET ANY FREE CORE
PUNTXX:	SETZB	T1,P2		;NO IO LIST, CHNNUM=0 (SO
	JRST	SETLS5		; IOIMPM WILL LIGHT AT INTERRUPT)

>;END FTKI10 CONDITIONAL
;SUBROUTINE TO FIND A UNIT WHICH NEEDS HOME BLOCKS REREAD
;NON-SKIP RETURN IF NO SUCH UNITS
;SKIP RETURN IF FOUND, U POINTS AT UNIT
UNIRHB:	SKIPG	HOMFLG##	;ANY UNITS NEED REREADING?
	POPJ	P,		;NO
	MOVEI	T1,KONTAB##(J)	;YES, SET TO LOOK FOR UNIT
	HRLI	T1,-10
	MOVSI	T2,UNPRHB##	;BIT TO TEST
UNIRH1:	SKIPE	T3,(T1)		;GET A UNIT DATA BLOCK
	TDNN	T2,UNIDES##(T3);NEED REREADING?
	AOBJN	T1,UNIRH1	;NO
	JUMPGE	T1,CPOPJ##	;GO IF DIDNT FIND ANY (DIFFERENT KONTROLLER)
	MOVE	U,T3		;SET U TO UDB TO REREAD
	JRST	CPOPJ1##	;AND NON-SKIP

;SUBROUTINE TO SEE IF ANY UNIT NEEDS HOME BLOCKS READ
;STARTS IO TO READ HOME BLOCKS IF ANY UNITS ON THIS KONTROL NEED IT
;OTHERWISE RETURNS (DISMISSING INTERRUPT)
TSTRHB:	PUSHJ	P,UNIRHB	;ANY UNIT NEED REREADING?
	  JRST	POSDIA		;NO
	PUSHJ	P,FAKDDX	;YES, GET A DDB
	  JRST	POSDIA		;NO FREE CORE, TRY LATER
TSTRHX:	HRRM	U,DEVUNI##(F)	;SAVE U
	SETZM	DEVRHB##(F)	;WHOLE WORD=0 INDICATES REREADING HOME BLOCKS
	MOVE	T1,RHBIOW##	;IOWD TO READ 1ST 10 WORDS
	MOVEM	T1,DEVDMP##(F)	; INTO A BUFFER
	MOVEI	T1,1		;BLOCK 1IS 1ST HOME BLOCK
	MOVEM	T1,DEVBLK##(F)
	MOVE	S,[IOSMON,,IOACT] ;SET S
	MOVEM	S,DEVIOS(F)
	AOS	@KONCHN##(J)	;MARK CHANNEL BUSY
	PJRST	STRTIO		;START THE READ AND RETURN

;SUBROUTINE TO GET A DDB
FAKDDX:	PUSH	P,J		;FAKDDB WIPES OUT J
	PUSHJ	P,FAKDDB##	;GET ONE
	  JRST	JPOPJ##		;NO FREE CORE
	SETZ	J,		;CANT BLAME THIS READ ON ANY JOB,
	DPB	J,PJOBN##	; SO SET PJOBN = 0
	JRST	JPOPJ1##	;RESTORE J AND GOODNESS-RETURN
;HERE WHEN ALL POSITIONING INTERRUPTS HAVE BEEN HANDLED
POSDON:	POP	P,P2		;LH=UNIT #, RH = FUNCTION
	POP	P,P4		;CONI WORD
	POP	P,P3		;DATAI WORD
	HRRZ	U,KONCUA##(J)	;SET U TO UNIT ADDRESS
	JUMPE	U,CPOPJ##	;MIGHT BE SPURIOUS INTERRUPT FROM WRONG KONTROLLER
	HRRZ	F,UNICDA##(U)	; SET F TO FILE ADDRESS
	JUMPE	F,TSTRHB	;FREE INT IF 0 OR UNSOLICITED
	MOVE	S,DEVIOS(F)	;AND S TO S
IFN FTVM,<
	SKIPL	DEVSWP##(F)
	JRST	POSDNS
	HRRM	U,DEVUNI##(F)	;IF MULTIPLE SWAPS ON DIFFERENT DF10'S
	MOVE	T1,UNIBLK##(U)	; DEVBLK AND DEVUNI MAY BE CHANGED
	MOVEM	T1,DEVBLK##(F)	; SO RESTORE THEM TO RIGHT VALUES
POSDNS:
>
IFN	FT5UUO,<
;	SKIPE	UNISTS##(U)	;IF NOT A FREE INTERRUPT W/NO ACTIVE DRIVES,
	MOVEM	P4,DEVSTS(F)	;SAVE CONI WORD IN DDB
>
	TRNE	P2,OPPOS##	;POSITIONING INTERRUPT ONLY?
;THE FOLLOWING INSTRUCTION COUNTS ON THE FACT THAT RP10 DISKS
;DONT GET ERRORS ON SEEKS (EXCEPT SEEK INCOMPLETE, AND DPXKON LIES ABOUT THAT)
;AND THAT RP04 DISKS HAVE IMPLIED SEEKS IF OFF-CYLINDER WHEN IO IS STARTED
POSDIA:
IFE FTDHIA,<
	POPJ	P,		;YES
>
IFN FTDHIA,<
	JRST	[SKIPGE	(P1)
		 JRST	CHNIDL
		 POPJ	P,]
>
	SOS	CHNCFT##(P1)	;NO, DECREASE FAIRNESS COUNTS
	SOS	CHNCFP##(P1)
	PUSHJ	P,ADRINT	;SET UP R
	HRRZ	T4,P2		;ERROR BITS FROM DRIVER
	LDB	T1,UNYPUN##	;UNIT NUMBER
	HLRZ	T2,P2		;UNIT NUMBER THE DEVICE CODE RETURNED
	CAME	T1,T2		;DO THEY AGREE?
	TROA	P2,IOBKTL	;NO - LIGHT IOBKTL
	TRZ	P2,IOBKTL	;YES - ZERO IOBKTL
	SKIPE	CHNNUM##(P1)	;0 BLOCKS XFERRED?
	JRST	POSDN0		;NO (ERROR SETS LH -1 EVEN IF RH IS 0)
IFN FTKI10!FTKL10,<
	LDB	T1,PIOMOD##	;IF DUMP MODE CHNNUM=0
	CAIL	T1,SD		; IFF WE RAN OUT OF LOW-CORE BLOCKS
	JUMPGE	S,POSDN3	; AND WE WILL RECOVER AT DUMPG5
>
	TRO	S,IOBKTL	;YES, 1ST BUFFER HEADER ZAPPED BY USER
	JRST	POSER8		;STORE S, GET NEXT IO
POSDN0:	TRNE	P2,IOIMPM+IODTER+IODERR+IOBKTL	;ERROR?
	JRST	POSERR		;YES, RECOVER
	MOVE	T1,KONIOC##(J)	;GET ADDR OF INAD PAIR
IFN FTKL10,<
	MOVE	T2,CHB22B##(P1)
	TLNE	T2,CP.RH2##	;IS IT AN RH20?
	SKIPA	T1,2(T1)	;YES, TERMINATION WORD IS ELSEWHERE
>
	MOVE	T1,1(T1)	;GET TERMINATION CONTROL WORD
	CAMN	T1,CHNTCW##(P1)	;IS IT WHAT WE EXPECT
	JRST	POSDN1		;YES, CONTINUE
	AOS	UNICCT##(U)	;NO, INCREMENT TERMINATION ERROR COUNT
	TRO	P2,IODTER	;SET AS DATA ERROR TO GET INFO TO ERROR.SYS
				;FALL INTO ERROR HANDLING
;HERE ON ANY ERROR RETURN FROM THE DEVICE DEPENDENT ROUTINE
POSERR:	HRRZ	T1,DEVDMP##(F)	;ADR OF (POSSIBLE) DUMP IOWD
	TLNE	S,IOSMON	;MONITOR CALL?
	JUMPE	T1,POSR5A	;YES. NO ERR RECOVERY IF CHAN SKIP IOWD
	SKIPGE	UNIECT##(U)	;FIRST ERROR (UNFIR)?
	JRST	FSTERR		;YES
IFN FTRP04,<
	TRNE	P2,IOECCX	;ECC-CRRECTABLE ERROR?
	JRST	POSERF		;YES, COMPUTE THE NUMBER OF GOOD BLOCKS PASSED
>
	JRST	POSERA		;NO

;HERE ON FIRST ERROR (DON'T KNOW WHETHER IT WILL BE SOFT OR HARD)
FSTERR:	SETZM	UNIERR##(U)	;YES, ZERO LAST ERROR CONI STATUS
	MOVEM	P4,UNISOF##(U)	;SAVE FIRST CONI IN UNIT DB
	MOVEM	P3,UNISDI##(U)	;SAVE FIRST DATAI
IFN FTRP04,<
	TRNN	T4,IOBKTL+IODTER+IODERR  ;IF NOT DEVICE DETECTED,
	PUSHJ	P,@KONRRG##(J)	; READ THE MASSBUS REGISTERS
>
	PUSHJ	P,FSTREG	;COPY REGISTERS TO RH OF UDB
	MOVEI	T2,CHNDPE##	;ASSUME DATA PARITY ERR ON DEVICE
	TRNE	P2,IOCHMP	;IS IT A MEMORY PARITY ERROR?
	MOVEI	T2,CHNMPE##	;YES, SET FOR MEM PAR ERR
	TRNE	P2,IOCHNX	; IS IT A NXM ERROR
	MOVEI	T2,CHNNXM##	;YES, NXM ERROR
	MOVE	T1,KONIOC##(J)	;INITIAL CONTROL WORD ADR
	TRNN	P2,IOCHMP!IOCHNX	;CHANNEL DETECTED ERROR?
				;(MPE, NXM, OR DATA LATE)
	TRNE	P2,IODTER	;NO, DEVICE ERROR (DO NOT COLLECT CHAN DATA)?
	PUSHJ	P,(T2)		;GO STORE CHANNEL DATA FOR F.S. ON SOFT+HARD ERRORS
	SETZM	UNIECT##(U)	;SET RETRY COUNT TO 0
				;(FIRST ERROR FLAG -UNPFIR AND HARD ERROR FLAG -UNPHRD)
IFN FTRP04,<
	TRC	P2,IODTER!IODERR  ;IODERR AND IODTER BOTH ON
	TRCE	P2,IODTER!IODERR  ; MEAN FORMAT ERROR
	JRST	FSTER2		;NOT FORMAT ERROR
	HRRZ	T1,DEVACC##(F)	;FORMAT - IF A FILE IS OPEN,
	JUMPE	T1,FMTERR
	MOVE	T1,DEVREL##(F)	; AND WE ARE NOT AT FIRST BLOCK OF FILE,
	SOJLE	T1,FMTERR
	TRZ	P2,IODERR	;THEN CALL IT A DATA ERROR,
	JRST	FSTER2		; AND ATTEMPT RECOVERY
FMTERR:	TRO	S,IODERR!IODTER	;FORMAT ERR, NO FILE OR AT 1ST BLOCK
	JRST	POSER8		;INDICATE FORMAT ERR AND DON'T RETRY
FSTER2:>
IFN FT5UUO,<			;5 SERIES UUOS?
	MOVEI	T1,DEPDER	;ERROR-RETRY DISABLED?
	TDNN	T1,DEVSTA(F)	;BY OPEN UUO
	JRST	POSERF		;NO
	AOS	UNISCT##(U)	;YES, COUNT A SOFT ERROR
	PUSH	P,CHNNUM##(P1)	;SAVE NO OF BLOCKS XFERRED
	PUSHJ	P,CTGOOD	;COMPUTE BAD BLOCK
	ADD	T1,DEVBLK##(F)
	MOVEM	T1,UNIHBN##(U)	;SAVE IN UDB
	POP	P,CHNNUM##(P1)	;RESTORE NO OF BLOCKS
	JRST	POSR1A		;NO RETRY
>
POSERF:	PUSHJ	P,CTGOOD	;COMPUTE THE NUMBER OF GOOD DATA BLOCKS
	HRLM	P2,CHNNUM##(P1)	;STORE ERROR BITS IN CASE CHN MEM PAR
				; SO CAN CALL SWEEP AFTER LAST TRY
	ADD	T1,DEVBLK##(F)	;FIRST LOGICAL BLOCK OF THIS TRANSFER
	MOVEM	T1,UNIHBN##(U)	;STORE LOGICAL BLOCK OF ERROR FOR F.S.
				; TELL LATER IF HARD OR SOFT
POSERA:	MOVEI	T4,1		;SET BIT FOR ERR COUNTER, ASSUME DATA ERR
	TRNE	P2,IODERR	;DEVICE ERROR?
	MOVSI	T4,1		;YES, COUNT AS DEVICE ERROR
	ADDM	T4,UNIECT##(U)	;ACCUMULATE ERROR COUNT
IFN FTRP04,<
	TLNN	S,IO		;IF READING
	TRNN	P2,IOECCX	;AND AN ECC-CORRECTABLE ERROR
	JRST	NOECC1
IFN FTKI10!FTKL10,<
	SKIPGE	DEVSWP##(F)	;IF SWAPPER
	JRST	NOECC1
	PUSHJ	P,SVEUF##	;MAKE JOB ADDRESSABLE
>
	SOS	T1,UNIHBN##(U)	;GET BLOCK BEFORE THE BAD ONE
	SUB	T1,DEVBLK##(F)	;COMPUTE NUMBER OF GOOD BLOCKS
	PUSH	P,DEVDMP##(F)	;SAVE DEVDMP
	LDB	T2,PIOMOD##	;IF DUMP MODE
	CAIGE	T2,SD
	JUMPGE	S,ECC1		;OR MONITOR IO
	HRRM	T1,CHNNUM##(P1) ;SAVE NUMBER OF GOOD BLOCKS
	AOS	CHNNUM##(P1)	;+1 FOR THE BLOCK WE'LL CORRECT
	LSH	T1,BLKLSH##	;CONVERT TO WORDS
	HRLS	T1
	ADD	T1,KONDMP##(J)	;UPDATE THE IOWD
	JUMPL	S,ECC3		;IF NOT MONITOR IO
	MOVE	T2,T1		; UPDATE IOWD FOR THE DDB
	ADD	T2,[BLKSIZ,,BLKSIZ]
	CAMLE	T1,[MBLKSZ,,0]	;IF LESS THAN 1 BLOCK IN IOWD
	TLZ	T2,-1
	MOVEM	T2,DEVDMP##(F)
	SUBI	T1,(R)		;UNRELOCATE THE IOWD
	JRST	ECC3		;AND CONTINUE
;HERE IF ERROR WAS IN BUFFERED MODE
ECC1:	HRRZ	T2,DEVIAD(F)	;LOC OF 1ST BUFFER
	JUMPE	T1,ECC2
IFN FTKA10,<
	TLO	T2,R
>
	EXCTUX	<HRR T2,@T2>	;ADVANCE THE NUMBER OF GOOD BUFFERS
	SOJG	T1,.-1
ECC2:	MOVEI	T1,1(T2)	;POINT T1 AT LOC-1 OF BAD BLOCK

;HERE WITH T1=UVA-1 OF START OF BAD BLOCK (OR EVA-1 IF MONITOR BUFFER)
ECC3:	PUSH	P,T1		;SAVE LOC
	HRRZ	T1,CHNNUM##(P1)
	JUMPE	T1,NOECC	;CHAN GOOFED IF NO BLOCKS XFERRED
	PUSHJ	P,@KONECC##(J)	;GET RELATIVE POSITION OF BAD WORD
	  JRST	NOECC		;OOPS
	CAILE	T1,BLKSIZ##-1	;IF THE ERROR IS IN THE ECC BYTE,
	JRST	[POP P,(P)
		 POP P,(P)
		 JRST POSDN1]	;NO CORRECTION NEEDED
	LDB	T4,PIOMOD##	;IF DUMP MODE,
	CAIGE	T4,SD
	JUMPGE	S,ECC4
	HLRE	T4,DEVDMP##(F)	;WORD COUNT OF IOWD
	SUBI	T4,BLKSIZ##	; PRIOR TO BAD BLOCK
	ADDI	T4,(T1)		;+ POSITION OF ERROR BURST
	JUMPL	T4,ECC4		;CONTINUE IF HE'S READING THAT PART OF BLOCK
	MOVEI	T3,0		;NO CORRECTION FOR 2ND PART, HE'S NOT READING IT
	SKIPE	T4		;READING 1ST WORD OF ERROR BURST?
	MOVEI	T2,0		;NO, DON'T CORRECT 1ST PART EITHER
ECC4:	POP	P,T4		;RESTORE START OF BLOCK
	POP	P,(P)		;REMOVE SAVED DEVDMP FROM LIST
	ADDI	T1,1(T4)	;POINT T1 AT 1ST BAD WORD
	JUMPL	S,ECC6		;IF NOT MONITOR IO,
IFN FTKA10,<
	TLO	T1,R
>
	JUMPE	T2,ECC5		;NO, 1ST PART IF T2=0
	EXCTUX	<MOVS T4,@T1>	;THIS WILL HAVE TO BE MODIFIED IF WE GET
				; OTHER HARDWARE WHICH DOES ECC DIFFERENTLY
	XOR	T4,T2		;APPLY MASK
	EXCTXU	<MOVSM T4,@T1>	;AND SAVE RESULT
ECC5:	ADDI	T1,1
	JUMPE	T3,POSDN1	;NO 2ND PART IF T3=0
	EXCTUX	<MOVS T4,@T1>	;GET 2ND WORD
	XOR	T4,T3		;APPLY MASK
	EXCTXU	<MOVSM T4,@T1>	;AND SAVE RESULT
	JRST	POSDN1		;LOG A RECOVERED ERROR AND CONTINUE

;HERE IF ERROR IN MONITOR IO (INTO MON BUF)
ECC6:	JUMPE	T2,ECC7		;NO 1ST PART IF T2=0
	MOVS	T4,(T1)		;GET 1ST BAD WORD
	XOR	T4,T2		;APPLY MASK
	MOVSM	T4,(T1)		;AND SAVE
ECC7:	JUMPE	T3,POSDN1	;NO 2ND PART IF T3=0
	MOVS	T4,1(T1)	;GET 2ND BAD WORD
	XOR	T4,T3		;CORRECT
	MOVSM	T4,1(T1)	;AND SAVE
	JRST	POSDN1		;AND CONTINUE

;HERE IF WE REALLY COULDNT RECOVER THOUGH WE THOUGHT WE COULD
NOECC:	POP	P,(P)		;REMOVE RELATIVE ADDR FROM LIST
	POP	P,DEVDMP##(F)	;RESTORE ORIGINAL DEVDMP TO THE DDB
	MOVEI	T4,1		;COUNT DATA ERROR
NOECC1:>
	AOS	T1,CHNECT##(P1)	;UPDATE COUNT OF TRIES
	CAIN	T1,1		;FIRST RETRY OR 1ST AFTER RECAL?
	CAME	T1,CHNRCT##(P1)	;YES, THIS 1ST RECAL?
	JRST	POSERB		;NO
	MOVEM	P4,UNIERR##(U)	;YES. SAVE 2ND ("HARD") CONI WORD
	MOVEM	P3,UNIHDI##(U)	;SAVE "HARD" DATAI WORD
	PUSHJ	P,LSTER		;SAVE THE DRIVE REGISTERS NOW
POSERB:	MOVE	T2,UNISTS##(U)	;STATE OF UNIT
	CAIE	T2,TCOD		;IGNORE IF POSITIONING,
	POPJ	P,		;RETRY IF XFER (ERROR RECOVERY)
	MOVE	P4,T4		;SAVE ERROR-COUNT WORD
IFN FTRP04,<
	TRNN	T2,IOHDER	;HEADER ERROR
	TRNN	P2,IODERR	; OR DATA ERROR? (AND NOT FMT)
	SKIPG	T2,KONERR##(J)	;YES, WILL KONTROL ROUTINE TELL US WHAT TO DO?
	JRST	NOOFST		;NO
	HLRZ	T1,UNIECT##(U)	;USE LH(UNIECT) IF HEADER ERROR
	ADD	T1,UNIECT##(U)	; OR RH IF DATA ERROR
	HRRZS	T1		;ONE HALF MUST HAVE COUNTED UP
	PUSHJ	P,(T2)		;ASK THE KONTROLLER ROUTINE
	JRST	@ERRTBL(T1)	;AND GO DO WHAT IT SAID

ERRTBL:	STARTE			;(0) RETRY
	OFFSET			;(1) OFFSET
	POSERE			;(2) LAST TIME
	POSERG			;(3) GIVE UP
	POSERD			;(4) RECAL

NOOFST:>
	HRRZ	T2,UNISTR##(U)	;LOC OF STR DATA BLOCK
	LDB	T3,STYTRY##	;NO OF TIMES TO RETRY
	TRNE	P2,IODERR	;DEVICE (POSITIONING) ERROR?
	LDB	T3,STYSER##	;YES. USE A DIFFERENT PARAMETER
	SKIPN	T2		;UNIT IN AN STR?
	MOVEI	T3,^D10		;NO, USE 10
	SUB	T1,T3		;HAVE WE TRIED ENOUGH?
	JUMPL	T1,STARTE	;RETRY IF NEGATIVE
	TRNE	P2,IOBKTL	;WRONG UNIT?
	JRST	POSERC		;YES, DONT TRY RECAL
	AOS	T4,CHNRCT##(P1)	;UPDATE RECALIBRATE-COUNTER
	LDB	T3,STYRCL##	;NO OF TIMES TO RECAL
	SKIPN	T2		;UNIT IN AN STR?
	MOVEI	T3,^D10		;NO, USE 10
	SUB	T4,T3		;TRIED ENOUGH?
	JUMPGE	T4,POSER0	;TRIED ENOUGH IF T4=0
POSERD:	SETOM	CHNECT##(P1)	;NO. SET A SWITCH FOR RECALR
	PUSHJ	P,@KONRCL##(J)	;DO A RECALIBRATE
	  JRST	POSER0		;NOT A PACK OR UNIT DOWN
	PJRST	STOIOS##	;RECALIBRATING - RESET HUNG TIME, DISMISS INTERRUPT
POSER0:	JUMPG	T1,POSER1	;GO IF NOT LAST TIME
POSERE:	MOVEI	T1,KONRED##(J)	;LAST TIME - SET TO NO STOPPING
	TLNE	S,IO		; ON ERROR SO ALL OF DATA IS ATTEMPTED
				; TO BE TRANSFERRED ON LAST RETRY
	MOVEI	T1,KONWRT##(J)	
IFN FTRP04,<
	MOVSI	T2,DEPCPT##	;IF IN 10/11 COMPAT MODE,
	TDNE	T2,DEVCPT##(F)
	ADDI	T1,2		;CALL THE COMPATABILITY ENTRY
>
	PUSHJ	P,@(T1)		;CALL DEVICE DEPENDENT ROUTINE
	  PJRST	BADUNI		;UNIT NOT UP
	POPJ	P,		;DISMISS THE INTERRUPT
IFN FTRP04,<
;HERE WHEN ERROR IS DECLARED HARD FOR AN ERROR-PROGRAM KONTROLLER
POSERG:	PUSHJ	P,LSTER		;READ ALL DRIVE REGISTERS
	JRST	POSER1		;AND GO DECLARE HARD ERROR
>
IFN FTRP04,<
OFFSET:	HRROS	CHNECT##(P1)	;CHNECT=-1,,N TO INDICATE OFFSET IN PROGRESS
	PJRST	STOIOS##
>

;SUBROUTINE TO COUNT THE NUMBER OF GOOD DATA BLOCKS
;UPDATES CHNNUM IF NOT DUMP-MODE
;RETURNS NO OF GOOD BLOCKS IN T1
CTGOOD:	HRRZ	T1,KONIOC##(J)	;INITIAL CONTROL WORD ADDRESS
	PUSHJ	P,WRDCNT##	;COMPUTE NO. OF GOOD WORDS TRANSFERRED
IFN FTRP04,<
	TRNE	P2,IOECCX	;ECC CORRECTABLE ERROR?
	ADDI	T1,BLKSIZ##-2	;YES, MAKE SURE "BAD" BLOCK IS COUNTED
>
	LSH	T1,MBKLSH##	;CONVERT TO # OF GOOD BLOCKS
	SKIPGE	DEVSWP##(F)	;IF SWAPPER
	POPJ	P,		; DON'T CHANGE CHNNUM
	LDB	T2,PIOMOD##	;IS IT DUMP MODE?
	CAIGE	T2,SD		;(DONT CHANGE CHNNUM SINCE DEVDMD
				; HAS BEEN UPDATED COUNTING ON IT
	HRRZM	T1,CHNNUM##(P1)	;STORE NO. OF GOOD BLOCKS TRANSFERRED
				; ON FIRST TRY TO BE USED BY BUFAD
				; IF THIS PROVES TO BE HARD ERROR
				; FLAG ERROR SO NON-ZERO EVEN IF IN FIRST BLOCK
				; SO DIFFERENT FROM USER ZAP FIRST BUFFER
	POPJ	P,
;SUBROUTINE TO COPY THE DRIVE REGISTERS INTO THE RH OF THE UDB
;CALLED ON FIRST ERROR, WIPES OUT LH OF UDB REG'S
FSTREG:	SKIPN	T2,KONREG##(J)	;GET NUMBER OF DRIVE REGISTERS TO STORE
	POPJ	P,		;NONE - NOT A MASSBUS DEVICE
	ADDI	T2,UNIEBK##(U)	;POINT TO TOP OF BLOCK
	MOVSI	T1,KONEBK##(J)	;WHERE THEY WERE SAVED
	HRRI	T1,UNIEBK##(U)	;WHERE THEY ARE TO GO
	BLT	T1,-1(T2)	;SAVE THEM
	MOVE	T1,UNILAS##(U)	;LAST DATAO
	MOVEM	T1,(T2)		;SAVE IN THE UDB
	MOVE	T1,KONECR##(J)	;GET KONTROLLER
	MOVEM	T1,UNISCR##(U)	; CONTROL REG & DATA REG
	MOVE	T1,KONEDB##(J)	;AND SAVE IN UDB
	MOVEM	T1,UNISDR##(U)
	POPJ	P,		;AND RETURN


;SUBROUTINE TO SAVE THE DRIVE REGISTERS IN THE UDB
; RESPECTS T1,T4
LSTER:	PUSH	P,T1
	MOVN	T1,KONREG##(J)	;NUMBER OF REGISTERS TO SAVE
	JUMPE	T1,TPOPJ##
	HRLS	T1		;MAKE AN AOBJN WORD
	HRRI	T1,KONEBK##(J)
	MOVEI	T2,UNIEBK##(U)	;WHERE TO STORE
LSTER1:	MOVE	T3,(T1)
	HRLM	T3,(T2)		;SAVE A DRIVE REGISTER IN LH OF UDB WORD
	ADDI	T2,1
	AOBJN	T1,LSTER1	;GET ANOTHER WORD
	MOVE	T1,UNILAS##(U)	;LAST DATAO TO THE DRIVE
	HRLM	T1,(T2)		;SAVE IN UDB
	MOVE	T1,KONECR##(J)	;SAVE KONTROLLER (RH10)
	MOVEM	T1,UNIHCR##(U)	; CONTROL REG & DATA REG
	MOVE	T1,KONEDB##(J)	;IN UDB
	MOVEM	T1,UNIHDR##(U)
	JRST	TPOPJ##		;AND RETURN
;HERE ON HARD WRONG-UNIT
POSERC:	TLNE	S,IO		;IF READING, CONTINUE
	STOPCD	.,JOB,HWU,	;++HARD WRONG UNIT
;HERE ON HARD DEVICE OR DATA ERRORS
POSER1:	SOJE	T1,STARTE	;LAST RETRY, STOP ON ERROR, IF 1
	ADDM	P4,UNIHCT##(U)	;UPDATE HARD-ERROR WORD
	TLNE	P4,-1		;BEEN COUNTING IN LH (POSITION ERRS)?
	HLRZS	UNIECT##(U)	;YES. SAVE COUNT IN RH (UNIECT)
	MOVSI	T1,UNPHRD##	;HARD ERROR FLAG ON LAST ERROR ON THIS UNIT
	IORM	T1,UNIECT##(U)	;SET FOR DAEMON AND SYSERR
	PUSHJ	P,CHKCMP	;CHECK IF CHN MEM PAR ERR
				; IF YES, FLAG CPU MEM SWEEP

;HERE IF USER AVOIDING ALL RETRIES
POSR1A:
IFN FTKL10,<
	TLNN	S,IO		;IF INPUT,
	PUSHJ	P,CFDMP		;FLUSH CACHE SO BAD DATA WILL BE SEEN
>		;END IFN FTKL10
	JUMPL	S,POSR5A	;ONLY 1 IOWD IF MONITOR IO
	HRRZ	P4,CHNNUM##(P1)	;GET # OF GOOD BLOCKS FOR BUFAD
	PUSHJ	P,BUFAD		;ADVANCE THE GOOD BUFFERS
	  JFCL
POSR5A:	PUSH	P,P2		;SAVE ALL ERROR BITS
	ANDI	P2,IOIMPM+IODTER+IODERR+IOBKTL+IOCHMP+IOCHNX	;P2=ERROR BITS
	TRNN	P2,IOCHMP+IOCHNX ;CHAN-DETECTED ERROR?
	JRST	POSR5C		;NO
	SKIPL	DEVSWP##(F)	;SWAPPER?
	TRZ	P2,IOCHMP+IOCHNX ;NO, DON'T KEEP THESE ERR BITS
POSR5C:	OR	S,P2		;STORE ERROR BITS IN S
	POP	P,P2
	JUMPL	S,POSER6	;GO IF MONITOR IO
	LDB	T1,PIOMOD	;MODE
	CAIL	T1,SD		;WE DIDN'T STOP EARLY IF DUMP-MODE
	JRST	POSER6		; SO DON'T FIDDLE WITH DEVBLK, ETC.
	AOS	DEVBLK##(F)	;UPDATE DB LOCS WHICH POINT TO BLOCK
	AOS	DEVREL##(F)	; UPDATE DEVREL
	SOS	DEVLFT##(F)
	PUSHJ	P,(P3)		;ADVANCE 1 MORE BUFFER (THE BAD ONE)
	  JFCL
POSER6:	TRNN	S,IODTER	;PARITY ERROR?
	JRST	POSER7		;NO
	TLNE	S,IO		;YES. LIGHT ERR BIT IN LH(S)
	TLOA	S,IOSHWE##	; BECAUSE USER CAN CLEAR RH OF S (SETSTS)
	TLO	S,IOSHRE##
	MOVE	T1,KONIOC##(J)	;INITIAL CONTROL WORD ADR
	PUSHJ	P,CHNDPE##	;LOG THE ERROR
POSER7:	TRNE	S,IODERR	;DEVICE (POSITIONING) ERROR?
	TLO	S,IOSSCE##	;YES. LIGHT A BIT IN LH(S) SOFTWARE CHECKSUM
				; OR DEVICE ERROR
IFN FTDBBK,<
	SKIPE	DEVELB##(F)	;IF NOT ALREADY A BAD BLOCK,
	JRST	POSER8
	MOVE	T1,UNIHBN##(U)	;BAD BLOCK NO. STORED ON FIRST ERROR
	TRNE	P2,IODTER	;GET ERROR CODE
	TLO	T1,BAPDTR##	; (DATA ERR,HEADER ERR, OR OTHER)
	TRNE	P2,IOHDER	;HEADER ERR?
	TLO	T1,BAPHDR##	;YES
	TRNN	P2,IODTER+IOHDER ;NOT HEADER OR DATA?
	TLO	T1,BAPOTR##	;"OTHER"
	TRNN	P2,IOCHNX+IOCHMP  ;CHANNEL ERRORS?
	MOVEM	T1,DEVELB##(F)	;STORE BLOCK + CODE IN DDB
	LDB	T1,UNYLUN##	;AND SAVE THE LOGICAL UNIT NUMBER
	DPB	T1,DEYEUN##	;FOR ERRFIN
>
POSER8:	PUSHJ	P,STDIOD##	;YES. WAKE IT UP
IFN FTDAEM,<			;DAEMON CODE?
	MOVEI	T1,.ERDPE	;CODE FOR DISK ERROR
	HRL	T1,F		;PUT DDB ADDR IN LH FOR DAEMON
	SKIPN	DINITF		;DON'T TRY TO STOP THE JOB OR WAKE
				; DAEMON IF IN ONCE-ONLY
	PUSHJ	P,DAEERR##	;STOP JOB, WAKE UP DAEMON
>
IFN FTKI10!FTKL10,<
	SKIPE	T1,@KONIOC##(J)	;ARE THERE ANY IOWDS?
	PUSHJ	P,RTNIOW##	;YES, GIVE THEM BACK
>
	PJRST	SETIDL		;SET THIS FILE IDLE AND LOOK FOR ANOTHER
;HERE WHEN THERE WAS NO HARDWARE ERROR ON THE DATA TRANSFER
POSDN1:	SKIPG	T1,UNIECT##(U)	;NO. IS THIS A RECOVERED ERROR (UNPFIR)?
	JRST	POSDN2		;NO - NO ERROR AT ALL (USUAL)
	MOVSI	T2,1		;YES, FOR POSSIBLE UPDATE OF LH
	TLNN	T1,-1		;DEVICE ERROR?
	AOSA	UNISCT##(U)	;NO, DATA ERROR UPDATE RH(UNISCT)
	ADDM	T2,UNISCT##(U)	;YES, UPDATE LH(UNISCT)
	TLNE	T1,-1		;WERE WE COUNTING IN LH (POSITION ERRS)?
	HLRZS	T1,UNIECT(U)	;YES, SET UNIECT= NUMBER IN RH
IFN FTDAEM,<			;DAEMON CODE?
	MOVE	T2,CHNNUM##(P1)	;IF AN OVERRUN
	TLNE	T2,IOVRUN	; RECOVERED ON 1ST RETRY,
	SOJE	T1,[SKIPN ALLOVR##  ;DON'T CALL DAEMON
		   JRST POSD1A	; IF ALLOVR = 0
		   JRST .+1]
	MOVEI	T1,.ERDPE	;CODE FOR DISK ERROR
	HRL	T1,F		;PUT DDB ADDR IN LH FOR DAEMON
	SKIPN	DINITF		;DON'T TRY TO STOP THE JOB OR WAKE
				; DAEMON IF IN ONCE-ONLY
	PUSHJ	P,DAEERR##	;STOP JOB, WAKE UP DAEMON
>
	PUSHJ	P,CHKCMP	;CHECK IF THIS WAS A CHN MEM PAR
				; IF YES, FLAG FOR CPU SWEEP
POSD1A:	PUSHJ	P,CTGOOD	;RESET CHNNUM TO NO OF GOOD BLOCKS
	SKIPE	UNIERR##(U)	;IS THIS BEFORE FIRST RECAL?
	JRST	POSDN2		;NO, "HARD" CONI STUFF ALREADY STORED
	MOVEM	P4,UNIERR##(U)	;YES, SAVE "HARD" CONI
	MOVEM	P3,UNIHDI##(U)	;SAVE "HARD" DATAI
	PUSHJ	P,LSTER		;SAVE THE DRIVE REGISTERS AT END (THEY PROBABLY ARE
				; MEANINGLESS AT  THIS POINT SINCE THEY ARE ONLY
				; STORED AT ERROR TIME, BUT ITS BETTER THAN NOTHING
POSDN2:	TLNN	S,IO+IOSMON
	TLZN	S,IOSFIR	;TIME FOR CHECKSUMS?
IFN FTKL10,<
	JRST	.+2		;NOT TIME FOR CHECKSUMS, SO WE DON'T HAVE
				; TO SWEEP YET.
	JRST	POSD2A		;CHECKSUM TIME, SWEEP IMMEDIATELY
	MOVSI	T1,CP.SWF##	;GET READY TO SET THE BIT
	TLNN	S,IO		;READING?
	IORM	T1,CHB22B##(P1)	;YES, INDICATE THAT A SWEEP MUST BE
				; DONE BEFORE INTERRUPT EXIT TIME.
	JRST	POSDN3		;CONTINUE.
POSD2A:	PUSHJ	P,CFDMP		;CHECKSUM TIME, SO SWEEP THAT WE MAY SEE
				; THE DATA NOW.
>;END IFN FTKL10
IFN FTKA10!FTKI10,<
	JRST	POSDN3		;NO. CONTINUE
>;END IFN FTKA10!FTKI10
	PUSHJ	P,CHKSUM	;YES. COMPUTE CHECKSUM
	SKIPN	T2,@DEVRET##(F)	;PICK UP RETRIEVAL PNTR
	MOVE	T2,DEVRB1##(F)	;1ST PNTR, MORE IN RIB
	HRRZ	T3,UNISTR##(U)	;LOC OF STR DB
	LDB	T2,STYCKP##(T3)	;GET CHECKSUM
	CAMN	T2,T1		;DOES IT MATCH COMPUTED CHECKSUM?
	JRST	POSDN3		;YES. OK
	MOVE	T2,DEVACC##(F)	;LOC OF A.T.
	MOVE	T4,ACCNCK##(T2)	;ALWAYS-BAD-CHECKSUM WORD
	TRNE	T4,ACPNCK##	;FILE A DIRECTORY OR HAVE ABC?
	JRST	POSDN3		;YES. IGNORE ERROR
	MOVE	T4,DEVREL##(F)	;NO. RELATIVE BLOCK NUMBER
	MOVE	T2,ACCPT1##(T2)	;CURRENT 1ST POINTER
	LDB	T2,STYCKP##(T3)	;CHECKSUM BYTE
	CAMN	T2,T1		;MATCH?
	SOJE	T4,POSDN3	;YES, IF 1ST BLOCK FILE IS A UFD WHOSE 
				;CHECKSUM HAS CHANGED BETWEEN LOOKUP AND INPUT
	AOS	UNIMCT##(U)	;REAL CHKSUM ERR. COUNT SOFTWARE ERROR
	TDO	S,[XWD IOSSCE##,IOIMPM];LIGHT ERROR BIT (LH SINCE USER CAN CLEAR IOIMPM)
	PUSHJ	P,CTGOOD	;T1= NO. OF GOOD BLOCKS TRANSFERRED
	ADD	T1,DEVBLK##(F)	;FIRST LOGICAL BLOCK OF TRANSFER
	MOVEM	T1,UNIHBN##(U)	;STORE BAD BLOCK NO. FOR ERROR REPORTING
IFN FTDAEM,<			;DAEMON CODE?
	MOVEI	T1,.ERDPE	;SAY DISK ERROR FOR DAEMON
	HRL	T1,F		;PUT DDB ADDR IN LH FOR DAEMON
	PUSHJ	P,DAEERR##	;STOP JOB, WAKE UP DAEMON
>
POSDN3:	SKIPLE	DEVSWP##(F)	;FILE IN IOWAIT?
	PUSHJ	P,STDIOD##	;YES. WAKE JOB UP
	MOVEM	S,DEVIOS(F)	;SAVE S IN DDB
IFN FTKI10!FTKL10,<
	SKIPE	T1,@KONIOC##(J)	;RETURN THE FREE-CORE BLOCKS
	PUSHJ	P,RTNIOW##
>
	HRRZ	P4,CHNNUM##(P1)	;NO OF BLOCKS TRANSFERRED
IFN FTDSTT,<
	LDB	T1,PJOBN##	;JOB NUMBER
;	HRRZ	T1,JBTPDB##(T1)	;ADDR OF PDB FOR JOB
	TLNN	S,IO		;READING?
	ADDM	P4,JBTRCT##(T1)	;YES. UPDATE JOB READ COUNT
	TLNE	S,IO		;WRITING?
	ADDM	P4,JBTWCT##(T1)	;YES, INCREMENT NO BLOCKS WRITTEN BY THIS JOB
>
	JUMPL	S,SETMDL	;MONITOR IO? YES IF S NEG
	PUSHJ	P,BUFAD		;NO. UPDATE DDB, ADVANCE BUFFERS
	  JRST	SETIDL		;NEXT BUFFER NOT USABLE, OR DUMP MODE
				;AT LEAST 1 BUFFER IS AVAILABLE 
	PUSHJ	P,CHKNXT	;ANY MORE BLOCKS ON DISK NOW?
	  JRST	SETIDL		;NO. SET FILE, UNIT TO IDLE
	SKIPL	KONPOS##(J)	;YES. DOES KONTROLLER POSITION?
	JRST	SETPW		;YES. SET FILE TO PW STATE
	PUSHJ	P,SETTW0	;NO, SET FILE TO TW STATE
	JRST	PIKTRN		;AND LOOK FOR NEXT TRANSFER OPERATION

;ROUTINE TO INITIATE CPU MEM PAR SWEEP AFTER ALL RETRIES DONE
; IF ERROR WAS A MEM PARITY DETECTED BY THE CHANNEL
; MUST WAIT TILL END BECAUSE SWEEP CLEARS PARITY ERRORS
;CALL:	MOVE	P1,CHANNEL DATA BLOCK ADDRESS
;	PUSHJ	P,CHKCMP
;	RETURN

CHKCMP:	MOVE	T1,CHNNUM##(P1) ;LH=IO STATUS ERR BITS ON RETRIES
	HLLZ	T2,.CHCSR(P1)	;FLAG FOR THIS CHANNEL TO REQUEST CPU0 SWEEP
	TRO	T2,UE.PEF	;CAUSE PARITY (NOT NXM) SWEEP
	TLNE	T1,IOCHMP	;DID CHAN DETECT MEM PAR?
	IORM	T2,.C0AEF##	;YES, FLAG CPU0 TO DO A CORE SWEEP
	POPJ	P,		;RETURN

;HERE IF FILE IS ON A POSITIONING DEVICE
;SET FILE TO PW STATE, ADD TO PWQ
SETPW:	MOVEI	T1,PWCOD##	;SET FILE, UNIT TO PW
	PUSHJ	P,FILCOD
IFN FTDUAL,<
	PUSHJ	P,SECCOD	;SET STATE OF PRIME UNIT IF THIS ALTERNATE
>
	MOVEI	T1,UNIQUE##(U)	;SET T1=UNI PWQ
	PUSHJ	P,PUTQUE	;PUT FILE ON Q
	JRST	SETID1		;AND LOOK FOR ANY POSITIONING TO DO

;HERE WHEN MONITOR IO DONE - SET FILE TO IDLE
SETMDL:	MOVEI	T1,UNIMRC##(U)	;SET TO UPDATE UNIMRC (UNIMWC)
	PUSHJ	P,UPSTAT	;UPDATE STATISTICS FOR UNIT

;HERE TO SET FILE TO IDLE 
SETIDL:
IFN FTVM,<
	SKIPL	DEVSWP##(F)	;IF NOT THE SWAPPER
>
	TLZ	S,IOSMON	;MAKE SURE IOSMON IS OFF
	SKIPE	DEVRHB##(F)
	JRST	SETIDA
	SOSGE	HOMFLG##
	STOPCD	RERED1,DEBUG,RHN, ;++REREAD-HOMEBLOCK-COUNT NEGATIVE
	MOVSI	T2,UNPRHB##	;CLEAR REREAD HOME BLOCKS
	ANDCAM	T2,UNIDES##(U)	; FROM UDB
	TRNE	S,IOIMPM	;READ GO OK?
	JRST	RERED1		;WENT OFF-LINE AGAIN
	MOVS	T1,HOMBUF##	;IS 1ST WORD HOME,
	CAIN	T1,'HOM'
	TRNE	S,IODERR+IODTER; AND NO DATA ERRORS?
	JRST	RERED2		;CANT READ HOME BLOCK, CALL MDA
	MOVE	T1,UNIHID##(U)	;READ OK, IS IT WHAT WE EXPECT?
	CAME	T1,HOMBID##
	JRST	RERED2		;HOME BLOCKS DONT MATCH
RERED1:	PUSHJ	P,CLRDDB##	;ALL IS WELL, GIVE UP DDB
	SETZM	UNISTS##(U)	;SET UNIT IDLE
	JRST	SETIDD		;AND CONTINUE

;HERE IF CANT READ HOME BLOCKS OR NO MATCH
RERED2:
IFN FTMDA,<
	SKIPGE	UNIPTR##(U)	;IF UNIT HAS SWAPPING SPACE
	JRST	RERED3		; COMPLAIN TO THE OPERATOR
	PUSHJ	P,CALMDA	;OTHERWISE LET MDA HANDLE IT
	  JRST	RERED3		;NO MDA, COMPLAIN
	PUSHJ	P,CLRDDB##	;MDA IS RUNNING, RETURN DDB
	PUSHJ	P,SET4MD	;SET SO ONLY MDA CAN READ DRIVE
	JRST	SETIDC		;AND GO FIND SOMETHING ELSE TO DO
RERED3:>
;HERE IF UNIT HAD SWAPPING SPACE OR IF MDE ISNT RUNNING. COMPLAIN ABOUT UNIT
	PUSH	P,F		;SAVE F AND U
	PUSH	P,U
	HRRZ	U,OPRLDB##	;TALK TO OPR
	PUSHJ	P,INLMES##
	BYTE	(7)7,7,7,7,7	;SOME BELLS
	ASCIZ	/
WRONG PACK POWERED UP ON /
	MOVE	T2,(P)		;UDB
	PUSH	P,UNIHID##(T2)	;SAVE WHAT WE THINK IT IS
	MOVE	T2,UNINAM##(T2);PHYSICAL NAME
	PUSHJ	P,PRNAME##
	PUSHJ	P,INLMES##
	ASCIZ	/ IS /
	MOVE	T2,HOMBID##	;WHAT WE READ
	PUSHJ	P,PRNAME##
	PUSHJ	P,INLMES##
	ASCIZ	/, SHOULD BE /
	POP	P,T2		;WHAT WE EXPECT
	PUSHJ	P,PRNAME##
	PUSHJ	P,INLMES##
	ASCIZ	/
PLEASE DISMOUNT IT AND MOUNT THE CORRECT PACK
/
	POP	P,U
	POP	P,F		;RESTORE ACS
	MOVEI	T1,OCOD##	;SET FOR ONCE-A-MINUTE GRUMP AT OPR
	MOVEM	T1,UNISTS##(U)	; AND NO IO TO START WHEN IT COMES UP
	PUSHJ	P,CLRDDB##	;RETURN THE FAKE DDB
	JRST	SETIDC		;AND FIND SOMETHING ELSE TO DO

IFN FTMDA,<
;SUBROUTINE TO SEND A MESSAGE TO THE MOUNTABLE DEVICE ALLOCATOR
CALMDA:	MOVE	T1,UNINAM##(U)	;SIXBIT /DEV NAME/
	MOVEI	T2,.TYDSK	;ITS A DSK
	PUSHJ	P,SNDMDC##	;TELL MDC
	  POPJ	P,		;MDC ISNT THERE
	JRST	CPOPJ1##	;MDC IS THERE
>
;HERE FROM BADUNI TO SET THE FILE IDLE. DON'T CLEAR IOSMON
SETIDA:	MOVEI	T1,ICOD##	;YES. SET FILE, UNIT TO I
	PUSHJ	P,FILCOD
SETIDD:
IFN FTDUAL,<
	SKIPN	UNIQUE##(U)	;THIS UNIT GOING IDLE?
	SKIPL	T1,UNI2ND##(U)	;YES, IS THERE A PRIME UNIT?
	JRST	SETIDB		;NO
	MOVE	T2,UNIQUE##(T1) ;YES, PUT POS. QUEUE OF PRIME UNIT
	HLLM	T2,UNIQUE##(U)	; ONTO THIS UNIT INSTEAD, TO START SEEK
	SETZM	UNIQUE##(T1)	; ON THIS UNIT NOW. PRIME UNIT HAS NO QUEUE NOW
SETIDB:>
	MOVEI	T1,PWCOD##
	SKIPE	UNIQUE##(U)	;ARE POSITIONS WAITING FOR UNIT?
	MOVEM	T1,UNISTS##(U)	;YES. PUT UNIT IN PW
SETIDC:
IFN FTDUAL,<
	PUSHJ	P,SECCOD
>
	HRLZS	UNICDA##(U)	;NO CURRENT DDB
IFN FTVM,<
	SKIPGE	DEVSWP##(F)	;SWAPPER?
	JRST	SETID0		;YES, TELL VMSER ABOUT THE REQUEST
>
	PUSHJ	P,CLRACT##	;CLEAR IOACT
IFN FTSWAP,<
IFE FTVM,<
	SKIPL	DEVSWP##(F)	;IS IT THE SWAPPER?
>
	JRST	SETID1		;NO, CONTINUE
IFE FTVM,<
	PUSH	P,J		;SAVE J
	PUSHJ	P,SWPINT##	;CALL SWPINT
	POP	P,J		;RESET J
>	;END IFE FTVM
IFN FTVM,<
SETID0:	HRRZ	T1,CHNNUM##(P1)
	PUSHJ	P,SWPP1		;POINT PI AT SWPLST ENTRY
	PUSH	P,U
	PUSHJ	P,DONE##
	MOVEI	F,SWPDDB##
	POP	P,U
	MOVE	J,UNIKON##(U)	;DONE ZAPS EVERYBODY
	HRRZ	P1,KONCHN##(J)
>	;END FTVM
>	;END FTSWAP


SETID1:
IFN FTKI10!FTKL10,<
	JUMPE	P1,CHNIDX	;DONT START IO (CHANGE UBR) AT UUO LEVEL
>
IFN FTVM,<
	MOVEI	F,SWPDDB##	;MAKE SURE F POINTS TO THE SWAPPER
	SKIPE	SQREQ##		;SWAPPER GOING?
	PUSHJ	P,SWPSCN##	;YES, START SWAP SEEKS FIRST
>
	SKIPG	KONPOS##(J)	;DOES KONTROL POSITION?
	JRST	PIKTRX		;NO, LOOK FOR BEST TRANSFER
				;YES. START ANY WAITING POSITIONS

;HERE TO PICK THE BEST FILE ON EACH UNIT TO START POSITIONING
PIKPOS:
IFN FTDHIA,<
	SKIPLE	DIADSK##	;IF WAITING FOR DIAG
	CAMN	P1,DIACHN##	; FOR THIS CHANNEL
	CAIA
	JRST	PIKTRX		;DON'T START ANOTHER SEEK
>
	PUSH	P,U		;SAVE U (LAST UNIT TO LOOK AT)
KONLUP:	HLR	U,UNIKON##(U)	;STEP TO NEXT UNIT IN RING
	SKIPE	T1,UNISTS##(U)	;GET STATE OF UNIT
	CAIE	T1,PWCOD##	;PW?
	CAIN	T1,SWCOD##	;OR SW?
	PUSHJ	P,UNIPOS	;YES, START UNIT POSITIONING
PIKPND:	CAME	U,(P)		;WAS THIS LAST UNIT ON KONTROL?
	JRST	KONLUP		;NO, STEP TO NEXT UNIT
	POP	P,T1		;YES, REMOVE U FROM PD LIST
	PUSHJ	P,UNIRHB	;SEE IF ANY UNIT NEEDS REREADING HOME BLOCKS
	  JRST	PIKTRX		;NO, GO LOOK FOR FILE TO START DATA ON
	PUSHJ	P,FAKDDX	;YES, GET A DDB
	  JRST	PIKTRX		;NO SPACE NOW, PUSH ON AND TRY LATER
	PJRST	TSTRHX		;GOT 1, GO START TO READ HOME BLOCK
IFN FTDHIA,<
;ROUTINE TO START POSITIONING DURING CRANK-UP
CRNPOS:	MOVE	J,UNIKON##(U)	;MAKE SURE J IS RIGHT
	SETZM	UNISTS##(U)	;SO RIGHT UNISTS WILL BE STORED (UUOTWQ)
>

;SUBROUTINE TO PICK A FILE ON A UNIT AND START POSITIONING FOR THAT FILE
;ENTER WITH U=LOC OF UNIT DATA BLOCK
;EXIT CPOPJ, A FILE IS NOW POSITIONING ON THE UNIT
UNIPOS:	PUSHJ	P,SAVE4##	
IFE FTVM,<
	SKIPN	UNIQUE##(U)	;GET UNIQUE = PWQ FOR UNIT
	STOPCD	CPOPJ##,DEBUG,PQE,	;++POSITIONING QUEUE EMPTY
>
IFN FTVM,<
	SKIPE	UNIQUE##(U)
	JRST	UNIPS0
	SKIPL	SCNCNT##	;IF NO DDB IN PWQ,
	POPJ	P,		; ITS OK IF SWPSCN PUT UNIT IN PW
	STOPCD	CPOPJ##,DEBUG,PQE,
UNIPS0:>
IFE FTDOPT,<			;NO DISK OPTIMIZATION
UNIPS1:	HLRZ	F,UNIQUE##(U)	;F=FIRST FILE IN UNIT POSITION QUEUE
	MOVEI	P2,DIFUDQ##(U)	;P2=PREDECESSOR
	SKIPE	T1,DEVUNI##(F)	;SKIP IF F/S HAS BEEN JERKED OUT
	PUSHJ	P,CYLCOM	;COMPUTE DISTANCE TO TARGET CYLINDER
	JUMPE	T1,PWQOK	;JUMP IF ON-CYLINDER, SET UNIT TO TW
>	;END CONDITIONAL ON FTDOPT
IFN FTDOPT,<
	PUSH	P,S		;SAVE S
UNIPS1:	HRLOI	P3,377777	;SET P3 (BEST DISTANCE) TO PLUS INFINITY
	HLRZ	F,UNIQUE##(U)	;F WILL GO THROUGH FILES ON U
	MOVEI	S,DIFUDQ##(U)	;INITIALIZE S (PREDECESSOR FILE)
	SKIPN	T1,DEVUNI##(F)	;JUST IN CASE F/S HAS BEEN JERKED OUT
	JRST	PWQLP1		;JERKED OUT - SET DISTANCE=0
				; (SO WILL IMMEDIATELY GO TO TWQ)
IFN FTDPRI,<
	PUSHJ	P,DFPRI		;PRIORITY OF FIRST FILE IN QUEUE
	MOVE	R,T2		;SAVE IN R
>
PWQLUP:	PUSHJ	P,CYLCOM	;COMPUTE DISTANCE TO TARGET CYLINDER
	MOVMS	T1		;ABSOLUTE VALUE
	SKIPL	DEVSWP##(F)	;IS THIS SWAPPER REQUEST?
	CAMGE	T1,P3		;NO, IS THIS BEST SO FAR?
PWQLP1:	PUSHJ	P,SVBST		;YES, SAVE POINTERS TO IT
				;P4=BEST F,P3=DIST TO BEST P2=PRED. F
	JUMPE	T1,PWQOK	;PERFECT IF 0 (SET UNIT TO TW)
	SKIPGE	DEVSWP##(F)	;SWAPPER REQUEST?
	JRST	SETPOS		;YES. USE THIS FILE
	MOVEM	F,S		;SAVE F AS PREDECESSOR POINTER
	HLRZ	F,DEVQUE##(F)	;AND STEP TO NEXT FILE ON UNIT
IFN FTDPRI,<
	JUMPE	F,SETPOS	;START POSITION IF LOOKED AT ALL IN QUEUE
	PUSHJ	P,DFPRI		;PRIORITY OF THIS FILE
	CAME	T2,R		;SAME AS FIRST IN QUEUE?
	JRST	SETPOS		;NO, START POSITION OF BEST IN PRIORITY GROUP
	JUMPG	R,PWQLUP	;YES, CHECK IT IF PRIORITY IS POSITIVE
				; (NEVER BY FAIR IF HI-PRI FILES IN QUEUE)
>
	SKIPLE	CHNCFP##(P1)	;IF TIME TO BE FAIR, FIRST IS BEST
	JUMPN	F,PWQLUP	;LOOP IF NOT END OF FILES, NOT FAIR TIME
SETPOS:	POP	P,S		;RESTORE S
;STILL IN FTDOPT CONDITIONAL
;HERE P4 HAS POINTER TO FILE, P2=PREDECESSOR
;REMOVE THIS FILE FROM PWQ, START IT POSITIONING
	MOVE	F,P4		;SET F TO FILE
>	;END CONDITIONAL ON FTDOPT
	PUSHJ	P,UNQUE0	;REMOVE FILE FROM Q
	MOVE	T1,UNISTS##(U)	;STATUS OF UNIT
	CAIN	T1,SWCOD##	;SEEK WAIT?
	AOJA	T1,STRPS0	;YES, SET STATE=SEEK AND START POSITION GOING
	PJRST	STRPOS		;NO, SET STATE=POSITION AND START POSITION GOING

;HERE IF A FILE IS ALREADY ON CYLINDER
PWQOK:	PUSHJ	P,UNQUE0	;REMOVE FILE FROM PWQ
	DSKOFF			;#TURN ALL DISK PI'S OFF
	MOVE	T1,UNISTS##(U)	;#STATUS OF UNIT
	CAIN	T1,SWCOD##	;#UNIT IN SEEK WAIT?
	JRST	PWQOK2		;#YES. DO SOMETHING ELSE
	HRRM	F,UNICDA##(U)	;SO SWAPPER WILL KNOW
IFN FTDUAL,<
	PUSH	P,U
>
	PUSHJ	P,UUOTWQ	;#PW STATE - ADD FILE TO TWQ,SET STATE TO TW
				;(UNLESS THERE WAS A SEEK WHICH WE FORGOT
				;BECAUSE OF A POSITION REQUEST, AND THE POSITION
				;IS ALREADY ON-CYLINDER. IN THAT CASE, I/O
				;WILL BE STARTED)
IFN FTDUAL,<
	POP	P,U		;IF WE STARTED IO ON ALTERNATE UNIT
	HRRZ	J,UNIKON##(U)	;THEN U, J AND P1 WERE CHANGED
	HRRZ	P1,KONCHN##(J)	;SO RESET THEM
>
PWQOK1:
IFN FTDOPT,<
	POP	P,S		;RESTORE S
>	;END CONDITIONAL ON FTDOPT
	POPJ	P,		;AND RETURN

;HERE IF POSITION REQUEST IS FOR A SEEK WHICH IS ON-CYLINDER
PWQOK2:	SKIPE	UNIQUE##(U)	;ANY POSITIONS WAITING?
	JRST	UNIPS1		;YES, START POSITION (FORGET SEEK)
	SETZM	UNISTS##(U)	;NO, SET UNIT IDLE
	JRST	PWQOK1		;RESTORE S AND RETURN
;SUBROUTINE TO UPDATE DDB, ADVANCE BUFFERS AFTER A DATA TRANSFER
;ENTER WITH P4=CHNNUM= NUMBER OF BUFFERS TO ADVANCE
;RETURNS WITH P3=ADVBFE OR ADVBFF DEPENDING ON INPUT OR OUTPUT
;CHANGES P3,P4
BUFAD:	MOVNM	P4,T1		;DECREASE NUMBER OF BLOCKS LEFT
	ADDM	T1,DEVLFT##(F)	;BY NUMBER OF BLOCKS XFERRED
	ADDM	P4,DEVBLK##(F)	;UPDATE FILE CURRENT BLOCK NUMBER
IFN FTDSUP,<	;SUPER USETI/USETO
	TLNE	S,IOSUPR	;IO FROM SUPER USETI/USETO?
	JRST	BUFAD0		;YES. DONT TOUCH A.T.
>
	ADDB	P4,DEVREL##(F)	;UPDATE CURRENT RELATIVE BLOCK NUMBER
	SOJN	P4,BUFAD4	;-1=HIGHEST BLOCK WRITTEN
	TLO	S,IOSFIR	;NEXT BLOCK = 1 - SET FOR CHKSUM
	MOVEM	S,DEVIOS(F)	;SAVE S IN DDB
BUFAD4:	HRRZ	T1,DEVACC##(F)	;ACCESS TABLE LOC
	MOVE	T3,ACCWRT##(T1)	;SET T3 NEGATIVE IF NEW
	SUB	T3,P4		; LAST BLOCK, 0 IF OLD LAST
	CAMLE	P4,ACCWRT##(T1)	;THIS BLOCK HIGHER THAN FORMER HIGHEST?
	MOVEM	P4,ACCWRT##(T1)	;YES, SAVE NEW HIGHEST WRITTEN
	SKIPE	ACCWRT##(T1)	;IF RIB, NOT LAST BLOCK
	CAME	P4,ACCWRT##(T1)	;LAST BLOCK?
	TLZA	P3,-1		;NO, LH(P3)=0
	HRL	P3,T1		;YES, LH(P3)=LOC OF A.T.
BUFAD0:	HRRZ	P4,CHNNUM##(P1)	;NUMBER OF BLOCKS TRANSFERRED AGAIN
	LDB	T2,PIOMOD##	;GET MODE
	MOVEI	T1,UNIDRC##(U)	;SET FOR DUMP-MODE STATS
	CAIL	T2,SD		;DUMP?
	PJRST	UPSTA		;YES. UPDATE UNIDRC(DWC) AND RETURN
	MOVEI	T1,UNIBRC##(U)	;NO. SET TO UPDATE BUFFERRED-MODE STATS
	PUSHJ	P,UPSTAT	;UPDATE UNIBRC(BWC)
	HRRI	P3,ADVBFE##	;SET TO ADVANCE BUFFERS
	TLNN	S,IO
	HRRI	P3,ADVBFF##
	JUMPE	P4,CPOPJ1##	;RETURN IF NO BUFFERS TO ADVANCE
BUFAD1:	SOJN	P4,BUFAD2	;GO IF NOT LAST BUFFER
	HLRZ	T2,P3		;LAST - LOC OF ACC IF READING LAST BLOCK OF FILE
	JUMPE	T2,BUFAD2	;NOT LAST BLOCK IF 0
;HERE WHEN DOING I/O TO LAST BLOCK OF THE FILE
IFN FTKI10!FTKL10,<
	PUSHJ	P,SVEUF##	;SETUP USER BASE REGISTER SO CAN ADDRESS BUFFERS
>
	TLNE	S,IO		;WRITING?
	JRST	BUFAD3		;YES, COMPUTE LBS
	LDB	T1,ACYLBS##	;READING LAST BLOCK - GET ITS SIZE
	MOVE	T2,DEVIAD(F)
IFN FTKA10,<
	MOVEI	T2,@T2
>
	EXCTXU	<MOVEM T1,1(T2)>
BUFAD2:	PUSHJ	P,(P3)		;ADVANCE BUFFERS
	  JUMPE	P4,CPOPJ##	;RAN OUT - RETURN IF LAST BUFFER
	JUMPG	P4,BUFAD1	;ADVANCE MORE IF NOT LAST BUFFER
	JRST	CPOPJ1##	;ANOTHER BUFFER AVAILABLE - SKIP RETURN

;HERE WHEN WRITING LAST BLOCK OF A FILE - COMPUTE LAST BLOCK SIZE
BUFAD3:	MOVE	T1,DEVOAD(F)	;ADDRESS OF LAST BUFFER
IFN FTKA10,<
	MOVEI	T1,@T1		;RELOCATE IF A KA
>
	EXCTUX	<MOVE T1,1(T1)>;GET WRDCNT OF LAST BUFFER
	CAILE	T1,BLKSIZ##	;TOO MANY WORDS?
	MOVEI	T1,BLKSIZ##	;YES, REDUCE COUNT
	JUMPL	T3,BUFAD5	;NEW LAST BLOCK IF NEGATIVE
	MOVE	T3,DEVACC##(F)	;LOC OF A.T.
	MOVE	T3,ACCSTS##(T3)	;STATUS WORD
	TRNN	T3,ACPUPD	;UPDATE MODE?
	TDZA	T3,T3		;NO
	LDB	T3,ACYLBS##	;YES, GET PREVIOUS LAST-BLOCK LENGTH
	CAILE	T3,BLKSIZ##	;TOO MANY WORDS?
	MOVEI	T3,BLKSIZ##	;REDUCE COUNT
	CAMLE	T3,T1		;CURRENT LENGTH LESS THAN PREVIOUS LENGTH?
	MOVE	T1,T3		;YES, SET CURRENT=PREVIOUS LENGTH
BUFAD5:	DPB	T1,ACYLBS##	;SAVE IN ACC
	JRST	BUFAD2		;AND GO ADVANCE BUFFERS
;SUBROUTINE TO COMPUTE A FOLDED CHECKSUM FROM THE FIRST DATA WORD
;CALL WHEN THE IO LIST HAS BEEN SET UP IN THE KONTROLLER DATA BLOCK
CHKSUM:
IFN FTKI10!FTKL10,<
	PUSHJ	P,SVEUF##	;MAKE ADDRESSABLE
	PUSH	P,J		;SAVE J
	PUSH	P,M		; AND M
	LDB	J,PJOBN##	;GET NEW JOB #
	HLRZ	M,DEVUVA##(F)	;GET L(1ST WORD)-1
	MOVEI	M,1(M)		;=ACTUAL I/O ADDRESS
	PUSHJ	P,GETWRD##	;GET WORD FROM USER AREA
	 STOPCD	.,STOP,CSE,	;++CHECKSUM ERROR
	MOVE	T2,T1		;MOVE IT
	POP	P,M		;RESTORE STUFF
	POP	P,J		;...
>
IFN FTKA10,<
	HLRZ	T2,DEVUVA##(F)	;ADDRESS OF THE CHECKSUM WORD
	TLO	T2,R		;RELOCATE
	HRRI	T2,1(T2)
	MOVE	T2,@T2		;GET CHECKSUM WORD
>
;SUBROUTINE TO COMPUTE A CHECKSUM FROM T2
;ENTER WITH T2=WORD TO BE CHECKSUMMED
;EXIT WITH T1 = CHECKSUM
CHKST1::HRRZ	T4,UNISTR##(U)	;LOC OF STR DB
	MOVE	T4,STYCKP##(T4)	;CHECKSUM POINTER
	LDB	T3,[POINT 6,T4,11]	;SIZE FIELD OF CHKSUM PNTR
	MOVNS	T3		;SET FOR LSH
	TLZA	T4,770000	;SET TO BIT 35
CHKSM1:	ADD	T2,T1		;NOT DONE. ADD BYTE TO REST OF WORD (FOLD CHKSUM)
	LDB	T1,T4		;GET A BYTE OF CHKSUM SIZE
	LSH	T2,(T3)		;THROW AWAY THE BYTE
	JUMPN	T2,CHKSM1	;FINISHED WHEN NO MORE OF ORIGINAL WORD
	POPJ	P,		;DONE - RETURN

;SUBROUTINE TO UPDATE UNIT STATISTICS AFTER IO
;ENTER WITH P4=NUMBER OF BLOCKS,  T1=UNIXRC(U)   (X=M,B OR D)
;UPSTA = UPSTAT,PRESERVES T3
UPSTA:
UPSTAT:	TLNE	S,IO		;WRITING?
	ADDI	T1,1		;YES. UNIXWC=UNIXRC+1
	ADDM	P4,(T1)		;UPDATE WORD IN UNIT BLOCK
IFN FTDMRB,<			;IF MULTIPLE RIBS
	SKIPL	DEVRIB##(F)	;IO TO FILE CURRENTLY USING EXTENDED RIB?
>	;END CONDITIONAL ON FTDMRB
	POPJ	P,		;NO, RETURN
IFN FTDMRB,<			;IF MULTIPLE RIBS
	HRRZ	T1,P4		;NUMBER OF BLOCKS TRANSFERRED
	TLNE	S,IO		;WRITING?
	HRLZ	T1,T1		;YES, MOVE NUMBER OF BLOCKS TO LEFT HALF
	ADDM	T1,UNIXRA##(U)	;AND STORE IN UNIT DATA BLOCK
	POPJ	P,		;AND RETURN
>	;END CONDITIONAL ON FTDMRB
;SUBROUTINE TO COMPUTE DISTANCE TO TARGET CYLINDER
;ENTER WITH TARGET BLOCK IN DEVBLK(F)
;ENTER AT CYLCM WITH T1=BLOCK NUMBER,  T4 PRESERVED
;EXIT WITH T1 =DISTANCE FROM CURRENT CYLINDER TO TARGET CYLINDER
CYLCOM:	MOVE	T1,DEVBLK##(F)	;#TARGET BLOCK
CYLCM::	LDB	T3,UNYBPY##	;#NUMBER OF BLOCKS PER CYLINDER
	IDIV	T1,T3		;#COMPUTE CYLINDER
	SUB	T1,UNICYL##(U)	;#-PRESENT CYLINDER
	POPJ	P,		;#EXIT T1=DISTANCE


;SUBROUTINE TO REMOVE A FILE FROM A QUEUE
;  UNQUEX FOR CHANNEL (XFER WAIT) QUEUES
;	P1=ADDR. OF CHAN. DATA BLOCK
;  UNQUE0 FOR UNIT (POSITION WAIT) QUEUES
;	U=ADDR. OF UNIT DATA BLOCK
;F HAS FILE    P2 HAS PREDECESSOR
UNQUEX:
IFN FTDSTT,<			;IF KEEPING DISK STATISTICS
	SOSA	CHNQUL##(P1)	;  DECREMENT XFER QUEUE LENGTH
>
UNQUE0:
IFN FTDSTT,<
IFE FTVM,<
	SOS	UNIQUL##(U)	;  OR POSITION WAIT QUEUE LENGTH
>
IFN FTVM,<
	SOSA	UNIQUL##(U)
>
>
IFN FTVM,<
	SOS	CHNWAT##(P1)
>
	HLLZ	T1,DEVQUE##(F)	;Q WORD OF FILE
	HLLM	T1,DEVQUE##(P2)	;SAVE IN Q WORD OF PREDECESSOR
	POPJ	P,		;AND RETURN
;SUBROUTINE  TO START UNIT POSITIONING
STRPOS::MOVEI	T1,PCOD##	;#PUT FILE AND UNIT INTO P STATE
STRPS0:	PUSHJ	P,FILCOD	;#
IFN FTDUAL,<
	PUSHJ	P,SECCOD	;SET MAIN UNIT TO SAME STATE
	HRRM	U,DEVCUR##(F)
>
STRPS1:				;SETPAR EXPECTS T1 TO STILL
				;CONTAIN PCOD FOR METER POINT
	PUSHJ	P,SETPRS	;#SET KONCUA, UNICDA, UNIBLK
	PUSHJ	P,@KONPOS##(J)	;#GO TO DEPENDENT ROUTINE
	  JRST	STRPS2		;UNIT NOT OK - PUT IT INTO T OR TW
				; (UNLESS CALLED FROM HNGDSK)
				;SO THAT STARTIO WILL CALL BADUNI
	DSKON			;# TURN ALL DISK PI'S BACK ON
	SCHEDULE
	POPJ	P,		;AND RETURN

;HERE IF UNIT NOT READY WHEN TRYING TO START POSITIONING
STRPS2:	MOVE	T1,UNISTS##(U)
	SETZM	UNISTS##(U)	;SO WE'LL STORE NEW UNISTS
	CAIN	T1,SCOD		;IF TRYING TO START A SEEK,
	POPJ	P,		; FORGET IT
IFE FTDUAL,<
	PJRST	SETTTW		;TRY TO START I/O
>
IFN FTDUAL,<
	PUSH	P,U
	PUSHJ	P,SETTTW
	POP	P,U		;IF WE STARTED IO ON ALTERNATE UNIT
	HRRZ	J,UNIKON##(U)	;THEN U, J AND P1 WERE CHANGED
	HRRZ	P1,KONCHN##(J)	;SO RESET THEM
	POPJ	P,
>

IFN FTDOPT,<
;SUBROUTINE TO SAVE POINTERS TO BEST FILE SO FAR
;P1-P3 CHANGED
SVBST:	MOVEM	F,P4		;P4 = BEST FILE SO FAR
	HRRZM	T1,P3		;P3 = DISTANCE TO BEST
	MOVEM	S,P2		;P2 = PREDECESSOR IN QUEUE
	POPJ	P,
>	;END CONDITIONAL ON FTDOPT
;SUBROUTINE TO SET UP PARAMETERS FOR DEPENDENT ROUTINE
SETPRS:
IFN FTRP04,<
	SKIPL	KONTAB##(J)	;#DONT STORE NEW KONCUA IF THIS IS A POSITION
				; STARTED WHILE XFER IS ACTIVE
>
SETPAR:	HRRM	U,KONCUA##(J)	;#SAVE CURRENT UNIT ADDR
	HRRM	F,UNICDA##(U)	;#SAVE FILE ADDR
IFN FTMETR,
<				;SET UP T1 FOR METER POINT 3
				;SHOULD ALREADY CONTAIN
				; OPCODE 4 OR 6

	ROT	T1,-2		;#GET THE DISTINGUISHING BIT INTO BIT 0
>	;END CONDITIONAL ON FTMETR

	MOVE	T1,DEVBLK##(F)	;# SAVE LOGICAL BLOCK NR WITHIN UNIT
	MOVEM	T1,UNIBLK##(U)	;#IN UNIT DATA BLOCK
	MOVE	S,DEVIOS(F)	;#GET S
IFN FTMETR,
<	SKIPL	T2,MP3##	;# POINT INITIALIZED
	PJRST	STOIOS##	;# NO, RESET HUNG TIME AND RETURN
	DPB	F,[POINT 11,T1,11] ;# STORE DDB ADR
	DPB	U,[POINT 8,T1,17] ;# AND UDB ADR
	PUSHJ	P,@MPDPRA##(T2) ;# CALL METER POINT ROUTINE
>	;END CONDITIONAL ON FTMETR

	PJRST	STOIOS		;# RESET HUNG TIME AND EXIT

;SUBROUTINE TO DETERMINE IF A POINTER TO THE NEXT BLOCK OF A FILE IS IN CORE
;ENTER WITH J,U,F SET UP
;RETURN CPOPJ IF NEXT BLOCK NOT AVAILABLE
;RETURN CPOPJ1 IF THE NEXT BLOCK HAS A POINTER ALREADY IN CORE
CHKNXT:	HRRZ	T1,DEVLFT##(F)	;NUMBER OF BLOCKS LEFT IN CURRENT GROUP
	SOJGE	T1,CHKNX2	;CPOPJ1 IF ANY LEFT AND WRITING
	MOVE	T1,DEVRET##(F)	;LOOK AT NEXT POINTER
CHKNX1:	SKIPE	T2,1(T1)	;IF ZERO (EOF)
	CAIL	T1,DEVRBN##(F)	;OR END OF POINTER BLOCK
	POPJ	P,		;NONE LEFT IN CORE
	HLRE	T1,DEVRSU##(F)	;DEVRSU
	CAMGE	T1,[-2]		;NO MORE IF MIGHT GET REDUNDANT RIB
	TLNN	T2,-1		;CHANGE OF LOGICAL UNITS?
	POPJ	P,		;NOT AVAILABLE SINCE IT IS ON ANOTHER UNIT
				;(CANT SWITCH UNITS ON INTERRUPT LEVEL SINCE STATE
				; OF OTHER UNITIS INDEPENDENT OF THIS ONE)
	PUSHJ	P,NXTBLK	;STORE NEW DEVBLK IN CASE THIS UNIT PUT BACK
				; IN PW AND NEW PNTR IS FOR A NEW CYLINDER
	  POPJ	P,		;NEW BLOCK PAST WRITTEN DATA - RETURN
CHKNX2:	HRRZ	T2,DEVACC##(F)	;SAME UNIT. LOC OF A.T.
	JUMPE	T2,CPOPJ##	;UNAVAILABLE IF F/S WAS JERKED
	MOVE	T2,ACCWRT##(T2)	;NUMBER OF BLOCKS WRITTEN
	TLNN	S,IO		;IF READING,
 	CAML	T2,DEVREL##(F)	;IS NEXT READ PAST THE EOF?
	AOS	(P)		;NO. OK
	POPJ	P,		;RETURN CPOPJ OR CPOPJ1
;HERE WHEN THE UNIT IS NOT READY
BADUNI:	HRRZS	UNISTS##(U)	;#CLEAR SIGN BIT (PHUNG)
IFN FTDAEM,<
	MOVEM	T2,UNIERR##(U)	;#YES, SAVE CONI, DATAI
	MOVEM	T3,UNIHDI##(U)	;#
>
IFN <FTKI10!FTKL10>,<
IFN FTVM,<
	SKIPGE	DEVSWP##(F)	;#DON'T RETURN IOWD'S IF THE SWAPPER
>
	JRST	BADUNA
	MOVE	T3,UNISTS##(U)	;IF THE UNIT IS IN T STATE
	SKIPG	UNIECT##(U)	; AND NOT IN ERROR-RECOVERY
	CAIE	T3,TCOD##
	JRST	BADUNA
	PUSH	P,T1		;SAVE T1
	SKIPE	T1,@KONIOC##(J)	;GET LOC OF FIRST CORE BLOCK
	PUSHJ	P,RTNIOW##	;RETURN THE FREE-CORE BLOCKS
	POP	P,T1		;RESTORE T1 AND CONTINUE
BADUNA:>	;END FTKI10!FTKL10
	MOVSI	T4,UNPOFL##
	TRNE	T1,KOPFUS##	;#UNIT GO FILE-UNSAFE?
	TLOA	T4,UNPFUS##	;#YES, LIGHT ANOTHER BIT TOO
	TRNE	T1,KOPOFL##	;#UNIT OFF-LINE?
	IORM	T4,UNIDES##(U)	;#YES - LIGHT UNIDES BIT
IFN FTDBAD,<
	SKIPE	DEVRHB##(F)	;#IF REREADING HOME BLOCKS,
	SKIPE	DINITF##	;#OR IF IN ONCE-ONLY CODE,
	JRST	BADUN6		;#DONT DO THIS OPR-WAIT STUFF
IFN FTDAEM,<
	MOVE	T2,UNIBLK##(U)	;#
	MOVEM	T2,UNIHBN##(U)	;#SAVE BLOCK NUMBER
	AOS	UNIHCT##(U)	;#BUMP ERROR COUNT
	PUSH	P,T1		;SAVE STATUS
	PUSHJ	P,LSTER		;COPY REGISTERS FROM KDB TO UDB
	MOVEI	T1,.ERDPE	;SAY DISK ERROR TO DAEMON
	HRL	T1,F		;PUT DDB ADDR IN LH FOR DAEMON
	PUSHJ	P,DAEERR##	;#AND CALL DAEMAN
	POP	P,T1		;#RESTORE STATUS
>	;END FTDAEM
	TRNN	T1,KOPOFL##	;#DID UNIT GO OFF-LINE?
	JRST	BADUN3		;#NO

	;STILL IN FTBAD CONDITIONAL
;HERE IF JOB NOT INTERCEPTING UNIT OFF-LINE

	TLO	P1,-1		;NO INTERCEPTS, INDICATE OFF-LINE
	MOVE	T1,[XWD TELOPC,1]	;#SET FOR CLOCK REQUEST
	CONO	PI,PIOFF##	;#SET TO STORE IN THE CLOCK QUEUE
	CONSO	PI,PIPROG##	;#ON PI LEVEL?
	JRST	BADLP2		;#NO
	IDPB	T1,CLOCK##	;#YES, TELL OPR ON NEXT TICK
	IDPB	U,CLOCK##	;SAVE ADR OF UDB
BADLP2:	CONO	PI,PION##	;#IN ORDER TO TYPE MESSAGE TO OPR
	CONSO	PI,PIPROG##	;#DONT TELL OPR NOW IF ON PI LEVEL
	PUSHJ	P,TELOPR	;#NOT ON PI LEVEL - TYPE MESSAGE NOW
IFN FTVM,<
	SKIPGE	DEVSWP##(F)	;#IF THE SWAPPER,
	JRST	BADU4A		; LET SWPHNG RECOVER
>
	MOVEI	T1,OWCOD##	;#SET UNIT IN OPR WAIT STATE
	MOVEM	T1,UNISTS##(U)	;#(ONLY GETS OUT OF OW ON "FREE" INTERRRUPT)
BADUN3:	JUMPL	S,BADUN4	;#IF NOT A MONITOR I/O OPERATION,
	MOVE	T1,KONDMP##(J)	;#GET IOWD BACK
	LDB	T2,PIOMOD##	;#MODE
	CAIL	T2,SD		;#DUMP?
	MOVEM	T1,DEVDMP##(F)	;#YES, RESET DEVDMP IN CASE "CONT" IS TYPED
	MOVEI	T4,.EROFL	;DISK OFF-LINE ERROR
	PUSHJ	P,SETINJ	;IS HE INTERCEPTING?
	  JRST	BADUN4		;NO
	MOVEI	T1,OW2COD##	;YES, SET UNIT O2 (OPR WAIT, NO MESSAGE EACH MINUTE)
	MOVEM	T1,UNISTS##(U)	; (ONLY GETS OUT OF O2 ON "FREE" INTERRUPT)
				;JOB IN IO WAIT?
	PUSHJ	P,STDIOD##	;YES, UNWAIT HIM
BADUN4:
IFN FTDUAL,<
	MOVEI	T1,O2COD##
	SKIPE	T2,UNI2ND##(U)	;DUAL-PORTED UNIT?
	MOVEM	T1,UNISTS##(T2)	;YES, PUT OTHER PORT IN OPR WAIT TOO
>
	JUMPGE	P1,BADUN5	;#IF UNIT WENT OFF-LINE,
	PUSH	P,F		;#SAVE F
IFN FTKI10!FTKL10,<
	CONSO	PI,PIPROG##	;IF ON UUO LEVEL AND A SEEK FINISHED
	SETZ	P1,		; CAN'T START IT - CANT CALL SVEUB
>
	PUSHJ	P,SETID1	;#GO FIND SOMETHING ELSE TO DO
				;#THIS (UNIT WONT BE USED TILL COMES OUT OF OW)
	POP	P,F		;#RESTORE F
BADU4A:	DSKON
	CONO	P1,DSKPIN
	POPJ	P,		;AND RETURN
;STILL IN FTDBAD CONDITIONAL
;HERE WHEN THE UNIT DID NOT GO OFF-LINE (PROBABLY WRITE-LOCK)
BADUN5:	DSKON			;#TURN ON DSK PI
IFE FTVM,<
	SKIPGE	DEVSWP##(F)	;CAN'T CALL HNGSTP IF THE SWAPPER
	JRST	BADUN6		;(P) = NULPDL
>
IFN FTVM,<
	SKIPGE	DEVSWP##(F)	;IF THE SWAPPER,
	JRST	BADU4A		; LET SWPHNG RECOVER
>
	CONSO	PI,PIPROG##	;IS A PI IN PROGRESS (P-10 ONLY)
	PUSHJ	P,SAVSTS	;MAKE A RECORD OF RESOURCES, RETURN THEM
	  JRST	BADUN6		;HAS MON-BUF OR PI IN PROGRESS, HE LOSES
	HRRZ	J,UNIKON##(U)	;SAVSTS CLOBBERS J
	PUSH	P,F		;NO, SAVE F
IFN FTKI10!FTKL10,<
	CONSO	PI,PIPROG	;IF OP UUO LEVEL AND A SEEKING DRIVE
	SETZ	P1,		; INTERRUPTED DONT START THE IO
				; (CANT CHANGE UBR AT UUO LEVEL)
>
	PUSHJ	P,SETIDA	;SET UNIT IDLE (DON'T CLEAR IOSMON), START NEXT OPERATION
	MOVE	F,(P)		;RESET DDB ADDR FOR HNGSTP
	PUSHJ	P,HNGSTP##	;"DEVICE DEV OK?"
	POP	P,F		;RESTORE F,
	POP	P,T3
	PUSHJ	P,RESSTS	; U, AND ANY RESOURCES JOB OWNED
	HRRZ	J,UNIKON##(U)	; AND J
	PJRST	UUOPW0		;HE SAID CONTINUE - TRY AGAIN

>	;END CONDITIONAL ON FTDBAD
;HERE ON INTERRUPT LEVEL OR DURING ONCE-ONLY
;LIGHT AN ERROR BIT AND RETURN TO CALLER
BADUN6:	DSKON			;#TURN ON DSK PI'S
	MOVE	S,DEVIOS(F)	;GET CURRENT DEVIOS
	TRO	S,IOIMPM	;LIGHT IOIMPM
				;IN IO WAIT?
	PUSHJ	P,STDIOD##	;YES. TAKE OUT
	JUMPE	U,CLRACT##	;RETURN IF F/S WAS JERKED
	PUSH	P,F		;SAVE F
IFN FTKI10!FTKL10,<
	CONSO	PI,PIPROG##	;CANT CHANGE UBR IF
	SETZ	P1,		; AT UUO LEVEL
>
	PUSHJ	P,SETIDL	;SET UNIT IDLE,START NEXT OPERATION
	POP	P,F
	POPJ	P,		;RETURN
	IFN FTDBAD,<
;ROUTINE TO TYPE A MESSAGE TO THE OPR WHEN A DRIVE FOES OFF-LINE
;ENTER AT TELOPC FROM THE CLOCK, T1=UDB
;ENTER AT TELOPR WITH U SET CORRECTLY
TELOPC:	SETZ	J,		;SET J=0 AS A SWITCH
	MOVE	U,T1
IFN FTVM,<
	HRRZ	T1,UNICDA##(U)	;IF THE SWAPPER
	SKIPL	DEVSWP##(T1)	; UNIT IS STILL IN TW
>
	MOVE	T1,UNISTS##(U)	;GET STATUS OF UNIT
	CAIGE	T1,OWCOD##	;HAS UNIT ALREADY BEEN POWERED DOWN AND UP?
	POPJ	P,		;YES, DONT TYPE ANYTHING
				;NO, TELL OPR ABOUT BAD UNIT

	JRST	TELOP3		;SAVE ONLY U, AND TYPE
TELOPR:	PUSH	P,F
TELOP3:	PUSH	P,U
	HRRZ	U,OPRLDB##	;TYPE MESSAGE ON OPR'S TTY
	PUSHJ	P,INLMES##
	BYTE	(7) 7,7,7,7,7	;SOME BELLS
	ASCIZ	/
UNIT /
	MOVE	T2,(P)		;UNIT
	MOVE	T2,UNINAM##(T2)	;PHYSICAL UNIT NAME
	PUSHJ	P,PRNAME##	;TYPE IT
IFN FTDUAL,<
	MOVE	T2,(P)		;UDB ADDR
	SKIPL	T2,UNI2ND##(T2);IS THIS AN ALTERNATE PATH?
	JRST	TELO3A		;NO
	PUSH	P,T2		;YES, SAVE ITS ADDR
	PUSHJ	P,INLMES##	;TELL OPR THE NAME HE KNOWS
	ASCIZ	/ = /
	POP	P,T2
	MOVE	T2,UNINAM##(T2)
	PUSHJ	P,PRNAME##
TELO3A:>
	PUSHJ	P,INLMES##	;AND THE MESSAGE:
	ASCIZ	/ WENT OFF-LINE/
	MOVE	T2,(P)		;UNIT
	MOVE	T2,UNIDES##(T2)	;UNIDES WORD
	TLNN	T2,UNPFUS##	;FILE UNSAFE?
	JRST	TELOP4
	PUSHJ	P,INLMES##	;YES
	ASCIZ	/ (FILE UNSAFE)/
;STILL IN FTDBAD
TELOP4:	MOVE	T2,(P)		;UDB AGAIN
	HRRZ	T2,UNIKON##(T2);KDB
	SKIPG	KONPOS##(T2)	;DOES THIS UNIT POSITION?
	JRST	TELOP5		;NO, HE CANT TURN IT OFF
	PUSHJ	P,INLMES##	;YES, ASK HIM TO
	ASCIZ	/
PLEASE POWER IT DOWN, THEN TURN IT ON AGAIN./
TELOP5:	PUSHJ	P,INLMES##
	ASCIZ	/
/
	POP	P,U		;RESTORE ACS
	JUMPE	J,CPOPJ##	;DIDN'T SAVE ACS IF J=0
	POP	P,F
	MOVE	S,DEVIOS(F)	;RESTORE S
	POPJ	P,		;AND RETURN


;ROUTINE CALLED ONCE A MINUTE
CHKUNI::SETZM	F
	SETOM	J
	HLRZ	U,SYSUNI##	;FIRST UNIT IN SYSTEM
CHKUN1:	MOVE	T1,UNISTS##(U)	;STATUS OF UNIT
	CAIE	T1,OCOD##
	CAIN	T1,OWCOD##	;WAITING FOR OPR?
	PUSHJ	P,TELOPR	;YES, REMIND HIM AGAIN
	HLRZ	U,UNISYS##(U)	;STEP TO NEXT UNIT
	JUMPN	U,CHKUN1	;AND TEST IT
	POPJ	P,		;DONE - RETURN
>	;END CONDITIONAL ON FTDBAD

;HERE TO START TRANSFER OF BEST (LATENCY DETERMINED) FILE IN TW
PIKTRN:
IFE FTVM,<
PIKTRX:
>
IFN FTVM,<
	MOVEI	F,SWPDDB	;MAKE SURE WE'RE POINTING AT SWAPPER
	SKIPE	SQREQ		;SWAPPER WANT SERVICE?
	PUSHJ	P,SWPSCN##	;YES, LET IT DO PART 1 (SET ASL UNITS IN TW STATE)
PIKTRX:	SKIPN	SQREQ##		;SWAPPER WAITING?
	JRST	PIKTR0		;NO
	MOVEI	F,SWPDDB	;YES, POINT F AT SWAPPER DDB
	PUSHJ	P,SWPPIK##	;GO FIND SOMETHING TO DO
	  CAIA			;COULDN'T, DO A FILE IO
	POPJ	P,		;SWAPPER IS GOING, EXIT
PIKTR0:>	;END FTVM
	PUSHJ	P,SAVE4##	;#
	DSKOFF
	MOVSI	T1,400000	;#SET OLD KONTROL IDLE
	ANDCAM	T1,KONTAB##(J)	;#
PIKTR1:	HLRZ	F,CHNQUE##(P1)	;#FIRST FILE DDB IN TW QUEUE FOR THIS CHAN
	JUMPE	F,CHNIDL	;#IF QUEUE EMPT, SET CHAN IDLE AND EXIT
	DSKON			;#


IFE FTDOPT,<
;HERE IF NO LATENCY OPTIMIZATION - PICK FIRST IN QUEUE
	MOVEI	P2,DIFCDQ##(P1)	;SET P2=PREDECESSOR
TWQLUP:	HRRZ	U,DEVUNI##(F)	;U=UNIT FILE IS ACCESSING
	JUMPE	U,SETBSY	;GO IMMEDIATELY IF F/S HAS BEEN JERKED OUT
	SKIPE	T2,UNISTS##(U)	;STATUS OF UNIT, SKIP IF IDLE
	CAIN	T2,TWCOD##	;SKIP IF NOT TRANSFER WAIT
	JRST	SETBSY		;IDLE OR TW, PICK THIS TRANSFER
	MOVEM	F,P2		;UNIT IS BUSY, LOOK FOR NEXT
	HLRZ	F,DEVQUE##(F)	;F=NEXT FILE IN QUEUE, P2=PREDECESSOR
	JUMPN	F,TWQLUP	;TEST NEXT FILE IF ANY
	PJRST	CHNIDL		;SET CHANNEL IDLE, NO WORK TO DO

;HERE WHEN A FILE IS FOUND, START IO
SETBSY:	MOVE	J,UNIKON##(U)	;J=CONTROLLER FILE IS ACCESSING
>	;END CONDITIONAL ON FTDOPT

IFN FTDOPT,<
;HERE TO FIND THE BEST FILE TO START TRANSFERRING
	HRLOI	P3,377777	;PRESET BEST LATENCY TIME
	PUSH	P,S		;SAVE S
	MOVEI	S,DIFCDQ##(P1)	;PRESET PREDECESSOR
IFN FTDPRI,<
	PUSHJ	P,DFPRI		;PRIORITY OF FIRST ITEM IN QUEUE
	MOVE	R,T2		;SAVE IN R
>
;STILL IN FTDOPT CONDITIONAL
TWQLUP:	MOVE	T1,DEVBLK##(F)	;BLOCK FILE NEEDS
IFE FTDUAL,<
	HRRZ	U,DEVUNI##(F)	;SET UP U
>
IFN FTDUAL,<
	SKIPE	U,DEVUNI##(F)
	HRRZ	U,DEVCUR##(F)
>
	JUMPE	U,TWQLP0	;JUST IN CASE F/S HAS BEEN JERKED OUT
	SKIPE	T2,UNISTS##(U)	;STATUS OF UNIT
	CAIN	T2,TWCOD##	;TW?
	SKIPA	J,UNIKON##(U)	;IDLE OR TW - SET J=KONTROLLER FOR UNIT
	JRST	TWQLP1		;UNIT IN TW - DONT GET ANOTHER FILE FOR TW
IFN FTDUAL,<
	SKIPGE	T2,UNI2ND##(U)	;IF THIS IS AN ALTERNATE PATH
	MOVE	T2,UNISTS##(T2)	; AND THE MAIN UNIT IS BUSY
	CAIN	T2,TCOD##
	JRST	TWQLP1		; THEN LEAVE ALTERNATE ALONE
>
	PUSHJ	P,@KONLTM##(J)	;COMPUTE LATENCY
TWQLP0:	  MOVEI	T1,0		;UNIT NOT OK- SET LATENCY=0
				; SO UNIT WILL BE GOTTEN RID OF IMMEDIATELY
	SKIPL	DEVSWP##(F)	;SWAPPER REQUEST?
	CAMG	T1,P3		;NO. BEST SO FAR?
	PUSHJ	P,SVBST		;YES, SAVE POINTERS TO FILE
				; P4=BEST F, P3=DIST TO BEST, P2=PRED.F
	JUMPE	T1,SETBSY
	SKIPGE	DEVSWP##(F)	;SWAPPER REQUEST?
	JRST	SETBSY		;YES. USE THIS FILE
TWQLP1:	MOVEM	F,S		;SAVE F AS PREDECESSOR
	HLRZ	F,DEVQUE##(F)	;STEP TO NEXT FILE
IFN FTDPRI,<
	JUMPE	F,TWQLP2	;START IO OR SET CHAN IDLE
	PUSHJ	P,DFPRI		;HAVE A QUEUE ENTRY - GET PRIORITY
	CAME	T2,R		;SAME AS FIRST IN QUEUE?
	JRST	TWQLP2		;NO, START IO
	JUMPG	R,TWQLUP	;YES, DON'T BE FAIR IF HI PRIORITY
>
	SKIPLE	CHNCFT##(P1)	;TIME TO BE FAIR?
	JUMPN	F,TWQLUP	;NO, TEST NEXT FILE
TWQLP2:	TLNN	P3,-1		;WAS ANY FILE FOUND TO START DATA?
	PJRST	SETBSY		;YES. GO
	JUMPN	F,TWQLUP	;NO. LOOK AGAIN IF THERE ARE MORE FILES
	POP	P,S		;NOTHING TO DO. RETORE S
	PJRST	CHNIDL		;SET CHAN IDLE
;STILL IN FTDOPT CONDITIONAL
;HERE WHEN BEST FILE IS FOUND START IO
SETBSY:	POP	P,S		;RESTORE S
	MOVE	F,P4		;SET F TO FILE
>	;END CONDITIONAL ON FTDOPT
	SKIPE	U,DEVUNI##(F)	;SET U TO UNIT DB ADR. IT IS ACCESSING
IFN FTDUAL,<
	HRRZ	U,DEVCUR##(F)
	SKIPE	U
>
	HRRZ	J,UNIKON##(U)	;SET J TO KONTROLLER DB UNIT IS ON
	DSKOFF			;#TURN ALL DISK PI'S OFF
	PUSHJ	P,UNQUEX	;#REMOVE FILE FROM TWQ
	JUMPE	U,UNIDWN	;JUST IN CASE F/S HAS BEEN JERKED OUT
IFN FTDSIM,<
SETBS1:	MOVE	T1,DEVUWZ##(F)	;ZEROING BLOCKS IN USETO CODE?
	TLNN	T1,DEPUWZ##
	JRST	SETBS2
	MOVE	T1,DEVACC##(F)	;YES, IS CURRENT BLOCK WRITTEN?
	MOVE	T1,ACCWRT##(T1)	; (IF USETO DECIDED TO ZERO BLOCK N WHILE
	CAML	T1,DEVREL##(F)	; ANOTHER JOB WAS IN DIOW FOR BLOCK N)
	JRST	NXTIO		;BLOCK NOW HAS GOOD DATA IN IT - GET OUT
SETBS2:>
	PUSHJ	P,STRTIO	;#SET FILE+UNIT TO T1, KONTROL TO B(CHAN ALREADY B)
				;COMPUTE CHAN COMMAND LIST AND START TRANSFER
	JRST	INTXIT		;AND DISMISS THE INTERRUPT
;HERE FROM BADUNI ON UUO LEVEL
CHNIDX:	MOVSI	T1,400000
	ANDCAM	T1,KONTAB##(J)
;HERE WHEN ALL PROCESSING FOR DATA INTERRUPT IS DONE
;RESET FAIRNESS COUNTS IF THEY ARE NEGATIVE AND DISMISS
;P1 IS STILL CHAN. DB ADR. WHICH CAUSED THIS DATA INTERRUPT
CHNIDL:	SETOB	T2,@KONCHN##(J)	;#SET CHAN IDLE
	DSKON			;#
IFN FTKI10!FTKL10,<
	JUMPE	P1,CPOPJ##	;DONE IF SETIDL CALLED BY
				; BADUNI AT UUO LEVEL
>
IFN FTKL10,<
	MOVSI	T1,CP.SWF##	;GET SWEEP FLAG
	TDNE	T1,CHB22B##(P1)	;DO WE HAVE TO DO A SWEEP BEFORE DISMISSING?
	PUSHJ	P,CFDMP		;YES, SO DO IT NOW SINCE NO I/O WILL
				; BE STARTED, AS WE ARE AT CHNIDL
>;END IFN FTKL10
	PUSH	P,U		;SAVE U FOR END TEST
CHNID1:	MOVE	T1,UNISTS##(U)	;STATUS OF UNIT
IFN FTDHIA,<
	CAIE	T1,TCOD##	;(PI'S ARE ON NOW)
	CAIN	T1,PCOD##	;IF ANY UNIT IS STILL DOING SOMETHING,
	AOJA	T2,CHNID2	; BUMP T2
	CAIN	T1,SCOD##
	AOJA	T2,CHNID2
>
IFN FTVM,<
	SKIPGE	SCNCNT		;UNITS ARE IN FUNNY STATE IF
				; IN SWPSCN ON UUO LEVEL
>
	CAIE	T1,TWCOD##	;IS UNIT IN TW?
	JRST	CHNID2		;NO
IFN FTDUAL,<
	SKIPE	T1,UNI2ND##(U)	;IF AN ALTERNATE UNIT,
	SKIPN	UNISTS##(T1)	; WHICH ISNT IDLE
	CAIA
	JRST	CHNID2		;IT'S OK
>
	SKIPE	T1,UNIQUE##(U)	;YES (UNKNOWN BUG)
	MOVEI	T1,PWCOD##	;PUT UNIT INTO PW OR IDLE
	MOVEM	T1,UNISTS##(U)	; SO SYSTEM WONT HANG
	AOS	UNIHNG##(U)	;INCREMENT SOFTWARE-HUNG COUNT
CHNID2:	HLR	U,UNICHN##(U)	;STEP TO NEXT UNIT ON CHAN
	CAME	U,(P)		;BACK WHERE WE STARTED?
	JRST	CHNID1		;NO, TEST THIS UNIT
	POP	P,U		;YES, REMOVE JUNK FROM PD LIST
IFN FTDHIA,<
	SKIPLE	F,DIADSK##	;TRYING TO SHUT DOWN IO?
	CAME	P1,DIACHN##	;YES, FOR THIS CHAN?
	JRST	INTXIT		;NO
	JUMPGE	T2,INTXIT	;YES, DISMISS IF ANY UNIT BUSY
	MOVE	S,DEVIOS(F)	;NO UNITS BUSY, SET UP S
	PUSHJ	P,STDIOD##	;AND WAKE UP THE JOB (TO START DIAGNOSTIC)
	PUSHJ	P,CLRACT##
>
INTXIT:
IFN FTKL10,<
	MOVSI	T1,CP.SWF##	;CLEAR SWEEP FLAG
	ANDCAM	T1,CHB22B##(P1)	;FOR NEXT INTERRUPT
>;END IFN FTKL10
	HRRZ	T1,CHNIFP##(P1)	;RESET FAIRNESS COUNTS IF THEY HAVE GONE NEGATIVE
	SKIPG	CHNCFP##(P1)	;CURRENT FAIRNESS COUNT FOR POSITIONING OPTIMIZATION
	MOVEM	T1,CHNCFP##(P1)
	HRRZ	T1,CHNIFT##(P1)
	SKIPG	CHNCFT##(P1)	;CURRENT FAIRNESS COUNT FOR TRANSFER OPTIMIZATION
	MOVEM	T1,CHNCFT##(P1)
	POPJ	P,		;AND DISMISS THE INTERRUPT


IFN FTKL10,<
;SUBROUTINE TO SWEEP CACHE
;CALL WITH P1=LOC OF CHANNEL DATA BLOCK
;PRESERVES ALL ACS  EXCEPT T1
CFDMP:
IFN FTKL10,<
	MOVE	T1,CHB22B##(P1)
	TLNN	T1,CP.RH2##	;IS IT AN RH20?
>
	SKIPE	DINITF##	; OR ARE WE IN ONCE-ONLY
	POPJ	P,		;YES, NO NEED TO SWEEP
	JRST	CSDMP##		;NO, SWEEP CACHE
>
UNIDWN:	PUSHJ	P,UNIYNK
	PJRST	PIKTR1		;START NEXT I/O IF CHAN NOT IDLE
				; IF IDLE, EXIT THE INTERRUPT
UNIYNK:
IFN FTDBAD,<
	PUSHJ	P,BADUN6	;FINISH THIS OPERATION, START NEXT
>
	MOVE	U,DEVFUN##(F)	;UNIT ADDR IS IN DEVFUN IF DEVUNI=0
	SKIPE	T1,UNIQUE##(U)	;MORE POSITIONS WAITING?
	MOVEI	T1,PWCOD##	;YES. RETURN UNIT TO PW STATE
	MOVEM	T1,UNISTS##(U)	;SET UNIT IDLE OR PW
	POPJ	P,




IFN FTDSIM,<
;HERE TO EXIT WITHOUT WRITING THE DISK
NXTIO:	MOVE	S,DEVIOS(F)	;SET UP S FOR STDIOD
	PUSHJ	P,STDIOD##	;WAKE UP JOB
	PUSHJ	P,CLRACT##	;NO LONGER IO ACTIVE
	DSKOFF
	CONSO	PI,PIPROG##	;#IF ON UUO LEVEL,
	JRST	[SETOM	@KONCHN##(J)  ;#INDICATE CHAN IS IDLE
		DSKON		;#TURN ON DSK PI
		POPJ	P,]	;#AND RETURN WITHOUT WIPING IT
	SKIPE	T1,UNIQUE##(U)	;UNIT IS IDLE OR PW
	MOVEI	T1,PWCOD##
	MOVEM	T1,UNISTS##(U)
	JUMPE	T1,PIKTR1	;LOOK FOR A TRANSFER TO START IF NOT PW
	SETOM	UNICYL##(U)	;ENSURE A SEEK HAPPENS (ELSE COULD PDL OV)
	JRST	PIKPOS		; AND START A SEEK GOING
>
FILEND:	END