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