.MCALL	.MODULE
.MODULE	UM,VERSION=26,COMMENT=<Universal MSCP Class Handler>,AUDIT=NO

;                    COPYRIGHT (c) 1984, 1985, 1986 BY
;             DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;                         ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
; ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
; COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
; AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	.SBTTL	CONDITIONAL ASSEMBLY SUMMARY
;+
;COND
;	UM$DU	(0)		Disk support
;		0		no disk support
;		1		disk support
;
;	UM$MU	(0)		Tape support
;		0		no tape support
;		1		tape support
;
;				Select exactly one from the two above
;
;	MU$32K	(0)		boundary check
;		0		no boundary check
;		1		boundary check
;
;	MMG$T			std conditional
;	TIM$T			std conditional (no code effects)
;	ERL$G			std conditional
;
;
;	For UM$DU =1
;
;	DU$BBR	(0)		bad block replacement support
;		0		none
;		1		host assisted
;
;	DU$BOOt	(0)		multi-port booting
;		0		not suppported
;		1		supported
;
;	DU$GBL	(^rDU )		region name
;
;	DU$CSR	(172150)	First CSR
;	DU$CS1	(172144)	Second CSR
;	DU$CS2	(172140)	Third CSR
;	DU$CS3	(172134)	Fourth CSR
;
;	DU$ALT	(176150)	Alternate CSR (FALCON)
;
;	DU$VEC	(154)		First vector
;	DU$VC1	(150)		Second vector
;	DU$VC2	(144)		Third vector
;	DU$VC3	(140)		Fourth vector
;
;	DU$PORts (1)		ports
;
;
;	For UM$MU =1
;
;	MU$FSM	(0)		FSM support
;		0		NFS
;		1		FS
;
;	MU$UN	(1)		number of units to support
;		1-4		range of values
;
;
;	MU$GBL	(^rMU )		region name
;
;	MU$CSR	(174500)	First CSR
;	MU$CS1	(174474)	Second CSR
;	MU$CS2	(174470)	Second CSR
;	MU$CS3	(174464)	Second CSR
;
;	MU$VEC	(260)		First vector
;	MU$VC1	(254)		Second vector
;	MU$VC2	(250)		Third vector
;	MU$VC3	(244)		Fourth vector !FPP vector
;
;	MU$PORts (MU$UN)	ports
;-

.MCALL	.Assume
	.Assume	<UM$MU+UM$DU> NE 0,<;NO hardware type specified>
	.Assume	<UM$MU+UM$DU> EQ 1,<;More than 1 hardware type specified>

.IF NE UM$MU
 .IIF NDF MU$FSM MU$FSM = 0		;No file structure if not defined
 .IIF NE  MU$FSM MU$FSM = 1		;File structure (make 0 or 1)
 .IIF NDF MU$CSR MU$CSR = 174500
 .IIF DF  MU$CSR UM$CSR = MU$CSR
 .IIF NDF MU$VEC MU$VEC = 260
 .IIF DF  MU$VEC UM$VEC = MU$VEC
 .IIF NDF MU$UN  MU$UN == 1		;Assume at least one unit

 .IIF NDF MU$GBL MU$GBL = <^RMU >	;Handler (MU) & global region (MU $  )
	UM$GBL	= MU$GBL		; name to use instead of .MODULE's UM.

 	MU$PORTS = MU$UN		;For now, # of ports = # of units.
 .IIF LE  MU$PORTS-1, MU$PORTS = 1	;Never let the number be less than 1.
	UM$PORTS = MU$PORTS		;For use in common code	

 .IIF NDF MU$CS1, MU$CS1 = MU$CSR-04
	UM$CS1	= MU$CS1
 .IIF NDF MU$CS2, MU$CS2 = MU$CSR-10
	UM$CS2	= MU$CS2
 .IIF NDF MU$CS3, MU$CS3 = MU$CSR-14
	UM$CS3	= MU$CS3
 .IIF NDF MU$VC1, MU$VC1 = MU$VEC-04
	UM$VC1	= MU$VC1
 .IIF NDF MU$VC2, MU$VC2 = MU$VEC-10
	UM$VC2	= MU$VC2
 .IIF NDF MU$VC3, MU$VC3 = MU$VEC-14
	UM$VC3	= MU$VC3
.ENDC ;NE UM$MU

.IF NE UM$DU
 .IIF DF DU$CSR UM$CSR = DU$CSR
 .IIF DF DU$VEC UM$VEC = DU$VEC

;	.DRDEF	UM,50,<FILST$!SPFUN$!VARSZ$>,0,172150,154
 .IIF NDF DU$GBL = <^RDU >		;Handler (DU) & global region (DU $  )
	UM$GBL = DU$GBL			; name to use instead of .MODULE's UM.

 .IIF NDF DU$PORTS,	DU$PORTS = 1	;Default number of ports to 1.
 .IIF LE  DU$PORTS-1,	DU$PORTS = 1	;Never let the number be less than 1.
	UM$PORTS = DU$PORTS		;For use in common code	

 .IIF NDF DU$BOO DU$BOO = 0		;Assume not multi-port booting
	UM$BOO = DU$BOO

 .IIF NDF DU$BBR DU$BBR =0

 .IIF NDF DU$ALT, DU$ALT = 176150	;Alternate "standard" CSR

 .IIF NDF DU$CS1, DU$CS1 = DU$CSR-04
	UM$CS1	= DU$CS1
 .IIF NDF DU$CS2, DU$CS2 = DU$CSR-10
	UM$CS2	= DU$CS2
 .IIF NDF DU$CS3, DU$CS3 = DU$CSR-14
	UM$CS3	= DU$CS3
 .IIF NDF DU$VC1, DU$VC1 = DU$VEC-04
	UM$VC1	= DU$VC1
 .IIF NDF DU$VC2, DU$VC2 = DU$VEC-10
	UM$VC2	= DU$VC2
 .IIF NDF DU$VC3, DU$VC3 = DU$VEC-14
	UM$VC3	= DU$VC3
.ENDC ;NE UM$DU

.SBTTL	*************************
.SBTTL	*	   UM		*
.SBTTL	*************************
.SBTTL	Universal (T)MSCP Class Handler 
.SBTTL	Edit History & Functional Description

	.ENABL	LC

;+
;
; Original version:
;
; V05 (000) 31-Oct-85	Start of coding for TMSCP/MSCP class support. 
;	BC		Derived from CA's DU handler, old  MU handler
;			with inspiration from NI/NC/NQ handlers.
;
;-

;+
; This portion of the TMSCP/MSCP handlers contains code common to the MSCP
; disk (DU) and TMSCP tape (MU) handlers.
;-

.SBTTL	Class Handler Assembly Parameters

; Assembly parameters

	.IIF NDF UM$MU	UM$MU = 0
	.IIF NE  UM$MU	UM$MU = 1

	.IIF NDF UM$DU	UM$DU = 0
	.IIF NE  UM$DU	UM$DU = 1

	.IIF NDF MMG$T	MMG$T = 0	;Set no XM if not defined

	.IIF EQ  MMG$T	MU$32K= 0	;Set no 32K bound check if not XM
	.IIF NDF MU$32K	MU$32K= 0	;Set no 32K bound check if not defined

	.IIF EQ <UM$MU+UM$DU>	.ERROR	;No controllers selected
	.IIF NE <UM$MU+UM$DU>-1	.ERROR	;Too many controllers selected

.SBTTL	Common MSCP/TMSCP Protocol Definitions

;+
; Command Packet Offsets
;
; Generic Command Packet Offsets and Field Lengths (bytes):
;
;	Offset     Length     Contents
;-

	P.CRF	=:   0		;4   Command reference number
	P.UNIT	=:   4		;2   Unit Number
				;2   Reserved
	P.OPCD	=:  10		;1   Opcode
				;1   Reserved
	P.MOD	=:  12		;2   Modifiers
	P.BCNT	=:  14		;4   Byte count
	P.BUFF	=:  20		;12  Buffer descriptor

	P.CSIZ	=:  60		;48. Total length of a packet

;+
; ABORT and GET COMMAND STATUS Command Packet Offsets and Field Lengths:
;-

	P.OTRF	=:  14		;4   Outstanding Reference number

;+
; ONLINE and SET UNIT CHARACTERISTICS Command Packet Offsets and Field Lengths
;-

	P.UNFL	=:  16		;2   Unit flags
	P.DVPM	=:  34		;4   Device dependent parameters

;+
; SET CONTROLLER CHARACTERISTICS Command Packet Offsets and Field Lengths:
;-

	P.VRSN	=:  14		;2   MSCP version
	P.CNTF	=:  16		;2   Controller flags
	P.HTMO	=:  20		;2   Host timeout
		TO.MIN	= 0 	;     timeout (in minutes)
	P.TIME	=:  24		;8   Quad-word time and date

;+
; End Packet Offsets
;
; Generic End Packet Offsets and Field Lengths:
;-

	P.CRF	=:   0		;4   Command reference number
	P.UNIT	=:   4		;2   Unit number
				;2   Reserved
	P.OPCD	=:  10		;1   Opcode (also called endcode)
	P.FLGS	=:  11		;1   End message flags
	P.STS	=:  12		;2   Status
	P.BCNT	=:  14		;4   Byte count

;+
; ABORT and GET COMMAND STATUS End Packet Offsets and Field Lengths:
;-

	P.OTRF	=:  14		;4   Outstanding reference number

;+
; GET COMMAND STATUS End Packet Offsets and Field Lengths:
;-

	P.CMST	=:  20		;4   Command status

;+
; GET UNIT STATUS End Packet Offsets and Field Lengths:
;-

	P.MLUN	=:  14		;2   Multi-unit code
	P.UNFL	=:  16		;2   Unit flags
	P.UNTI	=:  24		;8   Unit identifier

;+
; ONLINE and SET UNIT CHARACTERISTICS End Packet Offsets and Field Lengths:
;-

	P.MLUN	=:  14		;2   Multi-unit code
	P.UNFL	=:  16		;2   Unit flags
	P.UNTI	=:  24		;8   Unit identifer
	P.MEDI	=:  34		;4   Media type identifier

;+
; SET CONTROLLER CHARACTERISTICS End Packet Offsets and Field Lengths:
;-

	P.VRSN	=:  14		;2   MSCP version
	P.CNTF	=:  16		;2   Controller flags
	P.CTMO	=:  20		;2   Controller timeout
				;2   Reserved
	P.CNTI	=:  24		;8   Controller ID

	P.MSIZ	=:  60		;48. Total length of a packet

;+
; Control Packet Opcodes
;-

	OP.NIL	=:   0		;NIL Command - Used internally with MSCP macro
; True opcodes
	OP.ABO	=:   1		;ABORT Command
	OP.GCS	=:   2		;GET COMMAND STATUS Command
	OP.GUS	=:   3		;GET UNIT STATUS Command
	OP.SCC	=:   4		;SET CONTROLLER CHARACTERISTICS Command
	OP.AVL	=:  10		;AVAILABLE Command
	OP.ONL	=:  11		;ONLINE Command
	OP.SUC	=:  12		;SET UNIT CHARACTERISTICS Command
	OP.DAP	=:  13		;DETERMINE ACCESS PATHS Command
	OP.ACC	=:  20		;ACCESS Command
	OP.CCD	=:  21		;COMPARE CONTROLLER DATA Command
	OP.ERS	=:  22		;ERASE Command
	OP.FLU	=:  23		;FLUSH Command
	OP.CMP	=:  40		;COMPARE HOST DATA Command
	OP.RD	=:  41		;READ Command
	OP.WR	=:  42		;WRITE Command

	OP.AVA	=: 100		;AVAILABLE Attention Message
	OP.DUP	=: 101		;DUPLICATE UNIT NUMBER Attention Message
	OP.ACP	=: 102		;ACCESS PATH Attention Message

	OP.END	=: 200		;End packet flag (see note below)
;+
; Note: End packet opcodes are formed by ORing the end packet flag to the
; command opcode.  For example,  OP.RD!OP.END = OP.RD endcode.     If the
; endcode is OP.END alone then the command was unknown.
;-

;+
; Command Modifiers
;
; Generic Command Modifiers:
;-

	MD.CMP	=:   40000	;Compare
	MD.SEC	=:    1000	;Suppress Error Correction
	MD.SER	=:     400	;Suppress Error Recovery

;+
; AVAILABLE Command Modifiers:
;-

	MD.ALL	=:	 2	;All Class Drivers

;+
; Unit Flags
;-

	UF.CMR	=:	 1	;Compare Reads
	UF.CMW	=:	 2	;Compare Writes
	UF.WPH	=:   20000	;Write Protect (hardware)
	UF.WPS	=:   10000	;Write Protect (software)

;+
; Controller Flags
;-

	CF.ATN	=:     200	;Enable Attention Messages
	CF.MSC	=:     100	;Enable Miscellaneous Error Log Messages
	CF.OTH	=:      40	;Enable Other Host's Error Log Messages
	CF.THS	=:      20	;Enable This Host's Error Log Messages
	CF.576	=:       1	;576 Byte Sectors

;+
; Status codes
;-

	ST.MSK	=:	37	;Mask for major status code
	ST.SUB	=:	40	;Sub-code multiplier
	ST.SUC	=:       0	;Success
	ST.CMD	=:	 1	;Invalid MSCP command
	ST.ABO	=:	 2	;Command Aborted
	ST.OFL	=: 	 3	;Unit Offline
	ST.AVL	=:       4	;Drive available
	ST.WPR	=:	 6	;Write Protected
	ST.CMP	=:	 7	;Compare Error
	ST.DAT	=:	10	;Data Error (Sub-code = Force Error)
	ST.DRV	=:	13	;Drive Error

.IF NE ERL$G		;If error logging

;+
; End Message Flags
;-

	EF.LOG	=:      40	;Error Log Generated

;+
; Error Log Message Packet Offsets and Field Lengths
;-

	L.CRF	=:	 0	;4   Command reference number
	L.UNIT	=:	 4	;2   Unit number
	L.SEQ	=:	 6	;2   Sequence number
	L.FMT	=:	10	;1   Format
	L.FLGS	=:	11	;1   Error log message flags
	L.EVNT	=:	12	;2   Event code
	L.CNTI	=:	14	;8   Controller ID
	L.CSVR	=:	24	;1   Controller software version
	L.CHVR	=:	25	;1   Controller hardware version
	L.MLUN	=:	26	;2   Multi-unit code
	L.UNTI	=:	30	;8   Unit ID
	L.USVR	=:	40	;1   Unit software version
	L.UHVR	=:	41	;1   Unit hardware version

;+
; Error Log message Format Codes
;-

	FM.CNT	=:       0	;Controller errors
	FM.BAD	=:       1	;Host memory access errors with bus address

;+
; Error Log Message Flags
;-

	LF.SUC	=:     200	;Operation successful
	LF.CON	=:     100	;Operation continuing
	LF.SNR	=:       1	;Sequence number reset

;+
; Host Memory Access Errors with Bus Address Error Log Message Offsets
;-

	L.BADR	=:	 4	;4   Bus address

;+
; Disk Transfer Errors Error Log Message Offsets
;-

	L.LVL	=:	42	;1   Level
	L.RTRY	=:	43	;1   Retry

.ENDC ;NE ERL$G

.SBTTL	UDA Port Definitions

;+
; Ownership flags. For Message Descriptor Vectors.
;-

	OWN	=:  100000	;UDA owns ring buffer entry
	FLAG	=:   40000	;UDA should interrupt on ring transition

;+
; Initialization sequence definitions
;-

	ISTEP1	=:    4000	;Initialization step 1
	ISTEP2	=:   10000	;Initialization step 2
	ISTEP3	=:   20000	;Initialization step 3
	ISTEP4	=:   40000	;Initialization step 4

	IERROR	=:  100000	;Error
	IE	=:     200	;Interrupt during initialization sequence
	STEP	=:     200	;Mandatory one bit in step 1 (high byte)
	GO	=:       1	;GO at step 4

;+
; Masks for TK50
;
; FW revision level and controller model are available in the ASA register 
; after step 4 of the 4 step initialization has been completed.
;
; The firmware rev level is in bits 0-3
; The model is in bits 4-7
;
;-

	FWREV	=:	4	;Firmware level
	FWREVM	=:	17	;Firmware rev level mask, lowest 
				;acceptable level is 4
	TKMOD	=:	60	;Mask for TK50 identifier 
;+
; Port control table element offsets
;-

	PC.AIP	=:	 0	;Polling register.
	PC.ASA	=:	 2	;Status register.
	PC.STEP	=:	 4	;Initialization step for this port.
	PC.VEC	=:	 6	;Vector for this port.

	PC.ESZ	=:	10	;Port control table entry size.

.SBTTL	.MCALLs and MACRO Definitions

	.MCALL	.DRDEF,	.ADDR,	.INTEN
	.MCALL	.MFPS,  .MTPS,	.SYNCH,	 .BR,	.PRINT
	.MCALL	.TRPSET,.WAIT

;+
; Create an MSCP command entry into the command table (by subroutine).
;-

.MACRO	MSCP	OPCODE
	JSR	R5,GETCBF
	.WORD	OPCODE
.ENDM ;MSCP

;+
; Perform contiguous action while gone for interrupt.
;-

.MACRO	DO	THIS,THEN,THAT
	JSR	R5,COORD
	.WORD	THAT-.,THIS-.
.ENDM ;DO

;+
; P1EXT Macros
; These macros are used to execute a set of instructions in P1EXT - this
; instructions map the PAR1 space to another region.
; 
;	.P1EXT is used from LOW  memory
;	.HP1EX is used from HIGH memory
;-

.MACRO	.P1EXT	NEWPAR,?LOC
	MOV	NEWPAR,LOC
	JSR	R0,@$P1EXT
	.WORD	LOC-.
	.MACRO	.P1END
LOC:	.WORD	0
	.ENDM
.ENDM	.P1EXT

.MACRO	.HP1EX	NEWPAR,?LOC
	MOV	NEWPAR,LOC
	JSR	R0,@H$P1EX
	.WORD	LOC-.
	.MACRO	.HP1EN
LOC:	.WORD	0
	.ENDM
.ENDM	.HP1EX
.IF NE MU$32K			;If 32KW bound check enabled

.SBTTL	$REL	- Macro to Mark Words to Relocate in Body of Handler (XM Only)

;+
; $REL
;
; Used to mark words to relocate in the body of the handler.
; Use $RELF to mark words to relocate in the FETCH/LOAD once-only code.
;
;	$REL LOC VALUE BASE HIGH
;
;	LOC	-- Location of word to relocate
;	VALUE	-- Value to relocate it to
;	BASE	-- Base relocation on (UMR, UMX)
;	HIGH	-- Flags a reference which both RESIDES in extended memory and
;		   ACCESSES extended memory. (ONLY VALID if "Base = UMX").
;-

	UMR.CNT	= 0		;UM root from extended memory ref
	UMX.CNT	= 0		;UM extended memory ref from root
	UMH.CNT	= 0		;UM extended memory ref from ext mem

