title	'Wann ist Ostern ?'
	name	('OSTERN')

; Wann ist Ostern?
; Nach einem Artikel der Physikalisch-Technischen Bundesanstalt

; Ausfuehrung in Assembler, Werner Cirsovius, Februar 1999

	.z80

OS	equ	0000h
BDOS	equ	0005h

.conout	equ	 2
.rdcon	equ	10

null	equ	00h
bs	equ	08h
tab	equ	09h
lf	equ	0ah
ff	equ	0ch
cr	equ	0dh

	entry	$memry

; Berechnung des Datums und Ausgabe
; EIN	Accu haelt den berechneten Osterwert in Tagen ab 1.3.
; 	Register HL haelt Initialmeldung

datum:
	push	af
	ld	(@mess7),hl
	ld	de,@mess7
	ld	hl,$mess7
	call	_printf		; Meldung ausgeben
	pop	af
	ld	c,3		; Maerz voreinstellen
	cp	31+1		; .. Monat berechnen
	jr	c,dat.aus
	sub	31
	inc	c
	cp	30+1
	jr	c,dat.aus
	sub	30
	inc	c
	cp	31+1
	jr	c,dat.aus
	sub	31
	inc	c
dat.aus:
	ld	(_da),a
	ld	a,c
	ld	(_mo),a
	ld	hl,$mess8
	ld	de,@mess8
	call	_printf		; Monat ausgeben
	ret

; ** HAUPTPROGRAMM **

_main:
	ld	sp,LocStk

	ld	hl,$mess1
	call	_printf
	call	_scanf
	ld	(_x),hl
	ld	de,1583
	or	a
	sbc	hl,de
	jr	nc,not.jul
	ld	hl,$mess2
	call	_printf
	jp	OS
not.jul:
	ld	de,(_x)		;; k = x / 100
	ld	hl,100
	call	divide
	ld	(_k),hl
	inc	hl		;; l = 3*(k + 1) / 4
	ld	b,h
	ld	c,l
	add	hl,hl
	add	hl,bc
	srl	h
	rr	l
	srl	h
	rr	l
	ld	(_l),hl
	ld	de,15		;; m = 15 + l -((8 * k + 13) / 25)
	add	hl,de
	push	hl
	ld	hl,(_k)
	add	hl,hl
	add	hl,hl
	add	hl,hl
	ld	de,13
	add	hl,de
	ex	de,hl
	ld	hl,25
	call	divide
	ex	de,hl
	pop	hl
	or	a
	sbc	hl,de
	ld	(_m),hl
	ld	de,(_l)		;; s = 2 - l
	ld	hl,2
	or	a
	sbc	hl,de
	ld	(_s),hl
	ld	de,(_x)		;; a = x % 19
	ld	hl,19
	call	divide
	ld	(_a),de
	ld	hl,19		;; d = (19 * a + m) % 30
	call	multip
	ld	de,(_m)
	add	hl,de
	ex	de,hl
	ld	hl,30
	call	divide
	ld	(_d),de
	ld	hl,29		;; r = (d / 29) + ((d / 28) - (d / 29)) * (a / 11)
	call	divide
	push	hl
	ld	de,(_d)
	ld	hl,28
	call	divide
	pop	de
	or	a
	sbc	hl,de
	push	hl
	push	de
	ld	de,(_a)
	ld	hl,11
	call	divide
	pop	de
	call	multip
	ex	de,hl
	pop	hl
	add	hl,de
	ld	(_r),hl
	ex	de,hl		;; og = 21 + d - r
	ld	hl,(_d)
	ld	bc,21
	add	hl,bc
	or	a
	sbc	hl,de
	ld	(_og),hl
	ld	hl,(_x)		;; sz = 7 - (x + (x / 4) + s) % 7
	push	hl
	srl	h
	rr	l
	srl	h
	rr	l
	pop	de
	add	hl,de
	ld	de,(_s)
	add	hl,de
	ex	de,hl
	ld	hl,7
	call	divide
	ld	hl,7
	or	a
	sbc	hl,de
	ld	(_sz),hl
	ex	de,hl		;; oe = 7 - (og - sz) % 7
	ld	hl,(_og)
	or	a
	sbc	hl,de
	ex	de,hl
	ld	hl,7
	call	divide
	ld	hl,7
	or	a
	sbc	hl,de
	ld	(_oe),hl
	ld	de,(_og)	;; os = og + oe
	add	hl,de
	ld	(_os),hl

	ld	a,l
	ld	hl,$mess3
	call	datum

	ld	a,(_os)
	add	a,49
	ld	hl,$mess4
	call	datum

	ld	a,(_os)
	add	a,39
	ld	hl,$mess5
	call	datum

	ld	a,(_os)
	add	a,60
	ld	hl,$mess6
	call	datum

	jp	OS
