paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 05:00:07 +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;
begin
{$ifdef DEBUG}
{$ifdef SYSTEMDEBUG}
if exceptions_on then
begin
errln('Disabling FPK exceptions');
@ -683,7 +683,7 @@ procedure djgpp_exception_toggle;
begin
errln('Enabling FPK exceptions');
end;
{$endif DEBUG}
{$endif SYSTEMDEBUG}
{ toggle here to avoid infinite recursion }
{ if a subfunction calls runerror !! }
exceptions_on:= not exceptions_on;
@ -724,22 +724,22 @@ procedure djgpp_exception_toggle;
set_rm_interrupt(cbrk_vect,cbrk_ori);
free_rm_callback(cbrk_rmcb);
cbrk_hooked := false;
{$ifdef DEBUG}
{$ifdef SYSTEMDEBUG}
errln('back to ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
{$endif DEBUG}
{$endif SYSTEMDEBUG}
end
else
begin
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));
{$endif DEBUG}
{$endif SYSTEMDEBUG}
get_rm_callback(djgpp_cbrk_hdlr, cbrk_regs, 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));
{$endif DEBUG}
{$endif SYSTEMDEBUG}
cbrk_hooked := true;
end;
{$endif UseRMcbrk}
@ -939,7 +939,15 @@ djgpp_exception_setup;
end.
{
$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
* cleanup of some files

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

@ -570,12 +570,26 @@ begin
if p[i]='/' then p[i]:='\';
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);
var
regs : trealregs;
begin
regs.realebx:=handle;
{$ifdef SYSTEMDEBUG}
if handle<max_files then
openfiles[handle]:=false;
{$endif SYSTEMDEBUG}
regs.realeax:=$3e00;
sysrealintr($21,regs);
end;
@ -856,6 +870,14 @@ begin
end
else
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 }
if (flags and $10)<>0 then
begin
@ -1028,7 +1050,15 @@ Begin
End.
{
$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.