From:	CSBVAX::MRGATE!@KL.SRI.Com,@dewey.udel.edu,@localhost:galvin@UDEL.EDU@SMTP 29-JUN-1987 11:53
To:	EVERHART
Subj:	Callable Traceback Routine

Received: from UDEL.EDU by KL.SRI.COM with TCP; Mon 29 Jun 87 05:28:20-PDT
Received: from dewey.udel.edu by Louie.UDEL.EDU id a018485; 29 Jun 87 8:20 EDT
Received: from localhost by Dewey.UDEL.EDU id aa03998; 29 Jun 87 8:14 EDT
Received: from [192.5.57.130] by Louie.UDEL.EDU id a001178; 27 Jun 87 16:26 EDT
Date: 27 Jun 87 16:25:00 EST
From: "Michael J. Porter" <mike%udel-oitvax.arpa@UDEL.EDU>
Subject: Callable Traceback Routine
To: info-vax <info-vax@louie.udel.edu>
Reply-To: "Michael J. Porter" <mike%udel-oitvax.arpa@UDEL.EDU>
Message-ID: <8706271626.a001178@Louie.UDEL.EDU>
Resent-To: info-vax@kl.sri.com
Resent-Date: Mon, 29 Jun 87 08:14:13 -0400
Resent-Message-ID: <3993.551967253@udel.edu>
Resent-From: James M Galvin <galvin@UDEL.EDU>

I believe there was a request for calling the traceback facility recently.
The following routine will do this.  The only problems are:

1.  The interface to traceback is likely to change since it kinda strange.
2.  The traceback image can be mapped twice if a normal traceback is generated
    as a result of an exception.  There is no easy way to know where 
    SYS$IMAGSTA mapped TRACE since the symbols where it saves the address
    range are not global.
3.  You will have to define the symbol lib__trace in your favorite message
    library, or change the code to use something else.

The main entry point is lib_trace.  The ISI values are obtained from RMS via
the location RMS$W_ISI in the RAB.  I hope the code is documented well enough
to be of use.

*----- TRACE.MAR
	.TITLE	lib_trace
	.IDENT	/1.00/

;++
; Facility:	LIB -- General Programming Facility Library
;
; Abstract:
;
;		This module contains a routine that directly maps and calls
;		the traceback facility.  Normally, this facility is not
;		callable, it is mapped and called by the system when an
;		exception does not get handled.
;
;		The primary use of this routine is to generate tracebacks
;		from within a program, saving the trace in a file, without
;		generating an exception.  This is useful for tracing program
;		usage.  A general use of this routine is to allow users to make
;		comments in the program.  Later these comments can be
;		reviewed, and the location of the user in the program is
;		known symbolically.
;
;		In order to use this routine effectively, the image must
;		not be linked with /NOTRACEBACK.  This means that this
;		routine is of limited use for programs that are
;		installed.
;
;		Needless to say, this module is highly dependant on
;		undocumented interfaces to VMS.  Hopefully, at some
;		time in the future TRACEBACK will be a callable facility.
;
; Environment:	User-Mode, Non-AST Re-Entrant
;
; Author:	Michael Porter		7/23/85
;
; Modified By:
;		Original
;--


	.SBTTL	Global Declarations
	.DISABLE GLOBAL

;++
; Library Macro Calls:
;--

	.LIBRARY -
		/SYS$LIBRARY:LIB/		; System defs

	$IACDEF					; Image activator ctrl flags
	$IHDDEF					; Image header defintions
	$SSDEF					; System service status defs
	$SFDEF					; Stack frame definitions
	$CHFDEF					; Signal definitions
	$STSDEF					; Status code definitions
	$LNMDEF					; Logical definitions

;++
; External Declarations:
;--

	.EXTERNAL -
		lib__trace, -			; Default signal name

		LIB$SIG_TO_RET			; Change signal to return status

;++
; Macroes
;
; NONE.
;--

;++
; Equated Symbols:
;--

