Google
 

Trailing-Edge - PDP-10 Archives - BB-K911B-SM - sources/physio.mac
There are 56 other files named physio.mac in the archive. Click here to see a list.
; UPD ID= 735, SNARK:<5.MONITOR>PHYSIO.MAC.10,   7-Jul-80 00:47:13 by DBELL
;TCO 5.1096 - HAVE UNICHK LOOK FOR HALTED MICROCODE IN CONTROLLERS
; UPD ID= 685, SNARK:<5.MONITOR>PHYSIO.MAC.9,  22-Jun-80 12:19:58 by DBELL
;TCO 5.1065 - COMPLAIN ABOUT WRITE-LOCKED DISKS
; UPD ID= 679, SNARK:<5.MONITOR>PHYSIO.MAC.8,  19-Jun-80 16:32:02 by DBELL
;TCO 5.1071 - STORE CONTROLLER AND UNIT NUMBERS IN SYSERR BLOCKS
;TCO 5.1066 - GIVE IORB FUNCTION IN OVRDTA BUGCHK
;MAKE CLRACT GLOBAL, CLEAR US.WLK FOR DISKS ONCE A MINUTE IN UNITRY ROUTINE
; UPD ID= 616, SNARK:<5.MONITOR>PHYSIO.MAC.5,   8-Jun-80 15:52:07 by DBELL
;DON'T LET UDSKIO/MDSKIO DO TRANSFERS ACROSS CYLINDER BOUNDARIES
; UPD ID= 576, SNARK:<5.MONITOR>PHYSIO.MAC.4,  31-May-80 22:59:31 by DBELL
;TCO 5.1053 - DON'T GIVE FATAL ERROR FOR HUNG IORBS DOING SEEKS
;TCO 5.1048 - ADD ROUTINES TO ALLOW MULTIPLE-PAGE DISK I/O TO WORK
; UPD ID= 481, SNARK:<4.1.MONITOR>PHYSIO.MAC.30,  26-Apr-80 11:45:15 by DBELL
;CLEAN UP CODE LOTS BY USING TXNN AND MOVX MACROS EVERYWHERE
;TCO 4.1.1149 - MAKE HNGIRB ROUTINE KNOW ABOUT DISK CONTROLLERS
; UPD ID= 397, SNARK:<4.1.MONITOR>PHYSIO.MAC.29,   2-Apr-80 13:27:42 by DBELL
;MOVE INSTRUCTION AT PHYKIL DOWN TO PREVENT ILMNRF
; UPD ID= 366, SNARK:<4.1.MONITOR>PHYSIO.MAC.28,  26-Mar-80 11:07:44 by DBELL
;TCO 4.1.1119 - ADD LOTS OF CODE TO SUPPORT RP20 DISKS
; UPD ID= 215, SNARK:<4.1.MONITOR>PHYSIO.MAC.27,  23-Jan-80 09:19:39 by SCHMITT
;TCO 4.1.1071 - If fairness cnt exhsted at SEK1+5, chk for minimum cyl
;<4.1.MONITOR>PHYSIO.MAC.26, 10-Nov-79 11:08:37, EDIT BY DBELL
;TCO 4.1.1012 - TEST US.ACT CORRECTLY AT CHK5+3
;<4.MONITOR>PHYSIO.MAC.25, 16-Oct-79 12:09:04, EDIT BY DBELL
;TCO 4.2527 - ADD FNDCKU TO FIND CHANNEL, CONTROLLER, AND UNIT NUMBERS
; AND USE IT FOR OVRDTA BUGINF
;<4.MONITOR>PHYSIO.MAC.24,  2-Oct-79 16:42:19, EDIT BY DBELL
;TCO 4.2507 - FIX RSTSEK TO SET UP P2 AND P3 CORRECTLY
;<4.MONITOR>PHYSIO.MAC.23, 20-Sep-79 15:28:19, EDIT BY DBELL
;TCO 4.2476 - ADD EXTKDB AND EXTUDB TO CHECK FOR EXISTANCE OF UNITS
;<OSMAN.MON>PHYSIO.MAC.1, 10-Sep-79 16:01:21, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>PHYSIO.MAC.20, 25-Jul-79 18:10:27, EDIT BY DBELL
;MAKE SCHSEK GLOBAL
;<4.MONITOR>PHYSIO.MAC.19,  6-Mar-79 09:34:56, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<2BOSACK>PHYSIO.MAC.3, 14-Feb-79 10:59:18, EDIT BY BOSACK
;CAUSE UNIMES TO GET CORRECT TAPE UNIT NUMBER
;<4.MONITOR>PHYSIO.MAC.17,  7-Feb-79 14:31:21, Edit by MCLEAN
;FIX FAILURE PATH ON PHYALC SO NON-SKIP RETURN WORKS
;<4.MONITOR>PHYSIO.MAC.16, 28-Jan-79 16:55:21, Edit by MCLEAN
;<4.MONITOR>PHYSIO.MAC.16, 28-Jan-79 16:55:21, Edit by MCLEAN
;MAKE DGUMAP USE P6 INSTEAD OF P5 FOR TEMP
;<4.MONITOR>PHYSIO.MAC.14, 20-Nov-78 16:40:35, EDIT BY BOSACK
;<4.MONITOR>PHYSIO.MAC.13, 23-Oct-78 12:12:48, Edit by MILLER
;MAKE CORRECT CLEAR VALID VOLUME ROUTINE FOR PHYOFL
;<4.MONITOR>PHYSIO.MAC.12, 27-Sep-78 11:04:47, EDIT BY KIRSCHEN
;IMPROVE COMMENT AT HEAD OF GETSTR
;<4.MONITOR>PHYSIO.MAC.11, 30-Aug-78 09:57:40, EDIT BY FORTMILLER
;TCO 4.1999 Clear US.REW in HNGIRB
;<4.MONITOR>PHYSIO.MAC.10, 18-Aug-78 12:11:08, EDIT BY MURPHY
;<3A.MONITOR>PHYSIO.MAC.171, 13-Aug-78 23:33:28, EDIT BY BOSACK
;IF A POSITIONING OPERATION TO A TAPE GETS AN ERROR AT STRTPS,
;FLUSH IORB AND POST COMPLETE
;<4.MONITOR>PHYSIO.MAC.8,  5-Aug-78 16:47:38, Edit by MCLEAN
;<4.MONITOR>PHYSIO.MAC.7, 31-Jul-78 23:54:51, Edit by MCLEAN
;CLEAR MT VALID VOLUME ON OFFLINE
;<4.MONITOR>PHYSIO.MAC.6, 28-Jul-78 01:01:58, Edit by MCLEAN
;<4.MONITOR>PHYSIO.MAC.5, 28-Jul-78 00:24:44, Edit by MCLEAN
;<4.MONITOR>PHYSIO.MAC.4, 28-Jul-78 00:08:14, Edit by MCLEAN
;<2MCLEAN>PHYSIO.MAC.3, 23-Jul-78 16:43:29, Edit by MCLEAN
;INSERT PSI REQUESTS FOR REWINDS
;<4.MONITOR>PHYSIO.MAC.2, 20-Jul-78 00:52:07, Edit by MCLEAN
;FIX PHYRWD FOR PSI ON REWIND DONE
;<1MCLEAN>PHYSIO.MAC.163,  6-May-78 21:46:32, Edit by MCLEAN
;<1MCLEAN>PHYSIO.MAC.162,  6-May-78 21:34:36, Edit by MCLEAN
;ADD RP07
;<3A.MONITOR>PHYSIO.MAC.170,  2-Jul-78 01:33:55, Edit by BOSACK
;<3A.MONITOR>PHYSIO.MAC.169,  2-Jul-78 01:27:28, Edit by BOSACK
;<3A.MONITOR>PHYSIO.MAC.168, 28-Jun-78 13:50:49, EDIT BY BOSACK
;<3A.MONITOR>PHYSIO.MAC.167, 31-May-78 20:58:07, EDIT BY BOSACK
;<3A.MONITOR>PHYSIO.MAC.166, 31-May-78 14:43:13, EDIT BY BOSACK
;ADD TEMP XBIO STATS
;<3A-NEW>PHYSIO.MAC.165, 25-May-78 11:45:48, Edit by FORTMILLER
;ADD DX20 SUPPORT
;<3A.MONITOR>PHYSIO.MAC.164,  5-May-78 14:12:54, Edit by MCLEAN
;ADD CONVERT BCD TO OCTAL ROUTINE
;<3A.MONITOR>PHYSIO.MAC.163, 22-May-78 10:34:22, EDIT BY MILLER
;MOVE CALL TO GENBLK TO PROPER PLACE
;<3A.MONITOR>PHYSIO.MAC.162, 19-May-78 08:39:19, EDIT BY MILLER
;TCO 1189. GENREATE STATUS BLOCK AT ERRFIN
;<3A.MONITOR>PHYSIO.MAC.161, 21-Apr-78 14:03:22, EDIT BY MILLER
;FIX TYPEO IN 1878 ADDITION
;<3A.MONITOR>PHYSIO.MAC.160, 20-Apr-78 13:45:41, EDIT BY BOSACK
;3A TCO 1878 - TEST IF USER WANTS ERROR ON OFFLINE IN UDSKIO
;<3A.MONITOR>PHYSIO.MAC.159, 30-Mar-78 16:06:46, EDIT BY MILLER
;ADD MASSBUS UNIT # TO OVRDTA OUTPUT
;<3A.MONITOR>PHYSIO.MAC.158, 23-Mar-78 15:13:38, EDIT BY MILLER
;ADD UNIT AND CHANNEL #'S TO OVRDTA BUGINF
;<2BOSACK>PHYSIO.MAC.155, 24-Feb-78 01:18:37, EDIT BY BOSACK
;DONT START A NEW TRANSFER ON POWERFAIL, DONT DO BAT BLOCKS UNLESS DATA ERROR
;<2BOSACK>PHYSIO.MAC.155, 24-Feb-78 01:18:37, EDIT BY BOSACK
;DONT START A NEW TRANSFER ON POWERFAIL, DONT DO BAT BLOCKS UNLESS DATA ERROR
;<4.MONITOR>PHYSIO.MAC.155, 17-Feb-78 06:53:39, Edit by GILBERT
;DON'T MASK OUT HIGH ORDER BITS OF DISK ADDRESS IN UDSKIO.
;<4.MONITOR>PHYSIO.MAC.154,  1-Feb-78 14:48:55, Edit by MCLEAN
;MAKE PHYALC,PHYUDB ONLY BUGINF ON FAILURE
;<2BOSACK>PHYSIO.MAC.153, 27-Jan-78 02:16:48, EDIT BY BOSACK
;MOVE DSKSIZ TO PHYSIO
;<2BOSACK>PHYSIO.MAC.152, 26-Jan-78 23:21:11, EDIT BY BOSACK
;DONT PASS UDB FLAGS TO SEBCPY
;<2BOSACK>PHYSIO.MAC.151, 25-Jan-78 03:10:28, EDIT BY BOSACK
;USE SKIPS FOR TESTS OF SHORT IORB


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG,PHYPAR,SERCOD
; A SEARCH OF PROKL IS DONE HERE BECAUSE THE DEFINITONS
;OF CHNOFF AND CHNON ARE NEEDED AND PROKL IS A SUPERSET
;OF PROKS.  IN THE FUTURE IT SHOULD BE POSSIBLE TO REMOVE
;THIS SEARCH AFTER THE PI SYSTEM OF THE KL IS FIXED.
	SEARCH PROKL
	TTITLE(PHYSIO,,< - DEVICE INDEPENDENT PHYSICAL IO>)
	SUBTTL L.BOSACK 17-MAY-75
	RESCD

EXTERN MAXCHN,PHYCHL,PHYCHT,PHYPZS,ZSEND,CST5
EXTERN PHYACS,PHYIPD,PHYPDL,PHYSVP,UDIORB,UIOLST
EXTERN CHNTAB

;LATENCY OPTIMIZATION PARAMETERS

MINLAT==^D2700		;2.7MS SAFETY FACTOR
INIFCX==^D40		;INITIAL FAIRNESS COUNT FOR XFRS
			;DO A ROUND ROBIN CHANNEL SCHEDULE CYCLE
			;EVERY INFCX TRANSFERS. WHEN A CHANNEL GOES
			;IDLE, RESET THE COUNT.
INIFCP==^D40		;INITIAL FAIRNESS COUNT FOR POSITIONING
			;AT MOST INIFCP TRANSFERS WILL BE APPENDED
			;TO THE END OF A UNITS TRANSFER QUEUE IF
			;THERE ARE REQUESTS TO OTHER CYLINDERS
INIFCR==^D15		;INITIAL FAIRNESS COUNT FOR READ SEEK PREFERENCE
			;FOR INIFCR SEEK SCHEDULE CYCLES READS WILL
			;BE ABSOLUTLY PREFERABLE TO WRITES

;GLOBAL BYTE POINTERS

IRYFCN::POINT ISSFCN,IRBSTS(P4),ISPFCN ;IORB FUNCTION CODE
IRYMOD::POINT IMSMOD,IRBMOD(P4),IMPMOD ;IORB MODE

USYTYP::POINT USSTYP,UDBSTS(P3),USPTYP ;UNIT TYPE
CSYTYP::POINT CSSTYP,CDBSTS(P1),CSPTYP ;CHANNEL TYPE
CSYPIA::POINT CSSPIA,CDBSTS(P1),CSPPIA ;PI ASSIGNMENT
USYBKT::POINT XSSTYP,UDBSTS(P3),XSPTYP	;BLOCK TYPE FROM P3

;TABLE OF BYTES PER WORD AS A FUNCTION OF MODE

MODTAB::EXP -1			;ILLEGAL
	EXP 1			;WORD MODE
	EXP 6			;6 BIT MODE
	EXP 5			;7 BIT MODE
	EXP 4			;8 BIT MODE
	EXP 1			;HIGH DENSITY MODE

;TABLE OF UNIT TYPES USABLE BY THE FILESYSTEM
;NOTE: WHEN ADDING AN ENTRY TO THIS TABLE, BE SURE TO ADD A CORRESPONDING
;ENTRY IN DSKSIZ TO INDICATE THE SIZE OF THE DISK

DSKUTP::EXP .UTRP4		;RP04
	EXP .UTRP5		;RP05
	EXP .UTRP6		;RP06
	EXP .UTRP7		;RP07
	EXP .UTRM3		;RM03
	EXP .UTP20		;RP20
NDSKUT==:.-DSKUTP

;TABLE OF POINTER TO UNIT PHYSICAL SIZE PARAMETERS - THE TABLES ARE
;DEFINED IN STG


DSKSIZ::DSKSZ0			;RP04
	DSKSZ0			;RP05
	DSKSZ1			;RP06
	DSKSZ2			;RP07
	DSKSZ3			;RM03
	DSKSZ4			;RP20

;TABLE OF UNIT TYPE NAMES

NAMUTP::POINT 7,[ASCIZ /(ILLEGAL TYPE:0)/]
	POINT 7,[ASCIZ /RP04/]
	POINT 7,[ASCIZ /RS04/]
	POINT 7,[ASCIZ /TU45/]
	POINT 7,[ASCIZ /TM02/]
	POINT 7,[ASCIZ /RP05/]
	POINT 7,[ASCIZ /RP06/]
	POINT 7,[ASCIZ /RP07/]
	POINT 7,[ASCIZ /RP08/]
	POINT 7,[ASCIZ /RM03/]
	POINT 7,[ASCIZ /TM03/]
	POINT 7,[ASCIZ /TU77/]
	POINT 7,[ASCIZ /TM78/]
	POINT 7,[ASCIZ /TU78/]
	POINT 7,[ASCIZ /DX20A/]
	POINT 7,[ASCIZ /TU70/]
	POINT 7,[ASCIZ /TU71/]
	POINT 7,[ASCIZ /TU72/]
	POINT 7,[ASCIZ /TU73/]
	POINT 7,[ASCIZ /DX20B/]
	POINT 7,[ASCIZ /RP20/]
;INITIALIZATION
;WIPES THE ACCUMULATORS

PHYINI::MOVSI Q1,PHYCHL		;GET LENGTH OF CHANNEL SERVICE TABLE
	MOVEI P4,0		;FIRST FREE SLOT IN CHANTAB
PHYIN2:	HRRZ T1,PHYCHT(Q1)	;GET DISPATCH ADDRESS
	PUSH P,Q1		;SAVE OVER CALL
	CALL CDSINI(T1)		;CALL TO INITIALIZE ALL CHANNELS OF THIS TYPE
	POP P,Q1		;RESTORE AOBJN POINTER
	MOVEM P4,MAXCHN		;FREE SLOT UPDATED
	AOBJN Q1,PHYIN2		;LOOP FOR ALL TYPES LOADED

	MOVEI T1,UIOLEN*<NUIORB-1>+UDIORB ;INITIALIZE IORB FREE LIST
	SETZM (T1)		;CLEAR END OF LIST
PHYIN3:	CAIN T1,UDIORB		;DONE?
	JRST PHYIN4		;YES
	MOVE T2,T1		;NO - SAVE SUCCESSOR
	SUBI T1,UIOLEN		;MOVE BACKWARD IN LIST
	MOVEM T2,(T1)		;STORE FOREWARD POINTER
	JRST PHYIN3

PHYIN4:	MOVEM T1,UIOLST		;STORE HEAD OF LIST
	SETOM DIAGLK		;INITIALIZE LOCK TO FREE
	RET

;UTILITY TO SET UP AND INITIALIZE A UDB
;T3/ DISPATCH ADDRESS,,LENGTH OF UDB
;Q2/ UNIT NUMBER
;P1/ CDB
;RETURNS +1(ON FAILURE):
;RETURNS +2 (SUCCESS)
;P3/ UDB ADDRESS

PHYUDB::HRRZ T1,T3		;LENGTH OF UDB
	PUSHJ P,PHYALC		;ALLOCATE STORAGE
	RET			;NONE FOUND
	MOVE P3,T1		;UDB POINTER TO P3
	HLRZ T1,T3		;DISPATCH ADDRESS
	MOVEM T1,UDBDSP(P3)	;SET UP IN UDB
	MOVEI T1,.BTUDB		;MARK AS UDB
	DPB T1,USYBKT		; ...
	HRRZM P1,UDBCDB(P3)	;SET UP CDB ADDRESS
	HRRZM Q2,UDBADR(P3)	;THIS UNITS ADDRESS ON CHANNEL
	HRL Q2,P1		;CDB,,UNIT #
	MOVEM Q2,UDBAKA(P3)	;AKA TEMPORARY SETUP
	HRRZ Q2,Q2		;RESTORE Q2
	MOVSI T1,UDBPWQ(P3)	;MAKE EMPTY QUEUES
	MOVEM T1,UDBPWQ(P3)	;POSITION WAIT QUEUE
	MOVSI T1,UDBTWQ(P3)
	MOVEM T1,UDBTWQ(P3)	;TRANSFER WAIT QUEUE
	MOVEI T1,-1		;SET POSITIONS TO UNKNOWN
	MOVEM T1,UDBPS1(P3)	; ...
	MOVEM T1,UDBPS2(P3)	; ...
	SETOM UDBSTR(P3)	;NOT ASSIGNED TO A STRUCTURE
	RETSKP
;ROUTINE TO CHECK FOR THE LEGALITY AND EXISTANCE OF A PARTICULAR
;UNIT ON A CHANNEL.  THIS ROUTINE HANDLES ALMOST ALL CASES, WHERE
;CONTROLLERS AND UNITS RANGE FROM 0-7, AND ARE REFERENCED AS OFFSETS
;INTO UDB TABLES.  ANY EXCEPTIONS (SUCH AS THE DX20) WILL HAVE THEIR
;OWN ROUTINES.  USED BY THE .DGPDL FUNCTION OF DIAG.  ARGUMENTS:
;  P1/	CDB
;  P2/	KDB (ONLY FOR EXTUDB CALL)
;  P5/	CONTROLLER NUMBER OR -1 IF NONE (ONLY FOR EXTKDB CALL)
;  Q2/	UNIT NUMBER
;RETURNS:
;  +1:	T1/ 0	UNIT OR CONTROLLER IS ILLEGAL
;	T1/ -1	UNIT OR CONTROLLER IS NONEXISTANT
;  +2:	CONTROLLER AND UNIT EXIST
;TRASHES T1.  P2 AND P3 ARE SET TO THE KDB AND UDB AS THEY ARE FOUND.


EXTKDB::JUMPL P5,EXTUD2		;DIFFERENT IF NO CONTROLLER
	CAILE P5,7		;CAN HAVE ONLY 8 UNITS
	JRST RFALSE		;ILLEGAL
	MOVE T1,CDBIUN(P1)	;GET ADDRESS OF KDB POINTERS
	ADD T1,P5		;ADD KDB UNIT
	SKIPN P2,(T1)		;KDB EXIST?
	JRST RTRUE		;NO
	MOVE P3,P2		;COPY FOR CHECK
	LDB T1,USYBKT		;GET BLOCK TYPE
	CAIE T1,.BTKDB		;MAKE SURE IT IS A KDB
	JRST RTRUE		;NO, ERROR
	MOVE T1,KDBDSP(P2)	;GET DISPATCH ADDRESS
	JRST UDSEXT(T1)		;ASK CONTROLLER ABOUT THE UNIT

EXTUD2:	SKIPA P3,[ADD T1,CDBIUN(P1)]	;INSTRUCTION FOR NO CONTROLLER
EXTUDB::SKIPA P3,[ADD T1,KDBIUN(P2)]	;OR INSTRUCTION FOR CONTROLLER
	SETZ P2,		;FLAG NONEXISTANCE OF CONTROLLER
	SKIPL T1,Q2		;CHECK UNIT VALIDITY
	CAILE T1,7		;ONLY CAN HAVE 8 UNITS
	JRST RFALSE		;ILLEGAL
	XCT P3			;ADD IN ADDRESS OF UNIT TABLE
	SKIPN P3,(T1)		;SEE IF UDB EXISTS
	JRST RTRUE		;NO
	LDB T1,USYBKT		;GET BLOCK TYPE
	CAIE T1,.BTUDB		;MAKE SURE IT IS A UDB
	JRST RTRUE		;NOPE
	RETSKP			;YES, SKIP RETURN
;SUBROUTINE TO FIND THE CORRECT CHANNEL, CONTROLLER, AND UNIT NUMBERS
;GIVEN THE CDB, KDB, AND UDB ADDRESSES.  USED BY VARIOUS BUGCHKS, ETC.
;CALL:
;  P1/	CDB
;  P2/	KDB, OR 0 IF NONE
;  P3/	UDB
;RETURNS +1 ALWAYS:
;  T1/	CHANNEL NUMBER
;  T2/	CONTROLLER NUMBER OR -1 IF NONE
;  T3/	UNIT NUMBER




FNDCKU::HRRZ T1,CDBADR(P1)	;GET CHANNEL NUMBER
	SETO T2,		;ASSUME NO CONTROLLER
	HRRZ T3,UDBAKA(P3)	;GET UNIT IF NO CONTROLLER
	TRNN P2,-1		;GUESSED RIGHT?
	RET			;YES, DONE
	MOVE T2,T3		;NOPE, GET CONTROLLER NUMBER
	HRRZ T3,UDBSLV(P3)	;AND UNIT OF IT
	RET			;NOW DONE
;ALLOCATORS FOR USE DURING INITIALIZATION ONLY

;ALLOCATE RESIDENT STORAGE
;T1/ LENGTH OF BLOCK IN WORDS, ASSUMED LESS THAN PGSIZ
;	CALL PHYALC
;RETURNS+1:	ON FAILURE,
;RETRUNS+2:	SUCCESS,
;T1/ ADDRESS OF START OF BLOCK
;PRESERVES T3,T4

PHYALC::JUMPLE T1,INIERR	;CHECK ARG
	PUSH P,T3		;PRESERVE REGS
	PUSH P,T4		; ...
	HRLI T1,.RESP1		;PRIORITY
	MOVEI T2,.RESGP		;GENERAL CLASS
	CALL ASGRES		;GET STG
	JRST [ BUG(PHYICE)
		   SOS -2(P)
		   JRST .+1]
	POP P,T4		;RESTORE REGS
	POP P,T3		; ...
	RETSKP

;ALLOCATE RESIDENT PAGE 0 STORAGE (DISPATCH VECTORS, ETC.)
;T1/ ALIGNMENT,,LENGTH
;	CALL PHYALZ
;RETURNS+1:	ALWAYS,
;T1/ ADDRESS OF START OF BLOCK, A MULTIPLE OF LH(T1) ON CALL.
;	SPECIFYING A ZERO ALIGNMENT IS EQUIVALENT TO AN ALIGNMENT OF 1

