Пример реализации SEH исключений в стиле TRY .. EXCEPT .. END (из DELPHI) – модуль EXCEP и пример использования - модуль AAAAA. Допускает вложенные исключения.
Наверняка много недостатков, если кто-то улучшит код, не молчите.




MODULE bapiExcep;     (*  07.07.2006    *)
(* exception SEH      *)

IMPORT S:= SYSTEM;


TYPE

PTR_FRM = POINTER TO EXCPFRM;
EXCPFRM = RECORD [untagged]
next : PTR_FRM;
hand : EXCPPRC;
(* расширено *)
code : INTEGER; (* код исключения *)
ebp_ : INTEGER;
eip_ : INTEGER; (* адрес бз.места *)
END;


PTR_REC = POINTER TO EXCPREC;
EXCPREC = RECORD [untagged]
code : INTEGER; (* код исключения *)
flgs : SET;     (* 0 ,1, 2-раскр. *)
nrec : PTR_REC;
addr : INTEGER; (* adr исключения *)
ninf : INTEGER;
info : ARRAY 015 OF INTEGER;
END;

PTR_CON = POINTER TO CONTEXT;
CONTEXT = RECORD [untagged]
flags : SET;
debug : ARRAY 06 OF INTEGER;
float : ARRAY 28 OF INTEGER;

gs,fs : INTEGER;
es,ds : INTEGER;

di,si : INTEGER;
bx,dx : INTEGER;
cx,ax : INTEGER;

bp,ip : INTEGER;
cs,pf : INTEGER;
sp,ss : INTEGER;
END;


EXCPPRC = PROCEDURE(prec : PTR_REC;
pfrm : PTR_FRM;
cont : PTR_CON;
disp : INTEGER):INTEGER;


(* code procedures for exception handling *)

PROCEDURE [code] nullNOP 090H;  (* пустой *)

PROCEDURE [code] PushEAX 050H;
PROCEDURE [code] Pop_EAX 058H;
PROCEDURE [code] PushEDX 052H;
PROCEDURE [code] Pop_EDX 05AH;
PROCEDURE [code] PushEBX 053H;
PROCEDURE [code] Pop_EBX 05BH;

PROCEDURE [code] PushESP 054H;
PROCEDURE [code] Pop_ESP 05CH;
PROCEDURE [code] PushEBP 055H;
PROCEDURE [code] Pop_EBP 05DH;

PROCEDURE [code] PushESI 056H;
PROCEDURE [code] Pop_ESI 05EH;
PROCEDURE [code] PushEDI 057H;
PROCEDURE [code] Pop_EDI 05FH;


PROCEDURE [code] Get_ESP(   ) : INTEGER
089H, 0E0H;            (* mov eax,esp *)
PROCEDURE [code] Put_ESP(_esp : INTEGER)
089H, 0C4H;            (* mov esp,eax *)

PROCEDURE [code] Get_EBP(   ) : INTEGER
089H, 0E8H;            (* mov eax,ebp *)
PROCEDURE [code] Put_EBP(_esp : INTEGER)
089H, 0C5H;            (* mov ebp,eax *)


PROCEDURE [code] GetrADDR(   ) : INTEGER
(* адрес возврата из процедуры   *)
08BH, 045H, 004H;  (* mov eax,[ebp+4]  *)

PROCEDURE [code] SetrADDR(offs : INTEGER)
(* смена адреса возврата         *)
089H, 045H, 004H;  (* mov [ebp+4],eax  *)

PROCEDURE [code] GotoADDR(offs : INTEGER)
(* переход выполнения по адресау       *)
0FFH, 0E0H;        (* jmp eax          *)


PROCEDURE [code] pushEXTD
(* установка exception handling  *)
033H, 0C0H,        (* xor eax,eax      *)
052H,              (* push edx         *)
055H,              (* push ebp         *)
050H;              (* push eax (=0)    *)

PROCEDURE [code] instEXCP(offs : EXCPPRC)
(* установка exception handling  *)
050H,              (* push eax (=offs) *)
033H, 0C0H,        (* xor eax,eax      *)
064H, 0FFH, 030H,  (* push fs:[eax]    *)
064H, 089H, 020H;  (* mov fs:[eax],esp *)

