[comp.binaries.apple2] calc pi to 1000 digits

ART100@psuvm.psu.edu (Andy Tefft) (01/05/91)

This could be converted to applesoft, but that would only slow
it down. Maybe I'll work on converting it to assembly to speed
it up.

Anyway, it is integer basic (which means dos 3.3). Posted in
response to a request on comp.sys.apple2.

--- cut here ---
    0 REM  *** APPLE PI ***                 WRITTEN BY: BOB BISHOP
    1 REM  FROM MICRO NO 6 PG 15 AUG/SEPT,1978
    2 CALL -936: GOSUB 6000
    5 CALL -936: VTAB 10: TAB 5: PRINT "HOW MANY DIGITS DO YOU WANT";
    8 REM  1000 DIGITS TAKES 44 HOURS, BETTER TRY FOR 50 AT FIRST!
   10 INPUT SIZE
   15 CALL -936
   20 TEN=10: IF SIZE>200 THEN 50
   30 TEN=100:SIZE=(SIZE+1)/2
   50 POWER=4096:TERM=8192:RESULT=12288
   60 DIV=1000:ADD=2000:SUB=3000:INIT=4000:COPY=5000
   70 DIM CONSTANT(2):CONSTANT(1)=25:CONSTANT(2)=239
  100 REM   MAIN LOOP
  125 FOR PASS=1 TO 2
  150 GOSUB INIT
  200 GOSUB COPY
  210 POINT=TERM:DIVIDE=EXP: GOSUB DIV
  220 IF SIGN>0 THEN GOSUB ADD
  230 IF SIGN<0 THEN GOSUB SUB
  240 EXP=EXP+2:SIGN=-SIGN
  250 POINT=POWER:DIVIDE=CONSTANT(PASS): GOSUB DIV
  260 IF PASS=2 THEN GOSUB DIV
  270 IF ZERO<>0 THEN 200
  300 NEXT PASS
  400 REM   PRINT THE RESULT
  500 PRINT : PRINT
  510 PRINT "THE VALUE OF PI TO ";(TEN/100+1)*SIZE;" DECIMAL PLACES:": PRINT
  520 PRINT PEEK (RESULT);".";
  530 FOR PLACE=RESULT+1 TO RESULT+SIZE
  540 IF TEN=10 THEN 570
  560 IF PEEK (PLACE)<10 THEN PRINT "0";
  570 PRINT PEEK (PLACE);
  580 NEXT PLACE
  590 PRINT
  600 END
 1000 REM  DIVISION SUBROUTINE
 1010 DIGIT=0:ZERO=0
 1020 FOR PLACE=POINT TO POINT+SIZE
 1030 DIGIT=DIGIT+ PEEK (PLACE)
 1040 QUOTIENT=DIGIT/DIVIDE
 1050 RESIDUE=DIGIT MOD DIVIDE
 1055 ZERO=ZERO OR (QUOTIENT+RESIDUE)
 1060 POKE PLACE,QUOTIENT
 1070 DIGIT=TEN*RESIDUE
 1080 NEXT PLACE
 1090 RETURN
 2000 REM   ADDITION SUBROUTINE
 2010 CARRY=0
 2020 FOR PLACE=SIZE TO 0 STEP -1
 2030 SUM= PEEK (RESULT+PLACE)+ PEEK (TERM+PLACE)+CARRY
 2040 CARRY=0
 2050 IF SUM<TEN THEN 2080
 2060 SUM=SUM-TEN
 2070 CARRY=1
 2080 POKE RESULT+PLACE,SUM
 2090 NEXT PLACE
 2100 RETURN
 3000 REM   SUBTRACTION SUBROUTINE
 3010 LOAN=0
 3020 FOR PLACE=SIZE TO 0 STEP -1
 3030 DIFFERENCE= PEEK (RESULT+PLACE)- PEEK (TERM+PLACE)-LOAN
 3040 LOAN=0
 3050 IF DIFFERENCE>=0 THEN 3080
 3060 DIFFERENCE=DIFFERENCE+TEN
 3070 LOAN=1
 3080 POKE RESULT+PLACE,DIFFERENCE
 3090 NEXT PLACE
 3100 RETURN
 4000 REM    INITIALIZE REGISTERS
 4010 FOR PLACE=0 TO SIZE
 4020 POKE POWER+PLACE,0
 4030 POKE TERM+PLACE,0
 4040 IF PASS=1 THEN POKE RESULT+PLACE,0
 4050 NEXT PLACE
 4060 POKE POWER,16/PASS ^ 2
 4070 IF PASS=1 THEN DIVIDE=5
 4080 IF PASS=2 THEN DIVIDE=239
 4090 POINT=POWER: GOSUB DIV
 4100 EXP=1:SIGN=3-2*PASS
 4110 RETURN
 5000 REM  COPY "POWER INTO "TERM"
 5010 FOR PLACE=0 TO SIZE
 5020 POKE TERM+PLACE, PEEK (POWER+PLACE)
 5030 NEXT PLACE
 5035 CALL -1052
 5040 RETURN
 6000 VTAB 5: PRINT "CALC PI TO 1000 DIGETS"
 6010 PRINT : PRINT "BY BOB BISHOP FROM MICRO MAG"
 6020 PRINT "DATE: 7-79"
 6030 PRINT : PRINT : PRINT "THIS PROGRAM CAN CALC PI UP"
 6040 PRINT "TO 1000 DIGITS (THAT MANY WOULD"
 6045 PRINT "TAKE 44 HOURS"
 6050 VTAB 20: PRINT "PRESS ESC TO END"
 6060 PRINT : PRINT "<<PRESS SPACE BAR TO CONTINUE..>>"
 6070 IF PEEK (-16384)=27 THEN 7000
 6080 CALL -756: IF PEEK (-16384)<>32 THEN 6000
 6090 CALL -936: RETURN
 7000 CALL -936: END