Added a SafeWriteLn()-function to support thread-safe console-output.

This is used in all Log...-Methods now (not for file-output yet).
Don't use WriteLn anymore from external threads (for example in
SDL or Portaudio Callbacks), otherwise FPC will crash.

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@826 b956fd51-792f-4845-bead-9b4dfca2ff2c

1 files changed, 364 insertions, 278 deletions

diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas
index c9c87a92..542fa0b3 100644
--- a/Game/Code/Classes/ULog.pas
+++ b/Game/Code/Classes/ULog.pas
@@ -1,278 +1,364 @@
-unit ULog;
-
-interface
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses Classes;
-
-type
-  TLog = class
-    BenchmarkTimeStart:   array[0..7] of real;
-    BenchmarkTimeLength:  array[0..7] of real;//TDateTime;
-
-    FileBenchmark:    TextFile;
-    FileBenchmarkO:   boolean; // opened
-    FileError:        TextFile;
-    FileErrorO:       boolean; // opened
-
-    Title: String; //Application Title
-
-    //Should Log Files be written
-    Enabled:          Boolean;
-
-    // destuctor
-    destructor Free;
-
-    // benchmark
-    procedure BenchmarkStart(Number: integer);
-    procedure BenchmarkEnd(Number: integer);
-    procedure LogBenchmark(Text: string; Number: integer);
-
-    // error
-    procedure LogError(Text: string); overload;
-
-    //Critical Error (Halt + MessageBox)
-    procedure CriticalError(Text: string);
-
-    // voice
-    procedure LogVoice(SoundNr: integer);
-
-    // compability
-    procedure LogStatus(Log1, Log2: string);
-    procedure LogError(Log1, Log2: string); overload;
-    procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string);
-  end;
-
-var
-  Log:    TLog;
-
-implementation
-
-uses
-     {$IFDEF win32}
-     windows,
-     {$ENDIF}
-     SysUtils,
-     DateUtils,
-//     UFiles,
-     UMain,
-     URecord,
-     UTime,
-//     UIni,  // JB - Seems to not be needed.
-     UCommandLine;
-
-destructor TLog.Free;
-begin
-  if FileBenchmarkO then CloseFile(FileBenchmark);
-//  if FileAnalyzeO then CloseFile(FileAnalyze);
-  if FileErrorO then CloseFile(FileError);
-end;
-
-procedure TLog.BenchmarkStart(Number: integer);
-begin
-  BenchmarkTimeStart[Number] := USTime.GetTime; //Time;
-end;
-
-procedure TLog.BenchmarkEnd(Number: integer);
-begin
-  BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number];
-end;
-
-procedure TLog.LogBenchmark(Text: string; Number: integer);
-var
-  Minutes:      integer;
-  Seconds:      integer;
-  Miliseconds:  integer;
-
-  MinutesS:     string;
-  SecondsS:     string;
-  MilisecondsS: string;
-
-  ValueText:    string;
-begin
-  if Enabled AND (Params.Benchmark) then begin
-    if not FileBenchmarkO then begin
-      FileBenchmarkO := true;
-      AssignFile(FileBenchmark, LogPath + 'Benchmark.log');
-      {$I-}
-      Rewrite(FileBenchmark);
-      if IOResult = 0 then FileBenchmarkO := true;
-      {$I+}
-
-      //If File is opened write Date to Benchmark File
-      If (FileBenchmarkO) then
-      begin
-        WriteLn(FileBenchmark, Title + ' Benchmark File');
-        WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
-        WriteLn(FileBenchmark, '-------------------');
-
-        Flush(FileBenchmark);
-      end;
-    end;
-
-  if FileBenchmarkO then begin
-    Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000);
-    Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60;
-    Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60);
-//    ValueText := FloatToStr(BenchmarkTimeLength[Number]);
-
-{    ValueText := FloatToStr(
-      SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000
-      );
-    if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then
-      ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText;
-    WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');}
-
-    if (Minutes = 0) and (Seconds = 0) then begin
-      MilisecondsS := IntToStr(Miliseconds);
-      ValueText := MilisecondsS + ' miliseconds';
-    end;
-
-    if (Minutes = 0) and (Seconds >= 1) then begin
-      MilisecondsS := IntToStr(Miliseconds);
-      while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS;
-
-      SecondsS := IntToStr(Seconds);
-
-      ValueText := SecondsS + ',' + MilisecondsS + ' seconds';
-    end;
-
-    if Minutes >= 1 then begin
-      MilisecondsS := IntToStr(Miliseconds);
-      while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS;
-
-      SecondsS := IntToStr(Seconds);
-      while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS;
-
-      MinutesS := IntToStr(Minutes);
-
-      ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes';
-    end;
-
-    WriteLn(FileBenchmark, Text + ': ' + ValueText);
-    Flush(FileBenchmark);
-    end;
-  end;
-end;
-
-procedure TLog.LogError(Text: string);
-begin
-  if Enabled AND (not FileErrorO) then begin
-    //FileErrorO := true;
-    AssignFile(FileError, LogPath + 'Error.log');
-    {$I-}
-    Rewrite(FileError);
-    if IOResult = 0 then FileErrorO := true;
-    {$I+}
-
-    //If File is opened write Date to Error File
-    If (FileErrorO) then
-    begin
-      WriteLn(FileError, Title + ' Error Log');
-      WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
-      WriteLn(FileError, '-------------------');
-
-      Flush(FileError);
-    end;
-  end;
-
-  if FileErrorO then begin
-    try
-      WriteLn(FileError, Text);
-      Flush(FileError);
-    except
-      FileErrorO := false;
-    end;
-  end;
-  {$IFDEF DEBUG}
-  WriteLn('Error: ' + Text);
-  {$ENDIF}
-end;
-
-procedure TLog.LogVoice(SoundNr: integer);
-var
-  FileVoice:    File;
-  FS:           TFileStream;
-  FileName:     string;
-  Num:          integer;
-  BL:           integer;
-begin
-  for Num := 1 to 9999 do begin
-    FileName := IntToStr(Num);
-    while Length(FileName) < 4 do FileName := '0' + FileName;
-    FileName := LogPath + 'Voice' + FileName + '.raw';
-    if not FileExists(FileName) then break
-  end;
-
-
-  FS := TFileStream.Create(FileName, fmCreate);
-
-  for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin
-    AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning);
-    FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size);
-  end;
-
-  FS.Free;
-end;
-
-procedure TLog.LogStatus(Log1, Log2: string);
-begin
-  //Just for Debugging
-  //Comment for Release    
-  //LogError(Log2 + ': ' + Log1);
-
-  //If Debug => Write to Console Output
-  {$IFDEF DEBUG}
-//   WriteLn(Log2 + ': ' + Log1);
-  {$ENDIF}
-end;
-
-procedure TLog.LogError(Log1, Log2: string);
-begin
-  LogError(Log1 + ' ['+Log2+']');
-end;
-
-procedure TLog.CriticalError(Text: string);
-begin
-  //Write Error to Logfile:
-  LogError (Text);
-
-  {$IFDEF MSWINDOWS}
-  //Show Errormessage
-  Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK);
-  {$ELSE}
-  // TODO - JB_Linux handle critical error so user can see message.
-  writeln( 'Critical ERROR :' );
-  writeln( Text );
-  {$ENDIF}
-
-  //Exit Application
-  Halt;
-end;
-
-procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string);
-var
-  f : TFileStream;
-begin
-  f := nil;
-
-  try
-    f := TFileStream.Create( filename, fmCreate);
-    f.Write( buf^, bufLength);
-    f.Free;
-  except
-    on e : Exception do begin
-      Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message);
-      f.Free;
-    end;
-  end;
-end;
-
-end.
-
-
+unit ULog;