;
; ========= Unterprogramme =========
;
; Ausgabe auf Konsole
;
; EIN	Register HL zeigt auf zu formatierende Kette
;	Register DE zeigt auf Kontrollarray
;
_printf:
	ld	bc,($memry)	; Speicher fuer Resultat
	push	bc
	ld	a,255
	ld	(bc),a
	call	printf		; Formatieren
	pop	de
	inc	de
	call	strcn0		; Resultat ausgeben
	ret
;
; Dezimalzahl einlesen und wandeln
;
; AUS	Register HL haelt Resultat
;
_scanf:
	ld	de,$line
	call	getlin		; Einlesen
	ld	hl,0
	ret	c
	ld	de,$line+2
	ld	b,null
	call	decin		; .. und umwandeln
	ret	nc
	ld	hl,0
	ret

; Multiplikation vorzeichenloser Zahlen

; EIN	Register DE,HL halten die Zahlen
;	Eine davon darf nur 8 Bit breit sein

; AUS	Register HL haelt das Produkt
;	Carry wird bei Ueberlauf gesetzt

multip:
	xor	a
	or	h		; Test ob 8 Bit breit
	jr	z,found
	xor	a
	or	d		; 2. muss Null sein
	scf
	ret	nz
	ex	de,hl
found:
	ld	a,l		; Multiplikanten holen
	ld	hl,0		; Resultat initialisieren
	and	a
next:
	rra			; Gerade oder ungerade finden
	jr	nc,even
	add	hl,de		; Zahl addieren
	ret	c		; Fehler
even:
	and	a		; Ende testen
	ret	z
	ex	de,hl
	add	hl,hl
	ex	de,hl
	jr	nc,next
	ret

; Vorzeichenlose Zahlen dividieren

; EIN	Register DE haelt Dividenden
;	Register HL haelt Divisor

; AUS	Register HL haelt Quotienten
;	Register DE haelt Rest
;	Carry wird bei Division durch 0 gesetzt

divide:
	ld	a,h		; Testen Teiler 0
	or	l
	scf
	ret	z		; .. Fehler wenn ja
	ld	b,d
	ld	c,e
	inc	bc		; Dividend + 1
	call	negde		; Wert negieren
	xor	a		; Quotienten Puffer loeschen
	ld	(t?),a
	ld	(t?+1),a
	jr	d?
restor:
	add	hl,bc		; Resultat fixen
d?:
	inc	a		; Zaehler erhoehen
	push	hl
	add	hl,hl		; Divisor verdoppeln
	jr	c,c?
	add	hl,de		; Vergleichen
	jr	nc,restor
c?:
	ld	b,a		; Neuer Zaehler
subtrc:
	pop	hl
	add	hl,de
	jr	c,s?
	ex	de,hl
s?:
	ccf
	ld	a,(t?)
	rla			; Quotienten-Bits schieben
	ld	(t?),a
	ld	a,(t?+1)
	rla
	ld	(t?+1),a
	djnz	subtrc
	ld	hl,(t?)		; Quotienten holen
negde:				; Rest aendern
	ld	a,d
	cpl
	ld	d,a
	ld	a,e
	cpl
	ld	e,a
	ret

; UNIX aehnliche Formatierung durchfuehren

; EIN	Register HL zeigt auf zu formatierende Kette
;	- Abschluss mit 0
;	Register DE zeigt auf Kontrollaray
;	Register BC zeigt auf neue Kette,
;	dessen erstes Byte die maximale Laenge sein muss
; AUS	Neue Kette formatiert, mit Null abgeschlossen
;	Carry wird bei Ueberlauf gesetzt

