Arief Sujatmiko on Blogspot

Kamis, 23 April 2026

Building New PC To Study LLM

Since early 2025, I've been using AI LLMs like ChatGPT or DeepSeek to learn programming or help with research. Using AI LLMs is easier because they can collect and process data into information that's easier for me to understand.

At the time, I didn't know that AI LLMs could be run on a local computer. After reading several articles about SLMs (Small Language Models) that can be run on a local computer, I became interested in running AI LLMs on my computer.

For the software, I tried using Llama.cpp, which has acceleration support for Vulkan.

Initially, I used the computer I usually use for gaming in my spare time. The specifications are as follows:

Motherboard: Intel H81
Processor: Intel Core i5 4670 3.4-3.7 GHz Quad Core.
RAM: 16 GB DDR3 1600 MHz.
GPU: Nvidia GeForce GTX 1050 4 GB DDR5.
OS: Windows 10
SSD: 256 GB.
Hard Disk: 1 TB.

With the above specifications, I successfully ran the LLM model with 4B and 7B parameters, but it would crash if the parameters were set higher. For 4B parameters, with CPU-only, it produced 5 tokens/s, while with Vulkan acceleration, it could reach 11 tokens/s. Meanwhile, for LLM, with 7B parameters, with CPU-only, it produced 3 tokens/s, while with Vulkan acceleration, it could reach 8 tokens/s.

From the measurement results above, I concluded that the bottleneck was the DDR3 RAM speed and the GPU's RAM size, which was too small. Therefore, LLM with parameters of 7B or higher would use more RAM.

To address the above issues, I finally allocated the budget to upgrade my computer to:

Motherboard: MSI A520.
Processor: AMD Ryzen 5 3400G 3.6-4.2 GHz Quad Core with hyperthreading.
RAM: 64 GB DDR4 3200MHz.
GPU: AMD Vega 11 integrated 2 GB shared RAM.
OS: Windows 10.
SSD: 256 GB.
Hard Disk: 1 TB.

The iGPU is able to use all available RAM and not limited by shared RAM setting in the BIOS. On Windows computers, when 50% of RAM is used, it will start aggressively swapping RAM, making the computer very sluggish. On Linux, this parameter can be changed, for example, starting when there's 10% RAM remaining. Since I have a relatively large amount of RAM, I intentionally disabled the swap file so I could use more than 50% of RAM for running LLM. The maximum stable RAM speed is at 3200Mhz even though the RAM specification is 3600 MHz, possibly due to a defect in the RAM due to overclocking by previous owner or limitations of the Ryzen 3400G's memory controller. Luckily it can run very stable at 3200Mhz without any problems.

With these new specifications, I was able to run LLM models with 35B and even 80B parameters with LLama.cpp in Vulkan mode. On this computer, Qwen 3.0 Coder Next 80B A3B could run at 10 tokens/s with iGPU. LLama.cpp with Vulkan mode is more power efficient and quiter than the CPU only mode.

Beside running LLM this computer is good for casual gaming too and only consuming 24 watt at idle. The AMD Radeon GPU driver for Windows have great compatibility with games. The Age of Empires HD Edition is broken when viewing civilization's tech tree with my GTX 1050 but run flawlessly with the Ryzen 3400G iGPU.

Kamis, 22 Januari 2026

Searching Algorithms That I Often Use

As a Computer Science student I have learn a lot of algorithm that not only usable in programming but also in my daily life. For example, I save alot of time when using binary search for searching in ordered objects.

1. Hash Map

Hash Map using integer of hash function result of item's key to map object into bucket array. The object is mapped using modulo of hash value and bucket size as index in the bucket array. And if there is collision the item is added using linked list in the collided index. The item search is doing by calculate hash value of search key and using modulo to find index in the bucket array. And if index in bucket is occupied then continue to compare item's key with search key, if not equal then continue with items in the linked list until the key is equal, if all items is not equal then item is not found.

Using Hash Map is very fast for alot of items and is frequently searched but when new item is added and the bucket need to grow it need to rehash the entire bucket into new bucket.

This is an example of my Hash Map classes in Free Pascal:

