
\ -------------------------------------------------------------
\  Fixpoint output
\ -------------------------------------------------------------

: hold< ( c -- ) \ Add a character at the end of the number string
  hld @   dup 1- dup hld !    BUF hld @ -  move
  BUF 1- c!
;

: f# ( u -- u ) base @ um* .digit hold< ;

: f.n ( f n -- ) ( f-Low f-High n -- ) \ Prints a s15.16 number

  >r ( Low High R: n )

  dup 0< if [char] - emit then
  dabs
  ( uLow uHigh )
  0 <# #s   ( uLow 0 0 )
  drop swap ( 0 uLow )

  [char] , hold<
  r> 0 ?do f# loop

  #> type space
;

: f. ( f -- ) 16 f.n ;

\ -------------------------------------------------------------
\  Fixpoint calculations
\ -------------------------------------------------------------

: 2variable ( d -- ) create , , 0 foldable ;
\ : 2constant ( d -- ) create , , 0 foldable does> 2@ ;
: 2constant ( d -- ) swap : postpone literal postpone literal postpone ; 0 foldable ;

: s>f ( n -- f ) 0 swap ; 1 foldable  \ Signed integer --> Fixpoint s15.16
\ : f>s ( f -- n ) nip    ; 2 foldable  \ Fixpoint s15.16 --> Signed integer

: f* ( f1 f2 -- f )

        dup >r dabs
  2swap dup >r dabs

            ( d c b a )
  swap >r   ( d c a R: b )
  2dup *    ( d c a ac R: b )
  >r        ( d c a R: b ac )
  >r        ( d c R: b ac a )
  over      ( d c d R: b ac a )
  r> um*    ( d c L H R: b ac )
  r> +      ( d c L H' R: b )
  rot       ( d L H' c R: b )
  r@        ( d L H' c b R: b )
  um* d+    ( d L' H'' R: b )
  rot       ( L' H'' d R: b )
  r>        ( L' H'' d b )
  um* nip 0 ( L' H'' db 0 )
  d+        ( L'' H''' )

  r> r> xor 0< if dnegate then

; 4 foldable

0. 2variable Dividend
0. 2variable Shift
0. 2variable Divisor
0. 2variable Result

: (ud/mod) ( -- )

  32 0 do

    Dividend 2@
      dup 15 rshift >r
      d2*
    Dividend 2!

    Shift 2@
      d2* swap r> or swap
    2dup Shift 2!

    \ Compare if shift register is greater or equal to dividend.
    Divisor 2@ d-

    dup 0<
    if   \ Smaller: Don't subtract
      2drop
      0  \ Zero for result
    else \ Greater or Equal: Subtract !
      Shift 2!
      1  \ One for result
    then

    Result 2@ d2* >r or r> Result 2!

  loop
;

: ud/mod ( ud1 ud2 -- ud-rem ud-div )

     Divisor 2!
  0. Shift 2!
     Dividend 2!

  (ud/mod)

  Shift 2@
  Result 2@

; 4 foldable

: f/ ( f1 f2 -- f )

  dup >r dabs  Divisor 2!
  dup >r dabs  0 Shift 2! 0 swap Dividend 2!

  (ud/mod)

  Result 2@
  r> r> xor 0< if dnegate then

; 4 foldable