+

+interface

+

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+{$I switches.inc}

+

+uses

+  Classes;

+

+type

+  TLog = class

+  public

+    BenchmarkTimeStart:   array[0..7] of real;

+    BenchmarkTimeLength:  array[0..7] of real;//TDateTime;

+

+    FileBenchmark:    TextFile;

+    FileBenchmarkO:   boolean; // opened

+    FileError:        TextFile;

+    FileErrorO:       boolean; // opened

+

+    Title: String; //Application Title

+

+    //Should Log Files be written

+    Enabled:          Boolean;

+

+    constructor Create;

+

+    // destuctor

+    destructor Destroy; override;

+

+    // benchmark

+    procedure BenchmarkStart(Number: integer);

+    procedure BenchmarkEnd(Number: integer);

+    procedure LogBenchmark(Text: string; Number: integer);

+

+    // error

+    procedure LogError(Text: string); overload;

+

+    //Critical Error (Halt + MessageBox)

+    procedure CriticalError(Text: string);

+

+    // voice

+    procedure LogVoice(SoundNr: integer);

+

+    // compability

+    procedure LogStatus(Log1, Log2: string);

+    procedure LogError(Log1, Log2: string); overload;

+    procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string);

+  end;

+

+procedure SafeWriteLn(const msg: string); inline;

