MSP430-FORTH/ANS_COMP_SMPY.f

   1 ; ----------------------------------------------------------------------------------
   2 ; ANS complement for MSP430FR4xxx devices without hardware_MPY, to pass CORETEST.4th
   3 ; when downloading to SD_CARD target, truncate filename ANS_COMP_SMPY.4th to ANS_COMP.4th
   4 ; ----------------------------------------------------------------------------------
   5
   6 \ REGISTERS USAGE
   7 \ R4 to R7 must be saved before use and restored after
   8 \ scratch registers Y to S are free for use
   9 \ under interrupt, IP is free for use
  10
  11 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, R7, R6, R5, R4
  12 \ example : PUSHM IP,Y
  13 \
  14 \ POPM  order :  R4, R5, R6, R7,  Y,  X,  W,  T,  S, IP,TOS,PSP
  15 \ example : POPM Y,IP
  16
  17 \ ASSEMBLER conditionnal usage before IF UNTIL WHILE : S< S>= U< U>= 0= 0<> 0>=
  18 \ ASSEMBLER conditionnal usage before ?JMP ?GOTO    : S< S>= U< U>= 0= 0<> 0<
  19
  20 \ FORTH conditionnal usage before IF UNTIL WHILE : 0= 0< = < > U<
  21
  22
  23
  24 CODE INVERT     \   x1 -- x2            bitwise inversion
  25             XOR #-1,TOS
  26             MOV @IP+,PC
  27 ENDCODE
  28     \
  29
  30 CODE LSHIFT     \   x1 u -- x2    logical L shift u places
  31             MOV @PSP+,W
  32             AND #$1F,TOS        \ no need to shift more than 16
  33 0<> IF
  34     BEGIN   ADD W,W
  35             SUB #1,TOS
  36     0= UNTIL
  37 THEN        MOV W,TOS
  38             MOV @IP+,PC
  39 ENDCODE
  40     \
  41
  42 CODE RSHIFT \   x1 u -- x2    logical R shift u places
  43             MOV @PSP+,W
  44             AND #$1F,TOS       \ no need to shift more than 16
  45 0<> IF
  46     BEGIN   BIC #C,SR           \ Clr Carry
  47             RRC W
  48             SUB #1,TOS
  49     0= UNTIL
  50 THEN        MOV W,TOS
  51             MOV @IP+,PC
  52 ENDCODE
  53     \
  54
  55 CODE 1+     \    n1/u1 -- n2/u2       add 1 to TOS
  56             ADD #1,TOS
  57             MOV @IP+,PC
  58 ENDCODE
  59     \
  60
  61 CODE 1-     \ n1/u1 -- n2/u2     subtract 1 from TOS
  62             SUB #1,TOS
  63             MOV @IP+,PC
  64 ENDCODE
  65     \
  66
  67 CODE MAX    \    n1 n2 -- n3       signed maximum
  68             CMP     @PSP,TOS    \ n2-n1
  69             S<      ?GOTO FW1   \ n2<n1
  70 BW1         ADD     #2,PSP
  71             MOV     @IP+,PC
  72 ENDCODE
  73     \
  74
  75 CODE MIN    \    n1 n2 -- n3       signed minimum
  76             CMP     @PSP,TOS     \ n2-n1
  77             S<      ?GOTO BW1    \ n2<n1
  78 FW1         MOV     @PSP+,TOS
  79             MOV     @IP+,PC
  80 ENDCODE
  81     \
  82
  83 CODE 2*     \   x1 -- x2        arithmetic left shift
  84             ADD TOS,TOS
  85             MOV @IP+,PC
  86 ENDCODE
  87     \
  88
  89 CODE 2/     \   x1 -- x2        arithmetic right shift
  90             RRA TOS
  91             MOV @IP+,PC
  92 ENDCODE
  93     \
  94
  95 \ --------------------
  96 \ ARITHMETIC OPERATORS
  97 \ --------------------
  98
  99 : S>D           \ n -- d      single -> double
 100     DUP 0<
 101 ;
 102     \
 103
 104 \ \ C UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
 105 \ CODE UM*
 106 \             MOV @PSP,S
 107 \ \ u2          = TOS register
 108 \ \ MULTIPLIERl = S
 109 \ \ MULTIPLIERh = W
 110 \ \ BIT         = X
 111 \ \ RESULTlo    = Y
 112 \ \ RESULThi    = T
 113 \ \ T.I. SIGNED MULTIPLY SUBROUTINE: u2 x u1 -> ud
 114 \             MOV #0,Y        \  0 -> LSBs RESULT
 115 \             MOV #0,T        \  0 -> MSBs RESULT
 116 \             MOV #0,W        \  0 -> MSBs MULTIPLIER
 117 \             MOV #1,X        \  BIT TEST REGISTER
 118 \ BEGIN       BIT X,TOS       \ 1 TEST ACTUAL BIT ; IF 0: DO NOTHING
 119 \     0<> IF                  \ 2 IF 1: ADD MULTIPLIER TO RESULT
 120 \             ADD S,Y         \ 1
 121 \             ADDC W,T        \ 1
 122 \     THEN    ADD S,S         \ 1 (RLA LSBs) MULTIPLIER x 2
 123 \             ADDC W,W        \ 1 (RLC MSBs)
 124 \             ADD X,X         \ 1 (RLA) NEXT BIT TO TEST
 125 \ U>= UNTIL                   \ 2 IF BIT IN CARRY: FINISHED    10~ loop
 126 \             MOV Y,0(PSP)    \  low result on stack
 127 \             MOV T,TOS       \  high result in TOS
 128 \             MOV @IP+,PC
 129 \ ENDCODE
 130 \     \
 131
 132 CODE M*             \ n1 n2 -- dlo dhi  signed 16*16->32 multiply
 133 MOV TOS,S           \ TOS= n2
 134 XOR @PSP,S          \ S contains sign of result
 135 CMP #0,0(PSP)       \ n1 > -1 ?
 136 S< IF
 137     XOR #-1,0(PSP)  \ n1 --> u1
 138     ADD #1,0(PSP)   \
 139 THEN
 140 CMP #0,TOS          \ n2 > -1 ?
 141 S< IF
 142     XOR #-1,TOS     \ n2 --> u2
 143     ADD #1,TOS      \
 144 THEN
 145 PUSHM IP,S
 146 LO2HI               \ -- ud1 u2
 147 UM*                 \ UMSTAR use S,T,W,X,Y
 148 HI2LO
 149 POPM S,IP
 150 CMP #0,S            \ sign of result > -1 ?
 151 S< IF
 152     XOR #-1,0(PSP)  \ ud --> d
 153     XOR #-1,TOS
 154     ADD #1,0(PSP)
 155     ADDC #0,TOS
 156 THEN
 157 MOV     @IP+,PC
 158 ENDCODE
 159     \
 160
 161 \ TOS = DIVISOR
 162 \ S   = DIVIDENDlo
 163 \ W   = DIVIDENDhi
 164 \ X   = count
 165 \ Y   = QUOTIENT
 166 \ DVDhi|DVDlo : DIVISOR -> QUOT in Y, REM in DVDhi
 167 \ RETURN: CARRY = 0: OK CARRY = 1: QUOTIENT > 16 BITS
 168
 169 \ C UM/MOD   udlo|udhi u1 -- ur uq
 170 CODE UM/MOD
 171     MOV @PSP+,W     \ 2 W = DIVIDENDhi
 172     MOV @PSP,S      \ 2 S = DIVIDENDlo
 173     MOV #16,X       \ 2 INITIALIZE LOOP COUNTER
 174 BW1 CMP TOS,W       \ 1 dividendHI-divisor
 175     U< ?GOTO FW1    \ 2 if not carry
 176     SUB TOS,W       \ 1 if carry
 177 FW1                 \   FW1 is resolved therefore reusable
 178 BW2 ADDC Y,Y        \ 1 RLC quotient
 179     SUB #1,X        \ 1 Decrement loop counter
 180     0< ?GOTO FW1    \ 2 if 0< terminate
 181     ADD S,S         \ 1 RLA
 182     ADDC W,W        \ 1 RLC
 183     U< ?GOTO BW1    \ 2 if not carry    14~ loop
 184     SUB TOS,W       \ 1
 185     BIS #1,SR       \ 1 SETC
 186     GOTO BW2        \ 2                 14~ loop
 187 FW1 MOV W,0(PSP)    \ 3 remainder on stack
 188     MOV Y,TOS       \ 1 quotient in TOS
 189     MOV @IP+,PC     \ 4
 190 ENDCODE
 191     \
 192
 193 CODE SM/REM         \ d1lo d1hi n2 -- n3 n4  symmetric signed div
 194 MOV TOS,S           \           S=divisor
 195 MOV @PSP,T          \           T=dividend_sign=rem_sign
 196 CMP #0,TOS          \           n2 >= 0 ?
 197 S< IF               \
 198     XOR #-1,TOS
 199     ADD #1,TOS      \ -- d1 u2
 200 THEN
 201 CMP #0,0(PSP)       \           d1hi >= 0 ?
 202 S< IF               \
 203     XOR #-1,2(PSP)  \           d1lo
 204     XOR #-1,0(PSP)  \           d1hi
 205     ADD #1,2(PSP)   \           d1lo+1
 206     ADDC #0,0(PSP)  \           d1hi+C
 207 THEN
 208 PUSHM IP,S
 209 LO2HI               \ -- ud1 u2
 210 UM/MOD              \           UM/MOD use S,W,X,Y, not T
 211 HI2LO               \ -- u3 u4
 212 POPM S,IP
 213 CMP #0,T          \           T=rem_sign
 214 S< IF
 215     XOR #-1,0(PSP)
 216     ADD #1,0(PSP)
 217 THEN                \ -- n3 u4
 218 XOR S,T         \           S=divisor T=quot_sign
 219 CMP #0,T          \           T=quot_sign
 220 S< IF
 221     XOR #-1,TOS
 222     ADD #1,TOS
 223 THEN                \ -- n3 n4  S=divisor
 224 MOV @IP+,PC
 225 ENDCODE
 226     \
 227
 228
 229 : FM/MOD            \ d1 n1 -- n2 n3   floored signed div'n
 230 SM/REM
 231 HI2LO               \ -- remainder quotient       S=divisor
 232 CMP #0,0(PSP)       \
 233 0<> IF
 234     CMP #1,TOS      \ quotient < 1 ?
 235     S< IF
 236       ADD S,0(PSP)  \ add divisor to remainder
 237       SUB #1,TOS    \ decrement quotient
 238     THEN
 239 THEN
 240 MOV @RSP+,IP
 241 MOV @IP+,PC
 242 ENDCODE
 243     \
 244
 245 : *         \ n1 n2 -- n3           n1*n2 --> n3
 246 M* DROP
 247 ;
 248     \
 249
 250 : /MOD      \ n1 n2 -- n3 n4        n1/n2 --> rem quot
 251 >R DUP 0< R> FM/MOD
 252 ;
 253     \
 254
 255 : /         \ n1 n2 -- n3           n1/n2 --> quot
 256 >R DUP 0< R> FM/MOD NIP
 257 ;
 258     \
 259
 260 : MOD       \ n1 n2 -- n3           n1/n2 --> rem
 261 >R DUP 0< R> FM/MOD DROP
 262 ;
 263     \
 264
 265 : */MOD     \ n1 n2 n3 -- n4 n5     n1*n2/n3 --> rem quot
 266 >R M* R> FM/MOD
 267 ;
 268     \
 269
 270 : */        \ n1 n2 n3 -- n4        n1*n2/n3 --> quot
 271 >R M* R> FM/MOD NIP
 272 ;
 273     \
 274
 275 \ ----------------------------------------------------------------------
 276 \ DOUBLE OPERATORS
 277 \ ----------------------------------------------------------------------
 278
 279 CODE 2@        \ a-addr -- x1 x2    fetch 2 cells \ the lower address will appear on top of stack
 280 SUB     #2, PSP
 281 MOV     2(TOS),0(PSP)
 282 MOV     @TOS,TOS
 283 MOV     @IP+,PC
 284 ENDCODE
 285     \
 286
 287 CODE 2!         \ x1 x2 a-addr --    store 2 cells \ the top of stack is stored at the lower adr
 288 MOV     @PSP+,0(TOS)
 289 MOV     @PSP+,2(TOS)
 290 MOV     @PSP+,TOS
 291 MOV     @IP+,PC
 292 ENDCODE
 293     \
 294
 295 CODE 2DUP       \ x1 x2 -- x1 x2 x1 x2   dup top 2 cells
 296 SUB     #4,PSP          \ -- x1 x x x2
 297 MOV     TOS,2(PSP)      \ -- x1 x2 x x2
 298 MOV     4(PSP),0(PSP)   \ -- x1 x2 x1 x2
 299 MOV     @IP+,PC
 300 ENDCODE
 301     \
 302
 303 CODE 2DROP      \ x1 x2 --      drop 2 cells
 304 ADD     #2,PSP
 305 MOV     @PSP+,TOS
 306 MOV     @IP+,PC
 307 ENDCODE
 308     \
 309
 310 CODE 2SWAP      \ x1 x2 x3 x4 -- x3 x4 x1 x2
 311 MOV     @PSP,W          \ -- x1 x2 x3 x4    W=x3
 312 MOV     4(PSP),0(PSP)   \ -- x1 x2 x1 x4
 313 MOV     W,4(PSP)        \ -- x3 x2 x1 x4
 314 MOV     TOS,W           \ -- x3 x2 x1 x4    W=x4
 315 MOV     2(PSP),TOS      \ -- x3 x2 x1 x2    W=x4
 316 MOV     W,2(PSP)        \ -- x3 x4 x1 x2
 317 MOV     @IP+,PC
 318 ENDCODE
 319     \
 320
 321 CODE 2OVER      \ x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
 322 SUB     #4,PSP          \ -- x1 x2 x3 x x x4
 323 MOV     TOS,2(PSP)      \ -- x1 x2 x3 x4 x x4
 324 MOV     8(PSP),0(PSP)   \ -- x1 x2 x3 x4 x1 x4
 325 MOV     6(PSP),TOS      \ -- x1 x2 x3 x4 x1 x2
 326 MOV     @IP+,PC
 327 ENDCODE
 328     \
 329
 330
 331 \ ----------------------------------------------------------------------
 332 \ ALIGNMENT OPERATORS
 333 \ ----------------------------------------------------------------------
 334
 335 CODE ALIGNED    \ addr -- a-addr       align given addr
 336 BIT     #1,TOS
 337 ADDC    #0,TOS
 338 MOV     @IP+,PC
 339 ENDCODE
 340     \
 341
 342 CODE ALIGN      \ --                         align HERE
 343 BIT     #1,&DP  \ 3
 344 ADDC    #0,&DP  \ 4
 345 MOV     @IP+,PC
 346 ENDCODE
 347     \
 348
 349 \ ---------------------
 350 \ PORTABILITY OPERATORS
 351 \ ---------------------
 352
 353 CODE CHARS      \ n1 -- n2            chars->adrs units
 354 MOV     @IP+,PC
 355 ENDCODE
 356     \
 357
 358 CODE CHAR+      \ c-addr1 -- c-addr2   add char size
 359 ADD     #1,TOS
 360 MOV     @IP+,PC
 361 ENDCODE
 362     \
 363
 364 CODE CELLS      \ n1 -- n2            cells->adrs units
 365 ADD     TOS,TOS
 366 MOV     @IP+,PC
 367 ENDCODE
 368     \
 369
 370 CODE CELL+      \ a-addr1 -- a-addr2      add cell size
 371 ADD     #2,TOS
 372 MOV     @IP+,PC
 373 ENDCODE
 374     \
 375 \ ---------------------------
 376 \ BLOCK AND STRING COMPLEMENT
 377 \ ---------------------------
 378
 379 : CHAR      \ -- char       parse ASCII character
 380     BL WORD 1+ C@
 381 ;
 382     \
 383
 384 : [CHAR]    \ --            compile character literal
 385     CHAR lit lit , ,
 386 ; IMMEDIATE
 387     \
 388
 389 CODE +!         \ n/u a-addr --     add to memory
 390 ADD @PSP+,0(TOS)
 391 MOV @PSP+,TOS
 392 MOV @IP+,PC
 393 ENDCODE
 394     \
 395
 396
 397 CODE FILL       \ c-addr u char --  fill memory with char
 398 MOV @PSP+,X     \ count
 399 MOV @PSP+,W     \ address
 400 CMP #0,X
 401 0<> IF
 402     BEGIN
 403         MOV.B TOS,0(W)    \ store char in memory
 404         ADD #1,W
 405         SUB #1,X
 406     0= UNTIL
 407 THEN
 408 MOV @PSP+,TOS     \ empties stack
 409 MOV @IP+,PC
 410 ENDCODE
 411     \
 412
 413 \ --------------------
 414 \ INTERPRET COMPLEMENT
 415 \ --------------------
 416
 417 CODE HEX
 418 MOV     #$10,&BASE
 419 MOV     @IP+,PC
 420 ENDCODE
 421     \
 422
 423 CODE DECIMAL
 424 MOV     #$0A,&BASE
 425 MOV     @IP+,PC
 426 ENDCODE
 427     \
 428 : (                 \
 429 $29 WORD DROP
 430 ; IMMEDIATE
 431     \
 432
 433 : .(             \  --     dotparen \ type comment immediatly.
 434 \ CAPS_OFF        \  --     set CAPS_OFF  (recompile FORTH with LOWERCASE swith ON before, must be paired with set CAP_ON)
 435 $29 WORD
 436 COUNT TYPE
 437 \ CAPS_ON               \  --     set CAPS_OFF  (recompile FORTH with LOWERCASE swith ON before, must be paired with set CAP_ON)
 438 ; IMMEDIATE
 439     \
 440
 441 CODE SOURCE         \ -- adr u    current input buffer
 442 SUB #4,PSP
 443 MOV TOS,2(PSP)
 444 MOV &SOURCE_LEN,TOS
 445 MOV &SOURCE_ADR,0(PSP)
 446 MOV @IP+,PC
 447 ENDCODE
 448     \
 449
 450 CODE >BODY
 451 ADD #4,TOS
 452 MOV @IP+,PC
 453 ENDCODE
 454     \
 455
 456             ; added ANS_COMPLEMENT: INVERT LSHIFT RSHIFT 1+ 1- MAX MIN 2* 2/ CHAR [CHAR] +! FILL HEX DECIMAL ( .( SOURCE >BODY
 457             ;                       ARITHMETIC: S>D UM* M* UM/MOD SM/REM FM/MOD * /MOD / MOD */MOD */
 458             ;                       DOUBLE: 2@ 2! 2DUP 2DROP 2SWAP 2OVER
 459             ;                       ALIGMENT: ALIGNED ALIGN
 460             ;                       PORTABIITY: CHARS CHAR+ CELLS CELL+
 461
 462             ;    v--- use backspaces before hit "CR" if you want decrease level of app protection
 463 PWR_HERE RST_HERE