/* rexx ****************************************************************00010000
petri net simulator 00020000
***********************************************************************/00030000
call petriTest; 00040000
exit 00050000
00060000
petriTest: procedure expose m. 00070000
call petriIni 00080000
call petriNewTrans 't1', 'p1', 'p2 p3', 'say "firing t1"' 00090001
call petriNewTrans 't2', 'p2', 'p4', 'say "firing t2"' 00100001
call petriNewTrans 't3', 'p4', 'p1' 00110001
call petriNewTrans 't4', 'p3 p3', 'say "firing t4"' 00120001
call petriSetPlace 'p1', 1 00130001
p1 = 'PETRI.PLACE.p1' 00140001
p2 = 'PETRI.PLACE.p2' 00150001
p3 = 'PETRI.PLACE.p3' 00160001
p4 = 'PETRI.PLACE.p4' 00170001
do r = 1 to 10 00180000
say 'fireEE' r 'state' m.p1 m.p2 m.p3 m.p4 00190001
if petriFireEE() < 1 then 00200000
leave 00210000
end 00220000
return 00230000
endProcedure petriTest 00240000
00250000
petriIni: procedure expose m. 00260000
m.petri.place = '' 00270001
m.petri.trans = '' 00280001
return 00290000
endprocedure petriIni 00300000
00310000
petriSetPlace: procedure expose m. 00320001
parse arg nm, val 00330001
m.petri.place.nm = val 00340001
if symbol("m.petri.place.nm") ^= "VAR" then 00350001
m.petri.place = m.petri.place nm 00360001
return 00370001
endProcedure petriSetPlace 00380001
00390001
petriNewPlaces: procedure expose m. 00400001
parse arg names 00410001
do nx=1 to words(names) 00420001
nm = word(names, nx) 00430001
if symbol("m.petri.place.nm") ^= "VAR" then do 00440001
m.petri.place.nm = 0 00450001
m.petri.place = m.petri.place nm 00460001
end 00470001
end 00480001
return nm 00490001
endProcedure petriNewPlace 00500000
00510000
petriNewTrans: procedure expose m. 00520000
parse arg nm, i, o, fi 00530001
m.petri.trans = m.petri.trans nm 00540001
m.petri.trans.nm.in = i 00550001
m.petri.trans.nm.out = o 00560001
m.petri.trans.nm.fire = fi 00570001
call petriNewPlaces i o 00580001
return nn 00590000
endProcedure petriNewTrans 00600000
00610000
petriFireEE: procedure expose m. 00620000
fx = 0 00630000
do tx=1 to words(m.petri.trans) 00640001
t1 = word(m.petri.trans, tx) 00650001
if petriEnabled(t1) then do 00660001
call petriFire t1 00670001
fx = fx + 1 00680000
end 00690000
end 00700000
return fx 00710000
endProcedure petriFireEE 00720000
00730001
petriEnabled: procedure expose m. 00740000
parse arg tx 00750000
plcs = m.petri.trans.tx.in 00760001
do px=1 by 1 00770001
p = word(plcs, px) 00780001
if p = '' then 00790001
return 1 00800001
if symbol("c.p") = 'VAR' then 00810001
c.p = c.p - 1 00820001
else 00830001
c.p = m.petri.place.p - 1 00840001
if c.p < 0 then 00850001
return 0 00860001
end 00870000
endProcedure petriEnabled 00880000
00890000
petriFire: procedure expose m. 00900000
parse arg tx 00910000
say '*** firing trans' tx 00920001
if m.petri.trans.tx.fire <> '' then 00930001
interpret m.petri.trans.tx.fire 00940001
plcs = m.petri.trans.tx.in 00950000
do px=1 by 1 00960000
p = word(plcs, px) 00970000
if p = '' then 00980000
leave 00990000
if m.petri.place.p < 1 then 01000000
call err 'fire' tx 'underflow place' p m.petri.place.p 01010000
m.petri.place.p = m.petri.place.p - 1 01020000
end 01030000
plcs = m.petri.trans.tx.out 01040000
do px=1 by 1 01050000
p = word(plcs, px) 01060000
if p = '' then 01070000
leave 01080000
m.petri.place.p = m.petri.place.p + 1 01090000
end 01100000
return 01110000
endProcedure petriEnabled 01120000