paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-11 21:10:46 +01:00
Code Issues Packages Projects Releases Wiki Activity

* exception_level counting was wrong if dpmi_jmp_buf was copied

Browse Source
This commit is contained in:
pierre 1999-01-18 09:14:20 +00:00
parent 6a5776df47
commit b3635d6190
1 changed files with 74 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
rtl/go32v2/dpmiexcp.pp
View File

@ -104,7 +104,6 @@ function djgpp_set_ctrl_c(enable : boolean) : boolean;
{ Other } { Other }
function dpmi_set_coprocessor_emulation(flag : longint) : longint; function dpmi_set_coprocessor_emulation(flag : longint) : longint;
implementation implementation
{$ASMMODE DIRECT} {$ASMMODE DIRECT}
@ -114,6 +113,7 @@ implementation
var var
v2prt0_ds_alias : pointer;external name '___v2prt0_ds_alias'; v2prt0_ds_alias : pointer;external name '___v2prt0_ds_alias';
djgpp_ds_alias : pointer;external name '___djgpp_ds_alias'; djgpp_ds_alias : pointer;external name '___djgpp_ds_alias';
djgpp_exception_state_ptr : pexception_state;external name '___djgpp_exception_state_ptr';
endtext : longint;external name '_etext'; endtext : longint;external name '_etext';
starttext : longint;external name 'start'; starttext : longint;external name 'start';
djgpp_old_kbd : tseginfo;external name '___djgpp_old_kbd'; djgpp_old_kbd : tseginfo;external name '___djgpp_old_kbd';
@ -169,12 +169,31 @@ end;
SetJmp/LongJmp SetJmp/LongJmp
****************************************************************************} ****************************************************************************}
{ function c_setjmp(var rec : dpmi_jmp_buf) : longint;cdecl;[public, alias : '_setjmp']; function c_setjmp(var rec : dpmi_jmp_buf) : longint;[public, alias : '_setjmp'];
begin begin
c_setjmp:=dpmi_setjmp(rec); { here we need to be subtle :
end; } - we need to return with the arg still on the stack
- but we also need to jmp to FPC_setjmp and not to call it
because otherwise the return address is wrong !!
For this we shift the return address down and
duplicate the rec on stack }
asm
movl %ebp,%esp
popl %ebp
subl $8,%esp
movl %eax,(%esp)
movl 8(%esp),%eax
movl %eax,4(%esp)
movl 12(%esp),%eax
movl %eax,8(%esp)
popl %eax
jmp FPC_setjmp
end;
end;
function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;
function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;[alias : 'FPC_setjmp'];
begin begin
asm asm
pushl %edi pushl %edi
@ -224,15 +243,16 @@ begin
end; end;
{procedure c_longjmp(var rec : dpmi_jmp_buf;return_value : longint);cdecl;[public, alias : '_longjmp']; procedure c_longjmp(var rec : dpmi_jmp_buf;return_value : longint);[public, alias : '_longjmp'];
begin begin
dpmi_longjmp(rec,return_value); dpmi_longjmp(rec,return_value);
end; } { never gets here !! so pascal stack convention is no problem }
end;
procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);
procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);[alias : 'FPC_longjmp'];
begin begin
if (@rec=pdpmi_jmp_buf(djgpp_exception_state)) and (exception_level>0) then if (exception_level>0) then
dec(exception_level); dec(exception_level);
asm asm
{ restore compiler shit } { restore compiler shit }
popl %ebp popl %ebp
@ -479,15 +499,21 @@ begin
end; end;
const message_level : byte = 0;
function do_faulting_finish_message : integer; function do_faulting_finish_message : integer;
var var
en : pchar; en : pchar;
signum,i : longint; signum,i : longint;
old_vid : byte; old_vid : byte;
label
simple_exit;
begin begin
inc(message_level);
if message_level>2 then
goto simple_exit;
do_faulting_finish_message:=0; do_faulting_finish_message:=0;
signum:=djgpp_exception_state^.__signum; signum:=djgpp_exception_state_ptr^.__signum;
{ check video mode for original here and reset (not if PC98) */ } { check video mode for original here and reset (not if PC98) */ }
if ((go32_info_block.linear_address_of_primary_screen <> $a0000) and if ((go32_info_block.linear_address_of_primary_screen <> $a0000) and
(farpeekb(dosmemselector, $449) <> old_video_mode)) then (farpeekb(dosmemselector, $449) <> old_video_mode)) then
@ -520,13 +546,13 @@ begin
err('Exception '); err('Exception ');
itox(signum, 2); itox(signum, 2);
err(' at eip='); err(' at eip=');
itox(djgpp_exception_state^.__eip, 8); itox(djgpp_exception_state_ptr^.__eip, 8);
end end
else else
begin begin
write(stderr, 'FPC ',en); write(stderr, 'FPC ',en);
err(' at eip='); err(' at eip=');
itox(djgpp_exception_state^.__eip, 8); itox(djgpp_exception_state_ptr^.__eip, 8);
end; end;
{ Control-C should stop the program also !} { Control-C should stop the program also !}
{if (signum = $79) then {if (signum = $79) then
@ -536,7 +562,7 @@ begin
end;} end;}
if ((signum < EXCEPTIONCOUNT) and (has_error[signum]=1)) then if ((signum < EXCEPTIONCOUNT) and (has_error[signum]=1)) then
begin begin
errorcode := djgpp_exception_state^.__sigmask and $ffff; errorcode := djgpp_exception_state_ptr^.__sigmask and $ffff;
if(errorcode<>0) then if(errorcode<>0) then
begin begin
err(', error='); err(', error=');
@ -545,43 +571,48 @@ begin
end; end;
errln(''); errln('');
err('eax='); err('eax=');
itox(djgpp_exception_state^.__eax, 8); itox(djgpp_exception_state_ptr^.__eax, 8);
err(' ebx='); itox(djgpp_exception_state^.__ebx, 8); err(' ebx='); itox(djgpp_exception_state_ptr^.__ebx, 8);
err(' ecx='); itox(djgpp_exception_state^.__ecx, 8); err(' ecx='); itox(djgpp_exception_state_ptr^.__ecx, 8);
err(' edx='); itox(djgpp_exception_state^.__edx, 8); err(' edx='); itox(djgpp_exception_state_ptr^.__edx, 8);
err(' esi='); itox(djgpp_exception_state^.__esi, 8); err(' esi='); itox(djgpp_exception_state_ptr^.__esi, 8);
err(' edi='); itox(djgpp_exception_state^.__edi, 8); err(' edi='); itox(djgpp_exception_state_ptr^.__edi, 8);
errln(''); errln('');
err('ebp='); itox(djgpp_exception_state^.__ebp, 8); err('ebp='); itox(djgpp_exception_state_ptr^.__ebp, 8);
err(' esp='); itox(djgpp_exception_state^.__esp, 8); err(' esp='); itox(djgpp_exception_state_ptr^.__esp, 8);
err(' program='); err(' program=');
errln(paramstr(0)); errln(paramstr(0));
dump_selector('cs', djgpp_exception_state^.__cs); dump_selector('cs', djgpp_exception_state_ptr^.__cs);
dump_selector('ds', djgpp_exception_state^.__ds); dump_selector('ds', djgpp_exception_state_ptr^.__ds);
dump_selector('es', djgpp_exception_state^.__es); dump_selector('es', djgpp_exception_state_ptr^.__es);
dump_selector('fs', djgpp_exception_state^.__fs); dump_selector('fs', djgpp_exception_state_ptr^.__fs);
dump_selector('gs', djgpp_exception_state^.__gs); dump_selector('gs', djgpp_exception_state_ptr^.__gs);
dump_selector('ss', djgpp_exception_state^.__ss); dump_selector('ss', djgpp_exception_state_ptr^.__ss);
errln(''); errln('');
if (djgpp_exception_state^.__cs = get_cs) then if (djgpp_exception_state_ptr^.__cs = get_cs) then
show_call_frame(djgpp_exception_state) show_call_frame(djgpp_exception_state_ptr)
{$ifdef SYSTEMDEBUG} {$ifdef SYSTEMDEBUG}
else else
errln('Exception occured in another context'); errln('Exception occured in another context');
{$endif def SYSTEMDEBUG} {$endif def SYSTEMDEBUG}
; ;
if assigned(djgpp_exception_state^.__exception_ptr) then if assigned(djgpp_exception_state_ptr^.__exception_ptr) then
if (djgpp_exception_state^.__exception_ptr^.__cs = get_cs) then if (djgpp_exception_state_ptr^.__exception_ptr^.__cs = get_cs) then
begin begin
Errln('First exception level stack'); Errln('First exception level stack');
show_call_frame(djgpp_exception_state^.__exception_ptr); show_call_frame(djgpp_exception_state_ptr^.__exception_ptr);
end end
{$ifdef SYSTEMDEBUG} {$ifdef SYSTEMDEBUG}
else else
errln('First exception occured in another context'); begin
errln('First exception occured in another context');
djgpp_exception_state_ptr:=djgpp_exception_state_ptr^.__exception_ptr;
do_faulting_finish_message();
end;
{$endif def SYSTEMDEBUG} {$endif def SYSTEMDEBUG}
; ;
{ must not return !! } { must not return !! }
simple_exit:
if exceptions_on then if exceptions_on then
djgpp_exception_toggle; djgpp_exception_toggle;
asm asm
@ -601,20 +632,20 @@ procedure djgpp_exception_processor;[public,alias : '___djgpp_exception_processo
var var
sig : longint; sig : longint;
begin begin
if not assigned(djgpp_exception_state^.__exception_ptr) then if not assigned(djgpp_exception_state_ptr^.__exception_ptr) then
exception_level:=1 exception_level:=1
else else
inc(exception_level); inc(exception_level);
sig:=djgpp_exception_state^.__signum; sig:=djgpp_exception_state_ptr^.__signum;
if (exception_level=1) or (sig=$78) then if (exception_level=1) or (sig=$78) then
begin begin
sig := except_to_sig(sig); sig := except_to_sig(sig);
_raise(sig); _raise(sig);
if (djgpp_exception_state^.__signum >= EXCEPTIONCOUNT) then if (djgpp_exception_state_ptr^.__signum >= EXCEPTIONCOUNT) then
{ Not exception so continue OK } { Not exception so continue OK }
dpmi_longjmp(pdpmi_jmp_buf(djgpp_exception_state)^, djgpp_exception_state^.__eax); dpmi_longjmp(pdpmi_jmp_buf(djgpp_exception_state_ptr)^, djgpp_exception_state_ptr^.__eax);
{ User handler did not exit or longjmp, we must exit } { User handler did not exit or longjmp, we must exit }
err('FPC cannot continue from exception, exiting due to signal '); err('FPC cannot continue from exception, exiting due to signal ');
itox(sig, 4); itox(sig, 4);
@ -876,7 +907,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.2 1998-12-21 14:23:12 pierre Revision 1.3 1999-01-18 09:14:20 pierre
* exception_level counting was wrong if dpmi_jmp_buf was copied
Revision 1.2 1998/12/21 14:23:12 pierre
dpmiexcp.pp dpmiexcp.pp
Revision 1.1 1998/12/21 13:07:02 peter Revision 1.1 1998/12/21 13:07:02 peter