Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99V-BB_1990 - 10,7/mon/filio.mac
Click 10,7/mon/filio.mac to see without markup as text/plain
There are 15 other files named filio.mac in the archive. Click here to see a list.
TITLE	FILIO LEVEL-D DISK SERVICE ROUTINE  V1361
SUBTTL	DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW  29-NOV-90

	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,1990.
;ALL RIGHTS RESERVED.

.CPYRT<1973,1990>


XP VFILIO,1361

;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)
	PUSHJ	P,TSTGEN	;UNIT GENERATION NUMBERS CHANGE?
	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
	PUSHJ	P,TSTGEN	;UNIT GENERATION NUMBERS CHANGE?
	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)
>
	MOVE	J,.USJOB	;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,WATDF1	;NOT IF ZERO
	HRRZ	T1,UFBAUJ##(T1)	;GET OWNER
	CAIN	T1,(J)		;IS IT US?
	 JRST	UPDA2		;YES. GIVE DA TOO
WATDF1:	HRRZ	T1,JBTFA##(J)	;GOT THE FA?
	JUMPE	T1,WAITDA
	HRRZ	T1,NMBFAJ##(T1)	;IS FA USER US?
	CAIN	T1,(J)
	JRST	UPDA2		;GIVE DA IF HAVE FA
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	.+1,DEBUG,DHD,	;++ (S CLAIMS) DON'T HAVE DA
	PUSH	P,T1
	MOVE	T1,.USJOB	;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
	MOVE	T1,.USJOB	;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	DWNDA9,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
	MOVE	J,.USJOB	;
	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

DWNDA9:	JUMPE	F,CPOPJ##	;RETURN IF NO DDB
	PJRST	STRIOS		;ELSE UPDATE DEVIOS AND RETURN
;SUBROUTINE TO GET THE FA RESOURCE
;RESPECTS ALL AC'S
UPFA::	PUSHJ	P,SAVE2##	;SAVE P1, P2
	PUSHJ	P,SAVJW##	;SAVE J (W ALONG FOR THE RIDE)
	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
	MOVE	J,.USJOB	;GET MY JOB NUMBER
	HRRM	P1,JBTFA##(J)	;SAVE NMB ADDRESS FA OWNED/WANTED
	UUOLOK			;LOCK AGAINST UUO LEVEL ONLY NOW
	HRRZ	P2,NMBFAJ##(P1)	;GET CURRENT USER
	JUMPN	P2,WAITFA	;JUMP IF IN USE
	MOVSI	P2,JXPN		;IS JOB EXPANDING...
	TLNN	P2,JBTSTS##(J)	;?
	CAMN	J,FORCEF##	;OR BEING WAITED ON BY THE SWAPPER?
	JRST	UPFA3		;CUT THE FLOW
UPFA2::	HRRM	J,NMBFAJ##(P1)	;WE OWN IT NOW
	UUONLK			;DONE WITH INTERLOCK
	TRO	S,IOSFA		;FLAG WE OWN FA
	PJRST	STRIOS		;SAVE S AND RETURN

;FA FREE, BUT MIGHT WANT TO STOP JOB NOW ANYWAY

UPFA3:	HLRZ	P2,JBTDAU##(J)	;GOT THE DA?
	JUMPE	P2,UPFA4	;NO
	HRRZ	P2,UNIAJB(P2)	;DA RESOURCE FOR UDB
	CAIN	J,(P2)		;IS IT US?
	JRST	UPAU2		;YES, GO AHEAD & GIVE FA
UPFA4:	HRRZ	P2,JBTDAU##(J)	;HAVE AU?
	JUMPE	P2,WAITFA	;NO
	HRRZ	P2,UFBAUJ##(P2)	;AU USER
	CAIN	J,(P2)
	JRST	UPFA2		;IF HAS AU, GIVE FA

WAITFA:	UUONLK			;DONE WITH UUO LOCK
	MOVEI	P2,FAQ##	;WAIT CODE
	DPB	P2,PJBSTS##	;STORE IT
	PUSHJ	P,WSCHED##	;WAIT
	TRO	S,IOSFA		;FLAG WE OWN FA
	PJRST	STRIOS		;SAVE S AND RETURN

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
	CAME	P2,.USJOB	;ARE WE THE OWNER?
	JRST	UPFAZ		;NO, STOPCODE
