aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

101
Task/Dining-philosophers/Pascal/dining-philosophers-1.pas Normal file
View file

@ -0,0 +1,101 @@
program dining_philosophers;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, SyncObjs;
const
PHIL_COUNT = 5;
LIFESPAN = 7;
DELAY_RANGE = 950;
DELAY_LOW = 50;
PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
type
TFork = TCriticalSection;
TPhilosopher = class;
var
Forks: array[1..PHIL_COUNT] of TFork;
Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
type
TPhilosopher = class(TThread)
private
FName: string;
FFirstFork, FSecondFork: TFork;
protected
procedure Execute; override;
public
constructor Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
end;
procedure TPhilosopher.Execute;
var
LfSpan: Integer = LIFESPAN;
begin
while LfSpan > 0 do
begin
Dec(LfSpan);
WriteLn(FName, ' sits down at the table');
FFirstFork.Acquire;
FSecondFork.Acquire;
WriteLn(FName, ' eating');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
FSecondFork.Release;
FFirstFork.Release;
WriteLn(FName, ' is full and leaves the table');
if LfSpan = 0 then
continue;
WriteLn(FName, ' thinking');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
WriteLn(FName, ' is hungry');
end;
end;
constructor TPhilosopher.Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
begin
inherited Create(True);
FName := aName;
if aForkIdx1 < aForkIdx2 then
begin
FFirstFork := Forks[aForkIdx1];
FSecondFork := Forks[aForkIdx2];
end
else
begin
FFirstFork := Forks[aForkIdx2];
FSecondFork := Forks[aForkIdx1];
end;
end;
procedure DinnerBegin;
var
I: Integer;
Phil: TPhilosopher;
begin
for I := 1 to PHIL_COUNT do
Forks[I] := TFork.Create;
for I := 1 to PHIL_COUNT do
Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], I, Succ(I mod PHIL_COUNT));
for Phil in Philosophers do
Phil.Start;
end;
procedure WaitForDinnerOver;
var
Phil: TPhilosopher;
Fork: TFork;
begin
for Phil in Philosophers do
begin
Phil.WaitFor;
Phil.Free;
end;
for Fork in Forks do
Fork.Free;
end;
begin
Randomize;
DinnerBegin;
WaitForDinnerOver;
end.

115
Task/Dining-philosophers/Pascal/dining-philosophers-2.pas Normal file
View file

@ -0,0 +1,115 @@
program dining_philosophers2;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, SyncObjs;
const
PHIL_COUNT = 5;
LIFESPAN = 7;
DELAY_RANGE = 950;
DELAY_LOW = 50;
PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
type
TFork = TCriticalSection;
TPhilosopher = class;
var
Forks: array[1..PHIL_COUNT] of TFork;
Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
type
TPhilosopher = class(TThread)
private
FName: string;
FLeftFork, FRightFork: TFork;
FLefty: Boolean;
procedure SetLefty(aValue: Boolean);
procedure SwapForks;
protected
procedure Execute; override;
public
constructor Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
property Lefty: Boolean read FLefty write SetLefty;
end;
procedure TPhilosopher.SetLefty(aValue: Boolean);
begin
if Lefty = aValue then
exit;
FLefty := aValue;
SwapForks;
end;
procedure TPhilosopher.SwapForks;
var
Fork: TFork;
begin
Fork := FLeftFork;
FLeftFork := FRightFork;
FRightFork := Fork;
end;
procedure TPhilosopher.Execute;
var
LfSpan: Integer = LIFESPAN;
begin
while LfSpan > 0 do
begin
Dec(LfSpan);
WriteLn(FName, ' sits down at the table');
FLeftFork.Acquire;
FRightFork.Acquire;
WriteLn(FName, ' eating');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
FRightFork.Release;
FLeftFork.Release;
WriteLn(FName, ' is full and leaves the table');
if LfSpan = 0 then
continue;
WriteLn(FName, ' thinking');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
WriteLn(FName, ' is hungry');
end;
end;
constructor TPhilosopher.Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
begin
inherited Create(True);
FName := aName;
FLeftFork := Forks[aForkIdx1];
FRightFork := Forks[aForkIdx2];
end;
procedure DinnerBegin;
var
I: Integer;
Phil: TPhilosopher;
begin
for I := 1 to PHIL_COUNT do
Forks[I] := TFork.Create;
for I := 1 to PHIL_COUNT do
Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], I, Succ(I mod PHIL_COUNT));
Philosophers[Succ(Random(5))].Lefty := True;
for Phil in Philosophers do
Phil.Start;
end;
procedure WaitForDinnerOver;
var
Phil: TPhilosopher;
Fork: TFork;
begin
for Phil in Philosophers do
begin
Phil.WaitFor;
Phil.Free;
end;
for Fork in Forks do
Fork.Free;
end;
begin
Randomize;
DinnerBegin;
WaitForDinnerOver;
end.

