## Pi to 5,000 places from a 16,000 character 1401

by Ed Thelen January 28, 2005
this is my first 1401 program, it ain't pretty, but it works
the language is Autocoder

A bit of background - this method of approximating Pi is from Machin, about 300 years old.

Pi = 16*arctan(1/5)-4*arctan(1/239)
His sequence converges relatively rapidly compared to older schemes, and was reasonable to use through the 1960s.

Machin's method uses the previously discovered series for arctan:

arctan(x) = x - x3/3 + x5/5 - x7/7 + ...
which is conveniently calculated in three large fields.

Note that the three 5050 character fields are really crammed into the 16,000 character maximum memory for a 1401. Index registers X2 and X3 and the card punch buffer have working storage and instructions to make room - The printer buffer is free so the program can run again after the halt :-))

The AutoCoder source code is here
The AutoCoder assembly listing is here
The "object deck", program cards to be loaded into the 1401 is here .
And the result is here. :-))

Comment by Van Snyder

 ```... I noticed that the object deck was large. This is because you used the ,C option on the DA's. If you don't strip off the clear-core cards at the front of the deck, the DA areas will be cleared. I notice that you clear them anyway at START. If you don't put the ,C option on the DA's the object deck will be much smaller. ```

```               JOB       SubRoutine  PI
* SO - WE HAVE 5,000 VALID PI CHARACTERS  :-))
* NOW LETS PRETTY IT UP A BIT, ORGANIZE SUBROUTINES
*   CALL A SUBROUTINE DEPENDS UPON
*       IF THE INDEX REGISTER OPTION IS INSTALLED,
*            ANY BRANCH LEAVES THE ADDRESS OF THE NEXT SEQUENTIAL
*                  INSTRUCTION IF THE BRANCH NOT TAKEN IN THE
*     THE ARCTAN ROUTINE IS WRITTEN AS A CRUDE SUBROUTINE.
*
*   1         2         3         4         5         6         7         8
*78901234567890123456789012345678901234567890123456789012345678901234567890
* label   | op | OPERATION                                         |xxxxxxx
ORG  87
X1        DSA  0                  index register 1
ORG  92
*    X2        DSA  0                  index register 2
*              ORG  97
*    X3        DSA  0                  index register 3
*
* start storage areas
*  small areas
*              ORG  100     * PUT SMALL STUFF IN PUNCH AREA
ITCNT     DCW  000000    * ITERATION COUNTER, STARTS AT ZERO
DIVBAS    DCW  000000   * DIVISOR FOR BASET
IX2P1     DCW  000000   * ITCNT times 2 plus 1, DIVISOR FOR INTER
C0        DCW  000000
C1        DCW  000001
C2        DCW  000002
C25       DCW  000025  * 5^2
C239P2    DCW  057121  * 239^2
CNTZRO    DCW  000000  * COUNT LEADING ZEROS, DONE YET?
CF        DCW  1         *  "1"=ADD, "0" OR OTHER = SUBTRACT
LC0L9     DCW  000000000
*
*    COMPUTE    16*ARCTAN(1/5)
START     MCW  @+@,ACCUM&5049   * ZERO ACCUMULATOR, FORCE POSITIVE
MCW  @0@,ACCUM&5048
B    START1           * SKIP PRINT AREA
ORG  335
START1    MCW  ACCUM&5048,ACCUM&5047
MCW  @0@,BASET&5048  * ZERO BASE
MCW  BASET&5048,BASET&5047
* BIG REGISTERS SET
MCW  @80@,BASET&8  * SET A HIGH ORDER TO 1*5*16
MCW  @1@,CF        * SET NEXT TO ADD
MCW  C25,DIVBAS              * SET NEXT TO ADD
B    ATAN          *** CALL ATAN SUBROUTINE
*
* NOW, ADD MINUS 4*ARCTAN(1/239) TO ABOVE  16*ARCTAN(1/5)
* DO NOT ZERO ACCUMULATOR
START2    MCW  @0@,BASET&5048  * ZERO BASE
MCW  BASET&5048,BASET&5047
MCW  @956@,BASET&8   * SET A HIGH ORDER TO 1*4*239
MCW  @0@,CF          * SET NEXT SUBTRACT
MCW  C239P2,DIVBAS   * SET SET BASE DIVISOR
B    ATAN            *** CALL ATAN SUBROUTINE
* WE NOW HAVE PI IN MEMORY, PRINT IT OUT
B    PRINT           * CALL PRINT ROUTINE
HALT      H    START           *** HALT HERE -
*
ATAN      SBR  ATANX&3         * SET RETURN
MCW  C0,CNTZRO       * CLEAR LEADING ZERO COUNTER
MCW  C0,ITCNT        * ZERO ITERATION CNTR
MCW  C1,IX2P1        * INIT INTER DIVISOR
MCW  @000@,X1        * CLEAR ASSOCIATED INDEX REGISTER
ATANL     MCW  @+@,BASET&5049  * SET POSITIVE SIGN
D    DIVBAS,BASET&6     * TRIAL ARITH
MCW  BASET&5042,BASET&5049  * SHIFT QUOTIENT
MCW  LC0L9,BASET&6      * REMOVE UNSHIFTED
MCW  BASET&5049,INTER&5049  * MOVE QUOTIENT TO NEXT
MCW  @+@,INTER&5049     * SET POSITIVE SIGN
D    IX2P1,INTER&6    DIVIDE INTERMEDIATE
MCW  INTER&5042,INTER&5049   * SHIFT INTERMEDIATE
MCW  LC0L9,INTER&6        * REMOVE UNSHIFTED
MCW  @+@,INTER&5049  * SET UP BASE
BCE  ATANA,CF,1        * COMPARE FOR ADD
ATANS     MCW  @1@,CF              * SET NEXT ADD
S    INTER&5049,ACCUM&5049   * DO THE SUBTRACTION
B    ATANW                * GO TO WRAP-UP
ATANA     A    INTER&5049,ACCUM&5049   * ADD TO ACCUMULATOR
MCW  @0@,CF              * SET NEXT SUBTRACT
ATANW     A    C1,ITCNT            * INC ITERATION COUNT
A    C2,IX2P1            * FORM NEXT DIVISOR
ATANB     BCE  ATANI,BASET&X1,0   * CHAR = 0, DONE?
B    ATANL                * GO DO ANOTHER LOOP PASS
ATANI     A    C1,CNTZRO           * INCREMENT # LEADING ZEROS
SBR  X1,1&X1             * INCREMENT X1
C    CNTZRO,@5049@         * CHECK END
BU   ATANB              * NO, CHECK MORE ZEROS
*
*
* -------------------------------------------------------------
*
*  NOW WE PRINT THAT BABY OUT :-))
* PROPOSED FORMAT
* 2
* 0        1         2         3         4         5         6         7         8
* 12345678901234567890123456789012345678901234567890123456789012345678901234567890
*                                                        3. * 10E-00000
* + NNNNNNNNNN NNNNNNNNNN NNNNNNNNNN NNNNNNNNNN NNNNNNNNNN  * 10E-00050
* + NNNNNNNNNN NNNNNNNNNN NNNNNNNNNN NNNNNNNNNN NNNNNNNNNN  * 10E-00100
PRINT     SBR  PRINTX&3
PRINTD    MCW  @008@,X1   * CLEAR PICKUP X
MCW  C0,ITCNT   * CLEAR TOTAL CH MOVED
CS   332    * start clearing down to 200, PRINT AREA
CS
MCW  @. * 10E-00000@,269
SW   265                    * SET WORD MARK IN EXPONENT FIELD
MCW  ACCUM&X1,256  MOVE 5TH FIELD
SBR  X1,10&X1     * STEP X1
W           *write the print area to the printer
*
PR1LOP    CS   252        * CLEAR PREVIOUS NUMERICS
SW   203,214    * SET WORD MARKS FOR B FIELD
SW   225,236
SW   247,265
A    @00050@,269 * ADD 50 TO EXPONENT
MCW  ACCUM&X1,212  MOVE 1ST FIELD
SBR  X1,10&X1     * STEP X1
MCW  ACCUM&X1,223  MOVE 2ND FIELD
SBR  X1,10&X1     * STEP X1
MCW  ACCUM&X1,234  MOVE 3RD FIELD
SBR  X1,10&X1     * STEP X1
MCW  ACCUM&X1,245  MOVE 4TH FIELD
SBR  X1,10&X1     * STEP X1
MCW  ACCUM&X1,256  MOVE 5TH FIELD
SBR  X1,10&X1     * STEP X1
W           *write the print area to the printer
A    @000050@,ITCNT   * ADD 50 TO TOTAL DIGITS
C    @005000@,ITCNT   * TEST FOR END
BL   PR1LOP         * END IS HIGHER THAN COUNT
*
*
*  large areas Ron Mak says that blanks process as zeros
*          ORG  780
*FLDLEN    EQU  5050      * LENGTH OF THE 3 BIG FIELDS
BASET     DA   1X5050,C  * BASE, 1ST DIVISION HERE
INTER     DA   1X5050,C  * INTERMEDIATE BUFFER, 2ND DIVISION HERE
ACCUM     DA   1X5050,C  * ACCUMULATOR, ANSWER IS FORMED HERE
*   1         2         3         4         5         6         7         8
*78901234567890123456789012345678901234567890123456789012345678901234567890
* label   | op | OPERATION                                         |xxxxxxx
*
*** Nov 15
* Machin's method -
* PI = 16arctan(1/5) - 4arctan(1/239)
* An arctan series is 1/n - 1/(3xn^3) + 1/(5xn^5) - ...
*
*** Nov 16
* In any case,
*Lets do arctan(x),  x = 1/5
*   0.19739555984988075837004976519479
*then  16ARCTAN(1/5)
*   3.1583289575980921339207962431166
* then aectan(1/239)
*   0.0041840760020747238645382149592855
* times 4
*   0.016736304008298895458152859837142
* Pi =
*    3.1415926535897932384626433832795
* :-))
*
* Set N to 1/x = 5      (this is the fancy footwork :-))
*
* 1) a) form three large as practical equal sized areas in memory.
*       lets call them "Accumulator",       ACCUM
*                      "Intermediate",      INTER
*                      "Base of next term"  BASET
*     b) form smaller working areas
*          iteration counter ITCNT    used for observation
*                  starts at zero, counts up after a pass
*          divisor of BASET, DIVBAS,   usually 5^2 or 239^2
*                  5^2 = 25,   239^2 = 57121
*          add/subtract control flag, CF , toggled after a pass
*                0 means add, other is subtract
*          divisor of INTER is IX2P1 , ITCNT times 2 plus 1
*
* 2) figure where the decimal point will be
*     (same relative place in each area)
*     ( several characters or words to the "right" of
*       the top significance.)
*
* 3) a) zero the  ACCUM
*     b) ( INTER does not need initialization)
*    c) set X (5.0 in our example) into BASET
*    d) set counter N to 1
*
* 4) While BASET is non-zero
*    a) Divide BASET by X^2  ( 25 in our example ) giving BASET
*    b) Divide BASET by (2xN - 1) giving INTER
*    c) If N is odd, add Intermediate to Accumulator
*           else, subtract Intermediate from Accumulator
*    d) Add 1 to N (assure that machine can divide by 2N)
*
* 5) Accumulator is a fine approximation of arctan(x)   ;-))
END  START  * LAST CARD IN DECK, TRANSFER ADDRESS

```

