	.TITLE QUEACP QUEUE ACP 
	.IDENT /2.0/	; CHANGE BELOW TOO
	.RAD50 /2.0/	; SO CAN LOOK ON A RUNNING SYSTEM
;
; UPDATES:
;
;	6/5/87    D. LUECK   VERSION  2.0
;	1) Added capability to log debug messages to file QUEACPMSG.DAT
;	   using task QUELOG.  Also added debug message to log info in a
;	   message id header after completion of selected functions.
;	2) Added code to zero RNA pointers (M.RNA, M.BNA) in message id
;	   header if type 0 message being deleted (routine DLTYP0) has been 
;	   read but not acknowledged (message in RNA state).
;
;.begin.doc ************************** begin.doc
;  
; .c ;MODULE
; .c ;^&QUEACP\&
; .nf
; .x QUEACP>Defined
; Source:QUEACP.MAC
; Designer           :EARL LAKIA
; Author             :EARL LAKIA, DAVE LUECK
; Date of last update:05-JUN-87
; Revision level     :2.0
;  
; .C ;Formal Parameter List
; Receives:
;  
;    IOPACKET                   STRUCTURE       
;                               I/O PACKET FROM THE PSEUDO DEVICE 
;                               DRIVER.         
;  
; Returns:
;  
;    STATUS                     R0/R1 
;                               SUCCESS/FAILURE CODE AND BYTE COUNT. 
;  
; Accesses common(s):
;  
; Accesses file(s):
; 
; .x NETQUEn.DAT>READ/WRITE 
;    NTEQUEn.DAT                QUEUE FILE, WHERE n= CONNECTED DRIVER
;                               UNIT NUMBER.
; 
; Other modules referenced:
; .SK
; .fill
; .SK
; Description:
; .sk    
; 	This is the queue ACP for the DECNET queueing application.
; The following explains the valid function codes that may come
; from the pseudo device driver.  The position of the device
; dependent parameters are not the same as those in the QIO
; because of buffer address relocation of both the user message
; buffer and the message id buffer.
; .sk 
; .list
; .le;IO.WVB- This function is called with the message id and
; a message to be placed into the appropriate message id queue.
; The packet will also contain information denoting 
; recovery actions in the event the queue is full for this
; particular message id.
; .list 1,' '
; .le;I.PRM,I.PRM+2- User buffer double word address.  The
; buffer excludes the message header.
; .le;I.PRM+4- Byte count of above buffer.
; .le;I.PRM+6,I.PRM+10- Message id buffer double word address.
; .le;I.PRM+12- Type (0= This message may be deleted if queue becomes
; full, 1= message is not to be deleted  even if queue becomes full).
; .els
; .le;IO.WVB+1- Same as IO.WVB, but only used by the routing task, RTRRSX,
; to bypass writing a new header when the message is received from the
; remote node.
; .le;IO.RVB- This function is called to read a particular
; message id into the user buffer.  The second word of the 
; i/o status block will contain a "read but not acknowleged
; identifier" which must be used to acknowlege the message
; from the queue.  The size of the message can be determined by
; the header portion of the message.
; .list 1,' '
; .le;I.PRM,I.PRM+2- User buffer double word address.   The
; structure of buffer is the message header (see HDRDEF) followed
; by the user buffer.
; .le;I.PRM+4- Byte count of above buffer.
; .le;I.PRM+6,I.PRM+10- Message id buffer double word address.
; .els
; .le;IO.ACR- This function code allows any task to request
; notification whenever messages are received for the specified
; message id.  The ACP will determine if the task is able to 
; accept the notification prior to doing the notification (ie: the
; task is still in the system and part of the system task directory).
; The connected task will be notified by setting the task's event flag.
; .list 1,' '
; .le;I.PRM-I.PRM+2- Message id buffer double word address.
; .le;I.PRM+4- Size of message id buffer (16 bytes).
; .le;I.PRM+6- Event flag to set.
; .els
; .le;IO.ACW- This function code is used in conjunction with
; the IO.RVB to provide a logical  acknowlege from the task
; of a message just read or written.
; The I/O packet will contain a unique identifier from the 
; second I/O status word.  This will prevent
; the acknowlegement of a message that was read but deleted because
; of Queue overflow.
; .list 1,' '
; .le;I.PRM-I.PRM+2- Message id buffer double word address.
; .le;I.PRM+4- Size of message id buffer (16 bytes).
; .LE;I.PRM+6- Read not acknowleged identifier.
; .els
; .LE;IO.RNA- Put the read but not acknowleged message back at the beginning
; of the specified message id queue.
; .list 1,' '
; .le;I.PRM,I.PRM+2- Message id buffer double word address.
; .le;I.PRM+4- Size of message id buffer (16 bytes).
; .els
; .le;IO.DEL- This function code allows the user to delete without
; acknowleging a passed number of messages from the desired message id queue.
; .list 1,' '
; .le;I.PRM-I.PRM+2- Message id buffer double word address.
; .le;I.PRM+4- Size of message id buffer (16 bytes).
; .le;I.PRM+6- Number of messages to delete from queue.
; .ELS
; .le;IO.RAT- This function code allows the user to receive the
; current status of the desired message id queue.
; .list 1,' '
; .le;I.PRM-I.PRM+2- Buffer double word address to recieve the status of the
; message id queue.
; .le;I.PRM+4- Byte count of buffer (see MIDDEF).
; .le;I.PRM+6-I.PRM+10- Message id buffer double word address.
; .els
; .le;IO.ACE- This function code allows the user to receive the
; current status of the queue (read queue header).
; .list 1,' '
; .le;I.PRM-I.PRM+2- Buffer double word address to receive the status of the
; queue.
; .le;I.PRM+4- Byte count of buffer (see QHDDEF).
; .els
; .le;IO.APC+1- Mount the desired pseudo device unit with ourselves.  The
; passed UCB unit number is used to determine the file name of the QUEUE file.
; .LE;IO.APC+2- Dismount the desired pseudo device unit.
; .le;IO.DAC- Set up exit handling I/O rundown function.  This
; I/O never completes.  The ACP is called with a new packet
; when the task exits which will clean up in the event the task
; attached to a message id.  This function must be called prior to
; any calls to connect to a message id.
; .els
; .FILL
; .SK
; 	Possible error codes:
; .LIST 1,' '
; .le;IE.IFC (-02) -- Invalid function code.
; .le;IE.DUN (-09) -- ZQ: device not mounted or marked for dismount.
; .le;IE.EOF (-10) -- No messages in queue.
; .le;IE.DAO (-13) -- User buffer to small to contain message read.
; .le;IE.ABO (-15) -- QUEACP has been aborted via directive or an MCR or
; DCL command.
; .le;IE.CKS (-30) -- Error reading queue header into queue region.
; .le;IE.WAT (-31) -- Queue file not contiguous.
; .le;IE.SNC (-35) -- The wrong message is being acknowledged.
; .le;IE.CLO (-38) -- Error closing the queue file.
; .le;IE.NBF (-39) -- Directive error reading queue header from queue file.
; .le;IE.RBG (-40) -- Message to be written to queue exceeds 4014 bytes.
; .le;IE.NBK (-41) -- Queue header larger than 4K words; cannot map with 
; a single APR.
; .le;IE.RCN (-46) -- I/O error reading queue header from queue file.
; .le;IE.FOP (-53) -- A message exists in the queue that has been read
; but not acknowledged.
; .le;IE.PNT (-71) -- No message in this queue needs to be acknowledged.
; .le;IE.NDR (-72) -- No room left in queue.
; .le;IE.URJ (-73) -- Task cannot connect to queue; other task already
; connected.
; .le;IE.NLK (-79) -- Task is not connected to queue; cannot read any
; messages until connected.
; .le;IE.NST (-80) -- Another task is connected to queue; cannot read
; any messages while other task connected.
; .LE;IE.UKN (-97) -- Message id does not exist.
; .els
; end.doc ****************************** end.doc  

;
; SYSTEM MACROS
;
	.MCALL	TCBDF$	; TASK TCB DEFINITIONS
	.MCALL	UCBDF$	; UCB DEFINITIONS
	.MCALL	HWDDF$	; HARDWARE DEFINITIONS
	.MCALL	WTLO$	; WAIT FOR LOGICAL OR OF EVENT FLAGS
	.MCALL	SETF$	; SET SNGLE EVENT FLAG
	.MCALL	USTP$	; UNSTOP A TASK
	.MCALL	MRKT$	; MARK TIME 
	.MCALL	FINIT$	; INIT FSR REGION
	.MCALL	FSRSZ$
	.MCALL	WTSE$S	; WAIT FOR SINGLE EVENT FLAG
	.MCALL	GTIM$	; GET SYSTEM TIME 
	.MCALL	SDAT$	; SEND DATA 
	.MCALL	RSUM$	; RESUME A TASK
	.MCALL	SETF$S	; SET SINGLE EVENT FLAG
	.MCALL	RDAF$	; READ ALL EVENT FLAGS
	.MCALL	QIOSY$	; DEFINE ALL THE FUNCTION CODES
	.MCALL	RCVD$	; RECIEVE DATA
	.MCALL	EXIT$S	; EXIT
	.MCALL	CLEF$S	; CLEAR EVENT FLAG
	.MCALL	SRDA$S	; SPECIFY RECIEVE DATA AST
	.MCALL	OPEN$M	; OPEN FOR EXISTING FILE FOR MODIFY
	.MCALL	GLUN$	; GET LUN
	.MCALL	ALUN$	; ASSIGN LUN
	.MCALL	FDBDF$	; FDB OFFSET DEFINITION
	.MCALL	FDRC$A	; FDB RECORD SECTION DEFINITION
	.MCALL	FDOP$A	; FDB FILE OPEN SECTION DEFINITION
	.MCALL	CLOSE$	; CLOSE FILE
	.MCALL	FDBK$A	; ALLOC. SPACE FOR FDB
	.MCALL	DIR$	; DIRECTIVE CALL
	.MCALL	QIO$	; QIO CALL
	.MCALL	QIOW$	; QIO AND WAIT CALL
	.MCALL	ASTX$S	; AST EXIT
	.MCALL	SREX$S	; SPECIFY REQUESTED EXIT AST
	.MCALL	RQST$	; RUN A TASK
	.MCALL	FDOF$L	; LOCALLY DEFINE FILE OPEN SECTION OFFSETS
	.MCALL	FCSBT$
	.MCALL	NMBLK$	; FILE NAME BLOCK 
	.MCALL	CRRG$	; CREATE AND ATTACH REGION
	.MCALL	CRAW$	; CREATE ADDRESS WINDOW
	.MCALL	DTRG$S	; DETACH REGION
	.MCALL	SVTK$S	; SPECIFY SST VECTOR TABLE
	.MCALL	SNPBK$	; ALLOCATE SNAPSHOT DUMP CONTROL BLOCK
	.MCALL	SNAP$	; GENERATE SNAPSHOT DUMP
;
; DEFINE FLOATING POINT ACCUMULATORS
;
	F0=%0
	F1=%1
	F2=%2
	F3=%3
;
; QUEUE FILE MACROS (QUEUE.MLB)
;

	.MCALL	HDRDEF	; MESSAGE HEADER OFFSETS
	.MCALL	QHDDEF	; QUEUE HEADER OFFSETS
	.MCALL	MIDDEF	; MESSAGE ID LIST HEAD DEFINITIONS
;
; INVOKE SOME OF THE MACROS TO DEFINE OFFSETS
;
	FDOF$L
	FCSBT$
	QIOSY$
	TCBDF$
	UCBDF$
;
	.LIST	ME
	HWDDF$
	HDRDEF
	QHDDEF
	MIDDEF
	.NLIST	ME
	.ASECT
.=0
;
; DATA BLOCK OFFSET DEFINITIONS
;
B.DAT:	.BLKB	506.	; DATA FOR MESSAGE
B.CNT:	.BLKW	1	; BYTE COUNT USED IN THIS BLOCK
B.NXT:	.BLKW	1	; POINTER TO NEXT BLOCK IN MESSAGE
B.MSG:	.BLKW	1	; POINTER TO NEXT MESSAGE THIS PRIORITY
.=0
	.PAGE
;
; CONSTANTS, EQUATES, ETC.
;
QUNAM="QU	; DEVICE NAME
QUUNIT=0	;  FIRST DEVICE UNIT NUMBER
		; FIRST IS FOR INPUT QUEUE, SECOND IS FOR OUTPUT QUEUE
ICO=1		; CONSOLE OUTPUT LUN
IQU=2		; DISK ASSIGNMENT LUN FOR QUEUE FILE
;
	.IF NDF, IE.PNT	; error code not available for M+ V2.1
	IE.PNT=-71
	.ENDC
;
; FOR CLAIRTY, WE WILL DEFINE OUR OWN DEFINITION
; OF THE MEMORY MANAGEMENT REGISTERS.  THE DEFAULT
; AS SUPPLIED WITH HDWDF$ DOES NOT REALLY POINT THERE
;
KDAPR6=172374	; KERNEL DATA PAGE ADDRESS REGISTER 6
UDAPR5=177672	; USER DATA PAGE ADDRESS REGISTER 5
UDPDR6=177634	; USER PAGE DESCRIPTOR REGISTER 6
;
; THE TASK USES FOUR EVENT FLAGS THAT ARE DEFINED BELOW
;
;
EFN4	=4	; EVENT FLAG FOR QUEUE DEVICE I/O SYNCRONATION
EFN5	=5	; EVENT FLAG FOR CONSOLE DEVICE I/P SYNCRONATION
EFN6	=6	; EVENT FLAG TO SYNCHRONIZE SST HANDLER AND PMD
EFN4M	=10	; EVENT FLAG FOUR MASK
EFN5M	=20	; EVENT FLAG FIVE MASK
;
; FILE DESCRIPTOR BLOCK FOR
; OUR QUEUE FILE
;
;
	.PSECT	$DATA,RW,CON,LCL,D
FDBADD:
	FDBDF$
	FDRC$A	FD.RWM
	FDOP$A	IQU,DATDES,DFNMBL,FO.MFY,FA.DLK	; MODIFY, NO LOCK IF ABORTED
	FDBK$A	QHD,512.,,3,DSKSTA
	FSRSZ$	0
;
; DATA SET DESCRIPTOR
;
	.PSECT	$DATA,RW,CON,LCL,D
DATDES:
	.WORD	DEVL	; LENGTH OF DEVICE DESCRIPTOR
	.WORD	DEV	; ADDR. OF DEVICE NAME
	.WORD	UICL	; LENGTH OF UIC DESCRIPTOR
	.WORD	UIC	; ADDR. OF UIC DESCRIPTOR
	.WORD	INQUEL	; LENGTH OF INPUT QUEUE FILENAME
	.WORD	INQUEN	; ADDR. OF INPUT QUEUE FILENAME
;
; DESCRIPTORS
;
DEV:
	.WORD	QUNAM	; NAME OF UNIT CONTAINING FILE
	.BYTE	QUUNIT+60	; ASCII UNIT
	.ASCII	/:/	
DEVL=.-DEV
;
	.INCLUDE /QUEACP1.MAC/
;
INQUEN:
	.ASCII	/MAQUEUE.DAT;/		; QUEUE FILE NAME
INQUEL=.-INQUEN
;
	.EVEN
;
; DEFAULT NAME BLOCK
;
DFNMBL:
	NMBLK$	X,DAT,1,SY,0
	.PSECT	$DATA,RW,CON,LCL,D
;
; FILE STATISTICS BLOCK
;
STBLK:
	.WORD	0	; HIGH LOGICAL BLOCK NO. (0= NON CONTIGIOUS)
	.WORD	0	; LOW LOGICAL BLOCK NO.
	.WORD	0	; SIZE HIGH
	.WORD	0	; SIZE LOW
	.WORD	0	; LOCK AND ACCESS COUNT
;
; DISK STATUS
;
DSKSTA:
	.BLKW	2	; DISK STATUS
	.PAGE
;
; SST TRAP VECTOR FOR "SVTK$S" MACRO CALL
;
SSTVEC:
	.WORD	ODDSST	; ODD ADDRESS OR NONEXISTENT MEMORY
	.WORD	MEMSST	; MEMORY PROTECT VIOLATION
	.WORD	TBTSST	; T-BIT TRAP OR EXECUTION OF A BPT INSTRUCTION
	.WORD	IOTSST	; EXECUTION OF AN IOT INSTRUCTION
	.WORD	RESSST	; EXECUTION OF A RESERVED INSTRUCTION
	.WORD	EMTSST	; EXECUTION OF A NON-RSX EMT INSTRUCTION
	.WORD	TRPSST	; EXECUTION OF A TRAP INSTRUCTION
	.WORD	FLTSST	; FLOATING POINT EXCEPTION
;
;
; DEFINE AND ALLOCATE THE SNAPSHOT CONTROL BLOCK
;
SNPSHT:
	SNPBK$	LB,0,SC.HDR!SC.LUN!SC.STK!SC.WRD!SC.BYT,EFN6,100.
