; **************************************************
; ******************* ADAM_V3 **********************
; **************** rechenprogramm ******************
; ****** verbesserte version : mehr als 5mal *******
; ********** schneller als version 2 !!! ***********
; ************** bcd-codierte zahlen ***************
; ****** dokumentation siehe in file `dokuv3` ******
; **************************************************


; ************ konstanten ************

; vst und nst müssen durch 4 teilbar sein !!!

vst=200;	vorkommastellen
nst=200;	nachkommastellen

variab_anz=10;	anzahl der zahlenvariablen
rech_anz=5;	anzahl der rechenfelder
dez_anz=3;	anzahl der konstanten

vsb=vst/2
nsb=nst/2
st=vst+nst
sb=vsb+nsb
st1=sb+2
st2=sb+4
st3=sb+6
ast1=st+2
ast2=st+4
ast3=st+6

rt1_gr=sb*3+50
tabr_gr=sb+4*21+50
feldgr=sb+10

; libraryoffsets

allocmem=-198
freemem=-210
openlib=-552
closelib=-414
open=-30
close=-36
read=-42
write=-48
input=-54
forbid=-132
permit=-138
mode_old=1005
mode_new=1006


; *************** makros ****************

; 1 --> startadresse  2 --> end-adresse
prtxt:	macro
		move.l	#?1*8,d3
		bsr	print_text
endm

; 1 --> anzahl der zeichen
p_buf:	macro
		moveq	#?1,d3
		bsr	print_buf
	endm

; 1 --> startadresse  2 --> länge
print:	macro
		lea	?1(pc),a0
		moveq	#?2,d3
		bsr	print_sub
	endm


; ************ hauptprogramm ************

x:
	movem.l	d1-d7/a0-a6,-(sp)
	lea	stackpt(pc),a0
	move.l	a7,(a0)

	lea	fdruck(pc),a0
	clr.w	(a0)

	bra	allocmemory
alloc_rueck:
	bra	openwind
openw_rueck:
	bra	st_pruefen
st_pr_rueck:
	bra	dezwandel
haupt:
	prtxt	10;		hauptmenubild malen
	move.w	#vst,d4
	bsr	zahlaus
	move.l	buffer(pc),a0
	move.l	#$0a099b36,(a0)+
	move.b	#$43,(a0)
	p_buf	5
	move.w	#nst,d4
	bsr	zahlaus

readfunk:
	move.l	buffer(pc),a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	cmp.b	#$1b,(a4)
	beq.s	a
	cmp.b	#$9b,(a4)
	bne.s	readfunk

	addq.l	#1,a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#4,d3
	jsr	read(a6)

	move.b	(a4),d4
	lea	cmp_tab(pc),a3
	moveq	#4,d5
suchz:
	cmp.b	(a3)+,d4
	beq.s	gefund
	dbf	d5,suchz

	bra.s	readfunk
pidisp:
	bsr	pi1
	bra	haupt
help1:
	bsr	helptext
	bra	haupt
change_lang:
	lea	text_tab+4(pc),a0
	tst.l	(a0)
	beq.s	text_ger_eng

	clr.l	(a0)
	bra	haupt
text_ger_eng:
	move.l	#eng_ttab-text_tabanf,(a0)
	bra	haupt

gefund:
	print	sicht,3
	lea	cmp_tab(pc),a3

	cmp.b	(a3)+,d4
	beq.s	a
	cmp.b	(a3)+,d4
	beq.s	rechnen
	cmp.b	(a3)+,d4
	beq.s	pidisp
	cmp.b	(a3)+,d4
	beq.s	help1
	cmp.b	(a3)+,d4
	beq.s	change_lang

a:
	move.l	conhandle(pc),d1
	jsr	close(a6)
close_dos:
	move.l	4.w,a6
	move.l	dosbase(pc),a1
	jsr	closelib(a6)
dosoperr:

	bra	freememory
freem_rueck:

ende:
	move.l	stackpt(pc),a7
	movem.l	(a7)+,d1-d7/a0-a6
	moveq	#0,d0

	rts


; ************ rechnen *************

rechnen:
	bsr	bild

	move.l	bcd1(pc),a0
	bsr	zahlein
kopin:
	move.l	buffer(pc),a0
	bsr	feldloesch

	bra	operand
rueckoperand:
	move.l	bcd2(pc),a0
	bsr	zahlein

	bra	operation
rueck1:
	bra	ergebnis
rueck2:
	prtxt	2
readin:
	move.l	buffer(pc),a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#2,d3
	jsr	read(a6)

	cmp.b	#$1b,(a4)
	beq	haupt
	cmp.b	#$9b,(a4)
	bne.s	readin

	addq.l	#1,a4
	move.l	conhandle(pc),d1
	moveq	#2,d3
	jsr	read(a6)

	move.b	-1(a4),d0

	cmp.b	#$30,d0
	beq	haupt
	cmp.b	#$31,d0
	beq	rechnen
	cmp.b	#$32,d0
	beq.s	nochmalkop
	cmp.b	#$33,d0
	beq.s	format_ae
	cmp.b	#$34,d0
	beq.s	speich_nochm
	cmp.b	#$35,d0
	beq.s	help2

	bra	readin
nochmalkop:
	bsr	bild
	move.l	bcd1(pc),a0
	bsr	druck
	bra	kopin
format_ae:
	lea	format(pc),a0
	tst.b	(a0)
	bne.s	formj_n

	move.b	#1,(a0)
	prtxt	39
	bra	rueck2
formj_n:
	clr.b	(a0)
	prtxt	38
	bra	rueck2
speich_nochm:
	move.l	bcd1(pc),a0
	move.l	speicher(pc),a1
	bsr	kopieren
	bra	rechnen
help2:
	bsr	helptext
	bsr	bild
	move.l	bcd1(pc),a0
	bsr	druck
	prtxt	2
	bra	readin
bild:
	prtxt	7
	move.l	speicher(pc),a0
	bsr	druck
	print	home,2
	rts
helptext:
	prtxt	1
	bsr	r_buf
	print	sicht,3
	rts


;********** weitere makros ***************

mkopieren:	macro
	move.l	?1,a0
	move.l	?2,a1
	bsr	kopieren
endm
mquadrat:	macro
	move.l	?1,a0
	bsr	quadrat
endm
mfeldloesch:	macro
	move.l	?1,a0
	bsr	feldloesch
endm
mplusu:	macro
	move.l	?1,a0
	move.l	?2,a1
	bsr	plusu
endm
mminusu:	macro
	move.l	?1,a0
	move.l	?2,a1
	bsr	minusu
endm
mmals:	macro
	move.l	?1,a0
	move.l	?2,a1
	bsr	mals
endm
mdiv:	macro
	move.l	?1,a0
	move.l	?2,a1
	bsr	div
endm
mdruck:	macro
	move.l	?1,a0
	bsr	druck
endm
mincrem:	macro
	move.l	?1,a0
	bsr	increm
endm
mveru:	macro
	move.l	?1,a0
	move.l	?2,a1
	bsr	veru
endm

mal10:	macro;	multipliziert ein register mit #10
	move.w	?1,d0
	add.w	d0,d0
	add.w	d0,d0
	add.w	d0,?1
	add.w	?1,?1
endm


;************* fehlermeldungen **************

allocerr:
	move.l	4.w,a6
	lea	dosname(pc),a1
	moveq	#0,d0
	jsr	openlib(a6);	dos.library öffnen
	lea	dosbase(pc),a0
	move.l	d0,(a0)
	beq	dosoperr

	move.l	dosbase(pc),a6
	jsr	-54(a6)
	lea	conhandle(pc),a0
	move.l	d0,(a0)
	beq	close_dos

	prtxt	44

	bra	close_dos
vst_nst_falsch:
	bsr	prtxt12
	prtxt	6
	print	lflf,2
	prtxt	13
	bsr	r_buf
	bra	a
st3fehler:
	bsr	prtxt12
	prtxt	14
	bra	fehleraus
div_null:
	bsr	prtxt12
	prtxt	21
	bra	fehleraus
sqr_negativ:
	bsr.s	prtxt12
	prtxt	15
	bra.s	fehleraus
add_uberlauf:
	bsr.s	prtxt12
	prtxt	27
	bra.s	fehleraus
mal_uberlauf:
	bsr.s	prtxt12
	prtxt	29
	bra.s	fehleraus
div_uberlauf:
	bsr.s	prtxt12
	prtxt	28
	bra.s	fehleraus
fakfehler:
	bsr.s	prtxt12
	prtxt	34
fehleraus:
	print	lflf,2
	prtxt	13
	bsr	r_buf

	move.l	stackpt(pc),a7
	bra	haupt
prtxt12:
	prtxt	12
	rts

;************* unterprogramme **************

;----------------------------------

openwind:
	move.l	4.w,a6
	lea	dosname(pc),a1
	moveq	#0,d0
	jsr	openlib(a6);	dos.library öffnen
	lea	dosbase(pc),a0

	move.l	d0,(a0)
	beq	dosoperr

; maximale fenstergröße suchen

	lea	intname(pc),a1
	moveq	#33,d0
	jsr	openlib(a6);	intuition.lib öffnen
	tst.l	d0
	beq.s	no_intui
	move.l	d0,a6

	move.l	56(a6),a1;	aktueller screen

	lea	windsize(pc),a0
	moveq	#0,d0
	move.w	12(a1),d0;	smax_width
	moveq	#10,d1
	moveq	#$30,d2

	bsr.s	maked0

	move.b	#`/`,(a0)+
	moveq	#0,d0
	move.w	14(a1),d0;	smax_height

	bsr.s	maked0

	move.l	a6,a1
	move.l	4.w,a6
	jsr	closelib(a6)
no_intui:
	move.l	dosbase(pc),a6

	lea	name(pc),a0
	move.l	a0,d1
	move.l	#mode_old,d2
	jsr	open(a6);	fenster öffnen
	lea	conhandle(pc),a0
	move.l	d0,(a0)
	beq.s	no_window

	bra	openw_rueck
no_window:
	jsr	-54(a6)
	lea	conhandle(pc),a0
	move.l	d0,(a0)
	beq	close_dos

	prtxt	45

	bra	close_dos


maked0:
	divu	d1,d0
	swap	d0
	add.b	d2,d0
	move.w	d0,-(sp)
	clr.w	d0
	swap	d0

	divu	d1,d0
	swap	d0
	add.b	d2,d0
	move.w	d0,-(sp)
	swap	d0

	add.b	d2,d0
	move.b	d0,(a0)+

	move.w	(sp)+,d0
	move.b	d0,(a0)+
	move.w	(sp)+,d0
	move.b	d0,(a0)+

	rts

;----------------------------------

st_pruefen:
	move.w	#vst,d4
	cmp.w	#30000,d4
	bhs	vst_nst_falsch
	cmp.w	#20,d4
	blo	vst_nst_falsch
	and.w	#%11,d4
	bne	vst_nst_falsch

	move.w	#nst,d4
	cmp.w	#30000,d4
	bhs	vst_nst_falsch
	cmp.w	#20,d4
	blo	vst_nst_falsch
	and.w	#%11,d4
	bne	vst_nst_falsch

	bra	st_pr_rueck

;----------------------------------

; 1 ---> länge
; 2 ---> adresse

alloc:	macro
	move.l	#?1,d0
	move.l	d6,d1
	jsr	allocmem(a6)
	tst.l	d0
	beq	allocerr

	move.l	#?1,(a4)+
	move.l	d0,(a4)+
	lea	?2(pc),a0
	move.l	d0,(a0)
endm


; der belegte speicher wird in die memlist eingetragen,
; die mit 0,0 abgeschlossen ist.

allocmemory:
	move.l	4.w,a6
	lea	memlist(pc),a4
	moveq	#29,d0
alloccl:
	clr.l	(a4)+
	dbf	d0,alloccl

	lea	memlist(pc),a4
	move.l	#$10000,d6

; speicher für buffer, byte1, rt1, r1 und tabr

	alloc	st+48,buffer
	alloc	rt1_gr,rt1
	alloc	tabr_gr,tabr
	alloc	st+10,byte1
	alloc	st+10,r1
	alloc	sb+10,pi

; speicher für variablen speicher,bcd1-9

	move.w	#feldgr,d0
	mulu	#variab_anz,d0
	move.l	d0,d7
	move.l	d6,d1
	jsr	allocmem(a6)
	tst.l	d0
	beq	allocerr

	move.l	d7,(a4)+
	move.l	d0,(a4)+

	moveq	#variab_anz-1,d1
	lea	speicher(pc),a0
makev:
	move.l	d0,(a0)+
	add.l	#feldgr,d0
	dbf	d1,makev

; speicher für rechenfelder sqr1-4,quadrat

	move.w	#feldgr,d0
	mulu	#rech_anz,d0
	move.l	d0,d7
	move.l	d6,d1
	jsr	allocmem(a6)
	tst.l	d0
	beq	allocerr

	move.l	d7,(a4)+
	move.l	d0,(a4)+

	moveq	#rech_anz-1,d1
	lea	sqr1(pc),a0
makerech:
	move.l	d0,(a0)+
	add.l	#feldgr,d0
	dbf	d1,makerech

; speicher für konstantenfelder dez1-6

	move.w	#feldgr,d0
	mulu	#dez_anz,d0
	move.l	d0,d7
	move.l	d6,d1
	jsr	allocmem(a6)
	tst.l	d0
	beq	allocerr

	move.l	d7,(a4)+
	move.l	d0,(a4)+

	moveq	#dez_anz-1,d1
	lea	dez1(pc),a0
makedez:
	move.l	d0,(a0)+
	add.l	#feldgr,d0
	dbf	d1,makedez

	clr.l	(a4)+
	clr.l	(a4)

	bra	alloc_rueck

;----------------------------------

freememory:
	move.l	4.w,a6
	lea	memlist(pc),a4
freem_in:
	move.l	(a4)+,d0
	beq.s	freem_aus
	move.l	(a4)+,a1
	jsr	freemem(a6)

	bra.s	freem_in
freem_aus:
	bra	freem_rueck

;----------------------------------

; diese routine kopiert alle zahlenkonstanten in die
; konstantenfelder dez1, dez2, ...

dezwandel:
	movem.l	d0-d7/a0-a3,-(sp)

	moveq	#dez_anz-1,d6
	lea	dezdat1(pc),a0
	lea	dez1(pc),a3
	move.l	byte1(pc),a2
wanf:
	move.l	a2,a1
	move.w	#st/2+3,d0
clrb1:
	clr.w	(a1)+
	dbf	d0,clrb1

	move.l	a2,a1
	move.w	(a0)+,ast1(a2)
	move.w	(a0)+,ast2(a2)
	move.w	(a0)+,ast3(a2)

	cmp.w	#1,ast3(a2)
	beq.s	gerade

	tst.w	ast1(a2)
	beq.s	nachw

	move.w	ast1(a2),d5
	move.l	#vst,d4
	sub.w	d5,d4
	add.l	d4,a1
	subq.w	#1,d5
vorwand:
	move.b	(a0)+,(a1)+
	dbf	d5,vorwand