PHYALZ::JUMPLE T1,INIERR	;ILLEGAL ARGUMENT
	HLRZ T4,T1		;SAVE ALIGNMENT
	SKIPN T4		;ZERO SPECIFIED?
	MOVEI T4,1		;YES - USE 1
	HRRZ T3,T1		;SAVE LENGTH
	MOVE T1,ZSEND		;GET CURRENT FREE BOUNDRY
	IDIV T1,T4		;GET BOUNDRY MOD C(T4)
	MOVE T1,T4		;COMPUTE ALIGN-(ZSEND MOD ALIGN)
	SUB T1,T2		; ...
	SKIPE T2		;IF ALREADY ALIGNED, SKIP IT.
	ADDM T1,ZSEND		;ALIGN ZSEND
	MOVE T1,ZSEND		;RETURN START OF BLOCK
	ADDB T3,ZSEND		;UPDATE BOUNDRY
	SUBI T3,PHYPZS		;SEE IF OVERFLOW
	CAILE T3,PZSSIZ		; ...
	BUG(PHYP0E)
	RET

;HERE WHEN GIVEN AN ILLEGAL ARGUMENT TO ALC OR ALZ

INIERR:	BUG(PHYICA)
;RESTART ENTRY
;ENTERED WITH PI OFF, STACK IN P, ALL ACCUMULATORS FREE.

PHYRST::MOVSI Q3,-CHNN		;BUILD AOBJN POINTER
RST1:	SKIPN P1,CHNTAB(Q3)	;CHANNEL PRESENT?
	JRST RST2		;NO
	PUSH P,Q3		;SAVE CHANNEL COUNTER
	CALL DGUMAP		;FOR ALL UNITS ON THIS CHANNEL
	 CALL ABTREQ		;ABORT REQUESTS
	POP P,Q3		;RESTORE CHANNEL COUNTER
	MOVX T1,CS.ACT!CS.MAI!CS.ERC	;CLEAR STATE BITS
	ANDCAM T1,CDBSTS(P1)	; ...
	MOVEI T1,1		;INDICATE FULL RESET
	HRRZ T2,CDBDSP(P1)	;GET CHANNEL DISPATCH
	CALL CDSRST(T2)		;RESET HARDWARE
RST2:	AOBJN Q3,RST1		;LOOP FOR ALL CHANNELS
	CALL MTCLVA		;CLEAR ALL VALID VOLUME BITS FOR MT'S
	RET

;HERE TO ABORT THE REQUESTS ON A PARTICULAR UNIT

ABTREQ:	HRRZ P4,UDBTWQ(P3)	;ANY TRANSFER REQUESTS?
	JUMPE P4,ABT1		;NO MORE
	CALL OFFTWQ		;PULL FROM TWQ
	CALL ABT3		;POST DONE IF NEEDED
	JRST ABTREQ		;LOOP FOR MORE

ABT1:	HRRZ P4,UDBPWQ(P3)	;ANY POSITION REQUEST?
	JUMPE P4,ABT2		;NO MORE
	CALL OFFPWQ		;REMOVE FROM PWQ
	CALL ABT3		;AND POST COMPLETE IF NEEDED
	JRST ABT1		;LOOP FOR MORE

ABT2:	MOVX T1,US.BLK!US.REW!US.OIR!US.OMS	;THINGS TO RESET ABOVE
	ANDCAM T1,UDBSTS(P3)	;WHAT CLRACT RESETS
	MOVX T1,US.PSI		;SET PSI REQUEST
	IORM T1,UDBSTS(P3)
	CALL CLRACT		;RESET UDB
	RET

ABT3:	MOVX T1,IS.SHT		;PAGEM REQUEST?
	TDNE T1,IRBSTS(P4)	;?
	RET			;YES, IGNORE
	MOVX T1,IS.ERR!IS.NRT	;INDICATE ERROR
	IORM T1,IRBSTS(P4)	; ..
	CALL DONIRB		;POST COMPLETE
	RET			;DONE WITH THIS REQUEST
;ONLINE ENTRY - ENTERED ON THE ONLINE INTERRUPT OF A UNIT

PHYONL::MOVX T1,US.OFS		;CLEAR OFFLINE AND UNSAFE BITS
	ANDCAM T1,UDBSTS(P3)	; ...
	MOVX T1,US.PSI		;SET PSI REQUEST
	IORM T1,UDBSTS(P3)
	RET


;OFFLINE ENTRY - ENTERED ON THE OFFLINE INTERRUPT OF A UNIT

PHYOFL::MOVX T1,US.PSI!US.OFS	;GET OFFLINE AND PSI FLAGS
	IORB T1,UDBSTS(P3)	;STORE THEM AND GET OTHER BITS
	TXNN T1,US.TAP		;IS THIS A TAPE?
	RET			;NO, RETURN
	CALLRET MTCLVL		;CLEAR VALID VOLUME FOR THIS TAPE


;HERE ON REWIND DONE.

PHYRWD::SAVEQ			;SAVE ALL Q'S
	MOVX T1,US.REW		;NO LONGER REWINDING
	ANDCAM T1,UDBSTS(P3)	; ...
	MOVX T1,US.PSI		;SET POSSIBLE PSI FOR REWIND DONE
	IORM T1,UDBSTS(P3)
	IOPIOF			; INTERLOCKED
	CALL SCHSEK		;START ANY POSITION OPS
	MOVX T1,CS.ACT!CS.ERC	;GET FLAGS READY
	TDNN T1,CDBSTS(P1)	;CHANNEL ACTIVE?
	CALL SCHXFR		;NO, START CHANNEL
	JRST ONRET		;AND RETURN
;HERE WHEN THE INTERRUPTING DEVICE HAS BEEN DETERMINED
;ENTERED WITH CDB IN P1, P1 SAVED IN CDBSVQ


PHYINT::MOVEM 17,PHYACS+17	;SAVE HIGH ACCUMULATOR
	MOVEI 17,PHYACS		;SETUP BLT POINTER
	BLT 17,PHYACS+16	;SAVE REMAINING ACCUMULATORS
	MOVE T1,CDBSVQ(P1)	;COPY P1 FROM WHERE SAVED
	MOVEM T1,PHYACS+P1	;STORE WITH REST
	MOVE P,[IOWD LPHIPD,PHYIPD] ;GET INTERRUPT PDL
	HRRZ T1,CDBDSP(P1)	;GET CHANNEL DISPATCH
;NOTE THAT INTERRUPT ROUTINES DO NOT PRESERVE P OR Q ACCUMULATORS TO SAVE TIME
	CALL CDSINT(T1)		;PASS INTERRUPT DOWNWARD
	 JRST [	MOVX T1,CS.AC2	;AN ERROR WAS DETECTED, SHUT DOWN
		ANDCAM T1,CDBSTS(P1) ;STACKED COMMAND
		JRST .+1]
	JUMPE P4,XINT		;REQUEST TO DISMISS
	JUMPL P4,[ MOVX T1,CS.ERC	;REQUEST FOR SCHEDULE CYCLE,
		TDNN T1,CDBSTS(P1) ;IS CHANNEL IN ERR RECOV?
		JRST INT1	;NO - HONOR REQUEST
		JRST XINT]	;YES - SCHED AT END OF ERR RECOV
	HLL P3,UDBSTS(P3)	;SET UP LEFT HALF FOR SOME TESTS
	HRRZ T1,UDBTWQ(P3)	;CHECK IF THIS IS THE
	TXNE P3,US.POS		;IORB WE EXPECTED
	HRRZ T1,UDBPWQ(P3)	;FROM EITHER QUEUE
	CAIE T1,(P4)		;??
	BUG(ILTWQ)		;NO.
	SKIPE UDBERR(P3)	;ERROR RECOVERY IN PROGRESS?
	JRST INTERR		;YES - MUST CALL LOWER LEVEL IN ALL CASES
	MOVE T1,IRBSTS(P4)	;YES - ANY ERROR INDICATION?
	TXNN T1,IS.ERR!IS.WGU!IS.DTE!IS.DVE!IS.RTL	;??
	JRST INTDON
INTERR:	SKIPN T1,UDBERP(P3)	;ERRORS - ERROR BLOCK SETUP?
	JRST [	MOVX T1,CS.ERC	;NO, SET ERROR RECOVERY ON CHANNEL
		TXNN P3,US.POS	;TRANSFER?
		IORM T1,CDBSTS(P1) ;YES
		CALL ERRSET	;CREATE ERROR BLOCK
		JRST .+1]	;CONTINUE
	MOVEM T1,UDBERP(P3)	;STORE IN UDB
	MOVE T1,UDBDSP(P3)	;GET UNIT DISPATCH
	CALL UDSERR(T1)		;INVOKE ERROR RETRY
	 JRST XINT		;NON SKIP - RETRY IN PROGRESS
				;SKIP - DONE WITH RECOVERY, FOR GOOD OR ILL
	MOVX T1,CS.ERC		;SETUP TO CLEAR ERROR RECOVERY FLAG
	TXNN P3,US.POS		;TRANSFER?
	ANDCAM T1,CDBSTS(P1)	;YES - CLEAR FLAG
INTDON:	TXNE P3,US.POS		;TAKE REQUEST OUT OF QUEUE
	JRST INT2		;HANDLE TERMINATION IN POSITIONING
	MOVX T1,CS.AC2		;IS THIS A STACKED COMMAND
	TDNE T1,CDBSTS(P1)	; ??
	JRST INT3		;YES
	CALL OFFTWQ		;PULL FROM TWQ
	CALL CLRACT		;NO LONGER ACTIVE
	CALL DONIRB		;POST IORB AS DONE
	SKIPE PWRDWN		;POWER FAILING?
	JRST XINT		;YES - DISMISS
INT1:	CALL SCHSEK		;SCHEDULE SEEKS (IF NEEDED)
	CALL SCHXFR		;SCHEDULE TRANSFERS
XINT:	MOVSI P,PHYACS		;RESTORE BLT POINTER
	JRST CDBJEN(P1)		;RESTORE ACCUMULATORS AND DISMISS

;HERE WHEN AN IORB TERMINATES ON THE PWQ

INT2:	CALL OFFPWQ		;PULL FROM QUEUE
	CALL CLRPOS		;NO LONGER POSITIONING
	CALL DONIRB		;POST DONE
	CALL SCHSEK		;SEE IF MORE TO DO
	SKIPE PWRDWN		;POWER FAILING?
	JRST XINT		;YES, DON'T START NEW I/O
	MOVE T1,CDBSTS(P1)	;GET CHANNEL STATUS
	TXNN T1,CS.ACT!CS.ERC!CS.OFL	;CHANNEL AVAILABLE?
	CALL SCHXFR		;NO, SEE IF ANY WORK TO DO
	JRST XINT		;THEN EXIT

;HERE AT THE TERMINATION OF A STACKED TRANSFER

INT3:	ANDCAM T1,CDBSTS(P1)	;CLEAR SECOND COMMAND ACTIVE
	CALL OFFTWQ		;PULL FROM TWQ
	CALL DONIRB		;POST DONE
	SKIPN PWRDWN		;POWER FAILING?
	CALL SCHXFR		;NO - SEE IF MORE WORK TO DO
	JRST XINT		;AND DISMISS
;HERE TO POST AN IORB COMPLETE
;P4/ IORB
;	CALL DONIRB
;RETURNS+1(ALWAYS)


DONIRB:	MOVX T1,IS.DON		;FLAG DONE
	MOVX T2,IS.WGU!IS.TPM!IS.EOT!IS.DTE!IS.DVE!IS.BOT!IS.RTL
	TDNE T2,IRBSTS(P4)	;ANY ERRORS?
	TXO T1,IS.ERR		;YES, SET GENERAL ERROR BIT
	IORM T1,IRBSTS(P4)	; ...
	CALL ERRFIN		;TERMINATE ERROR RECOVERY IF NEEDED
	SKIPL IRBSTS(P4)	;SHORT IORB?
	JRST DONIR1		;NO - CALL SPECIFIED ADDRESS
	MOVEI T1,-CST5(P4)	;GET CPN
	MOVX T2,IS.WGU!IS.DTE!IS.DVE!IS.RTL	;IF ANY OF THESE ERRORS
	MOVX T3,SWPERR		;NOTIFY PAGEM
	TDNE T2,IRBSTS(P4)	; CHECK.
	IORM T3,CST3(T1)	;ERRORS - INDICATE TO PAGEM.
	PUSH P,P1		;SAVE REGISTERS
	PUSH P,P3		; ...
	CALL SWPDON		;NOTIFY PAGEM
	POP P,P3		;RESTORE REGISTERS
	POP P,P1		; ..
	RET


;HERE ON COMPLETION OF A LONG IORB

DONIR1:	HRRZ T2,IRBIVA(P4)	;GET CALLERS INTERRUPT ADDRESS
	JUMPE T2,DONIR2		;IS THERE AN INTERRUPT ROUTINE?
	MOVE T1,P4		;COPY IORB FOR CALL
	CALL (T2)		;CALL
	RET

DONIR2:	BUG(PHYNIR)
	RET
	SUBTTL START IO


;HERE TO ENQUEUE AN IO REQUEST.
;  T1/	IORB
;  T2/	UDB (FOR LONG IORB ONLY)
;	CALL PHYSIO
;RETURNS+1:(ALWAYS)
;	IO REQUEST MADE. IF UNIT IS OFFLINE, A MESSAGE TO THE
;	OPERATOR WILL BE PRINTED. IF THE CALL IS IN ANY WAY
;	INVALID (NONEXISTANT UNIT, BAD ADDRESS, ETC.) A BUGHLT WILL OCCUR
;	THE CALLING ROUTINE IS ASSUMED TO HAVE MADE THOSE CHECKS
;	AND PASSED.
;	**NOTE** NOSKED IS ASSUMED, AS A PRIVATE STACK IS USED

PHYSIO::MOVEM P,PHYSVP		;SAVE CALLERS STACK
	MOVE P,[IOWD LPHYPD,PHYPDL] ;LOCAL STACK
	SE0ENT
	CALL SIO1		;DO THE REAL WORK
	MOVE P,PHYSVP		;RESTORE CALLERS STACK
	SE1CAL			;ENTER SECTION 1 BEFORE RETURN
	RET

;DETERMINE CHANNEL/CONTROLLER/UNIT FOR THIS IORB

SIO1:	SAVEPQ			;SAVE CALLERS REGISTERS ON LOCAL STACK
	HRRZ P4,T1		;SET UP IORB POINTER
	HRRZ P3,T2		;ALSO SET UP UDB ADDRESS (IN CASE IORB IS LONG)
	SKIPL IRBSTS(P4)	;SHORT IORB?
	JRST SIO2		;NO, UDB ADDRESS ALREADY SET UP
	CALL GETCUB		;YES, COMPUTE UDB FROM PAGEM ADDRESS
	 BUG(ILPDAR)
				;T1 HAS UNIT ADDRESS (LINEAR)
	MOVEI T2,-CST5(P4)	;GET CORE PAGE NUMBER
	STOR T1,CSTLDA,(T2)	;STORE UNIT RELATIVE ADDRESS
SIO2:	HRRZ P1,UDBCDB(P3)	;SET UP CDB ADDRESS
	HRRZ P2,UDBKDB(P3)	;ALSO SET UP KDB ADDRESS OR ZERO IF NONE
	HRRZ T2,UDBDSP(P3)	;GET UNIT DISPATCH BASE
	IOPIOF			;TURN PHYSIO CHANNELS OFF
	HLL P3,UDBSTS(P3)	;GET LEFT HALF STATUS OF UNIT
	TXNE P3,US.POS		;IS POSITION IN PROGRESS?
	JRST SIO3		;YES - APPEND TO PWQ
	TXNE P3,US.TAP		;IS THIS A TAPELIKE DEVICE?
	JRST SIO6		;YES - SEE IF POSITIONING TO DO
	TXNN P3,US.PRQ		;DOES THIS UNIT POSITION?
	JRST SIO4		;NO - APPEND TO TWQ
	CALL UDSCNV(T2)		;YES - GET CYLINDER (PS1) IN T2
SIO2DL::CAME T2,UDBPS1(P3)	;SAME AS CURRENT UDBPS1? (TAG FOR DLLOOK)
	JRST SIO3		;NO - POSITIONING NEEDED
	SOSLE UDBFCT(P3)	;YES - SHOULD WE DO SOME OTHER CYL?
	JRST SIO4		;NO - ADD REQUEST TO TWQ
	HRRZ T1,UDBPWQ(P3)	;COUNT EXHAUSTED, REQUESTS TO OTHER CYLS?
	JUMPE T1,SIO4		;IF NO, APPEND TO TWQ ANYWAY
SIO3:	MOVE T1,P4		;PLACE ON PWQ
	CALL ONPWQ		; ...
	MOVX T1,US.OIR!US.OMS!US.POS!US.ACT!US.MAI!US.MRQ!US.REW!US.CHB
	MOVX T2,CS.MAI!CS.MRQ!CS.OFL	;GET FLAGS READY
	TDNN T1,UDBSTS(P3)	;UNIT AVAILABLE?
	TDNE T2,CDBSTS(P1)	;AND CHANNEL AVAILABLE?
	JRST ONRET		;NO, DO NOTHING
	MOVX T1,KS.ACT		;GET CONTROLLER BUSY FLAG
	TRNE P2,-1		;IS THERE A CONTROLLER?
	TDNN T1,KDBSTS(P2)	; ...
	SKIPA			;(NO,NO)
	JRST ONRET		;(YES,YES)
	HRRZ T1,UDBTWQ(P3)	;ARE THERE ANY TRANSFER PENDING ON CYLINDER?
	JUMPN T1,ONRET		;IF SO, DONT MOVE UNIT
	CALL STRTPS		;UNIT FREE - START POSITIONING
	 JFCL			;COULDNT DO IT, BUT NOTHING ELSE TO DO
	JRST ONRET		;ENABLE PI AND RETURN
;HERE WHEN REQUEST NEEDS NO POSITIONING

SIO4:	MOVE T1,P4		;PLACE ON TWQ
	CALL ONTWQ		; ...
	SKIPE PWRDWN		;POWER FAILING?
	JRST ONRET		;YES - DONT STARTUP A NEW REQUEST
	MOVE T1,CDBSTS(P1)	;GET CURRENT CHANNEL STATUS
	MOVE T2,UDBSTS(P3)	;AND UNIT STATUS
	TXNN T1,CS.OFL!CS.AC2!CS.MAI!CS.MRQ	;CHANNEL AVAILABLE?
	TXNE T2,US.POS!US.REW!US.OIR!US.OMS!US.MAI!US.MRQ!US.CHB ;UNIT TOO?
	JRST ONRET		;NO.
	TXNN T1,CS.AC1		;PRIMARY COMMAND ACTIVE?
	JRST SIO5		;NO - SEE IF UNIT REALLY FREE
	TXNN T2,US.DSK		;IS THIS A DISK?
	JRST ONRET		;NO, DON'T STACK FOR MAGTAPES
	MOVE T1,CDBXFR(P1)	;IS THIS THE ACTIVE UNIT?
	CAMN T1,UDBADR(P3)	; ???
	CALL SCHXFR		;YES, SEE IF WE CAN STACK ANOTHER COMMAND
	JRST ONRET

SIO5:	MOVX T1,US.ACT		;GET ACTIVE BIT FOR UNIT
	MOVX T2,KS.ACT		;AND FOR THE CONTROLLER
	TRNE P2,-1		;CHECK FOR EXISTANCE OF CONTROLLER
	TDNN T2,KDBSTS(P2)	;CONTROLLER BUSY?
	TDNE T1,UDBSTS(P3)	;OR THE UNIT?
	JRST ONRET		;YES, DO NOTHING
	CALL STRTIO		;STARTUP THIS IORB
	 JFCL			;CANT START IT, BUT NOTHING ELSE TO DO.
	JRST ONRET		;RESTORE PI

;HERE TO SEE IF REQUEST SHOULD GO THROUGH POSITION CYCLE

SIO6:	CALL UDSPRQ(T2)		;ASK DEVICE
	 JRST SIO4		;TRANSFER ONLY
	JRST SIO3		;POSITION FIRST
	SUBTTL POSITION DONE
;POSITION DONE - TRANSFER ALL REQUESTS FOR THIS CYLINDER FROM PWQ TO TWQ
;CALLED ONLY AT INTERRUPT LEVEL
;P1/ CDB, P3/ UDB, USES P4


PHYSDN::CALL CLRSRC		;UNIT NO LONGER SEARCHING
	SKIPA			;SKIP
PHYPDN::CALL CLRPOS		;UNIT NO LONGER POSITIONING
	HRRZ P4,UDBPWQ(P3)	;GET HEAD OF PWQ
	CALL ERRFIN		;RETURN ERROR BLOCK IF ONE ACTIVE
	SAVEQ
	MOVEI T1,INIFCP		;RESET FAIRNESS COUNT FOR POSITIONING
	MOVEM T1,UDBFCT(P3)	; ...
	MOVEI Q1,UDBPWQ(P3)	;PREVIOUS IORB IS INITIALLY HEAD CELL
	HRRZ Q2,UDBDSP(P3)	;GET UNIT DISPATCH
	SKIPN P4		;WAS PWQ NULL?
	JRST PDN4		;YES - COMPLAIN THEN EXIT
PDN1:	CALL UDSCNV(Q2)		;GET CYLINDER FOR IORB IN P4
	CAME T2,UDBPS1(P3)	;SAME AS CURRENT CYLINDER?
	JRST PDN3		;NO - KEEP LOOKING
	MOVE T1,Q1		;PREDECESSOR
	MOVE T2,P4		;CURRENT IORB
	CALL CONSPW		;REMOVE CURRENT, SPLICE PWQ
	MOVE T1,P4		;APPEND CURRENT TO TWQ
	CALL ONTWQ		; ...
PDN2:	HRRZ P4,IRBLNK(Q1)	;GET NEW CURRENT IORB
	JUMPN P4,PDN1		;IF NOT AT END, KEEP LOOKING
	HRRZ T1,UDBTWQ(P3)	;CHECK SOME REQUEST WAS FOUND
	SKIPN T1		; ??
	BUG(NRFTCL)
	RET			;YES - ALL IS WELL

PDN3:	MOVE Q1,P4		;MOVE DOWN THE LIST
	JRST PDN2		;AND CONTINUE

PDN4:	BUG(NPWQPD)
	RET			;JUST EXIT
	SUBTTL UTILITIES

;ENTER WITH 
;T1/ UNIT NUMBER
;P1/ CDB
;	CALL SETUDB
;RETURNS+1(ALWAYS):
;P2/ KDB (IF APPROPRIATE)
;P3/ UDB CORRESPONDING TO SPECIFIED UNIT # ON CHANNEL
;  NOTE: IN THE CASE OF THE TM02, THE KDB WILL BE IN BOTH P2&P3
;T1/ UNCHANGED
;T2/ DISPATCH FOR CORRESPONDING UNIT TYPE

SETUDB::MOVE T2,CDBIUN(P1)	;GET UDB TABLE POINTER
	HLRE T3,T2		;SEE IF LEGAL NUMBER
	MOVNS T3		;AS POSITIVE NUMBER
	CAIL T1,(T3)		;LEGAL?
	BUG(PYILUN)
	ADD T2,T1		;GET UDB
	SKIPN P3,(T2)		; ...
	JRST SETUD2		;NONE PRESENT
	LDB T2,USYBKT		;GET BLOCK TYPE
	CAIE T2,.BTUDB		;UDB?
	JRST SETUD1		;NO
	MOVE P2,UDBKDB(P3)	;GET KDB IF ANY
	HRRZ T2,UDBDSP(P3)	;RETURN DISPATCH
	RET

SETUD1:	MOVE P2,P3		;COPY KDB
	HRRZ T2,KDBDSP(P2)	;AND RETURN DISPATCH
	RET

SETUD2:	SETZB P2,P3		;RETURN 0
	RET

;UTILITY TO RETURN THE ACTIVE IORB ON A UNIT
;P3/ UDB
;	CALL SETIRB
;RETURNS+1(ALWAYS):
;P4/ ACTIVE IORB
;PRESERVES T1


SETIRB::HRRZ P4,UDBPWQ(P3)	;ASSUME POSITIONING
	MOVX T2,US.POS		;IS UNIT REALLY POSITIONING?
	TDNN T2,UDBSTS(P3)	; ???
	HRRZ P4,UDBTWQ(P3)	;NO - GET HEAD OF TWQ
	JUMPN P4,R		;RETURN IF THERE REALLY WAS ONE
	BUG(NOIORB)
;DETERMINE THE UNIT RELATIVE ADDRESS FOR A DISK REQUEST

;P4/ IORB
;	CALL PHYBLK
;RETURNS+1(ALWAYS):
;T2/ UNIT RELATIVE ADDRESS
;CLOBBERS T1,T2

PHYBLK::SKIPL IRBSTS(P4)	;SHORT IORB?
	JRST BLK1		;NO
	MOVEI T2,-CST5(P4)	;YES - GET CPN
	LOAD T2,CSTLDA,(T2)	;GET UNIT RELATIVE ADDRESS
	RET

BLK1:	MOVE T2,IRBADR(P4)	;GET UNIT RELATIVE ADDRESS
	RET
;DETERMINE CORRECT CHANNEL AND UNIT FROM A DISK REQUEST