type
IListIterator = interface
['{16585733-6438-4D58-A772-FC6811EB19BB}']
procedure First;
function Next: TObject;
procedure Delete;
end;
{ THashable }
THashable = class(TObject)
private
FNext__: THashable;
protected
FHash: Integer;
public
constructor Create;
function IsEqual(AKey: Pointer): Boolean; virtual;
property Next__: THashable read FNext__;
property Hash: Integer read FHash;
end;
{ THashMap }
THashMap = class(TObject)
private
FBucket: PObjectArray;
FCapacity: integer;
FCount: Integer;
procedure SetCapacity(NewCapacity: Integer);
public
function ObjectByKey(AKey: Pointer): THashable;
protected
procedure Grow; virtual;
function HashKey(AKey: Pointer): Integer; virtual;
property Capacity: integer read FCapacity write SetCapacity;
property Count: Integer read FCount;
public
destructor Destroy; override;
procedure Clear;
function GetObject(AKey: Pointer): THashable;
procedure Put(AItem: THashable);
procedure Remove(const AKey: Pointer);
function GetIterator: IListIterator;
end;
{ THashMapIterator }
THashMapIterator = class(TInterfacedObject, IListIterator)
private
FHashMap: THashMap;
FIndex: Integer;
FNode, FBefore: THashable;
FReread: Boolean;
public
constructor Create(AHashMap: THashMap);
procedure First;
function Next: TObject;
procedure Delete;
end;
{ THashable }
constructor THashable.Create;
begin
FHash := 0;
FNext__ := nil;
end;
function THashable.IsEqual(AKey: Pointer): Boolean;
begin
Result := False;
end;
{ THashMap }
procedure THashMap.Clear;
var
I: integer;
begin
if (FBucket <> nil) then
begin
for I := 0 to FCapacity - 1 do
begin
if (FBucket^[I] <> nil) then FreeAndNil(FBucket^[I]);
end;
FreeMem(FBucket);
FBucket := nil;
end;
FCapacity := 0;
FCount := 0;
end;
destructor THashMap.Destroy;
begin
Clear;
inherited;
end;
function THashMap.GetObject(AKey: Pointer): THashable;
var
P: THashable;
H: integer;
begin
if (FCount > 0) then
begin
H := HashKey(AKey);
P := THashable(FBucket^[H mod FCapacity]);
while ((P <> nil) and ((P.Hash <> H) or not P.IsEqual(AKey))) do
P := P.FNext__;
Result := P;
end
else
Result := nil;
end;
procedure THashMap.Grow;
var
Delta: Integer;
begin
if FCapacity > 64 then
Delta := FCapacity div 4
else if FCapacity > 8 then
Delta := 16
else
Delta := 4;
SetCapacity(FCapacity + Delta);
end;
function THashMap.HashKey(AKey: Pointer): Integer;
begin
Result := Integer(AKey);
end;
function THashMap.ObjectByKey(AKey: Pointer): THashable;
begin
Result := GetObject(AKey);
if (Result = nil) then
raise EListError.CreateFmt(SListItemNotFoundError,[IntToHex(Integer(AKey),8)]);
end;
procedure THashMap.Put(AItem: THashable);
var
I: integer;
begin
if (AItem = nil) then exit;
Inc(FCount);
if ((FCount * 4) div 3 > FCapacity) then Grow;
I := AItem.Hash mod FCapacity;
AItem.FNext__ := THashable(FBucket^[I]);
FBucket^[I] := AItem;
end;
procedure THashMap.Remove(const AKey: Pointer);
var
P, Q: THashable;
I, H: Integer;
begin
if (FCount > 0) then
begin
H := HashKey(AKey);
I := H mod FCapacity;
P := THashable(FBucket^[I]);
Q := nil;
while ((P <> nil) and (P.Hash <> H) and not P.IsEqual(AKey)) do
begin
Q := P;
P := P.FNext__;
end;
if (P <> nil) then
begin
if (Q = nil) then
FBucket^[I] := P.FNext__
else
Q.FNext__ := P.FNext__;
P.Free;
Dec(FCount);
end;
end;
end;
function THashMap.GetIterator: IListIterator;
begin
Result := THashMapIterator.Create(Self);
end;
procedure THashMap.SetCapacity(NewCapacity: Integer);
var
P, Q: THashable;
NewList: PObjectArray;
I, J: Integer;
begin
if ((NewCapacity = FCapacity) or (NewCapacity < FCount)) then exit;
if (NewCapacity > 0) then
begin
GetMem(NewList,NewCapacity*SizeOf(TObject));
FillChar(NewList^,NewCapacity*SizeOf(TObject),0);
for I := 0 to FCapacity - 1 do
begin
P := THashable(FBucket^[I]);
while (P <> nil) do
begin
Q := P;
P := P.FNext__;
J := Q.Hash mod NewCapacity;
Q.FNext__ := THashable(NewList^[J]);
NewList^[J] := Q;
end;
end;
end
else
NewList := nil;
if (FBucket <> nil) then FreeMem(FBucket);
FBucket := NewList;
FCapacity := NewCapacity;
end;
{ THashMapIterator }
constructor THashMapIterator.Create(AHashMap: THashMap);
begin
FHashMap := AHashMap;
FIndex := -1;
FNode := nil;
FBefore := nil;
FReread := False;
end;
procedure THashMapIterator.First;
begin
FIndex := -1;
FNode := nil;
FBefore := nil;
FReread := False;
end;
function THashMapIterator.Next: TObject;
begin
if (FReread) then
begin
FReread := False;
end
else begin
if (FNode <> nil) then
begin
FBefore := FNode;
FNode := FNode.FNext__;
end;
if (FNode = nil) then
begin
Inc(FIndex);
while ((FIndex < FHashMap.Capacity) and (FHashMap.FBucket^[FIndex] = nil)) do
Inc(FIndex);
if (FIndex < FHashMap.Capacity) then
FNode := THashable(FHashMap.FBucket^[FIndex])
else
FNode := nil;
FBefore := nil;
end;
end;
Result := FNode;
end;
procedure THashMapIterator.Delete;
var
P: THashable;
begin
if (FNode <> nil) then
begin
P := FNode;
if (FBefore <> nil) then
FBefore.FNext__ := P.FNext__
else
FHashMap.FBucket^[FIndex] := P.FNext__;
FNode := FNode.FNext__;
if (FNode = nil) then
begin
Inc(FIndex);
while ((FIndex < FHashMap.Capacity) and (FHashMap.FBucket^[FIndex] = nil)) do
Inc(FIndex);
if (FIndex < FHashMap.Capacity) then
FNode := THashable(FHashMap.FBucket^[FIndex])
else
FNode := nil;
FBefore := nil;
end;
FReread := True;
P.Free;
end;
end;
{ TNamedObject }
function TNamedObject.GetName: String;
begin
Result := FName;
end;
procedure TNamedObject.SetName(const Value: string);
begin
FName := Value;
FHash := HashName(Value);
end;
function TNamedObject.IsEqual(AKey: Pointer): Boolean;
begin
Result := SameText(FName, String(AKey));
end;

