|
0
|
1 (* Compute factorials using CPS *)
|
|
|
2
|
|
|
3 proc fac(n: integer; proc k(r: integer): integer): integer;
|
|
|
4 proc k1(r: integer): integer;
|
|
|
5 var r1: integer;
|
|
|
6 begin
|
|
|
7 r1 := n * r;
|
|
|
8 print_num(n); print_string(" * "); print_num(r);
|
|
|
9 print_string(" = "); print_num(r1); newline();
|
|
|
10 return k(r1)
|
|
|
11 end;
|
|
|
12 begin
|
|
|
13 if n = 0 then return k(1) else return fac(n-1, k1) end
|
|
|
14 end;
|
|
|
15
|
|
|
16 proc id(r: integer): integer;
|
|
|
17 begin
|
|
|
18 return r
|
|
|
19 end;
|
|
|
20
|
|
|
21 begin
|
|
|
22 print_num(fac(10, id));
|
|
|
23 newline()
|
|
|
24 end.
|
|
|
25
|
|
|
26 (*<<
|
|
|
27 1 * 1 = 1
|
|
|
28 2 * 1 = 2
|
|
|
29 3 * 2 = 6
|
|
|
30 4 * 6 = 24
|
|
|
31 5 * 24 = 120
|
|
|
32 6 * 120 = 720
|
|
|
33 7 * 720 = 5040
|
|
|
34 8 * 5040 = 40320
|
|
|
35 9 * 40320 = 362880
|
|
|
36 10 * 362880 = 3628800
|
|
|
37 3628800
|
|
|
38 >>*)
|
|
|
39
|
|
|
40 (*[[
|
|
|
41 @ picoPascal compiler output
|
|
|
42 .include "fixup.s"
|
|
|
43 .global pmain
|
|
|
44
|
|
|
45 @ proc fac(n: integer; proc k(r: integer): integer): integer;
|
|
|
46 .text
|
|
|
47 _fac:
|
|
|
48 mov ip, sp
|
|
|
49 stmfd sp!, {r0-r3}
|
|
|
50 stmfd sp!, {r4-r10, fp, ip, lr}
|
|
|
51 mov fp, sp
|
|
|
52 @ if n = 0 then return k(1) else return fac(n-1, k1) end
|
|
|
53 ldr r0, [fp, #40]
|
|
|
54 cmp r0, #0
|
|
|
55 bne .L5
|
|
|
56 mov r0, #1
|
|
|
57 ldr r10, [fp, #48]
|
|
|
58 ldr r1, [fp, #44]
|
|
|
59 blx r1
|
|
|
60 b .L3
|
|
|
61 .L5:
|
|
|
62 mov r2, fp
|
|
|
63 set r1, _k1
|
|
|
64 ldr r0, [fp, #40]
|
|
|
65 sub r0, r0, #1
|
|
|
66 bl _fac
|
|
|
67 .L3:
|
|
|
68 ldmfd fp, {r4-r10, fp, sp, pc}
|
|
|
69 .ltorg
|
|
|
70
|
|
|
71 @ proc k1(r: integer): integer;
|
|
|
72 _k1:
|
|
|
73 mov ip, sp
|
|
|
74 stmfd sp!, {r0-r1}
|
|
|
75 stmfd sp!, {r4-r10, fp, ip, lr}
|
|
|
76 mov fp, sp
|
|
|
77 @ r1 := n * r;
|
|
|
78 ldr r0, [fp, #24]
|
|
|
79 ldr r5, [r0, #40]
|
|
|
80 ldr r0, [fp, #40]
|
|
|
81 mul r4, r5, r0
|
|
|
82 @ print_num(n); print_string(" * "); print_num(r);
|
|
|
83 mov r0, r5
|
|
|
84 bl print_num
|
|
|
85 mov r1, #3
|
|
|
86 set r0, g1
|
|
|
87 bl print_string
|
|
|
88 ldr r0, [fp, #40]
|
|
|
89 bl print_num
|
|
|
90 @ print_string(" = "); print_num(r1); newline();
|
|
|
91 mov r1, #3
|
|
|
92 set r0, g2
|
|
|
93 bl print_string
|
|
|
94 mov r0, r4
|
|
|
95 bl print_num
|
|
|
96 bl newline
|
|
|
97 @ return k(r1)
|
|
|
98 ldr r5, [fp, #24]
|
|
|
99 mov r0, r4
|
|
|
100 ldr r10, [r5, #48]
|
|
|
101 ldr r1, [r5, #44]
|
|
|
102 blx r1
|
|
|
103 ldmfd fp, {r4-r10, fp, sp, pc}
|
|
|
104 .ltorg
|
|
|
105
|
|
|
106 @ proc id(r: integer): integer;
|
|
|
107 _id:
|
|
|
108 mov ip, sp
|
|
|
109 stmfd sp!, {r0-r1}
|
|
|
110 stmfd sp!, {r4-r10, fp, ip, lr}
|
|
|
111 mov fp, sp
|
|
|
112 @ return r
|
|
|
113 ldr r0, [fp, #40]
|
|
|
114 ldmfd fp, {r4-r10, fp, sp, pc}
|
|
|
115 .ltorg
|
|
|
116
|
|
|
117 pmain:
|
|
|
118 mov ip, sp
|
|
|
119 stmfd sp!, {r4-r10, fp, ip, lr}
|
|
|
120 mov fp, sp
|
|
|
121 @ print_num(fac(10, id));
|
|
|
122 mov r2, #0
|
|
|
123 set r1, _id
|
|
|
124 mov r0, #10
|
|
|
125 bl _fac
|
|
|
126 bl print_num
|
|
|
127 @ newline()
|
|
|
128 bl newline
|
|
|
129 ldmfd fp, {r4-r10, fp, sp, pc}
|
|
|
130 .ltorg
|
|
|
131
|
|
|
132 .data
|
|
|
133 g1:
|
|
|
134 .byte 32, 42, 32
|
|
|
135 .byte 0
|
|
|
136 g2:
|
|
|
137 .byte 32, 61, 32
|
|
|
138 .byte 0
|
|
|
139 @ End
|
|
|
140 ]]*)
|