;+
;	Define offsets for the traceback vector argument.  The traceback
;	vector is formed as follows:
;
;	+--------------------------------------------------------+
;	|  PC when the pseudo fault occured                      |
;	+--------------------------------------------------------+
;	| Frame in which the fault occured.  This is the first   |
;	| frame that appears in the traceback                    |
;	+--------------------------------------------------------+
;	| First FP, this is the last frame listed in the         |
;	| traceback                                              |
;	+--------------------------------------------------------+
;	| Signal array for the pseudo exception                  |
;	+--------------------------------------------------------+
;	| Lower section address for the symbol table             |
;	+--------------------------------------------------------+
;	| Upper section address of the symbol table              |
;	+--------------------------------------------------------+
;-

	fault_pc		= 0		; PC at exception
	fault_fp		= 4		; FP of faulting frame
	first_fp		= 8		; FP at start of program
	signal_array		= 12		; Address of signal array
	sect_bounds		= 16		; Address range for DST
	tbvec_len		= 24		; Length of vector

;++
; PSECT Declarations:
;--

	.PSECT	_LIBSHRCODE_	NOWRT, EXE, CON, RD, SHR, PIC,-
				LCL, WORD

	.PSECT	_LIBSHRPLIT_	NOWRT, NOEXE, CON, RD, SHR, PIC,-
                                LCL, WORD

	.PSECT	$OWN$		WRT, NOEXE, CON, RD, NOSHR, NOPIC,-
                                LCL, WORD

;++
; OWN Storage:
;--

	.PSECT	$OWN$

;+
;	Define the location to save the pointer to trace when it is mapped.
;-

sect_addr: -
	.LONG	0

;+
;	End of own storage.
;-

;++
; Static Storage
;--

	.PSECT	_LIBSHRPLIT_

;+
;	Define the name of the trace image.
;-

image:	.ASCID	/SYS$LIBRARY:TRACE.EXE/

;+
;	Define the logical name and the table it will go into.
;-

log_name: -
	.ASCID	/SYS$PUTMSG/

table_name: -
	.ASCID	/LNM$PROCESS/

;+
;	End of static storage.
;-

	.PSECT	_LIBSHRCODE_

;++
; End of global Definitions.
;--

	.SBTTL Sub-Routine trans_log
trans_log:

;++
; Functional Description:
;
;	This sub-routine is used to translate a process logical name which
;	is used to communicate to $PUTMSG and TRACE what file they
;	should be outputting to.
;
;	SYS$PUTMSG creates a logical name with the following format when it
;	is called the first time:
;
;	|  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |
;	|---------------------------------------------------------------------|
;	|  Error ISI  |  Output ISI |  Error ISI  |  Output ISI |    ^X11B    |
;
;	The ^X11B is sort of an ID code, the ISI values are the RAB$W_ISI
;	values found in an RAB.  Those values are all that is needed to
;	write to an already open file.  The values must be repeated for some
;	reason - it just doesn't work if you don't.
;
;	This routine translates such a logical name and returns the ISI
;	values in R5 and R6
;
; Calling Sequence:
;
;	BSBB	trans_log
;
; Formal Parameters:
;
;	NONE.
;
; Implicit Inputs:
;
;	log_name		-- Logical name string
;	table_name		-- Table name to enter the name in
;
; Implicit Outputs:
;
;	R5			-- Error ISI value, 0 if not found
;	R6			-- Output ISI value, 0 if not found
;
; Register Usage:
;
;	R2 - R4			-- Unavailable
;
; Completion Status:
;
;	SS$_NORMAL
;
; Side Effects:
;
;	NONE.
;--

	SUBL2	#16, SP				; Make room for the item desc.
	MOVL	SP, R0				; Save address of item
	SUBL2	#10, SP				; Make equivalence buffer
	MOVL	SP, R6				; Save address

	MOVW	#10, (R0)			; String length
	MOVW	#LNM$_STRING, 2(R0)		; Set the code
	MOVL	R6, 4(R0)			; Buffer address
	CLRL	8(R0)				; Return length address
	CLRL	12(R0)				; End of list

