(* This file was mangled by Mangler 1.35 (c) Copyright 1993-1994 by Berend de Boer *)
{ Created : 1993-12-01
Simple log file based Post Mortem Debugger
Install by calling InstallPMD *after* calling BBError.InstallExitHandler
InitIntHandler is not stable yet!
Last changes :
94-09-30 Added Windows GPF handler
94-10-03 Added procedure DonePMD
94-10-07 Improved stack walking a bit to detect near calls better
}
{$IFDEF MsDos}
{$F+,O+}
{$ENDIF}
{$IFDEF DPMI}
{$S-}
{$ENDIF}
{$IFDEF Windows}
{$S+}
{$ENDIF}
{$X+}
unit PMD;
interface
{ flags to pass to InitPMD to set PMD capabilities }
const
dfStandard = 0; { always make a symbolic stack dump }
dfDataSeg = 1; { optionally dump the data segment }
procedure InitPMD(AOptions : word);
{$IFDEF Windows}
procedure InitIntHandler;
{$ENDIF}
procedure DonePMD;
IMPLEMENTATION USES OBJECTS , {$IFDEF Windows}STRINGS , WINAPI , WINTYPES , WINPROCS , TOOLHELP ,
{$ENDIF}{$IFDEF DPMI}WINAPI , {$ENDIF}BBERROR , BBFILE , BBUTIL , TDINFO ;VAR O101OOIOIOlO1:WORD;
OO000lIIIl1:DUMPSTACKPROCEDURETYPE;PROCEDURE OI1I0llIO1l (OOlIl0OOIIOO:POINTER;O100llIl00IOl:WORD);
VAR OIlI1lll10I:BOOLEAN;PROCEDURE O10O0100lO1II (OIOOO0O0I1l:PSYMBOL);FAR;BEGIN IF OIlI1lll10I THEN BEGIN WRITE (FERR ,
'(');OIlI1lll10I := FALSE ;END ELSE WRITE (FERR , ',');WITH OIOOO0O0I1l^ DO BEGIN IF TYPEINDEX <> TID_VOID THEN WRITE
(FERR , ITSVALUESTR (O100llIl00IOl ));END ;END ;VAR O1010Ol11011O:PLINENUMBER;OIOOO0O0I1l:PSYMBOL;OO1O:STRING ;BEGIN NEW
(O1010Ol11011O , ATADDR (OOlIl0OOIIOO ));IF O1010Ol11011O =NIL THEN BEGIN WRITELN (FERR , ' ', HEXSTR (PTRREC
(OOlIl0OOIIOO ). SEG ), ':', HEXSTR (PTRREC (OOlIl0OOIIOO ). OFS ));END ELSE BEGIN WRITE (FERR , ' ', O1010Ol11011O ^.
ITSCORRELATION ^. ITSSOURCEFILE ^. ITSNAME , ' (', O1010Ol11011O ^. VALUE , ') ');NEW (OIOOO0O0I1l , ATSEGMENT
(O1010Ol11011O ^. ITSCORRELATION ^. ITSSEGMENT , OOlIl0OOIIOO ));IF OIOOO0O0I1l <> NIL THEN BEGIN IF OIOOO0O0I1l ^.
ITSTYPE ^. RETURNTYPE =1 THEN WRITE (FERR , 'procedure ')ELSE WRITE (FERR , 'function ');IF OIOOO0O0I1l ^. ITSTYPE ^. ID
=TID_SPECIALFUNC THEN BEGIN WRITE (FERR , OIOOO0O0I1l ^. ITSTYPE ^. ITSCLASSTYPE ^. ITSNAME , '.');END ;OO1O :=
OIOOO0O0I1l ^. ITSNAME ;WRITE (FERR , OO1O );OIlI1lll10I := TRUE ;OIOOO0O0I1l ^. ITSSCOPE ^. FOREACHPARAMETER (@
O10O0100lO1II );IF NOT OIlI1lll10I THEN WRITE (FERR , ')');WRITE (FERR , ';');DISPOSE (OIOOO0O0I1l , DONE );END ;WRITELN
(FERR );DISPOSE (O1010Ol11011O , DONE );END ;END ;PROCEDURE OO1IO10IlIO (OOlIl0OOIIOO:POINTER;O100llIl00IOl:WORD);
FAR;VAR O101O01III1II:WORD;O100Ol00I:POINTER;OI11OO1I0:WORD;FUNCTION OOIO11111111 :BOOLEAN ;VAR OOIl0I00O1O0:POINTER;
BEGIN OOIO11111111 := FALSE ;IF O100Ol00I =NIL THEN EXIT ;PTRREC (OOIl0I00O1O0 ). OFS := PTRREC (OOlIl0OOIIOO ). OFS ;
{$IFDEF MsDos}PTRREC (OOIl0I00O1O0 ). SEG := OI11OO1I0 ;{$ELSE}IF GETSELECTORLIMIT (OI11OO1I0 )<= PTRREC (OOIl0I00O1O0 ).
OFS THEN EXIT ;PTRREC (OOIl0I00O1O0 ). SEG := ALLOCSELECTOR (OI11OO1I0 );IF PTRREC (OOIl0I00O1O0 ). SEG =0 THEN EXIT ;
{$ENDIF}WITH PTRREC(OOIl0I00O1O0) DO OOIO11111111 := (MEMW [ SSEG :O100llIl00IOl + 4 ] =O101O01III1II )OR ((OFS >= 5 )AND
(MEM [ SEG :OFS - 3 ] =$E8 )AND (MEM [ SEG :OFS - 5 ] <> $9A ));{$IFNDEF MsDos}FREESELECTOR (PTRREC (OOIl0I00O1O0 ). SEG
);{$ENDIF}END ;BEGIN IF NOT TDINFOPRESENT (NIL )THEN BEGIN OO000lIIIl1 (OOlIl0OOIIOO , O100llIl00IOl );EXIT ;END ;
LOGERROR ('*** Full stack dump ***');IF ODD (O100llIl00IOl )THEN DEC (O100llIl00IOl );O101O01III1II := MEMW [ SSEG
:O100llIl00IOl ] ;IF ODD (O101O01III1II )THEN DEC (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;ASM {} MOV AX , CS {}
MOV OI11OO1I0, AX {} END;WHILE (O101O01III1II > O100llIl00IOl )AND (MEMW [ SSEG :O100llIl00IOl ] <> 0 ) DO BEGIN PTRREC
(OOlIl0OOIIOO ). OFS := MEMW [ SSEG :O100llIl00IOl + 2 ] ;IF OOIO11111111 THEN PTRREC (OOlIl0OOIIOO ). SEG := PTRREC
(O100Ol00I ). SEG ELSE BEGIN OI11OO1I0 := MEMW [ SSEG :O100llIl00IOl + 4 ] ;PTRREC (OOlIl0OOIIOO ). SEG := OI11OO1I0 ;
OOlIl0OOIIOO := GETLOGICALADDR (OOlIl0OOIIOO );IF OOlIl0OOIIOO =NIL THEN BREAK ;{$IFDEF MSDOS}{$ELSE}IF PTRREC
(OOlIl0OOIIOO ). SEG =0 THEN PTRREC (OOlIl0OOIIOO ). SEG := PTRREC (O100Ol00I ). SEG ;{$ENDIF}END ;O100llIl00IOl :=
O101O01III1II ;OI1I0llIO1l (OOlIl0OOIIOO , O100llIl00IOl );O101O01III1II := MEMW [ SSEG :O100llIl00IOl ] ;IF ODD
(O101O01III1II )THEN DEC (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;END ;FLUSH (FERR );END ;PROCEDURE O10101Il1II1I
(O100llIl00IOl:WORD);VAR OI110O01l011:PMODULE;PROCEDURE OIOI11I0IO0 (OIOOO0O0I1l:PSYMBOL);FAR;BEGIN WRITE (FERR ,
OI110O01l011 ^. ITSNAME , '.', OIOOO0O0I1l ^. ITSNAME , ' : ');IF OIOOO0O0I1l ^. ITSTYPE =NIL THEN WRITE (FERR ,
'<no type info>')ELSE WRITE (FERR , OIOOO0O0I1l ^. ITSTYPE ^. ITSNAME );WRITELN (FERR , ' = ', OIOOO0O0I1l ^. ITSVALUESTR
(O100llIl00IOl ), ';');END ;VAR OIlO:INTEGER;BEGIN FOR OIlO := 1 TO DEBUGHEADER.MODULESCOUNT DO BEGIN OI110O01l011 :=
NEW (PMODULE , INIT (OIlO ));IF OI110O01l011 <> NIL THEN OI110O01l011 ^. FOREACHDSEGELEMENT (@ OIOI11I0IO0 );DISCARD
(OI110O01l011 );END ;END ;PROCEDURE OOlIll110I1O (O100llIl00IOl:WORD);FAR;VAR OO1O:PSTREAM;OIlO:WORD;
OI0011l0I1:PSEGMENT;{$IFDEF Windows}OIlI1OlO00I:ARRAY [ 0 .. 127 ] OF CHAR;{$ENDIF}BEGIN {$IFDEF Windows}OO1O := NEW
(PBUFSTREAM , INIT (STRPCOPY (OIlI1OlO00I , PARAMSTR (0 )), STOPEN + FMDENYNONE , 512 ));{$ELSE}OO1O := NEW (PBUFSTREAM ,
INIT (PARAMSTR (0 ), STOPEN + FMDENYNONE , 512 ));{$ENDIF}IF (OO1O =NIL )OR (OO1O ^. STATUS <> STOK )THEN BEGIN IF OO1O
=NIL THEN LOGERROR ('PMD: Stream allocation returned nil.')ELSE LOGERROR ('PMD: Error when opening stream. Status = '+
STRI (OO1O ^. STATUS ));EXIT ;END ;IF NOT TDINFOPRESENT (OO1O )THEN BEGIN LOGERROR ('PMD: Debug info not present.');
LOGERROR ('Error '+ STRW (EXITCODE )+ ' at '+ HEXSTR (PTRREC (ERRORADDR ). SEG )+ ':'+ HEXSTR (PTRREC (ERRORADDR ). OFS
));OO000lIIIl1 (NIL , O100llIl00IOl );DISPOSE (OO1O , DONE );EXIT ;END ;LOGERROR ('Error '+ STRW (EXITCODE )+ ' at '+
HEXSTR (PTRREC (ERRORADDR ). SEG )+ ':'+ HEXSTR (PTRREC (ERRORADDR ). OFS ));LOGERROR ('MemAvail: '+ STRL (MEMAVAIL ));
O100llIl00IOl := MEMW [ SSEG :O100llIl00IOl ] ;IF ODD (O100llIl00IOl )THEN DEC (O100llIl00IOl );WRITE (FERR , GETDATESTR
, ' ', GETTIMESTR );OI1I0llIO1l (ERRORADDR , O100llIl00IOl );OO1IO10IlIO (ERRORADDR , O100llIl00IOl );IF O101OOIOIOlO1
AND DFDATASEG <> 0 THEN O10101Il1II1I (O100llIl00IOl );DISPOSE (NAMES , DONE );DISPOSE (OO1O , DONE );ERRORADDR := NIL ;
END ;{$IFDEF Windows}TYPE OO00IIlOlI0=PROCEDURE (INT :WORD ;O100llIl00IOl:WORD;
OIOllII1IlO,OIOll10Ol0I,OIOI1OOO110,OIOI1O0OlIO:WORD);PROCEDURE OOll110l0OlO (O10OO110OlIO1:THANDLE;
O10OIIOI1O0I1:OO00IIlOlI0);FAR;EXTERNAL'pmdwin'INDEX 1 ;PROCEDURE OOI1lOlIIO0O ;FAR;EXTERNAL'pmdwin'INDEX 2 ;
PROCEDURE OlI0l10l1 (OIl0OO00IO0:WORD;O100llIl00IOl:WORD;OIOllII1IlO, OIOll10Ol0I, OIOI1OOO110, OIOI1O0OlIO:WORD);EXPORT
;VAR OOlIl0OOIIOO:POINTER;OIlO:INTEGER;BEGIN LOGERROR ('Fault: 0'+ HEXSTR (OIl0OO00IO0 )+ 'h');IF NOT TDINFOPRESENT (NIL
)THEN EXIT ;O100llIl00IOl := MEMW [ SSEG :O100llIl00IOl ] ;IF ODD (O100llIl00IOl )THEN DEC (O100llIl00IOl );OOlIl0OOIIOO
:= PTR (OIOll10Ol0I , OIOI1OOO110 );OI1I0llIO1l (GETLOGICALADDR (OOlIl0OOIIOO ), O100llIl00IOl );DUMPSTACK
(GETLOGICALADDR (OOlIl0OOIIOO ), O100llIl00IOl );CLOSE (FERR );OOI1lOlIIO0O ;TERMINATEAPP (0 , NO_UAE_BOX );END ;
PROCEDURE INITINTHANDLER ;BEGIN OOll110l0OlO (GETCURRENTTASK , OlI0l10l1 );END ;FUNCTION O1lIIO0II0O1 (OI1I1I01OlO:WORD;
OI1II0ll0IOl:LONGINT):BOOL ;EXPORT ;VAR O10OIO0I10100:PNFYLOGERROR ABSOLUTE OI1II0ll0IOl;
OOIIlIII1OIl:PNFYLOGPARAMERROR ABSOLUTE OI1II0ll0IOl;O100llIl00IOl:WORD;BEGIN CASE OI1I1I01OlO OF NFY_RIP :LOGERROR
('RIP Error');NFY_OUTSTR :LOGERROR (STRPAS (PCHAR (OI1II0ll0IOl )));NFY_LOGERROR :LOGERROR ('Windows log error: '+ STRW
(O10OIO0I10100 ^. WERRCODE ));NFY_LOGPARAMERROR :BEGIN LOGERROR ('Windows parameter error: '+ STRW (OOIIlIII1OIl ^.
WERRCODE ));ASM {} MOV O100llIl00IOl, BP {} END;DUMPSTACK (GETLOGICALADDR (OOIIlIII1OIl ^. LPFNERRORADDR ), O100llIl00IOl
);END ;END ;O1lIIO0II0O1 := FALSE ;END ;{$ENDIF}PROCEDURE INITPMD (AOPTIONS:WORD);BEGIN IF ISFILEOPEN (FERR )THEN
BEGIN O101OOIOIOlO1 := AOPTIONS ;HANDLERUNTIMEERROR := OOlIll110I1O ;OO000lIIIl1 := DUMPSTACK ;DUMPSTACK := OO1IO10IlIO ;
{$IFDEF Windows}NOTIFYREGISTER (0 , O1lIIO0II0O1 , NF_RIP );{$ENDIF}LOGERROR ('Post Mortem Debugger installed.');END ;
END ;PROCEDURE DONEPMD ;BEGIN DISCARD (NAMES );DISCARD (DSTREAM );END ;END .