; Folgende Sequenzen werden unterstuetzt:
; Konvertierung:
;	%c Wandeln in ein Zeichen
;	%s Wandeln in eine Zeichenkette
;	%d Wandeln in einw Dezimalzahl mit Vorzeichen
;	%u Wandeln in eine Dezimalzahl ohne Vorzeichen
;	%x Wandeln in eine Hexzahl
;	%% Wandeln in ein einzelnes Zeichen '%'
;	   Alle anderen Sequenzen werden nicht bearbeitet
; Kontroll-Zeichen:
;	\t Wandeln in einen horizontalen Tabulator
;	\b Wandeln in ein Backspace
;	\f Wandeln in ein Form Feed
;	\r Wandeln in ein Carriage Return
;	\n Wandeln in ein Carriage Return und Line Feed
;	   (Neue Zeile)
;	\\ Wandeln in ein einzelnes Zeichen '\'
;	   Alle anderen Sequenzen werden nicht bearbeitet

printf:
	push	ix
	ld	ix,buffer
	ld	a,(bc)		; Maximale Laenge holen
	dec	a		; .. Null beachten
	ld	(ix),a
	inc	bc
	call	format		; .. Wandlung
	ld	a,(ix)
	pop	ix
	or	a		; Test ok
	ret	nz
	scf
	ret
format:
	ld	a,(hl)
	cp	'%'		; Test Wandlung
	jr	z,do.param
	cp	'\'		; .. oder Kontrolle
	call	z,$contr
..form:
	call	$StCh		; Zeichen speichern
	ret	z		; .. Ende falls Null
	inc	hl
	jr	format
do.param:
	inc	hl
	ld	a,(hl)		; Test Zweitzeichen
	or	a		; Vielleicht Ende
	ret	z		; .. ja
	cp	'%'
	jr	z,..form
	push	hl
	ex	de,hl
	ld	e,(hl)		; Adresse aus Array
	inc	hl
	ld	d,(hl)
	inc	hl
	ex	de,hl
	cp	's'		; Test Zeichenkette
	jr	nz,no.str
mov.str:
	ld	a,(hl)		; Zeichenkette umkopieren
	or	a
	jr	z,job.done	; .. bis zum Ende
	call	$StCh
	inc	hl
	jr	mov.str
no.str:
	cp	'u'		; Test Zahl ohne Vorzeichen
	jr	nz,no.uns
	call	dodec		; .. wandeln
	jr	job.done
no.uns:
	cp	'd'		; Test Zahl mit Vorzeichen
	jr	nz,no.sign
	call	dosign		; .. wandeln
	jr	job.done
no.sign:
	cp	'c'		; Test Zeichen
	jr	nz,no.char
	ld	a,(hl)		; .. holen
	call	$StCh
	jr	job.done
no.char:
	cp	'x'		; Test hex
	jr	nz,default
	call	dohex		; .. wandeln
	jr	job.done
default:
	push	af
	ld	a,'%'
	call	$StCh		; Zeichen speichern
	pop	af
	call	$StCh
job.done:
	pop	hl
	inc	hl
	jr	format
;
; Zahl nach dezimal wandeln
; EIN	Register HL haelt Zeiger auf die Zahl
;	Register BC zeigt auf Puffer
;
dodec:
	xor	a
	dec	a		; Kein Vorzeichen setzen
	jr	to.dec
;
; Zahl nach dezimal mit Vorzeichen wandeln
; EIN	Register HL haelt Zeiger auf die Zahl
;	Register BC zeigt auf Puffer
;
dosign:
	xor	a		; Vorzeichen setzen
to.dec:
	push	hl
	push	de
	ld	e,(hl)		; Zahl laden
	inc	hl
	ld	d,(hl)
	or	a		; Test Vorzeichen
	jr	nz,unsig	; .. nein
	bit	7,d		; Test negativ
	jr	z,unsig		; .. nein
	call	negde		; Wert negieren
	inc	de		; .. 2er Komplement
	ld	a,'-'
	call	$StCh		; Zeichen speichern
unsig:
	ld	(to.where),bc	; Zeiger speichern
	ex	de,hl		; Zahl laden
	call	decout		; .. wandeln
	ld	bc,(to.where)
	pop	de
	pop	hl
	ret
;
; Zahl nach hexadezimal wandeln
; EIN	Register HL haelt Zeiger auf die Zahl
;	Register BC zeigt auf Puffer
;
dohex:
	inc	hl		; .. erst niederwertiges Byte
	call	hexout
	dec	hl		; .. dann hoeherwertig
