PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/mon/filio.mac

TITLE	FILIO LEVEL-D DISK SERVICE ROUTINE  V1343
SUBTTL	DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW  13-SEP-88

	SEARCH	F,S,DEVPRM
	$RELOC
	$HIGH

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;  OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988.
;ALL RIGHTS RESERVED.

.CPYRT<1973,1988>


XP VFILIO,1343

;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
IOSPBF==2000	;PARTIAL BUFFER DONE
IOSFIR==1000	;COMPUTE AND STORE OR CHECK THE CHECKSUM
;XXX==IOBEG	;(UNUSED)
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 <>
DEFINE	CBDBUG<>


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 .CPJOB## 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
RELABP==40000	;AOBJN POINTER MUST BE RELOCATED BY (R)
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
	SE1ENT			;ENTER SECTION 1
	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
	HRRZ	P4,T2		;SAVE DESIRED NUMBER OF BLOCKS A MOMENT
	HRRZ	T3,UNISTR(U)
	SETO	T2,		;COMPUTE LARGEST ALLOWED GROUP SIZE
	LDB	T2,STYCNP##(T3)	;LARGEST FIELD
	CAIL	T2,(P3)		;ASKING FOR TOO MUCH?
	JRST	TAKBL0		;NO
	SKIPE	DINITF##	;IN ONCE-ONLY (REFRESHER)?
	CAIE	P4,-1		;YES, DON'T REDUCE ALLOCATION IF -1 - REFSTR
				; WANTS THIS CALL TO TAKBLK TO FAIL (HIALCU)
	HRR	P3,T2		;YES, REDUCE REQUEST
TAKBL0:	PUSHJ	P,SUPDA		;QUEUE FOR DISK ALLOCATION IF DONT ALREADY HAVE (ENTER)
	SKIPN	DEVUNI##(F)
	JRST	TAKBLU
	MOVE	R,UNISAB(U)	;LOC OF FIRST SAT BUFFER
	JUMPE	T1,TAKBLA	;GO IF NO START ADDRESS SPECIFIED
;HERE WHEN A START ADDRESS SPECIFIED
	SETZ	T2,
	JUMPL	T1,TAKBLM	;NEGATIVE BLOCK NOS ARE ILL GOAL
	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
	  JRST	[POP P,T1	;SAT DOESN'T EXIST
		 JRST TAKBLM]	;GIVE ERROR RETURN
	SKIPN	DEVUNI##(F)	;IF UNIT WAS REMOVED,
	PJRST	TAKBL3		; TAKE ERROR RETERN
	MOVEM	R,UNISAB(U)	;SAVE BUFFER LOC IN UNISAT
	HLRE	T1,SABSCN##(R)	;-LENGTH OF WHOLE SAT DATA AREA
	MOVEI	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:	MOVSI	P2,400000+R	;INSTRUCTION FORMAT INDIRECT WORD
	HRRM	P1,P2		;SET FOR INDIRECT
	MOVE	T1,@P2		;FIRST WORD TO LOOK AT
	MOVEI	P2,0		;P2 WILL CONTAIN LARGEST HOLE FOUND
	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+RELABP ;INDICATE START ADDR. SPECIFIED
	PUSH	P,P1		;SAVE LOC OF 1ST DATA WORD
	TLO	P3,RELABP	;AOBJN POINTER IS RELATIVE TO THE TABLE
	PUSHJ	P,GETZR##	;TRY TO GET N 0'S
	  JRST	TAKBL2		;CANT GET ENOUGH
	POP	P,(P)		;FOUND THEM REMOVE GARBAGE FROM PD LIST
	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##(R)	;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##(R)	;BIGGEST HOLE IN SAT
	CAIG	T1,(P3)		;TRYING FOR MORE THAN BIGGEST?
	JUMPGE	T1,[HRR P2,T1
           	    JRST TAKBLF] ;YES, SKIP SCAN IF WE KNOW SIZE OF HOLE
				; (SABHOL=-1 IF WE DONT KNOW THE SIZE)
	MOVSI	T1,SABBIT##	;SET UP AN AOBJN WORD  FOR SCAN
	HRLZ	T2,SABSCN##(R)	;COMPUTE DISTANCE FROM START TO C(SABSCN)
	SUB	T2,T1		;=+N
	ADD	T2,SABSCN##(R)	;LH=DISTANCE FROM C(SABSCN) TO TOP
				;RH=WHERE TO START LOOKING
	MOVE	P1,T2		;AOBJN WORD FOR SCAN
	HRRI	P2,0		;SET BEST SO FAR TO 0
	TLO	P3,RELABP	;AOBJN POINTER IS RELATIVE TO THE TABLE
	PUSHJ	P,GETZ##	;AND TRY TO GET N 0'S
TAKBLD:	  SKIPA			;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##	;FIRST DATA LOC IN BUFFER
	HLL	P1,SABSCN##(R)	;-LENGTH OF ENTIRE DATA AREA
	TLO	P3,RELABP	;AOBJN POINTER IS RELATIVE TO THE TABLE
	PUSHJ	P,GETZ##	;SCAN WHOLE SAT TABLE
	  SKIPA			;STILL CANT FIND ENOUGH
	JRST	TAKBLP		;FOUND THEM - WRAP UP

;HERE WHEN THE CURRENT SAT BUFFER DOESN'T HAVE ENOUGH

TAKBLF:	HRRZM	P2,SABHOL##(R)	;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)
	LDB	T1,SAYNDX##	;GET INDEX OF SAT
	DPB	T1,[POINT 11,P3,17] ;SAVE INDEX IN LH(P3)
TAKBLG:	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
	MOVE	R,SABRNG##(R)	;NO. STEP TO NEXT IN-CORE SAT TABLE
	MOVE	T1,UNISAB(U)	;BACK WHERE WE STARTED?
	CAME	R,T1
	JRST	TAKBLB		;NO. TRY THIS 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
	MOVE	R,UNISAB(U)	;POINT R TO CURRENT SAT
	SKIPA	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
	ADDI	P4,1
	PUSHJ	P,DWNDA		;UNQUEUE, REQUEUE FOR DISK ALLOCATION
	PUSHJ	P,UPDA		;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##(R)	;SIZE OF BIGGEST HOLE IN SAT
	HLRZ	T2,P2		;BIGGEST HOLE FOUND SO FAR
	CAMG	T1,T2		;WORTH WHILE TO SCAN THE SAT?
	JUMPGE	T1,TAKBLI	;NOT IF WE REALLY KNOW (SABHOL POSITIVE)
	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	DWNDA		;GIVE UP DA QUEUE AND RETURN ERROR

;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
	HLRZ	P3,P2		;SIZE OF LARGEST HOLE
TAKBLO:	HLL	P1,SABSCN##(R)	;SETUP AN AOBJN POINTER FOR THE BUFFER
	HRRI	P1,SABBIT##
	MOVEI	P2,0		;SET LARGEST HOLE TO 0
	TLO	P3,RELABP	;AOBJN POINTER IS RELATIVE TO THE TABLE
	PUSHJ	P,GETZ##	;GET THE BLOCKS
	  JRST	TAKBLR		;SOMEBODY SNUCK IN!

;HERE WHEN A BUNCH OF BLOCKS HAVE BEEN OBTAINED
;THE BUFFER LOC IS IN R
TAKBLP:	HRRZ	T1,P4		;POSITION OF HOLE
	HRRM	T1,SABSCN##(R)	;SET WHERE TO START NEXT TIME
	SUBI	T1,SABBIT##	;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##(R),CLAPOS]	;FIRST ADDRESS IN SAT
	ADD	T1,T2		;COMPUTE ACTUAL CLUSTER NUMBER (RELATIVE TO UNIT)
	PUSH	P,T1		;SAVE IT ON THE LIST
;HERE WITH CLUSTER ADDRESS ON PD LIST
TAKBLQ:	TLO	P3,RELABP	;AOBJN POINTER IS RELATIVE TO THE SAT
	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
	HRRZ	T3,UNISTR(U)	;LOC OF STRUCTURE DB
	DPB	P3,STYCNP##(T3)	;SAVE CLUSTER COUNT IN T2
	PUSHJ	P,DWNDA		;GIVE UP DA
	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:	MOVE	R,UNISAB(U)
	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:	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,DWNDA		;GIVE UP THE DA RESOURCE
	MOVEI	T4,.ERFUL	;STR - FULL ERROR
	HRRZ	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
;ROUTINE TO CALL SETINT
SETINJ::PUSHJ	P,PSIJBI##	;PSI INSTEAD
	  JRST	CPOPJ1##	;YES, WANTS TRAP
	PUSH	P,J		;SAVE J
	PUSH	P,M		;SETINT CLOBBERS M
	LDB	J,PJOBN##	;JOB NUMBER
	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
;SUBROUTINE TO RETURN BLOCKS (DEALLOCATE)
;ENTER WITH T1= DISK ADDRESS  T2= HOW MANY TO DEALLOCATE
GIVBLK::CAMLE	T1,UNIBPU(U)	;LEGAL?
	POPJ	P,		;NO. SOME ONE IS COMFUSED
	PUSHJ	P,SAVE4##	;SAVE P1-P4
	PUSHJ	P,UPDA		;GET DA RESOURCE
	SE1ENT
	MOVE	R,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,P1		;P3=-N FOR UPDATING COUNTS
	IDIV	T1,T4		;CONVERT TO CLUSTER ADDRESS
	PUSHJ	P,FNSAT		;FIND THE SAT  FOR THIS ADDRESS
	  STOPCD GIVBLR,DEBUG,SDE, ;SAT DOESN'T EXIST
	MOVEI	T4,SABBIT##(T2)	;POSITION IN TABLE
	MOVEI	T1,^D36
	SUBI	T1,(T3)		;POSITION
	MOVN	T3,P1		;COUNT
	MOVSI	P3,RELABP	;INDICATE AOBJN POINTER IS RELATIVE TO THE SAT
	PUSHJ	P,CLRBTS##	;CLEAR THE BITS
	  STOPCD GIVBLR,DEBUG,BAZ, ;++BIT ALREADY ZERO
	MOVE	P3,P1		;SET P3 FOR UPDATING COUNTS
	SETOM	SABHOL##(R)	;INDICATE SIZE OF LARGEST HOLE IN SAT UNKNOWN
	PUSHJ	P,FIXCNT	;UPDATE SOME COUNTS
GIVBLR:	XJRST	[0,,DWNDA]	;GIVE UP THE DA RESOURCE AND RETURN
;SUBROUTINE TO UPDATE SOME COUNTS
;ENTER WITH P3 = HOW MANY CLUSTERS  (PLUS-ALLOCATION, NEG - DEALLOCATION)
; R=LOC OF SAT BUF.
;RETURNS WITH T1=NUMBER OF BLOCKS
FIXCNT:
IFN FTXMON,<
	PUSH	P,F		;SAVE F
	HRRZS	F		;SHOULD HAVE THE SIGN BIT ON BUT DOESN'T ALWAYS
>
	MOVN	T1,P3		;-NUMBER OF CLUSTERS
	LDB	T4,UNYBPC##
	IMUL	T1,T4		;-NUMBER OF BLOCKS
	SKIPE	DINITF##	;IF IN ONCE-ONLY
	JRST	FIXCN2		;JUST SET SATCHG BIT
	MOVN	T2,P3		;-NUMBER OF CLUSTERS
	ADDM	T1,UNITAL(U)	;UPDATE UNIT FREE-TALLY
	HRRZ	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
	HRLOI	T4,377777
	SKIPGE	UFBTAL##(T3)	; AND UFBTAL HAS OVERFLOWED
	MOVEM	T4,UFBTAL##(T3)	; MAKE IT INFINITY AGAIN
FIXCN1:	HRRZ	T3,DEVACC##(F)	;UPDATE HIGHEST BLOCK ALLOCATED
	JUMPE	T3,FIXCN3
	MOVNS	T1
	MOVEI	T4,DEPALC##
	TDNN	T4,DEVALC##(F)	;LEAVE ACCALC ALONE IF BIT IS ON
	ADDM	T1,ACCALC##(T3)
FIXCN3:	ADD	T2,SABTAL##(R)
	TRNE	T2,400000	;COUNT GO NEGATIVE?
	MOVEI	T2,0		;YES, SET TO 0
	HRRM	T2,SABTAL##(R)
	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
	IORM	T4,SABFIR##(R)	; BLOCK HAS CHANGED
	MOVMS	T1
IFE FTXMON,<
	POPJ	P,		;AND RETURN
>
IFN FTXMON,<
	JRST	FPOPJ##		;RESTORE F 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 R=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  R=BUFFER LOC
;P3,T1 UNCHANGED, R,P2, P4 CHANGED
FNSAT:	HRRZ	T2,UNICPS(U)	;NUMBER OF CLUSTERS/SAT TABLE
	MOVE	P2,R		;USE P2 FOR END TEST

;TRY TO FIND A SAT IN CORE FOR THIS CLUSTER ADDRESS
FNSA1:	LDB	T3,[POINT CLASIZ,SABFIR##(R),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:	MOVE	R,SABRNG##(R)	;STEP TO NEXT SAT BUFFER
	CAME	R,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
	LDB	T2,UNYSPU##	;SATS PER UNIT
	CAMLE	T1,T2		;TOO HIGH?
	POPJ	P,		;YES, (LAST PARTIAL CLUSTER) NOT FOUND
	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,  R = LOC OF BUFFER
FNSA4:	LDB	T2,[POINT CLASIZ,SABFIR##(R),CLAPOS]	;1ST ADDRESS OF SAT
	SUBM	T1,T2		;-DESIRED ADDRESS
	IDIVI	T2,^D36		;COMPUTE WORD COUNT, SHIFT NUMBER
	JRST	CPOPJ1##
;SUBROUTINE TO ENTER REQUEST IN DISK-ALLOCATION QUEUE
;ALL ACS RESPECTED
;CALL SUPDA IF MIGHT ALREADY HAVE DA

SUPDA::	TLNN	S,IOSDA		;IF HAVE DA JUST RETURN
UPDA::	SKIPE	DINITF##	;IF IN ONCE, RETURN
	POPJ	P,
	PUSH	P,T1		;SAVE SOME REGISTERS
	PUSH	P,J		;
IFN <FTDUAL!FTCIDSK>,<
	PUSH	P,U		;SAVE U (IN CASE THIS IS 2ND PORT)
>
	LDB	J,PJOBN##	;GET JOB NUMBER
	UUOLOK			;CANT INTERRUPT HERE
IFN FTDUAL,<
	SKIPGE	UNI2ND(U)	;IS THIS THE PRIME PORT?
	HRRZ	U,UNIALT(U)	;NO, POINT TO PRIME PORT
>
IFN FTCIDSK,<
	MOVEI	T1,CPUMSK	;SEE IF PORT IS ACTIVE
	TDNE	T1,UDBCAM(U)	;BY SEEING IF ACCESSIBLE BY ANYONE
	JRST	UDCIOK		;IT IS, USE THIS PORT
	HRRZ	T1,UNIALT(U)	;GET SECOND PORT
	JUMPE	T1,UDCIOK	;NO SECOND PORT, JUST OFF-LINE
	HRL	T1,UDBCAM(T1)	;SEE IF THIS PORT ACCESSIBLE
	TLNE	T1,CPUMSK	;IS IT?
	JRST	[HRRZ	U,T1	;POINT TO ACTIVE PORT
		 JRST	UDCIOK]	;CONTINUE
	PUSH	P,T2		;NEED ONE MORE AC
	HRRZS	T1		;CLEAR JUNK
	PUSH	P,T1		;SAVE ALTERNATE PORT
	LDB	T1,UNYKNM##	;GET CI NODE NUMBER FOR UDB POINTED TO BY U
	EXCH	U,(P)		;ALSO FOR ALTERNATE PORT
	LDB	T2,UNYKNM##	;FOR ALTERNATE PORT
	CAIL	T2,(T1)		;DOESN'T MATTER WHICH PORT, BUT
	HRRZ	U,(P)		;ALWAYS BE THE SAME ONE
	POP	P,(P)		;FIX STACK
	POP	P,T2		;RESTORE T2
UDCIOK:>
	MOVSI	T1,1		;JUST INCREMENT LEFT HALF OF UNIAJB
	HRLM	U,JBTDAU##(J)	;SET DA USER WANTS
	ADDB	T1,UNIAJB(U)	;COUNT WAITERS
	TLNE	T1,-2		;MORE THAN ONE?
	 JRST	WAITDA		;MUST WAIT FOR IT
	MOVE	T1,JBTSTS##(J)	;GET JOB STATUS
	TLNN	T1,JXPN		;IF EXPANDING
	CAMN	J,FORCEF##	;OR BEING FORCED OUT
	 JRST	WATDAF		;MUST DO MORE CHECKING
UPDA2:	HRRM	J,UNIAJB(U)	;WE ARE NOW USING DA
	UUONLK			;UNINTERLOCK
UPDAX1:
IFN <FTDUAL!FTCIDSK>,<
	POP	P,U		;RESTORE U
>
	POP	P,J		;RESTORE REGISTERS
	POP	P,T1		;
	TLO	S,IOSDA		;HAVE DA QUEUE,LIGHT BIT
	PJRST	STRIOS		;SAVE S AND RETURN

WATDAF:	CAMN	J,CBUSER##	;JOB OWN CB?
	 JRST	UPDA2		;YES. GIVE HIM DA
	HRRZ	T1,JBTDAU##(J)	;NO. HOW ABOUT AU?
	JUMPE	T1,WAITDA	;NOT IF ZERO
	HRRZ	T1,UFBAUJ##(T1)	;GET OWNER
	CAIN	T1,(J)		;IS IT US?
	 JRST	UPDA2		;YES. GIVE DA TOO
WAITDA:	UUONLK			;UNINTERLOCK
	MOVEI	T1,DAQ##	;PUT JOB IN DAQ
	DPB	T1,PJBSTS##	;
	PUSH	P,R		;SWAPPER COULD CHANGE R
	PUSHJ	P,WSCHED##	;WAIT FOR SCHED1 TO GIVE IT TO US
	POP	P,R		;RESTORE ADDRESS OF SAT BUFFER
	JRST	UPDAX1		;AND RETURN

;HERE FROM SCHEDULAR TO SEE IF DA IS FREE, RETURN DESIRED OWNING JOB
;IN T3 (OR ZERO IF NONE OR CAN'T FIND)

UNWDA::	HLRZ	T3,JBTDAU##(J)	;DA DESIRED
	JUMPE	T3,CPOPJ##	;SOMEONE IS CONFUSED
IFN FTDUAL,<
	SKIPGE	UNI2ND(T3)	;PRIME PORT?
IFE FTCIDSK,<
	HRRZ	T3,UNIALT(T3)	;NO, POINT TO PRIME PORT
>
IFN FTCIDSK,<
	JRST	[HRRZ T3,UNIALT(T3) ;NO, POINT TO PRIME PORT
		 JRST UNWDA4  ]	;CONTINUE
>
> ;END FTDUAL
IFN FTCIDSK,<
	PUSH	P,T1
	MOVEI	T1,CPUMSK	;SEE IF PORT IS ACTIVE
	TDNE	T1,UDBCAM(T3)	;BY SEEING IF ACCESSIBLE BY ANYONE
	JRST	UNWDA3		;IT IS, USE THIS PORT
	HRRZ	T1,UNIALT(T3)	;GET SECOND PORT
	JUMPE	T1,UNWDA3	;NO SECOND PORT, JUST OFF-LINE
	HRL	T1,UDBCAM(T1)	;SEE IF THIS PORT ACCESSIBLE
	TLNE	T1,CPUMSK	;IS IT?
	JRST	[HRRZ	T3,T1	;POINT TO ACTIVE PORT
		 JRST	UNWDA3]	;CONTINUE
	PUSH	P,T2		;NEED ONE MORE AC
	HRRZS	T1		;CLEAR JUNK
	PUSH	P,T1		;SAVE ALTERNATE PORT
	EXCH	T3,U
	LDB	T1,UNYKNM##	;GET CI NODE NUMBER FOR UDB POINTED TO BY U
	EXCH	U,(P)		;ALSO FOR ALTERNATE PORT
	LDB	T2,UNYKNM##	;FOR ALTERNATE PORT
	CAIL	T2,(T1)		;DOESN'T MATTER WHICH PORT, BUT
	HRRZ	U,(P)		;MUST ALWAYS BE THE SAME ONE
	EXCH	T3,U		;WE NEED IT IN T3
	POP	P,(P)		;FIX STACK
	POP	P,T2
UNWDA3:	POP	P,T1		;RESTORE T1
UNWDA4:>
	HRRZ	T3,UNIAJB(T3)	;OWNER
	POPJ	P,

;HERE FROM SCHEDULAR TO GIVE JOB IN J THE DA RESOURCE (IF POSSIBLE)
;RETURN CPOPJ1 IF WE GOT IT, CPOPJ OTHERWISE.  USES T3

SCDDA::	HLRZ	T3,JBTDAU##(J)	;WHICH DA?
	JUMPE	T3,CPOPJ##	;HUH?
	UUOLOK
IFN FTDUAL,<
	SKIPGE	UNI2ND(T3)	;IS THIS THE PRIME PORT?
IFN FTCIDSK,<
	JRST	[HRRZ T3,UNIALT(T3)
		 JRST SCDDA4 ]
>
IFE FTCIDSK,<
	HRRZ	T3,UNIALT(T3)	;NO, DA IS ONLY ON THE PRIME PORT
>
> ;END FTDUAL
IFN FTCIDSK,<
	PUSH	P,T1
	MOVEI	T1,CPUMSK	;SEE IF PORT IS ACTIVE
	TDNE	T1,UDBCAM(T3)	;BY SEEING IF ACCESSIBLE BY ANYONE
	JRST	SCDDA3		;IT IS, USE THIS PORT
	HRRZ	T1,UNIALT(T3)	;GET SECOND PORT
	JUMPE	T1,SCDDA3	;NO SECOND PORT, JUST OFF-LINE
	HRL	T1,UDBCAM(T1)	;SEE IF THIS PORT ACCESSIBLE
	TLNE	T1,CPUMSK	;IS IT?
	JRST	[HRRZ	T3,T1	;POINT TO ACTIVE PORT
		 JRST	SCDDA3]	;CONTINUE
	PUSH	P,T2		;NEED ONE MORE AC
	HRRZS	T1		;CLEAR JUNK
	PUSH	P,T1		;SAVE ALTERNATE PORT
	EXCH	T3,U		;EASIER TO USE U HERE
	LDB	T1,UNYKNM##	;GET CI NODE NUMBER FOR UDB POINTED TO BY U
	EXCH	U,(P)		;ALSO FOR ALTERNATE PORT
	LDB	T2,UNYKNM##	;FOR ALTERNATE PORT
	CAIL	T2,(T1)		;DOESN'T MATTER WHICH PORT, BUT
	HRRZ	U,(P)		;ALWAYS BE THE SAME ONE
	EXCH	T3,U
	POP	P,(P)		;FIX STACK
	POP	P,T2		;RESTORE T2
SCDDA3:	POP	P,T1		;RESTORE T1
SCDDA4:	HRLM	T3,JBTDAU##(J)	;MAKE IT EASIER NEXT TIME
>
	HRL	T3,UNIAJB(T3)	;GET DA
	TLNE	T3,-1
	JRST	SCDDA1		;OH WELL
	HRRM	J,UNIAJB(T3)
	AOS	(P)		;GOOD RETURN
SCDDA1:	UUONLK
	POPJ	P,
;SUBROUTINE TO UNQUE A DA REQUEST
;ALL ACS RESPECTED
DWNDA::	SKIPE	DINITF##
	POPJ	P,
	TLZN	S,IOSDA		;CLEAR THE BIT
	STOPCD	CPOPJ##,DEBUG,DHD,;++ DON'T HAVE DA
	PUSH	P,T1
	LDB	T1,PJOBN##	;JOB NUMBER RETURNING DA
	SUB	T1,UNIAJB(U)	;IS IT THE RIGHT ONE?
	TRNN	T1,-1
	JRST	DWNDA1		;YES
IFN FTDUAL,<
	PUSH	P,U		;SAVE U
	HRRZ	U,UNIALT(U)	;IF WE ARE ON THE ALTERNATE PATH THIS IS OK
	LDB	T1,PJOBN##	;GO TO THE PRIME PORT
	SUB	T1,UNIAJB(U)	;OWN THE DA ON THE PRIME PORT?
	SKIPE	U		;(NO ALTERNATE PORT)
	TRNE	T1,-1
>
	STOPCD	.+1,DEBUG,RWD,	;++RETURNING WRONG UNIT'S DA
IFN FTDUAL,<
	PUSHJ	P,DWNDAD	;GIVE UP THE DA ON THE PRIME PORT
	POP	P,U
	JRST	TPOPJ##		;AND GO AWAY HAPPY
DWNDAD:	PUSH	P,T1
>
DWNDA1:	PUSH	P,J		;SAVE J
	UUOLOK
	LDB	J,PJOBN##	;
	HRRZS	JBTDAU##(J)	;CLEAR DA WE HAVE/WANT
	HLRZ	T1,UNIAJB(U)	;GET NUMBER OF WAITERS
	SOJL	T1,.+2		;PRECAUTIONARY
	HRLM	T1,UNIAJB(U)	;NOW ONE LESS
	HLLZS	UNIAJB(U)	;NO LONGER OWN IT
	UUONLK			;UNINTERLOCK
	SKIPE	F		;IF FROM ADFREE, NO DDB
	PUSHJ	P,STRIOS	;STORE S IN DDB
	PJRST	SRFRDA##	;SPECIAL CODE IN CLOCK1. EXPECTS T1,J ON LIST
;SUBROUTINE TO GET THE FA RESOURCE
;RESPECTS ALL AC'S
UPFA::	PUSHJ	P,SAVE2##	;SAVE P1, P2
	HRRZ	P1,DEVACC##(F)	;GET ADDRESS OF ACCESS TABLE
	TRNN	P1,DIFNAL##	;NOT ACC?
	SKIPN	P1		;OR NOTHING?
	JRST	UPFAZ		;STOPCODE IF FUNNY
	PUSHJ	P,GETCB		;NEED CB TO LOOK AT ACC. TAB. LINKS
UPFA1:	HLRZ	P1,ACCNMB##(P1)	;%GET NEXT ADDRESS
	TRZN	P1,DIFNAL##	;%NMB?
	JRST	UPFA1		;%NO, KEEP LOOKING
	PUSHJ	P,GVCBJ##	;%YES, GIVE UP CB
UPFA2:	UUOLOK			;LOCK AGAINST UUO LEVEL ONLY NOW
	HRRE	P2,NMBFAJ##(P1)	;GET CURRENT USER - WAIT EXTENDED
	JUMPN	P2,UPFA3	;JUMP IF IN USE
	MOVE	P2,.USJOB	;GET MY JOB NUMBER
	HRRM	P2,NMBFAJ##(P1)	;WE OWN IT NOW
	HRRM	P1,JBTFA##(P2)	;SAVE NMB ADDRESS FA OWNED FOR
	UUONLK			;DONE WITH INTERLOCK
	SETZM	FAUSER##	;SO GIVRES DOESN'T TRY SOMETHING STUPID
	TRO	S,IOSFA		;FLAG WE OWN FA
	PJRST	STRIOS		;SAVE S AND RETURN

;IF FA IS NOT FREE FOR THIS NMB
UPFA3:	JUMPL	P2,UPFA4	;ALREADY WAITERS (NMPFAW)?
	MOVEI	P2,NMPFAW##	;NO, GET THE FLAG
	IORM	P2,NMBFAJ##(P1)	;FLAG WAITERS FOR THIS NMB
UPFA4:	UUONLK			;DONE WITH UUO LOCK
	PUSHJ	P,FAWAIT##	;PUT US IN FAQ
	JRST	UPFA2		;GO SEE IF WE CAN GET FA NOW

UPFAZ:	STOPCD	STRIOS,DEBUG,FNU, ;++FA NOT OWNED BY US

;SUBROUTINE TO RELEASE FA RESOURCE
;RESPECTS ALL AC'S
DWNFA::	TRZN	S,IOSFA		;CLEAR BIT IN S
	STOPCD	CPOPJ##,DEBUG,DHF, ;++DON'T HAVE FA
	PUSHJ	P,SAVE2##	;SAVE P1, P2
	MOVE	P2,.USJOB	;GET US
	HRRZ	P1,JBTFA##(P2)	;GET ADDRESS OF NMB
	JUMPE	P1,UPFAZ	;STOPCODE IF NONE
	HRRZ	P2,NMBFAJ##(P1)	;GET OWNER
	TRZ	P2,NMPFAW##	;CLEAR WAIT BIT
	CAME	P2,.USJOB	;ARE WE THE OWNER?
	JRST	UPFAZ		;NO, STOPCODE
DWNFA1:	UUOLOK			;LOCK US
	HLLZS	JBTFA##(P2)	;CLEAR NMB ADDRESS
	HRL	P2,NMBFAJ##(P1)	;GET OLD IN CASE THERE ARE WAITERS
	HLLZS	NMBFAJ##(P1)	;INDICATE FA FREE FOR NMB
	UUONLK			;DONE WITH LOCK
	TLNE	P2,NMPFAW##	;WAITERS?
	PUSHJ	P,FAFREE##	;YES, WAKE THEM ALL UP
	PJUMPE	F,CPOPJ##	;JUMP IF NO DDB
	PJRST	STRIOS		;SAVE S AND RETURN
;SUBROUTINE TO TEST IF JOB OWNS AU, DA, OR FA
;NON-SKIP IF NO, SKIP IF YES
;RESPECTS ALL AC'S
TSTFAD::PUSHJ	P,SAVE2##
	PUSHJ	P,TSTFA		;JOB OWN AN FA?
	  CAIA			;NO, CHECK OTHERS
	JRST	CPOPJ1##	;YES, SKIP RETURN
	PUSHJ	P,TSTDA		;JOB OWN SOME DA?
	  PJRST	TSTAU		;NO, SEE IF IT OWNS AN AU
	JRST	CPOPJ1##	;YES, SKIP

;SUBROUTINE TO TEST IF JOB OWNS DA RESOURCE
;RETURNS CPOPJ IF NO,  CPOPJ1 IF YES
;CLOBBERS P1,P2 UNLESS CALLED AT OWNDA

OWNDA::	PUSHJ	P,SAVE2##
TSTDA:	HLRZ	P1,JBTDAU##(J)	;DA UNIT
	JUMPE	P1,CPOPJ##	;NO. NONSKIP
	HRRZ	P2,UNIAJB(P1)	;MAYBE. GET OWNER
	CAIN	P2,(J)		;DO WE OWN IT?
IFN <FTDUAL!FTCIDSK>,<
	JRST	CPOPJ1##	;YES.  SKIP RETURN
	HRRZ	P1,UNIALT(P1)	;HOW ABOUT ON ALTERNATE PORT
	JUMPE	P1,CPOPJ##	;NO ALTERNATE PORT
	HRRZ	P2,UNIAJB(P1)
	CAIN	P2,(J)		;OWN ON THIS PORT?
>
	AOS	(P)		;YES
	POPJ	P,		;NO, NON-SKIP

;SUBROUTINE TO TEST IF JOB OWNS AU RESOURCE
;RETURNS CPOPJ IF NO, CPOPJ1 IF YES
;CLOBBERS P1,P2 UNLESS CALLED AT OWNAU

OWNAU::	PUSHJ	P,SAVE2##
TSTAU:	HRRZ	P1,JBTDAU##(J)	;AU UFB
	JUMPE	P1,CPOPJ##	;NO. NON-SKIP
	HRRZ	P2,UFBAUJ##(P1)	;MAYBE. GET OWNER
	CAIN	P2,(J)		;DO WE OWN IT?
	AOS	(P)		;YES. SKIP RETURN
	POPJ	P,		;NO, NON-SKIP

;SUBROUTINE TO TEST IF JOB OWNS AN FA RESOURCE
;RETURNS CPOPJ IF NO, CPOPJ1 IF YES
;CLOBBERS P1

TSTFA:	HRRZ	P1,JBTFA##(J)	;FA NMB
	JUMPN	P1,CPOPJ1##	;SKIP IF WE HAVE ONE
	POPJ	P,		;WE DON'T, NON-SKIP RETURN

;SUBROUTINE TO TEST IF JOB OWNS AU, DA, OR FA. IF SO IT RETURNS THEM
ADFREE::PUSHJ	P,SAVE2##
	SETZ	F,		;NO DDB EXISTS
	MOVE	P2,J
	PUSHJ	P,TSTFA		;OWN FA?
	  CAIA			;NO
	PUSHJ	P,DWNFA1	;YES, RETURN IT
	PUSHJ	P,TSTAU		;OWN AU?
	  CAIA			;NO
	PUSHJ	P,DWNAU1	;YES, RETURN IT
	PUSHJ	P,TSTDA		;JOB OWN DA?
	  POPJ	P,		;NO
	EXCH	P1,U		;GET U RIGHT
	PUSHJ	P,DWNDA1	;RETURN DA
	MOVE	U,P1
	POPJ	P,		; AND RETURN
;SUBROUTINE TO GET THE AU RESOURCE
;ALL ACS RESPECTED
UPAU::	PUSHJ	P,SAVE2##
	HRRZ	P1,DEVUFB##(F)	;GET UFB OF DDB
	JUMPE	P1,UPAUZ	;STOPCD IF NONE
	PUSH	P,J		;SAVE J
UPAU1:	UUOLOK			;INTERLOCK
	MOVE	J,.CPJOB##	;SET TO UFB USER WANTS
	HRRM	P1,JBTDAU##(J)	;SO CAN UNWIND IN SCHED1
	AOSE	UFBWAT##(P1)	;COUNT UP THE WAITERS
	 JRST	WAITAU		;MUST WAIT
	SKIPE	DINITF		;IN ONCE?
	 JRST	UPAU2		;YES
	MOVE	P2,JBTSTS##(J)	;GET JOB STATUS
	TLNN	P2,JXPN		;EXPANDING?
	CAMN	J,FORCEF	;OR BEING FORCED?
	 JRST	WATAUF		;YES. DON'T GIVE IT UNLESS HAS OTHERS
UPAU2:	MOVEM	J,UFBAUJ##(P1)	;MARK WHO OWNS UFB
	UUONLK			;UNLOCK THINGS
UPAUX1:	POP	P,J		;RESTORE J
	TLO	S,IOSAU		;HAVE IT NOW
	PJRST	STRIOS		;RETURN
WATAUF:	CAMN	J,CBUSER##	;USER HAVE CB?
	 JRST	UPAU2		;YES. GIVE HIM AU
	HLRZ	P2,JBTDAU##(J)	;NO. HOW ABOUT DA?
	JUMPE	P2,WAITAU	;NOT IF ZERO
	HRRZ	P2,UNIAJB(P2)	;GET OWNER OF DA
	CAIN	J,(P2)		;IS IT US?
	 JRST	UPAU2		;YES. GIVE HIM AU
WAITAU:	UUONLK			;UNINTERLOCK
	MOVEI	P2,AUQ##	;PUT USER IN AU
	DPB	P2,PJBSTS##	;
	PUSHJ	P,WSCHED##	;AND WAIT FOR SCHED1 TO GIVE IT TO US
	JRST	UPAUX1		;WE HAVE AU NOW
UPAUZ:	STOPCD	CPOPJ##,DEBUG,ANU, ;++AU NOT OWNED BY US,

;HERE FROM SCHEDULAR TO SEE WHO OWNS AU.  RETURN OWNING JOB IN T3 OR
;ZERO IF NONE OR CAN'T FIND.

UNWAU::	HRRZ	T3,JBTDAU##(J)	;UFB
	JUMPE	T3,CPOPJ##
	HRRZ	T3,UFBAUJ##(T3)
	POPJ	P,		;RETURN

;HERE FROM SCHEDULAR TO GIVE JOB THE AU.  USES T3.

SCDAU::	HRRZ	T3,JBTDAU##(J)	;WHICH AU?
	JUMPE	T3,CPOPJ##	;?
	UUOLOK
	HRL	T3,UFBAUJ##(T3)	;CURRENT AU OWNER
	TLNE	T3,-1		;REALLY AVAILABLE NOW?
	JRST	SCDAU1		;NO, SOMEONE SNUCK IN
	HRRZM	J,UFBAUJ##(T3)	;GIVE IT TO HIM
	AOS	(P)
SCDAU1:	UUONLK
	POPJ	P,

;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,SAVE2##
	HRRZ	P1,DEVUFB##(F)	;GET UFB
	JUMPE	P1,UPAUZ	;STOPCD IF NONE
	LDB	P2,PJOBN##	;GET JOB NUMBER
	CAME	P2,UFBAUJ##(P1)	;ARE WE RETURNING WHAT WE OWN?
	JRST	UPAUZ		;NO, STOPCD
DWNAU1:	PUSH	P,T1		;SET ACS FOR SRFRAU
	UUOLOK
	HRLZS	UFBAUJ##(P1)	;SET PREVIOUS USER OF AU
	HLLZS	JBTDAU##(P2)	;MARK JOB DOESN'T HAVE/WANT AU
	SOSGE	T1,UFBWAT##(P1)	;DECREMENT NUMBER OF WAITERS
	AOJN	T1,DWNAUZ	;IF LESS THAN -1, WE HAVE PROBLEMS
	SETZM	UFBWAT##(P1)	;NEVER NEGATIVE
	UUONLK
DWNAU2:	SKIPE	F		;IF FROM ADFREE, NO DDB
	PUSHJ	P,STOIOS##	;SAVE S
	SKIPE	DINITF##	;IN ONCE?
	JRST	TPOPJ##		;YES. RETURN
	PUSH	P,J		;WHICH EXPECTS T1,J ON STACK
	MOVE	J,P2		;AND .CPJOB IN J
	PJRST	SRFRAU##	;
DWNAUZ:	SETOM	UFBWAT##(P1)	;SAY IT'S FREE (T1=WHAT IT WAS+1)
	UUONLK			;FREE INTERLOCK
	STOPCD	DWNAU2,DEBUG,AWN ;++AU WAITERS NEGATIVE
;SUBROUTINE TO FIND A PARTICULAR SAT IN THE
;SAT-BUFFER RING.  IF NOT FOUND, READ IT IN
;ENTER WITH R = LOC OF SAT BUFFER, P4 = INDEX OF SAT ADDRESS TABLE TO READ
;R ON EXIT CONTAINS THE BUFFER LOC. LH(P2) UNCHANGED.
SATST:	MOVE	T2,R		;LOC OF BUFFER (FOR END TEST)
SATS2:	LDB	T3,SAYNDX##	;INDEX OF THIS SAT
	CAIN	T3,(P4)		;RIGHT ONE?
	POPJ	P,		;YES. RETURN
	MOVE	R,SABRNG##(R)	;NO. STEP TO NEXT
	CAME	T2,R		;THROUGH?
	JRST	SATS2		;NO. TEST THIS BUFFER
				;YES. READ THE SAT

;SUBROUTINE TO (POSSIBLY) WRITE THIS SAT, READ IN NEW ONE
;ENTER WITH R = LOC OF SAT BUFFER, P4 = INDEX OF SAT ADDRESS TABLE TO READ
NEWSAT:	SKIPG	SABFIR##(R)	;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)
;R 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
IFN FTXMON,<
	PUSH	P,DEVISN(F)	;SAVE SECTION NUMBER FOR I/O
>
	PUSHJ	P,SATADR	;SET UP PARAMETERS TO READ
	HRRM	T3,SABTAL##(R)	;SAVE FREE SPACE FOR THIS SAT
IFN FTXMON,<
	JRST	@[0,,.+1]	;MUST BE IN SECTION 0
>
	PUSH	P,DEVUNI##(F)	;SAVE DEVUNI
	PUSH	P,R		;SAVE SAT ADDRESS (R IS NOT REALLY PRESERVED)
	PUSHJ	P,STOAU		;UNIT WE'RE TALKING TO
IFN FTMP,<
	SKIPE	DINITF##	;IF IN REFRESHER AND UNIT ON ANOTHER CPU
	PUSHJ	P,REFRED##	; LET ONCMOD DO THE READ
>
	  PUSHJ	P,MONRED	;READ THE SAT
	POP	P,R		;RESTORE SAT ADDRESS
	POP	P,DEVUNI##(F)	;RESTORE DEVUNI
IFN FTXMON,<
	POP	P,DEVISN(F)	;RESTORE SECTION NUMBER FOR NEXT I/O OPERATION
	XJRST   [MCSEC1+.+1]	;MUST BE IN SECTION 1
>
	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##(R),CLAPOS]	;SAVE IN BUFFER
	MOVEI	T1,SABBIT##	;START SCAN AT 1ST LOC OF TABLE
	HRRM	T1,SABSCN##(R)	;SAVE IN SCAN LOC
	SETOM	SABHOL##(R)	;DONT KNOW SIZE OF LARGEST HOLE
	SKIPE	DINITF##	;IF IN ONCE-ONLY
	PJRST	SATW2		;DONT CHECK FOR CONSISTENCY
	MOVE	T1,SABRNG##(R)	;STEP TO NEXT SAB IN RING
	MOVEM	T1,UNISAB(U)	;THIS WILL BE NEXT TO BE READ INTO
	MOVE	T1,SABSCN##(R)	;AOBJN WORD FOR SAT BITS
	SKIPN	T2,T3		;CHECK FOR ERRORS DETECTED IN MONRED
	PUSHJ	P,SATCN		;COUNT 0'S IN SAT
	HRRZ	T1,SABTAL##(R)	;DONE. # OF 0'S WE EXPECT
	CAIN	T1,(T2)		;RIGHT?
	PJRST	SATW2		;YES. ZERO SATCHG AND RETURN
	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
	LDB	T2,UNYBPC##
	IMULI	T1,(T2)		;CONVERT CLUSTERS TO BLOCKS
	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##(R)	;SET SABTAL FOR THIS SAT TO 0
	MOVE	T1,SABSCN##(R)	;SET ALL BITS IN THE SAT TO 1
	MOVSI	T2,400000+R	;INSTRUCTION FORMAT INDIRECT WORD
	HRRM	T1,T2		;UPDATED AOBJN POINTER
	SETOM	@T2
	AOBJN	T1,.-2
	PJRST	SATW2		;ZERO SATCHG (SO SAT WONT BE WRITTEN) AND EXIT

;ROUTINE TO COUNT 0 BITS IN A TABLE
;ARGS: T1=RELATIVE AOBJN POINTER TO TABLE, R=ADDRESS OF THE TABLE
;VALUES: T2=NO. OF 0-BITS IN TABLE
;RESPECTS T4
SATCN::	PUSHJ	P,SAVE1##	;SAVE AN AC
	SETZ	T2,		;T2 WILL COUNT 0'S FOUND
	PUSH	P,T4
	MOVSI	P1,400000+R	;INSTRUCTION FORMAT INDIRECT POINTER
SATR1:	HRRM	T1,P1		;POINT INDIRECT POINTER AT THE TABLE
	MOVE	T3,@P1		;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 R
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
IFN FTXMON,<
	PUSH	P,F		;SAVE F
	HRRZS	F		;SIGN BIT SHOULD BE ON BUT IT ISN'T ALWAYS
	PUSH	P,DEVISN(F)	;SAVE CURRENT SECTION NUMBER FOR I/O
>
	PUSHJ	P,SATADR	;SET PARAMETERS FOR WRITE
IFN FTXMON,<
	JRST	@[0,,.+1]	;MUST BE IN SECTION 0
>
	PUSH	P,DEVUNI##(F)
	PUSH	P,R		;SAVE SAT ADDRESS (R IS NOT REALLY PRESERVED)
	PUSHJ	P,STOAU		;UNIT WE'RE TALKING TO
IFN FTMP,<
	SKIPE	DINITF##	;IF IN REFRESHER, UNIT ON ANOTHER CPU
	PUSHJ	P,REFWRT##	; LET ONCMOD DO THE WRITE
>
	  PUSHJ	P,MONWRT	;WRITE THE SAT
	POP	P,R		;RESTORE SAT ADDRESS
	POP	P,DEVUNI##(F)
IFN FTXMON,<
	POP	P,DEVISN(F)	;RESTORE SECTION NUMBER FOR I/O
	POP	P,F		;RESTORE F
	XJRST   [MCSEC1+.+1]	;MUST BE IN SECTION 1
>
SATW2:	MOVSI	T1,SATCHG	;ZERO SAT-CHANGED BIT
	ANDCAM	T1,SABFIR##(R)
IFE FTXMON,<
	POPJ	P,		;AND RETURN
>
IFN FTXMON,<
	SKIPE	.UONCE##	;IF THIS IS USER MODE
	POPJ	P,		;THEN A SIMPLE RETURN WILL DO
	PJRST	SPCS##		;PUT PCS BACK AND RETURN
>


;SUBROUTINE TO SET UP PARAMETERS FOR A SAT-BLOCK READ OR WRITE
;ENTER WITH T4=INDEX TO SATSPT TABLE R=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
IFN FTXMON,<
	HLRZ	T1,R		;SECTION NUMBER
	HRRM	T1,DEVISN(F)	;STORE IT FOR THE I/O
>
	MOVEI	T1,SABBIT##-1(R);ADDRESS FOR IOWD
	HLL	T1,SABSCN##(R)	;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 R=1ST SAB ADR
CHKNEW:	LDB	T1,[POINT CLASIZ,SABFIR##(R),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,R		;P2=1ST SAB ADDR
CHKNE2:	PUSHJ	P,SATRED	;READ THE SAT
	MOVE	R,SABRNG##(R)	;STEP TO NEXT SAB
	CAME	P2,R		;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
	HRRZ	T3,UNISTR(U)
	SKIPG	STRTAL##(T3)	;ROOM ON STR?
	JRST	CHKQT1		;NO, COMPLAIN TO USER
	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
	MOVE	T1,.CPJOB##
	MOVE	T1,JBTSTS##(T1)	;DOES JOB WANT TO STOP ON FULL?
	TRNN	T1,JS.SFL
	JRST	CHKQ1B		;NO, RETURN
	PUSHJ	P,SAVSTS	;YES, SAVE A RECORD OF RESOURCES JOB OWNS
	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
;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 /
	MOVE	T2,(P)		;DDB
	MOVE	T2,DEVACC##(T2)	;AT
	LDB	T1,ACYFSN##	;FSN
	MOVE	T1,TABSTR##(T1)	;STR DATA BLOCK LOC
	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
;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,CRLF##
	PUSHJ	P,PRQM##	;"?"
	PUSHJ	P,INLMES##	;AND THE MESSAGE....
	ASCIZ	/Quota or storage exhausted on /
	MOVE	T1,(P)		;GET F
	MOVE	T1,DEVUNI##(T1)	;UNIT
	HRRZ	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
	MOVE	S,DEVIOS(F)	;RELOAD S FROM DDB
	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::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
	HRRZ	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)
	MOVEI	T2,-1		;NUMBER OF CLUSTERS DEVLFT WILL HOLD
	LDB	T3,UNYBPC##
	IDIVM	T2,T3
	SETO	T2,		;NUMBER OF CLUSTERS A PNTR WILL HOLD
	LDB	T2,STYCNP##(T4)
	CAMLE	T3,T2		;TAKE THE SMALLER OF THE TWO
	MOVE	T3,T2
	MOVE	T2,@DEVRET##(F)	;CURRENT POINTER
	LDB	T2,STYCNP##(T4)	;CURRENT GROUP SIZE
	SUBM	T3,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
CHKAD0:	MOVE	T1,T2		;ORIGINAL T2 INTO T1

CHKAD1:	SETZ	T2,		;RETURN CANT ADD
	POPJ	P,
	SUBTTL	AUTCONFIGURATION - BUILD DISK KDB

;BUILD A KONTROLLER DATA BLOCK.
;CALL:	T1/ MASSBUS UNIT NUMBER (MEANINGFUL FOR DX20/RP20 ONLY) OR -1
;	T2/ KONTROLLER TYPE CODE (TYPXX)
;	PUSHJ	P,DSKKON
;	  <NON-SKIP>		;NO CORE FOR KDB
;	<SKIP>			;AC J = NEW KDB ADDRESS
;NOTE:  KDB ADDRESS ALSO RETURNED IN AC W (AUTCON CONVENTION)

DSKKON::PUSH	P,T2		;SAVE KONTROLLER TYPE CODE
	PUSHJ	P,AUTKDB##	;BUILD AND LINK A KDB
	  JRST	TPOPJ##		;NO CORE
	MOVE	J,W		;PUT KDB ADDRESS IN J FOR KOYXXX BYTE POINTERS
	POP	P,T1		;RESTORE KONTROLLER TYPE CODE
	DPB	T1,KOYKTP##	;SALT IT AWAY
	LDB	T1,[POINT 5,KDBNAM(J),17] ;GET KONTROLLER NUMBER
	DPB	T1,KOYKNM##	;SALT IT AWAY
	MOVE	T1,KDBIUN(J)	;GET AOBJN POINTER TO UNIT TABLE
	HRRM	T1,KONPTR(J)	;SET UP KONPTR
	ADDM	J,KONEBK(J)	;COMPUTE ADDRESS OF DRIVE REGISTER STORAGE
	JRST	CPOPJ1##	;SUCCESS RETURN
	SUBTTL	AUTOCONFIGURATION - BUILD DISK DRIVE UDB

;BUILD A DISK DRIVE UNIT DATA BLOCK.
;CALL:	T1/ PHYSICAL UNIT NUMBER,,UDB TABLE OFFSET
;	T2/ FLAGS,,UNIT TYPE CODE
;	J/ KDB ADDRESS
;	PUSHJ	P,DSKDRV
;	  <NON-SKIP>		;NO CORE FOR UDB
;	<SKIP>			;AC U = NEW UDB ADDRESS
;WHERE FLAGS ARE:
;	1B0 = NON-REMOVABLE MEDIA

DSKDRV::HRRZ	U,KDBIUN(J)	;SEE IF THAT UNIT ALREADY EXISTS
	ADDI	U,(T1)		;ADD IN UDB TABLE OFFSET (UNIT NUMBER USUALLY)
	SKIPE	U,(U)		;IS THERE ALREADY A UDB THERE?
	JRST	DSKDR6		;YES
	PUSHJ	P,SAVE1##	;WE'D LIKE THE CHN AVAILABLE IN P1
	MOVE	P1,KDBCHN(J)
	PUSHJ	P,SAVW##	;AUTCON WANTS THE KDB IN W
	MOVE	W,J		; SO LET'S BE ACCOMODATING
	PUSH	P,T1		;SAVE PHYSICAL UNIT #,,UDB TABLE OFFSET
	PUSH	P,T2		;SAVE FLAGS,,UNIT TYPE CODE
	PUSHJ	P,AUTUDB##	;BUILD A UDB
	  JRST	TTPOPJ##	;NO CORE
	POP	P,T1		;RESTORE FLAGS,,UNIT TYPE CODE
	DPB	T1,UNYUTP##	;SALT AWAY IN UDB
	MOVSI	T2,U2PNRM	;GET NON-REMOVABLE MEDIA FLAG
	SKIPGE	T1		;SIGN BIT OF FLAGS WORD SET?
	IORM	T2,UNIDS2(U)	;YES
	POP	P,T1		;GET PHYSICAL UNIT #,,UDB TABLE OFFSET
	DPB	T1,UNYKOF##	;SALT AWAY IN UDB
	MOVEI	T1,UNVNPM	;STATUS = NO PACK MOUNTED (INITIALLY)
	DPB	T1,UNYUST##	;(IN CASE AUTCON NOT RUNNING BEFORE ONCMOD)
	LDB	T1,KOYKTP##	;GET KONTROLLER TYPE
	DPB	T1,UNYKTP##	;COPY TO UDB
IFN FTCIDSK,<
	MOVE	T2,.CPBIT##	;GET BIT FOR THIS CPU
	CAIN	T1,TYPRA	;CI DISK PSEUDO-CONTROLLER?
	ANDCAM	T2,UDBCAM(U)	;CLEAR ACCESSIBILITY MASK UNTIL UNIT ONLINE
>; END IFN FTCIDSK
	AOS	T1,SYSGEN##	;GET A UNIQUE UNIT GENERATION NUMBER
	HRRM	T1,UNIGEN(U)
	MOVSI	T1,777		;SET UP RANDOM UDB LOCS
	MOVEM	T1,UNICCT(U)
	MOVE	T1,[LBNHOM##,,LB2HOM##]
	MOVEM	T1,UNIHOM(U)
	SETOM	UNICYL(U)
	SETOM	UNIAJB(U)
				;*** COMPATIBILITY WITH OLD PROGRAMS
	LDB	T1,CHYSCN##	;GET SOFTWARE CHANNEL NUMBER
	DPB	T1,[POINT 3,UNIDES(U),20] ;STORE IN UNIDES (DSKCHR UUO)
	LDB	T1,KOYKNM##	;GET KONTROLLER NUMBER
	DPB	T1,[POINT 3,UNIDES(U),29] ;STORE IN UNIDES (DSKCHR UUO)
	MOVE	T1,UDBPDN(U)	;GET PHYSICAL DRIVE NUMBER
	DPB	T1,[POINT 3,UNIDES(U),35] ;STORE IN UNIDES (DSKCHR UUO)
;SET UP UNICHN LINKS
	SYSPIF			;PREVENT RACES AND FUMBLED LINKS
	SETZB	T1,T2		;NO FIRST OR LAST UNIT
	PUSH	P,P1		;PRESERVE P1
	MOVE	P1,CHNTBP(P1)	;GET AOBJN POINTER TO KDBS ON THIS CHN
DSKDR1:	MOVE	T4,(P1)		;GET A KDB ADDRESS
	MOVE	T4,KDBIUN(T4)	;GET AOBJN POINTER TO UNITS
	PUSHJ	P,FLUKN1	;FIND FIRST AND LAST UNITS ON THAT KON
	AOBJN	P1,DSKDR1	;LOOP FOR ANY OTHER KDBS ON THIS CHN
	POP	P,P1		;DONE WITH P1
	JUMPE	T1,DSKDR2	;JUMP IF NEW UNIT WAS ONLY UNIT
	MOVEM	T1,UNICHN(U)	;POINT NEW UNIT AT FIRST UNIT
	MOVEM	U,UNICHN(T2)	;POINT OLD LAST UNIT AT NEW UNIT
	JRST	DSKDR3		;DONE
DSKDR2:	MOVEM	U,UNICHN(U)	;ONLY UNIT, IT POINTS TO ITSELF
;SET UP UNIKON LINKS
DSKDR3:	PUSHJ	P,FLUKON	;FIND FIRST AND LAST UNITS ON THIS KON
	JUMPE	T1,DSKDR4	;JUMP IF NEW UNIT WAS ONLY UNIT
	MOVEM	T1,UNIKON(U)	;POINT NEW UNIT AT FIRST UNIT
	MOVEM	U,UNIKON(T2)	;POINT OLD LAST UNIT AT NEW UNIT
	JRST	DSKDR5		;DONE
DSKDR4:	MOVEM	U,UNIKON(U)	;ONLY UNIT, IT POINTS TO ITSELF
DSKDR5:	PUSHJ	P,LNKSUN	;LINK UNIT INTO UNISYS CHAIN
	SYSPIN			;THINGS ARE CONSISTENT AGAIN
DSKDR6:	PUSH	P,W		;SAVE W
	MOVE	W,J		;PUT KDB ADDRESS IN PROPER PLACE
	MOVE	T1,UDBPDN(U)	;PHYSICAL DRIVE NUMBER
	MOVEI	T2,KDBNUM	;STATE,,MASK WORD OFFSET
	PUSHJ	P,AUTMSK##	;CLEAR NEW UNIT FOR THIS DRIVE
	  JFCL			;CAN'T FAIL HERE
	MOVE	T1,UDBPDN(U)	;PHYSICAL DRIVE NUMBER
	MOVEI	T2,KDBIUM	;STATE,,MASK WORD OFFSET
	PUSHJ	P,AUTMSK##	;CLEAR IGNORE UNIT FOR THIS DRIVE
	  JFCL			;CAN'T FAIL HERE
	POP	P,W		;RESTORE W
	LDB	T1,UNYUST##	;GET UNIT STATE
	CAIN	T1,UNVDWN	;UNIT DOWN?
	JRST	DSKDR9		;POSSIBLY DETACHED SO LEAVE ALONE

DSKDR7:	SKIPGE	KONCPY(J)	;CAN WE CALL CPY ROUTINE IF KONTROL BUSY?
	SKIPL	KONBSY(J)	;NO, IS KONTROLLER BUSY?
	JRST	DSKDR8		;GO READ DATA
	PUSHJ	P,UUOLVL##	;CAN WE BLOCK?
	  TDZA	T1,T1		;MUST BE SPRINI
	MOVEI	T1,1		;SLEEP TIME
	PUSHJ	P,SLEEPF##	;ZZZZZZ
	JRST	DSKDR7		;TRY AGAIN

DSKDR8:	SKIPN	.UONCE##	;IF WE'RE IN USER MODE THEN JUST RETURN NICELY
	SKIPE	DINITF##	;DITTO FOR INITIALIZATION
	JRST	DSKDR9		;DON'T BOTHER THE DRIVER DURING INITIALIZATION
	S0PSHJ	@KONCPY(J)	;SEE IF DRIVE EXISTS
	  JRST	DSKDR9		;CAN'T DETERMINE STATUS
	MOVEM	T1,UNIBPU(U)	;SAVE BLOCKS PER UNIT
	MOVEM	T2,UNIBPM(U)	;SAVE BLOCKS PER UNIT INCL. MAINT CYLS
	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
	MOVEI	T1,UNVPIM	;ASSUME PACK IS MOUNTED
	TLNE	T4,KOPUHE	;UNIT HAD ERRORS (OFFLINE)?
	MOVEI	T1,UNVNPM	;YES--SAY NO PACK MOUNTED
	TLNE	T4,KOPNSU	;NO SUCH UNIT?
	MOVEI	T1,UNVDWN	;CALL IT A DOWN UNIT
	DPB	T1,UNYUST##	;UPDATE STATE
IFN FTMDA,<PUSHJ P,DSKMPA>	;INDICATE DISK DRIVE ATTACHED
DSKDR9:	MOVE	W,J		;FILSER HAS NO RESPECT FOR CONVENTIONS
	JRST	CPOPJ1##	;RETURN
IFN FTMDA,<

;SEND A DEVICE ATTACHED MESSAGE TO [SYSTEM]MDA
;CALL:
;	U/ ADDRESS OF UDB JUST ATTACHED

DSKMPA:	MOVE	T2,U		;COPY ATTACHED UDB ADDRESS
IFE FTDUAL,<SETZ T3,>		;NO DUAL PORT IF FTDUAL IS OFF
IFN FTDUAL,<
	SKIPGE	T3,UNI2ND##(U)	;IS THIS THE ALTERNATE PORT?
	EXCH	T2,T3		;YES, T2=PRIMARY UDB, T3=SECONDARY UDB
>; END IFN FTDUAL
	MOVE	T1,UDBNAM(T2)	;GET NAME OF PRIMARY PORT
	SKIPE	T2,T3		;HAVE A SECONDARY PORT UDB?
	MOVE	T2,UDBNAM(T3)	;YES, GET THE NAME
	PJRST	ATTMPA##	;INFORM [SYSTEM]MDA


;SEND A DEVICE DETACHED MESSAGE TO [SYSTEM]MDA
;CALL:
;	U/ ADDRESS OF UDB JUST DETACHED
;	T1/ ADDRESS OF NEW PRIME PORT (IF ANY)

DSKMPD:
IFE FTDUAL,<SETZ T1,>		;NO NEW PRIMARY PORT NAME
IFN FTDUAL,<
	SKIPE	T1		;DID UNIT HAVE AN ALTERNATE PORT?
	MOVE	T1,UDBNAM(T1)	;PICK UP NEW PRIMARY PORT NAME
> ;END IFN FTDUAL
	PJRST	DETMPA##	;INFORM [SYSTEM]MDA

> ;END IFN FTMDA
;ROUTINE TO FIND FIRST AND LAST UDBS ON A KDB
;CALL:
;	J/ KDB ADDRESS
;RETURN:
;	T1/ FIRST UNIT ON KDB (OR ZERO IF NO UNITS ON KDB)
;	T2/ LAST UNIT ON KDB (OR ZERO IF NO UNITS ON KDB)
;ENTER AT FLUKN1 WITH AOBJN POINTER TO UNITS ON KDB ALREADY IN T4

FLUKON:	SETZB	T1,T2		;NO FIRST OR LAST UNIT
	MOVE	T4,KDBIUN(J)	;GET AOBJN POINTER TO UNITS
FLUKN1:	SKIPE	T3,(T4)		;IS THERE A UDB THERE?
	CAMN	T3,U		;YES, IS IT NOT THE CURRENT ONE?
	JRST	FLUKN2		;NO UDB OR CURRENT ONE, SKIP IT
	MOVE	T2,T3		;REMEMBER LAST UNIT
	SKIPN	T1		;DO WE HAVE A FIRST UNIT?
	MOVE	T1,T2		;NO, SO THIS IS ALSO FIRST UNIT
FLUKN2:	AOBJN	T4,FLUKN1	;LOOP FOR REMAINDER OF TABLE
	POPJ	P,		;RETURN
	SUBTTL	AUTOCONFIGURATION - PROTOTYPE INTERRUPT CODE

DSKICD::PHASE	0		;AUTCON MUST FILL IN OFFSETS

;CONSO SKIP CHAIN CODE

IFN FTKL10,<
DICDIF::!CONSO	000,0		;(0) TEST FOR INTERRUPT FLAGS
	JRST	.		;(1) NOT FOR THIS DEVICE
DICDAE::!JFCL			;(2) RH20-ONLY TEST ON ATTN INTERRUPTS DISABLED
	CONSO	000,7		;(3) MAKE SURE IT HAS A PIA (DIAG. FIDDLING?)
	JRST	1		;(4) NOT INTERESTED
	JSR	PIERR##		;(5) SAVE AC'S
	SKIPA	J,.+1		;(6) LOAD KDB ADDRESS IN FILSER'S AC
	EXP	0		;(7) AUTCON FILLS IN KDB ADDRESS
	XJRST	.+1		;(10) DISPATCH TO INTERRUPT HANDLER
	EXP	0		;(11) INTERRUPT HANDLER ADDRESS
>; END IFN FTKL10

;VECTORRED INTERRUPT CODE

IFN FTKS10,<
	EXP	0		;(0) OLD PC FLAGS
	EXP	0		;(1) OLD PC
	EXP	IC.UOU		;(2) NEW PC FLAGS
	EXP	.+1		;(3) NEW PC
	JSR	PIERR##		;(4) SAVE ACS
	DMOVE	T1,0		;(5) COPY OLD PC DOUBLE WORD
	DMOVEM	T1,-1		;(6) FAKE UP PI CHANNEL INTERRUPT
	SKIPA	J,.+1		;(7) LOAD KDB ADDRESS IN FILSER'S AC
	EXP	0		;(10) AUTCON FILLS IN KDB ADDRESS
	XJRST	.+1		;(11) DISPATCH TO INTERRUPT HANDLER
	EXP	0		;(12) INTERRUPT HANDLER ADDRESS
>; END IFN FTKS10

	DEPHASE
DSKICL==:.-DSKICD		;LENGTH OF CONSO SKIP CHAIN CODE
	SUBTTL	XCHNGE COMMAND

;HERE TO SWITCH TWO UNITS BUT LEAVE THE DATA BASE ALONE -
;EG TO PUT DSKB2 ON RPA5 WHEN RPA2 GOES DOWN, LEAVE SATS, ETC THE SAME

XCHDSK::PUSHJ	P,SAVE3##	;SAVE SOME ACS
	PUSHJ	P,COMUNI	;SET UP U FOR FIRST UNIT
	  PJRST	COMERA##	;NO UNIT OR LOGICAL-UNIT MATCH
	MOVE	P1,U		;SAVE FIRST UNIT
	LDB	P3,UNYKOF##	;GET KONTAB OFFSET
	POP	P,U		;RESTORE U FOR COMCON
	PUSHJ	P,COMUNI	;GET SECOND UNIT
	  PJRST	COMERA##	;NONE OR LOGICAL MATCH
	LDB	P2,UNYKOF##	;GET KONTAB OFFSET
	MOVE	T1,UDBKDB(U)	;KONTROLLER
	CAME	T1,UDBKDB(P1)	;UNITS ON SAME KONTROLLER?
	JRST	XCHERR		;NO, CANT EXCHANGE THEM
	MOVE	T1,UNIBPU(U)	;IF UNIBPU DOESNT MATCH,
	CAME	T1,UNIBPU(P1)
	JRST	XCHERR		; THEN DIFFERENT TYPE UNITS, CANT EXCHANGE THEM
	MOVSI	T1,U2PNRM	;CAN'T EXCHANGE NON-REMOVABLE MEDIA
	TDNN	T1,UNIDS2(P1)	;...
	TDNE	T1,UNIDS2(U)	;...
	JRST	XCHERR		;GIVE ERROR
IFN FTDUAL,<
	SKIPL	UNI2ND(P1)	;DON'T ALLOW EXCHANGE OF ALTERNATE PORT
	SKIPGE	UNI2ND(U)	;...
	JRST	XCHERR		;GIVE ERROR
>; END IFN FTDUAL
	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	XCHDSW		;NO, CANT EXCHANGE
	CAIGE	T1,OWCOD	;2ND UNIT IDLE OR IN OPR WAIT?
	JUMPN	T1,XCHDSW	;CANT EXCHANGE IF NOT
	MOVEI	T1,O2COD	;IF UNITS ARENT IN OPR WAIT
	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,UNYKOF##	;OK - EXCHANGE THE UNITS
	MOVEM	U,@KONPTR(T2)	;MAKE INTERRUPTS FOR 1 UNIT POINT
	EXCH	P1,U		; AT THE OTHER UDB,
	DPB	P2,UNYKOF##	;MAKE THE UDB POINT AT DIFFERENT
	EXCH	P2,P3		; PHYSICAL UNITS,
	MOVEM	U,@KONPTR(T2)
	MOVE	T1,UDBNAM(U)	;CHANGE PHYSICAL NAMES IN THE UDBS
	EXCH	T1,UDBNAM(P1)
	MOVEM	T1,UDBNAM(U)
	MOVE	T1,UDBPDN(U)	;PHYSICAL DRIVE NUMBER FOR SECOND UNIT
	EXCH	P1,U		;SWAP UNITS
	MOVE	T2,UDBPDN(U)	;PHYSICAL DRIVE NUMBER FOR SECOND UNIT
	MOVEM	T1,UDBPDN(U)	;EXCHANGE THE UNITS
	DPB	T1,[POINT 3,UNIDES(U),35] ;OLD PLACE FOR DSKCHR UUO
	EXCH	P1,U		;SWAP UNITS
	MOVEM	T2,UDBPDN(U)	;...
	DPB	T2,[POINT 3,UNIDES(U),35] ;OLD PLACE FOR DSKCHR UUO
	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
IFN FTDUAL,<
	DMOVE	T1,UDBDSN(U)	;CHANGE UNIT SERIAL NUMBERS
	EXCH	T1,UDBDSN(P1)	;...
	EXCH	T2,UDBDSN+1(P1) ;...
	DMOVEM	T1,UDBDSN(U)	;...
	MOVE	T1,UNI2ND(U)	;GET ALTERNATE UNITS
	MOVE	T2,UNI2ND(P1)
	MOVEM	T2,UNI2ND(U)	;EXCHANGE THEM
	MOVEM	T1,UNI2ND(P1)
	SKIPE	T2
	HRRM	U,UNI2ND(T2)	;EXCHANGE THE BACKWARDS POINTERS
	SKIPE	T1
	HRRM	P1,UNI2ND(T1)
	SKIPE	T2,UNI2ND(U)	;IF SECOND UNIT NOW DUAL-PORTED,
	PUSHJ	P,CPYUD		; COPY NECESSARY DATA TO SECOND PORT
	EXCH	P1,U		;POINT AT FIRST UNIT
	SKIPE	T2,UNI2ND(U)	;IF FIRST UNIT NOW DUAL-PORTED,
	PUSHJ	P,CPYUD		; COPY NECESSARY DATA TO SECOND PORT
	EXCH	P1,U		;AS YOU WERE
>; END IFN FTDUAL
	DSKON			;ALLOW DISK INTERRUPTS AGAIN
	MOVE	F,P1		;GET 1ST UDB INTO F
	MOVSI	T1,.CSCXC	;CODE FOR XCH
	PUSHJ	P,DSKCSC	;CALL DAEMON
IFN FTMDA,<
	SKIPN	DINITF##	;DON'T DO THIS DURING INITIALIZATION
	PUSHJ	P,XCHMPA##	;NOTIFY MDA
>
	JRST	UPOPJ##		;RESTORE U AND RETURN TO COMCON

XCHERR:	POP	P,U		;RESTORE COMCON'S U
	PJRST	COMERA##	;GIVE ERROR

XCHDSW:	DSKON
	PJRST	DLYCM1##	;DELAY COMMAND UNTIL WE CAN

SLPJIF:	SETZ	T1,		;SLEEP FOR A JIFFY
	MOVE	J,.CPJOB##	;CAN'T RELY ON J HAVING A JOB NUMBER
	PJRST	SLEEPF##	;ZZZZ AND RETURN
	SUBTTL	DETACH A KONTROLLER

;HERE TO TAKE A KONTROLLER OFF-LINE
;P1 = KDB ADDRESS
;RETURN CPOPJ IF SOME UNIT WOULDN'T DETACH, CPOPJ1 IF ALL UNITS WON
;CLOBBERS P1 & P2

DETKON::MOVE	P1,KDBIUN(P1)	;GET POINTER TO UNITS
	SETZ	P2,		;COUNT UP UNITS THAT FAIL
DETKO1:	SKIPN	U,(P1)		;GET NEXT UNIT ON KON
	JRST	DETKO2		;TRY AGAIN
	PUSHJ	P,DETCPD	;DETACH IT
	  JFCL			;ERROR
	  AOS	P2		;KEEP TRACK OF ERRORS
DETKO2:	AOBJN	P1,DETKO1	;LOOP OVER ALL UNITS ON THIS KONTROLLER
	JUMPE	P2,CPOPJ1##	;WIN IF NO ERRORS
	POPJ	P,		;RETURN ERROR
	SUBTTL	DETACH A UNIT

;HERE TO TAKE A UNIT OFF-LINE
;RETURNS CPOPJ IF NOT A DSK
;RETURNS CPOPJ1 IF CANT DETACH (KON BUSY & NOT CALLED AT UUO LEVEL)
;RETURNS CPOPJ2 IF OK

DETCPD::PUSH	P,U		;SAVE U
	JRST	DETDS1		;JOIN COMMON CODE

DETDSK::PUSHJ	P,COMUNT	;SET UP U (COMCON ALREADY HAS U PUSHED)
	  POPJ	P,		;NO UNIT OR LOGICAL MATCH
DETDS1:	HRRZ	T2,UNISTR(U)
IFN FTDUAL,<
	SKIPN	T1,UNI2ND(U)	;IF NOT DUAL-PORTED
>
	JUMPN	T2,UPOPJ1##	; CAN'T BE IN A FILE STRUCTURE
IFN FTDUAL,<
	SKIPE	T2,UNISTS(U)	;UNIT IDLE
	CAILE	T2,TCOD		; OR SOME FLAVOR OF OPR WAIT?
	TLZA	T1,-1		;YES, WE'RE OK
	JRST	[PUSHJ	P,SLPJIF ;SLEEP FOR A JIFFY
		 JRST  DETDS1]	;GO BACK AND TRY AGAIN
	SETZM	UDBDSN(U)	;INSURE NO DUAL PORT MATCHES
	SETZM	UDBDSN+1(U)
	JUMPE	T1,DETDS3	;GO IF NOT DUAL-PORTED
	CAIA			;U IS ALREADY ON STACK
DETMX:	PUSH	P,U		;SAVE U
	MOVE	T2,UNISTS(U)	;SHUT UP
	MOVEI	T3,O2COD
	CAIN	T2,OCOD
	MOVEM	T3,UNISTS(U)
	MOVE	T2,T1		;COPY OTHER PORT TO T2
	JUMPL	U,DETD10	;JUMP IF NOT DETACHING PRIMARY PORT
	UUOLOK			;PREVENT DA RACE
	PUSHJ	P,CPYUD		;YES, COPY PARAMETERS TO SECOND PORT
DETD10:	PUSH	P,U		;PRESERVE UNIT BEING DETACHED
	SKIPL	U		;RE-LINK APPROPRIATE UNIT ONTO SYSUNI CHAIN
	HRRZ	U,UNI2ND(U)	;DETACHING PRIMARY PORT, GET 2ND PORT ADDRESS
	PUSHJ	P,LNKSUN	;LINK UNIT ONTO SYSUNI CHAIN
	POP	P,U		;RESTORE UNIT BEING DETACHED
	SETZM	UNILOG(U)	;CLEAR STUFF SO SYSTAT WONT DO WIERD THINGS
	SETZM	UNIHID(U)
	HRRZ	T1,UNI2ND(U)
	SETZM	UNI2ND(U)	;CLEAR INFO ABOUT DUAL-PORTEDNESS
	SETZM	UNI2ND(T1)
	AOS	T2,SYSGEN##	;MAKE CHEKU FAIL
	HRRZM	T2,UNIGEN(U)
	JUMPL	U,DETDS3	;NO SWEAT IF DETACHING A 2ND PORT
	UUONLK			;CAN LET UPDA THROUGH NOW
	PUSHJ	P,CSDELU	;INVALIDATE DISK CACHE FOR THIS UNIT
	PUSHJ	P,ADJUD		;ADJUST UNISTR, UNISWP LINKS
				;FALL INTO DETDS3
> ;END IFN FTDUAL
;UNLINK FROM SYSUNI, LINK TO SYSDET
DETDS3:
IFN FTCIDSK,<
DETUDB::			;ENTRY FROM ONCMOD FOR CI DISKS
>; END IFN FTCIDSK
	PUSH	P,T1		;PRESERVE T1 (SECOND PORT ADDRESS)
	PUSHJ	P,UNLSUN	;UNLINK UNIT FROM SYSUNI CHAIN
	PUSHJ	P,LNKSDT	;LINK UNIT ONTO SYSDET CHAIN
	POP	P,T1		;RESTORE T1
	MOVEI	T2,UNVDWN	;INDICATE DETACHED UNIT IS DOWN
	DPB	T2,UNYUST##
	HRRZ	T2,LASUNI	;LAST UNIT CONFIGURED
	CAIN	T2,(U)		;ONE WE'RE DETACHING?
	SETZM	LASUNI		;YES, LET AUTCON WORK HARDER
IFN FTCIDSK,<
	SKIPE	DINITF##	;ONCE-ONLY?
	POPJ	P,		;YES, RETURN NOW
>; END IFN FTCIDSK
IFN FTMDA,<PUSHJ P,DSKMPD>	;NOTIFY MDA OF LOSS
	MOVSI	T1,.CSCDT	;CODE TO SAY DETACH
	PUSHJ	P,DSKCSC	;CALL DAEMON
	POP	P,U
	PJRST	CPOPJ2##	;AND RETURN
	SUBTTL	ATTACH A KONTROLLER

;HERE TO PUT A KONTROLLER ON-LINE
;P1 = KDB ADDRESS
;RETURN CPOPJ1 ALWAYS
;CLOBBERS P1

ATTKON::MOVE	P1,KDBIUN(P1)	;GET POINTER TO UNITS
ATTKO1:	SKIPN	U,(P1)		;GET NEXT UNIT ON KON
	JRST	ATTKO2		;TRY AGAIN
	PUSHJ	P,ATTCPD	;ATTACH IT
	  JFCL			;ERROR
	  JFCL			;OTHER ERROR (DON'T CARE)
ATTKO2:	AOBJN	P1,ATTKO1	;LOOP OVER ALL UNITS ON THIS KONTROLLER
	JRST	CPOPJ1##	;RETURN SUCCESS
	SUBTTL	ATTACH A UNIT

;HERE TO ATTACH A UNIT
;RETURNS NON-SKIP IF UNIT IS DOWN
;CPOPJ1 IF WE CANT CALL CPY ROUTINE NOW SINCE NOT AT UUO LEVEL (TRY LATER)
;CPOPJ2 IF ALL IS OK
ATTCPD::PUSH	P,U		;SAVE U
	JRST	ATTUN0		;JOIN COMMON CODE
ATTDSK::PUSHJ	P,COMUNT	;SET UP U
	  JRST	[TLO U,400000	;NO MATCH
		 POPJ P,]
ATTUN0:	LDB	T1,UNYUST##	;GET UNIT STATUS
	CAIN	T1,UNVNPM	;ALREADY ATTACHED?
	JRST	[AOS  -1(P)	;YES, SET FOR OK RETURN
		 JRST UPOPJ1##]	;DOUBLE SKIP RETURN
	CAIE	T1,UNVDWN	;DOWN?
	JRST	UPOPJ##		;NO, CANT ATTACH IT
	PUSH	P,J		;YES, SAVE J FOR COMCON
ATTUN3:	MOVE	J,UDBKDB(U)	;KONTROLLER DATA BLOCK
	SKIPGE	KONCPY(J)	;CAN WE CALL CPY ROUTINE IF KONTROL BUSY?
	SKIPL	KONBSY(J)	;NO, IS KONTROLLER BUSY?
	SKIPA			;WE CAN TELL UNIT TYPE NOW
	JRST	[PUSHJ	P,UUOLVL## ;CALLED FROM UUO (COMMAND) LEVEL?
		   JRST	ATTUN7	;NO, MUST BE CALL FROM SPRINI
		 PUSHJ	P,SLPJIF ;SLEEP FOR A JIFFY
		 JRST	ATTUN3]	;GO BACK AND TRY AGAIN
IFN FTMP,<
	PUSHJ	P,UUOLVL##	;CALLED FROM UUO (COMMAND) LEVEL?
	  JRST	ATTUN6		;NO, MUST BE CALL FROM SPRINI
	MOVE	T1,UDBCAM(U)	;CPU(S) UNIT IS ON
	PUSHJ	P,CPUOK##	;FIND A LIVE CPU
	  JRST	ATTUN9		;ALL DEAD
	PUSHJ	P,ONCPUS##	;PUT US ON THAT CPU
	  JRST	ATTUN9		;DEAD (CAN'T HAPPEN)
>
ATTUN6:	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
	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
	MOVSI	T1,KOPDWN	;CLEAR KONTROL-IS-DOWN BIT
	ANDCAM	T1,KONDWN(J)
ATTUN1:	AOS	-2(P)		;CPOPJ2 IS GOODNESS
	MOVEI	T1,UNVNPM	;INDICATE NO PACK MOUNTED
	DPB	T1,UNYUST##	; (EG, UNIT IS UP)
	MOVSI	T1,UNPOFL!UNPWMD
	ANDCAM	T1,UNIUST(U)
	SETZM	UNISTS(U)
	PUSHJ	P,UNLSDT	;UNLINK UDB FROM SYSDET CHAIN
	PUSHJ	P,LNKSUN	;LINK UDB ONTO SYSUNI CHAIN
IFN FTDUAL,<
	PUSHJ	P,MATUN		;SEARCH FOR A MATCH
	  JRST	ATTUN4		;FINISH UP
	JRST	ATTUN8
ATTMX:	PUSH	P,U
	PUSH	P,J
	PUSH	P,T2		;SAVE SECOND PORT
	PUSHJ	P,UNLSDT	;UNLINK UDB FROM SYSDET CHAIN
	PUSHJ	P,LNKSUN	;LINK UDB ONTO SYSUNI CHAIN
	POP	P,T2		;RESTORE SECOND PORT
ATTUN8:	PUSHJ	P,LN2ND		;SETUP UNI2ND LINKS FOR THIS DRIVE
				;  AND UNLINK SECOND PORT FROM UNISYS CHAIN
>; END FTDUAL

ATTUN4:	PUSHJ	P,CSDELU	;INVALIDATE DISK CACHE FOR THIS UNIT
				;(SHOULDNT HAVE ANY, BUT..)
IFN FTMDA,<PUSHJ P,DSKMPA>	;INDICATE DISK DRIVE ATTACHED
	POP	P,J		;RESTORE J
	MOVSI	T1,.CSCAT	;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
	POP	P,J
	JRST	UPOPJ##		;NON-SKIP RETURN

;HERE IF CONTROLLER BUSY - TRY AGAIN LATER
ATTUN7:	AOS	-2(P)		;SET FOR CPOPJ1 RETURN
				;FALL INTO ATTUN9

;HERE IF THE CPU IS DEAD
ATTUN9:	POP	P,J
	POP	P,U
	TLO	U,400000
	POPJ	P,
;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,SRUNA##	;FIND MATCHING UNIT
	  JFCL			;NO SUCH UNIT
	  CAIA			;LOGICAL MATCH
	JRST	CPOPJ1##	;PHYSICAL MATCH - GOOD RETURN
	MOVE	U,(P)		;RESTORE U
	EXCH	U,-1(P)
	JRST	T2POPJ##	;TAKE GARBAGE OFF STACK AND BADNESS-RETURN


;ROUTINE TO CALL DAEMON FOR DISK CONFIGURATION STATUS CHANGE
;CALL WITH CODE FOR ATT, DET, XCH IN LH(T1), F + U SETUP
DSKCSC:	SKIPE	DINITF##	;DON'T DO THIS DURING INITIALIZATION
	POPJ	P,		;QUIT NOW
	HRRI	T1,.ERCSC	;GET CODE FOR DAEMON
	PUSH	P,J		;SAVE J
	PUSHJ	P,DAEEIM##	;WAKE DAEMON
	JRST	JPOPJ##		;RETURN
IFN FTDUAL,<			;GOES ON FOR SEVERAL PAGES

;ROUTINE TO TEST IF MATCHING SERIAL-NUMBERS (EG DUAL-PORTED DRIVES) EXIST
;CALL WITH U=UNIT
;RETURNS CPOPJ IF NO MATCH
;RETURNS CPOPJ1 IF A MATCH, T2= MATCHING UNIT
;PRESERVES T4
MATUN::	SKIPN	UDBDSN(U)	;NO MATCH IF NO SERIAL NUMBER
	SKIPE	UDBDSN+1(U)	;...
	SKIPA			;A SERIAL NUMBER, GO FOR IT
	POPJ	P,		;NO SERIAL NUMBER, NO MATCH
	HLRZ	T2,SYSUNI##	;START AT FIRST UNIT IN SYSTEM
MATUN1:	MOVE	T1,UDBDSN(U)	;GET FIRST WORD OF SERIAL NUMBER
	MOVE	T3,UDBDSN+1(U)	;AND SECOND WORD
	CAMN	T1,UDBDSN(T2)	;MATCH?
	CAME	T3,UDBDSN+1(T2) ;BOTH WORDS?
	JRST	MATUN2		;NO MATCH
	CAIE	T2,(U)		;FOR A DIFFERENT UNIT?
	JRST	MATUN3		;FOUND A MATCH.
MATUN2:	HLRZ	T2,UNISYS(T2)	;STEP TO NEXT UNIT
	JUMPN	T2,MATUN1	;AND TEST IT
	POPJ	P,		;NO MATCH, NON-SKIP

MATUN3:	LDB	T1,UNYUTP##	;GET UNIT TYPE
	EXCH	T2,U		;SWAP UDB ADDRESSES A MOMENT
	LDB	T3,UNYUTP##	;GET UNIT TYPE
	EXCH	T2,U		;UDB ADDRESSES BACK AS THEY WERE
	CAME	T1,T3		;SAME UNIT TYPE?
	JRST	MATUN2		;NO, NOT REALLY DUAL PORTED
	MOVE	T3,UDBPDN(U)	;UNIT NO OF 1ST PORT
	XOR	T3,UDBPDN(T2)	;DOES IT MATCH UNIT NO OF 2ND PORT?
	TRNE	T3,-1		;CHECK FOR DIFFERENCE IN PHYSICAL UNIT NUMBER
	JRST	MATUN2		;NO, NOT REALLY DUAL PORTED
	HRRM	T2,UNIALT(U)	;SET UP UNIALT LINK NOW
	HRRM	U,UNIALT(T2)	;...
IFN FTCIDSK,<
	LDB	T1,UNYKTP##	;GET KONTROLLER TYPE
	CAIN	T1,TYPRA	;CI DISK?
	POPJ	P,		;YES, NOT REALLY DUAL PORTED
>; END IFN FTCIDSK
	JRST	CPOPJ1##	;NO, MATCH
;ROUTINE TO SETUP THE UNI2ND LINKS FOR A DRIVE THAT IS DUAL PORTED.
;ALSO COPIES THE NEEDED INFORMATION TO THE SECOND PORT OF THE UNIT
;AND UNLINKS THE SECOND PORT FROM THE UNISYS CHAIN.
;CALL WITH U=UDB ADDRESS OF SECOND PORT, T2=UDB ADDRESS OF 1ST PORT.
;	   J=KDB ADDRESS CORRESPONDING TO U
;RETURNS CPOPJ ALWAYS
;PRESERVES U, T1-T4
LN2ND::	DSKOFF
	PUSHJ	P,SAVT##	;SAVE T1-T4
	PUSH	P,U		;SAVE UDB ADDRESS
	EXCH	U,T2		;MAKE U=SOURCE, T2=DESTINATION
	PUSHJ	P,CPYUD		;COPY NEEDED DATA TO 2ND PORT
	EXCH	U,T2		;PUT THEM BACK
	HRRZM	U,UNI2ND(T2)	;POINT MAIN UNIT AT THIS ONE
	TLO	T2,(1B0)
	MOVEM	T2,UNI2ND(U)	;POINT THIS UNIT AT MAIN UNIT
	PUSHJ	P,UNLSUN	;UNLINK FROM SYSUNI CHAIN
	DSKON
	JRST	UPOPJ##		;RESTORE U AND RETURN
;ROUTINE TO ADJUST THE STRUCTURE AND ACTIVE SWAPPING LINKED LISTS
;WHEN THE OTHER PORT OF A DUAL PORTED UNIT BECOMES THE PRIME PORT.
;CALL WITH U=ADDRESS OF SOURCE UDB, T1=ADDRESS OF DESTINATION UDB.
;PRESERVES ALL AC'S

ADJUD:	PUSHJ	P,SAVT##	;SAVE THE T AC'S
	MOVEI	U,(U)		;MAKE SURE LH OF U IS ZERO
	HRRZ	T2,UNISTR(U)	;GET THE STR DATA BLOCK ADDRESS
	JUMPE	T2,ADJUD2	;NOTHING TO DO IF NOT IN A STRUCTURE
	SUBI	T2,UNISTR-STRUNI## ;OFFSET FOR INDEX BELOW
ADJUD1:	HRRZ	T3,T2		;COPY THE CURRENT UDB ADDRESS
	HLRZ	T2,UNISTR(T2) ;STEP TO THE NEXT ONE
	JUMPE	T2,ADJUD2	;QUIT AT END OF LIST
	CAIE	T2,(U)		;FIND THE ONE BEING DETACHED?
	JRST	ADJUD1		;NO, KEEP TRYING
	HRLM	T1,UNISTR(T3)	;POINT IT AT THE NEW UDB
ADJUD2:	MOVSI	T4,MSWPMX##	;BUILD AOBJN POINTER TO SWPTAB
ADJUD3:	CAME	U,SWPTAB##(T4)	;FIND A MATCH?
	AOBJN	T4,ADJUD3	;NO, TRY NEXT
	MOVEI	T2,SWPUNI##-UNISWP ;START AT BEGINNING OF SWAPING LIST
ADJUD4:	HRRZ	T3,T2		;COPY CURRENT UDB ADDRESS
	HLRZ	T2,UNISWP(T2)	;STEP TO NEXT ONE
	JUMPE	T2,ADJUD5	;QUIT AT END OF LIST
	CAIE	T2,(U)		;FIND A MATCH?
	JRST	ADJUD4		;NO, TRY NEXT
	HRLM	T1,UNISWP(T3)	;STORE NEW UDB ADDRESS IN PREVIOUS
	SKIPGE	T4		;FIND A MATCH IN SWPTAB
	HRRZM	T1,SWPTAB##(T4)	;YES, PUT OTHER UDB THERE
	HRLM	T1,NXTSUN##	;ENSURE NO PNTR TO OTHER PORT
ADJUD5:	HLRZ	T2,SWPUN2##	;GET FIRST OF SLOW SWAPPING UNITS?
	CAIN	T2,(U)		;IS IT THE ONE BEING DETACHED?
	HRLM	T1,SWPUN2##	;YES, STORE NEW UDB ADDRESS
	POPJ	P,		;RETURN
;UNIT FAILOVER ROUTINE
;CALL WITH U = NEW UDB
;THIS ROUTINE WILL ATTACH THE NEW UNIT AND DETACH THE OLD ONE

IFN FTCIDSK,<
FLPUDB::HRRZ	T2,UNIALT(U)	;T2=OLD UDB
	JUMPE	T2,CPOPJ##	;NONE
	LDB	T1,UNYUST##	;STATUS OF NEW UNIT
	LDB	T3,UNXUST##	;STATUS OF OLD UNIT
	CAIE	T3,UNVDWN	;OLD UNIT MUST BE UP
	CAIN	T1,UNVPIM	;NEW UNIT MUST BE NOT 'PACK IS MOUNTED'
	POPJ	P,		;NO, IT'S ALREADY THE PRIME PORT
	MOVE	T1,UNISTS(T2)	;PUT NEW UDB IN OW
	MOVEM	T1,UNISTS(U)
	PUSHJ	P,ATTMX		;ATTACH NEW UDB
	  JFCL
	HRRZ	T1,UNIALT(U)	;T1=OLD UDB
	EXCH	T1,U		;U=OLD, T1=NEW
	PUSHJ	P,DETMX		;DETACH OLD UDB
	  JFCL
	  JFCL
	MOVEI	T1,ACTDRB##-DRBLNK## ;PRESET PRED
	DSKOFF
FLUDB1:	HRRZ	T1,DRBLNK##(T1)	;#STEP TO THE NEXT DRB
	CAIN	T1,ACTDRB##
	JRST	DOPOPJ		;#NONE
	MOVE	T2,DRBSTS##(T1)	;#WAITING FOR RETRY?
	HRRZ	T3,DRBCDA##(T1)	;#AND SWAPPER?
	TRNE	T2,DRPTRY##
	CAIE	T3,SWPDDB##
	JRST	FLUDB1		;#NO, TRY NEXT DRB
	HLRZ	T2,DRBCUR##(T1)	;#UNIT OF DRB
	CAME	T2,U		;#DRB IS FOR OLD UNIT?
	JRST	FLUDB1		;#NO, NEXT DRB
	HRRZ	T3,UNIALT(U)	;#YES, NEW UNIT
	HRLM	T3,DRBCUR##(T1)	;#SWITCH DRB TO NEW UNIT
IFN FTMP,<
	LDB	T2,DRYCPU##	;#ORIGINAL CPU
	MOVEI	T4,1		;#BIT MASK
	LSH	T4,(T2)
	TDNE	T4,UDBCAM(T3)	;#CAN ORIGINAL CPU DO IT?
	JRST	FLUDB1		;#YES, NO PROBLEM
	PUSH	P,T1		;#NO, FIND A CPU THAT CAN
	MOVE	T1,UDBCAM(T3)
	PUSHJ	P,CAMCPU##
	MOVE	T2,T1		;GET CPU NUMBER
	POP	P,T1
	DPB	T2,DRYCPU##	;#RESWP WILL WAIT FOR CACHE TO BE RIGHT
>; END IFN FTMP
	JRST	FLUDB1		;#NEXT DRB
>; END IFN FTCIDSK
;ROUTINES TO COPY INFORMATION FROM ONE UDB OF A DUAL PORTED DISK DRIVE
;TO THE OTHER.  CPYUD COPIES ALL NECESSARY INFORMATION.  CPYST ONLY
;COPIES STRUCTURE RELATED INFORMATION.
;CALL WITH U=SOURCE UDB ADDRESS,  T2=DESTINATION UDB ADDRESS.
;DESTROYS T1

CPYST::	SKIPA	T1,[-CSTTBL,,CSTTAB] ;GET AOBJN POINTER FOR CSTTAB
CPYUD::	MOVE	T1,[-CUDTBL,,CUDTAB] ;DITTO FOR CUDTAB
	PUSH	P,T3		;SAVE T3
CPYUD1:	LDB	T3,(T1)		;GET NEXT BYTE FROM SOURCE UDB
	EXCH	U,T2		;EXCHANGE UDB ADDRESSES
	DPB	T3,(T1)		;STORE IN DESTINATION UDB
	EXCH	U,T2		;PUT THEM BACK
	AOBJN	T1,CPYUD1	;LOOP FOR ALL
	JRST	T3POPJ##	;RESTORE T3 AND RETURN


;THE FOLLOWING TABLE DEFINES THE FIELDS IN THE UDB THAT MUST BE
;COPIED TO THE SECOND PORT OF A DISK WHEN A UNIT IS DUAL PORTED OR
;WHEN THE STATUS OF A UDB CHANGES, E.G., DETACH.  CUDTAB IS USED WHEN
;ALL PARAMETERS ARE TO BE COPIED, CSTTAB IS USED TO COPY ONLY STRUCTURE
;RELATED PARAMETERS.

CUDTAB:	POINT	36,UNISWP(U),35
	POINT	36,UNIFKS(U),35
	POINT	36,UNIHOM(U),35
	POINT	18,UNIGRP(U),17
;	POINT	36,UNIBPU(U),35	;SETUP BY RETURN FROM KONCPY
;	POINT	36,UNIBPM(U),35	;  DITTO
	POINT	36,UNICPS(U),35
	POINT	36,UNISAB(U),35
	POINT	36,UNISPT(U),35
	POINT	36,UNITAL(U),35
	POINT	18,UNIDES(U),17
	POINT	36,UNIPTR(U),35
	POINT	36,UNISLB(U),35
	POINT	36,UNIBUC(U),35

	POINT	36,UNIAJB(U),35
IFN FTXMON,<
	POINT	9,UNISNS(U),8
>; END IFN FTXMON
	POINT	36,UNIGEN(U),35
CSTTAB:	POINT	36,UNILOG(U),35
	POINT	36,UNIHID(U),35
	POINT	36,UNISTR(U),35
	POINT	18,UNISYS(U),35
	POINT	36,UNIBPC(U),35
CUDTBL==.-CUDTAB
CSTTBL==.-CSTTAB

>; END IFN FTDUAL
	SUBTTL	ROUTINES TO MANIPULATE SYSUNI AND SYSDET CHAINS


;ROUTINE TO UNLINK A UNIT FROM THE SYSUNI OR SYSDET CHAIN.
;ENSURES UNIT IS ALREADY ON CHAIN BEFORE UNLINKING IT.
;CALL WITH UDB ADDRESS IN U.

UNLSUN:	SKIPA	T1,[SYSUNI##-UNISYS] ;SET PREDECESSOR
UNLSDT:	MOVEI	T1,SYSDET##-UNISYS ;SET PREDECESSOR
UNLSY1:	HLRZ	T2,UNISYS(T1)	;GET LINK TO NEXT UNIT
	JUMPE	T2,CPOPJ##	;RETURN IF NOT LINKED ONTO THIS CHAIN
	CAIN	T2,(U)		;FOUND DESIRED UNIT?
	JRST	UNLSY2		;YES
	MOVE	T1,T2		;RESET PREDECESSOR
	JRST	UNLSY1		;KEEP LOOKING

UNLSY2:	MOVE	T2,UNISYS(U)	;GET LINK TO NEXT UNIT
	HLLM	T2,UNISYS(T1)	;LINK NEXT UNIT TO PREDECESSOR
	HRRZS	UNISYS(U)	;CLEAR OUT ANY LINKS IN THIS UDB
	POPJ	P,		;RETURN


;ROUTINE TO LINK A UNIT ONTO THE SYSUNI OR SYSDET CHAIN.
;ENSURES UNIT IS NOT ALREADY LINKED ONTO THE CHAIN.
;CALL WITH UDB ADDRESS IN U.

LNKSUN:	SKIPA	T1,[SYSUNI##-UNISYS] ;SET PREDECESSOR
LNKSDT:	MOVEI	T1,SYSDET##-UNISYS ;SET PREDECESSOR
	MOVE	T2,T1		;COPY PREDECESSOR FOR ACTUAL LINKING
LNKSY1:	HLRZ	T1,UNISYS(T1)	;GET LINK TO NEXT UNIT
	JUMPE	T1,LNKSY2	;IF NOT FOUND, OK TO PROCEED
	CAIN	T1,(U)		;FOUND DESIRED UNIT?
	POPJ	P,		;YES, ALREADY ON CHAIN, DO NOTHING
	CAIG	T1,(U)		;GONE PAST THE DESIRED UDB?
	MOVE	T2,T1		;NO, RESET PREDECESSOR
	JRST	LNKSY1		;KEEP LOOKING

LNKSY2:	HLLZ	T1,UNISYS(T2)	;GET LINK TO NEXT UNIT OF PREDECESSOR
	HLLM	T1,UNISYS(U)	;LINK NEXT UNIT TO THE DESIRED UDB
	HRLM	U,UNISYS(T2)	;NOW LINK DESIRED UDB TO PREDECESSOR
	POPJ	P,		;DONE
	SUBTTL	USETI/USETO
USETI0::SKIPGE	DEVSPL(F)	;IF THIS IS A SPOOLED DDB,
	POPJ	P,		;USETI IS A NO-OP
	PUSHJ	P,NULTST##	;USETI NUL: WINS
	  POPJ	P,
	PUSHJ	P,WAIT1##	;MAKE SURE ALL I/O IS DONE
	TLNN	F,LOOKB		;LOOKUP DONE?
	JRST	SETSUP		;NO. SUPER USETI IF PRIVILEGED
	PUSHJ	P,SETU		;SET UP U FROM DDB
	  POPJ	P,		;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
	MOVE	P1,W		;GET USETI ARGUMENT TO P1
	CAMGE	P1,MUSTMX##	;SKIP IF RH(M) POSSIBLE EXTEDNED RIB
	JRST	USETI4		;NOT LOOKING FOR EXTENDED RIBS
	AOJGE	P1,USETI4	;IF -1 OR POSITIVE, NOT EXTENDED
	HRRZ	U,DEVUNI##(F)	;GET CURRENT UNIT
	PUSHJ	P,PTRTST	;READ POINTERS, RE-WRITE IF CHANGED
	  POPJ	P,		;ERROR READING RIB
	SKIPL	DEVRIB##(F)	;PRIME RIB?
	JRST	USETI2		;YES, GET EXTENDED
	PUSHJ	P,REDRIB	;NO, READ PRIME RIB
	  POPJ	P,		;ERROR READING RIB
USETI2:	PUSHJ	P,PTRNXT	;GET EXTENDED RIB
	  JRST	USETI3		;EITHER RIB ERROR OR NONE
	AOJN	P1,USETI2	;JUMP BACK IF NOT THIS RIB
	MOVE	U,T2		;(NEW) UNIT
	PUSHJ	P,STORU		;PUT IN DDB
	PUSHJ	P,PTRBLT	;GET POINTERS TO DDB
	MOVE	T1,.USMBF	;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
	  POPJ	P,		;REALLY OUGHT TO BE A STOPCD
	MOVNS	DEVREL##(F)	;FLAG SO OUTPUT NEXT IS ILLEGAL
	TLZ	S,IOSFIR	;RIBS AREN'T CHECKSUMMED
	JRST	USETI7		;AND EXIT.
USETI3: JUMPN	T3,CPOPJ##	;GO IF RIB ERROR
	TRO	S,IOBKTL	;NON-EXISTANT RIB, GIVE HIMM ERROR
	PJRST	INPSW8##	;POINT AT BLOCK ONE

USETI4:	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	USETI6
	MOVEM	W,DEVREL##(F)
	PUSHJ	P,FNDPTR
	  POPJ	P,
USETI6:	JUMPL	P1,USETI7	;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
USETI7:	TDZ	S,[XWD IOEND,IODEND]	;OK - ZERO EOF BITS
	PUSHJ	P,EXTCKS	;LIGHT IOSFIR IF 1ST BLOCK IN EXT. RIB
	PJRST	STOIOS##	;STORE S AND TAKE GOOD RETURN
USETO0::SKIPGE	DEVSPL(F)	;IF THIS IS A SPOOLED DDB,
	POPJ	P,		; USETO IS A NOOP
	PUSHJ	P,NULTST##
	  POPJ	P,		;NUL WINS
	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,USETO2	;USETO -1 MEANS LAST BLOCK XFERRED
	MOVE	T1,DEVREL##(F)	;IS THERE A LAST BLOCK?
	SOJG	T1,USETO1	;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
USETO1:	MOVE	W,T1		;DO USETO TO THAT BLOCK
USETO2:	MOVE	T1,DEVACC##(F)	;LOC OF A.T
	MOVE	T1,ACCWRT##(T1)	;HIGHEST WRITTEN BLOCK
	CAML	T1,W		;TRY TO SETO PAST HIGHEST.
	JRST	USETO3		;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	USET11		;NO. HAVE TO ALLOCATE
USETO3:	PUSHJ	P,USET00	;YES. SET UP CORRECT POINTERS
	  POPJ	P,		;RIB ERROR
	AOSE	DEVBLK(F)	;IF DEVBLK=-1, CAN'T FIND BLOCK
	JRST	USETO4		;USETO TO ALLOCATED BLOCKS
	PUSHJ	P,GETALC	;SINCE ANOTHER JOB MAY HAVE ALLOCATED,
	CAMG	T1,W		; AND ACCWRT ISN'T YET TO ITS FINAL VALUE,
	JRST	USET11		; WE MUST REPEAT THE TEST (DEVRIB NOW POINTS TO LAST RIB)


;HERE IF DOING A USETO TO LAST BLOCK IN RIB
	PUSHJ	P,USETO5	;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
	MOVSI	T1,DEPLPC##	;LIGHT DEPLPC AGAIN
	IORM	T1,DEVLPC##(F)	;IN DDB
	POPJ	P,		;AND EXIT
USETO4:	SOS	DEVBLK##(F)	;RETURN DEVBLK TO PROPER VALUE
	PUSHJ	P,EXTCKS	;SET IOSFIR IF FIRST BLOCK IN EXTENDED RIB
	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
USETO5:	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
	MOVE	T1,.USMBF	;MAKE SURE WE ZERO MONITOR BUFFER
	SETOM	1(T1)
USETO6:	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....
IFN FTKL10,<
	MOVE	T1,UDBKDB(U)
	MOVE	T1,KDBCHN(T1)
	MOVE	T1,CHNTYP(T1)
	HRR	T1,ACCSTS##(P1)
	TLNE	T1,CP.RH2	;IF THE DEVICE IS NOT ON AN RH20
	TRNE	T1,ACPSMU	; OR IS SIMULTANEOUS ACCESS
	JRST	USETO8		;DON'T TRY TO ZERO MULTIPLE BLOCKS AT ONCE
IFN FTDUAL,<
	SKIPN	T1,UNI2ND(U)	;IF A DUAL-PORTED DISK
	JRST	USETO7
	MOVE	T1,UDBKDB(T1)	; IF THE 2ND PORT IS ON AN RH10
	MOVE	T1,KDBCHN(T1)
	MOVE	T1,CHNTYP(T1)	; DO IT 1 BLOCK AT A TIME
	TLNN	T1,CP.RH2	; BECAUSE THE RH10 WON'T SUPPORT THE HACK
	JRST	USETO8		; WE WANT TO USE  (WRITE 0'S THROUGH MANY BLOCKS)
> ;END IFN FTDUAL
USETO7:	HRRZ	T1,DEVLFT##(F)	;SHOULD BE EASY TO DO MULTIPLE
	MOVE	T2,P2
	ADDI	T2,1		;HIGHEST BLOCK TO ZERO
	SUB	T2,DEVREL##(F)	;MINUS WHERE WE NOW ARE
	CAMLE	T1,T2
	MOVE	T1,T2		;JUST DO THIS MUCH
	CAILE	T1,LIMUSZ##	;MORE BLOCKS THAN THE MAX?
	MOVEI	T1,LIMUSZ##	;YES, USE MAX
	MOVNS	T1
	LSH	T1,^D18+BLKLSH## ;TURN IT INTO AN IOWD WHICH WILL ZERO-FILL
	JRST	USETO9		;LET THE HARDWARE ZERO 15 BLOCKS IN 1 FELL SWOOP...
USETO8:> ;END IFN FTKL10
	MOVE	T1,.USMBF
	SKIPN	1(T1)		;IS MON BUF ZERO? (USTRIB COULD READ)
	JRST	USETO9		;DONT NEED TO DO ANYTHING MORE
	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
				;FALL INTO USETO9
				;DROPS INTO HERE FROM PREVIOUS PAGE
USETO9:	MOVE	T2,DEVBLK##(F)	;BLOCK TO WRITE
	CAMG	W,ACCWRT##(P1)	;SOMEBODY JUST WRITE THE BLOCK?
	JRST	USET10		;YES, WE'RE DONE
	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,MONWRU	;WRITE A BLOCK OF 0'S (DONT GO THROUGH DISK CACHE)
	TRNN	S,IOIMPM+IOBKTL+IODTER+IODERR ;DID AN I/O ERROR OCCUR?
	JRST	USET9A		;NO
IFE FTKL10,<
	POPJ	P,		;NO RETRY IF NO RH20
>; END IFE FTKL10
IFN FTKL10,<
	TRNE	T1,-1		;WAS I/O DONE VIA A CHANNEL SKIP?
	POPJ	P,		;NO, WE'VE ALREADY TRIED RECOVERY, QUIT
	TRZ	S,IOIMPM+IOBKTL+IODTER+IODERR ;CLEAR ERROR BITS FOR RETRY
	JRST	USETO8		;TRY ACTUALLY WRITING THE BLOCKS
>; END IFN FTKL10

USET9A:	LDB	T1,DEYNBB##	;GET NUMBER OF BLOCKS ACTUALLY WRITTEN
	SUBI	T1,1		;FILINT UPDATED THINGS ON THE BASIS OF A 1-BLOCK
	ADDM	T1,DEVBLK##(F)	; TRANSFER, SO UPDATE FOR THE OTHER BLOCKS DONE
	ADDM	T1,DEVREL##(F)
	ADDM	T1,ACCWRT##(P1)
	MOVNS	T1
	ADDM	T1,DEVLFT##(F)
	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
	LDB	J,PJOBN##	;JOB NUMBER
	MOVE	T1,JBTSTS##(J)	;JBTSTS
	TLNN	T1,CNTRLC	;JOB TYPED ^C?
	JRST	USET10		;NO
	PUSH	P,F
	PUSHJ	P,STOP1##	;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 USET10
USET10:	CAMLE	P2,ACCWRT##(P1)	;HAVE WE FINISHED YET?
	JRST	USETO6		;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
	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
IOSFA==:400			;FILE HAS FA RESOURCE
MNTCYL==100000			;ON IF USER WANTS MAINTENANCE CYLS

;HERE ON SUSET. UUO
USUSET::PUSHJ	P,SAVE1##
	MOVE	W,M		;SAVE AC BYTE
	MOVE	M,T1		;SAVE ARGUMENT
	LDB	P1,[POINT 9,M,12]
	PUSHJ	P,VALUUO	;DSK INITED ON THIS CHAN?
	  PJRST	IOIERR##	;"IO TO UNASSIGNED CHAN"
	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO COMPLETE (IOACT TO CLEAR)
	TLO	M,400000	;INDICATE SUSET.
	AOS	(P)		;SET FOR SKIP (GOOD) RETURN
	JRST	SETSU1		;AND DO SUPER USETI/O


SETSUP:	MOVSI	T1,DEPSIO##	;DEVICE OPENED FOR SUPER I/O?
	TDNE	T1,DEVPTB##(F)
	JRST	SETSU0		;YES, BYPASS ILLEGAL INSTRUCTION PATCH
	SKIPE	DISSIO##	;WANT TO DISABLE SUPER USETI/USETOS?
	JRST	ILLINS##	;YES
SETSU0:	TLNE	F,ENTRB+LOOKB	;FILE OPEN?
	JRST	SETIMP##	;YES, GIVE HIM AN ERROR
SETSU1:	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	SETSU3		;YES.
	PUSHJ	P,SRUNI##	;A UNIT NAME?
	  POPJ	P,		;NO - RETURN WITHOUT DOING ANYTHING
	  JFCL
	PUSHJ	P,PRVJB##	;YES. PRIVILEGED?
	  JRST	SETS15		;NO. ILLEGAL
SETSU2:	SKIPL	T1,M		;BLOCK NOT IN M IF SUSET.
	PUSHJ	P,GETWDU##	;UNIT NAME - GET BLOCK NUMBER
	TLZ	T1,777740
	PUSHJ	P,STORU		;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	SETSU7		;AND CONTINUE
SETSU3:	TRZ	S,UDSX		;INDICATE NOT WRITING FORMATS
	PUSHJ	P,PRVJB##	;PRIV'D
	  JRST	SETS11		;NO. ILLEGAL
	JUMPG	M,SETSU4	;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	SETSU5
SETSU4:	PUSHJ	P,GETWDU##	;GET BLOCK NUMBER
SETSU5:	CAME	T1,[-1]		;USETO TO LAST BLOCK XFERRED?
	JRST	SETSU6		;NO
	HRRZ	U,DEVUNI##(F)	;YES, GET RIGHT UNIT
	SOS	T1,DEVBLK##(F)	;GET BLOCK NUMBER
	JRST	SETSU8		;AND CONTINUE
SETSU6:	PUSHJ	P,ADR2UN##	;SET U TO RIGHT UNIT IN STR FOR THIS BLOCK
	  JRST	SETS10		;ILLEGAL BLOCK NUMBER - LIGHT IOBKTL
SETSU7:	CAML	T1,UNIBPU(U)	;HIGHER THAN HIGHEST BLOCK ON UNIT?
	JRST	SETS13		;YES. LIGHT IOBKTL
	JUMPL	T1,SETS10
	TLNE	M,MNTCYL	;WANT MAINT CYL?
	JRST	SETS10		;YES, ERROR (THIS BLOCK NOT IN MAINT CYLS)
	MOVEM	T1,DEVBLK##(F)	;NO, SAVE BLOCK NO IN DDB
SETSU8:	SUB	T1,UNIBPU(U)	;-DISTANCE TO END OF UNIT
SETSU9:	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
ERRFUL:
SETS10:	TRO	S,IOBKTL	;INDICATE TOO HIGH A BLOCK NUMBER
	PJRST	STOIOS##	;SAVE S AND RETURN


SETS11:	JUMPGE	M,SETS10	;GO IF SUPER USETI/O
SETS12:	SOS	(P)		;SUSET, - NON-SKIP RETURN
	MOVE	M,W		;RESTORE AC (PUUOAC)
	PJRST	RTM1##
;HERE IF BLOCK ABOVE HIGHEST BLOCK ON UNIT
SETS13:	MOVSI	T2,DEPCPT##	;COMPATABILITY MODE?
	TDNN	T2,DEVCPT##(F)
	JRST	SETS14		;NO
	CAMLE	T1,UNIBUC(U)	;YES, IS IT A LEGAL BLOCK?
	JRST	SETS10		;NO, LIGHT AN ERROR BIT
	MOVEM	T1,DEVBLK##(F)	;YES, SAVE BLOCK NUMBER
	SUB	T1,UNIBUC(U)	;DISTANCE TO END OF UNIT
	JRST	SETSU9		; AND FINISH UP
SETS14:	CAMG	T1,UNIBPM(U)	;MAINT CYL?
	SKIPL	DEVREL##(F)	;YES, UNIT (NOT STR) INITED?
	JRST	SETS10		;NO - IOBKTL
	TLNN	M,MNTCYL	;WANT MAINT CYL (OR SUPER USET)?
	JRST	SETS10		;NO, ERROR
	MOVEM	T1,DEVBLK##(F)	;YES, SAVE BLOCK
	SUB	T1,UNIBPM(U)	;DISTANCE TO END OF MAINT CYL
	JRST	SETSU9		;FINISH UP
;HERE IF UNPRIU'S SUSET/USET TO A UNIT
SETS15:	JUMPGE	M,SETS10	;ERROR IF SUPER USET
	MOVE	T1,.CPJOB##	;SUSET.
	MOVE	T1,JBTPPN##(T1)	;PPN OF REGISTER
	CAMN	T1,UMDPPN##	;USER-MODE DIAGNOSTICS? [6,6]
	TLNN	M,MNTCYL	;TO MAINT CYL?
	JRST	SETS12		;NO, ERROR
	JRST	SETSU2		;YES, OK
;HERE IF THE REQUESTED BLOCK IS HIGHER THAN THE HIGHEST ALLOCATED
USET11:	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
	SKIPL	DEVBLK##(F)	;FIND THE BLOCK?
	JRST	USET12		;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
USET12:	MOVE	T2,P1		;TOP BLOCK TO ALLOCATE
	MOVE	T1,P2		;FIRST BLOCK TO ALLOCATE
	SUB	T2,T1		;TOTAL NUMBER TO ALLOCATE
	ADDI	T2,1
	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
	MOVEM	P1,DEVREL##(F)	;SAVE REQUESTED BLOCK IN DDB
	MOVEM	T2,P2		;NUMBER TO GET
	POP	P,T1		;NUMBER REQUESTED
	SUBM	T2,T1		;MINUS NUMBER ALLOWED
	ADDM	T1,DEVREL##(F)	;ADJUST REQUESTED BLOCK BY NO. OBTAINED
	MOVE	T1,DEVACC##(F)
	MOVE	T1,ACCSMU##(T1)	;SIM UPDATE FILE?
	TRNN	T1,ACPSMU
	JRST	USET13		;NO, CONTINUE
	PUSHJ	P,GTMB2		;YES, GET MON BUF NOW TO AVOID DEADLY EMBRACE
	PUSHJ	P,UPFA		;GET FA TO PROTECT RIB
	PUSHJ	P,GETALC	;GET CURRENT NO OF BLOCKS ALLOCATED
	AOS	W		;HAS IT CHANGED (ANOTHER USETO ALLOCATING)
	CAMN	T1,W
	SOJA	W,USET13	;NO, WE'RE OK
	MOVE	W,P1		;YES, EXTRICATE OURSELVES
	POP	P,(P)
	POP	P,P2
	POP	P,P1		;MAKE STACK RIGHT
	PUSHJ	P,DWNFA		;GIVE UP RESOURCES
	JRST	USETO2		;AND TRY AGAIN
USET13:	MOVE	P1,P2		;RESTORE NUMBER TO GET
	MOVE	T2,P2		;HERE ALSO FOR CHKADD
	PUSHJ	P,CHKADD	;CAN WE ADD TO CURRENT POINTER?
	JUMPLE	T2,USET15	;NO. GET SPACE ANYWHERE
	AOSE	T1,DEVBLK##(F)	;YES SET T1= 1ST BLOCK
	PUSHJ	P,TAKBLK	;GET BLOCKS AT PREVIOUS END
	  JRST	USET15		;CANT GET ANY THERE
	PUSHJ	P,ADDPTR	;GOT SOME - ADD TO CURRENT POINTER
USET14:	SUB	P1,T1		;DECREMENT AMOUNT TO GET
	JUMPLE	P1,USET21	;FINISH UP IF GOT ENOUGH
;HERE TO GET BLOCKS ANYWHERE
USET15:	MOVSI	T3,1		;DECREMENT TOTAL NO. OF POINTERS
	ADDB	T3,DEVRSU##(F)	;TOO MANY?
	JUMPGE	T3,USET17	;YES, TRY TO GET AN EXTENDED RIB
	SETZ	T3,
	AOS	T1,DEVRET##(F)	;POINT DEVRET TO 1ST EMPTY POINTER LOC
	CAILE	T1,DEVRBN##(F)	;FILLED THE DDB?
	PUSHJ	P,WRTPTR	;YES. WRITE THE POINTERS
	JUMPN	T3,USET18	;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	USET16		;GOT THEM
	HLRE	T1,DEVRSU##(F)	;IF 1 SLOT LEFT,
	AOJGE	T1,USET20	;CANT EXTEND RIB,
	PUSHJ	P,NEXTUN	;STEP TO ANOTHER UNIT IN STR
	  JRST	USET20		;ALL UNITS FULL - SETTLE FOR WHAT WE GOT SO FAR
USET16:	PUSHJ	P,PTSTO		;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	USET14		;GET MORE BLOCKS IF NEEDED
USET17:	MOVSI	T3,-1
	ADDM	T3,DEVRSU##(F)
	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
	  JRST	[PUSHJ	P,USET19
		 PJRST	DWNIFA]	;GIVE UP FA RESOURCE IF OWNED
	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
	  PJRST	DWNIFA		;RETURN FA IF OWNED
	JUMPLE	P1,USET21	;FINISH UP IF GOT ENOUGH
	JRST	USET15		;NOT ENOUGH, GO GET MORE
USET18:	PUSHJ	P,DWNIFA	;RETURN FA IF OWNED
USET19:	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
USET20:	PUSHJ	P,USET19	;LIGHT AN ERROR BIT, ADJUST DEV REL
	SOS	DEVRET##(F)	;ADJUST DEVRET
	MOVSI	T1,-1
	ADDM	T1,DEVRSU##(F)	; AND DEVRSU (INCR'D AT USET15)


;HERE WHEN ALL BLOCKS HAVE BEEN ALLOCATED
USET21:	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,CHEKU		;UNIT OK?
	  JRST	USET19		;REMOVED-ERROR
	PUSHJ	P,WRTPTR	;WRITE OUT RET POINTERS LEFT IN DDB
	JUMPN	T3,USET18	;RETURN WITH IOBKTL IF RIB ERR
	PUSHJ	P,DWNIFA	;RETURN FA IF WE OWN IT
	PUSH	P,DEVRSU##(F)	;SAVE DEVRSU (USETO4 MAY CHANGE IT)
	PUSHJ	P,USETO3	;ZERO ALLOCATED, UNWRITTEN BLOCKS
	POP	P,DEVRSU##(F)	;RESTORE DEVRSU
	HRRZ	T1,DEVRET##(F)	;WERE EXTRA (OVERHEAD) BLOCKS ALLOCATED?
	MOVSI	T2,-1
USET22:	CAIGE	T1,DEVRBN##(F)
	SKIPN	1(T1)
	PJRST	STRIOS
	ADDM	T2,DEVRSU##(F)	;YES, ACCOUNT FOR THEM IN DEVRSU
	AOJA	T1,USET22

;SUBROUTINE TO GIVE UP THE FA RESOURCE IF WE OWN IT
;ALWAYS RETURN CPOPJ - RESPECTS ALL AC'S

DWNIFA::TRNE	S,IOSFA		;HAVE FA?
	PJRST	DWNFA		;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
	PUSHJ	P,PTSTO		;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
	TLNN	S,IOSDA		;YES, DO WE HAVE THE DA?
	JRST	NEXTU2		;NO, CARRY ON
	HRRZ	U,DEVUNI##(F)	;YES, GIVE IT UP FOR OLD UNIT
	PUSHJ	P,DWNDA
	MOVE	U,T1		;AND GET IT AGAIN FOR NEW UNIT
	PUSHJ	P,UPDA
NEXTU2:	MOVE	U,T1		;SET UP U
	PUSHJ	P,STORU		;AND DEVUNI
	LDB	T2,UNYLUN##	;GET LOGICAL UNIT NUMBER
	TRO	T2,RIPNUB##	;MAKE SURE NON-0
	PUSHJ	P,PTSTO		;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:	PUSHJ	P,SETU		;SET UP U FROM DDB
	  POPJ	P,		;UNIT WAS REMOVED
	HRRZ	U,DEVFUN##(F)	;UNIT FOR 1ST POINTER IN DDB
	PUSHJ	P,STORU		;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)
	CAIA			;NO, CONTINUE
	JRST	CPOPJ1##	;YES, DON'T CHANGE DEVRET OR DEVRSU
	HRRM	T1,DEVRET##(F)	;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


;SUBROUTINE TO TURN ON IOSFIR FOR FIRST BLOCK IN EXTENDED RIB
EXTCKS:	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
	MOVE	T1,DEVUNI##(F)	;NEWUX WIPES RH (DEVUNI)
	LDB	T2,DEYRBU##	;UNIT OF RIB
IFN FTMP,<
	MOVE	T3,DEVCPU##(F)
>
	PUSHJ	P,NEWUX
	  JFCL
IFN FTMP,<
	MOVEM	T3,DEVCPU##(F)
>
	EXCH	T1,DEVUNI##(F)	;RESET DEVUNI GET RIB UNIT
	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,CHEKU		;UNIT OK
	  JRST	ERRFUL		;REMOVED-ERROR
	PUSHJ	P,PTRTST	;READ POINTERS, REWRITE RIB IF POINTERS HAVE CHANGED
	  POPJ	P,		;ERROR READING RIB
	PUSHJ	P,SAVE1##
	SETO	P1,
USTRB1:	LDB	T2,DEYRBU##	;GET UNIT OF CURRENT RIB
	PUSHJ	P,NEWUX		;SET U
	  STOPCD	CPOPJ,DEBUG,NSU,	;++NO SUCH UNIT
	MOVE	T2,.USMBF	;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
	CAML	T2,T3		;BLOCK BELOW FLOOR OF CURRENT RIB?
	JUMPN	T2,USTRB2	;JUMP IF PRIME RIB
	PUSHJ	P,SCNPT0	;SCAN THE CURRENT RIB
	  JRST	USTRB3		;NOT HERE, LOOK IN NEXT RIB
	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
	POPJ	P,		;RETURN MONITOR BUFFER AND EXIT

;HERE WHEN WE MUST START LOOKING AT THE PRIME RIB
USTRB2:	AOJN	P1,CPOPJ##
	PUSHJ	P,REDRIB	;READ THE PRIME RIB
	  POPJ	P,		;ERROR READING THE RIB
	PUSHJ	P,SPTRW		;SET UP AOBJN WORD FOR THE RIB
	JRST	USTRB4		;SET UP TO SCAN THE PRIME RIB
;HERE TO GET THE NEXT RIB IN THE CHAIN
USTRB3:	PUSHJ	P,PTRNXT	;GET THE NEXT RIB IN THE CHAIN
				;IF MULTIPLE RIBS
	  JRST	USTRB5		;EITHER ERROR OR COULDN'T FIND THE BLOCK
USTRB4:	MOVE	T3,W		;BLOCK NUMBER TO GET
	JRST	USTRB1		;SCAN THE RIB

;HERE ON NON-SKIP RETURN FROM PTRNXT, EITHER RIB ERROR OR NO NEXT RIB
USTRB5:	PJUMPN	T3,CPOPJ##	;RETURN CPOPJ IF RIB ERROR
	SETOM	DEVBLK##(F)	;SET DEVBLK TO -1 AS A FLAG
	HLLZS	DEVLFT##(F)	; CLEAR BLOCK COUNT
	PUSHJ	P,DDBZRO##	;ZERO DDB PNTR SPACE SINCE DEYRLC IS WRONG
	JRST	CPOPJ1##	;TAKE A SEMI-GOOD RETURN
;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:	HRRZ	T1,DEVACC##(F)
	JUMPE	T1,PTRTS0
	MOVE	T1,ACCSTS##(T1)	;SIM UPDATE FILE?
	TRNE	T1,ACPSMU
	PUSHJ	P,UPFA		;GET FA TO PREVENT RACE IF WE WRITE RIB
PTRTS0:	PUSHJ	P,PTRCUR	;READ THE POINTERS INTO CORE
	JUMPN	T3,DWNIFA	;JUMP IF RIB ERROR
	HLRZ	T3,DEVEXT(F)	;EXTENSION
	PUSH	P,T1
	PUSHJ	P,JDAADR##
	MOVE	T4,(T1)		;WAS AN ENTER DONE ON THIS CHAN?
	POP	P,T1
	TLNE	T4,ENTRB+OUTPB	; (IF NOT THIS DDB DIDN'T CHANGE THE PNTRS)
	CAIN	T3,(SIXBIT /UFD/)	;"UFD"?
	JRST	USTR10		;YES, PNTRS IN THE RIB ARE RIGHT

;HERE WHEN THERE ARE PNTRS IN THE DDB WHICH MAY NOT BE IN THE RIB - CHECK THEM
	HRRZ	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
	HRRZ	T3,DEVCPY##(F)
	SKIPE	T3		;IF THERE IS AN IN-CORE COPY
	MOVEI	T2,PTRDAT##(T3)	; USE IT (CHECKSUMS MAY BE NEWER)
	HRLI	T2,MPTRLN##	;MAKE T2 AN AOBJN WORD
USTRB6:	SKIPN	T3,(T2)		;GET A PNTR FROM DDB
	JRST	USTRB9		;ALL DONE
	CAMN	T3,(T1)		;SAME AS PNTR IN RIB?
	JRST	USTRB8		;YES
	EXCH	T3,(T1)		;NO. SAVE PNTR IN MON BUF
	JUMPE	T3,USTRB7	;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
USTRB7:	TLZ	T1,-1		;ZERO LH(T1) - WAS MRIBLN
USTRB8:	AOBJP	T2,USTRB9	;SKIP IF ALL DDB PNTRS LOOKED AT
	AOJA	T1,USTRB6	;LOOK AT NEXT POINTER

;HERE WHEN ALL POINTERS HAVE BEEN COMPARED, CHANGED PNTRS STORED IN MON BUF
USTRB9: MOVE	T4,DEVRRC##(F)	;DID ACCWRT ETC CHANGE?
	TLNN	T4,DEPRHC##	;IF SO, ALWAYS REWRITE RIB
	SKIPL	T1		;T1 NEG IF ALL PNTRS COMPARED
	PUSHJ	P,WRTRIB	;WRITE THE MON BUF AS 1ST RIB
USTR10:	PUSHJ	P,DWNIFA	;RETURN FA 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
	HRRZ	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,SCNPT3	;REAL POINTER IF NON-0
	SKIPN	T2,(T1)		;UNIT CHANGE OR END OF POINTERS
	PJRST	TPOPJ##		;END OF POINTERS. ERROR RETURN
	TRZE	T2,RIPNUB##	;REMOVE BIT 18 (REST IS A LOGICAL UNIT NUMBER)
	PUSHJ	P,NEWUNI	;SET UP U, DEVUNI(F)
	  SKIPA	U,DEVUNI##(F)	;INVALID UNIT -NOT FOUND RETURN
SCNPT2:	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
SCNPT3:	ADD	P2,T2		;PLUS LENGTH OF GROUP
	CAML	T3,P2		;IS DESIRED CLUSTER IN THIS POINTER?
	JRST	SCNPT2		;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
	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	SCNPT4		;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	SCNPT7		;NO, PROCEED
	HRRZ	T2,T1		;GET ADDRESS PORTION OF POINTER
	CAIE	T2,DEVRBN##(F)	;SKIP IF THIS IS THE LAST SLOT
	SKIPE	1(T1)		;IS NEXT SLOT EMPTY?
	JRST	SCNPT4		;NO, CHECK TO SEE IF THIS IS LAST SLOT
	HRRZ	T2,DEVLFT##(F)	;IS LAST, MAKE LAST BLOCK UNAVAILABLE
	SOJE	T2,SCNPT9	;JUMP IF NO BLOCKS AVAILABLE
	JRST	SCNPT6		;STORE THE NEW VALUE OF DEVLFT
SCNPT4:	HRRZ	T2,DEVLFT##(F)	;RETURN DEVLFT TO T4
	AOBJN	T1,SCNPT5	;ABOUT TO RUN OUT OF POINTERS?
	SOJE	T2,SCNPT8	;YES, MAKE LAST BLOCK UNAVAILABLE
SCNPT5:	SUB	T1,[XWD 1,1]	;RESTORE AOBJN WORD
SCNPT6:	HRRM	T2,DEVLFT##(F)	;STORE IN DDB
SCNPT7:	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)
	HRRZ	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
SCNPT8:	MOVSI	T1,DEPLPC##	;TELL CALLER WHY HE LOST
	IORM	T1,DEVLPC##(F)
SCNPT9:	HLLZS	DEVLFT##(F)	;NOTHING LEFT IN THIS POINTER
	POPJ	P,




;SUBROUTINE TO READ A RIB BLOCK, AND STORE THE POINTERS IN THE DDB
RDPTRS::PUSHJ	P,PTRGET	;READ THE RIB BLOCK INTO A MON BUF
	PJRST	PTRCPY		;COPY CURRENT POINTERS FROM MON BUF TO DDB


;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
	POPJ	P,		;AND RETURN

;SUBROUTINE TO GET THE CURRENT POINTERS INTO CORE
;RETURNS T3=0 IF OK, NON-0 IF RIB ERROR
PTRCUR::PUSHJ	P,GTMNBF	;GET MON BUF IF DON'T YET HAVE IT
	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
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 WRITERS ASSOCIATED WITH A FILE
;CALL FNDDDB THE FIRST TIME, TO FIND OTHER WRITERS CALL FNDDDN WITH
; T2 AS RETURNED FROM THE FIRST CALL
;CALL WITH T1= L(AT)
;RETURNS CPOPJ IF NO MORE (OR NONE) WRITERS
;RETURNS CPOPJ1 NORMALLY, WITH T2=ADR OF IN-CORE COPY OF NEXT WRITER
FNDDDB:	MOVEI	T2,SYSPTR##-PTRSYS## ;INITIALIZE PREDECESSOR
FNDDDN:	HRRZ	T4,DEVCPY##(F)	;DONT FIND OUR OWN COPY
FNDDD1:	HLRZ	T2,PTRSYS##(T2)	;STEP TO NEXT IN-CORE COPY
	JUMPE	T2,CPOPJ##	;DONE OF 0
	HRRZ	T3,PTRAT##(T2)	;A.T IT POINTS AT
	CAIE	T4,(T2)		;IGNORE IT IF IT IS OURS

	CAIE	T3,(T1)		;POINTING AT OUR AT?
	JRST	FNDDD1		;NO, TRY NEXT
	JRST	CPOPJ1##	;FOUND, RETURN WITH ADDR IN T2
;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
	TRNN	T2,ACPUPD	;UPDATE?
	JRST	FIXDDB		;NO, 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,PTRDAT##(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,PTRRLC##(T2)
	TRNE	T3,PTPLPC##
	TLOA	T1,DEPLPC##
	TLZ	T1,DEPLPC##
	MOVEM	T1,DEVLPC##(F)
	HRLM	T3,DEVFUN##(F)
	DPB	T3,DEYRLC##
	LDB	T3,PTYRSU##
	MOVNS	T3
	HRLM	T3,DEVRSU##(F)
	MOVEI	T3,DEVRB1##(F)
	HRRM	T3,DEVRET##(F)
	MOVE	T1,PTRFLR##(T2)
	MOVEM	T1,DEVFLR##(F)
	MOVE	T1,PTRRIB##(T2)
	MOVEM	T1,DEVRIB##(F)
	PUSHJ	P,CPYPTR


;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,.USMBF	;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
	PUSHJ	P,STORU		;AND SAVE IN DDB
	JUMPN	T3,DDBZR##	;CLEAR OUT RETRIEVAL POINTERS IF READ ERROR
	POPJ	P,		;AND RETURN

;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
;RETURNS UNIT OF RIB IN T2
PTRNXT::SETZ	T3,		;T3=0 INDICATES NO RIB ERROR
	MOVE	T2,.USMBF	;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
	SUBTTL	MISCELLANEOUS FUNCTIONS

;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,UDBKDB(U)	;KONTROLLER DATA BLOCK
	SKIPGE	KONUNL(J)	;DOES DEVICE UNLOAD?
	PJRST	ECOD3##		;NO, ERROR 3
	SKIPGE	UNIDS2(U)	;NON-REMOVABLE MEDIUM?
	JRST	CPOPJ1##	;YES, UNLOAD WON'T DO ANYTHING
IFN FTMP,<
	MOVE	T1,UDBCAM(U)	;CPU(S) UNIT IS ON
	PUSHJ	P,CPUOK##	;FIND A LIVE CPU
	  JRST	CPOPJ1##	;ALL DEAD
	PUSHJ	P,ONCPUS##
	  PJRST	CPOPJ1##	;CPU NOT RUNNING
>
	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
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,UDBKDB(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
	CAIE	F,DSKDDB##	;DON'T WIPE OUT PROTOTYPE
	XCT	P1		;SET/CLEAR BIT IN DDB
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

	SUBTTL	DIAG UUO INTERFACE


DSKDIA::EXP	DSKPPR			;PREPROCESSOR ROUTINE
	DIAFNC	(CTC,DIACTC,CPOPJ##)	;MONITOR ENTRY ON ^C
	DIAFNC	(ASU,DIAASU,CPOPJ##)	;ASSIGN SINGLE UNIT
	DIAFNC	(AAU,DIAALL,CPOPJ##)	;ASSIGN ALL UNITS
	DIAFNC	(RAU,DIARAU,CPOPJ##)	;RELEASE CHAN AND ALL UNITS
	DIAFNC	(SCP,DIASCP,CPOPJ##)	;SPECIFY CHANNEL PROGRAM
	DIAFNC	(RCP,DIARCP,CPOPJ##)	;RELEASE CHAN PROGRAM
	DIAFNC	(GCS,DIACST,CPOPJ##)	;GET CHAN STATUS
	DIAFNC	(AKU,DIAAKU,DIAAKU)	;GET KONTROLLER AND UNIT
	DIAFNC	(SCR,DIASCR,CPOPJ##)	;SPECIFY CHAN PROGRAM FOR REVERSE
	DIAFNC	(ELD,DIAELD,DIAELD)	;ENABLE MICROCODE LOADING
	DIAFNC	(DLD,DIADLD,DIADLD)	;DISABLE MICROCODE LOADING
	DIAFNC	(LOD,DIALOD,DIALOD)	;LOAD MICROCODE
	DIAFNC	(SDS,DIASDS,DIASDS)	;SET DEVICE STATUS
	DIAFNC				;TERMINATE TABLE


;PREPROCESSOR ROUTINE
DSKPPR:
IFN FTXMON,<PUSHJ P,SSEC0##>	;ENTER SECTION ZERO
	JRST	(P3)		;GO HANDLE DIAG FUNCTION
; ENABLE/DISABLE MICROCODE LOADING
DIADLD:	TDZA	T1,T1		;DISABLE
DIAELD:	MOVEI	T1,1		;ENABLE
	PUSHJ	P,SAVJW##	;SAVE J & W
	MOVE	J,W		;BRAIN DAMAGED FILSER LIKES IT HERE
	PUSHJ	P,@KONEDL(J)	;DISPATCH
	  JRST	DIAANM##	;MICROCODE NOT AVAILABLE
	JRST	CPOPJ1##	;RETURN


; LOAD MICROCODE
DIALOD:	PUSHJ	P,SAVJW##	;SAVE J AND W
	MOVE	J,W		;BRAIN DAMAGED FILSER LIKES IT HERE
	PUSHJ	P,@KONRLD(J)	;LOAD MICROCODE
	  JRST	DIAARF##	;COULDN'T
	JRST	CPOPJ1##
;SET DEVICE STATUS
DIASDS:
IFN FTMP,<
	MOVE	T1,KDBCAM(W)	;FETCH CPU MASK
	PUSHJ	P,CPUOK##	;FIND A RUNNING CPU
	  JRST	DIAANR##	;CPU NOT RUNNING
	PUSHJ	P,ONCPUS##	;TRY TO GET THERE
	  JRST	DIAANR##	;CPU NOT RUNNING
> ;END IFN FTMP
	PUSHJ	P,GETWD1##	;GET NEXT ARGUMNET
	CAIL	T1,0		;RANGE
	CAILE	T1,SDSLEN	; CHECK
	JRST	DIAABA##	;BAD ARGUMENT LIST
	PUSHJ	P,SAVE3##	;SAVE SOME ACS
	MOVE	P2,T1		;SAVE SUB-FUNCTION CODE
	SETZB	P1,P3		;ASSUME DOING ONLY ONE UNIT
	JUMPGE	U,DIASD1	;ROMP THROUGH LOOP ONLY ONCE
	MOVNI	P3,1		;REMEMBER DOING THE WHOLE KONTROLLER
	PUSHJ	P,@SDSTAB(P2)	;DO KONT STUFF BEFORE LOOPING THROUGH DRIVES
	  POPJ	P,		;PROPAGATE ERROR BACK
	MOVE	T1,KDBDSP(W)	;POINT TO DRIVER DISPATCH
	LDB	P1,[POINTR (DRVCF2(T1),DR.HDN)] ;GET HIGHEST DRIVE ON KONT
	SETZ	U,		;START WITH FIRST DRIVE

DIASD1:	MOVE	T1,KDBIUN(W)	;DRIVE TABLE
DIASD2:	SKIPN	T2,(T1)		;GET A UDB
	JRST	DIASD3		;NONE THERE
	CAMN	U,UDBPDN(T2)	;FOUND THE UDB?
	JRST	DIASD4		;YES
DIASD3:	CAMGE	T1,KDBFUN(W)	;END OF TABLE?
	AOJA	T1,DIASD2	;KEEP SEARCHING
	HRROS	U		;FLAG A NON-EXISTANT DRIVE

DIASD4:	PUSHJ	P,@SDSTAB(P2)	;DISPATCH
	  POPJ	P,		;PROPAGATE ERROR BACK
	HRRZS	U		;INCASE LAST DRIVE DIDN'T EXIST
	AOS	U		;ADVANCE TO NEXT
	SOJGE	P1,DIASD1	;LOOP FOR ANOTHER
	JRST	CPOPJ1##	;RETURN


SDSTAB:	IFIW	SDSIGN		;SET IGNORE
	IFIW	SDSCLR		;CLEAR IGNORE
	IFIW	SDSDET		;SET DETACHE
	IFIW	SDSATT		;SET ATTACHED
SDSLEN==.-SDSTAB		;LENGTH OF TABLE
;SET IGNORE
SDSIGN:	CAMN	U,[EXP -1]	;KONTROLLER?
	JRST	CPOPJ1##	;MEANINGLESS
	JUMPGE	U,CPOPJ1##	;CAN'T IGNORE AN KNOWN DRIVE
	MOVE	T1,U		;COPY PHYSICAL DRIVE NUMBER
	MOVE	T2,[1,,KDBIUM]	;STATE,,MASK WORD OFFSET
	PUSHJ	P,AUTMSK##	;SET DRIVE IGNORED
	  JRST	DIAAIU##	;ILLEGAL UNIT
	JRST	CPOPJ1##	;RETURN


;CLEAR IGNORE
SDSCLR:	CAMN	U,[EXP -1]	;KONTROLLER?
	JRST	CPOPJ1##	;MEANINGLESS
	HRRZ	T1,U		;GET DRIVE NUMBER
	MOVEI	T2,KDBIUM	;STATE,,MASK WORD OFFSET
	PUSHJ	P,AUTMSK##	;CLEAR DRIVE IGNORED
	  JRST	DIAAIU##	;ILLEGAL UNIT
	JRST	CPOPJ1##	;RETURN


;SET DETACHED
SDSDET:	CAMN	U,[EXP -1]	;DETACH KONTROLLER?
	JRST	CPOPJ1##	;DO NOTHING (WILL GET CALLED PER DRIVE)
	JUMPL	U,CPOPJ1##	;CANNOT DETACH AN UNKNOWN DRIVE
	MOVE	T1,KDBIUN(W)	;DRIVE TABLE
SDSDE1:	MOVE	T2,(T1)		;GET A UDB
	CAMN	U,UDBPDN(T2)	;FOUND THE UDB?
	JRST	SDSDE2		;YES
	CAMGE	T1,KDBFUN(W)	;END OF TABLE?
	AOJA	T1,SDSDE1	;KEEP SEARCHING
	JRST	CPOPJ1##	;NOT THERE???
SDSDE2:	PUSH	P,U		;SAVE U
	MOVE	U,T2		;COPY UDB ADDRESS
	PUSHJ	P,DETCPD	;DETACH DRIVE
	  JFCL			;NOT A DISK?
	  JRST	[POP  P,U	;CLEAN STACK
		 JRST DIAADF##]	;ATTACH/DETACH FAILED
	MOVE	U,UDBPDN(U)	;GET DRIVE NUMBER
	PUSHJ	P,SDSCLR	;MAKE SURE IGNORE IS CLEARED
	  JFCL			;ALWAYS SKIPS
	JRST	UPOPJ1##	;RESTORE U AND RETURN


;SET ATTACHED
SDSATT:	CAMN	U,[EXP -1]	;ATTACH KONTROLLER?
	JRST	CPOPJ1##	;DO NOTHING (WILL GET CALLED PER DRIVE)
	MOVE	T1,KDBIUN(W)	;DRIVE TABLE
SDSAT1:	MOVE	T2,(T1)		;GET A UDB
	CAMN	U,UDBPDN(T2)	;FOUND THE UDB?
	JRST	SDSAT2		;YES
	CAMGE	T1,KDBFUN(W)	;END OF TABLE?
	AOJA	T1,SDSAT1	;KEEP SEARCHING
	JRST	CPOPJ1##	;NOT THERE???
SDSAT2:	PUSH	P,U		;SAVE U
	MOVE	U,T2		;COPY UDB ADDRESS
	PUSHJ	P,ATTCPD	;ATTACH IT
	  JFCL			;UNIT DOWN
	  CAIA			;CAN'T CALL CPY ROUTINE CUZ NOT AT UUO LEVEL
	JRST	SDSAT3		;CONTINUE IF SUCCESSFUL
	POP	P,U		;RESTORE U
	SKIPGE	U		;SKIP IF DRIVE EXISTS BUT ATTACH FAILED
	JUMPL	P3,CPOPJ1##	;RETURN IF NON-EXISTANT DRIVE & ATTACHING KONT
	JRST	DIAAAF##	;ELSE TAKE ERROR RETURN
SDSAT3:	PUSHJ	P,SDSCLR	;MAKE SURE IGNORE CLEARED
	  JFCL			;ALWAYS SKIPS
	JRST	UPOPJ1##	;RESTORE U AND RETURN
IFN FTKL10,<
;HERE TO ASSIGN SOME UNIT
DIAASU:	PUSHJ	P,FNDPDS##	;SET UP PDB
	JUMPN	F,DIAAAA##	;ALREADY HAVE SOME UNITS ASS'D
	HLRZ	T1,UNIDIA(U)	;JOB WHICH OWNS THIS UNIT
	CAME	T1,.CPJOB##	;SOME OTHER JOB HAVE IT?
	JUMPN	T1,DIAAAJ##	;UNIT ASS'D TO ANOTHER JOB
	JUMPN	T1,DIAHVF	;HAVE A DDB SET IF F NON-0
	PUSHJ	P,FAKDDB##	;GET A DDB
	  JRST	DIAAFC##	;NOT ENOUGH "FREE" CORE
	HRL	F,.CPJOB##	;SET UNIDIA=JOB,,DDB
	MOVEM	F,UNIDIA(U)
	JRST	DIAHVF		;AND CONTINUE

;HERE TO ASSIGN ALL UNITS ON A CHANNEL
DIAALL:	PUSHJ	P,FNDPDS##	;SET UP PDB
	JUMPN	F,DIAAAA##	;ALREADY HAVE SOME UNITS ASS'D
	HRRZ	T1,U		;SAVE STARTING-POINT
DIAAL1:	HLRZ	T2,UNIDIA(T1)	;UNIT IN DIAG FOR SOME OTHER JOB?
	CAME	T2,.CPJOB##
	JUMPN	T2,DIAAAJ##	;UNIT ASS'D TO ANOTHER JOB
	SKIPE	T2		;HAVE A DDB SET UP ALREADY?
	HRRZ	F,UNIDIA(T1)	;YES, SAVE IT
	MOVE	T1,UNICHN(T1)	;STEP TO NEXT UNIT ON CHAN
	CAIE	T1,(U)		;BACK WHERE WE STARTED?
	JRST	DIAAL1		;NO, TEST IT
	JUMPN	F,DIAAL2	;GO IF WE HAVE A DDB
	PUSHJ	P,FAKDDB##	;NONE, GET ONE
	  JRST	DIAAFC##	;NOT ENOUGH CORE
DIAAL2:	HRL	F,.CPJOB##	;SET JOB,,DDB IN EVERY UNIT
	HRRZ	T1,U		; ON THE CHANNEL
DIAAL3:	SKIPN	UNIDIA(T1)
	MOVEM	F,UNIDIA(T1)	;(IF NONE THERE ALREADY)
	MOVE	T1,UNICHN(T1)
	CAIE	T1,(U)
	JRST	DIAAL3

DIAHVF:	HRRZ	F,UNIDIA(U)	;MAKE SURE F IS RIGHT
	PUSHJ	P,STOAU		;SAVE U IN DDB
	MOVEM	F,.PDDIA##(W)	;SAVE DDB IN PDB
	MOVE	J,.CPJOB##	;STOAU SMASHES J
DIAHV1:	SKIPE	DIADWT##	;ANOTHER JOB WAITING FOR DIAG?
	JRST	DIAHV2		;YES, CAUSE THIS JOB TO BLOCK
	SKIPN	T1,DIADSK##	;NO, SOME OTHER JOB IN DIAG ALREADY?
	JRST	DIASCH		;NO
DIAHV2:	SKIPN	DIADSK##	;IF WE'RE HERE BECAUSE ANOTHER JOB IS WAITING
	AOSE	DIADWT##	; TOGGLE WAIT FLAG SO NEXT CALL TO DIAHVF WILL WIN
	SETOM	DIADWT##	;INDICATE THAT WE'RE WAITING
	MOVEI	T1,0		;SLEEP FOR A WHILE
	PUSHJ	P,SLEEPF##	;AND THEN TRY AGAIN
	JRST	DIAHV1
;STILL IN FTDHIA CONDITIONAL
DIASCH:	HRRZM	F,DIADSK##	;INDICATE WE WANT TO STOP IO
	MOVE	J,.CPJOB##
	HRLM	J,DIADSK##	;SAVE JOB NO
	MOVEI	T1,6		;IF THINGS DON'T START UP IN 30 SECONDS
	DPB	T1,PDVTIM##	; WE ARE IN TROUBLE, SO CALL HNGDSK
	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
	MOVE	T2,UDBKDB(U)	;SAY WHAT CHANNEL WE WANT TO STOP IO ON
	MOVE	T2,KDBCHN(T2)
	MOVEM	T2,DIACHN##
	DSKOFF
	PUSHJ	P,WINDWN	;ANY IO GOING?
	  JRST	[DSKON		;YES, WAIT FOR IT TO STOP
		 PUSHJ	P,WAIT1##
		 DSKOFF
		 JRST	.+1]

;HERE WHEN ALL IO IS STOPPED ON THE DESIRED CHANNEL.
	HRROS	DIADSK##	;INDICATE WE'RE IN MIDDLE OF TEST
	SETZM	@DIACHN##	;CHAN IS BUSY
	PUSHJ	P,DIAKDB	;SET ALL KDBS BUSY
	  IORM 	T1,KONBSY(T3) ;INSTR TO EXECUTE
	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
	MOVEM	T1,UNITIM(U)	;SET TIME IN UDB
	MOVEM	J,UNIJOB(U)
	MOVSI	T1,TCOD
	HLRZM	T1,UNISTS(U)	;SET UNIT ACTIVE SO HUNG LOGIVC WILL CHECK
	DPB	T1,PDVTIM##
	PUSHJ	P,SETACT##	;MAKE SURE IOACT IS ON
	DSKON
	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
;SUBROUTINE TO SET/CLEAR THE BUSY BIT IN ALL KDBS ASSOCIATED WITH A UNIT
;CALL	PUSHJ	P,DIAKDB
;	ANDCAM	T1,KONBSY(T3)	(OR IORM T1,....)
DIAKDB:	MOVSI	T1,KOPBSY	;BUSY BIT
	HRRZ	T2,U		;WHERE TO START
DIAKD1:	MOVE	T3,UDBKDB(T2)	;POINT AT KDB
	XCT	@(P)		;SET/CLEAR THE BIT
	MOVE	T2,UNICHN(T2)	;STEP TO NEXT UDB
	CAIE	T2,(U)		;BACK WHERE WE STARTED?
	JRST	DIAKD1		;NO, DO THIS ONE TOO
IFN FTDUAL,<
	SKIPN	T3,UNI2ND(U)	;DUAL-PORTED?
	JRST	CPOPJ1		;NO. DONE
	MOVE	T3,UDBKDB(T3)	;YES, POINT TO KDB
	XCT	@(P)		;SET/CLEAR
> ;END IFN FTDUAL
	JRST	CPOPJ1		;AND RETURN

;STILL IN FTDHIA CONDITIONAL
;HERE ON ^C, EXIT, HALT, ...
DIACTC:	PUSHJ	P,FNDPDS##	;SET UP PDB
	MOVE	U,DEVUNI##(F)	;SET UP U
	MOVE	P3,UDBKDB(U)	; AND P3
	TLOA	F,-1		;INDICATE FROM DIACTC
				;FALL INTO DIARAU
;HERE TO RELEASE ALL UNITS
DIARAU:	JUMPE	F,CPOPJ1##	;EXIT IF NO DIAG SET UP
	PUSHJ	P,DIARCX	;GIVE UP IOWD BLOCK IF ONE EXISTS
	PUSHJ	P,FNDPDS##	;SET UP PDB
	PUSH	P,U		;SAVE U
DIARA1:	HRRZ	T1,UNIDIA(U)	;DDB WHICH HAS UNIT
	CAME	T1,.PDDIA##(W)	;OURS?
	JRST	DIARA2		;NO
	SETOM	UNICYL(U)	;YES, SET SO WE'LL SEEK ON IT
	SETZM	UNIDIA(U)	;NOW NO DIAG FOR IT
	SETZM	UNISTS(U)	;UNIT IS AGAIN IDLE
DIARA2:	HRR	U,UNICHN(U)	;STEP TO NEXT UNIT
	CAME	U,(P)		;BACK WHERE WE STARTED?
	JRST	DIARA1		;NO, TEST IT
	PUSHJ	P,DIAKDB	;SET ALL KDBS IDLE
	  ANDCAM T1,KONBSY(T3) ;INSTR TO EXECUTE
	SETZM	.PDDIA##(W)	;DONT HAVE A DIAG GOING
	SETZM	DIADSK##
	SETOM	@DIACHN##	;CHAN IS FREE
	SKIPL	F
	PUSHJ	P,DIANUI##	;CLEAR SOME BITS
	PUSH	P,F
	PUSHJ	P,CLRDDB##	;RETURN DDB SPACE
	POP	P,F
IFN FTMP,<
	MOVE	T1,.CPCPN##	;CURRENT CPU NUMBER
	DPB	T1,[POINT 3,U,3]  ;FOR CLOCK QUEUE REQUEST
	TLO	U,400000	;FLAG A CPU NUMBER
> ;END IFN FTMP
	MOVE	T1,[CRNKUP,,1]	;CAUSE CANT START IO ON UUO LEVEL
	SYSPIF
	IDPB	T1,CLOCK##	; SO COME BACK WITH PD LIST NOT MAPPED
	IDPB	U,CLOCK##	;SAY WHICH UNIT (CHAN)
	SYSPIN
IFN FTMP,<
	MOVE	T1,.CPCPN##	;CURRENT CPU AGAIN
	SETZM	CLKMIN##(T1)	;FORCE LOOK AT CLOCK QUEUE
> ;END IFN FTMP
IFE FTMP,<SETOM	CLKNEW##>
	JUMPL	F,TPOPJ##	;NON-SKIP IF CALLED FROM DIACTC
	SETZB	T1,F		;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 REVERSE IO LIST
DIASCR:	JUMPE	F,DIAAAU##	;NO ASS'D UNITS
	TLO	F,-1		;SET REVERSE FLAG AND FALL INTO DIASCP

;HERE TO SET UP A CHANNEL PROGRAM
DIASCP:	JUMPE	F,DIAAAU##	;NO ASS'D UNITS
	PUSHJ	P,DIARCX	;RETURN ANY IOWD
	PUSHJ	P,GETWD1##	;GET IOWD
	HLRE	T2,T1		;LENGTH OF IOWD
	JUMPE	T2,DIAACP##	;TOO BIG IF 0
	SKIPGE	F		;REVERSE?
	ADD	T1,T2		;YES, COMPUTE 1ST ADDR (-1)
	MOVEM	T1,DEVDMP##(F)	;UNRELOCATED IOWD
	MOVEI	T1,1(T1)	;START ADDRESS
	MOVNS	T2		;+LENGTH
	ADDI	T2,-1(T1)	;TOP ADDRESS
	PUSHJ	P,ZRNGE##	;MAKE SURE THE PAGES ARE OK
	  JRST	[SETZM DEVDMP(F) ;PAGE NOT THERE
		 JRST  DIAACP##] ;BOMB HIM OUT
	MOVE	P3,UDBKDB(U)	;CHAN (FOR MAPIO)
	MOVE	P3,KDBCHN(P3)
	SETZB	P1,P4		;SAY FIRST CALL, NOT A DX10
	MOVE	T2,DEVDMP##(F)	;GET IOWD
	PUSHJ	P,MAPIO##	;RELOCATE THE IOWD
	  JRST	[SETZM DEVDMP##(F)
		 JRST  DIAAFC##] ;NO LOW-CORE BLOCKS
	SETZM	(P1)		;TERMINATE LIST
	MOVE	T1,UDBKDB(U)	;LOC OF KDB
	MOVE	T1,KDBICP(T1)	;INITIAL CONTROL WD ADDR
	MOVE	T2,CHNTYP(P3)	;IS IT AN RH20 ?
	TLNE	T2,CP.RH2
	TLO	P2,(INSVL.(.CCJMP,CC.OPC)) ;YES, MAKE ICWA BE A JUMP
	MOVEM	P2,(T1)		;POINT ICWA AT CORE-BLOCK
	PUSHJ	P,STOTAC##	;TELL USER ICWA
	JUMPGE	F,DIASC1	;REVERSE?
	TLNN	P2,(INSVL.(.CCJMP,CC.OPC)) ;YES, RH20?
	JRST	DIASC1		;CAN'T REVERSE IT
	HRRZ	T3,P2		;OK - SET IO LIST ADDRESS
	HLRZ	T2,DEVDMP##(F)	;AND WORDCOUNT
	PUSHJ	P,REVCCW##	;REVERSE THE IOWDS
DIASC1:	PUSHJ	P,CSDMP##	;SWEEP CACHE
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN
;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
	MOVE	T1,@KDBICP(W)	;GET LOC OF CORE-BLOCK
	PJRST	RTNIOW##	;RETURN THE SPACE


;HERE TO TELL USER FINAL CHAN STATS
DIACST:	JUMPE	F,CPOPJ1##	;NOTHING TO DO IF NO DDB
	MOVE	P2,KDBICP(W)	;GET ICWA
	PJRST	DIAGCS##	;FINISH UP IN UUOCON

;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:	SKIPL	@DIACHN##	;#IO XFER HAPPENING?
	POPJ	P,		;#YES, NON-SKIP
	MOVE	T2,U		;#NO, TEST UNITS FOR POSITIONING
WINDW1:	HRRZ	T1,UNISTS(T2)	;#UNIT SEEKING?
	CAIN	T1,PCOD
	POPJ	P,		;#YES, NON-SKIP
	HRR	T2,UNICHN(T2)	;#NO, TEST NEXT UNIT
	CAME	T2,U		;#BACK WHERE WE STARTED?
	JRST	WINDW1		;#NO
	JRST	CPOPJ1##	;#YES, ALL IS NOW QUIET

;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##
	PUSHJ	P,SSEUB##
	MOVE	U,T1
	MOVE	P1,DIACHN##	;POINT P1 AT CHANNEL
	PUSH	P,U
	SETOM	@DIACHN		;SO VMSER WILL START IO
	SETZ	J,		;INDICATE "UUO" LEVEL
	MOVEI	F,SWPDDB##
	PUSHJ	P,SWPSCN##	;CRANK UP SWAPPER
	MOVE	U,(P)		;RESET U
	SETZM	@DIACHN##	;SO ON-CYLINDER UNITS WONT START IO
CRNKU1:	HRR	U,UNICHN(U)	;NEXT UNIT
	PUSHJ	P,CRNPOS	;#NO, 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,UDBKDB(U)	;#GO START AN XFER IF CHNQUE NOT EMPTY
	DSKOFF			;#FIGHT RACE
	SKIPL	KONBSY(J)	;#DID A SEEK FINISH?
	PJRST	PIKTR0		;#NO, START IO IF CHNQUE NOT EMPTY
	PJRST	DOPOPJ		;#YES, FORGET IT
				;# SINCE IO IS ALREADY GOING
> ;END IFN FTKL10 FROM WAY BACK

;STILL IN FTDHIA CONDITIONAL
;HERE TO GET KONTROLLER/UNIT
DIAAKU:	CAIE	F,DSKDDB##	;NO, SOME FLAVOR OF DISK
	MOVE	T1,DEVNAM(F)
	PUSHJ	P,MSKUNI##	;SET UP A MASK
	PUSHJ	P,SRUNA##	;FIND UDB
	  JRST	DIAAIU##	;NOT A DISK UNIT
	  JFCL
DIAAK1:	PUSH	P,J		;SAVE J
	MOVE	J,UDBKDB(U)	;KONTROLLER
	MOVE	T2,KDBDVC(J)	;GET KONTROLLER CODE
	MOVE	T1,UDBPDN(U)	;GET PHYSICAL DRIVE NUMBER
	LDB	T3,UNYKTP##	;GET CONTROLLER TYPE
	CAIE	T3,TYPRN	;IS IT AN RP20?
	JRST	DIAAK2		;NO, CONTINUE
	HLRZ	T3,KDBUNI(J)	;GET DX20 ADDRESS (MASSBUS UNIT NUMBER)
	LSH	T3,3		;MAKE ROOM FOR UNIT NUMBER
	IORI	T3,(T1)		;OR WITH UNIT NUMBER
	SKIPA	T1,T3		;MOVE TO T1 AND SKIP LSH
DIAAK2:	LSH	T1,3		;POSITION IT
	LSH	T2,2		;POSITION KONTROLLER DEVICE CODE
	HRL	T1,T2
	POP	P,J		;RESTORE J
	AOS	(P)		;SET FOR SKIP-RETURN
	PJRST	STOTAC##	;TELL USER KON,,UNIT AND RETURN
	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::	PUSH	P,T4
	HRRZ	T3,UNISTR(U)	;GET ADDR OF STR DATA BLOCK
	SETO	T2,		;CREATE MASK FOR
	LDB	T2,STYCLP##(T3)	;CLUSTER POINTER
	MOVEM	T2,T4		;STORE IT FOR LATER
	HRRZ	T2,DEVCPY##(F)	;IN-CORE COPY
	JUMPE	T2,DD2MN6	;EASY IF THERE ISNT ONE
	SKIPN	DEVRB1##(F)	;DEVRET POINTING AT DEVRBN?
	SKIPA	T3,[PTRLEN##-1]	;YES, JUST COPY LAST PNTR
	MOVSI	T3,MPTRLN##	;NO, SET TO COPY ALL
	ADDI	T3,DEVRB1##(F)	;POINT AT START OF DDB-POINTERS
DD2MN5:	MOVE	T1,PTRDAT##(T2)	;GET A POINTER FROM IN-CORE COPY
	EXCH	T1,(T3)		;STORE IN DDB
	XOR	T1,(T3)		;MAKE SURE WE DIDNT MESS UP
	TDNE	T1,T4
	STOPCD	.+1,DEBUG,CDA,	;++IN-CORE COPY DOESN'T AGGREE
	SETZM	PTRDAT##(T2)	;CLEAR IN-CORE COPY
	ADDI	T2,1
	AOBJN	T3,DD2MN5	;AND STEP TO NEXT
	PUSHJ	P,SPTRW		;RESET T1 TO POINT AT RIB POINTERS
DD2MN6:	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,T4POPJ##	;NO, POPJ IF NO SLOTS
DD2MN2:	SKIPN	T3,(T2)		;GET A POINTER FROM DDB
	JRST	DD2MN4		;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,T4		;IF PNTRS EQUAL, SKIP
	STOPCD	.+1,DEBUG,PDA,	;++POINTERS WITH DIFFERENT ADDRESSES
DD2MN3:	SETZM	(T2)		;ZERO THE WORD IN DDB
	AOBJP	T2,[AOJA T1,DD2MN4] ;THROUGH WHEN DDB RUNS OUT
	AOBJN	T1,DD2MN2	;DO ANOTHER
	SKIPE	(T2)		;MON BUF FULL. MORE POINTERS?
	JRST	T4POPJ##	;MON BUF FULL AND MORE TO
DD2MN4:	AOS	-1(P)		;SET FOR SKIP-RETURN
	SOJA	T1,T4POPJ##	;GOOD RETURN
;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
TWOLOC:	SETZ	T3,2		;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)

;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
	PUSHJ	P,CPYPTR	;COPY POINTERS TO IN-CORE COPY
				;FALL INTO NEXT PAGE
;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.

	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
	PUSHJ	P,SAVE3##
	HRRZ	T3,UNISTR(U)	;YES, SET UP A MASK FOR
	SETO	T2,		; ADDR PORTION OF RETRIEVAL POINTERS
	LDB	T2,STYCLP##(T3)
	MOVEM	T2,P1		;AND SAVE IT AWAY
	PUSHJ	P,FNDDDB	;FIND A WRITING DDB FOR THE FILE
	  POPJ	P,		;NONE (DDB COULD BE IN EXTRIB)
PTRBL6:	HLRZ	T1,PTRFUN##(T2)	;SET UP 1ST UNIT IN FOUND-POINTERS
	LDB	P3,UNYLN1##	;UNIT NUMBER
	TRO	P3,RIPNUB##	;FAKE UP A UNIT-CHANGE PNTR FOR IT
	HRRZ	T1,DEVFUN##(F)	;1ST UNIT IN OUR DDB
	LDB	P2,UNYLN1##
	TRO	P2,RIPNUB##	;FAKE A UNIT-CHANGE FOR DDB POINTERS
	MOVEI	T3,DEVRB1##(F)	;YES, SET AN AOBJN WORD FOR OUR DDB
	HRRZ	T1,DEVCPY##(F)	;IN-CORE COPY?
	SKIPE	T1		; (MIGHT HAVE RUN OUT OF FREE-CORE)
	MOVEI	T3,PTRDAT##(T1)	;YES, USE THOSE PNTRS INSTEAD
	HRLI	T3,MPTRLN##
PTRBL7:	MOVEI	T1,PTRDAT##(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)
	TLNN	T4,-1		;UNIT-CHANGE?
	SKIPA	P3,T4		;YES, RESET P3
	CAME	P2,P3		;NO, ARE POINTERS FOR SAME UNIT?
	JRST	PTRBL9		;NO, TRY NEXT
	XOR	T4,(T3)		;YES, IS IT IN OUR DDB?
	TDNN	T4,P1
	JRST	PTRBLA		;YES, COPY PNTRS TO OUR DDB
PTRBL9:	AOBJN	T1,PTRBL8	;NO, TRY NEXT PNTR
	SKIPN	T4,1(T3)	;ANY MORE PNTRS IN OUR DDB?
	JRST	PTRBLB		;NO MATCH - TRY NEXT DDB
	TLNN	T4,-1		;ANOTHER POINTER, IS IT A UNIT-CHANGE?
	SKIPA	P2,T4		;YES, RESET P2
	TLNN	T4,-1		;IF THIS IS A UNIT-CHANGE
	AOBJN	T3,.+1		;DON'T TRY TO MATCH IT AGAINST FOUND DDB
	AOBJN	T3,PTRBL7	;TEST NEXT PNTR IN OUR DDB
	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
	POPJ	P,
	SKIPE	1(T1)		;IS THERE ANOTHER PNTR IN FOUND DDB?
	AOBJN	T1,PTRBLA	;YES, COPY INTO OUR DDB
PTRBLB:	HRRZ	T1,DEVACC##(F)	;RESET T1 FOR FNDDDN
	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 .UPMBF,  EXIT WITH T1=AOBJN WORD
;T2-T4 RESPECTED
SPTRW::	HRRZ	T1,.USMBF	;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 T1=AN IOWD FOR THE BUFFER
;PRESERVES T2
GTMB2:	PUSH	P,T2		;SAVE T2
	PUSHJ	P,GTMNBF	;GET THE MON BUF
	PJRST	T2POPJ##	;RESTORE T2 AND RETURN

GTMNBF::SKIPN	T1,.USSBF	;.UPMBF WRONG?
	JRST	GTMNB1
	MOVEM	T1,.USMBF	;YES (FROM RETRD8). FIX IT
	SETZM	.USSBF
	PUSHJ	P,RMVLBF##	;AND RETURN THE EXTRA PAGE
	  JFCL
GTMNB1::SKIPE	T1,.USMBF	;ALREADY HAVE MON BUF?
	POPJ	P,		;YES
	MOVEI	T2,BLKSIZ##	;NO OF WORDS TO GET
	PUSH	P,T3
	PUSHJ	P,GFWDCD##	;GET THE SPACE IN FUNNY SPACE
	  STOPCD T3POPJ##,JOB,MNA, ;++MONITOR-BUFFER NOT AVAILABLE
	SUBI	T1,1		;LOC-1 IN RH
	HRLI	T1,MBLKSZ##	;-200 IN LH
	MOVEM	T1,.USMBF	;SAVE IN UPMP
	JRST	T3POPJ##

;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,.USMBF	;IOWD FOR MONITOR BUFFER
	PUSHJ	P,GTMB2		;NONE YET, GET MON BUF
	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
	PJRST	STORU		;SAVE IN DDB AND RETURN
;SUBROUTINE TO WRITE THE RIB IF IT HAS CHANGED
WTRBIC::SKIPA	T1,DEVRRC##(F)	;HERE FROM OUTPUT
FWRBIC::SKIPA	T1,DEVRRC##(F)	;HERE FROM FILOP
	TLNE	T1,DEPRRC##	;USER WANT TO REWRITE IF RIB CHANGES?
	TLNN	T1,DEPRHC##	;YES, HAS RIB CHANGED?
	POPJ	P,		;NO, GO AWAY
	HRRZ	T1,DEVACC##(F)	;YES, IS THE FILE AN UPDATE FILE
	JUMPE	T1,CPOPJ##
	MOVE	T1,ACCSTS##(T1)
	TRNE	T1,ACPUPD
	TLNN	F,OUTPB		; AND HAS THIS USER UPDATED IT?
	POPJ	P,		;NO, DON'T DO ANYTHING
	PUSHJ	P,SETU		;NOT SET IF FILOP
	  POPJ	P,
	PUSHJ	P,WAIT1##
	PUSHJ	P,PTRTST	;UPDATE POINTERS ETC
	  JFCL			;WE TRIED
	POPJ 	P,

;SUBROUTINE TO WRITE A RIB
;RETURNS T3=0 IF WRITTEN OK, NON-0 IF BAD
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,.USMBF	;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##	;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
	MOVE	T1,.USMBF	;GET IOWD TO 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 THE MON BUF
	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:	PUSH	P,T3		;SAVE ERROR BITS
	MOVEM	P1,DEVRIB##(F)
	PUSHJ	P,RIBCUR	;REREAD EXTENDED RIB
	  JFCL
	POP	P,T3
WRTRB3:	POP	P,U		;RESTORE CURRENT UNIT
	MOVSI	T1,DEPRHC##	;CLEAR RIB HAS CHANGED BIT
	ANDCAM	T1,DEVRRC##(F)
	PJRST	STORU		;SAVE IN DDB 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
	PUSHJ	P,STORU		;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::	HRRZ	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,.USMBF	;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:	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::SKIPN	T1,.USMBF	;T1=IOWD FOR THE DATA
	PUSHJ	P,GTMB2
	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::TDO	S,[XWD IOSSCE##,IOIMPM]	;LIGHT ERROR BITS
	JUMPE	U,RIBER1	;SKIP THE REST OF THIS IF U=0 (NEWUNI)
	MOVEI	T1,UNPRER	;SET UP A BIT
	ADDM	T1,UNIMCT(U)	;COUNT IN SOFTWARE-ERROR WORD FOR UNIT
	SKIPGE	UNIECT(U)	;IF NOT IN ERROR RECOVERY
	MOVEM	T4,UNIHBN(U)	; SAVE BLOCK FOR DAEMON
	MOVE	T1,[.FIRBE,,.ERDPE] ;FILIO-DETECTED RIB ERROR
	PUSHJ	P,DAEERR##	;AND CALL DAEMON LOG ERROR
	PUSHJ	P,SAVE2##	;SLFND USES P-ACS
	HRRZ	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
RIBER1:	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
	MOVE	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
	PJRST	STRIOS		;STORE S AND RETURN
;SUBROUTINE TO READ AND VERIFY THE BAT BLOCKS ON A UNIT.
;ENTER WITH T1=IOWD, U=UDB ADDRESS
;RETURNS CPOPJ IF BOTH BLOCKS ARE BAD, CPOPJ1 NORMALLY WITH T1=IOWD
;  AND BLOCK IN BUFFER POINTED TO BY IOWD
REDBAT::PUSHJ	P,SAVE1##	;GET AN AC TO USE
	MOVE	P1,UNIHOM(U)	;GET HOME BLOCK ADDRESSES FOR THIS UNIT
REDBA1:	JUMPE	P1,CPOPJ##	;GO IF TRIED BOTH BLOCKS
	MOVEI	T2,LBOBAT##(P1)	;PUT ADDRESS OF BAT BLOCK IN T2
	PUSHJ	P,MONRED	;READ THE BLOCK
	MOVS	T2,BAFNAM##+1(T1) ;GET SIXBIT CODE FROM BLOCK
	TRNN	T3,IODTER+IODERR+IOIMPM ;ANY READ ERRORS?
	CAIE	T2,'BAT'	;NO, SIXBIT CODE CONSISTENT?
	JRST	REDBA2		;NO, TRY OTHER BLOCK
	MOVEI	T2,CODBAT##	;GET UNLIKELY CODE
	MOVEI	T3,LBOBAT##(P1)	;AND THE BLOCK NUMBER THAT WE READ
	CAMN	T3,BAFSLF##+1(T1) ;SELF POINTER CONSISTENT?
	CAME	T2,BAFCOD##+1(T1) ;YES, UNLIKELY CODE MATCH?
	CAIA			;NO, TRY NEXT
	JRST	CPOPJ1##	;YES, THIS BLOCK IS OK
REDBA2:	HLRZS	P1		;SETUP TO TRY OTHER BLOCK
	JRST	REDBA1		;AND DO SO
	UCACHE==1		;**TEMP FOR NOW**
;SUBROUTINE TO WRITE A BLOCK (OR SERIES OF BLOCKS)
;ENTER WITH T1= IOWD   T2=BLOCK NUMBER
;ENTER AT MONWRS TO STORE BLOCK NUMBER INTO BLKSLF WORD OF FIRST BLOCK
;ENTER AT MONWRU TO DO MONWRT BUT NOT TO USE DISK CACHE
MONWRS::MOVEM	T2,BLKSLF##+1(T1) ;MAKE SELF BLOCK NUMBER CONSISTENT
MONWRT::TLZA	F,UCACHE	;BE SURE WE GO THROUGH DISK CACHE
MONWRU::TLO	F,UCACHE	;DONT GO THROUGH DISK CACHE
	PUSH	P,S		;SAVE S
	TLO	S,IO		;INDICATE WRITING
	PJRST	MONIOY		;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
;ENTER AT MONRDU TO NOT GO THROUGH DISK CACHE
MONRED::TLZA	F,UCACHE	;BE SURE TO USE CACHE
MONRDU::TLO	F,UCACHE	;DO NOT USE DISK CACHE
	SKIPN	.UONCE##	;NOT IN ONCE?
	CAMN	T1,.USMBF	;READING INTO MONITOR BUFFER?
	TLZ	S,IOSRIB	;YES, IF RIB WAS THERE BEFORE IT ISN'T NOW
	PUSH	P,S		;SAVE S BEFORE UUOPWQ DOES ITS THING
	MOVEM	S,DEVIOS(F)
	TLZ	S,IO		;INDICATE READING
	PJRST	MONIOY		;JOIN COMMON CODE

;CALLED FROM SPRIO, REDSWP/WRTSWP
MONIOU::TLO	F,UCACHE	;DONT GO THROUGH CACHE
	PUSH	P,S		;SAVE S
				;FALL INTO MONIOY
MONIOY:	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
	TDZ	S,[IOSTBL,,IOIMPM+IOBKTL+IODTER+IODERR] ;ZERO THE TEMP ERR BITS
	TLO	S,IOSMON	;INDICATE MONITOR IO
	MOVEM	S,DEVIOS(F)	;STORE NEW S IN DDB
IFN FTXMON,<
	PUSH	P,DEVISN(F)	;SAVE CURRENT SECTION NUMBER FOR I/O
	SKIPN	DINITF##	;IF IN ONCE ONLY,
	CAME	T1,.USMBF	;OR NOT A MONITOR BUFFER,
	JRST	.+2		;LEAVE DEVISN ALONE
	HLLZS	DEVISN(F)	;A MONITOR BUFFER, ALWAYS IN SECTION 0
>
	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
MONIO9:	PUSHJ	P,CHEKU		;WAS UNIT YANKED?
	  JRST	MONIO1		;YES, HE LOSES
	PUSHJ	P,UNICHK	;MAKE SURE UNIT IS OKAY.
	  JRST	MONIO1		;NO GOOD - WRITING FROM MON-BUF, UNIT OFF LINE
IFE FTMP,<
	MOVE	J,UDBKDB(U)	;LOC OF KONTROLLER DATA BLOCK
>
	PUSHJ	P,CSHIO		;TRY TO READ BLOCK FROM DISK CACHE
	TLZE	S,IOSTBL	;TROUBLE?
	JRST	MONIO9		;YES, RETRY AT UUO LEVEL
				;FALL INTO MONIO1
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)
IFN FTXMON,<
	POP	P,DEVISN(F)	;RESTORE SECTION NUMBER FOR I/O
>
MONIO2:	POP	P,S
	OR	S,T3		;SET ANY ERROR BITS INTO S
	TLZ	F,UCACHE	;BE SURE WE DONT STORE UCACHE BIT
STRIOS::MOVEM	S,DEVIOS(F)
	POPJ	P,		;AND RETURN TO CALLER
	SUBTTL	ONCE PER SECOND CODE FOR DISK

DSKSEC::MOVSI	T1,(CR.ATO)	;BIT TO TEST
	TDNE	T1,.CPRUN##	;WAITING FOR AUTCON TO RUN?
	POPJ	P,		;THEN DO NOTHING
	PUSHJ	P,SAVE4##
	PUSHJ	P,SSEUB##	;SAVE CURRENT UBR
IFN FTMP,<
	PUSHJ	P,DSKRQT	;TEST FOR DEAD CPU
>
	MOVEI	T1,ACTDRB##-DRBLNK##
	DSKOFF			;#PREVENT RACES
DSKS0A:	HRRZ	T1,DRBLNK##(T1)	;#GET LINK TO NEXT DRB
	CAIN	T1,ACTDRB##	;#END OF CHAIN?
	JRST	DSKS0B		;#YES
IFN FTMP,<
	LDB	T2,DRYCPU##	;#GET CPU WHICH STARTED THIS I/O
	CAMN	T2,.CPCPN##	;#ON CORRECT CPU?
>; END IFN FTMP
IFN FTCIDSK,<
	SOSE	DRBTIM##(T1)	;#COUNT DOWN HUNG TIMER
	JRST	DSKS0A		;#NOT TIMED OUT YET
	MOVEI	T2,DRPTRY##	;#BIT TO SET
	IORM	T2,DRBSTS##(T1)	;#RETRY THIS OPERATION
	MOVEI	T2,4*DSKTIM##	;#HUNG TIMER
	MOVEM	T2,DRBTIM##(T1)	;#RESET IT
	JRST	DSKS0A		;#ONTO THE NEXT DRB
>; END IFN FTCIDSK
DSKS0B:	DSKON			;#OK TO INTERRUPT
IFN FTCIDSK,< PUSHJ P,RESWP>	;RETRY OFF-LINE SWAPS
	MOVEI	J,KDBTAB##+.TYDSK-KDBNXT  ;POINT TO START OF KDB CHAIN
DSKSE1:	SKIPN	J,KDBNXT(J)	;STEP TO NEXT KDB
	POPJ	P,		;DONE
	PUSHJ	P,DSPWQ		;CHECK PWQ (BEFORE KONCAM TEST)
IFN FTMP,<
	MOVE	T1,KDBCAM(J)	;CPU(S) WHICH OWN KONTROLLER
	TDNN	T1,.CPBIT##	;IS IT US?
	JRST	DSKSE1		;NO, GO TO NEXT KONTROL
>
IFN FTCIDSK,<
	MOVSI	T1,KOPCNA	;CREDIT NOT AVAILABLE BIT
	SKIPGE	KONMX(J)	;CAN KONTROLLER DO MULTIPLE TRANSFERS?
	ANDCAM	T1,KONCNA(J)	;YES, CLEAR CREDIT NOT AVAILABLE
>; END IFN FTCIDSK
	PUSHJ	P,@KONSEC(J)	;CALL THE ONCE PER SECOND CODE IF IT EXISTS
	DSKOFF			;INTERLOCK THIS
IFE FTKS10,<
	SKIPN	DIADSK##	;DON'T BLAST KON IF IN USE BY DIAG.
	PUSHJ	P,@KONALV(J)	;MAKE SURE DISK HAS PI,IVI
>
	SKIPGE	KONDRB(J)	;KONTROLLER USE DRBS?
	JRST	DSKS10		;YES, DON'T TWIDDLE WITH UNITS HERE
	SKIPN	U,KONCUA(J)	;GET CURRENT TRANSFERRING UNIT
	JRST	DSKSE2		;NONE, SKIP THIS
	MOVE	T1,UNISTS(U)
	CAIN	T1,TCOD		;IS IT IN TRANSFER STATE?
	SOSE	UNITIM(U)	;YES, COUNT DOWN HUNG-TIMER
	JRST	DSKSE2
	PUSHJ	P,DSKS11	;TIMER WENT TO 0 - IT IS HUNG
	DSKOFF			;MIGHT HAVE COME BACK ON
DSKSE2:	MOVE	T1,KDBCHN(J)	;GET CURRENT CHAN
	SKIPGE	DIADSK##	;IF DIAG IS GOING
	CAME	T1,DIACHN##	; ON THIS CHAN
	CAIA
	JRST	DSKS10		;LEAVE OTHER UNITS ALONE

	SKIPE	P4,CHNCUA(T1)	;GET BUSY UNIT ON CHAN
	MOVE	P4,UNISTS(P4)	;GET THE UNITS STATE
	SUBI	P4,TCOD		;P4=0 IF UNIT CAN BE IN TW
	HLRE	P3,KDBIUN(J)	;START AT LAST UNIT ON CHAN
	SETCA	P3,P3
DSKSE3:	SKIPE	U,@KONPTR(J)	;GET UDB
	SKIPN	T1,UNISTS(U)	;GET STATE OF UNIT
	JRST	DSKSE9		;DOESN'T EXIST OR IDLE
	SKIPN	P4		;IF SOME UNIT IS BUSY ON CHAN
	CAIE	T1,TCOD		; THEN T IS OK (HANDLED EARLIER)
	CAIN	T1,PWCOD	;PW IS OK
	JRST	DSKSE0		;SO IGNORE THESE
	CAIN	T1,TCOD		;ILLEGALLY IN T?
	SETZ	T1,		;YES, FIDDLE AROUND
	CAIE	T1,TWCOD	;(HERE FOR NOT I, PW, OR T)
	JUMPN	T1,DSKSE5	;NOT TW OR T
	JUMPE	P4,DSKSE9	;TW, IS THIS STATE LEGAL?
;HERE IF TW ILLEGALLY OR T ILLEGALLY
IFN FTDUAL,<
	SKIPN	T2,UNI2ND(U)	;IS THERE AN ALTERNATE PATH?
	JRST	DSKS3A		;NO. THIS UNIT SHOULDN'T BE IN TW
	MOVE	T2,UDBKDB(T2)	;YES. IS OTHER CHAN BUSY?
	MOVE	T2,KDBCHN(T2)
	SKIPL	(T2)		; IF SO, ALTERNATE PATH MIGHT REALLY BE TW
	JRST	DSKSE9		;SO DON'T CHANCE ZAPPING THIS UNIT
DSKS3A:>
	MOVE	P1,UDBKDB(U)	;GET CHANNEL DATA BLOCK
	MOVE	P1,KDBCHN(P1)
	JUMPN	T1,DSKSE4	;ILLEGAL T?
	HRRZ	F,UNICDA(U)	;YES, GET DDB
	JUMPE	F,DSKSE6	;IF NONE, SET IDLE
	HRRM	U,CHNCUA(P1)	;POINT CHAN TO UNIT
	SETZB	P4,(P1)		;INSURE CHAN IS BUSY
	HRRM	U,KONCUA(J)	;POINT KON TO UNIT
	MOVSI	T1,KOPBSY	;INSURE KON IS BUSY
	IORM	T1,KONBSY(J)
	MOVE	T1,UNISTS(U)	;GET STATUS BACK
	JRST	DSKSE8
;HERE IF TW ILLEGALLY
DSKSE4:	SKIPN	CHNQUE(P1)	;ANYTHING TO DO?
	JRST	DSKSE6		;NO, SET UNIT IDLE
	SETZB	P4,(P1)		;INSURE CHAN IS BUSY
	PUSHJ	P,PIKTRX	;START UP SOMETHING
	JRST	DSKSEZ		;AND TEST NEXT
DSKSE5:	SOSE	UNITIM(U)	;NOT I,PW,T,TW. COUNT TIMER
	JRST	DSKSE9		;NOT YET HUNG
	HRRZS	T1		;SIGN BIT ON IF POSITION-HUNG RECOVERY
	CAIN	T1,PCOD		;HUNG. POSITION?
	JRST	DSKSE8		;YES, CALL HNGSEC
	JRST	DSKSE9
DSKSE6:	PUSHJ	P,IDLEPW	;SET IDLE OR PW
	JRST	DSKSE9		;AND TEST NEXT UNIT
DSKSE8:	PUSHJ	P,DSKS11	;HUNG, TRY TO FIX IT UP
	JRST	DSKSEZ
DSKSE0:	PUSHJ	P,CRNPOS	;START PWQ IF KON IDLE
	MOVE	J,UDBKDB(U)	;GET KON BACK
DSKSEZ:	DSKOFF			;MIGHT HAVE COME BACK ON
DSKSE9:	SOJGE	P3,DSKSE3	;GO TO NEXT UDB
DSKS10:	DSKON
	JRST	DSKSE1		;DONE WITH KONTROL, TRY NEXT KDB
;HERE WHEN THE UNIT IS HUNG. CALL HNGDSK FROM HERE
DSKS11:
IFN FTCIDSK,<
	PUSHJ	P,CIBAD		;CI SHOULDN'T GET HERE
>
	HRRZ	F,UNICDA(U)	;DDB UNIT IS TALKING TO
	JUMPE	F,CPOPJ##	;FORGET IT IF NO DDB
	HRRZ	J,UNIJOB(U)	;SET UP J
	JUMPE	J,DSKS12	;GO IF SWAPPER
	HRRZ	T2,JBTUPM##(J)
	JUMPE	T2,DSKS14	;AVOID IME IF JOB IS GONE
DSKS12:	PUSHJ	P,MKADD##	;MAKE JOB ADDRESSABLE
	DPB	T1,DEYCOD##
	MOVE	S,DEVIOS(F)
	CAIN	F,SWPDDB##
	TRO	S,IOACT
IFN FTDUAL,<
	HRRZ	T1,DEVCUR##(F)
	CAIE	F,SWPDDB##
	CAIN	T1,(U)		;IS IT RIGHT UNIT
>
	TRNN	S,IOACT		;IS DDB IO ACTIVE?
	JRST	DSKS13
	PUSH	P,U		;ERRCON ZAPS U
	PUSHJ	P,HNGSEC	;HAVE HNGDSK TRY TO RECOVER
	  PUSHJ	P,DEVHNG##	;CAN'T RECOVER - ERROR FOR USER
	POP	P,U		;MIGHT BE RECOVERING
DSKS13:	MOVEI	T1,DSKTIM##	;RESET HUNG TIMER TO TRY AGAIN
	MOVEM	T1,UNITIM(U)	; IF RECOVERY DOESN'T WORK
DSKS14:	MOVE	J,UDBKDB(U)
	POPJ	P,		;AND EXIT
;TROUBLE IN THE POSITION WAIT QUEUE
;WAKE UP ALL THE JOBS IN THE QUEUE AND FORCE THEM
;TO EXECUTE UNICHK AT UUO LEVEL
TBLPWQ:	PUSHJ	P,SAVE2##	;SAVE P2
TBLPW1:	DSKOFF			;MAKE SURE NO INTS
	MOVEI	P2,UNIQUE-DEVQUE##(U);#PRESET PRED
	MOVS	F,DEVQUE##(P2)	;#GET 1ST DDB
	JUMPE	F,CPOPJ##	;#NONE
	PUSHJ	P,UNQUER	;#UNLINK IT
	  POPJ	P,		;#SYSTEM ERROR?
	SOS	UNIQUL(U)	;#COUNT IT
	DSKON
	MOVSI	S,IOSTBL	;LIGHT TROUBLE BIT
	IORB	S,DEVIOS(F)
	PUSHJ	P,STDIOD##	;WAKE HIM UP
	PUSHJ	P,CLRACT##
	JRST	TBLPW1		;MORE

;ROUTINE TO CHECK THE POSITION WAIT QUEUE
DSPWQ:	HLRE	P3,KDBIUN(J)	;START AT LAST UNIT ON CHAN
	SETCA	P3,P3
	DSKOFF
DSPWQ3:	SKIPN	U,@KONPTR(J)	;#GET UDB
	JRST	DSPWQ9
	MOVE	T1,UNISTS(U)	;#GET STATE OF UNIT
	CAIGE	T1,OWCOD	;#SOME FLAVOR OF OPR WAIT?
	JRST	DSPWQ9		;#NO
;#HERE IF OPR WAIT
	SKIPL	KONPOS(J)	;#DOES KONTROLLER POSITION?
	JRST	DSPWQ7		;#YES
IFN FTMP,<
	MOVE	T1,UDBCAM(U)	;#ONLY COUNT TIMER ON ONE CPU
	TDNN	T1,.CPBIT##	;#KONS THAT DON'T POSITION ALWAYS
	JRST	DSPWQ9		;#HAVE ONE KONCAM BIT ON
>
	SOSN	UNITIM(U)	;#TIMER RUN OUT?
	PUSHJ	P,IDLEPW	;#YES, SET BOTH PORTS IDLE
	JRST	DSPWQ9		;# AS THERE WON'T EVER BE A FREE INTERRUPT
DSPWQ7:	SKIPE	UNIQUE(U)	;#ANYBODY WAITING?
	PUSHJ	P,TBLPWQ	;#SEND EVERYBODY TO UNICHK
DSPWQ9:	SOJGE	P3,DSPWQ3	;#NEXT UNIT
	JRST	DOPOPJ
HNGSEC:
IFE FTKS10,<
	PUSHJ	P,FNDPDB##	;SET UP W
	  JRST	HNGDS1		;MUST BE SWAPPER
	CAMN	F,.PDDIA##(W)	;IN DIAG?
	JRST	DIACTC		;YES, RESTART THE IO ON THE CHANNEL
HNGDS1:
>
	MOVE	J,UDBKDB(U)	;KONTROLLER DB
;HERE IF UNIT MAY BE IN TRANSFER OR POSITION STATE
	PUSHJ	P,SAVE1##	;SAVE P1
	AOS	T1,UNIRCV(U)	;COUNT NUMBER OF ATTEMPTS AT RECOVERY
	CAIG	T1,10		;TRIED ENOUGH?
	JRST	HNGD12		;NO, TRY AGAIN
	SKIPL	DEVSWP##(F)	;YES, SWAPPER?
	JRST	HNGD99		;TOO MANY TIMES AND NOT SWAPPER, GIVE UP
	IDIVI	T1,^D60/DSKTIM	;TIME TO COMPLAIN AGAIN?
	CAIN	T2,1
	PUSHJ	P,TELOPR	;YES, HELP!
	JRST	HNGD12		;SWAPPER NEVER GIVES UP, TRY AGAIN
HNGD99:	PUSHJ	P,@KONSTP(J)	;STOP THE KONTROLLER
	  JFCL
HNGD11:	MOVSI	S,IOSMON
	ANDCAB	S,DEVIOS(F)	;MAKE SURE IOSMON=0
	TLO	T1,UNPFIR+UNPHNG ;TELL DAEMON HUNG DISK
	MOVEM	T1,UNIECT(U)
	PUSHJ	P,FLPJOB	;FLIP UNIJOB AND UNICDA
	SKIPE	DEVRHB##(F)	;IF NOT REREADING HOME BLOCKS,
	SOS	(P)		; LET USER GET HUNG DEVICE MESSAGE
				;REREADING HOME BLOCKS.
	MOVE	P1,KDBCHN(J)	;YES, SET UP P1
	MOVEI	T1,KOPOFL	;TELL BADUN1 TO GRUMBLE AT OPR
	PUSH	P,U
	PUSHJ	P,BADUN1	;GIVE UP, SHOUT AT OPR OVER THIS UNIT
	POP	P,U
	PJRST	CPOPJ1##	;DONT GIVE ERROR MESSAGE IF REREADING HOME BLOCKS
HNGD12:	MOVSI	T1,UNPHNG	;TELL DAEMON IT IS HUNG
	IORM	T1,UNIECT(U)
	SKIPL	UNIECT(U)	;IN ERROR RECOVERY?
	JRST	HNGD13		;YES, LEAVE REGS ALONE
	MOVEM	T1,UNIECT(U)	;NO, SET SO DAEMON WILL BE CALLED ON RECOVERY
	SETZM	UNIERR(U)
	PUSHJ	P,@KONRRG(J)	;GO READ ALL DRIVE REGISTERS NOW
	PUSHJ	P,FSTREG	;COPY REGISTERS TO UDB

HNGD13:	AOS	UNIECT(U)
	MOVE	T1,UNISTS(U)	;RESET T1=UNIT STATUS
	CAIE	T1,TCOD		;IS UNIT IN TRANSFER STATE?
	JRST	HNGD14		;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
	MOVEM	T2,UNISOF(U)	;STORE (BEFORE) CONI STATUS
	MOVEM	T3,UNISDI(U)	;STORE (BEFORE) DATAI STATUS
	MOVE	T1,UDBKDB(U)	;SET FLAG SO WE REMEMBER
	MOVE	T1,KDBCHN(T1)
	SETOM	CHNECT(T1)	; TO DO A RECAL
	ADDM	P1,UNIHNG(U)
	PUSHJ	P,SETHNG##	;RESTORE HUNG-TIME
	PJRST	CPOPJ1##	;SKIP RETURN - NO ERROR MESSAGE

;STILL IN FTDHNG CONDITIONAL
HNGD14:	HRRZ	T2,T1		;IGNORE SIGN BIT
	CAIE	T2,PCOD		;POSITIONING?
	PJRST	CPOPJ1##	;NO, RETURN WITH NO ERROR MESSAGE
				;(UNIT PROBABLY HUNG, THIS JOB IN QUEUE)
	HRRZM	T1,UNISTS(U)	;RESET SIGN BIT IF ON
	SKIPL	DEVSWP##(F)	;SWAPPER NEVER GIVES UP
	JUMPL	T1,HNGD11	;GIVE UP IF DIDN'T RECOVER
	MOVEI	T2,UNPHPS	;YES, INCREMENT HUNG POSITION COUNT
	ADDM	T2,UNIHNG(U)
	DSKOFF
	MOVE	T2,KONPOS(J)
	SKIPGE	KONBSY(J)	;#KONTROLLER BUSY?
	TLNE	T2,KOPPWX	;#YES, CAN WE RECAL ANYWAY?
	CAIA			;#IDLE OR DOESN'T MATTER
	JRST	HNGD15		;#CAN'T RECAL NOW, DO IT LATER
	MOVSI	T1,400000	;#INDICATE PHUNG RECOVERY
	IORM	T1,UNISTS(U)
	PUSHJ	P,SETHNG##
	PUSHJ	P,@KONRCL(J)	;#TRY A RECAL
	  PUSHJ	P,PUTOW		;#PUT IN OW
DOPJ1:	DSKON			;#
	PJRST	CPOPJ1##	;AND RETURN WITH NO ERR MESSAGE
;HERE IF WE CAN'T RECAL BECAUSE KONTROLLER IS BUSY
HNGD15: SKIPGE	DEVSWP##(F)	;#SWAPPER?
	JRST	DOPJ1		;#YES, KEEP TRYING TILL KON IDLE
	PUSHJ	P,FLPJOB	;#FLIP UNIJOB AND UNICDA
	PUSHJ	P,UUOPW5	;#LINK TO PWQ
	PJRST	CPOPJ1##	;AND RETURN W/ NO MSG

;ROUTINE TO PUT UNIT INTO OPERATOR WAIT
PUTOW:	SKIPGE	DEVSWP##(F)	;#SWAPPER?
	POPJ	P,		;#DON'T PUT SWAPPER IN OPR WAIT
	MOVEI	T1,OCOD
	MOVEM	T1,UNISTS(U)
	PUSHJ	P,FLPJOB	;#FLIP UNIJOB AND UNICDA
	PJRST	UUOPW2		;#LINK TO PWQ

;ROUTINE TO FLIP UNIJOB AND UNICDA
;PRESERVES ALL BUT T2
FLPJOB:	HRLZS	UNIJOB(U)
IFN FTDUAL,<
	SKIPE	T2,UNI2ND(U)
	HRLZS	UNIJOB(T2)
>
;FLIP ONLY UNICDA
FLPCDA:	HRLZS	UNICDA(U)
IFN FTDUAL,<
	SKIPE	T2,UNI2ND(U)
	HRLZS	UNICDA(T2)
>
	POPJ	P,
	SUBTTL JOB HANGING LOGIC

;SUBROUTINE TO REMOVE FROM UNIT QUEUES ALL DDBS BELONGING TO C(J)

ZAPDSK::PUSHJ	P,SAVE2##	;SAVE SOME AC'S
	PUSHJ	P,SVEUB##	;SAVE EUBR
	DSKOFF			;PREVENT RACES
	PUSH	P,U		;#SAVE U
	PUSH	P,F		;#SAVE F
	PUSH	P,J		;#SAVE JOB NUMBER
	HLRZ	U,SYSUNI##	;#GET FIRST UNIT IN SYSTEM

ZPDSK1:	MOVEI	P2,UNIQUE-DEVQUE##(U) ;#SET PREDECESSOR
ZPDSK2:	MOVS	F,DEVQUE##(P2)	;#GET NEXT DDB IN QUEUE
	JUMPE	F,ZPDSK4	;#JUMP IF NONE
	HLRZ	J,F		;#OWNED BY THIS JOB?
	CAME	J,(P)		;#...
	JRST	ZPDSK3		;#NO
	PUSHJ	P,UNQUER	;#REMOVE FROM UNIT QUEUE
	  JRST	ZPDSK1		;#PREDECESSOR CHANGED?
	SOSA	UNIQUL(U)	;#DECREMENT LENGTH OF PW QUEUE
ZPDSK3:	MOVE	P2,F		;#MAKE PREDECESSOR THIS
	HLRZ	J,P2		;#JOB NUMBER OF PREDECESSOR
	PUSHJ	P,MKADD##	;#MAKE IT ADDRESSABLE
	JRST	ZPDSK2		;#CONTINUE

ZPDSK4:	HLRZ	U,UNISYS(U)	;#STEP TO NEXT UNIT
	JUMPN	U,ZPDSK1	;#LOOP FOR ALL DISKS

	HLRZ	P1,SYSCHN##	;#ADDRESS OF FIRST CHN
ZPDSK5:	MOVEI	P2,CHNQUE-DEVQUE##(P1) ;#SET PREDECESOR
ZPDSK6:	MOVS	F,DEVQUE##(P2)	;#STEP TO NEXT ENTRY IN QUEUE
	JUMPE	F,ZPDSK8	;#GO IF QUEUE IS EMPTY
	HLRZ	J,F		;#GET JOB NUMBER
	CAME	J,(P)		;#BELONGS TO THIS JOB?
	JRST	ZPDSK7		;#NO
	PUSHJ	P,UNQUER	;#YES, REMOVE FROM QUEUE
	  JRST	ZPDSK5		;#PREDECESSOR CHANGED, TRY AGAIN
	SOSA	CHNQUL(P1)	;#REDUCE QUEUE LENGTH BY 1
ZPDSK7:	MOVE	P2,F		;#SET NEW PREDECESSOR
	HLRZ	J,P2		;#THIS JOB NUMBER
	PUSHJ	P,MKADD##	;#MAKE IT ADDRESSABLE
	JRST	ZPDSK6		;#CONTINUE

ZPDSK8:	HLRZ	P1,CHNSYS(P1)	;#STEP TO NEXT CHN
	JUMPN	P1,ZPDSK5	;#GO IF THERE IS ONE
	DSKON			;#ALLOW DISK INTERRUPTS
;NOW HANDLE CPUQUE
IFN FTMP,<
	DSKOFF			;PREVENT RACES
ZPDSK9:	MOVEI	P2,CPUDSQ##-DEVQUE## ;#SET PREDECESSOR
ZPDS10:	MOVS	F,DEVQUE##(P2)	;#GET NEXT IN QUEUE
	JUMPE	F,ZPDS12	;#ALL DONE IF NO NEXT
	HLRZ	J,F		;#GET JOB NUMBER
	CAME	J,(P)		;#BELONG TO JOB WE ARE WORRYING ABOUT?
	JRST	ZPDS11		;#NO, LOOK AT NEXT
	PUSHJ	P,UNQUER	;#REMOVE DDB FROM QUEUE
	  JRST	ZPDSK9		;#PREDECESSOR CHANGED
	SKIPA			;#CONTINUE, PREDECESSOR WAS UPDATED

;HERE TO MOVE TO NEXT ITEM IN QUEUE
ZPDS11:	MOVE	P2,F		;#SET NEW PREDECESSOR
	HLRZ	J,P2		;#THIS JOB NUMBER
	PUSHJ	P,MKADD##	;#MAKE IT ADDRESSABLE
	JRST	ZPDS10		;#CONTINUE

ZPDS12:	DSKON			;#ALLOW DISK INTERRUPTS
>; END IFN FTMP
	POP	P,J		;RESTORE J
	PJRST	FUPOPJ##	;RESTORE F AND U AND RETURN
;ROUTINE TO RETURN ANY RESOURCES A DDB HAS
;ENTER WITH JOB NUMBER IN J; EXITS WITH IOACT OFF IN DDB
RETRES::MOVE	U,DEVUNI##(F)
RETRSX:	TLNE	S,IOSDA		;HAVE DA?
	PUSHJ	P,DWNDA
	TRNE	S,IOSFA		;HAVE FA?
	PUSHJ	P,DWNFA		;YES, RETURN IT
	TLNE	S,IOSAU		;HAVE AU?
	PUSHJ	P,DWNAU
	JUMPE	J,CLRACT##
	CAME	J,CBUSER##	;HAVE CB?
	PJRST	CLRACT##	;RESET IOACT + POPJ
	SKIPN	DINITF##	;DON'T DURING ONCE-ONLY
	PUSHJ	P,CBFREE##	;FREE CB (ALREADY CHECKED IF WE OWNED IT)
				;(PREVENTS DOC IF CALLED FROM HNGSTP/GIVRSC)
	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

IFN FTMP,<
;SUBROUTINE TO SET UP DDB LOCS FOR MULTI CPUS
;ENTER WITH U SET UP
;RETURNS T1=FIRST CPU UNIT IS ON
CPUDDB:	MOVE	J,UDBKDB(U)	;SET UP J
	MOVEI	T1,CPFBIT##	;USE THE BIT MASK
	DPB	T1,DEYCPF##
	POPJ	P,
REPEAT 0,<			;THE OLD WAY
CPUDDB::MOVE	J,UDBKDB(U)	;SET UP J
	LDB	T1,KOYCPU##	;GET CPU WHICH OWNS UNIT/KONTROL
	DPB	T1,DEYCPF##	;TELL REST OF THE WORLD
IFN FTDUAL,<
	MOVSI	T2,DEPCPS
	ANDCAM	T2,DEVCPU(F)	;ASSUME NOT DUAL-PORTED TO 2 CPUS
	SKIPL	T3,UNI2ND(U)
	POPJ	P,
	MOVE	T3,UDBKDB(T3)	;KONTROLER FOR 2ND PORT
	LDB	T3,KOZCPU##	;CPU FOR 2ND PORT
	CAIN	T3,(T1)		;MATCH?
	POPJ	P,		;YES, IT ISNT ON 2 CPUS
	IORM	T2,DEVCPU(F)	;NO, TELL WORLD DDB IS ON 2 CPUS
	DPB	T3,DEYCPS##	;CPU NUMBER FOR 2ND PORT
>;END IFN FTDUAL
	POPJ	P,
>	;END OF REPEAT 0
;STILL IN FTMP CONDITIONAL
;HERE FOR DSKOFF MACRO
DSKLOK::CONO	PI,DSKPIF##	;TURN OFF DSK PI
DSKLO1:	AOSE	INTRDS##	;TRY TO GET INTERLOCK
	JRST	DSKLO2
	SETZM	.CPDLK##	;GOT IT, INDICATE SO
IFN FTMP,<
	APRID	INTODS##
>
	POPJ	P,
DSKLO2:	SKIPN	.CPDLK##	;DIDN'T GET IT. DO WE ALREADY OWN IT?
	POPJ	P,		;YES
	SKIPL	INTRDS##	;DON'T TRY IF NOT POSSIBLE TO GET IT
	JRST	.-1		; SINCE IT SUCKS UP RMW MEMORY CYCLES
	JRST	DSKLO1		;NO, WAIT A WHILE

;HERE ON DSKON MACRO
DSKULK::SKIPE	.CPDLK##	;DO WE OWN IT?
	POPJ	P,		;NO, GO AWAY
	SETOM	.CPDLK##	;YES, NOW WE DON'T
	SETOM	INTRDS##
IFN FTMP,<
	SETOM	INTODS##
>
	CONO	PI,DSKPIN##
	POPJ	P,
;STILL IN FTMP CONDITIONAL
;HERE FOR AN IO REQUEST ON ANOTHER CPU
;HERE WITH T1=CPU BIT MASK
PCLDSK:	PUSHJ	P,CPUOK##	;IS ONE OF THESE RUNNING?
	  JRST	PCLOFL		;NO, CALL HNGSTP
	MOVS	T2,F		;PUT THIS DDB AT FRONT OF QUEUE
	HRR	T2,.CPJOB##	; FOR ONCE-A-SECOND STUFF
	SKIPN	T1,.CPQUE##	;IF THIS 1ST ENTRY IN QUEUE,
	MOVEM	T2,.CPQND##	; ALSO MARK DDB AS LAST IN QUEUE
	MOVEM	T2,.CPQUE##
	MOVEM	T1,DEVQUE##(F)	;LINK FORMER FIRST TO THIS DDB
	MOVE	T1,.CPQPC##	;GET THIS CPUS QP BIT
	IORM	T1,DOORBL##	;SERVICE FASTER IF ONLY THE NUL JOB LEFT
	MOVEI	T1,PCLDKY##	;SET TO NON-EXISTANT CPU
	DPB	T1,DEYPCL##	;UNTIL WE KNOW WHICH CPU
				;WILL DO THE REQUEST
	PJRST	SETACT##	;SET IOACT AND RETURN

;HERE IF CPU IS DEAD
PCLOFL:	SKIPGE	DEVSWP##(F)	;SWAPPER?
	JRST	PCLOF1		;YES, CAN'T CALL HNGSTP
	PUSHJ	P,SAVSTS	;NO, SAVE WHAT RESOURCES JOB OWNS
	PUSHJ	P,HNGSTP##	;TELL THE USER
	POP	P,T3		;HE TYPED CONTINUE
	PUSHJ	P,RESSTS	;GET BACK RESOURCES HE HAD
	PUSHJ	P,CHKCPI##	;GET BIT MASK BACK
	  JFCL
	JRST	PCLDSK		;AND TRY THE OPERATION AGAIN

PCLOF1:	TRO	S,IODERR	;SWAPPER - INDICATE WE LOST
	POPJ	P,
;STILL IN FTMP CONDITIONAL
;HERE ONCE A TICK
DSKTIC::SKIPE	.CPSWP##	;HAVE SWAP REQUESTS?
	PUSHJ	P,SWPIO2	;YES, TRY TO START THE SWAPPER
	SKIPN	T1,CPUDSQ##	;NO, ANYTHING TO DO?
	SKIPE	.CPQUE##
	CAIA
	POPJ	P,		;NO
IFN FTKL10,<
	SETOM	.CPSWD##
>
	PUSHJ	P,SSEUB##	;YES, PRESERVE UBR
	PUSHJ	P,SAVE3##
	MOVE	T2,.CPQPC##	;CLEAR DOORBELL WORD
	ANDCAM	T2,DOORBL##	; SINCE WE'VE ANSWERED IT
	JUMPE	T1,DSKTI6	;#GO IF ALL CPU QUEUE EMPTY
DSKTI1:	DSKOFF			;#PREVENT RACES
	MOVEI	P2,CPUDSQ##-DEVQUE## ;#PRESET PREDECESSOR
DSKTI2:	MOVS	F,DEVQUE##(P2)	;#STEP TO NEXT IN QUEUE
	JUMPE	F,DSKTI6	;#GO IF DONE
	HLRZ	J,F		;#JOB FOR THE NEXT DDB
	PUSHJ	P,MKADD##	;#MAKE IT ADDRESSABLE
	PUSHJ	P,SETU		;#SET UP U FROM DDB
	  SETZ	U,		;#UNIT WAS REMOVED
	JUMPE	U,DSKTI3	;#GO IF UNIT WAS REMOVED
	PUSHJ	P,CHKCPI##	;#DEVICE ON THIS CPU?
	  JRST	DSKTI5		;#NO
IFN FTDUAL,<
;WE COULD INSERT CODE HERE TO SEE IF THIS CPU HAS ANY CREDITS
;OUTSTANDING, BUT IT PROBABLY WOULDN'T BE WORTH IT.
	SKIPE	UNI2ND(U)	;#GO IF SINGLE PORTED
	CAMN	T1,.CPBIT##	;#GO IF WE'RE THE ONLY CPU
	JRST	DSKTI3		;#DO IT ON THIS CPU
	MOVE	J,UDBKDB(U)	;#POINT U AT THIS CPU'S PORT
	MOVE	T1,UDBCAM(U)
	TDNN	T1,.CPBIT##
	HRRZ	U,UNI2ND(U)
	MOVE	J,UDBKDB(U)	;#POINT J AT THIS CPU'S KDB
	SKIPN	UNIQUE(U)	;#IF THIS PORT ALREADY HAS A QUEUE,
				;# THEN MAKE THE QUEUE LONGER.
				;# THIS WILL MAKE THE LATENCY OPTIMIZER
				;# WORK BETTER (MORE TO CHOOSE FROM).
	SKIPL	KONBSY(J)	;#KON BUSY?
	JRST	DSKTI3		;#IDLE, DO IT HERE
	HRRZ	T4,UNI2ND(U)	;#OTHER CPU'S PORT
	MOVE	T3,UDBKDB(T4)	;#OTHER CPU'S KDB
	MOVE	T1,UDBCAM(T4)	;#MASK OF OTHER CPU'S
	SKIPN	UNIQUE(T4)	;#MAKE OTHER QUEUE LONGER
	SKIPL	KONBSY(T3)	;#OTHER KON BUSY?
	PUSHJ	P,CPUOK##	;#OTHER CPU OK?
	  JRST	DSKTI3		;#BOTH BUSY OR OTHER CPU DEAD
	JRST	DSKTI5		;#OTHER CPU ALIVE AND IDLE
				;# LEAVE IT FOR THE OTHER CPU
>
DSKTI3:	PUSHJ	P,UNQUER	;#UNLINK DDB FROM QUEUE
	  JRST	DSKTI1		;#RACE, TRY AGAIN
	MOVE	S,DEVIOS(F)	;#SET S
	JUMPE	U,DSKTI7
	PUSHJ	P,UUOPWR	;#GO START OR QUEUE THE IO REQUEST
	JRST	DSKTI1		;#AND LOOK FOR SOMETHING ELSE TO DO

DSKTI5:	MOVE	P2,F		;#RESET PREDECESSOR
	JRST	DSKTI2		;#AND LOOK AT NEXT IN QUEUE

;HERE WHEN ALL REQUESTS ARE PROCESSED

DSKTI6:	DSKON			;LET THE CHANNEL BREATH AGAIN
IFN FTKL10,<
	SKIPN	.CPSWD##	;IF WE SWEPT
	MOVMS	.CPTAP##	; TELL TAPSER IT DOESNT HAVE TO
>
	SKIPN	.CPQUE##	;ANYTHING IN OUR CPU QUEUE?
	POPJ	P,		;NO
IFN FTKL10,<
	SKIPE	.CPSWD##	;YES, NO NEED TO SWEEP IF WE JUST DID
	PUSHJ	P,CSDMP##	;SWEEP CACHE
>
	MOVE	T2,.CPQUE##	;START OF QUEUE
	MOVS	T1,.CPQND##	;GET END OF CPU QUEUE
	HLRZ	J,T1		;JOB NUMBER OF THE DDB
	PUSHJ	P,MKADD##	;MAKE THE DDB ADDRESSABLE
	DSKOFF			;#PREVENT RACES
	MOVE	T3,CPUDSQ##	;#GET ALL-CPU QUEUE
	MOVEM	T3,DEVQUE##(T1)	;#INSERT CPU-QUEUE AT FRONT OF ALL-QUEUE
	MOVEM	T2,CPUDSQ##	;#INSERT ALL-QUEUE AT END OF CPU-QUEUE
	DSKON
	MOVE	T3,.CPQPS##	;GET QUEUED PROTOCOL BITS FOR OTHERS
	IORM	T3,DOORBL##	;RING EVERYBODY ELSE'S DOORBELL
	SETZM	.CPQUE##	;OUR QUEUE IS NOW EMPTY
	POPJ	P,		;ALL DONE

;HERE IF UNIT WAS REMOVED
DSKTI7:	PUSHJ	P,STDIOD##	;WAKE JOB UP
	JRST	DSKTI1		;AND TRY NEXT IN QUEUE
;STILL IN FTMP CONDITIONAL
;HERE AFTER ALL QUEUED PROTOCOL IS HANDLED
;LOOK FOR DISKS ON A DEAS CPU WHICH ARE DUAL-PORTED TO OUR CPU
;IF FOUND, SWITCH THE UDB TO THIS CPU
DSKRQT:	MOVE	T3,.CPSCC##	;BIT TO TEST
	MOVEI	T2,.C0CDB##	;WHERE TO START
DSKRQ1:	TDNE	T3,.CPDRQ##-.CPCDB##(T2) ;CPU DEAD?
	JRST	DSKRQ2		;YES, REQUE REQUESTS FOR DISKS ON THAT CPU
	HLRZ	T2,(T2)		;NO, STEP TO NEXT CDB
	JUMPN	T2,DSKRQ1	;TEST THIS ONE
	POPJ	P,		;ALL DONE - EXIT

;HERE (ONCE) WHEN A CPU DIES
DSKRQ2:	ANDCAM	T3,.CPDRQ##-.CPCDB##(T2) ;SO WE WON'T GET HERE AGAIN
	MOVE	P1,T2		;SAVE CDB LOC
	PUSHJ	P,RCDRB		;RESCUE DRBS WHICH ARE IN PROGRESS
	MOVE	J,KDBTAB##+.TYDSK ;1ST KDB IN SYSTEM
DSKRQ4:	MOVE	T1,KDBCAM(J)	;CPU(S) WHICH OWN THIS KDB
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;CAN THIS CPU ACCESS THE KDB?
	TDNE	T1,.CPBIT##
>
	TDNN	T1,.CPBIT##-.CPCDB##(P1) ;IS KDB ON THE DEAD CPU?
	JRST	DSKR11		;NO, TRY NEXT
	HLRE	P3,KDBIUN(J)	;START AT LAST UNIT ON CHAN
	SETCA	P3,P3
DSKRQ5:	SKIPN	U,@KONPTR(J)	;UNIT THERE?
	JRST	DSKR10		;NO
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;MULTIPLE XFERS?
	PUSHJ	P,DSKRCI	;SPECIAL STUFF FOR CI
>
IFN FTDUAL,<
	SKIPN	T1,UNISTS(U)	;YES, IDLE?
	JRST	DSKR10		;YES, NOTHING SPECIAL TO DO
	CAIGE	T1,MDACOD	;NO, IN A WAIT STATE?
	SKIPN	T2,UNI2ND(U)	;YES, DUAL-PORTED?
	JRST	DSKR10		;NO, CAN'T RESCUE IT
	MOVE	T3,UDBCAM(T2)	;IS 2ND PORT ON THIS CPU?
	TDNN	T3,.CPBIT##
	JRST	DSKR10		;NO, CAN'T HELP
	MOVE	P2,KDBCHN(J)	;YES. POINT AT CDB (FOR DSKRQ6)
	CAIE	T1,PCOD		;IS THE UNIT IN T OR P?
	CAIN	T1,TCOD
	CAIA			;YES. GO "RESCUE" THE CURRENT IO
	JRST	DSKRQ6		;NO, JUST OPERATE ON THE QUEUES
	HRRZ	J,UNIJOB(U)
	SKIPE	J		;MAKE THE JOB ADDRESSABLE
	PUSHJ	P,MKADD##
	HRRZ	F,UNICDA(U)	;DDB ADDR
	MOVE	T1,DEVCUR##(F)	;WAS IT STARTED ON THE DEAD CPU?
	CAIN	U,(T1)
	PUSHJ	P,DSKRSI	;YES. RESCUE IT
				;FALL INTO DSKRQ6
;HERE TO UNQUEUE REQUESTS FOR THE DISK ON THE DEAD CPU
DSKRQ6:	DSKON
	MOVEI	F,CHNQUE-DEVQUE##(P2) ;PRESET PREDECESSOR
DSKRQ7:	MOVE	P2,F		;CURRENT FORMER IS PREDECESSOR
	MOVS	F,DEVQUE##(P2)	;STEP TO NEXT QUEUE ENTRY
	JUMPE	F,DSKRQ8	;DONE IF 0
	HLRZ	J,F		;JOB NUMBER
	PUSHJ	P,MKADD##	;MAKE IT ADDRESSABLE
	HRRZ	T2,DEVCUR##(F)	;CURRENT UNITT
	CAIE	T2,(U)		;THE ONE WE'RE RESCUING?
	JRST	DSKRQ7		;NO, STEP TO NEXT
	DSKOFF
	PUSHJ	P,UNQUER	;REMOVE IT FROM QUEUE
	  JRST	DSKRQ6		;RACE, TRY AGAIN
	MOVE	T3,UDBKDB(U)	;COUNT IT
	MOVE	T3,KDBCHN(T3)
	SOS	CHNQUL(T3)
	DSKON
	PUSHJ	P,DSKRSQ	;START IO OR QUEUE IT TO OTHER PORT
	MOVE	F,P2		;POINT BACK AT PRED
	JRST	DSKRQ7		;GET NEXT QUEUE ENTRY

;HERE AFTER ALL ENTRIES FOR UNIT HAVE BEEN REMOVED FROM CHAN QUEUE
DSKRQ8:	MOVS	F,UNIQUE(U)	;1ST DDB
	JUMPE	F,DSKRQ9	;GO IF QUEUE EMPTY
	MOVEI	P2,UNIQUE-DEVQUE##(U) ;SET PREDECESSOR
	PUSHJ	P,UNQUER	;REMOVE DDB FROM POSITION QUEUE
	  JRST	DSKRQ9		;AVOID A KAF
	SOS	UNIQUL(U)	;COUNT IT
	PUSHJ	P,DSKRSQ	;START NEW SEEK OR QUEUE IT ON 2ND PORT
	JRST	DSKRQ8		;AND TEST NEXT UNIT-QUEUE ENTRY

;HERE AFTER ALL ENTRIES HAVE BEEN REMOVED FROM UNIT QUEUE
DSKRQ9:	SETZM	UNISTS(U)	;CLEAN UNIT STATE
	MOVE	J,UDBKDB(U)	;RESET J
	AOS	.CPNBI##-.CPCDB##(P1) ;MAKE SURE THE CPU CAN'T BE CONTINUED
> ;END IFN FTDUAL
DSKR10:	SOJGE	P3,DSKRQ5	;TEST NEXT UNIT ON KDB
DSKR11:	SKIPE	J,KDBNXT(J)	;STEP TO NEXT KDB
	JRST	DSKRQ4
	POPJ	P,		;DONE
IFN FTDUAL,<
;HERE TO RESCUE A DISK - START THE IO OR QUEUE IT ON THE OTHER PORT
DSKRSI:	MOVE	S,DEVIOS(F)
	MOVE	T2,UNISTS(U)	;SAVE UNISTS
	MOVE	T1,UNI2ND(U)	;2ND PORT
	SETZM	UNISTS(T1)	;MAKE UNIT IDLE SINCE IO WONT COMPLETE ON
	SETZM	UNISTS(U)	; UDB ON THE DEAD CPU
	MOVE	J,UDBKDB(U)	;DUMP MODE XFER. HAVE TO RESET DEVDMP
	CAIN	T2,TCOD		;WAS A TRANSFER IN PROGRESS?
	PUSHJ	P,UNLST		;UNDO SETLST
DSKRSQ:	MOVE	S,DEVIOS(F)	;SET UP S
	TRNN	S,IOACT		;PARANOIA
	POPJ	P,
	LDB	J,PJOBN##	;WRITING. SEE IF OK
IFN FTKL10,<
	PUSHJ	P,RWRTCH##	;JOB RUNNABLE WITH RESPECT TO CACHE?
>
	  SKIPA	U,UNI2ND(U)	;YES. DO THE IO
	JRST	DSKRS2		;NO, GIVE AN ERROR RETURN
	MOVE	J,UDBKDB(U)	;SET UP NEEDED ACS
	PUSHJ	P,UUOPWR	;DO IT OR QUEUE IT
	MOVE	U,UNI2ND(U)	;RESET ACS TO FAILED UNIT
	MOVE	J,UDBKDB(U)
	POPJ	P,		;AND RETURN
DSKRS2:	TRO	S,IOIMPM	;TOO BAD
DSKRS3:	PUSHJ	P,STDIOD##	;TEST IOW, RESTART JOB
	PJRST	CLRACT##	;CLEAR IOACT AND RETURN
> ;END IFN FTDUAL
IFN FTCIDSK,<
;HERE TO RESCUE THE POSITION WAIT QUEUE FOR A CI DISK
DSKRCI:	PUSHJ	P,SAVJW##	;SAVE J
DSKRC4:	MOVEI	F,UNIQUE-DEVQUE##(U);PRESET PRED
DSKRC2:	DSKON			;INTERRUPTS OK
	MOVE	P2,F		;SAVE PRED
	MOVS	F,DEVQUE##(P2)	;STEP TO NEXT DDB
	JUMPE	F,CPOPJ		;NONE
	HLRZ	J,F		;MAKE DDB ADDRESSABLE
	PUSHJ	P,MKADD
	DSKOFF			;NO INTERRUPTS
	LDB	T1,DEYPCL##	;#INTENDED FOR DEAD CPU?
	CAIN	T1,PCLCP0##
	SETZ	T1,
	CAME	T1,.CPCPN##-.CPCDB##(P1)
	JRST	DSKRC2		;#NO, TRY NEXT DDB
	PUSHJ	P,RWRTCH##	;#STUFF IN DEAD CPU'S CACHE?
	  JRST	DSKRC3		;#NO, WE CAN DO IT HERE
	PUSHJ	P,UNQUER	;#UNLINK THE DDB
	  JRST	DSKRC4		;#RACE, START OVER
	SOS	UNIQUL(U)	;#COUNT IT
	PUSHJ	P,RCERR		;#GIVE HIM AN ERROR RETURN
	JRST	DSKRC4		;NEXT DDB

;HERE IF THE I/O CAN BE DONE ON THIS CPU
DSKRC3:	SKIPN	T1,.CPCPN##	;#SWITCH CPU NUMBER
	MOVEI	T1,PCLCP0##
	DPB	T1,DEYPCL##
	JRST	DSKRC2		;#WAIT FOR DSKSEC TO START IT

;ROUTINE TO HIM THE USER AN ERROR RETURN
RCERR:	DSKON			;#INTERRUPTS OK AGAIN
	MOVE	S,DEVIOS(F)	;GIVE THE GUY AN ERROR RETURN
	TRO	S,IOIMPM
	PUSHJ	P,STDIOD	;WAKE HIM UP
	PJRST	CLRACT
;ROUTINE TO RESCUE DRBS WHICH ARE IN PROGRESS
;P1 PASSES THE CDB FOR THE CPU WHICH HAS FAILED
RCDRB:	MOVEI	P3,ACTDRB##-DRBLNK##;PRESET PRED
	DSKOFF
RCDRB1:	HRRZ	P3,DRBLNK##(P3)	;#STEP TO NEXT DRB
	CAIN	P3,ACTDRB##
	JRST	DOPOPJ		;#NONE LEFT
	MOVE	T2,DRBSTS##(P3)	;#NOT FILLED IN?
	TRNE	T2,DRPNFI##
	JRST	RCDRB1
	LDB	T2,DRZCPU##	;#I/O ON FAILED CPU?
	CAME	T2,.CPCPN##-.CPCDB##(P1)
	JRST	RCDRB1		;#NO
	HLRZ	U,DRBCUR##(P3)	;#UNIT
	MOVE	J,UDBKDB(U)	;#KON
	MOVE	T2,UDBCAM(U)	;#IS THIS CPU ALSO PORTED TO THE DISK?
	TDNN	T2,.CPBIT##
	JRST	RCDRB1		;#NO
	HRRZ	F,DRBCDA##(P3)	;#DDB
	LDB	J,DRZJOB##	;#JOB NUMBER
	JUMPE	J,RCDRB2	;#SWAPPER, RESWP WILL WAIT FOR CACHE TO BE RIGHT
	PUSHJ	P,MKADD##	;#MAKE DDB ADDRESSABLE
	PUSHJ	P,RWRTCH##	;#STUFF IN DEAD CPU'S CACHE?
	  JRST	RCDRB2		;#NO, DO I/O ON THIS CPU
	MOVE	J,UDBKDB(U)	;#YES, GET KON BACK
	PUSHJ	P,RTNDRB	;#RETURN THE DRB
	PUSHJ	P,RCERR		;#GIVE HIM AN ERROR
	JRST	RCDRB		;START OVER

;HERE IF THIS CPU CAN DO THE I/O INSTEAD
RCDRB2:	MOVE	T1,.CPCPN##	;#STORE NEW CPU NUMBER
	DPB	T1,DRZCPU##
	SKIPN	T1
	MOVEI	T1,PCLCP0##
	DPB	T1,DEYPCL##
	PUSHJ	P,RTNTRY	;#LIGHT "TRY AGAIN"
	JRST	RCDRB1		;#DO NEXT DRB
> ;END IFN FTCIDSK
> ;END IFN FTMP
IFN FTMP,<
SWPIO2:	DSKOFF
	SKIPN	SQREQ##		;THERE IS A RACE
	JRST	[SETZM	.CPSWP## ; WHICH ALLOWS THIS TO HAPPEN
		 JRST DOPOPJ]
	MOVEI	F,SWPDDB##
	PUSHJ	P,SSEUB##
>
;HERE TO PUT A SWAPPING REQUEST IN THE QUEUE


SWAPIO::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
SUBTTL UUO LEVEL MODULE
;SUBROUTINE TO ENSURE THAT A CALLI IS FOR A DSK CHAN
;RETURNS CPOPJ IF NOT, CPOPJ1 IF SO
VALUUO::HRLM	P1,.USCTA
	PUSHJ	P,SETUF##
	  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
UUOPWQ::SKIPE	.UONCE##	;USER MODE?
	PJRST	USRDIO##	;YES
	PUSHJ	P,UUOSET	;CHECK IF STR YANKED, SET UP ACS
	  POPJ	P,		;EOF OR QUOTA EXHAUSTED
				; AND FALL INTO UUOPWR
UUOPWR::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:	TLNN	S,IOSUPR	;SUPER USETI/USETO?
	SKIPE	DEVBLK##(F)	;NO. 0 BLOCK REQUESTED?
	JRST	UUOPWZ		;NO. OK
	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:
IFN FTMP,<
	PUSHJ	P,CHKCPI##	;RIGHT CPU?
	  PJRST	PCLDSK		;NO, QUEUE IT
IFN FTDUAL,<
	MOVE	T1,UDBCAM(U)	;BUT WHICH PORT IS ON THIS CPU?
	TDNE	T1,.CPBIT##	;PRIME PORT?
	JRST	UUOPWD		;YES, USE PRIME PORT
UUOPWW:	HRRZ	U,UNI2ND(U)	;SET UP ACS FOR OTHER PORT
	PUSHJ	P,UNICHK	;MAKE SURE THIS PORT IS OK
	  POPJ	P,		; CAN'T HAPPEN
	MOVE	J,UDBKDB(U)
UUOPWD:	SKIPN	T1,.CPCPN##	;SET DEYPCL BYTE FOR CPU WHICH STARTED IO
	MOVEI	T1,PCLCP0##	;ENSURE NON-0
	DPB	T1,DEYPCL##	;SAVE CPU FOR REST OF WORLD TO SEE
>>
	PUSHJ	P,SAVE1##	;SAVE P1
UUOPW0:	MOVE	P1,KDBCHN(J)	;SET P1 = CHANNEL DB
	TRON	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.
IFN FTCIDSK,<
	SKIPGE	KONCNA(J)	;#OUT OF CREDITS?
	JRST	UUOPW2		;#YES, PW
>
	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,TLPJOB##	;YES, IS THIS MDA?
	CAIA			;NO
	JRST	UUOTWQ		;YES, LET IT HAPPEN
>
IFN FTDUAL,<
	CAIN	T1,PWCOD	;#POSITION WAIT?
	SKIPE	UNIQUE(U)	;#BUT QUEUE EMPTY ON THIS PORT?
>
	JRST	UUOPW2		;#SET FILE PW
IFN FTDUAL,<
;HERE IF POSITIONS WAITING ON OTHER PORT.
;OTHER KON MUST BE BUSY.
;START SOMETHING ON THIS PORT IF WE CAN.
	SETZM	UNISTS(U)	;#FORCE NEW UNISTS TO BE STORED
	PUSHJ	P,SECCOD
	MOVE	T2,KONPOS(J)	;#SECCOD CLOBBERS T2
>
UUOPW1:	SKIPN	DIADSK##	;TRYING TO SHUT DOWN IO?
	JRST 	UUOPW4
	CAMN	P1,DIACHN##	;YES, FOR THIS CHAN?
	JRST	UUOPW2		;YES, JUST QUEUE THIS REQUEST
	TLZA	T2,KOPPWX	;NO, BUT DON'T START SEEK IF KDB ACTIVE
UUOPW4:	TLNN	T2,KOPPWX	;UNIT/KONTROLLER POSITION WHILE TRANFERRING?
	SKIPL	KONBSY(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,UDBKDB(T1)	;YES, T1=UNIT T2=KON
IFN FTMP,<
	MOVE	T3,UDBCAM(T1)	;IS OTHER PORT ON THIS CPU?
	TDNN	T3,.CPBIT##
	JRST	UUOPW2		;NO, QUEUE REQUEST
>
	MOVE	T3,KDBCHN(T2)	;ALTERNATE CHAN
	SKIPE	DIADSK##	;DIAG IN PROGRESS FOR IT?
	CAME	T3,DIACHN##

	SKIPGE	KONBSY(T2)	;KONTROLLER IDLE?
	JRST	UUOPW2		;NO
	SKIPL	(T3)		;IS CHAN IDLE? (2ND CONTROLLER ON DUAL PORTED RP20)
	JRST	UUOPW2		;NO, THE KON REALLY ISNT IDLE EITHER
	PUSHJ	P,STORF		;YES, 1ST UNIT ALSO IS THIS DDB
	HRRZ	U,T1		;SET UP NEEDED ACS
	HRRZ	J,T2
	MOVE	P1,KDBCHN(J)
	JRST	UUOPOS		;AND GO START SEEK (OR MAYBE XFER)
>

;HERE TO PUT FILE IN POSITION WAIT (ALWAYS STORE UNISTS)
UUOPW5:	SETZM	UNISTS(U)	;#FORCE UNITSTS TO BE STORED
;HERE TO PUT FILE IN POSITION WAIT (SOMETIMES STORE UNISTS)
UUOPW2:	MOVEI	T1,PWCOD	;#PUT FILE PW
	DPB	T1,DEYCOD##	;#SET FILE PW
IFE FTDUAL,<
	SKIPN	UNISTS(U)	;#UNIT IDLE?
	MOVEM	T1,UNISTS(U)	;#YES SET UNIT PW
>
IFN FTDUAL,<
	SKIPE	UNISTS(U)	;#UNIT IDLE?
	JRST	UUOPW9		;#NO, BUSY
	MOVEM	T1,UNISTS(U)	;#YES, SET UNIT PW
	PUSHJ	P,SECCOD	;#BOTH PORTS EQUAL
UUOPW9:
>
	MOVEI	T1,UNIQUE(U)	;#QUEUE ON WHICH TO INSERT FILE
	PJRST	PUTQUE		;#PUT FILE ON PWQ AND RETURN

UUOPOS:	PUSHJ	P,RHBP		;#NEED TO REREAD HOME BLOCKS?
	  JRST	UUOPW2		;#YES, QUEUE THIS REQUEST FOR LATER
	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

;ROUTINE TO TEST IF HOME BLOCKS NEED TO BE REREAD
;RETURNS CPOPJ IF REREAD NEEDED
;NORMAL RETURN IS CPOPJ1
;DESTROYS ONLY T2 AND T3
RHBP::	MOVSI	T2,UNPRHB
IFN FTDUAL,<
	SKIPE	T3,UNI2ND(U)
	TDNN	T2,UNIDES(T3)
>
	TDNE	T2,UNIDES(U)
	POPJ	P,
	JRST	CPOPJ1##
;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:	MOVSI	T1,DEPUWL##	;WRITE LOCK?
	TDNE	T1,DEVPTB##(F)
	JRST	UNICK1		;YES
	SKIPL	T1,DINITF##	;KEEP GOING IF ONCE ONLY
	SKIPE	T1,UNISTS(U)	;STATUS OF UNIT
	CAIGE	T1,MDACOD	;OKAY ?
	PJRST	CPOPJ1##	;YES
UNICK1:
IFN FTMP,<
	PUSHJ	P,INTLVL##	;POINT CALL HNGSTP IF CALLED FROM DSKTIC
>
	SKIPN	J,.CPJOB##	;NO, IS UNIT IN MDA WAIT
	JRST	CPOPJ1##	;REALLY STILL IN ONCE
IFN FTMDA,<
	CAMN	J,TLPJOB##	;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
	MOVSI	T1,DEPUWL##	;CLEAR WRITE LOCK
	ANDCAM	T1,DEVPTB##(F)
	PUSHJ	P,SAVSTS	;SAVE A RECORD OF JOB'S RESOURCES
IFN FTMP,<
	MOVE	T1,.CPCPN##
	PUSHJ	P,SETCPN##	;COME BACK ON SAME CPU
	PUSH	P,DEVUNI##(F)	; TO TYPE RIGHT UNIT
	HRRM	U,DEVUNI##(F)
>
	PUSHJ	P,HNGSTP##	;TELL OPR AND USER ABOUT THE PROBLEM
IFN FTMP,<
	POP	P,DEVUNI##(F)
>
	POP	P,T3		;RECORD OF RESOURCES
	PUSHJ	P,RESST1	;GET THEM AGAIN
	PUSHJ	P,CHEKU		;LET SWITCH TO ALTERNATE PORT HAPPEN
	  JFCL			;...
	JRST	UNICHK		;AND TRY AGAIN
;SUBROUTINE TO MAKE A RECORD OF RESOURCES JOB OWNS
;RETURNS WITH THE RECORD ON THE PD LIST AND NO RESOURCES
SAVSTS::MOVE	J,.CPJOB##	;GET JOB NUMBER
	HLRZ	T1,S		;SAVE IOSDA,IOSAU BITS
	CAMN	J,CBUSER##	;JOB HAVE CB?
	TLO	T1,1		;YES, LIGHT A BIT
	TRNE	S,IOSFA		;HAVE FA?
	TLO	T1,2		;YES, FLAG IT
	PUSH	P,T1		;SAVE RECORD OF RESOURCES
	PUSHJ	P,RETRSX	;GIVE UP ALL RESOURCES JOB OWNS
	POP	P,T1		;RECORD
	EXCH	T1,(P)		;PUT BACK ON STACK
	PJRST	(T1)		;AND TAKE 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
RESST1:	MOVE	S,DEVIOS(F)	;AND S
	TRNE	T3,IOSDA	;GET DA IF NEEDED
	PUSHJ	P,UPDA
	TLNE	T3,2		;GET FA IF NEEDED
	PUSHJ	P,UPFA
	TRNE	T3,IOSAU	;GET AU IF NEEDED
	PUSHJ	P,UPAU
	TLNE	T3,1		;WANT CB?
	PUSHJ	P,GETCB##
	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::PUSHJ	P,SETU		;SET U FROM DEVUNI
	  POPJ	P,		;F/S WAS YANKED FROM UNDER US
	PUSHJ	P,UNICHK	;MAKE SURE UNIT IS OKAY.
	  POPJ	P,		;UNIT IS DOWN
	MOVE	J,UDBKDB(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	NXTBL1		;*NO
	CAMGE	T2,DEVREL##(F)	;*TRYING TO READ MORE THAN WAS WRITTEN?
	POPJ	P,		;*YES. TAKE EOF RETURN
	JRST	NXTBL2		;NO, CONTINUE
NXTBL1:	LDB	T3,DEYFNC##	;WRITING, FILE APPEND ONLY ?
	TLNN	S,IOSUPR	;AND NOT SUPER USETO ?

	CAIE	T3,FNCAPP##
	JRST	NXTBL2		;NO
	CAMLE	T2,DEVREL##(F)	;YES.  WRITING IN THE MIDDLE ?
	POPJ	P,0		;YES, RETURN IOBKTL
NXTBL2:	SOJGE	T1,CPOPJ1##	;*NO, IF BLOCKS LEFT, RETURN (THIS PNTR OK)
	TLNN	S,IOSUPR	;SUPER USETI/USETO?
	JRST	NXTBL4		;NO
				;FALL INTO NXTBL3
;HERE WHEN DEVLFT RAN OUT.  THERE MAY ACTUALLY BE MORE BLOCKS LEFT.
;IN WHICH CASE WE JUST FILL DEVLFT UP AGAIN.
NXTBL3:	MOVE	T1,UNIBPU(U)	;NUMBER OF BLOCKS ON THE UNIT
	MOVSI	T2,DEPCPT##	;IN COMPATIBILITY MODE?
	TDNE	T2,DEVCPT##(F)
	MOVE	T1,UNIBUC(U)	;YES, AN 11 DISK HAS MORE BLOCKS
	SUB	T1,DEVBLK##(F)	;NUMBER OF BLOCKS TILL END
	TLNE	T1,-1		;BUT NO MORE THAN 18 BITS WORTH
	MOVEI	T1,-1
	HRRM	T1,DEVLFT##(F)	;FILL DEVLFT UP AGAIN
	SOJGE	T1,CPOPJ1##	;RETURN IF BLOCKS LEFT ON UNIT
	MOVE	T1,DEVNAM(F)	;DID HE OPEN A UNIT OR A STR?
	PUSHJ	P,SRSTR##
	  POPJ	P,		;A UNIT, NONE LEFT ON THIS UNIT
	HRRZ	U,DEVUNI##(F)	;A STR, GET CURRENT UNIT BACK
	HLRZ	U,UNISTR(U)	;GET NEXT UNIT IN STR
	JUMPE	U,CPOPJ##	;QUIT IF NO MORE UNITS
	HRRM	U,DEVUNI##(F)	;POINT DDB AT NEW UNIT
	MOVE	J,UDBKDB(U)	;NEW UNIT COULD BE DIFFERNT KON
	SETZM	DEVBLK##(F)	;START WITH BLOCK 0 OF THAT UNIT
	JRST	NXTBL3		;GO FILL DEVLFT UP
NXTBL4:	MOVSI	T2,1		;*DECREMENT NO. OF POINTERS
	SKIPG	DEVRSU##(F)	;* IF RIB WASNT ALREADY FULL
	ADDB	T2,DEVRSU##(F)	;*RIB NOW FULL?
	JUMPGE	T2,NXTBL6	;*YES, LIGHT IOBKTL
	AOS	T1,DEVRET##(F)	;*STEP TO NEXT POINTER IN CORE
	CAIG	T1,DEVRBN##(F)	;*RUN OUT OF IN-CORE POINTERS?
	JRST	NXTB11		;*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	NXTB10		;YES
;HERE WHEN WRITING AND THE DDB POINTER SPACE IS FULL
	TLNN	F,OCLOSB	;OUTPUT CALLED BY CLOSE?
	JRST	NXTBL8		;NO. CONTINUE

;HERE IF THE OUTPUT IS FROM CLOSE
	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,NXTBL5	;GO IF LAST PNTR
	SKIPL	DEVRIB##(F)	;NOT LAST, PRIME RIB?
	TLOA	S,IOSRIB	;YES, SET FLAG TO INDICATE TO CLOSE CODE
NXTBL5:	TLZ	S,IOSRIB	;RIB NOT PRIME, BETTER WRITE IT OUT
	PUSHJ	P,WRTRIB	;WRITE OUT THE RIB
	JRST	NXTBL9		;AND CONTINUE

;HERE IF THE CURRENT RIB IS FULL
NXTBL6:	TLNE	S,IO		;READING?
	JRST	NXTBL7		;NO
	PUSHJ	P,PTRTST	;READ NEW POINTERS, WRITE THESE IF CHANGED (CHECKSUM)
	  POPJ	P,		;RIB ERROR
	PUSHJ	P,PTRNXT	;GET THE NEXT RIB
	  POPJ	P,		;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	NXTB14		;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
NXTBL7:	PUSHJ	P,EXTRIB	;YES, ALLOCATE ANOTHER RIB
	  PJRST	DWNIFA		;ERROR - RETURN FA AND EXIT
	PUSHJ	P,DWNIFA	;OK - GIVE UP FA 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
NXTBL8:	PUSHJ	P,PTRCUR	;GET THE RIB
	JUMPN	T3,CPOPJ##	;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,CPXPTR	;SET UP PTRFUN, PTRFLR, ETC
NXTBL9:	SETZM	DEVBLK##(F)	;INDICATE NO CONTIGUITY
	AOS	UNIPGT(U)	;COUNT A PAGE-TURN
	JRST	NXTB11		;AND CONTINUE

;HERE WHEN THE POINTERS RAN OUT ON INPUT

NXTB10:	PUSHJ	P,CLSNAM##	;MAKE SURE NAME IN DDB IS RIGHT
				; (FILE MIGHT BE RENAMED)
	MOVSI	T1,1
	SKIPE	DEVRB2##(F)	;FULL DDB?
	AOSA	UNIPGT(U)	;YES, COUNT A PAGE-TURN
	ADDM	T1,UNIPGT(U)	;NO, COUNT A QUARTER-TURN
	PUSHJ	P,PTRTST	;READ NEW POINTERS, WRITE THESE IF CHANGED (CHECKSUM)
	  POPJ	P,		;RIB ERROR
	PUSHJ	P,PTRCPY	;COPY NEW SET OF POINTERS INTO DDB
	SKIPE	DEVRB1##(F)	;GET NEW POINTERS?
	JRST	NXTB11		;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)
NXTB11:	SKIPE	T2,@DEVRET##(F)	;*IS THERE ANOTHER POINTER?
	JRST	NXTB13		;*YES

	MOVE	T1,DEVACC##(F)	;NO, ARE WE UP TO END OF FILE?
	TLNN	S,IO		;IF READING,
	SKIPA	T1,ACCWRT##(T1)	;USE NUMBER OF BLOCKS WRITTEN
	PUSHJ	P,GETALC	;ELSE USE NUMBER OF BLOCKS ALLOCATED

	CAMG	T1,DEVREL##(F)
	JRST	NXTB12		;YES, RETURN EOF OR ALLOCATE BLOCKS
	TLNN	S,IO		;NOT AT EOF. READING?
	JRST	FNDPTR		;YES, FIND POINTERS IN SOME DDB
	JRST	FIXDDB		;NO, FIND NEWLY-ALLOCATED PNTRS IN RIB


;HERE IF WE ARE UP TO THE END OF THE FILE
NXTB12:	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)	;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
	JUMPLE	T2,OUTG11	;CAN'T GET ANY MORE RETURN (IOBKTL SET)


;HERE WITH T2 = AMOUNT TO ALLOCATE, STR HAS SOME SPACE
	MOVE	T1,DEVACC##(F)	;IF SIMULT UPDATE FILE
	MOVE	T3,ACCSMU##(T1)	; GET MON BUF NOW
	TRNN	T3,ACPSMU
	JRST	OUTGR2
	MOVE	T3,ACCALC##(T1)	;CURRENT LENGTH OF FILE
	PUSHJ	P,UPFA		;WAIT FOR FA
	CAMN	T3,ACCALC##(T1)	;DID ANOTHER JOB EXTEND FILE?
	JRST	OUTGR1		;NO, CARRY ON
	PUSHJ	P,DWNFA		;YES, BACK OUT GRACEFULLY
	JRST	NXTB11		;AND USE THE NEW BLOCKS
OUTGR1:	PUSHJ	P,GTMB2
OUTGR2:	SKIPN	T1,DEVBLK##(F)	;CONTIGUITY ALLOWED?
	JRST	OUTGR4		;NO. GET SPACE ANYWHERE
	SOS	DEVRET##(F)	;YES. POINT TO CURRENT RETRIEVAL PTR
	PUSHJ	P,CHKADD	;ROOM LEFT IN POINTER?
	JUMPLE	T2,OUTGR3	;NO. GET SPACE ANYWHERE
	MOVE	T1,DEVBLK##(F)	;YES. GET SPACE PAST 1ST UNALLOCATED BLOCK
	PUSHJ	P,TAKBLK	;YES. GET SPACE AT END
	  JRST	OUTGR3		;TRY FOR SPACE ANYWHERE ON UNIT
	PUSHJ	P,ADDPTR	;ADD NEW BLOCKS TO CURRENT POINTER
	MOVSI	T2,-1		;DEVRSU WAS INCREMENTED AT NXTBL4,
	ADDM	T2,DEVRSU##(F)	; SO DECREMENT IT BACK DOWN
	TRNE	S,IOSFA		;IF A SIM UPDATE FILE,
	JRST	OUTGR7		; REWRITE RIB WITH NEW POINTERS IN IT
	JRST	NXTB15		;STORE NEW DEVLFT AND CONTINUE

;HERE WHEN CANT GET SPACE CONTIGUOUS WITH THE OLD SPACE
OUTGR3:	AOS	DEVRET##(F)	;POINT TO NEW POINTER LOC
	MOVE	T2,T1		;RESTORE AMOUNT TO GET
OUTGR4:	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,OUTGR5	;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
OUTGR5:	SETZ	T1,		;GET BLOCKS ANYWHERE
	PUSHJ	P,(T4)		;GET SOME BLOCKS
	  JRST	OUTGR9		;ON NEW UNIT
OUTGR6:	PUSHJ	P,PTSTO		;GOT SPACE ON SAME UNIT - SAVE POINTER IN DDB
	TRNN	S,IOSFA		;SIM UPDATE FILE?
	JRST	OUTGR8		;NO, CONTINUE
OUTGR7:	PUSHJ	P,WRTPTR	;REWRITE RIB WITH NEW PNTRS
	PUSHJ	P,DWNFA		;GIVE UP FA NOT THAT RIB WRITTEN
	PJRST	FIXDDB		;CALL USETI TO GET PNTRS BACK INTO CORE
				; (DD2MN ZEROES THE DDB)
OUTGR8:	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	NXTB13		;AND CONTINUE
;GOT SOME SPACE ON A NEW UNIT, OR STR FULL
OUTGR9:	JUMPE	T3,OUTG12	;IF GOT ANY
	MOVSI	T1,1
	ADDB	T1,DEVRSU##(F)	;UPDATE DEVRSU
	JUMPGE	T1,OUTG12	;ERROR IF ALL SLOTS TAKEN (SHOULD NEVER HAPPEN)
	AOBJN	T1,OUTG10
	MOVSI	T1,DEPLPC##
	IORM	T1,DEVLPC##(F)
OUTG10:	MOVE	T1,T2		;SAVE RETRIEVAL POINTER
	MOVE	T2,T3		;PICK UP UNIT-CHANGE
	PUSHJ	P,PTSTO		;SAVE UNIT-CHANGE IN DDB
	MOVE	T2,T1		;RESTORE "REAL" POINTER
	PUSHJ	P,STORU		;SAVE NEW UNIT IN DDB
	AOS	T1,DEVRET##(F)	;POINT TO NEXT PNTR SLOT
	CAIG	T1,DEVRBN##(F)	;DDB FULL?
	JRST	OUTGR6		;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,OUTGR6	;CONTINUE IF NO RIB ERR
	PUSHJ	P,CNVPTR	;RIB ERR- GIVE BACK THE BLOCKS
	  JFCL			;BAD UNIT!
	  STOPCD OUTG12,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	OUTG12		;UPDATE DEVRSO AND ERROR RETURN

;HERE WHEN STRUCTURE IS FULL, RETURN DEVRSU TO PRE-CALL STATE
OUTG11:	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
OUTG12:	SOS	DEVRET##(F)	;POINT DEVRET BACK TO LAST REAL POINTER
	MOVSI	T1,-1		;DECR DEVSRU
	ADDM	T1,DEVRSU##(F)	;(INCREMENTED AT NXTBL4)
	PUSHJ	P,DWNIFA	;GIVE UP FA IF SIM UPDATE
	PJRST	ERRFUL		;LIGHT AN ERROR BIT AND RETURN
;HERE WHEN WE HAVE A POINTER IN T2 (MAY BE UNIT CHANGE)
NXTB13:	PUSHJ	P,CNVPTR	;*CONVERT POINTER TO BLK, COUNT
	  JRST	OUTG12		;BAD UNIT-CHANGE PTR-LOSE
	  JRST	NXTBL4		;*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	NXTB15		;*NO, ANY ALLOCATED BLOCK IS OK
NXTB14:	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
NXTB15:	MOVE	T2,DEVLPC##(F)	;GET WORD TO TEST FOR LAST POINTER
	TLNN	T2,DEPLPC##	;LAST POINTER IN CORE?
	JRST	NXTB16		;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,NXTBL4	;YES, JUMP IF CURRENT POINTER EXHAUSTED
NXTB16:	HRRM	T1,DEVLFT##(F)	;*AND SAVE IN DDB
	MOVE	J,UDBKDB(U)	;*RIB MIGHT BE ON ANOTHER KONTROLLER
	JRST	CPOPJ1##	;*AND TAKE SKIP RETURN
;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::MOVE	T1,DEVACC##(F)
	MOVE	T1,ACCSMU##(T1)	;SIM UPDATE FILE?
	TRNN	S,IOSFA		;AND DDB WITHOUT FA (OR MON BUF)?
	TRNN	T1,ACPSMU
	JRST	EXTRB0
	PUSHJ	P,GTMNBF	;YES, GET DA BEFORE READING RIB
	PUSHJ	P,UPFA		;CAUSE ANOTHER JOB MIGHT TRY TO EXTEND RIB
EXTRB0:	PUSHJ	P,PTRCUR	;GET CURRENT RIB INTO CORE
	JUMPN	T3,CPOPJ##	;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,.USMBF	;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,.USMBF	;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)
	LDB	T3,UNYLUN##	;GET LOGICAL UNIT NUMBER
	TRO	T3,RIPNUB##	;FORM A UNIT CHANGE POINTER
	MOVEM	T3,DEVRB1##(F)	;STORE IN DDB TEMPORARILY
				; (ASSUME WE'LL GET BLOCKS ON SAME UNIT)
	PUSH	P,U		;SAVE CURRENT UNIT
	PUSHJ	P,TAKCHK	;ALLOCATE BLOCKS ANYWHERE
	  MOVEM	T3,DEVRB1##(F)	;DIFFERENT UNIT, STORE UNIT CHANGE POINTER
	POP	P,U		;RESTORE UNIT
	SKIPN	T3,DEVRB1##(F)	;DID WE GET ANY BLOCKS?
	PJRST	EXTRB3		;ERROR, COULDN'T GET THE BLOCKS
	PUSH	P,T1		;SAVE NUMBER OF BLOCKS JUST TAKEN
	MOVEM	T2,DEVRB2##(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
	HRRZ	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
	DPB	T3,DEYRBU##	;INSERT EXTENDED RIB LOGICAL UNIT NUMBER
;STILL IN FTDMRB CONDITIONAL
	MOVE	T1,.USMBF	;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,.USMBF	;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,.USMBF	;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,DEVRB1##(F)	;GET FIRST POINTER IN RIB
	MOVEM	T2,(T4)		;SAVE FIRST POINTER IN RIB
	SETZM	DEVRB1##(F)	;CLEAR THE POINTER LOCATION
	MOVE	T2,DEVRB2##(F)	;GET SAVED SECOND POINTER
	MOVEM	T2,1(T4)	;(FIRST WAS CHANGE OF UNIT POINTER)
	SETZM	DEVRB2##(F)	;FORGET SAVED POINTER
	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
	PJRST	DWNIFA		;GIVE UP FA IT WE OWN IT AND RETURN
;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
	HRRZ	U,DEVUNI##(F)
	SOS	(P)
	JRST	CNVPT1		;*SET U TO 1ST UNIT IN STR AND RETURN

CNVPT2:	HRRZ	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:	PUSHJ	P,STORU		;*SET DDB
	MOVE	J,UDBKDB(U)	;*SET UP J
	JRST	CPOPJ1##	;*AND EXIT

NEWUN3:	TRO	S,IOBKTL	;*ILLEGAL UNIT - LIGHT ERROR BIT
	JRST	STRIOS		;*SAVE S AND ERROR RETURN
;SUBROUTINE TO SET U IN DDB, SET UP DEVGEN
;RESPECTS ALL ACS
STOAU::	HLLM	U,DEVUNI##(F)	;SAVE ALL OF U IN DDB
STORU::	HRRM	U,DEVUNI##(F)	;SAVE RH OF U IN DDB
	PUSH	P,T1
	MOVE	T1,UNIGEN(U)	;CURRENT GENERATION
	HRLM	T1,DEVGEN##(F)	;INTO DDB
IFN FTMP,<
	PUSHJ	P,CPUDDB	;SET CPU SPECIFICATION
>
	JRST	TPOPJ##		;AND RETURN
;SUBROUTINE TO SET U FROM DDB
;NON-SKIP RETURN IF F/S WAS YANKED OUT, CPOPJ1 NORMALLY
;RESPECTS ALL ACS
SETU::	HRRZ	U,DEVUNI##(F)	;SET UP U
CHEKU::	TRNN	U,-1		;REALLY A UDB THERE?
	STOPCD	SETIMP,DEBUG,UDBAIZ, ;++UDB ADDRESS IS ZERO
	PUSHJ	P,TSTGEN	;GENERATION CHANGED?
	  CAIA			;YES
	JRST	CPOPJ1		;NO
IFN FTDUAL,<
	PUSHJ	P,SAVT##	;WE'LL CALL CPUDDB AT THE END
	HRRZ	T1,UNIALT(U)	;LOOKS LIKE IT, GET ALTERNATE UDB ADDRESS
	JUMPE	T1,GONEU	;IF NO ALTERNATE, UNIT WAS YANKED
	HLRZ	T2,DEVGEN##(F)	;YES.  IS OTHER UDB SAME GENERATION?
	CAME	T2,UNIGEN(T1)
	JRST	GONEU		;NO.  UNIT WAS YANKED
	EXCH	U,T1		;YES, SWITCH TO ALTERNATE UNIT
	HRLS	T1
	HRRZ	T2,T1
	XOR	T1,DEVUNI##(F)	;SWITCH DEVUNI
	TLNN	T1,-1
	HRLM	U,DEVUNI##(F)	;SWITCH UNIT OF RIB
	TRNN	T1,-1
	HRRM	U,DEVUNI##(F)	;SWITCH CURRENT UNIT
	HRRZ	T1,DEVFUN##(F)
	CAME	T1,T2
	JRST	CHEKU1
	HRRM	U,DEVFUN##(F)	;SWITCH 1ST UNIT IN DDB POINTERS
	HRRZ	T1,DEVCPY##(F)
	SKIPE	T1
	HRLM	U,PTRFUN##(T1)	;SWITCH 1ST UNIT IN IN-CORE COPY
CHEKU1:	MOVE	T1,UNIGEN(U)	;SAVE CURRENT GENERATION
	HRLM	T1,DEVGEN##(F)	; IN DDB
IFN FTMP,<
	PUSHJ	P,CPUDDB	;SET WHICH CPU'S THE DISK LIVES ON
>
	JRST	CPOPJ1##	;AND GO AWAY HAPPY
>	;END FTDUAL
;HERE IF UNIT WAS YANKED
GONEU:	HLLZS	DEVACC##(F)	;A.T. WAS RETURNED
	PJRST	SETIMP##	;SET IOIMPM AND RETURN

;ROUTINE TO TEST IF UNIT GENERATION NUMBER HAS CHANGED
;SKIP IF STILL THE SAME
TSTGEN:	PUSH	P,T1		;SAVE AN AC
	HLRZ	T1,DEVGEN##(F)	;GENERATION WE STARTED WITH
	CAME	T1,UNIGEN(U)	;SAME AS CURRENT?
	SKIPGE	DEVSWP##(F)	;OR SWAPPER?
	AOS	-1(P)		;YES
	PJRST	TPOPJ##
;SUBROUTINE TO SET UP F, MAKE JOB ADRESSABLE
;PRESERVES ALL ACS
SETF:	HRRZ	F,UNICDA(U)	;GET F FROM UDB
	JUMPE	F,CPOPJ##
	PUSH	P,J
	HRRZ	J,UNIJOB(U)	;MAKE JOB ADDRESSABLE
	PUSHJ	P,MKADD##
IFN FTDUAL,<
	CAIG	F,FYSORG+FYSSIZ ;DDB LIVE WITHIN
	CAIGE	F,FYSORG	; FUNNY SPACE?
	SKIPA			;YES, BETTER HAVE A JOB NUMBER
	JUMPE	J,SETF0		;LOW CORE DDB
	HLL	F,DINITF##
	HRRZ	J,DEVCUR##(F)
	CAIN	J,(U)		;IF DDB IS POINTING AT THIS UDB
IFE FTXMON,<
	JRST	JPOPJ##		; EVERYTHING IS FINE
>
IFN FTXMON,<
	JRST	SETF1		; EVERYTHING IS FINE
>
	CAIN	F,SWPDDB##	;MANY SWAPS CAN BE GOING ON SIMULTANEOUSLY
	SKIPL	UNICDA(U)	;UNICDA IS ONLY NEG FOR PORT DOING ACTUAL IO
SETF0:	MOVEI	F,0		; THIS IS A SPURIOUS INTERRUPT
>
IFN FTXMON,<
	SKIPE	F		;DON'T TRY TO SET PCS IF F IS BAD
SETF1:	PUSHJ	P,SPCS##	;SET PCS FROM DEVISN (DEPENDS ON STEUB TO RESTORE IT)
>
	JRST	JPOPJ##		;AND RETURN

;SUBROUTINE TO STORE F IN UDB, SET UP HUNG TIMER.
;RETURNS T3=JOB NUMBER
;PRESERVES ALL ACS EXCEPT T3
STORF:	HRRM	F,UNICDA(U)	;SAVE F
IFN FTDUAL,<
	SKIPE	T3,UNI2ND(U)	;DUAL PORTED?
	SETZM	UNIJOB(T3)	;CLEAR JOB NO ON 2ND PORT
>
	MOVEI	T3,DSKTIM##	;SET UP HUNG TIMER
	MOVEM	T3,UNITIM(U)
	LDB	T3,PJOBN##	;POINT UDB AT JOB
	MOVEM	T3,UNIJOB(U)
	POPJ	P,		;AND RETURN
;COPY POINTER TO DEVRBN OR @DEVRET
;RESPECTS T1,T2
PTSTOX:	SKIPE	@DEVRET##(F)	;"REGULAR" POINTER?
	JRST	PTSTO		;YES, DO IT THE OTHER WAY
	MOVEM	T2,DEVRB1##(F)	;NO, SAVE THE PNTR IN DEVRB1
	SETZ	T3,		;STORE IN 1ST IN-CORE PNTR SLOT
	JRST	PTSTO1

;RESPECTS T1, T2
PTSTO::	MOVEM	T2,@DEVRET##(F)	;SAVE THE POINTER IN DDB
	HRRZ	T3,DEVRET##(F)	;LOC OF CURRENT PNTR
	SUBI	T3,DEVRB1##(F)	;COMPUTE RELATIVE LOC
	SKIPL	T3		;IF RELATIVE LOC IS WRONG
	CAIL	T3,PTRLEN##	;(POINTS AT MONBUF @CLSOU3)
	POPJ	P,		; JUST RETURN
PTSTO1:	HRRZ	T4,DEVCPY##(F)	;LOC OF IN-CORE COPY
	JUMPE	T4,CPOPJ##	;GO IF NONE
	ADDI	T4,PTRDAT##(T3)	;WHERE THIS PNTR GOES
	MOVEM	T2,(T4)
	POPJ	P,

;COPY POINTERS FROM DDB TO IN-CORE COPY
;ENTER T3=DEVLPC WORD
CPZPTR::MOVE	T3,DEVLPC##(F)	;LAST POINTER IN CORE
CPYPTR::HRRZ	T1,DEVCPY##(F)	;IN-CORE COPY
	JUMPE	T1,CPOPJ##	;GO IF NONE
	HRLI	T1,DEVRB1##(F)	;POINT AT 1ST RET. POINTER IN DDB
	MOVEI	T2,(T1)
	ADDI	T1,PTRDAT##	;POINT T2 AT 1ST RET PNTR IN COPY
	BLT	T1,PTRDND##(T2)	;SAVE PNTRS IN IN-CORE COPY
CPXPTR:	HRRZ	T2,DEVCPY##(F)
	JUMPE	T2,CPOPJ##	;NOTHING TO DO IF NO IN-CORE COPY
	MOVE	T1,DEVFLR##(F)	;GET INFO FROM DDB
	MOVEM	T1,PTRFLR##(T2)	; AND SAVE IN IN THE IN-CORE COPY
	MOVE	T1,DEVRIB##(F)
	MOVEM	T1,PTRRIB##(T2)
	MOVE	T1,DEVFUN##(F)
	HRLM	T1,PTRFUN##(T2)
	LDB	T1,DEYRLC##
	TLNE	T3,DEPLPC##
	TRO	T1,PTPLPC##
	HRRM	T1,PTRRLC##(T2)
	HLRE	T1,DEVRSU##(F)
	MOVNS	T1
	DPB	T1,PTYRSU##
	POPJ	P,		;AND RETURN
	SUBTTL	FILINT  - INTERRUPT HANDLING MODULE
FILINT::HLLZ	T4,T1		;CONVERT TO NEW FORMAT ARGS
	TLZ	T4,1777
	TLZ	T1,776000
FLHTID::PUSHJ	P,SSEUB##	;SAVE UBR
	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
	MOVE	P1,KDBCHN(J)	;SET UP P1=LOC OF CHAN DB
	MOVE	P2,T4		;GET INTERRUPT BITS
	SETZM	P4		;P4 WILL KEEP THE DRIVE NUMBER
	DSKOFF			;PREVENT RACES
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	FINPS3		;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
>
	SETZM	UNITIM(U)
	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
	JRST	FINPS1		;NO,
;HERE ON AN UNSOLICITED INTERRUPT, UNIT IDLE OR OPR WAIT
FREINT:	SKIPG	KONPOS(J)	;DOES UNIT DO POSITIONING?
	STOPCD	FINPS3,DEBUG,FDP,	;++FIXED-HEAD DEVICE POSITION
	MOVSI	T2,UNPUNO	;CLEAR 'OFF-LINE' AND FILE UNSAFE BITS
	ANDCAM	T2,UNIDES(U)
IFN FTDUAL,<
	SKIPE	T3,UNI2ND(U)
	ANDCAM	T2,UNIDES(T3)
>
	CAIE	T1,OW2COD
	CAIN	T1,OWCOD
	STOPCD	.,DEBUG,NOW,	;++NO OPR WAIT (OBSOLETE)
	SKIPE	DINITF##	;IF STILL IN ONCE-ONLY
	JRST	FINPS3		; DON'T DO ANYTHING FANCY
IFN FTDUAL,<
	HRRZ	T1,(P)		;COMMUNICATION WORD
	TRZE	T1,IODTER+IODERR;IS AN ERROR UP?
	CAIE	T1,OPPOS	; AND JUST A POSITION COMPLETE?
	JRST	FREIN5		;NO, "REAL" FREE INTERRUPT
	LDB	T1,[POINT 9,(P),17];YES, DID THIS DRIVE HAVE THE ERROR?
	CAIN	T1,(P4)
	JRST	FINPS3		;YES, IT ISN'T THE INTERRUPT WE WANT
FREIN5:	SKIPE	T2,UNI2ND(U)
	SKIPN	UNILOG(T2)
>
	SKIPE	UNILOG(U)	;IS THIS PACK KNOWN TO THE SYSTEM?
	JRST	FREIN2		;YES, REREAD HOME BLOCKS
IFN FTMDA,<
	PUSHJ	P,CALMDA	;NO, TELL MOUNTABLE DEVICE ALLOCATOR
	  JRST	FREIN3		;NOT RUNNING, CONTINUE
	PUSHJ	P,SET4MD	;SET SO ONLY MDA CAN READ DRIVE
	AOJA	P4,POSTST	;AND TEST NEXT DRIVE
>
IFE FTMDA,<
	JRST	FREIN3
>
;HERE IF PACK KNOWN TO SYSTEM
FREIN2:	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
FREIN3:	PUSHJ	P,IDLEPW	;SET IDLE OR PW
	AOJA	P4,POSTST	;AND GO TEST NEXT UNIT
;HERE FOR POSITION INTERRUPT, DRIVE NOT IN S OR T STATE
FINPS1:	TRNE	T1,1		;IS UNIT CURRENTLY IN A WAIT STATE?
	JRST	FREINT		;YES, FREE INTERRUPT
IFN FTCIDSK,<
	PUSHJ	P,CIBAD		;CI CAN'T GET HERE
>
	PUSHJ	P,SETF
	JUMPE	F,FINPS3	;GO IF SPURIOUS INTERRUPT
	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
IFN FTDUAL,<
	PUSH	P,U
>
	CAIN	T1,PCOD		;IF UNIT WAS IN POSITION,
	PUSHJ	P,SETTTW	;SET FILE TO TW, OR T AND START TRANSFER
IFN FTDUAL,<
	POP	P,U		;IF WE STARTED IO ON ALTERNATE UNIT
	MOVE	J,UDBKDB(U)	;THEN U, J AND P1 WERE CHANGED
	MOVE	P1,KDBCHN(J)	;SO RESET THEM
>
FINPS3:	AOJA	P4,POSTST	;GO TEST NEXT POSITION INTERRUPT
;HERE FOR POSITION INTERRUPT, DRIVE IN TRANSFER STATE
;THIS HAPPENS ON RECALIBRATE AFTER DATA ERROR
RECALR:	PUSHJ	P,SETF		;CURRENT DDB
	JUMPE	F,FINPS3	;IGNORE IF SPURIOUS INTERRUPT
	MOVE	S,DEVIOS(F)	;S WORD (SO STARTE WILL KNOW IF READ OR WRITE)
	SKIPGE	DEVSWP##(F)	;IF THE SWAPPER
	PUSHJ	P,SWPINS##	;UMAKE SURE IO IS RIGHT
	SKIPL	T1,CHNECT(P1)	;RECALIBRATE INTERRUPT?
	JRST	RECAL1		;NO - START DATA AGAIN
	SETZM	CHNECT(P1)	;YES - REPOSITION DRIVE
	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
	MOVEI	T1,DSKTIM##	;RESET HUNG TIMER
	MOVEM	T1,UNITIM(U)
	AOJA	P4,POSTST	;GO HANDLE OTHER ATTENTION INTERRUPTS
RECAL1:	PUSHJ	P,STARTE	;START DATA TRANSFER
	AOJA	P4,POSTST	;AND TEST NEXT ATTENTION BIT

;CALLED BY KON ROUTINE WHEN A UNIT GOES OFF-LINE
;PRESERVES T1
FILDN::	MOVEI	T2,O2COD	;IF  IDLE SAY OFF-LINE, NO MESSAGE
IFN FTCIDSK,<
	SKIPL	KONMX(J)	;CAN UNIT DO MULTIPLE TRANSFERS?
>; END IFN FTCIDSK
	SKIPN	UNISTS(U)	; (IF BUSY HNGDSK WILL CATCH IT)
	MOVEM	T2,UNISTS(U)	; AND RETURN
IFE FTCIDSK,<
	POPJ	P,
>; END IFE FTCIDSK
IFN FTCIDSK,<
	JFCL	CPOPJ##		;NEUTERABLE CODE
	SKIPL	KONMX(J)	;CAN UNIT DO MULTIPLE TRANSFERS?
	POPJ	P,		;NO
	PUSHJ	P,SAVT##	;BE SUPERSTITIOUS
FILDN2:	MOVEI	T3,ACTDRB##-DRBLNK## ;GET PREDECESSOR
	DSKOFF			;PREVENT RACES
FILDN3:	HRRZ	T3,DRBLNK##(T3)	;GET LINK TO NEXT DRB
	CAIN	T3,ACTDRB##	;AT END?
	JRST	DOPOPJ		;YES, RETURN
	MOVE	T1,DRBSTS##(T3)	;NOT FILLED IN?
	TRNE	T1,DRPNFI##+DRPTRY##
	JRST	FILDN3
	HLRZ	T1,DRBCUR##(T3)	;DRB FOR THIS UNIT?
	CAIE	T1,(U)		;...
	JRST	FILDN3		;NO
	DSKON			;WE'RE RACE FREE NOW
	MOVEI	T1,KOPOFL	;LIGHT ERROR FLAG
	IORM	T1,DRBSTS##(T3)	;...
	MOVS	T1,UDBPDN(U)	;FAKE UP THINGS FOR CALL TO FLHTID
	SETZB	T2,T4		;NO UNITS HAVE POSITIONED
	PUSH	P,U		;SAVE U
	PUSHJ	P,FLHTID	;REQUEUE REQUESTS FOR THIS UNIT
	POP	P,U		;RESTORE U
	JRST	FILDN2		;LOOP THROUGH UNTIL END
>; END IFN FTCIDSK

;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
IFE FTDUAL,<
	POPJ	P,		;AND RETURN
>
IFN FTDUAL,<
	SKIPE	T2,UNI2ND(U)
	IORM	T1,UNIDES(T2)
	PJRST	SECCOD
>
;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
	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:	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:
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;#IF MULTIPLE XFERS THEN
	JRST	UUOTWX		;#DON'T SET CHAN BUSY
>
	SKIPL	KONBMX(J)	;#IF BLOCK MUX KONTROLLER DON'T SET CHAN BUSY
	AOSG	@KDBCHN(J)	;#CHAN AVAILABLE?
UUOTWX:
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,UDBKDB(T1)	;#YES, T1=UNIT  T2=KON
IFN FTMP,<
	MOVE	T3,UDBCAM(T1)	;#IS OTHER PORT ON THIS CPU?
	TDNN	T3,.CPBIT##
	JRST	SETTW0		;#NO, QUEUE REQUEST
>
	SKIPL	KONBSY(T2)	;KONTROLLER IDLE?
	AOSE	@KDBCHN(T2)	;#YES, CHAN IDLE?
	JRST	SETTW0		;CANT START IT NOW
	PUSHJ	P,STORF		;SAVE DDB IN MAIN UDB
	HRRZ	J,T2		;WE CAN START THE IO ON THE ALTERNATE UNIT
	HRRZ	U,T1		; SO SET UP NEEDED ACS
	MOVE	P1,KDBCHN(J)
UUOTWS:
>;END OF IFN FTDUAL
	PJRST	SETBS1		;#HAVE TO CHECK FOR WRITE/USETO RACE
SETTW0:	MOVEI	T1,TWCOD	;#TRANSFER WAIT STATE CODE
	DPB	T1,DEYCOD##	;MAKE DDB TW
	SKIPL	DEVSWP##(F)	;#IF THIS IS THE SWAPPER,
	JRST	SETTW1
	PUSHJ	P,IDLEPW	;#SET IDLE OR PW
	SKIPN	CHNCFS(P1)	;#DO AT LEAST ONE TRANSFER BEFORE
	AOS	CHNCFS(P1)	;# MOVING HEADS AGAIN
	JRST	DOPOPJ		;#DON'T PUT IN CHAN QUEUE (START IT AT SWPPIK ONLY)
SETTW1:	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
>
	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,UDBKDB(T2)	;IF THE ALTERNATE UNIT IS BUSY THE REQUEST
	MOVE	T1,KDBCHN(T1)
	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:	AOSA	CHNQUL(P1)	;  INCREMENT XFER QUEUE LENGTH
PUTQUE:	AOS	UNIQUL(U)
	LDB	T2,PJOBN##	;JOB NUMBER
	HRL	T2,F		;DDB
	EXCH	T2,(T1)		;MAKE THIS DDB FIRST, GET CURRENT FIRST
	MOVEM	T2,DEVQUE##(F)	;POINT THIS DDB AT FORMER FIRST
IFN FTDUAL,<
	HRRM	U,DEVCUR##(F)	;#SAVE CURRENT UNIT IN DDB
>
	DSKON			;#TURN ALL DISK PI'S BACK ON
	SCHEDULE
	POPJ	P,		;AND RETURN


;SUBROUTINE TO COMPUTE PRIORITY OF A DISK FILE
;EXIT WITH T2=PRIORITY.  RESPECTS ALL ACS EXCEPT T2
DFPRI:	LDB	T2,DEYPRI##	;INDEX=
	TRZE	T2,MINDPR	;PRIORITY NEGATIVE?
	MOVNS	T2		;YES, MAKE T2 NEGATIVE
	POPJ	P,		;AND RETURN

;ROUTINE TO CHECK THAT JOB IS IN CORE (POSSIBLY AN INTERRUPT LEVEL)
ADRINT:	LDB	T1,PJOBN##	;JOB NUMBER
	SKIPN	JBTADR##(T1)	;GET ADDRESS
	SKIPGE	DEVSWP##(F)	;NONE - SWAPPER
	POPJ	P,		;JOB IN CORE OR SWAPPER
	SKIPE	DEVRHB##(F)	;REREADING HOME BLOCKS?
	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::
IFN FTDUAL,<
	HRRM	U,DEVCUR##(F)	;#SAVE CURRENT UNIT IN DDB
>
	SKIPL	KONDRB(J)	;#NEED AN IORB?
	JRST	STRTI9		;#NO
	PUSHJ	P,GETDRB	;#YES, ALLOCATE ONE
	  POPJ	P,		;#NONE LEFT
	MOVEM	T1,DEVDRB##(F)	;#SAVE ADDR OF IORB
IFN FTCIDSK,<
	SKIPL	KONMX(J)	;#MULTI XFERS?
	JRST	STRTIA		;#NO
	MOVEI	T1,TCOD		;#SET DDB TO TRANSFER
	DPB	T1,DEYCOD##
	JRST	STRTI8		;#DON'T SET UNISTS
>; END IFN FTCIDSK
IFE FTCIDSK,<
	JRST	STRTIA		;#DON'T CLEAR DEVDRB
>; END IFE FTCISK
STRTI9:	SKIPL	DEVSWP##(F)
	SETZM	DEVDRB##(F)	;#NO IORB
STRTIA:	MOVSI	T1,KOPBSY	;#SET KONTROL BUSY
	SKIPL	KONBMX(J)	;#UNLESS BLOCK MULTIPLEX KONTROLLER
	IORM	T1,KONBSY(J)
	MOVEI	T1,TCOD		;#SET FILE AND UNIT TO TCOD
	PUSHJ	P,FILCOD
IFN FTDUAL,<
	PUSHJ	P,SECCOD	;#MAKE OTHER UNIT STATE = THIS ONE
>
STRTI8:	PUSHJ	P,SETPAR	;#SET KONCUA,UNICDA,UNIBLK
	PUSHJ	P,DRSAVE	;#SAVE VOLATILE STUFF IN IORB
	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 FTKS10,<
	TLNN	S,IO		;SINCE KS HAS WRITE-THRU CACHE, NO NEED TO-
>
	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
	IORM	T1,UNIECT(U)	; TO INDICATE NO ERRORS YET
	MOVSI	T1,UNPHNG!UNPECC ;CLEAR THE HUNG AND ECC BITS TO INSURE WE
	ANDCAM	T1,UNIECT(U)	; DON'T REPORT INFINITE HANGS OR THINK AN
				; ECC-CORRECTABLE ERROR WAS SEEN DURING RETRY
	JUMPL	S,STARTE	;NO CHECKSUMS IF MONITOR IO
	TLNE	S,IO		;DATA - READING?
	TLZN	S,IOSFIR	;WRITING DATA - CHECKSUM TIME?
	JRST	STARTE		;NO
	PUSHJ	P,STORS7##	;YES, SAVE S IN DDB
	PUSHJ	P,CHKSUM	;COMPUTE CHECKSUM
	HRRZ	T2,DEVCPY##(F)
	JUMPE	T2,STRTI1	;GO IF NO IN-CORE COPY
	HRRZ	T3,DEVRET##(F)	;HAS AN IN-CORE COPY, COMPUTE
	SUBI	T3,DEVRB1##(F)	; RELATIVE LOCATION OF CURRENT POINTER
	SKIPN	@DEVRET##(F)	;SINCE THE CHECKSUM MIGHT HAVE
	SETZ	T3,		; HAVE CHANGED FROM ANOTHER WRITER,AND THE
	ADDI	T3,PTRDAT##(T2)	; DDB-COPY WASN'T CHANGED, WE NEED TO LOOK AT
	MOVE	T2,(T3)		; THE IN-CORE COPY FOR THE REAL THING
	JRST	STRTI2
STRTI1:	SKIPN	T2,@DEVRET##(F)	;GET RETRIEVAL PNTR
	MOVE	T2,DEVRB1##(F)	;JUST 1 PNTR IN DDB, STORED IN DEVRB1
STRTI2:	HRRZ	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
	PUSHJ	P,PTSTOX	;SAVE POINTER BACK OVER OLD (DEVRB1 OR @DEVRET)
	HRRZ	T1,DEVACC##(F)	;ACCESS TABLE
	MOVE	T3,DEVREL##(F)	;RELATIVE BLOCK OF FILE
	SOJN	T3,STRTI3	;IF 1ST BLOCK,
	MOVEM	T2,ACCPT1##(T1)	; SO ANOTHER JOB CAN READ THIS FILE (UPDATE)
STRTI3:	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
	IORM	T4,ACCSBC##(T1)	; WON'T GET SPURIOUS CHECKSUM ERRORS
	PUSHJ	P,RBCHD		;RIB HAS CHANGED

;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 IN-CORE COPIES
	MOVE	T1,DEVACC##(F)
	LDB	T3,ACYWCT##	;IF WE'RE THE ONLY WRITER,
	SOJLE	T3,STARTE	; FORGET IT
	PUSHJ	P,.+2		;SO CAN CALL SAVE3 WITHOUT PDL OV
	JRST	STARTE		;NO GO START THE IO
	PUSHJ	P,SAVE3##
	MOVE	P1,T2		;P1 = NEW POINTER
	LDB	P3,UNYLUN##
	TRO	P3,RIPNUB##	;P3 = NEEDED UNIT-CHANGE PTR
	HRRZ	T3,UNISTR(U)	;SET UP A MASK FOR PNTR ADDRESSES
	SETO	T2,
	LDB	P2,STYCLP##(T3)
	PUSHJ	P,FNDDDB	;FIND A WRITING DDB
	  POPJ	P,		;NONE THERE (SYSTEM ERROR?)
				;FALL INTO STRTI4
;HERE WHEN WE FOUND A WRITING DDB
STRTI4:	HLRZ	T1,PTRFUN##(T2)	;GET 1ST UNIT IN FOUND DDB
	LDB	T4,UNYLN1##	;FAKE UP A UNIT CHANGE POINTER
	TRO	T4,RIPNUB##	; FOR THIS WRITING DDB

;HERE WHEN WE FOUND A WRITING DDB
	MOVEI	T1,PTRDAT##(T2)	;SET A POINTER FOR THE
	HRLI	T1,MPTRLN##	;RETRIEVAL PNTRS OF FOUND DDB
STRTI5:	SKIPN	T3,(T1)		;GET A RET PNTR FROM THE DDB
	JRST	STRTI6
	TLNN	T3,-1		;UNIT-CHANGE?
	MOVE	T4,T3		;YES
	XOR	T3,P1		;DOES IT MATCH NEW PNTR?
	CAMN	T4,P3		;RIGHT UNIT?
	TDNE	T3,P2
	JRST	STRTI6		;NO, TRY NEXT PNTR
	MOVEM	P1,(T1)		;IN THE FOUND DDB
	JRST	STRTI7		;AND TEST FOR ANOTHER WRITER
STRTI6:	AOBJN	T1,STRTI5	;TES NEXT PNTR IN FOUND DDB
STRTI7:	HRRZ	T1,DEVACC##(F)	;RESET T1 FOR FNDDDN
	PUSHJ	P,FNDDDN	;LOOK FOR ANOTHER WRITER
	  POPJ	P,		;NONE THERE, DONE
	JRST	STRTI4		;FOUND ONE, LOOK FOR PNTR IN THIS DDB
STARTE:	MOVE	T1,DEVDRB##(F)	;GET DRB
;HERE WITH T1=DRB
STARTG:	MOVEI	T3,KONRDS(J)	;SET TO READ - STOP ON ERROR FOR F.S.
				; ALL BUT LAST TRY SO KNOW BAD BLOCK+WORD
	TLNE	S,IO
	MOVEI	T3,KONWTS(J)	; WRITE DATA - STOP ON ERROR FOR F.S.
				; ALL BUT LAST TRY SO KNOW BAD BLOCK+WORD
	TLNN	S,IOSUPR	;SUPER I/O MODE?
	JRST	STARTF		;NO, START THE IO
	TRNE	S,UDSX		;YES, READ/WRITE HEADERS AND DATA?
	AOJA	T3,STARTF	;YES, RDF/WTF = RDS/WTS +1
	MOVSI	T2,DEPCPT##	;NO, COMPATABILITY MODE?
	TDNE	T2,DEVCPT##(F)
	ADDI	T3,KONRDC-KONRDS ;YES, ENTRY POINT = RDS(WTS)+2

STARTF:	PUSHJ	P,STORS7##	;STORE S
	DSKOFF			;MAKE SURE NO INTERRUPTS HAPPEN
	PUSHJ	P,DRRST		;#RESTORE VOLATILE STUFF
IFN FTCIDSK,<
	MOVEI	T2,4*DSKTIM##	;#SET HUNG TIMER
	SKIPE	T1		;#NOT IF THERE ISN'T A DRB
	MOVEM	T2,DRBTIM##(T1)
>; END IFN FTCIDSK
	PUSH	P,T1		;#SAVE DRB
	MOVEI	T2,DSKTIM##	;RESET HUNG TIMER
	MOVEM	T2,UNITIM(U)
	PUSHJ	P,@(T3)		;#START READ OR WRITE
	  JRST	BADUNC		;#UNIT NOT OK
	POP	P,T1		;#PRUNE STACK
	MOVS	T2,UNIECT(U)
	CAIE	T2,UNPFIR+UNPHNG ;BUSY ON WHEN WE STARTED
	PJRST	DOPOPJ
	PUSHJ	P,FSTREG	;YES, COPY REGS TO UDB
	MOVE	T1,[.FIBOS,,.ERDPE] ;FILIO-DETECTED "BUSY ON WHEN STARTED"
	PUSHJ	P,DAEERR##	;TELL DAEMON
	MOVE	J,UDBKDB(U)
	PJRST	DOPOPJ

;ROUTINE TO SET THE UNIT EITHER IDLE OR POSITION WAIT
;DEPENDING ON THE VALUE OF UNIQUE
;CLOBBERS T1 AND T2
IDLEPW::
IFN FTDUAL,<
	SKIPE	T1,UNI2ND(U)	;#POSITIONS WAITING ON EITHER PORT?
	SKIPN	UNIQUE(T1)
>
	SKIPE	T1,UNIQUE(U)
	MOVEI	T1,PWCOD	;#YES, SET TO PW
	MOVEM	T1,UNISTS(U)	;#NO, SET IDLE
IFN FTDUAL,<
	PUSHJ	P,SECCOD	;#SET BOTH PORTS
>
	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

;HERE TO STORE THE STATUS IN BOTH PORTS
;T1 PASSES THE STATUS
BTHSTS::MOVEM	T1,UNISTS(U)	;PRIME PORT
IFN FTDUAL,<
;ROUTINE TO SET 2ND UNIT'S STATE CODE = THIS UNIT'S
SECCOD::MOVSI	T1,U2PPGA	;2ND PORT DISAPPEAR FROM UNDER US?
	TDNN	T1,UNIDS2(U)	; IF SO LEAVE 2ND PORT UNISTS ALONE
	SKIPN	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 CALL WHEN RIB HAS CHANGED
;SETS BIT IN DDB, CALLS PSISER IF ENABLED
;PRESERVES ALL ACS EXCEPT T1
RBCHD:	MOVSI	T1,DEPRHC##	;INDICATE RIB HAS CHANGED
	IORM	T1,DEVRRC##(F)
	MOVEI	T1,IR.RHC	;SIGNAL-BIT FOR PSISER
	TSNE	T1,DEVPSI(F)	;DOES HE WANT THE PSI?
	PJRST	PSIDVB##	;YES, LET PSISER TELL HIM
	POPJ	P,
;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 @KDBICP(J)
SETLST:	PUSHJ	P,NXTBLK	;GET NEXT BLOCK OF FILE
	  STOPCD .,JOB,BWA,	;++BLOCK WENT AWAY
	PUSHJ	P,SAVE4##	;YES, SAVE P1-P4
	HRROI	P3,(P1)		;TELL MAPIO TO STORE EXPECTED TERM WD
	SETZB	P1,P2		;P1=FREE CORE LOC
	PUSH	P,U		;SAVE U
	PUSH	P,W
	PUSH	P,R
	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)
IFN FTCIDSK,<
	LDB	T3,UNYKTP##	;GET KONTROLLER TYPE
	CAIN	T3,TYPRA	;IS IT AN HSC CONTROLLER?
	MOVEI	T1,^D50		;YES, LIMIT MAXIMUM TRANSFER SIZE TO APPROX.
				; ONE-FOURTH OF TOTAL NUMBER OF BSDS IN KLPSER
>; END IFN FTCIDSK
	HRRZ	T3,DEVLFT##(F)	;NO OF BLOCKS LEFT IN CURRENT GROUP
IFN FTKL10,<
	MOVE	T2,CHNTYP(P3)
	TLNE	T2,CP.RH2	;RH20?
	CAIG	T1,1777		;YES. MAX TRANSFER=1777 BLOCKS
	CAIA			; (10 BITS IN PTCR)
	MOVEI	T1,1777		;TOO BIG, REDUCE IT
>
	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	SETLS1		;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
SETLS1:	JUMPL	S,SETDMP	;SAME AS DUMP IF MONITOR MODE
	LDB	T1,PIOMOD##
	CAIL	T1,SD		;NO, DUMP MODE?
	JRST	SETDMP		;YES
	TLNE	S,IO		;READING?
	SKIPA	T2,DEVOAD(F)	;NO
	MOVE	T2,DEVIAD(F)	;YES
	HRRZS	T2		;ZERO LEFT HALF STUFF
	EXCTUX	<HLRZ T2,(T2)>	;GET BUFFER LENGTH
	TRZ	T2,400177	;CLEAR EXTRANEOUS BITS
	SKIPE	T2
	CAILE	T2,LIMBBW##	;BUFFER TOO LARGE?
	SETZ	T3,		;YES, DON'T DO ANYTHING
	HRLZ	W,T2		;SAVE BUFFER SIZE IN LH(W)
	MOVN	U,W		;WILL USE FOR PROTECTION CHECK
	LSH	T2,MBKLSH##	;COMPUTE NO OF BLOCKS PER BUFFER
	HRR	W,T2		;W=WDS/BUF,,BLOCKS/BUF
	DPB	T2,DEYNBB##	;SAVE FOR BUFAD
IFN FTKL10&FTMP,<
	TLNN	S,IO		;IF READING
	JRST	SETLS2		; DO AS MUCH AS POSSIBLE
	PUSHJ	P,CHKNB##
	HLRZ	T1,DEVNBF(F)	;NO OF BUFS SWEPT FOR
	IMULI	T1,(W)
	TLNN	S,IOSPBF	;PARTIAL BUFFER?
	JRST	SETLS0		;NO
	HRRZ	T2,DEVOAD(F)	;YES, GET NUMBER BLOCKS SO FAR
	EXCTUX	<HLRZ T2,1(T2)>
	LSH	T2,MBKLSH
	CAIL	T2,(W)		;PARANOIA
	SETZB	T3,T2
	SUB	T1,T2		;DON'T COUNT THESE BLOCKS
SETLS0:	CAMLE	T3,T1		;DONT LOOK AT BUFFERS WHICH
	MOVE	T3,T1		; HAVENT BEEN SWEPT BACK TO MEMORY
SETLS2:>
				;FALL INTO NEXT PAGE
	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
	HLL	T2,U
	LDB	T3,PJOBN##	;JOB NUMBER
	ADD	U,JBTADR##(T3)	;SET U TO USERS PROTECTION - BUFFER SIZE
	HLRZS	U		;IN RH FOR PROTECTION CHECK
	MOVEI	T3,1(T2)	;STARTING BUFFER LOC
	HRLM	T3,DEVUVA##(F)	;SAVE UVA-1 OF CHKSUM WORD
	SUBI	T3,1
	SETZB	T4,R		;T4 COUNTS NUMBER OF BUFFERS, R USED IN PARTIALS
	DPB	T4,DEYNB1##	;ASSUME WE START AT 1ST WORD IN BUFFER
	JUMPE	T1,SETLS9	;GET OUT QUICKLY IF BUFFERS ARE TOO LARGE
SETLS3:	PUSH	P,T1		;SAVE AOBJN POINTER
	HRRZ	T1,T2
	PUSHJ	P,IADRCK##	;BUFFER LEAGAL?
	  JFCL			;NO, UUOCON CAN GIVE ADDRESS CHECK
	  JRST	[POP P,T1	;PAGED OUT, LET UUOCON BRING IT IN
		 JRST SETLS9]
	POP	P,T1		;RESTORE T1
	PUSHJ	P,TSTBUF	;MAKE SURE ENTIRE BUFFER IS IN CORE
	  JRST	SETLS9		;PAGE FAILURE WILL OCCURR, TERMINATE THE IO LIST
	TLNN	S,IO
	JRST	SETLS4
	EXCTUX	<SKIPL (T2)>	;WRITING - IS NEXT BUFFER FULL?
	JRST	SETLS8		;NO, DONE
	JRST	SETLS5		;YES. SET IOWORD FOR BUFFER
SETLS4:
IFE FTKL10&FTMP,<
	EXCTUX	<SKIPG (T2)>	;READING - IS NEXT BUFFER FREE?
	JRST	SETLS8		;NO. DONE
>
IFN FTKL10&FTMP,<
	EXCTUX	<SKIPL (T2)>	;IS NEXT BUFFER FREE?
	PUSHJ	P,[PUSHJ P,SAVT## ;AND OK WITH RESPECT TO CACHE?
		   HRRZ T1,T2
                   PJRST BUFSSN##]
          JRST	SETLS8		;NO DON'T DO ANY MORE BUFFERS
>
SETLS5:	ADDI	T2,1		;INCREMENT BY 1 FOR WORDCOUNT WORD
	HRRZ	P4,W		;BLOCKS PER BUFFER
	TLZN	S,IOSPBF	;PARTIAL BUFFER WE STARTED BEFORE?
	JRST	SETLS6		;NO
	EXCTUX	<HRLZ R,(T2)>	;YES, GET PARTIAL WORDCOUNT
	TLNE	S,IO		;IF WRITING,
	EXCTUX	<HLLZ R,(T2)>	; GET PARTIAL WORDCOUNT ALREADY DONE
	TLNE	S,IOSFIR	;CHECKSUM BLOCK?
	ADDM	R,DEVUVA##(F)	;YES, POINT AT 1ST WORD OF THIS BLOCK
	LSH	R,-^D18-BLKLSH##;CONVERT TO BLOCKS ALREADY DONE
	SUB	P4,R		;ADJUST NO OF BLOCKS TO DO BY PART ALREADY DONE
	DPB	R,DEYNB1##	;SAVE STARTING BLOCK OF THE BUFFER
	LSH	R,BLKLSH##	;NO OF WORDS TO DO IN THIS BUFFER
	HRLS	R
	ADD	T2,R		;ADJUST IOWD FOR PART ALREADY DONE
SETLS6:	HRLS	P4		;BLOCKS DONE IN BOTH HALVES
	ADDB	T1,P4		;COMPUTE NO BLOCKS LEFT,,NO DONE
	JUMPL	T1,SETLS7	;GO IF WE CAN DO THE ENTIRE BUFFER
	TLNN	T1,-1		;EXACT FIT?
	JRST	SETLS7		;YES, CAN DO THE WHOLE BUFFER
	HLRS	P4		;NO OF BLOCKS WE CAN'T DO IN BOTH HALVES
	SUB	T1,P4		;MAKE T1=0,,NO WE'RE DOING
	HLLZS	P4		;LH
	LSH	P4,BLKLSH##	;NO OF WORDS WE CAN'T DO
	ADD	T2,P4		;ADJUST IOWD BY THAT AMOUNT
	SUB	W,P4		;NO OF WORDS WE WILL DO IN LH(W)
	ADD	T4,[1,,0]	;ACCOUNT FOR SUB A LITTLE LATER
	TLO	S,IOSPBF	;INDICATE A PARTIAL BUFFER
SETLS7:	MOVEI	P4,0		;NO FRAME-COUNT
	PUSHJ	P,MAPIO##	; STORE THE IOWD IN FREE-CORE
	  JRST	PUNTB		;NOT ENOUGH MONITOR FREE-CORE
	SUB	T2,R		;RESET T2 FOR A WHOLE BUFFER IF ENDING A PARTIAL
	TLNN	S,IO		;IF READING
	EXCTXU	<HLRZM W,(T2)>	; SAVE WDCNT IN BUFFER WORD 0
	TLNE	S,IO		;IF WRITING
	EXCTUU	<HLLM W,(T2)>	; SAVE AMOUNT DONE SO FAR IN LH OF WORD 0
	SUB	T4,[1,,0]	;COUNT A BUFFER
IFN FTKS10,<
	SETZ	R,		;NOT ENDING A PARTIAL NOW
	JRST	SETLS9		;ONE BLOCK AT A TIME FOR KS10
>
	PUSH	P,T1
	MOVEI	T1,-1(T2)	;WHAT TO OUCHE
	EXCTUX	<HRR T2,-1(T2)>	;STEP TO NEXT BUFFER
	JUMPN	R,[SETZ	R,	;NOT ENDING A PARTIAL NOW
		   IFN FTKL10&FTMP,<
		   PUSHJ P,OUCHE## ;GET OUT OF CACHE SINCE WON'T BE IN IOWD LIST
		   ADDI T1,1	;POINT AT NEXT WORD
		   TRNN T1,3	;IN THE SAME CACHE LINE?
		   PUSHJ P,OUCHE## ;NO, GET IT OUT OF THE CACHE AS WELL
		   >
		   JRST	.+1]	;AND CONTINUE
	POP	P,T1		;RESTORE T1
	CAIE	T3,(T2)		;BACK TO THE BUFFER WE STARTED AT?
	TRNE	S,IOCON		;OR DISCONTINUOUS MODE?
	JRST	SETLS9		;YES, IOWDS ARE ALL SET
	JUMPL	T1,SETLS3	;DO ANOTHER IF STILL HAVE BLOCKS AVAILABLE
				;ALL SET, FALL INTO SETLS9
;HERE WHEN THE IOLIST IS COMPLETELY SET UP
SETLS8:
IFN FTKL10&FTMP,<
	EXCH	T1,T2		;WE'VE TOUCHED THE T2-BUFFER,
	PUSHJ	P,OUCHE##	; WONT GET IT OUT OF CACHE BELOW,
	MOVE	T1,T2		; SO REMOVE IT FROM CACHE NOW
>
SETLS9:
IFN FTKL10&FTMP,<
	LDB	T3,PIOMOD
	TLNE	S,IO		;IF WRITING
	CAIL	T3,SD		;IN NON-DUMP MODE
	JRST	SETL10
	ADDM	T4,DEVNBF(F)	;UPDATE DEVNBF BY NO OF BUFFERS WE'RE ABOUT TO DO
>
SETL10:	MOVEM	T2,KONCNT(J)	;SAVE ACTUAL WRDCNT IF DUMP-MODE
	HRRZS	P2		;JUST ADDRESS (DF10-STYLE JUMP)
IFN FTKL10,<
	JUMPE	P2,SETL11	;ALL ZERO IF NO IOWDS
	MOVE	T2,CHNTYP(P3)	;RH20?
	TLNE	T2,CP.RH2
	TLO	P2,(INSVL.(.CCJMP,CC.OPC)) ;YES, MAKE IT THAT FLAVOR OF JUMP
>
SETL11:
IFE FTKS10,<
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	SKIPN	T2,DEVDRB##(F)	;MAYBE, DO WE?
	SKIPA	T2,KDBICP(J)	;NO, PUT IN KDB
	ADDI	T2,DRBPRG##	;YES, PUT IN DRB
	MOVEM	P2,(T2)		;STORE ICCW
>
	SKIPGE	DEVSWP##(F)	;SWAPPER?
	JRST	SETL12		;YES, THIS ALREADY FIXED THINGS
IFN FTKL10,<
	TLNE	P2,-1		;RH20?
	PUSHJ	P,RH2ND##	;YES, FINISH THE LIST
>
	SKIPE	DINITF##	;IN ONCE-ONLY?
	JRST	SETL12		;YES, ONLY COUNT DURING TIMESHARING
	HRRZS	T1
	TLNN	S,IO
	ADDM	T1,.CPFBI##	;UPDATE TOTAL FILE BLOCKS TRANSFERRED
	TLNE	S,IO
	ADDM	T1,.CPFBO##
SETL12:	MOVE	P1,P3		;RESET CHN ADDRESS
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	SKIPN	T2,DEVDRB##(F)	;MAYBE, DO WE?
	MOVEI	T2,CHNNUM-DRBNUM##(P1) ;NO, PUT IN CHN
	HRRZM	T1,DRBNUM##(T2)	;YES, PUT IN DRB
	POP	P,R
	POP	P,W
IFN FTKL10&FTMP,<
	JUMPE	P2,UPOPJ##	;DONE IF NO LIST
SETL15:	SKIPN	T1,(P2)		;GET NEXT IOWD
	JRST	UPOPJ##		;DONE IF 0
	TLNN	T1,577777	;IS IT A GOTO?
	JRST	[HRR P2,T1	;YES, POINT AT WHERE IT GOES
		 JRST SETL15]	;AND GO TEST THAT IOWD
	TLNN	P2,-1		;POINT T1 AT 1ST DATA LOC -2
	SOSA	T1		; (POINTER TO NEXT BUFFER)
	SUBI	T1,2		;GET THAT LOC OUT OF THE CACHE
	PUSHJ	P,OUCHE##	;SINCE WE WONT SWEEP WE MUST CLEAR VALID BIT
	ADDI	T1,1		;POINT AT WORDCOUNT WORD
	TRNN	T1,3		;IN SAME LINE AS POINTER?
	PUSHJ	P,OUCHE##	;NO, GET RID OF THAT LINE TOO
	AOJA	P2,SETL15	; FOR THAT CACHE LINE
>
IFE FTKL10&FTMP,<
	JRST	UPOPJ##		;EASY IF THERE ISN'T A CACHE TO CLEAR
>

;SUBROUTINE TO TEST IF THE ENTIRE BUFFER IS IN CORE
;RETURNS CPOPJ IF NOT, CPOPJ1 IF ALL IN CORE
;PRESERVES ALL ACS
TSTBUF:	PUSHJ	P,SAVT##	;SAVE ACS
	MOVEI	T1,-1(T2)	;START OF BUFFER
	HLR	T3,W		;SIZE OF BUFFER
	ADDI	T2,1(T3)	;TOP OF BUFFER
	TRO	T1,PG.BDY-1	;TOP OF PAGE
TSTBU1:	PUSHJ	P,FLTST##	;PAGE THERE?
	  POPJ	P,		;NO, NON-SKIP RETURN
	PUSHJ	P,CHKWLP##	;ALSO MAKE SURE ITS WRITE ENABLED
	CAIL	T1,(T2)		;PAST TOP OF BUFFER?
	JRST	CPOPJ1##

	ADDI	T1,PAGSIZ	;NO, STEP TO NEXT PAGE
	JRST	TSTBU1		;ENSURE THIS PAGE IS THERE TOO

;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:	SKIPGE	DEVSWP##(F)	;IS IT THE SWAPPER?
	JRST	SETSWP		;YES, DO IT DIFFERENTLY
	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,SETDM1	;0 IS OK
	TDC	S,[IOSUPR,,UDSX]
	TDCN	S,[IOSUPR,,UDSX]	;FORMATTING?
	JRST	SETDM1		;YES, ASSUME HE REALLY KNOWS

	CAMLE	T1,T2		;MORE REQUESTED THAN IN GROUP?
	MOVE	T1,T2		;YES, TAKE LESSER AMOUNT
SETDM1:	LSH	T1,BLKLSH##	;CONVERT BACK TO WORDS
	MOVNM	T1,T3		;SAVE N
	MOVE	T2,DEVDMP##(F)	;CURRENT IOWD
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	SKIPN	P4,DEVDRB##(F)	;MAYBE, DO WE?
	MOVEI	P4,KONDMP-DRBDMP##(J) ;NO, PUT IT KDB
	SKIPN	DINITF##	;IF NOT IN ONCE-ONLY,
	MOVEM	T2,DRBDMP##(P4)	;SAVE IOWD IN KDB
	HLL	T2,T3		;SET LH OF IOWD
	MOVEI	P4,0		;NO FRAME COUNT
	PUSHJ	P,MAPIO##	;SAVE THE IOWD IN FREE-CORE
	  JRST	PUNTD		;NOT ENOUGH FREE CORE
SETDM2:	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	T1,BLKSIZ##-1	;EVEN NUMBER OF WRDS FOR BLOCK?
	TLNN	S,IO		;NO. WRITING?
	JRST	SETDM3		;NO. OK
	LDB	T2,UNYKTP##	;TYPE OF KONTROLLER
	CAIE	T2,TYPDP	;DOES KONTROL ZERO-FILL TO END OF BLOCK?
	CAIN	T2,TYPRP	;...
	JRST	SETDM3		;YES
IFN FTCIDSK,<
	CAIE	T2,TYPRA	;...
>; END IFN FTCIDSK
	CAIN	T2,TYPRN	;...
	JRST	SETDM3		;YES
;*** I BELIEVE THERE IS A PROBLEM WITH USING THE MONITOR BUFFER HERE.
;*** IT LOOKS LIKE THE CLOSE CODE MIGHT EXPECT THE RIB TO STAY IN THE
;*** MONITOR BUFFER EVEN THOUGH IOSRIB ISN'T LIT.  STILL CHECKING - JAD
	PUSHJ	P,SETDM4	;DO THE ZERO-FILL BY HAND
	  JRST	PUNTD
SETDM3:	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
	DPB	T1,DEYNBB##	;TELL DIRSCN HOW MANY BLOCKS WE ACTUALLY READ
	AOJA	T4,SETL10	;ZERO IOLIST+1, SET CHNNUM AND RETURN

;HERE TO DO ZERO-FILL BY HAND

SETDM4:	LDB	T3,[POINT 7,T1,17] ;GET PARTIAL-BLOCK WORD COUNT
	MOVSS	T3		;IN LH
	ADD	T3,[XWD MBLKSZ##,0]	;-NO OF WDS LEFT
	HRRZ	T2,.USMBF	;MAKE AN IOWD FOR 0'S
	ADD	T2,T3
	TLO	S,IOSMON	;SO MAPIO WON'T UNRELOCATE THE IOWD
	PUSH	P,DEVISN(F)
	SETZM	DEVISN(F)	;SO DON'T CHECK MON BUF IN SECT 3 ETC.
	PUSHJ	P,MAPIO##	;SAVE IT
	  SOS	-1(P)
	TLZ	S,IOSMON
	POP	P,DEVISN(F)	;RESTORE DEVISN
	MOVE	T2,.USMBF	;NOW ZERO THE MONITOR BUFFER
	MOVEI	T3,1(T2)
	HRLI	T3,1(T3)
	SETZM	(T3)
	MOVSS	T3
	BLT	T3,BLKSIZ##(T2)
	JRST	CPOPJ1##	;RETURN


;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)
	MOVE	J,UDBKDB(U)	;THIS CLOBBERS J
	JRST	SETL10		;GO FINISH UP THE IO LIST STUFF
;HERE WHEN NO MONITOR FREE-CORE LEFT
PUNTB:	MOVE	P4,T2		;SAVE ORIGINAL IOWD SO WE CAN STORE WORD COUNT
	TLZA	P2,400000	;CLEAR FLAG AND SKIP
PUNTD:	TLO	P2,400000	;SET FLAG TO INDICATE DUMP MODE ENTRY
	JUMPE	P1,PUNTXX	;NO FREE-CORE IF 0
IFE FTKS10,<
	PUSH	P,T4		;SAVE COUNT OF BUFFERS WE THOUGHT WE DID
	SETZB	T1,T4		;T1 ACCUMULATES WORDCOUNT
	HLLZ	T4,CHNTYP(P3)	;SET T4 FOR TYPE OF CHANNEL
	TLNN	T4,CP.RH2!CP.KLP ;T4=2 FOR RH20
	TDZA	T4,T4		;SET T4=0 FOR DF10C-STYLE CHANNEL
	MOVEI	T4,2		;SET T4=2 FOR RH20

	SKIPA	T3,P2		;START AT BEGINING OF IOLIST
PUNTE:	HRR	T3,(T3)		;PICK UP ADDR OF GOTO WORD
PUNTF:	SKIPN	T2,(T3)		;END?
	JRST	PUNTG		;YES
	LDB	T2,CNTPT3##(T4)
	JUMPE	T2,PUNTE	;GOTO IF 0
	CAIE	T4,2		;RH20?
	TDOA	T2,CNTFIL##	;NO, MAKE IT "REAL"
	MOVNS	T2		;YES, MAKE IT NEGATIVE
	SUB	T1,T2		;ACCUMULATE WORDCOUNT
	AOJA	T3,PUNTF	;AND TRY NEXT
PUNTG:	HRLZS	T1		;PUT WORDCOUNT WHERE SETDMP NEEDS IT
	TLNN	T1,BLKSIZ##-1	;SKIP IF NOT AN INTEGRAL NUMBER OF BLOCKS
	JRST	PUNTX		;WE GOT LUCKY TODAY

;AT THIS POINT P1 POINTS AT THE 4TH WORD OF A FOUR WORD BLOCK, WHICH WILL
;CONTAIN ZERO (SINCE THE LINK WORD TO THE NEXT FOUR WORD BLOCK WOULD HAVE
;GONE THERE, AND THERE WERE NO MORE FOUR WORD BLOCKS).  WE CAN SAFELY BACK
;UP 2 WORDS TO FLUSH THE LAST PARTIAL BLOCK FROM THE IO LIST.  WE CAN
;TRUST THE LAST PARTIAL BLOCK WILL NOT SPAN MORE THAN 2 IOWDS SINCE THE
;USER'S IOWD (OR BUFFER) CAN'T CROSS MORE THAN 1 PAGE BOUNDARY.

	LDB	T3,[POINT 7,T1,17] ;PICK UP THE NUMBER OF WORDS TO DROP
	MOVNS	T3		;MAKE IT NEGATIVE
PUNTH:	SUB	P1,[XWD 1,1]	;POINT AT THE LAST VALID IOWD STORED
	LDB	T2,WDCPNT##(T4)	;GET THE WORD COUNT
	CAIE	T4,2		;RH20?
	TDOA	T2,CNTFIL##	;NO, SMEAR IN THE BITS TO MAKE COUNT -VE
	MOVNS	T2		;YES, NEGATE THE +VE COUNT
	CAMN	T2,T3		;DROPPING THE WHOLE IOWD?
	JRST	PUNTJ		;YES
	CAML	T3,T2		;MORE WORDS TO DROP THAN IOWD CONTAINS?
	JRST	PUNTI		;NO
	SETZM	(P1)		;THIS IOWD IS NOW USELESS
	SUB	T3,T2		;BACK OFF BY NUMBER OF WORDS IN THAT IOWD
	ADDM	T2,CHNTCW(P3)	;ADJUST COUNT HERE ALSO
	JRST	PUNTH		;BACK UP AND HANDLE PREVIOUS IOWD

PUNTI:	SUB	T2,T3		;REDUCE THE IOWD
	CAIN	T4,2		;RH20?
	MOVNS	T2		;YES, MAKE IT POSITIVE AGAIN
	DPB	T2,WDCPNT##(T4)	;STORE WORD COUNT BACK
	ADD	P1,[XWD 1,1]	;POINT AT FIRST UNUSED WORD
	JRST	PUNTK		;QUIT

;THE LAST IOWD CONTAINED THE PARTIAL BLOCK, WE CAN ZAP THE ENTIRE IOWD

PUNTJ:	SETZM	(P1)		;ZOT IT OUT
PUNTK:	ADDM	T3,CHNTCW(P3)	;MAKE WORD COUNT HERE REFLECT OUR DAMAGE
	TLZ	T1,BLKSIZ##-1	;FIX WORDCOUNT TO REFLECT REALITY
PUNTX:	POP	P,T4		;RESTORE NUMBER OF BUFFERS DONE
	TLZE	P2,400000	;CLEAR FLAG, WAS THIS DUMP MODE?
	JRST	SETDM2		;YES, FIX IOLIST AND START IO
	LSH	T1,-BLKLSH##-^D18 ;CONVERT TO BLOCK COUNT
	MOVE	T2,P4		;GET ORIGINAL IOWD BACK
	SUB	T2,R		;RESET T2 FOR A WHOLE BUFFER IF ENDING PARTIAL
	TLNN	S,IO		;IF READING
	EXCTXU	<HLRZM W,(T2)>	; SAVE WDCNT IN BUFFER WORD 0
	TLNE	S,IO		;IF WRITING
	EXCTUU	<HLLM W,(T2)>	; SAVE AMOUNT DONE SO FAR IN LH OF WORD 0
	JRST	SETLS8		;FINISH UP BUFFERED MODE
>;END IFE FTKS10

;HERE IF COULDN'T GET ANY FREE CORE
PUNTXX:	SETZB	T1,P2		;NO IO LIST, CHNNUM=0 (SO
	JRST	SETLS9		; IOBKTL WILL LIGHT AT INTERRUPT)
;SUBROUTINE TO POINT P1 AT SWPLST ENTRY
;PRESERVES T1,T3
SWPP1:	SKIPGE	KONDRB(J)	;HAVE A DRB?
	SKIPN	T2,DEVDRB##(F)	;MAYBE, DO WE?
	SKIPA	P1,UNISWA(U)	;NO, GET FROM UDB
	MOVE	P1,DRBSWA##(T2)	;YES, GET FROM DRB
	POPJ	P,
;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
	MOVE	T1,KDBIUN(J)	;YES, SET TO LOOK FOR UNIT
UNIRH1:	SKIPN	T3,(T1)		;GET A UNIT DATA BLOCK
	JRST	UNIRH2		;NONE
IFN FTCIDSK,<
	MOVEI	T2,UNPRHP
	TDNE	T2,UNIRHP(T3)	;ALREADY READING HOME?
	SKIPL	KONMX(J)	;AND MULTIPLE XFERS?
	SKIPA	T2,UNIDES(T3)
	JRST	UNIRH2		;YES, DON'T DO IT TWICE
>
IFE FTCIDSK,<
	MOVE	T2,UNIDES(T3)	;NEED REREADING (ON THIS PORT)?
>
IFN FTDUAL,<
	MOVE	T3,UNISTS(T3)	;ALREADY REREADING ON OTHER PORT?
	CAIE	T3,TCOD
>
	TLNN	T2,UNPRHB
	JRST	UNIRH2		;DON'T REREAD ON THIS PORT
	MOVE	U,(T1)		;SET U TO UDB TO REREAD
	JRST	CPOPJ1##	;AND SKIP
UNIRH2:	AOBJN	T1,UNIRH1	;LOOP
	POPJ	P,		;NOT FOUND (MUST BE DIFFERENT KONTROLLER)

;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:	SKIPGE	@KDBCHN(J)	;DON'T REREAD IF CHANNEL ALREADY BUSY
	PUSHJ	P,UNIRHB	;ANY UNIT NEED REREADING?
	  JRST	POSDN2		;NO
	PUSHJ	P,FAKDDX	;YES, GET A DDB
	  JRST	POSDN2		;NO FREE CORE, TRY LATER
TSTRHX:	PUSHJ	P,STORU		;SAVE U
	HLRZ	T1,UNIHOM(U)	;1ST HOME BLOCK NUMBER
TSTRH1:	MOVEM	T1,DEVBLK##(F)
	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
	MOVE	S,[IOSMON,,IOACT]	;SET S
	MOVEM	S,DEVIOS(F)
	DSKOFF
IFN FTCIDSK,<
	MOVEI	T1,UNPRHP	;REREAD NOW IN PROGRESS
	IORM	T1,UNIRHP(U)
	SKIPGE	KONMX(J)	;DON'T SET CHANNEL BUSY IF MULTI XFERS
	PJRST	STRTIO		;START THE READ AND RETURN
>
	SKIPL	KONBMX(J)	;DON'T SET CHANNEL BUSY IF BLOCK MUX KONTROLLER
	AOS	@KDBCHN(J)	;MARK CHANNEL BUSY
	PJRST	STRTIO		;START THE READ AND RETURN

;HERE WHEN ALL POSITIONING INTERRUPTS HAVE BEEN HANDLED
POSDON:	DSKON			;GIVE UP THE INTERLOCK
	POP	P,P2		;LH=UNIT #, RH = FUNCTION
	POP	P,P4		;CONI WORD
	POP	P,P3		;DATAI WORD (THE DRB)
	SKIPL	KONDRB(J)	;IORB?
	JRST	POSDNZ		;NO
	TRNE	P2,OPPOS	;POSITIONING ONLY?
	JRST	TSTRHB		;YES
	HLRZ	U,DRBCUR##(P3)	;GET UDB
	HRRZ	F,DRBCDA##(P3)	;DDB
	PUSH	P,J		;MAKE DDB ADDRESSABLE
	LDB	J,DRZJOB##
	PUSHJ	P,MKADD##
IFN FTXMON,<
	PUSHJ	P,SPCS##	;SET PCS
>
	POP	P,J
	MOVE	S,DEVIOS(F)
	MOVE	T1,DRBSTS##(P3)	;OFF-LINE?
	ANDI	T1,KONERM
	JUMPN	T1,BADUN1
	JRST	POSDNY		;JOIN COMMON CODE
POSDNZ:	HRRZ	U,KONCUA(J)	;SET U TO UNIT ADDRESS
	JUMPE	U,CPOPJ##	;MIGHT BE SPURIOUS INTERRUPT FROM WRONG KONTROLLER
	PUSHJ	P,SETF		;SET F TO FILE ADDRESS
	JUMPE	F,TSTRHB	;FREE INT IF 0 OR UNSOLICITED
	MOVE	T1,UNISTS(U)	;IF THE UNIT IS IN
	CAILE	T1,MDACOD	; SOME FLAVOR OF WAIT
	JRST	TSTRHB		;INTERRUPT IS SPURIOUS
	MOVE	S,DEVIOS(F)	;AND S TO S
POSDNY:	SKIPL	KONDRB(J)	;HAVE A DRB?
	SKIPA	T1,P4		;NO, LOAD CONI FROM AC
	MOVE	T1,DRBCNI##(P3)	;YES, LOAD CONI FROM DRB
	MOVEM	T1,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
POSDN2:	POPJ	P,		;YES
	SOS	CHNCFT(P1)	;NO, DECREASE FAIRNESS COUNTS
	SOS	CHNCFP(P1)
	PUSHJ	P,ADRINT	;SET UP R
	HRRZ	T4,P2		;ERROR BITS FROM DRIVER
	MOVE	T1,UDBPDN(U)	;PHYSICAL DRIVE 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
	HRRZS	P2		;SET LH(P2)=0 FOR BUFFERRED MODE
	LDB	T1,PIOMOD##	; P2 NEGATIVE IF MONITOR MODE OR DUMP MODE
	SKIPL	S
	CAIL	T1,SD
	TLO	P2,400000	;MONITOR OR DUMP
	SKIPL	KONDRB(J)	;HAVE A DRB?
	SKIPA	T2,CHNNUM(P1)	;NO, GET FROM CHN
	MOVE	T2,DRBNUM##(P3)	;YES, GET FROM DRB
	JUMPN	T2,POSDN3	;GO IF NOT ZERO BLOCKS TRANSFERRED
				;(ERROR SETS LH -1 EVEN IF RH IS 0)
				;IF DUMP MODE CHNNUM=0
	CAIL	T1,SD		; IFF WE RAN OUT OF LOW-CORE BLOCKS
	JUMPGE	S,POSDN8	; AND WE WILL RECOVER AT DUMPG5
	TRO	S,IOBKTL	;YES, 1ST BUFFER HEADER ZAPPED BY USER
	PUSHJ	P,STDIOD##	;WAKE THE JOB
	JRST	POSE19		;FINISH UP

POSDN3:	TRNE	P2,IOIMPM+IODTER+IODERR+IOBKTL	;ERROR?
	JRST	POSERR		;YES, RECOVER
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;MULTIPLE XFERS?
	JRST	POSDN4		;YES, THERE ISN'T A TERM WORD
>
	MOVE	T1,KDBICP(J)	;GET ADDR OF INAD PAIR
IFN FTKL10,<
	MOVE	T2,CHNTYP(P1)
	TLNE	T2,CP.RH2	;IS IT AN RH20?
	SKIPA	T1,2(T1)	;YES, TERMINATION WORD IS ELSEWHERE
>
IFE FTKS10,<
	MOVE	T1,1(T1)	;GET TERMINATION CONTROL WORD
>
	CAMN	T1,CHNTCW(P1)	;IS IT WHAT WE EXPECT
	JRST	POSDN4		;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:	SKIPGE	CHNECT(P1)	;ARE WE SUPPOSED TO RECAL?
	SKIPG	KONPOS(J)	;I.E. RECOVERING FROM THUNG?
	JRST	POSERZ		;NO, IT'S NORMAL ERROR
	SETOM	CHNECT(P1)	;YES, SET RH
	PUSHJ	P,@KONRCL(J)	;START A RECAL
	 JFCL
	MOVEI	T1,DSKTIM##	;SET TIMER
	MOVEM	T1,UNITIM(U)
	POPJ	P,
POSERZ:	SKIPL	KONDRB(J)	;HAVE A DRB?
	JRST	POSERY		;NO
	DSKOFF			;YES, DISABLE INTERRUPTS
	MOVE	T1,P3		;#ADDR OF IORB
	PUSHJ	P,DRRST		;#RESTORE ALL THE VOLATILE STUFF
				;#LEAVE INTERRUPTS OFF SO VOLATILE
				;#STUFF STAYS PUT
POSERY:	SKIPL	DEVSWP##(F)	;SWAPPER?
	JRST	POSERX		;NO
	DSKOFF			;#YES, DISABLE INTERRUPTS
	PUSHJ	P,STORU		;#SWPDDB MIGHT HAVE CHANGED SO PUT IT BACK
	MOVE	T1,UNIBLK(U)
	MOVEM	T1,DEVBLK##(F)
	PUSHJ	P,SWPINS##	;#RESTORE IO BIT
				;#LEAVE INTERRUPTS OFF
POSERX:	HRRZ	T1,DEVDMP##(F)	;ADR OF (POSSIBLE) DUMP IOWD
	TLNE	S,IOSMON	;MONITOR CALL?
	JUMPE	T1,POSE99	;YES. NO ERR RECOVERY IF CHAN SKIP IOWD
	SKIPGE	UNIECT(U)	;FIRST ERROR (UNPFIR)?
	JRST	FSTERR		;YES
	TRNN	P2,IOECCX	;ECC-CORRECTABLE ERROR?
	JRST	POSER2		;NO
	MOVSI	T1,UNPECC	;INDICATE ECC-CORRECTABLE ERROR
	IORB	T1,UNIECT(U)	;SET AND GET CURRENT BITS
	SKIPL	KONECA(J)	;SKIP IF KONTROLLER CAN DO ECC FIRST
	TLNE	T1,UNPECE	;ECC-CORRECTION ENABLED?
	JRST	POSER1		;YES, COMPUTE THE NUMBER OF GOOD BLOCKS PASSED
	JRST	POSER2		;NO, EXHAUST ALL RETRIES BEFORE ECC IS USED

;HERE ON FIRST ERROR (DON'T KNOW WHETHER IT WILL BE SOFT OR HARD)
FSTERR:	SETZM	UNIERR(U)	;YES, ZERO LAST ERROR CONI STATUS
	SKIPL	KONDRB(J)	;HAVE A DRB?
	DMOVE	T1,P3		;NO, LOAD DATA FROM ACS
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	DMOVE	T1,DRBDTI##(P3)	;YES, LOAD DATA FROM DRB
	MOVEM	T2,UNISOF(U)	;SAVE FIRST CONI IN UNIT DB
	MOVEM	T1,UNISDI(U)	;SAVE FIRST DATAI
	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
	TRNN	P2,IOCHMP!IOCHNX ;CHANNEL DETECTED ERROR?
	JRST	FSTER1		;NO--CONTINUE
	TRNE	P2,IOCHMP	;YES--IS IT A MEMORY PARITY ERROR?
	MOVEI	T2,CHEMPE##	;YES, SET FOR MEM PAR ERR
	TRNE	P2,IOCHNX	;NO--IS IT A NXM ERROR?
	MOVEI	T2,CHENXM##	;YES, NXM ERROR
	MOVE	T1,KDBICP(J)	;INITIAL CONTROL WORD ADR
	PUSHJ	P,(T2)		;GO STORE CHANNEL DATA FOR F.S. ON SOFT+HARD ERRORS
FSTER1:
IFN FTCIDSK,<
	SKIPL	KONMX(J)	;LEAVE SIGN BIT ON
>
	SETZM	UNIECT(U)	;SET RETRY COUNT TO 0
				;(FIRST ERROR FLAG -UNPFIR AND HARD ERROR FLAG -UNPHRD)
	TRC	P2,IODTER!IODERR ;IODERR AND IODTER BOTH ON
	TRCE	P2,IODTER!IODERR ; MEAN FORMAT ERROR
	JRST	FSTER2		;NOT FORMAT ERROR
	SKIPGE	DEVSWP##(F)	;IF SWAPPER
	JRST	FSTER3		;NOT A REAL FMT 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
FSTER3:	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	POSE18		;INDICATE FORMAT ERR AND DON'T RETRY
FSTER2:	MOVEI	T1,DEPDER	;ERROR-RETRY DISABLED?
	TDNN	T1,DEVSTA(F)	;BY OPEN UUO
	JRST	POSER1		;NO
	AOS	UNISCT(U)	;YES, COUNT A SOFT ERROR
	PUSHJ	P,CTGOOD	;COMPUTE BAD BLOCK
	ADD	T1,DEVBLK##(F)
	MOVEM	T1,UNIHBN(U)	;SAVE IN UDB
	JRST	POSE11		;NO RETRY

POSER1:	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
POSER2:	MOVEI	T4,1		;SET BIT FOR ERR COUNTER, ASSUME DATA ERR
	TRNE	P2,IODERR	;DEVICE ERROR?
	MOVSI	T4,1		;YES, COUNT AS DEVICE ERROR
IFN FTCIDSK,<
	SKIPL	KONMX(J)	;LEAVE IT STATIC
>
	ADDM	T4,UNIECT(U)	;ACCUMULATE ERROR COUNT
	TLNN	S,IO		;IF READING
	TRNN	P2,IOECCX	;AND AN ECC-CORRECTABLE ERROR
	JRST	NOECC1
	MOVSI	T1,UNPECE	;ECC CORRECTION ENABLED?
	SKIPL	KONECA(J)	;CAN KONTROLLER DO ECC FIRST?
	TDNE	T1,UNIECT(U)	;(HAVE WE EXHAUSTED ALL RETRIES/RECALS?)
	SKIPA			;ECC IS PERMISSIBLE NOW
	JRST	NOECC1		;CAN'T USE ECC YET
IFN FTCIDSK,<
	PUSHJ	P,CIBAD		;CI SHOULDN'T GET HERE
>
	MOVE	T1,UNIHBN(U)	;GET BAD BLOCK
	SUB	T1,DEVBLK##(F)	;COMPUTE NUMBER OF GOOD BLOCKS
	HRLS	CHNNUM(P1)	;SAVE IN CASE NOT ECC - RECOVERABLE
	JUMPL	T1,NOECC2	;CHAN GOOFED IF NO BLOCKS XFERRED
	HRRM	T1,CHNNUM(P1)	;SAVE NUMBER OF GOOD BLOCKS
	AOS	CHNNUM(P1)	;+1 FOR THE BLOCK WE'LL CORRECT
	SKIPGE	DEVSWP##(F)	;IF SWAPPER
IFN FTKL10,<
	JRST	ECCSWP
>
IFN FTKS10,<
	JRST	NOECC2
>
	PUSH	P,DEVDMP##(F)	;SAVE DEVDMP
	JUMPGE	P2,ECC1		;IF DUMP MODE OR MONITOR IO
	LSH	T1,BLKLSH##	;CONVERT TO WORDS
	HRRZ	T2,KONDMP(J)	;HANDLE HALVES INDEPENDENTLY
	ADDI	T2,(T1)		;FIRST WORD OF LAST BLOCK OF XFER
	HRLZS	T1		;NOW INCREMENT COUNT FOR GOOD BLOCKS
	ADD	T1,KONDMP(J)	;..
	EXCH	T1,T2		;COUNT IN T2, ADDR IN T1
	HLRES	T2		;COUNT IN RH(T2)
	JUMPL	S,ECC2		;DON'T UPDATE DEVDMP IF MON IO
	PUSH	P,T1		;CONSTRUCT IOWD FOR LAST
	HRLM	T2,(P)		;..
	ADDI	T1,BLKSIZ##	;FIRST WORD OF NEW TRANSFER
	ADDI	T2,BLKSIZ##	;COUNT FOR NEW TRANSFER
	AOS	T1		;FIRST WORD OF NEW TRANSFER
	MOVSS	T1		;SET DEYISN
	DPB	T1,DEYISN##	;..
	MOVSS	T1
	MOVSS	T2		;COUNT IN LEFT HALF
	HRRI	T2,-1(T1)	;IOWD FOR DEVDMP
	MOVEM	T2,DEVDMP##(F)	;..
	POP	P,T1		;IOWD FOR LAST BLOCK
	CAMLE	T1,[MBLKSZ##,,0] ;IF LESS THAN 1 BLOCK IN IOWD
	TLOA	T1,400000	; SET A FLAG
	TLZ	T1,-1
	MOVEM	T2,DEVDMP##(F)
	JRST	ECC2		;AND CONTINUE

;STILL IN FTRP04 CONDITIONAL
;HERE IF ERROR WAS IN BUFFERED MODE
ECC1:	HRRZ	T4,DEVIAD(F)	;LOC OF 1ST BUFFER
	PUSHJ	P,PARTDN	;ADJUST THINGS SINCE ONLY PART OF THE XFER GOT DONE
	EXCTUU	<HRRM T2,1(T4)>	;TELL WORLD HOW FAR WE GOT IN THIS BUFFER

;HERE WITH T1=UVA-1 OF START OF BAD BLOCK (OR EVA-1 IF MONITOR BUFFER)
ECC2:	PUSH	P,T1		;SAVE LOC
	PUSHJ	P,@KONECC(J)	;GET RELATIVE POSITION OF BAD WORD
	  JRST	ECC9		;OOPS
	CAILE	T1,BLKSIZ##-1	;IF THE ERROR IS IN THE ECC BYTE,
	JRST	[POP P,T1
		 POP P,(P)
		 JUMPGE	T1,ECC8 ;IF AT END OF SHORT IOWD
		 HRRZS	DEVDMP##(F) ; ENSURE WE TERMINATE
		 JRST ECC8]	;NO CORRECTION NEEDED
	CAIN	T1,BLKSIZ##-1	;IF SECOND HALF IS IN THE ECC BYTE,
	SETZ	T3,		;DON'T CORRECT THE SECOND HALF
	JUMPGE	P2,ECC3
	HLRE	T4,DEVDMP##(F)	;WORD COUNT OF IOWD
	SKIPL	S
	SUBI	T4,BLKSIZ##	; PRIOR TO BAD BLOCK
	ADDI	T4,1(T1)	;+ POSITION OF ERROR BURST
	SKIPGE	(P)		;IF AT END OF IOWD
	HRRZS	DEVDMP##(F)	; MAKE SURE WE TERMINATE
	JUMPL	T4,ECC3		;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
ECC3:	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,ECC5		;IF NOT MONITOR IO,
	JUMPE	T2,ECC4		;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
ECC4:	ADDI	T1,1
	JUMPE	T3,ECC8		;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	ECC8		;LOG A RECOVERED ERROR AND CONTINUE

;STILL IN FTRP04 CONDITIONAL

;HERE IF ERROR IN MONITOR IO (INTO MON BUF)
ECC5:	JUMPE	T2,ECC6		;NO 1ST PART IF T2=0
	MOVS	T4,(T1)		;GET 1ST BAD WORD
	XOR	T4,T2		;APPLY MASK
	MOVSM	T4,(T1)		;AND SAVE
ECC6:	JUMPE	T3,ECC7		;NO 2ND PART IF T3=0
	MOVS	T4,1(T1)	;GET 2ND BAD WORD
	XOR	T4,T3		;CORRECT
	MOVSM	T4,1(T1)	;AND SAVE
ECC7:	MOVE	T1,CHNNUM(P1)	;RESET NUMBER OF BLOCKS DONE
	DPB	T1,DEYNBB##	; (IN CASE IN DIRSCN FOR A LARGE UFD)
ECC8:
IFN FTKL10&FTMP,<
	PUSHJ	P,CSDMP##	;DONT LEAVE FUNNY VALID BITS IN CACHE
>
	JRST	POSDN4		;AND CONTINUE

IFN FTKL10,<
;HERE ON ECC ERROR DETECTED BY SWAPPER
ECCSWP:	PUSH	P,T2		;SAVE CORRECTION DATA
	PUSH	P,T3		;SAVE RH10/RH20,,L(IOWD)
	PUSHJ	P,@KONECC(J)	;GET CORRECTION DATA
ECCSW0:	  JRST	[POP P,(P)	;IT REALLY WASN'T ECC CORRECTABLE
		 POP P,(P)
		 JRST NOECC2]
	CAILE	T1,BLKSIZ##-1	;LEGAL POSITION OF ECC BYTE?
	JRST	ECCSW2		;NO, FORGET IT
	CAIN	T1,BLKSIZ##-1	;IF SECOND HALF IS IN THE ECC BYTE,
	SETZ	T3,		;DON'T CORRECT THE SECOND HALF
	MOVE	T4,(P)		;GET IOWD
	MOVE	T4,(T4)
	ADD	T4,-1(P)	;ADD POSITION OF ERROR
	SUBI	T4,BLKSIZ	;RELATIVE TO START OF BLOCK
	TLZ	T4,777760	;JUST ADDRESS
	SKIPL	(P)		;RH20?
	ADDI	T4,1		;ADJUST FOR ADDR-1
	TRNE	T4,BLKSIZ-1
	JRST	ECCSW0		;WRDCNT LIED
	ADDB	T1,T4		;T1=PHYSICAL ADDRESS OF 1ST BAD WORD
	LSH	T1,W2PLSH
	PUSHJ	P,SWPAD##	;MAKE IT ADDRESSABLE IN EVM
	ANDI	T4,PG.BDY
	ADD	T1,T4
	MOVS	T4,(T1)		;CORRECT THE DATA
	XOR	T4,T2
	MOVSM	T4,(T1)
	JUMPE	T3,ECCSW2	;NO 2ND PART IF T3 ZERO
	MOVS	T4,1(T1)	;GURANTEED TO BE IN SAME PAGE
	XOR	T4,T3
	MOVSM	T4,1(T1)
;HERE AFTER WE CORRECTED THE DATA
ECCSW2:	AOS	T1,UNIHBN(U)	;BLOCK AFTER THE ONE WE FIXED
	SUB	T1,DEVBLK##(F)	;-WHERE WE STARTED
	ADDM	T1,DEVBLK##(F)	;WHERE WE SHOULD RESTART
	ADDM	T1,UNIBLK(U)
	HLRZ	T1,CHNNUM(P1)	;ORIGINAL COUNT
	HRRZS	CHNNUM(P1)	;CLEAR BITS FROM LH
	SUB	T1,CHNNUM(P1)
	MOVEM	T1,CHNNUM(P1)	;NUMBER OF BLOCKS LEFT TO GO
	POP	P,T3
	POP	P,T2
	MOVE	T4,@KDBICP(J)	;NOW FIX UP THE IOWD TO RESTART THE XFER
	ADD	T2,(T3)
	TLNN	T2,077760
	JUMPL	T3,ECCSW3
	TLNE	T2,777760	;DONE WITH THIS IOWD?
	JRST	ECCSW4		;NO, RESTARTT ON THIS ONE
ECCSW3:	MOVEI	T1,1(T3)	;YES, POINT AT NEXT IOWD
	SKIPN	(T1)		;COMPLETELY DONE?
	JRST	POSDN4		;YES
	JUMPGE	T3,ECCSW5	;HAVE A GOTO WORD ALREADY IF RH10
	HRLI	T1,(INSVL.(.CCJMP,CC.OPC)) ;RH20 - MAKE A GOTO WORD
	JRST	ECCSW5		;AND START AT THAT IOWD
ECCSW4:	MOVEM	T2,(T3)		;CONTINUE IN THIS IOWD - SAVE UPDATED IOWD
	HRRZ	T1,T3		;IS THIS 1ST IOWD?
	CAIN	T1,(T4)
	JRST	STARTE		;YES, RESTART
	HLL	T1,T4		;NO, MAKE A GOTO THIS IOWD
ECCSW5:	MOVEM	T1,(T4)
	JRST	STARTE		;AND RESTART THE IO
> ;END IFN FTKL10

;HERE IF WE REALLY COULDNT RECOVER THOUGH WE THOUGHT WE COULD
ECC9:
IFN FTKL10&FTMP,<
	PUSHJ	P,CSDMP##
>
NOECC:	POP	P,(P)		;REMOVE RELATIVE ADDR FROM LIST
	POP	P,DEVDMP##(F)	;RESTORE ORIGINAL DEVDMP TO THE DDB
	MOVE	S,DEVIOS(F)	;RESET S (IOSPBF WAS CHANGED ERRONEOUSLY)
NOECC2:	MOVEI	T4,1		;COUNT DATA ERROR
	HLRZS	CHNNUM(P1)	;RESTORE ORIGINAL CHNNUM
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	POSER3		;NO
	SKIPL	KONDRB(J)	;HAVE A DRB?
	DMOVE	T1,P3		;NO, LOAD DATA FROM ACS
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	DMOVE	T1,DRBDTI##(P3)	;YES, LOAD DATA FROM DRB
	MOVEM	T2,UNIERR(U)	;YES. SAVE 2ND ("HARD") CONI WORD
	MOVEM	T1,UNIHDI(U)	;SAVE "HARD" DATAI WORD
	PUSHJ	P,LSTER		;SAVE THE DRIVE REGISTERS NOW
POSER3:	MOVE	P4,T4		;SAVE ERROR-COUNT WORD
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;MULTIPLE XFERS?
	JRST	POSER4		;UNISTS IS IDLE
>
	MOVE	T2,UNISTS(U)	;STATE OF UNIT
	CAIE	T2,TCOD		;IGNORE IF POSITIONING,
	POPJ	P,		;RETRY IF XFER (ERROR RECOVERY)
IFN FTKL10,<
	LDB	T2,UNYKTP##	;GET KONTROLLER TYPE
	CAIN	T2,TYPRN	;RP20?
	JRST	POSER4		;YES, ALWAYS CALL ERR ROUTINE
>
	TRNN	P2,IOHDER	;HEADER ERROR?
	TRNN	P2,IODERR	; OR DATA ERROR? (AND NOT FMT)
POSER4:	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
	POSER7			;(2) LAST TIME
	POSER8			;(3) GIVE UP
	POSER5			;(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	POSER9		;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,POSER6	;TRIED ENOUGH IF T4=0
POSER5:	SETOM	CHNECT(P1)	;NO. SET A SWITCH FOR RECALR
	PUSHJ	P,@KONRCL(J)	;DO A RECALIBRATE
	  JRST	POSER6		;NOT A PACK OR UNIT DOWN
	DSKON			;ALLOW INTERRUPTS AGAIN
	PJRST	STOIOS##	;RECALIBRATING - RESET HUNG TIME, DISMISS INTERRUPT
POSER6:	JUMPG	T1,POSE10	;GO IF NOT LAST TIME
POSER7:	MOVEI	T3,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	T3,KONWRT(J)
	MOVSI	T2,DEPCPT##	;IF IN 10/11 COMPAT MODE,
	TDNE	T2,DEVCPT##(F)
	ADDI	T3,KONWTC-KONWRT ;ENTRY POINT = RED(WRT)+3
	MOVE	T1,P3		;COPY THE DRB ADDRESS
	PUSHJ	P,@(T3)		;CALL DEVICE DEPENDENT ROUTINE
	  PJRST	BADUN1		;UNIT NOT UP
	PJRST	DOPOPJ		;TURN INTERRUPTS ON AND RETURN
;HERE WHEN ERROR IS DECLARED HARD FOR AN ERROR-PROGRAM KONTROLLER
POSER8:	PUSHJ	P,LSTER		;READ ALL DRIVE REGISTERS
	JRST	POSE10		;AND GO DECLARE HARD ERROR

OFFSET:	HRROS	CHNECT(P1)	;CHNECT=-1,,N TO INDICATE OFFSET IN PROGRESS
	DSKON			;ALLOW INTERRUPTS AGAIN
	PJRST	STOIOS##


;ROUTINE TO RETURN BAD BLOCK NUMBER RELATIVE TO BEGINNING
;OF TRANSFER.  RETURNS RELATIVE BLOCK NUMBER IN T1.
;RETURNS T2, T3 AS SET UP BY WRDCNT
CTGOOD:	SKIPL	KONDRB(J)	;HAVE A DRB?
	JRST	CTGOD1		;NO
	MOVE	T1,DEVDRB##(F)	;GET IT FROM IORB
	MOVE	T1,DRBGOD##(T1)
	POPJ	P,
CTGOD1:	HRRZ	T1,KDBICP(J)	;INITIAL CONTROL WORD ADDRESS
	PUSHJ	P,WRDCNT##	;COMPUTE NO. OF GOOD WORDS TRANSFERRED
	TRNE	P2,IODTER	;IS THIS EITHER
	TRNN	P2,IODERR!IOHDER ; FORMAT OR SEARCH ERROR?
	SUBI	T1,1		;NO, ENSURE WE GET THE RIGHT NUMBER OF BLOCKS
				;(DEVBLK(F) + THIS NUMBER = BAD BLOCK NUMBER)
	LSH	T1,MBKLSH##	;CONVERT TO RELATIVE BLOCK NUMBER
	POPJ	P,

;SUBROUTINE TO FIX THINGS UP WHEN ONLY A PART OF THE TRANSFER GETS DONE (ECC, HARD ERROR)
;CALLED ONLY FOR BUFFERRED MODE
;T1 PASSES NUM GOOD BLOCKS (I.E. NOT COUNTING THE ECC BLOCK)
;T4 PASSES DEVIAD OR DEVOAD
;T4 RETURNS ECC BUFFER
;T1 RETURNS ADDR-1 OF ECC BLOCK
;T2 RETURNS WORDS TRANSFERED SO FAR THIS BUF (INCLUDING THE ECC BLOCK)
PARTDN:	LDB	T2,DEYNB1##	;NO OF BLOCKS FROM START OF BUFFER
	ADD	T1,T2		;TOTAL GOOD (NOT COUNT ECC)
	LDB	T3,DEYNBB##	;NO OF BLOCKS PER BUFFER
	IDIVI	T1,(T3)		;NO OF BUFFERS BEFORE BAD BLOCK
	JUMPE	T1,PARTD1
	EXCTUX	<HRR T4,(T4)>	;ADVANCE THE NUMBER OF GOOD BUFFERS
	SOJG	T1,.-1
PARTD1:	MOVEI	T1,1(T4)	;POINT T1 AT LOC-1 OF BAD BUFFER
	SUBI	T3,1(T2)	;NO OF BLOCKS LEFT IN CURRENT BUFFER
	LSHC	T2,BLKLSH##	;NO OF GOOD WORDS AT FRONT
	ADD	T1,T2		;POINT AT EVA-1 OF BAD BLOCK
	SKIPN	T3		;PARTIAL BUFFER?
	TLZA	S,IOSPBF	;IN CASE IT WAS ON AND WE STOPPED AT END OF BUFFER
	TLO	S,IOSPBF	;PARTIAL - TELL REST OF WORLD
	ADDI	T2,BLKSIZ##	;HOW FAR WE'VE GONE
	POPJ	P,		;NON-SKIP RETURN
;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
	HRLZ	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
	HRR	T1,KONEBK(J)
	MOVEI	T2,UNIEBK(U)	;WHERE TO STORE
IFN FTKL10,<
	LDB	T3,UNYKTP##	;GET KONTROLLER TYPE
	CAIE	T3,TYPRN	;IS IT AN RP20?
	JRST	LSTER1		;NO, CONTINUE
	MOVE	T1,[-RNVNMR##,,RNVSMR##] ;AOBJN POINTER
	ADD	T1,KONEBK(J)	;RELOCATE
	MOVEI	T2,UNIEBK+RNVSMR##(U)	;WHERE TO STORE THEM
>
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	T2,KONREG(J)	;GET NUMBER OF REGISTERS BACK
	ADDI	T2,UNIEBK(U)	;COMPUTE WHERE TO STORE LAST DATAO
	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
POSER9:	TLNE	S,IO		;IF READING, CONTINUE
	STOPCD	.,JOB,HWU,	;++HARD WRONG UNIT
;HERE ON HARD DEVICE OR DATA ERRORS
POSE10:	SOJE	T1,STARTE	;LAST RETRY, STOP ON ERROR, IF 1
	MOVE	T1,UNIECT(U)	;GET INTERESTING BITS
	TLC	T1,UNPECC	;COMPLEMENT ECC-CORRECTABLE ERROR FLAG
	TLNN	T1,UNPECC!UNPECE ;IF ECC WOULD HELP, AND WE HAVEN'T TRIED,
	JRST	POSE20		;GO SET UP FOR SECOND PASS
	DSKON			;ALLOW INTERRUPTS AGAIN
	ADDM	P4,UNIHCT(U)	;UPDATE HARD-ERROR WORD
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;MULTIPLE XFERS?
	SETZ	P4,		;YES, LEAVE UNIECT STATIC
>
	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
	AOS	T1,HERCNT##	;BUMP HARD ERR COUNT
	TRNE	S,IODTER+IODERR	;HRDWRE ERROR?
	CAMGE	T1,HERLIM##	;YES. TIME TO TELL OPR?
	JRST	POSE11		;NO
	SETZM	HERCNT##	;YES. RESET FOR NEXT CYCLE
	MOVE	T1,[TELDER,,1]	;CANT TYPE ON PI LEVEL
	SYSPIF			; SO WAIT TILL NEXT TICK
	PUSHJ	P,SKPCLQ##	;ROOM IN CLOCK QUEUE FOR MESSAGE?
	  JRST	POS10A		;NO, PROBABLY LOTS OF ERRORS, LET IT GO
	IDPB	T1,CLOCK##	;SET SO WE WILL TELL OPR
	IDPB	U,CLOCK##
	SETOM	CLKNEW##
POS10A:	SYSPIN
POSE11:	JUMPL	P2,POSE12
	PUSHJ	P,CTGOOD	;GET RELATIVE BAD BLOCK NUMBER
	AOS	T1		;CONVERT TO NUMBER OF BLOCKS XFERRED
	HRRZ	T2,CHNNUM(P1)	;ORIGINAL NUM OF BLOCKS XFERRED
	HRRM	T1,CHNNUM(P1)	;SAVE FOR BUFAD
	SUBI	T2,(T1)		;NUMBER OF BLOCKS AFTER THE LAST GOOD ONE
				;FALL INTO POSE12
;HERE IF USER AVOIDING ALL RETRIES
POSE12:	TLNN	S,IO		;IF INPUT,
	PUSHJ	P,CFDMPX	;FLUSH CACHE SO BAD DATA WILL BE SEEN
POSE99:	PUSH	P,P3		;SAVE ADDR OF IORB
	JUMPL	S,POSE14	;ONLY 1 IOWD IF MONITOR IO
	JUMPL	P2,POSE13	;IF BUFFERRED MODE,
	PUSH	P,T2		;SAVE NUMBER OF BLOCKS PAST LAST GOOD ONE
	TLNE	S,IO		;GET LOC OF BUFFER
	SKIPA	T4,DEVOAD(F)
	MOVE	T4,DEVIAD(F)
	HRRZS	T4		;CLEAR POSSIBLE LEFT HALF JUNK
;WE NOW PRETEND THAT THERE WAS AN ECC CORRECTABLE BAD SPOT IN THE
;BLOCK BEFORE THE BAD BLOCK. WE ADVANCE OVER ALL THE BUFFERS UP TO
;AND INCLUDING THE "ECC" BLOCK (I.E. ALL THE GOOD DATA).
;WE THEN LIGHT ERROR BITS IN ALL THE REMAINING BUFFERS.
	HRRZ	T1,CHNNUM(P1)	;GET GOOD BLOCKS BACK
	SOJL	T1,POSE14	;GO IF BAD BLOCK IS 1ST IN TRANSFER
	PUSHJ	P,PARTDN	;SET IOSPBF, NO OF WORDS DONE IN BUFFER
	HRLM	T2,(P)		;SAVE NO OF WORDS DONE SO FAR
POSE13:	HRRZ	P4,CHNNUM(P1)	;GET # OF GOOD BLOCKS FOR BUFAD
	PUSHJ	P,BUFAD		;ADVANCE THE GOOD BUFFERS
	  JFCL
POSE14:	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	POSE15		;NO
	SKIPL	DEVSWP##(F)	;SWAPPER?
	TRZ	P2,IOCHMP+IOCHNX	;NO, DON'T KEEP THESE ERR BITS
POSE15:	OR	S,P2		;STORE ERROR BITS IN S
	POP	P,P2
	JUMPL	P2,POSE16	;GO IF MONITOR IO
	POP	P,T2		;NO GOOD WDS IN BUF,,NO OF EXTRA BLOCKS
	HRRM	T2,CHNNUM(P1)	;SAVE ADDITIONAL NO OF BUFS
	HRRZ	P4,T2		;BUFAD WANTS IT IN P4
	LSH	T2,-^D18-BLKLSH## ;NO OF BLOCKS INTO BUFFER
	LDB	T3,DEYNBB##	;NO OF BLOCKS PER BUFFER
	CAIN	T3,(T2)		;IF AT TOP OF BUFFER
	SETZ	T2,		;DEYNB1 SHOULD BE 0
	DPB	T2,DEYNB1##	;SAVE IN DDB FOR BUFAD
	SKIPE	P4		;IN CASE RH SCREWED UP
	PUSHJ	P,BUFAD		;ADVANCE THE REST OF THE BLOCKS
	  JFCL
POSE16:	POP	P,P3		;RESTORE ADDR OF IORB
	TRNN	S,IODTER	;PARITY ERROR?
	JRST	POSE17		;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##
POSE17:	TRNE	S,IODERR	;DEVICE (POSITIONING) ERROR?
	TLO	S,IOSSCE##	;YES. LIGHT A BIT IN LH(S) SOFTWARE CHECKSUM
				; OR DEVICE ERROR
	SKIPE	DEVELB##(F)	;IF NOT ALREADY A BAD BLOCK,
	JRST	POSE18
	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

POSE18:	PUSHJ	P,STDIOD##	;YES. WAKE IT UP
	MOVE	T1,[.FIER3,,.ERDPE] ;FILIO-DETECTED DISK ERROR
	SKIPN	DINITF##	;DON'T TRY TO STOP THE JOB OR WAKE
				; DAEMON IF IN ONCE-ONLY
	PUSHJ	P,DAEERR##	;STOP JOB, WAKE UP DAEMON

POSE19:	PUSHJ	P,RTNDRB	;RETURN CHANNEL PROGRAM AND IORB
	PJRST	SETID3		;SET THIS FILE IDLE AND LOOK FOR ANOTHER

;HERE WHEN RETRIES EXHAUSTED BUT ECC CORRECTION WAS INDICATED AS
;BEING POSSIBLE DURING ONE OF THE RETRIES.  RETRY ALLOWING ECC
;CORRECTION THIS TIME.

POSE20:	MOVSI	T1,UNPECE	;GET THE ONLY USEFUL BIT
	MOVEM	T1,UNIECT(U)	;INDICATE ECC CORRECTION PERMITTED
	JRST	POSERZ		;START THE RETRIES OVER AGAIN
;HERE WHEN THERE WAS NO HARDWARE ERROR ON THE DATA TRANSFER
POSDN4:	SKIPG	T1,UNIECT(U)	;NO. IS THIS A RECOVERED ERROR (UNPFIR)?
	JRST	POSDN6		;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
	MOVE	T2,CHNNUM(P1)	;IF AN OVERRUN
	TLNE	T2,IOVRUN	; RECOVERED ON 1ST RETRY,
	SOJE	T1,[SKIPN ALLOVR##	;DON'T CALL DAEMON
		   JRST POSDN5	; IF ALLOVR = 0
		   JRST .+1]
	MOVE	T1,[.FIER4,,.ERDPE] ;FILIO-DETECTED DISK ERROR
	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
POSDN5:	SKIPE	UNIERR(U)	;IS THIS BEFORE FIRST RECAL?
	JRST	POSDN6		;NO, "HARD" CONI STUFF ALREADY STORED
	SKIPL	KONDRB(J)	;HAVE A DRB?
	DMOVE	T1,P3		;NO, LOAD DATA FROM ACS
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	DMOVE	T1,DRBDTI##(P3)	;YES, LOAD DATA FROM DRB
	MOVEM	T2,UNIERR(U)	;YES, SAVE "HARD" CONI
	MOVEM	T1,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
POSDN6:	TLNN	S,IO+IOSMON
	TLZN	S,IOSFIR	;TIME FOR CHECKSUMS?
	JRST	.+2		;NOT TIME FOR CHECKSUMS, SO WE DON'T HAVE
				; TO SWEEP YET.
	JRST	POSDN7		;CHECKSUM TIME, SWEEP IMMEDIATELY
	MOVSI	T1,CP.SWF	;GET READY TO SET THE BIT
	TLNN	S,IO		;READING?
	IORM	T1,CHNTYP(P1)	;YES, INDICATE THAT A SWEEP MUST BE
				; DONE BEFORE INTERRUPT EXIT TIME.
	JRST	POSDN8		;CONTINUE.
POSDN7:	PUSHJ	P,CFDMPX	;CHECKSUM TIME, SO SWEEP THAT WE MAY SEE
				; THE DATA NOW.
	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	POSDN8		;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	POSDN8		;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,POSDN8	;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)
	MOVE	T1,DEVBLK##(F)	;FIRST LOGICAL BLOCK OF TRANSFER
	MOVEM	T1,UNIHBN(U)	;STORE BAD BLOCK NO. FOR ERROR REPORTING
	MOVE	T1,[.FICKE,,.ERDPE] ;FILIO-DETECTED CHECKSUM ERROR
	PUSHJ	P,DAEERR##	;STOP JOB, WAKE UP DAEMON

POSDN8:	MOVEM	S,DEVIOS(F)	;SAVE S IN DDB
	PUSHJ	P,RTNDRB	;RETURN THE IORB (IF ANY)
	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	SETID2		;NEXT BUFFER NOT USABLE, OR DUMP MODE
				;AT LEAST 1 BUFFER IS AVAILABLE
	SKIPE	DIADSK##	;IF WAITING FOR IO TO STOP
	CAME	P1,DIACHN##	; LET THE UNIT GO IDLE NOW

	PUSHJ	P,CHKNXT	;ANY MORE BLOCKS ON DISK NOW?
	  JRST	SETID1		;NO. SET FILE, UNIT TO IDLE
	TLNE	P3,-1
	PUSHJ	P,STDIOD##	;WAKE JOB IF WAITING
	DSKOFF
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;MULTIPLE XFERS?
	JRST	SETBS1		;YES, JUST START IT
>
	PUSHJ	P,FLPJOB	;#FLIP UNICDA (IN CASE SWPSCN)
	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 OR NXM SWEEP AFTER ALL RETRIES DONE
;CALL:	MOVE	P1,CHANNEL DATA BLOCK ADDRESS
;	PUSHJ	P,CHKCMP
;	RETURN

CHKCMP:	MOVE	T1,CHNNUM(P1)	;LH=IO STATUS ERR BITS ON RETRIES
	TLNN	T1,IOCHNX!IOCHMP ;ANY ERRORS
	POPJ	P,		;NO
	HLLZ	T2,CHNCSR(P1)	;FLAG FOR THIS CHANNEL TO REQUEST CPU0 SWEEP
	TRO	T2,UE.PEF	;CAUSE PARITY (NOT NXM) SWEEP
	TLNE	T1,IOCHNX	;DID CHAN DETECT NXM
	TRC	T2,UE.PEF!UE.NXM ;YES -- SET NXM SWEEP
	IORM	T2,.CPAEF##	;FLAG CPU TO DO A CORE SWEEP
	POPJ	P,		;RETURN
;ROUTINE TO RETURN THE CHANNEL PROGRAM AND IORB
;P3 PASSES THE ADDRESS OF THE IORB
;P4 RETURNS THE NUMBER OF BLOCKS
;P3 RETURNS SWPLST ADDRESS
RTNDRB:	SKIPL	KONDRB(J)	;HAVE A DRB?
	JRST	RTNDR1		;NO
IFN FTKL10,<
	SKIPE	T1,DRBPRG##(P3)	;RETURN CHANNEL PROGRAM
	PUSHJ	P,RTNIOW##
	SETZM	DRBPRG##(P3)	;ERASE MEMORY OF IT
>
IFN FTCIDSK,<
	PUSHJ	P,RTNBHD	;RETURN BHD AND BSD(S)
>; END IFN FTCIDSK
	HRRZ	P4,DRBNUM##(P3)	;NUMBER OF BLOCKS
	MOVE	T1,P3		;ADDR OF IORB
	MOVE	P3,DRBSWA##(T1)	;SWPLST ADDRESS
	DSKOFF
	SKIPL	DEVSWP##(F)
	SETZM	DEVDRB##(F)
	PUSHJ	P,GIVDRB	;RETURN THE IORB
	JRST	DOPOPJ
RTNDR1:
IFN FTKL10,<
	SKIPE	T1,@KDBICP(J)	;RETURN THE FREE-CORE BLOCKS
	PUSHJ	P,RTNIOW##
	SETZM	@KDBICP(J)	;ERASE MEMORY OF IT
>
	HRRZ	P4,CHNNUM(P1)	;NO OF BLOCKS TRANSFERRED
	MOVE	P3,UNISWA(U)	;SWPLST ADDRESS
	POPJ	P,

IFN FTCIDSK,<
;ROUTINE TO LIGHT THE "TRY AGAIN" BIT
;P3 PASSES ADDR OF DRB
RTNTRY:	MOVEI	T1,DRPTRY##	;LIGHT "TRY AGAIN"
	IORM	T1,DRBSTS##(P3)
RTNBHD:	SKIPE	T1,DRBBHD##(P3)	;GET BUFFER NAME
	PUSHJ	P,PPDRHD##	;RETURN BHD AND BSD(S)
	SETZM	DRBBHD##(P3)	;DON'T DO THIS TWICE
	POPJ	P,
>
;ROUTINE TO SAVE ALL THE VOLATILE STUFF
;U PASSES UDB
;J PASSES KDB
;F PASSES DDB
;YOU MUST DISABLE DISK INTERRUPTS BEFORE CALLING THIS ROUTINE
DRSAVE:	SKIPE	T1,DEVDRB##(F)	;GET ADDR OF IORB
	SKIPL	KONDRB(J)	;MIGHT WE HAVE A DRB?
	POPJ	P,		;NO
	PUSHJ	P,SAVE2##	;SAVE AC
	MOVE	P1,KDBCHN(J)	;CHANNEL DATA BLOCK
	MOVE	P2,CHNNUM(P1)
	MOVEM	P2,DRBNUM##(T1)
	MOVE	P2,@KDBICP(J)
	MOVEM	P2,DRBPRG##(T1)
	MOVE	P2,KONDMP(J)
	MOVEM	P2,DRBDMP##(T1)
	MOVE	P2,UNIBLK(U)
	MOVEM	P2,DRBBLK##(T1)
	HRLM	U,DRBCUR##(T1)
	HRRM	F,DRBCDA##(T1)
	MOVE	P2,UNISWA(U)
	MOVEM	P2,DRBSWA##(T1)
IFN FTMP,<
	MOVE	P2,.CPCPN##
	DPB	P2,DRYCPU##
>
	MOVE	P2,UNIJOB(U)
	DPB	P2,DRYJOB##
	POPJ	P,
;ROUTINE TO RESTORE THE VOLATILE STUFF
;U PASSES UDB
;J PASSES KDB
;F PASSES DDB (THE DDB MUST BE ADDRESSABLE)
;YOU MUST DISABLE DISK INTERRUPTS BEFORE CALLING THIS ROUTINE
DRREST:	SKIPE	T1,DEVDRB##(F)	;GET ADDR OF IORB
;ENTER HERE WITH T1=IORB
DRRST:	SKIPL	KONDRB(J)	;MIGHT WE HAVE A DRB?
	POPJ	P,		;NO
	PUSHJ	P,SAVE2##	;SAVE AC
	MOVE	P1,KDBCHN(J)	;CHANNEL DATA BLOCK
	MOVE	P2,DRBNUM##(T1)
	MOVEM	P2,CHNNUM(P1)
REPEAT 0,<
	MOVE	P2,DRBPRG##(T1)
	MOVEM	P2,@KDBICP(J)
>
	MOVE	P2,DRBDMP##(T1)
	MOVEM	P2,KONDMP(J)
	MOVE	P2,DRBBLK##(T1)
	MOVEM	P2,UNIBLK(U)
	HRRZM	F,UNICDA(U)
	MOVE	P2,DRBSWA##(T1)
	MOVEM	P2,UNISWA(U)
	LDB	P2,DRYJOB##
	MOVEM	P2,UNIJOB(U)
	MOVEI	P2,DRPNFI##	;WORTH RESTORING, IT MUST BE FILLED IN
	ANDCAM	P2,DRBSTS##(T1)
	POPJ	P,
;ROUTINE TO ALLOCATE A DRB
;YOU MUST DISABLE DISK INTERRUPTS BEFORE CALLING THIS ROUTINE
;RETURNS CPOPJ1 WITH T1=DRB
;RETURNS CPOPJ IF NO DRBS (THE DDB HAS ALREADY BEEN QUEUED,
;AND INTERRUPTS ARE BACK ON)

GETDRB:	MOVEI	T2,SIZDRB##	;#SIZE OF A DRB
	PUSHJ	P,GETWDS##	;#GET SPACE FOR IT
	  JRST	GTDRBE		;#NO FREE SPACE
	SETZM	(T1)		;#ZERO THE DRB
	MOVS	T2,T1
	HRRI	T2,1(T1)
	BLT	T2,SIZDRB##-1(T1)
	MOVEI	T2,DRPNFI##	;#NOT FILLED IN YET
	MOVEM	T2,DRBSTS##(T1)
	HLRZ	T2,ACTDRB##	;#LINK TO END OF ACTIVE LIST
	HRLM	T1,ACTDRB##
	HRRM	T1,DRBLNK##(T2)
	HRLI	T2,ACTDRB##
	MOVSM	T2,DRBLNK##(T1)
	JRST	CPOPJ1##

GTDRBE:	SKIPE	DINITF##	;#DURING INITIALIZATION?
	STOPCD	.,STOP,NODRB,	;++CAN'T ALLOCATE DISK IORB DURING ONCE
	AOS	ROODRB##	;#COUNT IT
	MOVSI	T1,KOPCNA	;#LIE ABOUT CREDITS SO CRNPOS DOESN'T KAF
	IORM	T1,KONCNA(J)
	SKIPL	DEVSWP##(F)	;#SWAPPER?
	JRST	UUOPW2		;#NO, POSITION WAIT
	JRST	DOPOPJ		;#YES, DON'T QUEUE SWPDDB

;ROUTINE TO RETURN A DRB TO THE FREE POOL
;YOU MUST DISABLE DISK INTERRUPTS BEFORE CALLING THIS ROUTINE
;T1 PASSES ADDR OF DRB
GIVDRB:	HLRZ	T2,DRBLNK##(T1)	;#PRED
	HRRZ	T3,DRBLNK##(T1)	;#SUC
	HRRM	T3,DRBLNK##(T2)	;#UNLINK FROM ACTIVE LIST
	HRLM	T2,DRBLNK##(T3)
	MOVEI	T2,SIZDRB##	;#SIZE OF A DRB
	EXCH	T1,T2		;#SWAP FOR CALL TO GIVWDS
	PUSHJ	P,GIVWDS##	;#RETURN THE DRB SPACE
IFE FTCIDSK,<
	POPJ	P,		;#RETURN
>; END IFE FTCIDSK
IFN FTCIDSK,<
	SKIPN	DINITF##	;#DON'T SCREW AROUND DURING ONCE
	PUSHJ	P,INTLVL##	;#AT INTERRUPT LEVEL?
	  POPJ	P,		;#DON'T CHANGE UBR AT UUO LEVEL
	DSKON
	PUSHJ	P,SSEUB		;SAVE UBR
	PUSH	P,F		;SAVE DDB
	PUSH	P,U		;SAVE UNIT
	MOVEI	U,SYSUNI##-UNISYS
GVDRB1:	HLRZ	U,UNISYS(U)	;GET NEXT UNIT
	JUMPE	U,GVDRB2	;NONE LEFT
	MOVE	J,UDBKDB(U)	;MULTIPLE XFERS?
	SKIPL	KONMX(J)
	JRST	GVDRB1		;NO
	PUSHJ	P,CRNPOS	;WAKE ANYBODY IN PW
	JRST	GVDRB1
GVDRB2:	POP	P,U		;RESTORE ORIGINAL UNIT
	MOVE	J,UDBKDB(U)	;ORIGINAL KON
	MOVE	P1,KDBCHN(J)	;ORIGINAL CHAN
	JRST	FPOPJ##		;RESTORE DDB
>; END IFN FTCIDSK
IFN FTCIDSK,<
CIBAD:	SKIPL	KONMX(J)	;MULTIPLE XFERS?
	POPJ	P,		;NO
	STOPCD	CPOPJ##,JOB,HSF,;++HSC50 NOT FANCY
>

IFN FTCIDSK,<
;ROUTINE TO RETRY SWAP REQUESTS THAT WENT OFF-LINE
;THIS IS NORMALLY DONE VIA UNITIM, BUT CI DISKS CAN
;HAVE MULTIPLE XFERS IN PROGRESS AT THE SAME TIME, AND UNITIM
;CAN ONLY TIME ONE OF THEM.
RESWP:	MOVE	T1,LOCSEC##	;TIME TO TRY AGAIN?
	IDIVI	T1,DSKTIM##
	JUMPN	T2,CPOPJ##
RESWP4:	MOVEI	P3,ACTDRB##-DRBLNK##;PRESET PRED
RESWP2:	DSKOFF
RESWP1:	HRRZ	P3,DRBLNK##(P3)	;#STEP TO THE NEXT DRB
	JUMPE	P3,DOPOPJ	;#PARANOIA
	CAIN	P3,ACTDRB##
	JRST	DOPOPJ		;#NONE
	MOVE	T3,DRBSTS##(P3)	;#NEED TO RETRY THIS ONE?
	TRNN	T3,DRPTRY##
	JRST	RESWP1		;#NO
	HRRZ	F,DRBCDA##(P3)	;#DDB
IFN FTMP,<
	LDB	T2,DRZCPU##	;#THIS CPU?
	CAME	T2,.CPCPN##
	JRST	RESWP1		;#NO
IFN FTKL10,<
	MOVE	P1,DRBSWA##(P3)	;#SWPLST ADDR
	CAIN	F,SWPDDB##	;#IS THIS A SWAP?
	TLNE	P1,-1		;#PAGES CAN'T BE FRAGMENTED
	JRST	RESWP3		;#NOT A PAGE SWAP
	MOVE	T1,SWPLST##(P1)	;#GET SWPLST ENTRY
	TLNE	T1,(SL.DIO)	;#OUTPUT?
	TLNE	T1,(SL.SIO)	;#AND PAGING?
	JRST	RESWP3		;#NO
	PUSHJ	P,SW2LC##	;#COMPUTE SWPLST OFFSET
	HRRZ	J,SW3LST##(T1)	;#GET JOB NUMBER
	PUSHJ	P,SBCCSH##	;#DOES JOB HAVE STUFF IN CACHE?
	  JRST	RESWP3		;#CACHE IS OK
	MOVSI	T1,(CR.DET)
	SKIPL	.CPOK##-.CPCDB##(T4);#IS THAT CPU RUNNING?
	TDNN	T1,.CPRUN##-.CPCDB##(T4);#NO, IS IT DETACHED?
	JRST	RESWP1		;#WAIT FOR CPU TO SWEEP
	MOVEI	T1,OPWRT##+IODERR;#NOT RUNNING AND DETACHED,
	MOVE	T3,P3		;#GIVE HIM A SWAP READ ERROR
	SETZ	T4,
	PUSHJ	P,FLHTID
	JRST	RESWP4
RESWP3:
>
>
	MOVEI	T2,KONERM+DRPTRY##;#ANCIENT HISTORY
	ANDCAM	T2,DRBSTS##(P3)
	LDB	J,DRZJOB##	;#JOB NUMBER
	PUSHJ	P,MKADD##	;#MAKE IT ADDRESSABLE
	MOVE	S,DEVIOS(F)	;#I/O BIT
	HLRZ	U,DRBCUR##(P3)
	MOVE	J,UDBKDB(U)
	MOVE	P1,KDBCHN(J)
	MOVE	T1,P3
	PUSH	P,F		;#SAVE DDB
	PUSHJ	P,STARTG	;#DO THE TRANSFER
	POP	P,F
	CAIE	F,SWPDDB##	;SWAPPER?
	JRST	RESWP4		;IF FILE GOT TO BADUNI THEN DRB IS GONE
	JRST	RESWP2
>
;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	SETI12		;#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
	SKIPE	DEVRHB##(F)	;IF NOT REREADING HOME BLOCKS
	SKIPGE	DEVSWP##(F)	; AND NOT THE SWAPPER
	JRST	SETID3
	JRST	SETID2
SETID1:	TLNN	P3,-1		;COMPLETE ANY BUFFERS?
	TLO	S,IOSTBL	;NO, GET BACK TO UUO LEVEL WITH PARTIAL BUFFER
SETID2:	TRZ	S,IOACT		;FIGHT RACE
	PUSHJ	P,STDIOD##	;WAKE JOB IF IN IOWAIT
	PUSHJ	P,CLRACT##	;GET IOACT OFF IN DDB NOW (DUAL CPU RACE)
;HERE TO SET FILE TO IDLE
SETID3:	SKIPL	DEVSWP##(F)	;IF NOT THE SWAPPER

	TLZ	S,IOSMON	;MAKE SURE IOSMON IS OFF
	SKIPE	DEVRHB##(F)
	JRST	SETID4
	SOSL	HOMFLG##
	JRST	RERED0		;COUNT IS STILL REASONABLE
	STOPCD	.+1,DEBUG,RHN,	;++REREAD-HOMEBLOCK-COUNT NEGATIVE
	SETZM	HOMFLG##	;MAKE IT REASONABLE
	JRST	RERED1		;THIS DIDN'T HAPPEN
RERED0:	MOVSI	T2,UNPRHB	;CLEAR REREAD HOME BLOCKS
	ANDCAM	T2,UNIDES(U)	; FROM UDB
	MOVEI	T2,UNPRHP
	ANDCAM	T2,UNIRHP(U)
	TRNE	S,IOIMPM	;READ GO OK?
	JRST	RERED1		;WENT OFF-LINE AGAIN
	MOVS	T1,HOMBUF##
	TRNN	S,IODERR+IODTER	;ANY DATA ERRORS
	CAIE	T1,'HOM'	;AND IS FIRST WORD HOME?
	JRST	RERED2		;NO, READ DIDN'T GO OK
	MOVE	T1,UNIHID(U)	;READ OK, IS IT WHAT WE EXPECT?
	CAME	T1,HOMBUF##+HOMHID##
	JRST	REREDA		;NO, HOME BLOCKS DONT MATCH
	PUSHJ	P,FJCONT##	;YES, FORCE A JCONT
RERED1:	PUSHJ	P,CLRDDB##	;ALL IS WELL, GIVE UP DDB
	SETZB	F,UNISTS(U)	;SET UNIT IDLE (ONLY THIS PORT)
	JRST	SETID5		;AND CONTINUE
;HERE IF CANT READ HOME BLOCKS OR NO MATCH
REREDA:	MOVE	T2,DEVBLK##(F)	;GET BLOCK WE READ
	SOJN	T2,RERED2	;IF IT WASN'T FIRST HOME BLOCK,BOTH ARE BAD
	PUSH	P,F		;SAVE F AND U
	PUSH	P,U
	MOVE	U,OPRLDB##	;TALK TO OPR
	PUSHJ	P,INLMES##
	BYTE	(7)7,7,7,7,7	;SOME BELLS
	ASCIZ	/
Error trying to reread 1st HOME block,
Attempting to read 2nd HOME block on /
	MOVE	T2,(P)		;UDB
	MOVE	T2,UDBNAM(T2)	;PHYSICAL UNIT
	PUSHJ	P,PRNAME##	;TYPE IT OUT
	PUSHJ	P,CRLF##	;CARRIAGE RETURN
	POP	P,U		;RESTORE U AND F
	POP	P,F
	AOS	HOMFLG##	;SET TO READ 2ND HOME BLOCK
	HRRZ	T1,UNIHOM(U)	;2ND HOME BLOCK NUMBER
	JRST	TSTRH1		;START THE READ AND RETURN
;HERE WHEN BOTH HOME BLOCKS ARE BAD 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	SETID9		;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
	MOVE	U,OPRLDB##	;TALK TO OPR
	MOVS	T2,HOMBUF##
	TRNN	S,IODTER+IODERR	;WAS IT AN I/O ERROR?
	CAIE	T2,'HOM'	;OR HOME BLOCK BAD?
	JRST	RERED4		;YES,THEN WHO KNOWS WHAT PACK IT IS?
	PUSHJ	P,INLMES##	;NO, HOME BLOCKS DON'T MATCH, WRONG PACK UP
	BYTE	(7)7,7,7,7,7	;SOME BELLS
	ASCIZ	/
Wrong pack powered up on /
	JRST	RERED5
RERED4:	PUSHJ	P,INLMES##	;ERROR IN HOME BLOCKS
	BYTE	(7)7,7,7,7,7	;SOME BELLS
	ASCIZ	/
Error trying to reread HOME blocks on /
	MOVSI	T2,'???'	;WHAT WE READ
	MOVEM	T2,HOMBUF##+HOMHID##
RERED5:	MOVE	T2,(P)		;UDB
	PUSH	P,UNIHID(T2)	;SAVE WHAT WE THINK IT IS
	MOVE	T2,UDBNAM(T2)	;PHYSICAL NAME
	PUSHJ	P,PRNAME##
	PUSHJ	P,INLMES##
	ASCIZ	/ is /
	MOVE	T2,HOMBUF##+HOMHID## ;WHAT WE READ
	PUSHJ	P,PRNAME##
	PUSHJ	P,INLMES##
	ASCIZ	/, should be /
	POP	P,T2		;WHAT WE EXPECT
	PUSHJ	P,PRNAME##
	MOVS	T2,HOMBUF##
	TRNN	S,IODTER+IODERR	;NO I/O ERRORS?
	CAIE	T2,'HOM'	;HOME BLOCK OK?
	JRST	[PUSHJ	P,CRLF## ;NO,THEN CORRECT PACK IS ALREADY MOUNTED
		JRST	RERED6]	;EXIT
	PUSHJ	P,INLMES##
	ASCIZ	/
Please dismount it and mount the correct pack
/
RERED6:	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	SETID9		;AND FIND SOMETHING ELSE TO DO

IFN FTMDA,<
;SUBROUTINE TO SEND A MESSAGE TO THE MOUNTABLE DEVICE ALLOCATOR
CALMDA:	MOVE	T1,UDBNAM(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 BADUN1 TO SET THE FILE IDLE. DON'T CLEAR IOSMON
SETID4:
IFN FTMP,<
	DSKOFF
>
IFE FTCIDSK,<
	MOVEI	T1,ICOD		;SET FILE AND UNIT IDLE
	PUSHJ	P,FILCOD
>
IFN FTCIDSK,<
	MOVE	T1,UNISTS(U)	;OPR WAIT?
	CAIE	T1,OCOD
	CAIN	T1,O2COD
	SKIPL	KONMX(J)	;AND MULTIPLE XFERS?
	MOVEI	T1,ICOD		;NO, SET IT IDLE
	MOVEM	T1,UNISTS(U)	;YES, LEAVE IT ALONE
	MOVEI	T1,ICOD		;ALWAYS SET DDB IDLE
	DPB	T1,DEYCOD##
>
SETID5:
IFN FTDUAL,<
	SKIPN	UNIQUE(U)	;THIS UNIT GOING IDLE?
	SKIPN	T3,UNI2ND(U)	;YES, IS THERE A PRIME UNIT?
	JRST	SETID8		;NO
	SKIPN	UNIQUE(T3)	;YES, PUT POS. QUEUE OF PRIME UNIT
	JRST	SETID8		;PRIME UNIT IDLE - NO PROBLEMS
IFN FTKL10&FTMP,<
	MOVE	T1,UDBCAM(T3)	;IS THE OTHER PORT ON THIS CPU?
	CAMN	T1,.CPBIT##	;BOTH PORTS ON SAME CPU?
	JRST	SETID7		;YES
	PUSHJ	P,CPUOK##	;NO, IS OTHER CPU ALIVE?
	  JRST	SETID8		;NO, WAIT FOR DSKRQT
IFN FTCIDSK,<
;THIS CODE ISN'T VERY EFFICIENT FOR AN HSC50.
;IF WE EVER GET AN HSC50 WITH DISKS WHICH ARE TRUELY DUAL PORTED,
;THEN WE MIGHT WANT TO REWRITE THIS CODE.
>
;HERE IF THIS PORT IDLE, OTHER PORT HAS A POSITION QUEUE, OTHER PORT ON ANOTHER CPU
; WE CAN'T SIMPLY SWITCH QUEUE TO OTHER PORT SINCE THE IO ISN'T RIGHT WRT OUR CACHE
	PUSHJ	P,PWQSP		;QUEUE A CLOCK REQUEST FOR SECOND PORT
	JRST	SETID8
SETID7:	>		;END FTKL10&FTMP
	HRRZ	T3,UNI2ND(U)	;SECOND PORT
	MOVE	T2,UNIQUE(T3)	;1ST DDB
	MOVEM	T2,UNIQUE(U)	; ONTO THIS UNIT INSTEAD, TO START SEEK
	SETZB	T2,UNIQUE(T3)	; ON THIS UNIT NOW. PRIME UNIT HAS NO QUEUE NOW
	EXCH	T2,UNIQUL(T3)
	MOVEM	T2,UNIQUL(U)
	SKIPL	DEVSWP##(F)
	JRST	SETID8
	HRRZS	UNICDA(T3)	;INDICATE OTHER PORT IS ACTIVE
	HRROS	UNICDA(U)	; (FOR SPURIOUS INTERRUPT TEST)
SETID8:>	;END FTDUAL
IFN FTCIDSK,<
	SKIPL	KONMX(J)	;LEAVE UNISTS ALONE
>
	SKIPN	UNIQUE(U)	;POSITIONS WAITING?
	SKIPA	T1,UNISTS(U)	;NO, LEAVE UNISTS ALONE
	MOVEI	T1,PWCOD	;YES, SET STATUS
	MOVEM	T1,UNISTS(U)
IFN FTMDA,<
	SKIPE	UNIQUE(U)	;UNIT GOING IDLE?
	JRST	SETID9		;NO
	MOVE	T1,UNIDES(U)	;YES.  ONLY READABLE BY MDA?
	MOVEI	T2,MDACOD
	TLNE	T1,UNPWMD
	MOVEM	T2,UNISTS(U)	;YES.  RESET UNISTS
>
SETID9:
IFN FTDUAL,<
	SKIPN	UNIQUE(U)	;IF PORT B OF DUAL-PORTED DRIVE
			 	; LEAVE THE A-SIDE IN T STATE
				; TO PREVENT SWPSCN FROM STARTING
	PUSHJ	P,SECCOD
>
	PUSHJ	P,FLPJOB	;FLIP UNIJOB AND UNICDA
	SETZM	UNITIM(U)
	JUMPE	F,SETI12
	SKIPGE	DEVSWP##(F)	;SWAPPER?
	JRST	SETI11		;YES, TELL VMSER ABOUT THE REQUEST
	TRNE	S,IOACT		;NO, DID WE ALREADY CLEAR IOACT?
	PUSHJ	P,CLRACT##	;CLEAR IOACT
	JRST	SETI12		;CONTINUE
IFN FTMP&<FTKL10&FTDUAL!FTCIDSK>,<
;HERE WHEN THE OWNING CPU HITS THE NEXT CLOCK TICK. CRANK THE UNIT UP IF IDLE
SETI10:	MOVE	U,T1		;UNIT WE WANT TO START
	PUSHJ	P,SSEUB##
	PUSHJ	P,SAVE1##
	MOVE	P1,UDBKDB(U)	;POINT AT CHAN IN CASE ON CYLINDER
	MOVE	P1,KDBCHN(P1)
	DSKOFF
	MOVEI	T1,UNPPWQ	;CLOCK REQUEST NOT OUTSTANDING
	ANDCAM	T1,UNIPWQ(U)
	SKIPE	DIADSK##	;TRYING TO SHUT DOWN I/O
	CAME	P1,DIACHN##	;YES, FOR THIS CHANNEL?
	CAIA			;NO
	JRST	DOPOPJ		;YES, DON'T START ANYTHING
	PUSHJ	P,CRNPOS	;YES, START THE SEEK NOW
	PJRST	DOPOPJ		;PION AND RETURN

;ROUTINE TO SEND A CLOCK REQUEST TO THE OTHER CPU.
;THE OTHER CPU WILL PROCESS THE POSITION WAIT QUEUE.
;HERE WITH T1=CPU
IFN FTCIDSK,<
PWQPP:	SKIPA	T3,U		;PRIME PORT
>
PWQSP:	HRRZ	T3,UNI2ND(U)	;SECOND PORT
	MOVEI	T2,UNPPWQ	;ALREADY QUEUED A CLOCK REQUEST?
	TDNE	T2,UNIPWQ(T3)
	POPJ	P,		;YES, DON'T OVERFLOW THE QUEUE
	IORM	T2,UNIPWQ(T3)	;NO, WILL QUEUE ONE
	MOVEI	T2,SETI10	;ROUTINE ADDR
	;JRST	QUECLK		;QUEUE IT
> ;END FTMP&<FTKL10&FTDUAL!FTCIDSK>

IFN FTMP,<
;ROUTINE TO QUEUE A CLOCK REQUEST
;T1 PASSES CPU NUMBER
;T2 PASSES ROUTINE ADDR
;T3 PASSES DATA
QUECLK::DPB	T1,[POINT 3,T3,3];CPU
	TLO	T3,(1B0)	;ONLY THIS CPU WILL DO
	HRLZS	T2		;ROUTINE IN LH
	HRRI	T2,1		;ONE TICK
	SYSPIF			;NO INTERRUPTS
	IDPB	T2,CLOCK##	;INSERT QUEUE ENTRY
	IDPB	T3,CLOCK##
	SETZM	CLKMIN##(T1)	;RE-SCAN CLOCK QUEUE
	PJRST	ONPOPJ##	;RE-ENABLE INTERRUPTS AND RETURN
>
SETI11:	HRRZ	T1,P4		;NUMBER OF BLOCKS
	MOVE	P1,P3		;SWPLST ADDRESS
	PUSH	P,U
	PUSHJ	P,DONE##
	MOVEI	F,SWPDDB##
	POP	P,U
	MOVE	J,UDBKDB(U)	;DONE ZAPS EVERYBODY
	MOVE	P1,KDBCHN(J)
	MOVSI	T1,UNPUNO
	ANDCAM	T1,UNIDES(U)


SETI12:
IFN	FTMP,<
	DSKON
>
	MOVEI	F,SWPDDB##	;MAKE SURE F POINTS TO THE SWAPPER
	SKIPN	SQREQ##		;SWAPPER GOING?
	JRST	SETI13		;NO
	SKIPN	P1		;AT UUO LEVEL?
	AOSA	.CPSWP##	;YES, FORCE SWPSCN TO BE CALLED AT UUO LEVEL
	PUSHJ	P,SWPSCN##	;YES, START SWAP SEEKS FIRST
SETI13:	JUMPE	P1,CHNIDX	;DONT START IO (CHANGE UBR) AT UUO LEVEL
	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:	SKIPLE	DIADSK##	;IF WAITING FOR DIAG
	CAME	P1,DIACHN##	; FOR THIS CHANNEL
	CAIA
	JRST	PIKTRX		;DON'T START ANOTHER SEEK

	PUSH	P,U		;SAVE U (LAST UNIT TO LOOK AT)
KONLUP:	HRR	U,UNIKON(U)	;STEP TO NEXT UNIT IN RING
	PUSHJ	P,UNIPOS	;START UNIT POSITIONING
	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
	MOVE	J,UDBKDB(U)	;GET KON BACK
	JRST	PIKTRX		;GO LOOK FOR A FILE TO START XFER ON

;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

;ROUTINE TO START POSITIONING DURING CRANK-UP
CRNPOS:	MOVE	J,UDBKDB(U)	;KDB
	MOVE	P1,KDBCHN(J)	;CHAN
	SKIPGE	KONBSY(J)	;KONTROLLER BUSY?
	POPJ	P,		;YES, WAIT TILL XFER DONE

;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:	SKIPE	T1,UNIQUE(U)	;POSITIONS WAITING?
	SKIPE	T1,UNISTS(U)	;AND EITHER IDLE OR PW?
	CAIN	T1,PWCOD
	PUSHJ	P,RHBP		;AND DON'T NEED TO REREAD HOME BLOCKS?
	  POPJ	P,
IFN FTCIDSK,<
	SKIPGE	KONCNA(J)	;MUST HAVE CREDITS
	POPJ	P,
>
	PUSHJ	P,SAVE4##
UNIPS1:	DSKON
	PUSH	P,S		;SAVE S
	HRLOI	P3,377777	;SET P3 (BEST DISTANCE) TO PLUS INFINITY
	MOVEI	F,UNIQUE-DEVQUE##(U)	;ADDR OF 1ST LINK
IFE FTMP&FTCIDSK,<SETZ P4,>	;NONE SO FAR
IFN FTMP&FTCIDSK,<
	TDZA	P4,P4
PWQLP6:	PUSHJ	P,PWQPP		;TELL THE OTHER CPU
>
PWQLP8:	MOVE	S,F		;SAVE PRED
	MOVS	F,DEVQUE##(F)	;STEP TO NEXT DDB
	JUMPE	F,PWQLP7	;GO IF NONE LEFT
	HLRZ	J,F		;JOB NUMBER WHICH OWNS DDB
	PUSHJ	P,MKADD##	;MAKE IT ADDRESSABLE
IFN FTMP&FTCIDSK,<
	LDB	T1,DEYPCL##	;CAN WE DO IT ON THIS CPU?
	CAIN	T1,PCLCP0##
	SETZ	T1,
	CAME	T1,.CPCPN##
	JRST	PWQLP6		;NO
>
	PUSHJ	P,CYLCMJ	;COMPUTE DISTANCE TO TARGET CYLINDER
	MOVMS	T2,T1		;ABSOLUTE VALUE
	TLO	T1,20000	;THIS BIT MEANS OFF CYL
	JUMPN	T2,PWQLP9	;GO IF REALLY IS OFF CYL
	MOVE	T1,DEVBLK##(F)	;GET BLOCK NUMBER BACK
	PUSHJ	P,@KONLTM(J)	;GET ROTATIONAL LATENCY
	  SETZ	T1,
PWQLP9:	PUSHJ	P,DFPRI
	MOVNI	T2,MXNDPR##(T2)
	TLNE	T1,20000
	DPB	T2,[POINT 3,T1,3]

	SKIPLE	CHNCFP(P1)	;IS IT TIME TO BE FAIR?
	CAMG	T1,P3		;NO, IS THIS BEST SO FAR?
	PUSHJ	P,SVBST		;YES, SAVE POINTERS TO IT
				;P4=BEST F,P3=DIST TO BEST P2=PRED. F
	JRST	PWQLP8		;LOOP
PWQLP7:	POP	P,S		;RESTORE S
	JUMPE	P4,CPOPJ##	;NOTHING TO DO
	DSKOFF
IFN FTMP,<
				;#SWPSCN AT CLOCK LEVEL ON OTHER CPU
	MOVE	T2,UNISTS(U)	;# COULD START AN OPERATION ON UNIT
	CAIE	T2,PWCOD	;# SO INTERLOCK AND CHECK
	JUMPN	T2,DOPOPJ	;WE DON'T OWN UNIT ANYMORE.
>
;HERE P4 HAS POINTER TO BEST FILE, P2=PREDECESSOR, P3=DISTANCE
	MOVE	F,P4		;#SET F TO FILE
	PUSHJ	P,UNQUER	;#REMOVE FILE FROM Q
	  JRST	UNIPS1		;#RACE, TRY AGAIN
	SOS	UNIQUL(U)	;#COUNT IT
	TLNE	P3,20000	;#ALREADY ON CYLINDER?
	PUSHJ	P,TSTGEN	;#OR FILE STR REMOVED?
	  JRST	PWQOK		;#YES, SET TO TW
	MOVE	T1,KONPOS(J)	;#OK TO POSITION?
	TLNN	T1,KOPPWX
	SKIPL	KONBSY(J)
	JRST	STRPOS		;#YES, START POSITION GOING
	CONSZ	PI,PI.IPA-PI.IP7;#AT INTERRUPT LEVEL?
	JRST	STRPOS		;#YES, IGNORE BUSY BIT
;RACE: WE WERE AT CLOCK LEVEL WITH INTERRUPTS ON, WE GOT A POSITION DONE
;INTERRUPT (ON SOME OTHER DRIVE) AND STARTED A TRANSFER.
	JRST	UUOPW2		;#BACK INTO THE QUEUE

;HERE IF A FILE IS ALREADY ON CYLINDER
PWQOK:	PUSH	P,S		;#SAVE S
	PUSHJ	P,STORF		;SO SWAPPER WILL KNOW
IFN FTDUAL,<
	PUSH	P,U
	HRRM	U,DEVCUR##(F)	;#IN CASE OF SETID7
>
	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
	MOVE	J,UDBKDB(U)	;THEN U, J AND P1 WERE CHANGED
	MOVE	P1,KDBCHN(J)	;SO RESET THEM
>
	POP	P,S		;RESTORE S
IFN FTCIDSK,<
	SKIPL	KONCNA(J)	;CREDITS AVAILABLE?
	SKIPL	KONMX(J)	;AND MULTIPLE XFERS?
	POPJ	P,		;NO
	JRST	UNIPS1		;TRY TO START ANOTHER
;NOTE THAT WE DELIBERATELY TAKE THE OLDEST GUY OUT OF THE QUEUE.
;THIS WILL INSURE FAIRNESS IF WE ARE SITTING RIGHT ON THE CREDIT LIMIT.
;NOTE THAT FOR A CI DISK, THE CREDIT CONSTRAINT IS PROBABLY THE REASON
;THE GUY WAS PUT IN PW TO BEGIN WITH.
>
	POPJ	P,
;SUBROUTINE TO UPDATE DDB, ADVANCE BUFFERS AFTER A DATA TRANSFER
;ENTER WITH P4=CHNNUM= NUMBER OF BLOCKS TO ADVANCE
;RETURNS WITH P3=ADVBFE OR ADVBFF DEPENDING ON INPUT OR OUTPUT
; AND LH(P3)=NUMBER OF BUFFERS DONE
;CHANGES P3,P4
BUFAD:	PUSH	P,P4		;SAVE NUMBER OF BLOCKS
	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
	TLNE	S,IOSUPR	;IO FROM SUPER USETI/USETO?
	JRST	BUFAD2		;YES. DONT TOUCH A.T.

	MOVE	T1,DEVACC##(F)	;NO, GET A.T.
	ADDB	P4,DEVREL##(F)	;UPDATE CURRENT RELATIVE BLOCK NUMBER
IFN FTCIDSK,<
	SKIPL	KONMX(J)
>
	SETZM	KONDMP(J)	;INDICATE WE'RE DONE
	SOJN	P4,BUFAD1	;-1=HIGHEST BLOCK WRITTEN
	TLO	S,IOSFIR	;NEXT BLOCK = 1 - SET FOR CHKSUM
	MOVEM	S,DEVIOS(F)	;SAVE S IN DDB
BUFAD1:	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?
BUFAD2:	TLZA	P3,-1		;NO, LH(P3)=0
	HRL	P3,T1		;YES, LH(P3)=LOC OF A.T.
	POP	P,P4		;NUMBER OF BLOCKS TRANSFERRED AGAIN
	JUMPGE	P2,BUFAD3	;GO IF NOT DUMP  MODE
	SKIPGE	T3		;DUMP MODE. HAS LENGTH INCREASED
	PUSHJ	P,RBCHD		;YES, SET FOR PSI/REWRITE RIB
	MOVEI	T1,UNIDRC(U)	;SET FOR DUMP-MODE STATS
	PJRST	UPSTA		;UPDATE UNIDRC(DWC) AND RETURN
;HERE TO ADVANCE BUFFERS
BUFAD3:	MOVEI	T1,UNIBRC(U)	;SET TO UPDATE BUFFERRED-MODE STATS
	PUSHJ	P,UPSTAT	;UPDATE UNIBRC(BWC)
	HRRI	P3,ADVBFO##	;SET TO ADVANCE BUFFERS
	TLNE	S,IO
	JRST	BUFAD4
	HRRI	P3,ADVBFI##
	TLNE	P3,-1		;IF READING AT END
	TLZ	S,IOSPBF	;ITS AN EOF, NOT A PARTIAL
BUFAD4:	LDB	T1,DEYNB1##	;NUMBER OF BLOCKS IN BUFFER BEFORE START
	ADD	T1,P4		;PLUS NUMBER DONE IN THIS OPERATION
	LDB	T2,DEYNBB##	;NO OF BLOCKS PER BUFFER
	IDIVI	T1,(T2)		;COMPUTE NO OF BUFFERS FINISHED
	SKIPN	T2		;EVEN NUMBER OF BUFFERS?
	TLZA	S,IOSPBF	;YES. MAKE SURE PBF=0 (HARD ERROR COULD HAVE IT ON)
	TLNE	S,IOSPBF	;NO, FINISH A PREVIOUS PARTIAL?
	SOS	T1		;EVEN OR A PREVIOUS PARTIAL
	MOVEM	S,DEVIOS(F)
	AOSE	P4,T1		;P4=NUMBER OF BUFFERS WE FINISHED
	JRST	BUFAD5		;GO IF AT LEAST 1

;HERE WITH NO COMPLETED BUFFERS
	TLZE	P3,-1		;AT EOF?
	TLNN	S,IO		;NOT EOF. WRITING
	JRST	CPOPJ1##	;EOF OR PARTIAL WHILE READING
	PUSH	P,P4		;PARTIAL BUFFER WHILE WRITING AT EOF
	MOVE	T2,DEVACC##(F)	;MAKE STACK, ACS RIGHT
	SOJA	P4,BUFAD7	;SET P4 NEGATIVE AND FIX UP A.T.

;HERE WITH AT LEAST 1 FINISHED BUFFER
BUFAD5:	PUSH	P,P4
IFN FTKL10&FTMP,<
	TLNE	S,IO		;WRITING?
	JRST	BUFAD6		;YES, CONTINUE
	PUSHJ	P,STONBF##	;NO, UPDATE NUMBER OF BUFS WE'VE SWEPT FOR
	ADDM	P4,DEVNBF(F)	;UPDATE NUMBER NOT YET SWEPT FOR
>
BUFAD6:	SOJN	P4,BUFA11	;GO IF NOT LAST BUFFER
	HLRZ	T2,P3		;LAST - LOC OF ACC IF I/O TO LAST BLOCK OF FILE
	JUMPE	T2,BUFA11	;NOT LAST BLOCK IF 0
;HERE WHEN DOING I/O TO LAST BLOCK OF THE FILE
	TLNE	S,IO		;WRITING?
	JRST	BUFAD7		;YES, COMPUTE LBS
	LDB	T2,ACYLBS##	;READING LAST BLOCK - GET ITS SIZE
	SUBI	T2,BLKSIZ##	;NOT-FILLED AMOUNT IN LAST BLOCK
	HRRZ	T1,DEVIAD(F)	;GET LOC OF BUFFER
	EXCTUU	<ADDM T2,1(T1)>	;ADJUST LAST BUFFER'S WORDCOUNT
	JRST	BUFA10		;AND FINISH UP
;HERE WHEN WRITING LAST BLOCK OF A FILE - COMPUTE LAST BLOCK SIZE
BUFAD7:	HRRZ	T1,DEVOAD(F)	;ADDRESS OF LAST BUFFER
	EXCTUX	<HRRZ T4,1(T1)>;GET WRDCNT OF LAST BUFFER
	TLNE	S,IOSPBF	;PARTIAL BUFFER WRITTEN?
	EXCTUX	<HLRZ T4,1(T1)>	;YES, GET AMOUNT DONE SO FAR
	JUMPE	T4,BUFAD8	;WHOLE THING IF EMPTY BUF
	EXCTUX	<HLRZ T1,(T1)>	;GET LENGTH OF BUFFER
	TRZ	T1,400177	;CLEAR EXTRANEOUS BITS
	CAMLE	T4,T1		;LEGAL?
	MOVE	T4,T1		;USER SMASHED RING.  ASSUME FULL BUF
	SUB	T1,T4		;NOT-FILLED LENGTH OF LAST BUFFER
	LSH	T1,MBKLSH##	;CONVERT TO BLOCKS
	MOVNS	T1		;NOT-FILLED BLOCKS IN LAST BUFFER
	ADDM	T1,ACCWRT##(T2)	;ADJUST A.T. (BUT LEAVE DEVREL AT EOF)
	TRNE	T4,BLKSIZ##-1	;NON-INTEGRAL NO OF WORDS?
	TRZ	T4,MBLKSZ##	;YES, MAKE SURE .LT 200
	CAILE	T4,BLKSIZ##	;TOO MANY WORDS?
	MOVEI	T4,BLKSIZ##	;YES, REDUCE COUNT
BUFAD8:	JUMPL	T3,BUFAD9	;NEW LAST BLOCK IF NEGATIVE
	MOVE	T3,ACCSTS##(T2)	;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
	CAMG	T3,T4		;CURRENT LENGTH LESS THAN PREVIOUS LENGTH?
	TRZA	T3,-1		;NO, NO NEED TO REWRITE RIB
	MOVE	T4,T3		;YES, SET CURRENT=PREVIOUS LENGTH
BUFAD9:	DPB	T4,ACYLBS##	;SAVE IN ACC
	SKIPE	T3		;IF SIZE CHANGED
	PUSHJ	P,RBCHD		; SET TO REWRITE RIB
	JUMPL	P4,BUFA13	;EXIT IF ONLY PARTIAL AT EOF
	HRRZ	T1,DEVOAD(F)	;GET LOC OF BUFFER
				;FALL INTO BUFA10
BUFA10:
IFN FTKL10&FTMP,<
	ADDI	T1,1
	PUSHJ	P,OUCHE##	;GET STUFF OUT OF CACHE
>
BUFA11:	PUSHJ	P,(P3)		;ADVANCE BUFFERS
	  JRST	BUFA14		;RAN OUT OR ERROR
	TRZ	S,IOIMPM	;CLEAR CHKSUM ERROR
	JUMPG	P4,BUFAD6	;ADVANCE MORE IF NOT LAST BUFFER
	PUSHJ	P,ADVSWP##	;SWAPPER WANTS US TO STOP?
	  JRST	BUFA14		;YES, PLEASE STOP
IFN FTKL10&FTMP,<
	TLNN	S,IO		;WRITING?
	JRST	BUFA12
	PUSHJ	P,CHKNB##	;YES, SEE IF ANY MORE TO DO
	HLRZ	T1,DEVNBF(F)	;IF BUFS HAVENT BEEN SWEPT FOR
	JUMPE	T1,BUFA14	; DONT CONTINUE (JOB IN OTHER CPU'S CACHE)
	JRST	BUFA13		;KEEP ON
BUFA12:	HRRZ	T1,DEVIAD(F)	;GET ADDRESS OF NEXT BUFFER
	PUSHJ	P,BUFSSN##	;SEE IF IT IS OK WITH RESPECT TO THE CACHE
	  JRST	BUFA14		;NO, CAN'T FILL IT NOW
>
BUFA13:	AOS	-1(P)
BUFA14:	HRL	P3,(P)
	MOVE	S,DEVIOS(F)
	JRST	TPOPJ##
;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 FTXMON,<
	HRRZ	T1,DEVISN(F)	;GET CURRENT SECTION FOR I/O, SET PCS FOR
	PUSHJ	P,SVPCS##	; FETCHING CHECKSUM (MAPIO COULD HAVE CHANGED IT)
>
	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
IFN FTKL10&FTMP,<
	MOVE	T1,M		;CHASE WORD FROM CACHE
	PUSHJ	P,OUCHE##	; IN CASE IT RUNS ON OTHER CPU
>
	POP	P,M		;RESTORE STUFF
	POP	P,J		;...

;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
	JUMPE	T4,SETIMP##	;ERROR IF UNIT WAS YANKED
	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
	SKIPL	DEVRIB##(F)	;IO TO FILE CURRENTLY USING EXTENDED RIB?
	POPJ	P,		;NO, RETURN
	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
;SUBROUTINE TO COMPUTE DISTANCE TO TARGET CYLINDER
;ENTER WITH TARGET BLOCK IN DEVBLK(F)
;ENTER AT CYLCMJ TO SETUP KDB ADDRESS FROM UNIKON(U)
;ENTER AT CYLCM WITH T1=BLOCK NUMBER,  T4 PRESERVED
;EXIT WITH T1 =DISTANCE FROM CURRENT CYLINDER TO TARGET CYLINDER
CYLCMJ:	MOVE	J,UDBKDB(U)	;GET KDB ADDRESS
CYLCOM:	MOVE	T1,DEVBLK##(F)	;#TARGET BLOCK
	PJRST	@KONCCM(J)	;GO TO KONTROLLER SPECIFIC CODE
				;  (CYLCM FOR ALL BUT RP20)
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
;F PASSES JOB,,DDB OF CURRENT DDB
;P2 PASSES JOB,,DDB OF PREDECESSOR
UNQUER:	HLRZ	J,F		;JOB NUMBER OF THIS DDB
	PUSHJ	P,MKADD##	; MAKE IT ADDRESSABLE
	MOVE	T2,DEVQUE##(F)	;Q WORD OF FILE
	HLRZ	J,P2
	SKIPE	J		;SAVE TIME IF QUEUE HEADER
	PUSHJ	P,MKADD##	;MAKE PREDECESSOR ADDRESSABLE
	MOVS	J,DEVQUE##(P2)	;IS IT WHAT WE EXPECT?
	CAME	J,F
	POPJ	P,		;RACE
	MOVEM	T2,DEVQUE##(P2)	;SAVE IN Q WORD OF PREDECESSOR
	HLRZ	J,F
	PUSHJ	P,MKADD##	;RETURN WITH THIS DDB ADDRESSABLE
	SETZM	DEVQUE##(F)	;CLEAR QUEUE-WORD
	MOVE	J,UDBKDB(U)	;RESET J TO KONTROLLER DATA BLOCK
	JRST	CPOPJ1##	;AND RETURN
;SUBROUTINE  TO START UNIT POSITIONING
STRPOS::MOVEI	T1,PCOD		;#PUT FILE AND UNIT INTO P STATE
	PUSHJ	P,FILCOD	;#
IFN FTDUAL,<
	PUSHJ	P,SECCOD	;SET MAIN UNIT TO SAME STATE
	HRRM	U,DEVCUR##(F)
>
STRPS1:	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 BADUN1
	SCHEDULE
DOPOPJ::DSKON			;# TURN ALL DISK PI'S BACK ON
	POPJ	P,		;AND RETURN

;HERE IF UNIT NOT READY WHEN TRYING TO START POSITIONING
STRPS2:	SETZM	UNISTS(U)	;SO WE'LL STORE NEW UNISTS
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
	MOVE	J,UDBKDB(U)	;THEN U, J AND P1 WERE CHANGED
	MOVE	P1,KDBCHN(J)	;SO RESET THEM
	POPJ	P,
>

;SUBROUTINE TO SAVE POINTERS TO BEST FILE SO FAR
;P1-P3 CHANGED
SVBST:	MOVEM	F,P4		;P4 = BEST FILE SO FAR
	MOVEM	T1,P3		;P3 = DISTANCE TO BEST
	MOVEM	S,P2		;P2 = PREDECESSOR IN QUEUE
	POPJ	P,
;SUBROUTINE TO SET UP PARAMETERS FOR DEPENDENT ROUTINE
SETPAR:	HRRM	U,CHNCUA(P1)	;#SAVE CURRENT UNIT IN USE ON CHAN
	JRST	SETPR2

SETPRS:	SKIPL	KONBSY(J)	;#DONT STORE NEW KONCUA IF THIS IS A POSITION
				; STARTED WHILE XFER IS ACTIVE

SETPR2:	HRRM	U,KONCUA(J)	;#SAVE CURRENT UNIT ADDR
	PUSHJ	P,STORF		;#SAVE FILE ADDR
IFN FTDUAL,<
	SKIPN	T2,UNI2ND(U)	;IF DUAL-PORTED
	JRST	SETPR1		; AND WE ARE TALKING TO ALTERNATE PATH
	HRRM	F,UNICDA(T2)	;SET UNICDA, UNIJOB ON MAIN PATH
	MOVEM	T3,UNIJOB(T2)	; FOR THIS OPERATION
SETPR1:>
	MOVE	T2,DEVBLK##(F)	;# SAVE LOGICAL BLOCK NR WITHIN UNIT
	MOVEM	T2,UNIBLK(U)	;#IN UNIT DATA BLOCK
	MOVE	S,DEVIOS(F)	;#GET S
	PJRST	SETHNG##	;# 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
	CAIGE	T1,DEVRBN##(F)	;IF END OF POINTER BLOCK
	SKIPN	T2,1(T1)	; OR ZERO (EOF)
	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:	PUSHJ	P,SETF		;SET F TO CURRENT DDB
	JUMPE	F,CPOPJ##	;NONE????
BADUN1:	PUSH	P,P3		;ADDR OF DRB
;HERE WITH ADDR OF DRB ON THE STACK
BADUNC:	HRRZS	UNISTS(U)	;#CLEAR SIGN BIT (PHUNG)
	MOVEM	T2,UNIERR(U)	;#YES, SAVE CONI, DATAI
	MOVEM	T3,UNIHDI(U)	;#
IFN FTCIDSK,<
	MOVSI	T3,KOPCNA	;#GET THE "NO CREDITS" BIT
	TRNE	T1,KOPNOC	;#NOT ENOUGH CREDITS?
	IORM	T3,KONCNA(J)	;#YES, SET SO CRNPOS DOESN'T START ANYTHING
>; END IFN FTCIDSK
	DSKON
	SKIPGE	DEVSWP##(F)	;DON'T RETURN IOWD'S IF THE SWAPPER
	JRST	BADUN2
	PUSH	P,P3
	MOVE	T3,UNISTS(U)	;HAS SETLST RUN YET?
	CAIE	T3,TCOD
IFN FTCIDSK,<
	SKIPGE	KONMX(J)	;HSC50 DOESN'T POSITION
	SKIPA	P3,-1(P)	; THEREFORE SETLST HAS RUN
>
	JRST	BADUNB		;SETLST NOT RUN YET
	PUSH	P,T1
	PUSH	P,P4
	PUSHJ	P,UNLST		;UNDO SETLST
	PUSHJ	P,RTNDRB	;RETURN THE CHANNEL PROGRAM
	POP	P,P4
	POP	P,T1
BADUNB:	POP	P,P3
BADUN2:
IFN FTCIDSK,<
	SKIPL	DEVSWP##(F)	;SWAPPER?
	POP	P,T4		;NO, WE DON'T NEED DRB ANYMORE
	TRNN	T1,KOPNOC	;NOT ENOUGH CREDITS?
	JRST	BADUNE		;ENOUGH
	SKIPGE	DEVSWP##(F)	;SWAPPER?
	JRST	BADUNA		;YES
	DSKOFF
	JRST	BADUNF		;PUT INTO PW
BADUNE:
>
	MOVSI	T4,UNPOFL
	TRNE	T1,KOPFUS	;UNIT GO FILE-UNSAFE?
	TLO	T4,UNPFUS	;YES, LIGHT ANOTHER BIT TOO
	TRNE	T1,KOPUSI
	TLO	T4,UNPUSI
	TRNN	T1,KOPOFL	;UNIT OFF-LINE?
	JRST	BADUN5		;NO, CALL HNGSTP
	IORM	T4,UNIDES(U)	;YES - LIGHT UNIDES BIT
	SKIPE	DEVRHB##(F)	;IF REREADING HOME BLOCKS,
	SKIPE	DINITF##	;OR IF IN ONCE-ONLY CODE,
	JRST	BADUN7		;DONT DO THIS OPR-WAIT STUFF
	MOVE	T2,UNIBLK(U)	;
	MOVEM	T2,UNIHBN(U)	;SAVE BLOCK NUMBER
	AOS	UNIHCT(U)	;BUMP ERROR COUNT
	SKIPGE	UNIECT(U)	;IN ERROR RECOVERY?
	PUSHJ	P,FSTREG	;NO, COPY INITIAL REGISTERS
	PUSHJ	P,LSTER		;COPY REGISTERS FROM KDB TO UDB
	MOVE	T1,[.FIUOF,,.ERDPE] ;FILIO-DETECTED UNIT OFFLINE
	PUSHJ	P,DAEERR##	;AND CALL DAEMAN

	LDB	T1,UNYUST##	;UNIT STATE
	CAIG	T1,UNVPBM	;A PACK MOUNTED?
	JRST	BADLP1		;YES, TELL THE OPERATOR
	MOVEI	T1,O2COD	;NO, THE OPERATOR DOESN'T WANT TO KNOW ABOUT IT
	DSKOFF
	MOVEM	T1,UNISTS(U)	;#SO NO MESSAGES
	PUSHJ	P,FLPJOB	;#FLIP UNIJOB AND UNICDA
	MOVE	S,DEVIOS(F)	;#GET CURRENT DEVIOS
	TDO	S,[IOW,,IODERR]	;#LIGHT IOW SO STDIOD DOES SOMETHING
	TRZ	S,IOACT		;#CLEAR IOACT
	PUSHJ	P,STDIOD##	;#GET OUT OF I/O WAIT
	JRST	BADUNG		;#GO FIND SOMETHING ELSE TO DO
BADLP1:	MOVE	T1,[XWD TELOPC,1];SET FOR CLOCK REQUEST
	CONSO	PI,PIPROG##-PI.IP7 ;ON PI LEVEL?
	JRST	BADLP2		;NO
	SYSPIF			;SET TO STORE IN THE CLOCK QUEUE
	PUSHJ	P,SKPCLQ##	;ROOM IN CLOCK QUEUE FOR MESSAGE?
	  JRST	BADL1A		;NO, PROBABLY LOTS OF OTHER ERRORS, LET IT GO
	IDPB	T1,CLOCK##	;YES, TELL OPR ON NEXT TICK
	IDPB	U,CLOCK##	;SAVE ADR OF UDB
	SETOM	CLKNEW##
BADL1A:	SYSPIN			;IN ORDER TO TYPE MESSAGE TO OPR
	CAIA			;DONT TELL OPR NOW IF ON PI LEVEL
BADLP2:	PUSHJ	P,TELOPR	;NOT ON PI LEVEL - TYPE MESSAGE NOW
	SKIPGE	DEVSWP##(F)	;IF THE SWAPPER,
	PJRST	BADUNA		; LET SWPHNG RECOVER
	MOVEI	T1,OCOD		;MESSAGE
	DSKOFF
	MOVEM	T1,UNISTS(U)	;#STORE UNIT STATUS
IFN FTDUAL,<
	SKIPN	T2,UNI2ND(U)	;SECOND PORT?
	JRST	BADLP3		;NO
	MOVE	T3,UNISTS(T2)	;YES, GET UNIT STATUS
	CAIGE	T3,OWCOD	;ALREADY IN SOME FLAVOR OF OPR WAIT?
	MOVEM	T1,UNISTS(T2)	;PREVENT TRANSFERS VIA ALTERNATE PORT
BADLP3:
>; END IFN FTDUAL
	PUSHJ	P,FLPJOB	;#FLIP UNIJOB AND UNICDA
;#WE SHOULDN'T CHANGE THE UBR AT UUO LEVEL SO PUT
;#THE GUY IN POSITION WAIT AND LET DSKSEC MOVE THE PWQ
;#TO UNICHK
BADUNF:	PUSHJ	P,UUOPW2	;#ADD DDB TO PWQ
BADUNG:	PUSH	P,F		;#SAVE F
	PUSHJ	P,INTLVL##	;#IF ON UUO LEVEL AND A SEEK FINISHED
	  SETZ	P1,		;# CAN'T START IT - CANT CALL SVEUB
	MOVE	J,UDBKDB(U)
	PUSHJ	P,SETI12	;#GO FIND SOMETHING ELSE TO DO
				;#THIS (UNIT WONT BE USED TILL COMES OUT OF OW)
	POP	P,F		;RESTORE F
	PJRST	DOPOPJ

;HERE WHEN THE UNIT DID NOT GO OFF-LINE (PROBABLY WRITE-LOCK)
BADUN5:	SKIPGE	DEVSWP##(F)	;SWAPPER NEVER GIVES UP
	JRST	BADUNA
	PUSHJ	P,FLPJOB	;FLIP UNIJOB AND UNICDA
	MOVSI	T1,DEPUWL##	;TELL UNICHK IT FAILED BECAUSE
	IORM	T1,DEVPTB##(F)	; OF WRITE LOCK
	TLO	S,IOSTBL	;RETRY AT UUO LEVEL
	PUSHJ	P,STDIOD##	;UNWAIT HIM
	PUSH	P,F		;MUST PRESERVE F IF AT UUO LEVEL
	PUSHJ	P,INTLVL##	;AT INTERRUPT LEVEL?
	  SETZ	P1,		;NO, FLAG NOT TO CHANGE UBR
	PUSHJ	P,SETID4	;START SOMETHING ELSE
	JRST	FPOPJ##
;HERE ON INTERRUPT LEVEL OR DURING ONCE-ONLY
;LIGHT AN ERROR BIT AND RETURN TO CALLER
BADUN7:	MOVE	S,DEVIOS(F)	;GET CURRENT DEVIOS
	TRO	S,IOIMPM	;LIGHT IOIMPM
				;IN IO WAIT?
	PUSHJ	P,STDIOD##	;YES. TAKE OUT
	PUSH	P,F		;SAVE F
	CONSO	PI,PIPROG##	;CANT CHANGE UBR IF
	SETZ	P1,		; AT UUO LEVEL

	PUSHJ	P,SETID3	;SET UNIT IDLE,START NEXT OPERATION
	JRST	FPOPJ##		;RETURN

;HERE IF IT'S THE SWPDDB
BADUNA:
IFN FTCIDSK,<
	EXCH	P3,(P)		;RESTORE ADDR OF DRB
	SKIPGE	KONMX(J)	;MULTIPLE XFERS?
	PUSHJ	P,RTNTRY	;YES, TRY AGAIN
	POP	P,P3
>
	POPJ	P,
;ROUTINE TO UNDO SETLST
;P3 PASSES DRB (IF ANY)
UNLST:	JUMPL	S,CPOPJ##	;GO IF MONITOR I/O
	LDB	T2,PIOMOD##	;MODE
	CAIL	T2,SD		;DUMP OR BUFFERED?
	JRST	UNLST1		;DUMP
	LDB	T1,DEYNB1##	;BUFFERED, RESTORE IOSPBF
	SKIPN	T1
	TLZA	S,IOSPBF
	TLO	S,IOSPBF
	MOVEM	S,DEVIOS(F)
IFN FTMP,<
	TLNN	S,IO		;OUTPUT?
	JRST	UNLST2		;INPUT, DEVNBF IS OK
	MOVE	T2,KDBCHN(J)	;GET CHNNUM
	SKIPGE	KONDRB(J)	;HAVE A DRB?
	MOVEI	T2,DRBNUM##-CHNNUM(P3) ;YES, GET FROM DRB
	HRRZ	T2,CHNNUM(T2)	;NO, GET FROM CHN
	ADD	T2,T1		;PLUS PORTION OF 1ST BUFFER
	LDB	T3,DEYNBB##	;BLOCKS PER BUFFER
	IDIV	T2,T3		;COMPLETED BUFS
	HRLZS	T2		;ADJUST DEVNBF
	ADDM	T2,DEVNBF(F)
UNLST2:
>
	JUMPE	T1,CPOPJ##	;GO UNLESS STARTED BUF IN MIDDLE
	TLNN	S,IO		;RESET COUNT IN BUF
	SKIPA	T2,DEVIAD(F)
	MOVE	T2,DEVOAD(F)
	HRRZS	T2
	LSH	T1,BLKLSH##
	TLNN	S,IO
	EXCTXU	<HRRZM T1,1(T2)>
	TLNE	S,IO
	EXCTUU	<HRLM T1,1(T2)>
	POPJ	P,
UNLST1:	SKIPGE	KONDRB(J)	;HAVE A DRB?
	SKIPA	T1,DRBDMP##(P3)	;YES, GET IT FROM DRB NOT KDB
	MOVE	T1,KONDMP(J)	;GET IOWD BACK
	MOVEM	T1,DEVDMP##(F)	;RESET DEVDMP IN CASE "CONT" IS TYPED
	POPJ	P,
;ROUTINE TO TYPE A MESSAGE TO THE OPR WHEN A DRIVE GOES OFF-LINE
;ENTER AT TELOPC FROM THE CLOCK, T1=UDB
;ENTER AT TELOPR WITH U SET CORRECTLY
TELOPC:	MOVE	U,T1
	SETZ	J,		;SET J=0 AS A SWITCH
	HRRZ	T1,UNICDA(U)	;IF THE SWAPPER
	CAIE	T1,SWPDDB##
	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	TELOP1		;SAVE ONLY U, AND TYPE
TELOPR:	PUSH	P,F
TELOP1:	PUSH	P,U
	MOVEI	T1,UNPMSG	;UNIT OFF-LINE MSG BEEN PRINTED THIS MINUTE?
	TDNE	T1,UNIMSG(U)	;...
	JRST	TELOP8		;YES
	IORM	T1,UNIMSG(U)	;REMEMBER IT WAS
	MOVE	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,UDBNAM(T2)	;PHYSICAL UNIT NAME
	PUSHJ	P,PRNAME##	;TYPE IT
IFN FTDUAL&FTMP,<
	MOVE	T2,(P)		;UDB ADDR
	MOVE	T1,UDBCAM(T2)
	SKIPL	T2,UNI2ND(T2)	;IS THIS AN ALTERNATE PATH?
	JRST	TELOP2		;NO
	MOVE	T3,UDBCAM(T2)
	CAME	T1,T3		;SAME CPU?
	JRST	TELOP2		;NO
	PUSH	P,UDBNAM(T2)	;SAVE ITS NAME
	PUSHJ	P,INLMES##	;TELL OPR THE NAME HE KNOWS
	ASCIZ	. / .
	POP	P,T2
	PUSHJ	P,PRNAME##
TELOP2:>
	MOVE	T2,(P)
	MOVSI	T1,UNPUSI
	TDNE	T1,UNIDES(T2)
	JRST	TELOP3
	PUSHJ	P,INLMES##	;AND THE MESSAGE:
	ASCIZ	/ went OFF-LINE/
	JRST	TELOP4
TELOP3:	ANDCAM	T1,UNIDES(T2)
	PUSHJ	P,INLMES##
	ASCIZ	/ status inconsistent/
TELOP4:	MOVE	T2,(P)		;UNIT
	MOVE	T2,UNIDES(T2)	;UNIDES WORD
	TLNN	T2,UNPFUS	;FILE UNSAFE?
	JRST	TELOP5
	PUSHJ	P,INLMES##	;YES
	ASCIZ	/ (File unsafe)/
TELOP5:	MOVE	T2,0(P)		;GET UDB BACK
	MOVE	T2,UDBKDB(T2)	;GET KDB ADDRESS
	MOVE	T2,KONMPS(T2)	;GET WORD CONTAINING KOPMPS
	TLNN	T2,KOPMPS	;MICROPROCESSOR STOPPED?
	JRST	TELOP6		;NO, ISSUE STANDARD MESSAGE
	PUSHJ	P,INLMES##
	ASCIZ	/
Disk controller microprocessor stopped.
/
	PUSH	P,J		;SAVE J
	HRRZ	J,-1(P)		;GET THE UDB ADDRESS BACK
	MOVE	J,UDBKDB(J)	;GET THE KDB ADDRESS
	PUSHJ	P,@KONRLD(J)	;TRY TO RELOAD THE CONTROLLER
	  CAIA			;FAILED
	JRST	[POP	P,J	;RELOAD SUCCEEDED, RESTORE J
		 JRST	TELOP6]	;  AND CONTINUE
	POP	P,J		;RESTORE J
	PUSHJ	P,INLMES##	;TYPE REST OF MESSAGE
	ASCIZ	/
Please reload the controller microcode./
				;FALL INTO TELOP6
TELOP6:	PUSHJ	P,INLMES##	;YES, ASK HIM TO
	ASCIZ	/
Operator intervention is required for this unit.
/
TELOP8:	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

TELDER:	MOVE	U,OPRLDB##	;OPR LDB
	PUSHJ	P,INLMES##
	BYTE	(7) 7,7,7,7,7
	ASCIZ	/
Excessive disk hardware errors
/
	POPJ	P,
;ROUTINE CALLED ONCE A MINUTE
CHKUNI::SETZM	F
	SETOM	J
	HLRZ	U,SYSUNI##	;FIRST UNIT IN SYSTEM
CHKUN1:	MOVEI	T1,UNPMSG	;CLEAR UNIT OFF-LINE MSG PRINTED FLAG
	ANDCAM	T1,UNIMSG(U)	;...
	MOVE	T1,UNISTS(U)	;STATUS OF UNIT
	CAIN	T1,OCOD		;WAITING FOR OPR?
	PUSHJ	P,[MOVE T2,STATES##  ;YES
		   TRNE T2,ST.NOP  ;OPR IN ATTENDANCE?
		   ADDI T1,2	;NO, DON'T REPEAT MESSAGE
		   MOVEM T1,UNISTS(U)
		   JRST TELOPR]	;REMIND HIM
	HLRZ	U,UNISYS(U)	;STEP TO NEXT UNIT
	JUMPN	U,CHKUN1	;AND TEST IT
	POPJ	P,		;DONE - RETURN
;HERE TO START TRANSFER OF BEST (LATENCY DETERMINED) FILE IN TW
PIKTRN:	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	PIKTR2		;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
PIKTR2:	PUSHJ	P,UNIRHB	;SEE IF ANY UNIT NEEDS REREADING HOME BLOCKS
	  JRST	PIKTR0		;NO, GO LOOK FOR FILE TO START DATA ON
	PUSHJ	P,FAKDDX	;YES, GET A DDB
	  JRST	PIKTR0		;NO SPACE NOW, PUSH ON AND TRY LATER
	PJRST	TSTRHX		;GOT 1, GO START TO READ HOME BLOCK
PIKTR0:	PUSHJ	P,SAVE4##	;#
	DSKOFF
	MOVSI	T1,KOPBSY	;#SET OLD KONTROL IDLE
	ANDCAM	T1,KONBSY(J)	;#
PIKTR1:	MOVS	F,CHNQUE(P1)	;#FIRST FILE DDB IN TW QUEUE FOR THIS CHAN
	JUMPE	F,CHNIDL	;#IF QUEUE EMPT, SET CHAN IDLE AND EXIT
	DSKON			;#


;HERE TO FIND THE BEST FILE TO START TRANSFERRING
	HRLOI	P3,377777	;PRESET BEST LATENCY TIME
	PUSH	P,S		;SAVE S
	MOVEI	S,CHNQUE-DEVQUE##(P1) ;PRESET PREDECESSOR
TWQLUP:	HLRZ	J,F		;JOB NUMBER WHICH OWNS DDB
	PUSHJ	P,MKADD##	;MAKE DDB ADDRESSABLE
	MOVE	T1,DEVBLK##(F)	;BLOCK FILE NEEDS
IFE FTDUAL,<
	HRRZ	U,DEVUNI##(F)
>
IFN FTDUAL,<
	HRRZ	U,DEVCUR##(F)
>
	SKIPN	U
	STOPCD	.,CPU,NUT,	;++NO UNIT FOR TRANSFER
	SKIPN	T2,UNISTS(U)	;STATUS OF UNIT
	JRST	TWQLP2
	CAIE	T2,MDACOD	;IDLE
	CAIN	T2,TWCOD	;TW?
TWQLP2:	SKIPA	J,UDBKDB(U)	;MDA WAIT OR TW - SET J=KONTROLLER FOR UNIT
	JRST	TWQLP1		;UNIT NOT IN TW - GET ANOTHER FILE
	PUSHJ	P,RHBP		;NEED TO REREAD HOME BLOCKS?
	  JRST	TWQLP1		;YES, DON'T START XFER
	PUSHJ	P,@KONLTM(J)	;COMPUTE LATENCY
	  MOVEI	T1,0		;UNIT NOT OK- SET LATENCY=0
	PUSHJ	P,DFPRI
	MOVNI	T2,MXNDPR##(T2)
	SKIPE	T1
	HRL	T1,T2

				; SO UNIT WILL BE GOTTEN RID OF IMMEDIATELY
	SKIPLE	CHNCFT(P1)	;TIME TO BE FAIR?
	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
TWQLP1:	MOVEM	F,S		;SAVE F AS PREDECESSOR
	MOVS	F,DEVQUE##(F)	;STEP TO NEXT FILE
	JUMPN	F,TWQLUP	;TEST NEXT FILE
	TLNN	P3,777770	;WAS ANY FILE FOUND TO START DATA?
	PJRST	SETBSY		;YES. GO
	POP	P,S		;NOTHING TO DO. RETORE S
	MOVE	J,UDBKDB(U)
	PJRST	CHNIDL		;SET CHAN IDLE
;HERE WHEN BEST FILE IS FOUND START IO
SETBSY:	POP	P,S		;RESTORE S
	MOVE	F,P4		;SET F TO FILE
	HLRZ	J,F
	PUSHJ	P,MKADD##	;MAKE DDB WE WANT TO START ADDRESSABLE
IFE FTDUAL,<
	HRRZ	U,DEVUNI##(F)
>
IFN FTDUAL,<
	HRRZ	U,DEVCUR##(F)
>
	DSKOFF			;#TURN ALL DISK PI'S OFF
	PUSHJ	P,UNQUER	;#REMOVE FILE FROM TWQ
	  JRST	PIKTR1		;#RACE, TRY AGAIN
	SOS	CHNQUL(P1)	;#COUNT IT
SETBS1:	PUSHJ	P,TSTGEN	;UNIT BEEN DETACHED?
	  JRST	NXTTBL		;YES, LIGHT TROUBLE
	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:
IFN FTXMON,<
	SKIPGE	S		;IF MONITOR I/O, ALSO SAVE PCS
	PUSHJ	P,SSPCS##	; DEVISN WILL BE ZERO IF LOOKUP/ENTER
	PUSHJ	P,SPCS##	;SET PCS FROM DEVISN (DEPENDS ON STEUB TO RESTORE IT)
>
     	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 BADUN1 ON UUO LEVEL
CHNIDX:	MOVSI	T1,KOPBSY
	ANDCAM	T1,KONBSY(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:	SKIPGE	DIADSK##	;IF TRYING TO SET DIAG CHAN IDLE
	CAME	P1,DIACHN##	; (CALL FROM CRNK UP)
	CAIA
	PJRST	DOPOPJ		;JUST RETURN

	SETOB	T2,@KDBCHN(J)	;#SET CHAN IDLE
	DSKON			;#
	JUMPE	P1,CPOPJ##	;DONE IF SETID3 CALLED BY
				; BADUN1 AT UUO LEVEL
	SETZM	CHNCUA(P1)	;NO CURRENT UNIT ACTIVE ON CHAN
	MOVSI	T1,CP.SWF	;GET SWEEP FLAG
	TDNE	T1,CHNTYP(P1)	;DO WE HAVE TO DO A SWEEP BEFORE DISMISSING?
	PUSHJ	P,CFDMPX	;YES, SO DO IT NOW SINCE NO I/O WILL
				; BE STARTED, AS WE ARE AT CHNIDL
	PUSH	P,U		;SAVE U FOR END TEST
CHNID1:	MOVE	T1,UNISTS(U)	;STATUS OF UNIT
	CAIE	T1,TCOD		;(PI'S ARE ON NOW)
	CAIN	T1,PCOD		;IF ANY UNIT IS STILL DOING SOMETHING,
	AOJA	T2,CHNID2	; BUMP T2

	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 (STRANGE RACE)
	MOVEI	T1,PWCOD	;PUT UNIT INTO PW OR IDLE
	MOVEM	T1,UNISTS(U)	; SO SYSTEM WONT HANG
CHNID2:	HRR	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
	SKIPLE	F,DIADSK##	;TRYING TO SHUT DOWN IO?
	CAME	P1,DIACHN##	;YES, FOR THIS CHAN?
	JRST	CHNID4		;NO
	JUMPGE	T2,INTXIT	;YES, DISMISS IF ANY UNIT BUSY
CHNID3:	HLRZ	J,F
	PUSHJ	P,MKADD##
	MOVE	S,DEVIOS(F)	;NO UNITS BUSY, SET UP S
	PUSHJ	P,STDIOD##	;AND WAKE UP THE JOB (TO START DIAGNOSTIC)
	PUSHJ	P,CLRACT##
IFN FTDUAL,<
	JRST	INTXIT
CHNID4:	JUMPLE	F,INTXIT	;GO IF NO DIAG WAITING
	MOVE	U,KONCUA(J)	;UNIT WE JUST TALKED TO
	SKIPN	T1,UNI2ND(U)	;DIAG - DUAL PORTED DRIVE?
	JRST	INTXIT
	MOVE	T2,UDBKDB(T1)	;YES, IS 2ND PORT ON RIGHT CHAN?
	MOVE	T2,KDBCHN(T2)
	SKIPGE	(T2)		; AND S THAT CHAN IDLE?
	CAME	T2,DIACHN##
	JRST	INTXIT		;NO, CANT START THE DIAG JOB
	HRRZ	T2,T1
	MOVEI	T3,PCOD		;YES, ARE ALL UNITS ON THE CHAN IDLE?
CHNID5:	CAMN	T3,UNISTS(T1)
	JRST	INTXIT		;NO, CAN'T START THE DIAG JOB
	MOVE	T1,UNICHN(T1)
	CAME	T1,T2
	JRST	CHNID5
	JRST	CHNID3		;YES, TAKE DIAG JOB OUT OF DIOW QUEUE
>
IFE FTDUAL,<
CHNID4:
>

INTXIT:	JUMPE	P1,CPOPJ##	;EXIT NOW IF NO CDB (BADUNI AT UUO LEVEL)
	MOVSI	T1,CP.SWF	;CLEAR SWEEP FLAG
	ANDCAM	T1,CHNTYP(P1)	;FOR NEXT INTERRUPT
	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
;SUBROUTINE TO SWEEP CACHE
;CALL WITH P1=LOC OF CHANNEL DATA BLOCK
;PRESERVES ALL ACS  EXCEPT T1
CFDMPX:
IFN FTMP,<
	LDB	T1,DEYCPU##	;IF DDB WE JUST DID IO FOR
	CAME	T1,.CPCPN##	; IS ON A DEFFERENT CPU
	POPJ	P,		;THERE IS NO NEED TO SWEEP ON THIS CPU
>
CFDMP:	MOVE	T1,CHNTYP(P1)
IFE FTKS10,<
	SKIPN	DINITF##	;ARE WE IN ONCE-ONLY?
>; END IFN FTKS10
	TLNE	T1,CP.RH2+CP.KLP	;INTERNAL CHANNEL?
	POPJ	P,		;YES, NO NEED TO SWEEP
IFN FTMP,<
	SETZM	.CPSWD##	;TELL DSKTIC WE SWEPT
>
	PJRST	CSDMP##		;NO, SWEEP CACHE
;HERE TO DO RETRY AT UUO LEVEL
NXTTBL:	MOVSI	S,IOSTBL	;LIGHT TROUBLE
	IORM	S,DEVIOS(F)

;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	@KDBCHN(J) ;#INDICATE CHAN IS IDLE
		 PJRST	DOPOPJ]	;#TURN ON DSK PI
				;#AND RETURN WITHOUT WIPING IT
	PUSHJ	P,IDLEPW	;#SET IDLE OR PW
	SKIPN	UNISTS(U)	;#PW?
	JRST	PIKTR1		;#IDLE, LOOK FOR A TRANSFER TO START
	SETOM	UNICYL(U)	;#ENSURE A SEEK HAPPENS (ELSE COULD PDL OV)
	JRST	PIKPOS		;# AND START A SEEK GOING
	SUBTTL	CSHSER -- ALGORITHM OVERVIEW

COMMENT |

THE DISK CACHE ALGORITHM WAS DESIGNED AND IMPLEMENTED BY BILL MEIER,
WITH HELP FROM PETER VATNE.

THE BASIC DATA STRUCTURE CONSISTS OF TWO DOUBLY LINKED LISTS, A LIST
HEADER, AND A HASH TABLE.  EACH NODE IN THE LIST CONTAINS FORWARD AND
BACKWARD POINTERS FOR EACH OF THE TWO LISTS ITS LINKED INTO, (.CBNHB,
.CBPHB, .CBNAB, .CBPAB), A UDB ADDRESS (.CBUDB), A BLOCK NUMBER
(.CBBLK), AND A POINTER TO THE ADDRESS IN FRECOR WHERE THE BLOCK IS
(.CBDAT). FOR STATISTICS ONLY, THE NODE ALSO CONTAINS A COUNT OF THE
NUMBER OF TIMES THIS BLOCK HAS BEEN HIT SINCE IT WAS IN THE CACHE
(.CBHIT).

THE LIST HEADER POINTS TO THE TWO LINKED LISTS.  THE FIRST LINKED LIST
IS THE "ACCESS" LIST.  THE MOST RECENTLY ACCESSED BLOCK IS AT THE HEAD
OF THE LIST; THE LEAST RECENTLY ACCESSED BLOCK IS AT THE TAIL.  THIS
LIST IS LINKED THROUGH THE .CBNAB/.CBPAB WORDS.  THE SECOND LINKED LIST
IS THE "FREE" LIST.  IT CONTAINS A LIST OF ALL BLOCKS THAT ARE NOT
CURRENTLY IN USE, AND AS SUCH DO NOT APPEAR IN THE HASH LIST DESCRIBED
BELOW.  THIS LIST IS LINKED THROUGH THE .CBNHB/.CBPHB WORDS.

THE HASH TABLE CONSISTS OF POINTERS INTO THE .CBNHB/.CBPHB LIST FOR THE
CORROSPONDING LIST FOR BLOCKS THAT HASH TO THE SAME POSITION.  THUS, THE
HASH TABLE IS REALLY N SEPARATE LIST HEADS FOR THE LISTS OF BLOCKS THAT
HASH TO THAT POSITION IN THE HASH TABLE.

AT INITIALIZATION TIME (CSHINI) ALL THE BLOCKS ARE ALLOCATED, AND LINKED
INTO THE FREE LIST.  THEY ARE ALSO LINKED INTO THE ACCESS LIST.  THE
HASH TABLE ENTRIES ARE ALL LINKED TO THEMSELVES, AS THE TABLE IS EMPTY.

TO FIND AN ENTRY, GIVEN ITS UDB AND BLOCK NUMBER, YOU SIMPLY HASH THE
BLOCK INTO THE HASH TABLE, AND USING THAT ENTRY AS A LIST HEAD, FOLLOW
THE LIST UNTIL YOU EITHER FIND A MATCH, OR RETURN TO THE HEADER.  THIS
IS DONE WITH THE ROUTINE CSHFND.  IT SHOULD BE NOTED THAT IN GENERAL,
THESE LISTS ARE VERY SMALL, MOST LIKELY ONLY 1 OR 2 BLOCKS.

THE MAIN CACHE HANDLING ROUTINE IS CSHIO, WHICH WILL SIMULATE I/O FROM
THE CACHE, DOING THE NECCESSARY PHYSICAL I/O TO FILL AND WRITE THE CACHE.
IT SHOULD BE NOTED THAT THIS IS A WRITE-THROUGH CACHE, SO NO SWEEPS
ARE REQUIRED, SO THE DATA IN THE CACHE ALWAYS REFLECTS THE BLOCKS ON
DISK.

|
	SUBTTL	CSHSER -- PICTORIAL DATA STRUCTURES

;FORMAT OF CBHEAD LIST HEADER:
;
;	  !=======================================================!
; .CBNHB: !         POINTER TO FIRST BLOCK IN "FREE" LIST         !
;	  !-------------------------------------------------------!
; .CBPHB: !         POINTER TO LAST BLOCK IN "FREE" LIST          !
;	  !-------------------------------------------------------!
; .CBNAB: !         POINTER TO FIRST BLOCK IN ACCESS LIST         !
;	  !-------------------------------------------------------!
; .CBPAB: !         POINTER TO LAST BLOCK IN ACCESS LIST          !
;	  !=======================================================!


;FORMAT OF TWO WORD CBHSHT HASH TABEL ENTRY:
;
;	  !=======================================================!
; .CBNHB: !       POINTER TO FIRST HASH BLOCK IN THIS CHAIN       !
;	  !-------------------------------------------------------!
; .CBPHB: !       POINTER TO LAST HASH BLOCK IN THIS CHAIN        !
;	  !=======================================================!


;FORMAT OF EACH LIST ENTRY:
;
;	  !=======================================================!
; .CBNHB: !       POINTER TO NEXT HASH BLOCK IN THIS CHAIN        !
;	  !-------------------------------------------------------!
; .CBPHB: !     POINTER TO PREVIOUS HASH BLOCK IN THIS CHAIN      !
;	  !-------------------------------------------------------!
; .CBNAB: !            POINTER TO NEXT ACCESSED BLOCK             !
;	  !-------------------------------------------------------!
; .CBPAB: !          POINTER TO PREVIOUS ACCESSED BLOCK           !
;	  !-------------------------------------------------------!
; .CBUDB: !           UDB OF UNIT CONTAINING THIS BLOCK           !
;	  !-------------------------------------------------------!
; .CBBLK: !                     BLOCK NUMBER                      !
;	  !-------------------------------------------------------!
; .CBDAT: !       POINTER TO 128. WORDS FOR THIS DISK BLOCK       !
;	  !=======================================================!
	SUBTTL	CSHSER -- DATA STRUCTURES

	.CBNHB==0			;NEXT HASH BLOCK
	.CBPHB==1			;PREVIOUS HASH BLOCK
	.CBNAB==2			;NEXT ACCESSED BLOCK
	.CBPAB==3			;PREVIOUS ACCESS BLOCK
	.CBUDB==4			;RH=UDB OF UNIT
	.CBBLK==5			;THE BLOCK NUMBER
	.CBDAT==6			;ADDRESS OF BLOCK IN CORE
	.CBHIT==7			;COUNT OF HITS THIS BLOCK

	.CBLEN==10			;LENGTH

	EXTERN	CBHSHT			;CACHE HASH TABLE
;ROUTINE TO GET THE INTERLOCK
UPPDC:	PUSHJ	P,UPDC			;GET IT
	  STOPCD .,DEBUG,IUI,		;++ILLEGAL USE OF UPPDC AT INTERRUPT LEVEL
	POPJ	P,

;ROUTINE TO GET THE INTERLOCK (IF POSSIBLE)
;NOSKIP IF INTERLOCK WAS NOT AVAILABLE
UPDC1:	PUSHJ	P,UUOLVL##		;AT UUO LEVEL?
	  POPJ	P,			;NO, INTERLOCK NOT AVAILABLE
;ENTER HERE
UPDC:	SKIPGE	INTRDC##		;INTERLOCK AVAILABLE?
	AOSE	INTRDC##
	JRST	UPDC1			;NO
IFN FTMP,<APRID INTODC##>		;YES, REMEMBER WHICH CPU
	PUSHJ	P,NOWDU			;PARANOIA
	JRST	CPOPJ1##		;WE GOT IT

;ROUTINE TO GIVE UP THE INTERLOCK
DWNDC:	PUSHJ	P,NOWDU			;DO CSDELU NOW
IFN FTMP,<SETOM INTODC##>		;NOT US
	SETOM	INTRDC##		;OPEN THE FLOOD GATE
	POPJ	P,

;ROUTINE TO DELETE A UNIT FROM THE CACHE (BECAUSE DELETION WAS DELAYED
;FROM A POINT EARLIER IN TIME)
NOWDU:	SKIPN	NOWDUC##		;ANY DELAYED?
	POPJ	P,			;NO
	SOS	NOWDUC##		;YES, COUNT IT
	PUSHJ	P,NWDU			;SEARCH AND DESTROY
	JRST	NOWDU			;AGAIN (PARANOID ABOUT RACES)

;ROUTINE TO SEARCH FOR A UNIT THAT WANTS TO BE DELETED FROM CACHE
NWDU:	PUSHJ	P,SAVE2##
	PUSH	P,U
	MOVEI	P1,UNPNDU		;THE BIT WE ARE SEARCHING FOR
	MOVEI	U,SYSUNI##-UNISYS	;PRESET PRED
NWDU1:	HLRZ	U,UNISYS(U)		;GET NEXT UNIT
	JUMPE	U,UPOPJ##		;NONE
IFN FTDUAL,<
	HRRZ	P2,UNIALT(U)		;EITHER PORT
	SKIPE	P2
	TDNN	P1,UNINDU(P2)
>
	TDNE	P1,UNINDU(U)		;WANT TO DELETE THIS UNIT?
	PUSHJ	P,CSDUN			;YES, DO IT
	JRST	NWDU1			;NO, KEEP SEARCHING
	SUBTTL	CSHINI - INITIALIZE THE CACHE, HASH TABLES, AND LINKS

;CALL:
;	PUSHJ	P,CSHINI
;	<RETURN>
CSHINI::MOVSI	T1,-CBHSHL##		;LENGTH OF TABLE

;LINK ALL HASH ENTRIES TO THEMSELVES
CSHIN1:	MOVEI	T2,CBHSHT(T1)		;ADDRESS OF SELF
	MOVEM	T2,CBHSHT+.CBNHB(T1)	;STORE NEXT
	MOVEM	T2,CBHSHT+.CBPHB(T1)	;AND PREVIOUS TO SELF
	AOBJN	T1,.+1			;ADVANCE TO NEXT
	AOBJN	T1,CSHIN1		;AND LOOP FOR ALL

;LINK HEADER ENTRY LINKS TO THEMSELVES
	MOVEI	T1,CBHEAD		;ADDRESS OF HEADER
	MOVEM	T1,CBHEAD+.CBNAB	;STORE NEXT
	MOVEM	T1,CBHEAD+.CBPAB	;AND PREVIOUS TO SELF
	MOVEM	T1,CBHEAD+.CBNHB	;STORE NEXT IN INVALID LIST
	MOVEM	T1,CBHEAD+.CBPHB	;AND PREVIOUS TO SELF

;ALLOCATE THE INITIAL SIZE OF THE CACHE
	SETZM	%LDCSZ##		;NO ENTRIES IN CACHE
	MOVE	T1,%LDOCS##		;MAXIMUM SIZE (PATCHABLE)
	PUSHJ	P,CSHSSZ		;INITIALIZE CACHE SIZE
	  JFCL				;CANT MAKE IT THAT BIG
	POPJ	P,			;RETURN
	SUBTTL	CSHFND - FIND ENTRY IN CACHE

;CALL:
;	T1/ BLOCK NUMBER
;	U/  UDB ADDRESS
;	PUSHJ	P,CSHFND
;	 <ERROR>			;BLOCK NOT IN CACHE T2/ ADDRESS TO INSERT
;	<NORMAL>			;BLOCK IN CACHE     T2/ ADDRESS OF ENTRY
CSHFND:	MOVE	T2,T1			;COPY BLOCK NUMBER
	XOR	T2,U			;SPRINKLE MORE BITS
	IDIVI	T2,CBHSHL##/2		;HASH INTO TABLE
	LSH	T3,1			;DOUBLE REMAINDER
	MOVEI	T4,CBHSHT(T3)		;REMEMBER START OF LIST
	MOVE	T2,T4			;COPY POINTER TO START
	AOS	%LDHSF##		;COUNT PROBES

;LOOP THROUGH HASH CHAIN FROM INITIAL PROBE
CSHFN1:	CAMN	T4,.CBNHB(T2)		;SEE IF LOOPED AROUND
	POPJ	P,			;YES, NOT IN TABLE
	MOVE	T2,.CBNHB(T2)		;COPY CURRENT BLOCK
	HRRZ	T3,.CBUDB(T2)		;UNIT DATA BLOCK
	CAMN	T1,.CBBLK(T2)		;MATCH THIS BLOCK?
	CAME	U,T3			;AND THIS UNIT?
	AOSA	%LDHSC##		;NO, COUNT COLLISIONS
	JRST	CPOPJ1##		;YES, SKIP RETURN
	JRST	CSHFN1			;AND LOOP
	SUBTTL	CSHIO  - DISPATCH ON READ OR WRITE REQUEST

;CALL:
;	F/ DDB ADDRESS
;	PUSHJ	P,CSHIO
;	<RETURN>
;IF A READ, WILL READ DATA FROM DISK OR GET FROM CACHE USING IOWD IN DEVDMP
;IF A WRITE, WILL WRITE DATA AND FIX CACHE FROM IOWD IN DEVDMP
;IN ALL CASES, S HAS ERROR BITS (0 IF CAME FROM CACHE), AND DEVBLK INDICATES
;THE BLOCK TO READ OR WRITE

CSHIO::	TLZE	F,UCACHE		;WANT UNCACHED I/O?
	JRST	CSHIOU			;YES--DO NOTHING HERE
	PUSHJ	P,UPPDC			;GET INTERLOCK
	SKIPG	%LDCSZ##		;ANY BLOCKS ALLOCATED?
	JRST	CSHION			;NO--CANT CACHE ANYTHING!

;SETUP U TO PRIMARY PORT UDB AND INTERLOCK US
	PUSH	P,U
	PUSHJ	P,CSSETU		;SET U TO PRIMARY PORT
	MOVSI	T1,U2PNOC		;NON-CACHED UNIT (STRUCTURE)?
	TDNE	T1,UNIDS2(U)
	JRST	CSHIO3			;YES
	MOVE	T1,DEVBLK##(F)		;GET BLOCK NUMBER

;DISPATCH ON READ OR WRITE
	TLNE	S,IO			;WRITING?
	JRST	CSHIOW			;YES

;READ - SEE IF DATA IN THE CACHE ALREADY
	AOS	%LDRDC##		;NO--COUNT TOTAL READ CALLS
	AOS	UNICRC(U)		;AND PER UDB
	PUSHJ	P,CSHFND		;SEE IF BLOCK IN CACHE
	  JRST	CSHIO0			;NOT FOUND

;READ - DATA FOUND IN CACHE, UPDATE BLOCK TO TOP OF ACCESS LIST
;BLT DATA TO MONITOR BUFFER, AND RETURN
	AOS	%LDRDH##		;COUNT TOTAL READ HITS
	AOS	UNICRH(U)		;AND PER UDB
	PUSHJ	P,CSHMRU		;MOVE TO TOP OF LIST
	PUSHJ	P,CSHC2B		;MOVE DATA FROM CACHE TO BUFFER
	MOVEI	S,0			;CLEAR ANY ERROR BITS
	JRST	CSHDMM			;POP U AND RETURN

;READ - DATA NOT IN CACHE, READ IT INTO MONITOR BUFFER
CSHIO0:	EXCH	U,(P)			;GET ORIGINAL U BACK
	PUSHJ	P,DWNDC			;GIVE UP INTERLOCK
	PUSHJ	P,UUOPWQ		;SETUP FOR READ
	PUSHJ	P,PWAIT1		;WAIT FOR THE DATA
	PUSHJ	P,UPPDC			;GET INTERLOCK

;READ - CHECK TO BE SURE BLOCK DIDNT REAPPEAR IN THE CACHE WHILE
;WHILE WE DROPPED MM AND BLOCKED
	EXCH	U,(P)			;SAVE ORIGINAL U, GET CSSETU BACK
	MOVE	T1,DEVBLK##(F)		;GET BLOCK NUMBER BACK
	PUSHJ	P,CSHFND		;SEE IF SNUCK BACK IN CACHE
	  JRST	CSHIO1			;NO--CONTINUE

;READ - BLOCK APPEARED IN CACHE WHILE WE BLOCKED. PREFER THAT BLOCK
;AND BLT IT TO OUR BUFFER, DISCARDING WHAT WE READ
	PUSHJ	P,CSHMRU		;YES!!--MOVE TO TOP OF LIST
	PUSHJ	P,CSHC2B		;COPY DATA FROM CACHE TO BUFFER
	MOVEI	S,0			;CLEAR ANY ERROR BITS
	JRST	CSHDMM			;POP U AND RETURN

;READ - HERE WHEN BLOCK DIDNT APPEAR BACK IN CACHE WHEN WE BLOCKED
;(THIS SHOULD USALLY BE THE CASE). BLT DATA INTO CACHE
;AND REPLACE THE LRU BLOCK WITH THIS ONE
CSHIO1:	SKIPLE	%LDCSZ##		;CACHE SIZE MAY HAVE CHANGED TO ZERO
	TDNE	S,[IOSTBL,,IOERR]	;ANY I/O ERRORS?
	JRST	CSHDMM			;YES--DONT PUT BLOCK IN CACHE
	MOVE	T1,CBHEAD+.CBPAB	;GET LAST BLOCK
	SKIPE	T1,.CBUDB(T1)		;SEE IF UDB IN USE
	SOS	UNICBK(T1)		;YES--DECR BLOCKS FOR PREVIOUS UNIT
	AOS	UNICBK(U)		;INCR BLOCKS FOR CURRENT UNIT
	MOVE	T1,DEVBLK##(F)		;GET BLOCK NUMBER
	PUSHJ	P,CSHINS		;INSERT NEW BLOCK IN CACHE
	PUSHJ	P,CSHB2C		;MOVE DATA FROM BUFFER TO CACHE
	JRST	CSHDMM			;POP U AND RETURN

;WRITE - SEE IF WRITING A BLOCK THAT ALREADY EXISTS IN THE CACHE
CSHIOW:	AOS	%LDWRC##		;COUNT TOTAL WRITE CALLS
	AOS	UNICWC(U)		;AND PER UDB
	PUSHJ	P,CSHFND		;SEE IF BLOCK IN CACHE
	  JRST	CSHIO3			;NOT FOUND

;WRITE - DATA FOUND IN CACHE, REPLACE BLOCK WITH DATA WE WERE ABOUT
;(OR NO BLOCKS ALLOCATED TO CACHE)
;TO WRITE, AND MOVE BLOCK TO TOP OF ACCESSED LIST
	AOS	%LDWRH##		;COUNT TOTAL WRITE HITS
	AOS	UNICWH(U)		;AND PER UDB
	PUSHJ	P,CSHMRU		;MOVE TO TOP OF LIST
	PUSHJ	P,CSHB2C		;UPDATE DATA IN CACHE
CSHIO3:	POP	P,U			;GET U BACK

;WRITE - DATA NOT IN CACHE, JUST WRITE IT OUT, AND LEAVE CACHE ALONE
CSHION:	PUSHJ	P,DWNDC			;GIVE UP INTERLOCK
CSHIOU:	PUSHJ	P,UUOPWQ		;SETUP FOR WRITE
	PJRST	PWAIT1			;WAIT FOR COMPLETION AND RETURN

CSHDMM:	PUSHJ	P,DWNDC			;GIVE UP INTERLOCK
	PJRST	UPOPJ##			;POP U AND RETURN
	SUBTTL	CSHC2B - MOVE DATA FROM CACHE TO BUFFER

;CALL:
;	T2/ POINTER TO LIST ENTRY
;	F/  POINTER TO DDB (DEVDMP SETUP)
;	PUSHJ	P,CSHC2B
;	<RETURN>
CSHC2B:	PUSHJ	P,CSSETL		;SETUP LENGTH FOR BLT
	JUMPE	T1,CPOPJ##		;NO WORK IF NO DATA
IFN FTXMON,<
	SE1ENT				;ENTER SECTION 1
	PUSH	P,T2			;SAVE T2
	MOVE	T2,.CBDAT(T2)		;START
	PUSH	P,F			;SAVE F
	HRRZS	F			;GET JUST ADDRESS
	HRRZ	T3,DEVDMP##(F)		;GET DESTINATION (IOWD)
	HRL	T3,DEVISN(F)		;SECTION NUMBER
	POP	P,F			;RESTORE F
	ADDI	T3,1			;FIX UP
	EXTEND	T1,[XBLT]		;MOVE THE DATA
	POP	P,T2			;RESTORE T2
>;END IFN FTXMON
IFE FTXMON,<
	HRRZ	T3,DEVDMP##(F)		;GET IOWD START
	ADDI	T3,1			;REMOVE -1 OFFSET
	ADDI	T1,(T3)			;COMPUTE DESTINATION END
	HRL	T3,.CBDAT(T2)		;GET START
	BLT	T3,-1(T1)		;MOVE THE DATA TO BUFFER
>;END IFE FTXMON
	POPJ	P,			;AND RETURN
	SUBTTL	CSHB2C - MOVE DATA FROM BUFFER TO CACHE

;CALL:
;	T2/ POINTER TO LIST ENTRY
;	F/  POINTER TO DDB (DEVDMP SETUP)
;	PUSHJ	P,CSHB2C
;	<RETURN>
CSHB2C:	PUSHJ	P,CSSETL		;SETUP LENGTH FOR BLT
	JUMPE	T1,CPOPJ##		;NO WORK IF NO DATA
IFN FTXMON,<
	SE1ENT				;ENTER SECTION 1
	PUSH	P,T2			;SAVE T2
	MOVE	T3,.CBDAT(T2)		;DESTINATION
	PUSH	P,F			;SAVE F
	HRRZS	F			;GET JUST ADDRESS
	HRRZ	T2,DEVDMP##(F)		;START (IOWD)
	HRL	T2,DEVISN(F)		;SECTION NUMBER
	POP	P,F			;RESTORE F
	ADDI	T2,1			;FIX UP
	EXTEND	T1,[XBLT]		;MOVE THE DATA
	POP	P,T2			;RESTORE T2
>;END IFN FTXMON
IFE FTXMON,<
	HRRZ	T3,DEVDMP##(F)		;GET IOWD START
	MOVSI	T3,1(T3)		;REMOVE -1, SWITCH HALVES
	HRR	T3,.CBDAT(T2)		;POINT TO BUFFER
	ADD	T1,.CBDAT(T2)		;INCLUDE LENGTH IN T1 FOR DEST
	BLT	T3,-1(T1)		;MOVE THE DATA
>;END IFE FTXMON
	POPJ	P,			;AND RETURN
	SUBTTL	CSSETL - SET LENGTH OF BLT

;CALL:
;	F/ DDB ADDRESS (DEVDMP SETUP)
;	PUSHJ	P,CSSETL
;	<RETURN>			;T1/ LENGTH FOR BLT
CSSETL:	HLRE	T1,DEVDMP##(F)		;GET -SIZE
	MOVMS	T1			;GET +SIZE
	CAILE	T1,BLKSIZ##		;WITHIN A BLOCK?
	STOPCD	.,STOP,WSM		;++WRONG SIZE MOVED
	POPJ	P,			;AND RETURN
	SUBTTL	CSHSIZ - SET SIZE OF CACHE

;CALL:		(FROM SETUUO)
;	T2/ NEW SIZE OF CACHE IN BLOCKS
;	PUSHJ	P,CSHSIZ
;	 <ERROR>			;CANT ALLOCATE MORE SPACE
;	<NORMAL>			;CACHE EXPANDED/CONTRACTED
;CALL:		(FROM CSHINI)
;	T1/ NEW SIZE OF CACHE IN BLOCKS
;	PUSHJ	P,CSHSSZ
;	 <ERROR>			;CANT ALLOCATE MORE SPACE
;	<NORMAL>			;CACHE EXPANDED/CONTRACTED
CSHSIZ::MOVE	T1,T2			;SETUUO HAD ARG IN T2
	PUSHJ	P,CSHSSZ		;SET THE CACHE SIZE
	  JRST	ECOD0##
	JRST	CPOPJ1##		;HAPPINESS

CSHSSZ:	JUMPL	T1,CPOPJ##		;NEGATIVE SIZE IS BAD
	SKIPG	[M.CBMX##]		;ANY BLOCKS ALLOCATED AT SYSINI?
	POPJ	P,			;NO--CANT MAKE ANY NOW EITHER
	PUSHJ	P,SAVE1##		;SAVE P1
	MOVE	P1,T1			;COPY SIZE

;COMPUTE NEW SIZE, SEE IF INCREASING OR DECREASING ALLOCATION
	SUB	P1,%LDCSZ##		;MINUS CURRENT SIZE
	JUMPE	P1,CPOPJ1##		;RETURN IF NO CHANGE
	JUMPG	P1,CSHSZ1		;EXPAND CACHE

;DECREASING, DEALLOCATE BLOCKS UNTIL REQUESTED SIZE REARCHED
CSHSZ2:	PUSHJ	P,CSHDEA		;DEALLOCATE A BLOCK
	AOJL	P1,CSHSZ2		;LOOP FOR ALL
	JRST	CPOPJ1##		;AND EXIT

;INCREASING, ALLOCATE BLOCKS UNTIL REQUESTED SIZE IS REACHED
CSHSZ1:	PUSHJ	P,CSHALC		;ALLOCATE A BLOCK
	  POPJ	P,			;CANT--RETURN
	SOJG	P1,CSHSZ1		;LOOP FOR ALL
	JRST	CPOPJ1##		;AND SKIP RETURN
	SUBTTL	CSHALC - ALLOCATE ANOTHER BLOCK FOR THE CACHE

;CALL:
;	PUSHJ	P,CSHALC
;	 <ERROR>			;CANT ALLOCATE ANOTHER BLOCK
;	<NORMAL>			;ANOTHER BLOCK ALLOCATED
CSHALC:	MOVEI	T2,.CBLEN		;GET LENGTH
	PUSHJ	P,GETWDS##		;GET CORE FOR NEW BLOCK
	  POPJ	P,			;RETURN W/O INCREASING CACHE
	PUSH	P,T1			;SAVE ENTRY ADDRESS
	MOVEI	T2,BLKSIZ##		;GET SIZE OF A BLOCK
IFN FTXMON,<PUSHJ P,GFWNZS##>		;GET CORE FROM SECTION 3
IFE FTXMON,<PUSHJ P,GETWDS##>		;GET CORE FROM FRECOR POOL
	 JRST	TPOPJ##			;CANT
	POP	P,T2			;RESTORE ENTRY ADDRESS
	MOVEM	T1,.CBDAT(T2)		;STORE ADDRESS OF BLOCK
	PUSHJ	P,UPPDC			;GET INTERLOCK
	AOS	%LDCSZ##		;COUNT BLOCKS INSERTED

;LINK NEW BLOCK AT BEGINNING OF "FREE" HASH LIST
	MOVE	T3,CBHEAD+.CBNHB	;GET FORWARD FROM HEADER
	MOVE	T4,.CBPHB(T3)		;AND PREVIOUS FROM TOP
	MOVEM	T2,CBHEAD+.CBNHB	;INSERT US AT THE TOP
	MOVEM	T2,.CBPHB(T3)		;PREVIOUS OF OLD TOP IS US
	MOVEM	T3,.CBNHB(T2)		;NEXT OF US IS OLD TOP
	MOVEM	T4,.CBPHB(T2)		;PREVIOUS OF US IS HEADER

;CLEAR OUT ANY TRASH
	SETZM	.CBBLK(T2)		;CLEAR BLOCK
	SETZM	.CBUDB(T2)		;AND UDB TO BE SAFE
	SETZM	.CBHIT(T2)		;AND COUNT OF HITS THIS BLOCK

;LINK NEW BLOCK AT END OF ACCESSED LIST
	MOVE	T3,CBHEAD+.CBPAB	;GET FORWARD FROM HEADER
	MOVE	T4,.CBNAB(T3)		;AND NEXT FROM TOP
	MOVEM	T2,CBHEAD+.CBPAB	;INSERT US AT THE TOP
	MOVEM	T2,.CBNAB(T3)		;NEXT OF OLD TOP IS US
	MOVEM	T3,.CBPAB(T2)		;PREVIOUS OF US IS OLD TOP
	MOVEM	T4,.CBNAB(T2)		;NEXT OF US IS HEADER
	PUSHJ	P,DWNDC			;GIVE UP INTERLOCK
	JRST	CPOPJ1##		;AND SKIP RETURN
	SUBTTL	CSHDEA - DEALLOCATE A BLOCK FROM THE CACHE

;CALL:
;	PUSHJ	P,CSHDEA
;	<RETURN>
CSHDEA:	PUSHJ	P,UPPDC			;GET INTERLOCK
	MOVE	T2,CBHEAD+.CBPAB	;LAST BLOCK IN CACHE
	MOVE	T3,.CBNAB(T2)		;GET NEXT
	MOVE	T4,.CBPAB(T2)		;GET PREVIOUS
	MOVEM	T3,.CBNAB(T4)		;REMOVE FROM FORWARD CHAIN
	MOVEM	T4,.CBPAB(T3)		;REMOVE FROM PREVIOUS CHAIN

;DELETE FROM HASH CHAIN
	MOVE	T3,.CBNHB(T2)		;GET NEXT
	MOVE	T4,.CBPHB(T2)		;GET PREVIOUS
	MOVEM	T3,.CBNHB(T4)		;REMOVE FROM FORWARD CHAIN
	MOVEM	T4,.CBPHB(T3)		;REMOVE FROM PREVIOUS CHAIN

;RETURN CORE, FIX UP CACHE SIZE
	SKIPE	T1,.CBUDB(T2)		;ASSOCIATED UDB?
	SOS	UNICBK(T1)		;YES--ONE LESS BLOCK CACHED
	SOS	%LDCSZ##		;CACHE IS 1 BLOCK SMALLER
	PUSHJ	P,DWNDC			;GIVE UP INTERLOCK
	PUSH	P,T2			;SAVE ENTRY ADDRESS
	MOVEI	T1,BLKSIZ##		;SIZE OF BLOCK
	MOVE	T2,.CBDAT(T2)		;ADDRESS OF BLOCK
IFN FTXMON,<PUSHJ P,GVFWDS##>
IFE FTXMON,<PUSHJ P,GIVWDS##>
	POP	P,T2			;RESTORE ENTRY ADDRESS
	MOVEI	T1,.CBLEN		;GET LENGTH
	PJRST	GIVWDS##		;RETURN CORE AND RETURN
	SUBTTL	CSHINS - INSERT (REPLACE) NEW BLOCK IN CACHE

;CALL:
;	T1/ BLOCK NUMBER
;	U/  UDB ADDRESS
;	T2/ ENTRY TO ADD AFTER
;	PUSHJ	P,CSHINS
;	<RETURN>
CSHINS:	CAMN	T2,CBHEAD+.CBPAB	;SAME AS ENTRY WE FIDDLE
	JRST	[MOVEM	T1,.CBBLK(T2)	;STORE NEW BLOCK
		 MOVEM	U,.CBUDB(T2)	;AND NEW UDB ADDRESS
		 SETZM	.CBHIT(T2)	;CLEAR HITS THIS BLOCK
		 PJRST	CSHMRU]		;AND MOVE TO TOP

;STORE BLOCK NUMBER AND UDB, REPLACE LAST BLOCK IN ACCESS CHAIN
	PUSH	P,T2			;SAVE ENTRY TO ADD
	MOVE	T2,CBHEAD+.CBPAB	;GET LAST IN CHAIN
	MOVEM	T1,.CBBLK(T2)		;STORE NEW BLOCK
	MOVEM	U,.CBUDB(T2)		;AND NEW UDB ADDRESS
	SETZM	.CBHIT(T2)		;CLEAR HITS THIS BLOCK

;UNLINK FROM OLD HASH CHAIN
	MOVE	T3,.CBNHB(T2)		;GET NEXT
	MOVE	T4,.CBPHB(T2)		;GET PREVIOUS
	MOVEM	T3,.CBNHB(T4)		;REMOVE FROM FORWARD CHAIN
	MOVEM	T4,.CBPHB(T3)		;REMOVE FROM PREVIOUS CHAIN

;LINK THIS BLOCK INTO CORRECT HASH CHAIN
	MOVE	T1,T2
	POP	P,T2			;RESTORE ENTRY TO ADD
	MOVE	T4,.CBNHB(T2)		;AND NEXT LINK
	MOVEM	T1,.CBNHB(T2)		;INSERT AFTER PREVIOUS
	MOVEM	T1,.CBPHB(T4)		;AND AS PREVIOUS OF OLD
	MOVEM	T2,.CBPHB(T1)		;STORE PREVIOUS OF OLD AS OURS
	MOVEM	T4,.CBNHB(T1)		;STORE NEXT OF OLD AS OURS
	MOVE	T2,T1

;MOVE ENTRY TO "MOST RECENTLY USED" AND RETURN
	PJRST	CSHMRU			;AND MOVE ENTRY TO TOP OF LIST
	SUBTTL	CSHMRU - MOVE ENTRY TO BEGINNING OF ACCESS LIST

;CALL:
;	T2/ ENTRY TO MOVE TO TOP OF ACCESS LIST
;	PUSHJ	P,CSHMRU
;	<RETURN>
CSHMRU:	AOS	.CBHIT(T2)		;COUNT HITS THIS BLOCK
	CAMN	T2,CBHEAD+.CBNAB	;WE AT THE TOP?
	POPJ	P,			;YES--SAVE SOME WORK

;DELETE FROM CURRENT ACCESS CHAIN POSITION
	MOVE	T3,.CBNAB(T2)		;GET NEXT
	MOVE	T4,.CBPAB(T2)		;GET PREVIOUS
	MOVEM	T3,.CBNAB(T4)		;REMOVE FROM FORWARD CHAIN
	MOVEM	T4,.CBPAB(T3)		;REMOVE FROM PREVIOUS CHAIN

;RELINK INTO "MOST RECENTLY USED" POSITION
	MOVE	T3,CBHEAD+.CBNAB	;GET FORWARD FROM HEADER
	MOVE	T4,.CBPAB(T3)		;AND PREVIOUS FROM TOP
	MOVEM	T2,CBHEAD+.CBNAB	;INSERT US AT THE TOP
	MOVEM	T2,.CBPAB(T3)		;PREVIOUS OF OLD TOP IS US
	MOVEM	T3,.CBNAB(T2)		;NEXT OF US IS OLD TOP
	MOVEM	T4,.CBPAB(T2)		;PREVIOUS OF US IS HEADER
	POPJ	P,			;AND RETURN
	SUBTTL	CSHLRU - MOVE ENTRY TO END OF ACCESS LIST

;CALL:
;	T2/ ENTRY TO MOVE TO END OF ACCESS LIST
;	PUSHJ	P,CSHLRU
;	<RETURN>
CSHLRU:	CAMN	T2,CBHEAD+.CBPAB	;WE AT THE END?
	POPJ	P,			;YES--SAVE SOME WORK

;DELETE FROM CURRENT ACCESS CHAIN POSITION
	MOVE	T3,.CBNAB(T2)		;GET NEXT
	MOVE	T4,.CBPAB(T2)		;GET PREVIOUS
	MOVEM	T3,.CBNAB(T4)		;REMOVE FROM FORWARD CHAIN
	MOVEM	T4,.CBPAB(T3)		;REMOVE FROM PREVIOUS CHAIN

;RELINK INTO "LEAST RECENTLY USED" POSITION
	MOVE	T3,CBHEAD+.CBPAB	;GET FORWARD FROM HEADER
	MOVE	T4,.CBNAB(T3)		;AND NEXT FROM TOP
	MOVEM	T2,CBHEAD+.CBPAB	;INSERT US AT THE TOP
	MOVEM	T2,.CBNAB(T3)		;NEXT OF OLD TOP IS US
	MOVEM	T3,.CBPAB(T2)		;PREVIOUS OF US IS OLD TOP
	MOVEM	T4,.CBNAB(T2)		;NEXT OF US IS HEADER
	POPJ	P,			;AND RETURN
	SUBTTL	CSHDEL - DELETE ENTRY, MOVE TO FREE LIST

;CALL:
;	T2/ ENTRY TO DELETE
;	PUSHJ	P,CSHDEL
;	<RETURN>
CSHDEL:	MOVE	T3,.CBNHB(T2)		;GET NEXT
	MOVE	T4,.CBPHB(T2)		;GET PREVIOUS
	MOVEM	T3,.CBNHB(T4)		;REMOVE FROM FORWARD CHAIN
	MOVEM	T4,.CBPHB(T3)		;REMOVE FROM PREVIOUS CHAIN

;LINK INTO FREE CHAIN
	MOVE	T3,CBHEAD+.CBNHB	;GET FORWARD FROM HEADER
	MOVE	T4,.CBPHB(T3)		;AND PREVIOUS FROM TOP
	MOVEM	T2,CBHEAD+.CBNHB	;INSERT US AT THE TOP
	MOVEM	T2,.CBPHB(T3)		;PREVIOUS OF OLD TOP IS US
	MOVEM	T3,.CBNHB(T2)		;NEXT OF US IS OLD TOP
	MOVEM	T4,.CBPHB(T2)		;PREVIOUS OF US IS HEADER

;ADJUST COUNTERS
	SKIPE	T3,.CBUDB(T2)		;GET UDB
	SOS	UNICBK(T3)		;ONE LESS BLOCK IN CACHE
	SETZM	.CBBLK(T2)		;CLEAR BLOCK NUMBER
	SETZM	.CBUDB(T2)		;AND UDB TO BE SAFE

;MOVE ENTRY TO "LEAST RECENTLY USED" AND RETURN
	PJRST	CSHLRU			;AND SET LEAST RECENTLY USED
	SUBTTL	CSDELB - DELETE BLOCK IF IN CACHE

;CALL:
;	T1/ BLOCK NUMBER
;	U/  UDB ADDRESS
;	PUSHJ	P,CSDELB
;	<RETURN>
;U/ UDB ADDRESS
CSDELB::PUSHJ	P,UPPDC			;GET INTERLOCK
	SKIPG	%LDCSZ##		;ANY BLOCKS IN CACHE?
	JRST	DWNDC			;NO, DON'T BOTHER
	PUSH	P,U			;SAVE U
	PUSHJ	P,CSSETU		;SETUP U TO PRIMARY PORT
	PUSHJ	P,CSHFND		;FIND IN CACHE
	  CAIA				;NOT FOUND--SKIP THE DELETE
	PUSHJ	P,CSHDEL		;FOUND--GO DELETE FROM CACHE
	PJRST	CSHDMM			;GIVE UP INTERLOCK AND POP U
	SUBTTL	CSDELR - DELETE A RANGE OF BLOCKS

;CALL:
;	T1/ STARTING BLOCK NUMBER
;	T2/ NUMBER OF BLOCKS
;	U/  UDB ADDRESS
;	PUSHJ	P,CSDELR
;	<RETURN>
CSDELR::PUSHJ	P,SAVE2##		;SAVE P1,P2
	DMOVE	P1,T1			;COPY ARGS
CSDLR1:	MOVE	T1,P1			;GET A BLOCK
	PUSHJ	P,CSDELB		;DELETE IF IN CACHE
	ADDI	P1,1			;ADVANCE TO NEXT BLOCK
	SOJLE	P2,CPOPJ##		;RETURN WHEN DONE
	TRNN	P2,77			;CALL SCDCHK EVERY
	PUSHJ	P,SCDCHK##		; 64 CALLS TO CSDELB
	JRST	CSDLR1			;LOOP FOR MORE
	SUBTTL	CSDELI - DELETE AN IOWD LIST OF BLOCKS

;CALL:
;	F/  DDB ADDRESS (DEVDMP, DEVBLK SETUP)
;	PUSHJ	P,CSDELI
;	<RETURN>
CSDELI::PUSHJ	P,SAVT##		;DONT TOUCH ANY AC'S
	HRRZ	T2,UNISTR(U)		;MOUNTED AS A STR?
	JUMPE	T2,CPOPJ##		;NO, DON'T NEED TO
	HLRE	T2,DEVDMP##(F)		;GET -SIZE
	MOVMS	T2			;GET +SIZE
	ADDI	T2,BLKSIZ##-1		;ROUND UP
	IDIVI	T2,BLKSIZ##		;COMPUTE NUMBER OF BLOCKS
	MOVE	T1,DEVBLK##(F)		;GET STARTING BLOCK
	SUB	T1,T2
	JUMPL	T1,CPOPJ##		;DEVDMP IS FUNNY DURING FORMATING
	PJRST	CSDELR			;DELETE THAT RANGE AND RETURN
	SUBTTL	CSDELU - DELETE ALL BLOCKS ON SPECIFIED UNIT FROM CACHE

;CALL:
;	U/ UDB ADDRESS
;	PUSHJ	P,CSDELU
;	<RETURN>
CSDELU::PUSHJ	P,UPDC			;GET INTERLOCK
	  JRST	CSDU9			;NOT AVAILABLE
	PUSHJ	P,CSDUN			;DELETE IT
	PJRST	DWNDC			;GIVE AWAY INTERLOCK

;HERE IF YOU ALREADY HAVE THE INTERLOCK
CSDUN:	SKIPG	%LDCSZ##		;ANY BLOCKS IN CACHE?
	POPJ	P,			;NO
	PUSHJ	P,SAVE2##
	PUSHJ	P,SAVT##		;BETTER SAFE THAN SORRY
	PUSH	P,U			;SAVE UNIT
	TLZ	U,-1			;PARANOIA
IFN FTDUAL,<
	PUSHJ	P,CSDU0			;DELETE 1ST PORT
	HRRZ	U,UNIALT(U)		;DELETE 2ND PORTS
	JUMPE	U,UPOPJ##
	PUSHJ	P,CSDU0
	JRST	UPOPJ##
>
CSDU0:	MOVEI	P1,UNPNDU		;CLEAR BIT
	ANDCAM	P1,UNINDU(U)
	MOVSI	P1,-CBHSHL##		;GET LENGTH OF TABLE

;STEP THROUGH EACH ENTRY IN THE HASH TABLE
CSDU1:	MOVEI	P2,CBHSHT(P1)		;GET AN ENTRY
	MOVE	T2,.CBNHB(P2)		;GET FIRST ENTRY

;STEP THROUGH EACH HASH CHAIN FOR THIS ENTRY
CSDU2:	CAMN	P2,T2			;LOOPED BACK?
	JRST	CSDU3			;YES
	PUSH	P,.CBNHB(T2)		;SAVE POINTER TO NEXT BLOCK
	CAMN	U,.CBUDB(T2)		;MATCH THIS UNIT
	PUSHJ	P,CSHDEL		;YES--DELETE IT
	POP	P,T2			;RESTORE NEXT BLOCK
	JRST	CSDU2			;AND LOOP

CSDU3:	AOBJN	P1,.+1			;ADVANCE TO NEXT
	AOBJN	P1,CSDU1		;LOOP FOR WHOLE TABLE
IFE FTDUAL,<JRST UPOPJ##>
IFN FTDUAL,<POPJ P,>

;HERE IF INTERLOCK IS NOT AVAILABLE
;DELAY THE CACHE SWEEP TILL LATER
CSDU9:	PUSHJ	P,SAVE1##
	MOVEI	P1,UNPNDU		;LIGHT THE BIT
	IORM	P1,UNINDU(U)
	AOS	NOWDUC##		;COUNT IT
	POPJ	P,
REPEAT 0,<
	SUBTTL	CSDELA - DELETE ALL BLOCKS FROM CACHE

;CALL:
;	PUSHJ	P,CSDELA
;	<RETURN>
CSDELA::PUSHJ	P,UPPDC			;GET INTERLOCK
	SKIPG	%LDCSZ##		;ANY BLOCKS IN CACHE?
	JRST	CSDA4			;NO--DONT BOTHER
	PUSHJ	P,SAVE2##		;SAVE P1,P2
	MOVSI	P1,-CBHSHL##		;GET LENGTH OF TABLE

;STEP THROUGH EACH ENTRY IN THE HASH TABLE
CSDA1:	MOVEI	P2,CBHSHT(P1)		;GET AN ENTRY
	MOVE	T2,.CBNHB(P2)		;POINT TO FIRST ENTRY

;STEP THROUGH EACH HASH CHAIN FOR THIS ENTRY
CSDA2:	CAMN	P2,T2			;LOOPED BACK?
	JRST	CSDA3			;YES
	PUSH	P,.CBNHB(T2)		;SAVE POINTER TO NEXT BLOCK
	PUSHJ	P,CSHDEL		;DELETE THIS BLOCK
	POP	P,T2			;RESTORE NEXT BLOCK
	JRST	CSDA2			;AND LOOP

CSDA3:	AOBJN	P1,.+1			;ADVANCE TO NEXT
	AOBJN	P1,CSDA1		;LOOP FOR WHOLE TABLE
CSDA4:	PUSHJ	P,DWNDC			;GIVE UP INTERLOCK
	POPJ	P,			;AND RETURN
>
	SUBTTL	CSSETU - SETUP U TO PRIMARY PORT

;CALL:
;	U/ UDB ADDRESS
;	PUSHJ	P,CSSETU
;	<RETURN>			;U/ PRIMARY PORT UDB ADDRESS
CSSETU:
IFN FTDUAL,<
	SKIPGE	T3,UNI2ND(U)		;2ND PORT?
	HRRZ	U,UNI2ND(U)		;YES, GET PRIME PORT
>;END IF FTDUAL
	TLZ	U,-1			;BE SURE JUST RH ADDRESS
	POPJ	P,			;AND RETURN

	$LIT
	$LOW

LASUNI:	BLOCK	1			;LAST DISK UDB BUILT
CBHEAD::BLOCK	.CBLEN			;CACHE BLOCK LIST HEADER
FILEND:	END