This is an example of Hash function used to map object using case insensitive name:

function HashName(const AName: string): integer;
var
I: integer;
C: Byte;
begin
Result := 0;
for I := 1 to Length(AName) do
begin
C := Byte(AName[I]);
if ((C >= Ord('a')) and (C <= Ord('z'))) then Dec(C,Ord('a')-Ord('A'));
Result := ((Result SHL 5) OR (Result AND $1F)) + C;
end;
Result := Result AND $7FFFFFFF;
end;

This an example of using the Hash Map class to map objects by case insensitive name:

type
{ TNamedObject }
TNamedObject = class(THashable)
private
FName: string;
protected
function GetName: String;
procedure SetName(const Value: string); virtual;
public
function IsEqual(AKey: Pointer): Boolean; override;
property Name: string read GetName write SetName;
end;
{ TNamedObjectMap }
TNamedObjectMap = class(THashMap)
protected
function HashKey(AKey: Pointer): Integer; override;
public
function GetObject(const AName: String): TNamedObject;
procedure Remove(const AName: string);
end;
{ TNamedObject }
function TNamedObject.GetName: String;
begin
Result := FName;
end;
procedure TNamedObject.SetName(const Value: string);
begin
FName := Value;
FHash := HashName(Value);
end;
function TNamedObject.IsEqual(AKey: Pointer): Boolean;
begin
Result := SameText(FName, String(AKey));
end;
{ TNamedObjectMap }
function TNamedObjectMap.HashKey(AKey: Pointer): Integer;
begin
Result := HashName(String(AKey));
end;
function TNamedObjectMap.GetObject(const AName: String): TNamedObject;
begin
Result := TNamedObject(inherited GetObject(Pointer(AName)));
end;
procedure TNamedObjectMap.Remove(const AName: string);
begin
inherited Remove(Pointer(AName));
end;

This is an example of name and row index search helper using Hash Map:

