level0/syssrc/math-single.f

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;; single math words
   3 ;;
   4 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   5 ;;
   6 ;; This program is free software: you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation, version 3 of the License ONLY.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 code: SGN  ( n -- -1/0/1 )
  20   or    TOS,TOS
  21   jr    nz,@f
  22   urnext
  23 @@:
  24   test  TOS,0x80000000
  25   jr    nz,@f
  26   ld    TOS,1
  27   urnext
  28 @@:
  29   ld    TOS,-1
  30   urnext
  31 endcode
  32
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 code: */  ( n0 n1 n2 -- n0*n1/n2 )
  36   pop   eax
  37   pop   ebx
  38   jecxz .zero
  39   ; TOS=n2
  40   ; EAX=n1
  41   ; EBX=n0
  42   imul  ebx
  43   idiv  TOS
  44   ld    TOS,eax
  45 .zero:
  46   urnext
  47 endcode
  48
  49
  50 code: */MOD  ( n0 n1 n2 -- n0*n1/n2 n0*n1%n2 )
  51   pop   eax
  52   pop   ebx
  53   jecxz .zero
  54   ; TOS=n2
  55   ; EAX=n1
  56   ; EBX=n0
  57   imul  ebx
  58   idiv  TOS
  59   push  edx
  60   ld    TOS,eax
  61 .zero:
  62   urnext
  63 endcode
  64
  65
  66 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67 ;; rounds toward zero
  68 code: SM/REM  ( d n -- nmod ndiv )  \ ANS
  69   pop   edx
  70   pop   eax
  71   jecxz .zero
  72   idiv  TOS
  73   push  edx
  74   ld    TOS,eax
  75   urnext
  76 .zero:
  77   push  TOS
  78   urnext
  79 endcode
  80
  81 ;; rounds toward negative infinity
  82 code: FM/MOD  ( d n -- nmod ndiv )  \ ANS
  83   pop   edx
  84   pop   eax
  85   jecxz @f
  86   ld    ebx,edx
  87   idiv  TOS
  88   or    edx,edx
  89   jr    z,@f
  90   xor   ebx,TOS
  91   jr    ns,@f
  92   dec   eax
  93   add   edx,TOS
  94 @@:
  95   push  edx
  96   ld    TOS,eax
  97   urnext
  98 .zero:
  99   push  TOS
 100   urnext
 101 endcode
 102
 103
 104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105 : ~and  ( u0 u1 -- u0&~u1 )
 106   bitnot and
 107 ;