.title	UWD	Template User Written Debugger
;++
; Creation date: 08-Nov-88
; Author:	 Nick de Smith
;
; Description:
;
; This is a template user written debugger. It is linked
; into your program with commands of the form:
;
;	$ Link file-name,... /Debug=UWD
;
; UWD gains control before the main program is executed, and
; when a SYS$EXIT occurs.
; UWD declares an exit handler, transfers control to the user
; program, and then re-gains control when the user program
; terminates in some way.
; UWD correctly handles the transfer vector such that all
; required initialisation routines are called.
; The template does nothing else.
;
; Edit	Edit date	By	Why
;  01	04-Jan-89	NMdS	First attempt
;--
	.ident	"V01.01"

	.library	"SYS$LIBRARY:LIB"
	.link		"SYS$SYSTEM:SYS.STB"/Selective_Search

	$ihadef				; Image activation offsets
	$sfdef				; Stack frame offsets
	$stsdef				; Status message bits

	.subtitle	UWD data area

	.psect	$DATA, Rd, Wrt, NoExe, NoShr

uwd_start:
	.ascid	/%UWD-I-STARTING, User written debugger starting/
uwd_end:
	.ascid	/%UWD-I-FINALSTS, User's final exit status:/
uwd_exit_called:
	.ascid	/%UWD-I-SYS$EXIT, User program called SYS$EXIT/

UWD_FP:	.long	0			; Our FP
VMS_EXIT_STATUS:			; User's $EXIT status
	.long	0
UWD_DESBLK:				; UWD $EXIT handler block
	.long	0			; FLINK for exit block
	.address UWD_EXIT_HANDLER	; Exit handler to use
	.long	0			; Argument count
	.address VMS_EXIT_STATUS	; Where to place $EXIT status

	.subtitle	UWD	User Written Debugger
;+
; UWD	User Written Debugger
;
; Called from PROCSTRT or SYS$IMGSTA as an entry in the transfer vector
; table.
; We set up our environment, and call the next setup routine.
;
; Input parameters:
;
;	4(ap)	=> IHA (transfer vector table)
;	8(ap)	=> CLI parse information routine
;	12(ap)	=> IHD (image header)
;	16(ap)	=> IFD (image file descriptor)
;	20(ap)	=  LINK status bits (IHD$L_LNKFLAGS)
;	24(ap)	=  CLI status bits (eg. CLI$V_xxxx)
;
;+
	.psect	$CODE, Rd, NoWrt, Exe, Shr, Pic, Usr, Con, Rel, Lcl

.entry	UWD, ^m<>
	pushaq	UWD_START		; Say who we are
	calls	#1, g^LIB$PUT_OUTPUT
	
	movl	fp, UWD_FP		; Save our FP
	$dclexh_s -			; Trap any $EXIT by user
		desblk = UWD_DESBLK
	blbc	r0, ERROR		; Check for error

	movl	4(ap), r2		; R2 => IHA
	addl	#4, 4(ap)		; Lose this debugger from list
	callg	(ap), @l^IHA$L_TFRADR2(r2) ; Call the user program

	bicl2	#STS$M_INHIB_MSG, r0	; Make sure message can be displayed
	pushl	r0			; Save termination reason
	$canexh_s -			; Cancel our exit handler
		desblk = UWD_DESBLK	; (if it wasn't used)

	pushaq	UWD_END			; Say that we are ending
	calls	#1, g^LIB$PUT_OUTPUT
	pushl	#<15@16>!1		; 1 argument in message vector
					; (R0 is already stacked)
	movl	sp, r1			; R1 => message vector
	$putmsg_s -			; Write the message
		msgvec	= (r1)
	tstl	(sp)+			; Lose $PUTMSG argument count
	popl	r0			; Recover r0
	bisl2	#STS$M_INHIB_MSG, r0	; Stop message being displayed again
	ret
ERROR:
	$exit_s	code = r0		; Exit at once
	ret

	.subtitle	UWD_EXIT_HANDLER	Exit handler for user code
;+
; UWD_EXIT_HANDLER
;
; This exit handler is called if the user code terminates with $EXIT.
; We scan through the call frames on the stack until we find a frame
; whose caller was UWD. We then save the exit status in R0 and execute
; a RET in the context of the that frame, which will resume execution
; just after the CALLG above, with the exit status in R0. Thus, the
; user terminating with:
;
;	$EXIT #status		; Terminate user program from anywhere
;
; is identical to:
;
;	movl #status, r0	; Set return status
;	ret			; Terminate program from main routine
;-

.entry	UWD_EXIT_HANDLER, ^m<>

	pushaq	UWD_EXIT_CALLED		; Say that SYS$EXIT was called
	calls	#1, g^LIB$PUT_OUTPUT

	movl	fp, r1			; => Current FP
10$:	movl	SF$L_SAVE_FP(r1), r1	; => Caller's FP
	cmpl	SF$L_SAVE_FP(r1), UWD_FP ; Was it called from UWD?
	bneq	10$			; No
	movl	r1, fp			; Yes, set it as current FP
	movl	VMS_EXIT_STATUS, r0	; Return user's exit status
	ret				; Back to UWD code

.end	UWD