primitives.fth (5077B)
1 \ Primitives.fth - Forth primitives from CodeM0M1.fth 2 3 (( 4 Copyright (c) 2010, 2011 5 MicroProcessor Engineering 6 133 Hill Lane 7 Southampton SO15 5AF 8 England 9 10 tel: +44 (0)23 8063 1441 11 fax: +44 (0)23 8033 9691 12 net: mpe@mpeforth.com 13 tech-support@mpeforth.com 14 web: www.mpeforth.com 15 16 From North America, our telephone and fax numbers are: 17 011 44 23 8063 1441 18 011 44 23 8033 9691 19 20 21 To do 22 ===== 23 24 Change history 25 ============== 26 20110628 MPE002 Cortex-M0 conversion. 27 20100125 MPE001 Cortex-M3 first version. 28 )) 29 30 only forth definitions 31 32 code cmove \ asrc adest len -- 33 \ *G Copy *\i{len} bytes of memory forwards from *\i{asrc} to *\i{adest}. 34 mov .s r3, tos \ r3=len 35 ldmia psp ! { r0, r1, tos } \ r0=addr2, r1=addr1, r3=len, tos restored 36 eq, if, 37 bx link \ return if len=0, nothing to do 38 endif, 39 mov .s r2, r0 40 orr .s r2, r2, r1 \ check alignment 41 orr .s r2, r2, r3 \ R2 := adr1|addr2|len 42 mov .s r4, # 3 43 and .s r4, r4, r2, \ will be zero if aligned 44 b .ne cmovx3 \ if not aligned 45 L: CMOVX1 46 ldr r2, [ r1 ] 47 str r2, [ r0 ] 48 add .s r1, r1, # 4 49 add .s r0, r0, # 4 50 sub .s r3, r3, # 4 51 b .ne CMOVX1 52 bx lr 53 L: CMOVX3 54 ldrb r2, [ r1 ] 55 strb r2, [ r0 ] 56 add .s r1, r1, # 1 57 add .s r0, r0, # 1 58 sub .s r3, r3, # 1 59 b .ne CMOVX3 60 bx lr 61 END-CODE 62 63 (( 64 CODE BRANCH \ -- 65 \ *G The run time action of unconditional branches compiled on the target. 66 \ ** The branch target address is in-line and must have the T bit set. 67 \ ** INTERNAL. 68 l: takebranch 69 mov .s r1, # 1 70 mov r0, link 71 bic .s r0, r1 72 ldr r2, [ r0 ] \ get address and branch 73 bx r2 74 END-CODE 75 76 CODE ?BRANCH \ n -- 77 \ *G The run time action of conditional branches compiled on the target. 78 \ ** The branch target address is in-line and must have the T bit set. 79 \ ** INTERNAL. 80 mov .s r1, tos 81 ldmia psp ! { tos } 82 b .eq takebranch 83 l: skipbranch 84 mov r0, link 85 add .s r0, # 4 86 bx r0 87 END-CODE 88 )) 89 90 CODE (DO) \ limit index -- 91 \ *G The run time action of *\fo{DO} compiled on the target. 92 \ ** The branch target address is in-line and must have the T bit set. 93 \ ** INTERNAL. 94 ldmia psp ! { r1 } \ get limit 95 L: PDO 96 mov .s r4, # 1 97 lsl .s r4, r4, # #31 \ r4 := $8000:0000 98 mov r3, link 99 sub .s r3, r3, # 1 \ clear T bit 100 ldr r2, [ r3 ] \ get LEAVE address, compiler sets T bit 101 add .s r1, r1, r4 \ limit+$8000:0000 102 sub .s r0, tos, r1 \ index-limit-$8000:0000 103 104 push { r0, r1, r2 } \ push LEAVE then limit, then index on ret. stack 105 ldmia psp ! { tos } \ update tos 106 l: skipbranch 107 mov r0, link 108 add .s r0, # 4 109 bx r0 110 END-CODE 111 112 CODE (?DO) \ limit index -- 113 \ *G The run time action of *\fo{?DO} compiled on the target. 114 \ ** The branch target address is in-line and must have the T bit set. 115 \ ** INTERNAL. 116 ldmia psp ! { r1 } \ get limit 117 cmp r1, tos \ check not equal 118 b .ne pdo \ take DO ? 119 ldmia psp ! { tos } \ update tos 120 l: takebranch 121 mov .s r1, # 1 122 mov r0, link 123 bic .s r0, r1 124 ldr r2, [ r0 ] \ get address and branch 125 bx r2 126 END-CODE 127 128 asmcode 129 here is-action-of constant 130 \ *G The runtime code for a CONSTANT. 131 sub .s psp, psp, # 4 \ save TOS 132 str tos, [ psp, # 0 ] 133 mov r0, link \ LINK is high register 134 sub .s r0, r0, # 1 \ remove T bit 135 ldr tos, [ r0, # 0 ] \ get data address (in-line) 136 pop { pc } 137 END-CODE 138 139 code di \ -- 140 \ *G Disable interruots. 141 cps .id .i 142 bx lr 143 end-code 144 145 CODE WITHIN \ n1|u1 n2|u2 n3|u3 -- flag 146 \ *G The ANS version of WITHIN?. 147 \ ** This word uses unsigned arithmetic, so that signed compares are 148 \ ** treated as existing on a number circle. 149 mov r2, tos \ save tos 150 ldmia psp ! { r0, r1 } \ r2 = n3, r0 = n2, r1 = n1 151 mov .s tos, # 0 \ assume false 152 sub .s r2, r2, r0 153 sub .s r1, r1, r0 154 cmp r1, r2 155 lo, if, 156 mvn .s tos, tos 157 endif, 158 bx lr 159 END-CODE 160 161 code um/mod \ ud1 u2 -- urem uquot 162 \ *G Full 64 by 32 unsigned division subroutine. 163 \ ** This routine uses a loop for code size. 164 ldmia psp ! { r0 } \ dividend high 165 ldr r1, [ psp ] \ dividend low 166 mov .s r4, # #32 \ loop counter 167 mov .s r2, # 0 \ always 0 168 begin, 169 \ udiv64_step 170 add .s r1, r1, r1 \ 64 bit shift of dividend 171 adc .s r0, r0, r0 172 mov r3, r2 \ must not affect flags 173 adc .s r3, r3, r2 \ preserve dividend bit 63, R2=0 174 sub .s r0, r0, tos \ trial subtraction, carry set (no borrow) if ok 175 adc .s r3, r3, r3 \ success if bit 0 or 1 set 176 ne, if, 177 add .s r1, r1, # 1 \ succeeded, update quotient 178 else, 179 add .s r0, r0, tos \ failed, undo subtraction 180 endif, 181 sub .s r4, r4, # 1 182 eq, until, 183 mov tos, r1 \ move quotient 184 str r0, [ psp ] \ move remainder 185 bx lr 186 end-code 187 188 : u/ \ u1 u2 -- uquot 189 0 swap um/mod nip ; 190