101
Task/Dining-philosophers/Pascal/dining-philosophers-3.pas Normal file
View file

@ -0,0 +1,101 @@
program dining_philosophers3;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, SyncObjs;
const
PHIL_COUNT = 5;
LIFESPAN = 7;
DELAY_RANGE = 950;
DELAY_LOW = 50;
PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
type
TFork = TCriticalSection;
TPhilosopher = class;
var
Forks: array[1..PHIL_COUNT] of TFork;
Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
type
TPhilosopher = class(TThread)
private
FName: string;
FLeftFork, FRightFork: TFork;
protected
procedure Execute; override;
public
constructor Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
end;
procedure TPhilosopher.Execute;
var
LfSpan: Integer = LIFESPAN;
begin
while LfSpan > 0 do
begin
Dec(LfSpan);
WriteLn(FName, ' sits down at the table');
repeat
FLeftFork.Acquire;
if not FRightFork.TryEnter then
begin
FLeftFork.Release;
Sleep(Random(DELAY_RANGE));
continue;
end;
break;
until False;
WriteLn(FName, ' eating');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
FRightFork.Release;
FLeftFork.Release;
WriteLn(FName, ' is full and leaves the table');
if LfSpan = 0 then
continue;
WriteLn(FName, ' thinking');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
WriteLn(FName, ' is hungry');
end;
end;
constructor TPhilosopher.Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
begin
inherited Create(True);
FName := aName;
FLeftFork := Forks[aForkIdx1];
FRightFork := Forks[aForkIdx2];
end;
procedure DinnerBegin;
var
I: Integer;
Phil: TPhilosopher;
begin
for I := 1 to PHIL_COUNT do
Forks[I] := TFork.Create;
for I := 1 to PHIL_COUNT do
Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], I, Succ(I mod PHIL_COUNT));
for Phil in Philosophers do
Phil.Start;
end;
procedure WaitForDinnerOver;
var
Phil: TPhilosopher;
Fork: TFork;
begin
for Phil in Philosophers do
begin
Phil.WaitFor;
Phil.Free;
end;
for Fork in Forks do
Fork.Free;
end;
begin
Randomize;
DinnerBegin;
WaitForDinnerOver;
end.

114
Task/Dining-philosophers/Pascal/dining-philosophers-4.pas Normal file
View file

@ -0,0 +1,114 @@
program dining_philosophers4;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, SyncObjs;
const
PHIL_COUNT = 5;
LIFESPAN = 7;
DELAY_RANGE = 950;
DELAY_LOW = 50;
PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
type
TFork = TCriticalSection;
TPhilosopher = class;
var
Forks: array[1..PHIL_COUNT] of TFork;
Philosophers: array[1..PHIL_COUNT] of TPhilosopher;
StilDining: Integer = 0;
procedure WaitForPlaceFree;
begin
repeat
if InterlockedIncrement(StilDining) > Pred(PHIL_COUNT) then
begin
InterlockedDecrement(StilDining);
Sleep(Random(DELAY_LOW));
continue;
end;
exit;
until False;
end;
procedure FreePlace;
begin
InterLockedDecrement(StilDining);
end;
type
TPhilosopher = class(TThread)
private
FName: string;
FLeftFork, FRightFork: TFork;
protected
procedure Execute; override;
public
constructor Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
end;
procedure TPhilosopher.Execute;
var
LfSpan: Integer = LIFESPAN;
begin
while LfSpan > 0 do
begin
Dec(LfSpan);
WaitForPlaceFree;
WriteLn(FName, ' sits down at the table');
FLeftFork.Acquire;
FRightFork.Acquire;
WriteLn(FName, ' eating');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
FRightFork.Release;
FLeftFork.Release;
FreePlace;
WriteLn(FName, ' is full and leaves the table');
if LfSpan = 0 then
continue;
WriteLn(FName, ' thinking');
Sleep(Random(DELAY_RANGE) + DELAY_LOW);
WriteLn(FName, ' is hungry');
end;
end;
constructor TPhilosopher.Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
begin
inherited Create(True);
FName := aName;
FLeftFork := Forks[aForkIdx1];
FRightFork := Forks[aForkIdx2];
end;
procedure DinnerBegin;
var
I: Integer;
Phil: TPhilosopher;
begin
for I := 1 to PHIL_COUNT do
Forks[I] := TFork.Create;
for I := 1 to PHIL_COUNT do
Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], I, Succ(I mod PHIL_COUNT));
for Phil in Philosophers do
Phil.Start;
end;
procedure WaitForDinnerOver;
var
Phil: TPhilosopher;
Fork: TFork;
begin
for Phil in Philosophers do
begin
Phil.WaitFor;
Phil.Free;
end;
for Fork in Forks do
Fork.Free;
end;
begin
Randomize;
DinnerBegin;
WaitForDinnerOver;
end.