nachw:
	tst.w	ast2(a2)
	beq.s	wandaus

	move.l	byte1(pc),a1
	move.w	ast2(a2),d5
	subq.w	#1,d5
	add.l	#vst,a1
nachwand:
	move.b	(a0)+,(a1)+
	dbf	d5,nachwand
wandaus:
	move.l	a0,d0

	btst	#0,d0
	beq	gerade
ungerade:
	addq.l	#1,a0
gerade:
	movem.l	a0/a1,-(sp)
	move.l	byte1(pc),a0
	move.l	(a3)+,a1
	bsr	wandbyte_bcd;	zahl in bcd-format wandeln
	movem.l	(sp)+,a0/a1

	dbf	d6,wanf

	mfeldloesch	speicher(pc)

	mkopieren	dez1(pc),bcd1(pc)
	mdiv		dez3(pc),bcd1(pc)
	mkopieren	bcd1(pc),dez3(pc)

; pi einlesen

	move.l	pi(pc),a0
	bsr	feldloesch
	move.b	#3,vsb-1(a0)
	move.w	#1,st1(a0)
	move.w	#2,st3(a0)

	move.l	a0,a4

	lea	piname(pc),a0
	move.l	a0,d1
	move.l	#mode_old,d2
	jsr	open(a6)
	move.l	d0,d7;		datei öffnen
	beq.s	pi_notfound

	move.l	d7,d1
	move.l	pi(pc),d2
	add.l	#vsb,d2
	move.l	#nsb,d3
	cmp.w	#2000,d3
	bls.s	pireadd3ok
	move.l	#2000,d3
pireadd3ok:
	jsr	read(a6);		datei schreiben

	move.l	d7,d1
	jsr	close(a6);		und wieder schließen

; nachkommastellenzahl von pi ermitteln

	move.l	a4,a0
	move.l	a0,a1
	add.l	#sb,a0
	move.w	#nsb,d0
pinachm:
	tst.b	-(a0)
	bne.s	pinachex

	subq.w	#1,d0
	bne.s	pinachm

	bra.s	pinachaus
pinsubeine:
	subq.w	#1,d0
	bra.s	pinachaus
pinachex:
	add.w	d0,d0
	move.b	(a0),d1
	lsl.b	#4,d1
	beq.s	pinsubeine
pinachaus:
	move.w	d0,st2(a1)
	bra.s	piliesaus
pi_notfound:
	prtxt	41
	bsr	r_buf
	move.l	#$14159265,vsb(a4)
	move.w	#8,st2(a4)
piliesaus:
	movem.l	(sp)+,d0-d7/a0-a3

	bra	haupt

;----------- operand nach op holen ------------

operand:
	print	miplu+1,4
opin:
	move.l	conhandle(pc),d1
	lea	op(pc),a2
	move.l	a2,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a2),d4

	cmp.b	#"+",d4
	beq.s	op1
	cmp.b	#"-",d4
	beq.s	op1
	cmp.b	#"*",d4
	beq.s	op1
	cmp.b	#"/",d4
	beq.s	op1
	cmp.b	#"v",d4
	beq.s	op1
	cmp.b	#"m",d4
	beq.s	op1
	cmp.b	#"s",d4
	beq.s	op1
	cmp.b	#"q",d4
	beq.s	op1
	cmp.b	#"w",d4
	beq.s	op1
	cmp.b	#"!",d4
	beq.s	op1
	cmp.b	#"i",d4
	beq.s	op1
	cmp.b	#"k",d4
	beq.s	op1
	cmp.b	#"S",d4
	beq.s	op1
	bra 	opin
op1:
	print	op,1
op2:
	move.l	conhandle(pc),d1
	lea	op+1(pc),a0
	move.l	a0,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	op+1(pc),d4
	cmp.b	#$d,d4
	beq.s	opaus
	cmp.b	#8,d4
	beq.s	oploe
	bra.s	op2
oploe:
	bsr	backspace
	bra	opin
opaus:
	lea	op(pc),a0
	move.b	(a0),d4
	cmp.b	#"m",d4
	beq.s	memin
	cmp.b	#"s",d4
	beq.s	opwurzel
	cmp.b	#"q",d4
	beq.L	opquadrat
	cmp.b	#"w",d4
	beq	opwechsel
	cmp.b	#"!",d4
	beq	opfak
	cmp.b	#"k",d4
	beq	opkehr
	cmp.b	#"i",d4
	beq	opinteg
	cmp.b	#"S",d4
	beq	opsin

	bsr	lf_cr
	bra	rueckoperand

;---------- speichern ---------------

memin:
	mkopieren	bcd1(pc),speicher(pc)
	bra	rechnen

;------------ wurzelziehen -----------------

opwurzel:
	prtxt	8
	move.l	bcd1(pc),a0
	bsr	sqrroot
	mdruck	bcd1(pc)
	bra	rueck2

;-------------- quadrieren -----------------

opquadrat:
	prtxt	9
	mquadrat	bcd1(pc)
	mdruck		bcd1(pc)
	bra	rueck2

;------------ vorzeichen wechseln ------------

opwechsel:
	prtxt	35
	move.l	bcd1(pc),a0
	bsr	vorz_wechsel
	mdruck	bcd1(pc)
	bra	rueck2

;------------ fakultät ------------

opfak:
	prtxt	20
	move.l	bcd1(pc),a0
	bsr	fakultaet
	mdruck	bcd1(pc)
	bra	rueck2

;------------ kehrwert ------------

opkehr:
	prtxt	36
	mkopieren	bcd1(pc),bcd2(pc)
	mkopieren	dez1(pc),bcd1(pc)
	mdiv		bcd2(pc),bcd1(pc)
	mdruck		bcd1(pc)
	bra	rueck2

;------------ integer ------------

opinteg:
	prtxt	37
	move.l	bcd1(pc),a0
	bsr	integer
	mdruck	bcd1(pc)
	bra	rueck2

;------------ fakultät ------------

opsin:
	prtxt	42
	move.l	bcd1(pc),a0
	bsr	sinus
	mdruck	bcd1(pc)
	bra	rueck2

;---------- operation ausführen -----------

operation:
	lea	op(pc),a0
	move.b	op(pc),d4
	cmp.b	#"v",d4
	beq	vergleich
	cmp.b	#"+",d4
	beq.s	opplus
	cmp.b	#"-",d4
	beq.s	opminus
	cmp.b	#"*",d4
	beq.s	opmal
	cmp.b	#"/",d4
	beq.s	opdiv

	bra	a
opplus:
	move.l	bcd2(pc),a0
	move.l	bcd1(pc),a1
	bsr	pluss
	bra.s	operationaus
opminus:
	move.l	bcd2(pc),a0
	move.l	bcd1(pc),a1
	bsr	minuss
	bra.s	operationaus
opmal:
	move.l	bcd2(pc),a0
	move.l	bcd1(pc),a1
	bsr	mals
	bra.s	operationaus
opdiv:
	move.l	bcd2(pc),a0
	move.l	bcd1(pc),a1
	bsr	div
	bra.s	operationaus
vergleich:
	move.l	bcd1(pc),a0
	move.l	bcd2(pc),a1
	bsr	vers
operationaus:
	bra	rueck1

;---------- ergebnis ausgeben -----------

ergebnis:
	lea	op(pc),a0
	cmp.b	#"v",(a0)
	beq.s	verglergebnis

	print	ergeb,8
	mdruck	bcd1(pc)

	bra.s	ergaus
verglergebnis:
	cmp.w	#1,(a0)
	beq.s	glei
	cmp.w	#2,(a0)
	beq.s	v1gr2
	prtxt	5
	bra.s	ergaus
glei:
	prtxt	3
	bra.s	ergaus
v1gr2:
	prtxt	4
ergaus:
	bra	rueck2

;************** subroutinen **************

;========== zeichenausgabe ==========

lf_cr:
	print	lflf,1
	rts
backspace:
	print	bs1,3
	rts

; liest ein zeichen in feld `buffer`
r_buf:
	move.l	conhandle(pc),d1
	move.l	buffer(pc),d2
	moveq	#1,d3
	jsr	read(a6)
	rts

; subroutinen für die macros prtxt, p_buf und print

print_text:
	lea	text_tab(pc),a0
	move.l	(a0)+,d1
	move.l	(a0)+,d2
	add.l	d3,a0
	add.l	d2,a0
	move.l	(a0)+,d2
	move.l	(a0)+,d3
	jsr	write(a6)
	rts
print_buf:
	move.l	conhandle(pc),d1
	move.l	buffer(pc),d2
	jsr	write(a6)
	rts
print_sub:
	move.l	conhandle(pc),d1
	move.l	a0,d2
	jsr	write(a6)
	rts

;============================================

; zahl in d4 (wort)

zahlaus:
	movem.l	d0-d5/a4/a5,-(sp)

	tst.w	d4
	beq.s	znull

	move.l	buffer(pc),a4
	and.l	#$ffff,d4
dodez:
	move.l	d4,d5
	divu	#10,d5
	move.w	d5,d4
	swap	d5
	add.b	#$30,d5
	move.b	d5,(a4)+

	tst.w	d4
	bne.s	dodez

	move.l	buffer(pc),d5
	move.l	d5,a5
	addq.l	#5,a5
	addq.l	#5,a5
	move.l	a5,d2
	sub.l	a4,d5
	neg.l	d5
	move.l	d5,d3
zahlin:
	move.b	-(a4),(a5)+
	dbf	d5,zahlin

	move.l	conhandle(pc),d1
	jsr	write(a6)
	bra.s	zahlausex
znull:
	print	nu,1
zahlausex:
	movem.l	(sp)+,d0-d5/a4/a5

	rts

;==========================================

; stellenzahl in d4

rechts:
	movem.l	d4/a0,-(sp)

	lea	r(pc),a0
	move.l	a0,d2

	move.b	#$9b,(a0)+

	and.l	#$ffff,d4
	divu	#10,d4
	tst.b	d4
	beq.s	nur_eine

	add.b	#$30,d4
	move.b	d4,(a0)+
nur_eine:
	swap	d4

	add.w	#$30,d4
	move.b	d4,(a0)+

	move.b	#$43,(a0)+

	move.l	conhandle(pc),d1
	move.l	a0,d3
	sub.l	d2,d3
	jsr	write(a6)

	movem.l	(sp)+,d4/a0

	rts

;===========================================

nullsetzen:
	move.l	buffer(pc),a0
	move.w	#st2+1,d4
nullsetz1:
	clr.b	(a0)+
	dbf	d4,nullsetz1

	moveq	#variab_anz,d4
	subq.w	#1,d4
	lea	buffer(pc),a1
nullsetz2:
	move.l	(a1)+,a0
	bsr	feldloesch
	dbf	d4,nullsetz2

	clr.l	-(sp)
	movem.l	(sp),d0-d7/a0-a5
	addq.l	#4,sp

	lea	op(pc),a0
	clr.b	(a0)

	rts

;================================================

; diese routine liest eine zahl in das feld ein, das in a0
; angegeben ist

zahlein:
	movem.l	d4-d7/a0-a5,-(sp)

; (a5) : punknum
; 2(a5) : vor
; 4(a5) : nach
; 6(a5) : vorzei
vorp=2
nachp=4
vorzeip=6

	move.l	a0,a3
	bsr	feldloesch

	lea	punknum(pc),a5
	clr.l	(a5)
	clr.w	4(a5)
	clr.b	6(a5)

	print	miplu+1,4
	move.l	buffer(pc),a4
ein2:	
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#$d,d4
	beq	return
	cmp.b	#8,d4
	beq	fbackspace
	cmp.b	#"-",d4
	beq	minzei
	cmp.b	#".",d4
	beq	punkt
	cmp.b	#"0",d4
	beq	zeinull
	cmp.b	#"m",d4
	beq	memory_pi
	cmp.b	#"p",d4
	beq	memory_pi
	cmp.b	#$30,d4
	blo.s	ein2
	cmp.b	#$39,d4
	bhi.s	ein2
zeichein:
	tst.w	(a5)
	beq.s	verglvor

	cmp.w	#nst,nachp(a5)
	beq.s	ein2

	bra.s	verglnach
zeinull:
	cmp.l	buffer(pc),a4
	beq	ein2
	bra.s	zeichein
verglvor:
	cmp.w	#vst,vorp(a5)
	beq	ein2
verglnach:
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	write(a6)

 	tst.w	(a5)
	beq.s	vorincrem

	addq.w	#1,nachp(a5)
	bra	vorret
vorincrem:
	addq.w	#1,vorp(a5)
vorret:
	addq.l	#1,a4
	bra	ein2
memory_pi:
	cmp.l	buffer(pc),a4
	bne	ein2

	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	write(a6)
	addq.l	#1,a4
mem:
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#$d,d4
	beq.s	memaus
	cmp.b	#$8,d4
	beq.s	mback
	bra.s	mem
mback:
	bsr	backspace
	move.l	buffer(pc),a4
	clr.w	(a4)
	bra	ein2
memaus:
	cmp.b	#"m",-1(a4)
	beq.s	memsp

	move.l	pi(pc),a0
	bra.s	memsp1
memsp:
	move.l	speicher(pc),a0
memsp1:
	move.l	a3,a1
	bsr	kopieren
	print	plumi,1
	move.l	a3,a0
	bsr	druck
	bra	zahleinex1
return:
	cmp.l	buffer(pc),a4
	beq	nullzahl

	tst.w	nachp(a5)
	bne	nulloesch
loein:
	move.l	a4,d6
	sub.l	buffer(pc),d6

	cmp.w	(a5),d6
	beq	punktloesch

	bra	einaus
nullzahl:
	cmp.b	#1,vorzeip(a5)
	beq.s	minloe
minloeret:
	print	nu,1
	bra	zahleinex
minloe:
	move.l	byte1(pc),a0
	move.l	a0,d2
	move.l	#$0d3e2020,(a0)+
	move.b	#$20,(a0)+
	move.l	conhandle(pc),d1
	moveq	#5,d3
	jsr	write(a6)

	clr.b	vorzeip(a5)
	bra.s	minloeret
nulloesch:
	move.l	buffer(pc),a0
	add.w	vor(pc),a0
	add.w	nach(pc),a0

	cmp.b	#$30,(a0)
	beq.s	nullo
	bra	loein
nullo:
	subq.w	#1,nachp(a5)
	subq.l	#1,a4
	bsr	backspace
	bra	nulloesch
punktloesch:
	bsr	backspace
	move.l	a4,d4
	subq.l	#1,d4

	cmp.l	buffer(pc),d4
	beq	nullzahl
einaus:
	moveq	#0,d4
	moveq	#0,d5
	moveq	#0,d6
	move.w	vor(pc),d4
	move.w	nach(pc),d5
	move.b	vorzei(pc),d6
	move.l	buffer(pc),a2
	move.l	a3,a4
	move.l	byte1(pc),a3

	move.l	a3,a0
	move.w	#st/2+3,d7
lbyte1:
	clr.w	(a0)+
	dbf	d7,lbyte1

	bsr	mittwandord
	move.l	byte1(pc),a0
	move.l	a4,a1
	bsr	wandbyte_bcd
zahleinex:
	bsr	lf_cr
zahleinex1:
	movem.l	(sp)+,d4-d7/a0-a5

	rts

