comparison lab4/test/cpsfac.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 (* 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 ]]*)