.TITLE	SNAP
;
;	This module will take a snapshot dump of another task.
;
	.MACRO	SNAP1$	CTL,EFN,ID,L1,H1,L2,H2,L3,H3,L4,H4,?LBL1,?LBL2
	.MCALL	SNPDF$,WTSE$S,SDAT$S,RQST$S,CLEF$S
	SNPDF$
	.IIF NB	<CTL>,	MOV	CTL,..SPBK+SB.CTL
	CLR	..SPBK+SB.EFN
;	.IIF NB	<EFN>,	MOV	EFN,..SPBK+SB.EFN
	.IIF NB	<ID>,	MOV	ID,..SPBK+SB.ID
	MOVB	@#$DSW,..SPBK+SB.DSW	;MOVE REQUESTING TASK'S DSW TO SNAP BLOC
...SNP = SB.LM1
	.IRP	X,<L1,H1,L2,H2,L3,H3,L4,H4>
	.IF NB	<X>
	MOV	X,..SPBK+...SNP
	.ENDC
...SNP = ...SNP+2
	.ENDM
;	CLEF$S	..SPBK+SB.EFN
;	BCS	LBL2
	SDAT$S	#..SPBK+SB.PMD,#..SPBK
	BCS	LBL2
	CALL	SWPTSK
	RQST$S	#..SPBK+SB.PMD
	BCC	LBL1
	CMP	#IE.ACT,@#$DSW
	BEQ	LBL1
	SEC
	BR	LBL2
LBL1:
;	WTSE$S	..SPBK+SB.EFN
LBL2:
	.ENDM	SNAP1$
	.MCALL	TCBDF$,SNPBK$,QIOW$S,EXIT$S
	TCBDF$
;
;	Data
;
OUT1:	.ASCII	<12><15>/Taskname > /
OUTL1=.-OUT1
OUT2:	.ASCII	<12><15>/ID (Dec) > /
OUTL2=.-OUT2
OUT3:	.ASCII	<12><15>/Low Address (Oct) > /
OUTL3=.-OUT3
OUT4:	.ASCII	<12><15>/High Address (Oct) > /
OUTL4=.-OUT4
	.EVEN
INBUF:	.BLKB	8.
TASK:	.BLKW	2
IOSB:	.BLKW	2
ID:	.WORD
LOW:	.BLKW	4
HIGH:	.BLKW	4
X=SC.HDR!SC.LUN!SC.STK!SC.OVL!SC.WRD!SC.BYT
	SNPBK$	SY,0,X,1,1
;
;
;	First we get the necessary parameters.
;
SNAP:
	CLR	INBUF		; Clear the input buffer
	CLR	INBUF+2
	CLR	INBUF+4
	CLR	INBUF+6		;
	QIOW$S	#IO.WLB,#5,#1,,,,<#OUT1,#OUTL1,#0>
				; Ask the first question
	QIOW$S	#IO.RLB,#5,#1,,#IOSB,,<#INBUF,#8.>
				; Get the Answer
	MOV	#INBUF,R0	; Convert to upper case
	MOV	R0,R1		;
	MOV	#6,R2		;
	CALL	$CVTUC		;
	MOV	#INBUF,R0	; Convert taskname to RAD50
	MOV	#1,R1		; Period is valid (as in ...MCR)
	CALL	$CAT5		; Convert it
	MOV	R1,TASK		; Store it
	MOV	#1,R1		; Period is valid (as in ...MCR)
	CALL	$CAT5		; Convert it
	MOV	R1,TASK+2		; Store it
	CLR	INBUF		; Clear the input buffer
	CLR	INBUF+2
	CLR	INBUF+4
	CLR	INBUF+6		;
	QIOW$S	#IO.WLB,#5,#1,,,,<#OUT2,#OUTL2,#0>
				; Ask the second question
	QIOW$S	#IO.RLB,#5,#1,,#IOSB,,<#INBUF,#8.>
				; Get the Answer
	MOV	#INBUF,R0	; Convert the ID to a number
	CALL	$CDTB		;
	MOV	R1,ID		;
	MOV	#4,R5		; Possibly 4 memory ranges
	CLR	R4		; And initialise offset
;
10$:
	CLR	INBUF		; Clear the input buffer
	CLR	INBUF+2
	CLR	INBUF+4
	CLR	INBUF+6		;
	QIOW$S	#IO.WLB,#5,#1,,,,<#OUT3,#OUTL3,#0>
				; Ask the third question
	QIOW$S	#IO.RLB,#5,#1,,#IOSB,,<#INBUF,#8.>
				; Get the Answer
	TST	IOSB+2		; Any Input?
	BEQ	20$		; If eq no - exit at once
	MOV	#INBUF,R0	; Convert the low address to a number
	CALL	$COTB		;
	MOV	R1,LOW(R4)	;
	CLR	INBUF		; Clear the input buffer
	CLR	INBUF+2
	CLR	INBUF+4
	CLR	INBUF+6		;
	QIOW$S	#IO.WLB,#5,#1,,,,<#OUT4,#OUTL4,#0>
				; Ask the fourth question
	QIOW$S	#IO.RLB,#5,#1,,#IOSB,,<#INBUF,#8.>
				; Get the Answer
	MOV	#INBUF,R0	; Convert the high address to a number
	CALL	$COTB		;
	MOV	R1,HIGH(R4)	;
	ADD	#2,R4		; No - increment offset
	DEC	R5		; Any more?
	BLE	20$		; If le no
	JMP	10$		; Yes
;
20$:
	SNAP1$	#X,,ID,LOW,HIGH,LOW+2,HIGH+2,LOW+4,HIGH+4,LOW+6,HIGH+6
	EXIT$S
;
SWPTSK:
	CALL	$SWSTK,70$	;;; SWITCH TO SYSTEM STATE
	MOV	$TSKHD,R5
;
10$:
	CMP	#^RPMD,T.NAM(R5)
	BNE	20$		;;; BR IF NOT REQUIRED 'TCB'
	CMP	#^R...,T.NAM+2(R5)
	BEQ	30$		;;; TASK FOUND
;
20$:
	MOV	T.TCBL(R5),R5
	BNE	10$		;;; CONTINUE SCAN IF NOT END-OF-LIST
	BR	60$
;
;*****
;*****	CHECK THE RECEIVE DATA QUEUE OF THE TASK
;*****	IF THIS QUEUE IS EMPTY THEN THE REPORT QUEUE IT EMPTY
;*****
;
30$:
	MOV	T.RCVL(R5),R5
	BNE	40$		;;; BR IF QUEUE NOT EMPTY
	BR	60$
;
;*****
;*****	NOW HAVE THE PRINT SPOOLER QUEUE LIST
;*****	THE RELEVANT INFORMATION FROM EACH PACKET IS COPIED TO
;*****	TO A DATA BUFFER. A MAXIMUM ON "LSTSZ" PACKETS CAN BE
;*****	CATERED FOR.
;*****
;
40$:
	MOV	TASK,2(R5)	;;; Change Sender Task Name
	MOV	TASK+2,4(R5)	;;;
60$:
	RETURN
;
70$:
	RETURN
	.END	SNAP