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

+ all debug in ifdef SYSTEMDEBUG

Browse Source 
+ added local arrays :
    opennames names of opened files
    fileopen boolean array to know if still open
    usefull with gdb if you get problems about too
    many open files !!
This commit is contained in:
pierre 1998-06-26 08:19:08 +00:00
parent 4ac8e5d18f
commit 3c0657acf2
2 changed files with 48 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -674,7 +674,7 @@ procedure djgpp_exception_toggle;
local_ex : boolean; local_ex : boolean;
begin begin
{$ifdef DEBUG} {$ifdef SYSTEMDEBUG}
if exceptions_on then if exceptions_on then
begin begin
errln('Disabling FPK exceptions'); errln('Disabling FPK exceptions');
@ -683,7 +683,7 @@ procedure djgpp_exception_toggle;
begin begin
errln('Enabling FPK exceptions'); errln('Enabling FPK exceptions');
end; end;
{$endif DEBUG} {$endif SYSTEMDEBUG}
{ toggle here to avoid infinite recursion } { toggle here to avoid infinite recursion }
{ if a subfunction calls runerror !! } { if a subfunction calls runerror !! }
exceptions_on:= not exceptions_on; exceptions_on:= not exceptions_on;
@ -724,22 +724,22 @@ procedure djgpp_exception_toggle;
set_rm_interrupt(cbrk_vect,cbrk_ori); set_rm_interrupt(cbrk_vect,cbrk_ori);
free_rm_callback(cbrk_rmcb); free_rm_callback(cbrk_rmcb);
cbrk_hooked := false; cbrk_hooked := false;
{$ifdef DEBUG} {$ifdef SYSTEMDEBUG}
errln('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 SYSTEMDEBUG}
end end
else else
begin begin
get_rm_interrupt(cbrk_vect, cbrk_ori); get_rm_interrupt(cbrk_vect, cbrk_ori);
{$ifdef DEBUG} {$ifdef SYSTEMDEBUG}
errln('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 SYSTEMDEBUG}
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 SYSTEMDEBUG}
errln('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 SYSTEMDEBUG}
cbrk_hooked := true; cbrk_hooked := true;
end; end;
{$endif UseRMcbrk} {$endif UseRMcbrk}
@ -939,7 +939,15 @@ djgpp_exception_setup;
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-05-31 14:18:23 peter Revision 1.4 1998-06-26 08:19:08 pierre
+ all debug in ifdef SYSTEMDEBUG
+ added local arrays :
opennames names of opened files
fileopen boolean array to know if still open
usefull with gdb if you get problems about too
many open files !!
Revision 1.3 1998/05/31 14:18:23 peter
* force att or direct assembling * force att or direct assembling
* cleanup of some files * cleanup of some files

32
rtl/dos/go32v2/system.pp
View File

@ -570,12 +570,26 @@ begin
if p[i]='/' then p[i]:='\'; if p[i]='/' then p[i]:='\';
end; end;
{$ifdef SYSTEMDEBUG}
{ Keep Track of open files }
const
max_files = 50;
var
opennames : array [0..max_files-1] of pchar;
openfiles : array [0..max_files-1] of boolean;
{$endif SYSTEMDEBUG}
procedure do_close(handle : longint); procedure do_close(handle : longint);
var var
regs : trealregs; regs : trealregs;
begin begin
regs.realebx:=handle; regs.realebx:=handle;
{$ifdef SYSTEMDEBUG}
if handle<max_files then
openfiles[handle]:=false;
{$endif SYSTEMDEBUG}
regs.realeax:=$3e00; regs.realeax:=$3e00;
sysrealintr($21,regs); sysrealintr($21,regs);
end; end;
@ -856,6 +870,14 @@ begin
end end
else else
filerec(f).handle:=regs.realeax; filerec(f).handle:=regs.realeax;
{$ifdef SYSTEMDEBUG}
if regs.realeax<max_files then
begin
openfiles[regs.realeax]:=true;
getmem(opennames[regs.realeax],strlen(p)+1);
opennames[regs.realeax]:=p;
end;
{$endif SYSTEMDEBUG}
{ append mode } { append mode }
if (flags and $10)<>0 then if (flags and $10)<>0 then
begin begin
@ -1028,7 +1050,15 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.7 1998-06-15 15:17:08 daniel Revision 1.8 1998-06-26 08:19:10 pierre
+ all debug in ifdef SYSTEMDEBUG
+ added local arrays :
opennames names of opened files
fileopen boolean array to know if still open
usefull with gdb if you get problems about too
many open files !!
Revision 1.7 1998/06/15 15:17:08 daniel
* RTLLITE conditional added to produce smaller RTL. * RTLLITE conditional added to produce smaller RTL.