From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP 12-AUG-1988 01:13
To:	ARISIA::EVERHART
Subj:	Getting a traceback in a file (Caller of subroutine?)


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 11 AUG 88 19:23:25 PDT
Received: from UDEL.EDU (Louie.UDel.EDU) by KL.SRI.COM with TCP; Thu, 11 Aug 88 15:36:30 PDT
Received: from [192.5.57.130] by Louie.UDEL.EDU id aa13302; 11 Aug 88 11:20 EDT
Date: 11 Aug 88 11:21:00 EST
From: "Michael J. Porter" <mike@vax.oit.udel.edu>
Subject: Getting a traceback in a file (Caller of subroutine?)
To: info-vax <info-vax@louie.udel.edu>
cc: mike@vax.oit.udel.edu
Reply-To: "Michael J. Porter" <mike@vax.oit.udel.edu>
Message-ID:  <8808111120.aa13302@Louie.UDEL.EDU>


There was a question recently about how to tell what subroutine called
a subroutine.  We had a similar problem in that we had a series of
page oriented programs designed to teach students statistics.  We wanted
the designers to be able to make comments on the program and give the
programmers enough information to locate the trouble in the code.

To do this, I wrote a routine which calls the traceback facility
directly.  While it is possible to simply reassign SYS$OUTPUT and
SYS$ERROR and signal an error, there are some problems with this:

1.  Once SYS$PUTMSG executes, it is normally not possible to reassign
    SYS$ERROR and SYS$OUTPUT.  (See the SYS$PUTMSG logical name
    documentation in TRACE.MAR)

2.  The language we were writing in used its own condition handlers
    which were triggered by an attempt to signal and 'catch' a traceback.

The original notewriter could use this routine to 'catch' a traceback
in a file, and then parse the result to see who called the current
routine.  It really depends on what the writer had in mind.

The alternatives as I see them are:

1.  As Paul Clayton suggested, simply pass the caller's name to the
    called procedure.

2.  Write code that can take apart a debugger symbol table.  This
    appears fairly difficult, which is why I went to calling the
    system traceback routine.


					Mike Porter