;------------ backspace ------------ 

fbackspace:
	cmp.l	buffer(pc),a4
	beq	ein2

	move.l	buffer(pc),a0
	addq.l	#1,a0

	cmp.l	a0,a4
	beq	loeschen

	addq.l	#1,a0

	cmp.l	a0,a4
	beq	loeschen2
rueckk:
	tst.w	(a5)
	bne	backpunkt
backein:
	bsr	backspace

	tst.w	(a5)
	beq.s	vordecr

	subq.w	#1,nachp(a5)
	bra.s	backweiter
vordecr:
	subq.w	#1,vorp(a5)
backweiter:
	clr.b	(a4)
	subq.l	#1,a4

	bra 	ein2
loeschen:
	cmp.w	#1,(a5)
	beq	nullpuloe

	tst.b	vorzeip(a5)
	beq.s	backein

	move.l	buffer(pc),a0
	move.l	#$08200d3e,(a0)+
	move.l	#$20202020,(a0)+
	p_buf	8

	subq.w	#1,vorp(a5)
	subq.l	#1,a4
	clr.b	vorzeip(a5)
	bra	ein2
loeschen2:
	cmp.w	#1,(a5)
	bne	rueckk

	lea	vorzei(pc),a0
	tst.b	(a0)
	beq	rueckk

	move.l	buffer(pc),a0
	move.l	#$9b302070,(a0)+
	move.l	#$08200d3e,(a0)+
	move.l	#$20209b31,(a0)+
	move.l	#$439b2070,(a0)
	p_buf	16

	subq.w	#1,a4
	subq.w	#1,nachp(a5)
	clr.b	vorzeip(a5)
	bra	ein2
backpunkt:
	move.l	buffer(pc),d5
	move.l	a4,d6
	sub.l	d5,d6

	cmp.w	(a5),d6
	bne	backein

	clr.w	(a5)
	addq.w	#1,vorp(a5)
	bra	backein
nullpuloe:
	subq.l	#1,a4
	clr.w	(a5)
	bsr	backspace

	bra	ein2

;-------- minuszeichen --------------

minzei:
	cmp.l	buffer(pc),a4
	beq	ein2

	move.l	buffer(pc),a0
	addq.l	#1,a0

	cmp.l	a0,a4
	beq.s	stell1
	bra.s	stellgr1
stell1:
	cmp.b	#`.`,-1(a4)
	beq	ein2
stellgr1:
	tst.b	vorzeip(a5)
	beq.s	plumin

	print	miplu,4
	clr.b	vorzeip(a5)
	bra.s	wechsaus
plumin:
	print	plumi,4
	move.b	#1,vorzeip(a5)
wechsaus:
	move.l	a4,d6
	sub.l	buffer(pc),d6
	addq.w	#1,d6

	move.w	d6,d4
	bsr	rechts

	bra	ein2

;---------------- punkt ----------------

punkt:
	tst.w	(a5)
	bne	ein2

	print	pu,1

	move.l	a4,d7
	sub.l	buffer(pc),d7
	lea	punknum(pc),a0
	move.w	d7,(a0)
	addq.w	#1,(a0)

	addq.l	#1,a4
	bra	ein2

;============================================

; quelladresse in a2 , zieladrsse in a3
; vorkomma in d4 , nachkomma in d5
; vorzeichen in d6 : 0 = + , 1 = -

mittwandord:
	movem.l	d0-d7/a0-a5,-(sp)
	move.w	d4,ast1(a3)
	move.w	d5,ast2(a3)

	cmp.w	#1,d6
	beq.s	vorz_min

	tst.w	d4
	beq.s	vor_nix
mrueck3:
	move.w	#2,ast3(a3)
	bra	anford
vor_nix:
	tst.w	d5
	beq.s	mittwausnull
	bra.s	mrueck3
vorz_min:
	move.w	#3,ast3(a3)
anford:
	move.l	d4,d6
	move.l	a2,a4
	move.l	a3,a5

	tst.w	d4
	beq.s	s2

	add.l	d4,a2
	add.l	#vst,a3
	subq.w	#1,d4
s1:
	move.b	-(a2),-(a3)
	sub.b	#$30,(a3)
	dbf	d4,s1
s2:
	tst.w	d5
	beq.s	s4

	cmp.b	#$2e,(a2)
	beq.s	nullp
	bra.s	nuk
nullp:
	addq.l	#1,a2
nuk:
	move.l	a4,a2
	move.l	a5,a3
	add.l	d6,a4
	add.l	#vst,a5
	addq.l	#1,a4
	subq.w	#1,d5
s3:
	move.b	(a4)+,(a5)+
	sub.b	#$30,-1(a5)
	dbf	d5,s3
s4:
	bra.s	mittwaus
mittwausnull:
	move.w	#1,ast3(a3)
	move.l	a3,a0
	bsr	feldloesch
mittwaus:
	movem.l	(sp)+,d0-d7/a0-a5
	rts

;====================================================

; adresse des feldes in a0
; außerdem wichtige variablen :
;	fdruck : 0 = druck im fenster, 1 = druck in datei
;	format : 0 = druck nicht formatiert, 1 = druck formatiert

druck:
	bsr	testa0

	movem.l	d0-d7/a0-a6,-(sp)

	lea	fehler(pc),a1
	clr.w	(a1)

	move.l	byte1(pc),a1
	bsr	wandbcd_byte
	move.l	a1,a0

	move.l	a0,a1
	move.l	buffer(pc),a2

	cmp.w	#1,ast3(a0)
	beq.s	dnullzahl

	cmp.w	#3,ast3(a0)
	beq.s	negativ
positiv:
	move.l	#$3e202020,(a2)+
	bra.s	dru1
negativ:
	move.l	#$3e202d20,(a2)+
dru1:
	tst.b	fdruck
	bne.s	nouns
	move.l	#$9b302070,(a2)+
nouns:
	moveq	#0,d4
	moveq	#0,d5
	moveq	#0,d7

	move.w	ast1(a0),d4
	move.w	ast2(a0),d5

	tst.w	d4
	beq.s	drvornull

	bra.s	vorkop
drvornull:
	move.w	#$302e,(a2)+
	bra.s	nachkop
dnullzahl:
	move.l	#$3e202020,(a2)+
	move.b	#$30,(a2)+
	bra	ausdruck
vorkop:
	subq.w	#1,d4
	move.l	#vst,d6
	sub.w	ast1(a0),d6
	add.l	d6,a1
vkop:
	move.b	(a1)+,(a2)
	add.b	#$30,(a2)+
	dbf	d4,vkop

	tst.w	ast2(a0)
	beq	ausdruck

	move.b	#$2e,(a2)+
nachkop:
	move.l	a0,a1
	move.w	ast2(a0),d4
	subq.w	#1,d4
	move.l	a0,a1
	add.l	#vst,a1
	lea	z1(pc),a3
	move.w	#5,(a3)
	move.w	#11,2(a3)
	moveq	#0,d7

	tst.b	format
	beq.s	nkop

	move.w	#$30,4(a3)
	move.b	#$a,(a2)+
	move.b	#$30,(a2)+
	move.b	#$20,(a2)+
nkop:
	move.b	(a1)+,d0

	tst.b	format
	beq.s	z1rueck

	subq.w	#1,(a3)
	bcs.s	z1neu
z1rueck:
	add.b	#$30,d0
	move.b	d0,(a2)+
	dbf	d4,nkop

	bra.s	ausdruck
z1neu:
	move.b	#$20,(a2)+
	addq.w	#1,d7
	cmp.w	#6,d7
	beq.s	zd71w
zd71r:
	move.w	#4,(a3)
	subq.w	#1,2(a3)
	bcc.s	z1rueck
	move.b	#$a,(a2)+
	move.w	#11,2(a3)
	moveq	#0,d7
	addq.w	#1,4(a3)
	cmp.w	#$39,4(a3)
	bhi.s	z3neu
z3ok:
	move.b	z3+1(pc),(a2)+
	move.b	#$20,(a2)+
	bra.s	z1rueck
zd71w:
	move.b	#$20,(a2)+
	move.b	#$20,(a2)+
	bra.s	zd71r
z3neu:
	move.w	#$30,4(a3)
	bra.s	z3ok
ausdruck:
	lea	fdruck(pc),a0
	tst.b	(a0)
	beq.s	winddruck

; datei schreiben

	lea	datname(pc),a0
	move.l	a0,d1
	move.l	#mode_new,d2
	jsr	open(a6)
	move.l	d0,d7;		datei öffnen
	beq.s	dat_fehler

	move.l	d7,d1
	move.l	buffer(pc),d2
	move.l	a2,d3
	sub.l	d2,d3
	jsr	write(a6);		datei schreiben

	move.l	d7,d1
	jsr	close(a6);		und wieder schließen

	bra.s	druck2aus
dat_fehler:
	lea	fehler(pc),a0
	move.w	#1,(a0)
	bra.s	druck2aus
winddruck:
	move.b	#$9b,(a2)+
	move.b	#$4b,(a2)+
	move.b	#$a,(a2)+
	move.b	#$9b,(a2)+
	move.b	#$20,(a2)+
	move.b	#$70,(a2)+

	move.l	a2,d3
	move.l	buffer(pc),d2
	sub.l	d2,d3
	move.l	conhandle(pc),d1
	jsr	write(a6)
druck2aus:
	movem.l	(sp)+,d0-d7/a0-a6

	rts

; =================================================

; adresse des bcdfeldes in a0
; benutzt feld : buffer

alldruck:
	movem.l	d4-d7/a0-a6,-(sp)

	move.l	a0,a1
	move.l	buffer(pc),a2

	move.l	#$3e202020,(a2)+

	move.w	#vsb/2-1,d4
	bsr	makehex

; nachkommateil kopieren

	move.b	#".",(a2)+
	move.w	#nsb/2-1,d4
	bsr	makehex
	move.b	#" ",(a2)+
	moveq	#3,d4
	bsr	makehex

	move.b	#$9b,(a2)+
	move.b	#$4b,(a2)+
	move.b	#$a,(a2)+

	move.l	a2,d3
	sub.l	buffer(pc),d3

	move.l	conhandle(pc),d1
	move.l	buffer(pc),d2
	jsr	write(a6)

	movem.l	(sp)+,d4-d7/a0-a6

	rts

makehex:
	moveq	#3,d3
	move.w	(a1)+,d5
makehex1:
	rol.w	#4,d5
	move.w	d5,d6
	and.w	#$f,d6

	cmp.w	#9,d6
	bhi.s	abuchst

	add.b	#$30,d6
	bra.s	az_ok
abuchst:
	add.b	#$37,d6
az_ok:
	move.b	d6,(a2)+
	dbf	d3,makehex1
	dbf	d4,makehex
	rts


;==================================================
;================ rechenroutinen ==================
;====== teil 1 : grundrechenarten und andere ======
;======= basis operationen wie vergleichen ========
;================ und feld löschen ================
;==================================================


testa0:
	tst.w	st3(a0)
	beq	st3fehler
	cmp.w	#3,st3(a0)
	bhi	st3fehler

	rts
testa0a1:
	tst.w	st3(a0)
	beq	st3fehler
	cmp.w	#3,st3(a0)
	bhi	st3fehler

	tst.w	st3(a1)
	beq	st3fehler
	cmp.w	#3,st3(a1)
	bhi	st3fehler

	rts


; adresse von bytefeld in a0
; adresse von bcdfeld und Ergebnisfeld in a1

wandbyte_bcd:
	movem.l	d0/d1/a0/a1,-(sp)

	move.w	#sb-1,d0
byte_bcd:
	move.b	(a0)+,d1
	lsl.b	#4,d1
	add.b	(a0)+,d1
	move.b	d1,(a1)+
	dbf	d0,byte_bcd

	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+

	movem.l	(sp)+,d0/d1/a0/a1

	rts

;==============================================

; adresse von bcdfeld in a0
; adresse von bytefeld und Ergebnisfeld in a1

wandbcd_byte:
	movem.l	d0-d2/a0/a1,-(sp)

	move.w	#sb-1,d0
bcd_byte:
	move.b	(a0)+,d1
	move.b	d1,d2
	lsr.b	#4,d1
	move.b	d1,(a1)+
	and.b	#$f,d2
	move.b	d2,(a1)+
	dbf	d0,bcd_byte

	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+

	movem.l	(sp)+,d0-d2/a0/a1

	rts

;=======================================================

; adresse von feld in a0
; teilt ein feld durch 2

durch2:
	bsr	testa0

	movem.l	d3-d5/a0/a1,-(sp)

	cmp.w	#1,st3(a0)
	beq	durch2aus

	bsr	dist_st

	move.l	a0,a1
	lsr.w	#1,d4
	bcc.s	no2a

	btst	#0,d5
	bne.s	no2a

	addq.l	#2,d5
no2a:
	add.l	d4,a1
	addq.w	#1,d5
	lsr.w	#1,d5
	add.l	d5,a1

	subq.w	#1,d5
durch21:
	move.b	-(a1),d4
	move.b	d4,d3
	and.b	#$f,d4
	lsr.b	#1,d4
	bcc.s	nopl51
	add.b	#$50,1(a1)
nopl51:
	lsr.b	#4,d3
	lsr.b	#1,d3
	bcc.s	nopl52
	addq.b	#5,d4
nopl52:
	lsl.b	#4,d3
	add.b	d3,d4
	move.b	d4,(a1)

	dbf	d5,durch21

	moveq	#0,d4
	move.w	st1(a0),d4
	beq.s	d2vaus

	move.l	a0,a1
	add.l	#vsb,a1
	clr.w	d5
	lsr.w	#1,d4
	addx.w	d5,d5
	sub.l	d4,a1
	tst.w	d5
	beq.s	tsteq

	tst.b	-1(a1)
	bne.s	d2vaus
	bra.s	subd2v
tsteq:
	cmp.b	#9,(a1)
	bhi.s	d2vaus
subd2v:
	subq.w	#1,st1(a0)
d2vaus:
	moveq	#0,d4
	move.w	st2(a0),d4

	move.l	a0,a1
	add.l	#vsb,a1
	clr.w	d5
	lsr.w	#1,d4
	addx.w	d5,d5
	add.l	d4,a1

	tst.w	d5
	beq.s	tst2eq

	move.b	(a1),d4
	and.b	#$f,d4
	beq.s	durch2aus
	bra.s	d2npl
tst2eq:
	tst.b	(a1)
	beq.s	durch2aus
d2npl:
	addq.w	#1,st2(a0)
	cmp.w	#nst,st2(a0)
	bls.s	durch2aus
	clr.w	sb(a0)
	move.w	#nst,st2(a0)
durch2aus:
	movem.l	(sp)+,d3-d5/a0/a1

	rts

;=================================================

; plus mit vorzeichen
; adresse von Summand 1 in a0
; adresse von Summand 2 und Ergebnisfeld in a1

pluss:
	bsr	testa0a1

	movem.l	d4/d5/a0/a1,-(sp)

	move.w	st3(a0),d4
	move.w	st3(a1),d5

	cmp.w	#1,d4
	beq	plussex

	cmp.w	#2,d4
	beq.s	p_pl1

	bra.s	p_mi1
