Skip to content

Instantly share code, notes, and snippets.

@scruss scruss/Classic2
Last active Jul 21, 2019

Embed
What would you like to do?
ejolson's classic basic big fibonacci modded for RISC OS BBC BASIC
10ON ERROR PRINT "LINE : " + STR$(ERL) + " ERROR : " + REPORT$ : END
100REM CLASSIC.BAS -- COMPUTE THE NTH FIBONACCI NUMBER
110REM WRITTEN DECEMBER 25, 2018 BY ERIC OLSON
120REM
130REM THIS PROGRAM DEMONSTRATES THE EXPRESSIVENESS OF THE ORIGINAL
140REM VERSIONS OF MICROSOFT BASIC AS MEASURED BY EXPLICITLY CODING
150REM KARATSUBA MULTIPLICATION FOR BIG-NUMBER ARITHMETIC AND THEN
160REM USING THE DOUBLING FORMULA
170REM
180REM F(2K) = F(K)[2F(K+1)-F(K)]
190REM F(2K+1) = F(K+1)[2F(K+1)-F(K)]+(-1)^(K+1)
200REM F(2K+1) = F(K)[2F(K)+F(K+1)]+(-1)^(K)
210REM F(2K+2) = F(K+1)[2F(K)+F(K+1)]
220REM
230REM TO COMPUTE THE NTH FIBONACCI NUMBER.
231REM
232REM VERSION 2: MINOR CHANGES TO OPTIMIZE THE O(N^2) MULTIPLY AND
233REM PREVENT OVERFLOW WHEN RUNNING ON MITS BASIC.
235REM
236REM TO RUN THIS PROGRAM ON EARLY VERSIONS OF MICROSOFT BASIC PLEASE
237REM REMOVE LINE 241 TO SET THE DEFAULT BACK TO SINGLE PRECISION
238REM AND CHANGE N SO THE RESULTING FIBONACCI NUMBER FITS IN MEMORY.
240REM
242Q1=0:Q2=0
250N=4784969
251REM *SPOOL BigFiboOut
252GOSUB 8500
260PRINT "Fibo(";N;") at "; TIME$
270D9=INT(N*LN((1+SQR(5))/2)/LN(B8)+7):M9=14
280DIM M(D9*M9)
290M0=1:REM INPUT "? " N:IF N=0 THEN *SPOOL : STOP
292T0=TIME
300A=M0:M0=M0+1+D9:B=M0:M0=M0+1+D9
310T1=M0:M0=M0+1+D9:T2=M0:M0=M0+1+D9
400R0=N:GOSUB 1000
420R7=B:GOSUB 7000
425PRINT "Elapsed: "; (TIME-T0)/100: PRINT TIME$: PRINT
430 STOP
1000REM COMPUTE NTH FIBONACCI NUMBER
1010REM INPUTS: R0 THE VALUE OF N
1020REM OUTPUTS: B THE VALUE OF F(N)
1040IF R0<2 THEN M(B)=1:M(B+1)=R0:RETURN
1060N1=R0:R0=INT((N1-1)/2):GOSUB 1500
1070P1=N1-4*INT(N1/4)
1080IF P1=1 OR P1=3 THEN 1200
1090R1=T1:R2=A:R3=A:GOSUB 2000
1110R1=T2:R2=T1:R3=B:GOSUB 2000
1120R1=T1:R2=B:R3=T2:GOSUB 4000
1170R1=B:R2=T1:GOSUB 5000:RETURN
1200R1=T1:R2=B:R3=B:GOSUB 2000
1210R1=T2:R2=T1:R3=A:GOSUB 3000
1220R1=T1:R2=B:R3=T2:GOSUB 4000
1230IF P1=3 THEN 1250
1240R1=T1:GOSUB 6000:GOTO 1260
1250R1=T1:GOSUB 6500
1260R1=B:R2=T1:GOSUB 5000:RETURN
1500REM RECURSIVE WORK FOR NTH FIBONACCI NUMBER
1510REM INPUTS: R0 THE VALUE OF N
1520REM OUTPUTS: A THE VALUE OF F(N)
1530REM OUTPUTS: B THE VALUE OF F(N+1)
1540IF R0=0 THEN M(A)=1:M(A+1)=0:M(B)=1:M(B+1)=1:RETURN
1600M(M0)=R0:M0=M0+1:R0=INT(R0/2):GOSUB 1500
1610M0=M0-1:R0=M(M0)
1620P1=R0-4*INT(R0/4)
1630IF P1=1 OR P1=3 THEN 1720
1640R1=T1:R2=B:R3=B:GOSUB 2000
1650R1=T2:R2=T1:R3=A:GOSUB 3000
1660R1=T1:R2=A:R3=T2:GOSUB 4000
1670R1=A:R2=T1:GOSUB 5000
1680R1=T1:R2=B:R3=T2:GOSUB 4000
1690IF P1=2 THEN 1710
1700R1=T1:GOSUB 6000:GOTO 1711
1710R1=T1:GOSUB 6500
1711R1=B:R2=T1:GOSUB 5000:RETURN
1720R1=T1:R2=A:R3=A:GOSUB 2000
1730R1=T2:R2=T1:R3=B:GOSUB 2000
1740R1=T1:R2=B:R3=T2:GOSUB 4000
1750R1=B:R2=T1:GOSUB 5000
1760R1=T1:R2=A:R3=T2:GOSUB 4000
1770IF P1=3 THEN 1790
1780R1=T1:GOSUB 6500:GOTO 1800
1790R1=T1:GOSUB 6000
1800R1=A:R2=T1:GOSUB 5000:RETURN
2000REM BIG-NUMBER ADDITION
2010REM OUTPUTS: R1 THE VALUE OF A+B
2020REM INPUTS: R2 THE VALUE OF A
2030REM INPUTS: R3 THE VALUE OF B
2050IF M(R3)>M(R2) THEN I9=M(R3) ELSE I9=M(R2)
2060FOR I=1 TO I9+1:M(R1+I)=0:NEXT I
2070FOR I=1 TO I9:C=0:T=M(R1+I)
2080IF I<=M(R2) THEN T=T+M(R2+I)
2090IF I<=M(R3) THEN T=T+M(R3+I)
2110IF T>=B8 THEN C=1:T=T-B8
2120M(R1+I)=T:M(R1+I+1)=M(R1+I+1)+C:NEXT I
2130M(R1)=I9+1
2140R4=R1:GOSUB 7500
2150RETURN
3000REM BIG-NUMBER SUBTRACTION
3010REM OUTPUTS: R1 THE VALUE OF A-B
3020REM INPUTS: R2 THE VALUE OF A
3030REM INPUTS: R3 THE VALUE OF B
3050FOR I=1 TO M(R2):M(R1+I)=0:NEXT I
3060FOR I=1 TO M(R3):T=M(R1+I)+M(R2+I)-M(R3+I)
3070IF T<0 THEN T=T+B8:M(R1+I+1)=M(R1+I+1)-1
3080M(R1+I)=T:NEXT I
3090FOR I=M(R3)+1 TO M(R2):T=M(R1+I)+M(R2+I)
3100IF T<0 THEN T=T+B8:M(R1+I+1)=M(R1+I+1)-1
3110M(R1+I)=T:NEXT I
3120M(R1)=M(R2)
3130R4=R1:GOSUB 7500
3150RETURN
4000REM BIG-NUMBER MULTIPLICATION
4010REM OUTPUTS: R1 THE VALUE OF A*B
4020REM INPUTS: R2 THE VALUE OF A
4030REM INPUTS: R3 THE VALUE OF B
4040IF M(R2)>80 AND M(R3)>80 THEN 4300
4050I9=M(R2)+M(R3):FOR I=1 TO I9:M(R1+I)=0:NEXT I
4070FOR I=1 TO M(R2):FOR J=1 TO M(R3)
4080T=M(R1+I+J-1)+M(R2+I)*M(R3+J)
4090IF T<B7 THEN 4120
4100M(R1+I+J-1)=T-B7
4110M(R1+I+J)=M(R1+I+J)+B6:GOTO 4130
4120M(R1+I+J-1)=T
4130NEXT J:NEXT I
4140C=0:FOR I=1 TO I9:T=M(R1+I)+C
4150IF T<B8 THEN C=0:GOTO 4170
4160C=INT(T/B8):T=T-B8*C
4170M(R1+I)=T:NEXT I
4180M(R1)=I9
4190R4=R1:GOSUB 7500
4230RETURN
4300REM BIG-NUMBER KARATSUBA ALGORITHM
4310IF M(R2)<M(R3) THEN I8=M(R3) ELSE I8=M(R2)
4320I8=INT(I8/2)
4330Z0=M0:M0=M0+1+2*I8+1
4332Z2=M0:M0=M0+1+2*I8+3
4334Z1=M0:M0=M0+1+2*I8+5
4340Z3=M0:M0=M0+1+I8+2
4350Z4=M0:M0=M0+1+I8+2
4360R5=Z4:R6=R3:GOSUB 4500
4370R5=Z3:R6=R2:GOSUB 4500
4380GOSUB 4600:R1=Z1:R2=Z3:R3=Z4:GOSUB 4000:GOSUB 4700
4400Q1=M(R2):IF I8<Q1 THEN M(R2)=I8
4405Q2=M(R3):IF I8<Q2 THEN M(R3)=I8
4410GOSUB 4600:R1=Z0:GOSUB 4000:GOSUB 4700
4420M(R2)=Q1:M(R3)=Q2
4430Q3=Q1-I8:Q4=Q2-I8:IF Q3<0 OR Q4<0 THEN M(Z2)=0:GOTO 8000
4440Q1=M(R2+I8):M(R2+I8)=Q3:Q2=M(R3+I8):M(R3+I8)=Q4
4450GOSUB 4600:R1=Z2:R2=R2+I8:R3=R3+I8:GOSUB 4000:GOSUB 4700
4460M(R2+I8)=Q1:M(R3+I8)=Q2
4470GOTO 8000
4500REM ADD HIGH TO LOW
4510REM OUTPUTS: R5 THE SUM OF HIGH(A)+LOW(A)
4520REM INPUTS: R6 THE VALUE OF A
4530REM INPUTS: I8 THE SPLIT POINT
4540C=0:FOR I=1 TO I8+1:T=C
4545IF I<=I8 AND I<=M(R6) THEN T=T+M(R6+I)
4550IF I+I8<=M(R6) THEN T=T+M(R6+I+I8)
4560IF T>=B8 THEN C=1:T=T-B8 ELSE C=0
4570M(R5+I)=T:NEXT I:M(R5+I8+2)=C
4590M(R5)=I8+2:R4=R5:GOSUB 7500
4595RETURN
4600REM SAVE FRAME
4610M(M0)=Z1:M0=M0+1:M(M0)=Z2:M0=M0+1:M(M0)=Z0:M0=M0+1
4620M(M0)=I8:M0=M0+1:M(M0)=Q1:M0=M0+1:M(M0)=Q2:M0=M0+1
4630REM SAVE PARAMETERS
4640M(M0)=R1:M0=M0+1:M(M0)=R2:M0=M0+1:M(M0)=R3:M0=M0+1
4650RETURN
4700REM RESTORE FRAME
4710GOSUB 4750
4720M0=M0-1:Q2=M(M0):M0=M0-1:Q1=M(M0):M0=M0-1:I8=M(M0)
4730M0=M0-1:Z0=M(M0):M0=M0-1:Z2=M(M0):M0=M0-1:Z1=M(M0)
4740RETURN
4750REM RESTORE PARAMETERS
4760M0=M0-1:R3=M(M0):M0=M0-1:R2=M(M0):M0=M0-1:R1=M(M0)
4770RETURN
5000REM BIG-NUMBER COPY
5010REM OUTPUTS: R1 THE VALUE OF A
5020REM INPUTS: R2 THE VALUE OF A
5030R4=R2:GOSUB 7500
5040FOR I=1 TO M(R2):M(R1+I)=M(R2+I):NEXT I
5050FOR I=M(R2)+1 TO M(R1):M(R1+I)=0:NEXT I
5060M(R1)=M(R2)
5070RETURN
6000REM BIG-NUMBER DECREMENT
6010REM INPUTS: R1 THE VALUE OF A
6020REM OUTPUTS: R1 THE VALUE OF A-1
6040I=1:C=1
6050IF C=0 THEN 6080
6060IF M(R1+I)<1 THEN M(R1+I)=B8-1 ELSE M(R1+I)=M(R1+I)-1:C=0
6070I=I+1:GOTO 6050
6080R4=R1:GOSUB 7500
6100RETURN
6500REM BIG-NUMBER INCREMENT
6510REM INPUTS: R1 THE VALUE OF A
6520REM OUTPUTS: R1 THE VALUE OF A+1
6540M(R1)=M(R1)+1:M(R1+M(R1))=0:I=1:C=1
6550IF C=0 THEN 6590
6560T=M(R1+I)+1
6570IF T>=B8 THEN M(R1+I)=T-B8 ELSE M(R1+I)=T:C=0
6580I=I+1:GOTO 6550
6590R4=R1:GOSUB 7500
6600RETURN
7000REM BIG-NUMBER PRINT
7010REM INPUTS: R7 THE VALUE TO PRINT
7020IF M(R7)=0 THEN PRINT "0":RETURN
7030FOR I=M(R7) TO 1 STEP -1
7040S$=STR$(M(R7+I))
7045IF MID$(S$,1,1)=" " THEN S$=MID$(S$,2,LEN(S$)-1)
7050IF I=M(R7) OR B9<=LEN(S$) THEN 7070
7060S$=MID$("0000000000000",1,B9-LEN(S$))+S$
7070PRINT S$;:NEXT I:PRINT:RETURN
7500REM BIG-NUMBER TRIM
7510REM INPUTS: R4 THE VALUE OF A
7520REM OUTPUTS: R4 THE TRIMMED VALUE OF A
7530IF M(R4+M(R4))=0 AND M(R4)>1 THEN M(R4)=M(R4)-1:GOTO 7530
7540RETURN
8000REM TAIL OF KARATSUBA
8003T4=M0-1-2*I8-5
8005GOSUB 4630:R1=T4:R2=Z1:R3=Z0:GOSUB 3000
8010R1=Z1:R2=T4:R3=Z2:GOSUB 3000:GOSUB 4750
8020R4=Z1:GOSUB 7500
8030I9=M(R2)+M(R3):I7=2*I8:C=0:FOR I=1 TO I9:T=C
8040IF I<=M(Z0) THEN T=T+M(Z0+I)
8050IF I>I8 AND I-I8<=M(Z1) THEN T=T+M(Z1+I-I8)
8060IF I>I7 AND I-I7<=M(Z2) THEN T=T+M(Z2+I-I7)
8070IF T<B8 THEN C=0:GOTO 8090
8080C=INT(T/B8):T=T-B8*C
8090M(R1+I)=T:NEXT I
8092M(R1)=I9:R4=R1:GOSUB 7500
8100M0=Z0
8120RETURN
8500REM GET DYNAMIC RANGE
8510REM OUTPUTS: F0 THE LARGEST INTEGER
8511REM OUTPUTS: B7 CARRY THRESHOLD
8512REM OUTPUTS: B8 RADIX OF LIMBS
8513REM OUTPUTS: B9 EXPONENT TO B8=10^B9
8520F0=&7FFFFFFF:F0=INT(F0/2):GOTO 8610:REM F9=1
8530F7=F9+1:IF F7>F9 THEN F9=F9*2:GOTO 8530
8540F0=F9
8550F7=F0+1:IF F7=F0 THEN F0=INT(F0/2):GOTO 8550
8560F4=0
8565F5=INT(0.5*(F0+F9)+0.5)
8570F7=F5+1:IF F7=F5 THEN F9=F5 ELSE F0=F5
8580IF F5=F4 THEN 8600
8590F4=F5:GOTO 8565
8600REM F0=F0/2
8610B9=INT(LN(SQR(F0))/LN(10))
8620B8=INT(EXP(LN(10)*B9)+0.5)
8630B7=F0-2*B8^2:IF B7/B8^2<4 THEN B9=B9-1:GOTO 8620
8640B6=INT(B7/B8):B7=B8*B6
8650PRINT "** Dynamic Range - F0: "; F0; " B7: "; B7; " B8: "; B8:PRINT
8700RETURN
9999END
10ON ERROR PRINT "LINE : " + STR$(ERL) + " ERROR : " + REPORT$ : END
100REM CLASSIC.BAS -- COMPUTE THE NTH FIBONACCI NUMBER
110REM WRITTEN DECEMBER 25, 2018 BY ERIC OLSON
120REM
130REM THIS PROGRAM DEMONSTRATES THE EXPRESSIVENESS OF THE ORIGINAL
140REM VERSIONS OF MICROSOFT BASIC AS MEASURED BY EXPLICITLY CODING
150REM KARATSUBA MULTIPLICATION FOR BIG-NUMBER ARITHMETIC AND THEN
160REM USING THE DOUBLING FORMULA
170REM
180REM F(2K) = F(K)[2F(K+1)-F(K)]
190REM F(2K+1) = F(K+1)[2F(K+1)-F(K)]+(-1)^(K+1)
200REM F(2K+1) = F(K)[2F(K)+F(K+1)]+(-1)^(K)
210REM F(2K+2) = F(K+1)[2F(K)+F(K+1)]
220REM
230REM TO COMPUTE THE NTH FIBONACCI NUMBER.
231REM
232REM VERSION 2: MINOR CHANGES TO OPTIMIZE THE O(N^2) MULTIPLY AND
233REM PREVENT OVERFLOW WHEN RUNNING ON MITS BASIC.
235REM
236REM TO RUN THIS PROGRAM ON EARLY VERSIONS OF MICROSOFT BASIC PLEASE
237REM REMOVE LINE 241 TO SET THE DEFAULT BACK TO SINGLE PRECISION
238REM AND CHANGE N SO THE RESULTING FIBONACCI NUMBER FITS IN MEMORY.
240REM
242Q1=0:Q2=0
250N=4784969
251REM *SPOOL BigFiboOut
252GOSUB 8500
260PRINT "Fibo(";N;") at "; TIME$
270D9=INT(N*LN((1+SQR(5))/2)/LN(B8)+7):M9=14
280DIM M(D9*M9)
290M0=1:REM INPUT "? " N:IF N=0 THEN *SPOOL : STOP
292T0=TIME
300A=M0:M0=M0+1+D9:B=M0:M0=M0+1+D9
310T1=M0:M0=M0+1+D9:T2=M0:M0=M0+1+D9
400R0=N:GOSUB 1000
420R7=B:GOSUB 7000
425PRINT "Elapsed: "; (TIME-T0)/100: PRINT TIME$: PRINT
430 STOP
1000REM COMPUTE NTH FIBONACCI NUMBER
1010REM INPUTS: R0 THE VALUE OF N
1020REM OUTPUTS: B THE VALUE OF F(N)
1040IF R0<2 THEN M(B)=1:M(B+1)=R0:RETURN
1060N1=R0:R0=INT((N1-1)/2):GOSUB 1500
1070P1=N1-4*INT(N1/4)
1080IF P1=1 OR P1=3 THEN 1200
1090R1=T1:R2=A:R3=A:GOSUB 2000
1110R1=T2:R2=T1:R3=B:GOSUB 2000
1120R1=T1:R2=B:R3=T2:GOSUB 4000
1170R1=B:R2=T1:GOSUB 5000:RETURN
1200R1=T1:R2=B:R3=B:GOSUB 2000
1210R1=T2:R2=T1:R3=A:GOSUB 3000
1220R1=T1:R2=B:R3=T2:GOSUB 4000
1230IF P1=3 THEN 1250
1240R1=T1:GOSUB 6000:GOTO 1260
1250R1=T1:GOSUB 6500
1260R1=B:R2=T1:GOSUB 5000:RETURN
1500REM RECURSIVE WORK FOR NTH FIBONACCI NUMBER
1510REM INPUTS: R0 THE VALUE OF N
1520REM OUTPUTS: A THE VALUE OF F(N)
1530REM OUTPUTS: B THE VALUE OF F(N+1)
1540IF R0=0 THEN M(A)=1:M(A+1)=0:M(B)=1:M(B+1)=1:RETURN
1600M(M0)=R0:M0=M0+1:R0=INT(R0/2):GOSUB 1500
1610M0=M0-1:R0=M(M0)
1620P1=R0-4*INT(R0/4)
1630IF P1=1 OR P1=3 THEN 1720
1640R1=T1:R2=B:R3=B:GOSUB 2000
1650R1=T2:R2=T1:R3=A:GOSUB 3000
1660R1=T1:R2=A:R3=T2:GOSUB 4000
1670R1=A:R2=T1:GOSUB 5000
1680R1=T1:R2=B:R3=T2:GOSUB 4000
1690IF P1=2 THEN 1710
1700R1=T1:GOSUB 6000:GOTO 1711
1710R1=T1:GOSUB 6500
1711R1=B:R2=T1:GOSUB 5000:RETURN
1720R1=T1:R2=A:R3=A:GOSUB 2000
1730R1=T2:R2=T1:R3=B:GOSUB 2000
1740R1=T1:R2=B:R3=T2:GOSUB 4000
1750R1=B:R2=T1:GOSUB 5000
1760R1=T1:R2=A:R3=T2:GOSUB 4000
1770IF P1=3 THEN 1790
1780R1=T1:GOSUB 6500:GOTO 1800
1790R1=T1:GOSUB 6000
1800R1=A:R2=T1:GOSUB 5000:RETURN
2000REM BIG-NUMBER ADDITION
2010REM OUTPUTS: R1 THE VALUE OF A+B
2020REM INPUTS: R2 THE VALUE OF A
2030REM INPUTS: R3 THE VALUE OF B
2050IF M(R3)>M(R2) THEN I9=M(R3) ELSE I9=M(R2)
2060FOR I=1 TO I9+1:M(R1+I)=0:NEXT I
2070FOR I=1 TO I9:C=0:T=M(R1+I)
2080IF I<=M(R2) THEN T=T+M(R2+I)
2090IF I<=M(R3) THEN T=T+M(R3+I)
2110IF T>=B8 THEN C=1:T=T-B8
2120M(R1+I)=T:M(R1+I+1)=M(R1+I+1)+C:NEXT I
2130M(R1)=I9+1
2140R4=R1:GOSUB 7500
2150RETURN
3000REM BIG-NUMBER SUBTRACTION
3010REM OUTPUTS: R1 THE VALUE OF A-B
3020REM INPUTS: R2 THE VALUE OF A
3030REM INPUTS: R3 THE VALUE OF B
3050FOR I=1 TO M(R2):M(R1+I)=0:NEXT I
3060FOR I=1 TO M(R3):T=M(R1+I)+M(R2+I)-M(R3+I)
3070IF T<0 THEN T=T+B8:M(R1+I+1)=M(R1+I+1)-1
3080M(R1+I)=T:NEXT I
3090FOR I=M(R3)+1 TO M(R2):T=M(R1+I)+M(R2+I)
3100IF T<0 THEN T=T+B8:M(R1+I+1)=M(R1+I+1)-1
3110M(R1+I)=T:NEXT I
3120M(R1)=M(R2)
3130R4=R1:GOSUB 7500
3150RETURN
4000REM BIG-NUMBER MULTIPLICATION
4010REM OUTPUTS: R1 THE VALUE OF A*B
4020REM INPUTS: R2 THE VALUE OF A
4030REM INPUTS: R3 THE VALUE OF B
4040IF M(R2)>80 AND M(R3)>80 THEN 4300
4050I9=M(R2)+M(R3):FOR I=1 TO I9:M(R1+I)=0:NEXT I
4070FOR I=1 TO M(R2):FOR J=1 TO M(R3)
4080T=M(R1+I+J-1)+M(R2+I)*M(R3+J)
4090IF T<B7 THEN 4120
4100M(R1+I+J-1)=T-B7
4110M(R1+I+J)=M(R1+I+J)+B6:GOTO 4130
4120M(R1+I+J-1)=T
4130NEXT J:NEXT I
4140C=0:FOR I=1 TO I9:T=M(R1+I)+C
4150IF T<B8 THEN C=0:GOTO 4170
4160C=INT(T/B8):T=T-B8*C
4170M(R1+I)=T:NEXT I
4180M(R1)=I9
4190R4=R1:GOSUB 7500
4230RETURN
4300REM BIG-NUMBER KARATSUBA ALGORITHM
4310IF M(R2)<M(R3) THEN I8=M(R3) ELSE I8=M(R2)
4320I8=INT(I8/2)
4330Z0=M0:M0=M0+1+2*I8+1
4332Z2=M0:M0=M0+1+2*I8+3
4334Z1=M0:M0=M0+1+2*I8+5
4340Z3=M0:M0=M0+1+I8+2
4350Z4=M0:M0=M0+1+I8+2
4360R5=Z4:R6=R3:GOSUB 4500
4370R5=Z3:R6=R2:GOSUB 4500
4380GOSUB 4600:R1=Z1:R2=Z3:R3=Z4:GOSUB 4000:GOSUB 4700
4400Q1=M(R2):IF I8<Q1 THEN M(R2)=I8
4405Q2=M(R3):IF I8<Q2 THEN M(R3)=I8
4410GOSUB 4600:R1=Z0:GOSUB 4000:GOSUB 4700
4420M(R2)=Q1:M(R3)=Q2
4430Q3=Q1-I8:Q4=Q2-I8:IF Q3<0 OR Q4<0 THEN M(Z2)=0:GOTO 8000
4440Q1=M(R2+I8):M(R2+I8)=Q3:Q2=M(R3+I8):M(R3+I8)=Q4
4450GOSUB 4600:R1=Z2:R2=R2+I8:R3=R3+I8:GOSUB 4000:GOSUB 4700
4460M(R2+I8)=Q1:M(R3+I8)=Q2
4470GOTO 8000
4500REM ADD HIGH TO LOW
4510REM OUTPUTS: R5 THE SUM OF HIGH(A)+LOW(A)
4520REM INPUTS: R6 THE VALUE OF A
4530REM INPUTS: I8 THE SPLIT POINT
4540C=0:FOR I=1 TO I8+1:T=C
4545IF I<=I8 AND I<=M(R6) THEN T=T+M(R6+I)
4550IF I+I8<=M(R6) THEN T=T+M(R6+I+I8)
4560IF T>=B8 THEN C=1:T=T-B8 ELSE C=0
4570M(R5+I)=T:NEXT I:M(R5+I8+2)=C
4590M(R5)=I8+2:R4=R5:GOSUB 7500
4595RETURN
4600REM SAVE FRAME
4610M(M0)=Z1:M0=M0+1:M(M0)=Z2:M0=M0+1:M(M0)=Z0:M0=M0+1
4620M(M0)=I8:M0=M0+1:M(M0)=Q1:M0=M0+1:M(M0)=Q2:M0=M0+1
4630REM SAVE PARAMETERS
4640M(M0)=R1:M0=M0+1:M(M0)=R2:M0=M0+1:M(M0)=R3:M0=M0+1
4650RETURN
4700REM RESTORE FRAME
4710GOSUB 4750
4720M0=M0-1:Q2=M(M0):M0=M0-1:Q1=M(M0):M0=M0-1:I8=M(M0)
4730M0=M0-1:Z0=M(M0):M0=M0-1:Z2=M(M0):M0=M0-1:Z1=M(M0)
4740RETURN
4750REM RESTORE PARAMETERS
4760M0=M0-1:R3=M(M0):M0=M0-1:R2=M(M0):M0=M0-1:R1=M(M0)
4770RETURN
5000REM BIG-NUMBER COPY
5010REM OUTPUTS: R1 THE VALUE OF A
5020REM INPUTS: R2 THE VALUE OF A
5030R4=R2:GOSUB 7500
5040FOR I=1 TO M(R2):M(R1+I)=M(R2+I):NEXT I
5050FOR I=M(R2)+1 TO M(R1):M(R1+I)=0:NEXT I
5060M(R1)=M(R2)
5070RETURN
6000REM BIG-NUMBER DECREMENT
6010REM INPUTS: R1 THE VALUE OF A
6020REM OUTPUTS: R1 THE VALUE OF A-1
6040I=1:C=1
6050IF C=0 THEN 6080
6060IF M(R1+I)<1 THEN M(R1+I)=B8-1 ELSE M(R1+I)=M(R1+I)-1:C=0
6070I=I+1:GOTO 6050
6080R4=R1:GOSUB 7500
6100RETURN
6500REM BIG-NUMBER INCREMENT
6510REM INPUTS: R1 THE VALUE OF A
6520REM OUTPUTS: R1 THE VALUE OF A+1
6540M(R1)=M(R1)+1:M(R1+M(R1))=0:I=1:C=1
6550IF C=0 THEN 6590
6560T=M(R1+I)+1
6570IF T>=B8 THEN M(R1+I)=T-B8 ELSE M(R1+I)=T:C=0
6580I=I+1:GOTO 6550
6590R4=R1:GOSUB 7500
6600RETURN
7000REM BIG-NUMBER PRINT
7010REM INPUTS: R7 THE VALUE TO PRINT
7020IF M(R7)=0 THEN PRINT "0":RETURN
7030FOR I=M(R7) TO 1 STEP -1
7040S$=STR$(M(R7+I))
7045IF MID$(S$,1,1)=" " THEN S$=MID$(S$,2,LEN(S$)-1)
7050IF I=M(R7) OR B9<=LEN(S$) THEN 7070
7060S$=MID$("0000000000000",1,B9-LEN(S$))+S$
7070PRINT S$;:NEXT I:PRINT:RETURN
7500REM BIG-NUMBER TRIM
7510REM INPUTS: R4 THE VALUE OF A
7520REM OUTPUTS: R4 THE TRIMMED VALUE OF A
7530IF M(R4+M(R4))=0 AND M(R4)>1 THEN M(R4)=M(R4)-1:GOTO 7530
7540RETURN
8000REM TAIL OF KARATSUBA
8003T4=M0-1-2*I8-5
8005GOSUB 4630:R1=T4:R2=Z1:R3=Z0:GOSUB 3000
8010R1=Z1:R2=T4:R3=Z2:GOSUB 3000:GOSUB 4750
8020R4=Z1:GOSUB 7500
8030I9=M(R2)+M(R3):I7=2*I8:C=0:FOR I=1 TO I9:T=C
8040IF I<=M(Z0) THEN T=T+M(Z0+I)
8050IF I>I8 AND I-I8<=M(Z1) THEN T=T+M(Z1+I-I8)
8060IF I>I7 AND I-I7<=M(Z2) THEN T=T+M(Z2+I-I7)
8070IF T<B8 THEN C=0:GOTO 8090
8080C=INT(T/B8):T=T-B8*C
8090M(R1+I)=T:NEXT I
8092M(R1)=I9:R4=R1:GOSUB 7500
8100M0=Z0
8120RETURN
8500REM GET DYNAMIC RANGE
8510REM OUTPUTS: F0 THE LARGEST INTEGER
8511REM OUTPUTS: B7 CARRY THRESHOLD
8512REM OUTPUTS: B8 RADIX OF LIMBS
8513REM OUTPUTS: B9 EXPONENT TO B8=10^B9
8520F0=&7FFFFFFF:F0=INT(F0/2):GOTO 8610:REM F9=1
8530F7=F9+1:IF F7>F9 THEN F9=F9*2:GOTO 8530
8540F0=F9
8550F7=F0+1:IF F7=F0 THEN F0=INT(F0/2):GOTO 8550
8560F4=0
8565F5=INT(0.5*(F0+F9)+0.5)
8570F7=F5+1:IF F7=F5 THEN F9=F5 ELSE F0=F5
8580IF F5=F4 THEN 8600
8590F4=F5:GOTO 8565
8600REM F0=F0/2
8610B9=INT(LN(SQR(F0))/LN(10))
8620B8=INT(EXP(LN(10)*B9)+0.5)
8630B7=F0-2*B8^2:IF B7/B8^2<4 THEN B9=B9-1:GOTO 8620
8640B6=INT(B7/B8):B7=B8*B6
8650PRINT "** Dynamic Range - F0: "; F0; " B7: "; B7; " B8: "; B8:PRINT
8700RETURN
9999END
100 REM integer.bas -- Compute the nth Fibonacci Number
110 REM Written December 25, 2018 by Eric Olson
120 REM (BBC BASIC mods - scruss, 2019-07)
130 REM This program demonstrates the expressiveness of the original
140 REM versions of Microsoft BASIC as measured by explicitly coding
150 REM Karatsuba multiplication for big-number arithmetic and then
160 REM using the doubling formula
170 REM
180 REM F(2k) = F(k)[2F(k+1)-F(k)]
190 REM F(2k+1) = F(k+1)[2F(k+1)-F(k)]+(-1)^(k+1)
200 REM F(2k+1) = F(k)[2F(k)+F(k+1)]+(-1)^(k)
210 REM F(2k+2) = F(k+1)[2F(k)+F(k+1)]
220 REM
221 REM to compute the nth Fibonacci number.
222 REM
223 REM Version 2: Minor changes to optimize the O(n^2) multiply and
224 REM prevent overflow when running on MITS BASIC.
225 REM
226 REM Version 3: Conversion to integer data types and removal of
227 REM subroutine that determines maximum floating-point integer.
228 REM
229 REM To run this program on early versions of Microsoft BASIC please
230 REM set the default data type to 16-bit integers using defint a-z in
231 REM line 241 and edit line 260 to read b8=100:b9=2:b7=32768-2*b8*b8.
232 REM Then change n so the resulting Fibonacci number fits in memory.
234 REM *** Uncomment HIMEM line if using BBC BASIC for SDL
235 REM - Brandy should use '-size 32000000' command line option
236 REM - RISC OS users should drag Next to > 20000K in the Task Window
238 REM HIMEM = PAGE + 20000000
240 REM
241 REM DEFLNG A-Z
242 REM defint a-z
243 REM Timer for program as only sbrandy can use /usr/bin/time
244 TM%=TIME
245 REM *** Original Brandy BASIC does not like *SPOOL: comment out ***
246 *SPOOL FiboOut
248 Q1%=0:Q2%=0
250 N%=4784969
251 REM N%=7499
260 B8%=10000:B9%=4:B7%=2147483647-2*B8%*B8%
261 REM B8%=100:B9%=2:B7%=32768-2*B8%*B8%
265 B6%=B7% DIV B8%:B7%=B8%*B6%
270 D9%=INT(N%*LN((1+SQR(5))/2)/LN(B8%)+7):M9%=14
280 DIM M%(D9%*M9%):M0%=1
300 A%=M0%:M0%=M0%+1+D9%:B%=M0%:M0%=M0%+1+D9%
310 T1%=M0%:M0%=M0%+1+D9%:T2%=M0%:M0%=M0%+1+D9%
400 R0%=N%:GOSUB 1000
420 R7%=B%:GOSUB 7000
423 REM *** Original Brandy BASIC does not like *SPOOL: comment out ***
424 *SPOOL
425 REM Comment out elapsed time print if comparing output to other versions
426 PRINT:PRINT " ** Elapsed: "; (TIME-TM%)/100
430 END
1000 REM Compute nth Fibonacci number
1010 REM inputs: r0 the value of n
1020 REM outputs: b the value of F(n)
1040 IF R0%<2 THEN M%(B%)=1:M%(B%+1)=R0%:RETURN
1060 N1%=R0%:R0%=(N1%-1) DIV 2:GOSUB 1500
1070 P1%=N1% MOD 4
1080 IF P1%=1 OR P1%=3 GOTO 1200
1090 R1%=T1%:R2%=A%:R3%=A%:GOSUB 2000
1110 R1%=T2%:R2%=T1%:R3%=B%:GOSUB 2000
1120 R1%=T1%:R2%=B%:R3%=T2%:GOSUB 4000
1170 R1%=B%:R2%=T1%:GOSUB 5000:RETURN
1200 R1%=T1%:R2%=B%:R3%=B%:GOSUB 2000
1210 R1%=T2%:R2%=T1%:R3%=A%:GOSUB 3000
1220 R1%=T1%:R2%=B%:R3%=T2%:GOSUB 4000
1230 IF P1%=3 THEN 1250
1240 R1%=T1%:GOSUB 6000:GOTO 1260
1250 R1%=T1%:GOSUB 6500
1260 R1%=B%:R2%=T1%:GOSUB 5000:RETURN
1500 REM Recursive work for nth Fibonacci number
1510 REM inputs: r0 the value of n
1520 REM outputs: a the value of F(n)
1530 REM outputs: b the value of F(n+1)
1540 IF R0%=0 THEN M%(A%)=1:M%(A%+1)=0:M%(B%)=1:M%(B%+1)=1:RETURN
1600 M%(M0%)=R0%:M0%=M0%+1:R0%=R0% DIV 2:GOSUB 1500
1610 M0%=M0%-1:R0%=M%(M0%)
1620 P1%=R0% MOD 4
1630 IF P1%=1 OR P1%=3 THEN 1720
1640 R1%=T1%:R2%=B%:R3%=B%:GOSUB 2000
1650 R1%=T2%:R2%=T1%:R3%=A%:GOSUB 3000
1660 R1%=T1%:R2%=A%:R3%=T2%:GOSUB 4000
1670 R1%=A%:R2%=T1%:GOSUB 5000
1680 R1%=T1%:R2%=B%:R3%=T2%:GOSUB 4000
1690 IF P1%=2 THEN 1710
1700 R1%=T1%:GOSUB 6000:GOTO 1711
1710 R1%=T1%:GOSUB 6500
1711 R1%=B%:R2%=T1%:GOSUB 5000:RETURN
1720 R1%=T1%:R2%=A%:R3%=A%:GOSUB 2000
1730 R1%=T2%:R2%=T1%:R3%=B%:GOSUB 2000
1740 R1%=T1%:R2%=B%:R3%=T2%:GOSUB 4000
1750 R1%=B%:R2%=T1%:GOSUB 5000
1760 R1%=T1%:R2%=A%:R3%=T2%:GOSUB 4000
1770 IF P1%=3 THEN 1790
1780 R1%=T1%:GOSUB 6500:GOTO 1800
1790 R1%=T1%:GOSUB 6000
1800 R1%=A%:R2%=T1%:GOSUB 5000:RETURN
2000 REM Big-number addition
2010 REM outputs: r1 the value of a+b
2020 REM inputs: r2 the value of a
2030 REM inputs: r3 the value of b
2050 IF M%(R3%)>M%(R2%) THEN I9%=M%(R3%) ELSE I9%=M%(R2%)
2060 FOR I%=1 TO I9%+1:M%(R1%+I%)=0:NEXT I%
2070 FOR I%=1 TO I9%:C%=0:T%=M%(R1%+I%)
2080 IF I%<=M%(R2%) THEN T%=T%+M%(R2%+I%)
2090 IF I%<=M%(R3%) THEN T%=T%+M%(R3%+I%)
2110 IF T%>=B8% THEN C%=1:T%=T%-B8%
2120 M%(R1%+I%)=T%:M%(R1%+I%+1)=M%(R1%+I%+1)+C%:NEXT I%
2130 M%(R1%)=I9%+1
2140 R4%=R1%:GOSUB 7500
2150 RETURN
3000 REM Big-number subtraction
3010 REM outputs: r1 the value of a-b
3020 REM inputs: r2 the value of a
3030 REM inputs: r3 the value of b
3050 FOR I%=1 TO M%(R2%):M%(R1%+I%)=0:NEXT I%
3060 FOR I%=1 TO M%(R3%):T%=M%(R1%+I%)+M%(R2%+I%)-M%(R3%+I%)
3070 IF T%<0 THEN T%=T%+B8%:M%(R1%+I%+1)=M%(R1%+I%+1)-1
3080 M%(R1%+I%)=T%:NEXT I%
3090 FOR I%=M%(R3%)+1 TO M%(R2%):T%=M%(R1%+I%)+M%(R2%+I%)
3100 IF T%<0 THEN T%=T%+B8%:M%(R1%+I%+1)=M%(R1%+I%+1)-1
3110 M%(R1%+I%)=T%:NEXT I%
3120 M%(R1%)=M%(R2%)
3130 R4%=R1%:GOSUB 7500
3150 RETURN
4000 REM Big-number multiplication
4010 REM outputs: r1 the value of a*b
4020 REM inputs: r2 the value of a
4030 REM inputs: r3 the value of b
4040 IF M%(R2%)>80 AND M%(R3%)>80 THEN 4300
4050 I9%=M%(R2%)+M%(R3%):FOR I%=1 TO I9%:M%(R1%+I%)=0:NEXT I%
4070 FOR I%=1 TO M%(R2%):FOR J%=1 TO M%(R3%)
4080 T%=M%(R1%+I%+J%-1)+M%(R2%+I%)*M%(R3%+J%)
4090 IF T%<B7% THEN 4120
4100 M%(R1%+I%+J%-1)=T%-B7%
4110 M%(R1%+I%+J%)=M%(R1%+I%+J%)+B6%:GOTO 4130
4120 M%(R1%+I%+J%-1)=T%
4130 NEXT J%:NEXT I%
4140 C%=0:FOR I%=1 TO I9%:T%=M%(R1%+I%)+C%
4150 IF T%<B8% THEN C%=0:GOTO 4170
4160 C%=T% DIV B8%:T%=T% MOD B8%
4170 M%(R1%+I%)=T%:NEXT I%
4180 M%(R1%)=I9%
4190 R4%=R1%:GOSUB 7500
4230 RETURN
4300 REM Big-number Karatsuba algorithm
4310 IF M%(R2%)<M%(R3%) THEN I8%=M%(R3%) ELSE I8%=M%(R2%)
4320 I8%=I8% DIV 2
4330 Z0%=M0%:M0%=M0%+1+2*I8%+1
4332 Z2%=M0%:M0%=M0%+1+2*I8%+3
4334 Z1%=M0%:M0%=M0%+1+2*I8%+5
4340 Z3%=M0%:M0%=M0%+1+I8%+2
4350 Z4%=M0%:M0%=M0%+1+I8%+2
4360 R5%=Z4%:R6%=R3%:GOSUB 4500
4370 R5%=Z3%:R6%=R2%:GOSUB 4500
4380 GOSUB 4600:R1%=Z1%:R2%=Z3%:R3%=Z4%:GOSUB 4000:GOSUB 4700
4400 Q1%=M%(R2%):IF I8%<Q1% THEN M%(R2%)=I8%
4405 Q2%=M%(R3%):IF I8%<Q2% THEN M%(R3%)=I8%
4410 GOSUB 4600:R1%=Z0%:GOSUB 4000:GOSUB 4700
4420 M%(R2%)=Q1%:M%(R3%)=Q2%
4430 Q3%=Q1%-I8%:Q4%=Q2%-I8%:IF Q3%<0 OR Q4%<0 THEN M%(Z2%)=0:GOTO 8000
4440 Q1%=M%(R2%+I8%):M%(R2%+I8%)=Q3%:Q2%=M%(R3%+I8%):M%(R3%+I8%)=Q4%
4450 GOSUB 4600:R1%=Z2%:R2%=R2%+I8%:R3%=R3%+I8%:GOSUB 4000:GOSUB 4700
4460 M%(R2%+I8%)=Q1%:M%(R3%+I8%)=Q2%
4470 GOTO 8000
4500 REM Add high to low
4510 REM outputs: r5 the sum of high(a)+low(a)
4520 REM inputs: r6 the value of a
4530 REM inputs: i8 the split point
4540 C%=0:FOR I%=1 TO I8%+1:T%=C%
4545 IF I%<=I8% AND I%<=M%(R6%) THEN T%=T%+M%(R6%+I%)
4550 IF I%+I8%<=M%(R6%) THEN T%=T%+M%(R6%+I%+I8%)
4560 IF T%>=B8% THEN C%=1:T%=T%-B8% ELSE C%=0
4570 M%(R5%+I%)=T%:NEXT I%:M%(R5%+I8%+2)=C%
4590 M%(R5%)=I8%+2:R4%=R5%:GOSUB 7500
4595 RETURN
4600 REM Save frame
4610 M%(M0%)=Z1%:M0%=M0%+1:M%(M0%)=Z2%:M0%=M0%+1:M%(M0%)=Z0%:M0%=M0%+1
4620 M%(M0%)=I8%:M0%=M0%+1:M%(M0%)=Q1%:M0%=M0%+1:M%(M0%)=Q2%:M0%=M0%+1
4630 REM Save parameters
4640 M%(M0%)=R1%:M0%=M0%+1:M%(M0%)=R2%:M0%=M0%+1:M%(M0%)=R3%:M0%=M0%+1
4650 RETURN
4700 REM Restore frame
4710 GOSUB 4750
4720 M0%=M0%-1:Q2%=M%(M0%):M0%=M0%-1:Q1%=M%(M0%):M0%=M0%-1:I8%=M%(M0%)
4730 M0%=M0%-1:Z0%=M%(M0%):M0%=M0%-1:Z2%=M%(M0%):M0%=M0%-1:Z1%=M%(M0%)
4740 RETURN
4750 REM Restore parameters
4760 M0%=M0%-1:R3%=M%(M0%):M0%=M0%-1:R2%=M%(M0%):M0%=M0%-1:R1%=M%(M0%)
4770 RETURN
5000 REM Big-number copy
5010 REM outputs: r1 the value of a
5020 REM inputs: r2 the value of a
5030 R4%=R2%:GOSUB 7500
5040 FOR I%=1 TO M%(R2%):M%(R1%+I%)=M%(R2%+I%):NEXT I%
5050 FOR I%=M%(R2%)+1 TO M%(R1%):M%(R1%+I%)=0:NEXT I%
5060 M%(R1%)=M%(R2%)
5070 RETURN
6000 REM Big-number decrement
6010 REM inputs: r1 the value of a
6020 REM outputs: r1 the value of a-1
6040 I%=1:C%=1
6050 IF C%=0 THEN 6080
6060 IF M%(R1%+I%)<1 THEN M%(R1%+I%)=B8%-1 ELSE M%(R1%+I%)=M%(R1%+I%)-1:C%=0
6070 I%=I%+1:GOTO 6050
6080 R4%=R1%:GOSUB 7500
6100 RETURN
6500 REM Big-number increment
6510 REM inputs: r1 the value of a
6520 REM outputs: r1 the value of a+1
6540 M%(R1%)=M%(R1%)+1:M%(R1%+M%(R1%))=0:I%=1:C%=1
6550 IF C%=0 THEN 6590
6560 T%=M%(R1%+I%)+1
6570 IF T%>=B8% THEN M%(R1%+I%)=T%-B8% ELSE M%(R1%+I%)=T%:C%=0
6580 I%=I%+1:GOTO 6550
6590 R4%=R1%:GOSUB 7500
6600 RETURN
7000 REM Big-number print
7010 REM inputs: r7 the value to print
7020 IF M%(R7%)=0 THEN PRINT "0":RETURN
7030 FOR I%=M%(R7%) TO 1 STEP -1
7040 S$=STR$(M%(R7%+I%))
7045 IF MID$(S$,1,1)=" " THEN S$=MID$(S$,2,LEN(S$)-1)
7050 IF I%=M%(R7%) OR B9%<=LEN(S$) THEN 7070
7060 S$=MID$("0000000000000",1,B9%-LEN(S$))+S$
7070 PRINT S$;:NEXT I%:PRINT:RETURN
7500 REM Big-number trim
7510 REM inputs: r4 the value of a
7520 REM outputs: r4 the trimmed value of a
7530 IF M%(R4%+M%(R4%))=0 AND M%(R4%)>1 THEN M%(R4%)=M%(R4%)-1:GOTO 7530
7540 RETURN
8000 REM Tail of Karatsuba
8003 T4%=M0%-1-2*I8%-5
8005 GOSUB 4630:R1%=T4%:R2%=Z1%:R3%=Z0%:GOSUB 3000
8010 R1%=Z1%:R2%=T4%:R3%=Z2%:GOSUB 3000:GOSUB 4750
8020 R4%=Z1%:GOSUB 7500
8030 I9%=M%(R2%)+M%(R3%):I7%=2*I8%:C=0:FOR I%=1 TO I9%:T%=C%
8040 IF I%<=M%(Z0%) THEN T%=T%+M%(Z0%+I%)
8050 IF I%>I8% AND I%-I8%<=M%(Z1%) THEN T%=T%+M%(Z1%+I%-I8%)
8060 IF I%>I7% AND I%-I7%<=M%(Z2%) THEN T%=T%+M%(Z2%+I%-I7%)
8070 IF T%<B8% THEN C%=0:GOTO 8090
8080 C%=1:T%=T%-B8%
8090 M%(R1%+I%)=T%:NEXT I%
8092 M%(R1%)=I9%:R4%=R1%:GOSUB 7500
8100 M0%=Z0%
8120 RETURN
9999 END
@scruss

This comment has been minimized.

Copy link
Owner Author

scruss commented Jul 18, 2019

@scruss

This comment has been minimized.

Copy link
Owner Author

scruss commented Jul 18, 2019

run Classic2_brandy with

/usr/bin/time --format "\t%E real,\t%U user,\t%S sys : %M mem" sbrandy -size 32000000 Classic2_brandy.bas > cfib.txt

stardot/MatrixBrandy: Fork of Brandy BASIC V for Linux

@scruss

This comment has been minimized.

Copy link
Owner Author

scruss commented Jul 18, 2019

runtimes on risc os (Raspberry Pi 3)

  • BASIC: 3778 s

  • BASIC64: 3240 s

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.