mike%udel-oitvax.arpa@UDEL.EDU ("Michael J. Porter") (06/28/87)
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
------