p_kop_plussex:
	bsr	kopieren
	bra.s	plussex
p_pl1:
	cmp.w	#1,d5
	beq.s	p_kop_plussex

	cmp.w	#2,d5
	beq.s	p_pl1_pl2
p_pl1_mi2:
	bsr	minusu

	cmp.w	#2,st3(a1)
	beq.s	p_pl_mi

	move.w	#2,st3(a1)

	bra.s	plussex
p_pl_mi:
	move.w	#3,st3(a1)
	bra.s	plussex
p_mi1:
	cmp.w	#1,d5
	beq.s	p_kop_plussex

	cmp.w	#2,d5
	beq.s	p_mi1_pl2
p_mi1_mi2:
	bsr	plusu
	move.w	#3,st3(a1)
	bra.s	plussex
p_pl1_pl2:
	bsr	plusu
	bra.s	plussex
p_mi1_pl2:
	bsr	minusu
plussex:
	movem.l	(sp)+,d4/d5/a0/a1

	rts

;=====================================================

; minus mit vorzeichen
; adresse von minuend 1 in a0
; adresse von subtrahent und ergebnisfeld in a1

minuss:
	bsr	testa0a1

	movem.l	d4/d5/a0/a1,-(sp)

	move.w	st3(a0),d4
	move.w	st3(a1),d5

	cmp.w	#1,d4
	beq.s	minussex

	cmp.w	#2,d4
	beq.s	m_pl1
m_mi1:
	cmp.w	#1,d5
	beq.s	kop_minussex

	cmp.w	#2,d5
	beq.s	m_mi1_pl2
m_mi1_mi2:
	bsr	minusu

	cmp.w	#2,st3(a1)
	beq.s	m_pl_mi

	move.w	#2,st3(a1)
	bra.s	minussex
m_pl_mi:
	move.w	#3,st3(a1)
	bra.s	minussex
m_pl1:
	cmp.w	#1,d5
	beq.s	m_pl1_n2

	cmp.w	#2,d5
	beq.s	m_pl1_pl2
m_pl1_mi2:
	bsr	plusu
	move.w	#3,st3(a1)
	bra.s	minussex
m_pl1_n2:
	bsr	kopieren
	move.w	#3,st3(a1)
	bra.s	minussex
m_pl1_pl2:
	bsr	minusu
	bra.s	minussex
kop_minussex:
	bsr	kopieren
	bra.s	minussex
m_mi1_pl2:
	bsr	plusu
	move.w	#2,st3(a1)
minussex:
	movem.l	(sp)+,d4/d5/a0/a1

	rts

;====================================================

; vergleich mit vorzeichen
; adresse der felder in a0 und in a1
; ergebnis in d4
; 1 : beide gleich
; 2 : a0 grösser a1
; 3 : a1 grösser a0

vers:
	bsr	testa0a1

	movem.l	d5/a0/a1,-(sp)

	move.w	st3(a0),d4
	move.w	st3(a1),d5

	cmp.w	#1,d4
	beq.s	v_n1

	cmp.w	#2,d4
	beq.s	v_pl1

	bra.s	v_mi1
v_n1:
	cmp.w	#1,d5
	beq.s	v_n1_n2

	cmp.w	#2,d5
	beq.s	v_n1_pl2
v_n1_mi2:
	moveq	#2,d4
	bra.s	versex
v_pl1:
	cmp.w	#1,d5
	beq.s	v_pl1_n2

	cmp.w	#2,d5
	beq.s	v_pl1_pl2
v_pl1_mi2:
	moveq	#2,d4
	bra.s	versex
v_mi1:
	cmp.w	#1,d5
	beq.s	v_mi1_n2

	cmp.w	#2,d5
	beq.s	v_mi1_pl2
v_mi1_mi2:
	bsr	veru

	cmp.b	#2,d4
	beq.s	v_gr_kl

	cmp.b	#1,d4
	beq.s	v_gl
v_kl_gr:
	moveq	#2,d4

	bra.s	versex
v_gr_kl:
	moveq	#3,d4
	bra.s	versex
v_gl:
	move.l	#1,d4
	bra	versex
v_n1_n2:
	moveq	#1,d4
	bra	versex
v_n1_pl2:
	moveq	#3,d4
	bra	versex
v_pl1_n2:
	moveq	#2,d4
	bra.s	versex
v_pl1_pl2:
	bsr	veru
	bra.s	versex
v_mi1_n2:
v_mi1_pl2:
	moveq	#3,d4
versex:
	movem.l	(sp)+,d5/a0/a1

	rts

;==================================================

; plus ohne vorzeichen
; adresse von Summand 1 in a0
; adresse von Summand 2 und Ergebnisfeld in a1

plusu:
	bsr	testa0a1

	movem.l	d4-d7/a0-a4,-(sp)

	cmp.w	#1,st3(a0)
	beq	pende

	move.b	(a0),d4
	move.b	(a1),d5
	sub.w	d6,d6
	abcd	d5,d4
	bcs	add_uberlauf

	cmp.w	#1,st3(a1)
	beq	kop0

	bsr	findrausgrkl

	move.w	d4,st1(a1)
	move.w	d5,st2(a1)

	move.l	a0,a3;	a3 : summand 1
	move.l	a1,a4;	a4 : summand 2 und ergebnis

	add.l	#vsb,a3
	add.l	#vsb,a4

	move.w	d4,d6
	addq.w	#1,d4
	addq.w	#1,d5
	lsr.w	#1,d4
	lsr.w	#1,d5
	move.l	d5,d7
	add.l	d5,a3
	add.l	d5,a4
	move.l	a4,a2
	add.w	d4,d5
	sub.w	d4,d4;		x-flag löschen
plus1:
	abcd	-(a3),-(a4)
	dbf	d5,plus1

; vorkomma

	btst	#0,d6
	beq.s	plu_ger

	move.b	1(a4),d4
	lsr.b	#4,d4
	bne.s	addeinestelle
	bra.s	plaus
plu_ger:
	tst.b	(a4)
	bne.s	addeinestelle

	bra.s	plaus
addeinestelle:
	addq.w	#1,st1(a1)
plaus:
	move.w	#2,st3(a1)

	move.w	d7,d4
	beq.s	movd4a1

	move.l	a1,a3
	add.l	#vsb,a3
	add.l	d7,a3
pin:
	tst.b	-(a3)
	beq.s	subeinestelle

	bra.s	paus
subeinestelle:
	subq.w	#1,d4
	beq.s	paus0
	bra.s	pin
paus0:
	clr.w	st2(a1)
	bra.s	pende
paus:
	add.w	d4,d4
	move.b	(a3),d5
	and.b	#$f,d5
	beq.s	plnaeinweni
movd4a1:
	move.w	d4,st2(a1)
	bra.s	pende
plnaeinweni:
	subq.w	#1,d4
	bra.s	movd4a1
kop0:
	bsr	kopieren
pende:
	movem.l	(sp)+,d4-d7/a0-a4

	rts

;=======================================================

; minus ohne vorzeichen
; adresse von Subtrahent in a0
; adresse von Subtraktor und Ergebnisfeld in a1

minusu:
	bsr	testa0a1

	movem.l	d3-d7/a0-a4,-(sp)

	move.l	a0,a2
	move.l	a1,a3
	bsr	veru
	move.b	d4,d3

	cmp.b	#1,d4
	beq	minnull

	bsr	findrausgrkl
	move.w	d4,st1(a1)
	move.w	d5,st2(a1)

	move.l	a0,a3;	a3 : summand 1
	move.l	a1,a4;	a4 : summand 2 und ergebnis

	add.l	#vsb,a3
	add.l	#vsb,a4

	addq.w	#1,d4
	addq.w	#1,d5
	lsr.w	#1,d4
	lsr.w	#1,d5
	move.w	d4,d6
	move.l	d5,d7
	add.l	d5,a3
	add.l	d5,a4
	move.l	a4,a2
	add.w	d4,d5

	cmp.b	#2,d3
	beq.s	tauschsubtr

	move.w	#2,st3(a1)
	bra.s	subtr_ok
tauschsubtr:
	movem.l	d0/a0/a1,-(sp)

	move.l	a4,a0
	move.l	rt1(pc),a1
	add.l	#sb,a1
	move.w	d5,d0
tauschsub:
	move.b	-(a0),-(a1)
	move.b	-(a3),(a0)
	dbf	d0,tauschsub

	movem.l	(sp)+,d0/a0/a1
	move.l	rt1(pc),a3
	add.l	#sb,a3
	move.w	#3,st3(a1)
subtr_ok:
	sub.w	d4,d4;		x-flag löschen
minus1:
	sbcd	-(a3),-(a4)
	dbf	d5,minus1

; vorkommastellenzahl errechnen

	tst.w	d6
	beq.s	mind6ok
	addq.l	#1,a4
minsubback:
	tst.b	(a4)
	beq.s	minsubein
	bra.s	minvaus
minsubein:
	subq.w	#1,d6
	beq.s	mind6ok
	addq.l	#1,a4
	bra.s	minsubback
minvaus:
	add.w	d6,d6
	move.b	(a4),d4
	lsr.b	#4,d4
	beq.s	subnaein
	bra.s	mind6ok
subnaein:
	subq.w	#1,d6
mind6ok:
	move.w	d6,st1(a1)

; nachkommastellenzahl errechnen

	move.w	d7,d4
	beq.s	mid4ok

	move.l	a1,a3
	add.l	#vsb,a3
	add.l	d7,a3
miin:
	tst.b	-(a3)
	beq.s	misubnein

	bra.s	miaus
misubnein:
	subq.w	#1,d4
	beq.s	miaus0
	bra.s	miin
miaus0:
	clr.w	st2(a1)
	bra.s	minex
miaus:
	add.w	d4,d4
	move.b	(a3),d5
	and.b	#$f,d5
	beq.s	minaeinweni
mid4ok:
	move.w	d4,st2(a1)
	bra.s	minex
minaeinweni:
	subq.w	#1,d4
	bra.s	mid4ok
minnull:
	move.l	a1,a0
	bsr	feldloesch
minex:
	movem.l	(sp)+,d3-d7/a0-a4

	rts

;=======================================================

; multiplikation mit vorzeichen
; adresse von faktor 1 in a0
; adresse von faktor 2 und ergebnisfeld in a1

mals:
	bsr	testa0a1

	movem.l	d0-d7/a0-a5,-(sp)

	cmp.w	#1,st3(a0)
	beq	malnull1
	cmp.w	#1,st3(a1)
	beq	malsaus

; vorzeichen des ergebnisses ermitteln

	move.w	st3(a0),d0
	cmp.w	st3(a1),d0
	beq.s	mgleich
	move.w	#3,st3(a1)
	bra.s	mvorzaus
mgleich:
	move.w	#2,st3(a1)
mvorzaus:

; rechenfeld rt1 loeschen

	move.w	#sb*3/2+10,d4
	move.l	rt1(pc),a3
mlo:
	clr.w	(a3)+
	dbf	d4,mlo

; stellenzahlen und distanzwerte

	moveq	#0,d4
	moveq	#0,d5
	move.l	a0,a2;		a3 : adresse von faktor 1
	move.l	a1,a3;		a4 : adresse von faktor 2

	bsr	dist_st

	move.l	d4,d0
	move.l	d5,d1

	bsr	maketab

	move.l	a1,a5;		a5 : adresse des ergebnisfeldes
	moveq	#0,d4
	moveq	#0,d5
	move.l	a1,a0
	bsr	dist_st

	moveq	#0,d7
	move.w	d4,d7
	clr.w	d6
	lsr.w	#1,d7
	addx.w	d6,d6
	tst.w	d6
	sne	d6
	add.l	d7,a0

; anfangsadresse im rechenfeld rt1 ermitteln 

	move.l	rt1(pc),a3
	move.l	#vst+8,d2
	move.l	d0,d3
	sub.l	#vst,d3
	add.l	d3,d2
	sub.l	#vst,d4
	add.l	d4,d2
	moveq	#0,d7
	asr.l	#1,d2
	addx.w	d7,d7
	tst.w	d7
	sne	d7

	moveq	#0,d3
	btst	d3,d4
	beq.s	d0test
	subq.l	#1,d2
	bra.s	d2aus1
d0test:
	btst	d3,d0
	bne.s	d2aus1
	subq.l	#2,d2
d2aus1:
	btst	d3,d0
	bne.s	d1test
	btst	d3,d1
	beq.s	d2aus2
	addq.l	#1,d2
	bra.s	d2aus2
d1test:
	btst	d3,d1
	bne.s	d2aus2
	subq.l	#1,d2
d2aus2:
	cmp.w	#2,d2
	blo	mal_uberlauf
	tst.w	d2
	bmi	mal_uberlauf

	moveq	#0,d3
	move.w	d1,d3
	lsr.w	#1,d3
	add.l	d3,d2
	add.l	d2,a3

	move.l	tabr(pc),a1
	subq.w	#1,d5

	move.w	d1,d2
	lsr.w	#1,d1
	addq.w	#1,d2
	lsr.w	#1,d2
	move.w	d2,d1

	move.l	r1(pc),a5
	move.w	#sb+10/2-1,d0
clrr1a:
	clr.w	(a5)+
	dbf	d0,clrr1a

	move.l	a5,d2
	move.w	#sb+4,d3
	move.l	#sb+4*10+2,d4

; verwendete rechenfelder:
;
; r1 : 01
; rt1:	rechenfeld für subtraktion (rest, 3-fache länge)
; tabr: tabelle fur multiplikation von 1 bis 10
;
; register:
;
; d0 : rechenregister
; d1 : laufzahl multergebnis
; d2 : zeiger auf r1, rechts
; d3 : sb+4
; d4 : sb+4*10+2
; d5 : laufzahl gesamt
; d6 : bit für wechsel von neuer zahl
; d7 : bit für wechsel von tabr
;
; a0 : zeiger auf nächste zahl
; a1 : zeiger auf tabr
; a2 : rechenregister
; a3 : zeiger auf rt1 rechts
; a4 : rechenregister
; a5 : adresse von nullbytes (ende)
; a6 : nicht benutzt


mmulanf:
	moveq	#0,d0
	not.b	d6
	beq.s	mbcdr

	move.b	(a0),d0
	lsr.b	#4,d0
	bra.s	mbcdraus
mbcdr:
	move.b	(a0)+,d0
	and.b	#$f,d0
mbcdraus:
	tst.b	d0
	beq.s	muladdnull

	mulu	d3,d0
	move.l	a1,a2
	add.l	d0,a2

	not.b	d7
	beq.s	noadd
	add.l	d4,a2
	addq.l	#1,a3
noadd:
	move.l	a3,a4
	sub.w	d0,d0
	move.w	d1,d0
muladd:
	abcd	-(a2),-(a4)
	dbf	d0,muladd
	bcs.s	weiadd

	bra.s	muladdaus
muladdnull:
	not.b	d7
	beq.s	muladdaus
	addq.l	#1,a3
	bra.s	muladdaus
weiadd:
	abcd	-(a5),-(a4)
	bcs.s	weiadd

	move.l	d2,d0
	sub.l	a5,d0
	subq.w	#1,d0