;P4/ IORB
;T4/ STRUCTURE NUMBER IF NOT FROM PAGEM
;	CALL GETCUB
;PRESERVES T2,3,4
;RETURNS+1:
;ERROR - INVALID ADDRESS
;RETURNS+2:
;T1/ UNIT RELATIVE ADDRESS
;P1/ CDB
;P2/ KDB, OR 0 IF NONE
;P3/ UDB

GETCUB:	SAVEQ			;PRESERVE ACCUMULATORS
	SKIPGE IRBSTS(P4)	;SHORT FORM IORB?
	JRST GTCUB5		;YES - GET CST1
	MOVE Q2,IRBADR(P4)	;NO - GET IORB ADDRESS
	MOVEI Q1,0(T4)		;SAVE STRUCTURE NUMBER
GTCUB1:	SKIPN Q1,STRTAB(Q1)	;ANY SUCH STRUCTURE?
	RET			;ILLEGAL STRUCTURE
	TXNN Q2,DSKAB		;DISK ADDRESS?
	JRST GTCUB3		;NO - SWAP ADDRESS
	TLZ Q2,DSKMSK		;CLEAR UNUSED BITS
	IDIV Q2,SDBSIZ(Q1)	;GET UNIT, RELATIVE ADDRESS
	CAML Q2,SDBNUM(Q1)	;LEGAL UNIT?
	RET			;UNIT TOO LARGE
GTCUB2:	ADDI Q2,SDBUDB(Q1)	;GET UDB ADDRESS
	MOVE P3,(Q2)		; ...
	HRRZ P1,UDBCDB(P3)	;FOLLOW BACK POINTER TO CDB
GTCUBX:	HRRZ P2,UDBKDB(P3)	;AND FOLLOW POINTER TO KDB
	MOVE T1,Q3		;UNIT RELATIVE ADDRESS
	RETSKP			;SUCCESS RETURN

;HERE IF SWAPPING ADDRESS

GTCUB3:	TXNN Q2,DRMOB		;REAL DRUM ADDRESS?
	JRST GTCUB4		;YES
	TLZ Q2,-1		;NO - CLEAR UNUSED BITS ***SYMBOL***
	MOVE T1,SDBTYP(Q1)	;GET TYPE OF THIS DEVICE
	IDIV Q2,SECCYL(T1)	;GET TRACK(CYLINDER), SECTOR IN TRACK
	MOVE P3,Q3		;SAVE SECTOR WITHIN TRACK
	IDIV Q2,SDBNUM(Q1)	;GET UNIT RELATIVE TRACK, UNIT
	EXCH Q2,Q3		;PUT UNIT IN Q2
	IMUL Q3,SECCYL(T1)	;GET SECTOR STARTING TRACK ON UNIT
	ADD Q3,P3		;ADD SECTOR WITHIN TRACK
	CAML Q3,SDBNSS(Q1)	;CHECK WITHIN LIMIT
	RET			;SWAPPING ADDRESS TOO LARGE
	ADD Q3,SDBFSS(Q1)	;SWAP AREA OFFSET
	JRST GTCUB2		;JOIN OTHER CODE
;HERE IF REAL DRUM ADDRESS

GTCUB4:	LOAD Q1,DRTRK,Q2	;GET TRACK
	LOAD Q2,DRSEC,Q2	;GET SECTOR
	IMULI Q1,DRMSEC		;GET SECTORS
	ADD Q2,Q1		;INTO Q2
	IDIVI Q2,NTRK*DRMSEC	;GET UNIT AND RELATIVE ADDRESS
	HLRZ P1,DRMTAB(Q2)	;GET CDB
	HRRZ P3,DRMTAB(Q2)	;GET UDB
	JRST GTCUBX

;HERE ON A PAGEM REQUEST

GTCUB5:	MOVEI Q2,-CST5(P4)	;GET CPN
	MOVE Q1,CST2(Q2)	;GET OWNER IDENT
	CAIL Q1,NOFN		;FILE?
	JRST GTCB5A		;NO
	MOVX T1,OFN2XB		;SECOND XB
	TDNN T1,SPTH(Q1)	; ??
	JRST GTCB5A		;NO
	LDB T1,IRYFCN		;GET OPERATION
	CAIN T1,IRFRED		;READ?
	AOSA XB2RED		;YES
	AOS XB2WRT		;NO - WRITE

GTCB5A:	MOVE Q2,CST1(Q2)	;GET DISK ADDRESS
	SETZ Q1,		;ASSUME STRUCTURE 0
	TXNN Q2,DSKAB		;IS THIS A DISK REQUEST?
	JRST GTCUB1		;NO. GO DO SWAPPING REQUEST
	MOVEI T1,-CST5(P4)	;GET CORE PAGE NUMBER
	CALL FNDSTR		;GO GET STRUCTURE NUMBER FROM PAGEM
	MOVEI Q1,0(B)		;PUT IT IN THE RIGHT PLACE
	JRST GTCUB1		;JOIN OTHER PROCESSING
;HERE TO GET THE IOLIST ASSOCIATED WITH AN IORB

;P4/ IORB
;P1/ CDB
;P3/ UDB
;CALL PHYXFL
;RETURNS+1(ALWAYS):
;T1/ POINTER TO TRANSFER LIST
;T2/ POINTER TO END OF TRANSFER LIST


PHYXFL::SKIPL IRBSTS(P4)	;SHORT IORB?
	JRST XFL1		;NO - HAS OWN POINTER
	MOVE T1,[IRMWRD,,PGSIZ]	;WORD MODE, ONE PAGE
	MOVEI T2,-CST5(P4)	;GET CPN
	LSH T2,PGSFT		;AS ADDRESS
	HRRZ T4,CDBDSP(P1)	;GET CHANNEL DISPATCH
	CALL CDSCCW(T4)		;FORM CCW FOR THIS CHANNEL
	MOVEI T2,CDBCCL(P1)	;COMPUTE LIST TO USE, ASSUME PRIMARY
	HLL P1,CDBSTS(P1)	;GET CHAN STATUS
	TXNE P1,CS.ACL		;USE ALTERNATE?
	MOVEI T2,CDBCL2(P1)	;YES
	MOVEM T1,(T2)		;STORE IN CDB
	SETZM 1(T2)		;MARK END WITH ZERO
	MOVE T1,T2		;RETURN ADDRESS
	ADDI T2,1		;ADDRESS OF END
	RET

;HERE ON LONG FORM IORB

XFL1:	HRRZ T1,IRBXFL(P4)	;GET USERS TRANSFER LIST
	HLRZ T2,IRBXFL(P4)	;GET TAIL OF USERS LIST
	RET

;HERE TO GET THE BYTE COUNT ASSOCIATED WITH AN IORB

;P4/ IORB
;	CALL PHYCNT
;RETURNS+1(ALWAYS):
;T1/ BYTE COUNT
;PRESERVES T3,T4

PHYCNT::SKIPL IRBSTS(P4)	;SHORT IORB?
	SKIPA T1,IRBCNT(P4)	;NO, GET COUNT FROM IORB
	MOVEI T1,PGSIZ		;YES - ALL ONE SIZE
	RET
;UTILITY TO APPEND TO TWQ
;T1/ IORB
;	CALL ONTWQ
;RETURNS+1(ALWAYS):
;T1/ UNCHANGED

ONTWQ:	HLRZ T2,UDBTWQ(P3)	;GET TAIL OF TWQ
	HRRZ T3,IRBLNK(T2)	;INSURE TAIL REALLY WAS TAIL
	JUMPN T3,IRBERR		;NOT TAIL - BOMB
	HRRM T1,IRBLNK(T2)	;STORE NEW TAIL
	HRLM T1,UDBTWQ(P3)	; ...
	RET

;HERE TO PLACE AN IORB AT THE FRONT OF THE TWQ
;T1/ IORB
;P3/ UDB
;	CALL ONFTWQ
;RETURNS+1(ALWAYS):
;	IORB AT HEAD OF TWQ

ONFTWQ:	HRRZ T2,IRBLNK(T1)	;CHECK LINK OF NEW IORB IS NULL
	JUMPN T2,IRBNNT		;IF NOT NULL, DIE PROMPTLY
	HRRZ T2,UDBTWQ(P3)	;GET CURRENT HEAD OF TWQ
	HRRM T2,IRBLNK(T1)	;POINT LINK OF NEW IORB AT IT
	HRRM T1,UDBTWQ(P3)	;NEW IORB IS NEW HEAD OF LIST
	JUMPN T2,R		;WAS TWQ NON NULL?
	HLRZ T3,UDBTWQ(P3)	;WAS NULL
	CAIE T3,UDBTWQ(P3)	;CHECK TAIL WAS FOR NULL LIST
	JRST IRBERR		;POINTER WAS BAD
	HRLM T1,UDBTWQ(P3)	;STORE NEW IORB AS NEW TAIL
	RET

IRBNNT:	BUG(ILRBLT)

;HERE TO PLACE AN IORB AS THE SECOND ELEMENT ON A UNITS TWQ
;ASSUMES THE FIRST ELEMENT EXISTS
;T1/ IORB
;	CALL ONSTWQ
;RETURNS+1(ALWAYS):
;	IORB SECOND ON TWQ
;T1/ UNCHANGED

ONSTWQ:	HRRZ T2,IRBLNK(T1)	;CHECK LINK OF IORB IS NULL
	JUMPN T2,IRBNNT		;IF NOT NULL, WE HAVE TROUBLE
	HRRZ T2,UDBTWQ(P3)	;GET CURRENT HEAD OF TWQ
	HRRZ T3,IRBLNK(T2)	;GET CURRENT SECOND ELEMENT
	HRRM T1,IRBLNK(T2)	;THIS IORB IS NOW SECOND
	HRRM T3,IRBLNK(T1)	;OLD SECOND IS NOW SUCCESSOR
	JUMPN T3,R		;IF SUCCESSOR NONNULL, DONE
	HRLM T1,UDBTWQ(P3)	;SUCCESSOR NULL, NEW IORB IS TAIL
	RET			;DONE
;APPEND TO PWQ
;T1/ IORB
;P3/ UDB
;	CALL ONPWQ
;RETURNS+1(ALWAYS):

ONPWQ:	HLRZ T2,UDBPWQ(P3)	;GET TAIL POINTER
	HRRZ T3,IRBLNK(T2)	;CHECK IT REALLY WAS THE TAIL
	JUMPN T3,IRBERR		;NO - BOMB
	HRRM T1,IRBLNK(T2)	;POINT TO NEW TAIL
	HRLM T1,UDBPWQ(P3)	; ...
	RET

;HERE IF THE CURRENT TAIL OF TWQ/PWQ HAS A NON ZERO FORWARD POINTER

IRBERR:	BUG(ILTWQP)

;HERE TO PLACE AN IORB AT THE FRONT OF THE PWQ
;T1/ IORB
;P3/ UDB
;	CALL ONFPWQ
;RETURNS+1(ALWAYS):
;	IORB AT HEAD OF PWQ

ONFPWQ:	HRRZ T2,IRBLNK(T1)	;CHECK LINK OF NEW IORB IS NULL
	JUMPN T2,IRBNNL		;IT IS NOT NULL, LOSE BIG
	HRRZ T2,UDBPWQ(P3)	;GET CURRENT HEAD OF PWQ
	HRRM T2,IRBLNK(T1)	;POINT LINK OF NEW IORB AT IT
	HRRM T1,UDBPWQ(P3)	;NEW IORB IS NEW HEAD OF LIST
	JUMPN T2,R		;WAS PWQ NON NULL?
	HLRZ T3,UDBPWQ(P3)	;WAS NULL, CHECK TAIL POINTER
	CAIE T3,UDBPWQ(P3)	;CORRECT NULL LIST?
	JRST IRBERR		;NO
	HRLM T1,UDBPWQ(P3)	;YES - NEW HEAD IS ALSO NEW TAIL
	RET

IRBNNL:	BUG(ILIRBL)
;HERE TO REMOVE AN ARBITRARY ELEMENT FROM THE TWQ
;T1/ PREDECESSOR OF ELEMENT TO BE REMOVED
;T2/ ELEMENT TO BE REMOVED
;	CALL CONSTW
;RETURNS+1(ALWAYS):
;	ELEMENT REMOVED
;**SEE NOTE AT START OF CONSPW**

CONSTW:	JUMPE T1,CNSTWE		;CHECK ARGUMENTS
	JUMPE T2,CNSTWE		; ...
	HRRZ T3,IRBLNK(T1)	;CHECK FOR REMOVAL OF EXACTLY ONE ELEMENT
	CAME T2,T3		; ...
	JRST CNSTWE		;MULTIPLE ELEMENTS, CURRENTLY ILLEGAL
	HRRZ T3,IRBLNK(T2)	;GET HEAD OF RIGHT RESIDUE LIST
	HLRZ T4,UDBTWQ(P3)	;GET TAIL OF TWQ
	CAME T4,T2		;IS TAIL OF LIST BEING REMOVED?
	JRST CNSTW1		;NO
	JUMPN T3,IRBERR		;YES - INSURE RIGHT RESIDUE REALLY NULL
	HRLM T1,UDBTWQ(P3)	;BACKUP TAIL OF TWQ
CNSTW1:	HRRM T3,IRBLNK(T1)	;POINT PREDECESSOR TO SUCCESSOR
	HLLZS IRBLNK(T2)	;CLEAR LINK IN REMOVED ELEMENT
	RET

CNSTWE:	BUG(ILCNST)

;HERE TO REMOVE AN ARBITRARY ELEMENT FROM THE PWQ
;T1/ PREDECESSOR OF ELEMENT TO BE REMOVED
;T2/ ELEMENT TO BE REMOVED
;	CALL CONSPW
;RETURNS+1(ALWAYS):
;ELEMENT REMOVED
;NOTE: THE REASON TWO ARGUMENTS ARE REQUIRED IS TO ALLOW FOR POSSIBLE
;	EXTENSION TO THE REMOVAL OF SUBLISTS. IN THIS CASE, T1 WOULD BE
;	THE PREDECESSOR OF THE FIRST ELEMENT TO BE REMOVED, T2 WOULD BE
;	THE LAST ELEMENT IN THE SUBLIST TO BE REMOVED. THIS CASE IS
;	CURRENTLY DETECTED AS ILLEGAL.

CONSPW:	JUMPE T1,CNSPWE		;VALIDATE ARGUMENTS
	JUMPE T2,CNSPWE		; ...
	HRRZ T3,IRBLNK(T1)	;CHECK ONE AND ONLY ONE ELEMENT IS
	CAME T2,T3		;BEING REMOVED.
	JRST CNSPWE		;MULTIPLE ELEMENTS, ILLEGAL
	HRRZ T3,IRBLNK(T2)	;GET HEAD OF LIST AFTER ELEMENT REMOVED
	HLRZ T4,UDBPWQ(P3)	;GET TAIL OF LIST
	CAME T4,T2		;IS TAIL BEING REMOVED?
	JRST CNSPW1		;NO, NOTHING SPECIAL
	JUMPN T3,IRBERR		;YES - INSURE RESIDUE REALLY NULL
	HRLM T1,UDBPWQ(P3)	;BACKUP TAIL OF LIST
CNSPW1:	HRRM T3,IRBLNK(T1)	;POINT PREDECESSOR TO SUCCESSOR
	HLLZS IRBLNK(T2)	;CLEAR LINK IN ELEMENT REMOVED
	RET

CNSPWE:	BUG(ILCNSP)
;UTILITY TO DEQUEUE THE HEAD OF A UNITS TWQ
;P3/ UDB
;	CALL OFFTWQ
;RETURNS+1(ALWAYS):
;T1/ IORB

OFFTWQ:	HRRZ T1,UDBTWQ(P3)	;GET IORB AT HEAD OF TWQ
	JUMPE T1,IRBMIS		;NO - BOMB
	HRRZ T2,IRBLNK(T1)	;GET FORWARD LINK
	HLLZS IRBLNK(T1)	;CLEAR TAIL POINTER
	HRRM T2,UDBTWQ(P3)	;NOW AT HEAD
	JUMPN T2,R		;UNLESS NOW NULL
	MOVSI T2,UDBTWQ(P3)	;NOW NULL - RESET LIST
	MOVEM T2,UDBTWQ(P3)	; ...
	RET

;UTILITY TO REMOVE THE HEAD OF A UNITS PWQ
;JUST LIKE OFFTWQ

OFFPWQ:	HRRZ T1,UDBPWQ(P3)	;GET IORB AT HEAD OF PWQ
	JUMPE T1,IRBMIS		;NO - BOMB
	HRRZ T2,IRBLNK(T1)	;GET FORWARD LINK
	HLLZS IRBLNK(T1)	;CLEAR TAIL POINTER
	HRRM T2,UDBPWQ(P3)	;NOW AT HEAD
	JUMPN T2,R		;UNLESS NOW NULL
	MOVSI T2,UDBPWQ(P3)	;NOW NULL - RESET LIST
	MOVEM T2,UDBPWQ(P3)	; ...
	RET

;HERE IF PWQ OR TWQ WAS NULL AT OFFPWQ/TWQ

IRBMIS:	BUG(TWQNUL)
;HERE TO REMOVE ALL NON ACTIVE IORBS FROM A UNIT TRANSFER QUEUE
;	NOTE: THIS ROUTINE IS NOT CURRENTLY CALLED FOR DISK UDBS

;P1 & P3 SETUP
;	CALL PHYKIL
;RETURNS+1(ALWAYS):
;T1/ HEAD OF LIST OF IORBS
;NOTE: THIS ROUTINE CAN BE CALLED FROM NONZERO SECTIONS

PHYKIL::SAVEP			;SAVE REGISTERS
	HRRZ P3,T1		;SETUP UDB
	HLRZ P1,T1		;SETUP CDB
	SETZM CDBIRB(P1)	;NO PREFERENTIAL IORB ANYMORE
	MOVX T1,US.ACT		;GET ACTIVE BITS READY FOR TESTING
	MOVX T2,US.POS		; ...
	PIOFF			;PREVENT RACE - MUST NEST IN IOPIOF
	TDNN T1,UDBSTS(P3)	; .?.
	JRST KILALL		;NO - CAN PRUNE ALL
	TDNE T2,UDBSTS(P3)	;UNIT ACTIVE. POSITIONING?
	JRST KIL2		;YES
	HRRZ T2,UDBTWQ(P3)	;PICK UP ACTIVE IORB
	HRRZ T1,IRBLNK(T2)	;LINK FORWARD
	JUMPE T1,KIL1		;CHECK PWQ
	HLLZS IRBLNK(T2)	;CLEAR FORWARD LINK
	HLRZ T3,UDBTWQ(P3)	;GET TAIL POINTER
	HRLM T2,UDBTWQ(P3)	;UPDATE TAIL POINTER
KIL1:	HRRZ T2,UDBPWQ(P3)	;GET HEAD OF PWQ
	JUMPE T2,PIONRT		;IF NIL, RETURN
	HRRM T2,IRBLNK(T3)	;APPEND TO TWQ LIST
	MOVSI T2,UDBPWQ(P3)	;RESET PWQ TO NULL
	MOVEM T2,UDBPWQ(P3)	; ...
	JRST PIONRT		;RETURN

KIL2:	HRRZ T2,UDBPWQ(P3)	;HERE WHEN POSITIONING ACTIVE
	HRRZ T1,IRBLNK(T2)	;GET ENTRY AFTER HEAD
	JUMPE T1,PIONRT		;RETURN NULL
	HLLZS IRBLNK(T2)	;CLEAR FORWARD LINK
	HRLM T2,UDBPWQ(P3)	;UPDATE END OF LIST
	JRST PIONRT		;RETURN

;HERE TO KILL ALL IORBS

KILALL:	HRRZ P4,UDBTWQ(P3)	;GET IORB
	JUMPN P4,KILA1		;IF PRESENT, USE FOR ERRFIN
	HRRZ P4,UDBPWQ(P3)	;NO TRANSFER, IS THERE POSITIONING
	JUMPE P4,KILA2		;NO, SKIP ERRFIN
KILA1:	CALL ERRFIN		;TERMINATE ERROR RECOVERY IF NEEDED
KILA2:	MOVX T1,US.OIR!US.OMS	;CLEAR OUT OPERATOR MESSAGE BITS
	ANDCAM T1,UDBSTS(P3)	; ...
	HRRZ T1,UDBTWQ(P3)	;GET HEAD OF LIST
	HLRZ T3,UDBTWQ(P3)	;GET TAIL OF LIST
	MOVSI T2,UDBTWQ(P3)	;SETUP NULL QUEUE
	MOVEM T2,UDBTWQ(P3)	; ...
	HRRZ T2,UDBPWQ(P3)	;GET PWQ HEAD
	JUMPE T1,KILA3		;WAS TWQ NIL?
	HRRM T2,IRBLNK(T3)	;NO - APPEND TO TWQ LIST
	MOVSI T2,UDBPWQ(P3)	;RESET PWQ TO NULL
	MOVEM T2,UDBPWQ(P3)	; ...
	JRST PIONRT		;RETURN

KILA3:	MOVE T1,T2		;TWQ NIL, RETURN PWQ
	MOVSI T2,UDBPWQ(P3)	;RESET PWQ TO NULL
	MOVEM T2,UDBPWQ(P3)	; ...
PIONRT:	PION
	RET
;HERE TO FETCH A WORD FROM A SPECIFIED PHYSICAL ADDRESS

;T1/ PHYSICAL ADDRESS
;CALL PHYMOV
;RETURNS+1(ALWAYS):
;T1/ UNCHANGED
;T2/ CONTENTS OF ((T1))

PHYMOV::PUSH P,T1		;SAVE ADDRESS OVER CALL
	IDIVI T1,PGSIZ		;ISOLATE CPN AND RELATIVE WORD
	EXCH T1,T2		;PLACE IN CORRECT ACCUMULATORS
	CALL MOVRCA		;CALL KERNEL ROUTINE
	MOVE T2,T1		;COPY RESULT
	JRST PA1		;POP T1 AND RETURN


;HERE TO STORE A WORD IN A SPECIFIED PHYSICAL ADDRESS

;T1/ PHYSICAL ADDRESS
;T2/ DATA TO STORE
;	CALL PHYSTO
;T1/ UNCHANGED

PHYSTO::PUSH P,T1		;SAVE ARGUMENT OVER CALL
	MOVE T3,T2		;MOVE DATA TO WHERE LOWER LEVEL WANTS IT
	IDIVI T1,PGSIZ		;ISOLATE CPN AND RELATIVE WORD
	EXCH T1,T2		;MOVE TO CORRECT PLACE
	CALL STORCA		;CALL KERNEL ROUTINE
	JRST PA1		;POP T1 AND RETURN

;HERE TO GENERATE A CCW FOR A PARTICULAR CHANNEL

;T1/ DATA MODE,,BYTE COUNT (1B0 IF BACKWARDS)
;T2/ PHYSICAL ADDRESS OF FIRST WORD TO TRANSFER
;T3/ CDB
;	CALL PHYCCW
;RETURNS+1(ALWAYS):
;T1/ CCW TO TRANSFER DATA AS SPECIFIED BY ARGUMENTS

PHYCCW::SAVEP			;PRESERVE REGISTERS
	MOVE P1,T3		;COPY CDB
	HRRZ T3,CDBDSP(P1)	;GET DISPATCH ADDRESS
	CALL CDSCCW(T3)		;GENERATE CCW
	RET
;ROUTINE TO WAIT FOR ALL PHYSIO ACTIVITY TO CEASE.
;CALLED AT SYSTEM STARTUP TIME JUST BEFORE THE SWAPPABLE MONITOR
;IS LOADED.

PHYIOW::SAVEPQ			;SAVE PRESERVED REGISTERS
IOW1:	MOVEI Q1,0		;CLEAR ACTIVITY FLAG
	MOVSI P4,-CHNN		;POINTER TO CHANNELS
IOW2:	SKIPN P1,CHNTAB(P4)	;CHANNEL PRESENT?
	JRST IOW3		;NO - CONTINUE
	MOVX T1,CS.ACT		;TRANSFER ON THIS CHANNEL?
	TDNE T1,CDBSTS(P1)	; ???
	AOJA Q1,IOW3		;YES - SET FLAG
	CALL DGUMAP		;MAP OVER ALL UNITS
	 CALL [	MOVX T1,US.ACT!US.POS!US.OIR!US.OMS	;CHECK ACTIVITY
		TDNE T1,UDBSTS(P3) ; ...
		AOS Q1		;FLAG ACTIVITY
		RET]
IOW3:	AOBJN P4,IOW2		;LOOP OVER ALL CHANNELS
	JUMPN Q1,IOW1		;IF ANY WERE ACTIVE, CHECK AGAIN
	RET			;NONE ACTIVE, RETURN

;ROUTINE TO RETRIEVE UDB INFO ON TAPE POSITION
;C(T1) := TAPE UNIT NUMBER
;RETURNS:
; T1/	UDBPS2	(RECORD COUNT)
; T2/	UDBPS1	(FILE COUNT)

PHYPOS::HRRZ T3,MTCUTB(T1)	;GET POINTER TO UDB
	MOVE T1,UDBPS2(T3)	;RECORD COUNT TO T1
	MOVE T2,UDBPS1(T3)	;FILE COUNT TO T2
	RET			;RETURN
	SUBTTL ERROR LOGGING INTERFACE

