'===========================================================================
' Subject: ASSEMBLY PI                        Date: 07/93 (00:00)          
'  Author: Victor Yiu                         Code: QB, PDS                
'  Origin: ASSEMBLY,PI                      Packet: ALGOR.ABC
'===========================================================================
' AsmPI v1.0 þ (C) Copyright Victor Yiu, July 1993.
' ~~~~~~~~~~
' FAST! FAST! FAST! FAST! FAST!
'
' Using hand-coded assembly routines I wrote, this program will calculate
' pi up to 20,000 digits at -really- high speeds.  I used Rich Geldreich's
' original BASIC public-domain "BCDPI" program as a guide.  Only thing is:
' this version is much faster.

DECLARE SUB asmBCDInit (BYVAL NumDigits%)
DECLARE SUB asmBCDclr (BYVAL Segm%)
DECLARE SUB asmBCDadd (BYVAL SegmA%, BYVAL SegmB%)
DECLARE SUB asmBCDsub (BYVAL SegmA%, BYVAL SegmB%)
DECLARE SUB asmBCDmul (BYVAL SegmA%, BYVAL SegmB%, BYVAL Mult%)
DECLARE FUNCTION asmBCDdiv% (BYVAL SegmA%, BYVAL SegmB%, BYVAL Divisor%)
DECLARE FUNCTION asmBCDdivL% (BYVAL SegmA%, BYVAL SegmB%, BYVAL Divisor%)

' Warning: These hand-coded BCD arithmetic libraries are designed for
' use in this program only.  Almost all error checking is removed;
' and sqeezed for every last ounce of speed left <g>.  Because of this,
' it only handles conditions such as ones in this program ... i.e.
' being able to only positive numbers.  It is hard to reuse these procs.
' without modification.

DECLARE SUB BCDdisplay (Array%())
DECLARE SUB PrintIt (Text$)

DEFINT A-Z
CONST False = 0, True = NOT False

NumDigits = 500    ' Range: 1 to 20,000
PassIn = VAL(COMMAND$)
IF (PassIn >= 10) AND (PassIn <= 20000) THEN NumDigits = PassIn
NumDigits = NumDigits + 5

Limit1 = (NumDigits / .69897) + ((NumDigits / .69897) * .1) + 5
Limit2 = (NumDigits / 2.37) + 7

DIM NumA(NumDigits \ 2), NumB(NumDigits \ 2), NumC(NumDigits \ 2)
asmBCDInit NumDigits        ' initialize ASM routines

CLS : COLOR 14
PRINT "AsmPI 1.0 þ (C) Copyright Victor Yiu, 1993"
PRINT STRING$(42, "~"): COLOR 7
IF VARPTR(NumA(0)) + VARPTR(NumB(0)) + VARPTR(NumC(0)) <> 0 THEN
    PRINT "Arrays not aligned on segment boundaries."
    PRINT "Unusual."
    STOP
END IF
PRINT "Calculating"; NumDigits - 5; "digits.  <Esc> to abort.";
COLOR 31
PRINT "    BLAZINGLY SUPER-FAST!!!  WOW!"
COLOR 7: PRINT

A = VARSEG(NumA(0)): B = VARSEG(NumB(0)): C = VARSEG(NumC(0))

asmBCDclr A             ' A = 10^(NumDigits-1)
asmBCDclr B
FirstDigit = (NumDigits - 1) \ 2
IF NumDigits AND 1 THEN
    NumA(FirstDigit) = 1
ELSE
    NumA(FirstDigit) = 256
END IF

PRINT "Pass 1: 0  %";
t! = TIMER                  ' start timer
                            ' do pass 1 specially:
Divisor = 3
Dummy = asmBCDdiv(A, A, 5)
Dummy = asmBCDdivL(A, C, 1) ' just copy A -> C
asmBCDadd B, C

DO WHILE Divisor < Limit1

    Dummy = asmBCDdiv(A, A, 25)
    Dummy = asmBCDdivL(A, C, Divisor)
    asmBCDsub B, C
    Divisor = Divisor + 2

    Dummy = asmBCDdiv(A, A, 25)
    Dummy = asmBCDdivL(A, C, Divisor)
    asmBCDadd B, C
    Divisor = Divisor + 2

    IF (Divisor AND 15) = 15 THEN
        LOCATE , 8
        PRINT Divisor * 100& \ Limit1;
        IF INKEY$ = CHR$(27) THEN PRINT : PRINT "Aborted.": END
    END IF
LOOP
asmBCDmul B, B, 4

LOCATE , 1
PRINT "Pass 1 complete."
PRINT "Pass 2: 0  %";

asmBCDclr A     ' A = 10^(NumDigits-1)
IF NumDigits AND 1 THEN
    NumA(FirstDigit) = 1
ELSE
    NumA(FirstDigit) = 256
END IF

