From: krishna.myneni@ccreweb.org   
      
   On 5/3/24 17:02, Krishna Myneni wrote:   
   ...   
   >   
   > Here's the full program to solve Euler13 using addition of double   
   > numbers on a 64-bit Forth system using only standard words and no   
   > floating point. With a little work, it can be used to print the full sum   
   > as well.   
   >   
   > -- KM   
   >   
   > === begin code ===   
   > \ euler13.4th   
   > \   
   > \ Work out the first ten digits of the sum of the   
   > \ following one-hundred 50-digit numbers.   
   >   
   > 1 CELLS 8 < ABORT" Needs 64-bit Forth!"   
   >   
   > 10 constant LF   
   > 100 constant N   
   >   50 constant Ndig   
   >   
   > create $nums N Ndig * allot   
   > create Dnums[ N 2* 16 * allot   
   > : ]D@ ( a idx -- ud ) 16 * + 2@ ;   
   > : ]D! ( ud a idx -- ) 16 * + 2! ;   
   > : $>ud ( a u -- ud )  0 s>d 2swap >number 2drop ;   
   > : $>2ud ( a u -- ud_low ud_high )   
   >     drop Ndig 2/ 2dup + over $>ud 2swap $>ud ;   
   >   
   > \ Read N big numbers as strings and then parse into   
   > \ double length array   
   > : read-numbers ( -- )   
   >      N 0 DO   
   >          refill IF   
   >            LF parse dup Ndig <> ABORT" String Length Error!"   
   >            $nums Ndig I * + swap move   
   >          ELSE  ABORT   
   >          THEN   
   >      LOOP   
   >      N 0 DO   
   >        $nums Ndig I * + Ndig   
   >        $>2ud Dnums[ I 2* 1+ ]D! Dnums[ I 2* ]D!   
   >      LOOP ;   
   >   
   > read-numbers   
   > 37107287533902102798797998220837590246510135740250   
   > ...   
   >   
   > 2variable dsum_high   
   > 2variable dsum_low   
   >   
   > : sumDnums ( -- )   
   >      0 s>d 2dup dsum_high 2! dsum_low 2!   
   >      N 2* 0 DO   
   >        I 1 and IF   
   >          dsum_high 2@ Dnums[ I ]D@ D+ dsum_high 2!   
   >        ELSE   
   >          dsum_low  2@ Dnums[ I ]D@ D+ dsum_low 2!   
   >        THEN   
   >      LOOP ;   
   >   
   > sumDnums   
   > \ dsum_low  2@ ud. cr   
   > \ dsum_high 2@ ud. cr   
   >   
   > \ add carry portion of low to high for unsigned 25 digit   
   > \ numbers to find the new high portion.   
   >   
   > : udsum_25 ( udhigh udlow -- udhigh' )   
   >     10000000000000000000 um/mod nip 1000000 / s>d d+ ;   
   >   
   > \ print the leading 10 digits of the sum   
   > : print-leading10 ( -- )   
   >      dsum_high 2@ dsum_low 2@ udsum_25   
   >      100000000000000000 um/mod nip u. ;   
   >   
   > print-leading10 cr   
   >   
   > === end code ===   
   >   
   > === run output ===   
   > include euler13   
   > 5537376230   
   >   ok   
   > === end output ===   
   >   
   >   
      
   Now that we have seen the code works, it's time to dispense with the   
   string storage and the array storage, which were useful for intermediate   
   diagnostics, and compact the code.   
      
   === begin code ===   
   \ euler13-2.4th   
   \   
   \ Print the first ten digits of the sum of a   
   \ sequence of N 50-digit numbers.   
      
   1 CELLS 8 < ABORT" Needs 64-bit Forth!"   
      
   10 constant LF   
   50 constant Ndig   
      
   : $>ud ( a u -- ud )  0 s>d 2swap >number 2drop ;   
   : $>2ud ( a u -- ud_low ud_high )   
       drop Ndig 2/ 2dup + over $>ud 2swap $>ud ;   
   : d+! ( d a -- ) dup >r 2@ d+ r> 2! ;   
      
   \ add carry portion of udlow to udhigh for 25 decimal   
   \ digit numbers; return new high portion.   
   : udsum_25 ( udhigh udlow -- udhigh' )   
       10000000000000000000 um/mod nip 1000000 / s>d d+ ;   
      
   \ print the leading 10 digits   
   : print-leading10 ( udhigh udlow -- )   
        udsum_25 100000000000000000 um/mod nip u. ;   
      
   \ Sum n big numbers as two doubles, holding the   
   \ high and low 25 decimal digits   
   2variable dsum_high   
   2variable dsum_low   
   : sum-numbers ( n -- udhigh udlow )   
        >r  0 s>d 2dup dsum_high 2! dsum_low 2!   
        dsum_high dsum_low   
        r> 0 DO   
            refill IF   
              LF parse dup Ndig <> ABORT" String Length Error!"   
              $>2ud 5 pick D+! 2 pick D+!   
            ELSE  ABORT   
            THEN   
        LOOP 2drop dsum_high 2@ dsum_low 2@ ;   
      
   100 sum-numbers   
   37107287533902102798797998220837590246510135740250   
   \ ...   
   print-leading10 cr   
      
   === end code ===   
      
   === run output ===   
   include euler13-2   
   5537376230   
     ok   
   .s   
      
     ok   
   === end output ===   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)