MSP430-FORTH/COMPSMPY.f

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