### view lab4/test/sudoku.p @ 4:9f5c8e19f204tipbasis

Oops: fix for lab0
author Mike Spivey Mon, 15 Oct 2018 21:58:03 +0100 5dd13b8deb54
line wrap: on
line source
```(* Sudoku solved with Knuth's dancing links *)

(* The Boolean matrix has:

* 81 columns Q11 .. Q99, one for each cell, since each cell must
contain exactly one digit.

* Nine columns Cn1 .. Cn9 for each column n of the puzzle grid, since
each column must contain each digit exactly once.

* Nine columns Rn1 .. Rn9 for each row of the puzzle grid.

* Nine columns Bn1 .. Bn9 for each block of the puzzle grid.

Each row corresponds to placing a digit in a single cell, and contains
four 1's, one in each of the four groups of columns above. *)

type
Cell = pointer to CellRec;
Column = pointer to ColRec;

CellRec = record
up, down, left, right: Cell; 	(* Neighbours *)
column: Column;			(* Top of the column *)
end;

ColRec = record
name: char;			(* Column code: C, R, B, Q *)
x, y: integer;			(* Two digits to identify column *)
size: integer;			(* No. of intersecting rows *)
covered: boolean;			(* Whether covered *)
prev, next: Column;		(* Links to adjacent columns *)
head: Cell;			(* Dummy node for this column *)
end;

var
root: Column; 			(* Root of the entire matrix *)

(* |PrintCol| -- print the name of a column *)
proc PrintCol(c: Column);
begin
print_char(c^.name); print_num(c^.x); print_num(c^.y)
end (* PrintCol *);

(* |PrintRow| -- print all columns in a given row *)
proc PrintRow(p: Cell);
var q: Cell; n: integer;
begin
(* Print the columns that intersect the row *)
q := p;
repeat
print_string(" "); PrintCol(q^.column); q := q^.right
until q = p;

(* Print position in column *)
n := 0; q := p^.column^.head;
while q <> p do n := n+1; q := q^.down end;
print_string("; # "); print_num(n); print_string(" of ");
print_num(p^.column^.size); print_string(" choices for ");
PrintCol(p^.column); newline()
end (* PrintRow *);

(* Creating the puzzle *)

const sqrtN = 3; N = sqrtN * sqrtN;

var
boardCell: array N of array N of Column;
boardColumn: array N of array N of Column;
boardRow: array N of array N of Column;
boardBlock: array N of array N of Column;
boardMove: array N of array N of array N of Cell;

proc ColumnLink(r: Column; var p: Cell);
var q: Cell;
begin
new(q);
if p = nil then
q^.right := q; q^.left := q; p := q
else
q^.left := p^.left; q^.right := p;
p^.left^.right := q; p^.left := q
end;
q^.column := r; r^.size := r^.size+1
end (* ColumnLink *);

proc MakeArray(var a: array N of array N of Column;
name: char; m, n: integer);
var
i, j: integer;
p: Column;
begin
for i := 0 to m-1 do
for j := 0 to n-1 do
new(p); p^.name := name; p^.x := i+1; p^.y := j+1;
p^.size := 0; p^.covered := false;
p^.prev := root^.prev; p^.next := root;
root^.prev^.next := p; root^.prev := p;
a[i][j] := p
end
end
end (* MakeArray *);

proc MakeMove(i, j, k: integer);
var p: Cell;
begin
p := nil;
ColumnLink(boardBlock[sqrtN * (i div sqrtN) + j div sqrtN][k], p);
boardMove[i][j][k] := p
end (* MakeMove *);

proc MakePuzzle();
var i, j, k: integer;
begin
new(root);
root^.prev := root; root^.next := root;

MakeArray(boardCell, 'Q', N, N);
MakeArray(boardColumn, 'C', N, N);
MakeArray(boardRow, 'R', N, N);
MakeArray(boardBlock, 'B', N, N);

for i := 0 to N-1 do
for j := 0 to N-1 do
for k := 0 to N-1 do
MakeMove(i, j, k);
end
end
end
end (* MakePuzzle *);

(* Exact cover problem *)

var
choice: array N*N of Cell; 	(* Current set of choices *)

(* |Cover| -- temporarily remove a column *)
proc Cover(p: Column);
var q, r: Cell;
begin
p^.covered := true;

(* Remove p from the list of columns *)
p^.prev^.next := p^.next; p^.next^.prev := p^.prev;

(* Block each row that intersects p *)
while q <> p^.head do
r := q^.right;
while r <> q do
r^.up^.down := r^.down; r^.down^.up := r^.up;
r^.column^.size := r^.column^.size-1; r := r^.right
end;
q := q^.down
end
end (* Cover *);

(* |Uncover| -- reverse the effect of |Cover| *)
proc Uncover(p: Column);
var q, r: Cell;
begin
(* Restore p to the list of columns *)
p^.prev^.next := p; p^.next^.prev := p;

(* Unblock each row that intersects p *)
while q <> p^.head do
r := q^.left;
while r <> q do
r^.up^.down := r; r^.down^.up := r;
r^.column^.size := r^.column^.size+1; r := r^.left
end;
q := q^.up
end;

p^.covered := false
end (* Uncover *);

(* |ChooseColumn| -- select a column according to stratregy *)
proc ChooseColumn(): Column;
var c, col: Column;
begin
(* Find smallest column |col| *)
col := root^.next;
c := col^.next;
while c <> root do
if c^.size < col^.size then col := c end;
c := c^.next
end;
return col
end (* ChooseColumn *);

proc PrintState(level: integer);
var
i, j, k: integer;
p: Cell;
board: array N of array N of char;
begin
for i := 0 to N-1 do
for j := 0 to N-1 do
board[i][j] := '.'
end
end;

for k := 0 to level-1 do
p := choice[k];
while p^.column^.name <> 'Q' do p := p^.right end;
i := p^.column^.x - 1; j := p^.column^.y - 1;
board[i][j] := chr(p^.right^.column^.y + ord('0'))
end;

for i := 0 to N-1 do
print_string(board[i]); newline()
end
end (* PrintState *);

(* |Solve| -- find an exact cover by backtracking search *)
proc Solve(level: integer);
var col: Column; p, q: Cell;
begin
if root^.next = root then
print_string("Solution:"); newline();
PrintState(level); return
end;

col := ChooseColumn();
if col^.size = 0 then return end;
Cover(col);

(* Try each row that intersects column col *)
while p <> col^.head do
choice[level] := p;

print_num(level); print_string(":"); PrintRow(p);

(* Cover other columns in row |p| *)
q := p^.right;
while q <> p do Cover(q^.column); q := q^.right end;

Solve(level+1);

(* Uncover other columns in row |p| *)
q := p^.left;
while q <> p do Uncover(q^.column); q := q^.left end;

p := p^.down
end;

Uncover(col)
end (* Solve *);

proc ChooseRow(var level: integer; p: Cell);
var q: Cell;
begin
choice[level] := p; level := level+1;
q := p;
repeat
if q^.column^.covered then
print_string("Conflict for "); PrintCol(q^.column); newline()
end;
Cover(q^.column); q := q^.right
until q = p
end (* ChooseRow *);

const input =
"..3....51/5.2..64../..7.5..../...63.7../2..7.8..6/..4.21.../....7.8../..81..6.9/17....5..";

proc Input(var level: integer);
var i, j, k: integer; ch: char;
begin
for i := 0 to N-1 do
for j := 0 to N-1 do
ch := input[10*i+j];
print_char(ch);
if ch <> '.' then
k := ord(ch) - ord('1');
ChooseRow(level, boardMove[i][j][k])
end
end;
newline()
end
end (* Input *);

(* Main program *)
var level: integer;

begin
MakePuzzle();
level := 0;
Input(level);
Solve(level)
end (* tSudoku *).

(*<<
..3....51
5.2..64..
..7.5....
...63.7..
2..7.8..6
..4.21...
....7.8..
..81..6.9
17....5..
28: Q85 C54 R84 B84; # 1 of 1 choices for Q85
29: Q55 C59 R59 B59; # 1 of 1 choices for Q55
30: Q15 C58 R18 B28; # 1 of 1 choices for Q15
31: Q25 C51 R21 B21; # 1 of 1 choices for Q25
32: Q64 C45 R65 B55; # 1 of 1 choices for Q64
33: Q46 C64 R44 B54; # 1 of 1 choices for Q46
34: Q81 C13 R83 B73; # 1 of 1 choices for Q81
35: Q95 C56 R96 B86; # 1 of 1 choices for Q95
36: Q93 C39 R99 B79; # 1 of 1 choices for Q93
37: C17 R67 B47 Q61; # 1 of 1 choices for C17
38: C36 R76 B76 Q73; # 1 of 1 choices for C36
39: Q71 C14 R74 B74; # 1 of 1 choices for Q71
40: C48 R98 B88 Q94; # 1 of 1 choices for C48
41: C67 R17 B27 Q16; # 1 of 1 choices for C67
42: C71 R51 B61 Q57; # 1 of 1 choices for C71
43: Q53 C35 R55 B45; # 1 of 1 choices for Q53
44: Q43 C31 R41 B41; # 1 of 1 choices for Q43
45: Q52 C23 R53 B43; # 1 of 1 choices for Q52
46: Q58 C84 R54 B64; # 1 of 1 choices for Q58
47: C21 R31 B11 Q32; # 1 of 1 choices for C21
48: C24 R14 B14 Q12; # 1 of 1 choices for C24
49: C26 R66 B46 Q62; # 1 of 1 choices for C26
50: C44 R34 B24 Q34; # 1 of 1 choices for C44
51: C81 R71 B91 Q78; # 1 of 1 choices for C81
52: C86 R36 B36 Q38; # 1 of 1 choices for C86
53: C16 R16 B16 Q11; # 1 of 1 choices for C16
54: C94 R94 B94 Q99; # 1 of 1 choices for C94
55: C95 R45 B65 Q49; # 1 of 1 choices for C95
56: C97 R27 B37 Q29; # 1 of 1 choices for C97
57: C87 R87 B97 Q88; # 1 of 1 choices for C87
58: R42 B62 Q48 C82; # 1 of 1 choices for R42
59: Q98 C83 R93 B93; # 1 of 1 choices for Q98
60: Q79 C92 R72 B92; # 1 of 1 choices for Q79
61: Q72 C25 R75 B75; # 1 of 1 choices for Q72
62: Q82 C22 R82 B72; # 1 of 1 choices for Q82
63: Q86 C65 R85 B85; # 1 of 1 choices for Q86
64: Q96 C62 R92 B82; # 1 of 1 choices for Q96
65: C42 R12 B22 Q14; # 1 of 1 choices for C42
66: Q17 C79 R19 B39; # 1 of 1 choices for Q17
67: Q28 C88 R28 B38; # 1 of 1 choices for Q28
68: Q22 C29 R29 B19; # 1 of 1 choices for Q22
69: Q24 C43 R23 B23; # 1 of 1 choices for Q24
70: Q31 C18 R38 B18; # 1 of 1 choices for Q31
71: Q36 C69 R39 B29; # 1 of 1 choices for Q36
72: Q39 C93 R33 B33; # 1 of 1 choices for Q39
73: Q37 C72 R32 B32; # 1 of 1 choices for Q37
74: Q41 C19 R49 B49; # 1 of 1 choices for Q41
75: Q42 C28 R48 B48; # 1 of 1 choices for Q42
76: Q67 C73 R63 B63; # 1 of 1 choices for Q67
77: Q68 C89 R69 B69; # 1 of 1 choices for Q68
78: Q69 C98 R68 B68; # 1 of 1 choices for Q69
79: Q74 C49 R79 B89; # 1 of 1 choices for Q74
80: Q76 C63 R73 B83; # 1 of 1 choices for Q76
Solution:
643287951
592316487
817459263
981634725
235798146
764521398
456973812
328145679
179862534
>>*)

(*[[
@ picoPascal compiler output
.include "fixup.s"
.global pmain

@ proc PrintCol(c: Column);
.text
_PrintCol:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   print_char(c^.name); print_num(c^.x); print_num(c^.y)
ldr r0, [fp, #40]
ldrb r0, [r0]
bl print_char
ldr r0, [fp, #40]
ldr r0, [r0, #4]
bl print_num
ldr r0, [fp, #40]
ldr r0, [r0, #8]
bl print_num
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc PrintRow(p: Cell);
_PrintRow:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   q := p;
ldr r4, [fp, #40]
.L11:
@     print_string(" "); PrintCol(q^.column); q := q^.right
mov r1, #1
set r0, g1
bl print_string
ldr r0, [r4, #16]
bl _PrintCol
ldr r4, [r4, #12]
ldr r6, [fp, #40]
cmp r4, r6
bne .L11
@   n := 0; q := p^.column^.head;
mov r5, #0
ldr r0, [r6, #16]
ldr r4, [r0, #28]
.L13:
@   while q <> p do n := n+1; q := q^.down end;
ldr r0, [fp, #40]
cmp r4, r0
beq .L15
add r5, r5, #1
ldr r4, [r4, #4]
b .L13
.L15:
@   print_string("; # "); print_num(n); print_string(" of ");
mov r1, #4
set r0, g2
bl print_string
mov r0, r5
bl print_num
mov r1, #4
set r0, g3
bl print_string
@   print_num(p^.column^.size); print_string(" choices for ");
ldr r0, [fp, #40]
ldr r0, [r0, #16]
ldr r0, [r0, #12]
bl print_num
mov r1, #13
set r0, g4
bl print_string
@   PrintCol(p^.column); newline()
ldr r0, [fp, #40]
ldr r0, [r0, #16]
bl _PrintCol
bl newline
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc ColumnLink(r: Column; var p: Cell);
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   new(q);
mov r0, #20
bl new
mov r4, r0
@   if p = nil then
ldr r0, [fp, #44]
ldr r0, [r0]
cmp r0, #0
bne .L18
@     q^.right := q; q^.left := q; p := q
str r4, [r4, #12]
str r4, [r4, #8]
ldr r0, [fp, #44]
str r4, [r0]
b .L19
.L18:
@     q^.left := p^.left; q^.right := p;
ldr r0, [fp, #44]
ldr r0, [r0]
ldr r0, [r0, #8]
str r0, [r4, #8]
ldr r0, [fp, #44]
ldr r0, [r0]
str r0, [r4, #12]
@     p^.left^.right := q; p^.left := q
ldr r0, [fp, #44]
ldr r0, [r0]
ldr r0, [r0, #8]
str r4, [r0, #12]
ldr r0, [fp, #44]
ldr r0, [r0]
str r4, [r0, #8]
.L19:
@   q^.up := r^.head^.up; q^.down := r^.head;
ldr r0, [fp, #40]
ldr r0, [r0, #28]
ldr r0, [r0]
str r0, [r4]
ldr r0, [fp, #40]
ldr r0, [r0, #28]
str r0, [r4, #4]
@   r^.head^.up^.down := q; r^.head^.up := q;
ldr r0, [fp, #40]
ldr r0, [r0, #28]
ldr r0, [r0]
str r4, [r0, #4]
ldr r0, [fp, #40]
ldr r0, [r0, #28]
str r4, [r0]
@   q^.column := r; r^.size := r^.size+1
ldr r0, [fp, #40]
str r0, [r4, #16]
ldr r0, [fp, #40]
add r5, r0, #12
ldr r0, [r5]
add r0, r0, #1
str r0, [r5]
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc MakeArray(var a: array N of array N of Column;
_MakeArray:
mov ip, sp
stmfd sp!, {r0-r3}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
sub sp, sp, #8
@   for i := 0 to m-1 do
mov r4, #0
ldr r0, [fp, #48]
sub r0, r0, #1
str r0, [fp, #-8]
.L21:
ldr r0, [fp, #-8]
cmp r4, r0
bgt .L20
@     for j := 0 to n-1 do
mov r5, #0
ldr r0, [fp, #52]
sub r0, r0, #1
str r0, [fp, #-4]
.L23:
ldr r0, [fp, #-4]
cmp r5, r0
bgt .L24
@       new(p); p^.name := name; p^.x := i+1; p^.y := j+1;
mov r0, #32
bl new
mov r6, r0
ldrb r0, [fp, #44]
strb r0, [r6]
add r0, r4, #1
str r0, [r6, #4]
add r0, r5, #1
str r0, [r6, #8]
@       p^.size := 0; p^.covered := false;
mov r0, #0
str r0, [r6, #12]
mov r0, #0
strb r0, [r6, #16]
mov r0, #20
bl new
str r0, [r6, #28]
ldr r7, [r6, #28]
str r7, [r7, #4]
ldr r7, [r6, #28]
str r7, [r7]
@       p^.prev := root^.prev; p^.next := root;
set r7, _root
ldr r0, [r7]
ldr r0, [r0, #20]
str r0, [r6, #20]
ldr r0, [r7]
str r0, [r6, #24]
@       root^.prev^.next := p; root^.prev := p;
ldr r0, [r7]
ldr r0, [r0, #20]
str r6, [r0, #24]
ldr r0, [r7]
str r6, [r0, #20]
@       a[i][j] := p
ldr r0, [fp, #40]
mov r1, #36
mul r1, r4, r1
add r0, r0, r1
lsl r1, r5, #2
add r0, r0, r1
str r6, [r0]
add r5, r5, #1
b .L23
.L24:
add r4, r4, #1
b .L21
.L20:
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc MakeMove(i, j, k: integer);
_MakeMove:
mov ip, sp
stmfd sp!, {r0-r3}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
sub sp, sp, #8
@   p := nil;
mov r0, #0
str r0, [fp, #-4]
add r1, fp, #-4
set r0, _boardCell
ldr r2, [fp, #40]
mov r3, #36
mul r2, r2, r3
add r0, r0, r2
ldr r2, [fp, #44]
lsl r2, r2, #2
add r0, r0, r2
ldr r0, [r0]
add r1, fp, #-4
set r0, _boardColumn
ldr r2, [fp, #44]
mov r3, #36
mul r2, r2, r3
add r0, r0, r2
ldr r2, [fp, #48]
lsl r2, r2, #2
add r0, r0, r2
ldr r0, [r0]
add r1, fp, #-4
set r0, _boardRow
ldr r2, [fp, #40]
mov r3, #36
mul r2, r2, r3
add r0, r0, r2
ldr r2, [fp, #48]
lsl r2, r2, #2
add r0, r0, r2
ldr r0, [r0]
@   ColumnLink(boardBlock[sqrtN * (i div sqrtN) + j div sqrtN][k], p);
mov r1, #3
ldr r0, [fp, #40]
bl int_div
mov r1, #3
mov r4, r0
ldr r0, [fp, #44]
bl int_div
add r1, fp, #-4
mov r5, r0
set r0, _boardBlock
mov r2, #3
mul r2, r4, r2
add r2, r2, r5
mov r3, #36
mul r2, r2, r3
add r0, r0, r2
ldr r2, [fp, #48]
lsl r2, r2, #2
add r0, r0, r2
ldr r0, [r0]
@   boardMove[i][j][k] := p
ldr r0, [fp, #-4]
set r1, _boardMove
ldr r2, [fp, #40]
mov r3, #324
mul r2, r2, r3
add r1, r1, r2
ldr r2, [fp, #44]
mov r3, #36
mul r2, r2, r3
add r1, r1, r2
ldr r2, [fp, #48]
lsl r2, r2, #2
add r1, r1, r2
str r0, [r1]
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc MakePuzzle();
_MakePuzzle:
mov ip, sp
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
sub sp, sp, #16
@   new(root);
mov r0, #32
bl new
set r7, _root
str r0, [r7]
@   root^.prev := root; root^.next := root;
str r0, [r0, #20]
ldr r7, [r7]
str r7, [r7, #24]
@   MakeArray(boardCell, 'Q', N, N);
mov r3, #9
mov r2, #9
mov r1, #81
set r0, _boardCell
bl _MakeArray
@   MakeArray(boardColumn, 'C', N, N);
mov r3, #9
mov r2, #9
mov r1, #67
set r0, _boardColumn
bl _MakeArray
@   MakeArray(boardRow, 'R', N, N);
mov r3, #9
mov r2, #9
mov r1, #82
set r0, _boardRow
bl _MakeArray
@   MakeArray(boardBlock, 'B', N, N);
mov r3, #9
mov r2, #9
mov r1, #66
set r0, _boardBlock
bl _MakeArray
@   for i := 0 to N-1 do
mov r4, #0
mov r0, #8
str r0, [fp, #-12]
.L27:
ldr r0, [fp, #-12]
cmp r4, r0
bgt .L26
@     for j := 0 to N-1 do
mov r5, #0
mov r0, #8
str r0, [fp, #-8]
.L29:
ldr r0, [fp, #-8]
cmp r5, r0
bgt .L30
@       for k := 0 to N-1 do
mov r6, #0
mov r0, #8
str r0, [fp, #-4]
.L31:
ldr r0, [fp, #-4]
cmp r6, r0
bgt .L32
@         MakeMove(i, j, k);
mov r2, r6
mov r1, r5
mov r0, r4
bl _MakeMove
@       end
add r6, r6, #1
b .L31
.L32:
add r5, r5, #1
b .L29
.L30:
add r4, r4, #1
b .L27
.L26:
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc Cover(p: Column);
_Cover:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   p^.covered := true;
mov r0, #1
ldr r1, [fp, #40]
strb r0, [r1, #16]
@   p^.prev^.next := p^.next; p^.next^.prev := p^.prev;
ldr r6, [fp, #40]
ldr r0, [r6, #24]
ldr r1, [r6, #20]
str r0, [r1, #24]
ldr r6, [fp, #40]
ldr r0, [r6, #20]
ldr r1, [r6, #24]
str r0, [r1, #20]
@   q := p^.head^.down;
ldr r0, [fp, #40]
ldr r0, [r0, #28]
ldr r4, [r0, #4]
.L34:
@   while q <> p^.head do
ldr r0, [fp, #40]
ldr r0, [r0, #28]
cmp r4, r0
beq .L33
@     r := q^.right;
ldr r5, [r4, #12]
.L37:
@     while r <> q do
cmp r5, r4
beq .L39
@       r^.up^.down := r^.down; r^.down^.up := r^.up;
ldr r0, [r5, #4]
ldr r1, [r5]
str r0, [r1, #4]
ldr r0, [r5]
ldr r1, [r5, #4]
str r0, [r1]
@       r^.column^.size := r^.column^.size-1; r := r^.right
ldr r0, [r5, #16]
add r6, r0, #12
ldr r0, [r6]
sub r0, r0, #1
str r0, [r6]
ldr r5, [r5, #12]
b .L37
.L39:
@     q := q^.down
ldr r4, [r4, #4]
b .L34
.L33:
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc Uncover(p: Column);
_Uncover:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   p^.prev^.next := p; p^.next^.prev := p;
ldr r6, [fp, #40]
ldr r0, [r6, #20]
str r6, [r0, #24]
ldr r6, [fp, #40]
ldr r0, [r6, #24]
str r6, [r0, #20]
@   q := p^.head^.up;
ldr r0, [fp, #40]
ldr r0, [r0, #28]
ldr r4, [r0]
.L41:
@   while q <> p^.head do
ldr r0, [fp, #40]
ldr r0, [r0, #28]
cmp r4, r0
beq .L43
@     r := q^.left;
ldr r5, [r4, #8]
.L44:
@     while r <> q do
cmp r5, r4
beq .L46
@       r^.up^.down := r; r^.down^.up := r;
ldr r0, [r5]
str r5, [r0, #4]
ldr r0, [r5, #4]
str r5, [r0]
@       r^.column^.size := r^.column^.size+1; r := r^.left
ldr r0, [r5, #16]
add r6, r0, #12
ldr r0, [r6]
add r0, r0, #1
str r0, [r6]
ldr r5, [r5, #8]
b .L44
.L46:
@     q := q^.up
ldr r4, [r4]
b .L41
.L43:
@   p^.covered := false
mov r0, #0
ldr r1, [fp, #40]
strb r0, [r1, #16]
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc ChooseColumn(): Column;
_ChooseColumn:
mov ip, sp
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   col := root^.next;
set r0, _root
ldr r0, [r0]
ldr r5, [r0, #24]
@   c := col^.next;
ldr r4, [r5, #24]
.L48:
@   while c <> root do
set r0, _root
ldr r0, [r0]
cmp r4, r0
beq .L50
@     if c^.size < col^.size then col := c end;
ldr r0, [r4, #12]
ldr r1, [r5, #12]
cmp r0, r1
bge .L53
mov r5, r4
.L53:
@     c := c^.next
ldr r4, [r4, #24]
b .L48
.L50:
@   return col
mov r0, r5
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc PrintState(level: integer);
_PrintState:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
sub sp, sp, #104
@   for i := 0 to N-1 do
mov r4, #0
mov r0, #8
str r0, [fp, #-96]
.L55:
ldr r0, [fp, #-96]
cmp r4, r0
bgt .L56
@     for j := 0 to N-1 do
mov r5, #0
mov r0, #8
str r0, [fp, #-92]
.L57:
ldr r0, [fp, #-92]
cmp r5, r0
bgt .L58
@       board[i][j] := '.'
mov r0, #46
add r1, fp, #-85
mov r2, #9
mul r2, r4, r2
add r1, r1, r2
add r1, r1, r5
strb r0, [r1]
add r5, r5, #1
b .L57
.L58:
add r4, r4, #1
b .L55
.L56:
@   for k := 0 to level-1 do
mov r6, #0
ldr r0, [fp, #40]
sub r0, r0, #1
str r0, [fp, #-100]
.L59:
ldr r0, [fp, #-100]
cmp r6, r0
bgt .L60
@     p := choice[k];
set r0, _choice
lsl r1, r6, #2
add r0, r0, r1
ldr r0, [r0]
str r0, [fp, #-4]
.L61:
@     while p^.column^.name <> 'Q' do p := p^.right end;
ldr r7, [fp, #-4]
ldr r0, [r7, #16]
ldrb r0, [r0]
cmp r0, #81
beq .L63
ldr r0, [r7, #12]
str r0, [fp, #-4]
b .L61
.L63:
@     i := p^.column^.x - 1; j := p^.column^.y - 1;
ldr r7, [fp, #-4]
ldr r8, [r7, #16]
ldr r0, [r8, #4]
sub r4, r0, #1
ldr r0, [r8, #8]
sub r5, r0, #1
@     board[i][j] := chr(p^.right^.column^.y + ord('0'))
ldr r0, [r7, #12]
ldr r0, [r0, #16]
ldr r0, [r0, #8]
add r0, r0, #48
add r1, fp, #-85
mov r2, #9
mul r2, r4, r2
add r1, r1, r2
add r1, r1, r5
strb r0, [r1]
add r6, r6, #1
b .L59
.L60:
@   for i := 0 to N-1 do
mov r4, #0
mov r0, #8
str r0, [fp, #-104]
.L64:
ldr r0, [fp, #-104]
cmp r4, r0
bgt .L54
@     print_string(board[i]); newline()
mov r1, #9
add r0, fp, #-85
mov r2, #9
mul r2, r4, r2
add r0, r0, r2
bl print_string
bl newline
add r4, r4, #1
b .L64
.L54:
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc Solve(level: integer);
_Solve:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   if root^.next = root then
set r0, _root
ldr r7, [r0]
ldr r0, [r7, #24]
cmp r0, r7
bne .L69
@     print_string("Solution:"); newline();
mov r1, #9
set r0, g5
bl print_string
bl newline
@     PrintState(level); return
ldr r0, [fp, #40]
bl _PrintState
b .L66
.L69:
@   col := ChooseColumn();
bl _ChooseColumn
mov r4, r0
@   if col^.size = 0 then return end;
ldr r0, [r4, #12]
cmp r0, #0
beq .L66
@   Cover(col);
mov r0, r4
bl _Cover
@   p := col^.head^.down;
ldr r0, [r4, #28]
ldr r5, [r0, #4]
.L73:
@   while p <> col^.head do
ldr r0, [r4, #28]
cmp r5, r0
beq .L75
@     choice[level] := p;
ldr r7, [fp, #40]
set r0, _choice
lsl r1, r7, #2
add r0, r0, r1
str r5, [r0]
@     print_num(level); print_string(":"); PrintRow(p);
mov r0, r7
bl print_num
mov r1, #1
set r0, g6
bl print_string
mov r0, r5
bl _PrintRow
@     q := p^.right;
ldr r6, [r5, #12]
.L76:
@     while q <> p do Cover(q^.column); q := q^.right end;
cmp r6, r5
beq .L78
ldr r0, [r6, #16]
bl _Cover
ldr r6, [r6, #12]
b .L76
.L78:
@     Solve(level+1);
ldr r0, [fp, #40]
add r0, r0, #1
bl _Solve
@     q := p^.left;
ldr r6, [r5, #8]
.L79:
@     while q <> p do Uncover(q^.column); q := q^.left end;
cmp r6, r5
beq .L81
ldr r0, [r6, #16]
bl _Uncover
ldr r6, [r6, #8]
b .L79
.L81:
@     p := p^.down
ldr r5, [r5, #4]
b .L73
.L75:
@   Uncover(col)
mov r0, r4
bl _Uncover
.L66:
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc ChooseRow(var level: integer; p: Cell);
_ChooseRow:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   choice[level] := p; level := level+1;
ldr r5, [fp, #40]
ldr r0, [fp, #44]
set r1, _choice
ldr r2, [r5]
lsl r2, r2, #2
add r1, r1, r2
str r0, [r1]
ldr r0, [r5]
add r0, r0, #1
str r0, [r5]
@   q := p;
ldr r4, [fp, #44]
.L83:
@     if q^.column^.covered then
ldr r0, [r4, #16]
ldrb r0, [r0, #16]
cmp r0, #0
beq .L87
@       print_string("Conflict for "); PrintCol(q^.column); newline()
mov r1, #13
set r0, g7
bl print_string
ldr r0, [r4, #16]
bl _PrintCol
bl newline
.L87:
@     Cover(q^.column); q := q^.right
ldr r0, [r4, #16]
bl _Cover
ldr r4, [r4, #12]
ldr r0, [fp, #44]
cmp r4, r0
bne .L83
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

@ proc Input(var level: integer);
_Input:
mov ip, sp
stmfd sp!, {r0-r1}
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
sub sp, sp, #16
@   for i := 0 to N-1 do
mov r4, #0
mov r0, #8
str r0, [fp, #-12]
.L89:
ldr r0, [fp, #-12]
cmp r4, r0
bgt .L88
@     for j := 0 to N-1 do
mov r5, #0
mov r0, #8
str r0, [fp, #-8]
.L91:
ldr r0, [fp, #-8]
cmp r5, r0
bgt .L92
@       ch := input[10*i+j];
set r0, g8
mov r1, #10
mul r1, r4, r1
add r0, r0, r1
add r0, r0, r5
ldrb r7, [r0]
strb r7, [fp, #-1]
@       print_char(ch);
mov r0, r7
bl print_char
@       if ch <> '.' then
ldrb r7, [fp, #-1]
cmp r7, #46
beq .L95
@         k := ord(ch) - ord('1');
sub r6, r7, #49
@ 	ChooseRow(level, boardMove[i][j][k])
set r0, _boardMove
mov r1, #324
mul r1, r4, r1
add r0, r0, r1
mov r1, #36
mul r1, r5, r1
add r0, r0, r1
lsl r1, r6, #2
add r0, r0, r1
ldr r1, [r0]
ldr r0, [fp, #40]
bl _ChooseRow
.L95:
add r5, r5, #1
b .L91
.L92:
@     newline()
bl newline
add r4, r4, #1
b .L89
.L88:
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

pmain:
mov ip, sp
stmfd sp!, {r4-r10, fp, ip, lr}
mov fp, sp
@   MakePuzzle();
bl _MakePuzzle
@   level := 0;
set r4, _level
mov r0, #0
str r0, [r4]
@   Input(level);
mov r0, r4
bl _Input
@   Solve(level)
set r0, _level
ldr r0, [r0]
bl _Solve
ldmfd fp, {r4-r10, fp, sp, pc}
.ltorg

.comm _root, 4, 4
.comm _boardCell, 324, 4
.comm _boardColumn, 324, 4
.comm _boardRow, 324, 4
.comm _boardBlock, 324, 4
.comm _boardMove, 2916, 4
.comm _choice, 324, 4
.comm _level, 4, 4
.data
g1:
.byte 32
.byte 0
g2:
.byte 59, 32, 35, 32
.byte 0
g3:
.byte 32, 111, 102, 32
.byte 0
g4:
.byte 32, 99, 104, 111, 105, 99, 101, 115, 32, 102
.byte 111, 114, 32
.byte 0
g5:
.byte 83, 111, 108, 117, 116, 105, 111, 110, 58
.byte 0
g6:
.byte 58
.byte 0
g7:
.byte 67, 111, 110, 102, 108, 105, 99, 116, 32, 102
.byte 111, 114, 32
.byte 0
g8:
.byte 46, 46, 51, 46, 46, 46, 46, 53, 49, 47
.byte 53, 46, 50, 46, 46, 54, 52, 46, 46, 47
.byte 46, 46, 55, 46, 53, 46, 46, 46, 46, 47
.byte 46, 46, 46, 54, 51, 46, 55, 46, 46, 47
.byte 50, 46, 46, 55, 46, 56, 46, 46, 54, 47
.byte 46, 46, 52, 46, 50, 49, 46, 46, 46, 47
.byte 46, 46, 46, 46, 55, 46, 56, 46, 46, 47
.byte 46, 46, 56, 49, 46, 46, 54, 46, 57, 47
.byte 49, 55, 46, 46, 46, 46, 53, 46, 46
.byte 0
@ End
]]*)```