Board index » delphi » Exception handlers - revisited

Exception handlers - revisited

A few days ago, Jasper Neumann posted a wonderful little exception-handler unit
on the network; the only drawback was that it didn't support overlays. Well, now
it does... (in TP 6.01 anyway, but I doubt that the overlay manager has changed
beyond all recognition between versions 6 and 7.)

The basic change is that the routine in the overlay manager that walks the call-
stack, swapping segments of return addresses, has been prefixed with a small
loop that does the same thing to the exceptions list. Also, the raise()
procedure now checks whether the segment of a return address points to the
memory "stub" of an unloaded overlay. (Overlay stubs start with INT $3F). If
the overlay needs to be loaded then the return offset is placed into the correct
slot in the overlay's stub and the return address changed to point to the
INT $3F instruction instead.

I have tested this using a simple overlaid program and it seems to work OK.
Enjoy...

Chris.

-cut-here------------------------------------------------------------------
{$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
unit except;
{$IFOPT G+}
  {$UNDEF CPU386}
{$ENDIF}

{$DEFINE singlestack}

{---------------------------------------------------------------------------}
{ Exceptions in TP! (c) 1993 by Jasper Neumann / SCP GmbH Aachen.           }
{ DOS, DPMI, OS/2, probably Win; *not* in overlays.                         }
{                                                                           }
{ Overlay support for TP 6.0 added by C.J.Rankin 1995                       }
{ If you use overlays then you MUST call XOvrInit() instead in OvrInit()!!  }
{ N.B. Since the exception structure is entirely stack based and there is   }
{      only 1 stack segment in TP, can the LINK element be replaced by a    }
{      word rather than a pointer?                                          }
{      And similarly only SP needs to be saved, rather than SS:SP?          }
{      This option is provided by $DEFINE singlestack.                      }
{---------------------------------------------------------------------------}
{ The following scheme should be applied:                                   }
{                                                                           }
{  case exception of                                                        }
{    0: begin                                                               }
{        (your code)                                                        }
{         end_exception                                                     }
{       end;                                                                }
{    err_1: err_1_handler;                                                  }
{    ...                                                                    }
{    err_n: err_n_handler;                                                  }
{  else                                                                     }
{    raise_current                                                          }
{  end;                                                                     }
{                                                                           }
{ The case 0 always contains the code you want to protect.                  }
{ The line "else raise_current;" submits not handled exceptions to the next }
{ exception handler.                                                        }
{                                                                           }
{ Explicit raising is done with  raise(x)  (x<>0).                          }
{---------------------------------------------------------------------------}

interface

const
  e_invalid_raise = 250; (* Exception raised without an *)
                         (* exception handler installed *)

type
  Pexception = ^Texception;
  Texception = record
               {$IFDEF singlestack}
                 link:        word;
               {$ELSE}
                 link:        Pexception;
               {$ENDIF}
                 _bp,_ip,_cs: word
               end;          (* Non-public exception structure. *)

const                        
  err_no: word = 0;          (* Argument of last raise.       *)
{$IFDEF singlestack}
  cur_ex: word = 0;
{$ELSE}                      (* Non-public pointer to current *)
  cur_ex: Pexception = nil;  (*   exception block.            *)
{$ENDIF}

const
{$IFDEF singlestack}
  exceptjmp = $10;
{$ELSE}
  {$IFDEF CPU386}
    exceptjmp = $15;
  {$ELSE}
    exceptjmp = $18;
  {$ENDIF}
{$ENDIF}

function exception: word; (* Creates an exception handler.      *)
inline(
   $0e                    (*   push cs                          *)
  /$e8/$00/$00            (*   call here                        *)
                          (* here:                              *)
  /$58                    (*   pop ax -- ip                     *)
  /$05/>exceptjmp         (*   add ax, ofs(start)-ofs(here)     *)
  /$50                    (*   push ax -- ip                    *)
  /$55                    (*   push bp                          *)
{$IFDEF singlestack}
  /$ff/$36/>cur_ex        (*   push word ptr [offset cur_ex]    *)
  /$89/$26/>cur_ex        (*   mov [offset cur_ex], sp          *)
{$ELSE}
  {$IFDEF CPU386}
    /$66/$ff/$36/>cur_ex  (*   push dword ptr [offset cur_ex]   *)
  {$ELSE}
    /$ff/$36/>cur_ex+2    (*   push word ptr [offset cur_ex+2]  *)
    /$ff/$36/>cur_ex      (*   push word ptr [offset cur_ex]    *)
  {$ENDIF}
    /$8c/$16/>cur_ex+2    (*   mov [offset cur_ex+2], ss        *)
    /$89/$26/>cur_ex      (*   mov [offset cur_ex], sp          *)
{$ENDIF}
  /$31/$c0                (*   xor ax,ax -- no exception        *)
  );                      (* start:                             *)

{$IFDEF singlestack}
procedure end_exception;
inline(
   $8f/$06/>cur_ex       (*   pop word ptr [offser cur_ex]     *)
  /$83/$c4/$06           (*   add sp,6 -- bp, ip and cs        *)
  );
{$ELSE}
procedure end_exception; (* Leaves the current exception handler. *)
inline(
{$IFDEF CPU386}
   $66/$8f/$06/>cur_ex   (*   pop dword ptr [offset cur_ex]    *)
{$ELSE}
   $8f/$06/>cur_ex       (*   pop word ptr [offset cur_ex]     *)
  /$8f/$06/>cur_ex+2     (*   pop word ptr [offset cur_ex+2]   *)
{$ENDIF}
  /$83/$c4/$06           (*   add sp,6 -- bp, ip and cs        *)
  );
{$ENDIF}

procedure raise(x: word);
procedure raise_current;
procedure halt(x: word);    (* System override to really quit the program. *)
procedure XOvrInit(filename: string); (* Installs modified overlay manager *)
procedure install_std_err;

implementation
uses overlay;

const
{$IFDEF singlestack}
  retofs = 26;
{$ELSE}
  retofs = 27;
{$ENDIF}

const
  exitsave: pointer = nil;

procedure halt(x: word);
begin
{$IFDEF singlestack}
  cur_ex := 0;
{$ELSE}
  cur_ex := nil;
{$ENDIF}
  system.halt(x)
end;

procedure raise(x: word);
begin
  err_no := x;
  if (x=0) or
     {$IFDEF singlestack} (cur_ex=0) {$ELSE} (cur_ex=nil) {$ENDIF} then
    runerror(e_invalid_raise);
  asm
  {$IFDEF singlestack}
    mov sp, [offset cur_ex]
    pop word ptr [offset cur_ex]
  {$ELSE}
    {$IFDEF CPU386}
      db $0f, $b2, 00100110b; dw offset cur_ex
                                           (* lss sp, [offset cur_ex]       *)
      db $66; pop word ptr [offset cur_ex] (* pop dword ptr [offset cur_ex] *)
    {$ELSE}
      mov ss, [offset cur_ex+2]
      mov sp, [offset cur_ex]
      pop word ptr [offset cur_ex]
      pop word ptr [offset cur_ex+2]
    {$ENDIF}
  {$ENDIF}

    cld
    mov bp, sp
    les bx, [bp+2]
    xor di, di
    mov ax, $3FCD
    scasw
    jne @loaded
    mov ax, bx
    stosw
    mov word ptr [bp+2], 0
@loaded:

    mov ax, [offset err_no]  (* Take this number back to the handler *)
    pop bp
    retf
  end
end;

procedure raise_current;
begin
  raise(err_no)
end;

procedure std_err; far;
begin
  if {$IFDEF singlestack} (cur_ex <> 0) {$ELSE} (cur_ex <> nil) {$ENDIF}
      and (exitcode <> 0) then
    begin
      exitproc := @std_err;  (* Keep on calling exception handlers ... *)
      raise(exitcode)
    end;
  exitproc := exitsave
end;

(* This is never, Ever, EVER meant to be called by the user. *)
(* It is an extension for the overlay manager ONLY!!!        *)
{$IFDEF singlestack}
procedure patch_xstack; near; assembler;
asm
         PUSH BP
         MOV BX, TEXCEPTION[OFFSET CUR_EX].LINK
         JMP @TEST
  @WALK: SEGSS CMP DX, TEXCEPTION[BX]._CS
         JNE @NEXT
         SEGSS MOV  TEXCEPTION[BX]._CS, AX
  @NEXT: SEGSS MOV BX, TEXCEPTION[BX].LINK
  @TEST: TEST BX, BX
         JNZ @WALK
         PUSH CX
         DB $EA
@RETOFS: DW 0000, SEG OVRINIT
end;
{$ELSE}
procedure patch_xstack; near; assembler;
asm
         PUSH BP
         PUSH CX
         PUSH DS
         LDS BX, TEXCEPTION[OFFSET CUR_EX].LINK
         JMP @TEST
  @WALK: CMP DX, TEXCEPTION[BX]._CS
         JNE @NEXT
         MOV TEXCEPTION[BX]._CS, AX
  @NEXT: LDS BX, TEXCEPTION[BX].LINK
  @TEST: MOV CX, DS
         OR CX, BX
         JNZ @WALK
         POP DS
         DB $EA
@RETOFS: DW 0000, SEG OVRINIT
end;
{$ENDIF}

procedure XOvrInit(filename: string);
begin
  overlay.OvrInit(filename);
  if OvrResult = ovrOK then
    asm
      MOV AX, $353F
      INT $21
      LEA DI, [BX+$22C]
      CLD
      MOV AL, $EA
      STOSB
      MOV AX, OFFSET PATCH_XSTACK
      STOSW
      MOV AX, CS
      STOSW
      ADD DI, 7
      SEGCS MOV [RETOFS+OFFSET PATCH_XSTACK], DI
    end
end;

procedure install_std_err;
begin
  exitsave := exitproc;
  exitproc := @std_err
end;

end.

 

Re:Exception handlers - revisited


Hi Chris!

CR> A few days ago, Jasper Neumann posted a wonderful little
CR> exception-handler unit on the network; the only drawback was
CR> that it didn't support overlays. Well, now it does...
Thanks a lot!
I just had no time to do it myself.

CR> { N.B. Since the exception structure is entirely stack based and there is
CR> {      only 1 stack segment in TP, can the LINK element be replaced by a
CR> {      word rather than a pointer?
CR> {      And similarly only SP needs to be saved, rather than SS:SP?
CR> {      This option is provided by $DEFINE singlestack.
Of course this could be done, but I wanted to be open for enhancements like
coroutines, and tracing the exception stack with the de{*word*81} would be more
work.  Last (but not least) the pushed stack segment could (and should) be
checked during the raise to avoid crashes when local variables overwrote the
exception block or when the command end_exception was misplaced (possibly
forgotten, doubly placed or by using goto, exit, continue or break).
Nevertheless I should have commented on that.  Sorry.

Greetinx Jane

Other Threads