Как сделать так, чтобы программа на free pascal или ее часть выполнялась на всех ядрах и потоках?

uses
  sysutils {$ifdef unix}, cthreads{$endif} ;
 
type
   Parr=^TArr;
   Tarr=array of integer;
 
var
 t:TTimeStamp;
 a,a1,a2:TArr;
 i:longint;
 ff:integer;
 
function fsort2(p:pointer):ptrint;
var
  i:longint;
  t:integer;
  a:Tarr;
begin
  pointer(a):=p;
  writeln('fsort started');
  i:=0;
  while (i<High(a)) do begin
    if a[i+1]<a[i] then begin
      t:=a[i];
      a[i]:=a[i+1];
      a[i+1]:=t;
      i:=0;
    end else  i:=i+1;
  end;
    p:=@a;
    pointer(a):=nil;
    fsort2:=0;
    ff:=ff+1;
    writeln('fsort finished');
 
end;
 
procedure CopyArr(a:TArr;var b:TArr);
var
  i:longint;
begin
  setlength(b,length(a));
  for i:=0 to High(a) do b[i]:=a[i];
end;
 
procedure PrintArr(a:TArr;c:integer);
var
  i:longint;
begin
  for i:=0 to High(a) do if (i>0) and (i mod c=0) then writeln(a[i]) else write(a[i]);
end;
 
begin
  randomize;
  setlength(a,3000);
  for i:=0 to High(a) do a[i]:=Random(10);
  CopyArr(a,a1);
  CopyArr(a,a2);
//  PrintArr(a,40);
  t:=DateTimeToTimeStamp(Now);
  fsort2(pointer(a1));
  fsort2(pointer(a2));
  writeln('ms passed:',DateTimeToTimeStamp(Now).Time-t.Time);
//  PrintArr(a1,40);
  writeln('Threads:');
  CopyArr(a,a1);
  CopyArr(a,a2);
  t:=DateTimeToTimeStamp(Now);
  ff:=0;
  BeginThread(@fsort2,pointer(a1));
  BeginThread(@fsort2,pointer(a2));
  while ff<2 do ;
  writeln('ms passed:',DateTimeToTimeStamp(Now).Time-t.Time);
//  PrintArr(a3,40);
  readln;
end.

type
  TComThread = class (TThread)
    private
      var
      protocol_pause:byte;
      protocol_pause2:byte;
      protocol_repeat:byte;
      hPort:THandle;
      DCB:TDCB;
      OverWrite, OverRead:TOverlapped;
      Stat : TComStat;
      last_pack:byte;
 
      //sbuf:string;
      RBuffer:array [0..$ffff-1] of byte;
      rbuflen:dword;
 
     type
      tt_pack = array of byte;
     var
      t_pack:array of tt_pack;
 
      procedure Read();
      procedure WriteP(S:array of byte);
 
      procedure refresh_bath_start;
 
     var
 
      readflag:boolean;
      update_bath_count:byte;
 
    public
 
      BathState:array[1..16] of TBathState;
 
      constructor Create(const cn:byte; baudrate:dword; stopbits,databits:byte; parity, flowcontrol:boolean );
      procedure SetProtocolSettings(const p_pause,p_pause2,p_repeat:byte);
      destructor Free();
 
      procedure SetParams(num:byte; mode,mode2,zhem_levelset, t23,t1:byte);
      procedure Start(num:byte);
      procedure Stop(num:byte);
      procedure parse;
      procedure testpack;
     var
       port_exist:boolean;
    protected
      procedure Execute(); override;
  end;
 
implementation
 
procedure TComThread.refresh_bath_start;
var i:byte;
begin
  update_bath_count:=0;
  for i:=1 to 16 do BathState[i].updated:=false;
end;
 
procedure TComThread.WriteP(S:array of byte);
var dwWrite,i, t1, t2:dword;
begin
  OverWrite.hEvent := CreateEvent(nil, True, False, nil);
  if OverWrite.hEvent = Null then
  raise Exception.Create('Error creating write event');
  if (not WriteFile(hPort, s, sizeof(s),  dwWrite, @OverWrite))
 and (GetLastError <> ERROR_IO_PENDING) then
  raise Exception.Create('Error writing port');
 
