home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 038 / pmd110.zip / PMD.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-14  |  9KB  |  115 lines
  1. (* This file was mangled by Mangler 1.35 (c) Copyright 1993-1994 by Berend de Boer *)
  2. { Created : 1993-12-01
  3.  
  4. Simple log file based Post Mortem Debugger
  5.  
  6. Install by calling InstallPMD *after* calling BBError.InstallExitHandler
  7.  
  8. InitIntHandler is not stable yet!
  9.  
  10. Last changes :
  11. 94-09-30  Added Windows GPF handler
  12. 94-10-03  Added procedure DonePMD
  13. 94-10-07  Improved stack walking a bit to detect near calls better
  14. }
  15.  
  16.  
  17.  
  18. {$IFDEF MsDos}
  19. {$F+,O+}
  20. {$ENDIF}
  21. {$IFDEF DPMI}
  22. {$S-}
  23. {$ENDIF}
  24. {$IFDEF Windows}
  25. {$S+}
  26. {$ENDIF}
  27.  
  28. {$X+}
  29.  
  30. unit PMD;
  31.  
  32. interface
  33.  
  34.  
  35. { flags to pass to InitPMD to set PMD capabilities }
  36. const
  37.   dfStandard = 0;       { always make a symbolic stack dump }
  38.   dfDataSeg = 1;        { optionally dump the data segment }
  39.  
  40.  
  41. procedure InitPMD(AOptions : word);
  42. {$IFDEF Windows}
  43. procedure InitIntHandler;
  44. {$ENDIF}
  45. procedure DonePMD;
  46.  
  47.  
  48.  
  49.  IMPLEMENTATION USES OBJECTS , {$IFDEF Windows}STRINGS , WINAPI , WINTYPES , WINPROCS , TOOLHELP ,
  50. {$ENDIF}{$IFDEF DPMI}WINAPI , {$ENDIF}BBERROR , BBFILE , BBUTIL , TDINFO ;VAR O101OOIOIOlO1:WORD;
  51. OO000lIIIl1:DUMPSTACKPROCEDURETYPE;PROCEDURE OI1I0llIO1l (OOlIl0OOIIOO:POINTER;O100llIl00IOl:WORD);
  52. VAR OIlI1lll10I:BOOLEAN;PROCEDURE O10O0100lO1II (OIOOO0O0I1l:PSYMBOL);FAR;BEGIN IF OIlI1lll10I THEN BEGIN WRITE (FERR ,
  53. '(');OIlI1lll10I := FALSE ;END ELSE WRITE (FERR , ',');WITH OIOOO0O0I1l^ DO BEGIN IF TYPEINDEX <> TID_VOID THEN WRITE
  54. (FERR , ITSVALUESTR (O100llIl00IOl ));END ;END ;VAR O1010Ol11011O:PLINENUMBER;OIOOO0O0I1l:PSYMBOL;OO1O:STRING ;BEGIN NEW
  55. (O1010Ol11011O , ATADDR (OOlIl0OOIIOO ));IF O1010Ol11011O =NIL THEN BEGIN WRITELN (FERR , '  ', HEXSTR (PTRREC
  56. (OOlIl0OOIIOO ). SEG ), ':', HEXSTR (PTRREC (OOlIl0OOIIOO ). OFS ));END ELSE BEGIN WRITE (FERR , '  ', O1010Ol11011O ^.
  57. ITSCORRELATION ^. ITSSOURCEFILE ^. ITSNAME , ' (', O1010Ol11011O ^. VALUE , ') ');NEW (OIOOO0O0I1l , ATSEGMENT
  58. (O1010Ol11011O ^. ITSCORRELATION ^. ITSSEGMENT , OOlIl0OOIIOO ));IF OIOOO0O0I1l <> NIL THEN BEGIN IF OIOOO0O0I1l ^.
  59. ITSTYPE ^. RETURNTYPE =1 THEN WRITE (FERR , 'procedure ')ELSE WRITE (FERR , 'function ');IF OIOOO0O0I1l ^. ITSTYPE ^. ID
  60. =TID_SPECIALFUNC THEN BEGIN WRITE (FERR , OIOOO0O0I1l ^. ITSTYPE ^. ITSCLASSTYPE ^. ITSNAME , '.');END ;OO1O :=
  61. OIOOO0O0I1l ^. ITSNAME ;WRITE (FERR , OO1O );OIlI1lll10I := TRUE ;OIOOO0O0I1l ^. ITSSCOPE ^. FOREACHPARAMETER (@
  62. O10O0100lO1II );IF NOT OIlI1lll10I THEN WRITE (FERR , ')');WRITE (FERR , ';');DISPOSE (OIOOO0O0I1l , DONE );END ;WRITELN
  63. (FERR );DISPOSE (O1010Ol11011O , DONE );END ;END ;PROCEDURE OO1IO10IlIO (OOlIl0OOIIOO:POINTER;O100llIl00IOl:WORD);
  64. FAR;VAR O101O01III1II:WORD;O100Ol00I:POINTER;OI11OO1I0:WORD;FUNCTION OOIO11111111 :BOOLEAN ;VAR OOIl0I00O1O0:POINTER;
  65. BEGIN OOIO11111111 := FALSE ;IF O100Ol00I =NIL THEN EXIT ;PTRREC (OOIl0I00O1O0 ). OFS := PTRREC (OOlIl0OOIIOO ). OFS ;
  66. {$IFDEF MsDos}PTRREC (OOIl0I00O1O0 ). SEG := OI11OO1I0 ;{$ELSE}IF GETSELECTORLIMIT (OI11OO1I0 )<= PTRREC (OOIl0I00O1O0 ).
  67. OFS THEN EXIT ;PTRREC (OOIl0I00O1O0 ). SEG := ALLOCSELECTOR (OI11OO1I0 );IF PTRREC (OOIl0I00O1O0 ). SEG =0 THEN EXIT ;
  68. {$ENDIF}WITH PTRREC(OOIl0I00O1O0) DO OOIO11111111 := (MEMW [ SSEG :O100llIl00IOl + 4 ] =O101O01III1II )OR ((OFS >= 5 )AND
  69. (MEM [ SEG :OFS - 3 ] =$E8 )AND (MEM [ SEG :OFS - 5 ] <> $9A ));{$IFNDEF MsDos}FREESELECTOR (PTRREC (OOIl0I00O1O0 ). SEG
  70. );{$ENDIF}END ;BEGIN IF NOT TDINFOPRESENT (NIL )THEN BEGIN OO000lIIIl1 (OOlIl0OOIIOO , O100llIl00IOl );EXIT ;END ;
  71. LOGERROR ('*** Full stack dump ***');IF ODD (O100llIl00IOl )THEN DEC (O100llIl00IOl );O101O01III1II := MEMW [ SSEG
  72. :O100llIl00IOl ] ;IF ODD (O101O01III1II )THEN DEC (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;ASM {} MOV AX , CS {}
  73. MOV OI11OO1I0, AX {} END;WHILE (O101O01III1II > O100llIl00IOl )AND (MEMW [ SSEG :O100llIl00IOl ] <> 0 ) DO BEGIN PTRREC
  74. (OOlIl0OOIIOO ). OFS := MEMW [ SSEG :O100llIl00IOl + 2 ] ;IF OOIO11111111 THEN PTRREC (OOlIl0OOIIOO ). SEG := PTRREC
  75. (O100Ol00I ). SEG ELSE BEGIN OI11OO1I0 := MEMW [ SSEG :O100llIl00IOl + 4 ] ;PTRREC (OOlIl0OOIIOO ). SEG := OI11OO1I0 ;
  76. OOlIl0OOIIOO := GETLOGICALADDR (OOlIl0OOIIOO );IF OOlIl0OOIIOO =NIL THEN BREAK ;{$IFDEF MSDOS}{$ELSE}IF PTRREC
  77. (OOlIl0OOIIOO ). SEG =0 THEN PTRREC (OOlIl0OOIIOO ). SEG := PTRREC (O100Ol00I ). SEG ;{$ENDIF}END ;O100llIl00IOl :=
  78. O101O01III1II ;OI1I0llIO1l (OOlIl0OOIIOO , O100llIl00IOl );O101O01III1II := MEMW [ SSEG :O100llIl00IOl ] ;IF ODD
  79. (O101O01III1II )THEN DEC (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;END ;FLUSH (FERR );END ;PROCEDURE O10101Il1II1I
  80. (O100llIl00IOl:WORD);VAR OI110O01l011:PMODULE;PROCEDURE OIOI11I0IO0 (OIOOO0O0I1l:PSYMBOL);FAR;BEGIN WRITE (FERR ,
  81. OI110O01l011 ^. ITSNAME , '.', OIOOO0O0I1l ^. ITSNAME , ' : ');IF OIOOO0O0I1l ^. ITSTYPE =NIL THEN WRITE (FERR ,
  82. '<no type info>')ELSE WRITE (FERR , OIOOO0O0I1l ^. ITSTYPE ^. ITSNAME );WRITELN (FERR , ' = ', OIOOO0O0I1l ^. ITSVALUESTR
  83. (O100llIl00IOl ), ';');END ;VAR OIlO:INTEGER;BEGIN FOR OIlO := 1 TO DEBUGHEADER.MODULESCOUNT  DO BEGIN OI110O01l011 :=
  84. NEW (PMODULE , INIT (OIlO ));IF OI110O01l011 <> NIL THEN OI110O01l011 ^. FOREACHDSEGELEMENT (@ OIOI11I0IO0 );DISCARD
  85. (OI110O01l011 );END ;END ;PROCEDURE OOlIll110I1O (O100llIl00IOl:WORD);FAR;VAR OO1O:PSTREAM;OIlO:WORD;
  86. OI0011l0I1:PSEGMENT;{$IFDEF Windows}OIlI1OlO00I:ARRAY [ 0 .. 127 ]  OF CHAR;{$ENDIF}BEGIN {$IFDEF Windows}OO1O := NEW
  87. (PBUFSTREAM , INIT (STRPCOPY (OIlI1OlO00I , PARAMSTR (0 )), STOPEN + FMDENYNONE , 512 ));{$ELSE}OO1O := NEW (PBUFSTREAM ,
  88. INIT (PARAMSTR (0 ), STOPEN + FMDENYNONE , 512 ));{$ENDIF}IF (OO1O =NIL )OR (OO1O ^. STATUS <> STOK )THEN BEGIN IF OO1O
  89. =NIL THEN LOGERROR ('PMD: Stream allocation returned nil.')ELSE LOGERROR ('PMD: Error when opening stream. Status = '+
  90. STRI (OO1O ^. STATUS ));EXIT ;END ;IF NOT TDINFOPRESENT (OO1O )THEN BEGIN LOGERROR ('PMD: Debug info not present.');
  91. LOGERROR ('Error '+ STRW (EXITCODE )+ ' at '+ HEXSTR (PTRREC (ERRORADDR ). SEG )+ ':'+ HEXSTR (PTRREC (ERRORADDR ). OFS
  92. ));OO000lIIIl1 (NIL , O100llIl00IOl );DISPOSE (OO1O , DONE );EXIT ;END ;LOGERROR ('Error '+ STRW (EXITCODE )+ ' at '+
  93. HEXSTR (PTRREC (ERRORADDR ). SEG )+ ':'+ HEXSTR (PTRREC (ERRORADDR ). OFS ));LOGERROR ('MemAvail: '+ STRL (MEMAVAIL ));
  94. O100llIl00IOl := MEMW [ SSEG :O100llIl00IOl ] ;IF ODD (O100llIl00IOl )THEN DEC (O100llIl00IOl );WRITE (FERR , GETDATESTR
  95. , ' ', GETTIMESTR );OI1I0llIO1l (ERRORADDR , O100llIl00IOl );OO1IO10IlIO (ERRORADDR , O100llIl00IOl );IF O101OOIOIOlO1
  96. AND DFDATASEG <> 0 THEN O10101Il1II1I (O100llIl00IOl );DISPOSE (NAMES , DONE );DISPOSE (OO1O , DONE );ERRORADDR := NIL ;
  97. END ;{$IFDEF Windows}TYPE OO00IIlOlI0=PROCEDURE (INT :WORD ;O100llIl00IOl:WORD;
  98. OIOllII1IlO,OIOll10Ol0I,OIOI1OOO110,OIOI1O0OlIO:WORD);PROCEDURE OOll110l0OlO (O10OO110OlIO1:THANDLE;
  99. O10OIIOI1O0I1:OO00IIlOlI0);FAR;EXTERNAL'pmdwin'INDEX 1 ;PROCEDURE OOI1lOlIIO0O ;FAR;EXTERNAL'pmdwin'INDEX 2 ;
  100. PROCEDURE OlI0l10l1 (OIl0OO00IO0:WORD;O100llIl00IOl:WORD;OIOllII1IlO, OIOll10Ol0I, OIOI1OOO110, OIOI1O0OlIO:WORD);EXPORT
  101. ;VAR OOlIl0OOIIOO:POINTER;OIlO:INTEGER;BEGIN LOGERROR ('Fault: 0'+ HEXSTR (OIl0OO00IO0 )+ 'h');IF NOT TDINFOPRESENT (NIL
  102. )THEN EXIT ;O100llIl00IOl := MEMW [ SSEG :O100llIl00IOl ] ;IF ODD (O100llIl00IOl )THEN DEC (O100llIl00IOl );OOlIl0OOIIOO
  103. := PTR (OIOll10Ol0I , OIOI1OOO110 );OI1I0llIO1l (GETLOGICALADDR (OOlIl0OOIIOO ), O100llIl00IOl );DUMPSTACK
  104. (GETLOGICALADDR (OOlIl0OOIIOO ), O100llIl00IOl );CLOSE (FERR );OOI1lOlIIO0O ;TERMINATEAPP (0 , NO_UAE_BOX );END ;
  105. PROCEDURE INITINTHANDLER ;BEGIN OOll110l0OlO (GETCURRENTTASK , OlI0l10l1 );END ;FUNCTION O1lIIO0II0O1 (OI1I1I01OlO:WORD;
  106. OI1II0ll0IOl:LONGINT):BOOL ;EXPORT ;VAR O10OIO0I10100:PNFYLOGERROR ABSOLUTE OI1II0ll0IOl;
  107. OOIIlIII1OIl:PNFYLOGPARAMERROR ABSOLUTE OI1II0ll0IOl;O100llIl00IOl:WORD;BEGIN CASE OI1I1I01OlO  OF NFY_RIP :LOGERROR
  108. ('RIP Error');NFY_OUTSTR :LOGERROR (STRPAS (PCHAR (OI1II0ll0IOl )));NFY_LOGERROR :LOGERROR ('Windows log error: '+ STRW
  109. (O10OIO0I10100 ^. WERRCODE ));NFY_LOGPARAMERROR :BEGIN LOGERROR ('Windows parameter error: '+ STRW (OOIIlIII1OIl ^.
  110. WERRCODE ));ASM {} MOV O100llIl00IOl, BP {} END;DUMPSTACK (GETLOGICALADDR (OOIIlIII1OIl ^. LPFNERRORADDR ), O100llIl00IOl
  111. );END ;END ;O1lIIO0II0O1 := FALSE ;END ;{$ENDIF}PROCEDURE INITPMD (AOPTIONS:WORD);BEGIN IF ISFILEOPEN (FERR )THEN
  112. BEGIN O101OOIOIOlO1 := AOPTIONS ;HANDLERUNTIMEERROR := OOlIll110I1O ;OO000lIIIl1 := DUMPSTACK ;DUMPSTACK := OO1IO10IlIO ;
  113. {$IFDEF Windows}NOTIFYREGISTER (0 , O1lIIO0II0O1 , NF_RIP );{$ENDIF}LOGERROR ('Post Mortem Debugger installed.');END ;
  114. END ;PROCEDURE DONEPMD ;BEGIN DISCARD (NAMES );DISCARD (DSTREAM );END ;END .
  115.