www.jupiter-ace.co.uk
 
Previous Page > Index of General Forth Information > Factorials.
Practical Computing September 1982, page 151

 Open File: Forth 
 
Factorials
AFTER SEEING F S Dewhirst's program for factorials on page 126 of the September 1981 issue of Practical Computing, J Yale of Corfe Mullen, Dorset, decided to write a similar program in Forth. The program takes 13 seconds to calculate 100! and 1.1. minutes to compute and display all the factorials up to 100. The 2,568 digits of 1,000! only take 40 minutes or so to compute.
The program is contained in three blocks or screens. The function of each of the new words is:
BYTE-ARRAY - This is the definition of a new data type, an array of bytes. This is the only word in the program which is CPU specific as it contains some Z-80 assembly code for speed of array access.
MAX-DIGITS - A constant giving the maximum length of number to be used, set to an arbitrarily large value.
F-BUFF - The buffer to hold the factorial defined using Byte-Array of length Max-Digits. To access the Nth element of F-Buff the code is:
N F-BUFF
LAST - A variable containing the last index to be used in F-Buff.
*BUFF - This word is the heart of the program. Given a number on the stack it multiplies F-Buff by that number. The second half of the word extends the buffer as
required by incrementing Last to accommodate the final carry.
SETUP - This word initialises F-Buff by putting a one in the first element and setting Last to zero.
.FAC - Displays the factorial in F-Buff with a comma in every third position.
FAC - Given a number on the stack, computes its factorial in F-Buff.
FAGS - Given a number on the stack, computes and displays all the factorials up to this number.
This program was developed on a Research Machine 380-Z using a cassette-based Forth system available from F Donovan, 35 St Julians Road, St Albans, Hertfordshire, ALl 2AZ.
." - Prints the following string up to a terminating ".
/MOD - Divides the second stack item by the first leaving the quotient and remainder, with the quotient on the top of the stack.
0= - Tests the top stack item against zero. Leaves true, 1, or false, 0, on the stack.
: - Starts a new Forth definition. The word immediately following the ":" is the name of the new word.
; - Ends a Forth definition.
;CODE - Introduces the assembly-code portion of a new defining word.
;S - Marks the logical end of a block. Any text after this point will not be compiled.
ALLOT - Given a number on the top of the stack, allocates that amount of dictionary space, in this case for an array. This word is sometimes called DP+!
ASCII - Leave the ASCII code of the next character on the top.
BEGIN...IF...AGAIN - On some systems this is Begin-While-Repeat. This structure is equivalent to Do-While-End of some languages except it is more versatile in that the test can be anywhere in the loop.
C@ - Fetch a byte from the address given on the stack, and leave the byte on the stack in place of the address.
CR - Output a carriage return.
DO..LOOP - Equivalent to a For - Next loop. The limit plus 1 and the start value should be on the stack before the Do. EQU — Defines a constant. Sometimes called Constant.
FORGET - Truncates the dictionary just before the definition of the word which follows. Used to discard the code from a previous compilation.
HPUSH - An assembler macro which assembles a jump to code which pushes the HL register on to the stack before returning to the Forth inner interpreter.
I - Pushes the current innermost Do loop index on to the stack.
IF ... THEN - The condition comes before the If, like all conditions in Forth.
MOD - As /Mod except only leaves the remainder.
NOT - Reverses the truth condition on the top of the stack.
OVER - Pushes the second stack item on to the top of the stack. Thus 1 2 OVER leaves 1 2 1 on the stack.
SWAP - Swaps the two top stack items.
TASK - A dummy definition used to mark the top of the system dictionary.
U.R. - Print the second stack item in the field width specified by the top stack item. Thus 23 5 U.R prints 23 in a field width of 5.
VARIABLE - Defines a variable and initialises it to zero. When the variables name appears in a program, or is typed at the terminal, the address of the variable is left on the stack and the contents may be accessed or altered by CL and !. On some systems Variable requires an initialisation value to be specified.
  
 1 LIST                                 15 AGAIN DROP                  7 DO  LAST @ I - DUP 1+ 3 MOD 0=
  1 ( Large Factorial ) DECIMAL        16 ;                           8 I 0= NOT AND IF ASCII , EMIT THEN
  2                                    17                             9 F-BUFF C@ 1 U.R
  3 FORGET TASK   : TASK ;             18                            10 LOOP
  4                                    19                            11 ;
  5 : BYTE-ARRAY CREATE ALLOT  ;CODE   20                         ,S 12 : FAC
  6 DE INC, HL POP, DE HL ADD, HPUSH                                 13    SETUP
  7                                  3 LIST                          14  1+ 1 DO I *BUFF LOOP
  8 4000 EQU MAX-DIGITS                 1  ( Factorial 3 )           15 ;
  9 MAX-DIGITS BYTE-ARRAY F-BUFF        2                            16 : FACS TEXT SETUP 1+ 1
 10 VARIABLE LAST ( Last buff element ) 3 : SETUP 1 0 F-BUFF C!      17 DO I *BUFF ." Factorial" I 3 U.R
 11                                     4     0 LAST !               18    ." = " .FRC CR
 12 2 3 THRU                            5 ;                          19 LOOP
 13                                     6 :   .FAC LAST @ 1+ 0       20 ;                              ;S
 14 ;S
 15
 16
 17                                     Sample run.
 18                                    20 FACS
 19                                    Factorial  1 = 1           Factorial 11 = 39,916,800
 20                             ;S     Factorial  2 = 2           Factorial 12 = 479,001,600
 2 LIST                                Factorial  3 = 6           Factorial 13 = 6,227,020,800
  1 ( Factorial 2 )                    Factorial  4 = 24          Factorial 14 = 87,178,291,200
  2                                    Factorial  5 = 120         Factorial 15 = 1,307,674,368,000
  3 : *BUFF   ( Multiplier )           Factorial  6 = 720         Factorial 16 = 20,922,789,888,000
  4 0 ( Carry ) LAST @ 1+ 0            Factorial  7 = 5,040       Factorial 17 = 355,687,428,096,000
  5     DO OVER I F-BUFF C@ * +        Factorial  8 = 40,320      Factorial 18 = 6,402,373,705,728,000
  6       10 /MOD SWAP I F-BUFF C!     Factorial  9 = 362,880     Factorial 19 = 121,645,100,408,832,000
  7     LOOP                           Factorial 10 = 3,628,800   Factorial 20 = 2,432,902,008,176,640,000
  8 ( Extend buffer to accept final carry )
  9 BEGIN ?DUP
 10 IF 10 /MOD SWAP                      >100 FRC .FAC
 11     1 LAST +!  LAST @ DUP 1+         93,326,215,443,944,152,681,699,238,856,266,700,490,715,968,264,
 12     MAX-DIGITS >                     381,621,468,592,963,895,217,599,993,229,915,608,941,463,976,
 13     IF ." Out of buffer" QUIT THEN   156,518,286,253,697,920,827,223,758,251,185,210,916,864,000,
 14     F-BUFF C!                        000,000,000,000,000,000,000
A Jupiter Ace version of the program can be found in the archive and the listing.