hexout:
	ld	a,(hl)		; .. Byte laden
	rra			; .. hoeherwertige Bits
	rra
	rra
	rra
	call	outchr		; .. speichern
	ld	a,(hl)		; Dann niederwertige Bits
outchr:
	and	00001111b	; .. Bits maskieren
	add	a,090h		; .. wandeln
	daa
	adc	a,040h
	daa
	call	$StCh
	ret
;
; EIN	Register HL haelt Zahl
;	Register BC zeigt auf Puffer
;	Adresse der Zeichenkette ist vorbereitet
;
decout:
	push	bc
	push	de
	push	hl
	ld	bc,-10		; Werte setzen
	ld	de,-1
dec.loop:
	add	hl,bc		; .. subtrahieren
	inc	de
	jr	c,dec.loop
	ld	bc,10
	add	hl,bc		; .. fixieren
	ex	de,hl
	ld	a,l
	or	h		; Test Null
	call	nz,decout	; .. weiter falls nicht
	ld	a,e
	add	a,'0'		; ASCII Zeichen addieren
	ld	bc,(to.where)
	call	$StCh		; .. speichern
	ld	(to.where),bc
	pop	hl
	pop	de
	pop	bc
	ret

; Kontrollwert in Zeichen wandeln
; EIN	Reg HL zeigt auf Zeichenkette
; AUS	Akku haelt Zeichen

$contr:
	inc	hl
	ld	a,(hl)		; Test doppelte Kontrolle
	cp	'\'
	ret	z		; .. dann Ende
	cp	't'		; Test Tabulator
	jr	nz,??not.t
	ld	a,tab
	ret
??not.t:
	cp	'b'		; Test Backspace
	jr	nz,??not.b
	ld	a,bs
	ret
??not.b:
	cp	'r'		; Test Carriage Return
	jr	nz,??not.r
	ld	a,cr
	ret
??not.r:
	cp	'f'		; Test Form Feed
	jr	nz,??not.f
	ld	a,ff
	ret
??not.f:
	cp	'n'		; Test neue Zeile
	jr	nz,??orig
	ld	a,cr
	call	$StCh		; Return speichern
	ld	a,lf
	ret
??orig:
	ld	a,'\'
	call	$StCh		; Alte Sequenz speichern
	ld	a,(hl)
	ret
;
; Zeichen in Puffer speichern
; EIN	Akku haelt Zeichen
;	Register BC zeigt auf Puffer
;	Register IX zeigt auf verbleibende Laenge
; AUS	Zero gesetzt bei Null
;
$StCh:
	push	af
	ld	a,(ix)
	or	a		; Test noch Platz
	jr	z,popCh		; .. nein
	dec	(ix)		; Runterzaehlen
	pop	af
	ld	(bc),a		; Speichern
	inc	bc
	push	af
	xor	a
	ld	(bc),a		; .. Zeile abschliessen
popCh:
	pop	af
	or	a
	ret

; Mit Null abgeschlossene Zeichenkette auf Konsole ausgeben

; EINT	Register DE zeigt auf Zeichenkette

strcn0:
	push	de
	call	str?		; .. ausgeben
	pop	de
	ret
str?:
	ld	a,(de)		; Zeichen laden
	inc	de
	or	a		; Test Ende
	ret	z		; .. ja
	call	conout		; Normal ausgeben
	jr	str?

; Zeichen auf Konsole ausgeben

; EIN	Akku haelt Zeichen fuer Konsole

conout:
	push	bc
	push	de
	push	hl
	ld	e,a		; Zeichen holen
	ld	c,.conout	; .. auf Konsole
	call	BDOS
	pop	hl
	pop	de
	pop	bc
	ret

; Zeile mit Zeichen von Tastatur fuellen

; EIN	Register DE zeigt auf Start des Puffers
;	Puffer+0 muss maximale Anzahl fuer Eingabe halten
; AUS	Puffer+1 haelt tatsaechliche Anzahl der Zeichen
;	Puffer+2 ist der Start der Zeichen
;	Carry gesetzt falls Puffer leer
;	Die Zeichenkette wird mit Null abgeschlossen

