aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code
diff options
context:
space:
mode:
authortobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-02-05 17:13:47 +0000
committertobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-02-05 17:13:47 +0000
commit2e6592ceadb3e3c910164c76595e7ae435b8823a (patch)
treebb43d9c43f932b0e1f984c5e6461de0b5e0a3ff1 /Game/Code
parent5df25a794dd5ba29729574560a1622f77f6b7048 (diff)
downloadusdx-2e6592ceadb3e3c910164c76595e7ae435b8823a.tar.gz
usdx-2e6592ceadb3e3c910164c76595e7ae435b8823a.tar.xz
usdx-2e6592ceadb3e3c910164c76595e7ae435b8823a.zip
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
Diffstat (limited to 'Game/Code')
-rw-r--r--Game/Code/Classes/ULog.pas642
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.
+
+