.MACRO	$REL LOC VALUE Base Hi
.....1	=	.
.	=	LOC
.IF IDN	<UMX>	<Base>
.IF B <Hi>
UMX.CNT	=	UMX.CNT+1
.IRP	x	<\UMX.CNT>
UMX'x:	.WORD	VALUE-UMXBase+BEGREL
.ENDR
.IFF ;B <Hi>
.IF IDN <HIGH>	<Hi>
UMH.CNT	=	UMH.CNT+1
.IRP	x	<\UMH.CNT>
UMH'x:	.WORD	VALUE-UMXBase+BEGREL
.ENDR
.IFF ;IDN <HIGH> <Hi>
.ERROR	; Unknown Parameter "<Hi>";
.ENDC ;IDN <HIGH> <Hi>
.ENDC ;B <Hi>
.	=	.....1
.MEXIT
.ENDC ;IDN <UMX> <Base>
.IF IDN	<UMR>	<Base>
UMR.CNT	=	UMR.CNT+1
.IRP	x	<\UMR.CNT>
UMR'x:	.WORD	VALUE-UMBase
.ENDR
.IF NB <Hi>
.ERROR	; Unknown Parameter "<Hi>";
.ENDC ;NB <Hi>
.	=	.....1
.MEXIT
.ENDC ;IDN <UMR> <Base>
.ERROR	; Unknown B A S E "Base";
.ENDM	$REL
.IFF ;NE MU$32K

.SBTTL	$REL	- Macro to Mark Words to Relocate in Body of Handler (XM Only)

;+
; $REL
;
; Used to mark words to relocate in the body of the handler.
; Use $RELF to mark words to relocate in the FETCH/LOAD once-only code.
;
;	$REL LOC VALUE BASE HIGH
;
;	LOC	-- Location of word to relocate
;	VALUE	-- Value to relocate it to
;	BASE	-- Base relocation on (UMR, UMX)
;	HIGH	-- (Ignored if 32KW bound check not enabled.)
;-

	UMR.CNT	= 0		;UM root from extended memory ref
	UMX.CNT	= 0		;UM extended memory ref from root

.MACRO	$REL LOC VALUE Base Hi
.....1	=	.
.	=	LOC
.IF IDN	<UMX>	<Base>
UMX.CNT	=	UMX.CNT+1
.IRP	x	<\UMX.CNT>
UMX'x:	.WORD	VALUE-UMXBase+BEGREL
.ENDR
.	=	.....1
.MEXIT
.ENDC ;IDN <UMX> <Base>
.IF IDN	<UMR>	<Base>
UMR.CNT	=	UMR.CNT+1
.IRP	x	<\UMR.CNT>
UMR'x:	.WORD	VALUE-UMBase
.ENDR
.	=	.....1
.MEXIT
.ENDC ;IDN <UMR> <Base>
.ERROR	; Unknown B A S E "Base";
.ENDM	$REL
.ENDC ;NE UM$32K

.SBTTL	$RELF	- Macro to Mark Words to Relocate in FETCH/LOAD Code (XM Only)

;+
; $RELF
;
; Used to mark words to relocate in the FETCH/LOAD once-only code. 
; Use $REL to mark words to relocate in the body of the handler.
;
;	$RELF LOC VALUE BASE
;
;	LOC	-- Location of word to relocate
;	VALUE	-- Value to relocate it to
;	BASE	-- Base relocation on (UMR, UMX)
;
;-

.MACRO	$RELF LOC VALUE Base
.....1	=	.
.	=	LOC
.IF IDN	<UMX>	<Base>
	.WORD	VALUE-UMXBase+BEGREL
.	=	.....1
.MEXIT
.ENDC ;IDN <UMX> <Base>
.IF IDN	<UMR>	<Base>
	.WORD	VALUE-UMBase
.	=	.....1
.MEXIT
.ENDC ;IDN <UMR> <Base>
.ERROR	; Unknown B A S E "Base";
.ENDM	$RELF

;+
; PSECT Macros
;-

.MACRO	UMXPSECT
.IF NE MMG$T
	.SAVE
	.PSECT	UMX
.ENDC ;NE MMG$T
.ENDM 	UMXPSECT

.MACRO	UMPSECT
.IIF NE MMG$T	.RESTORE
.ENDM	UMPSECT

.SBTTL	RT-11 System Definitions

;+
; RT-11 System Communications Area (SYSCOM) and RMON Fixed Offsets
;-

	SYSPTR	=:  54		;Pointer to base of RMON

	QCOMP	=: 270		;Address of I/O COMPLT routine in RMON
	SPUSR	=: 272		;Special function error word
	CONFG2	=: 370		;Configuration word 2
		QBUS$	=: 100	; Qbus hardware
		PROS$	=: 20000; Running on PRO3xx
	MEMPTR	=: 430		;Fixed offset to memory pointers
	 CORPTX	=:   4		; Offset to extended memory block
	  FSIZE =:   0		;   Size 32 word units
	  FADDR =:   2		;   Address/32 of region

	P1EXT	=: 432		;Pointer to PAR1 externalization routine
	 CVAPHY	=: -16		;  JMP to convrt user virtual -> physical addr
	 FINDGR	=: -12  	;  Find global region addr/32; use name
	 XALLOC =:  -6		;  Allocate memory from free list
	 BLKMOV	=:  -2		;  Block Move Routine

;+
; Global Region Control Block (in free area).
;-

	GR.SIZ	=: 	0	;Size of global region in 32 word blocks.
	GR.ADR  =: 	2	;Base address in 32-word blocks
	GR.STA	=: 	4	;Status byte
	 GR.PVT =: 100000	;  Private region
	 GR.NRF =:     40	;  Don't return memory to free list
	GR.NAM 	=: 	6	;Name (2 RAD50 words)
	GR.ESZ	=:     10.	;Size of Global Region Control Block in bytes

;+
; PAR1 offsets
;-

	BEGREL	=:  20000	;Beginning of PAR1 virtual addr
	ENDREL 	=:  37776	;End of PAR1 virtual addr
	PGSIZ	=:  20000	;Page size in bytes

;+
; Miscellaneous RT definitions
;-

	TRAP4	=:	4	;Trap to 4 vector

	JOBMK	=:    370	;Job number mask (Q$UNIT)
	UNITMK	=:      7	;Unit number mask (Q$UNIT)

	KTGRAN	=:     32	;KT-11 addressing granularity
	KISAR1	=: 172342	;Kernel I-Space PAR1

	PS	=: 177776	;Processor Status Word

.SBTTL	Special Function Definitions

.IF NE UM$MU			;Magtape Only
	SP.WTM	=: 377		;Write Tape Mark
	SP.FWD	=: 376		;Forward space block
	SP.BKS	=: 375		;Backspace block
	;SP.WEX	=: 374		;Write with extended gap.  ** NOT SUPPORTED **
				;    If received,  handler  will  do  a  write
				;    physical (SP.WRT).  (TMSCP:  If  you  use
				;    Erase Gap, tapes affected may not be able
				;    to be read on all systems.)
	SP.REW	=: 373		;Rewind
	SP.ORW	=: 372		;Offline Rewind
	SP.WRT	=: 371		;Write physical block
	SP.RD	=: 370		;Read physical block
	SP.STR	=: 367		;Stream at 100ips (MS: only) ** IGNORED **
	SP.BYP	=: 360		;Bypass handler, pass MSCP -> port
	SP.ASY	=: 354		;Asynchronous directory operation
.ENDC ;NE UM$MU
.IF NE UM$DU			;Disk Only
	SP.RIO	=: 377		;Absolute Read  I/O
	SP.WIO	=: 376		;Absolute Write I/O
	SP.VSZ	=: 373		;Return Volume Size
	SP.DAT	=: 372		;Read/Write Unit Translation Table
	SP.DUC	=: 371		;DU Compatible Bypass: does SP.BYP
	SP.BYP	=: 360		;Bypass handler, pass MSCP -> port
.ENDC ;NE UM$DU

;+
; Special Function Return Codes
;-

.IF NE UM$MU
	RC.DIE	=:   2		;Device in use by other job (.LOOKUP)
	RC.INV	=:   5		;Invalid argument (.LOOKUP) or function
.ENDC ;NE UM$MU

.SBTTL	Unit Translation Table Offsets

;+
; Unit Translation Table Offsets
;-

	UT.UNIT	=:	 0	;MSCP unit number (1 byte).
	UT.JOBN	=:	 1	;Job #: job owns unit (1 byte). (Tape only)
.IF NE UM$MU
	 UT.AVAL=:     377	;     : = -1 -> unit available  (Tape only) 
.IFF ;NE UM$MU
	 UT.AVAL=:	 0	;     : 0 if not Magtape 
.ENDC ;NE UM$MU
	UT.PART =:	 2	;Disk partition to use (1 byte). (Disk only)
	UT.PORT	=:	 3	;UDA port to be used (1 byte).
	UT.ESZ	=:	 4	;Unit translation table entry size.

;+
; Miscellaneous definitions
;-

	ILG.V	=:	4	;Illegal address trap vector
	INS.V	=:     10	;Illegal instruction trap vector

	NRETRY	=:	8.	;Retry initialization up to 8 times.

	BLK0	=:	0	;Block zero
	BLK	=:   1000	;Size of a block in octal (512 bytes)

	VT.ESZ	=:	6	;Size of RT-11 vector table in bytes.

.SBTTL	.DRDEF	- Device Definition

	UM$PRI	=: 5			;Device priority level

.IF NE UM$MU			;If TMSCP driver
 .IIF NDF MU$FSM MU$FSM = 0		;No file structure if not defined
 .IIF NE  MU$FSM MU$FSM = 1		;File structure (make 0 or 1)
 .IIF DF  MU$CSR UM$CSR = MU$CSR
 .IIF DF  MU$VEC UM$VEC = MU$VEC
 .IIF NDF MU$UN  MU$UN == 1		;Assume at least one unit

	.DRDEF	UM,60,<HNDLR$!SPECL$!SPFUN$!ABTIO$>,0,174500,260
	UM$HND = <^RMU >		;Handler (MU) & global region (MU $  )
					; name to use instead of .MODULE's UM.
 	MU$PORTS = MU$UN		;For now, # of ports = # of units.
 .IIF LE  MU$PORTS-1, MU$PORTS = 1	;Never let the number be less than 1.
	UM$PORTS = MU$PORTS		;For use in common code	
 .IIF NDF MU$CS1, MU$CS1 = MU$CSR-04
	UM$CS1	= MU$CS1
 .IIF NDF MU$CS2, MU$CS2 = MU$CSR-10
	UM$CS2	= MU$CS2
 .IIF NDF MU$CS3, MU$CS3 = MU$CSR-14
	UM$CS3	= MU$CS3
 .IIF NDF MU$VC1, MU$VC1 = MU$VEC-04
	UM$VC1	= MU$VC1
 .IIF NDF MU$VC2, MU$VC2 = MU$VEC-10
	UM$VC2	= MU$VC2
 .IIF NDF MU$VC3, MU$VC3 = MU$VEC-14
	UM$VC3	= MU$VC3
.ENDC ;NE UM$MU

.IF NE UM$DU
 .IIF DF DU$CSR UM$CSR = DU$CSR
 .IIF DF DU$VEC UM$VEC = DU$VEC

	.DRDEF	UM,50,<FILST$!SPFUN$!VARSZ$>,0,172150,154
	UM$HND = <^RDU >		;Handler (DU) & global region (DU $  )
					; name to use instead of .MODULE's UM.
 .IIF NDF DU$PORTS,	DU$PORTS = 1	;Default number of ports to 1.
 .IIF LE  DU$PORTS-1,	DU$PORTS = 1	;Never let the number be less than 1.
	UM$PORTS = DU$PORTS		;For use in common code	
 .IIF NDF DU$ALT, DU$ALT = 176150	;Alternate "standard" CSR
 .IIF NDF DU$CS1, DU$CS1 = DU$CSR-04
	UM$CS1	= DU$CS1
 .IIF NDF DU$CS2, DU$CS2 = DU$CSR-10
	UM$CS2	= DU$CS2
 .IIF NDF DU$CS3, DU$CS3 = DU$CSR-14
	UM$CS3	= DU$CS3
 .IIF NDF DU$VC1, DU$VC1 = DU$VEC-04
	UM$VC1	= DU$VC1
 .IIF NDF DU$VC2, DU$VC2 = DU$VEC-10
	UM$VC2	= DU$VC2
 .IIF NDF DU$VC3, DU$VC3 = DU$VEC-14
	UM$VC3	= DU$VC3
.ENDC ;NE UM$DU

.IIF EQ	UM$PORTS-1,	UM$BOO	= 0	;Never multi-port boot on one port.

.SBTTL	.DRPTR	- .DREST, .DRSPF Macro Invocations

.IF NE UM$MU
	.DRPTR	FETCH=ONCE,LOAD=ONCE
	.DREST	CLASS=DVC.MT
	.DRSPF	SP.WTM			;377 Write Tape Mark
	.DRSPF	SP.FWD			;376 Forward space block
	.DRSPF	SP.BKS			;375 Backspace block
	;	(SP.WEX)		;374 Write w/ext. gap
					;     ** NOT SUPPORTED ** If received,
					;     handler  does   write   physical
					;     (SP.WRT).  (TMSCP:  If  you  use
					;     Erase Gap,  tapes  affected  may
					;     not be able to be  read  on  all
					;     systems.)
	.DRSPF	SP.REW			;373 Rewind
	.DRSPF	SP.ORW			;372 Offline Rewind
	.DRSPF	SP.WRT			;371 Write physical block
	.DRSPF	SP.RD			;370 Read physical block
	;	(SP.STR)		;367 Stream @ 100ips **NOT SUPPORTED**
	.DRSPF	SP.BYP			;360 Bypass handler, pass MSCP -> port
 .IF NE MU$FSM				;If file structured
	.DRSPF	SP.ASY			;354 Asynchronous Directory Operation
 .ENDC ;NE MU$FSM
.ENDC ;NE UM$DU
.IF NE UM$DU
	.DRPTR	FETCH=ONCE,LOAD=ONCE
	.DREST	CLASS=DVC.DK
	.DRSPF	SP.RIO			;377 Absolute Read  I/O
	.DRSPF	SP.WIO			;376 Absolute Write I/O
	.DRSPF	SP.VSZ			;373 Return Volume Size
	.DRSPF	SP.DAT			;372 Read/Write Unit Translation Table
	.DRSPF	SP.DUC			;371 DU Compatible Bypass: does SP.BYP
	.DRSPF	SP.BYP			;360 Bypass handler, pass MSCP -> port
.ENDC ;NE UM$DU


.SBTTL	Psect Ordering

	.PSECT	UMDVR			;Handler Code
.IF NE UM$MU
 .IF NE MU$FSM
	.PSECT	MTDVR			;Magtape FSM Code: MU only
 .ENDC ;NE MU$FSM
.ENDC ;NE UM$MU
	.PSECT	SETOVR			;SET Code Overlays
.IF NE UM$DU
	.PSECT	UMBOOT			;Boot Code: DU only
.ENDC ;NE UM$DU
.IF NE MMG$T
	.PSECT	UMX			;Handler Extended Memory Code: XM only
UMXBAS::

 .IF NE UM$MU				;If magtape
	CRBSIZ =: P.CSIZ+P.MSIZ+10	;Size of cmd/resp buffers, length & 
					; virtual circuit id words.
	MEMUMX = <UMXSIZ+CRBSIZ+77>/100	;Required global region size
					;(Add 77 to be sure we got it all)
 .ENDC ;NE UM$MU
 .IF NE UM$DU				;If disk
  .IIF  EQ DU$BBR MEMUMX =: 100		;Required global region size: No   BBR
  .IIF  NE DU$BBR MEMUMX =: 200		;Required global region size: With BBR
 .ENDC ;NE UM$DU

.ENDC ;NE MMG$T

;+
; Should do this, but FSM.MAC has '.DREND MT' for file structured case
;	.PSECT	UMEND			;Handler end
;	.DREND	UM,PSECT=UMEND
;-

.SBTTL	.DRINS	- Installation Code

	.ASECT
	. = 0
REF0::					;Reference point zero
	. = 120

;+
; Installation code and EMT area for updating boot-time CSR
;-

.IF EQ UM$PORTS-1
	.DRINS	UM
.IFF
 .IF EQ UM$PORTS-2
	.DRINS	UM,<UM$CS1>
 .IFF
  .IF EQ UM$PORTS-3
	.DRINS	UM,<UM$CS1,UM$CS2>
  .IFF
	.DRINS	UM,<UM$CS1,UM$CS2,UM$CS3>
  .ENDC ;EQ UM$PORTS-3
 .ENDC ;EQ UM$PORTS-2
.ENDC ;EQ UM$PORTS-1

	BR	DATAIN			;Data device entry
.IF NE UM$MU
	BR	I.BAD			;System device entry: no MU system
.ENDC ;NE UM$MU
.IF NE UM$DU
	BR	SYSTIN			;System device entry; skip global
.ENDC ;NE UM$DU

.SBTTL	DAT/SYSTIN - Data and System Device Installation Routines

.IF NE MMG$T
;+ 
; To prevent .FETCH/LOAD error on data devices where there is no more
;  memory.
;-

.IFTF ;NE MMG$T


DATAIN:	MOV	@#SYSPTR,R4		;R4 = base of RMON
	BIT	#<PROS$>,CONFG2(R4)	;Running on the PRO?
	BNE	I.BAD			;Branch out with error if yes
.IFT ;NE MMG$T
	MOV	MEMPTR(R4),R0		;R0 = offset to memory ptr
	ADD	R4,R0			;R0 -> table of memory ptr
	MOV	CORPTX(R0),R5		;R5 = offset to free list
	ADD	R4,R5			;R5 -> free list
20$:	CMP	#-1,(R5)+		;End of list ?
	BNE	20$			;No, keep looking for it!
; R5 -> Start of region control block area
30$:	CMP	#-1,@R5			;End of RCB list ?
	BEQ	I.BAD			;Yes, branch ; failure
	TST	@R5			;Empty entry ?
	BEQ	40$			;Yes, branch; found an entry
	ADD	#GR.ESZ,R5		;Point to next entry
	BR	30$			;Repeat

; R5 -> Entry RCB
40$:	MOV	P1EXT(R4),R0		;R0 -> PAR1 externalization routines
	MOV	#MEMUMX,R2		;R2 = Size/32 memory
	CALL	XALLOC(R0)		;Get memory from free list
	BCS	I.BAD			;Branch if not obtained!
; Build RCB
	MOV	R2,(R5)+		;Store the Size/32
	MOV	R1,(R5)+		;Store the Addr/32
	MOV	#GR.PVT,(R5)+		;Store status = private
	MOV	#UM$GBL,(R5)+		;Store name 1st word (^RMU , or ^RDU )
	MOV	#<^R$>,@R5		;Store name 2nd word
	.DSABL	LSB
.ENDC ;NE MMG$T

.IF NE UM$DU
 .IF EQ UM$BOO				;Disable FALCON if multi-port booting!
SYSTIN:	CLR	R0			;Reset for later test
	MFPT				;Determine processor type
;>>>is this trapped if the processor does not do MFPT?
	CMP	R0,#4			;On a FALCON?
	BNE	I.GOO			;Nope, we'll use normal CSR
	TST	@#UM$ALT		;Yes, does alternate CSR exist?
  .IF EQ MMG$T
	NOP				;  (delay for SBC)
  .ENDC ;EQ MMG$T
	BCS	I.BAD			;Nope, reject installation
 .ENDC ;EQ UM$BOO
