1;----------------------------------------------------------------------
2; Floating Point Library for 6502: Multiplication
3;----------------------------------------------------------------------
4; (C)2020 Michael Jørgensen, License: 2-clause BSD
5
6; This file contains the assembly routine for
7; floating point multiplication.
8
9; Rounding:
10; The FAC has a 5-byte mantissa, where the 5th byte (stored in facov)
11; contains rounding bits that are removed after the final calculation.
12
13; A4 = fachop
14; A3 = facho
15; A2 = facmoh
16; A1 = facmo
17; A0 = faclo
18; AV = facov
19
20; B3 = argho
21; B2 = argmoh
22; B1 = argmo
23; B0 = arglo
24
25; C3 = resho
26; C2 = resmoh
27; C1 = resmo
28; C0 = reslo
29; CV = resov
30
31; This routine calculates C3:C2:C1:C0:CV = A3:A2:A1:A0:AV * B3:B2:B1:B0:0
32; C3 = A3*B3
33; C2 = A2*B3 + A3*B2
34; C1 = A1*B3 + A2*B2 + A3*B1
35; C0 = A0*B3 + A1*B2 + A2*B1 + A3*B0
36; CV = AV*B3 + A0*B2 + A1*B1 + A2*B0
37
38
39;--------------------------------------------------------------
40; Entry point for fmult
41; On entry one value is stored in FAC and the other in memory pointed
42; to by (A,Y).
43; On exit the sum is stored in FAC.
44
45fmult    jsr conupk
46
47;--------------------------------------------------------------
48; Entry point for fmultt
49; On entry the two values are stored in FAC and ARG.
50; The variable arisgn contains the XOR of the two sign bits.
51; Additionally, the Z-flag is the value of the FAC exponent.
52; On exit the sum is stored in FAC.
53
54fmultt
55
56; 1. If either operand is zero, then finish immediately.
57
58         beq @multrt    ; Jump if FAC is zero.
59         lda argexp
60         beq @zeremv    ; Jump if ARG is zero.
61
62; 2. Calculate new exponent and test for overflow/underflow.
63
64         clc
65         adc facexp
66         bcc @tryoff
67         clc
68         bpl @adjust
69         ldx #errov     ; Overflow
70         jmp error
71
72@zeremv  stz facexp     ; Result is zero.
73         stz facsgn
74@multrt  rts
75
76@tryoff  bpl @zeremv    ; Jump if underflow.
77@adjust  adc #$80       ; Carry is always clear here.
78         beq @zeremv    ; Jump if underflow.
79         sta facexp
80
81                        ; Copy over sign of result.
82         lda arisgn
83         sta facsgn
84
85; 3. Calculate mantissa
86
87         stz reshop
88         stz resho
89         stz resmoh
90         stz resmo
91         stz reslo
92         stz resov
93         stz fachop
94
95; We simultaneously calculate the four terms:
96;    00:00:00:A3:A2 * B0
97;  + 00:00:A3:A2:A1 * B1
98;  + 00:A3:A2:A1:A0 * B2
99;  + A3:A2:A1:A0:AV * B3
100
101; First calculate 00:00:00:A3:A2 * B0
102@b0      lsr arglo      ; B0
103         bcc @b1
104         lda resov
105         clc
106         adc facmoh     ; A2
107         sta resov
108         lda reslo
109         adc facho      ; A3
110         sta reslo
111         lda resmo
112         adc fachop     ; A4
113         sta resmo
114         bcc @b1
115         inc resmoh
116         bne @b1
117         inc resho
118         bne @b1
119         inc reshop
120
121; Next calculate 00:00:A3:A2:A1 * B1
122@b1      lsr argmo      ; B1
123         bcc @b2
124         lda resov
125         clc
126         adc facmo      ; A1
127         sta resov
128         lda reslo
129         adc facmoh     ; A2
130         sta reslo
131         lda resmo
132         adc facho      ; A3
133         sta resmo
134         lda resmoh
135         adc fachop     ; A4
136         sta resmoh
137         bcc @b2
138         inc resho
139         bne @b2
140         inc reshop
141
142; Then calculate 00:A3:A2:A1:A0 * B2
143@b2      lsr argmoh     ; B2
144         bcc @b3
145         lda resov
146         clc
147         adc faclo      ; A0
148         sta resov
149         lda reslo
150         adc facmo      ; A1
151         sta reslo
152         lda resmo
153         adc facmoh     ; A2
154         sta resmo
155         lda resmoh
156         adc facho      ; A3
157         sta resmoh
158         lda resho
159         adc fachop     ; A4
160         sta resho
161         bcc @b3
162         inc reshop
163
164; Finally calculate A3:A2:A1:A0:AV * B3
165@b3      lsr argho      ; B3
166         bcc @rota
167         lda resov
168         clc
169         adc facov      ; AV
170         sta resov
171         lda reslo
172         adc faclo      ; A0
173         sta reslo
174         lda resmo
175         adc facmo      ; A1
176         sta resmo
177         lda resmoh
178         adc facmoh     ; A2
179         sta resmoh
180         lda resho
181         adc facho      ; A3
182         sta resho
183         lda reshop
184         adc fachop     ; A4
185         sta reshop
186
187; Shift left FAC
188@rota    asl facov
189         rol faclo
190         rol facmo
191         rol facmoh
192         rol facho
193         rol fachop
194         bmi @fin
195         jmp @b0
196
197@fin     lda reshop
198         sta facho
199         lda resho
200         sta facmoh
201         lda resmoh
202         sta facmo
203         lda resmo
204         sta faclo
205         lda reslo
206         sta facov
207
208         jmp fnormal    ; In basic/xadd.s
209
210
211; Multiply FAC by 10.
212
213mul10
214
215; 1. ARG = FAC
216         jsr movaf      ; ARG = FAC; Leaves exponent in A register.
217
218; 2. FAC *= 4
219         tax            ; Exponent
220         beq @mul101    ; Return if zero.
221         clc
222         adc #2
223         bcs @mul102    ; Jump if overflow
224         sta facexp     ; Store new exponent.
225
226; 3. FAC += ARG
227         stz arisgn
228         jsr faddt      ; The Z flag is clear here.
229
230; 4. FAC *= 2
231         inc facexp
232         beq @mul102    ; Jump if overflow
233@mul101  rts
234
235@mul102  ldx #errov     ; Overllow
236         jmp error
237
238