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

* Check ErrorBuf at exit

Browse Source 
+ Win32StackTop
This commit is contained in:
pierre 1999-11-09 22:34:00 +00:00
parent bd7d22c00f
commit 76aa5a6dd3
1 changed files with 35 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
rtl/win32/syswin32.pp
View File

@ -70,6 +70,7 @@ var
cmdshow : longint;
IsLibrary,IsMultiThreaded,IsConsole : boolean;
DLLreason,DLLparam:longint;
Win32StackTop : Dword;
implementation
@ -737,6 +738,12 @@ end;
*****************************************************************************}
Procedure system_exit;
begin
if not IsConsole then
begin
Close(stderr);
Close(stdout);
{ what about Input and Output ?? PM }
end;
end;
{$ifdef dummy}
@ -761,6 +768,7 @@ end;
procedure PascalMain;external name 'PASCALMAIN';
procedure fpc_do_exit;external name 'FPC_DO_EXIT';
var
{ value of the stack segment
to check if the call stack can be written on exceptions }
@ -777,6 +785,8 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
asm
pushl %ebp
xorl %ebp,%ebp
movl %esp,%eax
movl %eax,Win32StackTop
movw %ss,%bp
movl %ebp,_SS
xorl %ebp,%ebp
@ -795,6 +805,8 @@ procedure Dll_entry;[public, alias : '_FPC_DLL_Entry'];
1,2 :
begin
asm
movl %esp,%eax
movl %eax,Win32StackTop
xorl %edi,%edi
movw %ss,%di
movl %edi,_SS
@ -976,8 +988,10 @@ var
function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
external 'user32' name 'MessageBoxA';
const
ErrorBufferLength = 1024;
var
ErrorBuf : array[0..1024] of char;
ErrorBuf : array[0..ErrorBufferLength] of char;
ErrorLen : longint;
Function ErrorWrite(Var F: TextRec): Integer;
@ -990,25 +1004,31 @@ var
Begin
if F.BufPos>0 then
begin
Move(F.BufPtr^,ErrorBuf[ErrorLen],F.BufPos);
inc(ErrorLen,F.BufPos);
if F.BufPos+ErrorLen>ErrorBufferLength then
i:=ErrorBufferLength-ErrorLen
else
i:=F.BufPos;
Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
inc(ErrorLen,i);
ErrorBuf[ErrorLen]:=#0;
end;
if ErrorLen>3 then
begin
p:=@ErrorBuf[ErrorLen];
for i:=1to 4 do
for i:=1 to 4 do
begin
dec(p);
if not(p^ in [#10,#13]) then
break;
end;
if (i=4) then
begin
MessageBox(0,@ErrorBuf,pchar('Error'),0);
ErrorLen:=0;
end;
end;
if ErrorLen=ErrorBufferLength then
i:=4;
if (i=4) then
begin
MessageBox(0,@ErrorBuf,pchar('Error'),0);
ErrorLen:=0;
end;
F.BufPos:=0;
ErrorWrite:=0;
End;
@ -1090,12 +1110,16 @@ begin
{ Reset IO Error }
InOutRes:=0;
{ Reset internal error variable }
errno := 0;
errno:=0;
end.
{
$Log$
Revision 1.47 1999-10-26 12:25:51 peter
Revision 1.48 1999-11-09 22:34:00 pierre
* Check ErrorBuf at exit
+ Win32StackTop
Revision 1.47 1999/10/26 12:25:51 peter
* report stderr,stdout to message box for errors
* close input,output when GUI app is made