Printing Quad number in Flashforth 5.0

[Jan Kromhout]

I am looking for a word that can print the contents of the stack, in this case a quad word. For example, q. ( q-dot prints a quad) If possible, with the same structure as d.
Thanks for nay help.
Jan

[Mikael Nordman]

That requires full 64-bit to 64-bit division which is not available. FF has 64-bit to 32-bit division, which useful for scaling as long as the result fits into 32-bytes.

Which FF are you using ?

[Jan Kromhout]

I have the scamp3, with the latest software, wich I hope this is include.

Did some updates to the PIC24 part.
Less writes to flash on chips that do not have eeprom (almost all chips). A smarter algorithm compares the highest written flash address with the xt to be executed.
DOES> fixed to work also with an empty DOES> part.
Unknown words do not cause INTERPRET to ABORT. This allows that unknown (marker words) words do not abort the loading from blocks or from Pere's file system. This was needed to let MARKER words to be used in those scenarios.
64 by 64-bit unsigned division. It links to the XC16 standard library code.
64 bit right and left shift. 64-bit was needed for controlling the SI570 chip.
2OVER
Mikael

[Mikael Nordman]

Here it is. I will replace the current UQ/MOD quad division word with this one.
Signed formatting is still missing, needs QABS.
I implemented 64-bit div/mod with 64/32 bit result and the number formatting words.

-qmath
marker -qmath
flash hex
: uqq/mod ( uq ud -- ud uq )  
[
eb0300. here cf! 2 allot
eb0380. here cf! 2 allot
2ffc00. here cf! 2 allot
781f80. here cf! 2 allot
7800ae. here cf! 2 allot
78002e. here cf! 2 allot
7802ae. here cf! 2 allot
78022e. here cf! 2 allot
7801ae. here cf! 2 allot
78012e. here cf! 2 allot
a90042. here cf! 2 allot
d28102. here cf! 2 allot
d28183. here cf! 2 allot
d28204. here cf! 2 allot
d28285. here cf! 2 allot
d28306. here cf! 2 allot
d28387. here cf! 2 allot

310003. here cf! 2 allot
530f80. here cf! 2 allot
5b8f81. here cf! 2 allot
390003. here cf! 2 allot
530300. here cf! 2 allot
5b8381. here cf! 2 allot
a00002. here cf! 2 allot
e81fcf. here cf! 2 allot
39fff1. here cf! 2 allot
782f06. here cf! 2 allot
782f07. here cf! 2 allot
782f02. here cf! 2 allot
782f03. here cf! 2 allot
782f04. here cf! 2 allot
782f05. here cf! 2 allot
78004f. here cf! 2 allot
060000. here cf! 2 allot
ram

: #q ( uq1 -- uq2 )
  base @ s>d uqq/mod >r >r >r >r drop digit hold r> r> r> r> ;

: #qs ( uq1 -- uq2 )
  begin
    #q 2over 2over d- d0=
  until ;

: #q> ( uq -- ) 2drop 2drop hp @ hb over - ;

: uq ( uq. -- )  <# #qs #q> type space ;

: uq.r ( uq u -- )
  >r <# begin #q r> 1- dup >r 0= until #q> rdrop type space ;

The assembler source looks like this.

; uq/mod ( uq ud -- ud uq )
        .pword  paddr(9b)+PFLASH
9:
        .byte   NFA|6
        .ascii  "uq/mod"
        .align  2

        clr     W6                  ; clear remainder
        clr     W7                  ; *
        mov     #-64, W0
        push    W0
        mov     [W14--], W1     ; Divisor
        mov     [W14--], W0     ; *
        mov     [W14--], W5     ; Dividend:Quotient
        mov     [W14--], W4     ; *
        mov     [W14--], W3     ; *
        mov     [W14--], W2     ; *
        bclr    SR, #C
UDIV6432_loop:
        rlc     W2, W2              ; Shift Dividend:Quotient left one bit
        rlc     W3, W3              ; *
        rlc     W4, W4              ; *
        rlc     W5, W5              ; *
        rlc     W6, W6              ; Into remainder
        rlc     W7, W7              ; *
        bra     C, UDIV6432_sub     ; if Remainder > 32 bits, subtract Divisor
        sub     W6, W0, [W15]       ; Try Remainder-Divisor (R-B)
        subb    W7, W1, [W15]       ; if (R<B) Quotient bit=0 
        bra     NC, UDIV6432_next   ;   skip substraction
UDIV6432_sub:
        sub     W6, W0, W6          ; if (R >= B) R = R - B
        subb    W7, W1, W7          ;   subtract Divisor from Remainder
        bset    W2, #0              ;   quotient bit0 = 1
UDIV6432_next:
        inc     [--W15], [W15++]
        bra     NC, UDIV6432_loop
        mov     W6, [++W14]         ; Remainder
        mov     W7, [++W14]         ; *
        mov     W2, [++W14]         ; Quotient
        mov     W3, [++W14]         ;
        mov     W4, [++W14]         ;
        mov     W5, [++W14]         ;
        pop     W0
        return

[Jan Kromhout]

Thanks Mikael for the fast response.
Have test it and it is working as a charm.
Could these routines not for always implemented in FF5?

With kindley regards
Jan

[Jan Kromhout]

Mikael,
Please can you help me with a definition for q* ( q q - q ).
I'm working on a conversion from string to a quad number. ( addr n -- q )

A word q10x ( q -- q*10) is also a posibility to do the conversion. ( I think the is a beter solution)

Thanks for any help.
With kindley regards
Jan

[Mikael Nordman]

Hi Jan,
Here is a simple binary multiplication that can be used for number conversion.
It is for multipliers less than 31.

-q*5
marker -q*5
ram create q*res 8 allot
: 4! ( q addr -- ) >r 2swap r@ 2! r> 4 + 2! ;
: 4@ ( addr -- q ) >r r@ 2@ r> 4 + 2@ ;
: 4drop 2drop 2drop ; 
: 4dup 2over 2over ;
: q*5 ( q u -- q' )  \ u = 0 - 31
  >r    4dup r@ %00001 and 0= if 4drop 0. 0. then q*res  4!
  1 q<< 4dup r@ %00010 and 0= if 4drop 0. 0. then q*res 4@ q+ q*res 4!
  1 q<< 4dup r@ %00100 and 0= if 4drop 0. 0. then q*res 4@ q+ q*res 4!
  1 q<< 4dup r@ %01000 and 0= if 4drop 0. 0. then q*res 4@ q+ q*res 4!
  1 q<<      r> %10000 and 0= if 4drop 0. 0. then q*res 4@ q+ q*res 4!
  q*res 4@
;

[Mikael Nordman]

Here is a another version.

-q*5
marker -q*5
ram create q*res 8 allot
: 4! ( q addr -- ) >r 2swap r@ 2! r> 4 + 2! ;
: 4@ ( addr -- q ) >r r@ 2@ r> 4 + 2@ ;
: 4drop 2drop 2drop ; 
: 4dup 2over 2over ;
: (q*5) ( q u -- ) and 0= if 4drop 0. 0. then q*res 4@ q+ q*res 4! ;
: q2* 1 q<< ;
: q*5 ( q u -- q' )  \ u = 0 - 31

  0. 0. q*res 4!
  >r  4dup r@ %00001 (q*5)
  q2* 4dup r@ %00010 (q*5)
  q2* 4dup r@ %00100 (q*5)
  q2* 4dup r@ %01000 (q*5)
  q2*      r> %10000 (q*5)
  q*res 4@
;