;
;
; VALID FUNCTION TABLE AND TRANSFER ADDRESS
;
; SYMBOLIC  FUNCTION    DESCRIPTION
; FUNCTION    VALUE
; IO.KIL	0	CANCEL I/O
; IO.ATT	3	ATTACH DEVICE
; IO.DET	4	DETACH DEVICE
; IO.RNA       11	BACKUP RNA POINTER
; IO.ACR       13	CONNECT FOR READ FOR A MESSAGE ID
; IO.ACW       14 	ACKNOWLEGE LAST READ MESSAGE
; IO.ACE       15       READ THE QUEUE HEADER INFORMATION (SEE QUEDEF)
; IO.DAC       16       DEACCESS ALL MESSAGES ID's FOR THIS TASK
; IO.RVB       17       READ MESSAGE ID  FROM QUEUE
; IO.WVB       18       WRITE MESSAGE ID TO QUEUE
; IO.DEL       21	DELETE SPECIFIED NUMBER OF MESSAGES FROM QUEUE
; IO.RAT       22       STATUS MESSAGE ID LISTHEAD (SEE MIDDEF)
; IO.APC       24	REQUEST DISMOUNT/MOUNT
;
FUNCT:
	.WORD	IO.RVB/256.
	.WORD	IORVB
	.WORD	IO.WVB/256.
	.WORD	IOWVB
	.WORD	IO.RNA/256.
	.WORD	IORNA
	.WORD	IO.ACR/256.
	.WORD	IOACR
	.WORD	IO.ACW/256.
	.WORD	IOACW
	.WORD	IO.DEL/256.
	.WORD	IODEL
	.WORD	IO.RAT/256.
	.WORD	IORAT
	.WORD	IO.APC/256.
	.WORD	IOAPC
	.WORD	IO.ACE/256.
	.WORD	IOACE
	.WORD	IO.DAC/256.
	.WORD	IODAC
	.WORD	0		; TERMINATOR FOR VALID FUNCTIONS
;
; QUEUE HEADER BLOCK
;
QHD:		.BLKW	2048.	; I/O BUFFER 
TEMP:		.BLKW	3	; TEMP STORAGE USED DURING READS AND WRITES
;
STRBLK:		.WORD	0	; STARTING RELATIVE BLOCK OF QUEUE MESSAGE BLOCKS
BITMAP:		.WORD	0	; STARTING RELATIVE BLOCK OF BIT MAPS
INQLBN:		.WORD	0,0	; STARTING LBN OF QUEUE
INQLTH:		.WORD	0	; SIZE OF QUEUE IN BLOCKS
IOPKT:		.WORD	0	; I/O PACKET ADDRESS 
;
; BUFFER OF BLOCKS THAT ARE TO STORE A MESSAGE
;
BLKBUF:
	.BLKW	15.		; MAXIMUM NUMBER OF BLOCKS IS 15
;
IDNAM:
	.BLKB	16.		; MESSAGE ID LOOKING FOR
ZQUCB:
	.WORD	0		; UCB OF ZQ: DEVICE
RTWRT:
	.WORD	0		; FLAG USED TO INDICATE IF ROUTER IS WRITING
				;   TO QUEUE
	.PAGE
	.PSECT	$CODE,RO,I,CON,REL
;
; INITIALZATION
;
START:
	FINIT$			; INIT FILE SYSTEM
	MOV	#"99,ERRNUM	; ASCII ERROR NUMBER FOR MESSAGE (ON THE ERROR)
	CLR	ERRSTA		; NO STATUS TO LOG
	MOV	#"ST,ASCXTA	; STATUS = 'START'
	MOV	#"AR,ASCXTA+2
	MOV	#"T ,ASCXTA+4
	CALL	MESGA		; OUTPUT THE MESSAGE
	SREX$S	#ASTEXT		; SPECIFY ROUTINE TO DO CLEAN UP AFTER 
				;   ABORT ISSUED
	BCC	10$		; AST DIRECTIVE SUCCESSFUL
	MOVB	$DSW,R0		; SIGN EXTEND ERROR CODE
	MOV	R0,ERRSTA	; STORE STATUS
	MOV	#"16,ERRNUM	; STORE ERROR NUMBER
	CALL 	MESGW		; LOG STATUS
	EXIT$S		
10$:
	SVTK$S	#SSTVEC,#8.	; DEFINE SST VECTOR 
	BCC	ACPLUP		; SST DIRECTIVE SUCCESSFUL
	MOVB	$DSW,R0		; SIGN EXTEND ERROR CODE
	MOV	R0,ERRSTA	; STORE STATUS
	MOV	#"17,ERRNUM	; STORE ERROR NUMBER
	CALL 	MESGW		; LOG STATUS
	EXIT$S
;
; THIS IS THE MAIN ACP LOOP, WE MUST HANDLE ALL I/O PACKETS
; THAT COME IN VIA OUR RECEIVE DATA QUEUE (PACKETS FROM THE
; ZQ DEVICE DRIVER.
;
ACPLUP:
	MOV	$TKTCB,R0	; CURRENT TASK TCB ADDRESS (IE: US)
	ADD	#T.RCVL,R0	; POINT TO OUR RECEIVE DATA THREAD
	CLR	IOPKT		; I/O PACKET ADDRESS (SET TO NOT FOUND)
	SWSTK$	DSPFCN		; GO SWITCH STACK AND DISPOSE OF FUNCTION
;;******************************************************************************
	CALL	$QRMVF		;; ATTEMPT TO DEQUEUE A PACKET
	BCS	STPACP		;; NO PACKET, GO WAIT
	MOV	R1,IOPKT	;; PACKET, SAVE FOR USER STATE
	RETURN			;; RETURN TO USER STATE
;;
;; NO PACKET FOR US, GO INTO ACP WAIT STATE
;;
STPACP:
	CALL	$STPCT		;; STOP, WHEN RESUMED, R1= NEW PACKET
				;; NOTE, AST'S CAN STILL BE DELIVERED???
	MOV	R1,IOPKT	;; SAVE I/O PACKET ADDRESS
	RETURN			;; GO BACK TO USER STATE TO:  DSPFCN
;;******************************************************************************
	.PAGE
;
; DISPOSE OF THE FUNCTION
;   IOPKT= ADDRESS OF THE CURRENT I/O PACKET
;
;
DSPFCN:
	MOV	IOPKT,R3	; GET I/O PACKET ADDRESS
	BEQ	ACPLUP		; NO PACKET, GO GET ONE
	MOV	I.UCB(R3),R5	; UCB OF DEVICE
	MOV	U.VCB(R5),R2	; VCB (VOLUME CONTROL BLOCK)
	.IF DF,DEBUG
	MOV	I.FCN(R3),ERRSTA
	MOV	#"98,ERRNUM
	CALL 	MESG
	.ENDC
	MOVB	I.FCN+1(R3),R0	; GET FUNCTION CODE
	BIC	#177400,R0	; CEAR POSSIBLE SIGN EXTENSION
	CMPB	#IO.APC/256.,R0 ; IS IT MOUNT/DISMOUNT FUNCTION?
	BEQ	8$		 ; YES, THEN OK TO BE NOT MOUNTED OR
				; MARKED FOR DISMOUNT
	BITB	#US.MNT,U.STS(R5)	; IS DEVICE MOUNTED?
	BEQ	5$		; YES
	MOV	#IE.DUN,R0	; USE DEVICE NOT ATTACHABLE ERROR CODE
	BR 	RTNSTS		; GO RETURN STATUS
5$:
	BITB	#US.MDM,U.STS(R5) ; IS DEVICE MARKED FOR DISMOUNT?
	BEQ	8$		; NO, THEN OK
	MOV	#IE.DUN,R0	; YES, THEN DON'T ACCEPT ANY FUNCTION
	BR	RTNSTS		; UNTIL DISMOUNT COMPLETE
;
8$:
	MOV	#FUNCT,R3	; VALID FUNCTION TABLE ADDRESS
10$:
	TST	(R3)		; AT END OF TABLE?
	BEQ	30$		; YES, THEN INVALID FUNCTION 
	CMP	(R3)+,R0	; IS IT THIS FUNCTION
	BNE	20$		; NO, THEN CHECK NEXT
	JMP	@(R3)		; YES, THEN JUMP TO CORRECT CODE
20$:
	TST	(R3)+		; SKIP CODE ADDRESS
	BR	10$
;
; INVALID FUNCTION CODE
;
30$:
	MOV	#IE.IFC,R0	; ERROR CODE
;
; RETURN STATUS FOR CURRENT PACKET
; R0,R1= STATUS
; IOPKT= CURRENT I/O PACKET
;
RTNSTS:
	.IF DF,DEBUG
	MOV	R0,ERRSTA
	MOV	#"95,ERRNUM
	CALL	MESG
	.ENDC
	SWSTK$	ACPLUP		; RETURN INVALID FUNCTION CODE STATUS
;;******************************************************************************
	MOV	IOPKT,R3	;; CURRENT PACKET BEING PROCESSEED
	CALLR	$IOFIN		;; RETURN STATUS AND EXIT SYSTEM STATE
				;; BACK TO ACPLUP
;;******************************************************************************
	.PAGE
;
; FUNCTION IS MOUNT
;	1) OPEN THE FILE AND SAVE  THE STARTING LOGICAL BLOCK NUMBER
;	   OF THE QUEUE FILE (ALSO MAKE SURE THAT IT IS CONTIGOUS)
;
;	2) STORE ACP TCB ADDRESS IN UCB AND MARK UCB AS MOUNTED
;	3) CLEAR ANY CONNECTED TCB'S FOR MESSAGE ID'S
IOAPC:
	MOV	IOPKT,R3	; GET I/O PACKET ADDRESS AGAIN
	MOV	I.UCB(R3),ZQUCB ; SAVE UCB OF ZQ: DEVICE
	CMPB	#1,I.FCN(R3)	; IS THIS MOUNT OR DISMOUNT
	BEQ	90$		; IT'S MOUNT
	JMP	IODMO		; NOPE, ITS DISMOUNT
90$:
;
; OPEN FILE:  MAQUEUE.DAT
;
	MOV	#FDBADD,R0	; GET FDB ADDRESS
	MOV	#STBLK,F.STBK(R0)	; LOAD STATISTICS BLOCK ADDR.
	CLR	STBLK	; CLEAR UPPER LBN
	CLR	STBLK+2	; CLEAR LOWER LBN
	OPEN$M	R0	; OPEN EXISTING FILE FOR MODIFY
	BCS	2$	; FILE OPEN ERROR
;
; MAKE SURE FILE IS CONTIGIOUS
;
	TST	STBLK	; HIGH LBN NON-ZERO
	BNE	3$	; JUMP IF CONTIGIOUS
	TST	STBLK+2	; CHECK LOW LBN NON-ZERO
	BNE	3$	; JUMP IF CONTIGIOUS
;
; FILE IS NOT CONTIGIOUS
;
1$:
	MOV	#"01,ERRNUM	; ERROR NUMBER
7$:
	CLR	ERRSTA		; NO ERROR STATUS
	CALL	MESG		; OUTPUT A MESSAGE
	MOV	#IE.WAT,R0	; SYMBOLIC ERROR CODE
	JMP	RTNSTS		; GO RETURN THE STATUS
;
; FILE OPEN ERROR
;
2$:
	MOV	#"02,ERRNUM	; ERROR NUMBER
6$:
	MOVB	FDBADD+F.ERR,R1	; SIGN EXTEND ERROR
	MOV	R1,ERRSTA	; SAVE ERROR STATUS
	CALL 	MESG	; OUTPUT ERROR MESSAGE
	MOV	R1,R0	; RETURN STATUS CODE
	JMP	RTNSTS	; RETURN ACTUAL REASON TO CALLER
;
; FILE WAS CONTIGIOUS
; SAVE STARTING LOGICAL BLOCK NUMBER OF FILE 
; AND THE FILE ID AND SEQUENCE NUMBER.
;
3$:
	MOV	STBLK,INQLBN	; SAVE UPPER STARTING LBN
	MOV	STBLK+2,INQLBN+2	; SAVE LOWER STARTING LBN
	MOV	STBLK+6,INQLTH	; SAVE TOTAL LENGTH OF FILE
;
; CLOSE FILE.  ALL FILE I/O IS LOGICAL BLOCK I/O -- THE FILE SYSTEM IS BYPASSED
;
	MOV	#FDBADD,R0	; GET FDB ADDRESS
	CLOSE$	R0		; CLOSE FILE
	BCC	4$		; CLOSE OK
	MOVB	F.ERR(R0),R0	; CLOSE STATUS ERROR
	MOV	R0,ERRSTA
	MOV	#"10,ERRNUM
	CALL	MESG		; LOG ERROR
	MOV	#IE.CLO,R0	;ERROR CODE
	JMP	RTNSTS
	.PAGE
;
; READ THE QUEUE HEADER BLOCK AND FIND OUT HOW MANY
; MESSAGE ID'S WERE DEFINED, HOW MANY DISK BLOCKS WERE
; ALLOCATED.  THEN CRATE A DYNAMIC REGION  MAPPED BY APR6
; TO THE SIZE NEEDED TO STORE THE BIT MAPS, AND THE MESSAGE
; ID LIST HEADS.   
; 
; LHDSIZE= NUMBER OF MESSAGE IDS/LHD SIZE ; NUMBER OF MESG. ID LIST HEAD BLOCKS
; BITSIZE= INQLTH-1-LHDSIZE	; # OF BLOCKS FOR MESSAGES LESS HEADER BLOCK
; BITSIZE= (BITSIZE+4095)/4096  ; NUMBER OF BIT MAP BLOCKS
;
; REGION SIZE= LHDSIZE+BITSIZE
;
4$:
	MOV	#IO.RLB,QUQIO+Q.IOFN	; FUNCTION CODE IS READ
	MOV	#QHD,QUQIO+Q.IOPL		; READ INTO QHD FROM START
	MOV	INQLBN+2,QUQIO+Q.IOPL+10	; LOW LBN OF READ
	MOV	INQLBN,QUQIO+Q.IOPL+6		; HIGH LBN OF READ 
	DIR$	#QUQIO				; READ THE BLOCK
	BCC	5$				; DIRECTIVE OK?
	MOV	#"18,ERRNUM			; ERROR NUMBER
	MOVB	$DSW,R1				; SIGN EXTEND ERROR CODE
	MOV	R1,ERRSTA			; STATUS
	CALL	MESG
	MOV	#IE.NBF,R0			; DUMMY ERROR STATUS
	JMP	RTNSTS				; GO TELL MOU THE BAD NEWS
5$:
	CMPB	#IS.SUC,QUSTAT			; READ SUCCESSFUL?
	BEQ	8$				; YES
	MOV	#"19,ERRNUM			; ERROR NUMBER
	MOVB	QUSTAT,R1			; EXTEND ERROR CODE
	MOV	R1,ERRSTA			; STATUS
	CALL 	MESG				; LOG THE ERROR
	MOV	#IE.RCN,R0			; DUMMY ERROR STATUS
	JMP	RTNSTS				; GO TELL MOU THE BAD NEWS
