home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / dos.swg / 0026_Trap DOS Error.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  4.9 KB  |  157 lines
  1. {
  2. Alexander Kugel
  3.  
  4.    There was a discussion about  how to trap  floating point errors
  5. in  TP.  Here  is  the   solution that traps   any kind of run-time
  6. errors.  The idea is not mine. I saw it in a russian  book about TP
  7. and OOP.
  8.  
  9.    The idea is quite simple.  Instead of trying to trap all kind of
  10. errors, we  can let TP to do  the job For  us.   Whenever  TP stops
  11. execution of the  Program ( because   of a run  time  error or just
  12. because  the Program  stops in a  natural  way )  it   executes the
  13. default Procedure of Exit : ExitProc.  Then TP checks the status of
  14. two Variables from  the SYSTEM Unit  : ErrorAddr and  ExitCode.  If
  15. there was a run  time error then ErrorAddr  is not NIL and ExitCode
  16. containes the run time error code. Otherwise ExitCode containes the
  17. errorlevel  that  will be    set  For  Dos and  ErrorAddr  is  NIL.
  18. Fortunatly  we can easily  redefine   the  ExitProc,   and  thus to
  19. overtake the control from TP. The problem is that we got to be able
  20. to get back or to jump to any point  of the Program  ( even to jump
  21. inside a Procedure / Function). The author of the book claimed that
  22. he took his routines from Turbo Professional.
  23.  
  24.    Well, there are two Files you are gonna need. Save the first one
  25. as JUMP.PAS Compile it as a Unit. The second one is a short Program
  26. that shows  how to use  it. It  asks For   two numbers, divides the
  27. first  by the second and takes  a  natural logarithm of the result.
  28. Try to divide by zero, logarithm of a negative number. Try entering
  29. letters instead of numbers and see how the Program recovers.
  30.  
  31.    The trapping   works  fine under Windows/Dos.   To  run  it With
  32. WindowS recompile the JUMP Unit For Windows target. Then add WinCrt
  33. to the Uses statement and remove Mark/Release lines ( because there
  34. is no Mark/Release For Windows ).
  35.  
  36. ------------------------------jump.pas-----------------------------
  37. }
  38.  
  39. Unit Jump;
  40.  
  41. Interface
  42.  
  43. Type
  44.   JumpRecord = Record
  45.     SpReg,
  46.     BpReg  : Word;
  47.     JmpPt  : Pointer;
  48.   end;
  49.  
  50. Procedure SetJump(Var JumpDest : JumpRecord);
  51. {Storing SP,BP and the address}
  52. Inline(
  53.   $5F/                   {pop di           }
  54.   $07/                   {pop es           }
  55.   $26/$89/$25/           {mov es:[di],sp   }
  56.   $26/$89/$6D/$02/       {mov es:[di+2],bp }
  57.   $E8/$00/$00/           {call null        }
  58.                          {null:            }
  59.   $58/                   {pop ax           }
  60.   $05/$0C/$00/           {add ax,12        }
  61.   $26/$89/$45/$04/       {mov es:[di+4],ax }
  62.   $26/$8C/$4D/$06);      {mov es:[di+6],cs }
  63.                          {next:            }
  64.  
  65. Procedure LongJump(Var JumpDest : JumpRecord);
  66. {Restore everything and jump}
  67. Inline(
  68.   $5F/                   {pop di           }
  69.   $07/                   {pop es           }
  70.   $26/$8B/$25/           {mov sp,es:[di]   }
  71.   $26/$8B/$6D/$02/       {mov bp,es:[di+2] }
  72.   $26/$FF/$6D/$04);      {jmp far es:[di+4]}
  73.  
  74. Implementation
  75.  
  76. end.
  77.  
  78. { ------------------------------try.pas------------------------------ }
  79.  
  80. Program Try;
  81. Uses
  82.   Jump;                                 {Uses Jump,WinCrt;}
  83.  
  84. Var
  85.   OldExit : Pointer;
  86.   MyAddr  : JumpRecord;
  87.   MyHeap  : Pointer;
  88.  
  89.   a1,a2,
  90.   a3,a4   : Real;
  91.  
  92.  
  93. {$F+}
  94. Procedure MyExit;
  95. {You can add your error handler here}
  96. begin
  97.   if ErrorAddr <> Nil Then
  98.   begin
  99.     Case ExitCode of
  100.       106 : Writeln('Invalid numeric format');
  101.       200 : Writeln('Division by zero');
  102.       205 : Writeln('Floating point overflow');
  103.       206 : Writeln('Floating point underflow');
  104.       207 : Writeln('Invalid floating point  operation');
  105.       else  Writeln('Hmmm... How did you do that ?');
  106.     end;
  107.     ErrorAddr := Nil;
  108.     LongJump(MyAddr);
  109.   end;
  110.   ExitProc := OldExit;
  111. end;
  112. {$F-}
  113.  
  114. begin
  115.   OldExit := ExitProc;
  116.   Mark(MyHeap);
  117.   {Just an example of how to restore the heap }
  118.   {Actually we don't have to do that in       }
  119.   {this Program, because we dont use heap     }
  120.   {at all. But anyway here it goes            }
  121.  
  122.         {Don't forget to remove when compiling this }
  123.         {for Windows        }
  124.  
  125.   SetJump(MyAddr);
  126.  
  127.   {We'll get back here whenever a run time    }
  128.   {error occurs                               }
  129.   {This line should always be before          }
  130.   {     ExitProc:=MyExit;                     }
  131.   {Don't ask me why... It's much easier For me}
  132.   {to follow the rule then to understand it :)}
  133.  
  134.   ExitProc := @MyExit;
  135.  
  136.   Release(MyHeap);
  137.   {restoring the heap after a run time error }
  138.         {Remove this if you are compiling it For   }
  139.         {Windows                                   }
  140.  
  141.   {Try entering whatever you want at the     }
  142.   {prompt. It should trap every runtime error}
  143.   {you could possibly get.                   }
  144.  
  145.   Repeat
  146.     Writeln;
  147.     Write('Enter a number a1=');
  148.     Readln(a1);
  149.     Write('Enter a number a2=');
  150.     Readln(a2);
  151.     a3 := a1 / a2;
  152.     Writeln('a1/a2=', a3 : 10 : 5);
  153.     a4 := ln(a3);
  154.     Writeln('ln(a1/a2)=', a4 : 10 : 5);
  155.   Until a3 = 1;
  156. end.
  157.