clrr1b:
	clr.b	(a5)+
	dbf	d0,clrr1b
	move.l	d2,a5
muladdaus:
	dbf	d5,mmulanf

	move.l	4*9(sp),a5

	move.l	rt1,a0
	tst.w	(a0)
	bne	mal_uberlauf

; ergebnis vom rechenfeld zum ergebnisfeld kopieren

	addq.l	#2,a0
	move.l	a5,a4
	move.w	#sb/2-1,d0
	moveq	#0,d1
	moveq	#0,d2
kopmal:
	move.w	(a0)+,(a4)+
	sne	d1
	or.w	d1,d2
	dbf	d0,kopmal

	tst.w	d2
	beq	malnullerg

; letzte stelle aufrunden

	cmp.b	#$49,(a0)
	bhi.s	maufrd
	bra.s	maufrdaus
maufrd:
	move.l	a4,a3

	move.l	rt1(pc),a0
	move.w	#sb,d0
mclrrt1:
	clr.w	(a0)+
	dbf	d0,mclrrt1

	move.b	#1,-1(a0)
	sub.w	d0,d0
contrm:
	abcd	-(a0),-(a4)
	bcs.s	contrm

	move.l	a3,a4
maufrdaus:

; nachkommastellenzahl ermitteln

	move.w	#nsb,d0
mnachm:
	tst.b	-(a4)
	bne.s	mnachex

	subq.w	#1,d0
	bne.s	mnachm

	bra.s	mnachaus
mnsubeine:
	subq.w	#1,d0
	bra.s	mnachaus
mnachex:
	add.w	d0,d0
	move.b	(a4),d1
	lsl.b	#4,d1
	beq.s	mnsubeine
mnachaus:
	move.w	d0,st2(a5)

; vorkommastellen ermitteln

	move.l	a5,a4
	move.w	#vsb-1,d0
tsta4:
	tst.b	(a4)+
	bne.s	mvor
	dbf	d0,tsta4
	clr.w	d0
	bra.s	mvoraus
mvor:
	addq.w	#1,d0
	add.w	d0,d0
	move.b	-1(a4),d1
	lsr.b	#4,d1
	bne.s	mvoraus

	subq.w	#1,d0
mvoraus:
	move.w	d0,st1(a5)
	bra.s	malsaus
malnullerg:
	clr.l	(a4)+
	move.l	#$00000001,(a4)
	bra.s	malsaus
malnull1:
	move.l	a1,a0
	bsr	feldloesch
malsaus:
	movem.l	(sp)+,d0-d7/a0-a5

	rts

;===========================================================

; division mit vorzeichen
; adresse von dividend in a0
; adresse von divisor und ergebnisfeld in a1

; f1 ist das feld in a0
; f2 ist das feld in a1

div:
	bsr	testa0a1

	cmp.w	#1,st3(a0)
	beq	div_null

	movem.l	d0-d7/a0-a5,-(sp)

	cmp.w	#1,st3(a1)
	beq	divaus

; vorzeichen ermitteln

	move.w	st3(a1),d4
	cmp.w	st3(a0),d4
	beq.s	dgleich

	move.w	#3,st3(a1)
	bra.s	dvorzaus
dgleich:
	move.w	#2,st3(a1)
dvorzaus:

; rechenfeld rt1 löschen

	move.l	rt1(pc),a5
	move.w	#sb*3/2,d4
div1:
	clr.w	(a5)+
	dbf	d4,div1

; distanzwert und stellenzahl für f1 ermitteln

	exg	a0,a1
	bsr	dist_st
	exg	a0,a1

	move.l	d4,d0
	move.l	d5,d1

	clr.w	d7
	lsr.w	#1,d4
	bcs.s	koprt11

	move.l	a1,a4
	add.l	d4,a4
	subq.w	#1,d5
	move.l	rt1(pc),a5
	addq.l	#2,a5
div2:
	move.b	(a4)+,(a5)+
	dbf	d5,div2

	bra.s	koprt1aus
koprt11:
	move.l	a1,a4
	add.l	d4,a4
	moveq	#0,d7
	lsr.w	#1,d5
	addx.w	d7,d7
	add.l	d5,a4
	addq.l	#1,a4
	move.l	rt1(pc),a5
	addq.l	#2,a5
	add.l	d5,a5
	tst.w	d7
	beq.s	d7eq
	bra.s	kop_rt12
d7eq:
	move.b	(a4),d7
	lsr.b	#4,d7
	move.b	d7,(a5)
kop_rt12:
	move.b	-(a4),d7
	move.b	d7,d4
	lsl.b	#4,d4
	add.b	d4,(a5)
	lsr.b	#4,d7
	move.b	d7,-(a5)
	dbf	d5,kop_rt12
koprt1aus:

; distanzwert und stellenzahl für f2 ermitteln

	bsr	dist_st
	move.w	d4,d2

; beginn des ergebnisses ermitteln

	cmp.w	d0,d2
	beq.s	d0gld2
	cmp.w	#vst,d2
	beq.s	d2_vst
	cmp.w	#vst,d2
	bhi.s	grglvst
klvst:
	cmp.w	d2,d0
	bhi.s	d2_gr_d0
	move.w	#vst,d1
	sub.w	d2,d1
	add.w	d1,d0
	subq.w	#1,d0
	bra.s	staus
d2_gr_d0:
	move.w	#vst-1,d1
	sub.w	d2,d1
	add.w	d1,d0
	bra.s	staus
d2_vst:
	subq.w	#1,d0
	bra.s	staus
d0gld2:
	move.w	#vst-1,d0
	bra.s	staus
grglvst:
	sub.w	#vst-1,d2
	sub.w	d2,d0
staus:

; in d0 : distanzwert für anfang des ergebnisses
; tabelle erstellen

	bsr	maketab

	move.l	d0,d2
	clr.w	d3
	lsr.w	#1,d2
	addx.w	d3,d3;	d3 : flag für wechsel von ergebnis
	tst.w	d3
	seq	d3

	move.l	a1,a2
	add.l	d2,a2;	a2 : zeiger auf ergebnisfeld, richtige stelle

	move.w	d0,a5
	move.w	#st,d6
	sub.w	d0,d6
	bcs	divergnull
	cmp.w	#st+1,d6
	bhi	div_uberlauf;	wenn das ergebnis zu groß ist
	lea	divzaeh(pc),a3
	move.w	d6,(a3);	divzaeh : divisionszähler

; die ersten 3 zahlen von f2 nach d6

	move.l	a0,a3
	moveq	#0,d0
	move.w	d4,d0
	clr.w	d1
	lsr.w	#1,d0
	addx.w	d1,d1

	add.l	d0,a3;	a3 : zeiger auf f2, links

	moveq	#0,d6
	moveq	#0,d7

	tst.b	d1
	bne.s	deiw

	move.b	(a3)+,d6
	move.b	d6,d7
	lsr.w	#4,d6
	mal10	d6
	and.w	#$f,d7
	add.w	d7,d6
	move.b	(a3),d7
	lsr.w	#4,d7
	mal10	d6
	add.w	d7,d6

	bra.s	deiwaus
deiw:
	move.b	(a3)+,d6
	move.b	(a3),d7
	lsr.w	#4,d7
	mal10	d6
	add.w	d7,d6
	move.b	(a3),d7
	and.w	#$f,d7
	mal10	d6
	add.w	d7,d6
deiwaus:
	tst.w	d1
	bne.s	vb

	btst	#0,d5
	bne.s	ok
	bra.s	lk
vb:
	btst	#0,d5
	beq.s	ok
	bra.s	lk
ok:
	bchg	#0,d1
lk:
	lsr.w	#1,d5

; f2 (ergebnisfeld) löschen

	move.w	#sb/2+1,d7
div4:
	clr.w	(a1)+
	dbf	d7,div4

	move.l	rt1(pc),a0;	  a0 : zeiger auf rechenfeld, links
	addq.l	#1,a0
	move.l	tabr(pc),a4
	addq.l	#1,a4;    a4 : basisadresse des multiplikationsfeldes

	tst.w	d1
	sne	d1
	st	d4

; verwendete rechenfelder :
;
; rt1:	rechenfeld für subtraktion (rest, 3-fache länge)
; tabr: tabelle fur multiplikation von 1 bis 10
;
; register:
;
; d0 : rechenregister
; d1 : bit für wechsel von tabr
; d2 : rechenregister
; d3 : bit für wechsel von ergebnis
; d4 : bit für wechsel von rt1
; d5 : stellenzahl von f2
; d6 : 3 zahlen von f2 (konstant)
; d7 : 4 zahlen von rt1
;
; a0 : zeiger auf rechenfeld rt1
; a1 : arbeitsregister für subtraktion
; a2 : zeiger auf ergebnisfeld, richtige stelle
; a3 : adresse des multiplikationsergebnisses, rechts
; a4 : basis des multiplikationsfeldes
; a5 : zähler für division (stellen insgesamt)
; a6 : nicht benutzt

divanf:

; 4 zahlen vom rest nach d7

	moveq	#0,d7
	moveq	#0,d2
	move.l	a4,a3
	move.l	a0,a1

	not.b	d4
	beq.s	wandrt11

	move.b	1(a0),d7
	move.b	d7,d2
	lsr.b	#4,d7
	mal10	d7
	and.b	#$f,d2
	add.b	d2,d7
	mal10	d7
	move.b	2(a0),d2
	lsr.b	#4,d2
	add.w	d2,d7
	mal10	d7
	move.b	2(a0),d2
	and.b	#$f,d2
	add.w	d2,d7

	addq.l	#1,a0
	add.l	#sb+4*10,a3

	addq.l	#2,a1
	not.b	d1
	bne.s	wandrt1aus

	addq.l	#1,a3
	bra.s	wandrt1aus
wandrt11:
	move.b	(a0),d7
	mal10	d7
	move.b	1(a0),d2
	lsr.b	#4,d2
	add.b	d2,d7
	mal10	d7
	move.b	1(a0),d2
	and.b	#$f,d2
	add.w	d2,d7
	mal10	d7
	move.b	2(a0),d2
	lsr.b	#4,d2
	add.w	d2,d7

	subq.l	#1,a3

	not.b	d1
	bne.s	nomuladd2

	addq.l	#2,a1
	bra.s	wandrt1aus
nomuladd2:
	addq.l	#1,a1
wandrt1aus:
	divu	d6,d7

	not.b	d3
	beq.s	ergli
	add.b	d7,(a2)+
	bra.s	divergaus
ergli:
	lsl.b	#4,d7
	move.b	d7,(a2)
	lsr.b	#4,d7
divergaus:
	tst.b	d7
	beq.s	dminaus

; adresse des multiplikationsergebnisses errechnen

mulanf:
	move.w	d7,d0
	mulu	#sb+4,d0
	add.l	d0,a3

; mult.ergebnis von rt1 abziehen
; adresse des mult.ergebnisses in a3

divminin:
	move.w	d5,d2
	addq.w	#1,d2
	add.l	d5,a1
	sub.w	d0,d0
divmin:
	sbcd	-(a3),-(a1)
	dbf	d2,divmin
	bcs.s	wiederadd
dminaus:
	lea	divzaeh(pc),a1
	subq.w	#1,(a1)
	bcc	divanf

	bra.s	divschleifaus

; wenn fehler, dann f2 wieder auf rt1 addieren

wiederadd:
	move.w	d5,d2
	addq.w	#1,d2
	add.l	d5,a1
	addq.l	#2,a1
	add.l	d5,a3
	addq.l	#2,a3
	sub.w	d0,d0
divadd:
	abcd	-(a3),-(a1)
	dbf	d2,divadd

	tst.b	d3
	beq.s	neuerg1

	subq.b	#1,-1(a2)
	bra.s	neuergaus
neuerg1:
	sub.b	#%10000,(a2)
neuergaus:
	subq.w	#1,d7
	beq.s	dminaus

	addq.l	#2,a1
	add.l	d5,a3
	sub.l	#sb+2,a3

	bra.s	divminin
divschleifaus:

; letzte stelle aufrunden

	cmp.b	#$49,(a2)
	bhi.s	daufrd
	bra.s	aufrdaus
daufrd:
	move.l	a2,a1

	move.l	rt1(pc),a0
	move.w	#sb,d0
dclrrt1:
	clr.w	(a0)+
	dbf	d0,dclrrt1

	move.b	#1,-1(a0)
	sub.w	d0,d0
contrd:
	abcd	-(a0),-(a2)
	bcs.s	contrd

	move.l	a1,a2
aufrdaus:
	clr.b	(a2)

	move.l	9*4(sp),a4

; vorkommastellenzahl

	cmp.w	#vst,a5
	bhi.s	dvornull

	move.w	#vst,d0
	sub.w	a5,d0
	beq.s	dvoraus

	move.w	d0,d1
	clr.w	d2
	lsr.w	#1,d1
	addx.w	d2,d2

	move.l	a4,a5
	add.l	#vsb,a5
	and.l	#$ffff,d1
	sub.l	d1,a5

	tst.w	d2
	beq.s	tsta0cl

	tst.b	-1(a5)
	beq.s	subeine

	bra.s	dvoraus
tsta0cl:
	move.b	(a5),d1
	lsr.b	#4,d1
	beq.s	subeine

	bra.s	dvoraus
subeine:
	subq.w	#1,d0
	bra.s	dvoraus
dvornull:
	clr.w	d0
dvoraus:
	move.w	d0,st1(a4)

; nachkommastellenzahl ermitteln

	move.l	a4,a5
	add.l	#sb,a5
	move.w	#nsb,d4
dnachm:
	tst.b	-(a5)
	bne.s	dnachex

	subq.w	#1,d4
	bne.s	dnachm

	bra.s	dnachaus
dnsubeine:
	subq.w	#1,d4
	bra.s	dnachaus
dnachex:
	add.w	d4,d4
	move.b	(a5),d0
	lsl.b	#4,d0
	beq.s	dnsubeine
dnachaus:
	move.w	d4,st2(a4)
	bra.s	divaus
divergnull:
	move.l	a1,a0
	bsr	feldloesch
divaus:
	movem.l	(sp)+,d0-d7/a0-a5

	rts

;==================================================

;  adresse des feldes in a0
; ergebnis:	distanzwert in d4
;		stellenzahl in d5

dist_st:
	movem.l	d3/d6/d7/a0,-(sp)

	move.w	st2(a0),d7
	move.w	st1(a0),d6
	beq.s	vnull

	move.l	#vst,d4
	sub.w	d6,d4

	tst.w	d7
	beq.s	suchen

	moveq	#0,d5
	move.w	d6,d5
	add.w	d7,d5
	bra.s	distaus
suchen:
	add.l	#vsb,a0
	moveq	#0,d7
nnull1:
	tst.b	-(a0)
	bne.s	naus

	addq.w	#1,d7
	bra.s	nnull1
naus:
	add.w	d7,d7
	move.b	(a0),d3
	and.b	#$f,d3
	beq.s	nauspl1
	bra.s	nausd4ok
nauspl1:
	addq.w	#1,d7
nausd4ok:
	moveq	#0,d5
	move.w	d6,d5
	sub.w	d7,d5
	bra.s	distaus
