title	Das Sieb des Eratosthenes
	name	('SIEVE')

; The Sieve of Eratosthenes in Assembler
; Algorithm based upon an article Wikipedia


	entry	$memry

	extrn	sqrt

FALSE	equ	0
TRUE	equ	1

OS	equ	0000h
BDOS	equ	0005h
TPATOP	equ	BDOS+1

.conout	equ	2
.string	equ	9

null	equ	00h
lf	equ	0ah
cr	equ	0dh
eot	equ	'$'

N	equ	10000

colmax	equ	10

	dseg
;
$DELIM:
	db	'  ',eot
$HEAD1:
	db	'Das Sieb des Eratosthenes 2-',eot
$HEAD2:
	db	'Primzahlen:'
	db	cr,lf
	db	'-----------'
	db	cr,lf
	db	'      ',eot
$NOMEM:
	db	'Nicht genug Speicher - Abbruch'
	db	cr,lf,eot
$memry:
	ds	2
tentbl:
	dw	10000
	dw	1000
	dw	100
	dw	10
Work1:
	ds	2
Work2:
	ds	2
col:
	ds	1
CrossOut:
	ds	2

	cseg
;
; =========================== OS Support ===========================
;
; Print string ^DE on console
;
String:
	push	bc
	push	de
	push	hl
	ld	c,.string
	call	BDOS		; Print
	pop	hl
	pop	de
	pop	bc
	ret
;
; Put new line to console
;
PrNL:
	ld	a,cr
	call	Conout
	ld	a,lf
;
; Put character in Accu to console
;
Conout:
	push	bc
	push	de
	push	hl
	ld	c,.conout
	ld	e,a		; Get character
	call	BDOS		; Put to console
	pop	hl
	pop	de
	pop	bc
	ret
;
; Convert hex number in HL to ASCII decimal string with B places
;
PrDec:
	call	decout		; Convert to ASCII
	ld	hl,($memry)	; Get ASCII pointer
	inc	b
	dec	b		; Test places defined
	call	nz,Place	; Yeap
noPlace:
	ld	a,(hl)		; Get character
	or	a		; Test end
	ret	z		; Yeap
	call	Conout		; Print it
	inc	hl
	jr	noPlace
;
; Fix places
;
Place:
	push	hl		; Save base
	ld	c,0		; Init count
getLen:
	ld	a,(hl)		; Get character
	or	a		; Test end
	jr	z,gotLen	; Yeap
	inc	hl		; Point to next
	inc	c		; Count up
	jr	getLen
gotLen:
	pop	hl		; Get back base
	ld	a,b		; Get place count
	sub	c		; Get difference
	ret	z		; Nothing to do
	ret	c
	ld	b,a
PrSpc:
	ld	a,' '
	call	Conout		; Print leading spaces
	djnz	PrSpc
	ret
;
; The conversion routine
;
decout:
	push	bc		; Save digit count
	push	ix
	ld	ix,($memry)	; Get ASCII pointer
	ld	de,tentbl	; Point to table
	push	de		; Onto stack
	ld	c,1		; Set zero flag
dotpos:
	ex	(sp),hl
	ld	e,(hl)		; Get pointer
	inc	hl
	ld	d,(hl)
	inc	hl
	ex	(sp),hl
	ld	b,-1		; Clear digit
dotdiv:
	inc	b		; Count digits
	or	a
	sbc	hl,de		; Get difference
	jr	nc,dotdiv	; Test < 0
	add	hl,de		; Make > 0
	xor	a		; Clear result
	or	b		; Test zero digit
	jr	nz,dotstr
	or	c		; Clear leading zero
	jr	nz,dotbyp
dotstr:
	ld	c,0		; Clear zero flag
	or	'0'		; Make ASCII
	ld	(ix),a		; Save digit
	inc	ix
dotbyp:
	ld	a,e		; Test end of table
	cp	10
	jr	nz,dotpos
	ld	a,l		; Get LSD
	or	'0'		; Make ASCII
	pop	de
	push	ix
	pop	hl		; Get back pointer
	ld	(hl),a		; Set last digit
	inc	hl
	ld	(hl),null	; Set end character
	pop	ix
	pop	bc
	ret
;
; Multiply signed integers HL:=HL*DE
;
Multiply:
	ld	c,e		; Copy multiplicand
	ld	b,d
	ex	de,hl
	ld	hl,0		; Init product
	ld	a,d
	or	a		; Test word
	ld	a,16
	jr	nz,MultLoop	; Yeap, set bit count
	ld	d,e
	ld	a,8		; Change bit count
