Initial revision

lang/occam/test/Huffman.ocm

@@ -0,0 +1,193 @@
+def
+  bits.in.character	= 8,
+  number.of.characters= 1 << bits.in.character,
+  number.of.codes	= number.of.characters + 1,
+  character.mask	= not ((not 0) << bits.in.character):
+
+def
+  root = 0, size.of.tree = (2* number.of.codes)-1, not.a.node = size.of.tree:
+
+var
+  escape, weight[size.of.tree],
+  children[size.of.tree], parent[size.of.tree],
+  character[size.of.tree], representative[number.of.characters] :
+
+proc construct.tree =
+  -- Create a tree for the encoding in which every character is escaped
+  seq
+    escape := root
+    weight[escape] := 1
+    children[escape] := root		-- it is a leaf
+    seq ch= [0 for number.of.characters]
+      representative[ch] := not.a.node					:
+
+proc create.leaf(var new.leaf, value ch) =
+  -- Extend the tree by fision of the escape leaf into two new leaves
+  var new.escape:
+  seq
+    new.leaf		:= escape + 1
+    new.escape		:= escape + 2
+
+    children[escape]	:= new.leaf	-- escape is the new parent
+
+    weight[new.leaf]	:= 0
+    children[new.leaf]	:= root
+    parent[new.leaf]	:= escape
+    character[new.leaf]	:= ch
+    representative[ch /\ character.mask] := new.leaf
+
+    weight[new.escape]	:= 1
+    children[new.escape]:= root
+    parent[new.escape]	:= escape
+
+    escape		:= new.escape					:
+
+proc swap.trees(value i, j) =
+  -- Exchange disjoint sub-trees routed at i and j
+  proc swap.words(var p,q) =
+    -- Exchange values stored in p and q
+    var t:
+    seq
+      t := p
+      p := q
+      q := t								:
+
+  proc adjust.offspring(value i) =
+    -- Restore downstream pointers to node i
+    if
+      children[i] = root
+	representative[character[i] /\ character.mask] := i
+      children[i] <> root
+	seq child=[children[i] for 2]
+	  parent[child] := i						:
+  
+  seq
+    swap.words(children[i], children[j])
+    swap.words(character[i], character[j])
+    adjust.offspring(i)
+    adjust.offspring(j)							:
+
+proc increment.frequency(value ch) =
+  -- Adjust the weights of all relevant nodes to account for one more occurence
+  -- of the character ch, and adjust the shape of the tree if necessary
+  var node:
+  seq
+    if
+      representative[ch /\ character.mask] <> not.a.node
+	node := representative[ch /\ character.mask]
+      representative[ch /\ character.mask] = not.a.node
+        create.leaf(node, ch)
+    while node <> root
+      if
+	weight[node-1] > weight[node]
+	  seq
+	    weight[node] := weight[node] + 1
+	    node := parent[node]
+	weight[node-1] = weight[node]
+	  if i= [1 for (node-root)-1]
+	    weight[(node-i)-1] > weight[node]
+	      seq
+		swap.trees(node, node-i)
+		node := node-i
+    weight[root] := weight[root] + 1					:
+
+proc encode.character(chan output, value ch) =
+  -- Transmit the encoding of ch along output
+  def size.of.encoding = bits.in.character + (number.of.codes - 1) :
+  var encoding[size.of.encoding], length, node:
+  seq
+    if
+      representative[ch /\ character.mask] <> not.a.node
+	seq
+	  length := 0
+	  node := representative[ch /\ character.mask]
+      representative[ch /\ character.mask] = not.a.node
+	seq
+	  seq i=[0 for bits.in.character]
+	    encoding[i] := (ch >> i) /\ 1	-- i'th bit of unencoded ch
+	  length := bits.in.character
+	  node := escape
+    while node <> root
+      seq
+	encoding[length] := node - children[parent[node]]
+	length := length + 1
+	node := parent[node]
+    seq i= [1 for length]
+      output ! encoding[length-i]					:
+
+proc decode.character(chan input, var ch) =
+  -- Receive an encoding along input and store the corresponding character in ch
+  var node:
+  seq
+    node := root
+    while children[node] <> root
+      var bit:
+      seq
+	input ? bit
+	node := children[node] + bit
+    if
+      node < escape
+	ch := character[node]
+      node = escape
+	var bit:
+	seq
+	  input ? bit
+	  ch := -bit
+	  seq i= [2 for bits.in.character - 1]
+	    seq
+	      input ? bit
+	      ch := (ch << 1) \/ bit					:
+
+def end.of.message = -1:
+
+proc copy.encoding(chan source, sink) =
+  -- Read a stream of characters from source, until signalled on end.of.source,
+  -- and transmit their encodings in sequence along sink, followed by that of
+  -- end.of.message, maintaining throughout the encoding tree for the encoding
+  -- determined by the cumulative frequencies of the characters transmitted
+  var more.characters.expected:
+  seq
+    construct.tree
+    more.characters.expected := true
+    while more.characters.expected
+      var ch:
+      seq
+	source ? ch
+	if
+	  ch <> end.of.message
+	    seq
+	      encode.character(sink, ch)
+	      increment.frequency(ch)
+	  ch = end.of.message
+	    more.characters.expected := false
+    encode.character(sink, end.of.message)				:
+
+proc copy.decoding(chan source, sink) =
+  -- Read the encodings of a stream of characters, up to and including the
+  -- encoding of end.of.message, from source and transmit the corresponding
+  -- characters along sink, maintaining the encoding tree for encoding
+  -- determined by the cumulative frequencies of the characters received
+  var more.characters.expected:
+  seq
+    construct.tree
+    more.characters.expected := true
+    while more.characters.expected
+      var ch:
+      seq
+	decode.character(source, ch)
+	if
+	  ch <> end.of.message
+	    seq
+	      sink ! ch
+	      increment.frequency(ch)
+	  ch = end.of.message
+	    more.characters.expected:=false				:
+
+var choose:
+seq
+  input ? choose
+  if
+    choose='e'
+      copy.encoding(input, output)
+    choose='d'
+      copy.decoding(input, output)

