.title TRACETRAP - Try to trap traceback to a file .ident 'V1.0' .library 'sys$share:lib' ;++ ; ; Facility: TRACETRAP ; ; Author: David G. North, CCP ; ; Date: 90.12.04 ; ; Usage: ; Establishing the trap: ; MACRO-32: ; pushaw callback ; pushaq logfilename_descriptor ; calls #2,g^INIT_TRACE_TRAP ; C: ; struct dsc$descriptor_s d_filename; ; void (*callback)(); ; INIT_TRACE_TRAP(&d_filename,callback); ; ; Callback occurs at trace image exit with the parameters: ; Macro: ; 4(AP) = Condition code ; 8(AP) = Address of internal filename_copy descriptor ; C: ; void callback(code,d_fname) ; unsigned long int code; ; struct dsc$descriptor_s *d_fname; ;-- $chfdef ;Define condition handler values $lnmdef ;Logical name item defs $psldef ;Access mode definitions $rmsalldef ;RMS definitions $sfdef ;Define saved frame offsets $stsdef ;VMS Status structure $ssdef ;Define system statii ; psect definitions .psect $$data,rd,wrt,noshr,noexe,nopic .psect $$code,exe,nowrt,shr,pic .psect $$data d_outtxt: .long 128 ;place for user filename copy .address outtxt outtxt: .blkb 128 crelnmitems: .long !0,outtxt,0,0 d_savsystran: .long 12 .address savsystran savsystran: .blkb 12 d_systran: .long 12 ;translation of SYS$PUTMSG logical .address systran systran: .blkb 12 systranstatus: .long 0 systranitems: .long !12,systran,d_systran,0 syscrelnmitems: .long !0,systran,0,0 d_sysotran: .long 128 ;translation of SYS$OUTPUT logical .address sysotran sysotran: .blkb 128 sysoacmode: .long 0 sysostatus: .long 0 sysotranitems: .long !128,sysotran,d_sysotran .long !1,sysoacmode,0,0 sysocrelnitems: .long !0,sysotran,0,0 d_sysetran: .long 128 ;translation of SYS$ERROR logical .address sysetran sysetran: .blkb 128 syseacmode: .long 0 sysestatus: .long 0 sysetranitems: .long !128,sysetran,d_sysetran .long !1,syseacmode,0,0 sysecrelnitems: .long !0,sysetran,0,0 exitsts: .long 0 exithblk: .long 0 .address exit_trap .long 1 .address exitsts callbackvec: .long 0 sysput: .ascid /SYS$PUTMSG/ sysout: .ascid /SYS$OUTPUT/ syserr: .ascid /SYS$ERROR/ process: .ascid /LNM$PROCESS/ ESCAPE = 1@8+27 .psect $$code .entry INIT_TRACE_TRAP, ^m movl SF$L_SAVE_FP(FP),r0 ;get caller's FP movaw trapper,(r0) ;start our trapper routine movaq @4(AP),r0 ;point to user's filename movzwl (r0),d_outtxt ;set output length movw (r0),crelnmitems ;setup for SYS$xxx redefinitions movc3 (r0),@4(r0),outtxt ;stuff filename into local storage movl 8(AP),callbackvec ;setup the callbacl vector address movzwl #SS$_NORMAL,r0 ;return all OK ret ;bye! trapper: .word ^m movl CHF$L_SIGARGLST(AP),r4 ;signal argument list cmpl CHF$L_SIG_NAME(r4),#SS$_DEBUG beql notme cmpl CHF$L_SIG_NAME(r4),#SS$_UNWIND ;is this an unwind??? beql more ;yep... keep on unwinding movl CHF$L_MCHARGLST(AP),r5 ;get mechanism list address movl CHF$L_SIG_NAME(r4),CHF$L_MCH_SAVR0(r5) ;copy signal name brb setuptrace ;setup for trace & capture notme: movl #SS$_RESIGNAL,r0 ;resignal the exception more: ret ;return to caller of excepted procedure setuptrace: cmpzv #STS$V_SEVERITY,#STS$S_SEVERITY,- CHF$L_SIG_NAME(r4),#STS$K_SEVERE bneq notme ;This one won't exit... skiptrap ; Now... we have a signal in hand that's going to munch the program... ; need to setup an exit trap, and reset the PUTMSG stuff so that the trace ; will go somewhere useful, and so we can re-call the user with the trapped ; information. pushl #1 ;destroy file access, save info calls #1,close_msg ;make sure $PUTMSG is shutup $CRELNM_S - ;redefine SYS$OUTPUT tabnam = process,- lognam = sysout,- itmlst = crelnmitems $CRELNM_S - ;redefine SYS$ERROR tabnam = process,- lognam = syserr,- itmlst = crelnmitems $DCLEXH_S - ;trap the TRACE exit desblk = exithblk brw notme ;play like nothing happened close_msg: .word ^m $TRNLNM_S - tabnam = process,- lognam = sysput,- itmlst = systranitems blbc 4(AP),10$ ;jump if nosave status movl r0,systranstatus ;save translation status 10$: blbs r0,20$ cmpw r0,#SS$_NOLOGNAM ;see if error is just 'notran' beql 40$ ;jump... no need to mess with it ret 20$: cmpw #ESCAPE,systran beql 30$ movzwl #SS$_ABORT,r0 ret 30$: $DELLNM_S - tabnam = process,- lognam = sysput movab -FAB$C_BLN(SP),SP ;make space for FAB movc5 #0,#0,#0,#FAB$C_BLN,(SP) ;zero new FAB block movl SP,r2 ;address of block movb #FAB$C_BID,FAB$B_BID(r2) ;set block ID movb #FAB$C_BLN,FAB$B_BLN(r2) ;set block length movw systran+6,FAB$W_IFI(r2) ;set SYS$OUTPUT IFI $close - fab = (r2) ;Poof! SYS$OUTPUT wasted. cmpw systran+6,systran+8 ;is SYS$ERROR different? beql 40$ ;nope... no re-close movw systran+8,FAB$W_IFI(r2) ;set SYS$ERROR IFI $close - fab = (r2) ;Poof! SYS$ERROR wasted. 40$: blbs 4(AP),50$ ;if save requested, doit ret 50$: movc3 d_systran,@d_systran+4,@d_savsystran+4 ;copy SYS$PUTMSG junk movw d_systran,d_savsystran ;copy length $TRNLNM_S - tabnam = process,- lognam = sysout,- itmlst = sysotranitems movl r0,sysostatus $TRNLNM_S - tabnam = process,- lognam = syserr,- itmlst = sysetranitems movl r0,sysestatus ret restore_msg: .word ^m $DELLNM_S - tabnam = process,- lognam = sysput blbc systranstatus,dosyso ;skip re-define if err get movw d_savsystran,syscrelnmitems ;set length for re-copy $CRELNM_S - ;redefine SYS$PUTMSG to old tabnam = process,- lognam = sysput,- itmlst = syscrelnmitems dosyso: ;restore SYS$OUTPUT definitions blbc sysostatus,delsyso cmpb sysoacmode,#PSL$C_USER bneq delsyso movw d_sysotran,sysocrelnitems $CRELNM_S - ;redefine SYS$OUTPUT to old tabnam = process,- lognam = sysout,- itmlst = sysocrelnitems brb dosyse delsyso: $DELLNM_S - tabnam = process,- lognam = sysout dosyse: ;restore SYS$ERROR definitions blbc sysestatus,delsyse cmpb syseacmode,#PSL$C_USER bneq delsyse movw d_sysetran,sysecrelnitems $CRELNM_S - ;redefine SYS$PUTMSG to old tabnam = process,- lognam = syserr,- itmlst = sysecrelnitems ret ;fully restored delsyse: $DELLNM_S - tabnam = process,- lognam = syserr ret ;fully restored exit_trap: .word ^m<> clrl -(SP) ;flag for close-only calls #1,close_msg ;re-close the message file calls #0,restore_msg ;reset SYS$OUTPUT junk movl callbackvec,r0 ;get user callback vector beql 10$ ;skip the callback if 0 pushaq d_outtxt ;descriptor for filename pushl exitsts ;code calls #2,(r0) ;call the user back 10$: movl exitsts,r0 ;recover exitstatus ret .end