File Archive

 
Output of file : ABORTU.PAS contained in archive : ABORTU.ZIP

{$R-,S-,I+,D+,T+,F-,V+,B-,N-,L+ }
UNIT AbortU; {version 1.01 of 03/27/88}

{Copyright (c) 1988 by Carley Phillips. Placed in the PUBLIC DOMAIN.}

{
This Turbo Pascal 4.0 unit provides an alternative to HALT in your programs
and allows you to obtain on the console the address of the "halt" along with
(optionally) a number and/or a message.

When your program aborts, simply go to the Compile menu option Find Error
and after entering the reported address you will be at the point in your
code that aborted.

IMPORTANT NOTE: When running in the Integrated Development Environment, set
the Compile option to "DESTINATION DISK" else the address reported will not
be accurate.

The procedures which you call simply save the necessary information from
the call then halt(254). The actual address (and number and/or message)
are output to the console during this unit's exit handler. Among other
things, this means that all your normal exit procedures will function
normally before the abort message is displayed.

To provide reliable results (i.e., that you can actually see the message on
the screen), MAKE SURE THAT AbortU IS THE FIRST UNIT IN YOUR MAIN PROGRAM's
Uses list even if your main program doesn't invoke any of the procedures.
This will insure that the exit code for Abort is executed last after other
exit handlers have cleaned up graphics screens, etc. In particular, if you
are using graphics, then make sure that you never abort while in graphics
mode or that you provide an exit handler in some unit to CloseGraph to get
out of graphics during Turbo's exit procedure processing. This won't matter
in the IDE but will when you run from the command line.

Changes for Version 1.01, 03/27/88:
1. Add AbortMsg. Same output was available previously with AbortNumMsg(0,msg).
2. Add AbortDecimal. Boolean flag, initially false, which indicates to output
any abort number in hex. If true, any number output is in decimal.
3. Add separate flags for whether or not there is a number and/or message.
This allows numbers of zero and empty messages to be output in case that
matters.

Comments, suggestions, bug reports, etc. should be sent on Compuserve (via
EasyPlex since I'm not necessarily on every few days) to

Carley Phillips, 76630,3312.
}

INTERFACE

{*****************************************************************************}
const
AbortDecimal : boolean = false; {set true to display number in decimal}

procedure Abort;

procedure AbortNum (tNum : longint {number}
);

procedure AbortMsg (tMsg : string {message}
);

procedure AbortNumMsg (tNum : longint; {number}
tMsg : string {message}
);

{*****************************************************************************}
IMPLEMENTATION

var
ExitSave : pointer; {save old ExitProc pointer}
AbortNumber : longint; {save user's number, if any}
AbortMessage : string; {save user's message, if any}

const
AbortAddress : pointer = NIL; {save user's address where called Abort}
HaveNumber : boolean = false; {true if user supplied a number}
HaveMessage : boolean = false; {true if user supplied a message}

{*****************************************************************************}
{Halts the program. The exit code will output the address. }
{*****************************************************************************}
procedure Abort;
var
dummyb : byte; {this is allocated on the stack at BP-1}
dummyr : record {then this kludge lets us find return adr}
tbyte : byte;
BP : word;
retofs : word;
retseg : word;
end absolute dummyb;
begin
AbortAddress := ptr(dummyr.retseg-PrefixSeg-16, dummyr.retofs);
halt (254);
end;

{*****************************************************************************}
{Halts the program. The exit code will output a number and the address. }
{*****************************************************************************}
procedure AbortNum (tNum : longint {number}
);
var
dummyb : byte; {this is allocated on the stack at BP-1}
dummyr : record {then this kludge lets us find return adr}
tbyte : byte;
BP : word;
retofs : word;
retseg : word;
end absolute dummyb;
begin
AbortAddress := ptr(dummyr.retseg-PrefixSeg-16, dummyr.retofs);
AbortNumber := tNum;
HaveNumber := true;
halt (254);
end;

{*****************************************************************************}
{Halts the program. The exit code will output a message and the address. }
{*****************************************************************************}
procedure AbortMsg (tMsg : string {message}
);
var
dummyb : byte; {this is allocated on the stack at BP-257}
dummyr : record {then this kludge lets us find return adr}
tbyte : byte;
tMsg : string; {note this local copy of string is in stack}
BP : word;
retofs : word;
retseg : word;
end absolute dummyb;
begin
AbortAddress := ptr(dummyr.retseg-PrefixSeg-16, dummyr.retofs);
AbortMessage := tMsg;
HaveMessage := true;
halt (254);
end;

{*****************************************************************************}
{Halts the program. The exit code will output a number, address, and message.}
{*****************************************************************************}
procedure AbortNumMsg (tNum : longint; {number}
tMsg : string {message}
);
var
dummyb : byte; {this is allocated on the stack at BP-257}
dummyr : record {then this kludge lets us find return adr}
tbyte : byte;
tMsg : string; {note this local copy of string is in stack}
BP : word;
retofs : word;
retseg : word;
end absolute dummyb;
begin
AbortAddress := ptr(dummyr.retseg-PrefixSeg-16, dummyr.retofs);
AbortNumber := tNum;
HaveNumber := true;
AbortMessage := tMsg;
HaveMessage := true;
halt (254);
end;

{*****************************************************************************}
{Local function to return a 4-byte string of hex characters for a word }
{*****************************************************************************}
function HexStr4ofWrd (tWrd : word {input word}
) : string; {4-character string of hex digits}
const
HexDigit : array [0..15] of char = '0123456789ABCDEF';
begin {HexStr4ofWrd}
HexStr4ofWrd[0] := chr(4);
HexStr4ofWrd[1] := HexDigit[hi(tWrd) shr 4];
HexStr4ofWrd[2] := HexDigit[hi(tWrd) and $0F];
HexStr4ofWrd[3] := HexDigit[lo(tWrd) shr 4];
HexStr4OfWrd[4] := HexDigit[lo(tWrd) and $0F];
end; {HexStr4ofWrd}

{*****************************************************************************}
{Exit procedure. If abort was called, then output addr, num, and msg. }
{If you have properly made AbortU the first unit in you main program, then the}
{halt in the abort procedure will trigger all of your exit handlers before }
{Turbo finally does this exit procedure to actually output the address. }
{*****************************************************************************}
{$F+} procedure ExitHandler; {$F-}

const
BEL = #$07;
var
console : text;

function MswOfLng (tLng : longint) : word;
Inline($44/$44/$58);

function LswOfLng (tLng : longint) : word;
Inline($58/$44/$44);

begin
if AbortAddress <> NIL then
begin
writeln;
{$I-} flush (output); {$I+}
if IOResult <> 0 then ; {Don't care. Just wanted it flushed.}
assign (console,'CON'); {Make sure we know where message will go.}
rewrite (console);
write (console, BEL, 'Program Abort');
if HaveNumber then
if AbortDecimal then
write (console, ' ', AbortNumber)
else
write (console, ' ', HexStr4ofWrd(MswOfLng(AbortNumber)),
HexStr4ofWrd(LswOfLng(AbortNumber)));
write (console, ' at ',
HexStr4ofWrd(MswOfLng(LongInt(AbortAddress))),
':',
HexStr4ofWrd(LswOfLng(LongInt(AbortAddress))));
if HaveMessage then
write (console, ' (', AbortMessage, ')');
writeln (console,BEL);
end;
ExitProc := ExitSave;
end;

{*****************************************************************************}
begin
ExitSave := ExitProc; {save previous exit handler address}
ExitProc := @ExitHandler; {install our exit handler}
end.