;HERE TO ASSIGN AN ERROR BLOCK
;P1/ CDB
;P3/ UDB
;	CALL ERRSET
;RETURNS+1(ALWAYS):
;T1/ EB ADDRESS OR ZERO IF NONE AVAILABLE


ERRSET::MOVEI T1,MB%LEN		;TOTAL BLOCK LENGTH
	MOVEI T2,MB%SIZ		;NON STRING DATA SIZE
	MOVX T3,IS.IEL		;GET ERROR LOGGING INHIBITED FLAG
	TDNN T3,IRBSTS(P4)	;LOGGING ALLOWED?
	CALL ALCSEB		;YES, TRY TO GET ERROR BLOCK
	 MOVEI T1,0		;NO LOGGING OR NONE AVAIL
	RET


;HERE TO LOG AND RELEASE AN ERROR BLOCK
;P1/ CDB
;P3/ UDB
;	CALL ERRFIN
;RETURNS+1(ALWAYS):
;ERROR LOGGING UNDERWAY


ERRFIN::HRRZS UDBERP(P3)	;CLEAR LEFT HALF
	SKIPN UDBERP(P3)	;AN ERROR BLOCK?
	JRST ERRFN3		;NO, DONT SAVE ACCUMULATORS
	SAVEQ
	MOVEI Q1,0		;CLEAR/GET ERROR BLOCK
	EXCH Q1,UDBERP(P3)	; ...
	JUMPE Q1,ERRFN3		;NOTHING TO LOG
	MOVE Q3,UDBSTS(P3)	;GET UNIT TYPE
	HRL Q3,CDBSTS(P1)	;GET CHANNEL TYPE
	HRRZ P3,P3		;CLEAR OUT ANY FLAGS
	MOVE T1,Q1		;GET ERROR BLOCK
	MOVE T2,[-NCTAB,,CTAB]	;GET THINGS TO COPY
	CALL SEBCPY		;AND DO IT
	 JFCL			;NEVER...
	HRLZ T1,UDBADR(P3)	;GET UNIT OFF OF CHANNEL READY
	HRR T1,UDBSLV(P3)	;AND SLAVE NUMBER
	TRNN P2,-1		;HAVE A CONTROLLER?
	HRRO T1,UDBADR(P3)	;NO, GET GET UNIT NUMBER THIS WAY
	MOVEM T1,SEBDAT+MB%UAD(Q1)	;STORE IN SYSERR BLOCK
	HLL P3,UDBSTS(P3)	;GET FLAGS BACK AGAIN
	MOVX T1,IS.ERR!IS.NRT	;IS THIS A HARD ERROR?
	TDNN T1,IRBSTS(P4)	; ?
	JRST ERRFN2		;NO, NO NEED FOR BAT BLOCK LOGIC
	MOVX T1,IS.DTE		;YES, GET DATA ERROR FLAG
	MOVX T2,US.DSK		;AND DISK FLAG
	TDNE T2,UDBSTS(P3)	;IS THIS A DISK?
	TDNN T1,IRBSTS(P4)	;AND IS THIS A DATA ERROR?
	JRST ERRFN2		;NO - DONT DO BAT BLOCK LOGIC
	MOVE T1,Q1		;GET ERROR BLOCK AGAIN
	MOVE T2,[-1,,[SEBPTR 0,SBTFNA,ERRBAT]]
	CALL SEBCPY		;INSERT JOB 0 FUNCTION
	 JFCL
ERRFN2:	MOVE T1,Q1		;RECOVER ERROR BLOCK
	CALL QUESEB
	MOVEI T1,MASBGX		;SAY WE ARE REOCRDING A MASSBUS ERROR
	CALL GENBLK		;SEE IF STATUS BLOCK NEEDED
ERRFN3:	SETZM UDBERR(P3)	;YES - CLEAR STATE INFORMATION
	SETZM UDBERC(P3)	; ...
	RET			;AND WE ARE DONE
;COPY BLOCK
CTAB:	SEBPTR 0,SBTEVC,SEC%MB	;BLOCK TYPE
	SEBPTR MB%VID,SBTWD,UDBVID(P3) ;VID
	SEBPTR MB%FES,SBTWD,UDBERR(P3) ;FINAL ERROR STATE
	SEBPTR MB%UDB,SBTWD,P3	;UDB - NEEDED FOR BAT BLOCK LOGIC IN JOB 0
	SEBPTR MB%IRS,SBTWD,IRBSTS(P4) ;IORB STATUS WORD
	SEBPTR MB%TYP,SBTWD,Q3	;CHANNEL TYPE,,UNIT TYPE
	SEBPTR MB%SEK,SBTWD,UDBSEK(P3) ;NUMBER OF SEEKS
	SEBPTR MB%RED,SBTWD,UDBRED(P3) ;DATA READ
	SEBPTR MB%WRT,SBTWD,UDBWRT(P3) ;DATA WRITTEN
	SEBPTR MB%SRE,SBTWD,UDBSRE(P3) ;SOFT READ ERRORS
	SEBPTR MB%SWE,SBTWD,UDBSWE(P3) ;SOFT WRITE ERRORS
	SEBPTR MB%HRE,SBTWD,UDBHRE(P3) ;HARD READ ERRORS
	SEBPTR MB%HWE,SBTWD,UDBHWE(P3) ;HARD WRITE ERRORS
	SEBPTR MB%PS1,SBTWD,UDBPS1(P3) ;POSITION 1
	SEBPTR MB%PS2,SBTWD,UDBPS2(P3) ;POSITION 2
	SEBPTR MB%FEC,SBTWD,UDBERC(P3) ;FINAL ERROR COUNTER
	SEBPTR MB%USR,SBTWD,UDBUDR(P3) ;USER DIRECTORY TO LOG
	SEBPTR MB%PGM,SBTWD,UDBPNM(P3) ;USER PROGRAM TO LOG
	SEBPTR MB%MPE,SBTWD,CDBPAR(P1) ;PAR ERR COUNT
	SEBPTR MB%NXM,SBTWD,CDBNXM(P1) ;NXM COUNT
	SEBPTR MB%OVR,SBTWD,CDBOVR(P1) ;NUMBER OF OVERRUNS
	SEBPTR MB%CAD,SBTWD,CDBADR(P1) ;CHANNEL NUMBER

NCTAB=.-CTAB

;HERE IN JOB 0 CONTEXT WHEN A HARD ERROR HAS OCCURED ON A DISK.
;THE BAT BLOCK LOGIC MUST BE INVOKED TO PREVENT RE-USE OF THE BAD BLOCK.

	SWAPCD			;RUNS IN JOB 0 CONTEXT, MAY BE SWAPPABLE
ERRBAT:	MOVE T2,SEBDAT+MB%LOC(T1) ;GET LINEAR ADDRESS FROM ERROR BLOCK
	MOVE T1,SEBDAT+MB%UDB(T1) ;GET UDB FROM ERROR BLOCK
	CALL BATQ		;MARK BAT BLOCKS, FDB, ETC.
	RET

	RESCD
SUBTTL INTERNAL START IO UTILITIES

;HERE TO START IO ON AN IORB

;SHOULD BE CALLED WITH PI OFF IF NOT AT INTERRUPT LEVEL
;P4/ IORB
;P1,2,3 SETUP
;	CALL STRTIO
;RETURNS+1:
;	IO NOT STARTED, IORB EITHER TERMINATED OR REMAINING IN QUEUES
;RETURNS+2:
;	IO STARTED

STRTIO:	SETZM CDBIRB(P1)	;NO LONGER HAVE A PREFERENTIAL IORB
	SKIPGE IRBSTS(P4)	;SHORT IORB?
	JRST STRTI1		;YES, NEVER AN EXIT ROUTINE
	HLRZ T2,IRBIVA(P4)	;GET STARTIO EXIT
	JUMPE T2,STRTI1		;NONE
	MOVE T1,P4		;COPY IORB FOR CALL
	CALL (T2)		;CALL EXIT ROUTINE
	 SKIPA			;ABORT
	JRST STRTI1		;NORMAL STARTUP
STRTI0:	MOVX T1,US.OIR!US.OMS	;NO LONGER ANY NEED FOR OPER INTERVENTION
	ANDCAM T1,UDBSTS(P3)	; ...
	CALL OFFTWQ		;REMOVE FROM TWQ
	CALL DONIRB		;FLAG AS DONE
	RET			;AND EXIT INDICATING REFUSED
STRTI1:	MOVX T1,US.POS!US.ACT	;GET UNIT ACTIVE BITS
	MOVX T2,KS.ACT		;AND CONTROLLER ACTIVE BIT
	TRNE P2,-1		;IS THERE A CONTROLLER?
	TDNN T2,KDBSTS(P2)	;YES, CONTROLLER ALREADY BUSY?
	TDNE T1,UDBSTS(P3)	;OR UNIT ALREADY BUSY?
	BUG(ILUST1)		;YES, ERROR
	MOVX T1,CS.AC2		;CHECK NOT OUT OF PHASE
	TDNE T1,CDBSTS(P1)	;BY SEEING IF STACKED COMMAND ACTIVE
	BUG(ILCHS1)		;YES, ERROR
	MOVX T1,CS.AC1		;CHANNEL GOING ACTIVE
	IORM T1,CDBSTS(P1)	; ...
	MOVX T1,KS.ACT		;AND CONTROLLER
	TRNE P2,-1		;IF PRESENT
	IORM T1,KDBSTS(P2)	; ...
	MOVX T1,US.ACT		;ALSO UNIT
	IORM T1,UDBSTS(P3)	; ...
	HRRZ T1,UDBAKA(P3)	;GET CURRENT UDB ADDRESS
	MOVEM T1,CDBXFR(P1)	;MARK A UNIT HOLDING CHANNEL
	CALL SETIO		;SETUP FOR IO
	CALL CDSSIO(T1)		;GO START IO
	 JRST STKIOF		;OFFLINE, CAN'T DO IT
	HRRZM P3,CDBLUN(P1)	;REMEMBER UDB OF THE UNIT
	RETSKP			;IO STARTED SUCCESSFULLY

STKIOF:	CALL CLRACT		;CLEAR CHANNEL AND UNIT ACTIVE BITS
	MOVX T1,IS.ERR		;ANY ERRORS OCCURRED?
	TDNE T1,IRBSTS(P4)	;CHECK IORB
	JRST STRTI0		;YES, REMOVE IORB FROM QUEUE
	CALLRET SETOIR		;INDICATE OPERATOR NEEDED

;HERE WHEN OPERATOR INTERVENTION REQUIRED

SETOIR:	MOVX T1,US.OIR		;SET OPERATOR INTERVENTION BIT
	IORM T1,UDBSTS(P3)	;FOR PERIODIC CHECKER
	SETZM UDBODT(P3)	;ALSO CLEAR OUT OVERDUE TIMER
	RET
;HERE TO STACK A SECOND DATA TRANSFER COMMAND FOR A CHANNEL

;REQUIRES THE USUAL PIOFF OR INTERRUPT LEVEL INTERLOCK
;P4/ IORB
;P1,2,3 SETUP
;	CALL STKIO
;RETURNS+1:
;	COMMAND NOT STACKED
;RETURNS+2:
;	COMMAND STACKED IN CHANNEL



STKIO:	SKIPGE IRBSTS(P4)	;SHORT IORB?
	JRST STKIO1		;YES - NO NEED TO CALL EXIT RTN
	HLRZ T2,IRBIVA(P4)	;GET SIO EXIT ROUTINE ADDRESS
	JUMPE T2,STKIO1		;IF NONE, ASSUME OK
	MOVE T1,P4		;COPY IORB
	CALL (T2)		;CALL EXIT ROUTINE
	 RET			;SIGNAL FAILURE, WILL TERMINATE AT STRTIO
STKIO1:	MOVX T1,CS.AC1		;GET PRIMARY CHANNEL ACTIVE FLAG
	MOVX T2,KS.ACT		;AND CONTROLLER ACTIVE FLAG
	TRNE P2,-1		;DOES A CONTROLLER EXIST?
	TDNE T2,KDBSTS(P2)	;YES, THEN IT BETTER BE ACTIVE
	TDNN T1,CDBSTS(P1)	;CHANNEL SHOULD BE BUSY ALSO
	BUG(ILUST5)		;WRONG, COMPLAIN
	MOVE T1,UDBSTS(P3)	;CHECK ON UNIT STATUS
	TXNE T1,US.ACT		;UNIT SHOULD BE ACTIVE
	TXNE T1,US.POS		;BUT NOT POSITIONING
	BUG(ILUST6)		;OTHERWISE LOSE
	MOVX T1,CS.AC2		;NOW GET SECOND CHANNEL ACTIVE FLAG
	TDNE T1,CDBSTS(P1)	;ALREADY BUSY?
	BUG(ILCHS2)		;YES, ERROR
	IORM T1,CDBSTS(P1)	;WILL NOW HAVE BOTH ACTIVE
	CALL SETIO		;SETUP
	CALL CDSSTK(T1)		;CALL LOWER LEVELS
	 SKIPA T1,[EXP CS.AC2]	;FAILED, GET FLAG READY
	RETSKP			;SUCCESSFUL
	ANDCAM T1,CDBSTS(P1)	;CLEAR SECOND ACTIVE FLAG
	RET			;AND RETURN ERROR
;HERE TO START POSITIONING FOR AN IORB

;P4/ IORB
;P1,3 SETUP
;	CALL STRTPS
;RETURN+1:
;	POSITIONING NOT STARTED, IORB TERMINATED IF APPROPRIATE
;RETURNS+2:
;	POSITIONING STARTED

STRTPS:	HRRZ T1,UDBTWQ(P3)	;CHECK IF POSITIONING LEGAL NOW
	MOVX T2,US.ACT		;IF ANY PENDING REQUEST ON CYLINDER
	TDNE T2,UDBSTS(P3)	;OR IF UNIT ACTIVE
	SKIPN T1		; ...
	SKIPA			;NONE OF THE ABOVE
	BUG(ILUST2)
	TRNN P2,-1		;IS THERE A CONTROLLER?
	JRST STRTP1		;NO
	MOVX T1,KS.ACT		;YES
	TDNE T1,KDBSTS(P2)	;ALREADY ACTIVE?
	BUG(ILUST4)
	IORM T1,KDBSTS(P2)	;NO - MAKE IT ACTIVE
STRTP1:	MOVX T1,US.ACT!US.POS	;UNIT SOON POSITIONING
	IORM T1,UDBSTS(P3)	; ...
	CALL SETIO		;SETUP
	CALL CDSPOS(T1)		;CALL LOWER LEVEL
	 JRST STRTPF		;COULDN'T
	HRRZM P3,CDBLUN(P1)	;REMEMBER LAST UNIT TALKED TO
	RETSKP			;ALL OK

STRTPF:	CALL CLRPOS		;CLEAR ACTIVE
	MOVX T1,US.TAP		;IS THIS A TAPE LIKE DEVICE?
	TDNN T1,UDBSTS(P3)	;???
	JRST STRTP2		;NO
	MOVX T1,IS.ERR		;YES - WAS AN ERROR INDICATED?
	TDNN T1,IRBSTS(P4)	; ???
	JRST STRTP2		;NO - KEEP IN QUEUES
	MOVX T1,US.OIR!US.OMS	;YES - TERMINATE
	ANDCAM T1,UDBSTS(P3)	;NO LONGER WAITING FOR OPR
	CALL OFFPWQ		;REMOVE FROM PWQ
	CALL DONIRB		;POST COMPLETE
	RET			;FAIL RETURN

STRTP2:	CALLRET	SETOIR		;SET OPERATOR INVERVENTION REQ
				;AND FAIL RETURN


;HERE TO RESTART SEEKS ON A CHANNEL
;P1/ CDB
;	CALL RSTSEK
;RETURNS+1(ALWAYS):
;CLOBBERS P REGISTERS, P2, AND P3
;SHOULD BE CALLED WITH PI OFF

RSTSEK::SAVEQ
	CALL DGUMAP		;LOOP OVER ALL UNITS
	 CALL SCHSEK		;DO THIS FOR EACH ONE
	RET			;DONE
;UTILITY TO SET UP FOR IO
;P4/IORB ADDRESS
;P1/CDB
;RETURNS +1 (ALWAYS):
;ERROR BIT CLEARED IN IORB,
;T1/DISPATCH ADDRESS


SETIO::	MOVX T1,IS.ALE		;CLEAR ALL ERROR BITS
	ANDCAM T1,IRBSTS(P4)
	MOVX T1,US.DSK		;DECIDE IF I/O IS FOR DISK OR TAPE
	TDNN T1,UDBSTS(P3)	;FOR DISK?
	TXCA T1,US.DSK^!<^D17000>	;NO, HAVE TO ALLOW FULL 17 SECONDS
	MOVEI T1,^D3000		;YES, ALLOW ONLY A FEW SECONDS THEN
	ADD T1,TODCLK		;FROM NOW
	MOVEM T1,UDBODT(P3)	;AND STORE AS OVERDUE TIME
	HRRZ T1,CDBDSP(P1)
	RET



;HERE TO CLEAR CHANNEL AND UNIT ACTIVE BITS

CLRACT::MOVX T1,CS.ACT!CS.ERC	;MARK CDB NO LONGER ACTIVE OR IN ERROR RECOVERY
	ANDCAM T1,CDBSTS(P1)	; ...
	SETOM CDBXFR(P1)	;CLEAR TRANSFERING UDB
CLRPOS:	TRNN P2,-1		;ANY CONTROLLER?
	JRST CLRSRC		;NO, SKIP ON
	MOVX T1,KS.ACT		;YES, GET ACTIVE BIT
	ANDCAM T1,KDBSTS(P2)	;AND CLEAR IT
	SETZM KDBACT(P2)	;CLEAR TRANSFERING UDB
CLRSRC:	MOVX T1,US.ACT!US.POS	;UNIT IS NO LONGER ACTIVE OR POSITIONING
	ANDCAM T1,UDBSTS(P3)	; ...
CLRXIT:	SETZM UDBODT(P3)	;ALSO CLEAR TIMEOUT
	MOVX T1,US.MRQ		;UNIT WAITING FOR MAINT MODE?
	TDNN T1,UDBSTS(P3)	;?
	RET			;NO - JUST RETURN
	MOVX T2,US.MAI		;YES, SET BIT
	IORM T2,UDBSTS(P3)	; ...
	ANDCAM T1,UDBSTS(P3)	;NO LONGER REQUESTING
	AOS PSKED		;POKE SCHED
	RET
	SUBTTL SEEK SCHEDULER
;SHOULD BE CALLED WITH INTERRUPTS OFF OR AT INTERRUPT LEVEL
;P1/ CDB
;P2/ KDB (IF PRESENT)
;P3/ UDB
;	CALL SCHSEK
;RETURNS+1(ALWAYS):
;	SEEK STARTED ON THIS UNIT IF APPROPRIATE
;	POSITION OP STARTED IF CONTROLLER FREE (SEE SCHPOS COMMENTS)
;USES P4,THE Q'S

;THE ALGORITHM USED IS THAT REFERED TO IN THE LITERATURE AS "SCAN"
;BRIEFLY STATED, THE ALGORITHM SELECTS THE REQUEST TO THE CLOSEST
;HIGHER NUMBERED CYLINDER THAN THE UNITS CURRENT CYLINDER. IF THERE IS
;NO SUCH REQUEST, THE REQUEST TO THE LOWEST NUMBERED CYLINDER IS
;SELECTED. THIS CAUSES THE DISK ARM TO "SCAN" FROM LOWER NUMBERED
;CYLINDERS TO HIGHER NUMBERED CYLINDERS. THE CACM AND IBM SYS. J.
;HAVE MANY DESCRIPTIONS AND WINDY RELIGIOUS DEBATES ON THE SUBJECT.

;NOTE: READS ARE GIVEN PREFERENCE OVER WRITES IN SELECTING THE
;	NEXT SEEK CYLINDER. THIS TENDS TO REDUCE SYSTEM SWAP WAIT TIME
;	IN THAT A PROCESS IS USUALLY BLOCKED WAITING FOR A READ WHILE
;	WRITES USUALLY ORIGINATE WITH GCCOR. ALL TRANSFERS FOR THE
;	SELECTED CYLINDER ARE DONE, BOTH READS AND WRITES.

;REGISTER USAGE:
;Q1/ FLAGS,,PREDECESSOR TO ELEMENT UNDER CONSIDERATION
;Q2/ MINIMUM CYLINDER SO FAR,,PREDECESSOR TO MINIMUM ELEMENT
;Q3/ BEST CYLINDER SO FAR,,PREDECESSOR TO BEST ELEMENT
;P4/ CURRENT ELEMENT UNDER CONSIDERATION

;LOCAL FLAGS IN LH(Q1)
SEKF%R==1B0		;PREFER READS OVER WRITES
SEKF%M==1B1		;HAVE A READ FOR MIN CYL
SEKF%B==1B2		;HAVE A READ FOR BEST CYL
SCHSEK::MOVX T1,CS.MRQ!CS.MAI	;CHANNEL IN MAINT MODE?
	TDNE T1,CDBSTS(P1)	; ???
	RET			;YES - NO NEW ACTIVITY
	TRNE P2,-1		;KDB FOR THIS UNIT?
	JRST SCHPOS		;YES - GO WORK ON IT
	HRRZ T1,UDBTWQ(P3)	;ANY TRANSFERS PENDING ON CYLINDER?
	JUMPN T1,R		;YES - WHY MESS THINGS UP?
	MOVEI Q1,UDBPWQ(P3)	;SETUP PREDECESSOR
	MOVSI Q2,-1		;SETUP MINIMUM CYLINDER TO LARGE NUMBER
	MOVSI Q3,-1		;SETUP BEST CYLINDER TO LARGE NUMBER
	HRRZ P4,UDBPWQ(P3)	;GET CURRENT HEAD OF PWQ
	JUMPE P4,SEKIDL		;IF QUEUE IS NULL, EXIT
	SOSG UDBFCR(P3)		;SHOULD READS GET PREFERENCE?
	SKIPA T1,[EXP INIFCR]	;NO - ALSO RESET COUNT
	TLOA Q1,(SEKF%R)	;YES
	MOVEM T1,UDBFCR(P3)	;SAVE NEW VALUE
SEK1:	HRRZ T1,UDBDSP(P3)	;GET UNIT DISPATCH
	CALL UDSCNV(T1)		;GET CYLINDER FOR THIS REQUEST
	LDB T3,IRYFCN		;GET FUNCTION CODE
	CAMN T2,UDBPS1(P3)	;SAVE AS CURRENT?
	SKIPG UDBFCT(P3)	;YES - "FAIRNESS" COUNT EXHAUSTED?
	JRST SEK3		;CNT EXHAUSTED OR NOT SAME CYL, CHK FOR MIN
	HRRZ T1,Q1		;GET PREDECESSOR
	HRRZ T2,P4		;GET ELEMENT TO BE REMOVED
	CALL CONSPW		;SPLICE QUEUE
	HRRZ T1,P4		;GET CURRENT REQUEST
	CALL ONTWQ		;AND PLACE ON TWQ
SEK2:	HRRZ P4,IRBLNK(Q1)	;ADVANCE CURRENT REQUEST
	JUMPN P4,SEK1		;IF ONE PRESENT, CONSIDER IT.
	HRRZ T1,UDBTWQ(P3)	;END OF QUEUE, ANYTHING IN TWQ?
	JUMPN T1,R		;YES - DONT DISTURB POSITION.
	HLRZ T1,Q3		;GET BEST CYLINDER FOUND
	CAIN T1,-1		;FOUND ANY REQUESTS TO HIGHER CYLINDERS?
	MOVE Q3,Q2		;NO - RESET SCAN AT MINIMUM
	HRRZ T1,Q3		;GET REQUEST DECIDED ABOVE
	HRRZ T2,IRBLNK(T1)	; ACTUAL ELEMENT
	HRRZ P4,T2		;COPY NEW CURRENT IORB
	CALL CONSPW		;SPLICE QUEUE
	MOVE T1,P4		;SHUFFLE TO HEAD OF PWQ
	CALL ONFPWQ		; ...
	MOVE T1,UDBSTS(P3)	;GET UNIT STATUS
	TXNE T1,US.OIR!US.OMS!US.MAI!US.MRQ	;WAITING FOR OPERATOR?
	RET			;YES, DO NOTHING
	TXNE T1,US.POS!US.ACT	;UNIT IDLE?
	BUG(ILUST3)		;NO, COMPLAIN
	CALL STRTPS		;START POSITIONING
	 JFCL			;COULDNT POSITION THIS UNIT, OPERATOR NEEDED
	RET
SEK3:	JUMPGE Q1,SEK3B		;READ PREFERENCE?
	CAIE T3,IRFRED		;YES - IS THIS A READ?
	JRST SEK3A		;NO
	TLON Q1,(SEKF%M)	;YES - SET/TEST IF WE HAVE A READ NOW
	JRST SEK3C		;NO - TAKE THIS REQUEST
	JRST SEK3B		;YES - SEE IF THIS REQUEST IS BETTER
