Blame | Last modification | View Log | Download | RSS feed
Tue Jul 17 11:00:18 2018 Page 12500 A.D. 65816 Macro Assembler #26960 - Version 5.02g-----------------------------------------------------Input Filename : src\F8\fpu.asmOutput Filename : obj\F8\fpu.objListing Has Been Relocated2694 .LIST on26952696 ;;.INCLUDE inc\p0.inc2697 F8FFB1 .INCLUDE inc\dpfpu.inc2698 ;;2699 ;; Copyright (c) 2016 Marco Granati <mg@unet.bz>2700 ;;2701 ;; Permission to use, copy, modify, and distribute this software for any2702 ;; purpose with or without fee is hereby granted, provided that the above2703 ;; copyright notice and this permission notice appear in all copies.2704 ;;2705 ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES2706 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF2707 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR2708 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES2709 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN2710 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF2711 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.2712 ;;27132714 ;; name: dpfpu.inc2715 ;; rev.: 2016/03/302716 ;; o.s. 65C816 version v1.027172718 .LIST on27192720 ; direct page for flotaing point unit2721 _DPFPU: .SECTION page0, common, ref_only, offset 0 ;FPU D.P.27222723 000080 MNTBITS .EQU (16*8) ; significand bits + guard bits2724 000010 MANTSIZ .EQU 16 ; significand size2725 000014 FREGSIZ .EQU 20 ; floating point register size27262727 000000 tm .DS 16 ; temp. mantissa27282729 000010 00 fsubnf .DB ; subnormal flag used by fac2dec2730 000010 atncode .EQU fsubnf ; fatanyx octant27312732 000011 00 sgncmp .DB ; sign comparison: fac vs. arg27332734 ; floating Point accumulator (fac)2735 000012 facm .DS 16 ; guard bits (32 bits)+significand (80 bits)2736 000022 0000 facexp .DW ; fac biased exponent2737 000024 00 facsgn .DB ; fac mantissa sign2738 000025 00 facst .DB ; fac status for floating point2739 ; <7>: 1 if fac is invalid (nan or inf)Tue Jul 17 11:00:18 2018 Page 22740 ; <6>: 1 if fac=inf (with <7>=1)2741 ; 0 if fac=nan (with <7>=1)2742 ; <6>: 1 if fac=0 (with <7>=0)2743 ; <5>: always '0'27442745 ; fac status for long integer2746 ; <7>: 1 if facm will be regarded as 'signed'2747 ; <6>: 1 if facm = 02748 ; <5>: always '1'27492750 000026 0000 fexph .DW ; unbiased fac exponent sign extension2751 000028 0000 facext .DW ; fac guard bits extension2752 000028 wftmp2 .EQU facext2753 000024 facsiz .EQU facsgn ; integer only: size in bytes27542755 ; floating point operand (arg)2756 00002A argm .DS 16 ; guard bits (32 bits)+significand (80 bits)2757 00003A 0000 argexp .DW ; arg biased exponent2758 00003C 00 argsgn .DB ; arg mantissa sign2759 00003D 00 argst .DB ; arg status for floating point2760 ; <7>: 1 if arg is invalid (nan or inf)2761 ; <6>: 1 if arg=inf (with <7>=1)2762 ; 0 if arg=nan (with <7>=1)2763 ; <6>: 1 if arg=0 (with <7>=0)27642765 ; arg status for long integer2766 ; <7>: 1 if facm will be regarded as 'signed'2767 ; <6>: 1 if facm = 02768 ; <5>: always '1'2769 00003E2770 00003E 0000 aexph .DW ; unbiased arg exponent sign extension2771 000040 0000 argext .DW27722773 00003E wftmp .EQU aexph ; temp. word (int2dec, fpadd, fpsub)2774 00003C argsiz .EQU argsgn ; integer only: size in bytes27752776 000042 fcp LP ; long pointer to flaot constants2777 000045 00 scsgn .DB ; scaling sign2778 000046 0000 scexp .DW ; scaling value2779 000048 0000 dexp .DW ; decimal exponent2780 00004A 00 dsgn .DB ; decimal float sign2781 00004B 00 pdeg .DB ; polyn. degree2782 00004B powfg .EQU pdeg ; flag used by fpowxy27832784 00004C tlp LP ; string long pointer2785 00004F 00 fpidx .DB ; string index2786 0000502787 000050 tfr0 .DS 20 ; temp. float reg. 02788 000064 tfr1 .DS 20 ; temp. float reg. 12789 000078 tfr2 .DS 20 ; temp. float reg. 22790 00008C tfr3 .DS 20 ; temp. float reg. 32791 0000A0 tfr4 .DS 20 ; temp. float reg. 42792 0000B4 tfr5 .DS 20 ; temp. float reg. 52793 0000C8 .DS 4 ; used by xcvt: doesn't change27942795 0000CB XCVTEND .EQU ($ - 1) ; last byte of xcvt buffer2796Tue Jul 17 11:00:18 2018 Page 32797 ; buffer used by decimal conversion (overlap tfr0&tfr1: 40 bytes)2798 000050 fpstr .EQU tfr0 ; 40 bytes buffer2799 ; buffer used to format a decimal string2800 000078 xcvt .EQU tfr2 ; 84 bytes buffer28012802 0000B4 fcpc0 .EQU tfr5 ; constants pointer for exp. function2803 0000B6 fcpc1 .EQU tfr5+22804 0000B8 fcpc2 .EQU tfr5+42805 0000BA fcpp .EQU tfr5+62806 0000BC fcpq .EQU tfr5+82807 0000BE fcpd .EQU tfr5+102808 0000BF fcqd .EQU tfr5+112809 0000C0 fcpolf .EQU tfr5+12 ; polynomial flag28102811 0000B4 tmdot .EQU tfr5 ; digit count after decimal dot2812 0000B6 tmpa .EQU tfr5+2 ; temp: save A&Y2813 0000B7 tmpy .EQU tfr5+32814 0000B8 tmsgn .EQU tfr5+4 ; temp.: significand sign2815 0000B9 tmcnt .EQU tfr5+5 ; temp.: significand digits count2816 0000BA tesgn .EQU tfr5+6 ; temp.: exponent sign2817 0000BB tecnt .EQU tfr5+7 ; temp.: exponent digits count28182819 0000BC mcand1 .EQU tfr5+8 ; multiplicand's2820 0000BE mcand2 .EQU tfr5+102821 0000C0 mcsgn .EQU tfr5+122822 0000C2 dvsor .EQU tfr5+142823 0000C4 quot .EQU tfr5+1628242825 0000CC 0000 fpprec .DW ; precision2826 0000CE 00 fpfmt .DB ; format2827 0000CF 00 fpaltf .DB ; alternate format2828 0000D0 00 fpcap .DB ; adding for lower case2829 0000D1 00 fpstyle .DB ; flag 'F' style2830 00004B fpdot .EQU pdeg ; decimal dot flag2831 0000CE fpoct .EQU fpfmt ; octant (circular func's)2832 0000CF fpcsgn .EQU fpaltf ; circular func's: argument sign2833 0000D0 fpcot .EQU fpcap ; cotangent flag2834 0000D0 fpasin .EQU fpcap ; asin flag28352836 0000D2 00 dummy .DB28372838 .ENDS2847 .LIST on28482849 003FFF EBIAS .EQU $3FFF ; exponent bias2850 007FFF INFEXP .EQU $7FFF ; inf/nan biased exponent2851 008000 INFSND .EQU $8000 ; infinity high word significand2852 00C000 NANSND .EQU $C000 ; nan high word significand2853 007FFE MAXEXP .EQU $7FFE ; max. biased exponent2854 000071 SNBITS .EQU 113 ; significand bits28552856 004006 BIAS8 .EQU (EBIAS + 7) ; bias exponent for 8 bit integer2857 00400E BIAS16 .EQU (BIAS8 + 8) ; bias exponent for 16 bit integer2858 00401E BIAS32 .EQU (BIAS16 + 16) ; bias exponent for 32 bit integer2859 00403E BIAS64 .EQU (BIAS32 + 32) ; bias exponent for 64 bit integer2860 00407E BIAS128 .EQU (BIAS64 + 64) ; bias exponent for 128 bit integer2861 004037 BIAS56 .EQU $4037 ; biased exponent of 2^56Tue Jul 17 11:00:18 2018 Page 42862 ;EM30 .EQU $3F9C ; biased exponent of 1.578e-302863 ;EM20 .EQU $3FBD ; biased exponent of about 1e-202864 ;EM62 .EQU $3F30 ; biased exponent of about 1e-622865 ;EP62 .EQU $40CF ; biased exponent of about 1e622866 004D10 LOG2H .EQU 19728 ; approximated log10(2) * $100002867 000024 MAXDIGITS .EQU 36 ; max. decimal digits2868 000026 EXP10 .EQU 38 ; decimal exponent for 128 bits integer2869 FFFFFC MINGEXP .EQU -4 ; min. decimal exponent 'G' format28702871 FFFF81 MAXBSHIFT .EQU -MNTBITS + 1 ; max. shift mant.28722873 000050 XCVTMAX .EQU 80 ; max. size of decimal string28742875 ;---------------------------------------------------------------------------2876 ; code segment -- bank $F82877 ;---------------------------------------------------------------------------28782879 .CODEF82880 .PUBLIC fpmult, ldfac, ldarg, mvftoa, int2dec, frndm, mvatof, scale10, str2fp2881 .PUBLIC uitrunc, imult, fp2dec, w2dec, fpack, funpack, str2fp2, mvf_t3, mvt3_a2882 .PUBLIC mvf_t1, mvt1_a, fpadd, fpsub, fpmult, fpdiv, fsqrt, flog10, flog10p12883 .PUBLIC fcbrt, floge, flogep1, floor, fexp, fexp10, frexp, fscale, flog2, flog2p12884 .PUBLIC fexp2, fexpm1, fpown, mvt1_f, frootn, fldinf, fldz, fpowxy, str2int2885 .PUBLIC uint2dec, fp2str, fsin, fcos, ftan, fcotan, fasin, facos, fatan2886 .PUBLIC ftrunc, fround, fceil, ui2dec, fpfrac, fsinh, fcosh, ftanh, fasinh, facosh2887 .PUBLIC fatanh, fpmod, fprem, fatanyx, int2str28882889 .LONGA off2890 .LONGI off28912892 ;---------------------------------------------------------------------------2893 ; addition & subtraction implementation2894 ;---------------------------------------------------------------------------28952896 ; fcsub - subtract the argument from one constant stored in program memory2897 ;2898 ; entry:2899 ; fac = x2900 ; A = low address of constant K2901 ; Y = high address of constant K2902 ;2903 ; exit:2904 ; fac = K - x2905 ;2906 ; This routine is used internally and not intended for end use.2907 ; Constant are stored unpacked, and with full size 128 bits mantissa,2908 ; in program memory segment(the code segment that hold this routine).2909 ;2910 ;-----2911 F8455C fcsub:2912 ;-----2913 F8455C 20 CF 86 jsr ldarg ; move K to arg...2914 ; ...and execute arg - fac29152916 ; fpsub - subtract fac from arg and store result in fac2917 ; main subtraction routine2918 ;Tue Jul 17 11:00:18 2018 Page 52919 ; entry:2920 ; arg = x2921 ; fac = y2922 ; CF = 1 if invalid result(inf or nan)2923 ;2924 ; exit:2925 ; fac = x - y2926 ;2927 ;-----2928 F8455F fpsub:2929 ;-----2930 F8455F A5 24 lda facsgn ; change sign to fac...2931 F84561 49 FF eor #$FF2932 F84563 85 24 sta facsgn2933 F84565 80 16 bra fpadd ; and execute arg + (-fac)29342935 ; faddhalf - add 0.5 to the argument2936 ;2937 ; entry:2938 ; fac = x2939 ;2940 ; exit:2941 ; fac = x + 0.52942 ;2943 ; This routine is used internally and not intended for end use.2944 ;2945 ;--------2946 F84567 faddhalf:2947 ;--------2948 F84567 20 9F 4E jsr ldahalf ; move constant K=0.5 to arg...2949 F8456A 80 11 bra fpadd ; ...and execute arg+fac29502951 ; faddone - add 1.0 to the argument2952 ;2953 ; entry:2954 ; fac = x2955 ;2956 ; exit:2957 ; fac = x + 1.02958 ;2959 ; This routine is used internally and not intended for end use.2960 ;2961 ;-------2962 F8456C faddone:2963 ;-------2964 F8456C 20 A6 4E jsr ldaone ; move constant K=1.0 to arg...2965 F8456F 80 0C bra fpadd ; ...and execute arg+fac29662967 ; fsubone - subtract 1.0 from the argument2968 ;2969 ; entry:2970 ; fac = x2971 ;2972 ; exit:2973 ; fac = x - 1.02974 ;2975 ; This routine is used internally and not intended for end use.Tue Jul 17 11:00:18 2018 Page 62976 ;2977 ;-------2978 F84571 fsubone:2979 ;-------2980 F84571 20 A6 4E jsr ldaone ; move constant K=1.0 to arg...2981 F84574 A9 FF lda #$FF2982 F84576 85 3C sta argsgn ; ...change sign to arg...2983 F84578 80 03 bra fpadd ; ...and execute arg+fac2984 F8457A2985 ; fcadd - add the argument to one constant stored in program memory2986 ;2987 ; entry:2988 ; fac = x2989 ; fcp = long pointer to the constant K2990 ;2991 ; exit:2992 ; fac = K + x2993 ;2994 ; This routine is used internally and not intended for end use.2995 ; Constant are stored unpacked, and with full size 128 bits mantissa,2996 ; in program memory segment(the code segment that hold this routine).2997 ;2998 ;-----2999 F8457A fcadd:3000 ;-----3001 F8457A 20 D7 86 jsr ldarg2 ; move K to arg...3002 ; ...and execute arg + fac30033004 ; fpadd: add fac to arg and store result in fac3005 ; main addition routine3006 ;3007 ; entry:3008 ; arg = x3009 ; fac = y3010 ;3011 ; exit:3012 ; fac = x + y3013 ; CF = 1 if invalid result(inf or nan)3014 ;3015 ; The smallest operand will be aligned shifting to right the mantissa and3016 ; incrementing the exponent until is equal to exponent of the greatest3017 ; operand. After alignment, mantissa of fac is added to mantissa of arg if3018 ; fac and arg have same sign, otherwise mantissa of the smallest operand will3019 ; be subctracted from mantissa of the greatest one (except in the case that3020 ; none of the operands has been shifted: in this case maybe need to change3021 ; sign to result).3022 ;3023 ;-----3024 F8457D fpadd:3025 ;-----3026 F8457D 20 41 48 jsr addtst ; operands test: check for inf,nan, 03027 F84580 A2 2A ldx #argm ; pointer to arg mantissa3028 F84582 A0 00 ldy #03029 F84584 ACC163030 F84584 C2 20 rep #PMFLAG3031 .LONGA on3032 .MNLISTTue Jul 17 11:00:18 2018 Page 73033 F84586 38 sec3034 F84587 A5 3A lda argexp ; now compute right shift count's to...3035 F84589 E5 22 sbc facexp ; ...align mantissa's3036 F8458B F0 2F beq ?go ; already aligned (same exponent)3037 F8458D 90 0F bcc ?sh ; arg < fac so shift right arg mantissa...3038 ; ...and result have same exp&sign of fac...3039 F8458F3040 ; fac > arg so shift right fac mantissa - here CF=1, Y=03041 F8458F 85 3E sta wftmp ; positive shift's count3042 F84591 A5 3A lda argexp ; result have same exp of arg...3043 F84593 85 22 sta facexp3044 F84595 A6 3C ldx argsgn ; ...and same sign of arg3045 F84597 86 24 stx facsgn3046 F84599 98 tya ; remember here CF=13047 F8459A E5 3E sbc wftmp ; negative shift's count3048 F8459C A2 12 ldx #facm ; pointer to fac mantissa30493050 ?sh: ; right shift mantissa pointed by X - here C=negative shift's count3051 F8459E C9 81 FF cmp #MAXBSHIFT ; shift out whole significand?3052 F845A1 B0 12 bcs ?shm ; no3053 F845A3 74 00 stz <0,x ; clear mantissa whole mantissa3054 F845A5 74 02 stz <2,x3055 F845A7 74 04 stz <4,x3056 F845A9 74 06 stz <6,x3057 F845AB 74 08 stz <8,x3058 F845AD 74 0A stz <10,x3059 F845AF 74 0C stz <12,x3060 F845B1 74 0E stz <14,x3061 F845B3 80 07 bra ?go ; go to add/sub3062 F845B53063 F845B5 ?shm: ACC08 ; A=negative shift's count3064 F845B5 E2 20 sep #PMFLAG3065 .LONGA off3066 .MNLIST3067 F845B7 20 3A 47 jsr shrmx ; shift right mantissa pointed by X3068 F845BA ACC163069 F845BA C2 20 rep #PMFLAG3070 .LONGA on3071 .MNLIST30723073 ; add/sub aligned mantissa's3074 F845BC A4 11 ?go: ldy sgncmp ; fac & arg have same sign?3075 F845BE 10 4A bpl ?add ; yes, so add mantissa's30763077 ; X=mantissa pointer (pssibly to the shifted operand)3078 ; always subtract the smallest operand from the greatest one,3079 ; except in the case that none of the operands has been shifted30803081 F845C0 A0 12 ldy #facm3082 F845C2 E0 2A cpx #argm3083 F845C4 F0 02 beq ?sub ; mantissa_fac - mantissa_arg3084 F845C6 A0 2A ldy #argm ; mantissa_arg - mantissa_fac3085 F845C8 38 ?sub: sec3086 F845C9 B9 00 3F lda P0FPU,y3087 F845CC F5 00 sbc <0,x3088 F845CE 85 12 sta facm3089 F845D0 B9 02 3F lda P0FPU+2,yTue Jul 17 11:00:18 2018 Page 83090 F845D3 F5 02 sbc <2,x3091 F845D5 85 14 sta facm+23092 F845D7 B9 04 3F lda P0FPU+4,y3093 F845DA F5 04 sbc <4,x3094 F845DC 85 16 sta facm+43095 F845DE B9 06 3F lda P0FPU+6,y3096 F845E1 F5 06 sbc <6,x3097 F845E3 85 18 sta facm+63098 F845E5 B9 08 3F lda P0FPU+8,y3099 F845E8 F5 08 sbc <8,x3100 F845EA 85 1A sta facm+83101 F845EC B9 0A 3F lda P0FPU+10,y3102 F845EF F5 0A sbc <10,x3103 F845F1 85 1C sta facm+103104 F845F3 B9 0C 3F lda P0FPU+12,y3105 F845F6 F5 0C sbc <12,x3106 F845F8 85 1E sta facm+123107 F845FA B9 0E 3F lda P0FPU+14,y3108 F845FD F5 0E sbc <14,x3109 F845FF 85 20 sta facm+143110 F84601 ACC083111 F84601 E2 20 sep #PMFLAG3112 .LONGA off3113 .MNLIST3114 F84603 B0 5D bcs normfac ; no borrow -- normalize fac3115 F846053116 ; a borrow mean that result change sign so we should negate mantissa3117 ; this can happen just when operands have same exponent31183119 F84605 20 04 47 jsr negfac ; negate fac because result change sign3120 F84608 80 58 bra normfac ; normalize fac3121 F8460A3122 F8460A ?add: ACC16CLC ; add fac & arg mantissa's3123 F8460A C2 21 rep #(PMFLAG.OR.PCFLAG)3124 .LONGA on3125 .MNLIST3126 F8460C A5 12 lda facm3127 F8460E 65 2A adc argm3128 F84610 85 12 sta facm3129 F84612 A5 14 lda facm+23130 F84614 65 2C adc argm+23131 F84616 85 14 sta facm+23132 F84618 A5 16 lda facm+43133 F8461A 65 2E adc argm+43134 F8461C 85 16 sta facm+43135 F8461E A5 18 lda facm+63136 F84620 65 30 adc argm+63137 F84622 85 18 sta facm+63138 F84624 A5 1A lda facm+83139 F84626 65 32 adc argm+83140 F84628 85 1A sta facm+83141 F8462A A5 1C lda facm+103142 F8462C 65 34 adc argm+103143 F8462E 85 1C sta facm+103144 F84630 A5 1E lda facm+123145 F84632 65 36 adc argm+123146 F84634 85 1E sta facm+12Tue Jul 17 11:00:18 2018 Page 93147 F84636 A5 20 lda facm+143148 F84638 65 38 adc argm+143149 F8463A 85 20 sta facm+143150 F8463C 90 24 bcc normfac ; normalize fac after addition3151 F8463E3152 ; the sum generate a carry so we add carry to fac31533154 ; addcf - add a carry to fac3155 ;3156 ; fac exponent will be incrementated and mantissa will be shifted3157 ; one place to right, and '1' is routed to the mantissa msb.3158 ; Note that this operation can cause overflow3159 ;3160 ; This routine is used internally and not intended for end use.3161 ;3162 ;-----3163 F8463E addcf:3164 ;-----3165 F8463E ACC163166 F8463E C2 20 rep #PMFLAG3167 .LONGA on3168 .MNLIST3169 F84640 A5 22 lda facexp3170 F84642 1A inc a ; increment exponent3171 F84643 C9 FF 7F cmp #INFEXP ; overflow?3172 F84646 90 03 bcc ?10 ; no3173 F84648 4C 7D 4E jmp fldinf ; yes, so set fac=inf3174 F8464B 85 22 ?10: sta facexp3175 F8464D 38 sec ; msb=13176 F8464E 66 20 ror facm+14 ; shift right mantissa one place3177 F84650 66 1E ror facm+123178 F84652 66 1C ror facm+103179 F84654 66 1A ror facm+83180 F84656 66 18 ror facm+63181 F84658 66 16 ror facm+43182 F8465A 66 14 ror facm+23183 F8465C 66 12 ror facm3184 F8465E ACC083185 F8465E E2 20 sep #PMFLAG3186 .LONGA off3187 .MNLIST3188 F84660 18 clc ; return no error condition3189 F84661 60 rts31903191 ; normfac - try to normalize fac after addition/subtraction or3192 ; while convert an integer to floting point3193 ;3194 ; The msb of mantissa will be '1', except in the case of subnormal.3195 ; This normalitation is accomplished by shifting toward left3196 ; the significand until msb=1 or biased exponent=1; at any shift3197 ; biased exponent is decremented.3198 ;3199 ; This routine is used internally and not intended for end use.3200 ;3201 ;-------3202 F84662 normfac:3203 ;-------Tue Jul 17 11:00:18 2018 Page 103204 F84662 ACC163205 F84662 C2 20 rep #PMFLAG3206 .LONGA on3207 .MNLIST3208 F84664 A5 22 lda facexp3209 F84666 3A dec a ; exp=exp-13210 F84667 F0 7D beq chkz ; fac have minimum biased exponent (1)3211 F84669 38 sec3212 F8466A A0 10 ldy #MANTSIZ3213 F8466C A6 21 ?lp: ldx facm+153214 F8466E 30 69 bmi ?end ; already normalized: nothing to do3215 F84670 D0 53 bne ?shb ; shift bit at bit3216 F84672 E9 08 00 sbc #8 ; can shift a whole byte?3217 F84675 90 47 bcc ?rst ; no, restore exponent3218 F84677 A6 20 ldx facm+14 ; shift toward left byte at byte3219 F84679 86 21 stx facm+153220 F8467B A6 1F ldx facm+133221 F8467D 86 20 stx facm+143222 F8467F A6 1E ldx facm+123223 F84681 86 1F stx facm+133224 F84683 A6 1D ldx facm+113225 F84685 86 1E stx facm+123226 F84687 A6 1C ldx facm+103227 F84689 86 1D stx facm+113228 F8468B A6 1B ldx facm+93229 F8468D 86 1C stx facm+103230 F8468F A6 1A ldx facm+83231 F84691 86 1B stx facm+93232 F84693 A6 19 ldx facm+73233 F84695 86 1A stx facm+83234 F84697 A6 18 ldx facm+63235 F84699 86 19 stx facm+73236 F8469B A6 17 ldx facm+53237 F8469D 86 18 stx facm+63238 F8469F A6 16 ldx facm+43239 F846A1 86 17 stx facm+53240 F846A3 A6 15 ldx facm+33241 F846A5 86 16 stx facm+43242 F846A7 A6 14 ldx facm+23243 F846A9 86 15 stx facm+33244 F846AB A6 13 ldx facm+13245 F846AD 86 14 stx facm+23246 F846AF A6 12 ldx facm3247 F846B1 86 13 stx facm+13248 F846B3 A2 00 ldx #0 ; in last byte enter a zero...3249 F846B5 86 12 stx facm3250 F846B7 88 dey ; loop until all bytes was shifted3251 F846B8 D0 B2 bne ?lp3252 F846BA 64 22 stz facexp ; at this point fac=0...3253 F846BC 80 3E bra chkz2 ; ...and set status byte3254 F846BE 69 08 00 ?rst: adc #8 ; restore exponent...3255 F846C1 1A inc a3256 F846C2 3A ?cnt: dec a ; decrement exponent while bit shifting...3257 F846C3 F0 14 beq ?end ; can't shift more (exponent=1)3258 F846C5 06 12 ?shb: asl facm ; shift toward left one bit at time3259 F846C7 26 14 rol facm+23260 F846C9 26 16 rol facm+4Tue Jul 17 11:00:18 2018 Page 113261 F846CB 26 18 rol facm+63262 F846CD 26 1A rol facm+83263 F846CF 26 1C rol facm+103264 F846D1 26 1E rol facm+123265 F846D3 26 20 rol facm+143266 F846D5 10 EB bpl ?cnt ; shift until msb=03267 F846D7 30 01 bmi ?end2 ; finish3268 F846D9 1A ?end: inc a ; restore exponent...3269 F846DA 85 22 ?end2: sta facexp ; ...and set fac exponent3270 F846DC C9 FF 7F cmp #INFEXP ; check overflow condition3271 F846DF 90 05 bcc chkz ; no overflow: chexck if fac=03272 F846E1 ACC083273 F846E1 E2 20 sep #PMFLAG3274 .LONGA off3275 .MNLIST3276 F846E3 4C 7D 4E jmp fldinf ; set fac=inf32773278 ; chkz - check if fac=0; if fac=0 set the status byte3279 ;3280 ; This routine is used internally and not intended for end use.3281 ;3282 ;----3283 F846E6 chkz:3284 ;----3285 F846E6 ACC16 ; if all significand bits are '0'...3286 F846E6 C2 20 rep #PMFLAG3287 .LONGA on3288 .MNLIST3289 F846E8 A5 12 lda facm ; ...then fac=03290 F846EA 05 14 ora facm+23291 F846EC 05 16 ora facm+43292 F846EE 05 18 ora facm+63293 F846F0 05 1A ora facm+83294 F846F2 05 1C ora facm+103295 F846F4 05 1E ora facm+123296 F846F6 05 20 ora facm+143297 F846F8 D0 06 bne chkz33298 F846FA 85 22 sta facexp ; set biased exponent = 03299 F846FC A2 40 chkz2: ldx #$40 ; set status byte for 'zero' condition3300 F846FE 86 25 stx facst3301 F84700 chkz3: ACC083302 F84700 E2 20 sep #PMFLAG3303 .LONGA off3304 .MNLIST3305 F84702 18 clc3306 F84703 60 rts33073308 ; negfac - negate fac (2's complement)3309 ;3310 ; this routine will be called after a subtraction3311 ; that change the sign of the result3312 ;3313 ; This routine is used internally and not intended for end use.3314 ;3315 ;------3316 F84704 negfac:3317 ;------Tue Jul 17 11:00:18 2018 Page 123318 F84704 A5 24 lda facsgn ; change fac sign3319 F84706 49 FF eor #$FF3320 F84708 85 24 sta facsgn3321 F8470A A2 00 ldx #03322 F8470C CPU16 ; two's complement3323 F8470C C2 30 rep #(PMFLAG.OR.PXFLAG)3324 .LONGA on3325 .LONGI on3326 .MNLIST3327 F8470E 38 sec3328 F8470F 8A txa3329 F84710 E5 12 sbc facm3330 F84712 85 12 sta facm3331 F84714 8A txa3332 F84715 E5 14 sbc facm+23333 F84717 85 14 sta facm+23334 F84719 8A txa3335 F8471A E5 16 sbc facm+43336 F8471C 85 16 sta facm+43337 F8471E 8A txa3338 F8471F E5 18 sbc facm+63339 F84721 85 18 sta facm+63340 F84723 8A txa3341 F84724 E5 1A sbc facm+83342 F84726 85 1A sta facm+83343 F84728 8A txa3344 F84729 E5 1C sbc facm+103345 F8472B 85 1C sta facm+103346 F8472D 8A txa3347 F8472E E5 1E sbc facm+123348 F84730 85 1E sta facm+123349 F84732 8A txa3350 F84733 E5 20 sbc facm+143351 F84735 85 20 sta facm+143352 F84737 CPU083353 F84737 E2 30 sep #(PMFLAG.OR.PXFLAG)3354 .LONGA off3355 .LONGI off3356 .MNLIST3357 F84739 60 rts33583359 ; shrmx - shift mantissa pointed by X toward right3360 ;3361 ; entry: A=negative shift's count (max. 128 bit)3362 ; X=mantissa pointer3363 ;3364 ; exit:3365 ; mantissa is shifted toward right and 0 will be routed to msb3366 ;3367 ; This routine is used internally and not intended for end use.3368 ;3369 ;-----3370 F8473A shrmx:3371 ;-----3372 F8473A C9 F9 cmp #$F9 ; NF=1,CF=0 if $79<=A<$F9 else NF=0,CF=13373 F8473C 10 76 bpl ?shb ; shift right less than 8 bit (CF=1)3374 F8473E 80 6A bra ?tst2 ; CF=0, shift at least 8 bit or moreTue Jul 17 11:00:18 2018 Page 133375 F84740 ?sh16: CPU16 ; shift right 16 bit at time3376 F84740 C2 30 rep #(PMFLAG.OR.PXFLAG)3377 .LONGA on3378 .LONGI on3379 .MNLIST3380 F84742 B4 02 ldy <2,x3381 F84744 94 00 sty <0,x3382 F84746 B4 04 ldy <4,x3383 F84748 94 02 sty <2,x3384 F8474A B4 06 ldy <6,x3385 F8474C 94 04 sty <4,x3386 F8474E B4 08 ldy <8,x3387 F84750 94 06 sty <6,x3388 F84752 B4 0A ldy <10,x3389 F84754 94 08 sty <8,x3390 F84756 B4 0C ldy <12,x3391 F84758 94 0A sty <10,x3392 F8475A B4 0E ldy <14,x3393 F8475C 94 0C sty <12,x3394 F8475E 74 0E stz <14,x3395 F84760 CPU083396 F84760 E2 30 sep #(PMFLAG.OR.PXFLAG)3397 .LONGA off3398 .LONGI off3399 .MNLIST3400 F84762 80 46 bra ?tst2 ; continue3401 F84764 69 08 ?tst1: adc #8 ; check if can shift 16 bit at time3402 F84766 30 D8 bmi ?sh16 ; yes (here CF=0)3403 F84768 F0 D6 beq ?sh16 ; yes (here CF=1)3404 F8476A E9 08 sbc #8 ; restore shift count and shift 8 bit at time3405 ; also note here result is negative and CF=03406 F8476C B4 01 ?sh8: ldy <1,x ; shift right 8 bit at time3407 F8476E 94 00 sty <0,x3408 F84770 B4 02 ldy <2,x3409 F84772 94 01 sty <1,x3410 F84774 B4 03 ldy <3,x3411 F84776 94 02 sty <2,x3412 F84778 B4 04 ldy <4,x3413 F8477A 94 03 sty <3,x3414 F8477C B4 05 ldy <5,x3415 F8477E 94 04 sty <4,x3416 F84780 B4 06 ldy <6,x3417 F84782 94 05 sty <5,x3418 F84784 B4 07 ldy <7,x3419 F84786 94 06 sty <6,x3420 F84788 B4 08 ldy <8,x3421 F8478A 94 07 sty <7,x3422 F8478C B4 09 ldy <9,x3423 F8478E 94 08 sty <8,x3424 F84790 B4 0A ldy <10,x3425 F84792 94 09 sty <9,x3426 F84794 B4 0B ldy <11,x3427 F84796 94 0A sty <10,x3428 F84798 B4 0C ldy <12,x3429 F8479A 94 0B sty <11,x3430 F8479C B4 0D ldy <13,x3431 F8479E 94 0C sty <12,xTue Jul 17 11:00:18 2018 Page 143432 F847A0 B4 0E ldy <14,x3433 F847A2 94 0D sty <13,x3434 F847A4 B4 0F ldy <15,x3435 F847A6 94 0E sty <14,x3436 F847A8 74 0F stz <15,x3437 F847AA 69 08 ?tst2: adc #8 ; test if can shift 8/16 bit at time3438 F847AC 30 B6 bmi ?tst1 ; test if can shift 16 bit at time (CF=0)3439 F847AE F0 BC beq ?sh8 ; shift 8 bit (here CF=1)3440 F847B0 E9 08 sbc #8 ; restore shift count3441 F847B2 B0 1D bcs ?end ; finish if shift count >= 03442 F847B4 A8 ?shb: tay ; residual bit shift count3443 F847B5 F0 1A beq ?end ; nothing to shift3444 F847B7 ACC163445 F847B7 C2 20 rep #PMFLAG3446 .LONGA on3447 .MNLIST3448 F847B9 B5 00 lda <0,x ; lsb+guard bits3449 F847BB 56 0E ?sh: lsr <14,x ; msb=03450 F847BD 76 0C ror <12,x3451 F847BF 76 0A ror <10,x3452 F847C1 76 08 ror <8,x3453 F847C3 76 06 ror <6,x3454 F847C5 76 04 ror <4,x3455 F847C7 76 02 ror <2,x3456 F847C9 6A ror a ; rotate lsb3457 F847CA C8 iny3458 F847CB D0 EE bne ?sh3459 F847CD 95 00 sta <0,x ; store lsb+guards bits3460 F847CF ACC083461 F847CF E2 20 sep #PMFLAG3462 .LONGA off3463 .MNLIST3464 F847D1 60 ?end: rts34653466 ; shlmx - shift mantissa pointed by X to left until msb of mantissa equal 13467 ; and decrement unbiased exponent according with shift's count.3468 ;3469 ; this routine is called for 'normalize' a subnormal operand3470 ;3471 ; call with A/M in 16 bit mode3472 ;3473 ; This routine is used internally and not intended for end use.3474 ;3475 ;-----3476 F847D2 shlmx:3477 ;-----3478 .LONGA on ; should be called with A/M=16 bit3479 .LONGI off34803481 F847D2 38 sec3482 F847D3 B5 10 lda <16,x ; C=unbiased exponent3483 F847D5 B4 0F ?lp1: ldy <15,x ; shift count < 8?3484 F847D7 D0 5D bne ?sh ; yes3485 F847D9 E9 08 00 sbc #8 ; 8 bits shift3486 F847DC B4 0E ldy <14,x ; shift toward left byte at byte3487 F847DE 94 0F sty <15,x3488 F847E0 B4 0D ldy <13,xTue Jul 17 11:00:18 2018 Page 153489 F847E2 94 0E sty <14,x3490 F847E4 B4 0C ldy <12,x3491 F847E6 94 0D sty <13,x3492 F847E8 B4 0B ldy <11,x3493 F847EA 94 0C sty <12,x3494 F847EC B4 0A ldy <10,x3495 F847EE 94 0B sty <11,x3496 F847F0 B4 09 ldy <9,x3497 F847F2 94 0A sty <10,x3498 F847F4 B4 08 ldy <8,x3499 F847F6 94 09 sty <9,x3500 F847F8 B4 07 ldy <7,x3501 F847FA 94 08 sty <8,x3502 F847FC B4 06 ldy <6,x3503 F847FE 94 07 sty <7,x3504 F84800 B4 05 ldy <5,x3505 F84802 94 06 sty <6,x3506 F84804 B4 04 ldy <4,x3507 F84806 94 05 sty <5,x3508 F84808 B4 03 ldy <3,x3509 F8480A 94 04 sty <4,x3510 F8480C B4 02 ldy <2,x3511 F8480E 94 03 sty <3,x3512 F84810 B4 01 ldy <1,x3513 F84812 94 02 sty <2,x3514 F84814 B4 00 ldy <0,x3515 F84816 94 01 sty <1,x3516 F84818 A0 00 ldy #03517 F8481A 94 00 sty <0,x3518 F8481C C9 81 FF cmp #MAXBSHIFT ; shifted all whole mantissa?3519 F8481F F0 17 beq ?done ; yes, store exponent3520 F84821 B0 B2 bcs ?lp1 ; no, try again3521 F84823 80 13 bra ?done ; store exponent3522 F84825 3A ?lp2: dec a ; decrement exponent3523 F84826 16 00 asl <0,x3524 F84828 36 02 rol <2,x3525 F8482A 36 04 rol <4,x3526 F8482C 36 06 rol <6,x3527 F8482E 36 08 rol <8,x3528 F84830 36 0A rol <10,x3529 F84832 36 0C rol <12,x3530 F84834 36 0E rol <14,x3531 F84836 10 ED ?sh: bpl ?lp2 ; if msb=0 shift to left one place3532 F84838 95 10 ?done: sta <16,x ; store exponent3533 F8483A 34 10 bit <16,x ; check exponent sign3534 F8483C 10 02 bpl ?end3535 F8483E D6 14 dec <20,x ; sign extension to 32 bit3536 F84840 60 ?end: rts35373538 .LONGA off35393540 ; addtst - test operands before to execute addition/subtraction3541 ;3542 ; This routine test fac & arg for validity, and return to the caller3543 ; for any abnormal condition:3544 ;3545 ; 1) return nan if fac=nan or arg=nanTue Jul 17 11:00:18 2018 Page 163546 ; 2) return nan if |fac|=|arg|=inf and arg&fac have opposites sign3547 ; 3) return +inf or -inf if fac=arg=+/-inf3548 ; 4) return +inf or -inf if fac=+/-inf and arg is valid3549 ; 5) return +inf or -inf if arg=+/-inf and fac is valid3550 ;3551 ; This routine is used internally and not intended for end use.3552 ;3553 ;------3554 F84841 addtst:3555 ;------3556 F84841 A5 24 lda facsgn ; compare sign3557 F84843 45 3C eor argsgn3558 F84845 85 11 sta sgncmp3559 F84847 38 sec ; invalid result flag3560 F84848 24 25 bit facst ; test fac3561 F8484A 10 11 bpl ?arg ; fac is valid, go to check arg3562 F8484C 50 1D bvc ?skp ; fac=nan so result=nan (fac sign)3563 F8484E 24 3D bit argst ; fac=inf so check arg3564 F84850 10 19 bpl ?skp ; fac=inf & arg=y so result=inf (fac sign)3565 F84852 50 14 bvc ?mv ; fac=inf & arg=nan so result=nan (arg sign)3566 F84854 24 11 bit sgncmp ; fac=inf & arg=inf so check sign comparison3567 F84856 10 13 bpl ?skp ; same sign so result=inf (fac sign)3568 F84858 20 74 4E jsr fldnan ; mismatch signs so result=nan (fac sign)3569 F8485B 80 0E bra ?skp ; skip resturn & exit with CF=13570 F8485D 24 3D ?arg: bit argst ; fac is valid, so now check arg3571 F8485F 30 07 bmi ?mv ; arg=inf/nan so result=inf/nan (arg sign)3572 F84861 18 clc ; now result is valid3573 F84862 70 07 bvs ?skp ; arg=0 so result=fac3574 F84864 24 25 bit facst ; fac=0?3575 F84866 50 05 bvc ?end ; no, return to add/sub operation3576 F84868 20 0C 84 ?mv: jsr mvatof ; move arg to fac (preserve CF)3577 F8486B 68 ?skp: pla ; skip return address3578 F8486C 68 pla3579 F8486D 60 ?end: rts35803581 ;---------------------------------------------------------------------------3582 ; multiplication & division implementation - scaling routines3583 ;---------------------------------------------------------------------------35843585 ; frexp - extracts the exponent from x. It returns an integer3586 ; power of two to scexp and the significand between 0.5 and 1 to fac3587 ;3588 ; entry:3589 ; fac = x (valid float)3590 ;3591 ; exit:3592 ; fac = y (0.5 <= y < 1)3593 ; scexp = N, exponent (signed integer)3594 ; scsgn = sign of N3595 ; dexp = |N| (absolute value of N)3596 ;3597 ; note that:3598 ; N3599 ; x = y * 23600 ;3601 ;-----3602 F8486E frexp:Tue Jul 17 11:00:18 2018 Page 173603 ;-----3604 F8486E 38 sec3605 F8486F 24 25 bit facst3606 F84871 30 43 bmi ?end ; invalid fac3607 F84873 ACC163608 F84873 C2 20 rep #PMFLAG3609 .LONGA on3610 .MNLIST3611 F84875 64 46 stz scexp3612 F84877 64 48 stz dexp3613 F84879 64 3E stz wftmp3614 F8487B A2 00 ldx #0 ; assume positive sign3615 F8487D A5 22 lda facexp3616 F8487F F0 30 beq ?s ; fac=0 so return exponent=03617 F84881 3A dec a ; subnormal?3618 F84882 D0 14 bne ?fn ; no3619 F84884 A6 21 ldx facm+153620 F84886 30 10 bmi ?fn ; fac is norml3621 F84888 85 22 sta facexp ; clear to get negative exponent of subnormal3622 F8488A A2 12 ldx #facm3623 F8488C 20 D2 47 jsr shlmx ; normalize subnormal fac3624 F8488F A5 22 lda facexp3625 F84891 85 3E sta wftmp ; negative exponent of subnormal3626 F84893 A9 01 00 lda #1 ; restore biased exponent3627 F84896 85 22 sta facexp3628 F84898 38 ?fn: sec ; scale a normal f.p.3629 F84899 A5 22 lda facexp3630 F8489B E9 FE 3F sbc #EBIAS-1 ; new biased exponent3631 F8489E 18 clc3632 F8489F 65 3E adc wftmp ; any subnormal negative exponent3633 F848A1 85 46 sta scexp3634 F848A3 10 05 bpl ?p3635 F848A5 CA dex3636 F848A6 49 FF FF eor #$FFFF3637 F848A9 1A inc a ; return absolute value too3638 F848AA 85 48 ?p: sta dexp3639 F848AC A9 FE 3F lda #EBIAS-13640 F848AF 85 22 sta facexp ; now 0.5 <= fac < 13641 F848B1 86 45 ?s: stx scsgn ; exponent sign3642 F848B3 ACC083643 F848B3 E2 20 sep #PMFLAG3644 .LONGA off3645 .MNLIST3646 F848B5 18 clc3647 F848B6 60 ?end: rts36483649 ; fscale - multiplies argument by a power of two3650 ;3651 ; entry:3652 ; fac = x (valid float)3653 ; scexp = N (signed integer)3654 ;3655 ; exit:3656 ; N3657 ; fac = x * 23658 ; CF = 1 if invalid result(inf or nan)3659 ;Tue Jul 17 11:00:18 2018 Page 183660 ;------3661 F848B7 fscale:3662 ;------3663 F848B7 38 sec ; invalid fac flag3664 F848B8 24 25 bit facst3665 F848BA 30 48 bmi ?end2 ; fac is invalid3666 F848BC 70 45 bvs ?end1 ; fac=03667 F848BE ACC163668 F848BE C2 20 rep #PMFLAG3669 .LONGA on3670 .MNLIST3671 F848C0 A5 46 lda scexp3672 F848C2 F0 3D beq ?end ; scale factor = 03673 F848C4 A5 22 lda facexp3674 F848C6 3A dec a3675 F848C7 D0 41 bne ?fn ; fac is normal3676 F848C9 A6 21 ldx facm+153677 F848CB 30 3D bmi ?fn ; fac is normal3678 F848CD A5 46 lda scexp3679 F848CF 10 18 bpl ?ps ; positive scaling of subnormal3680 F848D1 30 07 bmi ?ns ; negative scaling of subnormal3681 F848D3 A5 22 ?sn: lda facexp3682 F848D5 64 22 ?sn2: stz facexp ; set biased exponent=13683 F848D7 E6 22 inc facexp3684 F848D9 3A dec a ; count of right shift3685 F848DA C9 81 FF ?ns: cmp #MAXBSHIFT3686 F848DD 90 26 bcc ?z ; return fac=03687 F848DF ACC083688 F848DF E2 20 sep #PMFLAG3689 .LONGA off3690 .MNLIST3691 F848E1 A2 12 ldx #facm ; shift right3692 F848E3 20 3A 47 jsr shrmx3693 F848E6 4C E6 46 jmp chkz ; underflow test3694 .LONGA on3695 F848E9 A6 21 ?ps: ldx facm+15 ; shift subnormal toward left3696 F848EB 30 1D bmi ?fn3697 F848ED 06 12 asl facm3698 F848EF 26 14 rol facm+23699 F848F1 26 16 rol facm+43700 F848F3 26 18 rol facm+63701 F848F5 26 1A rol facm+83702 F848F7 26 1C rol facm+103703 F848F9 26 1E rol facm+123704 F848FB 26 20 rol facm+143705 F848FD C6 46 dec scexp3706 F848FF D0 E8 bne ?ps3707 F84901 ?end: ACC08 ; return3708 F84901 E2 20 sep #PMFLAG3709 .LONGA off3710 .MNLIST3711 F84903 18 ?end1: clc3712 F84904 60 ?end2: rts3713 F84905 ?z: ACC08 ; return fac=03714 F84905 E2 20 sep #PMFLAG3715 .LONGA off3716 .MNLISTTue Jul 17 11:00:18 2018 Page 193717 F84907 4C 56 4E jmp fldz3718 .LONGA on3719 F8490A 64 3E ?fn: stz wftmp ; 32 bit exponent sign extension3720 F8490C A5 46 lda scexp3721 F8490E 10 02 bpl ?p3722 F84910 C6 3E dec wftmp ; scexp is negative3723 F84912 18 ?p: clc3724 F84913 A5 22 lda facexp3725 F84915 65 46 adc scexp3726 F84917 85 22 sta facexp3727 F84919 A9 00 00 lda #03728 F8491C 65 3E adc wftmp ; can be just negative or null3729 F8491E 30 B3 bmi ?sn ; handle subnormal result3730 F84920 A5 22 lda facexp3731 F84922 F0 B1 beq ?sn2 ; handle subnormal result3732 F84924 C9 FF 7F cmp #INFEXP ; overflow?3733 F84927 90 D8 bcc ?end ; no3734 F84929 ACC083735 F84929 E2 20 sep #PMFLAG3736 .LONGA off3737 .MNLIST3738 F8492B 4C 7D 4E jmp fldinf37393740 .LONGA off3741 F8492E3742 ; scale10 - multiplies argument by a power of ten3743 ;3744 ; entry:3745 ; fac = x (valid float)3746 ; C = N (signed integer)3747 ;3748 ; exit:3749 ; N3750 ; fac = x * 103751 ; CF = 1 if invalid result(inf or nan)3752 ;3753 ; A lookup table is used for values from 10 through 10^7,3754 ; then this is augmented by multiplying with table entries3755 ; for 10^8/16/32/64/128/256/512/1024/2048/4096 which allows3756 ; any power up. Negative powers are provided by a final division.3757 ;3758 ;-------3759 F8492E scale10:3760 ;-------3761 F8492E 38 sec3762 F8492F 24 25 bit facst ; valid fac?3763 F84931 30 48 bmi ?end2 ; no, exit3764 F84933 70 45 bvs ?end1 ; fac=0, exit3765 F84935 ACC163766 F84935 C2 20 rep #PMFLAG3767 .LONGA on3768 .MNLIST3769 F84937 C9 00 00 cmp #03770 F8493A F0 3C beq ?end ; scaling exponent=0 so exit3771 F8493C 85 46 sta scexp ; scaling exponent3772 F8493E A2 00 ldx #03773 F84940 A4 47 ldy scexp+1 ; test signTue Jul 17 11:00:18 2018 Page 203774 F84942 10 07 bpl ?pe ; positive exponent3775 F84944 8A txa ; change sign3776 F84945 CA dex3777 F84946 38 sec3778 F84947 E5 46 sbc scexp3779 F84949 85 46 sta scexp3780 F8494B 86 45 ?pe: stx scsgn ; store sign3781 F8494D C9 00 10 ?lp1: cmp #4096 ; loop for big scaling3782 F84950 ACC083783 F84950 E2 20 sep #PMFLAG3784 .LONGA off3785 .MNLIST3786 F84952 90 28 bcc ?sc ; scaling<40963787 F84954 A9 31 lda #<fce40963788 F84956 A0 60 ldy #>fce40963789 F84958 24 45 bit scsgn ; if negative svaling...3790 F8495A 30 07 bmi ?div ; ...divide...3791 F8495C 20 D5 49 jsr fcmult ; ...else multiplies by 40963792 F8495F B0 1A bcs ?end2 ; overflow, so exit3793 F84961 90 09 bcc ?cnt ; continue3794 F84963 20 0A 4A ?div: jsr fcrdiv ; divide by 40963795 F84966 B0 13 bcs ?end23796 F84968 24 25 bit facst ; if fac=0 exit3797 F8496A 70 0F bvs ?end23798 F8496C ?cnt: ACC16 ; update scaling factor...3799 F8496C C2 20 rep #PMFLAG3800 .LONGA on3801 .MNLIST3802 F8496E 38 sec3803 F8496F A5 46 lda scexp3804 F84971 E9 00 10 sbc #4096 ; ...subtracting 4096...3805 F84974 85 46 sta scexp3806 F84976 D0 D5 bne ?lp1 ;...and repeat3807 F84978 ?end: ACC083808 F84978 E2 20 sep #PMFLAG3809 .LONGA off3810 .MNLIST3811 F8497A 18 ?end1: clc3812 F8497B 60 ?end2: rts3813 F8497C 20 66 84 ?sc: jsr mvf_t0 ; save fac (tfr0=fac) in temp. reg.3814 F8497F A5 46 lda scexp ; now decomposes scexp in factor...3815 F84981 29 07 and #7 ; this for component from 1 to 1e73816 F84983 0A asl a3817 F84984 AA tax3818 F84985 BF 44 60 F8 lda >fcaddr+1,x3819 F84989 A8 tay3820 F8498A BF 43 60 F8 lda >fcaddr,x3821 F8498E 20 82 86 jsr ldfac ; load fac with a constant from 1.0 to 1.0e73822 F84991 CPU163823 F84991 C2 30 rep #(PMFLAG.OR.PXFLAG)3824 .LONGA on3825 .LONGI on3826 .MNLIST3827 F84993 A9 8F 5F lda #!fce8 ; now find the high order factor...3828 F84996 85 42 sta fcp ; ...from 1.0e8 to 1.0e20483829 F84998 A5 46 lda scexp3830 F8499A 4A lsr a ; divide by 8Tue Jul 17 11:00:18 2018 Page 213831 F8499B 4A lsr a3832 F8499C 4A lsr a3833 F8499D F0 22 beq ?done ; if = 0 we are done3834 F8499F 4A ?lp2: lsr a ; divide by 2 high order bits3835 F849A0 90 14 bcc ?nxt ; if even load next constant3836 F849A2 85 46 sta scexp ; save scale3837 F849A4 CPU083838 F849A4 E2 30 sep #(PMFLAG.OR.PXFLAG)3839 .LONGA off3840 .LONGI off3841 .MNLIST3842 F849A6 20 DA 49 jsr fcmult2 ; multiplies by constant3843 F849A9 90 07 bcc ?ok3844 F849AB 24 45 bit scsgn3845 F849AD 10 CC bpl ?end2 ; overflow: fac=inf3846 F849AF 4C 56 4E jmp fldz ; underflow: fac=03847 F849B2 ?ok: CPU163848 F849B2 C2 30 rep #(PMFLAG.OR.PXFLAG)3849 .LONGA on3850 .LONGI on3851 .MNLIST3852 F849B4 A5 46 lda scexp3853 F849B6 AA ?nxt: tax ; update pointer to next constant3854 F849B7 A5 42 lda fcp3855 F849B9 69 12 00 adc #FCSIZ3856 F849BC 85 42 sta fcp3857 F849BE 8A txa3858 F849BF D0 DE bne ?lp2 ; loop3859 F849C1 ?done: CPU083860 F849C1 E2 30 sep #(PMFLAG.OR.PXFLAG)3861 .LONGA off3862 .LONGI off3863 .MNLIST3864 F849C3 20 CE 85 jsr mvt0_a ; move temp. reg. tfr0 to arg3865 F849C6 24 45 bit scsgn3866 F849C8 30 46 bmi fpdiv ; if negative scaling we divide arg by fac3867 F849CA 80 11 bra fpmult ; if positive scaling we multiplies arg by fac38683869 ; fsquare - return the square of the argument3870 ;3871 ; entry:3872 ; fac = x3873 ;3874 ; exit: 23875 ; fac = x3876 ; CF = 1 if invalid result(inf or nan)3877 ;3878 ;-------3879 F849CC fsquare:3880 ;-------3881 F849CC 20 39 84 jsr mvftoa ; move fac to arg3882 F849CF 80 0C bra fpmult ; fac*fac38833884 ; mult10 - multiplies the argument with 10.03885 ;3886 ; entry:3887 ; fac = xTue Jul 17 11:00:18 2018 Page 223888 ;3889 ; exit:3890 ; fac = x * 103891 ;3892 ; This routine is used internally and not intended for end use.3893 ;3894 ;------3895 F849D1 mult10:3896 ;------3897 F849D1 A9 11 lda #<fce1 ; address of constant = 10.03898 F849D3 A0 5F ldy #>fce138993900 ; fcmult - multiplies the argument with one constant stored in program memory3901 ;3902 ; entry:3903 ; fac = x3904 ; A = low address of constant K3905 ; Y = high address of constant K3906 ;3907 ; exit:3908 ; fac = K * x3909 ;3910 ; This routine is used internally and not intended for end use.3911 ; Constant are stored unpacked, and with full size 128 bits mantissa,3912 ; in program memory segment(the code segment that hold this routine).3913 ;3914 ;------3915 F849D5 fcmult:3916 ;------3917 F849D5 20 CF 86 jsr ldarg ; load arg with constant K3918 F849D8 80 03 bra fpmult ; execute multiplication39193920 ; fcmult2 - multiplies the argument with one constant stored in program memory3921 ;3922 ; entry:3923 ; fac = x3924 ; fcp = long pointer to constant K3925 ;3926 ; exit:3927 ; fac = K * x3928 ;3929 ; This routine is used internally and not intended for end use.3930 ; Constant are stored unpacked, and with full size 128 bits mantissa,3931 ; in program memory segment(the code segment that hold this routine).3932 ;3933 ;-------3934 F849DA fcmult2:3935 ;-------3936 F849DA 20 D7 86 jsr ldarg2 ; load arg with constant K39373938 ; fpmult - multiplies operands stored in arg & fac3939 ; main multiplication routine3940 ;3941 ; entry:3942 ; arg = x3943 ; fac = y3944 ;Tue Jul 17 11:00:18 2018 Page 233945 ; exit:3946 ; fac = x * y3947 ; CF = 1 if invalid result(inf or nan)3948 ;3949 ;------3950 F849DD fpmult:3951 ;------3952 F849DD 20 AF 4C jsr multst ; operands test3953 F849E0 18 clc ; multiplication flag for addexp3954 F849E1 20 DA 4A jsr addexp ; add exponent's3955 F849E4 CPU16 ; clear the partial result3956 F849E4 C2 30 rep #(PMFLAG.OR.PXFLAG)3957 .LONGA on3958 .LONGI on3959 .MNLIST3960 F849E6 64 00 stz tm3961 F849E8 64 02 stz tm+23962 F849EA 64 04 stz tm+43963 F849EC 64 06 stz tm+63964 F849EE 64 08 stz tm+83965 F849F0 64 0A stz tm+103966 F849F2 64 0C stz tm+123967 F849F4 64 0E stz tm+143968 F849F6 20 44 4B jsr multm ; execute binary multiplication3969 F849F9 CPU083970 F849F9 E2 30 sep #(PMFLAG.OR.PXFLAG)3971 .LONGA off3972 .LONGI off3973 .MNLIST3974 F849FB 80 1D bra movres ; move result to fac & normalize39753976 ; frecip - returns the reciprocal of the argument3977 ;3978 ; entry:3979 ; fac = x3980 ;3981 ; exit:3982 ; fac = 1/x3983 ; CF = 1 if invalid result(inf or nan)3984 ;3985 ;------3986 F849FD frecip:3987 ;------3988 F849FD A9 FF lda #<fce0 ; load arg with constant 1.03989 F849FF A0 5E ldy #>fce039903991 ; fcdiv - divide one constant stored in program memory by the argument3992 ;3993 ; entry:3994 ; fac = x3995 ; A = low address of constant K3996 ; Y = high address of constant K3997 ;3998 ; exit:3999 ; fac = K / x4000 ;4001 ; This routine is used internally and not intended for end use.Tue Jul 17 11:00:18 2018 Page 244002 ; Constant are stored unpacked, and with full size 128 bits mantissa,4003 ; in program memory segment(the code segment that hold this routine).4004 ;4005 ;-----4006 F84A01 fcdiv:4007 ;-----4008 F84A01 20 CF 86 jsr ldarg ; move constant K to arg4009 F84A04 80 0A bra fpdiv ; execute arg/fac40104011 ; div10 - divide the argument by 10.04012 ;4013 ; entry:4014 ; fac = x4015 ; exit:4016 ; fac = x / 104017 ;4018 ; This routine is used internally and not intended for end use.4019 ;4020 ;-----4021 F84A06 div10:4022 ;-----4023 F84A06 A9 11 lda #<fce1 ; address of constant = 10.04024 F84A08 A0 5F ldy #>fce140254026 ; fcrdiv - divide the argument by one constant stored in program memory4027 ;4028 ; entry:4029 ; fac = x4030 ; A = low address of constant K4031 ; Y = high address of constant K4032 ;4033 ; exit:4034 ; fac = x / K4035 ;4036 ; This routine is used internally and not intended for end use.4037 ; Constant are stored unpacked, and with full size 128 bits mantissa,4038 ; in program memory segment(the code segment that hold this routine).4039 ;4040 ;------4041 F84A0A fcrdiv:4042 ;------4043 F84A0A 20 39 84 jsr mvftoa ; nove fac to arg4044 F84A0D 20 82 86 jsr ldfac ; move constant to fac40454046 ; fpdiv - divide the argument stored in arg by the argument stored in fac4047 ;4048 ; entry:4049 ; arg = x4050 ; fac = y4051 ;4052 ; exit:4053 ; fac = x / y4054 ; CF = 1 if invalid result(inf or nan)4055 ;4056 ;-----4057 F84A10 fpdiv:4058 ;-----Tue Jul 17 11:00:18 2018 Page 254059 F84A10 20 EB 4C jsr divtst ; operands test4060 F84A13 38 sec ; flag division for addexp4061 F84A14 20 DA 4A jsr addexp ; add operands exponent4062 F84A17 20 DF 4B jsr divm ; binary division4063 F84A1A4064 ; movres - move the result of multiplication/division to fac & normalize4065 ;4066 ; This routine is used internally and not intended for end use.4067 ;4068 ;------4069 F84A1A movres:4070 ;------4071 F84A1A ACC164072 F84A1A C2 20 rep #PMFLAG4073 .LONGA on4074 .MNLIST4075 F84A1C A5 00 lda tm ; move the result (16 bytes) to fac4076 F84A1E 85 12 sta facm4077 F84A20 A5 02 lda tm+24078 F84A22 85 14 sta facm+24079 F84A24 A5 04 lda tm+44080 F84A26 85 16 sta facm+44081 F84A28 A5 06 lda tm+64082 F84A2A 85 18 sta facm+64083 F84A2C A5 08 lda tm+84084 F84A2E 85 1A sta facm+84085 F84A30 A5 0A lda tm+104086 F84A32 85 1C sta facm+104087 F84A34 A5 0C lda tm+124088 F84A36 85 1E sta facm+124089 F84A38 A5 0E lda tm+144090 F84A3A 85 20 sta facm+144091 F84A3C ACC084092 F84A3C E2 20 sep #PMFLAG4093 .LONGA off4094 .MNLIST4095 F84A3E A5 26 lda fexph ; operation involved subnormal?4096 F84A40 F0 08 beq ?fn ; no4097 F84A42 A2 12 ldx #facm ; now should shift to right fac...4098 F84A44 20 3A 47 jsr shrmx ; ...because fac is subnormal4099 F84A47 4C E6 46 ?tz: jmp chkz ; underflow test; check if fac=04100 F84A4A ?fn: ACC16 ; normalize fac after mult/div4101 F84A4A C2 20 rep #PMFLAG4102 .LONGA on4103 .MNLIST4104 F84A4C A5 22 lda facexp4105 F84A4E C9 01 00 cmp #14106 F84A51 F0 F4 beq ?tz ; can't normalize: underflow test4107 F84A53 A6 21 ldx facm+15 ; check msb4108 F84A55 30 1A bmi ?done ; already normalized4109 F84A57 C9 01 00 ?sh: cmp #14110 F84A5A F0 15 beq ?done ; can't shift more4111 F84A5C 3A dec a ; decrement exponent at any shift4112 F84A5D 06 28 asl facext4113 F84A5F 26 12 rol facm4114 F84A61 26 14 rol facm+24115 F84A63 26 16 rol facm+4Tue Jul 17 11:00:18 2018 Page 264116 F84A65 26 18 rol facm+64117 F84A67 26 1A rol facm+84118 F84A69 26 1C rol facm+104119 F84A6B 26 1E rol facm+124120 F84A6D 26 20 rol facm+144121 F84A6F 10 E6 bpl ?sh ; shift until msb=14122 F84A71 85 22 ?done: sta facexp ; store exponent4123 F84A73 C9 FF 7F cmp #INFEXP ; check if overflow4124 F84A76 B0 32 bcs ovfw ; overflow4125 F84A78 A6 29 ldx facext+1 ; if msb=1 we round 128 bits mantissa4126 F84A7A 10 2A bpl ifx ; no rounding bit: done4127 F84A7C 20 AF 4A jsr chkovf ; we check exponent for a potential overflow4128 F84A7F B0 25 bcs ifx ; no round is possible (we avoid overflow)4129 F84A81 E6 12 inc facm ; inc. 15 guard bits and significand lsb4130 F84A83 D0 21 bne ifx41314132 ; incfac - increment the high order 96 bits of the fac significand4133 ; Called when round fac mantissa4134 ;4135 ; This routine is used internally and not intended for end use.4136 ;4137 ;------4138 F84A85 incfac:4139 ;------4140 F84A85 E6 14 inc facm+24141 F84A87 D0 1D bne ifx4142 F84A89 E6 16 inc facm+44143 F84A8B D0 19 bne ifx4144 F84A8D E6 18 inc facm+64145 F84A8F D0 15 bne ifx4146 F84A91 E6 1A inc facm+84147 F84A93 D0 11 bne ifx4148 F84A95 E6 1C inc facm+104149 F84A97 D0 0D bne ifx4150 F84A99 E6 1E inc facm+124151 F84A9B D0 09 bne ifx4152 F84A9D E6 20 inc facm+144153 F84A9F D0 05 bne ifx4154 F84AA1 CPU084155 F84AA1 E2 30 sep #(PMFLAG.OR.PXFLAG)4156 .LONGA off4157 .LONGI off4158 .MNLIST4159 F84AA3 4C 3E 46 jmp addcf ; add carry to significand, no overflow4160 F84AA6 ifx: CPU084161 F84AA6 E2 30 sep #(PMFLAG.OR.PXFLAG)4162 .LONGA off4163 .LONGI off4164 .MNLIST4165 F84AA8 18 clc4166 F84AA9 60 rts41674168 ; set fac=inf4169 ;----4170 F84AAA ovfw:4171 ;----4172 F84AAA CPU08 ; overflowTue Jul 17 11:00:18 2018 Page 274173 F84AAA E2 30 sep #(PMFLAG.OR.PXFLAG)4174 .LONGA off4175 .LONGI off4176 .MNLIST4177 F84AAC 4C 7D 4E jmp fldinf41784179 ; chkovf - check potential fac overflow due to a roundoff4180 ;4181 ; return CF=1 if a rounding can cause overflow4182 ;4183 ; This routine should be called with A/M = 16 bit4184 ;4185 ; This routine is used internally and not intended for end use.4186 ;4187 ;------4188 F84AAF chkovf:4189 ;------4190 .LONGA on41914192 F84AAF C9 FE 7F cmp #MAXEXP ; we check exponent for possible overflow4193 F84AB2 90 25 bcc ?end ; ok, no overflow after rounding4194 F84AB4 A9 FF FF lda #$FFFF ; check if mantissa is all one's4195 F84AB7 C5 12 cmp facm4196 F84AB9 D0 1A bne ?ok4197 F84ABB C5 14 cmp facm+24198 F84ABD D0 16 bne ?ok4199 F84ABF C5 16 cmp facm+44200 F84AC1 D0 12 bne ?ok4201 F84AC3 C5 18 cmp facm+64202 F84AC5 D0 0E bne ?ok4203 F84AC7 C5 1A cmp facm+84204 F84AC9 D0 0A bne ?ok4205 F84ACB C5 1C cmp facm+104206 F84ACD D0 06 bne ?ok4207 F84ACF C5 1E cmp facm+124208 F84AD1 D0 02 bne ?ok4209 F84AD3 C5 20 cmp facm+144210 F84AD5 18 ?ok: clc ; rounding is possible4211 F84AD6 D0 01 bne ?end4212 F84AD8 38 sec ; no rounding possible4213 F84AD9 60 ?end: rts4214 F84ADA4215 .LONGA off42164217 ; addexp - add exponent of fac & arg for multiplication/division4218 ;4219 ; entry:4220 ; arg = x4221 ; fac = y4222 ; CF = 1 if multiplication, else division4223 ;4224 ; exit:4225 ; facexp = exponent of the result (x*y or x/y)4226 ; fexph = negative exponent if result is subnormal,4227 ; otherwise =0 if result is normal4228 ;4229 ; This routine is used internally and not intended for end use.Tue Jul 17 11:00:18 2018 Page 284230 ;4231 ;------4232 F84ADA addexp:4233 ;------4234 F84ADA 08 php ; save carry4235 F84ADB ACC164236 F84ADB C2 20 rep #PMFLAG4237 .LONGA on4238 .MNLIST4239 F84ADD 64 26 stz fexph ; clear exponent sign extension4240 F84ADF 64 3E stz aexph4241 F84AE1 64 28 stz facext ; extension used while mult/div4242 F84AE3 A5 20 lda facm+144243 F84AE5 30 05 bmi ?a ; fac is norml4244 F84AE7 A2 12 ldx #facm4245 F84AE9 20 D2 47 jsr shlmx ; normalize subnormal fac4246 F84AEC A5 38 ?a: lda argm+144247 F84AEE 30 05 bmi ?b ; arg is norml4248 F84AF0 A2 2A ldx #argm4249 F84AF2 20 D2 47 jsr shlmx ; normalize subnormal arg4250 F84AF5 28 ?b: plp ; restore carry4251 F84AF6 CPU164252 F84AF6 C2 30 rep #(PMFLAG.OR.PXFLAG)4253 .LONGA on4254 .LONGI on4255 .MNLIST4256 F84AF8 A5 3A lda argexp4257 F84AFA B0 14 bcs ?div ; subtract exponent for division4258 F84AFC 65 22 adc facexp ; add exponent with sign extension4259 F84AFE AA tax4260 F84AFF A5 3E lda aexph4261 F84B01 65 26 adc fexph4262 F84B03 A8 tay4263 F84B04 38 sec4264 F84B05 8A txa4265 F84B06 E9 FE 3F sbc #EBIAS-1 ; adjust biased exponent for mult4266 F84B09 AA tax4267 F84B0A 98 tya4268 F84B0B E9 00 00 sbc #04269 F84B0E 80 12 bra ?tst ; check exponent4270 F84B10 E5 22 ?div: sbc facexp ; subtract exponent with sign extension4271 F84B12 AA tax4272 F84B13 A5 3E lda aexph4273 F84B15 E5 26 sbc fexph4274 F84B17 A8 tay4275 F84B18 18 clc4276 F84B19 8A txa4277 F84B1A 69 FF 3F adc #EBIAS ; adjust biased exponent4278 F84B1D AA tax4279 F84B1E 98 tya4280 F84B1F 69 00 00 adc #04281 F84B22 30 09 ?tst: bmi ?sn ; negative exponent so result is subnormal4282 F84B24 8A txa4283 F84B25 F0 06 beq ?sn ; null exponent so result is subnormal4284 F84B27 85 22 sta facexp ; exp >= 1 so result is normal4285 F84B29 64 26 stz fexph4286 F84B2B 80 0D bra ?doneTue Jul 17 11:00:18 2018 Page 294287 F84B2D CA ?sn: dex ; negative count of shift toward right4288 F84B2E E0 80 FF cpx #MAXBSHIFT-14289 F84B31 90 0A bcc ?z ; underflow: set fac=04290 F84B33 86 26 stx fexph ; negative count of shift4291 F84B35 A9 01 00 lda #14292 F84B38 85 22 sta facexp ; subnormasl have exponent=14293 F84B3A ?done: CPU084294 F84B3A E2 30 sep #(PMFLAG.OR.PXFLAG)4295 .LONGA off4296 .LONGI off4297 .MNLIST4298 F84B3C 60 rts4299 F84B3D ?z: CPU08 ; underflow: load zero into fac...4300 F84B3D E2 30 sep #(PMFLAG.OR.PXFLAG)4301 .LONGA off4302 .LONGI off4303 .MNLIST4304 F84B3F 68 pla ; ...and exit4305 F84B40 68 pla4306 F84B41 4C 56 4E jmp fldz43074308 ; multm - binary multiplication of the arg mantissa with fac mantissa4309 ;4310 ; classic binary multiplication "shift and add" method4311 ; only high order 144 bits of 256 are retained in result4312 ; Due the fact that facm and argm are normalized, the result is4313 ; always between 1.000000... and 2.ffffff....4314 ;4315 ; should be called with A/M=16 bits, X/Y=16 bits4316 ;4317 ; This routine is used internally and not intended for end use.4318 ;4319 ;-----4320 F84B44 multm:4321 ;-----4322 .LONGA on4323 .LONGI on43244325 F84B44 A5 12 lda facm ; multiply any word of facm with whole argm4326 F84B46 20 6B 4B jsr ?mlt4327 F84B49 A5 14 lda facm+24328 F84B4B 20 6B 4B jsr ?mlt4329 F84B4E A5 16 lda facm+44330 F84B50 20 6B 4B jsr ?mlt4331 F84B53 A5 18 lda facm+64332 F84B55 20 6B 4B jsr ?mlt4333 F84B58 A5 1A lda facm+84334 F84B5A 20 6B 4B jsr ?mlt4335 F84B5D A5 1C lda facm+104336 F84B5F 20 6B 4B jsr ?mlt4337 F84B62 A5 1E lda facm+124338 F84B64 20 6B 4B jsr ?mlt4339 F84B67 A5 20 lda facm+14 ; multiply msb that never is null4340 F84B69 80 02 bra ?mlt24341 F84B6B F0 4F ?mlt: beq ?shr ; if null shift right partial result (16 bit)4342 F84B6D 4A ?mlt2: lsr a ; multiplicator bit4343 F84B6E 09 00 80 ora #$8000 ; bit for stop iteration (16 cycles)Tue Jul 17 11:00:18 2018 Page 304344 F84B71 A8 ?lp: tay4345 F84B72 90 31 bcc ?sh ; multiplicator=0 so shift result to right4346 F84B74 18 clc4347 F84B75 A5 00 lda tm ; add multiplicand to partial result4348 F84B77 65 2A adc argm4349 F84B79 85 00 sta tm4350 F84B7B A5 02 lda tm+24351 F84B7D 65 2C adc argm+24352 F84B7F 85 02 sta tm+24353 F84B81 A5 04 lda tm+44354 F84B83 65 2E adc argm+44355 F84B85 85 04 sta tm+44356 F84B87 A5 06 lda tm+64357 F84B89 65 30 adc argm+64358 F84B8B 85 06 sta tm+64359 F84B8D A5 08 lda tm+84360 F84B8F 65 32 adc argm+84361 F84B91 85 08 sta tm+84362 F84B93 A5 0A lda tm+104363 F84B95 65 34 adc argm+104364 F84B97 85 0A sta tm+104365 F84B99 A5 0C lda tm+124366 F84B9B 65 36 adc argm+124367 F84B9D 85 0C sta tm+124368 F84B9F A5 0E lda tm+144369 F84BA1 65 38 adc argm+144370 F84BA3 85 0E sta tm+144371 F84BA5 66 0E ?sh: ror tm+14 ; shift any carry into partial result...4372 F84BA7 66 0C ror tm+12 ; ...and shift partial result toward right4373 F84BA9 66 0A ror tm+104374 F84BAB 66 08 ror tm+84375 F84BAD 66 06 ror tm+64376 F84BAF 66 04 ror tm+44377 F84BB1 66 02 ror tm+24378 F84BB3 66 00 ror tm4379 F84BB5 66 28 ror facext ; greater accuracy with this extension4380 F84BB7 98 tya4381 F84BB8 4A lsr a ; end of loop when null4382 F84BB9 D0 B6 bne ?lp4383 F84BBB 60 rts ; always return CF=14384 F84BBC4385 F84BBC A5 00 ?shr: lda tm ; shift partial result toward right...4386 F84BBE 85 28 sta facext ; ...16 bit at time4387 F84BC0 A5 02 lda tm+24388 F84BC2 85 00 sta tm4389 F84BC4 A5 04 lda tm+44390 F84BC6 85 02 sta tm+24391 F84BC8 A5 06 lda tm+64392 F84BCA 85 04 sta tm+44393 F84BCC A5 08 lda tm+84394 F84BCE 85 06 sta tm+64395 F84BD0 A5 0A lda tm+104396 F84BD2 85 08 sta tm+84397 F84BD4 A5 0C lda tm+124398 F84BD6 85 0A sta tm+104399 F84BD8 A5 0E lda tm+144400 F84BDA 85 0C sta tm+12Tue Jul 17 11:00:18 2018 Page 314401 F84BDC 64 0E stz tm+144402 F84BDE 60 rts4403 F84BDF4404 .LONGA off4405 .LONGI off44064407 ; divm - computes the division of the arg mantissa by fac mantissa4408 ;4409 ; Classic fixed point division, that use the recurrence equation:4410 ;4411 ; R = 2*R - D*Q4412 ; j+1 j n-(j+1)4413 ;4414 ; R = V , Q = 1 if V >= D4415 ; 0 n-14416 ;4417 ; where: V=dividend, D=divisor, R = partial remainder, Q is the k-th4418 ; j k4419 ;4420 ; bit of the quotient, starting from the msb: k=n-(j+1),4421 ; n=130 is the quotient size, j=1..n-1 is the loop index.4422 ; Only 130 bits of quotient are retained.4423 ;4424 ; Due the fact that facm and argm are normalized, the result is4425 ; always between 0.100000... and 1.ffffff....4426 ;4427 ; This routine is used internally and not intended for end use.4428 ;4429 ;----4430 F84BDF divm:4431 ;----4432 F84BDF A2 10 ldx #MANTSIZ ; loop for all bytes of mantissa4433 F84BE1 A9 01 lda #$01 ; 8 bits quotient -- quotient = 04434 F84BE3 20 50 4C ?lp1: jsr ?cmp ; compare argm vs. facm4435 F84BE6 08 ?lp2: php ; save carry (CF=1 if argm>=facm)4436 F84BE7 2A rol a ; shift in CF (quotient bit) into lsb4437 F84BE8 90 09 bcc ?sub ; bits loop...stop when CF=14438 F84BEA CA dex ; index of quotient array4439 F84BEB 30 59 bmi ?done ; end of division4440 F84BED 95 00 sta tm,x ; store this byte of quotient (start with msb)4441 F84BEF F0 51 beq ?lst ; last quotient is 2 bits only4442 F84BF1 A9 01 lda #$01 ; 8 bits quotient -- quotient = 04443 F84BF3 28 ?sub: plp ; restore CF from comparing argm vs. facm4444 F84BF4 ACC164445 F84BF4 C2 20 rep #PMFLAG4446 .LONGA on4447 .MNLIST4448 F84BF6 90 32 bcc ?sh ; quotient bit = 0: no subtraction4449 F84BF8 A8 tay ; save partial quotient: here CF=14450 F84BF9 A5 2A lda argm ; get the partial remainder...4451 F84BFB E5 12 sbc facm ; ...subtracting the divisor facm4452 F84BFD 85 2A sta argm4453 F84BFF A5 2C lda argm+24454 F84C01 E5 14 sbc facm+24455 F84C03 85 2C sta argm+24456 F84C05 A5 2E lda argm+44457 F84C07 E5 16 sbc facm+4Tue Jul 17 11:00:18 2018 Page 324458 F84C09 85 2E sta argm+44459 F84C0B A5 30 lda argm+64460 F84C0D E5 18 sbc facm+64461 F84C0F 85 30 sta argm+64462 F84C11 A5 32 lda argm+84463 F84C13 E5 1A sbc facm+84464 F84C15 85 32 sta argm+84465 F84C17 A5 34 lda argm+104466 F84C19 E5 1C sbc facm+104467 F84C1B 85 34 sta argm+104468 F84C1D A5 36 lda argm+124469 F84C1F E5 1E sbc facm+124470 F84C21 85 36 sta argm+124471 F84C23 A5 38 lda argm+144472 F84C25 E5 20 sbc facm+144473 F84C27 85 38 sta argm+144474 F84C29 98 tya ; restore partial quotient4475 F84C2A 06 2A ?sh: asl argm ; now shift argm to left (one place)4476 F84C2C 26 2C rol argm+24477 F84C2E 26 2E rol argm+44478 F84C30 26 30 rol argm+64479 F84C32 26 32 rol argm+84480 F84C34 26 34 rol argm+104481 F84C36 26 36 rol argm+124482 F84C38 26 38 rol argm+144483 F84C3A ACC084484 F84C3A E2 20 sep #PMFLAG4485 .LONGA off4486 .MNLIST4487 F84C3C B0 A8 bcs ?lp2 ; CF=1: quotient bit = 14488 F84C3E 30 A3 bmi ?lp1 ; CF=0, MSB=1: compare again argm vs. facm4489 F84C40 10 A4 bpl ?lp2 ; CF=0, MSB=0: quotient bit = 04490 F84C42 A9 40 ?lst: lda #$40 ; 2 last bits quotient for normalitation...4491 F84C44 80 AD bra ?sub ; ...and rounding4492 F84C46 28 ?done: plp ; end of division4493 F84C47 0A asl a ; last truncated quotient (00..03)...4494 F84C48 0A asl a ; ...shifted to bits 15&14 of facext...4495 F84C49 0A asl a ; ...to have greater accuracy...4496 F84C4A 0A asl a4497 F84C4B 0A asl a4498 F84C4C 0A asl a4499 F84C4D 85 29 sta facext+14500 F84C4F 60 rts45014502 F84C50 A4 39 ?cmp: ldy argm+15 ; comparation: arg mantissa vs. fac mantissa4503 F84C52 C4 21 cpy facm+154504 F84C54 D0 58 bne ?end4505 F84C56 A4 38 ldy argm+144506 F84C58 C4 20 cpy facm+144507 F84C5A D0 52 bne ?end4508 F84C5C A4 37 ldy argm+134509 F84C5E C4 1F cpy facm+134510 F84C60 D0 4C bne ?end4511 F84C62 A4 36 ldy argm+124512 F84C64 C4 1E cpy facm+124513 F84C66 D0 46 bne ?end4514 F84C68 A4 35 ldy argm+11Tue Jul 17 11:00:18 2018 Page 334515 F84C6A C4 1D cpy facm+114516 F84C6C D0 40 bne ?end4517 F84C6E A4 34 ldy argm+104518 F84C70 C4 1C cpy facm+104519 F84C72 D0 3A bne ?end4520 F84C74 A4 33 ldy argm+94521 F84C76 C4 1B cpy facm+94522 F84C78 D0 34 bne ?end4523 F84C7A A4 32 ldy argm+84524 F84C7C C4 1A cpy facm+84525 F84C7E D0 2E bne ?end4526 F84C80 A4 31 ldy argm+74527 F84C82 C4 19 cpy facm+74528 F84C84 D0 28 bne ?end4529 F84C86 A4 30 ldy argm+64530 F84C88 C4 18 cpy facm+64531 F84C8A D0 22 bne ?end4532 F84C8C A4 2F ldy argm+54533 F84C8E C4 17 cpy facm+54534 F84C90 D0 1C bne ?end4535 F84C92 A4 2E ldy argm+44536 F84C94 C4 16 cpy facm+44537 F84C96 D0 16 bne ?end4538 F84C98 A4 2D ldy argm+34539 F84C9A C4 15 cpy facm+34540 F84C9C D0 10 bne ?end4541 F84C9E A4 2C ldy argm+24542 F84CA0 C4 14 cpy facm+24543 F84CA2 D0 0A bne ?end4544 F84CA4 A4 2B ldy argm+14545 F84CA6 C4 13 cpy facm+14546 F84CA8 D0 04 bne ?end4547 F84CAA A4 2A ldy argm4548 F84CAC C4 12 cpy facm4549 F84CAE 60 ?end: rts45504551 ; multst - test operands before to execute multiplication4552 ;4553 ; This routine test fac & arg for validity, set the sign of the result,4554 ; and return to the caller for any abnormal condition:4555 ;4556 ; 1) return nan if fac=nan or arg=nan4557 ; 2) return +inf if fac=+inf and arg=+inf or arg>04558 ; 3) return +inf if fac=-inf and arg=-inf or arg<04559 ; 4) return -inf if fac=-inf and arg=+inf or arg>04560 ; 5) return -inf if fac=+inf and arg=-inf or arg<04561 ; 6) return +inf if arg=+inf and fac>04562 ; 7) return +inf if arg=-inf and fac<04563 ; 8) return -inf if arg=-inf and fac>04564 ; 9) return -inf if arg=+inf and fac<04565 ; 10) return nan if fac=+/-inf and arg=04566 ; 11) return nan if arg=+/-inf and fac=04567 ;4568 ; This routine is used internally and not intended for end use.4569 ;4570 ;------4571 F84CAF multst:Tue Jul 17 11:00:18 2018 Page 344572 ;------4573 F84CAF A5 24 lda facsgn ; compare sign4574 F84CB1 45 3C eor argsgn4575 F84CB3 85 24 sta facsgn ; set result sign4576 F84CB5 85 3C sta argsgn4577 F84CB7 38 sec ; invalid result flag4578 F84CB8 24 25 bit facst ; test fac4579 F84CBA 10 0E bpl ?fv ; fac is valid4580 F84CBC 50 2A bvc ?skp ; fac=nan so result=nan4581 F84CBE 24 3D bit argst ; fac=inf so check arg4582 F84CC0 10 04 bpl ?az ; fac=inf & arg=y so check if arg=04583 F84CC2 50 21 bvc ?mv ; fac=inf & arg=nan so result=nan4584 F84CC4 80 22 bra ?skp ; fac=inf & arg=inf so result=inf4585 F84CC6 50 20 ?az: bvc ?skp ; fac=inf & arg not null so result=inf4586 F84CC8 80 0A bra ?nan ; fac=inf & arg=0 so result=nan4587 F84CCA 24 3D ?fv: bit argst ; fac is valid, so now check arg4588 F84CCC 10 0B bpl ?vv ; arg too is valid4589 F84CCE 50 15 bvc ?mv ; fac=x & arg=nan so result=nan4590 F84CD0 24 25 bit facst ; fac=x & arg=inf so check if fac=04591 F84CD2 50 11 bvc ?mv ; fac not null & arg=inf so result=inf4592 F84CD4 20 74 4E ?nan: jsr fldnan ; fac=0 & arg=inf so result=nan4593 F84CD7 80 0F bra ?skp ; skip resturn & exit with CF=14594 F84CD9 18 ?vv: clc ; now result is valid4595 F84CDA 70 09 bvs ?mv ; arg=0 so result=04596 F84CDC 24 25 bit facst ; fac=0?4597 F84CDE 50 0A bvc ?end ; no, return to mult operation4598 F84CE0 20 56 4E jsr fldz ; result=0 (with CF=0)4599 F84CE3 80 03 bra ?skp4600 F84CE5 20 0C 84 ?mv: jsr mvatof ; move arg to fac (preserve CF)4601 F84CE8 68 ?skp: pla ; skip return address4602 F84CE9 68 pla4603 F84CEA 60 ?end: rts46044605 ; divtst - test operands before to execute division4606 ;4607 ; This routine test fac & arg for validity, set the sign of the result,4608 ; and return to the caller for any abnormal condition:4609 ;4610 ; 1) return nan if fac=nan or arg=nan4611 ; 2) return nan if fac=0 and arg=04612 ; 3) return nan if fac=+/-inf and arg=+/-inf4613 ; 4) return +inf if arg=+inf and fac>=04614 ; 5) return +inf if arg=-inf and fac<04615 ; 6) return -inf if arg=-inf and fac>=04616 ; 7) return -inf if arg=+inf and fac<04617 ; 8) return +inf if arg>0 and fac=04618 ; 9) return -inf if arg<0 and fac=04619 ; 10) return 0 if arg=0 and fac=+/-inf4620 ;4621 ; This routine is used internally and not intended for end use.4622 ;4623 ;------4624 F84CEB divtst:4625 ;------4626 F84CEB A5 24 lda facsgn ; compare sign4627 F84CED 45 3C eor argsgn4628 F84CEF 85 24 sta facsgn ; set result signTue Jul 17 11:00:18 2018 Page 354629 F84CF1 85 3C sta argsgn4630 F84CF3 38 sec ; invalid result flag4631 F84CF4 24 25 bit facst ; test fac4632 F84CF6 10 08 bpl ?fv ; fac is valid4633 F84CF8 50 29 bvc ?skp ; fac=nan so result=nan4634 F84CFA 24 3D bit argst ; fac=inf so check arg4635 F84CFC 30 18 bmi ?nan ; fac=inf & arg=inf/nan so result=nan4636 F84CFE 80 11 bra ?z ; fac=inf & arg=y so result=04637 F84D00 A5 3D ?fv: lda argst ; fac is valid, so now check arg4638 F84D02 30 1C bmi ?mv ; fac=x & arg=nan/inf so result=nan/inf4639 F84D04 25 25 and facst4640 F84D06 0A asl a ; both null?4641 F84D07 30 0D bmi ?nan ; yes so result=nan4642 F84D09 24 25 bit facst4643 F84D0B 70 0E bvs ?inf4644 F84D0D 24 3D bit argst4645 F84D0F 50 14 bvc ?end4646 F84D11 20 56 4E ?z: jsr fldz ; result=0 (with CF=0)4647 F84D14 80 0D bra ?skp4648 F84D16 20 74 4E ?nan: jsr fldnan ; fac=0 & arg=0 so result=nan4649 F84D19 80 08 bra ?skp ; skip resturn & exit with CF=14650 F84D1B 20 7D 4E ?inf: jsr fldinf4651 F84D1E 80 03 bra ?skp4652 F84D20 20 0C 84 ?mv: jsr mvatof ; move arg to fac (preserve CF)4653 F84D23 68 ?skp: pla ; skip return address4654 F84D24 68 pla4655 F84D25 60 ?end: rts46564657 ;---------------------------------------------------------------------------4658 ; pack/unpack to/from 128 bit quadruple-precision IEEE format4659 ; these routines convert to/from internal format from/to std. IEEE format4660 ;---------------------------------------------------------------------------46614662 ; frndm - round 128-bit fac mantissa to 113-bit mantissa4663 ;4664 ; standard rounding method: round to nearest and tie to even4665 ;4666 ; let G = (guard bits)*2 and L = lsb significand:4667 ;4668 ; if G < $8000 then round down (truncate)4669 ; if G > $8000 then round up4670 ; if G = $8000 then 'tie even':4671 ; if L = 0 then round down (truncate)4672 ; else round up4673 ;4674 ; if exponent equal to $7FFE and mantissa is all 1's, no round up take place,4675 ; to avoid ovorflow4676 ;4677 ; The main use of this routine is to round fac before to convert to IEEE4678 ; format, but can be called after any operation (of course losing guard bits)4679 ;4680 ;-----4681 F84D26 frndm:4682 ;-----4683 F84D26 CPU164684 F84D26 C2 30 rep #(PMFLAG.OR.PXFLAG)4685 .LONGA onTue Jul 17 11:00:18 2018 Page 364686 .LONGI on4687 .MNLIST4688 F84D28 A5 12 lda facm ; check guard bits4689 F84D2A AA tax ; retain guard bits (G)4690 F84D2B 29 00 80 and #$8000 ; mask bit 15 (significand lsb)4691 F84D2E 85 12 sta facm ; clear guard bits (G)4692 F84D30 A8 tay ; Y=lsb significand (L)4693 F84D31 F0 07 beq ?rnd ; if bit 15=0 always possible to round up4694 F84D33 A5 22 lda facexp ; we check exponent for possible overflow4695 F84D35 20 AF 4A jsr chkovf4696 F84D38 B0 14 bcs ?done ; no round is possible (avoid overflow)4697 F84D3A 8A ?rnd: txa ; check guard bits4698 F84D3B 0A asl a4699 F84D3C C9 00 80 cmp #$80004700 F84D3F 90 0D bcc ?done ; G < $8000 so round down (truncate)4701 F84D41 D0 03 bne ?cf ; G > $8000 so round up (CF=1 here)4702 F84D43 98 tya ; G = $8000 so check L (lsb significand)4703 F84D44 10 08 bpl ?done ; if L=0 round down -- tie even (truncate)4704 F84D46 98 ?cf: tya ; here CF=1 -- round up4705 F84D47 69 FF 7F adc #$7FFF ; really add $80004706 F84D4A 85 12 sta facm ; lsb sigificand4707 F84D4C B0 03 bcs ?inc ; mantissa increment, because carry from lsb4708 F84D4E ?done: CPU084709 F84D4E E2 30 sep #(PMFLAG.OR.PXFLAG)4710 .LONGA off4711 .LONGI off4712 .MNLIST4713 F84D50 60 rts4714 F84D51 4C 85 4A ?inc: jmp incfac ; now this increment never cause overflow471547164717 ; pack - pack fac & store in memory in std. quadruple precision IEEE format4718 ;4719 ; Main routine to store in memory a floating point number4720 ;4721 ; entry:4722 ; fac = float point4723 ; A = low memory address4724 ; X = high memory address4725 ; Y = memory bank4726 ;4727 ; exit:4728 ; quadruple precision stored in memory4729 ;4730 ; This routine round 128-bit fac mantissa to 113-bit mantissa, pack to4731 ; quadruple precision IEEE standard format, and store it in memory4732 ;4733 ;-----4734 F84D54 fpack:4735 ;-----4736 F84D54 85 42 sta fcp ; set long pointer to memory buffer4737 F84D56 86 43 stx fcp+14738 F84D58 84 44 sty fcp+24739 F84D5A 20 26 4D jsr frndm ; round fac to 113 bit mantissa4740 F84D5D ACC164741 F84D5D C2 20 rep #PMFLAG4742 .LONGA onTue Jul 17 11:00:18 2018 Page 374743 .MNLIST4744 F84D5F A5 12 lda facm4745 F84D61 0A asl a ; rotate lsb of packed format4746 F84D62 A5 14 lda facm+2 ; rotate all remaining 112 bits...4747 F84D64 2A rol a4748 F84D65 87 42 sta [fcp] ; ...and store4749 F84D67 A5 16 lda facm+44750 F84D69 2A rol a4751 F84D6A A0 02 ldy #24752 F84D6C 97 42 sta [fcp],y4753 F84D6E A5 18 lda facm+64754 F84D70 2A rol a4755 F84D71 A0 04 ldy #44756 F84D73 97 42 sta [fcp],y4757 F84D75 A5 1A lda facm+84758 F84D77 2A rol a4759 F84D78 A0 06 ldy #64760 F84D7A 97 42 sta [fcp],y4761 F84D7C A5 1C lda facm+104762 F84D7E 2A rol a4763 F84D7F A0 08 ldy #84764 F84D81 97 42 sta [fcp],y4765 F84D83 A5 1E lda facm+124766 F84D85 2A rol a4767 F84D86 A0 0A ldy #104768 F84D88 97 42 sta [fcp],y4769 F84D8A A5 20 lda facm+144770 F84D8C 2A rol a ; CF = hidden bit (msb)4771 F84D8D A0 0C ldy #124772 F84D8F 97 42 sta [fcp],y4773 F84D91 A5 22 lda facexp4774 F84D93 B0 03 bcs ?fn ; CF=1 mean normal float4775 F84D95 A9 00 00 lda #0 ; subnormal float or zero4776 F84D98 A6 24 ?fn: ldx facsgn4777 F84D9A 10 03 bpl ?exp ; positive float4778 F84D9C 09 00 80 ora #$8000 ; negative float4779 F84D9F A0 0E ?exp: ldy #144780 F84DA1 97 42 sta [fcp],y4781 F84DA3 ACC084782 F84DA3 E2 20 sep #PMFLAG4783 .LONGA off4784 .MNLIST4785 F84DA5 60 rts47864787 ; unpack - get a quadruple precision IEEE format from memory and store in fac4788 ;4789 ; Main routine to load fac with a floating point number stored in memory4790 ;4791 ; entry:4792 ; A = low memory address4793 ; X = high memory address4794 ; Y = memory bank4795 ;4796 ; exit:4797 ; fac = floating point number in internal fortmat4798 ;4799 ;Tue Jul 17 11:00:18 2018 Page 384800 ;-------4801 F84DA6 funpack:4802 ;-------4803 F84DA6 85 42 sta fcp ; set long pointer to memory buffer4804 F84DA8 86 43 stx fcp+14805 F84DAA 84 44 sty fcp+24806 F84DAC ACC16CLC ; CF=0: assume hidden bit = 04807 F84DAC C2 21 rep #(PMFLAG.OR.PCFLAG)4808 .LONGA on4809 .MNLIST4810 F84DAE A2 00 ldx #0 ; assume positive sign4811 F84DB0 A0 0E ldy #144812 F84DB2 B7 42 lda [fcp],y ; exponent4813 F84DB4 10 01 bpl ?fp ; positive float4814 F84DB6 CA dex ; negative float4815 F84DB7 86 24 ?fp: stx facsgn4816 F84DB9 A2 00 ldx #$00 ; assume normal float4817 F84DBB 29 FF 7F and #$7FFF ; mask off sign4818 F84DBE 85 22 sta facexp4819 F84DC0 F0 01 beq ?get ; zero or subnormal (msb=0)4820 F84DC2 38 sec ; hidden bit: msb=14821 F84DC3 A0 0C ?get: ldy #124822 F84DC5 B7 42 lda [fcp],y ; significand4823 F84DC7 6A ror a ; rotate in hidden bit...4824 F84DC8 85 20 sta facm+14 ; ...then rotate all 112 bits...4825 F84DCA A0 0A ldy #10 ; ...and store to fac mantissa4826 F84DCC B7 42 lda [fcp],y4827 F84DCE 6A ror a4828 F84DCF 85 1E sta facm+124829 F84DD1 A0 08 ldy #84830 F84DD3 B7 42 lda [fcp],y4831 F84DD5 6A ror a4832 F84DD6 85 1C sta facm+104833 F84DD8 A0 06 ldy #64834 F84DDA B7 42 lda [fcp],y4835 F84DDC 6A ror a4836 F84DDD 85 1A sta facm+84837 F84DDF A0 04 ldy #44838 F84DE1 B7 42 lda [fcp],y4839 F84DE3 6A ror a4840 F84DE4 85 18 sta facm+64841 F84DE6 A0 02 ldy #24842 F84DE8 B7 42 lda [fcp],y4843 F84DEA 6A ror a4844 F84DEB 85 16 sta facm+44845 F84DED A7 42 lda [fcp]4846 F84DEF 6A ror a4847 F84DF0 85 14 sta facm+24848 F84DF2 8A txa ; shift in lsb4849 F84DF3 6A ror a ; <14:0> are all zero (guard bits)4850 F84DF4 85 12 sta facm4851 F84DF6 A5 22 lda facexp ; check exponent4852 F84DF8 F0 17 beq ?chkz ; if exp=0 check if fac=04853 F84DFA C9 FF 7F cmp #INFEXP4854 F84DFD 90 2A bcc ?st ; valid float, set status4855 F84DFF A9 FF 7F lda #INFEXP4856 F84E02 85 22 sta facexp ; fac=inf or fac=nanTue Jul 17 11:00:18 2018 Page 394857 F84E04 A2 C0 ldx #$C0 ; assume inf4858 F84E06 A5 20 lda facm+14 ; check type4859 F84E08 C9 00 80 cmp #INFSND4860 F84E0B F0 1C beq ?st ; set inf in fac stastus4861 F84E0D A2 80 ldx #$80 ; set nan in fac status4862 F84E0F 80 18 bra ?st4863 F84E11 A5 12 ?chkz: lda facm ; exponent is zero: check if fac=04864 F84E13 05 14 ora facm+24865 F84E15 05 16 ora facm+44866 F84E17 05 18 ora facm+64867 F84E19 05 1A ora facm+84868 F84E1B 05 1C ora facm+104869 F84E1D 05 1E ora facm+124870 F84E1F 05 20 ora facm+144871 F84E21 D0 04 bne ?sn ; fac is subnormal4872 F84E23 A2 40 ldx #$40 ; fac is zero4873 F84E25 80 02 bra ?st4874 F84E27 E6 22 ?sn: inc facexp ; subnormal exponent = 14875 F84E29 86 25 ?st: stx facst ; set fac status4876 F84E2B ACC084877 F84E2B E2 20 sep #PMFLAG4878 .LONGA off4879 .MNLIST4880 F84E2D 60 rts48814882 ;---------------------------------------------------------------------------4883 ; load fac & arg with special values4884 ;---------------------------------------------------------------------------48854886 ; fldp1 - load the constant +1.0 into fac4887 ;4888 ; exit:4889 ; fac = +1.04890 ;4891 ;-----4892 F84E2E fldp1:4893 ;-----4894 F84E2E 64 24 stz facsgn4895 F84E30 80 04 bra fld148964897 ; fldm1 - load the constant -1.0 into fac4898 ;4899 ; exit:4900 ; fac = -1.04901 ;4902 ;-----4903 F84E32 fldm1:4904 ;-----4905 F84E32 A9 FF lda #$FF4906 F84E34 85 24 sta facsgn49074908 ;----4909 F84E36 fld1:4910 ;----4911 F84E36 ACC164912 F84E36 C2 20 rep #PMFLAG4913 .LONGA onTue Jul 17 11:00:18 2018 Page 404914 .MNLIST4915 F84E38 A9 FF 3F lda #EBIAS4916 F84E3B 85 22 sta facexp4917 F84E3D A9 00 80 lda #$80004918 F84E40 85 20 sta facm+144919 F84E42 64 12 stz facm4920 F84E44 64 14 stz facm+24921 F84E46 64 16 stz facm+44922 F84E48 64 18 stz facm+64923 F84E4A 64 1A stz facm+84924 F84E4C 64 1C stz facm+104925 F84E4E 64 1E stz facm+124926 F84E50 ACC084927 F84E50 E2 20 sep #PMFLAG4928 .LONGA off4929 .MNLIST4930 F84E52 64 25 stz facst4931 F84E54 18 clc4932 F84E55 60 rts49334934 ; fldz - load the constant 0.0 into fac4935 ;4936 ; exit:4937 ; fac = 0.04938 ;4939 ;----4940 F84E56 fldz:4941 ;----4942 F84E56 ACC164943 F84E56 C2 20 rep #PMFLAG4944 .LONGA on4945 .MNLIST4946 F84E58 64 20 stz facm+144947 F84E5A 64 22 stz facexp4948 F84E5C 64 12 stz facm4949 F84E5E 64 14 stz facm+24950 F84E60 64 16 stz facm+44951 F84E62 64 18 stz facm+64952 F84E64 64 1A stz facm+84953 F84E66 64 1C stz facm+104954 F84E68 64 1E stz facm+124955 F84E6A ACC084956 F84E6A E2 20 sep #PMFLAG4957 .LONGA off4958 .MNLIST4959 F84E6C 64 24 stz facsgn4960 F84E6E A9 40 lda #$404961 F84E70 85 25 sta facst4962 F84E72 18 noer: clc4963 F84E73 60 rts49644965 ; fldnan - set fac=nan4966 ;------4967 F84E74 fldnan:4968 ;------4969 F84E74 ACC164970 F84E74 C2 20 rep #PMFLAGTue Jul 17 11:00:18 2018 Page 414971 .LONGA on4972 .MNLIST4973 F84E76 A9 00 C0 lda #NANSND4974 F84E79 A2 80 ldx #$80 ; nan flag4975 F84E7B 80 07 bra fldinv49764977 ; fldinf - set fac=inf4978 ;------4979 F84E7D fldinf:4980 ;------4981 F84E7D ACC164982 F84E7D C2 20 rep #PMFLAG4983 .LONGA on4984 .MNLIST4985 F84E7F A9 00 80 lda #INFSND4986 F84E82 A2 C0 ldx #$C0 ; inf flag49874988 F84E84 fldinv:4989 F84E84 85 20 sta facm+14 ; set msb4990 F84E86 A9 FF 7F lda #INFEXP ; set invalid exponent4991 F84E89 85 22 sta facexp4992 F84E8B 64 1E stz facm+124993 F84E8D 64 1C stz facm+104994 F84E8F 64 1A stz facm+84995 F84E91 64 18 stz facm+64996 F84E93 64 16 stz facm+44997 F84E95 64 14 stz facm+24998 F84E97 64 12 stz facm4999 F84E99 ACC085000 F84E99 E2 20 sep #PMFLAG5001 .LONGA off5002 .MNLIST5003 F84E9B 86 25 stx facst5004 F84E9D 38 sec ; return error condition5005 F84E9E 60 rts50065007 ; ldahalf - load the constant 0.5 into arg5008 ;5009 ; exit:5010 ; arg = 0.55011 ;5012 ;-------5013 F84E9F ldahalf:5014 ;-------5015 F84E9F ACC165016 F84E9F C2 20 rep #PMFLAG5017 .LONGA on5018 .MNLIST5019 F84EA1 A9 FE 3F lda #EBIAS-15020 F84EA4 80 0C bra amsb50215022 ; ldaone - load the constant +1.0 into arg5023 ;5024 ; exit:5025 ; arg = +1.05026 ;5027 ;------Tue Jul 17 11:00:18 2018 Page 425028 F84EA6 ldaone:5029 ;------5030 F84EA6 ACC165031 F84EA6 C2 20 rep #PMFLAG5032 .LONGA on5033 .MNLIST5034 F84EA8 A9 FF 3F lda #EBIAS5035 F84EAB 80 05 bra amsb50365037 ; ldatwo - load the constant +2.0 into arg5038 ;5039 ; exit:5040 ; arg = +2.05041 ;5042 ;------5043 F84EAD ldatwo:5044 ;------5045 F84EAD ACC165046 F84EAD C2 20 rep #PMFLAG5047 .LONGA on5048 .MNLIST5049 F84EAF A9 00 40 lda #EBIAS+150505051 F84EB2 amsb:5052 F84EB2 85 3A sta argexp ; store exponent5053 F84EB4 A9 00 80 lda #$80005054 F84EB7 85 38 sta argm+14 ; high word = $80005055 F84EB9 64 2A stz argm ; reset all remaining bits5056 F84EBB 64 2C stz argm+25057 F84EBD 64 2E stz argm+45058 F84EBF 64 30 stz argm+65059 F84EC1 64 32 stz argm+85060 F84EC3 64 34 stz argm+105061 F84EC5 64 36 stz argm+125062 F84EC7 64 3C stz argsgn ; positive sign5063 F84EC9 ACC085064 F84EC9 E2 20 sep #PMFLAG5065 .LONGA off5066 .MNLIST5067 F84ECB 18 clc5068 F84ECC 60 rts50695070 ;---------------------------------------------------------------------------5071 ; conversion from integer to float & from float to integer5072 ;---------------------------------------------------------------------------50735074 ; fldu128 - load fac with an unsigned 128 bit integer (n)5075 ;5076 ; entry:5077 ; tm..tm+15 = n, unsigned 128 bit integer5078 ;5079 ; exit:5080 ; fac = n5081 ;5082 ;-------5083 F84ECD fldu128:5084 ;-------Tue Jul 17 11:00:18 2018 Page 435085 F84ECD 20 56 4E jsr fldz ; set fac=05086 F84ED0 64 24 stz facsgn5087 F84ED2 ACC165088 F84ED2 C2 20 rep #PMFLAG5089 .LONGA on5090 .MNLIST5091 F84ED4 A5 0E lda tm+14 ; load 128 bit value5092 F84ED6 85 20 sta facm+145093 F84ED8 A5 0C lda tm+125094 F84EDA 85 1E sta facm+125095 F84EDC A5 0A lda tm+105096 F84EDE 85 1C sta facm+105097 F84EE0 A5 08 lda tm+85098 F84EE2 85 1A sta facm+85099 F84EE4 A5 06 lda tm+65100 F84EE6 85 18 sta facm+65101 F84EE8 A5 04 lda tm+45102 F84EEA 85 16 sta facm+45103 F84EEC A5 02 lda tm+25104 F84EEE 85 14 sta facm+25105 F84EF0 A5 00 lda tm5106 F84EF2 85 12 sta facm5107 F84EF4 05 14 ora facm+2 ; test if n=05108 F84EF6 05 16 ora facm+45109 F84EF8 05 18 ora facm+65110 F84EFA 05 1A ora facm+85111 F84EFC 05 1C ora facm+105112 F84EFE 05 1E ora facm+125113 F84F00 05 20 ora facm+145114 F84F02 F0 29 beq okz ; n=05115 F84F04 A9 7E 40 lda #BIAS128 ; biased exponent for 128 bit value5116 F84F07 80 66 bra fldu51175118 .LONGA off51195120 ; fldu64 - load fac with an unsigned 64 bit integer (n)5121 ;5122 ; entry:5123 ; tm..tm+7 = n, unsigned 64 bit integer5124 ;5125 ; exit:5126 ; fac = n5127 ;5128 ;------5129 F84F09 fldu64:5130 ;------5131 F84F09 20 56 4E jsr fldz ; set fac=05132 F84F0C 64 24 stz facsgn5133 F84F0E ACC165134 F84F0E C2 20 rep #PMFLAG5135 .LONGA on5136 .MNLIST5137 F84F10 A5 06 lda tm+6 ; load 64 bit value5138 F84F12 85 20 sta facm+145139 F84F14 A5 04 lda tm+45140 F84F16 85 1E sta facm+125141 F84F18 A5 02 lda tm+2Tue Jul 17 11:00:18 2018 Page 445142 F84F1A 85 1C sta facm+105143 F84F1C A5 00 lda tm5144 F84F1E 85 1A sta facm+85145 F84F20 05 1C ora facm+10 ; test if n=05146 F84F22 05 1E ora facm+125147 F84F24 05 20 ora facm+145148 F84F26 F0 05 beq okz ; n=05149 F84F28 A9 3E 40 lda #BIAS64 ; biased exponent for 64 bit value5150 F84F2B 80 42 bra fldu51515152 .LONGA off51535154 F84F2D okz: ACC085155 F84F2D E2 20 sep #PMFLAG5156 .LONGA off5157 .MNLIST5158 F84F2F 18 clc5159 F84F30 60 rts51605161 ; fldu32 - load fac with an unsigned 32 bit integer (n)5162 ;5163 ; entry:5164 ; tm..tm+3 = n, unsigned 32 bit integer5165 ;5166 ; exit:5167 ; fac = n5168 ;5169 ;------5170 F84F31 fldu32:5171 ;------5172 F84F31 20 56 4E jsr fldz ; set fac=05173 F84F34 64 24 stz facsgn5174 F84F36 ACC165175 F84F36 C2 20 rep #PMFLAG5176 .LONGA on5177 .MNLIST5178 F84F38 A5 02 lda tm+25179 F84F3A 85 20 sta facm+14 ; load 32 bit value5180 F84F3C A5 00 lda tm5181 F84F3E 85 1E sta facm+125182 F84F40 05 20 ora facm+14 ; test if n=05183 F84F42 F0 E9 beq okz ; n=05184 F84F44 A9 1E 40 lda #BIAS32 ; biased exponent for 32 bit value5185 F84F47 80 26 bra fldu51865187 .LONGA off51885189 ; fldbyt - load fac with an unsigned 8 bit integer (n)5190 ;5191 ; entry:5192 ; A = n, unsigned 8 bit integer5193 ;5194 ; exit:5195 ; fac = n5196 ;5197 ;------5198 F84F49 fldbyt:Tue Jul 17 11:00:18 2018 Page 455199 ;------5200 F84F49 AA tax ; save A5201 F84F4A 20 56 4E jsr fldz ; set fac=05202 F84F4D 64 24 stz facsgn5203 F84F4F 8A txa5204 F84F50 F0 DB beq okz ; n=05205 F84F52 86 21 stx facm+15 ; put byte in high order bits5206 F84F54 ACC165207 F84F54 C2 20 rep #PMFLAG5208 .LONGA on5209 .MNLIST5210 F84F56 A9 06 40 lda #BIAS8 ; biased exponent for 8 bit value5211 F84F59 80 14 bra fldu52125213 .LONGA off5214 F84F5B5215 ; fldu16 - load fac with an unsigned 16 bit integer (n)5216 ;5217 ; entry:5218 ; A = low 8 bit of n, unsigned 16 bit integer5219 ; Y = high 8 bit of n, unsigned 16 bit integer5220 ;5221 ; exit:5222 ; fac = n5223 ;5224 ;------5225 F84F5B fldu16:5226 ;------5227 F84F5B AA tax ; save A5228 F84F5C 20 56 4E jsr fldz ; set fac=05229 F84F5F 86 20 stx facm+14 ; low 8 bit5230 F84F61 84 21 sty facm+15 ; high 8 bit5231 F84F63 64 24 stz facsgn5232 F84F65 8A txa5233 F84F66 05 21 ora facm+15 ; test if n=05234 F84F68 F0 C3 beq okz ; n=05235 F84F6A ACC165236 F84F6A C2 20 rep #PMFLAG5237 .LONGA on5238 .MNLIST5239 F84F6C A9 0E 40 lda #BIAS16 ; biased exponent for 16 bit value52405241 ;----5242 F84F6F fldu:5243 ;----5244 F84F6F 85 22 sta facexp ; store exponent5245 F84F71 ACC085246 F84F71 E2 20 sep #PMFLAG5247 .LONGA off5248 .MNLIST5249 F84F73 64 25 stz facst ; normal fac <> 05250 F84F75 4C 62 46 jmp normfac ; normalize fac52515252 ; uitrunc - convert the integral part of fac to unsigned 128 bit integer5253 ;5254 ; this routine truncate toward zero, and ignore fac sign5255 ;Tue Jul 17 11:00:18 2018 Page 465256 ; entry:5257 ; fac = x5258 ;5259 ; exit:5260 ; tm..tm+15 = unsigned 128 bit integer = integral part of |x|5261 ; CF = 1 if the integral part of |x| not fit in 128 bit5262 ;5263 ; In overflow condition, or if fac=nan/inf, tm..tm+15 will be filled with5264 ; the max. 128 bit value and the carry flag will be set.5265 ;5266 ;-------5267 F84F78 uitrunc:5268 ;-------5269 F84F78 24 25 bit facst ; valid fac?5270 F84F7A 10 1F bpl ?fv ; yes5271 F84F7C ACC16 ; set tm..tm+15 to max.5272 F84F7C C2 20 rep #PMFLAG5273 .LONGA on5274 .MNLIST5275 F84F7E 38 ?ovf: sec ; invalid flag5276 F84F7F A9 FF FF lda #$FFFF ; set max.5277 F84F82 80 04 bra ?set5278 F84F84 A9 00 00 ?z: lda #05279 F84F87 18 ?z1: clc ; valid flag5280 F84F88 85 00 ?set: sta tm5281 F84F8A 85 02 sta tm+25282 F84F8C 85 04 sta tm+45283 F84F8E 85 06 sta tm+65284 F84F90 85 08 sta tm+85285 F84F92 85 0A sta tm+105286 F84F94 85 0C sta tm+125287 F84F96 85 0E sta tm+145288 F84F98 ACC085289 F84F98 E2 20 sep #PMFLAG5290 .LONGA off5291 .MNLIST5292 F84F9A 60 rts5293 F84F9B ?fv: ACC165294 F84F9B C2 20 rep #PMFLAG5295 .LONGA on5296 .MNLIST5297 F84F9D 70 E5 bvs ?z ; fac=0, so return tm=05298 F84F9F A5 22 lda facexp5299 F84FA1 F0 E4 beq ?z1 ; fac=0, so return tm=05300 F84FA3 38 sec5301 F84FA4 E9 FF 3F sbc #EBIAS ; unbias exponent5302 F84FA7 90 DB bcc ?z ; fac<1, so return tm=05303 F84FA9 C9 80 00 cmp #MNTBITS ; limit to 128 bit integer5304 F84FAC B0 D0 bcs ?ovf ; 128 bits integer overflow5305 F84FAE E9 7E 00 sbc #MNTBITS-2 ; take in account CF=0 here5306 F84FB1 AA tax ; A=X=negative count of shift toward right5307 F84FB2 A5 12 lda facm ; move fac mantissa to tm5308 F84FB4 85 00 sta tm5309 F84FB6 A5 14 lda facm+25310 F84FB8 85 02 sta tm+25311 F84FBA A5 16 lda facm+45312 F84FBC 85 04 sta tm+4Tue Jul 17 11:00:18 2018 Page 475313 F84FBE A5 18 lda facm+65314 F84FC0 85 06 sta tm+65315 F84FC2 A5 1A lda facm+85316 F84FC4 85 08 sta tm+85317 F84FC6 A5 1C lda facm+105318 F84FC8 85 0A sta tm+105319 F84FCA A5 1E lda facm+125320 F84FCC 85 0C sta tm+125321 F84FCE A5 20 lda facm+145322 F84FD0 85 0E sta tm+145323 F84FD2 ACC085324 F84FD2 E2 20 sep #PMFLAG5325 .LONGA off5326 .MNLIST5327 F84FD4 8A txa ; A=negative count of shift toward right5328 F84FD5 F0 05 beq ?done ; no shift so exit5329 F84FD7 A2 00 ldx #tm ; shift tm..tm15 toward right5330 F84FD9 20 3A 47 jsr shrmx ; align integer with exponent5331 F84FDC 18 ?done: clc5332 F84FDD 60 rts53335334 ;---------------------------------------------------------------------------5335 ; rounding routines5336 ;---------------------------------------------------------------------------53375338 ; fceil - returns the smallest f.p. integer greater than or equal the argument5339 ;5340 ; This routine truncates toward plus infinity5341 ;5342 ; entry:5343 ; fac = x5344 ;5345 ; exit:5346 ; fac = y = integral part of x truncated toward plus infinity5347 ; CF = 1 if invalid result(inf or nan)5348 ;5349 ; fceil(3.0) = 3.05350 ; fceil(2.3) = 3.05351 ; fceil(0.5) = 1.05352 ; fceil(-0.5) = 0.05353 ; fceil(-2.3) = -2.05354 ; fceil(-3.0) = -3.05355 ;5356 ;-----5357 F84FDE fceil:5358 ;-----5359 F84FDE 24 25 bit facst5360 F84FE0 10 02 bpl ?fv ; fac is valid5361 F84FE2 38 sec ; return invalid flag5362 F84FE3 60 rts5363 F84FE4 50 04 ?fv: bvc ?nz ; fac <> 05364 F84FE6 64 24 stz facsgn ; return fac=05365 F84FE8 18 clc5366 F84FE9 60 rts5367 F84FEA A5 24 ?nz: lda facsgn5368 F84FEC 49 FF eor #$FF ; fceil(x)=-floor(-x)5369 F84FEE 85 24 sta facsgnTue Jul 17 11:00:18 2018 Page 485370 F84FF0 20 27 50 jsr floor5371 F84FF3 A5 24 lda facsgn5372 F84FF5 49 FF eor #$FF5373 F84FF7 85 24 sta facsgn5374 F84FF9 60 rts53755376 ; fround - returns the integral value that is nearest to ergument x,5377 ; with halfway cases rounded away from zero.5378 ;5379 ; This routine truncates toward the nearest integer value5380 ;5381 ; entry:5382 ; fac = x5383 ;5384 ; exit:5385 ; fac = y = integral part of x truncated toward the nearest5386 ; CF = 1 if invalid result(inf or nan)5387 ;5388 ; fround(3.8) = 4.05389 ; fround(3.4) = 3.05390 ; fround(0.5) = 1.05391 ; fround(0.4) = 0.05392 ; fround(-0.4) = 0.05393 ; fround(-0.5) = -1.05394 ; fround(-3.4) = -3.05395 ; fround(-3.8) = -4.05396 ;5397 ;------5398 F84FFA fround:5399 ;------5400 F84FFA 24 25 bit facst5401 F84FFC 10 02 bpl ?fv ; fac is valid5402 F84FFE 38 sec ; return invalid flag5403 F84FFF 60 ?ret: rts5404 F85000 50 04 ?fv: bvc ?nz ; fac <> 05405 F85002 64 24 stz facsgn ; return fac=05406 F85004 18 clc5407 F85005 60 rts5408 F85006 A5 24 ?nz: lda facsgn5409 F85008 48 pha ; save fac sign5410 F85009 64 24 stz facsgn5411 F8500B 20 67 45 jsr faddhalf ; |x|+0.55412 F8500E 68 pla5413 F8500F 85 24 sta facsgn ; restore fac sign5414 F85011 B0 EC bcs ?ret ; overflow54155416 ; return sign(x)*ftrunc(|x|+0.5)5417 F85013 30 C9 bmi fceil ; ftrunc(x)=fceil(x) if x<05418 F85015 80 10 bra floor ; ftrunc(x)=floor(x) if x>05419 F850175420 ; ftrunc - returns the nearest integral value that is not larger5421 ; in magnitude than the argument x.5422 ;5423 ; This routine truncates toward zero5424 ;5425 ; entry:5426 ; fac = xTue Jul 17 11:00:18 2018 Page 495427 ;5428 ; exit:5429 ; fac = y = integral part of x truncated toward zero5430 ; CF = 1 if invalid result(inf or nan)5431 ;5432 ; ftrunc(3.0) = 3.05433 ; ftrunc(2.3) = 2.05434 ; ftrunc(0.5) = 0.05435 ; ftrunc(-0.5) = 0.05436 ; ftrunc(-2.3) = -2.05437 ; ftrunc(-3.0) = -3.05438 ;5439 ;------5440 F85017 ftrunc:5441 ;------5442 F85017 24 25 bit facst5443 F85019 10 02 bpl ?fv ; fac is valid5444 F8501B 38 sec ; return invalid flag5445 F8501C 60 rts5446 F8501D 50 04 ?fv: bvc ?nz ; fac <> 05447 F8501F 64 24 stz facsgn ; return fac=05448 F85021 18 clc5449 F85022 60 rts5450 F85023 A5 24 ?nz: lda facsgn5451 F85025 30 B7 bmi fceil ; ftrunc(x)=fceil(x) if x<05452 ; ftrunc(x)=floor(x) if x>05453 F850275454 ; floor - returns the largest f.p. integer less than or equal to the argument5455 ;5456 ; This routine truncates toward minus infinity5457 ;5458 ; entry:5459 ; fac = x5460 ;5461 ; exit:5462 ; fac = y = integral part of x truncated toward minus infinity5463 ; CF = 1 if invalid result(inf or nan)5464 ;5465 ; floor(3.0) = 3.05466 ; floor(2.3) = 2.05467 ; floor(0.5) = 0.05468 ; floor(-0.5) = -15469 ; floor(-2.3) = -3.05470 ; floor(-3.0) = -3.05471 ;5472 ;-----5473 F85027 floor:5474 ;-----5475 F85027 24 25 bit facst5476 F85029 10 02 bpl ?fv ; fac is valid5477 F8502B 38 sec ; return invalid flag5478 F8502C 60 rts5479 F8502D 50 04 ?fv: bvc ?nz ; fac <> 05480 F8502F 64 24 stz facsgn ; return fac=05481 F85031 18 clc5482 F85032 60 rts5483 F85033 20 26 4D ?nz: jsr frndmTue Jul 17 11:00:18 2018 Page 505484 F85036 ACC165485 F85036 C2 20 rep #PMFLAG5486 .LONGA on5487 .MNLIST5488 F85038 A5 22 lda facexp5489 F8503A 38 sec5490 F8503B E9 FF 3F sbc #EBIAS5491 F8503E 85 3E sta wftmp ; save unbiased exponent5492 F85040 ACC085493 F85040 E2 20 sep #PMFLAG5494 .LONGA off5495 .MNLIST5496 F85042 B0 0A bcs ?gt1 ; |fac|>=15497 F85044 24 24 bit facsgn5498 F85046 30 03 bmi ?m1 ; if -1<fac<0 return fac=-1...5499 F85048 4C 56 4E jmp fldz ; ...else return fac=05500 F8504B 4C 32 4E ?m1: jmp fldm1 ; return fac=-15501 F8504E 20 39 84 ?gt1: jsr mvftoa ; move fac to arg for later comparation5502 F85051 ACC16 ; here CF=15503 F85051 C2 20 rep #PMFLAG5504 .LONGA on5505 .MNLIST5506 F85053 A9 70 00 lda #SNBITS-15507 F85056 E5 3E sbc wftmp ; if this is <=0 then fac already integral5508 F85058 ACC085509 F85058 E2 20 sep #PMFLAG5510 .LONGA off5511 .MNLIST5512 F8505A 90 23 bcc ?int ; fac already integral5513 F8505C F0 21 beq ?int ; fac already integral5514 F8505E5515 ; now A=count of bits to clear starting from mantissa ending5516 ; and we can clear the fractional part to get just the integral part5517 F8505E5518 F8505E 64 13 stz facm+1 ; clear lsb5519 F85060 3A dec a5520 F85061 F0 1C beq ?int ; done: fac is integral5521 F85063 A0 00 ldy #0 ; Y=05522 F85065 BB tyx ; X=05523 F85066 C9 08 ?lp: cmp #8 ; clear 8 bits at time?5524 F85068 90 09 bcc ?bit ; no, we have to clear less than 8 bits5525 F8506A 94 14 sty facm+2,x5526 F8506C E8 inx5527 F8506D E9 08 sbc #8 ; update count5528 F8506F F0 0E beq ?int ; done: fac is integral5529 F85071 80 F3 bra ?lp ; loop until we can clear 8 bits at time5530 F85073 9B ?bit: txy ; save mantissa index5531 F85074 AA tax ; X=count of bits5532 F85075 CA dex5533 F85076 BF B6 50 F8 lda >fmask,x ; load bits mask5534 F8507A BB tyx ; X=mantissa index5535 F8507B 35 14 and facm+2,x ; mask mantissa byte5536 F8507D 95 14 sta facm+2,x5537 F8507F 24 24 ?int: bit facsgn ; if fac>0...5538 F85081 10 31 bpl ?end ; ...then done5539 F85083 ACC16 ; ...else we compare if integral part...5540 F85083 C2 20 rep #PMFLAGTue Jul 17 11:00:18 2018 Page 515541 .LONGA on5542 .MNLIST5543 ; ...is equal to original fac5544 F85085 A5 14 lda facm+25545 F85087 C5 2C cmp argm+25546 F85089 D0 22 bne ?chk5547 F8508B A5 16 lda facm+45548 F8508D C5 2E cmp argm+45549 F8508F D0 1C bne ?chk5550 F85091 A5 18 lda facm+65551 F85093 C5 30 cmp argm+65552 F85095 D0 16 bne ?chk5553 F85097 A5 1A lda facm+85554 F85099 C5 32 cmp argm+85555 F8509B D0 10 bne ?chk5556 F8509D A5 1C lda facm+105557 F8509F C5 34 cmp argm+105558 F850A1 D0 0A bne ?chk5559 F850A3 A5 1E lda facm+125560 F850A5 C5 36 cmp argm+125561 F850A7 D0 04 bne ?chk5562 F850A9 A5 20 lda facm+145563 F850AB C5 38 cmp argm+145564 F850AD ?chk: ACC085565 F850AD E2 20 sep #PMFLAG5566 .LONGA off5567 .MNLIST5568 F850AF F0 03 beq ?end ; if equal then return it...5569 F850B1 4C 71 45 jmp fsubone ; ...otherwise subtract 15570 F850B4 18 ?end: clc5571 F850B5 60 rts55725573 ; bit mask to clear5574 F850B6 fmask:5575 F850B6 FE FC F8 F0 E0 .DB $FE,$FC,$F8,$F0,$E0,$C0,$80C0 8055765577 ;---------------------------------------------------------------------------5578 ; remainders routines5579 ;---------------------------------------------------------------------------55805581 ; fpmod, fprem - returns the remainder of x/y5582 ;5583 ; entry:5584 ; fac = y5585 ; arg = x5586 ;5587 ; exit:5588 ; fac = remainder5589 ; arg = integral part of the quotient5590 ; CF = 1 if invalid results5591 ;5592 ; The quotient is truncated toward zero in fpmod, and rounded to nearest5593 ; in fprem. The remainder is computed as: x - n*y, where n is the integral5594 ; quotient.5595 ;5596 ;-----Tue Jul 17 11:00:18 2018 Page 525597 F850BD fpmod:5598 ;-----5599 F850BD 20 DD 50 jsr rdiv ; x/y5600 F850C0 20 17 50 jsr ftrunc5601 F850C3 80 06 bra rem5602 F850C55603 ;-----5604 F850C5 fprem:5605 ;-----5606 F850C5 20 DD 50 jsr rdiv ; x/y5607 F850C8 20 FA 4F jsr fround56085609 ;---5610 F850CB rem:5611 ;---5612 F850CB 20 C0 84 jsr mvf_t2 ; tfr2 = n5613 F850CE 20 FB 85 jsr mvt1_a ; y5614 F850D1 20 DD 49 jsr fpmult ; y*n5615 F850D4 20 CE 85 jsr mvt0_a5616 F850D7 20 5F 45 jsr fpsub ; fac = x - y*n5617 F850DA 4C 28 86 jmp mvt2_a ; arg = n56185619 ;----5620 F850DD rdiv:5621 ;----5622 F850DD 20 93 84 jsr mvf_t1 ; tfr1 = y5623 F850E0 20 1A 85 jsr mva_t0 ; tfr0 = x5624 F850E3 20 10 4A jsr fpdiv ; x/y5625 F850E6 90 09 bcc ?ret ; ok5626 F850E8 20 74 4E jsr fldnan ; return nan5627 F850EB 20 39 84 jsr mvftoa5628 F850EE 68 pla ; skip return address5629 F850EF 68 pla5630 F850F0 38 sec5631 F850F1 60 ?ret: rts5632 F850F25633 ; fpfrac - returns the integral part, trucated toward zero, and the fractional5634 ; part of the argument x5635 ;5636 ; entry:5637 ; fac = x5638 ;5639 ; exit:5640 ; fac = y = fractional part of x, with: -1 < y < +15641 ; arg = k = integral part of x, as returned by ftrunc(x)5642 ; CF = 1 if invalid result (inf or nan)5643 ; in this case fac=arg=nan/inf5644 ;5645 ; note that y and k have the same sign of x and:5646 ;5647 ; x = k + y5648 ;5649 ;------5650 F850F2 fpfrac:5651 ;------5652 F850F2 24 25 bit facst5653 F850F4 10 05 bpl ?fv ; fac is validTue Jul 17 11:00:18 2018 Page 535654 F850F6 20 39 84 ?er: jsr mvftoa ; set arg=fac5655 F850F9 38 sec ; return invalid flag5656 F850FA 60 rts5657 F850FB 20 ED 84 ?fv: jsr mvf_t3 ; move fac to temp. reg. tfr35658 F850FE 20 17 50 jsr ftrunc ; fac=k=ftrunc(x)5659 F85101 B0 F3 bcs ?er ; overflow5660 F85103 20 C0 84 jsr mvf_t2 ; tfr2=k5661 F85106 20 55 86 jsr mvt3_a ; arg=x5662 F85109 20 5F 45 jsr fpsub ; fac=y=x-k5663 F8510C 4C 28 86 jmp mvt2_a ; arg=k56645665 ;---------------------------------------------------------------------------5666 ; conversion decimal/hexadecimal to binary5667 ;---------------------------------------------------------------------------56685669 ; str2int, str2int2 - convert the initial portion of the source string to5670 ; an unsigned or signed 128 bits integer.5671 ;5672 ; entry:5673 ; A = low address of source string5674 ; X = high address of source string5675 ; Y = bank that hold source string5676 ; B = flag signed conversion ($80), ignored for hex. string5677 ;5678 ; str2int2 is the re-entry point when long pointer tlp is already set,5679 ; and in this case:5680 ;5681 ; entry:5682 ; A = flag signed conversion ($80), ignored for hex. string5683 ; tlp = long pointer to source string5684 ;5685 ; exit:5686 ; facm..facm+15 = 128 bits integer5687 ; facsiz = minimum number of bytes that can hold the integer5688 ; A = first character where conversion stop5689 ; tlp = long pointer to first char. where conversion stop5690 ; CF = 0 if conversion was succesfully done5691 ; VF = 1 if integer overflow5692 ; CF = 1 (VF don't care) if input string is invalid5693 ;5694 ; Conversion start parsing source string from left toward right, skipping any5695 ; leading blank and/or tab: if initial portion of string begin with '$',5696 ; or '0x', or '0X', the conversion is done in base 16, otherwise in base 10.5697 ; In decimal conversion an optional single sign '+' or '-' can precede any5698 ; decimal digit, while in hexadecimal conversion just hexadecimal's digits5699 ; (both lower case and upper case) can follow the initial '$' or '0x'.5700 ; Conversion stop at the end of the string or at the first character that5701 ; does not produce a valid digit in the given base, and tlp hold the long5702 ; pointer to this character.5703 ;5704 ;-------5705 F8510F str2int:5706 ;-------5707 F8510F 85 4C sta tlp ; set long pointer to source ascii string5708 F85111 86 4D stx tlp+15709 F85113 84 4E sty tlp+25710 F85115 EB xba ; signed flagTue Jul 17 11:00:18 2018 Page 5457115712 ;--------5713 F85116 str2int2:5714 ;--------5715 F85116 29 80 and #$80 ; mask signed flag5716 F85118 09 60 ora #$60 ; set bit 6&5 (assume integer = 0)5717 F8511A 85 25 sta facst ; flag signed conversion5718 F8511C 64 24 stz facsgn ; assume positive sign5719 F8511E A2 11 ldx #17 ; clear facm5720 F85120 74 12 ?clr: stz facm,x ; facexp used for overflow check (extension)5721 F85122 CA dex5722 F85123 10 FB bpl ?clr5723 F85125 64 3F stz wftmp+1 ; digit's flag5724 F85127 A0 00 ldy #0 ; init string pointer5725 F85129 80 03 bra ?get05726 F8512B C8 ?nx0: iny5727 F8512C F0 55 beq ?iy ; string index overflow5728 F8512E B7 4C ?get0: lda [tlp],y ; get char5729 F85130 F0 54 beq ?eos ; end of string5730 F85132 C9 20 cmp #' '5731 F85134 F0 F5 beq ?nx0 ; skip leading blanks5732 F85136 C9 08 cmp #$085733 F85138 F0 F1 beq ?nx0 ; skip leading 'tab'5734 F8513A C9 24 cmp #'$' ; hex. string?5735 F8513C F0 7E beq ?hex ; yes, convert ascii hex. string5736 F8513E C9 30 cmp #'0'5737 F85140 D0 12 bne ?dec ; go to decimal conversion5738 F85142 AA tax ; save char5739 F85143 C8 iny ; bump pointer5740 F85144 F0 3D beq ?iy ; string index overflow5741 F85146 B7 4C lda [tlp],y ; get char5742 F85148 C9 78 cmp #'x' ; '0x' so hex. conversion5743 F8514A F0 70 beq ?hex5744 F8514C C9 58 cmp #'X' ; '0X' so hex. conversion5745 F8514E F0 6C beq ?hex5746 F85150 88 dey ; re-fetch previous char5747 F85151 8A txa ; this is '0'5748 F85152 80 17 bra ?dec2 ; handle decimal digit5749 F851545750 ; parsing of ascii decimal string5751 F85154 C9 2B ?dec: cmp #'+'5752 F85156 F0 0C beq ?nxt ; skip '+' sign5753 F85158 C9 2D cmp #'-'5754 F8515A D0 0F bne ?dec2 ; handle decimal digit5755 F8515C 24 25 bit facst ; convert to unsigned?5756 F8515E 10 26 bpl ?eos ; invalid '-' sign in unsigned conversion5757 F85160 A9 80 lda #$805758 F85162 85 24 sta facsgn ; set negative sign flag5759 F85164 C8 ?nxt: iny ; next byte5760 F85165 F0 1C beq ?iy ; string index overflow5761 F85167 B7 4C lda [tlp],y ; get next char5762 F85169 F0 1B beq ?eos ; end of string5763 F8516B 38 ?dec2: sec5764 F8516C E9 3A sbc #'0'+105765 F8516E 18 clc5766 F8516F 69 0A adc #105767 F85171 90 13 bcc ?eos ; not a digit: stop string parsingTue Jul 17 11:00:18 2018 Page 555768 F85173 20 44 52 jsr ?m10 ; facm*105769 F85176 B0 1A bcs ?ov ; overflow5770 F85178 20 7E 52 jsr ?addg ; fac=fac+digit5771 F8517B B0 15 bcs ?ov ; overflow5772 F8517D A9 80 lda #$805773 F8517F 85 3F sta wftmp+1 ; decimal digit indicator5774 F85181 80 E1 bra ?nxt ; get next char5775 F85183 88 ?iy: dey ; string index overflow5776 F85184 80 15 bra ?er ; invalid string5777 F85186 84 4F ?eos: sty fpidx ; end of string or end of parsing5778 F85188 A6 3F ldx wftmp+1 ; parsed at least one digit?5779 F8518A F0 11 beq ?er2 ; no, so error (invalid string)5780 F8518C 20 02 52 jsr ?test ; final conversion test5781 F8518F B8 clv ; no overflow5782 F85190 90 13 bcc ?done ; CF=0, VF=0 -- ok5783 F85192 A9 40 ?ov: lda #$405784 F85194 14 25 trb facst5785 F85196 18 clc5786 F85197 E2 40 sep #PVFLAG ; VF=1 -- overflow5787 F85199 80 0A bra ?done ; CF=0, VF=1 if signed integer overflow5788 F8519B 84 4F ?er: sty fpidx ; save string pointer5789 F8519D A2 11 ?er2: ldx #17 ; clear facm5790 F8519F 74 12 ?clr2: stz facm,x5791 F851A1 CA dex5792 F851A2 10 FB bpl ?clr25793 F851A4 38 sec ; error flag (invalid string)5794 F851A5 08 ?done: php ; save carry5795 F851A6 20 A4 52 jsr ?gsiz ; compute min. size5796 F851A9 A5 4C lda tlp ; update string pointer5797 F851AB 18 clc5798 F851AC 65 4F adc fpidx5799 F851AE 85 4C sta tlp5800 F851B0 90 06 bcc ?end5801 F851B2 E6 4D inc tlp+15802 F851B4 D0 02 bne ?end5803 F851B6 E6 4E inc tlp+25804 F851B8 A7 4C ?end: lda [tlp] ; A=last parsed character5805 F851BA 28 plp ; restore carry5806 F851BB 60 rts5807 F851BC5808 ; parsing of ascii hex. string5809 F851BC A9 60 ?hex: lda #$605810 F851BE 85 25 sta facst ; unsigned conversion only5811 F851C0 C8 ?hex1: iny ; bump pointer5812 F851C1 F0 C0 beq ?iy ; string index overflow5813 F851C3 B7 4C ?hex2: lda [tlp],y ; get next char5814 F851C5 F0 BF beq ?eos ; end of string5815 F851C7 C9 61 cmp #'a' ; test hex. digit5816 F851C9 90 02 bcc ?hex35817 F851CB E9 20 sbc #$20 ; capitalize 'a', 'b',...5818 F851CD 38 ?hex3: sec5819 F851CE E9 3A sbc #('0'+10) ; check digits '0'..'9'5820 F851D0 18 clc5821 F851D1 69 0A adc #105822 F851D3 B0 09 bcs ?hex4 ; ok, valid hex. digit5823 F851D5 E9 16 sbc #(6+16) ; check 'A'..'F'5824 F851D7 18 clcTue Jul 17 11:00:18 2018 Page 565825 F851D8 69 06 adc #65826 F851DA 90 AA bcc ?eos ; no hex digit: stop parsing5827 F851DC 69 09 adc #9 ; valid hex. digit5828 F851DE 29 0F ?hex4: and #$0F ; mask low nibble5829 F851E0 85 3E sta wftmp5830 F851E2 ACC165831 F851E2 C2 20 rep #PMFLAG5832 .LONGA on5833 .MNLIST5834 F851E4 20 6B 52 jsr ?m2 ; facm*165835 F851E7 20 6B 52 jsr ?m25836 F851EA 20 6B 52 jsr ?m25837 F851ED 20 6B 52 jsr ?m25838 F851F0 A5 22 lda facm+16 ; overflow test5839 F851F2 ACC085840 F851F2 E2 20 sep #PMFLAG5841 .LONGA off5842 .MNLIST5843 F851F4 D0 9C bne ?ov ; overflow5844 F851F6 A5 3E lda wftmp ; add hex. digit5845 F851F8 05 12 ora facm ; last low nibble5846 F851FA 85 12 sta facm5847 F851FC A9 80 lda #$805848 F851FE 85 3F sta wftmp+1 ; digits flag5849 F85200 80 BE bra ?hex1 ; continue string parsing58505851 F85202 ?test: ACC165852 F85202 C2 20 rep #PMFLAG5853 .LONGA on5854 .MNLIST5855 F85204 A5 20 lda facm+14 ; check if zero5856 F85206 A2 0C ldx #125857 F85208 15 12 ?lp1: ora facm,x5858 F8520A CA dex5859 F8520B CA dex5860 F8520C 10 FA bpl ?lp15861 F8520E C9 00 00 cmp #$00005862 F85211 ACC085863 F85211 E2 20 sep #PMFLAG5864 .LONGA off5865 .MNLIST5866 F85213 F0 2B beq ?vf ; finish: integer = 05867 F85215 A9 40 lda #$405868 F85217 14 25 trb facst ; not zero integer indicator5869 F85219 24 25 bit facst ; conversion test5870 F8521B 10 23 bpl ?vf ; wanted unsigned integer: finish5871 F8521D 24 24 bit facsgn ; if negative decimal...5872 F8521F 30 06 bmi ?neg ; ...should negate facm5873 F85221 A5 21 lda facm+15 ; should be <$80 if positive signed integer5874 F85223 10 1B bpl ?vf ; finish: positive signed integer5875 F85225 30 1B bmi ?of ; signed integer overflow5876 F85227 ?neg: ACC165877 F85227 C2 20 rep #PMFLAG5878 .LONGA on5879 .MNLIST5880 F85229 A2 00 ldx #0 ; facm index5881 F8522B A0 08 ldy #8 ; counter (8 words)Tue Jul 17 11:00:18 2018 Page 575882 F8522D 38 sec5883 F8522E A9 00 00 ?lp2: lda #0 ; two's complement5884 F85231 F5 12 sbc facm,x5885 F85233 95 12 sta facm,x5886 F85235 E8 inx5887 F85236 E8 inx5888 F85237 88 dey5889 F85238 D0 F4 bne ?lp25890 F8523A A5 20 lda facm+14 ; must be negative5891 F8523C ACC085892 F8523C E2 20 sep #PMFLAG5893 .LONGA off5894 .MNLIST5895 F8523E 10 02 bpl ?of ; signed integer overflow5896 F85240 18 ?vf: clc ; valid flag5897 F85241 60 rts5898 F85242 38 ?of: sec ; overflow5899 F85243 60 rts5900 F852445901 F85244 A2 11 ?m10: ldx #17 ; multiplies facm by 105902 F85246 84 4F sty fpidx ; save Y5903 F85248 85 3E sta wftmp ; save digit5904 F8524A B5 12 ?m101: lda facm,x ; move facm to argm5905 F8524C 95 2A sta argm,x5906 F8524E CA dex5907 F8524F 10 F9 bpl ?m1015908 F85251 ACC165909 F85251 C2 20 rep #PMFLAG5910 .LONGA on5911 .MNLIST5912 F85253 20 6B 52 jsr ?m2 ; facm*25913 F85256 20 6B 52 jsr ?m2 ; facm*45914 F85259 20 91 52 jsr ?add ; facm*4+argm=facm*55915 F8525C 20 6B 52 jsr ?m2 ; facm*105916 F8525F A5 22 lda facm+16 ; check overflow5917 F85261 ACC085918 F85261 E2 20 sep #PMFLAG5919 .LONGA off5920 .MNLIST5921 F85263 F0 01 beq ?nof ; no overflow5922 F85265 38 sec ; overflow flag5923 F85266 A4 4F ?nof: ldy fpidx ; restore Y5924 F85268 A5 3E lda wftmp ; restore digit5925 F8526A 60 rts59265927 F8526B 06 12 ?m2: asl facm ; multiplies facm by 25928 F8526D 26 14 rol facm+25929 F8526F 26 16 rol facm+45930 F85271 26 18 rol facm+65931 F85273 26 1A rol facm+85932 F85275 26 1C rol facm+105933 F85277 26 1E rol facm+125934 F85279 26 20 rol facm+145935 F8527B 26 22 rol facm+165936 F8527D 60 rts59375938 F8527E 84 4F ?addg: sty fpidx ; add digit to facm - save YTue Jul 17 11:00:18 2018 Page 585939 F85280 85 2A sta argm ; digit5940 F85282 ACC16 ; argm was already cleared5941 F85282 C2 20 rep #PMFLAG5942 .LONGA on5943 .MNLIST5944 F85284 20 91 52 jsr ?add5945 F85287 A5 22 lda facm+16 ; check overflow5946 F85289 ACC085947 F85289 E2 20 sep #PMFLAG5948 .LONGA off5949 .MNLIST5950 F8528B F0 01 beq ?nof1 ; no overflow5951 F8528D 38 sec ; overflow flag5952 F8528E A4 4F ?nof1: ldy fpidx ; restore Y5953 F85290 60 rts59545955 F85291 18 ?add: clc ; facm=facm+argm5956 F85292 A2 00 ldx #0 ; facm&argm index5957 F85294 A0 09 ldy #9 ; counter (9 words)5958 F85296 B5 12 ?ad1: lda facm,x ; facm=facm+argm5959 F85298 75 2A adc argm,x5960 F8529A 95 12 sta facm,x5961 F8529C 74 2A stz argm,x ; and clear argm for later use5962 F8529E E8 inx5963 F8529F E8 inx5964 F852A0 88 dey5965 F852A1 D0 F3 bne ?ad15966 F852A3 60 rts59675968 F852A4 B0 0E ?gsiz: bcs ?gse ; invalid string5969 F852A6 A9 10 lda #16 ; assume max. possible size5970 F852A8 85 24 sta facsgn5971 F852AA 70 08 bvs ?gse ; overflow condition5972 F852AC 24 25 bit facst ; compute min. integer size (in bytes #)5973 F852AE 50 05 bvc ?gs0 ; not zero5974 F852B0 A9 01 lda #1 ; zero can fit in one byte5975 F852B2 85 24 sta facsgn5976 F852B4 60 ?gse: rts5977 F852B5 30 2C ?gs0: bmi ?gss ; signed integer5978 F852B7 A2 10 ldx #165979 F852B9 ACC165980 F852B9 C2 20 rep #PMFLAG5981 .LONGA on5982 .MNLIST5983 F852BB A5 20 lda facm+145984 F852BD 05 1E ora facm+125985 F852BF 05 1C ora facm+105986 F852C1 05 1A ora facm+85987 F852C3 D0 06 bne ?gs1 ; 16 bytes integer5988 F852C5 A2 08 ldx #85989 F852C7 A5 18 lda facm+65990 F852C9 05 16 ora facm+45991 F852CB ?gs1: ACC085992 F852CB E2 20 sep #PMFLAG5993 .LONGA off5994 .MNLIST5995 F852CD D0 11 bne ?gs2 ; 8 bytes integerTue Jul 17 11:00:18 2018 Page 595996 F852CF A2 04 ldx #45997 F852D1 A5 15 lda facm+35998 F852D3 D0 0B bne ?gs2 ; 4 bytes integer5999 F852D5 CA dex6000 F852D6 A5 14 lda facm+26001 F852D8 D0 06 bne ?gs2 ; 3 bytes integer (long pointer)6002 F852DA CA dex6003 F852DB A5 13 lda facm+16004 F852DD D0 01 bne ?gs2 ; 2 bytes integer6005 F852DF CA dex ; 1 byte integer6006 F852E0 86 24 ?gs2: stx facsgn6007 F852E2 60 rts6008 F852E3 A4 21 ?gss: ldy facm+156009 F852E5 10 3F bpl ?gsp ; signed integer is positive6010 F852E7 A2 10 ldx #166011 F852E9 ACC166012 F852E9 C2 20 rep #PMFLAG6013 .LONGA on6014 .MNLIST6015 F852EB A5 20 lda facm+146016 F852ED 25 1E and facm+126017 F852EF 25 1C and facm+106018 F852F1 25 1A and facm+86019 F852F3 C9 FF FF cmp #$FFFF6020 F852F6 D0 29 bne ?gs4 ; 16 bytes signed integer6021 F852F8 A5 18 lda facm+66022 F852FA 10 25 bpl ?gs4 ; 16 bytes signed integer6023 F852FC A2 08 ldx #86024 F852FE 25 16 and facm+46025 F85300 C9 FF FF cmp #$FFFF6026 F85303 D0 1C bne ?gs4 ; 8 bytes signed integer6027 F85305 A5 14 lda facm+26028 F85307 10 18 bpl ?gs4 ; 8 bytes signed integer6029 F85309 A2 04 ldx #46030 F8530B C9 FF FF cmp #$FFFF6031 F8530E ACC086032 F8530E E2 20 sep #PMFLAG6033 .LONGA off6034 .MNLIST6035 F85310 D0 0F bne ?gs4 ; 4 bytes signed integer6036 F85312 A5 13 lda facm+16037 F85314 10 0B bpl ?gs4 ; 4 bytes signed integer6038 F85316 A2 02 ldx #26039 F85318 C9 FF cmp #$FF6040 F8531A D0 05 bne ?gs4 ; 2 bytes signed integer6041 F8531C A5 12 lda facm6042 F8531E 10 01 bpl ?gs46043 F85320 CA dex6044 F85321 ?gs4: ACC086045 F85321 E2 20 sep #PMFLAG6046 .LONGA off6047 .MNLIST6048 F85323 86 24 stx facsgn6049 F85325 60 rts6050 F85326 A2 10 ?gsp: ldx #166051 F85328 ACC166052 F85328 C2 20 rep #PMFLAGTue Jul 17 11:00:18 2018 Page 606053 .LONGA on6054 .MNLIST6055 F8532A A5 20 lda facm+146056 F8532C 05 1E ora facm+126057 F8532E 05 1C ora facm+106058 F85330 05 1A ora facm+86059 F85332 D0 25 bne ?gs6 ; 16 bytes signed integer6060 F85334 A5 18 lda facm+66061 F85336 30 21 bmi ?gs6 ; 16 bytes signed integer6062 F85338 A2 08 ldx #86063 F8533A 05 16 ora facm+46064 F8533C D0 1B bne ?gs6 ; 8 bytes signed integer6065 F8533E A5 14 lda facm+26066 F85340 30 17 bmi ?gs6 ; 8 bytes signed integer6067 F85342 A2 04 ldx #46068 F85344 C9 00 00 cmp #06069 F85347 D0 10 bne ?gs6 ; 4 bytes signed integer6070 F85349 ACC086071 F85349 E2 20 sep #PMFLAG6072 .LONGA off6073 .MNLIST6074 F8534B A5 13 lda facm+16075 F8534D 30 0A bmi ?gs6 ; 4 bytes signed integer6076 F8534F A2 02 ldx #26077 F85351 A8 tay6078 F85352 D0 05 bne ?gs6 ; 2 bytes signed integer6079 F85354 A5 12 lda facm6080 F85356 30 01 bmi ?gs6 ; 2 bytes signed integer6081 F85358 CA dex ; 1 byte signed integer6082 F85359 ?gs6: ACC086083 F85359 E2 20 sep #PMFLAG6084 .LONGA off6085 .MNLIST6086 F8535B 86 24 stx facsgn6087 F8535D 60 rts6088 F8535E6089 ; str2fp, str2fp2 - convert the initial portion of the source string to6090 ; a 128 bits binary floating point.6091 ;6092 ; entry:6093 ; A = low address of source string6094 ; X = high address of source string6095 ; Y = bank that hold source string6096 ;6097 ; str2fp2 is the re-entry point when long pointer tlp is already set,6098 ; and in this case:6099 ;6100 ; entry:6101 ; tlp = long pointer to source string6102 ;6103 ; exit:6104 ; fac = converted floating point6105 ; A = first character where conversion stop6106 ; tlp = long pointer to first char. where conversion stop6107 ; CF = 0 if conversion was succesfully done6108 ; VF = 1 if fac=inf/nan6109 ; CF = 1 (VF don't care) if input string is invalidTue Jul 17 11:00:18 2018 Page 616110 ;6111 ; Conversion start parsing source string from left toward right, skipping any6112 ; leading blank and/or tab.6113 ; The expected form of the input string is either:6114 ;6115 ; +o an hexadecimal ascii string beginning with '$' or '0x' or '0X',6116 ; followed by exactly 32 hexadecimal digits (case don't care) for6117 ; the significand, followed by a 'p' or a 'P', followed by 46118 ; hexadecimals digits for the biased exponent. Significand sign6119 ; should be ored with msb of the biased exponent.6120 ; Example:6121 ; $80000000000000000000000000000000pbfff = -1.06122 ; $80000000000000000000000000000000p3fff = +1.06123 ; $00000000000000000000000000000000p0000 = +0.06124 ; Number 0.0 can be expressed either by significand=0 and/or6125 ; exponent=0.6126 ;6127 ; +0 an hexadecimal ascii string beginning with '#', followed by6128 ; exactly 32 hexadecimal digits (case don't care), seen as a packed6129 ; standard ieee quadruple format.6130 ; Example:6131 ; #bfff0000000000000000000000000000 = -1.06132 ; #3fff0000000000000000000000000000 = +1.06133 ; #00000000000000000000000000000000 = +0.06134 ;6135 ; +o a decimal ascii string, beginning with an optional single '+'6136 ; or '-' sign, followed by a decimal significand consisting of a6137 ; sequence of decimal digits optionally containing a decimal-point6138 ; character, '.'. The significand may be optionally followed by an6139 ; exponent. An exponent consists of an 'E' or 'e' followed by an6140 ; optional plus or minus sign, followed by a sequence of decimal6141 ; digits; the exponent indicates the power of 10 by which the6142 ; significand should be scaled.6143 ;6144 ; +o a string "+INF", "-INF", "+NAN", "-NAN", where the sign '+' or6145 ; '-' is optional (case don't care).6146 ;6147 ; Conversion stop at the end of the string or at the first character that6148 ; does not produce a valid digit in the given base, and tlp hold the long6149 ; pointer to this character.6150 ;6151 ;------6152 F8535E str2fp:6153 ;------6154 F8535E 85 4C sta tlp ; set long pointer to source ascii string6155 F85360 86 4D stx tlp+16156 F85362 84 4E sty tlp+261576158 ;-------6159 F85364 str2fp2:6160 ;-------6161 F85364 64 26 stz fexph ; clear exponent6162 F85366 9C 6C 68 stz fexp+16163 F85369 64 B4 stz tmdot ; count of decimal digits (after a dot)6164 F8536B 64 B5 stz tmdot+16165 F8536D 64 25 stz facst ; clear status6166 F8536F 64 24 stz facsgn ; clear signTue Jul 17 11:00:18 2018 Page 626167 F85371 64 B8 stz tmsgn ; sign&dot indicator6168 F85373 64 B9 stz tmcnt ; count of mantissa digits6169 F85375 64 BA stz tesgn ; sign&exponent indicator6170 F85377 64 BB stz tecnt ; count of exponent digit6171 F85379 20 56 4E jsr fldz ; set fac=06172 F8537C A0 00 ldy #0 ; init string pointer6173 F8537E 80 03 bra ?get06174 F85380 C8 ?nx0: iny6175 F85381 F0 69 beq ?iy ; string index overflow6176 F85383 B7 4C ?get0: lda [tlp],y ; get char6177 F85385 F0 68 beq ?eos ; end of string6178 F85387 C9 20 cmp #' '6179 F85389 F0 F5 beq ?nx0 ; skip leading blanks6180 F8538B C9 08 cmp #$086181 F8538D F0 F1 beq ?nx0 ; skip leading 'tab'6182 F8538F C9 23 cmp #'#' ; ieee packed hex. string?6183 F85391 D0 05 bne ?ckh ; no6184 F85393 20 74 55 jsr ?ieee ; convert hex. packed to float6185 F85396 80 1D bra ?ehx6186 F85398 C9 24 ?ckh: cmp #'$' ; hex. string?6187 F8539A F0 16 beq ?hex ; yes, convert ascii hex. string6188 F8539C C9 30 cmp #'0'6189 F8539E D0 1B bne ?dec ; go to decimal conversion6190 F853A0 AA tax ; save char6191 F853A1 C8 iny ; bump pointer6192 F853A2 F0 48 beq ?iy ; string index overflow6193 F853A4 B7 4C lda [tlp],y ; get char6194 F853A6 C9 78 cmp #'x' ; '0x' so hex. conversion6195 F853A8 F0 08 beq ?hex6196 F853AA C9 58 cmp #'X' ; '0X' so hex. conversion6197 F853AC F0 04 beq ?hex6198 F853AE 88 dey ; re-fetch previous char6199 F853AF 8A txa ; this is '0'6200 F853B0 80 1C bra ?dec2 ; handle decimal digit6201 F853B2 20 C9 54 ?hex: jsr ?hfp ; convert hex. string to float6202 F853B5 84 4F ?ehx: sty fpidx ; store index6203 F853B7 B8 clv ; ignore VF for hex. conversion6204 F853B8 4C 7F 54 jmp ?done62056206 ; parsing of ascii decimal string6207 F853BB C9 2B ?dec: cmp #'+'6208 F853BD F0 08 beq ?nxt ; skip '+' sign6209 F853BF C9 2D cmp #'-'6210 F853C1 D0 0B bne ?dec2 ; handle decimal digit6211 F853C3 A9 80 lda #$806212 F853C5 85 B8 sta tmsgn ; set negative sign flag6213 F853C7 C8 ?nxt: iny ; next byte6214 F853C8 F0 22 beq ?iy ; string index overflow6215 F853CA B7 4C lda [tlp],y ; get next char6216 F853CC F0 21 beq ?eos ; end of string6217 F853CE 38 ?dec2: sec6218 F853CF E9 3A sbc #'0'+106219 F853D1 18 clc6220 F853D2 69 0A adc #106221 F853D4 90 29 bcc ?ndg ; is not a digit6222 F853D6 24 BA bit tesgn ; will process exponent digits?6223 F853D8 70 09 bvs ?edec ; yesTue Jul 17 11:00:18 2018 Page 636224 F853DA E6 B9 inc tmcnt ; count of mantissa digits6225 F853DC 20 91 54 jsr ?mupd ; update mantissa (add digit)6226 F853DF 90 E6 bcc ?nxt ; next byte6227 F853E1 B0 5C bcs ?ovf ; overflow error6228 F853E3 E6 BB ?edec: inc tecnt ; process exponent digit6229 F853E5 20 AE 54 jsr ?eupd ; update exponent (add digit)6230 F853E8 90 DD bcc ?nxt ; next byte6231 F853EA B0 53 bcs ?ovf ; exponent overflow error62326233 F853EC 88 ?iy: dey ; here when index overflow6234 F853ED 80 5E bra ?nv ; invalid string62356236 ; end of string or parsing of an invalid char6237 F853EF 84 4F ?eos: sty fpidx ; store index6238 F853F1 A6 B9 ldx tmcnt6239 F853F3 F0 5A beq ?nv1 ; no mantissa digits: invalid string6240 F853F5 24 BA bit tesgn6241 F853F7 50 60 bvc ?sc ; no exponent: scale fac according decimals6242 F853F9 A6 BB ldx tecnt6243 F853FB F0 52 beq ?nv1 ; no exponent digits: invalid string6244 F853FD 80 5A bra ?sc ; scale fac according to exponent&decimals62456246 ; handle no-digit character6247 F853FF 69 30 ?ndg: adc #'0' ; restore character6248 F85401 C9 2E cmp #'.' ; check if decimal dot6249 F85403 D0 0C bne ?cke ; go to check 'e', 'E'6250 F85405 A6 B9 ldx tmcnt6251 F85407 F0 44 beq ?nv ; no mantissa digits so error6252 F85409 A9 40 lda #$40 ; test&set dot indicator6253 F8540B 04 B8 tsb tmsgn6254 F8540D D0 3E bne ?nv ; duplicate dot so error6255 F8540F 80 B6 bra ?nxt ; next byte6256 F85411 C9 45 ?cke: cmp #'E' ; check exponent6257 F85413 F0 0B beq ?cke16258 F85415 C9 65 cmp #'e'6259 F85417 F0 07 beq ?cke16260 F85419 20 F8 55 jsr ?ginf ; read INF or NAN string6261 F8541C B0 D1 bcs ?eos ; invalid string6262 F8541E 80 5F bra ?done6263 F85420 A6 B9 ?cke1: ldx tmcnt6264 F85422 F0 29 beq ?nv ; no mantissa digits so error6265 F85424 A9 40 lda #$40 ; test&set dot indicator6266 F85426 04 BA tsb tesgn6267 F85428 D0 23 bne ?nv ; duplicate 'E' so error6268 F8542A C8 iny ; get next byte6269 F8542B F0 BF beq ?iy ; string index overflow6270 F8542D B7 4C lda [tlp],y6271 F8542F F0 BE beq ?eos ; end of string6272 F85431 C9 2B cmp #'+'6273 F85433 F0 92 beq ?nxt ; skip '+' sign6274 F85435 C9 2D cmp #'-'6275 F85437 D0 95 bne ?dec2 ; process this byte6276 F85439 A9 80 lda #$806277 F8543B 04 BA tsb tesgn ; set negative exponent sign6278 F8543D 80 88 bra ?nxt ; get next byte62796280 ; mantissa or exponent overflowTue Jul 17 11:00:18 2018 Page 646281 F8543F 84 4F ?ovf: sty fpidx ; store index of last parsed byte6282 F85441 A6 B8 ldx tmsgn ; attual mantissa sign6283 F85443 86 24 stx facsgn6284 F85445 20 7D 4E jsr fldinf ; load inf because overflow6285 F85448 18 clc ; no error (string is valid)6286 F85449 E2 40 sep #PVFLAG ; VF=1 (overflow)6287 F8544B 80 32 bra ?done ; done62886289 ; duplicate dot, duplicate 'E', no valid digits: invalid string6290 F8544D 84 4F ?nv: sty fpidx6291 F8544F A6 B8 ?nv1: ldx tmsgn ; attual mantissa sign6292 F85451 86 24 stx facsgn6293 F85453 20 56 4E jsr fldz ; fac=06294 F85456 38 sec ; error: invalid string6295 F85457 80 26 bra ?done ; done62966297 ; now scale fac according to decimal digits count & exponent6298 F85459 A4 B8 ?sc: ldy tmsgn6299 F8545B 84 24 sty facsgn6300 F8545D A2 00 ldx #06301 F8545F ACC166302 F8545F C2 20 rep #PMFLAG6303 .LONGA on6304 .MNLIST6305 F85461 38 sec6306 F85462 8A txa ; change sign to decimal count6307 F85463 E5 B4 sbc tmdot6308 F85465 85 B4 sta tmdot6309 F85467 A5 26 lda fexph6310 F85469 A4 BA ldy tesgn ; check exponent sign6311 F8546B 10 04 bpl ?sc16312 F8546D 49 FF FF eor #$FFFF ; change sign to exponent6313 F85470 1A inc a6314 F85471 18 ?sc1: clc6315 F85472 65 B4 adc tmdot ; scale fac with this value6316 F85474 ACC086317 F85474 E2 20 sep #PMFLAG6318 .LONGA off6319 .MNLIST6320 F85476 20 2E 49 jsr scale106321 F85479 B8 clv ; VF=06322 F8547A 90 03 bcc ?done ; no overflow6323 F8547C 18 clc ; no error (string is valid)6324 F8547D E2 40 sep #PVFLAG ; VF=1 (overflow)6325 F8547F 08 ?done: php ; save CF&VF6326 F85480 A5 4C lda tlp6327 F85482 18 clc6328 F85483 65 4F adc fpidx6329 F85485 85 4C sta tlp6330 F85487 90 06 bcc ?rts6331 F85489 E6 4D inc tlp+16332 F8548B D0 02 bne ?rts6333 F8548D E6 4E inc tlp+26334 F8548F 28 ?rts: plp6335 F85490 60 rts63366337 ; update mantissa: fac=(fac*10)+byte (where A=byte)Tue Jul 17 11:00:18 2018 Page 656338 F85491 84 B7 ?mupd: sty tmpy ; save Y6339 F85493 85 B6 sta tmpa ; save A6340 F85495 24 B8 bit tmsgn ; digit after a decimal dot?6341 F85497 50 02 bvc ?mupd1 ; no6342 F85499 E6 B4 inc tmdot ; increment decimal count6343 F8549B 20 D1 49 ?mupd1: jsr mult10 ; fac=fac*106344 F8549E B0 0B bcs ?mupd2 ; invalid6345 F854A0 20 39 84 jsr mvftoa ; move fac to arg6346 F854A3 A5 B6 lda tmpa6347 F854A5 20 49 4F jsr fldbyt ; load byte into fac6348 F854A8 20 7D 45 jsr fpadd ; fac=(fac*10)+A6349 F854AB A4 B7 ?mupd2: ldy tmpy ; restore string index6350 F854AD 60 rts ; CF=1 if overflow63516352 ; update exponent: fexph=(10*fexph)+A6353 F854AE 85 B6 ?eupd: sta tmpa ; save byte to add6354 F854B0 64 B7 stz tmpa+1 ; high byte = 06355 F854B2 ACC166356 F854B2 C2 20 rep #PMFLAG6357 .LONGA on6358 .MNLIST6359 F854B4 A5 26 lda fexph6360 F854B6 C9 CC 0C cmp #$0CCC ; check overflow condition6361 F854B9 B0 0B bcs ?eupd1 ; limit exponent to $7FFF6362 F854BB 85 3E sta wftmp6363 F854BD 0A asl a ; mult. 106364 F854BE 0A asl a6365 F854BF 65 3E adc wftmp6366 F854C1 0A asl a6367 F854C2 65 B6 adc tmpa ; add byte6368 F854C4 85 26 sta fexph ; update exponent6369 F854C6 ?eupd1: ACC086370 F854C6 E2 20 sep #PMFLAG6371 .LONGA off6372 .MNLIST6373 F854C8 60 rts ; CF=1 if exponent overflow63746375 ; convert hexadecimal string: $xxx...xxpyyyy6376 ; where xx...xx=significand, yyyy=biased exponent6377 F854C9 20 12 55 ?hfp: jsr ?ghex ; convert hex. to fp6378 F854CC B0 50 bcs ?ghx ; error getting significand6379 F854CE A2 0F ldx #156380 F854D0 B5 00 ?hfl: lda tm,x ; move tm to facm6381 F854D2 95 12 sta facm,x6382 F854D4 CA dex6383 F854D5 10 F9 bpl ?hfl6384 F854D7 20 1F 55 jsr ?hexp ; get high exponent6385 F854DA B0 42 bcs ?ghx ; error6386 F854DC AA tax6387 F854DD 29 80 and #$806388 F854DF 85 24 sta facsgn ; sign6389 F854E1 8A txa6390 F854E2 29 7F and #$7F6391 F854E4 85 23 sta facexp+16392 F854E6 20 2C 55 jsr ?2hex ; get low exponent6393 F854E9 B0 33 bcs ?ghx ; error6394 F854EB 85 22 sta facexpTue Jul 17 11:00:18 2018 Page 666395 F854ED 20 61 55 jsr ?hsep ; check end of string6396 F854F0 B0 2C bcs ?ghx ; error6397 F854F2 64 25 stz facst6398 F854F4 20 E6 46 jsr chkz ; check if fac=06399 F854F7 24 25 bit facst6400 F854F9 70 23 bvs ?ghx ; fac=0, exit (CF=0)6401 F854FB A5 22 lda facexp6402 F854FD 05 23 ora facexp+1 ; exponent=0?6403 F854FF F0 0E beq ?hfz ; yes, set fac=06404 F85501 AA tax6405 F85502 A5 21 lda facm+156406 F85504 30 06 bmi ?hf3 ; normal6407 F85506 E0 01 cpx #1 ; subnormal should have exponent=16408 F85508 D0 68 bne ?1hex4 ; invalid string6409 F8550A 18 clc6410 F8550B 60 rts6411 F8550C 4C DC 55 ?hf3: jmp ?htst ; test inf/nan6412 F8550F 4C 56 4E ?hfz: jmp fldz6413 F855126414 F85512 A2 0F ?ghex: ldx #15 ; get 128 bits hex6415 F85514 20 2C 55 ?ghl: jsr ?2hex6416 F85517 B0 05 bcs ?ghx ; error6417 F85519 95 00 sta tm,x ; store (high-to-low order)6418 F8551B CA dex6419 F8551C 10 F6 bpl ?ghl6420 F8551E 60 ?ghx: rts ; CF=0 if no error64216422 F8551F C8 ?hexp: iny ; get 'p' biased high exponent6423 F85520 F0 4F beq ?1hex3 ; string index overflow6424 F85522 B7 4C lda [tlp],y ; get next char6425 F85524 C9 70 cmp #'p' ; exponent indicator6426 F85526 F0 04 beq ?2hex ; ok6427 F85528 C9 50 cmp #'P'6428 F8552A D0 46 bne ?1hex4 ; invalid string64296430 F8552C 20 3F 55 ?2hex: jsr ?1hex ; convert two digits at time6431 F8552F B0 ED bcs ?ghx ; error6432 F85531 0A asl a ; high nibble6433 F85532 0A asl a6434 F85533 0A asl a6435 F85534 0A asl a6436 F85535 85 3E sta wftmp6437 F85537 20 3F 55 jsr ?1hex ; get low nibble6438 F8553A B0 E2 bcs ?ghx ; error6439 F8553C 05 3E ora wftmp ; concatenate high & low nibble6440 F8553E 60 rts ; CF=0, no error64416442 F8553F C8 ?1hex: iny ; convert one hex. digit6443 F85540 F0 2F beq ?1hex3 ; string index overflow6444 F85542 B7 4C lda [tlp],y ; get next char6445 F85544 F0 2C beq ?1hex4 ; premature end of string6446 F85546 C9 61 cmp #'a' ; convert one hex digit6447 F85548 90 02 bcc ?1hex16448 F8554A E9 20 sbc #$20 ; capitalize 'a', 'b',...6449 F8554C 38 ?1hex1: sec6450 F8554D E9 3A sbc #('0'+10) ; check digits '0'..'9'6451 F8554F 18 clcTue Jul 17 11:00:18 2018 Page 676452 F85550 69 0A adc #106453 F85552 B0 09 bcs ?1hex2 ; ok, valid hex. digit6454 F85554 E9 16 sbc #(6+16) ; check 'A'..'F'6455 F85556 18 clc6456 F85557 69 06 adc #66457 F85559 90 17 bcc ?1hex4 ; no hex digit: error6458 F8555B 69 09 adc #9 ; valid hex. digit6459 F8555D 29 0F ?1hex2: and #$0F ; mask low nibble6460 F8555F 18 ?hxok: clc ; digit ok6461 F85560 60 rts6462 F85561 C8 ?hsep: iny ; check valid separator at the end of string6463 F85562 F0 0D beq ?1hex3 ; string index overflow6464 F85564 B7 4C lda [tlp],y ; get next char6465 F85566 F0 F7 beq ?hxok ; ok, end of string6466 F85568 C9 20 cmp #' ' ; should be a separator6467 F8556A F0 F3 beq ?hxok ; blank6468 F8556C C9 08 cmp #$086469 F8556E F0 EF beq ?hxok ; tab6470 F85570 C8 iny ; invalid string6471 F85571 88 ?1hex3: dey ; string too long6472 F85572 38 ?1hex4: sec ; error6473 F85573 60 rts64746475 F85574 20 12 55 ?ieee: jsr ?ghex ; convert hex. to fp6476 F85577 B0 A5 bcs ?ghx ; error getting significand6477 F85579 20 61 55 jsr ?hsep ; check end of string6478 F8557C B0 A0 bcs ?ghx ; error6479 F8557E A5 0F lda tm+156480 F85580 AA tax6481 F85581 29 80 and #$806482 F85583 85 24 sta facsgn ; sign6483 F85585 8A txa6484 F85586 29 7F and #$7F6485 F85588 85 23 sta facexp+16486 F8558A A5 0E lda tm+146487 F8558C 85 22 sta facexp6488 F8558E 38 sec ; hidden bit6489 F8558F 05 23 ora facexp+16490 F85591 D0 04 bne ?ie1 ; normal: hidden bit=16491 F85593 18 clc ; subnormal: hidden bit=06492 F85594 1A inc a6493 F85595 85 22 sta facexp ; subnormal have biased exponent=16494 F85597 ?ie1: ACC166495 F85597 C2 20 rep #PMFLAG6496 .LONGA on6497 .MNLIST6498 F85599 A5 0C lda tm+126499 F8559B 6A ror a ; rotate in hidden bit6500 F8559C 85 20 sta facm+146501 F8559E A5 0A lda tm+106502 F855A0 6A ror a6503 F855A1 85 1E sta facm+126504 F855A3 A5 08 lda tm+86505 F855A5 6A ror a6506 F855A6 85 1C sta facm+106507 F855A8 A5 06 lda tm+66508 F855AA 6A ror aTue Jul 17 11:00:18 2018 Page 686509 F855AB 85 1A sta facm+86510 F855AD A5 04 lda tm+46511 F855AF 6A ror a6512 F855B0 85 18 sta facm+66513 F855B2 A5 02 lda tm+26514 F855B4 6A ror a6515 F855B5 85 16 sta facm+46516 F855B7 A5 00 lda tm6517 F855B9 6A ror a6518 F855BA 85 14 sta facm+26519 F855BC A9 00 00 lda #0 ; significand lsb6520 F855BF 6A ror a6521 F855C0 85 12 sta facm6522 F855C2 05 14 ora facm+2 ; check if zero6523 F855C4 05 16 ora facm+46524 F855C6 05 18 ora facm+66525 F855C8 05 1A ora facm+86526 F855CA 05 1C ora facm+106527 F855CC 05 1E ora facm+126528 F855CE 05 20 ora facm+146529 F855D0 D0 0A bne ?htst6530 F855D2 85 22 sta facexp ; fac = 06531 F855D4 ACC086532 F855D4 E2 20 sep #PMFLAG6533 .LONGA off6534 .MNLIST6535 F855D6 A9 40 lda #$406536 F855D8 85 25 sta facst6537 F855DA 18 clc6538 F855DB 60 rts6539 F855DC ?htst: ACC16 ; test inf/nan6540 F855DC C2 20 rep #PMFLAG6541 .LONGA on6542 .MNLIST6543 F855DE A2 00 ldx #06544 F855E0 A5 22 lda facexp6545 F855E2 C9 FF 7F cmp #INFEXP6546 F855E5 90 0B bcc ?ie2 ; valid float6547 F855E7 A2 C0 ldx #$C0 ; assume inf6548 F855E9 A5 20 lda facm+14 ; check type6549 F855EB C9 00 80 cmp #INFSND6550 F855EE F0 02 beq ?ie2 ; set inf in fac stastus6551 F855F0 A2 80 ldx #$80 ; set nan in fac status6552 F855F2 86 25 ?ie2: stx facst6553 F855F4 ACC086554 F855F4 E2 20 sep #PMFLAG6555 .LONGA off6556 .MNLIST6557 F855F6 18 clc6558 F855F7 60 rts65596560 F855F8 C9 49 ?ginf: cmp #'I'6561 F855FA F0 0E beq ?inf6562 F855FC C9 69 cmp #'i'6563 F855FE F0 0A beq ?inf6564 F85600 C9 4E cmp #'N'6565 F85602 F0 35 beq ?nanTue Jul 17 11:00:18 2018 Page 696566 F85604 C9 6E cmp #'n'6567 F85606 F0 31 beq ?nan6568 F85608 38 sec ; invalid string6569 F85609 60 rts6570 F8560A C8 ?inf: iny6571 F8560B F0 29 beq ?inf3 ; string index overflow6572 F8560D B7 4C lda [tlp],y ; get next char6573 F8560F F0 26 beq ?inf4 ; end of string6574 F85611 09 20 ora #$206575 F85613 C9 6E cmp #'n'6576 F85615 D0 20 bne ?inf46577 F85617 C8 iny6578 F85618 F0 1C beq ?inf3 ; string index overflow6579 F8561A B7 4C lda [tlp],y ; get next char6580 F8561C F0 19 beq ?inf4 ; end of string6581 F8561E 09 20 ora #$206582 F85620 C9 66 cmp #'f'6583 F85622 D0 13 bne ?inf46584 F85624 20 61 55 jsr ?hsep ; terminator or separator6585 F85627 B0 0F bcs ?inf56586 F85629 84 4F sty fpidx6587 F8562B 20 7D 4E jsr fldinf6588 F8562E 18 ?inf0: clc6589 F8562F A5 B8 lda tmsgn6590 F85631 85 24 sta facsgn6591 F85633 E2 40 sep #PVFLAG6592 F85635 60 rts6593 F85636 88 ?inf3: dey ; string too long6594 F85637 38 ?inf4: sec ; error6595 F85638 60 ?inf5: rts65966597 F85639 C8 ?nan: iny6598 F8563A F0 FA beq ?inf3 ; string index overflow6599 F8563C B7 4C lda [tlp],y ; get next char6600 F8563E F0 F7 beq ?inf4 ; end of string6601 F85640 09 20 ora #$206602 F85642 C9 61 cmp #'a'6603 F85644 D0 F1 bne ?inf46604 F85646 C8 iny6605 F85647 F0 ED beq ?inf3 ; string index overflow6606 F85649 B7 4C lda [tlp],y ; get next char6607 F8564B F0 EA beq ?inf4 ; end of string6608 F8564D 09 20 ora #$206609 F8564F C9 6E cmp #'n'6610 F85651 D0 E4 bne ?inf46611 F85653 20 61 55 jsr ?hsep ; terminator or separator6612 F85656 B0 E0 bcs ?inf56613 F85658 84 4F sty fpidx6614 F8565A 20 74 4E jsr fldnan6615 F8565D 80 CF bra ?inf06616 F8565F6617 ;---------------------------------------------------------------------------6618 ; conversion from binary to decimal6619 ;---------------------------------------------------------------------------66206621 ; int2str - convert an integer to asciiz string (decimal or hexadecimal)6622 ;Tue Jul 17 11:00:18 2018 Page 706623 ; This routine is intended to format a string used by sprintf()-like function,6624 ; but can be used in stand-alone mode too.6625 ;6626 ; entry:6627 ; facm = integer (1, 2, 4, 8, 16 bytes)6628 ;6629 ; A = additional formattation flags6630 ; <7>: alternate format6631 ; <6>: group thousands6632 ; <1>: emit a sign '+' rather than a blank (if bit0=1)6633 ; <0>: take account of bit 1, otherwise no '+'/blank emitted6634 ;6635 ; Y = format: x,X,p,P,d6636 ;6637 ; X = precision (minimum number of digits)6638 ;6639 ; exit:6640 ; X = pointer to ascii buffer6641 ; Y = size of buffer6642 ;6643 ; The integer parameter stored in facm will be converted, according to the6644 ; format specifier and the requested precision, formatting the output ascii6645 ; string null-terminated:6646 ;6647 ; p,P format: the integer is interpreted as long pointer (24 bits) and6648 ; formatted as 6 hexadecimal digits prepended by '$' or by6649 ; '0x' or '0X' if alternate format was specified.6650 ; Precision ignored.6651 ;6652 ; x,X format: the integer is converted as unsigned and formatted as6653 ; sequence of hexadecimal digits prepended by '$' or by6654 ; '0x' or '0X' if alternate format was specified.6655 ;6656 ; d format: the integer is converted according to the status byte6657 ; (facst) either as signed or unsigned integer, and6658 ; formatted as sequence of decimal digits.6659 ; If bit 6 of flags is 1, thousands are grouped6660 ; 3 digits by 3 digits, separated by a comma.6661 ;6662 ; The precision, if any, gives the minimum number of digits that must appear;6663 ; if the converted value requires fewer digits, it is padded on the left6664 ; with zeros (precision is ignored for pP format).6665 ;6666 ;-------6667 F8565F int2str:6668 ;-------6669 F8565F 85 CF sta fpaltf ; alternate flag format6670 F85661 98 tya ; A=format char6671 F85662 A0 00 ldy #0 ; upper case6672 F85664 C9 61 cmp #'a'6673 F85666 90 08 bcc ?nc6674 F85668 C9 7B cmp #'z'+16675 F8566A B0 04 bcs ?nc6676 F8566C 29 DF and #$DF ; capitalize6677 F8566E A0 20 ldy #$20 ; lower case6678 F85670 84 D0 ?nc: sty fpcap6679 F85672 C9 50 cmp #'P'Tue Jul 17 11:00:18 2018 Page 716680 F85674 F0 0A beq ?stf6681 F85676 C9 58 cmp #'X'6682 F85678 F0 06 beq ?stf6683 F8567A C9 44 cmp #'D'6684 F8567C F0 02 beq ?stf6685 F8567E A9 44 lda #'D' ; force 'D' format if unknow one6686 F85680 85 CE ?stf: sta fpfmt ; format style6687 F85682 E0 50 cpx #XCVTMAX ; limit the precision to the buffer size6688 F85684 90 02 bcc ?pr16689 F85686 A2 50 ldx #XCVTMAX6690 F85688 C9 50 ?pr1: cmp #'P' ; 'P' format?6691 F8568A D0 02 bne ?pr26692 F8568C A2 06 ldx #6 ; fixed precision = 6 for 'P' format6693 F8568E 86 CC ?pr2: stx fpprec ; store wanted precision6694 F85690 C9 44 cmp #'D'6695 F85692 F0 24 beq ?dec ; decimal conversion6696 F85694 A9 06 lda #$06 ; value to add for digits A..F6697 F85696 05 D0 ora fpcap6698 F85698 85 3E sta wftmp6699 F8569A A9 7F lda #$7F ; ignore all format bits but bit 76700 F8569C 14 CF trb fpaltf6701 F8569E A2 0F ldx #15 ; counter6702 F856A0 A0 00 ldy #06703 F856A2 B5 12 ?hex: lda facm,x6704 F856A4 20 74 5A jsr b2hex ; convert to hexadecimal6705 F856A7 99 50 3F sta !P0FPU+fpstr,y ; store high digit6706 F856AA C8 iny6707 F856AB EB xba6708 F856AC 99 50 3F sta !P0FPU+fpstr,y ; store low digit6709 F856AF C8 iny6710 F856B0 CA dex6711 F856B1 10 EF bpl ?hex6712 F856B3 BB tyx6713 F856B4 74 50 stz fpstr,x ; put terminator6714 F856B6 80 03 bra ?fmt ; final formattation6715 F856B8 20 64 5B ?dec: jsr int2dec ; convert to decimal6716 F856BB A2 50 ?fmt: ldx #fpstr ; get pointer to first and last digits6717 F856BD 20 40 57 jsr ?frst ; X -> first, Y->last, A=size6718 F856C0 20 1B 57 jsr ?thg ; move (and group) to the xcvt6719 F856C3 BB tyx ; X = pointer to fisrt significative digit6720 F856C4 85 3E sta wftmp ; A = size of significative string6721 F856C6 A5 CC lda fpprec6722 F856C8 38 sec6723 F856C9 E5 3E sbc wftmp6724 F856CB F0 0C beq ?nop ; no padding needs6725 F856CD 90 0A bcc ?nop ; no padding needs6726 F856CF A0 30 ldy #'0'6727 F856D1 CA ?pad: dex6728 F856D2 94 00 sty <0,x ; padding string with '0'6729 F856D4 3A dec a6730 F856D5 D0 FA bne ?pad6731 F856D7 A5 CC lda fpprec6732 F856D9 A8 ?nop: tay ; Y = string size6733 F856DA A5 CE lda fpfmt6734 F856DC C9 44 cmp #'D'6735 F856DE F0 1D beq ?sts ; decimal formattation6736 F856E0 C9 50 cmp #'P'Tue Jul 17 11:00:18 2018 Page 726737 F856E2 D0 02 bne ?hx06738 F856E4 A2 C5 ldx #XCVTEND-66739 F856E6 24 CF ?hx0: bit fpaltf6740 F856E8 10 0C bpl ?hx1 ; '$' prefix6741 F856EA CA dex6742 F856EB A9 58 lda #'X'6743 F856ED 05 D0 ora fpcap ; add lower case6744 F856EF 95 00 sta <0,x6745 F856F1 C8 iny ; update size6746 F856F2 A9 30 lda #'0' ; '0x' or '0X' prefix6747 F856F4 80 02 bra ?hx26748 F856F6 A9 24 ?hx1: lda #'$'6749 F856F8 CA ?hx2: dex6750 F856F9 95 00 sta <0,x6751 F856FB C8 iny ; update size6752 F856FC 60 rts6753 F856FD 84 4F ?sts: sty fpidx ; store sign according format flags6754 F856FF 24 4A bit dsgn ; sign test6755 F85701 10 04 bpl ?sts1 ; positive6756 F85703 A0 2D ldy #'-' ; negative: store sign '-'6757 F85705 80 0C bra ?sts26758 F85707 A5 CF ?sts1: lda fpaltf ; check if should store sign/blank6759 F85709 4A lsr a ; fpaltf<0>: 1 if should store6760 F8570A 90 0C bcc ?done ; no store6761 F8570C A0 2B ldy #'+'6762 F8570E 4A lsr a ; fpaltf<1>: 1 if should store blank6763 F8570F B0 02 bcs ?sts2 ; store '+' sign6764 F85711 A0 20 ldy #' ' ; store blank6765 F85713 CA ?sts2: dex6766 F85714 94 00 sty <0,x6767 F85716 E6 4F inc fpidx6768 F85718 A4 4F ?done: ldy fpidx6769 F8571A 60 rts67706771 ; move digits from fpstr buffer to xcvt buffer and6772 ; group the digits in thousands (use comma as separator)6773 ; on entry: Y = index of first significative digit on fpstr6774 ; X = pointer to last digit on fpstr6775 ; on exit: Y = pointer to first significative digit6776 ; A = size of string6777 ; X = pointer to last digit6778 F8571B 84 3E ?thg: sty wftmp ; index of first significative digit6779 F8571D 9B txy ; Y = pointer to last digit6780 F8571E A2 CB ldx #XCVTEND ; X = pointer to end of xcvt buffer6781 F85720 74 00 stz <0,x ; put string terminator6782 F85722 CA dex ; bump pointer6783 F85723 A9 03 ?thg2: lda #3 ; goups 3 digits6784 F85725 EB ?thg4: xba ; B = digits counter6785 F85726 B9 00 3F lda !P0FPU,y ; A = current digit6786 F85729 95 00 sta <0,x ; move digit6787 F8572B 88 dey6788 F8572C C4 3E cpy wftmp ; finish?6789 F8572E 90 10 bcc ?frst ; yes6790 F85730 EB xba ; A = digits counter6791 F85731 CA dex6792 F85732 3A dec a6793 F85733 D0 F0 bne ?thg4 ; groups 3 digitsTue Jul 17 11:00:18 2018 Page 736794 F85735 24 CF bit fpaltf ; check if should groups thousands6795 F85737 50 EA bvc ?thg2 ; no groups6796 F85739 A9 2C lda #',' ; thousands separator6797 F8573B 95 00 sta <0,x6798 F8573D CA dex6799 F8573E 80 E3 bra ?thg2 ; repeat until end of source string68006801 ; get the pointer to first significative digit (not '0')6802 ; on entry: X = pointer to first digit6803 ; on exit: Y = pointer to first significative digit6804 ; A = size of string6805 ; X = pointer to last digit6806 F85740 86 3F ?frst: stx wftmp+16807 F85742 B5 00 ?fr0: lda <0,x6808 F85744 F0 07 beq ?fr1 ; end of string6809 F85746 C9 30 cmp #'0'6810 F85748 D0 04 bne ?fr2 ; first significative digit6811 F8574A E8 inx6812 F8574B 80 F5 bra ?fr0 ; search again6813 F8574D CA ?fr1: dex ; X = pointer to last digit6814 F8574E 9B ?fr2: txy ; Y = pointer to first significative digit6815 F8574F A6 3F ldx wftmp+1 ; start of string6816 F85751 B5 00 ?fr3: lda <0,x ; search end of string6817 F85753 F0 03 beq ?fr46818 F85755 E8 inx6819 F85756 80 F9 bra ?fr36820 F85758 CA ?fr4: dex ; X = pointer to last digit6821 F85759 8A txa6822 F8575A 84 3E sty wftmp6823 F8575C 38 sec6824 F8575D E5 3E sbc wftmp6825 F8575F 1A inc a ; significative string size6826 F85760 60 rts68276828 ; fp2str - convert a quadruple precision floating point to asciiz string6829 ;6830 ; This routine is intended to format a string used by sprintf()-like function,6831 ; but can be used in stand-alone mode too.6832 ;6833 ; entry:6834 ; fac = floating point argument6835 ;6836 ; A = additional formattation flags6837 ; <7>: alternate format6838 ; <6>: not discriminate +0.0 from -0.06839 ; <1>: emit a sign '+' rather than a blank (if bit0=1)6840 ; <0>: take account of bit 1, otherwise no '+'/blank emitted6841 ;6842 ; Y = format: e,E,f,F,g,G,a,A,k,K6843 ;6844 ; X = precision/count of decimal digits (after the '.')6845 ;6846 ; exit:6847 ; X = pointer to ascii buffer6848 ; Y = size of buffer6849 ;6850 ; The formatted decimal string is either the f/F format:Tue Jul 17 11:00:18 2018 Page 746851 ; [sign]ddd.ddd6852 ; or the e/E format:6853 ; [sign]d.ddde+|-[d][d]dd6854 ; where the number of digits after the decimal-point character is equal to6855 ; precision specification. The exponent in E format always contains at least6856 ; two digits; if the value is zero, the exponent is 00.6857 ; In the G format, precision specifies the number of significant digits: if6858 ; it is zero, is teeated as 1. G format can format decimal string in E style6859 ; or F style: style E is used if the exponent from its conversion is less6860 ; than MINGEXP or greater than or equal to the precision.6861 ; Trailing decimal points are usually suppressed, as also are trailing6862 ; fraction zeroes in the G/g format. If bit 7 of additional flag is 16863 ; then trailing decimal dot remain, and G/g format will not trim zeroes.6864 ; The format a/A format an hexadecimal string that contain 32 hexadecimal6865 ; digits (the content of the 128 bits mantissa), followed by the biased6866 ; exponent (introduced by literal 'p' or 'P'), or-ed at bit 15 with sign of6867 ; the float. Hexadecimal string is prepended either by '$' or '0x' or '0X'.6868 ; The no-standard format k/K format an hexadecimal string that contain the 326869 ; hexadecimal digits of the packed float (ieee format).6870 ; Hexadecimal string is prepended by '#'.6871 ;6872 ; The result formatted string can have at max. XCVTMAX characters: if the6873 ; requested format & precision cannot fit into this limit, the format is6874 ; switched to 'E' and limited in size.6875 ;6876 ;------6877 F85761 fp2str:6878 ;------6879 F85761 85 CF sta fpaltf ; alternate flag format6880 F85763 64 D1 stz fpstyle ; assume 'E' style6881 F85765 98 tya ; A=format char6882 F85766 A0 00 ldy #0 ; upper case6883 F85768 C9 61 cmp #'a'6884 F8576A 90 08 bcc ?nc6885 F8576C C9 7B cmp #'z'+16886 F8576E B0 04 bcs ?nc6887 F85770 29 DF and #$DF ; capitalize6888 F85772 A0 20 ldy #$20 ; lower case6889 F85774 84 D0 ?nc: sty fpcap6890 F85776 C9 45 cmp #'E'6891 F85778 F0 0E beq ?stf6892 F8577A C9 46 cmp #'F'6893 F8577C F0 0A beq ?stf6894 F8577E C9 41 cmp #'A'6895 F85780 F0 06 beq ?stf6896 F85782 C9 4B cmp #'K'6897 F85784 F0 02 beq ?stf6898 F85786 A9 47 lda #'G' ; force 'G' format if unknow one6899 F85788 85 CE ?stf: sta fpfmt ; format style6900 F8578A E0 50 cpx #XCVTMAX ; limit the precision to the buffer size6901 F8578C 90 02 bcc ?pr16902 F8578E A2 50 ldx #XCVTMAX6903 F85790 C9 47 ?pr1: cmp #'G' ; 'G' format?6904 F85792 D0 05 bne ?pr2 ; no6905 F85794 9B txy ; if precision=0 and 'G' format...6906 F85795 F0 06 beq ?pr3 ; ...then set precision=16907 F85797 D0 05 bne ?pr4 ; significant digits for 'G' formatTue Jul 17 11:00:18 2018 Page 756908 F85799 C9 45 ?pr2: cmp #'E' ; 'E' format?6909 F8579B D0 01 bne ?pr4 ; no6910 F8579D E8 ?pr3: inx ; 'E' format need one digit more6911 F8579E 86 CC ?pr4: stx fpprec ; store wanted precision6912 F857A0 64 CD stz fpprec+1 ; extend precision P to 16 bits69136914 ; P=fpprec specifies significant digits for 'E' & 'G' format,6915 ; and digit counts of fractional part for 'F' format6916 F857A26917 F857A2 C9 41 cmp #'A' ; 'A' format?6918 F857A4 D0 5B bne ?kfmt ; no6919 F857A66920 ; format floating point as hexadecimal full mantissa6921 ; plus biased exponent (or-ed with mantissa sign)6922 F857A6 A0 00 ldy #0 ; string index6923 F857A8 24 CF bit fpaltf6924 F857AA 10 0C bpl ?a1 ; '$' prfix6925 F857AC A2 30 ldx #'0' ; '0x' or '0X' prefix6926 F857AE 96 78 stx xcvt,y6927 F857B0 C8 iny6928 F857B1 A9 58 lda #'X'6929 F857B3 05 D0 ora fpcap ; add lower case6930 F857B5 AA tax6931 F857B6 80 02 bra ?a26932 F857B8 A2 24 ?a1: ldx #'$'6933 F857BA 96 78 ?a2: stx xcvt,y6934 F857BC C8 iny6935 F857BD A9 06 lda #$06 ; value to add for digits A..F6936 F857BF 05 D0 ora fpcap6937 F857C1 85 3E sta wftmp6938 F857C3 A2 0F ldx #15 ; counter6939 F857C5 B5 12 ?a4: lda facm,x6940 F857C7 20 74 5A jsr b2hex ; convert6941 F857CA 99 78 3F sta !P0FPU+xcvt,y ; store high digit6942 F857CD C8 iny6943 F857CE EB xba6944 F857CF 99 78 3F sta !P0FPU+xcvt,y ; store low digit6945 F857D2 C8 iny6946 F857D3 CA dex6947 F857D4 10 EF bpl ?a46948 F857D6 A9 50 lda #'P' ; exponent separator6949 F857D8 05 D0 ora fpcap6950 F857DA AA tax6951 F857DB 96 78 stx xcvt,y6952 F857DD C8 iny6953 F857DE A5 24 lda facsgn6954 F857E0 29 80 and #$80 ; mask sign6955 F857E2 05 23 ora facexp+16956 F857E4 20 74 5A jsr b2hex ; convert high exponent + sign6957 F857E7 99 78 3F sta !P0FPU+xcvt,y ; store high digit6958 F857EA C8 iny6959 F857EB EB xba6960 F857EC 99 78 3F sta !P0FPU+xcvt,y ; store low digit6961 F857EF C8 iny6962 F857F0 A5 22 lda facexp6963 F857F2 20 74 5A jsr b2hex ; convert low exponent6964 F857F5 99 78 3F sta !P0FPU+xcvt,y ; store high digitTue Jul 17 11:00:18 2018 Page 766965 F857F8 C8 iny6966 F857F9 EB xba6967 F857FA 99 78 3F sta !P0FPU+xcvt,y ; store low digit6968 F857FD C8 iny6969 F857FE 4C A7 58 jmp ?done69706971 F85801 C9 4B ?kfmt cmp #'K' ; packed format?6972 F85803 D0 2B bne ?cvt ; no6973 F85805 A9 00 lda #tm6974 F85807 A2 3F ldx #>P0FPU6975 F85809 A0 00 ldy #06976 F8580B 20 54 4D jsr fpack ; pack to tm..tm+156977 F8580E A0 00 ldy #06978 F85810 A2 23 ldx #'#'6979 F85812 96 78 stx xcvt,y6980 F85814 C8 iny6981 F85815 A9 06 lda #$06 ; value to add for digits A..F6982 F85817 05 D0 ora fpcap6983 F85819 85 3E sta wftmp6984 F8581B A2 0F ldx #15 ; counter6985 F8581D B5 00 ?kl: lda tm,x6986 F8581F 20 74 5A jsr b2hex ; convert6987 F85822 99 78 3F sta !P0FPU+xcvt,y ; store high digit6988 F85825 C8 iny6989 F85826 EB xba6990 F85827 99 78 3F sta !P0FPU+xcvt,y ; store low digit6991 F8582A C8 iny6992 F8582B CA dex6993 F8582C 10 EF bpl ?kl6994 F8582E 80 77 bra ?done6995 F858306996 ; The basic conversion to a decimal string is done by fp2dec,6997 ; with this function responsible for "customizing" the simple6998 ; format which fp2dec returns.6999 F85830 20 89 5A ?cvt: jsr fp2dec ; let E=dexp=decimal exponent7000 F85833 24 25 bit facst ; fac is valid?7001 F85835 10 14 bpl ?vf ; yes7002 F85837 20 E0 59 jsr ?sts ; store sign7003 F8583A A2 00 ldx #0 ; store string NAN or INF7004 F8583C B5 50 ?inv: lda fpstr,x7005 F8583E 05 D0 ora fpcap ; add lower case7006 F85840 99 78 3F sta !P0FPU+xcvt,y ; store7007 F85843 C8 iny7008 F85844 E8 inx7009 F85845 E0 03 cpx #37010 F85847 90 F3 bcc ?inv7011 F85849 80 5C bra ?done ; done7012 F8584B 20 FA 59 ?vf: jsr ?round10 ; round up decimal number7013 F8584E7014 ; Now that we have the basic string, decide what format the caller7015 ; wants it to be put into. Use the F format if either of the7016 ; following is true:7017 ; o+ the format is 'f' or 'F'7018 ; o+ the format is 'g' or 'G' and the exponent7019 ; is between MINGEXP and precision (fpprec)7020 ; and if overall digits count is less than XCVTMAX.7021 F8584E A5 CE lda fpfmtTue Jul 17 11:00:18 2018 Page 777022 F85850 C9 45 cmp #'E'7023 F85852 F0 42 beq ?end2 ; caller wants 'E' format7024 F85854 C9 47 cmp #'G'7025 F85856 ACC16CLC7026 F85856 C2 21 rep #(PMFLAG.OR.PCFLAG)7027 .LONGA on7028 .MNLIST7029 F85858 D0 1C bne ?ff ; caller wants 'F' format7030 F8585A A5 48 lda dexp ; if E < 0...7031 F8585C 30 08 bmi ?g1 ; ...compare vs. MINGEXP7032 F8585E C5 CC cmp fpprec ; ...else compare with P7033 F85860 B0 32 bcs ?end ; if E >= P select 'E' style7034 F85862 A5 CC lda fpprec ; 'G' format, E>=0: overall digits count = P7035 F85864 80 0C bra ?g27036 F85866 C9 FC FF ?g1: cmp #MINGEXP7037 F85869 90 29 bcc ?end ; if E < MINGEXP select 'E' style7038 F8586B 49 FF FF eor #$FFFF ; complement decimal exponent7039 F8586E 1A inc a7040 F8586F 18 clc7041 F85870 65 CC adc fpprec ; 'G' format, E<0...7042 F85872 85 3E ?g2: sta wftmp ; ...overall digits count = |E|+P7043 F85874 80 0B bra ?f27044 F85876 A5 CC ?ff: lda fpprec ; 'F' format: P = P + 17045 F85878 1A inc a7046 F85879 A6 49 ldx dexp+17047 F8587B 30 02 bmi ?f1 ; 'F', E<0: overall digits count = P+17048 F8587D 65 48 adc dexp ; 'F', E>=0: overall digits count = E+P+17049 F8587F 85 3E ?f1: sta wftmp7050 F85881 C9 50 00 ?f2: cmp #XCVTMAX ; fit into buffer?7051 F85884 ACC087052 F85884 E2 20 sep #PMFLAG7053 .LONGA off7054 .MNLIST7055 F85886 90 06 bcc ?f3 ; yes7056 F85888 A9 24 lda #MAXDIGITS7057 F8588A 85 CC sta fpprec7058 F8588C B0 08 bcs ?end2 ; force 'E' style7059 F8588E A2 80 ?f3: ldx #$807060 F85890 86 D1 stx fpstyle ; select 'F' style7061 F85892 80 02 bra ?end27062 F85894 ?end: ACC087063 F85894 E2 20 sep #PMFLAG7064 .LONGA off7065 .MNLIST7066 F85896 20 E0 59 ?end2: jsr ?sts ; emit sign7067 F85899 84 4F sty fpidx ; index of the first digit7068 F8589B 24 D1 bit fpstyle ; 'F' format?7069 F8589D 10 05 bpl ?ee ; no, 'E' format7070 F8589F 20 AE 58 jsr ?ffmt7071 F858A2 80 03 bra ?done7072 F858A4 20 33 59 ?ee: jsr ?efmt7073 F858A7 A2 00 ?done: ldx #07074 F858A9 96 78 stx xcvt,y7075 F858AB A2 78 ldx #xcvt7076 F858AD 60 rts70777078 ; If E<0, the 'F' format place a digit '0' followed by a decimal dot,Tue Jul 17 11:00:18 2018 Page 787079 ; followed by |E|-1 leading zeroes. After, place all needs significant7080 ; digits.7081 F858AE 64 4B ?ffmt: stz fpdot7082 F858B0 A5 48 lda dexp ; exponent E7083 F858B2 10 1A bpl ?ffp ; E>=07084 F858B4 A2 30 ldx #'0'7085 F858B6 96 78 stx xcvt,y7086 F858B8 C8 iny7087 F858B9 A2 2E ldx #'.'7088 F858BB 96 78 stx xcvt,y7089 F858BD C8 iny7090 F858BE C6 3E dec wftmp ; update digits count7091 F858C0 C6 4B dec fpdot ; decimal dot indicatr7092 F858C2 A2 30 ldx #'0'7093 F858C4 1A ?ff0: inc a7094 F858C5 F0 08 beq ?ffr ; when E=0 put significant...7095 F858C7 96 78 stx xcvt,y ; put leading zeroes...7096 F858C9 C8 iny7097 F858CA C6 3E dec wftmp7098 F858CC 80 F6 bra ?ff0 ; ...until E=07099 F858CE 1A ?ffp: inc a ; we increment exponent for easily manage '.'7100 F858CF A2 00 ?ffr: ldx #0 ; index7101 F858D1 85 46 sta scexp ; save current exponent7102 F858D37103 ; Now write the regular digits, inserting a '.' if it is somewhere7104 ; in the middle of the numeral.7105 F858D3 B5 50 ?ffl: lda fpstr,x ; regular digit7106 F858D5 F0 15 beq ?ff2 ; end7107 F858D7 99 78 3F sta !P0FPU+xcvt,y ; store digit7108 F858DA C8 iny7109 F858DB E8 inx7110 F858DC C6 3E dec wftmp7111 F858DE C6 46 dec scexp7112 F858E0 D0 F1 bne ?ffl ; loop until last digit or E=07113 F858E2 A9 2E lda #'.'7114 F858E4 99 78 3F sta !P0FPU+xcvt,y ; store '.'7115 F858E7 C8 iny7116 F858E8 C6 4B dec fpdot ; decimal dot indicatr7117 F858EA 80 E7 bra ?ffl7118 F858EC A6 48 ?ff2: ldx dexp7119 F858EE 30 19 bmi ?ff4 ; 0.dddd... form7120 F858F0 24 4B bit fpdot7121 F858F2 30 15 bmi ?ff4 ; no more integral digits7122 F858F4 A5 46 lda scexp ; ddd.ddd... form7123 F858F6 F0 11 beq ?ff4 ; no more integral digits7124 F858F8 A2 30 ldx #'0' ; must complete an integral number padding it..7125 F858FA 96 78 ?ff3: stx xcvt,y ; ...with zeroes7126 F858FC C8 iny7127 F858FD C6 3E dec wftmp7128 F858FF 3A dec a7129 F85900 D0 F8 bne ?ff37130 F85902 A2 2E ldx #'.' ; put in a trailing decimal dot7131 F85904 96 78 stx xcvt,y7132 F85906 C8 iny7133 F85907 C6 4B dec fpdot ; decimal dot indicator7134 F85909 A5 CE ?ff4: lda fpfmt7135 F8590B C9 47 cmp #'G' ; 'G' format remove trailing zeroes...Tue Jul 17 11:00:18 2018 Page 797136 F8590D D0 0B bne ?ff57137 F8590F 24 CF bit fpaltf ; ...if not alternate format7138 F85911 30 07 bmi ?ff57139 F85913 24 4B bit fpdot ; ...and if was putted in a decimal dot7140 F85915 10 03 bpl ?ff57141 F85917 4C CF 59 jmp ?trim ; trim trailing zeroes7142 F8591A A5 3E ?ff5: lda wftmp ; pad string with '0'7143 F8591C F0 08 beq ?ff77144 F8591E A2 30 ldx #'0'7145 F85920 96 78 ?ff6: stx xcvt,y7146 F85922 C8 iny7147 F85923 3A dec a7148 F85924 D0 FA bne ?ff67149 F85926 24 CF ?ff7: bit fpaltf ; trim trailing '.' if any...7150 F85928 30 08 bmi ?ff8 ; ...and not alternate format7151 F8592A 88 dey7152 F8592B B6 78 ldx xcvt,y7153 F8592D E0 2E cpx #'.'7154 F8592F F0 01 beq ?ff87155 F85931 C8 iny7156 F85932 60 ?ff8: rts71577158 ; The E format always places one digit to the left of the decimal7159 ; point, followed by fraction digits, and then an 'E' followed7160 ; by a decimal exponent. The exponent is always 2 digits unless7161 ; it is of magnitude > 99.7162 F85933 A6 CC ?efmt: ldx fpprec7163 F85935 E0 4A cpx #XCVTMAX-67164 F85937 90 02 bcc ?e07165 F85939 A2 4A ldx #XCVTMAX-67166 F8593B 86 3E ?e0: stx wftmp ; overall digits count7167 F8593D A2 00 ldx #0 ; decimal string index7168 F8593F B5 50 lda fpstr,x7169 F85941 99 78 3F sta !P0FPU+xcvt,y ; store first digit7170 F85944 C6 3E dec wftmp7171 F85946 E8 inx7172 F85947 C8 iny7173 F85948 A9 2E lda #'.' ; decimal dot7174 F8594A EB xba ; B='.'7175 F8594B B5 50 lda fpstr,x ; follow a digit?7176 F8594D D0 0B bne ?e2 ; yes7177 F8594F 24 CF bit fpaltf ; if alternate format is false...7178 F85951 10 36 bpl ?exx ; ...not emit trailing '.'7179 F85953 EB xba ; otherwise yes7180 F85954 99 78 3F sta !P0FPU+xcvt,y ; store '.'7181 F85957 C8 iny7182 F85958 80 2F bra ?exx ; emit exponent7183 F8595A E8 ?e2: inx ; bump pointer7184 F8595B EB xba7185 F8595C 99 78 3F sta !P0FPU+xcvt,y ; store '.'7186 F8595F C8 iny7187 F85960 EB xba ; 2nd digit7188 F85961 99 78 3F ?e3: sta !P0FPU+xcvt,y ; store following digits7189 F85964 C8 iny7190 F85965 C6 3E dec wftmp7191 F85967 B5 50 lda fpstr,x ; next digit7192 F85969 F0 03 beq ?e4 ; no more digitsTue Jul 17 11:00:18 2018 Page 807193 F8596B E8 inx7194 F8596C 80 F3 bra ?e37195 F8596E A5 CE ?e4: lda fpfmt7196 F85970 C9 47 cmp #'G' ; 'G' format remove trailing zeroes...7197 F85972 D0 09 bne ?e57198 F85974 24 CF bit fpaltf ; ...if not alternate format7199 F85976 30 05 bmi ?e57200 F85978 20 CF 59 jsr ?trim ; trim trailing zeroes7201 F8597B 80 0C bra ?exx ; emit exponent7202 F8597D A5 3E ?e5: lda wftmp ; pad string with '0'7203 F8597F F0 08 beq ?exx7204 F85981 A2 30 ldx #'0'7205 F85983 96 78 ?e6: stx xcvt,y7206 F85985 C8 iny7207 F85986 3A dec a7208 F85987 D0 FA bne ?e67209 F85989 A9 45 ?exx: lda #'E' ; emit exponent7210 F8598B 05 D0 ora fpcap ; add letter case7211 F8598D 99 78 3F sta !P0FPU+xcvt,y7212 F85990 C8 iny7213 F85991 ACC167214 F85991 C2 20 rep #PMFLAG7215 .LONGA on7216 .MNLIST7217 F85993 A2 2B ldx #'+'7218 F85995 A5 48 lda dexp7219 F85997 10 06 bpl ?exs ; positive exponent7220 F85999 49 FF FF eor #$FFFF7221 F8599C 1A inc a7222 F8599D A2 2D ldx #'-'7223 F8599F 85 00 ?exs: sta tm ; store unsigned exponent7224 F859A1 85 46 sta scexp7225 F859A3 96 78 stx xcvt,y ; store exponent sign7226 F859A5 C8 iny7227 F859A6 84 4F sty fpidx ; save string index7228 F859A8 ACC087229 F859A8 E2 20 sep #PMFLAG7230 .LONGA off7231 .MNLIST7232 F859AA 20 15 5C jsr w2dec ; convert exponent to decimal7233 F859AD ACC167234 F859AD C2 20 rep #PMFLAG7235 .LONGA on7236 .MNLIST7237 F859AF A2 01 ldx #1 ; index if exp>=10007238 F859B1 A5 46 lda scexp7239 F859B3 C9 E8 03 cmp #10007240 F859B6 B0 07 bcs ?ex27241 F859B8 E8 inx ; 100 <= exp < 10007242 F859B9 C9 64 00 cmp #1007243 F859BC B0 01 bcs ?ex27244 F859BE E8 inx ; exp < 1007245 F859BF ?ex2: ACC087246 F859BF E2 20 sep #PMFLAG7247 .LONGA off7248 .MNLIST7249 F859C1 A4 4F ldy fpidx ; string indexTue Jul 17 11:00:18 2018 Page 817250 F859C3 B5 50 ?ex3: lda fpstr,x7251 F859C5 F0 07 beq ?ex47252 F859C7 99 78 3F sta !P0FPU+xcvt,y7253 F859CA C8 iny7254 F859CB E8 inx7255 F859CC 80 F5 bra ?ex37256 F859CE 60 ?ex4: rts72577258 ; trim trailing zeroes7259 F859CF 88 ?trim: dey ; pointer to last character7260 F859D0 C4 4F cpy fpidx ; if it is the first digit...7261 F859D2 F0 0A beq ?tr1 ; ...restore pointer and exit7262 F859D4 B6 78 ldx xcvt,y7263 F859D6 E0 30 cpx #'0' ; trim trailing '0'...7264 F859D8 F0 F5 beq ?trim7265 F859DA E0 2E cpx #'.' ; trim trailing '.' if any7266 F859DC F0 01 beq ?tr27267 F859DE C8 ?tr1: iny7268 F859DF 60 ?tr2: rts72697270 F859E0 A0 00 ?sts: ldy #0 ; store sign according format flags7271 F859E2 24 4A bit dsgn ; sign test7272 F859E4 10 04 bpl ?sts1 ; positive7273 F859E6 A2 2D ldx #'-' ; negative: store sign '-'7274 F859E8 80 0C bra ?sts27275 F859EA A5 CF ?sts1: lda fpaltf ; check if should store sign/blank7276 F859EC 4A lsr a ; fpaltf<0>: 1 if should store7277 F859ED 90 0A bcc ?sts3 ; no store7278 F859EF A2 2B ldx #'+'7279 F859F1 4A lsr a ; fpaltf<1>: 1 if should store blank7280 F859F2 B0 02 bcs ?sts2 ; store '+' sign7281 F859F4 A2 20 ldx #' ' ; store blank7282 F859F6 96 78 ?sts2: stx xcvt,y7283 F859F8 C8 iny7284 F859F9 60 ?sts3: rts72857286 F859FA ?round10:7287 ; Round up the decimal string according to the wanted precision P7288 ; We round directly the decimal string at the N-th digit, where:7289 ; o+ N=P if 'E' or 'G' format7290 ; o+ N=E+P+1 if 'F' format7291 ; round up with usual decimal method: round to nearest away from zero7292 ;7293 ; on entry VF=1 if decimal float = 0.072947295 F859FA A6 CC ldx fpprec ; X=P=precision (8 bit)7296 F859FC A5 CE lda fpfmt ; A=wanted format7297 F859FE 70 60 bvs ?zz ; number = 07298 F85A00 C9 46 cmp #'F'7299 F85A02 D0 13 bne ?rnd ; 'E'&'G' format: N=P7300 F85A04 ACC16CLC ; 'F' format: N=E+P+17301 F85A04 C2 21 rep #(PMFLAG.OR.PCFLAG)7302 .LONGA on7303 .MNLIST7304 F85A06 A5 48 lda dexp ; signed addition7305 F85A08 65 CC adc fpprec7306 F85A0A 1A inc a ; N=E+P+1Tue Jul 17 11:00:18 2018 Page 827307 F85A0B 30 40 bmi ?rtz ; if N<0 we round to zero7308 F85A0D C9 24 00 cmp #MAXDIGITS ; we limit rounding to the max. possible7309 F85A10 ACC087310 F85A10 E2 20 sep #PMFLAG7311 .LONGA off7312 .MNLIST7313 F85A12 90 02 bcc ?rnd07314 F85A14 A9 24 lda #MAXDIGITS7315 F85A16 AA ?rnd0: tax7316 F85A17 E0 24 ?rnd: cpx #MAXDIGITS ; limit the digit index to round up7317 F85A19 90 05 bcc ?rnd1 ; round up at N-th digit7318 F85A1B A2 24 ldx #MAXDIGITS7319 F85A1D 74 50 stz fpstr,x ; truncate??7320 F85A1F 60 rts7321 F85A20 B5 50 ?rnd1: lda fpstr,x ; last digit: can cause round up7322 F85A22 74 50 stz fpstr,x ; truncate decimal string7323 F85A24 C9 35 cmp #'5' ; if last digits < '5'...7324 F85A26 90 24 bcc ?rend ; no round up7325 F85A28 9B txy ; X=0?7326 F85A29 D0 04 bne ?rnd2 ; no7327 F85A2B7328 ; special case for 'F' format when E<0: can happen that N=E+P+1=07329 ; in this case we round up to '1' theb first digit and increment7330 ; decimal exponent7331 F85A2B 64 51 stz fpstr+1 ; string contain just one digits '1'...7332 F85A2D 80 13 bra ?rinc ; ...and we increment exponent7333 F85A2F A0 30 ?rnd2: ldy #'0'7334 F85A31 CA ?rndl: dex ; previous digit index7335 F85A32 30 0E bmi ?rinc ; rounding up zeroes all digits...7336 F85A34 B5 50 lda fpstr,x7337 F85A36 1A inc a ; round up digit7338 F85A37 C9 3A cmp #'9'+17339 F85A39 90 04 bcc ?rnd3 ; stop rounding up7340 F85A3B 94 50 sty fpstr,x ; round digit to '0'...7341 F85A3D B0 F2 bcs ?rndl ; ...and repeat7342 F85A3F 95 50 ?rnd3: sta fpstr,x ; store rounded digit7343 F85A41 60 rts ; stop rounding up7344 F85A42 ?rinc: ACC16 ; rounding generate a carry to first digit7345 F85A42 C2 20 rep #PMFLAG7346 .LONGA on7347 .MNLIST7348 F85A44 E6 48 inc dexp ; increment decimal exponent7349 F85A46 ACC087350 F85A46 E2 20 sep #PMFLAG7351 .LONGA off7352 .MNLIST7353 F85A48 A9 31 lda #'1' ; store '1' because rounding change a 999...7354 F85A4A 85 50 sta fpstr ; ...to 1000...7355 F85A4C 60 ?rend: rts7356 F85A4D ?rtz: ACC08 ; round to zero7357 F85A4D E2 20 sep #PMFLAG7358 .LONGA off7359 .MNLIST7360 F85A4F A9 30 lda #'0'7361 F85A51 A2 25 ldx #EXP10-1 ; zeroes all digits...7362 F85A53 74 51 stz fpstr+1,x7363 F85A55 95 50 ?zlp: sta fpstr,xTue Jul 17 11:00:18 2018 Page 837364 F85A57 CA dex7365 F85A58 10 FB bpl ?zlp7366 F85A5A 64 48 stz dexp ; clear decimal exponent7367 F85A5C A6 CC ldx fpprec7368 F85A5E A5 CE lda fpfmt ; A=wanted format7369 F85A60 C9 46 ?zz: cmp #'F'7370 F85A62 D0 01 bne ?z17371 F85A64 E8 inx ; 'F' format: one digit more for '0'7372 F85A65 E0 24 ?z1: cpx #MAXDIGITS ; limit the digit index7373 F85A67 90 02 bcc ?z27374 F85A69 A2 24 ldx #MAXDIGITS7375 F85A6B 74 50 ?z2: stz fpstr,x ; truncate string7376 F85A6D 24 CF bit fpaltf ; check for a signed zero or not7377 F85A6F 50 02 bvc ?z3 ; standard signed zero7378 F85A71 64 4A stz dsgn ; force +0.07379 F85A73 60 ?z3: rts73807381 ; convert byte to 2 hex. digits7382 ; return A=high digit, B=low digit7383 F85A74 b2hex:7384 F85A74 48 pha ; save value7385 F85A75 20 7E 5A jsr ?hex7386 F85A78 EB xba ; B=low digit7387 F85A79 68 pla ; restore value7388 F85A7A 4A lsr a ; divide by 167389 F85A7B 4A lsr a7390 F85A7C 4A lsr a7391 F85A7D 4A lsr a7392 F85A7E 29 0F ?hex: and #$0F ; mask nibble7393 F85A80 C9 0A cmp #107394 F85A82 90 02 bcc ?hex17395 F85A84 65 3E adc wftmp ; add value for a..f/A..F7396 F85A86 69 30 ?hex1: adc #'0'7397 F85A88 60 rts7398 F85A8973997400 ; fp2dec - convert the floating point fac to decimal ascii string7401 ;7402 ; entry:7403 ; fac = argument (either valid or invalid)7404 ;7405 ; exit:7406 ; fpstr = 38 digits ascii decimal string (null terminated)7407 ; (implicit decimal dot between first and 2nd digit)7408 ; dsgn = sign of the decimal significand7409 ; dexp = decimal exponent (2's complement)7410 ;7411 ; If fac is not valid return either the string 'NAN' or 'INF' according7412 ; with fac status (dexp=don't care).7413 ; If fac=0 (or rounded to 0.0), return a string of digits '0',7414 ; and dexp=0.7415 ;7416 ; strategy:7417 ;7418 ; o find the decimal exponent N of the 'normalized' decimal floating7419 ; point number, such that:7420 ;Tue Jul 17 11:00:18 2018 Page 847421 ; N7422 ; |x| = d.ffff... 10 1<= d <=9, f=fractional part7423 ;7424 ; o scale |x| by a power of ten equal to M = 37 - N, such that:7425 ;7426 ; M N 37 - N 377427 ; y = x * 10 = d.ffff... * 10 * 10 = d.ffff... * 107428 ;7429 ; select 37 justified by the fact that the maximum decimal exponent7430 ; for a 128 bits number is 38.7431 ;7432 ; o this scaling give an y such that:7433 ;7434 ; 37 387435 ; 10 <= y < 107436 ;7437 ; and y can be regarded as 'integral' value with 38 significative digits7438 ; (first d digit, followed by 37 ffff... digits of the fractional part),7439 ; and can be converted to decimal string. The implicit decimal dot is7440 ; between first and 2nd digits.7441 ;7442 ; This routine is used internally and not intended for end use.7443 ;7444 ;------7445 F85A89 fp2dec:7446 ;------7447 F85A89 A5 24 lda facsgn7448 F85A8B 64 24 stz facsgn ; absolute fac7449 F85A8D 85 4A sta dsgn ; save sign of decimal float7450 F85A8F 64 48 stz dexp ; clear decimal exponent7451 F85A91 64 49 stz dexp+17452 F85A93 24 25 bit facst7453 F85A95 10 1B bpl ?vf7454 F85A97 ACC167455 F85A97 C2 20 rep #PMFLAG7456 .LONGA on7457 .MNLIST7458 F85A99 50 0A bvc ?nan ; fac=nan7459 F85A9B A9 49 4E lda #'NI' ; fac=inf7460 F85A9E 85 50 sta fpstr7461 F85AA0 A9 46 00 lda #'F' ; store 'INF'7462 F85AA3 80 08 bra ?end7463 F85AA5 A9 4E 41 ?nan: lda #'AN'7464 F85AA8 85 50 sta fpstr7465 F85AAA A9 4E 00 lda #'N' ; store 'NAN'7466 F85AAD 85 52 ?end: sta fpstr+27467 F85AAF ACC087468 F85AAF E2 20 sep #PMFLAG7469 .LONGA off7470 .MNLIST7471 F85AB1 60 rts7472 F85AB2 50 0C ?vf: bvc ?nz ; fac <> 07473 F85AB4 A9 30 lda #'0'7474 F85AB6 A2 25 ldx #37 ; store 38 digits '0'...7475 F85AB8 74 51 stz fpstr+1,x7476 F85ABA 95 50 ?z: sta fpstr,x7477 F85ABC CA dexTue Jul 17 11:00:18 2018 Page 857478 F85ABD 10 FB bpl ?z7479 F85ABF 60 rts ; ...and exit7480 F85AC0 A2 00 ?nz: ldx #07481 F85AC2 A5 21 lda facm+157482 F85AC4 30 09 bmi ?nf ; normal float7483 F85AC6 A9 C5 lda #<fce64 ; pre-scale by 1e64 the subnormal float7484 F85AC8 A0 5F ldy #>fce647485 F85ACA 20 D5 49 jsr fcmult7486 F85ACD A2 FF ldx #$FF7487 F85ACF 86 10 ?nf: stx fsubnf ; remember if we prescaled by 1e647488 F85AD1 20 26 4D jsr frndm ; round mantissa to 113 bits7489 F85AD47490 ; For a fast evaluation of the decimal exponent, we make a swift7491 ; estimate of the log10 of the float, then check it later.7492 ; We can form the estimate by multiplying the binary exponent7493 ; by a conversion factor Log10(2) with 16 bit accuracy, using7494 ; an integer signed multiplication 16x16 and taking the high7495 ; 16 bit of the result. The error is at most one digit up or7496 ; down.74977498 F85AD4 ACC16 ; get an estimate of the decimal exponent7499 F85AD4 C2 20 rep #PMFLAG7500 .LONGA on7501 .MNLIST7502 F85AD6 38 sec7503 F85AD7 A5 22 lda facexp7504 F85AD9 E9 FF 3F sbc #EBIAS7505 F85ADC A2 10 ldx #<LOG2H ; log(2)*$10000 (approximate to 16 bits)7506 F85ADE A0 4D ldy #>LOG2H7507 F85AE0 20 CE 87 jsr imult ; return C=estimate exponent (high 16 bits)7508 F85AE3 85 48 sta dexp ; this can be +/-1 from the real decimal exp.7509 F85AE5 A9 25 00 lda #EXP10-1 ; get difference exponent with 1e37...7510 F85AE8 38 sec ; ... to scale fac in range [1e37..1e38-1]7511 F85AE9 E5 48 sbc dexp7512 F85AEB ACC087513 F85AEB E2 20 sep #PMFLAG7514 .LONGA off7515 .MNLIST7516 F85AED 20 2E 49 jsr scale10 ; scale fac by 37 - N7517 F85AF07518 ; now check if we will divide by 10 or multiplies by 10 to get7519 ; the exact decimal exponent; should be: 1e37 <= fac < 1e3875207521 F85AF0 A9 ED lda #<fce38 ; now compare fac vs. 1e387522 F85AF2 A0 5E ldy #>fce387523 F85AF4 20 5E 87 jsr fccmp ; should be fac<1e387524 F85AF7 30 0B bmi ?tst ; fac < 1e38, so go to check if fac>=1e377525 F85AF9 ACC167526 F85AF9 C2 20 rep #PMFLAG7527 .LONGA on7528 .MNLIST7529 F85AFB E6 48 inc dexp ; increment decimal exponent...7530 F85AFD ACC08 ; ...because next division by 107531 F85AFD E2 20 sep #PMFLAG7532 .LONGA off7533 .MNLIST7534 F85AFF 20 06 4A jsr div10 ; fac=fac/10 so now fac<1e38Tue Jul 17 11:00:18 2018 Page 867535 F85B02 80 14 bra ?cvt ; convert to decimal7536 F85B04 A9 DB ?tst: lda #<fce37 ; now compare fac vs. 1e377537 F85B06 A0 5E ldy #>fce377538 F85B08 20 5E 87 jsr fccmp7539 F85B0B F0 0B beq ?cvt ; fac=1e377540 F85B0D 10 09 bpl ?cvt ; fac>1e377541 F85B0F ACC167542 F85B0F C2 20 rep #PMFLAG7543 .LONGA on7544 .MNLIST7545 F85B11 C6 48 dec dexp ; decrement decimal exponent because...7546 F85B13 ACC087547 F85B13 E2 20 sep #PMFLAG7548 .LONGA off7549 .MNLIST7550 F85B15 20 D1 49 jsr mult10 ; ...we mult x 1075517552 ; now we have 1e37 <= fac < 1e387553 ; note that we no round fac because we use all 128 bits mantissa7554 ; move fac mantissa (128 bits) to temporary mantissa tm7555 F85B18 ?cvt: ACC167556 F85B18 C2 20 rep #PMFLAG7557 .LONGA on7558 .MNLIST7559 F85B1A A6 10 ldx fsubnf ; we prescaled the float?7560 F85B1C F0 08 beq ?cvt1 ; no7561 F85B1E 38 sec7562 F85B1F A5 48 lda dexp ; adjust decimal exponent7563 F85B21 E9 40 00 sbc #647564 F85B24 85 48 sta dexp7565 F85B26 A5 12 ?cvt1: lda facm ; we use guard bits too in conversion7566 F85B28 85 00 sta tm7567 F85B2A A5 14 lda facm+27568 F85B2C 85 02 sta tm+27569 F85B2E A5 16 lda facm+47570 F85B30 85 04 sta tm+47571 F85B32 A5 18 lda facm+67572 F85B34 85 06 sta tm+67573 F85B36 A5 1A lda facm+87574 F85B38 85 08 sta tm+87575 F85B3A A5 1C lda facm+107576 F85B3C 85 0A sta tm+107577 F85B3E A5 1E lda facm+127578 F85B40 85 0C sta tm+127579 F85B42 A5 20 lda facm+147580 F85B44 85 0E sta tm+147581 F85B46 A5 22 lda facexp ; get how many shift need to align tm...7582 F85B48 38 sec ; ...to get the effective long integer7583 F85B49 E9 7E 40 sbc #EBIAS+MNTBITS-17584 F85B4C ACC08 ; negative or null, just 8 bits value7585 F85B4C E2 20 sep #PMFLAG7586 .LONGA off7587 .MNLIST7588 F85B4E F0 05 beq ?cvt2 ; tm aligned, no shift7589 F85B50 A2 00 ldx #tm7590 F85B52 20 3A 47 jsr shrmx ; shift tm to right to align at 128 bits int.7591 F85B55 20 9B 5B ?cvt2: jsr ui2dec ; convert integer to 39 decimal digitsTue Jul 17 11:00:18 2018 Page 8775927593 ; first digit is always a leading '0', beacuse 1e37 <= fac < 1e387594 ; max. integer is: 340282366920938463463374607431768211455 (> 1e38)7595 F85B587596 F85B58 A2 00 ldx #0 ; we shift one digit to left (normalitation)7597 F85B5A B5 51 ?sh: lda fpstr+1,x7598 F85B5C 95 50 sta fpstr,x7599 F85B5E F0 03 beq ?done7600 F85B60 E8 inx7601 F85B61 80 F7 bra ?sh7602 F85B63 60 ?done: rts ; 38 digits + null terminator76037604 ; int2dec - convert a signed/unsigned 128 bits long integer to decimal ascii7605 ;7606 ; entry:7607 ; facm..facm+15 = signed long integer7608 ;7609 ; exit:7610 ; fpstr = 39 digits ascii decimal string (null terminated)7611 ;7612 ; This routine check automatically if signed/unsigned (facst byte test, bit 7)7613 ; Note: this routine store leading not-significative digits '0'7614 ;7615 ;-------7616 F85B64 int2dec:7617 ;-------7618 F85B64 64 4A stz dsgn7619 F85B66 A2 0F ldx #15 ; move facm to tm7620 F85B68 B5 12 ?lp: lda facm,x7621 F85B6A 95 00 sta tm,x7622 F85B6C CA dex7623 F85B6D 10 F9 bpl ?lp7624 F85B6F 24 25 bit facst7625 F85B71 10 28 bpl ui2dec ; unsigned integer7626 F85B73 A5 0F lda tm+157627 F85B75 85 4A sta dsgn ; decimal sign7628 F85B77 10 22 bpl ui2dec ; positive7629 F85B79 ACC167630 F85B79 C2 20 rep #PMFLAG7631 .LONGA on7632 .MNLIST7633 F85B7B A2 00 ldx #07634 F85B7D A0 08 ldy #87635 F85B7F 38 sec7636 F85B80 A9 00 00 ?lp2: lda #0 ; two's complement7637 F85B83 F5 00 sbc tm,x7638 F85B85 95 00 sta tm,x7639 F85B87 E8 inx7640 F85B88 E8 inx7641 F85B89 88 dey7642 F85B8A D0 F4 bne ?lp27643 F85B8C ACC087644 F85B8C E2 20 sep #PMFLAG7645 .LONGA off7646 .MNLIST7647 F85B8E 80 0B bra ui2dec ; negative7648Tue Jul 17 11:00:18 2018 Page 887649 ; uint2dec - convert an unsigned 128 bits long integer to decimal ascii7650 ;7651 ; entry:7652 ; facm..facm+15 = unsigned long integer7653 ;7654 ; exit:7655 ; fpstr = 39 digits ascii decimal string (null terminated)7656 ;7657 ; Note: this routine store leading not-significative digits '0'7658 ;7659 ;--------7660 F85B90 uint2dec:7661 ;--------7662 F85B90 A2 0F ldx #15 ; move facm to tm7663 F85B92 B5 12 ?lp: lda facm,x7664 F85B94 95 00 sta tm,x7665 F85B96 CA dex7666 F85B97 10 F9 bpl ?lp7667 F85B99 64 4A stz dsgn ; clear decimal sign76687669 ; ui2dec - convert an unsigned 128 bits long integer to decimal ascii7670 ;7671 ; entry:7672 ; tm..tm+15 = unsigned long integer7673 ;7674 ; exit:7675 ; fpstr = 39 digits ascii decimal string (null terminated)7676 ;7677 ; Note: this routine store leading not-significative digits '0'7678 ;7679 ; This routine is used internally and not intended for end use.7680 ;7681 ;------7682 F85B9B ui2dec:7683 ;------7684 F85B9B 8B phb ; save dbr7685 F85B9C 4B phk7686 F85B9D AB plb ; set current dbr=pbr7687 F85B9E A2 00 ldx #0 ; index to decimal table7688 F85BA0 86 3F stx wftmp+1 ; index to the destination ascii buffer7689 F85BA2 A0 80 ldy #$80 ; partial quotient (alternate positive/neg.)7690 F85BA4 ?lp: ACC16 ; main loop7691 F85BA4 C2 20 rep #PMFLAG7692 .LONGA on7693 .MNLIST7694 F85BA6 A5 00 ?sub: lda tm ; repeated subtraction's7695 F85BA8 38 sec7696 F85BA9 FD 6B 5C sbc !dectbl0,x ; low bytes7697 F85BAC 85 00 sta tm7698 F85BAE A5 02 lda tm+27699 F85BB0 FD 6D 5C sbc !dectbl0+2,x7700 F85BB3 85 02 sta tm+27701 F85BB5 A5 04 lda tm+47702 F85BB7 FD 07 5D sbc !dectbl1,x7703 F85BBA 85 04 sta tm+47704 F85BBC A5 06 lda tm+67705 F85BBE FD 09 5D sbc !dectbl1+2,xTue Jul 17 11:00:18 2018 Page 897706 F85BC1 85 06 sta tm+67707 F85BC3 A5 08 lda tm+87708 F85BC5 FD A3 5D sbc !dectbl2,x7709 F85BC8 85 08 sta tm+87710 F85BCA A5 0A lda tm+107711 F85BCC FD A5 5D sbc !dectbl2+2,x7712 F85BCF 85 0A sta tm+107713 F85BD1 A5 0C lda tm+127714 F85BD3 FD 3F 5E sbc !dectbl3,x7715 F85BD6 85 0C sta tm+127716 F85BD8 A5 0E lda tm+147717 F85BDA FD 41 5E sbc !dectbl3+2,x7718 F85BDD 85 0E sta tm+14 ; CF=0 if remainder is negative7719 F85BDF C8 iny ; increment partial quotient (N flag)7720 F85BE0 B0 04 bcs ?pr ; remainder is positive7721 F85BE2 10 C2 bpl ?sub ; neg. rem. & pos. quot.: repeat subtraction7722 F85BE4 30 02 bmi ?st ; else store digit7723 F85BE6 30 BE ?pr: bmi ?sub ; pos. rem. & neg. quot.: repeat subtraction7724 ; else store digit7725 F85BE8 ?st: ACC087726 F85BE8 E2 20 sep #PMFLAG7727 .LONGA off7728 .MNLIST7729 F85BEA 98 tya7730 F85BEB 90 04 bcc ?nr ; remainder is negative7731 F85BED 49 FF eor #$FF ; 10's complement of the quotient7732 F85BEF 69 0A adc #107733 F85BF1 69 2F ?nr: adc #'0'-1 ; A is one more beacuse the 'iny'...7734 F85BF3 A8 tay7735 F85BF4 86 3E stx wftmp ; save counter7736 F85BF6 A6 3F ldx wftmp+1 ; current decimal string index7737 F85BF8 29 7F and #$7F ; strip off bit 77738 F85BFA 95 50 sta fpstr,x ; store digit7739 F85BFC E8 inx7740 F85BFD 86 3F stx wftmp+1 ; update string index7741 F85BFF 98 tya ; invert sign of the starting quotient7742 F85C00 49 FF eor #$FF7743 F85C02 29 80 and #$807744 F85C04 A8 tay7745 F85C05 A5 3E lda wftmp ; update table index7746 F85C07 18 clc7747 F85C08 69 04 adc #47748 F85C0A AA tax7749 F85C0B E0 9C cpx #DTBLSIZ7750 F85C0D 90 95 bcc ?lp ; repeat until done7751 F85C0F A6 3F ldx wftmp+1 ; terminate decimal string...7752 F85C11 74 50 stz fpstr,x ; ...with a null7753 F85C13 AB plb ; restore dbr7754 F85C14 60 rts77557756 ; w2dec - convert an unsigned 16 bits integer to decimal ascii7757 ;7758 ; entry:7759 ; C = unsigned 16 bits integer7760 ;7761 ; exit:7762 ; fpstr = 5 bytes ascii decimal string (null terminated)Tue Jul 17 11:00:18 2018 Page 907763 ;7764 ; Note: this routine store leading not-significative digits '0'7765 ;7766 ;-----7767 F85C15 w2dec:7768 ;-----7769 F85C15 8B phb ; save dbr7770 F85C16 4B phk7771 F85C17 AB plb ; set current dbr=pbr7772 F85C18 A2 88 ldx #I16IDX ; index to decimal table7773 F85C1A 64 3F stz wftmp+1 ; decimal string index7774 F85C1C A0 80 ldy #$80 ; partial quotient (alternate positive/neg.)7775 F85C1E ACC167776 F85C1E C2 20 rep #PMFLAG7777 .LONGA on7778 .MNLIST7779 F85C20 85 00 sta tm ; 16 bit value7780 F85C22 64 02 stz tm+2 ; sign extension7781 F85C24 ?lp: ACC16 ; main loop7782 F85C24 C2 20 rep #PMFLAG7783 .LONGA on7784 .MNLIST7785 F85C26 A5 00 ?sub: lda tm ; repeated subtraction's7786 F85C28 38 sec7787 F85C29 FD 6B 5C sbc !dectbl0,x ; low bytes7788 F85C2C 85 00 sta tm7789 F85C2E A5 02 lda tm+27790 F85C30 FD 6D 5C sbc !dectbl0+2,x7791 F85C33 85 02 sta tm+2 ; CF=0 if remainder is negative7792 F85C35 C8 iny ; increment partial quotient7793 F85C36 B0 04 bcs ?pr ; remainder is positive7794 F85C38 10 EC bpl ?sub ; neg. rem. & pos. quot.: repeat subtraction7795 F85C3A 30 02 bmi ?st ; else store digit7796 F85C3C 30 E8 ?pr: bmi ?sub ; pos. rem. & neg. quot.: repeat subtraction7797 ; else store digit7798 F85C3E ?st: ACC087799 F85C3E E2 20 sep #PMFLAG7800 .LONGA off7801 .MNLIST7802 F85C40 98 tya7803 F85C41 90 04 bcc ?nr ; negative remainder7804 F85C43 49 FF eor #$FF ; complement7805 F85C45 69 0A adc #107806 F85C47 69 2F ?nr: adc #'0'-17807 F85C49 A8 tay7808 F85C4A 86 3E stx wftmp7809 F85C4C A6 3F ldx wftmp+17810 F85C4E 29 7F and #$7F7811 F85C50 95 50 sta fpstr,x7812 F85C52 E8 inx7813 F85C53 86 3F stx wftmp+17814 F85C55 98 tya7815 F85C56 49 FF eor #$FF7816 F85C58 29 80 and #$807817 F85C5A A8 tay7818 F85C5B A5 3E lda wftmp7819 F85C5D 18 clcTue Jul 17 11:00:18 2018 Page 917820 F85C5E 69 04 adc #47821 F85C60 AA tax7822 F85C61 E0 9C cpx #DTBLSIZ7823 F85C63 90 BF bcc ?lp7824 F85C65 A6 3F ldx wftmp+17825 F85C67 74 50 stz fpstr,x7826 F85C69 AB plb7827 F85C6A 60 rts78287829 ; table of decreasing powers of ten, from 1e38 down to 1e0, with7830 ; alternating sign, used to convert 128 bits integer in decimal7831 ; Any constant is 128 bits, but table is splitted in four pieces,7832 ; to easily access with an 8 bit index.7833 ; bits from 0 to 317834 F85C6B dectbl0:7835 F85C6B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E387836 F85C6F 00 00 00 00 .DB $00,$00,$00,$00 ; -1E377837 F85C73 00 00 00 00 .DB $00,$00,$00,$00 ; +1E367838 F85C77 00 00 00 00 .DB $00,$00,$00,$00 ; -1E357839 F85C7B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E347840 F85C7F 00 00 00 00 .DB $00,$00,$00,$00 ; -1E337841 F85C83 00 00 00 00 .DB $00,$00,$00,$00 ; +1E327842 F85C87 00 00 00 80 .DB $00,$00,$00,$80 ; -1E317843 F85C8B 00 00 00 40 .DB $00,$00,$00,$40 ; +1E307844 F85C8F 00 00 00 60 .DB $00,$00,$00,$60 ; -1E297845 F85C93 00 00 00 10 .DB $00,$00,$00,$10 ; +1E287846 F85C97 00 00 00 18 .DB $00,$00,$00,$18 ; -1E277847 F85C9B 00 00 00 E4 .DB $00,$00,$00,$E4 ; +1E267848 F85C9F 00 00 00 B6 .DB $00,$00,$00,$B6 ; -1E257849 F85CA3 00 00 00 A1 .DB $00,$00,$00,$A1 ; +1E247850 F85CA7 00 00 80 09 .DB $00,$00,$80,$09 ; -1E237851 F85CAB 00 00 40 B2 .DB $00,$00,$40,$B2 ; +1E227852 F85CAF 00 00 60 21 .DB $00,$00,$60,$21 ; -1E217853 F85CB3 00 00 10 63 .DB $00,$00,$10,$63 ; +1E207854 F85CB7 00 00 18 76 .DB $00,$00,$18,$76 ; -1E197855 F85CBB 00 00 64 A7 .DB $00,$00,$64,$A7 ; +1E187856 F85CBF 00 00 76 A2 .DB $00,$00,$76,$A2 ; -1E177857 F85CC3 00 00 C1 6F .DB $00,$00,$C1,$6F ; +1E167858 F85CC7 00 80 39 5B .DB $00,$80,$39,$5B ; -1E157859 F85CCB 00 40 7A 10 .DB $00,$40,$7A,$10 ; +1E147860 F85CCF 00 60 8D B1 .DB $00,$60,$8D,$B1 ; -1E137861 F85CD3 00 10 A5 D4 .DB $00,$10,$A5,$D4 ; +1E127862 F85CD7 00 18 89 B7 .DB $00,$18,$89,$B7 ; -1E117863 F85CDB 00 E4 0B 54 .DB $00,$E4,$0B,$54 ; +1E107864 F85CDF 00 36 65 C4 .DB $00,$36,$65,$C4 ; -1E097865 F85CE3 00 E1 F5 05 .DB $00,$E1,$F5,$05 ; +1E087866 F85CE7 80 69 67 FF .DB $80,$69,$67,$FF ; -1E077867 F85CEB 40 42 0F 00 .DB $40,$42,$0F,$00 ; +1E067868 F85CEF 60 79 FE FF .DB $60,$79,$FE,$FF ; -1E057869 F85CF3 10 27 00 00 .DB $10,$27,$00,$00 ; +1E047870 F85CF7 18 FC FF FF .DB $18,$FC,$FF,$FF ; -1E037871 F85CFB 64 00 00 00 .DB $64,$00,$00,$00 ; +1E027872 F85CFF F6 FF FF FF .DB $F6,$FF,$FF,$FF ; -1E017873 F85D03 01 00 00 00 .DB $01,$00,$00,$00 ; +1E0078747875 ; bits from 32 to 637876 F85D07 dectbl1:Tue Jul 17 11:00:18 2018 Page 927877 F85D07 40 22 8A 09 .DB $40,$22,$8A,$09 ; +1E387878 F85D0B 60 C9 0B FF .DB $60,$C9,$0B,$FF ; -1E377879 F85D0F 10 9F 4B B3 .DB $10,$9F,$4B,$B3 ; +1E367880 F85D13 18 70 78 D4 .DB $18,$70,$78,$D4 ; -1E357881 F85D17 64 8E 8D 37 .DB $64,$8E,$8D,$37 ; +1E347882 F85D1B F6 A4 3E C7 .DB $F6,$A4,$3E,$C7 ; -1E337883 F85D1F 81 EF AC 85 .DB $81,$EF,$AC,$85 ; +1E327884 F85D23 D9 B4 6E 3F .DB $D9,$B4,$6E,$3F ; -1E317885 F85D27 EA ED 74 46 .DB $EA,$ED,$74,$46 ; +1E307886 F85D2B 35 E8 8D 92 .DB $35,$E8,$8D,$92 ; -1E297887 F85D2F 61 02 25 3E .DB $61,$02,$25,$3E ; +1E287888 F85D33 C3 7F 2F 60 .DB $C3,$7F,$2F,$60 ; -1E277889 F85D37 D2 0C C8 DC .DB $D2,$0C,$C8,$DC ; +1E267890 F85D3B B7 FE EB E9 .DB $B7,$FE,$EB,$E9 ; -1E257891 F85D3F ED CC CE 1B .DB $ED,$CC,$CE,$1B ; +1E247892 F85D43 B5 1E 38 FD .DB $B5,$1E,$38,$FD ; -1E237893 F85D47 BA C9 E0 19 .DB $BA,$C9,$E0,$19 ; +1E227894 F85D4B 3A 52 36 CA .DB $3A,$52,$36,$CA ; -1E217895 F85D4F 2D 5E C7 6B .DB $2D,$5E,$C7,$6B ; +1E207896 F85D53 FB DC 38 75 .DB $FB,$DC,$38,$75 ; -1E197897 F85D57 B3 B6 E0 0D .DB $B3,$B6,$E0,$0D ; +1E187898 F85D5B 87 BA 9C FE .DB $87,$BA,$9C,$FE ; -1E177899 F85D5F F2 86 23 00 .DB $F2,$86,$23,$00 ; +1E167900 F85D63 81 72 FC FF .DB $81,$72,$FC,$FF ; -1E157901 F85D67 F3 5A 00 00 .DB $F3,$5A,$00,$00 ; +1E147902 F85D6B E7 F6 FF FF .DB $E7,$F6,$FF,$FF ; -1E137903 F85D6F E8 00 00 00 .DB $E8,$00,$00,$00 ; +1E127904 F85D73 E8 FF FF FF .DB $E8,$FF,$FF,$FF ; -1E117905 F85D77 02 00 00 00 .DB $02,$00,$00,$00 ; +1E107906 F85D7B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E097907 F85D7F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E087908 F85D83 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E077909 F85D87 00 00 00 00 .DB $00,$00,$00,$00 ; +1E067910 F85D8B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E057911 F85D8F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E047912 F85D93 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E037913 F85D97 00 00 00 00 .DB $00,$00,$00,$00 ; +1E027914 F85D9B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E017915 F85D9F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E0079167917 ; bits from 64 to 957918 F85DA3 dectbl2:7919 F85DA3 7A C4 86 5A .DB $7A,$C4,$86,$5A ; +1E387920 F85DA7 26 B9 25 2A .DB $26,$B9,$25,$2A ; -1E377921 F85DAB 15 07 C9 7B .DB $15,$07,$C9,$7B ; +1E367922 F85DAF 7D B2 38 8D .DB $7D,$B2,$38,$8D ; -1E357923 F85DB3 C0 87 AD BE .DB $C0,$87,$AD,$BE ; +1E347924 F85DB7 6C 72 BB 39 .DB $6C,$72,$BB,$39 ; -1E337925 F85DBB 5B 41 6D 2D .DB $5B,$41,$6D,$2D ; +1E327926 F85DBF DD DF 41 C8 .DB $DD,$DF,$41,$C8 ; -1E317927 F85DC3 D0 9C 2C 9F .DB $D0,$9C,$2C,$9F ; +1E307928 F85DC7 51 F0 E1 BC .DB $51,$F0,$E1,$BC ; -1E297929 F85DCB 5E CE 4F 20 .DB $5E,$CE,$4F,$20 ; +1E287930 F85DCF C3 D1 C4 FC .DB $C3,$D1,$C4,$FC ; -1E277931 F85DD3 D2 B7 52 00 .DB $D2,$B7,$52,$00 ; +1E267932 F85DD7 6A BA F7 FF .DB $6A,$BA,$F7,$FF ; -1E257933 F85DDB C2 D3 00 00 .DB $C2,$D3,$00,$00 ; +1E24Tue Jul 17 11:00:18 2018 Page 937934 F85DDF D2 EA FF FF .DB $D2,$EA,$FF,$FF ; -1E237935 F85DE3 1E 02 00 00 .DB $1E,$02,$00,$00 ; +1E227936 F85DE7 C9 FF FF FF .DB $C9,$FF,$FF,$FF ; -1E217937 F85DEB 05 00 00 00 .DB $05,$00,$00,$00 ; +1E207938 F85DEF FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E197939 F85DF3 00 00 00 00 .DB $00,$00,$00,$00 ; +1E187940 F85DF7 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E177941 F85DFB 00 00 00 00 .DB $00,$00,$00,$00 ; +1E167942 F85DFF FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E157943 F85E03 00 00 00 00 .DB $00,$00,$00,$00 ; +1E147944 F85E07 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E137945 F85E0B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E127946 F85E0F FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E117947 F85E13 00 00 00 00 .DB $00,$00,$00,$00 ; +1E107948 F85E17 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E097949 F85E1B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E087950 F85E1F FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E077951 F85E23 00 00 00 00 .DB $00,$00,$00,$00 ; +1E067952 F85E27 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E057953 F85E2B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E047954 F85E2F FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E037955 F85E33 00 00 00 00 .DB $00,$00,$00,$00 ; +1E027956 F85E37 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E017957 F85E3B 00 00 00 00 .DB $00,$00,$00,$00 ; +1E0079587959 ; bits from 96 to 1277960 F85E3F dectbl3:7961 F85E3F A8 4C 3B 4B .DB $A8,$4C,$3B,$4B ; +1E387962 F85E43 EF 11 7A F8 .DB $EF,$11,$7A,$F8 ; -1E377963 F85E47 CE 97 C0 00 .DB $CE,$97,$C0,$00 ; +1E367964 F85E4B 9E BD EC FF .DB $9E,$BD,$EC,$FF ; -1E357965 F85E4F 09 ED 01 00 .DB $09,$ED,$01,$00 ; +1E347966 F85E53 B2 CE FF FF .DB $B2,$CE,$FF,$FF ; -1E337967 F85E57 EE 04 00 00 .DB $EE,$04,$00,$00 ; +1E327968 F85E5B 81 FF FF FF .DB $81,$FF,$FF,$FF ; -1E317969 F85E5F 0C 00 00 00 .DB $0C,$00,$00,$00 ; +1E307970 F85E63 FE FF FF FF .DB $FE,$FF,$FF,$FF ; -1E297971 F85E67 00 00 00 00 .DB $00,$00,$00,$00 ; +1E287972 F85E6B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E277973 F85E6F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E267974 F85E73 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E257975 F85E77 00 00 00 00 .DB $00,$00,$00,$00 ; +1E247976 F85E7B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E237977 F85E7F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E227978 F85E83 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E217979 F85E87 00 00 00 00 .DB $00,$00,$00,$00 ; +1E207980 F85E8B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E197981 F85E8F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E187982 F85E93 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E177983 F85E97 00 00 00 00 .DB $00,$00,$00,$00 ; +1E167984 F85E9B FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E157985 F85E9F 00 00 00 00 .DB $00,$00,$00,$00 ; +1E147986 F85EA3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E137987 F85EA7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E127988 F85EAB FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E117989 F85EAF 00 00 00 00 .DB $00,$00,$00,$00 ; +1E107990 F85EB3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E09Tue Jul 17 11:00:18 2018 Page 947991 F85EB7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E087992 F85EBB FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E077993 F85EBF 00 00 00 00 .DB $00,$00,$00,$00 ; +1E067994 F85EC3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E0579957996 ; this portion is used by routine that convert 16 bits integer to decimal7997 F85EC7 dec1e4:7998 F85EC7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E047999 F85ECB FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E038000 F85ECF 00 00 00 00 .DB $00,$00,$00,$00 ; +1E028001 F85ED3 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1E018002 F85ED7 00 00 00 00 .DB $00,$00,$00,$00 ; +1E0080038004 00009C DTBLSIZ .EQU $-dectbl38005 000088 I16IDX .EQU dec1e4-dectbl380068007 ; limits for conversion float-to-decimal8008 F85EDB 00 00 00 00 00 fce37: .DB $00,$00,$00,$00,$00,$D4,$86,$1E,$20D4 86 1E 208009 F85EE4 DB 48 BB 1A C2 .DB $DB,$48,$BB,$1A,$C2,$BD,$F0,$79,$40 ; 1e37BD F0 79 408010 F85EED8011 F85EED 00 00 00 00 80 fce38: .DB $00,$00,$00,$00,$80,$44,$14,$13,$F444 14 13 F48012 F85EF6 88 0D B5 50 99 .DB $88,$0D,$B5,$50,$99,$76,$96,$7D,$40 ; 1e3876 96 7D 4080138014 ; table of constant for scaling (not rounded, 128 bits mantissa)8015 ; used by scale10 routine (scaling by a power of ten)8016 F85EFF 00 00 00 00 00 fce0: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008017 F85F08 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FF,$3F ; 100 80 FF 3F8018 F85F11 00 00 00 00 00 fce1: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008019 F85F1A 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$A0,$02,$40 ; 1000 A0 02 408020 F85F23 00 00 00 00 00 fce2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008021 F85F2C 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$C8,$05,$40 ; 10000 C8 05 408022 F85F35 00 00 00 00 00 fce3: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008023 F85F3E 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$FA,$08,$40 ; 1E300 FA 08 408024 F85F47 00 00 00 00 00 fce4: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008025 F85F50 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$40,$9C,$0C,$40 ; 1E440 9C 0C 408026 F85F59 00 00 00 00 00 fce5: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008027 F85F62 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$50,$C3,$0F,$40 ; 1E550 C3 0F 408028 F85F6B 00 00 00 00 00 fce6: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008029 F85F74 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$24,$F4,$12,$40 ; 1E624 F4 12 40Tue Jul 17 11:00:18 2018 Page 958030 F85F7D 00 00 00 00 00 fce7: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008031 F85F86 00 00 00 00 80 .DB $00,$00,$00,$00,$80,$96,$98,$16,$40 ; 1E796 98 16 4080328033 F85F8F 00 00 00 00 00 fce8: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008034 F85F98 00 00 00 00 20 .DB $00,$00,$00,$00,$20,$BC,$BE,$19,$40 ; 1E8BC BE 19 4080358036 F85FA1 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008037 F85FAA 00 00 04 BF C9 .DB $00,$00,$04,$BF,$C9,$1B,$8E,$34,$40 ; 1E161B 8E 34 4080388039 F85FB3 00 00 00 00 00 fce32: .DB $00,$00,$00,$00,$00,$00,$20,$F0,$9D00 20 F0 9D8040 F85FBC B5 70 2B A8 AD .DB $B5,$70,$2B,$A8,$AD,$C5,$9D,$69,$40 ; 1E32C5 9D 69 4080418042 F85FC5 FA 25 6B C7 71 fce64: .DB $FA,$25,$6B,$C7,$71,$6B,$BF,$3C,$D56B BF 3C D58043 F85FCE A6 CF FF 49 1F .DB $A6,$CF,$FF,$49,$1F,$78,$C2,$D3,$40 ; 1E6478 C2 D3 4080448045 F85FD7 35 01 B1 36 6C .DB $35,$01,$B1,$36,$6C,$33,$6F,$C6,$DF33 6F C6 DF8046 F85FE0 8C E9 80 C9 47 .DB $8C,$E9,$80,$C9,$47,$BA,$93,$A8,$41 ; 1E128BA 93 A8 4180478048 F85FE9 B2 EA FE 98 1B .DB $B2,$EA,$FE,$98,$1B,$90,$BB,$DD,$8D90 BB DD 8D8049 F85FF2 DE F9 9D FB EB .DB $DE,$F9,$9D,$FB,$EB,$7E,$AA,$51,$43 ; 1E2567E AA 51 438050 F85FFB8051 F85FFB E8 58 50 BC 54 .DB $E8,$58,$50,$BC,$54,$5C,$65,$CC,$C65C 65 CC C68052 F86004 91 0E A6 AE A0 .DB $91,$0E,$A6,$AE,$A0,$19,$E3,$A3,$46 ; 1E51219 E3 A3 4680538054 F8600D B0 50 8B F1 28 .DB $B0,$50,$8B,$F1,$28,$3D,$0D,$65,$173D 0D 65 178055 F86016 0C 75 81 86 75 .DB $0C,$75,$81,$86,$75,$76,$C9,$48,$4D ; 1E102476 C9 48 4D80568057 F8601F 22 CE 9A 32 CE .DB $22,$CE,$9A,$32,$CE,$28,$4D,$A7,$E428 4D A7 E48058 F86028 5D 3D C5 5D 3B .DB $5D,$3D,$C5,$5D,$3B,$8B,$9E,$92,$5A ; 1E20488B 9E 92 5A80598060 F86031 fce4096:8061 F86031 1A 4A 4A 80 3F .DB $1A,$4A,$4A,$80,$3F,$15,$4C,$C9,$9A15 4C C9 9A8062 F8603A 97 20 8A 02 52 .DB $97,$20,$8A,$02,$52,$60,$C4,$25,$75 ; 1E409660 C4 25 7580638064 000012 FCSIZ .EQU $-fce4096Tue Jul 17 11:00:18 2018 Page 9680658066 ; constants address used by scxale10 routine8067 F86043 fcaddr:8068 F86043 FF5E 115F 235F .DW fce0, fce1, fce2, fce3, fce4, fce5, fce6, fce7355F 475F 595F6B5F 7D5F80698070 ;----------------------------------------------------------------------------8071 ; square root & cube root8072 ;----------------------------------------------------------------------------8073 F860538074 ; fsqrt - return the square root of the argument8075 ;8076 ; entry:8077 ; fac = x8078 ;8079 ; exit:8080 ; fac = sqrt(x)8081 ; CF = 1 if invalid result (nan, inf)8082 ;8083 ; strategy:8084 ; range reduction involves isolating the power of two of the8085 ; argument and using a rational approximation to obtain8086 ; a rough value for the square root; then Heron's (Newton) iteration8087 ; is used four times to converge to an accurate value.8088 ;8089 ; 1) range reduction is accomplished by separating the argument x8090 ; into an integer M and fraction z such that:8091 ;8092 ; 2*M8093 ; x = z * 2 with: 0.25 <= z < 18094 ;8095 ; 2) obtain a rough value w for the square root of z by a8096 ; rational approximation:8097 ;8098 ; w = A*z + B - C/(z + D) (accuracy: 10/12 bits)8099 ;8100 ; 3) the estimate w is used as initial seed for Heron's iteration:8101 ;8102 ; y[n+1] = 0.5*(y[n] + z/y[n]) where y[0] = w, n = 38103 ;8104 ; 4) finally, the square root of the x is obtained scaling back y:8105 ;8106 ; M M8107 ; sqrt(x) = sqrt(z) * 2 = y * 28108 ;8109 ; computation mean time: 30ms at 4MHz8110 ;8111 ;-----8112 F86053 fsqrt:8113 ;-----8114 F86053 24 25 bit facst ; fac is valid?8115 F86055 10 0B bpl ?fv ; yes8116 F86057 70 07 bvs ?er ; fac=nan so return nan8117 F86059 24 24 bit facsgn ; fac=inf so check sign8118 F8605B 10 03 bpl ?er ; fac=+inf so return +inf8119 F8605D 4C 74 4E ?nan: jmp fldnan ; fac=-inf so return nanTue Jul 17 11:00:18 2018 Page 978120 F86060 38 ?er: sec8121 F86061 60 rts8122 F86062 50 04 ?fv: bvc ?xp ; fac is not zero8123 F86064 64 24 stz facsgn ; fac=+/-0 return always +08124 F86066 18 clc8125 F86067 60 rts8126 F86068 24 24 ?xp: bit facsgn ; check if fac>08127 F8606A 30 F1 bmi ?nan ; fac<0 so return nan8128 F8606C 20 6E 48 jsr frexp ; reduce argument to range [0.5,1)8129 F8606F CPU168130 F8606F C2 30 rep #(PMFLAG.OR.PXFLAG)8131 .LONGA on8132 .LONGI on8133 .MNLIST8134 F86071 A5 46 lda scexp ; the true 2 exponent8135 F86073 AA tax8136 F86074 4A lsr a ; CF=0 if exponent is divisible by 28137 F86075 8A txa ; C=exponent8138 F86076 90 03 bcc ?sgn ; divisible by 28139 F86078 C6 22 dec facexp ; reduce argument to range [0.25, 0.5)8140 F8607A 1A inc a ; increment the exponent (now divisible by 2)8141 F8607B 0A ?sgn: asl a ; CF=exponent sign8142 F8607C 90 01 bcc ?sgn2 ; positive8143 F8607E 1A inc a ; negative: put sign in bit 08144 F8607F 6A ?sgn2: ror a ; restore exponent8145 F86080 6A ror a ; divide by 2 with sign extension8146 F86081 85 46 sta scexp ; scexp = M, fac = z8147 F86083 CPU088148 F86083 E2 30 sep #(PMFLAG.OR.PXFLAG)8149 .LONGA off8150 .LONGI off8151 .MNLIST8152 F860858153 ; approximate sqrt(z) in range [0.25,1) with rational function:8154 ; w = A*z + B - C/(z + D) (accuracy: 10/12 bits)8155 F86085 20 66 84 jsr mvf_t0 ; tfr0 = z8156 F86088 20 67 45 jsr faddhalf ; z + D (D=0.5)8157 F8608B A9 D0 lda #<sqc ; C8158 F8608D A0 61 ldy #>sqc8159 F8608F 20 01 4A jsr fcdiv ; C/(z + D)8160 F86092 A9 BE lda #<sqb ; B8161 F86094 A0 61 ldy #>sqb8162 F86096 20 5C 45 jsr fcsub ; B - C/(z + D)8163 F86099 20 93 84 jsr mvf_t18164 F8609C 20 47 85 jsr mvt0_f ; z8165 F8609F A9 AC lda #<sqa ; A8166 F860A1 A0 61 ldy #>sqa8167 F860A3 20 D5 49 jsr fcmult ; A*z8168 F860A6 20 FB 85 jsr mvt1_a8169 F860A9 20 7D 45 jsr fpadd ; A*z + B - C/(z + D)81708171 ; Hero's iteration four times8172 F860AC 20 BB 60 jsr ?nit8173 F860AF 20 BB 60 jsr ?nit8174 F860B2 20 BB 60 jsr ?nit8175 F860B5 20 BB 60 jsr ?nit ; fac=sqrt(z)8176Tue Jul 17 11:00:18 2018 Page 988177 F860B8 4C B7 48 jmp fscale ; fac=sqrt(z)*(2^M)=sqrt(x)81788179 ; newton iteration for sqrt8180 ; y[n+1] = 0.5*(y[n] + z/y[n])8181 ; where y[0]=w is the initial seed value8182 ; note that is safe, when fac is normal and limited,8183 ; to multiplies by 2 simply incrementing the exponent8184 F860BB 20 93 84 ?nit: jsr mvf_t1 ; tfr1 = y[n]8185 F860BE 20 CE 85 jsr mvt0_a ; arg = z8186 F860C1 20 10 4A jsr fpdiv ; x/y[n]8187 F860C4 20 FB 85 jsr mvt1_a ; arg = y[n]8188 F860C7 20 7D 45 jsr fpadd ; y[n] + z/y[n]8189 F860CA ACC168190 F860CA C2 20 rep #PMFLAG8191 .LONGA on8192 .MNLIST8193 F860CC C6 22 dec facexp ; y[n+1] = 0.5*(y[n] + z/y[n])8194 F860CE ACC088195 F860CE E2 20 sep #PMFLAG8196 .LONGA off8197 .MNLIST8198 F860D0 60 rts81998200 ; fcbrt - return the cube root of the argument8201 ;8202 ; entry:8203 ; fac = x8204 ;8205 ; exit:8206 ; fac = cbrt(x)8207 ; CF = 1 if invalid result (nan, inf)8208 ;8209 ; strategy:8210 ; range reduction involves isolating the power of two of the8211 ; argument and using a rational approximation to obtain8212 ; a rough value for the cube root; then one Newton iteration followed8213 ; by one Halley iteration is used to converge to an accurate value.8214 ;8215 ; 1) range reduction is accomplished by separating the argument x8216 ; into an integer M and fraction z such that:8217 ;8218 ; 3*M8219 ; x = z * 2 with: 0.125 <= z < 18220 ;8221 ; 2) obtain a rough value w for the square root of z by a8222 ; rational approximation of 8th degree:8223 ;8224 ; w = N(z)/D(z) (accuracy: 22/24 bits)8225 ;8226 ; 3) the estimate w is used as initial seed for Newton's iteration:8227 ;8228 ; p = (1/3)*((z/w*w)) + 2*w)8229 ;8230 ; 4) the estimate p is used as seed for final Halley's iteration:8231 ;8232 ; y = p*((p*p*p+2*z)/(2*p*p*p+z))8233 ;Tue Jul 17 11:00:18 2018 Page 998234 ; 5) finally, the cube root of the x is obtained scaling back y:8235 ;8236 ; M M8237 ; cbrt(x) = cbrt(z) * 2 = y * 28238 ;8239 ; computation mean time: 75/80ms at 4MHz8240 ;8241 ;-----8242 F860D1 fcbrt:8243 ;-----8244 F860D1 24 25 bit facst ; if fac is not valid return nan if fac=nan...8245 F860D3 30 04 bmi ?er ; ...or return inf if fac=inf (same fac sign)8246 F860D5 50 04 bvc ?ok ; fac is not zero8247 F860D7 18 clc ; return fac=08248 F860D8 60 rts8249 F860D9 38 ?er: sec8250 F860DA 60 rts8251 F860DB A5 24 ?ok: lda facsgn ; save fac sign...8252 F860DD 85 4A sta dsgn8253 F860DF 64 24 stz facsgn ; ...and work with absolute value8254 F860E1 20 6E 48 jsr frexp ; reduce argument to range [0.5,1)8255 F860E4 CPU168256 F860E4 C2 30 rep #(PMFLAG.OR.PXFLAG)8257 .LONGA on8258 .LONGI on8259 .MNLIST8260 F860E6 A2 03 00 ldx #38261 F860E9 A5 48 lda dexp ; absolute value of the exponent8262 F860EB 20 11 88 jsr udiv ; C=quotient, Y=remainder (unsigned)8263 F860EE BB tyx8264 F860EF F0 2B beq ?go ; remainder=0, exponent is divisible by 38265 F860F1 98 tya ; C=remainder8266 F860F2 A4 46 ldy scexp ; check exponent sign8267 F860F4 30 06 bmi ?ne ; handle negative exponent8268 F860F6 38 sec ; C=remainder, compute remainder such that...8269 F860F7 E9 03 00 sbc #3 ; ...(exponent-C) is divisible by 38270 F860FA 80 04 bra ?ne28271 F860FC 49 FF FF ?ne: eor #$FFFF ; exponent is negative...8272 F860FF 1A inc a ; ...so change sign to remainder8273 F86100 85 3E ?ne2: sta wftmp ; save for later use8274 F86102 18 clc8275 F86103 65 22 adc facexp ; reduce argument to range [0.125,1)8276 F86105 85 22 sta facexp8277 F86107 38 sec8278 F86108 A5 46 lda scexp ; find the new exponent after reduction8279 F8610A E5 3E sbc wftmp8280 F8610C F0 16 beq ?go2 ; exponent=08281 F8610E 85 46 sta scexp8282 F86110 10 04 bpl ?pe8283 F86112 49 FF FF eor #$FFFF8284 F86115 1A inc a8285 F86116 A2 03 00 ?pe: ldx #3 ; now exponent is divisible by 38286 F86119 20 11 88 jsr udiv ; C=new exponent8287 F8611C A6 46 ?go: ldx scexp ; change sign if negative8288 F8611E 10 04 bpl ?go28289 F86120 49 FF FF eor #$FFFF8290 F86123 1A inc aTue Jul 17 11:00:18 2018 Page 1008291 F86124 85 46 ?go2: sta scexp ; scexp=M=exponent of cube root8292 F86126 CPU08 ; fac=z, range: [1/8, 1)8293 F86126 E2 30 sep #(PMFLAG.OR.PXFLAG)8294 .LONGA off8295 .LONGI off8296 .MNLIST82978298 ; approximate cbrt(z) in range [0.125,1) with rational function:8299 ; w = N(z)/D(z) (accuracy: 22/24 bits)8300 F86128 20 66 84 jsr mvf_t0 ; tfr0 = z8301 F8612B A9 F4 lda #<cbrn ; evaluate numerator8302 F8612D A0 61 ldy #>cbrn8303 F8612F A2 04 ldx #4 ; degree=48304 F86131 20 1C 87 jsr peval8305 F86134 20 93 84 jsr mvf_t1 ; tfr1=N(z)8306 F86137 A9 4E lda #<cbrd ; evaluate denominator8307 F86139 A0 62 ldy #>cbrd8308 F8613B A2 04 ldx #4 ; degree=48309 F8613D 20 1C 87 jsr peval8310 F86140 20 FB 85 jsr mvt1_a ; arg=N(z)8311 F86143 20 10 4A jsr fpdiv ; w=N(z)/D(z)83128313 F86146 20 54 61 jsr ?nit ; Newton's iteration (evaluate p)8314 F86149 20 73 61 jsr ?hit ; Halley's iteration (evaluate y)8315 F8614C8316 F8614C 20 B7 48 jsr fscale ; fac=cbrtt(z)*(2^M)=sqrt(x)8317 F8614F A5 4A lda dsgn ; restore original argument sign8318 F86151 85 24 sta facsgn8319 F86153 60 rts8320 F861548321 ?nit: ; Newton's iteration8322 ; p = (1/3)*((z/w*w)) + 2*w)8323 F86154 20 93 84 jsr mvf_t1 ; tfr1 = w (initial seed)8324 F86157 20 CC 49 jsr fsquare ; w*w8325 F8615A 20 CE 85 jsr mvt0_a ; arg=z8326 F8615D 20 10 4A jsr fpdiv ; z/(w*w)8327 F86160 20 FB 85 jsr mvt1_a ; arg=w8328 F86163 ACC16 ; is safe here simply increment exponent8329 F86163 C2 20 rep #PMFLAG8330 .LONGA on8331 .MNLIST8332 F86165 E6 3A inc argexp ; arg=2*w8333 F86167 ACC088334 F86167 E2 20 sep #PMFLAG8335 .LONGA off8336 .MNLIST8337 F86169 20 7D 45 jsr fpadd ; 2*w + z/(w*w)8338 F8616C A9 E2 lda #<c13 ; 1/38339 F8616E A0 61 ldy #>c138340 F86170 4C D5 49 jmp fcmult ; p = (1/3)*((x/(w*w)) + 2*w)83418342 ?hit: ; Halley's iteration8343 ; y = p*((p*p*p+2*z)/(2*p*p*p+z))8344 F86173 20 93 84 jsr mvf_t1 ; tfr1=p8345 F86176 20 CC 49 jsr fsquare ; p*p8346 F86179 20 FB 85 jsr mvt1_a8347 F8617C 20 DD 49 jsr fpmult ; p*p*pTue Jul 17 11:00:18 2018 Page 1018348 F8617F 20 C0 84 jsr mvf_t2 ; tfr2=p*p*p8349 F86182 20 CE 85 jsr mvt0_a ; z8350 F86185 ACC16 ; is safe here simply increment exponent8351 F86185 C2 20 rep #PMFLAG8352 .LONGA on8353 .MNLIST8354 F86187 E6 3A inc argexp ; 2*z8355 F86189 ACC088356 F86189 E2 20 sep #PMFLAG8357 .LONGA off8358 .MNLIST8359 F8618B 20 7D 45 jsr fpadd8360 F8618E 20 ED 84 jsr mvf_t3 ; tfr3=p*p*p+2*X8361 F86191 20 28 86 jsr mvt2_a ; p*p*p8362 F86194 ACC16 ; is safe here simply increment exponent8363 F86194 C2 20 rep #PMFLAG8364 .LONGA on8365 .MNLIST8366 F86196 E6 3A inc argexp ; 2*p*p*p8367 F86198 ACC088368 F86198 E2 20 sep #PMFLAG8369 .LONGA off8370 .MNLIST8371 F8619A 20 47 85 jsr mvt0_f ; z8372 F8619D 20 7D 45 jsr fpadd ; 2*p*p*p+z8373 F861A0 20 55 86 jsr mvt3_a ; p*p*p+2*z8374 F861A3 20 10 4A jsr fpdiv ; (p*p*p+2*z)/(2*p*p*p+z)8375 F861A6 20 FB 85 jsr mvt1_a ; p8376 F861A9 4C DD 49 jmp fpmult ; p*((p*p*p+2*z)/(2*p*p*p+z))83778378 ; coefficients for initial rational approximation to square root8379 ; R(x) = Ax + B - C/(x + D) 10 bit (0.25 <= x < 1, D=0.5)8380 F861AC 62 47 23 98 80 sqa: .DB $62,$47,$23,$98,$80,$52,$B7,$9F,$F752 B7 9F F78381 F861B5 6F 60 5B 7C 8C .DB $6F,$60,$5B,$7C,$8C,$BA,$AF,$FD,$3F ; A=0.343220129185BA AF FD 3F8382 F861BE 9E BA E5 B7 91 sqb: .DB $9E,$BA,$E5,$B7,$91,$09,$68,$DF,$B209 68 DF B28383 F861C7 76 6E E6 E6 13 .DB $76,$6E,$E6,$E6,$13,$52,$E6,$FE,$3F ; B=0.89968990695252 E6 FE 3F8384 F861D0 4C 28 D6 5D 7A sqc: .DB $4C,$28,$D6,$5D,$7A,$85,$E9,$00,$8185 E9 00 818385 F861D9 17 23 D0 C7 70 .DB $17,$23,$D0,$C7,$70,$63,$BA,$FD,$3F ; C=0.36403992118063 BA FD 3F83868387 F861E2 AA AA AA AA AA c13: .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AAAA AA AA AA8388 F861EB AA AA AA AA AA .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FD,$3F ; 1/3AA AA FD 3F83898390 ; coefficients for initial rational approximation to cube root (0.125 <= x < 1)8391 cbrn: ; numerator coefficients (degree 4)8392 ; N[4] = 45.25483397568030225119874948393 F861F4 3C 10 33 78 FE .DB $3C,$10,$33,$78,$FE,$76,$9E,$89,$D076 9E 89 D08394 F861FD 83 D3 9D 32 F3 .DB $83,$D3,$9D,$32,$F3,$04,$B5,$04,$4004 B5 04 40Tue Jul 17 11:00:18 2018 Page 1028395 ; N[3] = 192.27983683550610504581346258396 F86206 08 E3 5B 8C F2 .DB $08,$E3,$5B,$8C,$F2,$49,$06,$80,$9749 06 80 978397 F8620F 00 B7 08 63 A3 .DB $00,$B7,$08,$63,$A3,$47,$C0,$06,$4047 C0 06 408398 ; N[2] = 119.16548242855816289569141438399 F86218 42 D8 BC 63 FD .DB $42,$D8,$BC,$63,$FD,$2F,$EF,$90,$642F EF 90 648400 F86221 9F 70 E5 1C BA .DB $9F,$70,$E5,$1C,$BA,$54,$EE,$05,$4054 EE 05 408401 ; N[1] = 13.432501390862398721728373148402 F8622A AA 47 0C 1F 85 .DB $AA,$47,$0C,$1F,$85,$FF,$A0,$76,$20FF A0 76 208403 F86233 00 A8 13 94 86 .DB $00,$A8,$13,$94,$86,$EB,$D6,$02,$40EB D6 02 408404 ; N[0] = 0.16361612265857542409583550638405 F8623C 7B C3 D8 3A B4 .DB $7B,$C3,$D8,$3A,$B4,$CC,$8B,$32,$6DCC 8B 32 6D8406 F86245 69 E9 AA 1F FC .DB $69,$E9,$AA,$1F,$FC,$8A,$A7,$FC,$3F8A A7 FC 3F84078408 cbrd: ; denominator coefficients (degree 4)8409 ; D[4] = 14.808840932191345737864808458410 F8624E 1A 8E 1C AB 2F .DB $1A,$8E,$1C,$AB,$2F,$1C,$FF,$A5,$491C FF A5 498411 F86257 05 D9 76 30 03 .DB $05,$D9,$76,$30,$03,$F1,$EC,$02,$40F1 EC 02 408412 ; D[3] = 151.97140510444356486585576688413 F86260 7A 6B 6B 1C FD .DB $7A,$6B,$6B,$1C,$FD,$4E,$DD,$A5,$C74E DD A5 C78414 F86269 A8 C0 42 01 AE .DB $A8,$C0,$42,$01,$AE,$F8,$97,$06,$40F8 97 06 408415 ; D[2] = 168.52544141015682839576683438416 F86272 F6 AE F6 BD 0C .DB $F6,$AE,$F6,$BD,$0C,$B1,$C7,$0B,$85B1 C7 0B 858417 F8627B 73 96 08 54 83 .DB $73,$96,$08,$54,$83,$86,$A8,$06,$4086 A8 06 408418 ; D[1] = 33.99059413502155987541918728419 F86284 9C 0A 30 D2 E7 .DB $9C,$0A,$30,$D2,$E7,$F9,$A1,$D1,$F6F9 A1 D1 F68420 F8628D A7 1B 16 4F 5E .DB $A7,$1B,$16,$4F,$5E,$F6,$87,$04,$40F6 87 04 408421 ; D[0] = 18422 F86296 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 008423 F8629F 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FF,$3F00 80 FF 3F84248425 ;----------------------------------------------------------------------------8426 ; logarithmic family functions8427 ;----------------------------------------------------------------------------84288429 ; flogep1 - return natural logarithm (base e) of x + 18430 ;8431 ; entry:8432 ; fac = x8433 ;Tue Jul 17 11:00:18 2018 Page 1038434 ; exit:8435 ; fac = loge(1 + x)8436 ; CF = 1 if invalid result (nan, inf)8437 ;8438 ; computation mean time: 75/125ms at 4MHz8439 ;8440 ;-------8441 F862A8 flogep1:8442 ;-------8443 F862A8 20 91 63 jsr cmnlogp1 ; return the logarithm of the fractional part8444 F862AB A5 46 lda scexp ; if exponent M of the argument is zero...8445 F862AD 05 47 ora scexp+1 ; ...we finish here...8446 F862AF D0 0D bne lgem ; ...otherwise we add the loge(M)8447 F862B1 18 clc ; return valid flag8448 F862B2 60 rts84498450 ; floge - return natural logarithm (base e) of x8451 ;8452 ; entry:8453 ; fac = x8454 ;8455 ; exit:8456 ; fac = loge(x)8457 ; CF = 1 if invalid result (nan, inf)8458 ;8459 ; computation mean time: 75/125ms at 4MHz8460 ;8461 ;-----8462 F862B3 floge:8463 ;-----8464 F862B3 20 DC 63 jsr cmnlog ; return the logarithm of the fractional part8465 F862B6 A5 46 lda scexp ; if exponent M of the argument is zero...8466 F862B8 05 47 ora scexp+1 ; ...we finish here...8467 F862BA D0 02 bne lgem ; ...otherwise we add the loge(M)8468 F862BC 18 clc ; return valid flag8469 F862BD 60 rts84708471 ; lgem - evaluate loge(2)*M and add to logarithm of fractional part8472 ;8473 ; M8474 ; log(x) = loge(f * 2 ) = loge(f) + M * loge(2)8475 ;8476 ;----8477 F862BE lgem:8478 ;----8479 F862BE 20 C0 84 jsr mvf_t2 ; tfr2=loge(f)8480 F862C1 A5 46 lda scexp8481 F862C3 A4 47 ldy scexp+18482 F862C5 20 5B 4F jsr fldu16 ; convert exponent M to float8483 F862C8 A5 45 lda scsgn8484 F862CA 85 24 sta facsgn ; sign of the exponent M8485 F862CC 20 66 84 jsr mvf_t08486 F862CF A9 8D lda #<ln2c1 ; now evaluate M * loge(2)...8487 F862D1 A0 67 ldy #>ln2c18488 F862D3 20 D5 49 jsr fcmult8489 F862D6 20 93 84 jsr mvf_t1 ; ...splitted in two8490 F862D9 20 47 85 jsr mvt0_fTue Jul 17 11:00:18 2018 Page 1048491 F862DC A9 9F lda #<ln2c28492 F862DE A0 67 ldy #>ln2c28493 F862E0 20 D5 49 jsr fcmult8494 F862E3 20 28 86 jsr mvt2_a8495 F862E6 20 7D 45 jsr fpadd8496 F862E9 20 FB 85 jsr mvt1_a8497 F862EC 4C 7D 45 jmp fpadd8498 F862EF8499 ; flog10p1 - return decimal logarithm (base 10) of x + 18500 ;8501 ; entry:8502 ; fac = x8503 ;8504 ; exit:8505 ; fac = log10(1 + x)8506 ; CF = 1 if invalid result (nan, inf)8507 ;8508 ; computation mean time: 85/140ms at 4MHz8509 ;8510 ;--------8511 F862EF flog10p1:8512 ;--------8513 F862EF 20 91 63 jsr cmnlogp1 ; return the loge of the fractional part8514 F862F2 20 3C 63 jsr lg10 ; return the log10 of the fractional part8515 F862F5 A5 46 lda scexp ; if exponent M of the argument is zero...8516 F862F7 05 47 ora scexp+1 ; ...we finish here...8517 F862F9 D0 10 bne lg10m ; ...otherwise we add the loge(M)8518 F862FB 18 clc ; return valid flag8519 F862FC 60 rts85208521 ; flog10 - return decimal logarithm (base 10) of x8522 ;8523 ; entry:8524 ; fac = x8525 ;8526 ; exit:8527 ; fac = log10(x)8528 ; CF = 1 if invalid result (nan, inf)8529 ;8530 ; computation mean time: 85/140ms at 4MHz8531 ;8532 ;------8533 F862FD flog10:8534 ;------8535 F862FD 20 DC 63 jsr cmnlog ; return the loge of the fractional part8536 F86300 20 3C 63 jsr lg10 ; return the log10 of the fractional part8537 F86303 A5 46 lda scexp ; if exponent M of the argument is zero...8538 F86305 05 47 ora scexp+1 ; ...we finish here...8539 F86307 D0 02 bne lg10m ; ...otherwise we add the loge(M)8540 F86309 18 clc ; return valid flag8541 F8630A 60 rts85428543 ; lg10m - evaluate log10(2)*M and add to logarithm of fractional part8544 ;8545 ; M8546 ; log(x) = log(f * 2 ) = log10(f) + M * log10(2)8547 ;Tue Jul 17 11:00:18 2018 Page 1058548 ;-----8549 F8630B lg10m:8550 ;-----8551 F8630B 20 C0 84 jsr mvf_t2 ; tfr2=log10(f)8552 F8630E A5 46 lda scexp8553 F86310 A4 47 ldy scexp+18554 F86312 20 5B 4F jsr fldu16 ; convert exponent M to float8555 F86315 A5 45 lda scsgn8556 F86317 85 24 sta facsgn ; sign of the exponent M8557 F86319 20 66 84 jsr mvf_t08558 F8631C A9 C3 lda #<l102a ; now evaluate M * log10(2)...8559 F8631E A0 67 ldy #>l102a8560 F86320 20 D5 49 jsr fcmult8561 F86323 20 93 84 jsr mvf_t1 ; ...splitted in two8562 F86326 20 47 85 jsr mvt0_f8563 F86329 A9 D5 lda #<l102b8564 F8632B A0 67 ldy #>l102b8565 F8632D 20 D5 49 jsr fcmult8566 F86330 20 28 86 jsr mvt2_a8567 F86333 20 7D 45 jsr fpadd8568 F86336 20 FB 85 jsr mvt1_a8569 F86339 4C 7D 45 jmp fpadd85708571 ; lg10 - convert the natural logarithm into decimal logarithm8572 ;8573 ; multiplies the log of the fraction by log10(e)8574 ;8575 ;----8576 F8633C lg10:8577 ;----8578 F8633C 20 66 84 jsr mvf_t0 ; tfr0=loge(f)8579 F8633F A9 E7 lda #<l10ea8580 F86341 A0 67 ldy #>l10ea8581 F86343 20 D5 49 jsr fcmult8582 F86346 20 93 84 jsr mvf_t18583 F86349 20 47 85 jsr mvt0_f8584 F8634C A9 F9 lda #<l10eb8585 F8634E A0 67 ldy #>l10eb8586 F86350 20 D5 49 jsr fcmult8587 F86353 20 FB 85 jsr mvt1_a8588 F86356 4C 7D 45 jmp fpadd85898590 ; flog2p1 - return the base 2 logarithm of x + 18591 ;8592 ; entry:8593 ; fac = x8594 ;8595 ; exit:8596 ; fac = log2(1 + x)8597 ; CF = 1 if invalid result (nan, inf)8598 ;8599 ; computation mean time: 80/130ms at 4MHz8600 ;8601 ;-------8602 F86359 flog2p1:8603 ;-------8604 F86359 20 91 63 jsr cmnlogp1 ; return the loge of the fractional partTue Jul 17 11:00:18 2018 Page 1068605 F8635C A9 0B lda #<lg2e ; return the log2 of the fractional part8606 F8635E A0 68 ldy #>lg2e8607 F86360 20 D5 49 jsr fcmult8608 F86363 A5 46 lda scexp ; if exponent M of the argument is zero...8609 F86365 05 47 ora scexp+1 ; ...we finish here...8610 F86367 D0 14 bne lg2m ; ...otherwise we add M8611 F86369 18 clc ; return valid flag8612 F8636A 60 rts86138614 ; flog2 - return the base 2 logarithm of x8615 ;8616 ; entry:8617 ; fac = x8618 ;8619 ; exit:8620 ; fac = log2(x)8621 ; CF = 1 if invalid result (nan, inf)8622 ;8623 ; computation mean time: 80/130ms at 4MHz8624 ;8625 ;-----8626 F8636B flog2:8627 ;-----8628 F8636B 20 DC 63 jsr cmnlog ; return the loge of the fractional part8629 F8636E A9 0B lda #<lg2e ; return the log2 of the fractional part8630 F86370 A0 68 ldy #>lg2e8631 F86372 20 D5 49 jsr fcmult8632 F86375 A5 46 lda scexp ; if exponent M of the argument is zero...8633 F86377 05 47 ora scexp+1 ; ...we finish here...8634 F86379 D0 02 bne lg2m ; ...otherwise we add M8635 F8637B 18 clc ; return valid flag8636 F8637C 60 rts86378638 ; lg2m - add exponent M to base 2 logarithm of fractional part8639 ;8640 ; M8641 ; log(x) = log(f * 2 ) = log2(f) + M8642 ;8643 ;----8644 F8637D lg2m:8645 ;----8646 F8637D 20 C0 84 jsr mvf_t2 ; tfr2=log2(f)8647 F86380 A5 46 lda scexp8648 F86382 A4 47 ldy scexp+18649 F86384 20 5B 4F jsr fldu16 ; convert exponent M to float8650 F86387 A5 45 lda scsgn8651 F86389 85 24 sta facsgn ; sign of the exponent M8652 F8638B 20 28 86 jsr mvt2_a8653 F8638E 4C 7D 45 jmp fpadd8654 F863918655 ; cmnlogp1 - common logarithm evaluation8656 ; return the natural logarithm (base e) of the fraction of x + 18657 ;8658 ; Note that when evaluate log(x) with x very close to one, cancellation8659 ; caused by computation of x - 1 can give a degrated result (precision loss).8660 ; To avoid this negative effect is better evaluate log(1+x) when argument8661 ; is very closed to one.Tue Jul 17 11:00:18 2018 Page 1078662 ;8663 ; entry:8664 ; fac = xm1 (xm1 = x - 1)8665 ;8666 ; exit:8667 ; fac = loge(f), f = fraction of xm1 + 18668 ; scexp = M = exponent of the argument8669 ;8670 ; where:8671 ; M8672 ; 1 + x = f * 2 sqrt(2)/2 <= f < sqrt(2)8673 ;8674 ; strategy:8675 ; The argument is separated into its exponent and fractional parts.8676 ; If the exponent is between -2 and +2, the logarithm of the fraction,8677 ; setting y = f - 1, is approximated by:8678 ;8679 ; 2 38680 ; loge(1+y) = y - 0.5 * y + y * P(y)/Q(y)8681 ;8682 ; otherwise, setting y = 2(f - 1)/(f + 1), is approximated by:8683 ;8684 ; 3 28685 ; loge(f) = y + y * R(z)/S(z), where z = y8686 ;8687 ;--------8688 F86391 cmnlogp1:8689 ;--------8690 F86391 24 25 bit facst8691 F86393 30 1C bmi ?nv ; invalid xm18692 F86395 18 clc8693 F86396 70 23 bvs ?ex ; xm1=0 so return 08694 F86398 20 93 84 jsr mvf_t1 ; tfr1=xm18695 F8639B 20 6C 45 jsr faddone ; x=1+xm18696 F8639E B0 1B bcs ?ex ; x=+inf so return +inf8697 F863A0 24 24 bit facsgn8698 F863A2 30 13 bmi ?nan ; x<0 so return -nan8699 F863A4 24 25 bit facst8700 F863A6 50 16 bvc ?ok ; ok, x > 08701 F863A8 20 7D 4E jsr fldinf ; x=0 so return -inf8702 F863AB A9 FF lda #$FF8703 F863AD 85 24 sta facsgn8704 F863AF 80 09 bra ?er8705 F863B1 70 07 ?nv: bvs ?er ; xm1=nan so return nan8706 F863B3 24 24 bit facsgn8707 F863B5 10 03 bpl ?er ; xm1=+inf so return +inf8708 F863B7 20 74 4E ?nan: jsr fldnan ; xm1=-inf so return -nan8709 F863BA 38 ?er: sec ; invalid fac8710 F863BB 68 ?ex: pla ; skip return address8711 F863BC 68 pla8712 F863BD 60 rts8713 F863BE 20 A6 64 ?ok: jsr logscl ; argument reduction & exponent extraction8714 F863C1 90 08 bcc ?tiny ; |M| < 38715 F863C3 20 66 84 jsr mvf_t0 ; tfr0=x8716 F863C6 20 71 45 jsr fsubone ; x-18717 F863C9 80 40 bra lge ; evaluation for |M| > 28718 F863CB A5 46 ?tiny: lda scexp ; if M=0...Tue Jul 17 11:00:18 2018 Page 1088719 F863CD 05 47 ora scexp+18720 F863CF F0 06 beq ?xm1 ; ...use argument xm18721 F863D1 20 71 45 jsr fsubone ; ...otherwise use x - 18722 F863D4 4C 5B 64 jmp lgep18723 F863D7 20 74 85 ?xm1: jsr mvt1_f ; use xm18724 F863DA 80 7F bra lgep187258726 ; cmnlog - common logarithm evaluation8727 ; return the natural logarithm (base e) of the fraction of the argument8728 ;8729 ; entry:8730 ; fac = x8731 ;8732 ; exit:8733 ; fac = loge(f)8734 ; scexp = M = exponent of the argument8735 ;8736 ; where:8737 ; M8738 ; x = f * 2 sqrt(2)/2 <= f < sqrt(2)8739 ;8740 ; strategy:8741 ; The argument is separated into its exponent and fractional parts.8742 ; If the exponent is between -2 and +2, the logarithm of the fraction,8743 ; setting y = f - 1, is approximated by:8744 ;8745 ; 2 38746 ; loge(1+y) = y - 0.5 * y + y * P(y)/Q(y)8747 ;8748 ; otherwise, setting y = 2(f - 1)/(f + 1), is approximated by:8749 ;8750 ; 3 28751 ; loge(f) = y + y * R(z)/S(z), where z = y8752 ;8753 ;------8754 F863DC cmnlog:8755 ;------8756 F863DC 24 25 bit facst ; fac must be valid and > 08757 F863DE 10 08 bpl ?ckz8758 F863E0 70 18 bvs ?er ; fac=nan so return nan8759 F863E2 24 24 bit facsgn ; if fac=+inf...8760 F863E4 10 14 bpl ?er ; ...return +inf...8761 F863E6 30 06 bmi ?nan ; ...else return nan8762 F863E8 70 09 ?ckz: bvs ?inf ; if fac=0 return -inf8763 F863EA 24 24 bit facsgn ; if fac>0 go to evaluation...8764 F863EC 10 10 bpl ?go ; ...else return nan8765 F863EE 20 74 4E ?nan: jsr fldnan ; return nan8766 F863F1 80 07 bra ?er8767 F863F3 A9 FF ?inf: lda #$FF ; return -inf8768 F863F5 85 24 sta facsgn8769 F863F7 20 7D 4E jsr fldinf8770 F863FA 68 ?er: pla ; skip return address8771 F863FB 68 pla8772 F863FC 38 sec ; return invalid result8773 F863FD 60 rts8774 F863FE 20 A6 64 ?go: jsr logscl ; argument reduction & exponent extraction8775 F86401 08 php ; save carry (cf=0 if |exponent| < 3)Tue Jul 17 11:00:18 2018 Page 1098776 F86402 20 66 84 jsr mvf_t0 ; tfr0=f8777 F86405 20 71 45 jsr fsubone ; fac=y=f-18778 F86408 28 plp8779 F86409 90 50 bcc lgep1 ; if |exponent| < 3 evaluate for (1+f)87808781 ; lge - approximate loge(f)8782 ;8783 ; 3 28784 ; loge(f) = y + y * R(z)/S(z), where z = y8785 ;8786 ; y = 2(f - 1)/(f + 1)8787 ;8788 ;---8789 F8640B lge:8790 ;---8791 F8640B 20 93 84 jsr mvf_t1 ; tfr1=y=f-18792 F8640E 20 47 85 jsr mvt0_f ; fac=f8793 F86411 20 6C 45 jsr faddone ; fac=f+18794 F86414 20 FB 85 jsr mvt1_a ; arg=f-18795 F86417 20 10 4A jsr fpdiv ; (f-1)/(f+1)8796 F8641A ACC168797 F8641A C2 20 rep #PMFLAG8798 .LONGA on8799 .MNLIST8800 F8641C A5 22 lda facexp8801 F8641E F0 03 beq ?isz ; y=08802 F86420 1A inc a ; note that here y is always normal8803 F86421 E6 22 inc facexp ; y=2*(x-1)/(x+1)8804 F86423 ?isz: ACC088805 F86423 E2 20 sep #PMFLAG8806 .LONGA off8807 .MNLIST8808 F86425 20 93 84 jsr mvf_t1 ; tfr1=y8809 F86428 20 CC 49 jsr fsquare ; z=y*y8810 F8642B 20 66 84 jsr mvf_t0 ; tfr0=z8811 F8642E A9 F3 lda #<clnr8812 F86430 A0 64 ldy #>clnr8813 F86432 A2 05 ldx #58814 F86434 20 1C 87 jsr peval ; evaluate R(z)8815 F86437 20 C0 84 jsr mvf_t2 ; tfr2=R(z)8816 F8643A A9 5F lda #<clns8817 F8643C A0 65 ldy #>clns8818 F8643E A2 05 ldx #58819 F86440 20 3A 87 jsr pevalp1 ; evaluate S(z)8820 F86443 20 28 86 jsr mvt2_a ; arg=R(z)8821 F86446 20 10 4A jsr fpdiv ; R(z)/S(z)8822 F86449 20 CE 85 jsr mvt0_a ; arg=z8823 F8644C 20 DD 49 jsr fpmult ; z*R(z)/S(z)8824 F8644F 20 FB 85 jsr mvt1_a ; arg=y8825 F86452 20 DD 49 jsr fpmult ; y*z*R(z)/S(z)8826 F86455 20 FB 85 jsr mvt1_a ; arg=y8827 F86458 4C 7D 45 jmp fpadd ; loge(f)=y+y*z*R(z)/S(z)8828 F8645B8829 ; lgep1 - approximate loge(1+y)8830 ;8831 ; 2 38832 ; loge(1+y) = y - 0.5 * y + y * P(y)/Q(y)Tue Jul 17 11:00:18 2018 Page 1108833 ;8834 ; y = f - 18835 ;8836 ;-----8837 F8645B lgep1:8838 ;-----8839 F8645B 20 66 84 jsr mvf_t0 ; tfr0=y=x-18840 F8645E 20 CC 49 jsr fsquare ; z=y*y8841 F86461 20 93 84 jsr mvf_t1 ; tfr1=z8842 F86464 A9 CB lda #<clnp8843 F86466 A0 65 ldy #>clnp8844 F86468 A2 0C ldx #128845 F8646A 20 1C 87 jsr peval ; evaluate P(y)8846 F8646D 20 C0 84 jsr mvf_t2 ; tfr2=P(y)8847 F86470 A9 B5 lda #<clnq8848 F86472 A0 66 ldy #>clnq8849 F86474 A2 0B ldx #118850 F86476 20 3A 87 jsr pevalp1 ; evaluate Q(y)8851 F86479 20 28 86 jsr mvt2_a ; P(y)8852 F8647C 20 10 4A jsr fpdiv ; P(y)/Q(y)8853 F8647F 20 FB 85 jsr mvt1_a ; z8854 F86482 20 DD 49 jsr fpmult ; z*P(y)/Q(y)8855 F86485 20 CE 85 jsr mvt0_a ; y8856 F86488 20 DD 49 jsr fpmult ; y*z*P(y)/Q(y)8857 F8648B 20 FB 85 jsr mvt1_a ; z8858 F8648E ACC168859 F8648E C2 20 rep #PMFLAG8860 .LONGA on8861 .MNLIST8862 F86490 A5 3A lda argexp8863 F86492 F0 03 beq ?isz ; z=08864 F86494 3A dec a8865 F86495 85 3A sta argexp ; z/28866 F86497 ?isz: ACC088867 F86497 E2 20 sep #PMFLAG8868 .LONGA off8869 .MNLIST8870 F86499 A9 FF lda #$FF8871 F8649B 85 3C sta argsgn ; arg=-z/28872 F8649D 20 7D 45 jsr fpadd ; y*z*(P(y)/Q(y)) - z/28873 F864A0 20 CE 85 jsr mvt0_a ; arg=y8874 F864A3 4C 7D 45 jmp fpadd ; loge(1+y)=y-z/2+y*z*(P(y)/Q(y))88758876 ; logscl - argument reduction for logarithm evaluation8877 ;8878 ; entry:8879 ; fac = x, valid float8880 ;8881 ; exit:8882 ; fac = f, reduced argument8883 ; scexp = |M|, exponent8884 ; scsgn = sign of M8885 ; CF = 0 if |M| < 38886 ;8887 ; M8888 ; x = f * 2 sqrt(2)/2 <= f < sqrt(2)8889 ;Tue Jul 17 11:00:18 2018 Page 1118890 ;------8891 F864A6 logscl:8892 ;------8893 F864A6 20 6E 48 jsr frexp ; now 0.5 <= fac < 18894 F864A9 A9 E1 lda #<rsqrt2h ; now compare fac vs. 1/sqrt(2)8895 F864AB A0 64 ldy #>rsqrt2h8896 F864AD 20 5E 87 jsr fccmp8897 F864B0 ACC168898 F864B0 C2 20 rep #PMFLAG8899 .LONGA on8900 .MNLIST8901 F864B2 F0 06 beq ?gte ; fac=1/sqrt(2)8902 F864B4 10 04 bpl ?gte ; fac>1/sqrt(2)8903 F864B6 E6 22 inc facexp ; fac=fac*2, now 1 <= fac < sqrt(2)8904 F864B8 C6 46 dec scexp ; decrement exponent8905 F864BA A2 00 ?gte: ldx #0 ; assume positive scaling exponent8906 F864BC A5 46 lda scexp8907 F864BE 10 07 bpl ?mp ; positive or null scaling8908 F864C0 CA dex ; negative scaling8909 F864C1 49 FF FF eor #$FFFF ; complement8910 F864C4 1A inc a8911 F864C5 85 46 sta scexp ; unsigned scaling exponent8912 F864C7 86 45 ?mp: stx scsgn ; sign of scaling exponent8913 F864C9 C9 03 00 cmp #3 ; return CF = 0 if |exponent| < 38914 F864CC ACC088915 F864CC E2 20 sep #PMFLAG8916 .LONGA off8917 .MNLIST8918 F864CE 60 rts89198920 ; unrounded 1/sqrt(2) - $B504F333F9DE6484597D89B3754ABE9FP3FFE8921 F864CF 9F BE 4A 75 B3 sqrth: .DB $9F,$BE,$4A,$75,$B3,$89,$7D,$59,$8489 7D 59 848922 F864D8 64 DE F9 33 F3 .DB $64,$DE,$F9,$33,$F3,$04,$B5,$FE,$3F04 B5 FE 3F89238924 ; 1/sqrt(2) rounded to 113 bits8925 F864E1 rsqrt2h:8926 F864E1 00 80 4A 75 B3 .DB $00,$80,$4A,$75,$B3,$89,$7D,$59,$8489 7D 59 848927 F864EA 64 DE F9 33 F3 .DB $64,$DE,$F9,$33,$F3,$04,$B5,$FE,$3F04 B5 FE 3F89288929 ; coefficients for log(x), rational function R()/S()8930 F864F3 clnr:8931 ; R[5] = -8.828896441624934385266096344596648080902E-18932 F864F3 8E 15 84 6B 67 .DB $8E,$15,$84,$6B,$67,$72,$AA,$CE,$2372 AA CE 238933 F864FC 34 AD A7 43 0E .DB $34,$AD,$A7,$43,$0E,$05,$E2,$FE,$BF05 E2 FE BF8934 ; R[4] = 8.057002716646055371965756206836056074715E18935 F86505 14 20 14 FB 86 .DB $14,$20,$14,$FB,$86,$D1,$08,$AB,$2DD1 08 AB 2D8936 F8650E 2B 8F CB 99 DA .DB $2B,$8F,$CB,$99,$DA,$23,$A1,$05,$4023 A1 05 408937 ; R[3] = -2.024301798136027039250415126250455056397E38938 F86517 BC EF D7 01 BF .DB $BC,$EF,$D7,$01,$BF,$A2,$EE,$76,$48Tue Jul 17 11:00:18 2018 Page 112A2 EE 76 488939 F86520 5B 87 90 54 A8 .DB $5B,$87,$90,$54,$A8,$09,$FD,$09,$C009 FD 09 C08940 ; R[2] = 2.048819892795278657810231591630928516206E48941 F86529 1C CC E3 20 15 .DB $1C,$CC,$E3,$20,$15,$6E,$6A,$18,$096E 6A 18 098942 F86532 F5 76 E2 D9 65 .DB $F5,$76,$E2,$D9,$65,$10,$A0,$0D,$4010 A0 0D 408943 ; R[1] = -8.977257995689735303686582344659576526998E48944 F8653B 37 36 95 61 03 .DB $37,$36,$95,$61,$03,$74,$9D,$2E,$4774 9D 2E 478945 F86544 9C 11 07 3C 4A .DB $9C,$11,$07,$3C,$4A,$56,$AF,$0F,$C056 AF 0F C08946 ; R[0] = 1.418134209872192732479751274970992665513E58947 F8654D A8 4A 7E 5A 28 .DB $A8,$4A,$7E,$5A,$28,$99,$7D,$53,$0199 7D 53 018948 F86556 B4 60 74 F1 5A .DB $B4,$60,$74,$F1,$5A,$7D,$8A,$10,$407D 8A 10 4089498950 F8655F clns:8951 ; S[5] = -1.186359407982897997337150403816839480438E28952 F8655F 3A 6E 31 96 EA .DB $3A,$6E,$31,$96,$EA,$56,$BE,$E6,$BA56 BE E6 BA8953 F86568 92 B1 45 08 9A .DB $92,$B1,$45,$08,$9A,$45,$ED,$05,$C045 ED 05 C08954 ; S[4] = 3.998526750980007367835804959888064681098E38955 F86571 C4 2A 76 05 E9 .DB $C4,$2A,$76,$05,$E9,$F4,$A8,$5F,$11F4 A8 5F 118956 F8657A 48 84 6F 92 6D .DB $48,$84,$6F,$92,$6D,$E8,$F9,$0A,$40E8 F9 0A 408957 ; S[3] = -5.748542087379434595104154610899551484314E48958 F86583 36 79 3E 93 5D .DB $36,$79,$3E,$93,$5D,$19,$08,$FE,$9319 08 FE 938959 F8658C 75 8E 62 BE 6B .DB $75,$8E,$62,$BE,$6B,$8D,$E0,$0E,$C08D E0 0E C08960 ; S[2] = 4.001557694070773974936904547424676279307E58961 F86595 36 7C 5E 8E 90 .DB $36,$7C,$5E,$8E,$90,$52,$EB,$2D,$7652 EB 2D 768962 F8659E 57 97 FB 9E 78 .DB $57,$97,$FB,$9E,$78,$63,$C3,$11,$4063 C3 11 408963 ; S[1] = -1.332535117259762928288745111081235577029E68964 F865A7 E8 C3 BB 00 81 .DB $E8,$C3,$BB,$00,$81,$59,$F2,$48,$4F59 F2 48 4F8965 F865B0 F7 E2 25 F0 B8 .DB $F7,$E2,$25,$F0,$B8,$A9,$A2,$13,$C0A9 A2 13 C08966 ; S[0] = 1.701761051846631278975701529965589676574E68967 F865B9 68 05 98 8B BC .DB $68,$05,$98,$8B,$BC,$65,$3C,$FD,$0165 3C FD 018968 F865C2 0E 91 2E 6A 08 .DB $0E,$91,$2E,$6A,$08,$BC,$CF,$13,$40BC CF 13 4089698970 ; coefficients for log(1+x), rational function P()/Q()8971 F865CB clnp:8972 ; P[12] = 1.538612243596254322971797716843006400388E-68973 F865CB 2A C3 7D B0 42 .DB $2A,$C3,$7D,$B0,$42,$00,$91,$A4,$A100 91 A4 A18974 F865D4 4A C1 76 6B 50 .DB $4A,$C1,$76,$6B,$50,$82,$CE,$EB,$3FTue Jul 17 11:00:18 2018 Page 11382 CE EB 3F8975 ; P[11] = 4.998469661968096229986658302195402690910E-18976 F865DD 6C FE CF 17 46 .DB $6C,$FE,$CF,$17,$46,$8D,$F4,$5A,$4E8D F4 5A 4E8977 F865E6 17 E6 A3 09 F1 .DB $17,$E6,$A3,$09,$F1,$EB,$FF,$FD,$3FEB FF FD 3F8978 ; P[10] = 2.321125933898420063925789532045674660756E18979 F865EF DD 55 73 C9 52 .DB $DD,$55,$73,$C9,$52,$31,$F5,$21,$A631 F5 21 A68980 F865F8 33 4B 7F BC A8 .DB $33,$4B,$7F,$BC,$A8,$B0,$B9,$03,$40B0 B9 03 408981 ; P[09] = 4.114517881637811823002128927449878962058E28982 F86601 62 F5 AF 82 FE .DB $62,$F5,$AF,$82,$FE,$EA,$8A,$CB,$29EA 8A CB 298983 F8660A 7D 14 CE 31 D4 .DB $7D,$14,$CE,$31,$D4,$B9,$CD,$07,$40B9 CD 07 408984 ; P[08] = 3.824952356185897735160588078446136783779E38985 F86613 98 15 15 FD 5B .DB $98,$15,$15,$FD,$5B,$9C,$06,$E3,$629C 06 E3 628986 F8661C 2F 09 D7 D9 3C .DB $2F,$09,$D7,$D9,$3C,$0F,$EF,$0A,$400F EF 0A 408987 ; P[07] = 2.128857716871515081352991964243375186031E48988 F86625 61 2D 76 77 32 .DB $61,$2D,$76,$77,$32,$6D,$65,$F8,$B46D 65 F8 B48989 F8662E B1 67 A8 82 27 .DB $B1,$67,$A8,$82,$27,$51,$A6,$0D,$4051 A6 0D 408990 ; P[06] = 7.594356839258970405033155585486712125861E48991 F86637 F5 CF 31 FA 60 .DB $F5,$CF,$31,$FA,$60,$22,$5B,$82,$A822 5B 82 A88992 F86640 08 A0 16 C1 C8 .DB $08,$A0,$16,$C1,$C8,$53,$94,$0F,$4053 94 0F 408993 ; P[05] = 1.797628303815655343403735250238293741397E58994 F86649 D2 08 FC D7 90 .DB $D2,$08,$FC,$D7,$90,$40,$A4,$21,$F640 A4 21 F68995 F86652 CA B8 F8 24 B5 .DB $CA,$B8,$F8,$24,$B5,$8C,$AF,$10,$408C AF 10 408996 ; P[04] = 2.854829159639697837788887080758954924001E58997 F8665B 98 EA 19 A8 D5 .DB $98,$EA,$19,$A8,$D5,$B8,$B8,$25,$24B8 B8 25 248998 F86664 D1 AB 93 4F 5D .DB $D1,$AB,$93,$4F,$5D,$65,$8B,$11,$4065 8B 11 408999 ; P[03] = 3.007007295140399532324943111654767187848E59000 F8666D 96 EF 0E 45 35 .DB $96,$EF,$0E,$45,$35,$32,$FC,$95,$4D32 FC 95 4D9001 F86676 F2 D3 2D 58 97 .DB $F2,$D3,$2D,$58,$97,$D3,$92,$11,$40D3 92 11 409002 ; P[02] = 2.014652742082537582487669938141683759923E59003 F8667F 5E E2 69 C5 8D .DB $5E,$E2,$69,$C5,$8D,$BE,$39,$2E,$D6BE 39 2E D69004 F86688 8B C6 A0 8C 51 .DB $8B,$C6,$A0,$8C,$51,$BE,$C4,$10,$40BE C4 10 409005 ; P[01] = 7.771154681358524243729929227226708890930E49006 F86691 AE E9 03 6A 3B .DB $AE,$E9,$03,$6A,$3B,$ED,$92,$AC,$F8ED 92 AC F89007 F8669A CF D0 FC FD C5 .DB $CF,$D0,$FC,$FD,$C5,$C7,$97,$0F,$40C7 97 0F 409008 ; P[00] = 1.313572404063446165910279910527789794488E4Tue Jul 17 11:00:18 2018 Page 1149009 F866A3 35 07 BE 83 BC .DB $35,$07,$BE,$83,$BC,$26,$2A,$5C,$A026 2A 5C A09010 F866AC F3 77 E8 6A E5 .DB $F3,$77,$E8,$6A,$E5,$3E,$CD,$0C,$403E CD 0C 409011 F866B59012 F866B5 clnq:9013 ; Q[11] = 4.839208193348159620282142911143429644326E19014 F866B5 19 97 D2 BF 46 .DB $19,$97,$D2,$BF,$46,$56,$ED,$89,$1056 ED 89 109015 F866BE A5 9F 26 ED 7D .DB $A5,$9F,$26,$ED,$7D,$91,$C1,$04,$4091 C1 04 409016 ; Q[10] = 9.104928120962988414618126155557301584078E29017 F866C7 C0 4E B7 7A BC .DB $C0,$4E,$B7,$7A,$BC,$63,$F1,$97,$7D63 F1 97 7D9018 F866D0 4F 2B BF 3B 8A .DB $4F,$2B,$BF,$3B,$8A,$9F,$E3,$08,$409F E3 08 409019 ; Q[09] = 9.147150349299596453976674231612674085381E39020 F866D9 E1 52 82 D3 69 .DB $E1,$52,$82,$D3,$69,$1A,$6A,$4C,$1D1A 6A 4C 1D9021 F866E2 F9 B2 2A F5 99 .DB $F9,$B2,$2A,$F5,$99,$EC,$8E,$0C,$40EC 8E 0C 409022 ; Q[08] = 5.605842085972455027590989944010492125825E49023 F866EB B8 65 30 7A BB .DB $B8,$65,$30,$7A,$BB,$1D,$CD,$02,$A21D CD 02 A29024 F866F4 25 81 76 BD 6B .DB $25,$81,$76,$BD,$6B,$FA,$DA,$0E,$40FA DA 0E 409025 ; Q[07] = 2.248234257620569139969141618556349415120E59026 F866FD A2 CA 5D F8 7F .DB $A2,$CA,$5D,$F8,$7F,$A4,$A6,$11,$B1A4 A6 11 B19027 F86706 94 7F AF 3F DB .DB $94,$7F,$AF,$3F,$DB,$8D,$DB,$10,$408D DB 10 409028 ; Q[06] = 6.132189329546557743179177159925690841200E59029 F8670F 7A 44 71 27 79 .DB $7A,$44,$71,$27,$79,$DE,$89,$E3,$39DE 89 E3 399030 F86718 73 DC 61 ED 2E .DB $73,$DC,$61,$ED,$2E,$B6,$95,$12,$40B6 95 12 409031 ; Q[05] = 1.158019977462989115839826904108208787040E69032 F86721 2A BB 38 BE F1 .DB $2A,$BB,$38,$BE,$F1,$46,$B7,$69,$6C46 B7 69 6C9033 F8672A 9A 1D D8 D1 1F .DB $9A,$1D,$D8,$D1,$1F,$5C,$8D,$13,$405C 8D 13 409034 ; Q[04] = 1.514882452993549494932585972882995548426E69035 F86733 C0 3A 8A D9 4A .DB $C0,$3A,$8A,$D9,$4A,$87,$5D,$9C,$0987 5D 9C 099036 F8673C 03 15 BB 9F 13 .DB $03,$15,$BB,$9F,$13,$EC,$B8,$13,$40EC B8 13 409037 ; Q[03] = 1.347518538384329112529391120390701166528E69038 F86745 70 CA B9 8E 83 .DB $70,$CA,$B9,$8E,$83,$73,$EC,$DA,$BC73 EC DA BC9039 F8674E 71 71 9C 4E F4 .DB $71,$71,$9C,$4E,$F4,$7D,$A4,$13,$407D A4 13 409040 ; Q[02] = 7.777690340007566932935753241556479363645E59041 F86757 10 A8 3B 99 11 .DB $10,$A8,$3B,$99,$11,$F5,$D7,$57,$97F5 D7 57 979042 F86760 A0 60 44 8B 90 .DB $A0,$60,$44,$8B,$90,$E2,$BD,$12,$40E2 BD 12 409043 ; Q[01] = 2.626900195321832660448791748036714883242E5Tue Jul 17 11:00:18 2018 Page 1159044 F86769 97 4B 94 D0 A5 .DB $97,$4B,$94,$D0,$A5,$28,$E9,$C7,$1B28 E9 C7 1B9045 F86772 0B F5 01 A0 40 .DB $0B,$F5,$01,$A0,$40,$44,$80,$11,$4044 80 11 409046 ; Q[00] = 3.940717212190338497730839731583397586124E49047 F8677B 95 DD E4 62 0D .DB $95,$DD,$E4,$62,$0D,$9D,$1F,$45,$B89D 1F 45 B89048 F86784 F6 59 2E 10 2C .DB $F6,$59,$2E,$10,$2C,$EF,$99,$0E,$40EF 99 0E 4090499050 ; C1 + C2 = loge(2) (splitted in two)9051 ; C1 = 6.93145751953125E-19052 F8678D 00 00 00 00 00 ln2c1: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 009053 F86796 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$72,$B1,$FE,$3F72 B1 FE 3F90549055 ; C2 = 1.428606820309417232121458176568075500134E-69056 F8679F 98 07 7A B5 97 ln2c2: .DB $98,$07,$7A,$B5,$97,$1F,$C0,$9C,$1D1F C0 9C 1D9057 F867A8 4F 5E CD 7B 8E .DB $4F,$5E,$CD,$7B,$8E,$BE,$BF,$EB,$3FBE BF EB 3F90589059 ; ln(2) = 0.69314718055994530941723212145817656807550019060 F867B1 AF F6 F2 03 98 cln2: .DB $AF,$F6,$F2,$03,$98,$B3,$E3,$C9,$ABB3 E3 C9 AB9061 F867BA 79 CF D1 F7 17 .DB $79,$CF,$D1,$F7,$17,$72,$B1,$FE,$3F72 B1 FE 3F90629063 ; log10(2) = l102a + l102b (splitted in two)9064 ; l102a = 0.31259065 F867C3 00 00 00 00 00 l102a: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 009066 F867CC 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$A0,$FD,$3F00 A0 FD 3F90679068 ; l102b = -1.14700043360188047862611052755069732318101185E-29069 F867D5 F8 D0 6D 90 7E l102b: .DB $F8,$D0,$6D,$90,$7E,$CA,$D4,$0E,$EECA D4 0E EE9070 F867DE 0C 01 86 60 AF .DB $0C,$01,$86,$60,$AF,$EC,$BB,$F8,$BFEC BB F8 BF90719072 ; log10(e) = l10ea + l10eb (splitted in two)9073 ; l10ea = 0.59074 F867E7 00 00 00 00 00 l10ea: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 009075 F867F0 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FE,$3F00 80 FE 3F9076 ; l10eb = -6.570551809674817234887108108339491770560299E-29077 F867F9 36 8F 30 4B 41 l10eb: .DB $36,$8F,$30,$4B,$41,$55,$91,$2A,$AB55 91 2A AB9078 F86802 39 5E 23 5B 9D .DB $39,$5E,$23,$5B,$9D,$90,$86,$FB,$BF90 86 FB BF90799080 ; log2(e) = 1/loge(2)9081 ; lg2e = 1.4426950408889634073599246810018921374266469082 F8680B 86 3E 1D 69 D0 lg2e: .DB $86,$3E,$1D,$69,$D0,$FE,$87,$BE,$BBTue Jul 17 11:00:18 2018 Page 116FE 87 BE BB9083 F86814 F0 17 5C 29 3B .DB $F0,$17,$5C,$29,$3B,$AA,$B8,$FF,$3FAA B8 FF 3F90849085 ;----------------------------------------------------------------------------9086 ; exponential family functions9087 ;----------------------------------------------------------------------------90889089 ; fexp2 - return 2 raised to the x power9090 ;9091 ; entry:9092 ; fac = x9093 ;9094 ; exit: x9095 ; fac = 29096 ; CF = 1 if invalid result (nan, inf)9097 ;9098 ; computation mean time: 50ms at 4MHz (4ms for integer argument)9099 ;9100 ;-----9101 F8681D fexp2:9102 ;-----9103 F8681D 24 25 bit facst9104 F8681F 10 0D bpl ?fv ; fac is valid9105 F86821 50 09 bvc ?er ; fac=nan so return nan9106 F86823 24 24 bit facsgn9107 F86825 10 05 bpl ?er ; fac=+inf so return +inf9108 F86827 64 24 ?zz: stz facsgn ; fac=-inf so return 09109 F86829 4C 56 4E jmp fldz9110 F8682C 38 ?er: sec9111 F8682D 60 rts9112 F8682E 20 26 4D ?fv: jsr frndm9113 F86831 24 24 bit facsgn9114 F86833 30 0E bmi ?xn ; x is negative9115 F86835 A9 32 lda #<maxl2 ; check if argument can cause overflow9116 F86837 A0 71 ldy #>maxl29117 F86839 20 5E 87 jsr fccmp9118 F8683C 30 0E bmi ?ok ; if x < maxl2 then no overflow9119 F8683E F0 0C beq ?ok9120 F86840 4C 7D 4E jmp fldinf ; overflow so return +inf9121 F86843 A9 44 ?xn: lda #<minl2 ; check if argument can cause underflow9122 F86845 A0 71 ldy #>minl29123 F86847 20 5E 87 jsr fccmp9124 F8684A 30 DB bmi ?zz ; if x < minl2 then underflow9125 F8684C ?ok: ACC169126 F8684C C2 20 rep #PMFLAG9127 .LONGA on9128 .MNLIST9129 F8684E 64 B4 stz fcpc0 ; log2(2) = 19130 F86850 64 B6 stz fcpc19131 F86852 64 B8 stz fcpc29132 F86854 A9 7E 70 lda #ce2p ; P coefficients9133 F86857 85 BA sta fcpp9134 F86859 A9 D8 70 lda #ce2q ; Q coefficients9135 F8685C 85 BC sta fcpq9136 F8685E A2 04 ldx #4 ; P: degree 49137 F86860 86 BE stx fcpdTue Jul 17 11:00:18 2018 Page 1179138 F86862 86 BF stx fcqd ; Q: degree 49139 F86864 ACC089140 F86864 E2 20 sep #PMFLAG9141 .LONGA off9142 .MNLIST9143 F86866 A9 FF lda #$FF ; Q polynomial N+19144 F86868 4C 18 69 jmp expev91459146 ; fexp - return e raised to the x power9147 ;9148 ; entry:9149 ; fac = x9150 ;9151 ; exit: x9152 ; fac = e9153 ; CF = 1 if invalid result (nan, inf)9154 ;9155 ; computation mean time: 60ms at 4MHz9156 ;9157 ;----9158 F8686B fexp:9159 ;----9160 F8686B 24 25 bit facst9161 F8686D 24 25 bit facst9162 F8686F 10 0D bpl ?fv ; fac is valid9163 F86871 50 09 bvc ?er ; fac=nan so return nan9164 F86873 24 24 bit facsgn9165 F86875 10 05 bpl ?er ; fac=+inf so return +inf9166 F86877 64 24 ?zz: stz facsgn ; fac=-inf so return 09167 F86879 4C 56 4E jmp fldz9168 F8687C 38 ?er: sec9169 F8687D 60 rts9170 F8687E 20 26 4D ?fv: jsr frndm9171 F86881 24 24 bit facsgn9172 F86883 30 0E bmi ?xn ; x is negative9173 F86885 A9 04 lda #<maxln ; check if argument can cause overflow9174 F86887 A0 6F ldy #>maxln9175 F86889 20 5E 87 jsr fccmp9176 F8688C 30 0E bmi ?ok ; if x <= maxln then no overflow9177 F8688E F0 0C beq ?ok9178 F86890 4C 7D 4E jmp fldinf ; overflow so return +inf9179 F86893 A9 16 ?xn: lda #<minln ; check if argument can cause underflow9180 F86895 A0 6F ldy #>minln9181 F86897 20 5E 87 jsr fccmp9182 F8689A 30 DB bmi ?zz ; if x < minln then underflow9183 F8689C ?ok: ACC169184 F8689C C2 20 rep #PMFLAG9185 .LONGA on9186 .MNLIST9187 F8689E A9 0B 68 lda #lg2e ; log2(e)9188 F868A1 85 B4 sta fcpc09189 F868A3 A9 8D 67 lda #ln2c1 ; loge(2) first piece9190 F868A6 85 B6 sta fcpc19191 F868A8 A9 9F 67 lda #ln2c2 ; loge(2) 2nd piece9192 F868AB 85 B8 sta fcpc29193 F868AD A9 1E 6D lda #ceep ; P coefficients9194 F868B0 85 BA sta fcppTue Jul 17 11:00:18 2018 Page 1189195 F868B2 A9 78 6D lda #ceeq ; Q coefficients9196 F868B5 85 BC sta fcpq9197 F868B7 A2 04 ldx #4 ; P: degree 49198 F868B9 86 BE stx fcpd9199 F868BB E8 inx9200 F868BC 86 BF stx fcqd ; Q: degree 59201 F868BE ACC089202 F868BE E2 20 sep #PMFLAG9203 .LONGA off9204 .MNLIST9205 F868C0 A9 00 lda #$00 ; Q polynomial N9206 F868C2 80 54 bra expev92079208 ; fexp10 - return 10 raised to the x power9209 ;9210 ; entry:9211 ; fac = x9212 ;9213 ; exit: x9214 ; fac = 109215 ; CF = 1 if invalid result (nan, inf)9216 ;9217 ; computation mean time: 65ms at 4MHz9218 ;9219 ;------9220 F868C4 fexp10:9221 ;------9222 F868C4 24 25 bit facst9223 F868C6 10 0D bpl ?fv ; fac is valid9224 F868C8 50 09 bvc ?er ; fac=nan so return nan9225 F868CA 24 24 bit facsgn9226 F868CC 10 05 bpl ?er ; fac=+inf so return +inf9227 F868CE 64 24 ?zz: stz facsgn ; fac=-inf so return 09228 F868D0 4C 56 4E jmp fldz9229 F868D3 38 ?er: sec9230 F868D4 60 rts9231 F868D5 20 26 4D ?fv: jsr frndm9232 F868D8 24 24 bit facsgn9233 F868DA 30 0E bmi ?xn ; x is negative9234 F868DC A9 5A lda #<maxl10 ; check if argument can cause overflow9235 F868DE A0 70 ldy #>maxl109236 F868E0 20 5E 87 jsr fccmp9237 F868E3 30 0E bmi ?ok ; if x <= maxl10 then no overflow9238 F868E5 F0 0C beq ?ok9239 F868E7 4C 7D 4E jmp fldinf ; overflow so return +inf9240 F868EA A9 6C ?xn: lda #<minl10 ; check if argument can cause underflow9241 F868EC A0 70 ldy #>minl109242 F868EE 20 5E 87 jsr fccmp9243 F868F1 30 DB bmi ?zz ; if x < minl10 then underflow9244 F868F3 ?ok: ACC169245 F868F3 C2 20 rep #PMFLAG9246 .LONGA on9247 .MNLIST9248 F868F5 A9 48 70 lda #lg210 ; log2(10)9249 F868F8 85 B4 sta fcpc09250 F868FA A9 24 70 lda #lg102a ; log10(2) first piece9251 F868FD 85 B6 sta fcpc1Tue Jul 17 11:00:18 2018 Page 1199252 F868FF A9 36 70 lda #lg102b ; log10(2) 2nd piece9253 F86902 85 B8 sta fcpc29254 F86904 A9 4C 6F lda #ce10p ; P coefficients9255 F86907 85 BA sta fcpp9256 F86909 A9 B8 6F lda #ce10q ; Q coefficients9257 F8690C 85 BC sta fcpq9258 F8690E A2 05 ldx #5 ; degree9259 F86910 86 BE stx fcpd9260 F86912 86 BF stx fcqd9261 F86914 ACC089262 F86914 E2 20 sep #PMFLAG9263 .LONGA off9264 .MNLIST9265 F86916 A9 FF lda #$FF ; Q polynomial N+19266 F869189267 ; expev - common exponential function evaluation9268 ;9269 ; entry:9270 ; fac = x, valid argument9271 ; A = $00 if exp(x), otherwise A = $FF9272 ; fcpc0 = pointer to a constant = log2(b)9273 ; fcpc1 = pointer to a splitted constant = logb(2)9274 ; fcpc2 = pointer to a splitted constant = logb(2)9275 ; fcpp = pointer to P polynomial coefficients9276 ; fcpq = pointer to Q polynomial coefficients9277 ; fcpd = P polynomial degree9278 ; fcqd = Q polynomial degree9279 ;9280 ; exit: x9281 ; fac = b , where b=e or b=10 or b=29282 ;9283 ; strategy:9284 ;9285 ; Range reduction is accomplished by separating the argument x into9286 ; an integer M and a fraction f such that:9287 ;9288 ; x f M9289 ; b = b * 2 where |f| < 0.5 * log (2)9290 ; b9291 ; f9292 ; A rational function (Pade' form) is then used to approximate b in9293 ; the basic range [-0.5 * log (2), +0.5 * log (2)]:9294 ; b b9295 ;9296 ; f P(z) 29297 ; b = 1 + 2f ------------- where z = f9298 ; Q(z) - fP(Z)9299 ;9300 ; Finally, get the result scaling the approximate exponential of the9301 ; fraction by a power of two:9302 ;9303 ; x f M9304 ; b = b * 29305 ;9306 ; Note:9307 ; Error amplification in the exponential function can be a serious matter.9308 ; The error propagation involves exp(x(1+delta)) = exp(x)(1 + x*delta + ...),Tue Jul 17 11:00:18 2018 Page 1209309 ; which shows that a 1 lsb error in representing x produces a relative error9310 ; of x times 1 lsb in the function.9311 ; While the routine gives an accurate result for arguments that are exactly9312 ; represented by a long double precision number, the result contains amplified9313 ; roundoff error for large arguments not exactly represented.9314 ;9315 ;-----9316 F86918 expev:9317 ;-----9318 F86918 85 C0 sta fcpolf ; Q polynomial flag degree N+19319 F8691A 20 93 84 jsr mvf_t1 ; tfr1=x (save argument)9320 F8691D A5 B4 lda fcpc0 ; x * log2(b) (logarithm base 2 of b)9321 F8691F AA tax9322 F86920 05 B5 ora fcpc0+1 ; if b=2 skip this multiplication9323 F86922 F0 06 beq ?no29324 F86924 8A txa9325 F86925 A4 B5 ldy fcpc0+19326 F86927 20 D5 49 jsr fcmult ; x*log2(b)9327 F8692A 20 67 45 ?no2: jsr faddhalf ; x*log2(b) + 0.5 (floor truncate toward -inf)9328 F8692D 20 27 50 jsr floor ; get integral part w = floor(x*log2(b) + 0.5)9329 F86930 20 66 84 jsr mvf_t0 ; tfr0=w9330 F86933 20 78 4F jsr uitrunc ; convert w to integer 16 bit9331 F86936 ACC169332 F86936 C2 20 rep #PMFLAG9333 .LONGA on9334 .MNLIST9335 F86938 A5 00 lda tm9336 F8693A A6 24 ldx facsgn ; sign of M9337 F8693C 10 04 bpl ?mp9338 F8693E 49 FF FF eor #$FFFF9339 F86941 1A inc a9340 F86942 85 46 ?mp: sta scexp ; scexp=M (for final scaling)9341 F86944 ACC089342 F86944 E2 20 sep #PMFLAG9343 .LONGA off9344 .MNLIST9345 F869469346 ; now compute x - logb(2)*w, the remainder of x/w9347 F86946 20 47 85 jsr mvt0_f ; fac=w9348 F86949 A5 B6 lda fcpc1 ; pointer to first piece of splitted -logb(2)9349 F8694B AA tax9350 F8694C 05 B7 ora fcpc1+1 ; if b=2 skip this multiplication9351 F8694E F0 19 beq ?skp ; if b=2 the remainder is: x-w9352 F86950 8A txa9353 F86951 A4 B7 ldy fcpc1+1 ; logb(2) is splitted in two pieces9354 F86953 20 D5 49 jsr fcmult ; first piece9355 F86956 20 FB 85 jsr mvt1_a ; arg=x9356 F86959 20 5F 45 jsr fpsub9357 F8695C 20 93 84 jsr mvf_t1 ; tfr1=x-c19358 F8695F 20 47 85 jsr mvt0_f ; fac=w9359 F86962 A5 B8 lda fcpc29360 F86964 A4 B9 ldy fcpc2+19361 F86966 20 D5 49 jsr fcmult ; 2nd piece9362 F86969 20 FB 85 ?skp: jsr mvt1_a ; arg=x-c19363 F8696C 20 5F 45 jsr fpsub ; x-c1-c2 = x - logb(2)*w9364 F8696F9365 ; now we have fac = f = x - logb(2)*w, the fraction partTue Jul 17 11:00:18 2018 Page 1219366 ; where: |f| < 0.5*logb(2), and we approximate exponential of fraction9367 F8696F 20 93 84 jsr mvf_t1 ; tfr1=f9368 F86972 20 CC 49 jsr fsquare ; z=f*f9369 F86975 20 66 84 jsr mvf_t0 ; tfr0=z9370 F86978 A5 BA lda fcpp ; pointer to P(z) coefficients9371 F8697A A4 BB ldy fcpp+19372 F8697C A6 BE ldx fcpd ; P(z) degree9373 F8697E 20 1C 87 jsr peval ; evaluate P(z)9374 F86981 20 FB 85 jsr mvt1_a ; arg=f9375 F86984 20 DD 49 jsr fpmult ; f*P(z)9376 F86987 20 C0 84 jsr mvf_t2 ; tfr2=f*P(z)9377 F8698A A5 BC lda fcpq ; pointer to Q(z) coefficients9378 F8698C A4 BD ldy fcpq+19379 F8698E A6 BF ldx fcqd ; Q(z) dregree9380 F86990 24 C0 bit fcpolf9381 F86992 10 05 bpl ?dn ; exp(x)9382 F86994 20 3A 87 jsr pevalp1 ; evaluate Q(z) for exp10(x) & exp2(x)9383 F86997 80 03 bra ?dn29384 F86999 20 1C 87 ?dn: jsr peval ; evaluate Q(z) for exp(x)9385 F8699C 20 28 86 ?dn2: jsr mvt2_a9386 F8699F A5 3C lda argsgn9387 F869A1 49 FF eor #$FF9388 F869A3 85 3C sta argsgn ; arg=-f*P(z)9389 F869A5 20 7D 45 jsr fpadd ; fac = Q(z) - f*P(z)9390 F869A8 20 28 86 jsr mvt2_a ; arg = f*P(z)9391 F869AB 20 10 4A jsr fpdiv ; y=f*P(z)/(Q(z) - f*P(z))9392 F869AE 20 66 84 jsr mvf_t0 ; tfr0=y9393 F869B1 20 6C 45 jsr faddone ; 1+y9394 F869B4 20 CE 85 jsr mvt0_a9395 F869B7 20 7D 45 jsr fpadd ; 1+y+y=1+2*y = 1 + 2*f*P(z)/(Q(z) - f*P(z))9396 F869BA 4C B7 48 jmp fscale ; scale by M, return exponential93979398 ; fexpm1 - return e raised to the x power, minus 19399 ;9400 ; entry:9401 ; fac = x9402 ;9403 ; exit: x9404 ; fac = e - 19405 ; CF = 1 if invalid result (nan, inf)9406 ;9407 ; For small magnitude values of x, expm1 may be more accurate than exp(x) - 19408 ;9409 ; strategy:9410 ;9411 ; Range reduction is accomplished by separating the argument x into9412 ; an integer M and a fraction f such that:9413 ;9414 ; x f M9415 ; e = e * 2 where |f| < 0.5 * log (2)9416 ; e9417 ; f9418 ; A rational function is then used to approximate e - 1 in9419 ; the basic range [-0.5 * log (2), +0.5 * log (2)]:9420 ; e e9421 ;9422 ; f 2 3 P(f) fTue Jul 17 11:00:18 2018 Page 1229423 ; e - 1 = f + 0.5f + f ------ = y, e = y + 19424 ; Q(f)9425 ;9426 ; Finally, get the result scaling the approximate exponential of the9427 ; fraction by a power of two:9428 ;9429 ; x f M M9430 ; e = e * 2 = (y + 1)*2 so:9431 ;9432 ; x M M9433 ; e - 1 = y * 2 + 2 - 19434 ;9435 ; computation mean time: 90ms at 4MHz9436 ;9437 ;------9438 F869BD fexpm1:9439 ;------9440 F869BD 24 25 bit facst9441 F869BF 10 0B bpl ?fv ; fac is valid9442 F869C1 70 07 bvs ?er ; fac=nan so return nan9443 F869C3 24 24 bit facsgn9444 F869C5 10 03 bpl ?er ; fac=+inf so return +inf9445 F869C7 4C 32 4E ?m1: jmp fldm1 ; fac=-inf so return -19446 F869CA 38 ?er: sec9447 F869CB 60 rts9448 F869CC 20 26 4D ?fv: jsr frndm9449 F869CF 24 24 bit facsgn9450 F869D1 30 0E bmi ?xn ; x is negative9451 F869D3 A9 04 lda #<maxln ; check if argument can cause overflow9452 F869D5 A0 6F ldy #>maxln9453 F869D7 20 5E 87 jsr fccmp9454 F869DA 30 0E bmi ?ok ; if x <= maxln then no overflow9455 F869DC F0 0C beq ?ok9456 F869DE 4C 7D 4E jmp fldinf ; overflow so return +inf9457 F869E1 A9 28 ?xn: lda #<mxm1 ; check if argument can cause underflow9458 F869E3 A0 6F ldy #>mxm19459 F869E5 20 5E 87 jsr fccmp9460 F869E8 30 DD bmi ?m1 ; if x < mxm1 then underflow, return -19461 F869EA 20 66 84 ?ok: jsr mvf_t0 ; tfr0=x9462 F869ED A9 0B lda #<lg2e ; x*log2(e)9463 F869EF A0 68 ldy #>lg2e9464 F869F1 20 D5 49 jsr fcmult9465 F869F4 20 67 45 jsr faddhalf ; express x = ln 2 (M + remainder)...9466 F869F7 20 27 50 jsr floor ; ...remainder not exceeding 1/2.9467 F869FA 20 93 84 jsr mvf_t1 ; tfr1=w=integral part9468 F869FD 20 78 4F jsr uitrunc ; convert to integer9469 F86A00 ACC169470 F86A00 C2 20 rep #PMFLAG9471 .LONGA on9472 .MNLIST9473 F86A02 A5 00 lda tm9474 F86A04 A6 24 ldx facsgn ; sign of M9475 F86A06 10 04 bpl ?mp9476 F86A08 49 FF FF eor #$FFFF9477 F86A0B 1A inc a9478 F86A0C 85 46 ?mp: sta scexp ; scexp=M (for final scaling)9479 F86A0E ACC08Tue Jul 17 11:00:18 2018 Page 1239480 F86A0E E2 20 sep #PMFLAG9481 .LONGA off9482 .MNLIST9483 F86A10 20 74 85 jsr mvt1_f9484 F86A13 A9 8D lda #<ln2c1 ; remainder times loge(2)9485 F86A15 A0 67 ldy #>ln2c19486 F86A17 20 D5 49 jsr fcmult9487 F86A1A 20 CE 85 jsr mvt0_a9488 F86A1D 20 5F 45 jsr fpsub9489 F86A20 20 66 84 jsr mvf_t09490 F86A23 20 74 85 jsr mvt1_f9491 F86A26 A9 9F lda #<ln2c29492 F86A28 A0 67 ldy #>ln2c29493 F86A2A 20 D5 49 jsr fcmult9494 F86A2D 20 CE 85 jsr mvt0_a9495 F86A30 20 5F 45 jsr fpsub9496 F86A33 20 66 84 jsr mvf_t0 ; tfr0=f=fraction9497 F86A36 20 CC 49 jsr fsquare9498 F86A39 20 93 84 jsr mvf_t1 ; tfr1=f*f9499 F86A3C A9 E4 lda #<cem1p9500 F86A3E A0 6D ldy #>cem1p9501 F86A40 A2 07 ldx #79502 F86A42 20 1C 87 jsr peval ; evaluate P(f)9503 F86A45 20 FB 85 jsr mvt1_a9504 F86A48 20 DD 49 jsr fpmult ; f*f*P(f)9505 F86A4B 20 CE 85 jsr mvt0_a9506 F86A4E 20 DD 49 jsr fpmult ; f*f*f*P(f)9507 F86A51 20 C0 84 jsr mvf_t2 ; tfr2=f*f*f*P(f)9508 F86A54 A9 74 lda #<cem1q9509 F86A56 A0 6E ldy #>cem1q9510 F86A58 A2 07 ldx #79511 F86A5A 20 3A 87 jsr pevalp1 ; evaluate Q(f)9512 F86A5D 20 28 86 jsr mvt2_a9513 F86A60 20 10 4A jsr fpdiv ; f*f*f*P(f)/Q(f)9514 F86A63 20 FB 85 jsr mvt1_a ; f*f9515 F86A66 ACC169516 F86A66 C2 20 rep #PMFLAG9517 .LONGA on9518 .MNLIST9519 F86A68 A5 3A lda argexp9520 F86A6A F0 03 beq ?isz9521 F86A6C 3A dec a9522 F86A6D 85 3A sta argexp ; f*f/29523 F86A6F ?isz: ACC089524 F86A6F E2 20 sep #PMFLAG9525 .LONGA off9526 .MNLIST9527 F86A71 20 7D 45 jsr fpadd9528 F86A74 20 CE 85 jsr mvt0_a ; arg=f9529 F86A77 20 7D 45 jsr fpadd9530 F86A7A 20 66 84 jsr mvf_t0 ; tfr0=y=f + 0.5*f*f + f*f*f*P(f)/Q(f)9531 F86A7D 20 2E 4E jsr fldp1 ; fac=+19532 F86A80 20 B7 48 jsr fscale ; 2^M9533 F86A83 20 93 84 jsr mvf_t1 ; tfr1=2^M9534 F86A86 20 CE 85 jsr mvt0_a ; tfr0=y9535 F86A89 20 DD 49 jsr fpmult ; y*2^M9536 F86A8C 20 66 84 jsr mvf_t0Tue Jul 17 11:00:18 2018 Page 1249537 F86A8F 20 74 85 jsr mvt1_f ; 2^M9538 F86A92 20 71 45 jsr fsubone ; 2^M - 19539 F86A95 20 CE 85 jsr mvt0_a9540 F86A98 4C 7D 45 jmp fpadd ; y*2^M + 2^M - 195419542 ; fpown - return the argument x raised to the nth power9543 ;9544 ; entry:9545 ; fac = x9546 ; C = N (signed integer)9547 ;9548 ; exit: N9549 ; fac = x9550 ; CF = 1 if invalid result (nan, inf)9551 ;9552 ; The routine decomposes N as a sum of powers of two.9553 ; The desired power is a product of two-to-the-kth powers of x.9554 ; Max. multiplications number (if N=32767) = 289555 ;9556 ; computation mean time: max. 30ms at 4MHz9557 ;9558 ;-----9559 F86A9B fpown:9560 ;-----9561 F86A9B 64 45 stz scsgn ; assume positive N9562 F86A9D ACC169563 F86A9D C2 20 rep #PMFLAG9564 .LONGA on9565 .MNLIST9566 F86A9F 89 00 80 bit #$80009567 F86AA2 F0 08 beq ?np ; N>=09568 F86AA4 49 FF FF eor #$FFFF ; two's complement9569 F86AA7 1A inc a9570 F86AA8 A2 80 ldx #$809571 F86AAA 86 45 stx scsgn ; N<09572 F86AAC 85 46 ?np: sta scexp ; store N9573 F86AAE 09 00 00 ora #09574 F86AB1 ACC089575 F86AB1 E2 20 sep #PMFLAG9576 .LONGA off9577 .MNLIST9578 F86AB3 D0 04 bne ?nz9579 F86AB5 A9 40 lda #$409580 F86AB7 04 45 tsb scsgn ; flag: N=09581 F86AB9 24 25 ?nz: bit facst ; fac test9582 F86ABB 10 1B bpl ?fv ; fac is valid9583 F86ABD 70 11 bvs ?er ; fac=nan, so return nan9584 F86ABF 24 45 bit scsgn9585 F86AC1 70 12 bvs ?p1 ; fac=inf: if N=0 return 19586 F86AC3 30 0D bmi ?zz ; fac=inf, N<0, so return zero9587 F86AC5 24 24 bit facsgn9588 F86AC7 10 07 bpl ?er ; +inf raised to +n, so return +inf9589 F86AC9 A5 46 lda scexp ; test if N is odd9590 F86ACB 4A lsr a9591 F86ACC B0 02 bcs ?er ; fac=-inf, N is odd, so return -inf9592 F86ACE 64 24 stz facsgn ; fac=-inf, N is even, so return +inf9593 F86AD0 38 ?er: sec ; exit with invalid flag (nar or inf)Tue Jul 17 11:00:18 2018 Page 1259594 F86AD1 60 ?rts: rts9595 F86AD2 4C 56 4E ?zz: jmp fldz ; set fac=0 and exit9596 F86AD5 4C 2E 4E ?p1: jmp fldp1 ; set fac=1 and exit9597 F86AD8 24 45 ?fv: bit scsgn9598 F86ADA 70 F9 bvs ?p1 ; fac is valid, N=0, so return 19599 F86ADC A5 24 lda facsgn9600 F86ADE 85 4A sta dsgn ; save fac sign and result sign9601 F86AE0 64 24 stz facsgn ; fac=|x|9602 F86AE2 20 66 84 jsr mvf_t0 ; tfr0=w=|x|9603 F86AE5 A5 46 lda scexp9604 F86AE7 4A lsr a9605 F86AE8 B0 05 bcs ?go ; N is odd, set y=|x|9606 F86AEA 20 2E 4E jsr fldp1 ; N is even so set y=19607 F86AED 64 4A stz dsgn ; N is even so result is positive9608 F86AEF 20 93 84 ?go: jsr mvf_t1 ; tfro=y9609 F86AF2 ?ll: ACC169610 F86AF2 C2 20 rep #PMFLAG9611 .LONGA on9612 .MNLIST9613 F86AF4 46 46 lsr scexp ; shift N9614 F86AF6 ACC089615 F86AF6 E2 20 sep #PMFLAG9616 .LONGA off9617 .MNLIST9618 F86AF8 F0 1D beq ?eol ; end of loop9619 F86AFA 08 php9620 F86AFB 20 47 85 jsr mvt0_f ; w9621 F86AFE 20 CC 49 jsr fsquare ; w=w*w, arg to the 2-to-the-kth power9622 F86B01 B0 13 bcs ?of ; overflow9623 F86B03 20 66 84 jsr mvf_t0 ; tfr0=w9624 F86B06 28 plp9625 F86B07 90 E9 bcc ?ll ; loop9626 F86B09 20 FB 85 jsr mvt1_a ; y (include in product if N odd)9627 F86B0C 20 DD 49 jsr fpmult9628 F86B0F B0 05 bcs ?of ; overflow9629 F86B11 20 93 84 jsr mvf_t1 ; tfr1=y9630 F86B14 80 DC bra ?ll ; loop9631 F86B16 28 ?of: plp9632 F86B17 A5 4A ?eol: lda dsgn ; set fac sign9633 F86B19 85 24 sta facsgn9634 F86B1B 18 clc9635 F86B1C 24 25 bit facst9636 F86B1E 10 01 bpl ?ok9637 F86B20 38 sec ; fac=inf9638 F86B21 24 45 ?ok: bit scsgn9639 F86B23 10 AC bpl ?rts ; done if N>09640 F86B25 B0 AB bcs ?zz ; y=inf so return 09641 F86B27 20 A6 4E jsr ldaone9642 F86B2A 4C 10 4A jmp fpdiv ; y=1/y96439644 ; frootn - return the nth root of the argument9645 ;9646 ; entry:9647 ; fac = x9648 ; C = N (integer, N>0)9649 ;9650 ; exit: 1/NTue Jul 17 11:00:18 2018 Page 1269651 ; fac = nthroot(x) = x9652 ; CF = 1 if invalid result (nan, inf)9653 ;9654 ; method:9655 ;9656 ; 1/N log2(x)/N9657 ; x = 29658 ;9659 ; computation mean time: 140ms at 4MHz9660 ;9661 ;------9662 F86B2D frootn:9663 ;------9664 F86B2D 64 45 stz scsgn ; assume N even9665 F86B2F ACC169666 F86B2F C2 20 rep #PMFLAG9667 .LONGA on9668 .MNLIST9669 F86B31 89 00 80 bit #$80009670 F86B34 F0 06 beq ?pos ; N>=09671 F86B36 49 FF FF eor #$FFFF ; two's complement9672 F86B39 1A inc a9673 F86B3A A2 FF ldx #$FF ; N<09674 F86B3C 85 46 ?pos: sta scexp ; store N9675 F86B3E 09 00 00 ora #09676 F86B41 ACC089677 F86B41 E2 20 sep #PMFLAG9678 .LONGA off9679 .MNLIST9680 F86B43 F0 03 beq ?nan ; return nan if N=09681 F86B45 E8 inx ; return nan if N<09682 F86B46 D0 03 bne ?ok9683 F86B48 4C 74 4E ?nan: jmp fldnan9684 F86B4B 4A ?ok: lsr a ; N odd?9685 F86B4C 90 04 bcc ?ev ; no9686 F86B4E A9 FF lda #$FF9687 F86B50 85 45 sta scsgn ; flag N odd9688 F86B52 24 25 ?ev: bit facst ; fac test9689 F86B54 10 0C bpl ?fv ; fac is valid9690 F86B56 70 08 bvs ?er ; fac=nan, so return nan9691 F86B58 24 24 bit facsgn9692 F86B5A 10 04 bpl ?er ; fac=+inf so return +inf9693 F86B5C 24 45 bit scsgn ; if N is even and fac=-inf...9694 F86B5E 50 E8 bvc ?nan ; ...return nan9695 F86B60 38 ?er: sec ; exit with invalid flag (nar or inf)9696 F86B61 60 rts9697 F86B62 50 03 ?fv: bvc ?nz ; fac <> 09698 F86B64 4C 56 4E ?z: jmp fldz ; if fac=0 return 09699 F86B67 A5 24 ?nz: lda facsgn9700 F86B69 10 04 bpl ?gte09701 F86B6B 24 45 bit scsgn ; if fac<0 and N is even...9702 F86B6D 50 D9 bvc ?nan ; ...return nan9703 F86B6F 85 4A ?gte0: sta dsgn9704 F86B71 ACC169705 F86B71 C2 20 rep #PMFLAG9706 .LONGA on9707 .MNLISTTue Jul 17 11:00:18 2018 Page 1279708 F86B73 A5 46 lda scexp9709 F86B75 C9 01 00 cmp #19710 F86B78 ACC089711 F86B78 E2 20 sep #PMFLAG9712 .LONGA off9713 .MNLIST9714 F86B7A 18 clc9715 F86B7B F0 2E beq ?rts9716 F86B7D 64 24 stz facsgn ; fac=|x|9717 F86B7F A5 4A lda dsgn9718 F86B81 48 pha ; save fac sign and result sign9719 F86B82 A5 47 lda scexp+19720 F86B84 48 pha9721 F86B85 A5 46 lda scexp9722 F86B87 48 pha9723 F86B88 20 6B 63 jsr flog2 ; log2(x)9724 F86B8B 90 06 bcc ?ok29725 F86B8D 24 24 bit facsgn9726 F86B8F 10 1A bpl ?rts9727 F86B91 30 D1 bmi ?z ; returns zero9728 F86B93 20 C0 84 ?ok2: jsr mvf_t29729 F86B96 68 pla ; scexp low9730 F86B97 7A ply ; scexp high9731 F86B98 20 5B 4F jsr fldu16 ; convert N to float9732 F86B9B 68 pla9733 F86B9C 85 4A sta dsgn ; sign of the result9734 F86B9E 20 28 86 jsr mvt2_a ; log2(x)9735 F86BA1 20 10 4A jsr fpdiv ; log2(x)/N9736 F86BA4 20 1D 68 jsr fexp2 ; exp2(...)9737 F86BA7 A5 4A lda dsgn9738 F86BA9 85 24 sta facsgn9739 F86BAB 60 ?rts: rts97409741 ; fpowxy - return x raised to the yth power9742 ;9743 ; entry:9744 ; fac = y9745 ; arg = x9746 ;9747 ; exit: y9748 ; fac = x9749 ; CF = 1 if invalid result (nan, inf)9750 ;9751 ; method:9752 ; 1) for noninteger y or |y|>327679753 ;9754 ; y y*log2(x)9755 ; x = 29756 ;9757 ; 2) for integer y, |y|<32768:9758 ;9759 ; y9760 ; x = fpown(x, y)9761 ;9762 ; computation mean time: max 200ms at 4MHz9763 ;9764 ;------Tue Jul 17 11:00:18 2018 Page 1289765 F86BAC fpowxy:9766 ;------9767 F86BAC A9 C0 lda #$C0 ; if x=nan or y=nan, return nan9768 F86BAE C5 3D cmp argst9769 F86BB0 F0 48 beq ?nan9770 F86BB2 C5 25 cmp facst9771 F86BB4 F0 44 beq ?nan9772 F86BB6 64 4B stz powfg9773 F86BB8 24 25 bit facst9774 F86BBA 30 72 bmi ?yinf ; y=+/-inf9775 F86BBC 70 3F bvs ?1 ; if y=0 return +19776 F86BBE9777 ; here y is valid and not zero9778 F86BBE 20 D6 6C jsr ?yint ; check if y is integer -- fac=w=floor(y)9779 F86BC1 D0 63 bne ?rst ; y is not integer, restore arg&fac9780 F86BC3 A9 80 lda #$809781 F86BC5 85 4B sta powfg ; powfg<7>: y is integer9782 F86BC7 20 78 4F jsr uitrunc ; get w as 128 bit integer9783 F86BCA ACC169784 F86BCA C2 20 rep #PMFLAG9785 .LONGA on9786 .MNLIST9787 F86BCC A5 0E lda tm+149788 F86BCE 05 0C ora tm+129789 F86BD0 05 0A ora tm+109790 F86BD2 05 08 ora tm+89791 F86BD4 05 06 ora tm+69792 F86BD6 05 04 ora tm+49793 F86BD8 05 02 ora tm+29794 F86BDA D0 27 bne ?ibig ; y is a big integer9795 F86BDC A5 00 lda tm9796 F86BDE C9 00 80 cmp #327689797 F86BE1 B0 20 bcs ?ibig ; |w|>=32768, is a big integer9798 F86BE3 A6 24 ldx facsgn ; w sign9799 F86BE5 10 04 bpl ?pp ; w>09800 F86BE7 49 FF FF eor #$FFFF ; two's complement9801 F86BEA 1A inc a9802 F86BEB 85 48 ?pp: sta dexp9803 F86BED ACC089804 F86BED E2 20 sep #PMFLAG9805 .LONGA off9806 .MNLIST9807 F86BEF 20 47 85 jsr mvt0_f ; fac=x9808 F86BF2 A5 49 lda dexp+1 ; y is integer and |y|<32768...9809 F86BF4 EB xba9810 F86BF5 A5 48 lda dexp9811 F86BF7 4C 9B 6A jmp fpown ; ...so call fpown9812 F86BFA 4C 74 4E ?nan: jmp fldnan ; return nan9813 F86BFD 4C 2E 4E ?1: jmp fldp1 ; return +19814 F86C00 4C 56 4E ?z: jmp fldz ; return 09815 F86C03 ?ibig: ACC08 ; y is a big integer and we check if...9816 F86C03 E2 20 sep #PMFLAG9817 .LONGA off9818 .MNLIST9819 ; ...is odd or even9820 F86C05 20 74 85 jsr mvt1_f ; restore fac=y9821 F86C08 A9 FF lda #$FFTue Jul 17 11:00:18 2018 Page 1299822 F86C0A 85 46 sta scexp9823 F86C0C 85 47 sta scexp+1 ; scexp=-19824 F86C0E 20 B7 48 jsr fscale ; w=y/29825 F86C11 20 27 50 jsr floor ; w=floor(y/2)9826 F86C14 A9 01 lda #19827 F86C16 85 46 sta scexp9828 F86C18 64 47 stz scexp+1 ; scexp=19829 F86C1A 20 B7 48 jsr fscale ; w*2 = 2*floor(y/2)9830 F86C1D9831 ; if 2*floor(y/2) != y then y is an odd integer9832 F86C1D 20 DF 6C jsr ?cpy ; compare y vs. 2*floor(y/2)9833 F86C20 F0 04 beq ?rst ; y is an even integer9834 F86C22 A9 40 lda #$409835 F86C24 04 4B tsb powfg ; powfg<6>: odd integer flag9836 F86C26 20 CE 85 ?rst: jsr mvt0_a ; restore arg=x9837 F86C29 20 74 85 jsr mvt1_f ; restore fac=y9838 F86C2C 80 30 bra ?xtst ; go to check x98399840 ?yinf: ; y=+/-inf so check x9841 F86C2E 24 3D bit argst9842 F86C30 10 0D bpl ?xv ; x is valid9843 F86C32 24 3C bit argsgn9844 F86C34 30 C4 bmi ?nan ; if x=-inf and y=+-inf return nan9845 F86C36 24 24 bit facsgn9846 F86C38 30 C6 bmi ?z ; if x=+inf and y=-inf return 09847 ; if x=+inf and y=inf return +inf9848 F86C3A 64 24 ?pi: stz facsgn ; return +inf9849 F86C3C 4C 7D 4E jmp fldinf98509851 ?xv: ; y=+/-inf and valid x9852 F86C3F 50 06 bvc ?nz ; x<>09853 F86C41 24 24 bit facsgn9854 F86C43 10 BB bpl ?z ; if x=0 and y=+inf return zero9855 F86C45 30 F3 bmi ?pi ; if x=0 and y=-inf return zero98569857 ?nz: ; y=+/-inf and x<>09858 F86C47 24 3C bit argsgn9859 F86C49 30 AF bmi ?nan ; if x<0 and y=+-inf return nan9860 F86C4B 20 B5 6C jsr ?is1 ; check if |x|=19861 F86C4E F0 AA beq ?nan ; if |x|=1 and y=+/-inf return nan9862 F86C50 90 06 bcc ?xm ; |x|<19863 F86C52 24 24 bit facsgn9864 F86C54 10 E4 bpl ?pi ; if |x|>1 and y=+inf return +inf9865 F86C56 30 A8 bmi ?z ; if |x|>1 and y=-inf return 09866 F86C58 24 24 ?xm: bit facsgn9867 F86C5A 10 A4 bpl ?z ; if |x|<1 and y=+inf return 09868 F86C5C 30 DC bmi ?pi ; if |x|<1 and y=-inf return +inf98699870 ?xtst: ; here y is valid and y <> 0 so we check x9871 F86C5E 24 3D bit argst9872 F86C60 10 17 bpl ?xv2 ; x is valid9873 F86C62 24 3C bit argsgn9874 F86C64 30 06 bmi ?xmi ; x=-inf9875 F86C66 24 24 bit facsgn9876 F86C68 10 D0 bpl ?pi ; if x=+inf and y>0 return +inf9877 F86C6A 30 94 bmi ?z ; if x=+inf and y<0 return 09878Tue Jul 17 11:00:18 2018 Page 1309879 ?xmi: ; x=-inf -- check if y is odd integer9880 F86C6C A5 4B lda powfg9881 F86C6E C9 C0 cmp #$C0 ; y must be odd integer9882 F86C70 D0 88 bne ?nan9883 F86C72 A9 FF lda #$FF ; x=-inf and y is an odd integer...9884 F86C74 85 24 sta facsgn9885 F86C76 4C 7D 4E jmp fldinf ; ...so return -inf9886 F86C799887 ?xv2: ; now both x and y are valid9888 F86C79 50 06 bvc ?xv3 ; x<>09889 F86C7B 24 24 bit facsgn9890 F86C7D 10 81 bpl ?z ; if x=0 and y>0 return 09891 F86C7F 30 B9 bmi ?pi ; if x=0 and y<0 return +inf9892 F86C81 24 3C ?xv3: bit argsgn9893 F86C83 10 0F bpl ?xv4 ; x>09894 F86C85 A5 4B lda powfg9895 F86C87 C9 C0 cmp #$C0 ; if x<0, y must be odd integer9896 F86C89 F0 03 beq ?xv309897 F86C8B 4C 74 4E jmp fldnan9898 F86C8E A9 01 ?xv30: lda #19899 F86C90 04 4B tsb powfg ; powfg<0>: x change sign9900 F86C92 64 3C stz argsgn ; |x|9901 F86C94 20 ED 84 ?xv4: jsr mvf_t3 ; tfr3=y9902 F86C97 20 0C 84 jsr mvatof ; fac=x9903 F86C9A 20 6B 63 jsr flog2 ; log2(x)9904 F86C9D B0 0B bcs ?end9905 F86C9F 20 55 86 jsr mvt3_a ; arg=y9906 F86CA2 20 DD 49 jsr fpmult ; y*log2(x)9907 F86CA5 B0 03 bcs ?end9908 F86CA7 20 1D 68 jsr fexp2 ; 2^(y*log2(x))9909 F86CAA 46 4B ?end: lsr powfg9910 F86CAC 90 06 bcc ?e29911 F86CAE A5 24 lda facsgn ; change sign to result9912 F86CB0 49 FF eor #$FF9913 F86CB2 85 24 sta facsgn9914 F86CB4 60 ?e2: rts99159916 ?is1: ; check if |arg|=19917 F86CB5 ACC169918 F86CB5 C2 20 rep #PMFLAG9919 .LONGA on9920 .MNLIST9921 F86CB7 A5 3A lda argexp9922 F86CB9 C9 FF 3F cmp #EBIAS9923 F86CBC D0 15 bne ?is0 ; is not 1 (CF=1 if |arg|>=1)9924 F86CBE A5 38 lda argm+149925 F86CC0 C9 00 80 cmp #$80009926 F86CC3 D0 0E bne ?is0 ; is not 19927 F86CC5 A5 2A lda argm9928 F86CC7 05 2C ora argm+29929 F86CC9 05 2E ora argm+49930 F86CCB 05 30 ora argm+69931 F86CCD 05 32 ora argm+89932 F86CCF 05 34 ora argm+109933 F86CD1 05 36 ora argm+129934 F86CD3 ?is0: ACC089935 F86CD3 E2 20 sep #PMFLAGTue Jul 17 11:00:18 2018 Page 1319936 .LONGA off9937 .MNLIST9938 F86CD5 60 rts ; ZF=1 if |arg|=1, CF=1 if |arg|>=199399940 F86CD6 20 1A 85 ?yint: jsr mva_t0 ; tfr0=x9941 F86CD9 20 93 84 jsr mvf_t1 ; tfr1=y9942 F86CDC 20 27 50 jsr floor ; get the integral part of y9943 F86CDF9944 ?cpy: ; compare fac vs. y/tfr1 (just for equality)9945 F86CDF ACC169946 F86CDF C2 20 rep #PMFLAG9947 .LONGA on9948 .MNLIST9949 F86CE1 A5 12 lda facm9950 F86CE3 C5 64 cmp tfr19951 F86CE5 D0 34 bne ?cp09952 F86CE7 A5 14 lda facm+29953 F86CE9 C5 66 cmp tfr1+29954 F86CEB D0 2E bne ?cp09955 F86CED A5 16 lda facm+49956 F86CEF C5 68 cmp tfr1+49957 F86CF1 D0 28 bne ?cp09958 F86CF3 A5 18 lda facm+69959 F86CF5 C5 6A cmp tfr1+69960 F86CF7 D0 22 bne ?cp09961 F86CF9 A5 1A lda facm+89962 F86CFB C5 6C cmp tfr1+89963 F86CFD D0 1C bne ?cp09964 F86CFF A5 1C lda facm+109965 F86D01 C5 6E cmp tfr1+109966 F86D03 D0 16 bne ?cp09967 F86D05 A5 1E lda facm+129968 F86D07 C5 70 cmp tfr1+129969 F86D09 D0 10 bne ?cp09970 F86D0B A5 20 lda facm+149971 F86D0D C5 72 cmp tfr1+149972 F86D0F D0 0A bne ?cp09973 F86D11 A5 22 lda facm+169974 F86D13 C5 74 cmp tfr1+169975 F86D15 D0 04 bne ?cp09976 F86D17 A5 24 lda facm+189977 F86D19 C5 76 cmp tfr1+189978 F86D1B ?cp0: ACC089979 F86D1B E2 20 sep #PMFLAG9980 .LONGA off9981 .MNLIST9982 F86D1D 60 rts ; ZF=1 if equal99839984 ; coefficients for exp() evaluation9985 F86D1E ceep:9986 ; P[4] = 3.279723985560247033712687707263393506266E-109987 F86D1E 44 59 3A 65 81 .DB $44,$59,$3A,$65,$81,$28,$53,$8A,$4728 53 8A 479988 F86D27 FE AA B3 F9 02 .DB $FE,$AA,$B3,$F9,$02,$4E,$B4,$DF,$3F4E B4 DF 3F9989 ; P[3] = 6.141506007208645008909088812338454698548E-79990 F86D30 B0 71 8E FB B2 .DB $B0,$71,$8E,$FB,$B2,$D2,$28,$E7,$FFTue Jul 17 11:00:18 2018 Page 132D2 28 E7 FF9991 F86D39 4A 4C 8E A0 1B .DB $4A,$4C,$8E,$A0,$1B,$DC,$A4,$EA,$3FDC A4 EA 3F9992 ; P[2] = 2.708775201978218837374512615596512792224E-49993 F86D42 B6 9E 58 BA 61 .DB $B6,$9E,$58,$BA,$61,$BA,$82,$D8,$A0BA 82 D8 A09994 F86D4B 31 FA 48 B9 90 .DB $31,$FA,$48,$B9,$90,$04,$8E,$F3,$3F04 8E F3 3F9995 ; P[1] = 3.508710990737834361215404761139478627390E-29996 F86D54 D4 0F B2 5C 74 .DB $D4,$0F,$B2,$5C,$74,$7D,$79,$81,$287D 79 81 289997 F86D5D BF 78 03 59 80 .DB $BF,$78,$03,$59,$80,$B7,$8F,$FA,$3FB7 8F FA 3F9998 ; P[0] = 19999 F86D66 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0010000 F86D6F 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$FF,$3F00 80 FF 3F1000110002 F86D78 ceeq:10003 ; Q[5] = 2.980756652081995192255342779918052538681E-1210004 F86D78 AA EB 58 3C C8 .DB $AA,$EB,$58,$3C,$C8,$65,$82,$7C,$6565 82 7C 6510005 F86D81 FB 7E D8 C6 89 .DB $FB,$7E,$D8,$C6,$89,$C0,$D1,$D8,$3FC0 D1 D8 3F10006 ; Q[4] = 1.771372078166251484503904874657985291164E-810007 F86D8A F5 58 96 76 83 .DB $F5,$58,$96,$76,$83,$9C,$A6,$21,$0D9C A6 21 0D10008 F86D93 1B F5 F8 49 E2 .DB $1B,$F5,$F8,$49,$E2,$28,$98,$E5,$3F28 98 E5 3F10009 ; Q[3] = 1.504792651814944826817779302637284053660E-510010 F86D9C AE 5F 82 3D 77 .DB $AE,$5F,$82,$3D,$77,$DC,$F3,$E4,$70DC F3 E4 7010011 F86DA5 24 62 3D 2E 5A .DB $24,$62,$3D,$2E,$5A,$76,$FC,$EE,$3F76 FC EE 3F10012 ; Q[2] = 3.611828913847589925056132680618007270344E-310013 F86DAE 68 61 9E E9 6E .DB $68,$61,$9E,$E9,$6E,$9C,$AE,$2E,$1E9C AE 2E 1E10014 F86DB7 D4 1F 50 10 6F .DB $D4,$1F,$50,$10,$6F,$B4,$EC,$F6,$3FB4 EC F6 3F10015 ; Q[1] = 2.368408864814233538909747618894558968880E-110016 F86DC0 76 96 FC D8 64 .DB $76,$96,$FC,$D8,$64,$69,$67,$EB,$3E69 67 EB 3E10017 F86DC9 0A 67 2C D7 6A .DB $0A,$67,$2C,$D7,$6A,$86,$F2,$FC,$3F86 F2 FC 3F10018 ; Q[0] = 210019 F86DD2 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0010020 F86DDB 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$00,$4000 80 00 401002110022 ; coefficients for expm1() evaluation10023 F86DE4 cem1p:10024 ; MP[7] = -4.888737542888633647784737721812546636240E-110025 F86DE4 52 E5 66 71 85 .DB $52,$E5,$66,$71,$85,$3C,$04,$05,$0D3C 04 05 0D10026 F86DED 8F 39 16 25 A9 .DB $8F,$39,$16,$25,$A9,$4D,$FA,$FD,$BFTue Jul 17 11:00:18 2018 Page 1334D FA FD BF10027 ; MP[6] = 4.401308817383362136048032038528753151144E110028 F86DF6 84 22 38 E7 E0 .DB $84,$22,$38,$E7,$E0,$BC,$D7,$D9,$5BBC D7 D9 5B10029 F86DFF AE 51 7A FC 66 .DB $AE,$51,$7A,$FC,$66,$0D,$B0,$04,$400D B0 04 4010030 ; MP[5] = -1.716772506388927649032068540558788106762E310031 F86E08 44 3A 92 A3 59 .DB $44,$3A,$92,$A3,$59,$97,$98,$46,$5F97 98 46 5F10032 F86E11 A6 8C 51 5F B8 .DB $A6,$8C,$51,$5F,$B8,$98,$D6,$09,$C098 D6 09 C010033 ; MP[4] = 4.578962475841642634225390068461943438441E410034 F86E1A C3 21 E0 44 63 .DB $C3,$21,$E0,$44,$63,$32,$45,$02,$AF32 45 02 AF10035 F86E23 73 E6 2A F0 9F .DB $73,$E6,$2A,$F0,$9F,$DD,$B2,$0E,$40DD B2 0E 4010036 ; MP[3] = -7.212432713558031519943281748462837065308E510037 F86E2C 12 EA 50 4A 6C .DB $12,$EA,$50,$4A,$6C,$00,$52,$CF,$E100 52 CF E110038 F86E35 C1 2E 79 57 B4 .DB $C1,$2E,$79,$57,$B4,$15,$B0,$12,$C015 B0 12 C010039 ; MP[2] = 8.944630806357575461578107295909719817253E610040 F86E3E 20 48 52 E0 BA .DB $20,$48,$52,$E0,$BA,$5E,$BC,$44,$7D5E BC 44 7D10041 F86E47 37 73 6D CE F6 .DB $37,$73,$6D,$CE,$F6,$7B,$88,$16,$407B 88 16 4010042 ; MP[1] = -5.722847283900608941516165725053359168840E710043 F86E50 7C BD E1 4B F3 .DB $7C,$BD,$E1,$4B,$F3,$59,$CC,$B5,$CB59 CC B5 CB10044 F86E59 98 46 B2 35 2E .DB $98,$46,$B2,$35,$2E,$4F,$DA,$18,$C04F DA 18 C010045 ; MP[0] = 2.943520915569954073888921213330863757240E810046 F86E62 12 F3 2E 3D 05 .DB $12,$F3,$2E,$3D,$05,$16,$56,$0F,$1616 56 0F 1610047 F86E6B 02 BA 74 DC A6 .DB $02,$BA,$74,$DC,$A6,$5B,$8C,$1B,$405B 8C 1B 401004810049 F86E74 cem1q:10050 ; MQ[7] = -8.802340681794263968892934703309274564037E110051 F86E74 5B 7E 65 0F E1 .DB $5B,$7E,$65,$0F,$E1,$0C,$75,$92,$240C 75 92 2410052 F86E7D 56 22 7B FA FB .DB $56,$22,$7B,$FA,$FB,$0B,$B0,$05,$C00B B0 05 C010053 ; MQ[6] = 3.697714952261803935521187272204485251835E310054 F86E86 FE 14 1F B8 5A .DB $FE,$14,$1F,$B8,$5A,$2E,$44,$50,$D92E 44 50 D910055 F86E8F 62 6A C8 71 70 .DB $62,$6A,$C8,$71,$70,$1B,$E7,$0A,$401B E7 0A 4010056 ; MQ[5] = -9.615511549171441430850103489315371768998E410057 F86E98 D6 13 D7 2D 65 .DB $D6,$13,$D7,$2D,$65,$3A,$0E,$9C,$283A 0E 9C 2810058 F86EA1 2F B8 6E C8 8E .DB $2F,$B8,$6E,$C8,$8E,$CD,$BB,$0F,$C0CD BB 0F C010059 ; MQ[4] = 1.682912729190313538934190635536631941751E610060 F86EAA 02 77 B9 68 7D .DB $02,$77,$B9,$68,$7D,$29,$95,$7B,$AD29 95 7B AD10061 F86EB3 29 BB 61 D5 05 .DB $29,$BB,$61,$D5,$05,$6F,$CD,$13,$40Tue Jul 17 11:00:18 2018 Page 1346F CD 13 4010062 ; MQ[3] = -2.019684072836541751428967854947019415698E710063 F86EBC CB B8 14 C8 CF .DB $CB,$B8,$14,$C8,$CF,$E5,$F5,$70,$E1E5 F5 70 E110064 F86EC5 F7 13 3B 5D F4 .DB $F7,$13,$3B,$5D,$F4,$16,$9A,$17,$C016 9A 17 C010065 ; MQ[2] = 1.615869009634292424463780387327037251069E810066 F86ECE 1C 14 94 07 23 .DB $1C,$14,$94,$07,$23,$62,$73,$13,$0562 73 13 0510067 F86ED7 C8 34 6A 4F ED .DB $C8,$34,$6A,$4F,$ED,$19,$9A,$1A,$4019 9A 1A 4010068 ; MQ[1] = -7.848989743695296475743081255027098295771E810069 F86EE0 DC 5E 0D 28 3F .DB $DC,$5E,$0D,$28,$3F,$32,$AD,$EF,$DC32 AD EF DC10070 F86EE9 FA 65 7A 79 6E .DB $FA,$65,$7A,$79,$6E,$22,$BB,$1C,$C022 BB 1C C010071 ; MQ[0] = 1.766112549341972444333352727998584753865E910072 F86EF2 D0 35 67 DC 07 .DB $D0,$35,$67,$DC,$07,$21,$01,$17,$2121 01 17 2110073 F86EFB 03 17 AF 4A 7A .DB $03,$17,$AF,$4A,$7A,$89,$D2,$1D,$4089 D2 1D 401007410075 ; maxln = 11356.52340629414394949193107797076410076 ; above this value, exp(x) overflow10077 F86F04 00 80 F2 03 98 maxln: .DB $00,$80,$F2,$03,$98,$B3,$E3,$C9,$ABB3 E3 C9 AB10078 F86F0D 79 CF D1 F7 17 .DB $79,$CF,$D1,$F7,$17,$72,$B1,$0C,$4072 B1 0C 401007910080 ; minln = -1.143276959615573793352782661133116431383730e410081 ; below this value, exp(x) underflow10082 F86F16 45 C0 39 B1 F4 minln: .DB $45,$C0,$39,$B1,$F4,$B2,$26,$E9,$44B2 26 E9 4410083 F86F1F 16 C0 03 11 14 .DB $16,$C0,$03,$11,$14,$A3,$B2,$0C,$C0A3 B2 0C C01008410085 ; min. argument for expm1() -- below this value expm1() = -110086 ; mxm1 = loge(2^-114) = -7.9018778583833765273564461846232128760607E110087 F86F28 00 80 84 63 F3 mxm1: .DB $00,$80,$84,$63,$F3,$CB,$CE,$FF,$5CCB CE FF 5C10088 F86F31 C8 DC B6 58 9D .DB $C8,$DC,$B6,$58,$9D,$09,$9E,$05,$C009 9E 05 C01008910090 ; e = 2.7182818284590452353602874713526623 (35 digits)10091 F86F3A 00 00 3D 27 20 ceul: .DB $00,$00,$3D,$27,$20,$56,$DC,$AF,$9A56 DC AF 9A10092 F86F43 4A BB A2 58 54 .DB $4A,$BB,$A2,$58,$54,$F8,$AD,$00,$40F8 AD 00 401009310094 ; coefficients for exp10() evaluation10095 F86F4C ce10p:10096 ; P[5] = 6.781965388610215141646963666801877147888E110097 F86F4C 45 E4 3F 51 CF .DB $45,$E4,$3F,$51,$CF,$31,$82,$DB,$8231 82 DB 8210098 F86F55 33 B2 95 AC A9 .DB $33,$B2,$95,$AC,$A9,$A3,$87,$05,$40A3 87 05 4010099 ; P[4] = 4.930988843306627886355612005613845141123E4Tue Jul 17 11:00:18 2018 Page 13510100 F86F5E D5 25 84 99 5A .DB $D5,$25,$84,$99,$5A,$EB,$62,$D1,$4BEB 62 D1 4B10101 F86F67 5A 74 59 70 E3 .DB $5A,$74,$59,$70,$E3,$9D,$C0,$0E,$409D C0 0E 4010102 ; P[3] = 9.112966716416345527154611203937593471620E610103 F86F70 36 62 7E 7C 7A .DB $36,$62,$7E,$7C,$7A,$40,$20,$E5,$5B40 20 E5 5B10104 F86F79 C6 0F 67 B7 86 .DB $C6,$0F,$67,$B7,$86,$0D,$8B,$16,$400D 8B 16 4010105 ; P[2] = 5.880306836049276068401249115246879608067E810106 F86F82 2E 0E F8 F9 5C .DB $2E,$0E,$F8,$F9,$5C,$1D,$B4,$4D,$7F1D B4 4D 7F10107 F86F8B 24 72 6B 6E 8B .DB $24,$72,$6B,$6E,$8B,$32,$8C,$1C,$4032 8C 1C 4010108 ; P[1] = 1.294143447497151402129871056524193102276E1010109 F86F94 63 CA AF 6C 10 .DB $63,$CA,$AF,$6C,$10,$94,$56,$45,$2594 56 45 2510110 F86F9D 49 2D BE 9A A7 .DB $49,$2D,$BE,$9A,$A7,$D7,$C0,$20,$40D7 C0 20 4010111 ; P[0] = 6.737236378815985929063482575381049393067E1010112 F86FA6 DC 96 E7 F7 15 .DB $DC,$96,$E7,$F7,$15,$39,$D0,$93,$9D39 D0 93 9D10113 F86FAF C8 8E C2 00 4B .DB $C8,$8E,$C2,$00,$4B,$FB,$FA,$22,$40FB FA 22 401011410115 F86FB8 ce10q:10116 ; Q[5] = 2.269602544366008200564158516293459788943E310117 F86FB8 58 5C 11 75 0B .DB $58,$5C,$11,$75,$0B,$63,$2E,$D1,$F363 2E D1 F310118 F86FC1 4E A6 8F 05 A4 .DB $4E,$A6,$8F,$05,$A4,$D9,$8D,$0A,$40D9 8D 0A 4010119 ; Q[4] = 7.712352920905011963059413773034169405418E510120 F86FCA 18 FC B0 15 D1 .DB $18,$FC,$B0,$15,$D1,$8B,$DA,$20,$C48B DA 20 C410121 F86FD3 E1 16 67 AC 34 .DB $E1,$16,$67,$AC,$34,$4A,$BC,$12,$404A BC 12 4010122 ; Q[3] = 8.312829542416079818945631366865677745737E710123 F86FDC 22 3B 86 E2 A1 .DB $22,$3B,$86,$E2,$A1,$37,$CF,$01,$8F37 CF 01 8F10124 F86FE5 AA B9 92 ED FC .DB $AA,$B9,$92,$ED,$FC,$8D,$9E,$19,$408D 9E 19 4010125 ; Q[2] = 3.192530874297321568824835872165913128965E910126 F86FEE 58 36 A6 B4 D3 .DB $58,$36,$A6,$B4,$D3,$61,$82,$7F,$2E61 82 7F 2E10127 F86FF7 44 1D 4C BA 27 .DB $44,$1D,$4C,$BA,$27,$4A,$BE,$1E,$404A BE 1E 4010128 ; Q[1] = 3.709588725051672862074295071447979432510E1010129 F87000 D8 CE E2 0B 30 .DB $D8,$CE,$E2,$0B,$30,$77,$F8,$EF,$3A77 F8 EF 3A10130 F87009 85 44 28 19 65 .DB $85,$44,$28,$19,$65,$31,$8A,$22,$4031 8A 22 4010131 ; Q[0] = 5.851889165195258152098281616369230806944E1010132 F87012 58 7C 65 00 31 .DB $58,$7C,$65,$00,$31,$77,$52,$F6,$1E77 52 F6 1E10133 F8701B C6 3D 3F C8 F6 .DB $C6,$3D,$3F,$C8,$F6,$FF,$D9,$22,$40FF D9 22 4010134Tue Jul 17 11:00:18 2018 Page 13610135 ; log10(2) = lg102a + lg102b = 3.0102999566398119521373889e-110136 ; lg102a = 3.01025390625e-110137 F87024 00 00 00 00 00 lg102a: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0010138 F8702D 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$20,$9A,$FD,$3F20 9A FD 3F10139 ; lg102b = 4.6050389811952137388947244930267681898814621E-610140 F87036 AC 26 78 91 7C lg102b: .DB $AC,$26,$78,$91,$7C,$0B,$AC,$59,$890B AC 59 8910141 F8703F 8F 98 F7 CF FB .DB $8F,$98,$F7,$CF,$FB,$84,$9A,$ED,$3F84 9A ED 3F1014210143 ; log2(10) = 3.32192809488736234787031942948939017586483110144 F87048 4C DB AF 4D FF lg210: .DB $4C,$DB,$AF,$4D,$FF,$F6,$2B,$49,$FEF6 2B 49 FE10145 F87051 8A 1B CD 4B 78 .DB $8A,$1B,$CD,$4B,$78,$9A,$D4,$00,$409A D4 00 401014610147 ; maxl10 = 4.9320754489586679023818980511660936429E310148 F8705A 00 80 7C 0B AC maxl10: .DB $00,$80,$7C,$0B,$AC,$59,$89,$8F,$9859 89 8F 9810149 F87063 F7 CF FB 84 9A .DB $F7,$CF,$FB,$84,$9A,$20,$9A,$0B,$4020 9A 0B 4010150 ; minl10 = -4.932075448958667902381898051166093750570023E310151 F8706C 77 91 7C 0B AC minl10: .DB $77,$91,$7C,$0B,$AC,$59,$89,$8F,$9859 89 8F 9810152 F87075 F7 CF FB 84 9A .DB $F7,$CF,$FB,$84,$9A,$20,$9A,$0B,$C020 9A 0B C01015310154 ; coefficients for exp2() evaluation10155 F8707E ce2p:10156 ; P[4] = 1.587171580015525194694938306936721666031E210157 F8707E 72 92 38 9A 50 .DB $72,$92,$38,$9A,$50,$06,$08,$65,$0406 08 65 0410158 F87087 98 BB B2 AA 97 .DB $98,$BB,$B2,$AA,$97,$B7,$9E,$06,$40B7 9E 06 4010159 ; P[3] = 6.185032670011643762127954396427045467506E510160 F87090 D2 BC B4 93 EB .DB $D2,$BC,$B4,$93,$EB,$21,$7F,$08,$D621 7F 08 D610161 F87099 4F 03 A3 45 74 .DB $4F,$03,$A3,$45,$74,$00,$97,$12,$4000 97 12 4010162 ; P[2] = 5.677513871931844661829755443994214173883E810163 F870A2 42 4D E3 47 3D .DB $42,$4D,$E3,$47,$3D,$36,$86,$67,$1136 86 67 1110164 F870AB 26 D2 C5 6C CB .DB $26,$D2,$C5,$6C,$CB,$5C,$87,$1C,$405C 87 1C 4010165 ; P[1] = 1.530625323728429161131811299626419117557E1110166 F870B4 7D 20 45 D0 EE .DB $7D,$20,$45,$D0,$EE,$9C,$89,$CD,$669C 89 CD 6610167 F870BD 25 5F 53 94 F3 .DB $25,$5F,$53,$94,$F3,$8C,$8E,$24,$408C 8E 24 4010168 ; P[0] = 9.079594442980146270952372234833529694788E1210169 F870C6 FF EB 3C 5D 44 .DB $FF,$EB,$3C,$5D,$44,$B2,$CC,$35,$20B2 CC 35 2010170 F870CF 57 42 0E 06 20 .DB $57,$42,$0E,$06,$20,$20,$84,$2A,$4020 84 2A 4010171Tue Jul 17 11:00:18 2018 Page 13710172 F870D8 ce2q:10173 ; Q[4] = 1.236602014442099053716561665053645270207E410174 F870D8 5F 7D C4 10 CE .DB $5F,$7D,$C4,$10,$CE,$91,$ED,$64,$A491 ED 64 A410175 F870E1 67 35 BD A0 14 .DB $67,$35,$BD,$A0,$14,$38,$C1,$0C,$4038 C1 0C 4010176 ; Q[3] = 2.186249607051644894762167991800811827835E710177 F870EA 15 9B 5C BC E3 .DB $15,$9B,$5C,$BC,$E3,$D1,$FC,$B0,$07D1 FC B0 0710178 F870F3 D9 AE 06 09 30 .DB $D9,$AE,$06,$09,$30,$CC,$A6,$17,$40CC A6 17 4010179 ; Q[2] = 1.092141473886177435056423606755843616331E1010180 F870FC C8 3E E7 04 F9 .DB $C8,$3E,$E7,$04,$F9,$42,$1F,$0D,$9B42 1F 0D 9B10181 F87105 4F 27 B7 14 E4 .DB $4F,$27,$B7,$14,$E4,$BD,$A2,$20,$40BD A2 20 4010182 ; Q[1] = 1.490560994263653042761789432690793026977E1210183 F8710E 64 87 EE 32 85 .DB $64,$87,$EE,$32,$85,$37,$63,$BC,$E737 63 BC E710184 F87117 96 D3 EB E5 2D .DB $96,$D3,$EB,$E5,$2D,$86,$AD,$27,$4086 AD 27 4010185 ; Q[0] = 2.619817175234089411411070339065679229869E1310186 F87120 68 99 1A 49 CE .DB $68,$99,$1A,$49,$CE,$E7,$82,$4C,$25E7 82 4C 2510187 F87129 27 A7 BC C4 E5 .DB $27,$A7,$BC,$C4,$E5,$9D,$BE,$2B,$409D BE 2B 401018810189 ; maxl2 = 1638410190 F87132 00 00 00 00 00 maxl2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0010191 F8713B 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$80,$0D,$4000 80 0D 4010192 ; minl2 = -1649410193 F87144 00 00 00 00 00 minl2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0010194 F8714D 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$DC,$80,$0D,$C0DC 80 0D C0101951019610197 ;---------------------------------------------------------------------------10198 ; circular functions & inverse circular functions10199 ;---------------------------------------------------------------------------1020010201 ; fcos - returns the circular cosine of the radian argument x10202 ;10203 ; entry:10204 ; fac = x (|x| < 2^56)10205 ;10206 ; exit:10207 ; fac = cos(x)10208 ; CF = 1 if invalid result (nan, if x is too large)10209 ;10210 ; computation mean time: 70ms at 4MHz10211 ;10212 ;----10213 F87156 fcos:10214 ;----Tue Jul 17 11:00:18 2018 Page 13810215 F87156 64 CF stz fpcsgn ; positive sign10216 F87158 64 24 stz facsgn ; make argument positive10217 F8715A 20 05 72 jsr modpi4 ; reduce argument: z = x - k*(pi/4)10218 F8715D A5 CE lda fpoct ; octant10219 F8715F C9 04 cmp #410220 F87161 90 0A bcc ?ok ; no change10221 F87163 AA tax10222 F87164 A5 CF lda fpcsgn ; invert sign10223 F87166 49 FF eor #$FF10224 F87168 85 CF sta fpcsgn10225 F8716A 8A txa10226 F8716B E9 04 sbc #4 ; reflect in x axis10227 F8716D C9 02 ?ok: cmp #210228 F8716F 90 0A bcc ?ok210229 F87171 AA tax10230 F87172 A5 CF lda fpcsgn ; invert sign10231 F87174 49 FF eor #$FF10232 F87176 85 CF sta fpcsgn10233 F87178 8A txa10234 F87179 C9 02 cmp #210235 F8717B F0 04 ?ok2: beq ?s0 ; octant = 210236 F8717D C9 01 cmp #110237 F8717F D0 05 bne ?s110238 F87181 20 C0 71 ?s0: jsr sinz ; 1 & 2nd octant: sinz10239 F87184 80 2E bra sincos10240 F87186 20 DB 71 ?s1: jsr cosz ; 0 & 3nd octant: cosz10241 F87189 80 29 bra sincos1024210243 ; fsin - returns the circular sine of the radian argument x10244 ;10245 ; entry:10246 ; fac = x (|x| < 2^56)10247 ;10248 ; exit:10249 ; fac = sin(x)10250 ; CF = 1 if invalid result (nan, if x is too large)10251 ;10252 ; computation mean time: 70ms at 4MHz10253 ;10254 ;----10255 F8718B fsin:10256 ;----10257 F8718B A5 24 lda facsgn ; save sign...10258 F8718D 85 CF sta fpcsgn10259 F8718F 64 24 stz facsgn ; ...and make argument positive10260 F87191 20 05 72 jsr modpi4 ; reduce argument: z = x - k*(pi/4)10261 F87194 A5 CE lda fpoct ; octant10262 F87196 C9 04 cmp #410263 F87198 90 0A bcc ?ok ; no change10264 F8719A AA tax10265 F8719B A5 CF lda fpcsgn ; invert sign10266 F8719D 49 FF eor #$FF10267 F8719F 85 CF sta fpcsgn10268 F871A1 8A txa10269 F871A2 E9 04 sbc #4 ; reflect in x axis10270 F871A4 C9 01 ?ok: cmp #110271 F871A6 F0 04 beq ?s0Tue Jul 17 11:00:18 2018 Page 13910272 F871A8 C9 02 cmp #210273 F871AA D0 05 bne ?s110274 F871AC 20 DB 71 ?s0: jsr cosz ; 1 & 2nd octant: cosz10275 F871AF 80 03 bra sincos10276 F871B1 20 C0 71 ?s1: jsr sinz ; 0 & 3nd octant: sinz1027710278 F871B4 sincos:10279 F871B4 24 CF bit fpcsgn10280 F871B6 10 06 bpl ?end10281 F871B8 A5 24 lda facsgn ; sign inversion10282 F871BA 49 FF eor #$FF10283 F871BC 85 24 sta facsgn10284 F871BE 18 ?end: clc10285 F871BF 60 rts1028610287 ; sinz - evaluates the sine of the reduced argument10288 ;10289 ; 3 210290 ; sin(z) = z + z * P(z )10291 ;10292 ;----10293 F871C0 sinz:10294 ;----10295 F871C0 A9 AD lda #<psin10296 F871C2 A0 75 ldy #>psin10297 F871C4 A2 0B ldx #1110298 F871C6 20 1C 87 jsr peval ; fac=P(z*z)10299 F871C9 20 CE 85 jsr mvt0_a ; z*z10300 F871CC 20 DD 49 jsr fpmult10301 F871CF 20 FB 85 jsr mvt1_a ; z10302 F871D2 20 DD 49 jsr fpmult ; (z^3) * P(z*z)10303 F871D5 20 FB 85 jsr mvt1_a ; z10304 F871D8 4C 7D 45 jmp fpadd ; z + (z^3) * P(z*z)1030510306 ; cosz - evaluates cosine of reduced argument10307 ;10308 ; 1 2 4 210309 ; cos(z) = 1 - --- * z + z * P(z )10310 ; 210311 ;10312 ;----10313 F871DB cosz:10314 ;----10315 F871DB A9 85 lda #<pcos10316 F871DD A0 76 ldy #>pcos10317 F871DF A2 0A ldx #1010318 F871E1 20 1C 87 jsr peval ; fac=P(z*z)10319 F871E4 20 CE 85 jsr mvt0_a ; z*z10320 F871E7 20 DD 49 jsr fpmult10321 F871EA 20 CE 85 jsr mvt0_a ; z*z10322 F871ED 20 DD 49 jsr fpmult10323 F871F0 20 6C 45 jsr faddone ; 1 + (z^4) * P(z*z)10324 F871F3 20 39 84 jsr mvftoa ; move to arg10325 F871F6 20 47 85 jsr mvt0_f ; z*z10326 F871F9 A9 FF lda #$FF10327 F871FB 85 46 sta scexp10328 F871FD 85 47 sta scexp+1Tue Jul 17 11:00:18 2018 Page 14010329 F871FF 20 B7 48 jsr fscale ; z*z/210330 F87202 4C 5F 45 jmp fpsub ; 1 - (z*z/2) + (z^4) * P(z*z)1033110332 ; modpi4 - argument reduction modulo pi/410333 ;10334 ; entry:10335 ; fac = x10336 ;10337 ; exit:10338 ; tfr1 = z, reduced argument in interval [0, pi/4]10339 ; fac = tfr0 = z*z10340 ; fpoct = octant modulo 360 degrees (0..7)10341 ;10342 ; If argument is invalid this function return CF=1 and skip the10343 ; return address.10344 ;10345 ; If |x| >= 2^56 the reduction fail due to a large precision loss10346 ; computing the modulo pi/4 of the argument (returns nan)10347 ;10348 ; The reduction error is nearly eliminated by contriving an extended10349 ; precision modular arithmetic10350 ;10351 ;------10352 F87205 modpi4:10353 ;------10354 F87205 24 25 bit facst10355 F87207 30 0B bmi ?er ; fac=nan or inf10356 F87209 ACC1610357 F87209 C2 20 rep #PMFLAG10358 .LONGA on10359 .MNLIST10360 F8720B A5 22 lda facexp10361 F8720D C9 37 40 cmp #BIAS56 ; compare vs. 2^5610362 F87210 ACC0810363 F87210 E2 20 sep #PMFLAG10364 .LONGA off10365 .MNLIST10366 F87212 90 0B bcc ?ok ; if too large returns nan10367 F87214 20 74 4E ?er: jsr fldnan10368 F87217 A5 CF lda fpcsgn10369 F87219 85 24 sta facsgn10370 F8721B 68 pla ; skip return address10371 F8721C 68 pla10372 F8721D 38 sec10373 F8721E 60 rts10374 F8721F 20 93 84 ?ok: jsr mvf_t1 ; tfr1=x10375 F87222 A9 81 lda #<cpio410376 F87224 A0 77 ldy #>cpio410377 F87226 20 0A 4A jsr fcrdiv ; y=x/(pi/4)10378 F87229 20 27 50 jsr floor ; integral part10379 F8722C 20 78 4F jsr uitrunc ; convert to integer in tm10380 ; just 8 bit value we need here10381 F8722F A5 00 lda tm ; map zeros to origin10382 F87231 4A lsr a10383 F87232 90 05 bcc ?no10384 F87234 E6 00 inc tm10385 F87236 20 6C 45 jsr faddone ; y=y+1Tue Jul 17 11:00:18 2018 Page 14110386 F87239 A5 00 ?no: lda tm10387 F8723B 29 07 and #$07 ; octant modulo 360 degrees...10388 F8723D 85 CE sta fpoct ; ...for tests on the phase angle10389 F8723F 20 C0 84 jsr mvf_t2 ; tfr2=y10390 F8724210391 ; computes z = x - y*(pi/4) with extended precision modular arithmetic10392 F87242 A9 4B lda #<cdp110393 F87244 A0 77 ldy #>cdp110394 F87246 20 D5 49 jsr fcmult ; y*cdp110395 F87249 20 FB 85 jsr mvt1_a ; arg=x10396 F8724C 20 5F 45 jsr fpsub ; x=x-y*cdp110397 F8724F 20 93 84 jsr mvf_t1 ; tfr1=x10398 F87252 20 A1 85 jsr mvt2_f ; fac=y10399 F87255 A9 5D lda #<cdp210400 F87257 A0 77 ldy #>cdp210401 F87259 20 D5 49 jsr fcmult ; y*cdp210402 F8725C 20 FB 85 jsr mvt1_a ; arg=x10403 F8725F 20 5F 45 jsr fpsub ; x=x-y*cdp1-y*cdp210404 F87262 20 93 84 jsr mvf_t1 ; tfr1=x10405 F87265 20 A1 85 jsr mvt2_f ; fac=y10406 F87268 A9 6F lda #<cdp310407 F8726A A0 77 ldy #>cdp310408 F8726C 20 D5 49 jsr fcmult ; y*cdp310409 F8726F 20 FB 85 jsr mvt1_a ; arg=x10410 F87272 20 5F 45 jsr fpsub ; z=x-y*cdp3-y*cdp2-y*cdp110411 F87275 20 93 84 jsr mvf_t1 ; tfr1=z=x-k*(pi/4)10412 F87278 20 CC 49 jsr fsquare ; z*z10413 F8727B 4C 66 84 jmp mvf_t0 ; tfr0=z*z1041410415 ; ftan - returns the circular tangent of the radian argument x10416 ;10417 ; entry:10418 ; fac = x10419 ;10420 ; exit:10421 ; fac = tan(x)10422 ; CF = 1 if invalid result (nan or inf)10423 ;10424 ; strategy10425 ;10426 ; Range reduction is modulo pi/4. A rational function10427 ; x + x^3 P(x^2)/Q(x^2)10428 ; is employed in the basic interval [0, pi/4].10429 ;10430 ; computation mean time: 70/80ms at 4MHz10431 ;10432 ;----10433 F8727E ftan:10434 ;----10435 F8727E A9 00 lda #010436 F87280 20 A0 72 jsr tancot ; computes tan(x)10437 F87283 B0 03 bcs ?end ; returns nan10438 F87285 10 01 bpl ?end ; returns finite value (CF=0)10439 F87287 38 sec10440 F87288 60 ?end: rts1044110442 ; fcotan - returns the circular cotangent of the radian argument xTue Jul 17 11:00:18 2018 Page 14210443 ;10444 ; entry:10445 ; fac = x10446 ;10447 ; exit:10448 ; fac = cotan(x)10449 ; CF = 1 if invalid result (nan or inf)10450 ;10451 ; strategy10452 ;10453 ; Range reduction is modulo pi/4. A rational function10454 ; x + x^3 P(x^2)/Q(x^2)10455 ; is employed in the basic interval [0, pi/4].10456 ;10457 ; computation mean time: 70/80ms at 4MHz10458 ;10459 ;------10460 F87289 fcotan:10461 ;------10462 F87289 24 25 bit facst10463 F8728B 30 0D bmi ?nan10464 F8728D 70 0E bvs ?inf ; x = 010465 F8728F A9 FF lda #$FF10466 F87291 20 A0 72 jsr tancot ; computes cotan(x)10467 F87294 B0 03 bcs ?end ; return nan10468 F87296 10 01 bpl ?end ; returns finite value (CF=0)10469 F87298 38 sec10470 F87299 60 ?end: rts10471 F8729A 4C 74 4E ?nan: jmp fldnan ; returns nan10472 F8729D 4C 7D 4E ?inf: jmp fldinf ; returns inf10473 F872A010474 ; tancot - common routine used computing tan(x) & cotan(x)10475 ;10476 ; entry:10477 ; fac = x10478 ; A = cotangent flag10479 ;10480 ; exit:10481 ; fac = tan(x) or cotan(x)10482 ; CF = 1 if returns nan10483 ; NF = 1 if returns inf10484 ;10485 ;------10486 F872A0 tancot:10487 ;------10488 F872A0 85 D0 sta fpcot ; cotangent flag10489 F872A2 A5 24 lda facsgn ; save sign...10490 F872A4 85 CF sta fpcsgn10491 F872A6 64 24 stz facsgn ; ...and make argument positive10492 F872A8 20 05 72 jsr modpi4 ; argument reduction: z = x - k*(pi/4)10493 ; fac=tfr0=z*z=w10494 F872AB A9 DB lda #<ptan10495 F872AD A0 77 ldy #>ptan10496 F872AF A2 05 ldx #510497 F872B1 20 1C 87 jsr peval ; evaluate P(w)10498 F872B4 20 CE 85 jsr mvt0_a10499 F872B7 20 DD 49 jsr fpmult ; w*P(w)Tue Jul 17 11:00:18 2018 Page 14310500 F872BA 20 C0 84 jsr mvf_t2 ; tfr2=w*P(w)10501 F872BD A9 47 lda #<qtan10502 F872BF A0 78 ldy #>qtan10503 F872C1 A2 05 ldx #510504 F872C3 20 3A 87 jsr pevalp1 ; evaluate Q(w)10505 F872C6 20 28 86 jsr mvt2_a ; arg=w*P(w)10506 F872C9 20 10 4A jsr fpdiv ; w*P(w)/Q(w)10507 F872CC 20 FB 85 jsr mvt1_a ; arg=z10508 F872CF 20 DD 49 jsr fpmult ; z*w*R(w)10509 F872D2 20 FB 85 jsr mvt1_a ; arg=z10510 F872D5 20 7D 45 jsr fpadd ; z + z*w*R(w)10511 F872D8 A5 CE ?done: lda fpoct ; octant10512 F872DA 29 02 and #$0210513 F872DC F0 0C beq ?cot10514 F872DE A5 24 lda facsgn10515 F872E0 49 FF eor #$FF10516 F872E2 85 24 sta facsgn ; sign inversion10517 F872E4 24 D0 bit fpcot10518 F872E6 30 09 bmi ?end ; cotan(x)10519 F872E8 80 04 bra ?rec ; tan(x)10520 F872EA 24 D0 ?cot: bit fpcot10521 F872EC 10 03 bpl ?end ; tan(x)10522 F872EE 20 FD 49 ?rec: jsr frecip10523 F872F1 24 CF ?end: bit fpcsgn10524 F872F3 10 06 bpl ?end210525 F872F5 A5 24 lda facsgn ; sign inversion10526 F872F7 49 FF eor #$FF10527 F872F9 85 24 sta facsgn10528 F872FB 18 ?end2: clc10529 F872FC 24 25 bit facst ; return N=1 if invalid10530 F872FE 60 rts1053110532 ; fasin - inverse circular sine: returns radian angle10533 ; between -pi/2 and +pi/2 whose sine is x10534 ;10535 ; entry:10536 ; fac = x10537 ;10538 ; exit:10539 ; fac = asin(x) in domain [-p1/2,+pi/2]10540 ; CF = 1 if returns nan (|x| > 1)10541 ;10542 ; strategy10543 ;10544 ; A rational function of the form x + x^3 P(x^2)/Q(x^2)10545 ; is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is10546 ; transformed by the identity10547 ;10548 ; asin(x) = pi/2 - 2*asin(sqrt((1-x)/2))10549 ;10550 ; computation mean time: 100/130ms at 4MHz10551 ;10552 ;-----10553 F872FF fasin:10554 ;-----10555 F872FF 24 25 bit facst10556 F87301 30 1C bmi ?nan ; if argument is invalid return nanTue Jul 17 11:00:18 2018 Page 14410557 F87303 70 18 bvs ?ok ; if x=0 return 010558 F87305 20 24 74 jsr cmpx1 ; compare |x| vs. 110559 F87308 B0 15 bcs ?nan ; if |x|>1 return nan10560 F8730A 08 php10561 F8730B A5 24 lda facsgn10562 F8730D 85 CF sta fpcsgn ; save sign(x)10563 F8730F 28 plp10564 F87310 D0 10 bne ?do ; |x|<110565 F87312 A9 93 lda #<cpio2 ; |x|=1 so return sgn(x)*pi/210566 F87314 A0 77 ldy #>cpio210567 F87316 20 82 86 jsr ldfac ; x=pi/210568 F87319 A5 CF lda fpcsgn10569 F8731B 85 24 sta facsgn10570 F8731D 18 ?ok: clc10571 F8731E 60 rts10572 F8731F 4C 74 4E ?nan: jmp fldnan10573 F87322 64 24 ?do: stz facsgn ; |x|10574 F87324 64 D0 stz fpasin ; asin flag10575 F87326 20 1B 74 jsr cmpxh ; compare |x| vs. 0.510576 F87329 B0 08 bcs ?gt ; |x|>0.510577 F8732B 20 93 84 jsr mvf_t1 ; tfr1=z=|x|10578 F8732E 20 CC 49 jsr fsquare ; w=z*z10579 F87331 80 22 bra ?pp10580 F87333 A9 FF ?gt: lda #$FF10581 F87335 85 D0 sta fpasin ; |x| > 0.5 flag10582 F87337 20 9F 4E jsr ldahalf ; arg=0.510583 F8733A 20 5F 45 jsr fpsub ; w=0.5-|x|10584 F8733D 20 67 45 jsr faddhalf ; w=1-|x|10585 F87340 A9 FF lda #$FF10586 F87342 85 46 sta scexp10587 F87344 85 47 sta scexp+1 ; divive dy 210588 F87346 20 B7 48 jsr fscale ; w=0.5*(1-|x|)10589 F87349 20 C0 84 jsr mvf_t2 ; tfr2=w10590 F8734C 20 53 60 jsr fsqrt ; z=sqrt(w)10591 F8734F 20 93 84 jsr mvf_t1 ; tfr1=z10592 F87352 20 A1 85 jsr mvt2_f ; fac=w10593 F87355 20 66 84 ?pp: jsr mvf_t0 ; tfr0=w10594 F87358 A9 B3 lda #<casp10595 F8735A A0 78 ldy #>casp10596 F8735C A2 09 ldx #910597 F8735E 20 1C 87 jsr peval ; P(w)10598 F87361 20 CE 85 jsr mvt0_a ; w10599 F87364 20 DD 49 jsr fpmult ; w*P(w)10600 F87367 20 C0 84 jsr mvf_t2 ; tfr2=w*P(w)10601 F8736A A9 67 lda #<casq10602 F8736C A0 79 ldy #>casq10603 F8736E A2 09 ldx #910604 F87370 20 3A 87 jsr pevalp1 ; Q(w)10605 F87373 20 28 86 jsr mvt2_a ; arg=w*P(w)10606 F87376 20 10 4A jsr fpdiv ; w*P(w)/Q(w)=w*R(w)10607 F87379 20 FB 85 jsr mvt1_a ; arg=z10608 F8737C 20 DD 49 jsr fpmult ; z*w*R(w)10609 F8737F 20 FB 85 jsr mvt1_a ; arg=z10610 F87382 20 7D 45 jsr fpadd ; y=z+z*w*R(w)10611 F87385 24 D0 bit fpasin10612 F87387 10 10 bpl ?done ; |x| <= 0.510613 F87389 20 39 84 jsr mvftoaTue Jul 17 11:00:18 2018 Page 14510614 F8738C 20 7D 45 jsr fpadd ; y+y10615 F8738F A9 93 lda #<cpio210616 F87391 A0 77 ldy #>cpio210617 F87393 20 CF 86 jsr ldarg ; arg=pi/210618 F87396 20 5F 45 jsr fpsub ; pi/2-2*asin(z)10619 F87399 24 CF ?done: bit fpcsgn10620 F8739B 10 06 bpl ?end10621 F8739D A5 24 lda facsgn ; sign inversion10622 F8739F 49 FF eor #$FF10623 F873A1 85 24 sta facsgn10624 F873A3 18 ?end: clc10625 F873A4 60 rts1062610627 ; facos - inverse circular cosine: returns radian angle10628 ; between 0 and +pi whose cosine is x10629 ;10630 ; entry:10631 ; fac = x10632 ;10633 ; exit:10634 ; fac = acos(x) in domain [0,pi]10635 ; CF = 1 if returns nan (|x| > 1)10636 ;10637 ; strategy10638 ;10639 ; Analytically, acos(x) = pi/2 - asin(x). However if |x| is10640 ; near 1, there is cancellation error in subtracting asin(x)10641 ; from pi/2. Hence if x < -0.5,10642 ;10643 ; acos(x) = pi - 2.0 * asin(sqrt((1+x)/2))10644 ;10645 ; or if x > +0.5,10646 ;10647 ; acos(x) = 2.0 * asin(sqrt((1-x)/2))10648 ;10649 ; computation mean time: 100/140ms at 4MHz10650 ;10651 ;-----10652 F873A5 facos:10653 ;-----10654 F873A5 24 25 bit facst10655 F873A7 30 21 bmi ?nan ; if argument is invalid return nan10656 F873A9 70 22 bvs ?pi2 ; if x=0 return pi/210657 F873AB 20 24 74 jsr cmpx1 ; compare |x| vs. 110658 F873AE B0 1A bcs ?nan ; if |x|>1 return nan10659 F873B0 08 php10660 F873B1 A5 24 lda facsgn10661 F873B3 85 CF sta fpcsgn ; save sign(x)10662 F873B5 28 plp10663 F873B6 D0 20 bne ?do ; |x|<110664 F873B8 64 24 stz facsgn ; |x|=110665 F873BA 24 CF bit fpcsgn10666 F873BC 10 09 bpl ?z ; x=1 so return 010667 F873BE A9 A5 lda #<cpi ; x=-1 so return pi10668 F873C0 A0 77 ldy #>cpi10669 F873C2 20 82 86 jsr ldfac ; x=pi10670 F873C5 18 clcTue Jul 17 11:00:18 2018 Page 14610671 F873C6 60 rts10672 F873C7 4C 56 4E ?z: jmp fldz10673 F873CA 4C 74 4E ?nan: jmp fldnan10674 F873CD A9 93 ?pi2: lda #<cpio2 ; |x|=0 so return pi/210675 F873CF A0 77 ldy #>cpio210676 F873D1 20 82 86 jsr ldfac ; x=pi/210677 F873D4 64 24 stz facsgn10678 F873D6 18 ?ok: clc10679 F873D7 60 rts10680 F873D8 20 1B 74 ?do: jsr cmpxh ; compare |x| vs. 0.510681 F873DB B0 0D bcs ?gt ; |x|>0.510682 F873DD 20 FF 72 jsr fasin ; |x|<=0.510683 F873E0 A9 93 lda #<cpio210684 F873E2 A0 77 ldy #>cpio210685 F873E4 20 CF 86 jsr ldarg ; arg=pi/210686 F873E7 4C 5F 45 jmp fpsub ; pi/2-asin(x) if |x|<=0.510687 F873EA A5 CF ?gt: lda fpcsgn10688 F873EC 30 04 bmi ?neg10689 F873EE A2 FF ldx #$FF10690 F873F0 86 24 stx facsgn ; x<-0.5 or x>0.510691 F873F2 48 ?neg: pha ; save sign10692 F873F3 20 6C 45 jsr faddone ; y=1+x or y=1-x10693 F873F6 A9 FF lda #$FF10694 F873F8 85 46 sta scexp10695 F873FA 85 47 sta scexp+110696 F873FC 20 B7 48 jsr fscale ; divide by 210697 F873FF 20 53 60 jsr fsqrt ; w=sqrt(y/2)10698 F87402 20 FF 72 jsr fasin10699 F87405 A9 01 lda #110700 F87407 85 46 sta scexp10701 F87409 64 47 stz scexp+110702 F8740B 20 B7 48 jsr fscale ; multiplies by 210703 F8740E 68 pla ; original sign10704 F8740F 10 C5 bpl ?ok ; done: acos(x)=2*asin(w)10705 F87411 A9 A5 lda #<cpi10706 F87413 A0 77 ldy #>cpi10707 F87415 20 CF 86 jsr ldarg ; arg=pi10708 F87418 4C 5F 45 jmp fpsub ; acos(x)=pi-2*asin(w)10709 F8741B1071010711 ; compare |x| vs. 0.5 - flag's affected10712 ;10713 ; CF=0, ZF=0 if |x| < 0.510714 ; CF=0, ZF=1 if |x| = 0.510715 ; CF=1, ZF=0 if |x| > 0.510716 F8741B cmpxh:10717 F8741B ACC1610718 F8741B C2 20 rep #PMFLAG10719 .LONGA on10720 .MNLIST10721 F8741D A5 22 lda facexp10722 F8741F C9 FE 3F cmp #EBIAS-110723 F87422 80 07 bra cmpx1h10724 F8742410725 ; compare |x| vs. 1 - flag's affected10726 ;10727 ; CF=0, ZF=0 if |x| < 1Tue Jul 17 11:00:18 2018 Page 14710728 ; CF=0, ZF=1 if |x| = 110729 ; CF=1, ZF=0 if |x| > 110730 F87424 cmpx1:10731 F87424 ACC1610732 F87424 C2 20 rep #PMFLAG10733 .LONGA on10734 .MNLIST10735 F87426 A5 22 lda facexp10736 F87428 C9 FF 3F cmp #EBIAS10737 F8742B cmpx1h:10738 F8742B 90 1C bcc ?done ; |x|<1, CF=0, ZF=010739 F8742D F0 02 beq ?tst10740 F8742F B0 18 bcs ?done ; |x|>1, CF=1, ZF=010741 F87431 A5 20 ?tst: lda facm+14 ; should be $800010742 F87433 C9 00 80 cmp #$8000 ; here always CF=110743 F87436 D0 11 bne ?done ; |x|>1, CF=1, ZF=010744 F87438 A5 1E lda facm+1210745 F8743A 05 1C ora facm+1010746 F8743C 05 1A ora facm+810747 F8743E 05 18 ora facm+610748 F87440 05 16 ora facm+410749 F87442 05 14 ora facm+210750 F87444 05 12 ora facm10751 F87446 D0 01 bne ?done ; |x|>1, CF=1, ZF=010752 F87448 18 clc ; |x|=1, CF=0, ZF=110753 F87449 ?done: ACC0810754 F87449 E2 20 sep #PMFLAG10755 .LONGA off10756 .MNLIST10757 F8744B 60 rts1075810759 ; fatan - inverse circular tangent, returns radian angle10760 ; between -pi/2 and +pi/2 whose tangent is x10761 ;10762 ; entry:10763 ; fac = x10764 ;10765 ; exit:10766 ; fac = atan(x) in domain [-pi/2,pi/2]10767 ; CF = 1 if returns nan10768 ;10769 ; strategy10770 ;10771 ; Range reduction is from four intervals into the interval10772 ; from zero to tan(pi/8). The approximant uses a rational10773 ; function of the form x + x^3 P(x)/Q(x).10774 ;10775 ; computation mean time: 100ms at 4MHz10776 ;10777 ;-----10778 F8744C fatan:10779 ;-----10780 F8744C 24 25 bit facst10781 F8744E 10 13 bpl ?fv ; valid fac10782 F87450 50 0F bvc ?er ; fac=nan so return nan10783 F87452 A5 24 lda facsgn10784 F87454 48 phaTue Jul 17 11:00:18 2018 Page 14810785 F87455 A9 93 lda #<cpio210786 F87457 A0 77 ldy #>cpio210787 F87459 20 82 86 jsr ldfac ; x=pi/210788 F8745C 68 pla10789 F8745D 85 24 sta facsgn ; return +/-pi/210790 F8745F 18 ?ok: clc10791 F87460 60 rts10792 F87461 38 ?er: sec10793 F87462 60 rts10794 F87463 70 FA ?fv: bvs ?ok ; if fac=0 return 010795 F87465 A5 24 lda facsgn ; save sign...10796 F87467 85 CF sta fpcsgn10797 F87469 64 24 stz facsgn ; ...and make argument positive10798 F8746B A9 B7 lda #<ct3p810799 F8746D A0 77 ldy #>ct3p810800 F8746F 20 5E 87 jsr fccmp ; cmpare x vs. tan(3*pi/8)10801 F87472 10 3E bpl ?gt38 ; fac > tan(3*pi/8)10802 F87474 A9 C9 lda #<ctp810803 F87476 A0 77 ldy #>ctp810804 F87478 20 5E 87 jsr fccmp ; cmpare x vs. tan(pi/8)10805 F8747B 10 0B bpl ?gt8 ; fac > tan(pi/8)10806 F8747D 20 93 84 jsr mvf_t1 ; tfr1=w=x10807 F87480 20 56 4E jsr fldz10808 F87483 20 C0 84 jsr mvf_t2 ; tfr2=y=010809 F87486 80 3E bra ?do10810 F87488 20 66 84 ?gt8: jsr mvf_t0 ; tfr0=x10811 F8748B 20 39 84 jsr mvftoa ; arg=x10812 F8748E 20 32 4E jsr fldm1 ; fac=-110813 F87491 20 7D 45 jsr fpadd ; x-110814 F87494 20 93 84 jsr mvf_t1 ; tfr1=x-110815 F87497 20 47 85 jsr mvt0_f ; fac=x10816 F8749A 20 6C 45 jsr faddone ; x+110817 F8749D 20 FB 85 jsr mvt1_a ; arg=x-110818 F874A0 20 10 4A jsr fpdiv ; w=(x-1)/(x+1)10819 F874A3 20 93 84 jsr mvf_t1 ; tfr1=w10820 F874A6 A9 81 lda #<cpio410821 F874A8 A0 77 ldy #>cpio410822 F874AA 20 82 86 jsr ldfac ; pi/410823 F874AD 20 C0 84 jsr mvf_t2 ; tfr2=y=pi/410824 F874B0 80 14 bra ?do10825 F874B2 20 FD 49 ?gt38: jsr frecip10826 F874B5 A9 FF lda #$FF10827 F874B7 85 24 sta facsgn ; w=-1/x10828 F874B9 20 93 84 jsr mvf_t1 ; tfr1=w=-1/x10829 F874BC A9 93 lda #<cpio210830 F874BE A0 77 ldy #>cpio210831 F874C0 20 82 86 jsr ldfac ; pi/210832 F874C3 20 C0 84 jsr mvf_t2 ; tfr2=y=pi/210833 F874C6 20 74 85 ?do: jsr mvt1_f ; fac=w10834 F874C9 20 CC 49 jsr fsquare ; z=w*w10835 F874CC 20 66 84 jsr mvf_t0 ; tfr0=z10836 F874CF A9 1B lda #<catp10837 F874D1 A0 7A ldy #>catp10838 F874D3 A2 08 ldx #810839 F874D5 20 1C 87 jsr peval ; P(z)10840 F874D8 20 ED 84 jsr mvf_t3 ; tfr3=P(z)10841 F874DB A9 BD lda #<catqTue Jul 17 11:00:18 2018 Page 14910842 F874DD A0 7A ldy #>catq10843 F874DF A2 07 ldx #710844 F874E1 20 3A 87 jsr pevalp1 ; Q(z)10845 F874E4 20 55 86 jsr mvt3_a ; arg=P(z)10846 F874E7 20 10 4A jsr fpdiv ; R(z)=P(z)/Q(z)10847 F874EA 20 CE 85 jsr mvt0_a ; arg=z10848 F874ED 20 DD 49 jsr fpmult ; z*R(z)10849 F874F0 20 FB 85 jsr mvt1_a ; arg=w10850 F874F3 20 DD 49 jsr fpmult ; z*w*R(z)10851 F874F6 20 FB 85 jsr mvt1_a ; arg=w10852 F874F9 20 7D 45 jsr fpadd ; w+z*w*R(z)10853 F874FC 20 28 86 jsr mvt2_a ; arg=y10854 F874FF 20 7D 45 jsr fpadd ; y+w+z*w*R(z)10855 F87502 24 CF bit fpcsgn10856 F87504 10 06 bpl ?end10857 F87506 A5 24 lda facsgn10858 F87508 49 FF eor #$FF10859 F8750A 85 24 sta facsgn10860 F8750C 18 ?end: clc10861 F8750D 60 rts1086210863 ; fatanyx - inverse circular tangent, returns radian angle10864 ; between 0 and 2*pi whose tangent is y/x (computes the phase angle)10865 ;10866 ; entry:10867 ; fac = x10868 ; arg = y10869 ;10870 ; exit:10871 ; fac = z = atan(y/x) in domain [0, 2pi]10872 ; CF = 1 if returns nan10873 ;10874 ; computation mean time: 100ms at 4MHz10875 ;10876 ;-------10877 F8750E fatanyx:10878 ;-------10879 F8750E A2 00 ldx #010880 F87510 24 24 bit facsgn10881 F87512 10 02 bpl ?xp ; x >= 010882 F87514 A2 02 ldx #210883 F87516 24 3C ?xp: bit argsgn10884 F87518 10 01 bpl ?yp ; y >= 010885 F8751A E8 inx10886 F8751B 86 10 ?yp: stx atncode10887 F8751D A5 25 lda facst10888 F8751F 29 C0 and #$C010889 F87521 C9 80 cmp #$8010890 F87523 F0 10 beq ?nan ; if x=nan return nan10891 F87525 AA tax10892 F87526 A5 3D lda argst10893 F87528 29 C0 and #$C010894 F8752A C9 80 cmp #$8010895 F8752C F0 07 beq ?nan ; if y=nan return nan10896 F8752E A8 tay10897 F8752F 25 25 and facst10898 F87531 C9 C0 cmp #$C0 ; if x=inf and y=inf return nanTue Jul 17 11:00:18 2018 Page 15010899 F87533 D0 03 bne ?x010900 F87535 4C 74 4E ?nan: jmp fldnan10901 F87538 E0 40 ?x0: cpx #$4010902 F8753A D0 25 bne ?xx ; x != 010903 F8753C C0 40 cpy #$40 ; y = 0?10904 F8753E F0 1E beq ?zz ; yes, return zero (x = 0, y = 0)10905 F87540 A9 93 ?pi2: lda #<cpio210906 F87542 A0 77 ldy #>cpio210907 F87544 20 82 86 jsr ldfac ; z = pi/210908 F87547 46 10 lsr atncode10909 F87549 90 31 bcc ?ret ; return z = pi/210910 F8754B 20 A6 4E jsr ldaone10911 F8754E ACC1610912 F8754E C2 20 rep #PMFLAG10913 .LONGA on10914 .MNLIST10915 F87550 E6 3A inc argexp10916 F87552 A9 00 C0 lda #$C00010917 F87555 85 38 sta argm+14 ; arg = 310918 F87557 ACC0810919 F87557 E2 20 sep #PMFLAG10920 .LONGA off10921 .MNLIST10922 F87559 64 3C stz argsgn10923 F8755B 4C DD 49 jmp fpmult ; return z = 3*pi/210924 F8755E 4C 56 4E ?zz: jmp fldz ; z = 010925 F87561 C0 40 ?xx: cpy #$4010926 F87563 D0 19 bne ?yy ; y != 010927 F87565 A5 10 ?pi: lda atncode10928 F87567 F0 F5 beq ?zz ; return z = 010929 F87569 A9 A5 lda #<cpi10930 F8756B A0 77 ldy #>cpi10931 F8756D 20 82 86 jsr ldfac ; z = pi10932 F87570 A9 02 lda #$0210933 F87572 24 10 bit atncode10934 F87574 D0 06 bne ?ret ; return z = pi10935 F87576 ACC1610936 F87576 C2 20 rep #PMFLAG10937 .LONGA on10938 .MNLIST10939 F87578 E6 22 inc facexp ; return z = 2*pi10940 F8757A ACC0810941 F8757A E2 20 sep #PMFLAG10942 .LONGA off10943 .MNLIST10944 F8757C 18 ?ret: clc10945 F8757D 60 rts10946 F8757E C0 C0 ?yy: cpy #$C010947 F87580 F0 BE beq ?pi2 ; if y = inf, x != 0, is like x = 010948 F87582 E0 C0 cpx #$C010949 F87584 F0 DF beq ?pi ; if x = inf, y != 0, is like y = 010950 F87586 20 10 4A jsr fpdiv ; w = y/x (both x and y finite and not null)10951 F87589 20 4C 74 jsr fatan ; z = atan(y/x)10952 F8758C A5 10 lda atncode10953 F8758E F0 EC beq ?ret ; return z = atan(y/x) (first quadrant)10954 F87590 20 39 84 jsr mvftoa ; arg = z10955 F87593 A9 A5 lda #<cpiTue Jul 17 11:00:18 2018 Page 15110956 F87595 A0 77 ldy #>cpi10957 F87597 20 82 86 jsr ldfac ; fac = pi10958 F8759A A5 10 lda atncode10959 F8759C C9 02 cmp #$0210960 F8759E F0 0A beq ?done ; 2nd quadrant: add pi (atan < 0)10961 F875A0 C9 03 cmp #$0310962 F875A2 F0 06 beq ?done ; 3th quadrant: add pi (atan > 0)10963 F875A4 ACC1610964 F875A4 C2 20 rep #PMFLAG10965 .LONGA on10966 .MNLIST10967 F875A6 E6 22 inc facexp ; 4th quadrant: add 2*pi (atan < 0)10968 F875A8 ACC0810969 F875A8 E2 20 sep #PMFLAG10970 .LONGA off10971 .MNLIST10972 F875AA 4C 7D 45 ?done: jmp fpadd10973 F875AD1097410975 ; sin(x) coefficients10976 F875AD psin:10977 ; PSIN[11] = 6.410290407010279602425714995528976754871E-2610978 F875AD 35 40 EA 6E 20 .DB $35,$40,$EA,$6E,$20,$61,$06,$26,$A161 06 26 A110979 F875B6 83 C3 68 DB 0A .DB $83,$C3,$68,$DB,$0A,$B6,$9E,$AB,$3FB6 9E AB 3F1098010981 ; PSIN[10] = -3.868105354403065333804959405965295962871E-2310982 F875BF D1 C3 E7 80 C9 .DB $D1,$C3,$E7,$80,$C9,$32,$07,$3B,$A432 07 3B A410983 F875C8 87 F3 85 2F D3 .DB $87,$F3,$85,$2F,$D3,$0C,$BB,$B4,$BF0C BB B4 BF1098410985 ; PSIN[09] = 1.957294039628045847156851410307133941611E-2010986 F875D1 44 DE C1 98 E0 .DB $44,$DE,$C1,$98,$E0,$53,$C7,$8F,$BC53 C7 8F BC10987 F875DA E5 70 32 4D 77 .DB $E5,$70,$32,$4D,$77,$DC,$B8,$BD,$3FDC B8 BD 3F1098810989 ; PSIN[08] = -8.220635246181818130416407184286068307901E-1810990 F875E3 88 ED DD EC 5C .DB $88,$ED,$DD,$EC,$5C,$DF,$55,$07,$A1DF 55 07 A110991 F875EC 85 FB E6 33 DA .DB $85,$FB,$E6,$33,$DA,$A4,$97,$C6,$BFA4 97 C6 BF1099210993 ; PSIN[07] = 2.811457254345322887443598804951004537784E-1510994 F875F5 22 B2 7C 77 2A .DB $22,$B2,$7C,$77,$2A,$20,$77,$86,$F320 77 86 F310995 F875FE A5 5A 85 81 3B .DB $A5,$5A,$85,$81,$3B,$96,$CA,$CE,$3F96 CA CE 3F1099610997 ; PSIN[06] = -7.647163731819815869711749952353081768709E-1310998 F87607 72 92 40 E9 65 .DB $72,$92,$40,$E9,$65,$9C,$A5,$43,$C19C A5 43 C110999 F87610 F3 C0 9D 39 9F .DB $F3,$C0,$9D,$39,$9F,$3F,$D7,$D6,$BF3F D7 D6 BF11000Tue Jul 17 11:00:18 2018 Page 15211001 ; PSIN[05] = 1.605904383682161459812515654720205050216E-1011002 F87619 80 06 BE F2 47 .DB $80,$06,$BE,$F2,$47,$B3,$13,$1B,$E4B3 13 1B E411003 F87622 4B 68 43 9D 30 .DB $4B,$68,$43,$9D,$30,$92,$B0,$DE,$3F92 B0 DE 3F1100411005 ; PSIN[04] = -2.505210838544171877505034150892770940116E-811006 F8762B EC 90 66 4A 76 .DB $EC,$90,$66,$4A,$76,$79,$F7,$39,$7F79 F7 39 7F11007 F87634 1C 27 AA 3F 2B .DB $1C,$27,$AA,$3F,$2B,$32,$D7,$E5,$BF32 D7 E5 BF1100811009 ; PSIN[03] = 2.755731922398589065255731765498970284004E-611010 F8763D 84 F7 94 D2 B7 .DB $84,$F7,$94,$D2,$B7,$37,$0E,$56,$7D37 0E 56 7D11011 F87646 9C 39 B6 2A 1D .DB $9C,$39,$B6,$2A,$1D,$EF,$B8,$EC,$3FEF B8 EC 3F1101211013 ; PSIN[02] = -1.984126984126984126984126984045294307281E-411014 F8764F 7D F8 65 29 FE .DB $7D,$F8,$65,$29,$FE,$0C,$D0,$00,$0D0C D0 00 0D11015 F87658 D0 00 0D D0 00 .DB $D0,$00,$0D,$D0,$00,$0D,$D0,$F2,$BF0D D0 F2 BF1101611017 ; PSIN[01] = 8.333333333333333333333333333333119885283E-311018 F87661 62 9A 41 88 88 .DB $62,$9A,$41,$88,$88,$88,$88,$88,$8888 88 88 8811019 F8766A 88 88 88 88 88 .DB $88,$88,$88,$88,$88,$88,$88,$F8,$3F88 88 F8 3F1102011021 ; PSIN[00] = -1.666666666666666666666666666666666647199E-111022 F87673 51 A0 AA AA AA .DB $51,$A0,$AA,$AA,$AA,$AA,$AA,$AA,$AAAA AA AA AA11023 F8767C AA AA AA AA AA .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FC,$BFAA AA FC BF1102411025 ; cos(x) coefficients11026 F87685 pcos:11027 ; PCOS[10] = 1.601961934248327059668321782499768648351E-2411028 F87685 6F 42 59 D2 8A .DB $6F,$42,$59,$D2,$8A,$EF,$37,$CD,$48EF 37 CD 4811029 F8768E C3 50 58 0F 40 .DB $C3,$50,$58,$0F,$40,$E4,$F7,$AF,$3FE4 F7 AF 3F1103011031 ; PCOS[09] = -8.896621117922334603659240022184527001401E-2211032 F87697 EF E7 87 4A 0E .DB $EF,$E7,$87,$4A,$0E,$94,$D9,$B3,$1194 D9 B3 1111033 F876A0 C8 08 07 CC 22 .DB $C8,$08,$07,$CC,$22,$71,$86,$B9,$BF71 86 B9 BF1103411035 ; PCOS[08] = 4.110317451243694098169570731967589555498E-1911036 F876A9 94 20 CD 9C D6 .DB $94,$20,$CD,$9C,$D6,$21,$68,$81,$A821 68 81 A811037 F876B2 E7 86 A7 75 5C .DB $E7,$86,$A7,$75,$5C,$A1,$F2,$C1,$3FA1 F2 C1 3F1103811039 ; PCOS[07] = -1.561920696747074515985647487260202922160E-16Tue Jul 17 11:00:18 2018 Page 15311040 F876BB 4C 88 FF 5A 9D .DB $4C,$88,$FF,$5A,$9D,$63,$B8,$94,$1363 B8 94 1311041 F876C4 54 B0 94 1D C3 .DB $54,$B0,$94,$1D,$C3,$13,$B4,$CA,$BF13 B4 CA BF1104211043 ; PCOS[06] = 4.779477332386900932514186378501779328195E-1411044 F876CD 2B 3C A9 FD E8 .DB $2B,$3C,$A9,$FD,$E8,$BA,$6D,$B7,$80BA 6D B7 8011045 F876D6 FC A8 9D 39 9F .DB $FC,$A8,$9D,$39,$9F,$3F,$D7,$D2,$3F3F D7 D2 3F1104611047 ; PCOS[05] = -1.147074559772972328629102981460088437917E-1111048 F876DF C1 7C 8A 0F 0E .DB $C1,$7C,$8A,$0F,$0E,$46,$0C,$31,$F446 0C 31 F411049 F876E8 E1 E4 03 46 A5 .DB $E1,$E4,$03,$46,$A5,$CB,$C9,$DA,$BFCB C9 DA BF1105011051 ; PCOS[04] = 2.087675698786809897637922200570559726116E-911052 F876F1 93 84 CC C1 FA .DB $93,$84,$CC,$C1,$FA,$D5,$F9,$BF,$A8D5 F9 BF A811053 F876FA BD C4 C6 7F C7 .DB $BD,$C4,$C6,$7F,$C7,$76,$8F,$E2,$3F76 8F E2 3F1105411055 ; PCOS[03] = -2.755731922398589065255365968070684102298E-711056 F87703 0E 2B 2E FA 29 .DB $0E,$2B,$2E,$FA,$29,$A2,$AE,$77,$97A2 AE 77 9711057 F8770C E3 FA C4 BB 7D .DB $E3,$FA,$C4,$BB,$7D,$F2,$93,$E9,$BFF2 93 E9 BF1105811059 ; PCOS[02] = 2.480158730158730158730158440896461945271E-511060 F87715 69 8F 86 22 AB .DB $69,$8F,$86,$22,$AB,$EF,$CF,$00,$0DEF CF 00 0D11061 F8771E D0 00 0D D0 00 .DB $D0,$00,$0D,$D0,$00,$0D,$D0,$EF,$3F0D D0 EF 3F1106211063 ; PCOS[01] = -1.388888888888888888888888888765724370132E-311064 F87727 C8 EC 07 B7 5B .DB $C8,$EC,$07,$B7,$5B,$0B,$B6,$60,$0B0B B6 60 0B11065 F87730 B6 60 0B B6 60 .DB $B6,$60,$0B,$B6,$60,$0B,$B6,$F5,$BF0B B6 F5 BF1106611067 ; PCOS[00] = 4.166666666666666666666666666666459301466E-211068 F87739 F7 64 FE A9 AA .DB $F7,$64,$FE,$A9,$AA,$AA,$AA,$AA,$AAAA AA AA AA11069 F87742 AA AA AA AA AA .DB $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FA,$3FAA AA FA 3F1107011071 ; DP1 + DP2 + DP3 = PI/411072 ; DP1 = 7.853981633974483067550664827649598009884357452392578125E-111073 F8774B 00 00 00 00 00 cdp1: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0011074 F87754 C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$FE,$3F0F C9 FE 3F1107511076 ; DP2 = 2.8605943630549158983813312792950660807511260829685741796657E-1811077 F8775D 00 00 00 00 00 cdp2: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 00Tue Jul 17 11:00:18 2018 Page 15411078 F87766 70 03 2E 8A 19 .DB $70,$03,$2E,$8A,$19,$13,$D3,$C4,$3F13 D3 C4 3F1107911080 ; DP3 = 2.1679525325309452561992610065108379921905808E-3511081 F8776F 00 00 32 F5 5D cdp3: .DB $00,$00,$32,$F5,$5D,$10,$A0,$63,$3E10 A0 63 3E11082 F87778 53 44 70 12 48 .DB $53,$44,$70,$12,$48,$89,$E6,$8B,$3F89 E6 8B 3F1108311084 ; PI/4 = 0.785398163397448309615660845819875721049292311085 F87781 D1 1C DC 80 8B cpio4: .DB $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$3462 C6 C4 3411086 F8778A C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$FE,$3F0F C9 FE 3F1108711088 ; PI/211089 F87793 D1 1C DC 80 8B cpio2: .DB $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$3462 C6 C4 3411090 F8779C C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$FF,$3F0F C9 FF 3F1109111092 ; PI11093 F877A5 D1 1C DC 80 8B cpi: .DB $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$3462 C6 C4 3411094 F877AE C2 68 21 A2 DA .DB $C2,$68,$21,$A2,$DA,$0F,$C9,$00,$400F C9 00 401109511096 ; tan(3*pi/8) = sqrt(2)+111097 F877B7 4F 5F A5 BA D9 ct3p8: .DB $4F,$5F,$A5,$BA,$D9,$C4,$BE,$2C,$42C4 BE 2C 4211098 F877C0 32 EF FC 99 79 .DB $32,$EF,$FC,$99,$79,$82,$9A,$00,$4082 9A 00 4011099 F877C911100 ; tan(pi/8) = sqrt(2)-111101 F877C9 7C FA 2A D5 CD ctp8: .DB $7C,$FA,$2A,$D5,$CD,$26,$F6,$65,$1126 F6 65 1111102 F877D2 92 79 E7 CF CC .DB $92,$79,$E7,$CF,$CC,$13,$D4,$FD,$3F13 D4 FD 3F111031110411105 ; tan(x) coefficients11106 F877DB ptan:11107 ; TP[5] = -9.889929415807650724957118893791829849557E-111108 F877DB 58 BB A5 17 15 .DB $58,$BB,$A5,$17,$15,$D7,$E3,$C6,$CBD7 E3 C6 CB11109 F877E4 04 71 10 34 A4 .DB $04,$71,$10,$34,$A4,$2E,$FD,$FE,$BF2E FD FE BF1111011111 ; TP[4] = 1.272297782199996882828849455156962260810E311112 F877ED D1 56 CC 23 3E .DB $D1,$56,$CC,$23,$3E,$E5,$D8,$0B,$50E5 D8 0B 5011113 F877F6 29 4A 89 6E 87 .DB $29,$4A,$89,$6E,$87,$09,$9F,$09,$4009 9F 09 401111411115 ; TP[3] = -4.249691853501233575668486667664718192660E511116 F877FF 94 A5 29 9E C5 .DB $94,$A5,$29,$9E,$C5,$9C,$0D,$8B,$2B9C 0D 8B 2BTue Jul 17 11:00:18 2018 Page 15511117 F87808 C4 61 63 EE 25 .DB $C4,$61,$63,$EE,$25,$81,$CF,$11,$C081 CF 11 C01111811119 ; TP[2] = 5.160188250214037865511600561074819366815E711120 F87811 B4 52 C1 B5 30 .DB $B4,$52,$C1,$B5,$30,$D3,$30,$C9,$14D3 30 C9 1411121 F8781A 66 11 23 A0 76 .DB $66,$11,$23,$A0,$76,$D8,$C4,$18,$40D8 C4 18 401112211123 ; TP[1] = -2.307030822693734879744223131873392503321E911124 F87823 55 27 82 DF 66 .DB $55,$27,$82,$DF,$66,$F2,$8E,$98,$ECF2 8E 98 EC11125 F8782C 9B 98 B1 26 7F .DB $9B,$98,$B1,$26,$7F,$82,$89,$1E,$C082 89 1E C01112611127 ; TP[0] = 2.883414728874239697964612246732416606301E1011128 F87835 16 C6 4C C5 B1 .DB $16,$C6,$4C,$C5,$B1,$35,$56,$87,$4F35 56 87 4F11129 F8783E B7 C1 17 7B C5 .DB $B7,$C1,$17,$7B,$C5,$D4,$D6,$21,$40D4 D6 21 401113011131 F87847 qtan:11132 ; TQ[5] = -1.317243702830553658702531997959756728291E311133 F87847 FA D3 81 DD E9 .DB $FA,$D3,$81,$DD,$E9,$7B,$94,$EB,$807B 94 EB 8011134 F87850 75 E5 E0 69 CC .DB $75,$E5,$E0,$69,$CC,$A7,$A4,$09,$C0A7 A4 09 C01113511136 ; TQ[4] = 4.529422062441341616231663543669583527923E511137 F87859 E6 99 66 53 23 .DB $E6,$99,$66,$53,$23,$56,$5A,$89,$E956 5A 89 E911138 F87862 66 4C 8D 99 C6 .DB $66,$4C,$8D,$99,$C6,$29,$DD,$11,$4029 DD 11 401113911140 ; TQ[3] = -5.733709132766856723608447733926138506824E711141 F8786B 69 45 D0 B9 5E .DB $69,$45,$D0,$B9,$5E,$77,$B9,$31,$0D77 B9 31 0D11142 F87874 95 85 F8 D4 40 .DB $95,$85,$F8,$D4,$40,$B9,$DA,$18,$C0B9 DA 18 C01114311144 ; TQ[2] = 2.758476078803232151774723646710890525496E911145 F8787D 25 48 F2 7D A4 .DB $25,$48,$F2,$7D,$A4,$71,$D8,$F7,$4E71 D8 F7 4E11146 F87886 9F A0 CD 2E 01 .DB $9F,$A0,$CD,$2E,$01,$6B,$A4,$1E,$406B A4 1E 401114711148 ; TQ[1] = -4.152206921457208101480801635640958361612E1011149 F8788F 45 68 68 C0 AA .DB $45,$68,$68,$C0,$AA,$ED,$34,$14,$6CED 34 14 6C11150 F87898 3E 27 E9 ED 87 .DB $3E,$27,$E9,$ED,$87,$AE,$9A,$22,$C0AE 9A 22 C01115111152 ; TQ[0] = 8.650244186622719093893836740197250197602E1011153 F878A1 30 B9 F9 53 45 .DB $30,$B9,$F9,$53,$45,$A8,$80,$A5,$7BA8 80 A5 7B11154 F878AA 49 D1 51 1C 94 .DB $49,$D1,$51,$1C,$94,$1F,$A1,$23,$401F A1 23 40Tue Jul 17 11:00:18 2018 Page 1561115511156 ; asin(x) coefficients11157 F878B3 casp:11158 ; ASP[9] = -8.067112765482705313585175280952515549833E-111159 F878B3 73 27 C0 8D 2C .DB $73,$27,$C0,$8D,$2C,$37,$96,$A8,$0437 96 A8 0411160 F878BC 05 D8 16 56 A1 .DB $05,$D8,$16,$56,$A1,$84,$CE,$FE,$BF84 CE FE BF1116111162 ; ASP[8] = 4.845649797786849136525020822000172350977E111163 F878C5 10 4E 72 84 A0 .DB $10,$4E,$72,$84,$A0,$F4,$1C,$1D,$A9F4 1C 1D A911164 F878CE 8C 8A B6 34 74 .DB $8C,$8A,$B6,$34,$74,$D3,$C1,$04,$40D3 C1 04 401116511166 ; ASP[7] = -8.510195404865297879959793548843395926847E211167 F878D7 EB 4D 4D 8F C3 .DB $EB,$4D,$4D,$8F,$C3,$B1,$24,$A9,$BDB1 24 A9 BD11168 F878E0 F9 A5 BD 26 40 .DB $F9,$A5,$BD,$26,$40,$C1,$D4,$08,$C0C1 D4 08 C01116911170 ; ASP[6] = 6.815196841370292688574521445731895826485E311171 F878E9 AA 5E 2D 43 AA .DB $AA,$5E,$2D,$43,$AA,$66,$ED,$0A,$6166 ED 0A 6111172 F878F2 41 7F 91 21 93 .DB $41,$7F,$91,$21,$93,$F9,$D4,$0B,$40F9 D4 0B 401117311174 ; ASP[5] = -2.967135182120339728996157454994675519735E411175 F878FB F2 CA 89 AC E2 .DB $F2,$CA,$89,$AC,$E2,$B3,$AC,$51,$EEB3 AC 51 EE11176 F87904 42 A5 E8 21 B4 .DB $42,$A5,$E8,$21,$B4,$CE,$E7,$0D,$C0CE E7 0D C01117711178 ; ASP[4] = 7.612250656518818109652985996692466409670E411179 F8790D 4D 89 09 49 F6 .DB $4D,$89,$09,$49,$F6,$5B,$21,$9C,$D35B 21 9C D311180 F87916 43 CA 20 D7 40 .DB $43,$CA,$20,$D7,$40,$AD,$94,$0F,$40AD 94 0F 401118111182 ; ASP[3] = -1.183360579752620455689557157684221905030E511183 F8791F C8 84 21 34 4B .DB $C8,$84,$21,$34,$4B,$51,$AB,$59,$3B51 AB 59 3B11184 F87928 3B BF BB 6B 07 .DB $3B,$BF,$BB,$6B,$07,$20,$E7,$0F,$C020 E7 0F C01118511186 ; ASP[2] = 1.095432262510413338755837156377401348063E511187 F87931 5C D5 0E A4 53 .DB $5C,$D5,$0E,$A4,$53,$03,$23,$26,$8303 23 26 8311188 F8793A 9B 4B CB F5 9C .DB $9B,$4B,$CB,$F5,$9C,$F3,$D5,$0F,$40F3 D5 0F 401118911190 ; ASP[1] = -5.554124580991113991999636773382495788705E411191 F87943 A8 77 07 20 6B .DB $A8,$77,$07,$20,$6B,$5E,$DE,$66,$ED5E DE 66 ED11192 F8794C 60 F9 65 ED 3E .DB $60,$F9,$65,$ED,$3E,$F5,$D8,$0E,$C0F5 D8 0E C011193Tue Jul 17 11:00:18 2018 Page 15711194 ; ASP[0] = 1.187132626694762543537732514905488896985E411195 F87955 14 17 24 62 E1 .DB $14,$17,$24,$62,$E1,$9B,$9A,$F9,$989B 9A F9 9811196 F8795E 44 37 EC 18 4E .DB $44,$37,$EC,$18,$4E,$7D,$B9,$0C,$407D B9 0C 401119711198 F87967 casq:11199 ; ASQ[9] = -8.005471061732009595694099899234272342478E111200 F87967 AB CB 99 42 E0 .DB $AB,$CB,$99,$42,$E0,$53,$D9,$98,$3E53 D9 98 3E11201 F87970 7F 44 B0 07 03 .DB $7F,$44,$B0,$07,$03,$1C,$A0,$05,$C01C A0 05 C01120211203 ; ASQ[8] = 1.817324228942812880965069608562483918025E311204 F87979 74 B0 9D 55 FC .DB $74,$B0,$9D,$55,$FC,$EE,$98,$24,$09EE 98 24 0911205 F87982 89 39 60 15 60 .DB $89,$39,$60,$15,$60,$2A,$E3,$09,$402A E3 09 401120611207 ; ASQ[7] = -1.867017317425756524289537002141956583706E411208 F8798B CA 11 F0 E5 FC .DB $CA,$11,$F0,$E5,$FC,$8D,$72,$C6,$EB8D 72 C6 EB11209 F87994 80 D9 4B AA 58 .DB $80,$D9,$4B,$AA,$58,$DC,$91,$0D,$C0DC 91 0D C01121011211 ; ASQ[6] = 1.048196619402464497478959760337779705622E511212 F8799D EA F9 4B 5E 82 .DB $EA,$F9,$4B,$5E,$82,$00,$4C,$57,$3400 4C 57 3411213 F879A6 34 3F 75 BA D4 .DB $34,$3F,$75,$BA,$D4,$B9,$CC,$0F,$40B9 CC 0F 401121411215 ; ASQ[5] = -3.527040897897253459022458866536165564103E511216 F879AF 9E F0 E3 86 B9 .DB $9E,$F0,$E3,$86,$B9,$BB,$11,$41,$14BB 11 41 1411217 F879B8 BC B3 8E DF 02 .DB $BC,$B3,$8E,$DF,$02,$38,$AC,$11,$C038 AC 11 C01121811219 ; ASQ[4] = 7.426302422018858001691440351763370029242E511220 F879C1 72 C6 78 BF 89 .DB $72,$C6,$78,$BF,$89,$F9,$2E,$F9,$A8F9 2E F9 A811221 F879CA A8 15 0F E0 63 .DB $A8,$15,$0F,$E0,$63,$4E,$B5,$12,$404E B5 12 401122211223 ; ASQ[3] = -9.863068411558756277454631976667880674474E511224 F879D3 FF 38 2A 9B 42 .DB $FF,$38,$2A,$9B,$42,$07,$BF,$F1,$8C07 BF F1 8C11225 F879DC 0A DD 5F 75 2D .DB $0A,$DD,$5F,$75,$2D,$CC,$F0,$12,$C0CC F0 12 C01122611227 ; ASQ[2] = 8.025654653926121907774766642393757364326E511228 F879E5 C1 3C 5A DF 8E .DB $C1,$3C,$5A,$DF,$8E,$AF,$32,$E7,$8CAF 32 E7 8C11229 F879EE 12 86 3F 72 57 .DB $12,$86,$3F,$72,$57,$F0,$C3,$12,$40F0 C3 12 401123011231 ; ASQ[1] = -3.653000557802254281954969843055623398839E511232 F879F7 CA 1B 43 FC 90 .DB $CA,$1B,$43,$FC,$90,$05,$03,$8F,$48Tue Jul 17 11:00:18 2018 Page 15805 03 8F 4811233 F87A00 7F 9C F3 C8 81 .DB $7F,$9C,$F3,$C8,$81,$5E,$B2,$11,$C05E B2 11 C01123411235 ; ASQ[0] = 7.122795760168575261226395089432959614179E411236 F87A09 93 75 A5 09 E9 .DB $93,$75,$A5,$09,$E9,$F4,$33,$BB,$72F4 33 BB 7211237 F87A12 73 29 B1 92 FA .DB $73,$29,$B1,$92,$FA,$1D,$8B,$0F,$401D 8B 0F 401123811239 ; atan(x) coefficients11240 F87A1B catp:11241 ; ATP[08] = -6.635810778635296712545011270011752799963E-411242 F87A1B F1 6B 5F 23 D7 .DB $F1,$6B,$5F,$23,$D7,$8E,$2D,$08,$F88E 2D 08 F811243 F87A24 79 13 55 1C 2C .DB $79,$13,$55,$1C,$2C,$F4,$AD,$F4,$BFF4 AD F4 BF1124411245 ; ATP[07] = -8.768423468036849091777415076702113400070E-111246 F87A2D 0C 62 A5 C3 8A .DB $0C,$62,$A5,$C3,$8A,$2F,$F9,$15,$4D2F F9 15 4D11247 F87A36 29 0C 45 73 BD .DB $29,$0C,$45,$73,$BD,$78,$E0,$FE,$BF78 E0 FE BF1124811249 ; ATP[06] = -2.548067867495502632615671450650071218995E111250 F87A3F EA FC 2D 13 27 .DB $EA,$FC,$2D,$13,$27,$8A,$73,$51,$2A8A 73 51 2A11251 F87A48 18 88 A6 0F 6E .DB $18,$88,$A6,$0F,$6E,$D8,$CB,$03,$C0D8 CB 03 C01125211253 ; ATP[05] = -2.497759878476618348858065206895055957104E211254 F87A51 F8 A0 32 CF E6 .DB $F8,$A0,$32,$CF,$E6,$62,$5C,$EB,$0C62 5C EB 0C11255 F87A5A 0F CD BB 23 A7 .DB $0F,$CD,$BB,$23,$A7,$C6,$F9,$06,$C0C6 F9 06 C01125611257 ; ATP[04] = -1.148164399808514330375280133523543970854E311258 F87A63 F0 5F EE 9D 20 .DB $F0,$5F,$EE,$9D,$20,$0D,$F2,$58,$EE0D F2 58 EE11259 F87A6C 34 21 63 C3 42 .DB $34,$21,$63,$C3,$42,$85,$8F,$09,$C085 8F 09 C01126011261 ; ATP[03] = -2.792272753241044941703278827346430350236E311262 F87A75 9A CD A1 B3 A8 .DB $9A,$CD,$A1,$B3,$A8,$AB,$A8,$87,$0EAB A8 87 0E11263 F87A7E A8 A2 80 32 5D .DB $A8,$A2,$80,$32,$5D,$84,$AE,$0A,$C084 AE 0A C01126411265 ; ATP[02] = -3.696264445691821235400930243493001671932E311266 F87A87 76 73 C3 5C DA .DB $76,$73,$C3,$5C,$DA,$FA,$F9,$C5,$78FA F9 C5 7811267 F87A90 0B DF 67 2B 3B .DB $0B,$DF,$67,$2B,$3B,$04,$E7,$0A,$C004 E7 0A C01126811269 ; ATP[01] = -2.514829758941713674909996882101723647996E311270 F87A99 FF 23 4B CB 5F .DB $FF,$23,$4B,$CB,$5F,$46,$30,$6F,$B346 30 6F B3Tue Jul 17 11:00:18 2018 Page 15911271 F87AA2 94 E3 4F B1 46 .DB $94,$E3,$4F,$B1,$46,$2D,$9D,$0A,$C02D 9D 0A C01127211273 ; ATP[00] = -6.880597774405940432145577545328795037141E211274 F87AAB 02 27 91 66 97 .DB $02,$27,$91,$66,$97,$AB,$B4,$ED,$BBAB B4 ED BB11275 F87AB4 F5 18 C2 64 D3 .DB $F5,$18,$C2,$64,$D3,$03,$AC,$08,$C003 AC 08 C01127611277 F87ABD catq:11278 ; ATQ[07] = 3.566239794444800849656497338030115886153E111279 F87ABD C0 AA A1 BA 09 .DB $C0,$AA,$A1,$BA,$09,$B0,$53,$CA,$64B0 53 CA 6411280 F87AC6 06 5E 91 A5 4B .DB $06,$5E,$91,$A5,$4B,$A6,$8E,$04,$40A6 8E 04 401128111282 ; ATQ[06] = 4.308348370818927353321556740027020068897E211283 F87ACF F3 26 2F 03 B5 .DB $F3,$26,$2F,$03,$B5,$85,$60,$C3,$D885 60 C3 D811284 F87AD8 D2 1B 06 F1 DB .DB $D2,$1B,$06,$F1,$DB,$6A,$D7,$07,$406A D7 07 401128511286 ; ATQ[05] = 2.494680540950601626662048893678584497900E311287 F87AE1 37 5A 94 B0 14 .DB $37,$5A,$94,$B0,$14,$01,$F9,$F5,$8801 F9 F5 8811288 F87AEA C3 66 E8 7E E3 .DB $C3,$66,$E8,$7E,$E3,$EA,$9B,$0A,$40EA 9B 0A 401128911290 ; ATQ[04] = 7.928572347062145288093560392463784743935E311291 F87AF3 E8 83 10 77 27 .DB $E8,$83,$10,$77,$27,$F7,$9C,$C9,$6AF7 9C C9 6A11292 F87AFC 01 4F B2 2A 94 .DB $01,$4F,$B2,$2A,$94,$C4,$F7,$0B,$40C4 F7 0B 401129311294 ; ATQ[03] = 1.458510242529987155225086911411015961174E411295 F87B05 F4 89 D9 F7 87 .DB $F4,$89,$D9,$F7,$87,$4A,$D8,$81,$DC4A D8 81 DC11296 F87B0E EC 84 2D E2 68 .DB $EC,$84,$2D,$E2,$68,$E4,$E3,$0C,$40E4 E3 0C 401129711298 ; ATQ[02] = 1.547394317752562611786521896296215170819E411299 F87B17 D6 33 A9 9B 41 .DB $D6,$33,$A9,$9B,$41,$D7,$06,$B7,$A6D7 06 B7 A611300 F87B20 8B 4B 54 D0 C5 .DB $8B,$4B,$54,$D0,$C5,$C7,$F1,$0C,$40C7 F1 0C 401130111302 ; ATQ[01] = 8.782996876218210302516194604424986107121E311303 F87B29 F6 15 46 E3 7B .DB $F6,$15,$46,$E3,$7B,$EE,$EE,$EA,$5EEE EE EA 5E11304 F87B32 7E 8D 1E CD FC .DB $7E,$8D,$1E,$CD,$FC,$3B,$89,$0C,$403B 89 0C 401130511306 ; ATQ[00] = 2.064179332321782129643673263598686441900E311307 F87B3B AD 9F 29 8D B1 .DB $AD,$9F,$29,$8D,$B1,$80,$47,$F2,$4C80 47 F2 4C11308 F87B44 B8 92 91 8B DE .DB $B8,$92,$91,$8B,$DE,$02,$81,$0A,$4002 81 0A 40Tue Jul 17 11:00:18 2018 Page 1601130911310 ;---------------------------------------------------------------------------11311 ; hyperbolics functions & inverse hyperbolics functions11312 ;---------------------------------------------------------------------------1131311314 ; fsinh - returns the hyperbolic sin of the argument11315 ;11316 ; entry:11317 ; fac = x (argument)11318 ;11319 ; exit:11320 ; fac = sinh(x)11321 ; CF = 1 if invalid result(inf or nan)11322 ;11323 ; strategy x -x11324 ; e - e11325 ; Mathematically sinh(x) = -----------11326 ; 211327 ;11328 ; 1) if |x| <=1 sinh(x) is approximated by a rational function:11329 ;11330 ; 3 P(z) 211331 ; sinh(x) = x + x * R(z), R(z) = ------, z = x11332 ; Q(z)11333 ;11334 ; E |x|11335 ; 2) |x| > 1: sinh(x) = sgn(x)*0.5*(E + -----), E = e - 1 = expm1(|x|)11336 ; E+111337 ;11338 ; computation mean time: 65/100ms at 4MHz11339 ;11340 ; Note: overflow if |x| >= 11356.2511341 ;11342 ;-----11343 F87B4D fsinh:11344 ;-----11345 F87B4D 38 sec11346 F87B4E 24 25 bit facst11347 F87B50 30 03 bmi ?rts ; fac=inf or inf11348 F87B52 50 02 bvc ?nz ; if fac=0 returns zero11349 F87B54 18 clc11350 F87B55 60 ?rts: rts11351 F87B56 20 24 74 ?nz: jsr cmpx1 ; compare |x| vs. 1.011352 F87B59 F0 2E beq rsinh ; |x|=111353 F87B5B 90 2C bcc rsinh ; |x|<111354 F87B5D A5 24 lda facsgn ; sinh(-x)=-sinh(x)11355 F87B5F 85 CF sta fpcsgn ; save sign11356 F87B61 64 24 stz facsgn ; |x|11357 F87B63 20 BD 69 jsr fexpm1 ; E=exp(|x|)-111358 F87B66 B0 1C bcs ?done ; overflow11359 F87B68 20 66 84 jsr mvf_t011360 F87B6B 20 6C 45 jsr faddone ; E+111361 F87B6E B0 14 bcs ?done ; overflow11362 F87B70 20 CE 85 jsr mvt0_a ; arg=E11363 F87B73 20 10 4A jsr fpdiv ; E/(E+1)11364 F87B76 20 CE 85 jsr mvt0_a ; arg=E11365 F87B79 20 7D 45 jsr fpadd ; E+E/(E+1)Tue Jul 17 11:00:18 2018 Page 16111366 F87B7C B0 06 bcs ?done ; overflow11367 F87B7E ACC16 ; for sure here fac is normal11368 F87B7E C2 20 rep #PMFLAG11369 .LONGA on11370 .MNLIST11371 F87B80 C6 22 dec facexp ; divide by 211372 F87B82 ACC0811373 F87B82 E2 20 sep #PMFLAG11374 .LONGA off11375 .MNLIST11376 F87B84 A5 CF ?done: lda fpcsgn11377 F87B86 85 24 sta facsgn ; set sign11378 F87B88 60 rts1137911380 ; returns sinh(x) when |x|<=1 (approximated by rational function)11381 F87B89 rsinh:11382 F87B89 20 93 84 jsr mvf_t1 ; tfr1=x11383 F87B8C 20 CC 49 jsr fsquare ; z=x*x11384 F87B8F 20 66 84 jsr mvf_t0 ; tfr0=z11385 F87B92 A9 6C lda #<cshp11386 F87B94 A0 7E ldy #>cshp11387 F87B96 A2 05 ldx #511388 F87B98 20 1C 87 jsr peval ; evaluates P(z)11389 F87B9B 20 C0 84 jsr mvf_t2 ; tfr2=P(z)11390 F87B9E A9 D8 lda #<cshq11391 F87BA0 A0 7E ldy #>cshq11392 F87BA2 A2 05 ldx #511393 F87BA4 20 3A 87 jsr pevalp1 ; evaluates Q(z)11394 F87BA7 20 28 86 jsr mvt2_a ; arg=P(z)11395 F87BAA 20 10 4A jsr fpdiv11396 F87BAD 20 CE 85 jsr mvt0_a ; arg=z11397 F87BB0 20 DD 49 jsr fpmult ; z*R(z)11398 F87BB3 20 FB 85 jsr mvt1_a ; arg=x11399 F87BB6 20 DD 49 jsr fpmult ; x*z*R(z)11400 F87BB9 20 FB 85 jsr mvt1_a ; arg=x11401 F87BBC 4C 7D 45 jmp fpadd ; returns sinh(x)=x + x*z*R(z)1140211403 ; fcosh - returns the hyperbolic cosin of the argument11404 ;11405 ; entry:11406 ; fac = x (argument)11407 ;11408 ; exit:11409 ; fac = cosh(x)11410 ; CF = 1 if invalid result(inf or nan)11411 ;11412 ; strategy x -x11413 ; e + e11414 ; Mathematically cosh(x) = -----------11415 ; 211416 ;11417 ; 1) if |x| <=1 cosh(x) is approximated by a rational function11418 ; that evaluates sinh(|x|):11419 ;11420 ; 3 P(z) 211421 ; sinh(x) = x + x * R(z), R(z) = ------, z = x11422 ; Q(z)Tue Jul 17 11:00:18 2018 Page 16211423 ; 211424 ; then: cosh(x) = sqrt(1 + sinh(x) )11425 ;11426 ; 0.5 |x|11427 ; 2) |x| > 1: cosh(x) = 0.5*E + -----, E = e = expm1(|x|) + 111428 ; E11429 ;11430 ; computation mean time: 100ms at 4MHz11431 ;11432 ; Note: overflow if |x| >= 11356.2511433 ;11434 ;-----11435 F87BBF fcosh:11436 ;-----11437 F87BBF 64 24 stz facsgn ; cosh(-x) = cosh(x)11438 F87BC1 38 sec11439 F87BC2 24 25 bit facst11440 F87BC4 30 05 bmi ?rts ; fac=inf or nan11441 F87BC6 50 04 bvc ?nz ; if fac=0 returns 111442 F87BC8 4C 2E 4E jmp fldp111443 F87BCB 60 ?rts: rts11444 F87BCC 20 24 74 ?nz: jsr cmpx1 ; compare |x| vs. 1.011445 F87BCF F0 02 beq ?le1 ; |x|=111446 F87BD1 B0 0C bcs ?gt1 ; |x|>111447 F87BD3 20 89 7B ?le1: jsr rsinh ; sinh(|x|)11448 F87BD6 20 CC 49 jsr fsquare ; sinh(|x|)^211449 F87BD9 20 6C 45 jsr faddone ; 1+sinh(|x|)^211450 F87BDC 4C 53 60 jmp fsqrt ; cosh(x) = sqrt(1+sinh(|x|)^2)11451 F87BDF 20 BD 69 ?gt1: jsr fexpm1 ; E=expm1(|x|)11452 F87BE2 B0 E7 bcs ?rts ; overflow11453 F87BE4 20 6C 45 jsr faddone11454 F87BE7 B0 E2 bcs ?rts ; overflow11455 F87BE9 20 66 84 jsr mvf_t011456 F87BEC 20 9F 4E jsr ldahalf11457 F87BEF 20 10 4A jsr fpdiv ; 0.5/E11458 F87BF2 20 CE 85 jsr mvt0_a ; arg=E11459 F87BF5 ACC1611460 F87BF5 C2 20 rep #PMFLAG11461 .LONGA on11462 .MNLIST11463 F87BF7 C6 3A dec argexp ; E/211464 F87BF9 ACC0811465 F87BF9 E2 20 sep #PMFLAG11466 .LONGA off11467 .MNLIST11468 F87BFB 4C 7D 45 jmp fpadd1146911470 ; ftanh - returns the hyperbolic tangent of the argument11471 ;11472 ; entry:11473 ; fac = x (argument)11474 ;11475 ; exit:11476 ; fac = tanh(x)11477 ; CF = 1 if invalid result(inf or nan)11478 ;11479 ; strategy x -xTue Jul 17 11:00:18 2018 Page 16311480 ; e - e11481 ; Mathematically cosh(x) = -----------11482 ; x -x11483 ; e + e11484 ;11485 ; strategy11486 ;11487 ; 1) if |x| < 0.625 tanh(x) is approximated by a rational function:11488 ;11489 ; 3 P(z) 211490 ; tanh(x) = x + x * R(z), R(z) = ------, z = x11491 ; Q(z)11492 ;11493 ; 2 2|x|11494 ; 2) |x| > 0.625: tanh(x) = 1 - -------, E = e11495 ; E + 111496 ;11497 ; computation mean time: 60/100ms at 4MHz11498 ;11499 ; Note: if |x| >= 40 tanh(x) = +/-111500 ;11501 ;-----11502 F87BFE ftanh:11503 ;-----11504 F87BFE 24 25 bit facst11505 F87C00 10 07 bpl ?fv ; valid11506 F87C02 50 03 bvc ?er ; fac=nan so returns nan11507 F87C04 4C 36 4E jmp fld1 ; if fac =+/-inf returns +/-111508 F87C07 38 ?er: sec11509 F87C08 60 rts11510 F87C09 70 47 ?fv: bvs ?ok ; if fac=0 returns zero11511 F87C0B ACC16 ; compare |x| vs. 0.62511512 F87C0B C2 20 rep #PMFLAG11513 .LONGA on11514 .MNLIST11515 F87C0D A5 22 lda facexp11516 F87C0F C9 FE 3F cmp #$3FFE11517 F87C12 F0 02 beq ?tst11518 F87C14 B0 05 bcs ?cc ; |x| > 0.62511519 F87C16 A5 20 ?tst: lda facm+1411520 F87C18 C9 00 A0 cmp #$A00011521 F87C1B ?cc: ACC0811522 F87C1B E2 20 sep #PMFLAG11523 .LONGA off11524 .MNLIST11525 F87C1D 90 35 bcc ?pp ; |x| < 0.62511526 F87C1F A5 24 lda facsgn11527 F87C21 85 CF sta fpcsgn ; save sign11528 F87C23 64 24 stz facsgn ; |x|11529 F87C25 ACC1611530 F87C25 C2 20 rep #PMFLAG11531 .LONGA on11532 .MNLIST11533 F87C27 A5 22 lda facexp11534 F87C29 C9 FE 7F cmp #MAXEXP11535 F87C2C B0 03 bcs ?cc211536 F87C2E 1A inc aTue Jul 17 11:00:18 2018 Page 16411537 F87C2F 85 22 sta facexp11538 F87C31 ?cc2: ACC0811539 F87C31 E2 20 sep #PMFLAG11540 .LONGA off11541 .MNLIST11542 F87C33 B0 16 bcs ?th1 ; overflow: return +111543 F87C35 20 6B 68 jsr fexp ; exp(|2x|)11544 F87C38 B0 11 bcs ?th1 ; overflow11545 F87C3A 20 6C 45 jsr faddone11546 F87C3D 20 AD 4E jsr ldatwo ; arg=2.011547 F87C40 20 10 4A jsr fpdiv ; 2/(exp(|2x|)+1)11548 F87C43 20 A6 4E jsr ldaone11549 F87C46 20 5F 45 jsr fpsub ; 1 - 2/(exp(|2x|)+1)11550 F87C49 80 03 bra ?done11551 F87C4B 20 36 4E ?th1: jsr fld1 ; set fac=111552 F87C4E A5 CF ?done: lda fpcsgn11553 F87C50 85 24 sta facsgn ; set sign11554 F87C52 18 ?ok: clc11555 F87C53 60 rts11556 F87C54 20 93 84 ?pp: jsr mvf_t1 ; tfr1=x11557 F87C57 20 CC 49 jsr fsquare ; z=x*x11558 F87C5A 20 66 84 jsr mvf_t0 ; tfr0=z11559 F87C5D A9 44 lda #<cthp11560 F87C5F A0 7F ldy #>cthp11561 F87C61 A2 05 ldx #511562 F87C63 20 1C 87 jsr peval ; evaluates P(z)11563 F87C66 20 C0 84 jsr mvf_t2 ; tfr2=P(z)11564 F87C69 A9 B0 lda #<cthq11565 F87C6B A0 7F ldy #>cthq11566 F87C6D A2 04 ldx #411567 F87C6F 20 3A 87 jsr pevalp1 ; evaluates Q(z)11568 F87C72 20 28 86 jsr mvt2_a ; arg=P(z)11569 F87C75 20 10 4A jsr fpdiv ; R(z)11570 F87C78 20 CE 85 jsr mvt0_a ; arg=z11571 F87C7B 20 DD 49 jsr fpmult ; z*R(z)11572 F87C7E 20 FB 85 jsr mvt1_a ; arg=x11573 F87C81 20 DD 49 jsr fpmult ; x*z*R(z)11574 F87C84 20 FB 85 jsr mvt1_a ; arg=x11575 F87C87 4C 7D 45 jmp fpadd ; returns tanh(x)=x + x*z*R(z)1157611577 ; fasinh - returns the inverse hyperbolic sine of the argument11578 ;11579 ; entry:11580 ; fac=x11581 ;11582 ; exit:11583 ; fac=asinh(x)11584 ; CF = 1 if invalid result(inf or nan)11585 ;11586 ; strategy11587 ;11588 ; Mathematically asinh(x) = sgn(x)*ln[|x| + sqrt(x*x + 1)]11589 ;11590 ; 1) if |x| < 0.5 asinh(x) is approximated by a rational function:11591 ;11592 ; 3 P(z) 211593 ; asinh(x) = x + x * R(z), R(z) = ------, z = xTue Jul 17 11:00:18 2018 Page 16511594 ; Q(z)11595 ;11596 ; 2) if |x| >= 0.5: asinh(x) = sgn(x)*ln[|x| + sqrt(x*x + 1)]11597 ; overflow will be avoided computing x*x or |x| + sqrt(...)11598 ; approximating asinh(x) with:11599 ;11600 ; asinh(x) = sgn(x)*ln(2*|x|) if x*x overflow11601 ;11602 ; or:11603 ;11604 ; asinh(x) = sgn(x)*[ln(|x|) + ln(2)] if 2*|x| overflow11605 ;11606 ; computation mean time: 100/150ms at 4MHz11607 ;11608 ;------11609 F87C8A fasinh:11610 ;------11611 F87C8A 38 sec11612 F87C8B 24 25 bit facst ; if fac=nan or fac=inf returns nan or inf11613 F87C8D 30 03 bmi ?rts11614 F87C8F 50 02 bvc ?fv11615 F87C91 18 clc ; if fac=0 returns zero11616 F87C92 60 ?rts: rts11617 F87C93 A5 24 ?fv: lda facsgn ; asinh(-x) = -asinh(x)11618 F87C95 85 CF sta fpcsgn ; save sign11619 F87C97 64 24 stz facsgn ; |x|11620 F87C99 ACC1611621 F87C99 C2 20 rep #PMFLAG11622 .LONGA on11623 .MNLIST11624 F87C9B A5 22 lda facexp11625 F87C9D C9 FE 3F cmp #$3FFE ; 0.511626 F87CA0 ACC0811627 F87CA0 E2 20 sep #PMFLAG11628 .LONGA off11629 .MNLIST11630 F87CA2 08 php11631 F87CA3 20 C0 84 jsr mvf_t2 ; tfr2=|x|11632 F87CA6 20 CC 49 jsr fsquare ; z=x*x11633 F87CA9 28 plp11634 F87CAA 90 34 bcc ?lt05 ; |x| < 0.511635 F87CAC 20 6C 45 jsr faddone ; z+111636 F87CAF B0 10 bcs ?big ; x*x overflow11637 F87CB1 20 53 60 jsr fsqrt ; sqrt(z+1)11638 F87CB4 20 28 86 jsr mvt2_a ; arg=x11639 F87CB7 20 7D 45 jsr fpadd ; x+sqrt(z+1)11640 F87CBA B0 05 bcs ?big ; overflow11641 F87CBC 20 B3 62 jsr floge ; ln(x+sqrt(z+1))11642 F87CBF 80 4F bra ?done11643 F87CC1 20 A1 85 ?big: jsr mvt2_f11644 F87CC4 20 39 84 jsr mvftoa11645 F87CC7 20 7D 45 jsr fpadd ; try 2*|x|11646 F87CCA B0 05 bcs ?big1 ; overflow11647 F87CCC 20 B3 62 jsr floge ; asinh(x) = sgn(x)*(ln(2*|x|))11648 F87CCF 80 3F bra ?done11649 F87CD1 20 A1 85 ?big1: jsr mvt2_f11650 F87CD4 20 B3 62 jsr flogeTue Jul 17 11:00:18 2018 Page 16611651 F87CD7 A9 B1 lda #<cln2 ; asinh(x) = sgn(x)*(ln(|x|) + ln(2))11652 F87CD9 A0 67 ldy #>cln211653 F87CDB 20 7A 45 jsr fcadd11654 F87CDE 80 30 bra ?done11655 F87CE0 20 66 84 ?lt05: jsr mvf_t0 ; tfr0=z11656 F87CE3 A9 0A lda #<cashp11657 F87CE5 A0 80 ldy #>cashp11658 F87CE7 A2 08 ldx #811659 F87CE9 20 1C 87 jsr peval ; evaluates P(z)11660 F87CEC 20 93 84 jsr mvf_t1 ; tfr2=P(z)11661 F87CEF A9 AC lda #<cashq11662 F87CF1 A0 80 ldy #>cashq11663 F87CF3 A2 08 ldx #811664 F87CF5 20 3A 87 jsr pevalp1 ; evaluates Q(z)11665 F87CF8 20 FB 85 jsr mvt1_a ; arg=P(z)11666 F87CFB 20 10 4A jsr fpdiv ; R(z)11667 F87CFE 20 CE 85 jsr mvt0_a ; arg=z11668 F87D01 20 DD 49 jsr fpmult ; z*R(z)11669 F87D04 20 28 86 jsr mvt2_a ; arg=x11670 F87D07 20 DD 49 jsr fpmult ; x*z*R(z)11671 F87D0A 20 28 86 jsr mvt2_a ; arg=x11672 F87D0D 20 7D 45 jsr fpadd ; asinh(x)=x + x*z*R(z)11673 F87D10 A5 CF ?done: lda fpcsgn ; set sign11674 F87D12 85 24 sta facsgn11675 F87D14 60 rts1167611677 ; facosh - returns the inverse hyperbolic cosine of the argument11678 ;11679 ; entry:11680 ; fac=x11681 ;11682 ; exit:11683 ; fac=acosh(x)11684 ; CF = 1 if invalid result(inf or nan)11685 ;11686 ; strategy11687 ;11688 ; Mathematically acosh(x) = ln[x + sqrt(x*x - 1)], x >= 111689 ;11690 ; 1) if 1 <= x < 1.5 acosh(x) is approximated by a rational function:11691 ;11692 ; P(z)11693 ; acosh(x) = sqrt(2*z) * R(z), R(z) = ------, z = x - 111694 ; Q(z)11695 ;11696 ; 2) if |x| >= 1.5: acosh(x) = ln[x + sqrt(x*x - 1)]11697 ; overflow will be avoided computing x*x or x + sqrt(...)11698 ; approximating acosh(x) with:11699 ;11700 ; acosh(x) = ln(2*x) if x*x overflow11701 ;11702 ; or:11703 ;11704 ; acosh(x) = ln(x) + ln(2) if 2*x overflow11705 ;11706 ; computation mean time: 75/150ms at 4MHz11707 ;Tue Jul 17 11:00:18 2018 Page 16711708 ;------11709 F87D15 facosh:11710 ;------11711 F87D15 A5 24 lda facsgn ; acosh(x) defined only if x>=111712 F87D17 30 0B bmi ?nan11713 F87D19 24 25 bit facst11714 F87D1B 30 0A bmi ?er ; nan or inf; returns nan or inf11715 F87D1D 20 24 74 jsr cmpx1 ; compare x with 1.011716 F87D20 F0 07 beq ?z ; acosh(1) = 011717 F87D22 B0 08 bcs ?ok ; returns nan if |x|<111718 F87D24 4C 74 4E ?nan: jmp fldnan11719 F87D27 38 ?er: sec11720 F87D28 60 rts11721 F87D29 4C 56 4E ?z: jmp fldz11722 F87D2C A9 5A ?ok: lda #<c1h511723 F87D2E A0 7E ldy #>c1h511724 F87D30 20 5E 87 jsr fccmp ; compare x vs. 1.511725 F87D33 F0 3B beq ?gt ; x = 1.511726 F87D35 10 39 bpl ?gt ; x > 1.511727 F87D37 20 71 45 jsr fsubone ; z = x - 1 (x < 1.5)11728 F87D3A 20 66 84 jsr mvf_t0 ; tfr0=z11729 F87D3D 20 39 84 jsr mvftoa11730 F87D40 20 7D 45 jsr fpadd ; 2*z11731 F87D43 20 C0 84 jsr mvf_t2 ; tfr2 = 2*z11732 F87D46 A9 4E lda #<cachp11733 F87D48 A0 81 ldy #>cachp11734 F87D4A A2 09 ldx #911735 F87D4C 20 1C 87 jsr peval ; evaluates P(z)11736 F87D4F 20 93 84 jsr mvf_t1 ; tfr1=P(z)11737 F87D52 A9 02 lda #<cachq11738 F87D54 A0 82 ldy #>cachq11739 F87D56 A2 08 ldx #811740 F87D58 20 3A 87 jsr pevalp1 ; evaluates Q(z)11741 F87D5B 20 FB 85 jsr mvt1_a ; arg=P(z)11742 F87D5E 20 10 4A jsr fpdiv ; R(z)11743 F87D61 20 ED 84 jsr mvf_t3 ; tfr3 = R(z)11744 F87D64 20 A1 85 jsr mvt2_f ; fac=2*z11745 F87D67 20 53 60 jsr fsqrt ; sqrt(2*z)11746 F87D6A 20 55 86 jsr mvt3_a ; R(z)11747 F87D6D 4C DD 49 jmp fpmult ; acosh(x) = sqrt(2*z)*R(z)11748 F87D70 20 C0 84 ?gt: jsr mvf_t2 ; tfr2 = x11749 F87D73 20 CC 49 jsr fsquare11750 F87D76 B0 11 bcs ?big ; x*x overflow11751 F87D78 20 71 45 jsr fsubone ; x*x - 111752 F87D7B 20 53 60 jsr fsqrt11753 F87D7E 20 28 86 jsr mvt2_a ; x11754 F87D81 20 7D 45 jsr fpadd11755 F87D84 B0 03 bcs ?big ; overflow11756 F87D86 4C B3 62 jmp floge ; acosh(x) = ln[x + sqrt(x*x - 1)]11757 F87D89 20 A1 85 ?big: jsr mvt2_f ; x11758 F87D8C 20 39 84 jsr mvftoa11759 F87D8F 20 7D 45 jsr fpadd ; try 2*x11760 F87D92 B0 03 bcs ?big1 ; overflow11761 F87D94 4C B3 62 jmp floge ; acosh(x) = ln(2*x)11762 F87D97 20 A1 85 ?big1: jsr mvt2_f ; x11763 F87D9A 20 B3 62 jsr floge11764 F87D9D A9 B1 lda #<cln2 ; acosh(x) = ln(x) + ln(2)Tue Jul 17 11:00:18 2018 Page 16811765 F87D9F A0 67 ldy #>cln211766 F87DA1 4C 7A 45 jmp fcadd1176711768 ; fatanh - returns the inverse hyperbolic tangent of the argument11769 ;11770 ; entry:11771 ; fac=x11772 ;11773 ; exit:11774 ; fac=atanh(x)11775 ; CF = 1 if invalid result(inf or nan)11776 ;11777 ; strategy11778 ; 1 1 + x11779 ; Mathematically atanh(x) = --- * ln(-------) , -1 < x < 111780 ; 2 1 - x11781 ;11782 ; 1) if |x| < 0.5 atanh(x) is approximated by a rational function:11783 ;11784 ; 3 P(z) 211785 ; atanh(x) = x + x * R(z), R(z) = ------, z = x11786 ; Q(z)11787 ;11788 ; 2) if |x| >= 0.5:11789 ;11790 ; 1 1 + |x|11791 ; atanh(x) = --- * sgn(x) * ln(---------)11792 ; 2 1 - |x|11793 ;11794 ; computation mean time: 80/100ms at 4MHz11795 ;11796 ;------11797 F87DA4 fatanh:11798 ;------11799 F87DA4 24 25 bit facst ; if fac=nan or fac=inf returns nan11800 F87DA6 30 07 bmi ?nan11801 F87DA8 50 08 bvc ?fv11802 F87DAA 18 clc ; if fac=0 returns zero11803 F87DAB 60 rts11804 F87DAC 4C 7D 4E ?inf: jmp fldinf11805 F87DAF 4C 74 4E ?nan: jmp fldnan ; if |x| > 1 returns nan11806 F87DB2 20 24 74 ?fv: jsr cmpx1 ; compare x vs. 1.011807 F87DB5 F0 F5 beq ?inf ; atanh(+/-1) = +/-inf11808 F87DB7 B0 F6 bcs ?nan ; if |x| > 1 returns nan11809 F87DB9 ACC1611810 F87DB9 C2 20 rep #PMFLAG11811 .LONGA on11812 .MNLIST11813 F87DBB A5 22 lda facexp11814 F87DBD C9 FE 3F cmp #$3FFE ; compare x vs. 0.511815 F87DC0 ACC0811816 F87DC0 E2 20 sep #PMFLAG11817 .LONGA off11818 .MNLIST11819 F87DC2 B0 36 bcs ?gt ; |x| >= 0.511820 F87DC4 20 C0 84 jsr mvf_t2 ; tfr2 = x11821 F87DC7 20 CC 49 jsr fsquare ; z=x*xTue Jul 17 11:00:18 2018 Page 16911822 F87DCA 20 66 84 jsr mvf_t0 ; tfr0=z11823 F87DCD A9 A4 lda #<cathp11824 F87DCF A0 82 ldy #>cathp11825 F87DD1 A2 09 ldx #911826 F87DD3 20 1C 87 jsr peval ; evaluates P(z)11827 F87DD6 20 93 84 jsr mvf_t1 ; tfr2=P(z)11828 F87DD9 A9 58 lda #<cathq11829 F87DDB A0 83 ldy #>cathq11830 F87DDD A2 09 ldx #911831 F87DDF 20 3A 87 jsr pevalp1 ; evaluates Q(z)11832 F87DE2 20 FB 85 jsr mvt1_a ; arg=P(z)11833 F87DE5 20 10 4A jsr fpdiv ; R(z)11834 F87DE8 20 CE 85 jsr mvt0_a ; arg=z11835 F87DEB 20 DD 49 jsr fpmult ; z*R(z)11836 F87DEE 20 28 86 jsr mvt2_a ; arg=x11837 F87DF1 20 DD 49 jsr fpmult ; x*z*R(z)11838 F87DF4 20 28 86 jsr mvt2_a ; arg=x11839 F87DF7 4C 7D 45 jmp fpadd ; atanh(x)=x + x*z*R(z)11840 F87DFA A5 24 ?gt: lda facsgn11841 F87DFC 85 CF sta fpcsgn ; save x sign11842 F87DFE 64 24 stz facsgn ; |x|11843 F87E00 20 66 84 jsr mvf_t0 ; tfr0 = |x|11844 F87E03 20 6C 45 jsr faddone ; y = 1 + |x|11845 F87E06 20 93 84 jsr mvf_t1 ; tfr1 = y11846 F87E09 20 47 85 jsr mvt0_f ; |x|11847 F87E0C A9 48 lda #<cthl11848 F87E0E A0 7E ldy #>cthl11849 F87E10 20 5E 87 jsr fccmp ; compare |x| vs. 0.999023437511850 F87E13 30 19 bmi ?dom1 ; if |x| <= 0.9990234375...11851 F87E15 F0 17 beq ?dom1 ; ...computes z = 1 - |x|11852 F87E17 A9 B3 lda #<fce32 ; otherwisa scale by 1e3211853 F87E19 A0 5F ldy #>fce3211854 F87E1B 20 D5 49 jsr fcmult11855 F87E1E A9 B3 lda #<fce32 ; computes z = 1e32 - |x|*1e3211856 F87E20 A0 5F ldy #>fce3211857 F87E22 20 5C 45 jsr fcsub11858 F87E25 A9 B3 lda #<fce32 ; scale back11859 F87E27 A0 5F ldy #>fce3211860 F87E29 20 0A 4A jsr fcrdiv ; z = 1 - |x|11861 F87E2C 80 06 bra ?div11862 F87E2E 20 A6 4E ?dom1: jsr ldaone ; arg=111863 F87E31 20 5F 45 jsr fpsub ; z = 1 - |x|11864 F87E34 20 FB 85 ?div: jsr mvt1_a ; arg = y = 1 + |x|11865 F87E37 20 10 4A jsr fpdiv ; w = y/z11866 F87E3A 20 B3 62 jsr floge ; ln(w) = ln[(1 + |x|)/(1 - |x|)]11867 F87E3D ACC1611868 F87E3D C2 20 rep #PMFLAG11869 .LONGA on11870 .MNLIST11871 F87E3F C6 22 dec facexp ; divide by211872 F87E41 ACC0811873 F87E41 E2 20 sep #PMFLAG11874 .LONGA off11875 .MNLIST11876 F87E43 A5 CF lda fpcsgn ; restore sign11877 F87E45 85 24 sta facsgn11878 F87E47 60 rtsTue Jul 17 11:00:18 2018 Page 1701187911880 ; 0.9990234375 = tanh(3.81206529283064476456228418624)11881 F87E48 00 00 00 00 00 cthl: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0011882 F87E51 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$C0,$FF,$FE,$3FC0 FF FE 3F11883 ; 1.511884 F87E5A 00 00 00 00 00 c1h5: .DB $00,$00,$00,$00,$00,$00,$00,$00,$0000 00 00 0011885 F87E63 00 00 00 00 00 .DB $00,$00,$00,$00,$00,$00,$C0,$FF,$3F00 C0 FF 3F1188611887 ; sinh(x) coefficients11888 F87E6C cshp:11889 ; SHP[5] = 1.622194395724068297909052717437740288268E311890 F87E6C 17 69 DD D3 6C .DB $17,$69,$DD,$D3,$6C,$86,$A5,$72,$E886 A5 72 E811891 F87E75 60 AB 61 7D 38 .DB $60,$AB,$61,$7D,$38,$C6,$CA,$09,$40C6 CA 09 401189211893 ; SHP[4] = 1.124862584587770079742188354390171794549E611894 F87E7E 1D 93 DF 58 C9 .DB $1D,$93,$DF,$58,$C9,$1A,$0E,$8E,$121A 0E 8E 1211895 F87E87 51 5A 3C AD F4 .DB $51,$5A,$3C,$AD,$F4,$4F,$89,$13,$404F 89 13 401189611897 ; SHP[3] = 3.047548980769660162696832999871894196102E811898 F87E90 9E C2 A9 C6 06 .DB $9E,$C2,$A9,$C6,$06,$9F,$E8,$40,$D69F E8 40 D611899 F87E99 5B A0 9D 90 86 .DB $5B,$A0,$9D,$90,$86,$51,$91,$1B,$4051 91 1B 401190011901 ; SHP[2] = 3.966215348072348368191433063260384329745E1011902 F87EA2 2F 3F 63 A6 E4 .DB $2F,$3F,$63,$A6,$E4,$FD,$2F,$10,$A0FD 2F 10 A011903 F87EAB 63 93 8B F0 C6 .DB $63,$93,$8B,$F0,$C6,$C0,$93,$22,$40C0 93 22 401190411905 ; SHP[1] = 2.375869584584371194838551715348965605295E1211906 F87EB4 0E D1 C3 AC F2 .DB $0E,$D1,$C3,$AC,$F2,$82,$01,$FF,$A782 01 FF A711907 F87EBD C1 17 32 35 37 .DB $C1,$17,$32,$35,$37,$4B,$8A,$28,$404B 8A 28 401190811909 ; SHP[0] = 6.482835792103233269752264509192030816323E1311910 F87EC6 6C 44 21 C8 30 .DB $6C,$44,$21,$C8,$30,$E2,$CC,$A8,$AEE2 CC A8 AE11911 F87ECF 54 21 24 FB 1C .DB $54,$21,$24,$FB,$1C,$D8,$EB,$2C,$40D8 EB 2C 401191211913 F87ED8 cshq:11914 ; SHQ[5] = -9.101683853129357776079049616394849086007E211915 F87ED8 E1 53 03 04 33 .DB $E1,$53,$03,$04,$33,$F5,$4A,$94,$A1F5 4A 94 A111916 F87EE1 E5 0B 31 D3 C6 .DB $E5,$0B,$31,$D3,$C6,$8A,$E3,$08,$C08A E3 08 C011917Tue Jul 17 11:00:18 2018 Page 17111918 ; SHQ[4] = 4.486400519836461218634448973793765123186E511919 F87EEA 1B 10 39 12 99 .DB $1B,$10,$39,$12,$99,$3F,$E1,$CF,$A53F E1 CF A511920 F87EF3 80 9B D9 A9 01 .DB $80,$9B,$D9,$A9,$01,$10,$DB,$11,$4010 DB 11 401192111922 ; SHQ[3] = -1.492531313030440305095318968983514314656E811923 F87EFC E3 FC 9D E6 6A .DB $E3,$FC,$9D,$E6,$6A,$12,$5D,$95,$8412 5D 95 8411924 F87F05 B2 44 D9 B4 C0 .DB $B2,$44,$D9,$B4,$C0,$56,$8E,$1A,$C056 8E 1A C01192511926 ; SHQ[2] = 3.457771488856930054902696708717192082887E1011927 F87F0E 36 87 1A 50 C3 .DB $36,$87,$1A,$50,$C3,$93,$A6,$7A,$E493 A6 7A E411928 F87F17 DA 1B 89 EC E0 .DB $DA,$1B,$89,$EC,$E0,$CF,$80,$22,$40CF 80 22 401192911930 ; SHQ[1] = -5.193289868803472640225483235513427062460E1211931 F87F20 DF 76 FE 54 9D .DB $DF,$76,$FE,$54,$9D,$2F,$E7,$64,$DE2F E7 64 DE11932 F87F29 1F 6F C0 54 06 .DB $1F,$6F,$C0,$54,$06,$25,$97,$29,$C025 97 29 C01193311934 ; SHQ[0] = 3.889701475261939961851358705515223019890E1411935 F87F32 F5 20 1D 96 A4 .DB $F5,$20,$1D,$96,$A4,$A9,$99,$FE,$82A9 99 FE 8211936 F87F3B FF 18 5B BC 15 .DB $FF,$18,$5B,$BC,$15,$E2,$B0,$2F,$40E2 B0 2F 401193711938 ; tanh(x) coefficients11939 F87F44 cthp:11940 ; THP[5] = -6.505693197948351084912624750702492767503E-611941 F87F44 A5 DE 0A CF 2E .DB $A5,$DE,$0A,$CF,$2E,$1F,$25,$59,$901F 25 59 9011942 F87F4D 92 24 C2 A2 7A .DB $92,$24,$C2,$A2,$7A,$4B,$DA,$ED,$BF4B DA ED BF1194311944 ; THP[4] = -9.804083860188429726356968570322356183383E-111945 F87F56 2F F3 D5 9C 7D .DB $2F,$F3,$D5,$9C,$7D,$E3,$C3,$6C,$CAE3 C3 6C CA11946 F87F5F A9 D1 AC 42 0B .DB $A9,$D1,$AC,$42,$0B,$FC,$FA,$FE,$BFFC FA FE BF1194711948 ; THP[3] = -5.055287638900473250703725789725376004355E211949 F87F68 74 6D 2D 35 A2 .DB $74,$6D,$2D,$35,$A2,$58,$08,$D8,$5858 08 D8 5811950 F87F71 8D 87 FF 88 AE .DB $8D,$87,$FF,$88,$AE,$C3,$FC,$07,$C0C3 FC 07 C01195111952 ; THP[2] = -7.307477148073823966594990496301416814519E411953 F87F7A 96 63 D3 D4 55 .DB $96,$63,$D3,$D4,$55,$B8,$E3,$D5,$DCB8 E3 D5 DC11954 F87F83 1D 7E E1 BF 62 .DB $1D,$7E,$E1,$BF,$62,$B9,$8E,$0F,$C0B9 8E 0F C01195511956 ; THP[1] = -3.531606586182691280701462523692471322688E6Tue Jul 17 11:00:18 2018 Page 17211957 F87F8C 96 14 AC DD D7 .DB $96,$14,$AC,$DD,$D7,$7B,$66,$A4,$207B 66 A4 2011958 F87F95 82 46 40 58 5A .DB $82,$46,$40,$58,$5A,$8D,$D7,$14,$C08D D7 14 C01195911960 ; THP[0] = -4.551377146142783468144190926206842300707E711961 F87F9E E4 75 8D 86 22 .DB $E4,$75,$8D,$86,$22,$74,$D2,$EF,$DA74 D2 EF DA11962 F87FA7 9C 08 88 DD 0A .DB $9C,$08,$88,$DD,$0A,$9F,$AD,$18,$C09F AD 18 C01196311964 F87FB0 cthq:11965 ; THQ[4] = 5.334865598460027935735737253027154828002E211966 F87FB0 19 BD 0A 16 6E .DB $19,$BD,$0A,$16,$6E,$A3,$F1,$38,$2CA3 F1 38 2C11967 F87FB9 3E 88 E8 CB 23 .DB $3E,$88,$E8,$CB,$23,$5F,$85,$08,$405F 85 08 401196811969 ; THQ[3] = 8.058475607422391042912151298751537172870E411970 F87FC2 9F 9E F9 42 21 .DB $9F,$9E,$F9,$42,$21,$C6,$63,$AC,$9DC6 63 AC 9D11971 F87FCB 85 48 0A C7 60 .DB $85,$48,$0A,$C7,$60,$64,$9D,$0F,$4064 9D 0F 401197211973 ; THQ[2] = 4.197073523796142343374222405869721575491E611974 F87FD4 22 53 FB 45 7B .DB $22,$53,$FB,$45,$7B,$BE,$6D,$81,$45BE 6D 81 4511975 F87FDD 0A 02 2F 0C A3 .DB $0A,$02,$2F,$0C,$A3,$15,$80,$15,$4015 80 15 401197611977 ; THQ[1] = 6.521134551226147545983467868553677881771E711978 F87FE6 95 2E 27 14 95 .DB $95,$2E,$27,$14,$95,$C2,$CF,$71,$06C2 CF 71 0611979 F87FEF 5B E4 C8 60 F4 .DB $5B,$E4,$C8,$60,$F4,$C2,$F8,$18,$40C2 F8 18 401198011981 ; THQ[0] = 1.365413143842835040443257277862054198329E811982 F87FF8 34 03 ED E4 19 .DB $34,$03,$ED,$E4,$19,$D7,$DD,$33,$A4D7 DD 33 A411983 F88001 75 06 26 26 48 .DB $75,$06,$26,$26,$48,$37,$82,$1A,$4037 82 1A 401198411985 ; asinh(x) coefficients11986 F8800A cashp:11987 ; ASHP[8] = -8.104404283317298189545629468767571317688E-111988 F8800A D4 44 8A 29 62 .DB $D4,$44,$8A,$29,$62,$9C,$61,$3B,$4F9C 61 3B 4F11989 F88013 B9 7F 0A 1F 06 .DB $B9,$7F,$0A,$1F,$06,$79,$CF,$FE,$BF79 CF FE BF1199011991 ; ASHP[7] = -4.954206127425209147110732546633675599008E111992 F8801C 4C 2A 14 A7 8C .DB $4C,$2A,$14,$A7,$8C,$5D,$7A,$C6,$D85D 7A C6 D811993 F88025 FF 5C 55 1C 12 .DB $FF,$5C,$55,$1C,$12,$2B,$C6,$04,$C02B C6 04 C01199411995 ; ASHP[6] = -8.438175619831548439550086251740438689853E2Tue Jul 17 11:00:18 2018 Page 17311996 F8802E 1F E6 69 54 E9 .DB $1F,$E6,$69,$54,$E9,$DD,$A7,$DA,$DBDD A7 DA DB11997 F88037 96 06 7F EF 52 .DB $96,$06,$7F,$EF,$52,$F4,$D2,$08,$C0F4 D2 08 C01199811999 ; ASHP[5] = -6.269710069245210459536983820505214648057E312000 F88040 4D 94 05 70 20 .DB $4D,$94,$05,$70,$20,$FD,$0E,$76,$39FD 0E 76 3912001 F88049 98 D0 C8 38 AE .DB $98,$D0,$C8,$38,$AE,$ED,$C3,$0B,$C0ED C3 0B C01200212003 ; ASHP[4] = -2.418935474493501382372711518024193326434E412004 F88052 65 46 D1 97 6C .DB $65,$46,$D1,$97,$6C,$45,$6A,$6B,$AE45 6A 6B AE12005 F8805B 9C CC 20 A1 B5 .DB $9C,$CC,$20,$A1,$B5,$FA,$BC,$0D,$C0FA BC 0D C01200612007 ; ASHP[3] = -5.208121780431312783866941311277024486498E412008 F88064 C1 0A 1C 9F EE .DB $C1,$0A,$1C,$9F,$EE,$A5,$FC,$D0,$D2A5 FC D0 D212009 F8806D CF 01 06 C2 37 .DB $CF,$01,$06,$C2,$37,$71,$CB,$0E,$C071 CB 0E C01201012011 ; ASHP[2] = -6.302755086521614763280617114866439227971E412012 F88076 27 92 3C F6 A2 .DB $27,$92,$3C,$F6,$A2,$88,$78,$6D,$A988 78 6D A912013 F8807F DB B7 80 05 8D .DB $DB,$B7,$80,$05,$8D,$33,$F6,$0E,$C033 F6 0E C01201412015 ; ASHP[1] = -4.003566436224198252093684987323233921339E412016 F88088 3D 57 F5 E9 85 .DB $3D,$57,$F5,$E9,$85,$D7,$5B,$49,$1DD7 5B 49 1D12017 F88091 03 D6 A4 13 AA .DB $03,$D6,$A4,$13,$AA,$63,$9C,$0E,$C063 9C 0E C01201812019 ; ASHP[0] = -1.037690841528359305134494613113086980551E412020 F8809A 75 93 4B 3D 7C .DB $75,$93,$4B,$3D,$7C,$5E,$17,$5F,$F85E 17 5F F812021 F880A3 DF B8 9D 37 A2 .DB $DF,$B8,$9D,$37,$A2,$23,$A2,$0C,$C023 A2 0C C01202212023 F880AC cashq:12024 ; ASHQ[8] = 8.175806439951395194771977809279448392548E112025 F880AC 2D 40 15 F1 2B .DB $2D,$40,$15,$F1,$2B,$46,$3A,$A0,$1946 3A A0 1912026 F880B5 3E 59 58 04 21 .DB $3E,$59,$58,$04,$21,$84,$A3,$05,$4084 A3 05 401202712028 ; ASHQ[7] = 1.822215299975696008284027212745010251320E312029 F880BE FC 15 F8 77 03 .DB $FC,$15,$F8,$77,$03,$2B,$9A,$81,$D72B 9A 81 D712030 F880C7 34 4E C6 BC E3 .DB $34,$4E,$C6,$BC,$E3,$C6,$E3,$09,$40C6 E3 09 401203112032 ; ASHQ[6] = 1.772040003462901790853111853838978236828E412033 F880D0 14 67 63 D4 3C .DB $14,$67,$63,$D4,$3C,$7C,$F1,$6E,$7F7C F1 6E 7FTue Jul 17 11:00:18 2018 Page 17412034 F880D9 CC C1 56 D1 CC .DB $CC,$C1,$56,$D1,$CC,$70,$8A,$0D,$4070 8A 0D 401203512036 ; ASHQ[5] = 9.077625379864046240143413577745818879353E412037 F880E2 C1 7C F0 4C 1A .DB $C1,$7C,$F0,$4C,$1A,$FC,$B2,$4C,$13FC B2 4C 1312038 F880EB 47 4E 79 7C 20 .DB $47,$4E,$79,$7C,$20,$4C,$B1,$0F,$404C B1 0F 401203912040 ; ASHQ[4] = 2.675554475070211205153169988669677418808E512041 F880F4 F5 4D 22 AF FB .DB $F5,$4D,$22,$AF,$FB,$11,$EE,$02,$2D11 EE 02 2D12042 F880FD 8E 3E FA 51 6E .DB $8E,$3E,$FA,$51,$6E,$A4,$82,$11,$40A4 82 11 401204312044 ; ASHQ[3] = 4.689758557916492969463473819426544383586E512045 F88106 9B B8 C0 1B 1D .DB $9B,$B8,$C0,$1B,$1D,$C9,$87,$FB,$72C9 87 FB 7212046 F8810F 3D 2B A5 62 FB .DB $3D,$2B,$A5,$62,$FB,$FD,$E4,$11,$40FD E4 11 401204712048 ; ASHQ[2] = 4.821923684550711724710891114802924039911E512049 F88118 77 20 49 F1 27 .DB $77,$20,$49,$F1,$27,$60,$C2,$4C,$6560 C2 4C 6512050 F88121 17 4A 62 CA 0B .DB $17,$4A,$62,$CA,$0B,$72,$EB,$11,$4072 EB 11 401205112052 ; ASHQ[1] = 2.682316388947175963642524537892687560973E512053 F8812A F4 0E 30 16 03 .DB $F4,$0E,$30,$16,$03,$74,$A4,$B8,$3B74 A4 B8 3B12054 F88133 B5 55 D3 71 F4 .DB $B5,$55,$D3,$71,$F4,$F8,$82,$11,$40F8 82 11 401205512056 ; ASHQ[0] = 6.226145049170155830806967678679167550122E412057 F8813C F9 E9 F0 5D BA .DB $F9,$E9,$F0,$5D,$BA,$0D,$A3,$8E,$F40D A3 8E F412058 F88145 4F 95 6C 53 73 .DB $4F,$95,$6C,$53,$73,$35,$F3,$0E,$4035 F3 0E 401205912060 ; acosh(x) coefficients12061 F8814E cachp:12062 ; ACHP[9] = 1.895467874386341763387398084072833727168E-112063 F8814E 66 70 8A 32 3A .DB $66,$70,$8A,$32,$3A,$8B,$D0,$B4,$438B D0 B4 4312064 F88157 DF 74 71 94 8D .DB $DF,$74,$71,$94,$8D,$18,$C2,$FC,$3F18 C2 FC 3F1206512066 ; ACHP[8] = 6.443902084393244878979969557171256604767E112067 F88160 C5 F1 41 7D 6B .DB $C5,$F1,$41,$7D,$6B,$5B,$C4,$95,$215B C4 95 2112068 F88169 85 E7 0D 57 C7 .DB $85,$E7,$0D,$57,$C7,$E0,$80,$05,$40E0 80 05 401206912070 ; ACHP[7] = 3.914593556594721458616408528941154205393E312071 F88172 8E E9 6A AE 1F .DB $8E,$E9,$6A,$AE,$1F,$EF,$B1,$89,$EDEF B1 89 ED12072 F8817B 75 2A 33 35 7F .DB $75,$2A,$33,$35,$7F,$A9,$F4,$0A,$40Tue Jul 17 11:00:18 2018 Page 175A9 F4 0A 401207312074 ; ACHP[6] = 9.164040999602964494412169748897754668733E412075 F88184 17 50 27 B4 1E .DB $17,$50,$27,$B4,$1E,$5D,$6C,$09,$4E5D 6C 09 4E12076 F8818D 68 F9 BF 7A 34 .DB $68,$F9,$BF,$7A,$34,$FC,$B2,$0F,$40FC B2 0F 401207712078 ; ACHP[5] = 1.065909694792026382660307834723001543839E612079 F88196 33 4B 4E 96 02 .DB $33,$4B,$4E,$96,$02,$E5,$64,$46,$AEE5 64 46 AE12080 F8819F 36 1F EF 8E AD .DB $36,$1F,$EF,$8E,$AD,$1D,$82,$13,$401D 82 13 401208112082 ; ACHP[4] = 6.899169896709615182428217047370629406305E612083 F881A8 84 A4 A5 35 34 .DB $84,$A4,$A5,$35,$34,$96,$92,$3E,$6F96 92 3E 6F12084 F881B1 CE 85 1D CB C3 .DB $CE,$85,$1D,$CB,$C3,$8B,$D2,$15,$408B D2 15 401208512086 ; ACHP[3] = 2.599781868717579447900896150777162652518E712087 F881BA 46 B9 30 2C 87 .DB $46,$B9,$30,$2C,$87,$69,$CA,$F0,$F169 CA F0 F112088 F881C3 5D 60 F5 57 FD .DB $5D,$60,$F5,$57,$FD,$58,$C6,$17,$4058 C6 17 401208912090 ; ACHP[2] = 5.663733059389964024656501196827345337766E712091 F881CC B6 97 B7 46 A7 .DB $B6,$97,$B7,$46,$A7,$44,$37,$C5,$FD44 37 C5 FD12092 F881D5 A2 73 02 A6 E4 .DB $A2,$73,$02,$A6,$E4,$0D,$D8,$18,$400D D8 18 401209312094 ; ACHP[1] = 6.606302846870644033621560858582696134512E712095 F881DE 3C C5 80 74 46 .DB $3C,$C5,$80,$74,$46,$EC,$B0,$CA,$2AEC B0 CA 2A12096 F881E7 4C 49 FF 1D AD .DB $4C,$49,$FF,$1D,$AD,$02,$FC,$18,$4002 FC 18 401209712098 ; ACHP[0] = 3.190482951215438078279772140481195200593E712099 F881F0 10 22 D8 A0 1A .DB $10,$22,$D8,$A0,$1A,$7C,$37,$8D,$FB7C 37 8D FB12100 F881F9 55 46 8E C1 1E .DB $55,$46,$8E,$C1,$1E,$6A,$F3,$17,$406A F3 17 401210112102 F88202 cachq:12103 ; ACHQ[8] = 1.635418024331924674147953764918262009321E212104 F88202 5C C5 F5 4B 8C .DB $5C,$C5,$F5,$4B,$8C,$8D,$25,$D8,$848D 25 D8 8412105 F8820B 72 74 73 90 B3 .DB $72,$74,$73,$90,$B3,$8A,$A3,$06,$408A A3 06 401210612107 ; ACHQ[7] = 7.290983678312632723073455563799692165828E312108 F88214 C3 9C 13 ED 77 .DB $C3,$9C,$13,$ED,$77,$C1,$6B,$F3,$08C1 6B F3 0812109 F8821D 56 34 BC 92 DE .DB $56,$34,$BC,$92,$DE,$D7,$E3,$0B,$40D7 E3 0B 4012110Tue Jul 17 11:00:18 2018 Page 17612111 ; ACHQ[6] = 1.418207894088607063257675159183397062114E512112 F88226 9E 1E 0F 35 24 .DB $9E,$1E,$0F,$35,$24,$95,$08,$A2,$0095 08 A2 0012113 F8822F FA BD AC 85 32 .DB $FA,$BD,$AC,$85,$32,$7F,$8A,$10,$407F 8A 10 401211412115 ; ACHQ[5] = 1.453154285419072886840913424715826321357E612116 F88238 A8 C8 CD DC 85 .DB $A8,$C8,$CD,$DC,$85,$7E,$96,$04,$A17E 96 04 A112117 F88241 7D CB 89 48 12 .DB $7D,$CB,$89,$48,$12,$63,$B1,$13,$4063 B1 13 401211812119 ; ACHQ[4] = 8.566841438576725234955968880501739464425E612120 F8824A 7A 0D 61 29 7E .DB $7A,$0D,$61,$29,$7E,$C7,$01,$C1,$ABC7 01 C1 AB12121 F88253 73 90 46 70 39 .DB $73,$90,$46,$70,$39,$B8,$82,$16,$40B8 82 16 401212212123 ; ACHQ[3] = 3.003448667795089562511136059766833630017E712124 F8825C 5F BB CA 91 50 .DB $5F,$BB,$CA,$91,$50,$67,$4C,$7B,$8067 4C 7B 8012125 F88265 4E 18 C7 56 1B .DB $4E,$18,$C7,$56,$1B,$25,$E5,$17,$4025 E5 17 401212612127 ; ACHQ[2] = 6.176592872899557661256383958395266919654E712128 F8826E 56 19 E7 C9 A7 .DB $56,$19,$E7,$C9,$A7,$81,$29,$B2,$1E81 29 B2 1E12129 F88277 10 DD A7 2E 4A .DB $10,$DD,$A7,$2E,$4A,$9E,$EB,$18,$409E EB 18 401213012131 ; ACHQ[1] = 6.872176426138597206811541870289420510034E712132 F88280 9F AE 34 C8 63 .DB $9F,$AE,$34,$C8,$63,$F3,$9E,$4D,$35F3 9E 4D 3512133 F88289 1D 46 5D 88 8C .DB $1D,$46,$5D,$88,$8C,$13,$83,$19,$4013 83 19 401213412135 ; ACHQ[0] = 3.190482951215438078279772140481195226621E712136 F88292 60 2C D8 A0 1A .DB $60,$2C,$D8,$A0,$1A,$7C,$37,$8D,$FB7C 37 8D FB12137 F8829B 55 46 8E C1 1E .DB $55,$46,$8E,$C1,$1E,$6A,$F3,$17,$406A F3 17 401213812139 ; atanh(x) coefficients12140 F882A4 cathp:12141 ; ATHP[9] = -9.217569843805850417698565442251656375681E-112142 F882A4 56 9C 44 93 0B .DB $56,$9C,$44,$93,$0B,$94,$F9,$5D,$5594 F9 5D 5512143 F882AD AE 31 C6 06 44 .DB $AE,$31,$C6,$06,$44,$F8,$EB,$FE,$BFF8 EB FE BF1214412145 ; ATHP[8] = 5.321929116410615470118183794063211260728E112146 F882B6 00 73 D2 C8 AD .DB $00,$73,$D2,$C8,$AD,$50,$DA,$62,$2650 DA 62 2612147 F882BF 02 8D E8 DC 8D .DB $02,$8D,$E8,$DC,$8D,$E0,$D4,$04,$40E0 D4 04 401214812149 ; ATHP[7] = -9.139522976807685333981548145417830690552E2Tue Jul 17 11:00:18 2018 Page 17712150 F882C8 FF 0B FD 2D D9 .DB $FF,$0B,$FD,$2D,$D9,$80,$67,$44,$AA80 67 44 AA12151 F882D1 47 BD F8 71 F2 .DB $47,$BD,$F8,$71,$F2,$7C,$E4,$08,$C07C E4 08 C01215212153 ; ATHP[6] = 7.204314536952949779101646454146682033772E312154 F882DA B7 34 20 F1 AE .DB $B7,$34,$20,$F1,$AE,$B4,$89,$32,$1EB4 89 32 1E12155 F882E3 6C 32 F3 2B 84 .DB $6C,$32,$F3,$2B,$84,$22,$E1,$0B,$4022 E1 0B 401215612157 ; ATHP[5] = -3.097809640165146436529075324081668598891E412158 F882EC AB 05 FB 15 54 .DB $AB,$05,$FB,$15,$54,$FB,$82,$FE,$C1FB 82 FE C112159 F882F5 A3 A8 8E 5B 31 .DB $A3,$A8,$8E,$5B,$31,$04,$F2,$0D,$C004 F2 0D C01216012161 ; ATHP[4] = 7.865376554210973897486215630898496100534E412162 F882FE D8 06 5E 71 61 .DB $D8,$06,$5E,$71,$61,$54,$5E,$34,$1654 5E 34 1612163 F88307 85 AA 48 FD E1 .DB $85,$AA,$48,$FD,$E1,$9E,$99,$0F,$409E 99 0F 401216412165 ; ATHP[3] = -1.211716814094785128366087489224821937203E512166 F88310 4A 97 EA 1A 1E .DB $4A,$97,$EA,$1A,$1E,$BF,$9D,$77,$D2BF 9D 77 D212167 F88319 B2 00 6D 38 D7 .DB $B2,$00,$6D,$38,$D7,$A9,$EC,$0F,$C0A9 EC 0F C01216812169 ; ATHP[2] = 1.112669508789123834670923967462068457013E512170 F88322 4A 6F 5C D9 90 .DB $4A,$6F,$5C,$D9,$90,$61,$4B,$27,$4F61 4B 27 4F12171 F8832B 92 73 66 B6 79 .DB $92,$73,$66,$B6,$79,$51,$D9,$0F,$4051 D9 0F 401217212173 ; ATHP[1] = -5.600242872292477863751728708249167956542E412174 F88334 09 D6 41 CF B4 .DB $09,$D6,$41,$CF,$B4,$1F,$BF,$51,$3F1F BF 51 3F12175 F8833D F8 1C C9 C0 6D .DB $F8,$1C,$C9,$C0,$6D,$C2,$DA,$0E,$C0C2 DA 0E C01217612177 ; ATHP[0] = 1.188901082233997739779618679364295772810E412178 F88346 25 9B 90 FA 10 .DB $25,$9B,$90,$FA,$10,$5E,$5E,$62,$935E 5E 62 9312179 F8834F 13 F1 02 15 0B .DB $13,$F1,$02,$15,$0B,$C4,$B9,$0C,$40C4 B9 0C 401218012181 F88358 cathq:12182 ; ATHQ[9] = -6.807348436010016270202879229504392062418E112183 F88358 99 2F A4 39 46 .DB $99,$2F,$A4,$39,$46,$E2,$E3,$D8,$82E2 E3 D8 8212184 F88361 9D CB F6 BD 9F .DB $9D,$CB,$F6,$BD,$9F,$25,$88,$05,$C025 88 05 C01218512186 ; ATHQ[8] = 1.386763299649315831625106608182196351693E312187 F8836A 85 34 75 16 4D .DB $85,$34,$75,$16,$4D,$4C,$65,$28,$334C 65 28 33Tue Jul 17 11:00:18 2018 Page 17812188 F88373 83 DB 62 F3 6C .DB $83,$DB,$62,$F3,$6C,$58,$AD,$09,$4058 AD 09 401218912190 ; ATHQ[7] = -1.310805752656879543134785263832907269320E412191 F8837C 10 00 DF D6 BA .DB $10,$00,$DF,$D6,$BA,$52,$8D,$F4,$8752 8D F4 8712192 F88385 82 AE 3E E8 3A .DB $82,$AE,$3E,$E8,$3A,$D0,$CC,$0C,$C0D0 CC 0C C01219312194 ; ATHQ[6] = 6.872174720355764193772953852564737816928E412195 F8838E 6E FA BF B3 EC .DB $6E,$FA,$BF,$B3,$EC,$33,$80,$DD,$7333 80 DD 7312196 F88397 C3 BD 5D A4 DF .DB $C3,$BD,$5D,$A4,$DF,$38,$86,$0F,$4038 86 0F 401219712198 ; ATHQ[5] = -2.181008360536226513009076189881617939380E512199 F883A0 F5 02 E5 97 FF .DB $F5,$02,$E5,$97,$FF,$97,$2A,$A0,$5697 2A A0 5612200 F883A9 BF 0D E7 81 35 .DB $BF,$0D,$E7,$81,$35,$FD,$D4,$10,$C0FD D4 10 C01220112202 ; ATHQ[4] = 4.362736119602298592874941767284979857248E512203 F883B2 61 1A B8 5B 6C .DB $61,$1A,$B8,$5B,$6C,$27,$7A,$54,$5827 7A 54 5812204 F883BB B6 9E 2D 95 33 .DB $B6,$9E,$2D,$95,$33,$06,$D5,$11,$4006 D5 11 401220512206 ; ATHQ[3] = -5.535251007539393347687001489396152923502E512207 F883C4 7F 3B 18 F4 58 .DB $7F,$3B,$18,$F4,$58,$AC,$E0,$0D,$2DAC E0 0D 2D12208 F883CD A6 29 B0 9C 51 .DB $A6,$29,$B0,$9C,$51,$23,$87,$12,$C023 87 12 C01220912210 ; ATHQ[2] = 4.321594849688346708841188057241308805551E512211 F883D6 4B 52 86 98 30 .DB $4B,$52,$86,$98,$30,$13,$CC,$A2,$B313 CC A2 B312212 F883DF 8F 5C DD 84 EF .DB $8F,$5C,$DD,$84,$EF,$03,$D3,$11,$4003 D3 11 401221312214 ; ATHQ[1] = -1.894075056489862952285849974761239845873E512215 F883E8 03 9B EB F1 8F .DB $03,$9B,$EB,$F1,$8F,$F5,$F9,$11,$30F5 F9 11 3012216 F883F1 D9 90 8D 5C E0 .DB $D9,$90,$8D,$5C,$E0,$F7,$B8,$10,$C0F7 B8 10 C01221712218 ; ATHQ[0] = 3.566703246701993219338856038092901974725E412219 F883FA 02 11 F8 BB 8C .DB $02,$11,$F8,$BB,$8C,$C6,$C6,$89,$AEC6 C6 89 AE12220 F88403 CE 34 C2 4F 08 .DB $CE,$34,$C2,$4F,$08,$53,$8B,$0E,$4053 8B 0E 401222112222 ;---------------------------------------------------------------------------12223 ; moving routines to/from fac/arg12224 ;---------------------------------------------------------------------------1222512226 ; temporary registers tfr0..tfr5 are 20-bytes-sized register that can hold the12227 ; full size 128 bits mantissa, the exponent, the sign and the byte statusTue Jul 17 11:00:18 2018 Page 1791222812229 ; move arg to fac12230 ;------12231 F8840C mvatof:12232 ;------12233 F8840C INDEX1612234 F8840C C2 10 rep #PXFLAG12235 .LONGI on12236 .MNLIST12237 F8840E A6 2A ldx argm12238 F88410 86 12 stx facm12239 F88412 A6 2C ldx argm+212240 F88414 86 14 stx facm+212241 F88416 A6 2E ldx argm+412242 F88418 86 16 stx facm+412243 F8841A A6 30 ldx argm+612244 F8841C 86 18 stx facm+612245 F8841E A6 32 ldx argm+812246 F88420 86 1A stx facm+812247 F88422 A6 34 ldx argm+1012248 F88424 86 1C stx facm+1012249 F88426 A6 36 ldx argm+1212250 F88428 86 1E stx facm+1212251 F8842A A6 38 ldx argm+1412252 F8842C 86 20 stx facm+1412253 F8842E A6 3A ldx argexp12254 F88430 86 22 stx facexp12255 F88432 A6 3C ldx argsgn12256 F88434 86 24 stx facsgn12257 F88436 INDEX0812258 F88436 E2 10 sep #PXFLAG12259 .LONGI off12260 .MNLIST12261 F88438 60 rts1226212263 ; move fac to arg12264 ;------12265 F88439 mvftoa:12266 ;------12267 F88439 INDEX1612268 F88439 C2 10 rep #PXFLAG12269 .LONGI on12270 .MNLIST12271 F8843B A6 12 ldx facm12272 F8843D 86 2A stx argm12273 F8843F A6 14 ldx facm+212274 F88441 86 2C stx argm+212275 F88443 A6 16 ldx facm+412276 F88445 86 2E stx argm+412277 F88447 A6 18 ldx facm+612278 F88449 86 30 stx argm+612279 F8844B A6 1A ldx facm+812280 F8844D 86 32 stx argm+812281 F8844F A6 1C ldx facm+1012282 F88451 86 34 stx argm+1012283 F88453 A6 1E ldx facm+1212284 F88455 86 36 stx argm+12Tue Jul 17 11:00:18 2018 Page 18012285 F88457 A6 20 ldx facm+1412286 F88459 86 38 stx argm+1412287 F8845B A6 22 ldx facexp12288 F8845D 86 3A stx argexp12289 F8845F A6 24 ldx facsgn12290 F88461 86 3C stx argsgn12291 F88463 INDEX0812292 F88463 E2 10 sep #PXFLAG12293 .LONGI off12294 .MNLIST12295 F88465 60 rts1229612297 ; move fac to temp. reg. tfr012298 ;------12299 F88466 mvf_t0:12300 ;------12301 F88466 ACC1612302 F88466 C2 20 rep #PMFLAG12303 .LONGA on12304 .MNLIST12305 F88468 A5 12 lda facm12306 F8846A 85 50 sta tfr012307 F8846C A5 14 lda facm+212308 F8846E 85 52 sta tfr0+212309 F88470 A5 16 lda facm+412310 F88472 85 54 sta tfr0+412311 F88474 A5 18 lda facm+612312 F88476 85 56 sta tfr0+612313 F88478 A5 1A lda facm+812314 F8847A 85 58 sta tfr0+812315 F8847C A5 1C lda facm+1012316 F8847E 85 5A sta tfr0+1012317 F88480 A5 1E lda facm+1212318 F88482 85 5C sta tfr0+1212319 F88484 A5 20 lda facm+1412320 F88486 85 5E sta tfr0+1412321 F88488 A5 22 lda facexp12322 F8848A 85 60 sta tfr0+1612323 F8848C A5 24 lda facsgn12324 F8848E 85 62 sta tfr0+1812325 F88490 ACC0812326 F88490 E2 20 sep #PMFLAG12327 .LONGA off12328 .MNLIST12329 F88492 60 rts1233012331 ; move fac to temp. reg. tfr112332 ;------12333 F88493 mvf_t1:12334 ;------12335 F88493 ACC1612336 F88493 C2 20 rep #PMFLAG12337 .LONGA on12338 .MNLIST12339 F88495 A5 12 lda facm12340 F88497 85 64 sta tfr112341 F88499 A5 14 lda facm+2Tue Jul 17 11:00:18 2018 Page 18112342 F8849B 85 66 sta tfr1+212343 F8849D A5 16 lda facm+412344 F8849F 85 68 sta tfr1+412345 F884A1 A5 18 lda facm+612346 F884A3 85 6A sta tfr1+612347 F884A5 A5 1A lda facm+812348 F884A7 85 6C sta tfr1+812349 F884A9 A5 1C lda facm+1012350 F884AB 85 6E sta tfr1+1012351 F884AD A5 1E lda facm+1212352 F884AF 85 70 sta tfr1+1212353 F884B1 A5 20 lda facm+1412354 F884B3 85 72 sta tfr1+1412355 F884B5 A5 22 lda facexp12356 F884B7 85 74 sta tfr1+1612357 F884B9 A5 24 lda facsgn12358 F884BB 85 76 sta tfr1+1812359 F884BD ACC0812360 F884BD E2 20 sep #PMFLAG12361 .LONGA off12362 .MNLIST12363 F884BF 60 rts1236412365 ; move fac to temp. reg. tfr212366 ;------12367 F884C0 mvf_t2:12368 ;------12369 F884C0 ACC1612370 F884C0 C2 20 rep #PMFLAG12371 .LONGA on12372 .MNLIST12373 F884C2 A5 12 lda facm12374 F884C4 85 78 sta tfr212375 F884C6 A5 14 lda facm+212376 F884C8 85 7A sta tfr2+212377 F884CA A5 16 lda facm+412378 F884CC 85 7C sta tfr2+412379 F884CE A5 18 lda facm+612380 F884D0 85 7E sta tfr2+612381 F884D2 A5 1A lda facm+812382 F884D4 85 80 sta tfr2+812383 F884D6 A5 1C lda facm+1012384 F884D8 85 82 sta tfr2+1012385 F884DA A5 1E lda facm+1212386 F884DC 85 84 sta tfr2+1212387 F884DE A5 20 lda facm+1412388 F884E0 85 86 sta tfr2+1412389 F884E2 A5 22 lda facexp12390 F884E4 85 88 sta tfr2+1612391 F884E6 A5 24 lda facsgn12392 F884E8 85 8A sta tfr2+1812393 F884EA ACC0812394 F884EA E2 20 sep #PMFLAG12395 .LONGA off12396 .MNLIST12397 F884EC 60 rts12398Tue Jul 17 11:00:18 2018 Page 18212399 ; move fac to temp. reg. tfr312400 ;------12401 F884ED mvf_t3:12402 ;------12403 F884ED ACC1612404 F884ED C2 20 rep #PMFLAG12405 .LONGA on12406 .MNLIST12407 F884EF A5 12 lda facm12408 F884F1 85 8C sta tfr312409 F884F3 A5 14 lda facm+212410 F884F5 85 8E sta tfr3+212411 F884F7 A5 16 lda facm+412412 F884F9 85 90 sta tfr3+412413 F884FB A5 18 lda facm+612414 F884FD 85 92 sta tfr3+612415 F884FF A5 1A lda facm+812416 F88501 85 94 sta tfr3+812417 F88503 A5 1C lda facm+1012418 F88505 85 96 sta tfr3+1012419 F88507 A5 1E lda facm+1212420 F88509 85 98 sta tfr3+1212421 F8850B A5 20 lda facm+1412422 F8850D 85 9A sta tfr3+1412423 F8850F A5 22 lda facexp12424 F88511 85 9C sta tfr3+1612425 F88513 A5 24 lda facsgn12426 F88515 85 9E sta tfr3+1812427 F88517 ACC0812428 F88517 E2 20 sep #PMFLAG12429 .LONGA off12430 .MNLIST12431 F88519 60 rts1243212433 ; move arg to temp. reg. tfr012434 ;------12435 F8851A mva_t0:12436 ;------12437 F8851A ACC1612438 F8851A C2 20 rep #PMFLAG12439 .LONGA on12440 .MNLIST12441 F8851C A5 2A lda argm12442 F8851E 85 50 sta tfr012443 F88520 A5 2C lda argm+212444 F88522 85 52 sta tfr0+212445 F88524 A5 2E lda argm+412446 F88526 85 54 sta tfr0+412447 F88528 A5 30 lda argm+612448 F8852A 85 56 sta tfr0+612449 F8852C A5 32 lda argm+812450 F8852E 85 58 sta tfr0+812451 F88530 A5 34 lda argm+1012452 F88532 85 5A sta tfr0+1012453 F88534 A5 36 lda argm+1212454 F88536 85 5C sta tfr0+1212455 F88538 A5 38 lda argm+14Tue Jul 17 11:00:18 2018 Page 18312456 F8853A 85 5E sta tfr0+1412457 F8853C A5 3A lda argexp12458 F8853E 85 60 sta tfr0+1612459 F88540 A5 3C lda argsgn12460 F88542 85 62 sta tfr0+1812461 F88544 ACC0812462 F88544 E2 20 sep #PMFLAG12463 .LONGA off12464 .MNLIST12465 F88546 60 rts1246612467 ; move temp. reg. tfr0 to fac12468 ;------12469 F88547 mvt0_f:12470 ;------12471 F88547 ACC1612472 F88547 C2 20 rep #PMFLAG12473 .LONGA on12474 .MNLIST12475 F88549 A5 50 lda tfr012476 F8854B 85 12 sta facm12477 F8854D A5 52 lda tfr0+212478 F8854F 85 14 sta facm+212479 F88551 A5 54 lda tfr0+412480 F88553 85 16 sta facm+412481 F88555 A5 56 lda tfr0+612482 F88557 85 18 sta facm+612483 F88559 A5 58 lda tfr0+812484 F8855B 85 1A sta facm+812485 F8855D A5 5A lda tfr0+1012486 F8855F 85 1C sta facm+1012487 F88561 A5 5C lda tfr0+1212488 F88563 85 1E sta facm+1212489 F88565 A5 5E lda tfr0+1412490 F88567 85 20 sta facm+1412491 F88569 A5 60 lda tfr0+1612492 F8856B 85 22 sta facexp12493 F8856D A5 62 lda tfr0+1812494 F8856F 85 24 sta facsgn12495 F88571 ACC0812496 F88571 E2 20 sep #PMFLAG12497 .LONGA off12498 .MNLIST12499 F88573 60 rts1250012501 ; move temp. reg. tfr1 to fac12502 ;------12503 F88574 mvt1_f:12504 ;------12505 F88574 ACC1612506 F88574 C2 20 rep #PMFLAG12507 .LONGA on12508 .MNLIST12509 F88576 A5 64 lda tfr112510 F88578 85 12 sta facm12511 F8857A A5 66 lda tfr1+212512 F8857C 85 14 sta facm+2Tue Jul 17 11:00:18 2018 Page 18412513 F8857E A5 68 lda tfr1+412514 F88580 85 16 sta facm+412515 F88582 A5 6A lda tfr1+612516 F88584 85 18 sta facm+612517 F88586 A5 6C lda tfr1+812518 F88588 85 1A sta facm+812519 F8858A A5 6E lda tfr1+1012520 F8858C 85 1C sta facm+1012521 F8858E A5 70 lda tfr1+1212522 F88590 85 1E sta facm+1212523 F88592 A5 72 lda tfr1+1412524 F88594 85 20 sta facm+1412525 F88596 A5 74 lda tfr1+1612526 F88598 85 22 sta facexp12527 F8859A A5 76 lda tfr1+1812528 F8859C 85 24 sta facsgn12529 F8859E ACC0812530 F8859E E2 20 sep #PMFLAG12531 .LONGA off12532 .MNLIST12533 F885A0 60 rts1253412535 ; move temp. reg. tfr2 to fac12536 ;------12537 F885A1 mvt2_f:12538 ;------12539 F885A1 ACC1612540 F885A1 C2 20 rep #PMFLAG12541 .LONGA on12542 .MNLIST12543 F885A3 A5 78 lda tfr212544 F885A5 85 12 sta facm12545 F885A7 A5 7A lda tfr2+212546 F885A9 85 14 sta facm+212547 F885AB A5 7C lda tfr2+412548 F885AD 85 16 sta facm+412549 F885AF A5 7E lda tfr2+612550 F885B1 85 18 sta facm+612551 F885B3 A5 80 lda tfr2+812552 F885B5 85 1A sta facm+812553 F885B7 A5 82 lda tfr2+1012554 F885B9 85 1C sta facm+1012555 F885BB A5 84 lda tfr2+1212556 F885BD 85 1E sta facm+1212557 F885BF A5 86 lda tfr2+1412558 F885C1 85 20 sta facm+1412559 F885C3 A5 88 lda tfr2+1612560 F885C5 85 22 sta facexp12561 F885C7 A5 8A lda tfr2+1812562 F885C9 85 24 sta facsgn12563 F885CB ACC0812564 F885CB E2 20 sep #PMFLAG12565 .LONGA off12566 .MNLIST12567 F885CD 60 rts12568 F885CE12569 ; move temp. reg. tfr0 to argTue Jul 17 11:00:18 2018 Page 18512570 ;------12571 F885CE mvt0_a:12572 ;------12573 F885CE ACC1612574 F885CE C2 20 rep #PMFLAG12575 .LONGA on12576 .MNLIST12577 F885D0 A5 50 lda tfr012578 F885D2 85 2A sta argm12579 F885D4 A5 52 lda tfr0+212580 F885D6 85 2C sta argm+212581 F885D8 A5 54 lda tfr0+412582 F885DA 85 2E sta argm+412583 F885DC A5 56 lda tfr0+612584 F885DE 85 30 sta argm+612585 F885E0 A5 58 lda tfr0+812586 F885E2 85 32 sta argm+812587 F885E4 A5 5A lda tfr0+1012588 F885E6 85 34 sta argm+1012589 F885E8 A5 5C lda tfr0+1212590 F885EA 85 36 sta argm+1212591 F885EC A5 5E lda tfr0+1412592 F885EE 85 38 sta argm+1412593 F885F0 A5 60 lda tfr0+1612594 F885F2 85 3A sta argexp12595 F885F4 A5 62 lda tfr0+1812596 F885F6 85 3C sta argsgn12597 F885F8 ACC0812598 F885F8 E2 20 sep #PMFLAG12599 .LONGA off12600 .MNLIST12601 F885FA 60 rts1260212603 ; move temp. reg. tfr1 to arg12604 ;------12605 F885FB mvt1_a:12606 ;------12607 F885FB ACC1612608 F885FB C2 20 rep #PMFLAG12609 .LONGA on12610 .MNLIST12611 F885FD A5 64 lda tfr112612 F885FF 85 2A sta argm12613 F88601 A5 66 lda tfr1+212614 F88603 85 2C sta argm+212615 F88605 A5 68 lda tfr1+412616 F88607 85 2E sta argm+412617 F88609 A5 6A lda tfr1+612618 F8860B 85 30 sta argm+612619 F8860D A5 6C lda tfr1+812620 F8860F 85 32 sta argm+812621 F88611 A5 6E lda tfr1+1012622 F88613 85 34 sta argm+1012623 F88615 A5 70 lda tfr1+1212624 F88617 85 36 sta argm+1212625 F88619 A5 72 lda tfr1+1412626 F8861B 85 38 sta argm+14Tue Jul 17 11:00:18 2018 Page 18612627 F8861D A5 74 lda tfr1+1612628 F8861F 85 3A sta argexp12629 F88621 A5 76 lda tfr1+1812630 F88623 85 3C sta argsgn12631 F88625 ACC0812632 F88625 E2 20 sep #PMFLAG12633 .LONGA off12634 .MNLIST12635 F88627 60 rts1263612637 ; move temp. reg. tfr2 to arg12638 ;------12639 F88628 mvt2_a:12640 ;------12641 F88628 ACC1612642 F88628 C2 20 rep #PMFLAG12643 .LONGA on12644 .MNLIST12645 F8862A A5 78 lda tfr212646 F8862C 85 2A sta argm12647 F8862E A5 7A lda tfr2+212648 F88630 85 2C sta argm+212649 F88632 A5 7C lda tfr2+412650 F88634 85 2E sta argm+412651 F88636 A5 7E lda tfr2+612652 F88638 85 30 sta argm+612653 F8863A A5 80 lda tfr2+812654 F8863C 85 32 sta argm+812655 F8863E A5 82 lda tfr2+1012656 F88640 85 34 sta argm+1012657 F88642 A5 84 lda tfr2+1212658 F88644 85 36 sta argm+1212659 F88646 A5 86 lda tfr2+1412660 F88648 85 38 sta argm+1412661 F8864A A5 88 lda tfr2+1612662 F8864C 85 3A sta argexp12663 F8864E A5 8A lda tfr2+1812664 F88650 85 3C sta argsgn12665 F88652 ACC0812666 F88652 E2 20 sep #PMFLAG12667 .LONGA off12668 .MNLIST12669 F88654 60 rts1267012671 ; move temp. reg. tfr3 to arg12672 ;------12673 F88655 mvt3_a:12674 ;------12675 F88655 ACC1612676 F88655 C2 20 rep #PMFLAG12677 .LONGA on12678 .MNLIST12679 F88657 A5 8C lda tfr312680 F88659 85 2A sta argm12681 F8865B A5 8E lda tfr3+212682 F8865D 85 2C sta argm+212683 F8865F A5 90 lda tfr3+4Tue Jul 17 11:00:18 2018 Page 18712684 F88661 85 2E sta argm+412685 F88663 A5 92 lda tfr3+612686 F88665 85 30 sta argm+612687 F88667 A5 94 lda tfr3+812688 F88669 85 32 sta argm+812689 F8866B A5 96 lda tfr3+1012690 F8866D 85 34 sta argm+1012691 F8866F A5 98 lda tfr3+1212692 F88671 85 36 sta argm+1212693 F88673 A5 9A lda tfr3+1412694 F88675 85 38 sta argm+1412695 F88677 A5 9C lda tfr3+1612696 F88679 85 3A sta argexp12697 F8867B A5 9E lda tfr3+1812698 F8867D 85 3C sta argsgn12699 F8867F ACC0812700 F8867F E2 20 sep #PMFLAG12701 .LONGA off12702 .MNLIST12703 F88681 60 rts1270412705 ; ldfac - load fac with a constant K stored in program memory12706 ;12707 ; entry:12708 ; A = low address of constant K12709 ; Y = high address of constant K12710 ;12711 ; exit:12712 ; fac = K12713 ;12714 ; This routine is used internally and not intended for end use.12715 ; Constant are stored unpacked, and with full size 128 bits mantissa,12716 ; in program memory segment(the code segment that hold this routine).12717 ;12718 ;-----12719 F88682 ldfac:12720 ;-----12721 F88682 85 42 sta fcp ; set long pointer to K12722 F88684 84 43 sty fcp+112723 F88686 A9 F8 lda #.SEG.ldfac12724 F88688 85 44 sta fcp+212725 F8868A A2 00 ldx #012726 F8868C 86 25 stx facst ; always assume valid K12727 F8868E ACC1612728 F8868E C2 20 rep #PMFLAG12729 .LONGA on12730 .MNLIST12731 F88690 A7 42 lda [fcp] ; set mantissa12732 F88692 85 12 sta facm12733 F88694 A0 02 ldy #212734 F88696 B7 42 lda [fcp],y12735 F88698 85 14 sta facm+212736 F8869A A0 04 ldy #412737 F8869C B7 42 lda [fcp],y12738 F8869E 85 16 sta facm+412739 F886A0 A0 06 ldy #612740 F886A2 B7 42 lda [fcp],yTue Jul 17 11:00:18 2018 Page 18812741 F886A4 85 18 sta facm+612742 F886A6 A0 08 ldy #812743 F886A8 B7 42 lda [fcp],y12744 F886AA 85 1A sta facm+812745 F886AC A0 0A ldy #1012746 F886AE B7 42 lda [fcp],y12747 F886B0 85 1C sta facm+1012748 F886B2 A0 0C ldy #1212749 F886B4 B7 42 lda [fcp],y12750 F886B6 85 1E sta facm+1212751 F886B8 A0 0E ldy #1412752 F886BA B7 42 lda [fcp],y12753 F886BC 85 20 sta facm+1412754 F886BE A0 10 ldy #1612755 F886C0 B7 42 lda [fcp],y12756 F886C2 10 01 bpl ?p12757 F886C4 CA dex12758 F886C5 29 FF 7F ?p: and #$7FFF12759 F886C8 85 22 sta facexp ; set exponent12760 F886CA ACC0812761 F886CA E2 20 sep #PMFLAG12762 .LONGA off12763 .MNLIST12764 F886CC 86 24 stx facsgn ; set sign12765 F886CE 60 rts12766 F886CF12767 ; ldarg - load arg with a constant K stored in program memory12768 ;12769 ; entry:12770 ; A = low address of constant K12771 ; Y = high address of constant K12772 ;12773 ; exit:12774 ; arg = K12775 ;12776 ; This routine is used internally and not intended for end use.12777 ; Constant are stored unpacked, and with full size 128 bits mantissa,12778 ; in program memory segment(the code segment that hold this routine).12779 ;12780 F886CF ldarg:12781 F886CF 85 42 sta fcp ; set long pointer to K12782 F886D1 84 43 sty fcp+112783 F886D3 A9 F8 lda #.SEG.ldarg12784 F886D5 85 44 sta fcp+21278512786 ; ldarg2 - entry if long pointer fcp was already set12787 F886D7 ldarg2:12788 F886D7 A2 00 ldx #012789 F886D9 86 3D stx argst ; always assume valid K12790 F886DB ACC1612791 F886DB C2 20 rep #PMFLAG12792 .LONGA on12793 .MNLIST12794 F886DD A7 42 lda [fcp] ; set mantissa12795 F886DF 85 2A sta argm12796 F886E1 A0 02 ldy #212797 F886E3 B7 42 lda [fcp],yTue Jul 17 11:00:18 2018 Page 18912798 F886E5 85 2C sta argm+212799 F886E7 A0 04 ldy #412800 F886E9 B7 42 lda [fcp],y12801 F886EB 85 2E sta argm+412802 F886ED A0 06 ldy #612803 F886EF B7 42 lda [fcp],y12804 F886F1 85 30 sta argm+612805 F886F3 A0 08 ldy #812806 F886F5 B7 42 lda [fcp],y12807 F886F7 85 32 sta argm+812808 F886F9 A0 0A ldy #1012809 F886FB B7 42 lda [fcp],y12810 F886FD 85 34 sta argm+1012811 F886FF A0 0C ldy #1212812 F88701 B7 42 lda [fcp],y12813 F88703 85 36 sta argm+1212814 F88705 A0 0E ldy #1412815 F88707 B7 42 lda [fcp],y12816 F88709 85 38 sta argm+1412817 F8870B A0 10 ldy #1612818 F8870D B7 42 lda [fcp],y12819 F8870F 10 01 bpl ?p12820 F88711 CA dex12821 F88712 29 FF 7F ?p: and #$7FFF12822 F88715 85 3A sta argexp ; set exponent12823 F88717 ACC0812824 F88717 E2 20 sep #PMFLAG12825 .LONGA off12826 .MNLIST12827 F88719 86 3C stx argsgn ; set sign12828 F8871B 60 rts1282912830 ;----------------------------------------------------------------------------12831 ; polynomial evaluatation12832 ;----------------------------------------------------------------------------1283312834 ; peval - evaluate polynomial of degree N12835 ;12836 ; entry:12837 ; A = low address of coefficient C12838 ; N12839 ;12840 ; Y = high address of coefficient C12841 ; N12842 ; X = degree (N)12843 ; tfr0 = x (temp. register #0)12844 ;12845 ; exit: 2 N12846 ; fac = y = C + C x + C x +...+ C x12847 ; 0 1 2 N12848 ;12849 ; Constant Cn..C0 are stored unpacked, and with full size 128 bits mantissa,12850 ; in program memory segment(the code segment that hold this routine), from12851 ; the highest order Cn to lowest order C0.12852 ;12853 ;-----12854 F8871C peval:Tue Jul 17 11:00:18 2018 Page 19012855 ;-----12856 F8871C 86 4B stx pdeg12857 F8871E 20 82 86 jsr ldfac ; fac=coefficient Cn12858 F88721 20 CE 85 ?lp: jsr mvt0_a ; arg=tfr012859 F88724 20 DD 49 jsr fpmult ; multiplies by x12860 F88727 ACC16CLC12861 F88727 C2 21 rep #(PMFLAG.OR.PCFLAG)12862 .LONGA on12863 .MNLIST12864 F88729 A5 42 lda fcp ; next coefficient12865 F8872B 69 12 00 adc #FCSIZ12866 F8872E 85 42 sta fcp12867 F88730 ACC0812868 F88730 E2 20 sep #PMFLAG12869 .LONGA off12870 .MNLIST12871 F88732 20 7A 45 jsr fcadd ; add coefficient Ck12872 F88735 C6 4B dec pdeg12873 F88737 D0 E8 bne ?lp12874 F88739 60 rts1287512876 ; pevalp1 - evaluate polynomial of degree N+112877 ;12878 ; entry:12879 ; A = low address of coefficient C12880 ; N12881 ;12882 ; Y = high address of coefficient C12883 ; N12884 ; X = degree - 1 (N)12885 ; tfr0 = x (temp. register #0)12886 ;12887 ; exit: 2 N N+112888 ; fac = y = C + C x + C x +...+ C x + x12889 ; 0 1 2 N12890 ;12891 ; Constant Cn..C0 are stored unpacked, and with full size 128 bits mantissa,12892 ; in program memory segment(the code segment that hold this routine), from12893 ; the highest order Cn to lowest order C0.12894 ;12895 ;-------12896 F8873A pevalp1:12897 ;-------12898 F8873A 86 4B stx pdeg12899 F8873C 20 82 86 jsr ldfac ; coefficient Cn12900 F8873F 20 CE 85 jsr mvt0_a ; arg=tfr012901 F88742 20 7D 45 jsr fpadd ; x + Cn12902 F88745 20 CE 85 ?lp: jsr mvt0_a ; loop12903 F88748 20 DD 49 jsr fpmult ; multiplies by x12904 F8874B ACC16CLC12905 F8874B C2 21 rep #(PMFLAG.OR.PCFLAG)12906 .LONGA on12907 .MNLIST12908 F8874D A5 42 lda fcp ; next coefficient12909 F8874F 69 12 00 adc #FCSIZ12910 F88752 85 42 sta fcp12911 F88754 ACC08Tue Jul 17 11:00:18 2018 Page 19112912 F88754 E2 20 sep #PMFLAG12913 .LONGA off12914 .MNLIST12915 F88756 20 7A 45 jsr fcadd ; add coefficient Ck12916 F88759 C6 4B dec pdeg12917 F8875B D0 E8 bne ?lp12918 F8875D 60 rts1291912920 ;----------------------------------------------------------------------------12921 ; utilities & helper routines12922 ;----------------------------------------------------------------------------1292312924 ; fccmp - compare fac versus a constant stored in program memory12925 ;12926 ; entry:12927 ; fac = x12928 ; A = low address of constant K12929 ; Y = high address of constant K12930 ;12931 ; exit:12932 ; if fac < K: ZF=0,NF=112933 ; if fac = K: ZF=1,NF=012934 ; if fac > K: ZF=0,NF=012935 ;12936 ; This routine is used internally and not intended for end use.12937 ; Constant are stored unpacked, and with full size 128 bits mantissa,12938 ; in program memory segment(the code segment that hold this routine).12939 ;12940 ;-----12941 F8875E fccmp:12942 ;-----12943 F8875E 85 42 sta fcp ; set long pointer to K12944 F88760 84 43 sty fcp+112945 F88762 A9 F8 lda #.SEG.fccmp12946 F88764 85 44 sta fcp+212947 F88766 A0 11 ldy #1712948 F88768 B7 42 lda [fcp],y ; K sign12949 F8876A 45 24 eor facsgn ; compare with fac sign12950 F8876C 10 04 bpl ?same ; sign match12951 F8876E A5 24 lda facsgn ; sign unmatch so return...12952 F88770 80 54 bra ?sgn ; ...fac sign12953 F88772 ?same: ACC1612954 F88772 C2 20 rep #PMFLAG12955 .LONGA on12956 .MNLIST12957 F88774 88 dey12958 F88775 B7 42 lda [fcp],y ; biased exponent12959 F88777 29 FF 7F and #$7FFF ; mask off sign12960 F8877A C5 22 cmp facexp12961 F8877C 90 3E bcc ?chk ; fac > K (CF=0)12962 F8877E D0 3C bne ?chk ; fac < K (CF=1)12963 F88780 A0 0E ldy #14 ; same exponent so now compare mantissa12964 F88782 B7 42 lda [fcp],y12965 F88784 C5 20 cmp facm+1412966 F88786 D0 34 bne ?chk ; CF=0 if fac>K else CF=1 if fac<K12967 F88788 A0 0C ldy #1212968 F8878A B7 42 lda [fcp],yTue Jul 17 11:00:18 2018 Page 19212969 F8878C C5 1E cmp facm+1212970 F8878E D0 2C bne ?chk12971 F88790 A0 0A ldy #1012972 F88792 B7 42 lda [fcp],y12973 F88794 C5 1C cmp facm+1012974 F88796 D0 24 bne ?chk12975 F88798 A0 08 ldy #812976 F8879A B7 42 lda [fcp],y12977 F8879C C5 1A cmp facm+812978 F8879E D0 1C bne ?chk12979 F887A0 A0 06 ldy #612980 F887A2 B7 42 lda [fcp],y12981 F887A4 C5 18 cmp facm+612982 F887A6 D0 14 bne ?chk12983 F887A8 A0 04 ldy #412984 F887AA B7 42 lda [fcp],y12985 F887AC C5 16 cmp facm+412986 F887AE D0 0C bne ?chk12987 F887B0 A0 02 ldy #212988 F887B2 B7 42 lda [fcp],y12989 F887B4 C5 14 cmp facm+212990 F887B6 D0 04 bne ?chk12991 F887B8 A7 42 lda [fcp]12992 F887BA C5 12 cmp facm12993 F887BC ?chk: ACC0812994 F887BC E2 20 sep #PMFLAG12995 .LONGA off12996 .MNLIST12997 F887BE F0 0D beq ?done ; fac=K so return ZF=112998 F887C0 A5 24 lda facsgn12999 F887C2 90 02 bcc ?sgn ; fac>K13000 F887C4 49 FF eor #$FF ; invert sign (fac<K)13001 F887C6 2A ?sgn: rol a ; CF=sign13002 F887C7 A9 FF lda #$FF ; NF=1 if fac<K13003 F887C9 B0 02 bcs ?done13004 F887CB A9 01 lda #1 ; NF=0 if fac>K13005 F887CD 60 ?done: rts1300613007 ; signed multiplication 16 bit13008 ;13009 ; entry: C = multiplicand 1 16 bit13010 ; X = multiplicand 2 low byte13011 ; Y = multiplicand 2 high byte13012 ;13013 ; exit: C = result high word13014 ; X = result low-low byte13015 ; Y = result low-high byte13016 ;13017 ; call with A in 16 bit mode13018 ;13019 ;-----13020 F887CE imult:13021 ;-----13022 .LONGA on13023 .LONGI off1302413025 F887CE 85 BC sta mcand1 ; store mcand1&mcand2Tue Jul 17 11:00:18 2018 Page 19313026 F887D0 86 BE stx mcand213027 F887D2 84 BF sty mcand2+113028 F887D4 45 BE eor mcand2 ; sign of the result13029 F887D6 85 C0 sta mcsgn13030 F887D8 A2 00 ldx #013031 F887DA A4 BD ldy mcand1+113032 F887DC 10 06 bpl ?p1 ; mcand1 is positive13033 F887DE 38 sec13034 F887DF 8A txa13035 F887E0 E5 BC sbc mcand1 ; complement mcand113036 F887E2 85 BC sta mcand113037 F887E4 A4 BF ?p1: ldy mcand2+113038 F887E6 10 06 bpl ?p2 ; mcand2 is positive13039 F887E8 38 sec13040 F887E9 8A txa13041 F887EA E5 BE sbc mcand2 ; complement mcand213042 F887EC 85 BE sta mcand213043 F887EE 8A ?p2: txa ; clear high word of result13044 F887EF A2 11 ldx #17 ; 17 bit loop13045 F887F1 18 clc13046 F887F2 6A ?shr: ror a ; shift in any carry - high result13047 F887F3 66 BC ror mcand1 ; low result13048 F887F5 90 03 bcc ?no ; no add13049 F887F7 18 clc13050 F887F8 65 BE adc mcand213051 F887FA CA ?no: dex13052 F887FB D0 F5 bne ?shr ; repeat13053 F887FD 85 BE sta mcand2 ; store result high13054 F887FF 24 C0 bit mcsgn ; if result is positive...13055 F88801 10 09 bpl ?done ; ...done (C=result high)13056 F88803 8A txa13057 F88804 38 sec ; else complement result13058 F88805 E5 BC sbc mcand113059 F88807 85 BC sta mcand113060 F88809 8A txa13061 F8880A E5 BE sbc mcand2 ; C=result high word13062 F8880C A6 BC ?done: ldx mcand1 ; X=result low-low byte13063 F8880E A4 BD ldy mcand1+1 ; Y=result low-high byte13064 F88810 60 rts1306513066 .LONGA off1306713068 ; unsigned division 16 bit13069 ;13070 ; entry: C = 16 bit dividend13071 ; X = 16 bit divisor13072 ;13073 ; exit: C = 16 bit quotient13074 ; Y = 16 bits remainder13075 ;13076 ; use: all13077 ;13078 ; note: no check for null divisor13079 ;13080 ; call in 16 bit mode13081 ;-----13082 F88811 udiv:Tue Jul 17 11:00:18 2018 Page 19413083 ;-----13084 .LONGA on13085 .LONGI on1308613087 F88811 86 C2 stx dvsor ; divisor13088 F88813 A8 tay ; Y=dividend13089 F88814 64 C4 stz quot ; init quotient13090 F88816 8A txa ; C=divisor13091 F88817 A2 01 00 ldx #1 ; bit counter13092 F8881A 0A ?shd: asl a ; shift divisor: get leftmost bit13093 F8881B B0 06 bcs ?div ; go to division13094 F8881D E8 inx13095 F8881E E0 11 00 cpx #17 ; test all divisor bit's13096 F88821 D0 F7 bne ?shd13097 F88823 6A ?div: ror a ; put shifted-out bit back13098 F88824 85 C2 sta dvsor13099 F88826 98 ?sub: tya ; get dividend13100 F88827 38 sec13101 F88828 E5 C2 sbc dvsor13102 F8882A 90 01 bcc ?no ; can't subctract, retain old dividend13103 F8882C A8 tay ; Y=new dividend13104 F8882D 26 C4 ?no: rol quot ; shift carry into quotient (1 if division)13105 F8882F 46 C2 lsr dvsor ; shift right divisor for next subtract13106 F88831 CA dex13107 F88832 D0 F2 bne ?sub ; repeat13108 F88834 84 C2 sty dvsor ; store remainder13109 F88836 A5 C4 lda quot ; C=quotient13110 F88838 60 rts1311113112 .LONGA off13113 .LONGI off1311413115 0042DE CODESIZ .EQU $ - fcsub +11311613117 ; end of fileLines Assembled : 12356 Errors : 0