lang/occam/test/READ_ME

@@ -0,0 +1 @@
+This directory only contains some Occam programs, not a testset.

lang/occam/test/aatob.ocm

@@ -0,0 +1,25 @@
+def otherwise=true:
+
+proc xxtoy(chan in, out, value x, y)=
+    var c:
+    seq
+	c:= not EOF
+	while c<>EOF
+	    seq
+		in ? c
+		if
+		    c=x
+			seq
+			    in ? c
+			    if
+				c=x
+				    out ! y
+				otherwise
+				    out ! x; c
+		    otherwise
+			out ! c
+:
+chan link:
+par
+    xxtoy(input, link, 'a', 'b')
+    xxtoy(link, output, 'b', 'c')

lang/occam/test/copy.ocm

@@ -0,0 +1,26 @@
+def N=10:
+
+proc copy(chan in, out)=
+	var char:
+	seq
+		char:='x'
+		while char<>EOF
+			seq
+				in ? char
+				out ! char
+:
+
+chan junk[N]:
+par
+	copy(input, junk[0])
+
+	par i=[0 FOR N-1]
+		copy(junk[i], junk[i+1])
+
+	var char:
+	seq
+		junk[N-1] ? char
+		while char<>EOF
+			seq
+				output ! char
+				junk[N-1] ? char

lang/occam/test/key.ocm

@@ -0,0 +1,14 @@
+#include "dec.ocm"
+var ch:
+seq
+	output ! RAW
+
+	input ? ch
+
+	seq i=[0 for 10]
+		seq
+			decout(output, ch, 0)
+			output ! '*n'
+			input ? ch
+
+	output ! TEXT

lang/occam/test/lifegame.ocm