distnullaus:
	moveq	#0,d4
	moveq	#0,d5
	bra.s	distaus
vnull:
	tst.w	d7
	beq.s	distnullaus

	move.l	#vsb,d4
vnull1:
	tst.b	(a0,d4.w)
	bne.s	vaus

	addq.w	#1,d4
	bra.s	vnull1
vaus:
	move.b	(a0,d4.w),d6
	add.w	d4,d4
	lsr.b	#4,d6
	beq.s	vnullpl1
	bra.s	vnulld4ok
vnullpl1:
	addq.w	#1,d4
vnulld4ok:
	moveq	#0,d5
	move.w	d7,d5
	add.w	#vst,d5
	sub.w	d4,d5
distaus:
	movem.l	(sp)+,d3/d6/d7/a0

	rts

;==========================================

; diese routine erstellt die tabelle für multiplikation und
; division bei tabr. alle register bleiben unverändert.
; kann direkt im anschluß an dist_st aufgerufen werden.
; a0 : zeiger auf feld
; d4 : distanzwert
; d5 : stellenzahl

maketab:
	movem.l	d2-d7/a0-a3,-(sp)

	move.l	#sb+4,d2
	subq.w	#1,d5

	move.l	tabr(pc),a1
	move.w	#sb+4*20+20/4,d6
clrtabr:
	clr.l	(a1)+
	dbf	d6,clrtabr

	lsr.w	#1,d4
	bcs.s	kop1m

	add.l	d4,a0
	lsr.w	#1,d5
	add.l	d5,a0
	addq.l	#1,a0;		a0 : zeiger rechts
	move.l	a0,a1
	move.l	tabr(pc),a2
	add.l	d2,a2
	move.w	d5,d6
kop_f1:
	move.b	-(a1),-(a2)
	dbf	d6,kop_f1
	bra.s	addtab1aus
kop1m:
	add.l	d4,a0
	moveq	#0,d7
	lsr.w	#1,d5
	addx.w	d7,d7
	add.l	d5,a0;		a0 : f2 rechts
	addq.l	#1,a0
	move.l	a0,a1
	move.l	tabr(pc),a2
	add.l	#sb+3,a2
	move.w	d5,d6
	addq.w	#1,d6
	tst.w	d7
	bne	d7ne
	bra.s	kop_f11
d7ne:
	move.b	(a1),d7
	lsr.b	#4,d7
	move.b	d7,(a2)
	addq.w	#1,d5
kop_f11:
	move.b	-(a1),d7
	move.b	d7,d4
	lsl.b	#4,d4
	add.b	d4,(a2)
	lsr.b	#4,d7
	move.b	d7,-(a2)
	dbf	d6,kop_f11
addtab1aus:
	move.l	tabr(pc),a0
	move.l	a0,a2
	add.l	d2,a0
	add.l	d2,a2
	add.l	d2,a2
	moveq	#8,d7
addtab1:
	move.w	d5,d6
	move.l	a0,a1
	move.l	a2,a3
addtab2:
	move.b	-(a1),-(a3)
	dbf	d6,addtab2

	move.l	a2,a1
	move.l	a2,a3
	sub.l	d2,a1

	move.w	d5,d6
	addq.w	#1,d6
	sub.w	d3,d3
addtab3:
	abcd	-(a1),-(a3)
	dbf	d6,addtab3

	add.l	d2,a2
	dbf	d7,addtab1

; verschobene tabelle erstellen

	move.l	tabr(pc),a0
	move.l	a0,a2
	add.l	d2,a0
	add.l	#sb+4*11+2,a2
	moveq	#9,d7
verschtab1:
	move.w	d5,d6
	addq.w	#1,d6
	move.l	a0,a1
	move.l	a2,a3
verschtab2:
	move.b	-(a1),d4
	move.b	d4,d3
	lsl.b	#4,d3
	add.b	d3,-(a3)
	lsr.b	#4,d4
	move.b	d4,-1(a3)
	dbf	d6,verschtab2

	add.l	d2,a0
	add.l	d2,a2
	dbf	d7,verschtab1

	movem.l	(sp)+,d2-d7/a0-a3

	rts

;==============================================

; setzt ein feld auf null
; feldadresse in a0

feldloesch:
	movem.l	d0/a0,-(sp)

	move.w	#sb/2+2,d0
lanf:
	clr.w	(a0)+
	dbf	d0,lanf
	move.w	#1,(a0)+

	movem.l	(sp)+,d0/a0

	rts

;================================================

; adresse des 1. feldes in a0
; adresse des 2. feldes in a1
; grössere vorkommazahl in d4
; grössere nachkommazahl in d5

findrausgrkl:
	move.l	d6,-(sp)

	moveq	#0,d4
	moveq	#0,d5

	move.w	st1(a1),d6
	cmp.w	st1(a0),d6
	blt.s	vor1grvor2
	bgt.s	vor1klvor2
	move.w	st1(a0),d4
frueck1:
	move.w	st2(a1),d6
	cmp.w	st2(a0),d6
	blt.s	nach1grnach2
	bgt.s	nach1klnach2
	move.w	st2(a1),d5

	bra.s	findaus
vor1grvor2:
	move.w	st1(a0),d4
	bra.s	frueck1
vor1klvor2:
	move.w	st1(a1),d4
	bra.s	frueck1
nach1grnach2:
	move.w	st2(a0),d5
	bra.s	findaus
nach1klnach2:
	move.w	st2(a1),d5
findaus:
	move.l	(sp)+,d6

	rts

;=====================================================

; kopiert feld in a0 auf feld in a1
; adresse des quellfeldes in a0
; adresse des zielfeldes in a1

kopieren:
	movem.l	d4/a0/a1,-(sp)

	move.w	#sb/2+3,d4
kopieren1:
	move.w	(a0)+,(a1)+
	dbf	d4,kopieren1

	movem.l	(sp)+,d4/a0/a1

	rts

;=====================================================

; tauscht felder in a0 und a1 aus
; adresse der felder in a0 und in a1

tausch:
	movem.l	d4/d5/a0/a1,-(sp)

	move.w	#sb/2+3,d4
tau1:
	move.w	(a0),d5
	move.w	(a1),(a0)+
	move.w	d5,(a1)+
	dbf	d4,tau1

	movem.l	(sp)+,d4/d5/a0/a1

	rts

;=====================================================

; vergleich ohne vorzeichen
; adresse der felder in a0 und in a1
; ergebnis in d4
; 1 : beide gleich
; 2 : a0 grösser a1
; 3 : a1 grösser a0

veru:
	bsr	testa0a1

	movem.l	a0/a1,-(sp)

	move.w	#sb/2-1,d4
ver1:
	cmpm.w	(a1)+,(a0)+
	blo.s	a1_gr_a0
	bhi.s	a0_gr_a1
	dbf	d4,ver1

	moveq	#1,d4
	bra.s	veraus
a1_gr_a0:
	moveq	#3,d4
	bra.s	veraus
a0_gr_a1:
	moveq	#2,d4
veraus:
	movem.l	(sp)+,a0/a1

	rts

;=================================================

; feld(a0) := feld(a0) - 1
; adresse des feldes in a0

decrem:
	bsr	testa0

	movem.l	d0/d1/a0-a2,-(sp)

	cmp.w	#1,st3(a0)
	beq.s	decremex
	tst.w	st2(a0)
	bne.s	decremex

	move.l	dez1(pc),a2
	add.l	#vsb,a2

	move.l	a0,a1
	add.l	#vsb,a1
	sub.w	d0,d0
decweiadd:
	sbcd	-(a2),-(a1)
	bcs.s	decweiadd

	move.w	st1(a0),d0
	moveq	#0,d1
	move.w	d0,d1
	lsr.w	#1,d1
	move.l	a0,a1
	add.l	#vsb,a1
	sub.l	d1,a1

	btst	#0,d0
	bne.s	tstm1

	move.b	(a1),d0
	lsr.b	#4,d0
	beq.s	dec1weniger

	bra.s	decremex
tstm1:
	tst.b	-1(a1)
	beq.s	dec1weniger

	bra.s	decremex
alloe:
	move.w	#1,st3(a0)
	bra.s	decremex
dec1weniger:
	subq.w	#1,st1(a0)
	beq.s	alloe
decremex:
	movem.l	(sp)+,d0/d1/a0-a2

	rts

;==============================================

; feld(a0) := feld(a0) + 1
; adresse des feldes in a0

increm:
	bsr	testa0

	movem.l	d0/d1/a0-a2,-(sp)

	cmp.w	#1,st3(a0)
	beq.s	increm0_1
	tst.w	st2(a0)
	bne.s	incremex

	move.l	dez1(pc),a2
	add.l	#vsb,a2

	move.l	a0,a1
	add.l	#vsb,a1
	sub.w	d0,d0
incweiadd:
	abcd	-(a2),-(a1)
	bcs.s	incweiadd

	move.w	st1(a0),d0
	moveq	#0,d1
	move.w	d0,d1
	lsr.w	#1,d1
	move.l	a0,a1
	add.l	#vsb-1,a1
	sub.l	d1,a1

	btst	#0,d0
	bne.s	itstm1

	tst.b	(a1)
	bne.s	inc1mehr

	bra.s	incremex
itstm1:
	move.b	(a1),d0
	lsr.b	#4,d0
	bne.s	inc1mehr

	bra.s	incremex
increm0_1:
	move.w	#1,st1(a0)
	move.w	#2,st3(a0)
	move.b	#1,vsb-1(a0)
	bra.s	incremex
inc1mehr:
	addq.w	#1,st1(a0)
incremex:
	movem.l	(sp)+,d0/d1/a0-a2

	rts

;==============================================

; wechselt das vorzeichen
; adresse des feldes in a0

vorz_wechsel:
	bsr	testa0

	move.l	d0,-(sp)

	move.w	st3(a0),d0

	cmp.w	#1,d0
	beq.s	vor_wechsaus

	cmp.w	#2,d0
	beq.s	plus_minus

	move.w	#2,st3(a0)
	bra.s	vor_wechsaus
plus_minus:
	move.w	#3,st3(a0)
vor_wechsaus:
	move.l	(sp)+,d0

	rts

;==================================================

; löscht den nachkommateil des feldes in a0
; adresse des feldes in a0

integer:
	bsr	testa0

	movem.l	d0/a0,-(sp)

	cmp.w	#1,st3(a0)
	beq.s	integ_aus
	tst.w	st2(a0)
	beq.s	integ_aus

	tst.w	st1(a0)
	bne.s	integnnull

	move.w	#1,st3(a0)
integnnull:
	clr.w	st2(a0)

	move.w	#nsb/2-1,d0
	add.l	#vsb,a0
clrinteg:
	clr.w	(a0)+
	dbf	d0,clrinteg
integ_aus:
	movem.l	(sp)+,d0/a0

	rts

;===========================================
;============= rechenroutinen ==============
;=== teil 2 : routinen, die die grund- =====
;====== rechenfunktionen benutzen. =========
;======== z.b. sqrroot oder pi1 ============
;===========================================


; adresse des feldes in a0

sinus:
	bsr	testa0

	movem.l	d0/d1/a0-a2,-(sp)

	move.l	a0,a2

; zahl zwischen +pi/2 und -pi/2 bringen

	mkopieren	a2,sqr1(pc)
	mdiv		pi(pc),sqr1(pc)

	move.l	sqr1(pc),a0
	cmp.b	#$49,vsb(a0)
	bhi.s	sinaufrd

	bsr	integer
	bra.s	sinaufrdaus
sinaufrd:
	bsr	integer
	bsr	increm
sinaufrdaus:
	mmals		pi(pc),sqr1(pc)
	mminusu		sqr1(pc),a2

	mkopieren	a2,sqr1(pc)
	mkopieren	a2,sqr2(pc)
	mquadrat	sqr2(pc)
	mkopieren	dez1(pc),sqr3(pc)
	mkopieren	dez1(pc),sqr4(pc)

; sin(x) = x - x^3/3! + x^5/5! -x^7/7! ...
; sqr1 : jeweiliges x^n
; sqr2 : x^2
; sqr3 : n!
; sqr4 : n

	st	d4
	moveq	#82,d5
makesin:
	mincrem		sqr4(pc)
	mmals		sqr4(pc),sqr3(pc)
	mincrem		sqr4(pc)
	mmals		sqr4(pc),sqr3(pc)

	mmals		sqr2(pc),sqr1(pc)
sin_in:
	mfeldloesch	sqr5(pc)
	mkopieren	sqr1(pc),sqr5(pc)
	mdiv		sqr3(pc),sqr5(pc)

	cmp.w	#1,st3(a1)
	beq.s	sin_aus

	not.b	d4
	beq.s	sinabzieh

	mplusu	sqr5(pc),a2
	bra.s	sin_2
sinabzieh:
	mminusu	sqr5(pc),a2
sin_2:
	dbf	d5,makesin
sin_aus:
	movem.l	(sp)+,d0/d1/a0-a2

	rts

;================================================

; adresse des feldes in a0

fakultaet:
	bsr	testa0

	movem.l	d0/d1/a0-a2,-(sp)

	cmp.w	#1,st3(a0)
	beq	fak_1

	cmp.w	#3,st3(a0)
	beq	fakfehler
	tst.w	st2(a0)
	bne	fakfehler

	moveq	#0,d0
	move.b	vsb-2(a0),d0
	move.w	d0,d1
	lsr.w	#4,d0
	mulu	#10,d0
	and.w	#$f,d1
	add.w	d1,d0
	mulu	#10,d0

	moveq	#0,d1
	move.b	vsb-1(a0),d1
	lsr.w	#4,d1
	add.w	d1,d0
	mulu	#10,d0
	move.b	vsb-1(a0),d1
	and.w	#$f,d1
	add.w	d1,d0

	tst.w	d0
	beq	fakfehler
	cmp.w	#1,d0
	beq	fakaus
	cmp.w	#2,d0
	beq	fakaus

	move.l	a0,a2

	move.l	sqr1(pc),a1
	bsr	kopieren

	subq.w	#2,d0
fak:
	move.l	sqr1(pc),a0
	bsr	decrem
	mmals	sqr1(pc),a2
	dbf	d0,fak

	bra.s	fakaus
fak_1:
	bsr	feldloesch
	move.b	#1,vsb-1(a0)
	move.w	#1,st1(a0)
	move.w	#2,st3(a0)
fakaus:
	movem.l	(sp)+,d0/d1/a0-a2

	rts

;===============================================

; adresse des feldes in a0

sqrroot:
	bsr	testa0

	cmp.w	#3,st3(a0)
	beq	sqr_negativ

	cmp.w	#1,st3(a0)
	beq	wurzaus2

	movem.l	d4-d7/a0-a5,-(sp)

	move.l	sqr1(pc),a1
	bsr	kopieren

	cmp.w	#4,st1(a0)
	bhi.s	kleinermachen

	bsr	dist_st

	cmp.w	#vst,d4
	bhi.s	groessermachen

	bra.s	anfwurz
groessermachen:
	sub.w	#vst-1,d4
	lsr.w	#1,d4
	add.w	#vst-1,d4
	moveq	#0,d5
	move.w	d4,d5

	lsr.w	#1,d5
	move.l	sqr1(pc),a1
	add.l	d5,a1
	move.b	#5,(a1)

	bra.s	anfwurz
