Deutsch   English   Français   Italiano  
<668e87ec$1@news.ausics.net>

View for Bookmarking (what is this?)
Look up another Usenet article

Date: Wed, 10 Jul 2024 23:08:59 +1000
MIME-Version: 1.0
User-Agent: Mozilla Thunderbird
Subject: Re: exercise in double number arithmetic
Newsgroups: comp.lang.forth
References: <v6c8v0$3usoe$1@dont-email.me>
 <9c8e8993d3413e65caf355ecc6ceea31@www.novabbs.com>
 <v6cl84$obt$2@dont-email.me>
 <5027ddf17f1061435c0ef1df0c5a2061@www.novabbs.com>
 <v6e4gn$bjep$1@dont-email.me> <v6e8vu$bdbc$1@dont-email.me>
 <v6gm4j$s90n$2@dont-email.me> <v6leh4$1qbfn$1@dont-email.me>
 <668e491f$1@news.ausics.net>
Content-Language: en-GB
From: dxf <dxforth@gmail.com>
In-Reply-To: <668e491f$1@news.ausics.net>
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 7bit
NNTP-Posting-Host: news.ausics.net
Message-ID: <668e87ec$1@news.ausics.net>
Organization: Ausics - https://newsgroups.ausics.net
Lines: 35
X-Complaints: abuse@ausics.net
Path: ...!weretis.net!feeder9.news.weretis.net!news.bbs.nz!news.ausics.net!not-for-mail
Bytes: 2124

On 10/07/2024 6:41 pm, dxf wrote:
> On 10/07/2024 5:51 pm, Gerry Jackson wrote:
>>
>> [...] I found I had another definition for D/MOD from Forth Dimensions Vol 14 Issue 6, p 27 "Math - Who Needs It"
>> https://www.forth.org/fd/FD-V14N6.pdf
>> I've no idea how good it is
>  
> Here's the source file (32MATH.SEQ) for those interested:
> 
> https://pastebin.com/mfU8FZ1x

Here's one I had lying around.  Not sure if I used it so may require checking
first!  The 2variable is an eye-sore.  Perhaps someone can eliminate it without
resorting to locals :)

2variable d

\ Divide quad by double. Unsigned.
: DUM/MOD ( uq ud -- udrem udquot )
  d 2! [ 16 cells ] literal 0 do
    dup >r  2swap  dup >r  d2*  2swap d2*
    r> 0<  dup d-  2dup d 2@  du< 0=  r> 0<  or
    if  d 2@ d-  2swap 1 0 d+ 2swap  then
  loop  2swap ;

\ Divide doubles. Unsigned.
: DU/MOD ( ud1 ud2 -- udrem udquot )
  0 0 2swap dum/mod ;

\ Divide doubles. Signed. Symmetric.
: D/MOD ( d1 d2 -- drem dquot )
  2 pick  2dup xor 2>r  dabs  2swap dabs
  2swap du/mod  r> 0< if  dnegate  then
  r> 0< if  2swap dnegate 2swap  then ;