end;
 
constructor TComThread.Create(const cn:byte; baudrate:dword; stopbits,databits:byte; parity, flowcontrol:boolean );
var i:byte;
 
begin
 
  hPort:=CreateFile(PChar('//./COM'+IntToStr(cn)),generic_read or generic_write, 0, nil,
                  open_existing, file_flag_overlapped,0);
  port_exist:=GetLastError=0;
  if port_exist then
  begin
  GetCommState(hPort,DCB);
  Dcb.BaudRate :=baudrate;
  Dcb.Parity := NOPARITY;
  Dcb.ByteSize := databits;
  Dcb.StopBits := ONESTOPBIT;
  DCB.Flags:=20625;
  SetCommState(hPort,DCB);
  SetupComm(hPort,16,16);
  PurgeComm(hPort,Purge_TxAbort or Purge_rxabort or Purge_Txclear or purge_rxclear);
  Sleep(100);
 
  SetLength(t_pack,16,5);
 
  for i:=0 to 15 do begin t_pack[i][0]:=$ff; t_pack[i][1]:=$40+i+1; end;
 
  for i:=1 to 16 do BathState[i].started_procedure:=false;
{  t_pack[1]:=$41;   // <<4 num
  t_pack[2]:=$81;   // <<KZ S1    команда, жемчуг, галочки
  t_pack[3]:=$48;   // <<T2 T3    температура
  t_pack[4]:=$15;   // <<S2 T1    галочки, температура}
 
  FreeOnTerminate:=True;
  end;
  inherited Create(False);
end;
 
procedure TComThread.SetProtocolSettings(const p_pause,p_pause2,p_repeat:byte);
begin
  protocol_pause:=p_pause;
  protocol_pause2:=p_pause2;
  protocol_repeat:=p_repeat;
end;
 
procedure TComThread.Read();
var errs,kols:dword;
begin
// REsive:='';
  if port_exist then
  begin
 OverRead.hEvent := CreateEvent(nil, True, False, nil);
 if OverRead.hEvent = Null then
  raise Exception.Create('Error creating read event');
 
 begin
  if not ClearCommError(hPort, Errs, @Stat) then
   raise Exception.Create('Error clearing port');
 
 
  Kols := Stat.cbInQue;
  rbuflen:=Kols;
//  SetLength(Rbuffer,Kols);
  if Kols > 0 then
  begin
       ReadFile(hPort, RBuffer, Kols, Kols, @OverRead)
  end;
 end;
  end;
end;
 
destructor TComThread.Free();
begin
   CloseHandle(hPort);
end;
 
procedure TComThread.testpack;
var t:array of byte;
begin
 WriteP(t_pack[last_pack]);
end;
 
procedure TComThread.Stop(num:byte);
begin
 if port_exist then
 begin
 while not readflag do;
 readflag:=true;
// t_pack[1]:=$40+num;
  last_pack:=num-1;
 t_pack[num-1][2]:=(1<<7) + (t_pack[num-1][2] and $3f);
 testpack;
{ Read();
 Parse();}
 readflag:=false;
{ Sleep(pause);}
 
 end;
end;
 
procedure TComThread.SetParams(num:byte; mode,mode2,zhem_levelset, t23,t1:byte);
var i:byte;
begin
 if port_exist then
 begin
  while not readflag do;
  readflag:=true;
//  t_pack[1]:=$40+num;
  last_pack:=num-1;
  t_pack[num-1][2]:=(t_pack[num-1][2] and $c0)+(zhem_levelset<<4)+mode;
  t_pack[num-1][3]:=t23;
  t_pack[num-1][4]:=(mode2<<4)+t1;
 
  for i:=1 to protocol_repeat do
  begin
    testpack;
    Sleep(protocol_pause2);
  end;
 
  readflag:=false;
 end;
end;
 
procedure TComThread.Start(num:byte);
begin
 while not readflag do;
 readflag:=true;
 //t_pack[1]:=$40+num;
 last_pack:=num-1;
 t_pack[num-1][2]:=(1<<6)+ (t_pack[num-1][2] and $3f);
 testpack;
 {Read();
 Parse();
 Sleep(pause);}
 readflag:=false;
end;