.TITLE	DMPCOR - DUMP ABORTING TASK.
	.IDENT	-000200-
	.SBTTL	TITLE PAGE
;+
; ABSTRACT:	DMPCOR
;
;	THIS SUBROUTINE TO .TKTN. WILL DUMP THE CORE OF AN ABORTING
; TASK. ALL REGISTERS ARE PRESERVED.
;
; CALLING SEQUENCE:
;
;	CALL DMPCOR
;
;	R0 IS ASSUMED TO POINT TO THE TASK'S ATL ENTRY.
;
; NONSTANDARD FEATURES:
;
;	MUST HAVE PRIVILEGED MAPPING RIGHTS!
;
; WRITTEN: BRUCE C. WRIGHT, -0.0.0-, 18-JUN-77
; MODIFIED: BRUCE C. WRIGHT, -0.0.1-, 20-OCT-77
;	ADDED OPTION FOR UIC IN HEADER TO OWN FILE.
; MODIFIED: BRUCE C. WRIGHT, -0.1.0-, 29-APR-79
;	ADDED RAY FRENCH'S CHANGES FOR IAS V3.0
;		1. CHANGED SYMBOL G.FB TO G.FW
;		2. REMOVED SF.24 SYMBOL TEST
;		3. CHANGED SYMBOL S.GC TO S.PA
; MODIFIED: BRUCE C. WRIGHT, -0.2.0-, 19-SEP-80
;	CHANGED FOR IAS V3.1:
;		1. USE A.TZ FOR TASK SIZE
; VERIFIED: BRUCE C. WRIGHT, -0.2.0-, 19-SEP-80
;-

	.SBTTL	MACRO CALLS
;
	.MCALL	CALL,RETURN
	.MCALL	FDBDF$,FSRSZ$,FINIT$
	.MCALL	FDAT$A,FDRC$A,FDOP$A,FDBF$A
	.MCALL	OPEN$W,PUT$,CLOSE$
	.MCALL	QIOW$,DIR$
;
	.MACRO	SAVE
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	.ENDM
;
	.MACRO	UNSAVE
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	.ENDM
;
	.SBTTL	DISK UNIT AND MISC. EQUATES
;
APR3OF	=	60000		;OFFSET FOR APR3 MAPPING.
TTYLUN	=	2
TTYEVF	=	2
DSKLUN	=	4		;LUN FOR THE DISK
DSKEVF	=	4		;EVENT FLAG FOR DISK.

;
; DEFINE THE FOLLOWING SYMBOL TO HAVE TASKS DUMPED ONLY IF
; THEY HAD PREVIOUSLY REQUESTED IT BY ASSIGNING A DUMMY LUN
; TO A PSEUDO-DEVICE "AB:". LEAVE OUT THE DEFINITION
; TO DUMP ALL ABORTING TASKS.
;
;ABDEV	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO PLACE ALL DUMPS INTO [1,7].
; LEAVE OUT THE DEFINITION TO PLACE THE DUMP INTO THE USER'S
; DIRECTORY. IN ANY CASE, THE USER WILL OWN THE FILE.
;
UIC1.7	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO HAVE ALL DUMPS NAMED
; FOR THE ABORTING TASK. LEAVING IT OUT WILL NAME ALL DUMPS
; CORE.DMP. DEFINING THE SYMBOL WILL TAKE MORE ADDRESS SPACE.
;
TSKFIL	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO DUMP TASKS ABORTED WITH
; THE ABRT$ DIRECTIVE OR THE MCR ABO COMMAND. LEAVE THE
; SYMBOL OUT TO BYPASS THE DUMP FOR AN ABRT$ ABORT.
;
;MCRDMP	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO DUMP TASKS ABORTED WITH
; THEIR TIME LIMIT EXCEEDED. LEAVE THE SYMBOL OUT TO BYPASS
; DUMPS FOR TASKS ABORTING FOR TIME LIMIT EXCEEDED.
;
;TMODMP	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO DUMP ABORTING TASKS' READ-
; ONLY AREA. IF THIS IS NOT SPECIFIED, THE R-O AREA WILL
; NOT BE DUMPED. THE SYSTEM TABLES WILL BE DUMPED ANYWAY.
; THIS IS NORMALLY ONLY INTERESTING IF STRANGE HARDWARE
; ERRORS ARE OCCURRING AS "ODD ADDRESS TRAP" OR "RESERVED
; INST TRAP" ABORTS AND NOT AS SYSTEM CRASHES OR ERRORS.
;
;ROADMP	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO DUMP COMMON AREAS.
; IF THIS IS NOT SPECIFIED, THEY WILL NOT BE DUMPED.
;
COMDMP	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO DUMP LIBRARIES.
; IF THIS IS NOT SPECIFIED, THEY WILL NOT BE DUMPED.
; MOST OF THE COMMENTS ABOUT READ-ONLY AREAS APPLY
; AS WELL TO LIBRARIES: THIS IS PROBABLY NOT INTERESTING
; UNLESS STRANGE HARDWARE ERRORS ARE OCCURRING.
;
;LIBDMP	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO GENERATE A MODULE TO BE
; USED WITH A PATCHED OBJECT FILE. LEAVE THE SYMBOL OUT IF
; THE PATCH APPLIED TO .TKTN. IS A SOURCE LEVEL PATCH.
;
;PATCH	=	1
;
; DEFINE THE FOLLOWING SYMBOL TO HAVE THE DUMP OWNED BY THE
; UIC IN THE TASK HEADER;  OTHERWISE IT WILL BE OWNED BY THE
; UIC IN THE PUD. THE SECOND OPTION TAKES SLIGHTLY LESS CODE
; UNLESS "ABDEV" IS SPECIFIED;  THE FIRST IS THE WAY FCS WORKS.
;
;UICHDR	=	1
;
; SELECT A TARGET SYSTEM FROM THE FOLLOWING OPTIONS:
;	0 - RSX-11D V6.2 OR IAS V2.2 OR EARLIER
;	1 - IAS V3.0
;	2 - IAS V3.1
;
S$$STM	=	2

	.SBTTL	FCS INITIALISATION.
