comparison lab4/test/sudoku.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 (* Sudoku solved with Knuth's dancing links *)
2
3 (* The Boolean matrix has:
4
5 * 81 columns Q11 .. Q99, one for each cell, since each cell must
6 contain exactly one digit.
7
8 * Nine columns Cn1 .. Cn9 for each column n of the puzzle grid, since
9 each column must contain each digit exactly once.
10
11 * Nine columns Rn1 .. Rn9 for each row of the puzzle grid.
12
13 * Nine columns Bn1 .. Bn9 for each block of the puzzle grid.
14
15 Each row corresponds to placing a digit in a single cell, and contains
16 four 1's, one in each of the four groups of columns above. *)
17
18 type
19 Cell = pointer to CellRec;
20 Column = pointer to ColRec;
21
22 CellRec = record
23 up, down, left, right: Cell; (* Neighbours *)
24 column: Column; (* Top of the column *)
25 end;
26
27 ColRec = record
28 name: char; (* Column code: C, R, B, Q *)
29 x, y: integer; (* Two digits to identify column *)
30 size: integer; (* No. of intersecting rows *)
31 covered: boolean; (* Whether covered *)
32 prev, next: Column; (* Links to adjacent columns *)
33 head: Cell; (* Dummy node for this column *)
34 end;
35
36 var
37 root: Column; (* Root of the entire matrix *)
38
39 (* |PrintCol| -- print the name of a column *)
40 proc PrintCol(c: Column);
41 begin
42 print_char(c^.name); print_num(c^.x); print_num(c^.y)
43 end (* PrintCol *);
44
45 (* |PrintRow| -- print all columns in a given row *)
46 proc PrintRow(p: Cell);
47 var q: Cell; n: integer;
48 begin
49 (* Print the columns that intersect the row *)
50 q := p;
51 repeat
52 print_string(" "); PrintCol(q^.column); q := q^.right
53 until q = p;
54
55 (* Print position in column *)
56 n := 0; q := p^.column^.head;
57 while q <> p do n := n+1; q := q^.down end;
58 print_string("; # "); print_num(n); print_string(" of ");
59 print_num(p^.column^.size); print_string(" choices for ");
60 PrintCol(p^.column); newline()
61 end (* PrintRow *);
62
63
64 (* Creating the puzzle *)
65
66 const sqrtN = 3; N = sqrtN * sqrtN;
67
68 var
69 boardCell: array N of array N of Column;
70 boardColumn: array N of array N of Column;
71 boardRow: array N of array N of Column;
72 boardBlock: array N of array N of Column;
73 boardMove: array N of array N of array N of Cell;
74
75 proc ColumnLink(r: Column; var p: Cell);
76 var q: Cell;
77 begin
78 new(q);
79 if p = nil then
80 q^.right := q; q^.left := q; p := q
81 else
82 q^.left := p^.left; q^.right := p;
83 p^.left^.right := q; p^.left := q
84 end;
85 q^.up := r^.head^.up; q^.down := r^.head;
86 r^.head^.up^.down := q; r^.head^.up := q;
87 q^.column := r; r^.size := r^.size+1
88 end (* ColumnLink *);
89
90 proc MakeArray(var a: array N of array N of Column;
91 name: char; m, n: integer);
92 var
93 i, j: integer;
94 p: Column;
95 begin
96 for i := 0 to m-1 do
97 for j := 0 to n-1 do
98 new(p); p^.name := name; p^.x := i+1; p^.y := j+1;
99 p^.size := 0; p^.covered := false;
100 new(p^.head); p^.head^.down := p^.head; p^.head^.up := p^.head;
101 p^.prev := root^.prev; p^.next := root;
102 root^.prev^.next := p; root^.prev := p;
103 a[i][j] := p
104 end
105 end
106 end (* MakeArray *);
107
108 proc MakeMove(i, j, k: integer);
109 var p: Cell;
110 begin
111 p := nil;
112 ColumnLink(boardCell[i][j], p);
113 ColumnLink(boardColumn[j][k], p);
114 ColumnLink(boardRow[i][k], p);
115 ColumnLink(boardBlock[sqrtN * (i div sqrtN) + j div sqrtN][k], p);
116 boardMove[i][j][k] := p
117 end (* MakeMove *);
118
119 proc MakePuzzle();
120 var i, j, k: integer;
121 begin
122 new(root);
123 root^.prev := root; root^.next := root;
124
125 MakeArray(boardCell, 'Q', N, N);
126 MakeArray(boardColumn, 'C', N, N);
127 MakeArray(boardRow, 'R', N, N);
128 MakeArray(boardBlock, 'B', N, N);
129
130 for i := 0 to N-1 do
131 for j := 0 to N-1 do
132 for k := 0 to N-1 do
133 MakeMove(i, j, k);
134 end
135 end
136 end
137 end (* MakePuzzle *);
138
139
140 (* Exact cover problem *)
141
142 var
143 choice: array N*N of Cell; (* Current set of choices *)
144
145 (* |Cover| -- temporarily remove a column *)
146 proc Cover(p: Column);
147 var q, r: Cell;
148 begin
149 p^.covered := true;
150
151 (* Remove p from the list of columns *)
152 p^.prev^.next := p^.next; p^.next^.prev := p^.prev;
153
154 (* Block each row that intersects p *)
155 q := p^.head^.down;
156 while q <> p^.head do
157 r := q^.right;
158 while r <> q do
159 r^.up^.down := r^.down; r^.down^.up := r^.up;
160 r^.column^.size := r^.column^.size-1; r := r^.right
161 end;
162 q := q^.down
163 end
164 end (* Cover *);
165
166 (* |Uncover| -- reverse the effect of |Cover| *)
167 proc Uncover(p: Column);
168 var q, r: Cell;
169 begin
170 (* Restore p to the list of columns *)
171 p^.prev^.next := p; p^.next^.prev := p;
172
173 (* Unblock each row that intersects p *)
174 q := p^.head^.up;
175 while q <> p^.head do
176 r := q^.left;
177 while r <> q do
178 r^.up^.down := r; r^.down^.up := r;
179 r^.column^.size := r^.column^.size+1; r := r^.left
180 end;
181 q := q^.up
182 end;
183
184 p^.covered := false
185 end (* Uncover *);
186
187 (* |ChooseColumn| -- select a column according to stratregy *)
188 proc ChooseColumn(): Column;
189 var c, col: Column;
190 begin
191 (* Find smallest column |col| *)
192 col := root^.next;
193 c := col^.next;
194 while c <> root do
195 if c^.size < col^.size then col := c end;
196 c := c^.next
197 end;
198 return col
199 end (* ChooseColumn *);
200
201 proc PrintState(level: integer);
202 var
203 i, j, k: integer;
204 p: Cell;
205 board: array N of array N of char;
206 begin
207 for i := 0 to N-1 do
208 for j := 0 to N-1 do
209 board[i][j] := '.'
210 end
211 end;
212
213 for k := 0 to level-1 do
214 p := choice[k];
215 while p^.column^.name <> 'Q' do p := p^.right end;
216 i := p^.column^.x - 1; j := p^.column^.y - 1;
217 board[i][j] := chr(p^.right^.column^.y + ord('0'))
218 end;
219
220 for i := 0 to N-1 do
221 print_string(board[i]); newline()
222 end
223 end (* PrintState *);
224
225 (* |Solve| -- find an exact cover by backtracking search *)
226 proc Solve(level: integer);
227 var col: Column; p, q: Cell;
228 begin
229 if root^.next = root then
230 print_string("Solution:"); newline();
231 PrintState(level); return
232 end;
233
234 col := ChooseColumn();
235 if col^.size = 0 then return end;
236 Cover(col);
237
238 (* Try each row that intersects column col *)
239 p := col^.head^.down;
240 while p <> col^.head do
241 choice[level] := p;
242
243 print_num(level); print_string(":"); PrintRow(p);
244
245 (* Cover other columns in row |p| *)
246 q := p^.right;
247 while q <> p do Cover(q^.column); q := q^.right end;
248
249 Solve(level+1);
250
251 (* Uncover other columns in row |p| *)
252 q := p^.left;
253 while q <> p do Uncover(q^.column); q := q^.left end;
254
255 p := p^.down
256 end;
257
258 Uncover(col)
259 end (* Solve *);
260
261 proc ChooseRow(var level: integer; p: Cell);
262 var q: Cell;
263 begin
264 choice[level] := p; level := level+1;
265 q := p;
266 repeat
267 if q^.column^.covered then
268 print_string("Conflict for "); PrintCol(q^.column); newline()
269 end;
270 Cover(q^.column); q := q^.right
271 until q = p
272 end (* ChooseRow *);
273
274 const input =
275 "..3....51/5.2..64../..7.5..../...63.7../2..7.8..6/..4.21.../....7.8../..81..6.9/17....5..";
276
277 proc Input(var level: integer);
278 var i, j, k: integer; ch: char;
279 begin
280 for i := 0 to N-1 do
281 for j := 0 to N-1 do
282 ch := input[10*i+j];
283 print_char(ch);
284 if ch <> '.' then
285 k := ord(ch) - ord('1');
286 ChooseRow(level, boardMove[i][j][k])
287 end
288 end;
289 newline()
290 end
291 end (* Input *);
292
293 (* Main program *)
294 var level: integer;
295
296 begin
297 MakePuzzle();
298 level := 0;
299 Input(level);
300 Solve(level)
301 end (* tSudoku *).
302
303 (*<<
304 ..3....51
305 5.2..64..
306 ..7.5....
307 ...63.7..
308 2..7.8..6
309 ..4.21...
310 ....7.8..
311 ..81..6.9
312 17....5..
313 28: Q85 C54 R84 B84; # 1 of 1 choices for Q85
314 29: Q55 C59 R59 B59; # 1 of 1 choices for Q55
315 30: Q15 C58 R18 B28; # 1 of 1 choices for Q15
316 31: Q25 C51 R21 B21; # 1 of 1 choices for Q25
317 32: Q64 C45 R65 B55; # 1 of 1 choices for Q64
318 33: Q46 C64 R44 B54; # 1 of 1 choices for Q46
319 34: Q81 C13 R83 B73; # 1 of 1 choices for Q81
320 35: Q95 C56 R96 B86; # 1 of 1 choices for Q95
321 36: Q93 C39 R99 B79; # 1 of 1 choices for Q93
322 37: C17 R67 B47 Q61; # 1 of 1 choices for C17
323 38: C36 R76 B76 Q73; # 1 of 1 choices for C36
324 39: Q71 C14 R74 B74; # 1 of 1 choices for Q71
325 40: C48 R98 B88 Q94; # 1 of 1 choices for C48
326 41: C67 R17 B27 Q16; # 1 of 1 choices for C67
327 42: C71 R51 B61 Q57; # 1 of 1 choices for C71
328 43: Q53 C35 R55 B45; # 1 of 1 choices for Q53
329 44: Q43 C31 R41 B41; # 1 of 1 choices for Q43
330 45: Q52 C23 R53 B43; # 1 of 1 choices for Q52
331 46: Q58 C84 R54 B64; # 1 of 1 choices for Q58
332 47: C21 R31 B11 Q32; # 1 of 1 choices for C21
333 48: C24 R14 B14 Q12; # 1 of 1 choices for C24
334 49: C26 R66 B46 Q62; # 1 of 1 choices for C26
335 50: C44 R34 B24 Q34; # 1 of 1 choices for C44
336 51: C81 R71 B91 Q78; # 1 of 1 choices for C81
337 52: C86 R36 B36 Q38; # 1 of 1 choices for C86
338 53: C16 R16 B16 Q11; # 1 of 1 choices for C16
339 54: C94 R94 B94 Q99; # 1 of 1 choices for C94
340 55: C95 R45 B65 Q49; # 1 of 1 choices for C95
341 56: C97 R27 B37 Q29; # 1 of 1 choices for C97
342 57: C87 R87 B97 Q88; # 1 of 1 choices for C87
343 58: R42 B62 Q48 C82; # 1 of 1 choices for R42
344 59: Q98 C83 R93 B93; # 1 of 1 choices for Q98
345 60: Q79 C92 R72 B92; # 1 of 1 choices for Q79
346 61: Q72 C25 R75 B75; # 1 of 1 choices for Q72
347 62: Q82 C22 R82 B72; # 1 of 1 choices for Q82
348 63: Q86 C65 R85 B85; # 1 of 1 choices for Q86
349 64: Q96 C62 R92 B82; # 1 of 1 choices for Q96
350 65: C42 R12 B22 Q14; # 1 of 1 choices for C42
351 66: Q17 C79 R19 B39; # 1 of 1 choices for Q17
352 67: Q28 C88 R28 B38; # 1 of 1 choices for Q28
353 68: Q22 C29 R29 B19; # 1 of 1 choices for Q22
354 69: Q24 C43 R23 B23; # 1 of 1 choices for Q24
355 70: Q31 C18 R38 B18; # 1 of 1 choices for Q31
356 71: Q36 C69 R39 B29; # 1 of 1 choices for Q36
357 72: Q39 C93 R33 B33; # 1 of 1 choices for Q39
358 73: Q37 C72 R32 B32; # 1 of 1 choices for Q37
359 74: Q41 C19 R49 B49; # 1 of 1 choices for Q41
360 75: Q42 C28 R48 B48; # 1 of 1 choices for Q42
361 76: Q67 C73 R63 B63; # 1 of 1 choices for Q67
362 77: Q68 C89 R69 B69; # 1 of 1 choices for Q68
363 78: Q69 C98 R68 B68; # 1 of 1 choices for Q69
364 79: Q74 C49 R79 B89; # 1 of 1 choices for Q74
365 80: Q76 C63 R73 B83; # 1 of 1 choices for Q76
366 Solution:
367 643287951
368 592316487
369 817459263
370 981634725
371 235798146
372 764521398
373 456973812
374 328145679
375 179862534
376 >>*)
377
378 (*[[
379 @ picoPascal compiler output
380 .include "fixup.s"
381 .global pmain
382
383 @ proc PrintCol(c: Column);
384 .text
385 _PrintCol:
386 mov ip, sp
387 stmfd sp!, {r0-r1}
388 stmfd sp!, {r4-r10, fp, ip, lr}
389 mov fp, sp
390 @ print_char(c^.name); print_num(c^.x); print_num(c^.y)
391 ldr r0, [fp, #40]
392 ldrb r0, [r0]
393 bl print_char
394 ldr r0, [fp, #40]
395 ldr r0, [r0, #4]
396 bl print_num
397 ldr r0, [fp, #40]
398 ldr r0, [r0, #8]
399 bl print_num
400 ldmfd fp, {r4-r10, fp, sp, pc}
401 .ltorg
402
403 @ proc PrintRow(p: Cell);
404 _PrintRow:
405 mov ip, sp
406 stmfd sp!, {r0-r1}
407 stmfd sp!, {r4-r10, fp, ip, lr}
408 mov fp, sp
409 @ q := p;
410 ldr r4, [fp, #40]
411 .L11:
412 @ print_string(" "); PrintCol(q^.column); q := q^.right
413 mov r1, #1
414 set r0, g1
415 bl print_string
416 ldr r0, [r4, #16]
417 bl _PrintCol
418 ldr r4, [r4, #12]
419 ldr r6, [fp, #40]
420 cmp r4, r6
421 bne .L11
422 @ n := 0; q := p^.column^.head;
423 mov r5, #0
424 ldr r0, [r6, #16]
425 ldr r4, [r0, #28]
426 .L13:
427 @ while q <> p do n := n+1; q := q^.down end;
428 ldr r0, [fp, #40]
429 cmp r4, r0
430 beq .L15
431 add r5, r5, #1
432 ldr r4, [r4, #4]
433 b .L13
434 .L15:
435 @ print_string("; # "); print_num(n); print_string(" of ");
436 mov r1, #4
437 set r0, g2
438 bl print_string
439 mov r0, r5
440 bl print_num
441 mov r1, #4
442 set r0, g3
443 bl print_string
444 @ print_num(p^.column^.size); print_string(" choices for ");
445 ldr r0, [fp, #40]
446 ldr r0, [r0, #16]
447 ldr r0, [r0, #12]
448 bl print_num
449 mov r1, #13
450 set r0, g4
451 bl print_string
452 @ PrintCol(p^.column); newline()
453 ldr r0, [fp, #40]
454 ldr r0, [r0, #16]
455 bl _PrintCol
456 bl newline
457 ldmfd fp, {r4-r10, fp, sp, pc}
458 .ltorg
459
460 @ proc ColumnLink(r: Column; var p: Cell);
461 _ColumnLink:
462 mov ip, sp
463 stmfd sp!, {r0-r1}
464 stmfd sp!, {r4-r10, fp, ip, lr}
465 mov fp, sp
466 @ new(q);
467 mov r0, #20
468 bl new
469 mov r4, r0
470 @ if p = nil then
471 ldr r0, [fp, #44]
472 ldr r0, [r0]
473 cmp r0, #0
474 bne .L18
475 @ q^.right := q; q^.left := q; p := q
476 str r4, [r4, #12]
477 str r4, [r4, #8]
478 ldr r0, [fp, #44]
479 str r4, [r0]
480 b .L19
481 .L18:
482 @ q^.left := p^.left; q^.right := p;
483 ldr r0, [fp, #44]
484 ldr r0, [r0]
485 ldr r0, [r0, #8]
486 str r0, [r4, #8]
487 ldr r0, [fp, #44]
488 ldr r0, [r0]
489 str r0, [r4, #12]
490 @ p^.left^.right := q; p^.left := q
491 ldr r0, [fp, #44]
492 ldr r0, [r0]
493 ldr r0, [r0, #8]
494 str r4, [r0, #12]
495 ldr r0, [fp, #44]
496 ldr r0, [r0]
497 str r4, [r0, #8]
498 .L19:
499 @ q^.up := r^.head^.up; q^.down := r^.head;
500 ldr r0, [fp, #40]
501 ldr r0, [r0, #28]
502 ldr r0, [r0]
503 str r0, [r4]
504 ldr r0, [fp, #40]
505 ldr r0, [r0, #28]
506 str r0, [r4, #4]
507 @ r^.head^.up^.down := q; r^.head^.up := q;
508 ldr r0, [fp, #40]
509 ldr r0, [r0, #28]
510 ldr r0, [r0]
511 str r4, [r0, #4]
512 ldr r0, [fp, #40]
513 ldr r0, [r0, #28]
514 str r4, [r0]
515 @ q^.column := r; r^.size := r^.size+1
516 ldr r0, [fp, #40]
517 str r0, [r4, #16]
518 ldr r0, [fp, #40]
519 add r5, r0, #12
520 ldr r0, [r5]
521 add r0, r0, #1
522 str r0, [r5]
523 ldmfd fp, {r4-r10, fp, sp, pc}
524 .ltorg
525
526 @ proc MakeArray(var a: array N of array N of Column;
527 _MakeArray:
528 mov ip, sp
529 stmfd sp!, {r0-r3}
530 stmfd sp!, {r4-r10, fp, ip, lr}
531 mov fp, sp
532 sub sp, sp, #8
533 @ for i := 0 to m-1 do
534 mov r4, #0
535 ldr r0, [fp, #48]
536 sub r0, r0, #1
537 str r0, [fp, #-8]
538 .L21:
539 ldr r0, [fp, #-8]
540 cmp r4, r0
541 bgt .L20
542 @ for j := 0 to n-1 do
543 mov r5, #0
544 ldr r0, [fp, #52]
545 sub r0, r0, #1
546 str r0, [fp, #-4]
547 .L23:
548 ldr r0, [fp, #-4]
549 cmp r5, r0
550 bgt .L24
551 @ new(p); p^.name := name; p^.x := i+1; p^.y := j+1;
552 mov r0, #32
553 bl new
554 mov r6, r0
555 ldrb r0, [fp, #44]
556 strb r0, [r6]
557 add r0, r4, #1
558 str r0, [r6, #4]
559 add r0, r5, #1
560 str r0, [r6, #8]
561 @ p^.size := 0; p^.covered := false;
562 mov r0, #0
563 str r0, [r6, #12]
564 mov r0, #0
565 strb r0, [r6, #16]
566 @ new(p^.head); p^.head^.down := p^.head; p^.head^.up := p^.head;
567 mov r0, #20
568 bl new
569 str r0, [r6, #28]
570 ldr r7, [r6, #28]
571 str r7, [r7, #4]
572 ldr r7, [r6, #28]
573 str r7, [r7]
574 @ p^.prev := root^.prev; p^.next := root;
575 set r7, _root
576 ldr r0, [r7]
577 ldr r0, [r0, #20]
578 str r0, [r6, #20]
579 ldr r0, [r7]
580 str r0, [r6, #24]
581 @ root^.prev^.next := p; root^.prev := p;
582 ldr r0, [r7]
583 ldr r0, [r0, #20]
584 str r6, [r0, #24]
585 ldr r0, [r7]
586 str r6, [r0, #20]
587 @ a[i][j] := p
588 ldr r0, [fp, #40]
589 mov r1, #36
590 mul r1, r4, r1
591 add r0, r0, r1
592 lsl r1, r5, #2
593 add r0, r0, r1
594 str r6, [r0]
595 add r5, r5, #1
596 b .L23
597 .L24:
598 add r4, r4, #1
599 b .L21
600 .L20:
601 ldmfd fp, {r4-r10, fp, sp, pc}
602 .ltorg
603
604 @ proc MakeMove(i, j, k: integer);
605 _MakeMove:
606 mov ip, sp
607 stmfd sp!, {r0-r3}
608 stmfd sp!, {r4-r10, fp, ip, lr}
609 mov fp, sp
610 sub sp, sp, #8
611 @ p := nil;
612 mov r0, #0
613 str r0, [fp, #-4]
614 @ ColumnLink(boardCell[i][j], p);
615 add r1, fp, #-4
616 set r0, _boardCell
617 ldr r2, [fp, #40]
618 mov r3, #36
619 mul r2, r2, r3
620 add r0, r0, r2
621 ldr r2, [fp, #44]
622 lsl r2, r2, #2
623 add r0, r0, r2
624 ldr r0, [r0]
625 bl _ColumnLink
626 @ ColumnLink(boardColumn[j][k], p);
627 add r1, fp, #-4
628 set r0, _boardColumn
629 ldr r2, [fp, #44]
630 mov r3, #36
631 mul r2, r2, r3
632 add r0, r0, r2
633 ldr r2, [fp, #48]
634 lsl r2, r2, #2
635 add r0, r0, r2
636 ldr r0, [r0]
637 bl _ColumnLink
638 @ ColumnLink(boardRow[i][k], p);
639 add r1, fp, #-4
640 set r0, _boardRow
641 ldr r2, [fp, #40]
642 mov r3, #36
643 mul r2, r2, r3
644 add r0, r0, r2
645 ldr r2, [fp, #48]
646 lsl r2, r2, #2
647 add r0, r0, r2
648 ldr r0, [r0]
649 bl _ColumnLink
650 @ ColumnLink(boardBlock[sqrtN * (i div sqrtN) + j div sqrtN][k], p);
651 mov r1, #3
652 ldr r0, [fp, #40]
653 bl int_div
654 mov r1, #3
655 mov r4, r0
656 ldr r0, [fp, #44]
657 bl int_div
658 add r1, fp, #-4
659 mov r5, r0
660 set r0, _boardBlock
661 mov r2, #3
662 mul r2, r4, r2
663 add r2, r2, r5
664 mov r3, #36
665 mul r2, r2, r3
666 add r0, r0, r2
667 ldr r2, [fp, #48]
668 lsl r2, r2, #2
669 add r0, r0, r2
670 ldr r0, [r0]
671 bl _ColumnLink
672 @ boardMove[i][j][k] := p
673 ldr r0, [fp, #-4]
674 set r1, _boardMove
675 ldr r2, [fp, #40]
676 mov r3, #324
677 mul r2, r2, r3
678 add r1, r1, r2
679 ldr r2, [fp, #44]
680 mov r3, #36
681 mul r2, r2, r3
682 add r1, r1, r2
683 ldr r2, [fp, #48]
684 lsl r2, r2, #2
685 add r1, r1, r2
686 str r0, [r1]
687 ldmfd fp, {r4-r10, fp, sp, pc}
688 .ltorg
689
690 @ proc MakePuzzle();
691 _MakePuzzle:
692 mov ip, sp
693 stmfd sp!, {r4-r10, fp, ip, lr}
694 mov fp, sp
695 sub sp, sp, #16
696 @ new(root);
697 mov r0, #32
698 bl new
699 set r7, _root
700 str r0, [r7]
701 @ root^.prev := root; root^.next := root;
702 str r0, [r0, #20]
703 ldr r7, [r7]
704 str r7, [r7, #24]
705 @ MakeArray(boardCell, 'Q', N, N);
706 mov r3, #9
707 mov r2, #9
708 mov r1, #81
709 set r0, _boardCell
710 bl _MakeArray
711 @ MakeArray(boardColumn, 'C', N, N);
712 mov r3, #9
713 mov r2, #9
714 mov r1, #67
715 set r0, _boardColumn
716 bl _MakeArray
717 @ MakeArray(boardRow, 'R', N, N);
718 mov r3, #9
719 mov r2, #9
720 mov r1, #82
721 set r0, _boardRow
722 bl _MakeArray
723 @ MakeArray(boardBlock, 'B', N, N);
724 mov r3, #9
725 mov r2, #9
726 mov r1, #66
727 set r0, _boardBlock
728 bl _MakeArray
729 @ for i := 0 to N-1 do
730 mov r4, #0
731 mov r0, #8
732 str r0, [fp, #-12]
733 .L27:
734 ldr r0, [fp, #-12]
735 cmp r4, r0
736 bgt .L26
737 @ for j := 0 to N-1 do
738 mov r5, #0
739 mov r0, #8
740 str r0, [fp, #-8]
741 .L29:
742 ldr r0, [fp, #-8]
743 cmp r5, r0
744 bgt .L30
745 @ for k := 0 to N-1 do
746 mov r6, #0
747 mov r0, #8
748 str r0, [fp, #-4]
749 .L31:
750 ldr r0, [fp, #-4]
751 cmp r6, r0
752 bgt .L32
753 @ MakeMove(i, j, k);
754 mov r2, r6
755 mov r1, r5
756 mov r0, r4
757 bl _MakeMove
758 @ end
759 add r6, r6, #1
760 b .L31
761 .L32:
762 add r5, r5, #1
763 b .L29
764 .L30:
765 add r4, r4, #1
766 b .L27
767 .L26:
768 ldmfd fp, {r4-r10, fp, sp, pc}
769 .ltorg
770
771 @ proc Cover(p: Column);
772 _Cover:
773 mov ip, sp
774 stmfd sp!, {r0-r1}
775 stmfd sp!, {r4-r10, fp, ip, lr}
776 mov fp, sp
777 @ p^.covered := true;
778 mov r0, #1
779 ldr r1, [fp, #40]
780 strb r0, [r1, #16]
781 @ p^.prev^.next := p^.next; p^.next^.prev := p^.prev;
782 ldr r6, [fp, #40]
783 ldr r0, [r6, #24]
784 ldr r1, [r6, #20]
785 str r0, [r1, #24]
786 ldr r6, [fp, #40]
787 ldr r0, [r6, #20]
788 ldr r1, [r6, #24]
789 str r0, [r1, #20]
790 @ q := p^.head^.down;
791 ldr r0, [fp, #40]
792 ldr r0, [r0, #28]
793 ldr r4, [r0, #4]
794 .L34:
795 @ while q <> p^.head do
796 ldr r0, [fp, #40]
797 ldr r0, [r0, #28]
798 cmp r4, r0
799 beq .L33
800 @ r := q^.right;
801 ldr r5, [r4, #12]
802 .L37:
803 @ while r <> q do
804 cmp r5, r4
805 beq .L39
806 @ r^.up^.down := r^.down; r^.down^.up := r^.up;
807 ldr r0, [r5, #4]
808 ldr r1, [r5]
809 str r0, [r1, #4]
810 ldr r0, [r5]
811 ldr r1, [r5, #4]
812 str r0, [r1]
813 @ r^.column^.size := r^.column^.size-1; r := r^.right
814 ldr r0, [r5, #16]
815 add r6, r0, #12
816 ldr r0, [r6]
817 sub r0, r0, #1
818 str r0, [r6]
819 ldr r5, [r5, #12]
820 b .L37
821 .L39:
822 @ q := q^.down
823 ldr r4, [r4, #4]
824 b .L34
825 .L33:
826 ldmfd fp, {r4-r10, fp, sp, pc}
827 .ltorg
828
829 @ proc Uncover(p: Column);
830 _Uncover:
831 mov ip, sp
832 stmfd sp!, {r0-r1}
833 stmfd sp!, {r4-r10, fp, ip, lr}
834 mov fp, sp
835 @ p^.prev^.next := p; p^.next^.prev := p;
836 ldr r6, [fp, #40]
837 ldr r0, [r6, #20]
838 str r6, [r0, #24]
839 ldr r6, [fp, #40]
840 ldr r0, [r6, #24]
841 str r6, [r0, #20]
842 @ q := p^.head^.up;
843 ldr r0, [fp, #40]
844 ldr r0, [r0, #28]
845 ldr r4, [r0]
846 .L41:
847 @ while q <> p^.head do
848 ldr r0, [fp, #40]
849 ldr r0, [r0, #28]
850 cmp r4, r0
851 beq .L43
852 @ r := q^.left;
853 ldr r5, [r4, #8]
854 .L44:
855 @ while r <> q do
856 cmp r5, r4
857 beq .L46
858 @ r^.up^.down := r; r^.down^.up := r;
859 ldr r0, [r5]
860 str r5, [r0, #4]
861 ldr r0, [r5, #4]
862 str r5, [r0]
863 @ r^.column^.size := r^.column^.size+1; r := r^.left
864 ldr r0, [r5, #16]
865 add r6, r0, #12
866 ldr r0, [r6]
867 add r0, r0, #1
868 str r0, [r6]
869 ldr r5, [r5, #8]
870 b .L44
871 .L46:
872 @ q := q^.up
873 ldr r4, [r4]
874 b .L41
875 .L43:
876 @ p^.covered := false
877 mov r0, #0
878 ldr r1, [fp, #40]
879 strb r0, [r1, #16]
880 ldmfd fp, {r4-r10, fp, sp, pc}
881 .ltorg
882
883 @ proc ChooseColumn(): Column;
884 _ChooseColumn:
885 mov ip, sp
886 stmfd sp!, {r4-r10, fp, ip, lr}
887 mov fp, sp
888 @ col := root^.next;
889 set r0, _root
890 ldr r0, [r0]
891 ldr r5, [r0, #24]
892 @ c := col^.next;
893 ldr r4, [r5, #24]
894 .L48:
895 @ while c <> root do
896 set r0, _root
897 ldr r0, [r0]
898 cmp r4, r0
899 beq .L50
900 @ if c^.size < col^.size then col := c end;
901 ldr r0, [r4, #12]
902 ldr r1, [r5, #12]
903 cmp r0, r1
904 bge .L53
905 mov r5, r4
906 .L53:
907 @ c := c^.next
908 ldr r4, [r4, #24]
909 b .L48
910 .L50:
911 @ return col
912 mov r0, r5
913 ldmfd fp, {r4-r10, fp, sp, pc}
914 .ltorg
915
916 @ proc PrintState(level: integer);
917 _PrintState:
918 mov ip, sp
919 stmfd sp!, {r0-r1}
920 stmfd sp!, {r4-r10, fp, ip, lr}
921 mov fp, sp
922 sub sp, sp, #104
923 @ for i := 0 to N-1 do
924 mov r4, #0
925 mov r0, #8
926 str r0, [fp, #-96]
927 .L55:
928 ldr r0, [fp, #-96]
929 cmp r4, r0
930 bgt .L56
931 @ for j := 0 to N-1 do
932 mov r5, #0
933 mov r0, #8
934 str r0, [fp, #-92]
935 .L57:
936 ldr r0, [fp, #-92]
937 cmp r5, r0
938 bgt .L58
939 @ board[i][j] := '.'
940 mov r0, #46
941 add r1, fp, #-85
942 mov r2, #9
943 mul r2, r4, r2
944 add r1, r1, r2
945 add r1, r1, r5
946 strb r0, [r1]
947 add r5, r5, #1
948 b .L57
949 .L58:
950 add r4, r4, #1
951 b .L55
952 .L56:
953 @ for k := 0 to level-1 do
954 mov r6, #0
955 ldr r0, [fp, #40]
956 sub r0, r0, #1
957 str r0, [fp, #-100]
958 .L59:
959 ldr r0, [fp, #-100]
960 cmp r6, r0
961 bgt .L60
962 @ p := choice[k];
963 set r0, _choice
964 lsl r1, r6, #2
965 add r0, r0, r1
966 ldr r0, [r0]
967 str r0, [fp, #-4]
968 .L61:
969 @ while p^.column^.name <> 'Q' do p := p^.right end;
970 ldr r7, [fp, #-4]
971 ldr r0, [r7, #16]
972 ldrb r0, [r0]
973 cmp r0, #81
974 beq .L63
975 ldr r0, [r7, #12]
976 str r0, [fp, #-4]
977 b .L61
978 .L63:
979 @ i := p^.column^.x - 1; j := p^.column^.y - 1;
980 ldr r7, [fp, #-4]
981 ldr r8, [r7, #16]
982 ldr r0, [r8, #4]
983 sub r4, r0, #1
984 ldr r0, [r8, #8]
985 sub r5, r0, #1
986 @ board[i][j] := chr(p^.right^.column^.y + ord('0'))
987 ldr r0, [r7, #12]
988 ldr r0, [r0, #16]
989 ldr r0, [r0, #8]
990 add r0, r0, #48
991 add r1, fp, #-85
992 mov r2, #9
993 mul r2, r4, r2
994 add r1, r1, r2
995 add r1, r1, r5
996 strb r0, [r1]
997 add r6, r6, #1
998 b .L59
999 .L60:
1000 @ for i := 0 to N-1 do
1001 mov r4, #0
1002 mov r0, #8
1003 str r0, [fp, #-104]
1004 .L64:
1005 ldr r0, [fp, #-104]
1006 cmp r4, r0
1007 bgt .L54
1008 @ print_string(board[i]); newline()
1009 mov r1, #9
1010 add r0, fp, #-85
1011 mov r2, #9
1012 mul r2, r4, r2
1013 add r0, r0, r2
1014 bl print_string
1015 bl newline
1016 add r4, r4, #1
1017 b .L64
1018 .L54:
1019 ldmfd fp, {r4-r10, fp, sp, pc}
1020 .ltorg
1021
1022 @ proc Solve(level: integer);
1023 _Solve:
1024 mov ip, sp
1025 stmfd sp!, {r0-r1}
1026 stmfd sp!, {r4-r10, fp, ip, lr}
1027 mov fp, sp
1028 @ if root^.next = root then
1029 set r0, _root
1030 ldr r7, [r0]
1031 ldr r0, [r7, #24]
1032 cmp r0, r7
1033 bne .L69
1034 @ print_string("Solution:"); newline();
1035 mov r1, #9
1036 set r0, g5
1037 bl print_string
1038 bl newline
1039 @ PrintState(level); return
1040 ldr r0, [fp, #40]
1041 bl _PrintState
1042 b .L66
1043 .L69:
1044 @ col := ChooseColumn();
1045 bl _ChooseColumn
1046 mov r4, r0
1047 @ if col^.size = 0 then return end;
1048 ldr r0, [r4, #12]
1049 cmp r0, #0
1050 beq .L66
1051 @ Cover(col);
1052 mov r0, r4
1053 bl _Cover
1054 @ p := col^.head^.down;
1055 ldr r0, [r4, #28]
1056 ldr r5, [r0, #4]
1057 .L73:
1058 @ while p <> col^.head do
1059 ldr r0, [r4, #28]
1060 cmp r5, r0
1061 beq .L75
1062 @ choice[level] := p;
1063 ldr r7, [fp, #40]
1064 set r0, _choice
1065 lsl r1, r7, #2
1066 add r0, r0, r1
1067 str r5, [r0]
1068 @ print_num(level); print_string(":"); PrintRow(p);
1069 mov r0, r7
1070 bl print_num
1071 mov r1, #1
1072 set r0, g6
1073 bl print_string
1074 mov r0, r5
1075 bl _PrintRow
1076 @ q := p^.right;
1077 ldr r6, [r5, #12]
1078 .L76:
1079 @ while q <> p do Cover(q^.column); q := q^.right end;
1080 cmp r6, r5
1081 beq .L78
1082 ldr r0, [r6, #16]
1083 bl _Cover
1084 ldr r6, [r6, #12]
1085 b .L76
1086 .L78:
1087 @ Solve(level+1);
1088 ldr r0, [fp, #40]
1089 add r0, r0, #1
1090 bl _Solve
1091 @ q := p^.left;
1092 ldr r6, [r5, #8]
1093 .L79:
1094 @ while q <> p do Uncover(q^.column); q := q^.left end;
1095 cmp r6, r5
1096 beq .L81
1097 ldr r0, [r6, #16]
1098 bl _Uncover
1099 ldr r6, [r6, #8]
1100 b .L79
1101 .L81:
1102 @ p := p^.down
1103 ldr r5, [r5, #4]
1104 b .L73
1105 .L75:
1106 @ Uncover(col)
1107 mov r0, r4
1108 bl _Uncover
1109 .L66:
1110 ldmfd fp, {r4-r10, fp, sp, pc}
1111 .ltorg
1112
1113 @ proc ChooseRow(var level: integer; p: Cell);
1114 _ChooseRow:
1115 mov ip, sp
1116 stmfd sp!, {r0-r1}
1117 stmfd sp!, {r4-r10, fp, ip, lr}
1118 mov fp, sp
1119 @ choice[level] := p; level := level+1;
1120 ldr r5, [fp, #40]
1121 ldr r0, [fp, #44]
1122 set r1, _choice
1123 ldr r2, [r5]
1124 lsl r2, r2, #2
1125 add r1, r1, r2
1126 str r0, [r1]
1127 ldr r0, [r5]
1128 add r0, r0, #1
1129 str r0, [r5]
1130 @ q := p;
1131 ldr r4, [fp, #44]
1132 .L83:
1133 @ if q^.column^.covered then
1134 ldr r0, [r4, #16]
1135 ldrb r0, [r0, #16]
1136 cmp r0, #0
1137 beq .L87
1138 @ print_string("Conflict for "); PrintCol(q^.column); newline()
1139 mov r1, #13
1140 set r0, g7
1141 bl print_string
1142 ldr r0, [r4, #16]
1143 bl _PrintCol
1144 bl newline
1145 .L87:
1146 @ Cover(q^.column); q := q^.right
1147 ldr r0, [r4, #16]
1148 bl _Cover
1149 ldr r4, [r4, #12]
1150 ldr r0, [fp, #44]
1151 cmp r4, r0
1152 bne .L83
1153 ldmfd fp, {r4-r10, fp, sp, pc}
1154 .ltorg
1155
1156 @ proc Input(var level: integer);
1157 _Input:
1158 mov ip, sp
1159 stmfd sp!, {r0-r1}
1160 stmfd sp!, {r4-r10, fp, ip, lr}
1161 mov fp, sp
1162 sub sp, sp, #16
1163 @ for i := 0 to N-1 do
1164 mov r4, #0
1165 mov r0, #8
1166 str r0, [fp, #-12]
1167 .L89:
1168 ldr r0, [fp, #-12]
1169 cmp r4, r0
1170 bgt .L88
1171 @ for j := 0 to N-1 do
1172 mov r5, #0
1173 mov r0, #8
1174 str r0, [fp, #-8]
1175 .L91:
1176 ldr r0, [fp, #-8]
1177 cmp r5, r0
1178 bgt .L92
1179 @ ch := input[10*i+j];
1180 set r0, g8
1181 mov r1, #10
1182 mul r1, r4, r1
1183 add r0, r0, r1
1184 add r0, r0, r5
1185 ldrb r7, [r0]
1186 strb r7, [fp, #-1]
1187 @ print_char(ch);
1188 mov r0, r7
1189 bl print_char
1190 @ if ch <> '.' then
1191 ldrb r7, [fp, #-1]
1192 cmp r7, #46
1193 beq .L95
1194 @ k := ord(ch) - ord('1');
1195 sub r6, r7, #49
1196 @ ChooseRow(level, boardMove[i][j][k])
1197 set r0, _boardMove
1198 mov r1, #324
1199 mul r1, r4, r1
1200 add r0, r0, r1
1201 mov r1, #36
1202 mul r1, r5, r1
1203 add r0, r0, r1
1204 lsl r1, r6, #2
1205 add r0, r0, r1
1206 ldr r1, [r0]
1207 ldr r0, [fp, #40]
1208 bl _ChooseRow
1209 .L95:
1210 add r5, r5, #1
1211 b .L91
1212 .L92:
1213 @ newline()
1214 bl newline
1215 add r4, r4, #1
1216 b .L89
1217 .L88:
1218 ldmfd fp, {r4-r10, fp, sp, pc}
1219 .ltorg
1220
1221 pmain:
1222 mov ip, sp
1223 stmfd sp!, {r4-r10, fp, ip, lr}
1224 mov fp, sp
1225 @ MakePuzzle();
1226 bl _MakePuzzle
1227 @ level := 0;
1228 set r4, _level
1229 mov r0, #0
1230 str r0, [r4]
1231 @ Input(level);
1232 mov r0, r4
1233 bl _Input
1234 @ Solve(level)
1235 set r0, _level
1236 ldr r0, [r0]
1237 bl _Solve
1238 ldmfd fp, {r4-r10, fp, sp, pc}
1239 .ltorg
1240
1241 .comm _root, 4, 4
1242 .comm _boardCell, 324, 4
1243 .comm _boardColumn, 324, 4
1244 .comm _boardRow, 324, 4
1245 .comm _boardBlock, 324, 4
1246 .comm _boardMove, 2916, 4
1247 .comm _choice, 324, 4
1248 .comm _level, 4, 4
1249 .data
1250 g1:
1251 .byte 32
1252 .byte 0
1253 g2:
1254 .byte 59, 32, 35, 32
1255 .byte 0
1256 g3:
1257 .byte 32, 111, 102, 32
1258 .byte 0
1259 g4:
1260 .byte 32, 99, 104, 111, 105, 99, 101, 115, 32, 102
1261 .byte 111, 114, 32
1262 .byte 0
1263 g5:
1264 .byte 83, 111, 108, 117, 116, 105, 111, 110, 58
1265 .byte 0
1266 g6:
1267 .byte 58
1268 .byte 0
1269 g7:
1270 .byte 67, 111, 110, 102, 108, 105, 99, 116, 32, 102
1271 .byte 111, 114, 32
1272 .byte 0
1273 g8:
1274 .byte 46, 46, 51, 46, 46, 46, 46, 53, 49, 47
1275 .byte 53, 46, 50, 46, 46, 54, 52, 46, 46, 47
1276 .byte 46, 46, 55, 46, 53, 46, 46, 46, 46, 47
1277 .byte 46, 46, 46, 54, 51, 46, 55, 46, 46, 47
1278 .byte 50, 46, 46, 55, 46, 56, 46, 46, 54, 47
1279 .byte 46, 46, 52, 46, 50, 49, 46, 46, 46, 47
1280 .byte 46, 46, 46, 46, 55, 46, 56, 46, 46, 47
1281 .byte 46, 46, 56, 49, 46, 46, 54, 46, 57, 47
1282 .byte 49, 55, 46, 46, 46, 46, 53, 46, 46
1283 .byte 0
1284 @ End
1285 ]]*)