ADDON/ARITHMETIC.asm

   1 ; -*- coding: utf-8 -*-
   2 ; http://patorjk.com/software/taag/#p=display&f=Banner&t=Fast Forth
   3
   4 ; Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices
   5 ; Copyright (C) <2015>  <J.M. THOORENS>
   6 ;
   7 ; This program is free software: you can redistribute it and/or modify
   8 ; it under the terms of the GNU General Public License as published by
   9 ; the Free Software Foundation, either version 3 of the License, or
  10 ; (at your option) any later version.
  11 ;
  12 ; This program is distributed in the hope that it will be useful,
  13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ; GNU General Public License for more details.
  16 ;
  17 ; You should have received a copy of the GNU General Public License
  18 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20
  21     .IFNDEF ARITHMETIC
  22 ARITHMETIC
  23     .ENDIF
  24
  25 ;https://forth-standard.org/standard/core/StoD
  26 ;C S>D    n -- d          single -> double prec.
  27             FORTHWORD "S>D"
  28 STOD:       SUB     #2,PSP
  29             MOV     TOS,0(PSP)
  30             JMP     ZEROLESS
  31
  32     .IFDEF MPY
  33
  34 ;https://forth-standard.org/standard/core/UMTimes
  35 ;C UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
  36             FORTHWORD "UM*"
  37 UMSTAR      MOV @PSP,&MPY       ; Load 1st operand
  38             MOV TOS,&OP2        ; Load 2nd operand
  39             MOV &RES0,0(PSP)    ; low result on stack
  40             MOV &RES1,TOS       ; high result in TOS
  41             mNEXT
  42
  43 ;https://forth-standard.org/standard/core/MTimes
  44 ;C M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
  45             FORTHWORD "M*"
  46 MSTAR       MOV     @PSP,&MPYS
  47             MOV     TOS,&OP2
  48             MOV     &RES0,0(PSP)
  49             MOV     &RES1,TOS
  50             mNEXT
  51
  52     .ELSE
  53
  54 ;https://forth-standard.org/standard/core/MTimes
  55 ;C M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
  56             FORTHWORD "M*"
  57 MSTAR:      MOV     TOS,S           ; TOS= n2
  58             XOR     @PSP,S          ; S contains sign of result
  59             CMP     #0,0(PSP)       ; n1 > -1 ?
  60             JGE     u1n2MSTAR       ; yes
  61             XOR     #-1,0(PSP)      ; no : n1 --> u1
  62             ADD     #1,0(PSP)       ;
  63 u1n2MSTAR   CMP     #0,TOS          ; n2 <= -1 ?
  64             JGE     u1u2MSTAR       ; no
  65             XOR     #-1,TOS         ; y: n2 --> u2
  66             ADD     #1,TOS          ;
  67 u1u2MSTAR   .word   151Dh           ;           PUSHM IP,S (1+1 push,IP=0Dh)
  68             ASMtoFORTH
  69             .word UMSTAR            ; UMSTAR use S,T,W,X,Y
  70             FORTHtoASM
  71             .word   171Ch           ;           POPM S,IP (1+1 pop,S=0Ch)
  72             CMP     #0,S            ; result > -1 ?
  73             JGE     MSTARend        ; yes
  74             XOR     #-1,0(PSP)      ; no : ud --> d
  75             XOR     #-1,TOS
  76             ADD     #1,0(PSP)
  77             ADDC    #0,TOS
  78 MSTARend    mNEXT
  79
  80     .ENDIF ;MPY
  81
  82 ;https://forth-standard.org/standard/core/SMDivREM
  83 ;C SM/REM   d1lo d1hi n2 -- n3 n4  symmetric signed div
  84             FORTHWORD "SM/REM"
  85 SMSLASHREM  MOV TOS,S           ;1            S=divisor
  86             MOV @PSP,T          ;2            T=rem_sign
  87             CMP #0,TOS          ;1            n2 >= 0 ?
  88             JGE d1u2SMSLASHREM  ;2            yes
  89             XOR #-1,TOS         ;1
  90             ADD #1,TOS          ;1
  91 d1u2SMSLASHREM                  ;   -- d1 u2
  92             CMP #0,0(PSP)       ;3           d1hi >= 0 ?
  93             JGE ud1u2SMSLASHREM ;2           yes
  94             XOR #-1,2(PSP)      ;4           d1lo
  95             XOR #-1,0(PSP)      ;4           d1hi
  96             ADD #1,2(PSP)       ;4           d1lo+1
  97             ADDC #0,0(PSP)      ;4           d1hi+C
  98 ud1u2SMSLASHREM                 ;   -- ud1 u2
  99            .word 151Ch          ;4          PUSHM S,T (1+1 push,S=0Ch)
 100             CALL #MUSMOD
 101             MOV @PSP+,TOS
 102            .word 171Bh          ;4          POPM T,S (1+1 pop,T=0Bh)
 103             CMP #0,T            ;1  -- ur uq  T=rem_sign>=0?
 104             JGE SMSLASHREMnruq  ;2           yes
 105             XOR #-1,0(PSP)      ;3
 106             ADD #1,0(PSP)       ;3
 107 SMSLASHREMnruq
 108             XOR S,T             ;1           S=divisor T=quot_sign
 109             CMP #0,T            ;1  -- nr uq  T=quot_sign>=0?
 110             JGE SMSLASHREMnrnq  ;2           yes
 111 NEGAT       XOR #-1,TOS         ;1
 112             ADD #1,TOS          ;1
 113 SMSLASHREMnrnq                  ;   -- nr nq  S=divisor
 114             mNEXT               ;4 34 words
 115
 116 ;https://forth-standard.org/standard/core/FMDivMOD
 117 ;C FM/MOD   d1 n1 -- r q   floored signed div'n
 118             FORTHWORD "FM/MOD"
 119 FMSLASHMOD  PUSH    IP
 120             MOV     #FMSLASHMOD1,IP
 121             JMP     SMSLASHREM
 122 FMSLASHMOD1 FORTHtoASM              ; -- remainder quotient       S=divisor
 123             CMP     #0,0(PSP)       ;
 124             JZ      FMSLASHMODEND
 125             CMP     #1,TOS          ; quotient < 1 ?
 126             JGE     FMSLASHMODEND   ;
 127 QUOTLESSONE ADD     S,0(PSP)        ; add divisor to remainder
 128             SUB     #1,TOS          ; decrement quotient
 129 FMSLASHMODEND
 130             MOV     @RSP+,IP
 131             mNEXT                   ;
 132
 133 ;https://forth-standard.org/standard/core/NEGATE
 134 ;C NEGATE   x1 -- x2            two's complement
 135             FORTHWORD "NEGATE"
 136             JMP NEGAT
 137
 138 ;https://forth-standard.org/standard/core/ABS
 139 ;C ABS     n1 -- +n2     absolute value
 140             FORTHWORD "ABS"
 141 ABBS        CMP     #0,TOS       ; 1
 142             JN      NEGAT
 143             mNEXT
 144
 145 ;https://forth-standard.org/standard/core/Times
 146 ;C *      n1 n2 -- n3       signed multiply
 147             FORTHWORD "*"
 148 STAR:       mDOCOL
 149             .word   MSTAR,DROP,EXIT
 150
 151 ;https://forth-standard.org/standard/core/DivMOD
 152 ;C /MOD   n1 n2 -- n3 n4    signed divide/rem'dr
 153             FORTHWORD "/MOD"
 154 SLASHMOD:   mDOCOL
 155             .word   TOR,STOD,RFROM,FMSLASHMOD,EXIT
 156
 157 ;https://forth-standard.org/standard/core/Div
 158 ;C /      n1 n2 -- n3       signed divide
 159             FORTHWORD "/"
 160 SLASH:      mDOCOL
 161             .word   TOR,STOD,RFROM,FMSLASHMOD,NIP,EXIT
 162
 163 ;https://forth-standard.org/standard/core/MOD
 164 ;C MOD    n1 n2 -- n3       signed remainder
 165             FORTHWORD "MOD"
 166 MODD:       mDOCOL
 167             .word   TOR,STOD,RFROM,FMSLASHMOD,DROP,EXIT
 168
 169 ;https://forth-standard.org/standard/core/TimesDivMOD
 170 ;C */MOD  n1 n2 n3 -- n4 n5    n1*n2/n3, rem&quot
 171             FORTHWORD "*/MOD"
 172 SSMOD:      mDOCOL
 173             .word   TOR,MSTAR,RFROM,FMSLASHMOD,EXIT
 174
 175 ;https://forth-standard.org/standard/core/TimesDiv
 176 ;C */     n1 n2 n3 -- n4        n1*n2/n3
 177             FORTHWORD "*/"
 178 STARSLASH   mDOCOL
 179             .word   TOR,MSTAR,RFROM,FMSLASHMOD,NIP,EXIT
 180
 181
 182