SEK3A:	TLNE Q1,(SEKF%M)	;NOT A READ - DO WE HAVE A READ NOW?
	JRST SEK4		;YES
SEK3B:	HLRZ T1,Q2		;GET MINIMUM CYLINDER FOUND SO FAR
	CAML T2,T1		;THIS REQUEST LESS THAN MINIMUM?
	JRST SEK4		;NO
SEK3C:	HRRZ Q2,Q1		;YES - SAVE PREDECESSOR
	HRL Q2,T2		;AND NEW MINIMUM CYLINDER
SEK4:	CAMG T2,UDBPS1(P3)	;THIS REQUEST GREATER THAN UNIT CURRENT?
	JRST SEK5		;NO
	JUMPGE Q1,SEK4B		;READ PREFERENCE?
	CAIE T3,IRFRED		;YES - IS THIS A READ?
	JRST SEK4A		;NO
	TLON Q1,(SEKF%B)	;YES - SET/TEST DO WE HAVE A READ NOW?
	JRST SEK4C		;NO - USE THIS REQUEST
	JRST SEK4B		;YES - CHECK IF THIS REQUEST IS BETTER
SEK4A:	TLNE Q1,(SEKF%B)	;NOT A READ - DO WE HAVE A READ NOW?
	JRST SEK5		;YES
SEK4B:	HLRZ T1,Q3		;GET CURRENT BEST CYLINDER
	CAML T2,T1		;BETTER? (LESS)
	JRST SEK5		;NO - CONTINUE SEARCH
SEK4C:	HRRZ Q3,Q1		;YES - SAVE PREDECESSOR
	HRL Q3,T2		;SAVE NEW BEST CYLINDER
SEK5:	HRR Q1,P4		;ADVANCE POINTER
	JRST SEK2		;AND CONTINUE SCAN

;HERE WHEN UNIT HAS NO MORE POSITION REQUESTS

SEKIDL:	MOVEI T1,INIFCR		;RESET READ PREFERENCE COUNT
	MOVEM T1,UDBFCR(P3)	; ...
	RET
;HERE TO SCHEDULE A POSITION OPERATION ON A UNIT WHICH IS A SUBUNIT
;OF A CONTROLLER TYPE DEVICE. THE POSITION AND TRANSFER OPERATIONS
;ARE SCHEDULED ROUND ROBIN AMONG THE DEVICES ON THE CONTROLLER.
;UNLIKE A DISK WHERE A SINGLE UNIT'S QUEUES DETERMINE WHETHER
;TO SEEK/NOT SEEK, THE UNITS OTHER THAN THE CURRENT ONE MUST BE
;SCANNED FIRST ON A CONTROLLER. 

;THE CURRENT UNIT'S POSITION WAIT QUEUE IS MOVED TO ITS TWQ IF
;(AND AS FAR AS) IT IS APPROPRIATE. THE REQUESTS FOR A PARTICULAR
;DEVICE MUST BE FINISHED IN THE ORDER SUBMITTED.


SCHPOS:	MOVX T1,KS.ACT		;IS THE CONTROLLER FREE?
	TDNE T1,KDBSTS(P2)	; ???
	RET			;NO - NOTHING TO DO NOW

POS1:	HRRZ P4,UDBPWQ(P3)	;GET HEAD OF PWQ
	JUMPE P4,POS2		;IF NONE, JUST SCAN OTHER UNITS
	HRRZ T1,UDBDSP(P3)	;GET UNIT DISPATCH
	CALL UDSPRQ(T1)		;DOES THIS REQUEST REQUIRE POSITIONING?
	 SKIPA			;NO - TRANSFER IT TO UNITS TWQ
	JRST POS2		;YES - TRY OTHER UNITS
	CALL OFFPWQ		;PULL REQUEST FROM PWQ
	CALL ONTWQ		;APPEND TO TWQ
	JRST POS1		;AND CHECK AGAIN

POS2:	MOVE Q1,KDBCUN(P2)	;GET CURRENT LOOP POINTER
	JRST POS5		;AND START WITH NEXT UNIT

POS3:	SKIPN P3,(Q1)		;IS THERE A UNIT PRESENT?
	JRST POS4		;NO
	MOVX T1,US.ACT!US.POS!US.REW!US.OIR!US.OMS!US.MAI!US.MRQ!US.CHB
	TDNE T1,UDBSTS(P3)	;IS THIS UNIT AVAILABLE?
	JRST POS4		;NO - KEEP LOOKING
	HRRZ P4,UDBTWQ(P3)	;DOES THIS UNIT HAVE ANY TRANSFER REQS?
	JUMPN P4,R		;YES - LET TRANSFER SCHEDULER DO IT
	HRRZ P4,UDBPWQ(P3)	;ARE THERE ANY POSITION REQUESTS?
	JUMPE P4,POS4		;NO
	MOVEM Q1,KDBCUN(P2)	;YES - SAVE CURRENT UNIT POINTER
	CALL STRTPS		;TRY TO START IT
	 JRST POS5		;FAILED - SEE IF ANYTHING ELSE
	RET			;ALL DONE

POS4:	CAMN Q1,KDBCUN(P2)	;BACK TO ORIGINAL UNIT?
	RET			;YES - IDLE
POS5:	AOBJN Q1,POS3		;LOOP
	MOVE Q1,KDBIUN(P2)	;WRAP AROUND THE UNIT NUMBERS
	JRST POS3		;AND LOOP
	SUBTTL CHANNEL SCHEDULER


SCHXFR::MOVE T1,CDBSTS(P1)	;GET STATUS
	TXNE T1,CS.MRQ!CS.MAI!CS.ERC	;CHANNEL IN MAINT MODE?
	RET			;YES - NO NEW ACTIVITY
	SOSLE CDBFCT(P1)	;CHECK "FAIRNESS" COUNT
	JRST SCHLTM		;NOT TIME TO ROUND ROBIN, DO LAT OPT
	TXNE T1,CS.AC1		;IS CHANNEL NOW ACTIVE?
	RET			;YES - WAS A POSSIBLE COMMAND STACK REQ
	MOVEI T1,INIFCX		;RESET COUNT
	MOVEM T1,CDBFCT(P1)	; ...
XFR0:	MOVE Q1,CDBCUN(P1)	;CONTINUE SCAN FROM LAST ACTIVE UNIT
	JRST XFR3

XFR1:	SKIPN P3,(Q1)		;ANY SUCH UNIT?
	JRST XFR2		;NO - CONTINUE SCAN
	LDB T1,USYBKT		;GET BLOCK TYPE
	CAIE T1,.BTUDB		;UDB?
	JRST XFR4		;SCAN KDB
	HRRZ P2,UDBKDB(P3)	;GET KDB IF ANY
	HRRZ P4,UDBTWQ(P3)	;GET REQUEST
	MOVE T1,UDBSTS(P3)	;GET STATUS OF UNIT
	TXNE T1,US.CHB		;NEED TO CHECK HOME BLOCKS?
	SKIPN UDBCHB(P3)	;IS A SPECIAL IORB PRESENT?
	SKIPA			;NO TO EITHER QUESTION
	JRST XFRCHB		;YES TO BOTH QUESTIONS
	JUMPE P4,XFR2		;NOTHING - CONTINUE SCAN
	TXNE T1,US.OIR!US.OMS!US.MAI!US.MRQ!US.REW!US.CHB	;AVAILABLE?
	JRST XFR2		;NO - CONTINUE SCAN
	CALL XFRX		;ATTEMPT TO START IO
	 JRST XFR3		;COULDNT - TRY ANOTHER UNIT
	RET			;ALL OK - RETURN

;HERE TO ATTEMPT TO START IO WHEN A REQUEST IS FOUND

XFRX:	MOVEM Q1,CDBCUN(P1)	;SETUP CURRENT UNIT POINTER
	CALLRET STRTIO		;START IO ON THIS IORB

XFR2:	CAMN Q1,CDBCUN(P1)	;BACK TO ORIGINAL UNIT?
	JRST XFRIDL		;YES - NOTHING TO DO, CHANNEL IDLE
XFR3:	AOBJN Q1,XFR1		;ADVANCE UNIT POINTER
	MOVE Q1,CDBIUN(P1)	;WRAPAROUND
	JRST XFR1		;CONTINUE SCAN

;HERE WHEN A CHANNEL GOES IDLE

XFRIDL:	MOVEI T1,INIFCX		;RESET "FAIRNESS" COUNT
	MOVEM T1,CDBFCT(P1)	; ...
	RET			;AND RETURN
;HERE WHEN A UNITS HOME BLOCKS NEED CHECKING

XFRCHB:	MOVX T1,US.MAI!US.MRQ!US.REW	;CAN THIS UNIT BE USED?
	TDNE T1,UDBSTS(P3)	;???
	JRST XFR2		;NO - CONTINUE SCAN
	HRRZ P4,UDBCHB(P3)	;GET SPECIAL IORB
	HRRZ T1,UDBTWQ(P3)	;GET CURRENT HEAD OF TWQ
	CAMN P4,T1		;ALREADY ON TWQ?
	BUG(PHYCH1)
	MOVE T1,P4		;COPY IORB
	CALL ONFTWQ		;PLACE AT HEAD OF TWQ
	CALL XFRX		;ATTEMPT TO START IT
	 SKIPA			;COULDNT
	RET			;STARTED - RETURN
	CALL OFFTWQ		;PULL IORB
	MOVX T1,IS.NRT!IS.DVE	;INDICATE HARD HARDWARE ERROR
	IORM T1,IRBSTS(P4)	; ...
	CALL DONIRB		;POST AS IF DONE
	JRST XFR3		;AND TRY FOR ANOTHER UNIT
;HERE TO SCAN A KDB FOR UDBS WITH WORK


XFR4:	MOVE P2,P3		;COPY KDB
	MOVX T1,KS.ACT		;IS IT FREE?
	TDNE T1,KDBSTS(P2)	; ???
	JRST XFR2		;NO - MOVE ALONG
	MOVE Q2,KDBCUN(P2)	;GET POINTER
	JRST XFR7		;ENTER BELOW

XFR5:	SKIPN P3,(Q2)		;UNIT PRESENT?
	JRST XFR6		;NO - TRY NEXT
	HRRZ P4,UDBTWQ(P3)	;ANY REQUESTS?
	JUMPE P4,XFR6		;NO - TRY AGAIN
	MOVX T1,US.ACT!US.POS!US.REW!US.OIR!US.OMS!US.MAI!US.MRQ!US.CHB
	TDNE T1,UDBSTS(P3)	;IS THE UNIT AVAILABLE?
	JRST XFR6		;NO - CONTINUE SCAN
	MOVEM Q2,KDBCUN(P2)	;YES - UPDATE POINTER
	CALL XFRX		;ATTEMPT START IO
	 JRST XFR7		;COULDNT - TRY AGAIN ON ANOTHER UNIT
	RET			;OK.

XFR6:	CAMN Q2,KDBCUN(P2)	;BACK TO STARTING UNIT?
	JRST XFR2		;YES - CONTINUE CHANNEL SCAN
XFR7:	AOBJN Q2,XFR5		;NEXT UNIT AND LOOP
	MOVE Q2,KDBIUN(P2)	;RESET TO START OF TABLE
	JRST XFR5		;AND LOOP
;HERE TO DO DISK LATENCY OPTIMIZATION

;REGISTER USAGE:
;  Q1/	UDB OF BEST IORB,,LATENCY OF BEST IORB SO FAR (MICROSECONDS)
;  Q2/	PREDECESSOR OF BEST IORB,,BEST IORB
;  Q3/	AOBJN POINTER TO UDB TABLE IN EITHER THE CDB OR KDB
;  P6/	NONZERO IF NON-DISKS FOUND ON THE CHANNEL


SCHLTM:	MOVX T1,CS.AC1		;PRIMARY COMMAND ACTIVE?
	TDNE T1,CDBSTS(P1)	; ???
	JRST SCHSTK		;YES - SEE IF WE SHOULD STACK ANOTHER
	MOVEI Q1,777777		;NIL UDB,,LARGE INITIAL BEST LATENCY
	SETZB Q2,P6		;INITIALIZE BEST IORBS AND NON-DISKS COUNT
	MOVE Q3,CDBIUN(P1)	;GET AOBJN POINTER

LTM1:	SKIPN P3,(Q3)		;UNIT EXIST?
	JRST LTM3		;NO
	LDB T1,USYBKT		;YES, GET BLOCK TYPE
	CAIN T1,.BTUDB		;IS IT A UDB?
	JRST LTM2		;YES, GO CHECK IT
	MOVE T1,KDBSTS(P3)	;IT'S A KDB, GET STATUS
	TXNN T1,KS.DSK		;THIS CONTROLLER FOR A DISK?
	AOJA P6,LTM3		;NO, COUNT IT AND LOOK SOME MORE
	TXNE T1,KS.ACT		;YES, IS THE CONTROLLER FREE?
	JRST LTM3		;NOPE, SKIP LOOKING AT IT THEN
	MOVE P2,P3		;MOVE KDB ADDRESS TO RIGHT AC
	PUSH P,Q3		;SAVE CURRENT AOBJN POINTER
	MOVE Q3,KDBIUN(P2)	;GET AOBJN POINTER TO ITS UNITS
LTM4:	SKIPN P3,(Q3)		;UNIT EXIST?
	JRST LTM6		;NO, GO EXAMINE NEXT ONE
	CALL LTMUNI		;YES, COMPUTE BEST IORB FOR IT
	 JRST [	POP P,Q3	;FOUND PREFERED IORB, RESTORE AC
		JRST LTM7]	;AND GO USE IT
LTM6:	AOBJN Q3,LTM4		;LOOP OVER ALL UNITS
	POP P,Q3		;RESTORE OLD AOBJN POINTER
	JRST LTM3		;AND CONTINUE LOOKING FOR UNITS OF CDB
LTM2:	MOVEI P2,0		;NO KDB EXISTS
	CALL LTMUNI		;COMPUTE BEST IORB FOR THIS UNIT
	 JRST LTM7		;FOUND PREFERED IORB, GO USE IT
LTM3:	AOBJN Q3,LTM1		;LOOP OVER ALL UNITS
LTM7:	JUMPE Q2,LTM5		;IF NO DISK TRANSFERS FOUND, CHECK FOR TAPES
	HLRZ P3,Q1		;GET BEST UDB
	HRRZ P2,UDBKDB(P3)	;AND CORRESPONDING KDB IF ANY
	HLRZ T1,Q2		;GET PREDECESSOR TO BEST IORB
	HRRZ T2,Q2		;GET BEST IORB
	MOVE P4,T2		; ...
	CALL CONSTW		;PULL FROM TWQ
	MOVE T1,P4		;GET IORB
	CALL ONFTWQ		;PLACE AT HEAD OF TWQ
	CALL STRTIO		;ATTEMPT TO START IO
	 JRST XFR0		;FAILURE - REGRESS TO ROUND ROBIN
	MOVX T1,CS.STK		;CHANNEL SUPPORT COMMAND STACKING?
	TDNN T1,CDBSTS(P1)	; ???
	RET			;NO - DONE
	JRST STK1		;YES - ENTER COMMAND STACK SCHEDULER

LTM5:	JUMPN P6,XFR0		;IF FOUND ANY TAPES, TRY ROUND ROBIN
	JRST XFRIDL		;NOTHING TO DO, NOW IDLE
;HERE FOR EACH UDB FOUND.  THE UNIT IS CHECKED TO SEE IF IT IS AVAILABLE,
;AND IF SO, THE IORB WITH THE BEST LATENCY ON THE UNIT IS FOUND, AND
;COMPARED WITH THE BEST OVERALL ON ALL UNITS.  IF BEST SO FAR, THE IORB
;AND UDB ARE REMEMBERED IN Q1 AND Q2.  CALL:
;  P1/	CDB
;  P2/	KDB, OR 0 IF NONE
;  P3/	UDB
;  Q1-Q3/  CURRENT BEST IORBS
;  P6/	FLAG FOR NON-DISKS
;RETURNS:
;  +1:	IORB WAS FOUND WHICH IS PREFERED (WAS THE ONE IN CDBIRB)
;  +2:	NORMAL TYPE IORBS EXAMINED



LTMUNI:	HRRZ T1,UDBTWQ(P3)	;ANYTHING ON THE TRANSFER WAIT QUEUE?
	JUMPE T1,RSKP		;NO, RETURN
	MOVE T1,UDBSTS(P3)	;GET STATUS OF THE UNIT
	TXNE T1,US.OIR!US.OMS!US.MAI!US.MRQ!US.REW!US.CHB!US.ACT!US.POS
	RETSKP			;UNIT NOT AVAILABLE
	TXNN T1,US.DSK		;IS UNIT A DISK?
	AOJA P6,RSKP		;NO, ADVANCE COUNTER AND RETURN
	MOVEI T1,MINLAT		;MINIMUM ACCEPTABLE LATENCY
	PUSH P,P6		;SAVE COUNTER
	HRRZ T2,UDBDSP(P3)	;GET UNIT DISPATCH
	CALL UDSLTM(T2)		;GET BEST TRANSFER ON THIS UNIT
	 BUG(PHYLTF)
				; T1/ LATENCY IN USEC (0 MEANS PREFERED IORB)
				; T2/ PRED. TO BEST IORB
				; T3/ BEST IORB
	POP P,P6		;RESTORE COUNTER
	CAIL T1,(Q1)		;BETTER THAN CURRENT BEST?
	RETSKP			;NO, LOOK AT NEXT UNIT
	MOVE Q1,T1		;YES - SAVE AS CURRENT BEST TIME
	HRL Q1,P3		;SAVE BEST UDB
	MOVE Q2,T3		;SAVE BEST IORB
	HRL Q2,T2		;SAVE PREDECESSOR TO BEST IORB
	JUMPN T1,RSKP		;SKIP RETURN IF NOT PREFERRED IORB
	RET			;RETURN NON-SKIP FOR SPECIAL IORB
;HERE TO DECIDE IF A SECOND COMMAND SHOULD BE STARTED TO THIS CHANNEL
;THOSE CHANNELS (RH20) WHICH SUPPORT A COMMAND STACK CAN BE RUN AT
;THEORETICAL BANDWIDTH ON A PER PAGE BASIS.

;FOR THE PRESENT, ONLY THE CURRENTLY ACTIVE UNIT IS SCANNED FOR
;A REQUEST TO STACK. A REQUEST WILL BE STACKED ONLY IF ITS LATENCY
;IS BETWEEN MINLTS AND MINLAT + (TIME TO TRANSFER ONE PAGE).


SCHSTK:	MOVX T1,CS.STK		;SET UP FOR TEST
	TDNE T1,CDBSTS(P1)	;DOES THIS CHANNEL SUPPORT COMMAND STACKING?
	SKIPGE P3,CDBXFR(P1)	;AND IS THERE A CURRENTLY TRANSFERING UNIT?
	RET			;NO
	ADDI P3,CDBUDB(P1)	;DOUBLE INDEX
	MOVE P3,(P3)		;TO GET UDB/KDB
	LDB T1,USYBKT		;GET BLOCK TYPE
	SETZ P2,		;ASSUME NO KDB NEEDED
	CAIN T1,.BTUDB		;IS IT A UDB?
	JRST STK0		;YES, PROCEED
	MOVE P2,P3		;WAS REALLY A KDB, COPY ADDRESS
	MOVX T1,US.DSK		;GET FLAG READY
	SKIPE P3,KDBACT(P2)	;GET CURRENTLY ACTIVE SLAVE
	TDNN T1,UDBSTS(P3)	;AND VERIFY THIS IS A DISK DEVICE
	RET			;NOT ACTIVE OR NOT A DISK
STK0:	HRRZ P4,UDBTWQ(P3)	;GET CURRENT HEAD OF TWQ
STK1:	HRRZ P4,IRBLNK(P4)	;CHECK TO SEE IF MORE
	JUMPE P4,R		;THAN ONE REQUEST
	MOVX T1,SF%FLO		;TEST GLOBAL "FULL LATENCY OPT" ENABLE
	TDNN T1,FACTSW		; OK?
	RET			;NO
	MOVEI T1,0		;YES - FLAG STACK LATOPT, ASSUMES DISK
				; IS JUST AFTER CURRENT PAGE
	HRRZ T2,UDBDSP(P3)	;GET UNIT TRANSFER VECTOR
	CALL UDSLTM(T2)		;COMPUTE BEST LATENCY
	 RET			;NO STACKABLE REQUEST
	CAILE T1,MINLAT		;WILL IT BE LESS THAN MINLAT?
	RET			;NO - WAIT UNTIL CURRENT TRANSFER DONE
	DMOVE T1,T2		;YES - GET PRED IN T1, BEST IN T2
	MOVE P4,T2		;SAVE BEST IORB
	CALL CONSTW		;SPLICE IT OUT OF TWQ
	MOVE T1,P4		;GET IORB AGAIN
	CALL ONSTWQ		;MOVE TO SECOND POSITION ON TWQ
	CALL STKIO		;STACK COMMAND
	 JFCL			;NOTHING TO DO ABOUT IT
	RET
	SUBTTL	ROUTINES TO LOCK AND UNLOCK I/O PAGES



;IOLOCK - CALLED TO LOCK DOWN A CONTIGUOUS BLOCK OF USER PAGES AND RETURN
;A LIST OF THE PHYSICAL PAGES USED.  (ONLY USE NOW IS TO ALLOW MULTI-PAGE
;DSKOPS TO WORK).  THE RETURNED LIST IS PHYSICALLY CONTIGUOUS, AND IS
;TERMINATED BY AN EXTRA ZERO WORD.  CALLER MUST BE NOINT.
;ARGUMENTS:
;  T1/	ADDRESS OF USER'S BUFFER
;  T2/	SIZE OF BUFFER IN WORDS
;  T3/	NONZERO IF PAGES WILL BE WRITTEN INTO
;RETURNS:
;  +1:	FAILURE, ERROR CODE IN T1
;  +2:	SUCCESS
;	  T1/	ADDRESS OF STORAGE CONTAINING LIST OF PAGES, WHERE THE
;		FIRST WORD OF THE BLOCK IS AN AOBJN POINTER TO THE LIST



IOLOCK::ASUBR <IOLADR,IOLRES,IOLFLG,IOLCNT>	;ALLOCATE STORAGE
	SKIPLE T2		;SIZE MUST BE POSITIVE
	CAILE T2,CCWMAX*PGSIZ	;BUT NOT TOO LARGE
	 RETBAD(DSKOX5)		;NO, FAIL
	MOVE T3,T1		;COPY ADDRESS
	ADDI T3,-1(T2)		;COMPUTE LAST ADDRESS IN BUFFER
	TLNN T1,-1		;VERIFY BEGINNING ADDRESS IS REASONABLE
	TLNE T3,-1		;AND ENDING ADDRESS IS TOO
	 RETBAD(DSKOX6)		;NOPE, FAIL
	LSH T1,-PGSFT		;CONVERT ARGUMENTS TO PAGE NUMBERS
	LSH T3,-PGSFT		;SO CAN COMPUTE PAGE COUNT
	SUBM T3,T1		;GET DIFFERENCE
	ADDI T1,1		;CREATE NUMBER OF PAGES TO DO
	MOVEM T1,IOLCNT		;REMEMBER COUNT
	ADDI T1,2(T1)		;DOUBLE COUNT SO CAN GUARANTEE CONTIGUOUS LIST
	HRLI T1,.RESP1		;NO SPECIAL PRIORITY
	MOVEI T2,.RESGP		;USE GENERAL STORAGE POOL
	CALL ASGRES		;GET SOME FREE CORE
	 RETBAD()		;FAILED
	MOVEM T1,IOLRES		;REMEMBER STORAGE ADDRESS
	MOVEI T2,1(T1)		;GET POSSIBLE STORAGE ADDRESS FOR CCWS
	ANDI T2,PGSIZ-1		;KEEP ONLY OFFSET WITHIN PAGE
	ADD T2,IOLCNT		;CREATE LAST OFFSET NEEDED
	CAIGE T2,PGSIZ		;IF LIST WAS HERE, WOULD IT FIT ON ONE PAGE?
	TDZA T2,T2		;YES, SET UP TO USE THIS FIRST HALF
	MOVE T2,IOLCNT		;NO, THEN SECOND HALF WILL BE CONTIGUOUS
	ADDI T2,1(T1)		;COMPUTE ADDRESS WHERE LIST WILL GO
	MOVN T3,IOLCNT		;NEGATE PAGE COUNT
	HRL T2,T3		;FINISH AOBJN POINTER
	MOVEM T2,0(T1)		;SAVE IN FIRST WORD OF STORAGE BLOCK
	; ..			;FALL INTO LOOP
;LOOP OVER ALL PAGES, LOCKING THEM DOWN AND REMEMBERING THE PAGE NUMBERS:


