aboutsummaryrefslogtreecommitdiffstats
path: root/tests/t_fl900
diff options
context:
space:
mode:
authorfishsoupisgood <github@madingley.org>2019-05-27 02:41:51 +0100
committerfishsoupisgood <github@madingley.org>2019-05-27 02:41:51 +0100
commit333b605b2afd472b823aeda0adf0e8b1ea9843c0 (patch)
treebc8f581317897e2e53f278f1716b4471fcdccd4f /tests/t_fl900
downloadasl-master.tar.gz
asl-master.tar.bz2
asl-master.zip
initial commit from asl-1.41r8.tar.gzHEADmaster
Diffstat (limited to 'tests/t_fl900')
-rw-r--r--tests/t_fl900/asflags0
-rw-r--r--tests/t_fl900/conout.inc154
-rw-r--r--tests/t_fl900/cpu_time.inc240
-rw-r--r--tests/t_fl900/float.inc973
-rw-r--r--tests/t_fl900/macros.inc16
-rw-r--r--tests/t_fl900/t_fl900.asm166
-rw-r--r--tests/t_fl900/t_fl900.doc6
-rw-r--r--tests/t_fl900/t_fl900.inc2
-rwxr-xr-xtests/t_fl900/t_fl900.oribin0 -> 3408 bytes
9 files changed, 1557 insertions, 0 deletions
diff --git a/tests/t_fl900/asflags b/tests/t_fl900/asflags
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/tests/t_fl900/asflags
diff --git a/tests/t_fl900/conout.inc b/tests/t_fl900/conout.inc
new file mode 100644
index 0000000..6483884
--- /dev/null
+++ b/tests/t_fl900/conout.inc
@@ -0,0 +1,154 @@
+; CONOUT.INC
+;******************************************************************************
+;* Konsolenausgabe fr Micro-ICE TLCS900 *
+;* *
+;* Routinen CONOUT, PSTR, A_ASC von Oliver Sellke *
+;* Routine WriteDec von Alfred Arnold, Oktober 1993 *
+;* 20.11.1993 StrTerm C-konform auf 00h ge„ndert *
+;* TXTAUS hinzugefgt *
+;* *
+;* Routine Funktion Eingabe Stack *
+;* *
+;* CONOUT Zeichen ausgeben A 1..3 Byte *
+;* TXTAUS String ausgeben (XHL) *
+;* PSTR String ausgeben hinter CALL+StrTerm als Ende 6 Byte *
+;* A_ASC Byte hex ausgeben A 2 Byte *
+;* WriteDec Wort dez ausgeben WA 6 Byte *
+;* *
+;* - Da die Routinen lokale Labels verwenden, ist mindestens AS 1.39 erfor- *
+;* derlich *
+;* - Der Prozessor muá sich im Maximum-Modus befinden *
+;* - Symbol SIODelay setzen, falls langsames Terminal vorhanden *
+;* - MACROS.INC muá vorher eingebunden werden *
+;******************************************************************************
+
+;------------------------------------------------------------------------------
+; gemeinsamer Anfang, Definitionen
+
+ section ConOut
+
+ public StrTerm
+StrTerm equ 0
+
+SC0BUF EQU 050H
+INTES0 EQU 077H
+
+;******************************************************************************
+; (7 bit ASCII) Ausgabe ber SIO-Kanal 0
+
+ proc CONOUT
+ PUSH A ;sichern
+ RES 7,A ;MSB ausblenden (nur ASCII!)
+CONOUT1: BIT 7,(INTES0) ;ist der Buffer frei?
+ JR Z,CONOUT1 ;Wenn nicht, dann weiter prfen
+ LD (INTES0),0Dh ;Flag rcksetzen
+ LD (SC0BUF),A ;Zeichen in Transmit-Buffer
+ ifdef SIODelay
+ PUSH HL ;sichern
+ LD HL,80H ;Verz”gerungszeit laden
+WAIT: DEC 1,HL ;Z„hler - 1
+ CP HL,0 ;Ist Z„hler = 0?
+ JR NZ,WAIT ;Wenn nicht, dann weiter DEC
+ POP HL ;restaurieren
+ endif
+ POP A ;restaurieren
+ RET ;Zurck zum Aufruf
+ endp
+
+;******************************************************************************
+; ASCIIZ-String ab (XHL) ausgeben:
+
+ proc TXTAUS
+ push xhl ; Register retten
+ push a
+Schl: ld a,(xhl+) ; ein Zeichen holen
+ cp a,StrTerm ; Endemarkierung ?
+ jr eq,Ende
+ call CONOUT ; nein, ausgeben
+ jr Schl ; Go on...
+Ende: pop a ; Register zurck
+ pop xhl
+ ret
+ endp
+
+;******************************************************************************
+; String der dem Aufruf folgt bis zur Endemarkierung ausgeben
+; Siehe auch TXTAUS:
+
+ proc PSTR
+ PUSH XHL ;sichern
+ LD XHL,(XSP+4) ;Datenadresse lesen
+ PUSH F ;sichern
+ PUSH A ;dito
+PSTR1: LD A,(XHL) ;Zeichen holen
+ INC 1,C ;Zeichenz„hler + 1
+ INC 1,XHL ;Zeichenzeiger + 1
+ CP A,StrTerm ;Endemarkierung erwischt?
+ JR Z,PSTR2 ;Wenn ja, dann Ende
+ AND A,A ;Null-Zeichen erwischt?
+ JR Z,PSTR1 ;Wenn ja, dann nicht ausgeben
+ CALL CONOUT ;Zeichen ausgeben
+ AND A,A ;War das 8. Bit gesetzt?
+ JR P,PSTR1 ;Wenn nicht, dann n„chstes Zeichen
+PSTR2: POP A ;restaurieren
+ POP F ;dito
+ LD (XSP+4),XHL ;Rcksprungadresse restaurieren
+ POP XHL ;Rcksprungadresse abspeichern
+ RET ;Zurck zum Aufruf
+ endp
+
+;******************************************************************************
+; "A" als ASCII Text ausgeben
+
+ proc A_ASC
+ PUSH F ;Sichern
+ PUSH A ;dito
+ RR 4,A ;high nibble an die richtige
+ CALL A_ASC00 ;Stelle und ausgeben
+ POP A ;restaurieren bzw.
+ POP F ;low nibble laden
+A_ASC00: AND A,00FH ;low nibble maskieren
+ CP A,00AH ;eine Zahl ?
+ JR C,A_ASC01 ;ja
+ ADD A,007H ;Offset A-F
+A_ASC01: ADD A,'0' ;Offset ASCII
+ JP CONOUT ;Ausgabe und Ende UP
+ endp
+
+;******************************************************************************
+; Zahl in WA dezimal ausgeben
+; C = minimale Stellenzahl
+; B = Fllzeichen (z.B. ' ', '0')
+
+ proc WriteDec
+ push xwa ; Register retten
+ push de
+
+ sub de,de ; E z„hlt echte Stellenzahl, D=1 falls Null
+InLoop: extz xwa ; fr Division vorbereiten
+ div xwa,10 ; letzte Stelle ausmaskieren
+ add qa,'0' ; ASCII-Offset
+ cp d,1 ; schon im Nullbereich ?
+ jr ne,NormVal
+ ld qa,b ; ja, dann gewnschtes Leerzeichen
+NormVal: push qa ; ein Zeichen mehr
+ inc e
+ or wa,wa ; schon Null ?
+ scc z,d
+ jr nz,InLoop ; wenn nicht Null, auf jeden Fall weiter
+ cp e,c ; noch nicht genug Zeichen ?
+ jr ult,InLoop ; dann auch weiter
+
+OutLoop: pop a ; umgekehrt ausgeben
+ call ConOut
+ djnz e,OutLoop
+
+ pop de
+ pop xwa
+ ret
+ endp
+
+;******************************************************************************
+; Modulende
+
+ endsection
diff --git a/tests/t_fl900/cpu_time.inc b/tests/t_fl900/cpu_time.inc
new file mode 100644
index 0000000..1240be2
--- /dev/null
+++ b/tests/t_fl900/cpu_time.inc
@@ -0,0 +1,240 @@
+; CPU_TIME.INC
+;*************************************************************************
+;* *
+;* Author...: Oli(ver Sellke) D-65199 Wiesbaden *
+;* auf AS umgestellt von Alfred Arnold, Oktober 1993 *
+;* die Low-Level-Ausgaberoutinen sind nach CONOUT.INC verlagert *
+;* Date.....: 14 Okt 1993 Version..: 1.0 *
+;* Target...: TLCS900-Family (TOSHIBA) Compiler.: AS V1.39p1 *
+;* Project..: General Purpose / e.g. TMP96C141F / Watt Ihr Volt *
+;* *
+;* Function.: Mit dieser Routine kann man die Ausfhrungszeit die *
+;* ein Programm(teil) ben”tigt ermitteln. *
+;* Die Zeit wird mit Timer4 und CAP1 davon gemessen, d.h. *
+;* dieser darf innerhalb des gemessenen Programm(teil)s *
+;* nicht (!) benutzt werden. *
+;* !!! Alle Zeiten beziehen sich auf einen 14,7456MHz Quarz!! *
+;* Zur Ausgabe des Messwertes werden Monitor-Routinen benutzt,*
+;* deshalb kann es auch nur unter Anwendung von diesem zur *
+;* Ausfhrung gebracht werden. *
+;* Wenn ein Programm(teil) getestet wird, dessen Ausfhrungs- *
+;* zeit unbekannt ist, sollte man die 8,681æs Aufl”sung w„hlen*
+;* um einen Overrun des Counters zu verhindern. Wenn der Wert *
+;* entsprechend klein ist ( <0FFF ), kann man die 0,543æs Auf-*
+;* l”sung w„hlen um genauere Werte zu bekommen. *
+;* Auáerdem ist die Ermittlung der 16 gr”áten und 16 kleinsten*
+;* Werte die bei mehreren Durchl„ufen erzielt wurden m”glich! *
+;* Man kann so einige 1000 Durchl„ufe fahren mit immer unter- *
+;* schiedlichen Randbedingungen auf die der zu testende Pro- *
+;* teil entsprechend reagiert und auch Zeit ben”tigt. *
+;* So hat man sicher die minimale und maximale Laufzeit. *
+;* *
+;* Bei allgemeiner Verwendung: *
+;* Max.Meáwert=0FFFFH = 35.585æs bei 0,543æs Aufl”sung *
+;* Max.Meáwert=0FFFFH = 568.909æs bei 8,681æs Aufl”sung *
+;* *
+;* Hardware.: getested auf Micro-ICE TLCS900 mit 14,7456MHz Quarz !!!! *
+;* *
+;* Routine Funktion Ausgabe Stack *
+;* *
+;* CPU_TI_INI Initialisierung ------ 6 Byte *
+;* CPU_TIME Uhr starten ------ 0 Byte *
+;* CPU_STOP Uhr stoppen Zeit+Statistik 8 Byte *
+;* *
+;* - Der Prozessor muá sich im Maximum-Modus befinden *
+;* - Symbol BigTime definieren fr gr”áere Aufl”sung *
+;* - Da die Routinen lokale Labels verwenden, ist mindestens AS 1.39 *
+;* erforderlich *
+;* - MACROS.INC muá vorher, CONOUT.INC irgendwo eingebunden werden *
+;*************************************************************************
+
+;-------------------------------------------------------------------------
+; gemeinsamer Anfang, Definitionen
+
+ section Timer
+
+TRUN EQU 020H
+CAP1L EQU 034H
+CAP1H EQU 035H
+T4MOD EQU 038H
+
+CR EQU 0DH
+LF EQU 0AH
+
+ ifdef BigTime
+Overhead equ 1 ; Eigenverbrauch Start/Stop
+ elseif
+Overhead equ 9
+ endif
+
+CPU_TI_FAA db 40h dup (?) ; FeldAnfangsAdresse, ab hier wer-
+ ; den 40H (64) RAM-Zellen ben”tigt
+ ; gleich 2 * 16 Worte
+CPU_TI_CR dd ? ; CPU_TIME-Control-Register,
+ ; wird noch nicht ben”tigt!!!
+
+;*************************************************************************
+;Dieser Aufruf geh”rt in den Initialisierungsbereich des zu testenden
+;Programmabschnittes!!
+
+ proc CPU_TI_INI
+
+;Hier werden die Feldwerte initialisiert..
+
+ PUSH XDE ;Wird gleich benutzt
+ PUSH BC ;Wird gleich benutzt
+ LD B,10H ;16 W”rter fr Max.Werte werden gebraucht
+ LD XDE,CPU_TI_FAA ;FeldAnfangsAdresse laden
+CPU_TI_INI1: LDW (XDE),00000H ;Feldzelle fr Max.Werte initalisieren
+ INC 2,XDE ;n„chste Max.Wert-Feldzelle
+ ;adressieren
+ DJNZ CPU_TI_INI1 ;Alle Max.Werte initialisiert?
+ LD B,10H ;16 W”rter fr Min.Werte werden gebraucht
+CPU_TI_INI2: LDW (XDE),0FFFFH ;Feldzelle fr Min.Werte initalisieren
+ INC 2,XDE ;n„chste Max.Wert-Feldzelle
+ ;adressieren
+ DJNZ CPU_TI_INI2 ;Alle Min.Werte initialisiert?
+ POP BC ;Und wieder restaurieren
+ POP XDE ;hier auch...
+ RET ;Zurck zum Aufruf!
+ endp
+
+;*************************************************************************
+; Uhr starten
+
+ proc CPU_TIME
+
+ ;Timer4 CPU-Time-Messung vorbereiten
+ RES 4,(TRUN) ;Timer4 stop and clear !
+ ifdef BigTime
+ LD (T4MOD),00100011B ;Bit 0+1:Source-Clock: 8,681æs
+ elseif
+ LD (T4MOD),00100001B ;Bit 0+1:Source-Clock: 0,543æs
+ endif
+ ;Bit 2 :clear from TREG5 disabled
+ ;Bit 3+4:INT-Capture disabled
+ ;Bit 5 :No Sw. capture now
+ SET 4,(TRUN) ;Timer4 start and count !
+ RET
+ endp
+
+;*************************************************************************
+
+ proc CPU_STOP
+
+ RES 5,(T4MOD) ;Capture1 grabs count
+ CALL CPU_TI_SOUT ;Einzelausgabe des gemessenen Wertes
+ CALL CPU_TI_SOR ;gemessenen Wert ins Feld sortieren
+ RET ;Zurck zum Aufruf!
+ endp
+
+;*************************************************************************
+;Hier wird der gerade gemessene Wert ausgegeben. Diese Ausgabe ist
+;ausreichend um Laufzeitwerte von statischen Programmabschnitten
+;zu ermitteln (keine Verzweigungen im Programmabschnitt).
+
+CPU_TI_SOUT: PUSH A ; needed little later
+ PUSH F ; needed little later
+ push bc ; needed little later
+ ld wa,(cap1l) ; gemesser Wert
+ call WriteTime
+ pop bc ; back to the roots ...
+ POP F
+ POP A
+ RET ; Zurck zum Aufruf!
+
+;*************************************************************************
+;Hier werden die ermittelten Werte sortiert abgelegt!
+;Jeweils am Feldanfang steht der grӇte und der kleinste Wert.
+;Falls ein Wert einem anderen im Feld entspricht (gleicher Messwert)
+;wird dieser nicht nochmal eingetragen!!!!
+;!!Achtung diese Routine ben”tigt max. 145æs (14,7456MHz Quarz)
+; im worst case!! Aber nur wenn Daten und Code 16Bit breit sind
+; und keine Waitstates zugeschaltet sind (Micro-ICE TLCS900 default RAM)!
+
+CPU_TI_SOR: PUSH HL ;Wird gleich benutzt
+ PUSH BC ;Wird gleich benutzt
+ PUSH XDE ;Wird gleich benutzt
+ ;Max.Werte sortiert ablegen!!!
+ LD B,10H ;16 W”rter enth„lt Max.Wert-Feld
+ LD HL,(CAP1L) ;gemessenen Wert aus Capture-Reg. holen
+ LD XDE,CPU_TI_FAA ;erste Max.Wert-Feldzelle adressieren
+CPU_TI_SOR1: CP HL,(XDE) ;Wert mit Feldinhalt vergleichen
+ JR ULT,CPU_TI_SOR2 ;Ist Wert kleiner als Feldinhalt?
+ JR Z,CPU_TI_SOR3 ;Ist Wert gleich Feldinhalt? Abbrechen!
+ EX (XDE),HL ;Nein-->Wert mit Feldinhalt tauschen!
+CPU_TI_SOR2: INC 2,XDE ;n„chste Feldzelle adressieren
+ DJNZ B,CPU_TI_SOR1 ;Alle 16 Max.Werte kontrolliert?
+ ;Min.Werte sortiert ablegen!!!
+CPU_TI_SOR3: LD B,10H ;16 W”rter enth„lt Min.Wert-Feld
+ LD HL,(CAP1L) ;gemessenen Wert aus Capture-Reg. holen
+ LD XDE,CPU_TI_FAA+20H ;erste Min.Wert-Feldzelle adressieren
+CPU_TI_SOR4: CP HL,(XDE) ;Wert mit Feldinhalt vergleichen
+ JR UGT,CPU_TI_SOR5 ;Ist Wert grӇer als Feldinhalt?
+ JR Z,CPU_TI_SOR6 ;Ist Wert gleich Feldinhalt? Abbrechen!
+ EX (XDE),HL ;Nein-->Wert mit Feldinhalt tauschen!
+CPU_TI_SOR5: INC 2,XDE ;n„chste Feldzelle adressieren
+ DJNZ B,CPU_TI_SOR4 ;Alle 16 Min.Werte kontrolliert?
+CPU_TI_SOR6: POP XDE ;Und wieder restaurieren
+ POP BC ;wieder restaurieren
+ POP HL ;hier auch...
+ RET ;Zurck zum Aufruf!
+
+;*************************************************************************
+;Hier werden die im Feld abgelegten Werte ausgeben.
+
+CPU_TI_MOUT: ;Muá noch geschrieben werden!
+ RET ;Zurck zum Aufruf!
+
+;*************************************************************************
+; eine Zeitdifferenz in WA umrechnen und ausgeben
+; wegen der Aufl”sung der Timer ist die letzte Stelle hinter dem Komma
+; bei hoher Aufl”sung mit Vorsicht zu genieáen
+
+WriteTime: push xwa ; Register retten
+ push bc
+ sub wa,Overhead ; Zeit korrigieren
+ ifdef BigTime ; Fall 1: niedrige Aufl”sung
+ mul xwa,8681 ; -->Nanos in XWA
+ add xwa,5000 ; !!Rundung!!
+ div xwa,10000 ; Nanos , einzelne Mikros wegschmeiáen
+ extz xwa
+ div xwa,100 ; Millisekunden in WA
+ ld bc,2003h ; ausgeben
+ call WriteDec
+ ld a,'.'
+ call CONOUT
+ ld wa,qwa ; auf 10 us genau ausgeben
+ ld bc,3002h
+ call WriteDec
+ call PSTR
+ db " Milli",StrTerm
+ elseif ; Fall 2: hohe Aufl”sung
+ mul xwa,543 ; -->Nanosekunden in XWA
+ div xwa,1000 ; -->Nanos in QWA, Mikros in WA
+ ld bc,2005h ; Mikros 5-stellig mit Blanks
+ call WriteDec
+ ld a,'.'
+ call CONOUT
+ ld wa,qwa ; Nanos einstellig
+ add wa,50 ; Rundung
+ extz xwa
+ div xwa,100 ; Ergebnis 0..9
+ cp wa,10
+ jr ne,NoErr
+ ld wa,9
+NoErr: ld bc,3001h ; einstellig ausgeben
+ call WriteDec
+ call PSTR
+ db " Mikro",StrTerm
+ endif
+ call PSTR
+ db "sekunden",StrTerm ; gemeinsamer Rest
+ pop bc ; Register zurck
+ pop xwa
+ ret
+
+;*************************************************************************
+; gemeinsames Ende
+
+ endsection
diff --git a/tests/t_fl900/float.inc b/tests/t_fl900/float.inc
new file mode 100644
index 0000000..dd4796c
--- /dev/null
+++ b/tests/t_fl900/float.inc
@@ -0,0 +1,973 @@
+; FLOAT.INC
+;******************************************************************************
+;* Gleitkommabibliothek fr TLCS 900 *
+;* *
+;* Originale fr den 68000 aus mc, bis auf die Quadratwurzel aus c't *
+;* Portierung auf TLCS 900 von Alfred Arnold, Oktober 1993 *
+;* *
+;* Routine Funktion Eingabe Ausgabe Stack L„nge Zeit/14MHz *
+;* *
+;* fadd Addition XWA+XHL XWA 12 Byte 194 Byte 60 us *
+;* fsub Subtraktion XWA-XHL XWA 12 Byte 7 Byte 65 us *
+;* fmul Multiplikation XWA*XHL XWA 20 Byte 218 Byte 70 us *
+;* fdiv Division XWA/XHL XWA 20 Byte 147 Byte 300 us *
+;* fmul2 Mult. mit 2er-Potenz XWA*(2^BC) XWA 6 Byte 99 Byte 20 us *
+;* fitof Int-->Float XWA XWA 4 Byte 41 Byte 90 us *
+;* fftoi Float-->Int XWA XWA 2 Byte 72 Byte 20 us *
+;* fsqrt Quadratwurzel XWA XWA 16 Byte 192 Byte 220 us *
+;* fftoa Float-->ASCII XWA (XHL),BC ~38 Byte 228 Byte ~4500 us *
+;* fatof ASCII-->Float (XHL),BC XWA,[BC] ~40 Byte 260 Byte ~2300 us *
+;* *
+;* - Wollen Sie einzelne Routinen entfernen, so beachten Sie, daá fsub Teile *
+;* aus fadd und fdiv Teile aus fmul verwendet ! *
+;* - Gleitkommaformat ist IEEE Single (32 Bit) *
+;* - Integerwerte bei fmul2, fitof und fftoi sind vorzeichenbehaftet *
+;* - Der Prozessor muá sich im Maximum-Modus befinden *
+;* - Da die Routinen lokale Labels verwenden, ist mindestens AS 1.39 erfor- *
+;* derlich *
+;* - Die Ausfhrungszeiten k”nnen je nach Operand streuen, insbesondere bei *
+;* den Konvertierungsfunktionen *
+;* - MACROS.INC muá vorher eingebunden werden *
+;******************************************************************************
+
+;------------------------------------------------------------------------------
+; gemeinsamer Anfang, Makros
+
+shifta macro op,dest ; Schieben, falls evtl. A>=16
+ push a ; A wird zerschossen
+ bit 4,a ; Akku im Bereich 16..31 ?
+ jr z,smaller
+ op 16,dest ; dann einmal groá schieben
+smaller: push f ; Carry erhalten
+ and a,15 ; obere Bits pl„tten
+ jr z,fertig
+ pop f ; evtl. Rest verarbeiten
+ op a,dest
+ jr ende ; Carry schon gut
+fertig: pop f
+ende: pop a ; A zurck
+ endm
+
+ section FloatLib
+
+;------------------------------------------------------------------------------
+; Konstanten
+
+Ld10: dd ld(10) ; Konversionskonstanten
+One: dd 1.0
+Half: dd 0.5
+Ten: dd 10.0
+Tenth: dd 3dcccccdh ; =0.1, aber die Rundung auf manchen
+ ; Systemen variiert (damit Test nicht
+ ; scheitert)
+
+Bias equ 127
+MaxExpo equ 255
+Comma equ '.'
+
+;------------------------------------------------------------------------------
+; Addition: XWA=XWA+XHL
+
+ proc fadd
+
+ push xbc ; andere Register retten
+ push xde
+ push xhl
+
+ ld xde,xwa ; Operand 1 nach XDE verschieben
+ rlc 1,xde ; Vorzeichen der Operanden nach Bit 0
+ rlc 1,xhl
+ ld xbc,xde ; Differenz bilden
+ sub xbc,xhl
+ jr nc,NoSwap ; evtl. vertauschen, so daá
+ ld xwa,xhl ; grӇere in XDE
+ ld xhl,xde
+ ld xde,xwa
+NoSwap: ld qa,e ; Vorzeichen 1 ausmaskieren
+ and qa,1 ; (=Ergebnis Vorzeichen)
+ bit 0,c ; gleiches Vorzeichen ?
+ jr z,NoSub
+ set 1,qa ; dann Subtraktion vormerken
+
+NoSub: sub xbc,xbc ; XBC initialisieren
+ rlc 8,xde ; Exponent 1 rausholen
+ ld c,e
+ or e,e ; falls <>0, implizite 1 einbauen
+ scc nz,e
+ rrc 1,xde
+ ld e,0 ; Bit 0..7 wieder pl„tten
+
+ rlc 8,xhl ; dito Exponent 2 extrahieren
+ ld qc,l
+ or l,l
+ scc nz,l
+ rrc 1,xhl
+ ld l,0
+
+; Zwischenstand:
+; - Mantissen linksbndig inkl. impliziter Eins in XDE und XHL
+; - Exponent 1 in BC, Exponent 2 in QBC
+; - Ergebnisvorzeichen in QA, Bit 0
+; - Subtraktionsflag in QA, Bit 1
+
+ ld wa,bc ; Exponentendifferenz berechnen
+ sub wa,qbc
+ cp wa,24 ; >24, d.h. Zahl 2 vernachl„ssigbar gegen Zahl 1
+ jr gt,Round ; ja, Ergebnis ist grӇere Zahl
+ shifta srl,xhl ; ansonsten Mantisse 2 entspr. anpassen
+
+Add: bit 1,qa ; subtrahieren ?
+ jr nz,Subtract ; ja-->
+ add xde,xhl ; nein, Mantissen addieren
+ jr nc,Round ; kein šberlauf, runden
+ rr 1,xde ; ansonsten šberlauf einschieben...
+ inc bc ; ...und Exponent korrigieren
+ jr Round ; normal weiter runden
+
+Subtract: sub xde,xhl ; Mantissen subtrahieren
+ jr z,Zero ; falls Null, Gesamtergebnis 0
+ jr m,Round ; fhrende 1 noch da: zum Runden
+Normalize: or bc,bc ; Exponent bereits Null ?
+ jr z,Round ; dann denormales Ergebnis
+ dec bc ; ansonsten Mantisse eins rauf, Exponent
+ sll 1,xde ; eins runter
+ jr p,Normalize ; solange, bis Eins auftaucht
+
+Round: add xde,80h ; Rundung auf Bit hinter Mantisse
+ jr nc,NoOver
+ rr 1,xde ; Bei šberlauf korrigieren
+ inc bc
+NoOver: ld e,0 ; Mantissenrest pl„tten
+ or xde,xde ; insgesamt 0 ?
+ jr z,Zero ; dann Ergebnis 0
+ cp bc,MaxExpo ; Exponentenberlauf ?
+ jr lt,NoEOver
+ ld bc,MaxExpo ; ja: Unendlich: Exponent=Maximum
+ sub xde,xde ; Mantisse=0
+ jr Denormal
+
+NoEOver: or bc,bc ; Exponent 0 ?
+ jr z,Denormal ; ja, denormal
+ sll 1,xde ; fhrende Eins nicht speichern
+Denormal: ld e,c ; Exponenten einbauen
+ rrc 8,xde ; nach oben schieben
+ rr 1,qa ; Vorzeichen einbauen
+ rr 1,xde
+
+Zero: ld xwa,xde ; Ergebnis in Akku
+
+ pop xhl ; Register zurck
+ pop xde
+ pop xbc
+
+ ret
+
+ endp
+
+;------------------------------------------------------------------------------
+; Subtraktion: XWA=XWA-XHL
+
+ proc fsub
+
+ xor qh,80h ; Vorzeichen 2 drehen
+ jp fadd ; ansonsten wie Addition
+
+ endp
+
+;------------------------------------------------------------------------------
+; Multiplikation: XWA=XWA*XHL
+
+ proc fmul
+
+ public MulRound:Parent,MulZero:Parent,MulResult:Parent
+ public DivError:Parent
+
+ push xbc ; Register retten
+ push xde
+ push xhl
+ push xix
+ push xiy
+
+ ld xiy,xwa ; Op1 kopieren
+ xor xiy,xhl ; Ergebnisvorzeichen bestimmen
+
+ ex wa,qwa ; Registerh„lften Op1 vertauschen
+ ld xde,xwa ; Op1 ab sofort in XDE
+ and de,7fh ; Exponent und Vz. behandeln
+ and wa,7f80h ; Exponent maskieren
+ jr z,Denorm1 ; gleich Null-->Op1 denormal
+ set 7,de ; ansonsten implizite Eins einbauen
+ sub wa,80h ; Bias kompensieren
+Denorm1:
+ ex hl,qhl ; Op2 genauso behandeln
+ ld xbc,xhl
+ and hl,7fh
+ and bc,7f80h
+ jr z,Denorm2
+ set 7,hl
+ sub bc,80h
+Denorm2:
+ add bc,wa ; Exponenten addieren
+ srl 7,bc ; richtig positionieren
+ sub bc,Bias-3 ; Bias-3 abziehen
+ cp bc,-24 ; totaler Unterlauf ?
+ jr lt,MulZero ; dann Ergebnis 0
+
+ ld wa,de ; beide oberen H„lften multiplizieren
+ mul xwa,hl
+ ex wa,qwa ; Ergebnis in oberer H„lfte lagern
+ ld wa,de ; obere H„lfte Op1 retten
+ ex de,qde ; untere H„lfte Op1 holen
+ ld ix,hl ; untere H„lfte Op1 * obere Op2
+ mul xix,de
+ ex hl,qhl ; untere Op1 * untere Op2
+ mul xde,hl
+ ex de,qde ; obere Op1 * untere Op2
+ mul xhl,wa
+
+ ld wa,de ; Teile aufaddieren
+ add xwa,xix
+ add xwa,xhl
+ jr z,MulResult ; Mantisse Null, Ergebnis Null
+ jr m,MulRound
+
+ or bc,bc ; Exponent negativ ?
+ jr m,Unterlauf ; ggfs. Unterlauf behandeln
+
+Nor: or bc,bc ; Exponent Null ?
+ jr z,MulRound ; ja-->zum Runden
+ rl 1,xde ; nein, Mantisse eins nachschieben
+ rl 1,xwa
+ dec bc ; und Exponent runter
+ or xwa,xwa ; fhrende Eins da ?
+ jr p,Nor ; nein, weiterschieben
+
+MulRound: add xwa,80h ; Rundung
+ jr nc,NoROver ; dabei šberlauf ?
+ rr 1,xwa ; ja: Mantisse & Exponent korrigieren
+ inc bc
+NoROver: cp bc,MaxExpo ; Exponentenberlauf ?
+ jr lt,NoEOver
+DivError: ld bc,MaxExpo ; dann unendlich einstellen
+ sub xwa,xwa
+ jr Denormal
+
+NoEOver: or bc,bc ; Exponent 0 ?
+ jr z,Denormal
+ sll 1,xwa ; fhrende 1 l”schen
+
+Denormal: ld a,c ; Exponent einbauen
+ rrc 8,xwa ; hochschieben
+ rl 1,xiy ; Vorzeichen einbauen
+ rr 1,xwa
+
+MulResult: pop xiy
+ pop xix
+ pop xhl
+ pop xde
+ pop xbc
+
+ ret
+
+MulZero: sub xwa,xwa ; Null erzeugen
+ jr MulResult
+
+Unterlauf: cp bc,-24 ; totaler Unterlauf ?
+ jr le,MulZero ; dann Null
+ neg bc ; sonst umbauen
+ ld xde,xwa ; dazu Akku freimachen
+ sub wa,wa ; Endexponent
+ ex wa,bc ; ist 0
+ shifta srl,xde ; Mantisse herunterschieben
+ ld xwa,xde ; Ergebnis zurck nach XWA
+ jr MulRound ; zurck mit Exponent 0
+
+ endp
+
+;------------------------------------------------------------------------------
+; Division: XWA=XWA/XHL
+
+ proc fdiv
+
+ push xbc ; Register retten (muá gleich zu fmul sein)
+ push xde
+ push xhl
+ push xix
+ push xiy
+
+ ld xiy,xwa ; Op1 kopieren
+ xor xiy,xhl ; Ergebnisvorzeichen bestimmen
+
+ ex wa,qwa ; Vorbehandlung wie bei fmul
+ ld xde,xwa
+ and de,7fh
+ and wa,7f80h
+ jr z,Denorm1
+ set 7,de
+ sub wa,80h
+Denorm1:
+ ex hl,qhl
+ ld xbc,xhl
+ and hl,7fh
+ and bc,7f80h
+ jr z,Denorm2
+ set 7,hl
+ sub bc,80h
+Denorm2:
+ sub wa,bc ; Exponentendifferenz bilden
+ ld bc,wa ; muá in BC liegen
+ sra 7,bc ; richtig positionieren
+ add bc,Bias ; Bias addieren
+ cp bc,-24 ; totaler Unterlauf ?
+ jr lt,MulZero ; ja, Ergebnis Null
+
+ ex hl,qhl ; Format 0fff ... ffff 0000 0000
+ or xhl,xhl ; Ergebnis unendlich ?
+ jrl z,DivError
+ sll 7,xhl
+ ex de,qde ; dito Divident
+ or xde,xde ; falls Null, Ergebnis Null
+ jrl z,MulZero
+ sll 7,xde
+
+NormLoop: bit 14,qhl ; Divisor normalisiert ?
+ jr nz,Normal
+ inc bc ; nein, Exponent RAUF (ist Ergebnisexponent)
+ sll 1,xhl
+ jr NormLoop
+
+Normal: sub xwa,xwa ; Ergebnisquotient vorbesetzen
+ add bc,25 ; Exponent nicht grӇer als 0
+
+Loop: ld xix,xde ; Divident zwischenspeichern
+ sub xde,xhl ; probeweise abziehen
+ ccf ; Carry drehen
+ jr c,IsOne ; ungedrehter Carry=1: Divisor paát
+ ld xde,xix ; ansonsten zurckkopieren
+IsOne: rl 1,xwa ; Ergebnisbit einschieben
+ sll 1,xde ; Divident verschieben
+ dec bc ; Exponent runter
+ or bc,bc
+ jr z,Denorm ; falls Null, denormalisieren
+ bit 8,qwa ; fhrende Eins da ?
+ jr z,Loop ; nein, weiterrechnen
+
+Denorm: sll 7,xwa ; Mantisse positionieren
+ jrl z,MulResult ; Ergebnis 0 ?
+ jrl MulRound ; ansonsten zum Runden
+
+ endp
+
+;-----------------------------------------------------------------------------
+; Multiplikation mit Zweierpotenz: XWA=XWA*2^BC
+
+ proc fmul2
+
+ push bc ; Register retten
+ push xde
+
+ ld xde,xwa ; Vorzeichen merken
+ sll 1,xwa ; Vorzeichen rausschieben
+ jr z,Zero ; falls Null, Ergebnis Null
+ rlc 8,xwa ; Exponent nach unten...
+ sub de,de ; und in DE packen
+ add e,a
+ jr z,Denorm ; falls denormalisiert..
+ or bc,bc ; Multiplikation oder Division ?
+ jr m,Divide ; (neg. Exponent=Division)
+
+ add de,bc ; Exponent addieren
+ cp de,MaxExpo ; šberlauf ?
+ jr ge,Over ; ja, Ergebnis unendlich
+Result: ld a,e ; Ergebnisexponent einbauen
+ rrc 8,xwa ; Exponent nach oben
+ rl 1,xde ; Vorzeichen einschieben
+ rr 1,xwa
+
+Zero: pop xde ; Register zurck
+ pop bc
+ ret
+
+Over: ld de,MaxExpo ; Ergebnis unendlich
+ sub xwa,xwa
+ jr Result
+
+Divide: add de,bc ; Exponentensumme bilden
+ jr gt,Result ; >0, keine Sonderbehandlung
+ scf ; ansonsten 1 explizit fr
+ rr 1,xwa ; denormale Zahl machen
+DDenorm: or de,de ; Exponent=0 ?
+ jr z,Result ; ja, Ergebnis einfach denormal
+ srl 1,xwa ; ansonsten weiter denormalisieren
+ jr z,Zero ; dabei totaler Unterlauf->Null
+ inc de ; Exponent korrigieren
+ jr DDenorm
+DDDenorm: add de,bc ; Exponentensumme bilden
+ jr DDenorm
+
+Denorm: or bc,bc ; Multiplikation oder Division ?
+ jr m,DDDenorm
+ sub a,a ; alten Exponenten l”schen
+Norm: sll 1,xwa ; normalisieren...
+ jr c,Stop ; bis fhrende Eins da
+ dec bc ; oder 2. Exponent 0
+ or bc,bc
+ jr nz,Norm
+ jr Result ; Multiplikator kompl. fr Normalisierung draufgegangen
+Stop: add de,bc ; Rest addieren
+ jr Result ; alles andere schon o.k.
+
+ endp
+
+;------------------------------------------------------------------------------
+; LongInt-->Float : XWA-->XWA
+
+ proc fitof
+
+ push xbc ; Register retten
+
+ or xwa,xwa ; Null ?
+ jr z,Result ; dann Ergebnis Null
+ scc m,qc ; Vorzeichen nach QC, Bit 0
+ jr p,Positive
+ cpl wa ; falls negativ,drehen
+ cpl qwa
+ inc xwa
+Positive: ld bc,Bias+32 ; Exponent vorbesetzen
+Shift: dec bc ; Mantisse verschieben
+ sll 1,xwa
+ jr nc,Shift
+ ld a,c ; Exponent einbauen
+ rrc 8,xwa ; Exponent nach oben
+ rr 1,qc ; Vorzeichen einbauen
+ rr 1,xwa
+
+Result: pop xbc ; Register zurck
+ ret
+
+ endp
+
+;------------------------------------------------------------------------------
+; Float-->LongInt : XWA-->XWA
+
+ proc fftoi
+
+ push bc ; Register retten
+
+ rl 1,xwa ; Vorzeichen in Carry
+ scc c,b ; in B merken
+
+ rlc 8,xwa ; Exponent nach unten
+ ld c,a ; in C legen
+ sub c,Bias ; Bias abziehen
+
+ jr m,Zero ; neg. Exponent -> Zahl<0 -> Ergebnis 0
+ cp c,31 ; šberlauf ?
+ jr ge,Over
+
+ scf ; fhrende Eins einschieben
+ rr 1,xwa
+ sub a,a ; Exponent l”schen
+
+Shift: srl 1,xwa ; jetzt schieben, bis Ergebnis stimmt
+ inc c
+ cp c,31
+ jr ne,Shift
+
+ srl 1,b ; negieren ?
+ jr nc,Positive
+ cpl wa ; ggfs. negieren
+ cpl qwa
+ inc xwa
+
+Positive: pop bc ; Register zurck
+ ret
+
+Zero: sub xwa,xwa ; Ergebnis 0
+ jr Positive
+
+Over: ld xwa,7fffffffh ; šberlauf: Maxint zurckgeben
+ srl 1,b ; negativ ?
+ jr nc,Positive
+ cpl wa ; ja, neg. Maximum zurckgeben
+ cpl qwa
+ jr Positive
+
+ endp
+
+;------------------------------------------------------------------------------
+; Quadratwurzel: XWA=SQRT(XWA)
+
+ proc fsqrt
+
+ push xbc ; Register retten
+ push xde
+ push xhl
+ push xix
+
+ ld xix,xwa ; Argument retten
+ or xix,xix ; Zahl negativ ?
+ jrl m,DomainError ; dann geht es nicht
+
+ ex ix,qix ; MSW holen
+ and xix,7f80h ; Exponent isolieren
+ jrl z,Zero ; keine Behandlung denormaler Zahlen
+
+ and xwa,7fffffh ; Mantisse isolieren
+ sub ix,7fh*80h ; Bias vom Exponenten entfernen
+ bit 7,ix ; Exponent ungerade ?
+ res 7,ix
+ jr z,EvenExp
+ add xwa,xwa ; ja: Mantisse verdoppeln
+ add xwa,1000000h-800000h ; impl. Eins dazu
+EvenExp: ; erste Iteration ohne impl. Eins
+ sra 1,ix ; Exponent/2 mit Vorzeichen
+ add ix,7fh*80h ; Bias wieder dazu
+ ex ix,qix ; neuen Exponenten in QIX aufheben
+ sll 7,xwa ; x ausrichten
+ ld xde,40000000h ; xroot nach erster Iteration
+ ld xhl,10000000h ; m2=2 << (MaxBit-1)
+Loop10: ld xbc,xwa ; xx2 = x
+Loop11: sub xbc,xde ; xx2 -= xroot
+ srl 1,xde ; xroot = xroot/2
+ sub xbc,xhl ; x2 -= m2
+ jr m,DontSet1
+ ld xwa,xbc ; x = xx2
+ or xde,xhl ; xroot += m2
+ srl 2,xhl ; m2 = m2/4
+ jr nz,Loop11
+ jr WABCSame
+DontSet1: srl 2,xhl ; m2 = m2/4
+ jr nz,Loop10 ; 15* abarbeiten
+ ; Bit 22..8
+ ld xbc,xwa ; 17. Iteration separat
+WABCSame: sub xbc,xde
+ rrc 1,xde ; mitsamt Carry...
+ ex de,qde ; auf neues Alignment umstellen
+ sub xbc,1 ; Carry von 0-$4000: x2 -= m2
+ jr m,DontSet7
+ or xbc,-40000000h ; 0-$4000: x2 -= m2, Teil 2
+ ld xwa,xbc
+ or de,4000h ; xroot += m2
+DontSet7: ex wa,qwa ; x auf neues Alignment umstellen
+ ld hl,1000h ; m2 - obere H„lfte schon 0
+Loop20: ld xbc,xwa ; xx2 = x
+Loop21: sub xbc,xde ; xx2 -= xroot
+ srl 1,xde ; xroot = xroot/2
+ sub xbc,xhl ; x2 -= m2
+ jr m,DontSet2
+ ld xwa,xbc ; x = xx2
+ or xde,xhl ; xroot += m2
+ srl 2,xhl ; m2 = m2/4
+ jr nz,Loop21
+ jr Finish
+DontSet2: srl 2,xhl ; m2 = m2/4
+ jr nz,Loop20 ; 7* abarbeiten
+
+Finish: sub xwa,xde ; Aufrunden notwendig ?
+ jr ule,NoInc
+ inc xde ; wenn ja, durchfhren
+NoInc: res 7,qde ; impl. Eins l”schen
+ or xde,xix
+ ld xwa,xde ; Ergebnis in XWA
+ jr End
+
+DomainError: ld xwa,0ffc00000h ; -NAN zurckgeben
+ jr End
+
+Zero: sub xwa,xwa ; Ergebnis 0
+
+End: pop xix ; Register zurck
+ pop xhl
+ pop xde
+ pop xbc
+ ret
+
+ endp
+
+;------------------------------------------------------------------------------
+; Unterroutine Zehnerpotenz bilden: XWA=10.0^BC
+
+ section fPot10 ; nicht mit proc, da private Funktion
+ public fPot10:Parent
+fPot10:
+
+ push xbc ; Register retten
+ push xhl
+
+ ld xwa,(One) ; Ausgangspunkt frs Multiplizieren
+ ld xhl,(Ten) ; zu benutzende Potenz
+ or bc,bc ; negative Potenz ?
+ jr p,IsPos
+ ld xhl,(Tenth) ; dann eben Zehntel multiplizieren
+ neg bc ; fr Schleife immer positiv
+IsPos:
+ or bc,bc ; Noch weiter multiplizieren ?
+ jr z,End
+ bit 0,bc ; Restpotenz ungerade ?
+ jr z,IsEven
+ call fmul ; ja: einzeln multiplizieren
+IsEven: srl 1,bc ; n„chste Stelle
+ push xwa ; neue Potenz berechnen
+ ld xwa,xhl
+ call fmul ; durch quadrieren
+ ld xhl,xwa
+ pop xwa
+ jr IsPos ; weiter nach Einsen suchen
+
+End: pop xhl ; Register zurck
+ pop xbc
+ ret
+
+ endsection
+
+;------------------------------------------------------------------------------
+; Unterroutine Zahl dezimal wandeln
+
+ section fOutDec
+ public fOutDec:Parent
+fOutDec:
+
+ push xwa ; Register retten
+ push xbc
+ push de
+ push xhl
+
+ bit 15,qwa ; negativ ?
+ jr z,IsPos
+ ld (xix+),'-' ; ja: vermerken...
+ cpl wa ; ...und Zweierkomplement
+ cpl qwa
+ inc xwa
+ jr GoOn
+IsPos: bit 7,c ; Pluszeichen ausgeben ?
+ jr nz,GoOn
+ ld (xix+),'+'
+GoOn: res 7,c ; Plusflag l”schen
+ ld qbc,0 ; Nullflag und Z„hler l”schen
+
+InLoop: ld xhl,0 ; Division vorbereiten
+ ld e,32 ; 32 Bit-Division
+DivLoop: sll 1,xwa ; eins weiterschieben
+ rl 1,xhl
+ srl 1,xwa ; fr nachher
+ sub xhl,10 ; paát Divisor hinein ?
+ jr nc,DivOK
+ add xhl,10 ; nein, zurcknehmen...
+ scf ; im Ergebnis 0 einschieben
+DivOK: ccf ; neues Ergebnisbit
+ rl 1,xwa ; Ergebnis in XWA einschieben...
+ djnz e,DivLoop
+
+ add l,'0' ; ASCII-Offset addieren
+ bit 1,qb ; schon im Nullbereich ?
+ jr z,NormVal
+ ld l,b ; ja, dann gewnschtes Leerzeichen
+NormVal: push l ; auf LIFO legen
+ inc qc ; ein Zeichen mehr
+ or xwa,xwa ; Quotient Null ?
+ scc z,qb
+ jr nz,InLoop ; wenn nicht Null, auf jeden Fall weiter
+ cp c,qc ; ansonsten nur, falls min. Stellenzahl
+ jr ugt,InLoop ; noch nicht erreicht
+
+OutLoop: pop a ; jetzt Zeichen umgekehrt ablegen
+ ld (xix+),a
+ djnz qc,OutLoop
+
+ pop xhl ; Register zurck
+ pop de
+ pop xbc
+ pop xwa
+
+ ret
+
+ endsection
+
+;------------------------------------------------------------------------------
+; Gleitkomma nach ASCII wandeln:
+; In: Zahl in XWA
+; Zeiger auf Speicher in XHL
+; max. Anzahl Nachkommastellen in C
+; B/Bit 0 setzen, falls Mantissen-Pluszeichen unerwnscht
+; B/Bit 1 setzen, falls Exponenten-Pluszeichen unerwnscht
+; B/Bit 2..4 = Stellenzahl Exponent
+; B/Bit 5 setzen, falls Nullen am Ende der Mantisse unerwnscht
+; Out: Zahl abgelegter Zeichen (exkl. NUL am Ende) in BC
+; (XHL) = gebildeter String
+
+ proc fftoa
+
+ push xix ; Register retten
+ push xhl
+ push de
+ push xbc
+ push xwa
+
+ ld xix,xhl ; Zeiger auf Speicher kopieren
+ ld de,bc ; Parameter sichern
+
+ ld xhl,xwa ; Zahl auf die Zerlegebank bringen
+ res 15,qwa ; Vorzeichen hier nicht mehr gebraucht
+
+ ld c,'+' ; Annahme positiv
+ sll 1,xhl ; Vorzeichen in Carry bringen
+ jr c,IsNeg ; Minuszeichen immer erforderlich...
+ bit 0,d ; ...Pluszeichen optional
+ jr nz,NoMantSgn
+ jr WrMantSgn
+IsNeg: ld c,'-' ; ja
+WrMantSgn: ld (xix+),c ; Mantissenvorzeichen ablegen
+NoMantSgn:
+ ld c,qh ; Exponenten herausholen...
+ extz bc ; ...auf 16 Bit erweitern...
+ sll 8,xhl ; ...und in Quelle l”schen
+
+ cp bc,MaxExpo ; Sonderwert (INF/NAN) ?
+ jrl z,SpecialVals ; ja-->
+
+ or bc,bc ; Zahl denormal ?
+ jr nz,IsNormal ; nein, normal weiter
+ or xhl,xhl ; bei kompl. Null auch berspringen
+ jr z,IsNull
+Normalize: sll 1,xhl ; ja: solange z„hlen, bis 1 erscheint
+ jr c,IsNormal
+ dec bc
+ jr Normalize
+IsNormal: sub bc,Bias ; Bias abziehen
+IsNull:
+ push xwa ; fr folgendes Zahl retten
+ ld wa,bc ; Zweierexponenten in Float wandeln
+ exts xwa
+ call fitof
+ ld xhl,(Ld10) ; in Dezimalexponenten wandeln
+ call fdiv
+ or xwa,xwa ; Zahl negativ ?
+ jr p,NoCorr
+ ld xhl,(One) ; dann nocheinmal korrigieren wg.
+ call fsub ; unterer Gauáklammer
+NoCorr: call fftoi ; Den Ausflug in Float beenden
+ ld qbc,wa ; den Zehnerexponenten retten
+ ld bc,wa
+ call fPot10 ; von diesem Exponenten Zehnerpotenz
+ ld xhl,xwa ; bilden
+ pop xwa ; alte Zahl zurck
+ call fdiv ; Teilen: Ergebnis ist Zahl zwischen
+Again: ld xhl,xwa ; 1.0 und 9.9999..., diese retten
+ call fftoi ; Vorkommastelle berechnen
+ cp a,10 ; doch etwas drber ?
+ jr ult,NoRoundErr
+ ld xwa,xhl ; ja, dann noch einmal zehnteln
+ ld xhl,(Tenth)
+ call fmul
+ inc qbc
+ jr Again
+NoRoundErr: add a,'0' ; diese nach ASCII wandeln...
+ ld (xix+),a ; ...und ablegen
+ sub a,'0' ; wieder rckg„ngig machen
+ cp e,0 ; gar keine Nachkommastellen ?
+ jr eq,NoComma
+ ld (xix+),Comma ; Dezimalpunkt ausgeben
+ call fitof ; in ganze Gleitkommazahl wandeln
+ call fsub ; Differenz bilden
+ chg 15,qwa ; war verkehrtherum...
+ ld xhl,xwa ; nach XHL verschieben, weil XWA gebraucht
+ ld c,e ; Zehnerpotenz fr Skalierung ausrechnen
+ extz bc ; auf 16 Bit aufblasen
+ call fPot10 ; Skalierungswert berechnen
+ call fmul ; hochmultiplizieren
+ ld xhl,(Half) ; Rundung
+ call fadd
+ call fftoi ; diese herausziehen
+ ld b,'0' ; n-stellig mit Vornullen ausgeben
+ ld c,e
+ set 7,c ; kein Pluszeichen!
+ call fOutDec
+ bit 5,d ; Nullen am Ende abr„umen ?
+ jr nz,CleanZeros
+NoComma:
+ ld a,d ; falls Minimalstellenzahl Exponent=0
+ and a,00011100b ; und Exponent=0, vergessen
+ or a,qb
+ or a,qc
+ jr z,End
+
+ ld (xix+),'E' ; Exponenten ausgeben
+ ld wa,qbc
+ exts xwa
+ ld b,'0' ; evtl. vornullen...
+ ld c,d ; Bit 1-->Bit 7
+ rrc 2,c
+ and c,87h ; Bits ausmaskieren
+ call fOutDec
+
+End: pop xwa ; Register zurck
+ pop xbc
+ pop de
+ pop xhl
+ ld (xix),0 ; NUL-Zeichen im String nicht vergessen
+ sub xix,xhl ; Stringl„nge berechnen
+ ld bc,ix
+ pop xix
+
+ ret
+
+SpecialVals: or xde,xde ; Ist die Mantisse Null ?
+ jr nz,IsNAN
+ ldw (xix+),'NI' ; ja: INF einschreiben
+ ld (xix+),'F'
+ jr End
+IsNAN: ldw (xix+),'AN' ; nein: NAN einschreiben
+ ld (xix+),'N'
+ jr End
+
+CleanZeros: cp (xix-1),'0' ; steht da eine Null am Ende ?
+ jr nz,CleanNoZero ; nein, Ende
+ dec xix ; ja: Z„hler runter, so daá ber-
+ jr CleanZeros ; schrieben wird und neuer Versuch
+CleanNoZero: cp (xix-1),Comma ; evtl. Komma entfernbar ?
+ jr nz,NoComma ; nein-->
+ dec xix ; ja: noch ein Zeichen weniger
+ jr NoComma
+
+ endp
+
+;------------------------------------------------------------------------------
+; ASCII nach Gleitkomma wandeln:
+; In: Zeiger auf String (ASCIIZ) in XHL
+; Out: XWA = Ergebnis bzw. fehlerhafte Stelle
+; CY = 0, falls fehlerfrei
+
+ proc fatof
+
+ push xbc ; Register retten
+ push xde
+ push xhl
+ push xix
+
+ ld xix,xhl ; Zeiger nach XIX
+ ld qbc,01 ; Phase 1 (Mantisse), noch kein Vorzeichen
+ ld xde,(Ten) ; in der Mantisse mit 10 hochmultiplizieren
+ ld xhl,0 ; Mantisse vorbelegen
+ ld bc,0 ; Exponent vorbelegen
+
+ReadLoop: ld a,(xix+) ; ein neues Zeichen holen
+ extz wa ; auf 32 Bit aufblasen
+ extz xwa
+
+ cp a,0 ; Endezeichen ?
+ jrl eq,Combine ; ja, alles zusammen
+
+ cp a,' ' ; Leerzeichen ignorieren
+ jr eq,ReadLoop
+
+ cp a,'+' ; Pluszeichen gnadenhalber zugelassen
+ jr ne,NoPlus ; ist aber nur ein Dummy
+ bit 0,qb ; schon ein Vorzeichen dagewesen ?
+ jrl nz,Error ; dann Fehler
+ set 0,qb ; ansonsten einfach setzen
+ jr ReadLoop
+NoPlus:
+ cp a,'-' ; Minuszeichen bewirkt schon eher etwas
+ jr ne,NoMinus
+ bit 0,qb ; darf auch nur einmal auftreten
+ jrl nz,Error
+ set 0,qb
+ cp qc,1 ; je nach Phase anderes Flag setzen
+ jr ne,MinPhase3
+ set 1,qb ; bei Mantisse Bit 1...
+ jr ReadLoop
+MinPhase3: set 2,qb ; bei Exponent Bit 2
+ jr ReadLoop
+NoMinus:
+ cp a,'.' ; Umschaltung zu Phase 2 (Nachkomma) ?
+ jr ne,NoPoint
+ cp qc,1 ; bish. Phase muá eins sein
+ jrl ne,Error
+ ld qc,2 ; neue Phase eintragen
+ set 0,qb ; Nachkomma darf kein Vorzeichen haben
+ ld xde,(Tenth) ; im Nachkomma durch 10 teilen
+ jr ReadLoop
+NoPoint:
+ cp a,'e' ; kleines und groáes E zulassen
+ jr eq,IsE
+ cp a,'E'
+ jr ne,NoE
+IsE: cp qc,3 ; vorherige Phase muá 1 oder 2 sein
+ jr eq,Error
+ ld qc,3 ; vermerken
+ res 0,qb ; Vorzeichen wieder zugelassen
+ jr ReadLoop
+NoE:
+ sub a,'0' ; jetzt nur noch 0..9 zugelassen
+ jr c,Error
+ cp a,9
+ jr ugt,Error
+ set 0,qb ; nach Ziffern kein Vorzeichen mehr zulassen
+
+ cp qc,1 ; Phase 1 (Mantisse) :
+ jr ne,NoPhase1
+ push xwa ; Zeichen retten
+ ld xwa,xde ; bish. Mantisse * 10
+ call fmul
+ ld xhl,xwa
+ pop xwa ; Zahl nach Float wandeln
+ call fitof
+ call fadd ; dazuaddieren
+ ld xhl,xwa ; Mantisse zurcklegen
+ jrl ReadLoop
+NoPhase1:
+ cp qc,2 ; Phase 2 (Nachkomma) :
+ jr ne,NoPhase2
+ call fitof ; Stelle nach Float wandeln
+ push xhl ; Mantisse retten
+ ld xhl,xde ; Stelle mit Zehnerpotenz skalieren
+ call fmul
+ pop xhl ; zur Mantisse addieren
+ call fadd
+ push xwa ; Zwischenergebnis retten
+ ld xwa,xde ; n„chste Skalierungspotenz ausrechnen
+ ld xhl,(Tenth)
+ call fmul
+ ld xde,xwa ; alles wieder zurck
+ pop xhl
+ jrl ReadLoop
+NoPhase2:
+ mul bc,10 ; Exponent heraufmultiplizieren
+ add bc,wa
+ cp bc,45 ; Minimum ist 1e-45
+ jr ugt,Error
+ jrl ReadLoop
+
+Combine: bit 2,qb ; Exponent negativ ?
+ jr z,ExpPos
+ neg bc
+ExpPos: call fPot10 ; Zehnerpotenz des Exponenten bilden
+ call fmul ; mit Mantisse kombinieren
+ bit 1,qb ; Mantisse negativ ?
+ jr z,ManPos
+ set 15,qwa
+ManPos: rcf ; Ende ohne Fehler
+
+ pop xix ; Register zurck
+ pop xhl
+ pop xde
+ pop xbc
+ ret
+
+Error: ld xwa,xix ; Endzeiger laden
+ pop xix
+ pop xhl
+ sub xwa,xhl ; rel. Position des fehlerhaften Zeichens berechnen
+ pop xde
+ pop xbc
+ scf ; Ende mit Fehler
+ ret
+
+ endp
+
+;------------------------------------------------------------------------------
+; gemeinsames Ende
+
+ endsection
+
diff --git a/tests/t_fl900/macros.inc b/tests/t_fl900/macros.inc
new file mode 100644
index 0000000..951a117
--- /dev/null
+++ b/tests/t_fl900/macros.inc
@@ -0,0 +1,16 @@
+; MACROS.INC
+;******************************************************************************
+;* šberall gebrauchte Makros *
+;* *
+;* Alfred Arnold, Oktober 1993 *
+;******************************************************************************
+
+proc macro name ; Prozedureintritt
+ section name
+ public name
+name label $
+ endm
+
+endp macro name ; Prozeduraustritt
+ endsection name
+ endm
diff --git a/tests/t_fl900/t_fl900.asm b/tests/t_fl900/t_fl900.asm
new file mode 100644
index 0000000..72510c2
--- /dev/null
+++ b/tests/t_fl900/t_fl900.asm
@@ -0,0 +1,166 @@
+; FTEST.ASM
+;******************************************************************************
+;* Testet Gleitkommabibliothek fr TLCS900 *
+;* *
+;* Hardware: Micro-ICE TLCS900 *
+;* Software: AS 1.39p1 oder h”her *
+;* Includes MACROS.INC, FLOAT.INC, CONOUT.INC, CPU_TIME.INC *
+;* *
+;* šbersetzen mit AS ftest oder beiliegendem Makefile *
+;* *
+;******************************************************************************
+
+ cpu 96c141
+
+ org 1000h ; Startadresse User-RAM
+
+;------------------------------------------------------------------------------
+
+CR equ 13
+LF equ 10
+Format_Tab equ 0000100000000110b ; fftoa-Format fr tab. Ausgabe
+Format_Min equ 0010001100000101b ; fftoa-Format fr minimale L„nge
+; ³<Â>³³<ÄÄÂÄÄÄ>
+; ³ ³ ³³ ³
+; ³ ³ ³³ ÀÄÄÄÄÄÄ Maximalzahl Nachkommastellen
+; ³ ³ ³ÀÄÄÄÄÄÄÄÄÄÄ Mantissenpluszeichen unterdrcken
+; ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄ Exponentenpluszeichen unterdrcken
+; ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄ Minimalstellenzahl Exponent
+; ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ anh„ngende Nullen Mantisse l”schen
+Format equ Format_Tab ; gew„hltes fftoa-Format
+
+ supmode on ; Vorgaben
+ maxmode on
+ macexp off
+ page 0 ; keine FFs
+ include macros.inc
+
+;------------------------------------------------------------------------------
+; Hauptroutine, Test
+
+; kleine Schreiberleichterung:
+
+bench macro op,arg1,arg2,arg3,msg
+ call PSTR ; Kennmeldung ausgeben
+ db msg,StrTerm
+ call CPU_TIME ; Uhr starten
+ ld xwa,arg1 ; Operanden holen
+ if "ARG2"<>"" ; 2. Operanden evtl. weglassen
+ ld xhl,arg2
+ endif
+ if "ARG3"<>"" ; dito 3. Operanden
+ ld bc,arg3
+ endif
+ call op ; Probanden laufen lassen
+ ld (xiz),xwa ; Ergebnis weglegen...
+ call CPU_STOP ; Uhr anhalten, Zeit ausgeben
+ if ("OP"<>"FNOP")&&("OP"<>"FFTOI")
+ call PSTR ; etwas Platz
+ db ", Ergebnis: ",StrTerm
+ ld xwa,(xiz+) ; Wert ausgeben
+ lda xhl,(Buffer)
+ ld bc,Format
+ call fftoa
+ call TXTAUS
+ endif
+ call PSTR
+ db CR,LF,StrTerm
+ endm
+
+ proc Main
+
+ max ; ohne das macht das keinen Spaá !
+ lda xsp,(Stack) ; etwas brauchen wir schon...
+ lda xiz,(Ergs) ; Zeiger auf Ergebnisfeld
+ call CPU_TI_INI ; Timer initialisieren
+
+ ; Overhead messen
+ bench fnop,(FConst1),(FConst1),,"Overhead : "
+
+ ; Addition zweier fast gleicher Zahlen
+ bench fadd,(FConst1),(FConst2),,"Laufzeit 1+2 : "
+
+ ; Addition zweier unterschiedl. groáer Zahlen
+ bench fadd,(FConst1),(FConst100000),,"Laufzeit 1+100000 : "
+
+ ; Subtraktion zweier fast gleicher Zahlen
+ bench fsub,(FConst1),(FConst2),,"Laufzeit 1-2 : "
+
+ ; Subtraktion zweier unterschiedl. groáer Zahlen
+ bench fsub,(FConst1),(FConst100000),,"Laufzeit 1-100000 : "
+
+ ; Multiplikation
+ bench fmul,(FConst2),(FConstPi),,"Laufzeit 2*Pi : "
+
+ ; Division
+ bench fdiv,(FConst2),(FConstPi),,"Laufzeit 2/Pi : "
+
+ ; Multiplikation mit 2er-Potenz
+ bench fmul2,(FConstPi),,10,"Laufzeit Pi*2^(10) : "
+
+ ; Division durch 2er-Potenz
+ bench fmul2,(FConstPi),,-10,"Laufzeit Pi*2^(-10) : "
+
+ ; kleine Zahl nach Float wandeln
+ bench fitof,1,,,"Laufzeit 1-->Float : "
+
+ ; groáe Zahl nach Float wandeln
+ bench fitof,100000,,,"Laufzeit 1E5-->Float: "
+
+ ; kleine Zahl nach Int wandeln
+ bench fftoi,(FConst1),,,"Laufzeit 1-->Int : "
+
+ ; groáe Zahl nach Int wandeln
+ bench fftoi,(FConst100000),,,"Laufzeit 1E5-->Int : "
+
+ ; Wurzel
+ bench fsqrt,(FConst2),,,"Laufzeit SQRT(2) : "
+
+ call PSTR
+ db "Eingabe: ",StrTerm
+ lda xhl,(InpBuffer)
+ call TXTAUS
+ call fatof
+ call PSTR
+ db ", Ergebnis: ",StrTerm
+ lda xhl,(Buffer)
+ ld bc,Format
+ call fftoa
+ call TXTAUS
+ call PSTR
+ db 13,10,StrTerm
+
+ swi 7 ; zum Monitor zurck
+
+ endp
+
+fnop: ld xwa,0 ; Dummy
+ ret
+
+ include "float.inc"
+ include "conout.inc"
+ include "cpu_time.inc"
+
+;------------------------------------------------------------------------------
+; Gleitkommakonstanten
+
+ align 4 ; fr schnelleren Zugriff
+
+FConst1 dd 1.0
+FConst2 dd 2.0
+FConst100000 dd 100000.0
+FConstM1 dd -1.0
+FConstM2 dd -2.0
+FConstPi dd 40490fdbh ; um Vergleichsfehler durch Rundung zu
+ ; vermeiden
+Ergs dd 30 dup (?) ; Platz fr Ergebnisse
+
+Buffer: db 20 dup (?)
+InpBuffer: db "12.3456E-12",0
+
+;------------------------------------------------------------------------------
+; Stack
+
+ db 200 dup (?)
+Stack:
+
diff --git a/tests/t_fl900/t_fl900.doc b/tests/t_fl900/t_fl900.doc
new file mode 100644
index 0000000..4e7cf63
--- /dev/null
+++ b/tests/t_fl900/t_fl900.doc
@@ -0,0 +1,6 @@
++------------------------ Test Application FL900 ----------------------------+
+| |
+| This is an IEEE single precision floating point library for the Toshiba |
+| TLCS-900 microcontroller, embedded into a small test program. |
+| |
++-----------------------------------------------------------------------------+
diff --git a/tests/t_fl900/t_fl900.inc b/tests/t_fl900/t_fl900.inc
new file mode 100644
index 0000000..4a02c1e
--- /dev/null
+++ b/tests/t_fl900/t_fl900.inc
@@ -0,0 +1,2 @@
+; t_fl900.asm-Includefile für Assembler-Programm
+; Ende Includefile für Assembler-Programm
diff --git a/tests/t_fl900/t_fl900.ori b/tests/t_fl900/t_fl900.ori
new file mode 100755
index 0000000..74929d8
--- /dev/null
+++ b/tests/t_fl900/t_fl900.ori
Binary files differ
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-01 05:23:16 +0000