{ TNameIndexItem }
TNameIndexItem = class(THashable)
private
FKey: String;
FRow: Integer;
FData: Pointer;
public
constructor Create(const AKey: String; ARow: Integer; AData: Pointer=nil);
function IsEqual(AKey: Pointer): Boolean; override;
property Key: String read FKey;
property Row: Integer read FRow;
property Data: Pointer read FData;
end;
{ TNameIndex }
TNameIndex = class(THashMap)
protected
function HashKey(AKey: Pointer): Integer; override;
public
function GetObject(const AKey: String): TNameIndexItem;
procedure Remove(const AKey: String);
procedure PutRow(const AKey: String; ARow: Integer; AData: Pointer=nil);
function FindRow(const AKey: String): Integer;
function GetRowAndData(const AKey: String; var ARow: Integer;
var AData: Pointer): Boolean;
// procedure IndexTable(ATable: ITransportTable; const AColName: String);
end;
{ TNameIndexItem }
constructor TNameIndexItem.Create(const AKey: String; ARow: Integer;
AData: Pointer);
begin
FKey := AKey;
FHash := HashName(AKey);
FRow := ARow;
FData := AData;
end;
function TNameIndexItem.IsEqual(AKey: Pointer): Boolean;
begin
Result := SameText(FKey, String(AKey));
end;
{ TNameIndex }
function TNameIndex.FindRow(const AKey: String): Integer;
var
P: TNameIndexItem;
begin
P := GetObject(AKey);
if (P <> nil) then
Result := P.Row
else
Result := -1;
end;
function TNameIndex.GetRowAndData(const AKey: String; var ARow: Integer;
var AData: Pointer): Boolean;
var
P: TNameIndexItem;
begin
P := GetObject(AKey);
if (P <> nil) then
begin
ARow := P.Row;
AData := P.Data;
Result := True;
end
else
Result := False;
end;
function TNameIndex.GetObject(const AKey: String): TNameIndexItem;
begin
Result := TNameIndexItem(inherited GetObject(Pointer(AKey)));
end;
function TNameIndex.HashKey(AKey: Pointer): Integer;
begin
Result := HashName(String(AKey));
end;
//procedure TNameIndex.IndexTable(ATable: ITransportTable;
// const AColName: String);
//var
// i, col: Integer;
//begin
// if (ATable = nil) then
// exit;
// col := ATable.FindField(AColName);
// if (col < 0) then
// exit;
// Clear;
// for i := 0 to ATable.RowCount - 1 do
// PutRow(ATable.Cells[col,i].AsString, i);
//end;
procedure TNameIndex.PutRow(const AKey: String; ARow: Integer;
AData: Pointer);
begin
if (GetObject(AKey) = nil) then
begin
Put(TNameIndexItem.Create(AKey, ARow, AData));
end;
end;
procedure TNameIndex.Remove(const AKey: String);
begin
inherited Remove(Pointer(AKey));
end;

2. Hash Marking

Hash marking using integer of hash function result of item's key to mark list items. Because comparing an integer only need 1 cpu clock and comparing text need 1 cpu clock per character we can skip comparing entire key by first comparing only hash values and only if it is equal then we continue to compare the key.

This method is very effective if item's key is a string or large complex type such as struct and number of items is limited or frequently recreated. For very alot of items and is frequently searched using Hash Map is faster.

This is an example of using hash marking to search for an object in a linked list:

function TChain.GetObject(AKey: Pointer): THashable;
var
P: THashable;
H: Integer;
begin
P := FFirst;
H := HashKey(AKey);
while ((P <> nil) and ((P.Hash <> H) or not P.IsEqual(AKey))) do
P := P.FNext__;
Result := P;
end;

3. Binary Search

Binary Search work with ordered list by repeatly search the middle first and if not the equal then search the half part of the list that is possibly still cotains the items until the item is found or range start > range end.

This is an example of searching data using binary search:

function TIntegerList.IndexOfB(AItem: Integer): Integer;
var
Low,High,Mid: Integer;
begin
Result := -1;
Low := 0;
High := Count - 1;
Mid := (Low + High) div 2;
while (Low <= High) do
begin
if (Items[Mid] > AItem) then High := Mid - 1
else if (Items[Mid] < AItem) then Low := Mid + 1
else begin
Result := Mid;
exit;
end;
Mid := (Low + High) div 2;
end;
end;

Selasa, 16 Desember 2025

Creating Expert System for Database Application Development

