[# the atomic-primitives evaluation: compare-and-swap and atomic
increment built from 'exchange' (which builds locks) alone — the
demonstration that closed "further atomic primitives": anything a new
primitive would express can be built from exchange and wait #]
make int64 lock
make int64 value
make string "\n" nl
define acquire
set 0
home
mark again
set 1
move lock
exchange
compare 0
set 0
home
jump again when different
return
end
define release
set 0
move lock
exchange
return
end
[# compare-and-swap: when value holds expected, store newv.
returns the value value held before the attempt #]
define cas int64 expected int64 newv result int64
make int64 old
call acquire
move value
read
move old
write
move expected
read
push
move old
read
compare
jump skip when different
move newv
read
move value
write
mark skip
call release
move old
read
return
end
define worker
make int64 k
make int64 seen
set 0
move k
write
set 0
home
mark w
move k
read
compare 50
jump done when greater-or-equal
set 0
home
mark retry
move value
read
move seen
write
move seen
read
push
move seen
read
add 1
push
call cas
push
move seen
read
compare
set 0
home
jump retry when different
move k
read
add 1
move k
write
set 0
home
jump w
mark done
return
end
define main
set 7
move value
write
set 5
push
set 9
push
call cas
compare 7
jump bad when different
move value
read
compare 7
jump bad when different
spawn worker
spawn worker
wait
move value
read
output
address nl
output text
return
mark bad
set 1
stop
end