home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ABORTU.ZIP / ABORTU.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-03-27  |  9.0 KB  |  227 lines
  1. {$R-,S-,I+,D+,T+,F-,V+,B-,N-,L+ }
  2. UNIT AbortU; {version 1.01 of 03/27/88}
  3.  
  4. {Copyright (c) 1988 by Carley Phillips.  Placed in the PUBLIC DOMAIN.}
  5.  
  6. {
  7. This Turbo Pascal 4.0 unit provides an alternative to HALT in your programs
  8. and allows you to obtain on the console the address of the "halt" along with
  9. (optionally) a number and/or a message.
  10.  
  11. When your program aborts, simply go to the Compile menu option Find Error
  12. and after entering the reported address you will be at the point in your
  13. code that aborted.
  14.  
  15. IMPORTANT NOTE: When running in the Integrated Development Environment, set
  16. the Compile option to "DESTINATION DISK" else the address reported will not
  17. be accurate.
  18.  
  19. The procedures which you call simply save the necessary information from
  20. the call then halt(254).  The actual address (and number and/or message)
  21. are output to the console during this unit's exit handler.  Among other
  22. things, this means that all your normal exit procedures will function
  23. normally before the abort message is displayed.
  24.  
  25. To provide reliable results (i.e., that you can actually see the message on
  26. the screen), MAKE SURE THAT AbortU IS THE FIRST UNIT IN YOUR MAIN PROGRAM's
  27. Uses list even if your main program doesn't invoke any of the procedures.
  28. This will insure that the exit code for Abort is executed last after other
  29. exit handlers have cleaned up graphics screens, etc.  In particular, if you
  30. are using graphics, then make sure that you never abort while in graphics
  31. mode or that you provide an exit handler in some unit to CloseGraph to get
  32. out of graphics during Turbo's exit procedure processing.  This won't matter
  33. in the IDE but will when you run from the command line.
  34.  
  35. Changes for Version 1.01, 03/27/88:
  36. 1. Add AbortMsg.  Same output was available previously with AbortNumMsg(0,msg).
  37. 2. Add AbortDecimal.  Boolean flag, initially false, which indicates to output
  38.    any abort number in hex.  If true, any number output is in decimal.
  39. 3. Add separate flags for whether or not there is a number and/or message.
  40.    This allows numbers of zero and empty messages to be output in case that
  41.    matters.
  42.  
  43. Comments, suggestions, bug reports, etc. should be sent on Compuserve (via
  44. EasyPlex since I'm not necessarily on every few days) to
  45.  
  46. Carley Phillips, 76630,3312.
  47. }
  48.  
  49. INTERFACE
  50.  
  51. {*****************************************************************************}
  52. const
  53.    AbortDecimal : boolean = false;     {set true to display number in decimal}
  54.  
  55. procedure Abort;
  56.  
  57. procedure AbortNum (tNum : longint     {number}
  58.                    );
  59.  
  60. procedure AbortMsg (tMsg : string      {message}
  61.                    );
  62.  
  63. procedure AbortNumMsg (tNum : longint; {number}
  64.                        tMsg : string   {message}
  65.                       );
  66.  
  67. {*****************************************************************************}
  68. IMPLEMENTATION
  69.  
  70. var
  71.    ExitSave     : pointer;          {save old ExitProc pointer}
  72.    AbortNumber  : longint;          {save user's number, if any}
  73.    AbortMessage : string;           {save user's message, if any}
  74.  
  75. const
  76.    AbortAddress : pointer = NIL;    {save user's address where called Abort}
  77.    HaveNumber   : boolean = false;  {true if user supplied a number}
  78.    HaveMessage  : boolean = false;  {true if user supplied a message}
  79.  
  80. {*****************************************************************************}
  81. {Halts the program.  The exit code will output the address.                   }
  82. {*****************************************************************************}
  83. procedure Abort;
  84. var
  85.    dummyb : byte;                {this is allocated on the stack at BP-1}
  86.    dummyr : record               {then this kludge lets us find return adr}
  87.                tbyte  : byte;
  88.                BP     : word;
  89.                retofs : word;
  90.                retseg : word;
  91.             end absolute dummyb;
  92. begin
  93.    AbortAddress := ptr(dummyr.retseg-PrefixSeg-16,  dummyr.retofs);
  94.    halt (254);
  95. end;
  96.  
  97. {*****************************************************************************}
  98. {Halts the program.  The exit code will output a number and the address.      }
  99. {*****************************************************************************}
  100. procedure AbortNum (tNum : longint  {number}
  101.                    );
  102. var
  103.    dummyb : byte;                {this is allocated on the stack at BP-1}
  104.    dummyr : record               {then this kludge lets us find return adr}
  105.                tbyte  : byte;
  106.                BP     : word;
  107.                retofs : word;
  108.                retseg : word;
  109.             end absolute dummyb;
  110. begin
  111.    AbortAddress := ptr(dummyr.retseg-PrefixSeg-16,  dummyr.retofs);
  112.    AbortNumber  := tNum;
  113.    HaveNumber := true;
  114.    halt (254);
  115. end;
  116.  
  117. {*****************************************************************************}
  118. {Halts the program.  The exit code will output a message and the address.     }
  119. {*****************************************************************************}
  120. procedure AbortMsg (tMsg : string      {message}
  121.                    );
  122. var
  123.    dummyb : byte;                {this is allocated on the stack at BP-257}
  124.    dummyr : record               {then this kludge lets us find return adr}
  125.                tbyte  : byte;
  126.                tMsg   : string;  {note this local copy of string is in stack}
  127.                BP     : word;
  128.                retofs : word;
  129.                retseg : word;
  130.             end absolute dummyb;
  131. begin
  132.    AbortAddress := ptr(dummyr.retseg-PrefixSeg-16,  dummyr.retofs);
  133.    AbortMessage := tMsg;
  134.    HaveMessage := true;
  135.    halt (254);
  136. end;
  137.  
  138. {*****************************************************************************}
  139. {Halts the program.  The exit code will output a number, address, and message.}
  140. {*****************************************************************************}
  141. procedure AbortNumMsg (tNum : longint; {number}
  142.                        tMsg : string   {message}
  143.                       );
  144. var
  145.    dummyb : byte;                {this is allocated on the stack at BP-257}
  146.    dummyr : record               {then this kludge lets us find return adr}
  147.                tbyte  : byte;
  148.                tMsg   : string;  {note this local copy of string is in stack}
  149.                BP     : word;
  150.                retofs : word;
  151.                retseg : word;
  152.             end absolute dummyb;
  153. begin
  154.    AbortAddress := ptr(dummyr.retseg-PrefixSeg-16,  dummyr.retofs);
  155.    AbortNumber  := tNum;
  156.    HaveNumber := true;
  157.    AbortMessage := tMsg;
  158.    HaveMessage := true;
  159.    halt (254);
  160. end;
  161.  
  162. {*****************************************************************************}
  163. {Local function to return a 4-byte string of hex characters for a word                         }
  164. {*****************************************************************************}
  165. function HexStr4ofWrd (tWrd : word       {input word}
  166.                           ) : string;    {4-character string of hex digits}
  167. const
  168.    HexDigit     : array [0..15] of char = '0123456789ABCDEF';
  169. begin {HexStr4ofWrd}
  170.    HexStr4ofWrd[0] := chr(4);
  171.    HexStr4ofWrd[1] := HexDigit[hi(tWrd) shr 4];
  172.    HexStr4ofWrd[2] := HexDigit[hi(tWrd) and $0F];
  173.    HexStr4ofWrd[3] := HexDigit[lo(tWrd) shr 4];
  174.    HexStr4OfWrd[4] := HexDigit[lo(tWrd) and $0F];
  175. end; {HexStr4ofWrd}
  176.  
  177. {*****************************************************************************}
  178. {Exit procedure.  If abort was called, then output addr, num, and msg.        }
  179. {If you have properly made AbortU the first unit in you main program, then the}
  180. {halt in the abort procedure will trigger all of your exit handlers before    }
  181. {Turbo finally does this exit procedure to actually output the address.       }
  182. {*****************************************************************************}
  183. {$F+} procedure ExitHandler; {$F-}
  184.  
  185. const
  186.    BEL = #$07;
  187. var
  188.    console : text;
  189.  
  190. function MswOfLng (tLng : longint) : word;
  191.    Inline($44/$44/$58);
  192.  
  193. function LswOfLng (tLng : longint) : word;
  194.    Inline($58/$44/$44);
  195.  
  196. begin
  197.    if AbortAddress <> NIL then
  198.       begin
  199.          writeln;
  200.          {$I-} flush (output); {$I+}
  201.          if IOResult <> 0 then ; {Don't care.  Just wanted it flushed.}
  202.          assign (console,'CON'); {Make sure we know where message will go.}
  203.          rewrite (console);
  204.          write   (console, BEL, 'Program Abort');
  205.          if HaveNumber then
  206.             if AbortDecimal then
  207.                write (console, ' ', AbortNumber)
  208.             else
  209.                write (console, ' ', HexStr4ofWrd(MswOfLng(AbortNumber)),
  210.                                     HexStr4ofWrd(LswOfLng(AbortNumber)));
  211.          write (console, ' at ',
  212.                 HexStr4ofWrd(MswOfLng(LongInt(AbortAddress))),
  213.                 ':',
  214.                 HexStr4ofWrd(LswOfLng(LongInt(AbortAddress))));
  215.          if HaveMessage then
  216.             write (console, ' (', AbortMessage, ')');
  217.          writeln (console,BEL);
  218.       end;
  219.    ExitProc := ExitSave;
  220. end;
  221.  
  222. {*****************************************************************************}
  223. begin
  224.    ExitSave := ExitProc;     {save previous exit handler address}
  225.    ExitProc := @ExitHandler; {install our exit handler}
  226. end.
  227.