paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 13:06:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some clean up for exceptions in system

Browse Source
This commit is contained in:
pierre 2000-03-10 09:53:17 +00:00
parent d68fb9a6a2
commit bba120a2fd
1 changed files with 44 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
rtl/go32v2/dpmiexcp.pp
View File

@ -13,9 +13,14 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
{$ifndef IN_SYSTEM} {$ifndef IN_SYSTEM}
{$GOTO ON} {$GOTO ON}
{$define IN_DPMIEXCP_UNIT} {$define IN_DPMIEXCP_UNIT}
{$ifndef NO_EXCEPTIONS_IN_SYSTEM}
{ $ define EXCEPTIONS_IN_SYSTEM}
{$endif NO_EXCEPTIONS_IN_SYSTEM}
Unit DpmiExcp; Unit DpmiExcp;
{ If linking to C code we must avoid loading of the dpmiexcp.o { If linking to C code we must avoid loading of the dpmiexcp.o
@ -35,7 +40,11 @@ uses
{$S-} {$S-}
{ Decide if we want to create the C functions or not }
{$ifdef EXCEPTIONS_IN_SYSTEM} {$ifdef EXCEPTIONS_IN_SYSTEM}
{ If exceptions are in system the C functions must be
inserted in the system unit }
{$ifdef IN_DPMIEXCP_UNIT} {$ifdef IN_DPMIEXCP_UNIT}
{$undef CREATE_C_FUNCTIONS} {$undef CREATE_C_FUNCTIONS}
{$else not IN_DPMIEXCP_UNIT} {$else not IN_DPMIEXCP_UNIT}
@ -45,7 +54,7 @@ uses
{$define CREATE_C_FUNCTIONS} {$define CREATE_C_FUNCTIONS}
{$endif not EXCEPTIONS_IN_SYSTEM} {$endif not EXCEPTIONS_IN_SYSTEM}
{ Error Messages } { Error Messages }
function do_faulting_finish_message(fake : boolean) : integer; function do_faulting_finish_message(fake : boolean) : integer;cdecl;
{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM} {$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
{ SetJmp/LongJmp } { SetJmp/LongJmp }
@ -130,14 +139,11 @@ 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;
{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM} {$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
function __djgpp_set_sigint_key(new_key : longint) : longint; function __djgpp_set_sigint_key(new_key : longint) : longint;cdecl;
{$ifdef CREATE_C_FUNCTIONS}cdecl;{$endif CREATE_C_FUNCTIONS}
{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM} {$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
function __djgpp_set_sigquit_key(new_key : longint) : longint; function __djgpp_set_sigquit_key(new_key : longint) : longint;cdecl;
{$ifdef CREATE_C_FUNCTIONS}cdecl;{$endif CREATE_C_FUNCTIONS}
{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM} {$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
function __djgpp__traceback_exit(sig : longint) : longint; function __djgpp__traceback_exit(sig : longint) : longint;cdecl;
{$ifdef CREATE_C_FUNCTIONS}cdecl;{$endif CREATE_C_FUNCTIONS}
{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM} {$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
{$ifndef IN_SYSTEM} {$ifndef IN_SYSTEM}
@ -155,10 +161,12 @@ procedure djgpp_exception_toggle;
external name '___djgpp_exception_toggle'; external name '___djgpp_exception_toggle';
procedure djgpp_exception_setup; procedure djgpp_exception_setup;
external name '___djgpp_exception_setup'; external name '___djgpp_exception_setup';
function __djgpp_set_sigint_key(new_key : longint) : longint; function __djgpp_set_sigint_key(new_key : longint) : longint;cdecl;
external name '___djgpp_set_sigint_key'; external name '___djgpp_set_sigint_key';
function __djgpp_set_sigquit_key(new_key : longint) : longint; function __djgpp_set_sigquit_key(new_key : longint) : longint;cdecl;
external name '___djgpp_set_sigquit_key'; external name '___djgpp_set_sigquit_key';
function __djgpp__traceback_exit(sig : longint) : longint;cdecl;
external name '__djgpp__traceback_exit';
{$endif CREATE_C_FUNCTIONS} {$endif CREATE_C_FUNCTIONS}
var var
v2prt0_ds_alias : word;external name '___v2prt0_ds_alias'; v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
@ -182,6 +190,7 @@ procedure djgpp_kbd_hdlr_pc98;external name '___djgpp_kbd_hdlr_pc98';
procedure djgpp_cbrk_hdlr;external name '___djgpp_cbrk_hdlr'; procedure djgpp_cbrk_hdlr;external name '___djgpp_cbrk_hdlr';
{$ifdef CREATE_C_FUNCTIONS}
var var
exceptions_on : boolean; exceptions_on : boolean;
{ old_int00 : tseginfo;cvar;external; { old_int00 : tseginfo;cvar;external;
@ -190,6 +199,7 @@ var
const const
cbrk_vect : byte = $1b; cbrk_vect : byte = $1b;
exception_level : longint = 0; exception_level : longint = 0;
{$endif CREATE_C_FUNCTIONS}
{$ifndef IN_DPMIEXCP_UNIT} {$ifndef IN_DPMIEXCP_UNIT}
@ -466,6 +476,10 @@ function c_setjmp(var rec : dpmi_jmp_buf) : longint;[public, alias : '_setjmp'];
{$endif CREATE_C_FUNCTIONS} {$endif CREATE_C_FUNCTIONS}
function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint; function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;
{$ifndef CREATE_C_FUNCTIONS}
external name 'FPC_setjmp';
{$else CREATE_C_FUNCTIONS}
[alias : 'FPC_setjmp'];
begin begin
asm asm
pushl %edi pushl %edi
@ -513,6 +527,7 @@ begin
ret $4 not anymore since cdecl !! } ret $4 not anymore since cdecl !! }
end; end;
end; end;
{$endif CREATE_C_FUNCTIONS}
{$ifdef CREATE_C_FUNCTIONS} {$ifdef CREATE_C_FUNCTIONS}
@ -523,7 +538,11 @@ procedure c_longjmp(var rec : dpmi_jmp_buf;return_value : longint);[public, ali
end; end;
{$endif CREATE_C_FUNCTIONS} {$endif CREATE_C_FUNCTIONS}
procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);[alias : 'FPC_longjmp']; procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);
{$ifndef CREATE_C_FUNCTIONS}
external name 'FPC_longjmp';
{$else CREATE_C_FUNCTIONS}
[public, alias : 'FPC_longjmp'];
begin begin
if (exception_level>0) then if (exception_level>0) then
dec(exception_level); dec(exception_level);
@ -573,6 +592,7 @@ begin
iret { actually jump to new cs:eip loading flags } iret { actually jump to new cs:eip loading flags }
end; end;
end; end;
{$endif CREATE_C_FUNCTIONS}
{**************************************************************************** {****************************************************************************
@ -698,6 +718,7 @@ end;
Exceptions Exceptions
****************************************************************************} ****************************************************************************}
{$ifdef CREATE_C_FUNCTIONS}
function except_to_sig(excep : longint) : longint; function except_to_sig(excep : longint) : longint;
begin begin
case excep of case excep of
@ -792,8 +813,13 @@ end;
const message_level : byte = 0; const message_level : byte = 0;
procedure ___exit(c:longint);cdecl;external name '___exit'; procedure ___exit(c:longint);cdecl;external name '___exit';
{$endif CREATE_C_FUNCTIONS}
function do_faulting_finish_message(fake : boolean) : integer; function do_faulting_finish_message(fake : boolean) : integer;cdecl;
{$ifndef CREATE_C_FUNCTIONS}
external;
{$else CREATE_C_FUNCTIONS}
public;
var var
en : pchar; en : pchar;
signum,i : longint; signum,i : longint;
@ -912,7 +938,7 @@ simple_exit:
djgpp_exception_toggle; djgpp_exception_toggle;
___exit(-1); ___exit(-1);
end; end;
{$endif CREATE_C_FUNCTIONS}
function djgpp_exception_state:pexception_state;assembler; function djgpp_exception_state:pexception_state;assembler;
asm asm
@ -963,7 +989,6 @@ begin
end; end;
do_faulting_finish_message(djgpp_exception_state<>nil); do_faulting_finish_message(djgpp_exception_state<>nil);
end; end;
{$endif CREATE_C_FUNCTIONS}
type type
@ -982,7 +1007,6 @@ var
v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on'; v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
{$ifdef CREATE_C_FUNCTIONS}
procedure djgpp_exception_toggle; procedure djgpp_exception_toggle;
[public,alias : '___djgpp_exception_toggle']; [public,alias : '___djgpp_exception_toggle'];
var var
@ -1119,6 +1143,7 @@ var
___djgpp_app_DS : word;external name '___djgpp_app_DS'; ___djgpp_app_DS : word;external name '___djgpp_app_DS';
___djgpp_our_DS : word;external name '___djgpp_our_DS'; ___djgpp_our_DS : word;external name '___djgpp_our_DS';
{$ifdef CREATE_C_FUNCTIONS}
__djgpp_sigint_mask : word;external name '___djgpp_sigint_mask'; __djgpp_sigint_mask : word;external name '___djgpp_sigint_mask';
__djgpp_sigint_key : word;external name '___djgpp_sigint_key'; __djgpp_sigint_key : word;external name '___djgpp_sigint_key';
__djgpp_sigquit_mask : word;external name '___djgpp_sigquit_mask'; __djgpp_sigquit_mask : word;external name '___djgpp_sigquit_mask';
@ -1182,7 +1207,6 @@ function set_signal_key(sig,new_key : longint) : longint;
exit(old_key); exit(old_key);
end; end;
{$ifdef CREATE_C_FUNCTIONS}
function __djgpp_set_sigint_key(new_key : longint) : longint;cdecl; function __djgpp_set_sigint_key(new_key : longint) : longint;cdecl;
begin begin
__djgpp_set_sigint_key:=set_signal_key(SIGINT, new_key); __djgpp_set_sigint_key:=set_signal_key(SIGINT, new_key);
@ -1192,10 +1216,8 @@ function __djgpp_set_sigquit_key(new_key : longint) : longint;cdecl;
begin begin
__djgpp_set_sigquit_key:=set_signal_key(SIGQUIT, new_key); __djgpp_set_sigquit_key:=set_signal_key(SIGQUIT, new_key);
end; end;
{$endif CREATE_C_FUNCTIONS}
function __djgpp__traceback_exit(sig : longint) : longint; function __djgpp__traceback_exit(sig : longint) : longint;cdecl;
{$ifdef CREATE_C_FUNCTIONS}cdecl;{$endif CREATE_C_FUNCTIONS}
var var
fake_exception : texception_state; fake_exception : texception_state;
begin begin
@ -1224,10 +1246,6 @@ begin
___exit(-1); ___exit(-1);
end; end;
{$ifdef CREATE_C_FUNCTIONS}
procedure djgpp_exception_setup; procedure djgpp_exception_setup;
[alias : '___djgpp_exception_setup']; [alias : '___djgpp_exception_setup'];
var var
@ -1408,7 +1426,10 @@ end;
{$endif IN_SYSTEM} {$endif IN_SYSTEM}
{ {
$Log$ $Log$
Revision 1.12 2000-03-09 09:15:10 pierre Revision 1.13 2000-03-10 09:53:17 pierre
* some clean up for exceptions in system
Revision 1.12 2000/03/09 09:15:10 pierre
+ support for djgpp v2.03 (added some new functions that are in v2.03 ofdpmiexcp.c) + support for djgpp v2.03 (added some new functions that are in v2.03 ofdpmiexcp.c)
+ code to integrate exception support inside the system unit + code to integrate exception support inside the system unit