[Back to EXEC SWAG index]  [Back to Main SWAG index]  [Original]

UNIT BPTrap;  { see DEMO at the bottom !! }

{ Trap runtime errors, Version 1.0
  Copyright (C) 1991-1996 by Frank Heckenbach, heckenb@mi.uni-erlangen.de

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, version 1, for NON-COMMERCIAL use.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. }

{$IFNDEF VER70}
This unit was tested only with Borland Pascal 7.0. You can use it with other
versions by commenting these two lines, but at your own risk!
{$ENDIF}

INTERFACE

FUNCTION  Trap:Boolean; FAR;
{* Returns False on installation.
 * After trapping a runtime error it jumps back to where the function was
   called returning True.
 * The procedure that calls Trap must NOT return as long as Trap is installed
   (so it is safest to call Trap from the main program, if possible)!
 * You must call this function AFTER installing all other Exitprocs (if any).
 * In Real mode: You must NOT call it from an overlayed unit.
 * In Protected mode and Windoze: You must call it from a code segment with
   the following attributes: FIXED PRELOAD PERMANENT. (I am not sure if this
   is really necessary...).}

FUNCTION UnTrap:Boolean;
{Returns True iff Trap could be uninstalled.}

IMPLEMENTATION

TYPE ptrrec=RECORD ofs,sgm:Word END;

CONST
  addrsave:Pointer=NIL;
  codesave:Word=0;

VAR
  exitsave,trapaddr:Pointer;
  trapsp,trapbp:Word;

{$S-}
PROCEDURE Trapexit; FAR;
BEGIN
  IF Erroraddr<>NIL
    THEN {Trapping runtime error}
      BEGIN
        {Install Trapexit again (in case another runtime error occurs later)!}
        Exitproc:=@Trapexit;

        {Keep error address and exit code and reset these variables}
        addrsave:=Erroraddr;
        codesave:=Exitcode;
        Erroraddr:=NIL;
        Exitcode:=0;

        {If you want, you can do something here to indicate the user that an
         error occurred. You could e.g. pop up a message telling the user to
         quit the program asap and report the error to the programmer.}

        ASM
          {Load the saved SP and BP registers}
          MOV  SP,trapsp
          MOV  BP,trapbp

          {Continue at saved address returning True}
          MOV  AL,1
          JMP  [trapaddr]
        END
      END

    ELSE {Programm finished without an error}
      BEGIN
        {Continue with other exit procs}
        Exitproc:=exitsave;

        {Restore error address and exit code of the last trapped error, if any}
        IF addrsave<>NIL THEN
          BEGIN
            Erroraddr:=addrsave;
            Exitcode:=codesave
          END
      END
END;

FUNCTION Trap:Boolean; ASSEMBLER;
ASM
   {Install Trapexit as an Exitproc}
   MOV  AX,OFFSET Trapexit
   MOV  DX,SEG Trapexit
   CMP  Exitproc.ptrrec.ofs,AX
   JNE  @1
   CMP  Exitproc.ptrrec.sgm,DX
   JE   @2
@1:XCHG Exitproc.ptrrec.ofs,AX
   XCHG Exitproc.ptrrec.sgm,DX
   MOV  exitsave.ptrrec.ofs,AX
   MOV  exitsave.ptrrec.sgm,DX

   {Save SP and BP registers and the return address}
@2:MOV  trapbp,BP
   MOV  SI,SP
   {$IFDEF WINDOWS}
   ADD  SI,4
   ADD  trapbp,6
   {$ENDIF}
   LES  DI,SS:[SI]
   MOV  trapaddr.ptrrec.ofs,DI
   MOV  trapaddr.ptrrec.sgm,ES
   ADD  SI,4
   MOV  trapsp,SI

   {Return False}
   XOR  AX,AX
END;

FUNCTION UnTrap:Boolean;
BEGIN
  IF Exitproc=@Trapexit
    THEN
      BEGIN
        Exitproc:=exitsave;
        UnTrap:=True
      END
    ELSE UnTrap:=False
END;
END.


{ -----------------------  DEMO PROGRAM --------------------- }

PROGRAM TrapDemo;
{ Demo program for BPTrap unit, Version 1.0
  Copyright (C) 1996 by Frank Heckenbach, heckenb@mi.uni-erlangen.de

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, version 1, for NON-COMMERCIAL use.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. }

{$C FIXED PRELOAD PERMANENT} {Not necessary for real mode.}

USES BPTrap{$IFDEF WINDOWS},Wincrt{$ENDIF};

VAR a,b:Byte;

BEGIN
  Writeln;
  Writeln('TrapDemo version 1.0, Copyright (C) 1996 by Frank Heckenbach');
  Writeln('TrapBP and TrapDemo come with ABSOLUTELY NO WARRANTY.');
  Writeln('This is free software, and you are welcome to redistribute it');
  Writeln('under certain conditions for NON-COMMERCIAL use.');
  Writeln('For details see the file COPYING.');
  Writeln;
  Writeln('Before the trap...');
  Writeln;
  Randomize;
  IF NOT Trap THEN
    REPEAT
      a:=Random(10);
      b:=Random(10);
      Writeln(a,'/',b,'=',a/b)
    UNTIL False;
  Writeln('Infinity.');
  Write('Press Enter.');
  Readln;
  Write('The program caused a... ')
END.

[Back to EXEC SWAG index]  [Back to Main SWAG index]  [Original]