dsforth/math_misc.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; misc math words
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_CODE_WORD 1+
   6 ;; k8
   7 ;; ( n -- n+1 )
   8   pop   hl
   9   inc   hl
  10   jp    i_pushhl
  11 $FORTH_END_CODE_WORD 1+
  12
  13 $FORTH_CODE_WORD 2+
  14 ;; k8
  15 ;; ( n -- n+2 )
  16   pop   hl
  17   inc   hl
  18   inc   hl
  19   jp    i_pushhl
  20 $FORTH_END_CODE_WORD 2+
  21
  22 $FORTH_CODE_WORD 4+
  23 ;; k8
  24 ;; ( n -- n+4 )
  25   pop   hl
  26   inc   hl
  27   inc   hl
  28   inc   hl
  29   inc   hl
  30   jp    i_pushhl
  31 $FORTH_END_CODE_WORD 4+
  32
  33 $FORTH_CODE_WORD 1-
  34 ;; k8
  35 ;; ( n -- n-1 )
  36   pop   hl
  37   dec   hl
  38   jp    i_pushhl
  39 $FORTH_END_CODE_WORD 1-
  40
  41 $FORTH_CODE_WORD 2-
  42 ;; k8
  43 ;; ( n -- n-2 )
  44   pop   hl
  45   dec   hl
  46   dec   hl
  47   jp    i_pushhl
  48 $FORTH_END_CODE_WORD 2-
  49
  50 $FORTH_CODE_WORD 4-
  51 ;; k8
  52 ;; ( n -- n-4 )
  53   pop   hl
  54   dec   hl
  55   dec   hl
  56   dec   hl
  57   dec   hl
  58   jp    i_pushhl
  59 $FORTH_END_CODE_WORD 4-
  60
  61 $FORTH_CODE_WORD 256U*
  62 ;; k8
  63 ;; ( n -- n*256u )
  64   pop   hl
  65   ld    h,l
  66   ld    l,0
  67   jp    i_pushhl
  68 $FORTH_END_CODE_WORD 256U*
  69
  70 $FORTH_CODE_WORD 256U/
  71 ;; k8
  72 ;; ( n -- n/256u )
  73   pop   hl
  74   ld    l,h
  75   ld    h,0
  76   jp    i_pushhl
  77 $FORTH_END_CODE_WORD 256U/
  78
  79 $FORTH_CODE_WORD 2U/
  80 ;; k8
  81 ;; ( n -- n/2 )
  82   pop   hl
  83   or    a
  84   rr    h
  85   rr    l
  86   jp    i_pushhl
  87 $FORTH_END_CODE_WORD 2U/
  88
  89 $FORTH_CODE_WORD 2U*
  90 ;; k8
  91 ;; ( n -- n*2 )
  92   pop   hl
  93   or    a
  94   rl    l
  95   rl    h
  96   jp    i_pushhl
  97 $FORTH_END_CODE_WORD 2U*
  98
  99 $FORTH_CODE_WORD 2UMOD
 100 ;; k8
 101 ;; ( n -- n%2 )
 102   pop   hl
 103   ld    a,l
 104   and   #01
 105   ld    l,a
 106   ld    h,0
 107   jp    i_pushhl
 108 $FORTH_END_CODE_WORD 2UMOD
 109
 110 $FORTH_CODE_WORD 256UMOD
 111 ;; k8
 112 ;; ( n -- n%256u )
 113   pop   hl
 114   ld    h,0
 115   jp    i_pushhl
 116 $FORTH_END_CODE_WORD 256UMOD
 117
 118 $FORTH_CODE_WORD ISGN
 119 ;; k8
 120 ;; ( 16 -- -1 or 0 or 1 )
 121   pop   hl
 122   bit   7,h
 123   jr    nz,isgn_negative
 124   ld    a,h
 125   or    l
 126   jp    z,i_pushhl  ;; zero
 127   ;; positive
 128   ld    hl,1
 129   jp    i_pushhl
 130 isgn_negative:
 131   ld    hl,0xffff
 132   jp    i_pushhl
 133 $FORTH_END_CODE_WORD ISGN
 134
 135
 136 $FORTH_CODE_WORD USQRT
 137 ;; k8
 138 ;; ( 16 -- 8 )
 139   pop   hl
 140   push  bc
 141   call  sqrt16_hl
 142   pop   bc
 143   ld    l,a
 144   ld    h,0
 145   jp    i_pushhl
 146 $FORTH_END_CODE_WORD USQRT
 147
 148 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 149 ;; fast 16-bit integer square root
 150 ;; 92 bytes, 344-379 cycles (average 362)
 151 ;; v2 - 3 t-state optimization spotted by Russ McNulty
 152 ;; http://www.retroprogramming.com/2017/07/a-fast-z80-integer-square-root.html
 153 ;; k8: NOT TESTED YET!
 154 ;;
 155 ;; IN:
 156 ;;   HL: number
 157 ;; OUT:
 158 ;;   A: square root
 159 ;;   HL: dead
 160 ;;   DE: dead
 161 ;;   F: dead
 162 sqrt16_hl:
 163   ld    a,h
 164   ld    de,0B0C0h
 165   add   a,e
 166   jr    c,.sq7
 167   ld    a,h
 168   ld    d,0F0h
 169 .sq7:
 170 ; ----------
 171   add   a,d
 172   jr    nc,.sq6
 173   res   5,d
 174   db    254
 175 .sq6:
 176   sub   d
 177   sra   d
 178 ; ----------
 179   set   2,d
 180   add   a,d
 181   jr    nc,.sq5
 182   res   3,d
 183   db    254
 184 .sq5:
 185   sub   d
 186   sra   d
 187 ; ----------
 188   inc   d
 189   add   a,d
 190   jr    nc,.sq4
 191   res   1,d
 192   db    254
 193 .sq4:
 194   sub   d
 195   sra   d
 196   ld    h,a
 197 ; ----------
 198   add   hl,de
 199   jr    nc,.sq3
 200   ld    e,040h
 201   db    210
 202 .sq3:
 203   sbc   hl,de
 204   sra   d
 205   ld    a,e
 206   rra
 207 ; ----------
 208   or    010h
 209   ld    e,a
 210   add   hl,de
 211   jr    nc,.sq2
 212   and   0DFh
 213   db    218
 214 .sq2:
 215   sbc   hl,de
 216   sra   d
 217   rra
 218 ; ----------
 219   or    04h
 220   ld    e,a
 221   add   hl,de
 222   jr    nc,.sq1
 223   and   0F7h
 224   db    218
 225 .sq1:
 226   sbc   hl,de
 227   sra   d
 228   rra
 229 ; ----------
 230   inc   a
 231   ld    e,a
 232   add   hl,de
 233   jr    nc,.sq0
 234   and   0FDh
 235 .sq0:
 236   sra   d
 237   rra
 238   cpl
 239   ret
 240
 241
 242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 243 ;; generate random number
 244 ;; period of 2^32-1, and passes most of the diehard tests
 245 ;; this is the preferred PRNG, it is fast, small and good
 246 ;;
 247 ;; IN:
 248 ;;   rndSeed: 4 bytes of shit
 249 ;; OUT:
 250 ;;   HL: 16-bit random
 251 ;;   DE: dead
 252 ;;   AF: dead
 253 ;; WARNING:
 254 ;;  be careful to not have all zeroes in rndSeed!
 255 ;;
 256 ;;  taken from http://www.worldofspectrum.org/forums/showthread.php?t=23070
 257 ;;  original code by Patrik Rak (2012, based on Einar Saukas version)
 258 random_marsaglia:
 259   ld    hl,#a280       ; yw -> zt
 260 rndSeed0 equ $-2
 261   ld    de,#c0de       ; xz -> yw
 262 rndSeed1 equ $-2
 263   ld    (rndSeed1),hl  ; x = y, z = w
 264   ld    a,l            ; w = w^(w<<3)
 265   add   a,a
 266   add   a,a
 267   add   a,a
 268   xor   l
 269   ld    l,a
 270   ld    a,d            ; t = x^(x<<1)
 271   add   a,a
 272   xor   d
 273   ld    h,a
 274   rra                  ; t = t^(t>>1)^w
 275   xor   h
 276   xor   l
 277   ld    h,e            ; y = z
 278   ld    l,a            ; w = t
 279   ld    (rndSeed0),hl
 280   ret
 281
 282
 283 $FORTH_CODE_WORD D-RANDSEED@
 284 ;; k8 -- set 16-bit random seed
 285 ;; ( -- lo hi )
 286   ld    hl,(rndSeed0)
 287   ld    de,(rndSeed1)
 288   jp    i_pushde
 289 $FORTH_END_CODE_WORD D-RANDSEED@
 290
 291 $FORTH_CODE_WORD RANDSEED!
 292 ;; k8 -- set 16-bit random seed
 293 ;; ( n -- )
 294   pop   hl
 295   ld    (rndSeed0),hl
 296   ld    hl,#c0de
 297   ld    (rndSeed1),hl
 298   jp    i_next
 299 $FORTH_END_CODE_WORD RANDSEED!
 300
 301 $FORTH_CODE_WORD D-RANDSEED!
 302 ;; k8 -- set 16-bit random seed
 303 ;; ( lo hi -- )
 304   pop   hl
 305   pop   de
 306   ld    a,l
 307   or    h
 308   or    d
 309   or    e
 310   jr    nz,fword_drandseed_ok
 311   inc   l
 312 fword_drandseed_ok:
 313   ld    (rndSeed0),hl
 314   ld    (rndSeed1),de
 315   jp    i_next
 316 $FORTH_END_CODE_WORD D-RANDSEED!
 317
 318
 319 $FORTH_CODE_WORD URANDOM
 320 ;; k8 -- generate 16-bit random number
 321 ;; ( -- n )
 322   call  random_marsaglia
 323   jp    i_pushhl
 324 $FORTH_END_CODE_WORD URANDOM
 325
 326 $FORTH_CODE_WORD RANDOM
 327 ;; k8 -- generate 15-bit random number
 328 ;; ( -- n )
 329   call  random_marsaglia
 330   res   7,h
 331   jp    i_pushhl
 332 $FORTH_END_CODE_WORD RANDOM
 333
 334
 335 $FORTH_CODE_WORD URANDOM8
 336 ;; k8 -- generate 8-bit random number
 337 ;; ( -- n )
 338   call  random_marsaglia
 339   ld    h,0
 340   jp    i_pushhl
 341 $FORTH_END_CODE_WORD URANDOM8
 342
 343 $FORTH_CODE_WORD URANDOM88
 344 ;; k8 -- generate two 8-bit random numbers
 345 ;; ( -- n n )
 346   call  random_marsaglia
 347   ld    e,h
 348   ld    h,0
 349   ld    d,h
 350   jp    i_pushde
 351 $FORTH_END_CODE_WORD URANDOM88