140 lines
3.1 KiB
Plaintext
140 lines
3.1 KiB
Plaintext
// This is a BCPL implementation of the Rosettacode synchronous
|
|
// concurrency test using BCPL coroutines and a coroutine implementation
|
|
// of a Occum-style channels.
|
|
// BCPL is freely available from www.cl.cam.ac.uk/users/mr10
|
|
|
|
SECTION "coinout"
|
|
|
|
GET "libhdr.h"
|
|
|
|
GLOBAL {
|
|
tracing: ug
|
|
}
|
|
|
|
LET start() = VALOF
|
|
{ LET argv = VEC 50
|
|
LET in_co, out_co = 0, 0
|
|
LET channel = 0
|
|
LET filename = "input.txt"
|
|
|
|
UNLESS rdargs("-f,-t/S", argv, 50) DO
|
|
{ writef("Bad arguments for coinout*n")
|
|
RESULTIS 0
|
|
}
|
|
|
|
IF argv!0 DO filename := argv!0 // -f the source file
|
|
tracing := argv!1 // -t/S tracing option
|
|
|
|
in_co := initco(infn, 500, @channel)
|
|
out_co := initco(outfn, 500, @channel)
|
|
|
|
UNLESS in_co & out_co DO
|
|
{ writef("Trouble creating the coroutines*n")
|
|
GOTO fin
|
|
}
|
|
|
|
IF tracing DO writef("*nBoth in and out coroutines created*n*n")
|
|
|
|
callco(in_co, filename)
|
|
|
|
fin:
|
|
IF in_co DO deleteco(in_co)
|
|
IF out_co DO deleteco(out_co)
|
|
|
|
IF tracing DO writef("Both in and out coroutines deleted*n*n")
|
|
|
|
RESULTIS 0
|
|
}
|
|
|
|
AND readline(line) = VALOF
|
|
{ LET ch, i = 0, 0
|
|
line%0 := 0
|
|
|
|
{ ch := rdch()
|
|
IF ch=endstreamch RESULTIS FALSE
|
|
i := i+1
|
|
line%0, line%i := i, ch
|
|
IF ch='*n' | i=255 BREAK
|
|
} REPEAT
|
|
|
|
RESULTIS TRUE
|
|
}
|
|
|
|
AND infn(args) BE
|
|
{ LET channelptr = args!0
|
|
LET name = cowait() // Get the file name
|
|
LET instream = findinput(name)
|
|
LET line = VEC 256/bytesperword
|
|
|
|
UNLESS instream DO
|
|
{ writef("*nTrouble with file: %s*n", name)
|
|
RETURN
|
|
}
|
|
|
|
selectinput(instream)
|
|
|
|
{ LET ok = readline(line)
|
|
UNLESS ok BREAK
|
|
IF tracing DO
|
|
writef("inco: Sending a line to outco*n")
|
|
cowrite(channelptr, line)
|
|
} REPEAT
|
|
|
|
IF tracing DO
|
|
writef("inco: Sending zero to outco*n")
|
|
|
|
writef("*nNumber of lines written was %n*n", cowrite(channelptr, 0))
|
|
|
|
endstream(instream)
|
|
}
|
|
|
|
AND outfn(args) BE
|
|
{ LET channelptr = args!0
|
|
LET linecount = 0
|
|
|
|
{ LET line = coread(channelptr)
|
|
UNLESS line BREAK
|
|
IF tracing DO writef("outfn: Received a line*n")
|
|
writes(line)
|
|
linecount := linecount + 1
|
|
} REPEAT
|
|
|
|
IF tracing DO
|
|
writef("outfn: Received zero, so sent count=%n back to inco*n",
|
|
linecount)
|
|
|
|
cowait(linecount)
|
|
}
|
|
|
|
// The following functions are a implementation of Occum-style channels
|
|
// using coroutines.
|
|
|
|
// The first coroutine to request a transfer through a channel becomes
|
|
// suspended and the second causes the data to be transfers and then allows
|
|
// both coroutines to resume (in some order). The channel word is either
|
|
// zero or points to a suspended (read or write) cocoutine.
|
|
|
|
// The use of resumeco in coread is somewhat subtle!
|
|
|
|
AND coread(ptr) = VALOF
|
|
{ LET cptr = !ptr
|
|
TEST cptr
|
|
THEN { !ptr := 0 // Clear the channel word
|
|
RESULTIS resumeco(cptr, currco)
|
|
}
|
|
ELSE { !ptr := currco // Set channel word to this coroutine
|
|
RESULTIS cowait() // Wait for value from cowrite
|
|
}
|
|
}
|
|
|
|
AND cowrite(ptr, val) BE
|
|
{ LET cptr = !ptr
|
|
TEST cptr
|
|
THEN { !ptr := 0
|
|
callco(cptr, val) // Send val to coread
|
|
}
|
|
ELSE { !ptr := currco
|
|
callco(cowait(), val)
|
|
}
|
|
}
|