;
; NOW CALCULATE THE SIZE OF THE REGION FROM INFORMATION IN THE HEADER BLOCK
;
8$:
	MOV	#QHD,R3		; START OF LIST HEAD BLOCK
	MOV	Q.IDC(R3),R1	; GET NUMBER OF MESSAGE ID'S ALLOCATED
	MUL	#M.LEN,R1	; MULT. BY SIZE OF MESSAGE ID LIST HEAD
	ADD	#Q.KSIZ,R1	; ADD SIZE OF THE HEADER OF THE QUEUE
	MOV	R1,BITMAP	; SAVE START OF THE BIT MAP
	MOV	Q.SIZ(R3),R1	; GET NUMBER OF BLOCKS
	ADD	#15.,R1		; ROUND TO WORD BOUNDRY
	ASH	#-4,R1		; CHANGE TO NUMBER OF WORDS (16 BITS/WORD)
	ASL	R1		; CHANGE TO WORD OFFSET
	ADD	BITMAP,R1	; ADD OFFSET TO BITMAPS (R1= START OF MESSAGE
					; BLOCKS
	BIS	#140000,BITMAP	; BIT MAP WILL BE USED VIA APR6 MAPPING
	ADD	#777,R1		; ROUND UP TO A BLOCK 
	ASH	#-9.,R1		; GET NUMBER OF BLOCKS
	MOV	R1,STRBLK	; SAVE STARTING BLOCK OF QUEUE (THE MESSAGE
				; BLOCKS MUST START ON BLOCK BOUNDRY)
	ASH	#3,R1		; GET NUMBER OF 32 WORD BLOCKS (8 PER BLOCK)
	CMP	#16.*8.,R1	; IS IT OVER 4K WORDS? 16 DISK BLOCKS?
	BPL	15$		; NO, THEN OK
	MOV	#"07,ERRNUM	; ERROR NUMBER
	MOV	R1,ERRSTA	; VALUE TO BE ENCODED
	CALL	MESG		; LOG THE ERROR 
	MOV	#IE.NBK,R0	; ERROR CODE
	JMP	RTNSTS		; TELL MOUNT THE BAD NEWS
15$:
	MOV	R1,WDB+W.NSIZ	; SIZE OF WINDOW
	MOV	R1,WDB+W.NLEN	; AMOUNT TO MAP
	MOV	R1,RDB+R.GSIZ	; SIZE OF REGION
	DIR$	#CRREG		; CREATE THE REGION
	BCC	10$		; CREATE OK?
	MOV	#"04,ERRNUM	; ERORR NUMBER, FOR OUTPUT MESSAGE
	MOVB	$DSW,R0		; SIGN EXTEND THE ERROR CODE
	MOV	R0,ERRSTA	; ERROR STATUS
	CALL	MESG		; LOG THE MESSAGE
	JMP 	RTNSTS		; RETURN THE ERROR CODE TO MOU
10$:
	MOV	RDB+R.GID,WDB+W.NRID ; COPY REGION ID
	DIR$	#CRWND		; CREATE THE WINDOW
	BCC	20$		; EVERYTHING OK?
	MOV	#"05,ERRNUM	; ERROR NUMBER FOR OUTPUT MESSAGE
	MOVB	$DSW,R0		; SIGN EXTEND THE ERROR CODE
	MOV	R0,ERRSTA	; DIRECTIVE STATUS
	CALL 	MESG		; LOG ERROR
	JMP	RTNSTS		; RETURN STATUS TO MOU	
20$:
	MOV	#"06,ERRNUM	; LOG SUCCESSFUL STATUS
	MOV	RDB+R.GSIZ,ERRSTA	; STATUS TO BE ENCODED
	CALL	MESG		; LOG ERROR
	.PAGE
;
; READ THE HEADER OF THE QUEUE INTO THE CREATED REGION
;
	MOV	STRBLK,R3	; GET NUMBER OF BLOCKS
	ASH	#9.,R3		; CHANGE TO BYTE COUNT
	MOV	R3,HEDQIO+Q.IOPL+2	; STORE FOR HEADER CHECKPOINT QIO
	MOV	#IO.RLB,HEDQIO+Q.IOFN	; READ THIS TIME ONLY.
	MOV	WDB+W.NBAS,HEDQIO+Q.IOPL ; V. A. OF CREATED REGION AS BUFFER 
	MOV	INQLBN+2,HEDQIO+Q.IOPL+10	; QUEUE START LBN LOWER
	MOV	INQLBN,HEDQIO+Q.IOPL+6	; QUEUE START LBN UPPER
	DIR$	#HEDQIO		; READ THE HEADER
	BCC	40$		; DIRECTIVE ACCEPTED
	MOV	#"08,ERRNUM	; ERROR NUMBER
	MOVB	$DSW,R0		; SIGN EXTEND THE ERROR
	MOV	R0,ERRSTA	; STORE FOR OUTPUT
	CALL 	MESG
	MOV	#IE.CKS,R0	; ERROR STATUS
	JMP	RTNSTS		; TELL CALLER THE BAD NEW
40$:
	MOVB	QUSTAT,R1	; GET ERROR CODE (SIGN EXTEND TOO)
	CMPB	#IS.SUC,R1	; WAS IT OK?
	BEQ	50$		; YES
	MOV	R1,ERRSTA	; NO, STORE STATUS FOR LOG
	MOV	#"09,ERRNUM
	CALL	MESG
	MOV	#IE.CKS,R0
	JMP	RTNSTS		; TELL CALLER BAD NEWS
50$:
	MOV	#IO.WLB,HEDQIO+Q.IOFN	; CHANGE FUNCTION CODE TO WRITE 
	.PAGE
;
; NOW CLEAR ALL CONNECTED MESSAGE ID'S FROM POSSIBLE PREVIOUS
; CONECTION.
;
	MOV	@#140000+Q.IDC,R1	; NUMBER OF MESAGE ID'S
	MOV	#140000+Q.KSIZ,R0	; POINT TO FIRST MESSAG ID LHD.
60$:
	CLR	M.TCB(R0)		; CLEAR CONNECTED TCB
	CLR	M.R50(R0)		; CLEAR CONNECTED TASK NAME
	CLR	M.R50+2(R0)		; SAME
	ADD	#M.LEN,R0		; POINT TO NEXT LIST HEAD
	SOB	R1,60$			; LOOP UNTIL ALL HAVE BEEN DONE
;
	MOV	$TKTCB,U.ACP(R5)	; STORE OUR TCB ADDRESS IN UCB
	BICB	#US.MNT,U.STS(R5)	; SET DEVICE AS MOUNTED
	MOV	#IS.SUC,R0	; GOOD STATUS
	.IF DF,DEBUG
	MOV	#"97,ERRNUM
	MOV	INQLTH,ERRSTA
	CALL 	MESG
	.ENDC
	JMP	RTNSTS		; GO RETURN THE STATUS
	.PAGE
;
; FUNCTION IS DISMOUNT
;
; CLOSE THE FILE, COMPACT OURSELVES GETTING RID OF
; OUR SCRATCH AREA, AND LOG A MESSAGE. 
;
IODMO:
	CMPB	#2,I.FCN(R3)	; IS THIS A DISMOUNT COMMAND
	BEQ	10$		; YES
	MOV	#IE.IFC,R0	; ILLEGAL FUNCTION CODE
	JMP	RTNSTS		; GO RETURN STATUS
10$:
	DTRG$S	#RDB	; DETACH FROM THE REQION (SHOULD GO AWAY TOO)
	BCC	25$	; GOOD DETACH
	MOV	#"14,ERRNUM	; ERROR NUMBER
	MOVB	$DSW,R0	; SIGN EXTEND DIRECTIVE STATUS
	MOV	R0,ERRSTA	; STORE FOR ENCODE
	CALL	MESG	; THIS IS NOT FATAL HOWEVER
;
; CLEAR MOUNT/DISMOUNT BITS IN UCB
;
25$:
	SWSTK$	30$
;;---------------------------------------------------------------------------
	MOV	IOPKT,R3	;; GET I/O PACKET
	MOV	I.UCB(R3),R5	;; GET UCB OF ZQ: DEVICE
	BICB	#US.MDM,U.STS(R5) ;; CLEAR MARKED FOR DISMOUNT
	BISB	#US.MNT,U.STS(R5) ;; SET DISMOUNT COMPLETE
	RETURN			;;
;;---------------------------------------------------------------------------
30$:
	MOVB	#IS.SUC,R0
	JMP	RTNSTS	; ALL DONE
	.PAGE
;
; FUNCTION IS WRITE VIRTUAL BLOCK
;
; IO.PRM,IO.PRM+2- User buffer double word address.  The
; structure of buffer is the message header (see HDRDEF followed
; by the user buffer.
; IO.PRM+4- Byte count of above buffer.
; IO.PRM+6,IO.PRM+10- Message id buffer double word address
; IO.PRM+12- Type (0= delete oldest, 1= donot delete oldest)
;
IOWVB:
	MOV	IOPKT,R5	; I/O PACKET ADDRESS
	MOV	I.PRM+4(R5),R1	; GET SIZE OF USER BUFFER
	CLR	R0		; CLEAR UPPER DIVIDEND
	ADD	#505.+H.SIZ,R1	; ROUND UP
	DIV	#506.,R0	; DIVIDE BY BYTES PER BLOCK
	MOV	R0,R1		; SAVE NUMBER OF BLOCKS NEEDED
	CMP	#8.,R1		; MAXIMUM NUMBER OF BLOCKS THAT CAN 
				;   BE WRITTEN (4096 BYTES), LARGEST
				;   USER MESSAGE IS 4014 BYTES
	BPL	5$		; NO, ITS IN RANGE
	MOV	#IE.RBG,R0	; ERROR CODE
	JMP	RTNSTS		; GO RETURN STATUS
;
; FIND THE MESSAGE ID
;
5$:
	MOV	R5,R0		; COPY I/O PKT ADDR
	ADD	#I.PRM+6,R0	; POINT TO THE MESSAGE ID
	CALL	FINDID		; FIND THE ID
	BCC	10$		; FOUND HIM
;
; RETURN STATUS TO CALLER, CAN'T FIND MESSAGE ID
;
	MOV	#IE.UKN,R0	; ERROR STATUS
	JMP	RTNSTS		; GO RETURN THE BAD STATUS
;
; ID FOUND, R0= ADDRESS OF THE LIST HEAD IN THE
; 		REGION HEADER (REGION HEADER IS MAPPED)
;	 IDNAM= MESSAGE ID THAT WAS COPIED FROM THE USER
;
10$:
	.IF DF,DEBUG & LOGPGM
	MOV	R0,DEBPTR 		; SAVE LISTHEAD PTR TO LOG DEBUG MSG
	.ENDC
	CMP	M.CNT(R0),M.MAX(R0)	; DO WE HAVE ANY ROOM THIS ID
	BMI	20$			; YES
;
; NO ROOM LEFT, SEE IF WE CAN DELETE ANY TYPE ZER0 MESSAGES
;
15$:
	CALL	DLTYP0		; GO DELETE OLDEST TYPE ZERO MESSAGE IF ONE
				;    EXITST
	BCC	20$		; DELETED ONE, THERE MUST BE SOME ROOM NOW.
18$:
	MOV	#IE.NDR,R0	; NO ROOM LEFT STATUS
	CLR	R1
	JMP	RTNSTS
;
; SEE IF ROOM IN WHOLE QUEUE
;
20$:
	MOV	#140000,R2	; QUEUE LIST HEAD ADDRESS  (MAPPED START APR6)
	CMP	Q.FREE(R2),R1	; IS THERE ROOM IN THE WHOLE QUEUE?
	BMI	18$		; NOPE, TELL HIM NO ROOM
	SUB	R1,Q.FREE(R2)	; SUBTRACT OFF WHAT WE ARE GOING TO USE
	.PAGE
;
; FIND THE BLOCKS FOR THE MESSAGE
; SCAN BIT MAP FOR A WORD WITH FREE BLOCKS IN IT
;
	MOV	R0,-(SP)	; SAVE ADDRESS TO MESSAGE ID LISTHEAD
	MOV	R1,-(SP)	; SAVE NUMBER OF BLOCKS WE NEED
	MOV	#BLKBUF,R4	; ADDRESS OF BLOCK NUMBER LIST
	CLR	-(SP)		; BLOCK NUMBER
	MOV	BITMAP,R0	; GET ADDRESS OF BIT MAP
43$:
	CMP	#177777,(R0)	; ANY BITS NOT SET, IE: AVAILABLE
	BNE	44$	; YES, GO FIND OUT WHICH
	ADD	#16.,(SP)	; ADD 16 TO BIT POSITION
	TST	(R0)+	; NO, UP TO NEXT WORD IN THIS BIT MAP PAGE
	BR	43$	; CHECK NEXT WORD IN BIT MAP
;
; FOUND A WORD WITH SOME BLOCKS FREE IN THE WORD
;
44$:
	MOV	#16.,R2	; 16 BITS PER WORD
	MOV	(R0),R5	; GET BIT WORD
45$:
	ASR	R5	; SHIFT BIT INTO CARRY TO DETECT IF SET
	BCC	46$	; FOUND A FREE BLOCK
	INC	(SP)	; INCREMENT BIT POSITION IN BIT MAP
	SOB	R2,45$	; NOT FREE, GO FIND THE FREE ONE
;
; FOUND FREE BLOCK
; (SP)= BIT POSITION OF THE BIT WITHIN THE BIT ARRAY (0 TO  16367)
; R2= BIT POSITION IN BIT WORD AS A LOOP COUNTER
;
46$:
	SUB	#16.,R2	; CHANGE LOOP COUNTER TO BIT POSITION 
	NEG	R2	; DON'T WANT NEGATIVE BIT POSITION
	MOV	#1,R5	; SINGLE BIT MASK
	ASH	R2,R5	; SHIFT BIT MASK TO BIT WE WANT
	BIS	R5,(R0)	; MARK THE BLOCK AS USED, IE: SET THE BIT
	MOV	(SP),R5	; GET THE BIT POSITION IN BIT MAP
	INC	R5	; BLOCK NBRS FOR WRITE BEGIN WITH 1 NOT 0
	BIC	#17,(SP)	; CLEAR TO EVEN BIT WORD
	MOV	R5,(R4)+	; STORE IN BLOCK BUFFER
	SOB	R1,43$	; LOOP UNTIL GOT ALL THE BLOCKS TAKEN CARE OF
	TST	(SP)+	; POP BIT COUNTER
	.PAGE
;
; BLKBUF CONTAINS THE BLOCKS THAT WERE ALLOCATED FROM 
; THE QUEUE.  
;	0(SP)= NUMBER OF BLOCKS
;	4(SP)= ADDRESS OF MESSAGE ID LISTHEAD
;
	MOV	(SP)+,R3	; GET NUMBER OF BLOCKS
	MOV	(SP)+,R0	; GET MESSAGE ID LIST HEAD AGAIN
	TST	M.FLK(R0)	; ANYTHING IN THIS QUEUE?
	BEQ	59$		; NO
;
; LINK THIS AT THE END
;
	MOV	M.BLK(R0),R1	; GET BACKWARD POINTER TO END
	CALL	RPAGEI		; READ THE LAST BLOCK OF LAST MESSAGE
	MOV	BLKBUF,QHD+B.MSG	; LINK LAST TO NEW LAST
	CALL	WPAGEI		; WRITE LAST MESSAGE BACK TO DISK
59$:
	DEC	R3		; NORMALIZE
	ASL	R3		; MAKE WORD OFFSET
	MOV	BLKBUF(R3),M.BLK(R0) ; UPDATE NEW TAIL POINTER
	TST	M.FLK(R0)	; IS THIS THE ONLY MESSAGE?
	BNE	60$		; NO
	MOV	BLKBUF,M.FLK(R0) ; STORE FORWARD LINK TO FIRST IN QUEUE
60$:
	INC	M.CNT(R0)	; UPDATE NUMBER FOR THIS MESSAGES THIS ID
	MOV	IOPKT,R3	; GET I/O PACKET
	TST	I.PRM+12(R3)	; IS THIS A VOLATILE MESSAGE
	BNE	65$		; NO
	INC	M.NVC(R0)	; INCREMENT NUMBER OF VOLATILE MESSAGES 
65$:
	INC	M.QSEQ(R0)		; INCREMENT SEQUENCE NUMBER
	CMP	#9999.,M.QSEQ(R0)	; TIME TO WRAP YET?
	BPL	68$			; NO
	MOV	#1,M.QSEQ(R0)		; YES
;
; FILL HEADER FOR THE FIRST BLOCK OF THE MESSAGE
;
68$:
	MOV	#QHD,R5		; ADDRESS OF LOCAL MESSAGE BUFFER
	MOV	#-1,RTWRT		; ASSUME ROUTER WRITE
	CMP	#IO.WVB+1,I.FCN(R3)	; CHECK IF FUNCTION IS ROUTER WRITE
	BEQ	82$			; YES, DON'T ADD HEADER INFO
	CLR	RTWRT		; NOT ROUTER WRITE, CLEAR FLAG
	MOV	#H.OFQT,R1	; BYTE COUNT OF SOURCE/DEST NODE NAMES
70$:
	MOVB	#' ,(R5)+	; BLANK OUT SENDER AND
	SOB	R1,70$		; RECEIVER NODE NAMES
;
	CLR	(R5)+		; CLEAR OFF QUEUE TIME
	CLR	(R5)+		;     "
	CLR	(R5)+		;     "
	CLR	(R5)+		;     "
	MOV	I.PRM+12(R3),(R5)+	; STORE THE TYPE OF THE MESSAGE
	MOV	R0,-(SP)		; SAVE R0
	CALL	VAXQAD			; STORE VAX ON QUEUE TIME
	MOV	(SP)+,R0		; RESTORE R0
	ADD	#H.LEN-H.ONQT,R5	; POINT TO NEXT FIELD
	MOV	I.PRM+4(R3),(R5)+	; BYTE COUNT OF USER MESSAGE
	MOV	M.QSEQ(R0),(R5)+	; ON QUEUE SEQUENCE NUMBER
	.PAGE
;
; LOAD REGISTERS FOR $BLXIO AND TRANSFER USER MESSAGE TO LOCAL BUFFER
; USING $BLXIO
; 
82$:
	MOV	R0,-(SP)	; SAVE R0 IN CASE HAVE TO BID TASK
	MOV	I.PRM+4(R3),R0	; NUMBER OF BYTES IN USER MESSAGE
	ADD	#I.PRM,R3	; POINT TO BUFFER ADDR. DOUBLE WORD
	MOV	(R3),R1		; SOURCE BIAS
	MOV	2(R3),R2	; SOURCE DISPLACEMENT
	BIC	#160000,R2	; CLEAR APR BITS
	BIS	#120000,R2	; SET APR 5 BITS
	MOV	@#UDAPR5,R3	; DESTINATION BIAS
	MOV	R5,R4		; DESTINATION DISPLACEMENT
	BIC	#160000,R4	; CLEAR APR BITS
	BIS	#140000,R4	; SET APR 6 BITS
	SWSTK$	85$		; SWITCH TO SYSTEM STATE TO COPY
				;   USER MESSAGE INTO LOCAL BUFFER
				;   RETURN TO USER STATE AT 85$
;;*************************************************************************
;; THE USER MESSAGE IS MOVED FROM THE USER BUFFER TO THE QUEACP LOCAL
;; BUFFER IN SYSTEM STATE SO THAT NO CONTEXT CHANGE CAN TAKE PLACE AFTER
;; THE USER BUFFER HAS BEEN MAPPED AND BEFORE ALL OF THE MESSAGE HAS BEEN
;; TRANSFERRED INTO THE USER BUFFER.

	CALL	$BLXIO		;; MOVE USER MESSAGE INTO LOCAL BUFFER
	RETURN			;; RETURN TO USER STATE
;;*************************************************************************
;
; ENTIRE USER MESSAGE IN THE LOCAL BUFFER 'QHD'.
; WRITE THE MESSAGE TO DISK IN BLOCKS (512. BYTES AT A TIME)
;
85$:
	TST	RTWRT		; WAS THIS A ROUTER WRITE?
	BMI	87$		; YES, DON'T ADD HEADER SIZE 
	ADD	#H.SIZ,R0	; TOTAL MSG INCLUDING HEADER
87$:
	MOV	#BLKBUF,R4	; LIST OF BLOCKS
	MOV	#QHD,R5		; MESSAGE TO WRITE TO FILE
90$:
	MOV	R5,-(SP)	; SAVE START ADDRESS OF PART OF MSG
				;   TO BE WRITTEN TO DISK
	SUB	#506.,R0	; SUBTRACT FROM TOTAL MESSAGE SIZE
	BGT	95$		; WAS A FULL BLOCK
	ADD	#506.,R0	; NOT A FULL BLOCK, RESTORE REMAINDER
	BR	100$		; WRITE REMAINDER TO DISK
95$:		
	ADD	#506.,R5	; POINT TO POINTER LOCATIONS IN A BLOCK
	MOV	(R5),TEMP	; SAVE THESE 2 BYTES OF MESSAGE
	MOV	#506.,(R5)+	; STORE BYTE COUNT THIS BLOCK
	MOV	(R5),TEMP+2	; SAVE THESE 2 BYTES OF MESSAGE
	MOV	2(R4),(R5)+	; STORE LINK TO NEXT BLOCK IN MESSAGE
	MOV	(R5),TEMP+4	; SAVE THESE 2 BYTES OF MESSAGE
	CLR	(R5)		; NOT ENDING BLOCK OF MESSAGE
	MOV	(SP)+,QUQIO+Q.IOPL	; LOAD START ADDR OF PART OF MSG
					;   TO WRITE 
	MOV	(R4),R1		; BLOCK TO WRITE
	CALL	WBLOCK		; WRITE THE BLOCK
	TST	(R4)+		; POINT TO NEXT BLOCK
	MOV	TEMP+4,(R5)	; RESTORE THE 6 BYTES OF MESSAGE SAVED
	MOV	TEMP+2,-(R5)	
	MOV	TEMP,-(R5)
	BR	90$		; NEXT BLOCK	
;
; ALL DONE, WE NEED TO WRITE THE LAST BLOCK OF MESSAGE AND UPDATE
; THE LIST HEAD
;
100$:
	ADD	#506.,R5	; POINT TO POINTER LOCATIONS IN A BLOCK
	MOV	R0,(R5)+	; STORE BYTE COUNT THIS BLOCK
	CLR	(R5)+		; NO NEXT BLOCK IN THIS MESSAGE
	CLR	(R5)		; LAST MESSAGE IN THIS ID QUEUE
	MOV	(SP)+,QUQIO+Q.IOPL	; LOAD START ADDR OF PART OF MSG
					;   TO WRITE 
	MOV	(R4),R1		; BLOCK TO WRITE
	CALL	WBLOCK		; WRITE THE BLOCK
	CALL 	WRTHED		; WRITE THE REGION HEADER, BIT MAP, LISTHEAD
				; BACK TO DISK.
	MOV	(SP)+,R1	; GET SAVED MESSAGE ID INDEX
	TST	M.R50(R1)	; IS THERE A TASK CONNECTED
	BEQ	120$		; NO, THEN NOONE TO BID
;;--------------------------------------------------------------------------
	SWSTK$	120$		;; GO TO SYSTEM STATE
	MOV	M.TCB(R1),R5	;; GET TCB OF CONNECTED TASK
	BEQ	110$		;; SHOULDN'T BE ZERO BUT....
	CMP	T.NAM(R5),M.R50(R1)
	BNE	110$		;; NOT THE SAME ANY MORE
	CMP	T.NAM+2(R5),M.R50+2(R1)
	BNE	110$		;; NOT THE SAME ANY MORE
	MOV	M.EFN(R1),R0	;; EVENT FLAG TO SET
	CALL	$SETF		;; SET THE USER'S EVENT FLAG (RET WITH R0=TCB)
	BIT	#TS.EXE,T.STAT(R0)	;; IS USER ACTIVE
	BNE	105$			;; YES, NO NEED TO BID HIM
	CALL	$TSKRT		;; BID TASK WITH DEFAULT UCB
105$:
	RETURN
110$:
	CLR	M.R50(R1)	;; TASK NO LONGER IN SYSTEM
	CLR	M.R50+2(R1)	;; CLEAR NAME
	CLR	M.TCB(R1)	;; CLEAR TCB
	RETURN
;;---------------------------------------------------------------------------
120$:
	MOV	#IS.SUC,R0	; GOOD STATUS
	.IF DF,DEBUG & LOGPGM
	MOV	R0,ERRSTA
	MOV	#"93,ERRNUM
	CALL	MESG
	.ENDC
	JMP	RTNSTS		; GO TELL THE USER THE GOOD NEWS
	.PAGE
;
; FUNCTION IS READ VIRTUAL BLOCK
; 
; .le;IO.PRM,IO.PRM+2- User buffer double word address.   The
; structure of buffer is the message header (see HDRDEF followed
; by the user buffer.
; .le;IO.PRM+4- Byte count of above buffer.
; .le;IO.PRM+6,IO.PRM+10- Message id buffer double word address
; 
IORVB:
	MOV	IOPKT,R5	; I/O PACKET ADDRESS
	MOV	R5,R0		; COPY I/O PACKET
	ADD	#I.PRM+6,R0	; POINT TO MESSAGE ID POINTER
	CALL	FINDID		; SEE IF WE KNOW OF THIS ID
	BCC	10$		; FOUND THE ID
	MOV	#IE.UKN,R0	; RETURN ERROR STATUS
	JMP	RTNSTS		; GO TO I/O DONE
;
; FOUND THE MESSAGE ID AND THE MESSAGE ID LIST HEAD IS POINTED TO BY R0
; IDNAM= THE MESSAGE ID FROM THE USER
;
10$:
	.IF DF,DEBUG & LOGPGM
	MOV	R0,DEBPTR	; SAVE LISTHEAD PTR TO LOG DEBUG MSG
	.ENDC
	TST	M.RNA(R0)	; IS THERE A READ BUT NOT ACKNOWLEGED MESSAGE
	BEQ	12$		; NO, THEN OK TO READ
	MOV	#IE.FOP,R0	; ERROR STATUS, USER MUST ACKNOWLEGE OTHER
	JMP	RTNSTS		; ONE FIRST.
12$:
	TST	M.R50(R0)	; IS SOMEONE CONNECTED FOR READ?
	BNE	13$		; YES, MAKE SURE IT IS THIS GUY
	MOV	#IE.NLK,R0	; MUST CONNECT BEFORE YOU CAN READ
	JMP	RTNSTS
13$:
	CMP	I.TCB(R5),M.TCB(R0)	; IS THIS THE ONE THAT'S CONNECTED?
	BEQ	15$			; YES
	MOV	#IE.NST,R0		; SOMEONE ELSE IS CONNECTED
	JMP	RTNSTS			; HE CAN'T READ THEN
15$:
	TST	M.CNT(R0)	; ANY MESSAGE IN THE QUEUE
	BNE	20$		; YES
	MOV	#IE.EOF,R0 	; NO, RETURN STATUS CODE
	JMP	RTNSTS		; GO DO I/O DONE
;
20$:
	MOV	M.FLK(R0),R1	; GET FORWARD LINK TO FIRST BLOCK OF MESSAGE
	MOV	R1,M.BNA(R0)	; IN CASE ONLY ONE BLOCK, SAVE LAST BLOCK PTR.
	CALL	RPAGEI		; READ THE BLOCK INTO QHD
;
; SEE IF ENOUGH ROOM IN USER BUFFER FOR THE MESSAGE
;
	MOV	R0,-(SP)	; SAVE ADDRESS OF MESSAGE ID LISTHEAD
	MOV	QHD+H.LEN,R0	; SIZE OF DATA PART OF MESSAGE
	ADD	#H.SIZ,R0	; ADD SIZE OF HEADER
	MOV	IOPKT,R3	; GET IOPACKET
	CMP	I.PRM+4(R3),R0	; WILL THE MESSAGE FIT IN USER BUFFER
	BPL	30$		; IT SHOULD
	MOV	(SP)+,R0	; RESTORE MSG ID LISTHEAD ADDRESS
	CLR	M.BNA(R0)	; CLEAR RNA POINTER SET ABOVE
	MOV	#IE.DAO,R0	; SET ERROR CODE (USER BUFFER TOO SMALL)
	JMP	RTNSTS		; GO RETURN THE STATUS
	.PAGE
30$:
;
; FILL IN THE OFF QUEUE TIME
;
	MOV	#QHD+H.OFQT,R5	; ADDRESS FOR FIRST WORD OF TIME
	MOV	R0,-(SP)	; SAVE R0
	CALL	VAXQAD		; STORE VAX OFF QUEUE TIME
	MOV	(SP)+,R0	; RESTORE R0
;
; READ BLOCKS OF MESSAGE UNTIL POINTER TO NEXT BLOCK IN MESSAGE IS ZERO
;
	MOV	#QHD,R4		; START ADDRESS OF LOCAL BUFFER
	CLR	R5		; WILL HOLD LAST BLOCK READ IN MESSAGE
40$:
	ADD	#508.,R4	; POINT TO NEXT BLOCK THIS MSG POINTER
	MOV	(R4),R1		; GET NEXT BLOCK IN MESSAGE
	BEQ	60$		; AT END
	MOV	R1,R5		; SAVE POSSIBLE LAST BLOCK POINTER	
	TST	-(R4)		; START ADDRESS IN LOCAL BUFFER THAT NEXT 
				;   BLOCK OF MESSAGE WILL BE READ INTO
	MOV	R4,QUQIO+Q.IOPL	; LOAD ADDRESS INTO QIO
	CALL	RBLOCK		; READ THE BLOCK
	BR	40$		; NEXT BLOCK

;
; LOAD REGISTERS FOR $BLXIO AND TRANSFER LOCAL BUFFER TO USER BUFFER
; USING $BLXIO (R0 ALREADY CONTAINS TOTAL BYTE COUNT OF MESG)
; 
60$:
	TST	(R4)+		; POINT TO FIRST BLOCK OF NEXT MSG POINTER
	MOV	R4,-(SP)	; SAVE POINTER TO POINTER
	MOV	@#UDAPR5,R1	; SOURCE BIAS
	MOV	#QHD,R2		; SOURCE DISPLACEMENT
	ADD	#I.PRM,R3	; POINT TO BUFFER ADDR. DOUBLE WORD
	MOV	2(R3),R4	; DESTINATION DISPLACEMENT
	MOV	(R3),R3		; DESTINATION BIAS
	SWSTK$	70$		; SWITCH TO SYSTEM STATE TO COPY
				;   USER MESSAGE INTO LOCAL BUFFER
				;   RETURN TO USER STATE AT 70$
;;*************************************************************************
;; THE USER MESSAGE IS MOVED FROM THE QUEACP LOCAL BUFFER TO THE USER'S
;; BUFFER IN SYSTEM STATE SO THAT NO CONTEXT CHANGE CAN TAKE PLACE AFTER
;; THE USER BUFFER HAS BEEN MAPPED AND BEFORE ALL OF THE MESSAGE HAS BEEN
;; TRANSFERRED INTO THE USER BUFFER.

	CALL	$BLXIO		;; MOVE LOCAL BUFFER INTO USER MESSAGE BUFFER
	RETURN			;; RETURN TO USER STATE
;;*************************************************************************
;
; ALL DONE MOVING THE MESSAGE TO USER'S BUFFER
;
70$:
	MOV	(SP)+,R4	; RESTORE POINTER TO FIRST BLOCK OF 
				;   NEXT MSG POINTER
	MOV	(SP)+,R0	; RESTORE MESSAGE ID LISTHEAD
	MOV	M.FLK(R0),M.RNA(R0)	; READ BUT NOT ACKNOWLEGED POINTER
	TST	R5			; IF R5 ZERO, MSG CONTAINED ONLY ONE
	BEQ	75$			;   BLOCK SO M.BNA ALREADY UPDATED
	MOV	R5,M.BNA(R0)		; READ NOT ACK LAST BLOCK POINTER
75$:
	MOV	(R4),M.FLK(R0)		; NEW POINTER TO NEW HEAD OF QUEUE
	BNE	80$			; MORE MSGS IN QUEUE
	MOV	(R4),M.BLK(R0)		; NO MORE MSGS IN QUEUE, ZERO POINTER
					;   TO LAST BLOCK ALSO
80$:
	MOV	M.RNA(R0),R1		; RAN POINTER FOR CALLER
	MOV	#IS.SUC,R0		; SUCCESS CODE
	.IF DF,DEBUG & LOGPGM
	MOV	R0,ERRSTA
	MOV	#"93,ERRNUM
	CALL	MESG
	.ENDC
	JMP	RTNSTS			; ALL DONE
	.PAGE
;
; FUNCTION IS RETURN MESSAGE ID LIST HEAD STATUS
; 	TO DO THIS, WE MUST FIRST TRANSFER THE DATA FROM OUR
; REGION TO A TEMP BUFFER (SINCE BOTH USER BUFFER AND OUR
; REGION ARE MAPPED WITH THE SAME APR), AND THEN TO THE USER BUFFER.
;
; .le;IO.PRM-IO.PRM+2- Buffer to recieve status
; .le;IO.PRM+4- Byte count of buffer (see MIDDEF)
; .le;IO.PRM+6-IO.PRM+10- Message id buffer address
;
IORAT:
	MOV	IOPKT,R0		; GET I/O PACKET ADDRESS
	CMP	#M.LEN,I.PRM+4(R0)	; IS USER BUFFER LARGE ENOUGH
	BLE	10$			; YES
	MOV	#IE.DAO,R0		; NO, RETURN DATA OVERRUN
	JMP	RTNSTS			; GO RETURN THE STATUS
10$:
	ADD	#I.PRM+6,R0		; POINT TO MESSAGE ID 
	CALL	FINDID			; FIND THE ID REQUESTED
	BCC	15$			; FOUND THE ID
	MOV	#IE.UKN,R0		; RETURN ERROR STATUS
	JMP	RTNSTS			; GO TO I/O DONE
15$:
	MOV	#QHD,R2			; TEMP BUFFER
	MOV	#M.LEN,R1		; SIZE OF ID LIST HEAD
20$:
	MOVB	(R0)+,(R2)+		; COPY SO CAN THEN MAP USER
	SOB	R1,20$			; AND TRANSFER IT TO HIM
;
	MOV	IOPKT,R3		; GET I/O PACKET ADDRESS
	ADD	#I.PRM,R3		; SO CAN FIND USER BUFFER
	SWSTK$	40$			; SWITCH TO SYSTEM STATE TO COPY
					;   MSG ID HEADER INTO USER BUFFER
					;   RETURN TO USER STATE AT 40$
;;*************************************************************************
	CALL	MAPUSR			;; GET USER MAPPED VIA APR6
	MOV	#M.LEN,R1		;; SIZE OF ID LIST HEAD
	MOV	#QHD,R2			;; TEMP BUFFER COPIED BEFORE
30$:
	MOVB	(R2)+,(R0)+		;; COPY TO USER BUFFER FROM TEMP.
	SOB	R1,30$			;; LOOP UNTIL TRANSFERED
	RETURN				;; RETURN TO USER STATE
;;*************************************************************************
40$:
	MOV	#IS.SUC,R0
	MOV	#M.LEN,R1		; BYTE COUNT OF TRANSFER
	JMP	RTNSTS			; RETURN STATUS
	.PAGE
;
; FUNCTION IS RETURN QUEUE HEADER STATUS
;
; COPY THE HEADER INFORMATION TO LOCAL STORAGE (BECAUSE BOTH THE
; USER BUFFER AND OUR REGION ARE MAPPED WITH APR6) AND
; THEN TO THE USER'S BUFFER.
;
; .le;IO.PRM-IO.PRM+2- Buffer to recieve staus
; .le;IO.PRM+4- Byte count of buffer (see QHDDEF)
IOACE:
	MOV	IOPKT,R0		; GET I/O PACKET ADDRESS
	CMP	#Q.KSIZ,I.PRM+4(R0)	; IS USER BUFFER LARGE ENOUGH
	BLE	10$			; YES
	MOV	#IE.DAO,R0		; NO, RETURN DATA OVERRUN
	JMP	RTNSTS			; GO RETURN THE STATUS
10$:
	MOV	#140000,R0		; APR 6 MAPPING
	MOV	#QHD,R2			; TEMP BUFFER
	MOV	#Q.KSIZ,R1		; SIZE OF QUEUE HEADER
20$:
	MOVB	(R0)+,(R2)+		; COPY SO CAN THEN MAP USER
	SOB	R1,20$			; AND TRANSFER IT TO HIM
;
	MOV	IOPKT,R3		; GET I/O PACKET ADDRESS
	ADD	#I.PRM,R3		; SO CAN FIND USER BUFFER
	SWSTK$	40$			; SWITCH TO SYSTEM STATE TO COPY
					;   QUEUE HEADER INTO USER BUFFER
					;   RETURN TO USER STATE AT 40$
;;*************************************************************************
	CALL	MAPUSR			;; GET USER MAPPED VIA APR6
	MOV	#Q.KSIZ,R1		;; SIZE OF QUEUE HEADER
	MOV	#QHD,R2			;; TEMP BUFFER COPIED BEFORE
30$:
	MOVB	(R2)+,(R0)+		;; COPY TO USER BUFFER FROM TEMP.
	SOB	R1,30$			;; LOOP UNTIL TRANSFERED
	RETURN				;; RETURN TO USER STATE
;;*************************************************************************
40$:
	MOV	#IS.SUC,R0
	MOV	#Q.KSIZ,R1		; BYTE COUNT OF TRANSFER
	JMP	RTNSTS			; RETURN STATUS
	.PAGE
;
; FUNCTION IS CONNECT
;
;	FIND THE SPECIFIED ID, AND STORE THE USER'S TCB AND NAME
; IN THE HEADER.  MUST ALSO MAKE SURE THAT A QIO FOR THIS TASK
; IS PRESENT ON THE ZQ1: DEVICE TO HANDLE THE I/O RUNDOWN IN THE
; EVENT THE TASK EXITS.
; 
; .le;IO.PRM-IO.PRM+2 Message ID buffer.
; .le;IO.PRM+4- Size of message ID buffer (16)
; .le;IO.PRM+6- Event flag TO SET.
;
IOACR:
	MOV	IOPKT,R3	; USER I/O PACKET
60$:
	MOV	R3,R0		; COPY I/O PACKET ADDR
	ADD	#I.PRM,R0	; POINT TO THE MESSAGE ID ADDRESS DOUBLE WORD
	CALL	FINDID		; FIND THE ID
	BCC	70$		; FOUND IT?
	MOV	#IE.UKN,R0	; NO
	JMP	RTNSTS		; GO RETURN STATUS
70$:
	TST	M.R50(R0)	; IS SOMEONE ALREADY CONNECTED?
	BEQ	80$		; NO, THEN WE WILL LET THIS ONE CONNECT
	MOV	#IE.URJ,R0	; SORRY ONLY ONE ALLOWED TO CONNECT
	JMP	RTNSTS
80$:
	MOV	I.TCB(R3),R1	; GET TCB OF REQUESTING TASK
	MOV	T.NAM(R1),M.R50(R0) ; STORE NAME OF REQUESTER
	MOV	T.NAM+2(R1),M.R50+2(R0)
	MOV	R1,M.TCB(R0)	; STORE TCB ADDRESS
	MOV	I.PRM+6(R3),M.EFN(R0) ; STORE THE EVENT FLAG TO SET
	.PAGE
;
; IF THERE IS AN OUTSTANDING READ BUT NOT ACKNOWLEGED MESSAGE ID,
; THEN BACK IT OFF
;
	TST	M.RNA(R0)	; IS THERE AN RNA?
	BNE	IORNA		; YES, THEN GO BACK IT OFF
	MOV	#IS.SUC,R0	; NO, THEN WE IS ALL DONE
	JMP	RTNSTS		; 
	.PAGE
;
; FUNCTION DISCONNECT ALL MESSAGE ID'S FOR THIS TASK
;	The packet queued to us came from the device driver
; and is not really an I/O packet.  We therefore do the function
; and then release the packet to primary pool.
;	The I.TCB is the TCB address of the task that is exiting
; and I.PRM, I.PRM+2 is the task name of the exiting task.
;
IODAC:
	MOV	IOPKT,R3		; GET THE I/O PACKET
;
	.IF DF,DEBUG
	MOV	I.TCB(R3),ERRSTA
	MOV	#"96,ERRNUM
	CALL	MESG
	.ENDC
;
	MOV	@#140000+Q.IDC,R1	; GET NUMBER OF MESSAGE ID'S
	MOV	#140000+Q.KSIZ+M.TCB,R0	; POINT TO TCB ADDRESSES IN MESSAGE
					; ID LIST HEAD
	MOV	I.TCB(R3),R4		; GET TCB ADDRESS
10$:
	CMP	(R0),R4			; TCB'S MATCH?
	BNE	20$			; NO
	CLR	(R0)			; CLEAR TCB ADDRESS
	CLR	M.R50-M.TCB(R0)		; CLEAR RAD 50 TASK NAME
	CLR	M.R50+2-M.TCB(R0)	; CLEAR RAD 50 TASK NAME
20$:
	ADD	#M.LEN,R0		; POINT TO NEXT LIST HEAD
	SOB	R1,10$			; LOOP UNTIL ALL ARE DISCONECTED
					; FOR THIS TASK
	SWSTK$	ACPLUP			; CHANGE TO EXEC MODE TO DEALLOCATE
					; POOL BUFFER
					; RETURN TO ACPLUP
;;--------------------------------------------------- 
	MOV	R3,R0			;; COPY BUFFER ADDRESS
	MOV	#I.LGTH,R1		;; SIZE OF BUFFER
	CALL	$DEACB			;; DEALLOCATE IT
	RETURN
;;----------------------------------------------------
	
	.PAGE
;
; FUNCTION IS BACKUP RNA
;	Take the message pointed to by M.RNA and M.BNA and rethread
; it back into the message id queue.  It is possible that the
; thread from B.MSG in block B.BNA no longer points to a valid
; message as it could have been deleted.  Therefore we must rethread
; the message.  If this is the only message in the queue, the work
; is much simpler as M.FLK and M.BLK are set to the M.RNA and 
; M.BNA pointers.
;
; .le;I.PRM,I.PRM+2= Message id that is to have the current read
; but not acknowleged message id placed back onto the front of the
; queue.
; .le;I.PRM+4= 16 Size of message id
;
IORNA:
	MOV	IOPKT,R0	; GET THE I/O PACKET
	ADD	#I.PRM,R0	; POINT TO THE ADDRESS DOUBLE WORD FOR THE ID
	CALL	FINDID		; SEE IF WE KNOW OF IT
	BCC	10$		; FOUND IT?
	MOV	#IE.UKN,R0	; NO
	JMP	RTNSTS		; GO RETURN STATUS
10$:
	.IF DF,DEBUG & LOGPGM
	MOV	R0,DEBPTR	; SAVE LISTHEAD PTR TO LOG DEBUG MSG
	.ENDC
	TST	M.RNA(R0)	; DO WE HAVE AN OUTSTANDING RNA?
	BEQ	40$		; NO
	CMP	#1,M.CNT(R0)	; IS THE RNA THE ONLY MESSAGE IN THE QUEUE?
	BNE	20$		; NO, MORE THAN ONE
	MOV	M.BNA(R0),M.BLK(R0) ; YES THEN BACKWARD POINTER IS ALSO RNA LAST
	BR	30$		; HANDLE REST, NO NEED TO READ LAST BLOCK OR RNA
20$:
	MOV	M.BNA(R0),R1	; LAST BLOCK OF THE RNA MESSAGE (NEED TO 
				; 	UPDATE B.MSG TO POINT TO REST OF QUEUE)
	CALL	RPAGEI		; READ LAST BLOCK OF THE RNA MESSAGE
	MOV	M.FLK(R0),QHD+B.MSG  ; LINK RNA TO REST OF QUEUE
	CALL	WPAGEI		; WRITE NEWLY THREADED BLOCK BACK
30$:
	CLR	M.BNA(R0)	; CLEAR THE BACKWARD POINTER
	MOV	M.RNA(R0),M.FLK(R0) ; PUT IT BACK ONTO FRONT OF QUEUE
	CLR	M.RNA(R0)	; CLEAR RNA POINTER
	CALL	WRTHED
40$:
	MOV	#IS.SUC,R0
	.IF DF,DEBUG & LOGPGM
	MOV	R0,ERRSTA
	MOV	#"93,ERRNUM
	CALL	MESG
	.ENDC
	JMP	RTNSTS	
	.PAGE
;
; FUNCTION IS ACKNOWLEGE THE READ BUT NOT ACKNOWLEGED MESSAGE
;
; 	Take the M.RNA through M.BNA blocks of the message
; and restore them to the free list.  Then clear M.RNA and M.BNA
; and decrement the number of messages for this message id.
;
; .le;I.PRM-I.PRM+2 Message ID buffer.
; .le;I.PRM+4- Size of message ID buffer (16)
; .LE;I.PRM+6- Read not acknowleged identifier
;
IOACW:
	MOV	IOPKT,R3	; GET USER I/O PACKET
	MOV	R3,R0		; COPY SO CAN POINT TO ADDR. DOUBLE WORD
	ADD	#I.PRM,R0	; MESSAGE ID DOUBLE WORD
	CALL	FINDID		; SEE IF CAN FIND THE ID
	BCC	10$		; FOUND IT
	MOV	#IE.UKN,R0	; ERROR STATUS
	JMP	RTNSTS		; RETURN TO THE IDIOT, HE CAN'T FOOL ME
;
10$:
	.IF DF,DEBUG & LOGPGM
	MOV	R0,DEBPTR	; SAVE LISTHEAD PTR TO LOG DEBUG MSG
	.ENDC
	TST	M.RNA(R0)	; IS THERE A MESSAGE TO BE ACKNOWLEGED?
	BNE	20$		; NOPE, WHAT IS THIS GUY ACK HAPPY?
	MOV	#IE.PNT,R0	; TELL HIM TO GO SEE A DOCTOR
	JMP	RTNSTS
20$:
	CMP	I.PRM+6(R3),M.RNA(R0)	; IS USER ACK'ING CORRECT MESSAGE
	BEQ	30$			; YES, RNA'S MATCH
	MOV	#IE.SNC,R0		; ERROR CODE
	JMP	RTNSTS			; TOO BAD TURKEY, YOU IS LOST!
30$:
	CMP	M.NVL(R0),M.RNA(R0)	; DOES M.NVL POINT TO MSG BEING DELETED?
	BNE	35$			; NO, DON'T UPDATE M.NVL
	MOV	M.FLK(R0),M.NVL(R0) ; MAKE SURE LINK TO LAST SCAN FOR
				    ; VOLATILE MESSAGES DOSEN'T POINT TO ONE
				    ; THAT WE ARE DELETEING
	CLR	M.LST(R0)	; CLEAR LAST BLOCK BEFORE LAST SCAN POINTER
35$:
	MOV	#BLKBUF,R3	; BLOCK BUFFER STACK
	MOV	M.RNA(R0),R1	; FIRST BLOCK TO DELETE
	MOV	R1,(R3)+	; STORE IN OUR BLOCK LIST TO BE RETURNED
	CALL	RPAGEI		; READ THE FIRST PAGE
	TST	QHD+H.TYPE	; IS THIS A VOLATILE MESSAGE?
	BNE	40$		; NO, THEN JUST FIND THE BLOCKS IN THE MESSAGE
	DEC	M.NVC(R0)	; DECREMENT THE NUMBER OF VOLATILE MESSAGES
40$:
	MOV	QHD+B.NXT,R1	; IS THERE ANOTHER BLOCK IN THE MESSAGE?
	BEQ	45$		; NO, THEN RETURN BLOCKS TO FREE LIST
	MOV	R1,(R3)+	; STORE BLOCK NUMBER OF BLOCK IN MESSAGE
	CALL	RPAGEI		; READ BLOCK SO CAN GET FORWARD THREAD
	BR	40$		; GET NEXT BLOCK IN MESSAGE
	.PAGE
;
; BLKBUF CONTAINS ALL OF THE BLOCKS THAT NEED TO BE RETURNED
; TO THE FREE LIST
;
45$:
	CLR	M.RNA(R0)	; CLEAR THE READ BUT NOT ACKNOWLEGED POINTER
	CLR	M.BNA(R0)
	DEC	M.CNT(R0)	; ONE LESS IN THIS MESSAGE ID'S QUEUE
;
	SUB	#BLKBUF,R3	; FIND OUT HOW MANY BLOCKS WERE DEALLOCATED
	ASR	R3		; R3= NUMBER OF BLOCKS TO FREE
	MOV	#BLKBUF,R1	; LIST OF BLOCKS TO DEALLOCATE
	ADD	R3,@#140000+Q.FREE ; ADD BLOCKS BEING ALLOCATED TO FREE COUNT
100$:
	MOV	(R1)+,R5
	DEC	R5		; BLOCK NBR ONE MUST BE RETURNED TO BIT 0
	CLR	R4		; DOUBLE WORD DIVIDE, CLEAR UPPER
	DIV	#16.,R4		; GET WHOLE WORDS AND REMAINDER
	ASL	R4		; CHANGE TO WORD OFFSET
	ADD	BITMAP,R4	; POINT TO WORD IN BITMAP
	MOV	#1,R2		; SINGLE BIT MASK
	ASH	R5,R2		; MOVE BIT TO CORRECT POSITION
	BIC	R2,(R4)		; FREE UP THE BIT
	SOB	R3,100$		; CONTINUE UNTIL ALL ARE DEALLOCATED
	CALL	WRTHED
	MOV	#IS.SUC,R0
	.IF DF,DEBUG & LOGPGM
	MOV	R0,ERRSTA
	MOV	#"93,ERRNUM
	CALL	MESG
	.ENDC
	JMP	RTNSTS
	.PAGE
;
; FUNCTION IS DELETE SPECIFIED NUMBER OF MESSAGES WITHOUT ACKNOWLEDGE
;
;	A specified number of messages (specified in the QIO directive)
; are deleted from the specified message id queue.  The messages are deleted
; from the beginning of the queue and the deletions are not acknowledged.
;
; .le;I.PRM-I.PRM+2- Message id buffer double word address.
; .le;I.PRM+4- Size of message id buffer (16 bytes).
; .le;I.PRM+6- Number of messages to delete from queue.
;
IODEL:
	MOV	IOPKT,R3	; GET USER I/O PACKET
	MOV	R3,R0		; COPY SO CAN POINT TO ADDRESS DOUBLE WORD
	ADD	#I.PRM,R0	; MESSAGE ID DOUBLE WORD
	CALL	FINDID		; SEE IF THE ID EXISTS
	BCC	10$		; FOUND THE ID
	MOV	#IE.UKN,R0	; ERROR STATUS
	JMP	RTNSTS		; RETURN ERROR STATUS
10$:
	.IF DF,DEBUG & LOGPGM
	MOV	R0,DEBPTR 	; SAVE LISTHEAD PTR TO LOG DEBUG MSG
	.ENDC
	TST	M.R50(R0)	; IS A TASK ALREADY CONNECTED?
	BEQ	20$		; NO, OK TO DELETE
	MOV	I.TCB(R3),R1	; GET TCB ADDRESS OF REQUESTING TASK
	CMP	T.NAM(R1),M.R50(R0)	; CHECK FIRST PART OF TASK NAME
	BNE	15$			; NO MATCH
	CMP	T.NAM+2(R1),M.R50+2(R0)	; CHECK REST OF TASK NAME
	BEQ	20$		; REQUESTING TASK CONNECTED, OK TO DELETE
15$:
	MOV	#IE.URJ,R0	; TASK ALREADY CONNECTED, THIS TASK NOT
				;   ALLOWED TO DELETE
	JMP	RTNSTS		; RETURN STATUS
20$:
	TST	M.CNT(R0)	; ANY MESSAGES IN QUEUE?
	BNE	22$		; YES
	MOV	#IS.SUC,R0	; NO MESSAGES IN QUEUE, SO NOTHING TO DO
				;   BUT RETURN GOOD STATUS
	.IF DF,DEBUG & LOGPGM
	MOV	R0,ERRSTA
	MOV	#"93,ERRNUM
	CALL	MESG
	.ENDC
	JMP 	RTNSTS
22$:
	MOV	I.PRM+6(R3),-(SP)   ; SAVE TOTAL NUMBER OF MSGS TO DELETE
				    ; ON STACK
	CLR	-(SP)		; CLEAR JUMP ADDRESS 
	TST	M.RNA(R0)	; IS THERE A RNA POINTER PRESENT
	BEQ	25$		; NO
	MOV	M.RNA(R0),R1	; FIRST BLOCK TO DELETE
	MOV	#25$,(SP)	; DELETE RNA MESSAGE FIRST, SECOND MESSAGE
				;   TO DELETE POINTED TO BY M.FLK
	BR	30$
25$:
	MOV	M.FLK(R0),R1	; FIRST BLOCK TO DELETE
	MOV	#30$,(SP)	; NEXT MESSAGE TO DELETE POINTED TO BY B.MSG
;
; GET ALL OF THE BLOCKS USED BY THE MESSAGE SO THAT THEY MAY BE RETURNED
; TO THE FREE LIST
;
30$:
	MOV	#BLKBUF,R3	; ADDRESS OF BLOCK BUFFER STACK
	MOV	R1,(R3)+	; STORE IN BLOCK LIST TO BE RETURNED
	CALL	RPAGEI		; READ BLOCK
	TST	QHD+H.TYPE	; IS MESSAGE VOLATILE?
	BNE	40$		; NO
	DEC	M.NVC(R0)	; DECREMENT VOLATILE MESSAGE COUNTER
40$:
	MOV	QHD+B.NXT,R1	; IS THERE ANOTHER BLOCK IN MESSAGE
	BEQ	45$		; NO, RETURN BLOCKS TO FREE LIST
	MOV	R1,(R3)+	; STORE BLOCK NUMBER TO BE RETURNED
	CALL	RPAGEI		; READ BLOCK
	BR	40$		; GET NEXT BLOCK IN MESSAGE
;
; BLKBUF CONTAINS ALL OF THE BLOCKS THAT NEED TO BE RETURNED
; TO THE FREE LIST
;
45$:
	SUB	#BLKBUF,R3	; FIND OUT HOW MANY BLOCKS WERE DEALLOCATED
	ASR	R3		; R3= NUMBER OF BLOCKS TO FREE
	MOV	#BLKBUF,R1	; LIST OF BLOCKS TO DEALLOCATE
	ADD	R3,@#140000+Q.FREE ; ADD BLOCKS BEING ALLOCATED TO FREE COUNT
100$:
	MOV	(R1)+,R5
	DEC	R5		; BLOCK NBR ONE MUST BE RETURNED TO BIT 0
	CLR	R4		; DOUBLE WORD DIVIDE, CLEAR UPPER
	DIV	#16.,R4		; GET WHOLE WORDS AND REMAINDER
	ASL	R4		; CHANGE TO WORD OFFSET
	ADD	BITMAP,R4	; POINT TO WORD IN BITMAP
	MOV	#1,R2		; SINGLE BIT MASK
	ASH	R5,R2		; MOVE BIT TO CORRECT POSITION
	BIC	R2,(R4)		; FREE UP THE BIT
	SOB	R3,100$		; CONTINUE UNTIL ALL ARE DEALLOCATED
;
; ALL BLOCKS USED BY DELETED MESSAGE HAVE BEEN DEALLOCATED.  GET FIRST
; BLOCK NUMBER OF NEXT MESSAGE TO DELETE.  IF FINISHED DELETING MESSAGES,
; UPDATE QUEUE POINTERS
;
	DEC	M.CNT(R0)	; ONE LESS IN THIS MESSAGE ID'S QUEUE
	BNE	105$		; MORE MESSAGES LEFT IN QUEUE
	CLR	M.FLK(R0)	; NO MORE MSGS IN QUEUE, CLEAR FIRST AND
	CLR	M.BLK(R0)	;   LAST BLOCK POINTERS
	BR	110$		
105$:
	MOV	QHD+B.MSG,R1	; FIRST BLOCK OF NEXT MESSAGE
	DEC	2(SP)		; DECREMENT COUNTER OF NBR OF MSGS TO DELETE
	BEQ	107$		; NO MORE MSGS TO DELETE
	JMP	@(SP)		; DELETE NEXT MSG
107$:
	TST	M.RNA(R0)	; WAS AN RNA MESSAGE PRESENT
	BEQ	109$		; NO, HAVE TO UPDATE FRONT LINK
	MOV	IOPKT,R3	; GET USER I/O PACKET
	CMP	#1,I.PRM+6(R3)	; WAS RNA MESSAGE ONLY MESSAGE DELETED
	BEQ	110$		; YES, M.FLK DOES NOT HAVE TO BE UPDATED
109$:
	MOV	QHD+B.MSG,M.FLK(R0)	; UPDATE FRONT LINK	
110$:
	CMP	(SP)+,(SP)+	; POP STACK
	CLR	M.RNA(R0)	; CLEAR THE READ BUT NOT ACKNOWLEGED POINTERS
	CLR	M.BNA(R0)
	CLR	M.NVL(R0)	; CLEAR THE LAST VOLATILE MSG SCANNED POINTERS
	CLR	M.LST(R0)
	CALL	WRTHED		; WRITE QUEUE HEADER TO DISK
	MOV	#IS.SUC,R0	; INDICATE SUCCESS
	.IF DF,DEBUG & LOGPGM
	MOV	R0,ERRSTA
	MOV	#"93,ERRNUM
	CALL	MESG
	.ENDC
	JMP	RTNSTS
	.PAGE
;
	.PSECT	$DATA,RW,CON,LCL,D
;
; DPB TO GET THE CURRENT SYSTEM TIME
;
TIME:
	GTIM$	TIMBUF
TIMBUF:
	.BLKW	8.	; BUFFER TO GET CURRENT SYSTEM TIME AND DATE
;
; QIO PARAMETER BLOCK TO WRITE TO QUEUE MANAGER DEVICE
;
QUQIO:
	QIOW$	,IQU,EFN4,,QUSTAT,,<,512.,0,0,0>
HEDQIO:
	QIOW$	,IQU,EFN4,,QUSTAT,,<,512.,0,0,0>
;
; QUEUE DEVICE STATUS RETURN
;
QUSTAT:
	.WORD	0	; STATUS
	.WORD	0	; NUMBER OF BYTES TRANSFERED
;
; QIO TO WRITE TO CONSOLE DEVICE
;
CONSLW:
	QIOW$	IO.WLB,ICO,EFN5,,,,<CONMSG,CSMGL>
CONSOL:
	QIO$	IO.WLB,ICO,EFN5,,,LOGAST,<CONMSG,CSMGL>
BUSY:
	.WORD	0	; CONSOLE QIO PENDING FLAG
LOST:
	.WORD	0	; LOST MESSAGE COUNTER
;
; CONSOLE DEVICE MESSAGE
;
CONMSG:
	.BYTE	012,015,012,015		; SOME CARRIAGE RETURNS
	.EVEN
MSGTIM:		; TIME STAMP TO MESSAGE
	.ASCII	/YY-MM-DD /
	.ASCII	/HH:MM:SS  (/
	.EVEN
LSTMSG:
	.ASCII	/XX/
	.ASCII	/) QUEACP QUEUE MANAGER ERROR: /
	.EVEN
ERRNUM:
	.WORD	0	; ASCII ERROR NUMBER
	.ASCII	/ STATUS: /
	.EVEN
ASCSTA:
	.ASCII	/XXXX/
	.EVEN
	.ASCII 	/  /
ASCXTA:
	.ASCII	/      /   ; SOME EXTRA ASCII IF DESIRED
	.BYTE	012,015,006,006  ; LINE FEEDS, CARRIAGE RETURNS, BELLS
	.EVEN
CSMGL=.-CONMSG
;
	.IF DF LOGPGM
DATBUF:
	.ASCII	/                           /	; INIT SEND BUFFER
	.EVEN
LOG:	
	SDAT$	QUELOG,DATBUF			; SEND DIRECTIVE
DEBPTR:
	.WORD	0				; PTR TO MSG ID LISTHEAD
						;   FOR DEBUG MESSAGE
	.ENDC
;
; DPB'S TO CREATE AND MAP REGION FOR OUR QUEUE HEADER
;
CRWND:
	CRAW$	WDB	; CREATE ADDRESS WINDOW
;
; WINDOW DESCRIPTOR BLOCK
;
WDB::
	.BYTE	0	; UNUSED
	.BYTE	6	; W.NAPR APR (6)
	.WORD	0	; W.NBAS RETURN V. A. OR WINDOW
	.WORD	0	; W.NSIZ DESIRED SIZE OF WINDOW IN 32W BLOCKS
	.WORD	0	; W.NRID TASK REGION ID (FROM CREATE REGION)
	.WORD	0	; W.NOFF OFFSET TO START MAP
	.WORD	0	; W.NLEN LENGTH TO BE MAPPED IN 32W BLOCKS
	.WORD	WS.WRT!WS.MAP!WS.UDS	; W.NSTS STATUS 
		; WS.MAP= IF WINDOW IS TO BE MAPPED
		; WS.WRT= WRITE ACCESS
		; WS.UDS= CREATE WINDOW IN USER "D" SPACE
;
CRREG:
	CRRG$	RDB	; CREATE AND ATTACH REGION
;
; REGIONS DESCRIPTOR BLOCK
;
RDB::
	.WORD	0	; R.GID RETURNDED ID TO THE CREATED REGION
	.WORD	0	; R.GSIZ SIZE OF REGION TO CREATE IN 32W BLOCKS
	.RAD50	/QUEHED/ ; R.GNAM NAME OF REGION
	.WORD	0,0	; R.GPAR PARTITION NAME (0= OUR PARTITION)
	.WORD	RS.MDL!RS.ATT!RS.NEX!RS.WRT!RS.DEL ; R.GSTS STATUS
	.WORD	010400	; R.GPRO PROTECTION, ALLOW ONLY OWNER AND SYSTEM FULL
			; ACCESS, REST READ ACCESS
	.PAGE
;
; MESSAGE OUTPUT SUBROUTINE
;
;    ERROR	DESCRIPTION
;
;	01	FILE MAQUEUE.DAT NOT CONTIGUOUS
;	02	FILE OPEN ERROR ON MAQUEUE.DAT 
;       03	BAD I/O STATUS WHILE READING OR WRITING BLOCK OF MESSAGE
;	04	CREATE REGION QUEHED BAD DIRECTIVE STATUS 
;	05	CREATE WINDOW FOR QUEHED REGION BAD DIRECTIVE STATUS 
;	06	QUEHED REGION SUCCESSFULLY CREATED 
;	07	HEADER OF QUEUE IS OVER 8K BYTES OR 1 APR 
;	08	UNABLE TO READ QUEUE HEADER BLOCK INTO REGION; BAD DIRECTIVE 
;		STATUS 
;	09	UNABLE TO READ QUEUE HEADER BLOCK INTO REGION; BAD I/O STATUS
;	10	FILE CLOSE ERROR ON MAQUEUE.DAT 
;	11	BAD DIRECTIVE STATUS WHILE DOING HEADER WRITE QIO 
;	12	BAD I/O STATUS WHILE WRITING THE HEADER
;	13	FOUND END OF QUEUE WHILE DELETING A TYPE ZERO MESSAGE WHEN 
;		M.NVC NOT EQUAL TO ZERO 
;	14	DETACHING FROM QUEUE HEADER REGION BAD DIRECTIVE STATUS 
;	15	QUEACP ABORTED VIA DIRECTIVE OR A DCL OR MCR COMMAND
;	16	UNABLE TO SPECIFY ABORT AST; BAD DIRECTIVE STATUS 
;	17	UNABLE TO SPECIFY SST VECTOR; BAD DIRECTIVE STATUS 
;	18	UNABLE TO READ FIRST BLOCK OF QUEUE HEADER; BAD DIRECTIVE 
;		STATUS 
;	19	UNABLE TO READ FIRST BLOCK OF QUEUE HEADER; BAD I/O STATUS
;
;
;     DEBUG STATUS MESSAGES
;
;	90	HEADER CHECKPOINTED
;	91	BLOCK NUMBER OF BLOCK READ 
;	92	BLOCK NUMBER OF BLOCK WRITTEN 
;	93	MESSAGE ID LISTHEAD INFO
;	95	FUNCTION STATUS (RESULT OF IO.WVB, IO.RVB, ETC) 
;	96	DISCONNECT ALL MSG IDS CONNECTED BY REQUESTING TASK 
;	97	LENGTH OF QUEUE IN BLOCKS 
;	98	FUNCTION CODE VALUE 
;	99	ACP ACTIVATED
;
;
; ERROR STATUS TO BE ENCODED INTO THE MESSAGE BEFORE OUTPUT
;
ERRSTA:
	.WORD	0
;
	.PSECT	$CODE,RO,I,CON,REL
;
; THIS ROUTINE WILL ISSUE A QIO TO THE CONSOLE AND CONTINUE.  ALL NON-FATAL
; ERRORS MUST USE THIS ROUTINE SO THAT THE TASK DOES NOT WAIT FOREVER
; IF THE QIO DOES NOT COMPLETE (CONSOLE OUT OF PAPER, ETC.)
;
MESG:
	MOV	#"  ,ASCXTA	; BLANK EXTENDED ASCII STATUS
	MOV	#"  ,ASCXTA+2	;   "     "       "      "
	MOV	#"  ,ASCXTA+4	;   "     "       "      "
MESGA:
	.IF NDF DEBUG & LOGPGM
	TST	BUSY		; IS WRITE TO CONSOLE PENDING?
	BEQ	5$		; NO, LOG MESSAGE
	INC	LOST		; MESSAGE WILL BE LOST, INCREMENT COUNTER
	RETURN
5$:
	INC	BUSY		; SET CONSOLE BUSY FLAG
	.ENDC
	CALL	FORMAT		; FORMAT MESSAGE FOR OUTPUT
	.IF DF LOGPGM
	CALL	SNDMSG		; SEND MESSAGE TO LOG PROGRAM
	.IFF
	.IF NDF DEBUG
	DIR$	#CONSOL		; OUTPUT MESSAGE TO CONSOLE DEVICE (NO WAIT)
	.IFF
	DIR$	#CONSLW		; OUTPUT MESSAGE TO CONSOLE DEVICE AND WAIT
	.ENDC
	.ENDC
	RETURN
;
; THIS ROUTINE WILL ISSUE A QIO TO THE CONSOLE AND WAIT FOR IT TO COMPLETE.
; IT IS ONLY USED TO LOG FATAL ERROR MESSAGES OR THE ABORT MESSAGE SINCE
; THE TASK MUST WAIT FOR THE QIO TO COMPLETE BEFORE IT EXITS.
;
MESGW:
	MOV	#"  ,ASCXTA	; BLANK EXTENDED ASCII STATUS
	MOV	#"  ,ASCXTA+2	;   "     "       "      "
	MOV	#"  ,ASCXTA+4	;   "     "       "      "
MESGAW:
	CALL	FORMAT		; FORMAT MESSAGE FOR OUTPUT
	.IF DF LOGPGM
	CALL	SNDMSG		; SEND MESSAGE TO LOG PROGRAM
	.IFF
	DIR$	#CONSLW		; OUTPUT MESSAGE TO CONSOLE DEVICE
	.ENDC
	RETURN
;
; THIS ROUTINE FORMATS THE MESSAGE LOGGED ON THE CONSOLE
;
FORMAT:
	CALL	$SAVAL		; SAVE ALL OPERATING REGISTERS*** X 1.9
	DIR$	#TIME		; GET CURRENT SYSTEM TIME
	MOV	#TIMBUF,R1	; DATE PARAMETERS
	MOV	#MSGTIM,R0	; WHERE TO ENCODE TIME
	CALL 	$DAT		; COVNERT DATE
	MOVB	#' ,(R0)+	; STORE INTERVENING SPACE
	MOV	#TIMBUF+6,R1	; TIME PARAMETERS
	MOV	#3,R2		; WANT HH:MM:SS
	CALL 	$TIM		; CONVERT TIME
;
	MOV	#LSTMSG,R0	; PLACE FOR LOST MESSAGE NUMBER IN ASCII
	MOV	LOST,R1		; BINARY TO CONVERT
	MOV	#<10.!1000!010000>,R2	; CONVERSION PARAMETERS
	CALL	$CBTA			; CALL TO CONVERT BINARY ASCII
	CLR	LOST		; ZERO LOST MESSAGE COUNTER FOR NEXT TIME
;
	MOV	#"  ,ASCSTA	; BLANK OUT 
	MOV	#"  ,ASCSTA+2
	TST	ERRSTA		; STATUS TO LOG?
	BEQ	10$		; NO
	MOV	#ASCSTA,R0	; PLACE FOR ASCII
	MOV	ERRSTA,R1	; BINARY TO CONVERT
;
;
	MOV	#<10.!400!020000>,R2	; CONVERSION PARAMETERS
	CALL	$CBTA	; CALL TO CONVERT BINARY ASCII
;
10$:
	RETURN
;
; THIS ROUTINE WILL SEND THE MESSAGE TO PROGRAM 'QUELOG' INSTEAD
; OF WRITING IT ON THE CONSOLE.
;
	.IF DF LOGPGM
SNDMSG:
	MOV	ERRNUM,DATBUF		; PUT ERROR NUMBER IN SEND BUFFER
	MOV	ASCSTA,DATBUF+2		; PUT STATUS NUMBER IN SEND BUFFER
	MOV	ASCSTA+2,DATBUF+4
	MOV	ASCXTA,DATBUF+6		; PUT EXTENDED STATUS IN SEND BUFFER
	MOV	ASCXTA+2,DATBUF+10
	CMP 	#"93,ERRNUM
	BNE	20$
	MOV	R0,-(SP)		; SAVE R0
	MOV	DEBPTR,R0		; GET LISTHEAD POINTER
	MOV	M.FLK(R0),DATBUF+12	; MOV LISTHEAD INFO INTO SEND BUFFER
	MOV	M.BLK(R0),DATBUF+14
	MOV	M.RNA(R0),DATBUF+16
	MOV	M.BNA(R0),DATBUF+20
	MOV	M.CNT(R0),DATBUF+22
	MOV	M.NVC(R0),DATBUF+24
	MOV	M.NVL(R0),DATBUF+26
	MOV	M.LST(R0),DATBUF+30
	MOV	(SP)+,R0		; RESTORE R0
20$:	
	DIR$	#LOG			; SEND TO PROGRAM QUELOG
	RETURN
	.ENDC
;
;
; CONSOLE QIO HAS COMPLETED.  CLEAR BUSY FLAG
;
LOGAST:
	CLR	BUSY
	TST	(SP)+	
	ASTX$S
	.PAGE
;
; DISK READ AND WRITE SUBROUTINES
;
;
; R1= RELATIVE BLOCK NUMBER TO READ OR WRITE
;
RPAGEI:
	MOV	#QHD,QUQIO+Q.IOPL	; READ FROM START OF QHD BUFFER
RBLOCK:
	MOV	#IO.RLB,QUQIO+Q.IOFN	; FUNCTION CODE IS READ
	.IF DF DEBUG
	MOV	R1,ERRSTA		; NBR OF BLOCK TO READ
	MOV	#"91,ERRNUM		; READ
	CALL	MESG
	.ENDC
	BR	COMIND
WPAGEI:
	MOV	#QHD,QUQIO+Q.IOPL	; WRITE FROM START OF QHD BUFFER
WBLOCK:
	MOV	#IO.WLB,QUQIO+Q.IOFN	; FUNCTION CODE IS WRITE
	.IF DF DEBUG
	MOV	R1,ERRSTA		; NBR OF BLOCK TO READ
	MOV	#"92,ERRNUM		; WRITE
	CALL	MESG
	.ENDC
COMIND:
	MOV	R1,-(SP)	; SAVE REGISTERS 1 AND 4
	MOV	R4,-(SP)	
	ADD	STRBLK,R1	; ADD OFFSET TO FIRST BLOCK OF MESSAGE BLOCKS
	MOV	INQLBN+2,R4	; LOWER STARTING LBN OF INPUT QUEUE FILE
	DEC	R4	; REMOVE BIAS OF ONE BLOCK
	ADD	R1,R4	; ADD RELATIVE BLOCK
	MOV	R4,QUQIO+Q.IOPL+10	; SAVE LOW LBN OF READ
	MOV	INQLBN,R4	; GET UPPER STARTING LBN OF INPUT QUEUE FILE
	ADC	R4	; ADD CARRY FROM LOWER LBN ADD
	MOV	R4,QUQIO+Q.IOPL+6	; STORE FOR QIO
	DIR$	#QUQIO	; READ/WRITE THE BLOCK
	MOV	(SP)+,R4	; RESTORE REGISTERS 1 AND 4
	MOV	(SP)+,R1	;
	CMPB	#IS.SUC,QUSTAT	; GOOD STATUS
	BNE	DSKERR	; NO, DISK ERROR
	RETURN
;
; DISK ERROR 
;
DSKERR:
	MOV	#"03,ERRNUM	; ERROR NUMBER
	MOVB	QUSTAT,R1	; SIGNE EXTEND ERROR
	MOV	R1,ERRSTA	; STORE FOR OUTPUT
	MOVB	$DSW,R1	; GET DIRECTIVE STATUS
	MOV	#ASCXTA,R0	; PLACE TO STORE EXTENDED ERROR
	MOV	#<10.!400!20000>,R2	; ENCODING PARAMETERS
	CALL	$CBTA	; CONVERT TO ASCII
	CALL	MESGW	; OUTPUT MESSAGE
	EXIT$S	; CAN'T CONTINUE
	.PAGE
;
; SUBROUTINE FINDID
;    THIS SUBROUTINE FINDS A MESSAGE ID THAT IS POINTED TO
; BY THE ADDRESS DOUBLE WORD.
;
; INPUT:
;	R0= ADDRESS OF ADDRESS DOUBLE WORD
; OUTPUT:
;	C= 0 IF FOUND
;	 = 1 IF NOT FOUND
;
;	   R0= ADDRESS OF MESSAGE ID LIST HEAD IN THE
;	       REGION
;	IDNAM= ACTUAL ID AS COPIED FROM THE USER'S
;		BUFFER.
;	
FINDID:
	JSR	R5,REGSAV	; SAVE ALL BUT R0
;
; MAP THE USER'S BUFFER FIRST AND GET A COPY
; OF HIS MESSAGE ID.
;
	MOV	R0,R3		; LOAD R3 WITH MESSAGE ID BUFFER DOUBLE
				; WORD ADDRESS FOR MAPUSR
	SWSTK$	15$		; SWITCH TO SYSTEM STATE TO COPY MSG
				;   ID FROM USER BUFFER TO LOCAL BUFFER
				;   RETURN TO USER STATE AT 15$
;;*************************************************************************
	CALL	MAPUSR		;; MAP THE USER MESSAGE ID BUFFER
	MOV	#M.IDSI,R1	;; 16 BYTE MESSAGE ID'S
	MOV	#IDNAM,R2	;; TEMP BUFFER
10$:
	MOVB	(R0)+,(R2)+	;; COPY TO OUR LOCAL BUFFER
	SOB	R1,10$		;; LOOP UNTIL HAVE HIS ID 
	RETURN			;; RETURN TO USER STATE
;;*************************************************************************
;
; NOW MAP THE REGION (MAP STARTS WITH APR 6, 140000)
;
15$:
	MOV	@#140000+Q.IDC,R1	; NUMBER OF MESSAGE ID'S DEFINED
	MOV	#140000+Q.KSIZ+M.MID,R2	; WHERE MESSAGE ID LIST HEADS START
					; (RIGHT AFTER THE QUEUE HEADER)
;
; NOW SEE IF WE CAN FIND THE ID
;
20$:
	CMPB	IDNAM,(R2)		; QUICK CHECK FIRST CHAR
	BNE	50$			; NOT THIS ONE
	MOV	#IDNAM,R4		; SEARCH BUFFER
	MOV	R2,R5			; COPY COMPARE ADDRESS
	MOV	#M.IDSI,R0		; NUMBER OF BYTES IN ID STRING
30$:
	CMPB	(R4)+,(R5)+		; SEE IF STRINGS MATCH
	BNE	50$			; NOT THIS ONE
	SOB	R0,30$
;
; FOUND A MATCH
;
	MOV	R2,R0			; RETURN ADDRESS
	CLC				; CLEAR CARRY (SUCCESS)
	RETURN				; ALL DONE
;
; NOT THIS ID
;
50$:
	ADD	#M.LEN,R2		; POINT TO NEXT LIST HEAD
	SOB	R1,20$			; LOOP UNTIL ALL HAVE BEEN COMPARED
;
; MESSAGE ID NOT FOUND
;
	SEC				; SET FAILURE
	RETURN
	.PAGE
;
; REGSAV
;
; THIS IS A COROUTINE THAT SAVES ALL REGISTERS BUT RO.
;
; 	JSR	R5,REGSAV
;
; ON ENTRY:
;     R5= RETURN ADDRESS TO CALLER
;  2(SP)= CALLER'S CALLER'S RETURN PC
;  0(SP)= SAVED R5
;
REGSAV:
	MOV	R1,-(SP)	; SAVE R1
	MOV	R2,-(SP)	; SAVE R2
	MOV	R3,-(SP)	; SAVE R3
	MOV	R4,-(SP)	; SAVE R4
	MOV	R5,-(SP)	; PUSH RETURN ADDRESS
	MOV	12(SP),R5	; GET SAVED R5
	JSR	PC,@(SP)+	; CALL THE CALLER BACK
;
; BACK TO RESTORE THE REGISTERS
;	00(SP) R4
;	02(SP) R3
;	04(SP) R2
;	06(SP) R1
;	10(SP) R5
;
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R5
	RETURN			; RETURN TO THE CALLER'S CALLER
	.PAGE
;;
;; SUBROUTINE  MAPUSR
;; 
;; THIS SUBROUTINE MAPS AN ADDRESS DOUBLE WORD
;; IT RUNS IN SYSTEM STATE USING KERNAL DATA APR 6 SO THAT NO CONTEXT
;; CHANGE CAN TAKE PLACE AFTER THE USER BUFFER HAS BEEN MAPPED VIA
;; APR 6 AND BEFORE ALL DATA HAS BEEN TRANSFERRED INTO THE USER BUFFER.
;; 
;;
;; INPUT:
;; 	R3= ADDRESS OF ADDRESS DOUBLE WORD
;; OUTPUT:
;;	R0= VIRTUAL ADDRESS 
;;
MAPUSR:
;;
;; ALLOW 4K WORDS UPWARD IN PDR FOR GETTING AT USER BUFFER
;;
	MOV	(R3),@#KDAPR6	  ;; LOAD OUR ADDRESS PAGE REGISTER
	MOV	2(R3),R0	  ;; RETURN V.A.
	RETURN			  
	.PAGE
;
; WRTHED
;
; THIS SUBROUTINE WRITE THE REGION HEADER BACK TO THE
; DISK, THIS INCLUDES THE HEADER, LISTHEADS, AND THE
; BIT MAP.
;
; CARRY SET, THEN ERROR AND R0 IS DESTROYED.
;
WRTHED:
	.IF DF DEBUG
	MOV	#1,ERRSTA		; NBR OF BLOCK TO READ
	MOV	#"90,ERRNUM		; HEADER CHECKPOINTED
	CALL	MESG
	.ENDC
	DIR$	#HEDQIO		; THE QIO WAS SET UP DURING THE MOUNT
	BCS	10$		; WHAT THIS IS BAD NEWS
	CMPB	#IS.SUC,QUSTAT	; GOOD WRITE?
	BNE	20$		; NOPE, THIS SOUNDS SERIOUS
	RETURN			; ALL IS OK
;
; DIRECTIVE ERROR IS PROBALBLY AND ACP BUG
;
10$:
	MOVB	$DSW,R0		; SIGN EXTEND THE ERROR CODE
	MOV	R0,ERRSTA	; STORE STATUS
	MOV	#"11,ERRNUM	; ERROR NUMBER
	CALL	MESG
	SEC			; SET CARRAY ERROR STATUS
	RETURN			; CAN'T GRACEFULLY RECOVER
				; SINCE WE DON'T HOW USER CALLED US
				; THEREFORE CAN'T DO I/O DONE
;
; BAD I/O STATUS ON WRITE
;
20$:
	MOVB	QUSTAT,R0	; GET THE I/O STATUS
	MOV	R0,ERRSTA	; SIGN EXTEND STATUS
	MOV	#"12,ERRNUM
	CALL	MESG		; LOG STATUS
	SEC
	RETURN
	.PAGE
;
; DLTYP0
;
; This subroutine will delete the oldest type zero message
; in a messag id subqueue.  The subroutine starts at either
; M.FLK or M.NVL depending if M.NVL is zero or not.  If
; M.NVL is not zero, that means that we have been here 
; before trying to delete messages and we saved the next
; place to look in the event that we have to delete more.
; Since it is not possible for any messages to ever be entered
; at the beginning of the queue, we  only need to save a pointer
; for the next attempt.
;
; The read but not acknowleged pointer is always checked first.
;
; input:
;	R0= message id list head
; output:
;	CC= 0 if successful in deleting a message
;	CC= 1 if unsuccessful
;
DLTYP0:
	TST	M.NVC(R0)	; ANY MESSAGES THAT CAN BE DELETED?
	BNE	10$		; YES
	SEC			; NO, SET CARRY AND RETURN
	RETURN	
10$:
	JSR	R5,REGSAV 	; SAVE OUR REGISTER (ALL EXCEPT R0)
	CLR	R5		; PREVIOUS BLOCK 
	MOV	M.NVL(R0),R1	; GET POSSIBLE LINK TO MESSAGE TO BE DELETED
	BEQ	15$		; NO LINK
	MOV	M.LST(R0),R5	; LAST BLOCK OF MSG BEFORE LAST SCANNED
	BR	20$
15$:
	MOV	M.FLK(R0),R1	; MUST BE FIRST TIME THROUGH
20$:
	CALL	RPAGEI		; GO READ IN THE MESSAGE
	TST	QHD+H.TYPE	; IS THIS A TYPE ZERO MESSAGE?
	BEQ	50$		; YES, THEN GO DELETE IT
;
; NOT A TYPE ZERO MESSAGE, FIND NEXT ONE IN THREADED LIST
;
30$:
	MOV	R1,R5		; SAVE PREVIOUS ENDING BLOCK POINTER
				; INCASE THIS ONE NEEDS TO BE MODIFIED
	MOV 	QHD+B.NXT,R1	; IS THERE A ANOTHER BLOCK IN THIS MESSAGE
	BEQ	40$		; NO, THEN HAVE ENDING THE BLOCK OF MESSAGE
	CALL	RPAGEI		; READ NEXT BLOCK IN THE MESSAGE
	BR	30$		; LOOP UNTIL WE GET FIND THE ENDING BLOCK
				; OF THE MESSAGE SO WE CAN FIND NEXT MESSAGE
;
; FOUND THE LAST BLOCK OF THE MESSAGE WHICH CONTAINS THE THREAD TO THE
; NEXT MESSAGE IN THIS MESSAGE ID QUEUE
;
40$:
	MOV	QHD+B.MSG,R1	; GET NEXT MESSAGE IN THIS MESSAGE ID LIST
	BNE	20$		; NOT AT END YET SO OK.
	CLR	M.NVC(R0)	; CLEAR NUMBER OF TYPE ZERO'S AVAILABLE
	CLR	M.NVL(R0)	; CLEAR LINKS TOO
	CLR	M.LST(R0)
	MOV	#"13,ERRNUM	; THIS SHOULDN'T HAPPEN AS WE CHECKED
				; THE COUNT FIRST AND THERE WERE SOME 
				; CANDIDATES
	MOV	R0,ERRSTA	; ERROR STATUS = MESSAGE ID LISTHEAD
	MOV	M.MID(R0),ASCXTA ; FIRST 6 CHARACTERS OF MESSAGE
	MOV	M.MID+2(R0),ASCXTA+2 ; ID FOR ERROR MESSAGE
	MOV	M.MID+4(R0),ASCXTA+4
	CALL	MESGA
	SEC
	RETURN
	.PAGE
;
; FOUND A MESSAGE TO DELETE
; R5= 0 IF FIRST MESSAGE IN QUEUE TO  BE DELETED, ELSE
;	CONTAINS THE BLOCK THAT MUST BE UPDATED TO THE
;	FORWARD LINK OF THIS MESSAGE (B.MSG(BLOCK R5)= B.MSG(BLOCK R1)
;
50$:
	MOV	#BLKBUF,R3	; ADDRESS OF BLOCK BUFFER STACK
60$:
	MOV	R1,(R3)+	; SAVE BLOCK NUMBER FOR DELETION
	MOV 	QHD+B.NXT,R1	; IS THERE A ANOTHER BLOCK IN THIS MESSAGE
	BEQ	70$		; NO, THEN HAVE THE ENDING BLOCK OF MESSAGE TO
				;    BE DELETED
	CALL	RPAGEI		; YES, READ NEXT BLOCK IN THE MESSAGE
	BR	60$		; LOOP UNTIL WE GET FIND THE ENDING BLOCK
				; OF THE MESSAGE SO WE CAN FIND NEXT MESSAGE
;
; HAVE THE LAST BLOCK OF THE MESSAGE THAT IS TO BE DELETED
;
70$:
	MOV	QHD+B.MSG,R4	; SAVE THIS MESSAGE'S FORWARD LINK
	MOV	R5,R1		; GET PREVIOUS BLOCK
	BNE	80$		; THIS IS NOT THE FIRST BLOCK IN THE QUEUE
	MOV	R4,M.FLK(R0)	; UPDATE FORWARD POINTER TO US
	BR	90$		; GO DELETE THE BLOCKS DEALLOCATED & DEC. COUNT	
80$:
	CALL	RPAGEI		; READ THE LAST BLOCK OF PREVIOUS MESSAGE
	MOV	R4,QHD+B.MSG	; WRITE THIS MESSAGES FORWARD LINK (TAKE'S US
				; OUT OF THE THREAD)
	BNE	85$		; NO NEED TO UPDATE BACK LINK
	MOV	R1,M.BLK(R0)	; LAST MSG IN QUEUE DELETED, UPDATE BACK LINK
85$:
	CALL	WPAGEI		; WRITE BACK WITH US REMOVED
;
; UPDATE COUNTS, MODIFY THREADS, RELEASE BLOCKS
;
90$:
	CMP	BLKBUF,M.RNA(R0)	; CHECK IF FIRST BLOCK OF TYPE 0 MSG
					;   BEING DELETED IS FIRST BLOCK OF
					;   RNA MSG
	BNE	92$		; NO, DON'T ZERO RNA POINTERS OF TYPE 1 MSG
	CLR	M.RNA(R0)	; CLEAR RNA POINTERS OF TYPE ZERO MSG 
	CLR	M.BNA(R0)	
92$:
	DEC	M.CNT(R0)	; ONE LESS IN THIS MESSAGE ID'S QUEUE
	DEC	M.NVC(R0)	; DECREMENT NUMBER OF TYPE ZERO MESSAGES
	MOV	R4,M.NVL(R0)	; UPDATE THE LINK TO NEXT DELETABLE
	BNE	95$		; NOT AT END OF QUEUE
	CLR	R5		; AT END OF QUEUE, ZERO M.LST ALSO
95$:
	MOV	R5,M.LST(R0)	; UPDATE LAST BLOCK NUMBER
;
	SUB	#BLKBUF,R3	; FIND OUT HOW MANY BLOCKS WERE DEALLOCATED
	ASR	R3		; R3= NUMBER OF BLOCKS TO FREE
	MOV	#BLKBUF,R1	; LIST OF BLOCKS TO DEALLOCATE
	ADD	R3,@#140000+Q.FREE ; ADD BLOCKS BEING ALLOCATED TO FREE COUNT
100$:
	MOV	(R1)+,R5
	DEC	R5		; BLOCK NBR ONE MUST BE RETURNED TO BIT 0
	CLR	R4		; DOUBLE WORD DIVIDE, CLEAR UPPER
	DIV	#16.,R4		; GET WHOLE WORDS AND REMAINDER
	ASL	R4		; CHANGE TO WORD OFFSET
	ADD	BITMAP,R4	; POINT TO WORD IN BITMAP
	MOV	#1,R2		; SINGLE BIT MASK
	ASH	R5,R2		; MOVE BIT TO CORRECT POSITION
	BIC	R2,(R4)		; FREE UP THE BIT
	SOB	R3,100$		; CONTINUE UNTIL ALL ARE DEALLOCATED
	CLC			; SET SUCCESS
	RETURN			; ALL DONE.  DO NOT CHECKPOINT HEADER
				; UNTIL ALL THE WAY COMPLETE.	
	.PAGE
;
;	ASTEXT
;	THIS ROUTINE HANDLES I/O PACKET CLEAN UP AND MARKS THE ZQ: DEVICE
;	AS DISMOUNTED WHEN AN ABORT COMMAND IS ISSUED.
;
ASTEXT:	
	SWSTK$	100$		;  SWITCH TO SYSTEM STATE, RETURN TO USER
				;    STATE AT 100$
;;*********************************************************************
	MOV	ZQUCB,R5	;; GET UCB OF ZQ: DEVICE
	BISB	#US.MDM,U.STS(R5)  ;; MARK ZQ: DEVICE FOR DISMOUNT
	TST	IOPKT		;; CHECK IF AN I/O PACKET WAS BEING
				;;   PROCESSED DURING ABORT
	BEQ	50$		;; NO I/O PACKET
	MOV	IOPKT,R3	;; LOAD R3 WITH I/O PACKET ADDR FOR $IOFIN
	MOV	#IE.ABO,R0	;; LOAD R0 WITH I/O ERROR CODE FOR $IOFIN
	CALL	$IOFIN		;; RETURN ABORT STATUS TO CALLER	
50$:
	MOV	$TKTCB,R0	;; CURRENT TASK TCB ADDRESS (IE: US)
	ADD	#T.RCVL,R0	;; POINT TO OUR RECEIVE DATA THREAD
	CALL	$QRMVF		;; ATTEMPT TO DEQUEUE A PACKET (PACKET ADDR
				;;   RETURNED IN R1)
	BCS	75$		;; NO PACKET, GO WAIT
	MOV	R1,R3		;; LOAD R3 WITH I/O PACKET ADDR FOR $IOFIN
	MOV	#IE.ABO,R0	;; LOAD R0 WITH I/O ERROR CODE FOR $IOFIN
	CALL	$IOFIN		;; RETURN ABORT STATUS TO CALLER
	BR	50$		;; LOOK FOR ANOTHER PACKET
;;
;; NO I/O PACKETS LEFT, MARK ZQ: DEVICE DISMOUNTED AND EXIT SYS STATE
;;
75$:
	MOV	ZQUCB,R5 	  ;; GET UCB OF ZQ: DEVICE
	BICB	#US.MDM,U.STS(R5) ;; CLEAR MARKED FOR DISMOUNT
	BISB	#US.MNT,U.STS(R5) ;; SET DISMOUNT COMPLETE
	RETURN			  ;; GO BACK TO USER STATE 
;;******************************************************************************
100$:
	MOV	$TKTCB,R0	; CURRENT TASK TCB ADDRESS (IE: US)
	TSTB	T.IOC(R0)	; POINT TO THE I/O COUNT BYTE
	BNE	100$		; LOOP IF I/O PENDING (T.IOC IS NONZERO)
	MOV	#"15,ERRNUM	; ERROR NUMBER
	CLR	ERRSTA		; NO STATUS
	MOV	#"AB,ASCXTA	; STATUS = 'ABORTED'
	MOV	#"OR,ASCXTA+2
	MOV	#"T ,ASCXTA+4
	CALL	MESGAW		; LOG MESSAGE ON CONSOLE

	EXIT$S			; EXIT TASK

	.PAGE
;
;	SYNCHRONOUS SYSTEM TRAP ROUTINES
;
;	THE COMMON SST ROUTINE CREATES A SNAP DUMP OF THE TASK STACK
;	AND THE HEADER REGION OF THE MAQUEUE.  ALL SST ERROR MESSAGES
;	APPEAR ON THE CONSOLE AS "ZQ0:  -- Select error". THE EXACT 
;	SST IS IDENTIFIED BY AN ERROR CODE THAT APPEARS ON THE STACK
;	ALONG WITH SST DEPENDENT PARAMETERS.
;
;	THE STACK IN THE SNAP DUMP CONTAINS THE FOLLOWING
;		  (SP) = LAST WORD OF I/O PACKET
;		46(SP) = FIRST WORD OF I/O PACKET
;		50(SP) = R5 WHEN SST OCCURRED
;		52(SP) = R4 WHEN SST OCCURRED
;		54(SP) = R3 WHEN SST OCCURRED
;		56(SP) = R2 WHEN SST OCCURRED
;		60(SP) = R1 WHEN SST OCCURRED
;		62(SP) = R0 WHEN SST OCCURRED
;		64(SP) = SST CODE
;	
;
; 	ODD ADDRESS OR NONEXISTENT MEMORY
;		64(SP) = SST CODE 'OD'
;		66(SP) = PC WHEN SST OCCURRED
;		70(SP) = PSW WHEN SST OCCURRED
ODDSST:
	MOV	#"OD,-(SP)	; PUSH ODD ADDRESS CODE 'OD' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	MEMORY PROTECT VIOLATION
;		64(SP) = SST CODE 'ME'
;		66(SP) = MMR1 (INSTRUCTION BACKUP REGISTER)
;		70(SP) = MMR2 (VIRTUAL PC OF FAULTY INSTRUCTION) 
;		72(SP) = MMR0 (MEMORY PROTECT STATUS) 
;		74(SP) = PC WHEN SST OCCURRED
;		76(SP) = PSW WHEN SST OCCURRED
MEMSST:
	MOV	#"ME,-(SP)	; PUSH MEMORT PROTECT CODE 'ME' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	T-BIT TRAP OR EXECUTION OF A BPT INSTRUCTION
;		64(SP) = SST CODE 'TB'
;		66(SP) = PC WHEN SST OCCURRED
;		70(SP) = PSW WHEN SST OCCURRED
TBTSST:
	MOV	#"TB,-(SP)	; PUSH T-BIT CODE 'TB' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	EXECUTION OF AN IOT INSTRUCTION
;		64(SP) = SST CODE 'IO'
;		66(SP) = PC WHEN SST OCCURRED
;		70(SP) = PSW WHEN SST OCCURRED
IOTSST:
	MOV	#"IO,-(SP)	; PUSH IOT CODE 'IO' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	EXECUTION OF A RESERVED INSTRUCTION
;		64(SP) = SST CODE 'RE'
;		66(SP) = PC WHEN SST OCCURRED
;		70(SP) = PSW WHEN SST OCCURRED
RESSST:
	MOV	#"RE,-(SP)	; PUSH RESERVED INSTRUCTION CODE 'RE' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	EXECUTION OF A NON-RSX EMT INSTRUCTION
;		64(SP) = SST CODE 'EM'
;		66(SP) = EMT CODE TIMES 2
;		70(SP) = PC WHEN SST OCCURRED
;		72(SP) = PSW WHEN SST OCCURRED
EMTSST:
	MOV	#"EM,-(SP)	; PUSH EMT CODE 'EM' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	EXECUTION OF A TRAP INSTRUCTION
;		64(SP) = SST CODE 'TR'
;		66(SP) = TRAP CODE TIMES 2
;		70(SP) = PC WHEN SST OCCURRED
;		72(SP) = PSW WHEN SST OCCURRED
TRPSST:
	MOV	#"TR,-(SP)	; PUSH TRAP CODE 'TR' ON STACK
	JMP	COMSST		; ENTER COMMON ROUTINE
;
;	FLOATING POINT EXCEPTION
;		64(SP) = SST CODE 'FL'
;		66(SP) = PC WHEN SST OCCURRED
;		70(SP) = PSW WHEN SST OCCURRED
FLTSST:
	MOV	#"FL,-(SP)	; PUSH FLOAT EXCEPTION CODE 'FL' ON STACK
;
COMSST:
	MOV	R0,-(SP)	; SAVE STATE OF REGISTERS WHEN SST
	MOV	R1,-(SP)	;   OCCURRED
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	MOV	#I.LGTH,R3	; NBR OF OCTAL BYTES IN I/O PACKET
	ASR	R3		; CHANGE TO NBR OF WORDS FOR COUNTER	
	MOV	IOPKT,R2	; LOAD R2 WITH STARTING ADDRESS OF I/O PACKET 
10$:
	MOV	(R2)+,-(SP)	; PUSH I/O PACKET WORD ON STACK
	SOB	R3,10$		; LOOP UNTIL ENTIRE I/O PACKET ON STACK
	MOV	@#UDPDR6,R1	; LOAD R0 WITH HEADER REGION PDR
	BIC	#100377,R1	; CLEAR ALL BITS THAT DON'T APPLY TO 
				;   PAGE LENGTH 
	ASH	#-8.,R1		; SHIFT PAGE LENGTH BITS TO BITS 0-6
	INC	R1		; R1 NOW CONTAINS NUMBER OF 32 WORD
				;   BLOCKS THAT ARE MAPPED
	MUL	#64.,R1		; CHANGE TO NUMBER OF BYTES MAPPED
	SUB	#2,R1		; END OF REGION ADDRESS
	ADD	#140000,R1	; CALC END OF REGION VIRTUAL ADDRESS
	
	SNAP$	,,,#140000,R1	; GENERATE SNAP DUMP
	MOV	#T.NDSE,R0	; MESSAGE NUMBER FOR $DVMSG (SELECT ERROR)
	MOV	ZQUCB,R5	; UCB OF ZQ: DEVICE
	SWSTK$	20$		; SWITCH TO SYSTEM STATE, RETURN TO USER
				;   STATE AT 20$
;;****************************************************************************
	CALL	$DVMSG		;; SUBMIT MSG TO TASK TERMINATOR
	RETURN			;; RETURN TO USER STATE
;;****************************************************************************
20$:
	EXIT$S			; EXIT TASK
	
	.PAGE
	.PSECT	$DATA,RW,CON,LCL,D
;
DAYMLT:
	.FLT4	864000000000.0	; NUMBER OF MILASECONDS IN A DAY
HRSMLT:
	.FLT4	36000000000.0	; NUMBER OF MILASECONDS IN AN HOUR
MINMLT:
	.FLT4	600000000.0	; NUMBER OF MILASECONDS IN A MINUTE
SECMLT:
	.FLT4	10000000.0	; NUMBER OF MILASECONDS IN A SECOND
TICMLT:
	.FLT4	166666.6	; NUMBER OF MILASECONDS IN A TICK
K365:	
	.FLT2	365.0
K$75:	
	.FLT2	0.75
K$4:	
	.FLT2	0.4
K2$3:	
	.FLT2	2.3
K1858:	
	.FLT2	678941.0	; DAYS SINCE 17-NOV-1858
XMS:	
	.BLKW	4	; TOTAL NUMBER OF MILLASECONDS
			; USED FOR MASKING OPERATIONS
;
; TEMPORAIES
;
I1:	.WORD	0
I2:	.WORD	0
I3:	.WORD	0	
$TEMPS:
	.BLKB	10	; TEMPS 
;
EXP:
	.BLKW	1
;
G:	.FLT2	0.0
F:	.FLT2	0.0
	.PAGE
	.PSECT	$CODE,RO,I,CON,REL
;
; GET CURRENT TIME IN VAX QUAD TIME FORMAT
;
; R5= OUTPUT BUFFER TO RECEIVE VAX QUAD TIME
;
VAXQAD::
	JSR	R5,REGSAV  ; SAVE ALL REGISTERS EXCEPT R0
	DIR$	#TIME	; GET CURRENT SYTE CLOCK
	MOV	R5,R4	; COPY OUTPUT BUFFER ADDRESS
	CLR	(R4)+	; INIT VAX QUAD TIME TO ZERO
	CLR	(R4)+
	CLR	(R4)+
	CLR	(R4)+
	MOV	R5,R3	; SAVE R5
;
	ADD	#1900.,TIMBUF+G.TIYR	; MAKE THE YEAR 1986 AND NOT 86
;
	SETF		; SET FLOATING (NORMAL)
	SETI		; SET INTEGER (NORMAL)
;

	LDCIF	TIMBUF+G.TIYR,F0	; GET YEAR
	LDF	F0,F1
	MULF	K365,F1 	; F1= (365.0 *IY)
	LDCIF	TIMBUF+G.TIDA,F2	; DAY
	ADDF	F2,F1		; F1= (365.0*IY)+DAY
	MOV	TIMBUF+G.TIMO,R1	; MONTH
	DEC	R1		; R1= MONTH-1
	MUL	#37,R1		; R1= (MONTH-1)*31)
	LDCIF	R1,F2		; F2= (MONTH-1)*31)
	ADDF	F2,F1		; F1= (365.0*IY)+DAY+((MONTH-1)*31)
	STF	F1,F		; SAVE IN F
	STF	F1,G		; SAVE IN G
	CMP	TIMBUF+G.TIMO,#2	; IF(MONTH .GT. 2) FEBRUARY
	BLE	L$FAAD			; YES
	LDF	F0,F2
	DIVF	#^F100.0,F2
	STCFI	F2,R2
	MOV	R2,R0
	INC	R0
	LDCIF	R0,F3
	MULF	#^F0.75,F3
	STCFI	F3,R2
	LDF	F0,F3
	MULF	#^F0.25,F3
	STCFI	F3,I2
	LDCIF	TIMBUF+G.TIMO,F1
	MULF	K$4,F1
	ADDF	K2$3,F1
	STCFI	F1,I3
	STF	F0,$TEMPS
	LDCIF	I3,F0
	STF	F2,$TEMPS+4
	LDF	G,F2
	SUBF	F0,F2
	LDCIF	I2,F0
	ADDF	F0,F2
	LDCIF	R2,F0
	SUBF	F0,F2
	STF	F2,G
	STCFI	F1,R0
	LDCIF	R0,F0
	LDF	F,F1
	SUBF	F0,F1
	STCFI	F3,R0
	LDCIF	R0,F0
	ADDF	F0,F1
	LDF	$TEMPS+4,F0
	STCFI	F0,R0
	INC	R0
	LDCIF	R0,F0
	MULF	#^F0.75,F0
	STCFI	F0,R0
	LDCIF	R0,F0
	SUBF	F0,F1
	STF	F1,F
	BR	L$FAOF
L$FAAD:
	MOV	TIMBUF+G.TIYR,R1
	DEC	R1
	MOV	R1,R5
	SXT	R4
	DIV	#144,R4
	MOV	R4,R2
	LDCIF	R2,F1
	MULF	#^F0.75,F1
	LDF	#^F1.0,F2
	ADDF	F2,F1
	STCFI	F1,R2
	TST	R1
	SXT	R0
	DIV	#4,R0
	MOV	R0,I2
	LDCIF	R0,F1
	ADDF	G,F1
	LDCIF	R2,F3
	SUBF	F3,F1
	STF	F1,G
	SUBF	F2,F0
	LDF	F0,F1
	MULF	#^F0.25,F1
	STCFI	F1,R0
	LDCIF	R0,F1
	ADDF	F,F1
	DIVF	#^F100.0,F0
	STCFI	F0,R0
	LDCIF	R0,F0
	MULF	#0.75,F0
	ADDF	F2,F0
	STCFI	F0,R0
	LDCIF	R0,F0
	SUBF	F0,F1
	STF	F1,F
L$FAOF:
	MOV	R2,I1
	LDF	F,F0
	SUBF	K1858,F0
	STF	F0,F
	SETD			; SET DOUBLE PRECISION
	LDCFD	F,F0		; GET VALUE SO FAR IN DOUBLE PRECISON
	MULD	DAYMLT,F0		; CALCULATE MILLASECONDS TO DATE
	STD	F0,XMS		; SAVE CALC. SO FAR
	.PAGE
;
; NOW ADD IN THE HOURS, MINUTES, SECONDS, AND TICKS.
;
	LDCID	TIMBUF+G.TIHR,F1	; GET HOURS
	MULD	HRSMLT,F1		; MULT BY MILLA SECONDS/HOUR
	ADDD	F1,F0			; ADD TO TOTAL
;
	LDCID	TIMBUF+G.TIMI,F1	; GET MINUTES
	MULD	MINMLT,F1		; MULT BY MILLASECONDS/MINUTE
	ADDD	F1,F0
;
	LDCID	TIMBUF+G.TISC,F1	; GET SECONDS
	MULD	SECMLT,F1		; MULT BY MILLASECONDS/SEC
	ADDD	F1,F0
;
	LDCID	TIMBUF+G.TICT,F1	; GET CLOCK TICK OF SECOND
	MULD	TICMLT,F1		; MULT BY MILLASECONDS/TICK
	ADDD	F1,F0
	STD	F0,XMS			; SAVE TOTAL MILLASECONDS
					; SINCE 17-NOV-1858
	.PAGE
;
; MOW CONVERT IT TO 64 BIT INTEGER
; XMS=
;	1 111 11
;	5 432 109 876 543 210  
; XMS   S MMM MMM MMF FFF FFF
; XMS+2 F FFF FFF FFF FFF FFF
; XMS+4 F FFF FFF FFF FFF FFF
; XMS+6 F FFF FFF FFF FFF FFF
;
C64:
	STEXP	F0,R1			; GET UNBIASED EXPONENT
	MOV	R1,EXP			; SAVE THE EXPONENT
	SETF				; SET NORMAL FLOATING ARITH
	BIC	#177600,XMS		; CLEAR EXPONENT
	BIS	#000200,XMS		; SET THE HIDDEN BIT
	SUB	#56.,R1			; DETERMINE HOW MANY BITS TO SHIFT
					; RIGHT THE RESULT (IF
					; WE LEAVE AS IS, IT IS LIKE
					; MULTIPLYING THE FRACTION BY 2**56
	BMI	20$			; IT'S A RIGHT SHIFT, 
;
; LEFT SHIFT, START FROM THE TOP
;
	MOV	XMS,R4			; SHIFT REGISTERS
	MOV	XMS+2,R5		;   "       "
	ASHC	R1,R4
	MOV	R4,XMS
;
	MOV	XMS+2,R4
	MOV	XMS+4,R5
	ASHC	R1,R4
	MOV	R4,XMS+2
;
	MOV	XMS+4,R4
	MOV	XMS+6,R5
	ASHC	R1,R4
	MOV	R4,XMS+4
;
	MOV	XMS+6,R5
	ASH	R1,R5
	MOV	R5,XMS+6
	BR	30$
;
; DO IT FROM THE BOTOM UP, SHIFTING RIGHT
;
20$:
	MOV	XMS+6,R5
	MOV	XMS+4,R4
	ASHC	R1,R4		; SHIFT POOP OFF THE RIGHT END
	MOV	R5,XMS+6
;
	MOV	XMS+4,R5
	MOV	XMS+2,R4
	ASHC	R1,R4
	MOV	R5,XMS+4
;
	MOV	XMS+2,R5
	MOV	XMS,R4
	ASHC	R1,R4
	MOV	R4,XMS
	MOV	R5,XMS+2
;
; R3= ADDRESS TO STORE THE RESULTANT VAX QUAD TIME
;
30$:
	MOV	XMS+4,(R3)+
	MOV	XMS+6,(R3)+
	MOV	XMS+2,(R3)+
	MOV	XMS,(R3)
	SETF			; SET NORML FLOATING LENGTH
	RETURN			; REAL RETURN TO CALLER
	.END	START