IOLLOP:	MOVEM T2,IOLCNT		;SAVE CURRENT AOBJN WORD
	MOVE T1,IOLADR		;GET CURRENT USER ADDRESS
	SKIPN IOLFLG		;WRITING FROM THE PAGE?
	XCTU [SKIP (T1)]	;YES, VERIFY THE PAGE EXISTS
	 ERJMP IOLFAI		;REFERENCE FAILED
	SKIPE IOLFLG		;READING INTO THE PAGE?
	XCTU [SETMM (T1)]	;YES, VERIFY PAGE IS WRITABLE
	 ERJMP IOLFAI		;NOPE, FAILED
	TXO T1,1B0		;INDICATE FROM USER MODE
	CALL MLKMA		;LOCK THE PAGE
	MOVE T2,IOLCNT		;GET BACK AOBJN POINTER
	MOVEM T1,0(T2)		;PUT PAGE NUMBER INTO STORAGE LIST
	MOVEI T1,PGSIZ		;GET SIZE OF A PAGE
	ADDM T1,IOLADR		;UPDATE USER ADDRESS FOR NEXT LOOP
	AOBJN T2,IOLLOP		;LOOP OVER ALL PAGES
	MOVE T1,IOLRES		;ALL DONE, GET STORAGE ADDRESS BACK
	RETSKP			;SKIP RETURN



;HERE IF ONE OF THE PAGES CANNOT BE REFERENCED.  UNLOCK ALL PAGES
;AND GIVE AN ERROR.


IOLFAI:	MOVE T1,IOLRES		;GET ADDRESS OF STORAGE BLOCK
	SETZM T2		;DON'T MARK PAGES AS BEING WRITTEN
	CALL IOPNLK		;UNLOCK ALL PAGES IN THE LIST
	MOVE T1,LSTERR		;GET ERROR CAUSED BY THE PAGE REFERENCE
	RETBAD()		;AND RETURN THAT
;IOLCCW - ROUTINE TO CONVERT A LIST OF PHYSICAL PAGE NUMBERS INTO A LIST
;OF CCW WORDS.  CALL:
;  P1/	CDB ADDRESS
;  T1/	ADDRESS OF STORAGE FOR PAGE LIST
;  T2/	USER ADDRESS
;  T3/	SIZE OF BUFFER IN WORDS
;RETURNS:
;  +1:	ALWAYS




IOLCCW::STKVAR <IOLOFS,IOLSIZ,IOLAOB>	;ALLOCATE STORAGE
	SKIPL T1,0(T1)		;GET AOBJN POINTER TO PAGE LIST
	RET			;NONE, RETURN
	MOVEM T1,IOLAOB		;REMEMBER IT FOR LATER
	ANDI T2,PGSIZ-1		;KEEP ONLY THE OFFSET INTO THE USER PAGE
	MOVEM T2,IOLOFS		;SAVE FOR LATER
	MOVEM T3,IOLSIZ		;AND SAVE SIZE OF BUFFER

IOLCLP:	MOVEI T1,PGSIZ		;GET SIZE OF A PAGE
	SUB T1,IOLOFS		;SUBTRACT OFFSET TO GET WORDS REMAINING IN PAGE
	CAMLE T1,IOLSIZ		;REMAINING BUFFER LESS THAN THAT?
	MOVE T1,IOLSIZ		;YES, REDUCE WORD COUNT
	MOVN T2,T1		;GET READY
	ADDM T2,IOLSIZ		;DECREMENT WORDS LEFT IN THE BUFFER
	HRLI T1,IRMWRD		;WANT WORD MODE
	MOVE T2,IOLAOB		;GET POINTER TO CURRENT LIST ELEMENT
	MOVE T2,0(T2)		;THEN GET PHYSICAL PAGE NUMBER
	LSH T2,PGSFT		;CONVERT INTO ADDRESS
	IOR T2,IOLOFS		;FINISH THE ADDRESS BY ADDING IN OFFSET
	HRRZ T3,CDBDSP(P1)	;GET CHANNEL DISPATCH ADDRESS
	HRRZ T3,CDSCCW(T3)	;AND THEN CCW ROUTINE
	CALL (T3)		;TRANSLATE ADDRESS AND COUNT INTO CCW VALUE
	MOVE T2,IOLAOB		;GET BACK AOBJN WORD
	MOVEM T1,(T2)		;STORE CCW WORD BACK INTO THE LIST
	AOBJP T2,R		;RETURN IF DID ALL WORDS
	MOVEM T2,IOLAOB		;MORE TO DO, SAVE UPDATED AOBJN WORD
	SETZM IOLOFS		;OFFSET IS NOW ZERO
	JRST IOLCLP		;GO DO NEXT PAGE
;IOCNLK AND IOPNLK - ROUTINES TO UNLOCK A LIST OF PAGES AND RETURN THE
;RESIDENT STORAGE.  USE IOPNLK IF LIST IS PAGE NUMBERS, OR USE IOCNLK IF
;THE LIST IS CCW WORDS.  MUST BE CALLED NOINT.  CALL:
;  P1/	CDB ADDRESS IF CALLING IOCNLK
;  T1/	ADDRESS OF LIST OF PAGES
;  T2/	NONZERO IF PAGES WERE WRITTEN INTO
;RETURNS:
;  +1:	ALWAYS



IOCNLK::HRRZ T3,CDBDSP(P1)	;GET DISPATCH ADDRESS FOR CHANNEL
	MOVE T3,CDSCCA(T3)	;THEN GET ROUTINE TO EXTRACT ADDRESS FROM CCW
	TXOA T3,IFIW		;MAKE SURE INDIRECT WORKS IN SECTION 1
IOPNLK::SETZ T3,		;OR INDICATE NO ROUTINE TO CALL
	SKIPL T4,(T1)		;GET AOBJN POINTER TO LIST
	CALLRET RELRES		;NONE THERE, JUST RELEASE STORAGE
	ASUBR <IOURES,IOUFLG,IOUCCW,IOLAOB>	;REMEMBER ARGUMENTS

IOUNLP:	MOVEM T4,IOLAOB		;SAVE UPDATED AOBJN WORD
	SKIPN T1,(T4)		;OBTAIN NEXT ELEMENT FROM LIST IF ANY
	JRST IOUNXT		;NONE THERE
	SKIPE T2,IOUCCW		;NEED TO CONVERT CCW TO PAGE NUMBER?
	CALL (T2)		;YES, FIRST EXTRACT ADDRESS FROM CCW
	SKIPE IOUCCW		;WELL?
	LSH T1,-PGSFT		;YES, TURN ADDRESS INTO PAGE NUMBER
	JUMPE T1,IOUNXT		;IF ZERO, NOTHING TO DO
	SKIPE IOUFLG		;WAS PAGE WRITTEN INTO?
	CALL MRKMPG		;YES, MARK IT AS BEING MODIFIED
	CALL MULKCR		;THEN UNLOCK THE PAGE
IOUNXT:	MOVE T4,IOLAOB		;GET BACK AOBJN WORD
	AOBJN T4,IOUNLP		;LOOP FOR NEXT ELEMENT
	MOVE T1,IOURES		;UNLOCKED EVERYTHING, GET BACK ADDRESS
	CALLRET RELRES		;RELEASE STORAGE BLOCK AND RETURN
	SUBTTL UDSKIO AND MDSKIO



;UDSKIO AND MDSKIO - GENERAL NON-PAGE ALIGNED DISK I/O ROUTINES.  USED
;FOR SPECIAL DISK I/O SUCH AS READING HOME BLOCKS, BAT BLOCKS, AND
;THE DSKOP JSYS.  CALL:
;  T1/	PHYSICAL DISK ADDRESS (SECTOR NUMBER)
;  T2/	FLAGS,,WORD COUNT  (FLAG DOP%WR MEANS WRITE)
;  T3/	PHYSICAL MEMORY ADDRESS (OR ADDRESS OF LIST OF CCW WORDS FOR MDSKIO)
;  T4/	IF 1B0 SET IN T2:  CKU NUMBER OF UNIT FOR I/O
;	IF 1B0 CLEAR IN T2:  STRUCTURE NUMBER
;RETURNS:  +1:	ALWAYS
;	  T1/	ZERO IF SUCCESSFUL, ERROR BITS IF I/O FAILED
;
;RESTRICTIONS:  MDSKIO CAN CROSS ARBITRARY PAGE BOUNDARIES, BUT THE
;TOTAL NUMBER OF WORDS READ/WRITTEN MUST BE AN EXACT MULTIPLE OF THE
;DISK SECTOR SIZE.  MDSKIO ALSO CANNOT DO ERROR RECOVERY OR ERROR LOGGING.
;UDSKIO CAN READ PARTIAL SECTORS, AND DOES ERROR RECOVERY AND LOGGING,
;BUT THE I/O CANNOT CROSS A PAGE BOUNDARY.  ALSO FOR WRITES, THE COUNT
;IS MODIFIED SO THAT AN EXACT MULTIPLE OF DISK SECTORS IS WRITTEN (THIS
;IS NECESSARY TO PREVENT PARITY ERRORS FROM THE CHANNEL).  THEREFORE,
;TO WRITE OUT THE HOME AND BAT BLOCKS, IT IS NECESSARY TO BEGIN THE
;WRITE AT THE TOP OF A PAGE SO THAT THE TRANSFER WON'T TRY TO GO OFF
;THE END OF THE PAGE FOR AN RP20.


MDSKIO::SAVEPQ			;SAVE ACCUMULATORS
	SKIPL Q3,0(T3)		;GET AOBJN WORD TO CCW LIST
	 JSP T1,UIOILA		;NONE, THEN FAIL
	JRST UIO0		;PROCEED

UDSKIO::SAVEPQ			;SALT AWAY ACCUMULATORS
	SETZM Q3		;SAY NO LIST EXISTS
UIO0:	SE0ENT			;USE SEC0 FOR PHYSIO CALLS
	DMOVE P5,T2		;SAVE FLAGS, COUNT, AND MEMORY ADDRESS
	CALL GETIRB		;GET IORB+CCW BLOCK IN P4, WAIT IF NEEDED
	TLZ T1,DSKMSK		;CLEAR UNUSED BITS
	TXO T1,DSKAB		;AND SET DISK ADDRESS BIT
	MOVEM T1,IRBADR(P4)	;STORE DEVICE ADDRESS
	HRRZM P5,IRBCNT(P4)	;STORE COUNT IN IORB
	MOVEI T1,IRFRED		;SEE IF READ OR WRITE
	TXNE P5,DOP%WR		; ...
	MOVEI T1,IRFWRT		;IS WRITE.
	DPB T1,IRYFCN		;STORE IN IORB
	MOVEI T1,IRMWRD		;WORD MODE
	DPB T1,IRYMOD		;STORE IN IORB
	MOVEI T1,0		;COPY INHIBIT ERR LOG OR RECOVERY BITS
	TXNE P5,DOP%IR		;INHIBIT ERROR RECOVERY?
	TXO T1,IS.IER		;YES, INHIBIT IT
	TXNE P5,DOP%IL		;INHIBIT ERROR LOGGING?
	TXO T1,IS.IEL		;YES
	SKIPE Q3		;CALLED AT MDSKIO?
	TXO T1,IS.IER!IS.IEL	;YES, DISABLE ERROR RECOVERY AND LOGGING
	IORM T1,IRBSTS(P4)	;STORE IN IORB
	MOVEI T1,0		;NO SIO EXIT NEEDED UNLESS
	TXNE P5,DOP%EO		;USER ASKED FOR ERROR ON OFFLINE
	MOVEI T1,UDISIE		;CALLER WANTS ERROR
	HRLM T1,IRBIVA(P4)	;STORE EXIT OR NOT
	JUMPGE P5,[CALL GETCUB	;IF STRUCTURE ADDRESS, COMPUTE UNIT ADDRESS
		 JSP T1,UIOILA	;IT WAS ILLEGAL
		MOVEM T1,IRBADR(P4)	;SAVE UNIT RELATIVE ADDRESS
		JRST UIO2]	;AND PROCEED WITH P1, P2, AND P3 SET UP
	MOVE T1,T4		;WANTS PHYSICAL UNIT, COPY CKU NUMBER
	CALL CKUNPK		;UNPACK THEM
	CALL CHKCKU		;VERIFY A LEGAL UNIT WAS SELECTED
	 JSP T1,UIONUN		;NOPE, FAIL
	MOVE P3,T1		;COPY UDB ADDRESS
	HRRZ P2,UDBKDB(P3)	;SET UP KDB POINTER
	HRRZ P1,UDBCDB(P3)	;AND CDB POINTER
	MOVSI T1,DSKMSK		;INVALID BITS IN DISK ADDRESS
	ANDCAB T1,IRBADR(P4)	;CLEAR THE BITS AND GET DISK ADDRESS
	HRRZ T2,UDBSIZ(P3)	;GET POINTER TO SIZE TABLES
	CAML T1,SECUNT(T2)	;LEGAL DISK ADDRESS SPECIFIED?
	 JSP T1,UIOILA		;NOPE, FAIL
UIO2:	TXNN P5,DOP%EO		;WANT ERROR ON OFFLINE?
	JRST UIO3		;NO, PROCEED
	MOVE T1,UDBSTS(P3)	;YES, GET UNIT STATUS
	MOVE T2,CDBSTS(P1)	;AND CHANNEL STATUS
	TXNN T1,US.OFS!US.CHB	;UNIT OFFLINE?
	TXNE T2,CS.OFL		;OR CHANNEL OFFLINE?
	 JSP T1,UIOUFL		;YES, RETURN ERROR
UIO3:	HRRZ Q2,UDBSIZ(P3)	;SET UP POINTER TO UNIT SIZE TABLE
	TXNN P5,DOP%WR		;WRITING?
	JRST UIO5		;NO, CAN SKIP ON
	MOVEI T1,PGSIZ		;GET SIZE OF PAGE
	IDIV T1,SECPAG(Q2)	;COMPUTE SIZE OF A SECTOR
	TRNN P5,-1(T1)		;WRITING PARTIAL SECTOR?
	JRST UIO5		;NO, SKIP ON
	SKIPE Q3		;CALLED AT MDSKIO?
	 JSP T1,UIONDS		;YES, ERROR IF NOT EXACT SECTOR SIZE
	IORI P5,-1(T1)		;INCREMENT COUNT TO JUST BELOW NEXT SECTOR
	HRRI P5,1(P5)		;THEN TURN INTO EXACT MULTIPLE OF A SECTOR
	HRRZM P5,IRBCNT(P4)	;UPDATE COUNT IN IORB TOO
	MOVE T1,P6		;COPY MEMORY ADDRESS
	ANDI T1,PGSIZ-1		;LEAVE ONLY THE OFFSET INTO THE PAGE
	ADDI T1,(P5)		;ADD IN NEW COUNT
	CAILE T1,PGSIZ		;TRYING TO DO I/O OFF THE PAGE?
	 JSP T1,UIOOPB		;YES, FAIL
UIO5:	MOVE T1,IRBADR(P4)	;GET DISK ADDRESS OF BEGINNING OF TRANSFER
	IDIV T1,SECCYL(Q2)	;COMPUTE CYLINDER THIS SECTOR IS ON
	MOVE T2,IRBCNT(P4)	;GET WORD COUNT
	MOVEI T3,PGSIZ		;SIZE OF A PAGE
	IDIV T3,SECPAG(Q2)	;COMPUTE SECTOR SIZE FOR UNIT
	ADDI T2,-1(T3)		;ROUND UP PARTIAL SECTORS
	IDIV T2,T3		;COMPUTE NUMBER OF SECTORS I/O IS FOR
	ADD T2,IRBADR(P4)	;ADD ORIGINAL SECTOR TO THIS
	SOS T2			;FINALLY GET DISK ADDRESS OF END OF TRANSFER
	IDIV T2,SECCYL(Q2)	;COMPUTE CYLINDER THIS SECTOR IS ON
	CAME T1,T2		;WOULD WHOLE TRANSFER BE ON SAME CYLINDER?
	 JSP T1,UIOILA		;NO, FAIL
	JUMPE Q3,UIO6		;SKIP ON IF CALLED AT UDSKIO
	HRRZM Q3,IRBXFL(P4)	;STORE FIRST CCW WORD ADDRESS AS HEAD
	HLRE T1,Q3		;EXTRACT NEGATIVE LENGTH OF CCW LIST
	SUBM Q3,T1		;COMPUTE END OF CCW LIST
	HRLM T1,IRBXFL(P4)	;STORE ADDRESS AS TAIL
	SETZM IRBLEN(P4)	;CLEAR NORMAL CCW LOCATION SINCE NOT USED
	JRST UIO7		;PROCEED

UIO6:	MOVEI T1,IRBLEN(P4)	;BUILD TAIL,,HEAD OF CCW LIST
	HRLI T1,IRBLEN+1(P4)	; ...
	MOVEM T1,IRBXFL(P4)	;STORE
	DMOVE T1,P5		;RETRIEVE WORD COUNT AND PHYSICAL ADDRESS
	HRLI T1,IRMWRD		;INSERT WORD MODE
	HRRZ T3,CDBDSP(P1)	;GET DISPATCH BASE
	CALL CDSCCW(T3)		;BUILD CCW INTO T1
	MOVEM T1,IRBLEN(P4)	;STORE AS FIRST WORD OF CCW LIST

UIO7:	SETZM IRBLEN+1(P4)	;CLEAR SECOND WORD OF CCW LIST
	MOVEI T1,UDIINT		;INTERRUPT ROUTINE TO CALL
	HRRM T1,IRBIVA(P4)	;STORE IN IORB
	MOVE T1,P4		;GET IORB FOR STARTING IO
	MOVE T2,P3		;ALSO GET UDB
	NOSKED			;PREVENT INTERRUPTIONS
	CALL PHYSIO		;START THE IO
	OKSKED
UIO4:	MOVEI T1,UDWDON		;WAIT FOR DONE
	HRL T1,P4		;ON THIS IORB
	PDISMS			; AS A PAGE FAULT
	MOVE T1,IRBSTS(P4)	;EXAMINE STATUS BITS
	TXNN T1,IS.DON		;CONDITION SATISFIED?
	JRST UIO4		;NO - BLOCK AGAIN
	TXNN T1,IS.ERR		;ANY ERRORS?
	MOVEI T1,0		;NO - RETURN 0
UIOXIT:	CALL GIVIRB		;RELEASE THIS IORB
	SE1CAL			;RETURN TO CALLER SECTION
	RET
;HERE FOR VARIOUS UDSKIO ERRORS.  FOR DEBUGGING PURPOSES, THE PC OF
;THE ERROR IS RETURNED IN THE RIGHT HALF OF T1, AND -1 IN THE LEFT HALF.
;THIS IS DONE BY DOING A "JSP T1,ERROR" TO ANY OF THE ERROR ADDRESSES.
;(BUT CURRENT CALLERS ONLY CHECK FOR A NONZERO OR NEGATIVE RESULT).

UIOOPB:
UIONCH:
UIONUN:
UIOCFL:
UIOUFL:
UIOILA:
UIONDS:	HRROI T1,-1(T1)		;NON DISK ERROR CODE (-1,,PC)
	JRST UIOXIT

;HERE JUST BEFORE SIO OF UDSKIO REQUEST
;CHECK IF UNIT OFFLINE

UDISIE:	MOVX T1,US.OFS!US.CHB	;UNIT ACCESSABLE
	TDNN T1,UDBSTS(P3)	; ???
	RETSKP			;YES - GO AHEAD
	MOVX T1,IS.ERR!IS.NRT	;NO, GET ERROR BITS
	IORM T1,IRBSTS(P4)	;STORE INTO IORB
	RET			;FAIL RETURN

;HERE AT INTERRUPT LEVEL WHEN REQUEST COMPLETED

UDIINT:	AOS PSKED		;FLAG SCHEDULER
	RET

;HERE TO GET AN IORB FROM THE POOL
;	CALL GETIRB
;RETURNS+1(ALWAYS):
;P4/ IORB + CCW BLOCK (LENGTH UIOLEN)
;CLOBBERS P3

GETIRB:	SKIPN NSKED		;NOSKED?
	JRST GETIR1		;NO - USUAL CASE
	SKIPN UIOLST		;YES - ANY LEFT
	BUG(UIONIR)
	MOVE P4,@UIOLST		;GET SUCCESSOR
	EXCH P4,UIOLST		;NOW HEAD OF LIST
	JRST GETIR2		;CLEAR IORB AND RETURN

GETIR1:	NOSKED			;INTERLOCK LIST MANIPULATION
	SKIPN UIOLST		;LIST NONNULL?
	JRST GETIR3		;NO.
	SKIPN P4,@UIOLST	;TEST/GET SUCCESSOR
	JRST GETIR3		;NO SUCCESSOR - FORCE BLOCK
	EXCH P4,UIOLST		;NEW HEAD OF LIST
	OKSKED			;RELEASE PROCESSOR
GETIR2:	SETZM 0(P4)		;CLEAR FIRST WORD OF BLOCK
	MOVS P3,P4		;BUILD BLT POINTER
	HRRI P3,1(P4)		; ...
	BLT P3,UIOLEN-1(P4)	;CLEAR BLOCK
	RET

GETIR3:	OKSKED			;WE MUST BLOCK
	CALL UDIWAT		; ...
	JRST GETIR1		;AND TRY AGAIN

;SCHEDULER TEST ROUTINE, WAITS FOR IORB DONE BIT

UDWDON::MOVX T2,IS.DON		;CHECK DONE BIT
	TDNN T2,IRBSTS(T1)	;IN IORB
	JRST 0(T4)		;STILL WAITING
	JRST 1(T4)		;ALL DONE

;HERE WHEN THE IORBS ARE IN USE. WAIT FOR THEM TO BECOME FREE

UDIWAT:	SAVET			;SAVE ARGUMENTS
UDIWT1:	MOVEI T1,UDITST		;WAIT FOR FREE IORB
	MDISMS			;ORDINARY BLOCK - MAY BE LONG TERM
	RET			;FREE, LOCK ACQUIRED

;SCHEDULE TEST TO WAIT FOR IORB

UDITST:	SKIPE T1,UIOLST		;LIST NON NULL
	SKIPN (T1)		;AT LEAST 2 FREE?
	JRST 0(T4)		;NO
	JRST 1(T4)		;YES

;HERE TO RELEASE AN IORB TO THE FREE LIST

GIVIRB:	NOSKED
	EXCH P4,UIOLST		;NEW HEAD OF LIST
	MOVEM P4,@UIOLST	;STORE FOREWARD LINK
	OKSKED
	RET
	SUBTTL PAGEM INTERFACE

;HERE TO TRANSFER A PAGE
;T1/ CPN	;1B0 ON IF WRITE
;	CALL DSKIO, DRMIO
;RETURNS+1(ALWAYS)

DSKIO::
DRMIO::	PUSH P,P4		;SAVE P4, IORB MUST BE IN P4 FOR IRYFCN
	PUSH P,T1		;SAVE T1 FOR PAGEM
	MOVX T2,DWRBIT		;COPY WRITE BIT TO CST3 FOR PAGEM
	AND T2,T1		; ...
	IORM T2,CST3(T1)	; ...
	MOVEI P4,CST5(T1)	;PUT IORB ADDRESS IN P4
	MOVX T2,IS.SHT		;FLAG AS SHORT IORB
	MOVEM T2,IRBSTS(P4)	;INITIALIZE IORB
	MOVEI T2,IRFRED		;SET IORB FUNCTION
	TXNE T1,DWRBIT		;WRITE?
	MOVEI T2,IRFWRT		;YES
	DPB T2,IRYFCN		;STORE IN IORB
	MOVE T1,P4		;COPY IORB ADDRESS
	CALL PHYSIO		;NOTE - ALREADY NOSKED
	POP P,T1		;RESTORE T1
	POP P,P4		;RESTORE P4
	RET

;HERE TO QUEUE A LIST OF PAGES FOR SWAPPER
;T1/ DWRBIT,,FIRST PAGE CST INDEX
;	CALL DXXIOM
;RETURNS+1(ALWAYS):
;	WHOLE LIST STARTED

DSKIOM::
DRMIOM::PUSH P,P4		;SAVE VARIABLE FOR POINTER
IOMNXT:	HRRZ P4,CST3(T1)	;GET FORWARD LINK
	HLLZS CST3(T1)		;CLEAR FORWARD LINK IN MEMORY
	CALL DRMIO		;INSERT REQUEST
	JUMPE P4,IOMXIT		;WAS LINK NULL
	SUBI P4,CST3		;NO - GET CST INDEX
	HRR T1,P4		;COPY (NOTE: DWRBIT IS STILL IN LH(T1))
	JRST IOMNXT		;LOOP

IOMXIT:	POP P,P4		;RESTORE
	RET

DRMINI::SETOM DRMJ0R		;SO OLD ERROR LOGGER IS HAPPY
	SKIPG DRUMP
	TDZA T1,T1		;NO DRUMS UNLESS DRUMP .GT. 0
	MOVE T1,DRMNUM		;GET NUMBER OF DRUMS FROM RS4INI
	MOVEM T1,NPDRMS		;STORE FOR REST OF WORLD
	RET
	SUBTTL OPERATOR INTERVENTION, RESTART AND TIMEOUT


