paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 20:19:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ debug info better output

Browse Source 
no normal code changed
This commit is contained in:
pierre 1998-04-21 14:46:33 +00:00
parent 945ce76534
commit 04f1d1e292
1 changed files with 44 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
rtl/dos/go32v2/dpmiexcp.pp
View File

@ -20,12 +20,13 @@ Unit DPMIEXCP;
{ Real mode control-C check removed { Real mode control-C check removed
because I got problems with the RMCB because I got problems with the RMCB
can be used by setting this conditionnal } can be used by setting this conditionnal (PM) }
{ works now correctly (PM) }
{$define UseRMcbrk} {$define UseRMcbrk}
interface interface
uses go32{,sysutils}; uses go32;
{$S- no stack check !!! } {$S- no stack check !!! }
{$packrecords 2 } {$packrecords 2 }
@ -168,7 +169,7 @@ end;
#include <sys/nearptr.h> /* For DS base/limit info */ #include <sys/nearptr.h> /* For DS base/limit info */
#include <libc/internal.h> } #include <libc/internal.h> }
const newline = #13#10; { const newline = #13#10; }
procedure err(x : string); procedure err(x : string);
begin begin
@ -176,6 +177,12 @@ begin
flush(stderr); flush(stderr);
end; end;
procedure errln(x : string);
begin
writeln(stderr, x);
flush(stderr);
end;
{ extern unsigned end __asm__ ('end'); } { extern unsigned end __asm__ ('end'); }
const cbrk_vect : byte = $1b; const cbrk_vect : byte = $1b;
{ /* May be $06 for PC98 */ } { /* May be $06 for PC98 */ }
@ -194,8 +201,7 @@ procedure itox(v,len : longint);
var st : string; var st : string;
begin begin
st:=hexstr(v,len); st:=hexstr(v,len);
write(stderr,st); err(st);
flush(stderr);
end; end;
function except_to_sig(excep : longint) : longint; function except_to_sig(excep : longint) : longint;
@ -230,8 +236,8 @@ function except_to_sig(excep : longint) : longint;
procedure show_call_frame; procedure show_call_frame;
begin begin
err('Call frame traceback EIPs:'+newline); errln('Call frame traceback EIPs:');
err(' 0x'+hexstr(djgpp_exception_state^.__eip, 8)+newline); errln(' 0x'+hexstr(djgpp_exception_state^.__eip, 8));
dump_stack(djgpp_exception_state^.__ebp); dump_stack(djgpp_exception_state^.__ebp);
end; end;
@ -266,7 +272,7 @@ const
procedure dump_selector(const name : string; sel : word); procedure dump_selector(const name : string; sel : word);
var base,limit : longint; var base,limit : longint;
begin begin
write(stderr, name); err(name);
err(': sel='); err(': sel=');
itox(sel, 4); itox(sel, 4);
if (sel<>0) then if (sel<>0) then
@ -282,7 +288,7 @@ procedure dump_selector(const name : string; sel : word);
limit:=get_segment_limit(sel); limit:=get_segment_limit(sel);
err(' limit='); itox(limit, 8); err(' limit='); itox(limit, 8);
end; end;
err(newline); errln('');
end; end;
function farpeekb(sel : word;offset : longint) : byte; function farpeekb(sel : word;offset : longint) : byte;
@ -341,7 +347,7 @@ function do_faulting_finish_message : integer;
{ Control-C should stop the program also !} { Control-C should stop the program also !}
{if (signum = $79) then {if (signum = $79) then
begin begin
err(newline); errln('');
exit(-1); exit(-1);
end;} end;}
if ((signum < EXCEPTIONCOUNT) and (has_error[signum]=1)) then if ((signum < EXCEPTIONCOUNT) and (has_error[signum]=1)) then
@ -353,7 +359,7 @@ function do_faulting_finish_message : integer;
itox(errorcode, 4); itox(errorcode, 4);
end; end;
end; end;
err(newline); errln('');
err('eax='); err('eax=');
itox(djgpp_exception_state^.__eax, 8); itox(djgpp_exception_state^.__eax, 8);
err(' ebx='); itox(djgpp_exception_state^.__ebx, 8); err(' ebx='); itox(djgpp_exception_state^.__ebx, 8);
@ -361,18 +367,18 @@ function do_faulting_finish_message : integer;
err(' edx='); itox(djgpp_exception_state^.__edx, 8); err(' edx='); itox(djgpp_exception_state^.__edx, 8);
err(' esi='); itox(djgpp_exception_state^.__esi, 8); err(' esi='); itox(djgpp_exception_state^.__esi, 8);
err(' edi='); itox(djgpp_exception_state^.__edi, 8); err(' edi='); itox(djgpp_exception_state^.__edi, 8);
err(newline); errln('');
err('ebp='); itox(djgpp_exception_state^.__ebp, 8); err('ebp='); itox(djgpp_exception_state^.__ebp, 8);
err(' esp='); itox(djgpp_exception_state^.__esp, 8); err(' esp='); itox(djgpp_exception_state^.__esp, 8);
err(' program='); err(' program=');
err(paramstr(0)+newline); errln(paramstr(0));
dump_selector('cs', djgpp_exception_state^.__cs); dump_selector('cs', djgpp_exception_state^.__cs);
dump_selector('ds', djgpp_exception_state^.__ds); dump_selector('ds', djgpp_exception_state^.__ds);
dump_selector('es', djgpp_exception_state^.__es); dump_selector('es', djgpp_exception_state^.__es);
dump_selector('fs', djgpp_exception_state^.__fs); dump_selector('fs', djgpp_exception_state^.__fs);
dump_selector('gs', djgpp_exception_state^.__gs); dump_selector('gs', djgpp_exception_state^.__gs);
dump_selector('ss', djgpp_exception_state^.__ss); dump_selector('ss', djgpp_exception_state^.__ss);
err(newline); errln('');
if (djgpp_exception_state^.__cs = get_cs) then if (djgpp_exception_state^.__cs = get_cs) then
show_call_frame; show_call_frame;
{ must not return !! } { must not return !! }
@ -444,14 +450,14 @@ function _raise(sig : longint) : longint;
err('Exiting due to signal $'); err('Exiting due to signal $');
itox(sig, 4); itox(sig, 4);
end; end;
err(newline); errln('');
{ if(djgpp_exception_state<>nil) then } { if(djgpp_exception_state<>nil) then }
do_faulting_finish_message(); {/* Exits, does not return */ } do_faulting_finish_message(); {/* Exits, does not return */ }
exit(-1); exit(-1);
end; end;
if ((longint(temp) < longint(starttext)) or (longint(temp) > longint(endtext))) then if ((longint(temp) < longint(starttext)) or (longint(temp) > longint(endtext))) then
begin begin
err('Bad signal handler, '); errln('Bad signal handler, ');
goto traceback_exit; goto traceback_exit;
end; end;
temp(sig); temp(sig);
@ -613,13 +619,13 @@ const exception_level : longint = 0;
{/* User handler did not exit or longjmp, we must exit */} {/* User handler did not exit or longjmp, we must exit */}
err('FPK cannot continue from exception, exiting due to signal '); err('FPK cannot continue from exception, exiting due to signal ');
itox(sig, 4); itox(sig, 4);
err(newline); errln('');
end end
else else
begin begin
if exception_level>2 then if exception_level>2 then
begin begin
err('FPK triple exception, exiting !!! '); errln('FPK triple exception, exiting !!! ');
if (exceptions_on) then if (exceptions_on) then
djgpp_exception_toggle; djgpp_exception_toggle;
asm asm
@ -629,7 +635,7 @@ const exception_level : longint = 0;
end; end;
err('FPK double exception, exiting due to signal '); err('FPK double exception, exiting due to signal ');
itox(sig, 4); itox(sig, 4);
err(newline); errln('');
end; end;
do_faulting_finish_message; do_faulting_finish_message;
end; end;
@ -669,13 +675,11 @@ procedure djgpp_exception_toggle;
{$ifdef DEBUG} {$ifdef DEBUG}
if exceptions_on then if exceptions_on then
begin begin
err('Disabling FPK exceptions'); errln('Disabling FPK exceptions');
err(newline);
end end
else else
begin begin
err('Enabling FPK exceptions'); errln('Enabling FPK exceptions');
err(newline);
end; end;
{$endif DEBUG} {$endif DEBUG}
{ toggle here to avoid infinite recursion } { toggle here to avoid infinite recursion }
@ -692,7 +696,7 @@ procedure djgpp_exception_toggle;
begin begin
if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then
if not set_pm_exception_handler(i,except_ori[i]) then if not set_pm_exception_handler(i,except_ori[i]) then
err('error setting exception nø'+hexstr(i,2)); errln('error setting exception nø'+hexstr(i,2));
except_ori[i] := _except; except_ori[i] := _except;
end end
else else
@ -701,7 +705,7 @@ procedure djgpp_exception_toggle;
begin begin
if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then
if not set_exception_handler(i,except_ori[i]) then if not set_exception_handler(i,except_ori[i]) then
err('error setting exception nø'+hexstr(i,2)); errln('error setting exception nø'+hexstr(i,2));
except_ori[i] := _except; except_ori[i] := _except;
end end
end; end;
@ -719,7 +723,7 @@ procedure djgpp_exception_toggle;
free_rm_callback(cbrk_rmcb); free_rm_callback(cbrk_rmcb);
cbrk_hooked := false; cbrk_hooked := false;
{$ifdef DEBUG} {$ifdef DEBUG}
err('back to ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4)); errln('back to ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
{$endif DEBUG} {$endif DEBUG}
end end
@ -727,12 +731,12 @@ procedure djgpp_exception_toggle;
begin begin
get_rm_interrupt(cbrk_vect, cbrk_ori); get_rm_interrupt(cbrk_vect, cbrk_ori);
{$ifdef DEBUG} {$ifdef DEBUG}
err('ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4)); errln('ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
{$endif DEBUG} {$endif DEBUG}
get_rm_callback(djgpp_cbrk_hdlr, cbrk_regs, cbrk_rmcb); get_rm_callback(djgpp_cbrk_hdlr, cbrk_regs, cbrk_rmcb);
set_rm_interrupt(cbrk_vect, cbrk_rmcb); set_rm_interrupt(cbrk_vect, cbrk_rmcb);
{$ifdef DEBUG} {$ifdef DEBUG}
err('now rm cbrk '+hexstr(cbrk_rmcb.segment,4)+':'+hexstr(longint(cbrk_rmcb.offset),4)); errln('now rm cbrk '+hexstr(cbrk_rmcb.segment,4)+':'+hexstr(longint(cbrk_rmcb.offset),4));
{$endif DEBUG} {$endif DEBUG}
cbrk_hooked := true; cbrk_hooked := true;
end; end;
@ -933,8 +937,12 @@ djgpp_exception_setup;
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-03-25 11:18:42 root Revision 1.2 1998-04-21 14:46:33 pierre
Initial revision + debug info better output
no normal code changed
Revision 1.1.1.1 1998/03/25 11:18:42 root
* Restored version
Revision 1.9 1998/03/18 15:34:46 pierre Revision 1.9 1998/03/18 15:34:46 pierre
+ fpu state is restaured in excep_exit + fpu state is restaured in excep_exit
@ -963,8 +971,12 @@ end.
{ {
$Log$ $Log$
Revision 1.1 1998-03-25 11:18:42 root Revision 1.2 1998-04-21 14:46:33 pierre
Initial revision + debug info better output
no normal code changed
Revision 1.1.1.1 1998/03/25 11:18:42 root
* Restored version
Revision 1.9 1998/03/18 15:34:46 pierre Revision 1.9 1998/03/18 15:34:46 pierre
+ fpu state is restaured in excep_exit + fpu state is restaured in excep_exit