annotate ppc/test/cpsfac.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 (* cpsfac.p *)
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 MODULE Main 0 0
mike@0 42 IMPORT Lib 0
mike@0 43 ENDHDR
mike@0 44
mike@0 45 PROC _fac 0 0 0
mike@0 46 ! if n = 0 then return k(1) else return fac(n-1, k1) end
mike@0 47 LDLW 16
mike@0 48 JEQZ L3
mike@0 49 JUMP L4
mike@0 50 LABEL L3
mike@0 51 CONST 1
mike@0 52 LDLW 24
mike@0 53 LDLW 20
mike@0 54 PCALLW 1
mike@0 55 RETURNW
mike@0 56 LABEL L4
mike@0 57 LOCAL 0
mike@0 58 GLOBAL _k1
mike@0 59 LDLW 16
mike@0 60 CONST 1
mike@0 61 MINUS
mike@0 62 CONST 0
mike@0 63 GLOBAL _fac
mike@0 64 PCALLW 3
mike@0 65 RETURNW
mike@0 66 END
mike@0 67
mike@0 68 PROC _k1 4 0 0
mike@0 69 ! r1 := n * r;
mike@0 70 LDLW 12
mike@0 71 LDNW 16
mike@0 72 LDLW 16
mike@0 73 TIMES
mike@0 74 STLW -4
mike@0 75 ! print_num(n); print_string(" * "); print_num(r);
mike@0 76 LDLW 12
mike@0 77 LDNW 16
mike@0 78 CONST 0
mike@0 79 GLOBAL lib.print_num
mike@0 80 PCALL 1
mike@0 81 CONST 3
mike@0 82 GLOBAL g1
mike@0 83 CONST 0
mike@0 84 GLOBAL lib.print_string
mike@0 85 PCALL 2
mike@0 86 LDLW 16
mike@0 87 CONST 0
mike@0 88 GLOBAL lib.print_num
mike@0 89 PCALL 1
mike@0 90 ! print_string(" = "); print_num(r1); newline();
mike@0 91 CONST 3
mike@0 92 GLOBAL g2
mike@0 93 CONST 0
mike@0 94 GLOBAL lib.print_string
mike@0 95 PCALL 2
mike@0 96 LDLW -4
mike@0 97 CONST 0
mike@0 98 GLOBAL lib.print_num
mike@0 99 PCALL 1
mike@0 100 CONST 0
mike@0 101 GLOBAL lib.newline
mike@0 102 PCALL 0
mike@0 103 ! return k(r1)
mike@0 104 LDLW -4
mike@0 105 LDLW 12
mike@0 106 LDNW 24
mike@0 107 LDLW 12
mike@0 108 LDNW 20
mike@0 109 PCALLW 1
mike@0 110 RETURNW
mike@0 111 END
mike@0 112
mike@0 113 PROC _id 0 0 0
mike@0 114 ! return r
mike@0 115 LDLW 16
mike@0 116 RETURNW
mike@0 117 END
mike@0 118
mike@0 119 PROC MAIN 0 0 0
mike@0 120 ! print_num(fac(10, id));
mike@0 121 CONST 0
mike@0 122 GLOBAL _id
mike@0 123 CONST 10
mike@0 124 CONST 0
mike@0 125 GLOBAL _fac
mike@0 126 PCALLW 3
mike@0 127 CONST 0
mike@0 128 GLOBAL lib.print_num
mike@0 129 PCALL 1
mike@0 130 ! newline()
mike@0 131 CONST 0
mike@0 132 GLOBAL lib.newline
mike@0 133 PCALL 0
mike@0 134 RETURN
mike@0 135 END
mike@0 136
mike@0 137 ! String " * "
mike@0 138 DEFINE g1
mike@0 139 STRING 202A2000
mike@0 140
mike@0 141 ! String " = "
mike@0 142 DEFINE g2
mike@0 143 STRING 203D2000
mike@0 144
mike@0 145 ! End
mike@0 146 ]]*)