🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.modula2
Article #195

FUNNY Eight Co-Queens

#195
From: Piet Tutelaers
Date: Thu, 03 Aug 1989 22:25
160 lines
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!rcpt

Show 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