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             PUSHM   #2,IP
  69             ASMtoFORTH
  70             .word UMSTAR            ; UMSTAR use S,T,W,X,Y
  71             FORTHtoASM
  72 ;            .word   171Ch           ;           POPM S,IP (1+1 pop,S=0Ch)
  73             POPM  #2,IP
  74             CMP     #0,S            ; result > -1 ?
  75             JGE     MSTARend        ; yes
  76             XOR     #-1,0(PSP)      ; no : ud --> d
  77             XOR     #-1,TOS
  78             ADD     #1,0(PSP)
  79             ADDC    #0,TOS
  80 MSTARend    mNEXT
  81
  82     .ENDIF ;MPY
  83
  84 ;https://forth-standard.org/standard/core/SMDivREM
  85 ;C SM/REM   d1lo d1hi n2 -- n3 n4  symmetric signed div
  86             FORTHWORD "SM/REM"
  87 SMSLASHREM  MOV TOS,S           ;1            S=divisor
  88             MOV @PSP,T          ;2            T=rem_sign
  89             CMP #0,TOS          ;1            n2 >= 0 ?
  90             JGE d1u2SMSLASHREM  ;2            yes
  91             XOR #-1,TOS         ;1
  92             ADD #1,TOS          ;1
  93 d1u2SMSLASHREM                  ;   -- d1 u2
  94             CMP #0,0(PSP)       ;3           d1hi >= 0 ?
  95             JGE ud1u2SMSLASHREM ;2           yes
  96             XOR #-1,2(PSP)      ;4           d1lo
  97             XOR #-1,0(PSP)      ;4           d1hi
  98             ADD #1,2(PSP)       ;4           d1lo+1
  99             ADDC #0,0(PSP)      ;4           d1hi+C
 100 ud1u2SMSLASHREM                 ;   -- ud1 u2
 101 ;           .word 151Ch          ;4          PUSHM S,T (1+1 push,S=0Ch)
 102             PUSHM  #2,S
 103             CALL #MUSMOD
 104             MOV @PSP+,TOS
 105 ;           .word 171Bh          ;4          POPM T,S (1+1 pop,T=0Bh)
 106             POPM  #2,S
 107             CMP #0,T            ;1  -- ur uq  T=rem_sign>=0?
 108             JGE SMSLASHREMnruq  ;2           yes
 109             XOR #-1,0(PSP)      ;3
 110             ADD #1,0(PSP)       ;3
 111 SMSLASHREMnruq
 112             XOR S,T             ;1           S=divisor T=quot_sign
 113             CMP #0,T            ;1  -- nr uq  T=quot_sign>=0?
 114             JGE SMSLASHREMnrnq  ;2           yes
 115 NEGAT       XOR #-1,TOS         ;1
 116             ADD #1,TOS          ;1
 117 SMSLASHREMnrnq                  ;   -- nr nq  S=divisor
 118             mNEXT               ;4 34 words
 119
 120 ;https://forth-standard.org/standard/core/FMDivMOD
 121 ;C FM/MOD   d1 n1 -- r q   floored signed div'n
 122             FORTHWORD "FM/MOD"
 123 FMSLASHMOD  PUSH    IP
 124             MOV     #FMSLASHMOD1,IP
 125             JMP     SMSLASHREM
 126 FMSLASHMOD1 FORTHtoASM              ; -- remainder quotient       S=divisor
 127             CMP     #0,0(PSP)       ;
 128             JZ      FMSLASHMODEND
 129             CMP     #1,TOS          ; quotient < 1 ?
 130             JGE     FMSLASHMODEND   ;
 131 QUOTLESSONE ADD     S,0(PSP)        ; add divisor to remainder
 132             SUB     #1,TOS          ; decrement quotient
 133 FMSLASHMODEND
 134             MOV     @RSP+,IP
 135             mNEXT                   ;
 136
 137 ;https://forth-standard.org/standard/core/NEGATE
 138 ;C NEGATE   x1 -- x2            two's complement
 139             FORTHWORD "NEGATE"
 140             JMP NEGAT
 141
 142 ;https://forth-standard.org/standard/core/ABS
 143 ;C ABS     n1 -- +n2     absolute value
 144             FORTHWORD "ABS"
 145 ABBS        CMP     #0,TOS       ; 1
 146             JN      NEGAT
 147             mNEXT
 148
 149 ;https://forth-standard.org/standard/core/Times
 150 ;C *      n1 n2 -- n3       signed multiply
 151             FORTHWORD "*"
 152 STAR:       mDOCOL
 153             .word   MSTAR,DROP,EXIT
 154
 155 ;https://forth-standard.org/standard/core/DivMOD
 156 ;C /MOD   n1 n2 -- n3 n4    signed divide/rem'dr
 157             FORTHWORD "/MOD"
 158 SLASHMOD:   mDOCOL
 159             .word   TOR,STOD,RFROM,FMSLASHMOD,EXIT
 160
 161 ;https://forth-standard.org/standard/core/Div
 162 ;C /      n1 n2 -- n3       signed divide
 163             FORTHWORD "/"
 164 SLASH:      mDOCOL
 165             .word   TOR,STOD,RFROM,FMSLASHMOD,NIP,EXIT
 166
 167 ;https://forth-standard.org/standard/core/MOD
 168 ;C MOD    n1 n2 -- n3       signed remainder
 169             FORTHWORD "MOD"
 170 MODD:       mDOCOL
 171             .word   TOR,STOD,RFROM,FMSLASHMOD,DROP,EXIT
 172
 173 ;https://forth-standard.org/standard/core/TimesDivMOD
 174 ;C */MOD  n1 n2 n3 -- n4 n5    n1*n2/n3, rem&quot
 175             FORTHWORD "*/MOD"
 176 SSMOD:      mDOCOL
 177             .word   TOR,MSTAR,RFROM,FMSLASHMOD,EXIT
 178
 179 ;https://forth-standard.org/standard/core/TimesDiv
 180 ;C */     n1 n2 n3 -- n4        n1*n2/n3
 181             FORTHWORD "*/"
 182 STARSLASH   mDOCOL
 183             .word   TOR,MSTAR,RFROM,FMSLASHMOD,NIP,EXIT
 184
 185
 186