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