.TITLE	WHE
;	PROGRAM WHERE
;	WRITTEN BY:	FRANK PENNER
;			JUNE 1980
;	THIS RSX-11M PRIVILEGED TASK WILL DISPLAY
;	THE ERROR TRACE BACK INFORMATION FOR THE
;	GIVEN FORTRAN TASK
;	TO USE, TYPE:
;	WHE TASK
;	WHERE TASK IS THE NAME OF THE TASK TO LOOK AT
	.MCALL	QIOW$,EXST$,DIR$
	.MCALL	TCBDF$,CALL,RETURN,GMCR$
	.MCALL	DCBDF$,HDRDF$,HWDDF$,PCBDF$
	TCBDF$				;DEFINE TCB OFFSETS
	DCBDF$				;DEFINE DCB OFFSETS
	HDRDF$				;DEFINE TASK HEADER OFFSETS
	HWDDF$				;DEFINE HARDWARE OFFSETS
	PCBDF$				;DEFINE PCB OFFSETS
EXITB:	EXST$	EX$SUC			;DPB FOR EXIT WITH STATUS
GMCR:	GMCR$
	TSKNAM	=GMCR+G.MCRB+4		;START OF TYPED INPUT TASKNAME
TSKNAR:	.BLKW	2			;SPACE FOR RAD 50 TASKNAME
IOST:	.BLKW	2			;I/O STATUS BLOCK
QIODPB:	QIOW$	IO.WLB,TLUN,TEFL,,IOST,,<OUTBUF,0,VFC>
	TLUN=	5
	TEFL=	2
	VFC=	40
OUTBUF:	.BLKB	132.
	MAX=20				;MAX TRACE BACK DEPTH
ARGBLK:					;ARGUMENT BLOCK FOR EDMSG ROUTINE
	.REPT	MAX
	.WORD	0			;1ST WORD IS STATEMENT NUMBER
	.WORD	0,0			;2 AND 3 ARE PROG UNIT NAME IN RAD50
	.ENDR
ISTRNG:	.ASCIZ	/%D  %2R/
	.EVEN
UISAR1	=177642				;DEFINE SYMBOL FOR USER APR 1
UISAR2	=177644				;DEFINE SYMBOL FOR USER APR 2
SAVEM0:	.BLKW	1			;SPACE TO SAVE MEMORY MANAGEMENT REGS
SAVEM1:	.BLKW	1			;SPACE TO SAVE APR'S 0 AND 1
SAVEM2:	.BLKW	1			;SPACE TO SAVE APR 2
	.EVEN
START:
	DIR$	#GMCR			;PICK UP COMMAND LINE
	MOV	#TSKNAM,R0		;ADDRESS OF ASCII STRING TO CONV
	MOV	#1,R1			;SPECIFY . AS VALID CHAR
	CALL	$CAT5			;DO ASCII TO RAD 50 CONV
	BCC	.+6			;IF C CLEAR SUCCESS
	JMP	ERROR			;IF C SET ERROR
	MOV	#TSKNAR,R3		;POINT R3 TO SPACE FOR OUTPUT
	MOV	R1,(R3)+		;STORE RAD 50 IN BUFFER
	MOV	#1,R1			;SET R1 AGAIN
	CALL	$CAT5			;DO SECOND 3 CHARS
	MOV	R1,(R3)+		;STORE THESE TOO
	MOV	#TSKNAR,R3		;POINT TO RAD50 TASKNAME
	CALL	SRATD			;FIND TCB  (TCB ADD==>R0)
	BCC	.+6			;C CLEAR IS SUCCESS
	JMP	ERROR			;TASK NOT ACTIVE
	BIT	#TS.OUT,T.STAT(R0)	;IS TASK OUT OF MEMORY?
	BEQ	.+6			;TASK IN MEMORY, SO CONTINUE
	JMP	EXIT			;TASK OUT OF MEMORY, SO QUIT
	MOV	#ARGBLK,R5		;POINT R5 TO ARGUMENT BLOCK FOR EDMSG
	MOV	T.PCB(R0),R1		;POINT R1 TO PCB
	MOV	P.HDR(R1),R0		;POINT R0 TO TASK HEADER
	MOV	H.FORT(R0),R2		;POINT R2 TO FORTRAN OTS WORK AREA
	BEQ	ERROR			;IF NULL PTR THEN ERROR
	MOV	R2,R3			;R3 ALSO
	ASH	#-6,R3			;SHIFT ADDRESS TO GET 32 WORD BLOCK
	BIC	#176177,R3		;MASK OFF ASH SIGN EXTEND AND ==> APR
	MOV	P.REL(R1),R4		;GET PHYSICAL START OF TASK
	ADD	R3,R4			;ADD OFFSET FOR OUR ADDRESS
	BIC	#160000,R2		;MAKE OUR ADDRESS APR 0
	MOV	@#UISAR0,SAVEM0		;SAVE MEM MAGMT REG APR 0
	MOVB	#1,$CXDBL		;DISABLE CONTEXT SWITCHING
	MOV	R4,@#UISAR0		;MAP APR 1 TO TASK ADDRESS
	MOV	(R2)+,(R5)+		;GET CURRENT STATEMENT #
	MOV	(R2),R4			;GET LISTHEAD FOR TRACEBACK CHAIN
	BNE	1$			;GO FOR IT IF VALID LISTHEAD
	MOV	SAVEM0,@#UISAR0		;RESTORE MAPPING
	CLRB	$CXDBL			;RENABLE CONTEXT SWITCHING
	BR	ERROR			;NULL LIST HEAD SO ERROR