.ENDC ;NE UM$DU

;+
; Installation Common Exit Point
;-

I.GOO:	TST	(PC)+
I.BAD:	SEC
	RTS	PC

.SBTTL	OV.xxx	- SET Code Dispatch Routines.

;+
; The following routines will prepare for the call to the SET overlay
;
; *NOTE* Installation area is borrowed for this code.
;-
	.ENABL	LSB

.IF NE UM$DU				;Only DU SETs UNIT, PARTition, PORT
OV.UT:	MOV	#SET.UT/2,R2		;R2 = addr/2 to pass control
	BR	10$			;Merge

.ENDC ;NE UM$DU
OV.CSR:	MOV	#SET.CSR/2,R2		;R2 = addr/2 to pass control
	BR	10$			;Merge

OV.VEC:	MOV	#SET.VEC/2,R2		;R2 = addr/2 to pass control
	BR	10$			;Merge

OV.RET:	MOV	#SET.RET/2,R2		;R2 = addr/2 to pass control
.IF NE UM$DU				;If disk
10$:	BR	GETOVR			;Go to read overlay
.ENDC ;NE UM$DU
.IF NE UM$MU				;If Magtape
10$:	CALLR	GETOVR			;Go to read overlay
.ENDC ;NE UM$MU

	.DSABL	LSB

.ASSUME	. LE 400,>;INSTALL area overflow>

.SBTTL	.DRSET	- SET Code Tables

;+
; SET Definitions and Tables.
;-

.IF NE UM$DU				  ;Only DU SETs UNIT, PARTition, PORT
	.DRSET	UNIT,UT.UNIT+1,XOV.UT,NUM ; +1 avoids a 0 entry (terminator)
	.DRSET	PART,UT.PART+1,XOV.UT,NUM ; +1 avoids a 0 entry (terminator)
 .IF NE UM$PORTS-1
	.DRSET	PORT,UT.PORT+1,XOV.UT,NUM
 .ENDC ;NE UM$PORTS-1
.ENDC ;NE UM$DU

	.DRSET	CSR,<0*2+1>,XOV.CS,OCT
	.DRSET	VECTOR,<0*2+1>,XOV.VE,OCT
	.DRSET	CSR0,<0*2+1>,XOV.CS,OCT
	.DRSET	VEC0,<0*2+1>,XOV.VE,OCT
					  ;Optional SET hooks
.IF NE UM$PORTS-1
	.DRSET	CSR1,<1*2+1>,XOV.CS,OCT
	.DRSET	VEC1,<1*2+1>,XOV.VE,OCT
 .IF NE UM$PORTS-2
	.DRSET	CSR2,<2*2+1>,XOV.CS,OCT
	.DRSET	VEC2,<2*2+1>,XOV.VE,OCT
  .IF NE UM$PORTS-3
	.DRSET	CSR3,<3*2+1>,XOV.CS,OCT
	.DRSET	VEC3,<3*2+1>,XOV.VE,OCT
  .ENDC ;NE UM$PORTS-3
 .ENDC ;NE UM$PORTS-2
.ENDC ;NE UM$PORTS-1
	.DRSET	RETRY,8.,XOV.RE,NUM
.IF NE ERL$G
	.DRSET	SUCCES,-1,OV.SUC,NO
.ENDC ;NE ERL$G

.IF NE UM$DU				;Only DU SETs UNIT, PARTition, PORT
XOV.UT:	BR	OV.UT

.ENDC ;NE UM$DU
XOV.CS: BR 	OV.CSR

XOV.VE:	BR	OV.VEC

XOV.RE: BR	OV.RET

.IF NE ERL$G
OV.SUC:	CLR	R2			;'YES' entry
	BR	ACNO			;Skip next

OV.NO:	MOV	#4/2,R2			;Address + 4 / 2 ('NO' entry)
.Assume OV.NO EQ OV.SUC+4,<;NO option is in wrong place>
ACNO:	ADD	#SET.SUC/2,R2		;R2 = addr/2 to pass control
	BR	GETOVR			;Go to read overlay

.ENDC ;NE ERL$G

.ASSUME . LE <1000-144>,<;SET code overlaps GETOVR code>

					; start! 

.SBTTL	GETOVR	- Get Overlay SET Code Routine From Disk

;+
; GETOVR - The following routine will read a disk overlay from disk
;	   containing the requested SET routine. It will also calculate
;	   the entry point in the overlay for the specific routine!
;	
;		Input : R2 = addr/2 of routine to enter
;
; NOTE: The Overlays will be read to block 0 - but not an entire block will
;	be read! A routine will always be kept in block 0 to bring the real
;	block zero into memory when the overlay has finished.
;-
	.ENABL	LSB

	. = 1000 - 144			;Don't slide down

GETOVR:	SWAB	R2			;Get blk number into low byte
	MOVB	R2,REABLK		;Store the blk into EMT
	BIC	#377,R2			;Clear blk, offset in high
;	BIS	#BLK0/BLK,R2		;User buffer block for addr
	.ASSUME	BLK0 EQ 0 
	JSR	R0,10$			;Save R0, R0 -> EMT
REAFUN:	 .BYTE	17,10			;  Channel , READ
REABLK:	 .BLKW	1			;  Block number to read
REABUF:	 .BLKW	1			;  Buffer addr to read
	 .WORD	VALWCT			;  Words to read!
	 .WORD	0			;  Wait mode I/O
10$:	.ADDR	#BLK0,R5,PUSH		;Get addr of buffer
	MOV	R5,REABUF		;Save into EMT
	MOV	(SP)+,R5		;Restore R5
;****************************************************************************
	VALWCT =: ./2			;Read till here - protect the rest  *
	OVRSIZ =: .			;Use in .ASSUME in overlay code     *
;****************************************************************************
	EMT	375			;***.READW***
	MOV	(SP)+,R0		;Pop R0, save Carry
	BCS	SET.NOR			;Branch if error
	SWAB	R2			;Get addr back
	ASL	R2			;Make into byte offset
	.ADDR	#BLK0,R2,ADD		;Make into real address
	JMP	@R2			;Go to routine
	.DSABL	LSB

.SBTTL	GETBK0	- Read Block Zero - Resident Routine

;+
; GETBK0 - This routine will not be overlayed by the SET code - instead
; 	   it will always be called by the SET code routines to exit.
;	   The routine reads the real block zero from disk!
;-
	.ENABL	LSB

GETBK0:	JSR	R0,10$			;Save R0 - point to EMT block
RDZERO:  .BYTE	17,10			;  Channel, READ
RDBLK:	 .WORD	BLK0			;  Read block zero from disk
RDBUF:	 .BLKW	1			;  Buffer address 
RDWC:	 .WORD	VALWCT			;  Wordcount
	 .WORD	0			;  Wait I/O
10$:	.ADDR	#BLK0,R3		;Get address of buffer
	MOV	R3,RDBUF		;Store into EMT block
	EMT	375			;***READW***
	MOV	(SP)+,R0		;Pop stack, save Carry
	BCS	SET.NOR			;Exit if error!

; Common exit for everyone (including overlays)

SET.EX: TST	R2			;Any previous errors ?
	BEQ	SET.NOR			;No, branch
	DEC	R2			;Usual error
	BEQ	SET.ERR			;Yes, branch
	ADD	#2,(SP)			;Write protect error - return 
SET.ERR:SEC				;Indicate error
SET.NOR:RTS	PC			;Return

	.DSABL	LSB
SET.END:
	OSIZ  ==: SET.END - GETOVR	;Size of fixed code!
.ASSUME	. LE 1000,<;SET area overflow (GETOVR)>

.SBTTL	OVR1	- SET Code Overlay Number 1

	.PSECT	SETOVR			;This Psect must be block aligned.
OVRBK0:

; Define the bias

	BIAS	==: <OVRBK0 - REF0>	;Bias due to overlay

; Define storage locations

VALUE:	.WORD	0			;Value to store 
OFFSET:	.WORD	0			;Offset to primary driver

.IF NE UM$BOO
	OFF2TA	= 8.*2*2		;Offset to 2nd table port/csr in 
					; the primary driver
.ENDC	;NE UM$BOO
.IF NE UM$DU				;Only DU SETs UNIT, PARTition, PORT

.SBTTL SET.UT	- SET UNIT, PORT, and PARTITION

;+
; Set code for MSCP Unit, Port and Partition.
;-

SET.UT:	DEC	R3			;Convert R3 value to table offset.
	CMP	R0,#255.		;Is this a legal value?
	BHI	HLP1			;No, take error exit.
 .IF NE UM$PORTS-1
	CMP	R3,#UT.PORT		;Is this the SET PORT command?
	BNE	10$			;No, then go process the set.
	CMP	R0,#UM$PORTS-1		;Then is it a legal port number.
	BHI	HLP1			;No, take error exit.
 .ENDC ;NE UM$PORTS-1
10$:	BIC	#100000,R1		;Strip the "device vs unit" flag.
	ASL	R1			;Create an index into the RT-11...
	ASL	R1			; ...to MSCP translation table.
 .IF NE UM$BOO
	MOV	R1,OFFSET		; ...Primary driver UNIT/PORT table.
 .ENDC ;NE UM$BOO
	.ASSUME UT.ESZ EQ 4
	.ADDR	#UTTAB+BIAS,R1,ADD	;R1 -> UTTAB
	ADD	R3,R1			;Now it points to the item.
	MOVB	R0,(R1)			;Store it in the table.
 .IF NE UM$BOO
	MOV	R0,VALUE		;Save value to store
	CMP	R3,#UT.PORT		;Was this a SET PORT command ?
	BNE	20$			;No, branch
	ADD	#2,OFFSET		;Offset into port entry
	BR	30$			;Skip next

20$:	CMP	R3,#UT.UNIT		;Was this a SET UNIT command ?
	BNE	S.NOR			;No, branch
30$:	MOV	#PD.POR/1000,R3		;Save block number in R3
	CALL	CORWRT			;Write block zero - Read N
	BCS	S.IGN			;Branch if error
	ADD	OFFSET,R2		;(R2 -> buffer) Get correct offset
	MOV	VALUE,<PD.POR&777>(R2)	;Set the boot-time port
	CALL	CORREA			;Write block N - Read zero
	BCS	S.IGN			;Branch if error
	BR	S.NOR			;Branch if no error
		
 .IFF ;NE UM$BOO
	BR	S.NOR			;Exit with success status
 .ENDC ;NE UM$BOO
.ENDC ;NE UM$DU
.IF NE ERL$G

.SBTTL SET.SUC	- SET SUCCESS

;+
; Set code for success error logging.
;-

SET.SUC:
	CLR	R3			;Clear the preset flag.
	NOP				;No, entry = SET.SUC+4.
	MOV	R3,$SUCS+BIAS		;Set the appropriate value.
	BR	S.NOR			;Exit with success status.

.ENDC ;NE ERL$G
.SBTTL SET.RET	- SET RETRY

;+
; Set code for retry count
;-

SET.RET:
	CMP	R0,R3			;Is the count too large?
HLP1:	BHI	S.ERR			;Yes, then take error exit.
	MOV	R0,$RETRY+BIAS		;No, then store the value.
	BR	S.NOR			;Exit with success status.

.SBTTL	SET.CSR	- SET CSR

;+
; SET code for CSR(s)
;-

SET.CSR:
	CMP	R0,#160000		;Is this a valid CSR address?
	BLO	S.ERR			;No, then take the error exit.
	MOV	R0,VALUE		;Store value - to free R0
	MOV	R3,OFFSET		;Save offs to primary driver table
	MOV	#BLK0,R3		;Read block zero
	CALL	CORWRT			;Write block 1 - read n
	BCS	S.IGN			;Branch if error!
	DEC	OFFSET			;Convert from 1,3,5,7 to 0,2,4,6
	BNE	10$			;Not 0, don't change install CSR
	MOV	VALUE,INSCSR+BIAS+1000	;Set the installation CSR
10$:	MOV	OFFSET,R0		;Make a copy of the offset
	NEG	R0			;Negate it for reversed CSR table
	.ADDR	#DISCSR+BIAS+1000,R0,ADD ;Calculate pickly
	MOV	VALUE,(R0)		;Now set the display CSR in question
	MOV	#BLK0,R3		;Write block n = 0
	CALL	CORREA			;Write block n - read 1
	BCS	S.IGN			;Branch if error
	MOV	OFFSET,R3		;Restore offset into R3
.IF NE UM$BOO
	ADD	#OFF2TA,OFFSET		;Offset PORT/CSR table entry to fill
.ENDC ;NE UM$BOO
.IF NE UM$PORTS-1
	ASL	R3			;  * 4
	ASL	R3			;  *10
	.ASSUME PC.ESZ EQ 10
	.ADDR	#PCTAB+BIAS,R1		;R1 -> PC table, set CSR there
	ADD	R3,R1			;Add table entry offset
.IFF ;NE UM$PORTS-1
	.ADDR	#UDAIP+BIAS,R1		;R1 -> directly to command.
.ENDC ;NE UM$PORTS-1
	MOV	VALUE,(R1)+		;Store the AIP address.
	.ASSUME PC.AIP EQ 0
	MOV	VALUE,@R1		;Store the ASA address.
	.ASSUME PC.ASA EQ 2
	ADD	#2,@R1			;It is 2 greater than the AIP.
.IF NE UM$MU				;If magtape
	BR	S.NOR			;Done
.ENDC ;NE UM$MU
.IF NE UM$DU				;If disk
 .IF NE UM$PORTS-1
  .IF EQ UM$BOO
	TST	R3			;Is this port 0?
	.ASSUME PC.AIP EQ 0.
	BNE	S.NOR			;Nope, so leave boot-time CSR alone
  .ENDC ;EQ UM$BOO
 .ENDC ;NE UM$PORTS-1

 .IF EQ UM$BOO
	MOV	#BUMAIP/1000,R3		;Save block number
 .IFF ;EQ UM$BOO
	MOV	#PD.POR/1000,R3		;Save block number in R3
 .ENDC ;EQ UM$BOO
	CALL	CORWRT			;Write block 1 - Read n
	BCS	S.IGN			;Branch if error
 .IF EQ UM$BOO
	MOV	VALUE,<BUMAIP&777>(R2)	;Set the boot-time port
 .IFF ;EQ UM$BOO
	ADD	OFFSET,R2		;Get correct offset
	MOV	VALUE,<PD.POR&777>(R2)	;Set the boot-time port
 .ENDC ;EQ UM$BOO
	CALL	CORREA			;Write block n - Read 1
	BCS	S.IGN			;Branch if error
	BR	S.NOR			;Branch if no error
.ENDC ;NE UM$DU

.SBTTL SET.VEC	- SET VECTOR(S)

;+
; Set code for vectors
;-

SET.VEC:
	CMP	R0,#500			;Is this a valid vector address.
	BHIS	S.ERR			;No, then take SET.ERR exit.
.IF NE UM$PORTS-1
	.ADDR	#UM$VTB+BIAS,R1		;R1 -> handler vector table.
	DEC	R3			;Change from 1,3,5,7 to 0,2,4,6
	MOV	R3,-(SP)		;Save it for later
	ASL	R3			;Now convert to vector table entry
	ADD	(SP),R3			;  offset
	.ASSUME VT.ESZ EQ 6
	ADD	R3,R1			;R1 -> specific entry.
.IFF ;NE UM$PORTS-1
	.ADDR	#UMSTRT+BIAS,R1		;R1 -> single vector entry.
.ENDC ;NE UM$PORTS-1
	MOV	R0,@R1			;Store the vector.
.IF NE UM$PORTS-1
	ADD	(SP)+,R1		;Correct for disparity in table sizes
	.ASSUME PC.ESZ EQ 10
	ADD	#PCTAB-UM$VTB+PC.VEC,R1
					;Move to the equivalent PCTAB entry.
	.ASSUME VT.ESZ+2 EQ PC.ESZ
.IFF ;NE UM$PORTS-1
	.ADDR	#INILST+BIAS,R1		;R1 -> directly to command.
.ENDC ;NE UM$PORTS-1
	ASR	R0			;Divide by 2.
	ASR	R0			;Divide by 4.
	BIS	#IE,R0			;Or in the interrupt enable.
	MOVB	R0,@R1			;Store the computed vector.
	BR	S.NOR			;Take the success exit.

.SBTTL	ADIOS	- Common Exit Point For Overlayed Code

;+
; Common exit back to block 0 resident part
; Set code error and success exits
;-

S.NOR:	CLR	R2			;Indicate no error
S.IGN:	CMP	(PC)+,(PC)+		;SKip next; Error already set R2
S.ERR:	MOV	#1,R2			;Indicate common error
	JMP	GETBK0+BIAS		;Go to block zero


.SBTTL	CORE	- Sub/Coroutine For Core Reads/Writes

;+
; This routine will write block 1 to disk - read block n indicated by
; register 3 - return to caller - write block n back to disk with the 
; changes the caller made - read block 1 back - return to caller.
; It is assumed that after the first call to CORWRT then modifications
; will be made and a call to CORREA is performed.
; In one case the bootstrap block is read - in another case block zero
; is read to modify the installation CSR etc.
;
; Input: 	R3 = block to read
; Output:	R2 = buffer 
;-

					;EMT area for accessing handler file
BAREA:	.BYTE	17,11			;  Channel 17, write
	.BLKW				;  Block number
	.BLKW				;  Buffer address
	.WORD	256.			;  Transfer length (256. words)
	.WORD	0			;  Wait-mode

CORWRT:	.ADDR	#BAREA+4,R1		;R1 -> BAREA+4 (buffer address)
	.ADDR	#1000+BIAS,R2		;R2 -> BUFFER (overwrite incore blk 1)
	MOV	R2,(R1)			;Set the buffer address
	MOV	#1,-(R1)		;Set up to save the current
	TST	-(R1)			; block one as it may have been
					; altered by a previous SET command
	MOV	R1,R0			; because we need R0 for the EMT's
	EMT	375			;*** .WRITW ***
	BCS	C2.ERR			;In case the write failed.
	MOV	R1,R0			;Restore R0
	DECB	1(R0)			;Make it a read.
	MOV	R3,2(R0)		;Set the block to Read
	EMT	375			;*** .READW ***
	BCS	C.ERR			;In case read fails
	BR	C.NOR		

CORREA:	MOV	R1,R0			;R0 -> EMT area again
	INCB	1(R0)			;Change it to a write
	MOV	R3,2(R0)		;Set block to write
	EMT	375			;*** .WRITW ***
	BCS	C2.ERR			;In case write fails...
	MOV	R1,R0			;R0 -> EMT area (one more time...)
	DECB	1(R0)			;Change it back to a read
	MOV	#1,2(R0)		; of block 1 of handler
	EMT	375			;*** .READW ***
	BCS	C.ERR			;In case read fails...
	INCB	1(R1)			;Restore EMT block to WRITE
	BR	C.NOR

C2.ERR:	MOV	#2,R2			;Indicate failure
	BR	C.NOR

C.ERR:	MOV	#1,R2			;Indicate failure
C.NOR:	RTS	PC			;Return to caller
.ASSUME	<.-OVRBK0> LE OVRSIZ,<;SET overlay overflow>


