MSP430-FORTH/test/UDSLHMOD.f

   1 \ -*- coding: utf-8 -*-
   2 \ http://patorjk.com/software/taag/#p=display&f=Banner&t=Fast Forth
   3
   4 \ TARGET SELECTION
   5 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   6 \ MSP_EXP430FR4133  MSP_EXP430FR2433    MSP_EXP430FR2355    CHIPSTICK_FR2433
   7 \ MY_MSP430FR5738_1 MY_MSP430FR5738     MY_MSP430FR5948     MY_MSP430FR5948_1
   8 \ JMJ_BOX
   9
  10 \ Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices
  11 \ Copyright (C) <2015>  <J.M. THOORENS>
  12 \
  13 \ This program is free software: you can redistribute it and/or modify
  14 \ it under the terms of the GNU General Public License as published by
  15 \ the Free Software Foundation, either version 3 of the License, or
  16 \ (at your option) any later version.
  17 \
  18 \ This program is distributed in the hope that it will be useful,
  19 \ but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 \ GNU General Public License for more details.
  22 \
  23 \ You should have received a copy of the GNU General Public License
  24 \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 \ REGISTERS USAGE
  27 \ rDODOES to rEXIT must be saved before use and restored after
  28 \ scratch registers Y to S are free for use
  29 \ under interrupt, IP is free for use
  30
  31 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT, rDOVAR, rDOCON, rDODOES
  32 \ example : PUSHM IP,Y
  33 \
  34 \ POPM  order :  rDODOES, rDOCON, rDOVAR, rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  35 \ example : POPM Y,IP
  36
  37 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  38
  39 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  40
  41 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  42
  43
  44 RST_RET
  45
  46 CODE DSM/REM                    \ D1 / D2 --> DREM DQUOT
  47             MOV TOS,Y           \ 1 Y=DVRhi
  48             MOV @PSP+,W         \ 2 W=DVRlo
  49             MOV @PSP+,X         \ 2 X=DVDhi
  50             MOV @PSP,T          \ 2 T=DVDlo
  51             PUSHM #5,X          \ 7 PUSHM DVDhi,DVRhi, M, P, Q
  52             AND #-1,Y           \ 1 Y=DVRhi < 0 ?
  53 S< IF       XOR #-1,W           \ 1 W=INV(DVRlo)
  54             XOR #-1,Y           \ 1 Y=INV(DVRhi)
  55             ADD #1,W            \ 1 W=INV(DVRlo)+1
  56             ADDC #0,Y           \ 1 Y=INV(DVRhi)+C
  57 THEN
  58             AND #-1,X           \ 1 X=DVDhi < 0 ?
  59 S< IF       XOR #-1,T           \ 1 T=INV(DVDlo)
  60             XOR #-1,X           \ 1 X=INV(DVDhi)
  61             ADD #1,T            \ 1 T=INV(DVDlo)+1
  62             ADDC #0,X           \ 1 X=INV(DVDhi)+C
  63 THEN
  64 \ ------------------------------------------------------------------------
  65 \ don't uncomment lines below, don't rub out, please !
  66 \ ------------------------------------------------------------------------
  67 \           UD/MOD    DVDlo DVDhi DVRlo DVRhi -- REMlo REMhi QUOTlo QUOThi
  68 \ ------------------------------------------------------------------------
  69 \            MOV TOS,Y           \ 1 Y=DVRhi
  70 \            MOV @PSP+,W         \ 2 W=DVRlo
  71 \            MOV @PSP+,X         \ 2 X=DVDhi
  72 \            MOV @PSP,T          \ 2 T=DVDlo
  73 \            PUSHM #5,X          \ 7 PUSHM DVDhi,DVRhi, M, P, Q
  74              MOV #0,M            \ 1 M=REMlo = 0
  75             MOV #0,P            \ 1 P=REMhi = 0
  76             MOV #32,Q           \ 2 Q=count
  77 BW1         CMP Y,P             \ 1 REMhi = DVRhi ?
  78     0= IF   CMP W,M             \ 1 REMlo U< DVRlo ?
  79     THEN
  80     U>= IF  SUB W,M             \ 1 no:  REMlo - DVRlo  (carry is set)
  81             SUBC Y,P            \ 1      REMhi - DVRhi
  82     THEN
  83     BEGIN   ADDC S,S            \ 1 RLC quotLO
  84             ADDC TOS,TOS        \ 1 RLC quotHI
  85             SUB #1,Q            \ 1 Decrement loop counter
  86     U>= WHILE                   \ 2 out of loop if count<0
  87             ADD T,T             \ 1 RLA DVDlo
  88             ADDC X,X            \ 1 RLC DVDhi
  89             ADDC M,M            \ 1 RLC REMlo
  90             ADDC P,P            \ 1 RLC REMhi
  91             U< ?GOTO BW1        \ 2 19~ loop
  92             SUB W,M             \ 1 REMlo - DVRlo
  93             SUBC Y,P            \ 1 REMhi - DVRhi
  94             BIS #1,SR           \ 1
  95     REPEAT                      \ 2 16~ loop
  96             MOV M,T             \ 1 T=REMlo
  97             MOV P,W             \ 1 W=REMhi
  98             POPM #5,X           \ 7 X=DVDhi, Y=DVRhi, restore M, P, Q, as system regs
  99             CMP #0,X            \ 1 sign of Rem ?
 100     S< IF   XOR #-1,T           \ 1 INV(REMlo)
 101             XOR #-1,W           \ 1 INV(REMhi)
 102             ADD #1,T            \ 1 INV(REMlo)+1
 103             ADDC #0,W           \ 1 INV(REMhi)+C
 104     THEN
 105             SUB #4,PSP          \
 106             MOV T,4(PSP)        \   REMlo
 107             MOV W,2(PSP)        \   REMhi
 108             XOR X,Y
 109             CMP #0,Y            \ sign of Quot ?
 110 S< IF       XOR #-1,S           \ 1 INV(QUOTlo)
 111             XOR #-1,TOS         \ 1 INV(QUOThi)
 112             ADD #1,S            \ 1 INV(QUOTlo)+1
 113             ADDC #0,TOS         \ 1 INV(QUOThi)+C
 114 THEN
 115             MOV S,0(PSP)        \ 3 QUOTlo
 116             MOV @IP+,PC         \ 4
 117 ENDCODE
 118
 119 PWR_HERE
 120
 121 [UNDEFINED] DROP [IF]
 122 \ https://forth-standard.org/standard/core/DROP
 123 \ DROP     x --          drop top of stack
 124 CODE DROP
 125 MOV @PSP+,TOS   \ 2
 126 MOV @IP+,PC     \ 4
 127 ENDCODE
 128 [THEN]
 129
 130 : UD. \    u --           display ud (unsigned)
 131 <# #S #> TYPE $20 EMIT
 132 ;
 133
 134 \ https://forth-standard.org/standard/double/Dd
 135 \ D.     dlo dhi --           display d (signed)
 136 CODE D.
 137 MOV #U.,W   \ U. + 10 = D.
 138 ADD #10,W
 139 MOV W,PC
 140 ENDCODE
 141
 142
 143
 144 ; dvd div               ; Quot  Rem
 145   .0  .0  UD/MOD D. D.  ;  inf   0   -->
 146   .0  .1  UD/MOD D. D.  ;   0    0   -->
 147   .1  .0  UD/MOD D. D.  ;  inf  dvd  -->
 148   .1  .1  UD/MOD D. D.  ;   1    0   -->
 149   .1  .2  UD/MOD D. D.  ;   0    1   -->
 150   .0  .2  UD/MOD D. D.  ;   0    0   -->
 151   .2  .0  UD/MOD D. D.  ;  inf  dvd  -->
 152   .2  .1  UD/MOD D. D.  ;   2    0   -->
 153   .2  .2  UD/MOD D. D.  ;   1    0   -->
 154   .2  .3  UD/MOD D. D.  ;   0    2   -->
 155   .0  .3  UD/MOD D. D.  ;   0    0   -->
 156   .3  .0  UD/MOD D. D.  ;  inf  dvd  -->
 157   .3  .1  UD/MOD D. D.  ;   3    0   -->
 158   .3  .2  UD/MOD D. D.  ;   1    1   -->
 159   .3  .3  UD/MOD D. D.  ;   1    0   -->
 160   .3  .4  UD/MOD D. D.  ;   0    3   -->
 161   .4  .1  UD/MOD D. D.  ;   4    0   -->
 162
 163 ; dvd div               ; Quot  Rem
 164    .0 -.1 UD/MOD D. D.  ;   0    0   -->
 165   -.1  .0 UD/MOD D. D.  ;  inf  dvd  -->
 166   -.1  .1 UD/MOD D. D.  ;  dvd   0   -->
 167   -.1 -.1 UD/MOD D. D.  ;   1    0   -->
 168   -.1 -.2 UD/MOD D. D.  ;   1    1   -->
 169   -.1 -.3 UD/MOD D. D.  ;   1    2   -->
 170   -.2  .0 UD/MOD D. D.  ;  inf  dvd  -->
 171   -.2 -.1 UD/MOD D. D.  ;   0   dvd  -->
 172   -.2 -.2 UD/MOD D. D.  ;   1    0   -->
 173   -.2 -.3 UD/MOD D. D.  ;   1    1   -->
 174   -.2 -.4 UD/MOD D. D.  ;   1    2   -->