;+
;	Create the logical name
;-

	$TRNLNM_S -
		TABNAM = table_name, -		; Table name
		LOGNAM = log_name, -		; Logical name
		ITMLST = (R0)			; Item list address

	BLBS	R0, 10$				; Success

	CMPL	R0, #SS$_NOLOGNAM		; Failed to locate it?
	BNEQU	1$				; No
	CLRQ	R5				; Yes
	MOVL	#SS$_NORMAL, R0			; Set success
	BRB	100$				; Exit

1$:	CMPL	R0, #SS$_BUFFEROVF		; Simple buffer overflow?
	BEQLU	10$				; Yes
	BRB	100$				; General error

10$:	CMPW	#^X11B, (R6)			; Check for code
	BEQLU	11$				; Matched
	CLRQ	R5				; No string
	BRB	100$				; Exit

11$:	MOVZWL	4(R6), R5			; Get the error ISI
	MOVZWL	2(R6), R6			; Get the output ISI

100$:	ADDL2	#26, SP				; Return stack space
	RSB

;++
;	End of routine.
;--

	.SBTTL Sub-Routine set_log
set_log:

;++
; Functional Description:
;
;	This sub-routine is used to define a process logical name which
;	is used to communicate to $PUTMSG and TRACE what file they
;	should be outputting to.
;
;	SYS$PUTMSG creates a logical name with the following format when it
;	is called the first time:
;
;	|  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |
;	|---------------------------------------------------------------------|
;	|  Error ISI  |  Output ISI |  Error ISI  |  Output ISI |    ^X11B    |
;
;	The ^X11B is sort of an ID code, the ISI values are the RAB$W_ISI
;	values found in an RAB.  Those values are all that is needed to
;	write to an already open file.  The values must be repeated, it
;	just doesn't work if you don't.
;
;	This routine defines such a logical name,  using R7 and R8 for
;	the ISI values.
;
;	Always delete the logical name first.  If the input ISI values
;	are zero, then exit at that point.
;
; Calling Sequence:
;
;	BSBB	set_log
;
; Formal Parameters:
;
;	R7			-- Error ISI
;	R8			-- Output ISI
;
; Implicit Inputs:
;
;	log_name		-- Logical name string
;	table_name		-- Table name to enter the name in
;
; Implicit Outputs:
;
;	Logical name created or deleted.
;
; Register Usage:
;
;	R2 - R6			-- Unavailable
;
; Completion Status:
;
;	SS$_NORMAL
;
; Side Effects:
;
;	NONE.
;--

;+
;	See if the values are zero or not.  If they are, just delete
;	the logical name.
;-

	CMPL	#0, R7				; Check the error ISI
	BNEQU	1$				; Not zero
	CMPL	#0, R8				; Check the output ISI
	BNEQU	1$				; Not zero

;+
;	Delete the logical name.
;-

	$DELLNM_S -
		TABNAM = table_name, -
		LOGNAM = log_name
	RSB

;+
;	The ISIs are not zero, so create the logical name.
;-

1$:	SUBL2	#16, SP				; Make room for the item desc.
	MOVL	SP, R0				; Save address of item
	SUBL2	#10, SP				; Make equivalence buffer
	MOVL	SP, R1				; Save address

	MOVW	#10, (R0)			; String length
	MOVW	#LNM$_STRING, 2(R0)		; Set the code
	MOVL	R1, 4(R0)			; Buffer address
	CLRL	8(R0)				; Return length address
	CLRL	12(R0)				; End of list

	MOVW	#^X11B, (R1)			; Set code
	MOVW	R8, 2(R1)			; Set output ISI
	MOVW	R7, 4(R1)			; Set error ISI
	MOVW	R8, 6(R1)			; Set output ISI
	MOVW	R7, 8(R1)			; Set error ISI

