Atomic updates: Difference between revisions
m
→{{header|PicoLisp}}: evolution.
m (→{{header|PicoLisp}}: evolution.) |
|||
Line 2,634:
child processes to handle the tasks, as this is the standard way
for general PicoLisp applications.
<lang PicoLisp>(
(de *Buckets . 15) # Number of buckets
# E/R model
(class +Bucket +Entity)
(rel key (+Key +Number)) # Key 1 .. *Buckets
(rel val (+Number)) # Value 1 .. 999
(pool (tmp "buckets.db"))
# Create *Buckets buckets with values between 1 and 999
Line 2,651 ⟶ 2,650:
(new T '(+Bucket) 'key K 'val (rand 1 999)) )
(commit)
# Pick a random bucket
(de pickBucket ()
(db 'key '+Bucket (rand 1 *Buckets)) )
▲# Create process
(unless (fork)▼
(seed *Pid) # Ensure local random sequence▼
(let (B1 (pickBucket) B2 (pickBucket)) # Pick two buckets 'B1' and 'B2'▼
(unless (== B1 B2) # Found two different ones?▼
(dbSync) # Atomic DB operation▼
(let (V1 (; B1 val) V2 (; B2 val)) # Get current values▼
(QuadFunction B1 V1 B2 V2) )▼
(commit 'upd) ) ) ) ) ) # Close transaction▼
# First process
((> V1 V2)▼
(dbSync)
(let (V1 (
((
(
(dec> B2 'val)
# Second process
(unless (fork)
(seed *Pid) # Ensure local random sequence
(let (B1 (pickBucket) B2 (pickBucket)) # Pick two buckets 'B1' and 'B2'
▲ ((> V1 V2 0)
(
▲ (dec> B2 'val) )
(let (
(inc> B1 'val) # Redistribute them
((> V2 V1 0)
(inc> B2 'val)
(dec> B1 'val) ) ) )
(wait 1) ) ) ) )
# Third process
(unless (fork)
(loop
(dbSync) # Atomic DB operation
(let Lst (collect 'key '+Bucket) # Get all buckets
(for This Lst # Print current values
(printsp (: val)) )
(prinl # and total sum
"-- Total: "
(sum '((This) (: val)) Lst) ) )
(rollback)
(wait 2000) ) ) # Sleep two seconds
(wait)</lang>
| |||