10 REM Generation of perfect numbers
using the 2x2x2x2x2xp assumption.PGM. NA
ME:GPERFN3
15 DIM A%(255),B%(255),C%(255)
17 MODE7
20 q%=1:rt%=1
30 REPEAT
40 q%=2*q%
50 rt%=rt%+q%
60 PROCtest(rt%)
70 IF prime THEN PRINT;q%;" x ";rt%;"
is perfect.":A$=STR$(q%):B$=STR$(rt%):P
ROCfermat:PRINT"= ";C$;'
80 UNTIL rt%>999999999
90 END
2000 DEFPROCtest(A%)
2005 D%=2:prime=TRUE
2010 IF A%/D%=INT(A%/D%) THEN prime=FAL
SE:ENDPROC
2020 D%=3
2025 IF A%=3 THEN prime=TRUE:ENDPROC
2030 IF A%/D%=INT(A%/D%) THEN prime=FAL
SE:ENDPROC
2040 REPEAT
2050 D%=D%+2
2060 IF A%/D%=INT(A%/D%) THEN prime=FAL
SE
2070 UNTIL D%>SQR(A%)
2080 ENDPROC
29999 REM```````````````````````````````
````````````````````````````````````
30000 DEFPROCfermat
30010 PROCinitial
30030 PROCmult
30060 PROCreorderc
30070 IF N% VDU7
30080 ENDPROC
30100 DEFPROCinitial
30110 N%=0:LA=LENA$:LB=LENB$
30120 IF LA>LB L%=LA ELSE L%=LB
30130 FOR I%=0 TO L%
30140 A%(I%)=-(I%<LA)*VALMID$(A$,LA-I%,1
)
30150 B%(I%)=-(I%<LB)*VALMID$(B$,LB-I%,1
)
30160 NEXT
30170 ENDPROC
30270 DEFPROCmult
30280 U%=2*L%
30290 PROCzeroc
30300 FOR I%=0 TO L%-1
30310 FOR J%=0 TO L%-1
30320 K%=I%+J%
30330 C%(K%)=A%(J%)*B%(I%)+C%(K%)
30340 NEXT J%,I%
30350 ENDPROC
31050 DEFPROCzeroc
31060 FOR I%=0 TO U%
31070 C%(I%)=0
31080 NEXT
31090 ENDPROC
31110 DEFPROCreorderc
31120 C%=0:CSIG=0:C$=""
31130 FOR I%=0 TO U%
31140 K%=C%(I%)+C%
31150 C%(I%)=K% MOD 10:C%=K% DIV 10
31160 IF C%(I%) CSIG=I%
31170 C$=CHR$(48+C%(I%))+C$
31180 NEXT
31190 C$=RIGHT$(C$,CSIG+1)
31200 ENDPROC