;ENTERED FROM SCHEDULER WHEN PHYTIM GT TODCLK.


PHYCHK::SAVEPQ			;SAVE ACCUMULATORS
	SE0ENT			;MAY CALL LOWER LEVELS, USE SEC0
	MOVEI T1,^D1000		;UPDATE NEXT CALL
	MOVEM T1,PHYTIM		; ...
	AOS T1,PHYSEC		;INCREMENT LOCAL ONCE A MINUTE TIMER
	CAILE T1,^D59		;AND IF EXPIRED,
	SETZM PHYSEC		;WRAPAROUND
	MOVX T1,IS.DON		;IS HOME BLOCK CHECK IORB DONE?
	SKIPE CHBUDB		;IS A UNIT BEING CHECKED FOR HOME BLOCK
	TDNN T1,CHBIRB		;DONE?
	SKIPA			;NO TO EITHER QUESTION
	JRST CHK7		;YES TO BOTH
	MOVE T1,CHBODT		;NOW CHECK HOME BLOCK IORB OVERDUE
	CAMGE T1,TODCLK		; ...
	SKIPN CHBUDB		;IS HOME BLOCK CHECKER ACTIVE?
	SKIPA			;NO TO EITHER QUESTION
	JRST CHK3		;APPARENTLY OVERDUE - INVESTIGATE FURTHER
CHK0:	MOVSI Q1,-CHNN		;LOOP OVER ALL CHANNELS
CHK1:	SKIPN P1,CHNTAB(Q1)	;IS THIS CHANNEL PRESENT?
	JRST CHK2		;NO - TRY NEXT
	MOVX T1,CS.OFL!CS.MAI	;CHANNEL OFFLINE OR IN MAINTENENCE MODE?
	TDNE T1,CDBSTS(P1)	;OR HAVE NO UNITS?
	JRST CHK2		;YES - IGNORE IT.
	HRRZ T1,CDBDSP(P1)	;GET CHANNEL DISPATCH
	CALL CDSCHK(T1)		;AND CALL PERIODIC CHECKER
	CALL DGUMAP		;FOR EACH UNIT,
	 CALL UNICHK		;DO CHECK CODE
CHK2:	AOBJN Q1,CHK1		;AND LOOP FOR ALL CHANNELS
	SE1CAL			;RETURN
	RET			;DONE

;HERE WHEN THE HOME BLOCK CHECK IORB SEEMS TO BE OVERDUE

CHK3:	IOPIOF			;INTERLOCK CHECKS
	SKIPE P3,CHBUDB		;GET UNIT BEING CHECKED
	JRST CHK5		;IF THERE IS STILL ONE
CHK4:	IOPION			;RESTORE INTERRUPTS
	JRST CHK0		;AND CONTINUE CHECKS

CHK5:	MOVE T1,CHBODT		;RE-CHECK OVERDUE TIMER
	CAML T1,TODCLK		;INCASE CHANGED
	JRST CHK4		;NO LONGER OVERDUE
	MOVX T1,US.ACT		;IS THIS UNIT ACTIVE?
	TDNN T1,UDBSTS(P3)	; ???
	JRST CHK6		;NO
	HRRZ P1,UDBCDB(P3)	;YES - GET CHANNEL
	HRRZ T1,UDBTWQ(P3)	;GET CURRENT TWQ HEAD
	CAIE T1,CHBIRB		;IS IT SPECIAL IORB?
	JRST CHK6		;NO - JUST REMOVE REQUEST
	BUG(PHYCH2)
	CALL HNGIRB		;TERMINATE IORB IN T1
	JRST CHK4		;RESTORE PI AND CONTINUE
CHK6:	BUG(PHYCH3)
	CALL CLRCHB		;CLEAR HOME BLOCK CHECK DATA
	JRST CHK4		;AND CONTINUE CHECKS

;HERE IF THE HOME BLOCK CHECK IORB IS DONE.

CHK7:	HRRZ P3,CHBUDB		;GET UNIT BEING CHECKED
	HRRZ P2,UDBKDB(P3)
	HRRZ P1,UDBCDB(P3)	;GET CHANNEL UNIT IS ON
	MOVX T1,IS.ERR		;ANY ERRORS?
	TDNE T1,CHBIRB+IRBSTS	;???
	JRST CHKA		;YES - COMPLAIN
	SKIPGE Q1,UDBSTR(P3)	;GET STR UNIT IS IN
	JRST CHK9		;UNIT NO LONGER IN STR
	MOVE Q1,STRTAB(Q1)	;GET SDB
	MOVE T1,CHBHB1+HOMNAM	;CHECK HOME BLOCK NAME AND CODE
	MOVE T2,CHBHB2		;GET HOMCOD (SYMBOL? )
	CAMN T1,[SIXBIT /HOM/]	;BLOCK NAME GOOD?
	CAIE T2,CODHOM		;BLOCK CODE GOOD?
	JRST CHK8		;NO TO EITHER
	MOVE T1,CHBHB1+HOMSNM	;CHECK STRUCTURE NAME
	MOVE T2,CHBHB1+HOMMID	;AND "UNIQUE" ID
	CAMN T1,SDBNAM(Q1)	;SAME NAME?
	CAME T2,SDBPUC(Q1)	;SAME CODE?
	JRST CHK8		;NO TO EITHER
	HRRZ T1,CHBHB1+HOMLUN	;CHECK IF SAME UNIT
	CAILE T1,MXSTRU		;LESS THAN MAXIMUM?
	JRST CHK8		;NO
	ADDI T1,SDBUDB(Q1)	;YES - GET POINTER TO UDB
	HRRZ T1,(T1)		;GET UDB
	HLRZ T2,CHBHB1+HOMLUN	;GET NUMBER OF UNITS
	CAMN T1,P3		;SAME UNIT AS THIS?
	CAME T2,SDBNUM(Q1)	;SAME TOTAL NUMBER?
	JRST CHK8		;NO TO EITHER
	MOVX T1,US.OMS		;SEEMS TO MATCH, PREVENT ANY
	IORM T1,UDBSTS(P3)	;DEADLOCK
	MOVX T1,US.CHB		;NO LONGER NEED CHECKING, ALLOW I/O
	ANDCAM T1,UDBSTS(P3)	; ...
CHKX:	CALL CLRCHB		;RESET HOME BLOCK CHECK DATA
	JRST CHK0		;AND DO USUAL TIMER THING

;HERE WHEN THE HOME BLOCK MISCOMPARES OR IS ILL FORMED

CHK8:	HRROI T1,[ASCIZ /
%Wrong pack on device:/]	;SLIGHTLY MISLEADING MESSAGE
	SKIPE PHYSEC		;ONLY REPORT ONCE A MINUTE
	JRST CHKX		;NOT TIME
	CALL UNIMES		;USE COMMON MESSAGE TAIL
	AOS PHYSEC		;CROCK COMPENSATION FOR TTEMES
	JRST CHKX		;AND JOIN NORMAL CHECKS

;HERE WHEN UNIT CHANGED STRUCTURE STATUS (FORCE REMOVAL?)

CHK9:	MOVX T1,US.CHB		;CLEAR CHECK HOME BLOCK BIT
	ANDCAM T1,UDBSTS(P3)	; ...
	JRST CHKX		;AND DO NORMAL CHECKS

;HERE WHEN AN IO ERROR OCCURS READING A HOME BLOCK

CHKA:	HRROI T1,[ASCIZ /
%Error reading HOME block on device:/]
	SKIPE PHYSEC		;PREVENT OUTPUT OVERLOAD
	JRST CHKX		;EXIT
	CALL UNIMES		;APPEND STOCK TRAILER
	AOS PHYSEC
	JRST CHKX

;HERE TO CLEAR HOME BLOCK CHECKING DATABASE

CLRCHB:	SETZM UDBCHB(P3)	;CLEAR SPECIAL IORB
	SETZM CHBODT		;CLEAR TIMER
	MOVEM P3,CHBLUC		;SETUP LAST UNIT CHECKED CELL
	SETZM CHBUDB		;CLEAR CURRENT CHECK UDB
	MOVX T1,IS.DON		;CLEAR DONE FLAG
	ANDCAM T1,CHBIRB+IRBSTS	; ...
	RET
;HERE FOR EACH UNIT. CHECK IF OPERATOR MESSAGE NEEDED OR RESTART NEEDED.
;IF UNIT IS ACTIVE, CHECK OVERDUE TIMER AND RESET IF HUNG.  SEE IF THE
;CONTROLLER FOR THE UNIT NEEDS TO BE RESTARTED.
;PRESERVES Q1 AND Q3


UNICHK:	TRNE P2,-1		;IS THERE A CONTROLLER?
	SKIPE PHYSEC		;AND IS THIS A MINUTE BOUNDARY?
	JRST UNICH1		;NO, SKIP ON
	HRRZ T1,KDBDSP(P2)	;GET DISPATCH ADDRESS
	TLON P2,-1		;CHECK IF FIRST TIME FOR THIS CONTROLLER
	CALL UDSCCK(T1)		;YES, CHECK IT OUT THEN

UNICH1:	MOVE T1,UDBSTS(P3)	;GET STATUS FOR CHECKING
	TXNE T1,US.MAI		;UNIT IN MAINTENENCE MODE?
	JRST UNICK5		;YES, DISABLE USUAL CHECKS
	TXNE T1,US.MRQ		;MAINTENENCE MODE REQUESTED?
	JRST UNICK6		;YES, CHECK IF NOW ALLOWED
	TXNE T1,US.CHB		;DOES THIS UNIT NEED ITS HOME BLOCKS CHECKED?
	JRST UNICK7		;YES, SEE WHAT CAN BE DONE
	TXNE T1,US.PSI		;PSI REQUESTED?
	CALL UNIPSI		;YES, INIT PSI SEQUENCE
UNICK0:	MOVX T1,US.OIR		;OPER INTERVENTION REQUEST?
	TDNN T1,UDBSTS(P3)	; ??
	JRST UNICK3		;NO - TRY OTHER CASES
	ANDCAM T1,UDBSTS(P3)	;YES - RESET BIT
	CALL UNITRY		;ATTEMPT TO RESTART IO
	 SKIPA			;ATTEMPT FAILED OR INDETERMINATE
	JRST UNIOK		;SUCCESS.
	MOVX T1,US.OMS		;OPERATOR MESSAGE ON MINUTE?
	TDNE T1,UDBSTS(P3)	; ??
	JRST UNICK2		;YES - CHECK FOR MINUTE
	IORM T1,UDBSTS(P3)	;NO - REQUEST IT AND PRINT MESSAGE NOW
UNICK1:	HRROI T1,[ASCIZ/
%Write-locked drive: /]		;GET POSSIBLE MESSAGE
	MOVE T2,UDBSTS(P3)	;GET UNIT STATUS
	TXNN T2,US.OFS!US.CHB!US.MAI!US.MRQ!US.TAP	;OFF-LINE OR A TAPE?
	TXNN T2,US.WLK		;OR NOT WRITE-LOCKED?
	HRROI T1,[ASCIZ /
%Problem on device: /]		;YES, GET STANDARD MESSAGE INSTEAD
	CALL UNIMES		;TYPE THE MESSAGE
	RET			;AND EXIT THIS UNIT

UNICK2:	SKIPN PHYSEC		;MINUTE BOUNDRY?
	JRST UNICK1		;YES - PRINT MESSAGE
	RET			;NO - EXIT THIS UNIT

UNICK3:	MOVX T1,US.OMS		;OPERATOR MESSAGE ON MINUTE?
	TDNN T1,UDBSTS(P3)	; ??
	JRST UNICKT		;NO - CHECK TIMEOUT
	CALL UNITRY		;DO RETRY
	 JRST UNICK2		;FAILED - DO RETRY
UNIOK:	MOVX T1,US.OMS		;SUCCESS, CLEAR MESSAGE BIT
	ANDCAM T1,UDBSTS(P3)	; ...
	RET			;DONE WITH THIS UNIT

UNIPSI:	MOVX T1,US.PSI		;GET PSI BIT
	ANDCAB T1,UDBSTS(P3)	;CLEAR BIT AND GET STATUS BITS
	TXNN T1,US.TAP		;IS THIS A TAPE?
	JRST UNIDPS		;NO -- HANDLE DISK ONLINE/OFFLINE
	MOVEI T3,MTCUTB		;LOOK THRU TABLE AND FIND CORRECT UNIT
	SETZ T4,0		;COUNT OF MTA'S
UNIPS2:	HRRZ T1,0(T3)		;GET UDB ADDRESS
	CAIN P3,0(T1)		;THIS UNIT?
	JRST UNIPSF		;YES SEE IF PSI NECESSARY
	AOS T4			;NEXT UNIT
	CAIGE T4,MTAN		;CHECK FOR ALL DONE
	AOJA T3,UNIPS2
	RET			;NO MORE QUIT

UNIPSF:	HRRZ T1,MTPSFK(T4)	;GET PSI CHANNEL
	HLRZ T2,MTPSFK(T4)	;GET FORK
	JUMPE T2,R		;QUIT IF NOT INITALIZED
	CALLRET	PSIRQ		;REQUEST PSI

UNIDPS:	HRRZ T1,DSPSFK		;GET DISK PSI REQUEST
	HLRZ T2,DSPSFK		;GET FORK
	JUMPE T2,R		;IF NONE THIS IS NOT LEGAL
	CALLRET PSIRQ		;REQUEST PSI
;HERE TO CHECK TIMER


UNICKT:	MOVX T1,US.ACT		;UNIT NOW ACTIVE?
	TDNN T1,UDBSTS(P3)	; ??
	RET			;NO - ALL DONE
	MOVE T1,UDBODT(P3)	;CHECK OVERDUE TIME
	CAML T1,TODCLK		;AGAINST PRESENT TIME
	RET			;NOT OVERDUE
	SAVEQ			;OVERDUE - SAVE Q ACCUMULATORS
	MOVX Q1,US.ACT		;PREPARE FOR PIOFF TESTS
	IOPIOF			;INTERLOCK AGAINST RACE
	MOVE T1,UDBODT(P3)	;GET OVERDUE TIME AGAIN
	CAMGE T1,TODCLK		;CHECK STILL OVERDUE
	TDON Q1,UDBSTS(P3)	;AND STILL ACTIVE (WHILE GETTING STATUS)
	JRST ONRET		;NOT BOTH - LOST RACE, USER WON.
	HRRZ T4,UDBERR(P3)	;GET FUNCTION CODE IF IN ERROR RECOVERY
	JUMPN T4,UNIOV0		;PROCEED IF NONZERO
	CALL SETIRB		;IF NOT, FIND IORB
	MOVEI T4,IRFSEK		;ASSUME DOING A SEEK
	TXNN Q1,US.TAP		;DEVICE A TAPE?
	TXNN Q1,US.POS		;OR OPERATION IS A TRANSFER?
	LDB T4,IRYFCN		;YES, GET FUNCTION FROM IORB INSTEAD
UNIOV0:	CALL FNDCKU		;FIND CHANNEL, CONTROLLER, AND UNIT NUMBERS
	BUG(OVRDTA,<<T1,CHAN>,<T2,CONTRL>,<T3,UNIT>,<T4,FUNC>>)	;COMPLAIN
	TXNE Q1,US.POS		;CHECK SEEK OR TRANSFER THAT LOST
	CALL OFFPWQ		;WAS SEEK, PULL IORB
	TXNN Q1,US.POS		;WELL?
	CALL OFFTWQ		;WAS TRANSFER, PULL IORB
	CALL HNGIRB		;TERMINATE HUNG IORB AND RESTART CHAN
ONRET:	IOPION			;AT LONG LAST
	RET

UNICK5:	IOPIOF			;INTERLOCK CHECK
	MOVE T1,UDBODT(P3)	;CHECK OVERDUE TIME
	JUMPE T1,ONRET		;UNTIMED
	CAML T1,TODCLK		;CHECK AGAINST NOW
	JRST ONRET		;STILL OK
	MOVE T1,UDBONR(P3)	;GET OWNING FORK
	HRRZ T1,FKJOB(T1)	;GET JOB
	CALL ELOGOO		;LOGOUT OUT THAT JOB
	IOPION
	RET

UNICK6:	MOVX T1,US.ACT		;CHECK IF UNIT STILL ACTIVE
	TDNE T1,UDBSTS(P3)	; ??
	JRST UNICK0		;YES - PERFORM USUAL CHECKS
	MOVX T1,US.MAI		;NO, SET IT INTO MAINTENENCE MODE
	IORM T1,UDBSTS(P3)	; ...
	RET			;AND CONTINUE SCAN
;HERE WHEN A UNIT NEEDS ITS HOME BLOCKS CHECKED

UNICK7:	SKIPE CHBUDB		;IS A UNIT CURRENTLY BEING CHECKED?
	JRST UNICK0		;YES - CONTINUE OTHER CHECKS
	CAME P3,CHBLUC		;NO - WAS THIS UNIT THE LAST ONE CHECKED
	JRST UNICK8		;NO - ATTEMPT CHECKS
	SETZM CHBLUC		;YES - BYPASS THIS TIME
	JRST UNICK0		;AND CONTINUE CHECKS

UNICK8:	SKIPGE UDBSTR(P3)	;IS THIS UNIT NOW PART OF A STR?
	JRST UNICKA		;NO - CLEAR CHECK REQUEST
	MOVX T1,US.OFS!US.ACT!US.MAI	;IS THIS UNIT OFFLINE OR ACTIVE?
	IOPIOF			;INTERLOCK TESTS
	TDNE T1,UDBSTS(P3)	; ???
	JRST UNICK9		;YES - CANNOT CHECK
	HRRZM P3,CHBUDB		;STORE THIS UNIT AS CURRENTLY CHECKED
	MOVEI T1,^D20000	;SET TIMEOUT FOR 20 SECONDS
	ADD T1,TODCLK		; ...
	MOVEM T1,CHBODT		;STORE OVERDUE TIME
	MOVE T1,[CHBIRB,,CHBIRB+1] ;SETUP TO CLEAR IORB
	SETZM CHBIRB		;CLEAR IORB
	BLT T1,CHBIRB+IRBLEN-1	; ...
	MOVEI P4,CHBIRB		;GET IORB IN STANDARD PLACE
	MOVEI T1,IRFRED		;GET READ FUNCTION CODE
	DPB T1,IRYFCN		;STORE IN IORB
	MOVEI T1,IRMWRD		;GET WORD MODE
	DPB T1,IRYMOD		;STORE IN IORB
	MOVX T1,IS.IEL		;INHIBIT ERROR LOGGING
	IORM T1,IRBSTS(P4)	; ...
	MOVEI T1,HBLEN		;SETUP COUNT
	HRRZM T1,IRBCNT(P4)	; ...
	MOVE T1,[CHBCCL+1,,CHBCCL] ;GET TAIL+1,,HEAD OF CHANNEL COMMAND LIST
	MOVEM T1,IRBXFL(P4)	;STORE IN IORB
	MOVE Q1,UDBSTR(P3)	;GET STRUCTURE NUMBER
	MOVE Q1,STRTAB(Q1)	;GET SDB
	MOVEI T2,HM1BLK		;GET ADDRESS OF PRIMARY HOME BLOCK
	MOVX T1,HB%1OK		;WAS PRIMARY HOME BLOCK GOOD?
	TDNN T1,SDBSTS(Q1)	; ???
	MOVEI T2,HM2BLK		;NO - ATTEMPT READ OF SECONDARY
	MOVEM T2,IRBADR(P4)	;STORE ADDRESS DECIDED UPON
	MOVEI T1,CHBINT		;INTERRUPT ROUTINE
	MOVEM T1,IRBIVA(P4)	; STORE IN IORB
	MOVSI T1,IRMWRD		;SETUP TO BUILD FIRST CCW
	HRRI T1,HBLEN		;COUNT
	MOVEI T2,CHBHB1		;ADDRESS 
	HRRZ T3,CDBDSP(P1)	;GET CHANNEL DISPATCH
	CALL CDSCCW(T3)		;BUILD CCW
	MOVEM T1,CHBCCL		;STORE IN CHANNEL COMMAND LIST
	MOVEM P4,UDBCHB(P3)	;STORE SPECIAL IORB IN UDB
	MOVX T1,CS.ACT		;GET CHANNEL ACTIVE BIT
	MOVX T2,KS.ACT		;CONTROLLER ACTIVE BIT ALSO
	TRNE P2,-1		;ANY CONTROLLER?
	TDNN T2,KDBSTS(P2)	;YES, IS IT ACTIVE?
	TDNE T1,CDBSTS(P1)	;OR THE CHANNEL?
	JRST UNICK9		;YES - CANT START IT NOW
	MOVE T1,P4		;PLACE ON HEAD OF TWQ
	CALL ONFTWQ		; ...
	CALL STRTIO		;ATTEMPT STARTUP NOW
	 SKIPA			;FAILED - UNIT WAS WRONG ABOUT ONLINE
	JRST ONRET		;SUCCESS - ENABLE PI AND RETURN
	CALL OFFTWQ		;PULL FROM QUEUE
	CALL CLRCHB		;UNDO ABOVE WORK
UNICK9:	IOPION
	JRST UNICK0		;COULDNT CHECK AFTERALL


;HERE WHEN A UNIT CHANGES STRUCTURE STATUS

UNICKA:	MOVX T1,US.CHB		;CLEAR CHECK HOME BLOCKS BIT
	ANDCAM T1,UDBSTS(P3)	; ...
	JRST UNICK0		;AND DO USUAL CHECKS


;INTERRUPT ROUTINE FOR HOME BLOCK CHECKER IO

CHBINT:	SETZM UDBCHB(P3)	;ONLY NEED THIS STARTED ONCE
	RET
;HERE TO ATTEMPT RESTART OF A FAILED IORB


UNITRY:	SAVEQ			;PRESERVE REGISTERS
	MOVX T1,US.ACT!US.CHB	;GET UNIT ACTIVE FLAGS
	MOVX T2,KS.ACT		;AND CONTROLLER ACTIVE FLAGS
	IOPIOF			;INTERLOCK
	TRNE P2,-1		;KDB ?
	TDNN T2,KDBSTS(P2)	;ACTIVE?
	TDNE T1,UDBSTS(P3)	;ACTIVE?
	JRST ONRET		;YES - FATE INDETERMINATE
	HRRZ P4,UDBTWQ(P3)	;ANY TRANSFERS PENDING?
	JUMPN P4,UNITR2		;YES - ATTEMPT RESTART
	HRRZ P4,UDBPWQ(P3)	;ANY SEEKS?
	JUMPN P4,UNITR1		;YES - RESTART
ONRSKP:	IOPION			;NOTHING AT ALL, MUST HAVE WON
	RETSKP			;AND SAY SO.

UNITR1:	CALL STRTPS		;RESTART POSITION OPERATION
	 JRST ONRET		;FAILED
	JRST ONRSKP		;WON - SUCCESS RETURN

UNITR2:	MOVE T1,CDBSTS(P1)	;GET CHANNEL STATUS
	TXNE T1,CS.ACT		;ACTIVE?
	JRST ONRET		;YES, DON'T DO ANYTHING
	SKIPE PHYSEC		;MINUTE BOUNDARY?
	JRST UNITR3		;NO, SKIP ON
	MOVX T1,US.DSK		;GET DISK FLAG READY
	MOVX T2,US.WLK		;AND WRITE-LOCKED FLAG READY
	TDNE T1,UDBSTS(P3)	;IS THIS A DISK?
	ANDCAM T2,UDBSTS(P3)	;YES, ALLOW RP20S TO TRY WRITING AGAIN
UNITR3:	CALL STRTIO		;RESTART THE TRANSFER OPERATION
	 JRST ONRET		;FAILED
	JRST ONRSKP		;WON - SUCCESS RETURN
;HERE TO TERMINATE A HUNG IORB AND RESTART CHANNEL ACTIVITY


;T1/ IORB
;P1 SETUP
;WIPES THE REGISTERS
;MUST BE CALLED IOPIOF 


HNGIRB:	MOVE P4,T1		;SETUP IORB IN EXPECTED PLACE
	MOVX T1,US.REW		;CLEAR REWINDING STATUS
	ANDCAB T1,UDBSTS(P3)	; IN THE UDB (ALSO LOAD UDBSTS INTO T1)
	TXNE T1,US.POS		;WAS THIS A POSITION REQUEST?
	JRST HNGIR1		;YES
	HRRZ T1,CDBDSP(P1)	;GET CHANNEL DISPATCH
	CALL CDSHNG(T1)		;DO HUNG RESET
	CALL CLRACT		;RESET ALL ACTIVE BITS
	MOVX T1,IS.NRT!IS.DVE	;GET ERROR FLAGS READY
	IORM T1,IRBSTS(P4)	;IN ALL CASES MARK IORB AS FAILED
	CALL DONIRB		;POST AS COMPLETE
	CALL SCHSEK		;START SEEKS (IF APPROPRIATE)
	CALL SCHXFR		;RESTART CHANNEL IF ANY WORK
	RET



;HERE TO CLEAN UP AFTER A HUNG SEEK


