comparison ppc/test/queens.p @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bfdcc3820b32
1 (* N queens in functional form *)
2
3 const N = 8;
4
5 proc queens(k: integer; proc choice(x: integer): integer);
6 var y, j, q: integer; ok: boolean;
7
8 proc choice1(x: integer): integer;
9 begin
10 if x = k then
11 return y
12 else
13 return choice(x)
14 end;
15 end;
16
17 begin
18 if k > N then
19 print(choice)
20 else
21 y := 1;
22 while y <= N do
23 j := 1; ok := true;
24 while ok and (j < k) do
25 q := choice(j);
26 ok := (q <> y) and (q+j <> y+k) and (q-j <> y-k);
27 j := j+1
28 end;
29 if ok then queens(k+1, choice1) end;
30 y := y+1
31 end
32 end
33 end;
34
35 proc print(proc choice(x: integer): integer);
36 var x: integer;
37 begin
38 x := 1;
39 while x <= N do
40 print_num(choice(x));
41 x := x+1
42 end;
43 newline()
44 end;
45
46 proc choice0(x: integer): integer;
47 begin
48 return 0
49 end;
50
51 begin
52 queens(1, choice0)
53 end.
54
55 (*<<
56 15863724
57 16837425
58 17468253
59 17582463
60 24683175
61 25713864
62 25741863
63 26174835
64 26831475
65 27368514
66 27581463
67 28613574
68 31758246
69 35281746
70 35286471
71 35714286
72 35841726
73 36258174
74 36271485
75 36275184
76 36418572
77 36428571
78 36814752
79 36815724
80 36824175
81 37285146
82 37286415
83 38471625
84 41582736
85 41586372
86 42586137
87 42736815
88 42736851
89 42751863
90 42857136
91 42861357
92 46152837
93 46827135
94 46831752
95 47185263
96 47382516
97 47526138
98 47531682
99 48136275
100 48157263
101 48531726
102 51468273
103 51842736
104 51863724
105 52468317
106 52473861
107 52617483
108 52814736
109 53168247
110 53172864
111 53847162
112 57138642
113 57142863
114 57248136
115 57263148
116 57263184
117 57413862
118 58413627
119 58417263
120 61528374
121 62713584
122 62714853
123 63175824
124 63184275
125 63185247
126 63571428
127 63581427
128 63724815
129 63728514
130 63741825
131 64158273
132 64285713
133 64713528
134 64718253
135 68241753
136 71386425
137 72418536
138 72631485
139 73168524
140 73825164
141 74258136
142 74286135
143 75316824
144 82417536
145 82531746
146 83162574
147 84136275
148 >>*)
149
150 (*[[
151 MODULE Main 0 0
152 IMPORT Lib 0
153 ENDHDR
154
155 PROC _queens 16 0 0
156 ! if k > N then
157 LDLW 16
158 CONST 8
159 JLEQ L2
160 ! print(choice)
161 LDLW 24
162 LDLW 20
163 CONST 0
164 GLOBAL _print
165 PCALL 2
166 JUMP L3
167 LABEL L2
168 ! y := 1;
169 CONST 1
170 STLW -4
171 ! while y <= N do
172 JUMP L5
173 LABEL L4
174 ! j := 1; ok := true;
175 CONST 1
176 STLW -8
177 CONST 1
178 STLC -13
179 ! while ok and (j < k) do
180 JUMP L8
181 LABEL L7
182 ! q := choice(j);
183 LDLW -8
184 LDLW 24
185 LDLW 20
186 PCALLW 1
187 STLW -12
188 ! ok := (q <> y) and (q+j <> y+k) and (q-j <> y-k);
189 LDLW -12
190 LDLW -4
191 JEQ L12
192 LDLW -12
193 LDLW -8
194 PLUS
195 LDLW -4
196 LDLW 16
197 PLUS
198 JEQ L12
199 LDLW -12
200 LDLW -8
201 MINUS
202 LDLW -4
203 LDLW 16
204 MINUS
205 JEQ L12
206 CONST 1
207 JUMP L13
208 LABEL L12
209 CONST 0
210 LABEL L13
211 STLC -13
212 ! j := j+1
213 LDLW -8
214 CONST 1
215 PLUS
216 STLW -8
217 LABEL L8
218 LDLC -13
219 JNEQZ L10
220 JUMP L9
221 LABEL L10
222 LDLW -8
223 LDLW 16
224 JLT L7
225 LABEL L9
226 ! if ok then queens(k+1, choice1) end;
227 LDLC -13
228 JNEQZ L16
229 JUMP L18
230 LABEL L16
231 LOCAL 0
232 GLOBAL _choice1
233 LDLW 16
234 CONST 1
235 PLUS
236 CONST 0
237 GLOBAL _queens
238 PCALL 3
239 LABEL L18
240 ! y := y+1
241 LDLW -4
242 CONST 1
243 PLUS
244 STLW -4
245 LABEL L5
246 LDLW -4
247 CONST 8
248 JLEQ L4
249 LABEL L3
250 RETURN
251 END
252
253 PROC _choice1 0 0 0
254 ! if x = k then
255 LDLW 16
256 LDLW 12
257 LDNW 16
258 JNEQ L20
259 ! return y
260 LDLW 12
261 LDNW -4
262 RETURNW
263 LABEL L20
264 ! return choice(x)
265 LDLW 16
266 LDLW 12
267 LDNW 24
268 LDLW 12
269 LDNW 20
270 PCALLW 1
271 RETURNW
272 END
273
274 PROC _print 4 0 0
275 ! x := 1;
276 CONST 1
277 STLW -4
278 ! while x <= N do
279 JUMP L23
280 LABEL L22
281 ! print_num(choice(x));
282 LDLW -4
283 LDLW 20
284 LDLW 16
285 PCALLW 1
286 CONST 0
287 GLOBAL lib.print_num
288 PCALL 1
289 ! x := x+1
290 LDLW -4
291 CONST 1
292 PLUS
293 STLW -4
294 LABEL L23
295 LDLW -4
296 CONST 8
297 JLEQ L22
298 ! newline()
299 CONST 0
300 GLOBAL lib.newline
301 PCALL 0
302 RETURN
303 END
304
305 PROC _choice0 0 0 0
306 ! return 0
307 CONST 0
308 RETURNW
309 END
310
311 PROC MAIN 0 0 0
312 ! queens(1, choice0)
313 CONST 0
314 GLOBAL _choice0
315 CONST 1
316 CONST 0
317 GLOBAL _queens
318 PCALL 3
319 RETURN
320 END
321
322 ! End
323 ]]*)