+

+var

+  Log:    TLog;

+

+implementation

+

+uses

+  {$IFDEF win32}

+  windows,

+  {$ENDIF}

+  SysUtils,

+  DateUtils,

+//UFiles,

+  UMain,

+  URecord,

+  UTime,

+//UIni,  // JB - Seems to not be needed.

+  {$IFDEF FPC}

+  sdl,

+  {$ENDIF}

+  UCommandLine;

+

+{$IFDEF FPC}

+var

+  MessageList: TStringList;

+  ConsoleHandler: TThreadID;

+  ConsoleMutex: PSDL_Mutex;

+  ConsoleCond: PSDL_Cond;

+{$ENDIF}

+

+{$IFDEF FPC}

+{*

+ * The console-handlers main-function.

+ * TODO: create a quit-event on closing.

+ *}

+function ConsoleHandlerFunc(param: pointer): PtrInt;

+var

+  i: integer;

+begin

+  while true do

+  begin

+    SDL_mutexP(ConsoleMutex);

+    while (MessageList.Count = 0) do

+      SDL_CondWait(ConsoleCond, ConsoleMutex);

+    for i := 0 to MessageList.Count-1 do

+    begin

+      WriteLn(MessageList[i]);

+    end;

+    MessageList.Clear();

+    SDL_mutexV(ConsoleMutex);

+  end;

+  result := 0;

+end;

+{$ENDIF}

+

+{*

+ * With FPC console output is not thread-safe.

+ * Using WriteLn() from external threads (like in SDL callbacks)

+ *  will damage the heap and crash the program.

+ * Most probably FPC uses thread-local-data (TLS) to lock a mutex on

+ *  the console-buffer. This does not work with external lib's threads

+ *  because these do not have the TLS data and so it crashes while

+ *  accessing unallocated memory.

+ * The solution is to create an FPC-managed thread which has the TLS data

+ *  and use it to handle the console-output (hence it is called Console-Handler)

+ * It should be safe to do so, but maybe FPC requires the main-thread to access

+ *  the console-buffer only. In this case output should be delegated to it.

+ *

+ * TODO: - check if it is safe if an FPC-managed thread different than the

+ *           main-thread accesses the console-buffer in FPC. 

+ *       - check if Delphi's WriteLn is thread-safe.

+ *       - check if we need to synchronize file-output too

+ *       - Use TEvent and TCriticalSection instead of the SDL equivalents.

+ *           Note: If those two objects use TLS they might crash FPC too.

+ *}

+procedure SafeWriteLn(const msg: string);

+begin

+{$IFDEF FPC}

+  SDL_mutexP(ConsoleMutex);

+  MessageList.Add(msg);

+  SDL_CondSignal(ConsoleCond);

+  SDL_mutexV(ConsoleMutex);

+{$ELSE}

+  WriteLn(msg);

+{$ENDIF}

+end;

+

+constructor TLog.Create;

+begin

+{$IFDEF FPC}

+  // TODO: check for the main-thread?

+  //GetCurrentThreadThreadId();

+  MessageList := TStringList.Create();

+  ConsoleMutex := SDL_CreateMutex();

+  ConsoleCond := SDL_CreateCond();

+  ConsoleHandler := BeginThread(@ConsoleHandlerFunc);

+{$ENDIF}

+end;

+

+destructor TLog.Destroy;

+begin

+  if FileBenchmarkO then CloseFile(FileBenchmark);

+//  if FileAnalyzeO then CloseFile(FileAnalyze);

+  if FileErrorO then CloseFile(FileError);

+end;

+

+procedure TLog.BenchmarkStart(Number: integer);

+begin

+  BenchmarkTimeStart[Number] := USTime.GetTime; //Time;

+end;

+

+procedure TLog.BenchmarkEnd(Number: integer);

+begin

+  BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number];

+end;

+

+procedure TLog.LogBenchmark(Text: string; Number: integer);

+var

+  Minutes:      integer;

+  Seconds:      integer;

+  Miliseconds:  integer;

+

+  MinutesS:     string;

+  SecondsS:     string;

+  MilisecondsS: string;

+

+  ValueText:    string;

+begin

+  if Enabled AND (Params.Benchmark) then begin

+    if not FileBenchmarkO then begin

+      FileBenchmarkO := true;

+      AssignFile(FileBenchmark, LogPath + 'Benchmark.log');

+      {$I-}

+      Rewrite(FileBenchmark);

+      if IOResult = 0 then FileBenchmarkO := true;

+      {$I+}