PROCEDURE [code] ret 0C3H; (* ret         *)


PROCEDURE [code] get_PFRM() : PTR_FRM
033H, 0C0H,        (* xor eax,eax      *)
064H, 08BH, 000H;  (* mov eax,fs:[eax] *)



(* pass procedures for exception handling *)

PROCEDURE [noframe] Get_EIP() : INTEGER;
(* на вершине стека адрес возврата =   *)
(* следующей инструкции на выполнение  *)
BEGIN Pop_EAX; PushEAX; ret;    END Get_EIP;


PROCEDURE TRYPROC(prec : PTR_REC;
pfrm : PTR_FRM;
cont : PTR_CON;
disp : INTEGER) : INTEGER;
(* процедура обработки исключения      *)
BEGIN
(* exception нельзя обработать *)
IF prec.flgs = {1} THEN   RETURN  1  END;
(* exception раскрутка стека   *)
IF prec.flgs = {2} THEN   RETURN  2  END;
(* исключeние в исключении   *)
IF prec.code = 111 THEN   RETURN  1  END;

(* exception можно обработать  *)
pfrm.code := prec.code; (* код исключ. *)
cont.ip   := pfrm.eip_; (* safe place  *)
cont.bp   := pfrm.ebp_; (* safe stace  *)
cont.sp   := S.VAL(INTEGER, pfrm       );
(*
cont.sp   := pfrm.esp_; (* safe stace  *)
*)

(* ------------ способ 2  --------------
Put_ESP(S.VAL(INTEGER,pfrm));
Put_EBP( pfrm._ebp);
GotoADDR(pfrm.goto);
-------------------------------------- *)

RETURN 0;
END TRYPROC;



(* excport *)

PROCEDURE [code] get_CODE*() : INTEGER
(* чтение кода исключения                 *)
033H, 0C0H,        (* xor eax,eax      *)
064H, 08BH, 000H,  (* mov eax,fs:[eax] *)
08BH, 040H, 008H;  (* mov eax,[eax+8]  *)


PROCEDURE [ code  ] del_EXCP*()
(*  удаление блока try .. except ..  end  *)
033H, 0C0H,        (* xor eax,eax      *)
05AH,              (* pop edx          *)
064H, 089H, 010H,  (* mov fs:[eax],edx *)
058H,              (* pop eax          *)
058H,              (* pop eax          *)
058H,              (* pop eax          *)
058H;              (* pop eax          *)

PROCEDURE [noframe] set_EXCP*();
(* установка блока try .. except ..  end  *)
BEGIN Pop_EDX;  pushEXTD;  instEXCP( TRYPROC );
PushEDX;  ret;
END set_EXCP;



END bapiExcep.




MODULE aaaaAaaaa;
(* обертка в TRY-EXCEPT     *)

IMPORT bapiExcep, Out;


PROCEDURE xxxx(par1,par2 : INTEGER);
VAR arr : ARRAY 2 OF INTEGER;
BEGIN
bapiExcep.set_EXCP();

IF bapiExcep.get_CODE() = 0 THEN

Out.String('шаг3='); Out.Int(bapiExcep.get_CODE(),10); Out.Ln;
par1 := arr[par2+5];
Out.String('шаг4='); Out.Int(bapiExcep.get_CODE(),10); Out.Ln;
ELSE

Out.String('excp='); Out.Int(bapiExcep.get_CODE(),10); Out.Ln;

END;

bapiExcep.del_EXCP();

par1 := par1 DIV par2;
par1 := arr[par2];

END xxxx;

PROCEDURE TRYTEST*();
BEGIN
bapiExcep.set_EXCP();

IF bapiExcep.get_CODE() = 0 THEN

Out.String('шаг1='); Out.Int(bapiExcep.get_CODE(),10); Out.Ln;
xxxx(1,0);
Out.String('шаг2='); Out.Int(bapiExcep.get_CODE(),10); Out.Ln;

ELSE

Out.String('excp='); Out.Int(bapiExcep.get_CODE(),10); Out.Ln;

END;

bapiExcep.del_EXCP();

Out.Ln;
END TRYTEST;


END aaaaAaaaa.


aaaaAaaaa.TRYTEST