.SBTTL	ONCE	- Special .DRPTR Load/Fetch Once-Only Code.

;+
; This code will perform various things,
;	
;	o Create a global region under XM,
;	o Check for Falcon,
;	o Install CSR checks,
;	o Attach to an existing global region.
;
; The advent of the .DRPTR macro allows this once only code to reside here.
; 
;	INPUT:
;		R0 -> handler routine being called.
;		R1 -- undefined
;		R2 -- SLOT*2 (SLOT is # of this device in monitor tables)
;		R3 -- type of routine being called.
;		R4 -> read routine
;		R5 -> $ENTRY word (handler fourth word)
;-
	. = OVRBK0 + <1*BLK>		;Block boundary
OVRBK1:

ONCE:: 	MOV	R2,(PC)+		;Save some of the parameters
SSLOT:	 .WORD	0			; SLOT*2 saved
	MOV	R4,(PC)+		;Save read routine
SRDRTN:	 .WORD	0			; Read routine saved
	MOV	R5,(PC)+		;Save $ENTRY ptr
SENTRY:	 .WORD	0			; $ENTRY saved
	MOV	@R5,R3			;R3 -> entry point handler
.IF NE UM$DU				;If disk
 .IF EQ UM$BOO
	CALL	FALCON			;Check if we are on a FALCON
 .ENDC ;EQ UM$BOO
.ENDC ;NE UM$DU
.IF NE UM$PORTS-1			;If more than one port
	CALL	CKPORT			;Go check ports
.ENDC ;NE UM$PORTS
.IF NE MMG$T
	CALL	ONCEXM			;Jump to rest of code in buffer!
	 BR	D.BAD			; Return here if error

; Go read code into upper memory
	CALL	UPUMX			;Read psect UMX up in memory
	BCS	D.BAD			;Branch if error
.ENDC ;NE MMG$T
	.BR	D.GOO

;+
; Common exit points
;-

D.GOO:	TST	(PC)+			;Skip next; clear Carry
D.BAD:	SEC				;Set Carry
	RETURN				;Return to caller

; Definitions

UMNAME:	.WORD	UM$GBL			;Global name 1st word: ^R'MU 'or 'DU '
	.RAD50	/$  /			;2nd word

.IF NE MMG$T				;For next page

.SBTTL	UPUMX	- Move Psect UMX to High Memory (XM Only)

;+
; UPUMX
;
; Input:
;	R0 = High 6 bits of global region physical address
; 	R1 = Low 16-bits of global region physical address
;	R3 -> Handler + 6
;-
	.ENABL	LSB

UPUMX::	CALL	UPSET			;Setup for the move
	MOV	@#KISAR1,-(SP)		;Save mapping
	MOV	P1HIGH-UMBASE(R3),@#KISAR1 ;Map to high memory
10$:	MOV	#BLK,R1			;Prepare to read 1 block.
	CMP	R4,R1			;Read less than 1 block ?
	BGT	20$			;Yes, branch
	MOV	R4,R1			;Use the remaining byte count
20$:	SUB	R1,R4			;Update bytes left.
	ASR	R1			;R1 = wordcount
	.ADDR	#ONCBUF,R2		;R2 -> buffer to read	
	MOV	R1,-(SP)
	CALL	@SRDRTN			;Read UMX
	MOV	(SP)+,R1
	BCS	140$			;Branch if error
30$:	MOV	(R2)+,(R5)+		;Store word
	SOB	R1,30$			;Loop till finished
; R5 -> is updated for next storage locations
	INC	R0			;Next block
	TST	R4			;Any more to read?
	BNE	10$			;Branch if more
	.BR	40$
;+
; UMX is in our region ... R3 -> HANDLER + 6 ... Init command/response area.
;-

 .IF EQ MU$32K				;If no 32KW bound check
40$:	MOV	#LN.CMD,R1		;R1 -> start of cmd bufr area -4
	$RELF .-2 LN.CMD UMX		; ...
 .IFF ;EQ MU$32K
40$:	MOV	#-4,R1			;R1 -> start of cmd bufr area -4
	.ASSUME	LN.CMD EQ CBUFF-4
	ADD	(PC)+,R1		;Use local pointer, since PAR1 is away
FPCBUF:	 .WORD	0			;( -> Start of cmd buffer area )
 .ENDC ;EQ MU$32K
	MOV	#P.CSIZ+4,R2		;R2 = size to clear (words)
50$:	CLR	(R1)+			;Clear word
	SOB	R2,50$			;Loop
;Fix the UMR references in UMX.
 .IF NE MU$32K				;If 32Kw bound check
	MOV	VAOFF,R4		;Get cmd/resp buffer offset
 .ENDC ;NE MU$32K
	.ADDR	#UMR.LST,R0		;Point to rel list
60$: 	MOV	(R0)+,R1		;Get next reloc list entry
	BEQ	70$			;Done this list
 .IF NE MU$32K				;If 32Kw bound check
	ADD	R4,R1			;Plus offset for cmd/resp buffer
 .ENDC ;NE MU$32K
	ADD	R3,@R1			;Relocate value in address
	BR	60$			;And do next

 .IF EQ MU$32K				;If no 32KW bound check
70$:	.BR	80$
 .IFF ;EQ MU$32K			;If 32KW bound check
;Fix UMX references in UMX.
70$:	MOV	(R0)+,R1		;Get next reloc list entry (UMH.LST)
	BEQ	80$			;Done this list
	ADD	R4,R1			;Plus offset for cmd/resp buffer
	ADD	R4,@R1			;Relocate value in address
	BR	70$			;And do next
 .ENDC ;EQ MU$32K

;+
; Relocate some pointers.
;-

 .IF EQ MU$32K				;If no 32KW bound check
80$:	MOV	#20000,R5		;R5 -> virtual start
 .IFF ;EQ MU$32K
80$:	MOV	(PC)+,R5		;R5 -> virtual start
SVADR:	 .WORD	0			; Starting virtual addr of hi mem code
 .ENDC ;EQ MU$32K
	MOV	@#KISAR1,R1		;Save high mapping
	MOV	(SP),@#KISAR1		;Restore low mapping
 .IF NE MU$32K				;If 32KW bound check
;Fix UMX references in Root.
90$:	MOV	(R0)+,R2		;Get next reloc list entry (UMX.LST)
	BEQ	100$			;Done this list
	ADD	R3,R2			;Add address of handler in memory
	ADD	R4,@R2			;Relocate value in address
	BR	90$			;And do next
 .ENDC ;NE MU$32K

100$:	MOV	$MPPTR-UMBASE(R3),-(SP)	;Store $MPPTR
	MOV	$PTWRD-UMBASE(R3),-(SP)	;Store $PTWRD
	MOV	$GTBYT-UMBASE(R3),-(SP)	;Store $GTBYT
 .IF NE ERL$G
	MOV	$ELPTR-UMBASE(R3),-(SP)	;Store $ELPTR
 .ENDC ;NE ERL$G
 .IF NE UM$MU				;If Magtape
	MOV	$RLPTR-UMBASE(R3),-(SP)	;Store $RLPTR
 .ENDC ;NE UM$MU
	MOV	@#SYSPTR,R2		;R2 -> base of RMON
	MOV	P1EXT(R2),-(SP)		;Store $P1EXT in stack too
	MOV	(SP),$P1EXT-UMBASE(R3)	;Store address in low memory
	MOV	R1,@#KISAR1		;Map back to high memory
	MOV	(SP)+,H$P1EX-UMXBAS(R5)	;Store $P1EXT in high memory
 .IF NE UM$MU				;If Magtape
	MOV	(SP)+,H$RLPT-UMXBAS(R5)	;Reloc $RLPTR
 .ENDC ;NE UM$MU
 .IF NE ERL$G
	MOV	(SP)+,H$ELPT-UMXBAS(R5)	;Store $ELPTR 
 .ENDC ;NE ERL$G
	MOV	(SP)+,H$GTBY-UMXBAS(R5)	;Reloc $GTBYT
	MOV	(SP)+,H$PTWR-UMXBAS(R5)	;Reloc $PTWRD
	MOV	(SP)+,H$MPPT-UMXBAS(R5)	;Reloc $MPPTR
; Relocate some data. (R1 = High Reloc)
	.ADDR	#ONCBUF,R0		;R0 -> buffer area
	MOV	(SP),@#KISAR1		;Reloc back to low memory
	MOV	#UDAIP-UMBASE,R2	;R2 = offset into UDAIP
	ADD	R3,R2			;R3 -> UDAIP
	MOV	#LOWDATA,R4		;R4 = bytes to relocate
	ADD	R4,R0			;'no software war, please!'
	ASR	R4			;R4 = words to relocate
110$:	MOV	(R2)+,-(R0)		;Store data in stack
	SOB	R4,110$			;Repeat till finish
	MOV	R1,@#KISAR1		;Map back to high memory
	MOV	#LOWDATA,R4		;R4 = bytes
	MOV	#XUDAIP,R2		;R2 -> XUMAIP
	$RELF .-2 XUDAIP UMX		; ...
 .IF NE MU$32K				;If 32KW bound check
	ADD	(PC)+,R2		;Plus offset for cmd/res buffer
VAOFF:	 .WORD	0			; Offset for virtual addr's in hi mem
 .ENDC ;NE MU$32K
	ADD	R4,R2			;Go to end of list
	ASR	R4			;R4 = words
120$:	MOV	(R0)+,-(R2)		;Restore the data (backward)
	SOB	R4,120$			;Repeat till finish
; Restore mapping and exit.
140$:	MOV	(SP)+,@#KISAR1		;Restore mapping
	RTS	PC

	.DSABL	LSB

.SBTTL	UMR.LST	- Table for Relocating Root References from UMX (XM Only)

;+
; UMR.LST - Table for relocating root references from UMX
;
; Handles relocation of references like: "$REL .-2 FOO UMR"
; (Modified to be built by hand,  so as to eliminate the need for this code to
; be at the very end of the sources,  as it was originally in DU.MAC.  In  the
; common UM module, this code occurs early in the DU/MU assemblies, before all
; the  '$REL .-2 FOO UMR'  references have been encountered.)
;-

	UMLCNT	= 2			;Ref's common to DU/MU
 .IF NE ERL$G				;If error logging
	UMLCNT	= UMLCNT + 2		; two more if error logging
 .ENDC ;NE ERL$G
 .IF NE UM$MU				;If magtape
	UMLCNT	= UMLCNT + 10		; eight more if magtape
  .IF NE MU$FSM				;If file-structured magtape
	UMLCNT	= UMLCNT + 6		; six more if file-structured magtape
  .ENDC ;NE MU$FSM
 .ENDC ;NE UM$MU

	UMR.DID	= 1
UMR.LST:
	.REPT	UMLCNT
	 .IRP	x	<\UMR.DID>
		.WORD	UMR'x
	$RELF	.-2	UMR'x	UMX
	 .ENDR
	UMR.DID	=	UMR.DID+1
	.ENDR
	.WORD	0			;End of list

UMRLSZ	= <.-UMR.LST>/2-1		;Size of list

 .IF NE MU$32K				;If 32KW bound check
	.BR	UMH.LST			;This must be next!!


.SBTTL	UMH.LST	- Table for Relocating Ext Mem References to UMX (XM Only)

;+
; UMH.LST - Table for Relocating Extended Memory References to UMX
;
; Handles relocation of references like: "$REL .-2 FOO UMX HIGH"
;-

	UMLCNT	= 11			;Ref's common to DU/MU
  .IF NE UM$PORTS-1			;If multiple ports
	UMLCNT	= UMLCNT + 2		; two more if multi-ports
  .ENDC ;NE UM$PORTS-1
  .IF NE UM$MU				;If magtape
   .IF NE MU$FSM			;If file-structured magtape
	UMLCNT	= UMLCNT + 1		; one more if file-structured magtape
   .ENDC ;NE MU$FSM
  .ENDC ;NE UM$MU

	UMH.DID	= 1

UMH.LST:
	.REPT	UMLCNT
	 .IRP	x	<\UMH.DID>
		.WORD	UMH'x
	$RELF	.-2	UMH'x	UMX
	 .ENDR
	UMH.DID	=	UMH.DID+1
	.ENDR
	.WORD	0			;End of list

UMHLSZ	= <.-UMH.LST>/2-1		;Size of list

	.BR	UMX.LST			;This must be next!!


.SBTTL	UMX.LST	- Table for Relocating Root References to UMX (XM Only)

;+
; UMX.LST - Table for Relocating Root References to UMX
;
; Handles relocation of references like: "$REL .-2 FOO UMX"
;-

	UMLCNT	= 7			;Ref's common to DU/MU
  .IF NE UM$MU				;If magtape
	UMLCNT	= UMLCNT + 1		; one more if magtape
   .IF NE MU$FSM			;If file-structured magtape
   .ENDC ;NE MU$FSM
  .ENDC ;NE UM$MU

	UMX.DID	= 1

UMX.LST:
	.REPT	UMLCNT
	 .IRP	x	<\UMX.DID>
		.WORD	UMX'x
	$RELF	.-2	UMX'x	UMR
	 .ENDR
	UMX.DID	=	UMX.DID+1
	.ENDR
	.WORD	0			;End of list

UMXLSZ	= <.-UMX.LST>/2-1		;Size of list
 .ENDC ;NE MU$32K

;+
;NOTE:	Following code should be placed at very end of a module	which does
;	".INCLUDE UM.MAC", to verify that 'UMx.LST's are the correct size.
;	(It is already at the end of TU.MAC.)
;
;	.IF NE MMG$T
;	.ASSUME	UMRLSZ EQ UMR.CNT	;Insure UMR.LST is proper size
;	 .IF NE MU$32K			;If 32KW bound check
;	.ASSUME	UMHLSZ EQ UMH.CNT	;Insure UMH.LST is proper size
;	.ASSUME	UMXLSZ EQ UMX.CNT	;Insure UMX.LST is proper size
;	 .ENDC ;NE MU$32K
;	.ENDC ;NE MMG$T
;-
.ENDC ;NE MMG$T

FBLOC::

.ASSUME	. LE OVRBK1+<1*BLK>,<;INSTALL overlay code too big>

;+
; Block align the next code. The following code will be executed and then
; phased out for allowing buffer space to read code into high memory.
;-
	. = OVRBK1+<1*BLK>		;Start of buffer block align
ONCBUF::

.IF NE UM$PORTS-1			;For next page

.SBTTL	CKPORT	- Check for Installed Ports

;+
; This routine will verify that the sysgened port do indeed exist on
; the virtual hardware configuration.
;-

CKPORT:	.MFPS				;Save current PS
	.MTPS	#340			;Don't let anybody annoy us
	MOV	@#INS.V,-(SP)		;Store old TRAP vector
	.ADDR	#UM.INS,R5		;R5 -> new TRAP routine
	MOV	R5,@#ILG.V		;Redirect to our new TRAP
; Port 1 processing
INPOR1:	MOV	PCTAB+<PC.ESZ*1>-UMBASE(R3),R1 ;R1 = CSR for port 1
	CLC				;Indicate no error
	MOV	@R1,R0			;Try to access it!
	BCC	INPOR2			;Branch if ok
; Must make port 1 invalid
	MOV	#1,R4			;R4 = port number
	CALL	PORTUP			;Update unit with this port!
INPOR2:
 .IF NE UM$PORTS-2
	MOV	PCTAB+<PC.ESZ*2>-UMBASE(R3),R1 ;R1 = CSR for port 2
	CLC				;Indicate no error
	MOV	@R1,R0			;Try to access it!
	BCC	INPOR3			;Branch if ok
; Must make port 2 invalid
	MOV	#2,R4			;R4 = port number
	CALL	PORTUP			;Update unit with this port!
INPOR3:
  .IF NE UM$PORTS-3
	MOV	PCTAB+<PC.ESZ*3>-UMBASE(R3),R1 ;R1 = CSR for port 3
	CLC				;Indicate no error
	MOV	@R1,R0			;Try to access it!
	BCC	NOPOR			;Branch if ok
; Must make port 3 invalid
	MOV	#3,R4			;R4 = port number
	CALL	PORTUP			;Update unit with this port!
NOPOR:
  .ENDC ;NE UM$PORTS-3
 .ENDC ;NE UM$PORTS-2
	MOV	(SP)+,@#ILG.V		;Restore the old TRAP vector
	.MTPS				;Restore old priority
	RTS	PC			;Return to caller

.SBTTL	PORTUP	- PORT Update Subroutine

;+
; PORTUP - PORT update subroutine
;
;	Input:	R3-> handler entry point
;		R4 = port number
;-

PORTUP:	MOV	#UTTAB-UMBASE,R1	;Point to translation table offset
	ADD	R3,R1			;R1 -> actual location
 .IF NE UM$DU				;If disk
	MOV	#8.,R0			;R0 = count of units to check
 .ENDC ;NE UM$DU
 .IF NE UM$MU				;If magtape
	MOV	#4.,R0			;R0 = count of units to check
 .ENDC ;NE UM$MU
10$:	CMPB	R4,UT.PORT(R1)		;Is this port in R4?
	BNE	20$			;No, branch
 	BISB	#200,UT.PORT(R1)	;Mark as invalid!
20$:	DEC	R0			;Are we finish?
	BEQ	30$			;Yes, go to next port
	ADD	#UT.ESZ,R1		;Point to next entry
	BR	10$			;Repeat

30$:	RTS	PC			;Return
.ENDC ;NE UM$PORTS-1

UM.INS:	BIS	#1,2(SP)		;Set carry
	RTI				; and return from trap

.IF NE UM$DU				;If disk
 .IF EQ UM$BOO				;For next page

.SBTTL	FALCON	- Check If We Are On A FALCON

;+
; FALCON 
;
; What the code does is  determine if the alternate  "standard"  CSR is to be
; used (for FALCON systems which  have  ROM  at  the normal standard address)
; and configures the handler such that it will use the appropriate addresses.
;-

FALCON:	.MFPS				;Save current PS
	.MTPS	#340			;Don't let anything annoy us
	MOV	R0,-(SP)		;Save R0 for awhile
	MOV	@#INS.V,-(SP)		;Save current trap vector contents
	.ADDR	#UM.INS,R5		;Build address of our own routine
	MOV	R5,@#INS.V		;Redirect to our trap routine
	CLR	R0			;Reset for later test
	MFPT				;Do processor determination
	CMP	R0,#4			;Running on a FALCON?
	BNE	10$			;Nope, then no alteration needed
  .IF EQ UM$PORTS-1
	MOV	#UM$ALT,UDAIP-UMBASE(R3) ;Yes, use the alternate CSR
	MOV	#UM$ALT+2,UDASA-UMBASE(R3)
  .IFF ;EQ UM$PORTS-1
	MOV	#UM$ALT,PCTAB-UMBASE(R3) ;(Done for multi-port handlers also)
	MOV	#UM$ALT+2,PCTAB+2-UMBASE(R3)
  .ENDC ;EQ UM$PORTS-1
10$:	MOV	(SP)+,@#INS.V		;Restore saved vector
	MOV	(SP)+,R0		;Restore saved work register
	.MTPS				;Restore previous priority
	RTS	PC
 .ENDC	;EQ UM$BOO
.ENDC ;NE UM$DU
.IF NE MMG$T				;If XM

.SBTTL	ONCEXM	- Continuation of ONCE Routine for Extended Memory

;+
; ONCEXM - Continuation of ONCE routine for Extended Memory
;
; This routine will find or allocate a global region in extended memory
; so that the code from psect UMX can be read into it.
;-
	.ENABL	LSB

ONCEXM:	MOV	@#SYSPTR,R4		;R4 -> base of RMON
					;Find global region, get address/32.
	MOV	P1EXT(R4),R4		;R4 = offset to P1EXT
	.ADDR	#UMNAME,R5		;R5-> Name global ^R/MU $  /or/DU $  /
	CALL	FINDGR(R4)		;Go get the control block
 .IF NE UM$MU				;If magtape
	BCS	XD.BAD			;Branch if none
	MOV	GR.ADR(R1),R1		;R1 = addr/32 of region
	.BR	40$			;Go merge; save parameters
 .ENDC ;NE UM$MU
 .IF NE UM$DU				;If disk
	BCS	GETGBL			;Branch if none
	MOV	GR.ADR(R1),R1		;R1 = addr/32 of region
	BR	40$			;Go merge; save parameters

.SBTTL	GETGBL	- Allocate Global Region (XM Only)

;+
; Part of the installation of XM will allocate a global region
;
; Memory requirements:
;
;	MMG$T = 1 	=>  2K
;	   or  
;       ERL$G  = 1 	=>  2K
;	   ADDR/32	=>  40
; For disk:
;	DU$BBR = 1 	=> 8K
;	   ADDR/32      => 200
;-

GETGBL:	MOV	@#SYSPTR,R4		;R4 = base of RMON
	MOV	MEMPTR(R4),R0		;R0 = offset to memory ptr
	ADD	R4,R0			;R0 -> table of memory ptr
	MOV	CORPTX(R0),R5		;R5 = offset to free list
	ADD	R4,R5			;R5 -> free list
10$:	CMP	#-1,(R5)+		;End of list ?
	BNE	10$			;No, keep looking for it!
; R5 -> Start of region control block area
20$:	CMP	#-1,@R5			;End of RCB list ?
	BEQ	XD.BAD			;Yes, branch ; failure
	TST	@R5			;Empty entry ?
	BEQ	30$			;Yes, branch; found an entry
	ADD	#GR.ESZ,R5		;Point to next entry
	BR	20$			;Repeat

; R5 -> Entry RCB
30$:	MOV	P1EXT(R4),R0		;R0 -> extern routines
	MOV	#MEMUMX,R2		;R2 = size/32 memory
	MOV	R3,-(SP)		;Save R3
	CALL	XALLOC(R0)		;Get memory from free list
	MOV	(SP)+,R3		;Restore R3
	BCS	XD.BAD			;Branch if not obtained!
; Build RCB
	MOV	R2,(R5)+		;Store the size/32 of region
	MOV	R1,(R5)+		;Store the addr/32 of region
	MOV	#GR.PVT,(R5)+		;Store status = Private
	MOV	#UM$GBL,(R5)+		;Store name 1st word (<^RDU >)
	MOV	#<^R$>,@R5		;Store name 2nd word
 .ENDC ;NE UM$DU
40$:	MOV	R1,P1HIGH-UMBASE(R3)	;Store addr/32 of region in driver too
 .IF NE MU$32K				;If 32KW bound check
	MOV	#BEGREL+CRBSIZ,SVADR	;Assume cmd/resp buf at region start
	MOV	#CRBSIZ,R4		;R4 = size of cmd/resp buffer
	MOV	R4,VAOFF		;Assume cmd/resp buf at region start
	MOV	#BEGREL+4,PCBUFF-UMBASE(R3) ;Store addr of command buffer
	MOV	#BEGREL+10+P.CSIZ,PMBUFF-UMBASE(R3) ;  and message buffer
 .ENDC ;NE MU$32K
	CLR	R0			;R0 = 0
	ASHC	#6,R0			;R0,R1 contain physical addr
 .IF NE UM$MU				;If magtape
  .IF NE MU$32K				;If 32KW bound check
; Insure cmd/resp buffers don't cross a 32KW boundary (TK50 requirement).

	ADD	R4,R1			;Check if buffer crosses 64KB boundary
	BCC	50$			;No, leave buffer at start of region
					;Put buffer at end of region
	ADD	#UMXSIZ,PCBUFF-UMBASE(R3) ;Add psect size to addr of cmnd buf
	ADD	#UMXSIZ,PMBUFF-UMBASE(R3) ; and addr of message buf
	SUB	R4,SVADR		;Subtract cmd/resp buffer size from
					; psect's starting virtual address.
	CLR	VAOFF			;Clear offset for virtual addresses.
50$:	SUB	R4,R1			;Fix R1
  .ENDC ;NE MU$32K
 .ENDC ;NE UM$MU
	MOV	R0,PHYSH-UMBASE(R3)	;Store physical high
	MOV	R1,PHYSL-UMBASE(R3)	;Store physical low
 .IF NE MU$32K
	MOV	PCBUFF-UMBASE(R3),FPCBUF ;Store -> cmd buffer for UPUMX
 .ENDC ;NE MU$32K
	ADD	#2,(SP)			;Success: return to call+4
XD.BAD:	RETURN				;Return to call+2 for errors

	.DSABL	LSB

.SBTTL	UPSET	- Setup to Move Psect UMX to High Memory (XM Only)

;+
; UPSET	- Setup to Move Psect UMX to High Memory (XM Only)
;
; This routine resides in the buffer, to allow for more code and tables
; in the first block. This routine is called by UPUMX to do some of the
; address calculations for the move of psect UMX to high memory. It is
; destroyed once UPUMX starts reading blocks of psect UMX into this
; buffer.
;
; Input:
;	R0 = High 6 bits of global region physical address
; 	R1 = Low 16-bits of global region physical address
;	R3 -> Handler + 6
; Output:
;	R0 = block # where UMX psect begins on system device
;     R1,2 = undefined
;	R3 -> Handler + 6
;	R4 = size of UMX psect (bytes)
;-

UPSET:					;Calculate MRING/CRING physical addr.
	MOV	#XMRING,R2		;R2 -> XMRING (virtual)
	$RELF .-2 XMRING UMX		; ...
	SUB	#BEGREL,R2		;R2 = PAR1 offset XMRING
 .IF NE MU$32K				;If 32KW bound check
	ADD	VAOFF,R2		;Add offset for cmd/resp buffer
 .ENDC ;NE MU$32K
	ADD	R2,R1			;Add to physical low
	ADC	R0			;Carry to physical high
	MOV	R1,MRPTR-UMBASE(R3)	;Store low 16-bits
	MOV	R0,MRPTR+2-UMBASE(R3)	;Store high bits
;Setup to Read Psect UMX into high memory
	MOV	SENTRY,R2 		;R2 -> $ENTRY for UM
	MOV	SSLOT,R0		;R0 = SLOT*2
	ASL	R0			;R0 = <SLOT*2>*2
	ADD	R2,R0			;R0 = $ENTRY + <SLOT*2>*2
	ADD	#2,R0			;$ENTRY + <SLOT*2>*2 + 2 
	MOV	@R0,R0			;R0 -> Starting block UMX.SYS + 1
	DEC	R0			;Subtract -1
 .IF NE MU$32K				;If 32KW bound check
	MOV	SVADR,R5		;Save starting virtual address
 .IFF ;NE MU$32K
	MOV	#20000,R5		;Save starting virtual address
 .ENDC ;NE MU$32K
	ADD	#UMXBAS/1000,R0		;Add block offset to start read
	MOV	#UMXSIZ,R4		;R4 = Size of psect UMX (bytes)
	RETURN				;Get out of buffer before we read!!

.ENDC ;NE MMG$T

ONCEND::

.ASSUME	. LE OVRBK1+<2*BLK>,<;INSTALL overlay too big>

	. = OVRBK1 + <2*BLK>		;Align UMX Psect on a block boundary

.SBTTL	.DRBEG	- Handler Entry Point

	.NLIST	BEX
	.ENABLE LC,LSB
;+
; Standard RT-11 entry point (BEGIN is logical entry point later in code).
;-
	.DRBEG	UM

	UMBASE	=: UMSTRT + 6		;Relocation off $ENTRY

UM::	BR	ACROSS			;Skip next location

;+
; Global status storage location. (diagnostics usage)
;-

STATU$::.WORD	0			;Offset = 16

;+
; Begin executing
;-

ACROSS:	MOV	UMCQE,R5		;R5 -> current Q-element
.IF EQ MMG$T
	CALLR	BEGIN			;This one jump saves a lot later.
.IFF ;EQ MMG$T
 .IF NE UM$MU				;If magtape
	CALLR	BEGIN			;This one jump saves a lot later.
 .ENDC ;NE UM$MU
 .IF NE UM$DU				;If disk
	MOV	@#KISAR1,R1		;Store old mapping
	.P1EXT	P1HIGH			; (Map to high memory)
	CALLR	@#BEGIN			;Go to it
	$REL .-2 BEGIN UMX		; ...
	.P1END				; (End of block)
 .ENDC ;NE UM$DU
.ENDC ;EQ MMG$T

	.DSABL	LSB

.SBTTL	Impure	- Vector Table and Impure Data Allocation

;+
; Vector table for multi-port configuration.
;-
.IF NE UM$PORTS
	.DRVTB	UM,UM$VEC,UMINT
 .IF NE UM$PORTS-1
	.DRVTB	,UM$VC1,UMINT
  .IF NE UM$PORTS-2
	.DRVTB	,UM$VC2,UMINT
   .IF NE UM$PORTS-3
	.DRVTB	,UM$VC3,UMINT
   .ENDC ;NE UM$PORTS-3
  .ENDC ;NE UM$PORTS-2
 .ENDC ;NE UM$PORTS-1
.ENDC ;NE UM$PORTS
.Assume . LE UMSTRT+1000,<;SET object not in block1>
;+
; Impure area	***** THE FOLLOWING ITEMS MUST BE KEPT IN ORDER *****
; An equivalent set of values will be defined in the UMX psect. Those
; values are going to be used when executing in high memory. The once
; only code .drptr will take into account the ordering of this values
; Impure area	***** THE FOLLOWING ITEMS MUST BE KEPT IN ORDER *****
;-

;+
; Active port values.
; Note that all items refer to the port currently being accessed.
;-

UDAIP::	.WORD	UM$CSR			;-> Address and polling register.
UDASA::	.WORD	UM$CSR+2		;-> Status and Address register.
ISTEP:	.WORD	0			;Next step bit, Done if <0.
INISEQ:	.WORD	0			;-> in INILST to next item to load.
INILST:	.BYTE	UM$VEC/4!IE		;INIT 1 LO: vector and IE for init.
	.BYTE	0*10+0+STEP		;INIT 1 HI: 2^0 both Msg & Cmd rings.
MRPTR:	.WORD	0			;INIT 2: Message ring address <15:0>
	.WORD	0			;INIT 3: Message ring address <21:16>
	.WORD	GO			;INIT 4: Go.

;+ 
; Communication area
;-

INTRID:	.BLKW	2			;Interrupt identity area.
MRING:	.WORD	0,0			;Message ring, 1 entry.
CRING:	.WORD	0,0			;Command ring, 1 entry.

;+
; Miscellaneous data area
;-

.IF NE ERL$G
$SUCS:	.WORD	0			;Success log flag, 0 = YES.
.Assume . LE UMSTRT+1000,<;SET object not in block1>
.ENDC ;NE ERL$G
$RETRY:	.WORD	NRETRY			;Retry value (set code)
.Assume . LE UMSTRT+1000,<;SET object not in block1>

.IF NE MMG$T
;+
; Physical memory addresses and pointers to the command/response buffers.
;-

PHYSH:	.WORD	0			;Physical high 16-bits
PHYSL:	.WORD	0			;Physical low 
 .IF NE MU$32K				;If 32KW bound check
PCBUFF:	.WORD	0			;-> Command Buffer
PMBUFF:	.WORD	0			;-> Message Buffer
 .ENDC ;NE MU$32K

.ENDC ;NE MMG$T

;+
; UTTAB	- Unit Translation Table.
;
; For DU:
;	Initially, the RT-11 unit numbers translate 1 to 1 with 
;	the MSCP unit numbers.  The values may be SET.
; For MU:
;	Initially, the RT-11 unit numbers translate 1 to 1 with 
;	the port numbers (only one tape drive per controller).
;-
	.ASSUME UT.UNIT EQ 0		;MSCP unit number (byte)	
	.ASSUME	UT.JOBN	EQ 1		;# of job owning unit (byte,Tape only)
	.ASSUME UT.PART EQ 2		;Disk partition # (byte,Disk only)
	.ASSUME UT.PORT EQ 3		;UDA Port to be used (byte)

.UTTAB:	.WORD	0			;Pointer to current UTTAB entry.
.IF NE UM$MU
UTTAB:	.WORD	<UT.AVAL*400+0>,<0*400>	;RT unit 0 is unit 0 of port 0
	.WORD	<UT.AVAL*400+0>,<1*400>	;RT unit 1 is unit 0 of port 1
	.WORD	<UT.AVAL*400+0>,<2*400>	;RT unit 2 is unit 0 of port 2
	.WORD	<UT.AVAL*400+0>,<3*400>	;RT unit 3 is unit 0 of port 3
.ENDC ;NE UM$MU
.IF NE UM$DU
UTTAB:	.WORD	0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0
.ENDC ;NE UM$DU
UTTBND	=: .				;Table end
.Assume . LE UMSTRT+1000,<;SET object not in block1>

;+
; PCTAB	- Port control table. Only used on multi-port handlers.
;
; For DU:
;	Initially, all port entries are set to 0. May be SET to other values.
; For MU:
;	Port entries correspond to RT-11 unit numbers,  since there's only one
;	tape per controller. For drive w/settable TMSCP unit number, set # =0.
;-

.IF NE UM$PORTS-1
	.ASSUME PC.AIP  EQ 0		;Initialization and Polling register
	.ASSUME PC.ASA  EQ 2		;Status register
	.ASSUME PC.STEP EQ 4		;Initialization step for this port
	.ASSUME PC.VEC  EQ 6		;Vector for this port

.PCTAB:	.WORD	0			;Pointer to current PCTAB entry.
PCTAB:	.WORD	UM$CSR,UM$CSR+2		;Port 0 (multi-port only)
	.WORD	0,UM$VEC/4!IE		;
	.WORD	UM$CS1,UM$CS1+2		;Port 1 data.
	.WORD	0,UM$VC1/4!IE		;
 .IF NE UM$PORTS-2
	.WORD	UM$CS2,UM$CS2+2		;Port 2 data.
	.WORD	0,UM$VC2/4!IE		;
  .IF NE UM$PORTS-3
	.WORD	UM$CS3,UM$CS3+2		;Port 3 data.
	.WORD	0,UM$VC3/4!IE		;

	.ASSUME UM$PORTS LE 4		;End of multi-port table
  .ENDC ;NE UM$PORTS-3
 .ENDC ;NE UM$PORTS-2
.ENDC ;NE UM$PORTS-1

; Establish size of low memory data

	LOWDATA ==:  . - UDAIP		;Bytes
	.ASSUME . LE UMSTRT+1000	;SET CODE access range

; Impure************END OF CRITICAL ORDERING***********

.IF NE MMG$T
;*********************************************************************
			UMXPSECT
;*********************************************************************
;*****"Mirror Mirror on the wall whos' data is it off"****

XUDAIP::.WORD	UM$CSR			;-> Address and polling register.
XUDASA::.WORD	UM$CSR+2		;-> Status and Address register.
XISTEP:	.WORD	0			;Next step bit, Done if <0.
XINISE:	.WORD	0			;-> in INILST to next item to load.
XINILS:	.BYTE	UM$VEC/4!IE		;INIT 1 LO: vector and IE for init.
	.BYTE	0*10+0+STEP		;INIT 1 HI: 2^0 both Msg & Cmd rings.
XMRPTR:	.WORD	0			;INIT 2: Message ring address <15:0>
	.WORD	0			;INIT 3: Message ring address <21:16>
	.WORD	GO			;INIT 4: Go.

;+ 
; Communication area
;-

XINTRI: .BLKW	2			;Interrupt identity area.
XMRING:	.WORD	0,0			;Message ring, 1 entry.
XCRING:	.WORD	0,0			;Command ring, 1 entry.

;+
; Miscellaneous data area
;-

 .IF NE ERL$G
X$SUCS:	.WORD	0			;Success log flag, 0 = YES.
 .ENDC ;NE ERL$G
X$RETR:	.WORD	NRETRY			;Retry value (set code)

;+
; Physical memory addresses and pointers to the command/response buffers.
;-

XPHYSH:	.WORD	0			;Physical high 16-bits
XPHYSL:	.WORD	0			;Physical low 
 .IF NE MU$32K				;If 32KW bound check
XPCBUF:	.WORD	0			;-> Command Buffer
XPMBUF:	.WORD	0			;-> Message Buffer
 .ENDC ;NE MU$32K

;+
; Unit translation table.
;-

X.UTTA:	.WORD	0			;Pointer to current UTTAB entry.
 .IF NE UM$MU
XUTTAB:	.WORD	<UT.AVAL*400+0>,<0*400>	;RT unit 0 is unit 0 of port 0
	.WORD	<UT.AVAL*400+0>,<1*400>	;RT unit 1 is unit 0 of port 1
	.WORD	<UT.AVAL*400+0>,<2*400>	;RT unit 2 is unit 0 of port 2
	.WORD	<UT.AVAL*400+0>,<3*400>	;RT unit 3 is unit 0 of port 3
 .ENDC ;NE UM$MU
 .IF NE UM$DU
XUTTAB:	.WORD	0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0
 .ENDC ;NE UM$DU
XUTTBND	=: .				;Table end

;+
; Port control table. <Only used on multi-port handlers>
;-

 .IF NE UM$PORTS-1
X.PCTA:	.WORD	0			;Pointer to current PCTAB entry.
XPCTAB:	.WORD	UM$CSR,UM$CSR+2		;Port 0 (multi-port only)
	.WORD	0,UM$VEC/4!IE		;
	.WORD	UM$CS1,UM$CS1+2		;Port 1 data.
	.WORD	0,UM$VC1/4!IE		;
  .IF NE UM$PORTS-2
	.WORD	UM$CS2,UM$CS2+2		;Port 2 data.
	.WORD	0,UM$VC2/4!IE		;
   .IF NE UM$PORTS-3
	.WORD	UM$CS3,UM$CS3+2		;Port 3 data.
	.WORD	0,UM$VC3/4!IE		;
					;End of multi-port table
   .ENDC ;NE UM$PORTS-3
  .ENDC ;NE UM$PORTS-2
 .ENDC ;NE UM$PORTS-1
;************* "End of Reflection " *************
.ENDC ;NE MMG$T

;+
; Command/Response buffer area
;-

.IF EQ MU$32K				;If no 32KW bound check
LN.CMD:	.WORD	P.CSIZ			;Length of command.
VC.CMD:	.WORD	0			;Command virtual circuit ID.
CBUFF:	.BLKB	P.CSIZ			;Command buffer: 1 full packet
LN.RSP:	.WORD	0			;Length of response.
VC.RSP:	.WORD	0			;Response virtual circuit ID.
MBUFF:	.BLKB	P.MSIZ			;Message buffer: 1 full packet
.IFF ;EQ MU$32K
LN.CMD	= 0				;Length of command.
VC.CMD	= LN.CMD + 2			;Command virtual circuit ID.
CBUFF	= VC.CMD + 2			;Command buffer: 1 full packet
LN.RSP	= CBUFF  + P.CSIZ		;Length of response.
VC.RSP	= LN.RSP + 2			;Response virtual circuit ID.
MBUFF	= VC.RSP + 2			;Message buffer: 1 full packet
MBUFFND	= MBUFF  + P.MSIZ
	.ASSUME	 MBUFFND EQ LN.CMD+CRBSIZ
.ENDC ;EQ MU$32K

;+
; Miscellaneous data area
;-
.IF NE MMG$T
;*********************************************************************
	UMPSECT
;*********************************************************************

P1HIGH:	.WORD	0			;UMX mapping
$P1EXT:	.WORD	0			;Store P1EXT ptr here
.ENDC ;NE MMG$T

UMFBLK:	.WORD	0,0,0,0			;Fork queue block.

.IF NE ERL$G
ERLBUF:	.BLKB	P.MSIZ			;Error log end message LOW memory
.ENDC ;NE ERL$G

.IF NE MMG$T
;*********************************************************************
	UMXPSECT
;*********************************************************************
.ENDC ;NE MMG$T

RETRY:	.WORD	0			;Retry counter.
.IF NE UM$DU				;If disk
VOLSIZE:.WORD	0,0			;Size of current volume.
.ENDC ;NE UM$DU
NEXT:	.WORD	0			;Address of post interrupt activity.
INTEOP:	.WORD	0			;Internal operation in progress!
.IF NE MMG$T
P1LOW:	.WORD	0			;Store new mapping low here (UMR)

; Relocate some pointer locations

 .IF NE UM$MU				;If Magtape
H$RLPT:	.WORD	0			;$RELOC ptr
 .ENDC ;NE UM$MU
 .IF NE ERL$G
H$ELPT:	.WORD	0			;Error logging entry
 .ENDC ;NE ERL$G
H$PTWR:	.WORD	0			;PUTWORD ptr
H$MPPT:	.WORD	0			;Convert virtual to phy
H$GTBY:	.WORD	0			;GETBYTE ptr
H$P1EX: .WORD	0			;$P1EXT high memory ptr
H$CQE:	.WORD	0			;UMCQE high memory ptr

 .IF NE UM$MU				;If Magtape
  .IF NE MU$FSM				;If file-structured

.SBTTL	 H$NQE	- High Memory Copy of Queue Element

;+
; H$NQE	- High Memory Copy of Queue Element
;
; (FSM communicates with the hardware part of the handler, via a fake queue
; element, NQE, located in FSM.)
;
; For MAGTAPE, H$CQE is not just a high memory copy of UMCQE. Rather it
; points to this high memory copy of the queue element. This is to handle
; the case where the handler (and FSM) are .FETCH'ed into PAR1 space in
; low memory. When this happens, FSM's fake queue element is, unfortunately,
; located in PAR1 space in low memory, which we map away to get to the high
; memory portion of the handler (.PSECT UMX). We must therefore copy the
; queue element up to high memory, and be a bit cautious how we access it.
;-

H$NQ.CS:.WORD	0			;CSW pointer
H$NQE:	.WORD	0			;Block number (or -> ERRBLK)
	.BYTE	0,0			;Function (low), Unit & Job #'s (high)
	.WORD	0			;Buffer address
	.WORD	0			;Word Count
	.WORD	0			;Completion routine code
	.WORD	0			;PAR1 relocation bias
	.WORD	0			; <reserved>
	.WORD	0			; <reserved>
H$NQND= .
  .ENDC ;NE MU$FSM
 .ENDC ;NE UM$MU
.ENDC ;NE MMG$T

.IF NE UM$DU				;If disk
 .IF NE DU$BBR
BBRON:	.WORD	0			;BBR in progress flag
 .ENDC ;NE DU$BBR
.ENDC ;NE UM$DU

.IF NE UM$MU				;If magtape
 .IF NE MMG$T				;If XM
;*********************************************************************
	UMPSECT
;*********************************************************************
 .ENDC ;NE MMG$T
.ENDC ;NE UM$MU

.SBTTL BEGIN	- Handler Start: Executable Code Begins

;+
; The RT-11 unit in the queue element is used to find the corresponding 
; MSCP unit and port. The data structures which belong to this unit are
; loaded into the 'active' set, (data structures = port values, and for
; DU, bbr values).  Some  flags  are initialized and,  for DU,  if  the
; function is to get the translation table we jump to the corresponding
; routine immediately.
;
; For MU, if this is XM,  we copy the queue element to high memory,  as
; it may reside in PAR1 (in FSM), which makes it difficult to access.
;-
	.ENABL	LSB
BEGIN::	
.IF EQ MMG$T
	MOV	$RETRY,RETRY		;Initialize error retry count.
	CLR	INTEOP			;Initialize internal operation flag
.IFF ;EQ MMG$T
 .IF NE UM$MU				;If magtape
	.P1EXT	P1HIGH			; (Map to high memory)
	MOV	@#X$RETRY,@#RETRY	;Initialize error retry count.
	$REL .-4 X$RETRY UMX		; ...
	$REL .-2 RETRY UMX		; ...
	CLR	@#INTEOP		;Initialize internal operation flag
	$REL .-2 INTEOP UMX		; ...
	CLR	@#ABTFLG		;Initialize abort flag
	$REL .-2 ABTFLG UMX		; ...
	.P1END				; (End of block)
	CMP	(R5)+,(R5)+		;R5 -> Q$BUFF
	.ASSUME Q$BUFF EQ 4
	CALL	@$MPPTR			;Convert virtual to physical
	MOV	(SP)+,OLDBA		;Save the low 16 bits of address
	MOV	(SP)+,R3		;Get the high bits of address
	ASH	#-4,R3			;Shift high bits into right place
	MOV	R3,EXTADR		;Save the high bits
	SUB	#Q$WCNT,R5		;Backup queue element pointer
 .ENDC ;NE UM$MU
 .IF NE UM$DU				;If disk
	MOV	2(SP),SP		;Restore stack
	ADD	#6,SP			;Pop return arguments
	MOV	R5,H$CQE		;Store Q-element ptr here
	MOV	R1,P1LOW		;Store low mapping
	MOV	X$RETRY,RETRY		;Initialize error retry count
	CLR	INTEOP			;Initialize internal operation flag
 .ENDC ;NE UM$DU
.ENDC ;EQ MMG$T
.IF NE UM$DU
 .IF NE DU$BBR
	CLR	BBRON			;Clear BBR in progress flag
 .ENDC ;NE DU$BBR
	CMPB	Q$FUNC(R5),#SP.DAT	;Is this a table .SPFUN
	BNE	10$			;No, then go set up the port.
	JMP	DOTAB			;Yes, then go read or write table

.ENDC ;NE UM$DU
10$:
.IF NE UM$MU				;If Magtape
 .IF EQ MU$FSM				;If not file structured
	MOV	R5,R3			;Get address of block number in R3
 .IFF ;EQ MU$FSM			;If file structured
	JMP	FSMDIS			;Call the file structured module
 .ENDC ;EQ MU$FSM
$MT::
 .IF NE MMG$T				;If XM
	MOVB	Q$JNUM(R3),R5		;Get job number
	BIC	#^C<JOBMK>,R5		;
	ASR	R5			;Shift
	ASR	R5			; into
	ASR	R5			;  place
	MOV	R5,JOBNM		;Store it in .SYNCH block for errors
	MOV	R3,R5			;Fix register usage
  .IF NE MU$FSM				;If file structured magtape
	TST	-(R3)			;-> CSW pointer (don't need link word)
	MOV	#<Q.ELGH/2-1>,R1	;Count of words to move
20$:	MOV	(R3)+,-(SP)		;Save queue element on the stack
	SOB	R1,20$			;In case we're .FETCHed into PAR1
  .ENDC ;NE MU$FSM
	MOVB	Q$UNIT(R5),R3		;Get the unit number.
	MOV	@#KISAR1,R1		;Store old mapping
	.P1EXT	P1HIGH			; (Map to high memory)
	CALLR	@#H$MT			;Go to it
	$REL .-2 H$MT UMX		; ...
	.P1END				; (End of block)

;*********************************************************************
	UMXPSECT
;*********************************************************************

H$MT::	MOV	2(SP),SP		;Restore stack
	ADD	#6,SP			;Pop return arguments
	MOV	R1,P1LOW		;Store low mapping
  .IF NE MU$FSM				;If file structured
	MOV	#H$NQND,R5		;R5 -> hi memory copy of queue element
	$REL .-2 H$NQND UMX HIGH	; ...
	MOV	#<Q.ELGH/2-1>,R1	;Copy all but link word of q element
30$:	MOV	(SP)+,-(R5)		;Copy queue element from stack
	SOB	R1,30$			;
	TST	(R5)+			;R5 -> Block number in queue element
  .ENDC ;NE MU$FSM
	MOV	R5,H$CQE		;H$CQE -> hi mem copy of queue element
 .IFF ;NE MMG$T				;If not XM
  .IF NE MU$FSM				;If file structured
	MOV	R3,R5			;Fix register usage
  .ENDC ;NE MU$FSM
	MOVB	Q$UNIT(R5),R3		;Get the unit number.
 .ENDC ;NE MMG$T
.ENDC ;NE UM$MU
.IF NE UM$DU				;If disk
	MOVB	Q$UNIT(R5),R3		;Get the unit number.
.ENDC ;NE UM$DU
	BIC	#^C<UNITMK>,R3		;Isolate the unit number.
	ASL	R3			;Create an index into the RT-11
	ASL	R3			; to MSCP unit translation table.
	.ASSUME UT.ESZ EQ 4
.IF EQ MMG$T
	.ADDR	#UTTAB,R3,ADD		;R3 -> unit translation
	MOV	R3,.UTTAB		;Save R3 for later.
.IFF ;EQ MMG$T
	ADD	#XUTTAB,R3		;R3 -> unit translation
	$REL .-2 XUTTAB UMX HIGH	; ...
	MOV	R3,X.UTTAB		;Save R3 for later
.ENDC ;EQ MMG$T
.IF NE UM$PORTS-1
	MOVB	UT.PORT(R3),R2		;R2 = Port number.
	BPL	40$			;Branch if it is ok!
	JMP	UMHERR			;Invalid port; exit

40$: 	ASL	R2			;Create index into the port control
	ASL	R2			; table by shifting left.
	MOV	R2,R1			;Save (* 4) for later in R1.
	ASL	R2
	.ASSUME PC.ESZ EQ 10
 .IF EQ MMG$T
	.ADDR	#PCTAB,R2,ADD		;R2 -> port control table entry
	MOV	R2,.PCTAB		;Save pointer for later.
	.ADDR	#UDAIP,R4		;R4 -> impure area
 .IFF ;EQ MMG$T
	ADD	#XPCTAB,R2		;R2 -> port control table entry
	$REL .-2 XPCTAB UMX HIGH	; ...
	MOV	R2,X.PCTAB		;Save pointer for later.
	MOV	#XUDAIP,R4		;R4 -> impure table
	$REL .-2 XUDAIP UMX HIGH	; ...
 .ENDC ;EQ MMG$T
	MOV	(R2)+,(R4)+		;Get the CSR, it is the IAP.
	.ASSUME PC.AIP EQ 0
	MOV	(R2)+,(R4)+		;Get the ASA.
	.ASSUME PC.ASA EQ 2
	MOV	(R2)+,(R4)+		;Get the new ports init status.
	.ASSUME PC.STEP EQ 4
 .IF EQ MMG$T
	MOVB	(R2),INILST		;Get the new ports vector code.
	.ASSUME PC.VEC EQ 6
 .IFF ;EQ MMG$T
	MOVB	(R2),XINILST		;Get the new ports vector code
 .ENDC ;EQ MMG$T
.ENDC ;UM$PORTS-1

.IF NE UM$DU
 .IF NE DU$BBR
  .IF NE UM$PORTS-1
	MOV	R1,-(SP)		;Save R1 (= active port * 4) in stack
	ASL	R1			; *8
	ADD	(SP)+,R1		; +(PORT*4) => offset to entry
	.ASSUME BB.SIZ EQ 14
  .IFF ;NE UM$PORTS-1
	CLR	R1			;R1 = only port zero
  .ENDC ;NE UM$PORTS-1
	ADD	#BBRTAB,R1		;R1 -> BBR table entry
	$REL .-2 BBRTAB UMX HIGH	; ...
	MOV	R1,ACTBBR		;Store the active entry
 .ENDC ;NE DU$BBR
.ENDC ;NE UM$DU
.IF NE UM$MU				;If Magtape
	CMPB	Q$FUNC(R5),#CLOSE	;Close?
	BNE	START			;No, go check if port is initialized
	CALLR	KLOSE			;Yes, close and go away.
.ENDC ;NE UM$MU
	.BR	START

	.DSABL	LSB

.SBTTL	START	- Port Initialization Code

;+
; The code checks the port status - if either reset or errored - the
; port is initialized using the four step process defined by the uq
; port spec. During initialization the controller is given information
; about the size of the command/response rings, the locations of two
; vectors which point to the rings and the interrupt id area.
; Each step generates interrupts if desired, the interrupt code will
; be flagged to return here for continuing until the four step process
; is completed.
;-
	.ENABL	LSB
START:
.IF EQ MMG$T
	TST	ISTEP			;Is this port fully initialized?
.IFF ;EQ MMG$T
	TST	XISTEP			;Is this port fully initialized?
.IFTF ;EQ MMG$T
	BPL	INIT			;No, then go init it.
.IFT ;EQ MMG$T
	BIT	#<IERROR!ISTEP1>,@UDASA	;Has port errored or been reset?
.IFF ;EQ MMG$T
	MOV	#XUDASA+2,R5		;R5 -> XUDASA+2
	$REL .-2 XUDASA+2 UMX HIGH	; ...
	BIT	#<IERROR!ISTEP1>,@-(R5)	;Has port errored or been reset ?
.ENDC ;EQ MMG$T
	BNE	INIT			;Yes, so must NOT be running
	JMP	DISPAT			;Go dispatch

INIT:	MOV	#100000,INITFL		;Set the initialization flag
					; (used to indicate whether we must
					; set the 'host timeout' for this
					; port after the init completes)
	DEC	RETRY			;Have we tried long enough?
	BGE	10$			;No, then do an initialization.
HARDEX:	CALLR	UMHERR			;Yes, take the hard error exit.

.IF EQ MMG$T
10$:	CLR	@UDAIP			;Strobe the UDA to start the init.
	.ADDR	#ISTEP,R4		;R4 -> initialization parameters.
.IFF ;EQ MMG$T
10$:	MOV	#XUDAIP+2,R5		;R5 -> UDAIP address +2
	$REL .-2 XUDAIP+2 UMX HIGH	; ...
	CLR	@-(R5)			;Strobe the UDA to start the init.
	MOV	#XISTEP,R4		;R4 -> initialization parameters.
	$REL .-2 XISTEP UMX HIGH	; ...
.ENDC ;EQ MMG$T	
	MOV	#ISTEP1,(R4)+		;Set step bit for step 1.
	MOV	R4,@R4			;Point INISEQ at INILST-2.
.IF EQ MMG$T
;*NOTE* The code below is omitted in XM because the 22-bit value is 
;	calculated in the .DRPTR code and stored.
	CMP	(R4)+,(R4)+		;Point to message ring pointer.
	MOV	R4,@R4			;During init, send port the address
	ADD	#MRING-MRPTR,@R4	;of the message ring.
.IFT ;EQ MMG$T
INISTP:	.ADDR	#UDASA,R4		;R4 -> -> UDASA register
.IFF ;EQ MMG$T
INISTP:	MOV	#XUDASA,R4		;Get the addr of ASA address
	$REL .-2 XUDASA UMX HIGH	; ...
.ENDC ;EQ MMG$T
	MOV	@(R4)+,R5		;Get the contents of the ASA.
	BMI	INIT			;Try again on error.
	BIT	R5,@R4			;Is the desired step bit on?
	BEQ	INISTP			;If not wait for it.
	MOV	R4,R5			;R5 -> (X)UDASA+2
	ASL	(R4)+			;Set next step for next time.
	ADD	#2,(R4)+		;Advance to parameters to load.
	MOV	@-(R4),@-(R5)		;Set the next word (*INTEN*)
	TST	-(R4)			;Which step is this?
	.ASSUME ISTEP4*2 EQ 100000
.IF EQ UM$PORTS-1
	BMI	START			;Step 4 so go start the transfer.
.IFF
	BPL	20$			;Not step 4 go RTS to wait for int.
 .IF EQ MMG$T
	MOV	.PCTAB,R5		;Yes so get address of CP entry.
 .IFF ;EQ MMG$T
	MOV	X.PCTAB,R5		;Yes so get address of CP entry.
 .ENDC ;EQ MMG$T
	MOV	(R4),PC.STEP(R5)	;Save init state in port impure area.
	BR	START			;Go try to start the transfer now.
.ENDC ;NE UM$PORTS-1
20$:	
.IF NE MMG$T
HRET:	.HP1EX	P1LOW			; (Map to low memory)
	JMP	@#LRET1			;Return to low memory exit
	$REL .-2 LRET1 UMR		; ...
	.HP1EN				; (End of block)

;*********************************************************************
	UMPSECT
;*********************************************************************

LRET1:	MOV	2(SP),SP		;Restore stack
	CMP	(SP)+,(SP)+		;Pop some arguments
	MOV	(SP)+,R0		;Restore R0 (in case come from abort)
.ENDC ;NE MMG$T
	RTS	PC			;Wait for an interrupt, back at UMINT
	.DSABL	LSB

.SBTTL	DISPAT	- Function Dispatch Area

;+
; DISPAT
;
; The controller characteristics are set if we just completed a four step
; initialize and the required unit is brought online. For DISK,In the case of
; bbr the online is followed by a get status to obtain parameters needed
; in the bbr algorithm. All the above operations used the interrupt facility
; and then return back to this point. 
; The function byte is obtained from the q-element - the operation requested
; is decoded and control is passed to the appropiatte routine.
;-
	.ENABL	LSB
.IF NE MMG$T				;If XM
;*********************************************************************
	UMXPSECT
;*********************************************************************
.ENDC ;NE MMG$T
DISPAT:
.IF NE UM$MU				;If magtape
	CLR	INTEXP			;Set no interrupts expected
.ENDC ;NE UM$MU	
	ASL	(PC)+			;Do we have to set timeout value?
INITFL:	 .WORD	0			; (Initialization flag)
	BCC	10$			;Nope, it's already set
	DO	SETTMO,THEN,BRINON	;Set the timeout, then do ONLINE
BRINON:	
.IF NE UM$DU				;If disk
 .IF EQ DU$BBR
	DO	IONLIN,THEN,DISPAT	;Go do an internal online
 .IFF ;EQ DU$BBR
	DO	IONLIN,THEN,GETUS	;If host BBR - Do ONL + GUS
 .ENDC ;EQ DU$BBR
10$:
 .IF EQ	MMG$T
	MOV	UMCQE,R5		;R5 -> current queue element.
 .IFF ;EQ MMG$T
	MOV	H$CQE,R5		;R5 -> current queue element
 .ENDC ;EQ MMG$T
.ENDC ;NE UM$DU
.IF NE UM$MU				;If Magtape
	DO	IONLIN,THEN,DISPAT	;Go do an internal online
10$:	
 .IF EQ MMG$T				;If not XM
  .IF EQ MU$FSM				;If hardware handler
	MOV	UMCQE,R5		;R5 -> current queue element.
  .IFF ;EQ MU$FSM			;If file structured
	MOV	MUCQ,R5			;R5 -> fake queue element
  .ENDC ;EQ MU$FSM
	MOV	Q$BUFF(R5),OLDBA	;Save buffer address
 .IFF ;EQ MMG$T				;If XM
	MOV	H$CQE,R5		;R5 -> hi memory copy of queue element
 .ENDC ;EQ MMG$T
	CLR	NFSREAD			;Clear NFS read flag
.ENDC ;NE UM$MU
	MOVB	Q$FUNC(R5),R4		;R4 = function. Read/Write or Seek?
	BEQ	50$			;Branch if yes
.IF NE UM$MU				;If Magtape
	BLT	20$			;Branch if .SPFUN
	CALLR	USRFN			;It's a USR function

20$:
.ENDC ;NE UM$MU
.IF NE UM$DU				;If disk
	CMPB	R4,#SP.MUC		;Is it the MU compatible Bypass?
	BEQ	30$			;Yes...
.ENDC ;NE UM$DU
	CMPB	R4,#SP.BYP		;Is this the Bypass .SPFUN
	BNE	40$			;No, check next function.
.IF NE UM$MU				;If Magtape
.ENDC ;NE UM$MU
30$:	DO	BYPASS,THEN,UMEXIT	;Yes, do Bypass action and exit.

40$:
.IF NE UM$MU				;If Magtape
	CMPB	R4,#SP.STR		;Is this TS05 stream @100ips .SPFUN?
	BNE	50$			;No
.ENDC ;NE UM$MU
	CALLR	FNDISP			;Jump to device specific dispatch

50$:
.IF NE MMG$T				;If XM
	CALL	BUSCHK			;Yes, go check bus limits on DMA
	BCS	HARDEX			;Branch if error
.ENDC ;NE MMG$T
.IF NE UM$DU				;If disk
 .IF EQ ERL$G
	DO	IOXFER,THEN,UMEXIT	;Yes, do I/O transfer then exit.
 .IFF
	DO	IOXFER,THEN,LOGIT	;Yes, do I/O and log success.
 .ENDC ;EQ ERL$G
.ENDC ;NE UM$DU
.IF NE UM$MU				;If Magtape
	CALLR	RWRT			;Go handle reads and writes (and most
					; .SPFUNs).
.ENDC ;NE UM$MU

	.DSABL	LSB

.SBTTL	COORD	- Coordination Routine for Handler

;+
; Pseudo subroutine to coordinate pre and post interrupt activity.
;-

COORD:	MOV	R5,R4			;Get address of routine offset.
	ADD	(R5)+,R4		;Get address of routine after int.
	MOV	R4,NEXT			;Store it for after interrupt.
	MOV	R5,R4			;Reset R4.
	ADD	(R5)+,R4		;Get address of pre-int. routine.
	MOV	(SP)+,R5		;Tidy the stack / restore R5
	JSR	PC,@R4			;Go do the setup routine.
	.BR	POLL			;Now start the activity.

.SBTTL	POLL	- Starts the Controller!

;+
; Send the command buffer to the port (ie. start the polling).
;-
	.ENABL	LSB
POLL:	
.IF NE UM$MU				;If magtape
	DEC	(PC)+			;We expect another interrupt
INTEXP:	 .WORD	0			; Minus count of interrupts expected.
ABPOLL:					;Entry for Abort command: INTEXP was
					; decremented already.
 .IF NE MU$FSM				;If file structured
	MOV	ABTFLG,-(SP)		;Save Abort flag. (Avoids race: abort
					; cmd interrupts fast, e.g. before the
					; abort check below for RESTOR regs.)
 .ENDC ;NE MU$FSM
.ENDC ;NE UM$MU
.IF EQ MMG$T
	BIS	#OWN,CRING+2		;Give the command to start polling.
	MOV	@UDAIP,R5		;Read the AIP to start it.
	BIS	#<OWN!FLAG>,MRING+2	;Give the port a reply buffer.
.IFF ;EQ MMG$T
	BIS	#OWN,XCRING+2		;Give the command to start polling
	MOV	#XUDAIP,R5		;R5 -> UDAIP
	$REL .-2 XUDAIP UMX HIGH	; ...
	MOV	@(R5),R5		;Read the AIP to start it
	BIS	#<OWN!FLAG>,XMRING+2	;Give the port a reply buffer.
.ENDC ;EQ MMG$T
.IF NE UM$MU				;If magtape
 .IF NE MU$FSM				;If file structured
	TST	(SP)+			;Are we Aborting?
	BNE	10$			;If NE, yes, don't muck with registers
  .IF NE MMG$T
	.HP1EX	P1LOW			; (Map to low memory)
	JMP	@#LRET5			;Return to low memory to call RESTOR
	$REL .-2 LRET5 UMR		; ...
	.HP1EN				; (End of block)

;*********************************************************************
	UMPSECT
;*********************************************************************

LRET5:	MOV	2(SP),SP		;Restore stack
	CMP	(SP)+,(SP)+		;Pop some arguments
	MOV	(SP)+,R0		;Restore R0 (in case come from abort)
  .IFTF ;NE MMG$T
	CALL	RESTOR			;Restore registers
  .IFT ;NE MMG$T
	RETURN				;Return, we'll be back on interrupt.

;*********************************************************************
	UMXPSECT
;*********************************************************************

  .ENDC ;NE MMG$T

10$:
 .ENDC ;NE MU$FSM
.ENDC ;NE UM$MU
.IF EQ MMG$T
	RETURN				;Return, we'll be back on interrupt.
.IFF ;EQ MMG$T
	JMP	HRET			;Go return to low before RTS
.ENDC ;EQ MMG$T


HINIST:	BR	INISTP			;'HELP! I need somebodys' help.'
					;       - the Beatles 

	.DSABL	LSB

.SBTTL	.DRAST	- Interrupt Entry Point

;+
; Interrupt and abort entry points
;
; 	Output: R5 -> Response buffer
;-
	.ENABL	LSB
.IF NE MMG$T				;If XM
;*********************************************************************
	UMPSECT
;*********************************************************************
.ENDC ;NE MMG$T
.IF NE UM$DU				;If disk
	.DRAST	UM,UM$PRI		;Set up the interrupt entry.
.ENDC ;NE UM$DU
.IF NE UM$MU				;If magtape
UM$ABRT:
 .IF EQ MMG$T				;If not XM
	CALLR	UM$AB1			;Go handle abort

 .IFF ;EQ MMG$T				;If XM
	.P1EXT	P1HIGH			; (Map to high memory)
	CALLR	@#UM$AB1		;Go handle abort
	$REL .-2 UM$AB1 UMX		; ...
	.P1END				; (End of block)

 .ENDC ;EQ MMG$T
	.DRAST	UM,UM$PRI,UM$ABRT	;Set up interrupt and abort entries.
.ENDC ;NE UM$MU
.IF NE MMG$T
.IFF ;NE MMG$T
 .IF NE UM$MU				;If magtape
	CALL	INTEX			;Enter interrupt
 .ENDC ;NE UM$MU
.IFT ;NE MMG$T
	.P1EXT	P1HIGH			; (Map to high memory)
	CALL	@#INTEX			;Enter interrupt in XM
	$REL .-2 INTEX UMX		; ...
	.P1END				; (End of block)
.IFTF ;NE MMG$T
 .IF NE UM$MU				;If magtape
	TST	R5			;What'll it be, pardner?
	BEQ	FORKIT			;Normal stuff, do the .FORK
	BPL	10$			;End of abort sequence, do .DRFIN
	RETURN				;Return, wait for last abort interrupt

10$:	CALLR	$DONE			;Abort is done, return queue element.
 .ENDC ;NE UM$MU

.IFT ;NE MMG$T				;If XM
;********************************************************************
	UMXPSECT
;********************************************************************
.IFTF ;NE MMG$T

INTEX:
.IFT ;NE MMG$T
	CLR	XINTRID			;Ack interrupt(s)
	CLR	XINTRID+2		; ...
.IFF ;NE MMG$T
	CLR	INTRID			;Ack interrupt(s)
	CLR	INTRID+2		; ...
.IFTF ;NE MMG$T
 .IF NE UM$MU				;If magtape
	INC	INTEXP			;Decr expected interrupt count, got 1
	MOV	ABTFLG,R5		;Aborting?
	BEQ	30$			;No
	MOV	INTEXP,R5		;Yes, any more interrupts expected?
	BPL	20$			;No, go tell 'em abort is finished.
  .IF NE MMG$T
	BIS	#<OWN!FLAG>,XMRING+2	;Yes, insure port has a reply buffer.
					; (Reuse it, since 2 cmds outstanding)
  .IFF ;NE MMG$T
	BIS	#<OWN!FLAG>,MRING+2	;Yes, insure port has a reply buffer.
					; (Reuse it, since 2 cmds outstanding)
  .ENDC ;NE MMG$T
	BR	30$			;Just return, next intrpt will .DRFIN
20$:	CLR	ABTFLG			;Abort done, clear flag, do .DRFIN
	INC	R5			;R5 > 0 to flag finished abort
 .ENDC ;NE UM$MU
30$:	RETURN				;Back to low memory


.IFT ;NE MMG$T
;********************************************************************
	UMPSECT
;********************************************************************
.IFTF ;NE MMG$T
FORKIT:					;.FORK in low memory
	.FORK	UMFBLK			;Well fork queue buddy!
.IFT ;NE MMG$T
	MOV	@#KISAR1,-(SP)		;Store old mapping
	.P1EXT	P1HIGH			; (Map to high memory)
	JMP	@#INTEX2		;Enter interrupt in XM
	$REL .-2 INTEX2 UMX		; ...
	.P1END				; (End of block)

;********************************************************************
	UMXPSECT
;********************************************************************

INTEX2:	MOV	2(SP),SP		;Restore stack pointer
	ADD	#6,SP			;Pop some arguments off
	MOV	(SP)+,P1LOW		;Store low mapping
	TST	XISTEP			;Are we initializing the port?
.IFF ;NE MMG$T
	TST	ISTEP			;Are we initializing the port?
.IFTF ;NE MMG$T
	BGT	HINIST			;Yes, branch
.IFT ;NE MMG$T
	MOV	#XUDASA,R5		;R5 -> UDASA
	$REL .-2 XUDASA UMX HIGH	; ...
	BIT	#<IERROR!ISTEP1>,@(R5)	;Has port errored or been reset?
.IFF ;NE MMG$T
	BIT	#<IERROR!ISTEP1>,@UDASA	;Has port errored or been reset?
.ENDC ;NE MMG$T
	BEQ	40$			;No, skip  next
	CALLR	INIT			;Yes, then we must re-initialize it
40$:
.IF NE UM$DU				;If disk
 .IF NE DU$BBR
	TST	BBRON			;Is BBR in progress ?
	BPL	50$			;No, branch
	JMP	CONBBR			;Go - get back into BBR
 .ENDC ;NE DU$BBR
.ENDC ;NE UM$DU

50$:
.IF NE UM$MU				;If Magtape
	CLR	R0			;Clear Bypass recovery flag
.ENDC ;NE UM$MU
	TST	INTEOP			;Is this an internal operation?
	BMI	60$			;Yes, go check result of recovery
.IF EQ MMG$T				;If not XM
 .IF NE UM$MU				;If magtape
  .IF NE MU$FSM				;If file structured
	MOV	MUCQ,R5			;R5 -> fake queue element
  .IFF ;NE MU$FSM			;If hardware handler
	MOV	UMCQE,R5		;R5 -> current queue element.
  .ENDC ;NE MU$FSM
 .ENDC ;NE UM$MU
 .IF NE UM$DU				;If disk
	MOV	UMCQE,R5		;R5 -> current queue element.
 .ENDC ;NE UM$DU
.IFF ;EQ MMG$T				;If XM
	MOV	H$CQE,R5		;R5 -> current queue element.
.ENDC ;EQ MMG$T
	CMPB	#SP.BYP,Q$FUNC(R5)	;The "BYPASS" special function?
	BNE	60$			;No, then carry on.
	CMP	#1,(R5)			;Does he want BYPASS recovery?
	BNE	GO$ON			;No, go do its post interrupt action.
	COM	R0			;Yes, set Bypass recovery flag
.IF NE MMG$T
					;MRING for BYPASS and regular
					; commands is different in XM.
	MOV	Q$PAR(R5),R1		;Get user mapping
	MOV	Q$BUFF(R5),R5		;R5 -> start of cmd/res buffer
	ADD	#<4>,R5			;R5 -> beginning of response
	.HP1EX	R1			; (Start of P1EXT block)
	MOV	P.STS(R5),R1		;Get status
	MOV	R1,@#STATU$		;Store status for crash...
	$REL .-2 STATU$ UMR		; ...
 .IF NE UM$DU				;If disk
	MOVB	P.FLGS(R5),R2		;R2 = End message flags
 .ENDC ;NE UM$DU
	.HP1EN				; (End of block)
	BR	70$			;Go merge
.ENDC ;NE MMG$T

60$:	CLR	INTEOP			;Reset internal op flag
.IF NE MMG$T
 .IF NE MU$32K				
	MOV	XPMBUF,R5		;R5 -> response buffer
 .IFF ;NE MU$32K
	MOV	#MBUFF,R5		;R5 -> response buffer
	$REL .-2 MBUFF UMX HIGH		; ...
 .ENDC ;NE MU$32K
.IFF ;NE MMG$T
	MOV	MRING,R5		;Point to message buffer.
.IFTF ;NE MMG$T
	MOV	P.STS(R5),R1		;R1 = status
.IFF ;NE MMG$T
	MOV	R1,STATU$		;Store status for crash...
.IFT ;NE MMG$T
	.HP1EX	P1LOW			; (Map to low memory)
	MOV	R1,@#STATU$		;Store status 'RELOC'
	$REL .-2 STATU$ UMR		; ...
	.HP1EN				; (End of block)
.IFTF ;NE MMG$T
 .IF NE UM$DU				;If disk
	MOVB	P.FLGS(R5),R2		;R2 = End message flags
 	BIC	#^C<377>,R2		;Clear sign extend
 .ENDC ;NE UM$DU
.ENDC ;NE MMG$T
70$:	
.IF NE UM$DU				;If disk
 .IF NE DU$BBR
	BITB	R2,#EF.BBR		;Bad block reported ?
	BEQ	NOBBR			;No, branch
	CALLR	BBFND			;Go do bad block replacement

NOBBR:					;Entry point for 'CANNOT DO BBR'
 .ENDC ;NE DU$BBR
.ENDC ;NE UM$DU
	BIC	#^C<ST.MSK>,R1		;Isolate major status code bits.
	.ASSUME ST.SUC EQ 0		;Did the I/O or function go ok?
	BNE	90$			;No, then try "online".
.IF NE UM$MU				;If magtape
	CMPB	#SP.RD,LASCOM		;Yes, was last command a read?
	BNE	80$			;No, check backup tape mark
	CMP	RBCNT,P.BCNT(R5)	;Requested byte count = transferred?
	BNE	90$			;No, treat it like an error
80$:	INC	BCKTM			;Last command 'backspace tape mark'?
	BEQ	90$			;If EQ, yes, treat it like an error
.ENDC ;NE UM$MU

GO$ON:	CALLR	@NEXT			;I/O ok, do post interrupt activity.

90$:	CMP	R1,#ST.AVL		;Was it not available?
.IF NE UM$DU				;If disk
 .IF EQ ERL$G
	BNE	UMHERR			;No, so not recoverable.
 .IFF ;EQ ERL$G
	BEQ	110$			;Yes, try online
	CALLR	BADIO			;No, log the bad I/O, take hard exit.
 .ENDC ;EQ ERL$G
.ENDC ;NE UM$DU
.IF NE UM$MU				;If magtape
	BEQ	110$			;Yes, it's not available, try online
	INC	R0			;No, is this Bypass recovery?
 .IF EQ ERL$G
	BEQ	120$			;Yes, just give hard error
 .IFF ;EQ ERL$G
	BNE	100$			;No, go check some other errors
	CALLR	BADIO			;Yes, log the bad I/O, take hard exit.
100$:
 .ENDC ;EQ ERL$G
	CALLR	UMERR			;Not Bypass, check some other errors
.ENDC ;NE UM$MU

.IF NE UM$DU				;If disk
110$:	DO	IONLIN,THEN,HSTART	;Retry the command and then start!
.ENDC ;NE UM$DU
.IF NE UM$MU				;If magtape
110$:	CLR	BCKTM			;Clear 'backspace tape mark' flag.
	DO	IONLIN,THEN,HSTART	;Retry the command and then start!
.ENDC ;NE UM$MU

HSTART:	
.IIF NE	ERL$G, JSR PC,ERRLOG		;Log the error.
	DEC	RETRY			;No, then have we tried too much.
	BLE	120$			;Yes, then its a hard error (init).
.IF NE UM$MU				;If magtape
	CALLR	START			;Go start again
.ENDC ;NE UM$MU
.IF NE UM$DU				;If disk
 .IF EQ DU$BBR
	CALLR	START			;Go start again
 .IFF ;EQ DU$BBR
	CALLR	GETUS			;If BBR support go get status too!
 .ENDC ;EQ DU$BBR
.ENDC ;NE UM$DU

120$:	CALLR	UMHERR			;Issue hard error
	.DSABL	LSB

.SBTTL	SETTMO	- Sets 'Host Timeout' Period

;+
; SETTMO
;	This routine is called as a result of a controller initialize
;	(on-line) procedure and is used to set the controller 'host
;	timeout' period before the actual transfer begins.
;-

SETTMO:	MOV	#-1,INTEOP		;Indicate Internal Op in progress
	MSCP	OP.SCC			;'Set Controller Characteristics'
	MOV	#TO.MIN*60.,P.HTMO(R4)	;Set the value
	RTS	PC

.SBTTL	ONLINE	- Do Online Request for Retry or Sizing

;+
; IONLIN, ONLINE
;
;	The following routine will provide an online of the desired unit.
;	Two entry points are available, one for internal operations which 
;	desire to bring the unit up, the second entry is used to get the 
;	size of the drive indicated by the selected unit.
;-

IONLIN:	MOV	#-1,INTEOP		;Indicate Internal Op in progress
ONLINE:	MSCP	OP.ONL			;Select the ONLINE command.
	RTS	PC			

.SBTTL	GETCBF	- Initialize MSCP Command Buffer

;+
; This subroutine clears the MSCP command buffer and inserts the generic
; parameters required by most command.
;
; 	Output:	R4 -> Command buffer
;-

GETCBF:	
.IF EQ MMG$T
	.ADDR	#MBUFF,R4		;R4 -> message buffer.
	MOV	R4,MRING		;Tell MSCP server where it is.
	CLR	MRING+2
.IFF ;EQ MMG$T
	MOV	R0,-(SP)		;Save work register
	MOV	R1,-(SP)		;ditto
	MOV	XPHYSL,R0		;R0 = global region phy base low
	MOV	XPHYSH,R1		;R1 = global region phy base high
 .IF NE MU$32K				;If 32KW bound check
	SUB	#BEGREL,R0		;Subtract beginning of relocated UMX
	SBC	R1			;Propogate borrow
	ADD	XPMBUF,R0		;Add -> response buff
 .IFF ;NE MU$32K
	ADD	#MBUFF-UMXBASE,R0	;Add offset to response buff
 .ENDC ;NE MU$32K
	ADC	R1			;Add carry to high part
	MOV	R0,XMRING		;Store low part
	MOV	R1,XMRING+2		;Store high part
 .IF NE MU$32K				;If 32KW bound check
	MOV	XPMBUF,R4		;R4 = offset to message ring (PAR1)
 .IFF ;NE MU$32K
	MOV	#MBUFF,R4		;R4 = offset to message ring (PAR1)
	$REL .-2 MBUFF UMX
 .ENDC ;NE MU$32K
.IFTF ;EQ MMG$T
	MOV	#P.CSIZ/2,-(SP)		;Count words to clear on stack which
	.ASSUME MBUFF EQ CBUFF+P.CSIZ+4
1$:	CLR	-(R4)			;Clear out a word of the buffer.
	DEC	(SP)			;Whole buffer cleared (ie.=-1)?
	BPL	1$			;No, keep clearing.
	SUB	(SP)+,-(R4)		;Add 1 to sequence number(subtract -1)
 .IF NE UM$MU
	MOV	@R4,CUROPT		;Get command number for abort check
	BIS	#MD.CSE,P.MOD(R4)	;Clear Serious Exceptions all commands
	MOV	#<TAPEID*400>,-(R4)	;Say its a tape 
	.ASSUME VC.CMD EQ CBUFF-2
	MOV	#P.CSIZ,-(R4)		;Store size of command!
	.ASSUME LN.CMD EQ VC.CMD-2
	CMP	(R4)+,(R4)+		;R4 -> CBUFF
 .ENDC ;NE UM$MU
 .IF NE UM$DU
	MOV	#P.CSIZ,-4(R4)		;Store size of command!
	.ASSUME LN.CMD EQ CBUFF-4
 .ENDC ;NE UM$DU
	MOV	#P.CSIZ,P.CSIZ(R4)	;Store response size
	.ASSUME LN.RSP EQ LN.CMD+P.CSIZ+4
.IFT ;EQ MMG$T
	MOV	R4,CRING		;Save the ring pointer.
	CLR	CRING+2
.IFF ;EQ MMG$T
	MOV	XPHYSL,R0		;R0 = global region phy base low
	MOV	XPHYSH,R1		;R1 = global region phy base high
 .IF NE MU$32K				;If 32KW bound check
	SUB	#BEGREL,R0		;Subtract beginning of relocated UMX
	SBC	R1			;Propogate borrow
	ADD	XPCBUF,R0		;Add -> command buffer
 .IFF ;NE MU$32K
	ADD	#CBUFF-UMXBASE,R0	;Add offset to command buffer
 .ENDC ;NE MU$32K
	ADC	R1			;Add Carry to high part
	MOV	R0,XCRING		;Store low part
	MOV	R1,XCRING+2		;Store high part
.IFTF ;EQ MMG$T
	MOV	(R5)+,P.OPCD(R4)	;Select the opcode.
	CLR	P.UNIT(R4)		;Clear unit number word for byte move.
.IFT ;EQ MMG$T
	MOVB	@.UTTAB,P.UNIT(R4)	;Select the unit number.
	.ASSUME UT.UNIT EQ 0
.IFF ;EQ MMG$T
	MOV	#X.UTTAB,R1		;R1 -> UTTAB
	$REL .-2 X.UTTAB UMX HIGH	; ...
	MOVB	@(R1)+,P.UNIT(R4)	;Select unit number
	MOV	(SP)+,R1
	MOV	(SP)+,R0
.IFTF ;EQ MMG$T
	RTS	R5			;Return to the caller.
.ENDC ;EQ MMG$T

.SBTTL	BYPASS	- Bypass RT-11 and Issue MSCP Directly

;+
; BYPASS
;	This subroutine implements special function BYPASS (code 371 and 360)
;	which allows the user to issue MSCP commands directly to the disk
;	system.
;
;				*** NOTE ***
;		RT has already address checked the start of the user's
;		buffer to ensure that it is in the user's job space.
;
;		If the WCNT argument is non-zero, it specifies the virtual
;		address of the data buffer.  It is converted to physical
;		and placed in the command message.  If it is zero, the
;		physical address specified in the command message is used.
;-
	.ENABL	LSB

BYPASS:	ADD	#Q$BUFF-Q$BLKN,R5	;Advance to buffer address field
.IF EQ MMG$T
	MOV	(R5)+,R4		;R4 = User's buffer address
.IFF ;EQ MMG$T
	CALL	@H$MPPT			;Convert virtual to physical.
	MOV	(SP)+,R4		;R4 = low order buffer address
	MOV	(SP)+,R0		;R0 = (shifted) high order address
	ASH	#-4,R0			;Right-justify high-order address bits
.IFTF ;EQ MMG$T
	ADD	#4,R4			;Adjust for length and virtual circuit
					; words
.IFT ;EQ MMG$T
	BCS	30$			;High-order component only valid in XM
	MOV	R4,MRING		;Set response buffer low-order
	CLR	MRING+2			; and high-order address
.IFF ;EQ MMG$T
	ADC	R0			;In case of 16-bit wrap
	MOV	R4,XMRING		;Set response buffer low-order
	MOV	R0,XMRING+2		; and high-order address
.IFTF ;EQ MMG$T
	ADD	#P.MSIZ+4,R4		;Adjust for response buffer,
					; length and virtual circuit words
.IFT ;EQ MMG$T
	BCS	30$			;High-order component only valid in XM
	MOV	R4,CRING		;Set command message buffer low-order
	CLR	CRING+2			; and high-order address
.IFF ;EQ MMG$T
	ADC	R0			;In case of 16-bit wrap
	MOV	R4,XCRING		;Set cmd message buffer low-order
	MOV	R0,XCRING+2		; and high order addr
.IFTF ;EQ MMG$T
 .IF NE UM$MU				;If Magtape
	MOV	#<TAPEID*400>,-2(R4)	;Put tape id into high byte of vcid
	MOV	R4,-(SP)		;POLL expects R4-> cmd buffer
	CLR	LASCOM			;BYPASS mustn't confuse error recovery
 .ENDC ;NE UM$MU
	MOV	(R5),R0			;Data buffer address specified?
	BEQ	20$			;Nope, use the command message as is
.IFT ;EQ MMG$T
	CLR	R1			;R1 = High order buffer address
	MOV	R0,R2			;R2 = Low order buffer address
.IFF ;EQ MMG$T
	MOV	H$P1EX,R1		;R1 -> P1EXT
	CALL	CVAPHY(R1)		;Convert user virtual address to phy
.IFTF ;EQ MMG$T
	MOV	Q$BUFF-Q$WCNT(R5),R4	;R4 -> User's command/response buffer
	ADD	#<4+P.MSIZ+4>+P.BUFF,R4	;Adjust to data buffer address field
.IFF ;EQ MMG$T
	MOV	Q$PAR-Q$WCNT(R5),10$	;Save PAR1 value for mapping buffer
	JSR	R0,@H$P1EX		;Externalize the following code
	 .WORD	10$-.
.IFTF ;EQ MMG$T
	MOV	R2,(R4)+		;Set the data buffer low-order and
	MOV	R1,(R4)+		; high-order physical address
.IFF ;EQ MMG$T
10$:	 .BLKW				; : PAR1 value to map user's buffer
.IFTF ;EQ MMG$T
20$:
 .IF NE UM$MU				;If Magtape
	MOV	(SP)+,R4		;Restore R4 for POLL
 .ENDC ;NE UM$MU
	RTS	PC			;Return (COORD will start operation)

.IFT ;EQ MMG$T
30$:	TST	(SP)+			;Tidy the stack
	CALLR	UMHERR			;And take the error exit
.ENDC ;EQ MMG$T

	.DSABL	LSB

.IF NE ERL$G				;For next page

.SBTTL	LOGIT,BADIO - Error Logging Support Routines

;+
; LOGIT
;
; Termination routine to log successful I/O transfers.
;-

LOGIT:	
 .IF EQ MMG$T
	TST	$SUCS			;Is success logging enabled?
 .IFF ;EQ MMG$T
	TST	X$SUCS			;Is success logging enabled?
 .ENDC ;EQ MMG$T
	BNE	44$			;No, branch
	CLR	RETRY			;Retry count = success + 1
	CALL	ERRLOG			;Tell the logger the good news.
44$:	CALLR	UMEXIT			;Take the normal exit.

;+
; BADIO
;
; Subroutine to log I/O errors (fatal).
;-

BADIO:	MOV	#1,RETRY		;Set retry count = hard error + 1
	CALL	ERRLOG			;Log the error.
	CALLR	UMHERR			;Take the error exit.

;+
; ERRLOG
;
; Subroutine to log online errors.
;-

ERRLOG:	
 .IF EQ MMG$T
	.ADDR	#MBUFF,R2		;R2 -> response buffer.
 .IFF ;EQ MMG$T
	MOV	@#KISAR1,R1		;R1 -> input buffer PAR1 value
	MOV	XPMBUF,R2		;R2 -> input buff PAR1 virtual
	MOV	#ERLBUF,R4		;R4 -> output buff virtual addr
	$REL .-2 ERLBUF UMR		; ...
;+
;*NOTE* The BLKMOV routine uses user mapping for the output buffer,
; 	therefore we are not guaranteed that the mapping would be correct.
;-
	MOV	R4,R3			;Save a copy temporary
	BIC	#^C<77>,R4		;Keep low six bits...
	ADD	#BEGREL,R4		;Form a PAR1 bias virtual addr
	ASH	#-6,R3			;Addr/32 for PAR1 value
	BIC	#^C<1777>,R3		;Clear sign extend
	MOV	#P.MSIZ/2,R5		;Wordcount
	MOV	H$P1EX,R0		;R0 -> P1EXT
	CALL	BLKMOV(R0)		;Go move data to low memory
	MOV	#ERLBUF,R2		;R2 -> response buffer 
	$REL .-2 ERLBUF UMR		; ...
 .ENDC ;EQ MMG$T
	ADD	#P.UNIT,R2		;Start at the unit number.
 .IF EQ MMG$T				;If not XM
  .IF NE UM$MU				;If magtape
   .IF NE MU$FSM			;If file structured
	MOV	MUCQ,R5			;R5 -> fake queue element
   .IFF ;NE MU$FSM			;If hardware handler
	MOV	UMCQE,R5		;R5 -> current queue element.
   .ENDC ;NE MU$FSM
  .ENDC ;NE UM$MU
  .IF NE UM$DU				;If disk
	MOV	UMCQE,R5		;R5 -> current queue element.
  .ENDC ;NE UM$DU
 .IFF ;EQ MMG$T				;If XM
	MOV	H$CQE,R5		;R5 -> current queue element.
 .ENDC ;EQ MMG$T
	MOV	RETRY,R4		;R4 = current retry count
	ADD	#UM$COD*400-1,R4	;Device code / Remaining retried

	MOV	#NRETRY*400+20.,R3	;R3 <- max retries + 20 words.
 .IF EQ MMG$T
	CALL	@$ELPTR			;Call the error logger.
 .IFF ;EQ MMG$T
	CALL	@H$ELPT			;Call error logger (high memory).
 .ENDC ;EQ MMG$T

	RTS	PC			;Return to the caller.

.ENDC ;NE ERL$G
.IF NE MMG$T				;If XM

.SBTTL	BUSCHK	- Check DMA Limits for a Given BUS

;+
;
;-
	.ENABL	LSB
BUSCHK:	MOV	R5,-(SP)		;Save R5
	MOV	@#SYSPTR,R3		;R3 -> RMON base
 .IF NE UM$DU				;If disk
	BIT	#QBUS$,CONFG2(R3)	;Q-bus?
	BNE	20$			;Yes, branch, no check needed.
 .ENDC ;NE UM$DU
	MOV	H$CQE,R5		;R5 -> current queue element (hi copy)
	ADD	#Q$BUFF,R5		;R5 -> Q$BUFF
	CALL	@H$MPPT			;Convert virtual to physical
	MOV	(SP)+,R1		;R1 = Low 16 bits
	MOV	(SP)+,R2		;R2 =  High bits
	ASH	#-4,R2			;Shift high bits into right place
	MOV	(R5)+,-(SP)		;Store word count
	BPL	10$			;Negative?
	NEG	(SP)			;If so, make it positive
10$:	ASL	(SP)			;Make it into byte count
	ADD	(SP)+,R1		;Add byte count to low buffer address
	ADC	R2			; propaganda carry to high bits
	BIC	#<^B11>,R2		;Clear all but allowed 2 bits
	BNE	30$			;Branch if more than 18 bits
20$:	TST	(PC)+			;Clear Carry, skip next instr.
30$:	SEC				;Set Carry
	MOV	(SP)+,R5		;*C* Restore register
 .IF NE UM$MU				;If Magtape
	BIT	#QBUS$,CONFG2(R3)	;*C* Q-bus?
	BEQ	40$			;*C* No. Need check, don't change C.
	CLC				;*C* Yes. No check required, clear C.
 .ENDC ;NE UM$MU
40$:	RETURN				;*C* Return

	.DSABL	LSB

.ENDC ;NE MMG$T
.IF NE UM$DU				;If disk

.SBTTL	IOXFER	- Subroutine to Initialize for I/O Transfers

;+
; This subroutine sets up the MSCP command buffer for I/O transfers.
;
;	Input: R5 -> $QBLKN(QUEUE ELEMENT)
;	       R4 -> COMMAND PACKET (PAR1 OFFSET IN XM)
;-
IOXFER:	
	MSCP	OP.RD			; Create an MSCP read.
	MOV	(R5),R1			; Save logical block number in R1.
	MOV	R1,P.LBN(R4)		; Get the logical block number.
 .IF EQ MMG$T
	MOV	Q$BUFF(R5),P.BUFF(R4)	; Get the user's buffer address.
 .IFF ;EQ MMG$T
	ADD	#Q$BUFF,R5		; R5 -> Q.BUFF.
	CALL	@H$MPPT			; Convert virtual to physical.
	MOV	(SP)+,P.BUFF(R4)	; Get the low order 16 bits.
	MOV	(SP)+,R0		; Get the high order bits <5:4>
	ASH	#-4,R0			; shift them into place.
	MOVB	R0,P.BUFF+2(R4)		; Store them into MSCP buffer.
	MOV	H$CQE,R5		; R5 -> CURRENT QUEUE ELEMENT
 .ENDC ;EQ MMG$T
	TST	SPCIO			; ABSOLUTE READ/WRITE ?
	BEQ	10$			; NO, BRANCH
	SUB	#2,Q$BUFF(R5)		; UPDATE BUFFER ADDRESS Q-ELEMENT
10$:	MOV	Q$WCNT(R5),R0		; Get the word count.
	BPL	20$			; Plus means it was a read.
	NEG	R0			; Make the word count positive.
	INCB	P.OPCD(R4)		; Convert opcode to a write which
	.ASSUME OP.WR EQ OP.RD+1
20$:	MOV	R0,-(SP)
	ADD	#255.,R0		; ADJUST FOR KEX PARTIAL READ/WRITE
	BICB	#377,R0			; CLEAR LOW BYTE
	SWAB	R0			; R0 = number of blocks
	ADD	R0,R1			; Are we exceeding the partition ?
	BCC	30$			; No, branch
; Overflow occur - need to adjust the wordcount - R1 contains excess.
	TST	R1			; Is it exactly zero ?
	BEQ	30$			; YES, NO ADJUST NECESSARY
	SUB	R1,R0			; R0 = Adjusted blocks
	SWAB	R0			; Make R0 into a wordcount.
	TST	(SP)+			; POP R0 - not needed.
	BIS	#HDERR$,@-(R5)		; Set hard error indicator in CSW
	BR	40$			; SKIP NEXT

30$:	MOV	(SP)+,R0		; Restore old wordcount
40$:	ASL	R0			; Convert to a byte count.
	MOV	R0,P.BCNT(R4)		; Store in the MSCP buffer.
 .IF EQ MMG$T
	MOV	.UTTAB,R5		; R5 -> UTTAB entry.
 .IFF ;EQ MMG$T
	MOV	X.UTTAB,R5		; R5 -> UTTAB ENTRY
 .ENDC ;EQ MMG$T
	MOVB	UT.PART(R5),P.PART(R4)	; Get the hi order logical block no.
	RTS	PC			; Return to the caller.	

.SBTTL	DOTAB	- Routine to Return the Unit Translation Table

;+
; DOTAB
;
; This routine implements special function 372.  It returns the unit
; translation table to the caller if Q$WCNT is plus, and writes the 
; provided table if the Q$WCNT is minus.
;-
	.ENABL	LSB

DOTAB:	MOV	R0,-(SP)		;We need R0 as a worker.
	MOV	#<UTTBND-UTTAB>/2,R0	;R0 = number of words to transfer.
	MOV	R5,R4			;R4 -> queue element for putword.
 .IF EQ MMG$T
	.ADDR	#UTTAB,R5		;R5 -> unit translation table.
 .IFF ;EQ MMG$T
	MOV	#XUTTAB,R5		;R5 -> unit translation table.
	$REL .-2 XUTTAB UMX HIGH	; ...
 .ENDC ;EQ MMG$T
	TST	Q$WCNT(R4)		;Read table ?
	BMI	20$			;No, branch
10$:
 .IF EQ MMG$T
	MOV	(R5)+,@Q$BUFF(R4)	;Send a word to the user.
	ADD	#2,Q$BUFF(R4)		;Move to the next buffer location.
 .IFF ;EQ MMG$T
	MOV	(R5)+,-(SP)		;Put the word on the stack.
	CALL	@H$PTWRD		;Send it to the user.
 .ENDC ;EQ MMG$T
	DEC	R0			;All done?
	BGT	10$			;No, continue in transfer loop.
	BR	40$

20$:	ASL	R0			;Make wordcount into byte count
 .IF EQ MMG$T
30$:	MOVB	@Q$BUFF(R4),(R5)+	;Store byte
	INC	Q$BUFF(R4)		;Point to next byte
 .IFF ;EQ MMG$T
30$:	JSR	PC,@H$GTBY		;Get byte from user
	MOVB	(SP)+,(R5)+		;Store the byte in table
 .ENDC ;EQ MMG$T
	DEC	R0			;All done?
	BGT	30$			;No, continue in transfer loop
40$:	MOV	(SP)+,R0		;Restore R0.
	CALLR	UMEXIT			;And take the all done exit.

	.DSABL	LSB

.ENDC ;NE UM$DU