;
DMPINI::
	FINIT$			;INIT FCS
	.IF DF	PATCH
	MOV	(SP)+,R0	;RECOVER RETURN ADDRESS.
	MOV	@#PS.EXP,-(SP)	;SAVE PSW
	JMP	(R0)		;AND RETURN.
	.IFF
	RETURN
	.ENDC
;
	.SBTTL	MAIN LINE CODE
;
DMPCOR::
	.IF DF	PATCH
	CALL	TYPREG		;TYPE LAST REG.
	.ENDC
	SAVE			;SAVE ALL REGISTERS.
	MOV	R0,R5		;R5 -> ATL ADDRESS.
	.IF DF	ABDEV		;IF ABORT DEVICE TO BE SUPPORTED
	MOV	#77406,-(SP)	;MAP INTO HEADER.
	MOV	A.HA(R5),-(SP)
	CALL	@#..SPD3	;SWAP APR3.
	CMP	(SP)+,(SP)+	;CLEAN STACK.
	MOV	#H.LUT+APR3OF,R1 ;POINT TO THE LUN AREA.
	MOV	(R1)+,R0	;GET THE # OF LUNS.
	BEQ	10$		;SKIP IF NONE.
5$:	MOV	(R1)+,R2	;GET THIS PUD ADDRESS.
	CMP	R2,.PUDBA	;TOO LOW?
	BLO	8$		;YES
	CMP	R2,.PUDEA	;TOO HIGH?
	BHIS	8$		;YES
	CMP	U.DN(R2),#"AB	;THIS IS DEVICE AB:?
	BEQ	20$		;YES
8$:	TST	(R1)+		;SKIP OVER A WORD.
	SOB	R0,5$		;AND LOOP.
10$:	JMP	RETRN		;AND LEAVE IF NOT FOUND.
20$:
	.ENDC
	.IF NDF	MCRDMP		;IF NO DUMP FOR MCR MODE
	CMPB	A.FM+0(R5),#TN.ABO ;ABORTED VIA DIRECTIVE?
	BNE	30$		;LEAVE IF SO.
	JMP	RETRN
30$:
	.ENDC
	.IF NDF	TMODMP		;IF NO DUMP FOR TIME LIMIT
	CMPB	A.FM+0(R5),#TN.TIO ;ABORTED AT LIMIT?
	BNE	40$		;YES -- LEAVE
	JMP	RETRN
