.TITLE  CDKILL
	.IDENT	/V1.1/
;
;  AUTHOR:
;	DAVID M. BERG
;	FERMI NATIONAL ACCELERATOR LABORATORY
;	BATAVIA, IL 60510
;
;  UPDATE HISTORY:
;  V01  -  7AUG84 - DB - ORIGINAL VERSION (RSX ONLY)
;  V1.1 - 31AUG84 - DB - do not emulate completion AST for
;			 receives queued internally by CDPACK
;
; ++
;
;  FUNCTION:
;
;  THIS ROUTINE CANCELS ALL RECEIVES, TRANSMITS, AND SIGNALS QUEUED TO
;  THE CD UNIT NUMBER CORRESPONDING TO THE SPECIFIED CHANNEL, INCLUDING
;  THOSE QUEUED INTERNALLY BY CDPACK WITH QRCV=0.  OPERATIONS IN PROGRESS
;  ARE NOT EFFECTED; ALL OTHERS TERMINATE WITH IE.ABO ERROR STATUS.
;
;  CALLING SEQUENCE:
;  ----------------
;
;  CALL CDKILL(CHAN,STAT)
;
;  MACROS:
;  ------
	.MCALL	RT$RSX
	RT$RSX
;
	.IF	NDF	RT11
;
	.MCALL	CHT$DF,MBL$DF,CDI$DF,ERR$DF
        .MCALL	PUSH,POP,ASSUME,$CM82
	.MCALL	QIOW$S,SETF$S,DSAR$S,ENAR$S
	CHT$DF			;DEFINE CHANNEL TABLE OFFSETS
        MBL$DF                  ;DEFINE MESSAGE BLOCK OFFSETS
	CDI$DF			;DEFINE I/O FUNCTION CODES
	ERR$DF			;DEFINE ERROR RETURNS
;
;
;  GLOBALS:
;  -------
        .GLOBL  CDKILL		;ROUTINE ENTRY POINT
	.GLOBL	$FNDCH		;SUBROUTINE TO FIND CHANNEL TABLE ENTRY
	.GLOBL	$DSW
	.PAGE
;
;  INPUTS TO ROUTINE 
;  -----------------
;	R5 IS THE ADDRESS OF A FORTRAN ARGUMENT LIST
;
;  OUTPUTS
;  -------
;	STATUS IS RETURNED IN STATUS ARGUMENT
;
;
;  COMMON AREA CDCM82
;  ------------------
	$CM82			;DEFINE PSECT CDCM82
;
;  COMMON FOR ERROR IN NO. OF ARGUMENTS
;
	.PSECT	CDERR,RW,GBL,D,OVR,REL
CDERR:  .BLKW
	.PSECT
;
;
        ASSUME  MB.CUR,0                ;STATUS ASSUMED TO BE 1ST
					;WORD OF MESSAGE BLOCK
;
CDKILL::
	PUSH	<R0,R1,R2,R3,R4,R5>	;SAVE REGISTERS
	MOV	@2(R5),R1		;CHANNEL NUMBER
	CALL	$FNDCH			;LOOK FOR CHANNEL BLOCK
	TST	R5			;FOUND IT?
	BEQ	XNOCHN			;ERROR IF NOT
	MOVB	CH.FLG(R5),R2		;EVENT FLAG USED TO WAIT
	SUB	#4,SP			;ALLOCATE I/O STATUS BLOCK ON STACK
	MOV	SP,R3			;ADDRESS OF STATUS BLOCK
	QIOW$S	#IO.KIL,R1,R2,,R3	;ISSUE CANCEL FUNCTION
	BCC	5$			;DIRECTIVE ERROR?
	ADD	#4,SP			;CLEAN OFF STACK
	BR	XDRERR
;
5$:	MOVB	(R3),R4			;STATUS AFTER COMPLETION
	ADD	#4,SP			;CLEAN OFF STACK
	CMP	#ER.SUC,R4		;SUCCESS?
	BNE	EXIT			;QUIT IF ERROR
;
	MOV	CD.NUM,R0		;NUMBER OF MB'S IN TABLE
	BEQ	EXIT			;QUIT IF THERE ARE NONE
	MOVB	CH.UNT(R5),R1		;DEVICE UNIT NUMBER
	MOV	#CD.MBL,R5		;ADDRESS OF START OF MB TABLE
;
	DSAR$S				;DISABLE AST RECOGNITION
;
; LOOP OVER ALL MESSAGE BLOCKS IN TABLE
;
10$:	CMPB	R1,MB.UNT(R5)		;MATCHING UNIT NUMBER?
	BNE	20$			;BRANCH IF NOT
	BIT	#S.WRCV,(R5)		;MATCHING STATUS BIT?
	BEQ	20$			;BRANCH IF NOT
;
; FOUND A RECEIVE MESSAGE BLOCK QUEUED TO THIS UNIT
	BIC	#S.WRCV,(R5)		;NO LONGER WAITING FOR RECEIVE
	MOVB	#IE.ABO,MB.ST1(R5)	;SET ABORT STATUS
	MOVB	MB.FLG(R5),R3		;EVENT FLAG TO BE SET
	SETF$S	R3			;SET EVENT FLAG
;
20$:	ADD	#MB.SIZ,R5		;POINT TO NEXT MESSAGE BLOCK
	SOB	R0,10$			;  AND TRY AGAIN
;
	ENAR$S				;ENABLE AST RECOGNITION
	BR	EXIT
;
XNOCHN:	MOV	#ER.CHN,R4		;CHANNEL NOT FOUND
	BR	EXIT
;
XDRERR:	MOV	$DSW,R4			;DIRECTIVE ERROR
	BR	EXIT
;
EXIT:	POP	<R5>			;RESTORE ARGUMENT POINTER
	MOV	R4,@4(R5)		;RETURN STATUS
	POP	<R4,R3,R2,R1,R0>	;RESTORE OTHER REGISTERS
	RETURN
;
	.ENDC
;
	.END