In the year 2016, my friend show me he create a desktop application using Delphi that he create very fast. I think I cannot compete with him with that software development skill. I am thinking what if I create an expert system to help create desktop application for me. Then I create this application and name it Gampang Builder.

The design of Gampang Builder is very simple, it get input from the user about the application design and generate software project for it, not a complete software but only:

Main form and main menu of the application.
Navigation system to access facilities in the application and limiting access by application user.
Data service for create, edit and delete for entities and relations.
Editing form for the entites and relations.
Printable report for the entities.

When we create an application first we have to define the backgroud of the problem to solve and the target to be achieved by the application.

Then we choose the technology for the to be generated application.

To make our code more reusable I split the code into few modules.

In each module we can define the class name for the data service and access right than can be used to limit user access because not every user will have the same access level.

After we define the modules we can define the entities by the data table and relations between entities in the applications.

In the data tabel we can define field name, data type, its characteristic, and relation with other table such as look up or master-detail.

If we need the printed design for documentation, Gampang Builder can print it.

The last thing to do is generate the application but because this application is too old and many changes to the library change the package file reader, I will repair the code and update when it completed. I created a few application with this program, one of the application is a medical laboratory database application and is still running today from 2016. I dont have time yet to improve this program but maybe someday.

UPDATE: Yesterday I have a requirement to generate a flutter Application so I have to fix the Gampang Builder before adding flutter application code generation module. So I open this project again and fix the problem with my modified library. And the problem is TTransportVar object using different format when storing String data. After I fix the file packer object with the modified library then everything is working again and the code generation is back to normal.

This is the generated folder for the middle ware of an Lazarus Application:

And this is the generated folder for the client app:

This is one of the server module API code:

This is one of the client save edit procedure:

It is very simple but the generated code compiled without any errors and easy to add code later.

That's all in this article, I hope it's usefull.

Creating Simple Web Server with Lazarus

Web server is a program or sub program that provide data to client program not limited to web browser using HTTP or HTTPS (HTTP over SSL) protocol. HTTP is a simple, fast and robust protocol for client-server application. The HTTP protocol works by having the client send a request to the server, then the server processes the request and sends back a response to the client.

Example of HTTP Client's Request:

GET / HTTP/1.1
Host: www.example.com

The first line of a HTTP request consist of a command, a url and the protocol version. Followed by header lines and terminated by empty line. Each header line consist of header name and value separated by colon and one space. After the header data is the content data that contain n bytes where n is the value of Content-Length header.

Example of HTTP Server's Response:

HTTP/1.1 200 OK
Date: Mon, 23 May 2005 22:38:34 GMT
Content-Type: text/html; charset=UTF-8
Content-Length: 155
Last-Modified: Wed, 08 Jan 2003 23:11:55 GMT
Server: Apache/1.3.3.7 (Unix) (Red-Hat/Linux)
ETag: "3f80f-1b6-3e1cb03b"
Accept-Ranges: bytes
Connection: close

<html>
  <head>
    <title>An Example Page</title>
  </head>
  <body>
    <p>Hello World, this is a very simple HTML document.</p>
  </body>
</html>

The first line of a HTTP response consist of protocol version and result code followed by error message. Followed by header lines and terminated by empty line. Each header line consist of header name and value separated by colon and one space. After the header data is the content data that contain n bytes where n is the value of Content-Length header.

Free Pascal, Delphi and Lazarus share the same programming language the Object Pascal with little differentiation. So many Delphi component can be used in Lazarus and vice versa because it only requires minor changes in the source code to support both programming. If you don't want to use visual component you can use operating system API like winsock (Windows Socket) for Windows or unisock (Unix Socket) for Linux. I will use synapse for Free Pascal library in this example.

To help parsing input data I create TStringSplitter :