40$:
	.ENDC
	MOV	A.TI(R5),R4	;GET TASK'S TI.
	.IF DF	UICHDR
	.IF NDF	ABDEV
	MOV	#77406,-(SP)	;SAVE PDR
	MOV	A.HA(R5),-(SP)	;SAVE PAR
	CALL	@#..SPD3	;SWAP PDR 3
	CMP	(SP)+,(SP)+	;CLEAN UP STACK.
	.ENDC
	MOV	H.UIC+APR3OF,R1	;GET THE UIC.
	.IFF
	MOV	U.UI(R4),R1	;GET INTO R1.
	.ENDC
	CALL	.WFOWN		;MAKE IT NEW FILE OWNER.
	.IF NDF	UIC1.7
	MOV	#DIRSTR,R2	;POINT TO NEW DIRECTORY STRING.
	.IF DF	UICHDR
	MOV	H.UIC+APR3OF,R3	;GET THE UIC.
	.IFF
	MOV	U.UI(R4),R3
	.ENDC
	CLR	R4
	CALL	.PPASC		;CREATE DEFAULT DIR.
	SUB	#DIRSTR,R2
	MOV	R2,DSPT+4	;SAVE NEW STRING LENGTH.
	.ENDC
	.IF DF	TSKFIL
	MOV	A.TD(R5),R4	;GET THE STD ENTRY.
	MOV	#TMPSTR,R0	;POINT TO THE NAME.
	MOV	S.TN(R4),R1	;GET RAD50 1
	CALL	$C5TA		;CONVERT TO ASCII
	MOV	S.TN+2(R4),R1
	CALL	$C5TA		;GET WHOLE NAME.
	MOV	#TMPSTR,R0	;GET TMP STRING.
	MOV	#NAMSTR,R1	;AND NAME STRING.
	MOV	#6,R2
50$:	CMPB	(R0),#' 	;IS IT A BLANK?
	BEQ	60$		;YES -- SKIP
	CMPB	(R0),#'$	;
	BEQ	60$
	CMPB	(R0),#'.	;IS IT A .?
	BEQ	60$
	MOVB	(R0),(R1)+	;MOVE DATA.
60$:	INC	R0
	SOB	R2,50$		;AND LOOP.
	MOVB	#'.,(R1)+
	MOVB	#'D,(R1)+
	MOVB	#'M,(R1)+
	MOVB	#'P,(R1)+
	SUB	#NAMSTR,R1	;COMPUTE LENGTH OF NAME,
	MOV	R1,DSPT+10	;AND MOVE INTO DESCRIPTOR.
	.ENDC
	OPEN$W	#FDB		;OPEN THE FDB.
	BCS	BADFDB		;OUT ON ERROR.
	MOV	A.TD(R5),R4	;GET THE ADDRESS OF THE STD.
	.IF LE	S$$STM-1	; IF IAS V3.0 OR EARLIER ...
	MOV	S.TZ(R4),R1	;GET THE TASK SIZE.
	.IFF			; OTHERWISE, ON IAS V3.1 ...
	MOV	A.TZ(R5),R1	; GET THE CURRENT TASK SIZE.
	.ENDC	;S$$STM
	MOV	A.HA(R5),R4
	PUT$	R0,R5		;FIRST PRINT THE ATL ENTRY.
	BCS	BADFIL		;LEAVE ON ERROR.
	PUT$	R0,A.TD(R5)	;WRITE THE TASK'S STD ENTRY.
	BCS	BADFIL
	PUT$	R0,A.RQ(R5)	;WRITE STD OF REQUESTOR.
	BCS	BADFIL
	PUT$	R0,A.PD(R5)	;WRITE PARTITION BLOCK
	BCS	BADFIL
	PUT$	R0,A.TI(R5)	;WRITE PUD ADDRESS.
	BCS	BADFIL
LOOP:	MOV	#77406,-(SP)	;SET UP TO ADDRESS TASK R/W AREA
	MOV	R4,-(SP)	;SAVE CURRENT ADDR IN IMAGE.
	CALL	@#..SPD3	;SWAP REGISTERS.
	CMP	(SP)+,(SP)+	;POP FROM STACK.
	PUT$	R0,#APR3OF	;WRITE THE BLOCK.
	BCS	BADFIL
	INC	R4		;BUMP ADDRESS POINTER.
	SOB	R1,LOOP		;AND LOOP.
	.IF EQ	S$$STM		; SGA DUMPS ARE CURRENTLY ONLY
				; SUPPORTED ON RSX-11D V6.2 AND
				; IAS V2.2 AND EARLIER!
	.IF DF	ROADMP!COMDMP!LIBDMP
	MOV	A.TD(R5),R4	;GET THE TASK STD ADDRESS.
	MOV	#3.,R2		;MAX OF 3. GCD NODES.
	BIT	#SF.24,S.FW(R4)	;IS IT THE LONG FORM?
	BEQ	10$		;NO -- SKIP.
	MOV	#7.,R2		;YES -- SET LONG LIMIT.
