138 lines
6.8 KiB
Rexx
Executable File
138 lines
6.8 KiB
Rexx
Executable File
#!@OOREXX_SHEBANG_PROGRAM@
|
|
/*----------------------------------------------------------------------------*/
|
|
/* */
|
|
/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */
|
|
/* Copyright (c) 2005-2014 Rexx Language Association. All rights reserved. */
|
|
/* */
|
|
/* This program and the accompanying materials are made available under */
|
|
/* the terms of the Common Public License v1.0 which accompanies this */
|
|
/* distribution. A copy is also available at the following address: */
|
|
/* https://www.oorexx.org/license.html */
|
|
/* */
|
|
/* Redistribution and use in source and binary forms, with or */
|
|
/* without modification, are permitted provided that the following */
|
|
/* conditions are met: */
|
|
/* */
|
|
/* Redistributions of source code must retain the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer. */
|
|
/* Redistributions in binary form must reproduce the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer in */
|
|
/* the documentation and/or other materials provided with the distribution. */
|
|
/* */
|
|
/* Neither the name of Rexx Language Association nor the names */
|
|
/* of its contributors may be used to endorse or promote products */
|
|
/* derived from this software without specific prior written permission. */
|
|
/* */
|
|
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
|
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
|
|
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
|
|
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
|
|
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
|
|
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
|
|
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
|
|
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
|
|
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
|
|
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
|
|
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
|
|
/* */
|
|
/*----------------------------------------------------------------------------*/
|
|
/****************************************************************************/
|
|
/* Name: philfork.rex */
|
|
/* Type: Open Object Rexx Script */
|
|
/* */
|
|
/* Description: Philosophers' Forks: Console window version */
|
|
/* */
|
|
/****************************************************************************/
|
|
|
|
|
|
/*---------------------- main logic ----------------------------------*/
|
|
|
|
arg parms
|
|
if parms = '' then parms = '8 6 any 2' /* default values */
|
|
parse var parms psleep peat pside prepeats
|
|
T.eat = peat
|
|
T.sleep = psleep
|
|
T.veat = trunc(peat / 2)
|
|
T.vsleep = trunc(psleep / 2)
|
|
if pside = 'L' then T.side = 100 /* left fork first */
|
|
else if pside = 'R' then T.side = 0 /* right */
|
|
else T.side = 50 /* random */
|
|
T.repeats = prepeats
|
|
|
|
f1 = .fork~new(1) /* create 5 forks */
|
|
f2 = .fork~new(2)
|
|
f3 = .fork~new(3)
|
|
f4 = .fork~new(4)
|
|
f5 = .fork~new(5)
|
|
p1 = .phil~new(1,f5,f1) /* create 5 philos. */
|
|
p2 = .phil~new(2,f1,f2)
|
|
p3 = .phil~new(3,f2,f3)
|
|
p4 = .phil~new(4,f3,f4)
|
|
p5 = .phil~new(5,f4,f5)
|
|
|
|
m1 = p1~start("run",T.) /* run 5 philsophers*/
|
|
m2 = p2~start("run",T.)
|
|
m3 = p3~start("run",T.)
|
|
m4 = p4~start("run",T.)
|
|
m5 = p5~start("run",T.)
|
|
|
|
m1~result /* wait for finish */
|
|
m2~result
|
|
m3~result
|
|
m4~result
|
|
m5~result
|
|
return 0
|
|
|
|
/*---------------------- philosopher ---------------------------------*/
|
|
|
|
::class phil /*** philosophers ***/
|
|
|
|
::method init /* initialize */
|
|
expose num rfork lfork out /* - store forks */
|
|
use arg num, rfork, lfork
|
|
out = ' '~copies(15*num-14)
|
|
|
|
::method run /* run the philosop.*/
|
|
expose num rfork lfork out
|
|
use arg T.
|
|
x = random(1,100,time('S')*num)
|
|
say out 'Philosopher-'num
|
|
do i=1 to T.repeats /* - run the loop */
|
|
stime = random(T.sleep-T.vsleep,T.sleep+T.vsleep)
|
|
say out 'Sleep-'stime
|
|
rc=SysSleep(stime) /* - sleep */
|
|
say out 'Wait'
|
|
if random(1,100) < T.side then do /* - pick up forks */
|
|
lfork~pickup(1,'left',num)
|
|
rfork~pickup(2,'right',num)
|
|
end
|
|
else do /* - same, right */
|
|
rfork~pickup(1,'right',num)
|
|
lfork~pickup(2,'left',num)
|
|
end
|
|
etime = random(T.eat-T.veat,T.eat+T.veat)
|
|
say out 'Eat-'etime
|
|
rc=SysSleep(etime) /* - eat */
|
|
lfork~laydown(num) /* - lay down forks */
|
|
rfork~laydown(num)
|
|
end
|
|
say out 'Done' /* loop finished */
|
|
return 1
|
|
|
|
/*---------------------- fork ----------------------------------------*/
|
|
|
|
::class fork /*** forks **********/
|
|
|
|
::method init /* initialize */
|
|
expose used
|
|
used = 0 /* - forks are free */
|
|
|
|
::method pickup /* pickup the fork */
|
|
expose used
|
|
guard on when used = 0 /* - wait until free*/
|
|
used = 1 /* - set occupied */
|
|
|
|
::method laydown unguarded /* laydown the fork */
|
|
expose used
|
|
used = 0 /* - set to free */
|