comparison lab4/test/cpsfib.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 (* Fibonacci numbers in CPS *)
2
3 (* This program computes fibonacci numbers using the usual doubly
4 recursive algorithm. However, the algorithm has been transformed
5 into continuation passing style. A good test for procedural
6 parameters! *)
7
8 (* fib -- fibonacci numbers *)
9 proc fib(n: integer): integer;
10
11 (* fib1 -- continuation transformer for fib *)
12 proc fib1(n: integer; proc k(r: integer): integer) : integer;
13 proc k1(r1: integer): integer;
14 proc k2(r2: integer): integer; begin return k(r1 + r2) end;
15 begin return fib1(n-2, k2) end;
16 begin
17 if n <= 1 then
18 return k(1)
19 else
20 return fib1(n-1, k1)
21 end
22 end;
23
24 (* id -- identity continuation *)
25 proc id(r: integer): integer; begin return r end;
26
27 begin
28 return fib1(n, id)
29 end;
30
31 begin
32 print_num(fib(6)); newline()
33 end.
34
35 (*<<
36 13
37 >>*)
38
39 (*[[
40 @ picoPascal compiler output
41 .include "fixup.s"
42 .global pmain
43
44 @ proc fib(n: integer): integer;
45 .text
46 _fib:
47 mov ip, sp
48 stmfd sp!, {r0-r1}
49 stmfd sp!, {r4-r10, fp, ip, lr}
50 mov fp, sp
51 @ return fib1(n, id)
52 mov r2, fp
53 set r1, _id
54 ldr r0, [fp, #40]
55 mov r10, fp
56 bl _fib1
57 ldmfd fp, {r4-r10, fp, sp, pc}
58 .ltorg
59
60 @ proc fib1(n: integer; proc k(r: integer): integer) : integer;
61 _fib1:
62 mov ip, sp
63 stmfd sp!, {r0-r3}
64 stmfd sp!, {r4-r10, fp, ip, lr}
65 mov fp, sp
66 @ if n <= 1 then
67 ldr r0, [fp, #40]
68 cmp r0, #1
69 bgt .L4
70 @ return k(1)
71 mov r0, #1
72 ldr r10, [fp, #48]
73 ldr r1, [fp, #44]
74 blx r1
75 b .L2
76 .L4:
77 @ return fib1(n-1, k1)
78 mov r2, fp
79 set r1, _k1
80 ldr r0, [fp, #40]
81 sub r0, r0, #1
82 ldr r10, [fp, #24]
83 bl _fib1
84 .L2:
85 ldmfd fp, {r4-r10, fp, sp, pc}
86 .ltorg
87
88 @ proc k1(r1: integer): integer;
89 _k1:
90 mov ip, sp
91 stmfd sp!, {r0-r1}
92 stmfd sp!, {r4-r10, fp, ip, lr}
93 mov fp, sp
94 @ begin return fib1(n-2, k2) end;
95 ldr r4, [fp, #24]
96 mov r2, fp
97 set r1, _k2
98 ldr r0, [r4, #40]
99 sub r0, r0, #2
100 ldr r10, [r4, #24]
101 bl _fib1
102 ldmfd fp, {r4-r10, fp, sp, pc}
103 .ltorg
104
105 @ proc k2(r2: integer): integer; begin return k(r1 + r2) end;
106 _k2:
107 mov ip, sp
108 stmfd sp!, {r0-r1}
109 stmfd sp!, {r4-r10, fp, ip, lr}
110 mov fp, sp
111 @ proc k2(r2: integer): integer; begin return k(r1 + r2) end;
112 ldr r4, [fp, #24]
113 ldr r5, [r4, #24]
114 ldr r0, [r4, #40]
115 ldr r1, [fp, #40]
116 add r0, r0, r1
117 ldr r10, [r5, #48]
118 ldr r1, [r5, #44]
119 blx r1
120 ldmfd fp, {r4-r10, fp, sp, pc}
121 .ltorg
122
123 @ proc id(r: integer): integer; begin return r end;
124 _id:
125 mov ip, sp
126 stmfd sp!, {r0-r1}
127 stmfd sp!, {r4-r10, fp, ip, lr}
128 mov fp, sp
129 @ proc id(r: integer): integer; begin return r end;
130 ldr r0, [fp, #40]
131 ldmfd fp, {r4-r10, fp, sp, pc}
132 .ltorg
133
134 pmain:
135 mov ip, sp
136 stmfd sp!, {r4-r10, fp, ip, lr}
137 mov fp, sp
138 @ print_num(fib(6)); newline()
139 mov r0, #6
140 bl _fib
141 bl print_num
142 bl newline
143 ldmfd fp, {r4-r10, fp, sp, pc}
144 .ltorg
145
146 @ End
147 ]]*)