OberonCore

Пример реализации 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