WebSVN – MB01 Project – Blame – /trunk/sources/lst/F8/fpu.lst

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 = 2R - DQ
		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 ; facm4+argm=facm5
		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/ww)) + 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((ppp+2z)/(2pp*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/ww)) + 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 ; 2w + z/(ww)
		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/(ww)) + 2*w)
		6194	8341
		6195	8342 ?hit: ; Halley's iteration
		6196	8343 ; y = p((ppp+2z)/(2pp*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 ; ppp
		6201	Tue Jul 17 11:00:18 2018 Page 101
		6202
		6203
		6204
		6205
		6206	8348 F8617F 20 C0 84 jsr mvf_t2 ; tfr2=ppp
		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=ppp+2*X
		6219	8361 F86191 20 28 86 jsr mvt2_a ; ppp
		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 ; 2pp*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 ; 2pp*p+z
		6231	8373 F861A0 20 55 86 jsr mvt3_a ; ppp+2*z
		6232	8374 F861A3 20 10 4A jsr fpdiv ; (ppp+2z)/(2ppp+z)
		6233	8375 F861A6 20 FB 85 jsr mvt1_a ; p
		6234	8376 F861A9 4C DD 49 jmp fpmult ; p((ppp+2z)/(2pp*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 ; yzR(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+yzR(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 ; yzP(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 ; yz(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+yz(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=fP(z)/(Q(z) - fP(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+2y = 1 + 2fP(z)/(Q(z) - fP(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 ; ffP(f)
		7595	9505 F86A4B 20 CE 85 jsr mvt0_a
		7596	9506 F86A4E 20 DD 49 jsr fpmult ; fff*P(f)
		7597	9507 F86A51 20 C0 84 jsr mvf_t2 ; tfr2=fff*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 ; fff*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.5ff + fff*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 ; w2 = 2floor(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 - (zz/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-ycdp1-ycdp2
		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-ycdp3-ycdp2-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 ; zwR(w)
		8819	10509 F872D2 20 FB 85 jsr mvt1_a ; arg=z
		8820	10510 F872D5 20 7D 45 jsr fpadd ; z + zwR(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 ; wP(w)/Q(w)=wR(w)
		8922	10607 F87379 20 FB 85 jsr mvt1_a ; arg=z
		8923	10608 F8737C 20 DD 49 jsr fpmult ; zwR(w)
		8924	10609 F8737F 20 FB 85 jsr mvt1_a ; arg=z
		8925	10610 F87382 20 7D 45 jsr fpadd ; y=z+zwR(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 ; zwR(z)
		9191	10851 F874F6 20 FB 85 jsr mvt1_a ; arg=w
		9192	10852 F874F9 20 7D 45 jsr fpadd ; w+zwR(z)
		9193	10853 F874FC 20 28 86 jsr mvt2_a ; arg=y
		9194	10854 F874FF 20 7D 45 jsr fpadd ; y+w+zwR(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 ; xzR(z)
		9960	11400 F87BB9 20 FB 85 jsr mvt1_a ; arg=x
		9961	11401 F87BBC 4C 7D 45 jmp fpadd ; returns sinh(x)=x + xzR(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 ; xzR(z)
		10149	11574 F87C84 20 FB 85 jsr mvt1_a ; arg=x
		10150	11575 F87C87 4C 7D 45 jmp fpadd ; returns tanh(x)=x + xzR(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(xx + 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(xx + 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 ; xzR(z)
		10256	11671 F87D0A 20 28 86 jsr mvt2_a ; arg=x
		10257	11672 F87D0D 20 7D 45 jsr fpadd ; asinh(x)=x + xzR(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(2z) 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(2x) if xx 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(2z)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 ; xzR(z)
		10438	11838 F87DF4 20 28 86 jsr mvt2_a ; arg=x
		10439	11839 F87DF7 4C 7D 45 jmp fpadd ; atanh(x)=x + xzR(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

Subversion Repositories MB01 Project

(root)/trunk/sources/lst/F8/fpu.lst – Rev 1