$!/* acf3:comp.os.vms / leichter@LRW.COM (Jerry Leichter) /  1:22 pm  Apr  6, 1991 */
$!
$!	I am using a set of malloc and free replacements to aid in finding
$!	memory leaks. They work like this:
$!
$!	#define malloc(n) test_malloc(n, __FILE__, __LINE__)
$!
$!	and in the malloc_test.c file:
$!
$!	void * test_malloc(int n, char *filename, int linenumber)
$!	{
$!		printf("Malloced %d bytes at line %d of file %s\n", n,
$!				linenumber, filename);
$!		return malloc(n);
$!	}
$!
$!	Oh well, to the point. What I would like to do is to get rid of the
$!	__LINE__ and __FILE__ macros, and somehow access the traceback
$!	information.  DEBUG has this information, because it is stored in the
$!	EXE, but: how can I access this?
$!
$!There is no documented way to do this, and - curiously, considering how often
$!the question has come up over the years - I haven't seen anyone cobble
$!together any unsupported code to do it either.  I HAVE seen unsupported code
$!(by Nick de Smith) to call the system traceback routine; I've enclosed a copy
$!I saved of his message below.
$!
$!Note that de Smith's elegant hack isn't really necessary:  You can get exactly
$!the same effect by signaling some dummy condition with a severity of Warning.
$!The default traceback handler will print a traceback and then continue execu-
$!tion.  (If the program is run /DEBUG, however, the Debugger will stop it.)
$!
$!	As this is probably asking for the impossible (or highly undocumented,
$!	which is roughly equivalent), I'll settle for the nonsymbolic stack
$!	info DEBUG gives you with the "SHOW STACK 3" command. The latter was
$!	implemented in the december, 1990 issue of VAX professional on
$!	profiling.  Unfortunately, the article doesn't include a listing of
$!	the "tiny MACRO subroutine" which does the dirty work.
$!
$!Actually, this is easy to do.  By signalling SS$_DEBUG, your program can get
$!the Debugger running.  It can also pass one or more commands for the Debugger
$!to execute.  This is all documented in the Debugger book.
$!
$!	Simply having the call stack info ("I was called from PC 0012f348, who
$!	in turn was called from 00058db0") will give enough information to
$!	quickly locate the offending code in a linker map.
$!
$!This is very easy to do if you understand the VAX architecture.  You'd write
$!a little function that would examine its own stack frame to see where it was
$!called from, then walk backward, stack frame by stack frame (they are threaded
$!through by the saved FP fields) printing the saved PC values.  The function
$!could be written in MACRO; or a couple of lines of MACRO could return the
$!starting FP to a C program, with everything else in C; or you could even
$!write the whole thing in C using the built_in _READ_GPR instruction to read
$!the FP (register 13).
$!							-- Jerry
$!
$!-----------------
$!Date: Tue, 7 Aug 90   9:40 BST
$!From: Nick de Smith <ncdlab.ulcc.ac.uk!NICK>
$!To: INFO-VAX <@NSFnet-Relay.AC.UK:INFO-VAX@crvax.sri.com>
$!Subject: RE: Calling TRACEBACK
$!
$!Hi,
$!
$!I have had many requests for the interface to TRACEBACK, so I am posting a SHORT
$!routine that can be called from any language to create a traceback listing and
$!then continue. It can easily be integrated into a AST delivery program to be
$!dropped onto another process. This is left as an exercise for the reader - If
$!you get really stuck I'll send the specific code for that to interested parties.
$!
$!TRACE.1_OF_1 follows at the end of this message.
$!
$!Just for the record, I have to pay for ALL incoming AND outgoing messages from
$!my site. As we are a commercial organisation, we can afford the $100/pcm for the
$!mail and the $12000/year for the data line. However, if I want to release a
$!largish package (like PDUMP a few weeks ago) I still feel that its MY
$!responsibility to distribute it to interested parties, even though I have so far
$!had to mail (via a VMSSERV) over 200 copies of this 46Kbyte package. If I were
$!an academic or private user, I almost certainly could not afford to do this, and
$!thus would be very reluctant to distribute it personally, and would thus have to
$!post it, or not to distribute it at all. I cannot receive general newsgroups so
$!the vms.sources route is not an option. I could ask for someone else to carry
$!the cost of "serving" the package, but why should they?
$!
$!The point I am rambling on about is that there is NO simple answer to the
$!post/don't post situation - there are so many different types of users on the
$!network that NO general rule can be applied to all of them. The main tenet used
$!by Info-VAX subscribers is RESPONSIBILITY. Just try to be aware of the
$!consequences of your actions. If its any consellation, I have come back from a
$!month away to find 100s of Kbytes of (largly) rubbish on this issue - far more
$!than the cost of letting the occasional posting go through.
$!
$!Yours in nearly terminal boredom,
$!
$!nick	NICK@NCDLAB.ULCC.AC.UK
$!
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  7-AUG-1990 09:17:18.47   By user NICK 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. PROCESS_TRACE.MAR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X.title`09PROCESS_TRACE`09Generate a process traceback
X;++
X; PROCESS_TRACE
X;
X; Date  :`0902-Jan-89
X; Author:`09Nick de Smith
X;`09`09Applied Telematics Services, 7 Vale Avenue
X;`09`09Tunbridge Wells, Kent TN1 1DJ, England.
X;`09`09+44 892 511000, PSI%234213300154::NICK
X;
X; Copyright (c) 1989 by Applied Telematics Group Limited and Nick de Smith.
X; This software is supplied for information only. No guarantee is supplied f
Vor
X; this software, and no liability will be accepted for any action resulting
V from
X; the use of this software or the information contained herein. Under no
X; circumstances may this software be used for commercial gain, including its
V sale,
X; lease or loan. This software may be copied only with the inclusion of this
X; copyright notice. The author is prepared to enter into correspondance with
X; interested parties, but will not necessarily maintain this software. Havin
Vg said
X; all that, enjoy it!`20
X;
X; Description:
X;
X; This routine invokes the VMS traceback facility to generate an image trace
Vback
X; of the current process whenever called. The calling process may then conti
Vnue.
X; A fake "signal" of SS$_DEBUG is used for the condition, the PC and PSL bei
Vng
X; those active when PROCESS_TRACE was called. The traceback is displayed on
V SYS$OUTPUT.
X;
X; Note that for some reason (best known to itself) TRACE executes a $EXIT, s
Vo we
X; trap it with an exit handler, and convert it into a RET. See the comments
V in the
X; code for EXIT_HANDLER, below.
X;
X; Note that TRACE may have side effects, eg. it uses EFN 0 for output. I thi
Vnk that
X; this routine is "safe", but, as with all undocumented features, don't walk
V in
X; with blind faith.
X;
X; Edit`09Edit date`09By`09Why
X;  01`0902-Jan-89`09NMdS`09First attempt
X;--
X`09.Ident`09/V01.01/
X
X`09.library`09"SYS$LIBRARY:LIB"
X`09.link`09`09"SYS$SYSTEM:SYS.STB" /Selective_Search
X
X`09$chfdef`09`09`09`09; Define condition handler values
X`09$iacdef`09`09`09`09; Image activator definitions
X`09$ihddef`09`09`09`09; Image file header definitions
X`09$psldef`09`09`09`09; Process status definitions
X`09$sfdef`09`09`09`09; Define saved frame offsets
X`09$ssdef`09`09`09`09; Define system statii
X`09$vadef`09`09`09`09; Define virtual address offsets
X`0C
X`09.subtitle`09TRACE data area
X`09.psect`09$DATA`09Rd, Wrt, NoShr, NoExe, Pic, Long
X;
X; TRACE traceback vector. This is required so that TRACE can locate the
X; stack frames and condition that it has to report on. The layout of this
X; vector is defined in module SYSIMGSTA.
X;
X`09$defini`09TRACE
X`09. = 0
X`09$def`09FAULT_PC`09.blkl`091`09; "Fault PC"
X`09$def`09FAULT_FP`09.blkl`091`09; "Fault FP"
X`09$def`09FIRST_FP`09.blkl`091`09; FP when user image invoked
X`09$def`09SIGNAL_ARRAY`09.blkl`091`09; => Fake signal array
X`09$def`09SECT_BOUNDS`09.blkq`091`09; Beginning of TRACE symbol table
X`09$def`09TRACE_CTX_SIZ`09`09`09; Size of TRACE's own storage
X`09$defend`09TRACE
X
XIMGNAM:`09.ascid "TRACE"`09`09`09; Name of the traceback utility to use
XDFLNAM:`09.ascid "SYS$LIBRARY:.EXE"`09; Defaults to use for the name
XHDRBUF:`09.blkb`09512`09`09`09; Buffer to use for image header
XINADR:`09.long`09`5Ex200, 1@VA$V_P1-1`09; Map TRACE anywhere in P0
XRETADR:`09.long`090, 0`09`09`09; Returned mapped range
X
XVMS_EXIT_STATUS:`09`09`09; TRACE's $EXIT status
X`09.long`090
XDESBLK:`09`09`09`09`09; $EXIT handler block
X`09.long`090`09`09`09; FLINK for exit block
X`09.address EXIT_HANDLER`09`09; Exit handler to use
X`09.long`090`09`09`09; Argument count
X`09.address VMS_EXIT_STATUS`09; Where to place $EXIT status
XSAVED_FP: .long`090`09`09`09; Saved FP of PROCESS_TRACE
X`0C
X.subtitle PROCESS_TRACE`09Generate an image traceback
X;++
X; PROCESS_TRACE - Generate an image traceback
X;
X; Call:`09`09status.wl = PROCESS_TRACE()
X;
X; We generate an argument list for TRACE:
X;
X;`094(ap)`09=> TRACE vector
X;`098(ap)`09=> CLI parse information routine
X;`0912(ap)`09=> IHD (image header)
X;`0916(ap)`09=> IFD (image file descriptor)
X;`0920(ap)`09=  LINK status bits (IHD$L_LNKFLAGS)
X;`0924(ap)`09=  0 (CLI status bits (eg. CLI$V_xxxx))
X;
X; Passed:
X;`09lots of implicit inputs (your whole process environment)
X;
X; Returns:
X; `09R0`09= Final system status of call
X;--
X`09.psect $CODE`09Rd, NoWrt, Shr, Exe, Pic, Long
X
X.entry`09PROCESS_TRACE, `5Em<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11> ; Must save al
Vl registers
X;
X`09movab`09g`5ELIB$SIG_TO_RET, SF$A_HANDLER(fp) ; Return all errors to calle
Vr
X;
X; Build TRACE's traceback vector on the stack
X;
X`09subl`09#TRACE_CTX_SIZ, sp`09; Get some space for TRACE own data
X`09movl`09sp, r0`09`09`09; R0 => TRACE context area
X`09movl`09SF$L_SAVE_PC(fp), FAULT_PC(r0) ; ...callers PC in traceback vector
X`09movl`09SF$L_SAVE_FP(fp), FAULT_FP(r0)`09; ...callers FP in traceback vect
Vor
X`09clrq`09SECT_BOUNDS(r0)`09`09; Init section bounds for TRACE
X;
X; Locate frame of main program (first frame to TRACE from)
X;
X`09movl`09fp, r1`09`09`09; R1 => Our frame
X10$:`09movl`09r1, r2`09`09`09; Save this frame
X`09movl`09SF$L_SAVE_FP(r1), r1`09; R1 => Callers frame
X`09tstl`09SF$L_SAVE_FP(r1)`09; Is there a previous frame?
X`09bneq`0910$`09`09`09; Branch if there is
X`09movl`09r2, FIRST_FP(r0)`09; Save first FP in traceback vector
X;
X; Build fake signal array on the stack
X;
X`09subl`09#CHF$S_CHFDEF1+<1*4>, sp ; Get space for signal array
X`09movl`09sp, r1`09`09`09; R1 => Fake signal array
X`09movl`09#3, CHF$L_SIG_ARGS(r1)`09; Three arguments...
X`09movl`09#SS$_DEBUG, CHF$L_SIG_NAME(r1)`09; ...false signal is SS$_DEBUG
X`09movl`09SF$L_SAVE_PC(fp), CHF$L_SIG_ARG1(r1)`09; ...caller's PC
X`09movpsl`09CHF$L_SIG_ARG1+4(r1)`09; ...caller's PSL
X`09movl`09r1, SIGNAL_ARRAY(r0)`09; Save pointer in fake argument list
X;
X; Build TRACE's argument list
X;
X`09subl`09#<7*4>, sp`09`09; Get some space for a fake argument list
X`09movl`09sp, ap`09`09`09; AP => EXE$IMGSTA style fake argument list
X`09movzbl`09#6, (ap)`09`09; 6 arguments
X`09movl`09r0, 4(ap)`09`09; => TRACE vector
X`09movab`09g`5EEXE$CLI_UTILSRV, 8(ap) ; => Dummy CLI callback (not used)
X`09movq`09g`5EMMG$IMGHDRBUF, r0`09; R0 => IHD, R1 => IFD
X`09movl`09r0, 12(ap)`09`09; => Image IHD
X`09movl`09r1, 16(ap)`09`09; => Image file IFD
X`09movl`09IHD$L_LNKFLAGS(r0), 20(ap) ; LINK status bits (not used)
X`09clrl`0924(ap)`09`09`09; CLI status bits (not used)
X;
X; Activate the TRACE image
X;
X`09$imgact_s`09`09 -`09;
X`09`09name   = IMGNAM`09,-`09; Name of traceback utility
X`09`09dflnam = DFLNAM`09,-`09; Name defaults to use
X`09`09hdrbuf = HDRBUF`09,-`09; Where to place header
X`09`09imgctl = #<IAC$M_MERGE!IAC$M_EXPREG>,- ; Merge and expand region
X`09`09inadr  = INADR`09,-`09; Where to map code (first free VA space)
X`09`09retadr = RETADR`09,-`09; Mapped addresses returned here
X`09`09ident  = 0`09,-`09; No ident specified
X`09`09acmode = #PSL$C_USER`09; Map at minimum access mode
X`09blbc`09r0, 20$`09`09`09; Check for any error
X`09$imgfix_s`09`09`09; Do any relocation fixups
X`09blbc`09r0, 20$`09`09`09; Check for any error
X
X`09movl`09fp, SAVED_FP`09`09; Save our FP
X`09$dclexh_s -`09`09`09; Trap $EXIT by TRACE
X`09`09desblk = DESBLK
X`09blbc`09r0, 20$`09`09`09; Check for error
X
X`09movl`09RETADR, r1`09`09; Get load address
X`09movab`09@8(r1)`5Br1`5D, r1`09`09; Calculate the entry address
X`09jsb`09(r1)`09`09`09; Call the traceback utility
X`09; Never get here, as TRACE executes a $EXIT. See the comments
X`09; for EXIT_HANDLER below for an explanation.
X20$:`09ret`09`09`09`09; Return to caller
X`0C
X`09.subtitle`09EXIT_HANDLER`09Trap TRACE's $EXIT call
X;+
X; EXIT_HANDLER`09Exit handler for PROCESS_TRACE
X;
X; The above routine, PROCESS_TRACE, executes a JSB to the TRACE module.
X; TRACE terminates with a $EXIT. In order to allow the program calling
X; this module to continue, this exit handler traps the $EXIT and searches
X; back through the call frames for the frame of the establisher of the
X; exit handler (which is, of course, PROCESS_TRACE). The RET from the
X; exit handler is executed in the context of PROCESS_TRACE, which will
X; return (after restoring all registers) to the caller of PROCESS_TRACE
X; such that the $EXIT is dismissed, and so that the main program may
X; continue to execute. Nasty, maybe, but it works!
X;-
XEXIT_HANDLER:
X`09.word`09`5Em<>`09`09`09; No save mask
X`09movl`09fp, r1`09`09`09; => Current FP
X10$:`09movl`09SF$L_SAVE_FP(r1), r1`09; => Caller's FP
X`09cmpl`09r1, SAVED_FP`09`09; Was it our caller's?
X`09bneq`0910$`09`09`09; No
X`09movl`09r1, fp`09`09`09; Yes, set it as current FP
X`09movl`09VMS_EXIT_STATUS, r0`09; Make $EXIT status the return code
X`09ret`09`09`09`09; Back to mainline code
X
X`09.end
X`0C
$ CALL UNPACK PROCESS_TRACE.MAR;1 1263716253
$ v=f$verify(v)
$ EXIT
/* ---------- */