HNGIR1:	TRNN P2,-1		;ANY CONTROLLER?
	JRST HNGIR2		;NOPE, SKIP ON
	HRRZ T1,KDBACT(P2)	;YES, GET ACTIVE UNIT IF ANY
	CAIE T1,(P3)		;WAS CONTROLLER BUSY FOR THIS DRIVE?
	JRST HNGIR2		;NOPE, SKIP ON
	HRRZ T1,UDBDSP(P3)	;YES, GET DISPATCH ADDRESS
	CALL UDSHNG(T1)		;DO HUNG DEVICE RECOVERY
	CALL CLRPOS		;CLEAR ACTIVE BITS FOR CONTROLLER AND UNIT
	SKIPA			;SKIP INTO REST
HNGIR2:	CALL CLRSRC		;CLEAR ACTIVE BITS FOR UNIT
	MOVX T1,IS.NRT!IS.DVE	;GET ERROR FLAGS READY
	MOVX T2,US.DSK		;IF THIS IS A DISK, THEY DO IMPLIED SEEKS
	TDNN T2,UDBSTS(P3)	;SO THAT POSITIONING ERRORS CAN BE IGNORED
	IORM T1,IRBSTS(P4)	;BUT IF NOT A DISK, FLAG AN ERROR
	CALL DONIRB		;MARK THE IORB AS COMPLETE
	CALL SCHSEK		;START ANOTHER SEEK
	MOVX T1,CS.ACT!CS.ERC	;CHANNEL NOW IDLE?
	TDNN T1,CDBSTS(P1)	; ???
	CALL SCHXFR		;YES - SEE IF ANYTHING ELSE TO DO
	RET
;HERE TO ISSUE A MESSAGE TO THE OPERATOR
;  T1/ POINTER TO INITIAL MESSAGE


UNIMES:	SAVEQ			;PRESERVE REGISTERS
	CALL PMES		;PRINT START OF MESSAGE
	MOVX T1,US.TAP		;MAGTAPE?
	TDNE T1,UDBSTS(P3)	; ???
	JRST UNIMS5		;YES, PRINT OUT "MTAN"
	LDB T1,USYTYP		;GET UNIT TYPE
	MOVE T1,NAMUTP(T1)	;GET NAME AS STRING POINTER
	CALL PMES		;PRINT TYPE
	SKIPL Q1,UDBSTR(P3)	;UNIT IN STR?
	SKIPN Q1,STRTAB(Q1)	; ???
	JRST UNIMS0		;NO
	HRROI T1,[ASCIZ /, STR=/]
	CALL PMES		;YES - PRINT NAME
	MOVE T1,SDBNAM(Q1)	;COPY STR NAME
	CALL PSIX		;PRINT IT
UNIMS0:	SKIPN UDBDSN(P3)	;SERIAL NUMBER KNOWN?
	JRST UNIMS2		;NO - SKIP THAT PART
	HRROI T1,[ASCIZ /, S.N.=/]
	CALL PMES		;PREPARE TO PRINT SERIAL
	MOVE Q1,UDBDSN(P3)	;GET SERIAL NUMBER
	CALL UNIDEC		;PRINT THE SERIAL NUMBER
UNIMS2:	HRROI T1,[ASCIZ /, Access path: CHN=/] ;PREPARE NEXT PART
	CALL PMES		;PRINT
	HRRZ T1,CDBADR(P1)	;GET CHANNEL NUMBER
	CALL PNUM		;PRINT IT
	JUMPN P2,UNIMS4		;IF KDB, PRINT APPROPRIATE MESSAGE
UNIMS3:	HRROI T1,[ASCIZ /, UNI=/] ;PREPARE NEXT
	CALL PMES
	HRRZ T1,UDBAKA(P3)	;GET ADDRESS
	TRNE P2,-1		;UNLESS HAVE A CONTROLLER
	HRRZ T1,UDBSLV(P3)	;IN WHICH CASE, SUBUNIT IS HERE
	CALL PNUM		;PRINT IT
	HRROI T1,[ASCIZ /
/]
	CALL PMES		;FINISH IT OFF
	RET
;HERE WHEN A CONTROLLER IS IN THE WAY


UNIMS4:	HRROI T1,[ASCIZ /, /]
	CALL PMES		;PREPARE TO PRINT KON TYPE
	EXCH P2,P3		;GET KDB IN P3
	LDB T1,USYTYP		;GET UNIT TYPE
	EXCH P2,P3		;REPLACE KDB,UDB
	MOVE T1,NAMUTP(T1)	;GET KON TYPE
	CALL PMES		;PRINT IT
	HRROI T1,[ASCIZ /=/]
	CALL PMES		;ANNOUNCE OBJECT
	HRRZ T1,UDBAKA(P3)	;GET ADDRESS
	CALL PNUM		;PRINT IT
	JRST UNIMS3		;JOIN ABOVE


UNIMS5:	HRROI T1,[ASCIZ/MTA/]
	CALL PMES		;GIVE LOGICAL UNIT NUMBER
	MOVSI Q1,-MTAN		;LOOK FOR THIS UNIT
UNIMS6:	HRRZ T1,MTCUTB(Q1)	;GET UDB ADR
	CAIN T1,(P3)		;FOUND THE UNIT YET?
	JRST UNIMS7		;YES
	AOBJN Q1,UNIMS6		;NO, LOOP BACK TIL FOUND
	JRST UNIMS0		;NOT FOUND SO DONT GIVE UNIT NUMBER

UNIMS7:	HRRZS Q1		;GET UNIT NUMBER
	CALL UNIOCT		;PRINT THE UNIT NUMBER
	JRST UNIMS0		;GO CONTINUE MESSAGE

UNIOCT:	SKIPA Q3,[^D8]		;SETUP FOR OCTAL NUMBER
UNIDEC:	MOVX Q3,^D10		;SETUP FOR DECIMAL NUMBER
UNIDE1:	IDIV Q1,Q3		;GET HIGH ORDER DIGIT
	PUSH P,Q2		;SAVE LOW ORDER DIGIT
	SKIPE Q1		;ANY MORE TO DO?
	CALL UNIDE1		;YES, GO DO ANOTHER
	POP P,T1		;GET BACK HIGH ORDER DIGIT
	CALLRET PNUM		;TYPE IT OUT
				; AND RETURN FOR OTHER DIGITS
;HERE TO PRINT A STRING TO THE OPERATOR

PMES:	MOVE T2,CTYLNO		;GET CTY LINE
	CALL TTEMES		;CALL TTY SERVICE
	RET

;HERE TO PRINT A SMALL NUMBER (FOUR DIGITS OR LESS) IN T1 AS AN OCTAL NUMBER

PNUM:	SETZ T3,		;CLEAR RESULT
PNUMLP:	IDIVI T1,^D8		;SPLIT OFF A DIGIT
	ADDI T2,"0"		;CONVERT REMAINDER TO ASCII
	LSHC T2,-7		;STORE WITH OTHER CHARACTERS IN T3
	JUMPN T1,PNUMLP		;PROCEED IF NOT DONE YET
	TRZ T3,377		;INSURE A NULL EXISTS
	PUSH P,T3		;SAVE RESULT
	HRROI T1,(P)		;POINT TO WORD
	CALL PMES		;TYPE NUMBER
	JRST PA1		;SCRAP STACK AND RETURN

;HERE TO PRINT T1 IN SIXBIT

PSIX:	MOVE T2,T1		;COPY ARG
	ADJSP P,2		;ALLOC STRING SPACE (STACK ALMOST GONE)
	HRRZI T3,-1(P)		;GET START OF STRING
	HRLI T3,(<POINT 7,.-.>)	;BUILD BYTE POINTER
PSIX1:	MOVEI T1,0		;CLEAR T1
	LSHC T1,6		;GET A CHAR FROM ARG
	SKIPE T1		;IF NOT END
	ADDI T1,40		;MAKE LIKE ASCII
	IDPB T1,T3		;STORE IN OUTPUT STRING
	JUMPN T1,PSIX1		;LOOP
	HRROI T1,-1(P)		;BUILD STRING POINTER
	CALL PMES		;PRINT STRING
	ADJSP P,-2		;SCRAP STACK
	RET			;DONE

PHCVBO::MOVE T4,T1		;SAVE THE NUMBER GIVEN
	LDB T1,[POINT 4,T4,23]	;GET HIGH ORDER DIGIT
	IMULI T1,^D10		;MULT BY 10
	LDB T2,[POINT 4,T4,27]	;GET 2ND DIGIT
	ADD T1,T2		;ADD TO NUMBER
	IMULI T1,^D10
	LDB T2,[POINT 4,T4,31]	;GET THIRD DIGIT
	ADD T1,T2
	IMULI T1,^D10
	LDB T2,[POINT 4,T4,35]	;LAST DIGIT
	ADD T1,T2		;LAST ONE
	RET			;RETURN
	SUBTTL	MOUNTABLE STRUCTURE SUPPORT ROUTINES


;ROUTINE TO SET UP UDBSTR AND SDBUDB DURING MOUNTING OF A STRUCTURE
;
;ACCEPTS IN T1/ UNIT'S CKU NUMBERS (CHANNEL, CONTROLLER, UNIT NUMBERS)
;	    T2/	UNIT NUMBER IN STRUCTURE,,STRUCTURE NUMBER
;	    T3/	ADDRESS OF SDB
;		CALL SETSTR
;RETURNS: +1 ALWAYS


	SWAPCD


SETSTR::STKVAR <STRSTN,SDBADR>	;ALLOCATE STORAGE
	MOVEM T2,STRSTN		;SAVE STRUCTURE NUMBER
	MOVEM T3,SDBADR		;AND SDB ADDRESS
	CALL CKUNPK		;UNPACK THE CKU NUMBERS
	CALL CHKCKU		;THEN FIND THE UDB ADDRESS
	 BUG(UNFWSS)		;SHOULD BE THERE!
	HLRZ T2,STRSTN		;GET LOGICAL UNIT NUMBER WITHIN THE STRUCTURE
	ADD T2,SDBADR		;ADD IN SDB ADDRESS
	MOVEM T1,SDBUDB(T2)	;STORE UDB ADDRESS IN SDB
	MOVE T2,STRSTN		;GET BACK UNIT,,STRUCTURE NUMBERS
	MOVEM T2,UDBSTR(T1)	;STORE THEM IN THE UDB
	RET			;RETURN



;ROUTINE TO CLEAR THE UDBSTR AND SDBUDB ENTRIES FOR ALL UNITS IN
;A STRUCTURE.
;
;CALL:
;ACCEPTS IN T1/ SDB ADDRESS
;	CALL CLRSTR
;RETURNS: +1 ALWAYS


CLRSTR::MOVN T4,SDBNUM(T1)	;MAKE AOBJN WORD FROM # OF UNITS IN STRUCTURE
	HRLZ T4,T4		;PUT NEGATIVE COUNT IN LEFT HALF
	HRR T4,T1		;AND SDB ADDRESS IN RIGHT HALF

; LOOP OVER ALL UNITS IN THE STRUCTURE

CLRST2:	MOVE T2,SDBUDB(T4)	;GET ADDRESS OF UNIT DATA BLOCK
	SETZM SDBUDB(T4)	;CLEAR POINTER TO UNIT DATA BLOCK
	SETOM UDBSTR(T2)	;CLEAR STRUCTURE INFORMATION IN UDB
	AOBJN T4,CLRST2		;LOOP OVER ALL UNITS IN THE STRUCTURE
	RET			;RETURN
;ROUTINE TO RETURN STRUCTURE NUMBER OF WHICH A GIVEN UNIT IS A PART
;
;ACCEPTS:	T1/  UDB ADDRESS OF UNIT
;		CALL GETSTR
;RETURNS: +1	 FAILED, UNIT OFFLINE OR IN MAINT MODE, WITH T1/ FLAGS
;         +2	SUCCESS, WITH T1/ UNIT WITHIN STRUCTURE,,STRUCTURE NUMBER
;				  OR -1 IF UNIT NOT IN STRUCTURE
;			      T2/ UNIT TYPE
;			      T3/ FLAGS:
;					MS%WLK IF UNIT IS WRITE LOCKED



GETSTR::LDB T2,[POINT USSTYP,UDBSTS(T1),USPTYP] ;GET UNIT TYPE
	MOVE T4,UDBSTS(T1)	;GRAB UDB STATUS
	MOVE T1,UDBSTR(T1)	;GET STRUCTURE NUMBER FOR THIS UNIT
	SETZ T3,		;CLEAR FLAGS TO RETURN
	TXNE T4,US.OFS		;UNIT OFF-LINE?
	TXO T3,MS%OFL		;YES, MARK IT
	TXNE T4,US.MAI		;IN MAINTENANCE MODE?
	TXO T3,MS%DIA		;YES, MARK IT
	TXNE T4,US.WLK		;WRITE-LOCKED?
	TXO T3,MS%WLK		;YES, MARK IT
	TXNN T3,MS%OFL!MS%DIA	;ANY FATAL ERRORS?
	RETSKP			;NOPE, SUCCESSFUL RETURN
	MOVE T1,T3		;YES, COPY FLAGS
	RET			;GIVE ERROR RETURN
;ROUTINE TO ACCEPT CHANNEL, CONTROLLER, AND UNIT NUMBERS AND
;FIND THE UDB WITH THE SPECIFIED ADDRESS.  CALL:
;  T1/	CHANNEL NUMBER
;  T2/	CONTROLLER NUMBER OR -1 IF NONE
;  T3/	UNIT NUMBER
;  T4/  0 TO ALLOW ANY KIND OF UDB, OR -1 TO ONLY ALLOW DISKS
;RETURNS:  +1:	ARGUMENTS ARE ILLEGAL OR UNIT CANNOT BE FOUND
;		  T1/ ERROR CODE
;	   +2:	SPECIFIED UDB FOUND
;		  T1/ UDB ADDRESS
;		  T2/ UNIT TYPE
;CALL CHKCKU FOR NORMAL CASE WHERE ONLY DISK UNITS ARE ALLOWED.


	RESCD


CHKCKU::SETOM T4		;REMEMBER TO ONLY PERMIT DISKS
CHKCKA::SAVEPQ			;SAVE SOME ACS
CHKCK2:	MOVE Q1,T4		;REMEMBER DISK ONLY FLAG
	SKIPL T1		;SEE IF CHANNEL NUMBER IS TOO SMALL
	CAIL T1,CHNN		;OR TOO LARGE
	 RETBAD (MSTX14)	;YES, "INVALID CHANNEL NUMBER"
	SKIPN P1,CHNTAB(T1)	;GET CDB ADDRESS
	 RETBAD (MSTX41)	;NONE, "CHANNEL DOES NOT EXIST"
	HLRE T1,CDBIUN(P1)	;GET NUMBER OF UNITS
	MOVMS T1		;MAKE POSITIVE
	HRRZ T4,CDBIUN(P1)	;ALSO GET ADDRESS OF UDB/KDB TABLE
	CAME T2,[-1]		;SEE IF A CONTROLLER IS SPECIFIED
	JRST CHKISK		;YES, SKIP ON


;HERE IN THE CASE THAT NO CONTROLLER IS SPECIFIED.  CHECK TO MAKE SURE
;THAT THE UNIT NUMBER GIVEN IS LEGAL AND IS IN FACT A UDB INSTEAD OF A KDB.


	SKIPL T3		;UNIT NUMBER TOO SMALL?
	CAML T3,T1		;OR TOO LARGE?
	 RETBAD (MSTX15)	;YES, "INVALID UNIT NUMBER"
	ADD T3,T4		;MAKE ADDRESS OF UDB POINTER
	SKIPN P3,(T3)		;GET UDB ADDRESS
	 RETBAD (DIAGX9)	;NONE, "UNIT DOES NOT EXIST"
	LDB T4,USYBKT		;GET BLOCK TYPE
	CAIE T4,.BTUDB		;MAKE SURE IT IS A UDB
	 RETBAD (DIAGX9)	;NOPE, "UNIT DOES NOT EXIST"
	JRST CHKHVU		;OK, GO FINISH UP
;HERE IN THE CASE THAT A CONTROLLER NUMBER WAS GIVEN.  CHECK ITS LEGALITY,
;AND MAKE SURE THAT A KDB WAS SPECIFIED INSTEAD OF A UDB.  FINALLY, THEN
;CHECK TO SEE THAT THE UNIT NUMBER IS LEGAL.


CHKISK:	SKIPL T2		;SEE IF CONTROLLER NUMBER IS TOO SMALL
	CAML T2,T1		;OR TOO LARGE
	 RETBAD (MSTX16)	;YES, "INVALID CONTROLLER NUMBER"
	ADD T2,T4		;MAKE ADDRESS OF KDB POINTER
	SKIPN P2,(T2)		;GET KDB ADDRESS
	 RETBAD (MSTX42)	;NONE, "CONTROLLER DOES NOT EXIST"
	MOVE P3,P2		;COPY FOR LDB
	LDB T4,USYBKT		;GET BLOCK TYPE
	CAIE T4,.BTKDB		;MAKE SURE IT'S A KDB AND NOT A UDB
	 RETBAD (MSTX42)	;NOPE, THEN "CONTROLLER DOES NOT EXIST"
	MOVE Q2,T3		;COPY OVER UNIT NUMBER
	HRRZ T1,KDBDSP(P2)	;GET DISPATCH ADDRESS
	CALL UDSEXT(T1)		;CHECK TO SEE IF UNIT IS VALID
	 JRST [	SKIPN T1	;BAD UNIT, DETERMINE WHY
		RETBAD(MSTX15)	;IT'S "INVALID UNIT NUMBER"
		RETBAD(DIAGX9)]	;IT'S "UNIT DOES NOT EXIST"

CHKHVU:	MOVE T1,P3		;GET UDB FOUND
	LDB T2,USYTYP		;AND THE UNIT TYPE
	JUMPE Q1,RSKP		;DONE IF ANY KIND OF UDB IS ALLOWED
	MOVX T3,US.DSK		;GET DISK BIT READY
	TDNN T3,UDBSTS(P3)	;IS THIS A DISK DEVICE?
	 RETBAD (MSTX27)	;NO, "SPECIFIED UNIT IS NOT A DISK"
	RETSKP			;IT'S A DISK, GOOD RETURN
;ROUTINE TO ADVANCE TO THE NEXT UDB IN THE SYSTEM BY SCANNING ALL
;CHANNELS, CONTROLLERS, AND UNITS.  CALL:
;  T1/	CHANNEL NUMBER, OR -1 TO START AT BEGINNING
;  T2/	CONTROLLER NUMBER OR -1 FOR NONE
;  T3/	UNIT NUMBER, OR -1 TO START WITH FIRST ONE
;  T4/  0 TO ALLOW ANY KIND OF UDB, OR -1 TO ONLY ALLOW DISKS
;RETURNS: +1:  NO MORE UNITS IN SYSTEM
; 	  +2:  NEXT UNIT FOUND
;		T1/  NEW CHANNEL NUMBER
;		T2/  NEW CONTROLLER NUMBER OR -1 IF NONE
;		T3/  NEW UNIT NUMBER
;		T4/  UDB FOR THIS UNIT
;SEARCHING IS DONE BY INCREMENTING FIRST THE UNIT NUMBER, THEN THE
;CONTROLLER NUMBER, AND LASTLY THE CHANNEL NUMBER.  THE CASE WHERE
;NO CONTROLLER EXISTS IS HANDLED SIMPLY AS "CONTROLLER NUMBER -1".
;CALL ADVCKU FOR NORMAL CASE WHICH ONLY ALLOWS DISK UNITS.



ADVCKU::SETOM T4		;ASSUME ONLY WANT DISKS
ADVCKA::SAVEPQ			;SAVE ACS
	ASUBR <ACHAN,ACTRL,AUNIT,ATYPE>	;SAVE CALLING ARGUMENTS
	CAMN T1,[-1]		;WANTS TO START WITH FIRST CHANNEL?
	JRST ADVCHN		;YES, GO DO IT

NXTUNI:	DMOVE T1,ACHAN		;SET UP TWO OF THE ARGUMENTS
	AOS T3,AUNIT		;ADVANCE TO NEXT UNIT
	MOVE T4,ATYPE		;GET FLAG READY ALSO
	CALL CHKCK2		;SEE IF THIS COMBINATION IS LEGAL
	 JRST ADVERR		;NO, GO SEE WHY
	MOVE T4,T1		;MOVE UDB TO CORRECT AC
	DMOVE T1,ACHAN		;RESTORE NEW CHANNEL AND CONTROLLER NUMBERS
	MOVE T3,AUNIT		;ALSO RESTORE NEW UNIT NUMBER
	RETSKP			;DONE



;HERE WHEN A PARTICULAR COMBINATION ISN'T VALID.  DETERMINE WHY, AND
;THEN MOVE TO THE NEXT UNIT, CONTROLLER, OR CHANNEL AS APPROPRIATE.


ADVERR:	CAIN T1,MSTX14		;INVALID CHANNEL NUMBER?
	RET			;YES, ALL DONE
	CAIE T1,MSTX41		;CHANNEL NOT THERE?
	CAIN T1,MSTX16		;OR INVALID CONTROLLER NUMBER?
	JRST ADVCHN		;YES, GO TO NEXT CHANNEL
	CAIE T1,MSTX42		;CONTROLLER NOT THERE?
	CAIN T1,MSTX15		;OR INVALID UNIT NUMBER?
	JRST ADVCTL		;YES, ADVANCE TO NEXT CONTROLLER
	JRST NXTUNI		;NO, MOVE TO NEXT UNIT
;ROUTINES TO ADVANCE CHANNELS OR CONTROLLERS.


ADVCHN:	SETOM ACTRL		;RESET CONTROLLER NUMBER BACK TO -1
	AOSA ACHAN		;MOVE TO NEXT CHANNEL NUMBER AND SKIP
ADVCTL:	AOS ACTRL		;MOVE TO NEXT CONTROLLER NUMBER
	SETOM AUNIT		;START WITH FIRST UNIT
	JRST NXTUNI		;GO EXAMINE IT
;SIMPLE ROUTINES TO PACK AND UNPACK THE CKU NUMBERS FOR A UNIT.
;CALL FOR CKUPAK:
;  T1/	CHANNEL NUMBER
;  T2/	CONTROLLER NUMBER OR -1 IF NONE
;  T3/	UNIT NUMBER
;RETURNS +1:  ALWAYS
;		T1/  CKU NUMBER
;
;CALL FOR CKUNPK:
;  T1/	CKU NUMBER
;RETURNS +1:  ALWAYS
;		T1/  CHANNEL NUMBER
;		T2/  CONTROLLER NUMBER OR -1 IF NONE
;		T3/  UNIT NUMBER



CKUPAK::STOR T1,DOP%C2,T1	;POSITION THE CHANNEL NUMBER
	STOR T2,DOP%K2,T1	;STORE THE CONTROLLER NUMBER
	STOR T3,DOP%U2,T1	;AND FINALLY THE UNIT NUMBER
	RET			;DONE



CKUNPK::LOAD T3,DOP%U2,T1	;EXTRACT THE UNIT NUMBER
	LOAD T2,DOP%K2,T1	;AND THE CONTROLLER NUMBER
	CAIN T2,<.RTJST(-1,DOP%K2)>	;WAS FIELD ALL ONES?
	SETOM T2		;YES, SET NO CONTROLLER THEN
	LOAD T1,DOP%C2,T1	;FINALLY EXTRACT THE CHANNEL NUMBER
	RET			;DONE
;HERE TO EXECUTE AN INSTRUCTION ONCE FOR EACH UDB ON A CHANNEL

;CALL DGUMAP
; INSTRUCTION TO EXECUTE

;THE INSTRUCTION WILL BE EXECUTED ONCE WITH P3 SETUP TO EACH UDB
;THIS ROUTINE CLOBBERS Q3




DGUMAP::MOVE Q3,CDBIUN(P1)	;GET AOBJN WORD
DGUMP1:	SKIPN P3,(Q3)		;UDB PRESENT?
	JRST DGUMP2		;NO - TRY NEXT
	LDB T1,USYBKT		;GET BLOCK TYPE
	CAIE T1,.BTUDB		;UDB ?
	JRST DGUMP3		;IS KDB, LOOP FOR IT
	MOVEI P2,0		;IF NO KDB, PROVIDE A ZERO
	XCT @(P)		;EXECUTE INSTRUCTION
DGUMP2:	AOBJN Q3,DGUMP1		;LOOP
	RETSKP			;DONE

DGUMP3:	MOVE P2,P3		;COPY KDB
	PUSH P,Q3		;SAVE AOBJN POINTER
	MOVE Q3,KDBIUN(P2)	;GET NEW ONE FOR KDB'S UNITS
DGUMP4:	SKIPE P3,(Q3)		;UDB PRESENT?
	XCT @-1(P)		;YES, DO INSTRUCTION
	AOBJN Q3,DGUMP4		;LOOP FOR MORE
	POP P,Q3		;RESTORE ORIGINAL AOBJN WORD
	MOVEI P2,0		;ENSURE NIL KDB
	JRST DGUMP2		;CONTINUE OUTER LOOP

	TNXEND
	END