From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  7-AUG-1990 23:07:22.64
To:	MRGATE::"ARISIA::EVERHART"
CC:	
Subj:	RE: Calling TRACEBACK

Received:  by crdgw1.ge.com (5.57/GE 1.70)
	 id AA22125; Tue, 7 Aug 90 11:42:45 EDT
Message-Id:  <9008071542.AA22125@crdgw1.ge.com>
Received: From NSFNET-RELAY.AC.UK by CRVAX.SRI.COM with TCP; Tue,  7 AUG 90 08:21:09 PDT
Received: from sun.nsfnet-relay.ac.uk by vax.NSFnet-Relay.AC.UK 
           via Janet with NIFTP  id aa03874; 7 Aug 90 9:27 BST
Date:           Tue, 7 Aug 90   9:40 BST
From: Nick de Smith <NICK@ncdlab.ulcc.ac.uk>
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

