\ -----file big.4th begins------ \ Arithmetic on big signed-magnitude numbers. \ Forth Scientific Library Algorithm #47 \ Copyright 1996 by Leonard Francis Zettel, Jr. \ Released to the Forth Scientific Library. \ This file may be compiled, copied, modified, or sold provided: \ 1) Full liability for any consequences of doing so is taken. \ 2) The nature of any modifications is clearly indicated. \ This is an ANS Forth program requiring: \ 0<> <> FALSE NIP TRUE \ From the Core Extension word set \ 2CONSTANT D< M+ From the Double-Number word set \ ? From the Programming-Tools word set \ [IF] [ELSE] [THEN] from the Programming-Tools Extension word set \ (conditional compilation used only for setting biggest) \ This is a Forth implementation of the "classical algorithms". \ See Knuth, Donald The Art of Computer Programming Vol 2 p 250. \ The internal representation of the big numbers is "little-endian \ signed magnitude". The cell at the address addr contains n, the \ size of the number in digits. n is positive for positive numbers, \ negative for negative. Each succeeding cell contains a digit of \ the number in base 2**(cell size-1), least significant digit first. BASE @ DECIMAL \ Housekeeping CREATE MAX-N CHAR M C, CHAR A C, CHAR X C, CHAR - C, CHAR N C, \ Yes, this is clumsy, but it avoids making it necessary to specify \ the use of S" from the File word set. MAX-N 5 ENVIRONMENT? [IF] [ELSE] 32767 [THEN] CONSTANT biggest \ Largest representable signed number biggest 1+ CONSTANT bigbase \ big number base as an unsigned number biggest S>D 1 M+ 2CONSTANT bigbd \ big number base as a double number : cell- ( addr1 -- addr2) \ addr2 is the cell address below addr1 1 CELLS - ; \ This code guided by the description of DIGIT in C. H. Ting, F-PC \ Technical Reference Manual, 2nd ed. Offete Enterprises 1989 p. 82. \ DIGIT is intended for the character range specified by the standard (0..Z) \ Lower-case digit conversion will require system-specific code modification. : DIGIT ( c n1 -- n2 true | false) \ attempt to convert c to its \ numerical value in base n1. Return the value and TRUE if \ successful, FALSE otherwise. OVER [CHAR] 0 < IF 2DROP FALSE \ characters below the zero character \ can't be digits ELSE OVER [CHAR] : < IF DROP [CHAR] 0 - TRUE ELSE OVER [CHAR] A < IF 2DROP FALSE ELSE SWAP [CHAR] 7 - \ convert to numeric value DUP ROT < IF TRUE \ valid digit ELSE DROP FALSE THEN THEN THEN THEN ; \ Words to handle spillover between cells during calculations : carry ( digit -- carry digit) \ check for a carry, remove it, leave it \ under the result. biggest OVER U< IF bigbase - \ Remove the carry 1 \ Show we had a carry ELSE 0 \ show we had no carry THEN SWAP ; : D>carry ( low high -- carry digit) \ convert a double number to a \ low-order digit and a carry. bigbase UM/MOD SWAP ; : overflow? ( borrow uj -- uj new_borrow) \ If uj is negative (indicating \ a result out of range on the previous subtraction), bring it in \ range and increment the borrow that will be necessary on the next \ digit. DUP 0< IF bigbase + 1 ELSE 0 THEN ROT + ; \ Words to point to parts of big numbers : big_digit_pointer ( --) ( n -- address) \ create a word . \ when is executed return the address of the nth cell after \ the address in 's data field. CREATE 1 CELLS ALLOT \ create the word & allot the data space DOES> @ \ put the address in 's data field \ on the stack SWAP CELLS + ; \ Increment the address by index cells : to_pointer ( -- addr1) \ compiling: addr1 is 's data field. ( addr2 --) \ execution: addr2 is placed in 's \ data field. ' >BODY POSTPONE LITERAL POSTPONE ! ; IMMEDIATE \ Miscellaneous operations on big numbers big_digit_pointer clippee : clip ( addr --) \ remove leading zeroes from the number at addr to_pointer clippee 0 \ default - no non-zero digits 1 0 clippee @ ABS \ loop from present number of digits to one. DO I clippee @ \ next big digit 0<> IF DROP I LEAVE THEN \ index of first non-zero digit \ on stack -1 +LOOP ?DUP IF 0 clippee @ \ original sign & size 0< IF NEGATE THEN \ minus sign on new size ELSE 1 \ number is exactly zero, keep one \ of the zeros, show plus number THEN 0 clippee ! ; \ store new size : big_digit ( addr n1 -- n2) \ Return digit n1 of the big number at addr. \ If n1 is greater than the number of digits, return a leading zero. OVER @ ABS \ number of digits OVER < IF 2DROP 0 \ Return leading zero ELSE CELLS + @ \ Return digit THEN ; : bignegate ( addr --) \ Change the sign of the big number at addr DUP @ DUP \ Number of digits 1 = IF OVER CELL+ @ \ Check for zero IF NEGATE SWAP ! \ Non-zero, negate ELSE 2DROP \ Zero, do nothing THEN ELSE NEGATE SWAP ! THEN ; : bigabs ( addr --) \ Give the big number at addr its absolute value, DUP @ ABS SWAP ! ; : big>here ( addr --) \ "big to here" append the big number at addr \ to the end of data space. HERE \ address to move to OVER @ ABS 1+ CELLS \ Number of address units in the number DUP ALLOT \ allot space for the number MOVE ; : adjust_sign ( addr1 addr2 addr3 -- addr3) \ adjust the sign of the big \ number at addr3 according to the rules for forming the algebraic \ product from the operands at addr1 and addr2 ROT @ ROT @ XOR 0< IF DUP bignegate THEN ; \ Move the number at addr1 to addr2 and free any data space beyond it. : reposition ( addr1 addr2 -- ) SWAP 2DUP @ \ (addr2 addr1 addr2 size) ABS 1+ CELLS \ (addr2 addr1 addr2 bytes) DUP >R MOVE \ (addr2) (bytes) R> + HERE - ALLOT ; \ Comparison operators big_digit_pointer |big|1 big_digit_pointer |big|2 : |big|= ( addr1 addr2 -- flag) \ TRUE if the big number at addr1 has the \ same absolute value as the big number at addr2. FALSE otherwise OVER @ ABS OVER @ ABS = \ are the numbers the same size? IF to_pointer |big|1 to_pointer |big|2 TRUE \ default initial flag. 1 0 |big|1 @ ABS DO I |big|1 @ I |big|2 @ <> IF DROP FALSE LEAVE THEN -1 +LOOP ELSE 2DROP FALSE THEN ; : |big|< ( addr1 addr2 -- flag) \ TRUE if the absolute value of the \ big number at addr1 is less than the absolute value of the big number \ at addr2. FALSE otherwise. to_pointer |big|2 to_pointer |big|1 0 |big|1 @ ABS 0 |big|2 @ ABS 2DUP < IF 2DROP TRUE ELSE = FALSE \ default flag if equal, result if <>. SWAP IF 1 0 |big|1 @ ABS \ From the high order digit to the first DO \ digit I |big|1 @ I |big|2 @ 2DUP <> IF < NIP LEAVE THEN 2DROP -1 +LOOP THEN THEN ; : big0= ( addr -- flag) \ Return TRUE if the big number at addr is zero. DUP @ 1 = IF CELL+ @ 0= ELSE DROP FALSE THEN ; : big0<> ( addr -- flag) \ Return TRUE if the big number at addr is not zero. big0= 0= ; : big0< ( addr -- flag) @ 0< ; : big< ( addr1 addr2 -- flag) \ TRUE if the operand at addr1 is less than \ the operand at addr2. FALSE otherwise. OVER @ OVER @ < \ Look at operand sign & number of digits IF 2DROP TRUE ELSE \ ( addr1 addr2) OVER @ OVER @ > IF 2DROP FALSE ELSE \ To get here the operands must be the \ same sign & be of equal length DUP @ 0< IF SWAP THEN \ If the numbers are negative, the one with \ the larger absolute value is the lesser. DUP @ ABS >R \ Park number of digits R@ CELLS DUP ROT + \ High order cell of operand 2. ROT ROT + \ High order cell of operand 1. SWAP FALSE \ dummy initial flag R> 0 DO \ ( addr1 addr2 flag) DROP \ flag from previous cycle OVER @ OVER @ \ ( addr1 addr2 digit1 digit2) < DUP IF LEAVE THEN ROT cell- ROT cell- ROT LOOP NIP NIP THEN THEN ; : big= ( addr1 addr2 -- flag) \ TRUE if the big number at addr1 has the \ same absolute value as the big number at addr2. FALSE otherwise OVER @ OVER @ = \ are the numbers the same size? IF to_pointer |big|1 to_pointer |big|2 TRUE \ default initial flag. 1 0 |big|1 @ ABS DO I |big|1 @ I |big|2 @ <> IF DROP FALSE LEAVE THEN -1 +LOOP ELSE 2DROP FALSE THEN ; \ Words doing mixed single-precision and big number arithmetic big_digit_pointer big_addend : big+s ( addr n --) \ add n to the number at addr. n must be non-negative \ the number at addr must be non-negative and end at HERE. SWAP to_pointer big_addend \ ( n) 0 big_addend @ ABS 1+ \ loop limit 1 \ loop start DO \ ( n) I big_addend @ + \ ( ui+n) carry I big_addend ! \ store new ui DUP 0= IF LEAVE THEN \ no carry, we are done LOOP \ carry in high-order digit? IF 1 , \ append carry to the number 1 0 big_addend +! \ Increment number size THEN ; big_digit_pointer big_multiplicand : big*s ( addr n -- ) \ multiply the number at addr by n. \ n must be positive \ the number at addr must end at "here" SWAP to_pointer big_multiplicand 0 \ ( n carry) 0 big_multiplicand @ ABS 1+ 1 DO \ ( n carry) OVER I big_multiplicand @ M* \ ( carry n low[ui*n] high[ui*n]) ROT M+ \ ( n low[ui*n+carry] high[ui*n+carry]) D>carry \ ( n carry ui*n) I big_multiplicand ! \ store digit i back in u ( n carry) LOOP NIP ?DUP IF 0 big_multiplicand @ \ ( carry n) DUP 0< IF 1- ELSE 1+ THEN \ ( carry n) 0 big_multiplicand ! , THEN ; big_digit_pointer big_dividend : big/mods ( addr n1 -- n2) \ "big slash-mod s". Divide the big number at \ addr by n1, leaving the quotient at addr. n2 is the remainder. SWAP to_pointer big_dividend 0 \ ( divisor remainder) 1 0 big_dividend @ ABS DO \ ( divisor remainder) OVER SWAP \ ( divisor divisor remainder) 2 /MOD \ ( divisor divisor lowr highr) I big_dividend @ \ ( divisor divisor lowr highr uj) ROT \ ( divisor divisor highr uj lowr) IF bigbase + THEN SWAP \ ( divisor divisor [rb+uj]) ROT UM/MOD \ ( divisor r wj ) I big_dividend ! -1 +LOOP NIP 0 big_dividend clip ; \ Words for going from characters to big numbers : >big_number ( addr1 addr2 u1 -- addr1 addr3 u2) \ "to big number" \ extend the big number at addr1 by the number represented by the \ string of u1 characters at addr2. addr3 is the address of the first \ unconverted character and u2 is the number of unconverted characters 2DUP + >R \ address just beyond end of string on \ return stack 0 DO \ ( addr1 addr2) 2DUP C@ \ ( addr1 addr2 addr1 char) BASE @ DIGIT \ ( addr1 addr2 addr1 n flag) IF OVER BASE @ big*s \ ( addr1 addr2 addr1 n) big+s \ ( addr1 addr2) ELSE \ ( addr1 addr2 addr1 char) DROP LEAVE \ ( addr1 addr2) THEN CHAR+ LOOP R> OVER - ; : make_big_number ( addr1 u -- addr2) \ convert the u characters at addr1 \ to a big number at addr2 \ If the first character is "-" (ASCII 45) the result will be negative. \ embedded commas are ignored \ (USA representation convention for large numbers) \ Conversion stops at the first non-convertible character. OVER C@ \ Get the first character [CHAR] - = \ Is it a minus sign? DUP >R IF SWAP CHAR+ SWAP 1- THEN \ Adjust to next character \ ( addr1 u) HERE 1 , 0 , \ create big number = 0 \ ( addr1 u addr2) ROT ROT BEGIN \ ( addr2 addr1 u) >big_number \ ( addr2 addr1 u) OVER C@ [CHAR] , = \ ( addr2 addr1 u flag) OVER AND WHILE SWAP CHAR+ SWAP 1- REPEAT 2DROP R> IF DUP bignegate THEN ; \ Words for big number output \ The words ( addr1 -- addr2 +n) \ "number sign big less". End big number \ pictured output conversion DROP bighld @ \ Start of string big_string 256 CHARS + \ One past end of string OVER - 1 CHARS / ; \ Length of string : big# ( addr -- addr) \ "big number sign" \ Generate the next ASCII character from the big number at addr. \ Afterward the big number at addr will hold the quotient obtained \ by dividing its previous value by the value in BASE. \ This result can then be used for further processing. \ Haydon p 18 DUP BASE @ big/mods \ Next digit 9 OVER < \ Is it bigger than a decimal digit? IF 7 + THEN \ Add seven to its character representation, \ thus skipping the ASCII codes between 9 and A. 48 + \ Convert from number to ASCII character code. bighold ; \ add the character to the front of the output \ string : big#s ( addr -- addr) \ "big number sign s" Convert all digits of the \ big number at addr to big numeric output, leaving \ zero at addr BEGIN big# DUP @ 1 = \ Down to length 1 OVER CELL+ @ 0= \ Remaining cell is zero AND UNTIL ; \ Haydon p 21. : bigsign ( n --) \ Put a minus sign in the big pictured numeric \ character output string if n is negative 0< IF 45 bighold THEN ; \ Haydon p 222. : bigstring ( addr1 sign -- ) \ Display the big number at addr1 with \ the sign of the number in sign. TYPE ; \ Words doing arithmetic on two big numbers big_digit_pointer long_addend big_digit_pointer short_addend : sum ( addr1 addr2 - addr3) \ addr3 has the result of adding the absolute \ value of the big number at addr1 to the absolute value of the big \ number at addr2. OVER @ ABS OVER @ ABS < \ compare the size of the addends IF SWAP THEN to_pointer short_addend to_pointer long_addend HERE \ address of result 0 , \ dummy placeholder for the count of the \ result 0 \ initialize carry 0 short_addend @ ABS 1+ \ for each digit in the short addend 1 \ starting at the first DO I short_addend @ + \ add digit to carry I long_addend @ + \ add digit to previous sum carry , \ new carry, append digit to result LOOP 0 long_addend @ ABS \ number of digits in long operand 1+ \ jog to make DO end on last digit 0 short_addend @ ABS \ number of digits in short operand 1+ \ jog to start DO on first digit \ not yet used ?DO I long_addend @ + \ append any remaining digits to the carry , \ result, rippling the carry as LOOP \ necessary 0 long_addend @ ABS \ result size so far SWAP IF 1 , 1+ THEN \ if final carry, append to result, \ bump size OVER ! ; \ store result size. big_digit_pointer minuend big_digit_pointer subtrahend : difference ( addr1 addr2 -- addr3) \ addr3 is the address of the difference of the absolute values of \ the big number at addr1 and the big number at addr2. HERE >R \ park address of result 2DUP |big|= IF 2DROP 1 , 0 , \ equal absolute values, result is zero ELSE 2DUP |big|< IF SWAP THEN to_pointer subtrahend to_pointer minuend 0 minuend @ ABS , \ count of the result 0 \ initialize borrow 0 minuend @ ABS 1+ \ for each minuend digit 1 \ starting with the first DO \ ( borrow) 0 \ next borrow I minuend @ \ get the ith minuend digit ROT - \ subtract previous borrow overflow? SWAP \ ( borrow result) 0 subtrahend I big_digit - \ subtract the ith subtrahend digit overflow? \ ( result borrow) SWAP , \ append result LOOP DROP \ Get rid of final borrow (it will be zero) R@ clip \ remove leading zeroes THEN R> ; \ address of result on stack big_digit_pointer multiplicand big_digit_pointer multiplier big_digit_pointer product : big_product ( addr1 addr2 -- addr3) \ addr3 has the result of multiplying \ the absolute value of the n digit operand at addr1 by the absolute \ value of the m digit operand at addr2. to_pointer multiplier to_pointer multiplicand \ store operand addresses HERE DUP to_pointer product \ address of result 0 multiplier @ ABS 0 multiplicand @ ABS 2DUP + , \ store product size \ allot and clear the first DUP 0 DO 0 , LOOP \ n digits of the product OVER CELLS ALLOT \ allot remaining digits of product OVER 1+ 1 \ for each multiplier digit, \ starting with the first DO 0 \ initial carry OVER 1+ 1 \ for each multiplicand digit, \ starting with the first DO I multiplicand @ \ mulitplicand digit times J multiplier @ \ multiplier digit M* I J 1- + >R \ current product digit index R@ product @ M+ \ add previous product result ROT M+ \ add carry D>carry \ split into digit & carry R> product ! \ store product digit LOOP OVER I + product ! \ store carry LOOP 2DROP DUP clip ; \ if there is a high-order zero, \ remove it big_digit_pointer dividend big_digit_pointer divisor big_digit_pointer quotient VARIABLE normalizer : divisor(n) ( -- n) \ n is the high digit of the divisor 0 divisor @ ABS divisor @ ; : divisor(n-1) ( -- n) \ n is the next-to-high-order digit of the divisor 0 divisor @ ABS 1- divisor @ ; : normalize ( -- ) \ Multiply dividend and divisor by a factor that \ will guarantee that the leading "digit" of the divisor will be \ > bigbase/2 bigbd \ big number base as double number divisor(n) \ high order digit of divisor 1+ UM/MOD normalizer ! \ normalizing factor (base/(vn+1)) DROP \ discard remainder HERE \ This will be the address of the \ normalized dividend 0 dividend big>here \ copy dividend to end of data space to_pointer dividend \ new dividend address normalizer @ 1 > IF 0 dividend normalizer @ big*s \ normalize the dividend. THEN 0 , \ append high order zero to dividend 0 dividend DUP @ 0< \ negative dividend? IF -1 ELSE 1 THEN SWAP +! \ up the dividend digit count HERE \ address of the normalized divisor 0 divisor big>here \ copy divisor to end of data space DUP to_pointer divisor normalizer @ big*s ; \ normalize the divisor : trial ( n1 -- n2) \ n2 is trial quotient digit n1 0 divisor @ ABS + >R R@ dividend @ bigbase UM* \ u(j)*b R@ 1- dividend @ M+ \ [u(j)*b+u(j-1)] divisor(n) \ high digit of divisor R@ dividend @ = \ equal to uj? \ data stack: low[u(j)*b+u(j-1)] \ high[u(j)*b+u(j-1)] \ flag IF R@ 1- dividend @ \ rhat = u(j-1) biggest \ qhat = base -1 ELSE divisor(n) UM/MOD \ rhat qhat THEN \ ( rhat qhat) (j) BEGIN \ test trial quotient 2DUP divisor(n-1) UM* \ v(n-1)*q ROT bigbase UM* \ rhat*b R@ 2 - dividend @ \ u(j-2) M+ 2SWAP D< WHILE \ ( rhat qhat) (j) 1- \ decrease trial quotient SWAP divisor(n-1) + \ adjust remainder SWAP REPEAT R> DROP \ clear return stack NIP ; \ drop trial remainder : div_subtract ( quotient j -- quotient flag) \ subtract (vn..v1)q from (u(j+n)..u(j)) \ flag is TRUE if the result is negative 0 \ borrow 0 divisor @ ABS 1+ 1 DO \ ( quotient j borrow) >R 2DUP R> ROT I divisor @ M* D>carry \ convert from double number to \ big digits \ ( quotient j j borrow carry digit) ROT + \ add the previous borrow to the digit overflow? ROT dividend @ \ uj ROT - \ new uj overflow? \ ( quotient j uj borrow) >R \ park new borrow OVER dividend ! \ store new uj 1+ \ bump j R> LOOP OVER dividend @ SWAP - \ subtract the last borrow from the \ next digit of u DUP ROT dividend ! \ put the result in the digit of u 0<> ; \ test for overflow : addback ( j --) \ add (vn..v1) to (u(j+n)..u(j)) 0 \ carry 0 divisor @ ABS 1+ 1 DO \ j carry OVER DUP dividend @ \ j carry j u(j) I divisor @ + ROT + \ j j (v(i)+u(j)+carry) carry ROT dividend ! SWAP 1+ SWAP \ increment j LOOP DUP IF \ Deal with the final carry (I'm not sure \ this is strictly necessary (If you can \ prove it one way or the other, I would be \ interested in seeing it) but it is neater) SWAP dividend +! ELSE DROP THEN ; : |divide| ( addr1 addr2 -- addr3) \ addr3 contains the result of dividing \ the absolute value of the big number at addr1 by the absolute value \ of the big number at addr2. The numbers must be unequal and the \ divisor must have at least two "digits". to_pointer divisor to_pointer dividend normalize HERE DUP \ address of quotient to_pointer quotient 1 \ limit for DO - stop after digit 1 0 dividend @ ABS \ number of digits in normalized dividend 0 divisor @ ABS \ number of digits in divisor - 1 MAX DUP , \ number of digits in quotient DUP CELLS ALLOT \ space for quotient DO I trial \ trial quotient digit I div_subtract IF 1- I addback THEN \ ( qi) I quotient ! \ store qi -1 +LOOP DUP clip ; : divide ( addr1 addr2 -- addr3) \ addr3 contains the result of dividing \ the absolute value of the big number at addr1 by the absolute value \ of the big number at addr2. 2DUP |big|< \ Is the number at addr1 < num at addr2? IF 2DROP HERE 1 , 0 , \ answer is 0 ELSE 2DUP |big|= \ are the numbers equal? IF 2DROP HERE 1 , 1 , \ answer is 1 ELSE DUP @ ABS 1 = \ single "digit" divisor? IF CELL+ @ \ divisor on stack HERE ROT big>here \ dividend to here DUP ROT big/mods DROP \ drop remainder DUP @ ABS \ absolute value for sign of quotient OVER ! ELSE |divide| THEN THEN THEN ; \ Finally! the words for the user. : big ( -- addr) \ addr is the address of the big number \ created from characters cccc in the input stream. BL WORD COUNT \ ( addr u) >R big_string R@ MOVE \ move characters from input stream to buffer big_string R> make_big_number ; : big. ( addr --) \ "big dot" Display the big number at addr HERE >R R@ SWAP big>here \ Copy for nondestructive write DUP @ \ sign of the number SWAP bigstring SPACE R> HERE - ALLOT ; \ recover space used by big>here : big.digits ( addr --) \ "big dot digits" print the digits of the \ big number at addr DUP CELL+ SWAP DUP @ ABS CELLS + DO I ? -1 CELLS +LOOP ; big_digit_pointer op1 big_digit_pointer op2 : big+ ( addr1 addr2 -- addr3) \ addr3 has the result of algebraically \ adding the operand at addr1 to the operand at addr2. HERE >R 2DUP to_pointer op2 to_pointer op1 0 op1 @ 0 op2 @ XOR 0< IF difference \ operands are of opposite sign 0 op1 0 op2 |big|< IF 0 op2 @ \ result has the sign of operand 2 ELSE 0 op1 0 op2 |big|= IF 1 \ result is zero, plus sign ELSE 0 op1 @ \ result has the sign of operand 1 THEN THEN ELSE sum \ operands have same sign 0 op1 @ THEN OVER @ \ size of result SWAP 0< IF NEGATE THEN \ add the sign OVER ! R@ reposition R> ; : big- ( addr1 addr2 - addr3) \ addr3 has the result of algebraically \ subtracting the operand at addr2 from the operand at addr1. HERE >R big>here \ copy second operand R@ bignegate \ switch its sign R@ big+ \ add R@ reposition R> ; : big* ( addr1 addr2 -- addr3) \ addr3 is the address of the result of \ multiplying the operand at addr1 by the operand at addr2 2DUP big_product adjust_sign ; : big/ ( addr1 addr2 -- addr3) \ addr3 contains the floored quotient of \ the big number at addr1 dvided by the big number at addr2. \ addr3 is the value of HERE before the operation. HERE >R 2DUP divide ( adjust_sign) ROT @ ROT @ XOR 0< \ Do we need an adjustment? IF DUP 1 big+s DUP bignegate THEN R@ reposition R> ; \ big 288,265,561,597,526,014 big 17,593,259,786,239 big/ should leave a \ result of 16384. This tests the rare "trial divisor off by two" division \ branch on a 16 bit system. See Regener for more on this : bigmod ( addr1 addr2 -- addr3) \ addr3 is the remainder after dividing \ the big number at addr1 by the big number at addr2. addr3 is the value \ returned by HERE before the operation. HERE >R 2DUP big/ \ (addr1 addr2 qoutient-addr) big* big- R@ reposition R> ; : big/mod ( addr1 addr2 -- addr3 addr4) \ addr3 is the remainder and addr4 \ is the quotient after dividing the big number at addr1 by the big \ number at addr2. 2DUP big/ DUP >R big* big- R> ; BASE ! \ End of file; restore BASE \ Bibliography & references: \ Haydon, Glen B. All About FORTH, An Annotated Glossary, Second edition \ 1984 MVP-FORTH Series Volume 1, Mounatin View Prees, Inc., P.O. Box 4656 \ Mountain View CA 94040 USA. ISBN 0-914699-00-8. \ Knuth, Donald B. The Art of Computer Programming, Second Edition Volume 2 \ Seminumerical Algorithms. Addison-Wesley Publishing Company Reading, \ Massachusetts USA 1961. ISBN 0-201-03822-6 (v.2) \ Regener, Eric "Multiprecision Integer Division Examples Using Arbitrary Radix" \ ACM Transactions on Mathematical SOftware, Vol 10 No. 3, September 1984 \ pp 325-28. \ Ting, C. H. F-PC 3.5 Technical Reference Manual, Second Edition 1989. \ Offete Enterprises, Inc. 1306 South B Street San MAteo CA 94402 USA. \ \ ------end of file------