@@ -0,0 +1,248 @@
+def otherwise=true:
+
+def dead=0, alive= not dead:
+
+def radius=1,
+    diameter= (2*radius)+1,
+    neighbours= (diameter*diameter)-1:
+
+proc calculate.next.state(chan link[], value in[], state, var next.state)=
+    var count:
+    seq
+	var state.of.neighbour[neighbours]:
+	seq
+	    par i=[0 for neighbours]
+		link[in[i]] ? state.of.neighbour[i]
+	    count:=0
+	    seq i=[0 for neighbours]
+		if
+		    state.of.neighbour[i]=alive
+			count:=count+1
+		    state.of.neighbour[i]=dead
+			skip
+	    if
+		count<2
+		    next.state:=dead
+		count=2
+		    next.state:=state
+		count=3
+		    next.state:=alive
+		count>3
+		    next.state:=dead
+:
+
+proc broadcast.present.state(chan link[], value out[], state)=
+    par i=[0 for neighbours]
+	link[out[i]] ! state
+:
+
+def set.state=1, ask.state=2, terminate=3:
+
+proc cell(chan link[], value in[], out[], chan control, sense)=
+    var state, instruction:
+    seq
+	state:=dead
+	control ? instruction
+	while instruction <> terminate
+	    seq
+		if
+		    instruction=set.state
+			control ? state
+		    instruction=ask.state
+			var next.state:
+			seq
+			    par
+				broadcast.present.state(link, out, state)
+				seq
+				    calculate.next.state(link, in, state,
+					next.state)
+				    sense ! (state<>next.state); next.state
+
+			    state:=next.state
+
+		control ? instruction
+:
+
+def array.width=5, array.height=5:
+def number.of.cells=array.height*array.width,
+    number.of.links=neighbours*number.of.cells:
+
+proc initialize(value x, y, var in[], out[])=
+    seq delta.x=[-radius for diameter]
+	seq delta.y=[-radius for diameter]
+	    var direction:
+	    seq
+		direction:=delta.x+(diameter*delta.y)
+		if
+		    direction<>0
+			var index, process:
+			seq
+			    process:=x+(array.width*y)
+			    index:=(neighbours+direction) \ (neighbours+1)
+			    out[index]:=index+(neighbours*process)
+
+			    process:=((x+delta.x+array.width) \ array.width) +
+				(array.width*
+				((y+delta.y+array.height) \ array.height))
+			    index:=(neighbours-direction) \ (neighbours+1)
+			    in[index]:=index+(neighbours*process)
+		    direction=0
+			skip
+:
+
+def control= not ((not 0)<<5), escape=control/\'[':
+
+proc move.cursor(chan screen, value x, y)=
+    screen ! escape; '='; '*s'+y; '*s'+x
+:
+
+proc initialize.display(chan screen)=
+    screen ! control /\ 'Z'
+:
+
+proc clean.up.display(chan screen)=
+    move.cursor(screen, 0, array.height)
+:
+
+proc display.state(chan screen, value x, y, state)=
+    seq
+	move.cursor(screen, x, y)
+	if
+	    state=alive
+		screen ! '**'
+	    state=dead
+		screen ! '*s'
+:
+
+proc generation(chan screen, control[], sense[], var active)=
+    seq
+	seq  cell=[0 for number.of.cells]
+	    control[cell] ! ask.state
+	active:=false
+	seq cell=[0 for number.of.cells]
+	    var changed, next.state:
+	    seq
+		sense[cell] ? changed; next.state
+		if
+		    changed
+			seq
+			    display.state(screen, cell\array.width,
+				cell/array.width, next.state)
+			    active:=true
+		    not changed
+			skip
+:
+
+proc edit(chan keyboard, screen, control[])=
+    def ctrl= not ((not 0)<<5):
+    def left.key= 'h',	right.key= 'l', up.key= 'k', down.key= 'j',
+	uproot.key= '*s', plant.key= '**', plant.key2= '8':
+    var x, y, editing, ch:
+    seq
+	x:=array.width/2
+	y:=array.height/2
+	editing:=true
+	while editing
+	    seq
+		move.cursor(screen, x, y)
+		keyboard ? ch
+		if
+		    (ch=left.key) and (x>0)
+			x:=x-1
+		    (ch=right.key) and (x<(array.width-1))
+			x:=x+1
+		    (ch=up.key) and (y>0)
+			y:=y-1
+		    (ch=down.key) and (y<(array.height-1))
+			y:=y+1
+		    (ch=uproot.key) or (ch=plant.key) or (ch=plant.key2)
+			var state:
+			seq
+			    state:=(dead /\ (ch=uproot.key)) \/
+				(alive /\ ((ch=plant.key) or (ch=plant.key2)))
+			    control[x+(array.width*y)] ! set.state; state
+			    display.state(screen, x, y, state)
+		    (ch='q') or (ch='Q')
+			editing:=false
+		    otherwise
+			skip
+:
+
+def idle=1, editing=2, single.stepping=3, free.running=4, terminated=5:
+
+proc display.activity(chan screen, value activity)=
+    seq
+	move.cursor(screen, array.width+1, array.height+2)
+
+	proc write.string(value str[])=
+	    seq i=[1 for str[byte 0]]
+		screen ! str[byte i]
+	:
+	if
+	    activity=idle
+		write.string("Idle")
+	    activity=editing
+		write.string("Edit")
+	    activity=single.stepping
+		write.string("Step")
+	    activity=free.running
+		write.string("Busy")
+	    activity=terminated
+		write.string("Done")
+:
+
+proc controller(chan keyboard, screen, control[], sense[])=
+    var activity:
+    seq
+	activity:=idle
+	initialize.display(screen)
+	while activity<>terminated
+	    seq
+		display.activity(screen, activity)
+		var ch:
+		pri alt
+		    (activity <> editing) & keyboard ? ch
+			if
+			    (ch='q') or (ch='Q')
+				activity:=terminated
+			    (ch='i') or (ch='I')
+				activity:=idle
+			    (ch='e') or (ch='E')
+				activity:=editing
+			    (ch='r') or (ch='R')
+				activity:=free.running
+			    (ch='s') or (ch='S')
+				activity:=single.stepping
+		    (activity=editing) & skip
+			seq
+			    edit(keyboard, screen, control)
+			    activity:=idle
+		    (activity=free.running) or (activity=single.stepping) & skip
+			var changing:
+			seq
+			    generation(screen, control, sense, changing)
+			    if
+				(activity=single.stepping) or (not changing)
+				    activity:=idle
+				(activity=free.running) and changing
+				    skip
+	display.activity(screen, activity)
+	seq cell=[0 for number.of.cells]
+	    control[cell] ! terminate
+	clean.up.display(screen)
+:
+
+chan link[number.of.links], control[number.of.cells], sense[number.of.cells]:
+seq
+    output ! RAW
+    par
+	controller(input, output, control, sense)
+
+	par x=[0 for array.width]
+	    par y=[0 for array.height]
+		var in[neighbours], out[neighbours]:
+		seq
+		    initialize(x, y, in, out)
+		    cell(link, in, out, control[x+(array.width*y)],
+			sense[x+(array.width*y)])
+    output ! TEXT

