Browse Source

* Check ErrorBuf at exit
+ Win32StackTop

pierre 26 years ago
parent
commit
76aa5a6dd3
1 changed files with 35 additions and 11 deletions
  1. 35 11
      rtl/win32/syswin32.pp

+ 35 - 11
rtl/win32/syswin32.pp

@@ -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