;+
;	Create the logical name
;-

	$CRELNM_S -
		TABNAM = table_name, -		; Table name
		LOGNAM = log_name, -		; Logical name
		ITMLST = (R0)			; Item list address

100$:	ADDL2	#26, SP				; Return stack space
	RSB

;++
;	End of routine.
;--

	.SBTTL Routine handler
	.ENTRY	handler, 0

;++
; Functional Description:
;
;	This routine acts as a condition handler when the traceback
;	facility is called.  It will delete the logical name SYS$PUTMSG
;	and change the signal to a return status.  This will cause the
;	lib_trace routine to exit because we call LIB$SIG_TO_RET.
;
; Calling Sequence:
;
;	handler( sigargs.ra.r, mechargs.ra.r )
;
; Formal Parameters:
;
;	sigargs		-- Signal arguments
;	mechargs	-- Mechanism arguments
;
; Implicit Inputs:
;
;	table_name	-- Name the logical appears in
;	log_name	-- Logical name string
;
; Implicit Outputs:
;
;	NONE.
;
; Completion Status:
;
;	SS$_NORMAL		Normal, successful completion
;
; Side Effects:
;
;	NONE.
;--

	$DELLNM_S -				; Delete the logical name
		TABNAM = table_name, -
		LOGNAM = log_name

	CALLG	(AP), G^LIB$SIG_TO_RET		; Change to return status

	MOVL	#SS$_CONTINUE, R0
	RET

;++
;	End of routine.
;--

	.SBTTL Global Routine lib_trace
	.ENTRY	lib_trace, ^M< R2, R3, R4, R5, R6, R7, R8, R9, R10, R11 >

;++
; Functional Description:
;
;	This routine is used to generate a traceback that will be written
;	to the file specified using the RAB RAB$W_ISI values.  The traceback
;	is generated by actually calling the traceback facility, an error
;	is not signalled, so there will be no confusion with other exception
;	handlers.  This routine can be called from an exception handler.
;	If it called from an exception handler and the exception is not
;	handled, two tracebacks will be generated.  The system generated
;	traceback will occur on SYS$OUTPUT and SYS$ERROR, the traceback
;	from this routine will go to the file specified or default to
;	SYS$OUTPUT and SYS$ERROR.
;
; Calling Sequence:
;
;	ret_status = lib_trace( [,error_isi.rw.v, output_isi.rl.v]
;	                        [frame.rl.v] [,signal.ra.r] )
;
; Formal Parameters:
;
;	error_isi	-- RAB RAB$W_ISI value of the file you want the output
;	output_isi	   to appear in.  If output_isi and error_isi are
;			   the same, the output will only occur once.  If
;			   neither is specified, SYS$OUTPUT and SYS$ERROR will
;			   be used.  you must specify both or neither.
;
;	frame		-- # of frames from end of call stack to skip
;			   This argument is used if this routine is called
;			   from a general location, and the frames for the
;			   general location are not wanted in the traceback.
;			   Do not include internal frames in this routine
;			   in the count
;
;	signal		-- Signal array used in traceback message.  The default
;			   is a signal named lib__trace.
;
; Implicit Inputs:
;
;	sect_addr	-- Pointer to location where TRACE was mapped
;	image		-- String descriptor giving the name of the image
;			   to map
;
; Implicit Outputs:
;
;	sect_addr	-- Pointer to location where TRACE was mapped
;
; Register Usage:
;
;	R2		-- Top FP (top of stack, usually SYS$IMGSTA)
;	R3		-- Top AP (AP pointing to args at image startup)
;	R4		-- Fault FP (FP of frame pseudo fault occured in)
;	R5		-- PC at Pseudo fault (The saved PC in the frame
;			   after the faulting frame)
;	R6		-- Signal name
;
; Completion Status:
;
;	SS$_NORMAL		Normal, successful completion
;
; Side Effects:
;
;	The TRACE image will be mapped.  If the system also generates
;	trace messages, TRACE will be mapped twice, but this will not
;	cause a problem since it is relocatable.
;--