lang/occam/test/matmul.ocm

@@ -0,0 +1,98 @@
+#include "dec.ocm"
+
+proc prompt(value str[])=
+	seq i=[1 for str[byte 0]]
+		output ! str[byte i]
+:
+def N=20 :
+
+var n:
+var A[N*N], x[N], k[N], y[N] :
+
+proc initialise=
+	var c:
+	seq
+		prompt("n?*n")
+		c:='*s'
+		decin(input, n, c)
+
+		prompt("A?*n")
+		seq i= [0 for n]
+			seq j= [0 for n]
+				decin(input, A[(i*n)+j], c)
+
+		prompt("x?*n")
+		seq i= [0 for n]
+			decin(input, x[i], c)
+
+		prompt("k?*n")
+		seq i= [0 for n]
+			decin(input, k[i], c)				:
+		
+proc produce.xj(value j, chan south) =
+	-- north row: source of x values
+	while true
+		south ! x[j]						:
+
+proc consume.yi(value i, chan east) =
+	-- west column: read y values
+	east ? y[i]						:
+
+proc offset(value ki, chan west) =
+	-- east column: source of k offsets
+	while true
+		west ! ki						:
+
+proc multiplier(value aij, chan north, south, west, east) =
+	-- middle: responsible for a values
+	var xj, aij.times.xj, yi :
+	seq
+		north ? xj
+		while true
+			seq
+				par
+					south ! xj
+					aij.times.xj:= aij*xj
+					east ? yi
+				par
+					west ! yi+aij.times.xj
+					north ? xj			:
+
+proc sink(chan north) =
+	-- south row: sink for unused outputs
+	while true
+		north ? any						:
+
+seq
+	initialise
+
+	chan north.south[(N+1)*N], east.west[N*(N+1)] :
+	par
+		par j= [0 for n]	-- producer of co-ordinates x[j]
+			produce.xj(j, north.south[j])
+
+		par			-- the matrix multiplier
+			par i= [0 for n]
+				offset(k[i], east.west[(n*n)+i])
+			par i= [0 for n]
+				par j= [0 for n]
+					multiplier(A[(n*i)+j],
+						north.south[(n*i)+j],
+						north.south[(n*(i+1))+j],
+						east.west[i+(n*j)],
+						east.west[i+(n*(j+1))])
+			par j= [0 for n]
+				sink(north.south[(n*n)+j])
+
+		seq
+			par i= [0 for n]-- consumer of transformed co-ordinates
+				consume.yi(i, east.west[i])
+
+			seq i= [0 for n]
+				seq
+					output ! 'y'; '['
+					decout(output, i, 0)
+					output ! ']'; '='
+					decout(output, y[i], 5)
+					output ! '*n'
+			exit(0)