MultLoop:
	add	hl,hl		; Do the multiplication
	ex	de,hl
	add	hl,hl
	ex	de,hl
	jr	nc,MultNC
	add	hl,bc
MultNC:
	dec	a
	jr	nz,MultLoop
	ret
;
; Set loop length from DE to HL
;
Diff:
	or	a
	sbc	hl,de		; Get difference
	ex	de,hl		; Start to HL
	inc	de		; Fix length
	ret
;
; =================================================================
;
; Clear the prime number field
;
inifield:
	ld	bc,N-2
	ld	hl,(CrossOut)
	dec	hl
	ld	e,l
	ld	d,h
	dec	hl
	ld	(hl),0
	ldir			; Clear field
	ret
;
; Print decimal number in reg HL
;
prime:
	ld	b,4
	call	PrDec		; Give four places
	ld	hl,col
	inc	(hl)
	ld	a,(hl)		; Update column
	cp	colmax+1	; Test max
	jr	nz,prime.nxt
	call	PrNL		; new line if so
	ld	a,1
	ld	(col),a		; Reset column
	ret
prime.nxt:
	ld	de,$DELIM
	call	String		; Print delimiter
	ret
;
; Part 1 of Sieve
; This part scans the crossfield from 2..sqrt(N)
;
Sieve1:
	ld	hl,N
	call	sqrt		; Get square root of size
	ld	de,2
	call	Diff		; Calculate loop
Sieve1.for:
	ld	a,d
	or	e		; Test done
	ret	z		; Yeap
	push	de
	ld	(Work1),hl
	ld	de,(CrossOut)
	dec	de
	dec	de
	add	hl,de
	ld	a,(hl)
	or	a		; Test field crossed
	jr	nz,Sieve1.noprime
	ld	hl,(Work1)
	call	prime		; Print prime number if so
	ld	hl,(Work1)
	ld	d,h
	ld	e,l
	call	Multiply
	ld	(Work2),hl	; Calculate square
Sieve1.loop:
	ld	de,N+1
	or	a
	sbc	hl,de		; Test within range
	jr	nc,Sieve1.noprime
	ld	de,(CrossOut)
	dec	de
	dec	de
	ld	hl,(Work2)
	add	hl,de
	ld	(hl),TRUE	; Set crossed if so
	ld	de,(Work2)
	ld	hl,(Work1)
	add	hl,de
	ld	(Work2),hl
	jr	Sieve1.loop
Sieve1.noprime:
	ld	hl,(Work1)
	inc	hl
	pop	de
	dec	de
	jr	Sieve1.for
;
; Part 2 of Sieve
; This part scans the crossfield from sqrt(N)+1..N
;
Sieve2:
	ld	hl,N
	call	sqrt		; Get square root of size
	inc	hl
	ex	de,hl
	ld	hl,N
	call	Diff		; Calculate loop
Sieve2.loop:
	ld	a,d
	or	e
	ret	z
	push	de
	ld	(Work1),hl
	ld	de,(CrossOut)
	dec	de
	dec	de
	add	hl,de
	ld	a,(hl)
	or	a		; Test crossed
	ld	hl,(Work1)
	call	z,prime		; Print prime number if so
	ld	hl,(Work1)
	inc	hl
	pop	de
	dec	de
	jr	Sieve2.loop
;
; Start of Sieve
;
Sieve:
	ld	hl,($memry)	; Get pointer to free memory
	inc	h		; Allow one free page
	inc	hl
	inc	hl
	ld	(CrossOut),hl	; Set base of CrossOut field
	ld	de,N
	add	hl,de		; Point to top of field
	ld	de,(TPATOP)	; Get top of memory
	dec	d		; One free page
	or	a
	sbc	hl,de		; Test free space
	jr	nc,NoMem	; Nope
	ld	sp,(TPATOP)	; Get stack
	ld	de,$HEAD1
	call	String		; Tell what we are doing
	ld	hl,N
	ld	b,0
	call	PrDec
	call	PrNL
	ld	de,$HEAD2
	call	String
	ld	a,2
	ld	(col),a		; Init start column
	call	inifield	; Clear the prime number field
	call	Sieve1		; Part 1 of Sieve
	call	Sieve2		; Part 2 of Sieve
	jp	OS
NoMem:
	ld	de,$NOMEM
	call	String		; Not enough memory
	jp	OS

	end	Sieve