;+
;	Set the condition handler
;-

	MOVAL	handler, (FP)

;+
;	Find the top stack frame by scanning the stack backwards.  Also,
;	find the AP that was used to pass the original arguments to the
;	image.  This is not necessarily the AP for the top frame.  Only
;	use the value if the # of args is none zero.
;
;	While we are winding back frames, move the fault FP and PC if the
;	number of frames to not trace is non-zero.
;
;	R2		-- Top FP
;	R3		-- Top AP
;	R4		-- Fault FP
;	R5		-- Fault PC
;
;	After we find the top frame, use the second from the top frame since
;	the top frame is SYS$IMAGSTA.  Even if $IMAGSTA is not present, then
;	it does not matter much since the traceback will not have symbols
;	anyway.  R8 is the trailer.
;-

0$:	MOVL	SF$L_SAVE_FP( FP ), R2		; Skip this frame
	MOVL	FP, R8				; Previous frame
	MOVL	SF$L_SAVE_AP( FP ), R3		; Set the top AP value.
	MOVL	R2, R4				; Fault FP
	MOVL	SF$L_SAVE_PC( FP ), R5		; Faulting PC
	CLRL	R6				; Counter
	MOVZBL	(AP), R7			; Argument count
	CMPL	R7, #3				; 3 args passed?
	BLSSU	1$				; No
	MOVL	12(AP), R7			; # of frames to skip
	BRB	2$				; Start unwinding frames
1$:	CLRL	R7				; No frames to skip

2$:	MOVL	SF$L_SAVE_FP( R2 ), R1		; Get the previous frame
	BEQLU	5$				; No previous frame
	MOVL	SF$L_SAVE_AP( R2 ), R0		; Get saved AP
	CMPB	#0, ( R0 )			; Args passed to frame?
	BEQLU	3$				; No
	MOVL	R0, R3				; Yes, save AP
3$:	CMPL	R6, R7				; How many frames back?
	BGEQU	4$				; Enough frames
	MOVL	R1, R4				; Move back fault FP
	MOVL	SF$L_SAVE_PC( R2 ), R5		; Move back fault PC
	INCL	R6				; Increment the counter
4$:	MOVL	R2, R8				; Save current FP
	MOVL	R1, R2				; Save the previous frame
	BRB	2$				; Get next frame
5$:	MOVL	R8, R2				; Use next to last frame
						; Skips SYS$IMAGSTA

;+
;	Build the traceback vector.  This vector's address will be placed
;	in the first argument slot pointed to by the AP used when the image was
;	originally run.
;
;	R2	-- First FP, Signal name
;	R3	-- First AP
;	R4	-- Fault FP, address to jump to if mapped
;	R5	-- Fault PC
;	R6	-- Temp
;
;	At the end of this code, only R2, R3 and R4 are alive.  R4 is only
;	live if trace is mapped.
;-

;+
;	Don't build a signal vector if one was provided.
;-

10$:	CMPB	(AP), #4			; 4 args passed?
	BLSSU	11$				; No
	MOVL	16(AP), R6			; Yes
	BNEQU	12$				; Address not NULL

11$:	MOVPSL	-(SP)				; Create signal vec, push PSL
	PUSHL	R5				; Fault PC
	PUSHL	#lib__trace			; Push default signal name
	PUSHL	#3				; Push length
	MOVL	SP, R6				; Save addr of signal array

12$:	SUBL2	#tbvec_len, SP			; Make space for trace vector
	MOVL	R2, first_fp( SP )		; Set FP for first frame
	MOVL	R4, fault_fp( SP )		; FP for fault
	MOVL	R5, fault_pc( SP )		; Save faulting PC
	MOVL	R6, signal_array( SP )		; Address of signal array
	CLRQ	sect_bounds( SP )		; DST address
	MOVL	SP, 4( R3 )			; Set addr. of tb vector
	MOVL	CHF$L_SIG_NAME(R6), R2		; Save signal name
	MOVL	sect_addr, R4			; Get addr of trace
	BNEQU	100$				; Already mapped