type
{ TStringSplitter }
TStringSplitter = class(TObject)
private
FLine: String;
FCol: Integer;
procedure SetCol(AValue: Integer);
procedure SetLine(AValue: String);
public
constructor Create;
function Fetch(const ATerminator: String=''): String;
property Line: String read FLine write SetLine;
property Col: Integer read FCol write SetCol;
end;
function PosAfter(const SubText, Text: String; StartAt: Integer): Integer;
var
I, L1, L2: Integer;
begin
Result := -1;
L1 := Length(SubText);
L2 := Length(Text);
if ((L1 > L2) or (StartAt < 1)) then exit;
for I := StartAt to L2-L1+1 do
if (CompareMem(@SubText[1], @Text[I], L1)) then
begin
Result := I;
exit;
end;
end;
procedure TStringSplitter.SetCol(AValue: Integer);
begin
FCol := AValue;
end;
procedure TStringSplitter.SetLine(AValue: String);
begin
FLine := AValue;
FCol := 1;
end;
constructor TStringSplitter.Create;
begin
FLine := '';
FCol := 1;
end;
function TStringSplitter.Fetch(const ATerminator: String): String;
var
I, J: Integer;
begin
Result := '';
I := FCol;
if (I > Length(FLine)) then exit;
if (ATerminator <> '') then
begin
J := PosAfter(ATerminator, FLine, I);
if (J > 0) then
begin
Result := Copy(FLine, I, J-I);
FCol := J + Length(ATerminator);
exit;
end;
end;
Result := Copy(FLine, FCol, MaxInt);
FCol := Length(FLine) + 1;
end;

When the server is started it initialize the socket to listen to the specified port. Then it repeatly check for incoming connection and start HTTP handler worker thread until the server is terminated.

procedure TDaemon1.WorkServerListener(Thread: TWorkerThread);
var
sock: TTCPBlockSocket;
h: TSocket;
begin
try
sock := TTCPBlockSocket.Create;
try
sock.Bind('0.0.0.0',IntToStr(Port));
if (sock.LastError <> 0) then
raise ENetworkError.Create('Cannot bind to port '+IntToStr(Port));
sock.Listen;
if (sock.LastError <> 0) then
raise ENetworkError.Create('Cannot listen to port '+IntToStr(Port));
while (not Thread.Terminated) do
begin
if (sock.CanRead(5000)) then
begin
h := sock.Accept;
{$HINTS OFF}
if (h <> INVALID_SOCKET) then
WorkerThreads.AddNew(@WorkRequestHandler,Pointer(h));
{$HINTS ON}
end;
end;
finally
sock.Free; // close and free socket object
end;
except
on E: Exception do
// DebugLog('HTTP Server terminated by error '+E.ClassName+': '+
// E.Message);
end;
end;

The HTTP handler worker thread read HTTP request from incoming connection and send back HTTP Respond.

procedure TDaemon1.WorkRequestHandler(Thread: TWorkerThread);
var
sock: TTCPBlockSocket;
S1: TStringSplitter;
s, cmd, url, http_ver, nm, vl, error_msg, respond_text, respond_data: AnsiString;
I, result_code: Integer;
close_socket, can_read: Boolean;
headers, gets, respond_headers: TStrings;
begin
result_code := 500;
close_socket := True;
sock := TTCPBlockSocket.Create;
S1 := TStringSplitter.Create;
headers := TStringList.Create;
gets := TStringList.Create;
respond_headers := TStringList.Create;
try
{$HINTS OFF}
sock.Socket := TSocket(Thread.Param);
{$HINTS ON}
repeat
can_read := sock.CanRead(5000);
if (sock.LastError <> 0) then exit;
if (can_read) then
begin
I := Pos('?',url);
if (I >= 1) then
begin
S1.Line := Copy(url, I+1, MaxInt);
repeat
nm := S1.Fetch('=');
if (nm <> '') then
begin
vl := S1.Fetch('&');
gets.Values[nm] := vl;
end;
until (nm = '');
Delete(url,I,MaxInt);
end;
S1.Line := sock.RecvString(ReadTimeout);
if (sock.LastError <> 0) then exit;
cmd := S1.Fetch(' ');
url := S1.Fetch(' ');
http_ver := S1.Fetch;
if ((cmd = 'GET') or (cmd = 'POST')) then
begin
close_socket := (http_ver = 'HTTP/0.9') or (http_ver = 'HTTP/1.0');
S1.Line := sock.RecvString(ReadTimeout);
if (sock.LastError <> 0) then exit;
while (S1.Line <> '') do
begin
nm := S1.Fetch(': ');
vl := S1.Fetch;
headers.Values[nm] := vl;
S1.Line := sock.RecvString(ReadTimeout);
if (sock.LastError <> 0) then exit;
end;
//
// .. do some processing here
//
respond_data :=
'<head><title>Welcome</title></head><body><h1>Welcome to my Web Server</h1><p>You are in here: '+HttpEncode(url)+'</body>';
respond_headers.Values['Content-Type'] := 'html/text';
respond_headers.Values['Content-Length'] := IntToStr(Length(respond_data));
result_code := 200;
end
else begin
result_code := 501;
close_socket := True;
end;
if((result_code < 200) or (result_code > 499)) then close_socket := True;
case result_code of
200: error_msg := 'OK';
400: error_msg := 'Bad Reqeust';
500: error_msg := 'Internal Server Error';
501: error_msg := 'Not Implemented';
end;
respond_text :=
http_ver + ' ' + IntToStr(result_code) + ' ' + error_msg + #13#10;
for I := 0 to respond_headers.Count do
respond_text := respond_text + respond_headers.Names[I] + ': ' +
respond_headers.ValueFromIndex[I] + #13#10;
respond_text := respond_text + #13#10 + respond_data;
sock.SendBuffer(@respond_text[1], Length(respond_text));
headers.Clear;
respond_headers.Clear;
respond_text := '';
end;
until (Thread.Terminated or close_socket);
finally
respond_headers.Free;
gets.Free;
headers.Free;
S1.Free;
sock.Free;
end;
end;