kleinermachen:
	move.w	st1(a0),d4
	lsr.w	#1,d4

	move.l	#vst,d5
	sub.w	d4,d5
	lsr.w	#1,d5
	move.l	sqr1,a1	
	add.l	d5,a1
	move.w	d5,d4
	subq.w	#1,d5
	move.b	#$50,(a1)
kl1:
	clr.b	-(a1)
	dbf	d5,kl1

	move.w	#vsb,d5
	sub.w	d4,d5
	add.w	d5,d5
	move.l	sqr1,a1
	move.w	d5,st1(a1)

; x[n+1] = 0.5 * ( x[n] + a / x[n] )
; sqr1 : x[n]
; sqr3 : rechenfeld für überprüfung
; sqr4 : zwischenergebnis der division

anfwurz:
	move.l	a0,a4;		a4 : originaladresse
	moveq	#10,d4;		anzahl der iterationen
	move.l	sqr1(pc),d6
	move.l	sqr4(pc),d7
	move.l	sqr3(pc),a5

wurz:
	mkopieren	a4,sqr4(pc)

	mdiv		d6,d7
	mplusu		d7,d6
	move.l		d6,a0
	bsr		durch2
	dbf		d4,wurz

ueberpruefen:
	mkopieren	d6,a5;	sqr3 : x[n]
	mkopieren	a4,d7
	mdiv		d6,d7
	mplusu		d7,d6
	move.l		d6,a0
	bsr		durch2;			sqr1 : x[n+1]

	mveru		d6,a5

	cmp.b	#1,d4
	beq.s	wurzaus1

	bra.s	ueberpruefen
wurzaus1:
	mkopieren	d6,a4
wurzaus:
	movem.l	(sp)+,d4-d7/a0-a5
wurzaus2:
	rts

;=============================================

; adresse des feldes in a0

quadrat:
	bsr	testa0

	movem.l	a0/a1,-(sp)

	move.l	sqr1(pc),a1
	bsr	kopieren
	exg	a0,a1
	bsr	mals

	movem.l	(sp)+,a0/a1

	rts

;=============================================

; adresse des feldes in a0


pi1:
	movem.l	d4-d7/a0-a6,-(sp)

	prtxt	16

	move.l	buffer(pc),a4
	moveq	#0,d6
piein:
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#$d,d4
	beq	pireturn
	cmp.b	#$8,d4
	beq	pibackspace
	cmp.b	#$30,d4
	beq	pizeinull

	cmp.b	#$30,d4
	blt.s	piein
	cmp.b	#$39,d4
	bgt.s	piein

	move.l	buffer(pc),a0
	addq.l	#4,a0

	cmp.l	a0,a4
	beq	piein
inordnung:
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	write(a6)

	sub.b	#$30,(a4)
	addq.l	#1,a4
	addq.w	#1,d6
	bra	piein
pibackspace:
	cmp.l	buffer(pc),a4
	beq	piein

	bsr	backspace

	clr.b	(a4)
	subq.l	#1,a4
	subq.w	#1,d6
	bra	piein
pizeinull:
	cmp.l	buffer(pc),a4
	beq	piein

	bra	inordnung
pireturn:
	cmp.l	buffer(pc),a4
	beq	pi1aus

	subq.w	#1,d6
	move.l	buffer(pc),a4
	clr.l	d5
	clr.w	d7
wand:
	move.b	(a4)+,d7
	mulu	#10,d5
	add.w	d7,d5
	dbf	d6,wand

; felder vorbesetzen

	prtxt	19

	mkopieren	dez2(pc),bcd1(pc)
	mquadrat	bcd1(pc)
	mkopieren	dez3(pc),bcd2(pc)
	mquadrat	bcd2(pc)

	mkopieren	dez2(pc),bcd3(pc)
	mkopieren	dez3(pc),bcd4(pc)
	mkopieren	dez2(pc),bcd5(pc)
	mkopieren	dez3(pc),bcd6(pc)
	mkopieren	dez1(pc),bcd7(pc)

	prtxt	22
	move.w	#vst,d4
	bsr	zahlaus
	prtxt	23
	move.w	#nst,d4
	bsr	zahlaus
	prtxt	11
	move.w	d5,d4
	bsr	zahlaus


; pi = 4 * ( 4*arctan(1/5) - arctan(1/239) )
; arctan(x) = x  -  x^3/3  +  x^5/5  -  x^7/7  +  x^9/9  ...
; bcd1 : (1/5)^2
; bcd2 : (1/239)^2
; bcd3 : zwischenergebnis arctan(1/5)
; bcd4 : zwischenergebnis arctan(1/239)
; bcd5 : (1/5)^n
; bcd6 : (1/239)^n
; bcd7 : zähler

	move.w	d5,d6
	moveq	#1,d7;	anzeigen
	lea	plflag(pc),a0
	st	(a0)
	move.l	4.w,a5
	lea	bcd1(pc),a3
schlanf1:
	print	str2,6

	move.w	d5,d4
	sub.w	d6,d4
	bsr	zahlaus

	print	miplu+2,1

	cmp.w	#2,d7
	beq.s	ueberspring

	prtxt	18
	bsr	berecherg
	mdruck		bcd8(pc)
ueberspring:
	btst	#6,$bfe001
	beq	piweiter
	cmp.b	#$3d,$bfec01
	beq	piweiter
berechwei:
	exg	a5,a6
	jsr	forbid(a6)

	mmals		(a3),4*4(a3);	v6 : v3 : (1/5)^2
	mkopieren	4*4(a3),7*4(a3)

	mmals		4(a3),5*4(a3);	v7 : v4 * (1/239)^2
	mkopieren	5*4(a3),8*4(a3)

	mincrem		6*4(a3)
	mincrem		6*4(a3);	v5 := v5+2
	mdiv		6*4(a3),7*4(a3)
	mdiv		6*4(a3),8*4(a3)

	lea	plflag(pc),a0
	not.b	(a0)
	beq.s	plabzieh

	mplusu		7*4(a3),2*4(a3)
	mplusu		8*4(a3),3*4(a3)
	bra.s	arcaus
plabzieh:
	mminusu		7*4(a3),2*4(a3)
	mminusu		8*4(a3),3*4(a3)
arcaus:
	jsr	permit(a6)
	exg	a5,a6

	dbf	d6,schlanf1

	prtxt	18
	bsr	berecherg
	mdruck		bcd8
	print	dt24,5
	bra	fragsave0
berechweiin:
	cmp.w	#2,d7
	beq.s	q_ja

	move.l	buffer(pc),a0
	move.l	#$0d9b4b00,(a0)
	p_buf	3
	bra	berechwei
q_ja:
	prtxt	25
	bra	berechwei
zquiet:
	cmp.w	#1,d7
	beq.s	anz_qu
qu_wiederanz:
	moveq	#1,d7
	bra.s	berechweiin
anz_qu:
	moveq	#2,d7
	prtxt	25
	bra	berechwei
piweiter:
	cmp.w	#1,d7
	beq.s	qtext
	prtxt	24
	bra.s	pireadin
qtext:
	prtxt	17
pireadin:
	move.l	buffer(pc),a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#"y",d4
	beq.s	piread1
	cmp.b	#"n",d4
	beq.s	piread1
	cmp.b	#"q",d4
	beq.s	piread1
	bra.s	pireadin
piread1:
	move.l	buffer(pc),a4
	lea	z1(pc),a0
	move.l	(a4),(a0)

	p_buf	1
piread2:
	move.l	buffer(pc),a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#$d,d4
	beq	pireadaus
	cmp.b	#8,d4
	beq.s	pireadloe
	bra.s	piread2
pireadloe:
	bsr	backspace
	bra.s	pireadin
pireadaus:
	move.b	z1(pc),d4

	cmp.b	#"y",d4
	beq	berechweiin
	cmp.b	#"q",d4
	beq	zquiet
fragsave0:
	prtxt	30
fragsave:
	move.l	buffer(pc),a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#"y",d4
	beq.s	fragsave2
	cmp.b	#"n",d4
	beq.s	fragsave2
	bra.s	fragsave
fragsave2:
	move.l	buffer(pc),a4
	lea	z1(pc),a0
	move.l	(a4),(a0)
	p_buf	1
fragsave3:
	move.l	buffer(pc),a4
	move.l	conhandle(pc),d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	move.b	(a4),d4

	cmp.b	#$d,d4
	beq.s	fragsaveaus
	cmp.b	#$8,d4
	beq.s	fragsaveloe
	bra.s	fragsave3
fragsaveloe:
	bsr	backspace
	bra.s	fragsave
fragsaveaus:
	move.b	z1(pc),d4

	cmp.b	#"n",d4
	beq	berechaus

	bsr	namein;		dateinamen eingeben

	lea	datname(pc),a0
	tst.b	(a0)
	beq.s	no_name

	bsr	berecherg

	lea	fdruck(pc),a3
	move.b	#1,(a3)
	mdruck	bcd8(pc);	zahl in datei speichern
	clr.b	(a3)

	lea	fehler(pc),a0
	tst.w	(a0)
	bne	piwrite_err
	bsr	namedruck
	prtxt	33
	bsr	r_buf
	bra	pi1aus
piwrite_err:
	prtxt	40
	bsr	r_buf
	bra.s	pi1aus
no_name:
	prtxt	43
	bra.s	pi1aus1
berechaus:
	print	str3,5
	prtxt	13
pi1aus1:
	bsr	r_buf
pi1aus:
	movem.l	(sp)+,d4-d7/a0-a6

	rts

;--------------------

berecherg:
	mkopieren	2*4(a3),7*4(a3)
	mkopieren	2*4(a3),8*4(a3)
	mplusu		7*4(a3),8*4(a3)
	mkopieren	8*4(a3),7*4(a3)
	mplusu		8*4(a3),7*4(a3);	v8 : 4*arctan(1/5)

	mminusu	3*4(a3),7*4(a3);  v8 : 4*arctan(1/5)-arctan(1/239)

	mkopieren	7*4(a3),8*4(a3)
	mplusu		7*4(a3),8*4(a3)
	mkopieren	8*4(a3),7*4(a3)
	mplusu		8*4(a3),7*4(a3);	v8 : pi-ergebnis

	rts

;--------------------

namein:
	prtxt	32
	lea	datname(pc),a4

	move.l	conhandle(pc),d7
nnamein:
	move.l	d7,d1
	move.l	a4,d2
	moveq	#1,d3
	jsr	read(a6)

	cmp.b	#$d,(a4)
	beq.s	nameex
	cmp.b	#$8,(a4)
	beq.s	nback
	cmp.b	#$9b,(a4)
	beq.s	frgs_ctrl
	cmp.l	#datname+40,a4
	beq.s	nnamein

	move.l	d7,d1
	move.l	a4,d2
	move.l	#1,d3
	jsr	write(a6)

	addq.l	#1,a4
	bra.s	nnamein
frgs_ctrl:
	move.l	d7,d1
	move.l	a4,d2
	moveq	#10,d3
	jsr	read(a6)

	bra.s	nnamein
nback:
	lea	datname(pc),a0
	cmp.l	a0,a4
	beq.s	nnamein

	bsr	backspace
	subq.l	#1,a4
	bra.s	nnamein
nameex:
	clr.b	(a4)

	rts

;--------------------

namedruck:
	prtxt	31

	lea	datname(pc),a4
	move.l	a4,d2
	moveq	#0,d3
addname:
	tst.b	(a4)+
	beq.s	addraus
	addq.w	#1,d3
	bra.s	addname
addraus:
	move.l	conhandle(pc),d1
	jsr	write(a6)

	print	zeiloe,2

	rts


;************ daten,variablen ***********

dosname:dc.b	`dos.library`,0
intname:dc.b	`intuition.library`,0
piname:	dc.b	`pidat`,0
name:	dc.b	`raw:0/0/`
windsize: dc.b	`640/200/**************  ADAM_V3  **************`,0

; deutsche texte

dt1:
dc.b	$c,$9b,`0 p`,$9b,`20C`,$9b,`4;31;40mManulle Eingabe`
dc.b	$9b,`0;31;40m`,$a,$a
dc.b	`   Das Prompt-Zeichen > fordert zur Eingabe auf. In der`
dc.b	` ersten und in der`,$a,` dritten Zeile`
dc.b	` wird die Eingabe einer Zahl erwartet, in der`,$a
dc.b	` zweiten Zeile die Eingabe eines Befehls.`,$a
dc.b	`   Hier können die Zeichen +, -, *, /`
dc.b	` oder ein Buchstabe eingegegeben werden.`,$a
dc.b	` Buchstaben, die Befehle auslösen:`,$a,$a,9
dc.b	`m = speichern`,9,9,9,`q = quadrieren`,$a,9
dc.b	`s = Wurzel ziehen`,9,9,`v = vergleichen`,$a,9
dc.b	`k = Kehrwert`,9,9,9,`! = Fakultät`,$a,9
dc.b	`w = Vorzeichen wechseln`,9,9,`i = Integer`,$a,9
dc.b	`S = Sinus`,$a,$a
dc.b	` Anstatt eine Zahl einzugeben kann auch`,$a
dc.b	`	- p für pi`,$a
dc.b	`	- m für die Zahl im Speicher`,$a
dc.b	` eingegeben werden.`,$a
dc.b	`   Jede Eingabe kann mit der Backspace-Taste gelöscht`
dc.b	` werden`,$a,` und muß mit Return-Taste abgeschlossen`
dc.b	` werden.`,$a,$a,9,9,`Drücke eine Taste `
dt2:
dc.b	$9b,`0 p`,$9b
dc.b	`K f1, Esc = Hauptmenü`,9,9,9,`f2 = nochmal`,$a,$9b
dc.b	`K f3 = nochmal mit dem Ergebnis`,9,9,`f4 = format ändern `
dc.b	$a,$9b,`K f5 = Ergebnis speichern und nochmal	f6 = help `
dc.b	$9b,` p`
dt3:	dc.b	` Beide Zahlen sind gleich gross`,$a
dt4:	dc.b	` Die erste Zahl ist grösser als die zweite`,$a
dt5:	dc.b	` Die zweite Zahl ist grösser als die erste`,$a
dt6:	dc.b	` Bedingungen für nst und vst:`,$a,9
	dc.b	`- vst und nst müssen durch 4 teilbar sein`,$a,9
	dc.b	`- vst und nst müssen kleiner als 30000 und größer`
	dc.b	`als 19 sein`
dt7:	dc.b	$c,$9b,`20B Speicher =`,$a
dt8:	dc.b	`qr =`,$a
dt9:	dc.b	8,`^2 =`,$a
dt10:	dc.b	$9b,`0 p`,$c,$a,$9b,`24C`,$9b,`4;31;40mHauptmenü`
	dc.b	$9b,`0;31;40m`,$9b
	dc.b	`3E	f1, Esc = Ende`,$9b
	dc.b	`2E	f2 = rechnen`,$9b
	dc.b	`2E	f3 = Pi berechnen`,$9b
	dc.b	`2E	f4 = Hilfe `,$9b
	dc.b	`2E	f5 = Sprache : Deutsch`,$9b,`3E `
	dc.b	$9b,`4;31;40mFeldgröße :`,$9b,`0;31;40m`,$a,$a
	dc.b	9,`vst =`,$a,9,`nst = `,$b
