diff --git a/fco2/testcases/ats1-q7.occ b/fco2/testcases/ats1-q7.occ index 6e5c5ff..57a92d9 100644 --- a/fco2/testcases/ats1-q7.occ +++ b/fco2/testcases/ats1-q7.occ @@ -1,30 +1,8 @@ -- CO516 q7: Adam Sampson vim:et:ts=2:foldmethod=marker -- Dining Frogger^WPhilosophers -- This will be a lot more readable in a folding editor (I use VIM). --- Standalone version. ---{{{ stuff from the standard library ---#INCLUDE "consts.inc" ---#USE "course.lib" -VAL BYTE ESCAPE IS 27 (BYTE): -VAL BYTE FLUSH IS 255 (BYTE): -PROC out.int (VAL INT n, w, CHAN OF BYTE out) - STOP -: -INT, INT FUNCTION random (VAL INT range, seed) IS 0, 0: -PROC copy.string (VAL []BYTE src, []BYTE dest) - STOP -: -PROC make.string ([]BYTE dest, VAL INT len) - STOP -: -PROC erase.screen (CHAN OF BYTE out) - STOP -: -PROC goto.x.y (VAL INT x, y, CHAN OF BYTE out) - STOP -: ---}}} +#USE "course" --{{{ Constants @@ -1170,7 +1148,7 @@ PROC screen.buffer (CHAN OF GRAPHICS.COMMAND in, CHAN OF BYTE out) (x = (prev.x + 1)) AND (y = prev.y) SKIP TRUE - goto.x.y (x + 1, y + 1, out) + cursor.x.y (BYTE (x + 1), BYTE (y + 1), out) out ! screen[current][y][x] prev.x, prev.y, prev.col := x, y, col TRUE diff --git a/fco2/testcases/commstime-mini.occ b/fco2/testcases/commstime-mini.occ index 09ead6e..c9c761a 100644 --- a/fco2/testcases/commstime-mini.occ +++ b/fco2/testcases/commstime-mini.occ @@ -1,106 +1,6 @@ -- A standalone occam 2 version of the stock commstime benchmark. ---{{{ stuff from libcourse ---{{{ PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out) ---* Write a character repeatedly to a channel. --- This outputs [@code ch] down the channel [@code out] [@code n] times. If --- [@code n] is negative, nothing happens. --- @param ch Character --- @param n Number of times to output (negative values result in no output) --- @param out Channel to write to -PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out) - --{{{ - IF - n > 0 - SEQ i = 0 FOR n - out ! ch - TRUE - SKIP - --}}} -: ---}}} ---{{{ PROC out.string (VAL []BYTE s, VAL INT field, CHAN OF BYTE out) ---* Write a string to a channel. --- This outputs [@code s] in a fieldwidth [@code field] down [@code out]. --- @param s String --- @param field Field width to right-justify in --- @param out Channel to write to -PROC out.string (VAL []BYTE s, VAL INT field, CHAN OF BYTE out) - --{{{ - VAL INT length IS SIZE s: - SEQ - out.repeat (' ', field - length, out) - SEQ i = 0 FOR length - out ! s[i] - --}}} -: ---}}} ---{{{ PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out) ---* Write an integer in decimal to a channel. --- This outputs [@code n] in a fieldwidth [@code field] down [@code out]. The --- rules for fieldwidth are as [@ref out.byte]. --- @param n Integer --- @param field Field width to right-justify in --- @param out Channel to write to -PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out) - --{{{ - IF - n = (MOSTNEG INT) - --{{{ minint - out.string ("-2147483648", field, out) - --}}} - n = 0 - --{{{ zero - SEQ - IF - 1 < field - out.repeat (' ', field - 1, out) - TRUE - SKIP - out ! '0' - --}}} - TRUE - --{{{ anything else - VAL INT max.digits IS 20: - [max.digits]INT D: - INT x, i: - SEQ - --{{{ check negative - IF - n < 0 - x := -n - TRUE -- (n > 0) - x := n - --}}} - --{{{ decompose - SEQ - i := 0 - WHILE x > 0 - SEQ - D[i] := x\10 - x := x/10 - i := i + 1 - --}}} - --{{{ pad - IF - n > 0 - out.repeat (' ', field - i, out) - TRUE - SEQ - out.repeat (' ', (field - 1) - i, out) - out ! '-' - --}}} - --{{{ output - WHILE i > 0 - SEQ - i := i - 1 - out ! BYTE (D[i] + (INT '0')) - --}}} - --}}} - --}}} -: ---}}} ---}}} +#USE "course" --{{{ PROC id (CHAN OF INT in, out) PROC id (CHAN OF INT in, out) diff --git a/fco2/testcases/course.occ b/fco2/testcases/course.occ new file mode 100644 index 0000000..55904fb --- /dev/null +++ b/fco2/testcases/course.occ @@ -0,0 +1,276 @@ +-- Various stuff taken from the course library that's used by these testcases. +-- This has all been translated back to occam2 for now. + +VAL BYTE NULL IS 0 (BYTE): --* ASCII NUL +VAL BYTE BELL IS 7 (BYTE): --* ASCII BEL - terminal bell +VAL BYTE BACK IS 8 (BYTE): --* ASCII BS - backspace key +VAL BYTE ESCAPE IS 27 (BYTE): --* ASCII ESC - escape key +VAL BYTE DELETE IS 127 (BYTE): --* ASCII DEL - delete key +VAL BYTE FLUSH IS 255 (BYTE): --* Flush output buffer +VAL BYTE END.OF.FILE IS 255 (BYTE): --* End of file + +--{{{ PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out) +--* Write a character repeatedly to a channel. +-- This outputs [@code ch] down the channel [@code out] [@code n] times. If +-- [@code n] is negative, nothing happens. +-- @param ch Character +-- @param n Number of times to output (negative values result in no output) +-- @param out Channel to write to +PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out) + --{{{ + IF + n > 0 + SEQ i = 0 FOR n + out ! ch + TRUE + SKIP + --}}} +: +--}}} +--{{{ PROC out.string (VAL []BYTE s, VAL INT field, CHAN OF BYTE out) +--* Write a string to a channel. +-- This outputs [@code s] in a fieldwidth [@code field] down [@code out]. +-- @param s String +-- @param field Field width to right-justify in +-- @param out Channel to write to +PROC out.string (VAL []BYTE s, VAL INT field, CHAN OF BYTE out) + --{{{ + VAL INT length IS SIZE s: + SEQ + out.repeat (' ', field - length, out) + SEQ i = 0 FOR length + out ! s[i] + --}}} +: +--}}} +--{{{ PROC out.byte (VAL BYTE b, VAL INT field, CHAN OF BYTE out) +--* Write a byte in decimal to a channel. +-- This outputs [@code b] in a fieldwidth [@code field] down [@code out]. If +-- the fieldwidth is too wide for [@code b], it right-justifies [@code b] with +-- spaces on the left. If the field is not wide enough, it prints the [@code +-- b] anyway. These rules for fieldwidth are the same as those used by the +-- Pascal [@text write] procedure. +-- @param b Byte +-- @param field Field width to right-justify in +-- @param out Channel to write to +PROC out.byte (VAL BYTE b, VAL INT field, CHAN OF BYTE out) + --{{{ + VAL BYTE hundreds IS b/100: + VAL BYTE rest IS b\100: + VAL BYTE tens IS rest/10: + VAL BYTE ones IS rest\10: + IF + hundreds > 0 + SEQ + out.repeat (' ', field - 3, out) + out ! hundreds + '0' + out ! tens + '0' + out ! ones + '0' + tens > 0 + SEQ + out.repeat (' ', field - 2, out) + out ! tens + '0' + out ! ones + '0' + TRUE + SEQ + out.repeat (' ', field - 1, out) + out ! ones + '0' + --}}} +: +--}}} +--{{{ PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out) +--* Write an integer in decimal to a channel. +-- This outputs [@code n] in a fieldwidth [@code field] down [@code out]. The +-- rules for fieldwidth are as [@ref out.byte]. +-- @param n Integer +-- @param field Field width to right-justify in +-- @param out Channel to write to +PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out) + --{{{ + IF + n = (MOSTNEG INT) + --{{{ minint + out.string ("-2147483648", field, out) + --}}} + n = 0 + --{{{ zero + SEQ + IF + 1 < field + out.repeat (' ', field - 1, out) + TRUE + SKIP + out ! '0' + --}}} + TRUE + --{{{ anything else + VAL INT max.digits IS 20: + [max.digits]INT D: + INT x, i: + SEQ + --{{{ check negative + IF + n < 0 + x := -n + TRUE -- (n > 0) + x := n + --}}} + --{{{ decompose + SEQ + i := 0 + WHILE x > 0 + SEQ + D[i] := x\10 + x := x/10 + i := i + 1 + --}}} + --{{{ pad + IF + n > 0 + out.repeat (' ', field - i, out) + TRUE + SEQ + out.repeat (' ', (field - 1) - i, out) + out ! '-' + --}}} + --{{{ output + WHILE i > 0 + SEQ + i := i - 1 + out ! BYTE (D[i] + (INT '0')) + --}}} + --}}} + --}}} +: +--}}} +--{{{ PROC make.string ([]BYTE a, VAL INT length) +--* Converts a [@code BYTE] array into a string. +-- This is needed for strings that have been input using a counted-array +-- protocol (where we know the length, but the string characters have been +-- left-justified and the elements of the array after the string need setting +-- to [@ref NULL]). +-- @param a Array to convert +-- @param length Length of string in [@code a] +PROC make.string ([]BYTE a, VAL INT length) + --{{{ + IF + (SIZE a) > length + SEQ i = length FOR (SIZE a) - length + a[i] := NULL + TRUE + SKIP + --}}} +: +--}}} +--{{{ PROC copy.string (VAL []BYTE a, []BYTE b) +--* Copy a string. +-- This copies the string from [@code a] into [@code b]. If [@code a] is +-- shorter than [@code b], the string gets padded with [@ref NULL]s. If +-- [@code b] is shorter than [@code a], the string gets truncated. +-- @param a Source string +-- @param b Destination string +PROC copy.string (VAL []BYTE a, []BYTE b) + --{{{ + INT min: + SEQ + --{{{ min := minimum (SIZE a, SIZE b) + IF + (SIZE a) > (SIZE b) + min := SIZE b + TRUE + min := SIZE a + --}}} + --{{{ copy a to b + [b FROM 0 FOR min] := [a FROM 0 FOR min] + --}}} + --{{{ pad with NULLs + SEQ i = min FOR (SIZE b) - min + b[i] := NULL + --}}} + --}}} +: +--}}} +--{{{ PROC erase.screen (CHAN OF BYTE out) +--* Erase whole screen. +-- This outputs a VT220 control sequence to erase all characters from the +-- screen. +-- @param out Channel to write to +PROC erase.screen (CHAN OF BYTE out) + --{{{ + SEQ + out ! ESCAPE + out ! '[' + out ! '2' + out ! 'J' + --}}} +: +--}}} +--{{{ PROC cursor.x.y (VAL BYTE x, y, CHAN OF BYTE out) +--* Place the cursor. +-- This outputs a VT220 control sequence down channel [@code out] to place the +-- cursor at screen coordinates ([@code x], [@code y]). +-- @param x X coordinate +-- @param y Y coordinate +-- @param out Channel to write to +PROC cursor.x.y (VAL BYTE x, y, CHAN OF BYTE out) + --{{{ + SEQ + out ! ESCAPE + out ! '[' + out.byte (y, 0, out) + out ! ';' + out.byte (x, 0, out) + out ! 'H' + --}}} +: +--}}} +--{{{ INT, INT FUNCTION random (VAL INT upto, seed) +--* Pseudorandom number generator. +-- This is an implementation by David Morse of the "minimal standard" +-- described in +-- "[@link http://portal.acm.org/citation.cfm?id=63042 Random number +-- generators: Good ones are hard to find]", +-- Park, K.P. & Miller, K.W. (1988), Comm. ACM, 31(10), 1192-1201. +-- +-- The routine must be called with a valid seed: an integer of +-- between 1 and 2 147 483 647. The value of the seed must be +-- preserved from one call of the function to the next. This +-- implementation of the random number generator returns an integer +-- lying between 0 and ([@code upto] - 1) inclusive as its first result, +-- the seed is the second result. +-- +-- The random number is full period, with a period of 2 ** 31, +-- that is 2 147 483 647. +-- +-- @param upto The upper bound (exclusive) of the output value +-- @param seed The input seed +-- @return The output value +-- @return The output seed +INT, INT FUNCTION random (VAL INT upto, seed) + + --{{{ miscellaneous constants + VAL INT magic IS 16807: + VAL INT period IS 2147483647: + VAL INT quotient IS period / magic: + VAL INT remainder IS period \ magic: + --}}} + + INT int.result, new.seed: + + VALOF + --{{{ + INT lo, hi, test: + SEQ + hi := seed / quotient + lo := seed \ quotient + test := (magic TIMES lo) MINUS (remainder TIMES hi) + IF + test > 0 + new.seed := test + TRUE + new.seed := test PLUS period + int.result := new.seed \ upto + --}}} + RESULT int.result, new.seed +: +--}}}