You can send and receive data using easy to parse data like JSON, XML, BSON or binary data for data service, it is very flexible.

That's all for this article and I hope it's useful.

Kamis, 04 Desember 2025

Creating Thread from Procedure to simplify thread programming in Free Pascal and Delphi

Thread in Free Pascal and Delphi is a process that run simutanously with main program. This is very useful when we need to process data in background while user doing his own work. And is needed to maximize processing in multicore processor because a process including main process can only use 1 core and a quad core processor require a minimum of 4 threads to use all 4 cores.

Basically to create a thread we need to create the thread class and override the execute procedure with the thread code. To minimize work I create WorkerThreadList class, a very simple class to run a procedure of object as a thread.

First the class definition:

type
{ TSemaphore }
TSemaphore = class(TObject)
private
FSem: Integer;
public
constructor Create;
destructor Destroy; override;
procedure Lock;
procedure Unlock;
end;
{ WorkerThreads Routines }
TWorkerThread = class;
TWorkerThreadList = class;
TWorkEvent = procedure(WT: TWorkerThread) of object;
{ TWorkerThread }
TWorkerThread = class(TThread)
private
FOwner: TWorkerThreadList;
FOnWork: TWorkEvent;
FParam: Pointer;
protected
procedure Execute; override;
public
constructor Create(AOwner: TWorkerThreadList; AOnWork: TWorkEvent;
AParam: Pointer);
destructor Destroy; override;
property OnWork: TWorkEvent read FOnWork write FOnWork;
property Param: Pointer read FParam;
property Terminated;
end;
{ TWorkerThreadList }
TWorkerThreadList = class(TObject)
private
FWorkers: TObjectList;
FSem: TSemaphore;
function GetItems(Index: Integer): TWorkerThread;
public
constructor Create;
destructor Destroy; override;
function AddNew(AOnWork: TWorkEvent; AParam: Pointer=nil): TWorkerThread;
procedure TerminateWait(Thread: TWorkerThread);
procedure UnregisterWorkerThread(AThread: TWorkerThread);
procedure TerminateWorkerThreads(Wait: Boolean);
property Items[Index: Integer]: TWorkerThread read GetItems; default;
end;

Then I create the class definition like this:

