Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | - | 1 | Tue Jul 17 11:00:18 2018 Page 1 |
2 | |||
3 | |||
4 | |||
5 | |||
6 | |||
7 | |||
8 | |||
9 | 2500 A.D. 65816 Macro Assembler #26960 - Version 5.02g |
||
10 | ----------------------------------------------------- |
||
11 | |||
12 | Input Filename : src\F8\fpu.asm |
||
13 | Output Filename : obj\F8\fpu.obj |
||
14 | Listing Has Been Relocated |
||
15 | |||
16 | |||
17 | 2694 .LIST on |
||
18 | 2695 |
||
19 | 2696 ;;.INCLUDE inc\p0.inc |
||
20 | 2697 F8FFB1 .INCLUDE inc\dpfpu.inc |
||
21 | 2698 ;; |
||
22 | 2699 ;; Copyright (c) 2016 Marco Granati <mg@unet.bz> |
||
23 | 2700 ;; |
||
24 | 2701 ;; Permission to use, copy, modify, and distribute this software for any |
||
25 | 2702 ;; purpose with or without fee is hereby granted, provided that the above |
||
26 | 2703 ;; copyright notice and this permission notice appear in all copies. |
||
27 | 2704 ;; |
||
28 | 2705 ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES |
||
29 | 2706 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF |
||
30 | 2707 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR |
||
31 | 2708 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES |
||
32 | 2709 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN |
||
33 | 2710 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF |
||
34 | 2711 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
||
35 | 2712 ;; |
||
36 | 2713 |
||
37 | 2714 ;; name: dpfpu.inc |
||
38 | 2715 ;; rev.: 2016/03/30 |
||
39 | 2716 ;; o.s. 65C816 version v1.0 |
||
40 | 2717 |
||
41 | 2718 .LIST on |
||
42 | 2719 |
||
43 | 2720 ; direct page for flotaing point unit |
||
44 | 2721 _DPFPU: .SECTION page0, common, ref_only, offset 0 ;FPU D.P. |
||
45 | 2722 |
||
46 | 2723 000080 MNTBITS .EQU (16*8) ; significand bits + guard bits |
||
47 | 2724 000010 MANTSIZ .EQU 16 ; significand size |
||
48 | 2725 000014 FREGSIZ .EQU 20 ; floating point register size |
||
49 | 2726 |
||
50 | 2727 000000 tm .DS 16 ; temp. mantissa |
||
51 | 2728 |
||
52 | 2729 000010 00 fsubnf .DB ; subnormal flag used by fac2dec |
||
53 | 2730 000010 atncode .EQU fsubnf ; fatanyx octant |
||
54 | 2731 |
||
55 | 2732 000011 00 sgncmp .DB ; sign comparison: fac vs. arg |
||
56 | 2733 |
||
57 | 2734 ; floating Point accumulator (fac) |
||
58 | 2735 000012 facm .DS 16 ; guard bits (32 bits)+significand (80 bits) |
||
59 | 2736 000022 0000 facexp .DW ; fac biased exponent |
||
60 | 2737 000024 00 facsgn .DB ; fac mantissa sign |
||
61 | 2738 000025 00 facst .DB ; fac status for floating point |
||
62 | 2739 ; <7>: 1 if fac is invalid (nan or inf) |
||
63 | Tue Jul 17 11:00:18 2018 Page 2 |
||
64 | |||
65 | |||
66 | |||
67 | |||
68 | 2740 ; <6>: 1 if fac=inf (with <7>=1) |
||
69 | 2741 ; 0 if fac=nan (with <7>=1) |
||
70 | 2742 ; <6>: 1 if fac=0 (with <7>=0) |
||
71 | 2743 ; <5>: always '0' |
||
72 | 2744 |
||
73 | 2745 ; fac status for long integer |
||
74 | 2746 ; <7>: 1 if facm will be regarded as 'signed' |
||
75 | 2747 ; <6>: 1 if facm = 0 |
||
76 | 2748 ; <5>: always '1' |
||
77 | 2749 |
||
78 | 2750 000026 0000 fexph .DW ; unbiased fac exponent sign extension |
||
79 | 2751 000028 0000 facext .DW ; fac guard bits extension |
||
80 | 2752 000028 wftmp2 .EQU facext |
||
81 | 2753 000024 facsiz .EQU facsgn ; integer only: size in bytes |
||
82 | 2754 |
||
83 | 2755 ; floating point operand (arg) |
||
84 | 2756 00002A argm .DS 16 ; guard bits (32 bits)+significand (80 bits) |
||
85 | 2757 00003A 0000 argexp .DW ; arg biased exponent |
||
86 | 2758 00003C 00 argsgn .DB ; arg mantissa sign |
||
87 | 2759 00003D 00 argst .DB ; arg status for floating point |
||
88 | 2760 ; <7>: 1 if arg is invalid (nan or inf) |
||
89 | 2761 ; <6>: 1 if arg=inf (with <7>=1) |
||
90 | 2762 ; 0 if arg=nan (with <7>=1) |
||
91 | 2763 ; <6>: 1 if arg=0 (with <7>=0) |
||
92 | 2764 |
||
93 | 2765 ; arg status for long integer |
||
94 | 2766 ; <7>: 1 if facm will be regarded as 'signed' |
||
95 | 2767 ; <6>: 1 if facm = 0 |
||
96 | 2768 ; <5>: always '1' |
||
97 | 2769 00003E |
||
98 | 2770 00003E 0000 aexph .DW ; unbiased arg exponent sign extension |
||
99 | 2771 000040 0000 argext .DW |
||
100 | 2772 |
||
101 | 2773 00003E wftmp .EQU aexph ; temp. word (int2dec, fpadd, fpsub) |
||
102 | 2774 00003C argsiz .EQU argsgn ; integer only: size in bytes |
||
103 | 2775 |
||
104 | 2776 000042 fcp LP ; long pointer to flaot constants |
||
105 | 2777 000045 00 scsgn .DB ; scaling sign |
||
106 | 2778 000046 0000 scexp .DW ; scaling value |
||
107 | 2779 000048 0000 dexp .DW ; decimal exponent |
||
108 | 2780 00004A 00 dsgn .DB ; decimal float sign |
||
109 | 2781 00004B 00 pdeg .DB ; polyn. degree |
||
110 | 2782 00004B powfg .EQU pdeg ; flag used by fpowxy |
||
111 | 2783 |
||
112 | 2784 00004C tlp LP ; string long pointer |
||
113 | 2785 00004F 00 fpidx .DB ; string index |
||
114 | 2786 000050 |
||
115 | 2787 000050 tfr0 .DS 20 ; temp. float reg. 0 |
||
116 | 2788 000064 tfr1 .DS 20 ; temp. float reg. 1 |
||
117 | 2789 000078 tfr2 .DS 20 ; temp. float reg. 2 |
||
118 | 2790 00008C tfr3 .DS 20 ; temp. float reg. 3 |
||
119 | 2791 0000A0 tfr4 .DS 20 ; temp. float reg. 4 |
||
120 | 2792 0000B4 tfr5 .DS 20 ; temp. float reg. 5 |
||
121 | 2793 0000C8 .DS 4 ; used by xcvt: doesn't change |
||
122 | 2794 |
||
123 | 2795 0000CB XCVTEND .EQU ($ - 1) ; last byte of xcvt buffer |
||
124 | 2796 |
||
125 | Tue Jul 17 11:00:18 2018 Page 3 |
||
126 | |||
127 | |||
128 | |||
129 | |||
130 | 2797 ; buffer used by decimal conversion (overlap tfr0&tfr1: 40 bytes) |
||
131 | 2798 000050 fpstr .EQU tfr0 ; 40 bytes buffer |
||
132 | 2799 ; buffer used to format a decimal string |
||
133 | 2800 000078 xcvt .EQU tfr2 ; 84 bytes buffer |
||
134 | 2801 |
||
135 | 2802 0000B4 fcpc0 .EQU tfr5 ; constants pointer for exp. function |
||
136 | 2803 0000B6 fcpc1 .EQU tfr5+2 |
||
137 | 2804 0000B8 fcpc2 .EQU tfr5+4 |
||
138 | 2805 0000BA fcpp .EQU tfr5+6 |
||
139 | 2806 0000BC fcpq .EQU tfr5+8 |
||
140 | 2807 0000BE fcpd .EQU tfr5+10 |
||
141 | 2808 0000BF fcqd .EQU tfr5+11 |
||
142 | 2809 0000C0 fcpolf .EQU tfr5+12 ; polynomial flag |
||
143 | 2810 |
||
144 | 2811 0000B4 tmdot .EQU tfr5 ; digit count after decimal dot |
||
145 | 2812 0000B6 tmpa .EQU tfr5+2 ; temp: save A&Y |
||
146 | 2813 0000B7 tmpy .EQU tfr5+3 |
||
147 | 2814 0000B8 tmsgn .EQU tfr5+4 ; temp.: significand sign |
||
148 | 2815 0000B9 tmcnt .EQU tfr5+5 ; temp.: significand digits count |
||
149 | 2816 0000BA tesgn .EQU tfr5+6 ; temp.: exponent sign |
||
150 | 2817 0000BB tecnt .EQU tfr5+7 ; temp.: exponent digits count |
||
151 | 2818 |
||
152 | 2819 0000BC mcand1 .EQU tfr5+8 ; multiplicand's |
||
153 | 2820 0000BE mcand2 .EQU tfr5+10 |
||
154 | 2821 0000C0 mcsgn .EQU tfr5+12 |
||
155 | 2822 0000C2 dvsor .EQU tfr5+14 |
||
156 | 2823 0000C4 quot .EQU tfr5+16 |
||
157 | 2824 |
||
158 | 2825 0000CC 0000 fpprec .DW ; precision |
||
159 | 2826 0000CE 00 fpfmt .DB ; format |
||
160 | 2827 0000CF 00 fpaltf .DB ; alternate format |
||
161 | 2828 0000D0 00 fpcap .DB ; adding for lower case |
||
162 | 2829 0000D1 00 fpstyle .DB ; flag 'F' style |
||
163 | 2830 00004B fpdot .EQU pdeg ; decimal dot flag |
||
164 | 2831 0000CE fpoct .EQU fpfmt ; octant (circular func's) |
||
165 | 2832 0000CF fpcsgn .EQU fpaltf ; circular func's: argument sign |
||
166 | 2833 0000D0 fpcot .EQU fpcap ; cotangent flag |
||
167 | 2834 0000D0 fpasin .EQU fpcap ; asin flag |
||
168 | 2835 |
||
169 | 2836 0000D2 00 dummy .DB |
||
170 | 2837 |
||
171 | 2838 .ENDS |
||
172 | 2847 .LIST on |
||
173 | 2848 |
||
174 | 2849 003FFF EBIAS .EQU $3FFF ; exponent bias |
||
175 | 2850 007FFF INFEXP .EQU $7FFF ; inf/nan biased exponent |
||
176 | 2851 008000 INFSND .EQU $8000 ; infinity high word significand |
||
177 | 2852 00C000 NANSND .EQU $C000 ; nan high word significand |
||
178 | 2853 007FFE MAXEXP .EQU $7FFE ; max. biased exponent |
||
179 | 2854 000071 SNBITS .EQU 113 ; significand bits |
||
180 | 2855 |
||
181 | 2856 004006 BIAS8 .EQU (EBIAS + 7) ; bias exponent for 8 bit integer |
||
182 | 2857 00400E BIAS16 .EQU (BIAS8 + 8) ; bias exponent for 16 bit integer |
||
183 | 2858 00401E BIAS32 .EQU (BIAS16 + 16) ; bias exponent for 32 bit integer |
||
184 | 2859 00403E BIAS64 .EQU (BIAS32 + 32) ; bias exponent for 64 bit integer |
||
185 | 2860 00407E BIAS128 .EQU (BIAS64 + 64) ; bias exponent for 128 bit integer |
||
186 | 2861 004037 BIAS56 .EQU $4037 ; biased exponent of 2^56 |
||
187 | Tue Jul 17 11:00:18 2018 Page 4 |
||
188 | |||
189 | |||
190 | |||
191 | |||
192 | 2862 ;EM30 .EQU $3F9C ; biased exponent of 1.578e-30 |
||
193 | 2863 ;EM20 .EQU $3FBD ; biased exponent of about 1e-20 |
||
194 | 2864 ;EM62 .EQU $3F30 ; biased exponent of about 1e-62 |
||
195 | 2865 ;EP62 .EQU $40CF ; biased exponent of about 1e62 |
||
196 | 2866 004D10 LOG2H .EQU 19728 ; approximated log10(2) * $10000 |
||
197 | 2867 000024 MAXDIGITS .EQU 36 ; max. decimal digits |
||
198 | 2868 000026 EXP10 .EQU 38 ; decimal exponent for 128 bits integer |
||
199 | 2869 FFFFFC MINGEXP .EQU -4 ; min. decimal exponent 'G' format |
||
200 | 2870 |
||
201 | 2871 FFFF81 MAXBSHIFT .EQU -MNTBITS + 1 ; max. shift mant. |
||
202 | 2872 |
||
203 | 2873 000050 XCVTMAX .EQU 80 ; max. size of decimal string |
||
204 | 2874 |
||
205 | 2875 ;--------------------------------------------------------------------------- |
||
206 | 2876 ; code segment -- bank $F8 |
||
207 | 2877 ;--------------------------------------------------------------------------- |
||
208 | 2878 |
||
209 | 2879 .CODEF8 |
||
210 | 2880 .PUBLIC fpmult, ldfac, ldarg, mvftoa, int2dec, frndm, mvatof, scale10, str2fp |
||
211 | 2881 .PUBLIC uitrunc, imult, fp2dec, w2dec, fpack, funpack, str2fp2, mvf_t3, mvt3_a |
||
212 | 2882 .PUBLIC mvf_t1, mvt1_a, fpadd, fpsub, fpmult, fpdiv, fsqrt, flog10, flog10p1 |
||
213 | 2883 .PUBLIC fcbrt, floge, flogep1, floor, fexp, fexp10, frexp, fscale, flog2, flog2p1 |
||
214 | 2884 .PUBLIC fexp2, fexpm1, fpown, mvt1_f, frootn, fldinf, fldz, fpowxy, str2int |
||
215 | 2885 .PUBLIC uint2dec, fp2str, fsin, fcos, ftan, fcotan, fasin, facos, fatan |
||
216 | 2886 .PUBLIC ftrunc, fround, fceil, ui2dec, fpfrac, fsinh, fcosh, ftanh, fasinh, facosh |
||
217 | 2887 .PUBLIC fatanh, fpmod, fprem, fatanyx, int2str |
||
218 | 2888 |
||
219 | 2889 .LONGA off |
||
220 | 2890 .LONGI off |
||
221 | 2891 |
||
222 | 2892 ;--------------------------------------------------------------------------- |
||
223 | 2893 ; addition & subtraction implementation |
||
224 | 2894 ;--------------------------------------------------------------------------- |
||
225 | 2895 |
||
226 | 2896 ; fcsub - subtract the argument from one constant stored in program memory |
||
227 | 2897 ; |
||
228 | 2898 ; entry: |
||
229 | 2899 ; fac = x |
||
230 | 2900 ; A = low address of constant K |
||
231 | 2901 ; Y = high address of constant K |
||
232 | 2902 ; |
||
233 | 2903 ; exit: |
||
234 | 2904 ; fac = K - x |
||
235 | 2905 ; |
||
236 | 2906 ; This routine is used internally and not intended for end use. |
||
237 | 2907 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
238 | 2908 ; in program memory segment(the code segment that hold this routine). |
||
239 | 2909 ; |
||
240 | 2910 ;----- |
||
241 | 2911 F8455C fcsub: |
||
242 | 2912 ;----- |
||
243 | 2913 F8455C 20 CF 86 jsr ldarg ; move K to arg... |
||
244 | 2914 ; ...and execute arg - fac |
||
245 | 2915 |
||
246 | 2916 ; fpsub - subtract fac from arg and store result in fac |
||
247 | 2917 ; main subtraction routine |
||
248 | 2918 ; |
||
249 | Tue Jul 17 11:00:18 2018 Page 5 |
||
250 | |||
251 | |||
252 | |||
253 | |||
254 | 2919 ; entry: |
||
255 | 2920 ; arg = x |
||
256 | 2921 ; fac = y |
||
257 | 2922 ; CF = 1 if invalid result(inf or nan) |
||
258 | 2923 ; |
||
259 | 2924 ; exit: |
||
260 | 2925 ; fac = x - y |
||
261 | 2926 ; |
||
262 | 2927 ;----- |
||
263 | 2928 F8455F fpsub: |
||
264 | 2929 ;----- |
||
265 | 2930 F8455F A5 24 lda facsgn ; change sign to fac... |
||
266 | 2931 F84561 49 FF eor #$FF |
||
267 | 2932 F84563 85 24 sta facsgn |
||
268 | 2933 F84565 80 16 bra fpadd ; and execute arg + (-fac) |
||
269 | 2934 |
||
270 | 2935 ; faddhalf - add 0.5 to the argument |
||
271 | 2936 ; |
||
272 | 2937 ; entry: |
||
273 | 2938 ; fac = x |
||
274 | 2939 ; |
||
275 | 2940 ; exit: |
||
276 | 2941 ; fac = x + 0.5 |
||
277 | 2942 ; |
||
278 | 2943 ; This routine is used internally and not intended for end use. |
||
279 | 2944 ; |
||
280 | 2945 ;-------- |
||
281 | 2946 F84567 faddhalf: |
||
282 | 2947 ;-------- |
||
283 | 2948 F84567 20 9F 4E jsr ldahalf ; move constant K=0.5 to arg... |
||
284 | 2949 F8456A 80 11 bra fpadd ; ...and execute arg+fac |
||
285 | 2950 |
||
286 | 2951 ; faddone - add 1.0 to the argument |
||
287 | 2952 ; |
||
288 | 2953 ; entry: |
||
289 | 2954 ; fac = x |
||
290 | 2955 ; |
||
291 | 2956 ; exit: |
||
292 | 2957 ; fac = x + 1.0 |
||
293 | 2958 ; |
||
294 | 2959 ; This routine is used internally and not intended for end use. |
||
295 | 2960 ; |
||
296 | 2961 ;------- |
||
297 | 2962 F8456C faddone: |
||
298 | 2963 ;------- |
||
299 | 2964 F8456C 20 A6 4E jsr ldaone ; move constant K=1.0 to arg... |
||
300 | 2965 F8456F 80 0C bra fpadd ; ...and execute arg+fac |
||
301 | 2966 |
||
302 | 2967 ; fsubone - subtract 1.0 from the argument |
||
303 | 2968 ; |
||
304 | 2969 ; entry: |
||
305 | 2970 ; fac = x |
||
306 | 2971 ; |
||
307 | 2972 ; exit: |
||
308 | 2973 ; fac = x - 1.0 |
||
309 | 2974 ; |
||
310 | 2975 ; This routine is used internally and not intended for end use. |
||
311 | Tue Jul 17 11:00:18 2018 Page 6 |
||
312 | |||
313 | |||
314 | |||
315 | |||
316 | 2976 ; |
||
317 | 2977 ;------- |
||
318 | 2978 F84571 fsubone: |
||
319 | 2979 ;------- |
||
320 | 2980 F84571 20 A6 4E jsr ldaone ; move constant K=1.0 to arg... |
||
321 | 2981 F84574 A9 FF lda #$FF |
||
322 | 2982 F84576 85 3C sta argsgn ; ...change sign to arg... |
||
323 | 2983 F84578 80 03 bra fpadd ; ...and execute arg+fac |
||
324 | 2984 F8457A |
||
325 | 2985 ; fcadd - add the argument to one constant stored in program memory |
||
326 | 2986 ; |
||
327 | 2987 ; entry: |
||
328 | 2988 ; fac = x |
||
329 | 2989 ; fcp = long pointer to the constant K |
||
330 | 2990 ; |
||
331 | 2991 ; exit: |
||
332 | 2992 ; fac = K + x |
||
333 | 2993 ; |
||
334 | 2994 ; This routine is used internally and not intended for end use. |
||
335 | 2995 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
336 | 2996 ; in program memory segment(the code segment that hold this routine). |
||
337 | 2997 ; |
||
338 | 2998 ;----- |
||
339 | 2999 F8457A fcadd: |
||
340 | 3000 ;----- |
||
341 | 3001 F8457A 20 D7 86 jsr ldarg2 ; move K to arg... |
||
342 | 3002 ; ...and execute arg + fac |
||
343 | 3003 |
||
344 | 3004 ; fpadd: add fac to arg and store result in fac |
||
345 | 3005 ; main addition routine |
||
346 | 3006 ; |
||
347 | 3007 ; entry: |
||
348 | 3008 ; arg = x |
||
349 | 3009 ; fac = y |
||
350 | 3010 ; |
||
351 | 3011 ; exit: |
||
352 | 3012 ; fac = x + y |
||
353 | 3013 ; CF = 1 if invalid result(inf or nan) |
||
354 | 3014 ; |
||
355 | 3015 ; The smallest operand will be aligned shifting to right the mantissa and |
||
356 | 3016 ; incrementing the exponent until is equal to exponent of the greatest |
||
357 | 3017 ; operand. After alignment, mantissa of fac is added to mantissa of arg if |
||
358 | 3018 ; fac and arg have same sign, otherwise mantissa of the smallest operand will |
||
359 | 3019 ; be subctracted from mantissa of the greatest one (except in the case that |
||
360 | 3020 ; none of the operands has been shifted: in this case maybe need to change |
||
361 | 3021 ; sign to result). |
||
362 | 3022 ; |
||
363 | 3023 ;----- |
||
364 | 3024 F8457D fpadd: |
||
365 | 3025 ;----- |
||
366 | 3026 F8457D 20 41 48 jsr addtst ; operands test: check for inf,nan, 0 |
||
367 | 3027 F84580 A2 2A ldx #argm ; pointer to arg mantissa |
||
368 | 3028 F84582 A0 00 ldy #0 |
||
369 | 3029 F84584 ACC16 |
||
370 | 3030 F84584 C2 20 rep #PMFLAG |
||
371 | 3031 .LONGA on |
||
372 | 3032 .MNLIST |
||
373 | Tue Jul 17 11:00:18 2018 Page 7 |
||
374 | |||
375 | |||
376 | |||
377 | |||
378 | 3033 F84586 38 sec |
||
379 | 3034 F84587 A5 3A lda argexp ; now compute right shift count's to... |
||
380 | 3035 F84589 E5 22 sbc facexp ; ...align mantissa's |
||
381 | 3036 F8458B F0 2F beq ?go ; already aligned (same exponent) |
||
382 | 3037 F8458D 90 0F bcc ?sh ; arg < fac so shift right arg mantissa... |
||
383 | 3038 ; ...and result have same exp&sign of fac... |
||
384 | 3039 F8458F |
||
385 | 3040 ; fac > arg so shift right fac mantissa - here CF=1, Y=0 |
||
386 | 3041 F8458F 85 3E sta wftmp ; positive shift's count |
||
387 | 3042 F84591 A5 3A lda argexp ; result have same exp of arg... |
||
388 | 3043 F84593 85 22 sta facexp |
||
389 | 3044 F84595 A6 3C ldx argsgn ; ...and same sign of arg |
||
390 | 3045 F84597 86 24 stx facsgn |
||
391 | 3046 F84599 98 tya ; remember here CF=1 |
||
392 | 3047 F8459A E5 3E sbc wftmp ; negative shift's count |
||
393 | 3048 F8459C A2 12 ldx #facm ; pointer to fac mantissa |
||
394 | 3049 |
||
395 | 3050 ?sh: ; right shift mantissa pointed by X - here C=negative shift's count |
||
396 | 3051 F8459E C9 81 FF cmp #MAXBSHIFT ; shift out whole significand? |
||
397 | 3052 F845A1 B0 12 bcs ?shm ; no |
||
398 | 3053 F845A3 74 00 stz <0,x ; clear mantissa whole mantissa |
||
399 | 3054 F845A5 74 02 stz <2,x |
||
400 | 3055 F845A7 74 04 stz <4,x |
||
401 | 3056 F845A9 74 06 stz <6,x |
||
402 | 3057 F845AB 74 08 stz <8,x |
||
403 | 3058 F845AD 74 0A stz <10,x |
||
404 | 3059 F845AF 74 0C stz <12,x |
||
405 | 3060 F845B1 74 0E stz <14,x |
||
406 | 3061 F845B3 80 07 bra ?go ; go to add/sub |
||
407 | 3062 F845B5 |
||
408 | 3063 F845B5 ?shm: ACC08 ; A=negative shift's count |
||
409 | 3064 F845B5 E2 20 sep #PMFLAG |
||
410 | 3065 .LONGA off |
||
411 | 3066 .MNLIST |
||
412 | 3067 F845B7 20 3A 47 jsr shrmx ; shift right mantissa pointed by X |
||
413 | 3068 F845BA ACC16 |
||
414 | 3069 F845BA C2 20 rep #PMFLAG |
||
415 | 3070 .LONGA on |
||
416 | 3071 .MNLIST |
||
417 | 3072 |
||
418 | 3073 ; add/sub aligned mantissa's |
||
419 | 3074 F845BC A4 11 ?go: ldy sgncmp ; fac & arg have same sign? |
||
420 | 3075 F845BE 10 4A bpl ?add ; yes, so add mantissa's |
||
421 | 3076 |
||
422 | 3077 ; X=mantissa pointer (pssibly to the shifted operand) |
||
423 | 3078 ; always subtract the smallest operand from the greatest one, |
||
424 | 3079 ; except in the case that none of the operands has been shifted |
||
425 | 3080 |
||
426 | 3081 F845C0 A0 12 ldy #facm |
||
427 | 3082 F845C2 E0 2A cpx #argm |
||
428 | 3083 F845C4 F0 02 beq ?sub ; mantissa_fac - mantissa_arg |
||
429 | 3084 F845C6 A0 2A ldy #argm ; mantissa_arg - mantissa_fac |
||
430 | 3085 F845C8 38 ?sub: sec |
||
431 | 3086 F845C9 B9 00 3F lda P0FPU,y |
||
432 | 3087 F845CC F5 00 sbc <0,x |
||
433 | 3088 F845CE 85 12 sta facm |
||
434 | 3089 F845D0 B9 02 3F lda P0FPU+2,y |
||
435 | Tue Jul 17 11:00:18 2018 Page 8 |
||
436 | |||
437 | |||
438 | |||
439 | |||
440 | 3090 F845D3 F5 02 sbc <2,x |
||
441 | 3091 F845D5 85 14 sta facm+2 |
||
442 | 3092 F845D7 B9 04 3F lda P0FPU+4,y |
||
443 | 3093 F845DA F5 04 sbc <4,x |
||
444 | 3094 F845DC 85 16 sta facm+4 |
||
445 | 3095 F845DE B9 06 3F lda P0FPU+6,y |
||
446 | 3096 F845E1 F5 06 sbc <6,x |
||
447 | 3097 F845E3 85 18 sta facm+6 |
||
448 | 3098 F845E5 B9 08 3F lda P0FPU+8,y |
||
449 | 3099 F845E8 F5 08 sbc <8,x |
||
450 | 3100 F845EA 85 1A sta facm+8 |
||
451 | 3101 F845EC B9 0A 3F lda P0FPU+10,y |
||
452 | 3102 F845EF F5 0A sbc <10,x |
||
453 | 3103 F845F1 85 1C sta facm+10 |
||
454 | 3104 F845F3 B9 0C 3F lda P0FPU+12,y |
||
455 | 3105 F845F6 F5 0C sbc <12,x |
||
456 | 3106 F845F8 85 1E sta facm+12 |
||
457 | 3107 F845FA B9 0E 3F lda P0FPU+14,y |
||
458 | 3108 F845FD F5 0E sbc <14,x |
||
459 | 3109 F845FF 85 20 sta facm+14 |
||
460 | 3110 F84601 ACC08 |
||
461 | 3111 F84601 E2 20 sep #PMFLAG |
||
462 | 3112 .LONGA off |
||
463 | 3113 .MNLIST |
||
464 | 3114 F84603 B0 5D bcs normfac ; no borrow -- normalize fac |
||
465 | 3115 F84605 |
||
466 | 3116 ; a borrow mean that result change sign so we should negate mantissa |
||
467 | 3117 ; this can happen just when operands have same exponent |
||
468 | 3118 |
||
469 | 3119 F84605 20 04 47 jsr negfac ; negate fac because result change sign |
||
470 | 3120 F84608 80 58 bra normfac ; normalize fac |
||
471 | 3121 F8460A |
||
472 | 3122 F8460A ?add: ACC16CLC ; add fac & arg mantissa's |
||
473 | 3123 F8460A C2 21 rep #(PMFLAG.OR.PCFLAG) |
||
474 | 3124 .LONGA on |
||
475 | 3125 .MNLIST |
||
476 | 3126 F8460C A5 12 lda facm |
||
477 | 3127 F8460E 65 2A adc argm |
||
478 | 3128 F84610 85 12 sta facm |
||
479 | 3129 F84612 A5 14 lda facm+2 |
||
480 | 3130 F84614 65 2C adc argm+2 |
||
481 | 3131 F84616 85 14 sta facm+2 |
||
482 | 3132 F84618 A5 16 lda facm+4 |
||
483 | 3133 F8461A 65 2E adc argm+4 |
||
484 | 3134 F8461C 85 16 sta facm+4 |
||
485 | 3135 F8461E A5 18 lda facm+6 |
||
486 | 3136 F84620 65 30 adc argm+6 |
||
487 | 3137 F84622 85 18 sta facm+6 |
||
488 | 3138 F84624 A5 1A lda facm+8 |
||
489 | 3139 F84626 65 32 adc argm+8 |
||
490 | 3140 F84628 85 1A sta facm+8 |
||
491 | 3141 F8462A A5 1C lda facm+10 |
||
492 | 3142 F8462C 65 34 adc argm+10 |
||
493 | 3143 F8462E 85 1C sta facm+10 |
||
494 | 3144 F84630 A5 1E lda facm+12 |
||
495 | 3145 F84632 65 36 adc argm+12 |
||
496 | 3146 F84634 85 1E sta facm+12 |
||
497 | Tue Jul 17 11:00:18 2018 Page 9 |
||
498 | |||
499 | |||
500 | |||
501 | |||
502 | 3147 F84636 A5 20 lda facm+14 |
||
503 | 3148 F84638 65 38 adc argm+14 |
||
504 | 3149 F8463A 85 20 sta facm+14 |
||
505 | 3150 F8463C 90 24 bcc normfac ; normalize fac after addition |
||
506 | 3151 F8463E |
||
507 | 3152 ; the sum generate a carry so we add carry to fac |
||
508 | 3153 |
||
509 | 3154 ; addcf - add a carry to fac |
||
510 | 3155 ; |
||
511 | 3156 ; fac exponent will be incrementated and mantissa will be shifted |
||
512 | 3157 ; one place to right, and '1' is routed to the mantissa msb. |
||
513 | 3158 ; Note that this operation can cause overflow |
||
514 | 3159 ; |
||
515 | 3160 ; This routine is used internally and not intended for end use. |
||
516 | 3161 ; |
||
517 | 3162 ;----- |
||
518 | 3163 F8463E addcf: |
||
519 | 3164 ;----- |
||
520 | 3165 F8463E ACC16 |
||
521 | 3166 F8463E C2 20 rep #PMFLAG |
||
522 | 3167 .LONGA on |
||
523 | 3168 .MNLIST |
||
524 | 3169 F84640 A5 22 lda facexp |
||
525 | 3170 F84642 1A inc a ; increment exponent |
||
526 | 3171 F84643 C9 FF 7F cmp #INFEXP ; overflow? |
||
527 | 3172 F84646 90 03 bcc ?10 ; no |
||
528 | 3173 F84648 4C 7D 4E jmp fldinf ; yes, so set fac=inf |
||
529 | 3174 F8464B 85 22 ?10: sta facexp |
||
530 | 3175 F8464D 38 sec ; msb=1 |
||
531 | 3176 F8464E 66 20 ror facm+14 ; shift right mantissa one place |
||
532 | 3177 F84650 66 1E ror facm+12 |
||
533 | 3178 F84652 66 1C ror facm+10 |
||
534 | 3179 F84654 66 1A ror facm+8 |
||
535 | 3180 F84656 66 18 ror facm+6 |
||
536 | 3181 F84658 66 16 ror facm+4 |
||
537 | 3182 F8465A 66 14 ror facm+2 |
||
538 | 3183 F8465C 66 12 ror facm |
||
539 | 3184 F8465E ACC08 |
||
540 | 3185 F8465E E2 20 sep #PMFLAG |
||
541 | 3186 .LONGA off |
||
542 | 3187 .MNLIST |
||
543 | 3188 F84660 18 clc ; return no error condition |
||
544 | 3189 F84661 60 rts |
||
545 | 3190 |
||
546 | 3191 ; normfac - try to normalize fac after addition/subtraction or |
||
547 | 3192 ; while convert an integer to floting point |
||
548 | 3193 ; |
||
549 | 3194 ; The msb of mantissa will be '1', except in the case of subnormal. |
||
550 | 3195 ; This normalitation is accomplished by shifting toward left |
||
551 | 3196 ; the significand until msb=1 or biased exponent=1; at any shift |
||
552 | 3197 ; biased exponent is decremented. |
||
553 | 3198 ; |
||
554 | 3199 ; This routine is used internally and not intended for end use. |
||
555 | 3200 ; |
||
556 | 3201 ;------- |
||
557 | 3202 F84662 normfac: |
||
558 | 3203 ;------- |
||
559 | Tue Jul 17 11:00:18 2018 Page 10 |
||
560 | |||
561 | |||
562 | |||
563 | |||
564 | 3204 F84662 ACC16 |
||
565 | 3205 F84662 C2 20 rep #PMFLAG |
||
566 | 3206 .LONGA on |
||
567 | 3207 .MNLIST |
||
568 | 3208 F84664 A5 22 lda facexp |
||
569 | 3209 F84666 3A dec a ; exp=exp-1 |
||
570 | 3210 F84667 F0 7D beq chkz ; fac have minimum biased exponent (1) |
||
571 | 3211 F84669 38 sec |
||
572 | 3212 F8466A A0 10 ldy #MANTSIZ |
||
573 | 3213 F8466C A6 21 ?lp: ldx facm+15 |
||
574 | 3214 F8466E 30 69 bmi ?end ; already normalized: nothing to do |
||
575 | 3215 F84670 D0 53 bne ?shb ; shift bit at bit |
||
576 | 3216 F84672 E9 08 00 sbc #8 ; can shift a whole byte? |
||
577 | 3217 F84675 90 47 bcc ?rst ; no, restore exponent |
||
578 | 3218 F84677 A6 20 ldx facm+14 ; shift toward left byte at byte |
||
579 | 3219 F84679 86 21 stx facm+15 |
||
580 | 3220 F8467B A6 1F ldx facm+13 |
||
581 | 3221 F8467D 86 20 stx facm+14 |
||
582 | 3222 F8467F A6 1E ldx facm+12 |
||
583 | 3223 F84681 86 1F stx facm+13 |
||
584 | 3224 F84683 A6 1D ldx facm+11 |
||
585 | 3225 F84685 86 1E stx facm+12 |
||
586 | 3226 F84687 A6 1C ldx facm+10 |
||
587 | 3227 F84689 86 1D stx facm+11 |
||
588 | 3228 F8468B A6 1B ldx facm+9 |
||
589 | 3229 F8468D 86 1C stx facm+10 |
||
590 | 3230 F8468F A6 1A ldx facm+8 |
||
591 | 3231 F84691 86 1B stx facm+9 |
||
592 | 3232 F84693 A6 19 ldx facm+7 |
||
593 | 3233 F84695 86 1A stx facm+8 |
||
594 | 3234 F84697 A6 18 ldx facm+6 |
||
595 | 3235 F84699 86 19 stx facm+7 |
||
596 | 3236 F8469B A6 17 ldx facm+5 |
||
597 | 3237 F8469D 86 18 stx facm+6 |
||
598 | 3238 F8469F A6 16 ldx facm+4 |
||
599 | 3239 F846A1 86 17 stx facm+5 |
||
600 | 3240 F846A3 A6 15 ldx facm+3 |
||
601 | 3241 F846A5 86 16 stx facm+4 |
||
602 | 3242 F846A7 A6 14 ldx facm+2 |
||
603 | 3243 F846A9 86 15 stx facm+3 |
||
604 | 3244 F846AB A6 13 ldx facm+1 |
||
605 | 3245 F846AD 86 14 stx facm+2 |
||
606 | 3246 F846AF A6 12 ldx facm |
||
607 | 3247 F846B1 86 13 stx facm+1 |
||
608 | 3248 F846B3 A2 00 ldx #0 ; in last byte enter a zero... |
||
609 | 3249 F846B5 86 12 stx facm |
||
610 | 3250 F846B7 88 dey ; loop until all bytes was shifted |
||
611 | 3251 F846B8 D0 B2 bne ?lp |
||
612 | 3252 F846BA 64 22 stz facexp ; at this point fac=0... |
||
613 | 3253 F846BC 80 3E bra chkz2 ; ...and set status byte |
||
614 | 3254 F846BE 69 08 00 ?rst: adc #8 ; restore exponent... |
||
615 | 3255 F846C1 1A inc a |
||
616 | 3256 F846C2 3A ?cnt: dec a ; decrement exponent while bit shifting... |
||
617 | 3257 F846C3 F0 14 beq ?end ; can't shift more (exponent=1) |
||
618 | 3258 F846C5 06 12 ?shb: asl facm ; shift toward left one bit at time |
||
619 | 3259 F846C7 26 14 rol facm+2 |
||
620 | 3260 F846C9 26 16 rol facm+4 |
||
621 | Tue Jul 17 11:00:18 2018 Page 11 |
||
622 | |||
623 | |||
624 | |||
625 | |||
626 | 3261 F846CB 26 18 rol facm+6 |
||
627 | 3262 F846CD 26 1A rol facm+8 |
||
628 | 3263 F846CF 26 1C rol facm+10 |
||
629 | 3264 F846D1 26 1E rol facm+12 |
||
630 | 3265 F846D3 26 20 rol facm+14 |
||
631 | 3266 F846D5 10 EB bpl ?cnt ; shift until msb=0 |
||
632 | 3267 F846D7 30 01 bmi ?end2 ; finish |
||
633 | 3268 F846D9 1A ?end: inc a ; restore exponent... |
||
634 | 3269 F846DA 85 22 ?end2: sta facexp ; ...and set fac exponent |
||
635 | 3270 F846DC C9 FF 7F cmp #INFEXP ; check overflow condition |
||
636 | 3271 F846DF 90 05 bcc chkz ; no overflow: chexck if fac=0 |
||
637 | 3272 F846E1 ACC08 |
||
638 | 3273 F846E1 E2 20 sep #PMFLAG |
||
639 | 3274 .LONGA off |
||
640 | 3275 .MNLIST |
||
641 | 3276 F846E3 4C 7D 4E jmp fldinf ; set fac=inf |
||
642 | 3277 |
||
643 | 3278 ; chkz - check if fac=0; if fac=0 set the status byte |
||
644 | 3279 ; |
||
645 | 3280 ; This routine is used internally and not intended for end use. |
||
646 | 3281 ; |
||
647 | 3282 ;---- |
||
648 | 3283 F846E6 chkz: |
||
649 | 3284 ;---- |
||
650 | 3285 F846E6 ACC16 ; if all significand bits are '0'... |
||
651 | 3286 F846E6 C2 20 rep #PMFLAG |
||
652 | 3287 .LONGA on |
||
653 | 3288 .MNLIST |
||
654 | 3289 F846E8 A5 12 lda facm ; ...then fac=0 |
||
655 | 3290 F846EA 05 14 ora facm+2 |
||
656 | 3291 F846EC 05 16 ora facm+4 |
||
657 | 3292 F846EE 05 18 ora facm+6 |
||
658 | 3293 F846F0 05 1A ora facm+8 |
||
659 | 3294 F846F2 05 1C ora facm+10 |
||
660 | 3295 F846F4 05 1E ora facm+12 |
||
661 | 3296 F846F6 05 20 ora facm+14 |
||
662 | 3297 F846F8 D0 06 bne chkz3 |
||
663 | 3298 F846FA 85 22 sta facexp ; set biased exponent = 0 |
||
664 | 3299 F846FC A2 40 chkz2: ldx #$40 ; set status byte for 'zero' condition |
||
665 | 3300 F846FE 86 25 stx facst |
||
666 | 3301 F84700 chkz3: ACC08 |
||
667 | 3302 F84700 E2 20 sep #PMFLAG |
||
668 | 3303 .LONGA off |
||
669 | 3304 .MNLIST |
||
670 | 3305 F84702 18 clc |
||
671 | 3306 F84703 60 rts |
||
672 | 3307 |
||
673 | 3308 ; negfac - negate fac (2's complement) |
||
674 | 3309 ; |
||
675 | 3310 ; this routine will be called after a subtraction |
||
676 | 3311 ; that change the sign of the result |
||
677 | 3312 ; |
||
678 | 3313 ; This routine is used internally and not intended for end use. |
||
679 | 3314 ; |
||
680 | 3315 ;------ |
||
681 | 3316 F84704 negfac: |
||
682 | 3317 ;------ |
||
683 | Tue Jul 17 11:00:18 2018 Page 12 |
||
684 | |||
685 | |||
686 | |||
687 | |||
688 | 3318 F84704 A5 24 lda facsgn ; change fac sign |
||
689 | 3319 F84706 49 FF eor #$FF |
||
690 | 3320 F84708 85 24 sta facsgn |
||
691 | 3321 F8470A A2 00 ldx #0 |
||
692 | 3322 F8470C CPU16 ; two's complement |
||
693 | 3323 F8470C C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
694 | 3324 .LONGA on |
||
695 | 3325 .LONGI on |
||
696 | 3326 .MNLIST |
||
697 | 3327 F8470E 38 sec |
||
698 | 3328 F8470F 8A txa |
||
699 | 3329 F84710 E5 12 sbc facm |
||
700 | 3330 F84712 85 12 sta facm |
||
701 | 3331 F84714 8A txa |
||
702 | 3332 F84715 E5 14 sbc facm+2 |
||
703 | 3333 F84717 85 14 sta facm+2 |
||
704 | 3334 F84719 8A txa |
||
705 | 3335 F8471A E5 16 sbc facm+4 |
||
706 | 3336 F8471C 85 16 sta facm+4 |
||
707 | 3337 F8471E 8A txa |
||
708 | 3338 F8471F E5 18 sbc facm+6 |
||
709 | 3339 F84721 85 18 sta facm+6 |
||
710 | 3340 F84723 8A txa |
||
711 | 3341 F84724 E5 1A sbc facm+8 |
||
712 | 3342 F84726 85 1A sta facm+8 |
||
713 | 3343 F84728 8A txa |
||
714 | 3344 F84729 E5 1C sbc facm+10 |
||
715 | 3345 F8472B 85 1C sta facm+10 |
||
716 | 3346 F8472D 8A txa |
||
717 | 3347 F8472E E5 1E sbc facm+12 |
||
718 | 3348 F84730 85 1E sta facm+12 |
||
719 | 3349 F84732 8A txa |
||
720 | 3350 F84733 E5 20 sbc facm+14 |
||
721 | 3351 F84735 85 20 sta facm+14 |
||
722 | 3352 F84737 CPU08 |
||
723 | 3353 F84737 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
724 | 3354 .LONGA off |
||
725 | 3355 .LONGI off |
||
726 | 3356 .MNLIST |
||
727 | 3357 F84739 60 rts |
||
728 | 3358 |
||
729 | 3359 ; shrmx - shift mantissa pointed by X toward right |
||
730 | 3360 ; |
||
731 | 3361 ; entry: A=negative shift's count (max. 128 bit) |
||
732 | 3362 ; X=mantissa pointer |
||
733 | 3363 ; |
||
734 | 3364 ; exit: |
||
735 | 3365 ; mantissa is shifted toward right and 0 will be routed to msb |
||
736 | 3366 ; |
||
737 | 3367 ; This routine is used internally and not intended for end use. |
||
738 | 3368 ; |
||
739 | 3369 ;----- |
||
740 | 3370 F8473A shrmx: |
||
741 | 3371 ;----- |
||
742 | 3372 F8473A C9 F9 cmp #$F9 ; NF=1,CF=0 if $79<=A<$F9 else NF=0,CF=1 |
||
743 | 3373 F8473C 10 76 bpl ?shb ; shift right less than 8 bit (CF=1) |
||
744 | 3374 F8473E 80 6A bra ?tst2 ; CF=0, shift at least 8 bit or more |
||
745 | Tue Jul 17 11:00:18 2018 Page 13 |
||
746 | |||
747 | |||
748 | |||
749 | |||
750 | 3375 F84740 ?sh16: CPU16 ; shift right 16 bit at time |
||
751 | 3376 F84740 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
752 | 3377 .LONGA on |
||
753 | 3378 .LONGI on |
||
754 | 3379 .MNLIST |
||
755 | 3380 F84742 B4 02 ldy <2,x |
||
756 | 3381 F84744 94 00 sty <0,x |
||
757 | 3382 F84746 B4 04 ldy <4,x |
||
758 | 3383 F84748 94 02 sty <2,x |
||
759 | 3384 F8474A B4 06 ldy <6,x |
||
760 | 3385 F8474C 94 04 sty <4,x |
||
761 | 3386 F8474E B4 08 ldy <8,x |
||
762 | 3387 F84750 94 06 sty <6,x |
||
763 | 3388 F84752 B4 0A ldy <10,x |
||
764 | 3389 F84754 94 08 sty <8,x |
||
765 | 3390 F84756 B4 0C ldy <12,x |
||
766 | 3391 F84758 94 0A sty <10,x |
||
767 | 3392 F8475A B4 0E ldy <14,x |
||
768 | 3393 F8475C 94 0C sty <12,x |
||
769 | 3394 F8475E 74 0E stz <14,x |
||
770 | 3395 F84760 CPU08 |
||
771 | 3396 F84760 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
772 | 3397 .LONGA off |
||
773 | 3398 .LONGI off |
||
774 | 3399 .MNLIST |
||
775 | 3400 F84762 80 46 bra ?tst2 ; continue |
||
776 | 3401 F84764 69 08 ?tst1: adc #8 ; check if can shift 16 bit at time |
||
777 | 3402 F84766 30 D8 bmi ?sh16 ; yes (here CF=0) |
||
778 | 3403 F84768 F0 D6 beq ?sh16 ; yes (here CF=1) |
||
779 | 3404 F8476A E9 08 sbc #8 ; restore shift count and shift 8 bit at time |
||
780 | 3405 ; also note here result is negative and CF=0 |
||
781 | 3406 F8476C B4 01 ?sh8: ldy <1,x ; shift right 8 bit at time |
||
782 | 3407 F8476E 94 00 sty <0,x |
||
783 | 3408 F84770 B4 02 ldy <2,x |
||
784 | 3409 F84772 94 01 sty <1,x |
||
785 | 3410 F84774 B4 03 ldy <3,x |
||
786 | 3411 F84776 94 02 sty <2,x |
||
787 | 3412 F84778 B4 04 ldy <4,x |
||
788 | 3413 F8477A 94 03 sty <3,x |
||
789 | 3414 F8477C B4 05 ldy <5,x |
||
790 | 3415 F8477E 94 04 sty <4,x |
||
791 | 3416 F84780 B4 06 ldy <6,x |
||
792 | 3417 F84782 94 05 sty <5,x |
||
793 | 3418 F84784 B4 07 ldy <7,x |
||
794 | 3419 F84786 94 06 sty <6,x |
||
795 | 3420 F84788 B4 08 ldy <8,x |
||
796 | 3421 F8478A 94 07 sty <7,x |
||
797 | 3422 F8478C B4 09 ldy <9,x |
||
798 | 3423 F8478E 94 08 sty <8,x |
||
799 | 3424 F84790 B4 0A ldy <10,x |
||
800 | 3425 F84792 94 09 sty <9,x |
||
801 | 3426 F84794 B4 0B ldy <11,x |
||
802 | 3427 F84796 94 0A sty <10,x |
||
803 | 3428 F84798 B4 0C ldy <12,x |
||
804 | 3429 F8479A 94 0B sty <11,x |
||
805 | 3430 F8479C B4 0D ldy <13,x |
||
806 | 3431 F8479E 94 0C sty <12,x |
||
807 | Tue Jul 17 11:00:18 2018 Page 14 |
||
808 | |||
809 | |||
810 | |||
811 | |||
812 | 3432 F847A0 B4 0E ldy <14,x |
||
813 | 3433 F847A2 94 0D sty <13,x |
||
814 | 3434 F847A4 B4 0F ldy <15,x |
||
815 | 3435 F847A6 94 0E sty <14,x |
||
816 | 3436 F847A8 74 0F stz <15,x |
||
817 | 3437 F847AA 69 08 ?tst2: adc #8 ; test if can shift 8/16 bit at time |
||
818 | 3438 F847AC 30 B6 bmi ?tst1 ; test if can shift 16 bit at time (CF=0) |
||
819 | 3439 F847AE F0 BC beq ?sh8 ; shift 8 bit (here CF=1) |
||
820 | 3440 F847B0 E9 08 sbc #8 ; restore shift count |
||
821 | 3441 F847B2 B0 1D bcs ?end ; finish if shift count >= 0 |
||
822 | 3442 F847B4 A8 ?shb: tay ; residual bit shift count |
||
823 | 3443 F847B5 F0 1A beq ?end ; nothing to shift |
||
824 | 3444 F847B7 ACC16 |
||
825 | 3445 F847B7 C2 20 rep #PMFLAG |
||
826 | 3446 .LONGA on |
||
827 | 3447 .MNLIST |
||
828 | 3448 F847B9 B5 00 lda <0,x ; lsb+guard bits |
||
829 | 3449 F847BB 56 0E ?sh: lsr <14,x ; msb=0 |
||
830 | 3450 F847BD 76 0C ror <12,x |
||
831 | 3451 F847BF 76 0A ror <10,x |
||
832 | 3452 F847C1 76 08 ror <8,x |
||
833 | 3453 F847C3 76 06 ror <6,x |
||
834 | 3454 F847C5 76 04 ror <4,x |
||
835 | 3455 F847C7 76 02 ror <2,x |
||
836 | 3456 F847C9 6A ror a ; rotate lsb |
||
837 | 3457 F847CA C8 iny |
||
838 | 3458 F847CB D0 EE bne ?sh |
||
839 | 3459 F847CD 95 00 sta <0,x ; store lsb+guards bits |
||
840 | 3460 F847CF ACC08 |
||
841 | 3461 F847CF E2 20 sep #PMFLAG |
||
842 | 3462 .LONGA off |
||
843 | 3463 .MNLIST |
||
844 | 3464 F847D1 60 ?end: rts |
||
845 | 3465 |
||
846 | 3466 ; shlmx - shift mantissa pointed by X to left until msb of mantissa equal 1 |
||
847 | 3467 ; and decrement unbiased exponent according with shift's count. |
||
848 | 3468 ; |
||
849 | 3469 ; this routine is called for 'normalize' a subnormal operand |
||
850 | 3470 ; |
||
851 | 3471 ; call with A/M in 16 bit mode |
||
852 | 3472 ; |
||
853 | 3473 ; This routine is used internally and not intended for end use. |
||
854 | 3474 ; |
||
855 | 3475 ;----- |
||
856 | 3476 F847D2 shlmx: |
||
857 | 3477 ;----- |
||
858 | 3478 .LONGA on ; should be called with A/M=16 bit |
||
859 | 3479 .LONGI off |
||
860 | 3480 |
||
861 | 3481 F847D2 38 sec |
||
862 | 3482 F847D3 B5 10 lda <16,x ; C=unbiased exponent |
||
863 | 3483 F847D5 B4 0F ?lp1: ldy <15,x ; shift count < 8? |
||
864 | 3484 F847D7 D0 5D bne ?sh ; yes |
||
865 | 3485 F847D9 E9 08 00 sbc #8 ; 8 bits shift |
||
866 | 3486 F847DC B4 0E ldy <14,x ; shift toward left byte at byte |
||
867 | 3487 F847DE 94 0F sty <15,x |
||
868 | 3488 F847E0 B4 0D ldy <13,x |
||
869 | Tue Jul 17 11:00:18 2018 Page 15 |
||
870 | |||
871 | |||
872 | |||
873 | |||
874 | 3489 F847E2 94 0E sty <14,x |
||
875 | 3490 F847E4 B4 0C ldy <12,x |
||
876 | 3491 F847E6 94 0D sty <13,x |
||
877 | 3492 F847E8 B4 0B ldy <11,x |
||
878 | 3493 F847EA 94 0C sty <12,x |
||
879 | 3494 F847EC B4 0A ldy <10,x |
||
880 | 3495 F847EE 94 0B sty <11,x |
||
881 | 3496 F847F0 B4 09 ldy <9,x |
||
882 | 3497 F847F2 94 0A sty <10,x |
||
883 | 3498 F847F4 B4 08 ldy <8,x |
||
884 | 3499 F847F6 94 09 sty <9,x |
||
885 | 3500 F847F8 B4 07 ldy <7,x |
||
886 | 3501 F847FA 94 08 sty <8,x |
||
887 | 3502 F847FC B4 06 ldy <6,x |
||
888 | 3503 F847FE 94 07 sty <7,x |
||
889 | 3504 F84800 B4 05 ldy <5,x |
||
890 | 3505 F84802 94 06 sty <6,x |
||
891 | 3506 F84804 B4 04 ldy <4,x |
||
892 | 3507 F84806 94 05 sty <5,x |
||
893 | 3508 F84808 B4 03 ldy <3,x |
||
894 | 3509 F8480A 94 04 sty <4,x |
||
895 | 3510 F8480C B4 02 ldy <2,x |
||
896 | 3511 F8480E 94 03 sty <3,x |
||
897 | 3512 F84810 B4 01 ldy <1,x |
||
898 | 3513 F84812 94 02 sty <2,x |
||
899 | 3514 F84814 B4 00 ldy <0,x |
||
900 | 3515 F84816 94 01 sty <1,x |
||
901 | 3516 F84818 A0 00 ldy #0 |
||
902 | 3517 F8481A 94 00 sty <0,x |
||
903 | 3518 F8481C C9 81 FF cmp #MAXBSHIFT ; shifted all whole mantissa? |
||
904 | 3519 F8481F F0 17 beq ?done ; yes, store exponent |
||
905 | 3520 F84821 B0 B2 bcs ?lp1 ; no, try again |
||
906 | 3521 F84823 80 13 bra ?done ; store exponent |
||
907 | 3522 F84825 3A ?lp2: dec a ; decrement exponent |
||
908 | 3523 F84826 16 00 asl <0,x |
||
909 | 3524 F84828 36 02 rol <2,x |
||
910 | 3525 F8482A 36 04 rol <4,x |
||
911 | 3526 F8482C 36 06 rol <6,x |
||
912 | 3527 F8482E 36 08 rol <8,x |
||
913 | 3528 F84830 36 0A rol <10,x |
||
914 | 3529 F84832 36 0C rol <12,x |
||
915 | 3530 F84834 36 0E rol <14,x |
||
916 | 3531 F84836 10 ED ?sh: bpl ?lp2 ; if msb=0 shift to left one place |
||
917 | 3532 F84838 95 10 ?done: sta <16,x ; store exponent |
||
918 | 3533 F8483A 34 10 bit <16,x ; check exponent sign |
||
919 | 3534 F8483C 10 02 bpl ?end |
||
920 | 3535 F8483E D6 14 dec <20,x ; sign extension to 32 bit |
||
921 | 3536 F84840 60 ?end: rts |
||
922 | 3537 |
||
923 | 3538 .LONGA off |
||
924 | 3539 |
||
925 | 3540 ; addtst - test operands before to execute addition/subtraction |
||
926 | 3541 ; |
||
927 | 3542 ; This routine test fac & arg for validity, and return to the caller |
||
928 | 3543 ; for any abnormal condition: |
||
929 | 3544 ; |
||
930 | 3545 ; 1) return nan if fac=nan or arg=nan |
||
931 | Tue Jul 17 11:00:18 2018 Page 16 |
||
932 | |||
933 | |||
934 | |||
935 | |||
936 | 3546 ; 2) return nan if |fac|=|arg|=inf and arg&fac have opposites sign |
||
937 | 3547 ; 3) return +inf or -inf if fac=arg=+/-inf |
||
938 | 3548 ; 4) return +inf or -inf if fac=+/-inf and arg is valid |
||
939 | 3549 ; 5) return +inf or -inf if arg=+/-inf and fac is valid |
||
940 | 3550 ; |
||
941 | 3551 ; This routine is used internally and not intended for end use. |
||
942 | 3552 ; |
||
943 | 3553 ;------ |
||
944 | 3554 F84841 addtst: |
||
945 | 3555 ;------ |
||
946 | 3556 F84841 A5 24 lda facsgn ; compare sign |
||
947 | 3557 F84843 45 3C eor argsgn |
||
948 | 3558 F84845 85 11 sta sgncmp |
||
949 | 3559 F84847 38 sec ; invalid result flag |
||
950 | 3560 F84848 24 25 bit facst ; test fac |
||
951 | 3561 F8484A 10 11 bpl ?arg ; fac is valid, go to check arg |
||
952 | 3562 F8484C 50 1D bvc ?skp ; fac=nan so result=nan (fac sign) |
||
953 | 3563 F8484E 24 3D bit argst ; fac=inf so check arg |
||
954 | 3564 F84850 10 19 bpl ?skp ; fac=inf & arg=y so result=inf (fac sign) |
||
955 | 3565 F84852 50 14 bvc ?mv ; fac=inf & arg=nan so result=nan (arg sign) |
||
956 | 3566 F84854 24 11 bit sgncmp ; fac=inf & arg=inf so check sign comparison |
||
957 | 3567 F84856 10 13 bpl ?skp ; same sign so result=inf (fac sign) |
||
958 | 3568 F84858 20 74 4E jsr fldnan ; mismatch signs so result=nan (fac sign) |
||
959 | 3569 F8485B 80 0E bra ?skp ; skip resturn & exit with CF=1 |
||
960 | 3570 F8485D 24 3D ?arg: bit argst ; fac is valid, so now check arg |
||
961 | 3571 F8485F 30 07 bmi ?mv ; arg=inf/nan so result=inf/nan (arg sign) |
||
962 | 3572 F84861 18 clc ; now result is valid |
||
963 | 3573 F84862 70 07 bvs ?skp ; arg=0 so result=fac |
||
964 | 3574 F84864 24 25 bit facst ; fac=0? |
||
965 | 3575 F84866 50 05 bvc ?end ; no, return to add/sub operation |
||
966 | 3576 F84868 20 0C 84 ?mv: jsr mvatof ; move arg to fac (preserve CF) |
||
967 | 3577 F8486B 68 ?skp: pla ; skip return address |
||
968 | 3578 F8486C 68 pla |
||
969 | 3579 F8486D 60 ?end: rts |
||
970 | 3580 |
||
971 | 3581 ;--------------------------------------------------------------------------- |
||
972 | 3582 ; multiplication & division implementation - scaling routines |
||
973 | 3583 ;--------------------------------------------------------------------------- |
||
974 | 3584 |
||
975 | 3585 ; frexp - extracts the exponent from x. It returns an integer |
||
976 | 3586 ; power of two to scexp and the significand between 0.5 and 1 to fac |
||
977 | 3587 ; |
||
978 | 3588 ; entry: |
||
979 | 3589 ; fac = x (valid float) |
||
980 | 3590 ; |
||
981 | 3591 ; exit: |
||
982 | 3592 ; fac = y (0.5 <= y < 1) |
||
983 | 3593 ; scexp = N, exponent (signed integer) |
||
984 | 3594 ; scsgn = sign of N |
||
985 | 3595 ; dexp = |N| (absolute value of N) |
||
986 | 3596 ; |
||
987 | 3597 ; note that: |
||
988 | 3598 ; N |
||
989 | 3599 ; x = y * 2 |
||
990 | 3600 ; |
||
991 | 3601 ;----- |
||
992 | 3602 F8486E frexp: |
||
993 | Tue Jul 17 11:00:18 2018 Page 17 |
||
994 | |||
995 | |||
996 | |||
997 | |||
998 | 3603 ;----- |
||
999 | 3604 F8486E 38 sec |
||
1000 | 3605 F8486F 24 25 bit facst |
||
1001 | 3606 F84871 30 43 bmi ?end ; invalid fac |
||
1002 | 3607 F84873 ACC16 |
||
1003 | 3608 F84873 C2 20 rep #PMFLAG |
||
1004 | 3609 .LONGA on |
||
1005 | 3610 .MNLIST |
||
1006 | 3611 F84875 64 46 stz scexp |
||
1007 | 3612 F84877 64 48 stz dexp |
||
1008 | 3613 F84879 64 3E stz wftmp |
||
1009 | 3614 F8487B A2 00 ldx #0 ; assume positive sign |
||
1010 | 3615 F8487D A5 22 lda facexp |
||
1011 | 3616 F8487F F0 30 beq ?s ; fac=0 so return exponent=0 |
||
1012 | 3617 F84881 3A dec a ; subnormal? |
||
1013 | 3618 F84882 D0 14 bne ?fn ; no |
||
1014 | 3619 F84884 A6 21 ldx facm+15 |
||
1015 | 3620 F84886 30 10 bmi ?fn ; fac is norml |
||
1016 | 3621 F84888 85 22 sta facexp ; clear to get negative exponent of subnormal |
||
1017 | 3622 F8488A A2 12 ldx #facm |
||
1018 | 3623 F8488C 20 D2 47 jsr shlmx ; normalize subnormal fac |
||
1019 | 3624 F8488F A5 22 lda facexp |
||
1020 | 3625 F84891 85 3E sta wftmp ; negative exponent of subnormal |
||
1021 | 3626 F84893 A9 01 00 lda #1 ; restore biased exponent |
||
1022 | 3627 F84896 85 22 sta facexp |
||
1023 | 3628 F84898 38 ?fn: sec ; scale a normal f.p. |
||
1024 | 3629 F84899 A5 22 lda facexp |
||
1025 | 3630 F8489B E9 FE 3F sbc #EBIAS-1 ; new biased exponent |
||
1026 | 3631 F8489E 18 clc |
||
1027 | 3632 F8489F 65 3E adc wftmp ; any subnormal negative exponent |
||
1028 | 3633 F848A1 85 46 sta scexp |
||
1029 | 3634 F848A3 10 05 bpl ?p |
||
1030 | 3635 F848A5 CA dex |
||
1031 | 3636 F848A6 49 FF FF eor #$FFFF |
||
1032 | 3637 F848A9 1A inc a ; return absolute value too |
||
1033 | 3638 F848AA 85 48 ?p: sta dexp |
||
1034 | 3639 F848AC A9 FE 3F lda #EBIAS-1 |
||
1035 | 3640 F848AF 85 22 sta facexp ; now 0.5 <= fac < 1 |
||
1036 | 3641 F848B1 86 45 ?s: stx scsgn ; exponent sign |
||
1037 | 3642 F848B3 ACC08 |
||
1038 | 3643 F848B3 E2 20 sep #PMFLAG |
||
1039 | 3644 .LONGA off |
||
1040 | 3645 .MNLIST |
||
1041 | 3646 F848B5 18 clc |
||
1042 | 3647 F848B6 60 ?end: rts |
||
1043 | 3648 |
||
1044 | 3649 ; fscale - multiplies argument by a power of two |
||
1045 | 3650 ; |
||
1046 | 3651 ; entry: |
||
1047 | 3652 ; fac = x (valid float) |
||
1048 | 3653 ; scexp = N (signed integer) |
||
1049 | 3654 ; |
||
1050 | 3655 ; exit: |
||
1051 | 3656 ; N |
||
1052 | 3657 ; fac = x * 2 |
||
1053 | 3658 ; CF = 1 if invalid result(inf or nan) |
||
1054 | 3659 ; |
||
1055 | Tue Jul 17 11:00:18 2018 Page 18 |
||
1056 | |||
1057 | |||
1058 | |||
1059 | |||
1060 | 3660 ;------ |
||
1061 | 3661 F848B7 fscale: |
||
1062 | 3662 ;------ |
||
1063 | 3663 F848B7 38 sec ; invalid fac flag |
||
1064 | 3664 F848B8 24 25 bit facst |
||
1065 | 3665 F848BA 30 48 bmi ?end2 ; fac is invalid |
||
1066 | 3666 F848BC 70 45 bvs ?end1 ; fac=0 |
||
1067 | 3667 F848BE ACC16 |
||
1068 | 3668 F848BE C2 20 rep #PMFLAG |
||
1069 | 3669 .LONGA on |
||
1070 | 3670 .MNLIST |
||
1071 | 3671 F848C0 A5 46 lda scexp |
||
1072 | 3672 F848C2 F0 3D beq ?end ; scale factor = 0 |
||
1073 | 3673 F848C4 A5 22 lda facexp |
||
1074 | 3674 F848C6 3A dec a |
||
1075 | 3675 F848C7 D0 41 bne ?fn ; fac is normal |
||
1076 | 3676 F848C9 A6 21 ldx facm+15 |
||
1077 | 3677 F848CB 30 3D bmi ?fn ; fac is normal |
||
1078 | 3678 F848CD A5 46 lda scexp |
||
1079 | 3679 F848CF 10 18 bpl ?ps ; positive scaling of subnormal |
||
1080 | 3680 F848D1 30 07 bmi ?ns ; negative scaling of subnormal |
||
1081 | 3681 F848D3 A5 22 ?sn: lda facexp |
||
1082 | 3682 F848D5 64 22 ?sn2: stz facexp ; set biased exponent=1 |
||
1083 | 3683 F848D7 E6 22 inc facexp |
||
1084 | 3684 F848D9 3A dec a ; count of right shift |
||
1085 | 3685 F848DA C9 81 FF ?ns: cmp #MAXBSHIFT |
||
1086 | 3686 F848DD 90 26 bcc ?z ; return fac=0 |
||
1087 | 3687 F848DF ACC08 |
||
1088 | 3688 F848DF E2 20 sep #PMFLAG |
||
1089 | 3689 .LONGA off |
||
1090 | 3690 .MNLIST |
||
1091 | 3691 F848E1 A2 12 ldx #facm ; shift right |
||
1092 | 3692 F848E3 20 3A 47 jsr shrmx |
||
1093 | 3693 F848E6 4C E6 46 jmp chkz ; underflow test |
||
1094 | 3694 .LONGA on |
||
1095 | 3695 F848E9 A6 21 ?ps: ldx facm+15 ; shift subnormal toward left |
||
1096 | 3696 F848EB 30 1D bmi ?fn |
||
1097 | 3697 F848ED 06 12 asl facm |
||
1098 | 3698 F848EF 26 14 rol facm+2 |
||
1099 | 3699 F848F1 26 16 rol facm+4 |
||
1100 | 3700 F848F3 26 18 rol facm+6 |
||
1101 | 3701 F848F5 26 1A rol facm+8 |
||
1102 | 3702 F848F7 26 1C rol facm+10 |
||
1103 | 3703 F848F9 26 1E rol facm+12 |
||
1104 | 3704 F848FB 26 20 rol facm+14 |
||
1105 | 3705 F848FD C6 46 dec scexp |
||
1106 | 3706 F848FF D0 E8 bne ?ps |
||
1107 | 3707 F84901 ?end: ACC08 ; return |
||
1108 | 3708 F84901 E2 20 sep #PMFLAG |
||
1109 | 3709 .LONGA off |
||
1110 | 3710 .MNLIST |
||
1111 | 3711 F84903 18 ?end1: clc |
||
1112 | 3712 F84904 60 ?end2: rts |
||
1113 | 3713 F84905 ?z: ACC08 ; return fac=0 |
||
1114 | 3714 F84905 E2 20 sep #PMFLAG |
||
1115 | 3715 .LONGA off |
||
1116 | 3716 .MNLIST |
||
1117 | Tue Jul 17 11:00:18 2018 Page 19 |
||
1118 | |||
1119 | |||
1120 | |||
1121 | |||
1122 | 3717 F84907 4C 56 4E jmp fldz |
||
1123 | 3718 .LONGA on |
||
1124 | 3719 F8490A 64 3E ?fn: stz wftmp ; 32 bit exponent sign extension |
||
1125 | 3720 F8490C A5 46 lda scexp |
||
1126 | 3721 F8490E 10 02 bpl ?p |
||
1127 | 3722 F84910 C6 3E dec wftmp ; scexp is negative |
||
1128 | 3723 F84912 18 ?p: clc |
||
1129 | 3724 F84913 A5 22 lda facexp |
||
1130 | 3725 F84915 65 46 adc scexp |
||
1131 | 3726 F84917 85 22 sta facexp |
||
1132 | 3727 F84919 A9 00 00 lda #0 |
||
1133 | 3728 F8491C 65 3E adc wftmp ; can be just negative or null |
||
1134 | 3729 F8491E 30 B3 bmi ?sn ; handle subnormal result |
||
1135 | 3730 F84920 A5 22 lda facexp |
||
1136 | 3731 F84922 F0 B1 beq ?sn2 ; handle subnormal result |
||
1137 | 3732 F84924 C9 FF 7F cmp #INFEXP ; overflow? |
||
1138 | 3733 F84927 90 D8 bcc ?end ; no |
||
1139 | 3734 F84929 ACC08 |
||
1140 | 3735 F84929 E2 20 sep #PMFLAG |
||
1141 | 3736 .LONGA off |
||
1142 | 3737 .MNLIST |
||
1143 | 3738 F8492B 4C 7D 4E jmp fldinf |
||
1144 | 3739 |
||
1145 | 3740 .LONGA off |
||
1146 | 3741 F8492E |
||
1147 | 3742 ; scale10 - multiplies argument by a power of ten |
||
1148 | 3743 ; |
||
1149 | 3744 ; entry: |
||
1150 | 3745 ; fac = x (valid float) |
||
1151 | 3746 ; C = N (signed integer) |
||
1152 | 3747 ; |
||
1153 | 3748 ; exit: |
||
1154 | 3749 ; N |
||
1155 | 3750 ; fac = x * 10 |
||
1156 | 3751 ; CF = 1 if invalid result(inf or nan) |
||
1157 | 3752 ; |
||
1158 | 3753 ; A lookup table is used for values from 10 through 10^7, |
||
1159 | 3754 ; then this is augmented by multiplying with table entries |
||
1160 | 3755 ; for 10^8/16/32/64/128/256/512/1024/2048/4096 which allows |
||
1161 | 3756 ; any power up. Negative powers are provided by a final division. |
||
1162 | 3757 ; |
||
1163 | 3758 ;------- |
||
1164 | 3759 F8492E scale10: |
||
1165 | 3760 ;------- |
||
1166 | 3761 F8492E 38 sec |
||
1167 | 3762 F8492F 24 25 bit facst ; valid fac? |
||
1168 | 3763 F84931 30 48 bmi ?end2 ; no, exit |
||
1169 | 3764 F84933 70 45 bvs ?end1 ; fac=0, exit |
||
1170 | 3765 F84935 ACC16 |
||
1171 | 3766 F84935 C2 20 rep #PMFLAG |
||
1172 | 3767 .LONGA on |
||
1173 | 3768 .MNLIST |
||
1174 | 3769 F84937 C9 00 00 cmp #0 |
||
1175 | 3770 F8493A F0 3C beq ?end ; scaling exponent=0 so exit |
||
1176 | 3771 F8493C 85 46 sta scexp ; scaling exponent |
||
1177 | 3772 F8493E A2 00 ldx #0 |
||
1178 | 3773 F84940 A4 47 ldy scexp+1 ; test sign |
||
1179 | Tue Jul 17 11:00:18 2018 Page 20 |
||
1180 | |||
1181 | |||
1182 | |||
1183 | |||
1184 | 3774 F84942 10 07 bpl ?pe ; positive exponent |
||
1185 | 3775 F84944 8A txa ; change sign |
||
1186 | 3776 F84945 CA dex |
||
1187 | 3777 F84946 38 sec |
||
1188 | 3778 F84947 E5 46 sbc scexp |
||
1189 | 3779 F84949 85 46 sta scexp |
||
1190 | 3780 F8494B 86 45 ?pe: stx scsgn ; store sign |
||
1191 | 3781 F8494D C9 00 10 ?lp1: cmp #4096 ; loop for big scaling |
||
1192 | 3782 F84950 ACC08 |
||
1193 | 3783 F84950 E2 20 sep #PMFLAG |
||
1194 | 3784 .LONGA off |
||
1195 | 3785 .MNLIST |
||
1196 | 3786 F84952 90 28 bcc ?sc ; scaling<4096 |
||
1197 | 3787 F84954 A9 31 lda #<fce4096 |
||
1198 | 3788 F84956 A0 60 ldy #>fce4096 |
||
1199 | 3789 F84958 24 45 bit scsgn ; if negative svaling... |
||
1200 | 3790 F8495A 30 07 bmi ?div ; ...divide... |
||
1201 | 3791 F8495C 20 D5 49 jsr fcmult ; ...else multiplies by 4096 |
||
1202 | 3792 F8495F B0 1A bcs ?end2 ; overflow, so exit |
||
1203 | 3793 F84961 90 09 bcc ?cnt ; continue |
||
1204 | 3794 F84963 20 0A 4A ?div: jsr fcrdiv ; divide by 4096 |
||
1205 | 3795 F84966 B0 13 bcs ?end2 |
||
1206 | 3796 F84968 24 25 bit facst ; if fac=0 exit |
||
1207 | 3797 F8496A 70 0F bvs ?end2 |
||
1208 | 3798 F8496C ?cnt: ACC16 ; update scaling factor... |
||
1209 | 3799 F8496C C2 20 rep #PMFLAG |
||
1210 | 3800 .LONGA on |
||
1211 | 3801 .MNLIST |
||
1212 | 3802 F8496E 38 sec |
||
1213 | 3803 F8496F A5 46 lda scexp |
||
1214 | 3804 F84971 E9 00 10 sbc #4096 ; ...subtracting 4096... |
||
1215 | 3805 F84974 85 46 sta scexp |
||
1216 | 3806 F84976 D0 D5 bne ?lp1 ;...and repeat |
||
1217 | 3807 F84978 ?end: ACC08 |
||
1218 | 3808 F84978 E2 20 sep #PMFLAG |
||
1219 | 3809 .LONGA off |
||
1220 | 3810 .MNLIST |
||
1221 | 3811 F8497A 18 ?end1: clc |
||
1222 | 3812 F8497B 60 ?end2: rts |
||
1223 | 3813 F8497C 20 66 84 ?sc: jsr mvf_t0 ; save fac (tfr0=fac) in temp. reg. |
||
1224 | 3814 F8497F A5 46 lda scexp ; now decomposes scexp in factor... |
||
1225 | 3815 F84981 29 07 and #7 ; this for component from 1 to 1e7 |
||
1226 | 3816 F84983 0A asl a |
||
1227 | 3817 F84984 AA tax |
||
1228 | 3818 F84985 BF 44 60 F8 lda >fcaddr+1,x |
||
1229 | 3819 F84989 A8 tay |
||
1230 | 3820 F8498A BF 43 60 F8 lda >fcaddr,x |
||
1231 | 3821 F8498E 20 82 86 jsr ldfac ; load fac with a constant from 1.0 to 1.0e7 |
||
1232 | 3822 F84991 CPU16 |
||
1233 | 3823 F84991 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
1234 | 3824 .LONGA on |
||
1235 | 3825 .LONGI on |
||
1236 | 3826 .MNLIST |
||
1237 | 3827 F84993 A9 8F 5F lda #!fce8 ; now find the high order factor... |
||
1238 | 3828 F84996 85 42 sta fcp ; ...from 1.0e8 to 1.0e2048 |
||
1239 | 3829 F84998 A5 46 lda scexp |
||
1240 | 3830 F8499A 4A lsr a ; divide by 8 |
||
1241 | Tue Jul 17 11:00:18 2018 Page 21 |
||
1242 | |||
1243 | |||
1244 | |||
1245 | |||
1246 | 3831 F8499B 4A lsr a |
||
1247 | 3832 F8499C 4A lsr a |
||
1248 | 3833 F8499D F0 22 beq ?done ; if = 0 we are done |
||
1249 | 3834 F8499F 4A ?lp2: lsr a ; divide by 2 high order bits |
||
1250 | 3835 F849A0 90 14 bcc ?nxt ; if even load next constant |
||
1251 | 3836 F849A2 85 46 sta scexp ; save scale |
||
1252 | 3837 F849A4 CPU08 |
||
1253 | 3838 F849A4 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1254 | 3839 .LONGA off |
||
1255 | 3840 .LONGI off |
||
1256 | 3841 .MNLIST |
||
1257 | 3842 F849A6 20 DA 49 jsr fcmult2 ; multiplies by constant |
||
1258 | 3843 F849A9 90 07 bcc ?ok |
||
1259 | 3844 F849AB 24 45 bit scsgn |
||
1260 | 3845 F849AD 10 CC bpl ?end2 ; overflow: fac=inf |
||
1261 | 3846 F849AF 4C 56 4E jmp fldz ; underflow: fac=0 |
||
1262 | 3847 F849B2 ?ok: CPU16 |
||
1263 | 3848 F849B2 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
1264 | 3849 .LONGA on |
||
1265 | 3850 .LONGI on |
||
1266 | 3851 .MNLIST |
||
1267 | 3852 F849B4 A5 46 lda scexp |
||
1268 | 3853 F849B6 AA ?nxt: tax ; update pointer to next constant |
||
1269 | 3854 F849B7 A5 42 lda fcp |
||
1270 | 3855 F849B9 69 12 00 adc #FCSIZ |
||
1271 | 3856 F849BC 85 42 sta fcp |
||
1272 | 3857 F849BE 8A txa |
||
1273 | 3858 F849BF D0 DE bne ?lp2 ; loop |
||
1274 | 3859 F849C1 ?done: CPU08 |
||
1275 | 3860 F849C1 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1276 | 3861 .LONGA off |
||
1277 | 3862 .LONGI off |
||
1278 | 3863 .MNLIST |
||
1279 | 3864 F849C3 20 CE 85 jsr mvt0_a ; move temp. reg. tfr0 to arg |
||
1280 | 3865 F849C6 24 45 bit scsgn |
||
1281 | 3866 F849C8 30 46 bmi fpdiv ; if negative scaling we divide arg by fac |
||
1282 | 3867 F849CA 80 11 bra fpmult ; if positive scaling we multiplies arg by fac |
||
1283 | 3868 |
||
1284 | 3869 ; fsquare - return the square of the argument |
||
1285 | 3870 ; |
||
1286 | 3871 ; entry: |
||
1287 | 3872 ; fac = x |
||
1288 | 3873 ; |
||
1289 | 3874 ; exit: 2 |
||
1290 | 3875 ; fac = x |
||
1291 | 3876 ; CF = 1 if invalid result(inf or nan) |
||
1292 | 3877 ; |
||
1293 | 3878 ;------- |
||
1294 | 3879 F849CC fsquare: |
||
1295 | 3880 ;------- |
||
1296 | 3881 F849CC 20 39 84 jsr mvftoa ; move fac to arg |
||
1297 | 3882 F849CF 80 0C bra fpmult ; fac*fac |
||
1298 | 3883 |
||
1299 | 3884 ; mult10 - multiplies the argument with 10.0 |
||
1300 | 3885 ; |
||
1301 | 3886 ; entry: |
||
1302 | 3887 ; fac = x |
||
1303 | Tue Jul 17 11:00:18 2018 Page 22 |
||
1304 | |||
1305 | |||
1306 | |||
1307 | |||
1308 | 3888 ; |
||
1309 | 3889 ; exit: |
||
1310 | 3890 ; fac = x * 10 |
||
1311 | 3891 ; |
||
1312 | 3892 ; This routine is used internally and not intended for end use. |
||
1313 | 3893 ; |
||
1314 | 3894 ;------ |
||
1315 | 3895 F849D1 mult10: |
||
1316 | 3896 ;------ |
||
1317 | 3897 F849D1 A9 11 lda #<fce1 ; address of constant = 10.0 |
||
1318 | 3898 F849D3 A0 5F ldy #>fce1 |
||
1319 | 3899 |
||
1320 | 3900 ; fcmult - multiplies the argument with one constant stored in program memory |
||
1321 | 3901 ; |
||
1322 | 3902 ; entry: |
||
1323 | 3903 ; fac = x |
||
1324 | 3904 ; A = low address of constant K |
||
1325 | 3905 ; Y = high address of constant K |
||
1326 | 3906 ; |
||
1327 | 3907 ; exit: |
||
1328 | 3908 ; fac = K * x |
||
1329 | 3909 ; |
||
1330 | 3910 ; This routine is used internally and not intended for end use. |
||
1331 | 3911 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
1332 | 3912 ; in program memory segment(the code segment that hold this routine). |
||
1333 | 3913 ; |
||
1334 | 3914 ;------ |
||
1335 | 3915 F849D5 fcmult: |
||
1336 | 3916 ;------ |
||
1337 | 3917 F849D5 20 CF 86 jsr ldarg ; load arg with constant K |
||
1338 | 3918 F849D8 80 03 bra fpmult ; execute multiplication |
||
1339 | 3919 |
||
1340 | 3920 ; fcmult2 - multiplies the argument with one constant stored in program memory |
||
1341 | 3921 ; |
||
1342 | 3922 ; entry: |
||
1343 | 3923 ; fac = x |
||
1344 | 3924 ; fcp = long pointer to constant K |
||
1345 | 3925 ; |
||
1346 | 3926 ; exit: |
||
1347 | 3927 ; fac = K * x |
||
1348 | 3928 ; |
||
1349 | 3929 ; This routine is used internally and not intended for end use. |
||
1350 | 3930 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
1351 | 3931 ; in program memory segment(the code segment that hold this routine). |
||
1352 | 3932 ; |
||
1353 | 3933 ;------- |
||
1354 | 3934 F849DA fcmult2: |
||
1355 | 3935 ;------- |
||
1356 | 3936 F849DA 20 D7 86 jsr ldarg2 ; load arg with constant K |
||
1357 | 3937 |
||
1358 | 3938 ; fpmult - multiplies operands stored in arg & fac |
||
1359 | 3939 ; main multiplication routine |
||
1360 | 3940 ; |
||
1361 | 3941 ; entry: |
||
1362 | 3942 ; arg = x |
||
1363 | 3943 ; fac = y |
||
1364 | 3944 ; |
||
1365 | Tue Jul 17 11:00:18 2018 Page 23 |
||
1366 | |||
1367 | |||
1368 | |||
1369 | |||
1370 | 3945 ; exit: |
||
1371 | 3946 ; fac = x * y |
||
1372 | 3947 ; CF = 1 if invalid result(inf or nan) |
||
1373 | 3948 ; |
||
1374 | 3949 ;------ |
||
1375 | 3950 F849DD fpmult: |
||
1376 | 3951 ;------ |
||
1377 | 3952 F849DD 20 AF 4C jsr multst ; operands test |
||
1378 | 3953 F849E0 18 clc ; multiplication flag for addexp |
||
1379 | 3954 F849E1 20 DA 4A jsr addexp ; add exponent's |
||
1380 | 3955 F849E4 CPU16 ; clear the partial result |
||
1381 | 3956 F849E4 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
1382 | 3957 .LONGA on |
||
1383 | 3958 .LONGI on |
||
1384 | 3959 .MNLIST |
||
1385 | 3960 F849E6 64 00 stz tm |
||
1386 | 3961 F849E8 64 02 stz tm+2 |
||
1387 | 3962 F849EA 64 04 stz tm+4 |
||
1388 | 3963 F849EC 64 06 stz tm+6 |
||
1389 | 3964 F849EE 64 08 stz tm+8 |
||
1390 | 3965 F849F0 64 0A stz tm+10 |
||
1391 | 3966 F849F2 64 0C stz tm+12 |
||
1392 | 3967 F849F4 64 0E stz tm+14 |
||
1393 | 3968 F849F6 20 44 4B jsr multm ; execute binary multiplication |
||
1394 | 3969 F849F9 CPU08 |
||
1395 | 3970 F849F9 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1396 | 3971 .LONGA off |
||
1397 | 3972 .LONGI off |
||
1398 | 3973 .MNLIST |
||
1399 | 3974 F849FB 80 1D bra movres ; move result to fac & normalize |
||
1400 | 3975 |
||
1401 | 3976 ; frecip - returns the reciprocal of the argument |
||
1402 | 3977 ; |
||
1403 | 3978 ; entry: |
||
1404 | 3979 ; fac = x |
||
1405 | 3980 ; |
||
1406 | 3981 ; exit: |
||
1407 | 3982 ; fac = 1/x |
||
1408 | 3983 ; CF = 1 if invalid result(inf or nan) |
||
1409 | 3984 ; |
||
1410 | 3985 ;------ |
||
1411 | 3986 F849FD frecip: |
||
1412 | 3987 ;------ |
||
1413 | 3988 F849FD A9 FF lda #<fce0 ; load arg with constant 1.0 |
||
1414 | 3989 F849FF A0 5E ldy #>fce0 |
||
1415 | 3990 |
||
1416 | 3991 ; fcdiv - divide one constant stored in program memory by the argument |
||
1417 | 3992 ; |
||
1418 | 3993 ; entry: |
||
1419 | 3994 ; fac = x |
||
1420 | 3995 ; A = low address of constant K |
||
1421 | 3996 ; Y = high address of constant K |
||
1422 | 3997 ; |
||
1423 | 3998 ; exit: |
||
1424 | 3999 ; fac = K / x |
||
1425 | 4000 ; |
||
1426 | 4001 ; This routine is used internally and not intended for end use. |
||
1427 | Tue Jul 17 11:00:18 2018 Page 24 |
||
1428 | |||
1429 | |||
1430 | |||
1431 | |||
1432 | 4002 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
1433 | 4003 ; in program memory segment(the code segment that hold this routine). |
||
1434 | 4004 ; |
||
1435 | 4005 ;----- |
||
1436 | 4006 F84A01 fcdiv: |
||
1437 | 4007 ;----- |
||
1438 | 4008 F84A01 20 CF 86 jsr ldarg ; move constant K to arg |
||
1439 | 4009 F84A04 80 0A bra fpdiv ; execute arg/fac |
||
1440 | 4010 |
||
1441 | 4011 ; div10 - divide the argument by 10.0 |
||
1442 | 4012 ; |
||
1443 | 4013 ; entry: |
||
1444 | 4014 ; fac = x |
||
1445 | 4015 ; exit: |
||
1446 | 4016 ; fac = x / 10 |
||
1447 | 4017 ; |
||
1448 | 4018 ; This routine is used internally and not intended for end use. |
||
1449 | 4019 ; |
||
1450 | 4020 ;----- |
||
1451 | 4021 F84A06 div10: |
||
1452 | 4022 ;----- |
||
1453 | 4023 F84A06 A9 11 lda #<fce1 ; address of constant = 10.0 |
||
1454 | 4024 F84A08 A0 5F ldy #>fce1 |
||
1455 | 4025 |
||
1456 | 4026 ; fcrdiv - divide the argument by one constant stored in program memory |
||
1457 | 4027 ; |
||
1458 | 4028 ; entry: |
||
1459 | 4029 ; fac = x |
||
1460 | 4030 ; A = low address of constant K |
||
1461 | 4031 ; Y = high address of constant K |
||
1462 | 4032 ; |
||
1463 | 4033 ; exit: |
||
1464 | 4034 ; fac = x / K |
||
1465 | 4035 ; |
||
1466 | 4036 ; This routine is used internally and not intended for end use. |
||
1467 | 4037 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
1468 | 4038 ; in program memory segment(the code segment that hold this routine). |
||
1469 | 4039 ; |
||
1470 | 4040 ;------ |
||
1471 | 4041 F84A0A fcrdiv: |
||
1472 | 4042 ;------ |
||
1473 | 4043 F84A0A 20 39 84 jsr mvftoa ; nove fac to arg |
||
1474 | 4044 F84A0D 20 82 86 jsr ldfac ; move constant to fac |
||
1475 | 4045 |
||
1476 | 4046 ; fpdiv - divide the argument stored in arg by the argument stored in fac |
||
1477 | 4047 ; |
||
1478 | 4048 ; entry: |
||
1479 | 4049 ; arg = x |
||
1480 | 4050 ; fac = y |
||
1481 | 4051 ; |
||
1482 | 4052 ; exit: |
||
1483 | 4053 ; fac = x / y |
||
1484 | 4054 ; CF = 1 if invalid result(inf or nan) |
||
1485 | 4055 ; |
||
1486 | 4056 ;----- |
||
1487 | 4057 F84A10 fpdiv: |
||
1488 | 4058 ;----- |
||
1489 | Tue Jul 17 11:00:18 2018 Page 25 |
||
1490 | |||
1491 | |||
1492 | |||
1493 | |||
1494 | 4059 F84A10 20 EB 4C jsr divtst ; operands test |
||
1495 | 4060 F84A13 38 sec ; flag division for addexp |
||
1496 | 4061 F84A14 20 DA 4A jsr addexp ; add operands exponent |
||
1497 | 4062 F84A17 20 DF 4B jsr divm ; binary division |
||
1498 | 4063 F84A1A |
||
1499 | 4064 ; movres - move the result of multiplication/division to fac & normalize |
||
1500 | 4065 ; |
||
1501 | 4066 ; This routine is used internally and not intended for end use. |
||
1502 | 4067 ; |
||
1503 | 4068 ;------ |
||
1504 | 4069 F84A1A movres: |
||
1505 | 4070 ;------ |
||
1506 | 4071 F84A1A ACC16 |
||
1507 | 4072 F84A1A C2 20 rep #PMFLAG |
||
1508 | 4073 .LONGA on |
||
1509 | 4074 .MNLIST |
||
1510 | 4075 F84A1C A5 00 lda tm ; move the result (16 bytes) to fac |
||
1511 | 4076 F84A1E 85 12 sta facm |
||
1512 | 4077 F84A20 A5 02 lda tm+2 |
||
1513 | 4078 F84A22 85 14 sta facm+2 |
||
1514 | 4079 F84A24 A5 04 lda tm+4 |
||
1515 | 4080 F84A26 85 16 sta facm+4 |
||
1516 | 4081 F84A28 A5 06 lda tm+6 |
||
1517 | 4082 F84A2A 85 18 sta facm+6 |
||
1518 | 4083 F84A2C A5 08 lda tm+8 |
||
1519 | 4084 F84A2E 85 1A sta facm+8 |
||
1520 | 4085 F84A30 A5 0A lda tm+10 |
||
1521 | 4086 F84A32 85 1C sta facm+10 |
||
1522 | 4087 F84A34 A5 0C lda tm+12 |
||
1523 | 4088 F84A36 85 1E sta facm+12 |
||
1524 | 4089 F84A38 A5 0E lda tm+14 |
||
1525 | 4090 F84A3A 85 20 sta facm+14 |
||
1526 | 4091 F84A3C ACC08 |
||
1527 | 4092 F84A3C E2 20 sep #PMFLAG |
||
1528 | 4093 .LONGA off |
||
1529 | 4094 .MNLIST |
||
1530 | 4095 F84A3E A5 26 lda fexph ; operation involved subnormal? |
||
1531 | 4096 F84A40 F0 08 beq ?fn ; no |
||
1532 | 4097 F84A42 A2 12 ldx #facm ; now should shift to right fac... |
||
1533 | 4098 F84A44 20 3A 47 jsr shrmx ; ...because fac is subnormal |
||
1534 | 4099 F84A47 4C E6 46 ?tz: jmp chkz ; underflow test; check if fac=0 |
||
1535 | 4100 F84A4A ?fn: ACC16 ; normalize fac after mult/div |
||
1536 | 4101 F84A4A C2 20 rep #PMFLAG |
||
1537 | 4102 .LONGA on |
||
1538 | 4103 .MNLIST |
||
1539 | 4104 F84A4C A5 22 lda facexp |
||
1540 | 4105 F84A4E C9 01 00 cmp #1 |
||
1541 | 4106 F84A51 F0 F4 beq ?tz ; can't normalize: underflow test |
||
1542 | 4107 F84A53 A6 21 ldx facm+15 ; check msb |
||
1543 | 4108 F84A55 30 1A bmi ?done ; already normalized |
||
1544 | 4109 F84A57 C9 01 00 ?sh: cmp #1 |
||
1545 | 4110 F84A5A F0 15 beq ?done ; can't shift more |
||
1546 | 4111 F84A5C 3A dec a ; decrement exponent at any shift |
||
1547 | 4112 F84A5D 06 28 asl facext |
||
1548 | 4113 F84A5F 26 12 rol facm |
||
1549 | 4114 F84A61 26 14 rol facm+2 |
||
1550 | 4115 F84A63 26 16 rol facm+4 |
||
1551 | Tue Jul 17 11:00:18 2018 Page 26 |
||
1552 | |||
1553 | |||
1554 | |||
1555 | |||
1556 | 4116 F84A65 26 18 rol facm+6 |
||
1557 | 4117 F84A67 26 1A rol facm+8 |
||
1558 | 4118 F84A69 26 1C rol facm+10 |
||
1559 | 4119 F84A6B 26 1E rol facm+12 |
||
1560 | 4120 F84A6D 26 20 rol facm+14 |
||
1561 | 4121 F84A6F 10 E6 bpl ?sh ; shift until msb=1 |
||
1562 | 4122 F84A71 85 22 ?done: sta facexp ; store exponent |
||
1563 | 4123 F84A73 C9 FF 7F cmp #INFEXP ; check if overflow |
||
1564 | 4124 F84A76 B0 32 bcs ovfw ; overflow |
||
1565 | 4125 F84A78 A6 29 ldx facext+1 ; if msb=1 we round 128 bits mantissa |
||
1566 | 4126 F84A7A 10 2A bpl ifx ; no rounding bit: done |
||
1567 | 4127 F84A7C 20 AF 4A jsr chkovf ; we check exponent for a potential overflow |
||
1568 | 4128 F84A7F B0 25 bcs ifx ; no round is possible (we avoid overflow) |
||
1569 | 4129 F84A81 E6 12 inc facm ; inc. 15 guard bits and significand lsb |
||
1570 | 4130 F84A83 D0 21 bne ifx |
||
1571 | 4131 |
||
1572 | 4132 ; incfac - increment the high order 96 bits of the fac significand |
||
1573 | 4133 ; Called when round fac mantissa |
||
1574 | 4134 ; |
||
1575 | 4135 ; This routine is used internally and not intended for end use. |
||
1576 | 4136 ; |
||
1577 | 4137 ;------ |
||
1578 | 4138 F84A85 incfac: |
||
1579 | 4139 ;------ |
||
1580 | 4140 F84A85 E6 14 inc facm+2 |
||
1581 | 4141 F84A87 D0 1D bne ifx |
||
1582 | 4142 F84A89 E6 16 inc facm+4 |
||
1583 | 4143 F84A8B D0 19 bne ifx |
||
1584 | 4144 F84A8D E6 18 inc facm+6 |
||
1585 | 4145 F84A8F D0 15 bne ifx |
||
1586 | 4146 F84A91 E6 1A inc facm+8 |
||
1587 | 4147 F84A93 D0 11 bne ifx |
||
1588 | 4148 F84A95 E6 1C inc facm+10 |
||
1589 | 4149 F84A97 D0 0D bne ifx |
||
1590 | 4150 F84A99 E6 1E inc facm+12 |
||
1591 | 4151 F84A9B D0 09 bne ifx |
||
1592 | 4152 F84A9D E6 20 inc facm+14 |
||
1593 | 4153 F84A9F D0 05 bne ifx |
||
1594 | 4154 F84AA1 CPU08 |
||
1595 | 4155 F84AA1 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1596 | 4156 .LONGA off |
||
1597 | 4157 .LONGI off |
||
1598 | 4158 .MNLIST |
||
1599 | 4159 F84AA3 4C 3E 46 jmp addcf ; add carry to significand, no overflow |
||
1600 | 4160 F84AA6 ifx: CPU08 |
||
1601 | 4161 F84AA6 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1602 | 4162 .LONGA off |
||
1603 | 4163 .LONGI off |
||
1604 | 4164 .MNLIST |
||
1605 | 4165 F84AA8 18 clc |
||
1606 | 4166 F84AA9 60 rts |
||
1607 | 4167 |
||
1608 | 4168 ; set fac=inf |
||
1609 | 4169 ;---- |
||
1610 | 4170 F84AAA ovfw: |
||
1611 | 4171 ;---- |
||
1612 | 4172 F84AAA CPU08 ; overflow |
||
1613 | Tue Jul 17 11:00:18 2018 Page 27 |
||
1614 | |||
1615 | |||
1616 | |||
1617 | |||
1618 | 4173 F84AAA E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1619 | 4174 .LONGA off |
||
1620 | 4175 .LONGI off |
||
1621 | 4176 .MNLIST |
||
1622 | 4177 F84AAC 4C 7D 4E jmp fldinf |
||
1623 | 4178 |
||
1624 | 4179 ; chkovf - check potential fac overflow due to a roundoff |
||
1625 | 4180 ; |
||
1626 | 4181 ; return CF=1 if a rounding can cause overflow |
||
1627 | 4182 ; |
||
1628 | 4183 ; This routine should be called with A/M = 16 bit |
||
1629 | 4184 ; |
||
1630 | 4185 ; This routine is used internally and not intended for end use. |
||
1631 | 4186 ; |
||
1632 | 4187 ;------ |
||
1633 | 4188 F84AAF chkovf: |
||
1634 | 4189 ;------ |
||
1635 | 4190 .LONGA on |
||
1636 | 4191 |
||
1637 | 4192 F84AAF C9 FE 7F cmp #MAXEXP ; we check exponent for possible overflow |
||
1638 | 4193 F84AB2 90 25 bcc ?end ; ok, no overflow after rounding |
||
1639 | 4194 F84AB4 A9 FF FF lda #$FFFF ; check if mantissa is all one's |
||
1640 | 4195 F84AB7 C5 12 cmp facm |
||
1641 | 4196 F84AB9 D0 1A bne ?ok |
||
1642 | 4197 F84ABB C5 14 cmp facm+2 |
||
1643 | 4198 F84ABD D0 16 bne ?ok |
||
1644 | 4199 F84ABF C5 16 cmp facm+4 |
||
1645 | 4200 F84AC1 D0 12 bne ?ok |
||
1646 | 4201 F84AC3 C5 18 cmp facm+6 |
||
1647 | 4202 F84AC5 D0 0E bne ?ok |
||
1648 | 4203 F84AC7 C5 1A cmp facm+8 |
||
1649 | 4204 F84AC9 D0 0A bne ?ok |
||
1650 | 4205 F84ACB C5 1C cmp facm+10 |
||
1651 | 4206 F84ACD D0 06 bne ?ok |
||
1652 | 4207 F84ACF C5 1E cmp facm+12 |
||
1653 | 4208 F84AD1 D0 02 bne ?ok |
||
1654 | 4209 F84AD3 C5 20 cmp facm+14 |
||
1655 | 4210 F84AD5 18 ?ok: clc ; rounding is possible |
||
1656 | 4211 F84AD6 D0 01 bne ?end |
||
1657 | 4212 F84AD8 38 sec ; no rounding possible |
||
1658 | 4213 F84AD9 60 ?end: rts |
||
1659 | 4214 F84ADA |
||
1660 | 4215 .LONGA off |
||
1661 | 4216 |
||
1662 | 4217 ; addexp - add exponent of fac & arg for multiplication/division |
||
1663 | 4218 ; |
||
1664 | 4219 ; entry: |
||
1665 | 4220 ; arg = x |
||
1666 | 4221 ; fac = y |
||
1667 | 4222 ; CF = 1 if multiplication, else division |
||
1668 | 4223 ; |
||
1669 | 4224 ; exit: |
||
1670 | 4225 ; facexp = exponent of the result (x*y or x/y) |
||
1671 | 4226 ; fexph = negative exponent if result is subnormal, |
||
1672 | 4227 ; otherwise =0 if result is normal |
||
1673 | 4228 ; |
||
1674 | 4229 ; This routine is used internally and not intended for end use. |
||
1675 | Tue Jul 17 11:00:18 2018 Page 28 |
||
1676 | |||
1677 | |||
1678 | |||
1679 | |||
1680 | 4230 ; |
||
1681 | 4231 ;------ |
||
1682 | 4232 F84ADA addexp: |
||
1683 | 4233 ;------ |
||
1684 | 4234 F84ADA 08 php ; save carry |
||
1685 | 4235 F84ADB ACC16 |
||
1686 | 4236 F84ADB C2 20 rep #PMFLAG |
||
1687 | 4237 .LONGA on |
||
1688 | 4238 .MNLIST |
||
1689 | 4239 F84ADD 64 26 stz fexph ; clear exponent sign extension |
||
1690 | 4240 F84ADF 64 3E stz aexph |
||
1691 | 4241 F84AE1 64 28 stz facext ; extension used while mult/div |
||
1692 | 4242 F84AE3 A5 20 lda facm+14 |
||
1693 | 4243 F84AE5 30 05 bmi ?a ; fac is norml |
||
1694 | 4244 F84AE7 A2 12 ldx #facm |
||
1695 | 4245 F84AE9 20 D2 47 jsr shlmx ; normalize subnormal fac |
||
1696 | 4246 F84AEC A5 38 ?a: lda argm+14 |
||
1697 | 4247 F84AEE 30 05 bmi ?b ; arg is norml |
||
1698 | 4248 F84AF0 A2 2A ldx #argm |
||
1699 | 4249 F84AF2 20 D2 47 jsr shlmx ; normalize subnormal arg |
||
1700 | 4250 F84AF5 28 ?b: plp ; restore carry |
||
1701 | 4251 F84AF6 CPU16 |
||
1702 | 4252 F84AF6 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
1703 | 4253 .LONGA on |
||
1704 | 4254 .LONGI on |
||
1705 | 4255 .MNLIST |
||
1706 | 4256 F84AF8 A5 3A lda argexp |
||
1707 | 4257 F84AFA B0 14 bcs ?div ; subtract exponent for division |
||
1708 | 4258 F84AFC 65 22 adc facexp ; add exponent with sign extension |
||
1709 | 4259 F84AFE AA tax |
||
1710 | 4260 F84AFF A5 3E lda aexph |
||
1711 | 4261 F84B01 65 26 adc fexph |
||
1712 | 4262 F84B03 A8 tay |
||
1713 | 4263 F84B04 38 sec |
||
1714 | 4264 F84B05 8A txa |
||
1715 | 4265 F84B06 E9 FE 3F sbc #EBIAS-1 ; adjust biased exponent for mult |
||
1716 | 4266 F84B09 AA tax |
||
1717 | 4267 F84B0A 98 tya |
||
1718 | 4268 F84B0B E9 00 00 sbc #0 |
||
1719 | 4269 F84B0E 80 12 bra ?tst ; check exponent |
||
1720 | 4270 F84B10 E5 22 ?div: sbc facexp ; subtract exponent with sign extension |
||
1721 | 4271 F84B12 AA tax |
||
1722 | 4272 F84B13 A5 3E lda aexph |
||
1723 | 4273 F84B15 E5 26 sbc fexph |
||
1724 | 4274 F84B17 A8 tay |
||
1725 | 4275 F84B18 18 clc |
||
1726 | 4276 F84B19 8A txa |
||
1727 | 4277 F84B1A 69 FF 3F adc #EBIAS ; adjust biased exponent |
||
1728 | 4278 F84B1D AA tax |
||
1729 | 4279 F84B1E 98 tya |
||
1730 | 4280 F84B1F 69 00 00 adc #0 |
||
1731 | 4281 F84B22 30 09 ?tst: bmi ?sn ; negative exponent so result is subnormal |
||
1732 | 4282 F84B24 8A txa |
||
1733 | 4283 F84B25 F0 06 beq ?sn ; null exponent so result is subnormal |
||
1734 | 4284 F84B27 85 22 sta facexp ; exp >= 1 so result is normal |
||
1735 | 4285 F84B29 64 26 stz fexph |
||
1736 | 4286 F84B2B 80 0D bra ?done |
||
1737 | Tue Jul 17 11:00:18 2018 Page 29 |
||
1738 | |||
1739 | |||
1740 | |||
1741 | |||
1742 | 4287 F84B2D CA ?sn: dex ; negative count of shift toward right |
||
1743 | 4288 F84B2E E0 80 FF cpx #MAXBSHIFT-1 |
||
1744 | 4289 F84B31 90 0A bcc ?z ; underflow: set fac=0 |
||
1745 | 4290 F84B33 86 26 stx fexph ; negative count of shift |
||
1746 | 4291 F84B35 A9 01 00 lda #1 |
||
1747 | 4292 F84B38 85 22 sta facexp ; subnormasl have exponent=1 |
||
1748 | 4293 F84B3A ?done: CPU08 |
||
1749 | 4294 F84B3A E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1750 | 4295 .LONGA off |
||
1751 | 4296 .LONGI off |
||
1752 | 4297 .MNLIST |
||
1753 | 4298 F84B3C 60 rts |
||
1754 | 4299 F84B3D ?z: CPU08 ; underflow: load zero into fac... |
||
1755 | 4300 F84B3D E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
1756 | 4301 .LONGA off |
||
1757 | 4302 .LONGI off |
||
1758 | 4303 .MNLIST |
||
1759 | 4304 F84B3F 68 pla ; ...and exit |
||
1760 | 4305 F84B40 68 pla |
||
1761 | 4306 F84B41 4C 56 4E jmp fldz |
||
1762 | 4307 |
||
1763 | 4308 ; multm - binary multiplication of the arg mantissa with fac mantissa |
||
1764 | 4309 ; |
||
1765 | 4310 ; classic binary multiplication "shift and add" method |
||
1766 | 4311 ; only high order 144 bits of 256 are retained in result |
||
1767 | 4312 ; Due the fact that facm and argm are normalized, the result is |
||
1768 | 4313 ; always between 1.000000... and 2.ffffff.... |
||
1769 | 4314 ; |
||
1770 | 4315 ; should be called with A/M=16 bits, X/Y=16 bits |
||
1771 | 4316 ; |
||
1772 | 4317 ; This routine is used internally and not intended for end use. |
||
1773 | 4318 ; |
||
1774 | 4319 ;----- |
||
1775 | 4320 F84B44 multm: |
||
1776 | 4321 ;----- |
||
1777 | 4322 .LONGA on |
||
1778 | 4323 .LONGI on |
||
1779 | 4324 |
||
1780 | 4325 F84B44 A5 12 lda facm ; multiply any word of facm with whole argm |
||
1781 | 4326 F84B46 20 6B 4B jsr ?mlt |
||
1782 | 4327 F84B49 A5 14 lda facm+2 |
||
1783 | 4328 F84B4B 20 6B 4B jsr ?mlt |
||
1784 | 4329 F84B4E A5 16 lda facm+4 |
||
1785 | 4330 F84B50 20 6B 4B jsr ?mlt |
||
1786 | 4331 F84B53 A5 18 lda facm+6 |
||
1787 | 4332 F84B55 20 6B 4B jsr ?mlt |
||
1788 | 4333 F84B58 A5 1A lda facm+8 |
||
1789 | 4334 F84B5A 20 6B 4B jsr ?mlt |
||
1790 | 4335 F84B5D A5 1C lda facm+10 |
||
1791 | 4336 F84B5F 20 6B 4B jsr ?mlt |
||
1792 | 4337 F84B62 A5 1E lda facm+12 |
||
1793 | 4338 F84B64 20 6B 4B jsr ?mlt |
||
1794 | 4339 F84B67 A5 20 lda facm+14 ; multiply msb that never is null |
||
1795 | 4340 F84B69 80 02 bra ?mlt2 |
||
1796 | 4341 F84B6B F0 4F ?mlt: beq ?shr ; if null shift right partial result (16 bit) |
||
1797 | 4342 F84B6D 4A ?mlt2: lsr a ; multiplicator bit |
||
1798 | 4343 F84B6E 09 00 80 ora #$8000 ; bit for stop iteration (16 cycles) |
||
1799 | Tue Jul 17 11:00:18 2018 Page 30 |
||
1800 | |||
1801 | |||
1802 | |||
1803 | |||
1804 | 4344 F84B71 A8 ?lp: tay |
||
1805 | 4345 F84B72 90 31 bcc ?sh ; multiplicator=0 so shift result to right |
||
1806 | 4346 F84B74 18 clc |
||
1807 | 4347 F84B75 A5 00 lda tm ; add multiplicand to partial result |
||
1808 | 4348 F84B77 65 2A adc argm |
||
1809 | 4349 F84B79 85 00 sta tm |
||
1810 | 4350 F84B7B A5 02 lda tm+2 |
||
1811 | 4351 F84B7D 65 2C adc argm+2 |
||
1812 | 4352 F84B7F 85 02 sta tm+2 |
||
1813 | 4353 F84B81 A5 04 lda tm+4 |
||
1814 | 4354 F84B83 65 2E adc argm+4 |
||
1815 | 4355 F84B85 85 04 sta tm+4 |
||
1816 | 4356 F84B87 A5 06 lda tm+6 |
||
1817 | 4357 F84B89 65 30 adc argm+6 |
||
1818 | 4358 F84B8B 85 06 sta tm+6 |
||
1819 | 4359 F84B8D A5 08 lda tm+8 |
||
1820 | 4360 F84B8F 65 32 adc argm+8 |
||
1821 | 4361 F84B91 85 08 sta tm+8 |
||
1822 | 4362 F84B93 A5 0A lda tm+10 |
||
1823 | 4363 F84B95 65 34 adc argm+10 |
||
1824 | 4364 F84B97 85 0A sta tm+10 |
||
1825 | 4365 F84B99 A5 0C lda tm+12 |
||
1826 | 4366 F84B9B 65 36 adc argm+12 |
||
1827 | 4367 F84B9D 85 0C sta tm+12 |
||
1828 | 4368 F84B9F A5 0E lda tm+14 |
||
1829 | 4369 F84BA1 65 38 adc argm+14 |
||
1830 | 4370 F84BA3 85 0E sta tm+14 |
||
1831 | 4371 F84BA5 66 0E ?sh: ror tm+14 ; shift any carry into partial result... |
||
1832 | 4372 F84BA7 66 0C ror tm+12 ; ...and shift partial result toward right |
||
1833 | 4373 F84BA9 66 0A ror tm+10 |
||
1834 | 4374 F84BAB 66 08 ror tm+8 |
||
1835 | 4375 F84BAD 66 06 ror tm+6 |
||
1836 | 4376 F84BAF 66 04 ror tm+4 |
||
1837 | 4377 F84BB1 66 02 ror tm+2 |
||
1838 | 4378 F84BB3 66 00 ror tm |
||
1839 | 4379 F84BB5 66 28 ror facext ; greater accuracy with this extension |
||
1840 | 4380 F84BB7 98 tya |
||
1841 | 4381 F84BB8 4A lsr a ; end of loop when null |
||
1842 | 4382 F84BB9 D0 B6 bne ?lp |
||
1843 | 4383 F84BBB 60 rts ; always return CF=1 |
||
1844 | 4384 F84BBC |
||
1845 | 4385 F84BBC A5 00 ?shr: lda tm ; shift partial result toward right... |
||
1846 | 4386 F84BBE 85 28 sta facext ; ...16 bit at time |
||
1847 | 4387 F84BC0 A5 02 lda tm+2 |
||
1848 | 4388 F84BC2 85 00 sta tm |
||
1849 | 4389 F84BC4 A5 04 lda tm+4 |
||
1850 | 4390 F84BC6 85 02 sta tm+2 |
||
1851 | 4391 F84BC8 A5 06 lda tm+6 |
||
1852 | 4392 F84BCA 85 04 sta tm+4 |
||
1853 | 4393 F84BCC A5 08 lda tm+8 |
||
1854 | 4394 F84BCE 85 06 sta tm+6 |
||
1855 | 4395 F84BD0 A5 0A lda tm+10 |
||
1856 | 4396 F84BD2 85 08 sta tm+8 |
||
1857 | 4397 F84BD4 A5 0C lda tm+12 |
||
1858 | 4398 F84BD6 85 0A sta tm+10 |
||
1859 | 4399 F84BD8 A5 0E lda tm+14 |
||
1860 | 4400 F84BDA 85 0C sta tm+12 |
||
1861 | Tue Jul 17 11:00:18 2018 Page 31 |
||
1862 | |||
1863 | |||
1864 | |||
1865 | |||
1866 | 4401 F84BDC 64 0E stz tm+14 |
||
1867 | 4402 F84BDE 60 rts |
||
1868 | 4403 F84BDF |
||
1869 | 4404 .LONGA off |
||
1870 | 4405 .LONGI off |
||
1871 | 4406 |
||
1872 | 4407 ; divm - computes the division of the arg mantissa by fac mantissa |
||
1873 | 4408 ; |
||
1874 | 4409 ; Classic fixed point division, that use the recurrence equation: |
||
1875 | 4410 ; |
||
1876 | 4411 ; R = 2*R - D*Q |
||
1877 | 4412 ; j+1 j n-(j+1) |
||
1878 | 4413 ; |
||
1879 | 4414 ; R = V , Q = 1 if V >= D |
||
1880 | 4415 ; 0 n-1 |
||
1881 | 4416 ; |
||
1882 | 4417 ; where: V=dividend, D=divisor, R = partial remainder, Q is the k-th |
||
1883 | 4418 ; j k |
||
1884 | 4419 ; |
||
1885 | 4420 ; bit of the quotient, starting from the msb: k=n-(j+1), |
||
1886 | 4421 ; n=130 is the quotient size, j=1..n-1 is the loop index. |
||
1887 | 4422 ; Only 130 bits of quotient are retained. |
||
1888 | 4423 ; |
||
1889 | 4424 ; Due the fact that facm and argm are normalized, the result is |
||
1890 | 4425 ; always between 0.100000... and 1.ffffff.... |
||
1891 | 4426 ; |
||
1892 | 4427 ; This routine is used internally and not intended for end use. |
||
1893 | 4428 ; |
||
1894 | 4429 ;---- |
||
1895 | 4430 F84BDF divm: |
||
1896 | 4431 ;---- |
||
1897 | 4432 F84BDF A2 10 ldx #MANTSIZ ; loop for all bytes of mantissa |
||
1898 | 4433 F84BE1 A9 01 lda #$01 ; 8 bits quotient -- quotient = 0 |
||
1899 | 4434 F84BE3 20 50 4C ?lp1: jsr ?cmp ; compare argm vs. facm |
||
1900 | 4435 F84BE6 08 ?lp2: php ; save carry (CF=1 if argm>=facm) |
||
1901 | 4436 F84BE7 2A rol a ; shift in CF (quotient bit) into lsb |
||
1902 | 4437 F84BE8 90 09 bcc ?sub ; bits loop...stop when CF=1 |
||
1903 | 4438 F84BEA CA dex ; index of quotient array |
||
1904 | 4439 F84BEB 30 59 bmi ?done ; end of division |
||
1905 | 4440 F84BED 95 00 sta tm,x ; store this byte of quotient (start with msb) |
||
1906 | 4441 F84BEF F0 51 beq ?lst ; last quotient is 2 bits only |
||
1907 | 4442 F84BF1 A9 01 lda #$01 ; 8 bits quotient -- quotient = 0 |
||
1908 | 4443 F84BF3 28 ?sub: plp ; restore CF from comparing argm vs. facm |
||
1909 | 4444 F84BF4 ACC16 |
||
1910 | 4445 F84BF4 C2 20 rep #PMFLAG |
||
1911 | 4446 .LONGA on |
||
1912 | 4447 .MNLIST |
||
1913 | 4448 F84BF6 90 32 bcc ?sh ; quotient bit = 0: no subtraction |
||
1914 | 4449 F84BF8 A8 tay ; save partial quotient: here CF=1 |
||
1915 | 4450 F84BF9 A5 2A lda argm ; get the partial remainder... |
||
1916 | 4451 F84BFB E5 12 sbc facm ; ...subtracting the divisor facm |
||
1917 | 4452 F84BFD 85 2A sta argm |
||
1918 | 4453 F84BFF A5 2C lda argm+2 |
||
1919 | 4454 F84C01 E5 14 sbc facm+2 |
||
1920 | 4455 F84C03 85 2C sta argm+2 |
||
1921 | 4456 F84C05 A5 2E lda argm+4 |
||
1922 | 4457 F84C07 E5 16 sbc facm+4 |
||
1923 | Tue Jul 17 11:00:18 2018 Page 32 |
||
1924 | |||
1925 | |||
1926 | |||
1927 | |||
1928 | 4458 F84C09 85 2E sta argm+4 |
||
1929 | 4459 F84C0B A5 30 lda argm+6 |
||
1930 | 4460 F84C0D E5 18 sbc facm+6 |
||
1931 | 4461 F84C0F 85 30 sta argm+6 |
||
1932 | 4462 F84C11 A5 32 lda argm+8 |
||
1933 | 4463 F84C13 E5 1A sbc facm+8 |
||
1934 | 4464 F84C15 85 32 sta argm+8 |
||
1935 | 4465 F84C17 A5 34 lda argm+10 |
||
1936 | 4466 F84C19 E5 1C sbc facm+10 |
||
1937 | 4467 F84C1B 85 34 sta argm+10 |
||
1938 | 4468 F84C1D A5 36 lda argm+12 |
||
1939 | 4469 F84C1F E5 1E sbc facm+12 |
||
1940 | 4470 F84C21 85 36 sta argm+12 |
||
1941 | 4471 F84C23 A5 38 lda argm+14 |
||
1942 | 4472 F84C25 E5 20 sbc facm+14 |
||
1943 | 4473 F84C27 85 38 sta argm+14 |
||
1944 | 4474 F84C29 98 tya ; restore partial quotient |
||
1945 | 4475 F84C2A 06 2A ?sh: asl argm ; now shift argm to left (one place) |
||
1946 | 4476 F84C2C 26 2C rol argm+2 |
||
1947 | 4477 F84C2E 26 2E rol argm+4 |
||
1948 | 4478 F84C30 26 30 rol argm+6 |
||
1949 | 4479 F84C32 26 32 rol argm+8 |
||
1950 | 4480 F84C34 26 34 rol argm+10 |
||
1951 | 4481 F84C36 26 36 rol argm+12 |
||
1952 | 4482 F84C38 26 38 rol argm+14 |
||
1953 | 4483 F84C3A ACC08 |
||
1954 | 4484 F84C3A E2 20 sep #PMFLAG |
||
1955 | 4485 .LONGA off |
||
1956 | 4486 .MNLIST |
||
1957 | 4487 F84C3C B0 A8 bcs ?lp2 ; CF=1: quotient bit = 1 |
||
1958 | 4488 F84C3E 30 A3 bmi ?lp1 ; CF=0, MSB=1: compare again argm vs. facm |
||
1959 | 4489 F84C40 10 A4 bpl ?lp2 ; CF=0, MSB=0: quotient bit = 0 |
||
1960 | 4490 F84C42 A9 40 ?lst: lda #$40 ; 2 last bits quotient for normalitation... |
||
1961 | 4491 F84C44 80 AD bra ?sub ; ...and rounding |
||
1962 | 4492 F84C46 28 ?done: plp ; end of division |
||
1963 | 4493 F84C47 0A asl a ; last truncated quotient (00..03)... |
||
1964 | 4494 F84C48 0A asl a ; ...shifted to bits 15&14 of facext... |
||
1965 | 4495 F84C49 0A asl a ; ...to have greater accuracy... |
||
1966 | 4496 F84C4A 0A asl a |
||
1967 | 4497 F84C4B 0A asl a |
||
1968 | 4498 F84C4C 0A asl a |
||
1969 | 4499 F84C4D 85 29 sta facext+1 |
||
1970 | 4500 F84C4F 60 rts |
||
1971 | 4501 |
||
1972 | 4502 F84C50 A4 39 ?cmp: ldy argm+15 ; comparation: arg mantissa vs. fac mantissa |
||
1973 | 4503 F84C52 C4 21 cpy facm+15 |
||
1974 | 4504 F84C54 D0 58 bne ?end |
||
1975 | 4505 F84C56 A4 38 ldy argm+14 |
||
1976 | 4506 F84C58 C4 20 cpy facm+14 |
||
1977 | 4507 F84C5A D0 52 bne ?end |
||
1978 | 4508 F84C5C A4 37 ldy argm+13 |
||
1979 | 4509 F84C5E C4 1F cpy facm+13 |
||
1980 | 4510 F84C60 D0 4C bne ?end |
||
1981 | 4511 F84C62 A4 36 ldy argm+12 |
||
1982 | 4512 F84C64 C4 1E cpy facm+12 |
||
1983 | 4513 F84C66 D0 46 bne ?end |
||
1984 | 4514 F84C68 A4 35 ldy argm+11 |
||
1985 | Tue Jul 17 11:00:18 2018 Page 33 |
||
1986 | |||
1987 | |||
1988 | |||
1989 | |||
1990 | 4515 F84C6A C4 1D cpy facm+11 |
||
1991 | 4516 F84C6C D0 40 bne ?end |
||
1992 | 4517 F84C6E A4 34 ldy argm+10 |
||
1993 | 4518 F84C70 C4 1C cpy facm+10 |
||
1994 | 4519 F84C72 D0 3A bne ?end |
||
1995 | 4520 F84C74 A4 33 ldy argm+9 |
||
1996 | 4521 F84C76 C4 1B cpy facm+9 |
||
1997 | 4522 F84C78 D0 34 bne ?end |
||
1998 | 4523 F84C7A A4 32 ldy argm+8 |
||
1999 | 4524 F84C7C C4 1A cpy facm+8 |
||
2000 | 4525 F84C7E D0 2E bne ?end |
||
2001 | 4526 F84C80 A4 31 ldy argm+7 |
||
2002 | 4527 F84C82 C4 19 cpy facm+7 |
||
2003 | 4528 F84C84 D0 28 bne ?end |
||
2004 | 4529 F84C86 A4 30 ldy argm+6 |
||
2005 | 4530 F84C88 C4 18 cpy facm+6 |
||
2006 | 4531 F84C8A D0 22 bne ?end |
||
2007 | 4532 F84C8C A4 2F ldy argm+5 |
||
2008 | 4533 F84C8E C4 17 cpy facm+5 |
||
2009 | 4534 F84C90 D0 1C bne ?end |
||
2010 | 4535 F84C92 A4 2E ldy argm+4 |
||
2011 | 4536 F84C94 C4 16 cpy facm+4 |
||
2012 | 4537 F84C96 D0 16 bne ?end |
||
2013 | 4538 F84C98 A4 2D ldy argm+3 |
||
2014 | 4539 F84C9A C4 15 cpy facm+3 |
||
2015 | 4540 F84C9C D0 10 bne ?end |
||
2016 | 4541 F84C9E A4 2C ldy argm+2 |
||
2017 | 4542 F84CA0 C4 14 cpy facm+2 |
||
2018 | 4543 F84CA2 D0 0A bne ?end |
||
2019 | 4544 F84CA4 A4 2B ldy argm+1 |
||
2020 | 4545 F84CA6 C4 13 cpy facm+1 |
||
2021 | 4546 F84CA8 D0 04 bne ?end |
||
2022 | 4547 F84CAA A4 2A ldy argm |
||
2023 | 4548 F84CAC C4 12 cpy facm |
||
2024 | 4549 F84CAE 60 ?end: rts |
||
2025 | 4550 |
||
2026 | 4551 ; multst - test operands before to execute multiplication |
||
2027 | 4552 ; |
||
2028 | 4553 ; This routine test fac & arg for validity, set the sign of the result, |
||
2029 | 4554 ; and return to the caller for any abnormal condition: |
||
2030 | 4555 ; |
||
2031 | 4556 ; 1) return nan if fac=nan or arg=nan |
||
2032 | 4557 ; 2) return +inf if fac=+inf and arg=+inf or arg>0 |
||
2033 | 4558 ; 3) return +inf if fac=-inf and arg=-inf or arg<0 |
||
2034 | 4559 ; 4) return -inf if fac=-inf and arg=+inf or arg>0 |
||
2035 | 4560 ; 5) return -inf if fac=+inf and arg=-inf or arg<0 |
||
2036 | 4561 ; 6) return +inf if arg=+inf and fac>0 |
||
2037 | 4562 ; 7) return +inf if arg=-inf and fac<0 |
||
2038 | 4563 ; 8) return -inf if arg=-inf and fac>0 |
||
2039 | 4564 ; 9) return -inf if arg=+inf and fac<0 |
||
2040 | 4565 ; 10) return nan if fac=+/-inf and arg=0 |
||
2041 | 4566 ; 11) return nan if arg=+/-inf and fac=0 |
||
2042 | 4567 ; |
||
2043 | 4568 ; This routine is used internally and not intended for end use. |
||
2044 | 4569 ; |
||
2045 | 4570 ;------ |
||
2046 | 4571 F84CAF multst: |
||
2047 | Tue Jul 17 11:00:18 2018 Page 34 |
||
2048 | |||
2049 | |||
2050 | |||
2051 | |||
2052 | 4572 ;------ |
||
2053 | 4573 F84CAF A5 24 lda facsgn ; compare sign |
||
2054 | 4574 F84CB1 45 3C eor argsgn |
||
2055 | 4575 F84CB3 85 24 sta facsgn ; set result sign |
||
2056 | 4576 F84CB5 85 3C sta argsgn |
||
2057 | 4577 F84CB7 38 sec ; invalid result flag |
||
2058 | 4578 F84CB8 24 25 bit facst ; test fac |
||
2059 | 4579 F84CBA 10 0E bpl ?fv ; fac is valid |
||
2060 | 4580 F84CBC 50 2A bvc ?skp ; fac=nan so result=nan |
||
2061 | 4581 F84CBE 24 3D bit argst ; fac=inf so check arg |
||
2062 | 4582 F84CC0 10 04 bpl ?az ; fac=inf & arg=y so check if arg=0 |
||
2063 | 4583 F84CC2 50 21 bvc ?mv ; fac=inf & arg=nan so result=nan |
||
2064 | 4584 F84CC4 80 22 bra ?skp ; fac=inf & arg=inf so result=inf |
||
2065 | 4585 F84CC6 50 20 ?az: bvc ?skp ; fac=inf & arg not null so result=inf |
||
2066 | 4586 F84CC8 80 0A bra ?nan ; fac=inf & arg=0 so result=nan |
||
2067 | 4587 F84CCA 24 3D ?fv: bit argst ; fac is valid, so now check arg |
||
2068 | 4588 F84CCC 10 0B bpl ?vv ; arg too is valid |
||
2069 | 4589 F84CCE 50 15 bvc ?mv ; fac=x & arg=nan so result=nan |
||
2070 | 4590 F84CD0 24 25 bit facst ; fac=x & arg=inf so check if fac=0 |
||
2071 | 4591 F84CD2 50 11 bvc ?mv ; fac not null & arg=inf so result=inf |
||
2072 | 4592 F84CD4 20 74 4E ?nan: jsr fldnan ; fac=0 & arg=inf so result=nan |
||
2073 | 4593 F84CD7 80 0F bra ?skp ; skip resturn & exit with CF=1 |
||
2074 | 4594 F84CD9 18 ?vv: clc ; now result is valid |
||
2075 | 4595 F84CDA 70 09 bvs ?mv ; arg=0 so result=0 |
||
2076 | 4596 F84CDC 24 25 bit facst ; fac=0? |
||
2077 | 4597 F84CDE 50 0A bvc ?end ; no, return to mult operation |
||
2078 | 4598 F84CE0 20 56 4E jsr fldz ; result=0 (with CF=0) |
||
2079 | 4599 F84CE3 80 03 bra ?skp |
||
2080 | 4600 F84CE5 20 0C 84 ?mv: jsr mvatof ; move arg to fac (preserve CF) |
||
2081 | 4601 F84CE8 68 ?skp: pla ; skip return address |
||
2082 | 4602 F84CE9 68 pla |
||
2083 | 4603 F84CEA 60 ?end: rts |
||
2084 | 4604 |
||
2085 | 4605 ; divtst - test operands before to execute division |
||
2086 | 4606 ; |
||
2087 | 4607 ; This routine test fac & arg for validity, set the sign of the result, |
||
2088 | 4608 ; and return to the caller for any abnormal condition: |
||
2089 | 4609 ; |
||
2090 | 4610 ; 1) return nan if fac=nan or arg=nan |
||
2091 | 4611 ; 2) return nan if fac=0 and arg=0 |
||
2092 | 4612 ; 3) return nan if fac=+/-inf and arg=+/-inf |
||
2093 | 4613 ; 4) return +inf if arg=+inf and fac>=0 |
||
2094 | 4614 ; 5) return +inf if arg=-inf and fac<0 |
||
2095 | 4615 ; 6) return -inf if arg=-inf and fac>=0 |
||
2096 | 4616 ; 7) return -inf if arg=+inf and fac<0 |
||
2097 | 4617 ; 8) return +inf if arg>0 and fac=0 |
||
2098 | 4618 ; 9) return -inf if arg<0 and fac=0 |
||
2099 | 4619 ; 10) return 0 if arg=0 and fac=+/-inf |
||
2100 | 4620 ; |
||
2101 | 4621 ; This routine is used internally and not intended for end use. |
||
2102 | 4622 ; |
||
2103 | 4623 ;------ |
||
2104 | 4624 F84CEB divtst: |
||
2105 | 4625 ;------ |
||
2106 | 4626 F84CEB A5 24 lda facsgn ; compare sign |
||
2107 | 4627 F84CED 45 3C eor argsgn |
||
2108 | 4628 F84CEF 85 24 sta facsgn ; set result sign |
||
2109 | Tue Jul 17 11:00:18 2018 Page 35 |
||
2110 | |||
2111 | |||
2112 | |||
2113 | |||
2114 | 4629 F84CF1 85 3C sta argsgn |
||
2115 | 4630 F84CF3 38 sec ; invalid result flag |
||
2116 | 4631 F84CF4 24 25 bit facst ; test fac |
||
2117 | 4632 F84CF6 10 08 bpl ?fv ; fac is valid |
||
2118 | 4633 F84CF8 50 29 bvc ?skp ; fac=nan so result=nan |
||
2119 | 4634 F84CFA 24 3D bit argst ; fac=inf so check arg |
||
2120 | 4635 F84CFC 30 18 bmi ?nan ; fac=inf & arg=inf/nan so result=nan |
||
2121 | 4636 F84CFE 80 11 bra ?z ; fac=inf & arg=y so result=0 |
||
2122 | 4637 F84D00 A5 3D ?fv: lda argst ; fac is valid, so now check arg |
||
2123 | 4638 F84D02 30 1C bmi ?mv ; fac=x & arg=nan/inf so result=nan/inf |
||
2124 | 4639 F84D04 25 25 and facst |
||
2125 | 4640 F84D06 0A asl a ; both null? |
||
2126 | 4641 F84D07 30 0D bmi ?nan ; yes so result=nan |
||
2127 | 4642 F84D09 24 25 bit facst |
||
2128 | 4643 F84D0B 70 0E bvs ?inf |
||
2129 | 4644 F84D0D 24 3D bit argst |
||
2130 | 4645 F84D0F 50 14 bvc ?end |
||
2131 | 4646 F84D11 20 56 4E ?z: jsr fldz ; result=0 (with CF=0) |
||
2132 | 4647 F84D14 80 0D bra ?skp |
||
2133 | 4648 F84D16 20 74 4E ?nan: jsr fldnan ; fac=0 & arg=0 so result=nan |
||
2134 | 4649 F84D19 80 08 bra ?skp ; skip resturn & exit with CF=1 |
||
2135 | 4650 F84D1B 20 7D 4E ?inf: jsr fldinf |
||
2136 | 4651 F84D1E 80 03 bra ?skp |
||
2137 | 4652 F84D20 20 0C 84 ?mv: jsr mvatof ; move arg to fac (preserve CF) |
||
2138 | 4653 F84D23 68 ?skp: pla ; skip return address |
||
2139 | 4654 F84D24 68 pla |
||
2140 | 4655 F84D25 60 ?end: rts |
||
2141 | 4656 |
||
2142 | 4657 ;--------------------------------------------------------------------------- |
||
2143 | 4658 ; pack/unpack to/from 128 bit quadruple-precision IEEE format |
||
2144 | 4659 ; these routines convert to/from internal format from/to std. IEEE format |
||
2145 | 4660 ;--------------------------------------------------------------------------- |
||
2146 | 4661 |
||
2147 | 4662 ; frndm - round 128-bit fac mantissa to 113-bit mantissa |
||
2148 | 4663 ; |
||
2149 | 4664 ; standard rounding method: round to nearest and tie to even |
||
2150 | 4665 ; |
||
2151 | 4666 ; let G = (guard bits)*2 and L = lsb significand: |
||
2152 | 4667 ; |
||
2153 | 4668 ; if G < $8000 then round down (truncate) |
||
2154 | 4669 ; if G > $8000 then round up |
||
2155 | 4670 ; if G = $8000 then 'tie even': |
||
2156 | 4671 ; if L = 0 then round down (truncate) |
||
2157 | 4672 ; else round up |
||
2158 | 4673 ; |
||
2159 | 4674 ; if exponent equal to $7FFE and mantissa is all 1's, no round up take place, |
||
2160 | 4675 ; to avoid ovorflow |
||
2161 | 4676 ; |
||
2162 | 4677 ; The main use of this routine is to round fac before to convert to IEEE |
||
2163 | 4678 ; format, but can be called after any operation (of course losing guard bits) |
||
2164 | 4679 ; |
||
2165 | 4680 ;----- |
||
2166 | 4681 F84D26 frndm: |
||
2167 | 4682 ;----- |
||
2168 | 4683 F84D26 CPU16 |
||
2169 | 4684 F84D26 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
2170 | 4685 .LONGA on |
||
2171 | Tue Jul 17 11:00:18 2018 Page 36 |
||
2172 | |||
2173 | |||
2174 | |||
2175 | |||
2176 | 4686 .LONGI on |
||
2177 | 4687 .MNLIST |
||
2178 | 4688 F84D28 A5 12 lda facm ; check guard bits |
||
2179 | 4689 F84D2A AA tax ; retain guard bits (G) |
||
2180 | 4690 F84D2B 29 00 80 and #$8000 ; mask bit 15 (significand lsb) |
||
2181 | 4691 F84D2E 85 12 sta facm ; clear guard bits (G) |
||
2182 | 4692 F84D30 A8 tay ; Y=lsb significand (L) |
||
2183 | 4693 F84D31 F0 07 beq ?rnd ; if bit 15=0 always possible to round up |
||
2184 | 4694 F84D33 A5 22 lda facexp ; we check exponent for possible overflow |
||
2185 | 4695 F84D35 20 AF 4A jsr chkovf |
||
2186 | 4696 F84D38 B0 14 bcs ?done ; no round is possible (avoid overflow) |
||
2187 | 4697 F84D3A 8A ?rnd: txa ; check guard bits |
||
2188 | 4698 F84D3B 0A asl a |
||
2189 | 4699 F84D3C C9 00 80 cmp #$8000 |
||
2190 | 4700 F84D3F 90 0D bcc ?done ; G < $8000 so round down (truncate) |
||
2191 | 4701 F84D41 D0 03 bne ?cf ; G > $8000 so round up (CF=1 here) |
||
2192 | 4702 F84D43 98 tya ; G = $8000 so check L (lsb significand) |
||
2193 | 4703 F84D44 10 08 bpl ?done ; if L=0 round down -- tie even (truncate) |
||
2194 | 4704 F84D46 98 ?cf: tya ; here CF=1 -- round up |
||
2195 | 4705 F84D47 69 FF 7F adc #$7FFF ; really add $8000 |
||
2196 | 4706 F84D4A 85 12 sta facm ; lsb sigificand |
||
2197 | 4707 F84D4C B0 03 bcs ?inc ; mantissa increment, because carry from lsb |
||
2198 | 4708 F84D4E ?done: CPU08 |
||
2199 | 4709 F84D4E E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
2200 | 4710 .LONGA off |
||
2201 | 4711 .LONGI off |
||
2202 | 4712 .MNLIST |
||
2203 | 4713 F84D50 60 rts |
||
2204 | 4714 F84D51 4C 85 4A ?inc: jmp incfac ; now this increment never cause overflow |
||
2205 | 4715 |
||
2206 | 4716 |
||
2207 | 4717 ; pack - pack fac & store in memory in std. quadruple precision IEEE format |
||
2208 | 4718 ; |
||
2209 | 4719 ; Main routine to store in memory a floating point number |
||
2210 | 4720 ; |
||
2211 | 4721 ; entry: |
||
2212 | 4722 ; fac = float point |
||
2213 | 4723 ; A = low memory address |
||
2214 | 4724 ; X = high memory address |
||
2215 | 4725 ; Y = memory bank |
||
2216 | 4726 ; |
||
2217 | 4727 ; exit: |
||
2218 | 4728 ; quadruple precision stored in memory |
||
2219 | 4729 ; |
||
2220 | 4730 ; This routine round 128-bit fac mantissa to 113-bit mantissa, pack to |
||
2221 | 4731 ; quadruple precision IEEE standard format, and store it in memory |
||
2222 | 4732 ; |
||
2223 | 4733 ;----- |
||
2224 | 4734 F84D54 fpack: |
||
2225 | 4735 ;----- |
||
2226 | 4736 F84D54 85 42 sta fcp ; set long pointer to memory buffer |
||
2227 | 4737 F84D56 86 43 stx fcp+1 |
||
2228 | 4738 F84D58 84 44 sty fcp+2 |
||
2229 | 4739 F84D5A 20 26 4D jsr frndm ; round fac to 113 bit mantissa |
||
2230 | 4740 F84D5D ACC16 |
||
2231 | 4741 F84D5D C2 20 rep #PMFLAG |
||
2232 | 4742 .LONGA on |
||
2233 | Tue Jul 17 11:00:18 2018 Page 37 |
||
2234 | |||
2235 | |||
2236 | |||
2237 | |||
2238 | 4743 .MNLIST |
||
2239 | 4744 F84D5F A5 12 lda facm |
||
2240 | 4745 F84D61 0A asl a ; rotate lsb of packed format |
||
2241 | 4746 F84D62 A5 14 lda facm+2 ; rotate all remaining 112 bits... |
||
2242 | 4747 F84D64 2A rol a |
||
2243 | 4748 F84D65 87 42 sta [fcp] ; ...and store |
||
2244 | 4749 F84D67 A5 16 lda facm+4 |
||
2245 | 4750 F84D69 2A rol a |
||
2246 | 4751 F84D6A A0 02 ldy #2 |
||
2247 | 4752 F84D6C 97 42 sta [fcp],y |
||
2248 | 4753 F84D6E A5 18 lda facm+6 |
||
2249 | 4754 F84D70 2A rol a |
||
2250 | 4755 F84D71 A0 04 ldy #4 |
||
2251 | 4756 F84D73 97 42 sta [fcp],y |
||
2252 | 4757 F84D75 A5 1A lda facm+8 |
||
2253 | 4758 F84D77 2A rol a |
||
2254 | 4759 F84D78 A0 06 ldy #6 |
||
2255 | 4760 F84D7A 97 42 sta [fcp],y |
||
2256 | 4761 F84D7C A5 1C lda facm+10 |
||
2257 | 4762 F84D7E 2A rol a |
||
2258 | 4763 F84D7F A0 08 ldy #8 |
||
2259 | 4764 F84D81 97 42 sta [fcp],y |
||
2260 | 4765 F84D83 A5 1E lda facm+12 |
||
2261 | 4766 F84D85 2A rol a |
||
2262 | 4767 F84D86 A0 0A ldy #10 |
||
2263 | 4768 F84D88 97 42 sta [fcp],y |
||
2264 | 4769 F84D8A A5 20 lda facm+14 |
||
2265 | 4770 F84D8C 2A rol a ; CF = hidden bit (msb) |
||
2266 | 4771 F84D8D A0 0C ldy #12 |
||
2267 | 4772 F84D8F 97 42 sta [fcp],y |
||
2268 | 4773 F84D91 A5 22 lda facexp |
||
2269 | 4774 F84D93 B0 03 bcs ?fn ; CF=1 mean normal float |
||
2270 | 4775 F84D95 A9 00 00 lda #0 ; subnormal float or zero |
||
2271 | 4776 F84D98 A6 24 ?fn: ldx facsgn |
||
2272 | 4777 F84D9A 10 03 bpl ?exp ; positive float |
||
2273 | 4778 F84D9C 09 00 80 ora #$8000 ; negative float |
||
2274 | 4779 F84D9F A0 0E ?exp: ldy #14 |
||
2275 | 4780 F84DA1 97 42 sta [fcp],y |
||
2276 | 4781 F84DA3 ACC08 |
||
2277 | 4782 F84DA3 E2 20 sep #PMFLAG |
||
2278 | 4783 .LONGA off |
||
2279 | 4784 .MNLIST |
||
2280 | 4785 F84DA5 60 rts |
||
2281 | 4786 |
||
2282 | 4787 ; unpack - get a quadruple precision IEEE format from memory and store in fac |
||
2283 | 4788 ; |
||
2284 | 4789 ; Main routine to load fac with a floating point number stored in memory |
||
2285 | 4790 ; |
||
2286 | 4791 ; entry: |
||
2287 | 4792 ; A = low memory address |
||
2288 | 4793 ; X = high memory address |
||
2289 | 4794 ; Y = memory bank |
||
2290 | 4795 ; |
||
2291 | 4796 ; exit: |
||
2292 | 4797 ; fac = floating point number in internal fortmat |
||
2293 | 4798 ; |
||
2294 | 4799 ; |
||
2295 | Tue Jul 17 11:00:18 2018 Page 38 |
||
2296 | |||
2297 | |||
2298 | |||
2299 | |||
2300 | 4800 ;------- |
||
2301 | 4801 F84DA6 funpack: |
||
2302 | 4802 ;------- |
||
2303 | 4803 F84DA6 85 42 sta fcp ; set long pointer to memory buffer |
||
2304 | 4804 F84DA8 86 43 stx fcp+1 |
||
2305 | 4805 F84DAA 84 44 sty fcp+2 |
||
2306 | 4806 F84DAC ACC16CLC ; CF=0: assume hidden bit = 0 |
||
2307 | 4807 F84DAC C2 21 rep #(PMFLAG.OR.PCFLAG) |
||
2308 | 4808 .LONGA on |
||
2309 | 4809 .MNLIST |
||
2310 | 4810 F84DAE A2 00 ldx #0 ; assume positive sign |
||
2311 | 4811 F84DB0 A0 0E ldy #14 |
||
2312 | 4812 F84DB2 B7 42 lda [fcp],y ; exponent |
||
2313 | 4813 F84DB4 10 01 bpl ?fp ; positive float |
||
2314 | 4814 F84DB6 CA dex ; negative float |
||
2315 | 4815 F84DB7 86 24 ?fp: stx facsgn |
||
2316 | 4816 F84DB9 A2 00 ldx #$00 ; assume normal float |
||
2317 | 4817 F84DBB 29 FF 7F and #$7FFF ; mask off sign |
||
2318 | 4818 F84DBE 85 22 sta facexp |
||
2319 | 4819 F84DC0 F0 01 beq ?get ; zero or subnormal (msb=0) |
||
2320 | 4820 F84DC2 38 sec ; hidden bit: msb=1 |
||
2321 | 4821 F84DC3 A0 0C ?get: ldy #12 |
||
2322 | 4822 F84DC5 B7 42 lda [fcp],y ; significand |
||
2323 | 4823 F84DC7 6A ror a ; rotate in hidden bit... |
||
2324 | 4824 F84DC8 85 20 sta facm+14 ; ...then rotate all 112 bits... |
||
2325 | 4825 F84DCA A0 0A ldy #10 ; ...and store to fac mantissa |
||
2326 | 4826 F84DCC B7 42 lda [fcp],y |
||
2327 | 4827 F84DCE 6A ror a |
||
2328 | 4828 F84DCF 85 1E sta facm+12 |
||
2329 | 4829 F84DD1 A0 08 ldy #8 |
||
2330 | 4830 F84DD3 B7 42 lda [fcp],y |
||
2331 | 4831 F84DD5 6A ror a |
||
2332 | 4832 F84DD6 85 1C sta facm+10 |
||
2333 | 4833 F84DD8 A0 06 ldy #6 |
||
2334 | 4834 F84DDA B7 42 lda [fcp],y |
||
2335 | 4835 F84DDC 6A ror a |
||
2336 | 4836 F84DDD 85 1A sta facm+8 |
||
2337 | 4837 F84DDF A0 04 ldy #4 |
||
2338 | 4838 F84DE1 B7 42 lda [fcp],y |
||
2339 | 4839 F84DE3 6A ror a |
||
2340 | 4840 F84DE4 85 18 sta facm+6 |
||
2341 | 4841 F84DE6 A0 02 ldy #2 |
||
2342 | 4842 F84DE8 B7 42 lda [fcp],y |
||
2343 | 4843 F84DEA 6A ror a |
||
2344 | 4844 F84DEB 85 16 sta facm+4 |
||
2345 | 4845 F84DED A7 42 lda [fcp] |
||
2346 | 4846 F84DEF 6A ror a |
||
2347 | 4847 F84DF0 85 14 sta facm+2 |
||
2348 | 4848 F84DF2 8A txa ; shift in lsb |
||
2349 | 4849 F84DF3 6A ror a ; <14:0> are all zero (guard bits) |
||
2350 | 4850 F84DF4 85 12 sta facm |
||
2351 | 4851 F84DF6 A5 22 lda facexp ; check exponent |
||
2352 | 4852 F84DF8 F0 17 beq ?chkz ; if exp=0 check if fac=0 |
||
2353 | 4853 F84DFA C9 FF 7F cmp #INFEXP |
||
2354 | 4854 F84DFD 90 2A bcc ?st ; valid float, set status |
||
2355 | 4855 F84DFF A9 FF 7F lda #INFEXP |
||
2356 | 4856 F84E02 85 22 sta facexp ; fac=inf or fac=nan |
||
2357 | Tue Jul 17 11:00:18 2018 Page 39 |
||
2358 | |||
2359 | |||
2360 | |||
2361 | |||
2362 | 4857 F84E04 A2 C0 ldx #$C0 ; assume inf |
||
2363 | 4858 F84E06 A5 20 lda facm+14 ; check type |
||
2364 | 4859 F84E08 C9 00 80 cmp #INFSND |
||
2365 | 4860 F84E0B F0 1C beq ?st ; set inf in fac stastus |
||
2366 | 4861 F84E0D A2 80 ldx #$80 ; set nan in fac status |
||
2367 | 4862 F84E0F 80 18 bra ?st |
||
2368 | 4863 F84E11 A5 12 ?chkz: lda facm ; exponent is zero: check if fac=0 |
||
2369 | 4864 F84E13 05 14 ora facm+2 |
||
2370 | 4865 F84E15 05 16 ora facm+4 |
||
2371 | 4866 F84E17 05 18 ora facm+6 |
||
2372 | 4867 F84E19 05 1A ora facm+8 |
||
2373 | 4868 F84E1B 05 1C ora facm+10 |
||
2374 | 4869 F84E1D 05 1E ora facm+12 |
||
2375 | 4870 F84E1F 05 20 ora facm+14 |
||
2376 | 4871 F84E21 D0 04 bne ?sn ; fac is subnormal |
||
2377 | 4872 F84E23 A2 40 ldx #$40 ; fac is zero |
||
2378 | 4873 F84E25 80 02 bra ?st |
||
2379 | 4874 F84E27 E6 22 ?sn: inc facexp ; subnormal exponent = 1 |
||
2380 | 4875 F84E29 86 25 ?st: stx facst ; set fac status |
||
2381 | 4876 F84E2B ACC08 |
||
2382 | 4877 F84E2B E2 20 sep #PMFLAG |
||
2383 | 4878 .LONGA off |
||
2384 | 4879 .MNLIST |
||
2385 | 4880 F84E2D 60 rts |
||
2386 | 4881 |
||
2387 | 4882 ;--------------------------------------------------------------------------- |
||
2388 | 4883 ; load fac & arg with special values |
||
2389 | 4884 ;--------------------------------------------------------------------------- |
||
2390 | 4885 |
||
2391 | 4886 ; fldp1 - load the constant +1.0 into fac |
||
2392 | 4887 ; |
||
2393 | 4888 ; exit: |
||
2394 | 4889 ; fac = +1.0 |
||
2395 | 4890 ; |
||
2396 | 4891 ;----- |
||
2397 | 4892 F84E2E fldp1: |
||
2398 | 4893 ;----- |
||
2399 | 4894 F84E2E 64 24 stz facsgn |
||
2400 | 4895 F84E30 80 04 bra fld1 |
||
2401 | 4896 |
||
2402 | 4897 ; fldm1 - load the constant -1.0 into fac |
||
2403 | 4898 ; |
||
2404 | 4899 ; exit: |
||
2405 | 4900 ; fac = -1.0 |
||
2406 | 4901 ; |
||
2407 | 4902 ;----- |
||
2408 | 4903 F84E32 fldm1: |
||
2409 | 4904 ;----- |
||
2410 | 4905 F84E32 A9 FF lda #$FF |
||
2411 | 4906 F84E34 85 24 sta facsgn |
||
2412 | 4907 |
||
2413 | 4908 ;---- |
||
2414 | 4909 F84E36 fld1: |
||
2415 | 4910 ;---- |
||
2416 | 4911 F84E36 ACC16 |
||
2417 | 4912 F84E36 C2 20 rep #PMFLAG |
||
2418 | 4913 .LONGA on |
||
2419 | Tue Jul 17 11:00:18 2018 Page 40 |
||
2420 | |||
2421 | |||
2422 | |||
2423 | |||
2424 | 4914 .MNLIST |
||
2425 | 4915 F84E38 A9 FF 3F lda #EBIAS |
||
2426 | 4916 F84E3B 85 22 sta facexp |
||
2427 | 4917 F84E3D A9 00 80 lda #$8000 |
||
2428 | 4918 F84E40 85 20 sta facm+14 |
||
2429 | 4919 F84E42 64 12 stz facm |
||
2430 | 4920 F84E44 64 14 stz facm+2 |
||
2431 | 4921 F84E46 64 16 stz facm+4 |
||
2432 | 4922 F84E48 64 18 stz facm+6 |
||
2433 | 4923 F84E4A 64 1A stz facm+8 |
||
2434 | 4924 F84E4C 64 1C stz facm+10 |
||
2435 | 4925 F84E4E 64 1E stz facm+12 |
||
2436 | 4926 F84E50 ACC08 |
||
2437 | 4927 F84E50 E2 20 sep #PMFLAG |
||
2438 | 4928 .LONGA off |
||
2439 | 4929 .MNLIST |
||
2440 | 4930 F84E52 64 25 stz facst |
||
2441 | 4931 F84E54 18 clc |
||
2442 | 4932 F84E55 60 rts |
||
2443 | 4933 |
||
2444 | 4934 ; fldz - load the constant 0.0 into fac |
||
2445 | 4935 ; |
||
2446 | 4936 ; exit: |
||
2447 | 4937 ; fac = 0.0 |
||
2448 | 4938 ; |
||
2449 | 4939 ;---- |
||
2450 | 4940 F84E56 fldz: |
||
2451 | 4941 ;---- |
||
2452 | 4942 F84E56 ACC16 |
||
2453 | 4943 F84E56 C2 20 rep #PMFLAG |
||
2454 | 4944 .LONGA on |
||
2455 | 4945 .MNLIST |
||
2456 | 4946 F84E58 64 20 stz facm+14 |
||
2457 | 4947 F84E5A 64 22 stz facexp |
||
2458 | 4948 F84E5C 64 12 stz facm |
||
2459 | 4949 F84E5E 64 14 stz facm+2 |
||
2460 | 4950 F84E60 64 16 stz facm+4 |
||
2461 | 4951 F84E62 64 18 stz facm+6 |
||
2462 | 4952 F84E64 64 1A stz facm+8 |
||
2463 | 4953 F84E66 64 1C stz facm+10 |
||
2464 | 4954 F84E68 64 1E stz facm+12 |
||
2465 | 4955 F84E6A ACC08 |
||
2466 | 4956 F84E6A E2 20 sep #PMFLAG |
||
2467 | 4957 .LONGA off |
||
2468 | 4958 .MNLIST |
||
2469 | 4959 F84E6C 64 24 stz facsgn |
||
2470 | 4960 F84E6E A9 40 lda #$40 |
||
2471 | 4961 F84E70 85 25 sta facst |
||
2472 | 4962 F84E72 18 noer: clc |
||
2473 | 4963 F84E73 60 rts |
||
2474 | 4964 |
||
2475 | 4965 ; fldnan - set fac=nan |
||
2476 | 4966 ;------ |
||
2477 | 4967 F84E74 fldnan: |
||
2478 | 4968 ;------ |
||
2479 | 4969 F84E74 ACC16 |
||
2480 | 4970 F84E74 C2 20 rep #PMFLAG |
||
2481 | Tue Jul 17 11:00:18 2018 Page 41 |
||
2482 | |||
2483 | |||
2484 | |||
2485 | |||
2486 | 4971 .LONGA on |
||
2487 | 4972 .MNLIST |
||
2488 | 4973 F84E76 A9 00 C0 lda #NANSND |
||
2489 | 4974 F84E79 A2 80 ldx #$80 ; nan flag |
||
2490 | 4975 F84E7B 80 07 bra fldinv |
||
2491 | 4976 |
||
2492 | 4977 ; fldinf - set fac=inf |
||
2493 | 4978 ;------ |
||
2494 | 4979 F84E7D fldinf: |
||
2495 | 4980 ;------ |
||
2496 | 4981 F84E7D ACC16 |
||
2497 | 4982 F84E7D C2 20 rep #PMFLAG |
||
2498 | 4983 .LONGA on |
||
2499 | 4984 .MNLIST |
||
2500 | 4985 F84E7F A9 00 80 lda #INFSND |
||
2501 | 4986 F84E82 A2 C0 ldx #$C0 ; inf flag |
||
2502 | 4987 |
||
2503 | 4988 F84E84 fldinv: |
||
2504 | 4989 F84E84 85 20 sta facm+14 ; set msb |
||
2505 | 4990 F84E86 A9 FF 7F lda #INFEXP ; set invalid exponent |
||
2506 | 4991 F84E89 85 22 sta facexp |
||
2507 | 4992 F84E8B 64 1E stz facm+12 |
||
2508 | 4993 F84E8D 64 1C stz facm+10 |
||
2509 | 4994 F84E8F 64 1A stz facm+8 |
||
2510 | 4995 F84E91 64 18 stz facm+6 |
||
2511 | 4996 F84E93 64 16 stz facm+4 |
||
2512 | 4997 F84E95 64 14 stz facm+2 |
||
2513 | 4998 F84E97 64 12 stz facm |
||
2514 | 4999 F84E99 ACC08 |
||
2515 | 5000 F84E99 E2 20 sep #PMFLAG |
||
2516 | 5001 .LONGA off |
||
2517 | 5002 .MNLIST |
||
2518 | 5003 F84E9B 86 25 stx facst |
||
2519 | 5004 F84E9D 38 sec ; return error condition |
||
2520 | 5005 F84E9E 60 rts |
||
2521 | 5006 |
||
2522 | 5007 ; ldahalf - load the constant 0.5 into arg |
||
2523 | 5008 ; |
||
2524 | 5009 ; exit: |
||
2525 | 5010 ; arg = 0.5 |
||
2526 | 5011 ; |
||
2527 | 5012 ;------- |
||
2528 | 5013 F84E9F ldahalf: |
||
2529 | 5014 ;------- |
||
2530 | 5015 F84E9F ACC16 |
||
2531 | 5016 F84E9F C2 20 rep #PMFLAG |
||
2532 | 5017 .LONGA on |
||
2533 | 5018 .MNLIST |
||
2534 | 5019 F84EA1 A9 FE 3F lda #EBIAS-1 |
||
2535 | 5020 F84EA4 80 0C bra amsb |
||
2536 | 5021 |
||
2537 | 5022 ; ldaone - load the constant +1.0 into arg |
||
2538 | 5023 ; |
||
2539 | 5024 ; exit: |
||
2540 | 5025 ; arg = +1.0 |
||
2541 | 5026 ; |
||
2542 | 5027 ;------ |
||
2543 | Tue Jul 17 11:00:18 2018 Page 42 |
||
2544 | |||
2545 | |||
2546 | |||
2547 | |||
2548 | 5028 F84EA6 ldaone: |
||
2549 | 5029 ;------ |
||
2550 | 5030 F84EA6 ACC16 |
||
2551 | 5031 F84EA6 C2 20 rep #PMFLAG |
||
2552 | 5032 .LONGA on |
||
2553 | 5033 .MNLIST |
||
2554 | 5034 F84EA8 A9 FF 3F lda #EBIAS |
||
2555 | 5035 F84EAB 80 05 bra amsb |
||
2556 | 5036 |
||
2557 | 5037 ; ldatwo - load the constant +2.0 into arg |
||
2558 | 5038 ; |
||
2559 | 5039 ; exit: |
||
2560 | 5040 ; arg = +2.0 |
||
2561 | 5041 ; |
||
2562 | 5042 ;------ |
||
2563 | 5043 F84EAD ldatwo: |
||
2564 | 5044 ;------ |
||
2565 | 5045 F84EAD ACC16 |
||
2566 | 5046 F84EAD C2 20 rep #PMFLAG |
||
2567 | 5047 .LONGA on |
||
2568 | 5048 .MNLIST |
||
2569 | 5049 F84EAF A9 00 40 lda #EBIAS+1 |
||
2570 | 5050 |
||
2571 | 5051 F84EB2 amsb: |
||
2572 | 5052 F84EB2 85 3A sta argexp ; store exponent |
||
2573 | 5053 F84EB4 A9 00 80 lda #$8000 |
||
2574 | 5054 F84EB7 85 38 sta argm+14 ; high word = $8000 |
||
2575 | 5055 F84EB9 64 2A stz argm ; reset all remaining bits |
||
2576 | 5056 F84EBB 64 2C stz argm+2 |
||
2577 | 5057 F84EBD 64 2E stz argm+4 |
||
2578 | 5058 F84EBF 64 30 stz argm+6 |
||
2579 | 5059 F84EC1 64 32 stz argm+8 |
||
2580 | 5060 F84EC3 64 34 stz argm+10 |
||
2581 | 5061 F84EC5 64 36 stz argm+12 |
||
2582 | 5062 F84EC7 64 3C stz argsgn ; positive sign |
||
2583 | 5063 F84EC9 ACC08 |
||
2584 | 5064 F84EC9 E2 20 sep #PMFLAG |
||
2585 | 5065 .LONGA off |
||
2586 | 5066 .MNLIST |
||
2587 | 5067 F84ECB 18 clc |
||
2588 | 5068 F84ECC 60 rts |
||
2589 | 5069 |
||
2590 | 5070 ;--------------------------------------------------------------------------- |
||
2591 | 5071 ; conversion from integer to float & from float to integer |
||
2592 | 5072 ;--------------------------------------------------------------------------- |
||
2593 | 5073 |
||
2594 | 5074 ; fldu128 - load fac with an unsigned 128 bit integer (n) |
||
2595 | 5075 ; |
||
2596 | 5076 ; entry: |
||
2597 | 5077 ; tm..tm+15 = n, unsigned 128 bit integer |
||
2598 | 5078 ; |
||
2599 | 5079 ; exit: |
||
2600 | 5080 ; fac = n |
||
2601 | 5081 ; |
||
2602 | 5082 ;------- |
||
2603 | 5083 F84ECD fldu128: |
||
2604 | 5084 ;------- |
||
2605 | Tue Jul 17 11:00:18 2018 Page 43 |
||
2606 | |||
2607 | |||
2608 | |||
2609 | |||
2610 | 5085 F84ECD 20 56 4E jsr fldz ; set fac=0 |
||
2611 | 5086 F84ED0 64 24 stz facsgn |
||
2612 | 5087 F84ED2 ACC16 |
||
2613 | 5088 F84ED2 C2 20 rep #PMFLAG |
||
2614 | 5089 .LONGA on |
||
2615 | 5090 .MNLIST |
||
2616 | 5091 F84ED4 A5 0E lda tm+14 ; load 128 bit value |
||
2617 | 5092 F84ED6 85 20 sta facm+14 |
||
2618 | 5093 F84ED8 A5 0C lda tm+12 |
||
2619 | 5094 F84EDA 85 1E sta facm+12 |
||
2620 | 5095 F84EDC A5 0A lda tm+10 |
||
2621 | 5096 F84EDE 85 1C sta facm+10 |
||
2622 | 5097 F84EE0 A5 08 lda tm+8 |
||
2623 | 5098 F84EE2 85 1A sta facm+8 |
||
2624 | 5099 F84EE4 A5 06 lda tm+6 |
||
2625 | 5100 F84EE6 85 18 sta facm+6 |
||
2626 | 5101 F84EE8 A5 04 lda tm+4 |
||
2627 | 5102 F84EEA 85 16 sta facm+4 |
||
2628 | 5103 F84EEC A5 02 lda tm+2 |
||
2629 | 5104 F84EEE 85 14 sta facm+2 |
||
2630 | 5105 F84EF0 A5 00 lda tm |
||
2631 | 5106 F84EF2 85 12 sta facm |
||
2632 | 5107 F84EF4 05 14 ora facm+2 ; test if n=0 |
||
2633 | 5108 F84EF6 05 16 ora facm+4 |
||
2634 | 5109 F84EF8 05 18 ora facm+6 |
||
2635 | 5110 F84EFA 05 1A ora facm+8 |
||
2636 | 5111 F84EFC 05 1C ora facm+10 |
||
2637 | 5112 F84EFE 05 1E ora facm+12 |
||
2638 | 5113 F84F00 05 20 ora facm+14 |
||
2639 | 5114 F84F02 F0 29 beq okz ; n=0 |
||
2640 | 5115 F84F04 A9 7E 40 lda #BIAS128 ; biased exponent for 128 bit value |
||
2641 | 5116 F84F07 80 66 bra fldu |
||
2642 | 5117 |
||
2643 | 5118 .LONGA off |
||
2644 | 5119 |
||
2645 | 5120 ; fldu64 - load fac with an unsigned 64 bit integer (n) |
||
2646 | 5121 ; |
||
2647 | 5122 ; entry: |
||
2648 | 5123 ; tm..tm+7 = n, unsigned 64 bit integer |
||
2649 | 5124 ; |
||
2650 | 5125 ; exit: |
||
2651 | 5126 ; fac = n |
||
2652 | 5127 ; |
||
2653 | 5128 ;------ |
||
2654 | 5129 F84F09 fldu64: |
||
2655 | 5130 ;------ |
||
2656 | 5131 F84F09 20 56 4E jsr fldz ; set fac=0 |
||
2657 | 5132 F84F0C 64 24 stz facsgn |
||
2658 | 5133 F84F0E ACC16 |
||
2659 | 5134 F84F0E C2 20 rep #PMFLAG |
||
2660 | 5135 .LONGA on |
||
2661 | 5136 .MNLIST |
||
2662 | 5137 F84F10 A5 06 lda tm+6 ; load 64 bit value |
||
2663 | 5138 F84F12 85 20 sta facm+14 |
||
2664 | 5139 F84F14 A5 04 lda tm+4 |
||
2665 | 5140 F84F16 85 1E sta facm+12 |
||
2666 | 5141 F84F18 A5 02 lda tm+2 |
||
2667 | Tue Jul 17 11:00:18 2018 Page 44 |
||
2668 | |||
2669 | |||
2670 | |||
2671 | |||
2672 | 5142 F84F1A 85 1C sta facm+10 |
||
2673 | 5143 F84F1C A5 00 lda tm |
||
2674 | 5144 F84F1E 85 1A sta facm+8 |
||
2675 | 5145 F84F20 05 1C ora facm+10 ; test if n=0 |
||
2676 | 5146 F84F22 05 1E ora facm+12 |
||
2677 | 5147 F84F24 05 20 ora facm+14 |
||
2678 | 5148 F84F26 F0 05 beq okz ; n=0 |
||
2679 | 5149 F84F28 A9 3E 40 lda #BIAS64 ; biased exponent for 64 bit value |
||
2680 | 5150 F84F2B 80 42 bra fldu |
||
2681 | 5151 |
||
2682 | 5152 .LONGA off |
||
2683 | 5153 |
||
2684 | 5154 F84F2D okz: ACC08 |
||
2685 | 5155 F84F2D E2 20 sep #PMFLAG |
||
2686 | 5156 .LONGA off |
||
2687 | 5157 .MNLIST |
||
2688 | 5158 F84F2F 18 clc |
||
2689 | 5159 F84F30 60 rts |
||
2690 | 5160 |
||
2691 | 5161 ; fldu32 - load fac with an unsigned 32 bit integer (n) |
||
2692 | 5162 ; |
||
2693 | 5163 ; entry: |
||
2694 | 5164 ; tm..tm+3 = n, unsigned 32 bit integer |
||
2695 | 5165 ; |
||
2696 | 5166 ; exit: |
||
2697 | 5167 ; fac = n |
||
2698 | 5168 ; |
||
2699 | 5169 ;------ |
||
2700 | 5170 F84F31 fldu32: |
||
2701 | 5171 ;------ |
||
2702 | 5172 F84F31 20 56 4E jsr fldz ; set fac=0 |
||
2703 | 5173 F84F34 64 24 stz facsgn |
||
2704 | 5174 F84F36 ACC16 |
||
2705 | 5175 F84F36 C2 20 rep #PMFLAG |
||
2706 | 5176 .LONGA on |
||
2707 | 5177 .MNLIST |
||
2708 | 5178 F84F38 A5 02 lda tm+2 |
||
2709 | 5179 F84F3A 85 20 sta facm+14 ; load 32 bit value |
||
2710 | 5180 F84F3C A5 00 lda tm |
||
2711 | 5181 F84F3E 85 1E sta facm+12 |
||
2712 | 5182 F84F40 05 20 ora facm+14 ; test if n=0 |
||
2713 | 5183 F84F42 F0 E9 beq okz ; n=0 |
||
2714 | 5184 F84F44 A9 1E 40 lda #BIAS32 ; biased exponent for 32 bit value |
||
2715 | 5185 F84F47 80 26 bra fldu |
||
2716 | 5186 |
||
2717 | 5187 .LONGA off |
||
2718 | 5188 |
||
2719 | 5189 ; fldbyt - load fac with an unsigned 8 bit integer (n) |
||
2720 | 5190 ; |
||
2721 | 5191 ; entry: |
||
2722 | 5192 ; A = n, unsigned 8 bit integer |
||
2723 | 5193 ; |
||
2724 | 5194 ; exit: |
||
2725 | 5195 ; fac = n |
||
2726 | 5196 ; |
||
2727 | 5197 ;------ |
||
2728 | 5198 F84F49 fldbyt: |
||
2729 | Tue Jul 17 11:00:18 2018 Page 45 |
||
2730 | |||
2731 | |||
2732 | |||
2733 | |||
2734 | 5199 ;------ |
||
2735 | 5200 F84F49 AA tax ; save A |
||
2736 | 5201 F84F4A 20 56 4E jsr fldz ; set fac=0 |
||
2737 | 5202 F84F4D 64 24 stz facsgn |
||
2738 | 5203 F84F4F 8A txa |
||
2739 | 5204 F84F50 F0 DB beq okz ; n=0 |
||
2740 | 5205 F84F52 86 21 stx facm+15 ; put byte in high order bits |
||
2741 | 5206 F84F54 ACC16 |
||
2742 | 5207 F84F54 C2 20 rep #PMFLAG |
||
2743 | 5208 .LONGA on |
||
2744 | 5209 .MNLIST |
||
2745 | 5210 F84F56 A9 06 40 lda #BIAS8 ; biased exponent for 8 bit value |
||
2746 | 5211 F84F59 80 14 bra fldu |
||
2747 | 5212 |
||
2748 | 5213 .LONGA off |
||
2749 | 5214 F84F5B |
||
2750 | 5215 ; fldu16 - load fac with an unsigned 16 bit integer (n) |
||
2751 | 5216 ; |
||
2752 | 5217 ; entry: |
||
2753 | 5218 ; A = low 8 bit of n, unsigned 16 bit integer |
||
2754 | 5219 ; Y = high 8 bit of n, unsigned 16 bit integer |
||
2755 | 5220 ; |
||
2756 | 5221 ; exit: |
||
2757 | 5222 ; fac = n |
||
2758 | 5223 ; |
||
2759 | 5224 ;------ |
||
2760 | 5225 F84F5B fldu16: |
||
2761 | 5226 ;------ |
||
2762 | 5227 F84F5B AA tax ; save A |
||
2763 | 5228 F84F5C 20 56 4E jsr fldz ; set fac=0 |
||
2764 | 5229 F84F5F 86 20 stx facm+14 ; low 8 bit |
||
2765 | 5230 F84F61 84 21 sty facm+15 ; high 8 bit |
||
2766 | 5231 F84F63 64 24 stz facsgn |
||
2767 | 5232 F84F65 8A txa |
||
2768 | 5233 F84F66 05 21 ora facm+15 ; test if n=0 |
||
2769 | 5234 F84F68 F0 C3 beq okz ; n=0 |
||
2770 | 5235 F84F6A ACC16 |
||
2771 | 5236 F84F6A C2 20 rep #PMFLAG |
||
2772 | 5237 .LONGA on |
||
2773 | 5238 .MNLIST |
||
2774 | 5239 F84F6C A9 0E 40 lda #BIAS16 ; biased exponent for 16 bit value |
||
2775 | 5240 |
||
2776 | 5241 ;---- |
||
2777 | 5242 F84F6F fldu: |
||
2778 | 5243 ;---- |
||
2779 | 5244 F84F6F 85 22 sta facexp ; store exponent |
||
2780 | 5245 F84F71 ACC08 |
||
2781 | 5246 F84F71 E2 20 sep #PMFLAG |
||
2782 | 5247 .LONGA off |
||
2783 | 5248 .MNLIST |
||
2784 | 5249 F84F73 64 25 stz facst ; normal fac <> 0 |
||
2785 | 5250 F84F75 4C 62 46 jmp normfac ; normalize fac |
||
2786 | 5251 |
||
2787 | 5252 ; uitrunc - convert the integral part of fac to unsigned 128 bit integer |
||
2788 | 5253 ; |
||
2789 | 5254 ; this routine truncate toward zero, and ignore fac sign |
||
2790 | 5255 ; |
||
2791 | Tue Jul 17 11:00:18 2018 Page 46 |
||
2792 | |||
2793 | |||
2794 | |||
2795 | |||
2796 | 5256 ; entry: |
||
2797 | 5257 ; fac = x |
||
2798 | 5258 ; |
||
2799 | 5259 ; exit: |
||
2800 | 5260 ; tm..tm+15 = unsigned 128 bit integer = integral part of |x| |
||
2801 | 5261 ; CF = 1 if the integral part of |x| not fit in 128 bit |
||
2802 | 5262 ; |
||
2803 | 5263 ; In overflow condition, or if fac=nan/inf, tm..tm+15 will be filled with |
||
2804 | 5264 ; the max. 128 bit value and the carry flag will be set. |
||
2805 | 5265 ; |
||
2806 | 5266 ;------- |
||
2807 | 5267 F84F78 uitrunc: |
||
2808 | 5268 ;------- |
||
2809 | 5269 F84F78 24 25 bit facst ; valid fac? |
||
2810 | 5270 F84F7A 10 1F bpl ?fv ; yes |
||
2811 | 5271 F84F7C ACC16 ; set tm..tm+15 to max. |
||
2812 | 5272 F84F7C C2 20 rep #PMFLAG |
||
2813 | 5273 .LONGA on |
||
2814 | 5274 .MNLIST |
||
2815 | 5275 F84F7E 38 ?ovf: sec ; invalid flag |
||
2816 | 5276 F84F7F A9 FF FF lda #$FFFF ; set max. |
||
2817 | 5277 F84F82 80 04 bra ?set |
||
2818 | 5278 F84F84 A9 00 00 ?z: lda #0 |
||
2819 | 5279 F84F87 18 ?z1: clc ; valid flag |
||
2820 | 5280 F84F88 85 00 ?set: sta tm |
||
2821 | 5281 F84F8A 85 02 sta tm+2 |
||
2822 | 5282 F84F8C 85 04 sta tm+4 |
||
2823 | 5283 F84F8E 85 06 sta tm+6 |
||
2824 | 5284 F84F90 85 08 sta tm+8 |
||
2825 | 5285 F84F92 85 0A sta tm+10 |
||
2826 | 5286 F84F94 85 0C sta tm+12 |
||
2827 | 5287 F84F96 85 0E sta tm+14 |
||
2828 | 5288 F84F98 ACC08 |
||
2829 | 5289 F84F98 E2 20 sep #PMFLAG |
||
2830 | 5290 .LONGA off |
||
2831 | 5291 .MNLIST |
||
2832 | 5292 F84F9A 60 rts |
||
2833 | 5293 F84F9B ?fv: ACC16 |
||
2834 | 5294 F84F9B C2 20 rep #PMFLAG |
||
2835 | 5295 .LONGA on |
||
2836 | 5296 .MNLIST |
||
2837 | 5297 F84F9D 70 E5 bvs ?z ; fac=0, so return tm=0 |
||
2838 | 5298 F84F9F A5 22 lda facexp |
||
2839 | 5299 F84FA1 F0 E4 beq ?z1 ; fac=0, so return tm=0 |
||
2840 | 5300 F84FA3 38 sec |
||
2841 | 5301 F84FA4 E9 FF 3F sbc #EBIAS ; unbias exponent |
||
2842 | 5302 F84FA7 90 DB bcc ?z ; fac<1, so return tm=0 |
||
2843 | 5303 F84FA9 C9 80 00 cmp #MNTBITS ; limit to 128 bit integer |
||
2844 | 5304 F84FAC B0 D0 bcs ?ovf ; 128 bits integer overflow |
||
2845 | 5305 F84FAE E9 7E 00 sbc #MNTBITS-2 ; take in account CF=0 here |
||
2846 | 5306 F84FB1 AA tax ; A=X=negative count of shift toward right |
||
2847 | 5307 F84FB2 A5 12 lda facm ; move fac mantissa to tm |
||
2848 | 5308 F84FB4 85 00 sta tm |
||
2849 | 5309 F84FB6 A5 14 lda facm+2 |
||
2850 | 5310 F84FB8 85 02 sta tm+2 |
||
2851 | 5311 F84FBA A5 16 lda facm+4 |
||
2852 | 5312 F84FBC 85 04 sta tm+4 |
||
2853 | Tue Jul 17 11:00:18 2018 Page 47 |
||
2854 | |||
2855 | |||
2856 | |||
2857 | |||
2858 | 5313 F84FBE A5 18 lda facm+6 |
||
2859 | 5314 F84FC0 85 06 sta tm+6 |
||
2860 | 5315 F84FC2 A5 1A lda facm+8 |
||
2861 | 5316 F84FC4 85 08 sta tm+8 |
||
2862 | 5317 F84FC6 A5 1C lda facm+10 |
||
2863 | 5318 F84FC8 85 0A sta tm+10 |
||
2864 | 5319 F84FCA A5 1E lda facm+12 |
||
2865 | 5320 F84FCC 85 0C sta tm+12 |
||
2866 | 5321 F84FCE A5 20 lda facm+14 |
||
2867 | 5322 F84FD0 85 0E sta tm+14 |
||
2868 | 5323 F84FD2 ACC08 |
||
2869 | 5324 F84FD2 E2 20 sep #PMFLAG |
||
2870 | 5325 .LONGA off |
||
2871 | 5326 .MNLIST |
||
2872 | 5327 F84FD4 8A txa ; A=negative count of shift toward right |
||
2873 | 5328 F84FD5 F0 05 beq ?done ; no shift so exit |
||
2874 | 5329 F84FD7 A2 00 ldx #tm ; shift tm..tm15 toward right |
||
2875 | 5330 F84FD9 20 3A 47 jsr shrmx ; align integer with exponent |
||
2876 | 5331 F84FDC 18 ?done: clc |
||
2877 | 5332 F84FDD 60 rts |
||
2878 | 5333 |
||
2879 | 5334 ;--------------------------------------------------------------------------- |
||
2880 | 5335 ; rounding routines |
||
2881 | 5336 ;--------------------------------------------------------------------------- |
||
2882 | 5337 |
||
2883 | 5338 ; fceil - returns the smallest f.p. integer greater than or equal the argument |
||
2884 | 5339 ; |
||
2885 | 5340 ; This routine truncates toward plus infinity |
||
2886 | 5341 ; |
||
2887 | 5342 ; entry: |
||
2888 | 5343 ; fac = x |
||
2889 | 5344 ; |
||
2890 | 5345 ; exit: |
||
2891 | 5346 ; fac = y = integral part of x truncated toward plus infinity |
||
2892 | 5347 ; CF = 1 if invalid result(inf or nan) |
||
2893 | 5348 ; |
||
2894 | 5349 ; fceil(3.0) = 3.0 |
||
2895 | 5350 ; fceil(2.3) = 3.0 |
||
2896 | 5351 ; fceil(0.5) = 1.0 |
||
2897 | 5352 ; fceil(-0.5) = 0.0 |
||
2898 | 5353 ; fceil(-2.3) = -2.0 |
||
2899 | 5354 ; fceil(-3.0) = -3.0 |
||
2900 | 5355 ; |
||
2901 | 5356 ;----- |
||
2902 | 5357 F84FDE fceil: |
||
2903 | 5358 ;----- |
||
2904 | 5359 F84FDE 24 25 bit facst |
||
2905 | 5360 F84FE0 10 02 bpl ?fv ; fac is valid |
||
2906 | 5361 F84FE2 38 sec ; return invalid flag |
||
2907 | 5362 F84FE3 60 rts |
||
2908 | 5363 F84FE4 50 04 ?fv: bvc ?nz ; fac <> 0 |
||
2909 | 5364 F84FE6 64 24 stz facsgn ; return fac=0 |
||
2910 | 5365 F84FE8 18 clc |
||
2911 | 5366 F84FE9 60 rts |
||
2912 | 5367 F84FEA A5 24 ?nz: lda facsgn |
||
2913 | 5368 F84FEC 49 FF eor #$FF ; fceil(x)=-floor(-x) |
||
2914 | 5369 F84FEE 85 24 sta facsgn |
||
2915 | Tue Jul 17 11:00:18 2018 Page 48 |
||
2916 | |||
2917 | |||
2918 | |||
2919 | |||
2920 | 5370 F84FF0 20 27 50 jsr floor |
||
2921 | 5371 F84FF3 A5 24 lda facsgn |
||
2922 | 5372 F84FF5 49 FF eor #$FF |
||
2923 | 5373 F84FF7 85 24 sta facsgn |
||
2924 | 5374 F84FF9 60 rts |
||
2925 | 5375 |
||
2926 | 5376 ; fround - returns the integral value that is nearest to ergument x, |
||
2927 | 5377 ; with halfway cases rounded away from zero. |
||
2928 | 5378 ; |
||
2929 | 5379 ; This routine truncates toward the nearest integer value |
||
2930 | 5380 ; |
||
2931 | 5381 ; entry: |
||
2932 | 5382 ; fac = x |
||
2933 | 5383 ; |
||
2934 | 5384 ; exit: |
||
2935 | 5385 ; fac = y = integral part of x truncated toward the nearest |
||
2936 | 5386 ; CF = 1 if invalid result(inf or nan) |
||
2937 | 5387 ; |
||
2938 | 5388 ; fround(3.8) = 4.0 |
||
2939 | 5389 ; fround(3.4) = 3.0 |
||
2940 | 5390 ; fround(0.5) = 1.0 |
||
2941 | 5391 ; fround(0.4) = 0.0 |
||
2942 | 5392 ; fround(-0.4) = 0.0 |
||
2943 | 5393 ; fround(-0.5) = -1.0 |
||
2944 | 5394 ; fround(-3.4) = -3.0 |
||
2945 | 5395 ; fround(-3.8) = -4.0 |
||
2946 | 5396 ; |
||
2947 | 5397 ;------ |
||
2948 | 5398 F84FFA fround: |
||
2949 | 5399 ;------ |
||
2950 | 5400 F84FFA 24 25 bit facst |
||
2951 | 5401 F84FFC 10 02 bpl ?fv ; fac is valid |
||
2952 | 5402 F84FFE 38 sec ; return invalid flag |
||
2953 | 5403 F84FFF 60 ?ret: rts |
||
2954 | 5404 F85000 50 04 ?fv: bvc ?nz ; fac <> 0 |
||
2955 | 5405 F85002 64 24 stz facsgn ; return fac=0 |
||
2956 | 5406 F85004 18 clc |
||
2957 | 5407 F85005 60 rts |
||
2958 | 5408 F85006 A5 24 ?nz: lda facsgn |
||
2959 | 5409 F85008 48 pha ; save fac sign |
||
2960 | 5410 F85009 64 24 stz facsgn |
||
2961 | 5411 F8500B 20 67 45 jsr faddhalf ; |x|+0.5 |
||
2962 | 5412 F8500E 68 pla |
||
2963 | 5413 F8500F 85 24 sta facsgn ; restore fac sign |
||
2964 | 5414 F85011 B0 EC bcs ?ret ; overflow |
||
2965 | 5415 |
||
2966 | 5416 ; return sign(x)*ftrunc(|x|+0.5) |
||
2967 | 5417 F85013 30 C9 bmi fceil ; ftrunc(x)=fceil(x) if x<0 |
||
2968 | 5418 F85015 80 10 bra floor ; ftrunc(x)=floor(x) if x>0 |
||
2969 | 5419 F85017 |
||
2970 | 5420 ; ftrunc - returns the nearest integral value that is not larger |
||
2971 | 5421 ; in magnitude than the argument x. |
||
2972 | 5422 ; |
||
2973 | 5423 ; This routine truncates toward zero |
||
2974 | 5424 ; |
||
2975 | 5425 ; entry: |
||
2976 | 5426 ; fac = x |
||
2977 | Tue Jul 17 11:00:18 2018 Page 49 |
||
2978 | |||
2979 | |||
2980 | |||
2981 | |||
2982 | 5427 ; |
||
2983 | 5428 ; exit: |
||
2984 | 5429 ; fac = y = integral part of x truncated toward zero |
||
2985 | 5430 ; CF = 1 if invalid result(inf or nan) |
||
2986 | 5431 ; |
||
2987 | 5432 ; ftrunc(3.0) = 3.0 |
||
2988 | 5433 ; ftrunc(2.3) = 2.0 |
||
2989 | 5434 ; ftrunc(0.5) = 0.0 |
||
2990 | 5435 ; ftrunc(-0.5) = 0.0 |
||
2991 | 5436 ; ftrunc(-2.3) = -2.0 |
||
2992 | 5437 ; ftrunc(-3.0) = -3.0 |
||
2993 | 5438 ; |
||
2994 | 5439 ;------ |
||
2995 | 5440 F85017 ftrunc: |
||
2996 | 5441 ;------ |
||
2997 | 5442 F85017 24 25 bit facst |
||
2998 | 5443 F85019 10 02 bpl ?fv ; fac is valid |
||
2999 | 5444 F8501B 38 sec ; return invalid flag |
||
3000 | 5445 F8501C 60 rts |
||
3001 | 5446 F8501D 50 04 ?fv: bvc ?nz ; fac <> 0 |
||
3002 | 5447 F8501F 64 24 stz facsgn ; return fac=0 |
||
3003 | 5448 F85021 18 clc |
||
3004 | 5449 F85022 60 rts |
||
3005 | 5450 F85023 A5 24 ?nz: lda facsgn |
||
3006 | 5451 F85025 30 B7 bmi fceil ; ftrunc(x)=fceil(x) if x<0 |
||
3007 | 5452 ; ftrunc(x)=floor(x) if x>0 |
||
3008 | 5453 F85027 |
||
3009 | 5454 ; floor - returns the largest f.p. integer less than or equal to the argument |
||
3010 | 5455 ; |
||
3011 | 5456 ; This routine truncates toward minus infinity |
||
3012 | 5457 ; |
||
3013 | 5458 ; entry: |
||
3014 | 5459 ; fac = x |
||
3015 | 5460 ; |
||
3016 | 5461 ; exit: |
||
3017 | 5462 ; fac = y = integral part of x truncated toward minus infinity |
||
3018 | 5463 ; CF = 1 if invalid result(inf or nan) |
||
3019 | 5464 ; |
||
3020 | 5465 ; floor(3.0) = 3.0 |
||
3021 | 5466 ; floor(2.3) = 2.0 |
||
3022 | 5467 ; floor(0.5) = 0.0 |
||
3023 | 5468 ; floor(-0.5) = -1 |
||
3024 | 5469 ; floor(-2.3) = -3.0 |
||
3025 | 5470 ; floor(-3.0) = -3.0 |
||
3026 | 5471 ; |
||
3027 | 5472 ;----- |
||
3028 | 5473 F85027 floor: |
||
3029 | 5474 ;----- |
||
3030 | 5475 F85027 24 25 bit facst |
||
3031 | 5476 F85029 10 02 bpl ?fv ; fac is valid |
||
3032 | 5477 F8502B 38 sec ; return invalid flag |
||
3033 | 5478 F8502C 60 rts |
||
3034 | 5479 F8502D 50 04 ?fv: bvc ?nz ; fac <> 0 |
||
3035 | 5480 F8502F 64 24 stz facsgn ; return fac=0 |
||
3036 | 5481 F85031 18 clc |
||
3037 | 5482 F85032 60 rts |
||
3038 | 5483 F85033 20 26 4D ?nz: jsr frndm |
||
3039 | Tue Jul 17 11:00:18 2018 Page 50 |
||
3040 | |||
3041 | |||
3042 | |||
3043 | |||
3044 | 5484 F85036 ACC16 |
||
3045 | 5485 F85036 C2 20 rep #PMFLAG |
||
3046 | 5486 .LONGA on |
||
3047 | 5487 .MNLIST |
||
3048 | 5488 F85038 A5 22 lda facexp |
||
3049 | 5489 F8503A 38 sec |
||
3050 | 5490 F8503B E9 FF 3F sbc #EBIAS |
||
3051 | 5491 F8503E 85 3E sta wftmp ; save unbiased exponent |
||
3052 | 5492 F85040 ACC08 |
||
3053 | 5493 F85040 E2 20 sep #PMFLAG |
||
3054 | 5494 .LONGA off |
||
3055 | 5495 .MNLIST |
||
3056 | 5496 F85042 B0 0A bcs ?gt1 ; |fac|>=1 |
||
3057 | 5497 F85044 24 24 bit facsgn |
||
3058 | 5498 F85046 30 03 bmi ?m1 ; if -1<fac<0 return fac=-1... |
||
3059 | 5499 F85048 4C 56 4E jmp fldz ; ...else return fac=0 |
||
3060 | 5500 F8504B 4C 32 4E ?m1: jmp fldm1 ; return fac=-1 |
||
3061 | 5501 F8504E 20 39 84 ?gt1: jsr mvftoa ; move fac to arg for later comparation |
||
3062 | 5502 F85051 ACC16 ; here CF=1 |
||
3063 | 5503 F85051 C2 20 rep #PMFLAG |
||
3064 | 5504 .LONGA on |
||
3065 | 5505 .MNLIST |
||
3066 | 5506 F85053 A9 70 00 lda #SNBITS-1 |
||
3067 | 5507 F85056 E5 3E sbc wftmp ; if this is <=0 then fac already integral |
||
3068 | 5508 F85058 ACC08 |
||
3069 | 5509 F85058 E2 20 sep #PMFLAG |
||
3070 | 5510 .LONGA off |
||
3071 | 5511 .MNLIST |
||
3072 | 5512 F8505A 90 23 bcc ?int ; fac already integral |
||
3073 | 5513 F8505C F0 21 beq ?int ; fac already integral |
||
3074 | 5514 F8505E |
||
3075 | 5515 ; now A=count of bits to clear starting from mantissa ending |
||
3076 | 5516 ; and we can clear the fractional part to get just the integral part |
||
3077 | 5517 F8505E |
||
3078 | 5518 F8505E 64 13 stz facm+1 ; clear lsb |
||
3079 | 5519 F85060 3A dec a |
||
3080 | 5520 F85061 F0 1C beq ?int ; done: fac is integral |
||
3081 | 5521 F85063 A0 00 ldy #0 ; Y=0 |
||
3082 | 5522 F85065 BB tyx ; X=0 |
||
3083 | 5523 F85066 C9 08 ?lp: cmp #8 ; clear 8 bits at time? |
||
3084 | 5524 F85068 90 09 bcc ?bit ; no, we have to clear less than 8 bits |
||
3085 | 5525 F8506A 94 14 sty facm+2,x |
||
3086 | 5526 F8506C E8 inx |
||
3087 | 5527 F8506D E9 08 sbc #8 ; update count |
||
3088 | 5528 F8506F F0 0E beq ?int ; done: fac is integral |
||
3089 | 5529 F85071 80 F3 bra ?lp ; loop until we can clear 8 bits at time |
||
3090 | 5530 F85073 9B ?bit: txy ; save mantissa index |
||
3091 | 5531 F85074 AA tax ; X=count of bits |
||
3092 | 5532 F85075 CA dex |
||
3093 | 5533 F85076 BF B6 50 F8 lda >fmask,x ; load bits mask |
||
3094 | 5534 F8507A BB tyx ; X=mantissa index |
||
3095 | 5535 F8507B 35 14 and facm+2,x ; mask mantissa byte |
||
3096 | 5536 F8507D 95 14 sta facm+2,x |
||
3097 | 5537 F8507F 24 24 ?int: bit facsgn ; if fac>0... |
||
3098 | 5538 F85081 10 31 bpl ?end ; ...then done |
||
3099 | 5539 F85083 ACC16 ; ...else we compare if integral part... |
||
3100 | 5540 F85083 C2 20 rep #PMFLAG |
||
3101 | Tue Jul 17 11:00:18 2018 Page 51 |
||
3102 | |||
3103 | |||
3104 | |||
3105 | |||
3106 | 5541 .LONGA on |
||
3107 | 5542 .MNLIST |
||
3108 | 5543 ; ...is equal to original fac |
||
3109 | 5544 F85085 A5 14 lda facm+2 |
||
3110 | 5545 F85087 C5 2C cmp argm+2 |
||
3111 | 5546 F85089 D0 22 bne ?chk |
||
3112 | 5547 F8508B A5 16 lda facm+4 |
||
3113 | 5548 F8508D C5 2E cmp argm+4 |
||
3114 | 5549 F8508F D0 1C bne ?chk |
||
3115 | 5550 F85091 A5 18 lda facm+6 |
||
3116 | 5551 F85093 C5 30 cmp argm+6 |
||
3117 | 5552 F85095 D0 16 bne ?chk |
||
3118 | 5553 F85097 A5 1A lda facm+8 |
||
3119 | 5554 F85099 C5 32 cmp argm+8 |
||
3120 | 5555 F8509B D0 10 bne ?chk |
||
3121 | 5556 F8509D A5 1C lda facm+10 |
||
3122 | 5557 F8509F C5 34 cmp argm+10 |
||
3123 | 5558 F850A1 D0 0A bne ?chk |
||
3124 | 5559 F850A3 A5 1E lda facm+12 |
||
3125 | 5560 F850A5 C5 36 cmp argm+12 |
||
3126 | 5561 F850A7 D0 04 bne ?chk |
||
3127 | 5562 F850A9 A5 20 lda facm+14 |
||
3128 | 5563 F850AB C5 38 cmp argm+14 |
||
3129 | 5564 F850AD ?chk: ACC08 |
||
3130 | 5565 F850AD E2 20 sep #PMFLAG |
||
3131 | 5566 .LONGA off |
||
3132 | 5567 .MNLIST |
||
3133 | 5568 F850AF F0 03 beq ?end ; if equal then return it... |
||
3134 | 5569 F850B1 4C 71 45 jmp fsubone ; ...otherwise subtract 1 |
||
3135 | 5570 F850B4 18 ?end: clc |
||
3136 | 5571 F850B5 60 rts |
||
3137 | 5572 |
||
3138 | 5573 ; bit mask to clear |
||
3139 | 5574 F850B6 fmask: |
||
3140 | 5575 F850B6 FE FC F8 F0 E0 .DB $FE,$FC,$F8,$F0,$E0,$C0,$80 |
||
3141 | C0 80 |
||
3142 | 5576 |
||
3143 | 5577 ;--------------------------------------------------------------------------- |
||
3144 | 5578 ; remainders routines |
||
3145 | 5579 ;--------------------------------------------------------------------------- |
||
3146 | 5580 |
||
3147 | 5581 ; fpmod, fprem - returns the remainder of x/y |
||
3148 | 5582 ; |
||
3149 | 5583 ; entry: |
||
3150 | 5584 ; fac = y |
||
3151 | 5585 ; arg = x |
||
3152 | 5586 ; |
||
3153 | 5587 ; exit: |
||
3154 | 5588 ; fac = remainder |
||
3155 | 5589 ; arg = integral part of the quotient |
||
3156 | 5590 ; CF = 1 if invalid results |
||
3157 | 5591 ; |
||
3158 | 5592 ; The quotient is truncated toward zero in fpmod, and rounded to nearest |
||
3159 | 5593 ; in fprem. The remainder is computed as: x - n*y, where n is the integral |
||
3160 | 5594 ; quotient. |
||
3161 | 5595 ; |
||
3162 | 5596 ;----- |
||
3163 | Tue Jul 17 11:00:18 2018 Page 52 |
||
3164 | |||
3165 | |||
3166 | |||
3167 | |||
3168 | 5597 F850BD fpmod: |
||
3169 | 5598 ;----- |
||
3170 | 5599 F850BD 20 DD 50 jsr rdiv ; x/y |
||
3171 | 5600 F850C0 20 17 50 jsr ftrunc |
||
3172 | 5601 F850C3 80 06 bra rem |
||
3173 | 5602 F850C5 |
||
3174 | 5603 ;----- |
||
3175 | 5604 F850C5 fprem: |
||
3176 | 5605 ;----- |
||
3177 | 5606 F850C5 20 DD 50 jsr rdiv ; x/y |
||
3178 | 5607 F850C8 20 FA 4F jsr fround |
||
3179 | 5608 |
||
3180 | 5609 ;--- |
||
3181 | 5610 F850CB rem: |
||
3182 | 5611 ;--- |
||
3183 | 5612 F850CB 20 C0 84 jsr mvf_t2 ; tfr2 = n |
||
3184 | 5613 F850CE 20 FB 85 jsr mvt1_a ; y |
||
3185 | 5614 F850D1 20 DD 49 jsr fpmult ; y*n |
||
3186 | 5615 F850D4 20 CE 85 jsr mvt0_a |
||
3187 | 5616 F850D7 20 5F 45 jsr fpsub ; fac = x - y*n |
||
3188 | 5617 F850DA 4C 28 86 jmp mvt2_a ; arg = n |
||
3189 | 5618 |
||
3190 | 5619 ;---- |
||
3191 | 5620 F850DD rdiv: |
||
3192 | 5621 ;---- |
||
3193 | 5622 F850DD 20 93 84 jsr mvf_t1 ; tfr1 = y |
||
3194 | 5623 F850E0 20 1A 85 jsr mva_t0 ; tfr0 = x |
||
3195 | 5624 F850E3 20 10 4A jsr fpdiv ; x/y |
||
3196 | 5625 F850E6 90 09 bcc ?ret ; ok |
||
3197 | 5626 F850E8 20 74 4E jsr fldnan ; return nan |
||
3198 | 5627 F850EB 20 39 84 jsr mvftoa |
||
3199 | 5628 F850EE 68 pla ; skip return address |
||
3200 | 5629 F850EF 68 pla |
||
3201 | 5630 F850F0 38 sec |
||
3202 | 5631 F850F1 60 ?ret: rts |
||
3203 | 5632 F850F2 |
||
3204 | 5633 ; fpfrac - returns the integral part, trucated toward zero, and the fractional |
||
3205 | 5634 ; part of the argument x |
||
3206 | 5635 ; |
||
3207 | 5636 ; entry: |
||
3208 | 5637 ; fac = x |
||
3209 | 5638 ; |
||
3210 | 5639 ; exit: |
||
3211 | 5640 ; fac = y = fractional part of x, with: -1 < y < +1 |
||
3212 | 5641 ; arg = k = integral part of x, as returned by ftrunc(x) |
||
3213 | 5642 ; CF = 1 if invalid result (inf or nan) |
||
3214 | 5643 ; in this case fac=arg=nan/inf |
||
3215 | 5644 ; |
||
3216 | 5645 ; note that y and k have the same sign of x and: |
||
3217 | 5646 ; |
||
3218 | 5647 ; x = k + y |
||
3219 | 5648 ; |
||
3220 | 5649 ;------ |
||
3221 | 5650 F850F2 fpfrac: |
||
3222 | 5651 ;------ |
||
3223 | 5652 F850F2 24 25 bit facst |
||
3224 | 5653 F850F4 10 05 bpl ?fv ; fac is valid |
||
3225 | Tue Jul 17 11:00:18 2018 Page 53 |
||
3226 | |||
3227 | |||
3228 | |||
3229 | |||
3230 | 5654 F850F6 20 39 84 ?er: jsr mvftoa ; set arg=fac |
||
3231 | 5655 F850F9 38 sec ; return invalid flag |
||
3232 | 5656 F850FA 60 rts |
||
3233 | 5657 F850FB 20 ED 84 ?fv: jsr mvf_t3 ; move fac to temp. reg. tfr3 |
||
3234 | 5658 F850FE 20 17 50 jsr ftrunc ; fac=k=ftrunc(x) |
||
3235 | 5659 F85101 B0 F3 bcs ?er ; overflow |
||
3236 | 5660 F85103 20 C0 84 jsr mvf_t2 ; tfr2=k |
||
3237 | 5661 F85106 20 55 86 jsr mvt3_a ; arg=x |
||
3238 | 5662 F85109 20 5F 45 jsr fpsub ; fac=y=x-k |
||
3239 | 5663 F8510C 4C 28 86 jmp mvt2_a ; arg=k |
||
3240 | 5664 |
||
3241 | 5665 ;--------------------------------------------------------------------------- |
||
3242 | 5666 ; conversion decimal/hexadecimal to binary |
||
3243 | 5667 ;--------------------------------------------------------------------------- |
||
3244 | 5668 |
||
3245 | 5669 ; str2int, str2int2 - convert the initial portion of the source string to |
||
3246 | 5670 ; an unsigned or signed 128 bits integer. |
||
3247 | 5671 ; |
||
3248 | 5672 ; entry: |
||
3249 | 5673 ; A = low address of source string |
||
3250 | 5674 ; X = high address of source string |
||
3251 | 5675 ; Y = bank that hold source string |
||
3252 | 5676 ; B = flag signed conversion ($80), ignored for hex. string |
||
3253 | 5677 ; |
||
3254 | 5678 ; str2int2 is the re-entry point when long pointer tlp is already set, |
||
3255 | 5679 ; and in this case: |
||
3256 | 5680 ; |
||
3257 | 5681 ; entry: |
||
3258 | 5682 ; A = flag signed conversion ($80), ignored for hex. string |
||
3259 | 5683 ; tlp = long pointer to source string |
||
3260 | 5684 ; |
||
3261 | 5685 ; exit: |
||
3262 | 5686 ; facm..facm+15 = 128 bits integer |
||
3263 | 5687 ; facsiz = minimum number of bytes that can hold the integer |
||
3264 | 5688 ; A = first character where conversion stop |
||
3265 | 5689 ; tlp = long pointer to first char. where conversion stop |
||
3266 | 5690 ; CF = 0 if conversion was succesfully done |
||
3267 | 5691 ; VF = 1 if integer overflow |
||
3268 | 5692 ; CF = 1 (VF don't care) if input string is invalid |
||
3269 | 5693 ; |
||
3270 | 5694 ; Conversion start parsing source string from left toward right, skipping any |
||
3271 | 5695 ; leading blank and/or tab: if initial portion of string begin with '$', |
||
3272 | 5696 ; or '0x', or '0X', the conversion is done in base 16, otherwise in base 10. |
||
3273 | 5697 ; In decimal conversion an optional single sign '+' or '-' can precede any |
||
3274 | 5698 ; decimal digit, while in hexadecimal conversion just hexadecimal's digits |
||
3275 | 5699 ; (both lower case and upper case) can follow the initial '$' or '0x'. |
||
3276 | 5700 ; Conversion stop at the end of the string or at the first character that |
||
3277 | 5701 ; does not produce a valid digit in the given base, and tlp hold the long |
||
3278 | 5702 ; pointer to this character. |
||
3279 | 5703 ; |
||
3280 | 5704 ;------- |
||
3281 | 5705 F8510F str2int: |
||
3282 | 5706 ;------- |
||
3283 | 5707 F8510F 85 4C sta tlp ; set long pointer to source ascii string |
||
3284 | 5708 F85111 86 4D stx tlp+1 |
||
3285 | 5709 F85113 84 4E sty tlp+2 |
||
3286 | 5710 F85115 EB xba ; signed flag |
||
3287 | Tue Jul 17 11:00:18 2018 Page 54 |
||
3288 | |||
3289 | |||
3290 | |||
3291 | |||
3292 | 5711 |
||
3293 | 5712 ;-------- |
||
3294 | 5713 F85116 str2int2: |
||
3295 | 5714 ;-------- |
||
3296 | 5715 F85116 29 80 and #$80 ; mask signed flag |
||
3297 | 5716 F85118 09 60 ora #$60 ; set bit 6&5 (assume integer = 0) |
||
3298 | 5717 F8511A 85 25 sta facst ; flag signed conversion |
||
3299 | 5718 F8511C 64 24 stz facsgn ; assume positive sign |
||
3300 | 5719 F8511E A2 11 ldx #17 ; clear facm |
||
3301 | 5720 F85120 74 12 ?clr: stz facm,x ; facexp used for overflow check (extension) |
||
3302 | 5721 F85122 CA dex |
||
3303 | 5722 F85123 10 FB bpl ?clr |
||
3304 | 5723 F85125 64 3F stz wftmp+1 ; digit's flag |
||
3305 | 5724 F85127 A0 00 ldy #0 ; init string pointer |
||
3306 | 5725 F85129 80 03 bra ?get0 |
||
3307 | 5726 F8512B C8 ?nx0: iny |
||
3308 | 5727 F8512C F0 55 beq ?iy ; string index overflow |
||
3309 | 5728 F8512E B7 4C ?get0: lda [tlp],y ; get char |
||
3310 | 5729 F85130 F0 54 beq ?eos ; end of string |
||
3311 | 5730 F85132 C9 20 cmp #' ' |
||
3312 | 5731 F85134 F0 F5 beq ?nx0 ; skip leading blanks |
||
3313 | 5732 F85136 C9 08 cmp #$08 |
||
3314 | 5733 F85138 F0 F1 beq ?nx0 ; skip leading 'tab' |
||
3315 | 5734 F8513A C9 24 cmp #'$' ; hex. string? |
||
3316 | 5735 F8513C F0 7E beq ?hex ; yes, convert ascii hex. string |
||
3317 | 5736 F8513E C9 30 cmp #'0' |
||
3318 | 5737 F85140 D0 12 bne ?dec ; go to decimal conversion |
||
3319 | 5738 F85142 AA tax ; save char |
||
3320 | 5739 F85143 C8 iny ; bump pointer |
||
3321 | 5740 F85144 F0 3D beq ?iy ; string index overflow |
||
3322 | 5741 F85146 B7 4C lda [tlp],y ; get char |
||
3323 | 5742 F85148 C9 78 cmp #'x' ; '0x' so hex. conversion |
||
3324 | 5743 F8514A F0 70 beq ?hex |
||
3325 | 5744 F8514C C9 58 cmp #'X' ; '0X' so hex. conversion |
||
3326 | 5745 F8514E F0 6C beq ?hex |
||
3327 | 5746 F85150 88 dey ; re-fetch previous char |
||
3328 | 5747 F85151 8A txa ; this is '0' |
||
3329 | 5748 F85152 80 17 bra ?dec2 ; handle decimal digit |
||
3330 | 5749 F85154 |
||
3331 | 5750 ; parsing of ascii decimal string |
||
3332 | 5751 F85154 C9 2B ?dec: cmp #'+' |
||
3333 | 5752 F85156 F0 0C beq ?nxt ; skip '+' sign |
||
3334 | 5753 F85158 C9 2D cmp #'-' |
||
3335 | 5754 F8515A D0 0F bne ?dec2 ; handle decimal digit |
||
3336 | 5755 F8515C 24 25 bit facst ; convert to unsigned? |
||
3337 | 5756 F8515E 10 26 bpl ?eos ; invalid '-' sign in unsigned conversion |
||
3338 | 5757 F85160 A9 80 lda #$80 |
||
3339 | 5758 F85162 85 24 sta facsgn ; set negative sign flag |
||
3340 | 5759 F85164 C8 ?nxt: iny ; next byte |
||
3341 | 5760 F85165 F0 1C beq ?iy ; string index overflow |
||
3342 | 5761 F85167 B7 4C lda [tlp],y ; get next char |
||
3343 | 5762 F85169 F0 1B beq ?eos ; end of string |
||
3344 | 5763 F8516B 38 ?dec2: sec |
||
3345 | 5764 F8516C E9 3A sbc #'0'+10 |
||
3346 | 5765 F8516E 18 clc |
||
3347 | 5766 F8516F 69 0A adc #10 |
||
3348 | 5767 F85171 90 13 bcc ?eos ; not a digit: stop string parsing |
||
3349 | Tue Jul 17 11:00:18 2018 Page 55 |
||
3350 | |||
3351 | |||
3352 | |||
3353 | |||
3354 | 5768 F85173 20 44 52 jsr ?m10 ; facm*10 |
||
3355 | 5769 F85176 B0 1A bcs ?ov ; overflow |
||
3356 | 5770 F85178 20 7E 52 jsr ?addg ; fac=fac+digit |
||
3357 | 5771 F8517B B0 15 bcs ?ov ; overflow |
||
3358 | 5772 F8517D A9 80 lda #$80 |
||
3359 | 5773 F8517F 85 3F sta wftmp+1 ; decimal digit indicator |
||
3360 | 5774 F85181 80 E1 bra ?nxt ; get next char |
||
3361 | 5775 F85183 88 ?iy: dey ; string index overflow |
||
3362 | 5776 F85184 80 15 bra ?er ; invalid string |
||
3363 | 5777 F85186 84 4F ?eos: sty fpidx ; end of string or end of parsing |
||
3364 | 5778 F85188 A6 3F ldx wftmp+1 ; parsed at least one digit? |
||
3365 | 5779 F8518A F0 11 beq ?er2 ; no, so error (invalid string) |
||
3366 | 5780 F8518C 20 02 52 jsr ?test ; final conversion test |
||
3367 | 5781 F8518F B8 clv ; no overflow |
||
3368 | 5782 F85190 90 13 bcc ?done ; CF=0, VF=0 -- ok |
||
3369 | 5783 F85192 A9 40 ?ov: lda #$40 |
||
3370 | 5784 F85194 14 25 trb facst |
||
3371 | 5785 F85196 18 clc |
||
3372 | 5786 F85197 E2 40 sep #PVFLAG ; VF=1 -- overflow |
||
3373 | 5787 F85199 80 0A bra ?done ; CF=0, VF=1 if signed integer overflow |
||
3374 | 5788 F8519B 84 4F ?er: sty fpidx ; save string pointer |
||
3375 | 5789 F8519D A2 11 ?er2: ldx #17 ; clear facm |
||
3376 | 5790 F8519F 74 12 ?clr2: stz facm,x |
||
3377 | 5791 F851A1 CA dex |
||
3378 | 5792 F851A2 10 FB bpl ?clr2 |
||
3379 | 5793 F851A4 38 sec ; error flag (invalid string) |
||
3380 | 5794 F851A5 08 ?done: php ; save carry |
||
3381 | 5795 F851A6 20 A4 52 jsr ?gsiz ; compute min. size |
||
3382 | 5796 F851A9 A5 4C lda tlp ; update string pointer |
||
3383 | 5797 F851AB 18 clc |
||
3384 | 5798 F851AC 65 4F adc fpidx |
||
3385 | 5799 F851AE 85 4C sta tlp |
||
3386 | 5800 F851B0 90 06 bcc ?end |
||
3387 | 5801 F851B2 E6 4D inc tlp+1 |
||
3388 | 5802 F851B4 D0 02 bne ?end |
||
3389 | 5803 F851B6 E6 4E inc tlp+2 |
||
3390 | 5804 F851B8 A7 4C ?end: lda [tlp] ; A=last parsed character |
||
3391 | 5805 F851BA 28 plp ; restore carry |
||
3392 | 5806 F851BB 60 rts |
||
3393 | 5807 F851BC |
||
3394 | 5808 ; parsing of ascii hex. string |
||
3395 | 5809 F851BC A9 60 ?hex: lda #$60 |
||
3396 | 5810 F851BE 85 25 sta facst ; unsigned conversion only |
||
3397 | 5811 F851C0 C8 ?hex1: iny ; bump pointer |
||
3398 | 5812 F851C1 F0 C0 beq ?iy ; string index overflow |
||
3399 | 5813 F851C3 B7 4C ?hex2: lda [tlp],y ; get next char |
||
3400 | 5814 F851C5 F0 BF beq ?eos ; end of string |
||
3401 | 5815 F851C7 C9 61 cmp #'a' ; test hex. digit |
||
3402 | 5816 F851C9 90 02 bcc ?hex3 |
||
3403 | 5817 F851CB E9 20 sbc #$20 ; capitalize 'a', 'b',... |
||
3404 | 5818 F851CD 38 ?hex3: sec |
||
3405 | 5819 F851CE E9 3A sbc #('0'+10) ; check digits '0'..'9' |
||
3406 | 5820 F851D0 18 clc |
||
3407 | 5821 F851D1 69 0A adc #10 |
||
3408 | 5822 F851D3 B0 09 bcs ?hex4 ; ok, valid hex. digit |
||
3409 | 5823 F851D5 E9 16 sbc #(6+16) ; check 'A'..'F' |
||
3410 | 5824 F851D7 18 clc |
||
3411 | Tue Jul 17 11:00:18 2018 Page 56 |
||
3412 | |||
3413 | |||
3414 | |||
3415 | |||
3416 | 5825 F851D8 69 06 adc #6 |
||
3417 | 5826 F851DA 90 AA bcc ?eos ; no hex digit: stop parsing |
||
3418 | 5827 F851DC 69 09 adc #9 ; valid hex. digit |
||
3419 | 5828 F851DE 29 0F ?hex4: and #$0F ; mask low nibble |
||
3420 | 5829 F851E0 85 3E sta wftmp |
||
3421 | 5830 F851E2 ACC16 |
||
3422 | 5831 F851E2 C2 20 rep #PMFLAG |
||
3423 | 5832 .LONGA on |
||
3424 | 5833 .MNLIST |
||
3425 | 5834 F851E4 20 6B 52 jsr ?m2 ; facm*16 |
||
3426 | 5835 F851E7 20 6B 52 jsr ?m2 |
||
3427 | 5836 F851EA 20 6B 52 jsr ?m2 |
||
3428 | 5837 F851ED 20 6B 52 jsr ?m2 |
||
3429 | 5838 F851F0 A5 22 lda facm+16 ; overflow test |
||
3430 | 5839 F851F2 ACC08 |
||
3431 | 5840 F851F2 E2 20 sep #PMFLAG |
||
3432 | 5841 .LONGA off |
||
3433 | 5842 .MNLIST |
||
3434 | 5843 F851F4 D0 9C bne ?ov ; overflow |
||
3435 | 5844 F851F6 A5 3E lda wftmp ; add hex. digit |
||
3436 | 5845 F851F8 05 12 ora facm ; last low nibble |
||
3437 | 5846 F851FA 85 12 sta facm |
||
3438 | 5847 F851FC A9 80 lda #$80 |
||
3439 | 5848 F851FE 85 3F sta wftmp+1 ; digits flag |
||
3440 | 5849 F85200 80 BE bra ?hex1 ; continue string parsing |
||
3441 | 5850 |
||
3442 | 5851 F85202 ?test: ACC16 |
||
3443 | 5852 F85202 C2 20 rep #PMFLAG |
||
3444 | 5853 .LONGA on |
||
3445 | 5854 .MNLIST |
||
3446 | 5855 F85204 A5 20 lda facm+14 ; check if zero |
||
3447 | 5856 F85206 A2 0C ldx #12 |
||
3448 | 5857 F85208 15 12 ?lp1: ora facm,x |
||
3449 | 5858 F8520A CA dex |
||
3450 | 5859 F8520B CA dex |
||
3451 | 5860 F8520C 10 FA bpl ?lp1 |
||
3452 | 5861 F8520E C9 00 00 cmp #$0000 |
||
3453 | 5862 F85211 ACC08 |
||
3454 | 5863 F85211 E2 20 sep #PMFLAG |
||
3455 | 5864 .LONGA off |
||
3456 | 5865 .MNLIST |
||
3457 | 5866 F85213 F0 2B beq ?vf ; finish: integer = 0 |
||
3458 | 5867 F85215 A9 40 lda #$40 |
||
3459 | 5868 F85217 14 25 trb facst ; not zero integer indicator |
||
3460 | 5869 F85219 24 25 bit facst ; conversion test |
||
3461 | 5870 F8521B 10 23 bpl ?vf ; wanted unsigned integer: finish |
||
3462 | 5871 F8521D 24 24 bit facsgn ; if negative decimal... |
||
3463 | 5872 F8521F 30 06 bmi ?neg ; ...should negate facm |
||
3464 | 5873 F85221 A5 21 lda facm+15 ; should be <$80 if positive signed integer |
||
3465 | 5874 F85223 10 1B bpl ?vf ; finish: positive signed integer |
||
3466 | 5875 F85225 30 1B bmi ?of ; signed integer overflow |
||
3467 | 5876 F85227 ?neg: ACC16 |
||
3468 | 5877 F85227 C2 20 rep #PMFLAG |
||
3469 | 5878 .LONGA on |
||
3470 | 5879 .MNLIST |
||
3471 | 5880 F85229 A2 00 ldx #0 ; facm index |
||
3472 | 5881 F8522B A0 08 ldy #8 ; counter (8 words) |
||
3473 | Tue Jul 17 11:00:18 2018 Page 57 |
||
3474 | |||
3475 | |||
3476 | |||
3477 | |||
3478 | 5882 F8522D 38 sec |
||
3479 | 5883 F8522E A9 00 00 ?lp2: lda #0 ; two's complement |
||
3480 | 5884 F85231 F5 12 sbc facm,x |
||
3481 | 5885 F85233 95 12 sta facm,x |
||
3482 | 5886 F85235 E8 inx |
||
3483 | 5887 F85236 E8 inx |
||
3484 | 5888 F85237 88 dey |
||
3485 | 5889 F85238 D0 F4 bne ?lp2 |
||
3486 | 5890 F8523A A5 20 lda facm+14 ; must be negative |
||
3487 | 5891 F8523C ACC08 |
||
3488 | 5892 F8523C E2 20 sep #PMFLAG |
||
3489 | 5893 .LONGA off |
||
3490 | 5894 .MNLIST |
||
3491 | 5895 F8523E 10 02 bpl ?of ; signed integer overflow |
||
3492 | 5896 F85240 18 ?vf: clc ; valid flag |
||
3493 | 5897 F85241 60 rts |
||
3494 | 5898 F85242 38 ?of: sec ; overflow |
||
3495 | 5899 F85243 60 rts |
||
3496 | 5900 F85244 |
||
3497 | 5901 F85244 A2 11 ?m10: ldx #17 ; multiplies facm by 10 |
||
3498 | 5902 F85246 84 4F sty fpidx ; save Y |
||
3499 | 5903 F85248 85 3E sta wftmp ; save digit |
||
3500 | 5904 F8524A B5 12 ?m101: lda facm,x ; move facm to argm |
||
3501 | 5905 F8524C 95 2A sta argm,x |
||
3502 | 5906 F8524E CA dex |
||
3503 | 5907 F8524F 10 F9 bpl ?m101 |
||
3504 | 5908 F85251 ACC16 |
||
3505 | 5909 F85251 C2 20 rep #PMFLAG |
||
3506 | 5910 .LONGA on |
||
3507 | 5911 .MNLIST |
||
3508 | 5912 F85253 20 6B 52 jsr ?m2 ; facm*2 |
||
3509 | 5913 F85256 20 6B 52 jsr ?m2 ; facm*4 |
||
3510 | 5914 F85259 20 91 52 jsr ?add ; facm*4+argm=facm*5 |
||
3511 | 5915 F8525C 20 6B 52 jsr ?m2 ; facm*10 |
||
3512 | 5916 F8525F A5 22 lda facm+16 ; check overflow |
||
3513 | 5917 F85261 ACC08 |
||
3514 | 5918 F85261 E2 20 sep #PMFLAG |
||
3515 | 5919 .LONGA off |
||
3516 | 5920 .MNLIST |
||
3517 | 5921 F85263 F0 01 beq ?nof ; no overflow |
||
3518 | 5922 F85265 38 sec ; overflow flag |
||
3519 | 5923 F85266 A4 4F ?nof: ldy fpidx ; restore Y |
||
3520 | 5924 F85268 A5 3E lda wftmp ; restore digit |
||
3521 | 5925 F8526A 60 rts |
||
3522 | 5926 |
||
3523 | 5927 F8526B 06 12 ?m2: asl facm ; multiplies facm by 2 |
||
3524 | 5928 F8526D 26 14 rol facm+2 |
||
3525 | 5929 F8526F 26 16 rol facm+4 |
||
3526 | 5930 F85271 26 18 rol facm+6 |
||
3527 | 5931 F85273 26 1A rol facm+8 |
||
3528 | 5932 F85275 26 1C rol facm+10 |
||
3529 | 5933 F85277 26 1E rol facm+12 |
||
3530 | 5934 F85279 26 20 rol facm+14 |
||
3531 | 5935 F8527B 26 22 rol facm+16 |
||
3532 | 5936 F8527D 60 rts |
||
3533 | 5937 |
||
3534 | 5938 F8527E 84 4F ?addg: sty fpidx ; add digit to facm - save Y |
||
3535 | Tue Jul 17 11:00:18 2018 Page 58 |
||
3536 | |||
3537 | |||
3538 | |||
3539 | |||
3540 | 5939 F85280 85 2A sta argm ; digit |
||
3541 | 5940 F85282 ACC16 ; argm was already cleared |
||
3542 | 5941 F85282 C2 20 rep #PMFLAG |
||
3543 | 5942 .LONGA on |
||
3544 | 5943 .MNLIST |
||
3545 | 5944 F85284 20 91 52 jsr ?add |
||
3546 | 5945 F85287 A5 22 lda facm+16 ; check overflow |
||
3547 | 5946 F85289 ACC08 |
||
3548 | 5947 F85289 E2 20 sep #PMFLAG |
||
3549 | 5948 .LONGA off |
||
3550 | 5949 .MNLIST |
||
3551 | 5950 F8528B F0 01 beq ?nof1 ; no overflow |
||
3552 | 5951 F8528D 38 sec ; overflow flag |
||
3553 | 5952 F8528E A4 4F ?nof1: ldy fpidx ; restore Y |
||
3554 | 5953 F85290 60 rts |
||
3555 | 5954 |
||
3556 | 5955 F85291 18 ?add: clc ; facm=facm+argm |
||
3557 | 5956 F85292 A2 00 ldx #0 ; facm&argm index |
||
3558 | 5957 F85294 A0 09 ldy #9 ; counter (9 words) |
||
3559 | 5958 F85296 B5 12 ?ad1: lda facm,x ; facm=facm+argm |
||
3560 | 5959 F85298 75 2A adc argm,x |
||
3561 | 5960 F8529A 95 12 sta facm,x |
||
3562 | 5961 F8529C 74 2A stz argm,x ; and clear argm for later use |
||
3563 | 5962 F8529E E8 inx |
||
3564 | 5963 F8529F E8 inx |
||
3565 | 5964 F852A0 88 dey |
||
3566 | 5965 F852A1 D0 F3 bne ?ad1 |
||
3567 | 5966 F852A3 60 rts |
||
3568 | 5967 |
||
3569 | 5968 F852A4 B0 0E ?gsiz: bcs ?gse ; invalid string |
||
3570 | 5969 F852A6 A9 10 lda #16 ; assume max. possible size |
||
3571 | 5970 F852A8 85 24 sta facsgn |
||
3572 | 5971 F852AA 70 08 bvs ?gse ; overflow condition |
||
3573 | 5972 F852AC 24 25 bit facst ; compute min. integer size (in bytes #) |
||
3574 | 5973 F852AE 50 05 bvc ?gs0 ; not zero |
||
3575 | 5974 F852B0 A9 01 lda #1 ; zero can fit in one byte |
||
3576 | 5975 F852B2 85 24 sta facsgn |
||
3577 | 5976 F852B4 60 ?gse: rts |
||
3578 | 5977 F852B5 30 2C ?gs0: bmi ?gss ; signed integer |
||
3579 | 5978 F852B7 A2 10 ldx #16 |
||
3580 | 5979 F852B9 ACC16 |
||
3581 | 5980 F852B9 C2 20 rep #PMFLAG |
||
3582 | 5981 .LONGA on |
||
3583 | 5982 .MNLIST |
||
3584 | 5983 F852BB A5 20 lda facm+14 |
||
3585 | 5984 F852BD 05 1E ora facm+12 |
||
3586 | 5985 F852BF 05 1C ora facm+10 |
||
3587 | 5986 F852C1 05 1A ora facm+8 |
||
3588 | 5987 F852C3 D0 06 bne ?gs1 ; 16 bytes integer |
||
3589 | 5988 F852C5 A2 08 ldx #8 |
||
3590 | 5989 F852C7 A5 18 lda facm+6 |
||
3591 | 5990 F852C9 05 16 ora facm+4 |
||
3592 | 5991 F852CB ?gs1: ACC08 |
||
3593 | 5992 F852CB E2 20 sep #PMFLAG |
||
3594 | 5993 .LONGA off |
||
3595 | 5994 .MNLIST |
||
3596 | 5995 F852CD D0 11 bne ?gs2 ; 8 bytes integer |
||
3597 | Tue Jul 17 11:00:18 2018 Page 59 |
||
3598 | |||
3599 | |||
3600 | |||
3601 | |||
3602 | 5996 F852CF A2 04 ldx #4 |
||
3603 | 5997 F852D1 A5 15 lda facm+3 |
||
3604 | 5998 F852D3 D0 0B bne ?gs2 ; 4 bytes integer |
||
3605 | 5999 F852D5 CA dex |
||
3606 | 6000 F852D6 A5 14 lda facm+2 |
||
3607 | 6001 F852D8 D0 06 bne ?gs2 ; 3 bytes integer (long pointer) |
||
3608 | 6002 F852DA CA dex |
||
3609 | 6003 F852DB A5 13 lda facm+1 |
||
3610 | 6004 F852DD D0 01 bne ?gs2 ; 2 bytes integer |
||
3611 | 6005 F852DF CA dex ; 1 byte integer |
||
3612 | 6006 F852E0 86 24 ?gs2: stx facsgn |
||
3613 | 6007 F852E2 60 rts |
||
3614 | 6008 F852E3 A4 21 ?gss: ldy facm+15 |
||
3615 | 6009 F852E5 10 3F bpl ?gsp ; signed integer is positive |
||
3616 | 6010 F852E7 A2 10 ldx #16 |
||
3617 | 6011 F852E9 ACC16 |
||
3618 | 6012 F852E9 C2 20 rep #PMFLAG |
||
3619 | 6013 .LONGA on |
||
3620 | 6014 .MNLIST |
||
3621 | 6015 F852EB A5 20 lda facm+14 |
||
3622 | 6016 F852ED 25 1E and facm+12 |
||
3623 | 6017 F852EF 25 1C and facm+10 |
||
3624 | 6018 F852F1 25 1A and facm+8 |
||
3625 | 6019 F852F3 C9 FF FF cmp #$FFFF |
||
3626 | 6020 F852F6 D0 29 bne ?gs4 ; 16 bytes signed integer |
||
3627 | 6021 F852F8 A5 18 lda facm+6 |
||
3628 | 6022 F852FA 10 25 bpl ?gs4 ; 16 bytes signed integer |
||
3629 | 6023 F852FC A2 08 ldx #8 |
||
3630 | 6024 F852FE 25 16 and facm+4 |
||
3631 | 6025 F85300 C9 FF FF cmp #$FFFF |
||
3632 | 6026 F85303 D0 1C bne ?gs4 ; 8 bytes signed integer |
||
3633 | 6027 F85305 A5 14 lda facm+2 |
||
3634 | 6028 F85307 10 18 bpl ?gs4 ; 8 bytes signed integer |
||
3635 | 6029 F85309 A2 04 ldx #4 |
||
3636 | 6030 F8530B C9 FF FF cmp #$FFFF |
||
3637 | 6031 F8530E ACC08 |
||
3638 | 6032 F8530E E2 20 sep #PMFLAG |
||
3639 | 6033 .LONGA off |
||
3640 | 6034 .MNLIST |
||
3641 | 6035 F85310 D0 0F bne ?gs4 ; 4 bytes signed integer |
||
3642 | 6036 F85312 A5 13 lda facm+1 |
||
3643 | 6037 F85314 10 0B bpl ?gs4 ; 4 bytes signed integer |
||
3644 | 6038 F85316 A2 02 ldx #2 |
||
3645 | 6039 F85318 C9 FF cmp #$FF |
||
3646 | 6040 F8531A D0 05 bne ?gs4 ; 2 bytes signed integer |
||
3647 | 6041 F8531C A5 12 lda facm |
||
3648 | 6042 F8531E 10 01 bpl ?gs4 |
||
3649 | 6043 F85320 CA dex |
||
3650 | 6044 F85321 ?gs4: ACC08 |
||
3651 | 6045 F85321 E2 20 sep #PMFLAG |
||
3652 | 6046 .LONGA off |
||
3653 | 6047 .MNLIST |
||
3654 | 6048 F85323 86 24 stx facsgn |
||
3655 | 6049 F85325 60 rts |
||
3656 | 6050 F85326 A2 10 ?gsp: ldx #16 |
||
3657 | 6051 F85328 ACC16 |
||
3658 | 6052 F85328 C2 20 rep #PMFLAG |
||
3659 | Tue Jul 17 11:00:18 2018 Page 60 |
||
3660 | |||
3661 | |||
3662 | |||
3663 | |||
3664 | 6053 .LONGA on |
||
3665 | 6054 .MNLIST |
||
3666 | 6055 F8532A A5 20 lda facm+14 |
||
3667 | 6056 F8532C 05 1E ora facm+12 |
||
3668 | 6057 F8532E 05 1C ora facm+10 |
||
3669 | 6058 F85330 05 1A ora facm+8 |
||
3670 | 6059 F85332 D0 25 bne ?gs6 ; 16 bytes signed integer |
||
3671 | 6060 F85334 A5 18 lda facm+6 |
||
3672 | 6061 F85336 30 21 bmi ?gs6 ; 16 bytes signed integer |
||
3673 | 6062 F85338 A2 08 ldx #8 |
||
3674 | 6063 F8533A 05 16 ora facm+4 |
||
3675 | 6064 F8533C D0 1B bne ?gs6 ; 8 bytes signed integer |
||
3676 | 6065 F8533E A5 14 lda facm+2 |
||
3677 | 6066 F85340 30 17 bmi ?gs6 ; 8 bytes signed integer |
||
3678 | 6067 F85342 A2 04 ldx #4 |
||
3679 | 6068 F85344 C9 00 00 cmp #0 |
||
3680 | 6069 F85347 D0 10 bne ?gs6 ; 4 bytes signed integer |
||
3681 | 6070 F85349 ACC08 |
||
3682 | 6071 F85349 E2 20 sep #PMFLAG |
||
3683 | 6072 .LONGA off |
||
3684 | 6073 .MNLIST |
||
3685 | 6074 F8534B A5 13 lda facm+1 |
||
3686 | 6075 F8534D 30 0A bmi ?gs6 ; 4 bytes signed integer |
||
3687 | 6076 F8534F A2 02 ldx #2 |
||
3688 | 6077 F85351 A8 tay |
||
3689 | 6078 F85352 D0 05 bne ?gs6 ; 2 bytes signed integer |
||
3690 | 6079 F85354 A5 12 lda facm |
||
3691 | 6080 F85356 30 01 bmi ?gs6 ; 2 bytes signed integer |
||
3692 | 6081 F85358 CA dex ; 1 byte signed integer |
||
3693 | 6082 F85359 ?gs6: ACC08 |
||
3694 | 6083 F85359 E2 20 sep #PMFLAG |
||
3695 | 6084 .LONGA off |
||
3696 | 6085 .MNLIST |
||
3697 | 6086 F8535B 86 24 stx facsgn |
||
3698 | 6087 F8535D 60 rts |
||
3699 | 6088 F8535E |
||
3700 | 6089 ; str2fp, str2fp2 - convert the initial portion of the source string to |
||
3701 | 6090 ; a 128 bits binary floating point. |
||
3702 | 6091 ; |
||
3703 | 6092 ; entry: |
||
3704 | 6093 ; A = low address of source string |
||
3705 | 6094 ; X = high address of source string |
||
3706 | 6095 ; Y = bank that hold source string |
||
3707 | 6096 ; |
||
3708 | 6097 ; str2fp2 is the re-entry point when long pointer tlp is already set, |
||
3709 | 6098 ; and in this case: |
||
3710 | 6099 ; |
||
3711 | 6100 ; entry: |
||
3712 | 6101 ; tlp = long pointer to source string |
||
3713 | 6102 ; |
||
3714 | 6103 ; exit: |
||
3715 | 6104 ; fac = converted floating point |
||
3716 | 6105 ; A = first character where conversion stop |
||
3717 | 6106 ; tlp = long pointer to first char. where conversion stop |
||
3718 | 6107 ; CF = 0 if conversion was succesfully done |
||
3719 | 6108 ; VF = 1 if fac=inf/nan |
||
3720 | 6109 ; CF = 1 (VF don't care) if input string is invalid |
||
3721 | Tue Jul 17 11:00:18 2018 Page 61 |
||
3722 | |||
3723 | |||
3724 | |||
3725 | |||
3726 | 6110 ; |
||
3727 | 6111 ; Conversion start parsing source string from left toward right, skipping any |
||
3728 | 6112 ; leading blank and/or tab. |
||
3729 | 6113 ; The expected form of the input string is either: |
||
3730 | 6114 ; |
||
3731 | 6115 ; +o an hexadecimal ascii string beginning with '$' or '0x' or '0X', |
||
3732 | 6116 ; followed by exactly 32 hexadecimal digits (case don't care) for |
||
3733 | 6117 ; the significand, followed by a 'p' or a 'P', followed by 4 |
||
3734 | 6118 ; hexadecimals digits for the biased exponent. Significand sign |
||
3735 | 6119 ; should be ored with msb of the biased exponent. |
||
3736 | 6120 ; Example: |
||
3737 | 6121 ; $80000000000000000000000000000000pbfff = -1.0 |
||
3738 | 6122 ; $80000000000000000000000000000000p3fff = +1.0 |
||
3739 | 6123 ; $00000000000000000000000000000000p0000 = +0.0 |
||
3740 | 6124 ; Number 0.0 can be expressed either by significand=0 and/or |
||
3741 | 6125 ; exponent=0. |
||
3742 | 6126 ; |
||
3743 | 6127 ; +0 an hexadecimal ascii string beginning with '#', followed by |
||
3744 | 6128 ; exactly 32 hexadecimal digits (case don't care), seen as a packed |
||
3745 | 6129 ; standard ieee quadruple format. |
||
3746 | 6130 ; Example: |
||
3747 | 6131 ; #bfff0000000000000000000000000000 = -1.0 |
||
3748 | 6132 ; #3fff0000000000000000000000000000 = +1.0 |
||
3749 | 6133 ; #00000000000000000000000000000000 = +0.0 |
||
3750 | 6134 ; |
||
3751 | 6135 ; +o a decimal ascii string, beginning with an optional single '+' |
||
3752 | 6136 ; or '-' sign, followed by a decimal significand consisting of a |
||
3753 | 6137 ; sequence of decimal digits optionally containing a decimal-point |
||
3754 | 6138 ; character, '.'. The significand may be optionally followed by an |
||
3755 | 6139 ; exponent. An exponent consists of an 'E' or 'e' followed by an |
||
3756 | 6140 ; optional plus or minus sign, followed by a sequence of decimal |
||
3757 | 6141 ; digits; the exponent indicates the power of 10 by which the |
||
3758 | 6142 ; significand should be scaled. |
||
3759 | 6143 ; |
||
3760 | 6144 ; +o a string "+INF", "-INF", "+NAN", "-NAN", where the sign '+' or |
||
3761 | 6145 ; '-' is optional (case don't care). |
||
3762 | 6146 ; |
||
3763 | 6147 ; Conversion stop at the end of the string or at the first character that |
||
3764 | 6148 ; does not produce a valid digit in the given base, and tlp hold the long |
||
3765 | 6149 ; pointer to this character. |
||
3766 | 6150 ; |
||
3767 | 6151 ;------ |
||
3768 | 6152 F8535E str2fp: |
||
3769 | 6153 ;------ |
||
3770 | 6154 F8535E 85 4C sta tlp ; set long pointer to source ascii string |
||
3771 | 6155 F85360 86 4D stx tlp+1 |
||
3772 | 6156 F85362 84 4E sty tlp+2 |
||
3773 | 6157 |
||
3774 | 6158 ;------- |
||
3775 | 6159 F85364 str2fp2: |
||
3776 | 6160 ;------- |
||
3777 | 6161 F85364 64 26 stz fexph ; clear exponent |
||
3778 | 6162 F85366 9C 6C 68 stz fexp+1 |
||
3779 | 6163 F85369 64 B4 stz tmdot ; count of decimal digits (after a dot) |
||
3780 | 6164 F8536B 64 B5 stz tmdot+1 |
||
3781 | 6165 F8536D 64 25 stz facst ; clear status |
||
3782 | 6166 F8536F 64 24 stz facsgn ; clear sign |
||
3783 | Tue Jul 17 11:00:18 2018 Page 62 |
||
3784 | |||
3785 | |||
3786 | |||
3787 | |||
3788 | 6167 F85371 64 B8 stz tmsgn ; sign&dot indicator |
||
3789 | 6168 F85373 64 B9 stz tmcnt ; count of mantissa digits |
||
3790 | 6169 F85375 64 BA stz tesgn ; sign&exponent indicator |
||
3791 | 6170 F85377 64 BB stz tecnt ; count of exponent digit |
||
3792 | 6171 F85379 20 56 4E jsr fldz ; set fac=0 |
||
3793 | 6172 F8537C A0 00 ldy #0 ; init string pointer |
||
3794 | 6173 F8537E 80 03 bra ?get0 |
||
3795 | 6174 F85380 C8 ?nx0: iny |
||
3796 | 6175 F85381 F0 69 beq ?iy ; string index overflow |
||
3797 | 6176 F85383 B7 4C ?get0: lda [tlp],y ; get char |
||
3798 | 6177 F85385 F0 68 beq ?eos ; end of string |
||
3799 | 6178 F85387 C9 20 cmp #' ' |
||
3800 | 6179 F85389 F0 F5 beq ?nx0 ; skip leading blanks |
||
3801 | 6180 F8538B C9 08 cmp #$08 |
||
3802 | 6181 F8538D F0 F1 beq ?nx0 ; skip leading 'tab' |
||
3803 | 6182 F8538F C9 23 cmp #'#' ; ieee packed hex. string? |
||
3804 | 6183 F85391 D0 05 bne ?ckh ; no |
||
3805 | 6184 F85393 20 74 55 jsr ?ieee ; convert hex. packed to float |
||
3806 | 6185 F85396 80 1D bra ?ehx |
||
3807 | 6186 F85398 C9 24 ?ckh: cmp #'$' ; hex. string? |
||
3808 | 6187 F8539A F0 16 beq ?hex ; yes, convert ascii hex. string |
||
3809 | 6188 F8539C C9 30 cmp #'0' |
||
3810 | 6189 F8539E D0 1B bne ?dec ; go to decimal conversion |
||
3811 | 6190 F853A0 AA tax ; save char |
||
3812 | 6191 F853A1 C8 iny ; bump pointer |
||
3813 | 6192 F853A2 F0 48 beq ?iy ; string index overflow |
||
3814 | 6193 F853A4 B7 4C lda [tlp],y ; get char |
||
3815 | 6194 F853A6 C9 78 cmp #'x' ; '0x' so hex. conversion |
||
3816 | 6195 F853A8 F0 08 beq ?hex |
||
3817 | 6196 F853AA C9 58 cmp #'X' ; '0X' so hex. conversion |
||
3818 | 6197 F853AC F0 04 beq ?hex |
||
3819 | 6198 F853AE 88 dey ; re-fetch previous char |
||
3820 | 6199 F853AF 8A txa ; this is '0' |
||
3821 | 6200 F853B0 80 1C bra ?dec2 ; handle decimal digit |
||
3822 | 6201 F853B2 20 C9 54 ?hex: jsr ?hfp ; convert hex. string to float |
||
3823 | 6202 F853B5 84 4F ?ehx: sty fpidx ; store index |
||
3824 | 6203 F853B7 B8 clv ; ignore VF for hex. conversion |
||
3825 | 6204 F853B8 4C 7F 54 jmp ?done |
||
3826 | 6205 |
||
3827 | 6206 ; parsing of ascii decimal string |
||
3828 | 6207 F853BB C9 2B ?dec: cmp #'+' |
||
3829 | 6208 F853BD F0 08 beq ?nxt ; skip '+' sign |
||
3830 | 6209 F853BF C9 2D cmp #'-' |
||
3831 | 6210 F853C1 D0 0B bne ?dec2 ; handle decimal digit |
||
3832 | 6211 F853C3 A9 80 lda #$80 |
||
3833 | 6212 F853C5 85 B8 sta tmsgn ; set negative sign flag |
||
3834 | 6213 F853C7 C8 ?nxt: iny ; next byte |
||
3835 | 6214 F853C8 F0 22 beq ?iy ; string index overflow |
||
3836 | 6215 F853CA B7 4C lda [tlp],y ; get next char |
||
3837 | 6216 F853CC F0 21 beq ?eos ; end of string |
||
3838 | 6217 F853CE 38 ?dec2: sec |
||
3839 | 6218 F853CF E9 3A sbc #'0'+10 |
||
3840 | 6219 F853D1 18 clc |
||
3841 | 6220 F853D2 69 0A adc #10 |
||
3842 | 6221 F853D4 90 29 bcc ?ndg ; is not a digit |
||
3843 | 6222 F853D6 24 BA bit tesgn ; will process exponent digits? |
||
3844 | 6223 F853D8 70 09 bvs ?edec ; yes |
||
3845 | Tue Jul 17 11:00:18 2018 Page 63 |
||
3846 | |||
3847 | |||
3848 | |||
3849 | |||
3850 | 6224 F853DA E6 B9 inc tmcnt ; count of mantissa digits |
||
3851 | 6225 F853DC 20 91 54 jsr ?mupd ; update mantissa (add digit) |
||
3852 | 6226 F853DF 90 E6 bcc ?nxt ; next byte |
||
3853 | 6227 F853E1 B0 5C bcs ?ovf ; overflow error |
||
3854 | 6228 F853E3 E6 BB ?edec: inc tecnt ; process exponent digit |
||
3855 | 6229 F853E5 20 AE 54 jsr ?eupd ; update exponent (add digit) |
||
3856 | 6230 F853E8 90 DD bcc ?nxt ; next byte |
||
3857 | 6231 F853EA B0 53 bcs ?ovf ; exponent overflow error |
||
3858 | 6232 |
||
3859 | 6233 F853EC 88 ?iy: dey ; here when index overflow |
||
3860 | 6234 F853ED 80 5E bra ?nv ; invalid string |
||
3861 | 6235 |
||
3862 | 6236 ; end of string or parsing of an invalid char |
||
3863 | 6237 F853EF 84 4F ?eos: sty fpidx ; store index |
||
3864 | 6238 F853F1 A6 B9 ldx tmcnt |
||
3865 | 6239 F853F3 F0 5A beq ?nv1 ; no mantissa digits: invalid string |
||
3866 | 6240 F853F5 24 BA bit tesgn |
||
3867 | 6241 F853F7 50 60 bvc ?sc ; no exponent: scale fac according decimals |
||
3868 | 6242 F853F9 A6 BB ldx tecnt |
||
3869 | 6243 F853FB F0 52 beq ?nv1 ; no exponent digits: invalid string |
||
3870 | 6244 F853FD 80 5A bra ?sc ; scale fac according to exponent&decimals |
||
3871 | 6245 |
||
3872 | 6246 ; handle no-digit character |
||
3873 | 6247 F853FF 69 30 ?ndg: adc #'0' ; restore character |
||
3874 | 6248 F85401 C9 2E cmp #'.' ; check if decimal dot |
||
3875 | 6249 F85403 D0 0C bne ?cke ; go to check 'e', 'E' |
||
3876 | 6250 F85405 A6 B9 ldx tmcnt |
||
3877 | 6251 F85407 F0 44 beq ?nv ; no mantissa digits so error |
||
3878 | 6252 F85409 A9 40 lda #$40 ; test&set dot indicator |
||
3879 | 6253 F8540B 04 B8 tsb tmsgn |
||
3880 | 6254 F8540D D0 3E bne ?nv ; duplicate dot so error |
||
3881 | 6255 F8540F 80 B6 bra ?nxt ; next byte |
||
3882 | 6256 F85411 C9 45 ?cke: cmp #'E' ; check exponent |
||
3883 | 6257 F85413 F0 0B beq ?cke1 |
||
3884 | 6258 F85415 C9 65 cmp #'e' |
||
3885 | 6259 F85417 F0 07 beq ?cke1 |
||
3886 | 6260 F85419 20 F8 55 jsr ?ginf ; read INF or NAN string |
||
3887 | 6261 F8541C B0 D1 bcs ?eos ; invalid string |
||
3888 | 6262 F8541E 80 5F bra ?done |
||
3889 | 6263 F85420 A6 B9 ?cke1: ldx tmcnt |
||
3890 | 6264 F85422 F0 29 beq ?nv ; no mantissa digits so error |
||
3891 | 6265 F85424 A9 40 lda #$40 ; test&set dot indicator |
||
3892 | 6266 F85426 04 BA tsb tesgn |
||
3893 | 6267 F85428 D0 23 bne ?nv ; duplicate 'E' so error |
||
3894 | 6268 F8542A C8 iny ; get next byte |
||
3895 | 6269 F8542B F0 BF beq ?iy ; string index overflow |
||
3896 | 6270 F8542D B7 4C lda [tlp],y |
||
3897 | 6271 F8542F F0 BE beq ?eos ; end of string |
||
3898 | 6272 F85431 C9 2B cmp #'+' |
||
3899 | 6273 F85433 F0 92 beq ?nxt ; skip '+' sign |
||
3900 | 6274 F85435 C9 2D cmp #'-' |
||
3901 | 6275 F85437 D0 95 bne ?dec2 ; process this byte |
||
3902 | 6276 F85439 A9 80 lda #$80 |
||
3903 | 6277 F8543B 04 BA tsb tesgn ; set negative exponent sign |
||
3904 | 6278 F8543D 80 88 bra ?nxt ; get next byte |
||
3905 | 6279 |
||
3906 | 6280 ; mantissa or exponent overflow |
||
3907 | Tue Jul 17 11:00:18 2018 Page 64 |
||
3908 | |||
3909 | |||
3910 | |||
3911 | |||
3912 | 6281 F8543F 84 4F ?ovf: sty fpidx ; store index of last parsed byte |
||
3913 | 6282 F85441 A6 B8 ldx tmsgn ; attual mantissa sign |
||
3914 | 6283 F85443 86 24 stx facsgn |
||
3915 | 6284 F85445 20 7D 4E jsr fldinf ; load inf because overflow |
||
3916 | 6285 F85448 18 clc ; no error (string is valid) |
||
3917 | 6286 F85449 E2 40 sep #PVFLAG ; VF=1 (overflow) |
||
3918 | 6287 F8544B 80 32 bra ?done ; done |
||
3919 | 6288 |
||
3920 | 6289 ; duplicate dot, duplicate 'E', no valid digits: invalid string |
||
3921 | 6290 F8544D 84 4F ?nv: sty fpidx |
||
3922 | 6291 F8544F A6 B8 ?nv1: ldx tmsgn ; attual mantissa sign |
||
3923 | 6292 F85451 86 24 stx facsgn |
||
3924 | 6293 F85453 20 56 4E jsr fldz ; fac=0 |
||
3925 | 6294 F85456 38 sec ; error: invalid string |
||
3926 | 6295 F85457 80 26 bra ?done ; done |
||
3927 | 6296 |
||
3928 | 6297 ; now scale fac according to decimal digits count & exponent |
||
3929 | 6298 F85459 A4 B8 ?sc: ldy tmsgn |
||
3930 | 6299 F8545B 84 24 sty facsgn |
||
3931 | 6300 F8545D A2 00 ldx #0 |
||
3932 | 6301 F8545F ACC16 |
||
3933 | 6302 F8545F C2 20 rep #PMFLAG |
||
3934 | 6303 .LONGA on |
||
3935 | 6304 .MNLIST |
||
3936 | 6305 F85461 38 sec |
||
3937 | 6306 F85462 8A txa ; change sign to decimal count |
||
3938 | 6307 F85463 E5 B4 sbc tmdot |
||
3939 | 6308 F85465 85 B4 sta tmdot |
||
3940 | 6309 F85467 A5 26 lda fexph |
||
3941 | 6310 F85469 A4 BA ldy tesgn ; check exponent sign |
||
3942 | 6311 F8546B 10 04 bpl ?sc1 |
||
3943 | 6312 F8546D 49 FF FF eor #$FFFF ; change sign to exponent |
||
3944 | 6313 F85470 1A inc a |
||
3945 | 6314 F85471 18 ?sc1: clc |
||
3946 | 6315 F85472 65 B4 adc tmdot ; scale fac with this value |
||
3947 | 6316 F85474 ACC08 |
||
3948 | 6317 F85474 E2 20 sep #PMFLAG |
||
3949 | 6318 .LONGA off |
||
3950 | 6319 .MNLIST |
||
3951 | 6320 F85476 20 2E 49 jsr scale10 |
||
3952 | 6321 F85479 B8 clv ; VF=0 |
||
3953 | 6322 F8547A 90 03 bcc ?done ; no overflow |
||
3954 | 6323 F8547C 18 clc ; no error (string is valid) |
||
3955 | 6324 F8547D E2 40 sep #PVFLAG ; VF=1 (overflow) |
||
3956 | 6325 F8547F 08 ?done: php ; save CF&VF |
||
3957 | 6326 F85480 A5 4C lda tlp |
||
3958 | 6327 F85482 18 clc |
||
3959 | 6328 F85483 65 4F adc fpidx |
||
3960 | 6329 F85485 85 4C sta tlp |
||
3961 | 6330 F85487 90 06 bcc ?rts |
||
3962 | 6331 F85489 E6 4D inc tlp+1 |
||
3963 | 6332 F8548B D0 02 bne ?rts |
||
3964 | 6333 F8548D E6 4E inc tlp+2 |
||
3965 | 6334 F8548F 28 ?rts: plp |
||
3966 | 6335 F85490 60 rts |
||
3967 | 6336 |
||
3968 | 6337 ; update mantissa: fac=(fac*10)+byte (where A=byte) |
||
3969 | Tue Jul 17 11:00:18 2018 Page 65 |
||
3970 | |||
3971 | |||
3972 | |||
3973 | |||
3974 | 6338 F85491 84 B7 ?mupd: sty tmpy ; save Y |
||
3975 | 6339 F85493 85 B6 sta tmpa ; save A |
||
3976 | 6340 F85495 24 B8 bit tmsgn ; digit after a decimal dot? |
||
3977 | 6341 F85497 50 02 bvc ?mupd1 ; no |
||
3978 | 6342 F85499 E6 B4 inc tmdot ; increment decimal count |
||
3979 | 6343 F8549B 20 D1 49 ?mupd1: jsr mult10 ; fac=fac*10 |
||
3980 | 6344 F8549E B0 0B bcs ?mupd2 ; invalid |
||
3981 | 6345 F854A0 20 39 84 jsr mvftoa ; move fac to arg |
||
3982 | 6346 F854A3 A5 B6 lda tmpa |
||
3983 | 6347 F854A5 20 49 4F jsr fldbyt ; load byte into fac |
||
3984 | 6348 F854A8 20 7D 45 jsr fpadd ; fac=(fac*10)+A |
||
3985 | 6349 F854AB A4 B7 ?mupd2: ldy tmpy ; restore string index |
||
3986 | 6350 F854AD 60 rts ; CF=1 if overflow |
||
3987 | 6351 |
||
3988 | 6352 ; update exponent: fexph=(10*fexph)+A |
||
3989 | 6353 F854AE 85 B6 ?eupd: sta tmpa ; save byte to add |
||
3990 | 6354 F854B0 64 B7 stz tmpa+1 ; high byte = 0 |
||
3991 | 6355 F854B2 ACC16 |
||
3992 | 6356 F854B2 C2 20 rep #PMFLAG |
||
3993 | 6357 .LONGA on |
||
3994 | 6358 .MNLIST |
||
3995 | 6359 F854B4 A5 26 lda fexph |
||
3996 | 6360 F854B6 C9 CC 0C cmp #$0CCC ; check overflow condition |
||
3997 | 6361 F854B9 B0 0B bcs ?eupd1 ; limit exponent to $7FFF |
||
3998 | 6362 F854BB 85 3E sta wftmp |
||
3999 | 6363 F854BD 0A asl a ; mult. 10 |
||
4000 | 6364 F854BE 0A asl a |
||
4001 | 6365 F854BF 65 3E adc wftmp |
||
4002 | 6366 F854C1 0A asl a |
||
4003 | 6367 F854C2 65 B6 adc tmpa ; add byte |
||
4004 | 6368 F854C4 85 26 sta fexph ; update exponent |
||
4005 | 6369 F854C6 ?eupd1: ACC08 |
||
4006 | 6370 F854C6 E2 20 sep #PMFLAG |
||
4007 | 6371 .LONGA off |
||
4008 | 6372 .MNLIST |
||
4009 | 6373 F854C8 60 rts ; CF=1 if exponent overflow |
||
4010 | 6374 |
||
4011 | 6375 ; convert hexadecimal string: $xxx...xxpyyyy |
||
4012 | 6376 ; where xx...xx=significand, yyyy=biased exponent |
||
4013 | 6377 F854C9 20 12 55 ?hfp: jsr ?ghex ; convert hex. to fp |
||
4014 | 6378 F854CC B0 50 bcs ?ghx ; error getting significand |
||
4015 | 6379 F854CE A2 0F ldx #15 |
||
4016 | 6380 F854D0 B5 00 ?hfl: lda tm,x ; move tm to facm |
||
4017 | 6381 F854D2 95 12 sta facm,x |
||
4018 | 6382 F854D4 CA dex |
||
4019 | 6383 F854D5 10 F9 bpl ?hfl |
||
4020 | 6384 F854D7 20 1F 55 jsr ?hexp ; get high exponent |
||
4021 | 6385 F854DA B0 42 bcs ?ghx ; error |
||
4022 | 6386 F854DC AA tax |
||
4023 | 6387 F854DD 29 80 and #$80 |
||
4024 | 6388 F854DF 85 24 sta facsgn ; sign |
||
4025 | 6389 F854E1 8A txa |
||
4026 | 6390 F854E2 29 7F and #$7F |
||
4027 | 6391 F854E4 85 23 sta facexp+1 |
||
4028 | 6392 F854E6 20 2C 55 jsr ?2hex ; get low exponent |
||
4029 | 6393 F854E9 B0 33 bcs ?ghx ; error |
||
4030 | 6394 F854EB 85 22 sta facexp |
||
4031 | Tue Jul 17 11:00:18 2018 Page 66 |
||
4032 | |||
4033 | |||
4034 | |||
4035 | |||
4036 | 6395 F854ED 20 61 55 jsr ?hsep ; check end of string |
||
4037 | 6396 F854F0 B0 2C bcs ?ghx ; error |
||
4038 | 6397 F854F2 64 25 stz facst |
||
4039 | 6398 F854F4 20 E6 46 jsr chkz ; check if fac=0 |
||
4040 | 6399 F854F7 24 25 bit facst |
||
4041 | 6400 F854F9 70 23 bvs ?ghx ; fac=0, exit (CF=0) |
||
4042 | 6401 F854FB A5 22 lda facexp |
||
4043 | 6402 F854FD 05 23 ora facexp+1 ; exponent=0? |
||
4044 | 6403 F854FF F0 0E beq ?hfz ; yes, set fac=0 |
||
4045 | 6404 F85501 AA tax |
||
4046 | 6405 F85502 A5 21 lda facm+15 |
||
4047 | 6406 F85504 30 06 bmi ?hf3 ; normal |
||
4048 | 6407 F85506 E0 01 cpx #1 ; subnormal should have exponent=1 |
||
4049 | 6408 F85508 D0 68 bne ?1hex4 ; invalid string |
||
4050 | 6409 F8550A 18 clc |
||
4051 | 6410 F8550B 60 rts |
||
4052 | 6411 F8550C 4C DC 55 ?hf3: jmp ?htst ; test inf/nan |
||
4053 | 6412 F8550F 4C 56 4E ?hfz: jmp fldz |
||
4054 | 6413 F85512 |
||
4055 | 6414 F85512 A2 0F ?ghex: ldx #15 ; get 128 bits hex |
||
4056 | 6415 F85514 20 2C 55 ?ghl: jsr ?2hex |
||
4057 | 6416 F85517 B0 05 bcs ?ghx ; error |
||
4058 | 6417 F85519 95 00 sta tm,x ; store (high-to-low order) |
||
4059 | 6418 F8551B CA dex |
||
4060 | 6419 F8551C 10 F6 bpl ?ghl |
||
4061 | 6420 F8551E 60 ?ghx: rts ; CF=0 if no error |
||
4062 | 6421 |
||
4063 | 6422 F8551F C8 ?hexp: iny ; get 'p' biased high exponent |
||
4064 | 6423 F85520 F0 4F beq ?1hex3 ; string index overflow |
||
4065 | 6424 F85522 B7 4C lda [tlp],y ; get next char |
||
4066 | 6425 F85524 C9 70 cmp #'p' ; exponent indicator |
||
4067 | 6426 F85526 F0 04 beq ?2hex ; ok |
||
4068 | 6427 F85528 C9 50 cmp #'P' |
||
4069 | 6428 F8552A D0 46 bne ?1hex4 ; invalid string |
||
4070 | 6429 |
||
4071 | 6430 F8552C 20 3F 55 ?2hex: jsr ?1hex ; convert two digits at time |
||
4072 | 6431 F8552F B0 ED bcs ?ghx ; error |
||
4073 | 6432 F85531 0A asl a ; high nibble |
||
4074 | 6433 F85532 0A asl a |
||
4075 | 6434 F85533 0A asl a |
||
4076 | 6435 F85534 0A asl a |
||
4077 | 6436 F85535 85 3E sta wftmp |
||
4078 | 6437 F85537 20 3F 55 jsr ?1hex ; get low nibble |
||
4079 | 6438 F8553A B0 E2 bcs ?ghx ; error |
||
4080 | 6439 F8553C 05 3E ora wftmp ; concatenate high & low nibble |
||
4081 | 6440 F8553E 60 rts ; CF=0, no error |
||
4082 | 6441 |
||
4083 | 6442 F8553F C8 ?1hex: iny ; convert one hex. digit |
||
4084 | 6443 F85540 F0 2F beq ?1hex3 ; string index overflow |
||
4085 | 6444 F85542 B7 4C lda [tlp],y ; get next char |
||
4086 | 6445 F85544 F0 2C beq ?1hex4 ; premature end of string |
||
4087 | 6446 F85546 C9 61 cmp #'a' ; convert one hex digit |
||
4088 | 6447 F85548 90 02 bcc ?1hex1 |
||
4089 | 6448 F8554A E9 20 sbc #$20 ; capitalize 'a', 'b',... |
||
4090 | 6449 F8554C 38 ?1hex1: sec |
||
4091 | 6450 F8554D E9 3A sbc #('0'+10) ; check digits '0'..'9' |
||
4092 | 6451 F8554F 18 clc |
||
4093 | Tue Jul 17 11:00:18 2018 Page 67 |
||
4094 | |||
4095 | |||
4096 | |||
4097 | |||
4098 | 6452 F85550 69 0A adc #10 |
||
4099 | 6453 F85552 B0 09 bcs ?1hex2 ; ok, valid hex. digit |
||
4100 | 6454 F85554 E9 16 sbc #(6+16) ; check 'A'..'F' |
||
4101 | 6455 F85556 18 clc |
||
4102 | 6456 F85557 69 06 adc #6 |
||
4103 | 6457 F85559 90 17 bcc ?1hex4 ; no hex digit: error |
||
4104 | 6458 F8555B 69 09 adc #9 ; valid hex. digit |
||
4105 | 6459 F8555D 29 0F ?1hex2: and #$0F ; mask low nibble |
||
4106 | 6460 F8555F 18 ?hxok: clc ; digit ok |
||
4107 | 6461 F85560 60 rts |
||
4108 | 6462 F85561 C8 ?hsep: iny ; check valid separator at the end of string |
||
4109 | 6463 F85562 F0 0D beq ?1hex3 ; string index overflow |
||
4110 | 6464 F85564 B7 4C lda [tlp],y ; get next char |
||
4111 | 6465 F85566 F0 F7 beq ?hxok ; ok, end of string |
||
4112 | 6466 F85568 C9 20 cmp #' ' ; should be a separator |
||
4113 | 6467 F8556A F0 F3 beq ?hxok ; blank |
||
4114 | 6468 F8556C C9 08 cmp #$08 |
||
4115 | 6469 F8556E F0 EF beq ?hxok ; tab |
||
4116 | 6470 F85570 C8 iny ; invalid string |
||
4117 | 6471 F85571 88 ?1hex3: dey ; string too long |
||
4118 | 6472 F85572 38 ?1hex4: sec ; error |
||
4119 | 6473 F85573 60 rts |
||
4120 | 6474 |
||
4121 | 6475 F85574 20 12 55 ?ieee: jsr ?ghex ; convert hex. to fp |
||
4122 | 6476 F85577 B0 A5 bcs ?ghx ; error getting significand |
||
4123 | 6477 F85579 20 61 55 jsr ?hsep ; check end of string |
||
4124 | 6478 F8557C B0 A0 bcs ?ghx ; error |
||
4125 | 6479 F8557E A5 0F lda tm+15 |
||
4126 | 6480 F85580 AA tax |
||
4127 | 6481 F85581 29 80 and #$80 |
||
4128 | 6482 F85583 85 24 sta facsgn ; sign |
||
4129 | 6483 F85585 8A txa |
||
4130 | 6484 F85586 29 7F and #$7F |
||
4131 | 6485 F85588 85 23 sta facexp+1 |
||
4132 | 6486 F8558A A5 0E lda tm+14 |
||
4133 | 6487 F8558C 85 22 sta facexp |
||
4134 | 6488 F8558E 38 sec ; hidden bit |
||
4135 | 6489 F8558F 05 23 ora facexp+1 |
||
4136 | 6490 F85591 D0 04 bne ?ie1 ; normal: hidden bit=1 |
||
4137 | 6491 F85593 18 clc ; subnormal: hidden bit=0 |
||
4138 | 6492 F85594 1A inc a |
||
4139 | 6493 F85595 85 22 sta facexp ; subnormal have biased exponent=1 |
||
4140 | 6494 F85597 ?ie1: ACC16 |
||
4141 | 6495 F85597 C2 20 rep #PMFLAG |
||
4142 | 6496 .LONGA on |
||
4143 | 6497 .MNLIST |
||
4144 | 6498 F85599 A5 0C lda tm+12 |
||
4145 | 6499 F8559B 6A ror a ; rotate in hidden bit |
||
4146 | 6500 F8559C 85 20 sta facm+14 |
||
4147 | 6501 F8559E A5 0A lda tm+10 |
||
4148 | 6502 F855A0 6A ror a |
||
4149 | 6503 F855A1 85 1E sta facm+12 |
||
4150 | 6504 F855A3 A5 08 lda tm+8 |
||
4151 | 6505 F855A5 6A ror a |
||
4152 | 6506 F855A6 85 1C sta facm+10 |
||
4153 | 6507 F855A8 A5 06 lda tm+6 |
||
4154 | 6508 F855AA 6A ror a |
||
4155 | Tue Jul 17 11:00:18 2018 Page 68 |
||
4156 | |||
4157 | |||
4158 | |||
4159 | |||
4160 | 6509 F855AB 85 1A sta facm+8 |
||
4161 | 6510 F855AD A5 04 lda tm+4 |
||
4162 | 6511 F855AF 6A ror a |
||
4163 | 6512 F855B0 85 18 sta facm+6 |
||
4164 | 6513 F855B2 A5 02 lda tm+2 |
||
4165 | 6514 F855B4 6A ror a |
||
4166 | 6515 F855B5 85 16 sta facm+4 |
||
4167 | 6516 F855B7 A5 00 lda tm |
||
4168 | 6517 F855B9 6A ror a |
||
4169 | 6518 F855BA 85 14 sta facm+2 |
||
4170 | 6519 F855BC A9 00 00 lda #0 ; significand lsb |
||
4171 | 6520 F855BF 6A ror a |
||
4172 | 6521 F855C0 85 12 sta facm |
||
4173 | 6522 F855C2 05 14 ora facm+2 ; check if zero |
||
4174 | 6523 F855C4 05 16 ora facm+4 |
||
4175 | 6524 F855C6 05 18 ora facm+6 |
||
4176 | 6525 F855C8 05 1A ora facm+8 |
||
4177 | 6526 F855CA 05 1C ora facm+10 |
||
4178 | 6527 F855CC 05 1E ora facm+12 |
||
4179 | 6528 F855CE 05 20 ora facm+14 |
||
4180 | 6529 F855D0 D0 0A bne ?htst |
||
4181 | 6530 F855D2 85 22 sta facexp ; fac = 0 |
||
4182 | 6531 F855D4 ACC08 |
||
4183 | 6532 F855D4 E2 20 sep #PMFLAG |
||
4184 | 6533 .LONGA off |
||
4185 | 6534 .MNLIST |
||
4186 | 6535 F855D6 A9 40 lda #$40 |
||
4187 | 6536 F855D8 85 25 sta facst |
||
4188 | 6537 F855DA 18 clc |
||
4189 | 6538 F855DB 60 rts |
||
4190 | 6539 F855DC ?htst: ACC16 ; test inf/nan |
||
4191 | 6540 F855DC C2 20 rep #PMFLAG |
||
4192 | 6541 .LONGA on |
||
4193 | 6542 .MNLIST |
||
4194 | 6543 F855DE A2 00 ldx #0 |
||
4195 | 6544 F855E0 A5 22 lda facexp |
||
4196 | 6545 F855E2 C9 FF 7F cmp #INFEXP |
||
4197 | 6546 F855E5 90 0B bcc ?ie2 ; valid float |
||
4198 | 6547 F855E7 A2 C0 ldx #$C0 ; assume inf |
||
4199 | 6548 F855E9 A5 20 lda facm+14 ; check type |
||
4200 | 6549 F855EB C9 00 80 cmp #INFSND |
||
4201 | 6550 F855EE F0 02 beq ?ie2 ; set inf in fac stastus |
||
4202 | 6551 F855F0 A2 80 ldx #$80 ; set nan in fac status |
||
4203 | 6552 F855F2 86 25 ?ie2: stx facst |
||
4204 | 6553 F855F4 ACC08 |
||
4205 | 6554 F855F4 E2 20 sep #PMFLAG |
||
4206 | 6555 .LONGA off |
||
4207 | 6556 .MNLIST |
||
4208 | 6557 F855F6 18 clc |
||
4209 | 6558 F855F7 60 rts |
||
4210 | 6559 |
||
4211 | 6560 F855F8 C9 49 ?ginf: cmp #'I' |
||
4212 | 6561 F855FA F0 0E beq ?inf |
||
4213 | 6562 F855FC C9 69 cmp #'i' |
||
4214 | 6563 F855FE F0 0A beq ?inf |
||
4215 | 6564 F85600 C9 4E cmp #'N' |
||
4216 | 6565 F85602 F0 35 beq ?nan |
||
4217 | Tue Jul 17 11:00:18 2018 Page 69 |
||
4218 | |||
4219 | |||
4220 | |||
4221 | |||
4222 | 6566 F85604 C9 6E cmp #'n' |
||
4223 | 6567 F85606 F0 31 beq ?nan |
||
4224 | 6568 F85608 38 sec ; invalid string |
||
4225 | 6569 F85609 60 rts |
||
4226 | 6570 F8560A C8 ?inf: iny |
||
4227 | 6571 F8560B F0 29 beq ?inf3 ; string index overflow |
||
4228 | 6572 F8560D B7 4C lda [tlp],y ; get next char |
||
4229 | 6573 F8560F F0 26 beq ?inf4 ; end of string |
||
4230 | 6574 F85611 09 20 ora #$20 |
||
4231 | 6575 F85613 C9 6E cmp #'n' |
||
4232 | 6576 F85615 D0 20 bne ?inf4 |
||
4233 | 6577 F85617 C8 iny |
||
4234 | 6578 F85618 F0 1C beq ?inf3 ; string index overflow |
||
4235 | 6579 F8561A B7 4C lda [tlp],y ; get next char |
||
4236 | 6580 F8561C F0 19 beq ?inf4 ; end of string |
||
4237 | 6581 F8561E 09 20 ora #$20 |
||
4238 | 6582 F85620 C9 66 cmp #'f' |
||
4239 | 6583 F85622 D0 13 bne ?inf4 |
||
4240 | 6584 F85624 20 61 55 jsr ?hsep ; terminator or separator |
||
4241 | 6585 F85627 B0 0F bcs ?inf5 |
||
4242 | 6586 F85629 84 4F sty fpidx |
||
4243 | 6587 F8562B 20 7D 4E jsr fldinf |
||
4244 | 6588 F8562E 18 ?inf0: clc |
||
4245 | 6589 F8562F A5 B8 lda tmsgn |
||
4246 | 6590 F85631 85 24 sta facsgn |
||
4247 | 6591 F85633 E2 40 sep #PVFLAG |
||
4248 | 6592 F85635 60 rts |
||
4249 | 6593 F85636 88 ?inf3: dey ; string too long |
||
4250 | 6594 F85637 38 ?inf4: sec ; error |
||
4251 | 6595 F85638 60 ?inf5: rts |
||
4252 | 6596 |
||
4253 | 6597 F85639 C8 ?nan: iny |
||
4254 | 6598 F8563A F0 FA beq ?inf3 ; string index overflow |
||
4255 | 6599 F8563C B7 4C lda [tlp],y ; get next char |
||
4256 | 6600 F8563E F0 F7 beq ?inf4 ; end of string |
||
4257 | 6601 F85640 09 20 ora #$20 |
||
4258 | 6602 F85642 C9 61 cmp #'a' |
||
4259 | 6603 F85644 D0 F1 bne ?inf4 |
||
4260 | 6604 F85646 C8 iny |
||
4261 | 6605 F85647 F0 ED beq ?inf3 ; string index overflow |
||
4262 | 6606 F85649 B7 4C lda [tlp],y ; get next char |
||
4263 | 6607 F8564B F0 EA beq ?inf4 ; end of string |
||
4264 | 6608 F8564D 09 20 ora #$20 |
||
4265 | 6609 F8564F C9 6E cmp #'n' |
||
4266 | 6610 F85651 D0 E4 bne ?inf4 |
||
4267 | 6611 F85653 20 61 55 jsr ?hsep ; terminator or separator |
||
4268 | 6612 F85656 B0 E0 bcs ?inf5 |
||
4269 | 6613 F85658 84 4F sty fpidx |
||
4270 | 6614 F8565A 20 74 4E jsr fldnan |
||
4271 | 6615 F8565D 80 CF bra ?inf0 |
||
4272 | 6616 F8565F |
||
4273 | 6617 ;--------------------------------------------------------------------------- |
||
4274 | 6618 ; conversion from binary to decimal |
||
4275 | 6619 ;--------------------------------------------------------------------------- |
||
4276 | 6620 |
||
4277 | 6621 ; int2str - convert an integer to asciiz string (decimal or hexadecimal) |
||
4278 | 6622 ; |
||
4279 | Tue Jul 17 11:00:18 2018 Page 70 |
||
4280 | |||
4281 | |||
4282 | |||
4283 | |||
4284 | 6623 ; This routine is intended to format a string used by sprintf()-like function, |
||
4285 | 6624 ; but can be used in stand-alone mode too. |
||
4286 | 6625 ; |
||
4287 | 6626 ; entry: |
||
4288 | 6627 ; facm = integer (1, 2, 4, 8, 16 bytes) |
||
4289 | 6628 ; |
||
4290 | 6629 ; A = additional formattation flags |
||
4291 | 6630 ; <7>: alternate format |
||
4292 | 6631 ; <6>: group thousands |
||
4293 | 6632 ; <1>: emit a sign '+' rather than a blank (if bit0=1) |
||
4294 | 6633 ; <0>: take account of bit 1, otherwise no '+'/blank emitted |
||
4295 | 6634 ; |
||
4296 | 6635 ; Y = format: x,X,p,P,d |
||
4297 | 6636 ; |
||
4298 | 6637 ; X = precision (minimum number of digits) |
||
4299 | 6638 ; |
||
4300 | 6639 ; exit: |
||
4301 | 6640 ; X = pointer to ascii buffer |
||
4302 | 6641 ; Y = size of buffer |
||
4303 | 6642 ; |
||
4304 | 6643 ; The integer parameter stored in facm will be converted, according to the |
||
4305 | 6644 ; format specifier and the requested precision, formatting the output ascii |
||
4306 | 6645 ; string null-terminated: |
||
4307 | 6646 ; |
||
4308 | 6647 ; p,P format: the integer is interpreted as long pointer (24 bits) and |
||
4309 | 6648 ; formatted as 6 hexadecimal digits prepended by '$' or by |
||
4310 | 6649 ; '0x' or '0X' if alternate format was specified. |
||
4311 | 6650 ; Precision ignored. |
||
4312 | 6651 ; |
||
4313 | 6652 ; x,X format: the integer is converted as unsigned and formatted as |
||
4314 | 6653 ; sequence of hexadecimal digits prepended by '$' or by |
||
4315 | 6654 ; '0x' or '0X' if alternate format was specified. |
||
4316 | 6655 ; |
||
4317 | 6656 ; d format: the integer is converted according to the status byte |
||
4318 | 6657 ; (facst) either as signed or unsigned integer, and |
||
4319 | 6658 ; formatted as sequence of decimal digits. |
||
4320 | 6659 ; If bit 6 of flags is 1, thousands are grouped |
||
4321 | 6660 ; 3 digits by 3 digits, separated by a comma. |
||
4322 | 6661 ; |
||
4323 | 6662 ; The precision, if any, gives the minimum number of digits that must appear; |
||
4324 | 6663 ; if the converted value requires fewer digits, it is padded on the left |
||
4325 | 6664 ; with zeros (precision is ignored for pP format). |
||
4326 | 6665 ; |
||
4327 | 6666 ;------- |
||
4328 | 6667 F8565F int2str: |
||
4329 | 6668 ;------- |
||
4330 | 6669 F8565F 85 CF sta fpaltf ; alternate flag format |
||
4331 | 6670 F85661 98 tya ; A=format char |
||
4332 | 6671 F85662 A0 00 ldy #0 ; upper case |
||
4333 | 6672 F85664 C9 61 cmp #'a' |
||
4334 | 6673 F85666 90 08 bcc ?nc |
||
4335 | 6674 F85668 C9 7B cmp #'z'+1 |
||
4336 | 6675 F8566A B0 04 bcs ?nc |
||
4337 | 6676 F8566C 29 DF and #$DF ; capitalize |
||
4338 | 6677 F8566E A0 20 ldy #$20 ; lower case |
||
4339 | 6678 F85670 84 D0 ?nc: sty fpcap |
||
4340 | 6679 F85672 C9 50 cmp #'P' |
||
4341 | Tue Jul 17 11:00:18 2018 Page 71 |
||
4342 | |||
4343 | |||
4344 | |||
4345 | |||
4346 | 6680 F85674 F0 0A beq ?stf |
||
4347 | 6681 F85676 C9 58 cmp #'X' |
||
4348 | 6682 F85678 F0 06 beq ?stf |
||
4349 | 6683 F8567A C9 44 cmp #'D' |
||
4350 | 6684 F8567C F0 02 beq ?stf |
||
4351 | 6685 F8567E A9 44 lda #'D' ; force 'D' format if unknow one |
||
4352 | 6686 F85680 85 CE ?stf: sta fpfmt ; format style |
||
4353 | 6687 F85682 E0 50 cpx #XCVTMAX ; limit the precision to the buffer size |
||
4354 | 6688 F85684 90 02 bcc ?pr1 |
||
4355 | 6689 F85686 A2 50 ldx #XCVTMAX |
||
4356 | 6690 F85688 C9 50 ?pr1: cmp #'P' ; 'P' format? |
||
4357 | 6691 F8568A D0 02 bne ?pr2 |
||
4358 | 6692 F8568C A2 06 ldx #6 ; fixed precision = 6 for 'P' format |
||
4359 | 6693 F8568E 86 CC ?pr2: stx fpprec ; store wanted precision |
||
4360 | 6694 F85690 C9 44 cmp #'D' |
||
4361 | 6695 F85692 F0 24 beq ?dec ; decimal conversion |
||
4362 | 6696 F85694 A9 06 lda #$06 ; value to add for digits A..F |
||
4363 | 6697 F85696 05 D0 ora fpcap |
||
4364 | 6698 F85698 85 3E sta wftmp |
||
4365 | 6699 F8569A A9 7F lda #$7F ; ignore all format bits but bit 7 |
||
4366 | 6700 F8569C 14 CF trb fpaltf |
||
4367 | 6701 F8569E A2 0F ldx #15 ; counter |
||
4368 | 6702 F856A0 A0 00 ldy #0 |
||
4369 | 6703 F856A2 B5 12 ?hex: lda facm,x |
||
4370 | 6704 F856A4 20 74 5A jsr b2hex ; convert to hexadecimal |
||
4371 | 6705 F856A7 99 50 3F sta !P0FPU+fpstr,y ; store high digit |
||
4372 | 6706 F856AA C8 iny |
||
4373 | 6707 F856AB EB xba |
||
4374 | 6708 F856AC 99 50 3F sta !P0FPU+fpstr,y ; store low digit |
||
4375 | 6709 F856AF C8 iny |
||
4376 | 6710 F856B0 CA dex |
||
4377 | 6711 F856B1 10 EF bpl ?hex |
||
4378 | 6712 F856B3 BB tyx |
||
4379 | 6713 F856B4 74 50 stz fpstr,x ; put terminator |
||
4380 | 6714 F856B6 80 03 bra ?fmt ; final formattation |
||
4381 | 6715 F856B8 20 64 5B ?dec: jsr int2dec ; convert to decimal |
||
4382 | 6716 F856BB A2 50 ?fmt: ldx #fpstr ; get pointer to first and last digits |
||
4383 | 6717 F856BD 20 40 57 jsr ?frst ; X -> first, Y->last, A=size |
||
4384 | 6718 F856C0 20 1B 57 jsr ?thg ; move (and group) to the xcvt |
||
4385 | 6719 F856C3 BB tyx ; X = pointer to fisrt significative digit |
||
4386 | 6720 F856C4 85 3E sta wftmp ; A = size of significative string |
||
4387 | 6721 F856C6 A5 CC lda fpprec |
||
4388 | 6722 F856C8 38 sec |
||
4389 | 6723 F856C9 E5 3E sbc wftmp |
||
4390 | 6724 F856CB F0 0C beq ?nop ; no padding needs |
||
4391 | 6725 F856CD 90 0A bcc ?nop ; no padding needs |
||
4392 | 6726 F856CF A0 30 ldy #'0' |
||
4393 | 6727 F856D1 CA ?pad: dex |
||
4394 | 6728 F856D2 94 00 sty <0,x ; padding string with '0' |
||
4395 | 6729 F856D4 3A dec a |
||
4396 | 6730 F856D5 D0 FA bne ?pad |
||
4397 | 6731 F856D7 A5 CC lda fpprec |
||
4398 | 6732 F856D9 A8 ?nop: tay ; Y = string size |
||
4399 | 6733 F856DA A5 CE lda fpfmt |
||
4400 | 6734 F856DC C9 44 cmp #'D' |
||
4401 | 6735 F856DE F0 1D beq ?sts ; decimal formattation |
||
4402 | 6736 F856E0 C9 50 cmp #'P' |
||
4403 | Tue Jul 17 11:00:18 2018 Page 72 |
||
4404 | |||
4405 | |||
4406 | |||
4407 | |||
4408 | 6737 F856E2 D0 02 bne ?hx0 |
||
4409 | 6738 F856E4 A2 C5 ldx #XCVTEND-6 |
||
4410 | 6739 F856E6 24 CF ?hx0: bit fpaltf |
||
4411 | 6740 F856E8 10 0C bpl ?hx1 ; '$' prefix |
||
4412 | 6741 F856EA CA dex |
||
4413 | 6742 F856EB A9 58 lda #'X' |
||
4414 | 6743 F856ED 05 D0 ora fpcap ; add lower case |
||
4415 | 6744 F856EF 95 00 sta <0,x |
||
4416 | 6745 F856F1 C8 iny ; update size |
||
4417 | 6746 F856F2 A9 30 lda #'0' ; '0x' or '0X' prefix |
||
4418 | 6747 F856F4 80 02 bra ?hx2 |
||
4419 | 6748 F856F6 A9 24 ?hx1: lda #'$' |
||
4420 | 6749 F856F8 CA ?hx2: dex |
||
4421 | 6750 F856F9 95 00 sta <0,x |
||
4422 | 6751 F856FB C8 iny ; update size |
||
4423 | 6752 F856FC 60 rts |
||
4424 | 6753 F856FD 84 4F ?sts: sty fpidx ; store sign according format flags |
||
4425 | 6754 F856FF 24 4A bit dsgn ; sign test |
||
4426 | 6755 F85701 10 04 bpl ?sts1 ; positive |
||
4427 | 6756 F85703 A0 2D ldy #'-' ; negative: store sign '-' |
||
4428 | 6757 F85705 80 0C bra ?sts2 |
||
4429 | 6758 F85707 A5 CF ?sts1: lda fpaltf ; check if should store sign/blank |
||
4430 | 6759 F85709 4A lsr a ; fpaltf<0>: 1 if should store |
||
4431 | 6760 F8570A 90 0C bcc ?done ; no store |
||
4432 | 6761 F8570C A0 2B ldy #'+' |
||
4433 | 6762 F8570E 4A lsr a ; fpaltf<1>: 1 if should store blank |
||
4434 | 6763 F8570F B0 02 bcs ?sts2 ; store '+' sign |
||
4435 | 6764 F85711 A0 20 ldy #' ' ; store blank |
||
4436 | 6765 F85713 CA ?sts2: dex |
||
4437 | 6766 F85714 94 00 sty <0,x |
||
4438 | 6767 F85716 E6 4F inc fpidx |
||
4439 | 6768 F85718 A4 4F ?done: ldy fpidx |
||
4440 | 6769 F8571A 60 rts |
||
4441 | 6770 |
||
4442 | 6771 ; move digits from fpstr buffer to xcvt buffer and |
||
4443 | 6772 ; group the digits in thousands (use comma as separator) |
||
4444 | 6773 ; on entry: Y = index of first significative digit on fpstr |
||
4445 | 6774 ; X = pointer to last digit on fpstr |
||
4446 | 6775 ; on exit: Y = pointer to first significative digit |
||
4447 | 6776 ; A = size of string |
||
4448 | 6777 ; X = pointer to last digit |
||
4449 | 6778 F8571B 84 3E ?thg: sty wftmp ; index of first significative digit |
||
4450 | 6779 F8571D 9B txy ; Y = pointer to last digit |
||
4451 | 6780 F8571E A2 CB ldx #XCVTEND ; X = pointer to end of xcvt buffer |
||
4452 | 6781 F85720 74 00 stz <0,x ; put string terminator |
||
4453 | 6782 F85722 CA dex ; bump pointer |
||
4454 | 6783 F85723 A9 03 ?thg2: lda #3 ; goups 3 digits |
||
4455 | 6784 F85725 EB ?thg4: xba ; B = digits counter |
||
4456 | 6785 F85726 B9 00 3F lda !P0FPU,y ; A = current digit |
||
4457 | 6786 F85729 95 00 sta <0,x ; move digit |
||
4458 | 6787 F8572B 88 dey |
||
4459 | 6788 F8572C C4 3E cpy wftmp ; finish? |
||
4460 | 6789 F8572E 90 10 bcc ?frst ; yes |
||
4461 | 6790 F85730 EB xba ; A = digits counter |
||
4462 | 6791 F85731 CA dex |
||
4463 | 6792 F85732 3A dec a |
||
4464 | 6793 F85733 D0 F0 bne ?thg4 ; groups 3 digits |
||
4465 | Tue Jul 17 11:00:18 2018 Page 73 |
||
4466 | |||
4467 | |||
4468 | |||
4469 | |||
4470 | 6794 F85735 24 CF bit fpaltf ; check if should groups thousands |
||
4471 | 6795 F85737 50 EA bvc ?thg2 ; no groups |
||
4472 | 6796 F85739 A9 2C lda #',' ; thousands separator |
||
4473 | 6797 F8573B 95 00 sta <0,x |
||
4474 | 6798 F8573D CA dex |
||
4475 | 6799 F8573E 80 E3 bra ?thg2 ; repeat until end of source string |
||
4476 | 6800 |
||
4477 | 6801 ; get the pointer to first significative digit (not '0') |
||
4478 | 6802 ; on entry: X = pointer to first digit |
||
4479 | 6803 ; on exit: Y = pointer to first significative digit |
||
4480 | 6804 ; A = size of string |
||
4481 | 6805 ; X = pointer to last digit |
||
4482 | 6806 F85740 86 3F ?frst: stx wftmp+1 |
||
4483 | 6807 F85742 B5 00 ?fr0: lda <0,x |
||
4484 | 6808 F85744 F0 07 beq ?fr1 ; end of string |
||
4485 | 6809 F85746 C9 30 cmp #'0' |
||
4486 | 6810 F85748 D0 04 bne ?fr2 ; first significative digit |
||
4487 | 6811 F8574A E8 inx |
||
4488 | 6812 F8574B 80 F5 bra ?fr0 ; search again |
||
4489 | 6813 F8574D CA ?fr1: dex ; X = pointer to last digit |
||
4490 | 6814 F8574E 9B ?fr2: txy ; Y = pointer to first significative digit |
||
4491 | 6815 F8574F A6 3F ldx wftmp+1 ; start of string |
||
4492 | 6816 F85751 B5 00 ?fr3: lda <0,x ; search end of string |
||
4493 | 6817 F85753 F0 03 beq ?fr4 |
||
4494 | 6818 F85755 E8 inx |
||
4495 | 6819 F85756 80 F9 bra ?fr3 |
||
4496 | 6820 F85758 CA ?fr4: dex ; X = pointer to last digit |
||
4497 | 6821 F85759 8A txa |
||
4498 | 6822 F8575A 84 3E sty wftmp |
||
4499 | 6823 F8575C 38 sec |
||
4500 | 6824 F8575D E5 3E sbc wftmp |
||
4501 | 6825 F8575F 1A inc a ; significative string size |
||
4502 | 6826 F85760 60 rts |
||
4503 | 6827 |
||
4504 | 6828 ; fp2str - convert a quadruple precision floating point to asciiz string |
||
4505 | 6829 ; |
||
4506 | 6830 ; This routine is intended to format a string used by sprintf()-like function, |
||
4507 | 6831 ; but can be used in stand-alone mode too. |
||
4508 | 6832 ; |
||
4509 | 6833 ; entry: |
||
4510 | 6834 ; fac = floating point argument |
||
4511 | 6835 ; |
||
4512 | 6836 ; A = additional formattation flags |
||
4513 | 6837 ; <7>: alternate format |
||
4514 | 6838 ; <6>: not discriminate +0.0 from -0.0 |
||
4515 | 6839 ; <1>: emit a sign '+' rather than a blank (if bit0=1) |
||
4516 | 6840 ; <0>: take account of bit 1, otherwise no '+'/blank emitted |
||
4517 | 6841 ; |
||
4518 | 6842 ; Y = format: e,E,f,F,g,G,a,A,k,K |
||
4519 | 6843 ; |
||
4520 | 6844 ; X = precision/count of decimal digits (after the '.') |
||
4521 | 6845 ; |
||
4522 | 6846 ; exit: |
||
4523 | 6847 ; X = pointer to ascii buffer |
||
4524 | 6848 ; Y = size of buffer |
||
4525 | 6849 ; |
||
4526 | 6850 ; The formatted decimal string is either the f/F format: |
||
4527 | Tue Jul 17 11:00:18 2018 Page 74 |
||
4528 | |||
4529 | |||
4530 | |||
4531 | |||
4532 | 6851 ; [sign]ddd.ddd |
||
4533 | 6852 ; or the e/E format: |
||
4534 | 6853 ; [sign]d.ddde+|-[d][d]dd |
||
4535 | 6854 ; where the number of digits after the decimal-point character is equal to |
||
4536 | 6855 ; precision specification. The exponent in E format always contains at least |
||
4537 | 6856 ; two digits; if the value is zero, the exponent is 00. |
||
4538 | 6857 ; In the G format, precision specifies the number of significant digits: if |
||
4539 | 6858 ; it is zero, is teeated as 1. G format can format decimal string in E style |
||
4540 | 6859 ; or F style: style E is used if the exponent from its conversion is less |
||
4541 | 6860 ; than MINGEXP or greater than or equal to the precision. |
||
4542 | 6861 ; Trailing decimal points are usually suppressed, as also are trailing |
||
4543 | 6862 ; fraction zeroes in the G/g format. If bit 7 of additional flag is 1 |
||
4544 | 6863 ; then trailing decimal dot remain, and G/g format will not trim zeroes. |
||
4545 | 6864 ; The format a/A format an hexadecimal string that contain 32 hexadecimal |
||
4546 | 6865 ; digits (the content of the 128 bits mantissa), followed by the biased |
||
4547 | 6866 ; exponent (introduced by literal 'p' or 'P'), or-ed at bit 15 with sign of |
||
4548 | 6867 ; the float. Hexadecimal string is prepended either by '$' or '0x' or '0X'. |
||
4549 | 6868 ; The no-standard format k/K format an hexadecimal string that contain the 32 |
||
4550 | 6869 ; hexadecimal digits of the packed float (ieee format). |
||
4551 | 6870 ; Hexadecimal string is prepended by '#'. |
||
4552 | 6871 ; |
||
4553 | 6872 ; The result formatted string can have at max. XCVTMAX characters: if the |
||
4554 | 6873 ; requested format & precision cannot fit into this limit, the format is |
||
4555 | 6874 ; switched to 'E' and limited in size. |
||
4556 | 6875 ; |
||
4557 | 6876 ;------ |
||
4558 | 6877 F85761 fp2str: |
||
4559 | 6878 ;------ |
||
4560 | 6879 F85761 85 CF sta fpaltf ; alternate flag format |
||
4561 | 6880 F85763 64 D1 stz fpstyle ; assume 'E' style |
||
4562 | 6881 F85765 98 tya ; A=format char |
||
4563 | 6882 F85766 A0 00 ldy #0 ; upper case |
||
4564 | 6883 F85768 C9 61 cmp #'a' |
||
4565 | 6884 F8576A 90 08 bcc ?nc |
||
4566 | 6885 F8576C C9 7B cmp #'z'+1 |
||
4567 | 6886 F8576E B0 04 bcs ?nc |
||
4568 | 6887 F85770 29 DF and #$DF ; capitalize |
||
4569 | 6888 F85772 A0 20 ldy #$20 ; lower case |
||
4570 | 6889 F85774 84 D0 ?nc: sty fpcap |
||
4571 | 6890 F85776 C9 45 cmp #'E' |
||
4572 | 6891 F85778 F0 0E beq ?stf |
||
4573 | 6892 F8577A C9 46 cmp #'F' |
||
4574 | 6893 F8577C F0 0A beq ?stf |
||
4575 | 6894 F8577E C9 41 cmp #'A' |
||
4576 | 6895 F85780 F0 06 beq ?stf |
||
4577 | 6896 F85782 C9 4B cmp #'K' |
||
4578 | 6897 F85784 F0 02 beq ?stf |
||
4579 | 6898 F85786 A9 47 lda #'G' ; force 'G' format if unknow one |
||
4580 | 6899 F85788 85 CE ?stf: sta fpfmt ; format style |
||
4581 | 6900 F8578A E0 50 cpx #XCVTMAX ; limit the precision to the buffer size |
||
4582 | 6901 F8578C 90 02 bcc ?pr1 |
||
4583 | 6902 F8578E A2 50 ldx #XCVTMAX |
||
4584 | 6903 F85790 C9 47 ?pr1: cmp #'G' ; 'G' format? |
||
4585 | 6904 F85792 D0 05 bne ?pr2 ; no |
||
4586 | 6905 F85794 9B txy ; if precision=0 and 'G' format... |
||
4587 | 6906 F85795 F0 06 beq ?pr3 ; ...then set precision=1 |
||
4588 | 6907 F85797 D0 05 bne ?pr4 ; significant digits for 'G' format |
||
4589 | Tue Jul 17 11:00:18 2018 Page 75 |
||
4590 | |||
4591 | |||
4592 | |||
4593 | |||
4594 | 6908 F85799 C9 45 ?pr2: cmp #'E' ; 'E' format? |
||
4595 | 6909 F8579B D0 01 bne ?pr4 ; no |
||
4596 | 6910 F8579D E8 ?pr3: inx ; 'E' format need one digit more |
||
4597 | 6911 F8579E 86 CC ?pr4: stx fpprec ; store wanted precision |
||
4598 | 6912 F857A0 64 CD stz fpprec+1 ; extend precision P to 16 bits |
||
4599 | 6913 |
||
4600 | 6914 ; P=fpprec specifies significant digits for 'E' & 'G' format, |
||
4601 | 6915 ; and digit counts of fractional part for 'F' format |
||
4602 | 6916 F857A2 |
||
4603 | 6917 F857A2 C9 41 cmp #'A' ; 'A' format? |
||
4604 | 6918 F857A4 D0 5B bne ?kfmt ; no |
||
4605 | 6919 F857A6 |
||
4606 | 6920 ; format floating point as hexadecimal full mantissa |
||
4607 | 6921 ; plus biased exponent (or-ed with mantissa sign) |
||
4608 | 6922 F857A6 A0 00 ldy #0 ; string index |
||
4609 | 6923 F857A8 24 CF bit fpaltf |
||
4610 | 6924 F857AA 10 0C bpl ?a1 ; '$' prfix |
||
4611 | 6925 F857AC A2 30 ldx #'0' ; '0x' or '0X' prefix |
||
4612 | 6926 F857AE 96 78 stx xcvt,y |
||
4613 | 6927 F857B0 C8 iny |
||
4614 | 6928 F857B1 A9 58 lda #'X' |
||
4615 | 6929 F857B3 05 D0 ora fpcap ; add lower case |
||
4616 | 6930 F857B5 AA tax |
||
4617 | 6931 F857B6 80 02 bra ?a2 |
||
4618 | 6932 F857B8 A2 24 ?a1: ldx #'$' |
||
4619 | 6933 F857BA 96 78 ?a2: stx xcvt,y |
||
4620 | 6934 F857BC C8 iny |
||
4621 | 6935 F857BD A9 06 lda #$06 ; value to add for digits A..F |
||
4622 | 6936 F857BF 05 D0 ora fpcap |
||
4623 | 6937 F857C1 85 3E sta wftmp |
||
4624 | 6938 F857C3 A2 0F ldx #15 ; counter |
||
4625 | 6939 F857C5 B5 12 ?a4: lda facm,x |
||
4626 | 6940 F857C7 20 74 5A jsr b2hex ; convert |
||
4627 | 6941 F857CA 99 78 3F sta !P0FPU+xcvt,y ; store high digit |
||
4628 | 6942 F857CD C8 iny |
||
4629 | 6943 F857CE EB xba |
||
4630 | 6944 F857CF 99 78 3F sta !P0FPU+xcvt,y ; store low digit |
||
4631 | 6945 F857D2 C8 iny |
||
4632 | 6946 F857D3 CA dex |
||
4633 | 6947 F857D4 10 EF bpl ?a4 |
||
4634 | 6948 F857D6 A9 50 lda #'P' ; exponent separator |
||
4635 | 6949 F857D8 05 D0 ora fpcap |
||
4636 | 6950 F857DA AA tax |
||
4637 | 6951 F857DB 96 78 stx xcvt,y |
||
4638 | 6952 F857DD C8 iny |
||
4639 | 6953 F857DE A5 24 lda facsgn |
||
4640 | 6954 F857E0 29 80 and #$80 ; mask sign |
||
4641 | 6955 F857E2 05 23 ora facexp+1 |
||
4642 | 6956 F857E4 20 74 5A jsr b2hex ; convert high exponent + sign |
||
4643 | 6957 F857E7 99 78 3F sta !P0FPU+xcvt,y ; store high digit |
||
4644 | 6958 F857EA C8 iny |
||
4645 | 6959 F857EB EB xba |
||
4646 | 6960 F857EC 99 78 3F sta !P0FPU+xcvt,y ; store low digit |
||
4647 | 6961 F857EF C8 iny |
||
4648 | 6962 F857F0 A5 22 lda facexp |
||
4649 | 6963 F857F2 20 74 5A jsr b2hex ; convert low exponent |
||
4650 | 6964 F857F5 99 78 3F sta !P0FPU+xcvt,y ; store high digit |
||
4651 | Tue Jul 17 11:00:18 2018 Page 76 |
||
4652 | |||
4653 | |||
4654 | |||
4655 | |||
4656 | 6965 F857F8 C8 iny |
||
4657 | 6966 F857F9 EB xba |
||
4658 | 6967 F857FA 99 78 3F sta !P0FPU+xcvt,y ; store low digit |
||
4659 | 6968 F857FD C8 iny |
||
4660 | 6969 F857FE 4C A7 58 jmp ?done |
||
4661 | 6970 |
||
4662 | 6971 F85801 C9 4B ?kfmt cmp #'K' ; packed format? |
||
4663 | 6972 F85803 D0 2B bne ?cvt ; no |
||
4664 | 6973 F85805 A9 00 lda #tm |
||
4665 | 6974 F85807 A2 3F ldx #>P0FPU |
||
4666 | 6975 F85809 A0 00 ldy #0 |
||
4667 | 6976 F8580B 20 54 4D jsr fpack ; pack to tm..tm+15 |
||
4668 | 6977 F8580E A0 00 ldy #0 |
||
4669 | 6978 F85810 A2 23 ldx #'#' |
||
4670 | 6979 F85812 96 78 stx xcvt,y |
||
4671 | 6980 F85814 C8 iny |
||
4672 | 6981 F85815 A9 06 lda #$06 ; value to add for digits A..F |
||
4673 | 6982 F85817 05 D0 ora fpcap |
||
4674 | 6983 F85819 85 3E sta wftmp |
||
4675 | 6984 F8581B A2 0F ldx #15 ; counter |
||
4676 | 6985 F8581D B5 00 ?kl: lda tm,x |
||
4677 | 6986 F8581F 20 74 5A jsr b2hex ; convert |
||
4678 | 6987 F85822 99 78 3F sta !P0FPU+xcvt,y ; store high digit |
||
4679 | 6988 F85825 C8 iny |
||
4680 | 6989 F85826 EB xba |
||
4681 | 6990 F85827 99 78 3F sta !P0FPU+xcvt,y ; store low digit |
||
4682 | 6991 F8582A C8 iny |
||
4683 | 6992 F8582B CA dex |
||
4684 | 6993 F8582C 10 EF bpl ?kl |
||
4685 | 6994 F8582E 80 77 bra ?done |
||
4686 | 6995 F85830 |
||
4687 | 6996 ; The basic conversion to a decimal string is done by fp2dec, |
||
4688 | 6997 ; with this function responsible for "customizing" the simple |
||
4689 | 6998 ; format which fp2dec returns. |
||
4690 | 6999 F85830 20 89 5A ?cvt: jsr fp2dec ; let E=dexp=decimal exponent |
||
4691 | 7000 F85833 24 25 bit facst ; fac is valid? |
||
4692 | 7001 F85835 10 14 bpl ?vf ; yes |
||
4693 | 7002 F85837 20 E0 59 jsr ?sts ; store sign |
||
4694 | 7003 F8583A A2 00 ldx #0 ; store string NAN or INF |
||
4695 | 7004 F8583C B5 50 ?inv: lda fpstr,x |
||
4696 | 7005 F8583E 05 D0 ora fpcap ; add lower case |
||
4697 | 7006 F85840 99 78 3F sta !P0FPU+xcvt,y ; store |
||
4698 | 7007 F85843 C8 iny |
||
4699 | 7008 F85844 E8 inx |
||
4700 | 7009 F85845 E0 03 cpx #3 |
||
4701 | 7010 F85847 90 F3 bcc ?inv |
||
4702 | 7011 F85849 80 5C bra ?done ; done |
||
4703 | 7012 F8584B 20 FA 59 ?vf: jsr ?round10 ; round up decimal number |
||
4704 | 7013 F8584E |
||
4705 | 7014 ; Now that we have the basic string, decide what format the caller |
||
4706 | 7015 ; wants it to be put into. Use the F format if either of the |
||
4707 | 7016 ; following is true: |
||
4708 | 7017 ; o+ the format is 'f' or 'F' |
||
4709 | 7018 ; o+ the format is 'g' or 'G' and the exponent |
||
4710 | 7019 ; is between MINGEXP and precision (fpprec) |
||
4711 | 7020 ; and if overall digits count is less than XCVTMAX. |
||
4712 | 7021 F8584E A5 CE lda fpfmt |
||
4713 | Tue Jul 17 11:00:18 2018 Page 77 |
||
4714 | |||
4715 | |||
4716 | |||
4717 | |||
4718 | 7022 F85850 C9 45 cmp #'E' |
||
4719 | 7023 F85852 F0 42 beq ?end2 ; caller wants 'E' format |
||
4720 | 7024 F85854 C9 47 cmp #'G' |
||
4721 | 7025 F85856 ACC16CLC |
||
4722 | 7026 F85856 C2 21 rep #(PMFLAG.OR.PCFLAG) |
||
4723 | 7027 .LONGA on |
||
4724 | 7028 .MNLIST |
||
4725 | 7029 F85858 D0 1C bne ?ff ; caller wants 'F' format |
||
4726 | 7030 F8585A A5 48 lda dexp ; if E < 0... |
||
4727 | 7031 F8585C 30 08 bmi ?g1 ; ...compare vs. MINGEXP |
||
4728 | 7032 F8585E C5 CC cmp fpprec ; ...else compare with P |
||
4729 | 7033 F85860 B0 32 bcs ?end ; if E >= P select 'E' style |
||
4730 | 7034 F85862 A5 CC lda fpprec ; 'G' format, E>=0: overall digits count = P |
||
4731 | 7035 F85864 80 0C bra ?g2 |
||
4732 | 7036 F85866 C9 FC FF ?g1: cmp #MINGEXP |
||
4733 | 7037 F85869 90 29 bcc ?end ; if E < MINGEXP select 'E' style |
||
4734 | 7038 F8586B 49 FF FF eor #$FFFF ; complement decimal exponent |
||
4735 | 7039 F8586E 1A inc a |
||
4736 | 7040 F8586F 18 clc |
||
4737 | 7041 F85870 65 CC adc fpprec ; 'G' format, E<0... |
||
4738 | 7042 F85872 85 3E ?g2: sta wftmp ; ...overall digits count = |E|+P |
||
4739 | 7043 F85874 80 0B bra ?f2 |
||
4740 | 7044 F85876 A5 CC ?ff: lda fpprec ; 'F' format: P = P + 1 |
||
4741 | 7045 F85878 1A inc a |
||
4742 | 7046 F85879 A6 49 ldx dexp+1 |
||
4743 | 7047 F8587B 30 02 bmi ?f1 ; 'F', E<0: overall digits count = P+1 |
||
4744 | 7048 F8587D 65 48 adc dexp ; 'F', E>=0: overall digits count = E+P+1 |
||
4745 | 7049 F8587F 85 3E ?f1: sta wftmp |
||
4746 | 7050 F85881 C9 50 00 ?f2: cmp #XCVTMAX ; fit into buffer? |
||
4747 | 7051 F85884 ACC08 |
||
4748 | 7052 F85884 E2 20 sep #PMFLAG |
||
4749 | 7053 .LONGA off |
||
4750 | 7054 .MNLIST |
||
4751 | 7055 F85886 90 06 bcc ?f3 ; yes |
||
4752 | 7056 F85888 A9 24 lda #MAXDIGITS |
||
4753 | 7057 F8588A 85 CC sta fpprec |
||
4754 | 7058 F8588C B0 08 bcs ?end2 ; force 'E' style |
||
4755 | 7059 F8588E A2 80 ?f3: ldx #$80 |
||
4756 | 7060 F85890 86 D1 stx fpstyle ; select 'F' style |
||
4757 | 7061 F85892 80 02 bra ?end2 |
||
4758 | 7062 F85894 ?end: ACC08 |
||
4759 | 7063 F85894 E2 20 sep #PMFLAG |
||
4760 | 7064 .LONGA off |
||
4761 | 7065 .MNLIST |
||
4762 | 7066 F85896 20 E0 59 ?end2: jsr ?sts ; emit sign |
||
4763 | 7067 F85899 84 4F sty fpidx ; index of the first digit |
||
4764 | 7068 F8589B 24 D1 bit fpstyle ; 'F' format? |
||
4765 | 7069 F8589D 10 05 bpl ?ee ; no, 'E' format |
||
4766 | 7070 F8589F 20 AE 58 jsr ?ffmt |
||
4767 | 7071 F858A2 80 03 bra ?done |
||
4768 | 7072 F858A4 20 33 59 ?ee: jsr ?efmt |
||
4769 | 7073 F858A7 A2 00 ?done: ldx #0 |
||
4770 | 7074 F858A9 96 78 stx xcvt,y |
||
4771 | 7075 F858AB A2 78 ldx #xcvt |
||
4772 | 7076 F858AD 60 rts |
||
4773 | 7077 |
||
4774 | 7078 ; If E<0, the 'F' format place a digit '0' followed by a decimal dot, |
||
4775 | Tue Jul 17 11:00:18 2018 Page 78 |
||
4776 | |||
4777 | |||
4778 | |||
4779 | |||
4780 | 7079 ; followed by |E|-1 leading zeroes. After, place all needs significant |
||
4781 | 7080 ; digits. |
||
4782 | 7081 F858AE 64 4B ?ffmt: stz fpdot |
||
4783 | 7082 F858B0 A5 48 lda dexp ; exponent E |
||
4784 | 7083 F858B2 10 1A bpl ?ffp ; E>=0 |
||
4785 | 7084 F858B4 A2 30 ldx #'0' |
||
4786 | 7085 F858B6 96 78 stx xcvt,y |
||
4787 | 7086 F858B8 C8 iny |
||
4788 | 7087 F858B9 A2 2E ldx #'.' |
||
4789 | 7088 F858BB 96 78 stx xcvt,y |
||
4790 | 7089 F858BD C8 iny |
||
4791 | 7090 F858BE C6 3E dec wftmp ; update digits count |
||
4792 | 7091 F858C0 C6 4B dec fpdot ; decimal dot indicatr |
||
4793 | 7092 F858C2 A2 30 ldx #'0' |
||
4794 | 7093 F858C4 1A ?ff0: inc a |
||
4795 | 7094 F858C5 F0 08 beq ?ffr ; when E=0 put significant... |
||
4796 | 7095 F858C7 96 78 stx xcvt,y ; put leading zeroes... |
||
4797 | 7096 F858C9 C8 iny |
||
4798 | 7097 F858CA C6 3E dec wftmp |
||
4799 | 7098 F858CC 80 F6 bra ?ff0 ; ...until E=0 |
||
4800 | 7099 F858CE 1A ?ffp: inc a ; we increment exponent for easily manage '.' |
||
4801 | 7100 F858CF A2 00 ?ffr: ldx #0 ; index |
||
4802 | 7101 F858D1 85 46 sta scexp ; save current exponent |
||
4803 | 7102 F858D3 |
||
4804 | 7103 ; Now write the regular digits, inserting a '.' if it is somewhere |
||
4805 | 7104 ; in the middle of the numeral. |
||
4806 | 7105 F858D3 B5 50 ?ffl: lda fpstr,x ; regular digit |
||
4807 | 7106 F858D5 F0 15 beq ?ff2 ; end |
||
4808 | 7107 F858D7 99 78 3F sta !P0FPU+xcvt,y ; store digit |
||
4809 | 7108 F858DA C8 iny |
||
4810 | 7109 F858DB E8 inx |
||
4811 | 7110 F858DC C6 3E dec wftmp |
||
4812 | 7111 F858DE C6 46 dec scexp |
||
4813 | 7112 F858E0 D0 F1 bne ?ffl ; loop until last digit or E=0 |
||
4814 | 7113 F858E2 A9 2E lda #'.' |
||
4815 | 7114 F858E4 99 78 3F sta !P0FPU+xcvt,y ; store '.' |
||
4816 | 7115 F858E7 C8 iny |
||
4817 | 7116 F858E8 C6 4B dec fpdot ; decimal dot indicatr |
||
4818 | 7117 F858EA 80 E7 bra ?ffl |
||
4819 | 7118 F858EC A6 48 ?ff2: ldx dexp |
||
4820 | 7119 F858EE 30 19 bmi ?ff4 ; 0.dddd... form |
||
4821 | 7120 F858F0 24 4B bit fpdot |
||
4822 | 7121 F858F2 30 15 bmi ?ff4 ; no more integral digits |
||
4823 | 7122 F858F4 A5 46 lda scexp ; ddd.ddd... form |
||
4824 | 7123 F858F6 F0 11 beq ?ff4 ; no more integral digits |
||
4825 | 7124 F858F8 A2 30 ldx #'0' ; must complete an integral number padding it.. |
||
4826 | 7125 F858FA 96 78 ?ff3: stx xcvt,y ; ...with zeroes |
||
4827 | 7126 F858FC C8 iny |
||
4828 | 7127 F858FD C6 3E dec wftmp |
||
4829 | 7128 F858FF 3A dec a |
||
4830 | 7129 F85900 D0 F8 bne ?ff3 |
||
4831 | 7130 F85902 A2 2E ldx #'.' ; put in a trailing decimal dot |
||
4832 | 7131 F85904 96 78 stx xcvt,y |
||
4833 | 7132 F85906 C8 iny |
||
4834 | 7133 F85907 C6 4B dec fpdot ; decimal dot indicator |
||
4835 | 7134 F85909 A5 CE ?ff4: lda fpfmt |
||
4836 | 7135 F8590B C9 47 cmp #'G' ; 'G' format remove trailing zeroes... |
||
4837 | Tue Jul 17 11:00:18 2018 Page 79 |
||
4838 | |||
4839 | |||
4840 | |||
4841 | |||
4842 | 7136 F8590D D0 0B bne ?ff5 |
||
4843 | 7137 F8590F 24 CF bit fpaltf ; ...if not alternate format |
||
4844 | 7138 F85911 30 07 bmi ?ff5 |
||
4845 | 7139 F85913 24 4B bit fpdot ; ...and if was putted in a decimal dot |
||
4846 | 7140 F85915 10 03 bpl ?ff5 |
||
4847 | 7141 F85917 4C CF 59 jmp ?trim ; trim trailing zeroes |
||
4848 | 7142 F8591A A5 3E ?ff5: lda wftmp ; pad string with '0' |
||
4849 | 7143 F8591C F0 08 beq ?ff7 |
||
4850 | 7144 F8591E A2 30 ldx #'0' |
||
4851 | 7145 F85920 96 78 ?ff6: stx xcvt,y |
||
4852 | 7146 F85922 C8 iny |
||
4853 | 7147 F85923 3A dec a |
||
4854 | 7148 F85924 D0 FA bne ?ff6 |
||
4855 | 7149 F85926 24 CF ?ff7: bit fpaltf ; trim trailing '.' if any... |
||
4856 | 7150 F85928 30 08 bmi ?ff8 ; ...and not alternate format |
||
4857 | 7151 F8592A 88 dey |
||
4858 | 7152 F8592B B6 78 ldx xcvt,y |
||
4859 | 7153 F8592D E0 2E cpx #'.' |
||
4860 | 7154 F8592F F0 01 beq ?ff8 |
||
4861 | 7155 F85931 C8 iny |
||
4862 | 7156 F85932 60 ?ff8: rts |
||
4863 | 7157 |
||
4864 | 7158 ; The E format always places one digit to the left of the decimal |
||
4865 | 7159 ; point, followed by fraction digits, and then an 'E' followed |
||
4866 | 7160 ; by a decimal exponent. The exponent is always 2 digits unless |
||
4867 | 7161 ; it is of magnitude > 99. |
||
4868 | 7162 F85933 A6 CC ?efmt: ldx fpprec |
||
4869 | 7163 F85935 E0 4A cpx #XCVTMAX-6 |
||
4870 | 7164 F85937 90 02 bcc ?e0 |
||
4871 | 7165 F85939 A2 4A ldx #XCVTMAX-6 |
||
4872 | 7166 F8593B 86 3E ?e0: stx wftmp ; overall digits count |
||
4873 | 7167 F8593D A2 00 ldx #0 ; decimal string index |
||
4874 | 7168 F8593F B5 50 lda fpstr,x |
||
4875 | 7169 F85941 99 78 3F sta !P0FPU+xcvt,y ; store first digit |
||
4876 | 7170 F85944 C6 3E dec wftmp |
||
4877 | 7171 F85946 E8 inx |
||
4878 | 7172 F85947 C8 iny |
||
4879 | 7173 F85948 A9 2E lda #'.' ; decimal dot |
||
4880 | 7174 F8594A EB xba ; B='.' |
||
4881 | 7175 F8594B B5 50 lda fpstr,x ; follow a digit? |
||
4882 | 7176 F8594D D0 0B bne ?e2 ; yes |
||
4883 | 7177 F8594F 24 CF bit fpaltf ; if alternate format is false... |
||
4884 | 7178 F85951 10 36 bpl ?exx ; ...not emit trailing '.' |
||
4885 | 7179 F85953 EB xba ; otherwise yes |
||
4886 | 7180 F85954 99 78 3F sta !P0FPU+xcvt,y ; store '.' |
||
4887 | 7181 F85957 C8 iny |
||
4888 | 7182 F85958 80 2F bra ?exx ; emit exponent |
||
4889 | 7183 F8595A E8 ?e2: inx ; bump pointer |
||
4890 | 7184 F8595B EB xba |
||
4891 | 7185 F8595C 99 78 3F sta !P0FPU+xcvt,y ; store '.' |
||
4892 | 7186 F8595F C8 iny |
||
4893 | 7187 F85960 EB xba ; 2nd digit |
||
4894 | 7188 F85961 99 78 3F ?e3: sta !P0FPU+xcvt,y ; store following digits |
||
4895 | 7189 F85964 C8 iny |
||
4896 | 7190 F85965 C6 3E dec wftmp |
||
4897 | 7191 F85967 B5 50 lda fpstr,x ; next digit |
||
4898 | 7192 F85969 F0 03 beq ?e4 ; no more digits |
||
4899 | Tue Jul 17 11:00:18 2018 Page 80 |
||
4900 | |||
4901 | |||
4902 | |||
4903 | |||
4904 | 7193 F8596B E8 inx |
||
4905 | 7194 F8596C 80 F3 bra ?e3 |
||
4906 | 7195 F8596E A5 CE ?e4: lda fpfmt |
||
4907 | 7196 F85970 C9 47 cmp #'G' ; 'G' format remove trailing zeroes... |
||
4908 | 7197 F85972 D0 09 bne ?e5 |
||
4909 | 7198 F85974 24 CF bit fpaltf ; ...if not alternate format |
||
4910 | 7199 F85976 30 05 bmi ?e5 |
||
4911 | 7200 F85978 20 CF 59 jsr ?trim ; trim trailing zeroes |
||
4912 | 7201 F8597B 80 0C bra ?exx ; emit exponent |
||
4913 | 7202 F8597D A5 3E ?e5: lda wftmp ; pad string with '0' |
||
4914 | 7203 F8597F F0 08 beq ?exx |
||
4915 | 7204 F85981 A2 30 ldx #'0' |
||
4916 | 7205 F85983 96 78 ?e6: stx xcvt,y |
||
4917 | 7206 F85985 C8 iny |
||
4918 | 7207 F85986 3A dec a |
||
4919 | 7208 F85987 D0 FA bne ?e6 |
||
4920 | 7209 F85989 A9 45 ?exx: lda #'E' ; emit exponent |
||
4921 | 7210 F8598B 05 D0 ora fpcap ; add letter case |
||
4922 | 7211 F8598D 99 78 3F sta !P0FPU+xcvt,y |
||
4923 | 7212 F85990 C8 iny |
||
4924 | 7213 F85991 ACC16 |
||
4925 | 7214 F85991 C2 20 rep #PMFLAG |
||
4926 | 7215 .LONGA on |
||
4927 | 7216 .MNLIST |
||
4928 | 7217 F85993 A2 2B ldx #'+' |
||
4929 | 7218 F85995 A5 48 lda dexp |
||
4930 | 7219 F85997 10 06 bpl ?exs ; positive exponent |
||
4931 | 7220 F85999 49 FF FF eor #$FFFF |
||
4932 | 7221 F8599C 1A inc a |
||
4933 | 7222 F8599D A2 2D ldx #'-' |
||
4934 | 7223 F8599F 85 00 ?exs: sta tm ; store unsigned exponent |
||
4935 | 7224 F859A1 85 46 sta scexp |
||
4936 | 7225 F859A3 96 78 stx xcvt,y ; store exponent sign |
||
4937 | 7226 F859A5 C8 iny |
||
4938 | 7227 F859A6 84 4F sty fpidx ; save string index |
||
4939 | 7228 F859A8 ACC08 |
||
4940 | 7229 F859A8 E2 20 sep #PMFLAG |
||
4941 | 7230 .LONGA off |
||
4942 | 7231 .MNLIST |
||
4943 | 7232 F859AA 20 15 5C jsr w2dec ; convert exponent to decimal |
||
4944 | 7233 F859AD ACC16 |
||
4945 | 7234 F859AD C2 20 rep #PMFLAG |
||
4946 | 7235 .LONGA on |
||
4947 | 7236 .MNLIST |
||
4948 | 7237 F859AF A2 01 ldx #1 ; index if exp>=1000 |
||
4949 | 7238 F859B1 A5 46 lda scexp |
||
4950 | 7239 F859B3 C9 E8 03 cmp #1000 |
||
4951 | 7240 F859B6 B0 07 bcs ?ex2 |
||
4952 | 7241 F859B8 E8 inx ; 100 <= exp < 1000 |
||
4953 | 7242 F859B9 C9 64 00 cmp #100 |
||
4954 | 7243 F859BC B0 01 bcs ?ex2 |
||
4955 | 7244 F859BE E8 inx ; exp < 100 |
||
4956 | 7245 F859BF ?ex2: ACC08 |
||
4957 | 7246 F859BF E2 20 sep #PMFLAG |
||
4958 | 7247 .LONGA off |
||
4959 | 7248 .MNLIST |
||
4960 | 7249 F859C1 A4 4F ldy fpidx ; string index |
||
4961 | Tue Jul 17 11:00:18 2018 Page 81 |
||
4962 | |||
4963 | |||
4964 | |||
4965 | |||
4966 | 7250 F859C3 B5 50 ?ex3: lda fpstr,x |
||
4967 | 7251 F859C5 F0 07 beq ?ex4 |
||
4968 | 7252 F859C7 99 78 3F sta !P0FPU+xcvt,y |
||
4969 | 7253 F859CA C8 iny |
||
4970 | 7254 F859CB E8 inx |
||
4971 | 7255 F859CC 80 F5 bra ?ex3 |
||
4972 | 7256 F859CE 60 ?ex4: rts |
||
4973 | 7257 |
||
4974 | 7258 ; trim trailing zeroes |
||
4975 | 7259 F859CF 88 ?trim: dey ; pointer to last character |
||
4976 | 7260 F859D0 C4 4F cpy fpidx ; if it is the first digit... |
||
4977 | 7261 F859D2 F0 0A beq ?tr1 ; ...restore pointer and exit |
||
4978 | 7262 F859D4 B6 78 ldx xcvt,y |
||
4979 | 7263 F859D6 E0 30 cpx #'0' ; trim trailing '0'... |
||
4980 | 7264 F859D8 F0 F5 beq ?trim |
||
4981 | 7265 F859DA E0 2E cpx #'.' ; trim trailing '.' if any |
||
4982 | 7266 F859DC F0 01 beq ?tr2 |
||
4983 | 7267 F859DE C8 ?tr1: iny |
||
4984 | 7268 F859DF 60 ?tr2: rts |
||
4985 | 7269 |
||
4986 | 7270 F859E0 A0 00 ?sts: ldy #0 ; store sign according format flags |
||
4987 | 7271 F859E2 24 4A bit dsgn ; sign test |
||
4988 | 7272 F859E4 10 04 bpl ?sts1 ; positive |
||
4989 | 7273 F859E6 A2 2D ldx #'-' ; negative: store sign '-' |
||
4990 | 7274 F859E8 80 0C bra ?sts2 |
||
4991 | 7275 F859EA A5 CF ?sts1: lda fpaltf ; check if should store sign/blank |
||
4992 | 7276 F859EC 4A lsr a ; fpaltf<0>: 1 if should store |
||
4993 | 7277 F859ED 90 0A bcc ?sts3 ; no store |
||
4994 | 7278 F859EF A2 2B ldx #'+' |
||
4995 | 7279 F859F1 4A lsr a ; fpaltf<1>: 1 if should store blank |
||
4996 | 7280 F859F2 B0 02 bcs ?sts2 ; store '+' sign |
||
4997 | 7281 F859F4 A2 20 ldx #' ' ; store blank |
||
4998 | 7282 F859F6 96 78 ?sts2: stx xcvt,y |
||
4999 | 7283 F859F8 C8 iny |
||
5000 | 7284 F859F9 60 ?sts3: rts |
||
5001 | 7285 |
||
5002 | 7286 F859FA ?round10: |
||
5003 | 7287 ; Round up the decimal string according to the wanted precision P |
||
5004 | 7288 ; We round directly the decimal string at the N-th digit, where: |
||
5005 | 7289 ; o+ N=P if 'E' or 'G' format |
||
5006 | 7290 ; o+ N=E+P+1 if 'F' format |
||
5007 | 7291 ; round up with usual decimal method: round to nearest away from zero |
||
5008 | 7292 ; |
||
5009 | 7293 ; on entry VF=1 if decimal float = 0.0 |
||
5010 | 7294 |
||
5011 | 7295 F859FA A6 CC ldx fpprec ; X=P=precision (8 bit) |
||
5012 | 7296 F859FC A5 CE lda fpfmt ; A=wanted format |
||
5013 | 7297 F859FE 70 60 bvs ?zz ; number = 0 |
||
5014 | 7298 F85A00 C9 46 cmp #'F' |
||
5015 | 7299 F85A02 D0 13 bne ?rnd ; 'E'&'G' format: N=P |
||
5016 | 7300 F85A04 ACC16CLC ; 'F' format: N=E+P+1 |
||
5017 | 7301 F85A04 C2 21 rep #(PMFLAG.OR.PCFLAG) |
||
5018 | 7302 .LONGA on |
||
5019 | 7303 .MNLIST |
||
5020 | 7304 F85A06 A5 48 lda dexp ; signed addition |
||
5021 | 7305 F85A08 65 CC adc fpprec |
||
5022 | 7306 F85A0A 1A inc a ; N=E+P+1 |
||
5023 | Tue Jul 17 11:00:18 2018 Page 82 |
||
5024 | |||
5025 | |||
5026 | |||
5027 | |||
5028 | 7307 F85A0B 30 40 bmi ?rtz ; if N<0 we round to zero |
||
5029 | 7308 F85A0D C9 24 00 cmp #MAXDIGITS ; we limit rounding to the max. possible |
||
5030 | 7309 F85A10 ACC08 |
||
5031 | 7310 F85A10 E2 20 sep #PMFLAG |
||
5032 | 7311 .LONGA off |
||
5033 | 7312 .MNLIST |
||
5034 | 7313 F85A12 90 02 bcc ?rnd0 |
||
5035 | 7314 F85A14 A9 24 lda #MAXDIGITS |
||
5036 | 7315 F85A16 AA ?rnd0: tax |
||
5037 | 7316 F85A17 E0 24 ?rnd: cpx #MAXDIGITS ; limit the digit index to round up |
||
5038 | 7317 F85A19 90 05 bcc ?rnd1 ; round up at N-th digit |
||
5039 | 7318 F85A1B A2 24 ldx #MAXDIGITS |
||
5040 | 7319 F85A1D 74 50 stz fpstr,x ; truncate?? |
||
5041 | 7320 F85A1F 60 rts |
||
5042 | 7321 F85A20 B5 50 ?rnd1: lda fpstr,x ; last digit: can cause round up |
||
5043 | 7322 F85A22 74 50 stz fpstr,x ; truncate decimal string |
||
5044 | 7323 F85A24 C9 35 cmp #'5' ; if last digits < '5'... |
||
5045 | 7324 F85A26 90 24 bcc ?rend ; no round up |
||
5046 | 7325 F85A28 9B txy ; X=0? |
||
5047 | 7326 F85A29 D0 04 bne ?rnd2 ; no |
||
5048 | 7327 F85A2B |
||
5049 | 7328 ; special case for 'F' format when E<0: can happen that N=E+P+1=0 |
||
5050 | 7329 ; in this case we round up to '1' theb first digit and increment |
||
5051 | 7330 ; decimal exponent |
||
5052 | 7331 F85A2B 64 51 stz fpstr+1 ; string contain just one digits '1'... |
||
5053 | 7332 F85A2D 80 13 bra ?rinc ; ...and we increment exponent |
||
5054 | 7333 F85A2F A0 30 ?rnd2: ldy #'0' |
||
5055 | 7334 F85A31 CA ?rndl: dex ; previous digit index |
||
5056 | 7335 F85A32 30 0E bmi ?rinc ; rounding up zeroes all digits... |
||
5057 | 7336 F85A34 B5 50 lda fpstr,x |
||
5058 | 7337 F85A36 1A inc a ; round up digit |
||
5059 | 7338 F85A37 C9 3A cmp #'9'+1 |
||
5060 | 7339 F85A39 90 04 bcc ?rnd3 ; stop rounding up |
||
5061 | 7340 F85A3B 94 50 sty fpstr,x ; round digit to '0'... |
||
5062 | 7341 F85A3D B0 F2 bcs ?rndl ; ...and repeat |
||
5063 | 7342 F85A3F 95 50 ?rnd3: sta fpstr,x ; store rounded digit |
||
5064 | 7343 F85A41 60 rts ; stop rounding up |
||
5065 | 7344 F85A42 ?rinc: ACC16 ; rounding generate a carry to first digit |
||
5066 | 7345 F85A42 C2 20 rep #PMFLAG |
||
5067 | 7346 .LONGA on |
||
5068 | 7347 .MNLIST |
||
5069 | 7348 F85A44 E6 48 inc dexp ; increment decimal exponent |
||
5070 | 7349 F85A46 ACC08 |
||
5071 | 7350 F85A46 E2 20 sep #PMFLAG |
||
5072 | 7351 .LONGA off |
||
5073 | 7352 .MNLIST |
||
5074 | 7353 F85A48 A9 31 lda #'1' ; store '1' because rounding change a 999... |
||
5075 | 7354 F85A4A 85 50 sta fpstr ; ...to 1000... |
||
5076 | 7355 F85A4C 60 ?rend: rts |
||
5077 | 7356 F85A4D ?rtz: ACC08 ; round to zero |
||
5078 | 7357 F85A4D E2 20 sep #PMFLAG |
||
5079 | 7358 .LONGA off |
||
5080 | 7359 .MNLIST |
||
5081 | 7360 F85A4F A9 30 lda #'0' |
||
5082 | 7361 F85A51 A2 25 ldx #EXP10-1 ; zeroes all digits... |
||
5083 | 7362 F85A53 74 51 stz fpstr+1,x |
||
5084 | 7363 F85A55 95 50 ?zlp: sta fpstr,x |
||
5085 | Tue Jul 17 11:00:18 2018 Page 83 |
||
5086 | |||
5087 | |||
5088 | |||
5089 | |||
5090 | 7364 F85A57 CA dex |
||
5091 | 7365 F85A58 10 FB bpl ?zlp |
||
5092 | 7366 F85A5A 64 48 stz dexp ; clear decimal exponent |
||
5093 | 7367 F85A5C A6 CC ldx fpprec |
||
5094 | 7368 F85A5E A5 CE lda fpfmt ; A=wanted format |
||
5095 | 7369 F85A60 C9 46 ?zz: cmp #'F' |
||
5096 | 7370 F85A62 D0 01 bne ?z1 |
||
5097 | 7371 F85A64 E8 inx ; 'F' format: one digit more for '0' |
||
5098 | 7372 F85A65 E0 24 ?z1: cpx #MAXDIGITS ; limit the digit index |
||
5099 | 7373 F85A67 90 02 bcc ?z2 |
||
5100 | 7374 F85A69 A2 24 ldx #MAXDIGITS |
||
5101 | 7375 F85A6B 74 50 ?z2: stz fpstr,x ; truncate string |
||
5102 | 7376 F85A6D 24 CF bit fpaltf ; check for a signed zero or not |
||
5103 | 7377 F85A6F 50 02 bvc ?z3 ; standard signed zero |
||
5104 | 7378 F85A71 64 4A stz dsgn ; force +0.0 |
||
5105 | 7379 F85A73 60 ?z3: rts |
||
5106 | 7380 |
||
5107 | 7381 ; convert byte to 2 hex. digits |
||
5108 | 7382 ; return A=high digit, B=low digit |
||
5109 | 7383 F85A74 b2hex: |
||
5110 | 7384 F85A74 48 pha ; save value |
||
5111 | 7385 F85A75 20 7E 5A jsr ?hex |
||
5112 | 7386 F85A78 EB xba ; B=low digit |
||
5113 | 7387 F85A79 68 pla ; restore value |
||
5114 | 7388 F85A7A 4A lsr a ; divide by 16 |
||
5115 | 7389 F85A7B 4A lsr a |
||
5116 | 7390 F85A7C 4A lsr a |
||
5117 | 7391 F85A7D 4A lsr a |
||
5118 | 7392 F85A7E 29 0F ?hex: and #$0F ; mask nibble |
||
5119 | 7393 F85A80 C9 0A cmp #10 |
||
5120 | 7394 F85A82 90 02 bcc ?hex1 |
||
5121 | 7395 F85A84 65 3E adc wftmp ; add value for a..f/A..F |
||
5122 | 7396 F85A86 69 30 ?hex1: adc #'0' |
||
5123 | 7397 F85A88 60 rts |
||
5124 | 7398 F85A89 |
||
5125 | 7399 |
||
5126 | 7400 ; fp2dec - convert the floating point fac to decimal ascii string |
||
5127 | 7401 ; |
||
5128 | 7402 ; entry: |
||
5129 | 7403 ; fac = argument (either valid or invalid) |
||
5130 | 7404 ; |
||
5131 | 7405 ; exit: |
||
5132 | 7406 ; fpstr = 38 digits ascii decimal string (null terminated) |
||
5133 | 7407 ; (implicit decimal dot between first and 2nd digit) |
||
5134 | 7408 ; dsgn = sign of the decimal significand |
||
5135 | 7409 ; dexp = decimal exponent (2's complement) |
||
5136 | 7410 ; |
||
5137 | 7411 ; If fac is not valid return either the string 'NAN' or 'INF' according |
||
5138 | 7412 ; with fac status (dexp=don't care). |
||
5139 | 7413 ; If fac=0 (or rounded to 0.0), return a string of digits '0', |
||
5140 | 7414 ; and dexp=0. |
||
5141 | 7415 ; |
||
5142 | 7416 ; strategy: |
||
5143 | 7417 ; |
||
5144 | 7418 ; o find the decimal exponent N of the 'normalized' decimal floating |
||
5145 | 7419 ; point number, such that: |
||
5146 | 7420 ; |
||
5147 | Tue Jul 17 11:00:18 2018 Page 84 |
||
5148 | |||
5149 | |||
5150 | |||
5151 | |||
5152 | 7421 ; N |
||
5153 | 7422 ; |x| = d.ffff... 10 1<= d <=9, f=fractional part |
||
5154 | 7423 ; |
||
5155 | 7424 ; o scale |x| by a power of ten equal to M = 37 - N, such that: |
||
5156 | 7425 ; |
||
5157 | 7426 ; M N 37 - N 37 |
||
5158 | 7427 ; y = x * 10 = d.ffff... * 10 * 10 = d.ffff... * 10 |
||
5159 | 7428 ; |
||
5160 | 7429 ; select 37 justified by the fact that the maximum decimal exponent |
||
5161 | 7430 ; for a 128 bits number is 38. |
||
5162 | 7431 ; |
||
5163 | 7432 ; o this scaling give an y such that: |
||
5164 | 7433 ; |
||
5165 | 7434 ; 37 38 |
||
5166 | 7435 ; 10 <= y < 10 |
||
5167 | 7436 ; |
||
5168 | 7437 ; and y can be regarded as 'integral' value with 38 significative digits |
||
5169 | 7438 ; (first d digit, followed by 37 ffff... digits of the fractional part), |
||
5170 | 7439 ; and can be converted to decimal string. The implicit decimal dot is |
||
5171 | 7440 ; between first and 2nd digits. |
||
5172 | 7441 ; |
||
5173 | 7442 ; This routine is used internally and not intended for end use. |
||
5174 | 7443 ; |
||
5175 | 7444 ;------ |
||
5176 | 7445 F85A89 fp2dec: |
||
5177 | 7446 ;------ |
||
5178 | 7447 F85A89 A5 24 lda facsgn |
||
5179 | 7448 F85A8B 64 24 stz facsgn ; absolute fac |
||
5180 | 7449 F85A8D 85 4A sta dsgn ; save sign of decimal float |
||
5181 | 7450 F85A8F 64 48 stz dexp ; clear decimal exponent |
||
5182 | 7451 F85A91 64 49 stz dexp+1 |
||
5183 | 7452 F85A93 24 25 bit facst |
||
5184 | 7453 F85A95 10 1B bpl ?vf |
||
5185 | 7454 F85A97 ACC16 |
||
5186 | 7455 F85A97 C2 20 rep #PMFLAG |
||
5187 | 7456 .LONGA on |
||
5188 | 7457 .MNLIST |
||
5189 | 7458 F85A99 50 0A bvc ?nan ; fac=nan |
||
5190 | 7459 F85A9B A9 49 4E lda #'NI' ; fac=inf |
||
5191 | 7460 F85A9E 85 50 sta fpstr |
||
5192 | 7461 F85AA0 A9 46 00 lda #'F' ; store 'INF' |
||
5193 | 7462 F85AA3 80 08 bra ?end |
||
5194 | 7463 F85AA5 A9 4E 41 ?nan: lda #'AN' |
||
5195 | 7464 F85AA8 85 50 sta fpstr |
||
5196 | 7465 F85AAA A9 4E 00 lda #'N' ; store 'NAN' |
||
5197 | 7466 F85AAD 85 52 ?end: sta fpstr+2 |
||
5198 | 7467 F85AAF ACC08 |
||
5199 | 7468 F85AAF E2 20 sep #PMFLAG |
||
5200 | 7469 .LONGA off |
||
5201 | 7470 .MNLIST |
||
5202 | 7471 F85AB1 60 rts |
||
5203 | 7472 F85AB2 50 0C ?vf: bvc ?nz ; fac <> 0 |
||
5204 | 7473 F85AB4 A9 30 lda #'0' |
||
5205 | 7474 F85AB6 A2 25 ldx #37 ; store 38 digits '0'... |
||
5206 | 7475 F85AB8 74 51 stz fpstr+1,x |
||
5207 | 7476 F85ABA 95 50 ?z: sta fpstr,x |
||
5208 | 7477 F85ABC CA dex |
||
5209 | Tue Jul 17 11:00:18 2018 Page 85 |
||
5210 | |||
5211 | |||
5212 | |||
5213 | |||
5214 | 7478 F85ABD 10 FB bpl ?z |
||
5215 | 7479 F85ABF 60 rts ; ...and exit |
||
5216 | 7480 F85AC0 A2 00 ?nz: ldx #0 |
||
5217 | 7481 F85AC2 A5 21 lda facm+15 |
||
5218 | 7482 F85AC4 30 09 bmi ?nf ; normal float |
||
5219 | 7483 F85AC6 A9 C5 lda #<fce64 ; pre-scale by 1e64 the subnormal float |
||
5220 | 7484 F85AC8 A0 5F ldy #>fce64 |
||
5221 | 7485 F85ACA 20 D5 49 jsr fcmult |
||
5222 | 7486 F85ACD A2 FF ldx #$FF |
||
5223 | 7487 F85ACF 86 10 ?nf: stx fsubnf ; remember if we prescaled by 1e64 |
||
5224 | 7488 F85AD1 20 26 4D jsr frndm ; round mantissa to 113 bits |
||
5225 | 7489 F85AD4 |
||
5226 | 7490 ; For a fast evaluation of the decimal exponent, we make a swift |
||
5227 | 7491 ; estimate of the log10 of the float, then check it later. |
||
5228 | 7492 ; We can form the estimate by multiplying the binary exponent |
||
5229 | 7493 ; by a conversion factor Log10(2) with 16 bit accuracy, using |
||
5230 | 7494 ; an integer signed multiplication 16x16 and taking the high |
||
5231 | 7495 ; 16 bit of the result. The error is at most one digit up or |
||
5232 | 7496 ; down. |
||
5233 | 7497 |
||
5234 | 7498 F85AD4 ACC16 ; get an estimate of the decimal exponent |
||
5235 | 7499 F85AD4 C2 20 rep #PMFLAG |
||
5236 | 7500 .LONGA on |
||
5237 | 7501 .MNLIST |
||
5238 | 7502 F85AD6 38 sec |
||
5239 | 7503 F85AD7 A5 22 lda facexp |
||
5240 | 7504 F85AD9 E9 FF 3F sbc #EBIAS |
||
5241 | 7505 F85ADC A2 10 ldx #<LOG2H ; log(2)*$10000 (approximate to 16 bits) |
||
5242 | 7506 F85ADE A0 4D ldy #>LOG2H |
||
5243 | 7507 F85AE0 20 CE 87 jsr imult ; return C=estimate exponent (high 16 bits) |
||
5244 | 7508 F85AE3 85 48 sta dexp ; this can be +/-1 from the real decimal exp. |
||
5245 | 7509 F85AE5 A9 25 00 lda #EXP10-1 ; get difference exponent with 1e37... |
||
5246 | 7510 F85AE8 38 sec ; ... to scale fac in range [1e37..1e38-1] |
||
5247 | 7511 F85AE9 E5 48 sbc dexp |
||
5248 | 7512 F85AEB ACC08 |
||
5249 | 7513 F85AEB E2 20 sep #PMFLAG |
||
5250 | 7514 .LONGA off |
||
5251 | 7515 .MNLIST |
||
5252 | 7516 F85AED 20 2E 49 jsr scale10 ; scale fac by 37 - N |
||
5253 | 7517 F85AF0 |
||
5254 | 7518 ; now check if we will divide by 10 or multiplies by 10 to get |
||
5255 | 7519 ; the exact decimal exponent; should be: 1e37 <= fac < 1e38 |
||
5256 | 7520 |
||
5257 | 7521 F85AF0 A9 ED lda #<fce38 ; now compare fac vs. 1e38 |
||
5258 | 7522 F85AF2 A0 5E ldy #>fce38 |
||
5259 | 7523 F85AF4 20 5E 87 jsr fccmp ; should be fac<1e38 |
||
5260 | 7524 F85AF7 30 0B bmi ?tst ; fac < 1e38, so go to check if fac>=1e37 |
||
5261 | 7525 F85AF9 ACC16 |
||
5262 | 7526 F85AF9 C2 20 rep #PMFLAG |
||
5263 | 7527 .LONGA on |
||
5264 | 7528 .MNLIST |
||
5265 | 7529 F85AFB E6 48 inc dexp ; increment decimal exponent... |
||
5266 | 7530 F85AFD ACC08 ; ...because next division by 10 |
||
5267 | 7531 F85AFD E2 20 sep #PMFLAG |
||
5268 | 7532 .LONGA off |
||
5269 | 7533 .MNLIST |
||
5270 | 7534 F85AFF 20 06 4A jsr div10 ; fac=fac/10 so now fac<1e38 |
||
5271 | Tue Jul 17 11:00:18 2018 Page 86 |
||
5272 | |||
5273 | |||
5274 | |||
5275 | |||
5276 | 7535 F85B02 80 14 bra ?cvt ; convert to decimal |
||
5277 | 7536 F85B04 A9 DB ?tst: lda #<fce37 ; now compare fac vs. 1e37 |
||
5278 | 7537 F85B06 A0 5E ldy #>fce37 |
||
5279 | 7538 F85B08 20 5E 87 jsr fccmp |
||
5280 | 7539 F85B0B F0 0B beq ?cvt ; fac=1e37 |
||
5281 | 7540 F85B0D 10 09 bpl ?cvt ; fac>1e37 |
||
5282 | 7541 F85B0F ACC16 |
||
5283 | 7542 F85B0F C2 20 rep #PMFLAG |
||
5284 | 7543 .LONGA on |
||
5285 | 7544 .MNLIST |
||
5286 | 7545 F85B11 C6 48 dec dexp ; decrement decimal exponent because... |
||
5287 | 7546 F85B13 ACC08 |
||
5288 | 7547 F85B13 E2 20 sep #PMFLAG |
||
5289 | 7548 .LONGA off |
||
5290 | 7549 .MNLIST |
||
5291 | 7550 F85B15 20 D1 49 jsr mult10 ; ...we mult x 10 |
||
5292 | 7551 |
||
5293 | 7552 ; now we have 1e37 <= fac < 1e38 |
||
5294 | 7553 ; note that we no round fac because we use all 128 bits mantissa |
||
5295 | 7554 ; move fac mantissa (128 bits) to temporary mantissa tm |
||
5296 | 7555 F85B18 ?cvt: ACC16 |
||
5297 | 7556 F85B18 C2 20 rep #PMFLAG |
||
5298 | 7557 .LONGA on |
||
5299 | 7558 .MNLIST |
||
5300 | 7559 F85B1A A6 10 ldx fsubnf ; we prescaled the float? |
||
5301 | 7560 F85B1C F0 08 beq ?cvt1 ; no |
||
5302 | 7561 F85B1E 38 sec |
||
5303 | 7562 F85B1F A5 48 lda dexp ; adjust decimal exponent |
||
5304 | 7563 F85B21 E9 40 00 sbc #64 |
||
5305 | 7564 F85B24 85 48 sta dexp |
||
5306 | 7565 F85B26 A5 12 ?cvt1: lda facm ; we use guard bits too in conversion |
||
5307 | 7566 F85B28 85 00 sta tm |
||
5308 | 7567 F85B2A A5 14 lda facm+2 |
||
5309 | 7568 F85B2C 85 02 sta tm+2 |
||
5310 | 7569 F85B2E A5 16 lda facm+4 |
||
5311 | 7570 F85B30 85 04 sta tm+4 |
||
5312 | 7571 F85B32 A5 18 lda facm+6 |
||
5313 | 7572 F85B34 85 06 sta tm+6 |
||
5314 | 7573 F85B36 A5 1A lda facm+8 |
||
5315 | 7574 F85B38 85 08 sta tm+8 |
||
5316 | 7575 F85B3A A5 1C lda facm+10 |
||
5317 | 7576 F85B3C 85 0A sta tm+10 |
||
5318 | 7577 F85B3E A5 1E lda facm+12 |
||
5319 | 7578 F85B40 85 0C sta tm+12 |
||
5320 | 7579 F85B42 A5 20 lda facm+14 |
||
5321 | 7580 F85B44 85 0E sta tm+14 |
||
5322 | 7581 F85B46 A5 22 lda facexp ; get how many shift need to align tm... |
||
5323 | 7582 F85B48 38 sec ; ...to get the effective long integer |
||
5324 | 7583 F85B49 E9 7E 40 sbc #EBIAS+MNTBITS-1 |
||
5325 | 7584 F85B4C ACC08 ; negative or null, just 8 bits value |
||
5326 | 7585 F85B4C E2 20 sep #PMFLAG |
||
5327 | 7586 .LONGA off |
||
5328 | 7587 .MNLIST |
||
5329 | 7588 F85B4E F0 05 beq ?cvt2 ; tm aligned, no shift |
||
5330 | 7589 F85B50 A2 00 ldx #tm |
||
5331 | 7590 F85B52 20 3A 47 jsr shrmx ; shift tm to right to align at 128 bits int. |
||
5332 | 7591 F85B55 20 9B 5B ?cvt2: jsr ui2dec ; convert integer to 39 decimal digits |
||
5333 | Tue Jul 17 11:00:18 2018 Page 87 |
||
5334 | |||
5335 | |||
5336 | |||
5337 | |||
5338 | 7592 |
||
5339 | 7593 ; first digit is always a leading '0', beacuse 1e37 <= fac < 1e38 |
||
5340 | 7594 ; max. integer is: 340282366920938463463374607431768211455 (> 1e38) |
||
5341 | 7595 F85B58 |
||
5342 | 7596 F85B58 A2 00 ldx #0 ; we shift one digit to left (normalitation) |
||
5343 | 7597 F85B5A B5 51 ?sh: lda fpstr+1,x |
||
5344 | 7598 F85B5C 95 50 sta fpstr,x |
||
5345 | 7599 F85B5E F0 03 beq ?done |
||
5346 | 7600 F85B60 E8 inx |
||
5347 | 7601 F85B61 80 F7 bra ?sh |
||
5348 | 7602 F85B63 60 ?done: rts ; 38 digits + null terminator |
||
5349 | 7603 |
||
5350 | 7604 ; int2dec - convert a signed/unsigned 128 bits long integer to decimal ascii |
||
5351 | 7605 ; |
||
5352 | 7606 ; entry: |
||
5353 | 7607 ; facm..facm+15 = signed long integer |
||
5354 | 7608 ; |
||
5355 | 7609 ; exit: |
||
5356 | 7610 ; fpstr = 39 digits ascii decimal string (null terminated) |
||
5357 | 7611 ; |
||
5358 | 7612 ; This routine check automatically if signed/unsigned (facst byte test, bit 7) |
||
5359 | 7613 ; Note: this routine store leading not-significative digits '0' |
||
5360 | 7614 ; |
||
5361 | 7615 ;------- |
||
5362 | 7616 F85B64 int2dec: |
||
5363 | 7617 ;------- |
||
5364 | 7618 F85B64 64 4A stz dsgn |
||
5365 | 7619 F85B66 A2 0F ldx #15 ; move facm to tm |
||
5366 | 7620 F85B68 B5 12 ?lp: lda facm,x |
||
5367 | 7621 F85B6A 95 00 sta tm,x |
||
5368 | 7622 F85B6C CA dex |
||
5369 | 7623 F85B6D 10 F9 bpl ?lp |
||
5370 | 7624 F85B6F 24 25 bit facst |
||
5371 | 7625 F85B71 10 28 bpl ui2dec ; unsigned integer |
||
5372 | 7626 F85B73 A5 0F lda tm+15 |
||
5373 | 7627 F85B75 85 4A sta dsgn ; decimal sign |
||
5374 | 7628 F85B77 10 22 bpl ui2dec ; positive |
||
5375 | 7629 F85B79 ACC16 |
||
5376 | 7630 F85B79 C2 20 rep #PMFLAG |
||
5377 | 7631 .LONGA on |
||
5378 | 7632 .MNLIST |
||
5379 | 7633 F85B7B A2 00 ldx #0 |
||
5380 | 7634 F85B7D A0 08 ldy #8 |
||
5381 | 7635 F85B7F 38 sec |
||
5382 | 7636 F85B80 A9 00 00 ?lp2: lda #0 ; two's complement |
||
5383 | 7637 F85B83 F5 00 sbc tm,x |
||
5384 | 7638 F85B85 95 00 sta tm,x |
||
5385 | 7639 F85B87 E8 inx |
||
5386 | 7640 F85B88 E8 inx |
||
5387 | 7641 F85B89 88 dey |
||
5388 | 7642 F85B8A D0 F4 bne ?lp2 |
||
5389 | 7643 F85B8C ACC08 |
||
5390 | 7644 F85B8C E2 20 sep #PMFLAG |
||
5391 | 7645 .LONGA off |
||
5392 | 7646 .MNLIST |
||
5393 | 7647 F85B8E 80 0B bra ui2dec ; negative |
||
5394 | 7648 |
||
5395 | Tue Jul 17 11:00:18 2018 Page 88 |
||
5396 | |||
5397 | |||
5398 | |||
5399 | |||
5400 | 7649 ; uint2dec - convert an unsigned 128 bits long integer to decimal ascii |
||
5401 | 7650 ; |
||
5402 | 7651 ; entry: |
||
5403 | 7652 ; facm..facm+15 = unsigned long integer |
||
5404 | 7653 ; |
||
5405 | 7654 ; exit: |
||
5406 | 7655 ; fpstr = 39 digits ascii decimal string (null terminated) |
||
5407 | 7656 ; |
||
5408 | 7657 ; Note: this routine store leading not-significative digits '0' |
||
5409 | 7658 ; |
||
5410 | 7659 ;-------- |
||
5411 | 7660 F85B90 uint2dec: |
||
5412 | 7661 ;-------- |
||
5413 | 7662 F85B90 A2 0F ldx #15 ; move facm to tm |
||
5414 | 7663 F85B92 B5 12 ?lp: lda facm,x |
||
5415 | 7664 F85B94 95 00 sta tm,x |
||
5416 | 7665 F85B96 CA dex |
||
5417 | 7666 F85B97 10 F9 bpl ?lp |
||
5418 | 7667 F85B99 64 4A stz dsgn ; clear decimal sign |
||
5419 | 7668 |
||
5420 | 7669 ; ui2dec - convert an unsigned 128 bits long integer to decimal ascii |
||
5421 | 7670 ; |
||
5422 | 7671 ; entry: |
||
5423 | 7672 ; tm..tm+15 = unsigned long integer |
||
5424 | 7673 ; |
||
5425 | 7674 ; exit: |
||
5426 | 7675 ; fpstr = 39 digits ascii decimal string (null terminated) |
||
5427 | 7676 ; |
||
5428 | 7677 ; Note: this routine store leading not-significative digits '0' |
||
5429 | 7678 ; |
||
5430 | 7679 ; This routine is used internally and not intended for end use. |
||
5431 | 7680 ; |
||
5432 | 7681 ;------ |
||
5433 | 7682 F85B9B ui2dec: |
||
5434 | 7683 ;------ |
||
5435 | 7684 F85B9B 8B phb ; save dbr |
||
5436 | 7685 F85B9C 4B phk |
||
5437 | 7686 F85B9D AB plb ; set current dbr=pbr |
||
5438 | 7687 F85B9E A2 00 ldx #0 ; index to decimal table |
||
5439 | 7688 F85BA0 86 3F stx wftmp+1 ; index to the destination ascii buffer |
||
5440 | 7689 F85BA2 A0 80 ldy #$80 ; partial quotient (alternate positive/neg.) |
||
5441 | 7690 F85BA4 ?lp: ACC16 ; main loop |
||
5442 | 7691 F85BA4 C2 20 rep #PMFLAG |
||
5443 | 7692 .LONGA on |
||
5444 | 7693 .MNLIST |
||
5445 | 7694 F85BA6 A5 00 ?sub: lda tm ; repeated subtraction's |
||
5446 | 7695 F85BA8 38 sec |
||
5447 | 7696 F85BA9 FD 6B 5C sbc !dectbl0,x ; low bytes |
||
5448 | 7697 F85BAC 85 00 sta tm |
||
5449 | 7698 F85BAE A5 02 lda tm+2 |
||
5450 | 7699 F85BB0 FD 6D 5C sbc !dectbl0+2,x |
||
5451 | 7700 F85BB3 85 02 sta tm+2 |
||
5452 | 7701 F85BB5 A5 04 lda tm+4 |
||
5453 | 7702 F85BB7 FD 07 5D sbc !dectbl1,x |
||
5454 | 7703 F85BBA 85 04 sta tm+4 |
||
5455 | 7704 F85BBC A5 06 lda tm+6 |
||
5456 | 7705 F85BBE FD 09 5D sbc !dectbl1+2,x |
||
5457 | Tue Jul 17 11:00:18 2018 Page 89 |
||
5458 | |||
5459 | |||
5460 | |||
5461 | |||
5462 | 7706 F85BC1 85 06 sta tm+6 |
||
5463 | 7707 F85BC3 A5 08 lda tm+8 |
||
5464 | 7708 F85BC5 FD A3 5D sbc !dectbl2,x |
||
5465 | 7709 F85BC8 85 08 sta tm+8 |
||
5466 | 7710 F85BCA A5 0A lda tm+10 |
||
5467 | 7711 F85BCC FD A5 5D sbc !dectbl2+2,x |
||
5468 | 7712 F85BCF 85 0A sta tm+10 |
||
5469 | 7713 F85BD1 A5 0C lda tm+12 |
||
5470 | 7714 F85BD3 FD 3F 5E sbc !dectbl3,x |
||
5471 | 7715 F85BD6 85 0C sta tm+12 |
||
5472 | 7716 F85BD8 A5 0E lda tm+14 |
||
5473 | 7717 F85BDA FD 41 5E sbc !dectbl3+2,x |
||
5474 | 7718 F85BDD 85 0E sta tm+14 ; CF=0 if remainder is negative |
||
5475 | 7719 F85BDF C8 iny ; increment partial quotient (N flag) |
||
5476 | 7720 F85BE0 B0 04 bcs ?pr ; remainder is positive |
||
5477 | 7721 F85BE2 10 C2 bpl ?sub ; neg. rem. & pos. quot.: repeat subtraction |
||
5478 | 7722 F85BE4 30 02 bmi ?st ; else store digit |
||
5479 | 7723 F85BE6 30 BE ?pr: bmi ?sub ; pos. rem. & neg. quot.: repeat subtraction |
||
5480 | 7724 ; else store digit |
||
5481 | 7725 F85BE8 ?st: ACC08 |
||
5482 | 7726 F85BE8 E2 20 sep #PMFLAG |
||
5483 | 7727 .LONGA off |
||
5484 | 7728 .MNLIST |
||
5485 | 7729 F85BEA 98 tya |
||
5486 | 7730 F85BEB 90 04 bcc ?nr ; remainder is negative |
||
5487 | 7731 F85BED 49 FF eor #$FF ; 10's complement of the quotient |
||
5488 | 7732 F85BEF 69 0A adc #10 |
||
5489 | 7733 F85BF1 69 2F ?nr: adc #'0'-1 ; A is one more beacuse the 'iny'... |
||
5490 | 7734 F85BF3 A8 tay |
||
5491 | 7735 F85BF4 86 3E stx wftmp ; save counter |
||
5492 | 7736 F85BF6 A6 3F ldx wftmp+1 ; current decimal string index |
||
5493 | 7737 F85BF8 29 7F and #$7F ; strip off bit 7 |
||
5494 | 7738 F85BFA 95 50 sta fpstr,x ; store digit |
||
5495 | 7739 F85BFC E8 inx |
||
5496 | 7740 F85BFD 86 3F stx wftmp+1 ; update string index |
||
5497 | 7741 F85BFF 98 tya ; invert sign of the starting quotient |
||
5498 | 7742 F85C00 49 FF eor #$FF |
||
5499 | 7743 F85C02 29 80 and #$80 |
||
5500 | 7744 F85C04 A8 tay |
||
5501 | 7745 F85C05 A5 3E lda wftmp ; update table index |
||
5502 | 7746 F85C07 18 clc |
||
5503 | 7747 F85C08 69 04 adc #4 |
||
5504 | 7748 F85C0A AA tax |
||
5505 | 7749 F85C0B E0 9C cpx #DTBLSIZ |
||
5506 | 7750 F85C0D 90 95 bcc ?lp ; repeat until done |
||
5507 | 7751 F85C0F A6 3F ldx wftmp+1 ; terminate decimal string... |
||
5508 | 7752 F85C11 74 50 stz fpstr,x ; ...with a null |
||
5509 | 7753 F85C13 AB plb ; restore dbr |
||
5510 | 7754 F85C14 60 rts |
||
5511 | 7755 |
||
5512 | 7756 ; w2dec - convert an unsigned 16 bits integer to decimal ascii |
||
5513 | 7757 ; |
||
5514 | 7758 ; entry: |
||
5515 | 7759 ; C = unsigned 16 bits integer |
||
5516 | 7760 ; |
||
5517 | 7761 ; exit: |
||
5518 | 7762 ; fpstr = 5 bytes ascii decimal string (null terminated) |
||
5519 | Tue Jul 17 11:00:18 2018 Page 90 |
||
5520 | |||
5521 | |||
5522 | |||
5523 | |||
5524 | 7763 ; |
||
5525 | 7764 ; Note: this routine store leading not-significative digits '0' |
||
5526 | 7765 ; |
||
5527 | 7766 ;----- |
||
5528 | 7767 F85C15 w2dec: |
||
5529 | 7768 ;----- |
||
5530 | 7769 F85C15 8B phb ; save dbr |
||
5531 | 7770 F85C16 4B phk |
||
5532 | 7771 F85C17 AB plb ; set current dbr=pbr |
||
5533 | 7772 F85C18 A2 88 ldx #I16IDX ; index to decimal table |
||
5534 | 7773 F85C1A 64 3F stz wftmp+1 ; decimal string index |
||
5535 | 7774 F85C1C A0 80 ldy #$80 ; partial quotient (alternate positive/neg.) |
||
5536 | 7775 F85C1E ACC16 |
||
5537 | 7776 F85C1E C2 20 rep #PMFLAG |
||
5538 | 7777 .LONGA on |
||
5539 | 7778 .MNLIST |
||
5540 | 7779 F85C20 85 00 sta tm ; 16 bit value |
||
5541 | 7780 F85C22 64 02 stz tm+2 ; sign extension |
||
5542 | 7781 F85C24 ?lp: ACC16 ; main loop |
||
5543 | 7782 F85C24 C2 20 rep #PMFLAG |
||
5544 | 7783 .LONGA on |
||
5545 | 7784 .MNLIST |
||
5546 | 7785 F85C26 A5 00 ?sub: lda tm ; repeated subtraction's |
||
5547 | 7786 F85C28 38 sec |
||
5548 | 7787 F85C29 FD 6B 5C sbc !dectbl0,x ; low bytes |
||
5549 | 7788 F85C2C 85 00 sta tm |
||
5550 | 7789 F85C2E A5 02 lda tm+2 |
||
5551 | 7790 F85C30 FD 6D 5C sbc !dectbl0+2,x |
||
5552 | 7791 F85C33 85 02 sta tm+2 ; CF=0 if remainder is negative |
||
5553 | 7792 F85C35 C8 iny ; increment partial quotient |
||
5554 | 7793 F85C36 B0 04 bcs ?pr ; remainder is positive |
||
5555 | 7794 F85C38 10 EC bpl ?sub ; neg. rem. & pos. quot.: repeat subtraction |
||
5556 | 7795 F85C3A 30 02 bmi ?st ; else store digit |
||
5557 | 7796 F85C3C 30 E8 ?pr: bmi ?sub ; pos. rem. & neg. quot.: repeat subtraction |
||
5558 | 7797 ; else store digit |
||
5559 | 7798 F85C3E ?st: ACC08 |
||
5560 | 7799 F85C3E E2 20 sep #PMFLAG |
||
5561 | 7800 .LONGA off |
||
5562 | 7801 .MNLIST |
||
5563 | 7802 F85C40 98 tya |
||
5564 | 7803 F85C41 90 04 bcc ?nr ; negative remainder |
||
5565 | 7804 F85C43 49 FF eor #$FF ; complement |
||
5566 | 7805 F85C45 69 0A adc #10 |
||
5567 | 7806 F85C47 69 2F ?nr: adc #'0'-1 |
||
5568 | 7807 F85C49 A8 tay |
||
5569 | 7808 F85C4A 86 3E stx wftmp |
||
5570 | 7809 F85C4C A6 3F ldx wftmp+1 |
||
5571 | 7810 F85C4E 29 7F and #$7F |
||
5572 | 7811 F85C50 95 50 sta fpstr,x |
||
5573 | 7812 F85C52 E8 inx |
||
5574 | 7813 F85C53 86 3F stx wftmp+1 |
||
5575 | 7814 F85C55 98 tya |
||
5576 | 7815 F85C56 49 FF eor #$FF |
||
5577 | 7816 F85C58 29 80 and #$80 |
||
5578 | 7817 F85C5A A8 tay |
||
5579 | 7818 F85C5B A5 3E lda wftmp |
||
5580 | 7819 F85C5D 18 clc |
||
5581 | Tue Jul 17 11:00:18 2018 Page 91 |
||
5582 | |||
5583 | |||
5584 | |||
5585 | |||
5586 | 7820 F85C5E 69 04 adc #4 |
||
5587 | 7821 F85C60 AA tax |
||
5588 | 7822 F85C61 E0 9C cpx #DTBLSIZ |
||
5589 | 7823 F85C63 90 BF bcc ?lp |
||
5590 | 7824 F85C65 A6 3F ldx wftmp+1 |
||
5591 | 7825 F85C67 74 50 stz fpstr,x |
||
5592 | 7826 F85C69 AB plb |
||
5593 | 7827 F85C6A 60 rts |
||
5594 | 7828 |
||
5595 | 7829 ; table of decreasing powers of ten, from 1e38 down to 1e0, with |
||
5596 | 7830 ; alternating sign, used to convert 128 bits integer in decimal |
||
5597 | 7831 ; Any constant is 128 bits, but table is splitted in four pieces, |
||
5598 | 7832 ; to easily access with an 8 bit index. |
||
5599 | 7833 ; bits from 0 to 31 |
||
5600 | 7834 F85C6B dectbl0: |
||
5601 | 7835 F85C6B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E38 |
||
5602 | 7836 F85C6F 00 00 00 00 .DB $00,$00,$00,$00 ; -1E37 |
||
5603 | 7837 F85C73 00 00 00 00 .DB $00,$00,$00,$00 ; +1E36 |
||
5604 | 7838 F85C77 00 00 00 00 .DB $00,$00,$00,$00 ; -1E35 |
||
5605 | 7839 F85C7B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E34 |
||
5606 | 7840 F85C7F 00 00 00 00 .DB $00,$00,$00,$00 ; -1E33 |
||
5607 | 7841 F85C83 00 00 00 00 .DB $00,$00,$00,$00 ; +1E32 |
||
5608 | 7842 F85C87 00 00 00 80 .DB $00,$00,$00,$80 ; -1E31 |
||
5609 | 7843 F85C8B 00 00 00 40 .DB $00,$00,$00,$40 ; +1E30 |
||
5610 | 7844 F85C8F 00 00 00 60 .DB $00,$00,$00,$60 ; -1E29 |
||
5611 | 7845 F85C93 00 00 00 10 .DB $00,$00,$00,$10 ; +1E28 |
||
5612 | 7846 F85C97 00 00 00 18 .DB $00,$00,$00,$18 ; -1E27 |
||
5613 | 7847 F85C9B 00 00 00 E4 .DB $00,$00,$00,$E4 ; +1E26 |
||
5614 | 7848 F85C9F 00 00 00 B6 .DB $00,$00,$00,$B6 ; -1E25 |
||
5615 | 7849 F85CA3 00 00 00 A1 .DB $00,$00,$00,$A1 ; +1E24 |
||
5616 | 7850 F85CA7 00 00 80 09 .DB $00,$00,$80,$09 ; -1E23 |
||
5617 | 7851 F85CAB 00 00 40 B2 .DB $00,$00,$40,$B2 ; +1E22 |
||
5618 | 7852 F85CAF 00 00 60 21 .DB $00,$00,$60,$21 ; -1E21 |
||
5619 | 7853 F85CB3 00 00 10 63 .DB $00,$00,$10,$63 ; +1E20 |
||
5620 | 7854 F85CB7 00 00 18 76 .DB $00,$00,$18,$76 ; -1E19 |
||
5621 | 7855 F85CBB 00 00 64 A7 .DB $00,$00,$64,$A7 ; +1E18 |
||
5622 | 7856 F85CBF 00 00 76 A2 .DB $00,$00,$76,$A2 ; -1E17 |
||
5623 | 7857 F85CC3 00 00 C1 6F .DB $00,$00,$C1,$6F ; +1E16 |
||
5624 | 7858 F85CC7 00 80 39 5B .DB $00,$80,$39,$5B ; -1E15 |
||
5625 | 7859 F85CCB 00 40 7A 10 .DB $00,$40,$7A,$10 ; +1E14 |
||
5626 | 7860 F85CCF 00 60 8D B1 .DB $00,$60,$8D,$B1 ; -1E13 |
||
5627 | 7861 F85CD3 00 10 A5 D4 .DB $00,$10,$A5,$D4 ; +1E12 |
||
5628 | 7862 F85CD7 00 18 89 B7 .DB $00,$18,$89,$B7 ; -1E11 |
||
5629 | 7863 F85CDB 00 E4 0B 54 .DB $00,$E4,$0B,$54 ; +1E10 |
||
5630 | 7864 F85CDF 00 36 65 C4 .DB $00,$36,$65,$C4 ; -1E09 |
||
5631 | 7865 F85CE3 00 E1 F5 05 .DB $00,$E1,$F5,$05 ; +1E08 |
||
5632 | 7866 F85CE7 80 69 67 FF .DB $80,$69,$67,$FF ; -1E07 |
||
5633 | 7867 F85CEB 40 42 0F 00 .DB $40,$42,$0F,$00 ; +1E06 |
||
5634 | 7868 F85CEF 60 79 FE FF .DB $60,$79,$FE,$FF ; -1E05 |
||
5635 | 7869 F85CF3 10 27 00 00 .DB $10,$27,$00,$00 ; +1E04 |
||
5636 | 7870 F85CF7 18 FC FF FF .DB $18,$FC,$FF,$FF ; -1E03 |
||
5637 | 7871 F85CFB 64 00 00 00 .DB $64,$00,$00,$00 ; +1E02 |
||
5638 | 7872 F85CFF F6 FF FF FF .DB $F6,$FF,$FF,$FF ; -1E01 |
||
5639 | 7873 F85D03 01 00 00 00 .DB $01,$00,$00,$00 ; +1E00 |
||
5640 | 7874 |
||
5641 | 7875 ; bits from 32 to 63 |
||
5642 | 7876 F85D07 dectbl1: |
||
5643 | Tue Jul 17 11:00:18 2018 Page 92 |
||
5644 | |||
5645 | |||
5646 | |||
5647 | |||
5648 | 7877 F85D07 40 22 8A 09 .DB $40,$22,$8A,$09 ; +1E38 |
||
5649 | 7878 F85D0B 60 C9 0B FF .DB $60,$C9,$0B,$FF ; -1E37 |
||
5650 | 7879 F85D0F 10 9F 4B B3 .DB $10,$9F,$4B,$B3 ; +1E36 |
||
5651 | 7880 F85D13 18 70 78 D4 .DB $18,$70,$78,$D4 ; -1E35 |
||
5652 | 7881 F85D17 64 8E 8D 37 .DB $64,$8E,$8D,$37 ; +1E34 |
||
5653 | 7882 F85D1B F6 A4 3E C7 .DB $F6,$A4,$3E,$C7 ; -1E33 |
||
5654 | 7883 F85D1F 81 EF AC 85 .DB $81,$EF,$AC,$85 ; +1E32 |
||
5655 | 7884 F85D23 D9 B4 6E 3F .DB $D9,$B4,$6E,$3F ; -1E31 |
||
5656 | 7885 F85D27 EA ED 74 46 .DB $EA,$ED,$74,$46 ; +1E30 |
||
5657 | 7886 F85D2B 35 E8 8D 92 .DB $35,$E8,$8D,$92 ; -1E29 |
||
5658 | 7887 F85D2F 61 02 25 3E .DB $61,$02,$25,$3E ; +1E28 |
||
5659 | 7888 F85D33 C3 7F 2F 60 .DB $C3,$7F,$2F,$60 ; -1E27 |
||
5660 | 7889 F85D37 D2 0C C8 DC .DB $D2,$0C,$C8,$DC ; +1E26 |
||
5661 | 7890 F85D3B B7 FE EB E9 .DB $B7,$FE,$EB,$E9 ; -1E25 |
||
5662 | 7891 F85D3F ED CC CE 1B .DB $ED,$CC,$CE,$1B ; +1E24 |
||
5663 | 7892 F85D43 B5 1E 38 FD .DB $B5,$1E,$38,$FD ; -1E23 |
||
5664 | 7893 F85D47 BA C9 E0 19 .DB $BA,$C9,$E0,$19 ; +1E22 |
||
5665 | 7894 F85D4B 3A 52 36 CA .DB $3A,$52,$36,$CA ; -1E21 |
||
5666 | 7895 F85D4F 2D 5E C7 6B .DB $2D,$5E,$C7,$6B ; +1E20 |
||
5667 | 7896 F85D53 FB DC 38 75 .DB $FB,$DC,$38,$75 ; -1E19 |
||
5668 | 7897 F85D57 B3 B6 E0 0D .DB $B3,$B6,$E0,$0D ; +1E18 |
||
5669 | 7898 F85D5B 87 BA 9C FE .DB $87,$BA,$9C,$FE ; -1E17 |
||
5670 | 7899 F85D5F F2 86 23 00 .DB $F2,$86,$23,$00 ; +1E16 |
||
5671 | 7900 F85D63 81 72 FC FF .DB $81,$72,$FC,$FF ; -1E15 |
||
5672 | 7901 F85D67 F3 5A 00 00 .DB $F3,$5A,$00,$00 ; +1E14 |
||
5673 | 7902 F85D6B E7 F6 FF FF .DB $E7,$F6,$FF,$FF ; -1E13 |
||
5674 | 7903 F85D6F E8 00 00 00 .DB $E8,$00,$00,$00 ; +1E12 |
||
5675 | 7904 F85D73 E8 FF FF FF .DB $E8,$FF,$FF,$FF ; -1E11 |
||
5676 | 7905 F85D77 02 00 00 00 .DB $02,$00,$00,$00 ; +1E10 |
||
5677 | 7906 F85D7B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E09 |
||
5678 | 7907 F85D7F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E08 |
||
5679 | 7908 F85D83 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E07 |
||
5680 | 7909 F85D87 00 00 00 00 .DB $00,$00,$00,$00 ; +1E06 |
||
5681 | 7910 F85D8B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E05 |
||
5682 | 7911 F85D8F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E04 |
||
5683 | 7912 F85D93 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E03 |
||
5684 | 7913 F85D97 00 00 00 00 .DB $00,$00,$00,$00 ; +1E02 |
||
5685 | 7914 F85D9B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E01 |
||
5686 | 7915 F85D9F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E00 |
||
5687 | 7916 |
||
5688 | 7917 ; bits from 64 to 95 |
||
5689 | 7918 F85DA3 dectbl2: |
||
5690 | 7919 F85DA3 7A C4 86 5A .DB $7A,$C4,$86,$5A ; +1E38 |
||
5691 | 7920 F85DA7 26 B9 25 2A .DB $26,$B9,$25,$2A ; -1E37 |
||
5692 | 7921 F85DAB 15 07 C9 7B .DB $15,$07,$C9,$7B ; +1E36 |
||
5693 | 7922 F85DAF 7D B2 38 8D .DB $7D,$B2,$38,$8D ; -1E35 |
||
5694 | 7923 F85DB3 C0 87 AD BE .DB $C0,$87,$AD,$BE ; +1E34 |
||
5695 | 7924 F85DB7 6C 72 BB 39 .DB $6C,$72,$BB,$39 ; -1E33 |
||
5696 | 7925 F85DBB 5B 41 6D 2D .DB $5B,$41,$6D,$2D ; +1E32 |
||
5697 | 7926 F85DBF DD DF 41 C8 .DB $DD,$DF,$41,$C8 ; -1E31 |
||
5698 | 7927 F85DC3 D0 9C 2C 9F .DB $D0,$9C,$2C,$9F ; +1E30 |
||
5699 | 7928 F85DC7 51 F0 E1 BC .DB $51,$F0,$E1,$BC ; -1E29 |
||
5700 | 7929 F85DCB 5E CE 4F 20 .DB $5E,$CE,$4F,$20 ; +1E28 |
||
5701 | 7930 F85DCF C3 D1 C4 FC .DB $C3,$D1,$C4,$FC ; -1E27 |
||
5702 | 7931 F85DD3 D2 B7 52 00 .DB $D2,$B7,$52,$00 ; +1E26 |
||
5703 | 7932 F85DD7 6A BA F7 FF .DB $6A,$BA,$F7,$FF ; -1E25 |
||
5704 | 7933 F85DDB C2 D3 00 00 .DB $C2,$D3,$00,$00 ; +1E24 |
||
5705 | Tue Jul 17 11:00:18 2018 Page 93 |
||
5706 | |||
5707 | |||
5708 | |||
5709 | |||
5710 | 7934 F85DDF D2 EA FF FF .DB $D2,$EA,$FF,$FF ; -1E23 |
||
5711 | 7935 F85DE3 1E 02 00 00 .DB $1E,$02,$00,$00 ; +1E22 |
||
5712 | 7936 F85DE7 C9 FF FF FF .DB $C9,$FF,$FF,$FF ; -1E21 |
||
5713 | 7937 F85DEB 05 00 00 00 .DB $05,$00,$00,$00 ; +1E20 |
||
5714 | 7938 F85DEF FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E19 |
||
5715 | 7939 F85DF3 00 00 00 00 .DB $00,$00,$00,$00 ; +1E18 |
||
5716 | 7940 F85DF7 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E17 |
||
5717 | 7941 F85DFB 00 00 00 00 .DB $00,$00,$00,$00 ; +1E16 |
||
5718 | 7942 F85DFF FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E15 |
||
5719 | 7943 F85E03 00 00 00 00 .DB $00,$00,$00,$00 ; +1E14 |
||
5720 | 7944 F85E07 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E13 |
||
5721 | 7945 F85E0B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E12 |
||
5722 | 7946 F85E0F FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E11 |
||
5723 | 7947 F85E13 00 00 00 00 .DB $00,$00,$00,$00 ; +1E10 |
||
5724 | 7948 F85E17 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E09 |
||
5725 | 7949 F85E1B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E08 |
||
5726 | 7950 F85E1F FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E07 |
||
5727 | 7951 F85E23 00 00 00 00 .DB $00,$00,$00,$00 ; +1E06 |
||
5728 | 7952 F85E27 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E05 |
||
5729 | 7953 F85E2B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E04 |
||
5730 | 7954 F85E2F FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E03 |
||
5731 | 7955 F85E33 00 00 00 00 .DB $00,$00,$00,$00 ; +1E02 |
||
5732 | 7956 F85E37 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E01 |
||
5733 | 7957 F85E3B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E00 |
||
5734 | 7958 |
||
5735 | 7959 ; bits from 96 to 127 |
||
5736 | 7960 F85E3F dectbl3: |
||
5737 | 7961 F85E3F A8 4C 3B 4B .DB $A8,$4C,$3B,$4B ; +1E38 |
||
5738 | 7962 F85E43 EF 11 7A F8 .DB $EF,$11,$7A,$F8 ; -1E37 |
||
5739 | 7963 F85E47 CE 97 C0 00 .DB $CE,$97,$C0,$00 ; +1E36 |
||
5740 | 7964 F85E4B 9E BD EC FF .DB $9E,$BD,$EC,$FF ; -1E35 |
||
5741 | 7965 F85E4F 09 ED 01 00 .DB $09,$ED,$01,$00 ; +1E34 |
||
5742 | 7966 F85E53 B2 CE FF FF .DB $B2,$CE,$FF,$FF ; -1E33 |
||
5743 | 7967 F85E57 EE 04 00 00 .DB $EE,$04,$00,$00 ; +1E32 |
||
5744 | 7968 F85E5B 81 FF FF FF .DB $81,$FF,$FF,$FF ; -1E31 |
||
5745 | 7969 F85E5F 0C 00 00 00 .DB $0C,$00,$00,$00 ; +1E30 |
||
5746 | 7970 F85E63 FE FF FF FF .DB $FE,$FF,$FF,$FF ; -1E29 |
||
5747 | 7971 F85E67 00 00 00 00 .DB $00,$00,$00,$00 ; +1E28 |
||
5748 | 7972 F85E6B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E27 |
||
5749 | 7973 F85E6F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E26 |
||
5750 | 7974 F85E73 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E25 |
||
5751 | 7975 F85E77 00 00 00 00 .DB $00,$00,$00,$00 ; +1E24 |
||
5752 | 7976 F85E7B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E23 |
||
5753 | 7977 F85E7F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E22 |
||
5754 | 7978 F85E83 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E21 |
||
5755 | 7979 F85E87 00 00 00 00 .DB $00,$00,$00,$00 ; +1E20 |
||
5756 | 7980 F85E8B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E19 |
||
5757 | 7981 F85E8F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E18 |
||
5758 | 7982 F85E93 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E17 |
||
5759 | 7983 F85E97 00 00 00 00 .DB $00,$00,$00,$00 ; +1E16 |
||
5760 | 7984 F85E9B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E15 |
||
5761 | 7985 F85E9F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E14 |
||
5762 | 7986 F85EA3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E13 |
||
5763 | 7987 F85EA7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E12 |
||
5764 | 7988 F85EAB FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E11 |
||
5765 | 7989 F85EAF 00 00 00 00 .DB $00,$00,$00,$00 ; +1E10 |
||
5766 | 7990 F85EB3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E09 |
||
5767 | Tue Jul 17 11:00:18 2018 Page 94 |
||
5768 | |||
5769 | |||
5770 | |||
5771 | |||
5772 | 7991 F85EB7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E08 |
||
5773 | 7992 F85EBB FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E07 |
||
5774 | 7993 F85EBF 00 00 00 00 .DB $00,$00,$00,$00 ; +1E06 |
||
5775 | 7994 F85EC3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E05 |
||
5776 | 7995 |
||
5777 | 7996 ; this portion is used by routine that convert 16 bits integer to decimal |
||
5778 | 7997 F85EC7 dec1e4: |
||
5779 | 7998 F85EC7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E04 |
||
5780 | 7999 F85ECB FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E03 |
||
5781 | 8000 F85ECF 00 00 00 00 .DB $00,$00,$00,$00 ; +1E02 |
||
5782 | 8001 F85ED3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E01 |
||
5783 | 8002 F85ED7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E00 |
||
5784 | 8003 |
||
5785 | 8004 00009C DTBLSIZ .EQU $-dectbl3 |
||
5786 | 8005 000088 I16IDX .EQU dec1e4-dectbl3 |
||
5787 | 8006 |
||
5788 | 8007 ; limits for conversion float-to-decimal |
||
5789 | 8008 F85EDB 00 00 00 00 00 fce37: .DB $00,$00,$00,$00,$00,$D4,$86,$1E,$20 |
||
5790 | D4 86 1E 20 |
||
5791 | 8009 F85EE4 DB 48 BB 1A C2 .DB $DB,$48,$BB,$1A,$C2,$BD,$F0,$79,$40 ; 1e37 |
||
5792 | BD F0 79 40 |
||
5793 | 8010 F85EED |
||
5794 | 8011 F85EED 00 00 00 00 80 fce38: .DB $00,$00,$00,$00,$80,$44,$14,$13,$F4 |
||
5795 | 44 14 13 F4 |
||
5796 | 8012 F85EF6 88 0D B5 50 99 .DB $88,$0D,$B5,$50,$99,$76,$96,$7D,$40 ; 1e38 |
||
5797 | 76 96 7D 40 |
||
5798 | 8013 |
||
5799 | 8014 ; table of constant for scaling (not rounded, 128 bits mantissa) |
||
5800 | 8015 ; used by scale10 routine (scaling by a power of ten) |
||
5801 | 8016 F85EFF 00 00 00 00 00 fce0: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5802 | 00 00 00 00 |
||
5803 | 8017 F85F08 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FF,$3F ; 1 |
||
5804 | 00 80 FF 3F |
||
5805 | 8018 F85F11 00 00 00 00 00 fce1: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5806 | 00 00 00 00 |
||
5807 | 8019 F85F1A 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$A0,$02,$40 ; 10 |
||
5808 | 00 A0 02 40 |
||
5809 | 8020 F85F23 00 00 00 00 00 fce2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5810 | 00 00 00 00 |
||
5811 | 8021 F85F2C 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$C8,$05,$40 ; 100 |
||
5812 | 00 C8 05 40 |
||
5813 | 8022 F85F35 00 00 00 00 00 fce3: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5814 | 00 00 00 00 |
||
5815 | 8023 F85F3E 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$FA,$08,$40 ; 1E3 |
||
5816 | 00 FA 08 40 |
||
5817 | 8024 F85F47 00 00 00 00 00 fce4: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5818 | 00 00 00 00 |
||
5819 | 8025 F85F50 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$40,$9C,$0C,$40 ; 1E4 |
||
5820 | 40 9C 0C 40 |
||
5821 | 8026 F85F59 00 00 00 00 00 fce5: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5822 | 00 00 00 00 |
||
5823 | 8027 F85F62 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$50,$C3,$0F,$40 ; 1E5 |
||
5824 | 50 C3 0F 40 |
||
5825 | 8028 F85F6B 00 00 00 00 00 fce6: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5826 | 00 00 00 00 |
||
5827 | 8029 F85F74 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$24,$F4,$12,$40 ; 1E6 |
||
5828 | 24 F4 12 40 |
||
5829 | Tue Jul 17 11:00:18 2018 Page 95 |
||
5830 | |||
5831 | |||
5832 | |||
5833 | |||
5834 | 8030 F85F7D 00 00 00 00 00 fce7: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5835 | 00 00 00 00 |
||
5836 | 8031 F85F86 00 00 00 00 80 .DB $00,$00,$00,$00,$80,$96,$98,$16,$40 ; 1E7 |
||
5837 | 96 98 16 40 |
||
5838 | 8032 |
||
5839 | 8033 F85F8F 00 00 00 00 00 fce8: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5840 | 00 00 00 00 |
||
5841 | 8034 F85F98 00 00 00 00 20 .DB $00,$00,$00,$00,$20,$BC,$BE,$19,$40 ; 1E8 |
||
5842 | BC BE 19 40 |
||
5843 | 8035 |
||
5844 | 8036 F85FA1 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
5845 | 00 00 00 00 |
||
5846 | 8037 F85FAA 00 00 04 BF C9 .DB $00,$00,$04,$BF,$C9,$1B,$8E,$34,$40 ; 1E16 |
||
5847 | 1B 8E 34 40 |
||
5848 | 8038 |
||
5849 | 8039 F85FB3 00 00 00 00 00 fce32: .DB $00,$00,$00,$00,$00,$00,$20,$F0,$9D |
||
5850 | 00 20 F0 9D |
||
5851 | 8040 F85FBC B5 70 2B A8 AD .DB $B5,$70,$2B,$A8,$AD,$C5,$9D,$69,$40 ; 1E32 |
||
5852 | C5 9D 69 40 |
||
5853 | 8041 |
||
5854 | 8042 F85FC5 FA 25 6B C7 71 fce64: .DB $FA,$25,$6B,$C7,$71,$6B,$BF,$3C,$D5 |
||
5855 | 6B BF 3C D5 |
||
5856 | 8043 F85FCE A6 CF FF 49 1F .DB $A6,$CF,$FF,$49,$1F,$78,$C2,$D3,$40 ; 1E64 |
||
5857 | 78 C2 D3 40 |
||
5858 | 8044 |
||
5859 | 8045 F85FD7 35 01 B1 36 6C .DB $35,$01,$B1,$36,$6C,$33,$6F,$C6,$DF |
||
5860 | 33 6F C6 DF |
||
5861 | 8046 F85FE0 8C E9 80 C9 47 .DB $8C,$E9,$80,$C9,$47,$BA,$93,$A8,$41 ; 1E128 |
||
5862 | BA 93 A8 41 |
||
5863 | 8047 |
||
5864 | 8048 F85FE9 B2 EA FE 98 1B .DB $B2,$EA,$FE,$98,$1B,$90,$BB,$DD,$8D |
||
5865 | 90 BB DD 8D |
||
5866 | 8049 F85FF2 DE F9 9D FB EB .DB $DE,$F9,$9D,$FB,$EB,$7E,$AA,$51,$43 ; 1E256 |
||
5867 | 7E AA 51 43 |
||
5868 | 8050 F85FFB |
||
5869 | 8051 F85FFB E8 58 50 BC 54 .DB $E8,$58,$50,$BC,$54,$5C,$65,$CC,$C6 |
||
5870 | 5C 65 CC C6 |
||
5871 | 8052 F86004 91 0E A6 AE A0 .DB $91,$0E,$A6,$AE,$A0,$19,$E3,$A3,$46 ; 1E512 |
||
5872 | 19 E3 A3 46 |
||
5873 | 8053 |
||
5874 | 8054 F8600D B0 50 8B F1 28 .DB $B0,$50,$8B,$F1,$28,$3D,$0D,$65,$17 |
||
5875 | 3D 0D 65 17 |
||
5876 | 8055 F86016 0C 75 81 86 75 .DB $0C,$75,$81,$86,$75,$76,$C9,$48,$4D ; 1E1024 |
||
5877 | 76 C9 48 4D |
||
5878 | 8056 |
||
5879 | 8057 F8601F 22 CE 9A 32 CE .DB $22,$CE,$9A,$32,$CE,$28,$4D,$A7,$E4 |
||
5880 | 28 4D A7 E4 |
||
5881 | 8058 F86028 5D 3D C5 5D 3B .DB $5D,$3D,$C5,$5D,$3B,$8B,$9E,$92,$5A ; 1E2048 |
||
5882 | 8B 9E 92 5A |
||
5883 | 8059 |
||
5884 | 8060 F86031 fce4096: |
||
5885 | 8061 F86031 1A 4A 4A 80 3F .DB $1A,$4A,$4A,$80,$3F,$15,$4C,$C9,$9A |
||
5886 | 15 4C C9 9A |
||
5887 | 8062 F8603A 97 20 8A 02 52 .DB $97,$20,$8A,$02,$52,$60,$C4,$25,$75 ; 1E4096 |
||
5888 | 60 C4 25 75 |
||
5889 | 8063 |
||
5890 | 8064 000012 FCSIZ .EQU $-fce4096 |
||
5891 | Tue Jul 17 11:00:18 2018 Page 96 |
||
5892 | |||
5893 | |||
5894 | |||
5895 | |||
5896 | 8065 |
||
5897 | 8066 ; constants address used by scxale10 routine |
||
5898 | 8067 F86043 fcaddr: |
||
5899 | 8068 F86043 FF5E 115F 235F .DW fce0, fce1, fce2, fce3, fce4, fce5, fce6, fce7 |
||
5900 | 355F 475F 595F |
||
5901 | 6B5F 7D5F |
||
5902 | 8069 |
||
5903 | 8070 ;---------------------------------------------------------------------------- |
||
5904 | 8071 ; square root & cube root |
||
5905 | 8072 ;---------------------------------------------------------------------------- |
||
5906 | 8073 F86053 |
||
5907 | 8074 ; fsqrt - return the square root of the argument |
||
5908 | 8075 ; |
||
5909 | 8076 ; entry: |
||
5910 | 8077 ; fac = x |
||
5911 | 8078 ; |
||
5912 | 8079 ; exit: |
||
5913 | 8080 ; fac = sqrt(x) |
||
5914 | 8081 ; CF = 1 if invalid result (nan, inf) |
||
5915 | 8082 ; |
||
5916 | 8083 ; strategy: |
||
5917 | 8084 ; range reduction involves isolating the power of two of the |
||
5918 | 8085 ; argument and using a rational approximation to obtain |
||
5919 | 8086 ; a rough value for the square root; then Heron's (Newton) iteration |
||
5920 | 8087 ; is used four times to converge to an accurate value. |
||
5921 | 8088 ; |
||
5922 | 8089 ; 1) range reduction is accomplished by separating the argument x |
||
5923 | 8090 ; into an integer M and fraction z such that: |
||
5924 | 8091 ; |
||
5925 | 8092 ; 2*M |
||
5926 | 8093 ; x = z * 2 with: 0.25 <= z < 1 |
||
5927 | 8094 ; |
||
5928 | 8095 ; 2) obtain a rough value w for the square root of z by a |
||
5929 | 8096 ; rational approximation: |
||
5930 | 8097 ; |
||
5931 | 8098 ; w = A*z + B - C/(z + D) (accuracy: 10/12 bits) |
||
5932 | 8099 ; |
||
5933 | 8100 ; 3) the estimate w is used as initial seed for Heron's iteration: |
||
5934 | 8101 ; |
||
5935 | 8102 ; y[n+1] = 0.5*(y[n] + z/y[n]) where y[0] = w, n = 3 |
||
5936 | 8103 ; |
||
5937 | 8104 ; 4) finally, the square root of the x is obtained scaling back y: |
||
5938 | 8105 ; |
||
5939 | 8106 ; M M |
||
5940 | 8107 ; sqrt(x) = sqrt(z) * 2 = y * 2 |
||
5941 | 8108 ; |
||
5942 | 8109 ; computation mean time: 30ms at 4MHz |
||
5943 | 8110 ; |
||
5944 | 8111 ;----- |
||
5945 | 8112 F86053 fsqrt: |
||
5946 | 8113 ;----- |
||
5947 | 8114 F86053 24 25 bit facst ; fac is valid? |
||
5948 | 8115 F86055 10 0B bpl ?fv ; yes |
||
5949 | 8116 F86057 70 07 bvs ?er ; fac=nan so return nan |
||
5950 | 8117 F86059 24 24 bit facsgn ; fac=inf so check sign |
||
5951 | 8118 F8605B 10 03 bpl ?er ; fac=+inf so return +inf |
||
5952 | 8119 F8605D 4C 74 4E ?nan: jmp fldnan ; fac=-inf so return nan |
||
5953 | Tue Jul 17 11:00:18 2018 Page 97 |
||
5954 | |||
5955 | |||
5956 | |||
5957 | |||
5958 | 8120 F86060 38 ?er: sec |
||
5959 | 8121 F86061 60 rts |
||
5960 | 8122 F86062 50 04 ?fv: bvc ?xp ; fac is not zero |
||
5961 | 8123 F86064 64 24 stz facsgn ; fac=+/-0 return always +0 |
||
5962 | 8124 F86066 18 clc |
||
5963 | 8125 F86067 60 rts |
||
5964 | 8126 F86068 24 24 ?xp: bit facsgn ; check if fac>0 |
||
5965 | 8127 F8606A 30 F1 bmi ?nan ; fac<0 so return nan |
||
5966 | 8128 F8606C 20 6E 48 jsr frexp ; reduce argument to range [0.5,1) |
||
5967 | 8129 F8606F CPU16 |
||
5968 | 8130 F8606F C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
5969 | 8131 .LONGA on |
||
5970 | 8132 .LONGI on |
||
5971 | 8133 .MNLIST |
||
5972 | 8134 F86071 A5 46 lda scexp ; the true 2 exponent |
||
5973 | 8135 F86073 AA tax |
||
5974 | 8136 F86074 4A lsr a ; CF=0 if exponent is divisible by 2 |
||
5975 | 8137 F86075 8A txa ; C=exponent |
||
5976 | 8138 F86076 90 03 bcc ?sgn ; divisible by 2 |
||
5977 | 8139 F86078 C6 22 dec facexp ; reduce argument to range [0.25, 0.5) |
||
5978 | 8140 F8607A 1A inc a ; increment the exponent (now divisible by 2) |
||
5979 | 8141 F8607B 0A ?sgn: asl a ; CF=exponent sign |
||
5980 | 8142 F8607C 90 01 bcc ?sgn2 ; positive |
||
5981 | 8143 F8607E 1A inc a ; negative: put sign in bit 0 |
||
5982 | 8144 F8607F 6A ?sgn2: ror a ; restore exponent |
||
5983 | 8145 F86080 6A ror a ; divide by 2 with sign extension |
||
5984 | 8146 F86081 85 46 sta scexp ; scexp = M, fac = z |
||
5985 | 8147 F86083 CPU08 |
||
5986 | 8148 F86083 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
5987 | 8149 .LONGA off |
||
5988 | 8150 .LONGI off |
||
5989 | 8151 .MNLIST |
||
5990 | 8152 F86085 |
||
5991 | 8153 ; approximate sqrt(z) in range [0.25,1) with rational function: |
||
5992 | 8154 ; w = A*z + B - C/(z + D) (accuracy: 10/12 bits) |
||
5993 | 8155 F86085 20 66 84 jsr mvf_t0 ; tfr0 = z |
||
5994 | 8156 F86088 20 67 45 jsr faddhalf ; z + D (D=0.5) |
||
5995 | 8157 F8608B A9 D0 lda #<sqc ; C |
||
5996 | 8158 F8608D A0 61 ldy #>sqc |
||
5997 | 8159 F8608F 20 01 4A jsr fcdiv ; C/(z + D) |
||
5998 | 8160 F86092 A9 BE lda #<sqb ; B |
||
5999 | 8161 F86094 A0 61 ldy #>sqb |
||
6000 | 8162 F86096 20 5C 45 jsr fcsub ; B - C/(z + D) |
||
6001 | 8163 F86099 20 93 84 jsr mvf_t1 |
||
6002 | 8164 F8609C 20 47 85 jsr mvt0_f ; z |
||
6003 | 8165 F8609F A9 AC lda #<sqa ; A |
||
6004 | 8166 F860A1 A0 61 ldy #>sqa |
||
6005 | 8167 F860A3 20 D5 49 jsr fcmult ; A*z |
||
6006 | 8168 F860A6 20 FB 85 jsr mvt1_a |
||
6007 | 8169 F860A9 20 7D 45 jsr fpadd ; A*z + B - C/(z + D) |
||
6008 | 8170 |
||
6009 | 8171 ; Hero's iteration four times |
||
6010 | 8172 F860AC 20 BB 60 jsr ?nit |
||
6011 | 8173 F860AF 20 BB 60 jsr ?nit |
||
6012 | 8174 F860B2 20 BB 60 jsr ?nit |
||
6013 | 8175 F860B5 20 BB 60 jsr ?nit ; fac=sqrt(z) |
||
6014 | 8176 |
||
6015 | Tue Jul 17 11:00:18 2018 Page 98 |
||
6016 | |||
6017 | |||
6018 | |||
6019 | |||
6020 | 8177 F860B8 4C B7 48 jmp fscale ; fac=sqrt(z)*(2^M)=sqrt(x) |
||
6021 | 8178 |
||
6022 | 8179 ; newton iteration for sqrt |
||
6023 | 8180 ; y[n+1] = 0.5*(y[n] + z/y[n]) |
||
6024 | 8181 ; where y[0]=w is the initial seed value |
||
6025 | 8182 ; note that is safe, when fac is normal and limited, |
||
6026 | 8183 ; to multiplies by 2 simply incrementing the exponent |
||
6027 | 8184 F860BB 20 93 84 ?nit: jsr mvf_t1 ; tfr1 = y[n] |
||
6028 | 8185 F860BE 20 CE 85 jsr mvt0_a ; arg = z |
||
6029 | 8186 F860C1 20 10 4A jsr fpdiv ; x/y[n] |
||
6030 | 8187 F860C4 20 FB 85 jsr mvt1_a ; arg = y[n] |
||
6031 | 8188 F860C7 20 7D 45 jsr fpadd ; y[n] + z/y[n] |
||
6032 | 8189 F860CA ACC16 |
||
6033 | 8190 F860CA C2 20 rep #PMFLAG |
||
6034 | 8191 .LONGA on |
||
6035 | 8192 .MNLIST |
||
6036 | 8193 F860CC C6 22 dec facexp ; y[n+1] = 0.5*(y[n] + z/y[n]) |
||
6037 | 8194 F860CE ACC08 |
||
6038 | 8195 F860CE E2 20 sep #PMFLAG |
||
6039 | 8196 .LONGA off |
||
6040 | 8197 .MNLIST |
||
6041 | 8198 F860D0 60 rts |
||
6042 | 8199 |
||
6043 | 8200 ; fcbrt - return the cube root of the argument |
||
6044 | 8201 ; |
||
6045 | 8202 ; entry: |
||
6046 | 8203 ; fac = x |
||
6047 | 8204 ; |
||
6048 | 8205 ; exit: |
||
6049 | 8206 ; fac = cbrt(x) |
||
6050 | 8207 ; CF = 1 if invalid result (nan, inf) |
||
6051 | 8208 ; |
||
6052 | 8209 ; strategy: |
||
6053 | 8210 ; range reduction involves isolating the power of two of the |
||
6054 | 8211 ; argument and using a rational approximation to obtain |
||
6055 | 8212 ; a rough value for the cube root; then one Newton iteration followed |
||
6056 | 8213 ; by one Halley iteration is used to converge to an accurate value. |
||
6057 | 8214 ; |
||
6058 | 8215 ; 1) range reduction is accomplished by separating the argument x |
||
6059 | 8216 ; into an integer M and fraction z such that: |
||
6060 | 8217 ; |
||
6061 | 8218 ; 3*M |
||
6062 | 8219 ; x = z * 2 with: 0.125 <= z < 1 |
||
6063 | 8220 ; |
||
6064 | 8221 ; 2) obtain a rough value w for the square root of z by a |
||
6065 | 8222 ; rational approximation of 8th degree: |
||
6066 | 8223 ; |
||
6067 | 8224 ; w = N(z)/D(z) (accuracy: 22/24 bits) |
||
6068 | 8225 ; |
||
6069 | 8226 ; 3) the estimate w is used as initial seed for Newton's iteration: |
||
6070 | 8227 ; |
||
6071 | 8228 ; p = (1/3)*((z/w*w)) + 2*w) |
||
6072 | 8229 ; |
||
6073 | 8230 ; 4) the estimate p is used as seed for final Halley's iteration: |
||
6074 | 8231 ; |
||
6075 | 8232 ; y = p*((p*p*p+2*z)/(2*p*p*p+z)) |
||
6076 | 8233 ; |
||
6077 | Tue Jul 17 11:00:18 2018 Page 99 |
||
6078 | |||
6079 | |||
6080 | |||
6081 | |||
6082 | 8234 ; 5) finally, the cube root of the x is obtained scaling back y: |
||
6083 | 8235 ; |
||
6084 | 8236 ; M M |
||
6085 | 8237 ; cbrt(x) = cbrt(z) * 2 = y * 2 |
||
6086 | 8238 ; |
||
6087 | 8239 ; computation mean time: 75/80ms at 4MHz |
||
6088 | 8240 ; |
||
6089 | 8241 ;----- |
||
6090 | 8242 F860D1 fcbrt: |
||
6091 | 8243 ;----- |
||
6092 | 8244 F860D1 24 25 bit facst ; if fac is not valid return nan if fac=nan... |
||
6093 | 8245 F860D3 30 04 bmi ?er ; ...or return inf if fac=inf (same fac sign) |
||
6094 | 8246 F860D5 50 04 bvc ?ok ; fac is not zero |
||
6095 | 8247 F860D7 18 clc ; return fac=0 |
||
6096 | 8248 F860D8 60 rts |
||
6097 | 8249 F860D9 38 ?er: sec |
||
6098 | 8250 F860DA 60 rts |
||
6099 | 8251 F860DB A5 24 ?ok: lda facsgn ; save fac sign... |
||
6100 | 8252 F860DD 85 4A sta dsgn |
||
6101 | 8253 F860DF 64 24 stz facsgn ; ...and work with absolute value |
||
6102 | 8254 F860E1 20 6E 48 jsr frexp ; reduce argument to range [0.5,1) |
||
6103 | 8255 F860E4 CPU16 |
||
6104 | 8256 F860E4 C2 30 rep #(PMFLAG.OR.PXFLAG) |
||
6105 | 8257 .LONGA on |
||
6106 | 8258 .LONGI on |
||
6107 | 8259 .MNLIST |
||
6108 | 8260 F860E6 A2 03 00 ldx #3 |
||
6109 | 8261 F860E9 A5 48 lda dexp ; absolute value of the exponent |
||
6110 | 8262 F860EB 20 11 88 jsr udiv ; C=quotient, Y=remainder (unsigned) |
||
6111 | 8263 F860EE BB tyx |
||
6112 | 8264 F860EF F0 2B beq ?go ; remainder=0, exponent is divisible by 3 |
||
6113 | 8265 F860F1 98 tya ; C=remainder |
||
6114 | 8266 F860F2 A4 46 ldy scexp ; check exponent sign |
||
6115 | 8267 F860F4 30 06 bmi ?ne ; handle negative exponent |
||
6116 | 8268 F860F6 38 sec ; C=remainder, compute remainder such that... |
||
6117 | 8269 F860F7 E9 03 00 sbc #3 ; ...(exponent-C) is divisible by 3 |
||
6118 | 8270 F860FA 80 04 bra ?ne2 |
||
6119 | 8271 F860FC 49 FF FF ?ne: eor #$FFFF ; exponent is negative... |
||
6120 | 8272 F860FF 1A inc a ; ...so change sign to remainder |
||
6121 | 8273 F86100 85 3E ?ne2: sta wftmp ; save for later use |
||
6122 | 8274 F86102 18 clc |
||
6123 | 8275 F86103 65 22 adc facexp ; reduce argument to range [0.125,1) |
||
6124 | 8276 F86105 85 22 sta facexp |
||
6125 | 8277 F86107 38 sec |
||
6126 | 8278 F86108 A5 46 lda scexp ; find the new exponent after reduction |
||
6127 | 8279 F8610A E5 3E sbc wftmp |
||
6128 | 8280 F8610C F0 16 beq ?go2 ; exponent=0 |
||
6129 | 8281 F8610E 85 46 sta scexp |
||
6130 | 8282 F86110 10 04 bpl ?pe |
||
6131 | 8283 F86112 49 FF FF eor #$FFFF |
||
6132 | 8284 F86115 1A inc a |
||
6133 | 8285 F86116 A2 03 00 ?pe: ldx #3 ; now exponent is divisible by 3 |
||
6134 | 8286 F86119 20 11 88 jsr udiv ; C=new exponent |
||
6135 | 8287 F8611C A6 46 ?go: ldx scexp ; change sign if negative |
||
6136 | 8288 F8611E 10 04 bpl ?go2 |
||
6137 | 8289 F86120 49 FF FF eor #$FFFF |
||
6138 | 8290 F86123 1A inc a |
||
6139 | Tue Jul 17 11:00:18 2018 Page 100 |
||
6140 | |||
6141 | |||
6142 | |||
6143 | |||
6144 | 8291 F86124 85 46 ?go2: sta scexp ; scexp=M=exponent of cube root |
||
6145 | 8292 F86126 CPU08 ; fac=z, range: [1/8, 1) |
||
6146 | 8293 F86126 E2 30 sep #(PMFLAG.OR.PXFLAG) |
||
6147 | 8294 .LONGA off |
||
6148 | 8295 .LONGI off |
||
6149 | 8296 .MNLIST |
||
6150 | 8297 |
||
6151 | 8298 ; approximate cbrt(z) in range [0.125,1) with rational function: |
||
6152 | 8299 ; w = N(z)/D(z) (accuracy: 22/24 bits) |
||
6153 | 8300 F86128 20 66 84 jsr mvf_t0 ; tfr0 = z |
||
6154 | 8301 F8612B A9 F4 lda #<cbrn ; evaluate numerator |
||
6155 | 8302 F8612D A0 61 ldy #>cbrn |
||
6156 | 8303 F8612F A2 04 ldx #4 ; degree=4 |
||
6157 | 8304 F86131 20 1C 87 jsr peval |
||
6158 | 8305 F86134 20 93 84 jsr mvf_t1 ; tfr1=N(z) |
||
6159 | 8306 F86137 A9 4E lda #<cbrd ; evaluate denominator |
||
6160 | 8307 F86139 A0 62 ldy #>cbrd |
||
6161 | 8308 F8613B A2 04 ldx #4 ; degree=4 |
||
6162 | 8309 F8613D 20 1C 87 jsr peval |
||
6163 | 8310 F86140 20 FB 85 jsr mvt1_a ; arg=N(z) |
||
6164 | 8311 F86143 20 10 4A jsr fpdiv ; w=N(z)/D(z) |
||
6165 | 8312 |
||
6166 | 8313 F86146 20 54 61 jsr ?nit ; Newton's iteration (evaluate p) |
||
6167 | 8314 F86149 20 73 61 jsr ?hit ; Halley's iteration (evaluate y) |
||
6168 | 8315 F8614C |
||
6169 | 8316 F8614C 20 B7 48 jsr fscale ; fac=cbrtt(z)*(2^M)=sqrt(x) |
||
6170 | 8317 F8614F A5 4A lda dsgn ; restore original argument sign |
||
6171 | 8318 F86151 85 24 sta facsgn |
||
6172 | 8319 F86153 60 rts |
||
6173 | 8320 F86154 |
||
6174 | 8321 ?nit: ; Newton's iteration |
||
6175 | 8322 ; p = (1/3)*((z/w*w)) + 2*w) |
||
6176 | 8323 F86154 20 93 84 jsr mvf_t1 ; tfr1 = w (initial seed) |
||
6177 | 8324 F86157 20 CC 49 jsr fsquare ; w*w |
||
6178 | 8325 F8615A 20 CE 85 jsr mvt0_a ; arg=z |
||
6179 | 8326 F8615D 20 10 4A jsr fpdiv ; z/(w*w) |
||
6180 | 8327 F86160 20 FB 85 jsr mvt1_a ; arg=w |
||
6181 | 8328 F86163 ACC16 ; is safe here simply increment exponent |
||
6182 | 8329 F86163 C2 20 rep #PMFLAG |
||
6183 | 8330 .LONGA on |
||
6184 | 8331 .MNLIST |
||
6185 | 8332 F86165 E6 3A inc argexp ; arg=2*w |
||
6186 | 8333 F86167 ACC08 |
||
6187 | 8334 F86167 E2 20 sep #PMFLAG |
||
6188 | 8335 .LONGA off |
||
6189 | 8336 .MNLIST |
||
6190 | 8337 F86169 20 7D 45 jsr fpadd ; 2*w + z/(w*w) |
||
6191 | 8338 F8616C A9 E2 lda #<c13 ; 1/3 |
||
6192 | 8339 F8616E A0 61 ldy #>c13 |
||
6193 | 8340 F86170 4C D5 49 jmp fcmult ; p = (1/3)*((x/(w*w)) + 2*w) |
||
6194 | 8341 |
||
6195 | 8342 ?hit: ; Halley's iteration |
||
6196 | 8343 ; y = p*((p*p*p+2*z)/(2*p*p*p+z)) |
||
6197 | 8344 F86173 20 93 84 jsr mvf_t1 ; tfr1=p |
||
6198 | 8345 F86176 20 CC 49 jsr fsquare ; p*p |
||
6199 | 8346 F86179 20 FB 85 jsr mvt1_a |
||
6200 | 8347 F8617C 20 DD 49 jsr fpmult ; p*p*p |
||
6201 | Tue Jul 17 11:00:18 2018 Page 101 |
||
6202 | |||
6203 | |||
6204 | |||
6205 | |||
6206 | 8348 F8617F 20 C0 84 jsr mvf_t2 ; tfr2=p*p*p |
||
6207 | 8349 F86182 20 CE 85 jsr mvt0_a ; z |
||
6208 | 8350 F86185 ACC16 ; is safe here simply increment exponent |
||
6209 | 8351 F86185 C2 20 rep #PMFLAG |
||
6210 | 8352 .LONGA on |
||
6211 | 8353 .MNLIST |
||
6212 | 8354 F86187 E6 3A inc argexp ; 2*z |
||
6213 | 8355 F86189 ACC08 |
||
6214 | 8356 F86189 E2 20 sep #PMFLAG |
||
6215 | 8357 .LONGA off |
||
6216 | 8358 .MNLIST |
||
6217 | 8359 F8618B 20 7D 45 jsr fpadd |
||
6218 | 8360 F8618E 20 ED 84 jsr mvf_t3 ; tfr3=p*p*p+2*X |
||
6219 | 8361 F86191 20 28 86 jsr mvt2_a ; p*p*p |
||
6220 | 8362 F86194 ACC16 ; is safe here simply increment exponent |
||
6221 | 8363 F86194 C2 20 rep #PMFLAG |
||
6222 | 8364 .LONGA on |
||
6223 | 8365 .MNLIST |
||
6224 | 8366 F86196 E6 3A inc argexp ; 2*p*p*p |
||
6225 | 8367 F86198 ACC08 |
||
6226 | 8368 F86198 E2 20 sep #PMFLAG |
||
6227 | 8369 .LONGA off |
||
6228 | 8370 .MNLIST |
||
6229 | 8371 F8619A 20 47 85 jsr mvt0_f ; z |
||
6230 | 8372 F8619D 20 7D 45 jsr fpadd ; 2*p*p*p+z |
||
6231 | 8373 F861A0 20 55 86 jsr mvt3_a ; p*p*p+2*z |
||
6232 | 8374 F861A3 20 10 4A jsr fpdiv ; (p*p*p+2*z)/(2*p*p*p+z) |
||
6233 | 8375 F861A6 20 FB 85 jsr mvt1_a ; p |
||
6234 | 8376 F861A9 4C DD 49 jmp fpmult ; p*((p*p*p+2*z)/(2*p*p*p+z)) |
||
6235 | 8377 |
||
6236 | 8378 ; coefficients for initial rational approximation to square root |
||
6237 | 8379 ; R(x) = Ax + B - C/(x + D) 10 bit (0.25 <= x < 1, D=0.5) |
||
6238 | 8380 F861AC 62 47 23 98 80 sqa: .DB $62,$47,$23,$98,$80,$52,$B7,$9F,$F7 |
||
6239 | 52 B7 9F F7 |
||
6240 | 8381 F861B5 6F 60 5B 7C 8C .DB $6F,$60,$5B,$7C,$8C,$BA,$AF,$FD,$3F ; A=0.343220129185 |
||
6241 | BA AF FD 3F |
||
6242 | 8382 F861BE 9E BA E5 B7 91 sqb: .DB $9E,$BA,$E5,$B7,$91,$09,$68,$DF,$B2 |
||
6243 | 09 68 DF B2 |
||
6244 | 8383 F861C7 76 6E E6 E6 13 .DB $76,$6E,$E6,$E6,$13,$52,$E6,$FE,$3F ; B=0.899689906952 |
||
6245 | 52 E6 FE 3F |
||
6246 | 8384 F861D0 4C 28 D6 5D 7A sqc: .DB $4C,$28,$D6,$5D,$7A,$85,$E9,$00,$81 |
||
6247 | 85 E9 00 81 |
||
6248 | 8385 F861D9 17 23 D0 C7 70 .DB $17,$23,$D0,$C7,$70,$63,$BA,$FD,$3F ; C=0.364039921180 |
||
6249 | 63 BA FD 3F |
||
6250 | 8386 |
||
6251 | 8387 F861E2 AA AA AA AA AA c13: .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA |
||
6252 | AA AA AA AA |
||
6253 | 8388 F861EB AA AA AA AA AA .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FD,$3F ; 1/3 |
||
6254 | AA AA FD 3F |
||
6255 | 8389 |
||
6256 | 8390 ; coefficients for initial rational approximation to cube root (0.125 <= x < 1) |
||
6257 | 8391 cbrn: ; numerator coefficients (degree 4) |
||
6258 | 8392 ; N[4] = 45.2548339756803022511987494 |
||
6259 | 8393 F861F4 3C 10 33 78 FE .DB $3C,$10,$33,$78,$FE,$76,$9E,$89,$D0 |
||
6260 | 76 9E 89 D0 |
||
6261 | 8394 F861FD 83 D3 9D 32 F3 .DB $83,$D3,$9D,$32,$F3,$04,$B5,$04,$40 |
||
6262 | 04 B5 04 40 |
||
6263 | Tue Jul 17 11:00:18 2018 Page 102 |
||
6264 | |||
6265 | |||
6266 | |||
6267 | |||
6268 | 8395 ; N[3] = 192.2798368355061050458134625 |
||
6269 | 8396 F86206 08 E3 5B 8C F2 .DB $08,$E3,$5B,$8C,$F2,$49,$06,$80,$97 |
||
6270 | 49 06 80 97 |
||
6271 | 8397 F8620F 00 B7 08 63 A3 .DB $00,$B7,$08,$63,$A3,$47,$C0,$06,$40 |
||
6272 | 47 C0 06 40 |
||
6273 | 8398 ; N[2] = 119.1654824285581628956914143 |
||
6274 | 8399 F86218 42 D8 BC 63 FD .DB $42,$D8,$BC,$63,$FD,$2F,$EF,$90,$64 |
||
6275 | 2F EF 90 64 |
||
6276 | 8400 F86221 9F 70 E5 1C BA .DB $9F,$70,$E5,$1C,$BA,$54,$EE,$05,$40 |
||
6277 | 54 EE 05 40 |
||
6278 | 8401 ; N[1] = 13.43250139086239872172837314 |
||
6279 | 8402 F8622A AA 47 0C 1F 85 .DB $AA,$47,$0C,$1F,$85,$FF,$A0,$76,$20 |
||
6280 | FF A0 76 20 |
||
6281 | 8403 F86233 00 A8 13 94 86 .DB $00,$A8,$13,$94,$86,$EB,$D6,$02,$40 |
||
6282 | EB D6 02 40 |
||
6283 | 8404 ; N[0] = 0.1636161226585754240958355063 |
||
6284 | 8405 F8623C 7B C3 D8 3A B4 .DB $7B,$C3,$D8,$3A,$B4,$CC,$8B,$32,$6D |
||
6285 | CC 8B 32 6D |
||
6286 | 8406 F86245 69 E9 AA 1F FC .DB $69,$E9,$AA,$1F,$FC,$8A,$A7,$FC,$3F |
||
6287 | 8A A7 FC 3F |
||
6288 | 8407 |
||
6289 | 8408 cbrd: ; denominator coefficients (degree 4) |
||
6290 | 8409 ; D[4] = 14.80884093219134573786480845 |
||
6291 | 8410 F8624E 1A 8E 1C AB 2F .DB $1A,$8E,$1C,$AB,$2F,$1C,$FF,$A5,$49 |
||
6292 | 1C FF A5 49 |
||
6293 | 8411 F86257 05 D9 76 30 03 .DB $05,$D9,$76,$30,$03,$F1,$EC,$02,$40 |
||
6294 | F1 EC 02 40 |
||
6295 | 8412 ; D[3] = 151.9714051044435648658557668 |
||
6296 | 8413 F86260 7A 6B 6B 1C FD .DB $7A,$6B,$6B,$1C,$FD,$4E,$DD,$A5,$C7 |
||
6297 | 4E DD A5 C7 |
||
6298 | 8414 F86269 A8 C0 42 01 AE .DB $A8,$C0,$42,$01,$AE,$F8,$97,$06,$40 |
||
6299 | F8 97 06 40 |
||
6300 | 8415 ; D[2] = 168.5254414101568283957668343 |
||
6301 | 8416 F86272 F6 AE F6 BD 0C .DB $F6,$AE,$F6,$BD,$0C,$B1,$C7,$0B,$85 |
||
6302 | B1 C7 0B 85 |
||
6303 | 8417 F8627B 73 96 08 54 83 .DB $73,$96,$08,$54,$83,$86,$A8,$06,$40 |
||
6304 | 86 A8 06 40 |
||
6305 | 8418 ; D[1] = 33.9905941350215598754191872 |
||
6306 | 8419 F86284 9C 0A 30 D2 E7 .DB $9C,$0A,$30,$D2,$E7,$F9,$A1,$D1,$F6 |
||
6307 | F9 A1 D1 F6 |
||
6308 | 8420 F8628D A7 1B 16 4F 5E .DB $A7,$1B,$16,$4F,$5E,$F6,$87,$04,$40 |
||
6309 | F6 87 04 40 |
||
6310 | 8421 ; D[0] = 1 |
||
6311 | 8422 F86296 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
6312 | 00 00 00 00 |
||
6313 | 8423 F8629F 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FF,$3F |
||
6314 | 00 80 FF 3F |
||
6315 | 8424 |
||
6316 | 8425 ;---------------------------------------------------------------------------- |
||
6317 | 8426 ; logarithmic family functions |
||
6318 | 8427 ;---------------------------------------------------------------------------- |
||
6319 | 8428 |
||
6320 | 8429 ; flogep1 - return natural logarithm (base e) of x + 1 |
||
6321 | 8430 ; |
||
6322 | 8431 ; entry: |
||
6323 | 8432 ; fac = x |
||
6324 | 8433 ; |
||
6325 | Tue Jul 17 11:00:18 2018 Page 103 |
||
6326 | |||
6327 | |||
6328 | |||
6329 | |||
6330 | 8434 ; exit: |
||
6331 | 8435 ; fac = loge(1 + x) |
||
6332 | 8436 ; CF = 1 if invalid result (nan, inf) |
||
6333 | 8437 ; |
||
6334 | 8438 ; computation mean time: 75/125ms at 4MHz |
||
6335 | 8439 ; |
||
6336 | 8440 ;------- |
||
6337 | 8441 F862A8 flogep1: |
||
6338 | 8442 ;------- |
||
6339 | 8443 F862A8 20 91 63 jsr cmnlogp1 ; return the logarithm of the fractional part |
||
6340 | 8444 F862AB A5 46 lda scexp ; if exponent M of the argument is zero... |
||
6341 | 8445 F862AD 05 47 ora scexp+1 ; ...we finish here... |
||
6342 | 8446 F862AF D0 0D bne lgem ; ...otherwise we add the loge(M) |
||
6343 | 8447 F862B1 18 clc ; return valid flag |
||
6344 | 8448 F862B2 60 rts |
||
6345 | 8449 |
||
6346 | 8450 ; floge - return natural logarithm (base e) of x |
||
6347 | 8451 ; |
||
6348 | 8452 ; entry: |
||
6349 | 8453 ; fac = x |
||
6350 | 8454 ; |
||
6351 | 8455 ; exit: |
||
6352 | 8456 ; fac = loge(x) |
||
6353 | 8457 ; CF = 1 if invalid result (nan, inf) |
||
6354 | 8458 ; |
||
6355 | 8459 ; computation mean time: 75/125ms at 4MHz |
||
6356 | 8460 ; |
||
6357 | 8461 ;----- |
||
6358 | 8462 F862B3 floge: |
||
6359 | 8463 ;----- |
||
6360 | 8464 F862B3 20 DC 63 jsr cmnlog ; return the logarithm of the fractional part |
||
6361 | 8465 F862B6 A5 46 lda scexp ; if exponent M of the argument is zero... |
||
6362 | 8466 F862B8 05 47 ora scexp+1 ; ...we finish here... |
||
6363 | 8467 F862BA D0 02 bne lgem ; ...otherwise we add the loge(M) |
||
6364 | 8468 F862BC 18 clc ; return valid flag |
||
6365 | 8469 F862BD 60 rts |
||
6366 | 8470 |
||
6367 | 8471 ; lgem - evaluate loge(2)*M and add to logarithm of fractional part |
||
6368 | 8472 ; |
||
6369 | 8473 ; M |
||
6370 | 8474 ; log(x) = loge(f * 2 ) = loge(f) + M * loge(2) |
||
6371 | 8475 ; |
||
6372 | 8476 ;---- |
||
6373 | 8477 F862BE lgem: |
||
6374 | 8478 ;---- |
||
6375 | 8479 F862BE 20 C0 84 jsr mvf_t2 ; tfr2=loge(f) |
||
6376 | 8480 F862C1 A5 46 lda scexp |
||
6377 | 8481 F862C3 A4 47 ldy scexp+1 |
||
6378 | 8482 F862C5 20 5B 4F jsr fldu16 ; convert exponent M to float |
||
6379 | 8483 F862C8 A5 45 lda scsgn |
||
6380 | 8484 F862CA 85 24 sta facsgn ; sign of the exponent M |
||
6381 | 8485 F862CC 20 66 84 jsr mvf_t0 |
||
6382 | 8486 F862CF A9 8D lda #<ln2c1 ; now evaluate M * loge(2)... |
||
6383 | 8487 F862D1 A0 67 ldy #>ln2c1 |
||
6384 | 8488 F862D3 20 D5 49 jsr fcmult |
||
6385 | 8489 F862D6 20 93 84 jsr mvf_t1 ; ...splitted in two |
||
6386 | 8490 F862D9 20 47 85 jsr mvt0_f |
||
6387 | Tue Jul 17 11:00:18 2018 Page 104 |
||
6388 | |||
6389 | |||
6390 | |||
6391 | |||
6392 | 8491 F862DC A9 9F lda #<ln2c2 |
||
6393 | 8492 F862DE A0 67 ldy #>ln2c2 |
||
6394 | 8493 F862E0 20 D5 49 jsr fcmult |
||
6395 | 8494 F862E3 20 28 86 jsr mvt2_a |
||
6396 | 8495 F862E6 20 7D 45 jsr fpadd |
||
6397 | 8496 F862E9 20 FB 85 jsr mvt1_a |
||
6398 | 8497 F862EC 4C 7D 45 jmp fpadd |
||
6399 | 8498 F862EF |
||
6400 | 8499 ; flog10p1 - return decimal logarithm (base 10) of x + 1 |
||
6401 | 8500 ; |
||
6402 | 8501 ; entry: |
||
6403 | 8502 ; fac = x |
||
6404 | 8503 ; |
||
6405 | 8504 ; exit: |
||
6406 | 8505 ; fac = log10(1 + x) |
||
6407 | 8506 ; CF = 1 if invalid result (nan, inf) |
||
6408 | 8507 ; |
||
6409 | 8508 ; computation mean time: 85/140ms at 4MHz |
||
6410 | 8509 ; |
||
6411 | 8510 ;-------- |
||
6412 | 8511 F862EF flog10p1: |
||
6413 | 8512 ;-------- |
||
6414 | 8513 F862EF 20 91 63 jsr cmnlogp1 ; return the loge of the fractional part |
||
6415 | 8514 F862F2 20 3C 63 jsr lg10 ; return the log10 of the fractional part |
||
6416 | 8515 F862F5 A5 46 lda scexp ; if exponent M of the argument is zero... |
||
6417 | 8516 F862F7 05 47 ora scexp+1 ; ...we finish here... |
||
6418 | 8517 F862F9 D0 10 bne lg10m ; ...otherwise we add the loge(M) |
||
6419 | 8518 F862FB 18 clc ; return valid flag |
||
6420 | 8519 F862FC 60 rts |
||
6421 | 8520 |
||
6422 | 8521 ; flog10 - return decimal logarithm (base 10) of x |
||
6423 | 8522 ; |
||
6424 | 8523 ; entry: |
||
6425 | 8524 ; fac = x |
||
6426 | 8525 ; |
||
6427 | 8526 ; exit: |
||
6428 | 8527 ; fac = log10(x) |
||
6429 | 8528 ; CF = 1 if invalid result (nan, inf) |
||
6430 | 8529 ; |
||
6431 | 8530 ; computation mean time: 85/140ms at 4MHz |
||
6432 | 8531 ; |
||
6433 | 8532 ;------ |
||
6434 | 8533 F862FD flog10: |
||
6435 | 8534 ;------ |
||
6436 | 8535 F862FD 20 DC 63 jsr cmnlog ; return the loge of the fractional part |
||
6437 | 8536 F86300 20 3C 63 jsr lg10 ; return the log10 of the fractional part |
||
6438 | 8537 F86303 A5 46 lda scexp ; if exponent M of the argument is zero... |
||
6439 | 8538 F86305 05 47 ora scexp+1 ; ...we finish here... |
||
6440 | 8539 F86307 D0 02 bne lg10m ; ...otherwise we add the loge(M) |
||
6441 | 8540 F86309 18 clc ; return valid flag |
||
6442 | 8541 F8630A 60 rts |
||
6443 | 8542 |
||
6444 | 8543 ; lg10m - evaluate log10(2)*M and add to logarithm of fractional part |
||
6445 | 8544 ; |
||
6446 | 8545 ; M |
||
6447 | 8546 ; log(x) = log(f * 2 ) = log10(f) + M * log10(2) |
||
6448 | 8547 ; |
||
6449 | Tue Jul 17 11:00:18 2018 Page 105 |
||
6450 | |||
6451 | |||
6452 | |||
6453 | |||
6454 | 8548 ;----- |
||
6455 | 8549 F8630B lg10m: |
||
6456 | 8550 ;----- |
||
6457 | 8551 F8630B 20 C0 84 jsr mvf_t2 ; tfr2=log10(f) |
||
6458 | 8552 F8630E A5 46 lda scexp |
||
6459 | 8553 F86310 A4 47 ldy scexp+1 |
||
6460 | 8554 F86312 20 5B 4F jsr fldu16 ; convert exponent M to float |
||
6461 | 8555 F86315 A5 45 lda scsgn |
||
6462 | 8556 F86317 85 24 sta facsgn ; sign of the exponent M |
||
6463 | 8557 F86319 20 66 84 jsr mvf_t0 |
||
6464 | 8558 F8631C A9 C3 lda #<l102a ; now evaluate M * log10(2)... |
||
6465 | 8559 F8631E A0 67 ldy #>l102a |
||
6466 | 8560 F86320 20 D5 49 jsr fcmult |
||
6467 | 8561 F86323 20 93 84 jsr mvf_t1 ; ...splitted in two |
||
6468 | 8562 F86326 20 47 85 jsr mvt0_f |
||
6469 | 8563 F86329 A9 D5 lda #<l102b |
||
6470 | 8564 F8632B A0 67 ldy #>l102b |
||
6471 | 8565 F8632D 20 D5 49 jsr fcmult |
||
6472 | 8566 F86330 20 28 86 jsr mvt2_a |
||
6473 | 8567 F86333 20 7D 45 jsr fpadd |
||
6474 | 8568 F86336 20 FB 85 jsr mvt1_a |
||
6475 | 8569 F86339 4C 7D 45 jmp fpadd |
||
6476 | 8570 |
||
6477 | 8571 ; lg10 - convert the natural logarithm into decimal logarithm |
||
6478 | 8572 ; |
||
6479 | 8573 ; multiplies the log of the fraction by log10(e) |
||
6480 | 8574 ; |
||
6481 | 8575 ;---- |
||
6482 | 8576 F8633C lg10: |
||
6483 | 8577 ;---- |
||
6484 | 8578 F8633C 20 66 84 jsr mvf_t0 ; tfr0=loge(f) |
||
6485 | 8579 F8633F A9 E7 lda #<l10ea |
||
6486 | 8580 F86341 A0 67 ldy #>l10ea |
||
6487 | 8581 F86343 20 D5 49 jsr fcmult |
||
6488 | 8582 F86346 20 93 84 jsr mvf_t1 |
||
6489 | 8583 F86349 20 47 85 jsr mvt0_f |
||
6490 | 8584 F8634C A9 F9 lda #<l10eb |
||
6491 | 8585 F8634E A0 67 ldy #>l10eb |
||
6492 | 8586 F86350 20 D5 49 jsr fcmult |
||
6493 | 8587 F86353 20 FB 85 jsr mvt1_a |
||
6494 | 8588 F86356 4C 7D 45 jmp fpadd |
||
6495 | 8589 |
||
6496 | 8590 ; flog2p1 - return the base 2 logarithm of x + 1 |
||
6497 | 8591 ; |
||
6498 | 8592 ; entry: |
||
6499 | 8593 ; fac = x |
||
6500 | 8594 ; |
||
6501 | 8595 ; exit: |
||
6502 | 8596 ; fac = log2(1 + x) |
||
6503 | 8597 ; CF = 1 if invalid result (nan, inf) |
||
6504 | 8598 ; |
||
6505 | 8599 ; computation mean time: 80/130ms at 4MHz |
||
6506 | 8600 ; |
||
6507 | 8601 ;------- |
||
6508 | 8602 F86359 flog2p1: |
||
6509 | 8603 ;------- |
||
6510 | 8604 F86359 20 91 63 jsr cmnlogp1 ; return the loge of the fractional part |
||
6511 | Tue Jul 17 11:00:18 2018 Page 106 |
||
6512 | |||
6513 | |||
6514 | |||
6515 | |||
6516 | 8605 F8635C A9 0B lda #<lg2e ; return the log2 of the fractional part |
||
6517 | 8606 F8635E A0 68 ldy #>lg2e |
||
6518 | 8607 F86360 20 D5 49 jsr fcmult |
||
6519 | 8608 F86363 A5 46 lda scexp ; if exponent M of the argument is zero... |
||
6520 | 8609 F86365 05 47 ora scexp+1 ; ...we finish here... |
||
6521 | 8610 F86367 D0 14 bne lg2m ; ...otherwise we add M |
||
6522 | 8611 F86369 18 clc ; return valid flag |
||
6523 | 8612 F8636A 60 rts |
||
6524 | 8613 |
||
6525 | 8614 ; flog2 - return the base 2 logarithm of x |
||
6526 | 8615 ; |
||
6527 | 8616 ; entry: |
||
6528 | 8617 ; fac = x |
||
6529 | 8618 ; |
||
6530 | 8619 ; exit: |
||
6531 | 8620 ; fac = log2(x) |
||
6532 | 8621 ; CF = 1 if invalid result (nan, inf) |
||
6533 | 8622 ; |
||
6534 | 8623 ; computation mean time: 80/130ms at 4MHz |
||
6535 | 8624 ; |
||
6536 | 8625 ;----- |
||
6537 | 8626 F8636B flog2: |
||
6538 | 8627 ;----- |
||
6539 | 8628 F8636B 20 DC 63 jsr cmnlog ; return the loge of the fractional part |
||
6540 | 8629 F8636E A9 0B lda #<lg2e ; return the log2 of the fractional part |
||
6541 | 8630 F86370 A0 68 ldy #>lg2e |
||
6542 | 8631 F86372 20 D5 49 jsr fcmult |
||
6543 | 8632 F86375 A5 46 lda scexp ; if exponent M of the argument is zero... |
||
6544 | 8633 F86377 05 47 ora scexp+1 ; ...we finish here... |
||
6545 | 8634 F86379 D0 02 bne lg2m ; ...otherwise we add M |
||
6546 | 8635 F8637B 18 clc ; return valid flag |
||
6547 | 8636 F8637C 60 rts |
||
6548 | 8637 |
||
6549 | 8638 ; lg2m - add exponent M to base 2 logarithm of fractional part |
||
6550 | 8639 ; |
||
6551 | 8640 ; M |
||
6552 | 8641 ; log(x) = log(f * 2 ) = log2(f) + M |
||
6553 | 8642 ; |
||
6554 | 8643 ;---- |
||
6555 | 8644 F8637D lg2m: |
||
6556 | 8645 ;---- |
||
6557 | 8646 F8637D 20 C0 84 jsr mvf_t2 ; tfr2=log2(f) |
||
6558 | 8647 F86380 A5 46 lda scexp |
||
6559 | 8648 F86382 A4 47 ldy scexp+1 |
||
6560 | 8649 F86384 20 5B 4F jsr fldu16 ; convert exponent M to float |
||
6561 | 8650 F86387 A5 45 lda scsgn |
||
6562 | 8651 F86389 85 24 sta facsgn ; sign of the exponent M |
||
6563 | 8652 F8638B 20 28 86 jsr mvt2_a |
||
6564 | 8653 F8638E 4C 7D 45 jmp fpadd |
||
6565 | 8654 F86391 |
||
6566 | 8655 ; cmnlogp1 - common logarithm evaluation |
||
6567 | 8656 ; return the natural logarithm (base e) of the fraction of x + 1 |
||
6568 | 8657 ; |
||
6569 | 8658 ; Note that when evaluate log(x) with x very close to one, cancellation |
||
6570 | 8659 ; caused by computation of x - 1 can give a degrated result (precision loss). |
||
6571 | 8660 ; To avoid this negative effect is better evaluate log(1+x) when argument |
||
6572 | 8661 ; is very closed to one. |
||
6573 | Tue Jul 17 11:00:18 2018 Page 107 |
||
6574 | |||
6575 | |||
6576 | |||
6577 | |||
6578 | 8662 ; |
||
6579 | 8663 ; entry: |
||
6580 | 8664 ; fac = xm1 (xm1 = x - 1) |
||
6581 | 8665 ; |
||
6582 | 8666 ; exit: |
||
6583 | 8667 ; fac = loge(f), f = fraction of xm1 + 1 |
||
6584 | 8668 ; scexp = M = exponent of the argument |
||
6585 | 8669 ; |
||
6586 | 8670 ; where: |
||
6587 | 8671 ; M |
||
6588 | 8672 ; 1 + x = f * 2 sqrt(2)/2 <= f < sqrt(2) |
||
6589 | 8673 ; |
||
6590 | 8674 ; strategy: |
||
6591 | 8675 ; The argument is separated into its exponent and fractional parts. |
||
6592 | 8676 ; If the exponent is between -2 and +2, the logarithm of the fraction, |
||
6593 | 8677 ; setting y = f - 1, is approximated by: |
||
6594 | 8678 ; |
||
6595 | 8679 ; 2 3 |
||
6596 | 8680 ; loge(1+y) = y - 0.5 * y + y * P(y)/Q(y) |
||
6597 | 8681 ; |
||
6598 | 8682 ; otherwise, setting y = 2(f - 1)/(f + 1), is approximated by: |
||
6599 | 8683 ; |
||
6600 | 8684 ; 3 2 |
||
6601 | 8685 ; loge(f) = y + y * R(z)/S(z), where z = y |
||
6602 | 8686 ; |
||
6603 | 8687 ;-------- |
||
6604 | 8688 F86391 cmnlogp1: |
||
6605 | 8689 ;-------- |
||
6606 | 8690 F86391 24 25 bit facst |
||
6607 | 8691 F86393 30 1C bmi ?nv ; invalid xm1 |
||
6608 | 8692 F86395 18 clc |
||
6609 | 8693 F86396 70 23 bvs ?ex ; xm1=0 so return 0 |
||
6610 | 8694 F86398 20 93 84 jsr mvf_t1 ; tfr1=xm1 |
||
6611 | 8695 F8639B 20 6C 45 jsr faddone ; x=1+xm1 |
||
6612 | 8696 F8639E B0 1B bcs ?ex ; x=+inf so return +inf |
||
6613 | 8697 F863A0 24 24 bit facsgn |
||
6614 | 8698 F863A2 30 13 bmi ?nan ; x<0 so return -nan |
||
6615 | 8699 F863A4 24 25 bit facst |
||
6616 | 8700 F863A6 50 16 bvc ?ok ; ok, x > 0 |
||
6617 | 8701 F863A8 20 7D 4E jsr fldinf ; x=0 so return -inf |
||
6618 | 8702 F863AB A9 FF lda #$FF |
||
6619 | 8703 F863AD 85 24 sta facsgn |
||
6620 | 8704 F863AF 80 09 bra ?er |
||
6621 | 8705 F863B1 70 07 ?nv: bvs ?er ; xm1=nan so return nan |
||
6622 | 8706 F863B3 24 24 bit facsgn |
||
6623 | 8707 F863B5 10 03 bpl ?er ; xm1=+inf so return +inf |
||
6624 | 8708 F863B7 20 74 4E ?nan: jsr fldnan ; xm1=-inf so return -nan |
||
6625 | 8709 F863BA 38 ?er: sec ; invalid fac |
||
6626 | 8710 F863BB 68 ?ex: pla ; skip return address |
||
6627 | 8711 F863BC 68 pla |
||
6628 | 8712 F863BD 60 rts |
||
6629 | 8713 F863BE 20 A6 64 ?ok: jsr logscl ; argument reduction & exponent extraction |
||
6630 | 8714 F863C1 90 08 bcc ?tiny ; |M| < 3 |
||
6631 | 8715 F863C3 20 66 84 jsr mvf_t0 ; tfr0=x |
||
6632 | 8716 F863C6 20 71 45 jsr fsubone ; x-1 |
||
6633 | 8717 F863C9 80 40 bra lge ; evaluation for |M| > 2 |
||
6634 | 8718 F863CB A5 46 ?tiny: lda scexp ; if M=0... |
||
6635 | Tue Jul 17 11:00:18 2018 Page 108 |
||
6636 | |||
6637 | |||
6638 | |||
6639 | |||
6640 | 8719 F863CD 05 47 ora scexp+1 |
||
6641 | 8720 F863CF F0 06 beq ?xm1 ; ...use argument xm1 |
||
6642 | 8721 F863D1 20 71 45 jsr fsubone ; ...otherwise use x - 1 |
||
6643 | 8722 F863D4 4C 5B 64 jmp lgep1 |
||
6644 | 8723 F863D7 20 74 85 ?xm1: jsr mvt1_f ; use xm1 |
||
6645 | 8724 F863DA 80 7F bra lgep1 |
||
6646 | 8725 |
||
6647 | 8726 ; cmnlog - common logarithm evaluation |
||
6648 | 8727 ; return the natural logarithm (base e) of the fraction of the argument |
||
6649 | 8728 ; |
||
6650 | 8729 ; entry: |
||
6651 | 8730 ; fac = x |
||
6652 | 8731 ; |
||
6653 | 8732 ; exit: |
||
6654 | 8733 ; fac = loge(f) |
||
6655 | 8734 ; scexp = M = exponent of the argument |
||
6656 | 8735 ; |
||
6657 | 8736 ; where: |
||
6658 | 8737 ; M |
||
6659 | 8738 ; x = f * 2 sqrt(2)/2 <= f < sqrt(2) |
||
6660 | 8739 ; |
||
6661 | 8740 ; strategy: |
||
6662 | 8741 ; The argument is separated into its exponent and fractional parts. |
||
6663 | 8742 ; If the exponent is between -2 and +2, the logarithm of the fraction, |
||
6664 | 8743 ; setting y = f - 1, is approximated by: |
||
6665 | 8744 ; |
||
6666 | 8745 ; 2 3 |
||
6667 | 8746 ; loge(1+y) = y - 0.5 * y + y * P(y)/Q(y) |
||
6668 | 8747 ; |
||
6669 | 8748 ; otherwise, setting y = 2(f - 1)/(f + 1), is approximated by: |
||
6670 | 8749 ; |
||
6671 | 8750 ; 3 2 |
||
6672 | 8751 ; loge(f) = y + y * R(z)/S(z), where z = y |
||
6673 | 8752 ; |
||
6674 | 8753 ;------ |
||
6675 | 8754 F863DC cmnlog: |
||
6676 | 8755 ;------ |
||
6677 | 8756 F863DC 24 25 bit facst ; fac must be valid and > 0 |
||
6678 | 8757 F863DE 10 08 bpl ?ckz |
||
6679 | 8758 F863E0 70 18 bvs ?er ; fac=nan so return nan |
||
6680 | 8759 F863E2 24 24 bit facsgn ; if fac=+inf... |
||
6681 | 8760 F863E4 10 14 bpl ?er ; ...return +inf... |
||
6682 | 8761 F863E6 30 06 bmi ?nan ; ...else return nan |
||
6683 | 8762 F863E8 70 09 ?ckz: bvs ?inf ; if fac=0 return -inf |
||
6684 | 8763 F863EA 24 24 bit facsgn ; if fac>0 go to evaluation... |
||
6685 | 8764 F863EC 10 10 bpl ?go ; ...else return nan |
||
6686 | 8765 F863EE 20 74 4E ?nan: jsr fldnan ; return nan |
||
6687 | 8766 F863F1 80 07 bra ?er |
||
6688 | 8767 F863F3 A9 FF ?inf: lda #$FF ; return -inf |
||
6689 | 8768 F863F5 85 24 sta facsgn |
||
6690 | 8769 F863F7 20 7D 4E jsr fldinf |
||
6691 | 8770 F863FA 68 ?er: pla ; skip return address |
||
6692 | 8771 F863FB 68 pla |
||
6693 | 8772 F863FC 38 sec ; return invalid result |
||
6694 | 8773 F863FD 60 rts |
||
6695 | 8774 F863FE 20 A6 64 ?go: jsr logscl ; argument reduction & exponent extraction |
||
6696 | 8775 F86401 08 php ; save carry (cf=0 if |exponent| < 3) |
||
6697 | Tue Jul 17 11:00:18 2018 Page 109 |
||
6698 | |||
6699 | |||
6700 | |||
6701 | |||
6702 | 8776 F86402 20 66 84 jsr mvf_t0 ; tfr0=f |
||
6703 | 8777 F86405 20 71 45 jsr fsubone ; fac=y=f-1 |
||
6704 | 8778 F86408 28 plp |
||
6705 | 8779 F86409 90 50 bcc lgep1 ; if |exponent| < 3 evaluate for (1+f) |
||
6706 | 8780 |
||
6707 | 8781 ; lge - approximate loge(f) |
||
6708 | 8782 ; |
||
6709 | 8783 ; 3 2 |
||
6710 | 8784 ; loge(f) = y + y * R(z)/S(z), where z = y |
||
6711 | 8785 ; |
||
6712 | 8786 ; y = 2(f - 1)/(f + 1) |
||
6713 | 8787 ; |
||
6714 | 8788 ;--- |
||
6715 | 8789 F8640B lge: |
||
6716 | 8790 ;--- |
||
6717 | 8791 F8640B 20 93 84 jsr mvf_t1 ; tfr1=y=f-1 |
||
6718 | 8792 F8640E 20 47 85 jsr mvt0_f ; fac=f |
||
6719 | 8793 F86411 20 6C 45 jsr faddone ; fac=f+1 |
||
6720 | 8794 F86414 20 FB 85 jsr mvt1_a ; arg=f-1 |
||
6721 | 8795 F86417 20 10 4A jsr fpdiv ; (f-1)/(f+1) |
||
6722 | 8796 F8641A ACC16 |
||
6723 | 8797 F8641A C2 20 rep #PMFLAG |
||
6724 | 8798 .LONGA on |
||
6725 | 8799 .MNLIST |
||
6726 | 8800 F8641C A5 22 lda facexp |
||
6727 | 8801 F8641E F0 03 beq ?isz ; y=0 |
||
6728 | 8802 F86420 1A inc a ; note that here y is always normal |
||
6729 | 8803 F86421 E6 22 inc facexp ; y=2*(x-1)/(x+1) |
||
6730 | 8804 F86423 ?isz: ACC08 |
||
6731 | 8805 F86423 E2 20 sep #PMFLAG |
||
6732 | 8806 .LONGA off |
||
6733 | 8807 .MNLIST |
||
6734 | 8808 F86425 20 93 84 jsr mvf_t1 ; tfr1=y |
||
6735 | 8809 F86428 20 CC 49 jsr fsquare ; z=y*y |
||
6736 | 8810 F8642B 20 66 84 jsr mvf_t0 ; tfr0=z |
||
6737 | 8811 F8642E A9 F3 lda #<clnr |
||
6738 | 8812 F86430 A0 64 ldy #>clnr |
||
6739 | 8813 F86432 A2 05 ldx #5 |
||
6740 | 8814 F86434 20 1C 87 jsr peval ; evaluate R(z) |
||
6741 | 8815 F86437 20 C0 84 jsr mvf_t2 ; tfr2=R(z) |
||
6742 | 8816 F8643A A9 5F lda #<clns |
||
6743 | 8817 F8643C A0 65 ldy #>clns |
||
6744 | 8818 F8643E A2 05 ldx #5 |
||
6745 | 8819 F86440 20 3A 87 jsr pevalp1 ; evaluate S(z) |
||
6746 | 8820 F86443 20 28 86 jsr mvt2_a ; arg=R(z) |
||
6747 | 8821 F86446 20 10 4A jsr fpdiv ; R(z)/S(z) |
||
6748 | 8822 F86449 20 CE 85 jsr mvt0_a ; arg=z |
||
6749 | 8823 F8644C 20 DD 49 jsr fpmult ; z*R(z)/S(z) |
||
6750 | 8824 F8644F 20 FB 85 jsr mvt1_a ; arg=y |
||
6751 | 8825 F86452 20 DD 49 jsr fpmult ; y*z*R(z)/S(z) |
||
6752 | 8826 F86455 20 FB 85 jsr mvt1_a ; arg=y |
||
6753 | 8827 F86458 4C 7D 45 jmp fpadd ; loge(f)=y+y*z*R(z)/S(z) |
||
6754 | 8828 F8645B |
||
6755 | 8829 ; lgep1 - approximate loge(1+y) |
||
6756 | 8830 ; |
||
6757 | 8831 ; 2 3 |
||
6758 | 8832 ; loge(1+y) = y - 0.5 * y + y * P(y)/Q(y) |
||
6759 | Tue Jul 17 11:00:18 2018 Page 110 |
||
6760 | |||
6761 | |||
6762 | |||
6763 | |||
6764 | 8833 ; |
||
6765 | 8834 ; y = f - 1 |
||
6766 | 8835 ; |
||
6767 | 8836 ;----- |
||
6768 | 8837 F8645B lgep1: |
||
6769 | 8838 ;----- |
||
6770 | 8839 F8645B 20 66 84 jsr mvf_t0 ; tfr0=y=x-1 |
||
6771 | 8840 F8645E 20 CC 49 jsr fsquare ; z=y*y |
||
6772 | 8841 F86461 20 93 84 jsr mvf_t1 ; tfr1=z |
||
6773 | 8842 F86464 A9 CB lda #<clnp |
||
6774 | 8843 F86466 A0 65 ldy #>clnp |
||
6775 | 8844 F86468 A2 0C ldx #12 |
||
6776 | 8845 F8646A 20 1C 87 jsr peval ; evaluate P(y) |
||
6777 | 8846 F8646D 20 C0 84 jsr mvf_t2 ; tfr2=P(y) |
||
6778 | 8847 F86470 A9 B5 lda #<clnq |
||
6779 | 8848 F86472 A0 66 ldy #>clnq |
||
6780 | 8849 F86474 A2 0B ldx #11 |
||
6781 | 8850 F86476 20 3A 87 jsr pevalp1 ; evaluate Q(y) |
||
6782 | 8851 F86479 20 28 86 jsr mvt2_a ; P(y) |
||
6783 | 8852 F8647C 20 10 4A jsr fpdiv ; P(y)/Q(y) |
||
6784 | 8853 F8647F 20 FB 85 jsr mvt1_a ; z |
||
6785 | 8854 F86482 20 DD 49 jsr fpmult ; z*P(y)/Q(y) |
||
6786 | 8855 F86485 20 CE 85 jsr mvt0_a ; y |
||
6787 | 8856 F86488 20 DD 49 jsr fpmult ; y*z*P(y)/Q(y) |
||
6788 | 8857 F8648B 20 FB 85 jsr mvt1_a ; z |
||
6789 | 8858 F8648E ACC16 |
||
6790 | 8859 F8648E C2 20 rep #PMFLAG |
||
6791 | 8860 .LONGA on |
||
6792 | 8861 .MNLIST |
||
6793 | 8862 F86490 A5 3A lda argexp |
||
6794 | 8863 F86492 F0 03 beq ?isz ; z=0 |
||
6795 | 8864 F86494 3A dec a |
||
6796 | 8865 F86495 85 3A sta argexp ; z/2 |
||
6797 | 8866 F86497 ?isz: ACC08 |
||
6798 | 8867 F86497 E2 20 sep #PMFLAG |
||
6799 | 8868 .LONGA off |
||
6800 | 8869 .MNLIST |
||
6801 | 8870 F86499 A9 FF lda #$FF |
||
6802 | 8871 F8649B 85 3C sta argsgn ; arg=-z/2 |
||
6803 | 8872 F8649D 20 7D 45 jsr fpadd ; y*z*(P(y)/Q(y)) - z/2 |
||
6804 | 8873 F864A0 20 CE 85 jsr mvt0_a ; arg=y |
||
6805 | 8874 F864A3 4C 7D 45 jmp fpadd ; loge(1+y)=y-z/2+y*z*(P(y)/Q(y)) |
||
6806 | 8875 |
||
6807 | 8876 ; logscl - argument reduction for logarithm evaluation |
||
6808 | 8877 ; |
||
6809 | 8878 ; entry: |
||
6810 | 8879 ; fac = x, valid float |
||
6811 | 8880 ; |
||
6812 | 8881 ; exit: |
||
6813 | 8882 ; fac = f, reduced argument |
||
6814 | 8883 ; scexp = |M|, exponent |
||
6815 | 8884 ; scsgn = sign of M |
||
6816 | 8885 ; CF = 0 if |M| < 3 |
||
6817 | 8886 ; |
||
6818 | 8887 ; M |
||
6819 | 8888 ; x = f * 2 sqrt(2)/2 <= f < sqrt(2) |
||
6820 | 8889 ; |
||
6821 | Tue Jul 17 11:00:18 2018 Page 111 |
||
6822 | |||
6823 | |||
6824 | |||
6825 | |||
6826 | 8890 ;------ |
||
6827 | 8891 F864A6 logscl: |
||
6828 | 8892 ;------ |
||
6829 | 8893 F864A6 20 6E 48 jsr frexp ; now 0.5 <= fac < 1 |
||
6830 | 8894 F864A9 A9 E1 lda #<rsqrt2h ; now compare fac vs. 1/sqrt(2) |
||
6831 | 8895 F864AB A0 64 ldy #>rsqrt2h |
||
6832 | 8896 F864AD 20 5E 87 jsr fccmp |
||
6833 | 8897 F864B0 ACC16 |
||
6834 | 8898 F864B0 C2 20 rep #PMFLAG |
||
6835 | 8899 .LONGA on |
||
6836 | 8900 .MNLIST |
||
6837 | 8901 F864B2 F0 06 beq ?gte ; fac=1/sqrt(2) |
||
6838 | 8902 F864B4 10 04 bpl ?gte ; fac>1/sqrt(2) |
||
6839 | 8903 F864B6 E6 22 inc facexp ; fac=fac*2, now 1 <= fac < sqrt(2) |
||
6840 | 8904 F864B8 C6 46 dec scexp ; decrement exponent |
||
6841 | 8905 F864BA A2 00 ?gte: ldx #0 ; assume positive scaling exponent |
||
6842 | 8906 F864BC A5 46 lda scexp |
||
6843 | 8907 F864BE 10 07 bpl ?mp ; positive or null scaling |
||
6844 | 8908 F864C0 CA dex ; negative scaling |
||
6845 | 8909 F864C1 49 FF FF eor #$FFFF ; complement |
||
6846 | 8910 F864C4 1A inc a |
||
6847 | 8911 F864C5 85 46 sta scexp ; unsigned scaling exponent |
||
6848 | 8912 F864C7 86 45 ?mp: stx scsgn ; sign of scaling exponent |
||
6849 | 8913 F864C9 C9 03 00 cmp #3 ; return CF = 0 if |exponent| < 3 |
||
6850 | 8914 F864CC ACC08 |
||
6851 | 8915 F864CC E2 20 sep #PMFLAG |
||
6852 | 8916 .LONGA off |
||
6853 | 8917 .MNLIST |
||
6854 | 8918 F864CE 60 rts |
||
6855 | 8919 |
||
6856 | 8920 ; unrounded 1/sqrt(2) - $B504F333F9DE6484597D89B3754ABE9FP3FFE |
||
6857 | 8921 F864CF 9F BE 4A 75 B3 sqrth: .DB $9F,$BE,$4A,$75,$B3,$89,$7D,$59,$84 |
||
6858 | 89 7D 59 84 |
||
6859 | 8922 F864D8 64 DE F9 33 F3 .DB $64,$DE,$F9,$33,$F3,$04,$B5,$FE,$3F |
||
6860 | 04 B5 FE 3F |
||
6861 | 8923 |
||
6862 | 8924 ; 1/sqrt(2) rounded to 113 bits |
||
6863 | 8925 F864E1 rsqrt2h: |
||
6864 | 8926 F864E1 00 80 4A 75 B3 .DB $00,$80,$4A,$75,$B3,$89,$7D,$59,$84 |
||
6865 | 89 7D 59 84 |
||
6866 | 8927 F864EA 64 DE F9 33 F3 .DB $64,$DE,$F9,$33,$F3,$04,$B5,$FE,$3F |
||
6867 | 04 B5 FE 3F |
||
6868 | 8928 |
||
6869 | 8929 ; coefficients for log(x), rational function R()/S() |
||
6870 | 8930 F864F3 clnr: |
||
6871 | 8931 ; R[5] = -8.828896441624934385266096344596648080902E-1 |
||
6872 | 8932 F864F3 8E 15 84 6B 67 .DB $8E,$15,$84,$6B,$67,$72,$AA,$CE,$23 |
||
6873 | 72 AA CE 23 |
||
6874 | 8933 F864FC 34 AD A7 43 0E .DB $34,$AD,$A7,$43,$0E,$05,$E2,$FE,$BF |
||
6875 | 05 E2 FE BF |
||
6876 | 8934 ; R[4] = 8.057002716646055371965756206836056074715E1 |
||
6877 | 8935 F86505 14 20 14 FB 86 .DB $14,$20,$14,$FB,$86,$D1,$08,$AB,$2D |
||
6878 | D1 08 AB 2D |
||
6879 | 8936 F8650E 2B 8F CB 99 DA .DB $2B,$8F,$CB,$99,$DA,$23,$A1,$05,$40 |
||
6880 | 23 A1 05 40 |
||
6881 | 8937 ; R[3] = -2.024301798136027039250415126250455056397E3 |
||
6882 | 8938 F86517 BC EF D7 01 BF .DB $BC,$EF,$D7,$01,$BF,$A2,$EE,$76,$48 |
||
6883 | Tue Jul 17 11:00:18 2018 Page 112 |
||
6884 | |||
6885 | |||
6886 | |||
6887 | |||
6888 | A2 EE 76 48 |
||
6889 | 8939 F86520 5B 87 90 54 A8 .DB $5B,$87,$90,$54,$A8,$09,$FD,$09,$C0 |
||
6890 | 09 FD 09 C0 |
||
6891 | 8940 ; R[2] = 2.048819892795278657810231591630928516206E4 |
||
6892 | 8941 F86529 1C CC E3 20 15 .DB $1C,$CC,$E3,$20,$15,$6E,$6A,$18,$09 |
||
6893 | 6E 6A 18 09 |
||
6894 | 8942 F86532 F5 76 E2 D9 65 .DB $F5,$76,$E2,$D9,$65,$10,$A0,$0D,$40 |
||
6895 | 10 A0 0D 40 |
||
6896 | 8943 ; R[1] = -8.977257995689735303686582344659576526998E4 |
||
6897 | 8944 F8653B 37 36 95 61 03 .DB $37,$36,$95,$61,$03,$74,$9D,$2E,$47 |
||
6898 | 74 9D 2E 47 |
||
6899 | 8945 F86544 9C 11 07 3C 4A .DB $9C,$11,$07,$3C,$4A,$56,$AF,$0F,$C0 |
||
6900 | 56 AF 0F C0 |
||
6901 | 8946 ; R[0] = 1.418134209872192732479751274970992665513E5 |
||
6902 | 8947 F8654D A8 4A 7E 5A 28 .DB $A8,$4A,$7E,$5A,$28,$99,$7D,$53,$01 |
||
6903 | 99 7D 53 01 |
||
6904 | 8948 F86556 B4 60 74 F1 5A .DB $B4,$60,$74,$F1,$5A,$7D,$8A,$10,$40 |
||
6905 | 7D 8A 10 40 |
||
6906 | 8949 |
||
6907 | 8950 F8655F clns: |
||
6908 | 8951 ; S[5] = -1.186359407982897997337150403816839480438E2 |
||
6909 | 8952 F8655F 3A 6E 31 96 EA .DB $3A,$6E,$31,$96,$EA,$56,$BE,$E6,$BA |
||
6910 | 56 BE E6 BA |
||
6911 | 8953 F86568 92 B1 45 08 9A .DB $92,$B1,$45,$08,$9A,$45,$ED,$05,$C0 |
||
6912 | 45 ED 05 C0 |
||
6913 | 8954 ; S[4] = 3.998526750980007367835804959888064681098E3 |
||
6914 | 8955 F86571 C4 2A 76 05 E9 .DB $C4,$2A,$76,$05,$E9,$F4,$A8,$5F,$11 |
||
6915 | F4 A8 5F 11 |
||
6916 | 8956 F8657A 48 84 6F 92 6D .DB $48,$84,$6F,$92,$6D,$E8,$F9,$0A,$40 |
||
6917 | E8 F9 0A 40 |
||
6918 | 8957 ; S[3] = -5.748542087379434595104154610899551484314E4 |
||
6919 | 8958 F86583 36 79 3E 93 5D .DB $36,$79,$3E,$93,$5D,$19,$08,$FE,$93 |
||
6920 | 19 08 FE 93 |
||
6921 | 8959 F8658C 75 8E 62 BE 6B .DB $75,$8E,$62,$BE,$6B,$8D,$E0,$0E,$C0 |
||
6922 | 8D E0 0E C0 |
||
6923 | 8960 ; S[2] = 4.001557694070773974936904547424676279307E5 |
||
6924 | 8961 F86595 36 7C 5E 8E 90 .DB $36,$7C,$5E,$8E,$90,$52,$EB,$2D,$76 |
||
6925 | 52 EB 2D 76 |
||
6926 | 8962 F8659E 57 97 FB 9E 78 .DB $57,$97,$FB,$9E,$78,$63,$C3,$11,$40 |
||
6927 | 63 C3 11 40 |
||
6928 | 8963 ; S[1] = -1.332535117259762928288745111081235577029E6 |
||
6929 | 8964 F865A7 E8 C3 BB 00 81 .DB $E8,$C3,$BB,$00,$81,$59,$F2,$48,$4F |
||
6930 | 59 F2 48 4F |
||
6931 | 8965 F865B0 F7 E2 25 F0 B8 .DB $F7,$E2,$25,$F0,$B8,$A9,$A2,$13,$C0 |
||
6932 | A9 A2 13 C0 |
||
6933 | 8966 ; S[0] = 1.701761051846631278975701529965589676574E6 |
||
6934 | 8967 F865B9 68 05 98 8B BC .DB $68,$05,$98,$8B,$BC,$65,$3C,$FD,$01 |
||
6935 | 65 3C FD 01 |
||
6936 | 8968 F865C2 0E 91 2E 6A 08 .DB $0E,$91,$2E,$6A,$08,$BC,$CF,$13,$40 |
||
6937 | BC CF 13 40 |
||
6938 | 8969 |
||
6939 | 8970 ; coefficients for log(1+x), rational function P()/Q() |
||
6940 | 8971 F865CB clnp: |
||
6941 | 8972 ; P[12] = 1.538612243596254322971797716843006400388E-6 |
||
6942 | 8973 F865CB 2A C3 7D B0 42 .DB $2A,$C3,$7D,$B0,$42,$00,$91,$A4,$A1 |
||
6943 | 00 91 A4 A1 |
||
6944 | 8974 F865D4 4A C1 76 6B 50 .DB $4A,$C1,$76,$6B,$50,$82,$CE,$EB,$3F |
||
6945 | Tue Jul 17 11:00:18 2018 Page 113 |
||
6946 | |||
6947 | |||
6948 | |||
6949 | |||
6950 | 82 CE EB 3F |
||
6951 | 8975 ; P[11] = 4.998469661968096229986658302195402690910E-1 |
||
6952 | 8976 F865DD 6C FE CF 17 46 .DB $6C,$FE,$CF,$17,$46,$8D,$F4,$5A,$4E |
||
6953 | 8D F4 5A 4E |
||
6954 | 8977 F865E6 17 E6 A3 09 F1 .DB $17,$E6,$A3,$09,$F1,$EB,$FF,$FD,$3F |
||
6955 | EB FF FD 3F |
||
6956 | 8978 ; P[10] = 2.321125933898420063925789532045674660756E1 |
||
6957 | 8979 F865EF DD 55 73 C9 52 .DB $DD,$55,$73,$C9,$52,$31,$F5,$21,$A6 |
||
6958 | 31 F5 21 A6 |
||
6959 | 8980 F865F8 33 4B 7F BC A8 .DB $33,$4B,$7F,$BC,$A8,$B0,$B9,$03,$40 |
||
6960 | B0 B9 03 40 |
||
6961 | 8981 ; P[09] = 4.114517881637811823002128927449878962058E2 |
||
6962 | 8982 F86601 62 F5 AF 82 FE .DB $62,$F5,$AF,$82,$FE,$EA,$8A,$CB,$29 |
||
6963 | EA 8A CB 29 |
||
6964 | 8983 F8660A 7D 14 CE 31 D4 .DB $7D,$14,$CE,$31,$D4,$B9,$CD,$07,$40 |
||
6965 | B9 CD 07 40 |
||
6966 | 8984 ; P[08] = 3.824952356185897735160588078446136783779E3 |
||
6967 | 8985 F86613 98 15 15 FD 5B .DB $98,$15,$15,$FD,$5B,$9C,$06,$E3,$62 |
||
6968 | 9C 06 E3 62 |
||
6969 | 8986 F8661C 2F 09 D7 D9 3C .DB $2F,$09,$D7,$D9,$3C,$0F,$EF,$0A,$40 |
||
6970 | 0F EF 0A 40 |
||
6971 | 8987 ; P[07] = 2.128857716871515081352991964243375186031E4 |
||
6972 | 8988 F86625 61 2D 76 77 32 .DB $61,$2D,$76,$77,$32,$6D,$65,$F8,$B4 |
||
6973 | 6D 65 F8 B4 |
||
6974 | 8989 F8662E B1 67 A8 82 27 .DB $B1,$67,$A8,$82,$27,$51,$A6,$0D,$40 |
||
6975 | 51 A6 0D 40 |
||
6976 | 8990 ; P[06] = 7.594356839258970405033155585486712125861E4 |
||
6977 | 8991 F86637 F5 CF 31 FA 60 .DB $F5,$CF,$31,$FA,$60,$22,$5B,$82,$A8 |
||
6978 | 22 5B 82 A8 |
||
6979 | 8992 F86640 08 A0 16 C1 C8 .DB $08,$A0,$16,$C1,$C8,$53,$94,$0F,$40 |
||
6980 | 53 94 0F 40 |
||
6981 | 8993 ; P[05] = 1.797628303815655343403735250238293741397E5 |
||
6982 | 8994 F86649 D2 08 FC D7 90 .DB $D2,$08,$FC,$D7,$90,$40,$A4,$21,$F6 |
||
6983 | 40 A4 21 F6 |
||
6984 | 8995 F86652 CA B8 F8 24 B5 .DB $CA,$B8,$F8,$24,$B5,$8C,$AF,$10,$40 |
||
6985 | 8C AF 10 40 |
||
6986 | 8996 ; P[04] = 2.854829159639697837788887080758954924001E5 |
||
6987 | 8997 F8665B 98 EA 19 A8 D5 .DB $98,$EA,$19,$A8,$D5,$B8,$B8,$25,$24 |
||
6988 | B8 B8 25 24 |
||
6989 | 8998 F86664 D1 AB 93 4F 5D .DB $D1,$AB,$93,$4F,$5D,$65,$8B,$11,$40 |
||
6990 | 65 8B 11 40 |
||
6991 | 8999 ; P[03] = 3.007007295140399532324943111654767187848E5 |
||
6992 | 9000 F8666D 96 EF 0E 45 35 .DB $96,$EF,$0E,$45,$35,$32,$FC,$95,$4D |
||
6993 | 32 FC 95 4D |
||
6994 | 9001 F86676 F2 D3 2D 58 97 .DB $F2,$D3,$2D,$58,$97,$D3,$92,$11,$40 |
||
6995 | D3 92 11 40 |
||
6996 | 9002 ; P[02] = 2.014652742082537582487669938141683759923E5 |
||
6997 | 9003 F8667F 5E E2 69 C5 8D .DB $5E,$E2,$69,$C5,$8D,$BE,$39,$2E,$D6 |
||
6998 | BE 39 2E D6 |
||
6999 | 9004 F86688 8B C6 A0 8C 51 .DB $8B,$C6,$A0,$8C,$51,$BE,$C4,$10,$40 |
||
7000 | BE C4 10 40 |
||
7001 | 9005 ; P[01] = 7.771154681358524243729929227226708890930E4 |
||
7002 | 9006 F86691 AE E9 03 6A 3B .DB $AE,$E9,$03,$6A,$3B,$ED,$92,$AC,$F8 |
||
7003 | ED 92 AC F8 |
||
7004 | 9007 F8669A CF D0 FC FD C5 .DB $CF,$D0,$FC,$FD,$C5,$C7,$97,$0F,$40 |
||
7005 | C7 97 0F 40 |
||
7006 | 9008 ; P[00] = 1.313572404063446165910279910527789794488E4 |
||
7007 | Tue Jul 17 11:00:18 2018 Page 114 |
||
7008 | |||
7009 | |||
7010 | |||
7011 | |||
7012 | 9009 F866A3 35 07 BE 83 BC .DB $35,$07,$BE,$83,$BC,$26,$2A,$5C,$A0 |
||
7013 | 26 2A 5C A0 |
||
7014 | 9010 F866AC F3 77 E8 6A E5 .DB $F3,$77,$E8,$6A,$E5,$3E,$CD,$0C,$40 |
||
7015 | 3E CD 0C 40 |
||
7016 | 9011 F866B5 |
||
7017 | 9012 F866B5 clnq: |
||
7018 | 9013 ; Q[11] = 4.839208193348159620282142911143429644326E1 |
||
7019 | 9014 F866B5 19 97 D2 BF 46 .DB $19,$97,$D2,$BF,$46,$56,$ED,$89,$10 |
||
7020 | 56 ED 89 10 |
||
7021 | 9015 F866BE A5 9F 26 ED 7D .DB $A5,$9F,$26,$ED,$7D,$91,$C1,$04,$40 |
||
7022 | 91 C1 04 40 |
||
7023 | 9016 ; Q[10] = 9.104928120962988414618126155557301584078E2 |
||
7024 | 9017 F866C7 C0 4E B7 7A BC .DB $C0,$4E,$B7,$7A,$BC,$63,$F1,$97,$7D |
||
7025 | 63 F1 97 7D |
||
7026 | 9018 F866D0 4F 2B BF 3B 8A .DB $4F,$2B,$BF,$3B,$8A,$9F,$E3,$08,$40 |
||
7027 | 9F E3 08 40 |
||
7028 | 9019 ; Q[09] = 9.147150349299596453976674231612674085381E3 |
||
7029 | 9020 F866D9 E1 52 82 D3 69 .DB $E1,$52,$82,$D3,$69,$1A,$6A,$4C,$1D |
||
7030 | 1A 6A 4C 1D |
||
7031 | 9021 F866E2 F9 B2 2A F5 99 .DB $F9,$B2,$2A,$F5,$99,$EC,$8E,$0C,$40 |
||
7032 | EC 8E 0C 40 |
||
7033 | 9022 ; Q[08] = 5.605842085972455027590989944010492125825E4 |
||
7034 | 9023 F866EB B8 65 30 7A BB .DB $B8,$65,$30,$7A,$BB,$1D,$CD,$02,$A2 |
||
7035 | 1D CD 02 A2 |
||
7036 | 9024 F866F4 25 81 76 BD 6B .DB $25,$81,$76,$BD,$6B,$FA,$DA,$0E,$40 |
||
7037 | FA DA 0E 40 |
||
7038 | 9025 ; Q[07] = 2.248234257620569139969141618556349415120E5 |
||
7039 | 9026 F866FD A2 CA 5D F8 7F .DB $A2,$CA,$5D,$F8,$7F,$A4,$A6,$11,$B1 |
||
7040 | A4 A6 11 B1 |
||
7041 | 9027 F86706 94 7F AF 3F DB .DB $94,$7F,$AF,$3F,$DB,$8D,$DB,$10,$40 |
||
7042 | 8D DB 10 40 |
||
7043 | 9028 ; Q[06] = 6.132189329546557743179177159925690841200E5 |
||
7044 | 9029 F8670F 7A 44 71 27 79 .DB $7A,$44,$71,$27,$79,$DE,$89,$E3,$39 |
||
7045 | DE 89 E3 39 |
||
7046 | 9030 F86718 73 DC 61 ED 2E .DB $73,$DC,$61,$ED,$2E,$B6,$95,$12,$40 |
||
7047 | B6 95 12 40 |
||
7048 | 9031 ; Q[05] = 1.158019977462989115839826904108208787040E6 |
||
7049 | 9032 F86721 2A BB 38 BE F1 .DB $2A,$BB,$38,$BE,$F1,$46,$B7,$69,$6C |
||
7050 | 46 B7 69 6C |
||
7051 | 9033 F8672A 9A 1D D8 D1 1F .DB $9A,$1D,$D8,$D1,$1F,$5C,$8D,$13,$40 |
||
7052 | 5C 8D 13 40 |
||
7053 | 9034 ; Q[04] = 1.514882452993549494932585972882995548426E6 |
||
7054 | 9035 F86733 C0 3A 8A D9 4A .DB $C0,$3A,$8A,$D9,$4A,$87,$5D,$9C,$09 |
||
7055 | 87 5D 9C 09 |
||
7056 | 9036 F8673C 03 15 BB 9F 13 .DB $03,$15,$BB,$9F,$13,$EC,$B8,$13,$40 |
||
7057 | EC B8 13 40 |
||
7058 | 9037 ; Q[03] = 1.347518538384329112529391120390701166528E6 |
||
7059 | 9038 F86745 70 CA B9 8E 83 .DB $70,$CA,$B9,$8E,$83,$73,$EC,$DA,$BC |
||
7060 | 73 EC DA BC |
||
7061 | 9039 F8674E 71 71 9C 4E F4 .DB $71,$71,$9C,$4E,$F4,$7D,$A4,$13,$40 |
||
7062 | 7D A4 13 40 |
||
7063 | 9040 ; Q[02] = 7.777690340007566932935753241556479363645E5 |
||
7064 | 9041 F86757 10 A8 3B 99 11 .DB $10,$A8,$3B,$99,$11,$F5,$D7,$57,$97 |
||
7065 | F5 D7 57 97 |
||
7066 | 9042 F86760 A0 60 44 8B 90 .DB $A0,$60,$44,$8B,$90,$E2,$BD,$12,$40 |
||
7067 | E2 BD 12 40 |
||
7068 | 9043 ; Q[01] = 2.626900195321832660448791748036714883242E5 |
||
7069 | Tue Jul 17 11:00:18 2018 Page 115 |
||
7070 | |||
7071 | |||
7072 | |||
7073 | |||
7074 | 9044 F86769 97 4B 94 D0 A5 .DB $97,$4B,$94,$D0,$A5,$28,$E9,$C7,$1B |
||
7075 | 28 E9 C7 1B |
||
7076 | 9045 F86772 0B F5 01 A0 40 .DB $0B,$F5,$01,$A0,$40,$44,$80,$11,$40 |
||
7077 | 44 80 11 40 |
||
7078 | 9046 ; Q[00] = 3.940717212190338497730839731583397586124E4 |
||
7079 | 9047 F8677B 95 DD E4 62 0D .DB $95,$DD,$E4,$62,$0D,$9D,$1F,$45,$B8 |
||
7080 | 9D 1F 45 B8 |
||
7081 | 9048 F86784 F6 59 2E 10 2C .DB $F6,$59,$2E,$10,$2C,$EF,$99,$0E,$40 |
||
7082 | EF 99 0E 40 |
||
7083 | 9049 |
||
7084 | 9050 ; C1 + C2 = loge(2) (splitted in two) |
||
7085 | 9051 ; C1 = 6.93145751953125E-1 |
||
7086 | 9052 F8678D 00 00 00 00 00 ln2c1: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
7087 | 00 00 00 00 |
||
7088 | 9053 F86796 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$72,$B1,$FE,$3F |
||
7089 | 72 B1 FE 3F |
||
7090 | 9054 |
||
7091 | 9055 ; C2 = 1.428606820309417232121458176568075500134E-6 |
||
7092 | 9056 F8679F 98 07 7A B5 97 ln2c2: .DB $98,$07,$7A,$B5,$97,$1F,$C0,$9C,$1D |
||
7093 | 1F C0 9C 1D |
||
7094 | 9057 F867A8 4F 5E CD 7B 8E .DB $4F,$5E,$CD,$7B,$8E,$BE,$BF,$EB,$3F |
||
7095 | BE BF EB 3F |
||
7096 | 9058 |
||
7097 | 9059 ; ln(2) = 0.6931471805599453094172321214581765680755001 |
||
7098 | 9060 F867B1 AF F6 F2 03 98 cln2: .DB $AF,$F6,$F2,$03,$98,$B3,$E3,$C9,$AB |
||
7099 | B3 E3 C9 AB |
||
7100 | 9061 F867BA 79 CF D1 F7 17 .DB $79,$CF,$D1,$F7,$17,$72,$B1,$FE,$3F |
||
7101 | 72 B1 FE 3F |
||
7102 | 9062 |
||
7103 | 9063 ; log10(2) = l102a + l102b (splitted in two) |
||
7104 | 9064 ; l102a = 0.3125 |
||
7105 | 9065 F867C3 00 00 00 00 00 l102a: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
7106 | 00 00 00 00 |
||
7107 | 9066 F867CC 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$A0,$FD,$3F |
||
7108 | 00 A0 FD 3F |
||
7109 | 9067 |
||
7110 | 9068 ; l102b = -1.14700043360188047862611052755069732318101185E-2 |
||
7111 | 9069 F867D5 F8 D0 6D 90 7E l102b: .DB $F8,$D0,$6D,$90,$7E,$CA,$D4,$0E,$EE |
||
7112 | CA D4 0E EE |
||
7113 | 9070 F867DE 0C 01 86 60 AF .DB $0C,$01,$86,$60,$AF,$EC,$BB,$F8,$BF |
||
7114 | EC BB F8 BF |
||
7115 | 9071 |
||
7116 | 9072 ; log10(e) = l10ea + l10eb (splitted in two) |
||
7117 | 9073 ; l10ea = 0.5 |
||
7118 | 9074 F867E7 00 00 00 00 00 l10ea: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
7119 | 00 00 00 00 |
||
7120 | 9075 F867F0 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FE,$3F |
||
7121 | 00 80 FE 3F |
||
7122 | 9076 ; l10eb = -6.570551809674817234887108108339491770560299E-2 |
||
7123 | 9077 F867F9 36 8F 30 4B 41 l10eb: .DB $36,$8F,$30,$4B,$41,$55,$91,$2A,$AB |
||
7124 | 55 91 2A AB |
||
7125 | 9078 F86802 39 5E 23 5B 9D .DB $39,$5E,$23,$5B,$9D,$90,$86,$FB,$BF |
||
7126 | 90 86 FB BF |
||
7127 | 9079 |
||
7128 | 9080 ; log2(e) = 1/loge(2) |
||
7129 | 9081 ; lg2e = 1.442695040888963407359924681001892137426646 |
||
7130 | 9082 F8680B 86 3E 1D 69 D0 lg2e: .DB $86,$3E,$1D,$69,$D0,$FE,$87,$BE,$BB |
||
7131 | Tue Jul 17 11:00:18 2018 Page 116 |
||
7132 | |||
7133 | |||
7134 | |||
7135 | |||
7136 | FE 87 BE BB |
||
7137 | 9083 F86814 F0 17 5C 29 3B .DB $F0,$17,$5C,$29,$3B,$AA,$B8,$FF,$3F |
||
7138 | AA B8 FF 3F |
||
7139 | 9084 |
||
7140 | 9085 ;---------------------------------------------------------------------------- |
||
7141 | 9086 ; exponential family functions |
||
7142 | 9087 ;---------------------------------------------------------------------------- |
||
7143 | 9088 |
||
7144 | 9089 ; fexp2 - return 2 raised to the x power |
||
7145 | 9090 ; |
||
7146 | 9091 ; entry: |
||
7147 | 9092 ; fac = x |
||
7148 | 9093 ; |
||
7149 | 9094 ; exit: x |
||
7150 | 9095 ; fac = 2 |
||
7151 | 9096 ; CF = 1 if invalid result (nan, inf) |
||
7152 | 9097 ; |
||
7153 | 9098 ; computation mean time: 50ms at 4MHz (4ms for integer argument) |
||
7154 | 9099 ; |
||
7155 | 9100 ;----- |
||
7156 | 9101 F8681D fexp2: |
||
7157 | 9102 ;----- |
||
7158 | 9103 F8681D 24 25 bit facst |
||
7159 | 9104 F8681F 10 0D bpl ?fv ; fac is valid |
||
7160 | 9105 F86821 50 09 bvc ?er ; fac=nan so return nan |
||
7161 | 9106 F86823 24 24 bit facsgn |
||
7162 | 9107 F86825 10 05 bpl ?er ; fac=+inf so return +inf |
||
7163 | 9108 F86827 64 24 ?zz: stz facsgn ; fac=-inf so return 0 |
||
7164 | 9109 F86829 4C 56 4E jmp fldz |
||
7165 | 9110 F8682C 38 ?er: sec |
||
7166 | 9111 F8682D 60 rts |
||
7167 | 9112 F8682E 20 26 4D ?fv: jsr frndm |
||
7168 | 9113 F86831 24 24 bit facsgn |
||
7169 | 9114 F86833 30 0E bmi ?xn ; x is negative |
||
7170 | 9115 F86835 A9 32 lda #<maxl2 ; check if argument can cause overflow |
||
7171 | 9116 F86837 A0 71 ldy #>maxl2 |
||
7172 | 9117 F86839 20 5E 87 jsr fccmp |
||
7173 | 9118 F8683C 30 0E bmi ?ok ; if x < maxl2 then no overflow |
||
7174 | 9119 F8683E F0 0C beq ?ok |
||
7175 | 9120 F86840 4C 7D 4E jmp fldinf ; overflow so return +inf |
||
7176 | 9121 F86843 A9 44 ?xn: lda #<minl2 ; check if argument can cause underflow |
||
7177 | 9122 F86845 A0 71 ldy #>minl2 |
||
7178 | 9123 F86847 20 5E 87 jsr fccmp |
||
7179 | 9124 F8684A 30 DB bmi ?zz ; if x < minl2 then underflow |
||
7180 | 9125 F8684C ?ok: ACC16 |
||
7181 | 9126 F8684C C2 20 rep #PMFLAG |
||
7182 | 9127 .LONGA on |
||
7183 | 9128 .MNLIST |
||
7184 | 9129 F8684E 64 B4 stz fcpc0 ; log2(2) = 1 |
||
7185 | 9130 F86850 64 B6 stz fcpc1 |
||
7186 | 9131 F86852 64 B8 stz fcpc2 |
||
7187 | 9132 F86854 A9 7E 70 lda #ce2p ; P coefficients |
||
7188 | 9133 F86857 85 BA sta fcpp |
||
7189 | 9134 F86859 A9 D8 70 lda #ce2q ; Q coefficients |
||
7190 | 9135 F8685C 85 BC sta fcpq |
||
7191 | 9136 F8685E A2 04 ldx #4 ; P: degree 4 |
||
7192 | 9137 F86860 86 BE stx fcpd |
||
7193 | Tue Jul 17 11:00:18 2018 Page 117 |
||
7194 | |||
7195 | |||
7196 | |||
7197 | |||
7198 | 9138 F86862 86 BF stx fcqd ; Q: degree 4 |
||
7199 | 9139 F86864 ACC08 |
||
7200 | 9140 F86864 E2 20 sep #PMFLAG |
||
7201 | 9141 .LONGA off |
||
7202 | 9142 .MNLIST |
||
7203 | 9143 F86866 A9 FF lda #$FF ; Q polynomial N+1 |
||
7204 | 9144 F86868 4C 18 69 jmp expev |
||
7205 | 9145 |
||
7206 | 9146 ; fexp - return e raised to the x power |
||
7207 | 9147 ; |
||
7208 | 9148 ; entry: |
||
7209 | 9149 ; fac = x |
||
7210 | 9150 ; |
||
7211 | 9151 ; exit: x |
||
7212 | 9152 ; fac = e |
||
7213 | 9153 ; CF = 1 if invalid result (nan, inf) |
||
7214 | 9154 ; |
||
7215 | 9155 ; computation mean time: 60ms at 4MHz |
||
7216 | 9156 ; |
||
7217 | 9157 ;---- |
||
7218 | 9158 F8686B fexp: |
||
7219 | 9159 ;---- |
||
7220 | 9160 F8686B 24 25 bit facst |
||
7221 | 9161 F8686D 24 25 bit facst |
||
7222 | 9162 F8686F 10 0D bpl ?fv ; fac is valid |
||
7223 | 9163 F86871 50 09 bvc ?er ; fac=nan so return nan |
||
7224 | 9164 F86873 24 24 bit facsgn |
||
7225 | 9165 F86875 10 05 bpl ?er ; fac=+inf so return +inf |
||
7226 | 9166 F86877 64 24 ?zz: stz facsgn ; fac=-inf so return 0 |
||
7227 | 9167 F86879 4C 56 4E jmp fldz |
||
7228 | 9168 F8687C 38 ?er: sec |
||
7229 | 9169 F8687D 60 rts |
||
7230 | 9170 F8687E 20 26 4D ?fv: jsr frndm |
||
7231 | 9171 F86881 24 24 bit facsgn |
||
7232 | 9172 F86883 30 0E bmi ?xn ; x is negative |
||
7233 | 9173 F86885 A9 04 lda #<maxln ; check if argument can cause overflow |
||
7234 | 9174 F86887 A0 6F ldy #>maxln |
||
7235 | 9175 F86889 20 5E 87 jsr fccmp |
||
7236 | 9176 F8688C 30 0E bmi ?ok ; if x <= maxln then no overflow |
||
7237 | 9177 F8688E F0 0C beq ?ok |
||
7238 | 9178 F86890 4C 7D 4E jmp fldinf ; overflow so return +inf |
||
7239 | 9179 F86893 A9 16 ?xn: lda #<minln ; check if argument can cause underflow |
||
7240 | 9180 F86895 A0 6F ldy #>minln |
||
7241 | 9181 F86897 20 5E 87 jsr fccmp |
||
7242 | 9182 F8689A 30 DB bmi ?zz ; if x < minln then underflow |
||
7243 | 9183 F8689C ?ok: ACC16 |
||
7244 | 9184 F8689C C2 20 rep #PMFLAG |
||
7245 | 9185 .LONGA on |
||
7246 | 9186 .MNLIST |
||
7247 | 9187 F8689E A9 0B 68 lda #lg2e ; log2(e) |
||
7248 | 9188 F868A1 85 B4 sta fcpc0 |
||
7249 | 9189 F868A3 A9 8D 67 lda #ln2c1 ; loge(2) first piece |
||
7250 | 9190 F868A6 85 B6 sta fcpc1 |
||
7251 | 9191 F868A8 A9 9F 67 lda #ln2c2 ; loge(2) 2nd piece |
||
7252 | 9192 F868AB 85 B8 sta fcpc2 |
||
7253 | 9193 F868AD A9 1E 6D lda #ceep ; P coefficients |
||
7254 | 9194 F868B0 85 BA sta fcpp |
||
7255 | Tue Jul 17 11:00:18 2018 Page 118 |
||
7256 | |||
7257 | |||
7258 | |||
7259 | |||
7260 | 9195 F868B2 A9 78 6D lda #ceeq ; Q coefficients |
||
7261 | 9196 F868B5 85 BC sta fcpq |
||
7262 | 9197 F868B7 A2 04 ldx #4 ; P: degree 4 |
||
7263 | 9198 F868B9 86 BE stx fcpd |
||
7264 | 9199 F868BB E8 inx |
||
7265 | 9200 F868BC 86 BF stx fcqd ; Q: degree 5 |
||
7266 | 9201 F868BE ACC08 |
||
7267 | 9202 F868BE E2 20 sep #PMFLAG |
||
7268 | 9203 .LONGA off |
||
7269 | 9204 .MNLIST |
||
7270 | 9205 F868C0 A9 00 lda #$00 ; Q polynomial N |
||
7271 | 9206 F868C2 80 54 bra expev |
||
7272 | 9207 |
||
7273 | 9208 ; fexp10 - return 10 raised to the x power |
||
7274 | 9209 ; |
||
7275 | 9210 ; entry: |
||
7276 | 9211 ; fac = x |
||
7277 | 9212 ; |
||
7278 | 9213 ; exit: x |
||
7279 | 9214 ; fac = 10 |
||
7280 | 9215 ; CF = 1 if invalid result (nan, inf) |
||
7281 | 9216 ; |
||
7282 | 9217 ; computation mean time: 65ms at 4MHz |
||
7283 | 9218 ; |
||
7284 | 9219 ;------ |
||
7285 | 9220 F868C4 fexp10: |
||
7286 | 9221 ;------ |
||
7287 | 9222 F868C4 24 25 bit facst |
||
7288 | 9223 F868C6 10 0D bpl ?fv ; fac is valid |
||
7289 | 9224 F868C8 50 09 bvc ?er ; fac=nan so return nan |
||
7290 | 9225 F868CA 24 24 bit facsgn |
||
7291 | 9226 F868CC 10 05 bpl ?er ; fac=+inf so return +inf |
||
7292 | 9227 F868CE 64 24 ?zz: stz facsgn ; fac=-inf so return 0 |
||
7293 | 9228 F868D0 4C 56 4E jmp fldz |
||
7294 | 9229 F868D3 38 ?er: sec |
||
7295 | 9230 F868D4 60 rts |
||
7296 | 9231 F868D5 20 26 4D ?fv: jsr frndm |
||
7297 | 9232 F868D8 24 24 bit facsgn |
||
7298 | 9233 F868DA 30 0E bmi ?xn ; x is negative |
||
7299 | 9234 F868DC A9 5A lda #<maxl10 ; check if argument can cause overflow |
||
7300 | 9235 F868DE A0 70 ldy #>maxl10 |
||
7301 | 9236 F868E0 20 5E 87 jsr fccmp |
||
7302 | 9237 F868E3 30 0E bmi ?ok ; if x <= maxl10 then no overflow |
||
7303 | 9238 F868E5 F0 0C beq ?ok |
||
7304 | 9239 F868E7 4C 7D 4E jmp fldinf ; overflow so return +inf |
||
7305 | 9240 F868EA A9 6C ?xn: lda #<minl10 ; check if argument can cause underflow |
||
7306 | 9241 F868EC A0 70 ldy #>minl10 |
||
7307 | 9242 F868EE 20 5E 87 jsr fccmp |
||
7308 | 9243 F868F1 30 DB bmi ?zz ; if x < minl10 then underflow |
||
7309 | 9244 F868F3 ?ok: ACC16 |
||
7310 | 9245 F868F3 C2 20 rep #PMFLAG |
||
7311 | 9246 .LONGA on |
||
7312 | 9247 .MNLIST |
||
7313 | 9248 F868F5 A9 48 70 lda #lg210 ; log2(10) |
||
7314 | 9249 F868F8 85 B4 sta fcpc0 |
||
7315 | 9250 F868FA A9 24 70 lda #lg102a ; log10(2) first piece |
||
7316 | 9251 F868FD 85 B6 sta fcpc1 |
||
7317 | Tue Jul 17 11:00:18 2018 Page 119 |
||
7318 | |||
7319 | |||
7320 | |||
7321 | |||
7322 | 9252 F868FF A9 36 70 lda #lg102b ; log10(2) 2nd piece |
||
7323 | 9253 F86902 85 B8 sta fcpc2 |
||
7324 | 9254 F86904 A9 4C 6F lda #ce10p ; P coefficients |
||
7325 | 9255 F86907 85 BA sta fcpp |
||
7326 | 9256 F86909 A9 B8 6F lda #ce10q ; Q coefficients |
||
7327 | 9257 F8690C 85 BC sta fcpq |
||
7328 | 9258 F8690E A2 05 ldx #5 ; degree |
||
7329 | 9259 F86910 86 BE stx fcpd |
||
7330 | 9260 F86912 86 BF stx fcqd |
||
7331 | 9261 F86914 ACC08 |
||
7332 | 9262 F86914 E2 20 sep #PMFLAG |
||
7333 | 9263 .LONGA off |
||
7334 | 9264 .MNLIST |
||
7335 | 9265 F86916 A9 FF lda #$FF ; Q polynomial N+1 |
||
7336 | 9266 F86918 |
||
7337 | 9267 ; expev - common exponential function evaluation |
||
7338 | 9268 ; |
||
7339 | 9269 ; entry: |
||
7340 | 9270 ; fac = x, valid argument |
||
7341 | 9271 ; A = $00 if exp(x), otherwise A = $FF |
||
7342 | 9272 ; fcpc0 = pointer to a constant = log2(b) |
||
7343 | 9273 ; fcpc1 = pointer to a splitted constant = logb(2) |
||
7344 | 9274 ; fcpc2 = pointer to a splitted constant = logb(2) |
||
7345 | 9275 ; fcpp = pointer to P polynomial coefficients |
||
7346 | 9276 ; fcpq = pointer to Q polynomial coefficients |
||
7347 | 9277 ; fcpd = P polynomial degree |
||
7348 | 9278 ; fcqd = Q polynomial degree |
||
7349 | 9279 ; |
||
7350 | 9280 ; exit: x |
||
7351 | 9281 ; fac = b , where b=e or b=10 or b=2 |
||
7352 | 9282 ; |
||
7353 | 9283 ; strategy: |
||
7354 | 9284 ; |
||
7355 | 9285 ; Range reduction is accomplished by separating the argument x into |
||
7356 | 9286 ; an integer M and a fraction f such that: |
||
7357 | 9287 ; |
||
7358 | 9288 ; x f M |
||
7359 | 9289 ; b = b * 2 where |f| < 0.5 * log (2) |
||
7360 | 9290 ; b |
||
7361 | 9291 ; f |
||
7362 | 9292 ; A rational function (Pade' form) is then used to approximate b in |
||
7363 | 9293 ; the basic range [-0.5 * log (2), +0.5 * log (2)]: |
||
7364 | 9294 ; b b |
||
7365 | 9295 ; |
||
7366 | 9296 ; f P(z) 2 |
||
7367 | 9297 ; b = 1 + 2f ------------- where z = f |
||
7368 | 9298 ; Q(z) - fP(Z) |
||
7369 | 9299 ; |
||
7370 | 9300 ; Finally, get the result scaling the approximate exponential of the |
||
7371 | 9301 ; fraction by a power of two: |
||
7372 | 9302 ; |
||
7373 | 9303 ; x f M |
||
7374 | 9304 ; b = b * 2 |
||
7375 | 9305 ; |
||
7376 | 9306 ; Note: |
||
7377 | 9307 ; Error amplification in the exponential function can be a serious matter. |
||
7378 | 9308 ; The error propagation involves exp(x(1+delta)) = exp(x)(1 + x*delta + ...), |
||
7379 | Tue Jul 17 11:00:18 2018 Page 120 |
||
7380 | |||
7381 | |||
7382 | |||
7383 | |||
7384 | 9309 ; which shows that a 1 lsb error in representing x produces a relative error |
||
7385 | 9310 ; of x times 1 lsb in the function. |
||
7386 | 9311 ; While the routine gives an accurate result for arguments that are exactly |
||
7387 | 9312 ; represented by a long double precision number, the result contains amplified |
||
7388 | 9313 ; roundoff error for large arguments not exactly represented. |
||
7389 | 9314 ; |
||
7390 | 9315 ;----- |
||
7391 | 9316 F86918 expev: |
||
7392 | 9317 ;----- |
||
7393 | 9318 F86918 85 C0 sta fcpolf ; Q polynomial flag degree N+1 |
||
7394 | 9319 F8691A 20 93 84 jsr mvf_t1 ; tfr1=x (save argument) |
||
7395 | 9320 F8691D A5 B4 lda fcpc0 ; x * log2(b) (logarithm base 2 of b) |
||
7396 | 9321 F8691F AA tax |
||
7397 | 9322 F86920 05 B5 ora fcpc0+1 ; if b=2 skip this multiplication |
||
7398 | 9323 F86922 F0 06 beq ?no2 |
||
7399 | 9324 F86924 8A txa |
||
7400 | 9325 F86925 A4 B5 ldy fcpc0+1 |
||
7401 | 9326 F86927 20 D5 49 jsr fcmult ; x*log2(b) |
||
7402 | 9327 F8692A 20 67 45 ?no2: jsr faddhalf ; x*log2(b) + 0.5 (floor truncate toward -inf) |
||
7403 | 9328 F8692D 20 27 50 jsr floor ; get integral part w = floor(x*log2(b) + 0.5) |
||
7404 | 9329 F86930 20 66 84 jsr mvf_t0 ; tfr0=w |
||
7405 | 9330 F86933 20 78 4F jsr uitrunc ; convert w to integer 16 bit |
||
7406 | 9331 F86936 ACC16 |
||
7407 | 9332 F86936 C2 20 rep #PMFLAG |
||
7408 | 9333 .LONGA on |
||
7409 | 9334 .MNLIST |
||
7410 | 9335 F86938 A5 00 lda tm |
||
7411 | 9336 F8693A A6 24 ldx facsgn ; sign of M |
||
7412 | 9337 F8693C 10 04 bpl ?mp |
||
7413 | 9338 F8693E 49 FF FF eor #$FFFF |
||
7414 | 9339 F86941 1A inc a |
||
7415 | 9340 F86942 85 46 ?mp: sta scexp ; scexp=M (for final scaling) |
||
7416 | 9341 F86944 ACC08 |
||
7417 | 9342 F86944 E2 20 sep #PMFLAG |
||
7418 | 9343 .LONGA off |
||
7419 | 9344 .MNLIST |
||
7420 | 9345 F86946 |
||
7421 | 9346 ; now compute x - logb(2)*w, the remainder of x/w |
||
7422 | 9347 F86946 20 47 85 jsr mvt0_f ; fac=w |
||
7423 | 9348 F86949 A5 B6 lda fcpc1 ; pointer to first piece of splitted -logb(2) |
||
7424 | 9349 F8694B AA tax |
||
7425 | 9350 F8694C 05 B7 ora fcpc1+1 ; if b=2 skip this multiplication |
||
7426 | 9351 F8694E F0 19 beq ?skp ; if b=2 the remainder is: x-w |
||
7427 | 9352 F86950 8A txa |
||
7428 | 9353 F86951 A4 B7 ldy fcpc1+1 ; logb(2) is splitted in two pieces |
||
7429 | 9354 F86953 20 D5 49 jsr fcmult ; first piece |
||
7430 | 9355 F86956 20 FB 85 jsr mvt1_a ; arg=x |
||
7431 | 9356 F86959 20 5F 45 jsr fpsub |
||
7432 | 9357 F8695C 20 93 84 jsr mvf_t1 ; tfr1=x-c1 |
||
7433 | 9358 F8695F 20 47 85 jsr mvt0_f ; fac=w |
||
7434 | 9359 F86962 A5 B8 lda fcpc2 |
||
7435 | 9360 F86964 A4 B9 ldy fcpc2+1 |
||
7436 | 9361 F86966 20 D5 49 jsr fcmult ; 2nd piece |
||
7437 | 9362 F86969 20 FB 85 ?skp: jsr mvt1_a ; arg=x-c1 |
||
7438 | 9363 F8696C 20 5F 45 jsr fpsub ; x-c1-c2 = x - logb(2)*w |
||
7439 | 9364 F8696F |
||
7440 | 9365 ; now we have fac = f = x - logb(2)*w, the fraction part |
||
7441 | Tue Jul 17 11:00:18 2018 Page 121 |
||
7442 | |||
7443 | |||
7444 | |||
7445 | |||
7446 | 9366 ; where: |f| < 0.5*logb(2), and we approximate exponential of fraction |
||
7447 | 9367 F8696F 20 93 84 jsr mvf_t1 ; tfr1=f |
||
7448 | 9368 F86972 20 CC 49 jsr fsquare ; z=f*f |
||
7449 | 9369 F86975 20 66 84 jsr mvf_t0 ; tfr0=z |
||
7450 | 9370 F86978 A5 BA lda fcpp ; pointer to P(z) coefficients |
||
7451 | 9371 F8697A A4 BB ldy fcpp+1 |
||
7452 | 9372 F8697C A6 BE ldx fcpd ; P(z) degree |
||
7453 | 9373 F8697E 20 1C 87 jsr peval ; evaluate P(z) |
||
7454 | 9374 F86981 20 FB 85 jsr mvt1_a ; arg=f |
||
7455 | 9375 F86984 20 DD 49 jsr fpmult ; f*P(z) |
||
7456 | 9376 F86987 20 C0 84 jsr mvf_t2 ; tfr2=f*P(z) |
||
7457 | 9377 F8698A A5 BC lda fcpq ; pointer to Q(z) coefficients |
||
7458 | 9378 F8698C A4 BD ldy fcpq+1 |
||
7459 | 9379 F8698E A6 BF ldx fcqd ; Q(z) dregree |
||
7460 | 9380 F86990 24 C0 bit fcpolf |
||
7461 | 9381 F86992 10 05 bpl ?dn ; exp(x) |
||
7462 | 9382 F86994 20 3A 87 jsr pevalp1 ; evaluate Q(z) for exp10(x) & exp2(x) |
||
7463 | 9383 F86997 80 03 bra ?dn2 |
||
7464 | 9384 F86999 20 1C 87 ?dn: jsr peval ; evaluate Q(z) for exp(x) |
||
7465 | 9385 F8699C 20 28 86 ?dn2: jsr mvt2_a |
||
7466 | 9386 F8699F A5 3C lda argsgn |
||
7467 | 9387 F869A1 49 FF eor #$FF |
||
7468 | 9388 F869A3 85 3C sta argsgn ; arg=-f*P(z) |
||
7469 | 9389 F869A5 20 7D 45 jsr fpadd ; fac = Q(z) - f*P(z) |
||
7470 | 9390 F869A8 20 28 86 jsr mvt2_a ; arg = f*P(z) |
||
7471 | 9391 F869AB 20 10 4A jsr fpdiv ; y=f*P(z)/(Q(z) - f*P(z)) |
||
7472 | 9392 F869AE 20 66 84 jsr mvf_t0 ; tfr0=y |
||
7473 | 9393 F869B1 20 6C 45 jsr faddone ; 1+y |
||
7474 | 9394 F869B4 20 CE 85 jsr mvt0_a |
||
7475 | 9395 F869B7 20 7D 45 jsr fpadd ; 1+y+y=1+2*y = 1 + 2*f*P(z)/(Q(z) - f*P(z)) |
||
7476 | 9396 F869BA 4C B7 48 jmp fscale ; scale by M, return exponential |
||
7477 | 9397 |
||
7478 | 9398 ; fexpm1 - return e raised to the x power, minus 1 |
||
7479 | 9399 ; |
||
7480 | 9400 ; entry: |
||
7481 | 9401 ; fac = x |
||
7482 | 9402 ; |
||
7483 | 9403 ; exit: x |
||
7484 | 9404 ; fac = e - 1 |
||
7485 | 9405 ; CF = 1 if invalid result (nan, inf) |
||
7486 | 9406 ; |
||
7487 | 9407 ; For small magnitude values of x, expm1 may be more accurate than exp(x) - 1 |
||
7488 | 9408 ; |
||
7489 | 9409 ; strategy: |
||
7490 | 9410 ; |
||
7491 | 9411 ; Range reduction is accomplished by separating the argument x into |
||
7492 | 9412 ; an integer M and a fraction f such that: |
||
7493 | 9413 ; |
||
7494 | 9414 ; x f M |
||
7495 | 9415 ; e = e * 2 where |f| < 0.5 * log (2) |
||
7496 | 9416 ; e |
||
7497 | 9417 ; f |
||
7498 | 9418 ; A rational function is then used to approximate e - 1 in |
||
7499 | 9419 ; the basic range [-0.5 * log (2), +0.5 * log (2)]: |
||
7500 | 9420 ; e e |
||
7501 | 9421 ; |
||
7502 | 9422 ; f 2 3 P(f) f |
||
7503 | Tue Jul 17 11:00:18 2018 Page 122 |
||
7504 | |||
7505 | |||
7506 | |||
7507 | |||
7508 | 9423 ; e - 1 = f + 0.5f + f ------ = y, e = y + 1 |
||
7509 | 9424 ; Q(f) |
||
7510 | 9425 ; |
||
7511 | 9426 ; Finally, get the result scaling the approximate exponential of the |
||
7512 | 9427 ; fraction by a power of two: |
||
7513 | 9428 ; |
||
7514 | 9429 ; x f M M |
||
7515 | 9430 ; e = e * 2 = (y + 1)*2 so: |
||
7516 | 9431 ; |
||
7517 | 9432 ; x M M |
||
7518 | 9433 ; e - 1 = y * 2 + 2 - 1 |
||
7519 | 9434 ; |
||
7520 | 9435 ; computation mean time: 90ms at 4MHz |
||
7521 | 9436 ; |
||
7522 | 9437 ;------ |
||
7523 | 9438 F869BD fexpm1: |
||
7524 | 9439 ;------ |
||
7525 | 9440 F869BD 24 25 bit facst |
||
7526 | 9441 F869BF 10 0B bpl ?fv ; fac is valid |
||
7527 | 9442 F869C1 70 07 bvs ?er ; fac=nan so return nan |
||
7528 | 9443 F869C3 24 24 bit facsgn |
||
7529 | 9444 F869C5 10 03 bpl ?er ; fac=+inf so return +inf |
||
7530 | 9445 F869C7 4C 32 4E ?m1: jmp fldm1 ; fac=-inf so return -1 |
||
7531 | 9446 F869CA 38 ?er: sec |
||
7532 | 9447 F869CB 60 rts |
||
7533 | 9448 F869CC 20 26 4D ?fv: jsr frndm |
||
7534 | 9449 F869CF 24 24 bit facsgn |
||
7535 | 9450 F869D1 30 0E bmi ?xn ; x is negative |
||
7536 | 9451 F869D3 A9 04 lda #<maxln ; check if argument can cause overflow |
||
7537 | 9452 F869D5 A0 6F ldy #>maxln |
||
7538 | 9453 F869D7 20 5E 87 jsr fccmp |
||
7539 | 9454 F869DA 30 0E bmi ?ok ; if x <= maxln then no overflow |
||
7540 | 9455 F869DC F0 0C beq ?ok |
||
7541 | 9456 F869DE 4C 7D 4E jmp fldinf ; overflow so return +inf |
||
7542 | 9457 F869E1 A9 28 ?xn: lda #<mxm1 ; check if argument can cause underflow |
||
7543 | 9458 F869E3 A0 6F ldy #>mxm1 |
||
7544 | 9459 F869E5 20 5E 87 jsr fccmp |
||
7545 | 9460 F869E8 30 DD bmi ?m1 ; if x < mxm1 then underflow, return -1 |
||
7546 | 9461 F869EA 20 66 84 ?ok: jsr mvf_t0 ; tfr0=x |
||
7547 | 9462 F869ED A9 0B lda #<lg2e ; x*log2(e) |
||
7548 | 9463 F869EF A0 68 ldy #>lg2e |
||
7549 | 9464 F869F1 20 D5 49 jsr fcmult |
||
7550 | 9465 F869F4 20 67 45 jsr faddhalf ; express x = ln 2 (M + remainder)... |
||
7551 | 9466 F869F7 20 27 50 jsr floor ; ...remainder not exceeding 1/2. |
||
7552 | 9467 F869FA 20 93 84 jsr mvf_t1 ; tfr1=w=integral part |
||
7553 | 9468 F869FD 20 78 4F jsr uitrunc ; convert to integer |
||
7554 | 9469 F86A00 ACC16 |
||
7555 | 9470 F86A00 C2 20 rep #PMFLAG |
||
7556 | 9471 .LONGA on |
||
7557 | 9472 .MNLIST |
||
7558 | 9473 F86A02 A5 00 lda tm |
||
7559 | 9474 F86A04 A6 24 ldx facsgn ; sign of M |
||
7560 | 9475 F86A06 10 04 bpl ?mp |
||
7561 | 9476 F86A08 49 FF FF eor #$FFFF |
||
7562 | 9477 F86A0B 1A inc a |
||
7563 | 9478 F86A0C 85 46 ?mp: sta scexp ; scexp=M (for final scaling) |
||
7564 | 9479 F86A0E ACC08 |
||
7565 | Tue Jul 17 11:00:18 2018 Page 123 |
||
7566 | |||
7567 | |||
7568 | |||
7569 | |||
7570 | 9480 F86A0E E2 20 sep #PMFLAG |
||
7571 | 9481 .LONGA off |
||
7572 | 9482 .MNLIST |
||
7573 | 9483 F86A10 20 74 85 jsr mvt1_f |
||
7574 | 9484 F86A13 A9 8D lda #<ln2c1 ; remainder times loge(2) |
||
7575 | 9485 F86A15 A0 67 ldy #>ln2c1 |
||
7576 | 9486 F86A17 20 D5 49 jsr fcmult |
||
7577 | 9487 F86A1A 20 CE 85 jsr mvt0_a |
||
7578 | 9488 F86A1D 20 5F 45 jsr fpsub |
||
7579 | 9489 F86A20 20 66 84 jsr mvf_t0 |
||
7580 | 9490 F86A23 20 74 85 jsr mvt1_f |
||
7581 | 9491 F86A26 A9 9F lda #<ln2c2 |
||
7582 | 9492 F86A28 A0 67 ldy #>ln2c2 |
||
7583 | 9493 F86A2A 20 D5 49 jsr fcmult |
||
7584 | 9494 F86A2D 20 CE 85 jsr mvt0_a |
||
7585 | 9495 F86A30 20 5F 45 jsr fpsub |
||
7586 | 9496 F86A33 20 66 84 jsr mvf_t0 ; tfr0=f=fraction |
||
7587 | 9497 F86A36 20 CC 49 jsr fsquare |
||
7588 | 9498 F86A39 20 93 84 jsr mvf_t1 ; tfr1=f*f |
||
7589 | 9499 F86A3C A9 E4 lda #<cem1p |
||
7590 | 9500 F86A3E A0 6D ldy #>cem1p |
||
7591 | 9501 F86A40 A2 07 ldx #7 |
||
7592 | 9502 F86A42 20 1C 87 jsr peval ; evaluate P(f) |
||
7593 | 9503 F86A45 20 FB 85 jsr mvt1_a |
||
7594 | 9504 F86A48 20 DD 49 jsr fpmult ; f*f*P(f) |
||
7595 | 9505 F86A4B 20 CE 85 jsr mvt0_a |
||
7596 | 9506 F86A4E 20 DD 49 jsr fpmult ; f*f*f*P(f) |
||
7597 | 9507 F86A51 20 C0 84 jsr mvf_t2 ; tfr2=f*f*f*P(f) |
||
7598 | 9508 F86A54 A9 74 lda #<cem1q |
||
7599 | 9509 F86A56 A0 6E ldy #>cem1q |
||
7600 | 9510 F86A58 A2 07 ldx #7 |
||
7601 | 9511 F86A5A 20 3A 87 jsr pevalp1 ; evaluate Q(f) |
||
7602 | 9512 F86A5D 20 28 86 jsr mvt2_a |
||
7603 | 9513 F86A60 20 10 4A jsr fpdiv ; f*f*f*P(f)/Q(f) |
||
7604 | 9514 F86A63 20 FB 85 jsr mvt1_a ; f*f |
||
7605 | 9515 F86A66 ACC16 |
||
7606 | 9516 F86A66 C2 20 rep #PMFLAG |
||
7607 | 9517 .LONGA on |
||
7608 | 9518 .MNLIST |
||
7609 | 9519 F86A68 A5 3A lda argexp |
||
7610 | 9520 F86A6A F0 03 beq ?isz |
||
7611 | 9521 F86A6C 3A dec a |
||
7612 | 9522 F86A6D 85 3A sta argexp ; f*f/2 |
||
7613 | 9523 F86A6F ?isz: ACC08 |
||
7614 | 9524 F86A6F E2 20 sep #PMFLAG |
||
7615 | 9525 .LONGA off |
||
7616 | 9526 .MNLIST |
||
7617 | 9527 F86A71 20 7D 45 jsr fpadd |
||
7618 | 9528 F86A74 20 CE 85 jsr mvt0_a ; arg=f |
||
7619 | 9529 F86A77 20 7D 45 jsr fpadd |
||
7620 | 9530 F86A7A 20 66 84 jsr mvf_t0 ; tfr0=y=f + 0.5*f*f + f*f*f*P(f)/Q(f) |
||
7621 | 9531 F86A7D 20 2E 4E jsr fldp1 ; fac=+1 |
||
7622 | 9532 F86A80 20 B7 48 jsr fscale ; 2^M |
||
7623 | 9533 F86A83 20 93 84 jsr mvf_t1 ; tfr1=2^M |
||
7624 | 9534 F86A86 20 CE 85 jsr mvt0_a ; tfr0=y |
||
7625 | 9535 F86A89 20 DD 49 jsr fpmult ; y*2^M |
||
7626 | 9536 F86A8C 20 66 84 jsr mvf_t0 |
||
7627 | Tue Jul 17 11:00:18 2018 Page 124 |
||
7628 | |||
7629 | |||
7630 | |||
7631 | |||
7632 | 9537 F86A8F 20 74 85 jsr mvt1_f ; 2^M |
||
7633 | 9538 F86A92 20 71 45 jsr fsubone ; 2^M - 1 |
||
7634 | 9539 F86A95 20 CE 85 jsr mvt0_a |
||
7635 | 9540 F86A98 4C 7D 45 jmp fpadd ; y*2^M + 2^M - 1 |
||
7636 | 9541 |
||
7637 | 9542 ; fpown - return the argument x raised to the nth power |
||
7638 | 9543 ; |
||
7639 | 9544 ; entry: |
||
7640 | 9545 ; fac = x |
||
7641 | 9546 ; C = N (signed integer) |
||
7642 | 9547 ; |
||
7643 | 9548 ; exit: N |
||
7644 | 9549 ; fac = x |
||
7645 | 9550 ; CF = 1 if invalid result (nan, inf) |
||
7646 | 9551 ; |
||
7647 | 9552 ; The routine decomposes N as a sum of powers of two. |
||
7648 | 9553 ; The desired power is a product of two-to-the-kth powers of x. |
||
7649 | 9554 ; Max. multiplications number (if N=32767) = 28 |
||
7650 | 9555 ; |
||
7651 | 9556 ; computation mean time: max. 30ms at 4MHz |
||
7652 | 9557 ; |
||
7653 | 9558 ;----- |
||
7654 | 9559 F86A9B fpown: |
||
7655 | 9560 ;----- |
||
7656 | 9561 F86A9B 64 45 stz scsgn ; assume positive N |
||
7657 | 9562 F86A9D ACC16 |
||
7658 | 9563 F86A9D C2 20 rep #PMFLAG |
||
7659 | 9564 .LONGA on |
||
7660 | 9565 .MNLIST |
||
7661 | 9566 F86A9F 89 00 80 bit #$8000 |
||
7662 | 9567 F86AA2 F0 08 beq ?np ; N>=0 |
||
7663 | 9568 F86AA4 49 FF FF eor #$FFFF ; two's complement |
||
7664 | 9569 F86AA7 1A inc a |
||
7665 | 9570 F86AA8 A2 80 ldx #$80 |
||
7666 | 9571 F86AAA 86 45 stx scsgn ; N<0 |
||
7667 | 9572 F86AAC 85 46 ?np: sta scexp ; store N |
||
7668 | 9573 F86AAE 09 00 00 ora #0 |
||
7669 | 9574 F86AB1 ACC08 |
||
7670 | 9575 F86AB1 E2 20 sep #PMFLAG |
||
7671 | 9576 .LONGA off |
||
7672 | 9577 .MNLIST |
||
7673 | 9578 F86AB3 D0 04 bne ?nz |
||
7674 | 9579 F86AB5 A9 40 lda #$40 |
||
7675 | 9580 F86AB7 04 45 tsb scsgn ; flag: N=0 |
||
7676 | 9581 F86AB9 24 25 ?nz: bit facst ; fac test |
||
7677 | 9582 F86ABB 10 1B bpl ?fv ; fac is valid |
||
7678 | 9583 F86ABD 70 11 bvs ?er ; fac=nan, so return nan |
||
7679 | 9584 F86ABF 24 45 bit scsgn |
||
7680 | 9585 F86AC1 70 12 bvs ?p1 ; fac=inf: if N=0 return 1 |
||
7681 | 9586 F86AC3 30 0D bmi ?zz ; fac=inf, N<0, so return zero |
||
7682 | 9587 F86AC5 24 24 bit facsgn |
||
7683 | 9588 F86AC7 10 07 bpl ?er ; +inf raised to +n, so return +inf |
||
7684 | 9589 F86AC9 A5 46 lda scexp ; test if N is odd |
||
7685 | 9590 F86ACB 4A lsr a |
||
7686 | 9591 F86ACC B0 02 bcs ?er ; fac=-inf, N is odd, so return -inf |
||
7687 | 9592 F86ACE 64 24 stz facsgn ; fac=-inf, N is even, so return +inf |
||
7688 | 9593 F86AD0 38 ?er: sec ; exit with invalid flag (nar or inf) |
||
7689 | Tue Jul 17 11:00:18 2018 Page 125 |
||
7690 | |||
7691 | |||
7692 | |||
7693 | |||
7694 | 9594 F86AD1 60 ?rts: rts |
||
7695 | 9595 F86AD2 4C 56 4E ?zz: jmp fldz ; set fac=0 and exit |
||
7696 | 9596 F86AD5 4C 2E 4E ?p1: jmp fldp1 ; set fac=1 and exit |
||
7697 | 9597 F86AD8 24 45 ?fv: bit scsgn |
||
7698 | 9598 F86ADA 70 F9 bvs ?p1 ; fac is valid, N=0, so return 1 |
||
7699 | 9599 F86ADC A5 24 lda facsgn |
||
7700 | 9600 F86ADE 85 4A sta dsgn ; save fac sign and result sign |
||
7701 | 9601 F86AE0 64 24 stz facsgn ; fac=|x| |
||
7702 | 9602 F86AE2 20 66 84 jsr mvf_t0 ; tfr0=w=|x| |
||
7703 | 9603 F86AE5 A5 46 lda scexp |
||
7704 | 9604 F86AE7 4A lsr a |
||
7705 | 9605 F86AE8 B0 05 bcs ?go ; N is odd, set y=|x| |
||
7706 | 9606 F86AEA 20 2E 4E jsr fldp1 ; N is even so set y=1 |
||
7707 | 9607 F86AED 64 4A stz dsgn ; N is even so result is positive |
||
7708 | 9608 F86AEF 20 93 84 ?go: jsr mvf_t1 ; tfro=y |
||
7709 | 9609 F86AF2 ?ll: ACC16 |
||
7710 | 9610 F86AF2 C2 20 rep #PMFLAG |
||
7711 | 9611 .LONGA on |
||
7712 | 9612 .MNLIST |
||
7713 | 9613 F86AF4 46 46 lsr scexp ; shift N |
||
7714 | 9614 F86AF6 ACC08 |
||
7715 | 9615 F86AF6 E2 20 sep #PMFLAG |
||
7716 | 9616 .LONGA off |
||
7717 | 9617 .MNLIST |
||
7718 | 9618 F86AF8 F0 1D beq ?eol ; end of loop |
||
7719 | 9619 F86AFA 08 php |
||
7720 | 9620 F86AFB 20 47 85 jsr mvt0_f ; w |
||
7721 | 9621 F86AFE 20 CC 49 jsr fsquare ; w=w*w, arg to the 2-to-the-kth power |
||
7722 | 9622 F86B01 B0 13 bcs ?of ; overflow |
||
7723 | 9623 F86B03 20 66 84 jsr mvf_t0 ; tfr0=w |
||
7724 | 9624 F86B06 28 plp |
||
7725 | 9625 F86B07 90 E9 bcc ?ll ; loop |
||
7726 | 9626 F86B09 20 FB 85 jsr mvt1_a ; y (include in product if N odd) |
||
7727 | 9627 F86B0C 20 DD 49 jsr fpmult |
||
7728 | 9628 F86B0F B0 05 bcs ?of ; overflow |
||
7729 | 9629 F86B11 20 93 84 jsr mvf_t1 ; tfr1=y |
||
7730 | 9630 F86B14 80 DC bra ?ll ; loop |
||
7731 | 9631 F86B16 28 ?of: plp |
||
7732 | 9632 F86B17 A5 4A ?eol: lda dsgn ; set fac sign |
||
7733 | 9633 F86B19 85 24 sta facsgn |
||
7734 | 9634 F86B1B 18 clc |
||
7735 | 9635 F86B1C 24 25 bit facst |
||
7736 | 9636 F86B1E 10 01 bpl ?ok |
||
7737 | 9637 F86B20 38 sec ; fac=inf |
||
7738 | 9638 F86B21 24 45 ?ok: bit scsgn |
||
7739 | 9639 F86B23 10 AC bpl ?rts ; done if N>0 |
||
7740 | 9640 F86B25 B0 AB bcs ?zz ; y=inf so return 0 |
||
7741 | 9641 F86B27 20 A6 4E jsr ldaone |
||
7742 | 9642 F86B2A 4C 10 4A jmp fpdiv ; y=1/y |
||
7743 | 9643 |
||
7744 | 9644 ; frootn - return the nth root of the argument |
||
7745 | 9645 ; |
||
7746 | 9646 ; entry: |
||
7747 | 9647 ; fac = x |
||
7748 | 9648 ; C = N (integer, N>0) |
||
7749 | 9649 ; |
||
7750 | 9650 ; exit: 1/N |
||
7751 | Tue Jul 17 11:00:18 2018 Page 126 |
||
7752 | |||
7753 | |||
7754 | |||
7755 | |||
7756 | 9651 ; fac = nthroot(x) = x |
||
7757 | 9652 ; CF = 1 if invalid result (nan, inf) |
||
7758 | 9653 ; |
||
7759 | 9654 ; method: |
||
7760 | 9655 ; |
||
7761 | 9656 ; 1/N log2(x)/N |
||
7762 | 9657 ; x = 2 |
||
7763 | 9658 ; |
||
7764 | 9659 ; computation mean time: 140ms at 4MHz |
||
7765 | 9660 ; |
||
7766 | 9661 ;------ |
||
7767 | 9662 F86B2D frootn: |
||
7768 | 9663 ;------ |
||
7769 | 9664 F86B2D 64 45 stz scsgn ; assume N even |
||
7770 | 9665 F86B2F ACC16 |
||
7771 | 9666 F86B2F C2 20 rep #PMFLAG |
||
7772 | 9667 .LONGA on |
||
7773 | 9668 .MNLIST |
||
7774 | 9669 F86B31 89 00 80 bit #$8000 |
||
7775 | 9670 F86B34 F0 06 beq ?pos ; N>=0 |
||
7776 | 9671 F86B36 49 FF FF eor #$FFFF ; two's complement |
||
7777 | 9672 F86B39 1A inc a |
||
7778 | 9673 F86B3A A2 FF ldx #$FF ; N<0 |
||
7779 | 9674 F86B3C 85 46 ?pos: sta scexp ; store N |
||
7780 | 9675 F86B3E 09 00 00 ora #0 |
||
7781 | 9676 F86B41 ACC08 |
||
7782 | 9677 F86B41 E2 20 sep #PMFLAG |
||
7783 | 9678 .LONGA off |
||
7784 | 9679 .MNLIST |
||
7785 | 9680 F86B43 F0 03 beq ?nan ; return nan if N=0 |
||
7786 | 9681 F86B45 E8 inx ; return nan if N<0 |
||
7787 | 9682 F86B46 D0 03 bne ?ok |
||
7788 | 9683 F86B48 4C 74 4E ?nan: jmp fldnan |
||
7789 | 9684 F86B4B 4A ?ok: lsr a ; N odd? |
||
7790 | 9685 F86B4C 90 04 bcc ?ev ; no |
||
7791 | 9686 F86B4E A9 FF lda #$FF |
||
7792 | 9687 F86B50 85 45 sta scsgn ; flag N odd |
||
7793 | 9688 F86B52 24 25 ?ev: bit facst ; fac test |
||
7794 | 9689 F86B54 10 0C bpl ?fv ; fac is valid |
||
7795 | 9690 F86B56 70 08 bvs ?er ; fac=nan, so return nan |
||
7796 | 9691 F86B58 24 24 bit facsgn |
||
7797 | 9692 F86B5A 10 04 bpl ?er ; fac=+inf so return +inf |
||
7798 | 9693 F86B5C 24 45 bit scsgn ; if N is even and fac=-inf... |
||
7799 | 9694 F86B5E 50 E8 bvc ?nan ; ...return nan |
||
7800 | 9695 F86B60 38 ?er: sec ; exit with invalid flag (nar or inf) |
||
7801 | 9696 F86B61 60 rts |
||
7802 | 9697 F86B62 50 03 ?fv: bvc ?nz ; fac <> 0 |
||
7803 | 9698 F86B64 4C 56 4E ?z: jmp fldz ; if fac=0 return 0 |
||
7804 | 9699 F86B67 A5 24 ?nz: lda facsgn |
||
7805 | 9700 F86B69 10 04 bpl ?gte0 |
||
7806 | 9701 F86B6B 24 45 bit scsgn ; if fac<0 and N is even... |
||
7807 | 9702 F86B6D 50 D9 bvc ?nan ; ...return nan |
||
7808 | 9703 F86B6F 85 4A ?gte0: sta dsgn |
||
7809 | 9704 F86B71 ACC16 |
||
7810 | 9705 F86B71 C2 20 rep #PMFLAG |
||
7811 | 9706 .LONGA on |
||
7812 | 9707 .MNLIST |
||
7813 | Tue Jul 17 11:00:18 2018 Page 127 |
||
7814 | |||
7815 | |||
7816 | |||
7817 | |||
7818 | 9708 F86B73 A5 46 lda scexp |
||
7819 | 9709 F86B75 C9 01 00 cmp #1 |
||
7820 | 9710 F86B78 ACC08 |
||
7821 | 9711 F86B78 E2 20 sep #PMFLAG |
||
7822 | 9712 .LONGA off |
||
7823 | 9713 .MNLIST |
||
7824 | 9714 F86B7A 18 clc |
||
7825 | 9715 F86B7B F0 2E beq ?rts |
||
7826 | 9716 F86B7D 64 24 stz facsgn ; fac=|x| |
||
7827 | 9717 F86B7F A5 4A lda dsgn |
||
7828 | 9718 F86B81 48 pha ; save fac sign and result sign |
||
7829 | 9719 F86B82 A5 47 lda scexp+1 |
||
7830 | 9720 F86B84 48 pha |
||
7831 | 9721 F86B85 A5 46 lda scexp |
||
7832 | 9722 F86B87 48 pha |
||
7833 | 9723 F86B88 20 6B 63 jsr flog2 ; log2(x) |
||
7834 | 9724 F86B8B 90 06 bcc ?ok2 |
||
7835 | 9725 F86B8D 24 24 bit facsgn |
||
7836 | 9726 F86B8F 10 1A bpl ?rts |
||
7837 | 9727 F86B91 30 D1 bmi ?z ; returns zero |
||
7838 | 9728 F86B93 20 C0 84 ?ok2: jsr mvf_t2 |
||
7839 | 9729 F86B96 68 pla ; scexp low |
||
7840 | 9730 F86B97 7A ply ; scexp high |
||
7841 | 9731 F86B98 20 5B 4F jsr fldu16 ; convert N to float |
||
7842 | 9732 F86B9B 68 pla |
||
7843 | 9733 F86B9C 85 4A sta dsgn ; sign of the result |
||
7844 | 9734 F86B9E 20 28 86 jsr mvt2_a ; log2(x) |
||
7845 | 9735 F86BA1 20 10 4A jsr fpdiv ; log2(x)/N |
||
7846 | 9736 F86BA4 20 1D 68 jsr fexp2 ; exp2(...) |
||
7847 | 9737 F86BA7 A5 4A lda dsgn |
||
7848 | 9738 F86BA9 85 24 sta facsgn |
||
7849 | 9739 F86BAB 60 ?rts: rts |
||
7850 | 9740 |
||
7851 | 9741 ; fpowxy - return x raised to the yth power |
||
7852 | 9742 ; |
||
7853 | 9743 ; entry: |
||
7854 | 9744 ; fac = y |
||
7855 | 9745 ; arg = x |
||
7856 | 9746 ; |
||
7857 | 9747 ; exit: y |
||
7858 | 9748 ; fac = x |
||
7859 | 9749 ; CF = 1 if invalid result (nan, inf) |
||
7860 | 9750 ; |
||
7861 | 9751 ; method: |
||
7862 | 9752 ; 1) for noninteger y or |y|>32767 |
||
7863 | 9753 ; |
||
7864 | 9754 ; y y*log2(x) |
||
7865 | 9755 ; x = 2 |
||
7866 | 9756 ; |
||
7867 | 9757 ; 2) for integer y, |y|<32768: |
||
7868 | 9758 ; |
||
7869 | 9759 ; y |
||
7870 | 9760 ; x = fpown(x, y) |
||
7871 | 9761 ; |
||
7872 | 9762 ; computation mean time: max 200ms at 4MHz |
||
7873 | 9763 ; |
||
7874 | 9764 ;------ |
||
7875 | Tue Jul 17 11:00:18 2018 Page 128 |
||
7876 | |||
7877 | |||
7878 | |||
7879 | |||
7880 | 9765 F86BAC fpowxy: |
||
7881 | 9766 ;------ |
||
7882 | 9767 F86BAC A9 C0 lda #$C0 ; if x=nan or y=nan, return nan |
||
7883 | 9768 F86BAE C5 3D cmp argst |
||
7884 | 9769 F86BB0 F0 48 beq ?nan |
||
7885 | 9770 F86BB2 C5 25 cmp facst |
||
7886 | 9771 F86BB4 F0 44 beq ?nan |
||
7887 | 9772 F86BB6 64 4B stz powfg |
||
7888 | 9773 F86BB8 24 25 bit facst |
||
7889 | 9774 F86BBA 30 72 bmi ?yinf ; y=+/-inf |
||
7890 | 9775 F86BBC 70 3F bvs ?1 ; if y=0 return +1 |
||
7891 | 9776 F86BBE |
||
7892 | 9777 ; here y is valid and not zero |
||
7893 | 9778 F86BBE 20 D6 6C jsr ?yint ; check if y is integer -- fac=w=floor(y) |
||
7894 | 9779 F86BC1 D0 63 bne ?rst ; y is not integer, restore arg&fac |
||
7895 | 9780 F86BC3 A9 80 lda #$80 |
||
7896 | 9781 F86BC5 85 4B sta powfg ; powfg<7>: y is integer |
||
7897 | 9782 F86BC7 20 78 4F jsr uitrunc ; get w as 128 bit integer |
||
7898 | 9783 F86BCA ACC16 |
||
7899 | 9784 F86BCA C2 20 rep #PMFLAG |
||
7900 | 9785 .LONGA on |
||
7901 | 9786 .MNLIST |
||
7902 | 9787 F86BCC A5 0E lda tm+14 |
||
7903 | 9788 F86BCE 05 0C ora tm+12 |
||
7904 | 9789 F86BD0 05 0A ora tm+10 |
||
7905 | 9790 F86BD2 05 08 ora tm+8 |
||
7906 | 9791 F86BD4 05 06 ora tm+6 |
||
7907 | 9792 F86BD6 05 04 ora tm+4 |
||
7908 | 9793 F86BD8 05 02 ora tm+2 |
||
7909 | 9794 F86BDA D0 27 bne ?ibig ; y is a big integer |
||
7910 | 9795 F86BDC A5 00 lda tm |
||
7911 | 9796 F86BDE C9 00 80 cmp #32768 |
||
7912 | 9797 F86BE1 B0 20 bcs ?ibig ; |w|>=32768, is a big integer |
||
7913 | 9798 F86BE3 A6 24 ldx facsgn ; w sign |
||
7914 | 9799 F86BE5 10 04 bpl ?pp ; w>0 |
||
7915 | 9800 F86BE7 49 FF FF eor #$FFFF ; two's complement |
||
7916 | 9801 F86BEA 1A inc a |
||
7917 | 9802 F86BEB 85 48 ?pp: sta dexp |
||
7918 | 9803 F86BED ACC08 |
||
7919 | 9804 F86BED E2 20 sep #PMFLAG |
||
7920 | 9805 .LONGA off |
||
7921 | 9806 .MNLIST |
||
7922 | 9807 F86BEF 20 47 85 jsr mvt0_f ; fac=x |
||
7923 | 9808 F86BF2 A5 49 lda dexp+1 ; y is integer and |y|<32768... |
||
7924 | 9809 F86BF4 EB xba |
||
7925 | 9810 F86BF5 A5 48 lda dexp |
||
7926 | 9811 F86BF7 4C 9B 6A jmp fpown ; ...so call fpown |
||
7927 | 9812 F86BFA 4C 74 4E ?nan: jmp fldnan ; return nan |
||
7928 | 9813 F86BFD 4C 2E 4E ?1: jmp fldp1 ; return +1 |
||
7929 | 9814 F86C00 4C 56 4E ?z: jmp fldz ; return 0 |
||
7930 | 9815 F86C03 ?ibig: ACC08 ; y is a big integer and we check if... |
||
7931 | 9816 F86C03 E2 20 sep #PMFLAG |
||
7932 | 9817 .LONGA off |
||
7933 | 9818 .MNLIST |
||
7934 | 9819 ; ...is odd or even |
||
7935 | 9820 F86C05 20 74 85 jsr mvt1_f ; restore fac=y |
||
7936 | 9821 F86C08 A9 FF lda #$FF |
||
7937 | Tue Jul 17 11:00:18 2018 Page 129 |
||
7938 | |||
7939 | |||
7940 | |||
7941 | |||
7942 | 9822 F86C0A 85 46 sta scexp |
||
7943 | 9823 F86C0C 85 47 sta scexp+1 ; scexp=-1 |
||
7944 | 9824 F86C0E 20 B7 48 jsr fscale ; w=y/2 |
||
7945 | 9825 F86C11 20 27 50 jsr floor ; w=floor(y/2) |
||
7946 | 9826 F86C14 A9 01 lda #1 |
||
7947 | 9827 F86C16 85 46 sta scexp |
||
7948 | 9828 F86C18 64 47 stz scexp+1 ; scexp=1 |
||
7949 | 9829 F86C1A 20 B7 48 jsr fscale ; w*2 = 2*floor(y/2) |
||
7950 | 9830 F86C1D |
||
7951 | 9831 ; if 2*floor(y/2) != y then y is an odd integer |
||
7952 | 9832 F86C1D 20 DF 6C jsr ?cpy ; compare y vs. 2*floor(y/2) |
||
7953 | 9833 F86C20 F0 04 beq ?rst ; y is an even integer |
||
7954 | 9834 F86C22 A9 40 lda #$40 |
||
7955 | 9835 F86C24 04 4B tsb powfg ; powfg<6>: odd integer flag |
||
7956 | 9836 F86C26 20 CE 85 ?rst: jsr mvt0_a ; restore arg=x |
||
7957 | 9837 F86C29 20 74 85 jsr mvt1_f ; restore fac=y |
||
7958 | 9838 F86C2C 80 30 bra ?xtst ; go to check x |
||
7959 | 9839 |
||
7960 | 9840 ?yinf: ; y=+/-inf so check x |
||
7961 | 9841 F86C2E 24 3D bit argst |
||
7962 | 9842 F86C30 10 0D bpl ?xv ; x is valid |
||
7963 | 9843 F86C32 24 3C bit argsgn |
||
7964 | 9844 F86C34 30 C4 bmi ?nan ; if x=-inf and y=+-inf return nan |
||
7965 | 9845 F86C36 24 24 bit facsgn |
||
7966 | 9846 F86C38 30 C6 bmi ?z ; if x=+inf and y=-inf return 0 |
||
7967 | 9847 ; if x=+inf and y=inf return +inf |
||
7968 | 9848 F86C3A 64 24 ?pi: stz facsgn ; return +inf |
||
7969 | 9849 F86C3C 4C 7D 4E jmp fldinf |
||
7970 | 9850 |
||
7971 | 9851 ?xv: ; y=+/-inf and valid x |
||
7972 | 9852 F86C3F 50 06 bvc ?nz ; x<>0 |
||
7973 | 9853 F86C41 24 24 bit facsgn |
||
7974 | 9854 F86C43 10 BB bpl ?z ; if x=0 and y=+inf return zero |
||
7975 | 9855 F86C45 30 F3 bmi ?pi ; if x=0 and y=-inf return zero |
||
7976 | 9856 |
||
7977 | 9857 ?nz: ; y=+/-inf and x<>0 |
||
7978 | 9858 F86C47 24 3C bit argsgn |
||
7979 | 9859 F86C49 30 AF bmi ?nan ; if x<0 and y=+-inf return nan |
||
7980 | 9860 F86C4B 20 B5 6C jsr ?is1 ; check if |x|=1 |
||
7981 | 9861 F86C4E F0 AA beq ?nan ; if |x|=1 and y=+/-inf return nan |
||
7982 | 9862 F86C50 90 06 bcc ?xm ; |x|<1 |
||
7983 | 9863 F86C52 24 24 bit facsgn |
||
7984 | 9864 F86C54 10 E4 bpl ?pi ; if |x|>1 and y=+inf return +inf |
||
7985 | 9865 F86C56 30 A8 bmi ?z ; if |x|>1 and y=-inf return 0 |
||
7986 | 9866 F86C58 24 24 ?xm: bit facsgn |
||
7987 | 9867 F86C5A 10 A4 bpl ?z ; if |x|<1 and y=+inf return 0 |
||
7988 | 9868 F86C5C 30 DC bmi ?pi ; if |x|<1 and y=-inf return +inf |
||
7989 | 9869 |
||
7990 | 9870 ?xtst: ; here y is valid and y <> 0 so we check x |
||
7991 | 9871 F86C5E 24 3D bit argst |
||
7992 | 9872 F86C60 10 17 bpl ?xv2 ; x is valid |
||
7993 | 9873 F86C62 24 3C bit argsgn |
||
7994 | 9874 F86C64 30 06 bmi ?xmi ; x=-inf |
||
7995 | 9875 F86C66 24 24 bit facsgn |
||
7996 | 9876 F86C68 10 D0 bpl ?pi ; if x=+inf and y>0 return +inf |
||
7997 | 9877 F86C6A 30 94 bmi ?z ; if x=+inf and y<0 return 0 |
||
7998 | 9878 |
||
7999 | Tue Jul 17 11:00:18 2018 Page 130 |
||
8000 | |||
8001 | |||
8002 | |||
8003 | |||
8004 | 9879 ?xmi: ; x=-inf -- check if y is odd integer |
||
8005 | 9880 F86C6C A5 4B lda powfg |
||
8006 | 9881 F86C6E C9 C0 cmp #$C0 ; y must be odd integer |
||
8007 | 9882 F86C70 D0 88 bne ?nan |
||
8008 | 9883 F86C72 A9 FF lda #$FF ; x=-inf and y is an odd integer... |
||
8009 | 9884 F86C74 85 24 sta facsgn |
||
8010 | 9885 F86C76 4C 7D 4E jmp fldinf ; ...so return -inf |
||
8011 | 9886 F86C79 |
||
8012 | 9887 ?xv2: ; now both x and y are valid |
||
8013 | 9888 F86C79 50 06 bvc ?xv3 ; x<>0 |
||
8014 | 9889 F86C7B 24 24 bit facsgn |
||
8015 | 9890 F86C7D 10 81 bpl ?z ; if x=0 and y>0 return 0 |
||
8016 | 9891 F86C7F 30 B9 bmi ?pi ; if x=0 and y<0 return +inf |
||
8017 | 9892 F86C81 24 3C ?xv3: bit argsgn |
||
8018 | 9893 F86C83 10 0F bpl ?xv4 ; x>0 |
||
8019 | 9894 F86C85 A5 4B lda powfg |
||
8020 | 9895 F86C87 C9 C0 cmp #$C0 ; if x<0, y must be odd integer |
||
8021 | 9896 F86C89 F0 03 beq ?xv30 |
||
8022 | 9897 F86C8B 4C 74 4E jmp fldnan |
||
8023 | 9898 F86C8E A9 01 ?xv30: lda #1 |
||
8024 | 9899 F86C90 04 4B tsb powfg ; powfg<0>: x change sign |
||
8025 | 9900 F86C92 64 3C stz argsgn ; |x| |
||
8026 | 9901 F86C94 20 ED 84 ?xv4: jsr mvf_t3 ; tfr3=y |
||
8027 | 9902 F86C97 20 0C 84 jsr mvatof ; fac=x |
||
8028 | 9903 F86C9A 20 6B 63 jsr flog2 ; log2(x) |
||
8029 | 9904 F86C9D B0 0B bcs ?end |
||
8030 | 9905 F86C9F 20 55 86 jsr mvt3_a ; arg=y |
||
8031 | 9906 F86CA2 20 DD 49 jsr fpmult ; y*log2(x) |
||
8032 | 9907 F86CA5 B0 03 bcs ?end |
||
8033 | 9908 F86CA7 20 1D 68 jsr fexp2 ; 2^(y*log2(x)) |
||
8034 | 9909 F86CAA 46 4B ?end: lsr powfg |
||
8035 | 9910 F86CAC 90 06 bcc ?e2 |
||
8036 | 9911 F86CAE A5 24 lda facsgn ; change sign to result |
||
8037 | 9912 F86CB0 49 FF eor #$FF |
||
8038 | 9913 F86CB2 85 24 sta facsgn |
||
8039 | 9914 F86CB4 60 ?e2: rts |
||
8040 | 9915 |
||
8041 | 9916 ?is1: ; check if |arg|=1 |
||
8042 | 9917 F86CB5 ACC16 |
||
8043 | 9918 F86CB5 C2 20 rep #PMFLAG |
||
8044 | 9919 .LONGA on |
||
8045 | 9920 .MNLIST |
||
8046 | 9921 F86CB7 A5 3A lda argexp |
||
8047 | 9922 F86CB9 C9 FF 3F cmp #EBIAS |
||
8048 | 9923 F86CBC D0 15 bne ?is0 ; is not 1 (CF=1 if |arg|>=1) |
||
8049 | 9924 F86CBE A5 38 lda argm+14 |
||
8050 | 9925 F86CC0 C9 00 80 cmp #$8000 |
||
8051 | 9926 F86CC3 D0 0E bne ?is0 ; is not 1 |
||
8052 | 9927 F86CC5 A5 2A lda argm |
||
8053 | 9928 F86CC7 05 2C ora argm+2 |
||
8054 | 9929 F86CC9 05 2E ora argm+4 |
||
8055 | 9930 F86CCB 05 30 ora argm+6 |
||
8056 | 9931 F86CCD 05 32 ora argm+8 |
||
8057 | 9932 F86CCF 05 34 ora argm+10 |
||
8058 | 9933 F86CD1 05 36 ora argm+12 |
||
8059 | 9934 F86CD3 ?is0: ACC08 |
||
8060 | 9935 F86CD3 E2 20 sep #PMFLAG |
||
8061 | Tue Jul 17 11:00:18 2018 Page 131 |
||
8062 | |||
8063 | |||
8064 | |||
8065 | |||
8066 | 9936 .LONGA off |
||
8067 | 9937 .MNLIST |
||
8068 | 9938 F86CD5 60 rts ; ZF=1 if |arg|=1, CF=1 if |arg|>=1 |
||
8069 | 9939 |
||
8070 | 9940 F86CD6 20 1A 85 ?yint: jsr mva_t0 ; tfr0=x |
||
8071 | 9941 F86CD9 20 93 84 jsr mvf_t1 ; tfr1=y |
||
8072 | 9942 F86CDC 20 27 50 jsr floor ; get the integral part of y |
||
8073 | 9943 F86CDF |
||
8074 | 9944 ?cpy: ; compare fac vs. y/tfr1 (just for equality) |
||
8075 | 9945 F86CDF ACC16 |
||
8076 | 9946 F86CDF C2 20 rep #PMFLAG |
||
8077 | 9947 .LONGA on |
||
8078 | 9948 .MNLIST |
||
8079 | 9949 F86CE1 A5 12 lda facm |
||
8080 | 9950 F86CE3 C5 64 cmp tfr1 |
||
8081 | 9951 F86CE5 D0 34 bne ?cp0 |
||
8082 | 9952 F86CE7 A5 14 lda facm+2 |
||
8083 | 9953 F86CE9 C5 66 cmp tfr1+2 |
||
8084 | 9954 F86CEB D0 2E bne ?cp0 |
||
8085 | 9955 F86CED A5 16 lda facm+4 |
||
8086 | 9956 F86CEF C5 68 cmp tfr1+4 |
||
8087 | 9957 F86CF1 D0 28 bne ?cp0 |
||
8088 | 9958 F86CF3 A5 18 lda facm+6 |
||
8089 | 9959 F86CF5 C5 6A cmp tfr1+6 |
||
8090 | 9960 F86CF7 D0 22 bne ?cp0 |
||
8091 | 9961 F86CF9 A5 1A lda facm+8 |
||
8092 | 9962 F86CFB C5 6C cmp tfr1+8 |
||
8093 | 9963 F86CFD D0 1C bne ?cp0 |
||
8094 | 9964 F86CFF A5 1C lda facm+10 |
||
8095 | 9965 F86D01 C5 6E cmp tfr1+10 |
||
8096 | 9966 F86D03 D0 16 bne ?cp0 |
||
8097 | 9967 F86D05 A5 1E lda facm+12 |
||
8098 | 9968 F86D07 C5 70 cmp tfr1+12 |
||
8099 | 9969 F86D09 D0 10 bne ?cp0 |
||
8100 | 9970 F86D0B A5 20 lda facm+14 |
||
8101 | 9971 F86D0D C5 72 cmp tfr1+14 |
||
8102 | 9972 F86D0F D0 0A bne ?cp0 |
||
8103 | 9973 F86D11 A5 22 lda facm+16 |
||
8104 | 9974 F86D13 C5 74 cmp tfr1+16 |
||
8105 | 9975 F86D15 D0 04 bne ?cp0 |
||
8106 | 9976 F86D17 A5 24 lda facm+18 |
||
8107 | 9977 F86D19 C5 76 cmp tfr1+18 |
||
8108 | 9978 F86D1B ?cp0: ACC08 |
||
8109 | 9979 F86D1B E2 20 sep #PMFLAG |
||
8110 | 9980 .LONGA off |
||
8111 | 9981 .MNLIST |
||
8112 | 9982 F86D1D 60 rts ; ZF=1 if equal |
||
8113 | 9983 |
||
8114 | 9984 ; coefficients for exp() evaluation |
||
8115 | 9985 F86D1E ceep: |
||
8116 | 9986 ; P[4] = 3.279723985560247033712687707263393506266E-10 |
||
8117 | 9987 F86D1E 44 59 3A 65 81 .DB $44,$59,$3A,$65,$81,$28,$53,$8A,$47 |
||
8118 | 28 53 8A 47 |
||
8119 | 9988 F86D27 FE AA B3 F9 02 .DB $FE,$AA,$B3,$F9,$02,$4E,$B4,$DF,$3F |
||
8120 | 4E B4 DF 3F |
||
8121 | 9989 ; P[3] = 6.141506007208645008909088812338454698548E-7 |
||
8122 | 9990 F86D30 B0 71 8E FB B2 .DB $B0,$71,$8E,$FB,$B2,$D2,$28,$E7,$FF |
||
8123 | Tue Jul 17 11:00:18 2018 Page 132 |
||
8124 | |||
8125 | |||
8126 | |||
8127 | |||
8128 | D2 28 E7 FF |
||
8129 | 9991 F86D39 4A 4C 8E A0 1B .DB $4A,$4C,$8E,$A0,$1B,$DC,$A4,$EA,$3F |
||
8130 | DC A4 EA 3F |
||
8131 | 9992 ; P[2] = 2.708775201978218837374512615596512792224E-4 |
||
8132 | 9993 F86D42 B6 9E 58 BA 61 .DB $B6,$9E,$58,$BA,$61,$BA,$82,$D8,$A0 |
||
8133 | BA 82 D8 A0 |
||
8134 | 9994 F86D4B 31 FA 48 B9 90 .DB $31,$FA,$48,$B9,$90,$04,$8E,$F3,$3F |
||
8135 | 04 8E F3 3F |
||
8136 | 9995 ; P[1] = 3.508710990737834361215404761139478627390E-2 |
||
8137 | 9996 F86D54 D4 0F B2 5C 74 .DB $D4,$0F,$B2,$5C,$74,$7D,$79,$81,$28 |
||
8138 | 7D 79 81 28 |
||
8139 | 9997 F86D5D BF 78 03 59 80 .DB $BF,$78,$03,$59,$80,$B7,$8F,$FA,$3F |
||
8140 | B7 8F FA 3F |
||
8141 | 9998 ; P[0] = 1 |
||
8142 | 9999 F86D66 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
8143 | 00 00 00 00 |
||
8144 | 10000 F86D6F 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FF,$3F |
||
8145 | 00 80 FF 3F |
||
8146 | 10001 |
||
8147 | 10002 F86D78 ceeq: |
||
8148 | 10003 ; Q[5] = 2.980756652081995192255342779918052538681E-12 |
||
8149 | 10004 F86D78 AA EB 58 3C C8 .DB $AA,$EB,$58,$3C,$C8,$65,$82,$7C,$65 |
||
8150 | 65 82 7C 65 |
||
8151 | 10005 F86D81 FB 7E D8 C6 89 .DB $FB,$7E,$D8,$C6,$89,$C0,$D1,$D8,$3F |
||
8152 | C0 D1 D8 3F |
||
8153 | 10006 ; Q[4] = 1.771372078166251484503904874657985291164E-8 |
||
8154 | 10007 F86D8A F5 58 96 76 83 .DB $F5,$58,$96,$76,$83,$9C,$A6,$21,$0D |
||
8155 | 9C A6 21 0D |
||
8156 | 10008 F86D93 1B F5 F8 49 E2 .DB $1B,$F5,$F8,$49,$E2,$28,$98,$E5,$3F |
||
8157 | 28 98 E5 3F |
||
8158 | 10009 ; Q[3] = 1.504792651814944826817779302637284053660E-5 |
||
8159 | 10010 F86D9C AE 5F 82 3D 77 .DB $AE,$5F,$82,$3D,$77,$DC,$F3,$E4,$70 |
||
8160 | DC F3 E4 70 |
||
8161 | 10011 F86DA5 24 62 3D 2E 5A .DB $24,$62,$3D,$2E,$5A,$76,$FC,$EE,$3F |
||
8162 | 76 FC EE 3F |
||
8163 | 10012 ; Q[2] = 3.611828913847589925056132680618007270344E-3 |
||
8164 | 10013 F86DAE 68 61 9E E9 6E .DB $68,$61,$9E,$E9,$6E,$9C,$AE,$2E,$1E |
||
8165 | 9C AE 2E 1E |
||
8166 | 10014 F86DB7 D4 1F 50 10 6F .DB $D4,$1F,$50,$10,$6F,$B4,$EC,$F6,$3F |
||
8167 | B4 EC F6 3F |
||
8168 | 10015 ; Q[1] = 2.368408864814233538909747618894558968880E-1 |
||
8169 | 10016 F86DC0 76 96 FC D8 64 .DB $76,$96,$FC,$D8,$64,$69,$67,$EB,$3E |
||
8170 | 69 67 EB 3E |
||
8171 | 10017 F86DC9 0A 67 2C D7 6A .DB $0A,$67,$2C,$D7,$6A,$86,$F2,$FC,$3F |
||
8172 | 86 F2 FC 3F |
||
8173 | 10018 ; Q[0] = 2 |
||
8174 | 10019 F86DD2 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
8175 | 00 00 00 00 |
||
8176 | 10020 F86DDB 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$00,$40 |
||
8177 | 00 80 00 40 |
||
8178 | 10021 |
||
8179 | 10022 ; coefficients for expm1() evaluation |
||
8180 | 10023 F86DE4 cem1p: |
||
8181 | 10024 ; MP[7] = -4.888737542888633647784737721812546636240E-1 |
||
8182 | 10025 F86DE4 52 E5 66 71 85 .DB $52,$E5,$66,$71,$85,$3C,$04,$05,$0D |
||
8183 | 3C 04 05 0D |
||
8184 | 10026 F86DED 8F 39 16 25 A9 .DB $8F,$39,$16,$25,$A9,$4D,$FA,$FD,$BF |
||
8185 | Tue Jul 17 11:00:18 2018 Page 133 |
||
8186 | |||
8187 | |||
8188 | |||
8189 | |||
8190 | 4D FA FD BF |
||
8191 | 10027 ; MP[6] = 4.401308817383362136048032038528753151144E1 |
||
8192 | 10028 F86DF6 84 22 38 E7 E0 .DB $84,$22,$38,$E7,$E0,$BC,$D7,$D9,$5B |
||
8193 | BC D7 D9 5B |
||
8194 | 10029 F86DFF AE 51 7A FC 66 .DB $AE,$51,$7A,$FC,$66,$0D,$B0,$04,$40 |
||
8195 | 0D B0 04 40 |
||
8196 | 10030 ; MP[5] = -1.716772506388927649032068540558788106762E3 |
||
8197 | 10031 F86E08 44 3A 92 A3 59 .DB $44,$3A,$92,$A3,$59,$97,$98,$46,$5F |
||
8198 | 97 98 46 5F |
||
8199 | 10032 F86E11 A6 8C 51 5F B8 .DB $A6,$8C,$51,$5F,$B8,$98,$D6,$09,$C0 |
||
8200 | 98 D6 09 C0 |
||
8201 | 10033 ; MP[4] = 4.578962475841642634225390068461943438441E4 |
||
8202 | 10034 F86E1A C3 21 E0 44 63 .DB $C3,$21,$E0,$44,$63,$32,$45,$02,$AF |
||
8203 | 32 45 02 AF |
||
8204 | 10035 F86E23 73 E6 2A F0 9F .DB $73,$E6,$2A,$F0,$9F,$DD,$B2,$0E,$40 |
||
8205 | DD B2 0E 40 |
||
8206 | 10036 ; MP[3] = -7.212432713558031519943281748462837065308E5 |
||
8207 | 10037 F86E2C 12 EA 50 4A 6C .DB $12,$EA,$50,$4A,$6C,$00,$52,$CF,$E1 |
||
8208 | 00 52 CF E1 |
||
8209 | 10038 F86E35 C1 2E 79 57 B4 .DB $C1,$2E,$79,$57,$B4,$15,$B0,$12,$C0 |
||
8210 | 15 B0 12 C0 |
||
8211 | 10039 ; MP[2] = 8.944630806357575461578107295909719817253E6 |
||
8212 | 10040 F86E3E 20 48 52 E0 BA .DB $20,$48,$52,$E0,$BA,$5E,$BC,$44,$7D |
||
8213 | 5E BC 44 7D |
||
8214 | 10041 F86E47 37 73 6D CE F6 .DB $37,$73,$6D,$CE,$F6,$7B,$88,$16,$40 |
||
8215 | 7B 88 16 40 |
||
8216 | 10042 ; MP[1] = -5.722847283900608941516165725053359168840E7 |
||
8217 | 10043 F86E50 7C BD E1 4B F3 .DB $7C,$BD,$E1,$4B,$F3,$59,$CC,$B5,$CB |
||
8218 | 59 CC B5 CB |
||
8219 | 10044 F86E59 98 46 B2 35 2E .DB $98,$46,$B2,$35,$2E,$4F,$DA,$18,$C0 |
||
8220 | 4F DA 18 C0 |
||
8221 | 10045 ; MP[0] = 2.943520915569954073888921213330863757240E8 |
||
8222 | 10046 F86E62 12 F3 2E 3D 05 .DB $12,$F3,$2E,$3D,$05,$16,$56,$0F,$16 |
||
8223 | 16 56 0F 16 |
||
8224 | 10047 F86E6B 02 BA 74 DC A6 .DB $02,$BA,$74,$DC,$A6,$5B,$8C,$1B,$40 |
||
8225 | 5B 8C 1B 40 |
||
8226 | 10048 |
||
8227 | 10049 F86E74 cem1q: |
||
8228 | 10050 ; MQ[7] = -8.802340681794263968892934703309274564037E1 |
||
8229 | 10051 F86E74 5B 7E 65 0F E1 .DB $5B,$7E,$65,$0F,$E1,$0C,$75,$92,$24 |
||
8230 | 0C 75 92 24 |
||
8231 | 10052 F86E7D 56 22 7B FA FB .DB $56,$22,$7B,$FA,$FB,$0B,$B0,$05,$C0 |
||
8232 | 0B B0 05 C0 |
||
8233 | 10053 ; MQ[6] = 3.697714952261803935521187272204485251835E3 |
||
8234 | 10054 F86E86 FE 14 1F B8 5A .DB $FE,$14,$1F,$B8,$5A,$2E,$44,$50,$D9 |
||
8235 | 2E 44 50 D9 |
||
8236 | 10055 F86E8F 62 6A C8 71 70 .DB $62,$6A,$C8,$71,$70,$1B,$E7,$0A,$40 |
||
8237 | 1B E7 0A 40 |
||
8238 | 10056 ; MQ[5] = -9.615511549171441430850103489315371768998E4 |
||
8239 | 10057 F86E98 D6 13 D7 2D 65 .DB $D6,$13,$D7,$2D,$65,$3A,$0E,$9C,$28 |
||
8240 | 3A 0E 9C 28 |
||
8241 | 10058 F86EA1 2F B8 6E C8 8E .DB $2F,$B8,$6E,$C8,$8E,$CD,$BB,$0F,$C0 |
||
8242 | CD BB 0F C0 |
||
8243 | 10059 ; MQ[4] = 1.682912729190313538934190635536631941751E6 |
||
8244 | 10060 F86EAA 02 77 B9 68 7D .DB $02,$77,$B9,$68,$7D,$29,$95,$7B,$AD |
||
8245 | 29 95 7B AD |
||
8246 | 10061 F86EB3 29 BB 61 D5 05 .DB $29,$BB,$61,$D5,$05,$6F,$CD,$13,$40 |
||
8247 | Tue Jul 17 11:00:18 2018 Page 134 |
||
8248 | |||
8249 | |||
8250 | |||
8251 | |||
8252 | 6F CD 13 40 |
||
8253 | 10062 ; MQ[3] = -2.019684072836541751428967854947019415698E7 |
||
8254 | 10063 F86EBC CB B8 14 C8 CF .DB $CB,$B8,$14,$C8,$CF,$E5,$F5,$70,$E1 |
||
8255 | E5 F5 70 E1 |
||
8256 | 10064 F86EC5 F7 13 3B 5D F4 .DB $F7,$13,$3B,$5D,$F4,$16,$9A,$17,$C0 |
||
8257 | 16 9A 17 C0 |
||
8258 | 10065 ; MQ[2] = 1.615869009634292424463780387327037251069E8 |
||
8259 | 10066 F86ECE 1C 14 94 07 23 .DB $1C,$14,$94,$07,$23,$62,$73,$13,$05 |
||
8260 | 62 73 13 05 |
||
8261 | 10067 F86ED7 C8 34 6A 4F ED .DB $C8,$34,$6A,$4F,$ED,$19,$9A,$1A,$40 |
||
8262 | 19 9A 1A 40 |
||
8263 | 10068 ; MQ[1] = -7.848989743695296475743081255027098295771E8 |
||
8264 | 10069 F86EE0 DC 5E 0D 28 3F .DB $DC,$5E,$0D,$28,$3F,$32,$AD,$EF,$DC |
||
8265 | 32 AD EF DC |
||
8266 | 10070 F86EE9 FA 65 7A 79 6E .DB $FA,$65,$7A,$79,$6E,$22,$BB,$1C,$C0 |
||
8267 | 22 BB 1C C0 |
||
8268 | 10071 ; MQ[0] = 1.766112549341972444333352727998584753865E9 |
||
8269 | 10072 F86EF2 D0 35 67 DC 07 .DB $D0,$35,$67,$DC,$07,$21,$01,$17,$21 |
||
8270 | 21 01 17 21 |
||
8271 | 10073 F86EFB 03 17 AF 4A 7A .DB $03,$17,$AF,$4A,$7A,$89,$D2,$1D,$40 |
||
8272 | 89 D2 1D 40 |
||
8273 | 10074 |
||
8274 | 10075 ; maxln = 11356.523406294143949491931077970764 |
||
8275 | 10076 ; above this value, exp(x) overflow |
||
8276 | 10077 F86F04 00 80 F2 03 98 maxln: .DB $00,$80,$F2,$03,$98,$B3,$E3,$C9,$AB |
||
8277 | B3 E3 C9 AB |
||
8278 | 10078 F86F0D 79 CF D1 F7 17 .DB $79,$CF,$D1,$F7,$17,$72,$B1,$0C,$40 |
||
8279 | 72 B1 0C 40 |
||
8280 | 10079 |
||
8281 | 10080 ; minln = -1.143276959615573793352782661133116431383730e4 |
||
8282 | 10081 ; below this value, exp(x) underflow |
||
8283 | 10082 F86F16 45 C0 39 B1 F4 minln: .DB $45,$C0,$39,$B1,$F4,$B2,$26,$E9,$44 |
||
8284 | B2 26 E9 44 |
||
8285 | 10083 F86F1F 16 C0 03 11 14 .DB $16,$C0,$03,$11,$14,$A3,$B2,$0C,$C0 |
||
8286 | A3 B2 0C C0 |
||
8287 | 10084 |
||
8288 | 10085 ; min. argument for expm1() -- below this value expm1() = -1 |
||
8289 | 10086 ; mxm1 = loge(2^-114) = -7.9018778583833765273564461846232128760607E1 |
||
8290 | 10087 F86F28 00 80 84 63 F3 mxm1: .DB $00,$80,$84,$63,$F3,$CB,$CE,$FF,$5C |
||
8291 | CB CE FF 5C |
||
8292 | 10088 F86F31 C8 DC B6 58 9D .DB $C8,$DC,$B6,$58,$9D,$09,$9E,$05,$C0 |
||
8293 | 09 9E 05 C0 |
||
8294 | 10089 |
||
8295 | 10090 ; e = 2.7182818284590452353602874713526623 (35 digits) |
||
8296 | 10091 F86F3A 00 00 3D 27 20 ceul: .DB $00,$00,$3D,$27,$20,$56,$DC,$AF,$9A |
||
8297 | 56 DC AF 9A |
||
8298 | 10092 F86F43 4A BB A2 58 54 .DB $4A,$BB,$A2,$58,$54,$F8,$AD,$00,$40 |
||
8299 | F8 AD 00 40 |
||
8300 | 10093 |
||
8301 | 10094 ; coefficients for exp10() evaluation |
||
8302 | 10095 F86F4C ce10p: |
||
8303 | 10096 ; P[5] = 6.781965388610215141646963666801877147888E1 |
||
8304 | 10097 F86F4C 45 E4 3F 51 CF .DB $45,$E4,$3F,$51,$CF,$31,$82,$DB,$82 |
||
8305 | 31 82 DB 82 |
||
8306 | 10098 F86F55 33 B2 95 AC A9 .DB $33,$B2,$95,$AC,$A9,$A3,$87,$05,$40 |
||
8307 | A3 87 05 40 |
||
8308 | 10099 ; P[4] = 4.930988843306627886355612005613845141123E4 |
||
8309 | Tue Jul 17 11:00:18 2018 Page 135 |
||
8310 | |||
8311 | |||
8312 | |||
8313 | |||
8314 | 10100 F86F5E D5 25 84 99 5A .DB $D5,$25,$84,$99,$5A,$EB,$62,$D1,$4B |
||
8315 | EB 62 D1 4B |
||
8316 | 10101 F86F67 5A 74 59 70 E3 .DB $5A,$74,$59,$70,$E3,$9D,$C0,$0E,$40 |
||
8317 | 9D C0 0E 40 |
||
8318 | 10102 ; P[3] = 9.112966716416345527154611203937593471620E6 |
||
8319 | 10103 F86F70 36 62 7E 7C 7A .DB $36,$62,$7E,$7C,$7A,$40,$20,$E5,$5B |
||
8320 | 40 20 E5 5B |
||
8321 | 10104 F86F79 C6 0F 67 B7 86 .DB $C6,$0F,$67,$B7,$86,$0D,$8B,$16,$40 |
||
8322 | 0D 8B 16 40 |
||
8323 | 10105 ; P[2] = 5.880306836049276068401249115246879608067E8 |
||
8324 | 10106 F86F82 2E 0E F8 F9 5C .DB $2E,$0E,$F8,$F9,$5C,$1D,$B4,$4D,$7F |
||
8325 | 1D B4 4D 7F |
||
8326 | 10107 F86F8B 24 72 6B 6E 8B .DB $24,$72,$6B,$6E,$8B,$32,$8C,$1C,$40 |
||
8327 | 32 8C 1C 40 |
||
8328 | 10108 ; P[1] = 1.294143447497151402129871056524193102276E10 |
||
8329 | 10109 F86F94 63 CA AF 6C 10 .DB $63,$CA,$AF,$6C,$10,$94,$56,$45,$25 |
||
8330 | 94 56 45 25 |
||
8331 | 10110 F86F9D 49 2D BE 9A A7 .DB $49,$2D,$BE,$9A,$A7,$D7,$C0,$20,$40 |
||
8332 | D7 C0 20 40 |
||
8333 | 10111 ; P[0] = 6.737236378815985929063482575381049393067E10 |
||
8334 | 10112 F86FA6 DC 96 E7 F7 15 .DB $DC,$96,$E7,$F7,$15,$39,$D0,$93,$9D |
||
8335 | 39 D0 93 9D |
||
8336 | 10113 F86FAF C8 8E C2 00 4B .DB $C8,$8E,$C2,$00,$4B,$FB,$FA,$22,$40 |
||
8337 | FB FA 22 40 |
||
8338 | 10114 |
||
8339 | 10115 F86FB8 ce10q: |
||
8340 | 10116 ; Q[5] = 2.269602544366008200564158516293459788943E3 |
||
8341 | 10117 F86FB8 58 5C 11 75 0B .DB $58,$5C,$11,$75,$0B,$63,$2E,$D1,$F3 |
||
8342 | 63 2E D1 F3 |
||
8343 | 10118 F86FC1 4E A6 8F 05 A4 .DB $4E,$A6,$8F,$05,$A4,$D9,$8D,$0A,$40 |
||
8344 | D9 8D 0A 40 |
||
8345 | 10119 ; Q[4] = 7.712352920905011963059413773034169405418E5 |
||
8346 | 10120 F86FCA 18 FC B0 15 D1 .DB $18,$FC,$B0,$15,$D1,$8B,$DA,$20,$C4 |
||
8347 | 8B DA 20 C4 |
||
8348 | 10121 F86FD3 E1 16 67 AC 34 .DB $E1,$16,$67,$AC,$34,$4A,$BC,$12,$40 |
||
8349 | 4A BC 12 40 |
||
8350 | 10122 ; Q[3] = 8.312829542416079818945631366865677745737E7 |
||
8351 | 10123 F86FDC 22 3B 86 E2 A1 .DB $22,$3B,$86,$E2,$A1,$37,$CF,$01,$8F |
||
8352 | 37 CF 01 8F |
||
8353 | 10124 F86FE5 AA B9 92 ED FC .DB $AA,$B9,$92,$ED,$FC,$8D,$9E,$19,$40 |
||
8354 | 8D 9E 19 40 |
||
8355 | 10125 ; Q[2] = 3.192530874297321568824835872165913128965E9 |
||
8356 | 10126 F86FEE 58 36 A6 B4 D3 .DB $58,$36,$A6,$B4,$D3,$61,$82,$7F,$2E |
||
8357 | 61 82 7F 2E |
||
8358 | 10127 F86FF7 44 1D 4C BA 27 .DB $44,$1D,$4C,$BA,$27,$4A,$BE,$1E,$40 |
||
8359 | 4A BE 1E 40 |
||
8360 | 10128 ; Q[1] = 3.709588725051672862074295071447979432510E10 |
||
8361 | 10129 F87000 D8 CE E2 0B 30 .DB $D8,$CE,$E2,$0B,$30,$77,$F8,$EF,$3A |
||
8362 | 77 F8 EF 3A |
||
8363 | 10130 F87009 85 44 28 19 65 .DB $85,$44,$28,$19,$65,$31,$8A,$22,$40 |
||
8364 | 31 8A 22 40 |
||
8365 | 10131 ; Q[0] = 5.851889165195258152098281616369230806944E10 |
||
8366 | 10132 F87012 58 7C 65 00 31 .DB $58,$7C,$65,$00,$31,$77,$52,$F6,$1E |
||
8367 | 77 52 F6 1E |
||
8368 | 10133 F8701B C6 3D 3F C8 F6 .DB $C6,$3D,$3F,$C8,$F6,$FF,$D9,$22,$40 |
||
8369 | FF D9 22 40 |
||
8370 | 10134 |
||
8371 | Tue Jul 17 11:00:18 2018 Page 136 |
||
8372 | |||
8373 | |||
8374 | |||
8375 | |||
8376 | 10135 ; log10(2) = lg102a + lg102b = 3.0102999566398119521373889e-1 |
||
8377 | 10136 ; lg102a = 3.01025390625e-1 |
||
8378 | 10137 F87024 00 00 00 00 00 lg102a: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
8379 | 00 00 00 00 |
||
8380 | 10138 F8702D 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$20,$9A,$FD,$3F |
||
8381 | 20 9A FD 3F |
||
8382 | 10139 ; lg102b = 4.6050389811952137388947244930267681898814621E-6 |
||
8383 | 10140 F87036 AC 26 78 91 7C lg102b: .DB $AC,$26,$78,$91,$7C,$0B,$AC,$59,$89 |
||
8384 | 0B AC 59 89 |
||
8385 | 10141 F8703F 8F 98 F7 CF FB .DB $8F,$98,$F7,$CF,$FB,$84,$9A,$ED,$3F |
||
8386 | 84 9A ED 3F |
||
8387 | 10142 |
||
8388 | 10143 ; log2(10) = 3.321928094887362347870319429489390175864831 |
||
8389 | 10144 F87048 4C DB AF 4D FF lg210: .DB $4C,$DB,$AF,$4D,$FF,$F6,$2B,$49,$FE |
||
8390 | F6 2B 49 FE |
||
8391 | 10145 F87051 8A 1B CD 4B 78 .DB $8A,$1B,$CD,$4B,$78,$9A,$D4,$00,$40 |
||
8392 | 9A D4 00 40 |
||
8393 | 10146 |
||
8394 | 10147 ; maxl10 = 4.9320754489586679023818980511660936429E3 |
||
8395 | 10148 F8705A 00 80 7C 0B AC maxl10: .DB $00,$80,$7C,$0B,$AC,$59,$89,$8F,$98 |
||
8396 | 59 89 8F 98 |
||
8397 | 10149 F87063 F7 CF FB 84 9A .DB $F7,$CF,$FB,$84,$9A,$20,$9A,$0B,$40 |
||
8398 | 20 9A 0B 40 |
||
8399 | 10150 ; minl10 = -4.932075448958667902381898051166093750570023E3 |
||
8400 | 10151 F8706C 77 91 7C 0B AC minl10: .DB $77,$91,$7C,$0B,$AC,$59,$89,$8F,$98 |
||
8401 | 59 89 8F 98 |
||
8402 | 10152 F87075 F7 CF FB 84 9A .DB $F7,$CF,$FB,$84,$9A,$20,$9A,$0B,$C0 |
||
8403 | 20 9A 0B C0 |
||
8404 | 10153 |
||
8405 | 10154 ; coefficients for exp2() evaluation |
||
8406 | 10155 F8707E ce2p: |
||
8407 | 10156 ; P[4] = 1.587171580015525194694938306936721666031E2 |
||
8408 | 10157 F8707E 72 92 38 9A 50 .DB $72,$92,$38,$9A,$50,$06,$08,$65,$04 |
||
8409 | 06 08 65 04 |
||
8410 | 10158 F87087 98 BB B2 AA 97 .DB $98,$BB,$B2,$AA,$97,$B7,$9E,$06,$40 |
||
8411 | B7 9E 06 40 |
||
8412 | 10159 ; P[3] = 6.185032670011643762127954396427045467506E5 |
||
8413 | 10160 F87090 D2 BC B4 93 EB .DB $D2,$BC,$B4,$93,$EB,$21,$7F,$08,$D6 |
||
8414 | 21 7F 08 D6 |
||
8415 | 10161 F87099 4F 03 A3 45 74 .DB $4F,$03,$A3,$45,$74,$00,$97,$12,$40 |
||
8416 | 00 97 12 40 |
||
8417 | 10162 ; P[2] = 5.677513871931844661829755443994214173883E8 |
||
8418 | 10163 F870A2 42 4D E3 47 3D .DB $42,$4D,$E3,$47,$3D,$36,$86,$67,$11 |
||
8419 | 36 86 67 11 |
||
8420 | 10164 F870AB 26 D2 C5 6C CB .DB $26,$D2,$C5,$6C,$CB,$5C,$87,$1C,$40 |
||
8421 | 5C 87 1C 40 |
||
8422 | 10165 ; P[1] = 1.530625323728429161131811299626419117557E11 |
||
8423 | 10166 F870B4 7D 20 45 D0 EE .DB $7D,$20,$45,$D0,$EE,$9C,$89,$CD,$66 |
||
8424 | 9C 89 CD 66 |
||
8425 | 10167 F870BD 25 5F 53 94 F3 .DB $25,$5F,$53,$94,$F3,$8C,$8E,$24,$40 |
||
8426 | 8C 8E 24 40 |
||
8427 | 10168 ; P[0] = 9.079594442980146270952372234833529694788E12 |
||
8428 | 10169 F870C6 FF EB 3C 5D 44 .DB $FF,$EB,$3C,$5D,$44,$B2,$CC,$35,$20 |
||
8429 | B2 CC 35 20 |
||
8430 | 10170 F870CF 57 42 0E 06 20 .DB $57,$42,$0E,$06,$20,$20,$84,$2A,$40 |
||
8431 | 20 84 2A 40 |
||
8432 | 10171 |
||
8433 | Tue Jul 17 11:00:18 2018 Page 137 |
||
8434 | |||
8435 | |||
8436 | |||
8437 | |||
8438 | 10172 F870D8 ce2q: |
||
8439 | 10173 ; Q[4] = 1.236602014442099053716561665053645270207E4 |
||
8440 | 10174 F870D8 5F 7D C4 10 CE .DB $5F,$7D,$C4,$10,$CE,$91,$ED,$64,$A4 |
||
8441 | 91 ED 64 A4 |
||
8442 | 10175 F870E1 67 35 BD A0 14 .DB $67,$35,$BD,$A0,$14,$38,$C1,$0C,$40 |
||
8443 | 38 C1 0C 40 |
||
8444 | 10176 ; Q[3] = 2.186249607051644894762167991800811827835E7 |
||
8445 | 10177 F870EA 15 9B 5C BC E3 .DB $15,$9B,$5C,$BC,$E3,$D1,$FC,$B0,$07 |
||
8446 | D1 FC B0 07 |
||
8447 | 10178 F870F3 D9 AE 06 09 30 .DB $D9,$AE,$06,$09,$30,$CC,$A6,$17,$40 |
||
8448 | CC A6 17 40 |
||
8449 | 10179 ; Q[2] = 1.092141473886177435056423606755843616331E10 |
||
8450 | 10180 F870FC C8 3E E7 04 F9 .DB $C8,$3E,$E7,$04,$F9,$42,$1F,$0D,$9B |
||
8451 | 42 1F 0D 9B |
||
8452 | 10181 F87105 4F 27 B7 14 E4 .DB $4F,$27,$B7,$14,$E4,$BD,$A2,$20,$40 |
||
8453 | BD A2 20 40 |
||
8454 | 10182 ; Q[1] = 1.490560994263653042761789432690793026977E12 |
||
8455 | 10183 F8710E 64 87 EE 32 85 .DB $64,$87,$EE,$32,$85,$37,$63,$BC,$E7 |
||
8456 | 37 63 BC E7 |
||
8457 | 10184 F87117 96 D3 EB E5 2D .DB $96,$D3,$EB,$E5,$2D,$86,$AD,$27,$40 |
||
8458 | 86 AD 27 40 |
||
8459 | 10185 ; Q[0] = 2.619817175234089411411070339065679229869E13 |
||
8460 | 10186 F87120 68 99 1A 49 CE .DB $68,$99,$1A,$49,$CE,$E7,$82,$4C,$25 |
||
8461 | E7 82 4C 25 |
||
8462 | 10187 F87129 27 A7 BC C4 E5 .DB $27,$A7,$BC,$C4,$E5,$9D,$BE,$2B,$40 |
||
8463 | 9D BE 2B 40 |
||
8464 | 10188 |
||
8465 | 10189 ; maxl2 = 16384 |
||
8466 | 10190 F87132 00 00 00 00 00 maxl2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
8467 | 00 00 00 00 |
||
8468 | 10191 F8713B 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$0D,$40 |
||
8469 | 00 80 0D 40 |
||
8470 | 10192 ; minl2 = -16494 |
||
8471 | 10193 F87144 00 00 00 00 00 minl2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
8472 | 00 00 00 00 |
||
8473 | 10194 F8714D 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$DC,$80,$0D,$C0 |
||
8474 | DC 80 0D C0 |
||
8475 | 10195 |
||
8476 | 10196 |
||
8477 | 10197 ;--------------------------------------------------------------------------- |
||
8478 | 10198 ; circular functions & inverse circular functions |
||
8479 | 10199 ;--------------------------------------------------------------------------- |
||
8480 | 10200 |
||
8481 | 10201 ; fcos - returns the circular cosine of the radian argument x |
||
8482 | 10202 ; |
||
8483 | 10203 ; entry: |
||
8484 | 10204 ; fac = x (|x| < 2^56) |
||
8485 | 10205 ; |
||
8486 | 10206 ; exit: |
||
8487 | 10207 ; fac = cos(x) |
||
8488 | 10208 ; CF = 1 if invalid result (nan, if x is too large) |
||
8489 | 10209 ; |
||
8490 | 10210 ; computation mean time: 70ms at 4MHz |
||
8491 | 10211 ; |
||
8492 | 10212 ;---- |
||
8493 | 10213 F87156 fcos: |
||
8494 | 10214 ;---- |
||
8495 | Tue Jul 17 11:00:18 2018 Page 138 |
||
8496 | |||
8497 | |||
8498 | |||
8499 | |||
8500 | 10215 F87156 64 CF stz fpcsgn ; positive sign |
||
8501 | 10216 F87158 64 24 stz facsgn ; make argument positive |
||
8502 | 10217 F8715A 20 05 72 jsr modpi4 ; reduce argument: z = x - k*(pi/4) |
||
8503 | 10218 F8715D A5 CE lda fpoct ; octant |
||
8504 | 10219 F8715F C9 04 cmp #4 |
||
8505 | 10220 F87161 90 0A bcc ?ok ; no change |
||
8506 | 10221 F87163 AA tax |
||
8507 | 10222 F87164 A5 CF lda fpcsgn ; invert sign |
||
8508 | 10223 F87166 49 FF eor #$FF |
||
8509 | 10224 F87168 85 CF sta fpcsgn |
||
8510 | 10225 F8716A 8A txa |
||
8511 | 10226 F8716B E9 04 sbc #4 ; reflect in x axis |
||
8512 | 10227 F8716D C9 02 ?ok: cmp #2 |
||
8513 | 10228 F8716F 90 0A bcc ?ok2 |
||
8514 | 10229 F87171 AA tax |
||
8515 | 10230 F87172 A5 CF lda fpcsgn ; invert sign |
||
8516 | 10231 F87174 49 FF eor #$FF |
||
8517 | 10232 F87176 85 CF sta fpcsgn |
||
8518 | 10233 F87178 8A txa |
||
8519 | 10234 F87179 C9 02 cmp #2 |
||
8520 | 10235 F8717B F0 04 ?ok2: beq ?s0 ; octant = 2 |
||
8521 | 10236 F8717D C9 01 cmp #1 |
||
8522 | 10237 F8717F D0 05 bne ?s1 |
||
8523 | 10238 F87181 20 C0 71 ?s0: jsr sinz ; 1 & 2nd octant: sinz |
||
8524 | 10239 F87184 80 2E bra sincos |
||
8525 | 10240 F87186 20 DB 71 ?s1: jsr cosz ; 0 & 3nd octant: cosz |
||
8526 | 10241 F87189 80 29 bra sincos |
||
8527 | 10242 |
||
8528 | 10243 ; fsin - returns the circular sine of the radian argument x |
||
8529 | 10244 ; |
||
8530 | 10245 ; entry: |
||
8531 | 10246 ; fac = x (|x| < 2^56) |
||
8532 | 10247 ; |
||
8533 | 10248 ; exit: |
||
8534 | 10249 ; fac = sin(x) |
||
8535 | 10250 ; CF = 1 if invalid result (nan, if x is too large) |
||
8536 | 10251 ; |
||
8537 | 10252 ; computation mean time: 70ms at 4MHz |
||
8538 | 10253 ; |
||
8539 | 10254 ;---- |
||
8540 | 10255 F8718B fsin: |
||
8541 | 10256 ;---- |
||
8542 | 10257 F8718B A5 24 lda facsgn ; save sign... |
||
8543 | 10258 F8718D 85 CF sta fpcsgn |
||
8544 | 10259 F8718F 64 24 stz facsgn ; ...and make argument positive |
||
8545 | 10260 F87191 20 05 72 jsr modpi4 ; reduce argument: z = x - k*(pi/4) |
||
8546 | 10261 F87194 A5 CE lda fpoct ; octant |
||
8547 | 10262 F87196 C9 04 cmp #4 |
||
8548 | 10263 F87198 90 0A bcc ?ok ; no change |
||
8549 | 10264 F8719A AA tax |
||
8550 | 10265 F8719B A5 CF lda fpcsgn ; invert sign |
||
8551 | 10266 F8719D 49 FF eor #$FF |
||
8552 | 10267 F8719F 85 CF sta fpcsgn |
||
8553 | 10268 F871A1 8A txa |
||
8554 | 10269 F871A2 E9 04 sbc #4 ; reflect in x axis |
||
8555 | 10270 F871A4 C9 01 ?ok: cmp #1 |
||
8556 | 10271 F871A6 F0 04 beq ?s0 |
||
8557 | Tue Jul 17 11:00:18 2018 Page 139 |
||
8558 | |||
8559 | |||
8560 | |||
8561 | |||
8562 | 10272 F871A8 C9 02 cmp #2 |
||
8563 | 10273 F871AA D0 05 bne ?s1 |
||
8564 | 10274 F871AC 20 DB 71 ?s0: jsr cosz ; 1 & 2nd octant: cosz |
||
8565 | 10275 F871AF 80 03 bra sincos |
||
8566 | 10276 F871B1 20 C0 71 ?s1: jsr sinz ; 0 & 3nd octant: sinz |
||
8567 | 10277 |
||
8568 | 10278 F871B4 sincos: |
||
8569 | 10279 F871B4 24 CF bit fpcsgn |
||
8570 | 10280 F871B6 10 06 bpl ?end |
||
8571 | 10281 F871B8 A5 24 lda facsgn ; sign inversion |
||
8572 | 10282 F871BA 49 FF eor #$FF |
||
8573 | 10283 F871BC 85 24 sta facsgn |
||
8574 | 10284 F871BE 18 ?end: clc |
||
8575 | 10285 F871BF 60 rts |
||
8576 | 10286 |
||
8577 | 10287 ; sinz - evaluates the sine of the reduced argument |
||
8578 | 10288 ; |
||
8579 | 10289 ; 3 2 |
||
8580 | 10290 ; sin(z) = z + z * P(z ) |
||
8581 | 10291 ; |
||
8582 | 10292 ;---- |
||
8583 | 10293 F871C0 sinz: |
||
8584 | 10294 ;---- |
||
8585 | 10295 F871C0 A9 AD lda #<psin |
||
8586 | 10296 F871C2 A0 75 ldy #>psin |
||
8587 | 10297 F871C4 A2 0B ldx #11 |
||
8588 | 10298 F871C6 20 1C 87 jsr peval ; fac=P(z*z) |
||
8589 | 10299 F871C9 20 CE 85 jsr mvt0_a ; z*z |
||
8590 | 10300 F871CC 20 DD 49 jsr fpmult |
||
8591 | 10301 F871CF 20 FB 85 jsr mvt1_a ; z |
||
8592 | 10302 F871D2 20 DD 49 jsr fpmult ; (z^3) * P(z*z) |
||
8593 | 10303 F871D5 20 FB 85 jsr mvt1_a ; z |
||
8594 | 10304 F871D8 4C 7D 45 jmp fpadd ; z + (z^3) * P(z*z) |
||
8595 | 10305 |
||
8596 | 10306 ; cosz - evaluates cosine of reduced argument |
||
8597 | 10307 ; |
||
8598 | 10308 ; 1 2 4 2 |
||
8599 | 10309 ; cos(z) = 1 - --- * z + z * P(z ) |
||
8600 | 10310 ; 2 |
||
8601 | 10311 ; |
||
8602 | 10312 ;---- |
||
8603 | 10313 F871DB cosz: |
||
8604 | 10314 ;---- |
||
8605 | 10315 F871DB A9 85 lda #<pcos |
||
8606 | 10316 F871DD A0 76 ldy #>pcos |
||
8607 | 10317 F871DF A2 0A ldx #10 |
||
8608 | 10318 F871E1 20 1C 87 jsr peval ; fac=P(z*z) |
||
8609 | 10319 F871E4 20 CE 85 jsr mvt0_a ; z*z |
||
8610 | 10320 F871E7 20 DD 49 jsr fpmult |
||
8611 | 10321 F871EA 20 CE 85 jsr mvt0_a ; z*z |
||
8612 | 10322 F871ED 20 DD 49 jsr fpmult |
||
8613 | 10323 F871F0 20 6C 45 jsr faddone ; 1 + (z^4) * P(z*z) |
||
8614 | 10324 F871F3 20 39 84 jsr mvftoa ; move to arg |
||
8615 | 10325 F871F6 20 47 85 jsr mvt0_f ; z*z |
||
8616 | 10326 F871F9 A9 FF lda #$FF |
||
8617 | 10327 F871FB 85 46 sta scexp |
||
8618 | 10328 F871FD 85 47 sta scexp+1 |
||
8619 | Tue Jul 17 11:00:18 2018 Page 140 |
||
8620 | |||
8621 | |||
8622 | |||
8623 | |||
8624 | 10329 F871FF 20 B7 48 jsr fscale ; z*z/2 |
||
8625 | 10330 F87202 4C 5F 45 jmp fpsub ; 1 - (z*z/2) + (z^4) * P(z*z) |
||
8626 | 10331 |
||
8627 | 10332 ; modpi4 - argument reduction modulo pi/4 |
||
8628 | 10333 ; |
||
8629 | 10334 ; entry: |
||
8630 | 10335 ; fac = x |
||
8631 | 10336 ; |
||
8632 | 10337 ; exit: |
||
8633 | 10338 ; tfr1 = z, reduced argument in interval [0, pi/4] |
||
8634 | 10339 ; fac = tfr0 = z*z |
||
8635 | 10340 ; fpoct = octant modulo 360 degrees (0..7) |
||
8636 | 10341 ; |
||
8637 | 10342 ; If argument is invalid this function return CF=1 and skip the |
||
8638 | 10343 ; return address. |
||
8639 | 10344 ; |
||
8640 | 10345 ; If |x| >= 2^56 the reduction fail due to a large precision loss |
||
8641 | 10346 ; computing the modulo pi/4 of the argument (returns nan) |
||
8642 | 10347 ; |
||
8643 | 10348 ; The reduction error is nearly eliminated by contriving an extended |
||
8644 | 10349 ; precision modular arithmetic |
||
8645 | 10350 ; |
||
8646 | 10351 ;------ |
||
8647 | 10352 F87205 modpi4: |
||
8648 | 10353 ;------ |
||
8649 | 10354 F87205 24 25 bit facst |
||
8650 | 10355 F87207 30 0B bmi ?er ; fac=nan or inf |
||
8651 | 10356 F87209 ACC16 |
||
8652 | 10357 F87209 C2 20 rep #PMFLAG |
||
8653 | 10358 .LONGA on |
||
8654 | 10359 .MNLIST |
||
8655 | 10360 F8720B A5 22 lda facexp |
||
8656 | 10361 F8720D C9 37 40 cmp #BIAS56 ; compare vs. 2^56 |
||
8657 | 10362 F87210 ACC08 |
||
8658 | 10363 F87210 E2 20 sep #PMFLAG |
||
8659 | 10364 .LONGA off |
||
8660 | 10365 .MNLIST |
||
8661 | 10366 F87212 90 0B bcc ?ok ; if too large returns nan |
||
8662 | 10367 F87214 20 74 4E ?er: jsr fldnan |
||
8663 | 10368 F87217 A5 CF lda fpcsgn |
||
8664 | 10369 F87219 85 24 sta facsgn |
||
8665 | 10370 F8721B 68 pla ; skip return address |
||
8666 | 10371 F8721C 68 pla |
||
8667 | 10372 F8721D 38 sec |
||
8668 | 10373 F8721E 60 rts |
||
8669 | 10374 F8721F 20 93 84 ?ok: jsr mvf_t1 ; tfr1=x |
||
8670 | 10375 F87222 A9 81 lda #<cpio4 |
||
8671 | 10376 F87224 A0 77 ldy #>cpio4 |
||
8672 | 10377 F87226 20 0A 4A jsr fcrdiv ; y=x/(pi/4) |
||
8673 | 10378 F87229 20 27 50 jsr floor ; integral part |
||
8674 | 10379 F8722C 20 78 4F jsr uitrunc ; convert to integer in tm |
||
8675 | 10380 ; just 8 bit value we need here |
||
8676 | 10381 F8722F A5 00 lda tm ; map zeros to origin |
||
8677 | 10382 F87231 4A lsr a |
||
8678 | 10383 F87232 90 05 bcc ?no |
||
8679 | 10384 F87234 E6 00 inc tm |
||
8680 | 10385 F87236 20 6C 45 jsr faddone ; y=y+1 |
||
8681 | Tue Jul 17 11:00:18 2018 Page 141 |
||
8682 | |||
8683 | |||
8684 | |||
8685 | |||
8686 | 10386 F87239 A5 00 ?no: lda tm |
||
8687 | 10387 F8723B 29 07 and #$07 ; octant modulo 360 degrees... |
||
8688 | 10388 F8723D 85 CE sta fpoct ; ...for tests on the phase angle |
||
8689 | 10389 F8723F 20 C0 84 jsr mvf_t2 ; tfr2=y |
||
8690 | 10390 F87242 |
||
8691 | 10391 ; computes z = x - y*(pi/4) with extended precision modular arithmetic |
||
8692 | 10392 F87242 A9 4B lda #<cdp1 |
||
8693 | 10393 F87244 A0 77 ldy #>cdp1 |
||
8694 | 10394 F87246 20 D5 49 jsr fcmult ; y*cdp1 |
||
8695 | 10395 F87249 20 FB 85 jsr mvt1_a ; arg=x |
||
8696 | 10396 F8724C 20 5F 45 jsr fpsub ; x=x-y*cdp1 |
||
8697 | 10397 F8724F 20 93 84 jsr mvf_t1 ; tfr1=x |
||
8698 | 10398 F87252 20 A1 85 jsr mvt2_f ; fac=y |
||
8699 | 10399 F87255 A9 5D lda #<cdp2 |
||
8700 | 10400 F87257 A0 77 ldy #>cdp2 |
||
8701 | 10401 F87259 20 D5 49 jsr fcmult ; y*cdp2 |
||
8702 | 10402 F8725C 20 FB 85 jsr mvt1_a ; arg=x |
||
8703 | 10403 F8725F 20 5F 45 jsr fpsub ; x=x-y*cdp1-y*cdp2 |
||
8704 | 10404 F87262 20 93 84 jsr mvf_t1 ; tfr1=x |
||
8705 | 10405 F87265 20 A1 85 jsr mvt2_f ; fac=y |
||
8706 | 10406 F87268 A9 6F lda #<cdp3 |
||
8707 | 10407 F8726A A0 77 ldy #>cdp3 |
||
8708 | 10408 F8726C 20 D5 49 jsr fcmult ; y*cdp3 |
||
8709 | 10409 F8726F 20 FB 85 jsr mvt1_a ; arg=x |
||
8710 | 10410 F87272 20 5F 45 jsr fpsub ; z=x-y*cdp3-y*cdp2-y*cdp1 |
||
8711 | 10411 F87275 20 93 84 jsr mvf_t1 ; tfr1=z=x-k*(pi/4) |
||
8712 | 10412 F87278 20 CC 49 jsr fsquare ; z*z |
||
8713 | 10413 F8727B 4C 66 84 jmp mvf_t0 ; tfr0=z*z |
||
8714 | 10414 |
||
8715 | 10415 ; ftan - returns the circular tangent of the radian argument x |
||
8716 | 10416 ; |
||
8717 | 10417 ; entry: |
||
8718 | 10418 ; fac = x |
||
8719 | 10419 ; |
||
8720 | 10420 ; exit: |
||
8721 | 10421 ; fac = tan(x) |
||
8722 | 10422 ; CF = 1 if invalid result (nan or inf) |
||
8723 | 10423 ; |
||
8724 | 10424 ; strategy |
||
8725 | 10425 ; |
||
8726 | 10426 ; Range reduction is modulo pi/4. A rational function |
||
8727 | 10427 ; x + x^3 P(x^2)/Q(x^2) |
||
8728 | 10428 ; is employed in the basic interval [0, pi/4]. |
||
8729 | 10429 ; |
||
8730 | 10430 ; computation mean time: 70/80ms at 4MHz |
||
8731 | 10431 ; |
||
8732 | 10432 ;---- |
||
8733 | 10433 F8727E ftan: |
||
8734 | 10434 ;---- |
||
8735 | 10435 F8727E A9 00 lda #0 |
||
8736 | 10436 F87280 20 A0 72 jsr tancot ; computes tan(x) |
||
8737 | 10437 F87283 B0 03 bcs ?end ; returns nan |
||
8738 | 10438 F87285 10 01 bpl ?end ; returns finite value (CF=0) |
||
8739 | 10439 F87287 38 sec |
||
8740 | 10440 F87288 60 ?end: rts |
||
8741 | 10441 |
||
8742 | 10442 ; fcotan - returns the circular cotangent of the radian argument x |
||
8743 | Tue Jul 17 11:00:18 2018 Page 142 |
||
8744 | |||
8745 | |||
8746 | |||
8747 | |||
8748 | 10443 ; |
||
8749 | 10444 ; entry: |
||
8750 | 10445 ; fac = x |
||
8751 | 10446 ; |
||
8752 | 10447 ; exit: |
||
8753 | 10448 ; fac = cotan(x) |
||
8754 | 10449 ; CF = 1 if invalid result (nan or inf) |
||
8755 | 10450 ; |
||
8756 | 10451 ; strategy |
||
8757 | 10452 ; |
||
8758 | 10453 ; Range reduction is modulo pi/4. A rational function |
||
8759 | 10454 ; x + x^3 P(x^2)/Q(x^2) |
||
8760 | 10455 ; is employed in the basic interval [0, pi/4]. |
||
8761 | 10456 ; |
||
8762 | 10457 ; computation mean time: 70/80ms at 4MHz |
||
8763 | 10458 ; |
||
8764 | 10459 ;------ |
||
8765 | 10460 F87289 fcotan: |
||
8766 | 10461 ;------ |
||
8767 | 10462 F87289 24 25 bit facst |
||
8768 | 10463 F8728B 30 0D bmi ?nan |
||
8769 | 10464 F8728D 70 0E bvs ?inf ; x = 0 |
||
8770 | 10465 F8728F A9 FF lda #$FF |
||
8771 | 10466 F87291 20 A0 72 jsr tancot ; computes cotan(x) |
||
8772 | 10467 F87294 B0 03 bcs ?end ; return nan |
||
8773 | 10468 F87296 10 01 bpl ?end ; returns finite value (CF=0) |
||
8774 | 10469 F87298 38 sec |
||
8775 | 10470 F87299 60 ?end: rts |
||
8776 | 10471 F8729A 4C 74 4E ?nan: jmp fldnan ; returns nan |
||
8777 | 10472 F8729D 4C 7D 4E ?inf: jmp fldinf ; returns inf |
||
8778 | 10473 F872A0 |
||
8779 | 10474 ; tancot - common routine used computing tan(x) & cotan(x) |
||
8780 | 10475 ; |
||
8781 | 10476 ; entry: |
||
8782 | 10477 ; fac = x |
||
8783 | 10478 ; A = cotangent flag |
||
8784 | 10479 ; |
||
8785 | 10480 ; exit: |
||
8786 | 10481 ; fac = tan(x) or cotan(x) |
||
8787 | 10482 ; CF = 1 if returns nan |
||
8788 | 10483 ; NF = 1 if returns inf |
||
8789 | 10484 ; |
||
8790 | 10485 ;------ |
||
8791 | 10486 F872A0 tancot: |
||
8792 | 10487 ;------ |
||
8793 | 10488 F872A0 85 D0 sta fpcot ; cotangent flag |
||
8794 | 10489 F872A2 A5 24 lda facsgn ; save sign... |
||
8795 | 10490 F872A4 85 CF sta fpcsgn |
||
8796 | 10491 F872A6 64 24 stz facsgn ; ...and make argument positive |
||
8797 | 10492 F872A8 20 05 72 jsr modpi4 ; argument reduction: z = x - k*(pi/4) |
||
8798 | 10493 ; fac=tfr0=z*z=w |
||
8799 | 10494 F872AB A9 DB lda #<ptan |
||
8800 | 10495 F872AD A0 77 ldy #>ptan |
||
8801 | 10496 F872AF A2 05 ldx #5 |
||
8802 | 10497 F872B1 20 1C 87 jsr peval ; evaluate P(w) |
||
8803 | 10498 F872B4 20 CE 85 jsr mvt0_a |
||
8804 | 10499 F872B7 20 DD 49 jsr fpmult ; w*P(w) |
||
8805 | Tue Jul 17 11:00:18 2018 Page 143 |
||
8806 | |||
8807 | |||
8808 | |||
8809 | |||
8810 | 10500 F872BA 20 C0 84 jsr mvf_t2 ; tfr2=w*P(w) |
||
8811 | 10501 F872BD A9 47 lda #<qtan |
||
8812 | 10502 F872BF A0 78 ldy #>qtan |
||
8813 | 10503 F872C1 A2 05 ldx #5 |
||
8814 | 10504 F872C3 20 3A 87 jsr pevalp1 ; evaluate Q(w) |
||
8815 | 10505 F872C6 20 28 86 jsr mvt2_a ; arg=w*P(w) |
||
8816 | 10506 F872C9 20 10 4A jsr fpdiv ; w*P(w)/Q(w) |
||
8817 | 10507 F872CC 20 FB 85 jsr mvt1_a ; arg=z |
||
8818 | 10508 F872CF 20 DD 49 jsr fpmult ; z*w*R(w) |
||
8819 | 10509 F872D2 20 FB 85 jsr mvt1_a ; arg=z |
||
8820 | 10510 F872D5 20 7D 45 jsr fpadd ; z + z*w*R(w) |
||
8821 | 10511 F872D8 A5 CE ?done: lda fpoct ; octant |
||
8822 | 10512 F872DA 29 02 and #$02 |
||
8823 | 10513 F872DC F0 0C beq ?cot |
||
8824 | 10514 F872DE A5 24 lda facsgn |
||
8825 | 10515 F872E0 49 FF eor #$FF |
||
8826 | 10516 F872E2 85 24 sta facsgn ; sign inversion |
||
8827 | 10517 F872E4 24 D0 bit fpcot |
||
8828 | 10518 F872E6 30 09 bmi ?end ; cotan(x) |
||
8829 | 10519 F872E8 80 04 bra ?rec ; tan(x) |
||
8830 | 10520 F872EA 24 D0 ?cot: bit fpcot |
||
8831 | 10521 F872EC 10 03 bpl ?end ; tan(x) |
||
8832 | 10522 F872EE 20 FD 49 ?rec: jsr frecip |
||
8833 | 10523 F872F1 24 CF ?end: bit fpcsgn |
||
8834 | 10524 F872F3 10 06 bpl ?end2 |
||
8835 | 10525 F872F5 A5 24 lda facsgn ; sign inversion |
||
8836 | 10526 F872F7 49 FF eor #$FF |
||
8837 | 10527 F872F9 85 24 sta facsgn |
||
8838 | 10528 F872FB 18 ?end2: clc |
||
8839 | 10529 F872FC 24 25 bit facst ; return N=1 if invalid |
||
8840 | 10530 F872FE 60 rts |
||
8841 | 10531 |
||
8842 | 10532 ; fasin - inverse circular sine: returns radian angle |
||
8843 | 10533 ; between -pi/2 and +pi/2 whose sine is x |
||
8844 | 10534 ; |
||
8845 | 10535 ; entry: |
||
8846 | 10536 ; fac = x |
||
8847 | 10537 ; |
||
8848 | 10538 ; exit: |
||
8849 | 10539 ; fac = asin(x) in domain [-p1/2,+pi/2] |
||
8850 | 10540 ; CF = 1 if returns nan (|x| > 1) |
||
8851 | 10541 ; |
||
8852 | 10542 ; strategy |
||
8853 | 10543 ; |
||
8854 | 10544 ; A rational function of the form x + x^3 P(x^2)/Q(x^2) |
||
8855 | 10545 ; is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is |
||
8856 | 10546 ; transformed by the identity |
||
8857 | 10547 ; |
||
8858 | 10548 ; asin(x) = pi/2 - 2*asin(sqrt((1-x)/2)) |
||
8859 | 10549 ; |
||
8860 | 10550 ; computation mean time: 100/130ms at 4MHz |
||
8861 | 10551 ; |
||
8862 | 10552 ;----- |
||
8863 | 10553 F872FF fasin: |
||
8864 | 10554 ;----- |
||
8865 | 10555 F872FF 24 25 bit facst |
||
8866 | 10556 F87301 30 1C bmi ?nan ; if argument is invalid return nan |
||
8867 | Tue Jul 17 11:00:18 2018 Page 144 |
||
8868 | |||
8869 | |||
8870 | |||
8871 | |||
8872 | 10557 F87303 70 18 bvs ?ok ; if x=0 return 0 |
||
8873 | 10558 F87305 20 24 74 jsr cmpx1 ; compare |x| vs. 1 |
||
8874 | 10559 F87308 B0 15 bcs ?nan ; if |x|>1 return nan |
||
8875 | 10560 F8730A 08 php |
||
8876 | 10561 F8730B A5 24 lda facsgn |
||
8877 | 10562 F8730D 85 CF sta fpcsgn ; save sign(x) |
||
8878 | 10563 F8730F 28 plp |
||
8879 | 10564 F87310 D0 10 bne ?do ; |x|<1 |
||
8880 | 10565 F87312 A9 93 lda #<cpio2 ; |x|=1 so return sgn(x)*pi/2 |
||
8881 | 10566 F87314 A0 77 ldy #>cpio2 |
||
8882 | 10567 F87316 20 82 86 jsr ldfac ; x=pi/2 |
||
8883 | 10568 F87319 A5 CF lda fpcsgn |
||
8884 | 10569 F8731B 85 24 sta facsgn |
||
8885 | 10570 F8731D 18 ?ok: clc |
||
8886 | 10571 F8731E 60 rts |
||
8887 | 10572 F8731F 4C 74 4E ?nan: jmp fldnan |
||
8888 | 10573 F87322 64 24 ?do: stz facsgn ; |x| |
||
8889 | 10574 F87324 64 D0 stz fpasin ; asin flag |
||
8890 | 10575 F87326 20 1B 74 jsr cmpxh ; compare |x| vs. 0.5 |
||
8891 | 10576 F87329 B0 08 bcs ?gt ; |x|>0.5 |
||
8892 | 10577 F8732B 20 93 84 jsr mvf_t1 ; tfr1=z=|x| |
||
8893 | 10578 F8732E 20 CC 49 jsr fsquare ; w=z*z |
||
8894 | 10579 F87331 80 22 bra ?pp |
||
8895 | 10580 F87333 A9 FF ?gt: lda #$FF |
||
8896 | 10581 F87335 85 D0 sta fpasin ; |x| > 0.5 flag |
||
8897 | 10582 F87337 20 9F 4E jsr ldahalf ; arg=0.5 |
||
8898 | 10583 F8733A 20 5F 45 jsr fpsub ; w=0.5-|x| |
||
8899 | 10584 F8733D 20 67 45 jsr faddhalf ; w=1-|x| |
||
8900 | 10585 F87340 A9 FF lda #$FF |
||
8901 | 10586 F87342 85 46 sta scexp |
||
8902 | 10587 F87344 85 47 sta scexp+1 ; divive dy 2 |
||
8903 | 10588 F87346 20 B7 48 jsr fscale ; w=0.5*(1-|x|) |
||
8904 | 10589 F87349 20 C0 84 jsr mvf_t2 ; tfr2=w |
||
8905 | 10590 F8734C 20 53 60 jsr fsqrt ; z=sqrt(w) |
||
8906 | 10591 F8734F 20 93 84 jsr mvf_t1 ; tfr1=z |
||
8907 | 10592 F87352 20 A1 85 jsr mvt2_f ; fac=w |
||
8908 | 10593 F87355 20 66 84 ?pp: jsr mvf_t0 ; tfr0=w |
||
8909 | 10594 F87358 A9 B3 lda #<casp |
||
8910 | 10595 F8735A A0 78 ldy #>casp |
||
8911 | 10596 F8735C A2 09 ldx #9 |
||
8912 | 10597 F8735E 20 1C 87 jsr peval ; P(w) |
||
8913 | 10598 F87361 20 CE 85 jsr mvt0_a ; w |
||
8914 | 10599 F87364 20 DD 49 jsr fpmult ; w*P(w) |
||
8915 | 10600 F87367 20 C0 84 jsr mvf_t2 ; tfr2=w*P(w) |
||
8916 | 10601 F8736A A9 67 lda #<casq |
||
8917 | 10602 F8736C A0 79 ldy #>casq |
||
8918 | 10603 F8736E A2 09 ldx #9 |
||
8919 | 10604 F87370 20 3A 87 jsr pevalp1 ; Q(w) |
||
8920 | 10605 F87373 20 28 86 jsr mvt2_a ; arg=w*P(w) |
||
8921 | 10606 F87376 20 10 4A jsr fpdiv ; w*P(w)/Q(w)=w*R(w) |
||
8922 | 10607 F87379 20 FB 85 jsr mvt1_a ; arg=z |
||
8923 | 10608 F8737C 20 DD 49 jsr fpmult ; z*w*R(w) |
||
8924 | 10609 F8737F 20 FB 85 jsr mvt1_a ; arg=z |
||
8925 | 10610 F87382 20 7D 45 jsr fpadd ; y=z+z*w*R(w) |
||
8926 | 10611 F87385 24 D0 bit fpasin |
||
8927 | 10612 F87387 10 10 bpl ?done ; |x| <= 0.5 |
||
8928 | 10613 F87389 20 39 84 jsr mvftoa |
||
8929 | Tue Jul 17 11:00:18 2018 Page 145 |
||
8930 | |||
8931 | |||
8932 | |||
8933 | |||
8934 | 10614 F8738C 20 7D 45 jsr fpadd ; y+y |
||
8935 | 10615 F8738F A9 93 lda #<cpio2 |
||
8936 | 10616 F87391 A0 77 ldy #>cpio2 |
||
8937 | 10617 F87393 20 CF 86 jsr ldarg ; arg=pi/2 |
||
8938 | 10618 F87396 20 5F 45 jsr fpsub ; pi/2-2*asin(z) |
||
8939 | 10619 F87399 24 CF ?done: bit fpcsgn |
||
8940 | 10620 F8739B 10 06 bpl ?end |
||
8941 | 10621 F8739D A5 24 lda facsgn ; sign inversion |
||
8942 | 10622 F8739F 49 FF eor #$FF |
||
8943 | 10623 F873A1 85 24 sta facsgn |
||
8944 | 10624 F873A3 18 ?end: clc |
||
8945 | 10625 F873A4 60 rts |
||
8946 | 10626 |
||
8947 | 10627 ; facos - inverse circular cosine: returns radian angle |
||
8948 | 10628 ; between 0 and +pi whose cosine is x |
||
8949 | 10629 ; |
||
8950 | 10630 ; entry: |
||
8951 | 10631 ; fac = x |
||
8952 | 10632 ; |
||
8953 | 10633 ; exit: |
||
8954 | 10634 ; fac = acos(x) in domain [0,pi] |
||
8955 | 10635 ; CF = 1 if returns nan (|x| > 1) |
||
8956 | 10636 ; |
||
8957 | 10637 ; strategy |
||
8958 | 10638 ; |
||
8959 | 10639 ; Analytically, acos(x) = pi/2 - asin(x). However if |x| is |
||
8960 | 10640 ; near 1, there is cancellation error in subtracting asin(x) |
||
8961 | 10641 ; from pi/2. Hence if x < -0.5, |
||
8962 | 10642 ; |
||
8963 | 10643 ; acos(x) = pi - 2.0 * asin(sqrt((1+x)/2)) |
||
8964 | 10644 ; |
||
8965 | 10645 ; or if x > +0.5, |
||
8966 | 10646 ; |
||
8967 | 10647 ; acos(x) = 2.0 * asin(sqrt((1-x)/2)) |
||
8968 | 10648 ; |
||
8969 | 10649 ; computation mean time: 100/140ms at 4MHz |
||
8970 | 10650 ; |
||
8971 | 10651 ;----- |
||
8972 | 10652 F873A5 facos: |
||
8973 | 10653 ;----- |
||
8974 | 10654 F873A5 24 25 bit facst |
||
8975 | 10655 F873A7 30 21 bmi ?nan ; if argument is invalid return nan |
||
8976 | 10656 F873A9 70 22 bvs ?pi2 ; if x=0 return pi/2 |
||
8977 | 10657 F873AB 20 24 74 jsr cmpx1 ; compare |x| vs. 1 |
||
8978 | 10658 F873AE B0 1A bcs ?nan ; if |x|>1 return nan |
||
8979 | 10659 F873B0 08 php |
||
8980 | 10660 F873B1 A5 24 lda facsgn |
||
8981 | 10661 F873B3 85 CF sta fpcsgn ; save sign(x) |
||
8982 | 10662 F873B5 28 plp |
||
8983 | 10663 F873B6 D0 20 bne ?do ; |x|<1 |
||
8984 | 10664 F873B8 64 24 stz facsgn ; |x|=1 |
||
8985 | 10665 F873BA 24 CF bit fpcsgn |
||
8986 | 10666 F873BC 10 09 bpl ?z ; x=1 so return 0 |
||
8987 | 10667 F873BE A9 A5 lda #<cpi ; x=-1 so return pi |
||
8988 | 10668 F873C0 A0 77 ldy #>cpi |
||
8989 | 10669 F873C2 20 82 86 jsr ldfac ; x=pi |
||
8990 | 10670 F873C5 18 clc |
||
8991 | Tue Jul 17 11:00:18 2018 Page 146 |
||
8992 | |||
8993 | |||
8994 | |||
8995 | |||
8996 | 10671 F873C6 60 rts |
||
8997 | 10672 F873C7 4C 56 4E ?z: jmp fldz |
||
8998 | 10673 F873CA 4C 74 4E ?nan: jmp fldnan |
||
8999 | 10674 F873CD A9 93 ?pi2: lda #<cpio2 ; |x|=0 so return pi/2 |
||
9000 | 10675 F873CF A0 77 ldy #>cpio2 |
||
9001 | 10676 F873D1 20 82 86 jsr ldfac ; x=pi/2 |
||
9002 | 10677 F873D4 64 24 stz facsgn |
||
9003 | 10678 F873D6 18 ?ok: clc |
||
9004 | 10679 F873D7 60 rts |
||
9005 | 10680 F873D8 20 1B 74 ?do: jsr cmpxh ; compare |x| vs. 0.5 |
||
9006 | 10681 F873DB B0 0D bcs ?gt ; |x|>0.5 |
||
9007 | 10682 F873DD 20 FF 72 jsr fasin ; |x|<=0.5 |
||
9008 | 10683 F873E0 A9 93 lda #<cpio2 |
||
9009 | 10684 F873E2 A0 77 ldy #>cpio2 |
||
9010 | 10685 F873E4 20 CF 86 jsr ldarg ; arg=pi/2 |
||
9011 | 10686 F873E7 4C 5F 45 jmp fpsub ; pi/2-asin(x) if |x|<=0.5 |
||
9012 | 10687 F873EA A5 CF ?gt: lda fpcsgn |
||
9013 | 10688 F873EC 30 04 bmi ?neg |
||
9014 | 10689 F873EE A2 FF ldx #$FF |
||
9015 | 10690 F873F0 86 24 stx facsgn ; x<-0.5 or x>0.5 |
||
9016 | 10691 F873F2 48 ?neg: pha ; save sign |
||
9017 | 10692 F873F3 20 6C 45 jsr faddone ; y=1+x or y=1-x |
||
9018 | 10693 F873F6 A9 FF lda #$FF |
||
9019 | 10694 F873F8 85 46 sta scexp |
||
9020 | 10695 F873FA 85 47 sta scexp+1 |
||
9021 | 10696 F873FC 20 B7 48 jsr fscale ; divide by 2 |
||
9022 | 10697 F873FF 20 53 60 jsr fsqrt ; w=sqrt(y/2) |
||
9023 | 10698 F87402 20 FF 72 jsr fasin |
||
9024 | 10699 F87405 A9 01 lda #1 |
||
9025 | 10700 F87407 85 46 sta scexp |
||
9026 | 10701 F87409 64 47 stz scexp+1 |
||
9027 | 10702 F8740B 20 B7 48 jsr fscale ; multiplies by 2 |
||
9028 | 10703 F8740E 68 pla ; original sign |
||
9029 | 10704 F8740F 10 C5 bpl ?ok ; done: acos(x)=2*asin(w) |
||
9030 | 10705 F87411 A9 A5 lda #<cpi |
||
9031 | 10706 F87413 A0 77 ldy #>cpi |
||
9032 | 10707 F87415 20 CF 86 jsr ldarg ; arg=pi |
||
9033 | 10708 F87418 4C 5F 45 jmp fpsub ; acos(x)=pi-2*asin(w) |
||
9034 | 10709 F8741B |
||
9035 | 10710 |
||
9036 | 10711 ; compare |x| vs. 0.5 - flag's affected |
||
9037 | 10712 ; |
||
9038 | 10713 ; CF=0, ZF=0 if |x| < 0.5 |
||
9039 | 10714 ; CF=0, ZF=1 if |x| = 0.5 |
||
9040 | 10715 ; CF=1, ZF=0 if |x| > 0.5 |
||
9041 | 10716 F8741B cmpxh: |
||
9042 | 10717 F8741B ACC16 |
||
9043 | 10718 F8741B C2 20 rep #PMFLAG |
||
9044 | 10719 .LONGA on |
||
9045 | 10720 .MNLIST |
||
9046 | 10721 F8741D A5 22 lda facexp |
||
9047 | 10722 F8741F C9 FE 3F cmp #EBIAS-1 |
||
9048 | 10723 F87422 80 07 bra cmpx1h |
||
9049 | 10724 F87424 |
||
9050 | 10725 ; compare |x| vs. 1 - flag's affected |
||
9051 | 10726 ; |
||
9052 | 10727 ; CF=0, ZF=0 if |x| < 1 |
||
9053 | Tue Jul 17 11:00:18 2018 Page 147 |
||
9054 | |||
9055 | |||
9056 | |||
9057 | |||
9058 | 10728 ; CF=0, ZF=1 if |x| = 1 |
||
9059 | 10729 ; CF=1, ZF=0 if |x| > 1 |
||
9060 | 10730 F87424 cmpx1: |
||
9061 | 10731 F87424 ACC16 |
||
9062 | 10732 F87424 C2 20 rep #PMFLAG |
||
9063 | 10733 .LONGA on |
||
9064 | 10734 .MNLIST |
||
9065 | 10735 F87426 A5 22 lda facexp |
||
9066 | 10736 F87428 C9 FF 3F cmp #EBIAS |
||
9067 | 10737 F8742B cmpx1h: |
||
9068 | 10738 F8742B 90 1C bcc ?done ; |x|<1, CF=0, ZF=0 |
||
9069 | 10739 F8742D F0 02 beq ?tst |
||
9070 | 10740 F8742F B0 18 bcs ?done ; |x|>1, CF=1, ZF=0 |
||
9071 | 10741 F87431 A5 20 ?tst: lda facm+14 ; should be $8000 |
||
9072 | 10742 F87433 C9 00 80 cmp #$8000 ; here always CF=1 |
||
9073 | 10743 F87436 D0 11 bne ?done ; |x|>1, CF=1, ZF=0 |
||
9074 | 10744 F87438 A5 1E lda facm+12 |
||
9075 | 10745 F8743A 05 1C ora facm+10 |
||
9076 | 10746 F8743C 05 1A ora facm+8 |
||
9077 | 10747 F8743E 05 18 ora facm+6 |
||
9078 | 10748 F87440 05 16 ora facm+4 |
||
9079 | 10749 F87442 05 14 ora facm+2 |
||
9080 | 10750 F87444 05 12 ora facm |
||
9081 | 10751 F87446 D0 01 bne ?done ; |x|>1, CF=1, ZF=0 |
||
9082 | 10752 F87448 18 clc ; |x|=1, CF=0, ZF=1 |
||
9083 | 10753 F87449 ?done: ACC08 |
||
9084 | 10754 F87449 E2 20 sep #PMFLAG |
||
9085 | 10755 .LONGA off |
||
9086 | 10756 .MNLIST |
||
9087 | 10757 F8744B 60 rts |
||
9088 | 10758 |
||
9089 | 10759 ; fatan - inverse circular tangent, returns radian angle |
||
9090 | 10760 ; between -pi/2 and +pi/2 whose tangent is x |
||
9091 | 10761 ; |
||
9092 | 10762 ; entry: |
||
9093 | 10763 ; fac = x |
||
9094 | 10764 ; |
||
9095 | 10765 ; exit: |
||
9096 | 10766 ; fac = atan(x) in domain [-pi/2,pi/2] |
||
9097 | 10767 ; CF = 1 if returns nan |
||
9098 | 10768 ; |
||
9099 | 10769 ; strategy |
||
9100 | 10770 ; |
||
9101 | 10771 ; Range reduction is from four intervals into the interval |
||
9102 | 10772 ; from zero to tan(pi/8). The approximant uses a rational |
||
9103 | 10773 ; function of the form x + x^3 P(x)/Q(x). |
||
9104 | 10774 ; |
||
9105 | 10775 ; computation mean time: 100ms at 4MHz |
||
9106 | 10776 ; |
||
9107 | 10777 ;----- |
||
9108 | 10778 F8744C fatan: |
||
9109 | 10779 ;----- |
||
9110 | 10780 F8744C 24 25 bit facst |
||
9111 | 10781 F8744E 10 13 bpl ?fv ; valid fac |
||
9112 | 10782 F87450 50 0F bvc ?er ; fac=nan so return nan |
||
9113 | 10783 F87452 A5 24 lda facsgn |
||
9114 | 10784 F87454 48 pha |
||
9115 | Tue Jul 17 11:00:18 2018 Page 148 |
||
9116 | |||
9117 | |||
9118 | |||
9119 | |||
9120 | 10785 F87455 A9 93 lda #<cpio2 |
||
9121 | 10786 F87457 A0 77 ldy #>cpio2 |
||
9122 | 10787 F87459 20 82 86 jsr ldfac ; x=pi/2 |
||
9123 | 10788 F8745C 68 pla |
||
9124 | 10789 F8745D 85 24 sta facsgn ; return +/-pi/2 |
||
9125 | 10790 F8745F 18 ?ok: clc |
||
9126 | 10791 F87460 60 rts |
||
9127 | 10792 F87461 38 ?er: sec |
||
9128 | 10793 F87462 60 rts |
||
9129 | 10794 F87463 70 FA ?fv: bvs ?ok ; if fac=0 return 0 |
||
9130 | 10795 F87465 A5 24 lda facsgn ; save sign... |
||
9131 | 10796 F87467 85 CF sta fpcsgn |
||
9132 | 10797 F87469 64 24 stz facsgn ; ...and make argument positive |
||
9133 | 10798 F8746B A9 B7 lda #<ct3p8 |
||
9134 | 10799 F8746D A0 77 ldy #>ct3p8 |
||
9135 | 10800 F8746F 20 5E 87 jsr fccmp ; cmpare x vs. tan(3*pi/8) |
||
9136 | 10801 F87472 10 3E bpl ?gt38 ; fac > tan(3*pi/8) |
||
9137 | 10802 F87474 A9 C9 lda #<ctp8 |
||
9138 | 10803 F87476 A0 77 ldy #>ctp8 |
||
9139 | 10804 F87478 20 5E 87 jsr fccmp ; cmpare x vs. tan(pi/8) |
||
9140 | 10805 F8747B 10 0B bpl ?gt8 ; fac > tan(pi/8) |
||
9141 | 10806 F8747D 20 93 84 jsr mvf_t1 ; tfr1=w=x |
||
9142 | 10807 F87480 20 56 4E jsr fldz |
||
9143 | 10808 F87483 20 C0 84 jsr mvf_t2 ; tfr2=y=0 |
||
9144 | 10809 F87486 80 3E bra ?do |
||
9145 | 10810 F87488 20 66 84 ?gt8: jsr mvf_t0 ; tfr0=x |
||
9146 | 10811 F8748B 20 39 84 jsr mvftoa ; arg=x |
||
9147 | 10812 F8748E 20 32 4E jsr fldm1 ; fac=-1 |
||
9148 | 10813 F87491 20 7D 45 jsr fpadd ; x-1 |
||
9149 | 10814 F87494 20 93 84 jsr mvf_t1 ; tfr1=x-1 |
||
9150 | 10815 F87497 20 47 85 jsr mvt0_f ; fac=x |
||
9151 | 10816 F8749A 20 6C 45 jsr faddone ; x+1 |
||
9152 | 10817 F8749D 20 FB 85 jsr mvt1_a ; arg=x-1 |
||
9153 | 10818 F874A0 20 10 4A jsr fpdiv ; w=(x-1)/(x+1) |
||
9154 | 10819 F874A3 20 93 84 jsr mvf_t1 ; tfr1=w |
||
9155 | 10820 F874A6 A9 81 lda #<cpio4 |
||
9156 | 10821 F874A8 A0 77 ldy #>cpio4 |
||
9157 | 10822 F874AA 20 82 86 jsr ldfac ; pi/4 |
||
9158 | 10823 F874AD 20 C0 84 jsr mvf_t2 ; tfr2=y=pi/4 |
||
9159 | 10824 F874B0 80 14 bra ?do |
||
9160 | 10825 F874B2 20 FD 49 ?gt38: jsr frecip |
||
9161 | 10826 F874B5 A9 FF lda #$FF |
||
9162 | 10827 F874B7 85 24 sta facsgn ; w=-1/x |
||
9163 | 10828 F874B9 20 93 84 jsr mvf_t1 ; tfr1=w=-1/x |
||
9164 | 10829 F874BC A9 93 lda #<cpio2 |
||
9165 | 10830 F874BE A0 77 ldy #>cpio2 |
||
9166 | 10831 F874C0 20 82 86 jsr ldfac ; pi/2 |
||
9167 | 10832 F874C3 20 C0 84 jsr mvf_t2 ; tfr2=y=pi/2 |
||
9168 | 10833 F874C6 20 74 85 ?do: jsr mvt1_f ; fac=w |
||
9169 | 10834 F874C9 20 CC 49 jsr fsquare ; z=w*w |
||
9170 | 10835 F874CC 20 66 84 jsr mvf_t0 ; tfr0=z |
||
9171 | 10836 F874CF A9 1B lda #<catp |
||
9172 | 10837 F874D1 A0 7A ldy #>catp |
||
9173 | 10838 F874D3 A2 08 ldx #8 |
||
9174 | 10839 F874D5 20 1C 87 jsr peval ; P(z) |
||
9175 | 10840 F874D8 20 ED 84 jsr mvf_t3 ; tfr3=P(z) |
||
9176 | 10841 F874DB A9 BD lda #<catq |
||
9177 | Tue Jul 17 11:00:18 2018 Page 149 |
||
9178 | |||
9179 | |||
9180 | |||
9181 | |||
9182 | 10842 F874DD A0 7A ldy #>catq |
||
9183 | 10843 F874DF A2 07 ldx #7 |
||
9184 | 10844 F874E1 20 3A 87 jsr pevalp1 ; Q(z) |
||
9185 | 10845 F874E4 20 55 86 jsr mvt3_a ; arg=P(z) |
||
9186 | 10846 F874E7 20 10 4A jsr fpdiv ; R(z)=P(z)/Q(z) |
||
9187 | 10847 F874EA 20 CE 85 jsr mvt0_a ; arg=z |
||
9188 | 10848 F874ED 20 DD 49 jsr fpmult ; z*R(z) |
||
9189 | 10849 F874F0 20 FB 85 jsr mvt1_a ; arg=w |
||
9190 | 10850 F874F3 20 DD 49 jsr fpmult ; z*w*R(z) |
||
9191 | 10851 F874F6 20 FB 85 jsr mvt1_a ; arg=w |
||
9192 | 10852 F874F9 20 7D 45 jsr fpadd ; w+z*w*R(z) |
||
9193 | 10853 F874FC 20 28 86 jsr mvt2_a ; arg=y |
||
9194 | 10854 F874FF 20 7D 45 jsr fpadd ; y+w+z*w*R(z) |
||
9195 | 10855 F87502 24 CF bit fpcsgn |
||
9196 | 10856 F87504 10 06 bpl ?end |
||
9197 | 10857 F87506 A5 24 lda facsgn |
||
9198 | 10858 F87508 49 FF eor #$FF |
||
9199 | 10859 F8750A 85 24 sta facsgn |
||
9200 | 10860 F8750C 18 ?end: clc |
||
9201 | 10861 F8750D 60 rts |
||
9202 | 10862 |
||
9203 | 10863 ; fatanyx - inverse circular tangent, returns radian angle |
||
9204 | 10864 ; between 0 and 2*pi whose tangent is y/x (computes the phase angle) |
||
9205 | 10865 ; |
||
9206 | 10866 ; entry: |
||
9207 | 10867 ; fac = x |
||
9208 | 10868 ; arg = y |
||
9209 | 10869 ; |
||
9210 | 10870 ; exit: |
||
9211 | 10871 ; fac = z = atan(y/x) in domain [0, 2pi] |
||
9212 | 10872 ; CF = 1 if returns nan |
||
9213 | 10873 ; |
||
9214 | 10874 ; computation mean time: 100ms at 4MHz |
||
9215 | 10875 ; |
||
9216 | 10876 ;------- |
||
9217 | 10877 F8750E fatanyx: |
||
9218 | 10878 ;------- |
||
9219 | 10879 F8750E A2 00 ldx #0 |
||
9220 | 10880 F87510 24 24 bit facsgn |
||
9221 | 10881 F87512 10 02 bpl ?xp ; x >= 0 |
||
9222 | 10882 F87514 A2 02 ldx #2 |
||
9223 | 10883 F87516 24 3C ?xp: bit argsgn |
||
9224 | 10884 F87518 10 01 bpl ?yp ; y >= 0 |
||
9225 | 10885 F8751A E8 inx |
||
9226 | 10886 F8751B 86 10 ?yp: stx atncode |
||
9227 | 10887 F8751D A5 25 lda facst |
||
9228 | 10888 F8751F 29 C0 and #$C0 |
||
9229 | 10889 F87521 C9 80 cmp #$80 |
||
9230 | 10890 F87523 F0 10 beq ?nan ; if x=nan return nan |
||
9231 | 10891 F87525 AA tax |
||
9232 | 10892 F87526 A5 3D lda argst |
||
9233 | 10893 F87528 29 C0 and #$C0 |
||
9234 | 10894 F8752A C9 80 cmp #$80 |
||
9235 | 10895 F8752C F0 07 beq ?nan ; if y=nan return nan |
||
9236 | 10896 F8752E A8 tay |
||
9237 | 10897 F8752F 25 25 and facst |
||
9238 | 10898 F87531 C9 C0 cmp #$C0 ; if x=inf and y=inf return nan |
||
9239 | Tue Jul 17 11:00:18 2018 Page 150 |
||
9240 | |||
9241 | |||
9242 | |||
9243 | |||
9244 | 10899 F87533 D0 03 bne ?x0 |
||
9245 | 10900 F87535 4C 74 4E ?nan: jmp fldnan |
||
9246 | 10901 F87538 E0 40 ?x0: cpx #$40 |
||
9247 | 10902 F8753A D0 25 bne ?xx ; x != 0 |
||
9248 | 10903 F8753C C0 40 cpy #$40 ; y = 0? |
||
9249 | 10904 F8753E F0 1E beq ?zz ; yes, return zero (x = 0, y = 0) |
||
9250 | 10905 F87540 A9 93 ?pi2: lda #<cpio2 |
||
9251 | 10906 F87542 A0 77 ldy #>cpio2 |
||
9252 | 10907 F87544 20 82 86 jsr ldfac ; z = pi/2 |
||
9253 | 10908 F87547 46 10 lsr atncode |
||
9254 | 10909 F87549 90 31 bcc ?ret ; return z = pi/2 |
||
9255 | 10910 F8754B 20 A6 4E jsr ldaone |
||
9256 | 10911 F8754E ACC16 |
||
9257 | 10912 F8754E C2 20 rep #PMFLAG |
||
9258 | 10913 .LONGA on |
||
9259 | 10914 .MNLIST |
||
9260 | 10915 F87550 E6 3A inc argexp |
||
9261 | 10916 F87552 A9 00 C0 lda #$C000 |
||
9262 | 10917 F87555 85 38 sta argm+14 ; arg = 3 |
||
9263 | 10918 F87557 ACC08 |
||
9264 | 10919 F87557 E2 20 sep #PMFLAG |
||
9265 | 10920 .LONGA off |
||
9266 | 10921 .MNLIST |
||
9267 | 10922 F87559 64 3C stz argsgn |
||
9268 | 10923 F8755B 4C DD 49 jmp fpmult ; return z = 3*pi/2 |
||
9269 | 10924 F8755E 4C 56 4E ?zz: jmp fldz ; z = 0 |
||
9270 | 10925 F87561 C0 40 ?xx: cpy #$40 |
||
9271 | 10926 F87563 D0 19 bne ?yy ; y != 0 |
||
9272 | 10927 F87565 A5 10 ?pi: lda atncode |
||
9273 | 10928 F87567 F0 F5 beq ?zz ; return z = 0 |
||
9274 | 10929 F87569 A9 A5 lda #<cpi |
||
9275 | 10930 F8756B A0 77 ldy #>cpi |
||
9276 | 10931 F8756D 20 82 86 jsr ldfac ; z = pi |
||
9277 | 10932 F87570 A9 02 lda #$02 |
||
9278 | 10933 F87572 24 10 bit atncode |
||
9279 | 10934 F87574 D0 06 bne ?ret ; return z = pi |
||
9280 | 10935 F87576 ACC16 |
||
9281 | 10936 F87576 C2 20 rep #PMFLAG |
||
9282 | 10937 .LONGA on |
||
9283 | 10938 .MNLIST |
||
9284 | 10939 F87578 E6 22 inc facexp ; return z = 2*pi |
||
9285 | 10940 F8757A ACC08 |
||
9286 | 10941 F8757A E2 20 sep #PMFLAG |
||
9287 | 10942 .LONGA off |
||
9288 | 10943 .MNLIST |
||
9289 | 10944 F8757C 18 ?ret: clc |
||
9290 | 10945 F8757D 60 rts |
||
9291 | 10946 F8757E C0 C0 ?yy: cpy #$C0 |
||
9292 | 10947 F87580 F0 BE beq ?pi2 ; if y = inf, x != 0, is like x = 0 |
||
9293 | 10948 F87582 E0 C0 cpx #$C0 |
||
9294 | 10949 F87584 F0 DF beq ?pi ; if x = inf, y != 0, is like y = 0 |
||
9295 | 10950 F87586 20 10 4A jsr fpdiv ; w = y/x (both x and y finite and not null) |
||
9296 | 10951 F87589 20 4C 74 jsr fatan ; z = atan(y/x) |
||
9297 | 10952 F8758C A5 10 lda atncode |
||
9298 | 10953 F8758E F0 EC beq ?ret ; return z = atan(y/x) (first quadrant) |
||
9299 | 10954 F87590 20 39 84 jsr mvftoa ; arg = z |
||
9300 | 10955 F87593 A9 A5 lda #<cpi |
||
9301 | Tue Jul 17 11:00:18 2018 Page 151 |
||
9302 | |||
9303 | |||
9304 | |||
9305 | |||
9306 | 10956 F87595 A0 77 ldy #>cpi |
||
9307 | 10957 F87597 20 82 86 jsr ldfac ; fac = pi |
||
9308 | 10958 F8759A A5 10 lda atncode |
||
9309 | 10959 F8759C C9 02 cmp #$02 |
||
9310 | 10960 F8759E F0 0A beq ?done ; 2nd quadrant: add pi (atan < 0) |
||
9311 | 10961 F875A0 C9 03 cmp #$03 |
||
9312 | 10962 F875A2 F0 06 beq ?done ; 3th quadrant: add pi (atan > 0) |
||
9313 | 10963 F875A4 ACC16 |
||
9314 | 10964 F875A4 C2 20 rep #PMFLAG |
||
9315 | 10965 .LONGA on |
||
9316 | 10966 .MNLIST |
||
9317 | 10967 F875A6 E6 22 inc facexp ; 4th quadrant: add 2*pi (atan < 0) |
||
9318 | 10968 F875A8 ACC08 |
||
9319 | 10969 F875A8 E2 20 sep #PMFLAG |
||
9320 | 10970 .LONGA off |
||
9321 | 10971 .MNLIST |
||
9322 | 10972 F875AA 4C 7D 45 ?done: jmp fpadd |
||
9323 | 10973 F875AD |
||
9324 | 10974 |
||
9325 | 10975 ; sin(x) coefficients |
||
9326 | 10976 F875AD psin: |
||
9327 | 10977 ; PSIN[11] = 6.410290407010279602425714995528976754871E-26 |
||
9328 | 10978 F875AD 35 40 EA 6E 20 .DB $35,$40,$EA,$6E,$20,$61,$06,$26,$A1 |
||
9329 | 61 06 26 A1 |
||
9330 | 10979 F875B6 83 C3 68 DB 0A .DB $83,$C3,$68,$DB,$0A,$B6,$9E,$AB,$3F |
||
9331 | B6 9E AB 3F |
||
9332 | 10980 |
||
9333 | 10981 ; PSIN[10] = -3.868105354403065333804959405965295962871E-23 |
||
9334 | 10982 F875BF D1 C3 E7 80 C9 .DB $D1,$C3,$E7,$80,$C9,$32,$07,$3B,$A4 |
||
9335 | 32 07 3B A4 |
||
9336 | 10983 F875C8 87 F3 85 2F D3 .DB $87,$F3,$85,$2F,$D3,$0C,$BB,$B4,$BF |
||
9337 | 0C BB B4 BF |
||
9338 | 10984 |
||
9339 | 10985 ; PSIN[09] = 1.957294039628045847156851410307133941611E-20 |
||
9340 | 10986 F875D1 44 DE C1 98 E0 .DB $44,$DE,$C1,$98,$E0,$53,$C7,$8F,$BC |
||
9341 | 53 C7 8F BC |
||
9342 | 10987 F875DA E5 70 32 4D 77 .DB $E5,$70,$32,$4D,$77,$DC,$B8,$BD,$3F |
||
9343 | DC B8 BD 3F |
||
9344 | 10988 |
||
9345 | 10989 ; PSIN[08] = -8.220635246181818130416407184286068307901E-18 |
||
9346 | 10990 F875E3 88 ED DD EC 5C .DB $88,$ED,$DD,$EC,$5C,$DF,$55,$07,$A1 |
||
9347 | DF 55 07 A1 |
||
9348 | 10991 F875EC 85 FB E6 33 DA .DB $85,$FB,$E6,$33,$DA,$A4,$97,$C6,$BF |
||
9349 | A4 97 C6 BF |
||
9350 | 10992 |
||
9351 | 10993 ; PSIN[07] = 2.811457254345322887443598804951004537784E-15 |
||
9352 | 10994 F875F5 22 B2 7C 77 2A .DB $22,$B2,$7C,$77,$2A,$20,$77,$86,$F3 |
||
9353 | 20 77 86 F3 |
||
9354 | 10995 F875FE A5 5A 85 81 3B .DB $A5,$5A,$85,$81,$3B,$96,$CA,$CE,$3F |
||
9355 | 96 CA CE 3F |
||
9356 | 10996 |
||
9357 | 10997 ; PSIN[06] = -7.647163731819815869711749952353081768709E-13 |
||
9358 | 10998 F87607 72 92 40 E9 65 .DB $72,$92,$40,$E9,$65,$9C,$A5,$43,$C1 |
||
9359 | 9C A5 43 C1 |
||
9360 | 10999 F87610 F3 C0 9D 39 9F .DB $F3,$C0,$9D,$39,$9F,$3F,$D7,$D6,$BF |
||
9361 | 3F D7 D6 BF |
||
9362 | 11000 |
||
9363 | Tue Jul 17 11:00:18 2018 Page 152 |
||
9364 | |||
9365 | |||
9366 | |||
9367 | |||
9368 | 11001 ; PSIN[05] = 1.605904383682161459812515654720205050216E-10 |
||
9369 | 11002 F87619 80 06 BE F2 47 .DB $80,$06,$BE,$F2,$47,$B3,$13,$1B,$E4 |
||
9370 | B3 13 1B E4 |
||
9371 | 11003 F87622 4B 68 43 9D 30 .DB $4B,$68,$43,$9D,$30,$92,$B0,$DE,$3F |
||
9372 | 92 B0 DE 3F |
||
9373 | 11004 |
||
9374 | 11005 ; PSIN[04] = -2.505210838544171877505034150892770940116E-8 |
||
9375 | 11006 F8762B EC 90 66 4A 76 .DB $EC,$90,$66,$4A,$76,$79,$F7,$39,$7F |
||
9376 | 79 F7 39 7F |
||
9377 | 11007 F87634 1C 27 AA 3F 2B .DB $1C,$27,$AA,$3F,$2B,$32,$D7,$E5,$BF |
||
9378 | 32 D7 E5 BF |
||
9379 | 11008 |
||
9380 | 11009 ; PSIN[03] = 2.755731922398589065255731765498970284004E-6 |
||
9381 | 11010 F8763D 84 F7 94 D2 B7 .DB $84,$F7,$94,$D2,$B7,$37,$0E,$56,$7D |
||
9382 | 37 0E 56 7D |
||
9383 | 11011 F87646 9C 39 B6 2A 1D .DB $9C,$39,$B6,$2A,$1D,$EF,$B8,$EC,$3F |
||
9384 | EF B8 EC 3F |
||
9385 | 11012 |
||
9386 | 11013 ; PSIN[02] = -1.984126984126984126984126984045294307281E-4 |
||
9387 | 11014 F8764F 7D F8 65 29 FE .DB $7D,$F8,$65,$29,$FE,$0C,$D0,$00,$0D |
||
9388 | 0C D0 00 0D |
||
9389 | 11015 F87658 D0 00 0D D0 00 .DB $D0,$00,$0D,$D0,$00,$0D,$D0,$F2,$BF |
||
9390 | 0D D0 F2 BF |
||
9391 | 11016 |
||
9392 | 11017 ; PSIN[01] = 8.333333333333333333333333333333119885283E-3 |
||
9393 | 11018 F87661 62 9A 41 88 88 .DB $62,$9A,$41,$88,$88,$88,$88,$88,$88 |
||
9394 | 88 88 88 88 |
||
9395 | 11019 F8766A 88 88 88 88 88 .DB $88,$88,$88,$88,$88,$88,$88,$F8,$3F |
||
9396 | 88 88 F8 3F |
||
9397 | 11020 |
||
9398 | 11021 ; PSIN[00] = -1.666666666666666666666666666666666647199E-1 |
||
9399 | 11022 F87673 51 A0 AA AA AA .DB $51,$A0,$AA,$AA,$AA,$AA,$AA,$AA,$AA |
||
9400 | AA AA AA AA |
||
9401 | 11023 F8767C AA AA AA AA AA .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FC,$BF |
||
9402 | AA AA FC BF |
||
9403 | 11024 |
||
9404 | 11025 ; cos(x) coefficients |
||
9405 | 11026 F87685 pcos: |
||
9406 | 11027 ; PCOS[10] = 1.601961934248327059668321782499768648351E-24 |
||
9407 | 11028 F87685 6F 42 59 D2 8A .DB $6F,$42,$59,$D2,$8A,$EF,$37,$CD,$48 |
||
9408 | EF 37 CD 48 |
||
9409 | 11029 F8768E C3 50 58 0F 40 .DB $C3,$50,$58,$0F,$40,$E4,$F7,$AF,$3F |
||
9410 | E4 F7 AF 3F |
||
9411 | 11030 |
||
9412 | 11031 ; PCOS[09] = -8.896621117922334603659240022184527001401E-22 |
||
9413 | 11032 F87697 EF E7 87 4A 0E .DB $EF,$E7,$87,$4A,$0E,$94,$D9,$B3,$11 |
||
9414 | 94 D9 B3 11 |
||
9415 | 11033 F876A0 C8 08 07 CC 22 .DB $C8,$08,$07,$CC,$22,$71,$86,$B9,$BF |
||
9416 | 71 86 B9 BF |
||
9417 | 11034 |
||
9418 | 11035 ; PCOS[08] = 4.110317451243694098169570731967589555498E-19 |
||
9419 | 11036 F876A9 94 20 CD 9C D6 .DB $94,$20,$CD,$9C,$D6,$21,$68,$81,$A8 |
||
9420 | 21 68 81 A8 |
||
9421 | 11037 F876B2 E7 86 A7 75 5C .DB $E7,$86,$A7,$75,$5C,$A1,$F2,$C1,$3F |
||
9422 | A1 F2 C1 3F |
||
9423 | 11038 |
||
9424 | 11039 ; PCOS[07] = -1.561920696747074515985647487260202922160E-16 |
||
9425 | Tue Jul 17 11:00:18 2018 Page 153 |
||
9426 | |||
9427 | |||
9428 | |||
9429 | |||
9430 | 11040 F876BB 4C 88 FF 5A 9D .DB $4C,$88,$FF,$5A,$9D,$63,$B8,$94,$13 |
||
9431 | 63 B8 94 13 |
||
9432 | 11041 F876C4 54 B0 94 1D C3 .DB $54,$B0,$94,$1D,$C3,$13,$B4,$CA,$BF |
||
9433 | 13 B4 CA BF |
||
9434 | 11042 |
||
9435 | 11043 ; PCOS[06] = 4.779477332386900932514186378501779328195E-14 |
||
9436 | 11044 F876CD 2B 3C A9 FD E8 .DB $2B,$3C,$A9,$FD,$E8,$BA,$6D,$B7,$80 |
||
9437 | BA 6D B7 80 |
||
9438 | 11045 F876D6 FC A8 9D 39 9F .DB $FC,$A8,$9D,$39,$9F,$3F,$D7,$D2,$3F |
||
9439 | 3F D7 D2 3F |
||
9440 | 11046 |
||
9441 | 11047 ; PCOS[05] = -1.147074559772972328629102981460088437917E-11 |
||
9442 | 11048 F876DF C1 7C 8A 0F 0E .DB $C1,$7C,$8A,$0F,$0E,$46,$0C,$31,$F4 |
||
9443 | 46 0C 31 F4 |
||
9444 | 11049 F876E8 E1 E4 03 46 A5 .DB $E1,$E4,$03,$46,$A5,$CB,$C9,$DA,$BF |
||
9445 | CB C9 DA BF |
||
9446 | 11050 |
||
9447 | 11051 ; PCOS[04] = 2.087675698786809897637922200570559726116E-9 |
||
9448 | 11052 F876F1 93 84 CC C1 FA .DB $93,$84,$CC,$C1,$FA,$D5,$F9,$BF,$A8 |
||
9449 | D5 F9 BF A8 |
||
9450 | 11053 F876FA BD C4 C6 7F C7 .DB $BD,$C4,$C6,$7F,$C7,$76,$8F,$E2,$3F |
||
9451 | 76 8F E2 3F |
||
9452 | 11054 |
||
9453 | 11055 ; PCOS[03] = -2.755731922398589065255365968070684102298E-7 |
||
9454 | 11056 F87703 0E 2B 2E FA 29 .DB $0E,$2B,$2E,$FA,$29,$A2,$AE,$77,$97 |
||
9455 | A2 AE 77 97 |
||
9456 | 11057 F8770C E3 FA C4 BB 7D .DB $E3,$FA,$C4,$BB,$7D,$F2,$93,$E9,$BF |
||
9457 | F2 93 E9 BF |
||
9458 | 11058 |
||
9459 | 11059 ; PCOS[02] = 2.480158730158730158730158440896461945271E-5 |
||
9460 | 11060 F87715 69 8F 86 22 AB .DB $69,$8F,$86,$22,$AB,$EF,$CF,$00,$0D |
||
9461 | EF CF 00 0D |
||
9462 | 11061 F8771E D0 00 0D D0 00 .DB $D0,$00,$0D,$D0,$00,$0D,$D0,$EF,$3F |
||
9463 | 0D D0 EF 3F |
||
9464 | 11062 |
||
9465 | 11063 ; PCOS[01] = -1.388888888888888888888888888765724370132E-3 |
||
9466 | 11064 F87727 C8 EC 07 B7 5B .DB $C8,$EC,$07,$B7,$5B,$0B,$B6,$60,$0B |
||
9467 | 0B B6 60 0B |
||
9468 | 11065 F87730 B6 60 0B B6 60 .DB $B6,$60,$0B,$B6,$60,$0B,$B6,$F5,$BF |
||
9469 | 0B B6 F5 BF |
||
9470 | 11066 |
||
9471 | 11067 ; PCOS[00] = 4.166666666666666666666666666666459301466E-2 |
||
9472 | 11068 F87739 F7 64 FE A9 AA .DB $F7,$64,$FE,$A9,$AA,$AA,$AA,$AA,$AA |
||
9473 | AA AA AA AA |
||
9474 | 11069 F87742 AA AA AA AA AA .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FA,$3F |
||
9475 | AA AA FA 3F |
||
9476 | 11070 |
||
9477 | 11071 ; DP1 + DP2 + DP3 = PI/4 |
||
9478 | 11072 ; DP1 = 7.853981633974483067550664827649598009884357452392578125E-1 |
||
9479 | 11073 F8774B 00 00 00 00 00 cdp1: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
9480 | 00 00 00 00 |
||
9481 | 11074 F87754 C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$FE,$3F |
||
9482 | 0F C9 FE 3F |
||
9483 | 11075 |
||
9484 | 11076 ; DP2 = 2.8605943630549158983813312792950660807511260829685741796657E-18 |
||
9485 | 11077 F8775D 00 00 00 00 00 cdp2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
9486 | 00 00 00 00 |
||
9487 | Tue Jul 17 11:00:18 2018 Page 154 |
||
9488 | |||
9489 | |||
9490 | |||
9491 | |||
9492 | 11078 F87766 70 03 2E 8A 19 .DB $70,$03,$2E,$8A,$19,$13,$D3,$C4,$3F |
||
9493 | 13 D3 C4 3F |
||
9494 | 11079 |
||
9495 | 11080 ; DP3 = 2.1679525325309452561992610065108379921905808E-35 |
||
9496 | 11081 F8776F 00 00 32 F5 5D cdp3: .DB $00,$00,$32,$F5,$5D,$10,$A0,$63,$3E |
||
9497 | 10 A0 63 3E |
||
9498 | 11082 F87778 53 44 70 12 48 .DB $53,$44,$70,$12,$48,$89,$E6,$8B,$3F |
||
9499 | 89 E6 8B 3F |
||
9500 | 11083 |
||
9501 | 11084 ; PI/4 = 0.7853981633974483096156608458198757210492923 |
||
9502 | 11085 F87781 D1 1C DC 80 8B cpio4: .DB $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$34 |
||
9503 | 62 C6 C4 34 |
||
9504 | 11086 F8778A C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$FE,$3F |
||
9505 | 0F C9 FE 3F |
||
9506 | 11087 |
||
9507 | 11088 ; PI/2 |
||
9508 | 11089 F87793 D1 1C DC 80 8B cpio2: .DB $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$34 |
||
9509 | 62 C6 C4 34 |
||
9510 | 11090 F8779C C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$FF,$3F |
||
9511 | 0F C9 FF 3F |
||
9512 | 11091 |
||
9513 | 11092 ; PI |
||
9514 | 11093 F877A5 D1 1C DC 80 8B cpi: .DB $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$34 |
||
9515 | 62 C6 C4 34 |
||
9516 | 11094 F877AE C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$00,$40 |
||
9517 | 0F C9 00 40 |
||
9518 | 11095 |
||
9519 | 11096 ; tan(3*pi/8) = sqrt(2)+1 |
||
9520 | 11097 F877B7 4F 5F A5 BA D9 ct3p8: .DB $4F,$5F,$A5,$BA,$D9,$C4,$BE,$2C,$42 |
||
9521 | C4 BE 2C 42 |
||
9522 | 11098 F877C0 32 EF FC 99 79 .DB $32,$EF,$FC,$99,$79,$82,$9A,$00,$40 |
||
9523 | 82 9A 00 40 |
||
9524 | 11099 F877C9 |
||
9525 | 11100 ; tan(pi/8) = sqrt(2)-1 |
||
9526 | 11101 F877C9 7C FA 2A D5 CD ctp8: .DB $7C,$FA,$2A,$D5,$CD,$26,$F6,$65,$11 |
||
9527 | 26 F6 65 11 |
||
9528 | 11102 F877D2 92 79 E7 CF CC .DB $92,$79,$E7,$CF,$CC,$13,$D4,$FD,$3F |
||
9529 | 13 D4 FD 3F |
||
9530 | 11103 |
||
9531 | 11104 |
||
9532 | 11105 ; tan(x) coefficients |
||
9533 | 11106 F877DB ptan: |
||
9534 | 11107 ; TP[5] = -9.889929415807650724957118893791829849557E-1 |
||
9535 | 11108 F877DB 58 BB A5 17 15 .DB $58,$BB,$A5,$17,$15,$D7,$E3,$C6,$CB |
||
9536 | D7 E3 C6 CB |
||
9537 | 11109 F877E4 04 71 10 34 A4 .DB $04,$71,$10,$34,$A4,$2E,$FD,$FE,$BF |
||
9538 | 2E FD FE BF |
||
9539 | 11110 |
||
9540 | 11111 ; TP[4] = 1.272297782199996882828849455156962260810E3 |
||
9541 | 11112 F877ED D1 56 CC 23 3E .DB $D1,$56,$CC,$23,$3E,$E5,$D8,$0B,$50 |
||
9542 | E5 D8 0B 50 |
||
9543 | 11113 F877F6 29 4A 89 6E 87 .DB $29,$4A,$89,$6E,$87,$09,$9F,$09,$40 |
||
9544 | 09 9F 09 40 |
||
9545 | 11114 |
||
9546 | 11115 ; TP[3] = -4.249691853501233575668486667664718192660E5 |
||
9547 | 11116 F877FF 94 A5 29 9E C5 .DB $94,$A5,$29,$9E,$C5,$9C,$0D,$8B,$2B |
||
9548 | 9C 0D 8B 2B |
||
9549 | Tue Jul 17 11:00:18 2018 Page 155 |
||
9550 | |||
9551 | |||
9552 | |||
9553 | |||
9554 | 11117 F87808 C4 61 63 EE 25 .DB $C4,$61,$63,$EE,$25,$81,$CF,$11,$C0 |
||
9555 | 81 CF 11 C0 |
||
9556 | 11118 |
||
9557 | 11119 ; TP[2] = 5.160188250214037865511600561074819366815E7 |
||
9558 | 11120 F87811 B4 52 C1 B5 30 .DB $B4,$52,$C1,$B5,$30,$D3,$30,$C9,$14 |
||
9559 | D3 30 C9 14 |
||
9560 | 11121 F8781A 66 11 23 A0 76 .DB $66,$11,$23,$A0,$76,$D8,$C4,$18,$40 |
||
9561 | D8 C4 18 40 |
||
9562 | 11122 |
||
9563 | 11123 ; TP[1] = -2.307030822693734879744223131873392503321E9 |
||
9564 | 11124 F87823 55 27 82 DF 66 .DB $55,$27,$82,$DF,$66,$F2,$8E,$98,$EC |
||
9565 | F2 8E 98 EC |
||
9566 | 11125 F8782C 9B 98 B1 26 7F .DB $9B,$98,$B1,$26,$7F,$82,$89,$1E,$C0 |
||
9567 | 82 89 1E C0 |
||
9568 | 11126 |
||
9569 | 11127 ; TP[0] = 2.883414728874239697964612246732416606301E10 |
||
9570 | 11128 F87835 16 C6 4C C5 B1 .DB $16,$C6,$4C,$C5,$B1,$35,$56,$87,$4F |
||
9571 | 35 56 87 4F |
||
9572 | 11129 F8783E B7 C1 17 7B C5 .DB $B7,$C1,$17,$7B,$C5,$D4,$D6,$21,$40 |
||
9573 | D4 D6 21 40 |
||
9574 | 11130 |
||
9575 | 11131 F87847 qtan: |
||
9576 | 11132 ; TQ[5] = -1.317243702830553658702531997959756728291E3 |
||
9577 | 11133 F87847 FA D3 81 DD E9 .DB $FA,$D3,$81,$DD,$E9,$7B,$94,$EB,$80 |
||
9578 | 7B 94 EB 80 |
||
9579 | 11134 F87850 75 E5 E0 69 CC .DB $75,$E5,$E0,$69,$CC,$A7,$A4,$09,$C0 |
||
9580 | A7 A4 09 C0 |
||
9581 | 11135 |
||
9582 | 11136 ; TQ[4] = 4.529422062441341616231663543669583527923E5 |
||
9583 | 11137 F87859 E6 99 66 53 23 .DB $E6,$99,$66,$53,$23,$56,$5A,$89,$E9 |
||
9584 | 56 5A 89 E9 |
||
9585 | 11138 F87862 66 4C 8D 99 C6 .DB $66,$4C,$8D,$99,$C6,$29,$DD,$11,$40 |
||
9586 | 29 DD 11 40 |
||
9587 | 11139 |
||
9588 | 11140 ; TQ[3] = -5.733709132766856723608447733926138506824E7 |
||
9589 | 11141 F8786B 69 45 D0 B9 5E .DB $69,$45,$D0,$B9,$5E,$77,$B9,$31,$0D |
||
9590 | 77 B9 31 0D |
||
9591 | 11142 F87874 95 85 F8 D4 40 .DB $95,$85,$F8,$D4,$40,$B9,$DA,$18,$C0 |
||
9592 | B9 DA 18 C0 |
||
9593 | 11143 |
||
9594 | 11144 ; TQ[2] = 2.758476078803232151774723646710890525496E9 |
||
9595 | 11145 F8787D 25 48 F2 7D A4 .DB $25,$48,$F2,$7D,$A4,$71,$D8,$F7,$4E |
||
9596 | 71 D8 F7 4E |
||
9597 | 11146 F87886 9F A0 CD 2E 01 .DB $9F,$A0,$CD,$2E,$01,$6B,$A4,$1E,$40 |
||
9598 | 6B A4 1E 40 |
||
9599 | 11147 |
||
9600 | 11148 ; TQ[1] = -4.152206921457208101480801635640958361612E10 |
||
9601 | 11149 F8788F 45 68 68 C0 AA .DB $45,$68,$68,$C0,$AA,$ED,$34,$14,$6C |
||
9602 | ED 34 14 6C |
||
9603 | 11150 F87898 3E 27 E9 ED 87 .DB $3E,$27,$E9,$ED,$87,$AE,$9A,$22,$C0 |
||
9604 | AE 9A 22 C0 |
||
9605 | 11151 |
||
9606 | 11152 ; TQ[0] = 8.650244186622719093893836740197250197602E10 |
||
9607 | 11153 F878A1 30 B9 F9 53 45 .DB $30,$B9,$F9,$53,$45,$A8,$80,$A5,$7B |
||
9608 | A8 80 A5 7B |
||
9609 | 11154 F878AA 49 D1 51 1C 94 .DB $49,$D1,$51,$1C,$94,$1F,$A1,$23,$40 |
||
9610 | 1F A1 23 40 |
||
9611 | Tue Jul 17 11:00:18 2018 Page 156 |
||
9612 | |||
9613 | |||
9614 | |||
9615 | |||
9616 | 11155 |
||
9617 | 11156 ; asin(x) coefficients |
||
9618 | 11157 F878B3 casp: |
||
9619 | 11158 ; ASP[9] = -8.067112765482705313585175280952515549833E-1 |
||
9620 | 11159 F878B3 73 27 C0 8D 2C .DB $73,$27,$C0,$8D,$2C,$37,$96,$A8,$04 |
||
9621 | 37 96 A8 04 |
||
9622 | 11160 F878BC 05 D8 16 56 A1 .DB $05,$D8,$16,$56,$A1,$84,$CE,$FE,$BF |
||
9623 | 84 CE FE BF |
||
9624 | 11161 |
||
9625 | 11162 ; ASP[8] = 4.845649797786849136525020822000172350977E1 |
||
9626 | 11163 F878C5 10 4E 72 84 A0 .DB $10,$4E,$72,$84,$A0,$F4,$1C,$1D,$A9 |
||
9627 | F4 1C 1D A9 |
||
9628 | 11164 F878CE 8C 8A B6 34 74 .DB $8C,$8A,$B6,$34,$74,$D3,$C1,$04,$40 |
||
9629 | D3 C1 04 40 |
||
9630 | 11165 |
||
9631 | 11166 ; ASP[7] = -8.510195404865297879959793548843395926847E2 |
||
9632 | 11167 F878D7 EB 4D 4D 8F C3 .DB $EB,$4D,$4D,$8F,$C3,$B1,$24,$A9,$BD |
||
9633 | B1 24 A9 BD |
||
9634 | 11168 F878E0 F9 A5 BD 26 40 .DB $F9,$A5,$BD,$26,$40,$C1,$D4,$08,$C0 |
||
9635 | C1 D4 08 C0 |
||
9636 | 11169 |
||
9637 | 11170 ; ASP[6] = 6.815196841370292688574521445731895826485E3 |
||
9638 | 11171 F878E9 AA 5E 2D 43 AA .DB $AA,$5E,$2D,$43,$AA,$66,$ED,$0A,$61 |
||
9639 | 66 ED 0A 61 |
||
9640 | 11172 F878F2 41 7F 91 21 93 .DB $41,$7F,$91,$21,$93,$F9,$D4,$0B,$40 |
||
9641 | F9 D4 0B 40 |
||
9642 | 11173 |
||
9643 | 11174 ; ASP[5] = -2.967135182120339728996157454994675519735E4 |
||
9644 | 11175 F878FB F2 CA 89 AC E2 .DB $F2,$CA,$89,$AC,$E2,$B3,$AC,$51,$EE |
||
9645 | B3 AC 51 EE |
||
9646 | 11176 F87904 42 A5 E8 21 B4 .DB $42,$A5,$E8,$21,$B4,$CE,$E7,$0D,$C0 |
||
9647 | CE E7 0D C0 |
||
9648 | 11177 |
||
9649 | 11178 ; ASP[4] = 7.612250656518818109652985996692466409670E4 |
||
9650 | 11179 F8790D 4D 89 09 49 F6 .DB $4D,$89,$09,$49,$F6,$5B,$21,$9C,$D3 |
||
9651 | 5B 21 9C D3 |
||
9652 | 11180 F87916 43 CA 20 D7 40 .DB $43,$CA,$20,$D7,$40,$AD,$94,$0F,$40 |
||
9653 | AD 94 0F 40 |
||
9654 | 11181 |
||
9655 | 11182 ; ASP[3] = -1.183360579752620455689557157684221905030E5 |
||
9656 | 11183 F8791F C8 84 21 34 4B .DB $C8,$84,$21,$34,$4B,$51,$AB,$59,$3B |
||
9657 | 51 AB 59 3B |
||
9658 | 11184 F87928 3B BF BB 6B 07 .DB $3B,$BF,$BB,$6B,$07,$20,$E7,$0F,$C0 |
||
9659 | 20 E7 0F C0 |
||
9660 | 11185 |
||
9661 | 11186 ; ASP[2] = 1.095432262510413338755837156377401348063E5 |
||
9662 | 11187 F87931 5C D5 0E A4 53 .DB $5C,$D5,$0E,$A4,$53,$03,$23,$26,$83 |
||
9663 | 03 23 26 83 |
||
9664 | 11188 F8793A 9B 4B CB F5 9C .DB $9B,$4B,$CB,$F5,$9C,$F3,$D5,$0F,$40 |
||
9665 | F3 D5 0F 40 |
||
9666 | 11189 |
||
9667 | 11190 ; ASP[1] = -5.554124580991113991999636773382495788705E4 |
||
9668 | 11191 F87943 A8 77 07 20 6B .DB $A8,$77,$07,$20,$6B,$5E,$DE,$66,$ED |
||
9669 | 5E DE 66 ED |
||
9670 | 11192 F8794C 60 F9 65 ED 3E .DB $60,$F9,$65,$ED,$3E,$F5,$D8,$0E,$C0 |
||
9671 | F5 D8 0E C0 |
||
9672 | 11193 |
||
9673 | Tue Jul 17 11:00:18 2018 Page 157 |
||
9674 | |||
9675 | |||
9676 | |||
9677 | |||
9678 | 11194 ; ASP[0] = 1.187132626694762543537732514905488896985E4 |
||
9679 | 11195 F87955 14 17 24 62 E1 .DB $14,$17,$24,$62,$E1,$9B,$9A,$F9,$98 |
||
9680 | 9B 9A F9 98 |
||
9681 | 11196 F8795E 44 37 EC 18 4E .DB $44,$37,$EC,$18,$4E,$7D,$B9,$0C,$40 |
||
9682 | 7D B9 0C 40 |
||
9683 | 11197 |
||
9684 | 11198 F87967 casq: |
||
9685 | 11199 ; ASQ[9] = -8.005471061732009595694099899234272342478E1 |
||
9686 | 11200 F87967 AB CB 99 42 E0 .DB $AB,$CB,$99,$42,$E0,$53,$D9,$98,$3E |
||
9687 | 53 D9 98 3E |
||
9688 | 11201 F87970 7F 44 B0 07 03 .DB $7F,$44,$B0,$07,$03,$1C,$A0,$05,$C0 |
||
9689 | 1C A0 05 C0 |
||
9690 | 11202 |
||
9691 | 11203 ; ASQ[8] = 1.817324228942812880965069608562483918025E3 |
||
9692 | 11204 F87979 74 B0 9D 55 FC .DB $74,$B0,$9D,$55,$FC,$EE,$98,$24,$09 |
||
9693 | EE 98 24 09 |
||
9694 | 11205 F87982 89 39 60 15 60 .DB $89,$39,$60,$15,$60,$2A,$E3,$09,$40 |
||
9695 | 2A E3 09 40 |
||
9696 | 11206 |
||
9697 | 11207 ; ASQ[7] = -1.867017317425756524289537002141956583706E4 |
||
9698 | 11208 F8798B CA 11 F0 E5 FC .DB $CA,$11,$F0,$E5,$FC,$8D,$72,$C6,$EB |
||
9699 | 8D 72 C6 EB |
||
9700 | 11209 F87994 80 D9 4B AA 58 .DB $80,$D9,$4B,$AA,$58,$DC,$91,$0D,$C0 |
||
9701 | DC 91 0D C0 |
||
9702 | 11210 |
||
9703 | 11211 ; ASQ[6] = 1.048196619402464497478959760337779705622E5 |
||
9704 | 11212 F8799D EA F9 4B 5E 82 .DB $EA,$F9,$4B,$5E,$82,$00,$4C,$57,$34 |
||
9705 | 00 4C 57 34 |
||
9706 | 11213 F879A6 34 3F 75 BA D4 .DB $34,$3F,$75,$BA,$D4,$B9,$CC,$0F,$40 |
||
9707 | B9 CC 0F 40 |
||
9708 | 11214 |
||
9709 | 11215 ; ASQ[5] = -3.527040897897253459022458866536165564103E5 |
||
9710 | 11216 F879AF 9E F0 E3 86 B9 .DB $9E,$F0,$E3,$86,$B9,$BB,$11,$41,$14 |
||
9711 | BB 11 41 14 |
||
9712 | 11217 F879B8 BC B3 8E DF 02 .DB $BC,$B3,$8E,$DF,$02,$38,$AC,$11,$C0 |
||
9713 | 38 AC 11 C0 |
||
9714 | 11218 |
||
9715 | 11219 ; ASQ[4] = 7.426302422018858001691440351763370029242E5 |
||
9716 | 11220 F879C1 72 C6 78 BF 89 .DB $72,$C6,$78,$BF,$89,$F9,$2E,$F9,$A8 |
||
9717 | F9 2E F9 A8 |
||
9718 | 11221 F879CA A8 15 0F E0 63 .DB $A8,$15,$0F,$E0,$63,$4E,$B5,$12,$40 |
||
9719 | 4E B5 12 40 |
||
9720 | 11222 |
||
9721 | 11223 ; ASQ[3] = -9.863068411558756277454631976667880674474E5 |
||
9722 | 11224 F879D3 FF 38 2A 9B 42 .DB $FF,$38,$2A,$9B,$42,$07,$BF,$F1,$8C |
||
9723 | 07 BF F1 8C |
||
9724 | 11225 F879DC 0A DD 5F 75 2D .DB $0A,$DD,$5F,$75,$2D,$CC,$F0,$12,$C0 |
||
9725 | CC F0 12 C0 |
||
9726 | 11226 |
||
9727 | 11227 ; ASQ[2] = 8.025654653926121907774766642393757364326E5 |
||
9728 | 11228 F879E5 C1 3C 5A DF 8E .DB $C1,$3C,$5A,$DF,$8E,$AF,$32,$E7,$8C |
||
9729 | AF 32 E7 8C |
||
9730 | 11229 F879EE 12 86 3F 72 57 .DB $12,$86,$3F,$72,$57,$F0,$C3,$12,$40 |
||
9731 | F0 C3 12 40 |
||
9732 | 11230 |
||
9733 | 11231 ; ASQ[1] = -3.653000557802254281954969843055623398839E5 |
||
9734 | 11232 F879F7 CA 1B 43 FC 90 .DB $CA,$1B,$43,$FC,$90,$05,$03,$8F,$48 |
||
9735 | Tue Jul 17 11:00:18 2018 Page 158 |
||
9736 | |||
9737 | |||
9738 | |||
9739 | |||
9740 | 05 03 8F 48 |
||
9741 | 11233 F87A00 7F 9C F3 C8 81 .DB $7F,$9C,$F3,$C8,$81,$5E,$B2,$11,$C0 |
||
9742 | 5E B2 11 C0 |
||
9743 | 11234 |
||
9744 | 11235 ; ASQ[0] = 7.122795760168575261226395089432959614179E4 |
||
9745 | 11236 F87A09 93 75 A5 09 E9 .DB $93,$75,$A5,$09,$E9,$F4,$33,$BB,$72 |
||
9746 | F4 33 BB 72 |
||
9747 | 11237 F87A12 73 29 B1 92 FA .DB $73,$29,$B1,$92,$FA,$1D,$8B,$0F,$40 |
||
9748 | 1D 8B 0F 40 |
||
9749 | 11238 |
||
9750 | 11239 ; atan(x) coefficients |
||
9751 | 11240 F87A1B catp: |
||
9752 | 11241 ; ATP[08] = -6.635810778635296712545011270011752799963E-4 |
||
9753 | 11242 F87A1B F1 6B 5F 23 D7 .DB $F1,$6B,$5F,$23,$D7,$8E,$2D,$08,$F8 |
||
9754 | 8E 2D 08 F8 |
||
9755 | 11243 F87A24 79 13 55 1C 2C .DB $79,$13,$55,$1C,$2C,$F4,$AD,$F4,$BF |
||
9756 | F4 AD F4 BF |
||
9757 | 11244 |
||
9758 | 11245 ; ATP[07] = -8.768423468036849091777415076702113400070E-1 |
||
9759 | 11246 F87A2D 0C 62 A5 C3 8A .DB $0C,$62,$A5,$C3,$8A,$2F,$F9,$15,$4D |
||
9760 | 2F F9 15 4D |
||
9761 | 11247 F87A36 29 0C 45 73 BD .DB $29,$0C,$45,$73,$BD,$78,$E0,$FE,$BF |
||
9762 | 78 E0 FE BF |
||
9763 | 11248 |
||
9764 | 11249 ; ATP[06] = -2.548067867495502632615671450650071218995E1 |
||
9765 | 11250 F87A3F EA FC 2D 13 27 .DB $EA,$FC,$2D,$13,$27,$8A,$73,$51,$2A |
||
9766 | 8A 73 51 2A |
||
9767 | 11251 F87A48 18 88 A6 0F 6E .DB $18,$88,$A6,$0F,$6E,$D8,$CB,$03,$C0 |
||
9768 | D8 CB 03 C0 |
||
9769 | 11252 |
||
9770 | 11253 ; ATP[05] = -2.497759878476618348858065206895055957104E2 |
||
9771 | 11254 F87A51 F8 A0 32 CF E6 .DB $F8,$A0,$32,$CF,$E6,$62,$5C,$EB,$0C |
||
9772 | 62 5C EB 0C |
||
9773 | 11255 F87A5A 0F CD BB 23 A7 .DB $0F,$CD,$BB,$23,$A7,$C6,$F9,$06,$C0 |
||
9774 | C6 F9 06 C0 |
||
9775 | 11256 |
||
9776 | 11257 ; ATP[04] = -1.148164399808514330375280133523543970854E3 |
||
9777 | 11258 F87A63 F0 5F EE 9D 20 .DB $F0,$5F,$EE,$9D,$20,$0D,$F2,$58,$EE |
||
9778 | 0D F2 58 EE |
||
9779 | 11259 F87A6C 34 21 63 C3 42 .DB $34,$21,$63,$C3,$42,$85,$8F,$09,$C0 |
||
9780 | 85 8F 09 C0 |
||
9781 | 11260 |
||
9782 | 11261 ; ATP[03] = -2.792272753241044941703278827346430350236E3 |
||
9783 | 11262 F87A75 9A CD A1 B3 A8 .DB $9A,$CD,$A1,$B3,$A8,$AB,$A8,$87,$0E |
||
9784 | AB A8 87 0E |
||
9785 | 11263 F87A7E A8 A2 80 32 5D .DB $A8,$A2,$80,$32,$5D,$84,$AE,$0A,$C0 |
||
9786 | 84 AE 0A C0 |
||
9787 | 11264 |
||
9788 | 11265 ; ATP[02] = -3.696264445691821235400930243493001671932E3 |
||
9789 | 11266 F87A87 76 73 C3 5C DA .DB $76,$73,$C3,$5C,$DA,$FA,$F9,$C5,$78 |
||
9790 | FA F9 C5 78 |
||
9791 | 11267 F87A90 0B DF 67 2B 3B .DB $0B,$DF,$67,$2B,$3B,$04,$E7,$0A,$C0 |
||
9792 | 04 E7 0A C0 |
||
9793 | 11268 |
||
9794 | 11269 ; ATP[01] = -2.514829758941713674909996882101723647996E3 |
||
9795 | 11270 F87A99 FF 23 4B CB 5F .DB $FF,$23,$4B,$CB,$5F,$46,$30,$6F,$B3 |
||
9796 | 46 30 6F B3 |
||
9797 | Tue Jul 17 11:00:18 2018 Page 159 |
||
9798 | |||
9799 | |||
9800 | |||
9801 | |||
9802 | 11271 F87AA2 94 E3 4F B1 46 .DB $94,$E3,$4F,$B1,$46,$2D,$9D,$0A,$C0 |
||
9803 | 2D 9D 0A C0 |
||
9804 | 11272 |
||
9805 | 11273 ; ATP[00] = -6.880597774405940432145577545328795037141E2 |
||
9806 | 11274 F87AAB 02 27 91 66 97 .DB $02,$27,$91,$66,$97,$AB,$B4,$ED,$BB |
||
9807 | AB B4 ED BB |
||
9808 | 11275 F87AB4 F5 18 C2 64 D3 .DB $F5,$18,$C2,$64,$D3,$03,$AC,$08,$C0 |
||
9809 | 03 AC 08 C0 |
||
9810 | 11276 |
||
9811 | 11277 F87ABD catq: |
||
9812 | 11278 ; ATQ[07] = 3.566239794444800849656497338030115886153E1 |
||
9813 | 11279 F87ABD C0 AA A1 BA 09 .DB $C0,$AA,$A1,$BA,$09,$B0,$53,$CA,$64 |
||
9814 | B0 53 CA 64 |
||
9815 | 11280 F87AC6 06 5E 91 A5 4B .DB $06,$5E,$91,$A5,$4B,$A6,$8E,$04,$40 |
||
9816 | A6 8E 04 40 |
||
9817 | 11281 |
||
9818 | 11282 ; ATQ[06] = 4.308348370818927353321556740027020068897E2 |
||
9819 | 11283 F87ACF F3 26 2F 03 B5 .DB $F3,$26,$2F,$03,$B5,$85,$60,$C3,$D8 |
||
9820 | 85 60 C3 D8 |
||
9821 | 11284 F87AD8 D2 1B 06 F1 DB .DB $D2,$1B,$06,$F1,$DB,$6A,$D7,$07,$40 |
||
9822 | 6A D7 07 40 |
||
9823 | 11285 |
||
9824 | 11286 ; ATQ[05] = 2.494680540950601626662048893678584497900E3 |
||
9825 | 11287 F87AE1 37 5A 94 B0 14 .DB $37,$5A,$94,$B0,$14,$01,$F9,$F5,$88 |
||
9826 | 01 F9 F5 88 |
||
9827 | 11288 F87AEA C3 66 E8 7E E3 .DB $C3,$66,$E8,$7E,$E3,$EA,$9B,$0A,$40 |
||
9828 | EA 9B 0A 40 |
||
9829 | 11289 |
||
9830 | 11290 ; ATQ[04] = 7.928572347062145288093560392463784743935E3 |
||
9831 | 11291 F87AF3 E8 83 10 77 27 .DB $E8,$83,$10,$77,$27,$F7,$9C,$C9,$6A |
||
9832 | F7 9C C9 6A |
||
9833 | 11292 F87AFC 01 4F B2 2A 94 .DB $01,$4F,$B2,$2A,$94,$C4,$F7,$0B,$40 |
||
9834 | C4 F7 0B 40 |
||
9835 | 11293 |
||
9836 | 11294 ; ATQ[03] = 1.458510242529987155225086911411015961174E4 |
||
9837 | 11295 F87B05 F4 89 D9 F7 87 .DB $F4,$89,$D9,$F7,$87,$4A,$D8,$81,$DC |
||
9838 | 4A D8 81 DC |
||
9839 | 11296 F87B0E EC 84 2D E2 68 .DB $EC,$84,$2D,$E2,$68,$E4,$E3,$0C,$40 |
||
9840 | E4 E3 0C 40 |
||
9841 | 11297 |
||
9842 | 11298 ; ATQ[02] = 1.547394317752562611786521896296215170819E4 |
||
9843 | 11299 F87B17 D6 33 A9 9B 41 .DB $D6,$33,$A9,$9B,$41,$D7,$06,$B7,$A6 |
||
9844 | D7 06 B7 A6 |
||
9845 | 11300 F87B20 8B 4B 54 D0 C5 .DB $8B,$4B,$54,$D0,$C5,$C7,$F1,$0C,$40 |
||
9846 | C7 F1 0C 40 |
||
9847 | 11301 |
||
9848 | 11302 ; ATQ[01] = 8.782996876218210302516194604424986107121E3 |
||
9849 | 11303 F87B29 F6 15 46 E3 7B .DB $F6,$15,$46,$E3,$7B,$EE,$EE,$EA,$5E |
||
9850 | EE EE EA 5E |
||
9851 | 11304 F87B32 7E 8D 1E CD FC .DB $7E,$8D,$1E,$CD,$FC,$3B,$89,$0C,$40 |
||
9852 | 3B 89 0C 40 |
||
9853 | 11305 |
||
9854 | 11306 ; ATQ[00] = 2.064179332321782129643673263598686441900E3 |
||
9855 | 11307 F87B3B AD 9F 29 8D B1 .DB $AD,$9F,$29,$8D,$B1,$80,$47,$F2,$4C |
||
9856 | 80 47 F2 4C |
||
9857 | 11308 F87B44 B8 92 91 8B DE .DB $B8,$92,$91,$8B,$DE,$02,$81,$0A,$40 |
||
9858 | 02 81 0A 40 |
||
9859 | Tue Jul 17 11:00:18 2018 Page 160 |
||
9860 | |||
9861 | |||
9862 | |||
9863 | |||
9864 | 11309 |
||
9865 | 11310 ;--------------------------------------------------------------------------- |
||
9866 | 11311 ; hyperbolics functions & inverse hyperbolics functions |
||
9867 | 11312 ;--------------------------------------------------------------------------- |
||
9868 | 11313 |
||
9869 | 11314 ; fsinh - returns the hyperbolic sin of the argument |
||
9870 | 11315 ; |
||
9871 | 11316 ; entry: |
||
9872 | 11317 ; fac = x (argument) |
||
9873 | 11318 ; |
||
9874 | 11319 ; exit: |
||
9875 | 11320 ; fac = sinh(x) |
||
9876 | 11321 ; CF = 1 if invalid result(inf or nan) |
||
9877 | 11322 ; |
||
9878 | 11323 ; strategy x -x |
||
9879 | 11324 ; e - e |
||
9880 | 11325 ; Mathematically sinh(x) = ----------- |
||
9881 | 11326 ; 2 |
||
9882 | 11327 ; |
||
9883 | 11328 ; 1) if |x| <=1 sinh(x) is approximated by a rational function: |
||
9884 | 11329 ; |
||
9885 | 11330 ; 3 P(z) 2 |
||
9886 | 11331 ; sinh(x) = x + x * R(z), R(z) = ------, z = x |
||
9887 | 11332 ; Q(z) |
||
9888 | 11333 ; |
||
9889 | 11334 ; E |x| |
||
9890 | 11335 ; 2) |x| > 1: sinh(x) = sgn(x)*0.5*(E + -----), E = e - 1 = expm1(|x|) |
||
9891 | 11336 ; E+1 |
||
9892 | 11337 ; |
||
9893 | 11338 ; computation mean time: 65/100ms at 4MHz |
||
9894 | 11339 ; |
||
9895 | 11340 ; Note: overflow if |x| >= 11356.25 |
||
9896 | 11341 ; |
||
9897 | 11342 ;----- |
||
9898 | 11343 F87B4D fsinh: |
||
9899 | 11344 ;----- |
||
9900 | 11345 F87B4D 38 sec |
||
9901 | 11346 F87B4E 24 25 bit facst |
||
9902 | 11347 F87B50 30 03 bmi ?rts ; fac=inf or inf |
||
9903 | 11348 F87B52 50 02 bvc ?nz ; if fac=0 returns zero |
||
9904 | 11349 F87B54 18 clc |
||
9905 | 11350 F87B55 60 ?rts: rts |
||
9906 | 11351 F87B56 20 24 74 ?nz: jsr cmpx1 ; compare |x| vs. 1.0 |
||
9907 | 11352 F87B59 F0 2E beq rsinh ; |x|=1 |
||
9908 | 11353 F87B5B 90 2C bcc rsinh ; |x|<1 |
||
9909 | 11354 F87B5D A5 24 lda facsgn ; sinh(-x)=-sinh(x) |
||
9910 | 11355 F87B5F 85 CF sta fpcsgn ; save sign |
||
9911 | 11356 F87B61 64 24 stz facsgn ; |x| |
||
9912 | 11357 F87B63 20 BD 69 jsr fexpm1 ; E=exp(|x|)-1 |
||
9913 | 11358 F87B66 B0 1C bcs ?done ; overflow |
||
9914 | 11359 F87B68 20 66 84 jsr mvf_t0 |
||
9915 | 11360 F87B6B 20 6C 45 jsr faddone ; E+1 |
||
9916 | 11361 F87B6E B0 14 bcs ?done ; overflow |
||
9917 | 11362 F87B70 20 CE 85 jsr mvt0_a ; arg=E |
||
9918 | 11363 F87B73 20 10 4A jsr fpdiv ; E/(E+1) |
||
9919 | 11364 F87B76 20 CE 85 jsr mvt0_a ; arg=E |
||
9920 | 11365 F87B79 20 7D 45 jsr fpadd ; E+E/(E+1) |
||
9921 | Tue Jul 17 11:00:18 2018 Page 161 |
||
9922 | |||
9923 | |||
9924 | |||
9925 | |||
9926 | 11366 F87B7C B0 06 bcs ?done ; overflow |
||
9927 | 11367 F87B7E ACC16 ; for sure here fac is normal |
||
9928 | 11368 F87B7E C2 20 rep #PMFLAG |
||
9929 | 11369 .LONGA on |
||
9930 | 11370 .MNLIST |
||
9931 | 11371 F87B80 C6 22 dec facexp ; divide by 2 |
||
9932 | 11372 F87B82 ACC08 |
||
9933 | 11373 F87B82 E2 20 sep #PMFLAG |
||
9934 | 11374 .LONGA off |
||
9935 | 11375 .MNLIST |
||
9936 | 11376 F87B84 A5 CF ?done: lda fpcsgn |
||
9937 | 11377 F87B86 85 24 sta facsgn ; set sign |
||
9938 | 11378 F87B88 60 rts |
||
9939 | 11379 |
||
9940 | 11380 ; returns sinh(x) when |x|<=1 (approximated by rational function) |
||
9941 | 11381 F87B89 rsinh: |
||
9942 | 11382 F87B89 20 93 84 jsr mvf_t1 ; tfr1=x |
||
9943 | 11383 F87B8C 20 CC 49 jsr fsquare ; z=x*x |
||
9944 | 11384 F87B8F 20 66 84 jsr mvf_t0 ; tfr0=z |
||
9945 | 11385 F87B92 A9 6C lda #<cshp |
||
9946 | 11386 F87B94 A0 7E ldy #>cshp |
||
9947 | 11387 F87B96 A2 05 ldx #5 |
||
9948 | 11388 F87B98 20 1C 87 jsr peval ; evaluates P(z) |
||
9949 | 11389 F87B9B 20 C0 84 jsr mvf_t2 ; tfr2=P(z) |
||
9950 | 11390 F87B9E A9 D8 lda #<cshq |
||
9951 | 11391 F87BA0 A0 7E ldy #>cshq |
||
9952 | 11392 F87BA2 A2 05 ldx #5 |
||
9953 | 11393 F87BA4 20 3A 87 jsr pevalp1 ; evaluates Q(z) |
||
9954 | 11394 F87BA7 20 28 86 jsr mvt2_a ; arg=P(z) |
||
9955 | 11395 F87BAA 20 10 4A jsr fpdiv |
||
9956 | 11396 F87BAD 20 CE 85 jsr mvt0_a ; arg=z |
||
9957 | 11397 F87BB0 20 DD 49 jsr fpmult ; z*R(z) |
||
9958 | 11398 F87BB3 20 FB 85 jsr mvt1_a ; arg=x |
||
9959 | 11399 F87BB6 20 DD 49 jsr fpmult ; x*z*R(z) |
||
9960 | 11400 F87BB9 20 FB 85 jsr mvt1_a ; arg=x |
||
9961 | 11401 F87BBC 4C 7D 45 jmp fpadd ; returns sinh(x)=x + x*z*R(z) |
||
9962 | 11402 |
||
9963 | 11403 ; fcosh - returns the hyperbolic cosin of the argument |
||
9964 | 11404 ; |
||
9965 | 11405 ; entry: |
||
9966 | 11406 ; fac = x (argument) |
||
9967 | 11407 ; |
||
9968 | 11408 ; exit: |
||
9969 | 11409 ; fac = cosh(x) |
||
9970 | 11410 ; CF = 1 if invalid result(inf or nan) |
||
9971 | 11411 ; |
||
9972 | 11412 ; strategy x -x |
||
9973 | 11413 ; e + e |
||
9974 | 11414 ; Mathematically cosh(x) = ----------- |
||
9975 | 11415 ; 2 |
||
9976 | 11416 ; |
||
9977 | 11417 ; 1) if |x| <=1 cosh(x) is approximated by a rational function |
||
9978 | 11418 ; that evaluates sinh(|x|): |
||
9979 | 11419 ; |
||
9980 | 11420 ; 3 P(z) 2 |
||
9981 | 11421 ; sinh(x) = x + x * R(z), R(z) = ------, z = x |
||
9982 | 11422 ; Q(z) |
||
9983 | Tue Jul 17 11:00:18 2018 Page 162 |
||
9984 | |||
9985 | |||
9986 | |||
9987 | |||
9988 | 11423 ; 2 |
||
9989 | 11424 ; then: cosh(x) = sqrt(1 + sinh(x) ) |
||
9990 | 11425 ; |
||
9991 | 11426 ; 0.5 |x| |
||
9992 | 11427 ; 2) |x| > 1: cosh(x) = 0.5*E + -----, E = e = expm1(|x|) + 1 |
||
9993 | 11428 ; E |
||
9994 | 11429 ; |
||
9995 | 11430 ; computation mean time: 100ms at 4MHz |
||
9996 | 11431 ; |
||
9997 | 11432 ; Note: overflow if |x| >= 11356.25 |
||
9998 | 11433 ; |
||
9999 | 11434 ;----- |
||
10000 | 11435 F87BBF fcosh: |
||
10001 | 11436 ;----- |
||
10002 | 11437 F87BBF 64 24 stz facsgn ; cosh(-x) = cosh(x) |
||
10003 | 11438 F87BC1 38 sec |
||
10004 | 11439 F87BC2 24 25 bit facst |
||
10005 | 11440 F87BC4 30 05 bmi ?rts ; fac=inf or nan |
||
10006 | 11441 F87BC6 50 04 bvc ?nz ; if fac=0 returns 1 |
||
10007 | 11442 F87BC8 4C 2E 4E jmp fldp1 |
||
10008 | 11443 F87BCB 60 ?rts: rts |
||
10009 | 11444 F87BCC 20 24 74 ?nz: jsr cmpx1 ; compare |x| vs. 1.0 |
||
10010 | 11445 F87BCF F0 02 beq ?le1 ; |x|=1 |
||
10011 | 11446 F87BD1 B0 0C bcs ?gt1 ; |x|>1 |
||
10012 | 11447 F87BD3 20 89 7B ?le1: jsr rsinh ; sinh(|x|) |
||
10013 | 11448 F87BD6 20 CC 49 jsr fsquare ; sinh(|x|)^2 |
||
10014 | 11449 F87BD9 20 6C 45 jsr faddone ; 1+sinh(|x|)^2 |
||
10015 | 11450 F87BDC 4C 53 60 jmp fsqrt ; cosh(x) = sqrt(1+sinh(|x|)^2) |
||
10016 | 11451 F87BDF 20 BD 69 ?gt1: jsr fexpm1 ; E=expm1(|x|) |
||
10017 | 11452 F87BE2 B0 E7 bcs ?rts ; overflow |
||
10018 | 11453 F87BE4 20 6C 45 jsr faddone |
||
10019 | 11454 F87BE7 B0 E2 bcs ?rts ; overflow |
||
10020 | 11455 F87BE9 20 66 84 jsr mvf_t0 |
||
10021 | 11456 F87BEC 20 9F 4E jsr ldahalf |
||
10022 | 11457 F87BEF 20 10 4A jsr fpdiv ; 0.5/E |
||
10023 | 11458 F87BF2 20 CE 85 jsr mvt0_a ; arg=E |
||
10024 | 11459 F87BF5 ACC16 |
||
10025 | 11460 F87BF5 C2 20 rep #PMFLAG |
||
10026 | 11461 .LONGA on |
||
10027 | 11462 .MNLIST |
||
10028 | 11463 F87BF7 C6 3A dec argexp ; E/2 |
||
10029 | 11464 F87BF9 ACC08 |
||
10030 | 11465 F87BF9 E2 20 sep #PMFLAG |
||
10031 | 11466 .LONGA off |
||
10032 | 11467 .MNLIST |
||
10033 | 11468 F87BFB 4C 7D 45 jmp fpadd |
||
10034 | 11469 |
||
10035 | 11470 ; ftanh - returns the hyperbolic tangent of the argument |
||
10036 | 11471 ; |
||
10037 | 11472 ; entry: |
||
10038 | 11473 ; fac = x (argument) |
||
10039 | 11474 ; |
||
10040 | 11475 ; exit: |
||
10041 | 11476 ; fac = tanh(x) |
||
10042 | 11477 ; CF = 1 if invalid result(inf or nan) |
||
10043 | 11478 ; |
||
10044 | 11479 ; strategy x -x |
||
10045 | Tue Jul 17 11:00:18 2018 Page 163 |
||
10046 | |||
10047 | |||
10048 | |||
10049 | |||
10050 | 11480 ; e - e |
||
10051 | 11481 ; Mathematically cosh(x) = ----------- |
||
10052 | 11482 ; x -x |
||
10053 | 11483 ; e + e |
||
10054 | 11484 ; |
||
10055 | 11485 ; strategy |
||
10056 | 11486 ; |
||
10057 | 11487 ; 1) if |x| < 0.625 tanh(x) is approximated by a rational function: |
||
10058 | 11488 ; |
||
10059 | 11489 ; 3 P(z) 2 |
||
10060 | 11490 ; tanh(x) = x + x * R(z), R(z) = ------, z = x |
||
10061 | 11491 ; Q(z) |
||
10062 | 11492 ; |
||
10063 | 11493 ; 2 2|x| |
||
10064 | 11494 ; 2) |x| > 0.625: tanh(x) = 1 - -------, E = e |
||
10065 | 11495 ; E + 1 |
||
10066 | 11496 ; |
||
10067 | 11497 ; computation mean time: 60/100ms at 4MHz |
||
10068 | 11498 ; |
||
10069 | 11499 ; Note: if |x| >= 40 tanh(x) = +/-1 |
||
10070 | 11500 ; |
||
10071 | 11501 ;----- |
||
10072 | 11502 F87BFE ftanh: |
||
10073 | 11503 ;----- |
||
10074 | 11504 F87BFE 24 25 bit facst |
||
10075 | 11505 F87C00 10 07 bpl ?fv ; valid |
||
10076 | 11506 F87C02 50 03 bvc ?er ; fac=nan so returns nan |
||
10077 | 11507 F87C04 4C 36 4E jmp fld1 ; if fac =+/-inf returns +/-1 |
||
10078 | 11508 F87C07 38 ?er: sec |
||
10079 | 11509 F87C08 60 rts |
||
10080 | 11510 F87C09 70 47 ?fv: bvs ?ok ; if fac=0 returns zero |
||
10081 | 11511 F87C0B ACC16 ; compare |x| vs. 0.625 |
||
10082 | 11512 F87C0B C2 20 rep #PMFLAG |
||
10083 | 11513 .LONGA on |
||
10084 | 11514 .MNLIST |
||
10085 | 11515 F87C0D A5 22 lda facexp |
||
10086 | 11516 F87C0F C9 FE 3F cmp #$3FFE |
||
10087 | 11517 F87C12 F0 02 beq ?tst |
||
10088 | 11518 F87C14 B0 05 bcs ?cc ; |x| > 0.625 |
||
10089 | 11519 F87C16 A5 20 ?tst: lda facm+14 |
||
10090 | 11520 F87C18 C9 00 A0 cmp #$A000 |
||
10091 | 11521 F87C1B ?cc: ACC08 |
||
10092 | 11522 F87C1B E2 20 sep #PMFLAG |
||
10093 | 11523 .LONGA off |
||
10094 | 11524 .MNLIST |
||
10095 | 11525 F87C1D 90 35 bcc ?pp ; |x| < 0.625 |
||
10096 | 11526 F87C1F A5 24 lda facsgn |
||
10097 | 11527 F87C21 85 CF sta fpcsgn ; save sign |
||
10098 | 11528 F87C23 64 24 stz facsgn ; |x| |
||
10099 | 11529 F87C25 ACC16 |
||
10100 | 11530 F87C25 C2 20 rep #PMFLAG |
||
10101 | 11531 .LONGA on |
||
10102 | 11532 .MNLIST |
||
10103 | 11533 F87C27 A5 22 lda facexp |
||
10104 | 11534 F87C29 C9 FE 7F cmp #MAXEXP |
||
10105 | 11535 F87C2C B0 03 bcs ?cc2 |
||
10106 | 11536 F87C2E 1A inc a |
||
10107 | Tue Jul 17 11:00:18 2018 Page 164 |
||
10108 | |||
10109 | |||
10110 | |||
10111 | |||
10112 | 11537 F87C2F 85 22 sta facexp |
||
10113 | 11538 F87C31 ?cc2: ACC08 |
||
10114 | 11539 F87C31 E2 20 sep #PMFLAG |
||
10115 | 11540 .LONGA off |
||
10116 | 11541 .MNLIST |
||
10117 | 11542 F87C33 B0 16 bcs ?th1 ; overflow: return +1 |
||
10118 | 11543 F87C35 20 6B 68 jsr fexp ; exp(|2x|) |
||
10119 | 11544 F87C38 B0 11 bcs ?th1 ; overflow |
||
10120 | 11545 F87C3A 20 6C 45 jsr faddone |
||
10121 | 11546 F87C3D 20 AD 4E jsr ldatwo ; arg=2.0 |
||
10122 | 11547 F87C40 20 10 4A jsr fpdiv ; 2/(exp(|2x|)+1) |
||
10123 | 11548 F87C43 20 A6 4E jsr ldaone |
||
10124 | 11549 F87C46 20 5F 45 jsr fpsub ; 1 - 2/(exp(|2x|)+1) |
||
10125 | 11550 F87C49 80 03 bra ?done |
||
10126 | 11551 F87C4B 20 36 4E ?th1: jsr fld1 ; set fac=1 |
||
10127 | 11552 F87C4E A5 CF ?done: lda fpcsgn |
||
10128 | 11553 F87C50 85 24 sta facsgn ; set sign |
||
10129 | 11554 F87C52 18 ?ok: clc |
||
10130 | 11555 F87C53 60 rts |
||
10131 | 11556 F87C54 20 93 84 ?pp: jsr mvf_t1 ; tfr1=x |
||
10132 | 11557 F87C57 20 CC 49 jsr fsquare ; z=x*x |
||
10133 | 11558 F87C5A 20 66 84 jsr mvf_t0 ; tfr0=z |
||
10134 | 11559 F87C5D A9 44 lda #<cthp |
||
10135 | 11560 F87C5F A0 7F ldy #>cthp |
||
10136 | 11561 F87C61 A2 05 ldx #5 |
||
10137 | 11562 F87C63 20 1C 87 jsr peval ; evaluates P(z) |
||
10138 | 11563 F87C66 20 C0 84 jsr mvf_t2 ; tfr2=P(z) |
||
10139 | 11564 F87C69 A9 B0 lda #<cthq |
||
10140 | 11565 F87C6B A0 7F ldy #>cthq |
||
10141 | 11566 F87C6D A2 04 ldx #4 |
||
10142 | 11567 F87C6F 20 3A 87 jsr pevalp1 ; evaluates Q(z) |
||
10143 | 11568 F87C72 20 28 86 jsr mvt2_a ; arg=P(z) |
||
10144 | 11569 F87C75 20 10 4A jsr fpdiv ; R(z) |
||
10145 | 11570 F87C78 20 CE 85 jsr mvt0_a ; arg=z |
||
10146 | 11571 F87C7B 20 DD 49 jsr fpmult ; z*R(z) |
||
10147 | 11572 F87C7E 20 FB 85 jsr mvt1_a ; arg=x |
||
10148 | 11573 F87C81 20 DD 49 jsr fpmult ; x*z*R(z) |
||
10149 | 11574 F87C84 20 FB 85 jsr mvt1_a ; arg=x |
||
10150 | 11575 F87C87 4C 7D 45 jmp fpadd ; returns tanh(x)=x + x*z*R(z) |
||
10151 | 11576 |
||
10152 | 11577 ; fasinh - returns the inverse hyperbolic sine of the argument |
||
10153 | 11578 ; |
||
10154 | 11579 ; entry: |
||
10155 | 11580 ; fac=x |
||
10156 | 11581 ; |
||
10157 | 11582 ; exit: |
||
10158 | 11583 ; fac=asinh(x) |
||
10159 | 11584 ; CF = 1 if invalid result(inf or nan) |
||
10160 | 11585 ; |
||
10161 | 11586 ; strategy |
||
10162 | 11587 ; |
||
10163 | 11588 ; Mathematically asinh(x) = sgn(x)*ln[|x| + sqrt(x*x + 1)] |
||
10164 | 11589 ; |
||
10165 | 11590 ; 1) if |x| < 0.5 asinh(x) is approximated by a rational function: |
||
10166 | 11591 ; |
||
10167 | 11592 ; 3 P(z) 2 |
||
10168 | 11593 ; asinh(x) = x + x * R(z), R(z) = ------, z = x |
||
10169 | Tue Jul 17 11:00:18 2018 Page 165 |
||
10170 | |||
10171 | |||
10172 | |||
10173 | |||
10174 | 11594 ; Q(z) |
||
10175 | 11595 ; |
||
10176 | 11596 ; 2) if |x| >= 0.5: asinh(x) = sgn(x)*ln[|x| + sqrt(x*x + 1)] |
||
10177 | 11597 ; overflow will be avoided computing x*x or |x| + sqrt(...) |
||
10178 | 11598 ; approximating asinh(x) with: |
||
10179 | 11599 ; |
||
10180 | 11600 ; asinh(x) = sgn(x)*ln(2*|x|) if x*x overflow |
||
10181 | 11601 ; |
||
10182 | 11602 ; or: |
||
10183 | 11603 ; |
||
10184 | 11604 ; asinh(x) = sgn(x)*[ln(|x|) + ln(2)] if 2*|x| overflow |
||
10185 | 11605 ; |
||
10186 | 11606 ; computation mean time: 100/150ms at 4MHz |
||
10187 | 11607 ; |
||
10188 | 11608 ;------ |
||
10189 | 11609 F87C8A fasinh: |
||
10190 | 11610 ;------ |
||
10191 | 11611 F87C8A 38 sec |
||
10192 | 11612 F87C8B 24 25 bit facst ; if fac=nan or fac=inf returns nan or inf |
||
10193 | 11613 F87C8D 30 03 bmi ?rts |
||
10194 | 11614 F87C8F 50 02 bvc ?fv |
||
10195 | 11615 F87C91 18 clc ; if fac=0 returns zero |
||
10196 | 11616 F87C92 60 ?rts: rts |
||
10197 | 11617 F87C93 A5 24 ?fv: lda facsgn ; asinh(-x) = -asinh(x) |
||
10198 | 11618 F87C95 85 CF sta fpcsgn ; save sign |
||
10199 | 11619 F87C97 64 24 stz facsgn ; |x| |
||
10200 | 11620 F87C99 ACC16 |
||
10201 | 11621 F87C99 C2 20 rep #PMFLAG |
||
10202 | 11622 .LONGA on |
||
10203 | 11623 .MNLIST |
||
10204 | 11624 F87C9B A5 22 lda facexp |
||
10205 | 11625 F87C9D C9 FE 3F cmp #$3FFE ; 0.5 |
||
10206 | 11626 F87CA0 ACC08 |
||
10207 | 11627 F87CA0 E2 20 sep #PMFLAG |
||
10208 | 11628 .LONGA off |
||
10209 | 11629 .MNLIST |
||
10210 | 11630 F87CA2 08 php |
||
10211 | 11631 F87CA3 20 C0 84 jsr mvf_t2 ; tfr2=|x| |
||
10212 | 11632 F87CA6 20 CC 49 jsr fsquare ; z=x*x |
||
10213 | 11633 F87CA9 28 plp |
||
10214 | 11634 F87CAA 90 34 bcc ?lt05 ; |x| < 0.5 |
||
10215 | 11635 F87CAC 20 6C 45 jsr faddone ; z+1 |
||
10216 | 11636 F87CAF B0 10 bcs ?big ; x*x overflow |
||
10217 | 11637 F87CB1 20 53 60 jsr fsqrt ; sqrt(z+1) |
||
10218 | 11638 F87CB4 20 28 86 jsr mvt2_a ; arg=x |
||
10219 | 11639 F87CB7 20 7D 45 jsr fpadd ; x+sqrt(z+1) |
||
10220 | 11640 F87CBA B0 05 bcs ?big ; overflow |
||
10221 | 11641 F87CBC 20 B3 62 jsr floge ; ln(x+sqrt(z+1)) |
||
10222 | 11642 F87CBF 80 4F bra ?done |
||
10223 | 11643 F87CC1 20 A1 85 ?big: jsr mvt2_f |
||
10224 | 11644 F87CC4 20 39 84 jsr mvftoa |
||
10225 | 11645 F87CC7 20 7D 45 jsr fpadd ; try 2*|x| |
||
10226 | 11646 F87CCA B0 05 bcs ?big1 ; overflow |
||
10227 | 11647 F87CCC 20 B3 62 jsr floge ; asinh(x) = sgn(x)*(ln(2*|x|)) |
||
10228 | 11648 F87CCF 80 3F bra ?done |
||
10229 | 11649 F87CD1 20 A1 85 ?big1: jsr mvt2_f |
||
10230 | 11650 F87CD4 20 B3 62 jsr floge |
||
10231 | Tue Jul 17 11:00:18 2018 Page 166 |
||
10232 | |||
10233 | |||
10234 | |||
10235 | |||
10236 | 11651 F87CD7 A9 B1 lda #<cln2 ; asinh(x) = sgn(x)*(ln(|x|) + ln(2)) |
||
10237 | 11652 F87CD9 A0 67 ldy #>cln2 |
||
10238 | 11653 F87CDB 20 7A 45 jsr fcadd |
||
10239 | 11654 F87CDE 80 30 bra ?done |
||
10240 | 11655 F87CE0 20 66 84 ?lt05: jsr mvf_t0 ; tfr0=z |
||
10241 | 11656 F87CE3 A9 0A lda #<cashp |
||
10242 | 11657 F87CE5 A0 80 ldy #>cashp |
||
10243 | 11658 F87CE7 A2 08 ldx #8 |
||
10244 | 11659 F87CE9 20 1C 87 jsr peval ; evaluates P(z) |
||
10245 | 11660 F87CEC 20 93 84 jsr mvf_t1 ; tfr2=P(z) |
||
10246 | 11661 F87CEF A9 AC lda #<cashq |
||
10247 | 11662 F87CF1 A0 80 ldy #>cashq |
||
10248 | 11663 F87CF3 A2 08 ldx #8 |
||
10249 | 11664 F87CF5 20 3A 87 jsr pevalp1 ; evaluates Q(z) |
||
10250 | 11665 F87CF8 20 FB 85 jsr mvt1_a ; arg=P(z) |
||
10251 | 11666 F87CFB 20 10 4A jsr fpdiv ; R(z) |
||
10252 | 11667 F87CFE 20 CE 85 jsr mvt0_a ; arg=z |
||
10253 | 11668 F87D01 20 DD 49 jsr fpmult ; z*R(z) |
||
10254 | 11669 F87D04 20 28 86 jsr mvt2_a ; arg=x |
||
10255 | 11670 F87D07 20 DD 49 jsr fpmult ; x*z*R(z) |
||
10256 | 11671 F87D0A 20 28 86 jsr mvt2_a ; arg=x |
||
10257 | 11672 F87D0D 20 7D 45 jsr fpadd ; asinh(x)=x + x*z*R(z) |
||
10258 | 11673 F87D10 A5 CF ?done: lda fpcsgn ; set sign |
||
10259 | 11674 F87D12 85 24 sta facsgn |
||
10260 | 11675 F87D14 60 rts |
||
10261 | 11676 |
||
10262 | 11677 ; facosh - returns the inverse hyperbolic cosine of the argument |
||
10263 | 11678 ; |
||
10264 | 11679 ; entry: |
||
10265 | 11680 ; fac=x |
||
10266 | 11681 ; |
||
10267 | 11682 ; exit: |
||
10268 | 11683 ; fac=acosh(x) |
||
10269 | 11684 ; CF = 1 if invalid result(inf or nan) |
||
10270 | 11685 ; |
||
10271 | 11686 ; strategy |
||
10272 | 11687 ; |
||
10273 | 11688 ; Mathematically acosh(x) = ln[x + sqrt(x*x - 1)], x >= 1 |
||
10274 | 11689 ; |
||
10275 | 11690 ; 1) if 1 <= x < 1.5 acosh(x) is approximated by a rational function: |
||
10276 | 11691 ; |
||
10277 | 11692 ; P(z) |
||
10278 | 11693 ; acosh(x) = sqrt(2*z) * R(z), R(z) = ------, z = x - 1 |
||
10279 | 11694 ; Q(z) |
||
10280 | 11695 ; |
||
10281 | 11696 ; 2) if |x| >= 1.5: acosh(x) = ln[x + sqrt(x*x - 1)] |
||
10282 | 11697 ; overflow will be avoided computing x*x or x + sqrt(...) |
||
10283 | 11698 ; approximating acosh(x) with: |
||
10284 | 11699 ; |
||
10285 | 11700 ; acosh(x) = ln(2*x) if x*x overflow |
||
10286 | 11701 ; |
||
10287 | 11702 ; or: |
||
10288 | 11703 ; |
||
10289 | 11704 ; acosh(x) = ln(x) + ln(2) if 2*x overflow |
||
10290 | 11705 ; |
||
10291 | 11706 ; computation mean time: 75/150ms at 4MHz |
||
10292 | 11707 ; |
||
10293 | Tue Jul 17 11:00:18 2018 Page 167 |
||
10294 | |||
10295 | |||
10296 | |||
10297 | |||
10298 | 11708 ;------ |
||
10299 | 11709 F87D15 facosh: |
||
10300 | 11710 ;------ |
||
10301 | 11711 F87D15 A5 24 lda facsgn ; acosh(x) defined only if x>=1 |
||
10302 | 11712 F87D17 30 0B bmi ?nan |
||
10303 | 11713 F87D19 24 25 bit facst |
||
10304 | 11714 F87D1B 30 0A bmi ?er ; nan or inf; returns nan or inf |
||
10305 | 11715 F87D1D 20 24 74 jsr cmpx1 ; compare x with 1.0 |
||
10306 | 11716 F87D20 F0 07 beq ?z ; acosh(1) = 0 |
||
10307 | 11717 F87D22 B0 08 bcs ?ok ; returns nan if |x|<1 |
||
10308 | 11718 F87D24 4C 74 4E ?nan: jmp fldnan |
||
10309 | 11719 F87D27 38 ?er: sec |
||
10310 | 11720 F87D28 60 rts |
||
10311 | 11721 F87D29 4C 56 4E ?z: jmp fldz |
||
10312 | 11722 F87D2C A9 5A ?ok: lda #<c1h5 |
||
10313 | 11723 F87D2E A0 7E ldy #>c1h5 |
||
10314 | 11724 F87D30 20 5E 87 jsr fccmp ; compare x vs. 1.5 |
||
10315 | 11725 F87D33 F0 3B beq ?gt ; x = 1.5 |
||
10316 | 11726 F87D35 10 39 bpl ?gt ; x > 1.5 |
||
10317 | 11727 F87D37 20 71 45 jsr fsubone ; z = x - 1 (x < 1.5) |
||
10318 | 11728 F87D3A 20 66 84 jsr mvf_t0 ; tfr0=z |
||
10319 | 11729 F87D3D 20 39 84 jsr mvftoa |
||
10320 | 11730 F87D40 20 7D 45 jsr fpadd ; 2*z |
||
10321 | 11731 F87D43 20 C0 84 jsr mvf_t2 ; tfr2 = 2*z |
||
10322 | 11732 F87D46 A9 4E lda #<cachp |
||
10323 | 11733 F87D48 A0 81 ldy #>cachp |
||
10324 | 11734 F87D4A A2 09 ldx #9 |
||
10325 | 11735 F87D4C 20 1C 87 jsr peval ; evaluates P(z) |
||
10326 | 11736 F87D4F 20 93 84 jsr mvf_t1 ; tfr1=P(z) |
||
10327 | 11737 F87D52 A9 02 lda #<cachq |
||
10328 | 11738 F87D54 A0 82 ldy #>cachq |
||
10329 | 11739 F87D56 A2 08 ldx #8 |
||
10330 | 11740 F87D58 20 3A 87 jsr pevalp1 ; evaluates Q(z) |
||
10331 | 11741 F87D5B 20 FB 85 jsr mvt1_a ; arg=P(z) |
||
10332 | 11742 F87D5E 20 10 4A jsr fpdiv ; R(z) |
||
10333 | 11743 F87D61 20 ED 84 jsr mvf_t3 ; tfr3 = R(z) |
||
10334 | 11744 F87D64 20 A1 85 jsr mvt2_f ; fac=2*z |
||
10335 | 11745 F87D67 20 53 60 jsr fsqrt ; sqrt(2*z) |
||
10336 | 11746 F87D6A 20 55 86 jsr mvt3_a ; R(z) |
||
10337 | 11747 F87D6D 4C DD 49 jmp fpmult ; acosh(x) = sqrt(2*z)*R(z) |
||
10338 | 11748 F87D70 20 C0 84 ?gt: jsr mvf_t2 ; tfr2 = x |
||
10339 | 11749 F87D73 20 CC 49 jsr fsquare |
||
10340 | 11750 F87D76 B0 11 bcs ?big ; x*x overflow |
||
10341 | 11751 F87D78 20 71 45 jsr fsubone ; x*x - 1 |
||
10342 | 11752 F87D7B 20 53 60 jsr fsqrt |
||
10343 | 11753 F87D7E 20 28 86 jsr mvt2_a ; x |
||
10344 | 11754 F87D81 20 7D 45 jsr fpadd |
||
10345 | 11755 F87D84 B0 03 bcs ?big ; overflow |
||
10346 | 11756 F87D86 4C B3 62 jmp floge ; acosh(x) = ln[x + sqrt(x*x - 1)] |
||
10347 | 11757 F87D89 20 A1 85 ?big: jsr mvt2_f ; x |
||
10348 | 11758 F87D8C 20 39 84 jsr mvftoa |
||
10349 | 11759 F87D8F 20 7D 45 jsr fpadd ; try 2*x |
||
10350 | 11760 F87D92 B0 03 bcs ?big1 ; overflow |
||
10351 | 11761 F87D94 4C B3 62 jmp floge ; acosh(x) = ln(2*x) |
||
10352 | 11762 F87D97 20 A1 85 ?big1: jsr mvt2_f ; x |
||
10353 | 11763 F87D9A 20 B3 62 jsr floge |
||
10354 | 11764 F87D9D A9 B1 lda #<cln2 ; acosh(x) = ln(x) + ln(2) |
||
10355 | Tue Jul 17 11:00:18 2018 Page 168 |
||
10356 | |||
10357 | |||
10358 | |||
10359 | |||
10360 | 11765 F87D9F A0 67 ldy #>cln2 |
||
10361 | 11766 F87DA1 4C 7A 45 jmp fcadd |
||
10362 | 11767 |
||
10363 | 11768 ; fatanh - returns the inverse hyperbolic tangent of the argument |
||
10364 | 11769 ; |
||
10365 | 11770 ; entry: |
||
10366 | 11771 ; fac=x |
||
10367 | 11772 ; |
||
10368 | 11773 ; exit: |
||
10369 | 11774 ; fac=atanh(x) |
||
10370 | 11775 ; CF = 1 if invalid result(inf or nan) |
||
10371 | 11776 ; |
||
10372 | 11777 ; strategy |
||
10373 | 11778 ; 1 1 + x |
||
10374 | 11779 ; Mathematically atanh(x) = --- * ln(-------) , -1 < x < 1 |
||
10375 | 11780 ; 2 1 - x |
||
10376 | 11781 ; |
||
10377 | 11782 ; 1) if |x| < 0.5 atanh(x) is approximated by a rational function: |
||
10378 | 11783 ; |
||
10379 | 11784 ; 3 P(z) 2 |
||
10380 | 11785 ; atanh(x) = x + x * R(z), R(z) = ------, z = x |
||
10381 | 11786 ; Q(z) |
||
10382 | 11787 ; |
||
10383 | 11788 ; 2) if |x| >= 0.5: |
||
10384 | 11789 ; |
||
10385 | 11790 ; 1 1 + |x| |
||
10386 | 11791 ; atanh(x) = --- * sgn(x) * ln(---------) |
||
10387 | 11792 ; 2 1 - |x| |
||
10388 | 11793 ; |
||
10389 | 11794 ; computation mean time: 80/100ms at 4MHz |
||
10390 | 11795 ; |
||
10391 | 11796 ;------ |
||
10392 | 11797 F87DA4 fatanh: |
||
10393 | 11798 ;------ |
||
10394 | 11799 F87DA4 24 25 bit facst ; if fac=nan or fac=inf returns nan |
||
10395 | 11800 F87DA6 30 07 bmi ?nan |
||
10396 | 11801 F87DA8 50 08 bvc ?fv |
||
10397 | 11802 F87DAA 18 clc ; if fac=0 returns zero |
||
10398 | 11803 F87DAB 60 rts |
||
10399 | 11804 F87DAC 4C 7D 4E ?inf: jmp fldinf |
||
10400 | 11805 F87DAF 4C 74 4E ?nan: jmp fldnan ; if |x| > 1 returns nan |
||
10401 | 11806 F87DB2 20 24 74 ?fv: jsr cmpx1 ; compare x vs. 1.0 |
||
10402 | 11807 F87DB5 F0 F5 beq ?inf ; atanh(+/-1) = +/-inf |
||
10403 | 11808 F87DB7 B0 F6 bcs ?nan ; if |x| > 1 returns nan |
||
10404 | 11809 F87DB9 ACC16 |
||
10405 | 11810 F87DB9 C2 20 rep #PMFLAG |
||
10406 | 11811 .LONGA on |
||
10407 | 11812 .MNLIST |
||
10408 | 11813 F87DBB A5 22 lda facexp |
||
10409 | 11814 F87DBD C9 FE 3F cmp #$3FFE ; compare x vs. 0.5 |
||
10410 | 11815 F87DC0 ACC08 |
||
10411 | 11816 F87DC0 E2 20 sep #PMFLAG |
||
10412 | 11817 .LONGA off |
||
10413 | 11818 .MNLIST |
||
10414 | 11819 F87DC2 B0 36 bcs ?gt ; |x| >= 0.5 |
||
10415 | 11820 F87DC4 20 C0 84 jsr mvf_t2 ; tfr2 = x |
||
10416 | 11821 F87DC7 20 CC 49 jsr fsquare ; z=x*x |
||
10417 | Tue Jul 17 11:00:18 2018 Page 169 |
||
10418 | |||
10419 | |||
10420 | |||
10421 | |||
10422 | 11822 F87DCA 20 66 84 jsr mvf_t0 ; tfr0=z |
||
10423 | 11823 F87DCD A9 A4 lda #<cathp |
||
10424 | 11824 F87DCF A0 82 ldy #>cathp |
||
10425 | 11825 F87DD1 A2 09 ldx #9 |
||
10426 | 11826 F87DD3 20 1C 87 jsr peval ; evaluates P(z) |
||
10427 | 11827 F87DD6 20 93 84 jsr mvf_t1 ; tfr2=P(z) |
||
10428 | 11828 F87DD9 A9 58 lda #<cathq |
||
10429 | 11829 F87DDB A0 83 ldy #>cathq |
||
10430 | 11830 F87DDD A2 09 ldx #9 |
||
10431 | 11831 F87DDF 20 3A 87 jsr pevalp1 ; evaluates Q(z) |
||
10432 | 11832 F87DE2 20 FB 85 jsr mvt1_a ; arg=P(z) |
||
10433 | 11833 F87DE5 20 10 4A jsr fpdiv ; R(z) |
||
10434 | 11834 F87DE8 20 CE 85 jsr mvt0_a ; arg=z |
||
10435 | 11835 F87DEB 20 DD 49 jsr fpmult ; z*R(z) |
||
10436 | 11836 F87DEE 20 28 86 jsr mvt2_a ; arg=x |
||
10437 | 11837 F87DF1 20 DD 49 jsr fpmult ; x*z*R(z) |
||
10438 | 11838 F87DF4 20 28 86 jsr mvt2_a ; arg=x |
||
10439 | 11839 F87DF7 4C 7D 45 jmp fpadd ; atanh(x)=x + x*z*R(z) |
||
10440 | 11840 F87DFA A5 24 ?gt: lda facsgn |
||
10441 | 11841 F87DFC 85 CF sta fpcsgn ; save x sign |
||
10442 | 11842 F87DFE 64 24 stz facsgn ; |x| |
||
10443 | 11843 F87E00 20 66 84 jsr mvf_t0 ; tfr0 = |x| |
||
10444 | 11844 F87E03 20 6C 45 jsr faddone ; y = 1 + |x| |
||
10445 | 11845 F87E06 20 93 84 jsr mvf_t1 ; tfr1 = y |
||
10446 | 11846 F87E09 20 47 85 jsr mvt0_f ; |x| |
||
10447 | 11847 F87E0C A9 48 lda #<cthl |
||
10448 | 11848 F87E0E A0 7E ldy #>cthl |
||
10449 | 11849 F87E10 20 5E 87 jsr fccmp ; compare |x| vs. 0.9990234375 |
||
10450 | 11850 F87E13 30 19 bmi ?dom1 ; if |x| <= 0.9990234375... |
||
10451 | 11851 F87E15 F0 17 beq ?dom1 ; ...computes z = 1 - |x| |
||
10452 | 11852 F87E17 A9 B3 lda #<fce32 ; otherwisa scale by 1e32 |
||
10453 | 11853 F87E19 A0 5F ldy #>fce32 |
||
10454 | 11854 F87E1B 20 D5 49 jsr fcmult |
||
10455 | 11855 F87E1E A9 B3 lda #<fce32 ; computes z = 1e32 - |x|*1e32 |
||
10456 | 11856 F87E20 A0 5F ldy #>fce32 |
||
10457 | 11857 F87E22 20 5C 45 jsr fcsub |
||
10458 | 11858 F87E25 A9 B3 lda #<fce32 ; scale back |
||
10459 | 11859 F87E27 A0 5F ldy #>fce32 |
||
10460 | 11860 F87E29 20 0A 4A jsr fcrdiv ; z = 1 - |x| |
||
10461 | 11861 F87E2C 80 06 bra ?div |
||
10462 | 11862 F87E2E 20 A6 4E ?dom1: jsr ldaone ; arg=1 |
||
10463 | 11863 F87E31 20 5F 45 jsr fpsub ; z = 1 - |x| |
||
10464 | 11864 F87E34 20 FB 85 ?div: jsr mvt1_a ; arg = y = 1 + |x| |
||
10465 | 11865 F87E37 20 10 4A jsr fpdiv ; w = y/z |
||
10466 | 11866 F87E3A 20 B3 62 jsr floge ; ln(w) = ln[(1 + |x|)/(1 - |x|)] |
||
10467 | 11867 F87E3D ACC16 |
||
10468 | 11868 F87E3D C2 20 rep #PMFLAG |
||
10469 | 11869 .LONGA on |
||
10470 | 11870 .MNLIST |
||
10471 | 11871 F87E3F C6 22 dec facexp ; divide by2 |
||
10472 | 11872 F87E41 ACC08 |
||
10473 | 11873 F87E41 E2 20 sep #PMFLAG |
||
10474 | 11874 .LONGA off |
||
10475 | 11875 .MNLIST |
||
10476 | 11876 F87E43 A5 CF lda fpcsgn ; restore sign |
||
10477 | 11877 F87E45 85 24 sta facsgn |
||
10478 | 11878 F87E47 60 rts |
||
10479 | Tue Jul 17 11:00:18 2018 Page 170 |
||
10480 | |||
10481 | |||
10482 | |||
10483 | |||
10484 | 11879 |
||
10485 | 11880 ; 0.9990234375 = tanh(3.81206529283064476456228418624) |
||
10486 | 11881 F87E48 00 00 00 00 00 cthl: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
10487 | 00 00 00 00 |
||
10488 | 11882 F87E51 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$C0,$FF,$FE,$3F |
||
10489 | C0 FF FE 3F |
||
10490 | 11883 ; 1.5 |
||
10491 | 11884 F87E5A 00 00 00 00 00 c1h5: .DB $00,$00,$00,$00,$00,$00,$00,$00,$00 |
||
10492 | 00 00 00 00 |
||
10493 | 11885 F87E63 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$C0,$FF,$3F |
||
10494 | 00 C0 FF 3F |
||
10495 | 11886 |
||
10496 | 11887 ; sinh(x) coefficients |
||
10497 | 11888 F87E6C cshp: |
||
10498 | 11889 ; SHP[5] = 1.622194395724068297909052717437740288268E3 |
||
10499 | 11890 F87E6C 17 69 DD D3 6C .DB $17,$69,$DD,$D3,$6C,$86,$A5,$72,$E8 |
||
10500 | 86 A5 72 E8 |
||
10501 | 11891 F87E75 60 AB 61 7D 38 .DB $60,$AB,$61,$7D,$38,$C6,$CA,$09,$40 |
||
10502 | C6 CA 09 40 |
||
10503 | 11892 |
||
10504 | 11893 ; SHP[4] = 1.124862584587770079742188354390171794549E6 |
||
10505 | 11894 F87E7E 1D 93 DF 58 C9 .DB $1D,$93,$DF,$58,$C9,$1A,$0E,$8E,$12 |
||
10506 | 1A 0E 8E 12 |
||
10507 | 11895 F87E87 51 5A 3C AD F4 .DB $51,$5A,$3C,$AD,$F4,$4F,$89,$13,$40 |
||
10508 | 4F 89 13 40 |
||
10509 | 11896 |
||
10510 | 11897 ; SHP[3] = 3.047548980769660162696832999871894196102E8 |
||
10511 | 11898 F87E90 9E C2 A9 C6 06 .DB $9E,$C2,$A9,$C6,$06,$9F,$E8,$40,$D6 |
||
10512 | 9F E8 40 D6 |
||
10513 | 11899 F87E99 5B A0 9D 90 86 .DB $5B,$A0,$9D,$90,$86,$51,$91,$1B,$40 |
||
10514 | 51 91 1B 40 |
||
10515 | 11900 |
||
10516 | 11901 ; SHP[2] = 3.966215348072348368191433063260384329745E10 |
||
10517 | 11902 F87EA2 2F 3F 63 A6 E4 .DB $2F,$3F,$63,$A6,$E4,$FD,$2F,$10,$A0 |
||
10518 | FD 2F 10 A0 |
||
10519 | 11903 F87EAB 63 93 8B F0 C6 .DB $63,$93,$8B,$F0,$C6,$C0,$93,$22,$40 |
||
10520 | C0 93 22 40 |
||
10521 | 11904 |
||
10522 | 11905 ; SHP[1] = 2.375869584584371194838551715348965605295E12 |
||
10523 | 11906 F87EB4 0E D1 C3 AC F2 .DB $0E,$D1,$C3,$AC,$F2,$82,$01,$FF,$A7 |
||
10524 | 82 01 FF A7 |
||
10525 | 11907 F87EBD C1 17 32 35 37 .DB $C1,$17,$32,$35,$37,$4B,$8A,$28,$40 |
||
10526 | 4B 8A 28 40 |
||
10527 | 11908 |
||
10528 | 11909 ; SHP[0] = 6.482835792103233269752264509192030816323E13 |
||
10529 | 11910 F87EC6 6C 44 21 C8 30 .DB $6C,$44,$21,$C8,$30,$E2,$CC,$A8,$AE |
||
10530 | E2 CC A8 AE |
||
10531 | 11911 F87ECF 54 21 24 FB 1C .DB $54,$21,$24,$FB,$1C,$D8,$EB,$2C,$40 |
||
10532 | D8 EB 2C 40 |
||
10533 | 11912 |
||
10534 | 11913 F87ED8 cshq: |
||
10535 | 11914 ; SHQ[5] = -9.101683853129357776079049616394849086007E2 |
||
10536 | 11915 F87ED8 E1 53 03 04 33 .DB $E1,$53,$03,$04,$33,$F5,$4A,$94,$A1 |
||
10537 | F5 4A 94 A1 |
||
10538 | 11916 F87EE1 E5 0B 31 D3 C6 .DB $E5,$0B,$31,$D3,$C6,$8A,$E3,$08,$C0 |
||
10539 | 8A E3 08 C0 |
||
10540 | 11917 |
||
10541 | Tue Jul 17 11:00:18 2018 Page 171 |
||
10542 | |||
10543 | |||
10544 | |||
10545 | |||
10546 | 11918 ; SHQ[4] = 4.486400519836461218634448973793765123186E5 |
||
10547 | 11919 F87EEA 1B 10 39 12 99 .DB $1B,$10,$39,$12,$99,$3F,$E1,$CF,$A5 |
||
10548 | 3F E1 CF A5 |
||
10549 | 11920 F87EF3 80 9B D9 A9 01 .DB $80,$9B,$D9,$A9,$01,$10,$DB,$11,$40 |
||
10550 | 10 DB 11 40 |
||
10551 | 11921 |
||
10552 | 11922 ; SHQ[3] = -1.492531313030440305095318968983514314656E8 |
||
10553 | 11923 F87EFC E3 FC 9D E6 6A .DB $E3,$FC,$9D,$E6,$6A,$12,$5D,$95,$84 |
||
10554 | 12 5D 95 84 |
||
10555 | 11924 F87F05 B2 44 D9 B4 C0 .DB $B2,$44,$D9,$B4,$C0,$56,$8E,$1A,$C0 |
||
10556 | 56 8E 1A C0 |
||
10557 | 11925 |
||
10558 | 11926 ; SHQ[2] = 3.457771488856930054902696708717192082887E10 |
||
10559 | 11927 F87F0E 36 87 1A 50 C3 .DB $36,$87,$1A,$50,$C3,$93,$A6,$7A,$E4 |
||
10560 | 93 A6 7A E4 |
||
10561 | 11928 F87F17 DA 1B 89 EC E0 .DB $DA,$1B,$89,$EC,$E0,$CF,$80,$22,$40 |
||
10562 | CF 80 22 40 |
||
10563 | 11929 |
||
10564 | 11930 ; SHQ[1] = -5.193289868803472640225483235513427062460E12 |
||
10565 | 11931 F87F20 DF 76 FE 54 9D .DB $DF,$76,$FE,$54,$9D,$2F,$E7,$64,$DE |
||
10566 | 2F E7 64 DE |
||
10567 | 11932 F87F29 1F 6F C0 54 06 .DB $1F,$6F,$C0,$54,$06,$25,$97,$29,$C0 |
||
10568 | 25 97 29 C0 |
||
10569 | 11933 |
||
10570 | 11934 ; SHQ[0] = 3.889701475261939961851358705515223019890E14 |
||
10571 | 11935 F87F32 F5 20 1D 96 A4 .DB $F5,$20,$1D,$96,$A4,$A9,$99,$FE,$82 |
||
10572 | A9 99 FE 82 |
||
10573 | 11936 F87F3B FF 18 5B BC 15 .DB $FF,$18,$5B,$BC,$15,$E2,$B0,$2F,$40 |
||
10574 | E2 B0 2F 40 |
||
10575 | 11937 |
||
10576 | 11938 ; tanh(x) coefficients |
||
10577 | 11939 F87F44 cthp: |
||
10578 | 11940 ; THP[5] = -6.505693197948351084912624750702492767503E-6 |
||
10579 | 11941 F87F44 A5 DE 0A CF 2E .DB $A5,$DE,$0A,$CF,$2E,$1F,$25,$59,$90 |
||
10580 | 1F 25 59 90 |
||
10581 | 11942 F87F4D 92 24 C2 A2 7A .DB $92,$24,$C2,$A2,$7A,$4B,$DA,$ED,$BF |
||
10582 | 4B DA ED BF |
||
10583 | 11943 |
||
10584 | 11944 ; THP[4] = -9.804083860188429726356968570322356183383E-1 |
||
10585 | 11945 F87F56 2F F3 D5 9C 7D .DB $2F,$F3,$D5,$9C,$7D,$E3,$C3,$6C,$CA |
||
10586 | E3 C3 6C CA |
||
10587 | 11946 F87F5F A9 D1 AC 42 0B .DB $A9,$D1,$AC,$42,$0B,$FC,$FA,$FE,$BF |
||
10588 | FC FA FE BF |
||
10589 | 11947 |
||
10590 | 11948 ; THP[3] = -5.055287638900473250703725789725376004355E2 |
||
10591 | 11949 F87F68 74 6D 2D 35 A2 .DB $74,$6D,$2D,$35,$A2,$58,$08,$D8,$58 |
||
10592 | 58 08 D8 58 |
||
10593 | 11950 F87F71 8D 87 FF 88 AE .DB $8D,$87,$FF,$88,$AE,$C3,$FC,$07,$C0 |
||
10594 | C3 FC 07 C0 |
||
10595 | 11951 |
||
10596 | 11952 ; THP[2] = -7.307477148073823966594990496301416814519E4 |
||
10597 | 11953 F87F7A 96 63 D3 D4 55 .DB $96,$63,$D3,$D4,$55,$B8,$E3,$D5,$DC |
||
10598 | B8 E3 D5 DC |
||
10599 | 11954 F87F83 1D 7E E1 BF 62 .DB $1D,$7E,$E1,$BF,$62,$B9,$8E,$0F,$C0 |
||
10600 | B9 8E 0F C0 |
||
10601 | 11955 |
||
10602 | 11956 ; THP[1] = -3.531606586182691280701462523692471322688E6 |
||
10603 | Tue Jul 17 11:00:18 2018 Page 172 |
||
10604 | |||
10605 | |||
10606 | |||
10607 | |||
10608 | 11957 F87F8C 96 14 AC DD D7 .DB $96,$14,$AC,$DD,$D7,$7B,$66,$A4,$20 |
||
10609 | 7B 66 A4 20 |
||
10610 | 11958 F87F95 82 46 40 58 5A .DB $82,$46,$40,$58,$5A,$8D,$D7,$14,$C0 |
||
10611 | 8D D7 14 C0 |
||
10612 | 11959 |
||
10613 | 11960 ; THP[0] = -4.551377146142783468144190926206842300707E7 |
||
10614 | 11961 F87F9E E4 75 8D 86 22 .DB $E4,$75,$8D,$86,$22,$74,$D2,$EF,$DA |
||
10615 | 74 D2 EF DA |
||
10616 | 11962 F87FA7 9C 08 88 DD 0A .DB $9C,$08,$88,$DD,$0A,$9F,$AD,$18,$C0 |
||
10617 | 9F AD 18 C0 |
||
10618 | 11963 |
||
10619 | 11964 F87FB0 cthq: |
||
10620 | 11965 ; THQ[4] = 5.334865598460027935735737253027154828002E2 |
||
10621 | 11966 F87FB0 19 BD 0A 16 6E .DB $19,$BD,$0A,$16,$6E,$A3,$F1,$38,$2C |
||
10622 | A3 F1 38 2C |
||
10623 | 11967 F87FB9 3E 88 E8 CB 23 .DB $3E,$88,$E8,$CB,$23,$5F,$85,$08,$40 |
||
10624 | 5F 85 08 40 |
||
10625 | 11968 |
||
10626 | 11969 ; THQ[3] = 8.058475607422391042912151298751537172870E4 |
||
10627 | 11970 F87FC2 9F 9E F9 42 21 .DB $9F,$9E,$F9,$42,$21,$C6,$63,$AC,$9D |
||
10628 | C6 63 AC 9D |
||
10629 | 11971 F87FCB 85 48 0A C7 60 .DB $85,$48,$0A,$C7,$60,$64,$9D,$0F,$40 |
||
10630 | 64 9D 0F 40 |
||
10631 | 11972 |
||
10632 | 11973 ; THQ[2] = 4.197073523796142343374222405869721575491E6 |
||
10633 | 11974 F87FD4 22 53 FB 45 7B .DB $22,$53,$FB,$45,$7B,$BE,$6D,$81,$45 |
||
10634 | BE 6D 81 45 |
||
10635 | 11975 F87FDD 0A 02 2F 0C A3 .DB $0A,$02,$2F,$0C,$A3,$15,$80,$15,$40 |
||
10636 | 15 80 15 40 |
||
10637 | 11976 |
||
10638 | 11977 ; THQ[1] = 6.521134551226147545983467868553677881771E7 |
||
10639 | 11978 F87FE6 95 2E 27 14 95 .DB $95,$2E,$27,$14,$95,$C2,$CF,$71,$06 |
||
10640 | C2 CF 71 06 |
||
10641 | 11979 F87FEF 5B E4 C8 60 F4 .DB $5B,$E4,$C8,$60,$F4,$C2,$F8,$18,$40 |
||
10642 | C2 F8 18 40 |
||
10643 | 11980 |
||
10644 | 11981 ; THQ[0] = 1.365413143842835040443257277862054198329E8 |
||
10645 | 11982 F87FF8 34 03 ED E4 19 .DB $34,$03,$ED,$E4,$19,$D7,$DD,$33,$A4 |
||
10646 | D7 DD 33 A4 |
||
10647 | 11983 F88001 75 06 26 26 48 .DB $75,$06,$26,$26,$48,$37,$82,$1A,$40 |
||
10648 | 37 82 1A 40 |
||
10649 | 11984 |
||
10650 | 11985 ; asinh(x) coefficients |
||
10651 | 11986 F8800A cashp: |
||
10652 | 11987 ; ASHP[8] = -8.104404283317298189545629468767571317688E-1 |
||
10653 | 11988 F8800A D4 44 8A 29 62 .DB $D4,$44,$8A,$29,$62,$9C,$61,$3B,$4F |
||
10654 | 9C 61 3B 4F |
||
10655 | 11989 F88013 B9 7F 0A 1F 06 .DB $B9,$7F,$0A,$1F,$06,$79,$CF,$FE,$BF |
||
10656 | 79 CF FE BF |
||
10657 | 11990 |
||
10658 | 11991 ; ASHP[7] = -4.954206127425209147110732546633675599008E1 |
||
10659 | 11992 F8801C 4C 2A 14 A7 8C .DB $4C,$2A,$14,$A7,$8C,$5D,$7A,$C6,$D8 |
||
10660 | 5D 7A C6 D8 |
||
10661 | 11993 F88025 FF 5C 55 1C 12 .DB $FF,$5C,$55,$1C,$12,$2B,$C6,$04,$C0 |
||
10662 | 2B C6 04 C0 |
||
10663 | 11994 |
||
10664 | 11995 ; ASHP[6] = -8.438175619831548439550086251740438689853E2 |
||
10665 | Tue Jul 17 11:00:18 2018 Page 173 |
||
10666 | |||
10667 | |||
10668 | |||
10669 | |||
10670 | 11996 F8802E 1F E6 69 54 E9 .DB $1F,$E6,$69,$54,$E9,$DD,$A7,$DA,$DB |
||
10671 | DD A7 DA DB |
||
10672 | 11997 F88037 96 06 7F EF 52 .DB $96,$06,$7F,$EF,$52,$F4,$D2,$08,$C0 |
||
10673 | F4 D2 08 C0 |
||
10674 | 11998 |
||
10675 | 11999 ; ASHP[5] = -6.269710069245210459536983820505214648057E3 |
||
10676 | 12000 F88040 4D 94 05 70 20 .DB $4D,$94,$05,$70,$20,$FD,$0E,$76,$39 |
||
10677 | FD 0E 76 39 |
||
10678 | 12001 F88049 98 D0 C8 38 AE .DB $98,$D0,$C8,$38,$AE,$ED,$C3,$0B,$C0 |
||
10679 | ED C3 0B C0 |
||
10680 | 12002 |
||
10681 | 12003 ; ASHP[4] = -2.418935474493501382372711518024193326434E4 |
||
10682 | 12004 F88052 65 46 D1 97 6C .DB $65,$46,$D1,$97,$6C,$45,$6A,$6B,$AE |
||
10683 | 45 6A 6B AE |
||
10684 | 12005 F8805B 9C CC 20 A1 B5 .DB $9C,$CC,$20,$A1,$B5,$FA,$BC,$0D,$C0 |
||
10685 | FA BC 0D C0 |
||
10686 | 12006 |
||
10687 | 12007 ; ASHP[3] = -5.208121780431312783866941311277024486498E4 |
||
10688 | 12008 F88064 C1 0A 1C 9F EE .DB $C1,$0A,$1C,$9F,$EE,$A5,$FC,$D0,$D2 |
||
10689 | A5 FC D0 D2 |
||
10690 | 12009 F8806D CF 01 06 C2 37 .DB $CF,$01,$06,$C2,$37,$71,$CB,$0E,$C0 |
||
10691 | 71 CB 0E C0 |
||
10692 | 12010 |
||
10693 | 12011 ; ASHP[2] = -6.302755086521614763280617114866439227971E4 |
||
10694 | 12012 F88076 27 92 3C F6 A2 .DB $27,$92,$3C,$F6,$A2,$88,$78,$6D,$A9 |
||
10695 | 88 78 6D A9 |
||
10696 | 12013 F8807F DB B7 80 05 8D .DB $DB,$B7,$80,$05,$8D,$33,$F6,$0E,$C0 |
||
10697 | 33 F6 0E C0 |
||
10698 | 12014 |
||
10699 | 12015 ; ASHP[1] = -4.003566436224198252093684987323233921339E4 |
||
10700 | 12016 F88088 3D 57 F5 E9 85 .DB $3D,$57,$F5,$E9,$85,$D7,$5B,$49,$1D |
||
10701 | D7 5B 49 1D |
||
10702 | 12017 F88091 03 D6 A4 13 AA .DB $03,$D6,$A4,$13,$AA,$63,$9C,$0E,$C0 |
||
10703 | 63 9C 0E C0 |
||
10704 | 12018 |
||
10705 | 12019 ; ASHP[0] = -1.037690841528359305134494613113086980551E4 |
||
10706 | 12020 F8809A 75 93 4B 3D 7C .DB $75,$93,$4B,$3D,$7C,$5E,$17,$5F,$F8 |
||
10707 | 5E 17 5F F8 |
||
10708 | 12021 F880A3 DF B8 9D 37 A2 .DB $DF,$B8,$9D,$37,$A2,$23,$A2,$0C,$C0 |
||
10709 | 23 A2 0C C0 |
||
10710 | 12022 |
||
10711 | 12023 F880AC cashq: |
||
10712 | 12024 ; ASHQ[8] = 8.175806439951395194771977809279448392548E1 |
||
10713 | 12025 F880AC 2D 40 15 F1 2B .DB $2D,$40,$15,$F1,$2B,$46,$3A,$A0,$19 |
||
10714 | 46 3A A0 19 |
||
10715 | 12026 F880B5 3E 59 58 04 21 .DB $3E,$59,$58,$04,$21,$84,$A3,$05,$40 |
||
10716 | 84 A3 05 40 |
||
10717 | 12027 |
||
10718 | 12028 ; ASHQ[7] = 1.822215299975696008284027212745010251320E3 |
||
10719 | 12029 F880BE FC 15 F8 77 03 .DB $FC,$15,$F8,$77,$03,$2B,$9A,$81,$D7 |
||
10720 | 2B 9A 81 D7 |
||
10721 | 12030 F880C7 34 4E C6 BC E3 .DB $34,$4E,$C6,$BC,$E3,$C6,$E3,$09,$40 |
||
10722 | C6 E3 09 40 |
||
10723 | 12031 |
||
10724 | 12032 ; ASHQ[6] = 1.772040003462901790853111853838978236828E4 |
||
10725 | 12033 F880D0 14 67 63 D4 3C .DB $14,$67,$63,$D4,$3C,$7C,$F1,$6E,$7F |
||
10726 | 7C F1 6E 7F |
||
10727 | Tue Jul 17 11:00:18 2018 Page 174 |
||
10728 | |||
10729 | |||
10730 | |||
10731 | |||
10732 | 12034 F880D9 CC C1 56 D1 CC .DB $CC,$C1,$56,$D1,$CC,$70,$8A,$0D,$40 |
||
10733 | 70 8A 0D 40 |
||
10734 | 12035 |
||
10735 | 12036 ; ASHQ[5] = 9.077625379864046240143413577745818879353E4 |
||
10736 | 12037 F880E2 C1 7C F0 4C 1A .DB $C1,$7C,$F0,$4C,$1A,$FC,$B2,$4C,$13 |
||
10737 | FC B2 4C 13 |
||
10738 | 12038 F880EB 47 4E 79 7C 20 .DB $47,$4E,$79,$7C,$20,$4C,$B1,$0F,$40 |
||
10739 | 4C B1 0F 40 |
||
10740 | 12039 |
||
10741 | 12040 ; ASHQ[4] = 2.675554475070211205153169988669677418808E5 |
||
10742 | 12041 F880F4 F5 4D 22 AF FB .DB $F5,$4D,$22,$AF,$FB,$11,$EE,$02,$2D |
||
10743 | 11 EE 02 2D |
||
10744 | 12042 F880FD 8E 3E FA 51 6E .DB $8E,$3E,$FA,$51,$6E,$A4,$82,$11,$40 |
||
10745 | A4 82 11 40 |
||
10746 | 12043 |
||
10747 | 12044 ; ASHQ[3] = 4.689758557916492969463473819426544383586E5 |
||
10748 | 12045 F88106 9B B8 C0 1B 1D .DB $9B,$B8,$C0,$1B,$1D,$C9,$87,$FB,$72 |
||
10749 | C9 87 FB 72 |
||
10750 | 12046 F8810F 3D 2B A5 62 FB .DB $3D,$2B,$A5,$62,$FB,$FD,$E4,$11,$40 |
||
10751 | FD E4 11 40 |
||
10752 | 12047 |
||
10753 | 12048 ; ASHQ[2] = 4.821923684550711724710891114802924039911E5 |
||
10754 | 12049 F88118 77 20 49 F1 27 .DB $77,$20,$49,$F1,$27,$60,$C2,$4C,$65 |
||
10755 | 60 C2 4C 65 |
||
10756 | 12050 F88121 17 4A 62 CA 0B .DB $17,$4A,$62,$CA,$0B,$72,$EB,$11,$40 |
||
10757 | 72 EB 11 40 |
||
10758 | 12051 |
||
10759 | 12052 ; ASHQ[1] = 2.682316388947175963642524537892687560973E5 |
||
10760 | 12053 F8812A F4 0E 30 16 03 .DB $F4,$0E,$30,$16,$03,$74,$A4,$B8,$3B |
||
10761 | 74 A4 B8 3B |
||
10762 | 12054 F88133 B5 55 D3 71 F4 .DB $B5,$55,$D3,$71,$F4,$F8,$82,$11,$40 |
||
10763 | F8 82 11 40 |
||
10764 | 12055 |
||
10765 | 12056 ; ASHQ[0] = 6.226145049170155830806967678679167550122E4 |
||
10766 | 12057 F8813C F9 E9 F0 5D BA .DB $F9,$E9,$F0,$5D,$BA,$0D,$A3,$8E,$F4 |
||
10767 | 0D A3 8E F4 |
||
10768 | 12058 F88145 4F 95 6C 53 73 .DB $4F,$95,$6C,$53,$73,$35,$F3,$0E,$40 |
||
10769 | 35 F3 0E 40 |
||
10770 | 12059 |
||
10771 | 12060 ; acosh(x) coefficients |
||
10772 | 12061 F8814E cachp: |
||
10773 | 12062 ; ACHP[9] = 1.895467874386341763387398084072833727168E-1 |
||
10774 | 12063 F8814E 66 70 8A 32 3A .DB $66,$70,$8A,$32,$3A,$8B,$D0,$B4,$43 |
||
10775 | 8B D0 B4 43 |
||
10776 | 12064 F88157 DF 74 71 94 8D .DB $DF,$74,$71,$94,$8D,$18,$C2,$FC,$3F |
||
10777 | 18 C2 FC 3F |
||
10778 | 12065 |
||
10779 | 12066 ; ACHP[8] = 6.443902084393244878979969557171256604767E1 |
||
10780 | 12067 F88160 C5 F1 41 7D 6B .DB $C5,$F1,$41,$7D,$6B,$5B,$C4,$95,$21 |
||
10781 | 5B C4 95 21 |
||
10782 | 12068 F88169 85 E7 0D 57 C7 .DB $85,$E7,$0D,$57,$C7,$E0,$80,$05,$40 |
||
10783 | E0 80 05 40 |
||
10784 | 12069 |
||
10785 | 12070 ; ACHP[7] = 3.914593556594721458616408528941154205393E3 |
||
10786 | 12071 F88172 8E E9 6A AE 1F .DB $8E,$E9,$6A,$AE,$1F,$EF,$B1,$89,$ED |
||
10787 | EF B1 89 ED |
||
10788 | 12072 F8817B 75 2A 33 35 7F .DB $75,$2A,$33,$35,$7F,$A9,$F4,$0A,$40 |
||
10789 | Tue Jul 17 11:00:18 2018 Page 175 |
||
10790 | |||
10791 | |||
10792 | |||
10793 | |||
10794 | A9 F4 0A 40 |
||
10795 | 12073 |
||
10796 | 12074 ; ACHP[6] = 9.164040999602964494412169748897754668733E4 |
||
10797 | 12075 F88184 17 50 27 B4 1E .DB $17,$50,$27,$B4,$1E,$5D,$6C,$09,$4E |
||
10798 | 5D 6C 09 4E |
||
10799 | 12076 F8818D 68 F9 BF 7A 34 .DB $68,$F9,$BF,$7A,$34,$FC,$B2,$0F,$40 |
||
10800 | FC B2 0F 40 |
||
10801 | 12077 |
||
10802 | 12078 ; ACHP[5] = 1.065909694792026382660307834723001543839E6 |
||
10803 | 12079 F88196 33 4B 4E 96 02 .DB $33,$4B,$4E,$96,$02,$E5,$64,$46,$AE |
||
10804 | E5 64 46 AE |
||
10805 | 12080 F8819F 36 1F EF 8E AD .DB $36,$1F,$EF,$8E,$AD,$1D,$82,$13,$40 |
||
10806 | 1D 82 13 40 |
||
10807 | 12081 |
||
10808 | 12082 ; ACHP[4] = 6.899169896709615182428217047370629406305E6 |
||
10809 | 12083 F881A8 84 A4 A5 35 34 .DB $84,$A4,$A5,$35,$34,$96,$92,$3E,$6F |
||
10810 | 96 92 3E 6F |
||
10811 | 12084 F881B1 CE 85 1D CB C3 .DB $CE,$85,$1D,$CB,$C3,$8B,$D2,$15,$40 |
||
10812 | 8B D2 15 40 |
||
10813 | 12085 |
||
10814 | 12086 ; ACHP[3] = 2.599781868717579447900896150777162652518E7 |
||
10815 | 12087 F881BA 46 B9 30 2C 87 .DB $46,$B9,$30,$2C,$87,$69,$CA,$F0,$F1 |
||
10816 | 69 CA F0 F1 |
||
10817 | 12088 F881C3 5D 60 F5 57 FD .DB $5D,$60,$F5,$57,$FD,$58,$C6,$17,$40 |
||
10818 | 58 C6 17 40 |
||
10819 | 12089 |
||
10820 | 12090 ; ACHP[2] = 5.663733059389964024656501196827345337766E7 |
||
10821 | 12091 F881CC B6 97 B7 46 A7 .DB $B6,$97,$B7,$46,$A7,$44,$37,$C5,$FD |
||
10822 | 44 37 C5 FD |
||
10823 | 12092 F881D5 A2 73 02 A6 E4 .DB $A2,$73,$02,$A6,$E4,$0D,$D8,$18,$40 |
||
10824 | 0D D8 18 40 |
||
10825 | 12093 |
||
10826 | 12094 ; ACHP[1] = 6.606302846870644033621560858582696134512E7 |
||
10827 | 12095 F881DE 3C C5 80 74 46 .DB $3C,$C5,$80,$74,$46,$EC,$B0,$CA,$2A |
||
10828 | EC B0 CA 2A |
||
10829 | 12096 F881E7 4C 49 FF 1D AD .DB $4C,$49,$FF,$1D,$AD,$02,$FC,$18,$40 |
||
10830 | 02 FC 18 40 |
||
10831 | 12097 |
||
10832 | 12098 ; ACHP[0] = 3.190482951215438078279772140481195200593E7 |
||
10833 | 12099 F881F0 10 22 D8 A0 1A .DB $10,$22,$D8,$A0,$1A,$7C,$37,$8D,$FB |
||
10834 | 7C 37 8D FB |
||
10835 | 12100 F881F9 55 46 8E C1 1E .DB $55,$46,$8E,$C1,$1E,$6A,$F3,$17,$40 |
||
10836 | 6A F3 17 40 |
||
10837 | 12101 |
||
10838 | 12102 F88202 cachq: |
||
10839 | 12103 ; ACHQ[8] = 1.635418024331924674147953764918262009321E2 |
||
10840 | 12104 F88202 5C C5 F5 4B 8C .DB $5C,$C5,$F5,$4B,$8C,$8D,$25,$D8,$84 |
||
10841 | 8D 25 D8 84 |
||
10842 | 12105 F8820B 72 74 73 90 B3 .DB $72,$74,$73,$90,$B3,$8A,$A3,$06,$40 |
||
10843 | 8A A3 06 40 |
||
10844 | 12106 |
||
10845 | 12107 ; ACHQ[7] = 7.290983678312632723073455563799692165828E3 |
||
10846 | 12108 F88214 C3 9C 13 ED 77 .DB $C3,$9C,$13,$ED,$77,$C1,$6B,$F3,$08 |
||
10847 | C1 6B F3 08 |
||
10848 | 12109 F8821D 56 34 BC 92 DE .DB $56,$34,$BC,$92,$DE,$D7,$E3,$0B,$40 |
||
10849 | D7 E3 0B 40 |
||
10850 | 12110 |
||
10851 | Tue Jul 17 11:00:18 2018 Page 176 |
||
10852 | |||
10853 | |||
10854 | |||
10855 | |||
10856 | 12111 ; ACHQ[6] = 1.418207894088607063257675159183397062114E5 |
||
10857 | 12112 F88226 9E 1E 0F 35 24 .DB $9E,$1E,$0F,$35,$24,$95,$08,$A2,$00 |
||
10858 | 95 08 A2 00 |
||
10859 | 12113 F8822F FA BD AC 85 32 .DB $FA,$BD,$AC,$85,$32,$7F,$8A,$10,$40 |
||
10860 | 7F 8A 10 40 |
||
10861 | 12114 |
||
10862 | 12115 ; ACHQ[5] = 1.453154285419072886840913424715826321357E6 |
||
10863 | 12116 F88238 A8 C8 CD DC 85 .DB $A8,$C8,$CD,$DC,$85,$7E,$96,$04,$A1 |
||
10864 | 7E 96 04 A1 |
||
10865 | 12117 F88241 7D CB 89 48 12 .DB $7D,$CB,$89,$48,$12,$63,$B1,$13,$40 |
||
10866 | 63 B1 13 40 |
||
10867 | 12118 |
||
10868 | 12119 ; ACHQ[4] = 8.566841438576725234955968880501739464425E6 |
||
10869 | 12120 F8824A 7A 0D 61 29 7E .DB $7A,$0D,$61,$29,$7E,$C7,$01,$C1,$AB |
||
10870 | C7 01 C1 AB |
||
10871 | 12121 F88253 73 90 46 70 39 .DB $73,$90,$46,$70,$39,$B8,$82,$16,$40 |
||
10872 | B8 82 16 40 |
||
10873 | 12122 |
||
10874 | 12123 ; ACHQ[3] = 3.003448667795089562511136059766833630017E7 |
||
10875 | 12124 F8825C 5F BB CA 91 50 .DB $5F,$BB,$CA,$91,$50,$67,$4C,$7B,$80 |
||
10876 | 67 4C 7B 80 |
||
10877 | 12125 F88265 4E 18 C7 56 1B .DB $4E,$18,$C7,$56,$1B,$25,$E5,$17,$40 |
||
10878 | 25 E5 17 40 |
||
10879 | 12126 |
||
10880 | 12127 ; ACHQ[2] = 6.176592872899557661256383958395266919654E7 |
||
10881 | 12128 F8826E 56 19 E7 C9 A7 .DB $56,$19,$E7,$C9,$A7,$81,$29,$B2,$1E |
||
10882 | 81 29 B2 1E |
||
10883 | 12129 F88277 10 DD A7 2E 4A .DB $10,$DD,$A7,$2E,$4A,$9E,$EB,$18,$40 |
||
10884 | 9E EB 18 40 |
||
10885 | 12130 |
||
10886 | 12131 ; ACHQ[1] = 6.872176426138597206811541870289420510034E7 |
||
10887 | 12132 F88280 9F AE 34 C8 63 .DB $9F,$AE,$34,$C8,$63,$F3,$9E,$4D,$35 |
||
10888 | F3 9E 4D 35 |
||
10889 | 12133 F88289 1D 46 5D 88 8C .DB $1D,$46,$5D,$88,$8C,$13,$83,$19,$40 |
||
10890 | 13 83 19 40 |
||
10891 | 12134 |
||
10892 | 12135 ; ACHQ[0] = 3.190482951215438078279772140481195226621E7 |
||
10893 | 12136 F88292 60 2C D8 A0 1A .DB $60,$2C,$D8,$A0,$1A,$7C,$37,$8D,$FB |
||
10894 | 7C 37 8D FB |
||
10895 | 12137 F8829B 55 46 8E C1 1E .DB $55,$46,$8E,$C1,$1E,$6A,$F3,$17,$40 |
||
10896 | 6A F3 17 40 |
||
10897 | 12138 |
||
10898 | 12139 ; atanh(x) coefficients |
||
10899 | 12140 F882A4 cathp: |
||
10900 | 12141 ; ATHP[9] = -9.217569843805850417698565442251656375681E-1 |
||
10901 | 12142 F882A4 56 9C 44 93 0B .DB $56,$9C,$44,$93,$0B,$94,$F9,$5D,$55 |
||
10902 | 94 F9 5D 55 |
||
10903 | 12143 F882AD AE 31 C6 06 44 .DB $AE,$31,$C6,$06,$44,$F8,$EB,$FE,$BF |
||
10904 | F8 EB FE BF |
||
10905 | 12144 |
||
10906 | 12145 ; ATHP[8] = 5.321929116410615470118183794063211260728E1 |
||
10907 | 12146 F882B6 00 73 D2 C8 AD .DB $00,$73,$D2,$C8,$AD,$50,$DA,$62,$26 |
||
10908 | 50 DA 62 26 |
||
10909 | 12147 F882BF 02 8D E8 DC 8D .DB $02,$8D,$E8,$DC,$8D,$E0,$D4,$04,$40 |
||
10910 | E0 D4 04 40 |
||
10911 | 12148 |
||
10912 | 12149 ; ATHP[7] = -9.139522976807685333981548145417830690552E2 |
||
10913 | Tue Jul 17 11:00:18 2018 Page 177 |
||
10914 | |||
10915 | |||
10916 | |||
10917 | |||
10918 | 12150 F882C8 FF 0B FD 2D D9 .DB $FF,$0B,$FD,$2D,$D9,$80,$67,$44,$AA |
||
10919 | 80 67 44 AA |
||
10920 | 12151 F882D1 47 BD F8 71 F2 .DB $47,$BD,$F8,$71,$F2,$7C,$E4,$08,$C0 |
||
10921 | 7C E4 08 C0 |
||
10922 | 12152 |
||
10923 | 12153 ; ATHP[6] = 7.204314536952949779101646454146682033772E3 |
||
10924 | 12154 F882DA B7 34 20 F1 AE .DB $B7,$34,$20,$F1,$AE,$B4,$89,$32,$1E |
||
10925 | B4 89 32 1E |
||
10926 | 12155 F882E3 6C 32 F3 2B 84 .DB $6C,$32,$F3,$2B,$84,$22,$E1,$0B,$40 |
||
10927 | 22 E1 0B 40 |
||
10928 | 12156 |
||
10929 | 12157 ; ATHP[5] = -3.097809640165146436529075324081668598891E4 |
||
10930 | 12158 F882EC AB 05 FB 15 54 .DB $AB,$05,$FB,$15,$54,$FB,$82,$FE,$C1 |
||
10931 | FB 82 FE C1 |
||
10932 | 12159 F882F5 A3 A8 8E 5B 31 .DB $A3,$A8,$8E,$5B,$31,$04,$F2,$0D,$C0 |
||
10933 | 04 F2 0D C0 |
||
10934 | 12160 |
||
10935 | 12161 ; ATHP[4] = 7.865376554210973897486215630898496100534E4 |
||
10936 | 12162 F882FE D8 06 5E 71 61 .DB $D8,$06,$5E,$71,$61,$54,$5E,$34,$16 |
||
10937 | 54 5E 34 16 |
||
10938 | 12163 F88307 85 AA 48 FD E1 .DB $85,$AA,$48,$FD,$E1,$9E,$99,$0F,$40 |
||
10939 | 9E 99 0F 40 |
||
10940 | 12164 |
||
10941 | 12165 ; ATHP[3] = -1.211716814094785128366087489224821937203E5 |
||
10942 | 12166 F88310 4A 97 EA 1A 1E .DB $4A,$97,$EA,$1A,$1E,$BF,$9D,$77,$D2 |
||
10943 | BF 9D 77 D2 |
||
10944 | 12167 F88319 B2 00 6D 38 D7 .DB $B2,$00,$6D,$38,$D7,$A9,$EC,$0F,$C0 |
||
10945 | A9 EC 0F C0 |
||
10946 | 12168 |
||
10947 | 12169 ; ATHP[2] = 1.112669508789123834670923967462068457013E5 |
||
10948 | 12170 F88322 4A 6F 5C D9 90 .DB $4A,$6F,$5C,$D9,$90,$61,$4B,$27,$4F |
||
10949 | 61 4B 27 4F |
||
10950 | 12171 F8832B 92 73 66 B6 79 .DB $92,$73,$66,$B6,$79,$51,$D9,$0F,$40 |
||
10951 | 51 D9 0F 40 |
||
10952 | 12172 |
||
10953 | 12173 ; ATHP[1] = -5.600242872292477863751728708249167956542E4 |
||
10954 | 12174 F88334 09 D6 41 CF B4 .DB $09,$D6,$41,$CF,$B4,$1F,$BF,$51,$3F |
||
10955 | 1F BF 51 3F |
||
10956 | 12175 F8833D F8 1C C9 C0 6D .DB $F8,$1C,$C9,$C0,$6D,$C2,$DA,$0E,$C0 |
||
10957 | C2 DA 0E C0 |
||
10958 | 12176 |
||
10959 | 12177 ; ATHP[0] = 1.188901082233997739779618679364295772810E4 |
||
10960 | 12178 F88346 25 9B 90 FA 10 .DB $25,$9B,$90,$FA,$10,$5E,$5E,$62,$93 |
||
10961 | 5E 5E 62 93 |
||
10962 | 12179 F8834F 13 F1 02 15 0B .DB $13,$F1,$02,$15,$0B,$C4,$B9,$0C,$40 |
||
10963 | C4 B9 0C 40 |
||
10964 | 12180 |
||
10965 | 12181 F88358 cathq: |
||
10966 | 12182 ; ATHQ[9] = -6.807348436010016270202879229504392062418E1 |
||
10967 | 12183 F88358 99 2F A4 39 46 .DB $99,$2F,$A4,$39,$46,$E2,$E3,$D8,$82 |
||
10968 | E2 E3 D8 82 |
||
10969 | 12184 F88361 9D CB F6 BD 9F .DB $9D,$CB,$F6,$BD,$9F,$25,$88,$05,$C0 |
||
10970 | 25 88 05 C0 |
||
10971 | 12185 |
||
10972 | 12186 ; ATHQ[8] = 1.386763299649315831625106608182196351693E3 |
||
10973 | 12187 F8836A 85 34 75 16 4D .DB $85,$34,$75,$16,$4D,$4C,$65,$28,$33 |
||
10974 | 4C 65 28 33 |
||
10975 | Tue Jul 17 11:00:18 2018 Page 178 |
||
10976 | |||
10977 | |||
10978 | |||
10979 | |||
10980 | 12188 F88373 83 DB 62 F3 6C .DB $83,$DB,$62,$F3,$6C,$58,$AD,$09,$40 |
||
10981 | 58 AD 09 40 |
||
10982 | 12189 |
||
10983 | 12190 ; ATHQ[7] = -1.310805752656879543134785263832907269320E4 |
||
10984 | 12191 F8837C 10 00 DF D6 BA .DB $10,$00,$DF,$D6,$BA,$52,$8D,$F4,$87 |
||
10985 | 52 8D F4 87 |
||
10986 | 12192 F88385 82 AE 3E E8 3A .DB $82,$AE,$3E,$E8,$3A,$D0,$CC,$0C,$C0 |
||
10987 | D0 CC 0C C0 |
||
10988 | 12193 |
||
10989 | 12194 ; ATHQ[6] = 6.872174720355764193772953852564737816928E4 |
||
10990 | 12195 F8838E 6E FA BF B3 EC .DB $6E,$FA,$BF,$B3,$EC,$33,$80,$DD,$73 |
||
10991 | 33 80 DD 73 |
||
10992 | 12196 F88397 C3 BD 5D A4 DF .DB $C3,$BD,$5D,$A4,$DF,$38,$86,$0F,$40 |
||
10993 | 38 86 0F 40 |
||
10994 | 12197 |
||
10995 | 12198 ; ATHQ[5] = -2.181008360536226513009076189881617939380E5 |
||
10996 | 12199 F883A0 F5 02 E5 97 FF .DB $F5,$02,$E5,$97,$FF,$97,$2A,$A0,$56 |
||
10997 | 97 2A A0 56 |
||
10998 | 12200 F883A9 BF 0D E7 81 35 .DB $BF,$0D,$E7,$81,$35,$FD,$D4,$10,$C0 |
||
10999 | FD D4 10 C0 |
||
11000 | 12201 |
||
11001 | 12202 ; ATHQ[4] = 4.362736119602298592874941767284979857248E5 |
||
11002 | 12203 F883B2 61 1A B8 5B 6C .DB $61,$1A,$B8,$5B,$6C,$27,$7A,$54,$58 |
||
11003 | 27 7A 54 58 |
||
11004 | 12204 F883BB B6 9E 2D 95 33 .DB $B6,$9E,$2D,$95,$33,$06,$D5,$11,$40 |
||
11005 | 06 D5 11 40 |
||
11006 | 12205 |
||
11007 | 12206 ; ATHQ[3] = -5.535251007539393347687001489396152923502E5 |
||
11008 | 12207 F883C4 7F 3B 18 F4 58 .DB $7F,$3B,$18,$F4,$58,$AC,$E0,$0D,$2D |
||
11009 | AC E0 0D 2D |
||
11010 | 12208 F883CD A6 29 B0 9C 51 .DB $A6,$29,$B0,$9C,$51,$23,$87,$12,$C0 |
||
11011 | 23 87 12 C0 |
||
11012 | 12209 |
||
11013 | 12210 ; ATHQ[2] = 4.321594849688346708841188057241308805551E5 |
||
11014 | 12211 F883D6 4B 52 86 98 30 .DB $4B,$52,$86,$98,$30,$13,$CC,$A2,$B3 |
||
11015 | 13 CC A2 B3 |
||
11016 | 12212 F883DF 8F 5C DD 84 EF .DB $8F,$5C,$DD,$84,$EF,$03,$D3,$11,$40 |
||
11017 | 03 D3 11 40 |
||
11018 | 12213 |
||
11019 | 12214 ; ATHQ[1] = -1.894075056489862952285849974761239845873E5 |
||
11020 | 12215 F883E8 03 9B EB F1 8F .DB $03,$9B,$EB,$F1,$8F,$F5,$F9,$11,$30 |
||
11021 | F5 F9 11 30 |
||
11022 | 12216 F883F1 D9 90 8D 5C E0 .DB $D9,$90,$8D,$5C,$E0,$F7,$B8,$10,$C0 |
||
11023 | F7 B8 10 C0 |
||
11024 | 12217 |
||
11025 | 12218 ; ATHQ[0] = 3.566703246701993219338856038092901974725E4 |
||
11026 | 12219 F883FA 02 11 F8 BB 8C .DB $02,$11,$F8,$BB,$8C,$C6,$C6,$89,$AE |
||
11027 | C6 C6 89 AE |
||
11028 | 12220 F88403 CE 34 C2 4F 08 .DB $CE,$34,$C2,$4F,$08,$53,$8B,$0E,$40 |
||
11029 | 53 8B 0E 40 |
||
11030 | 12221 |
||
11031 | 12222 ;--------------------------------------------------------------------------- |
||
11032 | 12223 ; moving routines to/from fac/arg |
||
11033 | 12224 ;--------------------------------------------------------------------------- |
||
11034 | 12225 |
||
11035 | 12226 ; temporary registers tfr0..tfr5 are 20-bytes-sized register that can hold the |
||
11036 | 12227 ; full size 128 bits mantissa, the exponent, the sign and the byte status |
||
11037 | Tue Jul 17 11:00:18 2018 Page 179 |
||
11038 | |||
11039 | |||
11040 | |||
11041 | |||
11042 | 12228 |
||
11043 | 12229 ; move arg to fac |
||
11044 | 12230 ;------ |
||
11045 | 12231 F8840C mvatof: |
||
11046 | 12232 ;------ |
||
11047 | 12233 F8840C INDEX16 |
||
11048 | 12234 F8840C C2 10 rep #PXFLAG |
||
11049 | 12235 .LONGI on |
||
11050 | 12236 .MNLIST |
||
11051 | 12237 F8840E A6 2A ldx argm |
||
11052 | 12238 F88410 86 12 stx facm |
||
11053 | 12239 F88412 A6 2C ldx argm+2 |
||
11054 | 12240 F88414 86 14 stx facm+2 |
||
11055 | 12241 F88416 A6 2E ldx argm+4 |
||
11056 | 12242 F88418 86 16 stx facm+4 |
||
11057 | 12243 F8841A A6 30 ldx argm+6 |
||
11058 | 12244 F8841C 86 18 stx facm+6 |
||
11059 | 12245 F8841E A6 32 ldx argm+8 |
||
11060 | 12246 F88420 86 1A stx facm+8 |
||
11061 | 12247 F88422 A6 34 ldx argm+10 |
||
11062 | 12248 F88424 86 1C stx facm+10 |
||
11063 | 12249 F88426 A6 36 ldx argm+12 |
||
11064 | 12250 F88428 86 1E stx facm+12 |
||
11065 | 12251 F8842A A6 38 ldx argm+14 |
||
11066 | 12252 F8842C 86 20 stx facm+14 |
||
11067 | 12253 F8842E A6 3A ldx argexp |
||
11068 | 12254 F88430 86 22 stx facexp |
||
11069 | 12255 F88432 A6 3C ldx argsgn |
||
11070 | 12256 F88434 86 24 stx facsgn |
||
11071 | 12257 F88436 INDEX08 |
||
11072 | 12258 F88436 E2 10 sep #PXFLAG |
||
11073 | 12259 .LONGI off |
||
11074 | 12260 .MNLIST |
||
11075 | 12261 F88438 60 rts |
||
11076 | 12262 |
||
11077 | 12263 ; move fac to arg |
||
11078 | 12264 ;------ |
||
11079 | 12265 F88439 mvftoa: |
||
11080 | 12266 ;------ |
||
11081 | 12267 F88439 INDEX16 |
||
11082 | 12268 F88439 C2 10 rep #PXFLAG |
||
11083 | 12269 .LONGI on |
||
11084 | 12270 .MNLIST |
||
11085 | 12271 F8843B A6 12 ldx facm |
||
11086 | 12272 F8843D 86 2A stx argm |
||
11087 | 12273 F8843F A6 14 ldx facm+2 |
||
11088 | 12274 F88441 86 2C stx argm+2 |
||
11089 | 12275 F88443 A6 16 ldx facm+4 |
||
11090 | 12276 F88445 86 2E stx argm+4 |
||
11091 | 12277 F88447 A6 18 ldx facm+6 |
||
11092 | 12278 F88449 86 30 stx argm+6 |
||
11093 | 12279 F8844B A6 1A ldx facm+8 |
||
11094 | 12280 F8844D 86 32 stx argm+8 |
||
11095 | 12281 F8844F A6 1C ldx facm+10 |
||
11096 | 12282 F88451 86 34 stx argm+10 |
||
11097 | 12283 F88453 A6 1E ldx facm+12 |
||
11098 | 12284 F88455 86 36 stx argm+12 |
||
11099 | Tue Jul 17 11:00:18 2018 Page 180 |
||
11100 | |||
11101 | |||
11102 | |||
11103 | |||
11104 | 12285 F88457 A6 20 ldx facm+14 |
||
11105 | 12286 F88459 86 38 stx argm+14 |
||
11106 | 12287 F8845B A6 22 ldx facexp |
||
11107 | 12288 F8845D 86 3A stx argexp |
||
11108 | 12289 F8845F A6 24 ldx facsgn |
||
11109 | 12290 F88461 86 3C stx argsgn |
||
11110 | 12291 F88463 INDEX08 |
||
11111 | 12292 F88463 E2 10 sep #PXFLAG |
||
11112 | 12293 .LONGI off |
||
11113 | 12294 .MNLIST |
||
11114 | 12295 F88465 60 rts |
||
11115 | 12296 |
||
11116 | 12297 ; move fac to temp. reg. tfr0 |
||
11117 | 12298 ;------ |
||
11118 | 12299 F88466 mvf_t0: |
||
11119 | 12300 ;------ |
||
11120 | 12301 F88466 ACC16 |
||
11121 | 12302 F88466 C2 20 rep #PMFLAG |
||
11122 | 12303 .LONGA on |
||
11123 | 12304 .MNLIST |
||
11124 | 12305 F88468 A5 12 lda facm |
||
11125 | 12306 F8846A 85 50 sta tfr0 |
||
11126 | 12307 F8846C A5 14 lda facm+2 |
||
11127 | 12308 F8846E 85 52 sta tfr0+2 |
||
11128 | 12309 F88470 A5 16 lda facm+4 |
||
11129 | 12310 F88472 85 54 sta tfr0+4 |
||
11130 | 12311 F88474 A5 18 lda facm+6 |
||
11131 | 12312 F88476 85 56 sta tfr0+6 |
||
11132 | 12313 F88478 A5 1A lda facm+8 |
||
11133 | 12314 F8847A 85 58 sta tfr0+8 |
||
11134 | 12315 F8847C A5 1C lda facm+10 |
||
11135 | 12316 F8847E 85 5A sta tfr0+10 |
||
11136 | 12317 F88480 A5 1E lda facm+12 |
||
11137 | 12318 F88482 85 5C sta tfr0+12 |
||
11138 | 12319 F88484 A5 20 lda facm+14 |
||
11139 | 12320 F88486 85 5E sta tfr0+14 |
||
11140 | 12321 F88488 A5 22 lda facexp |
||
11141 | 12322 F8848A 85 60 sta tfr0+16 |
||
11142 | 12323 F8848C A5 24 lda facsgn |
||
11143 | 12324 F8848E 85 62 sta tfr0+18 |
||
11144 | 12325 F88490 ACC08 |
||
11145 | 12326 F88490 E2 20 sep #PMFLAG |
||
11146 | 12327 .LONGA off |
||
11147 | 12328 .MNLIST |
||
11148 | 12329 F88492 60 rts |
||
11149 | 12330 |
||
11150 | 12331 ; move fac to temp. reg. tfr1 |
||
11151 | 12332 ;------ |
||
11152 | 12333 F88493 mvf_t1: |
||
11153 | 12334 ;------ |
||
11154 | 12335 F88493 ACC16 |
||
11155 | 12336 F88493 C2 20 rep #PMFLAG |
||
11156 | 12337 .LONGA on |
||
11157 | 12338 .MNLIST |
||
11158 | 12339 F88495 A5 12 lda facm |
||
11159 | 12340 F88497 85 64 sta tfr1 |
||
11160 | 12341 F88499 A5 14 lda facm+2 |
||
11161 | Tue Jul 17 11:00:18 2018 Page 181 |
||
11162 | |||
11163 | |||
11164 | |||
11165 | |||
11166 | 12342 F8849B 85 66 sta tfr1+2 |
||
11167 | 12343 F8849D A5 16 lda facm+4 |
||
11168 | 12344 F8849F 85 68 sta tfr1+4 |
||
11169 | 12345 F884A1 A5 18 lda facm+6 |
||
11170 | 12346 F884A3 85 6A sta tfr1+6 |
||
11171 | 12347 F884A5 A5 1A lda facm+8 |
||
11172 | 12348 F884A7 85 6C sta tfr1+8 |
||
11173 | 12349 F884A9 A5 1C lda facm+10 |
||
11174 | 12350 F884AB 85 6E sta tfr1+10 |
||
11175 | 12351 F884AD A5 1E lda facm+12 |
||
11176 | 12352 F884AF 85 70 sta tfr1+12 |
||
11177 | 12353 F884B1 A5 20 lda facm+14 |
||
11178 | 12354 F884B3 85 72 sta tfr1+14 |
||
11179 | 12355 F884B5 A5 22 lda facexp |
||
11180 | 12356 F884B7 85 74 sta tfr1+16 |
||
11181 | 12357 F884B9 A5 24 lda facsgn |
||
11182 | 12358 F884BB 85 76 sta tfr1+18 |
||
11183 | 12359 F884BD ACC08 |
||
11184 | 12360 F884BD E2 20 sep #PMFLAG |
||
11185 | 12361 .LONGA off |
||
11186 | 12362 .MNLIST |
||
11187 | 12363 F884BF 60 rts |
||
11188 | 12364 |
||
11189 | 12365 ; move fac to temp. reg. tfr2 |
||
11190 | 12366 ;------ |
||
11191 | 12367 F884C0 mvf_t2: |
||
11192 | 12368 ;------ |
||
11193 | 12369 F884C0 ACC16 |
||
11194 | 12370 F884C0 C2 20 rep #PMFLAG |
||
11195 | 12371 .LONGA on |
||
11196 | 12372 .MNLIST |
||
11197 | 12373 F884C2 A5 12 lda facm |
||
11198 | 12374 F884C4 85 78 sta tfr2 |
||
11199 | 12375 F884C6 A5 14 lda facm+2 |
||
11200 | 12376 F884C8 85 7A sta tfr2+2 |
||
11201 | 12377 F884CA A5 16 lda facm+4 |
||
11202 | 12378 F884CC 85 7C sta tfr2+4 |
||
11203 | 12379 F884CE A5 18 lda facm+6 |
||
11204 | 12380 F884D0 85 7E sta tfr2+6 |
||
11205 | 12381 F884D2 A5 1A lda facm+8 |
||
11206 | 12382 F884D4 85 80 sta tfr2+8 |
||
11207 | 12383 F884D6 A5 1C lda facm+10 |
||
11208 | 12384 F884D8 85 82 sta tfr2+10 |
||
11209 | 12385 F884DA A5 1E lda facm+12 |
||
11210 | 12386 F884DC 85 84 sta tfr2+12 |
||
11211 | 12387 F884DE A5 20 lda facm+14 |
||
11212 | 12388 F884E0 85 86 sta tfr2+14 |
||
11213 | 12389 F884E2 A5 22 lda facexp |
||
11214 | 12390 F884E4 85 88 sta tfr2+16 |
||
11215 | 12391 F884E6 A5 24 lda facsgn |
||
11216 | 12392 F884E8 85 8A sta tfr2+18 |
||
11217 | 12393 F884EA ACC08 |
||
11218 | 12394 F884EA E2 20 sep #PMFLAG |
||
11219 | 12395 .LONGA off |
||
11220 | 12396 .MNLIST |
||
11221 | 12397 F884EC 60 rts |
||
11222 | 12398 |
||
11223 | Tue Jul 17 11:00:18 2018 Page 182 |
||
11224 | |||
11225 | |||
11226 | |||
11227 | |||
11228 | 12399 ; move fac to temp. reg. tfr3 |
||
11229 | 12400 ;------ |
||
11230 | 12401 F884ED mvf_t3: |
||
11231 | 12402 ;------ |
||
11232 | 12403 F884ED ACC16 |
||
11233 | 12404 F884ED C2 20 rep #PMFLAG |
||
11234 | 12405 .LONGA on |
||
11235 | 12406 .MNLIST |
||
11236 | 12407 F884EF A5 12 lda facm |
||
11237 | 12408 F884F1 85 8C sta tfr3 |
||
11238 | 12409 F884F3 A5 14 lda facm+2 |
||
11239 | 12410 F884F5 85 8E sta tfr3+2 |
||
11240 | 12411 F884F7 A5 16 lda facm+4 |
||
11241 | 12412 F884F9 85 90 sta tfr3+4 |
||
11242 | 12413 F884FB A5 18 lda facm+6 |
||
11243 | 12414 F884FD 85 92 sta tfr3+6 |
||
11244 | 12415 F884FF A5 1A lda facm+8 |
||
11245 | 12416 F88501 85 94 sta tfr3+8 |
||
11246 | 12417 F88503 A5 1C lda facm+10 |
||
11247 | 12418 F88505 85 96 sta tfr3+10 |
||
11248 | 12419 F88507 A5 1E lda facm+12 |
||
11249 | 12420 F88509 85 98 sta tfr3+12 |
||
11250 | 12421 F8850B A5 20 lda facm+14 |
||
11251 | 12422 F8850D 85 9A sta tfr3+14 |
||
11252 | 12423 F8850F A5 22 lda facexp |
||
11253 | 12424 F88511 85 9C sta tfr3+16 |
||
11254 | 12425 F88513 A5 24 lda facsgn |
||
11255 | 12426 F88515 85 9E sta tfr3+18 |
||
11256 | 12427 F88517 ACC08 |
||
11257 | 12428 F88517 E2 20 sep #PMFLAG |
||
11258 | 12429 .LONGA off |
||
11259 | 12430 .MNLIST |
||
11260 | 12431 F88519 60 rts |
||
11261 | 12432 |
||
11262 | 12433 ; move arg to temp. reg. tfr0 |
||
11263 | 12434 ;------ |
||
11264 | 12435 F8851A mva_t0: |
||
11265 | 12436 ;------ |
||
11266 | 12437 F8851A ACC16 |
||
11267 | 12438 F8851A C2 20 rep #PMFLAG |
||
11268 | 12439 .LONGA on |
||
11269 | 12440 .MNLIST |
||
11270 | 12441 F8851C A5 2A lda argm |
||
11271 | 12442 F8851E 85 50 sta tfr0 |
||
11272 | 12443 F88520 A5 2C lda argm+2 |
||
11273 | 12444 F88522 85 52 sta tfr0+2 |
||
11274 | 12445 F88524 A5 2E lda argm+4 |
||
11275 | 12446 F88526 85 54 sta tfr0+4 |
||
11276 | 12447 F88528 A5 30 lda argm+6 |
||
11277 | 12448 F8852A 85 56 sta tfr0+6 |
||
11278 | 12449 F8852C A5 32 lda argm+8 |
||
11279 | 12450 F8852E 85 58 sta tfr0+8 |
||
11280 | 12451 F88530 A5 34 lda argm+10 |
||
11281 | 12452 F88532 85 5A sta tfr0+10 |
||
11282 | 12453 F88534 A5 36 lda argm+12 |
||
11283 | 12454 F88536 85 5C sta tfr0+12 |
||
11284 | 12455 F88538 A5 38 lda argm+14 |
||
11285 | Tue Jul 17 11:00:18 2018 Page 183 |
||
11286 | |||
11287 | |||
11288 | |||
11289 | |||
11290 | 12456 F8853A 85 5E sta tfr0+14 |
||
11291 | 12457 F8853C A5 3A lda argexp |
||
11292 | 12458 F8853E 85 60 sta tfr0+16 |
||
11293 | 12459 F88540 A5 3C lda argsgn |
||
11294 | 12460 F88542 85 62 sta tfr0+18 |
||
11295 | 12461 F88544 ACC08 |
||
11296 | 12462 F88544 E2 20 sep #PMFLAG |
||
11297 | 12463 .LONGA off |
||
11298 | 12464 .MNLIST |
||
11299 | 12465 F88546 60 rts |
||
11300 | 12466 |
||
11301 | 12467 ; move temp. reg. tfr0 to fac |
||
11302 | 12468 ;------ |
||
11303 | 12469 F88547 mvt0_f: |
||
11304 | 12470 ;------ |
||
11305 | 12471 F88547 ACC16 |
||
11306 | 12472 F88547 C2 20 rep #PMFLAG |
||
11307 | 12473 .LONGA on |
||
11308 | 12474 .MNLIST |
||
11309 | 12475 F88549 A5 50 lda tfr0 |
||
11310 | 12476 F8854B 85 12 sta facm |
||
11311 | 12477 F8854D A5 52 lda tfr0+2 |
||
11312 | 12478 F8854F 85 14 sta facm+2 |
||
11313 | 12479 F88551 A5 54 lda tfr0+4 |
||
11314 | 12480 F88553 85 16 sta facm+4 |
||
11315 | 12481 F88555 A5 56 lda tfr0+6 |
||
11316 | 12482 F88557 85 18 sta facm+6 |
||
11317 | 12483 F88559 A5 58 lda tfr0+8 |
||
11318 | 12484 F8855B 85 1A sta facm+8 |
||
11319 | 12485 F8855D A5 5A lda tfr0+10 |
||
11320 | 12486 F8855F 85 1C sta facm+10 |
||
11321 | 12487 F88561 A5 5C lda tfr0+12 |
||
11322 | 12488 F88563 85 1E sta facm+12 |
||
11323 | 12489 F88565 A5 5E lda tfr0+14 |
||
11324 | 12490 F88567 85 20 sta facm+14 |
||
11325 | 12491 F88569 A5 60 lda tfr0+16 |
||
11326 | 12492 F8856B 85 22 sta facexp |
||
11327 | 12493 F8856D A5 62 lda tfr0+18 |
||
11328 | 12494 F8856F 85 24 sta facsgn |
||
11329 | 12495 F88571 ACC08 |
||
11330 | 12496 F88571 E2 20 sep #PMFLAG |
||
11331 | 12497 .LONGA off |
||
11332 | 12498 .MNLIST |
||
11333 | 12499 F88573 60 rts |
||
11334 | 12500 |
||
11335 | 12501 ; move temp. reg. tfr1 to fac |
||
11336 | 12502 ;------ |
||
11337 | 12503 F88574 mvt1_f: |
||
11338 | 12504 ;------ |
||
11339 | 12505 F88574 ACC16 |
||
11340 | 12506 F88574 C2 20 rep #PMFLAG |
||
11341 | 12507 .LONGA on |
||
11342 | 12508 .MNLIST |
||
11343 | 12509 F88576 A5 64 lda tfr1 |
||
11344 | 12510 F88578 85 12 sta facm |
||
11345 | 12511 F8857A A5 66 lda tfr1+2 |
||
11346 | 12512 F8857C 85 14 sta facm+2 |
||
11347 | Tue Jul 17 11:00:18 2018 Page 184 |
||
11348 | |||
11349 | |||
11350 | |||
11351 | |||
11352 | 12513 F8857E A5 68 lda tfr1+4 |
||
11353 | 12514 F88580 85 16 sta facm+4 |
||
11354 | 12515 F88582 A5 6A lda tfr1+6 |
||
11355 | 12516 F88584 85 18 sta facm+6 |
||
11356 | 12517 F88586 A5 6C lda tfr1+8 |
||
11357 | 12518 F88588 85 1A sta facm+8 |
||
11358 | 12519 F8858A A5 6E lda tfr1+10 |
||
11359 | 12520 F8858C 85 1C sta facm+10 |
||
11360 | 12521 F8858E A5 70 lda tfr1+12 |
||
11361 | 12522 F88590 85 1E sta facm+12 |
||
11362 | 12523 F88592 A5 72 lda tfr1+14 |
||
11363 | 12524 F88594 85 20 sta facm+14 |
||
11364 | 12525 F88596 A5 74 lda tfr1+16 |
||
11365 | 12526 F88598 85 22 sta facexp |
||
11366 | 12527 F8859A A5 76 lda tfr1+18 |
||
11367 | 12528 F8859C 85 24 sta facsgn |
||
11368 | 12529 F8859E ACC08 |
||
11369 | 12530 F8859E E2 20 sep #PMFLAG |
||
11370 | 12531 .LONGA off |
||
11371 | 12532 .MNLIST |
||
11372 | 12533 F885A0 60 rts |
||
11373 | 12534 |
||
11374 | 12535 ; move temp. reg. tfr2 to fac |
||
11375 | 12536 ;------ |
||
11376 | 12537 F885A1 mvt2_f: |
||
11377 | 12538 ;------ |
||
11378 | 12539 F885A1 ACC16 |
||
11379 | 12540 F885A1 C2 20 rep #PMFLAG |
||
11380 | 12541 .LONGA on |
||
11381 | 12542 .MNLIST |
||
11382 | 12543 F885A3 A5 78 lda tfr2 |
||
11383 | 12544 F885A5 85 12 sta facm |
||
11384 | 12545 F885A7 A5 7A lda tfr2+2 |
||
11385 | 12546 F885A9 85 14 sta facm+2 |
||
11386 | 12547 F885AB A5 7C lda tfr2+4 |
||
11387 | 12548 F885AD 85 16 sta facm+4 |
||
11388 | 12549 F885AF A5 7E lda tfr2+6 |
||
11389 | 12550 F885B1 85 18 sta facm+6 |
||
11390 | 12551 F885B3 A5 80 lda tfr2+8 |
||
11391 | 12552 F885B5 85 1A sta facm+8 |
||
11392 | 12553 F885B7 A5 82 lda tfr2+10 |
||
11393 | 12554 F885B9 85 1C sta facm+10 |
||
11394 | 12555 F885BB A5 84 lda tfr2+12 |
||
11395 | 12556 F885BD 85 1E sta facm+12 |
||
11396 | 12557 F885BF A5 86 lda tfr2+14 |
||
11397 | 12558 F885C1 85 20 sta facm+14 |
||
11398 | 12559 F885C3 A5 88 lda tfr2+16 |
||
11399 | 12560 F885C5 85 22 sta facexp |
||
11400 | 12561 F885C7 A5 8A lda tfr2+18 |
||
11401 | 12562 F885C9 85 24 sta facsgn |
||
11402 | 12563 F885CB ACC08 |
||
11403 | 12564 F885CB E2 20 sep #PMFLAG |
||
11404 | 12565 .LONGA off |
||
11405 | 12566 .MNLIST |
||
11406 | 12567 F885CD 60 rts |
||
11407 | 12568 F885CE |
||
11408 | 12569 ; move temp. reg. tfr0 to arg |
||
11409 | Tue Jul 17 11:00:18 2018 Page 185 |
||
11410 | |||
11411 | |||
11412 | |||
11413 | |||
11414 | 12570 ;------ |
||
11415 | 12571 F885CE mvt0_a: |
||
11416 | 12572 ;------ |
||
11417 | 12573 F885CE ACC16 |
||
11418 | 12574 F885CE C2 20 rep #PMFLAG |
||
11419 | 12575 .LONGA on |
||
11420 | 12576 .MNLIST |
||
11421 | 12577 F885D0 A5 50 lda tfr0 |
||
11422 | 12578 F885D2 85 2A sta argm |
||
11423 | 12579 F885D4 A5 52 lda tfr0+2 |
||
11424 | 12580 F885D6 85 2C sta argm+2 |
||
11425 | 12581 F885D8 A5 54 lda tfr0+4 |
||
11426 | 12582 F885DA 85 2E sta argm+4 |
||
11427 | 12583 F885DC A5 56 lda tfr0+6 |
||
11428 | 12584 F885DE 85 30 sta argm+6 |
||
11429 | 12585 F885E0 A5 58 lda tfr0+8 |
||
11430 | 12586 F885E2 85 32 sta argm+8 |
||
11431 | 12587 F885E4 A5 5A lda tfr0+10 |
||
11432 | 12588 F885E6 85 34 sta argm+10 |
||
11433 | 12589 F885E8 A5 5C lda tfr0+12 |
||
11434 | 12590 F885EA 85 36 sta argm+12 |
||
11435 | 12591 F885EC A5 5E lda tfr0+14 |
||
11436 | 12592 F885EE 85 38 sta argm+14 |
||
11437 | 12593 F885F0 A5 60 lda tfr0+16 |
||
11438 | 12594 F885F2 85 3A sta argexp |
||
11439 | 12595 F885F4 A5 62 lda tfr0+18 |
||
11440 | 12596 F885F6 85 3C sta argsgn |
||
11441 | 12597 F885F8 ACC08 |
||
11442 | 12598 F885F8 E2 20 sep #PMFLAG |
||
11443 | 12599 .LONGA off |
||
11444 | 12600 .MNLIST |
||
11445 | 12601 F885FA 60 rts |
||
11446 | 12602 |
||
11447 | 12603 ; move temp. reg. tfr1 to arg |
||
11448 | 12604 ;------ |
||
11449 | 12605 F885FB mvt1_a: |
||
11450 | 12606 ;------ |
||
11451 | 12607 F885FB ACC16 |
||
11452 | 12608 F885FB C2 20 rep #PMFLAG |
||
11453 | 12609 .LONGA on |
||
11454 | 12610 .MNLIST |
||
11455 | 12611 F885FD A5 64 lda tfr1 |
||
11456 | 12612 F885FF 85 2A sta argm |
||
11457 | 12613 F88601 A5 66 lda tfr1+2 |
||
11458 | 12614 F88603 85 2C sta argm+2 |
||
11459 | 12615 F88605 A5 68 lda tfr1+4 |
||
11460 | 12616 F88607 85 2E sta argm+4 |
||
11461 | 12617 F88609 A5 6A lda tfr1+6 |
||
11462 | 12618 F8860B 85 30 sta argm+6 |
||
11463 | 12619 F8860D A5 6C lda tfr1+8 |
||
11464 | 12620 F8860F 85 32 sta argm+8 |
||
11465 | 12621 F88611 A5 6E lda tfr1+10 |
||
11466 | 12622 F88613 85 34 sta argm+10 |
||
11467 | 12623 F88615 A5 70 lda tfr1+12 |
||
11468 | 12624 F88617 85 36 sta argm+12 |
||
11469 | 12625 F88619 A5 72 lda tfr1+14 |
||
11470 | 12626 F8861B 85 38 sta argm+14 |
||
11471 | Tue Jul 17 11:00:18 2018 Page 186 |
||
11472 | |||
11473 | |||
11474 | |||
11475 | |||
11476 | 12627 F8861D A5 74 lda tfr1+16 |
||
11477 | 12628 F8861F 85 3A sta argexp |
||
11478 | 12629 F88621 A5 76 lda tfr1+18 |
||
11479 | 12630 F88623 85 3C sta argsgn |
||
11480 | 12631 F88625 ACC08 |
||
11481 | 12632 F88625 E2 20 sep #PMFLAG |
||
11482 | 12633 .LONGA off |
||
11483 | 12634 .MNLIST |
||
11484 | 12635 F88627 60 rts |
||
11485 | 12636 |
||
11486 | 12637 ; move temp. reg. tfr2 to arg |
||
11487 | 12638 ;------ |
||
11488 | 12639 F88628 mvt2_a: |
||
11489 | 12640 ;------ |
||
11490 | 12641 F88628 ACC16 |
||
11491 | 12642 F88628 C2 20 rep #PMFLAG |
||
11492 | 12643 .LONGA on |
||
11493 | 12644 .MNLIST |
||
11494 | 12645 F8862A A5 78 lda tfr2 |
||
11495 | 12646 F8862C 85 2A sta argm |
||
11496 | 12647 F8862E A5 7A lda tfr2+2 |
||
11497 | 12648 F88630 85 2C sta argm+2 |
||
11498 | 12649 F88632 A5 7C lda tfr2+4 |
||
11499 | 12650 F88634 85 2E sta argm+4 |
||
11500 | 12651 F88636 A5 7E lda tfr2+6 |
||
11501 | 12652 F88638 85 30 sta argm+6 |
||
11502 | 12653 F8863A A5 80 lda tfr2+8 |
||
11503 | 12654 F8863C 85 32 sta argm+8 |
||
11504 | 12655 F8863E A5 82 lda tfr2+10 |
||
11505 | 12656 F88640 85 34 sta argm+10 |
||
11506 | 12657 F88642 A5 84 lda tfr2+12 |
||
11507 | 12658 F88644 85 36 sta argm+12 |
||
11508 | 12659 F88646 A5 86 lda tfr2+14 |
||
11509 | 12660 F88648 85 38 sta argm+14 |
||
11510 | 12661 F8864A A5 88 lda tfr2+16 |
||
11511 | 12662 F8864C 85 3A sta argexp |
||
11512 | 12663 F8864E A5 8A lda tfr2+18 |
||
11513 | 12664 F88650 85 3C sta argsgn |
||
11514 | 12665 F88652 ACC08 |
||
11515 | 12666 F88652 E2 20 sep #PMFLAG |
||
11516 | 12667 .LONGA off |
||
11517 | 12668 .MNLIST |
||
11518 | 12669 F88654 60 rts |
||
11519 | 12670 |
||
11520 | 12671 ; move temp. reg. tfr3 to arg |
||
11521 | 12672 ;------ |
||
11522 | 12673 F88655 mvt3_a: |
||
11523 | 12674 ;------ |
||
11524 | 12675 F88655 ACC16 |
||
11525 | 12676 F88655 C2 20 rep #PMFLAG |
||
11526 | 12677 .LONGA on |
||
11527 | 12678 .MNLIST |
||
11528 | 12679 F88657 A5 8C lda tfr3 |
||
11529 | 12680 F88659 85 2A sta argm |
||
11530 | 12681 F8865B A5 8E lda tfr3+2 |
||
11531 | 12682 F8865D 85 2C sta argm+2 |
||
11532 | 12683 F8865F A5 90 lda tfr3+4 |
||
11533 | Tue Jul 17 11:00:18 2018 Page 187 |
||
11534 | |||
11535 | |||
11536 | |||
11537 | |||
11538 | 12684 F88661 85 2E sta argm+4 |
||
11539 | 12685 F88663 A5 92 lda tfr3+6 |
||
11540 | 12686 F88665 85 30 sta argm+6 |
||
11541 | 12687 F88667 A5 94 lda tfr3+8 |
||
11542 | 12688 F88669 85 32 sta argm+8 |
||
11543 | 12689 F8866B A5 96 lda tfr3+10 |
||
11544 | 12690 F8866D 85 34 sta argm+10 |
||
11545 | 12691 F8866F A5 98 lda tfr3+12 |
||
11546 | 12692 F88671 85 36 sta argm+12 |
||
11547 | 12693 F88673 A5 9A lda tfr3+14 |
||
11548 | 12694 F88675 85 38 sta argm+14 |
||
11549 | 12695 F88677 A5 9C lda tfr3+16 |
||
11550 | 12696 F88679 85 3A sta argexp |
||
11551 | 12697 F8867B A5 9E lda tfr3+18 |
||
11552 | 12698 F8867D 85 3C sta argsgn |
||
11553 | 12699 F8867F ACC08 |
||
11554 | 12700 F8867F E2 20 sep #PMFLAG |
||
11555 | 12701 .LONGA off |
||
11556 | 12702 .MNLIST |
||
11557 | 12703 F88681 60 rts |
||
11558 | 12704 |
||
11559 | 12705 ; ldfac - load fac with a constant K stored in program memory |
||
11560 | 12706 ; |
||
11561 | 12707 ; entry: |
||
11562 | 12708 ; A = low address of constant K |
||
11563 | 12709 ; Y = high address of constant K |
||
11564 | 12710 ; |
||
11565 | 12711 ; exit: |
||
11566 | 12712 ; fac = K |
||
11567 | 12713 ; |
||
11568 | 12714 ; This routine is used internally and not intended for end use. |
||
11569 | 12715 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
11570 | 12716 ; in program memory segment(the code segment that hold this routine). |
||
11571 | 12717 ; |
||
11572 | 12718 ;----- |
||
11573 | 12719 F88682 ldfac: |
||
11574 | 12720 ;----- |
||
11575 | 12721 F88682 85 42 sta fcp ; set long pointer to K |
||
11576 | 12722 F88684 84 43 sty fcp+1 |
||
11577 | 12723 F88686 A9 F8 lda #.SEG.ldfac |
||
11578 | 12724 F88688 85 44 sta fcp+2 |
||
11579 | 12725 F8868A A2 00 ldx #0 |
||
11580 | 12726 F8868C 86 25 stx facst ; always assume valid K |
||
11581 | 12727 F8868E ACC16 |
||
11582 | 12728 F8868E C2 20 rep #PMFLAG |
||
11583 | 12729 .LONGA on |
||
11584 | 12730 .MNLIST |
||
11585 | 12731 F88690 A7 42 lda [fcp] ; set mantissa |
||
11586 | 12732 F88692 85 12 sta facm |
||
11587 | 12733 F88694 A0 02 ldy #2 |
||
11588 | 12734 F88696 B7 42 lda [fcp],y |
||
11589 | 12735 F88698 85 14 sta facm+2 |
||
11590 | 12736 F8869A A0 04 ldy #4 |
||
11591 | 12737 F8869C B7 42 lda [fcp],y |
||
11592 | 12738 F8869E 85 16 sta facm+4 |
||
11593 | 12739 F886A0 A0 06 ldy #6 |
||
11594 | 12740 F886A2 B7 42 lda [fcp],y |
||
11595 | Tue Jul 17 11:00:18 2018 Page 188 |
||
11596 | |||
11597 | |||
11598 | |||
11599 | |||
11600 | 12741 F886A4 85 18 sta facm+6 |
||
11601 | 12742 F886A6 A0 08 ldy #8 |
||
11602 | 12743 F886A8 B7 42 lda [fcp],y |
||
11603 | 12744 F886AA 85 1A sta facm+8 |
||
11604 | 12745 F886AC A0 0A ldy #10 |
||
11605 | 12746 F886AE B7 42 lda [fcp],y |
||
11606 | 12747 F886B0 85 1C sta facm+10 |
||
11607 | 12748 F886B2 A0 0C ldy #12 |
||
11608 | 12749 F886B4 B7 42 lda [fcp],y |
||
11609 | 12750 F886B6 85 1E sta facm+12 |
||
11610 | 12751 F886B8 A0 0E ldy #14 |
||
11611 | 12752 F886BA B7 42 lda [fcp],y |
||
11612 | 12753 F886BC 85 20 sta facm+14 |
||
11613 | 12754 F886BE A0 10 ldy #16 |
||
11614 | 12755 F886C0 B7 42 lda [fcp],y |
||
11615 | 12756 F886C2 10 01 bpl ?p |
||
11616 | 12757 F886C4 CA dex |
||
11617 | 12758 F886C5 29 FF 7F ?p: and #$7FFF |
||
11618 | 12759 F886C8 85 22 sta facexp ; set exponent |
||
11619 | 12760 F886CA ACC08 |
||
11620 | 12761 F886CA E2 20 sep #PMFLAG |
||
11621 | 12762 .LONGA off |
||
11622 | 12763 .MNLIST |
||
11623 | 12764 F886CC 86 24 stx facsgn ; set sign |
||
11624 | 12765 F886CE 60 rts |
||
11625 | 12766 F886CF |
||
11626 | 12767 ; ldarg - load arg with a constant K stored in program memory |
||
11627 | 12768 ; |
||
11628 | 12769 ; entry: |
||
11629 | 12770 ; A = low address of constant K |
||
11630 | 12771 ; Y = high address of constant K |
||
11631 | 12772 ; |
||
11632 | 12773 ; exit: |
||
11633 | 12774 ; arg = K |
||
11634 | 12775 ; |
||
11635 | 12776 ; This routine is used internally and not intended for end use. |
||
11636 | 12777 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
11637 | 12778 ; in program memory segment(the code segment that hold this routine). |
||
11638 | 12779 ; |
||
11639 | 12780 F886CF ldarg: |
||
11640 | 12781 F886CF 85 42 sta fcp ; set long pointer to K |
||
11641 | 12782 F886D1 84 43 sty fcp+1 |
||
11642 | 12783 F886D3 A9 F8 lda #.SEG.ldarg |
||
11643 | 12784 F886D5 85 44 sta fcp+2 |
||
11644 | 12785 |
||
11645 | 12786 ; ldarg2 - entry if long pointer fcp was already set |
||
11646 | 12787 F886D7 ldarg2: |
||
11647 | 12788 F886D7 A2 00 ldx #0 |
||
11648 | 12789 F886D9 86 3D stx argst ; always assume valid K |
||
11649 | 12790 F886DB ACC16 |
||
11650 | 12791 F886DB C2 20 rep #PMFLAG |
||
11651 | 12792 .LONGA on |
||
11652 | 12793 .MNLIST |
||
11653 | 12794 F886DD A7 42 lda [fcp] ; set mantissa |
||
11654 | 12795 F886DF 85 2A sta argm |
||
11655 | 12796 F886E1 A0 02 ldy #2 |
||
11656 | 12797 F886E3 B7 42 lda [fcp],y |
||
11657 | Tue Jul 17 11:00:18 2018 Page 189 |
||
11658 | |||
11659 | |||
11660 | |||
11661 | |||
11662 | 12798 F886E5 85 2C sta argm+2 |
||
11663 | 12799 F886E7 A0 04 ldy #4 |
||
11664 | 12800 F886E9 B7 42 lda [fcp],y |
||
11665 | 12801 F886EB 85 2E sta argm+4 |
||
11666 | 12802 F886ED A0 06 ldy #6 |
||
11667 | 12803 F886EF B7 42 lda [fcp],y |
||
11668 | 12804 F886F1 85 30 sta argm+6 |
||
11669 | 12805 F886F3 A0 08 ldy #8 |
||
11670 | 12806 F886F5 B7 42 lda [fcp],y |
||
11671 | 12807 F886F7 85 32 sta argm+8 |
||
11672 | 12808 F886F9 A0 0A ldy #10 |
||
11673 | 12809 F886FB B7 42 lda [fcp],y |
||
11674 | 12810 F886FD 85 34 sta argm+10 |
||
11675 | 12811 F886FF A0 0C ldy #12 |
||
11676 | 12812 F88701 B7 42 lda [fcp],y |
||
11677 | 12813 F88703 85 36 sta argm+12 |
||
11678 | 12814 F88705 A0 0E ldy #14 |
||
11679 | 12815 F88707 B7 42 lda [fcp],y |
||
11680 | 12816 F88709 85 38 sta argm+14 |
||
11681 | 12817 F8870B A0 10 ldy #16 |
||
11682 | 12818 F8870D B7 42 lda [fcp],y |
||
11683 | 12819 F8870F 10 01 bpl ?p |
||
11684 | 12820 F88711 CA dex |
||
11685 | 12821 F88712 29 FF 7F ?p: and #$7FFF |
||
11686 | 12822 F88715 85 3A sta argexp ; set exponent |
||
11687 | 12823 F88717 ACC08 |
||
11688 | 12824 F88717 E2 20 sep #PMFLAG |
||
11689 | 12825 .LONGA off |
||
11690 | 12826 .MNLIST |
||
11691 | 12827 F88719 86 3C stx argsgn ; set sign |
||
11692 | 12828 F8871B 60 rts |
||
11693 | 12829 |
||
11694 | 12830 ;---------------------------------------------------------------------------- |
||
11695 | 12831 ; polynomial evaluatation |
||
11696 | 12832 ;---------------------------------------------------------------------------- |
||
11697 | 12833 |
||
11698 | 12834 ; peval - evaluate polynomial of degree N |
||
11699 | 12835 ; |
||
11700 | 12836 ; entry: |
||
11701 | 12837 ; A = low address of coefficient C |
||
11702 | 12838 ; N |
||
11703 | 12839 ; |
||
11704 | 12840 ; Y = high address of coefficient C |
||
11705 | 12841 ; N |
||
11706 | 12842 ; X = degree (N) |
||
11707 | 12843 ; tfr0 = x (temp. register #0) |
||
11708 | 12844 ; |
||
11709 | 12845 ; exit: 2 N |
||
11710 | 12846 ; fac = y = C + C x + C x +...+ C x |
||
11711 | 12847 ; 0 1 2 N |
||
11712 | 12848 ; |
||
11713 | 12849 ; Constant Cn..C0 are stored unpacked, and with full size 128 bits mantissa, |
||
11714 | 12850 ; in program memory segment(the code segment that hold this routine), from |
||
11715 | 12851 ; the highest order Cn to lowest order C0. |
||
11716 | 12852 ; |
||
11717 | 12853 ;----- |
||
11718 | 12854 F8871C peval: |
||
11719 | Tue Jul 17 11:00:18 2018 Page 190 |
||
11720 | |||
11721 | |||
11722 | |||
11723 | |||
11724 | 12855 ;----- |
||
11725 | 12856 F8871C 86 4B stx pdeg |
||
11726 | 12857 F8871E 20 82 86 jsr ldfac ; fac=coefficient Cn |
||
11727 | 12858 F88721 20 CE 85 ?lp: jsr mvt0_a ; arg=tfr0 |
||
11728 | 12859 F88724 20 DD 49 jsr fpmult ; multiplies by x |
||
11729 | 12860 F88727 ACC16CLC |
||
11730 | 12861 F88727 C2 21 rep #(PMFLAG.OR.PCFLAG) |
||
11731 | 12862 .LONGA on |
||
11732 | 12863 .MNLIST |
||
11733 | 12864 F88729 A5 42 lda fcp ; next coefficient |
||
11734 | 12865 F8872B 69 12 00 adc #FCSIZ |
||
11735 | 12866 F8872E 85 42 sta fcp |
||
11736 | 12867 F88730 ACC08 |
||
11737 | 12868 F88730 E2 20 sep #PMFLAG |
||
11738 | 12869 .LONGA off |
||
11739 | 12870 .MNLIST |
||
11740 | 12871 F88732 20 7A 45 jsr fcadd ; add coefficient Ck |
||
11741 | 12872 F88735 C6 4B dec pdeg |
||
11742 | 12873 F88737 D0 E8 bne ?lp |
||
11743 | 12874 F88739 60 rts |
||
11744 | 12875 |
||
11745 | 12876 ; pevalp1 - evaluate polynomial of degree N+1 |
||
11746 | 12877 ; |
||
11747 | 12878 ; entry: |
||
11748 | 12879 ; A = low address of coefficient C |
||
11749 | 12880 ; N |
||
11750 | 12881 ; |
||
11751 | 12882 ; Y = high address of coefficient C |
||
11752 | 12883 ; N |
||
11753 | 12884 ; X = degree - 1 (N) |
||
11754 | 12885 ; tfr0 = x (temp. register #0) |
||
11755 | 12886 ; |
||
11756 | 12887 ; exit: 2 N N+1 |
||
11757 | 12888 ; fac = y = C + C x + C x +...+ C x + x |
||
11758 | 12889 ; 0 1 2 N |
||
11759 | 12890 ; |
||
11760 | 12891 ; Constant Cn..C0 are stored unpacked, and with full size 128 bits mantissa, |
||
11761 | 12892 ; in program memory segment(the code segment that hold this routine), from |
||
11762 | 12893 ; the highest order Cn to lowest order C0. |
||
11763 | 12894 ; |
||
11764 | 12895 ;------- |
||
11765 | 12896 F8873A pevalp1: |
||
11766 | 12897 ;------- |
||
11767 | 12898 F8873A 86 4B stx pdeg |
||
11768 | 12899 F8873C 20 82 86 jsr ldfac ; coefficient Cn |
||
11769 | 12900 F8873F 20 CE 85 jsr mvt0_a ; arg=tfr0 |
||
11770 | 12901 F88742 20 7D 45 jsr fpadd ; x + Cn |
||
11771 | 12902 F88745 20 CE 85 ?lp: jsr mvt0_a ; loop |
||
11772 | 12903 F88748 20 DD 49 jsr fpmult ; multiplies by x |
||
11773 | 12904 F8874B ACC16CLC |
||
11774 | 12905 F8874B C2 21 rep #(PMFLAG.OR.PCFLAG) |
||
11775 | 12906 .LONGA on |
||
11776 | 12907 .MNLIST |
||
11777 | 12908 F8874D A5 42 lda fcp ; next coefficient |
||
11778 | 12909 F8874F 69 12 00 adc #FCSIZ |
||
11779 | 12910 F88752 85 42 sta fcp |
||
11780 | 12911 F88754 ACC08 |
||
11781 | Tue Jul 17 11:00:18 2018 Page 191 |
||
11782 | |||
11783 | |||
11784 | |||
11785 | |||
11786 | 12912 F88754 E2 20 sep #PMFLAG |
||
11787 | 12913 .LONGA off |
||
11788 | 12914 .MNLIST |
||
11789 | 12915 F88756 20 7A 45 jsr fcadd ; add coefficient Ck |
||
11790 | 12916 F88759 C6 4B dec pdeg |
||
11791 | 12917 F8875B D0 E8 bne ?lp |
||
11792 | 12918 F8875D 60 rts |
||
11793 | 12919 |
||
11794 | 12920 ;---------------------------------------------------------------------------- |
||
11795 | 12921 ; utilities & helper routines |
||
11796 | 12922 ;---------------------------------------------------------------------------- |
||
11797 | 12923 |
||
11798 | 12924 ; fccmp - compare fac versus a constant stored in program memory |
||
11799 | 12925 ; |
||
11800 | 12926 ; entry: |
||
11801 | 12927 ; fac = x |
||
11802 | 12928 ; A = low address of constant K |
||
11803 | 12929 ; Y = high address of constant K |
||
11804 | 12930 ; |
||
11805 | 12931 ; exit: |
||
11806 | 12932 ; if fac < K: ZF=0,NF=1 |
||
11807 | 12933 ; if fac = K: ZF=1,NF=0 |
||
11808 | 12934 ; if fac > K: ZF=0,NF=0 |
||
11809 | 12935 ; |
||
11810 | 12936 ; This routine is used internally and not intended for end use. |
||
11811 | 12937 ; Constant are stored unpacked, and with full size 128 bits mantissa, |
||
11812 | 12938 ; in program memory segment(the code segment that hold this routine). |
||
11813 | 12939 ; |
||
11814 | 12940 ;----- |
||
11815 | 12941 F8875E fccmp: |
||
11816 | 12942 ;----- |
||
11817 | 12943 F8875E 85 42 sta fcp ; set long pointer to K |
||
11818 | 12944 F88760 84 43 sty fcp+1 |
||
11819 | 12945 F88762 A9 F8 lda #.SEG.fccmp |
||
11820 | 12946 F88764 85 44 sta fcp+2 |
||
11821 | 12947 F88766 A0 11 ldy #17 |
||
11822 | 12948 F88768 B7 42 lda [fcp],y ; K sign |
||
11823 | 12949 F8876A 45 24 eor facsgn ; compare with fac sign |
||
11824 | 12950 F8876C 10 04 bpl ?same ; sign match |
||
11825 | 12951 F8876E A5 24 lda facsgn ; sign unmatch so return... |
||
11826 | 12952 F88770 80 54 bra ?sgn ; ...fac sign |
||
11827 | 12953 F88772 ?same: ACC16 |
||
11828 | 12954 F88772 C2 20 rep #PMFLAG |
||
11829 | 12955 .LONGA on |
||
11830 | 12956 .MNLIST |
||
11831 | 12957 F88774 88 dey |
||
11832 | 12958 F88775 B7 42 lda [fcp],y ; biased exponent |
||
11833 | 12959 F88777 29 FF 7F and #$7FFF ; mask off sign |
||
11834 | 12960 F8877A C5 22 cmp facexp |
||
11835 | 12961 F8877C 90 3E bcc ?chk ; fac > K (CF=0) |
||
11836 | 12962 F8877E D0 3C bne ?chk ; fac < K (CF=1) |
||
11837 | 12963 F88780 A0 0E ldy #14 ; same exponent so now compare mantissa |
||
11838 | 12964 F88782 B7 42 lda [fcp],y |
||
11839 | 12965 F88784 C5 20 cmp facm+14 |
||
11840 | 12966 F88786 D0 34 bne ?chk ; CF=0 if fac>K else CF=1 if fac<K |
||
11841 | 12967 F88788 A0 0C ldy #12 |
||
11842 | 12968 F8878A B7 42 lda [fcp],y |
||
11843 | Tue Jul 17 11:00:18 2018 Page 192 |
||
11844 | |||
11845 | |||
11846 | |||
11847 | |||
11848 | 12969 F8878C C5 1E cmp facm+12 |
||
11849 | 12970 F8878E D0 2C bne ?chk |
||
11850 | 12971 F88790 A0 0A ldy #10 |
||
11851 | 12972 F88792 B7 42 lda [fcp],y |
||
11852 | 12973 F88794 C5 1C cmp facm+10 |
||
11853 | 12974 F88796 D0 24 bne ?chk |
||
11854 | 12975 F88798 A0 08 ldy #8 |
||
11855 | 12976 F8879A B7 42 lda [fcp],y |
||
11856 | 12977 F8879C C5 1A cmp facm+8 |
||
11857 | 12978 F8879E D0 1C bne ?chk |
||
11858 | 12979 F887A0 A0 06 ldy #6 |
||
11859 | 12980 F887A2 B7 42 lda [fcp],y |
||
11860 | 12981 F887A4 C5 18 cmp facm+6 |
||
11861 | 12982 F887A6 D0 14 bne ?chk |
||
11862 | 12983 F887A8 A0 04 ldy #4 |
||
11863 | 12984 F887AA B7 42 lda [fcp],y |
||
11864 | 12985 F887AC C5 16 cmp facm+4 |
||
11865 | 12986 F887AE D0 0C bne ?chk |
||
11866 | 12987 F887B0 A0 02 ldy #2 |
||
11867 | 12988 F887B2 B7 42 lda [fcp],y |
||
11868 | 12989 F887B4 C5 14 cmp facm+2 |
||
11869 | 12990 F887B6 D0 04 bne ?chk |
||
11870 | 12991 F887B8 A7 42 lda [fcp] |
||
11871 | 12992 F887BA C5 12 cmp facm |
||
11872 | 12993 F887BC ?chk: ACC08 |
||
11873 | 12994 F887BC E2 20 sep #PMFLAG |
||
11874 | 12995 .LONGA off |
||
11875 | 12996 .MNLIST |
||
11876 | 12997 F887BE F0 0D beq ?done ; fac=K so return ZF=1 |
||
11877 | 12998 F887C0 A5 24 lda facsgn |
||
11878 | 12999 F887C2 90 02 bcc ?sgn ; fac>K |
||
11879 | 13000 F887C4 49 FF eor #$FF ; invert sign (fac<K) |
||
11880 | 13001 F887C6 2A ?sgn: rol a ; CF=sign |
||
11881 | 13002 F887C7 A9 FF lda #$FF ; NF=1 if fac<K |
||
11882 | 13003 F887C9 B0 02 bcs ?done |
||
11883 | 13004 F887CB A9 01 lda #1 ; NF=0 if fac>K |
||
11884 | 13005 F887CD 60 ?done: rts |
||
11885 | 13006 |
||
11886 | 13007 ; signed multiplication 16 bit |
||
11887 | 13008 ; |
||
11888 | 13009 ; entry: C = multiplicand 1 16 bit |
||
11889 | 13010 ; X = multiplicand 2 low byte |
||
11890 | 13011 ; Y = multiplicand 2 high byte |
||
11891 | 13012 ; |
||
11892 | 13013 ; exit: C = result high word |
||
11893 | 13014 ; X = result low-low byte |
||
11894 | 13015 ; Y = result low-high byte |
||
11895 | 13016 ; |
||
11896 | 13017 ; call with A in 16 bit mode |
||
11897 | 13018 ; |
||
11898 | 13019 ;----- |
||
11899 | 13020 F887CE imult: |
||
11900 | 13021 ;----- |
||
11901 | 13022 .LONGA on |
||
11902 | 13023 .LONGI off |
||
11903 | 13024 |
||
11904 | 13025 F887CE 85 BC sta mcand1 ; store mcand1&mcand2 |
||
11905 | Tue Jul 17 11:00:18 2018 Page 193 |
||
11906 | |||
11907 | |||
11908 | |||
11909 | |||
11910 | 13026 F887D0 86 BE stx mcand2 |
||
11911 | 13027 F887D2 84 BF sty mcand2+1 |
||
11912 | 13028 F887D4 45 BE eor mcand2 ; sign of the result |
||
11913 | 13029 F887D6 85 C0 sta mcsgn |
||
11914 | 13030 F887D8 A2 00 ldx #0 |
||
11915 | 13031 F887DA A4 BD ldy mcand1+1 |
||
11916 | 13032 F887DC 10 06 bpl ?p1 ; mcand1 is positive |
||
11917 | 13033 F887DE 38 sec |
||
11918 | 13034 F887DF 8A txa |
||
11919 | 13035 F887E0 E5 BC sbc mcand1 ; complement mcand1 |
||
11920 | 13036 F887E2 85 BC sta mcand1 |
||
11921 | 13037 F887E4 A4 BF ?p1: ldy mcand2+1 |
||
11922 | 13038 F887E6 10 06 bpl ?p2 ; mcand2 is positive |
||
11923 | 13039 F887E8 38 sec |
||
11924 | 13040 F887E9 8A txa |
||
11925 | 13041 F887EA E5 BE sbc mcand2 ; complement mcand2 |
||
11926 | 13042 F887EC 85 BE sta mcand2 |
||
11927 | 13043 F887EE 8A ?p2: txa ; clear high word of result |
||
11928 | 13044 F887EF A2 11 ldx #17 ; 17 bit loop |
||
11929 | 13045 F887F1 18 clc |
||
11930 | 13046 F887F2 6A ?shr: ror a ; shift in any carry - high result |
||
11931 | 13047 F887F3 66 BC ror mcand1 ; low result |
||
11932 | 13048 F887F5 90 03 bcc ?no ; no add |
||
11933 | 13049 F887F7 18 clc |
||
11934 | 13050 F887F8 65 BE adc mcand2 |
||
11935 | 13051 F887FA CA ?no: dex |
||
11936 | 13052 F887FB D0 F5 bne ?shr ; repeat |
||
11937 | 13053 F887FD 85 BE sta mcand2 ; store result high |
||
11938 | 13054 F887FF 24 C0 bit mcsgn ; if result is positive... |
||
11939 | 13055 F88801 10 09 bpl ?done ; ...done (C=result high) |
||
11940 | 13056 F88803 8A txa |
||
11941 | 13057 F88804 38 sec ; else complement result |
||
11942 | 13058 F88805 E5 BC sbc mcand1 |
||
11943 | 13059 F88807 85 BC sta mcand1 |
||
11944 | 13060 F88809 8A txa |
||
11945 | 13061 F8880A E5 BE sbc mcand2 ; C=result high word |
||
11946 | 13062 F8880C A6 BC ?done: ldx mcand1 ; X=result low-low byte |
||
11947 | 13063 F8880E A4 BD ldy mcand1+1 ; Y=result low-high byte |
||
11948 | 13064 F88810 60 rts |
||
11949 | 13065 |
||
11950 | 13066 .LONGA off |
||
11951 | 13067 |
||
11952 | 13068 ; unsigned division 16 bit |
||
11953 | 13069 ; |
||
11954 | 13070 ; entry: C = 16 bit dividend |
||
11955 | 13071 ; X = 16 bit divisor |
||
11956 | 13072 ; |
||
11957 | 13073 ; exit: C = 16 bit quotient |
||
11958 | 13074 ; Y = 16 bits remainder |
||
11959 | 13075 ; |
||
11960 | 13076 ; use: all |
||
11961 | 13077 ; |
||
11962 | 13078 ; note: no check for null divisor |
||
11963 | 13079 ; |
||
11964 | 13080 ; call in 16 bit mode |
||
11965 | 13081 ;----- |
||
11966 | 13082 F88811 udiv: |
||
11967 | Tue Jul 17 11:00:18 2018 Page 194 |
||
11968 | |||
11969 | |||
11970 | |||
11971 | |||
11972 | 13083 ;----- |
||
11973 | 13084 .LONGA on |
||
11974 | 13085 .LONGI on |
||
11975 | 13086 |
||
11976 | 13087 F88811 86 C2 stx dvsor ; divisor |
||
11977 | 13088 F88813 A8 tay ; Y=dividend |
||
11978 | 13089 F88814 64 C4 stz quot ; init quotient |
||
11979 | 13090 F88816 8A txa ; C=divisor |
||
11980 | 13091 F88817 A2 01 00 ldx #1 ; bit counter |
||
11981 | 13092 F8881A 0A ?shd: asl a ; shift divisor: get leftmost bit |
||
11982 | 13093 F8881B B0 06 bcs ?div ; go to division |
||
11983 | 13094 F8881D E8 inx |
||
11984 | 13095 F8881E E0 11 00 cpx #17 ; test all divisor bit's |
||
11985 | 13096 F88821 D0 F7 bne ?shd |
||
11986 | 13097 F88823 6A ?div: ror a ; put shifted-out bit back |
||
11987 | 13098 F88824 85 C2 sta dvsor |
||
11988 | 13099 F88826 98 ?sub: tya ; get dividend |
||
11989 | 13100 F88827 38 sec |
||
11990 | 13101 F88828 E5 C2 sbc dvsor |
||
11991 | 13102 F8882A 90 01 bcc ?no ; can't subctract, retain old dividend |
||
11992 | 13103 F8882C A8 tay ; Y=new dividend |
||
11993 | 13104 F8882D 26 C4 ?no: rol quot ; shift carry into quotient (1 if division) |
||
11994 | 13105 F8882F 46 C2 lsr dvsor ; shift right divisor for next subtract |
||
11995 | 13106 F88831 CA dex |
||
11996 | 13107 F88832 D0 F2 bne ?sub ; repeat |
||
11997 | 13108 F88834 84 C2 sty dvsor ; store remainder |
||
11998 | 13109 F88836 A5 C4 lda quot ; C=quotient |
||
11999 | 13110 F88838 60 rts |
||
12000 | 13111 |
||
12001 | 13112 .LONGA off |
||
12002 | 13113 .LONGI off |
||
12003 | 13114 |
||
12004 | 13115 0042DE CODESIZ .EQU $ - fcsub +1 |
||
12005 | 13116 |
||
12006 | 13117 ; end of file |
||
12007 | |||
12008 | |||
12009 | Lines Assembled : 12356 Errors : 0 |
||
12010 | |||
12011 | |||
12012 |