C [This is Program 1 of TRACEBACK.TXT.] C Program: ERROR_TRACEBACK.FOR [Subroutine] C Author: Matthew Rabuzzi, ASK Computer Systems B.V., Nyon Switzerland C Date: 1-May-1989 C The ERROR_TRACEBACK subroutine prints out a traceback (symbolic stack dump) C to SYS$OUTPUT. The traceback begins not with ERROR_TRACEBACK's caller but C with the caller's caller: The caller is assumed to be a central error- C handling routine which we do not want the user to see; the caller's C caller is the routine that actually had the error. C C The module name of the caller's caller is returned to the caller, which C can then write that name in some central error log or whatever. C C Since this routine is intended as part of an error-handler, it is best C if TRACEBACK_INIT_OPEN has already been called by the main program's C initialization code. If you don't do this, then when you arrive here C you may end up with an EXQUOTA/FILLM error, and it's not good to have C the error-handler blow up. On the other hand, it's probably better not C to call TRACEBACK_INIT_READ in the mainline init, since that overhead C of line-by-line reading of the .ADDR should only be incurred if an error C really occurs...not every time you start the program. C C If any error occurred in either INIT routine, that routine will have printed C out an error message at that time, but never subsequently. Subsequently, C absolutely nothing will be written (not even the %TRACE-I-TRACEBACK line). C C If desired, you can remove all WRITE statements from the INIT routines, C to make this completely "silent" and not alarm the general user C with irrelevant details such as "File not found XYZ.ADDR" ... OPTIONS /EXTEND_SOURCE SUBROUTINE ERROR_TRACEBACK (TOPMODULE) IMPLICIT INTEGER*4 (A-Z) PARAMETER MODULENAMELEN = 31 CHARACTER*(MODULENAMELEN) MODULENAME CHARACTER*(*) TOPMODULE TOPMODULE = ' ' SF_FP = 0 C Skip our caller, which is an error handler (comment out this line if you C wish the error-handler to show up in the stack dump) ITRACE = TRACEBACK (SF_FP, MODULENAME, REL_PC, ABS_PC) IF (ITRACE .GT. 0) THEN WRITE (6,100) DO WHILE (ITRACE .GT. 0) ITRACE = TRACEBACK (SF_FP, MODULENAME, REL_PC, ABS_PC) IF (ITRACE) THEN WRITE (6,110) MODULENAME, REL_PC, ABS_PC IF (TOPMODULE .EQ. ' ') TOPMODULE = MODULENAME ENDIF ENDDO ENDIF 100 FORMAT (' %TRACE-I-TRACEBACK, symbolic stack dump follows (user traceback)'/ * ' module name routine name line rel PC abs PC') 110 FORMAT (XA,T60,Z8.8,T70,Z8.8) END C [This is Program 2 of TRACEBACK.TXT.] C Program: TRACEBACK.FOR [Subroutine] C Author: Matthew Rabuzzi, ASK Computer Systems B.V., Nyon Switzerland C Date: 27-Apr-1989 C Function TRACEBACK returns the following values: C -1 means that the returned name is the image's main module, C the User Transfer Address module, which means that the returned name C will be the last interesting line to dump (the "interesting" end of C the stack has been reached); C 0 means the real end of the stack has been reached, no more call frames C (somehow we've snuck past the transfer address module to get here); C +1 is returned for all other modules. C Note that both -1 and +1 are .TRUE. values, 0 is .FALSE. C C Entries TRACEBACK_INIT_OPEN and TRACEBACK_INIT_READ return: C .TRUE. if successful; .FALSE. if an error opening or reading the .ADDR file. C C If either INIT routine fails, then all subsequent calls to TRACEBACK C will return .FALSE. (0). OPTIONS /EXTEND_SOURCE INTEGER*4 FUNCTION TRACEBACK (SF_FP, RETURN_NAME, REL_PC, ABS_PC) IMPLICIT INTEGER*4 (A-Z) INCLUDE '($JPIDEF)' C Several of these definitions must match MAP_ADDRESSES.COM + .FOR. PARAMETER DEFTYP = '.ADDR' PARAMETER USRTFR = ':' ! 'User transfer address:' PARAMETER COMMENT = '!' ! Ignore '!' in column one PARAMETER MODULENAMELEN = 31 ! This is a maximum PARAMETER ADDRLEN = 8 PARAMETER STARTOFF = MODULENAMELEN + 1 + 1 PARAMETER ENDOFF = STARTOFF + ADDRLEN + 1 CHARACTER*255 CBUF ! Max RMS filename length PARAMETER MAXVMSSTRINGLEN = 32767 !! PARAMETER BIGSTRINGLEN = MAXVMSSTRINGLEN ! VMS limitation PARAMETER BIGSTRINGLEN = 24000 ! Arbitrarily large, CHARACTER*(BIGSTRINGLEN) MODULENAME ! but no more than the BYTE BMODULENAME(BIGSTRINGLEN) ! VMS maximum. EQUIVALENCE (MODULENAME, BMODULENAME) PARAMETER MAXMODULES = 1600 ! Arbitrarily large INTEGER*4 MODULEADDR(MAXMODULES) C From the preceding declaration and the code below (see "STRINGPTR"), C the total storage per module is <4 + actual length of the module name + 1> C bytes (the 1 is where we store the length, in a "ASCIC"-like manner). C Our value of 1600 modules will fit in the big string as long as each of C those module names averages out at 24000/1600 - 1 = 14 characters long. C This arbitarily chosen pair of parameter values results in C <1600*4 + 24000> bytes, or less than 60 pages. C Stack Frame Pointer context variable. On first call, should be passed as C zero, then caller should not modify it but rather repeatedly pass it back C until this function returns .le. 0. C The next time a stack dump is required, reset SF_FP to zero, and do it again. INTEGER*4 SF_FP C Return the module name, and the relative and absolute Program Counter. CHARACTER*(*) RETURN_NAME INTEGER*4 REL_PC, ABS_PC C ----------------------------------------------------------------------------- REL_PC = 0 ! Initial values zero and blank ABS_PC = 0 ! RETURN_NAME = ' ' ! Unnamed module INIT_OPEN_ONLY = .FALSE. INIT_READ_ONLY = .FALSE. GOTO 1 C ----------------------------------------------------------------------------- ENTRY TRACEBACK_INIT_OPEN INIT_OPEN_ONLY = .TRUE. GOTO 1 1 IF (.NOT. INIT_OPEN_DONE) THEN INIT_OPEN_DONE = .TRUE. TRACEBACK = .FALSE. ! Error function return status IF (.NOT. LIB$GET_LUN (LUN)) THEN WRITE (6,*) '**TRACEBACK: NO LUN AVAILABLE**' RETURN ENDIF CBUF = 'TRACEBACK$ADDRESSES' INQUIRE (FILE=CBUF, DEFAULTFILE=DEFTYP, EXIST=EXISTS) IF (.NOT. EXISTS) THEN ISTAT = LIB$GETJPI (JPI$_IMAGNAME,,,,CBUF,L) IF (.NOT. ISTAT) THEN CALL TRACEBACK_ERRMSG2 (6, ISTAT) CALL LIB$FREE_LUN (LUN) RETURN ENDIF I = INDEX (CBUF(:L), ';') - 4 ! 4 = LEN('.EXE') IF (I .LE. 0) I = L + 1 CBUF(I:) = DEFTYP ! Replace '.EXE' with '.ADDR' ENDIF OPEN (UNIT=LUN, FILE=CBUF, DEFAULTFILE=DEFTYP, STATUS='OLD', * CARRIAGECONTROL='LIST', READONLY, SHARED, IOSTAT=ISTAT) IF (ISTAT .NE. 0) THEN CALL TRACEBACK_ERRMSG (6, ISTAT) WRITE (6,*) '**TRACEBACK: FILENAME IS:**' WRITE (6,*) CBUF CALL LIB$FREE_LUN (LUN) RETURN ENDIF INIT_OPEN_SUCC = .TRUE. ! Success ret ENDIF TRACEBACK = INIT_OPEN_SUCC IF (INIT_OPEN_ONLY .OR. .NOT. TRACEBACK) RETURN GOTO 2 C ----------------------------------------------------------------------------- ENTRY TRACEBACK_INIT_READ INIT_READ_ONLY = .TRUE. GOTO 2 2 IF (.NOT. INIT_READ_DONE) THEN INIT_READ_DONE = .TRUE. TRACEBACK = .FALSE. ! Error function return status C Read in the .ADDR file generated after the link by MAP_ADDRESSES.COM + .FOR. C We assume that the file has not been edited, i.e. no module lines have been C commented out (a la PROFILER). For each line, we save the module name as a C string preceded by a length byte (ASCIC representation); this is a substring C of the big string MODULENAME. We save the module's starting address in the C array MODULEADDR. We do not save the ending address, to save space C (from this comes the requirement that no lines be commented out; else we'd C mistakenly attribute some chunks of code to the preceding modules). C We do look at the ending addresses, though; the last one seen in the file C is the code address boundary HIGHEST_CODEADDR. C Lastly, the User Transfer Address directly from the file we save too. STRINGPTR = 1 NMODULES = 0 DO WHILE (.TRUE.) 10 FORMAT (A) 20 FORMAT (Z) READ (LUN,10,END=100,IOSTAT=ISTAT) CBUF IF (ISTAT .NE. 0) THEN CALL TRACEBACK_ERRMSG (6, ISTAT) RETURN ENDIF IF (CBUF .NE. ' ' .AND. ! Not a blank line * CBUF(:1) .NE. COMMENT .AND. ! Not a comment line * INDEX (CBUF, USRTFR) .EQ. 0) THEN NMODULES = NMODULES + 1 IF (NMODULES .LE. MAXMODULES) THEN NAMELEN = INDEX (CBUF, ' ') - 1 IF (STRINGPTR + NAMELEN .GT. BIGSTRINGLEN) GOTO 80 BMODULENAME(STRINGPTR) = NAMELEN MODULENAME(STRINGPTR+1:STRINGPTR+NAMELEN) = CBUF STRINGPTR = STRINGPTR + 1 + NAMELEN READ (CBUF(STARTOFF:STARTOFF+ADDRLEN-1),20) MODULEADDR(NMODULES) READ (CBUF(ENDOFF:ENDOFF+ADDRLEN-1),20) HIGHEST_CODEADDR ENDIF ELSE IF (INDEX (CBUF, USRTFR) .NE. 0) THEN READ (CBUF(STARTOFF:STARTOFF+ADDRLEN-1),20) USRTFR_ADDR ENDIF ENDDO C Print messages, but recover from overflow conditions. 80 WRITE (6,90) BIGSTRINGLEN, STRINGPTR, NMODULES, CBUF(:MODULENAMELEN) 90 FORMAT (' **TRACEBACK: BIGSTRINGLEN OF 'I5,' EXCEEDED**'/ * ' **STRINGPTR IS 'I5,' AND NMODULES IS 'I5,'**'/ * ' **LINE IS "'A'"**') NMODULES = NMODULES - 1 100 IF (NMODULES .GT. MAXMODULES) THEN WRITE (6,110) MAXMODULES, NMODULES-MAXMODULES 110 FORMAT (' **TRACEBACK: MAXMODULES OF 'I5,' EXCEEDED BY 'I5,'**') NMODULES = MAXMODULES ENDIF CLOSE (LUN) CALL LIB$FREE_LUN (LUN) INIT_READ_SUCC = .TRUE. ! Success ret ENDIF TRACEBACK = INIT_READ_SUCC IF (INIT_READ_ONLY .OR. .NOT. TRACEBACK) RETURN GOTO 3 C ----------------------------------------------------------------------------- C This part of the code is where entry TRACEBACK returns the next C module information. Note that the return arguments were initialized to C zeroes and blanks above. 3 TRACEBACK = 0 ! 0 = end of all stack frames CALL STACKFRAME_WALK_NEXT (SF_FP, ABS_PC) IF (SF_FP .EQ. 0) RETURN TRACEBACK = 1 ! +1 = valid frame IF (ABS_PC .GT. HIGHEST_CODEADDR) RETURN ! Shareable image / RTL IF (ABS_PC .LT. MODULEADDR(1)) RETURN ! System space (negative) DO I = 2,NMODULES ! A known (named) module IF (ABS_PC .LT. MODULEADDR(I)) GOTO 210 ENDDO 210 I = I - 1 C Is this module the module that contains the User Transfer Address? TMP = HIGHEST_CODEADDR IF (I .LT. NMODULES) TMP = MODULEADDR(I+1) IF (MODULEADDR(I) .LE. USRTFR_ADDR .AND. USRTFR_ADDR .LT. TMP) * TRACEBACK = -1 ! -1 = the last valid frame REL_PC = ABS_PC - MODULEADDR(I) ! Offset within the module C This sequential scan of the big string is surprisingly very fast. C For the I'th name, skip past the preceding I+1 by starting at the first C ASCIC count byte, advancing bytes to the next, etc. C At the end, just return the module name there. J = 1 STRINGPTR = 1 DO J = 1,I-1 STRINGPTR = STRINGPTR + 1 + BMODULENAME(STRINGPTR) ENDDO NAMELEN = BMODULENAME(STRINGPTR) RETURN_NAME = MODULENAME(STRINGPTR+1:STRINGPTR+NAMELEN) END C Internal error message routine SUBROUTINE TRACEBACK_ERRMSG (UNIT, ISTAT) IMPLICIT INTEGER*4 (A-Z) CHARACTER*132 MSG CALL ERRSNS (,,,,ISTAT) ENTRY TRACEBACK_ERRMSG2 (UNIT, ISTAT) WRITE (UNIT,*) '**TRACEBACK: ERROR**' IF (SYS$GETMSG (%VAL(ISTAT), MSGLEN, MSG,,)) * WRITE (UNIT,*) MSG(:MSGLEN) END ; [This is Program 3 of TRACEBACK.TXT.] ; [It is identical to Program #x of PROFILER.TXT by this author.] ; Program: STACKFRAME_WALK.MAR [Subroutines] ; Author: Matthew Rabuzzi, ASK Computer Systems B.V., Nyon Switzerland ; Date: 18-Apr-1989 ; This module consists of two entrypoints that retrieve information from ; the call stack frame. ; SF stands for stack frame, FP is frame pointer, PC is program counter. ; See PROFILER.FOR and TRACEBACK.FOR for usage. .TITLE STACKFRAME_WALK $SFDEF ; define symbolic offsets .PSECT $CODE PIC, SHR, NOWRT, LONG ; This routine returns, in the single INTEGER*4 argument, ; the stack frame pointer of the initial caller i.e. SHARE$DEBUG. ; This initial FP is the boundary beyond which PROFILER should not ; collect statistics. ; Example: CALL STACKFRAME_WALK_INIT (SF_BOUND) .ENTRY STACKFRAME_WALK_INIT, ^M<> MOVL SF$L_SAVE_FP(FP), R0 ; this routine MOVL SF$L_SAVE_FP(R0), R0 ; PROFILER_INIT.FOR MOVL R0, @4(AP) RET ; This routine returns, in the two INTEGER*4 arguments, ; the stack frame pointer and the PC of the next caller. ; You start things off by passing the first argument as zero, ; and then repeatedly pass that context variable back to this routine ; until you have satisfied your boundary or end condition (this is the ; "SF_BOUND" test in PROFILER, "USRTFR_ADDR" check in TRACEBACK). ; Example: ; SF_FP = 0 ; DO WHILE (condition) ; CALL STACKFRAME_WALK_NEXT (SF_FP, SF_PC) ; ... ; ENDDO .ENTRY STACKFRAME_WALK_NEXT, ^M<> MOVL @4(AP), R0 BNEQ 1$ MOVL SF$L_SAVE_FP(FP), R0 ; this routine MOVL SF$L_SAVE_FP(R0), R0 ; PROFILER_COLLECT or TRACEBACK 1$: MOVL SF$L_SAVE_FP(R0), @4(AP) ; the next stack frame of interest MOVL SF$L_SAVE_PC(R0), @8(AP) RET .END $! [This is ancillary Program 4A of TRACEBACK.TXT.] $! [It is identical to Program #x of PROFILER.TXT by the same author.] $! $! Procedure: MAP_ADDRESSES.COM $! Author: Matthew Rabuzzi, ASK Computer Systems B.V., Nyon Switzerland $! Date: 18-Apr-1989 $ $! This procedure should be invoked after each link of an image that uses $! either PROFILER or TRACEBACK.FOR. Its purpose is to set up logical names $! and various housekeeping chores for the MAP_ADDRESSES.FOR program, which $! converts a linker map (output of VMS LINK/MAP) into a .ADDR file (input to $! PROFILER and to TRACEBACK). $! The linker .MAP file may be deleted after running this procedure. $ $ DEFTYP = ".ADDR" ! This definition must match PROFILER and TRACEBACK.FOR. $ map = p1 $ savemap = p2 .eqs. "" .or. p2 $ map = f$parse(map,".map") $ out = f$parse(DEFTYP,map) $ out = out - f$parse(out,,,"version") $ tmpout = f$parse(".tmp-mapaddr-''f$getj("","pid")'",out) ! Unique tmp name $ tmpout = tmpout - f$parse(tmpout,,,"version") $ devdir = f$parse(f$env("procedure"),,,"device") + - f$parse(f$env("procedure"),,,"directory") $ $ on control_y then goto cleanup $ on error then goto cleanup $ $ define/user MAP_ADDRESSES_IN 'map' $ define/user MAP_ADDRESSES_OUT 'tmpout' $ run 'devdir'MAP_ADDRESSES.EXE $ $ rename 'tmpout' 'out' $ purge 'out' $ if .not. savemap then delete 'map' $cleanup: $ if f$sea(tmpout) .nes. "" then delete 'tmpout';* $ exit C [This is ancillary Program 4B of TRACEBACK.TXT.] C [It is identical to Program #x of PROFILER.TXT by this author.] C Program: MAP_ADDRESSES.FOR [A Main Program] C Author: Matthew Rabuzzi, ASK Computer Systems B.V., Nyon Switzerland C Date: 2-May-1989 (patterned after a slower .COM procedure of 18-Apr) OPTIONS /EXTEND_SOURCE C This program is called by MAP_ADDRESSES.COM (which does some preliminary C processing and assigns input and output file logical names) to generate C a ".ADDR" file of module names and their absolute hex addresses. C The .ADDR file should obviously be regenerated each time you link. C The .ADDR file is opened and read at run-time by the PROFILER and TRACEBACK C subroutines. C The linker .MAP file may be deleted after running this program. C C Input: Logical name MAP_ADDRESSES_IN points to a .MAP file. C Output: Logical name MAP_ADDRESSES_OUT points to a .ADDR file that C we are to create. C C This program obviously depends implicitly upon the layout of the VMS Linker's C map files. (This layout has not changed in years.) C As a reference for reading this code, here is a condensed sample of a map: C C DUA0:[PROGDIR]JUNK.EXE;83 1-MAY-1989 14:31 VAX-11 Linker V04-00 Page 25 C C Psect Module Base End Length Align Attributes C ----- --------- ---- --- ------ ----- ---------- C $CODE 00056E00 00066555 0000F756 (3318.) LONG 2 PIC,USR,CON,... C JUNK$MAIN 00057D60 00057F4F 000001F0 ( 496.) LONG 2 C C Addresses are gotten for all modules found in a psect with either C "$CODE" or "$DEBUG_CODE" in the name, and with the "CONcatenate" attribute C (i.e., we ignore any dubiously named Fortran common blocks, which would C instead have the "OVR" overlay attribute). PROGRAM MAP_ADDRESSES IMPLICIT INTEGER*4 (A-Z) C These definitions must match PROFILER.FOR and TRACEBACK.FOR. C Format statement 20 below must match what PROFILER and TRACEBACK expect C (the STARTOFF and ENDOFF parameters). PARAMETER USRTFR = 'User transfer address:' ! Note colon PARAMETER COMMENT = '!' PARAMETER MODULENAMELEN = 31 PARAMETER ADDRLEN = 8 PARAMETER INFILE = 10 PARAMETER OUTFILE = 20 PARAMETER MODULENAMELEN2 = MODULENAMELEN + 1 CHARACTER*132 LINE CHARACTER*(MODULENAMELEN2) MODULE ! GUARANTEE A TERMINATING ' ' CHARACTER*(ADDRLEN) START, END C ----------------------------------------------------------------------------- 10 FORMAT (A) 20 FORMAT (A,2(XA)) 30 FORMAT (A,X, I5,' modules, ',I5,' total name length, ',I5,' longest single name length.') 40 FORMAT (A,' This file MUST remain in this order (sorted by increasing hex addresses).'/ * A,' For TRACEBACK, all lines must remain uncommented.'/ * A,' For PROFILER, lines may be commented out with the "'A'" character.'/) C ----------------------------------------------------------------------------- OPEN (UNIT=INFILE, FILE='MAP_ADDRESSES_IN', STATUS='OLD', * CARRIAGECONTROL='LIST', READONLY) OPEN (UNIT=OUTFILE, FILE='MAP_ADDRESSES_OUT', STATUS='NEW', * CARRIAGECONTROL='LIST') WRITE (OUTFILE,40) COMMENT, COMMENT, COMMENT, COMMENT C Read map until we reach a $CODE or $DEBUG_CODE psect, set IN_THE_CODE flag. C Once in amongst the module code addresses, condense the info and output it C to address file; stop when reach the first non-code psect; repeat in case C not all code psects are contiguous. IN_THE_CODE = .FALSE. DO WHILE (.TRUE.) READ (INFILE,10,END=500) LINE IF (LINE .NE. ' ') THEN IF (INDEX (LINE,USRTFR) .GT. 0) GOTO 500 XPSECT_LINE = INDEX (LINE,',') .GT. 0 ! 'CON,REL,PIC' etc CODE_PSECT = (INDEX (LINE,'$CODE') .GT. 0 .OR. * INDEX (LINE,'$DEBUG_CODE') .GT. 0) .AND. * INDEX (LINE,'CON,') .GT. 0 ! Ignore COMMON blocks IF (XPSECT_LINE) IN_THE_CODE = CODE_PSECT IF (IN_THE_CODE .AND. LINE(:1) .EQ. ' ') THEN ! Ignore page breaks CALL GET3TOKENS (LINE, MODULE, START, END) IF (MODULE(:1) .EQ. '+') GOTO 500 ! '+---Symbols by value' DO WHILE (START .EQ. ' ') READ (INFILE,10) LINE IF (LINE(:1) .EQ. ' ') ! Ignore page breaks * CALL GET2TOKENS (LINE, START, END) ENDDO LENGTH = INDEX (MODULE,' ') - 1 ! Guaranteed above MAXNAMLEN = MAX (LENGTH, MAXNAMLEN) TOTNAMLEN = TOTNAMLEN + LENGTH NMODULES = NMODULES + 1 WRITE (OUTFILE,20) MODULE, START, END ENDIF ENDIF ENDDO C Read till we get the User Transfer Address 500 DO WHILE (INDEX (LINE,USRTFR) .EQ. 0) READ (INFILE,10,END=600) LINE ENDDO LINE(:INDEX(LINE,':')) = ' ' CALL GET1TOKEN (LINE, START) ! This is the User Transfer Address MODULE = USRTFR ! Ensure string is left-justified END = ' ' WRITE (OUTFILE,20) MODULE, START, END 600 WRITE (OUTFILE,30) COMMENT, NMODULES, TOTNAMLEN, MAXNAMLEN END C ----------------------------------------------------------------------------- C Get blank-delimited tokens from an input line. SUBROUTINE GET3TOKENS (LINE, TOK1, TOK2, TOK3) IMPLICIT INTEGER*4 (A-Z) CHARACTER*(*) LINE, TOK1, TOK2, TOK3 NTOKS = 3 GOTO 10 ENTRY GET2TOKENS (LINE, TOK1, TOK2) NTOKS = 2 GOTO 10 ENTRY GET1TOKEN (LINE, TOK1) NTOKS = 1 GOTO 10 10 PREV = 0 CALL GETNXTTOK (LINE, TOK1, PREV) IF (NTOKS .GE. 2) CALL GETNXTTOK (LINE, TOK2, PREV) IF (NTOKS .GE. 3) CALL GETNXTTOK (LINE, TOK3, PREV) END C ----------------------------------------------------------------------------- C Get the next blank-delimited token in the line. SUBROUTINE GETNXTTOK (LINE, TOK, J) IMPLICIT INTEGER*4 (A-Z) CHARACTER*(*) LINE, TOK TOK = ' ' IF (J .GE. LEN (LINE)) RETURN I = STR$FIND_FIRST_NOT_IN_SET (LINE(J+1:), ' ') IF (I .LE. 0) RETURN I = I + J J = INDEX (LINE(I:), ' ') + I - 2 IF (J .LE. 0) J = LEN (LINE) TOK = LINE(I:J) END [This is Example 1 for TRACEBACK.TXT by Matthew Rabuzzi, ASK Computer Systems.] %FOR-F-FILNOTFOU, file not found unit 10 file DUA0:[MANMAN.COM]TRKDBV070_AREA.TBL; user PC 00054134 -RMS-E-FNF, file not found %TRACE-I-TRACEBACK, symbolic stack dump follows (user traceback) module name routine name line rel PC abs PC SYSIZE_READTBL 0000045D 0005413D SYSIZE_INIT 000000F2 00053C5A SYU450_TRKDB 00000019 0005D811 SYU450 000003F9 000539F9