dsforth/math_hlev.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; "high-level" math words
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 ;; convert normal singed number to double
   6 $FORTH_CODE_WORD S->D
   7 ;; AberSoft
   8 ;; ( n -- d )
   9   pop   de
  10   ld    hl,0
  11   ld    a,d
  12   and   #80
  13   jr    z,s2d0
  14   dec   hl
  15 s2d0:
  16   jp    i_pushde
  17 $FORTH_END_CODE_WORD S->D
  18
  19 $FORTH_WORD +-
  20 ;; AberSoft
  21   0< 0BRANCH pm0
  22   NEGATE
  23 pm0:
  24   ;S
  25 $FORTH_END_WORD +-
  26
  27 $FORTH_WORD D+-
  28 ;; AberSoft
  29   0< 0BRANCH dpm0
  30   DNEGATE
  31 dpm0:
  32   ;S
  33 $FORTH_END_WORD D+-
  34
  35 $FORTH_WORD ABS
  36 ;; AberSoft
  37   DUP +- ;S
  38 $FORTH_END_WORD ABS
  39
  40 $FORTH_WORD DABS
  41 ;; AberSoft
  42   DUP D+- ;S
  43 $FORTH_END_WORD DABS
  44
  45 $FORTH_WORD MIN
  46 ;; AberSoft
  47   2DUP > 0BRANCH min0
  48   SWAP
  49 min0:
  50   DROP
  51   ;S
  52 $FORTH_END_WORD MIN
  53
  54 $FORTH_WORD MAX
  55 ;; AberSoft
  56   2DUP < 0BRANCH max0
  57   SWAP
  58 max0:
  59   DROP
  60   ;S
  61 $FORTH_END_WORD MAX
  62
  63 $FORTH_WORD UMIN
  64 ;; AberSoft
  65   2DUP U> 0BRANCH umin0
  66   SWAP
  67 umin0:
  68   DROP
  69   ;S
  70 $FORTH_END_WORD UMIN
  71
  72 $FORTH_WORD UMAX
  73 ;; AberSoft
  74   2DUP U< 0BRANCH umax0
  75   SWAP
  76 umax0:
  77   DROP
  78   ;S
  79 $FORTH_END_WORD UMAX
  80
  81
  82 $FORTH_WORD M*
  83 ;; AberSoft
  84   2DUP XOR >R ABS SWAP ABS U* R> D+- ;S
  85 $FORTH_END_WORD M*
  86
  87 $FORTH_WORD M/
  88 ;; AberSoft
  89   OVER >R >R DABS R@ ABS U/MOD R> R@ XOR +- SWAP R> +- SWAP ;S
  90 $FORTH_END_WORD M/
  91
  92 $FORTH_WORD *
  93 ;; AberSoft
  94   M* DROP ;S
  95 $FORTH_END_WORD *
  96
  97 $FORTH_WORD /MOD
  98 ;; AberSoft
  99   >R S->D R> M/ ;S
 100 $FORTH_END_WORD /MOD
 101
 102 $FORTH_WORD /
 103 ;; AberSoft
 104   /MOD SWAP DROP ;S
 105 $FORTH_END_WORD /
 106
 107 $FORTH_WORD MOD
 108 ;; AberSoft
 109   /MOD DROP ;S
 110 $FORTH_END_WORD MOD
 111
 112 $FORTH_WORD */MOD
 113 ;; AberSoft
 114   >R M* R> M/ ;S
 115 $FORTH_END_WORD */MOD
 116
 117 $FORTH_WORD */
 118 ;; AberSoft
 119   */MOD SWAP DROP ;S
 120 $FORTH_END_WORD */
 121
 122 $FORTH_WORD M/MOD
 123 ;; AberSoft
 124   >R 0 R@ U/MOD R> SWAP >R U/MOD R> ;S
 125 $FORTH_END_WORD M/MOD