Subversion Repositories MB01 Project

Rev

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