dsforth/math_compare.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; math comparisons
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_CODE_WORD 0=
   6 ;; AberSoft
   7 ;; ( n -- flag )
   8 zequ:
   9   pop   hl
  10   ld    a,l
  11   or    h
  12   inc   hl
  13   jp    z,i_pushhl
  14   ld    hl,0
  15   jp    i_pushhl
  16 $FORTH_END_CODE_WORD 0=
  17
  18 $FORTH_CODE_WORD NOT
  19 ;; AberSoft
  20 ;; ( n -- flag )
  21   jr    zequ
  22 $FORTH_END_CODE_WORD NOT
  23
  24 $FORTH_CODE_WORD 0<
  25 ;; k8
  26 ;; ( n1 -- flag )
  27   pop   hl
  28   ld    a,h
  29   ld    hl,0
  30   bit   7,a
  31   jp    z,i_pushhl
  32   inc   hl
  33   jp    i_pushhl
  34 $FORTH_END_CODE_WORD 0<
  35
  36 $FORTH_CODE_WORD <
  37 ;; AberSoft
  38 ;; ( n0 n1 -- flag )
  39   pop   de
  40   pop   hl
  41 do_signed_less:
  42   ld    a,d
  43   xor   h
  44   jp    m,less0
  45   and   a
  46   sbc   hl,de
  47 less0:
  48   inc   h
  49   dec   h
  50   jp    m,less1
  51   ld    hl,0
  52   jp    i_pushhl
  53 less1:
  54   ld    hl,1
  55   jp    i_pushhl
  56 $FORTH_END_CODE_WORD <
  57
  58 $FORTH_CODE_WORD U<
  59 ;; k8
  60 ;; ( n0 n1 -- flag )
  61   pop   de
  62   pop   hl
  63 do_unsigned_less:
  64   and   a
  65   sbc   hl,de
  66   ld    hl,0
  67   jp    nc,i_pushhl
  68   inc   hl
  69   jp    i_pushhl
  70 $FORTH_END_CODE_WORD U<
  71
  72 ;; ;; $FORTH_WORD U<
  73 ;; ;; ;; AberSoft
  74 ;; ;; ;; ( n0 n1 -- flag )
  75 ;; ;;   2DUP XOR 0< 0BRANCH uless0
  76 ;; ;;   DROP 0< 0= BRANCH uless1
  77 ;; ;; uless0:
  78 ;; ;;   - 0<
  79 ;; ;; uless1:
  80 ;; ;;   ;S
  81 ;; ;; $FORTH_END_WORD U<
  82
  83 ;; $FORTH_WORD U>
  84 ;; ;; AberSoft
  85 ;; ;; ( n0 n1 -- flag )
  86 ;;   >R 1- R> U< 0=
  87 ;;   ;S
  88 ;; $FORTH_END_WORD U>
  89
  90 $FORTH_CODE_WORD U>
  91 ;; k8
  92 ;; ( n0 n1 -- flag )
  93   pop   hl
  94   pop   de
  95   jp    do_unsigned_less
  96 $FORTH_END_CODE_WORD U>
  97
  98 $FORTH_CODE_WORD >
  99 ;; k8
 100 ;; ( n0 n1 -- flag )
 101   pop   hl
 102   pop   de
 103   jp    do_signed_less
 104 $FORTH_END_CODE_WORD >
 105
 106 ;; $FORTH_WORD >
 107 ;; ;; AberSoft
 108 ;; ;; ( n0 n1 -- flag )
 109 ;;   SWAP < ;S
 110 ;; $FORTH_END_WORD >
 111
 112 $FORTH_WORD =
 113 ;; AberSoft
 114 ;; ( n0 n1 -- flag )
 115   - 0= ;S
 116 $FORTH_END_WORD =
 117
 118 $FORTH_CODE_WORD <>
 119 ;; k8
 120 ;; ( n0 n1 -- flag )
 121 notequ_code:
 122   pop   hl
 123   pop   de
 124   or    a
 125   sbc   hl,de
 126   jp    z,i_pushhl
 127   ld    hl,1
 128   jp    i_pushhl
 129 $FORTH_END_CODE_WORD <>
 130 ;; k8
 131 ;; ( n0 n1 -- flag )
 132 ;;  - 0= 0= ;S
 133 ;;$FORTH_END_WORD <>
 134
 135 $FORTH_CODE_WORD !=
 136 ;; k8
 137 ;; ( n0 n1 -- flag )
 138   jp    notequ_code
 139 $FORTH_END_CODE_WORD !=
 140
 141 $FORTH_WORD <=
 142 ;; k8
 143 ;; ( n0 n1 -- flag )
 144   2DUP < >R = R> OR ;S
 145 $FORTH_END_WORD <=
 146
 147 $FORTH_WORD >=
 148 ;; k8
 149 ;; ( n0 n1 -- flag )
 150   2DUP > >R = R> OR ;S
 151 $FORTH_END_WORD >=