+

+      //If File is opened write Date to Benchmark File

+      If (FileBenchmarkO) then

+      begin

+        WriteLn(FileBenchmark, Title + ' Benchmark File');

+        WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));

+        WriteLn(FileBenchmark, '-------------------');

+

+        Flush(FileBenchmark);

+      end;

+    end;

+

+  if FileBenchmarkO then begin

+    Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000);

+    Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60;

+    Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60);

+//    ValueText := FloatToStr(BenchmarkTimeLength[Number]);

+

+{    ValueText := FloatToStr(

+      SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000

+      );

+    if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then

+      ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText;

+    WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');}

+

+    if (Minutes = 0) and (Seconds = 0) then begin

+      MilisecondsS := IntToStr(Miliseconds);

+      ValueText := MilisecondsS + ' miliseconds';

+    end;

+

+    if (Minutes = 0) and (Seconds >= 1) then begin

+      MilisecondsS := IntToStr(Miliseconds);

+      while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS;

+

+      SecondsS := IntToStr(Seconds);

+

+      ValueText := SecondsS + ',' + MilisecondsS + ' seconds';

+    end;

+

+    if Minutes >= 1 then begin

+      MilisecondsS := IntToStr(Miliseconds);

+      while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS;

+

+      SecondsS := IntToStr(Seconds);

+      while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS;

+

+      MinutesS := IntToStr(Minutes);

+

+      ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes';

+    end;

+

+    WriteLn(FileBenchmark, Text + ': ' + ValueText);

+    Flush(FileBenchmark);

+    end;

+  end;

+end;

+

+procedure TLog.LogError(Text: string);

+begin

+  if Enabled AND (not FileErrorO) then begin

+    //FileErrorO := true;

+    AssignFile(FileError, LogPath + 'Error.log');

+    {$I-}

+    Rewrite(FileError);

+    if IOResult = 0 then FileErrorO := true;

+    {$I+}

+

+    //If File is opened write Date to Error File

+    If (FileErrorO) then

+    begin

+      WriteLn(FileError, Title + ' Error Log');

+      WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));

+      WriteLn(FileError, '-------------------');

+

+      Flush(FileError);

+    end;

+  end;

+

+  if FileErrorO then begin

+    try

+      WriteLn(FileError, Text);

+      Flush(FileError);

+    except

+      FileErrorO := false;

+    end;

+  end;

+  {$IFDEF DEBUG}

+  SafeWriteLn('Error: ' + Text);

+  {$ENDIF}

+end;

+

+procedure TLog.LogVoice(SoundNr: integer);

+var

+  FileVoice:    File;

+  FS:           TFileStream;

+  FileName:     string;

+  Num:          integer;

+  BL:           integer;

+begin

+  for Num := 1 to 9999 do begin

+    FileName := IntToStr(Num);

+    while Length(FileName) < 4 do FileName := '0' + FileName;

+    FileName := LogPath + 'Voice' + FileName + '.raw';

+    if not FileExists(FileName) then break

+  end;

+

+

+  FS := TFileStream.Create(FileName, fmCreate);

+

+  for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin

+    AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning);

+    FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size);

+  end;

+

+  FS.Free;

+end;

+

+procedure TLog.LogStatus(Log1, Log2: string);

+begin

+  //Just for Debugging

+  //Comment for Release    

+  //LogError(Log2 + ': ' + Log1);

+

+  //If Debug => Write to Console Output

+  {$IFDEF DEBUG}

+  // SafeWriteLn(Log2 + ': ' + Log1);

+  {$ENDIF}

+end;

+

+procedure TLog.LogError(Log1, Log2: string);

+begin

+  LogError(Log1 + ' ['+Log2+']');

+end;

+

+procedure TLog.CriticalError(Text: string);

+begin

+  //Write Error to Logfile:

+  LogError (Text);

+

+  {$IFDEF MSWINDOWS}

+  //Show Errormessage

+  Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK);

+  {$ELSE}

+  // TODO - JB_Linux handle critical error so user can see message.

+  SafeWriteLn( 'Critical ERROR :' );

+  SafeWriteLn( Text );

+  {$ENDIF}

+

+  //Exit Application

+  Halt;

+end;

+

+procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string);

+var

+  f : TFileStream;

+begin

+  f := nil;

+

+  try

+    f := TFileStream.Create( filename, fmCreate);

+    f.Write( buf^, bufLength);

+    f.Free;

+  except

+    on e : Exception do begin

+      Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message);

+      f.Free;

+    end;

+  end;

+end;

+

+end.

+

+