home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / ptgenr2.zip / BBERROR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-01  |  6KB  |  97 lines
  1. (* This file was mangled by Mangler 1.32 (c) Copyright 1993-1994 by Berend de Boer *)
  2. { Created : 01-06-'90
  3.  
  4. Last changes :
  5. 91-07-10  Adapted for use in TP6.0 and Turbo Vision
  6. 92-07-02  Added log file ferr where an application can write error codes to
  7. 92-12-04  Added code to clear IOResult so an errormessage can be written to
  8.           the log file
  9. 93-01-18  Installed a simple Heap function to return 1 when a request for
  10.           memory could not be fulfilled
  11. 93-01-28  Deleted statements which disposed an Application if an error was
  12.           detected
  13. 93-05-05  Added a dump stack procedure
  14. 93-12-01  Added a hook for the Post Mortem Debugger, simple change the
  15.           procedure variable HandleRunTimeError
  16. 94-03-17  Renamed InstallExitHandler to InitBBError
  17. 94-05-16  Adapted to Windows target
  18.  
  19.  
  20. Expects that an application object was running
  21. }
  22.  
  23.  
  24.  
  25. {$IFDEF MSDOS}
  26. {$O+,F+,D-}
  27. {$ENDIF}
  28.  
  29. {$I-,V-,Q-,R-,S-}
  30. unit BBError;
  31.  
  32. interface
  33.  
  34. uses Objects,
  35.      {$IFDEF Windows}
  36.      BBFile
  37.      {$ELSE}
  38.      Dos
  39.      {$ENDIF};
  40.  
  41.  
  42. const
  43.   FatalErrorText:string[128] = 'Fatal error. Errorcode: ';
  44.  
  45. type
  46.   HandleRunTimeErrorProcedureType = procedure(StackFrame : word);
  47.   DumpStackProcedureType = procedure(Addr : pointer; StackFrame : word);
  48.  
  49. var
  50.   ferr : text;
  51.   HandleRunTimeError : HandleRunTimeErrorProcedureType;
  52.   DumpStack : DumpStackProcedureType;
  53.  
  54.  
  55. function  GetLogicalAddr(Addr : pointer) : pointer;
  56. procedure LogError(const s : string);
  57. procedure InitBBError(const AFileName : PathStr);
  58.  
  59.  
  60.  
  61.  
  62.  IMPLEMENTATION USES {$IFNDEF Windows}BBFILE , {$ENDIF}BBGUI , BBUTIL ;FUNCTION GETLOGICALADDR (ADDR:POINTER):POINTER ;
  63. ASSEMBLER;ASM {} {$IFNDEF MsDos} {} MOV DX , WORD PTR ADDR+ 2 {} CMP DX , 0 {} JE @@end {} VERR DX {} JE @@selok {}
  64. XOR DX , DX {} JMP @@end {} @@selok : {} MOV ES , DX {} MOV DX , WORD PTR ES : [ 0 ] {} @@end : {}
  65. MOV AX , WORD PTR ADDR{} {$ENDIF} {} {$IFDEF MsDos} {} MOV CX , WORD PTR ADDR{} MOV BX , WORD PTR ADDR+ 2 {}
  66. MOV AX , OVRLOADLIST{} @@0 : {} OR AX , AX {} JE @@3 {} MOV ES , AX {} MOV AX , ES : WORD PTR 16 {} OR AX , AX {}
  67. JE @@1 {} SUB AX , BX {} JA @@1 {} NEG AX {} CMP AX , 1000h {} JAE @@1 {} MOV DX , 16 {} MUL DX {} ADD AX , CX {}
  68. JC @@1 {} CMP AX , ES : WORD PTR 8 {} JB @@2 {} @@1 : {} MOV AX , ES : WORD PTR 20 {} JMP @@0 {} @@2 : {} MOV CX , AX {}
  69. MOV BX , ES {} @@3 : {} SUB BX , PREFIXSEG{} SUB BX , 10h {} MOV AX , CX {} MOV DX , BX {} {$ENDIF} {} END;
  70. PROCEDURE O100I0IOIOl (OOlIl0OOIIOO:POINTER;O100llIl00IOl:WORD);FAR;PROCEDURE O1011O1IO1O10 (OOlIl0OOIIOO:POINTER);
  71. BEGIN WITH PTRREC(OOlIl0OOIIOO) DO WRITELN (FERR , '  ', HEXSTR (SEG ), ':', HEXSTR (OFS ));END ;VAR O101O01III1II:WORD;
  72. O100Ol00I:POINTER;BEGIN IF NOT FILEOPEN (FERR )THEN EXIT ;LOGERROR ('**Stack dump. Callers shown only**');IF ODD
  73. (O100llIl00IOl )THEN DEC (O100llIl00IOl );O100llIl00IOl := MEMW [ SSEG :O100llIl00IOl ] ;O101O01III1II := MEMW [ SSEG
  74. :O100llIl00IOl ] ;IF ODD (O101O01III1II )THEN DEC (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;WHILE (O101O01III1II >
  75. O100llIl00IOl )AND (MEMW [ SSEG :O100llIl00IOl ] <> 0 ) DO BEGIN PTRREC (OOlIl0OOIIOO ). OFS := MEMW [ SSEG
  76. :O100llIl00IOl + 2 ] ;IF (MEMW [ SSEG :O100llIl00IOl + 4 ] =O101O01III1II ){$IFDEF MSDOS}OR (MEMW [ SSEG :O100llIl00IOl +
  77. 4 ] =1 ){$ENDIF}THEN PTRREC (OOlIl0OOIIOO ). SEG := PTRREC (O100Ol00I ). SEG ELSE BEGIN PTRREC (OOlIl0OOIIOO ). SEG :=
  78. MEMW [ SSEG :O100llIl00IOl + 4 ] ;OOlIl0OOIIOO := GETLOGICALADDR (OOlIl0OOIIOO );IF OOlIl0OOIIOO =NIL THEN BREAK ;
  79. {$IFDEF MSDOS}IF (MEMW [ SSEG :O101O01III1II ] =0 )OR (MEMW [ SSEG :O101O01III1II ] =MEMW [ SSEG :O100llIl00IOl + 4 ]
  80. )THEN PTRREC (OOlIl0OOIIOO ). SEG := 0 ;{$ELSE}IF PTRREC (OOlIl0OOIIOO ). SEG =0 THEN PTRREC (OOlIl0OOIIOO ). SEG :=
  81. PTRREC (O100Ol00I ). SEG ;{$ENDIF}END ;O100llIl00IOl := O101O01III1II ;O1011O1IO1O10 (OOlIl0OOIIOO );O101O01III1II :=
  82. MEMW [ SSEG :O100llIl00IOl ] ;IF ODD (O101O01III1II )THEN DEC (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;END ;END ;
  83. PROCEDURE LOGERROR (CONST S:STRING );VAR OIOO:INTEGER;BEGIN IF FILEOPEN (FERR )THEN BEGIN OIOO := IORESULT ;WRITELN (FERR
  84. , GETDATESTR , ' ', GETTIMESTR , '  ', S );FLUSH (FERR );END ;END ;PROCEDURE O10O0I0llIOl0 (O100llIl00IOl:WORD);
  85. FAR;BEGIN WRITE (FERR , GETDATESTR , '  ', GETTIMESTR , '  ');WRITE (FERR , 'Errorcode = ', EXITCODE , '  ');WRITELN
  86. (FERR , 'Erroraddr = ', HEXSTR (PTRREC (ERRORADDR ). SEG ), ':', HEXSTR (PTRREC (ERRORADDR ). OFS ));WRITELN (FERR ,
  87. 'MaxAvail = ', MAXAVAIL );WRITELN (FERR , 'MemAvail = ', MEMAVAIL );DUMPSTACK (ERRORADDR , O100llIl00IOl );CLOSE (FERR );
  88. APPEND (FERR );INFOBOX (FATALERRORTEXT + STRW (EXITCODE ), 0 );END ;VAR O1lO11Il00lI:POINTER;PROCEDURE OIO0OO1100O ;
  89. FAR;VAR OIOO:WORD;OIO1OO11I1:WORD;BEGIN ASM {} MOV AX , BP {} SHR AX , 1 {} SHL AX , 1 {} MOV OIO1OO11I1, AX {} END;
  90. EXITPROC := O1lO11Il00lI ;OIOO := IORESULT ;IF (EXITCODE =0 )OR (ERRORADDR =NIL )THEN BEGIN WRITELN (FERR ,
  91. 'Program ended on ', GETDATESTR , ' at ', GETTIMESTR );CLOSE (FERR );EXIT ;END ;HANDLERUNTIMEERROR (OIO1OO11I1 );CLOSE
  92. (FERR );END ;{$IFDEF DPMI}FUNCTION O1011I1OlOIO1 (OI1OIIIl0lO1:WORD):INTEGER ;FAR;BEGIN O1011I1OlOIO1 := 1 ;END ;
  93. {$ENDIF}PROCEDURE INITBBERROR (CONST AFILENAME:PATHSTR);BEGIN O1lO11Il00lI := EXITPROC ;EXITPROC := @ OIO0OO1100O ;
  94. DUMPSTACK := O100I0IOIOl ;HANDLERUNTIMEERROR := O10O0I0llIOl0 ;ASSIGN (FERR , AFILENAME );IF NOT FILEEXIST (AFILENAME
  95. )THEN REWRITE (FERR )ELSE APPEND (FERR );WRITELN (FERR );WRITELN (FERR , '** Program started on ', GETDATESTR , ' at ',
  96. GETTIMESTR , ' **');{$IFDEF DPMI}HEAPERROR := @ O1011I1OlOIO1 ;{$ENDIF}END ;END .
  97.