And the result (simulation running time about 7 seconds on a fast PC)
```                                               000000003. * 10E-00000
1415926535 8979323846 2643383279 5028841971 6939937510. * 10E-00050
5820974944 5923078164 0628620899 8628034825 3421170679. * 10E-00100
8214808651 3282306647 0938446095 5058223172 5359408128. * 10E-00150
4811174502 8410270193 8521105559 6446229489 5493038196. * 10E-00200
4428810975 6659334461 2847564823 3786783165 2712019091. * 10E-00250
4564856692 3460348610 4543266482 1339360726 0249141273. * 10E-00300
7245870066 0631558817 4881520920 9628292540 9171536436. * 10E-00350
7892590360 0113305305 4882046652 1384146951 9415116094. * 10E-00400
3305727036 5759591953 0921861173 8193261179 3105118548. * 10E-00450
0744623799 6274956735 1885752724 8912279381 8301194912. * 10E-00500
9833673362 4406566430 8602139494 6395224737 1907021798. * 10E-00550
6094370277 0539217176 2931767523 8467481846 7669405132. * 10E-00600
0005681271 4526356082 7785771342 7577896091 7363717872. * 10E-00650
1468440901 2249534301 4654958537 1050792279 6892589235. * 10E-00700
4201995611 2129021960 8640344181 5981362977 4771309960. * 10E-00750
5187072113 4999999837 2978049951 0597317328 1609631859. * 10E-00800
5024459455 3469083026 4252230825 3344685035 2619311881. * 10E-00850
7101000313 7838752886 5875332083 8142061717 7669147303. * 10E-00900
5982534904 2875546873 1159562863 8823537875 9375195778. * 10E-00950
1857780532 1712268066 1300192787 6611195909 2164201989. * 10E-01000
3809525720 1065485863 2788659361 5338182796 8230301952. * 10E-01050
0353018529 6899577362 2599413891 2497217752 8347913151. * 10E-01100
5574857242 4541506959 5082953311 6861727855 8890750983. * 10E-01150
8175463746 4939319255 0604009277 0167113900 9848824012. * 10E-01200
8583616035 6370766010 4710181942 9555961989 4676783744. * 10E-01250
9448255379 7747268471 0404753464 6208046684 2590694912. * 10E-01300
9331367702 8989152104 7521620569 6602405803 8150193511. * 10E-01350
2533824300 3558764024 7496473263 9141992726 0426992279. * 10E-01400
6782354781 6360093417 2164121992 4586315030 2861829745. * 10E-01450
5570674983 8505494588 5869269956 9092721079 7509302955. * 10E-01500
3211653449 8720275596 0236480665 4991198818 3479775356. * 10E-01550
6369807426 5425278625 5181841757 4672890977 7727938000. * 10E-01600
8164706001 6145249192 1732172147 7235014144 1973568548. * 10E-01650
1613611573 5255213347 5741849468 4385233239 0739414333. * 10E-01700
4547762416 8625189835 6948556209 9219222184 2725502542. * 10E-01750
5688767179 0494601653 4668049886 2723279178 6085784383. * 10E-01800
8279679766 8145410095 3883786360 9506800642 2512520511. * 10E-01850
7392984896 0841284886 2694560424 1965285022 2106611863. * 10E-01900
0674427862 2039194945 0471237137 8696095636 4371917287. * 10E-01950
4677646575 7396241389 0865832645 9958133904 7802759009. * 10E-02000
9465764078 9512694683 9835259570 9825822620 5224894077. * 10E-02050
2671947826 8482601476 9909026401 3639443745 5305068203. * 10E-02100
4962524517 4939965143 1429809190 6592509372 2169646151. * 10E-02150
5709858387 4105978859 5977297549 8930161753 9284681382. * 10E-02200
6868386894 2774155991 8559252459 5395943104 9972524680. * 10E-02250
8459872736 4469584865 3836736222 6260991246 0805124388. * 10E-02300
4390451244 1365497627 8079771569 1435997700 1296160894. * 10E-02350
4169486855 5848406353 4220722258 2848864815 8456028506. * 10E-02400
0168427394 5226746767 8895252138 5225499546 6672782398. * 10E-02450
6456596116 3548862305 7745649803 5593634568 1743241125. * 10E-02500
1507606947 9451096596 0940252288 7971089314 5669136867. * 10E-02550
2287489405 6010150330 8617928680 9208747609 1782493858. * 10E-02600
9009714909 6759852613 6554978189 3129784821 6829989487. * 10E-02650
2265880485 7564014270 4775551323 7964145152 3746234364. * 10E-02700
5428584447 9526586782 1051141354 7357395231 1342716610. * 10E-02750
2135969536 2314429524 8493718711 0145765403 5902799344. * 10E-02800
0374200731 0578539062 1983874478 0847848968 3321445713. * 10E-02850
8687519435 0643021845 3191048481 0053706146 8067491927. * 10E-02900
8191197939 9520614196 6342875444 0643745123 7181921799. * 10E-02950
9839101591 9561814675 1426912397 4894090718 6494231961. * 10E-03000
5679452080 9514655022 5231603881 9301420937 6213785595. * 10E-03050
6638937787 0830390697 9207734672 2182562599 6615014215. * 10E-03100
0306803844 7734549202 6054146659 2520149744 2850732518. * 10E-03150
6660021324 3408819071 0486331734 6496514539 0579626856. * 10E-03200
1005508106 6587969981 6357473638 4052571459 1028970641. * 10E-03250
4011097120 6280439039 7595156771 5770042033 7869936007. * 10E-03300
2305587631 7635942187 3125147120 5329281918 2618612586. * 10E-03350
7321579198 4148488291 6447060957 5270695722 0917567116. * 10E-03400
7229109816 9091528017 3506712748 5832228718 3520935396. * 10E-03450
5725121083 5791513698 8209144421 0067510334 6711031412. * 10E-03500
6711136990 8658516398 3150197016 5151168517 1437657618. * 10E-03550
3515565088 4909989859 9823873455 2833163550 7647918535. * 10E-03600
8932261854 8963213293 3089857064 2046752590 7091548141. * 10E-03650
6549859461 6371802709 8199430992 4488957571 2828905923. * 10E-03700
2332609729 9712084433 5732654893 8239119325 9746366730. * 10E-03750
5836041428 1388303203 8249037589 8524374417 0291327656. * 10E-03800
1809377344 4030707469 2112019130 2033038019 7621101100. * 10E-03850
4492932151 6084244485 9637669838 9522868478 3123552658. * 10E-03900
2131449576 8572624334 4189303968 6426243410 7732269780. * 10E-03950
2807318915 4411010446 8232527162 0105265227 2111660396. * 10E-04000
6655730925 4711055785 3763466820 6531098965 2691862056. * 10E-04050
4769312570 5863566201 8558100729 3606598764 8611791045. * 10E-04100
3348850346 1136576867 5324944166 8039626579 7877185560. * 10E-04150
8455296541 2665408530 6143444318 5867697514 5661406800. * 10E-04200
7002378776 5913440171 2749470420 5622305389 9456131407. * 10E-04250
1127000407 8547332699 3908145466 4645880797 2708266830. * 10E-04300
6343285878 5698305235 8089330657 5740679545 7163775254. * 10E-04350
2021149557 6158140025 0126228594 1302164715 5097925923. * 10E-04400
0990796547 3761255176 5675135751 7829666454 7791745011. * 10E-04450
2996148903 0463994713 2962107340 4375189573 5961458901. * 10E-04500
9389713111 7904297828 5647503203 1986915140 2870808599. * 10E-04550
0480109412 1472213179 4764777262 2414254854 5403321571. * 10E-04600
8530614228 8137585043 0633217518 2979866223 7172159160. * 10E-04650
7716692547 4873898665 4949450114 6540628433 6639379003. * 10E-04700
9769265672 1463853067 3609657120 9180763832 7166416274. * 10E-04750
8888007869 2560290228 4721040317 2118608204 1900042296. * 10E-04800
6171196377 9213375751 1495950156 6049631862 9472654736. * 10E-04850
4252308177 0367515906 7350235072 8354056704 0386743513. * 10E-04900
6222247715 8915049530 9844489333 0963408780 7693259939. * 10E-04950
7805419341 4473774418 4263129860 8099888687 4132604721. * 10E-05000
```