 # fbForth 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 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
*
*      - 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
• 2

##### 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 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.

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 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. • 1

## Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account. ×   Pasted as rich text.   Paste as plain text instead

Only 75 emoji are allowed.

×   Your previous content has been restored.   Clear editor

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