XProfan

Window Title "Größere Faktorielle berechnen"
'(CL) CopyLeft 2014-09 by P.woodpecker, Wien; No however geartete Gewähr!
'Orig.-Source from https://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
Window 0,0-%maxx,%maxy
font 2
var Limit& = 10000' Sufficient digits.
var Base&  = 10' The base of the simulated arithmetic.
var FactorialLimit& = 365' Default of Target number to solve, 365!
Declare digit&[Limit&]' 1..Limit&: The big number.
declare carry&,d&' Assistants during multiplication.
declare last&,i&,n&' Indices to the big number's digits.
declare Text$,c$' Scratchpad for output and for input
declare tdigit$[] : tdigit$[]=explode("0 1 2 3 4 5 6 7 8 9"," ")
BEGIN:
Print "\n number, from the The Faktorielle errechnet go should: ? ";:Input c$
case val(c$)>0:FactorialLimit&=val(c$)
digit&[]=0' Clear the whole aray.
digit&[1]=1' The big number starts with 1,
last&=1' Its highest-order digit is number 1.

whileloop FactorialLimit&

    n&=&Loop' Step through producing 1!, 2!, 3!, 4!, etc.
    carry&=0' Start a multiply by n.

    whileloop last&:i&=&Loop' Step along every digit.

        d&=digit&[i&]*n&+carry&' The classic multiply.
        digit&[i&]=(d& mod Base&)' The low-order digit of the result.
        carry&=d& \ Base&' The carry to the next digit.

    endwhile

    while carry& > 0' net curtain the carry in the big number.

        if last&>=Limit&

            print "Overflow!";' If possible!
            beep: waitinput :end

        endif

        last&=last& + 1' One more digit.
        digit&[last&]=carry& mod Base&' Placed.
        carry&=carry& \ Base&' The carry reduced.

    endwhile' With n > Base, maybe > 1 digit extra.

    case rnd()<0.1:print "*";
    ' Print n&;"! = ";text$+" ("+st$(len(Text$)-1)+" to put)"  ' Print the result!

endwhile' On to the next factorial up.

text$=" "' Now prepare the output.

whileloop last&:i&=&Loop' Translate from binary to Text.

    Text$=tdigit$[digit&[i&]]+text $' Reverse the order.

endwhile' Arabic numerals put the low order last.

cls
Print "\n "+st$(n&)+" ! = ";text$+" ("+st$(len(text $))+" to put)"
clearclip:putclip st$(n&)+" ! = "+text $+"\n"
print "\n Last result in clipboard! "
sound 300,300 : waitinput
END

Proc Facf :parameters N&:casenot N&:return 1.0

    if N&>100000:print " *** FAC() TOO BIG! *** ";:beep:return -100000:endif

        if N&<171:var p!=1:whileloop N&:p!=p!*&Loop:endwhile:return p!

            else :var s!=0:whileloop N&:s!=s!-lg(&Loop):endwhile:return s!:endif

        ENDPROC

        Declare n!,F!

        Repeat

            print " n = ";:input n!:F!=Facf(n!)
            print " Facf(";int(n!);") = ";

            if F!>=0:print stature$(" %g",F!)

                else :set("decimals",17)
                print st$( round(10^(int(F!)-F!),13))+"e+"+st$(int(-F!) )

            endif

        Until 0