thread-ring Pascal Free Pascal program
source code
{ The Computer Language Benchmarks Game
http://benchmarksgame.alioth.debian.org
contributed by Marc Weustink
}
{$mode objfpc}
program thread_ring;
uses
PThreads;
var
SemList: array[1..503] of TSemaphore;
ThreadAttr: TThreadAttr;
ThreadFuncAddr: TStartRoutine;
FinishedSem: TSemaphore;
Count: Integer;
function ThreadFunc(AIndex: PtrInt): Pointer; cdecl;
var
MySem, NextSem: PSemaphore;
Id: TThreadID;
begin
MySem := @SemList[AIndex];
if AIndex < High(SemList)
then begin
NextSem := MySem+1;
sem_init(NextSem, 0, 0);
pthread_create(@Id, @ThreadAttr, ThreadFuncAddr, Pointer(AIndex+1));
end
else NextSem := @SemList[Low(SemList)];
repeat
sem_wait(MySem);
if Count = 0 then begin
WriteLn(Aindex);
sem_post(FinishedSem);
end
else begin
Dec(Count);
sem_post(NextSem);
end;
until False;
end;
var
n: Integer;
Id: TThreadId;
begin
Val(paramstr(1), count, n);
if n <> 0 then exit;
sem_init(SemList[Low(SemList)], 0, 1);
sem_init(FinishedSem, 0, 0);
pthread_attr_init(@ThreadAttr);
pthread_attr_setdetachstate(@ThreadAttr, 1);
pthread_attr_setstacksize(@ThreadAttr, 1024 * 16);
ThreadFuncAddr := TStartRoutine(@ThreadFunc);
pthread_create(@Id, @ThreadAttr, ThreadFuncAddr, Pointer(PtrUInt(Low(SemList))));
sem_wait(FinishedSem);
end.
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
Free Pascal Compiler version 3.0.4 [2017/10/03] for x86_64
Sun, 10 Dec 2017 05:46:15 GMT
MAKE:
mv threadring.fpascal threadring.pas
/opt/src/fpc-3.0.4/bin/fpc -FuInclude/fpascal -XXs -O4 -Tlinux -oFPASCAL_RUN threadring.pas
Free Pascal Compiler version 3.0.4 [2017/10/03] for x86_64
Copyright (c) 1993-2017 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling threadring.pas
threadring.pas(40,27) Error: Incompatible type for arg no. 1: Got "sem_t", expected "psem_t"
threadring.pas(57,33) Error: Incompatible type for arg no. 1: Got "sem_t", expected "psem_t"
threadring.pas(58,23) Error: Incompatible type for arg no. 1: Got "sem_t", expected "psem_t"
threadring.pas(67,23) Error: Incompatible type for arg no. 1: Got "sem_t", expected "psem_t"
threadring.pas(69) Fatal: There were 4 errors compiling module, stopping
Fatal: Compilation aborted
Error: /opt/src/fpc-3.0.4/bin/ppcx64 returned an error exitcode
/home/dunham/benchmarksgame/nanobench/makefiles/u64q.programs.Makefile:463: recipe for target 'threadring.fpascal_run' failed
make: [threadring.fpascal_run] Error 1 (ignored)
mv FPASCAL_RUN threadring.fpascal_run
mv: cannot stat 'FPASCAL_RUN': No such file or directory
/home/dunham/benchmarksgame/nanobench/makefiles/u64q.programs.Makefile:463: recipe for target 'threadring.fpascal_run' failed
make: [threadring.fpascal_run] Error 1 (ignored)
rm threadring.pas
0.07s to complete and log all make actions
COMMAND LINE:
./threadring.fpascal_run 500000
MAKE ERROR