Jump to content
Lee Stewart

fbForth—TI Forth with File-based Block I/O [Post #1 UPDATED: 11/16/2019]

Recommended Posts

1 hour ago, TheBF said:

Lee we had discussed creating faster dictionary searches using a hashing method like PolyForth.  I found this book by Dr. Ting called inside Forth83, which is a fantastic little Forth for DOS by Laxen & Perry. It used a 4 way hash on the dictionary which is described herein. Here is the link to the book: http://www.forth.org/OffeteStore/1003_InsideF83.pdf. Page 73 shows real code on how they Laxen and Perry did it ....

 

Sounds interesting. I must check it out. Thanks.

 

...lee

Share this post


Link to post
Share on other sites

The comments by @Tursi and @Asmusr regarding methods of calculating square roots sparked a Google search, which netted the algorithm I used in the following fast routine for the square root of an unsigned double number (from Craig McQueen’s response to “Looking for an efficient integer square root algorithm for ARM Thumb2” on stackoverflow.com) :

 

Spoiler
HEX
\ Registers:   R0,R1 = udh,udl
\              R2,R3 = root (nh,nl)
\              R4,r5 = floating 1 (f1h,f1l)
\              R6,R7 = wkh,wkl
ASM: UDSQRT    ( ud -- n )
   *SP+ R0 MOV,      \ pop udh to R0
   *SP R1 MOV,       \ udl to R1
   R2 CLR,           \ clear running..
   R3 CLR,           \ ..root (nh,nl)
   R5 CLR,           \ set floating 1..
   R4 4000 LI,       \ ..to 4000 0000
   
   \ get highest power of 4 <= square (udh,udl)
   BEGIN,
      R4 R0 C,       \ f1h:udh?
      EQ IF,
         R5 R1 C,    \ f1l:udl?
      THEN,
   H WHILE,
      R4 R5 C,          \ f1h:f1l?
      H IF,             \ bit in f1h?
         R4 2 SRL,      \ yes..shift f1h right 2 bits
         EQ IF,         \ bit shifted out?
            R5 4000 LI, \ set f1l to shifted-out bit
         THEN,
      ELSE,             \ no..bit is in f1l
         R5 2 SRL,      \ shift f1l right 2 bits
      THEN, 
   REPEAT,

   \ calculate square root
   BEGIN,
      R4 R5 C,       \ f1h:f1l?
   NE WHILE,         \ f1h,f1l > 0?
      \ set up wkh,wkl = nh,nl + f1h,f1l to compare to udh,udl
      R2 R6 MOV,     \ nh to wkh
      R3 R7 MOV,     \ nl to wkl
      R5 R7 A,       \ f1l + wkl
      OC IF,         \ carry?
         R6 INC,     \ yes..increment wkh
      THEN,
      R4 R6 A,       \ f1h + wkh
      \ check if need to update running values of udh,udl & nh,nl
      R0 R6 C,       \ udh:wkh?
      EQ IF,         \ udh = wkh?
         R1 R7 C,    \ udl:wkl?
      THEN,
      HE IF,         \ udh,udl >= wkh,wkl?
         \ udh,udl = udh,udl - wkh,wkl
         R7 R1 S,    \ udl - wkl
         NC IF,
            R0 DEC,  \ reduce udh on no carry
         THEN,
         R6 R0 S,    \ udh - wkh
         \ nh,nl = wkh,wkl + f1h,f1l
         R5 R7 A,    \ wkl + f1l
         OC IF,      \ carry?
            R6 INC,  \ yes..increment wkh
         THEN,
         R4 R6 A,    \ wkh + f1h
         R6 R2 MOV,  \ wkh to nh
         R7 R3 MOV,  \ wkl to nl
      THEN,
      \ f1h,f1l >> 2 
      R4 R5 C,          \ f1h:f1l?
      H IF,             \ bit in f1h?
         R4 2 SRL,      \ yes..shift f1h right 2 bits
         EQ IF,         \ bit shifted out?
            R5 4000 LI, \ set f1l to shifted-out bit
         THEN,
      ELSE,             \ no..bit is in f1l
         R5 2 SRL,      \ shift f1l right 2 bits
      THEN,
      \ nh,nl >> 1
      R3 1 SRL,         \ shift nl right 1 bit
      R2 1 SRL,         \ shift nh right 1 bit
      OC IF,            \ carry?
         R3 8000 ORI,   \ set MSb of nl
      THEN,
   REPEAT,
   R3 *SP MOV,          \ return n on stack
;ASM

 

 

This routine (UDSQRT) is 128 bytes long, but is very fast. Even for the highest unsigned double number possible, FFFF FFFF16 (4,294,967,29510), it is a mere hesitation—quicker than I could manage a stopwatch. It uses a binary version of the paper-and-pencil method of working out square roots we learned in grade school. The result is truncated rather than rounded.

 

The basis for the above code is this C routine:

Spoiler
/**
 * \brief    Fast Square root algorithm
 *
 * Fractional parts of the answer are discarded. That is:
 *      - SquareRoot(3) --> 1
 *      - SquareRoot(4) --> 2
 *      - SquareRoot(5) --> 2
 *      - SquareRoot(8) --> 2
 *      - SquareRoot(9) --> 3
 *
 * \param[in] a_nInput - unsigned integer for which to find the square root
 *
 * \return Integer square root of the input value.
 */
uint32_t SquareRoot(uint32_t a_nInput)
{
    uint32_t op  = a_nInput;
    uint32_t res = 0;
    uint32_t one = 1uL << 30; // The second-to-top bit is set: use 1u << 14 for uint16_t type; use 1uL<<30 for uint32_t type

    // "one" starts at the highest power of four <= than the argument.
    while (one > op)
    {
        one >>= 2;
    }
    while (one != 0)
    {
        if (op >= res + one)
        {
            op = op - (res + one);
            res = res +  2 * one;
        }
        res >>= 1;
        one >>= 2;
    }
    return res;
}

 

 

...lee

Edited by Lee Stewart
Inclusion of Source Credits
  • Like 2

Share this post


Link to post
Share on other sites

Albert Van der Horst did a pile of work on this for his ciForth system. It's on comp.lang.forth.

I will see if I can find a Forth version for comparison.

Share this post


Link to post
Share on other sites

I found it but it needs a pile of library code from his system and I think it is for 64 bit integers so it will choke on our favourite CPU.

 

https://groups.google.com/g/comp.lang.forth/c/j_8Bdl7-c_s/m/j-J3E_NjAQAJ

 

Incomprehensible to me.

 

Spoiler
1,000,000,013 CONSTANT p

WANT SQ SQRT FACTOR GCD PRIME?
WANT REGRESS

\ For N return FLOOR of the square root of n.
VARIABLE T 1000 T !
: SQRT1 >R
    T @ [email protected] OVER / + 2/ \ Minimize iterations.
    BEGIN 
      [email protected] OVER / OVER + 2/ .S 2DUP > 
    WHILE
      NIP 
    REPEAT 
    DROP RDROP DUP T ! ;

 REGRESS 1001 SQRT S: 31
 REGRESS 81 SQRT S: 9

\ For N return :" n IS a square"
VARIABLE T_s 1000 T_s !
: SQ? >R
    T_s @ [email protected] OVER / + 2/ \ Minimize iterations.
    BEGIN
      [email protected] OVER / OVER + 2/ .S 2DUP > 
    WHILE
      NIP 
    REPEAT 
    DUP T_s ! * R> = ;

 REGRESS 1001 SQ? S: 0
 REGRESS 81 SQ? S: -1

: hart 
  DUP 1 
  DO
    KEY? IF RDROP LEAVE THEN
    DUP I M* THROW SQRT1 1+ DUP >R  \ s
    SQ OVER MOD \ m
    DUP SQ? .S IF
        SQRT \ t
        R> SWAP - OVER GCD LEAVE
    ELSE
        R> 2DROP
    THEN
    .S 
  LOOP ;

 

 

Share this post


Link to post
Share on other sites
56 minutes ago, Lee Stewart said:

The comments by @Tursi and @Asmusr regarding methods of calculating square roots sparked a Google search, which netted the algorithm I used in the following fast routine for the square root of an unsigned double number (I need to search again to give due credit):

 

  Hide contents

HEX
\ Registers:   R0,R1 = udh,udl
\              R2,R3 = root (nh,nl)
\              R4,r5 = floating 1 (f1h,f1l)
\              R6,R7 = wkh,wkl
ASM: UDSQRT    ( ud -- n )
   *SP+ R0 MOV,      \ pop udh to R0
   *SP R1 MOV,       \ udl to R1
   R2 CLR,           \ clear running..
   R3 CLR,           \ ..root (nh,nl)
   R5 CLR,           \ set floating 1..
   R4 4000 LI,       \ ..to 4000 0000
   
   \ get highest power of 4 <= square (udh,udl)
   BEGIN,
      R4 R0 C,       \ f1h:udh?
      EQ IF,
         R5 R1 C,    \ f1l:udl?
      THEN,
   H WHILE,
      R4 R5 C,          \ f1h:f1l?
      H IF,             \ bit in f1h?
         R4 2 SRL,      \ yes..shift f1h right 2 bits
         EQ IF,         \ bit shifted out?
            R5 4000 LI, \ set f1l to shifted-out bit
         THEN,
      ELSE,             \ no..bit is in f1l
         R5 2 SRL,      \ shift f1l right 2 bits
      THEN, 
   REPEAT,

   \ calculate square root
   BEGIN,
      R4 R5 C,       \ f1h:f1l?
   NE WHILE,         \ f1h,f1l > 0?
      \ set up wkh,wkl = nh,nl + f1h,f1l to compare to udh,udl
      R2 R6 MOV,     \ nh to wkh
      R3 R7 MOV,     \ nl to wkl
      R5 R7 A,       \ f1l + wkl
      OC IF,         \ carry?
         R6 INC,     \ yes..increment wkh
      THEN,
      R4 R6 A,       \ f1h + wkh
      \ check if need to update running values of udh,udl & nh,nl
      R0 R6 C,       \ udh:wkh?
      EQ IF,         \ udh = wkh?
         R1 R7 C,    \ udl:wkl?
      THEN,
      HE IF,         \ udh,udl >= wkh,wkl?
         \ udh,udl = udh,udl - wkh,wkl
         R7 R1 S,    \ udl - wkl
         NC IF,
            R0 DEC,  \ reduce udh on no carry
         THEN,
         R6 R0 S,    \ udh - wkh
         \ nh,nl = wkh,wkl + f1h,f1l
         R5 R7 A,    \ wkl + f1l
         OC IF,      \ carry?
            R6 INC,  \ yes..increment wkh
         THEN,
         R4 R6 A,    \ wkh + f1h
         R6 R2 MOV,  \ wkh to nh
         R7 R3 MOV,  \ wkl to nl
      THEN,
      \ f1h,f1l >> 2 
      R4 R5 C,          \ f1h:f1l?
      H IF,             \ bit in f1h?
         R4 2 SRL,      \ yes..shift f1h right 2 bits
         EQ IF,         \ bit shifted out?
            R5 4000 LI, \ set f1l to shifted-out bit
         THEN,
      ELSE,             \ no..bit is in f1l
         R5 2 SRL,      \ shift f1l right 2 bits
      THEN,
      \ nh,nl >> 1
      R3 1 SRL,         \ shift nl right 1 bit
      R2 1 SRL,         \ shift nh right 1 bit
      OC IF,            \ carry?
         R3 8000 ORI,   \ set MSb of nl
      THEN,
   REPEAT,
   R3 *SP MOV,          \ return n on stack
;ASM

 

 

This routine (UDSQRT) is 128 bytes long, but is very fast. Even for the highest unsigned double number possible, FFFF FFFF16 (4,294,967,29510), it is a mere hesitation—quicker than I could manage a stopwatch. It uses a binary version of the paper-and-pencil method of working out square roots we learned in grade school. The result is truncated rather than rounded.

 

...lee

That's a thing of beauty. :) 

  • Thanks 1

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...