cut and fail
We implement this semantics with some careful attention to how threads are killed:
| Program | ::= |
Definition … Expression | a-program (defns exp1) |
| Definition | ::= |
define Identifier = (
Identifier … ) Expression |
proc-definition (id bvars body) |
| Expression | ::= |
Number | const-exp (num) |
::= |
Identifier | var-exp (var) |
|
::= |
Unop(Expression) |
unop-exp (op exp1) |
|
::= |
Binop(Expression
, Expression) |
binop-exp (op exp1 exp2) |
|
::= |
if Expression
then Expression
else Expression |
if-exp (exp1 exp2 exp3) |
|
::= |
(Expression
Expression …
) |
call-exp (rator rands) |
|
::= |
choose (Expression
, Expression) |
choose-exp (exp1 exp2) |
|
::= |
choose/cut (Expression
, Expression) |
choose/cut-exp (exp1 exp2) |
|
::= |
fail |
fail-exp () |
|
::= |
begin Expression
Expression
…
end |
begin-exp (exp exps) |
|
::= |
cas (Expression ,
Expression ,
Expression) |
cas-exp (exp1 exp2 exp3) |
|
| Unop | ::= |
newref |
op-newref () |
::= |
deref |
op-deref () |
|
| Binop | ::= |
setref |
op-setref () |
::= |
+ |
op-plus () |
|
::= |
- |
op-minus () |
|
::= |
* |
op-times () |
|
::= |
/ |
op-div () |
|
::= |
< |
op-less() |
|
::= |
= |
op-equal () |
|
::= |
> |
op-greater () |
Premature commitment may cause programs to fail:
define primesearch = proc (n)
choose/cut (if (primetest n)
then n
else fail,
(primesearch +(n,1)))
define primetest = proc (n)
if (divides 2 n)
then false
else (primetests 3 n)
define primetests = proc (d n)
if >(*(d,d),n)
then true
else if (divides d n)
then false
else (primetests +(d,2) n)
define divides = proc (d n)
(dividesloop 1 d n)
define dividesloop = proc (q d n)
if =(*(q,d),n)
then true
else if >(*(q,d),n)
then false
else (dividesloop +(q,1) d n)
define different = proc (n except)
(different2 n except (primesearch n))
define different2 = proc (n except candidate)
if =(except, candidate)
then fail
else candidate
(different 8 11)
Using two threads to compute a product:
define product = proc (m n)
(productFork m n newref(1) newref(false))
define productFork = proc (m n refProduct refDone)
begin choose((productLoop m
(avg m n)
refProduct),
(productLoop (avg m n)
n
refProduct));
if deref(refDone)
then deref(refProduct)
else begin setref(refDone,true);
fail
end
end
define productLoop = proc (m n refProduct)
if <(m,n)
then begin setref(refProduct,
*(m,deref(refProduct)));
(productLoop +(m,1) n refProduct)
end
else 0
define avg = proc (m n) /(+(m,n),2)
(product 1 10)
The correct answer is 9! = 362880.
Let's compute 20!.
define product = proc (m n)
(productFork m n newref(1) newref(false))
define productFork = proc (m n refProduct refDone)
begin choose((productLoop m
(avg m n)
refProduct),
(productLoop (avg m n)
n
refProduct));
if deref(refDone)
then deref(refProduct)
else begin setref(refDone,true);
fail
end
end
define productLoop = proc (m n refProduct)
if <(m,n)
then begin setref(refProduct,
*(m,deref(refProduct)));
(productLoop +(m,1) n refProduct)
end
else 0
define avg = proc (m n) /(+(m,n),2)
(product 1 21)
The correct answer is 20! = 2432902008176640000, but we get an error when all threads fail. Why?
We can use cas (compare-and-swap)
to repair the race on refDone:
define product = proc (m n)
(productFork m n newref(1) newref(0))
define productFork = proc (m n refProduct refDone)
begin choose((productLoop m
(avg m n)
refProduct),
(productLoop (avg m n)
n
refProduct));
(productJoin refProduct refDone)
end
define productJoin = proc (refProduct refDone)
if =(0,deref(refDone))
then if =(0,cas(refDone,0,1))
then fail
else (productJoin refProduct refDone)
else deref(refProduct)
define productLoop = proc (m n refProduct)
if <(m,n)
then begin setref(refProduct,
*(m,deref(refProduct)));
(productLoop +(m,1) n refProduct)
end
else 0
define avg = proc (m n) /(+(m,n),2)
(product 1 21)
That works pretty reliably. Let's test it 1000 times:
define product = proc (m n)
(productFork m n newref(1) newref(0))
define productFork = proc (m n refProduct refDone)
begin choose((productLoop m
(avg m n)
refProduct),
(productLoop (avg m n)
n
refProduct));
(productJoin refProduct refDone)
end
define productJoin = proc (refProduct refDone)
if =(0,deref(refDone))
then if =(0,cas(refDone,0,1))
then fail
else (productJoin refProduct refDone)
else deref(refProduct)
define productLoop = proc (m n refProduct)
if <(m,n)
then begin setref(refProduct,
*(m,deref(refProduct)));
(productLoop +(m,1) n refProduct)
end
else 0
define avg = proc (m n) /(+(m,n),2)
define loop = proc (m n k expected)
if >(k,0)
then if =((product m n), expected)
then (loop m n -(k,1) expected)
else -(0,k)
else expected
(loop 1 21 1000 2432902008176640000)
Even though that code appears to work, it still contains a latent bug caused by a race condition. Here is one way to fix it:
define product = proc (m n)
(productFork m n newref(1) newref(0))
define productFork = proc (m n refProduct refDone)
begin choose((productLoop m
(avg m n)
refProduct),
(productLoop (avg m n)
n
refProduct));
(productJoin refProduct refDone)
end
define productJoin = proc (refProduct refDone)
if =(0,deref(refDone))
then if =(0,cas(refDone,0,1))
then fail
else (productJoin refProduct refDone)
else deref(refProduct)
define productLoop = proc (m n refProduct)
if <(m,n)
then begin (productLoop2 m
n
refProduct
deref(refProduct));
(productLoop +(m,1) n refProduct)
end
else 0
define productLoop2 = proc (m n refProduct p)
if =(p,cas(refProduct,p,*(m,p)))
then true
else (productLoop2 m
n
refProduct
deref(refProduct))
define avg = proc (m n) /(+(m,n),2)
(product 1 21)
Last updated 7 April 2008.