comparison ppc/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 (* cpsfib.p *)
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 MODULE Main 0 0
41 IMPORT Lib 0
42 ENDHDR
43
44 PROC _fib 0 0 0
45 ! return fib1(n, id)
46 LOCAL 0
47 GLOBAL _id
48 LDLW 16
49 LOCAL 0
50 GLOBAL _fib1
51 PCALLW 3
52 RETURNW
53 END
54
55 PROC _fib1 0 0 0
56 ! if n <= 1 then
57 LDLW 16
58 CONST 1
59 JGT L2
60 ! return k(1)
61 CONST 1
62 LDLW 24
63 LDLW 20
64 PCALLW 1
65 RETURNW
66 LABEL L2
67 ! return fib1(n-1, k1)
68 LOCAL 0
69 GLOBAL _k1
70 LDLW 16
71 CONST 1
72 MINUS
73 LDLW 12
74 GLOBAL _fib1
75 PCALLW 3
76 RETURNW
77 END
78
79 PROC _k1 0 0 0
80 ! begin return fib1(n-2, k2) end;
81 LOCAL 0
82 GLOBAL _k2
83 LDLW 12
84 LDNW 16
85 CONST 2
86 MINUS
87 LDLW 12
88 LDNW 12
89 GLOBAL _fib1
90 PCALLW 3
91 RETURNW
92 END
93
94 PROC _k2 0 0 0
95 ! proc k2(r2: integer): integer; begin return k(r1 + r2) end;
96 LDLW 12
97 LDNW 16
98 LDLW 16
99 PLUS
100 LDLW 12
101 LDNW 12
102 LDNW 24
103 LDLW 12
104 LDNW 12
105 LDNW 20
106 PCALLW 1
107 RETURNW
108 END
109
110 PROC _id 0 0 0
111 ! proc id(r: integer): integer; begin return r end;
112 LDLW 16
113 RETURNW
114 END
115
116 PROC MAIN 0 0 0
117 ! print_num(fib(6)); newline()
118 CONST 6
119 CONST 0
120 GLOBAL _fib
121 PCALLW 1
122 CONST 0
123 GLOBAL lib.print_num
124 PCALL 1
125 CONST 0
126 GLOBAL lib.newline
127 PCALL 0
128 RETURN
129 END
130
131 ! End
132 ]]*)