lang/occam/test/sort.ocm

@@ -0,0 +1,49 @@
+-- This file contains a recursive call to sorter, so this is not really Occam.
+#include "dec.ocm"
+
+var c:
+seq
+    c:='*s'
+    proc comparator(value num, chan in, out)=
+	var old.num, new.num:
+	seq
+	    old.num:=num
+	    in ? new.num
+	    while new.num
+		seq
+		    in ? new.num
+		    if
+			new.num<=old.num
+			    out ! true; new.num
+			new.num>old.num
+			    seq
+				out ! true; old.num
+				old.num:=new.num
+		    in ? new.num
+	    out ! true; old.num; false
+    :
+    proc sorter(chan out)=
+	chan in:
+	var num:
+	seq
+	    decin(input, num, c)
+	    if
+		c<0
+		    out ! false
+		c>=0
+		    par
+			sorter(in)
+			comparator(num, in, out)
+    :
+    chan out:
+    var num:
+    par
+	sorter(out)
+	seq
+	    out ? num
+	    while num
+		seq
+		    out ? num
+		    decout(output, num, 0)
+		    output ! '*n'
+		    out ? num

lang/occam/test/tst.ocm

@@ -0,0 +1,24 @@
+#include <dec.ocm>
+#include <prints.ocm>
+
+var fmt[byte 100]:
+var d, c:
+seq
+	input ? c
+	decin(input, d, c)
+	while c<>EOF
+		seq
+			chan link:
+			par
+				printd(link, "XXXX %%%ds XXXXX*#00", d)
+				var c, i:
+				seq
+					i:=0
+					link ? c
+					while c<>0
+						seq
+							i:=i+1
+							fmt[byte i]:=c
+							link ? c
+			prints("XXXX %s XXXXX", "YYYYY")
+			decin(input, d, c)

lang/occam/test/use_prnt.ocm

@@ -0,0 +1,17 @@
+#include <dec.ocm>
+#include <printd.ocm>
+
+seq
+	printd(output, "philosopher %d eats ice*n", 2048)
+	printd(output, "phil. %20d also*n", 65536)
+	chan link:
+	par
+		printd(link, "%d times %d makes 100*n", 10)
+
+		var c:
+		seq
+			c:='x'
+			while c<>'*n'
+				seq
+					link ? c
+					output ! c

lang/occam/test/xxtoy.ocm

@@ -0,0 +1,32 @@
+def otherwise=true:
+
+def NLET= ('z'-'a')+1:
+
+proc xxtoy(chan in, out, value x, y)=
+    var c:
+    seq
+	c:= not EOF
+	while c<>EOF
+	    seq
+		in ? c
+		if
+		    c=x
+			seq
+			    in ? c
+			    if
+				c=x
+				    out ! y
+				otherwise
+				    out ! x; c
+		    otherwise
+			out ! c
+:
+chan link[NLET-1]:
+
+par
+    xxtoy(input, link[0], 'a', 'b')
+
+    par i=[0 for NLET-2]
+	xxtoy(link[i], link[i+1], i+'b', i+'c')
+
+    xxtoy(link[NLET-2], output, 'y', 'z')