48 lines
2.1 KiB
Forth
48 lines
2.1 KiB
Forth
36000 CONSTANT #DIGITS \ Enough for !10000
|
|
CREATE S #DIGITS ALLOT S #DIGITS ERASE VARIABLE S#
|
|
CREATE F #DIGITS ALLOT F #DIGITS ERASE VARIABLE F#
|
|
1 F C! 1 F# ! \ F = 1 = 0!
|
|
|
|
\ "Bignums": represented by two cells on the stack:
|
|
\ 1) An address pointing to the least-significant unit
|
|
\ 2) An integer size representing the number of character-size units
|
|
: mod/ /mod swap ;
|
|
: B+ ( addr u addr' u' -- u'') \ Add the second "bignum" into the first
|
|
over + >R -rot over + >R ( addr' addr R:end' R:end)
|
|
swap >R 0 over R> ( addr 0 addr addr' R:end' R:end)
|
|
\ 0: Assume second has equal or more digits, as in our problem
|
|
BEGIN over R@ < WHILE \ 1: add all digits from S
|
|
dup >R C@ swap dup >R C@ ( addr c a a' R:end' R:end R:addr'* R:addr*)
|
|
+ + 10 mod/ R@ C! R> 1+ R> 1+
|
|
REPEAT R> drop ( addr c addr* addr'* R:end')
|
|
BEGIN dup R@ < WHILE \ 2: add any remaining digits from F
|
|
dup >R C@ swap >R ( addr c a' R:end' R:addr'* R:addr*)
|
|
+ 10 mod/ R@ C! R> 1+ R> 1+
|
|
REPEAT R> drop drop ( addr c addr*)
|
|
BEGIN over WHILE \ 3: add any carry digits
|
|
>R 10 mod/ ( addr m d R:addr*) R@ C! R> 1+
|
|
REPEAT rot - nip ; \ calculate travel distance, discard 0 carry
|
|
: B* ( addr u u' -- u'') \ Multiply "bignum" inplace by U'
|
|
0 2swap over >R dup >R bounds ( u' 0 addr+u addr R:addr R:u)
|
|
DO ( u' c) over I C@ * + 10 mod/ I C! LOOP
|
|
nip R> BEGIN ( c u) over WHILE \ insert carry, may have multiple digits
|
|
>R 10 mod/ R@ swap R> R@ + ( m u d addr+u R:addr) C! 1+
|
|
REPEAT nip R> ( u'' addr) drop ;
|
|
: .B ( addr u) over + BEGIN 1- \ print bignum
|
|
dup C@ [char] 0 + EMIT over over >=
|
|
UNTIL drop drop ;
|
|
: .!n 0 <# #s [char] ! hold #> 6 over - spaces type space ;
|
|
: REPORT ( n)
|
|
dup 10 <= over dup 20 111 within swap 10 mod 0= and or
|
|
IF .!n [char] = emit space S S# @ .B cr
|
|
ELSE dup 1000 mod 0=
|
|
IF .!n ." has " S# @ . ." digits" cr
|
|
ELSE drop THEN
|
|
THEN ;
|
|
: GO 0 REPORT
|
|
1 BEGIN dup 10000 <=
|
|
WHILE
|
|
S S# @ F F# @ B+ S# !
|
|
dup REPORT
|
|
dup F F# @ rot B* F# !
|
|
1+ REPEAT drop ;
|