getlin:
	push	bc
	push	hl
	push	de
	ld	c,.rdcon
	call	BDOS		; Zeile lesen
	pop	hl
	push	hl
	inc	hl		; Auf Laenge zeigenength
	ld	c,(hl)
	ld	b,0
	add	hl,bc		; Auf das Ende zeigen
	inc	hl
	ld	(hl),b		; Zeile abschliessen
	ld	a,c		; Laenge holen
	pop	de
	pop	hl
	pop	bc
	or	a
	ret	nz		; Test ob leer
	scf
	ret

; Dezimale ASCII Zeichenkette nach binaer wandeln

; EIN	Register DE zeigt auf Zeichenkette
;	Register B haelt das Endzeichen in der Zeichenkette
;	(typischerweise Null oder $)
;	Falls Register B 255 (hex 0FFH) haelt, endet
;	die Routine beim ersten nicht numerischen Zeichen
; Aus	Register HL haelt Hexzahl
;	Register DE zeigt auf Endzeichen oder nicht
;	numerisches Zeichen
;	Carry gesetzt bei Ueberlauf oder ungueltigem Zeichgen

decin:
	ld	hl,0		; Resultat loeschen
	call	skpblk		; Keine Leerzeichen
dig???:
	ld	a,(de)		; Zeichen holen
	cp	b		; Test Ende
	ret	z
	call	tstdig
	jr	c,tstff		; Test gueltiges Ende
	inc	de
	push	de
	call	mul10		; Mit 10 multiplizieren
	pop	de
	ret	c		; Ueberlauf
	push	bc
	ld	c,a		; Ziffer holen
	ld	b,0
	add	hl,bc		; .. und addieren
	pop	bc
	jr	nc,dig???
	ret
;
; Test gueltiges Ende bei nicht-numerischem Zeichen
; (Register B muss 255 [-1] beinhaten)
;
tstff:
	inc	b		; Result sollte Null sein
	ret	nz
	ccf
	ret
;
; Zahl mit 10 multiplizieren
; EIN	Register HL haelt Zahl
; AUS	Register HL Zahl*10
;	Carry gesetzt bei Ueberlauf
;
mul10:
	ld	d,h		; Originalwert laden
	ld	e,l
	add	hl,hl		; *  2
	ret	c
	add	hl,hl		; *  4
	ret	c
	add	hl,de		; *  5
	ret	c
	add	hl,hl		; * 10
	ret

; Leerzeichen in Zeichenkette ueberspringen
; EIN	Register DE zeigt auf Zeichenkette
; AUS	Register DE zeigt hinter Leerzeichen 

skp???:
	inc	de
skpblk:
	ld	a,(de)
	cp	' '		; Test Leerzeichen
	jr	z,skp???
	cp	tab
	jr	z,skp???	; .. oder Tabulator
	ret

; Test ob Zeichen im Bereich 0 .. 9 liegt

; EIN	Akku haelt Zeichen
; AUS	Carry nicht gesetzt bei 0 .. 9
;	Dann haelt Akku Binaerwert
;	Carry gesetzt bei ungueltigem Zeichen
;	Dann bleibt Akku unveraendert

tstdig:
	cp	'9'+1		; Zeichen testen
	ccf
	ret	c
	cp	'0'
	ret	c
	sub	'0'		; Binaerwert holen
	ret

	dseg

$mess1:	
	db	'\nDas Jahr eingeben bitte ... ',null
$mess2:
	db	'\n Julianischer Kalender kann nicht berechnet werden!\n',null
$mess3:
	db	'      Ostern',null
$mess4:
	db	'   Pfingsten',null
$mess5:
	db	' Himmelfahrt',null
$mess6:
	db	'Fronleichnam',null
$mess7:
	db	'\n%s ist am ',null
@mess7:
	ds	2
$mess8:
	db	'%d.%d.%d',null
@mess8:
	dw	_da,_mo,_x
$line:
	db	4,0
	ds	4+1
_x:
	ds	2
_k:
	ds	2
_l:
	ds	2
_m:
	ds	2
_s:
	ds	2
_a:
	ds	2
_d:
	ds	2
_r:
	ds	2
_og:
	ds	2
_sz:
	ds	2
_oe:
	ds	2
_os:
	ds	2
_da:
	ds	2
_mo:
	ds	2
t?:
	ds	2		; Quotienten Puffer
to.where:
	ds	2
buffer:
	ds	1
$memry:
	ds	2

	ds	2*32
LocStk	equ	$

	end	_main