1$:	MOV	P.REL(R1),@#UISAR0	;PUT PHYSICAL START OF TASK IN APR 0
					;ASSUME SINCE TRACE BACK CHAIN ON STACK
					;THAT IT CAN BE MAPPED WITH APR0
2$:	MOV	(R4)+,R3		;SAVE PTR TO NEXT IN TRACEBACK CHAIN
	MOV	(R4)+,R2		;SAVE SATEMENT NUMBER AND
	MOV	(R4)+,(R5)+		;SAVE RAD50 PROG UNIT NAME
	MOV	(R4)+,(R5)+		;IN EDMSG ARGUMENT BLOCK
	MOV	R3,R4			;POINT R4 TO NEXT BLK IN CHAIN
	BEQ	3$			;IF 0; THEN NO MORE BLK IN CHAIN
	MOV	R2,(R5)+		;PUT SEQUENCE # IN ARGBLK
	BR	2$			;LOOP TILL DONE
3$:	MOV	SAVEM0,@#UISAR0		;RESTORE MAPPING
	CLRB	$CXDBL			;RENABLE CONTEXT SWITCHING
					;WE ARE DONE COLLECTING THE INFO
					;NOW WE PRINT IT OUT
	MOV	#ARGBLK,R2		;ARGUMENT BLOCK FOR EDMSG
4$:	MOV	#OUTBUF,R0		;ADDRESS OF OUTPUT BUFFER FOR EDMSG
	MOV	#ISTRNG,R1		;INPUT STRING FOR EDMSG
	CALL	$EDMSG			;CALL EDIT MESSAGE ROUTINE
	MOV	R1,QIODPB+Q.IOPL+2	;SIZE OF MESSAGE TO PRINT
	DIR$	#QIODPB			;PRINT OUT TRACE BLK ON TERMINAL
	CMP	R5,R2			;ALL DONE WITH TRACEBACK BLKS ?
	BNE	4$			;LOOP TILL DONE
	BR	EXIT			;THAT'S ALL FOLKS
ERROR:
	MOV	#EX$WAR,EXITB+E.XSTS	;SET WARNING STATUS
EXIT:	DIR$	#EXITB			;EXIT WITH STATUS
SRATD:					;SEARCH ACTIVE TASK DIRECTORY
					;STOLEN FROM EXEC $SRSTD
	MOV	$ACTHD,R0		;POINT TO FIRST TCB IN LIST
10$:	CMP	T.NAM(R0),(R3)		;FIRST HALF OF NAME MATCH ?
	BNE	20$			;IF NE NO
	CMP	T.NAM+2(R0),2(R3)	;SECOND HALF OF NAME MATCH ?
	BEQ	30$			;IF EQUALS YES
20$:	MOV	T.ACTL(R0),R0		;GET LINK TO NEXT TCB
	TST	T.ACTL(R0)		;NULL TASK ?
	BNE	10$			;IF NOT EQUALS NO
	SEC				;INDICATE FAILURE
30$:	RETURN				;END OF SEARCH ACTIVE TASK DIRECTORY
	.END	START