.title PROCESS_TRACE Generate a process traceback ;++ ; PROCESS_TRACE ; ; Date : 02-Jan-89 ; Author: Nick de Smith ; Applied Telematics Services, 7 Vale Avenue ; Tunbridge Wells, Kent TN1 1DJ, England. ; +44 892 511000, PSI%234213300154::NICK ; ; Copyright (c) 1989 by Applied Telematics Group Limited and Nick de Smith. ; This software is supplied for information only. No guarantee is supplied for ; this software, and no liability will be accepted for any action resulting from ; the use of this software or the information contained herein. Under no ; circumstances may this software be used for commercial gain, including its sale, ; lease or loan. This software may be copied only with the inclusion of this ; copyright notice. The author is prepared to enter into correspondance with ; interested parties, but will not necessarily maintain this software. Having said ; all that, enjoy it! ; ; Description: ; ; This routine invokes the VMS traceback facility to generate an image traceback ; of the current process whenever called. The calling process may then continue. ; A fake "signal" of SS$_DEBUG is used for the condition, the PC and PSL being ; those active when PROCESS_TRACE was called. The traceback is displayed on SYS$OUTPUT. ; ; Note that for some reason (best known to itself) TRACE executes a $EXIT, so we ; trap it with an exit handler, and convert it into a RET. See the comments in the ; code for EXIT_HANDLER, below. ; ; Note that TRACE may have side effects, eg. it uses EFN 0 for output. I think that ; this routine is "safe", but, as with all undocumented features, don't walk in ; with blind faith. ; ; Edit Edit date By Why ; 01 02-Jan-89 NMdS First attempt ;-- .Ident /V01.01/ .library "SYS$LIBRARY:LIB" .link "SYS$SYSTEM:SYS.STB" /Selective_Search $chfdef ; Define condition handler values $iacdef ; Image activator definitions $ihddef ; Image file header definitions $psldef ; Process status definitions $sfdef ; Define saved frame offsets $ssdef ; Define system statii $vadef ; Define virtual address offsets .subtitle TRACE data area .psect $DATA Rd, Wrt, NoShr, NoExe, Pic, Long ; ; TRACE traceback vector. This is required so that TRACE can locate the ; stack frames and condition that it has to report on. The layout of this ; vector is defined in module SYSIMGSTA. ; $defini TRACE . = 0 $def FAULT_PC .blkl 1 ; "Fault PC" $def FAULT_FP .blkl 1 ; "Fault FP" $def FIRST_FP .blkl 1 ; FP when user image invoked $def SIGNAL_ARRAY .blkl 1 ; => Fake signal array $def SECT_BOUNDS .blkq 1 ; Beginning of TRACE symbol table $def TRACE_CTX_SIZ ; Size of TRACE's own storage $defend TRACE IMGNAM: .ascid "TRACE" ; Name of the traceback utility to use DFLNAM: .ascid "SYS$LIBRARY:.EXE" ; Defaults to use for the name HDRBUF: .blkb 512 ; Buffer to use for image header INADR: .long ^x200, 1@VA$V_P1-1 ; Map TRACE anywhere in P0 RETADR: .long 0, 0 ; Returned mapped range VMS_EXIT_STATUS: ; TRACE's $EXIT status .long 0 DESBLK: ; $EXIT handler block .long 0 ; FLINK for exit block .address EXIT_HANDLER ; Exit handler to use .long 0 ; Argument count .address VMS_EXIT_STATUS ; Where to place $EXIT status SAVED_FP: .long 0 ; Saved FP of PROCESS_TRACE .subtitle PROCESS_TRACE Generate an image traceback ;++ ; PROCESS_TRACE - Generate an image traceback ; ; Call: status.wl = PROCESS_TRACE() ; ; We generate an argument list for TRACE: ; ; 4(ap) => TRACE vector ; 8(ap) => CLI parse information routine ; 12(ap) => IHD (image header) ; 16(ap) => IFD (image file descriptor) ; 20(ap) = LINK status bits (IHD$L_LNKFLAGS) ; 24(ap) = 0 (CLI status bits (eg. CLI$V_xxxx)) ; ; Passed: ; lots of implicit inputs (your whole process environment) ; ; Returns: ; R0 = Final system status of call ;-- .psect $CODE Rd, NoWrt, Shr, Exe, Pic, Long .entry PROCESS_TRACE, ^m ; Must save all registers ; movab g^LIB$SIG_TO_RET, SF$A_HANDLER(fp) ; Return all errors to caller ; ; Build TRACE's traceback vector on the stack ; subl #TRACE_CTX_SIZ, sp ; Get some space for TRACE own data movl sp, r0 ; R0 => TRACE context area movl SF$L_SAVE_PC(fp), FAULT_PC(r0) ; ...callers PC in traceback vector movl SF$L_SAVE_FP(fp), FAULT_FP(r0) ; ...callers FP in traceback vector clrq SECT_BOUNDS(r0) ; Init section bounds for TRACE ; ; Locate frame of main program (first frame to TRACE from) ; movl fp, r1 ; R1 => Our frame 10$: movl r1, r2 ; Save this frame movl SF$L_SAVE_FP(r1), r1 ; R1 => Callers frame tstl SF$L_SAVE_FP(r1) ; Is there a previous frame? bneq 10$ ; Branch if there is movl r2, FIRST_FP(r0) ; Save first FP in traceback vector ; ; Build fake signal array on the stack ; subl #CHF$S_CHFDEF1+<1*4>, sp ; Get space for signal array movl sp, r1 ; R1 => Fake signal array movl #3, CHF$L_SIG_ARGS(r1) ; Three arguments... movl #SS$_DEBUG, CHF$L_SIG_NAME(r1) ; ...false signal is SS$_DEBUG movl SF$L_SAVE_PC(fp), CHF$L_SIG_ARG1(r1) ; ...caller's PC movpsl CHF$L_SIG_ARG1+4(r1) ; ...caller's PSL movl r1, SIGNAL_ARRAY(r0) ; Save pointer in fake argument list ; ; Build TRACE's argument list ; subl #<7*4>, sp ; Get some space for a fake argument list movl sp, ap ; AP => EXE$IMGSTA style fake argument list movzbl #6, (ap) ; 6 arguments movl r0, 4(ap) ; => TRACE vector movab g^EXE$CLI_UTILSRV, 8(ap) ; => Dummy CLI callback (not used) movq g^MMG$IMGHDRBUF, r0 ; R0 => IHD, R1 => IFD movl r0, 12(ap) ; => Image IHD movl r1, 16(ap) ; => Image file IFD movl IHD$L_LNKFLAGS(r0), 20(ap) ; LINK status bits (not used) clrl 24(ap) ; CLI status bits (not used) ; ; Activate the TRACE image ; $imgact_s - ; name = IMGNAM ,- ; Name of traceback utility dflnam = DFLNAM ,- ; Name defaults to use hdrbuf = HDRBUF ,- ; Where to place header imgctl = #,- ; Merge and expand region inadr = INADR ,- ; Where to map code (first free VA space) retadr = RETADR ,- ; Mapped addresses returned here ident = 0 ,- ; No ident specified acmode = #PSL$C_USER ; Map at minimum access mode blbc r0, 20$ ; Check for any error $imgfix_s ; Do any relocation fixups blbc r0, 20$ ; Check for any error movl fp, SAVED_FP ; Save our FP $dclexh_s - ; Trap $EXIT by TRACE desblk = DESBLK blbc r0, 20$ ; Check for error movl RETADR, r1 ; Get load address movab @8(r1)[r1], r1 ; Calculate the entry address jsb (r1) ; Call the traceback utility ; Never get here, as TRACE executes a $EXIT. See the comments ; for EXIT_HANDLER below for an explanation. 20$: ret ; Return to caller .subtitle EXIT_HANDLER Trap TRACE's $EXIT call ;+ ; EXIT_HANDLER Exit handler for PROCESS_TRACE ; ; The above routine, PROCESS_TRACE, executes a JSB to the TRACE module. ; TRACE terminates with a $EXIT. In order to allow the program calling ; this module to continue, this exit handler traps the $EXIT and searches ; back through the call frames for the frame of the establisher of the ; exit handler (which is, of course, PROCESS_TRACE). The RET from the ; exit handler is executed in the context of PROCESS_TRACE, which will ; return (after restoring all registers) to the caller of PROCESS_TRACE ; such that the $EXIT is dismissed, and so that the main program may ; continue to execute. Nasty, maybe, but it works! ;- EXIT_HANDLER: .word ^m<> ; No save mask movl fp, r1 ; => Current FP 10$: movl SF$L_SAVE_FP(r1), r1 ; => Caller's FP cmpl r1, SAVED_FP ; Was it our caller's? bneq 10$ ; No movl r1, fp ; Yes, set it as current FP movl VMS_EXIT_STATUS, r0 ; Make $EXIT status the return code ret ; Back to mainline code .end