TInternetServer - using Simba WinAPI for threading

program new;
{$I Windows/Windows.simba}
{$I Windows/Threading.simba}
{$I SRL/osr.simba}

type
  TClientAcceptTimer = type TMMLTimer;
  TClientThread = type TMMLTimer;


  TInternetClient = record
    ID: Int32;
    IP, Port: string;
    Index: Int32;
  end;

  PInternetServer = ^TInternetServer;
  TInternetServer = record
    ID: Int32;
    IP, Port: string;
    AcceptTimer: TClientAcceptTimer;
    ClientThread: TClientThread;
    ClientQueue: array of TInternetClient;
    Requests: Int32;
  end;


var
  Server: TInternetServer;


// SPINLOCK
var
  critical: Int32;

{$IFDEF LINUX}
function CAS(x: ^Int32; y, z: Int32): Int32; static; external '__sync_val_compare_and_swap@libgcc_s.so.1 cdecl';
{$ELSE}{$IFDEF WINDOWS}
function CAS(x: ^Int32; y,z: Int32): Int32; static; external 'InterlockedCompareExchange@Kernel32.dll ' + {$IFDEF CPU386}'stdcall'{$ELSE}'win64'{$ENDIF};
{$ENDIF}{$ENDIF}

procedure AcquireLock(Lock: Int32);
begin
  repeat
    if CAS(@Lock, 1, 0) = 0 then Exit;
  until False;
end;

procedure ReleaseLock(Lock: Int32);
begin
  Lock := 0;
end;

// ------------------------------------


function TInternetClient.Create(IP: string; Port: string): TInternetServer; static;
var f: Int32;
begin
  Result.ID   := CreateSocket();
  Result.IP   := IP;
  Result.Port := Port;
  BindSocket(Result.ID, Result.IP, Result.Port);
  ListenSocket(Result.ID);
end;

procedure TInternetClient.WriteString(s: string);
begin
  SendSocket(Self.ID, s);
end;

function TInternetClient.Read(bytes: Int32): string;
begin
  Result := RecvSocketEx(Self.ID, bytes);
end;

function TInternetClient.ReadStr(): string;
begin
  Result := RecvSocketStr(Self.ID);
end;

procedure TInternetClient.SetTimeout(Time: Int32);
begin
  SetSocketTimeout(Self.ID, Time);
end;

procedure TInternetClient.CloseAndFree();
begin
  try
    CloseSocket(Self.ID);
    FreeSocket(Self.ID);
  except
    //dumb auto free
  end;

  Self.ID := -1;
  Delete(Server.ClientQueue, Self.Index, 1);
end;


// -----------------------------------

procedure AsyncAcceptClient(Sender: TObject);
var
  client,i: Int32;
begin
  with Server do
  begin
    client := AcceptSocket(Server.ID);

    AcquireLock(critical);
    begin
      clientQueue += [client,'','', Length(ClientQueue)];
      SocketInfo(client, clientQueue[High(clientQueue)].IP, clientQueue[High(clientQueue)].Port);
      Requests += 1;
    end;
    ReleaseLock(critical);
  end;
end;

function TInternetServer.Create(IP: string; Port: string): TInternetServer; static;
var f: Int32;
begin
  Result.ID   := CreateSocket();
  Result.IP   := IP;
  Result.Port := Port;
  BindSocket(Result.ID, Result.IP, Result.Port);
  ListenSocket(Result.ID);
end;

procedure TInternetServer.AcceptClients();
begin
  Self.AcceptTimer.Init();
  Self.AcceptTimer.SetInterval(128);
  Self.AcceptTimer.SetOnTimer(@AsyncAcceptClient);
  Self.AcceptTimer.SetEnabled(True);
end;

procedure TInternetServer.CloseAndFree();
begin
  try
    CloseSocket(Self.ID);
    FreeSocket(Self.ID);
  except
    //it was autofree'd because simba is dumb
  end;
end;

procedure HandleClient(lpParam: Pointer);
var
  Data,IP, port, tmp, Header: string;
  Content: string;
  client: TInternetClient;
  t: Double;
begin
  t := PerformanceTimer();
  client := TInternetClient(lpParam^);

  if Client.ID <= 0 then Exit;
  try
    Client.SetTimeout(1000*30); // 30 sec before we release without ping | cant keep it open for no reason
  except
    Exit;
  end;

  AcquireLock(critical);
  Server.Requests -= 1;         // We are handling one of the requests, reduce
  ReleaseLock(critical);

  Writeln('>>> Connection from: ', Client.IP, ':', Client.port);

  (* Get headers *)
  repeat
    try
      tmp := Client.ReadStr();
      header += tmp;
    except
      AcquireLock(critical);
      Client.CloseAndFree();
      ReleaseLock(critical);
      Exit;
    end;
  until tmp = '';

  (* Reply with OK *)
  Content := '<b>Welcome to my simba webserver</b><br \><br \> Responded in '+ ToStr(Round(PerformanceTimer() - t,6))+ 'ms';
  Client.WriteString('HTTP/1.1 200 OK'+#13#10);
  Client.WriteString('Content-Type: text/html'+#13#10);
  Client.WriteString('Connection: close'+#13#10);
  Client.WriteString('Content-Length: ' + IntToStr(Length(Content))+#13#10#13#10);
  Client.WriteString(Content);
  WriteLn('>>> Content data sent!');

  AcquireLock(critical);
  Client.CloseAndFree();
  ReleaseLock(critical);
end;

procedure Main;
var
  client: TInternetClient;
  threads: array of TLapeThread;

begin
  Server := TInternetServer.Create('127.0.0.1', '80');
  Server.AcceptClients();

  while True do
  begin
    client := [];

    AcquireLock(critical);
    begin
      if Server.Requests <> 0 then
        client := Server.ClientQueue[High(Server.ClientQueue)];
    end;
    ReleaseLock(critical);


    if client <> [] then
    begin
      threads += TLapeThread.Create(@HandleClient,@client);
      threads[High(threads)].Execute();
      //HandleClient(client);
    end;

    Sleep(1);
  end;

  Server.CloseAndFree();
end;

begin
  Main;
end.