;+
;	Map in the traceback image.  Do not do all the work the system
;	does (translating LIB$TRACE etc), just map it.
;
;	R2		-- Signal name
;	R3		-- Image arguments
;-

	SUBL2	#IHD$S_IHDDEF, SP		; Create image header buffer
	MOVL	SP, R1				; Save address of header
	CLRQ	-(SP)				; Create return address array
	MOVL	SP, R4				; Save address of return array
	PUSHL	#1@30-1				; 2nd lw for input addr. array
	PUSHL	#^X200				; 1st lw for input addr. array
	MOVL	SP, R0				; Input address array

;+
;	Activate the image.
;-

	$IMGACT_S -
		NAME   = image, -		; Name of file
		HDRBUF = (R1), -		; Address of image header
		IMGCTL = #<IAC$M_MERGE!IAC$M_EXPREG>, -
		INADR  = (R0), -		; Range to map into
		RETADR = (R4)			; Range mapped into
	BLBS	R0, 15$				; Error?
	RET					; Yes

15$:	$IMGFIX_S				; Fix up image vectors
	BLBS	R0, 20$				; Error?
	RET					; Yes
20$:						; No

;+
;	Get the transfer address from the image.  The address of the array
;	that holds the range that was mapped is in R4.  The third longword
;	in the mapped section contains the transfer address for trace.
;-

	MOVL	(R4), R4			; Get mapped address
	ADDL3	8( R4 ), R4, R4			; Compute start address
	MOVL	R4, sect_addr			; Save the start address
		
;+
;	See if the error and output ISI values are specified or if we
;	defaulting to SYS$OUTPUT.
;
;	R2		-- Signal name
;	R3		-- Argument list
;	R4		-- Address to jump to
;	R7		-- Error ISI
;	R8		-- Error ISI
;	R5		-- Old error ISI
;	R6		-- Old output ISI
;-

100$:	CLRQ	R5				; Clear OLD ISI values
	CMPB	(AP), #2			; Enough args passed?
	BLSSU	105$				; Nope, default
	MOVL	4(AP), R7			; Get the error ISI
	BEQLU	105$				; Ignore if zero
	MOVL	8(AP), R8			; Get the output ISI
	BEQLU	105$				; Ignore if zero
	BSBW	trans_log			; Translate the logical
	BLBC	R0, 115$			; Error?
	BSBW	set_log				; Set the new logical
	BLBC	R0, 115$			; Error?

105$:	CALLG	(R3), 120$			; Call trace
	MOVL	R0, R3				; Save the return status

;+
;	Remove the logical name or re-define it to what it was.
;-

	MOVQ	R5, R7				; Yes
	BSBW	set_log				; Redefine the logical name
	BLBC	R0, 115$			; Error?

;+
;	If the signal name is still the same, then exit with SS$_NORMAL,
;	otherwise make sure the inhibit flag is clear and return the
;	code.
;-

110$:	BICL2	#STS$M_INHIB_MSG, R2		; Clear inhib on signal name
	BICL2	#STS$M_INHIB_MSG, R3		; Clear inhib in ret status
	CMPL	R2, R3				; Are codes the same
	BNEQU	116$				; No
	MOVL	#SS$_NORMAL, R0			; Set success	
115$:	RET					; Return
116$:	MOVL	R3, R0				; No, return TRACE error
	RET					; Return

;+
;	This frame will be removed by the RET in TRACE.  A RET is not needed.
;
;	R2		-- Signal name
;	R4		-- Address to jump to (not saved)
;	R5		-- Old error ISI
;	R6		-- Old output ISI
;-

120$:	.WORD	^M< R2, R5, R6 >
	JMP	( R4 )

;++
;	End of module.
;--

	.END
------