DWNFA1:	UUOLOK			;LOCK US
	HLLZS	JBTFA##(P2)	;CLEAR NMB ADDRESS
	HLLZS	NMBFAJ##(P1)	;INDICATE FA FREE FOR NMB
	UUONLK			;DONE WITH LOCK
	SKIPE	F		;DON'T SAVE S
	PUSHJ	P,STRIOS	;SAVE S
	PUSH	P,T1		;FOR FUNNY SRFRFA CODE
	MOVE	J,P2		;SCHEDULAR CODE WANTS J=JOB
	PUSH	P,J		;T1, J NEED TO BE ON STACK
	PJRST	SRFRFA##

;ROUTINE TO GIVE JOB FA RESOURCES AT SCHEDULAR LEVEL

SCDFA::	HRRZ	T3,JBTFA##(J)	;FA WE WANT
	JUMPE	T3,CPOPJ##	;?
	PUSH	P,T1		;SAVE T1
	UUOLOK
	HRRZ	T1,NMBFAJ##(T3)	;CURRENT OWNER
	JUMPN	T1,SCDFA2	;SOMEONE SNUCK IN
	HRRM	J,NMBFAJ##(T3)	;WE OWN IT NOW
	AOS	-1(P)		;GIVE GOOD RETURN
SCDFA2:	UUONLK
	POP	P,T1		;RESTORE T1
	POPJ	P,		;RETURN

;SUBROUTINE TO GET OWNER OF FA WE WANT FOR UNWIND

UNWFA::	HRRZ	T3,JBTFA##(J)	;NMB ADDRESS WE WANT
	JUMPE	T3,CPOPJ##	;CAN'T FIND NOW
	HRRZ	T3,NMBFAJ##(T3)	;CURRENT JOB # OF OWNER
	POPJ	P,
;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 UNLESS CALLED AT OWNFA

OWNFA::	PUSHJ	P,SAVE1##	;SAVE P1 FOR SCHEDULAR
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,WATAU2	;NOT IF ZERO
	HRRZ	P2,UNIAJB(P2)	;GET OWNER OF DA
	CAIN	J,(P2)		;IS IT US?
	 JRST	UPAU2		;YES. GIVE HIM AU
WATAU2:	HRRZ	P2,JBTFA##(J)	;GOT THE FA?
	JUMPE	P2,WAITAU
	HRRZ	P2,NMBFAJ##(P2)	;IS FA USER US?
	CAIN	P2,(J)
	JRST	UPAU2		;GIVE DA IF HAVE FA

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
	MOVEM	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
	LDB	T1,UNYUST##	;GET CURRENT PACK STATUS
	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
	MOVEI	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?
	JRST	UPOPJ##		;YES, RETURN NOW
>; END IFN FTCIDSK
IFN FTMDA,<PUSHJ P,DSKMPD>	;NOTIFY MDA OF LOSS
	MOVEI	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
	MOVEI	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 RH(T1), F + U SETUP
DSKCSC:	SKIPE	DINITF##	;DON'T DO THIS DURING INITIALIZATION
	POPJ	P,		;QUIT NOW
	MOVSI	T4,(T1)		;GET LH SUB-CODE FOR DAEMON
	CAIE	T1,.CSCXC	;IF NOT EXCHANGE,
	TDZA	T3,T3		;THEN NO SECOND UNIT TO REPORT
	MOVE	T3,UDBNAM(F)	;ELSE GET NAME OF SECOND UNIT
	XMOVEI	T2,CSCBEG	;POINT TO OUR TRANSFER TABLE
	SETZ	T1,		;WE HAVE NOT ALLOCATED THE ERROR BLOCK
	PUSHJ	P,XFRSEB##	;MAKE AN ERROR ENTRY
	  POPJ	P,		;PUNT IF NO CORE
	POPJ	P,		;ALREADY GAVE IT TO DAEMON--JUST RETURN

CSCBEG:	SEBTBL(.ERCSC,CSCEND,EX.QUE!EX.SYE)
	MOVE	UDBNAM(U)	;(R00) FIRST UNIT NAME
	MOVE	T3		;(R01) SECOND UNIT NAME OR ZERO
	MOVE	T4		;(R02) SUB-CODE,,0
CSCEND:!
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 UN