mike@vax.oit.udel.edu
....................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by MIKE
$! on Thursday 11-AUG-1988 11:18:51.10
$!
$! It contains the following 4 files:
$! TRACE.MAR LIBPTR.MSG TEST.PAS COMPILE.COM
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="TRACE.MAR"
$ Check_Sum_is=1528050121
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009.TITLE`009lib_trace
X`009.IDENT`009/1.00/
X
X;++
X; Facility:`009LIB -- General Programming Facility Library
X;
X; Abstract:
X;
X;`009`009This module contains a routine that directly maps and calls
X;`009`009the traceback facility.  Normally, this facility is not
X;`009`009callable, it is mapped and called by the system when an
X;`009`009exception does not get handled.
X;
X;`009`009The primary use of this routine is to generate tracebacks
X;`009`009from within a program, saving the trace in a file, without
X;`009`009generating an exception.  This is useful for tracing program
X;`009`009usage.  A general use of this routine is to allow users to make
X;`009`009comments in the program.  Later these comments can be
X;`009`009reviewed, and the location of the user in the program is
X;`009`009known symbolically.
X;
X;`009`009In order to use this routine effectively, the image must
X;`009`009not be linked with /NOTRACEBACK.  This means that this
X;`009`009routine is of limited use for programs that are
X;`009`009installed.
X;
X;`009`009Needless to say, this module is highly dependant on
X;`009`009undocumented interfaces to VMS.  Hopefully, at some
X;`009`009time in the future TRACEBACK will be a callable facility.
X;
X; Environment:`009User-Mode, Non-AST Re-Entrant
X;
X; Author:`009Michael Porter`009`0097/23/85
X;
X; Modified By:
X;`009`009Original
X;--
X
X`012
X`009.SBTTL`009Global Declarations
X`009.DISABLE GLOBAL
X
X;++
X; Library Macro Calls:
X;--
X
X`009.LIBRARY -
X`009`009/SYS$LIBRARY:LIB/`009`009; System defs
X
X`009$IACDEF`009`009`009`009`009; Image activator ctrl flags
X`009$IHDDEF`009`009`009`009`009; Image header defintions
X`009$SSDEF`009`009`009`009`009; System service status defs
X`009$SFDEF`009`009`009`009`009; Stack frame definitions
X`009$CHFDEF`009`009`009`009`009; Signal definitions
X`009$STSDEF`009`009`009`009`009; Status code definitions
X`009$LNMDEF`009`009`009`009`009; Logical definitions
X
X;++
X; External Declarations:
X;--
X
X`009.EXTERNAL -
X`009`009lib__trace, -`009`009`009; Default signal name
X
X`009`009LIB$SIG_TO_RET`009`009`009; Change signal to return status
X
X;++
X; Macroes
X;
X; NONE.
X;--
X
X;++
X; Equated Symbols:
X;--
X
X;+
X;`009Define offsets for the traceback vector argument.  The traceback
X;`009vector is formed as follows:
X;
X;`009+--------------------------------------------------------+
X;`009|  PC when the pseudo fault occured                      |
X;`009+--------------------------------------------------------+
X;`009| Frame in which the fault occured.  This is the first   |
X;`009| frame that appears in the traceback                    |
X;`009+--------------------------------------------------------+
X;`009| First FP, this is the last frame listed in the         |
X;`009| traceback                                              |
X;`009+--------------------------------------------------------+
X;`009| Signal array for the pseudo exception                  |
X;`009+--------------------------------------------------------+
X;`009| Lower section address for the symbol table             |
X;`009+--------------------------------------------------------+
X;`009| Upper section address of the symbol table              |
X;`009+--------------------------------------------------------+
X;-
X
X`009fault_pc`009`009= 0`009`009; PC at exception
X`009fault_fp`009`009= 4`009`009; FP of faulting frame
X`009first_fp`009`009= 8`009`009; FP at start of program
X`009signal_array`009`009= 12`009`009; Address of signal array
X`009sect_bounds`009`009= 16`009`009; Address range for DST
X`009tbvec_len`009`009= 24`009`009; Length of vector
X
X;++
X; PSECT Declarations:
X;--
X
X`009.PSECT`009_LIBSHRCODE_`009NOWRT, EXE, CON, RD, SHR, PIC,-
X`009`009`009`009LCL, WORD
X
X`009.PSECT`009_LIBSHRPLIT_`009NOWRT, NOEXE, CON, RD, SHR, PIC,-
X                                LCL, WORD
X
X`009.PSECT`009$OWN$`009`009WRT, NOEXE, CON, RD, NOSHR, NOPIC,-
X                                LCL, WORD
X
X;++
X; OWN Storage:
X;--
X
X`009.PSECT`009$OWN$
X
X;+
X;`009Define the location to save the pointer to trace when it is mapped.
X;-
X
Xsect_addr: -
X`009.LONG`0090
X
X;+
X;`009End of own storage.
X;-
X
X;++
X; Static Storage
X;--
X
X`009.PSECT`009_LIBSHRPLIT_
X
X;+
X;`009Define the name of the trace image.
X;-
X
Ximage:`009.ASCID`009/SYS$LIBRARY:TRACE.EXE/
X
X;+
X;`009Define the logical name and the table it will go into.
X;-
X
Xlog_name: -
X`009.ASCID`009/SYS$PUTMSG/
X
Xtable_name: -
X`009.ASCID`009/LNM$PROCESS/
X
X;+
X;`009End of static storage.
X;-
X
X`009.PSECT`009_LIBSHRCODE_
X
X;++
X; End of global Definitions.
X;--
X`012
X`009.SBTTL Sub-Routine trans_log
Xtrans_log:
X
X;++
X; Functional Description:
X;
X;`009This sub-routine is used to translate a process logical name which
X;`009is used to communicate to $PUTMSG and TRACE what file they
X;`009should be outputting to.
X;
X;`009SYS$PUTMSG creates a logical name with the following format when it
X;`009is called the first time:
X;
X;`009|  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |
X;`009|---------------------------------------------------------------------|
X;`009|  Error ISI  |  Output ISI |  Error ISI  |  Output ISI |    ^X11B    |
X;
X;`009The ^X11B is sort of an ID code, the ISI values are the RAB$W_ISI
X;`009values found in an RAB.  Those values are all that is needed to
X;`009write to an already open file.  The values must be repeated for some
X;`009reason - it just doesn't work if you don't.
X;
X;`009This routine translates such a logical name and returns the ISI
X;`009values in R5 and R6
X;
X; Calling Sequence:
X;
X;`009BSBB`009trans_log
X;
X; Formal Parameters:
X;
X;`009NONE.
X;
X; Implicit Inputs:
X;
X;`009log_name`009`009-- Logical name string
X;`009table_name`009`009-- Table name to enter the name in
X;
X; Implicit Outputs:
X;
X;`009R5`009`009`009-- Error ISI value, 0 if not found
X;`009R6`009`009`009-- Output ISI value, 0 if not found
X;
X; Register Usage:
X;
X;`009R2 - R4`009`009`009-- Unavailable
X;
X; Completion Status:
X;
X;`009SS$_NORMAL
X;
X; Side Effects:
X;
X;`009NONE.
X;--
X
X`009SUBL2`009#16, SP`009`009`009`009; Make room for the item desc.
X`009MOVL`009SP, R0`009`009`009`009; Save address of item
X`009SUBL2`009#10, SP`009`009`009`009; Make equivalence buffer
X`009MOVL`009SP, R6`009`009`009`009; Save address
X
X`009MOVW`009#10, (R0)`009`009`009; String length
X`009MOVW`009#LNM$_STRING, 2(R0)`009`009; Set the code
X`009MOVL`009R6, 4(R0)`009`009`009; Buffer address
X`009CLRL`0098(R0)`009`009`009`009; Return length address
X`009CLRL`00912(R0)`009`009`009`009; End of list
X
X;+
X;`009Create the logical name
X;-
X
X`009$TRNLNM_S -
X`009`009TABNAM = table_name, -`009`009; Table name
X`009`009LOGNAM = log_name, -`009`009; Logical name
X`009`009ITMLST = (R0)`009`009`009; Item list address
X
X`009BLBS`009R0, 10$`009`009`009`009; Success
X
X`009CMPL`009R0, #SS$_NOLOGNAM`009`009; Failed to locate it?
X`009BNEQU`0091$`009`009`009`009; No
X`009CLRQ`009R5`009`009`009`009; Yes
X`009MOVL`009#SS$_NORMAL, R0`009`009`009; Set success
X`009BRB`009100$`009`009`009`009; Exit
X
X1$:`009CMPL`009R0, #SS$_BUFFEROVF`009`009; Simple buffer overflow?
X`009BEQLU`00910$`009`009`009`009; Yes
X`009BRB`009100$`009`009`009`009; General error
X
X10$:`009CMPW`009#^X11B, (R6)`009`009`009; Check for code
X`009BEQLU`00911$`009`009`009`009; Matched
X`009CLRQ`009R5`009`009`009`009; No string
X`009BRB`009100$`009`009`009`009; Exit
X
X11$:`009MOVZWL`0094(R6), R5`009`009`009; Get the error ISI
X`009MOVZWL`0092(R6), R6`009`009`009; Get the output ISI
X
X100$:`009ADDL2`009#26, SP`009`009`009`009; Return stack space
X`009RSB
X
X;++
X;`009End of routine.
X;--
X`012
X`009.SBTTL Sub-Routine set_log
Xset_log:
X
X;++
X; Functional Description:
X;
X;`009This sub-routine is used to define a process logical name which
X;`009is used to communicate to $PUTMSG and TRACE what file they
X;`009should be outputting to.
X;
X;`009SYS$PUTMSG creates a logical name with the following format when it
X;`009is called the first time:
X;
X;`009|  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |  2 bytes    |
X;`009|---------------------------------------------------------------------|
X;`009|  Error ISI  |  Output ISI |  Error ISI  |  Output ISI |    ^X11B    |
X;
X;`009The ^X11B is sort of an ID code, the ISI values are the RAB$W_ISI
X;`009values found in an RAB.  Those values are all that is needed to
X;`009write to an already open file.  The values must be repeated, it
X;`009just doesn't work if you don't.
X;
X;`009This routine defines such a logical name,  using R7 and R8 for
X;`009the ISI values.
X;
X;`009Always delete the logical name first.  If the input ISI values
X;`009are zero, then exit at that point.
X;
X; Calling Sequence:
X;
X;`009BSBB`009set_log
X;
X; Formal Parameters:
X;
X;`009R7`009`009`009-- Error ISI
X;`009R8`009`009`009-- Output ISI
X;
X; Implicit Inputs:
X;
X;`009log_name`009`009-- Logical name string
X;`009table_name`009`009-- Table name to enter the name in
X;
X; Implicit Outputs:
X;
X;`009Logical name created or deleted.
X;
X; Register Usage:
X;
X;`009R2 - R6`009`009`009-- Unavailable
X;
X; Completion Status:
X;
X;`009SS$_NORMAL
X;
X; Side Effects:
X;
X;`009NONE.
X;--
X
X;+
X;`009See if the values are zero or not.  If they are, just delete
X;`009the logical name.
X;-
X
X`009CMPL`009#0, R7`009`009`009`009; Check the error ISI
X`009BNEQU`0091$`009`009`009`009; Not zero
X`009CMPL`009#0, R8`009`009`009`009; Check the output ISI
X`009BNEQU`0091$`009`009`009`009; Not zero
X
X;+
X;`009Delete the logical name.
X;-
X
X`009$DELLNM_S -
X`009`009TABNAM = table_name, -
X`009`009LOGNAM = log_name
X`009RSB
X
X;+
X;`009The ISIs are not zero, so create the logical name.
X;-
X
X1$:`009SUBL2`009#16, SP`009`009`009`009; Make room for the item desc.
X`009MOVL`009SP, R0`009`009`009`009; Save address of item
X`009SUBL2`009#10, SP`009`009`009`009; Make equivalence buffer
X`009MOVL`009SP, R1`009`009`009`009; Save address
X
X`009MOVW`009#10, (R0)`009`009`009; String length
X`009MOVW`009#LNM$_STRING, 2(R0)`009`009; Set the code
X`009MOVL`009R1, 4(R0)`009`009`009; Buffer address
X`009CLRL`0098(R0)`009`009`009`009; Return length address
X`009CLRL`00912(R0)`009`009`009`009; End of list
X
X`009MOVW`009#^X11B, (R1)`009`009`009; Set code
X`009MOVW`009R8, 2(R1)`009`009`009; Set output ISI
X`009MOVW`009R7, 4(R1)`009`009`009; Set error ISI
X`009MOVW`009R8, 6(R1)`009`009`009; Set output ISI
X`009MOVW`009R7, 8(R1)`009`009`009; Set error ISI
X
X;+
X;`009Create the logical name
X;-
X
X`009$CRELNM_S -
X`009`009TABNAM = table_name, -`009`009; Table name
X`009`009LOGNAM = log_name, -`009`009; Logical name
X`009`009ITMLST = (R0)`009`009`009; Item list address
X
X100$:`009ADDL2`009#26, SP`009`009`009`009; Return stack space
X`009RSB
X
X;++
X;`009End of routine.
X;--
X`012
X`009.SBTTL Routine handler
X`009.ENTRY`009handler, 0
X
X;++
X; Functional Description:
X;
X;`009This routine acts as a condition handler when the traceback
X;`009facility is called.  It will delete the logical name SYS$PUTMSG
X;`009and change the signal to a return status.  This will cause the
X;`009lib_trace routine to exit because we call LIB$SIG_TO_RET.
X;
X; Calling Sequence:
X;
X;`009handler( sigargs.ra.r, mechargs.ra.r )
X;
X; Formal Parameters:
X;
X;`009sigargs`009`009-- Signal arguments
X;`009mechargs`009-- Mechanism arguments
X;
X; Implicit Inputs:
X;
X;`009table_name`009-- Name the logical appears in
X;`009log_name`009-- Logical name string
X;
X; Implicit Outputs:
X;
X;`009NONE.
X;
X; Completion Status:
X;
X;`009SS$_NORMAL`009`009Normal, successful completion
X;
X; Side Effects:
X;
X;`009NONE.
X;--
X
X`009$DELLNM_S -`009`009`009`009; Delete the logical name
X`009`009TABNAM = table_name, -
X`009`009LOGNAM = log_name
X
X`009CALLG`009(AP), G^LIB$SIG_TO_RET`009`009; Change to return status
X
X`009MOVL`009#SS$_CONTINUE, R0
X`009RET
X
X;++
X;`009End of routine.
X;--
X`012
X`009.SBTTL Global Routine lib_trace
X`009.ENTRY`009lib_trace, ^M< R2, R3, R4, R5, R6, R7, R8, R9, R10, R11 >
X
X;++
X; Functional Description:
X;
X;`009This routine is used to generate a traceback that will be written
X;`009to the file specified using the RAB RAB$W_ISI values.  The traceback
X;`009is generated by actually calling the traceback facility, an error
X;`009is not signalled, so there will be no confusion with other exception
X;`009handlers.  This routine can be called from an exception handler.
X;`009If it called from an exception handler and the exception is not
X;`009handled, two tracebacks will be generated.  The system generated
X;`009traceback will occur on SYS$OUTPUT and SYS$ERROR, the traceback
X;`009from this routine will go to the file specified or default to
X;`009SYS$OUTPUT and SYS$ERROR.
X;
X; Calling Sequence:
X;
X;`009ret_status = lib_trace( [,error_isi.rw.v, output_isi.rl.v]
X;`009                        [frame.rl.v] [,signal.ra.r] )
X;
X; Formal Parameters:
X;
X;`009error_isi`009-- RAB RAB$W_ISI value of the file you want the output
X;`009output_isi`009   to appear in.  If output_isi and error_isi are
X;`009`009`009   the same, the output will only occur once.  If
X;`009`009`009   neither is specified, SYS$OUTPUT and SYS$ERROR will
X;`009`009`009   be used.  you must specify both or neither.
X;
X;`009frame`009`009-- # of frames from end of call stack to skip
X;`009`009`009   This argument is used if this routine is called
X;`009`009`009   from a general location, and the frames for the
X;`009`009`009   general location are not wanted in the traceback.
X;`009`009`009   Do not include internal frames in this routine
X;`009`009`009   in the count
X;
X;`009signal`009`009-- Signal array used in traceback message.  The default
X;`009`009`009   is a signal named lib__trace.
X;
X; Implicit Inputs:
X;
X;`009sect_addr`009-- Pointer to location where TRACE was mapped
X;`009image`009`009-- String descriptor giving the name of the image
X;`009`009`009   to map
X;
X; Implicit Outputs:
X;
X;`009sect_addr`009-- Pointer to location where TRACE was mapped
X;
X; Register Usage:
X;
X;`009R2`009`009-- Top FP (top of stack, usually SYS$IMGSTA)
X;`009R3`009`009-- Top AP (AP pointing to args at image startup)
X;`009R4`009`009-- Fault FP (FP of frame pseudo fault occured in)
X;`009R5`009`009-- PC at Pseudo fault (The saved PC in the frame
X;`009`009`009   after the faulting frame)
X;`009R6`009`009-- Signal name
X;
X; Completion Status:
X;
X;`009SS$_NORMAL`009`009Normal, successful completion
X;
X; Side Effects:
X;
X;`009The TRACE image will be mapped.  If the system also generates
X;`009trace messages, TRACE will be mapped twice, but this will not
X;`009cause a problem since it is relocatable.
X;--
X
X;+
X;`009Set the condition handler
X;-
X
X`009MOVAL`009handler, (FP)
X
X;+
X;`009Find the top stack frame by scanning the stack backwards.  Also,
X;`009find the AP that was used to pass the original arguments to the
X;`009image.  This is not necessarily the AP for the top frame.  Only
X;`009use the value if the # of args is none zero.
X;
X;`009While we are winding back frames, move the fault FP and PC if the
X;`009number of frames to not trace is non-zero.
X;
X;`009R2`009`009-- Top FP
X;`009R3`009`009-- Top AP
X;`009R4`009`009-- Fault FP
X;`009R5`009`009-- Fault PC
X;
X;`009After we find the top frame, use the second from the top frame since
X;`009the top frame is SYS$IMAGSTA.  Even if $IMAGSTA is not present, then
X;`009it does not matter much since the traceback will not have symbols
X;`009anyway.  R8 is the trailer.
X;-
X
X0$:`009MOVL`009SF$L_SAVE_FP( FP ), R2`009`009; Skip this frame
X`009MOVL`009FP, R8`009`009`009`009; Previous frame
X`009MOVL`009SF$L_SAVE_AP( FP ), R3`009`009; Set the top AP value.
X`009MOVL`009R2, R4`009`009`009`009; Fault FP
X`009MOVL`009SF$L_SAVE_PC( FP ), R5`009`009; Faulting PC
X`009CLRL`009R6`009`009`009`009; Counter
X`009MOVZBL`009(AP), R7`009`009`009; Argument count
X`009CMPL`009R7, #3`009`009`009`009; 3 args passed?
X`009BLSSU`0091$`009`009`009`009; No
X`009MOVL`00912(AP), R7`009`009`009; # of frames to skip
X`009BRB`0092$`009`009`009`009; Start unwinding frames
X1$:`009CLRL`009R7`009`009`009`009; No frames to skip
X
X2$:`009MOVL`009SF$L_SAVE_FP( R2 ), R1`009`009; Get the previous frame
X`009BEQLU`0095$`009`009`009`009; No previous frame
X`009MOVL`009SF$L_SAVE_AP( R2 ), R0`009`009; Get saved AP
X`009CMPB`009#0, ( R0 )`009`009`009; Args passed to frame?
X`009BEQLU`0093$`009`009`009`009; No
X`009MOVL`009R0, R3`009`009`009`009; Yes, save AP
X3$:`009CMPL`009R6, R7`009`009`009`009; How many frames back?
X`009BGEQU`0094$`009`009`009`009; Enough frames
X`009MOVL`009R1, R4`009`009`009`009; Move back fault FP
X`009MOVL`009SF$L_SAVE_PC( R2 ), R5`009`009; Move back fault PC
X`009INCL`009R6`009`009`009`009; Increment the counter
X4$:`009MOVL`009R2, R8`009`009`009`009; Save current FP
X`009MOVL`009R1, R2`009`009`009`009; Save the previous frame
X`009BRB`0092$`009`009`009`009; Get next frame
X5$:`009MOVL`009R8, R2`009`009`009`009; Use next to last frame
X`009`009`009`009`009`009; Skips SYS$IMAGSTA
X
X;+
X;`009Build the traceback vector.  This vector's address will be placed
X;`009in the first argument slot pointed to by the AP used when the image was
X;`009originally run.
X;
X;`009R2`009-- First FP, Signal name
X;`009R3`009-- First AP
X;`009R4`009-- Fault FP, address to jump to if mapped
X;`009R5`009-- Fault PC
X;`009R6`009-- Temp
X;
X;`009At the end of this code, only R2, R3 and R4 are alive.  R4 is only
X;`009live if trace is mapped.
X;-
X
X;+
X;`009Don't build a signal vector if one was provided.
X;-
X
X10$:`009CMPB`009(AP), #4`009`009`009; 4 args passed?
X`009BLSSU`00911$`009`009`009`009; No
X`009MOVL`00916(AP), R6`009`009`009; Yes
X`009BNEQU`00912$`009`009`009`009; Address not NULL
X
X11$:`009MOVPSL`009-(SP)`009`009`009`009; Create signal vec, push PSL
X`009PUSHL`009R5`009`009`009`009; Fault PC
X`009PUSHL`009#lib__trace`009`009`009; Push default signal name
X`009PUSHL`009#3`009`009`009`009; Push length
X`009MOVL`009SP, R6`009`009`009`009; Save addr of signal array
X
X12$:`009SUBL2`009#tbvec_len, SP`009`009`009; Make space for trace vector
X`009MOVL`009R2, first_fp( SP )`009`009; Set FP for first frame
X`009MOVL`009R4, fault_fp( SP )`009`009; FP for fault
X`009MOVL`009R5, fault_pc( SP )`009`009; Save faulting PC
X`009MOVL`009R6, signal_array( SP )`009`009; Address of signal array
X`009CLRQ`009sect_bounds( SP )`009`009; DST address
X`009MOVL`009SP, 4( R3 )`009`009`009; Set addr. of tb vector
X`009MOVL`009CHF$L_SIG_NAME(R6), R2`009`009; Save signal name
X`009MOVL`009sect_addr, R4`009`009`009; Get addr of trace
X`009BNEQU`009100$`009`009`009`009; Already mapped
X
X;+
X;`009Map in the traceback image.  Do not do all the work the system
X;`009does (translating LIB$TRACE etc), just map it.
X;
X;`009R2`009`009-- Signal name
X;`009R3`009`009-- Image arguments
X;-
X
X`009SUBL2`009#IHD$S_IHDDEF, SP`009`009; Create image header buffer
X`009MOVL`009SP, R1`009`009`009`009; Save address of header
X`009CLRQ`009-(SP)`009`009`009`009; Create return address array
X`009MOVL`009SP, R4`009`009`009`009; Save address of return array
X`009PUSHL`009#1@30-1`009`009`009`009; 2nd lw for input addr. array
X`009PUSHL`009#^X200`009`009`009`009; 1st lw for input addr. array
X`009MOVL`009SP, R0`009`009`009`009; Input address array
X
X;+
X;`009Activate the image.
X;-
X
X`009$IMGACT_S -
X`009`009NAME   = image, -`009`009; Name of file
X`009`009HDRBUF = (R1), -`009`009; Address of image header
X`009`009IMGCTL = #<IAC$M_MERGE!IAC$M_EXPREG>, -
X`009`009INADR  = (R0), -`009`009; Range to map into
X`009`009RETADR = (R4)`009`009`009; Range mapped into
X`009BLBS`009R0, 15$`009`009`009`009; Error?
X`009RET`009`009`009`009`009; Yes
X
X15$:`009$IMGFIX_S`009`009`009`009; Fix up image vectors
X`009BLBS`009R0, 20$`009`009`009`009; Error?
X`009RET`009`009`009`009`009; Yes
X20$:`009`009`009`009`009`009; No
X
X;+
X;`009Get the transfer address from the image.  The address of the array
X;`009that holds the range that was mapped is in R4.  The third longword
X;`009in the mapped section contains the transfer address for trace.
X;-
X
X`009MOVL`009(R4), R4`009`009`009; Get mapped address
X`009ADDL3`0098( R4 ), R4, R4`009`009`009; Compute start address
X`009MOVL`009R4, sect_addr`009`009`009; Save the start address
X`009`009
X;+
X;`009See if the error and output ISI values are specified or if we
X;`009defaulting to SYS$OUTPUT.
X;
X;`009R2`009`009-- Signal name
X;`009R3`009`009-- Argument list
X;`009R4`009`009-- Address to jump to
X;`009R7`009`009-- Error ISI
X;`009R8`009`009-- Error ISI
X;`009R5`009`009-- Old error ISI
X;`009R6`009`009-- Old output ISI
X;-
X
X100$:`009CLRQ`009R5`009`009`009`009; Clear OLD ISI values
X`009CMPB`009(AP), #2`009`009`009; Enough args passed?
X`009BLSSU`009105$`009`009`009`009; Nope, default
X`009MOVL`0094(AP), R7`009`009`009; Get the error ISI
X`009BEQLU`009105$`009`009`009`009; Ignore if zero
X`009MOVL`0098(AP), R8`009`009`009; Get the output ISI
X`009BEQLU`009105$`009`009`009`009; Ignore if zero
X`009BSBW`009trans_log`009`009`009; Translate the logical
X`009BLBC`009R0, 115$`009`009`009; Error?
X`009BSBW`009set_log`009`009`009`009; Set the new logical
X`009BLBC`009R0, 115$`009`009`009; Error?
X
X105$:`009CALLG`009(R3), 120$`009`009`009; Call trace
X`009MOVL`009R0, R3`009`009`009`009; Save the return status
X
X;+
X;`009Remove the logical name or re-define it to what it was.
X;-
X
X`009MOVQ`009R5, R7`009`009`009`009; Yes
X`009BSBW`009set_log`009`009`009`009; Redefine the logical name
X`009BLBC`009R0, 115$`009`009`009; Error?
X
X;+
X;`009If the signal name is still the same, then exit with SS$_NORMAL,
X;`009otherwise make sure the inhibit flag is clear and return the
X;`009code.
X;-
X
X110$:`009BICL2`009#STS$M_INHIB_MSG, R2`009`009; Clear inhib on signal name
X`009BICL2`009#STS$M_INHIB_MSG, R3`009`009; Clear inhib in ret status
X`009CMPL`009R2, R3`009`009`009`009; Are codes the same
X`009BNEQU`009116$`009`009`009`009; No
X`009MOVL`009#SS$_NORMAL, R0`009`009`009; Set success`009
X115$:`009RET`009`009`009`009`009; Return
X116$:`009MOVL`009R3, R0`009`009`009`009; No, return TRACE error
X`009RET`009`009`009`009`009; Return
X
X;+
X;`009This frame will be removed by the RET in TRACE.  A RET is not needed.
X;
X;`009R2`009`009-- Signal name
X;`009R4`009`009-- Address to jump to (not saved)
X;`009R5`009`009-- Old error ISI
X;`009R6`009`009-- Old output ISI
X;-
X
X120$:`009.WORD`009^M< R2, R5, R6 >
X`009JMP`009( R4 )
X
X;++
X;`009End of module.
X;--
X
X`009.END
$ GoSub Convert_File
$ File_is="LIBPTR.MSG"
$ Check_Sum_is=1578772832
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X.TITLE`009General Message Symbols
X.IDENT`009'1.00'
X
X!++
X!`009This file defines all symbols used in all programs at the University.
X!`009It is imperitive that the codes be properly defined
X!`009and that symbol values do not change once defined.  If they change,
X!`009then many programs can quickly become invalid.
X!
X!`009NEVER add a new code before another one in the same severity class
X!`009NEVER modify the .FACILITY number
X!`009NEVER change the format of the facility line.  The command procedure
X!`009needs it in this format so that it can assign the next facility
X!`009number.
X!--
X
X.PAGE
X.TITLE`009General_message_codes
X
X!++
X!`009General Library facility definitions.  The symbols for this library
X!`009are prefixed with a "LIB__".  Severity levels are grouped in sets of
X!`009255.
X!--
X
X.FACILITY`009LIB,1/PREFIX=LIB__
X
X.BASE`009`0091
X.SEVERITY`009SUCCESS`009`009`009`009! LIB success codes
X
X!+
X!`009Add success messages here.
X!-
X
X.PAGE
X.BASE`009`009256
X.SEVERITY`009INFORMATIONAL`009`009`009! LIB info codes
X
X!+
X!`009Add informational messages here.
X!-
X
X.PAGE
X.BASE`009`009511
X.SEVERITY`009WARNING`009`009`009`009! LIB warning codes
X
X!+
X!`009Add warning messages here.
X!-
X
XTRACE`009`009<traceback initiated.>
X
X.PAGE
X.BASE`009`009766
X.SEVERITY`009ERROR`009`009`009`009! LIB error codes
X
X!+
X!`009Add error messages here.
X!-
X
X.PAGE
X.BASE`009`0091021
X.SEVERITY`009SEVERE`009`009`009`009! LIB severe error codes
X
X!+
X!`009Add severe messages here.
X!-
X
X!++
X!`009End of Facility "LIB" error codes.
X!--
X
X.END
$ GoSub Convert_File
$ File_is="TEST.PAS"
$ Check_Sum_is=1142631545
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
XPROGRAM test;
X
XPROCEDURE lib_trace;
X    EXTERN;
X
XPROCEDURE c;
X
XBEGIN
X
X    lib_trace;
X
XEND;
X
XPROCEDURE b;
X
XBEGIN
X
X    c;
X
XEND;
X
XPROCEDURE a;
X
XBEGIN
X
X    b;
X
XEND;
X
XBEGIN
X
X    a;
X
XEND.
$ GoSub Convert_File
$ File_is="COMPILE.COM"
$ Check_Sum_is=1364354292
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ !
X$ !`009Simple compile and link.
X$ !
X$ MACRO trace
X$ PASCAL/DEBUG/NOOPT test
X$ MESSAGE/OBJ LIBPTR
X$ LINK/TRACEBACK test,trace,libptr
X$ !
X$ RUN test
X$ !
X$ !
$ GoSub Convert_File
$ Exit
------

