return to main page
Return to 1401 Software Development
Return to Geek-fun,-Software

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 - then all heck broke loose and swept beyond me.

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 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 
     *                  B ADDRESS REGISTER   :-))
     *     THE ARCTAN ROUTINE IS WRITTEN AS A CRUDE SUBROUTINE.
     *
               CTL       6611  *6=16,000C;6=16,000T;1=OBJDECK;,1=MODADD
     *   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
     ATANX     B    0                  *** RETURN TO CALL
     *        
     *   
     * -------------------------------------------------------------
     *
     *  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
     PRINTX    B    0              *** RETURN TO CALL
     *
     *
     *  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