WebSVN – pentevo – Blame – /tools/asl/asl-current/tests/t_fl900/float.inc

Rev	Author	Line No.	Line
1186	savelij	1	; FLOAT.INC
		2	;******************************************************************************
		3	;* Gleitkommabibliothek fuer TLCS 900 *
		4	;* *
		5	;* Originale fuer den 68000 aus mc, bis auf die Quadratwurzel aus c't *
		6	;* Portierung auf TLCS 900 von Alfred Arnold, Oktober 1993 *
		7	;* *
		8	;* Routine Funktion Eingabe Ausgabe Stack Laenge Zeit/14MHz *
		9	;* *
		10	;* fadd Addition XWA+XHL XWA 12 Byte 194 Byte 60 us *
		11	;* fsub Subtraktion XWA-XHL XWA 12 Byte 7 Byte 65 us *
		12	;* fmul Multiplikation XWAXHL XWA 20 Byte 218 Byte 70 us
		13	;* fdiv Division XWA/XHL XWA 20 Byte 147 Byte 300 us *
		14	;* fmul2 Mult. mit 2er-Potenz XWA(2^BC) XWA 6 Byte 99 Byte 20 us
		15	;* fitof Int-->Float XWA XWA 4 Byte 41 Byte 90 us *
		16	;* fftoi Float-->Int XWA XWA 2 Byte 72 Byte 20 us *
		17	;* fsqrt Quadratwurzel XWA XWA 16 Byte 192 Byte 220 us *
		18	;* fftoa Float-->ASCII XWA (XHL),BC ~38 Byte 228 Byte ~4500 us *
		19	;* fatof ASCII-->Float (XHL),BC XWA,[BC] ~40 Byte 260 Byte ~2300 us *
		20	;* *
		21	;* - Wollen Sie einzelne Routinen entfernen, so beachten Sie, dass fsub Teile *
		22	;* aus fadd und fdiv Teile aus fmul verwendet ! *
		23	;* - Gleitkommaformat ist IEEE Single (32 Bit) *
		24	;* - Integerwerte bei fmul2, fitof und fftoi sind vorzeichenbehaftet *
		25	;* - Der Prozessor muss sich im Maximum-Modus befinden *
		26	;* - Da die Routinen lokale Labels verwenden, ist mindestens AS 1.39 erfor- *
		27	;* derlich *
		28	;* - Die Ausfuehrungszeiten koennen je nach Operand streuen, insbesondere bei *
		29	;* den Konvertierungsfunktionen *
		30	;* - MACROS.INC muss vorher eingebunden werden *
		31	;******************************************************************************
		32
		33	;------------------------------------------------------------------------------
		34	; gemeinsamer Anfang, Makros
		35
		36	shifta macro op,dest ; Schieben, falls evtl. A>=16
		37	push a ; A wird zerschossen
		38	bit 4,a ; Akku im Bereich 16..31 ?
		39	jr z,smaller
		40	op 16,dest ; dann einmal gross schieben
		41	smaller: push f ; Carry erhalten
		42	and a,15 ; obere Bits plaetten
		43	jr z,fertig
		44	pop f ; evtl. Rest verarbeiten
		45	op a,dest
		46	jr ende ; Carry schon gut
		47	fertig: pop f
		48	ende: pop a ; A zurueck
		49	endm
		50
		51	section FloatLib
		52
		53	;------------------------------------------------------------------------------
		54	; Konstanten
		55
		56	Ld10: dd ld(10) ; Konversionskonstanten
		57	One: dd 1.0
		58	Half: dd 0.5
		59	Ten: dd 10.0
		60	Tenth: dd 3dcccccdh ; =0.1, aber die Rundung auf manchen
		61	; Systemen variiert (damit Test nicht
		62	; scheitert)
		63
		64	Bias equ 127
		65	MaxExpo equ 255
		66	Comma equ '.'
		67
		68	;------------------------------------------------------------------------------
		69	; Addition: XWA=XWA+XHL
		70
		71	proc fadd
		72
		73	push xbc ; andere Register retten
		74	push xde
		75	push xhl
		76
		77	ld xde,xwa ; Operand 1 nach XDE verschieben
		78	rlc 1,xde ; Vorzeichen der Operanden nach Bit 0
		79	rlc 1,xhl
		80	ld xbc,xde ; Differenz bilden
		81	sub xbc,xhl
		82	jr nc,NoSwap ; evtl. vertauschen, so dass
		83	ld xwa,xhl ; groessere in XDE
		84	ld xhl,xde
		85	ld xde,xwa
		86	NoSwap: ld qa,e ; Vorzeichen 1 ausmaskieren
		87	and qa,1 ; (=Ergebnis Vorzeichen)
		88	bit 0,c ; gleiches Vorzeichen ?
		89	jr z,NoSub
		90	set 1,qa ; dann Subtraktion vormerken
		91
		92	NoSub: sub xbc,xbc ; XBC initialisieren
		93	rlc 8,xde ; Exponent 1 rausholen
		94	ld c,e
		95	or e,e ; falls <>0, implizite 1 einbauen
		96	scc nz,e
		97	rrc 1,xde
		98	ld e,0 ; Bit 0..7 wieder plaetten
		99
		100	rlc 8,xhl ; dito Exponent 2 extrahieren
		101	ld qc,l
		102	or l,l
		103	scc nz,l
		104	rrc 1,xhl
		105	ld l,0
		106
		107	; Zwischenstand:
		108	; - Mantissen linksbuendig inkl. impliziter Eins in XDE und XHL
		109	; - Exponent 1 in BC, Exponent 2 in QBC
		110	; - Ergebnisvorzeichen in QA, Bit 0
		111	; - Subtraktionsflag in QA, Bit 1
		112
		113	ld wa,bc ; Exponentendifferenz berechnen
		114	sub wa,qbc
		115	cp wa,24 ; >24, d.h. Zahl 2 vernachlaessigbar gegen Zahl 1
		116	jr gt,Round ; ja, Ergebnis ist groessere Zahl
		117	shifta srl,xhl ; ansonsten Mantisse 2 entspr. anpassen
		118
		119	Add: bit 1,qa ; subtrahieren ?
		120	jr nz,Subtract ; ja-->
		121	add xde,xhl ; nein, Mantissen addieren
		122	jr nc,Round ; kein Ueberlauf, runden
		123	rr 1,xde ; ansonsten Ueberlauf einschieben...
		124	inc bc ; ...und Exponent korrigieren
		125	jr Round ; normal weiter runden
		126
		127	Subtract: sub xde,xhl ; Mantissen subtrahieren
		128	jr z,Zero ; falls Null, Gesamtergebnis 0
		129	jr m,Round ; fuehrende 1 noch da: zum Runden
		130	Normalize: or bc,bc ; Exponent bereits Null ?
		131	jr z,Round ; dann denormales Ergebnis
		132	dec bc ; ansonsten Mantisse eins rauf, Exponent
		133	sll 1,xde ; eins runter
		134	jr p,Normalize ; solange, bis Eins auftaucht
		135
		136	Round: add xde,80h ; Rundung auf Bit hinter Mantisse
		137	jr nc,NoOver
		138	rr 1,xde ; Bei Ueberlauf korrigieren
		139	inc bc
		140	NoOver: ld e,0 ; Mantissenrest plaetten
		141	or xde,xde ; insgesamt 0 ?
		142	jr z,Zero ; dann Ergebnis 0
		143	cp bc,MaxExpo ; Exponentenueberlauf ?
		144	jr lt,NoEOver
		145	ld bc,MaxExpo ; ja: Unendlich: Exponent=Maximum
		146	sub xde,xde ; Mantisse=0
		147	jr Denormal
		148
		149	NoEOver: or bc,bc ; Exponent 0 ?
		150	jr z,Denormal ; ja, denormal
		151	sll 1,xde ; fuehrende Eins nicht speichern
		152	Denormal: ld e,c ; Exponenten einbauen
		153	rrc 8,xde ; nach oben schieben
		154	rr 1,qa ; Vorzeichen einbauen
		155	rr 1,xde
		156
		157	Zero: ld xwa,xde ; Ergebnis in Akku
		158
		159	pop xhl ; Register zurueck
		160	pop xde
		161	pop xbc
		162
		163	ret
		164
		165	endp
		166
		167	;------------------------------------------------------------------------------
		168	; Subtraktion: XWA=XWA-XHL
		169
		170	proc fsub
		171
		172	xor qh,80h ; Vorzeichen 2 drehen
		173	jp fadd ; ansonsten wie Addition
		174
		175	endp
		176
		177	;------------------------------------------------------------------------------
		178	; Multiplikation: XWA=XWA*XHL
		179
		180	proc fmul
		181
		182	public MulRound:Parent,MulZero:Parent,MulResult:Parent
		183	public DivError:Parent
		184
		185	push xbc ; Register retten
		186	push xde
		187	push xhl
		188	push xix
		189	push xiy
		190
		191	ld xiy,xwa ; Op1 kopieren
		192	xor xiy,xhl ; Ergebnisvorzeichen bestimmen
		193
		194	ex wa,qwa ; Registerhaelften Op1 vertauschen
		195	ld xde,xwa ; Op1 ab sofort in XDE
		196	and de,7fh ; Exponent und Vz. behandeln
		197	and wa,7f80h ; Exponent maskieren
		198	jr z,Denorm1 ; gleich Null-->Op1 denormal
		199	set 7,de ; ansonsten implizite Eins einbauen
		200	sub wa,80h ; Bias kompensieren
		201	Denorm1:
		202	ex hl,qhl ; Op2 genauso behandeln
		203	ld xbc,xhl
		204	and hl,7fh
		205	and bc,7f80h
		206	jr z,Denorm2
		207	set 7,hl
		208	sub bc,80h
		209	Denorm2:
		210	add bc,wa ; Exponenten addieren
		211	srl 7,bc ; richtig positionieren
		212	sub bc,Bias-3 ; Bias-3 abziehen
		213	cp bc,-24 ; totaler Unterlauf ?
		214	jr lt,MulZero ; dann Ergebnis 0
		215
		216	ld wa,de ; beide oberen Haelften multiplizieren
		217	mul xwa,hl
		218	ex wa,qwa ; Ergebnis in oberer Haelfte lagern
		219	ld wa,de ; obere Haelfte Op1 retten
		220	ex de,qde ; untere Haelfte Op1 holen
		221	ld ix,hl ; untere Haelfte Op1 * obere Op2
		222	mul xix,de
		223	ex hl,qhl ; untere Op1 * untere Op2
		224	mul xde,hl
		225	ex de,qde ; obere Op1 * untere Op2
		226	mul xhl,wa
		227
		228	ld wa,de ; Teile aufaddieren
		229	add xwa,xix
		230	add xwa,xhl
		231	jr z,MulResult ; Mantisse Null, Ergebnis Null
		232	jr m,MulRound
		233
		234	or bc,bc ; Exponent negativ ?
		235	jr m,Unterlauf ; ggfs. Unterlauf behandeln
		236
		237	Nor: or bc,bc ; Exponent Null ?
		238	jr z,MulRound ; ja-->zum Runden
		239	rl 1,xde ; nein, Mantisse eins nachschieben
		240	rl 1,xwa
		241	dec bc ; und Exponent runter
		242	or xwa,xwa ; fuehrende Eins da ?
		243	jr p,Nor ; nein, weiterschieben
		244
		245	MulRound: add xwa,80h ; Rundung
		246	jr nc,NoROver ; dabei Ueberlauf ?
		247	rr 1,xwa ; ja: Mantisse & Exponent korrigieren
		248	inc bc
		249	NoROver: cp bc,MaxExpo ; Exponentenueberlauf ?
		250	jr lt,NoEOver
		251	DivError: ld bc,MaxExpo ; dann unendlich einstellen
		252	sub xwa,xwa
		253	jr Denormal
		254
		255	NoEOver: or bc,bc ; Exponent 0 ?
		256	jr z,Denormal
		257	sll 1,xwa ; fuehrende 1 loeschen
		258
		259	Denormal: ld a,c ; Exponent einbauen
		260	rrc 8,xwa ; hochschieben
		261	rl 1,xiy ; Vorzeichen einbauen
		262	rr 1,xwa
		263
		264	MulResult: pop xiy
		265	pop xix
		266	pop xhl
		267	pop xde
		268	pop xbc
		269
		270	ret
		271
		272	MulZero: sub xwa,xwa ; Null erzeugen
		273	jr MulResult
		274
		275	Unterlauf: cp bc,-24 ; totaler Unterlauf ?
		276	jr le,MulZero ; dann Null
		277	neg bc ; sonst umbauen
		278	ld xde,xwa ; dazu Akku freimachen
		279	sub wa,wa ; Endexponent
		280	ex wa,bc ; ist 0
		281	shifta srl,xde ; Mantisse herunterschieben
		282	ld xwa,xde ; Ergebnis zurueck nach XWA
		283	jr MulRound ; zurueck mit Exponent 0
		284
		285	endp
		286
		287	;------------------------------------------------------------------------------
		288	; Division: XWA=XWA/XHL
		289
		290	proc fdiv
		291
		292	push xbc ; Register retten (muss gleich zu fmul sein)
		293	push xde
		294	push xhl
		295	push xix
		296	push xiy
		297
		298	ld xiy,xwa ; Op1 kopieren
		299	xor xiy,xhl ; Ergebnisvorzeichen bestimmen
		300
		301	ex wa,qwa ; Vorbehandlung wie bei fmul
		302	ld xde,xwa
		303	and de,7fh
		304	and wa,7f80h
		305	jr z,Denorm1
		306	set 7,de
		307	sub wa,80h
		308	Denorm1:
		309	ex hl,qhl
		310	ld xbc,xhl
		311	and hl,7fh
		312	and bc,7f80h
		313	jr z,Denorm2
		314	set 7,hl
		315	sub bc,80h
		316	Denorm2:
		317	sub wa,bc ; Exponentendifferenz bilden
		318	ld bc,wa ; muс in BC liegen
		319	sra 7,bc ; richtig positionieren
		320	add bc,Bias ; Bias addieren
		321	cp bc,-24 ; totaler Unterlauf ?
		322	jr lt,MulZero ; ja, Ergebnis Null
		323
		324	ex hl,qhl ; Format 0fff ... ffff 0000 0000
		325	or xhl,xhl ; Ergebnis unendlich ?
		326	jrl z,DivError
		327	sll 7,xhl
		328	ex de,qde ; dito Divident
		329	or xde,xde ; falls Null, Ergebnis Null
		330	jrl z,MulZero
		331	sll 7,xde
		332
		333	NormLoop: bit 14,qhl ; Divisor normalisiert ?
		334	jr nz,Normal
		335	inc bc ; nein, Exponent RAUF (ist Ergebnisexponent)
		336	sll 1,xhl
		337	jr NormLoop
		338
		339	Normal: sub xwa,xwa ; Ergebnisquotient vorbesetzen
		340	add bc,25 ; Exponent nicht groesser als 0
		341
		342	Loop: ld xix,xde ; Divident zwischenspeichern
		343	sub xde,xhl ; probeweise abziehen
		344	ccf ; Carry drehen
		345	jr c,IsOne ; ungedrehter Carry=1: Divisor paсt
		346	ld xde,xix ; ansonsten zurueckkopieren
		347	IsOne: rl 1,xwa ; Ergebnisbit einschieben
		348	sll 1,xde ; Divident verschieben
		349	dec bc ; Exponent runter
		350	or bc,bc
		351	jr z,Denorm ; falls Null, denormalisieren
		352	bit 8,qwa ; fuehrende Eins da ?
		353	jr z,Loop ; nein, weiterrechnen
		354
		355	Denorm: sll 7,xwa ; Mantisse positionieren
		356	jrl z,MulResult ; Ergebnis 0 ?
		357	jrl MulRound ; ansonsten zum Runden
		358
		359	endp
		360
		361	;-----------------------------------------------------------------------------
		362	; Multiplikation mit Zweierpotenz: XWA=XWA*2^BC
		363
		364	proc fmul2
		365
		366	push bc ; Register retten
		367	push xde
		368
		369	ld xde,xwa ; Vorzeichen merken
		370	sll 1,xwa ; Vorzeichen rausschieben
		371	jr z,Zero ; falls Null, Ergebnis Null
		372	rlc 8,xwa ; Exponent nach unten...
		373	sub de,de ; und in DE packen
		374	add e,a
		375	jr z,Denorm ; falls denormalisiert..
		376	or bc,bc ; Multiplikation oder Division ?
		377	jr m,Divide ; (neg. Exponent=Division)
		378
		379	add de,bc ; Exponent addieren
		380	cp de,MaxExpo ; Ueberlauf ?
		381	jr ge,Over ; ja, Ergebnis unendlich
		382	Result: ld a,e ; Ergebnisexponent einbauen
		383	rrc 8,xwa ; Exponent nach oben
		384	rl 1,xde ; Vorzeichen einschieben
		385	rr 1,xwa
		386
		387	Zero: pop xde ; Register zurueck
		388	pop bc
		389	ret
		390
		391	Over: ld de,MaxExpo ; Ergebnis unendlich
		392	sub xwa,xwa
		393	jr Result
		394
		395	Divide: add de,bc ; Exponentensumme bilden
		396	jr gt,Result ; >0, keine Sonderbehandlung
		397	scf ; ansonsten 1 explizit fБr
		398	rr 1,xwa ; denormale Zahl machen
		399	DDenorm: or de,de ; Exponent=0 ?
		400	jr z,Result ; ja, Ergebnis einfach denormal
		401	srl 1,xwa ; ansonsten weiter denormalisieren
		402	jr z,Zero ; dabei totaler Unterlauf->Null
		403	inc de ; Exponent korrigieren
		404	jr DDenorm
		405	DDDenorm: add de,bc ; Exponentensumme bilden
		406	jr DDenorm
		407
		408	Denorm: or bc,bc ; Multiplikation oder Division ?
		409	jr m,DDDenorm
		410	sub a,a ; alten Exponenten loeschen
		411	Norm: sll 1,xwa ; normalisieren...
		412	jr c,Stop ; bis fuehrende Eins da
		413	dec bc ; oder 2. Exponent 0
		414	or bc,bc
		415	jr nz,Norm
		416	jr Result ; Multiplikator kompl. fuer Normalisierung draufgegangen
		417	Stop: add de,bc ; Rest addieren
		418	jr Result ; alles andere schon o.k.
		419
		420	endp
		421
		422	;------------------------------------------------------------------------------
		423	; LongInt-->Float : XWA-->XWA
		424
		425	proc fitof
		426
		427	push xbc ; Register retten
		428
		429	or xwa,xwa ; Null ?
		430	jr z,Result ; dann Ergebnis Null
		431	scc m,qc ; Vorzeichen nach QC, Bit 0
		432	jr p,Positive
		433	cpl wa ; falls negativ,drehen
		434	cpl qwa
		435	inc xwa
		436	Positive: ld bc,Bias+32 ; Exponent vorbesetzen
		437	Shift: dec bc ; Mantisse verschieben
		438	sll 1,xwa
		439	jr nc,Shift
		440	ld a,c ; Exponent einbauen
		441	rrc 8,xwa ; Exponent nach oben
		442	rr 1,qc ; Vorzeichen einbauen
		443	rr 1,xwa
		444
		445	Result: pop xbc ; Register zurueck
		446	ret
		447
		448	endp
		449
		450	;------------------------------------------------------------------------------
		451	; Float-->LongInt : XWA-->XWA
		452
		453	proc fftoi
		454
		455	push bc ; Register retten
		456
		457	rl 1,xwa ; Vorzeichen in Carry
		458	scc c,b ; in B merken
		459
		460	rlc 8,xwa ; Exponent nach unten
		461	ld c,a ; in C legen
		462	sub c,Bias ; Bias abziehen
		463
		464	jr m,Zero ; neg. Exponent -> Zahl<0 -> Ergebnis 0
		465	cp c,31 ; Ueberlauf ?
		466	jr ge,Over
		467
		468	scf ; fuehrende Eins einschieben
		469	rr 1,xwa
		470	sub a,a ; Exponent loeschen
		471
		472	Shift: srl 1,xwa ; jetzt schieben, bis Ergebnis stimmt
		473	inc c
		474	cp c,31
		475	jr ne,Shift
		476
		477	srl 1,b ; negieren ?
		478	jr nc,Positive
		479	cpl wa ; ggfs. negieren
		480	cpl qwa
		481	inc xwa
		482
		483	Positive: pop bc ; Register zurueck
		484	ret
		485
		486	Zero: sub xwa,xwa ; Ergebnis 0
		487	jr Positive
		488
		489	Over: ld xwa,7fffffffh ; Ueberlauf: Maxint zurueckgeben
		490	srl 1,b ; negativ ?
		491	jr nc,Positive
		492	cpl wa ; ja, neg. Maximum zurueckgeben
		493	cpl qwa
		494	jr Positive
		495
		496	endp
		497
		498	;------------------------------------------------------------------------------
		499	; Quadratwurzel: XWA=SQRT(XWA)
		500
		501	proc fsqrt
		502
		503	push xbc ; Register retten
		504	push xde
		505	push xhl
		506	push xix
		507
		508	ld xix,xwa ; Argument retten
		509	or xix,xix ; Zahl negativ ?
		510	jrl m,DomainError ; dann geht es nicht
		511
		512	ex ix,qix ; MSW holen
		513	and xix,7f80h ; Exponent isolieren
		514	jrl z,Zero ; keine Behandlung denormaler Zahlen
		515
		516	and xwa,7fffffh ; Mantisse isolieren
		517	sub ix,7fh*80h ; Bias vom Exponenten entfernen
		518	bit 7,ix ; Exponent ungerade ?
		519	res 7,ix
		520	jr z,EvenExp
		521	add xwa,xwa ; ja: Mantisse verdoppeln
		522	add xwa,1000000h-800000h ; impl. Eins dazu
		523	EvenExp: ; erste Iteration ohne impl. Eins
		524	sra 1,ix ; Exponent/2 mit Vorzeichen
		525	add ix,7fh*80h ; Bias wieder dazu
		526	ex ix,qix ; neuen Exponenten in QIX aufheben
		527	sll 7,xwa ; x ausrichten
		528	ld xde,40000000h ; xroot nach erster Iteration
		529	ld xhl,10000000h ; m2=2 << (MaxBit-1)
		530	Loop10: ld xbc,xwa ; xx2 = x
		531	Loop11: sub xbc,xde ; xx2 -= xroot
		532	srl 1,xde ; xroot = xroot/2
		533	sub xbc,xhl ; x2 -= m2
		534	jr m,DontSet1
		535	ld xwa,xbc ; x = xx2
		536	or xde,xhl ; xroot += m2
		537	srl 2,xhl ; m2 = m2/4
		538	jr nz,Loop11
		539	jr WABCSame
		540	DontSet1: srl 2,xhl ; m2 = m2/4
		541	jr nz,Loop10 ; 15* abarbeiten
		542	; Bit 22..8
		543	ld xbc,xwa ; 17. Iteration separat
		544	WABCSame: sub xbc,xde
		545	rrc 1,xde ; mitsamt Carry...
		546	ex de,qde ; auf neues Alignment umstellen
		547	sub xbc,1 ; Carry von 0-$4000: x2 -= m2
		548	jr m,DontSet7
		549	or xbc,-40000000h ; 0-$4000: x2 -= m2, Teil 2
		550	ld xwa,xbc
		551	or de,4000h ; xroot += m2
		552	DontSet7: ex wa,qwa ; x auf neues Alignment umstellen
		553	ld hl,1000h ; m2 - obere Haelfte schon 0
		554	Loop20: ld xbc,xwa ; xx2 = x
		555	Loop21: sub xbc,xde ; xx2 -= xroot
		556	srl 1,xde ; xroot = xroot/2
		557	sub xbc,xhl ; x2 -= m2
		558	jr m,DontSet2
		559	ld xwa,xbc ; x = xx2
		560	or xde,xhl ; xroot += m2
		561	srl 2,xhl ; m2 = m2/4
		562	jr nz,Loop21
		563	jr Finish
		564	DontSet2: srl 2,xhl ; m2 = m2/4
		565	jr nz,Loop20 ; 7* abarbeiten
		566
		567	Finish: sub xwa,xde ; Aufrunden notwendig ?
		568	jr ule,NoInc
		569	inc xde ; wenn ja, durchfuehren
		570	NoInc: res 7,qde ; impl. Eins loeschen
		571	or xde,xix
		572	ld xwa,xde ; Ergebnis in XWA
		573	jr End
		574
		575	DomainError: ld xwa,0ffc00000h ; -NAN zurueckgeben
		576	jr End
		577
		578	Zero: sub xwa,xwa ; Ergebnis 0
		579
		580	End: pop xix ; Register zurueck
		581	pop xhl
		582	pop xde
		583	pop xbc
		584	ret
		585
		586	endp
		587
		588	;------------------------------------------------------------------------------
		589	; Unterroutine Zehnerpotenz bilden: XWA=10.0^BC
		590
		591	section fPot10 ; nicht mit proc, da private Funktion
		592	public fPot10:Parent
		593	fPot10:
		594
		595	push xbc ; Register retten
		596	push xhl
		597
		598	ld xwa,(One) ; Ausgangspunkt fuers Multiplizieren
		599	ld xhl,(Ten) ; zu benutzende Potenz
		600	or bc,bc ; negative Potenz ?
		601	jr p,IsPos
		602	ld xhl,(Tenth) ; dann eben Zehntel multiplizieren
		603	neg bc ; fuer Schleife immer positiv
		604	IsPos:
		605	or bc,bc ; Noch weiter multiplizieren ?
		606	jr z,End
		607	bit 0,bc ; Restpotenz ungerade ?
		608	jr z,IsEven
		609	call fmul ; ja: einzeln multiplizieren
		610	IsEven: srl 1,bc ; naechste Stelle
		611	push xwa ; neue Potenz berechnen
		612	ld xwa,xhl
		613	call fmul ; durch quadrieren
		614	ld xhl,xwa
		615	pop xwa
		616	jr IsPos ; weiter nach Einsen suchen
		617
		618	End: pop xhl ; Register zurueck
		619	pop xbc
		620	ret
		621
		622	endsection
		623
		624	;------------------------------------------------------------------------------
		625	; Unterroutine Zahl dezimal wandeln
		626
		627	section fOutDec
		628	public fOutDec:Parent
		629	fOutDec:
		630
		631	push xwa ; Register retten
		632	push xbc
		633	push de
		634	push xhl
		635
		636	bit 15,qwa ; negativ ?
		637	jr z,IsPos
		638	ld (xix+),'-' ; ja: vermerken...
		639	cpl wa ; ...und Zweierkomplement
		640	cpl qwa
		641	inc xwa
		642	jr GoOn
		643	IsPos: bit 7,c ; Pluszeichen ausgeben ?
		644	jr nz,GoOn
		645	ld (xix+),'+'
		646	GoOn: res 7,c ; Plusflag loeschen
		647	ld qbc,0 ; Nullflag und Zaehler loeschen
		648
		649	InLoop: ld xhl,0 ; Division vorbereiten
		650	ld e,32 ; 32 Bit-Division
		651	DivLoop: sll 1,xwa ; eins weiterschieben
		652	rl 1,xhl
		653	srl 1,xwa ; fuer nachher
		654	sub xhl,10 ; passt Divisor hinein ?
		655	jr nc,DivOK
		656	add xhl,10 ; nein, zuruecknehmen...
		657	scf ; im Ergebnis 0 einschieben
		658	DivOK: ccf ; neues Ergebnisbit
		659	rl 1,xwa ; Ergebnis in XWA einschieben...
		660	djnz e,DivLoop
		661
		662	add l,'0' ; ASCII-Offset addieren
		663	bit 1,qb ; schon im Nullbereich ?
		664	jr z,NormVal
		665	ld l,b ; ja, dann gewuenschtes Leerzeichen
		666	NormVal: push l ; auf LIFO legen
		667	inc qc ; ein Zeichen mehr
		668	or xwa,xwa ; Quotient Null ?
		669	scc z,qb
		670	jr nz,InLoop ; wenn nicht Null, auf jeden Fall weiter
		671	cp c,qc ; ansonsten nur, falls min. Stellenzahl
		672	jr ugt,InLoop ; noch nicht erreicht
		673
		674	OutLoop: pop a ; jetzt Zeichen umgekehrt ablegen
		675	ld (xix+),a
		676	djnz qc,OutLoop
		677
		678	pop xhl ; Register zurueck
		679	pop de
		680	pop xbc
		681	pop xwa
		682
		683	ret
		684
		685	endsection
		686
		687	;------------------------------------------------------------------------------
		688	; Gleitkomma nach ASCII wandeln:
		689	; In: Zahl in XWA
		690	; Zeiger auf Speicher in XHL
		691	; max. Anzahl Nachkommastellen in C
		692	; B/Bit 0 setzen, falls Mantissen-Pluszeichen unerwuenscht
		693	; B/Bit 1 setzen, falls Exponenten-Pluszeichen unerwuenscht
		694	; B/Bit 2..4 = Stellenzahl Exponent
		695	; B/Bit 5 setzen, falls Nullen am Ende der Mantisse unerwuenscht
		696	; Out: Zahl abgelegter Zeichen (exkl. NUL am Ende) in BC
		697	; (XHL) = gebildeter String
		698
		699	proc fftoa
		700
		701	push xix ; Register retten
		702	push xhl
		703	push de
		704	push xbc
		705	push xwa
		706
		707	ld xix,xhl ; Zeiger auf Speicher kopieren
		708	ld de,bc ; Parameter sichern
		709
		710	ld xhl,xwa ; Zahl auf die Zerlegebank bringen
		711	res 15,qwa ; Vorzeichen hier nicht mehr gebraucht
		712
		713	ld c,'+' ; Annahme positiv
		714	sll 1,xhl ; Vorzeichen in Carry bringen
		715	jr c,IsNeg ; Minuszeichen immer erforderlich...
		716	bit 0,d ; ...Pluszeichen optional
		717	jr nz,NoMantSgn
		718	jr WrMantSgn
		719	IsNeg: ld c,'-' ; ja
		720	WrMantSgn: ld (xix+),c ; Mantissenvorzeichen ablegen
		721	NoMantSgn:
		722	ld c,qh ; Exponenten herausholen...
		723	extz bc ; ...auf 16 Bit erweitern...
		724	sll 8,xhl ; ...und in Quelle loeschen
		725
		726	cp bc,MaxExpo ; Sonderwert (INF/NAN) ?
		727	jrl z,SpecialVals ; ja-->
		728
		729	or bc,bc ; Zahl denormal ?
		730	jr nz,IsNormal ; nein, normal weiter
		731	or xhl,xhl ; bei kompl. Null auch ueberspringen
		732	jr z,IsNull
		733	Normalize: sll 1,xhl ; ja: solange zaehlen, bis 1 erscheint
		734	jr c,IsNormal
		735	dec bc
		736	jr Normalize
		737	IsNormal: sub bc,Bias ; Bias abziehen
		738	IsNull:
		739	push xwa ; fuer folgendes Zahl retten
		740	ld wa,bc ; Zweierexponenten in Float wandeln
		741	exts xwa
		742	call fitof
		743	ld xhl,(Ld10) ; in Dezimalexponenten wandeln
		744	call fdiv
		745	or xwa,xwa ; Zahl negativ ?
		746	jr p,NoCorr
		747	ld xhl,(One) ; dann nocheinmal korrigieren wg.
		748	call fsub ; unterer Gaussklammer
		749	NoCorr: call fftoi ; Den Ausflug in Float beenden
		750	ld qbc,wa ; den Zehnerexponenten retten
		751	ld bc,wa
		752	call fPot10 ; von diesem Exponenten Zehnerpotenz
		753	ld xhl,xwa ; bilden
		754	pop xwa ; alte Zahl zurueck
		755	call fdiv ; Teilen: Ergebnis ist Zahl zwischen
		756	Again: ld xhl,xwa ; 1.0 und 9.9999..., diese retten
		757	call fftoi ; Vorkommastelle berechnen
		758	cp a,10 ; doch etwas drueber ?
		759	jr ult,NoRoundErr
		760	ld xwa,xhl ; ja, dann noch einmal zehnteln
		761	ld xhl,(Tenth)
		762	call fmul
		763	inc qbc
		764	jr Again
		765	NoRoundErr: add a,'0' ; diese nach ASCII wandeln...
		766	ld (xix+),a ; ...und ablegen
		767	sub a,'0' ; wieder rueckgaengig machen
		768	cp e,0 ; gar keine Nachkommastellen ?
		769	jr eq,NoComma
		770	ld (xix+),Comma ; Dezimalpunkt ausgeben
		771	call fitof ; in ganze Gleitkommazahl wandeln
		772	call fsub ; Differenz bilden
		773	chg 15,qwa ; war verkehrtherum...
		774	ld xhl,xwa ; nach XHL verschieben, weil XWA gebraucht
		775	ld c,e ; Zehnerpotenz fuer Skalierung ausrechnen
		776	extz bc ; auf 16 Bit aufblasen
		777	call fPot10 ; Skalierungswert berechnen
		778	call fmul ; hochmultiplizieren
		779	ld xhl,(Half) ; Rundung
		780	call fadd
		781	call fftoi ; diese herausziehen
		782	ld b,'0' ; n-stellig mit Vornullen ausgeben
		783	ld c,e
		784	set 7,c ; kein Pluszeichen!
		785	call fOutDec
		786	bit 5,d ; Nullen am Ende abraeumen ?
		787	jr nz,CleanZeros
		788	NoComma:
		789	ld a,d ; falls Minimalstellenzahl Exponent=0
		790	and a,00011100b ; und Exponent=0, vergessen
		791	or a,qb
		792	or a,qc
		793	jr z,End
		794
		795	ld (xix+),'E' ; Exponenten ausgeben
		796	ld wa,qbc
		797	exts xwa
		798	ld b,'0' ; evtl. vornullen...
		799	ld c,d ; Bit 1-->Bit 7
		800	rrc 2,c
		801	and c,87h ; Bits ausmaskieren
		802	call fOutDec
		803
		804	End: pop xwa ; Register zurueck
		805	pop xbc
		806	pop de
		807	pop xhl
		808	ld (xix),0 ; NUL-Zeichen im String nicht vergessen
		809	sub xix,xhl ; Stringlaenge berechnen
		810	ld bc,ix
		811	pop xix
		812
		813	ret
		814
		815	SpecialVals: or xde,xde ; Ist die Mantisse Null ?
		816	jr nz,IsNAN
		817	ldw (xix+),'NI' ; ja: INF einschreiben
		818	ld (xix+),'F'
		819	jr End
		820	IsNAN: ldw (xix+),'AN' ; nein: NAN einschreiben
		821	ld (xix+),'N'
		822	jr End
		823
		824	CleanZeros: cp (xix-1),'0' ; steht da eine Null am Ende ?
		825	jr nz,CleanNoZero ; nein, Ende
		826	dec xix ; ja: Zaehler runter, so dass Ueber-
		827	jr CleanZeros ; schrieben wird und neuer Versuch
		828	CleanNoZero: cp (xix-1),Comma ; evtl. Komma entfernbar ?
		829	jr nz,NoComma ; nein-->
		830	dec xix ; ja: noch ein Zeichen weniger
		831	jr NoComma
		832
		833	endp
		834
		835	;------------------------------------------------------------------------------
		836	; ASCII nach Gleitkomma wandeln:
		837	; In: Zeiger auf String (ASCIIZ) in XHL
		838	; Out: XWA = Ergebnis bzw. fehlerhafte Stelle
		839	; CY = 0, falls fehlerfrei
		840
		841	proc fatof
		842
		843	push xbc ; Register retten
		844	push xde
		845	push xhl
		846	push xix
		847
		848	ld xix,xhl ; Zeiger nach XIX
		849	ld qbc,01 ; Phase 1 (Mantisse), noch kein Vorzeichen
		850	ld xde,(Ten) ; in der Mantisse mit 10 hochmultiplizieren
		851	ld xhl,0 ; Mantisse vorbelegen
		852	ld bc,0 ; Exponent vorbelegen
		853
		854	ReadLoop: ld a,(xix+) ; ein neues Zeichen holen
		855	extz wa ; auf 32 Bit aufblasen
		856	extz xwa
		857
		858	cp a,0 ; Endezeichen ?
		859	jrl eq,Combine ; ja, alles zusammen
		860
		861	cp a,' ' ; Leerzeichen ignorieren
		862	jr eq,ReadLoop
		863
		864	cp a,'+' ; Pluszeichen gnadenhalber zugelassen
		865	jr ne,NoPlus ; ist aber nur ein Dummy
		866	bit 0,qb ; schon ein Vorzeichen dagewesen ?
		867	jrl nz,Error ; dann Fehler
		868	set 0,qb ; ansonsten einfach setzen
		869	jr ReadLoop
		870	NoPlus:
		871	cp a,'-' ; Minuszeichen bewirkt schon eher etwas
		872	jr ne,NoMinus
		873	bit 0,qb ; darf auch nur einmal auftreten
		874	jrl nz,Error
		875	set 0,qb
		876	cp qc,1 ; je nach Phase anderes Flag setzen
		877	jr ne,MinPhase3
		878	set 1,qb ; bei Mantisse Bit 1...
		879	jr ReadLoop
		880	MinPhase3: set 2,qb ; bei Exponent Bit 2
		881	jr ReadLoop
		882	NoMinus:
		883	cp a,'.' ; Umschaltung zu Phase 2 (Nachkomma) ?
		884	jr ne,NoPoint
		885	cp qc,1 ; bish. Phase muss eins sein
		886	jrl ne,Error
		887	ld qc,2 ; neue Phase eintragen
		888	set 0,qb ; Nachkomma darf kein Vorzeichen haben
		889	ld xde,(Tenth) ; im Nachkomma durch 10 teilen
		890	jr ReadLoop
		891	NoPoint:
		892	cp a,'e' ; kleines und grosses E zulassen
		893	jr eq,IsE
		894	cp a,'E'
		895	jr ne,NoE
		896	IsE: cp qc,3 ; vorherige Phase muss 1 oder 2 sein
		897	jr eq,Error
		898	ld qc,3 ; vermerken
		899	res 0,qb ; Vorzeichen wieder zugelassen
		900	jr ReadLoop
		901	NoE:
		902	sub a,'0' ; jetzt nur noch 0..9 zugelassen
		903	jr c,Error
		904	cp a,9
		905	jr ugt,Error
		906	set 0,qb ; nach Ziffern kein Vorzeichen mehr zulassen
		907
		908	cp qc,1 ; Phase 1 (Mantisse) :
		909	jr ne,NoPhase1
		910	push xwa ; Zeichen retten
		911	ld xwa,xde ; bish. Mantisse * 10
		912	call fmul
		913	ld xhl,xwa
		914	pop xwa ; Zahl nach Float wandeln
		915	call fitof
		916	call fadd ; dazuaddieren
		917	ld xhl,xwa ; Mantisse zuruecklegen
		918	jrl ReadLoop
		919	NoPhase1:
		920	cp qc,2 ; Phase 2 (Nachkomma) :
		921	jr ne,NoPhase2
		922	call fitof ; Stelle nach Float wandeln
		923	push xhl ; Mantisse retten
		924	ld xhl,xde ; Stelle mit Zehnerpotenz skalieren
		925	call fmul
		926	pop xhl ; zur Mantisse addieren
		927	call fadd
		928	push xwa ; Zwischenergebnis retten
		929	ld xwa,xde ; nДchste Skalierungspotenz ausrechnen
		930	ld xhl,(Tenth)
		931	call fmul
		932	ld xde,xwa ; alles wieder zurueck
		933	pop xhl
		934	jrl ReadLoop
		935	NoPhase2:
		936	mul bc,10 ; Exponent heraufmultiplizieren
		937	add bc,wa
		938	cp bc,45 ; Minimum ist 1e-45
		939	jr ugt,Error
		940	jrl ReadLoop
		941
		942	Combine: bit 2,qb ; Exponent negativ ?
		943	jr z,ExpPos
		944	neg bc
		945	ExpPos: call fPot10 ; Zehnerpotenz des Exponenten bilden
		946	call fmul ; mit Mantisse kombinieren
		947	bit 1,qb ; Mantisse negativ ?
		948	jr z,ManPos
		949	set 15,qwa
		950	ManPos: rcf ; Ende ohne Fehler
		951
		952	pop xix ; Register zurueck
		953	pop xhl
		954	pop xde
		955	pop xbc
		956	ret
		957
		958	Error: ld xwa,xix ; Endzeiger laden
		959	pop xix
		960	pop xhl
		961	sub xwa,xhl ; rel. Position des fehlerhaften Zeichens berechnen
		962	pop xde
		963	pop xbc
		964	scf ; Ende mit Fehler
		965	ret
		966
		967	endp
		968
		969	;------------------------------------------------------------------------------
		970	; gemeinsames Ende
		971
		972	endsection
		973

Subversion Repositories pentevo

(root)/tools/asl/asl-current/tests/t_fl900/float.inc – Rev 1186