Article View: comp.lang.modula2
Article #195FUNNY Eight Co-Queens
From: Piet Tutelaers
Date: Thu, 03 Aug 1989 22:25
Date: Thu, 03 Aug 1989 22:25
160 lines
4654 bytes
4654 bytes
The Eight Queens Problem solved with COROUTINES crashes Logitech system!!!
The next program will run with the Logitech Modula-2 development system
version 3.0, BUT IF YOU REMOVE lines 3 and 69 of program Queens.mod the
program crashes and FUNNY things happen..... Can somebody explain why?
uucp: rcpt@eutrc3.UUCP | Piet Tutelaers Room RC 1.90
bitnet: rcpt@heithe5.BITNET | Eindhoven University of Technology
phone: +31 (0)40 474541 | P.O. Box 513, 5600 MB Eindhoven, NL
----------------------------Queens.mod-----------------------------------
MODULE Queens;
(* 3 *) FROM InOut IMPORT WriteString, WriteLn, WriteInt;
FROM Board IMPORT
Safe, (* tests if proposed placement is safe *)
Occupy, (* occupies a given place on the board *)
Vacate, (* vacates a given place on the board *)
Display; (* displays board *)
FROM SYSTEM IMPORT
PROCESS,
NEWPROCESS,
TRANSFER,
WORD,
ADR,
SIZE;
TYPE
Arow = [1..8];
Acol = [1..8];
CONST
wkspsize = 200; (* informed guess *)
VAR
colData:
ARRAY Acol OF
RECORD
cr: PROCESS;
wksp: ARRAY [1..wkspsize] OF WORD;
END;
initCol: Acol;
main: PROCESS;
done: BOOLEAN;
PROCEDURE Placer; (* coroutine code *)
VAR
myCol: Acol;
myRow: Arow;
BEGIN
myCol := initCol; TRANSFER(colData[myCol].cr, main);
LOOP
FOR myRow := 1 TO 8 DO
IF Safe(myCol, myRow) THEN
Occupy(myCol, myRow);
IF myCol < 8 THEN
TRANSFER(colData[myCol].cr, colData[myCol+1].cr);
ELSE
done:=TRUE;
TRANSFER(colData[myCol].cr, main)
END;
Vacate(myCol, myRow);
END
END;
(* none of the rows are safe in this column *)
IF myCol > 1 THEN
TRANSFER(colData[myCol].cr, colData[myCol-1].cr)
ELSE
done:=FALSE;
TRANSFER(colData[myCol].cr, main)
END
END
END Placer;
PROCEDURE Init;
BEGIN
FOR initCol := 1 TO 8 DO
(* 69*) WriteString('Initiating Placer '); WriteInt(initCol, 0); WriteLn;
WITH colData[initCol] DO
NEWPROCESS(Placer, ADR(wksp), SIZE(wksp), cr);
TRANSFER(main, cr)
END
END
END Init;
BEGIN
Init;
TRANSFER(main, colData[1].cr);
WHILE done DO
Display;
TRANSFER(main, colData[8].cr)
END
END Queens.
----------------------------Board.def-----------------------------------
DEFINITION MODULE Board;
EXPORT QUALIFIED Safe, Occupy, Vacate, Display;
PROCEDURE Safe(c, r: INTEGER): BOOLEAN;
(* Returns TRUE if the square on column c [1..8] and row r
[1..8] can be occupied by a queen.
*)
PROCEDURE Occupy(c, r: INTEGER);
(* Places a queen on the square [c,r] *)
PROCEDURE Vacate(c, r: INTEGER);
(* Removes queen from square [c,r] *)
PROCEDURE Display;
(* Displays a solution by printing the rows of queens on the succesive
columns
*)
END Board.
----------------------------Board.mod-----------------------------------
IMPLEMENTATION MODULE Board;
FROM InOut IMPORT WriteInt, WriteLn;
CONST
NROWS = 8;
VAR
k: INTEGER;
x: ARRAY [1..NROWS] OF INTEGER; (* x[i] row of queen in col i *)
row: ARRAY [1..NROWS] OF BOOLEAN; (* free row's *)
up: ARRAY [-(NROWS - 1)..(NROWS - 1)] OF BOOLEAN;
(* free upper diagonals *)
down: ARRAY [2..(2*NROWS)] OF BOOLEAN; (* free down diagonals *)
PROCEDURE Safe(c, r: INTEGER): BOOLEAN;
BEGIN
RETURN row[r] & up[c-r] & down[c+r]
END Safe;
PROCEDURE Occupy(c, r: INTEGER);
BEGIN
x[c]:=r; row[r]:=FALSE; up[c-r]:=FALSE; down[c+r]:=FALSE
END Occupy;
PROCEDURE Vacate(c, r: INTEGER);
BEGIN
down[c+r]:=TRUE; up[c-r]:=TRUE; row[r]:=TRUE
END Vacate;
PROCEDURE Display;
BEGIN
FOR k:=1 TO NROWS DO WriteInt(x[k], 3); END;
WriteLn
END Display;
BEGIN (* initiate empty board *)
FOR k:=1 TO NROWS DO row[k]:=TRUE END;
FOR k:=-(NROWS - 1) TO (NROWS - 1) DO up[k]:=TRUE END;
FOR k:=2 TO (2 * NROWS) DO down[k]:=TRUE END
END Board.
Technical Details
Message-ID:
<819@eutrc3.urc.tue.nl>Path:
arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!wasatch!cs.utexas.edu!uunet!mcvax!hp4nl!eutrc3!eutrc4!rcptShow Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!wasatch!cs.utexas.edu!uunet!mcvax!hp4nl!eutrc3!eutrc4!rcpt From: rcpt@eutrc4.urc.tue.nl (Piet Tutelaers) Newsgroups: comp.lang.modula2 Subject: FUNNY Eight Co-Queens Keywords: coroutines, Logitech 3.0, BUG Message-ID: <819@eutrc3.urc.tue.nl> Date: 3 Aug 89 22:25:02 GMT Sender: news@eutrc3.urc.tue.nl Lines: 160