10$:	ADD	#S.PA,R4	;001 POINT TO PUD PTRS
PUADLP:	TST	(R4)		;END OF LIST
	BEQ	FINI		;YES
	MOV	(R4)+,R3	;RECOVER READ-ONLY AREA
	.IF NDF	ROADMP
	TST	(R3)		;IS THIS THE R/O AREA?
	BEQ	PUADEN		;YES
	.ENDC
	.IF NDF	LIBDMP
	BIT	#GF.LI,G.FW(R3)	;+001 A LIBRARY?
	BNE	PUADEN		;YES -- DON'T DUMP.
	.ENDC
	.IF NDF	COMDMP
	BIT	#GF.LI,G.FW(R3)	;+001 IS THIS A COMMON AREA?
	BEQ	PUADEN		;YES
	.ENDC
	PUT$	R0,R3		;OUTPUT THE GCD NODE.
	BCS	BADFIL		;CHECK ERROR CODE.
	MOV	G.CZ(R3),R1	;GET SIZE
	MOV	G.BA(R3),R3	;GET MEM ADDR
PUOLOP:	MOV	#77406,-(SP)	;SET UP TO ADDRESS TASK R/W AREA
	MOV	R3,-(SP)	;SAVE CURRENT ADDR IN IMAGE.
	CALL	@#..SPD3	;SWAP REGISTERS.
	CMP	(SP)+,(SP)+	;POP FROM STACK.
	PUT$	R0,#APR3OF	;WRITE THE BLOCK.
	BCS	BADFIL
	INC	R3		;BUMP ADDRESS POINTER.
	SOB	R1,PUOLOP	;AND LOOP
PUADEN:	SOB	R2,PUADLP
FINI:
	.ENDC
	.ENDC	;S$$STM
	DIR$	#$DMPD		;PRINT DUMPED MESSAGE.
CLOSE:	CLOSE$	R0		;CLOSE THE FILE.
RETRN:	UNSAVE			;UNSAVE ALL REGISTERS
	RETURN			;AND LEAVE.
BADFIL:	MOV	#CLOSE,R5	;GET RETURN ADDR
	BR	PRIOER
BADFDB:	MOV	#RETRN,R5	;GET RETURN ADDR
PRIOER:	MOVB	FDB+F.ERR,R1	;GET STATUS ...
	BLT	10$		;SKIP IF OK.
	CLR	R1
10$:	CLR	R0
	NEG	R1
	DIV	#10.,R0		;GET INTO NORMAL FORMAT.
	ADD	#'0,R1
	ADD	#'0,R0
	MOVB	R0,IOEFCS
	MOVB	R1,IOEFCS+1
	MOV	@#$DSW,R1
	BLE	20$
	CLR	R1
20$:	CLR	R0		;PREPARE TO MAKE INTO DECIMAL
	DIV	#10.,R0
	ADD	#'0,R1
	ADD	#'0,R0
	MOVB	R0,IOEDSW
	MOVB	R1,IOEDSW+1
	DIR$	#$IOERR
	JMP	(R5)		;AND LEAVE

	.SBTTL	DATA AREA
;
$DMPD:	QIOW$	IO.WVB,TTYLUN,TTYLUN,,,,<DMPMSG,DMPLEN,40>
DMPMSG:	.ASCII	/CORE DUMPED/
DMPLEN	=	.-DMPMSG
	.EVEN
$IOERR:	QIOW$	IO.WVB,TTYLUN,TTYLUN,,,,<IORMSG,IORLEN,40>
IORMSG:	.ASCII	/CORE DUMP FAILED, FCS -/
IOEFCS:	.ASCII	/  , DSW -/
IOEDSW:	.ASCII	/  /
IORLEN	=	.-IORMSG
	.EVEN
	FSRSZ$	1
FDB:	FDBDF$
	FDAT$A	R.FIX,,100,-10,-10
	FDRC$A	,,100
	FDOP$A	DSKLUN,DSPT
	FDBF$A	DSKEVF
DSPT:	.WORD	DEVLEN,DEVSTR
	.WORD	DIRLEN,DIRSTR
	.WORD	NAMLEN,NAMSTR
DEVSTR:	.ASCII	/SY0:/
DEVLEN	=	.-DEVSTR
	.IF NDF	TSKFIL
NAMSTR:	.ASCII	/CORE.DMP/
NAMLEN	=	.-FILSTR
	.EVEN
	.IFF
TMPSTR:	.BLKB	6.
NAMSTR:	.BLKB	10.
NAMLEN	=	0
	.ENDC
	.IF DF	UIC1.7
DIRSTR:	.ASCII	/[1,7]/
DIRLEN	=	.-DIRSTR
	.IFF
DIRSTR:	.BLKB	10.
DIRLEN	=	0
	.ENDC
	.EVEN
	.END