Divisor = 3
Dummy = asmBCDdiv(A, A, 239)
Dummy = asmBCDdivL(A, C, 1)
asmBCDsub B, C

DO WHILE Divisor < Limit2
    Dummy = asmBCDdiv(A, A, 239)   ' 239^2
    Dummy = asmBCDdiv(A, A, 239)
    Dummy = asmBCDdivL(A, C, Divisor)
    asmBCDadd B, C
    Divisor = Divisor + 2

    Dummy = asmBCDdiv(A, A, 239)
    Dummy = asmBCDdiv(A, A, 239)
    Dummy = asmBCDdivL(A, C, Divisor)
    asmBCDsub B, C
    Divisor = Divisor + 2

    IF (Divisor AND 7) = 7 THEN
        LOCATE , 8
        PRINT Divisor * 100& \ Limit2;
        IF INKEY$ = CHR$(27) THEN PRINT : PRINT "Aborted.": END
    END IF
LOOP
asmBCDmul B, B, 4

LOCATE , 1
PRINT "Pass 2 complete.  Time:"; TIMER - t!; "secs."
BCDdisplay NumB()

SUB BCDdisplay (Array())
SHARED NumDigits

DEF SEG = VARSEG(Array(0))
Start = NumDigits - 1
Tens = -1
OPEN "PI" FOR OUTPUT AS #1
PRINT

FOR Disp = Start TO 4 STEP -1     ' skip last 5 or so
    Temp = PEEK(Disp)
    IF Temp > 9 THEN
        PRINT
        PRINT "Bad number!  Error in program!"
    ELSE
        Tens = Tens + 1

        PrintIt CHR$(Temp + 48)
        IF Disp = Start THEN
            PrintIt "."
        ELSEIF (Tens MOD 10) = 0 THEN
            PrintIt " "
            IF (Tens MOD 70) = 0 THEN
                PrintIt "": PrintIt "  "
            END IF
        END IF
    END IF
NEXT
CLOSE

DEF SEG

END SUB

SUB PrintIt (Text$)

IF LEN(Text$) THEN
    PRINT Text$;
    PRINT #1, Text$;
ELSE
    PRINT
    PRINT #1,
END IF

END SUB



'---------8<----[ Begin ASMPILIB.BAS ]---->8---------------

DEFINT A-Z:DIM SHARED B,K,S,B&,Z&:XA '** by PostIt! 7.0 ** BETA
SUB XA:OPEN "O",1,"ASMPI.LZH",4^6:Z&=583:?STRING$(50,177);
U"DE^P9$5XPE#%##2Y)##*+$O=C#$,dv#pslQ#ole2%kp##M$?/Hm1Y6Upn8VR]Gw
U"K9$-^[V0-2G)Itt./+bEA>p)[-_i'\S',3f)/PiIROKamsMm7e'07d-H9D-N?W(
U"_HO-K)nguj,A[KbR%!&p&(0%3WB2UnBQf>\0`OZr?!mS$M_#3L,*Dm$YOoQN?6I
U"t[W6t_^[B]4q_eBI92TDvfas8G(`Jh',(<J%cCkgg8Du%=m(lhtob.;^%i!u5-W
U"iBoDkOA$2w9Z4!.wt%!sD'j,uJ=e=v.%H?SXp4b0i(]I-,`glMP]3QH\t<Z8wtg
U"0O!+%RU^BV+R>OV,h\s/$:'OZ=YA8Tpbs-`Y#`)k]71-lrH/m&nQ0Y0N?C!5XK(
U"kwes\)l6hq3:*M;74&dlmngv]tUL>^BZrmiK;'r[pH&u?x\bKO+*fG\&kLg+j*W
U"$I^U/t+jp?tn[g&drknhRMG>s%Pk^cP0H=-Vk!`VwlS;VV$SAq&g-<ld6GgYG3W
U"[fo&%<1W;*hee(+CX3jG/N2=J7Nx\7,<H6-3nN1nRatESc.E2r&1F_86GQ#E_D(
U"5pI89rOa0^L90\<Y2<:$2Fe-.eBYZ.bqNk;<T<S9D[;^?sio0WQ146_jH7fIU^Y
U"`^]4E?WZ\U>#l0;qF1AR4&\=kUfUV^s[O'X=cSfcMQ#Lik$rEi==Up)aUfY.fC+
U"O.s77u.7YYo-,3ViRr*dqBUv'rOa^cdl'rM#"
END SUB
CLOSE:IF S=198AND B&=Z&THEN?":) Ok"ELSE?":( Bad
SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-35:B=B-1:IF C<0THEN C=29
S=(S+C)*2:IF B<0THEN B=4:K=C ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1
S=S\256+(S AND 255):NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB

'---------8<----[ Begin ASMPILIB.BAS ]---->8---------------

' ------- That's it, folks!
' I hope you enjoy it!  Please feel free to leave me a message on
' comments and suggestions.  Wow, this was fun!  Thanks!