annotate lab4/test/cpsfib.p @ 1:b5139af1a420 tip basis

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