{ TWorkerThreadList }
function TWorkerThreadList.GetItems(Index: Integer): TWorkerThread;
begin
Result := TWorkerThread(FWorkers[Index]);
end;
constructor TWorkerThreadList.Create;
begin
inherited;
FWorkers := TObjectList.Create(False);
FSem := TSemaphore.Create;
end;
destructor TWorkerThreadList.Destroy;
begin
TerminateWorkerThreads(True);
FWorkers.Free;
FSem.Free;
inherited Destroy;
end;
function TWorkerThreadList.AddNew(AOnWork: TWorkEvent;
AParam: Pointer): TWorkerThread;
var
N: TWorkerThread;
begin
N := TWorkerThread.Create(Self, AOnWork, AParam);
try
FSem.Lock;
try
FWorkers.Add(N);
finally
FSem.Unlock;
end;
Result := N;
N.Start;
except
N.Free;
raise;
end;
end;
procedure TWorkerThreadList.TerminateWait(Thread: TWorkerThread);
var
I: Integer;
begin
if (Thread = nil) then exit;
FSem.Lock;
try
if (FWorkers.IndexOf(Thread) < 0) then
exit
else begin
if (not Thread.Terminated) then Thread.Terminate;
if (Thread.Suspended) then Thread.Start;
end;
finally
FSem.Unlock;
end;
repeat
FSem.Lock;
try
I := FWorkers.IndexOf(Thread);
if (I < 0) then exit;
if (Thread.Finished or (Thread.ThreadId = 0)) then
begin
FWorkers.Remove(Thread);
Thread.FOwner := nil;
Thread.Free;
exit;
end;
finally
FSem.Unlock;
end;
Sleep(1);
until (False);
end;
procedure TWorkerThreadList.UnregisterWorkerThread(AThread: TWorkerThread);
begin
if ((AThread = nil) or (AThread.FOwner <> Self)) then
exit;
FSem.Lock;
try
FWorkers.Remove(AThread);
AThread.FOwner := nil;
finally
FSem.Unlock;
end;
end;
procedure TWorkerThreadList.TerminateWorkerThreads(Wait: Boolean);
var
I, J: Integer;
begin
repeat
FSem.Lock;
try
J := 0;
for I := FWorkers.Count-1 downto 0 do
begin
with TWorkerThread(FWorkers[I]) do
begin
if (not Finished and (ThreadId <> 0)) then
begin
if (not Terminated) then Terminate;
if (Suspended) then Start;
Inc(J);
end;
end;
end;
finally
FSem.Unlock;
end;
if (J > 0) then Sleep(70);
until ((J = 0) or not Wait);
FSem.Lock;
try
for I := FWorkers.Count-1 downto 0 do
begin
try
TWorkerThread(FWorkers[I]).FOwner := nil;
TWorkerThread(FWorkers[I]).Free;
except
//
end;
end;
FWorkers.Clear;
finally
FSem.Unlock;
end;
end;
{ TWorkerThread }
procedure TWorkerThread.Execute;
begin
try
if (Assigned(FOnWork)) then FOnWork(Self);
except
end;
if (FOwner <> nil) then FOwner.UnregisterWorkerThread(Self);
end;
constructor TWorkerThread.Create(AOwner: TWorkerThreadList; AOnWork: TWorkEvent;
AParam: Pointer);
begin
inherited Create(True);
FreeOnTerminate := True;
Priority := tpIdle;
FOwner := AOwner;
FOnWork := AOnWork;
FParam := AParam;
end;
destructor TWorkerThread.Destroy;
begin
if (FOwner <> nil) then FOwner.UnregisterWorkerThread(Self);
inherited Destroy;
end;
{ TSemaphore }
constructor TSemaphore.Create;
begin
FSem := 0;
end;
destructor TSemaphore.Destroy;
begin
Unlock;
inherited Destroy;
end;
procedure TSemaphore.Lock;
begin
while (InterLockedExchange(FSem, 1) = 1) do Sleep(1);
end;
procedure TSemaphore.Unlock;
begin
InterLockedExchange(FSem, 0);
end;

Using this class I can run a procedure of object with this parameter using TWorkerThreadList object:

TWorkEvent = procedure(WT: TWorkerThread) of object;

How to use the TWorkerThreadList class:

Define WorkerThreads variable as global variable or in the data module:

WorkerThreads: TWorkerThreadList;
Add object create and free for the WorkerThreads object in the data module on create and on destroy:
1. procedure TDaemon1.DataModuleCreate(Sender: TObject);
2. begin
3. WorkerThreads := TWorkerThreadList.Create;
4. end;
6. procedure TDaemon1.DataModuleDestroy(Sender: TObject);
7. begin
8. WorkerThreads.Free;
9. end;
Create the thread procedure:
1. procedure TDaemon1.WorkServerListener(Thread: TWorkerThread);
2. begin
3. try
4. { do something }
5. except
6. { do handle exceptions }
7. end;
8. end;
Create thread for the procedure:
1. procedure TDaemon1.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean
2. );
3. begin
4. WorkerThreads.AddNew(@WorkServerListener, nil);
5. OK := True;
6. end;

WorkerThreadList object can be created and destroyed as needed. A WorkerThreadList object can run alot of procedures.

Working with thread can be tricky, You have to be carefull with race condition, some objects that is not thread safe you need to put semaphore so that only one thread can access it at a time. Memory leak is not the only bugs.

Thats all for the WorkerThreadList object, and I hope this article can be useful.