aboutsummaryrefslogtreecommitdiffstats
path: root/tests/t_parsys
diff options
context:
space:
mode:
Diffstat (limited to 'tests/t_parsys')
-rw-r--r--tests/t_parsys/asflags1
-rw-r--r--tests/t_parsys/float.i681226
-rw-r--r--tests/t_parsys/float81.i68293
-rw-r--r--tests/t_parsys/parsys.i68115
-rw-r--r--tests/t_parsys/t_parsys.asm994
-rw-r--r--tests/t_parsys/t_parsys.doc8
-rw-r--r--tests/t_parsys/t_parsys.inc10
-rw-r--r--tests/t_parsys/t_parsys.oribin0 -> 7516 bytes
8 files changed, 2647 insertions, 0 deletions
diff --git a/tests/t_parsys/asflags b/tests/t_parsys/asflags
new file mode 100644
index 0000000..01f6552
--- /dev/null
+++ b/tests/t_parsys/asflags
@@ -0,0 +1 @@
+-c \ No newline at end of file
diff --git a/tests/t_parsys/float.i68 b/tests/t_parsys/float.i68
new file mode 100644
index 0000000..fbfc1e9
--- /dev/null
+++ b/tests/t_parsys/float.i68
@@ -0,0 +1,1226 @@
+; FLOAT.I68
+;-----------------------------------------------------------------------------
+; Fliesskommaroutinen fuer den PC-PAR 68000, Version ohne 68881
+; entnommen mc 11/88, c't...
+
+;-----------------------------------------------------------------------------
+; Definitionen
+
+vorz equ 0
+subflag equ 1
+maxexpo equ 255
+bias equ 127
+extend equ $10
+e equ $402df854 ; exp(1)
+ln2 equ $3f317218 ; ln(2)
+ln10 equ $40135d8e ; ln(10)
+eins equ $3f800000 ; 1.0
+zwei equ $40000000 ; 2.0
+pi2 equ $40c90fdb ; Pi*2
+pi equ $40490fdb ; Pi
+pihalf equ $3fc90fdb ; Pi/2
+
+;-----------------------------------------------------------------------------
+; Librarykopf:
+
+
+S_FloatLib: dc.l S_floatlibend-S_floatlibstart ; Laenge
+S_floatlibstart:
+ dc.l -1 ; Speicher fuer Zeiger
+ dc.b "FLOAT",0 ; Name
+ ds 0
+
+
+
+;-----------------------------------------------------------------------------
+; Sprungtabelle:
+
+ bra.l S_fadd
+ bra.l S_fsub
+ bra.l S_fmul
+ bra.l S_fdiv
+ bra.l S_fmul2
+ bra.l S_fsqrt
+ bra.l S_fabs
+ bra.l S_floatlibnop
+ bra.l S_fcmp
+ bra.l S_fitof
+ bra.l S_fftoi
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_fexp
+ bra.l S_fsinh
+ bra.l S_fcosh
+ bra.l S_ftanh
+ bra.l S_fcoth
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_fln
+ bra.l S_flog
+ bra.l S_fasinh
+ bra.l S_facosh
+ bra.l S_fatanh
+ bra.l S_facoth
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_fsin
+ bra.l S_fcos
+ bra.l S_ftan
+ bra.l S_fcot
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_floatlibnop
+ bra.l S_fasin
+ bra.l S_facos
+ bra.l S_fatan
+ bra.l S_facot
+
+
+;-----------------------------------------------------------------------------
+; Konstanten :
+
+S_Const1 dc.s 1.0
+
+;-----------------------------------------------------------------------------
+; Nullprozedur :
+
+S_floatlibnop: rts
+
+;-----------------------------------------------------------------------------
+; Addition : D0.S = D0.S + D1.S
+
+ ds 0
+S_fadd:
+ addq.l #1,_fadd_cnt.w
+ movem.l d1-d5,-(a7) ; benoetigte Register retten
+ rol.l #1,d0 ; Operanden rotieren und in Form
+ rol.l #1,d1 ; eeee eeee ffff ... fffs bringen
+ move.l d0,d2
+ sub.l d1,d2 ; Differenz beider Zahlen bilden
+ bcc.s fadd_1
+ exg d0,d1 ; ggf. vertauschen, so dass der
+fadd_1: move.b d0,d3 ; kleinere in Register D1 steht
+ and.b #1,d3 ; maskiere das Vorzeichenbit
+ btst #vorz,d2 ; haben beide gleiches Vorzeichen ?
+ beq.s fadd_2 ; bei verschiedenen Vorzeichen
+ bset #subflag,d3 ; Flag fuer Subtraktion setzen
+fadd_2: rol.l #8,d0 ; Form: ffff ... fffs eeee eeee
+ clr.w d4 ; Exponent der ersten Zahl
+ move.b d0,d4 ; wird im Register D4 aufgebaut
+ sne d0 ; falls ungleich Null, dann
+ ror.l #1,d0 ; implizite Eins, sonst implizite
+ clr.b d0 ; Null erzeugen, neu positionieren
+
+ rol.l #8,d1 ; jetzt das gleiche fuer den
+ clr.w d5 ; zweiten Operanden, der Exponent
+ move.b d1,d5 ; kommt ins Register D5
+ sne d1
+ ror.l #1,d1
+ clr.b d1
+
+; In den Registern D0 und D1 stehen jetzt nur noch die Mantissen
+; im Format ffff ... ffff 0000 0000, also linksbuendig, wobei die
+; ehemals implizite Null bzw. Eins nun explizit an erster Stelle steht.
+; In den Registern D4 und D5 stehen die Exponenten der beiden Zahlen.
+; Das Vorzeichen des Ergebnisses sowie die Subtraktionsflags sind im
+; Register D3 zwischengespeichert.
+
+ move.w d4,d2 ; Jetzt Differenz der Exponenten
+ sub.w d5,d2 ; berechnen
+ cmp.w #24,d2 ; groesser als 24 ?
+ bgt.s fadd_rnd ; ja, --> Ergebnis ist groessere Zahl
+ lsr.l d2,d1 ; Mantisse um (D2)-Bits verschieben
+ btst #subflag,d3 ; Subtraktion oder Addition ?
+ bne.s fadd_subtr ; ggf. zur Subtraktion springen
+ add.l d1,d0 ; die beiden Mantissen addieren
+ bcc.s fadd_rnd ; kein Ueberlauf --> zum Runden
+ roxr.l #1,d0 ; Ueberlauf einschieben
+ addq.w #1,d4 ; Exponent korrigieren
+ bra.s fadd_rnd ; und zum Runden
+
+fadd_subtr: sub.l d1,d0 ; die beiden Mantissen subtrahieren
+ beq.s fadd_zero ; bei Null ist das Gesamtergebnis Null
+ bmi.s fadd_rnd ; bei fuehrender Eins zum Runden
+fadd_nrm: tst.w d4 ; Exponent ist schon Null ?
+ beq.s fadd_rnd ; dann ist Ergebnis denormalisiert
+ subq.w #1,d4 ; Exponent erniedrigen
+ lsl.l #1,d0 ; Mantisse normalisieren bis
+ bpl.s fadd_nrm ; fuehrende Eins auftaucht
+
+fadd_rnd: add.l #$80,d0 ; jetzt Runden auf Bit hinter
+ bcc.s fadd_nov ; Mantisse
+ roxr.l #1,d0 ; bei Ueberlauf Mantisse normalisieren
+ addq.w #1,d4 ; und Exponent korrigieren
+fadd_nov: clr.b d0 ; Rest-Mantisse loeschen
+ tst.l d0 ; Ist die Mantisse komplett Null ?
+ beq.s fadd_zero ; ja, dann ist Ergebnis auch Null
+ cmp.w #maxexpo,d4 ; Exponent-Ueberlauf ?
+ blt.s fadd_nue
+ move.w #maxexpo,d4 ; Unendlich Exponent = maxexpo
+ clr.l d0 ; Mantisse = Null
+ bra.s fadd_den
+
+fadd_nue: tst.w d4 ; Exponent Null ( Zahl denormalisiert? )
+ beq.s fadd_den ; ja -->
+ lsl.l #1,d0 ; fuehrendes Bit wird nicht gespeichert
+fadd_den: move.b d4,d0 ; Exponent einsetzen
+ ror.l #8,d0 ; Form: eeee eeee ffff ... fffx
+ roxr.b #1,d3 ; Vorzeichen in Carry schieben
+ roxr.l #1,d0 ; Form: seee eeee efff ... ffff
+
+fadd_zero:
+ movem.l (a7)+,d1-d5 ; Register restaurieren
+ rts ; Ende, Ergebnis steht in D0.L
+
+;-----------------------------------------------------------------------------
+; Subtraktion : D0.S = D0.S - D1.S
+
+ ds 0
+S_fsub:
+ bchg #31,d1 ; Vorzeichen des zweiten Operanden
+ bra S_fadd ; invertieren und zur Addition springen
+
+
+;-----------------------------------------------------------------------------
+; Multiplikation : D0.S = D0.S * D1.S
+
+ ds 0
+S_fmul:
+ addq.l #1,_fmul_cnt.w
+ movem.l d1-d5,-(a7) ; benoetigte Register retten
+ move.l d0,d2 ; Operand 1 kopieren
+ eor.l d1,d2 ; EXOR um Vorzeichen zu bestimmen
+
+ swap d0 ; Registerhaelften Operand 1 vertauschen
+ move.l d0,d3 ; Operand 1 ab jetzt in Register D3
+ and.w #$7f,d3 ; Exponent und Vorzeichen loeschen
+ and.w #$7f80,d0 ; Exponent maskieren
+ beq.s fmul_dn1 ; gleich Null: Zahl ist denormalisiert
+ bset #7,d3 ; implizite Eins einsetzen
+ sub.w #$0080,d0 ; Bias kompensieren
+
+fmul_dn1: swap d1 ; jetzt Operand 2 behandeln
+ move.w d1,d4
+ and.w #$7f,d1
+ and.w #$7f80,d4
+ beq.s fmul_dn2
+ bset #7,d1
+ sub.w #$0080,d4 ; Bias kompensieren
+
+fmul_dn2: add.w d0,d4 ; Exponenten addieren
+ lsr.w #7,d4 ; richtig positionieren
+ sub.w #bias-3,d4 ; Bias-3 subtrahieren
+ cmp.w #-24,d4 ; totaler Unterlauf ?
+ blt.s fmul_zero ; ja, dann ist Ergebnis Null
+
+ move.w d3,d0 ; oberes Mantissenwort von Operand 1
+ mulu d1,d0 ; mal oberem Mantissenwort von Op2
+ swap d0 ; entspricht Verschiebung um 16 Bit
+
+; Das obere Wort von D0 ist nach der Multiplikation auf jeden Fall Null,
+; da die oberen Mantissenworte nur im Bereich 0 ... 255 liegen.
+; Das groete moegliche Ergebnis ist also 255 x 255 = 65025 = 0000FE01.
+; Nach der Vertauschung erhalten wir also eine Zahl der xxxx 0000.
+; Die untere Registerhaelfte von D0 koennen wir kurzzeitig als Zwischen-
+; speicher verwenden.
+
+ move.w d3,d0 ; oberes Wort von Operand 1 merken
+ swap d3 ; jetzt unteres Wort Op1 mal oberes Op2
+ move.w d1,d5
+ mulu d3,d5 ; Ergebnis steht im D5
+ swap d1 ; jetzt unteres Wort Op1 mal unteres Op2
+ mulu d1,d3 ; Ergebnis steht im D3
+ swap d3 ; entspricht Verschiebung um 16 Bit
+ mulu d0,d1 ; jetzt oberes Wort Op1 mal unteres Op2
+
+ move.w d3,d0 ; zum ersten Zwischenergebnis dazu
+ add.l d5,d0 ; jetzt alles aufaddieren
+ add.l d1,d0
+ beq.s fmul_res ; falls Mantisse Null auch Ergebnis Null
+ bmi.s fmul_rnd ; fuehrende Eins? dann zum Runden
+
+; Im Register D0.L befinden sich die oberen 32 Bit des Produktes,
+; im oberen Wort von D3 die restlichen 16 Bit.
+
+ tst.w d4 ; Exponent ist negativ ?
+ bmi.s fmul_unt ; ggf. Unterlauf behandeln
+
+fmul_nor: tst.w d4 ; Exponent = Null ?
+ beq.s fmul_rnd ; falls Null, dann zum Runden
+ roxl.l #1,d3 ; Im oberen Wort von D3 sind die
+ roxl.l #1,d0 ; niedrigsten Bits des Produktes
+ subq.w #1,d4 ; Exponent korrigieren
+ tst.l d0 ; Mantisse testen
+ bpl.s fmul_nor ; bis fuehrende Eins auftaucht
+
+fmul_rnd: add.l #$80,d0 ; Rundung
+ bcc.s fmul_nov
+ roxr.l #1,d0 ; Ueberlauf einschieben
+ addq.w #1,d4 ; Exponent korrigieren
+fmul_nov: cmp.w #maxexpo,d4 ; Exponent-Ueberlauf ?
+ blt.s fmul_nue
+fdiv_err: move.w #maxexpo,d4 ; Ueberlauf: Exponent = Maxexpo
+ clr.l d0 ; Mantisse = Null
+ bra.s fmul_den
+
+fmul_nue: tst.w d4 ; Exponent = Null ?
+ beq.s fmul_den ; falls Null, dann denormalisiert
+ lsl.l #1,d0 ; fuehrende Eins wird nicht abgespeichert
+
+fmul_den: move.b d4,d0 ; Exponent einsetzen
+ ror.l #8,d0 ; Form: eeee eeee ffff ... fffx
+ roxl.l #1,d2 ; Vorzeichen in Carry schieben
+ roxr.l #1,d0 ; und ins Ergebnis einsetzen
+
+fmul_res: movem.l (a7)+,d1-d5 ; Register restaurieren
+ rts
+
+fmul_zero: clr.l d0 ; Null erzeugen
+ bra.s fmul_res ; Ende, Ergebnis steht in D0.L
+
+fmul_unt: cmp.w #-24,d4 ; totaler Unterlauf ?
+ ble.s fmul_zero ; Dann ist das Ergebnis auf jeden Fall Null
+ neg.w d4 ; sonst Shift-Zaehler erzeugen
+ lsr.l d4,d0 ; und Zahl denormalisieren
+ clr.w d4 ; Exponent ist Null als Kennzeichen
+ bra.s fmul_rnd ; fuer eine denormalisierte Zahl
+
+;-----------------------------------------------------------------------------
+; Division : D0.S = D0.S / D1.S
+
+ ds 0
+S_fdiv:
+ addq.l #1,_fdiv_cnt.w
+ movem.l d1-d5,-(a7) ; benoetigte Register retten
+ move.l d0,d2 ; Operand 1 kopieren
+ eor.l d1,d2 ; EXOR um Vorzeichen zu bestimmen
+
+ swap d0 ; Registerhaelften Operand 1 vertauschen
+ move.l d0,d3 ; Operand 1 ab jetzt in Register D3
+ and.w #$7f,d3 ; Exponent und Vorzeichen loeschen
+ and.w #$7f80,d0 ; Exponent maskieren
+ beq.s fdiv_dn1 ; gleich Null: Zahl ist denormalisiert
+ bset #7,d3 ; implizite Eins einsetzen
+ sub.w #$0080,d0 ; Bias kompensieren
+
+fdiv_dn1: swap d1 ; jetzt Operand 2 behandeln
+ move.w d1,d4
+ and.w #$7f,d1
+ and.w #$7f80,d4
+ beq.s fdiv_dn2
+ bset #7,d1
+ sub.w #$0080,d4
+
+fdiv_dn2: sub.w d4,d0 ; Exponenten subtrahieren
+ move.w d0,d4 ; Exponent nach D4 kopieren
+ asr.w #7,d4 ; richtig positionieren
+ add.w #bias,d4 ; Bias addieren
+ cmp.w #-24,d4 ; totaler Ueberlauf ?
+ blt.s fmul_zero ; ja, dann ist Ergebnis Null
+
+ swap d1 ; Form: 0fff ... ffff 0000 0000
+ beq.s fdiv_err ; falls Divisor Null, dann wird
+ lsl.l #7,d1 ; als Ergebnis unendlich ausgegeben
+ swap d3
+ beq.s fmul_zero ; falls Divident Null --> Ergebnis Null
+ lsl.l #7,d3
+
+fdiv_nlp: btst #30,d1 ; ist der Divisor normalisiert ?
+ bne.s fdiv_nor ; ja, -->
+ addq.w #1,d4 ; nein, Exponent erhoehen
+ lsl.l #1,d1 ; Divisor verschieben bis Form 01ff ..
+ bra.s fdiv_nlp
+
+fdiv_nor: clr.l d0 ; Ergebnis vorbesetzen
+ add.w #25,d4 ; Exponent ist nicht groesser als Null
+
+fdiv_lop: move.l d3,d5 ; Divident zwischenspeichern
+ sub.l d1,d3 ; Divisor abziehen
+ eori #extend,ccr ; X-Bit invertieren
+ bcc.s fdiv_one ; kein Carry: Divisor passt
+ move.l d5,d3 ; zurueckkopieren (X-Bit unveraendert!)
+fdiv_one: roxl.l #1,d0 ; Ergebnis aufbauen
+ lsl.l #1,d3 ; Divident verschieben
+ subq.w #1,d4 ; Exponent erniedrigen
+ beq.s fdiv_den ; falls Null, dann denormalisiert
+ btst #24,d0 ; fuehrende Eins in Ergebnis-Mantisse?
+ beq.s fdiv_lop ; nein, weiter rechnen
+
+fdiv_den: lsl.l #7,d0 ; Mantisse positionieren
+ beq fmul_res ; Null ?
+ bra fmul_rnd ; zum Runden
+;-----------------------------------------------------------------------------
+; Multiplikation mit einer Zweierpotenz: D0.S=D0.S * 2^(D1.W)
+
+ ds 0
+S_fmul2:
+ addq.l #1,_fmul_cnt.w
+ movem.l d1-d2,-(a7) ; Register retten
+ move.l d0,d2 ; Vorzeichen in D2 Bit 31 merken
+ lsl.l #1,d0 ; Vorzeichen rausschieben
+ beq.s fmul2_zero ; falls Null, dann ist Ergebnis Null
+ rol.l #8,d0 ; Form: ffff ... fff0 eeee eeee
+ clr.w d2 ; auf Wort vorbereiten
+ move.b d0,d2 ; Exponent in D2
+ beq.s fmul2_den
+ tst.w d1 ; Multiplikation oder Division?
+ bmi.s fmul2_div ; (neg. Exponent entspr. Div.)
+
+ add.w d1,d2 ; Summe der Exponenten bilden
+ cmp.w #maxexpo,d2 ; Ueberlauf?
+ bge.s fmul2_over ; ja, Ergebnis ist unendlich
+fmul2_res: move.b d2,d0 ; Ergebnisexponent einsetzen
+ ror.l #8,d0 ; Form: eeee eeee ffff ... fffx
+ roxl.l #1,d2 ; Vorzeichen ins X-Bit
+ roxr.l #1,d0 ; und ins Ergebnis einschieben
+fmul2_zero: movem.l (a7)+,d1-d2 ; Register restaurieren
+ rts
+
+fmul2_over: move.w #maxexpo,d2 ; Unendlich: Exponent = maxexpo
+ clr.l d0 ; Mantisse = Null
+ bra.s fmul2_res
+
+fmul2_div: add.w d1,d2 ; Summe der Exponenten bilden
+ bgt.s fmul2_res ; Unterlauf? nein --> Ergebnis
+ ori #Extend,ccr ; implizite Eins real machen
+ roxr.l #1,d0 ; Form: 1fff ... ffff xxxx xxxx
+fmul2_dnr: tst.w d2 ; Exponent = Null ?
+ beq.s fmul2_res ; ja, Ergebnis ist denormalisiert
+ lsr.l #1,d0 ; Mantisse denormalisieren
+ beq.s fmul2_zero ; totaler Unterlauf: Ergebnis ist Null
+ addq.w #1,d2 ; Exponent korrigieren
+ bra.s fmul2_dnr
+fmul2_ddd: add.w d1,d2 ; Summe der Exponenten bilden
+ bra.s fmul2_dnr ; mit denormalisiereter Eingabe bearbeiten
+
+fmul2_den: tst.w d1 ; Multiplikation oder Division
+ bmi.s fmul2_ddd
+ clr.b d0 ; Form: ffff ... fff0 0000 0000
+fmul2_nor: lsl.l #1,d0 ; Mantisse nach links schieben
+ bcs.s fmul2_stp ; bis fuehrende Eins auftaucht
+ subq.w #1,d1 ; oder zweiter Exponent Null wird
+ bne.s fmul2_nor
+ bra.s fmul2_res ; Ergebnis abliefern
+fmul2_stp: add.w d1,d2 ; Rest zum Exponenten addieren
+ bra.s fmul2_res ; Bias stimmt auch ( jetzt 127 statt 126)
+
+;-----------------------------------------------------------------------------
+; Vergleich zweier Zahlen: cmp d0,d1
+
+S_fcmp:
+ bclr #31,d0 ; Zahl 1 >=0 ?
+ bne.s fcmp_2
+fcmp_1:
+ bclr #31,d1 ; Zahl 2 >=0 ?
+ bne.s fcmp_12
+fcmp_11:
+ cmp.l d1,d0 ; beide Zahlen >=0
+ rts ; dann Betraege vergleichen
+fcmp_12:
+ moveq.l #1,d0 ; Zahl 1 >=0 und Zahl 2 <0
+ cmp.l #-1,d0
+ rts
+fcmp_2:
+ bclr #31,d1 ; Zahl 2 >=0 ?
+ bne.s fcmp_22
+fcmp_21:
+ moveq.l #-1,d0 ; Zahl 1 <0 und Zahl 2 >=0
+ cmp.w #1,d0 ; dann kleiner
+ rts
+fcmp_22:
+ neg.l d0
+ neg.l d1
+ cmp.l d1,d0 ; beide Zahlen <0, dann ver-
+ rts ; kehrtherum vergleichen
+
+
+;-----------------------------------------------------------------------------
+; Longint-->Gleitkomma
+; D0.L --> D0.S
+
+S_fitof:
+ movem.l d1-d2,-(a7) ; Register retten
+ tst.l d0 ; Integer ist Null ?
+ beq.s fitof_res; Ergebnis ist auch Null
+ smi d1 ; Vorzeichen in D1 merken
+ bpl.s fitof_pos
+ neg.l d0 ; ggf. Integer negieren
+fitof_pos: move.w #bias+32,d2 ; Exponent vorbesetzen
+fitof_shift: subq.w #1,d2 ; Mantisse verschieben
+ lsl.l #1,d0 ; bis fuehrende Eins rausfliegt
+ bcc.s fitof_shift
+ move.b d2,d0 ; Exponent einsetzen
+ ror.l #8,d0 ; Zahl positionieren
+ roxr.b #1,d1 ; Vorzeichen in X-Bit
+ roxr.l #1,d0 ; und ins Ergebnis
+fitof_res: movem.l (a7)+,d1-d2 ; fertig
+ rts
+
+;-----------------------------------------------------------------------------
+; Gleitkomma --> Longint:
+; D0.S --> D0.L
+
+S_fftoi:
+ movem.l d1-d2,-(a7) ; Register retten
+ roxl.l #1,d0 ; Vorzeichen in Carry
+ scs d1 ; in D1 merken
+ rol.l #8,d0 ; Form: ffff ... fffx eeee eeee
+ move.b d0,d2 ; Exponent extrahieren
+ sub.b #bias,d2 ; Bias subtrahieren
+ bmi.s fftoi_zero ; kleiner Null -> Ergebnis = Null
+ cmp.b #31,d2 ; Ueberlauf?
+ bge.s fftoi_over
+ ori #extend,ccr ; Implizite Eins explizit machen
+ roxr.l #1,d0
+ clr.b d0 ; Form: 1fff ... ffff 0000 0000
+fftoi_shft:
+ lsr.l #1,d0 ; jetzt Verschiebung bis
+ addq.b #1,d2 ; Exponent stimmt
+ cmp.b #31,d2
+ bne.s fftoi_shft
+ tst.b d1 ; Zahl negativ ?
+ bpl.s fftoi_pos
+ neg.l d0 ; ggf. Ergebnis negieren
+fftoi_pos:
+ movem.l (a7)+,d1-d2 ; Register wieder holen
+ rts
+fftoi_zero:
+ clr.l d0 ; Unterlauf; Ergebnis ist Null
+ bra.s fftoi_pos
+fftoi_over:
+ move.l #$7fffffff,d0 ; Ueberlauf: Maxint zurueckgeben
+ tst.b d1 ; positiv oder negativ ?
+ bpl.s fftoi_pos
+ not.l d0 ; Einser-Komplement erzeugt Minint
+ bra.s fftoi_pos
+
+;-----------------------------------------------------------------------------
+; Quadratwurzel : D0.S-->D0.S
+
+ ds 0
+fsqrt_domainerror:
+ move.l #$ffc00000,d0 ; -NAN zurueckgeben
+ movem.l (a7)+,d1-d4
+ rts
+fsqrt_sq0:
+ clr.l d0
+ movem.l (a7)+,d1-d4
+ rts
+S_fsqrt:
+ addq.l #1,_fsqrt_cnt.w
+ movem.l d1-d4,-(a7) ; D1-D4 werden sonst zerstoert
+ move.l d0,d4
+ bmi.s fsqrt_domainerror ; Fehler bei negativem Argument
+ swap d4 ; MSW des Arguments
+ and.l #$7f80,d4 ; Exponent isolieren
+ beq.s fsqrt_sq0 ; Zahl ist 0, wenn Exponent 0
+ and.l #$007fffff,d0 ; Mantisse isolieren
+ sub.w #$7f*$80,d4 ; Exponent im Zweierkomplement
+ bclr #7,d4 ; Exponent ungerade? (und LSB auf 0)
+ beq.s fsqrt_evenexp
+ add.l d0,d0 ; ja: Mantisse * 2
+ add.l #$01000000-$00800000,d0 ; Hidden Bit setzen, 1.Iteration
+
+fsqrt_evenexp:
+ ; 1. Iteration fuer geraden Exponenten: Hidden Bit nicht setzen
+ asr.w #1,d4 ; Exponent/2 mit Vorzeichen
+ add.w #$7f*$80,d4 ; Exponent wieder in Offset-Darst.
+ swap d4 ; neuen Exponenten im MSW aufheben
+ lsl.l #7,d0 ; x ausrichten
+ move.l #$40000000,d2 ; xroot nach erster Iteration
+ move.l #$10000000,d3 ; m2=2 << (MaxBit-1);
+fsqrt_loop10:
+ move.l d0,d1 ; xx2 = x
+fsqrt_loop11:
+ sub.l d2,d1 ; xx2 -= root
+ lsr.l #1,d2 ; xroot >>= 1
+ sub.l d3,d1 ; x2 -= m2
+ bmi.s fsqrt_dontset1
+ move.l d1,d0 ; x = xx2
+ or.l d3,d2 ; xroot += m2
+ lsr.l #2,d3 ; m2 >>= 2
+ bne.s fsqrt_loop11
+ bra.s fsqrt_d0d1same
+fsqrt_dontset1:
+ lsr.l #2,d3 ; m2 >>= 2
+ bne.s fsqrt_loop10 ; Schleife 15* abarbeiten
+ ; Bit 22..8
+ ; 17. Iteration (Bit 7) mit separatem Code durchfuehren:
+ move.l d0,d1 ; xx2 = x
+fsqrt_d0d1same:
+ sub.l d2,d1 ; xx2 -= root
+ ror.l #1,d2 ; xroot >>= 1 mitsamt Carry...
+ swap d2 ; auf neues Alignment umstellen
+ subq.l #1,d1 ; Carry von 0-0x4000: x2 -= m2
+ ; Teil 1
+ bmi.s fsqrt_dontset7
+ or.l #-$40000000,d1 ; 0 - 0x4000: x2 -= m2, Teil 2
+ move.l d1,d0 ; x = xx2
+ or.w #$4000,d2 ; xroot += m2
+fsqrt_dontset7:
+ swap d0 ; x auf neues Alignment umstellen
+
+ move.w #$1000,d3 ; m2 - Bit 16..31 bereits 0
+fsqrt_loop20:
+ move.l d0,d1 ; xx2 = x
+fsqrt_loop21:
+ sub.l d2,d1 ; xx2 -= xroot
+ lsr.l #1,d2 ; xroot >>= 1
+ sub.l d3,d1 ; x2 -= m2
+ bmi.s fsqrt_dontset2
+ move.l d1,d0 ; x = xx2
+ or.w d3,d2 ; xroot += m2
+ lsr.w #2,d3 ; m2 >>= 2
+ bne.s fsqrt_loop21
+ bra.s fsqrt_finish
+fsqrt_dontset2:
+ lsr.w #2,d3 ; m2 >>= 2
+ bne.s fsqrt_loop20 ; Schleife 7 * abarbeiten (n=6..0)
+fsqrt_finish:
+ sub.l d2,d0 ; Aufrunden notwendig ?
+ bls.s fsqrt_noinc
+ addq.l #1,d2 ; wenn ja, durchfuehren
+fsqrt_noinc:
+ bclr #23,d2 ; Hidden Bit loeschen
+ or.l d4,d2 ; Exponent und Mantisse kombinieren
+ move.l d2,d0 ; Ergebnis
+ movem.l (a7)+,d1-d4
+ rts ; Z-,S-, und V-Flag o.k.
+
+;-----------------------------------------------------------------------------
+; Absolutbetrag: D0.S--> D0.S
+
+ ds 0
+
+S_fabs: bclr #31,d0 ; ganz einfach...
+ rts
+
+;-----------------------------------------------------------------------------
+; Exponentialfunktion: D0.S--> D0.S
+
+; Die "krummen" Konstanten legen wir als hex ab, damit es keine Vergleichs-
+; fehler durch Rundungsvarianzen gibt.
+
+S_fexp_Const0: dc.l $3FB8AA3B ; ld(exp(1.0)) = ld(e) = 1/ln(2)
+S_fexp_ConstA: dc.l $3D0DF4E0 ; 0.034657359038 Polynomkonstanten
+S_fexp_ConstB: dc.l $411F4606 ; 9.9545957821
+S_fexp_ConstC: dc.l $441A7E3A ; 617.97226953
+S_fexp_ConstD: dc.l $42AED5C2 ; 87.417498202
+
+ ds 0
+S_fexp: movem.l d1-d5,-(sp)
+
+ bclr #31,d0 ; Vorzeichen loeschen und nach D2 retten
+ sne d2
+
+ move.l S_fexp_Const0(pc),d1 ; auf 2erpotenz umrechnen
+ bsr S_fmul
+
+ move.l d0,d3 ; in Ganzzahlanteil und Nach-
+ bsr S_fftoi ; kommastellen (z) zerlegen
+ move.l d0,d4 ; Ganzzahlanteil nach D4
+ bsr S_fitof
+ move.l d0,d1
+ move.l d3,d0
+ bsr S_fsub
+ move.l d0,d3
+
+ move.l d0,d1 ; z^2 berechnen
+ bsr S_fmul
+ move.l d0,d5 ; noch zu gebrauchen
+
+ move.l S_fexp_ConstD(pc),d1 ; --> D+z^2
+ bsr S_fadd
+ move.l d0,d1 ; --> C/(..)
+ move.l S_fexp_ConstC(pc),d0
+ bsr S_fdiv
+ move.l d0,d1 ; --> B-(..)
+ move.l S_fexp_ConstB(pc),d0
+ bsr S_fsub
+ move.l d3,d1 ; --> (..)-z
+ bsr S_fsub
+ exg d0,d5 ; Ergebnis retten
+ move.l S_fexp_ConstA(pc),d1 ; A*z^2 berechnen
+ bsr S_fmul
+ move.l d5,d1 ; ergibt Nenner
+ bsr S_fadd
+ move.l d0,d1 ; Quotient bilden
+ move.l d3,d0
+ bsr S_fdiv
+ moveq #1,d1 ; verdoppeln
+ bsr S_fmul2
+ move.l S_Const1(pc),d1 ; 1 addieren
+ bsr S_fadd
+ move.l d4,d1 ; Potenzieren
+ bsr S_fmul2
+
+ tst.b d2 ; war Argument negativ ?
+ beq.s S_fexp_ArgPos
+ move.l d0,d1 ; dann Kehrwert bilden
+ move.l S_Const1(pc),d0
+ bsr S_fdiv
+
+Terminate:
+S_fexp_ArgPos: movem.l (sp)+,d1-d5
+
+ rts
+
+;------------------------------------------------------------------------------
+; Sinus hyperbolicus: D0.S-->D0.S
+
+S_fsinh:
+ movem.l d1-d2,-(a7) ; Register retten
+ bsr S_fexp ; exp(x) berechnen
+ move.l d0,d2 ; in D2 merken
+ move.l d0,d1 ; exp(-x)=1/exp(x) berechnen
+ move.l #eins,d0
+ bsr S_fdiv
+ move.l d0,d1 ; Teilergebnisse subtrahieren
+ move.l d2,d0
+ bsr S_fsub
+ move.w #-1,d1 ; halbieren
+ bsr S_fmul2
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+
+;------------------------------------------------------------------------------
+; Cosinus hyperbolicus: D0.S-->D0.S
+
+S_fcosh:
+ movem.l d1-d2,-(a7) ; Register retten
+ bsr S_fexp ; exp(x) berechnen
+ move.l d0,d2 ; in D2 merken
+ move.l d0,d1 ; exp(-x)=1/exp(x) berechnen
+ move.l #eins,d0
+ bsr S_fdiv
+ move.l d2,d1 ; Teilergebnisse addieren
+ bsr S_fadd
+ move.w #-1,d1 ; halbieren
+ bsr S_fmul2
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Tangens hyperbolicus: D0.S-->D0.S
+
+S_ftanh:
+ movem.l d1-d3,-(a7) ; Register sichern
+ bsr S_fexp ; exp(x) berechnen
+ move.l d0,d2 ; in D2 merken
+ move.l d0,d1 ; exp(-x)=1/exp(x) berechnen
+ move.l #eins,d0
+ bsr S_fdiv
+ move.l d0,d3 ; in D3 merken
+ move.l d2,d1 ; Summe=Nenner berechnen
+ bsr S_fadd
+ exg d0,d2 ; jetzt exp(x) in D0, Nenner
+ move.l d3,d1 ; in D2
+ bsr S_fsub ; Zaehler berechnen
+ move.l d2,d1 ; Quotient berechnen
+ bsr S_fdiv
+ movem.l (a7)+,d1-d3 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Cotangens hyperbolicus: D0.S-->D0.S
+
+S_fcoth:
+ tst.l d0 ; Argument Null ?
+ beq.s S_fcoth_valerr ; dann zur Fehlerroutine
+ movem.l d1-d3,-(a7) ; Register sichern
+ bsr S_fexp ; exp(x) berechnen
+ move.l d0,d2 ; in D2 merken
+ move.l d0,d1 ; exp(-x)=1/exp(x) berechnen
+ move.l #eins,d0
+ bsr S_fdiv
+ move.l d0,d3 ; in D3 merken
+ move.l d0,d1 ; Differenz=Nenner berechnen
+ move.l d2,d0
+ bsr S_fsub
+ exg d0,d2 ; jetzt exp(x) in D0, Nenner
+ move.l d3,d1 ; in D2
+ bsr S_fadd ; Zaehler berechnen
+ move.l d2,d1 ; Quotient berechnen
+ bsr S_fdiv
+ movem.l (a7)+,d1-d3 ; Register zurueck
+ rts
+S_fcoth_valerr:
+ move.l #$7f800000,d0 ; +INF zurueckgeben
+ rts
+
+;-----------------------------------------------------------------------------
+; nat. Logarithmus: D0.S-->D0.S
+
+ ds 0
+S_fln:
+ tst.l d0 ; Argument <=0 ?
+ ble S_fln_errval
+ movem.l d1-d7,-(a7) ; Register retten
+ move.l d0,d3 ; Argument sichern
+
+ move.l #eins,d1 ; Zahl>1?
+ bsr S_fsub ; ( dies ist sinnvoll bei
+ tst.l d0 ; Zahlen <<1 );
+ smi d7 ; und die Vorzeichenumkehr merken
+ bpl.s S_fln_gr1 ; ja-->o.k.
+ move.l d3,d1 ; ansonsten Kehrwert bilden
+ move.l #eins,d0
+ bsr S_fdiv
+ move.l d0,d3
+
+S_fln_gr1:
+ clr.l d2 ; Merker = Null
+S_fln_nrm:
+ move.l d3,d0 ; Zahl > 1 ?
+ move.l #eins,d1
+ bsr S_fsub
+ bmi.s S_fln_isok
+ beq.s S_fln_isok
+ sub.l #$00800000,d3 ; ja-->Zahl durch 2 teilen...
+ addq.w #1,d2 ; ...und Merker erhoehen
+ bra.s S_fln_nrm ; nochmal probieren
+S_fln_isok:
+ move.l d0,d3 ; Zahl um Eins erniedrigt abspeichern
+ move.l d0,d4 ; yz:=y
+ moveq.l #1,d6 ; zaehler:=1
+ clr.l d5 ; Summe:=0
+ bchg #31,d3 ; Multiplikator negativ
+S_fln_loop:
+ move.l d6,d0 ; Zaehler in Gleitkomma wandeln
+ bsr S_fitof
+ move.l d0,d1 ; s:=s+yz/zaehler*vz
+ move.l d4,d0
+ bsr S_fdiv
+ move.l d5,d1
+ bsr S_fadd
+ cmp.l d5,d0 ; noch signifikant ?
+ beq.s S_fln_loopend
+ move.l d0,d5
+ addq.w #1,d6 ; zaehler:=zaehler+1
+ cmp.w #10,d6 ; Schleife fertig ?
+ beq.s S_fln_loopend
+ move.l d4,d0 ; yz:=yz*y
+ move.l d3,d1
+ bsr S_fmul
+ move.l d0,d4
+ bra.s S_fln_loop
+S_fln_loopend:
+ move.l d2,d0 ; Merker in Gleitkomma
+ bsr S_fitof
+ move.l #ln2,d1 ; * ln(2)
+ bsr S_fmul
+ move.l d5,d1 ; s:=s+merker
+ bsr S_fadd
+
+ tst.b d7 ; noch Vorzeichen tauschen ?
+ beq.s S_fln_end
+ bchg #31,d0
+S_fln_end:
+ movem.l (a7)+,d1-d7 ; Register zurueck
+ rts
+S_fln_errval:
+ move.l #$ffc00000,d0 ; -NAN zurueckgeben
+ rts
+
+;-----------------------------------------------------------------------------
+; 10er-Logarithmus : D0.S --> D0.S
+
+S_flog:
+ tst.l d0 ; Argument <=0 ?
+ ble.s S_flog_errval
+ bsr S_fln ; nat. Logarithmus bilden
+ move.l #ln10,d1 ; umrechnen
+ bsr S_fdiv
+ rts
+S_flog_errval:
+ move.l #$ffc00000,d0 ; -NAN zurueckgeben
+ rts
+
+;-----------------------------------------------------------------------------
+; Areasinus hyperbolicus: D0.S-->D0.S == ln[x+sqrt(x*x+1)]
+
+S_fasinh:
+ movem.l d1-d2,-(a7)
+ move.l d0,d2 ; Argument sichern
+ move.l d0,d1 ; quadrieren
+ bsr S_fmul
+ move.l #eins,d1 ; 1 addieren
+ bsr S_fadd
+ bsr S_fsqrt ; Wurzel ziehen
+ move.l d2,d1 ; Argument addieren
+ bsr S_fadd
+ bsr S_fln ; Logarithmus des ganzen
+ movem.l (a7)+,d1-d2
+ rts
+
+;-----------------------------------------------------------------------------
+; Areacosinus hyperbolicus: D0.S-->D0.S == ln[x+sqrt(x*x-1)]
+
+S_facosh:
+ movem.l d1-d2,-(a7) ; Register sichern
+ move.l d0,d2 ; Argument sichern
+ move.l #eins,d1 ; Argument <1 ?
+ bsr S_fcmp
+ bmi.s S_facosh_errval
+ move.l d2,d0 ; Argument zurueck
+ move.l d0,d1 ; quadrieren
+ bsr S_fmul
+ move.l #eins,d1 ; 1 abziehen
+ bsr S_fsub
+ bsr S_fsqrt ; Wurzel ziehen
+ move.l d2,d1 ; Argument addieren
+ bsr S_fadd
+ bsr S_fln ; Logarithmus des ganzen
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_facosh_errval:
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ move.l #$ffc00000,d0 ; NAN zurueckgeben
+ rts
+
+;-----------------------------------------------------------------------------
+; Areatangens hyperbolicus: D0.S-->D0.S == 0.5*ln((1+x)/(1-x))
+
+S_fatanh:
+ movem.l d1-d2,-(a7) ; Register sichern
+ move.l d0,d2 ; Argument sichern
+ bclr #31,d0 ; Vorzeichen weg
+ cmp.l #eins,d0
+ beq.s S_fatanh_inf ; =1-->INF
+ bhi.s S_fatanh_errval ; >1-->NAN
+ move.l d2,d1 ; Nenner berechnen
+ move.l #eins,d0
+ bsr S_fsub
+ exg d0,d2 ; Zaehler berechnen
+ move.l #eins,d1
+ bsr S_fadd
+ move.l d2,d1 ; Quotient daraus
+ bsr S_fdiv
+ bsr S_fln ; logarithmieren
+ move.w #-1,d1 ; halbieren
+ bsr S_fmul2
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_fatanh_inf:
+ move.l #$ff000000,d0 ; vorzeichenbehaftete Unend-
+ roxr.l #1,d0 ; lichkeit
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_fatanh_errval:
+ move.l #$7fc00000,d0 ; NAN geben
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Areakotangens hyperbolicus: D0.S--> D0.S == 0.5*ln((1+x)/(x-1))
+
+S_facoth:
+ movem.l d1-d2,-(a7) ; Register sichern
+ move.l d0,d2 ; Argument sichern
+ roxl.l #1,d0 ; Vorzeichen in X-Flag
+ cmp.l #eins*2,d0
+ beq.s S_facoth_inf ; =1-->INF
+ bmi.s S_facoth_errval ; <1-->NAN
+ move.l d2,d0 ; Nenner berechnen
+ move.l #eins,d1
+ bsr S_fsub
+ exg d0,d2 ; Zaehler berechnen
+ move.l #eins,d1
+ bsr S_fadd
+ move.l d2,d1 ; Quotient daraus
+ bsr S_fdiv
+ bsr S_fln ; logarithmieren
+ move.w #-1,d1 ; halbieren
+ bsr S_fmul2
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_facoth_inf:
+ move.l #$ff000000,d0 ; vorzeichenbehaftete Unend-
+ roxr.l #1,d0 ; lichkeit
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_facoth_errval:
+ move.l #$7fc00000,d0 ; NAN geben
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Kosinusfunktion: D0.S--> D0.S
+
+ ds 0
+S_fcos:
+ movem.l d1-d6,-(a7) ; Register retten
+ bclr #31,d0 ; cos(-x)=cos(x)
+
+ move.l #pi2,d1 ; auf Bereich 0..2*Pi reduzieren
+S_fcos_subtr:
+ cmp.l d1,d0 ; x>=2*Pi ?
+ blo.s S_fcos_subend ; ja-->Ende
+ bchg #31,d1 ; fuer Subtraktion
+ bsr S_fadd ; reduzieren
+ bchg #31,d1 ; Subtrahend wieder richtig
+ bra.s S_fcos_subtr
+S_fcos_subend:
+ cmp.l #pi,d0 ; x>Pi ?
+ blo.s S_fcos_nosub
+ exg d0,d1 ; ja-->cos(x)=cos(2*Pi-x)
+ bsr S_fsub
+S_fcos_nosub:
+ move.l d0,d1 ; wir brauchen nur x^2
+ bsr S_fmul
+ bset #31,d0
+ move.l d0,d3 ; -x^2 in D3
+ move.l d0,d4 ; D4 enthaelt laufende Potenz von x^2
+ ; inkl. Vorzeichen
+ move.l #zwei,d5 ; D5 enthaelt laufende Fakultaet
+ move.l #eins,d2 ; D2 enthaelt Summe
+ moveq.l #2,d6 ; D6 enthaelt Zaehler
+S_fcos_loop:
+ move.l d5,d1 ; s:=s+yz/zaehler
+ move.l d4,d0
+ bsr S_fdiv
+ move.l d2,d1
+ bsr S_fadd
+ cmp.l d2,d0 ; Veraendert sich Summe noch ?
+ beq.s S_fcos_end
+ move.l d0,d2
+ addq.b #2,d6 ; i:=i+1
+ cmp.b #22,d6 ; i=11 ?
+ beq.s S_fcos_end
+ move.w d6,d0 ; Fakultaet erhhen: *(2n-1)*(2n)
+ mulu.w d6,d0 ; =4*n^2-2*n
+ sub.w d6,d0
+ bsr S_fitof ; dazumultiplizieren
+ move.l d5,d1
+ bsr S_fmul
+ move.l d0,d5
+ move.l d4,d0 ; yz:=yz*y
+ move.l d3,d1
+ bsr S_fmul
+ move.l d0,d4
+ bra.s S_fcos_loop
+S_fcos_end:
+ ; Ergebnis bereits in D0
+ movem.l (a7)+,d1-d6 ; Register zurueck
+ rts
+
+;----------------------------------------------------------------------------
+; Sinus : D0.S-->D0.S
+
+S_fsin:
+ move.l d1,-(a7) ; Register retten
+ move.l #pihalf,d1 ; sin(x)=cos(x-pi/2)
+ bsr S_fsub
+ bsr S_fcos
+ move.l (a7)+,d1 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Tangens: D0.S-->D0.S
+
+S_ftan:
+ movem.l d1-d4,-(a7) ; Register retten
+ tst.l d0 ; Vorzeichen merken
+ smi d4
+ bclr #31,d0
+ move.l #pi,d1 ; auf Bereich 0..Pi reduzieren
+S_ftan_subtr:
+ cmp.l d1,d0 ; x>=Pi ?
+ blo.s S_ftan_subend ; ja-->Ende
+ bchg #31,d1 ; fuer Subtraktion
+ bsr S_fadd ; reduzieren
+ bchg #31,d1 ; Subtrahend wieder richtig
+ bra.s S_ftan_subtr
+S_ftan_subend:
+ move.l d0,d2 ; Argument merken
+ bsr S_fcos ; Nenner rechnen
+ move.l d0,d3 ; Nenner merken
+ move.l d0,d1 ; sqr(1-x^2) rechnen
+ bsr S_fmul
+ move.l d0,d1
+ move.l #eins,d0
+ bsr S_fsub
+ bsr S_fsqrt
+ move.l d3,d1
+ bsr S_fdiv ; Quotient
+ tst.b d4 ; Vorzeichen dazu
+ beq.s S_ftan_noneg
+ bchg #31,d0
+S_ftan_noneg:
+ movem.l (a7)+,d1-d4 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Kotangens: D0.S-->D0.S
+
+S_fcot:
+ movem.l d1-d4,-(a7) ; Register retten
+ tst.l d0 ; Vorzeichen merken
+ smi d4
+ bclr #31,d0
+ move.l #pi,d1 ; auf Bereich 0..Pi reduzieren
+S_fcot_subtr:
+ cmp.l d1,d0 ; x>=Pi ?
+ blo.s S_fcot_subend ; ja-->Ende
+ bchg #31,d1 ; fuer Subtraktion
+ bsr S_fadd ; reduzieren
+ bchg #31,d1 ; Subtrahend wieder richtig
+ bra.s S_fcot_subtr
+S_fcot_subend:
+ move.l d0,d2 ; Argument merken
+ bsr S_fcos ; Zaehler rechnen
+ move.l d0,d3 ; Zaehler merken
+ move.l d0,d1 ; sqr(1-x^2) rechnen
+ bsr S_fmul
+ move.l d0,d1
+ move.l #eins,d0
+ bsr S_fsub
+ bsr S_fsqrt
+ move.l d0,d1
+ move.l d3,d0
+ bsr S_fdiv ; Quotient
+ tst.b d4 ; Vorzeichen dazu
+ beq.s S_fcot_noneg
+ bchg #31,d0
+S_fcot_noneg:
+ movem.l (a7)+,d1-d4 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Arcustangens: D0.S-->D0.S
+
+S_fatan:
+ movem.l d1-d6,-(a7) ; Register sichern
+ subq.l #2,a7 ; Platz fuer Hilfsvariablen
+ tst.l d0 ; Vorzeichen merken...
+ smi (a7)
+ bclr #31,d0 ; ...und loeschen
+ cmp.l #eins,d0 ; Argument>1 ?
+ shi 1(a7) ; ja :
+ bls.s S_fatan_no1 ; nein :
+ move.l d0,d1 ; ja : Kehrwert bilden
+ move.l #eins,d0
+ bsr S_fdiv
+S_fatan_no1:
+ move.l #3,d2 ; Zaehler initialisieren
+ move.l d0,d5 ; Summe initialisieren
+ move.l d0,d4 ; laufende Potenz = x^1
+ move.l d0,d1 ; x^2 berechnen
+ bsr S_fmul
+ move.l d0,d3
+ bset #31,d3 ; immer mit -x^2 multiplizieren
+S_fatan_loop:
+ move.l d4,d0 ; naechste Potenz ausrechnen
+ move.l d3,d1
+ bsr S_fmul
+ move.l d0,d4
+ move.l d2,d0 ; Nenner in Gleitkomma
+ bsr S_fitof
+ move.l d0,d1 ; Division ausfuehren
+ move.l d4,d0
+ bsr S_fdiv
+ move.l d5,d1 ; zur Summe addieren
+ bsr S_fadd
+ cmp.l d0,d5 ; noch signifikant ?
+ beq.s S_fatan_endloop ; nein-->Ende
+ move.l d0,d5
+ addq.l #2,d2 ; Zaehler erhoehen
+ cmp.l #61,d2 ; fertig ?
+ bne.s S_fatan_loop
+S_fatan_endloop:
+ move.l d5,d0 ; Ergebnis in D0 bringen
+ tst.b 1(a7) ; war Argument < 1 ?
+ beq.s S_fatan_not2
+ bchg #31,d0 ; ja : Erg.=Pi/2-Erg
+ move.l #pihalf,d1
+ bsr S_fadd
+S_fatan_not2:
+ tst.b (a7) ; Vorzeichen dazu
+ beq.s S_fatan_not1
+ bset #31,d0
+S_fatan_not1:
+ addq.l #2,a7 ; Hilfsvar. abraeumen
+ movem.l (a7)+,d1-d6 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Arcuskotangens: D0.S-->D0.S
+
+S_facot:
+ move.l d1,-(a7) ; Register sichern
+ bsr S_fatan ; acot(x)=pi/2-atan(x)
+ bchg #31,d0
+ move.l #pihalf,d1
+ bsr S_fadd
+ move.l (a7)+,d1 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Arcussinus: D0.S --> D0.S
+
+S_fasin:
+ movem.l d1-d2,-(a7) ; Register retten
+ move.l d0,d2 ; Argument merken
+ move.l d0,d1 ; Quadrat berechnen
+ bsr S_fmul
+ bset #31,d0 ; 1-x^2 bilden
+ move.l #eins,d1
+ bsr S_fadd
+ tst.l d0 ; Sonderfaelle abfangen
+ bmi.s S_fasin_errval ; <0 geht nicht
+ beq.s S_fasin_inf ; Endwerte
+ bsr S_fsqrt ; Wurzel ...
+ move.l d0,d1 ; ... und Quotient
+ move.l d2,d0
+ bsr S_fdiv
+ bsr S_fatan ; zuletzt das wichtigste
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_fasin_errval:
+ move.l #$7fc00000,d0 ; NAN zurueckgeben
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_fasin_inf:
+ move.l #pihalf,d0 ; +- pi/2 zurueckgeben
+ and.l #$80000000,d2 ; Vorzeichen dazu
+ or.l d2,d0
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+
+;-----------------------------------------------------------------------------
+; Arcuskosinus: D0.S --> D0.S
+
+S_facos:
+ tst.l d0 ; Argument=0 ?
+ beq.s S_facos_inf
+ move.l d0,d2 ; Argument merken
+ move.l d0,d1 ; Quadrat berechnen
+ bsr S_fmul
+ bset #31,d0 ; 1-x^2 bilden
+ move.l #eins,d1
+ bsr S_fadd
+ tst.l d0 ; Sonderfaelle abfangen
+ bmi.s S_facos_errval ; <0 geht nicht
+ bsr S_fsqrt ; Wurzel ...
+ move.l d2,d1 ; ... und Quotient
+ bsr S_fdiv
+ bsr S_fatan ; zuletzt das wichtigste
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_facos_errval:
+ move.l #$7fc00000,d0 ; NAN zurueckgeben
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+S_facos_inf:
+ move.l #pihalf,d0 ; +- pi/2 zurueckgeben
+ and.l #$80000000,d2 ; Vorzeichen dazu
+ or.l d2,d0
+ movem.l (a7)+,d1-d2 ; Register zurueck
+ rts
+
+S_floatlibend:
diff --git a/tests/t_parsys/float81.i68 b/tests/t_parsys/float81.i68
new file mode 100644
index 0000000..ed5a3dc
--- /dev/null
+++ b/tests/t_parsys/float81.i68
@@ -0,0 +1,293 @@
+;----------------------------------------------------------------------------
+; Fliesskommaroutinen fuer den PcPar68000 - Version mit 68881
+
+;-----------------------------------------------------------------------------
+; Definitionen:
+
+CoConst1 equ $32 ; Offsets im Konstantenrom
+CoConstPi equ 0 ; des 6888x
+
+;-----------------------------------------------------------------------------
+; Librarykopf:
+
+
+S_Float81Lib: dc.l S_float81libend-S_float81libstart ; Laenge
+S_float81libstart:
+ dc.l -1 ; Speicher fuer Zeiger
+ dc.b "FLOAT",0 ; Name
+ ds 0
+
+
+;-----------------------------------------------------------------------------
+; Sprungtabelle:
+
+ bra.l S_fadd_co68
+ bra.l S_fsub_co68
+ bra.l S_fmul_co68
+ bra.l S_fdiv_co68
+ bra.l S_fsqrt_co68
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_fcmp_co68
+ bra.l S_fitof_co68
+ bra.l S_fftoi_co68
+ bra.l S_fabs_co68
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_fexp_co68
+ bra.l S_fsinh_co68
+ bra.l S_fcosh_co68
+ bra.l S_ftanh_co68
+ bra.l S_fcoth_co68
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_fln_co68
+ bra.l S_flog_co68
+ bra.l S_fasinh_co68
+ bra.l S_facosh_co68
+ bra.l S_fatanh_co68
+ bra.l S_facoth_co68
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_fsin_co68
+ bra.l S_fcos_co68
+ bra.l S_ftan_co68
+ bra.l S_fcot_co68
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_float81libnop
+ bra.l S_fasin_co68
+ bra.l S_facos_co68
+ bra.l S_fatan_co68
+ bra.l S_facot_co68
+
+S_float81libnop: rts
+
+;----------------------------------------------------------------------------
+
+ fpu on
+S_fadd_co68:
+ addq.l #1,_fadd_cnt.w
+ fmove.s d0,fp0
+ fadd.s d1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fsub_co68:
+ addq.l #1,_fadd_cnt.w
+ fmove.s d0,fp0
+ fsub.s d1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fmul_co68:
+ addq.l #1,_fmul_cnt.w
+ fmove.s d0,fp0
+ fsglmul.s d1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fdiv_co68:
+ addq.l #1,_fdiv_cnt.w
+ fmove.s d0,fp0
+ fsgldiv.s d1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fmul2_co68:
+ addq.l #1,_fmul_cnt.w
+ fmove.s d0,fp0
+ fscale.w d1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fitof_co68:
+ fmove.l d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fftoi_co68:
+ fmove.s d0,fp0
+ fmove.l fp0,d0
+ rts
+
+
+S_fsqrt_co68:
+ addq.l #1,_fsqrt_cnt.w
+ fsqrt.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fabs_co68: bclr #31,d0 ; ganz einfach...
+ rts
+
+
+S_fcmp_co68:
+ fmove.s d0,fp0
+ fcmp.s d1,fp0
+ fbeq.l S_fcmp_coeq ; Variante 1:gleich
+ fbgt.l S_fcmp_cogt ; Variante 2:groeer
+
+ moveq #1,d0 ; Bedingung "kleiner"
+ cmp.w #2,d0 ; erzeugen
+ rts
+S_fcmp_cogt:
+ moveq #2,d0 ; Bedingung "groesser"
+ cmp.w #1,d0 ; erzeugen
+ rts
+S_fcmp_coeq:
+ cmp.w d0,d0 ; Bedingung "gleich"
+ rts ; erzeugen
+
+
+S_fexp_co68:
+ fetox.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fsinh_co68:
+ fsinh.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fcosh_co68:
+ fcosh.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_ftanh_co68:
+ ftanh.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fcoth_co68:
+ fmove.s d0,fp0
+ fsinh.x fp0,fp1
+ fcosh.x fp0
+ fsgldiv.x fp1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fln_co68:
+ flogn.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_flog_co68:
+ flog10.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fasinh_co68:
+ fmove.s d0,fp0
+ fmove.x fp0,fp1
+ fmul.x fp1,fp0
+ fmovecr.x #CoConst1,fp2
+ fadd.x fp2,fp0
+ fsqrt.x fp0
+ fadd.x fp1,fp0
+ flogn.x fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_facosh_co68:
+ fmove.s d0,fp0
+ fmove.x fp0,fp1
+ fmul.x fp1,fp0
+ fmovecr.x #CoConst1,fp2
+ fsub.x fp2,fp0
+ fsqrt.x fp0
+ fadd.x fp1,fp0
+ flogn.x fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fatanh_co68:
+ fatanh.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_facoth_co68:
+ fmovecr.x #CoConst1,fp0
+ fdiv.s d0,fp0
+ fatanh.x fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fcos_co68:
+ fcos.s d0,fp0
+ fmove.x fp0,d0
+ rts
+
+
+S_fsin_co68:
+ fsin.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_ftan_co68:
+ ftan.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fcot_co68:
+ fsincos.s d0,fp0:fp1
+ fsgldiv.x fp1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fatan_co68:
+ fatan.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_facot_co68:
+ fatan.s d0,fp1
+ fmovecr.x #CoConstPi,fp0
+ fscale.w #-1,fp0
+ fsub.x fp1,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_fasin_co68:
+ fasin.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+
+S_facos_co68:
+ facos.s d0,fp0
+ fmove.s fp0,d0
+ rts
+
+S_float81libend:
+
+ fpu off
+
diff --git a/tests/t_parsys/parsys.i68 b/tests/t_parsys/parsys.i68
new file mode 100644
index 0000000..e5a2569
--- /dev/null
+++ b/tests/t_parsys/parsys.i68
@@ -0,0 +1,115 @@
+; Includedatei PcPar-System
+; vor dem Programm mit include einbinden
+
+;----------------------------------------------------------------------------
+; offizieller Datenbereich:
+
+ shared S_RegSave,S_MemEnd,S_ParNo,S_CPUNo
+ shared _fadd_cnt,_fmul_cnt,_fdiv_cnt,_fsqrt_cnt
+
+ org $400
+S_MemEnd:
+ ds.l 1 ; Speicherende ( Default 64K )
+S_SysStart:
+ ds.l 1 ; Anfang des Systemcodes
+S_ParNo: ; vom PC geschiebene Werte
+ ds.w 1 ; Parallelrechneradresse
+S_LibAdr: ; Adresse der Library-
+ ds.l 1 ; sprungtabelle
+_fadd_cnt: ; Anzahl ausgefuehrter Gleit-
+ ds.l 1 ; kommaadditionen/subtraktion
+_fmul_cnt: ; dito Multiplikation
+ ds.l 1
+_fdiv_cnt: ; dito Division
+ ds.l 1
+_fsqrt_cnt: ; dito Quadratwurzel
+ ds.l 1
+S_FreeMemEnd:
+ ds.l 1 ; Ende freien Speichers
+S_CPUNo:
+ ds.w 1 ; CPU-Typ: 0 = 68008
+ ; 1 = 68000
+ ; 2 = 68010
+ ; 3 = 68020
+ ; 4 = 68030
+ ; Byte 1 : $01 = 68881
+ ; $02 = 68882
+ ; $10 = 68851
+ org $600
+
+S_SSPEnd:
+ ds.l 1 ; Anfang des Systemstacks
+S_ResVecSave: ; Sicherung Resetvektor
+ ds.l 1
+S_RegSave: ; Registersicherung
+ ds.l 17 ; wird vom PC veraendert
+S_ExVec: ; Exceptionvektor
+ ds.w 1
+S_LibStart:
+ ds.l 1 ; Anfang Librarykette
+ org $800
+
+;-----------------------------------------------------------------------------
+; Libraryoffsets :
+
+fadd equ $0000
+fsub equ $0004
+fmul equ $0008
+fdiv equ $000c
+fmul2 equ $0010
+fsqrt equ $0014
+fabs equ $0018
+
+fcmp equ $0020
+fitof equ $0024
+fftoi equ $0028
+
+fexp equ $0040
+fsinh equ $0044
+fcosh equ $0048
+ftanh equ $004c
+fcoth equ $0050
+
+fln equ $0060
+flog equ $0064
+fasinh equ $0068
+facosh equ $006c
+fatanh equ $0070
+facoth equ $0074
+
+fsin equ $0080
+fcos equ $0084
+ftan equ $0088
+fcot equ $008c
+
+fasin equ $00a0
+facos equ $00a4
+fatan equ $00a8
+facot equ $00ac
+
+;----------------------------------------------------------------------------
+; Konstanten fuer Betriebssystemaufrufe:
+
+TrapProgEnd equ 15 ; Trap fuer Programmende
+
+TrapTglSStep equ 14 ; Trap Einzelschritt an/aus
+
+TrapLibCtrl equ 13 ; Trap Libraryverwaltung
+LibCtrlInstall equ 0
+LibCtrlGetAdr equ 1
+
+;----------------------------------------------------------------------------
+; andere Konstanten:
+
+S_Latch equ $fffffffe ; Adresse der I/O-Latches
+
+is68008 equ $00 ; Prozessorcode 68008
+is68000 equ $01 ; " 68000
+is68010 equ $02 ; " 68010
+is68020 equ $03 ; " 68020
+is68030 equ $04 ; " 68030
+has68881 equ $01 ; " 68881
+has68882 equ $02 ; " 68882
+hasMMU equ $10 ; " 68851
+intMMU equ $20 ; " interne MMU
+
diff --git a/tests/t_parsys/t_parsys.asm b/tests/t_parsys/t_parsys.asm
new file mode 100644
index 0000000..8afe6f3
--- /dev/null
+++ b/tests/t_parsys/t_parsys.asm
@@ -0,0 +1,994 @@
+ include parsys.i68
+
+ page 60
+ cpu 68000
+
+;-----------------------------------------------------------------------------
+; Die Exceptionvektoren:
+
+ supmode on
+
+ org $00000000 ; Die Vektoren
+ dc.l 0 ; Adresse vom Stack (Dummy)
+ dc.l Start ; erster Start
+ dc.l ex_vec2 ; Busfehler
+ dc.l ex_vec3 ; Adressfehler
+ dc.l ex_vec4 ; Illegaler Befehl
+ dc.l ex_vec5 ; Division durch Null
+ dc.l ex_vec6 ; Befehl CHK
+ dc.l ex_vec7 ; Befehl TRAPV
+ dc.l ex_vec8 ; Privilegverletzung
+ dc.l StepProc ; Ablaufverfolgung
+ dc.l ex_vec10 ; Line-A --> Gleitkomma
+ dc.l S_LineF ; Line-F --> 68881-Emulator
+ dc.l ex_vec12 ; Reserviert
+ dc.l ex_vec13 ; Koprozessor-Protokollfehler
+ dc.l ex_vec14 ; illegaler FRESTORE-Frame
+ dc.l ex_vec15 ; nicht initialisierter Unterbrechungsvektor
+ dc.l ex_vec16 ; Reserviert
+ dc.l ex_vec17 ; Reserviert
+ dc.l ex_vec18 ; Reserviert
+ dc.l ex_vec19 ; Reserviert
+ dc.l ex_vec20 ; Reserviert
+ dc.l ex_vec21 ; Reserviert
+ dc.l ex_vec22 ; Reserviert
+ dc.l ex_vec23 ; Reserviert
+ dc.l ex_vec24 ; Unechte Unterbrechung
+ dc.l ex_vec25 ; autovektoriell 1
+ dc.l ex_vec26 ; autovektoriell 2
+ dc.l ex_vec27 ; autovektoriell 3
+ dc.l ex_vec28 ; autovektoriell 4
+ dc.l ex_vec29 ; autovektoriell 5
+ dc.l ex_vec30 ; autovektoriell 6
+ dc.l ex_vec31 ; autovektoriell 7
+ dc.l PcSysCall ; Trap #0 --> PC-Kommunikation
+ dc.l ex_vec33 ; Trap #1
+ dc.l ex_vec34 ; Trap #2
+ dc.l ex_vec35 ; Trap #3
+ dc.l ex_vec36 ; Trap #4
+ dc.l ex_vec37 ; Trap #5
+ dc.l ex_vec38 ; Trap #6
+ dc.l ex_vec39 ; Trap #7
+ dc.l ex_vec40 ; Trap #8
+ dc.l ex_vec41 ; Trap #9
+ dc.l ex_vec42 ; Trap #10
+ dc.l ex_vec43 ; Trap #11
+ dc.l ex_vec44 ; Trap #12
+ dc.l S_LibFun ; Trap #13 --> Libraryverwaltung
+ dc.l S_StepTgl ; Trap #14 --> Trace an/aus
+ dc.l S_ProgEnd ; Trap #15 --> Programmende
+ dc.l ex_vec48 ; BSUN in FPU gesetzt
+ dc.l ex_vec49 ; FPU inexaktes Ergebnis
+ dc.l ex_vec50 ; FPU Division durch 0
+ dc.l ex_vec51 ; FPU Unterlauf
+ dc.l ex_vec52 ; FPU Operandenfehler
+ dc.l ex_vec53 ; FPU Ueberlauf
+ dc.l ex_vec54 ; FPU signaling NAN
+ dc.l ex_vec55 ; reserviert
+ dc.l ex_vec56 ; MMU Konfigurationsfehler
+ dc.l ex_vec57 ; MMU Illegale Operation
+ dc.l ex_vec58 ; MMU Zugriffsfehler
+ ; Vektoren 59..255 frei
+
+;----------------------------------------------------------------------------
+; Installationssequenz:
+
+ org $800
+start:
+ clr.w S_Latch.w ; Port nullen
+
+ and.b #$fc,S_MemEnd+3.w ; Speichergroesse auf Lang-
+ ; wortadresse ausrichten
+ move.l S_MemEnd.w,a7 ; SSP setzen
+
+ lea -256(a7),a0 ; SSP-Anfang in A0
+ move.l a0,S_SSPEnd.w ; sichern
+
+ lea S_End.w,a1 ; Codelaenge berechnen
+ lea S_Start.w,a2
+ sub.l a2,a1 ; A1=Laenge Systemcode
+ moveq #4,d0 ; auf mehrfaches von 4 aus-
+ sub.w a1,d0 ; richten
+ and.l #3,d0
+ add.l d0,a1
+
+ sub.l a1,a0 ; Start des Systemcodes rechnen
+ move.l a0,S_SysStart.w ; sichern
+ move.l a0,$4.w ; =Programmstart
+
+ move.l a1,d0 ; Systemcode umkopieren
+ lsr.l #2,d0 ; =Zahl Langworttransfers
+ subq.w #1,d0 ; wg. DBRA
+S_SysCopy: move.l (a2)+,(a0)+
+ dbra d0,S_SysCopy
+
+ sub.l a2,a0 ; Verschiebedifferenz rechnen
+ move.l a0,d1
+
+ lea 8.w,a1 ; alle Vektoren relozieren
+ moveq #45,d0
+S_RelVec: add.l d1,(a1)+
+ dbra d0,S_RelVec
+
+ move.l S_SysStart.w,a1 ; obere Speichergrenze in USP...
+ move a1,usp
+ move.l a1,S_FreeMemEnd.w ; und Variable
+
+ move.l #-1,S_LibStart.w; Librarykette leer
+
+ lea S_floatlib.w,a0 ; passende FloatLib installieren
+ btst #0,S_Latch+1.w ; 68881 vorhanden ?
+ bne.s S_NoCo81
+ lea S_float81lib.w,a0 ; ja-->andere Library
+S_NoCo81: moveq #LibCtrlInstall,d0 ; einschreiben
+ trap #TrapLibCtrl
+
+ moveq #LibCtrlGetAdr,d0 ; Adresse holen
+ lea S_LibName.w,a0
+ trap #TrapLibCtrl
+ move.l d0,S_LibAdr.w
+
+ move.l 4*4.w,a4 ; Exceptionvektoren 4 und 11 retten
+ move.l 11*4.w,a5
+ move.l sp,a6 ; SP retten
+ move.l #S_NoCPU,4*4.w ; neue Exceptionhandler einschreiben
+ move.l #S_NoMMU,11*4.w
+ moveq #is68008,d1 ; Prozessorcode loeschen
+
+ cpu 68030 ; fuer zus. Befehle
+
+ ori #1,ccr ; 68008 ausfiltern
+ moveq #is68000,d1
+
+ movec vbr,d0 ; geht erst ab 68010
+ moveq #is68010,d1
+
+ extb d0 ; geht erst ab 68020
+ moveq #is68020,d1
+
+ cpu 68000 ; nicht mehr gebraucht
+ fpu on ; dafuer dies
+
+S_NoCPU: btst #0,S_Latch+1.w ; FPU vorhanden ?
+ bne.s S_NoFPU ; nein-->
+ or.w #has68881,d1 ; ja : 68881 annehmen
+ fnop ; FPU idle machen, damit im folgenden
+ fsave -(sp) ; ein idle frame gespeichert wird
+ cmp.b #$18,1(sp) ; Framelaenge=$18 fuer 68881, $38 fuer 882
+ beq.s S_NoFPU
+ add.w #(has68882-has68881),d1 ; 68882 eintragen
+
+ fpu off ; FPU nicht mehr gebraucht
+ pmmu on ; dafuer die MMU
+
+S_NoFPU: move.l a4,4*4.w ; Exception 4 zuruecksetzen
+ pflusha ; dies versteht auch die 68030-MMU
+ add.w #hasMMU,d1 ; gefunden: Flag dazu
+ move.l #S_SmallMMU,11*4.w ; testen ob Schmalspur-MMU
+ psave -(sp)
+ bra.s S_NoMMU ; Ergebnis 68020/68851
+
+S_SmallMMU: move.b #is68030,d1 ; 68030 eintragen (nicht MOVEQ!!)
+ add.w #(intMMU-hasMMU),d1 ; Code interne MMU
+
+S_NoMMU: move.l a5,11*4.w ; Line-F-Vektor zuruecksetzen
+ move.l a6,sp ; SP restaurieren
+ move.w d1,S_CPUNo.w ; Ergebnis einschreiben
+
+ trap #TrapProgEnd
+
+S_LibName: dc.b "FLOAT",0
+
+;----------------------------------------------------------------------------
+; Gleitkommalibrary, ohne 68881:
+
+ supmode off
+
+ include float.i68
+
+;----------------------------------------------------------------------------
+; Gleitkommalibrary, mit 68881:
+
+ supmode off
+
+ include float81.i68
+
+;----------------------------------------------------------------------------
+; Die Startsequenz:
+
+ supmode on
+
+S_Start: clr.w S_Latch.w ; Ports loeschen
+ clr.l _fadd_cnt.w ; Zielvariablen loeschen
+ clr.l _fmul_cnt.w
+ clr.l _fdiv_cnt.w
+ clr.l _fsqrt_cnt.w
+
+ move.l S_MemEnd.w,d0 ; SSP an Speicherende legen
+ move.l d0,$0.w ; Neben Resetvekor vermerken
+ move.l d0,a7 ; SSP setzen
+ move.l S_FreeMemEnd.w,a0 ; USP liegt am Speicherende
+ move a0,usp
+
+ andi #$dfff,sr ; In Usermodus schalten
+ jmp Start.w ; zum Programmstart
+
+;----------------------------------------------------------------------------
+; Die Ausnahmebehandlungsprozeduren:
+
+ex_vec2:
+ move.w #2,S_ExVec.w
+ bra.l ex_handle
+ex_vec3:
+ move.w #3,S_ExVec.w
+ bra.l ex_handle
+ex_vec4:
+ move.w #4,S_ExVec.w
+ bra.l ex_handle
+ex_vec5:
+ move.w #5,S_ExVec.w
+ bra.l ex_handle
+ex_vec6:
+ move.w #6,S_ExVec.w
+ bra.l ex_handle
+ex_vec7:
+ move.w #7,S_ExVec.w
+ bra.l ex_handle
+ex_vec8:
+ move.w #8,S_ExVec.w
+ bra.l ex_handle
+ex_vec10:
+ move.w #10,S_ExVec.w
+ bra.l ex_handle
+ex_vec11:
+ move.w #0,S_Control+S_Response.w ; FPU resetten
+ move.w #11,S_ExVec.w
+ bra.l ex_handle
+ex_vec12:
+ move.w #12,S_ExVec.w
+ bra.l ex_handle
+ex_vec13:
+ move.w #13,S_ExVec.w
+ bra.l ex_handle
+ex_vec14:
+ move.w #14,S_ExVec.w
+ bra.l ex_handle
+ex_vec15:
+ move.w #15,S_ExVec.w
+ bra.l ex_handle
+ex_vec16:
+ move.w #16,S_ExVec.w
+ bra.l ex_handle
+ex_vec17:
+ move.w #17,S_ExVec.w
+ bra.l ex_handle
+ex_vec18:
+ move.w #18,S_ExVec.w
+ bra.l ex_handle
+ex_vec19:
+ move.w #19,S_ExVec.w
+ bra.l ex_handle
+ex_vec20:
+ move.w #20,S_ExVec.w
+ bra.l ex_handle
+ex_vec21:
+ move.w #21,S_ExVec.w
+ bra.l ex_handle
+ex_vec22:
+ move.w #22,S_ExVec.w
+ bra.l ex_handle
+ex_vec23:
+ move.w #23,S_ExVec.w
+ bra.l ex_handle
+ex_vec24:
+ move.w #24,S_ExVec.w
+ bra.l ex_handle
+ex_vec25:
+ move.w #25,S_ExVec.w
+ bra.l ex_handle
+ex_vec26:
+ move.w #26,S_ExVec.w
+ bra.l ex_handle
+ex_vec27:
+ move.w #27,S_ExVec.w
+ bra.l ex_handle
+ex_vec28:
+ move.w #28,S_ExVec.w
+ bra.l ex_handle
+ex_vec29:
+ move.w #29,S_ExVec.w
+ bra.l ex_handle
+ex_vec30:
+ move.w #30,S_ExVec.w
+ bra.l ex_handle
+ex_vec31:
+ move.w #31,S_ExVec.w
+ bra.l ex_handle
+ex_vec33:
+ move.w #33,S_ExVec.w
+ bra.l ex_handle
+ex_vec34:
+ move.w #34,S_ExVec.w
+ bra.l ex_handle
+ex_vec35:
+ move.w #35,S_ExVec.w
+ bra.l ex_handle
+ex_vec36:
+ move.w #36,S_ExVec.w
+ bra.l ex_handle
+ex_vec37:
+ move.w #37,S_ExVec.w
+ bra.l ex_handle
+ex_vec38:
+ move.w #38,S_ExVec.w
+ bra.l ex_handle
+ex_vec39:
+ move.w #39,S_ExVec.w
+ bra.l ex_handle
+ex_vec40:
+ move.w #40,S_ExVec.w
+ bra.l ex_handle
+ex_vec41:
+ move.w #41,S_ExVec.w
+ bra.l ex_handle
+ex_vec42:
+ move.w #42,S_ExVec.w
+ bra.l ex_handle
+ex_vec43:
+ move.w #43,S_ExVec.w
+ bra.l ex_handle
+ex_vec44:
+ move.w #44,S_ExVec.w
+ bra.l ex_handle
+ex_vec48:
+ move.w #48,S_ExVec.w
+ bra.l ex_handle
+ex_vec49:
+ move.w #49,S_ExVec.w
+ bra.l ex_handle
+ex_vec50:
+ move.w #50,S_ExVec.w
+ bra.l ex_handle
+ex_vec51:
+ move.w #51,S_ExVec.w
+ bra.l ex_handle
+ex_vec52:
+ move.w #52,S_ExVec.w
+ bra.l ex_handle
+ex_vec53:
+ move.w #53,S_ExVec.w
+ bra.l ex_handle
+ex_vec54:
+ move.w #54,S_ExVec.w
+ bra.l ex_handle
+ex_vec55:
+ move.w #55,S_ExVec.w
+ bra.l ex_handle
+ex_vec56:
+ move.w #56,S_ExVec.w
+ bra.l ex_handle
+ex_vec57:
+ move.w #57,S_ExVec.w
+ bra.l ex_handle
+ex_vec58:
+ move.w #58,S_ExVec.w
+
+ex_handle:
+ movem.l d0-d7/a0-a7,S_RegSave.w ; Wert der Register abspeichern
+ move usp,a0
+ move.l a0,S_RegSave+64.w
+ lea S_Latch.w,a0
+ move.w S_ExVec.w,d0 ; Vektornr. holen
+ move.b d0,1(a0) ; Fehlernr. ausgeben
+ex_infinite:
+ move.b d0,d1 ; Die LED n-mal blinken lassen ; Die LED n-mal blinken lassen
+ex_blink:
+ bset #0,(a0) ; LED an
+ bsr.s ex_wait
+ bclr #0,(a0) ; LED aus
+ bsr.s ex_wait
+ subq.b #1,d1
+ bne.s ex_blink
+ move.b #$05,d1 ; eine Pause einlegen
+ex_pause:
+ bsr.s ex_wait
+ subq.b #1,d1
+ bne.s ex_pause
+ bra.s ex_handle ; und alles von vorne
+
+ex_wait:
+ move.l d0,-(a7) ; Register retten
+ move.l #$50000,d0 ; ungefaehr 1/2 Sekunde
+ex_wloop: ; Register herunterzaehlen
+ subq.l #1,d0
+ bne.s ex_wloop
+ move.l (a7)+,d0 ; D0 wieder zurueck
+ rts
+
+;----------------------------------------------------------------------------
+; Einzelschrittverfolgung:
+
+StepProc:
+ clr.b S_Latch+1.w
+ movem.l d0-d7/a0-a7,S_RegSave.w ; Register retten
+ move usp,a0
+ move.l a0,S_RegSave+64.w
+ move.l $4.w,S_ResVecSave.w ; Resetvektor sichern
+ lea S_Restart(pc),a0 ; am Punkt S_StepBack wacht
+ move.l a0,$4.w ; der PcPar wieder auf
+ move.b #9,S_Latch+1.w ; ParMon-Aufruf ausgeben
+ stop #$2000 ; hier geht es nur mit einem
+ ; Reset weiter
+
+;----------------------------------------------------------------------------
+; Routinen zur Kommunikation mit dem PC (Trap 0)
+
+PcSysCall:
+ clr.b S_Latch+1.w
+ movem.l d0-d7/a0-a7,S_RegSave.w ; Register retten
+ move usp,a0
+ move.l a0,S_RegSave+64.w
+ move.l $4.w,S_ResVecSave.w ; Resetvektor sichern
+ lea S_Restart(pc),a0 ; am Punkt S_Restart wacht
+ move.l a0,$4.w ; der PcPar wieder auf
+ move.b #$40,S_Latch+1.w ; PC-Aufruf ausgeben
+ stop #$2000 ; hier geht es nur mit einem
+
+S_Restart:
+ clr.b S_Latch+1.w ; Systemanfrage loeschen
+ move.l S_ResVecSave.w,$4.w ; Resetvektor zurueck
+ move.l S_RegSave+64.w,a0
+ move a0,usp
+ movem.l S_RegSave.w,d0-d7/a0-a7 ; Register zurueckholen
+ rte ; das war's
+
+;----------------------------------------------------------------------------
+; Libraryverwaltung : Trap #13
+;
+; Struktur einer Library :
+;
+; Adresse 0: Laenge in Bytes (1 <= Laenge <= 256k)
+; Adresse 4: Dummyzeiger =-1 (vom System verwendet) \
+; Adresse 8: Libraryname als ASCIIZ-String | kopierter Block
+; Adresse n: Sprungtabelle |
+; Adresse m: Librarycode, private Daten /
+;
+; der gesamte Librarycode muss lageunabhaengig geschrieben sein !
+;
+; definierte Unterfunktionen:
+;
+; D0.L=0 : Library installieren
+; D0.L=1 : Libraryzeiger holen
+;
+;----------------------------------------------------------------------------
+
+; Subfunktion 0: Library von Adresse 0 installieren:
+; Eingabe: A0=Startadresse der Library
+; Ausgabe: keine
+
+S_LibFun: movem.l d1-d2/a1-a2,-(a7) ; Register sichern
+ tst.l d0 ; ist es Funktion 0 ?
+ bne.s S_LibFun1 ; nein-->bei Funktion 1 weitertesten
+
+ move.l (a0),d0 ; Laenge Library holen
+ addq.l #3,d0 ; auf Doppelworte aufrunden
+ and.b #$fc,d0
+ moveq #1,d1
+ cmp.l #$40000,d0 ; Maximalgroesse ueberschritten ?
+ bge.l S_LibErr ; ja-->Ende mit Fehler Nr.1
+
+ move usp,a1 ; Userstack holen
+ move.l S_FreeMemEnd.w,d2 ; mom. belegte Stackmenge berechnen
+ sub.l a1,d2
+ move.l a1,a2 ; neue Untergrenze in A2 rechnen
+ sub.l d0,a2
+ moveq #2,d1
+ cmp.l #$800,a2 ; unter abs. Untergrenze gesunken ?
+ ble.l S_LibErr ; ja-->Ende mit Fehler Nr.2
+
+ move a2,usp ; neuen Userstack einschreiben
+ lsr.l #1,d2 ; Stackgroesse in Worten
+ bra.s S_LibStckEnd ; damit Ende, falls kein Stack belegt
+
+S_LibStckCpy: move.w (a1)+,(a2)+ ; Userstack umkopieren
+S_LibStckEnd: dbra d2,S_LibStckCpy
+
+ move.l S_FreeMemEnd.w,a1 ; Startadresse der Library rechnen
+ sub.l d0,a1 ; =altes Speicherende-Laenge
+ addq.l #4,a0 ; Quellzeiger weitersetzen
+ move.l S_LibStart.w,d1 ; bisheriges Ende der Kette holen
+ move.l d1,(a0) ; in neue Library eintragen
+ move.l a1,S_FreeMemEnd.w ; Speichergrenze heruntersetzen
+ move.l a1,S_LibStart.w ; neuen Kettenanfang eintragen
+
+ lsr.l #2,d0 ; Laenge in Doppelworte umrechnen
+ subq.w #1,d0 ; wg. DBRA
+
+S_LibInstLoop: move.l (a0)+,(a1)+ ; Library umkopieren
+ dbra d0,S_LibInstLoop
+
+ bra.l S_LibOK ; Ende ohne Fehler
+
+; Subfunktion 1: Library finden, deren Name ab (A0) als ASCIIZ steht:
+; Eingabe: A0=Startadresse des ASCIIZ-Strings
+; Ausgabe: D0=Startadresse der Sprungtabelle
+
+S_LibFun1: subq.l #1,d0 ; ist es Funktion 1 ?
+ bne.s S_LibFun2 ; nein-->bei Funktion 2 weitertesten
+
+ move.l S_LibStart.w,a2 ; Wurzelzeiger der Kette holen
+
+S_LibGetLoop: moveq #3,d1 ; Kettenende erreicht ?
+ move.l a2,d0
+ addq.l #1,d0 ; wird durch -1 angezeigt
+ beq.l S_LibErr ; ja-->Ende mit Fehler
+
+ move.l a0,d0 ; Startadresse Vergleichsstring retten
+ lea 4(a2),a1 ; A1 zeigt auf zu testenden Namen
+S_LibGetComp: cmpm.b (a0)+,(a1)+ ; ein Zeichen vergleichen
+ bne.s S_LibGetNext ; ungleich-->weiter in Kette
+ tst.b -1(a0) ; War das das Ende ?
+ beq.s S_LibGetFnd ; ja-->Heureka!
+ bra.s S_LibGetComp ; ansonsten naechstes Zeichen vergleichen
+
+S_LibGetNext: move.l (a2),a2 ; weiter auf Nachfolger in Kette
+ move.l d0,a0 ; A0 auf Referenzstringanfang
+ bra.s S_LibGetLoop
+
+S_LibGetFnd: move.l a1,d0 ; Libraryadresse gerade machen
+ addq.l #1,d0
+ bclr #0,d0
+
+ bra.l S_LibOK ; Ende ohne Fehler
+
+S_LibFun2: moveq #127,d1 ; unbekannte Funktion:
+ bra.l S_LibErr
+
+S_LibErr: move.l d1,d0 ; Fehlercode in D0 holen
+ movem.l (a7)+,d1-d2/a1-a2 ; Register zurueck
+ or.b #1,1(a7) ; Carry setzen
+ rte
+
+S_LibOK: movem.l (a7)+,d1-d2/a1-a2 ; Register zurueck
+ and.b #$fe,1(a7) ; Carry loeschen
+ rte
+
+;----------------------------------------------------------------------------
+; Tracemode ein/aus:
+
+S_StepTgl:
+ andi #$7fff,sr ; bitte hier kein Trace!
+ bclr #7,(a7) ; altes T-Flag loeschen
+ btst #0,1(a7)
+ bne.s S_StepOn ; C=1-->Tracemodus an
+ rte ; C=0-->fertig
+S_StepOn:
+ bset #7,(a7) ; T-Flag setzen
+ rte
+
+;----------------------------------------------------------------------------
+; Programmende (Trap 15)
+
+S_ProgEnd: lea S_Start(pc),a0 ; Startvektor zurueck
+ move.l a0,4.w
+ move.b #$ff,S_Latch+1.w ; "Ich bin fertig"
+ stop #$2000 ; und Ende
+
+;----------------------------------------------------------------------------
+; Line-F-Exception
+
+S_Response equ $fffffe00 ; In a6 (Coprozessor-Register)
+S_Control equ $02 ; Alle weiteren Register relativ
+S_Save equ $04 ; zu "Response"
+S_Restore equ $06
+S_Command equ $0a ; in a5
+S_Condition equ $0e
+S_Operand equ $10 ; in a4
+S_Reg_Selec equ $14
+S_Ins_Add equ $18
+
+ supmode on
+
+S_LineF: btst #0,S_Latch+1.w ; Ist ein Koprozessor vorhanden ?
+ bne ex_vec11 ; nein-->normaler Line-F
+
+ movem.l d0-d7/a0-a6,S_RegSave.w ; Register retten
+ move.l usp,a0 ; USP retten
+ move.l a0,S_RegSave+60.w ; (geht nur ueber Umweg)
+ lea S_Response.w,a6 ; #response nach A6
+ lea S_Command(a6),a5 ; #command nach A5
+ lea S_Operand(a6),a6 ; #operand nach A4
+ lea S_RegSave.w,a3 ; #dregs nach A3
+ move.l 2(a7),a0 ; PC nach A0
+ move.w (a0),d1 ; Kommando nach D1
+S_again: ; Einsprung fuer weitere FPU-Befehle
+ and.w #%0000000111000000,d1 ; Spezialteil ausmaskieren
+ bne S_spezial ; Ein Bit gesetzt-->Spezialbefehl
+ move.w 2(a0),d1 ; zweiten Befehlsteil in D1 merken
+ move.w d1,(a5) ; Befehl in FPU schr. (A5==#command)
+S_do_ca: ; Einsprung fuer weitere Nachfragen an FPU
+ move.w (a6),d0 ; Response lesen
+ btst #12,d0 ; Erstes Modusbit testen
+ bne S_rw_1x ; ==1 --> springen
+ btst #11,d0 ; Zweites Modusbit testen
+ beq.s S_rw_00 ; ==0 --> springen
+; ----- %xxx01, Null-Primitive/Transfer Single CPU Register
+ btst #10,d0 ; Register uebertragen ?
+ bne.s S_rw_sngl ; Ja--> Transfer Single CPU-Register
+ btst #15,d0 ; CA (Come Again) gesetzt ?
+ bne.s S_do_ca ; Ja--> weiter fragen, sonst fertig
+ addq.l #4,a0 ; A0 um reine Befehlslaenge weiter
+ ; ( alles andere wurde in calc_add erledigt )
+ move.w (a0),d1 ; erstes Befehlswort holen
+ move.w d1,d0 ; und nach D0
+ and.w #$f000,d0 ; Wieder COP-Befehl ?
+ eor.w #$f000,d0
+ beq.s S_again ; Ja-->direkt weitermachen
+ move.l a0,2(a7) ; Neuen PC eintragen
+ move.l S_RegSave+60.w,a0 ; USP wiederherstellen
+ move.l a0,usp ; (geht nur ueber Umweg)
+ movem.l (a3),d0-a6 ; Register wiederherstellen
+ rte ; Trap beenden
+S_rw_sngl:
+ and.w #%1110000,d1 ; Registernummer ausmaskieren ( nur Dn )
+ lsr.w #2,d1 ; D1=Nummer*4
+ move.l 0(a3,d1.w),(a4) ; Register uebertragen (a4==#operand, a3==#dregs)
+ bra.s S_do_ca ; danach kommt immer noch etwas
+;-----%xxx00, Transfer multiple coprocessor Reg.
+S_rw_00:
+ bsr S_calc_add ; Operandenadresse nach A1 holen
+ move.w S_Reg_Selec(a6),d4 ; Registerliste nach D4 holen
+ btst #13,d0 ; Dr-Bit testen
+ beq.s S_w_00 ; ==0--> Daten in FPU schreiben
+ btst #12,d0 ; Predekrementmodus ?
+ beq.s S_r_pred ; ==0--> Ja,springen
+ moveq #7,d0 ; Schleifenzaehler fuer 8 Bits
+S_11:
+ lsl.w #1,d4 ; Ein Bit ins Carry
+ bcc.s S_21 ; nur bei Bit==1 etwas machen
+ move.l (a4),(a1)+ ; 1 (A4==#operand)
+ move.l (a4),(a1)+ ; 2
+ move.l (a4),(a1)+ ; 3 Langworte fuer jedes Register
+S_21:
+ dbra d0,S_11 ; Fuer alle 8 Bits
+ bra.s S_do_ca ; Nochmal FPU befragen
+S_r_Pred:
+ moveq #7,d0 ; Schleifenzaehler fuer 8 Bits
+S_12:
+ lsl.w #1,d4 ; Ein Bit ins Carry
+ bcc.s S_22 ; nur bei Bit=1 etwas machen
+ move.l (a4),(a1)+ ; 1 (A4==#operand)
+ move.l (a4),(a1)+ ; 2
+ move.l (a4),(a1)+ ; 3 Langworte fuer jedes Register
+ suba.w #24,a1 ; Dekrement durchfuehren
+S_22:
+ dbra d0,S_12 ; Fuer alle 8 Bits
+ adda.w #12,a1 ; A1 wieder auf letztes Register
+ move.l a1,(a2) ; A1 als Registerinhalt abspeichern
+ bra S_do_ca ; Nochmal FPU befragen
+S_w_00:
+ move.w (a0),d0 ; erstes Befehlswort holen
+ and.b #%111000,d0 ; Adressierungsart maskieren
+ cmp.b #%011000,d0 ; Gleich (An)+ ?
+ beq.s S_w_Post ; Ja-->Postinkrementiermodus
+ moveq #7,d0 ; Schleifenzaehler fuer 8 Bits
+S_13:
+ lsl.w #1,d4 ; Ein Bit ins Carry
+ bcc.s S_23 ; Nur bei Bit==1 etwas machen
+ move.l (a1)+,(a4) ; 1 (A4==#operand)
+ move.l (a1)+,(a4) ; 2
+ move.l (a1)+,(a4) ; 3 Langworte fuer jedes Register
+S_23:
+ dbra d0,S_13 ; Fuer alle 8 Bits
+ bra S_do_ca ; Nochmal FPU befragen
+S_w_Post:
+ suba.w #12,a1 ; Inkrement von calc_add aufheben
+ moveq #7,d0 ; Schleifenzaehler fuer 8 Bits
+S_14:
+ lsl.w #1,d4 ; Ein Bit ins Carry
+ bcc.s S_24 ; nur bei Bit==1 etwas machen
+ move.l (a1)+,(a4) ; 1 (A4==#operand)
+ move.l (a1)+,(a4) ; 2
+ move.l (a1)+,(a4) ; 3 Langworte fuer jedes Register
+S_24:
+ dbra d0,S_14 ; Fuer alle 8 Bits
+ move.l a1,(a2) ; A1 als Registerinhalt abspeichern
+ bra S_do_ca ; Nochmal FPU befragen
+
+S_rw_1x:
+ btst #11,d0 ; zweites Modusbit testen
+ bne.s S_rw_11 ; ==1 --> springen (Trap,Error)
+ btst #13,d0 ; DR-Bit testen
+ beq.s S_w_10 ; ==0 --> Daten an FPU schreiben
+;----- %xx110, evaluate effective adress and transfer data
+ bsr S_calc_add ; Operandenadresse berechnen
+ ; A1=Operandenadresse, d1.l=Operandenl„nge
+ cmp.w #2,d1 ; Laenge-2
+ ble.s S_r_bw ; <=2 --> Wort-oder-Byteoperand
+S_r_11:
+ move.l (a4),(a1)+ ; ein Langwort lesen (A4==#operand)
+ subq.l #4,d1 ; und runterzaehlen
+ bgt.s S_r_11 ; >0 --> weiter uebertragen
+ bra S_do_ca ; Nochmal FPU befragen
+S_r_bw:
+ btst #0,d1 ; Byte ?
+ bne.s S_r_byte ; Ja!
+ move.w (a4),(a1) ; Wort-Operand lesen (A4==#operand)
+ bra S_do_ca ; Nochmal FPU befragen
+S_r_byte:
+ move.b (a4),(a1) ; Byte-Operand lesen (A4==#operand)
+ bra.l S_do_ca ; Nochmal FPU befragen
+
+;----- %xx101, evaluate effective adress and transfer data
+S_w_10:
+ bsr S_calc_add ; Operandenadresse berechnen
+ ; A1=Operandenadresse, d1.l=Operandenl„nge
+ cmp.w #2,d1 ; Laenge-2
+ ble.s S_w_bw ; <=2 --> Wort-oder-Byteoperand
+S_w_11:
+ move.l (a1)+,(a4) ; ein Langwort lesen (A4==#operand)
+ subq.l #4,d1 ; und runterzaehlen
+ bgt.s S_w_11 ; >0 --> weiter uebertragen
+ bra S_do_ca ; Nochmal FPU befragen
+S_w_bw:
+ btst #0,d1 ; Byte ?
+ bne.s S_w_byte ; Ja!
+ move.w (a1),(a4) ; Wort-Operand lesen (A4==#operand)
+ bra S_do_ca ; Nochmal FPU befragen
+S_w_byte:
+ move.b (a1),(a4) ; Byte-Operand lesen (A4==#operand)
+ bra.l S_do_ca ; Nochmal FPU befragen
+
+;----- %xxx11, take pre-instruction exception
+S_rw_11:
+ bra ex_vec11 ; Error-Handler anspringen
+; ( hier koennte man eine genauere Fehleranalyse machen )
+
+S_spezial: ; Sprungbefehle etc.
+ cmp.w #%001000000,d1 ; FScc,FDBcc oder FTRAPcc
+ beq.s S_s_trap
+ cmp.w #%010000000,d1 ; Branch mit 16-Bit-Offset
+ beq.l S_s_br16
+ cmp.w #%011000000,d1 ; Branch mit 32-Bit-Offset
+ beq.l S_s_br32
+ bra ex_vec11 ; FSAVE/FRESTORE nicht unterstuetzt
+S_s_trap:
+ move.w (a0),d0 ; Erstes Befehlswort nach D0
+ move.w d0,d1 ; und nach D1 retten
+ and.w #%111000,d0 ; Wichtige Bits ausmaskieren
+ cmp.w #%001000,d0 ; FDBcc ?
+ beq.s S_s_fdbcc ; Ja-->springen
+ cmp.w #%111000,d0 ; FTRAP ?
+ beq ex_vec11 ; Ja-->Fehler (nicht unterstuetzt)
+ ; sonst FScc
+ move.w 2(a0),S_condition(a6) ; Bedingung an FPU schicken
+ moveq #1,d0 ; Operandenlaenge=1 (fuer calc_add)
+ bsr S_calc_add ; Operandenadresse berechnen
+S_15:
+ move.w (a6),d0 ; Response lesen
+ btst #8,d0 ; IA-Bit testen
+ beq.s S_25 ; ==0 --> fertig
+ and.w #%1100000000000,d0 ; Bits 11 und 12 ausmaskieren
+ eor.w #%1100000000000,d0 ; Beide gesetzt ?
+ bne.s S_15 ; Nicht beide==1 --> warten
+ bra ex_vec11 ; Sonst ist Exception aufgetreten
+S_25:
+ btst #0,d0 ; Antwortbit testen
+ sne (a1) ; Je nach Bit setzen/loeschen
+ bra S_do_ca ; Nochmal FPU befragen
+S_s_fdbcc:
+ move.w 2(a0),S_condition(a6) ; Bedingung an FPU schicken
+ and.w #%111,d1 ; Registernummer maskieren (D1=(A0))
+ lsl.w #2,d1 ; D1=Nummer*4
+ lea 0(a3,d1.w),a1 ; A1 enthaelt Adresse des Datenreg.
+ move.l (a1),d1 ; Dn holen
+ subq.w #1,d1 ; Dn=Dn-1
+ move.l d1,(a1) ; Dn zurueckschreiben
+ move.l a0,a2 ; alten PC nach A2 holen
+ addq.l #2,a0 ; PC 2 weiter ( fuer "nicht springen")
+S_16:
+ move.w (a6),d0 ; Response lesen
+ btst #8,d0 ; IA-Bit testen
+ beq.s S_26 ; ==0 --> fertig
+ and.w #%1100000000000,d0 ; Bits 11 und 12 ausmaskieren
+ eor.w #%1100000000000,d0 ; Beide gesetzt ?
+ bne.s S_16 ; Nicht beide==1 --> warten
+ bra ex_vec11 ; Sonst ist Exception aufgetreten
+S_26:
+ btst #0,d0 ; Antwortbit testen
+ bne S_do_ca ; True-->das war's schon
+ adda.w 2(a2),a2 ; 16-Bit-Sprungdist. add. (A2=PC)
+ addq.w #1,d1 ; Dn=-1 ?
+ beq S_do_ca ; Ja-->kein Sprung (Schleifenende)
+ move.l a2,a0 ; Sonst "Sprung" (neuen PC laden)
+ bra S_do_ca ; nochmal FPU befragen
+S_s_br16:
+ move.w (a0),S_Condition(a6) ; Bedingung an FPU schicken
+S_17:
+ move.w (a6),d0 ; Response lesen
+ btst #8,d0 ; IA-Bit testen
+ beq.s S_27 ; ==0 --> fertig
+ and.w #%1100000000000,d0 ; Bits 11 und 12 ausmaskieren
+ eor.w #%1100000000000,d0 ; Beide gesetzt ?
+ bne.s S_17 ; Nicht beide==1 --> warten
+ bra ex_vec11 ; Sonst ist Exception aufgetreten
+S_27:
+ btst #0,d0 ; Antwortbit testen
+ beq S_do_ca ; False--> das war's schon
+ adda.w 2(a0),a0 ; 16-Bit-Sprungdistanz addieren
+ subq.l #2,a0 ; Ein Wort zurueck ( weil spaeter
+ ; noch 4 addiert wird und und nur 2 addiert werden muesste )
+ bra S_do_ca ; Nochmal FPU befragen
+S_s_br32:
+ move.w (a0),S_Condition(a6) ; Bedingung an FPU schicken
+S_18:
+ move.w (a6),d0 ; Response lesen
+ btst #8,d0 ; IA-Bit testen
+ beq.s S_28 ; ==0 --> fertig
+ and.w #%1100000000000,d0 ; Bits 11 und 12 ausmaskieren
+ eor.w #%1100000000000,d0 ; Beide gesetzt ?
+ bne.s S_18 ; Nicht beide==1 --> warten
+ bra ex_vec11 ; Sonst ist Exception aufgetreten
+S_28:
+ addq.l #2,a0 ; Befehl ist 3 Worte lang
+ ; (jetzt : (A0)=Distanz)
+ btst #0,d0 ; Antwortbit testen
+ beq S_do_ca ; False--> das war's schon
+ adda.l (a0),a0 ; 32-Bit-Sprungdistanz addieren
+ subq.l #4,a0 ; Zwei Worte zurueck ( weil spaeter
+ ; noch 4 addiert wird, 2 wurden schon addiert )
+ bra S_do_ca ; Nochmal FPU befragen
+S_calc_add:
+ ; Operandenadresse berechnen. A0 muss die Adresse des Line-F-
+ ; Befehls enthalten, D0 im unteren Byte die Operandenlaenge.
+ ; die zu berechnende Adresse wird in A1 abgelegt. A0 wird
+ ; um die Laenge der zusaetzlichen Daten erhaelt.
+ ; Zusaetzlich wird in D1 die Laenge des Operanden zurueckge-
+ ; geben (in Bytes, als Langwort). D2,D3,A3 werden zerstoert.
+ ; Bei den Adressierungsarten -(An),(An)+ steht in A2 ein
+ ; Zeiger auf die Stelle, in der der Inhalt des Adressregisters
+ ; gisters An steht (wird fuer FMOVEM gebraucht).
+
+ clr.l d1 ; Laenge als Langwort loeschen
+ move.b d0,d1 ; und Byte umkopieren
+ move.w (a0),d2 ; erstes Befehlswort nach D2
+ move.w d2,d3 ; und D3 retten
+ and.w #%111000,d3 ; Adressierungsart ausmaskieren
+ lsr.w #1,d3 ; D3=Adressierungsart*4 (Langworte)
+ lea S_cs_tab(pc),a1 ; Sprungtabellenadresse nach A1
+ move.l 0(a1,d3.w),a1 ; Adresse der Routine nach A1
+ jmp (a1) ; und Routine anspringen
+S_c_drd: ; %000 Data Register Direct: Dn
+S_c_ard: ; %001 Address Register Direct: An
+ lea (a3),a1 ; A1 auf Registerfeld
+ and.w #%1111,d2 ; Registernummer ausmaskieren
+; ( und ein Bit vom Modus, 0 fuer Daten-,1 fuer Adressregister )
+ lsl.w #2,d2 ; D2="Registernummer"*4 (+Modusbit)
+ addq.w #4,d2 ; +4 (fuer Operandenlaenge)
+ sub.w d1,d2 ; Wahre Laenge abziehen
+ adda.w d2,a1 ; Offset auf Registerfeldanfang add.
+ rts
+S_c_ari: ; %010 Address Register indirect: (An)
+ and.w #%111,d2 ; Registernummer ausmaskieren
+ lsl.w #2,d2 ; D2=Registernummer*4
+ move.l 32(a3,d2.w),a1 ; Adresse nach A1
+ rts
+S_c_arpo: ; %011 Adressregister indirect with Postincrement: (An)+
+ and.w #%111,d2 ; Registernummer ausmaskieren
+ lsl.w #2,d2 ; D2=Registernummer*4
+ lea 32(a3,d2.w),a2 ; Adresse Adressregister nach A2
+ move.l (a2),a1 ; Adresse (Inhalt A.-Reg.) nach A1
+ btst #0,d1 ; D1 ungerade ? (Byteoperand)
+ bne.s S_29 ; Ja-->Spezialbehandlung
+S_19:
+ add.l d1,(a2) ; Inkrement durchfuehren
+ rts
+S_29:
+ cmp.w #4*7,d2 ; Ist A7 gemeint ?
+ bne.s S_19 ; nein-->normal vorgehen
+ addq.l #2,(a2) ; Sonst (bei Byte) 2 addieren,
+ rts ; damit Stack gerade bleibt!
+S_c_arpr: ; %100 Adressregister Indirect with Predekrement: -(An)
+ and.w #%111,d2 ; Registernummer ausmaskieren
+ lsl.w #2,d2 ; D2=Registernummer*4
+ lea 32(a3,d2.w),a2 ; Adresse des Adressreg. nach A2
+ btst #0,d1 ; D1 ungerade? (Byteoperand)
+ bne.s S_210 ; Ja-->Spezialbehandlung
+S_110:
+ sub.l d1,(a2) ; Dekrement durchfuehren
+ move.l (a2),a1 ; Adresse (Inhalt des A.-Reg) nach A1
+ rts
+S_210:
+ cmp.w #4*7,d2 ; Ist A7 gemeint?
+ bne.s S_110 ; nein-->normal vorgehen
+ subq.l #2,(a2) ; Sonst (bei Byte) 2 addieren,
+ ; damit Stack gerade bleibt !
+ move.l (a2),a1 ; Adresse (Inhalt des A.-Reg) nach A1
+ rts
+S_c_ar16: ; %101 Addressregister Indirect with Displacement: d16(An)
+ and.w #%111,d2 ; Registernummer ausmaskieren
+ lsl.w #2,d2 ; D2=Registernummer*4
+ move.l 32(a3,d2.w),a1 ; Adresse nach A1
+ move.w 4(a0),d2 ; 3.Befehlswort nach D2 (Offset)
+ adda.w d2,a1 ; Offset auf Adresse addieren
+ addq.l #2,a0 ; A0 ein Wort (d16) weiter
+ rts
+S_c_ar08: ; %110 Addressregister Indirect with Index : d8(An,Xn)
+ and.w #%111,d2 ; Registernummer ausmaskieren
+ lsl.w #2,d2 ; D2=Registernummer*4
+ move.l 32(a3,d2.w),a1 ; Adresse nach A1
+ move.w 4(a0),d2 ; 3.Befehlswort nach D2 (Byte-Offset)
+ move.w d2,d3 ; und nach D3
+ and.w #$ff,d3 ; Byte ausmaskieren (Byte-Offset)
+ adda.w d3,a1 ; Offset auf Adresse addieren
+ btst #11,d2 ; 1=long; 0=word
+ bne.s S_c_ar81
+ and.w #%1111000000000000,d2 ; Nummer von Dn und Modusbit
+ lsr.w #5,d2 ; maskieren
+ lsr.w #5,d2 ; D2=Registernummer*4 (und modusbit)
+ adda.w 2(a3,d2.w),a1 ; 16-Bit-Index auf A1 addieren
+ addq.l #2,a0 ; A0 ein Wort (Kram & d8) weiter
+ rts
+S_c_ar81:
+ and.w #%1111000000000000,d2 ; Nummer von Dn und Modusbit
+ lsr.w #5,d2 ; maskieren
+ lsr.w #5,d2 ; D2=Registernummer*4 (und modusbit)
+ adda.w 0(a3,d2.w),a1 ; 32-Bit-Index auf A1 addieren
+ addq.l #2,a0 ; A0 ein Wort (Kram & d8) weiter
+ rts
+S_c_pc: ; %111 absolut short/long, PC-relativ (ohne/mit Index) \ oder direkt
+ btst #2,d2 ; Immidiate ?
+ bne.s S_immi ; <>0 --> Ja!
+ btst #1,d2 ; PC-relativ ?
+ bne.s S_pc_rel ; <>0 --> Ja!
+ btst #0,d2 ; Long ?
+ bne.s S_c_long ; <>0 --> Ja!
+ ; sonst short
+ move.w 4(a0),d2 ; Wortadresse holen
+ ext.l d2 ; Auf Langwort erweitern
+ move.l d2,a1 ; und als Operandenadresse merken
+ addq.l #2,a0 ; A0 ein Wort (Short-A.) weiter
+ rts
+S_c_long:
+ move.l 4(a0),a1 ; Langwortadresse holen
+ addq.l #4,a0 ; A0 zwei Worte (Long-A.) weiter
+ rts
+S_immi:
+ move.l a0,a1 ; Befehlsadresse nach A1
+ add.l d1,a0 ; A0 ueber Operand hinwegsetzen
+ rts
+S_pc_rel:
+ btst #0,d2 ; mit Index ?
+ bne.s S_pc_idx ; <>0 --> Ja!
+ move.l a0,a1 ; PC nach A1
+ adda.w 4(a0),a1 ; Offset addieren
+ addq.l #4,a1 ; +4 fuer Laenge des FPU-Befehls
+ addq.l #2,a0 ; A0 zwei (16-Bit-Offset) weiter
+ rts
+S_pc_idx:
+ move.l a0,a1 ; PC nach A1
+ clr.w d2 ; Oberes Byte loeschen
+ move.b 5(a0),d2 ; Offset nach D2
+ adda.w d2,a1 ; und addieren
+ addq.l #4,a1 ; +4 fuer Laenge des FPU-Befehls
+ move.b 4(a0),d2 ; D2=Registernummer*16 und Modusbit
+ ; ( high-Byte ist noch 0 )
+ btst #3,d2 ; Long-Bit testen
+ bne.s S_pc_i_l ; <>0 -->Long-Index
+ and.b #%11110000,d2 ; Registerinformation ausblenden
+ lsr.w #2,d2 ; D2=Registernummer*4 (und Modusbit)
+ adda.w 2(a3,d2.w),a1 ; Word-Index addieren
+ addq.l #2,a0 ; A0 zwei (8-Bit-Offset & Kram) weiter
+ rts
+S_pc_i_l:
+ and.b #%11110000,d2 ; Restinformation ausblenden
+ lsr.w #2,d2 ; D2=Registernummer*4 (und Modusbit)
+ adda.l 0(a3,d2.w),a1 ; Long-Index addieren
+ addq.l #2,a0 ; A0 zwei (8-Bit-Offset & Kram) weiter
+ rts ; Ende von S_calc_add
+
+S_cs_tab:
+ dc.l S_c_drd,S_c_ard,S_c_ari,S_c_arpo ; Sprungtabelle fuer
+ dc.l S_c_arpr,S_c_ar16,S_c_ar08,S_c_pc ; Adressierungsarten
+S_End:
+
diff --git a/tests/t_parsys/t_parsys.doc b/tests/t_parsys/t_parsys.doc
new file mode 100644
index 0000000..10d31c7
--- /dev/null
+++ b/tests/t_parsys/t_parsys.doc
@@ -0,0 +1,8 @@
++---------------------- Test Application PARSYS ----------------------------+
+| |
+| Back to the roots! This is the "operating system" of my 68000-based par- |
+| allel computer I built several years ago and which was the main reason to |
+| write my own assembler because the original one from RDK was too buggy to |
+| work reliably with it. Contains also a lot of FPU orders. |
+| |
++----------------------------------------------------------------------------+
diff --git a/tests/t_parsys/t_parsys.inc b/tests/t_parsys/t_parsys.inc
new file mode 100644
index 0000000..7ffd805
--- /dev/null
+++ b/tests/t_parsys/t_parsys.inc
@@ -0,0 +1,10 @@
+(* tests/t_parsys/t_parsys.asm-Includefile für CONST-Sektion *)
+S_RegSave = $608;
+S_MemEnd = $400;
+S_ParNo = $408;
+S_CPUNo = $422;
+_fadd_cnt = $40E;
+_fmul_cnt = $412;
+_fdiv_cnt = $416;
+_fsqrt_cnt = $41A;
+(* Ende Includefile für CONST-Sektion *)
diff --git a/tests/t_parsys/t_parsys.ori b/tests/t_parsys/t_parsys.ori
new file mode 100644
index 0000000..d26be99
--- /dev/null
+++ b/tests/t_parsys/t_parsys.ori
Binary files differ
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-03 11:31:09 +0000