dt11:	dc.b	$9b,`1;42H`,$9b,`4;31;40mIterationen :`
	dc.b	$9b,`0;31;40m       von  `
dt12:	dc.b	$c,$a,$9b,`24C`,$9b,`4;33;40mFehlermeldung`
	dc.b	$9b,`0;31;40m`,$a,$a
dt13:	dc.b	$d,` Bitte eine Taste drücken `,$9b,$4b
dt14:	dc.b	` Im Artwort des Feldes (st3) ist eine Null statt`
	dc.b	` 1,2 oder 3`
dt15:	dc.b	` Wurzel aus einer negativen Zahl`
dt16:	dc.b	$c,` Anzahl der Iterationen ?`,$9b,`4E`
	dc.b	` Die Berechnung kann mit dem linken Mausknopf und`
	dc.b	` der rechten Shifttaste`,$a,` unterbrochen werden`
	dc.b	$9b,`3F>   `
dt17:	dc.b	$9b,`3;1H`
	dc.b	` Weitermachen (y/n) oder quiet (q) ? `,$9b,$4b
dt18:	dc.b	$9b,`5;1H Pi = `,$a
dt19:	dc.b	$9b,`5E Einen Moment ... `
dt20:	dc.b	` =`,$9b,$4b,$a
dt21:	dc.b	` Division durch null`
dt22:	dc.b	$c,` `,$9b,`4;31;40mFeldgröße :`
	dc.b	$9b,`0;31;40m vst = `
dt23:	dc.b	`, nst = `
dt24:	dc.b	$9b,`3;1H Weitermachen`
	dc.b	` (y/n) oder wieder anzeigen (q) ? `,$9b,$4b
dt25:	dc.b	$d,` quiet`,$9b,$4b
dt26:
dt27:	dc.b	` Überlauf bei Addition`
dt28:	dc.b	` Überlauf bei Division`
dt29:	dc.b	` Überlauf bei Multiplikation`
dt30:	dc.b	$d,` Zahl speichern (y/n) ? `,$9b,$4b
dt31:	dc.b	$d,` Zahl gespeichert als : `,$9b,$4b
dt32:	dc.b	$d,` Dateiname : `,$9b,$4b
dt33:	dc.b	`   < Taste > `,$9b,$4b
dt34:	dc.b	` Fakultät einer negativen Zahl und einer nicht`
	dc.b	`ganzen Zahl ist nicht erlaubt`
dt35:	dc.b	8,`* -1 =`,$a
dt36:	dc.b	8,`^ -1 =`,$a
dt37:	dc.b	8,`integer =`,$a
dt38:	dc.b	$a,` Format : unformatiert`,$9b,$4b,$9b,`3F`
dt39:	dc.b	$a,` Format : formatiert`,$9b,$4b,$9b,`3F`
dt40:	dc.b	$d,` Fehler : Datei konnte nicht geöffnet werden `
	dc.b	`     < Taste >`,$9b,$4b
dt41:	dc.b	$a,`  Datei `,34,`pidat`,34,` konnte nicht`
	dc.b	` geöffnet werden     < Taste > `,$9b,$4b
dt42:	dc.b	8,`Sinus =`,$a
dt43:	dc.b	$d,` Nicht gespeichert     < Taste > `
dt44:	dc.b	$a,9,`Nicht genug Speicher !`
dt45:	dc.b	$a,9,`Konnte Fenster nicht öffnen !`
dt46:

; englische texte

et1:
dc.b	$c,$9b,`0 p`,$9b,`20C`,$9b,`4;31;40mHow to enter a`
dc.b	` number`,$9b,`0;31;40m`,$a,$a
dc.b	`   The prompt > requests your enters. `
dc.b	`In the first`,$a,` and third line`
dc.b	` you are expected to type in a number,`,$a
dc.b	` in the second line a command.`,$a
dc.b	` These are the commands :`,$a,$a
dc.b	9,`+, -, *, / = add, subract, multiply, divide`,$a
dc.b	9,`m = copy to memory`,9,9,`q = square`,$a
dc.b	9,`s = square root`,9,9,9,`v = compare`,$a
dc.b	9,`k = reciprocal`,9,9,9,`! = faculty`,$a
dc.b	9,`w = change sign`,9,9,9,`i = integer`,$a
dc.b	9,`S = sine`,$a,$a
dc.b	` Instead of typing a number you can type`,$a
dc.b	`	- m for the number that is currently in the `
dc.b	`memory and `,$a,9,`    is displayed at the bottom or `
dc.b	$a,`	- p for pi`
dc.b	$a,`   Each number and command must be concluded by `
dc.b	`<RETURN>`,$a,` and can be erased by <BACKSPACE>.`
dc.b	$a,$a,9,9,` Press any key `
et2:
dc.b	$9b,`0 p`,$9b
dc.b	`K f1, Esc = Main Menu`,9,9,9,`f2 = once again`,$a,$9b
dc.b	`K f3 = once again with result`,9,9,`f4 = change format`
dc.b	$a,$9b,`K f5 = store result and once again	f6 = help `
dc.b	$9b,` p`
et3:	dc.b	` The numbers are equal`,$a
et4:	dc.b	` The first number is higher`,$a
et5:	dc.b	` The second number is higher`,$a
et6:	dc.b	` Conditions for st : `,$a,$a
dc.b	`	vst and nst can be divided by 4 without a rest`
dc.b	$a,`	vst and nst must be smaller than 30000 and `
dc.b	`greater than 19`
et7:	dc.b	$c,$9b,`20B memory =`,$a
et8:	dc.b	`qr =`,$a
et9:	dc.b	8,`^2 =`,$a
et10:	dc.b	$9b,`0 p`,$c,$a,$9b,`24C`,$9b,`4;31;40mMain menu`
	dc.b	$9b,`0;31;40m`,$9b
	dc.b	`3E	f1, Esc = Exit`,$9b
	dc.b	`2E	f2 = calculate`,$9b
	dc.b	`2E	f3 = calculate pi`,$9b
	dc.b	`2E	f4 = help `,$9b
	dc.b	`2E	f5 = language : English`,$9b,`3E `
	dc.b	$9b,`4;31;40mSize of numbers :`,$9b,`0;31;40m`
	dc.b	$a,$a,9,`vst =`,$a,9,`nst = `,$b
et11:	dc.b	$9b,`1;43H`,$9b,`4;31;40mIterations :`
	dc.b	$9b,`0;31;40m       of  `
et12:	dc.b	$c,$a,$9b,`24C`,$9b,`4;33;40mErrormessage`
	dc.b	$9b,`0;31;40m`,$a,$a
et13:	dc.b	$d,` Press any key `,$9b,$4b
et14:	dc.b	` In the signword of the array is 0 instead of`
	dc.b	` 1,2 or 3`
et15:	dc.b	` Squareroot of a negative number`
et16:	dc.b	$c,` How many iterations ?`,$9b,`4`,$45
	dc.b	` The calculation can be interrupted by pressing `
	dc.b	`the left mousebutton`,$a,` or pressing the right`
	dc.b	` shift-key`,$9b,`3F>   `
et17:	dc.b	$9b,`3;1H`
	dc.b	` Go on (y/n) oder quiet (q) ? `,$9b,$4b
et18:	dc.b	$9b,`5;1H pi = `,$a
et19:	dc.b	$9b,`5`,$45,` one moment please ... `
et20:	dc.b	` =`,$9b,$4b,$a
et21:	dc.b	` Division by 0`
et22:	dc.b	$c,` `,$9b,`4;31;40mSize of numbers :`
	dc.b	$9b,`0;31;40m vst = `
et23:	dc.b	`, nst = `
et24:	dc.b	$9b,`3;1H Go on`
	dc.b	` (y/n) or print pi (q) ? `,$9b,$4b
et25:	dc.b	$d,` quiet`,$9b,$4b
et26:
et27:	dc.b	` Overflow at addition`
et28:	dc.b	` Overflow at division`
et29:	dc.b	` Overflow at multiplikation`
et30:	dc.b	$d,` Write pi to file (y/n) ? `,$9b,$4b
et31:	dc.b	$d,` Number saved as : `,$9b,$4b
et32:	dc.b	$d,` File name : `,$9b,$4b
et33:	dc.b	`   < press any key > `,$9b,$4b
et34:	dc.b	` Faculty of a negative and of a not integer number`
	dc.b	`is not allowed`
et35:	dc.b	8,`* -1 =`,$a
et36:	dc.b	8,`^ -1 =`,$a
et37:	dc.b	8,`integer =`,$a
et38:	dc.b	$a,` format : not formatted`,$9b,$4b,$9b,`3F`
et39:	dc.b	$a,` format : formatted`,$9b,$4b,$9b,`3F`
et40:	dc.b	$a,` File `,34,`pidat`,34,` could not be opened `
	dc.b	`     < press any key >`,$9b,$4b
et41:	dc.b	$a,`  File `,34,`pidat`,34,` not found`
	dc.b	`    < press any key >`,$9b,$4b
et42:	dc.b	8,`sine =`,$a
et43:	dc.b	$d,$9b,`K Not done		< press any key >`
et44:	dc.b	$a,9,`ADAM : short of memory !`
et45:	dc.b	$a,9,`Could not open window !`
et46:
even

conhandle:
text_tab:
dc.l	0;			conhandle
dc.l	eng_ttab-text_tabanf;	distanzwert für sprache
text_tabanf:
dc.l	0,0;	text0 gibt es nicht
dc.l	dt1,dt2-dt1,dt2,dt3-dt2,dt3,dt4-dt3,dt4,dt5-dt4
dc.l	dt5,dt6-dt5,dt6,dt7-dt6,dt7,dt8-dt7,dt8,dt9-dt8
dc.l	dt9,dt10-dt9,dt10,dt11-dt10,dt11,dt12-dt11
dc.l	dt12,dt13-dt12,dt13,dt14-dt13,dt14,dt15-dt14
dc.l	dt15,dt16-dt15,dt16,dt17-dt16,dt17,dt18-dt17
dc.l	dt18,dt19-dt18,dt19,dt20-dt19,dt20,dt21-dt20
dc.l	dt21,dt22-dt21,dt22,dt23-dt22,dt23,dt24-dt23
dc.l	dt24,dt25-dt24,dt25,dt26-dt25,dt26,dt27-dt26
dc.l	dt27,dt28-dt27,dt28,dt29-dt28,dt29,dt30-dt29
dc.l	dt30,dt31-dt30,dt31,dt32-dt31,dt32,dt33-dt32
dc.l	dt33,dt34-dt33,dt34,dt35-dt34,dt35,dt36-dt35
dc.l	dt36,dt37-dt36,dt37,dt38-dt37,dt38,dt39-dt38
dc.l	dt39,dt40-dt39,dt40,dt41-dt40,dt41,dt42-dt41
dc.l	dt42,dt43-dt42,dt43,dt44-dt43,dt44,dt45-dt44
dc.l	dt45,dt46-dt45
eng_ttab:
dc.l	0,0,et1,et2-et1,et2,et3-et2,et3,et4-et3,et4,et5-et4
dc.l	et5,et6-et5,et6,et7-et6,et7,et8-et7,et8,et9-et8
dc.l	et9,et10-et9,et10,et11-et10,et11,et12-et11
dc.l	et12,et13-et12,et13,et14-et13,et14,et15-et14
dc.l	et15,et16-et15,et16,et17-et16,et17,et18-et17
dc.l	et18,et19-et18,et19,et20-et19,et20,et21-et20
dc.l	et21,et22-et21,et22,et23-et22,et23,et24-et23
dc.l	et24,et25-et24,et25,et26-et25,et26,et27-et26
dc.l	et27,et28-et27,et28,et29-et28,et29,et30-et29
dc.l	et30,et31-et30,et31,et32-et31,et32,et33-et32
dc.l	et33,et34-et33,et34,et35-et34,et35,et36-et35
dc.l	et36,et37-et36,et37,et38-et37,et38,et39-et38
dc.l	et39,et40-et39,et40,et41-et40,et41,et42-et41
dc.l	et42,et43-et42,et43,et44-et43,et44,et45-et44
dc.l	et45,et46-et45

; schriftzeichen
pu:	dc.b	`.`
nu:	dc.b	`0`

; steuerzeichen
bs1:	dc.b	8,$20,8
home:	dc.b	$9b,$48
str2:	dc.b	$9b,`1;56H`
str3:	dc.b	$9b,`3;1H`
plumi:	dc.b	$d,`> -`
miplu:	dc.b	$d,`>   `
zeiloe:	dc.b	$9b,$4b
lflf:	dc.b	$a,$a
ergeb:	dc.b	`>   =`,$9b,$4b,$a
cmp_tab:dc.b	`01234`
sicht:	dc.b	$9b,` p`
r:	dc.b	0,0,0,0

; variablenfelder (anzahl auch bei variab_anz ändern !)

even
speicher:	dc.l	0;	memoryfeld
bcd1:		dc.l	0
bcd2:		dc.l	0
bcd3:		dc.l	0
bcd4:		dc.l	0
bcd5:		dc.l	0
bcd6:		dc.l	0
bcd7:		dc.l	0
bcd8:		dc.l	0
bcd9:		dc.l	0

; rechenfelder  (anzahl auch bei rech_anz ändern !)

sqr1:		dc.l	0;	für sqrroot
sqr2:		dc.l	0;	für sqrroot
sqr3:		dc.l	0;	für sqrroot
sqr4:		dc.l	0;	für sqrroot
sqr5:		dc.l	0;	für sqrroot

; dezimalkonstanten   (anzahl auch bei dez_anz ändern !)

dez1:		dc.l	0
dez2:		dc.l	0
dez3:		dc.l	0

; sonstige felder

r1:		dc.l	0; für mals
rt1:		dc.l	0; für div und mals und minusu und decrem
tabr:		dc.l	0; multiplikationstabelle für div und mals
byte1:		dc.l	0; für zahlein und druck
buffer:		dc.l	0; eingabe- und ausgabefeld
pi:		dc.l	0

; daten fur die zahlenkonstanten. bevor das ausgabefenster geöffnet
; wird, werden die daten in die variablen dez1,dez2... übertragen.
; sie dürfen vom programm nicht verändert werden !!!

dezdat1:	dc.w	1,0,2;		1
		dc.b	1,0
		dc.w	0,1,2;		0.2
		dc.b	2,0
		dc.w	3,0,2;		1/239
		dc.b	2,3,9,0

stackpt:	dc.l	0
dosbase:	dc.l	0
datname:	blk.b	44,0
memlist:	blk.l	30,0
fehler:		dc.w	0
divzaeh:	dc.w	0

; die folgenden variablen nicht umstellen !!!

z1:		dc.w	0
z2:		dc.w	0
z3:		dc.w	0
punknum:	dc.w	0
vor:		dc.w	0
nach:		dc.w	0
vorzei:		dc.b	0

plflag:		dc.b	0
fdruck:		dc.b	0
format:		dc.b	0
op:		dc.b	0