Message logging is a common activity used for either keeping track of what happens in an application or for debugging purpose.
Recently, I was developing a real time communication system which experimented strange errors. To find out what was happening, I decided to log all kind of informations that where available during the execution. After an error, I analyzed the message log and I eventually could determine what the error was.
But this was not so simple, actually. On a real time system, many errors come from that fact that concurrency is not handled correctly. When badly coded, an error may occur when two of more parts of the system (threads or asynchronous operation) are doing something simultaneously. When you introduce a message logging system, you also introduce some perturbation to the actual process and maybe your error goes away simply because the system is slowly writing messages to the log.
To solve this issue, instead of using my good old logging class, I have designed a brand new one. This new logging class stores all messages in pre-allocated memory for faster access. Of course the class also offers the feature of saving the recorded messages in a text file.
The class has been made “thread safe”. It means the methods can be called not only from the thread which created the class instance in the first place, but by any worker thread. The class takes care of writing message in the correct order without inserting a message from one thread in the middle of the message from another thread.
I just said that memory was pre-allocated. Actually this is more complex than that. I created a linked list of “buffers” to store messages. Buffers are of arbitrary size (more on this later). A new buffer is added to the linked list automatically when the current one is filled.
Buffers are removed from the list once they have been written to a file. But instead of freeing the buffer, it is moved to a list of available buffers where it is available when a new buffer is required. So before allocating a new buffer, the available buffer list is checked to reuse an existing buffer, avoiding the memory allocation.
Writing to the file is straightforward. It is done by iterating thru the linked list of buffers, writing each one to the file and then moving the buffer to the available buffer list.
Multithreading safety is achieved by using two critical sections. One protects the linked lists of buffers and the other make sure only one write to file take place at a time.
Usage
You create a variable to hold the class instance. This variable can have any scope but it is likely a global variable so that in can be used from anywhere, including initialization and finalization sections of units.
var
GLog : TInMemoryLogger;
You create the object instance the same way as usual. If you selected a global variable, it is likely you create it from the initialization section of unit. You’ll make sure to put the unit in front of other units in the project source file so that it is initialized the first and makes the logger available for other units.
The code looks like this:
initialization
CompanyFolder := 'OverByte';
GLog := TInMemoryLogger.Create(nil);
GLog.BufferSize := 4096;
GLog.SetDefaultFileName;
GLog.Options := GLog.Options +
[imloAddCRLF, // Add a CRLF at end of each Log()
imloAddDate, // Add a date in front of each log()
imloAddTime, // Add a time in front of each log()
imloAddTimeMSec, // Add millisecond to time
imloFlushOnDestroy]; // Flush to file when destroyed
TInmemoryLogger is actually a component which could be installed and dropped onto a form. Here I use it as a simple class to the constructor takes a nil argument.
The then buffer size is initialized. This is the size in bytes for one buffer which will be part of the linked list. Any size is OK. Selecting a small size forces more allocations (once). Selecting a larger one uses less allocations but make flushing to disk a little bit heavier.
SetDefautFileName assign the filename for flushing the buffer to disk. It builds the file name from the executable file name and put the file in the user profile in Local\AppData branch, in a folder with your company name. Hence the variable “CompanyFolder” used to specify that name. Of course you may also initialize the FileName property with anything you like to store the file exactly where you like.
Finally, there are a number of options which are self-explanatory. Add or remove the options according to your needs and preferences.
Then to use the logger, you just call his Log() method, passing a string:
GLog.Log(‘This is my demo message’);
If you use a global variable and plan to use it from anywhere, it is better to encapsulate the Log method into a global Log procedure which will take care of the variable being created or destroyed. You’ll avoid many access violations if you don’t master initialization/finalization unit order.
procedure Log(const Msg : String);
begin
if Assigned(GLog) then
GLog.Log(Msg);
end;
When doing that, it is better to move the GLog variable to the unit implementation section so that it is not available from anywhere else.
Likely, you’ll create a wrapper procedure to flush the buffers to disk file and for any other access to the class members.
procedure LogFlush;
begin
if Assigned(GLog) then
GLog.FlushToFile;
end;
Implementation
The logger is made of two classes: the first one is TInMemoryLogger we saw the use above, the second is the class used to encapsulate a buffer.
Let’s have a look at TInMemoryChunk, the class encapsulating a buffer. It is quite simple. It is manly build around the memory used for storing data. I use a TBytes data type (Dynamic array of bytes). I also use a variable to store the buffer size, even if this could be derived from the array size because it is faster. Then there is an integer to count how many bytes have already been written to the buffer. Finally there is a reference to the next buffer to make the linked list of buffers.
There is a single method named “Write”. It is used to store a message to the buffer. The message is passed as a string argument. Passed also as a var parameter is the number of bytes actually written to the buffer. The method returns the last buffer used to store the message. A large message could be split into several buffers which are created as needed. The method always returns the last buffer used. The main class uses this returned value to update the linked list head.
As I said in the introduction, buffer are allocated once and not freed when emptied. Instead they are move to a list of available buffers for later reuse. TInMemoryChunk has to acquire a buffer from this available buffer list. The list in maintained by the main class and as such is inaccessible from TInMemoryChunk. The implementation makes use of an event that TInMemoryChunk triggers when a free buffer is required. The main class implements a handler for that event which will get a buffer from the available buffer list, or create a new one if no available buffer exists.
All in all, here is the class declaration:
TInMemoryChunk = class(TObject)
strict private
FBuffer : TBytes;
FBufferSize : Integer;
FBufferNext : TInMemoryChunk;
FWriteCount : Integer;
FOnAcquireChunk : TInMemoryChunkAcquireEvent;
function AcquireChunk : TInMemoryChunk;
public
constructor Create(Size : Integer);
function Write(const Msg : String;
var ByteCount : Integer) : TInMemoryChunk;
property Buffer : TBytes read FBuffer
write FBuffer;
property BufferNext : TInMemoryChunk read FBufferNext
write FBufferNext;
property BufferSize : Integer read FBufferSize
write FBufferSize;
property WriteCount : Integer read FWriteCount
write FWriteCount;
property OnAcquireChunk : TInMemoryChunkAcquireEvent
read FOnAcquireChunk
write FOnAcquireChunk;
end;
You will recognize all the member variables I talked above, as well as their corresponding properties declarations. This is quite canonical and opens the door to easy customization.
Actual implementation code is really straightforward:
constructor TInMemoryChunk.Create(Size: Integer);
begin
if Size < 16 then
raise EInMemoryRangeException.Create(ERROR_MSG_SIZE_TO_LOW);
FWriteCount := 0;
FBufferNext := nil;
FBufferSize := Size;
SetLength(FBuffer, FBufferSize);
end;
function TInMemoryChunk.AcquireChunk: TInMemoryChunk;
begin
Result := nil;
if Assigned(FOnAcquireChunk) then
FOnAcquireChunk(Self, Result);
end;
// Write a msg into the buffer, allocating a new one if required
// Returns the last buffer used (The current one or the new allocated)
function TInMemoryChunk.Write(
const Msg : String;
var ByteCount : Integer) : TInMemoryChunk;
var
I : Integer;
Len : Integer;
AvailBytes : Integer;
NewBuffer : TInMemoryChunk;
begin
Result := Self;
Len := Length(Msg);
if Len <= 0 then
Exit;
AvailBytes := Result.BufferSize - Result.WriteCount;
I := Low(Msg);
while I <= High(Msg) do begin
// Simple and incorrect unicode to ascii conversion
Result.Buffer[Result.WriteCount] := Ord(Msg[I]);
Result.WriteCount := Result.WriteCount + 1;
Inc(I);
Inc(ByteCount);
Dec(AvailBytes);
if AvailBytes <= 0 then begin
// No more room in current buffer, allocate new one
NewBuffer := AcquireChunk; // Get a free chunk
if not Assigned(NewBuffer) then begin
Result := nil;
Exit;
end;
Result.BufferNext := NewBuffer;
Result := NewBuffer;
Result.BufferNext := nil;
Result.WriteCount := 0;
AvailBytes := Result.BufferSize;
end;
end;
end;
As you can see, I’m converting the string (Unicode) to ascii. I do it the rude way for performance reason. Of course you can preserve Unicode instead if you need it. This double the in memory size and write to disk time. For my application, keeping ascii is enough and I preferred better speed and less memory and disk space. Just a choice.
Now let’s see the main class. TInMemoryLogger is responsible for maintening the list of buffers and the list of available buffers. It receives the request to write a message thru the method Log() and the request to flush the buffers to disk thru the method FlushToFile(). Another important responsibility of the class it to manage concurrency so that the Log and FlushToFile methods can be called from different threads. So there are two critical sections: one two serialize access to the buffers and one to serialize access to the file.
The list of available buffers is managed by two protected methods: AcquireChunk and ReleaseChunk. AcquireChunk will check for available buffer and return it, or create a new buffer if no one is available. ReleaseChunk takes an emptied buffer (one which has been flushed to disk) and move it to the available buffer list.
The final code is quite simple. Here after you’ll find it complete.
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: François PIETTE
Creation: Feb 09, 2014
Description: Fast multithread safe in memory logging
Version: 1.00
History:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteInMemoryLogger;
interface
uses
Windows, ShlObj,
Types, Classes, SysUtils, SyncObjs,
Generics.Collections,
OverbyteInMemoryChunk;
type
TInMemoryLoggerOption = (
imloAddCRLF, // Add a CRLF at end of each Log()
imloAddDate, // Add a date in front of each log()
imloAddTime, // Add a time in front of each log()
imloAddTimeMSec, // Add millisecond to time
imloFlushOnDestroy // Flush to file when destroyed
);
TInMemoryLoggerOptions = set of TInMemoryLoggerOption;
TInMemoryLogger = class(TComponent)
private
protected
FCritSectBuffer : TCriticalSection; // To protect buffer access
FCritSectFile : TCriticalSection; // To protect file write access
FBufferHead : TInMemoryChunk;
FBufferCurrent : TInMemoryChunk;
FBuffe : Integer;
FOptions : TInMemoryLoggerOptions;
FFileName : String;
FBufferAvail : TInMemoryChunk;
FByteCount : Integer;
function AcquireChunk: TInMemoryChunk;
procedure ReleaseChunk(Chunk: TInMemoryChunk);
procedure AcquireChunkHandler(Sender: TObject; var Chunk: TInMemoryChunk);
function GetByteCount: Integer;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Log(const Msg : String);
procedure FlushToFile;
procedure SetDefaultFileName;
published
property BufferSize : Integer read FBufferSize
write FBufferSize;
property Options : TInMemoryLoggerOptions read FOptions
write FOptions;
property FileName : String read FFileName
write FFileName;
property ByteCount : Integer read GetByteCount;
end;
var
CompanyFolder : String = 'OverByte';
implementation
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ TInMemoryLogger }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TInMemoryLogger.Create(AOwner: TComponent);
begin
FCritSectBuffer := TCriticalSection.Create;
FCritSectFile := TCriticalSection.Create;
FBufferSize := 4096; // Default buffer size;
FOptions := [imloAddCRLF, imloFlushOnDestroy,
imloAddDate, imloAddTime, imloAddTimeMSec];
inherited Create(AOwner);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TInMemoryLogger.Destroy;
var
Chunk1 : TInMemoryChunk;
Chunk2 : TInMemoryChunk;
begin
if imloFlushOnDestroy in FOptions then
FlushToFile;
if Assigned(FCritSectBuffer) then
FCritSectBuffer.Acquire;
try
// Free currently active buffers
Chunk1 := FBufferHead;
FBufferHead := nil;
while Assigned(Chunk1) do begin
Chunk2 := Chunk1.BufferNext;
FreeAndNil(Chunk1);
Chunk1 := Chunk2;
end;
// Free available buffers
Chunk1 := FBufferAvail;
FBufferAvail := nil;
while Assigned(Chunk1) do begin
Chunk2 := Chunk1.BufferNext;
FreeAndNil(Chunk1);
Chunk1 := Chunk2;
end;
finally
if Assigned(FCritSectBuffer) then begin
FCritSectBuffer.Release;
FreeAndNil(FCritSectBuffer);
end;
end;
FreeAndNil(FCritSectFile);
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TInMemoryLogger.AcquireChunk : TInMemoryChunk;
begin
FCritSectBuffer.Acquire;
try
// Check if a buffer is available
if not Assigned(FBufferAvail) then
Result := nil
else begin
// Take one buffer from the buffer available list
Result := FBufferAvail;
FBufferAvail := FBufferAvail.BufferNext;
Result.BufferNext := nil;
end;
finally
FCritSectBuffer.Release;
end;
// If we got no buffer, then create a new one
if not Assigned(Result) then begin
Result := TInMemoryChunk.Create(FBufferSize);
Result.OnAcquireChunk := AcquireChunkHandler;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.ReleaseChunk(Chunk : TInMemoryChunk);
begin
if not Assigned(Chunk) then
Exit;
FCritSectBuffer.Acquire;
try
// Add the buffer to the available buffer list
Chunk.BufferNext := FBufferAvail;
FBufferAvail := Chunk;
// Clear data
Chunk.WriteCount := 0;
{$IFDEF DEBUG}
// When debugging, clear buffer memory
if Assigned(Chunk.Buffer) then
FillChar(PByte(Chunk.Buffer)^, Chunk.BufferSize, 0);
{$ENDIF}
finally
FCritSectBuffer.Release;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Build filename with LocalApp data location, company folder and
// same filename es executable with .log extension
procedure TInMemoryLogger.SetDefaultFileName;
var
ExeName : array [0 .. MAX_PATH] of Char;
Path : array [0 .. MAX_PATH] of Char;
AppName : String;
begin
// Fetch Windows LocalApp data folder location
SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
// Fetch executable file path
GetModuleFileName(0, ExeName, High(ExeName));
AppName := ChangeFileExt(ExtractFileName(ExeName), '');
// Build complete file name
FFileName := IncludeTrailingPathDelimiter(Path) + CompanyFolder +
'\' + AppName + '\' + AppName + '.Log';
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.AcquireChunkHandler(
Sender : TObject;
var Chunk : TInMemoryChunk);
begin
Chunk := AcquireChunk;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.FlushToFile;
var
Stream : TFileStream;
Mode : Integer;
Next : TInMemoryChunk;
begin
// Check if critical section are assigned. The may be not assigned
// in case of exception raise during contructor execution.
if not Assigned(FCritSectFile) then
Exit;
if not Assigned(FCritSectBuffer) then
Exit;
FCritSectFile.Acquire;
try
if (not Assigned(FBufferHead)) or (FBufferHead.WriteCount <= 0) then
Exit;
if FFileName = '' then
Exit;
if FileExists(FFileName) then
Mode := fmOpenWrite
else
Mode := fmCreate;
Stream := TFileStream.Create(FFileName, Mode);
try
Stream.Seek(0, TSeekOrigin.soEnd);
FCritSectBuffer.Acquire;
try
while Assigned(FBufferHead) do begin
Stream.Write(FBufferHead.Buffer[0], FBufferHead.WriteCount);
Dec(FByteCount, FBufferHead.WriteCount);
FBufferHead.WriteCount := 0;
Next := FBufferHead.BufferNext;
ReleaseChunk(FBufferHead);
FBufferHead := Next;
// Release/Acquire the critical section to enhance concurrency
FCritSectBuffer.Release;
Sleep(0); // Let other thread take hand
FCritSectBuffer.Acquire;
end;
finally
FCritSectBuffer.Release;
end;
finally
FreeAndNil(Stream);
end;
finally
FCritSectFile.Release;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TInMemoryLogger.GetByteCount: Integer;
begin
FCritSectBuffer.Acquire;
try
Result := FByteCount;
finally
FCritSectBuffer.Release;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.Log(const Msg: String);
var
NewBuffer : TInMemoryChunk;
Buf : String;
begin
FCritSectBuffer.Acquire;
try
if not Assigned(FBufferHead) then begin
NewBuffer := AcquireChunk;
FBufferHead := NewBuffer;
FBufferCurrent := NewBuffer;
end;
if not Assigned(FBufferCurrent) then
raise EInMemoryNoBufferException.Create(ERROR_MSG_NO_BUFFER);
if (imloAddTime in FOptions) and (imloAddDate in FOptions) then begin
// Add both date and time
if imloAddTimeMSec in FOptions then
Buf := FormatDateTime('YYYYMMDD HHNNSS.ZZZ ', Now)
else
Buf := FormatDateTime('YYYYMMDD HHNNSS ', Now);
FBufferCurrent := FBufferCurrent.Write(Buf, FByteCount);
end
else if imloAddDate in FOptions then begin
// Add date only
Buf := FormatDateTime('YYYYMMDD ', Now);
FBufferCurrent := FBufferCurrent.Write(Buf, FByteCount);
end
else if imloAddTime in FOptions then begin
// Add time only
if imloAddTimeMSec in FOptions then
Buf := FormatDateTime('HHNNSS.ZZZ ', Now)
else
Buf := FormatDateTime('HHNNSS ', Now);
FBufferCurrent := FBufferCurrent.Write(Buf, FByteCount);
end;
if not Assigned(FBufferCurrent) then
raise EInMemoryNoBufferException.Create(ERROR_MSG_NO_BUFFER);
FBufferCurrent := FBufferCurrent.Write(Msg, FByteCount);
if imloAddCRLF in FOptions then
FBufferCurrent := FBufferCurrent.Write(#13#10, FByteCount);
finally
FCritSectBuffer.Release;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: François PIETTE
Creation: Feb 09, 2014
Description: Class to represent a buffer for TInMemoryLogger. Buffers
are organized as a simply linked list.
Version: 1.00
History:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteInMemoryChunk;
interface
uses
SysUtils;
type
EInMemoryException = class(Exception);
EInMemoryRangeException = class(EInMemoryException);
EInMemoryNoBufferException = class(EInMemoryException);
TInMemoryChunk = class;
TInMemoryChunkAcquireEvent = procedure (Sender : TObject;
var Chunk : TInMemoryChunk)
of object;
// Store data in ASCII
TInMemoryChunk = class(TObject)
strict private
FBuffer : TBytes;
FBufferSize : Integer;
FBufferNext : TInMemoryChunk;
FWriteCount : Integer;
FOnAcquireChunk : TInMemoryChunkAcquireEvent;
function AcquireChunk : TInMemoryChunk;
public
constructor Create(Size : Integer);
destructor Destroy; override;
function Write(const Msg : String;
var ByteCount : Integer) : TInMemoryChunk;
property Buffer : TBytes read FBuffer
write FBuffer;
property BufferNext : TInMemoryChunk read FBufferNext
write FBufferNext;
property BufferSize : Integer read FBufferSize
write FBufferSize;
property WriteCount : Integer read FWriteCount
write FWriteCount;
property OnAcquireChunk : TInMemoryChunkAcquireEvent
read FOnAcquireChunk
write FOnAcquireChunk;
end;
const
ERROR_MSG_NO_BUFFER = 'Log failed. No buffer available';
ERROR_MSG_SIZE_TO_LOW = 'Create buffer failed. Min size is 16';
implementation
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ TInMemoryChunk }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TInMemoryChunk.Create(Size: Integer);
begin
if Size < 16 then
raise EInMemoryRangeException.Create(ERROR_MSG_SIZE_TO_LOW);
FWriteCount := 0;
FBufferNext := nil;
FBufferSize := Size;
SetLength(FBuffer, FBufferSize);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TInMemoryChunk.Destroy;
begin
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TInMemoryChunk.AcquireChunk: TInMemoryChunk;
begin
Result := nil;
if Assigned(FOnAcquireChunk) then
FOnAcquireChunk(Self, Result);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Write a msg into the buffer, allocating a new one if required
// Returns the last buffer used (The current one or the new allocated)
function TInMemoryChunk.Write(
const Msg : String;
var ByteCount : Integer) : TInMemoryChunk;
var
I : Integer;
Len : Integer;
AvailBytes : Integer;
NewBuffer : TInMemoryChunk;
begin
Result := Self;
Len := Length(Msg);
if Len <= 0 then
Exit;
AvailBytes := Result.BufferSize - Result.WriteCount;
I := Low(Msg);
while I <= High(Msg) do begin
// Simple and incorrect unicode to ascii conversion
Result.Buffer[Result.WriteCount] := Ord(Msg[I]);
Result.WriteCount := Result.WriteCount + 1;
Inc(I);
Inc(ByteCount);
Dec(AvailBytes);
if AvailBytes <= 0 then begin
// No more room in current buffer, allocate new one
NewBuffer := AcquireChunk; // Get a free chunk
if not Assigned(NewBuffer) then begin
Result := nil;
Exit;
end;
Result.BufferNext := NewBuffer;
Result := NewBuffer;
Result.BufferNext := nil;
Result.WriteCount := 0;
AvailBytes := Result.BufferSize;
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
Follow me on
Twitter
Follow me on
LinkedIn
Follow me on
Google+
Visit my website:
http://www.overbyte.be
This article is available from
http://francois-piette.blogspot.be
