From Newsgroup: comp.sys.apple2

Here are two new versions which also display the prime numbers.
This one prints primes less than 2048. All primes will fit on one 80x24 screen: Sieve65.2K
8100:A2 9B BD 79 81 95 39 CA D0 F8 A0 00 A2 0E A9 76
8110:20 6F 00 A9 B2 20 77 81 A9 A0 20 77 81 A0 00 A9
8120:03 84 02 C8 F8 18 D0 30 AA A5 02 69 00 85 02 8A
8130:C8 D0 25 EE 5A 81 10 20 D8 60 D8 A6 02 F0 04 8A
8140:20 65 81 A5 01 20 65 81 A9 A0 20 77 81 A5 01 F8
8150:18 69 02 B0 D3 C8 F0 DB BE 00 7C 10 F4 85 01 30
8160:D9 E8 30 10 60 85 00 4A 4A 4A 4A 20 72 81 A5 00
8170:29 0F F0 ED 09 B0 AA 4C ED FD C2 2C A6 4A 4C A6
8180:88 6C 22 CA 64 A4 CA 68 86 85 71 85 75 85 79 85
8190:7D 85 81 85 85 85 89 86 70 E8 86 74 E8 86 78 E8
81A0:86 7C E8 86 80 E8 86 84 E8 86 88 A2 0E B5 3A 99
81B0:00 7C 0A 99 01 7C 0A 99 02 7C 0A 99 03 7C 0A 99
81C0:04 7C 0A 99 05 7C 0A 99 06 7C 98 18 69 07 A8 CA
81D0:10 DB 0A 90 D6 4A A8 A5 70 49 80 AA 30 B9 A5 71
81E0:69 01 10 A5 A0 0B A2 7C A9 3C 85 CD E6 AF 2C 04
81F0:7C 10 15 86 C7 84 C0 86 BE 18 85 BD 8C 00 FF 69
8200:00 90 F7 E8 10 F1 A2 00 C8 98 C8 0A 69 00 90 DA
8210:E8 10 D7 60
This version prints primes less than $F000 (61,440), with one prime per line. Sieve65.66K
8100:A2 9B BD 85 81 95 39 CA D0 F8 A0 00 A2 0E A9 76
8110:20 6F 00 A9 B2 20 83 81 A9 8D 20 83 81 A0 00 A9
8120:03 84 02 84 03 C8 F8 18 D0 3A AA A5 02 69 00 85
8130:02 90 03 E6 03 18 8A C8 D0 2A EE 66 81 10 25 D8
8140:60 D8 A6 03 F0 04 8A 20 80 81 A5 02 20 71 81 A5
8150:01 20 71 81 A9 8D 20 83 81 A5 01 F8 18 69 02 B0
8160:C9 C8 F0 D6 BE 00 08 10 F4 85 01 30 D4 E8 30 10
8170:60 85 00 4A 4A 4A 4A 20 7E 81 A5 00 29 0F F0 ED
8180:09 B0 AA 4C ED FD C2 2C A6 4A 4C A6 88 6C 22 CA
8190:64 A4 CA 68 86 85 71 85 75 85 79 85 7D 85 81 85
81A0:85 85 89 86 70 E8 86 74 E8 86 78 E8 86 7C E8 86
81B0:80 E8 86 84 E8 86 88 A2 0E B5 3A 99 00 08 0A 99
81C0:01 08 0A 99 02 08 0A 99 03 08 0A 99 04 08 0A 99
81D0:05 08 0A 99 06 08 98 18 69 07 A8 CA 10 DB 0A 90
81E0:D6 4A A8 A5 70 49 80 AA 30 B9 A5 71 69 01 10 A5
81F0:A0 0B A2 08 A9 3C 85 CD E6 AF 2C 04 08 10 15 86
8200:C7 84 C0 86 BE 18 85 BD 8C 00 FF 69 00 90 F7 E8
8210:10 F1 A2 00 C8 98 C8 0A 69 00 90 DA E8 10 D7 60
Below is the Merlin-16 source listing.
Enjoy,
-JB
*-------------------------------
* Sieve of Eratosthenes for Apple II
* Merlin-16 v3.5.1 assembler
* 11/25/2023 by John Brooks
*-------------------------------
* Primes less than 2048 in 276 code bytes
* 17,165 cycle prime calc (8110:4C to time)
* 75,812 cycle prime w/print (8177:60 to time)
*-------------------------------
* Primes less than 66,140 in 288 code bytes
* 913,120 cycle prime calc (8110:4C to time)
* 2,118,067 cycle prime w/print (8183:60 to time) *-------------------------------
lst on ; Merlin assembler: generate assembly listing
org $8100 ; Code execution starts at $8100
Sieve2048 equ 1 ; 0 = 66K primes, 1 = 2K primes
ZpCodeOrg equ $3a ; zero page address where Prime calc code runs *.................
do Sieve2048
PrimeRange equ 2048 ; check integers less than 2048 for primes OddRange equ PrimeRange/2 ; check 1024 odd integers
Flags equ $8000-OddRange ; 1024 byte-per-odd flags array ends at $8000
BcdTmp equ $00 ; holds BCD low digit while printing high digit NumAsBcd equ $01 ; 4-digit BCD of odd-integers during print SpaceChar equ " " ; display a space between primes *.................
else
PrimeRange equ $f000 ; check integers less than 66,140 for primes OddRange equ PrimeRange/2 ; check $7800 odd integers
Flags equ $8000-OddRange ; byte-per-odd flags array at $800-$8000 BcdTmp equ $00 ; holds BCD low digit while printing high digit NumAsBcd equ $01 ; 5-digit BCD of odd-integers during print SpaceChar equ $8D ; display one prime per line
fin
*.................
mx %11 ; Merlin: 8-bit mem/acc, 8-bit xy regs
Sieve
ldx #SieveEnd-SieveZP+1 ; Num bytes to copy to ZP. +1 for X=0 exit
CopyToZp
lda RelocToZP-1,x
sta ZpCodeOrg-1,x
dex
bne CopyToZp
ldy #0 ; y: Flags index == 0
ldx #15-1 ; x: wheel constants index
lda #%01110110 ; initial primes = .,3,5,7,.,11,13,.
jsr SetFlag1 ; find all primes *-------------------------------
DispPrimes
lda #"2" ; display the single even prime: 2
jsr Cout
lda #SpaceChar
jsr Cout
ldy #$00
lda #$03 ; first BCD number checked is == $0003 *.................
do Sieve2048
sty NumAsBcd+1
*.................
else
sty NumAsBcd+1
sty NumAsBcd+2
fin
*.................
iny ; y: start checking number 3, Flags index (3/2 == 1)
sed ; enable 6502 BCD mode
clc ; c=0 assumed in loop
bne DispChk ; always
DispNextBcdH
tax ; save BcdL
lda NumAsBcd+1 ; BcdH++
adc #0
sta NumAsBcd+1
*.................
do Sieve2048
txa ; restore BcdL
*.................
else
bcc DispBcd5Ok
inc NumAsBcd+2
clc
DispBcd5Ok
txa ; restore BcdL
fin
*.................
iny ; check PtrL++
bne DispChk
DispNextPtrH
inc DispChk+2 ; check PtrH++
bpl DispChk
DispExit
cld ; disable BCD mode
rts
DispBcd
cld ; disable BCD mode during Cout print *.................
do Sieve2048
ldx NumAsBcd+1 ; set X<$80 to skip printing leading zero digits beq DispSkip00
txa ; non-zero in top two BCD digits, print them *.................
else
ldx NumAsBcd+2 ; set X<$80 to skip printing leading zero digits
beq DispNoBcd5
txa
jsr DispDigit
DispNoBcd5
lda NumAsBcd+1
fin
*.................
jsr DispByte
DispSkip00
lda NumAsBcd ; print low two BCD digits
jsr DispByte
lda #SpaceChar ; print space
jsr Cout
lda NumAsBcd ; acc: BcdL
sed ; 6502 BCD mode enabled
clc ; loop assumes c=0
DispNext
adc #2 ; check BcdL += 2
bcs DispNextBcdH
iny ; check PtrL++
beq DispNextPtrH
DispChk ldx Flags,y ; self-mod PtrH
bpl DispNext ; branch if not prime
sta NumAsBcd ; save acc:BCD for printing
bmi DispBcd ; always
*-------------------------------
DispZero
inx ; x: > 128 if a non-zero digit has printed
bmi DispDigit
rts ; skip leading zeroes *-------------------------------
DispByte
sta BcdTmp ; save BCD low digit
lsr ; shift BCD high to low
lsr
lsr
lsr
jsr ChkZero
lda BcdTmp ; get low digit
and #$0f
ChkZero
beq DispZero
DispDigit
ora #"0" ; make ascii 0-9
tax ; disable zero skipping for the rest of the number
Cout jmp $fded ; Apple II ROM character output routine *-------------------------------
RelocToZP
org ZpCodeOrg
SieveZP
* wheel of primes for odd integers less than 2*3*5*7 (210 integers)
* stored as 15 * 7 bits (105 bits for the odd integers < 2*3*5*7)
Wheel210
db %11000010 ; 197,199,...,...,...,...,209,0
db %00101100 ; ...,...,187,...,191,193,...,0
db %10100110 ; 169,...,173,...,...,179,181,0
db %01001010 ; ...,157,...,...,163,...,167,0
db %01001100 ; ...,143,...,...,149,151,...,0
db %10100110 ; 127,...,131,...,...,137,139,0
db %10001000 ; 113,...,...,...,121,...,...,0
db %01101100 ; ...,101,103,...,107,109,...,0
db %00100010 ; ...,..., 89,...,...,..., 97,0
db %11001010 ; 71, 73,...,..., 79,..., 83,0
db %01100100 ; ..., 59, 61,...,..., 67,...,0
db %10100100 ; 43,..., 47,...,..., 53,...,0
db %11001010 ; 29, 31,...,..., 37,..., 41,0
db %01101000 ; ..., 17, 19,..., 23,...,...,0
db %10000110 ; 1,...,...,...,..., 11, 13,0 *-------------------------------
SetFlagPtrH ; self-mod writes to the Flags array (PtrH)
sta SetFlag1+2
sta SetFlag2+2
sta SetFlag3+2
sta SetFlag4+2
sta SetFlag5+2
sta SetFlag6+2
sta SetFlag7+2
SetFlagPtrL ; self-mod writes to the Flags array (PtrL)
stx SetFlag1+1
inx
stx SetFlag2+1
inx
stx SetFlag3+1
inx
stx SetFlag4+1
inx
stx SetFlag5+1
inx
stx SetFlag6+1
inx
stx SetFlag7+1
*-------------------------------
DoWheel210
ldx #15-1 ; load 15 7-bit wheel constants
DoWheelByte
lda Wheel210,x ; acc: 7 bits of wheel constants
; set bit 7 of Flags: 1=check for prime, 0=not prime
SetFlag1 sta Flags,y
asl
SetFlag2 sta Flags+1,y
asl
SetFlag3 sta Flags+2,y
asl
SetFlag4 sta Flags+3,y
asl
SetFlag5 sta Flags+4,y
asl
SetFlag6 sta Flags+5,y
asl
SetFlag7 sta Flags+6,y
tya ; y: Flags index += 7
clc
adc #7
tay
dex ; x: next wheel constant
bpl DoWheelByte ; loop for 15 wheel bytes
asl
bcc DoWheel210 ; loop while y:FlagsIndex < 128
lsr ; y: Flags index &= $7F to avoid y overflow
tay
lda SetFlag1+1 ; Flags PtrL += $80 to avoid y overflow
eor #$80
tax
bmi SetFlagPtrL ; Update 7 Flags PtrL
lda SetFlag1+2 ; PtrH++
adc #1 ; C=0 from lsr above
bpl SetFlagPtrH ; Update 7 Flags PtrL & PtrH *-------------------------------
* Check Flags starting at number 11. Wheel210 has excluded multiples of 3,5,7
* Start excluding Flags at Prime squared, 11*11
ldy #11 ; y: Prime check = 11
ldx #>11*11/2+Flags ; xa: Prime squared = 11^2. Div2 for only-odd
lda #<11*11/2+Flags
ChkPrime
sta ModSq+1 ; save acc
inc ModChkPtr+1 ; ++FlagsPtr
ModChkPtr bit 11/2+Flags-1 ;acc: OddPrimeFlag
bpl ChkNext ; branch if not prime, ie < 128 *-------------------------------
* Exclude multiples of the found prime
* Start at prime^2 (ptr in xa)
stx ModExcOk+1 ; save x:Flags PtrH
sty ModExcInc+1 ; set stride to exclude Flags
SetExcPtrH
stx ModExcPtr+2 ; set PtrH
clc ; assumes c=0 in loop
ExcLoop
sta ModExcPtr+1 ; set PtrL
ModExcPtr sty $ff00 ; exclude Flags entry via bit7=0 (y always < 128)
ModExcInc adc #0 ; step to next Flags entry to exclude
bcc ExcLoop ; exclude all flags in the page
inx ; PtrH++
bpl SetExcPtrH ; set PtrH
ModExcOk ldx #0 ; restore x: prime^2 PtrH *-------------------------------
ChkNext
iny ; y: prime chk += 1
tya
iny ; y: prime chk += 1
asl ; incrementally update prime^2
ModSq adc #0 ; add to old xa:prime^2 ptr
bcc ChkPrime
inx ; PtrH++
bpl ChkPrime
rts ; All primes found when prime^2 ptr >= $8000 SieveEnd
lst off ; Merlin: disable listing the entire symbol table
--- Synchronet 3.20a-Linux NewsLink 1.114

From Newsgroup: comp.sys.apple2

ldx #SieveEnd-SieveZP+1 ; Num bytes to copy to ZP. +1 for X=0 exit
CopyToZp
lda RelocToZP-1,x
sta ZpCodeOrg-1,x
dex
bne CopyToZp

ldy #0 ; y: Flags index == 0



ldy #SieveEnd-SieveZP+1 ; Num bytes to copy to ZP. +1 for X=0 exit
CopyToZp
ldx RelocToZP-1,y
stx ZpCodeOrg-1,y
dey
bne CopyToZp

; ldy #0 ; y: Flags index == 0
--- Synchronet 3.20a-Linux NewsLink 1.114