Subversion Repositories MB01 Project

Rev

Blame | Last modification | View Log | Download | RSS feed

  Tue Jul 17 11:00:18 2018                                                                                               Page    1







          2500 A.D. 65816 Macro Assembler #26960 - Version 5.02g
          -----------------------------------------------------

                       Input  Filename : src\F8\fpu.asm
                       Output Filename : obj\F8\fpu.obj
                       Listing Has Been Relocated                               


 2694                           .LIST           on
 2695                           
 2696                                   ;;.INCLUDE inc\p0.inc   
 2697  F8FFB1                           .INCLUDE inc\dpfpu.inc
 2698                           ;;
 2699                           ;; Copyright (c) 2016 Marco Granati <mg@unet.bz>
 2700                           ;;
 2701                           ;; Permission to use, copy, modify, and distribute this software for any
 2702                           ;; purpose with or without fee is hereby granted, provided that the above
 2703                           ;; copyright notice and this permission notice appear in all copies.
 2704                           ;;
 2705                           ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 2706                           ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 2707                           ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 2708                           ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 2709                           ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 2710                           ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 2711                           ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 2712                           ;;
 2713                           
 2714                           ;; name: dpfpu.inc      
 2715                           ;; rev.: 2016/03/30
 2716                           ;; o.s. 65C816 version v1.0
 2717                           
 2718                           .LIST on
 2719                           
 2720                           ; direct page for flotaing point unit
 2721                           _DPFPU: .SECTION page0, common, ref_only, offset 0      ;FPU D.P.
 2722                           
 2723          000080           MNTBITS         .EQU    (16*8)  ; significand bits + guard bits
 2724          000010           MANTSIZ         .EQU    16      ; significand size
 2725          000014           FREGSIZ         .EQU    20      ; floating point register size
 2726                           
 2727  000000                   tm              .DS     16      ; temp. mantissa
 2728                           
 2729  000010  00               fsubnf          .DB             ; subnormal flag used by fac2dec
 2730          000010           atncode         .EQU    fsubnf  ; fatanyx octant
 2731                           
 2732  000011  00               sgncmp          .DB             ; sign comparison: fac vs. arg
 2733                           
 2734                           ; floating Point accumulator (fac)
 2735  000012                   facm            .DS     16      ; guard bits (32 bits)+significand (80 bits)
 2736  000022  0000             facexp          .DW             ; fac biased exponent
 2737  000024  00               facsgn          .DB             ; fac mantissa sign
 2738  000025  00               facst           .DB             ; fac status for floating point
 2739                                                           ; <7>: 1 if fac is invalid (nan or inf)
  Tue Jul 17 11:00:18 2018                                                                                               Page    2




 2740                                                           ; <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'
 2744                           
 2745                                                           ; fac status for long integer
 2746                                                           ; <7>: 1 if facm will be regarded as 'signed'
 2747                                                           ; <6>: 1 if facm = 0
 2748                                                           ; <5>: always '1'
 2749                           
 2750  000026  0000             fexph           .DW             ; unbiased fac exponent sign extension
 2751  000028  0000             facext          .DW             ; fac guard bits extension
 2752          000028           wftmp2          .EQU    facext
 2753          000024           facsiz          .EQU    facsgn  ; integer only: size in bytes   
 2754                           
 2755                           ; floating point operand (arg)
 2756  00002A                   argm            .DS     16      ; guard bits (32 bits)+significand (80 bits)
 2757  00003A  0000             argexp          .DW             ; arg biased exponent
 2758  00003C  00               argsgn          .DB             ; arg mantissa sign
 2759  00003D  00               argst           .DB             ; arg status for floating point
 2760                                                           ; <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)
 2764                           
 2765                                                           ; arg status for long integer
 2766                                                           ; <7>: 1 if facm will be regarded as 'signed'
 2767                                                           ; <6>: 1 if facm = 0
 2768                                                           ; <5>: always '1'
 2769  00003E                                           
 2770  00003E  0000             aexph           .DW             ; unbiased arg exponent sign extension
 2771  000040  0000             argext          .DW
 2772                           
 2773          00003E           wftmp           .EQU    aexph   ; temp. word (int2dec, fpadd, fpsub)
 2774          00003C           argsiz          .EQU    argsgn  ; integer only: size in bytes   
 2775                           
 2776  000042                   fcp             LP              ; long pointer to flaot constants
 2777  000045  00               scsgn           .DB             ; scaling sign
 2778  000046  0000             scexp           .DW             ; scaling value
 2779  000048  0000             dexp            .DW             ; decimal exponent
 2780  00004A  00               dsgn            .DB             ; decimal float sign
 2781  00004B  00               pdeg            .DB             ; polyn. degree
 2782          00004B           powfg           .EQU    pdeg    ; flag used by fpowxy
 2783                           
 2784  00004C                   tlp             LP              ; string long pointer
 2785  00004F  00               fpidx           .DB             ; string index
 2786  000050                                   
 2787  000050                   tfr0            .DS     20      ; temp. float reg. 0
 2788  000064                   tfr1            .DS     20      ; temp. float reg. 1
 2789  000078                   tfr2            .DS     20      ; temp. float reg. 2
 2790  00008C                   tfr3            .DS     20      ; temp. float reg. 3
 2791  0000A0                   tfr4            .DS     20      ; temp. float reg. 4
 2792  0000B4                   tfr5            .DS     20      ; temp. float reg. 5
 2793  0000C8                                   .DS     4       ; used by xcvt: doesn't change
 2794                           
 2795          0000CB           XCVTEND         .EQU    ($ - 1) ; last byte of xcvt buffer
 2796                           
  Tue Jul 17 11:00:18 2018                                                                                               Page    3




 2797                           ; buffer used by decimal conversion (overlap tfr0&tfr1: 40 bytes)
 2798          000050           fpstr           .EQU    tfr0    ; 40 bytes buffer
 2799                           ; buffer used to format a decimal string
 2800          000078           xcvt            .EQU    tfr2    ; 84 bytes buffer
 2801                           
 2802          0000B4           fcpc0           .EQU    tfr5    ; constants pointer for exp. function
 2803          0000B6           fcpc1           .EQU    tfr5+2
 2804          0000B8           fcpc2           .EQU    tfr5+4
 2805          0000BA           fcpp            .EQU    tfr5+6
 2806          0000BC           fcpq            .EQU    tfr5+8
 2807          0000BE           fcpd            .EQU    tfr5+10
 2808          0000BF           fcqd            .EQU    tfr5+11
 2809          0000C0           fcpolf          .EQU    tfr5+12 ; polynomial flag
 2810                           
 2811          0000B4           tmdot           .EQU    tfr5    ; digit count after decimal dot
 2812          0000B6           tmpa            .EQU    tfr5+2  ; temp: save A&Y
 2813          0000B7           tmpy            .EQU    tfr5+3
 2814          0000B8           tmsgn           .EQU    tfr5+4  ; temp.: significand sign
 2815          0000B9           tmcnt           .EQU    tfr5+5  ; temp.: significand digits count
 2816          0000BA           tesgn           .EQU    tfr5+6  ; temp.: exponent sign 
 2817          0000BB           tecnt           .EQU    tfr5+7  ; temp.: exponent digits count
 2818                           
 2819          0000BC           mcand1          .EQU    tfr5+8  ; multiplicand's 
 2820          0000BE           mcand2          .EQU    tfr5+10
 2821          0000C0           mcsgn           .EQU    tfr5+12
 2822          0000C2           dvsor           .EQU    tfr5+14
 2823          0000C4           quot            .EQU    tfr5+16
 2824                           
 2825  0000CC  0000             fpprec          .DW             ; precision
 2826  0000CE  00               fpfmt           .DB             ; format
 2827  0000CF  00               fpaltf          .DB             ; alternate format
 2828  0000D0  00               fpcap           .DB             ; adding for lower case
 2829  0000D1  00               fpstyle         .DB             ; flag 'F' style
 2830          00004B           fpdot           .EQU    pdeg    ; decimal dot flag
 2831          0000CE           fpoct           .EQU    fpfmt   ; octant (circular func's)
 2832          0000CF           fpcsgn          .EQU    fpaltf  ; circular func's: argument sign
 2833          0000D0           fpcot           .EQU    fpcap   ; cotangent flag
 2834          0000D0           fpasin          .EQU    fpcap   ; asin flag
 2835                           
 2836  0000D2  00               dummy           .DB
 2837                           
 2838                                   .ENDS
 2847                           .LIST on
 2848                           
 2849          003FFF           EBIAS           .EQU    $3FFF           ; exponent bias
 2850          007FFF           INFEXP          .EQU    $7FFF           ; inf/nan biased exponent
 2851          008000           INFSND          .EQU    $8000           ; infinity high word significand
 2852          00C000           NANSND          .EQU    $C000           ; nan high word significand
 2853          007FFE           MAXEXP          .EQU    $7FFE           ; max. biased exponent
 2854          000071           SNBITS          .EQU    113             ; significand bits
 2855                           
 2856          004006           BIAS8           .EQU    (EBIAS + 7)     ; bias exponent for 8 bit integer
 2857          00400E           BIAS16          .EQU    (BIAS8 + 8)     ; bias exponent for 16 bit integer
 2858          00401E           BIAS32          .EQU    (BIAS16 + 16)   ; bias exponent for 32 bit integer
 2859          00403E           BIAS64          .EQU    (BIAS32 + 32)   ; bias exponent for 64 bit integer
 2860          00407E           BIAS128         .EQU    (BIAS64 + 64)   ; bias exponent for 128 bit integer
 2861          004037           BIAS56          .EQU    $4037           ; biased exponent of 2^56
  Tue Jul 17 11:00:18 2018                                                                                               Page    4




 2862                           ;EM30           .EQU    $3F9C           ; biased exponent of 1.578e-30
 2863                           ;EM20           .EQU    $3FBD           ; biased exponent of about 1e-20
 2864                           ;EM62           .EQU    $3F30           ; biased exponent of about 1e-62
 2865                           ;EP62           .EQU    $40CF           ; biased exponent of about 1e62
 2866          004D10           LOG2H           .EQU    19728           ; approximated log10(2) * $10000
 2867          000024           MAXDIGITS       .EQU    36              ; max. decimal digits
 2868          000026           EXP10           .EQU    38              ; decimal exponent for 128 bits integer 
 2869          FFFFFC           MINGEXP         .EQU    -4              ; min. decimal exponent 'G' format
 2870                           
 2871          FFFF81           MAXBSHIFT       .EQU    -MNTBITS + 1    ; max. shift mant.
 2872                           
 2873          000050           XCVTMAX         .EQU    80              ; max. size of decimal string
 2874                           
 2875                           ;---------------------------------------------------------------------------
 2876                           ; code segment -- bank $F8
 2877                           ;---------------------------------------------------------------------------
 2878                           
 2879                                   .CODEF8
 2880                                   .PUBLIC fpmult, ldfac, ldarg, mvftoa, int2dec, frndm, mvatof, scale10, str2fp
 2881                                   .PUBLIC uitrunc, imult, fp2dec, w2dec, fpack, funpack, str2fp2, mvf_t3, mvt3_a
 2882                                   .PUBLIC mvf_t1, mvt1_a, fpadd, fpsub, fpmult, fpdiv, fsqrt, flog10, flog10p1
 2883                                   .PUBLIC fcbrt, floge, flogep1, floor, fexp, fexp10, frexp, fscale, flog2, flog2p1
 2884                                   .PUBLIC fexp2, fexpm1, fpown, mvt1_f, frootn, fldinf, fldz, fpowxy, str2int
 2885                                   .PUBLIC uint2dec, fp2str, fsin, fcos, ftan, fcotan, fasin, facos, fatan
 2886                                   .PUBLIC ftrunc, fround, fceil, ui2dec, fpfrac, fsinh, fcosh, ftanh, fasinh, facosh
 2887                                   .PUBLIC fatanh, fpmod, fprem, fatanyx, int2str
 2888                           
 2889                                   .LONGA  off
 2890                                   .LONGI  off
 2891                           
 2892                           ;---------------------------------------------------------------------------
 2893                           ; addition & subtraction implementation
 2894                           ;---------------------------------------------------------------------------
 2895                           
 2896                           ; fcsub - subtract the argument from one constant stored in program memory
 2897                           ;
 2898                           ;       entry:
 2899                           ;               fac = x
 2900                           ;               A = low  address of constant K
 2901                           ;               Y = high address of constant K
 2902                           ;
 2903                           ;       exit:
 2904                           ;               fac = K - x
 2905                           ;
 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 - fac
 2915                           
 2916                           ; fpsub - subtract fac from arg and store result in fac
 2917                           ; main subtraction routine
 2918                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page    5




 2919                           ;       entry:
 2920                           ;               arg = x
 2921                           ;               fac = y
 2922                           ;               CF = 1 if invalid result(inf or nan)
 2923                           ;
 2924                           ;       exit:
 2925                           ;               fac = x - y
 2926                           ;
 2927                           ;-----
 2928  F8455F                   fpsub:
 2929                           ;-----
 2930  F8455F  A5 24                    lda     facsgn          ; change sign to fac...
 2931  F84561  49 FF                    eor     #$FF
 2932  F84563  85 24                    sta     facsgn
 2933  F84565  80 16                    bra     fpadd           ; and execute arg + (-fac)
 2934                           
 2935                           ; faddhalf - add 0.5 to the argument
 2936                           ;
 2937                           ;       entry:
 2938                           ;               fac = x
 2939                           ;
 2940                           ;       exit:
 2941                           ;               fac = x + 0.5
 2942                           ;
 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+fac
 2950                           
 2951                           ; faddone - add 1.0 to the argument
 2952                           ;
 2953                           ;       entry:
 2954                           ;               fac = x
 2955                           ;
 2956                           ;       exit:
 2957                           ;               fac = x + 1.0
 2958                           ;
 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+fac
 2966                           
 2967                           ; fsubone - subtract 1.0 from the argument
 2968                           ;
 2969                           ;       entry:
 2970                           ;               fac = x
 2971                           ;
 2972                           ;       exit:
 2973                           ;               fac = x - 1.0
 2974                           ;
 2975                           ; This routine is used internally and not intended for end use.
  Tue Jul 17 11:00:18 2018                                                                                               Page    6




 2976                           ;
 2977                           ;-------
 2978  F84571                   fsubone:
 2979                           ;-------
 2980  F84571  20 A6 4E                 jsr     ldaone          ; move constant K=1.0 to arg...
 2981  F84574  A9 FF                    lda     #$FF
 2982  F84576  85 3C                    sta     argsgn          ; ...change sign to arg...
 2983  F84578  80 03                    bra     fpadd           ; ...and execute arg+fac
 2984  F8457A                           
 2985                           ; fcadd - add the argument to one constant stored in program memory
 2986                           ;
 2987                           ;       entry:
 2988                           ;               fac = x
 2989                           ;               fcp = long pointer to the constant K
 2990                           ;
 2991                           ;       exit:
 2992                           ;               fac = K + x
 2993                           ;
 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 + fac
 3003                           
 3004                           ; fpadd: add fac to arg and store result in fac
 3005                           ; main addition routine
 3006                           ;
 3007                           ;       entry:
 3008                           ;               arg = x
 3009                           ;               fac = y
 3010                           ;
 3011                           ;       exit:
 3012                           ;               fac = x + y
 3013                           ;               CF = 1 if invalid result(inf or nan)
 3014                           ;
 3015                           ; The smallest operand will be aligned shifting to right the mantissa and
 3016                           ; incrementing the exponent until is equal to exponent of the greatest
 3017                           ; operand. After alignment, mantissa of fac is added to mantissa of arg if
 3018                           ; fac and arg have same sign, otherwise mantissa of the smallest operand will
 3019                           ; be subctracted from mantissa of the greatest one (except in the case that
 3020                           ; none of the operands has been shifted: in this case maybe need to change
 3021                           ; sign to result).
 3022                           ;
 3023                           ;-----
 3024  F8457D                   fpadd:
 3025                           ;-----
 3026  F8457D  20 41 48                 jsr     addtst          ; operands test: check for inf,nan, 0
 3027  F84580  A2 2A                    ldx     #argm           ; pointer to arg mantissa
 3028  F84582  A0 00                    ldy     #0
 3029  F84584                           ACC16
 3030  F84584  C2 20                    rep     #PMFLAG
 3031                                   .LONGA  on
 3032                                   .MNLIST
  Tue Jul 17 11:00:18 2018                                                                                               Page    7




 3033  F84586  38                       sec
 3034  F84587  A5 3A                    lda     argexp          ; now compute right shift count's to...
 3035  F84589  E5 22                    sbc     facexp          ; ...align mantissa's
 3036  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  F8458F                           
 3040                                   ; fac > arg so shift right fac mantissa - here CF=1, Y=0
 3041  F8458F  85 3E                    sta     wftmp           ; positive shift's count
 3042  F84591  A5 3A                    lda     argexp          ; result have same exp of arg...
 3043  F84593  85 22                    sta     facexp
 3044  F84595  A6 3C                    ldx     argsgn          ; ...and same sign of arg
 3045  F84597  86 24                    stx     facsgn
 3046  F84599  98                       tya                     ; remember here CF=1
 3047  F8459A  E5 3E                    sbc     wftmp           ; negative shift's count
 3048  F8459C  A2 12                    ldx     #facm           ; pointer to fac mantissa
 3049                           
 3050                           ?sh:    ; right shift mantissa pointed by X - here C=negative shift's count
 3051  F8459E  C9 81 FF                 cmp     #MAXBSHIFT      ; shift out whole significand?
 3052  F845A1  B0 12                    bcs     ?shm            ; no
 3053  F845A3  74 00                    stz     <0,x            ; clear mantissa whole mantissa
 3054  F845A5  74 02                    stz     <2,x
 3055  F845A7  74 04                    stz     <4,x
 3056  F845A9  74 06                    stz     <6,x
 3057  F845AB  74 08                    stz     <8,x
 3058  F845AD  74 0A                    stz     <10,x
 3059  F845AF  74 0C                    stz     <12,x
 3060  F845B1  74 0E                    stz     <14,x
 3061  F845B3  80 07                    bra     ?go             ; go to add/sub
 3062  F845B5                           
 3063  F845B5                   ?shm:   ACC08                   ; A=negative shift's count
 3064  F845B5  E2 20                    sep     #PMFLAG
 3065                                   .LONGA  off
 3066                                   .MNLIST
 3067  F845B7  20 3A 47                 jsr     shrmx           ; shift right mantissa pointed by X
 3068  F845BA                           ACC16
 3069  F845BA  C2 20                    rep     #PMFLAG
 3070                                   .LONGA  on
 3071                                   .MNLIST
 3072                           
 3073                                   ; add/sub aligned mantissa's
 3074  F845BC  A4 11            ?go:    ldy     sgncmp          ; fac & arg have same sign?
 3075  F845BE  10 4A                    bpl     ?add            ; yes, so add mantissa's
 3076                           
 3077                                   ; 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 shifted
 3080                           
 3081  F845C0  A0 12                    ldy     #facm
 3082  F845C2  E0 2A                    cpx     #argm
 3083  F845C4  F0 02                    beq     ?sub            ; mantissa_fac - mantissa_arg
 3084  F845C6  A0 2A                    ldy     #argm           ; mantissa_arg - mantissa_fac
 3085  F845C8  38               ?sub:   sec
 3086  F845C9  B9 00 3F                 lda     P0FPU,y
 3087  F845CC  F5 00                    sbc     <0,x
 3088  F845CE  85 12                    sta     facm
 3089  F845D0  B9 02 3F                 lda     P0FPU+2,y
  Tue Jul 17 11:00:18 2018                                                                                               Page    8




 3090  F845D3  F5 02                    sbc     <2,x
 3091  F845D5  85 14                    sta     facm+2
 3092  F845D7  B9 04 3F                 lda     P0FPU+4,y
 3093  F845DA  F5 04                    sbc     <4,x
 3094  F845DC  85 16                    sta     facm+4
 3095  F845DE  B9 06 3F                 lda     P0FPU+6,y
 3096  F845E1  F5 06                    sbc     <6,x
 3097  F845E3  85 18                    sta     facm+6
 3098  F845E5  B9 08 3F                 lda     P0FPU+8,y
 3099  F845E8  F5 08                    sbc     <8,x
 3100  F845EA  85 1A                    sta     facm+8
 3101  F845EC  B9 0A 3F                 lda     P0FPU+10,y
 3102  F845EF  F5 0A                    sbc     <10,x
 3103  F845F1  85 1C                    sta     facm+10
 3104  F845F3  B9 0C 3F                 lda     P0FPU+12,y
 3105  F845F6  F5 0C                    sbc     <12,x
 3106  F845F8  85 1E                    sta     facm+12
 3107  F845FA  B9 0E 3F                 lda     P0FPU+14,y
 3108  F845FD  F5 0E                    sbc     <14,x
 3109  F845FF  85 20                    sta     facm+14
 3110  F84601                           ACC08
 3111  F84601  E2 20                    sep     #PMFLAG
 3112                                   .LONGA  off
 3113                                   .MNLIST
 3114  F84603  B0 5D                    bcs     normfac         ; no borrow -- normalize fac
 3115  F84605                           
 3116                                   ; a borrow mean that result change sign so we should negate mantissa
 3117                                   ; this can happen just when operands have same exponent
 3118                           
 3119  F84605  20 04 47                 jsr     negfac          ; negate fac because result change sign
 3120  F84608  80 58                    bra     normfac         ; normalize fac  
 3121  F8460A                           
 3122  F8460A                   ?add:   ACC16CLC                ; add fac & arg mantissa's
 3123  F8460A  C2 21                    rep     #(PMFLAG.OR.PCFLAG)
 3124                                   .LONGA  on
 3125                                   .MNLIST
 3126  F8460C  A5 12                    lda     facm
 3127  F8460E  65 2A                    adc     argm
 3128  F84610  85 12                    sta     facm
 3129  F84612  A5 14                    lda     facm+2
 3130  F84614  65 2C                    adc     argm+2
 3131  F84616  85 14                    sta     facm+2
 3132  F84618  A5 16                    lda     facm+4
 3133  F8461A  65 2E                    adc     argm+4
 3134  F8461C  85 16                    sta     facm+4
 3135  F8461E  A5 18                    lda     facm+6
 3136  F84620  65 30                    adc     argm+6
 3137  F84622  85 18                    sta     facm+6
 3138  F84624  A5 1A                    lda     facm+8
 3139  F84626  65 32                    adc     argm+8
 3140  F84628  85 1A                    sta     facm+8
 3141  F8462A  A5 1C                    lda     facm+10
 3142  F8462C  65 34                    adc     argm+10
 3143  F8462E  85 1C                    sta     facm+10
 3144  F84630  A5 1E                    lda     facm+12
 3145  F84632  65 36                    adc     argm+12
 3146  F84634  85 1E                    sta     facm+12
  Tue Jul 17 11:00:18 2018                                                                                               Page    9




 3147  F84636  A5 20                    lda     facm+14
 3148  F84638  65 38                    adc     argm+14
 3149  F8463A  85 20                    sta     facm+14
 3150  F8463C  90 24                    bcc     normfac         ; normalize fac after addition
 3151  F8463E                           
 3152                                   ; the sum generate a carry so we add carry to fac       
 3153                           
 3154                           ; addcf - add a carry to fac
 3155                           ;
 3156                           ;       fac exponent will be incrementated and mantissa will be shifted
 3157                           ;       one place to right, and '1' is routed to the mantissa msb.
 3158                           ;       Note that this operation can cause overflow
 3159                           ;
 3160                           ; This routine is used internally and not intended for end use.
 3161                           ;
 3162                           ;-----
 3163  F8463E                   addcf:
 3164                           ;-----
 3165  F8463E                           ACC16
 3166  F8463E  C2 20                    rep     #PMFLAG
 3167                                   .LONGA  on
 3168                                   .MNLIST
 3169  F84640  A5 22                    lda     facexp
 3170  F84642  1A                       inc     a               ; increment exponent
 3171  F84643  C9 FF 7F                 cmp     #INFEXP         ; overflow?
 3172  F84646  90 03                    bcc     ?10             ; no
 3173  F84648  4C 7D 4E                 jmp     fldinf          ; yes, so set fac=inf
 3174  F8464B  85 22            ?10:    sta     facexp
 3175  F8464D  38                       sec                     ; msb=1
 3176  F8464E  66 20                    ror     facm+14         ; shift right mantissa one place
 3177  F84650  66 1E                    ror     facm+12
 3178  F84652  66 1C                    ror     facm+10 
 3179  F84654  66 1A                    ror     facm+8
 3180  F84656  66 18                    ror     facm+6
 3181  F84658  66 16                    ror     facm+4
 3182  F8465A  66 14                    ror     facm+2
 3183  F8465C  66 12                    ror     facm    
 3184  F8465E                           ACC08
 3185  F8465E  E2 20                    sep     #PMFLAG
 3186                                   .LONGA  off
 3187                                   .MNLIST
 3188  F84660  18                       clc                     ; return no error condition
 3189  F84661  60                       rts
 3190                           
 3191                           ; normfac - try to normalize fac after addition/subtraction or 
 3192                           ; while convert an integer to floting point
 3193                           ;
 3194                           ;       The msb of mantissa will be '1', except in the case of subnormal.
 3195                           ;       This normalitation is accomplished by shifting toward left
 3196                           ;       the significand until msb=1 or biased exponent=1; at any shift
 3197                           ;       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   10




 3204  F84662                           ACC16
 3205  F84662  C2 20                    rep     #PMFLAG
 3206                                   .LONGA  on
 3207                                   .MNLIST
 3208  F84664  A5 22                    lda     facexp
 3209  F84666  3A                       dec     a               ; exp=exp-1
 3210  F84667  F0 7D                    beq     chkz            ; fac have minimum biased exponent (1)
 3211  F84669  38                       sec
 3212  F8466A  A0 10                    ldy     #MANTSIZ
 3213  F8466C  A6 21            ?lp:    ldx     facm+15
 3214  F8466E  30 69                    bmi     ?end            ; already normalized: nothing to do
 3215  F84670  D0 53                    bne     ?shb            ; shift bit at bit
 3216  F84672  E9 08 00                 sbc     #8              ; can shift a whole byte?
 3217  F84675  90 47                    bcc     ?rst            ; no, restore exponent
 3218  F84677  A6 20                    ldx     facm+14         ; shift toward left byte at byte
 3219  F84679  86 21                    stx     facm+15 
 3220  F8467B  A6 1F                    ldx     facm+13
 3221  F8467D  86 20                    stx     facm+14 
 3222  F8467F  A6 1E                    ldx     facm+12
 3223  F84681  86 1F                    stx     facm+13 
 3224  F84683  A6 1D                    ldx     facm+11
 3225  F84685  86 1E                    stx     facm+12 
 3226  F84687  A6 1C                    ldx     facm+10
 3227  F84689  86 1D                    stx     facm+11 
 3228  F8468B  A6 1B                    ldx     facm+9
 3229  F8468D  86 1C                    stx     facm+10
 3230  F8468F  A6 1A                    ldx     facm+8
 3231  F84691  86 1B                    stx     facm+9
 3232  F84693  A6 19                    ldx     facm+7
 3233  F84695  86 1A                    stx     facm+8
 3234  F84697  A6 18                    ldx     facm+6
 3235  F84699  86 19                    stx     facm+7
 3236  F8469B  A6 17                    ldx     facm+5
 3237  F8469D  86 18                    stx     facm+6
 3238  F8469F  A6 16                    ldx     facm+4
 3239  F846A1  86 17                    stx     facm+5
 3240  F846A3  A6 15                    ldx     facm+3
 3241  F846A5  86 16                    stx     facm+4
 3242  F846A7  A6 14                    ldx     facm+2
 3243  F846A9  86 15                    stx     facm+3
 3244  F846AB  A6 13                    ldx     facm+1
 3245  F846AD  86 14                    stx     facm+2
 3246  F846AF  A6 12                    ldx     facm
 3247  F846B1  86 13                    stx     facm+1
 3248  F846B3  A2 00                    ldx     #0              ; in last byte enter a zero...
 3249  F846B5  86 12                    stx     facm
 3250  F846B7  88                       dey                     ; loop until all bytes was shifted
 3251  F846B8  D0 B2                    bne     ?lp
 3252  F846BA  64 22                    stz     facexp          ; at this point fac=0...
 3253  F846BC  80 3E                    bra     chkz2           ; ...and set status byte
 3254  F846BE  69 08 00         ?rst:   adc     #8              ; restore exponent...
 3255  F846C1  1A                       inc     a
 3256  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 time
 3259  F846C7  26 14                    rol     facm+2
 3260  F846C9  26 16                    rol     facm+4
  Tue Jul 17 11:00:18 2018                                                                                               Page   11




 3261  F846CB  26 18                    rol     facm+6
 3262  F846CD  26 1A                    rol     facm+8
 3263  F846CF  26 1C                    rol     facm+10
 3264  F846D1  26 1E                    rol     facm+12
 3265  F846D3  26 20                    rol     facm+14 
 3266  F846D5  10 EB                    bpl     ?cnt            ; shift until msb=0
 3267  F846D7  30 01                    bmi     ?end2           ; finish
 3268  F846D9  1A               ?end:   inc     a               ; restore exponent...
 3269  F846DA  85 22            ?end2:  sta     facexp          ; ...and set fac exponent
 3270  F846DC  C9 FF 7F                 cmp     #INFEXP         ; check overflow condition
 3271  F846DF  90 05                    bcc     chkz            ; no overflow: chexck if fac=0
 3272  F846E1                           ACC08
 3273  F846E1  E2 20                    sep     #PMFLAG
 3274                                   .LONGA  off
 3275                                   .MNLIST
 3276  F846E3  4C 7D 4E                 jmp     fldinf          ; set fac=inf
 3277                           
 3278                           ; chkz - check if fac=0; if fac=0 set the status byte
 3279                           ;
 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     #PMFLAG
 3287                                   .LONGA  on
 3288                                   .MNLIST
 3289  F846E8  A5 12                    lda     facm            ; ...then fac=0
 3290  F846EA  05 14                    ora     facm+2
 3291  F846EC  05 16                    ora     facm+4
 3292  F846EE  05 18                    ora     facm+6
 3293  F846F0  05 1A                    ora     facm+8
 3294  F846F2  05 1C                    ora     facm+10
 3295  F846F4  05 1E                    ora     facm+12
 3296  F846F6  05 20                    ora     facm+14 
 3297  F846F8  D0 06                    bne     chkz3
 3298  F846FA  85 22                    sta     facexp          ; set biased exponent = 0
 3299  F846FC  A2 40            chkz2:  ldx     #$40            ; set status byte for 'zero' condition
 3300  F846FE  86 25                    stx     facst
 3301  F84700                   chkz3:  ACC08
 3302  F84700  E2 20                    sep     #PMFLAG
 3303                                   .LONGA  off
 3304                                   .MNLIST
 3305  F84702  18                       clc
 3306  F84703  60                       rts
 3307                           
 3308                           ; negfac - negate fac (2's complement)
 3309                           ;
 3310                           ; this routine will be called after a subtraction
 3311                           ; that change the sign of the result
 3312                           ;
 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   12




 3318  F84704  A5 24                    lda     facsgn          ; change fac sign
 3319  F84706  49 FF                    eor     #$FF
 3320  F84708  85 24                    sta     facsgn
 3321  F8470A  A2 00                    ldx     #0
 3322  F8470C                           CPU16                   ; two's complement
 3323  F8470C  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 3324                                   .LONGA  on
 3325                                   .LONGI  on
 3326                                   .MNLIST
 3327  F8470E  38                       sec
 3328  F8470F  8A                       txa
 3329  F84710  E5 12                    sbc     facm
 3330  F84712  85 12                    sta     facm
 3331  F84714  8A                       txa
 3332  F84715  E5 14                    sbc     facm+2
 3333  F84717  85 14                    sta     facm+2
 3334  F84719  8A                       txa
 3335  F8471A  E5 16                    sbc     facm+4
 3336  F8471C  85 16                    sta     facm+4
 3337  F8471E  8A                       txa
 3338  F8471F  E5 18                    sbc     facm+6
 3339  F84721  85 18                    sta     facm+6
 3340  F84723  8A                       txa
 3341  F84724  E5 1A                    sbc     facm+8
 3342  F84726  85 1A                    sta     facm+8
 3343  F84728  8A                       txa
 3344  F84729  E5 1C                    sbc     facm+10
 3345  F8472B  85 1C                    sta     facm+10
 3346  F8472D  8A                       txa
 3347  F8472E  E5 1E                    sbc     facm+12
 3348  F84730  85 1E                    sta     facm+12
 3349  F84732  8A                       txa
 3350  F84733  E5 20                    sbc     facm+14
 3351  F84735  85 20                    sta     facm+14
 3352  F84737                           CPU08
 3353  F84737  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 3354                                   .LONGA  off
 3355                                   .LONGI  off
 3356                                   .MNLIST
 3357  F84739  60                       rts
 3358                           
 3359                           ; shrmx - shift mantissa pointed by X toward right
 3360                           ;
 3361                           ;       entry:  A=negative shift's count (max. 128 bit)
 3362                           ;               X=mantissa pointer
 3363                           ;
 3364                           ;       exit:
 3365                           ;               mantissa is shifted toward right and 0 will be routed to msb
 3366                           ;
 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=1
 3373  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 more
  Tue Jul 17 11:00:18 2018                                                                                               Page   13




 3375  F84740                   ?sh16:  CPU16                   ; shift right 16 bit at time
 3376  F84740  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 3377                                   .LONGA  on
 3378                                   .LONGI  on
 3379                                   .MNLIST
 3380  F84742  B4 02                    ldy     <2,x
 3381  F84744  94 00                    sty     <0,x
 3382  F84746  B4 04                    ldy     <4,x
 3383  F84748  94 02                    sty     <2,x
 3384  F8474A  B4 06                    ldy     <6,x
 3385  F8474C  94 04                    sty     <4,x
 3386  F8474E  B4 08                    ldy     <8,x
 3387  F84750  94 06                    sty     <6,x
 3388  F84752  B4 0A                    ldy     <10,x
 3389  F84754  94 08                    sty     <8,x
 3390  F84756  B4 0C                    ldy     <12,x
 3391  F84758  94 0A                    sty     <10,x
 3392  F8475A  B4 0E                    ldy     <14,x
 3393  F8475C  94 0C                    sty     <12,x
 3394  F8475E  74 0E                    stz     <14,x
 3395  F84760                           CPU08
 3396  F84760  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 3397                                   .LONGA  off
 3398                                   .LONGI  off
 3399                                   .MNLIST
 3400  F84762  80 46                    bra     ?tst2           ; continue
 3401  F84764  69 08            ?tst1:  adc     #8              ; check if can shift 16 bit at time
 3402  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 time
 3405                                                           ; also note here result is negative and CF=0
 3406  F8476C  B4 01            ?sh8:   ldy     <1,x            ; shift right 8 bit at time
 3407  F8476E  94 00                    sty     <0,x
 3408  F84770  B4 02                    ldy     <2,x
 3409  F84772  94 01                    sty     <1,x
 3410  F84774  B4 03                    ldy     <3,x
 3411  F84776  94 02                    sty     <2,x
 3412  F84778  B4 04                    ldy     <4,x
 3413  F8477A  94 03                    sty     <3,x
 3414  F8477C  B4 05                    ldy     <5,x
 3415  F8477E  94 04                    sty     <4,x
 3416  F84780  B4 06                    ldy     <6,x
 3417  F84782  94 05                    sty     <5,x
 3418  F84784  B4 07                    ldy     <7,x
 3419  F84786  94 06                    sty     <6,x
 3420  F84788  B4 08                    ldy     <8,x
 3421  F8478A  94 07                    sty     <7,x
 3422  F8478C  B4 09                    ldy     <9,x
 3423  F8478E  94 08                    sty     <8,x
 3424  F84790  B4 0A                    ldy     <10,x
 3425  F84792  94 09                    sty     <9,x
 3426  F84794  B4 0B                    ldy     <11,x
 3427  F84796  94 0A                    sty     <10,x
 3428  F84798  B4 0C                    ldy     <12,x
 3429  F8479A  94 0B                    sty     <11,x
 3430  F8479C  B4 0D                    ldy     <13,x
 3431  F8479E  94 0C                    sty     <12,x
  Tue Jul 17 11:00:18 2018                                                                                               Page   14




 3432  F847A0  B4 0E                    ldy     <14,x
 3433  F847A2  94 0D                    sty     <13,x
 3434  F847A4  B4 0F                    ldy     <15,x
 3435  F847A6  94 0E                    sty     <14,x
 3436  F847A8  74 0F                    stz     <15,x
 3437  F847AA  69 08            ?tst2:  adc     #8              ; test if can shift 8/16 bit at time
 3438  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 count
 3441  F847B2  B0 1D                    bcs     ?end            ; finish if shift count >= 0
 3442  F847B4  A8               ?shb:   tay                     ; residual bit shift count
 3443  F847B5  F0 1A                    beq     ?end            ; nothing to shift
 3444  F847B7                           ACC16
 3445  F847B7  C2 20                    rep     #PMFLAG
 3446                                   .LONGA  on
 3447                                   .MNLIST
 3448  F847B9  B5 00                    lda     <0,x            ; lsb+guard bits
 3449  F847BB  56 0E            ?sh:    lsr     <14,x           ; msb=0
 3450  F847BD  76 0C                    ror     <12,x
 3451  F847BF  76 0A                    ror     <10,x
 3452  F847C1  76 08                    ror     <8,x
 3453  F847C3  76 06                    ror     <6,x
 3454  F847C5  76 04                    ror     <4,x
 3455  F847C7  76 02                    ror     <2,x
 3456  F847C9  6A                       ror     a               ; rotate lsb
 3457  F847CA  C8                       iny
 3458  F847CB  D0 EE                    bne     ?sh
 3459  F847CD  95 00                    sta     <0,x            ; store lsb+guards bits
 3460  F847CF                           ACC08
 3461  F847CF  E2 20                    sep     #PMFLAG
 3462                                   .LONGA  off
 3463                                   .MNLIST
 3464  F847D1  60               ?end:   rts
 3465                           
 3466                           ; shlmx - shift mantissa pointed by X to left until msb of mantissa equal 1
 3467                           ; and decrement unbiased exponent according with shift's count.
 3468                           ; 
 3469                           ; this routine is called for 'normalize' a subnormal operand
 3470                           ;
 3471                           ; call with A/M in 16 bit mode
 3472                           ;
 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 bit
 3479                                   .LONGI  off
 3480                           
 3481  F847D2  38                       sec
 3482  F847D3  B5 10                    lda     <16,x           ; C=unbiased exponent
 3483  F847D5  B4 0F            ?lp1:   ldy     <15,x           ; shift count < 8?
 3484  F847D7  D0 5D                    bne     ?sh             ; yes
 3485  F847D9  E9 08 00                 sbc     #8              ; 8 bits shift
 3486  F847DC  B4 0E                    ldy     <14,x           ; shift toward left byte at byte
 3487  F847DE  94 0F                    sty     <15,x   
 3488  F847E0  B4 0D                    ldy     <13,x
  Tue Jul 17 11:00:18 2018                                                                                               Page   15




 3489  F847E2  94 0E                    sty     <14,x   
 3490  F847E4  B4 0C                    ldy     <12,x
 3491  F847E6  94 0D                    sty     <13,x   
 3492  F847E8  B4 0B                    ldy     <11,x
 3493  F847EA  94 0C                    sty     <12,x   
 3494  F847EC  B4 0A                    ldy     <10,x
 3495  F847EE  94 0B                    sty     <11,x   
 3496  F847F0  B4 09                    ldy     <9,x
 3497  F847F2  94 0A                    sty     <10,x
 3498  F847F4  B4 08                    ldy     <8,x
 3499  F847F6  94 09                    sty     <9,x
 3500  F847F8  B4 07                    ldy     <7,x
 3501  F847FA  94 08                    sty     <8,x
 3502  F847FC  B4 06                    ldy     <6,x
 3503  F847FE  94 07                    sty     <7,x
 3504  F84800  B4 05                    ldy     <5,x
 3505  F84802  94 06                    sty     <6,x
 3506  F84804  B4 04                    ldy     <4,x
 3507  F84806  94 05                    sty     <5,x
 3508  F84808  B4 03                    ldy     <3,x
 3509  F8480A  94 04                    sty     <4,x
 3510  F8480C  B4 02                    ldy     <2,x
 3511  F8480E  94 03                    sty     <3,x
 3512  F84810  B4 01                    ldy     <1,x
 3513  F84812  94 02                    sty     <2,x
 3514  F84814  B4 00                    ldy     <0,x
 3515  F84816  94 01                    sty     <1,x
 3516  F84818  A0 00                    ldy     #0
 3517  F8481A  94 00                    sty     <0,x
 3518  F8481C  C9 81 FF                 cmp     #MAXBSHIFT      ; shifted all whole mantissa?
 3519  F8481F  F0 17                    beq     ?done           ; yes, store exponent
 3520  F84821  B0 B2                    bcs     ?lp1            ; no, try again
 3521  F84823  80 13                    bra     ?done           ; store exponent
 3522  F84825  3A               ?lp2:   dec     a               ; decrement exponent
 3523  F84826  16 00                    asl     <0,x
 3524  F84828  36 02                    rol     <2,x
 3525  F8482A  36 04                    rol     <4,x
 3526  F8482C  36 06                    rol     <6,x
 3527  F8482E  36 08                    rol     <8,x
 3528  F84830  36 0A                    rol     <10,x
 3529  F84832  36 0C                    rol     <12,x
 3530  F84834  36 0E                    rol     <14,x   
 3531  F84836  10 ED            ?sh:    bpl     ?lp2            ; if msb=0 shift to left one place
 3532  F84838  95 10            ?done:  sta     <16,x           ; store exponent
 3533  F8483A  34 10                    bit     <16,x           ; check exponent sign
 3534  F8483C  10 02                    bpl     ?end
 3535  F8483E  D6 14                    dec     <20,x           ; sign extension to 32 bit
 3536  F84840  60               ?end:   rts
 3537                           
 3538                                   .LONGA  off
 3539                           
 3540                           ; addtst - test operands before to execute addition/subtraction
 3541                           ;
 3542                           ; This routine test fac & arg for validity, and return to the caller
 3543                           ; for any abnormal condition:
 3544                           ;
 3545                           ;       1) return nan if fac=nan or arg=nan
  Tue Jul 17 11:00:18 2018                                                                                               Page   16




 3546                           ;       2) return nan if |fac|=|arg|=inf and arg&fac have opposites sign
 3547                           ;       3) return +inf or -inf if fac=arg=+/-inf
 3548                           ;       4) return +inf or -inf if fac=+/-inf and arg is valid
 3549                           ;       5) return +inf or -inf if arg=+/-inf and fac is valid
 3550                           ;
 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 sign
 3557  F84843  45 3C                    eor     argsgn
 3558  F84845  85 11                    sta     sgncmp
 3559  F84847  38                       sec                     ; invalid result flag
 3560  F84848  24 25                    bit     facst           ; test fac
 3561  F8484A  10 11                    bpl     ?arg            ; fac is valid, go to check arg
 3562  F8484C  50 1D                    bvc     ?skp            ; fac=nan so result=nan (fac sign)
 3563  F8484E  24 3D                    bit     argst           ; fac=inf so check arg
 3564  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 comparison
 3567  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=1
 3570  F8485D  24 3D            ?arg:   bit     argst           ; fac is valid, so now check arg
 3571  F8485F  30 07                    bmi     ?mv             ; arg=inf/nan so result=inf/nan (arg sign)
 3572  F84861  18                       clc                     ; now result is valid
 3573  F84862  70 07                    bvs     ?skp            ; arg=0 so result=fac
 3574  F84864  24 25                    bit     facst           ; fac=0?
 3575  F84866  50 05                    bvc     ?end            ; no, return to add/sub operation
 3576  F84868  20 0C 84         ?mv:    jsr     mvatof          ; move arg to fac (preserve CF)
 3577  F8486B  68               ?skp:   pla                     ; skip return address
 3578  F8486C  68                       pla
 3579  F8486D  60               ?end:   rts
 3580                           
 3581                           ;---------------------------------------------------------------------------
 3582                           ; multiplication & division implementation - scaling routines
 3583                           ;---------------------------------------------------------------------------
 3584                           
 3585                           ; frexp - extracts the exponent from x.  It returns an integer
 3586                           ; power of two to scexp and the significand between 0.5 and 1 to fac
 3587                           ;
 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 N
 3595                           ;               dexp    = |N| (absolute value of N)
 3596                           ;
 3597                           ;       note that:
 3598                           ;                        N
 3599                           ;               x = y * 2
 3600                           ;
 3601                           ;-----
 3602  F8486E                   frexp:
  Tue Jul 17 11:00:18 2018                                                                                               Page   17




 3603                           ;-----
 3604  F8486E  38                       sec
 3605  F8486F  24 25                    bit     facst
 3606  F84871  30 43                    bmi     ?end            ; invalid fac   
 3607  F84873                           ACC16
 3608  F84873  C2 20                    rep     #PMFLAG
 3609                                   .LONGA  on
 3610                                   .MNLIST
 3611  F84875  64 46                    stz     scexp
 3612  F84877  64 48                    stz     dexp
 3613  F84879  64 3E                    stz     wftmp
 3614  F8487B  A2 00                    ldx     #0              ; assume positive sign
 3615  F8487D  A5 22                    lda     facexp
 3616  F8487F  F0 30                    beq     ?s              ; fac=0 so return exponent=0    
 3617  F84881  3A                       dec     a               ; subnormal?
 3618  F84882  D0 14                    bne     ?fn             ; no
 3619  F84884  A6 21                    ldx     facm+15
 3620  F84886  30 10                    bmi     ?fn             ; fac is norml
 3621  F84888  85 22                    sta     facexp          ; clear to get negative exponent of subnormal
 3622  F8488A  A2 12                    ldx     #facm
 3623  F8488C  20 D2 47                 jsr     shlmx           ; normalize subnormal fac
 3624  F8488F  A5 22                    lda     facexp
 3625  F84891  85 3E                    sta     wftmp           ; negative exponent of subnormal
 3626  F84893  A9 01 00                 lda     #1              ; restore biased exponent
 3627  F84896  85 22                    sta     facexp
 3628  F84898  38               ?fn:    sec                     ; scale a normal f.p.
 3629  F84899  A5 22                    lda     facexp
 3630  F8489B  E9 FE 3F                 sbc     #EBIAS-1        ; new biased exponent
 3631  F8489E  18                       clc
 3632  F8489F  65 3E                    adc     wftmp           ; any subnormal negative exponent
 3633  F848A1  85 46                    sta     scexp
 3634  F848A3  10 05                    bpl     ?p
 3635  F848A5  CA                       dex
 3636  F848A6  49 FF FF                 eor     #$FFFF
 3637  F848A9  1A                       inc     a               ; return absolute value too
 3638  F848AA  85 48            ?p:     sta     dexp    
 3639  F848AC  A9 FE 3F                 lda     #EBIAS-1
 3640  F848AF  85 22                    sta     facexp          ; now 0.5 <= fac < 1
 3641  F848B1  86 45            ?s:     stx     scsgn           ; exponent sign
 3642  F848B3                           ACC08
 3643  F848B3  E2 20                    sep     #PMFLAG
 3644                                   .LONGA  off
 3645                                   .MNLIST
 3646  F848B5  18                       clc
 3647  F848B6  60               ?end:   rts
 3648                           
 3649                           ; fscale - multiplies argument by a power of two
 3650                           ;
 3651                           ;       entry:
 3652                           ;               fac     = x (valid float)
 3653                           ;               scexp   = N (signed integer)
 3654                           ;
 3655                           ;       exit:
 3656                           ;                              N
 3657                           ;               fac     = x * 2
 3658                           ;               CF      = 1 if invalid result(inf or nan)
 3659                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page   18




 3660                           ;------
 3661  F848B7                   fscale:
 3662                           ;------
 3663  F848B7  38                       sec                     ; invalid fac flag
 3664  F848B8  24 25                    bit     facst
 3665  F848BA  30 48                    bmi     ?end2           ; fac is invalid
 3666  F848BC  70 45                    bvs     ?end1           ; fac=0
 3667  F848BE                           ACC16
 3668  F848BE  C2 20                    rep     #PMFLAG
 3669                                   .LONGA  on
 3670                                   .MNLIST
 3671  F848C0  A5 46                    lda     scexp
 3672  F848C2  F0 3D                    beq     ?end            ; scale factor = 0
 3673  F848C4  A5 22                    lda     facexp
 3674  F848C6  3A                       dec     a
 3675  F848C7  D0 41                    bne     ?fn             ; fac is normal
 3676  F848C9  A6 21                    ldx     facm+15
 3677  F848CB  30 3D                    bmi     ?fn             ; fac is normal
 3678  F848CD  A5 46                    lda     scexp
 3679  F848CF  10 18                    bpl     ?ps             ; positive scaling of subnormal
 3680  F848D1  30 07                    bmi     ?ns             ; negative scaling of subnormal
 3681  F848D3  A5 22            ?sn:    lda     facexp
 3682  F848D5  64 22            ?sn2:   stz     facexp          ; set biased exponent=1
 3683  F848D7  E6 22                    inc     facexp
 3684  F848D9  3A                       dec     a               ; count of right shift
 3685  F848DA  C9 81 FF         ?ns:    cmp     #MAXBSHIFT
 3686  F848DD  90 26                    bcc     ?z              ; return fac=0
 3687  F848DF                           ACC08
 3688  F848DF  E2 20                    sep     #PMFLAG
 3689                                   .LONGA  off
 3690                                   .MNLIST
 3691  F848E1  A2 12                    ldx     #facm           ; shift right
 3692  F848E3  20 3A 47                 jsr     shrmx
 3693  F848E6  4C E6 46                 jmp     chkz            ; underflow test
 3694                                   .LONGA  on
 3695  F848E9  A6 21            ?ps:    ldx     facm+15         ; shift subnormal toward left
 3696  F848EB  30 1D                    bmi     ?fn
 3697  F848ED  06 12                    asl     facm
 3698  F848EF  26 14                    rol     facm+2
 3699  F848F1  26 16                    rol     facm+4
 3700  F848F3  26 18                    rol     facm+6
 3701  F848F5  26 1A                    rol     facm+8
 3702  F848F7  26 1C                    rol     facm+10
 3703  F848F9  26 1E                    rol     facm+12
 3704  F848FB  26 20                    rol     facm+14
 3705  F848FD  C6 46                    dec     scexp
 3706  F848FF  D0 E8                    bne     ?ps
 3707  F84901                   ?end:   ACC08                   ; return
 3708  F84901  E2 20                    sep     #PMFLAG
 3709                                   .LONGA  off
 3710                                   .MNLIST
 3711  F84903  18               ?end1:  clc
 3712  F84904  60               ?end2:  rts
 3713  F84905                   ?z:     ACC08                   ; return fac=0
 3714  F84905  E2 20                    sep     #PMFLAG
 3715                                   .LONGA  off
 3716                                   .MNLIST
  Tue Jul 17 11:00:18 2018                                                                                               Page   19




 3717  F84907  4C 56 4E                 jmp     fldz
 3718                                   .LONGA  on
 3719  F8490A  64 3E            ?fn:    stz     wftmp           ; 32 bit exponent sign extension
 3720  F8490C  A5 46                    lda     scexp
 3721  F8490E  10 02                    bpl     ?p
 3722  F84910  C6 3E                    dec     wftmp           ; scexp is negative
 3723  F84912  18               ?p:     clc
 3724  F84913  A5 22                    lda     facexp
 3725  F84915  65 46                    adc     scexp
 3726  F84917  85 22                    sta     facexp
 3727  F84919  A9 00 00                 lda     #0
 3728  F8491C  65 3E                    adc     wftmp           ; can be just negative or null
 3729  F8491E  30 B3                    bmi     ?sn             ; handle subnormal result
 3730  F84920  A5 22                    lda     facexp
 3731  F84922  F0 B1                    beq     ?sn2            ; handle subnormal result
 3732  F84924  C9 FF 7F                 cmp     #INFEXP         ; overflow?
 3733  F84927  90 D8                    bcc     ?end            ; no
 3734  F84929                           ACC08
 3735  F84929  E2 20                    sep     #PMFLAG
 3736                                   .LONGA  off
 3737                                   .MNLIST
 3738  F8492B  4C 7D 4E                 jmp     fldinf
 3739                           
 3740                                   .LONGA  off
 3741  F8492E                           
 3742                           ; scale10 - multiplies argument by a power of ten
 3743                           ;
 3744                           ;       entry:
 3745                           ;               fac     = x (valid float)
 3746                           ;               C       = N (signed integer)
 3747                           ;
 3748                           ;       exit:
 3749                           ;                               N
 3750                           ;               fac     = x * 10
 3751                           ;               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 entries 
 3755                           ; for  10^8/16/32/64/128/256/512/1024/2048/4096 which allows
 3756                           ; any power up. Negative powers are provided by a final division.
 3757                           ;
 3758                           ;-------
 3759  F8492E                   scale10:
 3760                           ;-------
 3761  F8492E  38                       sec
 3762  F8492F  24 25                    bit     facst           ; valid fac?
 3763  F84931  30 48                    bmi     ?end2           ; no, exit
 3764  F84933  70 45                    bvs     ?end1           ; fac=0, exit
 3765  F84935                           ACC16
 3766  F84935  C2 20                    rep     #PMFLAG
 3767                                   .LONGA  on
 3768                                   .MNLIST
 3769  F84937  C9 00 00                 cmp     #0
 3770  F8493A  F0 3C                    beq     ?end            ; scaling exponent=0 so exit
 3771  F8493C  85 46                    sta     scexp           ; scaling exponent
 3772  F8493E  A2 00                    ldx     #0
 3773  F84940  A4 47                    ldy     scexp+1         ; test sign
  Tue Jul 17 11:00:18 2018                                                                                               Page   20




 3774  F84942  10 07                    bpl     ?pe             ; positive exponent
 3775  F84944  8A                       txa                     ; change sign
 3776  F84945  CA                       dex
 3777  F84946  38                       sec
 3778  F84947  E5 46                    sbc     scexp
 3779  F84949  85 46                    sta     scexp
 3780  F8494B  86 45            ?pe:    stx     scsgn           ; store sign
 3781  F8494D  C9 00 10         ?lp1:   cmp     #4096           ; loop for big scaling
 3782  F84950                           ACC08
 3783  F84950  E2 20                    sep     #PMFLAG
 3784                                   .LONGA  off
 3785                                   .MNLIST
 3786  F84952  90 28                    bcc     ?sc             ; scaling<4096
 3787  F84954  A9 31                    lda     #<fce4096
 3788  F84956  A0 60                    ldy     #>fce4096
 3789  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 4096
 3792  F8495F  B0 1A                    bcs     ?end2           ; overflow, so exit
 3793  F84961  90 09                    bcc     ?cnt            ; continue
 3794  F84963  20 0A 4A         ?div:   jsr     fcrdiv          ; divide by 4096
 3795  F84966  B0 13                    bcs     ?end2
 3796  F84968  24 25                    bit     facst           ; if fac=0 exit
 3797  F8496A  70 0F                    bvs     ?end2
 3798  F8496C                   ?cnt:   ACC16                   ; update scaling factor...
 3799  F8496C  C2 20                    rep     #PMFLAG
 3800                                   .LONGA  on
 3801                                   .MNLIST
 3802  F8496E  38                       sec
 3803  F8496F  A5 46                    lda     scexp
 3804  F84971  E9 00 10                 sbc     #4096           ; ...subtracting 4096...
 3805  F84974  85 46                    sta     scexp
 3806  F84976  D0 D5                    bne     ?lp1            ;...and repeat
 3807  F84978                   ?end:   ACC08
 3808  F84978  E2 20                    sep     #PMFLAG
 3809                                   .LONGA  off
 3810                                   .MNLIST
 3811  F8497A  18               ?end1:  clc
 3812  F8497B  60               ?end2:  rts
 3813  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 1e7
 3816  F84983  0A                       asl     a
 3817  F84984  AA                       tax
 3818  F84985  BF 44 60 F8              lda     >fcaddr+1,x
 3819  F84989  A8                       tay
 3820  F8498A  BF 43 60 F8              lda     >fcaddr,x
 3821  F8498E  20 82 86                 jsr     ldfac           ; load fac with a constant from 1.0 to 1.0e7
 3822  F84991                           CPU16
 3823  F84991  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 3824                                   .LONGA  on
 3825                                   .LONGI  on
 3826                                   .MNLIST
 3827  F84993  A9 8F 5F                 lda     #!fce8          ; now find the high order factor...
 3828  F84996  85 42                    sta     fcp             ; ...from 1.0e8 to 1.0e2048
 3829  F84998  A5 46                    lda     scexp
 3830  F8499A  4A                       lsr     a               ; divide by 8
  Tue Jul 17 11:00:18 2018                                                                                               Page   21




 3831  F8499B  4A                       lsr     a
 3832  F8499C  4A                       lsr     a
 3833  F8499D  F0 22                    beq     ?done           ; if = 0 we are done
 3834  F8499F  4A               ?lp2:   lsr     a               ; divide by 2 high order bits
 3835  F849A0  90 14                    bcc     ?nxt            ; if even load next constant
 3836  F849A2  85 46                    sta     scexp           ; save scale
 3837  F849A4                           CPU08
 3838  F849A4  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 3839                                   .LONGA  off
 3840                                   .LONGI  off
 3841                                   .MNLIST
 3842  F849A6  20 DA 49                 jsr     fcmult2         ; multiplies by constant
 3843  F849A9  90 07                    bcc     ?ok
 3844  F849AB  24 45                    bit     scsgn
 3845  F849AD  10 CC                    bpl     ?end2           ; overflow: fac=inf
 3846  F849AF  4C 56 4E                 jmp     fldz            ; underflow: fac=0
 3847  F849B2                   ?ok:    CPU16
 3848  F849B2  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 3849                                   .LONGA  on
 3850                                   .LONGI  on
 3851                                   .MNLIST
 3852  F849B4  A5 46                    lda     scexp
 3853  F849B6  AA               ?nxt:   tax                     ; update pointer to next constant       
 3854  F849B7  A5 42                    lda     fcp
 3855  F849B9  69 12 00                 adc     #FCSIZ
 3856  F849BC  85 42                    sta     fcp
 3857  F849BE  8A                       txa
 3858  F849BF  D0 DE                    bne     ?lp2            ; loop
 3859  F849C1                   ?done:  CPU08
 3860  F849C1  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 3861                                   .LONGA  off
 3862                                   .LONGI  off
 3863                                   .MNLIST
 3864  F849C3  20 CE 85                 jsr     mvt0_a          ; move temp. reg. tfr0 to arg
 3865  F849C6  24 45                    bit     scsgn
 3866  F849C8  30 46                    bmi     fpdiv           ; if negative scaling we divide arg by fac
 3867  F849CA  80 11                    bra     fpmult          ; if positive scaling we multiplies arg by fac
 3868                           
 3869                           ; fsquare - return the square of the argument
 3870                           ;
 3871                           ;       entry:
 3872                           ;               fac = x
 3873                           ;
 3874                           ;       exit:          2
 3875                           ;               fac = x
 3876                           ;               CF  = 1 if invalid result(inf or nan)
 3877                           ;
 3878                           ;-------
 3879  F849CC                   fsquare:
 3880                           ;-------
 3881  F849CC  20 39 84                 jsr     mvftoa          ; move fac to arg
 3882  F849CF  80 0C                    bra     fpmult          ; fac*fac
 3883                           
 3884                           ; mult10 - multiplies the argument with 10.0
 3885                           ;
 3886                           ;       entry:
 3887                           ;               fac = x
  Tue Jul 17 11:00:18 2018                                                                                               Page   22




 3888                           ;
 3889                           ;       exit:
 3890                           ;               fac = x * 10
 3891                           ;
 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.0
 3898  F849D3  A0 5F                    ldy     #>fce1
 3899                           
 3900                           ; fcmult - multiplies the argument with one constant stored in program memory
 3901                           ;
 3902                           ;       entry:
 3903                           ;               fac = x
 3904                           ;               A = low  address of constant K
 3905                           ;               Y = high address of constant K
 3906                           ;
 3907                           ;       exit:
 3908                           ;               fac = K * x
 3909                           ;
 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 K
 3918  F849D8  80 03                    bra     fpmult          ; execute multiplication
 3919                           
 3920                           ; fcmult2 - multiplies the argument with one constant stored in program memory
 3921                           ;
 3922                           ;       entry:
 3923                           ;               fac = x
 3924                           ;               fcp = long pointer to constant K
 3925                           ;
 3926                           ;       exit:
 3927                           ;               fac = K * x
 3928                           ;
 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 K
 3937                           
 3938                           ; fpmult - multiplies operands stored in arg & fac
 3939                           ; main multiplication routine
 3940                           ;
 3941                           ;       entry:
 3942                           ;               arg = x
 3943                           ;               fac = y
 3944                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page   23




 3945                           ;       exit:
 3946                           ;               fac = x * y
 3947                           ;               CF  = 1 if invalid result(inf or nan)
 3948                           ;
 3949                           ;------
 3950  F849DD                   fpmult:
 3951                           ;------
 3952  F849DD  20 AF 4C                 jsr     multst          ; operands test
 3953  F849E0  18                       clc                     ; multiplication flag for addexp
 3954  F849E1  20 DA 4A                 jsr     addexp          ; add exponent's
 3955  F849E4                           CPU16                   ; clear the partial result
 3956  F849E4  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 3957                                   .LONGA  on
 3958                                   .LONGI  on
 3959                                   .MNLIST
 3960  F849E6  64 00                    stz     tm
 3961  F849E8  64 02                    stz     tm+2
 3962  F849EA  64 04                    stz     tm+4
 3963  F849EC  64 06                    stz     tm+6
 3964  F849EE  64 08                    stz     tm+8
 3965  F849F0  64 0A                    stz     tm+10
 3966  F849F2  64 0C                    stz     tm+12
 3967  F849F4  64 0E                    stz     tm+14   
 3968  F849F6  20 44 4B                 jsr     multm           ; execute binary multiplication
 3969  F849F9                           CPU08
 3970  F849F9  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 3971                                   .LONGA  off
 3972                                   .LONGI  off
 3973                                   .MNLIST
 3974  F849FB  80 1D                    bra     movres          ; move result to fac & normalize
 3975                           
 3976                           ; frecip - returns the reciprocal of the argument
 3977                           ;
 3978                           ;       entry:
 3979                           ;               fac = x
 3980                           ;
 3981                           ;       exit:
 3982                           ;               fac = 1/x
 3983                           ;               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.0
 3989  F849FF  A0 5E                    ldy     #>fce0
 3990                           
 3991                           ; fcdiv - divide one constant stored in program memory by the argument
 3992                           ;
 3993                           ;       entry:
 3994                           ;               fac = x
 3995                           ;               A = low  address of constant K
 3996                           ;               Y = high address of constant K
 3997                           ;
 3998                           ;       exit:
 3999                           ;               fac = K / x
 4000                           ;
 4001                           ; This routine is used internally and not intended for end use.
  Tue Jul 17 11:00:18 2018                                                                                               Page   24




 4002                           ; 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 arg
 4009  F84A04  80 0A                    bra     fpdiv           ; execute arg/fac
 4010                           
 4011                           ; div10 - divide the argument by 10.0
 4012                           ;
 4013                           ;       entry:
 4014                           ;               fac = x
 4015                           ;       exit:
 4016                           ;               fac = x / 10
 4017                           ;
 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.0
 4024  F84A08  A0 5F                    ldy     #>fce1
 4025                           
 4026                           ; fcrdiv - divide the argument by one constant stored in program memory
 4027                           ;
 4028                           ;       entry:
 4029                           ;               fac = x
 4030                           ;               A = low  address of constant K
 4031                           ;               Y = high address of constant K
 4032                           ;
 4033                           ;       exit:
 4034                           ;               fac = x / K
 4035                           ;
 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 arg
 4044  F84A0D  20 82 86                 jsr     ldfac           ; move constant to fac
 4045                           
 4046                           ; fpdiv - divide the argument stored in arg by the argument stored in fac
 4047                           ;
 4048                           ;       entry:
 4049                           ;               arg = x
 4050                           ;               fac = y
 4051                           ;
 4052                           ;       exit:
 4053                           ;               fac = x / y
 4054                           ;               CF  = 1 if invalid result(inf or nan)
 4055                           ;
 4056                           ;-----
 4057  F84A10                   fpdiv:
 4058                           ;-----
  Tue Jul 17 11:00:18 2018                                                                                               Page   25




 4059  F84A10  20 EB 4C                 jsr     divtst          ; operands test
 4060  F84A13  38                       sec                     ; flag division for addexp
 4061  F84A14  20 DA 4A                 jsr     addexp          ; add operands exponent
 4062  F84A17  20 DF 4B                 jsr     divm            ; binary division
 4063  F84A1A                           
 4064                           ; movres - move the result of multiplication/division to fac & normalize
 4065                           ;
 4066                           ; This routine is used internally and not intended for end use.
 4067                           ;
 4068                           ;------
 4069  F84A1A                   movres:
 4070                           ;------
 4071  F84A1A                           ACC16
 4072  F84A1A  C2 20                    rep     #PMFLAG
 4073                                   .LONGA  on
 4074                                   .MNLIST
 4075  F84A1C  A5 00                    lda     tm              ; move the result (16 bytes) to fac
 4076  F84A1E  85 12                    sta     facm
 4077  F84A20  A5 02                    lda     tm+2
 4078  F84A22  85 14                    sta     facm+2
 4079  F84A24  A5 04                    lda     tm+4
 4080  F84A26  85 16                    sta     facm+4
 4081  F84A28  A5 06                    lda     tm+6
 4082  F84A2A  85 18                    sta     facm+6
 4083  F84A2C  A5 08                    lda     tm+8
 4084  F84A2E  85 1A                    sta     facm+8
 4085  F84A30  A5 0A                    lda     tm+10
 4086  F84A32  85 1C                    sta     facm+10
 4087  F84A34  A5 0C                    lda     tm+12
 4088  F84A36  85 1E                    sta     facm+12
 4089  F84A38  A5 0E                    lda     tm+14
 4090  F84A3A  85 20                    sta     facm+14
 4091  F84A3C                           ACC08
 4092  F84A3C  E2 20                    sep     #PMFLAG
 4093                                   .LONGA  off
 4094                                   .MNLIST
 4095  F84A3E  A5 26                    lda     fexph           ; operation involved subnormal?
 4096  F84A40  F0 08                    beq     ?fn             ; no
 4097  F84A42  A2 12                    ldx     #facm           ; now should shift to right fac...
 4098  F84A44  20 3A 47                 jsr     shrmx           ; ...because fac is subnormal
 4099  F84A47  4C E6 46         ?tz:    jmp     chkz            ; underflow test; check if fac=0
 4100  F84A4A                   ?fn:    ACC16                   ; normalize fac after mult/div  
 4101  F84A4A  C2 20                    rep     #PMFLAG
 4102                                   .LONGA  on
 4103                                   .MNLIST
 4104  F84A4C  A5 22                    lda     facexp
 4105  F84A4E  C9 01 00                 cmp     #1
 4106  F84A51  F0 F4                    beq     ?tz             ; can't normalize: underflow test
 4107  F84A53  A6 21                    ldx     facm+15         ; check msb
 4108  F84A55  30 1A                    bmi     ?done           ; already normalized
 4109  F84A57  C9 01 00         ?sh:    cmp     #1
 4110  F84A5A  F0 15                    beq     ?done           ; can't shift more
 4111  F84A5C  3A                       dec     a               ; decrement exponent at any shift
 4112  F84A5D  06 28                    asl     facext
 4113  F84A5F  26 12                    rol     facm
 4114  F84A61  26 14                    rol     facm+2
 4115  F84A63  26 16                    rol     facm+4
  Tue Jul 17 11:00:18 2018                                                                                               Page   26




 4116  F84A65  26 18                    rol     facm+6
 4117  F84A67  26 1A                    rol     facm+8
 4118  F84A69  26 1C                    rol     facm+10
 4119  F84A6B  26 1E                    rol     facm+12
 4120  F84A6D  26 20                    rol     facm+14 
 4121  F84A6F  10 E6                    bpl     ?sh             ; shift until msb=1
 4122  F84A71  85 22            ?done:  sta     facexp          ; store exponent
 4123  F84A73  C9 FF 7F                 cmp     #INFEXP         ; check if overflow
 4124  F84A76  B0 32                    bcs     ovfw            ; overflow
 4125  F84A78  A6 29                    ldx     facext+1        ; if msb=1 we round 128 bits mantissa
 4126  F84A7A  10 2A                    bpl     ifx             ; no rounding bit: done
 4127  F84A7C  20 AF 4A                 jsr     chkovf          ; we check exponent for a potential overflow
 4128  F84A7F  B0 25                    bcs     ifx             ; no round is possible (we avoid overflow)      
 4129  F84A81  E6 12                    inc     facm            ; inc. 15 guard bits and significand lsb
 4130  F84A83  D0 21                    bne     ifx
 4131                           
 4132                           ; incfac - increment the high order 96 bits of the fac significand
 4133                           ; Called when round fac mantissa
 4134                           ;
 4135                           ; This routine is used internally and not intended for end use.
 4136                           ;
 4137                           ;------
 4138  F84A85                   incfac:
 4139                           ;------
 4140  F84A85  E6 14                    inc     facm+2
 4141  F84A87  D0 1D                    bne     ifx
 4142  F84A89  E6 16                    inc     facm+4
 4143  F84A8B  D0 19                    bne     ifx
 4144  F84A8D  E6 18                    inc     facm+6
 4145  F84A8F  D0 15                    bne     ifx
 4146  F84A91  E6 1A                    inc     facm+8
 4147  F84A93  D0 11                    bne     ifx
 4148  F84A95  E6 1C                    inc     facm+10
 4149  F84A97  D0 0D                    bne     ifx
 4150  F84A99  E6 1E                    inc     facm+12
 4151  F84A9B  D0 09                    bne     ifx
 4152  F84A9D  E6 20                    inc     facm+14
 4153  F84A9F  D0 05                    bne     ifx
 4154  F84AA1                           CPU08
 4155  F84AA1  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 4156                                   .LONGA  off
 4157                                   .LONGI  off
 4158                                   .MNLIST
 4159  F84AA3  4C 3E 46                 jmp     addcf           ; add carry to significand, no overflow
 4160  F84AA6                   ifx:    CPU08
 4161  F84AA6  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 4162                                   .LONGA  off
 4163                                   .LONGI  off
 4164                                   .MNLIST
 4165  F84AA8  18                       clc
 4166  F84AA9  60                       rts
 4167                           
 4168                           ; set fac=inf
 4169                           ;----
 4170  F84AAA                   ovfw:
 4171                           ;----
 4172  F84AAA                           CPU08                   ; overflow
  Tue Jul 17 11:00:18 2018                                                                                               Page   27




 4173  F84AAA  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 4174                                   .LONGA  off
 4175                                   .LONGI  off
 4176                                   .MNLIST
 4177  F84AAC  4C 7D 4E                 jmp     fldinf
 4178                           
 4179                           ; chkovf - check potential fac overflow due to a roundoff
 4180                           ;
 4181                           ;       return CF=1 if a rounding can cause overflow
 4182                           ;
 4183                           ;       This routine should be called with A/M = 16 bit
 4184                           ;
 4185                           ; This routine is used internally and not intended for end use.
 4186                           ;
 4187                           ;------
 4188  F84AAF                   chkovf:
 4189                           ;------
 4190                                   .LONGA  on
 4191                           
 4192  F84AAF  C9 FE 7F                 cmp     #MAXEXP         ; we check exponent for possible overflow
 4193  F84AB2  90 25                    bcc     ?end            ; ok, no overflow after rounding
 4194  F84AB4  A9 FF FF                 lda     #$FFFF          ; check if mantissa is all one's
 4195  F84AB7  C5 12                    cmp     facm
 4196  F84AB9  D0 1A                    bne     ?ok
 4197  F84ABB  C5 14                    cmp     facm+2
 4198  F84ABD  D0 16                    bne     ?ok
 4199  F84ABF  C5 16                    cmp     facm+4
 4200  F84AC1  D0 12                    bne     ?ok
 4201  F84AC3  C5 18                    cmp     facm+6
 4202  F84AC5  D0 0E                    bne     ?ok
 4203  F84AC7  C5 1A                    cmp     facm+8
 4204  F84AC9  D0 0A                    bne     ?ok
 4205  F84ACB  C5 1C                    cmp     facm+10
 4206  F84ACD  D0 06                    bne     ?ok
 4207  F84ACF  C5 1E                    cmp     facm+12
 4208  F84AD1  D0 02                    bne     ?ok
 4209  F84AD3  C5 20                    cmp     facm+14
 4210  F84AD5  18               ?ok:    clc                     ; rounding is possible
 4211  F84AD6  D0 01                    bne     ?end
 4212  F84AD8  38                       sec                     ; no rounding possible 
 4213  F84AD9  60               ?end:   rts
 4214  F84ADA                           
 4215                                   .LONGA  off
 4216                           
 4217                           ; addexp - add exponent of fac & arg for multiplication/division
 4218                           ;
 4219                           ;       entry:
 4220                           ;               arg = x
 4221                           ;               fac = y
 4222                           ;               CF  = 1 if multiplication, else division
 4223                           ;
 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 normal
 4228                           ;
 4229                           ; This routine is used internally and not intended for end use.
  Tue Jul 17 11:00:18 2018                                                                                               Page   28




 4230                           ;
 4231                           ;------
 4232  F84ADA                   addexp:
 4233                           ;------
 4234  F84ADA  08                       php                     ; save carry
 4235  F84ADB                           ACC16
 4236  F84ADB  C2 20                    rep     #PMFLAG
 4237                                   .LONGA  on
 4238                                   .MNLIST
 4239  F84ADD  64 26                    stz     fexph           ; clear exponent sign extension 
 4240  F84ADF  64 3E                    stz     aexph
 4241  F84AE1  64 28                    stz     facext          ; extension used while mult/div
 4242  F84AE3  A5 20                    lda     facm+14
 4243  F84AE5  30 05                    bmi     ?a              ; fac is norml
 4244  F84AE7  A2 12                    ldx     #facm
 4245  F84AE9  20 D2 47                 jsr     shlmx           ; normalize subnormal fac
 4246  F84AEC  A5 38            ?a:     lda     argm+14
 4247  F84AEE  30 05                    bmi     ?b              ; arg is norml
 4248  F84AF0  A2 2A                    ldx     #argm
 4249  F84AF2  20 D2 47                 jsr     shlmx           ; normalize subnormal arg
 4250  F84AF5  28               ?b:     plp                     ; restore carry 
 4251  F84AF6                           CPU16
 4252  F84AF6  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 4253                                   .LONGA  on
 4254                                   .LONGI  on
 4255                                   .MNLIST
 4256  F84AF8  A5 3A                    lda     argexp
 4257  F84AFA  B0 14                    bcs     ?div            ; subtract exponent for division
 4258  F84AFC  65 22                    adc     facexp          ; add exponent with sign extension
 4259  F84AFE  AA                       tax
 4260  F84AFF  A5 3E                    lda     aexph
 4261  F84B01  65 26                    adc     fexph
 4262  F84B03  A8                       tay
 4263  F84B04  38                       sec
 4264  F84B05  8A                       txa
 4265  F84B06  E9 FE 3F                 sbc     #EBIAS-1        ; adjust biased exponent for mult
 4266  F84B09  AA                       tax
 4267  F84B0A  98                       tya
 4268  F84B0B  E9 00 00                 sbc     #0
 4269  F84B0E  80 12                    bra     ?tst            ; check exponent
 4270  F84B10  E5 22            ?div:   sbc     facexp          ; subtract exponent with sign extension
 4271  F84B12  AA                       tax
 4272  F84B13  A5 3E                    lda     aexph
 4273  F84B15  E5 26                    sbc     fexph
 4274  F84B17  A8                       tay
 4275  F84B18  18                       clc
 4276  F84B19  8A                       txa
 4277  F84B1A  69 FF 3F                 adc     #EBIAS          ; adjust biased exponent
 4278  F84B1D  AA                       tax
 4279  F84B1E  98                       tya
 4280  F84B1F  69 00 00                 adc     #0
 4281  F84B22  30 09            ?tst:   bmi     ?sn             ; negative exponent so result is subnormal
 4282  F84B24  8A                       txa
 4283  F84B25  F0 06                    beq     ?sn             ; null exponent so result is subnormal
 4284  F84B27  85 22                    sta     facexp          ; exp >= 1 so result is normal
 4285  F84B29  64 26                    stz     fexph
 4286  F84B2B  80 0D                    bra     ?done
  Tue Jul 17 11:00:18 2018                                                                                               Page   29




 4287  F84B2D  CA               ?sn:    dex                     ; negative count of shift toward right
 4288  F84B2E  E0 80 FF                 cpx     #MAXBSHIFT-1
 4289  F84B31  90 0A                    bcc     ?z              ; underflow: set fac=0
 4290  F84B33  86 26                    stx     fexph           ; negative count of shift
 4291  F84B35  A9 01 00                 lda     #1
 4292  F84B38  85 22                    sta     facexp          ; subnormasl have exponent=1
 4293  F84B3A                   ?done:  CPU08
 4294  F84B3A  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 4295                                   .LONGA  off
 4296                                   .LONGI  off
 4297                                   .MNLIST
 4298  F84B3C  60                       rts
 4299  F84B3D                   ?z:     CPU08                   ; underflow: load zero into fac...
 4300  F84B3D  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 4301                                   .LONGA  off
 4302                                   .LONGI  off
 4303                                   .MNLIST
 4304  F84B3F  68                       pla                     ; ...and exit
 4305  F84B40  68                       pla
 4306  F84B41  4C 56 4E                 jmp     fldz
 4307                           
 4308                           ; multm - binary multiplication of the arg mantissa with fac mantissa
 4309                           ;
 4310                           ; classic binary multiplication "shift and add" method
 4311                           ; only high order 144 bits of 256 are retained in result
 4312                           ; Due the fact that facm and argm are normalized, the result is
 4313                           ; always between 1.000000... and 2.ffffff....
 4314                           ;
 4315                           ; should be called with A/M=16 bits, X/Y=16 bits
 4316                           ;
 4317                           ; This routine is used internally and not intended for end use.
 4318                           ;
 4319                           ;-----
 4320  F84B44                   multm:
 4321                           ;-----
 4322                                   .LONGA  on
 4323                                   .LONGI  on
 4324                           
 4325  F84B44  A5 12                    lda     facm            ; multiply any word of facm with whole argm
 4326  F84B46  20 6B 4B                 jsr     ?mlt
 4327  F84B49  A5 14                    lda     facm+2
 4328  F84B4B  20 6B 4B                 jsr     ?mlt
 4329  F84B4E  A5 16                    lda     facm+4
 4330  F84B50  20 6B 4B                 jsr     ?mlt
 4331  F84B53  A5 18                    lda     facm+6
 4332  F84B55  20 6B 4B                 jsr     ?mlt
 4333  F84B58  A5 1A                    lda     facm+8
 4334  F84B5A  20 6B 4B                 jsr     ?mlt
 4335  F84B5D  A5 1C                    lda     facm+10
 4336  F84B5F  20 6B 4B                 jsr     ?mlt
 4337  F84B62  A5 1E                    lda     facm+12
 4338  F84B64  20 6B 4B                 jsr     ?mlt
 4339  F84B67  A5 20                    lda     facm+14         ; multiply msb that never is null
 4340  F84B69  80 02                    bra     ?mlt2   
 4341  F84B6B  F0 4F            ?mlt:   beq     ?shr            ; if null shift right partial result (16 bit)
 4342  F84B6D  4A               ?mlt2:  lsr     a               ; multiplicator bit
 4343  F84B6E  09 00 80                 ora     #$8000          ; bit for stop iteration (16 cycles)
  Tue Jul 17 11:00:18 2018                                                                                               Page   30




 4344  F84B71  A8               ?lp:    tay
 4345  F84B72  90 31                    bcc     ?sh             ; multiplicator=0 so shift result to right
 4346  F84B74  18                       clc
 4347  F84B75  A5 00                    lda     tm              ; add multiplicand to partial result
 4348  F84B77  65 2A                    adc     argm
 4349  F84B79  85 00                    sta     tm
 4350  F84B7B  A5 02                    lda     tm+2
 4351  F84B7D  65 2C                    adc     argm+2
 4352  F84B7F  85 02                    sta     tm+2
 4353  F84B81  A5 04                    lda     tm+4
 4354  F84B83  65 2E                    adc     argm+4
 4355  F84B85  85 04                    sta     tm+4
 4356  F84B87  A5 06                    lda     tm+6
 4357  F84B89  65 30                    adc     argm+6
 4358  F84B8B  85 06                    sta     tm+6
 4359  F84B8D  A5 08                    lda     tm+8
 4360  F84B8F  65 32                    adc     argm+8
 4361  F84B91  85 08                    sta     tm+8
 4362  F84B93  A5 0A                    lda     tm+10
 4363  F84B95  65 34                    adc     argm+10
 4364  F84B97  85 0A                    sta     tm+10
 4365  F84B99  A5 0C                    lda     tm+12
 4366  F84B9B  65 36                    adc     argm+12
 4367  F84B9D  85 0C                    sta     tm+12
 4368  F84B9F  A5 0E                    lda     tm+14
 4369  F84BA1  65 38                    adc     argm+14
 4370  F84BA3  85 0E                    sta     tm+14
 4371  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 right
 4373  F84BA9  66 0A                    ror     tm+10   
 4374  F84BAB  66 08                    ror     tm+8
 4375  F84BAD  66 06                    ror     tm+6
 4376  F84BAF  66 04                    ror     tm+4
 4377  F84BB1  66 02                    ror     tm+2
 4378  F84BB3  66 00                    ror     tm
 4379  F84BB5  66 28                    ror     facext          ; greater accuracy with this extension
 4380  F84BB7  98                       tya
 4381  F84BB8  4A                       lsr     a               ; end of loop when null
 4382  F84BB9  D0 B6                    bne     ?lp
 4383  F84BBB  60                       rts                     ; always return CF=1
 4384  F84BBC                           
 4385  F84BBC  A5 00            ?shr:   lda     tm              ; shift partial result toward right...
 4386  F84BBE  85 28                    sta     facext          ; ...16 bit at time
 4387  F84BC0  A5 02                    lda     tm+2
 4388  F84BC2  85 00                    sta     tm
 4389  F84BC4  A5 04                    lda     tm+4
 4390  F84BC6  85 02                    sta     tm+2
 4391  F84BC8  A5 06                    lda     tm+6
 4392  F84BCA  85 04                    sta     tm+4
 4393  F84BCC  A5 08                    lda     tm+8
 4394  F84BCE  85 06                    sta     tm+6
 4395  F84BD0  A5 0A                    lda     tm+10
 4396  F84BD2  85 08                    sta     tm+8
 4397  F84BD4  A5 0C                    lda     tm+12
 4398  F84BD6  85 0A                    sta     tm+10
 4399  F84BD8  A5 0E                    lda     tm+14
 4400  F84BDA  85 0C                    sta     tm+12
  Tue Jul 17 11:00:18 2018                                                                                               Page   31




 4401  F84BDC  64 0E                    stz     tm+14
 4402  F84BDE  60                       rts
 4403  F84BDF                           
 4404                                   .LONGA  off
 4405                                   .LONGI  off
 4406                           
 4407                           ; divm - computes the division of the arg mantissa by fac mantissa
 4408                           ;
 4409                           ; Classic fixed point division, that use the recurrence equation:
 4410                           ;
 4411                           ;       R    =  2*R  -  D*Q  
 4412                           ;        j+1       j       n-(j+1)      
 4413                           ;
 4414                           ;       R   =  V  ,  Q    = 1 if V >= D
 4415                           ;        0            n-1
 4416                           ;
 4417                           ; where: V=dividend, D=divisor, R  = partial remainder, Q  is the k-th
 4418                           ;                                j                       k
 4419                           ;
 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 is
 4425                           ; 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 mantissa
 4433  F84BE1  A9 01                    lda     #$01            ; 8 bits quotient -- quotient = 0
 4434  F84BE3  20 50 4C         ?lp1:   jsr     ?cmp            ; compare argm vs. facm
 4435  F84BE6  08               ?lp2:   php                     ; save carry (CF=1 if argm>=facm)
 4436  F84BE7  2A                       rol     a               ; shift in CF (quotient bit) into lsb
 4437  F84BE8  90 09                    bcc     ?sub            ; bits loop...stop when CF=1
 4438  F84BEA  CA                       dex                     ; index of quotient array
 4439  F84BEB  30 59                    bmi     ?done           ; end of division
 4440  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 only
 4442  F84BF1  A9 01                    lda     #$01            ; 8 bits quotient -- quotient = 0
 4443  F84BF3  28               ?sub:   plp                     ; restore CF from comparing argm vs. facm
 4444  F84BF4                           ACC16
 4445  F84BF4  C2 20                    rep     #PMFLAG
 4446                                   .LONGA  on
 4447                                   .MNLIST
 4448  F84BF6  90 32                    bcc     ?sh             ; quotient bit = 0: no subtraction
 4449  F84BF8  A8                       tay                     ; save partial quotient: here CF=1
 4450  F84BF9  A5 2A                    lda     argm            ; get the partial remainder...
 4451  F84BFB  E5 12                    sbc     facm            ; ...subtracting the divisor facm
 4452  F84BFD  85 2A                    sta     argm
 4453  F84BFF  A5 2C                    lda     argm+2
 4454  F84C01  E5 14                    sbc     facm+2
 4455  F84C03  85 2C                    sta     argm+2
 4456  F84C05  A5 2E                    lda     argm+4
 4457  F84C07  E5 16                    sbc     facm+4
  Tue Jul 17 11:00:18 2018                                                                                               Page   32




 4458  F84C09  85 2E                    sta     argm+4
 4459  F84C0B  A5 30                    lda     argm+6
 4460  F84C0D  E5 18                    sbc     facm+6
 4461  F84C0F  85 30                    sta     argm+6
 4462  F84C11  A5 32                    lda     argm+8
 4463  F84C13  E5 1A                    sbc     facm+8
 4464  F84C15  85 32                    sta     argm+8
 4465  F84C17  A5 34                    lda     argm+10
 4466  F84C19  E5 1C                    sbc     facm+10
 4467  F84C1B  85 34                    sta     argm+10
 4468  F84C1D  A5 36                    lda     argm+12
 4469  F84C1F  E5 1E                    sbc     facm+12
 4470  F84C21  85 36                    sta     argm+12
 4471  F84C23  A5 38                    lda     argm+14
 4472  F84C25  E5 20                    sbc     facm+14
 4473  F84C27  85 38                    sta     argm+14
 4474  F84C29  98                       tya                     ; restore partial quotient
 4475  F84C2A  06 2A            ?sh:    asl     argm            ; now shift argm to left (one place)
 4476  F84C2C  26 2C                    rol     argm+2
 4477  F84C2E  26 2E                    rol     argm+4
 4478  F84C30  26 30                    rol     argm+6
 4479  F84C32  26 32                    rol     argm+8
 4480  F84C34  26 34                    rol     argm+10
 4481  F84C36  26 36                    rol     argm+12
 4482  F84C38  26 38                    rol     argm+14
 4483  F84C3A                           ACC08
 4484  F84C3A  E2 20                    sep     #PMFLAG
 4485                                   .LONGA  off
 4486                                   .MNLIST
 4487  F84C3C  B0 A8                    bcs     ?lp2            ; CF=1: quotient bit = 1
 4488  F84C3E  30 A3                    bmi     ?lp1            ; CF=0, MSB=1: compare again argm vs. facm
 4489  F84C40  10 A4                    bpl     ?lp2            ; CF=0, MSB=0: quotient bit = 0
 4490  F84C42  A9 40            ?lst:   lda     #$40            ; 2 last bits quotient for normalitation...
 4491  F84C44  80 AD                    bra     ?sub            ; ...and rounding
 4492  F84C46  28               ?done:  plp                     ; end of division
 4493  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     a
 4497  F84C4B  0A                       asl     a
 4498  F84C4C  0A                       asl     a
 4499  F84C4D  85 29                    sta     facext+1        
 4500  F84C4F  60                       rts
 4501                           
 4502  F84C50  A4 39            ?cmp:   ldy     argm+15         ; comparation: arg mantissa vs. fac mantissa
 4503  F84C52  C4 21                    cpy     facm+15
 4504  F84C54  D0 58                    bne     ?end
 4505  F84C56  A4 38                    ldy     argm+14
 4506  F84C58  C4 20                    cpy     facm+14
 4507  F84C5A  D0 52                    bne     ?end    
 4508  F84C5C  A4 37                    ldy     argm+13
 4509  F84C5E  C4 1F                    cpy     facm+13
 4510  F84C60  D0 4C                    bne     ?end
 4511  F84C62  A4 36                    ldy     argm+12
 4512  F84C64  C4 1E                    cpy     facm+12
 4513  F84C66  D0 46                    bne     ?end
 4514  F84C68  A4 35                    ldy     argm+11
  Tue Jul 17 11:00:18 2018                                                                                               Page   33




 4515  F84C6A  C4 1D                    cpy     facm+11
 4516  F84C6C  D0 40                    bne     ?end
 4517  F84C6E  A4 34                    ldy     argm+10
 4518  F84C70  C4 1C                    cpy     facm+10
 4519  F84C72  D0 3A                    bne     ?end
 4520  F84C74  A4 33                    ldy     argm+9
 4521  F84C76  C4 1B                    cpy     facm+9
 4522  F84C78  D0 34                    bne     ?end
 4523  F84C7A  A4 32                    ldy     argm+8
 4524  F84C7C  C4 1A                    cpy     facm+8
 4525  F84C7E  D0 2E                    bne     ?end
 4526  F84C80  A4 31                    ldy     argm+7
 4527  F84C82  C4 19                    cpy     facm+7
 4528  F84C84  D0 28                    bne     ?end
 4529  F84C86  A4 30                    ldy     argm+6
 4530  F84C88  C4 18                    cpy     facm+6
 4531  F84C8A  D0 22                    bne     ?end
 4532  F84C8C  A4 2F                    ldy     argm+5
 4533  F84C8E  C4 17                    cpy     facm+5
 4534  F84C90  D0 1C                    bne     ?end
 4535  F84C92  A4 2E                    ldy     argm+4
 4536  F84C94  C4 16                    cpy     facm+4
 4537  F84C96  D0 16                    bne     ?end
 4538  F84C98  A4 2D                    ldy     argm+3
 4539  F84C9A  C4 15                    cpy     facm+3
 4540  F84C9C  D0 10                    bne     ?end
 4541  F84C9E  A4 2C                    ldy     argm+2
 4542  F84CA0  C4 14                    cpy     facm+2
 4543  F84CA2  D0 0A                    bne     ?end
 4544  F84CA4  A4 2B                    ldy     argm+1
 4545  F84CA6  C4 13                    cpy     facm+1
 4546  F84CA8  D0 04                    bne     ?end
 4547  F84CAA  A4 2A                    ldy     argm
 4548  F84CAC  C4 12                    cpy     facm
 4549  F84CAE  60               ?end:   rts
 4550                           
 4551                           ; multst - test operands before to execute multiplication
 4552                           ;
 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=nan
 4557                           ;       2) return +inf if fac=+inf and arg=+inf or arg>0
 4558                           ;       3) return +inf if fac=-inf and arg=-inf or arg<0
 4559                           ;       4) return -inf if fac=-inf and arg=+inf or arg>0
 4560                           ;       5) return -inf if fac=+inf and arg=-inf or arg<0
 4561                           ;       6) return +inf if arg=+inf and fac>0
 4562                           ;       7) return +inf if arg=-inf and fac<0
 4563                           ;       8) return -inf if arg=-inf and fac>0
 4564                           ;       9) return -inf if arg=+inf and fac<0
 4565                           ;      10) return nan if fac=+/-inf and arg=0
 4566                           ;      11) return nan if arg=+/-inf and fac=0
 4567                           ;
 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   34




 4572                           ;------
 4573  F84CAF  A5 24                    lda     facsgn          ; compare sign
 4574  F84CB1  45 3C                    eor     argsgn
 4575  F84CB3  85 24                    sta     facsgn          ; set result sign
 4576  F84CB5  85 3C                    sta     argsgn
 4577  F84CB7  38                       sec                     ; invalid result flag
 4578  F84CB8  24 25                    bit     facst           ; test fac
 4579  F84CBA  10 0E                    bpl     ?fv             ; fac is valid
 4580  F84CBC  50 2A                    bvc     ?skp            ; fac=nan so result=nan
 4581  F84CBE  24 3D                    bit     argst           ; fac=inf so check arg
 4582  F84CC0  10 04                    bpl     ?az             ; fac=inf & arg=y so check if arg=0
 4583  F84CC2  50 21                    bvc     ?mv             ; fac=inf & arg=nan so result=nan
 4584  F84CC4  80 22                    bra     ?skp            ; fac=inf & arg=inf so result=inf
 4585  F84CC6  50 20            ?az:    bvc     ?skp            ; fac=inf & arg not null so result=inf
 4586  F84CC8  80 0A                    bra     ?nan            ; fac=inf & arg=0 so result=nan
 4587  F84CCA  24 3D            ?fv:    bit     argst           ; fac is valid, so now check arg
 4588  F84CCC  10 0B                    bpl     ?vv             ; arg too is valid
 4589  F84CCE  50 15                    bvc     ?mv             ; fac=x & arg=nan so result=nan
 4590  F84CD0  24 25                    bit     facst           ; fac=x & arg=inf so check if fac=0
 4591  F84CD2  50 11                    bvc     ?mv             ; fac not null & arg=inf so result=inf
 4592  F84CD4  20 74 4E         ?nan:   jsr     fldnan          ; fac=0 & arg=inf so result=nan
 4593  F84CD7  80 0F                    bra     ?skp            ; skip resturn & exit with CF=1
 4594  F84CD9  18               ?vv:    clc                     ; now result is valid
 4595  F84CDA  70 09                    bvs     ?mv             ; arg=0 so result=0
 4596  F84CDC  24 25                    bit     facst           ; fac=0?
 4597  F84CDE  50 0A                    bvc     ?end            ; no, return to mult operation
 4598  F84CE0  20 56 4E                 jsr     fldz            ; result=0 (with CF=0)
 4599  F84CE3  80 03                    bra     ?skp
 4600  F84CE5  20 0C 84         ?mv:    jsr     mvatof          ; move arg to fac (preserve CF)
 4601  F84CE8  68               ?skp:   pla                     ; skip return address
 4602  F84CE9  68                       pla
 4603  F84CEA  60               ?end:   rts
 4604                           
 4605                           ; divtst - test operands before to execute division
 4606                           ;
 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=nan
 4611                           ;       2) return nan if fac=0 and arg=0
 4612                           ;       3) return nan if fac=+/-inf and arg=+/-inf
 4613                           ;       4) return +inf if arg=+inf and fac>=0
 4614                           ;       5) return +inf if arg=-inf and fac<0
 4615                           ;       6) return -inf if arg=-inf and fac>=0
 4616                           ;       7) return -inf if arg=+inf and fac<0
 4617                           ;       8) return +inf if arg>0 and fac=0
 4618                           ;       9) return -inf if arg<0 and fac=0
 4619                           ;      10) return 0 if arg=0 and fac=+/-inf
 4620                           ;
 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 sign
 4627  F84CED  45 3C                    eor     argsgn
 4628  F84CEF  85 24                    sta     facsgn          ; set result sign
  Tue Jul 17 11:00:18 2018                                                                                               Page   35




 4629  F84CF1  85 3C                    sta     argsgn
 4630  F84CF3  38                       sec                     ; invalid result flag
 4631  F84CF4  24 25                    bit     facst           ; test fac
 4632  F84CF6  10 08                    bpl     ?fv             ; fac is valid
 4633  F84CF8  50 29                    bvc     ?skp            ; fac=nan so result=nan
 4634  F84CFA  24 3D                    bit     argst           ; fac=inf so check arg
 4635  F84CFC  30 18                    bmi     ?nan            ; fac=inf & arg=inf/nan so result=nan
 4636  F84CFE  80 11                    bra     ?z              ; fac=inf & arg=y so result=0   
 4637  F84D00  A5 3D            ?fv:    lda     argst           ; fac is valid, so now check arg
 4638  F84D02  30 1C                    bmi     ?mv             ; fac=x & arg=nan/inf so result=nan/inf
 4639  F84D04  25 25                    and     facst
 4640  F84D06  0A                       asl     a               ; both null?
 4641  F84D07  30 0D                    bmi     ?nan            ; yes so result=nan
 4642  F84D09  24 25                    bit     facst
 4643  F84D0B  70 0E                    bvs     ?inf
 4644  F84D0D  24 3D                    bit     argst
 4645  F84D0F  50 14                    bvc     ?end
 4646  F84D11  20 56 4E         ?z:     jsr     fldz            ; result=0 (with CF=0)
 4647  F84D14  80 0D                    bra     ?skp
 4648  F84D16  20 74 4E         ?nan:   jsr     fldnan          ; fac=0 & arg=0 so result=nan
 4649  F84D19  80 08                    bra     ?skp            ; skip resturn & exit with CF=1 
 4650  F84D1B  20 7D 4E         ?inf:   jsr     fldinf
 4651  F84D1E  80 03                    bra     ?skp
 4652  F84D20  20 0C 84         ?mv:    jsr     mvatof          ; move arg to fac (preserve CF)
 4653  F84D23  68               ?skp:   pla                     ; skip return address
 4654  F84D24  68                       pla
 4655  F84D25  60               ?end:   rts
 4656                           
 4657                           ;---------------------------------------------------------------------------
 4658                           ; pack/unpack to/from 128 bit quadruple-precision IEEE format
 4659                           ; these routines convert to/from internal format from/to std. IEEE format
 4660                           ;---------------------------------------------------------------------------
 4661                           
 4662                           ; frndm - round 128-bit fac mantissa to 113-bit mantissa 
 4663                           ;
 4664                           ; standard rounding method: round to nearest and tie to even
 4665                           ;
 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 up
 4670                           ;       if G = $8000 then 'tie even':
 4671                           ;               if L = 0 then round down (truncate)
 4672                           ;                        else round up
 4673                           ;
 4674                           ; if exponent equal to $7FFE and mantissa is all 1's, no round up take place, 
 4675                           ; to avoid ovorflow
 4676                           ;
 4677                           ; The main use of this routine is to round fac before to convert to IEEE
 4678                           ; format, but can be called after any operation (of course losing guard bits)
 4679                           ;
 4680                           ;-----
 4681  F84D26                   frndm:
 4682                           ;-----
 4683  F84D26                           CPU16
 4684  F84D26  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 4685                                   .LONGA  on
  Tue Jul 17 11:00:18 2018                                                                                               Page   36




 4686                                   .LONGI  on
 4687                                   .MNLIST
 4688  F84D28  A5 12                    lda     facm            ; check guard bits
 4689  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 up
 4694  F84D33  A5 22                    lda     facexp          ; we check exponent for possible overflow
 4695  F84D35  20 AF 4A                 jsr     chkovf
 4696  F84D38  B0 14                    bcs     ?done           ; no round is possible (avoid overflow) 
 4697  F84D3A  8A               ?rnd:   txa                     ; check guard bits
 4698  F84D3B  0A                       asl     a
 4699  F84D3C  C9 00 80                 cmp     #$8000
 4700  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 up
 4705  F84D47  69 FF 7F                 adc     #$7FFF          ; really add $8000
 4706  F84D4A  85 12                    sta     facm            ; lsb sigificand
 4707  F84D4C  B0 03                    bcs     ?inc            ; mantissa increment, because carry from lsb
 4708  F84D4E                   ?done:  CPU08
 4709  F84D4E  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 4710                                   .LONGA  off
 4711                                   .LONGI  off
 4712                                   .MNLIST
 4713  F84D50  60                       rts
 4714  F84D51  4C 85 4A         ?inc:   jmp     incfac          ; now this increment never cause overflow
 4715                           
 4716                           
 4717                           ; pack - pack fac & store in memory in std. quadruple precision IEEE format
 4718                           ;
 4719                           ; Main routine to store in memory a floating point number
 4720                           ;
 4721                           ;       entry:
 4722                           ;               fac = float point
 4723                           ;               A   = low  memory address
 4724                           ;               X   = high memory address
 4725                           ;               Y   = memory bank
 4726                           ;
 4727                           ;       exit:
 4728                           ;               quadruple precision stored in memory
 4729                           ;
 4730                           ; This routine round 128-bit fac mantissa to 113-bit mantissa, pack to
 4731                           ; quadruple precision IEEE standard format, and store it in memory
 4732                           ;
 4733                           ;-----
 4734  F84D54                   fpack:
 4735                           ;-----
 4736  F84D54  85 42                    sta     fcp             ; set long pointer to memory buffer
 4737  F84D56  86 43                    stx     fcp+1
 4738  F84D58  84 44                    sty     fcp+2
 4739  F84D5A  20 26 4D                 jsr     frndm           ; round fac to 113 bit mantissa
 4740  F84D5D                           ACC16
 4741  F84D5D  C2 20                    rep     #PMFLAG
 4742                                   .LONGA  on
  Tue Jul 17 11:00:18 2018                                                                                               Page   37




 4743                                   .MNLIST
 4744  F84D5F  A5 12                    lda     facm
 4745  F84D61  0A                       asl     a               ; rotate lsb of packed format
 4746  F84D62  A5 14                    lda     facm+2          ; rotate all remaining 112 bits...
 4747  F84D64  2A                       rol     a
 4748  F84D65  87 42                    sta     [fcp]           ; ...and store
 4749  F84D67  A5 16                    lda     facm+4
 4750  F84D69  2A                       rol     a
 4751  F84D6A  A0 02                    ldy     #2
 4752  F84D6C  97 42                    sta     [fcp],y
 4753  F84D6E  A5 18                    lda     facm+6
 4754  F84D70  2A                       rol     a
 4755  F84D71  A0 04                    ldy     #4
 4756  F84D73  97 42                    sta     [fcp],y
 4757  F84D75  A5 1A                    lda     facm+8
 4758  F84D77  2A                       rol     a
 4759  F84D78  A0 06                    ldy     #6
 4760  F84D7A  97 42                    sta     [fcp],y
 4761  F84D7C  A5 1C                    lda     facm+10
 4762  F84D7E  2A                       rol     a
 4763  F84D7F  A0 08                    ldy     #8
 4764  F84D81  97 42                    sta     [fcp],y
 4765  F84D83  A5 1E                    lda     facm+12
 4766  F84D85  2A                       rol     a
 4767  F84D86  A0 0A                    ldy     #10
 4768  F84D88  97 42                    sta     [fcp],y
 4769  F84D8A  A5 20                    lda     facm+14
 4770  F84D8C  2A                       rol     a               ; CF = hidden bit (msb)
 4771  F84D8D  A0 0C                    ldy     #12
 4772  F84D8F  97 42                    sta     [fcp],y 
 4773  F84D91  A5 22                    lda     facexp
 4774  F84D93  B0 03                    bcs     ?fn             ; CF=1 mean normal float
 4775  F84D95  A9 00 00                 lda     #0              ; subnormal float or zero
 4776  F84D98  A6 24            ?fn:    ldx     facsgn
 4777  F84D9A  10 03                    bpl     ?exp            ; positive float
 4778  F84D9C  09 00 80                 ora     #$8000          ; negative float
 4779  F84D9F  A0 0E            ?exp:   ldy     #14
 4780  F84DA1  97 42                    sta     [fcp],y
 4781  F84DA3                           ACC08
 4782  F84DA3  E2 20                    sep     #PMFLAG
 4783                                   .LONGA  off
 4784                                   .MNLIST
 4785  F84DA5  60                       rts
 4786                           
 4787                           ; unpack - get a quadruple precision IEEE format from memory and store in fac
 4788                           ;
 4789                           ; Main routine to load fac with a floating point number stored in memory
 4790                           ;
 4791                           ;       entry:
 4792                           ;               A   = low  memory address
 4793                           ;               X   = high memory address
 4794                           ;               Y   = memory bank
 4795                           ;
 4796                           ;       exit:
 4797                           ;               fac = floating point number in internal fortmat
 4798                           ;
 4799                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page   38




 4800                           ;-------
 4801  F84DA6                   funpack:
 4802                           ;-------
 4803  F84DA6  85 42                    sta     fcp             ; set long pointer to memory buffer
 4804  F84DA8  86 43                    stx     fcp+1
 4805  F84DAA  84 44                    sty     fcp+2
 4806  F84DAC                           ACC16CLC                ; CF=0: assume hidden bit = 0
 4807  F84DAC  C2 21                    rep     #(PMFLAG.OR.PCFLAG)
 4808                                   .LONGA  on
 4809                                   .MNLIST
 4810  F84DAE  A2 00                    ldx     #0              ; assume positive sign
 4811  F84DB0  A0 0E                    ldy     #14
 4812  F84DB2  B7 42                    lda     [fcp],y         ; exponent
 4813  F84DB4  10 01                    bpl     ?fp             ; positive float
 4814  F84DB6  CA                       dex                     ; negative float
 4815  F84DB7  86 24            ?fp:    stx     facsgn
 4816  F84DB9  A2 00                    ldx     #$00            ; assume normal float
 4817  F84DBB  29 FF 7F                 and     #$7FFF          ; mask off sign
 4818  F84DBE  85 22                    sta     facexp
 4819  F84DC0  F0 01                    beq     ?get            ; zero or subnormal (msb=0)
 4820  F84DC2  38                       sec                     ; hidden bit: msb=1
 4821  F84DC3  A0 0C            ?get:   ldy     #12
 4822  F84DC5  B7 42                    lda     [fcp],y         ; significand
 4823  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 mantissa
 4826  F84DCC  B7 42                    lda     [fcp],y
 4827  F84DCE  6A                       ror     a
 4828  F84DCF  85 1E                    sta     facm+12
 4829  F84DD1  A0 08                    ldy     #8
 4830  F84DD3  B7 42                    lda     [fcp],y
 4831  F84DD5  6A                       ror     a
 4832  F84DD6  85 1C                    sta     facm+10
 4833  F84DD8  A0 06                    ldy     #6
 4834  F84DDA  B7 42                    lda     [fcp],y
 4835  F84DDC  6A                       ror     a
 4836  F84DDD  85 1A                    sta     facm+8
 4837  F84DDF  A0 04                    ldy     #4
 4838  F84DE1  B7 42                    lda     [fcp],y
 4839  F84DE3  6A                       ror     a
 4840  F84DE4  85 18                    sta     facm+6
 4841  F84DE6  A0 02                    ldy     #2
 4842  F84DE8  B7 42                    lda     [fcp],y
 4843  F84DEA  6A                       ror     a
 4844  F84DEB  85 16                    sta     facm+4
 4845  F84DED  A7 42                    lda     [fcp]
 4846  F84DEF  6A                       ror     a
 4847  F84DF0  85 14                    sta     facm+2
 4848  F84DF2  8A                       txa                     ; shift in lsb
 4849  F84DF3  6A                       ror     a               ; <14:0> are all zero (guard bits)
 4850  F84DF4  85 12                    sta     facm
 4851  F84DF6  A5 22                    lda     facexp          ; check exponent
 4852  F84DF8  F0 17                    beq     ?chkz           ; if exp=0 check if fac=0       
 4853  F84DFA  C9 FF 7F                 cmp     #INFEXP
 4854  F84DFD  90 2A                    bcc     ?st             ; valid float, set status
 4855  F84DFF  A9 FF 7F                 lda     #INFEXP
 4856  F84E02  85 22                    sta     facexp          ; fac=inf or fac=nan
  Tue Jul 17 11:00:18 2018                                                                                               Page   39




 4857  F84E04  A2 C0                    ldx     #$C0            ; assume inf
 4858  F84E06  A5 20                    lda     facm+14         ; check type
 4859  F84E08  C9 00 80                 cmp     #INFSND
 4860  F84E0B  F0 1C                    beq     ?st             ; set inf in fac stastus
 4861  F84E0D  A2 80                    ldx     #$80            ; set nan in fac status
 4862  F84E0F  80 18                    bra     ?st
 4863  F84E11  A5 12            ?chkz:  lda     facm            ; exponent is zero: check if fac=0
 4864  F84E13  05 14                    ora     facm+2
 4865  F84E15  05 16                    ora     facm+4
 4866  F84E17  05 18                    ora     facm+6
 4867  F84E19  05 1A                    ora     facm+8
 4868  F84E1B  05 1C                    ora     facm+10
 4869  F84E1D  05 1E                    ora     facm+12
 4870  F84E1F  05 20                    ora     facm+14
 4871  F84E21  D0 04                    bne     ?sn             ; fac is subnormal
 4872  F84E23  A2 40                    ldx     #$40            ; fac is zero
 4873  F84E25  80 02                    bra     ?st
 4874  F84E27  E6 22            ?sn:    inc     facexp          ; subnormal exponent = 1
 4875  F84E29  86 25            ?st:    stx     facst           ; set fac status
 4876  F84E2B                           ACC08
 4877  F84E2B  E2 20                    sep     #PMFLAG
 4878                                   .LONGA  off
 4879                                   .MNLIST
 4880  F84E2D  60                       rts
 4881                           
 4882                           ;---------------------------------------------------------------------------
 4883                           ; load fac & arg with special values
 4884                           ;---------------------------------------------------------------------------
 4885                           
 4886                           ; fldp1 - load the constant +1.0 into fac
 4887                           ;
 4888                           ;       exit:
 4889                           ;               fac = +1.0
 4890                           ;
 4891                           ;-----
 4892  F84E2E                   fldp1:
 4893                           ;-----
 4894  F84E2E  64 24                    stz     facsgn
 4895  F84E30  80 04                    bra     fld1
 4896                           
 4897                           ; fldm1 - load the constant -1.0 into fac
 4898                           ;
 4899                           ;       exit:
 4900                           ;               fac = -1.0
 4901                           ;
 4902                           ;-----
 4903  F84E32                   fldm1:
 4904                           ;-----
 4905  F84E32  A9 FF                    lda     #$FF
 4906  F84E34  85 24                    sta     facsgn
 4907                           
 4908                           ;----
 4909  F84E36                   fld1:
 4910                           ;----
 4911  F84E36                           ACC16
 4912  F84E36  C2 20                    rep     #PMFLAG
 4913                                   .LONGA  on
  Tue Jul 17 11:00:18 2018                                                                                               Page   40




 4914                                   .MNLIST
 4915  F84E38  A9 FF 3F                 lda     #EBIAS
 4916  F84E3B  85 22                    sta     facexp
 4917  F84E3D  A9 00 80                 lda     #$8000
 4918  F84E40  85 20                    sta     facm+14 
 4919  F84E42  64 12                    stz     facm
 4920  F84E44  64 14                    stz     facm+2
 4921  F84E46  64 16                    stz     facm+4
 4922  F84E48  64 18                    stz     facm+6
 4923  F84E4A  64 1A                    stz     facm+8
 4924  F84E4C  64 1C                    stz     facm+10
 4925  F84E4E  64 1E                    stz     facm+12
 4926  F84E50                           ACC08
 4927  F84E50  E2 20                    sep     #PMFLAG
 4928                                   .LONGA  off
 4929                                   .MNLIST
 4930  F84E52  64 25                    stz     facst
 4931  F84E54  18                       clc
 4932  F84E55  60                       rts
 4933                           
 4934                           ; fldz - load the constant 0.0 into fac
 4935                           ;
 4936                           ;       exit:
 4937                           ;               fac = 0.0
 4938                           ;
 4939                           ;----
 4940  F84E56                   fldz:
 4941                           ;----
 4942  F84E56                           ACC16
 4943  F84E56  C2 20                    rep     #PMFLAG
 4944                                   .LONGA  on
 4945                                   .MNLIST
 4946  F84E58  64 20                    stz     facm+14 
 4947  F84E5A  64 22                    stz     facexp
 4948  F84E5C  64 12                    stz     facm
 4949  F84E5E  64 14                    stz     facm+2
 4950  F84E60  64 16                    stz     facm+4
 4951  F84E62  64 18                    stz     facm+6
 4952  F84E64  64 1A                    stz     facm+8
 4953  F84E66  64 1C                    stz     facm+10
 4954  F84E68  64 1E                    stz     facm+12
 4955  F84E6A                           ACC08
 4956  F84E6A  E2 20                    sep     #PMFLAG
 4957                                   .LONGA  off
 4958                                   .MNLIST
 4959  F84E6C  64 24                    stz     facsgn
 4960  F84E6E  A9 40                    lda     #$40
 4961  F84E70  85 25                    sta     facst
 4962  F84E72  18               noer:   clc
 4963  F84E73  60                       rts
 4964                           
 4965                           ; fldnan - set fac=nan
 4966                           ;------
 4967  F84E74                   fldnan:
 4968                           ;------
 4969  F84E74                           ACC16
 4970  F84E74  C2 20                    rep     #PMFLAG
  Tue Jul 17 11:00:18 2018                                                                                               Page   41




 4971                                   .LONGA  on
 4972                                   .MNLIST
 4973  F84E76  A9 00 C0                 lda     #NANSND
 4974  F84E79  A2 80                    ldx     #$80            ; nan flag
 4975  F84E7B  80 07                    bra     fldinv
 4976                           
 4977                           ; fldinf - set fac=inf
 4978                           ;------
 4979  F84E7D                   fldinf:
 4980                           ;------
 4981  F84E7D                           ACC16
 4982  F84E7D  C2 20                    rep     #PMFLAG
 4983                                   .LONGA  on
 4984                                   .MNLIST
 4985  F84E7F  A9 00 80                 lda     #INFSND
 4986  F84E82  A2 C0                    ldx     #$C0            ; inf flag
 4987                           
 4988  F84E84                   fldinv:
 4989  F84E84  85 20                    sta     facm+14         ; set msb
 4990  F84E86  A9 FF 7F                 lda     #INFEXP         ; set invalid exponent
 4991  F84E89  85 22                    sta     facexp
 4992  F84E8B  64 1E                    stz     facm+12
 4993  F84E8D  64 1C                    stz     facm+10
 4994  F84E8F  64 1A                    stz     facm+8
 4995  F84E91  64 18                    stz     facm+6
 4996  F84E93  64 16                    stz     facm+4
 4997  F84E95  64 14                    stz     facm+2
 4998  F84E97  64 12                    stz     facm
 4999  F84E99                           ACC08
 5000  F84E99  E2 20                    sep     #PMFLAG
 5001                                   .LONGA  off
 5002                                   .MNLIST
 5003  F84E9B  86 25                    stx     facst
 5004  F84E9D  38                       sec                     ; return error condition
 5005  F84E9E  60                       rts
 5006                           
 5007                           ; ldahalf - load the constant 0.5 into arg
 5008                           ;
 5009                           ;       exit:
 5010                           ;               arg = 0.5
 5011                           ;
 5012                           ;-------
 5013  F84E9F                   ldahalf:
 5014                           ;-------
 5015  F84E9F                           ACC16
 5016  F84E9F  C2 20                    rep     #PMFLAG
 5017                                   .LONGA  on
 5018                                   .MNLIST
 5019  F84EA1  A9 FE 3F                 lda     #EBIAS-1
 5020  F84EA4  80 0C                    bra     amsb
 5021                           
 5022                           ; ldaone - load the constant +1.0 into arg
 5023                           ;
 5024                           ;       exit:
 5025                           ;               arg = +1.0
 5026                           ;
 5027                           ;------
  Tue Jul 17 11:00:18 2018                                                                                               Page   42




 5028  F84EA6                   ldaone:
 5029                           ;------
 5030  F84EA6                           ACC16
 5031  F84EA6  C2 20                    rep     #PMFLAG
 5032                                   .LONGA  on
 5033                                   .MNLIST
 5034  F84EA8  A9 FF 3F                 lda     #EBIAS
 5035  F84EAB  80 05                    bra     amsb
 5036                           
 5037                           ; ldatwo - load the constant +2.0 into arg
 5038                           ;
 5039                           ;       exit:
 5040                           ;               arg = +2.0
 5041                           ;
 5042                           ;------
 5043  F84EAD                   ldatwo:
 5044                           ;------
 5045  F84EAD                           ACC16
 5046  F84EAD  C2 20                    rep     #PMFLAG
 5047                                   .LONGA  on
 5048                                   .MNLIST
 5049  F84EAF  A9 00 40                 lda     #EBIAS+1
 5050                           
 5051  F84EB2                   amsb:
 5052  F84EB2  85 3A                    sta     argexp          ; store exponent
 5053  F84EB4  A9 00 80                 lda     #$8000
 5054  F84EB7  85 38                    sta     argm+14         ; high word = $8000
 5055  F84EB9  64 2A                    stz     argm            ; reset all remaining bits
 5056  F84EBB  64 2C                    stz     argm+2
 5057  F84EBD  64 2E                    stz     argm+4
 5058  F84EBF  64 30                    stz     argm+6
 5059  F84EC1  64 32                    stz     argm+8
 5060  F84EC3  64 34                    stz     argm+10
 5061  F84EC5  64 36                    stz     argm+12
 5062  F84EC7  64 3C                    stz     argsgn          ; positive sign
 5063  F84EC9                           ACC08
 5064  F84EC9  E2 20                    sep     #PMFLAG
 5065                                   .LONGA  off
 5066                                   .MNLIST
 5067  F84ECB  18                       clc     
 5068  F84ECC  60                       rts
 5069                           
 5070                           ;---------------------------------------------------------------------------
 5071                           ; conversion from integer to float & from float to integer
 5072                           ;---------------------------------------------------------------------------
 5073                           
 5074                           ; fldu128 - load fac with an unsigned 128 bit integer (n)
 5075                           ;
 5076                           ;       entry:
 5077                           ;               tm..tm+15 = n, unsigned 128 bit integer
 5078                           ;
 5079                           ;       exit:
 5080                           ;               fac = n
 5081                           ;
 5082                           ;-------
 5083  F84ECD                   fldu128:
 5084                           ;-------
  Tue Jul 17 11:00:18 2018                                                                                               Page   43




 5085  F84ECD  20 56 4E                 jsr     fldz            ; set fac=0
 5086  F84ED0  64 24                    stz     facsgn
 5087  F84ED2                           ACC16
 5088  F84ED2  C2 20                    rep     #PMFLAG
 5089                                   .LONGA  on
 5090                                   .MNLIST
 5091  F84ED4  A5 0E                    lda     tm+14           ; load 128 bit value
 5092  F84ED6  85 20                    sta     facm+14
 5093  F84ED8  A5 0C                    lda     tm+12
 5094  F84EDA  85 1E                    sta     facm+12
 5095  F84EDC  A5 0A                    lda     tm+10
 5096  F84EDE  85 1C                    sta     facm+10
 5097  F84EE0  A5 08                    lda     tm+8
 5098  F84EE2  85 1A                    sta     facm+8
 5099  F84EE4  A5 06                    lda     tm+6
 5100  F84EE6  85 18                    sta     facm+6
 5101  F84EE8  A5 04                    lda     tm+4
 5102  F84EEA  85 16                    sta     facm+4
 5103  F84EEC  A5 02                    lda     tm+2
 5104  F84EEE  85 14                    sta     facm+2
 5105  F84EF0  A5 00                    lda     tm
 5106  F84EF2  85 12                    sta     facm
 5107  F84EF4  05 14                    ora     facm+2          ; test if n=0
 5108  F84EF6  05 16                    ora     facm+4
 5109  F84EF8  05 18                    ora     facm+6
 5110  F84EFA  05 1A                    ora     facm+8
 5111  F84EFC  05 1C                    ora     facm+10
 5112  F84EFE  05 1E                    ora     facm+12
 5113  F84F00  05 20                    ora     facm+14
 5114  F84F02  F0 29                    beq     okz             ; n=0
 5115  F84F04  A9 7E 40                 lda     #BIAS128        ; biased exponent for 128 bit value     
 5116  F84F07  80 66                    bra     fldu
 5117                           
 5118                                   .LONGA  off
 5119                           
 5120                           ; fldu64 - load fac with an unsigned 64 bit integer (n)
 5121                           ;
 5122                           ;       entry:
 5123                           ;               tm..tm+7 = n, unsigned 64 bit integer
 5124                           ;
 5125                           ;       exit:
 5126                           ;               fac = n
 5127                           ;
 5128                           ;------
 5129  F84F09                   fldu64:
 5130                           ;------
 5131  F84F09  20 56 4E                 jsr     fldz            ; set fac=0
 5132  F84F0C  64 24                    stz     facsgn
 5133  F84F0E                           ACC16
 5134  F84F0E  C2 20                    rep     #PMFLAG
 5135                                   .LONGA  on
 5136                                   .MNLIST
 5137  F84F10  A5 06                    lda     tm+6            ; load 64 bit value
 5138  F84F12  85 20                    sta     facm+14
 5139  F84F14  A5 04                    lda     tm+4
 5140  F84F16  85 1E                    sta     facm+12
 5141  F84F18  A5 02                    lda     tm+2
  Tue Jul 17 11:00:18 2018                                                                                               Page   44




 5142  F84F1A  85 1C                    sta     facm+10
 5143  F84F1C  A5 00                    lda     tm
 5144  F84F1E  85 1A                    sta     facm+8
 5145  F84F20  05 1C                    ora     facm+10         ; test if n=0
 5146  F84F22  05 1E                    ora     facm+12
 5147  F84F24  05 20                    ora     facm+14
 5148  F84F26  F0 05                    beq     okz             ; n=0
 5149  F84F28  A9 3E 40                 lda     #BIAS64         ; biased exponent for 64 bit value      
 5150  F84F2B  80 42                    bra     fldu
 5151                           
 5152                                   .LONGA  off
 5153                           
 5154  F84F2D                   okz:    ACC08
 5155  F84F2D  E2 20                    sep     #PMFLAG
 5156                                   .LONGA  off
 5157                                   .MNLIST
 5158  F84F2F  18                       clc
 5159  F84F30  60                       rts
 5160                           
 5161                           ; fldu32 - load fac with an unsigned 32 bit integer (n)
 5162                           ;
 5163                           ;       entry:
 5164                           ;               tm..tm+3 = n, unsigned 32 bit integer
 5165                           ;
 5166                           ;       exit:
 5167                           ;               fac = n
 5168                           ;
 5169                           ;------
 5170  F84F31                   fldu32:
 5171                           ;------
 5172  F84F31  20 56 4E                 jsr     fldz            ; set fac=0
 5173  F84F34  64 24                    stz     facsgn
 5174  F84F36                           ACC16
 5175  F84F36  C2 20                    rep     #PMFLAG
 5176                                   .LONGA  on
 5177                                   .MNLIST
 5178  F84F38  A5 02                    lda     tm+2
 5179  F84F3A  85 20                    sta     facm+14         ; load 32 bit value
 5180  F84F3C  A5 00                    lda     tm
 5181  F84F3E  85 1E                    sta     facm+12
 5182  F84F40  05 20                    ora     facm+14         ; test if n=0
 5183  F84F42  F0 E9                    beq     okz             ; n=0
 5184  F84F44  A9 1E 40                 lda     #BIAS32         ; biased exponent for 32 bit value      
 5185  F84F47  80 26                    bra     fldu
 5186                           
 5187                                   .LONGA  off
 5188                           
 5189                           ; fldbyt - load fac with an unsigned 8 bit integer (n)
 5190                           ;
 5191                           ;       entry:
 5192                           ;               A = n, unsigned 8 bit integer
 5193                           ;
 5194                           ;       exit:
 5195                           ;               fac = n
 5196                           ;
 5197                           ;------
 5198  F84F49                   fldbyt:
  Tue Jul 17 11:00:18 2018                                                                                               Page   45




 5199                           ;------
 5200  F84F49  AA                       tax                     ; save A
 5201  F84F4A  20 56 4E                 jsr     fldz            ; set fac=0
 5202  F84F4D  64 24                    stz     facsgn
 5203  F84F4F  8A                       txa
 5204  F84F50  F0 DB                    beq     okz             ; n=0   
 5205  F84F52  86 21                    stx     facm+15         ; put byte in high order bits
 5206  F84F54                           ACC16
 5207  F84F54  C2 20                    rep     #PMFLAG
 5208                                   .LONGA  on
 5209                                   .MNLIST
 5210  F84F56  A9 06 40                 lda     #BIAS8          ; biased exponent for 8 bit value
 5211  F84F59  80 14                    bra     fldu
 5212                           
 5213                                   .LONGA  off
 5214  F84F5B                           
 5215                           ; fldu16 - load fac with an unsigned 16 bit integer (n)
 5216                           ;
 5217                           ;       entry:
 5218                           ;               A = low  8 bit of n, unsigned 16 bit integer
 5219                           ;               Y = high 8 bit of n, unsigned 16 bit integer
 5220                           ;
 5221                           ;       exit:
 5222                           ;               fac = n
 5223                           ;
 5224                           ;------
 5225  F84F5B                   fldu16:
 5226                           ;------
 5227  F84F5B  AA                       tax                     ; save A
 5228  F84F5C  20 56 4E                 jsr     fldz            ; set fac=0
 5229  F84F5F  86 20                    stx     facm+14         ; low 8 bit
 5230  F84F61  84 21                    sty     facm+15         ; high 8 bit
 5231  F84F63  64 24                    stz     facsgn
 5232  F84F65  8A                       txa
 5233  F84F66  05 21                    ora     facm+15         ; test if n=0
 5234  F84F68  F0 C3                    beq     okz             ; n=0           
 5235  F84F6A                           ACC16
 5236  F84F6A  C2 20                    rep     #PMFLAG
 5237                                   .LONGA  on
 5238                                   .MNLIST
 5239  F84F6C  A9 0E 40                 lda     #BIAS16         ; biased exponent for 16 bit value
 5240                           
 5241                           ;----   
 5242  F84F6F                   fldu:
 5243                           ;----
 5244  F84F6F  85 22                    sta     facexp          ; store exponent
 5245  F84F71                           ACC08
 5246  F84F71  E2 20                    sep     #PMFLAG
 5247                                   .LONGA  off
 5248                                   .MNLIST
 5249  F84F73  64 25                    stz     facst           ; normal fac <> 0
 5250  F84F75  4C 62 46                 jmp     normfac         ; normalize fac
 5251                           
 5252                           ; uitrunc - convert the integral part of fac to unsigned 128 bit integer
 5253                           ;
 5254                           ; this routine truncate toward zero, and ignore fac sign
 5255                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page   46




 5256                           ;       entry:
 5257                           ;               fac = x
 5258                           ;
 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 bit
 5262                           ;
 5263                           ; In overflow condition, or if fac=nan/inf, tm..tm+15 will be filled with
 5264                           ; 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             ; yes
 5271  F84F7C                           ACC16                   ; set tm..tm+15 to max.
 5272  F84F7C  C2 20                    rep     #PMFLAG
 5273                                   .LONGA  on
 5274                                   .MNLIST
 5275  F84F7E  38               ?ovf:   sec                     ; invalid flag
 5276  F84F7F  A9 FF FF                 lda     #$FFFF          ; set max.
 5277  F84F82  80 04                    bra     ?set
 5278  F84F84  A9 00 00         ?z:     lda     #0
 5279  F84F87  18               ?z1:    clc                     ; valid flag
 5280  F84F88  85 00            ?set:   sta     tm
 5281  F84F8A  85 02                    sta     tm+2
 5282  F84F8C  85 04                    sta     tm+4
 5283  F84F8E  85 06                    sta     tm+6
 5284  F84F90  85 08                    sta     tm+8
 5285  F84F92  85 0A                    sta     tm+10
 5286  F84F94  85 0C                    sta     tm+12
 5287  F84F96  85 0E                    sta     tm+14
 5288  F84F98                           ACC08
 5289  F84F98  E2 20                    sep     #PMFLAG
 5290                                   .LONGA  off
 5291                                   .MNLIST
 5292  F84F9A  60                       rts
 5293  F84F9B                   ?fv:    ACC16
 5294  F84F9B  C2 20                    rep     #PMFLAG
 5295                                   .LONGA  on
 5296                                   .MNLIST
 5297  F84F9D  70 E5                    bvs     ?z              ; fac=0, so return tm=0
 5298  F84F9F  A5 22                    lda     facexp
 5299  F84FA1  F0 E4                    beq     ?z1             ; fac=0, so return tm=0
 5300  F84FA3  38                       sec
 5301  F84FA4  E9 FF 3F                 sbc     #EBIAS          ; unbias exponent
 5302  F84FA7  90 DB                    bcc     ?z              ; fac<1, so return tm=0
 5303  F84FA9  C9 80 00                 cmp     #MNTBITS        ; limit to 128 bit integer
 5304  F84FAC  B0 D0                    bcs     ?ovf            ; 128 bits integer overflow
 5305  F84FAE  E9 7E 00                 sbc     #MNTBITS-2      ; take in account CF=0 here
 5306  F84FB1  AA                       tax                     ; A=X=negative count of shift toward right
 5307  F84FB2  A5 12                    lda     facm            ; move fac mantissa to tm
 5308  F84FB4  85 00                    sta     tm
 5309  F84FB6  A5 14                    lda     facm+2
 5310  F84FB8  85 02                    sta     tm+2
 5311  F84FBA  A5 16                    lda     facm+4
 5312  F84FBC  85 04                    sta     tm+4
  Tue Jul 17 11:00:18 2018                                                                                               Page   47




 5313  F84FBE  A5 18                    lda     facm+6
 5314  F84FC0  85 06                    sta     tm+6
 5315  F84FC2  A5 1A                    lda     facm+8
 5316  F84FC4  85 08                    sta     tm+8
 5317  F84FC6  A5 1C                    lda     facm+10
 5318  F84FC8  85 0A                    sta     tm+10
 5319  F84FCA  A5 1E                    lda     facm+12
 5320  F84FCC  85 0C                    sta     tm+12
 5321  F84FCE  A5 20                    lda     facm+14
 5322  F84FD0  85 0E                    sta     tm+14
 5323  F84FD2                           ACC08
 5324  F84FD2  E2 20                    sep     #PMFLAG
 5325                                   .LONGA  off
 5326                                   .MNLIST
 5327  F84FD4  8A                       txa                     ; A=negative count of shift toward right
 5328  F84FD5  F0 05                    beq     ?done           ; no shift so exit
 5329  F84FD7  A2 00                    ldx     #tm             ; shift tm..tm15 toward right
 5330  F84FD9  20 3A 47                 jsr     shrmx           ; align integer with exponent
 5331  F84FDC  18               ?done:  clc
 5332  F84FDD  60                       rts
 5333                           
 5334                           ;---------------------------------------------------------------------------
 5335                           ; rounding routines
 5336                           ;---------------------------------------------------------------------------    
 5337                           
 5338                           ; fceil - returns the smallest f.p. integer greater than or equal the argument
 5339                           ;
 5340                           ; This routine truncates toward plus infinity
 5341                           ;
 5342                           ;       entry:
 5343                           ;               fac = x
 5344                           ;
 5345                           ;       exit:
 5346                           ;               fac = y = integral part of x truncated toward plus infinity
 5347                           ;               CF = 1 if invalid result(inf or nan)
 5348                           ;
 5349                           ;       fceil(3.0)  =  3.0
 5350                           ;       fceil(2.3)  =  3.0
 5351                           ;       fceil(0.5)  =  1.0
 5352                           ;       fceil(-0.5) =  0.0
 5353                           ;       fceil(-2.3) = -2.0
 5354                           ;       fceil(-3.0) = -3.0
 5355                           ;
 5356                           ;-----
 5357  F84FDE                   fceil:
 5358                           ;-----
 5359  F84FDE  24 25                    bit     facst
 5360  F84FE0  10 02                    bpl     ?fv             ; fac is valid
 5361  F84FE2  38                       sec                     ; return invalid flag
 5362  F84FE3  60                       rts
 5363  F84FE4  50 04            ?fv:    bvc     ?nz             ; fac <> 0
 5364  F84FE6  64 24                    stz     facsgn          ; return fac=0
 5365  F84FE8  18                       clc
 5366  F84FE9  60                       rts
 5367  F84FEA  A5 24            ?nz:    lda     facsgn
 5368  F84FEC  49 FF                    eor     #$FF            ; fceil(x)=-floor(-x)
 5369  F84FEE  85 24                    sta     facsgn
  Tue Jul 17 11:00:18 2018                                                                                               Page   48




 5370  F84FF0  20 27 50                 jsr     floor
 5371  F84FF3  A5 24                    lda     facsgn
 5372  F84FF5  49 FF                    eor     #$FF
 5373  F84FF7  85 24                    sta     facsgn
 5374  F84FF9  60                       rts
 5375                           
 5376                           ; 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 value
 5380                           ;
 5381                           ;       entry:
 5382                           ;               fac = x
 5383                           ;
 5384                           ;       exit:
 5385                           ;               fac = y = integral part of x truncated toward the nearest
 5386                           ;               CF = 1 if invalid result(inf or nan)
 5387                           ;
 5388                           ;       fround(3.8)   =   4.0
 5389                           ;       fround(3.4)   =   3.0
 5390                           ;       fround(0.5)   =   1.0
 5391                           ;       fround(0.4)   =   0.0
 5392                           ;       fround(-0.4)  =   0.0
 5393                           ;       fround(-0.5)  =  -1.0
 5394                           ;       fround(-3.4)  =  -3.0
 5395                           ;       fround(-3.8)  =  -4.0
 5396                           ;
 5397                           ;------
 5398  F84FFA                   fround:
 5399                           ;------
 5400  F84FFA  24 25                    bit     facst
 5401  F84FFC  10 02                    bpl     ?fv             ; fac is valid
 5402  F84FFE  38                       sec                     ; return invalid flag
 5403  F84FFF  60               ?ret:   rts
 5404  F85000  50 04            ?fv:    bvc     ?nz             ; fac <> 0
 5405  F85002  64 24                    stz     facsgn          ; return fac=0
 5406  F85004  18                       clc
 5407  F85005  60                       rts
 5408  F85006  A5 24            ?nz:    lda     facsgn
 5409  F85008  48                       pha                     ; save fac sign
 5410  F85009  64 24                    stz     facsgn
 5411  F8500B  20 67 45                 jsr     faddhalf        ; |x|+0.5
 5412  F8500E  68                       pla
 5413  F8500F  85 24                    sta     facsgn          ; restore fac sign
 5414  F85011  B0 EC                    bcs     ?ret            ; overflow
 5415                           
 5416                                   ; return sign(x)*ftrunc(|x|+0.5)
 5417  F85013  30 C9                    bmi     fceil           ; ftrunc(x)=fceil(x) if x<0
 5418  F85015  80 10                    bra     floor           ; ftrunc(x)=floor(x) if x>0
 5419  F85017                           
 5420                           ; ftrunc - returns the nearest integral value that is not larger 
 5421                           ; in magnitude than the argument x.
 5422                           ;
 5423                           ; This routine truncates toward zero
 5424                           ;
 5425                           ;       entry:
 5426                           ;               fac = x
  Tue Jul 17 11:00:18 2018                                                                                               Page   49




 5427                           ;
 5428                           ;       exit:
 5429                           ;               fac = y = integral part of x truncated toward zero
 5430                           ;               CF = 1 if invalid result(inf or nan)
 5431                           ;
 5432                           ;       ftrunc(3.0)  =  3.0
 5433                           ;       ftrunc(2.3)  =  2.0
 5434                           ;       ftrunc(0.5)  =  0.0
 5435                           ;       ftrunc(-0.5) =  0.0
 5436                           ;       ftrunc(-2.3) = -2.0
 5437                           ;       ftrunc(-3.0) = -3.0
 5438                           ;
 5439                           ;------
 5440  F85017                   ftrunc:
 5441                           ;------
 5442  F85017  24 25                    bit     facst
 5443  F85019  10 02                    bpl     ?fv             ; fac is valid
 5444  F8501B  38                       sec                     ; return invalid flag
 5445  F8501C  60                       rts
 5446  F8501D  50 04            ?fv:    bvc     ?nz             ; fac <> 0
 5447  F8501F  64 24                    stz     facsgn          ; return fac=0
 5448  F85021  18                       clc
 5449  F85022  60                       rts
 5450  F85023  A5 24            ?nz:    lda     facsgn
 5451  F85025  30 B7                    bmi     fceil           ; ftrunc(x)=fceil(x) if x<0
 5452                                                           ; ftrunc(x)=floor(x) if x>0
 5453  F85027                                                   
 5454                           ; floor - returns the largest f.p. integer less than or equal to the argument
 5455                           ;
 5456                           ; This routine truncates toward minus infinity
 5457                           ;
 5458                           ;       entry:
 5459                           ;               fac = x
 5460                           ;
 5461                           ;       exit:
 5462                           ;               fac = y = integral part of x truncated toward minus infinity
 5463                           ;               CF = 1 if invalid result(inf or nan)
 5464                           ;
 5465                           ;       floor(3.0)  =  3.0
 5466                           ;       floor(2.3)  =  2.0
 5467                           ;       floor(0.5)  =  0.0
 5468                           ;       floor(-0.5) = -1
 5469                           ;       floor(-2.3) = -3.0
 5470                           ;       floor(-3.0) = -3.0
 5471                           ;
 5472                           ;-----
 5473  F85027                   floor:
 5474                           ;-----
 5475  F85027  24 25                    bit     facst
 5476  F85029  10 02                    bpl     ?fv             ; fac is valid
 5477  F8502B  38                       sec                     ; return invalid flag
 5478  F8502C  60                       rts
 5479  F8502D  50 04            ?fv:    bvc     ?nz             ; fac <> 0
 5480  F8502F  64 24                    stz     facsgn          ; return fac=0
 5481  F85031  18                       clc
 5482  F85032  60                       rts
 5483  F85033  20 26 4D         ?nz:    jsr     frndm
  Tue Jul 17 11:00:18 2018                                                                                               Page   50




 5484  F85036                           ACC16
 5485  F85036  C2 20                    rep     #PMFLAG
 5486                                   .LONGA  on
 5487                                   .MNLIST
 5488  F85038  A5 22                    lda     facexp
 5489  F8503A  38                       sec
 5490  F8503B  E9 FF 3F                 sbc     #EBIAS
 5491  F8503E  85 3E                    sta     wftmp           ; save unbiased exponent
 5492  F85040                           ACC08
 5493  F85040  E2 20                    sep     #PMFLAG
 5494                                   .LONGA  off
 5495                                   .MNLIST
 5496  F85042  B0 0A                    bcs     ?gt1            ; |fac|>=1
 5497  F85044  24 24                    bit     facsgn
 5498  F85046  30 03                    bmi     ?m1             ; if -1<fac<0 return fac=-1...
 5499  F85048  4C 56 4E                 jmp     fldz            ; ...else return fac=0
 5500  F8504B  4C 32 4E         ?m1:    jmp     fldm1           ; return fac=-1
 5501  F8504E  20 39 84         ?gt1:   jsr     mvftoa          ; move fac to arg for later comparation 
 5502  F85051                           ACC16                   ; here CF=1
 5503  F85051  C2 20                    rep     #PMFLAG
 5504                                   .LONGA  on
 5505                                   .MNLIST
 5506  F85053  A9 70 00                 lda     #SNBITS-1
 5507  F85056  E5 3E                    sbc     wftmp           ; if this is <=0 then fac already integral
 5508  F85058                           ACC08
 5509  F85058  E2 20                    sep     #PMFLAG
 5510                                   .LONGA  off
 5511                                   .MNLIST
 5512  F8505A  90 23                    bcc     ?int            ; fac already integral
 5513  F8505C  F0 21                    beq     ?int            ; fac already integral
 5514  F8505E                           
 5515                                   ; now A=count of bits to clear starting from mantissa ending
 5516                                   ; and we can clear the fractional part to get just the integral part
 5517  F8505E                           
 5518  F8505E  64 13                    stz     facm+1          ; clear lsb
 5519  F85060  3A                       dec     a
 5520  F85061  F0 1C                    beq     ?int            ; done: fac is integral
 5521  F85063  A0 00                    ldy     #0              ; Y=0
 5522  F85065  BB                       tyx                     ; X=0
 5523  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 bits
 5525  F8506A  94 14                    sty     facm+2,x
 5526  F8506C  E8                       inx
 5527  F8506D  E9 08                    sbc     #8              ; update count
 5528  F8506F  F0 0E                    beq     ?int            ; done: fac is integral
 5529  F85071  80 F3                    bra     ?lp             ; loop until we can clear 8 bits at time
 5530  F85073  9B               ?bit:   txy                     ; save mantissa index                   
 5531  F85074  AA                       tax                     ; X=count of bits
 5532  F85075  CA                       dex
 5533  F85076  BF B6 50 F8              lda     >fmask,x        ; load bits mask
 5534  F8507A  BB                       tyx                     ; X=mantissa index
 5535  F8507B  35 14                    and     facm+2,x        ; mask mantissa byte
 5536  F8507D  95 14                    sta     facm+2,x
 5537  F8507F  24 24            ?int:   bit     facsgn          ; if fac>0...
 5538  F85081  10 31                    bpl     ?end            ; ...then done
 5539  F85083                           ACC16                   ; ...else we compare if integral part...
 5540  F85083  C2 20                    rep     #PMFLAG
  Tue Jul 17 11:00:18 2018                                                                                               Page   51




 5541                                   .LONGA  on
 5542                                   .MNLIST
 5543                                                           ; ...is equal to original fac
 5544  F85085  A5 14                    lda     facm+2
 5545  F85087  C5 2C                    cmp     argm+2
 5546  F85089  D0 22                    bne     ?chk
 5547  F8508B  A5 16                    lda     facm+4
 5548  F8508D  C5 2E                    cmp     argm+4
 5549  F8508F  D0 1C                    bne     ?chk
 5550  F85091  A5 18                    lda     facm+6
 5551  F85093  C5 30                    cmp     argm+6
 5552  F85095  D0 16                    bne     ?chk
 5553  F85097  A5 1A                    lda     facm+8
 5554  F85099  C5 32                    cmp     argm+8
 5555  F8509B  D0 10                    bne     ?chk
 5556  F8509D  A5 1C                    lda     facm+10
 5557  F8509F  C5 34                    cmp     argm+10
 5558  F850A1  D0 0A                    bne     ?chk
 5559  F850A3  A5 1E                    lda     facm+12
 5560  F850A5  C5 36                    cmp     argm+12
 5561  F850A7  D0 04                    bne     ?chk
 5562  F850A9  A5 20                    lda     facm+14
 5563  F850AB  C5 38                    cmp     argm+14
 5564  F850AD                   ?chk:   ACC08
 5565  F850AD  E2 20                    sep     #PMFLAG
 5566                                   .LONGA  off
 5567                                   .MNLIST
 5568  F850AF  F0 03                    beq     ?end            ; if equal then return it...
 5569  F850B1  4C 71 45                 jmp     fsubone         ; ...otherwise subtract 1
 5570  F850B4  18               ?end:   clc
 5571  F850B5  60                       rts
 5572                           
 5573                           ; bit mask to clear
 5574  F850B6                   fmask:
 5575  F850B6  FE FC F8 F0 E0           .DB     $FE,$FC,$F8,$F0,$E0,$C0,$80
               C0 80 
 5576                           
 5577                           ;---------------------------------------------------------------------------
 5578                           ; remainders routines
 5579                           ;---------------------------------------------------------------------------    
 5580                           
 5581                           ; fpmod, fprem - returns the remainder of x/y
 5582                           ;
 5583                           ;       entry:
 5584                           ;               fac = y
 5585                           ;               arg = x
 5586                           ;
 5587                           ;       exit:
 5588                           ;               fac = remainder
 5589                           ;               arg = integral part of the quotient
 5590                           ;               CF = 1 if invalid results
 5591                           ;
 5592                           ; The quotient is truncated toward zero in fpmod, and rounded to nearest
 5593                           ; in fprem. The remainder is computed as: x - n*y, where n is the integral
 5594                           ; quotient.
 5595                           ;
 5596                           ;-----
  Tue Jul 17 11:00:18 2018                                                                                               Page   52




 5597  F850BD                   fpmod:
 5598                           ;-----
 5599  F850BD  20 DD 50                 jsr     rdiv            ; x/y
 5600  F850C0  20 17 50                 jsr     ftrunc
 5601  F850C3  80 06                    bra     rem
 5602  F850C5                                   
 5603                           ;-----  
 5604  F850C5                   fprem:
 5605                           ;-----
 5606  F850C5  20 DD 50                 jsr     rdiv            ; x/y
 5607  F850C8  20 FA 4F                 jsr     fround
 5608                           
 5609                           ;---
 5610  F850CB                   rem:
 5611                           ;---
 5612  F850CB  20 C0 84                 jsr     mvf_t2          ; tfr2 = n
 5613  F850CE  20 FB 85                 jsr     mvt1_a          ; y
 5614  F850D1  20 DD 49                 jsr     fpmult          ; y*n   
 5615  F850D4  20 CE 85                 jsr     mvt0_a
 5616  F850D7  20 5F 45                 jsr     fpsub           ; fac = x - y*n
 5617  F850DA  4C 28 86                 jmp     mvt2_a          ; arg = n
 5618                           
 5619                           ;----
 5620  F850DD                   rdiv:
 5621                           ;----
 5622  F850DD  20 93 84                 jsr     mvf_t1          ; tfr1 = y
 5623  F850E0  20 1A 85                 jsr     mva_t0          ; tfr0 = x
 5624  F850E3  20 10 4A                 jsr     fpdiv           ; x/y
 5625  F850E6  90 09                    bcc     ?ret            ; ok
 5626  F850E8  20 74 4E                 jsr     fldnan          ; return nan
 5627  F850EB  20 39 84                 jsr     mvftoa
 5628  F850EE  68                       pla                     ; skip return address
 5629  F850EF  68                       pla
 5630  F850F0  38                       sec
 5631  F850F1  60               ?ret:   rts
 5632  F850F2                           
 5633                           ; fpfrac - returns the integral part, trucated toward zero, and the fractional
 5634                           ; part of the argument x
 5635                           ;
 5636                           ;       entry:
 5637                           ;               fac = x
 5638                           ;
 5639                           ;       exit:
 5640                           ;               fac = y = fractional part of x, with: -1 < y < +1
 5641                           ;               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/inf
 5644                           ;
 5645                           ; note that y and k have the same sign of x and:
 5646                           ;
 5647                           ;               x = k + y
 5648                           ;
 5649                           ;------
 5650  F850F2                   fpfrac:
 5651                           ;------
 5652  F850F2  24 25                    bit     facst
 5653  F850F4  10 05                    bpl     ?fv             ; fac is valid
  Tue Jul 17 11:00:18 2018                                                                                               Page   53




 5654  F850F6  20 39 84         ?er:    jsr     mvftoa          ; set arg=fac
 5655  F850F9  38                       sec                     ; return invalid flag
 5656  F850FA  60                       rts
 5657  F850FB  20 ED 84         ?fv:    jsr     mvf_t3          ; move fac to temp. reg. tfr3
 5658  F850FE  20 17 50                 jsr     ftrunc          ; fac=k=ftrunc(x)
 5659  F85101  B0 F3                    bcs     ?er             ; overflow
 5660  F85103  20 C0 84                 jsr     mvf_t2          ; tfr2=k
 5661  F85106  20 55 86                 jsr     mvt3_a          ; arg=x
 5662  F85109  20 5F 45                 jsr     fpsub           ; fac=y=x-k
 5663  F8510C  4C 28 86                 jmp     mvt2_a          ; arg=k
 5664                           
 5665                           ;---------------------------------------------------------------------------
 5666                           ; conversion decimal/hexadecimal to binary
 5667                           ;---------------------------------------------------------------------------    
 5668                           
 5669                           ; str2int, str2int2 - convert the initial portion of the source string to
 5670                           ; an unsigned or signed 128 bits integer.
 5671                           ;
 5672                           ;       entry:
 5673                           ;               A = low  address of source string
 5674                           ;               X = high address of source string
 5675                           ;               Y = bank that hold source string
 5676                           ;               B = flag signed conversion ($80), ignored for hex. string
 5677                           ;
 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. string
 5683                           ;               tlp = long pointer to source string
 5684                           ;
 5685                           ;       exit:
 5686                           ;               facm..facm+15 = 128 bits integer
 5687                           ;               facsiz = minimum number of bytes that can hold the integer
 5688                           ;               A = first character where conversion stop
 5689                           ;               tlp = long pointer to first char. where conversion stop
 5690                           ;               CF = 0 if conversion was succesfully done
 5691                           ;               VF = 1 if integer overflow
 5692                           ;               CF = 1 (VF don't care) if input string is invalid
 5693                           ;
 5694                           ; Conversion start parsing source string from left toward right, skipping any
 5695                           ; 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 any 
 5698                           ; decimal digit, while in hexadecimal conversion just hexadecimal's digits 
 5699                           ; (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 that 
 5701                           ; does not produce a valid digit in the given base, and tlp hold the long 
 5702                           ; pointer to this character.
 5703                           ;
 5704                           ;-------
 5705  F8510F                   str2int:
 5706                           ;-------
 5707  F8510F  85 4C                    sta     tlp             ; set long pointer to source ascii string
 5708  F85111  86 4D                    stx     tlp+1
 5709  F85113  84 4E                    sty     tlp+2
 5710  F85115  EB                       xba                     ; signed flag
  Tue Jul 17 11:00:18 2018                                                                                               Page   54




 5711                           
 5712                           ;--------
 5713  F85116                   str2int2:
 5714                           ;--------
 5715  F85116  29 80                    and     #$80            ; mask signed flag
 5716  F85118  09 60                    ora     #$60            ; set bit 6&5 (assume integer = 0)
 5717  F8511A  85 25                    sta     facst           ; flag signed conversion
 5718  F8511C  64 24                    stz     facsgn          ; assume positive sign
 5719  F8511E  A2 11                    ldx     #17             ; clear facm
 5720  F85120  74 12            ?clr:   stz     facm,x          ; facexp used for overflow check (extension)
 5721  F85122  CA                       dex
 5722  F85123  10 FB                    bpl     ?clr
 5723  F85125  64 3F                    stz     wftmp+1         ; digit's flag
 5724  F85127  A0 00                    ldy     #0              ; init string pointer
 5725  F85129  80 03                    bra     ?get0
 5726  F8512B  C8               ?nx0:   iny
 5727  F8512C  F0 55                    beq     ?iy             ; string index overflow
 5728  F8512E  B7 4C            ?get0:  lda     [tlp],y         ; get char
 5729  F85130  F0 54                    beq     ?eos            ; end of string
 5730  F85132  C9 20                    cmp     #' '
 5731  F85134  F0 F5                    beq     ?nx0            ; skip leading blanks
 5732  F85136  C9 08                    cmp     #$08
 5733  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. string
 5736  F8513E  C9 30                    cmp     #'0'
 5737  F85140  D0 12                    bne     ?dec            ; go to decimal conversion
 5738  F85142  AA                       tax                     ; save char
 5739  F85143  C8                       iny                     ; bump pointer
 5740  F85144  F0 3D                    beq     ?iy             ; string index overflow
 5741  F85146  B7 4C                    lda     [tlp],y         ; get char
 5742  F85148  C9 78                    cmp     #'x'            ; '0x' so hex. conversion
 5743  F8514A  F0 70                    beq     ?hex
 5744  F8514C  C9 58                    cmp     #'X'            ; '0X' so hex. conversion
 5745  F8514E  F0 6C                    beq     ?hex
 5746  F85150  88                       dey                     ; re-fetch previous char
 5747  F85151  8A                       txa                     ; this is '0'
 5748  F85152  80 17                    bra     ?dec2           ; handle decimal digit
 5749  F85154                           
 5750                                   ; parsing of ascii decimal string
 5751  F85154  C9 2B            ?dec:   cmp     #'+'
 5752  F85156  F0 0C                    beq     ?nxt            ; skip '+' sign
 5753  F85158  C9 2D                    cmp     #'-'
 5754  F8515A  D0 0F                    bne     ?dec2           ; handle decimal digit
 5755  F8515C  24 25                    bit     facst           ; convert to unsigned?
 5756  F8515E  10 26                    bpl     ?eos            ; invalid '-' sign in unsigned conversion       
 5757  F85160  A9 80                    lda     #$80
 5758  F85162  85 24                    sta     facsgn          ; set negative sign flag
 5759  F85164  C8               ?nxt:   iny                     ; next byte
 5760  F85165  F0 1C                    beq     ?iy             ; string index overflow
 5761  F85167  B7 4C                    lda     [tlp],y         ; get next char
 5762  F85169  F0 1B                    beq     ?eos            ; end of string
 5763  F8516B  38               ?dec2:  sec
 5764  F8516C  E9 3A                    sbc     #'0'+10
 5765  F8516E  18                       clc
 5766  F8516F  69 0A                    adc     #10
 5767  F85171  90 13                    bcc     ?eos            ; not a digit: stop string parsing
  Tue Jul 17 11:00:18 2018                                                                                               Page   55




 5768  F85173  20 44 52                 jsr     ?m10            ; facm*10
 5769  F85176  B0 1A                    bcs     ?ov             ; overflow
 5770  F85178  20 7E 52                 jsr     ?addg           ; fac=fac+digit
 5771  F8517B  B0 15                    bcs     ?ov             ; overflow
 5772  F8517D  A9 80                    lda     #$80
 5773  F8517F  85 3F                    sta     wftmp+1         ; decimal digit indicator
 5774  F85181  80 E1                    bra     ?nxt            ; get next char
 5775  F85183  88               ?iy:    dey                     ; string index overflow
 5776  F85184  80 15                    bra     ?er             ; invalid string
 5777  F85186  84 4F            ?eos:   sty     fpidx           ; end of string or end of parsing
 5778  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 test
 5781  F8518F  B8                       clv                     ; no overflow
 5782  F85190  90 13                    bcc     ?done           ; CF=0, VF=0 -- ok
 5783  F85192  A9 40            ?ov:    lda     #$40
 5784  F85194  14 25                    trb     facst
 5785  F85196  18                       clc
 5786  F85197  E2 40                    sep     #PVFLAG         ; VF=1 -- overflow
 5787  F85199  80 0A                    bra     ?done           ; CF=0, VF=1 if signed integer overflow
 5788  F8519B  84 4F            ?er:    sty     fpidx           ; save string pointer
 5789  F8519D  A2 11            ?er2:   ldx     #17             ; clear facm
 5790  F8519F  74 12            ?clr2:  stz     facm,x
 5791  F851A1  CA                       dex
 5792  F851A2  10 FB                    bpl     ?clr2
 5793  F851A4  38                       sec                     ; error flag (invalid string)
 5794  F851A5  08               ?done:  php                     ; save carry
 5795  F851A6  20 A4 52                 jsr     ?gsiz           ; compute min. size
 5796  F851A9  A5 4C                    lda     tlp             ; update string pointer
 5797  F851AB  18                       clc
 5798  F851AC  65 4F                    adc     fpidx
 5799  F851AE  85 4C                    sta     tlp
 5800  F851B0  90 06                    bcc     ?end
 5801  F851B2  E6 4D                    inc     tlp+1
 5802  F851B4  D0 02                    bne     ?end
 5803  F851B6  E6 4E                    inc     tlp+2
 5804  F851B8  A7 4C            ?end:   lda     [tlp]           ; A=last parsed character       
 5805  F851BA  28                       plp                     ; restore carry 
 5806  F851BB  60                       rts
 5807  F851BC                           
 5808                                   ; parsing of ascii hex. string
 5809  F851BC  A9 60            ?hex:   lda     #$60    
 5810  F851BE  85 25                    sta     facst           ; unsigned conversion only
 5811  F851C0  C8               ?hex1:  iny                     ; bump pointer
 5812  F851C1  F0 C0                    beq     ?iy             ; string index overflow
 5813  F851C3  B7 4C            ?hex2:  lda     [tlp],y         ; get next char
 5814  F851C5  F0 BF                    beq     ?eos            ; end of string
 5815  F851C7  C9 61                    cmp     #'a'            ; test hex. digit
 5816  F851C9  90 02                    bcc     ?hex3
 5817  F851CB  E9 20                    sbc     #$20            ; capitalize 'a', 'b',...
 5818  F851CD  38               ?hex3:  sec
 5819  F851CE  E9 3A                    sbc     #('0'+10)        ; check digits '0'..'9'
 5820  F851D0  18                       clc
 5821  F851D1  69 0A                    adc     #10
 5822  F851D3  B0 09                    bcs     ?hex4           ; ok, valid hex. digit
 5823  F851D5  E9 16                    sbc     #(6+16)         ; check 'A'..'F'
 5824  F851D7  18                       clc
  Tue Jul 17 11:00:18 2018                                                                                               Page   56




 5825  F851D8  69 06                    adc     #6
 5826  F851DA  90 AA                    bcc     ?eos            ; no hex digit: stop parsing
 5827  F851DC  69 09                    adc     #9              ; valid hex. digit
 5828  F851DE  29 0F            ?hex4:  and     #$0F            ; mask low nibble
 5829  F851E0  85 3E                    sta     wftmp
 5830  F851E2                           ACC16
 5831  F851E2  C2 20                    rep     #PMFLAG
 5832                                   .LONGA  on
 5833                                   .MNLIST
 5834  F851E4  20 6B 52                 jsr     ?m2             ; facm*16
 5835  F851E7  20 6B 52                 jsr     ?m2
 5836  F851EA  20 6B 52                 jsr     ?m2
 5837  F851ED  20 6B 52                 jsr     ?m2
 5838  F851F0  A5 22                    lda     facm+16         ; overflow test
 5839  F851F2                           ACC08
 5840  F851F2  E2 20                    sep     #PMFLAG
 5841                                   .LONGA  off
 5842                                   .MNLIST
 5843  F851F4  D0 9C                    bne     ?ov             ; overflow
 5844  F851F6  A5 3E                    lda     wftmp           ; add hex. digit
 5845  F851F8  05 12                    ora     facm            ; last low nibble
 5846  F851FA  85 12                    sta     facm
 5847  F851FC  A9 80                    lda     #$80
 5848  F851FE  85 3F                    sta     wftmp+1         ; digits flag
 5849  F85200  80 BE                    bra     ?hex1           ; continue string parsing
 5850                           
 5851  F85202                   ?test:  ACC16   
 5852  F85202  C2 20                    rep     #PMFLAG
 5853                                   .LONGA  on
 5854                                   .MNLIST
 5855  F85204  A5 20                    lda     facm+14         ; check if zero
 5856  F85206  A2 0C                    ldx     #12
 5857  F85208  15 12            ?lp1:   ora     facm,x
 5858  F8520A  CA                       dex
 5859  F8520B  CA                       dex
 5860  F8520C  10 FA                    bpl     ?lp1
 5861  F8520E  C9 00 00                 cmp     #$0000
 5862  F85211                           ACC08
 5863  F85211  E2 20                    sep     #PMFLAG
 5864                                   .LONGA  off
 5865                                   .MNLIST
 5866  F85213  F0 2B                    beq     ?vf             ; finish: integer = 0
 5867  F85215  A9 40                    lda     #$40
 5868  F85217  14 25                    trb     facst           ; not zero integer indicator
 5869  F85219  24 25                    bit     facst           ; conversion test
 5870  F8521B  10 23                    bpl     ?vf             ; wanted unsigned integer: finish
 5871  F8521D  24 24                    bit     facsgn          ; if negative decimal...
 5872  F8521F  30 06                    bmi     ?neg            ; ...should negate facm
 5873  F85221  A5 21                    lda     facm+15         ; should be <$80 if positive signed integer
 5874  F85223  10 1B                    bpl     ?vf             ; finish: positive signed integer
 5875  F85225  30 1B                    bmi     ?of             ; signed integer overflow
 5876  F85227                   ?neg:   ACC16
 5877  F85227  C2 20                    rep     #PMFLAG
 5878                                   .LONGA  on
 5879                                   .MNLIST
 5880  F85229  A2 00                    ldx     #0              ; facm index
 5881  F8522B  A0 08                    ldy     #8              ; counter (8 words)
  Tue Jul 17 11:00:18 2018                                                                                               Page   57




 5882  F8522D  38                       sec
 5883  F8522E  A9 00 00         ?lp2:   lda     #0              ; two's complement
 5884  F85231  F5 12                    sbc     facm,x
 5885  F85233  95 12                    sta     facm,x
 5886  F85235  E8                       inx
 5887  F85236  E8                       inx
 5888  F85237  88                       dey
 5889  F85238  D0 F4                    bne     ?lp2
 5890  F8523A  A5 20                    lda     facm+14         ; must be negative
 5891  F8523C                           ACC08
 5892  F8523C  E2 20                    sep     #PMFLAG
 5893                                   .LONGA  off
 5894                                   .MNLIST
 5895  F8523E  10 02                    bpl     ?of             ; signed integer overflow
 5896  F85240  18               ?vf:    clc                     ; valid flag
 5897  F85241  60                       rts
 5898  F85242  38               ?of:    sec                     ; overflow
 5899  F85243  60                       rts
 5900  F85244                           
 5901  F85244  A2 11            ?m10:   ldx     #17             ; multiplies facm by 10
 5902  F85246  84 4F                    sty     fpidx           ; save Y
 5903  F85248  85 3E                    sta     wftmp           ; save digit    
 5904  F8524A  B5 12            ?m101:  lda     facm,x          ; move facm to argm
 5905  F8524C  95 2A                    sta     argm,x
 5906  F8524E  CA                       dex
 5907  F8524F  10 F9                    bpl     ?m101
 5908  F85251                           ACC16
 5909  F85251  C2 20                    rep     #PMFLAG
 5910                                   .LONGA  on
 5911                                   .MNLIST
 5912  F85253  20 6B 52                 jsr     ?m2             ; facm*2
 5913  F85256  20 6B 52                 jsr     ?m2             ; facm*4
 5914  F85259  20 91 52                 jsr     ?add            ; facm*4+argm=facm*5
 5915  F8525C  20 6B 52                 jsr     ?m2             ; facm*10
 5916  F8525F  A5 22                    lda     facm+16         ; check overflow
 5917  F85261                           ACC08
 5918  F85261  E2 20                    sep     #PMFLAG
 5919                                   .LONGA  off
 5920                                   .MNLIST
 5921  F85263  F0 01                    beq     ?nof            ; no overflow
 5922  F85265  38                       sec                     ; overflow flag
 5923  F85266  A4 4F            ?nof:   ldy     fpidx           ; restore Y
 5924  F85268  A5 3E                    lda     wftmp           ; restore digit
 5925  F8526A  60                       rts
 5926                           
 5927  F8526B  06 12            ?m2:    asl     facm            ; multiplies facm by 2
 5928  F8526D  26 14                    rol     facm+2
 5929  F8526F  26 16                    rol     facm+4
 5930  F85271  26 18                    rol     facm+6
 5931  F85273  26 1A                    rol     facm+8
 5932  F85275  26 1C                    rol     facm+10
 5933  F85277  26 1E                    rol     facm+12
 5934  F85279  26 20                    rol     facm+14
 5935  F8527B  26 22                    rol     facm+16
 5936  F8527D  60                       rts
 5937                           
 5938  F8527E  84 4F            ?addg:  sty     fpidx           ; add digit to facm - save Y
  Tue Jul 17 11:00:18 2018                                                                                               Page   58




 5939  F85280  85 2A                    sta     argm            ; digit
 5940  F85282                           ACC16                   ; argm was already cleared
 5941  F85282  C2 20                    rep     #PMFLAG
 5942                                   .LONGA  on
 5943                                   .MNLIST
 5944  F85284  20 91 52                 jsr     ?add
 5945  F85287  A5 22                    lda     facm+16         ; check overflow
 5946  F85289                           ACC08
 5947  F85289  E2 20                    sep     #PMFLAG
 5948                                   .LONGA  off
 5949                                   .MNLIST
 5950  F8528B  F0 01                    beq     ?nof1           ; no overflow
 5951  F8528D  38                       sec                     ; overflow flag
 5952  F8528E  A4 4F            ?nof1:  ldy     fpidx           ; restore Y
 5953  F85290  60                       rts
 5954                           
 5955  F85291  18               ?add:   clc                     ; facm=facm+argm
 5956  F85292  A2 00                    ldx     #0              ; facm&argm index
 5957  F85294  A0 09                    ldy     #9              ; counter (9 words)
 5958  F85296  B5 12            ?ad1:   lda     facm,x          ; facm=facm+argm
 5959  F85298  75 2A                    adc     argm,x
 5960  F8529A  95 12                    sta     facm,x
 5961  F8529C  74 2A                    stz     argm,x          ; and clear argm for later use
 5962  F8529E  E8                       inx
 5963  F8529F  E8                       inx
 5964  F852A0  88                       dey
 5965  F852A1  D0 F3                    bne     ?ad1
 5966  F852A3  60                       rts
 5967                           
 5968  F852A4  B0 0E            ?gsiz:  bcs     ?gse            ; invalid string
 5969  F852A6  A9 10                    lda     #16             ; assume max. possible size
 5970  F852A8  85 24                    sta     facsgn
 5971  F852AA  70 08                    bvs     ?gse            ; overflow condition
 5972  F852AC  24 25                    bit     facst           ; compute min. integer size (in bytes #)
 5973  F852AE  50 05                    bvc     ?gs0            ; not zero
 5974  F852B0  A9 01                    lda     #1              ; zero can fit in one byte
 5975  F852B2  85 24                    sta     facsgn
 5976  F852B4  60               ?gse:   rts
 5977  F852B5  30 2C            ?gs0:   bmi     ?gss            ; signed integer
 5978  F852B7  A2 10                    ldx     #16
 5979  F852B9                           ACC16
 5980  F852B9  C2 20                    rep     #PMFLAG
 5981                                   .LONGA  on
 5982                                   .MNLIST
 5983  F852BB  A5 20                    lda     facm+14
 5984  F852BD  05 1E                    ora     facm+12
 5985  F852BF  05 1C                    ora     facm+10
 5986  F852C1  05 1A                    ora     facm+8
 5987  F852C3  D0 06                    bne     ?gs1            ; 16 bytes integer
 5988  F852C5  A2 08                    ldx     #8
 5989  F852C7  A5 18                    lda     facm+6
 5990  F852C9  05 16                    ora     facm+4
 5991  F852CB                   ?gs1:   ACC08
 5992  F852CB  E2 20                    sep     #PMFLAG
 5993                                   .LONGA  off
 5994                                   .MNLIST
 5995  F852CD  D0 11                    bne     ?gs2            ; 8 bytes integer
  Tue Jul 17 11:00:18 2018                                                                                               Page   59




 5996  F852CF  A2 04                    ldx     #4
 5997  F852D1  A5 15                    lda     facm+3
 5998  F852D3  D0 0B                    bne     ?gs2            ; 4 bytes integer
 5999  F852D5  CA                       dex
 6000  F852D6  A5 14                    lda     facm+2
 6001  F852D8  D0 06                    bne     ?gs2            ; 3 bytes integer (long pointer)
 6002  F852DA  CA                       dex
 6003  F852DB  A5 13                    lda     facm+1
 6004  F852DD  D0 01                    bne     ?gs2            ; 2 bytes integer
 6005  F852DF  CA                       dex                     ; 1 byte integer
 6006  F852E0  86 24            ?gs2:   stx     facsgn
 6007  F852E2  60                       rts
 6008  F852E3  A4 21            ?gss:   ldy     facm+15
 6009  F852E5  10 3F                    bpl     ?gsp            ; signed integer is positive
 6010  F852E7  A2 10                    ldx     #16
 6011  F852E9                           ACC16
 6012  F852E9  C2 20                    rep     #PMFLAG
 6013                                   .LONGA  on
 6014                                   .MNLIST
 6015  F852EB  A5 20                    lda     facm+14
 6016  F852ED  25 1E                    and     facm+12
 6017  F852EF  25 1C                    and     facm+10
 6018  F852F1  25 1A                    and     facm+8
 6019  F852F3  C9 FF FF                 cmp     #$FFFF
 6020  F852F6  D0 29                    bne     ?gs4            ; 16 bytes signed integer
 6021  F852F8  A5 18                    lda     facm+6
 6022  F852FA  10 25                    bpl     ?gs4            ; 16 bytes signed integer
 6023  F852FC  A2 08                    ldx     #8
 6024  F852FE  25 16                    and     facm+4
 6025  F85300  C9 FF FF                 cmp     #$FFFF
 6026  F85303  D0 1C                    bne     ?gs4            ; 8 bytes signed integer
 6027  F85305  A5 14                    lda     facm+2
 6028  F85307  10 18                    bpl     ?gs4            ; 8 bytes signed integer
 6029  F85309  A2 04                    ldx     #4
 6030  F8530B  C9 FF FF                 cmp     #$FFFF
 6031  F8530E                           ACC08
 6032  F8530E  E2 20                    sep     #PMFLAG
 6033                                   .LONGA  off
 6034                                   .MNLIST
 6035  F85310  D0 0F                    bne     ?gs4            ; 4 bytes signed integer
 6036  F85312  A5 13                    lda     facm+1
 6037  F85314  10 0B                    bpl     ?gs4            ; 4 bytes signed integer
 6038  F85316  A2 02                    ldx     #2
 6039  F85318  C9 FF                    cmp     #$FF
 6040  F8531A  D0 05                    bne     ?gs4            ; 2 bytes signed integer
 6041  F8531C  A5 12                    lda     facm
 6042  F8531E  10 01                    bpl     ?gs4
 6043  F85320  CA                       dex
 6044  F85321                   ?gs4:   ACC08   
 6045  F85321  E2 20                    sep     #PMFLAG
 6046                                   .LONGA  off
 6047                                   .MNLIST
 6048  F85323  86 24                    stx     facsgn
 6049  F85325  60                       rts
 6050  F85326  A2 10            ?gsp:   ldx     #16
 6051  F85328                           ACC16
 6052  F85328  C2 20                    rep     #PMFLAG
  Tue Jul 17 11:00:18 2018                                                                                               Page   60




 6053                                   .LONGA  on
 6054                                   .MNLIST
 6055  F8532A  A5 20                    lda     facm+14
 6056  F8532C  05 1E                    ora     facm+12
 6057  F8532E  05 1C                    ora     facm+10
 6058  F85330  05 1A                    ora     facm+8
 6059  F85332  D0 25                    bne     ?gs6            ; 16 bytes signed integer
 6060  F85334  A5 18                    lda     facm+6
 6061  F85336  30 21                    bmi     ?gs6            ; 16 bytes signed integer
 6062  F85338  A2 08                    ldx     #8
 6063  F8533A  05 16                    ora     facm+4
 6064  F8533C  D0 1B                    bne     ?gs6            ; 8 bytes signed integer
 6065  F8533E  A5 14                    lda     facm+2
 6066  F85340  30 17                    bmi     ?gs6            ; 8 bytes signed integer
 6067  F85342  A2 04                    ldx     #4
 6068  F85344  C9 00 00                 cmp     #0
 6069  F85347  D0 10                    bne     ?gs6            ; 4 bytes signed integer
 6070  F85349                           ACC08
 6071  F85349  E2 20                    sep     #PMFLAG
 6072                                   .LONGA  off
 6073                                   .MNLIST
 6074  F8534B  A5 13                    lda     facm+1
 6075  F8534D  30 0A                    bmi     ?gs6            ; 4 bytes signed integer
 6076  F8534F  A2 02                    ldx     #2
 6077  F85351  A8                       tay
 6078  F85352  D0 05                    bne     ?gs6            ; 2 bytes signed integer
 6079  F85354  A5 12                    lda     facm
 6080  F85356  30 01                    bmi     ?gs6            ; 2 bytes signed integer
 6081  F85358  CA                       dex                     ; 1 byte signed integer
 6082  F85359                   ?gs6:   ACC08   
 6083  F85359  E2 20                    sep     #PMFLAG
 6084                                   .LONGA  off
 6085                                   .MNLIST
 6086  F8535B  86 24                    stx     facsgn
 6087  F8535D  60                       rts
 6088  F8535E                           
 6089                           ; str2fp, str2fp2 - convert the initial portion of the source string to
 6090                           ; a 128 bits binary floating point.
 6091                           ;
 6092                           ;       entry:
 6093                           ;               A = low  address of source string
 6094                           ;               X = high address of source string
 6095                           ;               Y = bank that hold source string
 6096                           ;
 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 string
 6102                           ;
 6103                           ;       exit:
 6104                           ;               fac = converted floating point
 6105                           ;               A = first character where conversion stop
 6106                           ;               tlp = long pointer to first char. where conversion stop
 6107                           ;               CF = 0 if conversion was succesfully done
 6108                           ;               VF = 1 if fac=inf/nan
 6109                           ;               CF = 1 (VF don't care) if input string is invalid
  Tue Jul 17 11:00:18 2018                                                                                               Page   61




 6110                           ;
 6111                           ; Conversion start parsing source string from left toward right, skipping any
 6112                           ; 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) for
 6117                           ;           the significand, followed by a 'p' or a 'P', followed by 4 
 6118                           ;           hexadecimals digits for the biased exponent. Significand sign
 6119                           ;           should be ored with msb of the biased exponent.
 6120                           ;           Example:
 6121                           ;               $80000000000000000000000000000000pbfff = -1.0   
 6122                           ;               $80000000000000000000000000000000p3fff = +1.0   
 6123                           ;               $00000000000000000000000000000000p0000 = +0.0   
 6124                           ;           Number 0.0 can be expressed either by significand=0 and/or
 6125                           ;           exponent=0.
 6126                           ;
 6127                           ;       +0  an hexadecimal ascii string beginning with '#', followed by
 6128                           ;           exactly 32 hexadecimal digits (case don't care), seen as a packed
 6129                           ;           standard ieee quadruple format.
 6130                           ;           Example:
 6131                           ;               #bfff0000000000000000000000000000 = -1.0        
 6132                           ;               #3fff0000000000000000000000000000 = +1.0        
 6133                           ;               #00000000000000000000000000000000 = +0.0        
 6134                           ;
 6135                           ;       +o  a decimal ascii string, beginning with an optional single '+'
 6136                           ;           or '-' sign, followed by a decimal significand consisting of a
 6137                           ;           sequence of decimal digits optionally containing a decimal-point
 6138                           ;           character, '.'. The significand may be optionally followed by an 
 6139                           ;           exponent. An exponent consists of an 'E' or 'e' followed by an
 6140                           ;           optional plus or minus sign, followed by a sequence of decimal 
 6141                           ;           digits; the exponent indicates the power of 10 by which the
 6142                           ;           significand should be scaled.
 6143                           ;
 6144                           ;       +o  a string "+INF", "-INF", "+NAN", "-NAN", where the sign '+' or
 6145                           ;           '-' is optional (case don't care).
 6146                           ;
 6147                           ; Conversion stop at the end of the string or at the first character that 
 6148                           ; does not produce a valid digit in the given base, and tlp hold the long 
 6149                           ; pointer to this character.
 6150                           ;
 6151                           ;------
 6152  F8535E                   str2fp:
 6153                           ;------
 6154  F8535E  85 4C                    sta     tlp             ; set long pointer to source ascii string
 6155  F85360  86 4D                    stx     tlp+1
 6156  F85362  84 4E                    sty     tlp+2
 6157                           
 6158                           ;-------
 6159  F85364                   str2fp2:
 6160                           ;-------
 6161  F85364  64 26                    stz     fexph           ; clear exponent
 6162  F85366  9C 6C 68                 stz     fexp+1
 6163  F85369  64 B4                    stz     tmdot           ; count of decimal digits (after a dot)
 6164  F8536B  64 B5                    stz     tmdot+1
 6165  F8536D  64 25                    stz     facst           ; clear status
 6166  F8536F  64 24                    stz     facsgn          ; clear sign
  Tue Jul 17 11:00:18 2018                                                                                               Page   62




 6167  F85371  64 B8                    stz     tmsgn           ; sign&dot indicator
 6168  F85373  64 B9                    stz     tmcnt           ; count of mantissa digits
 6169  F85375  64 BA                    stz     tesgn           ; sign&exponent indicator
 6170  F85377  64 BB                    stz     tecnt           ; count of exponent digit
 6171  F85379  20 56 4E                 jsr     fldz            ; set fac=0
 6172  F8537C  A0 00                    ldy     #0              ; init string pointer
 6173  F8537E  80 03                    bra     ?get0
 6174  F85380  C8               ?nx0:   iny
 6175  F85381  F0 69                    beq     ?iy             ; string index overflow
 6176  F85383  B7 4C            ?get0:  lda     [tlp],y         ; get char
 6177  F85385  F0 68                    beq     ?eos            ; end of string
 6178  F85387  C9 20                    cmp     #' '
 6179  F85389  F0 F5                    beq     ?nx0            ; skip leading blanks
 6180  F8538B  C9 08                    cmp     #$08
 6181  F8538D  F0 F1                    beq     ?nx0            ; skip leading 'tab'
 6182  F8538F  C9 23                    cmp     #'#'            ; ieee packed hex. string?
 6183  F85391  D0 05                    bne     ?ckh            ; no
 6184  F85393  20 74 55                 jsr     ?ieee           ; convert hex. packed to float
 6185  F85396  80 1D                    bra     ?ehx    
 6186  F85398  C9 24            ?ckh:   cmp     #'$'            ; hex. string?
 6187  F8539A  F0 16                    beq     ?hex            ; yes, convert ascii hex. string
 6188  F8539C  C9 30                    cmp     #'0'
 6189  F8539E  D0 1B                    bne     ?dec            ; go to decimal conversion
 6190  F853A0  AA                       tax                     ; save char
 6191  F853A1  C8                       iny                     ; bump pointer
 6192  F853A2  F0 48                    beq     ?iy             ; string index overflow
 6193  F853A4  B7 4C                    lda     [tlp],y         ; get char
 6194  F853A6  C9 78                    cmp     #'x'            ; '0x' so hex. conversion
 6195  F853A8  F0 08                    beq     ?hex
 6196  F853AA  C9 58                    cmp     #'X'            ; '0X' so hex. conversion
 6197  F853AC  F0 04                    beq     ?hex
 6198  F853AE  88                       dey                     ; re-fetch previous char
 6199  F853AF  8A                       txa                     ; this is '0'
 6200  F853B0  80 1C                    bra     ?dec2           ; handle decimal digit
 6201  F853B2  20 C9 54         ?hex:   jsr     ?hfp            ; convert hex. string to float
 6202  F853B5  84 4F            ?ehx:   sty     fpidx           ; store index
 6203  F853B7  B8                       clv                     ; ignore VF for hex. conversion
 6204  F853B8  4C 7F 54                 jmp     ?done
 6205                           
 6206                                   ; parsing of ascii decimal string
 6207  F853BB  C9 2B            ?dec:   cmp     #'+'
 6208  F853BD  F0 08                    beq     ?nxt            ; skip '+' sign
 6209  F853BF  C9 2D                    cmp     #'-'
 6210  F853C1  D0 0B                    bne     ?dec2           ; handle decimal digit
 6211  F853C3  A9 80                    lda     #$80
 6212  F853C5  85 B8                    sta     tmsgn           ; set negative sign flag
 6213  F853C7  C8               ?nxt:   iny                     ; next byte
 6214  F853C8  F0 22                    beq     ?iy             ; string index overflow
 6215  F853CA  B7 4C                    lda     [tlp],y         ; get next char
 6216  F853CC  F0 21                    beq     ?eos            ; end of string
 6217  F853CE  38               ?dec2:  sec
 6218  F853CF  E9 3A                    sbc     #'0'+10
 6219  F853D1  18                       clc
 6220  F853D2  69 0A                    adc     #10
 6221  F853D4  90 29                    bcc     ?ndg            ; is not a digit
 6222  F853D6  24 BA                    bit     tesgn           ; will process exponent digits?
 6223  F853D8  70 09                    bvs     ?edec           ; yes
  Tue Jul 17 11:00:18 2018                                                                                               Page   63




 6224  F853DA  E6 B9                    inc     tmcnt           ; count of mantissa digits 
 6225  F853DC  20 91 54                 jsr     ?mupd           ; update mantissa (add digit)
 6226  F853DF  90 E6                    bcc     ?nxt            ; next byte
 6227  F853E1  B0 5C                    bcs     ?ovf            ; overflow error
 6228  F853E3  E6 BB            ?edec:  inc     tecnt           ; process exponent digit
 6229  F853E5  20 AE 54                 jsr     ?eupd           ; update exponent (add digit)
 6230  F853E8  90 DD                    bcc     ?nxt            ; next byte
 6231  F853EA  B0 53                    bcs     ?ovf            ; exponent overflow error
 6232                           
 6233  F853EC  88               ?iy:    dey                     ; here when index overflow
 6234  F853ED  80 5E                    bra     ?nv             ; invalid string
 6235                           
 6236                                   ; end of string or parsing of an invalid char
 6237  F853EF  84 4F            ?eos:   sty     fpidx           ; store index   
 6238  F853F1  A6 B9                    ldx     tmcnt
 6239  F853F3  F0 5A                    beq     ?nv1            ; no mantissa digits: invalid string
 6240  F853F5  24 BA                    bit     tesgn
 6241  F853F7  50 60                    bvc     ?sc             ; no exponent: scale fac according decimals 
 6242  F853F9  A6 BB                    ldx     tecnt
 6243  F853FB  F0 52                    beq     ?nv1            ; no exponent digits: invalid string
 6244  F853FD  80 5A                    bra     ?sc             ; scale fac according to exponent&decimals
 6245                           
 6246                                   ; handle no-digit character     
 6247  F853FF  69 30            ?ndg:   adc     #'0'             ; restore character
 6248  F85401  C9 2E                    cmp     #'.'            ; check if decimal dot
 6249  F85403  D0 0C                    bne     ?cke            ; go to check 'e', 'E'
 6250  F85405  A6 B9                    ldx     tmcnt
 6251  F85407  F0 44                    beq     ?nv             ; no mantissa digits so error
 6252  F85409  A9 40                    lda     #$40            ; test&set dot indicator
 6253  F8540B  04 B8                    tsb     tmsgn
 6254  F8540D  D0 3E                    bne     ?nv             ; duplicate dot so error
 6255  F8540F  80 B6                    bra     ?nxt            ; next byte
 6256  F85411  C9 45            ?cke:   cmp     #'E'            ; check exponent
 6257  F85413  F0 0B                    beq     ?cke1
 6258  F85415  C9 65                    cmp     #'e'
 6259  F85417  F0 07                    beq     ?cke1
 6260  F85419  20 F8 55                 jsr     ?ginf           ; read INF or NAN string        
 6261  F8541C  B0 D1                    bcs     ?eos            ; invalid string
 6262  F8541E  80 5F                    bra     ?done
 6263  F85420  A6 B9            ?cke1:  ldx     tmcnt
 6264  F85422  F0 29                    beq     ?nv             ; no mantissa digits so error
 6265  F85424  A9 40                    lda     #$40            ; test&set dot indicator
 6266  F85426  04 BA                    tsb     tesgn
 6267  F85428  D0 23                    bne     ?nv             ; duplicate 'E' so error
 6268  F8542A  C8                       iny                     ; get next byte
 6269  F8542B  F0 BF                    beq     ?iy             ; string index overflow
 6270  F8542D  B7 4C                    lda     [tlp],y
 6271  F8542F  F0 BE                    beq     ?eos            ; end of string
 6272  F85431  C9 2B                    cmp     #'+'
 6273  F85433  F0 92                    beq     ?nxt            ; skip '+' sign
 6274  F85435  C9 2D                    cmp     #'-'
 6275  F85437  D0 95                    bne     ?dec2           ; process this byte
 6276  F85439  A9 80                    lda     #$80
 6277  F8543B  04 BA                    tsb     tesgn           ; set negative exponent sign
 6278  F8543D  80 88                    bra     ?nxt            ; get next byte
 6279                           
 6280                                   ; mantissa or exponent overflow
  Tue Jul 17 11:00:18 2018                                                                                               Page   64




 6281  F8543F  84 4F            ?ovf:   sty     fpidx           ; store index of last parsed byte
 6282  F85441  A6 B8                    ldx     tmsgn           ; attual mantissa sign
 6283  F85443  86 24                    stx     facsgn
 6284  F85445  20 7D 4E                 jsr     fldinf          ; load inf because overflow
 6285  F85448  18                       clc                     ; no error (string is valid)
 6286  F85449  E2 40                    sep     #PVFLAG         ; VF=1 (overflow)
 6287  F8544B  80 32                    bra     ?done           ; done
 6288                           
 6289                                   ; duplicate dot, duplicate 'E', no valid digits: invalid string
 6290  F8544D  84 4F            ?nv:    sty     fpidx
 6291  F8544F  A6 B8            ?nv1:   ldx     tmsgn           ; attual mantissa sign
 6292  F85451  86 24                    stx     facsgn
 6293  F85453  20 56 4E                 jsr     fldz            ; fac=0
 6294  F85456  38                       sec                     ; error: invalid string
 6295  F85457  80 26                    bra     ?done           ; done
 6296                           
 6297                                   ; now scale fac according to decimal digits count & exponent
 6298  F85459  A4 B8            ?sc:    ldy     tmsgn
 6299  F8545B  84 24                    sty     facsgn
 6300  F8545D  A2 00                    ldx     #0
 6301  F8545F                           ACC16
 6302  F8545F  C2 20                    rep     #PMFLAG
 6303                                   .LONGA  on
 6304                                   .MNLIST
 6305  F85461  38                       sec
 6306  F85462  8A                       txa                     ; change sign to decimal count
 6307  F85463  E5 B4                    sbc     tmdot
 6308  F85465  85 B4                    sta     tmdot
 6309  F85467  A5 26                    lda     fexph
 6310  F85469  A4 BA                    ldy     tesgn           ; check exponent sign
 6311  F8546B  10 04                    bpl     ?sc1
 6312  F8546D  49 FF FF                 eor     #$FFFF          ; change sign to exponent
 6313  F85470  1A                       inc     a
 6314  F85471  18               ?sc1:   clc
 6315  F85472  65 B4                    adc     tmdot           ; scale fac with this value
 6316  F85474                           ACC08
 6317  F85474  E2 20                    sep     #PMFLAG
 6318                                   .LONGA  off
 6319                                   .MNLIST
 6320  F85476  20 2E 49                 jsr     scale10
 6321  F85479  B8                       clv                     ; VF=0
 6322  F8547A  90 03                    bcc     ?done           ; no overflow
 6323  F8547C  18                       clc                     ; no error (string is valid)
 6324  F8547D  E2 40                    sep     #PVFLAG         ; VF=1 (overflow)       
 6325  F8547F  08               ?done:  php                     ; save CF&VF
 6326  F85480  A5 4C                    lda     tlp
 6327  F85482  18                       clc
 6328  F85483  65 4F                    adc     fpidx
 6329  F85485  85 4C                    sta     tlp
 6330  F85487  90 06                    bcc     ?rts
 6331  F85489  E6 4D                    inc     tlp+1
 6332  F8548B  D0 02                    bne     ?rts
 6333  F8548D  E6 4E                    inc     tlp+2
 6334  F8548F  28               ?rts:   plp     
 6335  F85490  60                       rts
 6336                           
 6337                                   ; update mantissa: fac=(fac*10)+byte (where A=byte)
  Tue Jul 17 11:00:18 2018                                                                                               Page   65




 6338  F85491  84 B7            ?mupd:  sty     tmpy            ; save Y
 6339  F85493  85 B6                    sta     tmpa            ; save A
 6340  F85495  24 B8                    bit     tmsgn           ; digit after a decimal dot?
 6341  F85497  50 02                    bvc     ?mupd1          ; no
 6342  F85499  E6 B4                    inc     tmdot           ; increment decimal count
 6343  F8549B  20 D1 49         ?mupd1: jsr     mult10          ; fac=fac*10
 6344  F8549E  B0 0B                    bcs     ?mupd2          ; invalid
 6345  F854A0  20 39 84                 jsr     mvftoa          ; move fac to arg
 6346  F854A3  A5 B6                    lda     tmpa
 6347  F854A5  20 49 4F                 jsr     fldbyt          ; load byte into fac
 6348  F854A8  20 7D 45                 jsr     fpadd           ; fac=(fac*10)+A
 6349  F854AB  A4 B7            ?mupd2: ldy     tmpy            ; restore string index
 6350  F854AD  60                       rts                     ; CF=1 if overflow
 6351                           
 6352                                   ; update exponent: fexph=(10*fexph)+A
 6353  F854AE  85 B6            ?eupd:  sta     tmpa            ; save byte to add
 6354  F854B0  64 B7                    stz     tmpa+1          ; high byte = 0
 6355  F854B2                           ACC16
 6356  F854B2  C2 20                    rep     #PMFLAG
 6357                                   .LONGA  on
 6358                                   .MNLIST
 6359  F854B4  A5 26                    lda     fexph
 6360  F854B6  C9 CC 0C                 cmp     #$0CCC          ; check overflow condition
 6361  F854B9  B0 0B                    bcs     ?eupd1          ; limit exponent to $7FFF
 6362  F854BB  85 3E                    sta     wftmp
 6363  F854BD  0A                       asl     a               ; mult. 10
 6364  F854BE  0A                       asl     a
 6365  F854BF  65 3E                    adc     wftmp
 6366  F854C1  0A                       asl     a
 6367  F854C2  65 B6                    adc     tmpa            ; add byte
 6368  F854C4  85 26                    sta     fexph           ; update exponent
 6369  F854C6                   ?eupd1: ACC08
 6370  F854C6  E2 20                    sep     #PMFLAG
 6371                                   .LONGA  off
 6372                                   .MNLIST
 6373  F854C8  60                       rts                     ; CF=1 if exponent overflow
 6374                           
 6375                                   ; convert hexadecimal string: $xxx...xxpyyyy
 6376                                   ; where xx...xx=significand, yyyy=biased exponent
 6377  F854C9  20 12 55         ?hfp:   jsr     ?ghex           ; convert hex. to fp
 6378  F854CC  B0 50                    bcs     ?ghx            ; error getting significand
 6379  F854CE  A2 0F                    ldx     #15
 6380  F854D0  B5 00            ?hfl:   lda     tm,x            ; move tm to facm
 6381  F854D2  95 12                    sta     facm,x
 6382  F854D4  CA                       dex
 6383  F854D5  10 F9                    bpl     ?hfl
 6384  F854D7  20 1F 55                 jsr     ?hexp           ; get high exponent
 6385  F854DA  B0 42                    bcs     ?ghx            ; error
 6386  F854DC  AA                       tax
 6387  F854DD  29 80                    and     #$80
 6388  F854DF  85 24                    sta     facsgn          ; sign
 6389  F854E1  8A                       txa
 6390  F854E2  29 7F                    and     #$7F
 6391  F854E4  85 23                    sta     facexp+1
 6392  F854E6  20 2C 55                 jsr     ?2hex           ; get low exponent
 6393  F854E9  B0 33                    bcs     ?ghx            ; error
 6394  F854EB  85 22                    sta     facexp
  Tue Jul 17 11:00:18 2018                                                                                               Page   66




 6395  F854ED  20 61 55                 jsr     ?hsep           ; check end of string
 6396  F854F0  B0 2C                    bcs     ?ghx            ; error
 6397  F854F2  64 25                    stz     facst
 6398  F854F4  20 E6 46                 jsr     chkz            ; check if fac=0        
 6399  F854F7  24 25                    bit     facst
 6400  F854F9  70 23                    bvs     ?ghx            ; fac=0, exit (CF=0)
 6401  F854FB  A5 22                    lda     facexp
 6402  F854FD  05 23                    ora     facexp+1        ; exponent=0?
 6403  F854FF  F0 0E                    beq     ?hfz            ; yes, set fac=0
 6404  F85501  AA                       tax
 6405  F85502  A5 21                    lda     facm+15
 6406  F85504  30 06                    bmi     ?hf3            ; normal
 6407  F85506  E0 01                    cpx     #1              ; subnormal should have exponent=1
 6408  F85508  D0 68                    bne     ?1hex4          ; invalid string
 6409  F8550A  18                       clc
 6410  F8550B  60                       rts
 6411  F8550C  4C DC 55         ?hf3:   jmp     ?htst           ; test inf/nan
 6412  F8550F  4C 56 4E         ?hfz:   jmp     fldz
 6413  F85512                           
 6414  F85512  A2 0F            ?ghex:  ldx     #15             ; get 128 bits hex
 6415  F85514  20 2C 55         ?ghl:   jsr     ?2hex
 6416  F85517  B0 05                    bcs     ?ghx            ; error
 6417  F85519  95 00                    sta     tm,x            ; store (high-to-low order)
 6418  F8551B  CA                       dex
 6419  F8551C  10 F6                    bpl     ?ghl
 6420  F8551E  60               ?ghx:   rts                     ; CF=0 if no error
 6421                           
 6422  F8551F  C8               ?hexp:  iny                     ; get 'p' biased high exponent
 6423  F85520  F0 4F                    beq     ?1hex3          ; string index overflow
 6424  F85522  B7 4C                    lda     [tlp],y         ; get next char
 6425  F85524  C9 70                    cmp     #'p'            ; exponent indicator
 6426  F85526  F0 04                    beq     ?2hex           ; ok
 6427  F85528  C9 50                    cmp     #'P'
 6428  F8552A  D0 46                    bne     ?1hex4          ; invalid string
 6429                           
 6430  F8552C  20 3F 55         ?2hex:  jsr     ?1hex           ; convert two digits at time
 6431  F8552F  B0 ED                    bcs     ?ghx            ; error
 6432  F85531  0A                       asl     a               ; high nibble
 6433  F85532  0A                       asl     a
 6434  F85533  0A                       asl     a
 6435  F85534  0A                       asl     a
 6436  F85535  85 3E                    sta     wftmp
 6437  F85537  20 3F 55                 jsr     ?1hex           ; get low nibble
 6438  F8553A  B0 E2                    bcs     ?ghx            ; error
 6439  F8553C  05 3E                    ora     wftmp           ; concatenate high & low nibble
 6440  F8553E  60                       rts                     ; CF=0, no error
 6441                           
 6442  F8553F  C8               ?1hex:  iny                     ; convert one hex. digit
 6443  F85540  F0 2F                    beq     ?1hex3          ; string index overflow
 6444  F85542  B7 4C                    lda     [tlp],y         ; get next char
 6445  F85544  F0 2C                    beq     ?1hex4          ; premature end of string
 6446  F85546  C9 61                    cmp     #'a'            ; convert one hex digit
 6447  F85548  90 02                    bcc     ?1hex1
 6448  F8554A  E9 20                    sbc     #$20            ; capitalize 'a', 'b',...
 6449  F8554C  38               ?1hex1: sec
 6450  F8554D  E9 3A                    sbc     #('0'+10)        ; check digits '0'..'9'
 6451  F8554F  18                       clc
  Tue Jul 17 11:00:18 2018                                                                                               Page   67




 6452  F85550  69 0A                    adc     #10
 6453  F85552  B0 09                    bcs     ?1hex2          ; ok, valid hex. digit
 6454  F85554  E9 16                    sbc     #(6+16)         ; check 'A'..'F'
 6455  F85556  18                       clc
 6456  F85557  69 06                    adc     #6
 6457  F85559  90 17                    bcc     ?1hex4          ; no hex digit: error
 6458  F8555B  69 09                    adc     #9              ; valid hex. digit
 6459  F8555D  29 0F            ?1hex2: and     #$0F            ; mask low nibble
 6460  F8555F  18               ?hxok:  clc                     ; digit ok
 6461  F85560  60                       rts
 6462  F85561  C8               ?hsep:  iny                     ; check valid separator at the end of string
 6463  F85562  F0 0D                    beq     ?1hex3          ; string index overflow
 6464  F85564  B7 4C                    lda     [tlp],y         ; get next char
 6465  F85566  F0 F7                    beq     ?hxok           ; ok, end of string
 6466  F85568  C9 20                    cmp     #' '            ; should be a separator
 6467  F8556A  F0 F3                    beq     ?hxok           ; blank
 6468  F8556C  C9 08                    cmp     #$08
 6469  F8556E  F0 EF                    beq     ?hxok           ; tab
 6470  F85570  C8                       iny                     ; invalid string
 6471  F85571  88               ?1hex3: dey                     ; string too long
 6472  F85572  38               ?1hex4: sec                     ; error
 6473  F85573  60                       rts
 6474                           
 6475  F85574  20 12 55         ?ieee:  jsr     ?ghex           ; convert hex. to fp
 6476  F85577  B0 A5                    bcs     ?ghx            ; error getting significand
 6477  F85579  20 61 55                 jsr     ?hsep           ; check end of string
 6478  F8557C  B0 A0                    bcs     ?ghx            ; error
 6479  F8557E  A5 0F                    lda     tm+15
 6480  F85580  AA                       tax
 6481  F85581  29 80                    and     #$80
 6482  F85583  85 24                    sta     facsgn          ; sign
 6483  F85585  8A                       txa
 6484  F85586  29 7F                    and     #$7F
 6485  F85588  85 23                    sta     facexp+1
 6486  F8558A  A5 0E                    lda     tm+14
 6487  F8558C  85 22                    sta     facexp
 6488  F8558E  38                       sec                     ; hidden bit
 6489  F8558F  05 23                    ora     facexp+1
 6490  F85591  D0 04                    bne     ?ie1            ; normal: hidden bit=1
 6491  F85593  18                       clc                     ; subnormal: hidden bit=0
 6492  F85594  1A                       inc     a
 6493  F85595  85 22                    sta     facexp          ; subnormal have biased exponent=1              
 6494  F85597                   ?ie1:   ACC16
 6495  F85597  C2 20                    rep     #PMFLAG
 6496                                   .LONGA  on
 6497                                   .MNLIST
 6498  F85599  A5 0C                    lda     tm+12
 6499  F8559B  6A                       ror     a               ; rotate in hidden bit
 6500  F8559C  85 20                    sta     facm+14
 6501  F8559E  A5 0A                    lda     tm+10
 6502  F855A0  6A                       ror     a
 6503  F855A1  85 1E                    sta     facm+12
 6504  F855A3  A5 08                    lda     tm+8
 6505  F855A5  6A                       ror     a
 6506  F855A6  85 1C                    sta     facm+10
 6507  F855A8  A5 06                    lda     tm+6
 6508  F855AA  6A                       ror     a
  Tue Jul 17 11:00:18 2018                                                                                               Page   68




 6509  F855AB  85 1A                    sta     facm+8
 6510  F855AD  A5 04                    lda     tm+4
 6511  F855AF  6A                       ror     a
 6512  F855B0  85 18                    sta     facm+6
 6513  F855B2  A5 02                    lda     tm+2
 6514  F855B4  6A                       ror     a
 6515  F855B5  85 16                    sta     facm+4
 6516  F855B7  A5 00                    lda     tm
 6517  F855B9  6A                       ror     a
 6518  F855BA  85 14                    sta     facm+2
 6519  F855BC  A9 00 00                 lda     #0              ; significand lsb
 6520  F855BF  6A                       ror     a
 6521  F855C0  85 12                    sta     facm
 6522  F855C2  05 14                    ora     facm+2          ; check if zero
 6523  F855C4  05 16                    ora     facm+4
 6524  F855C6  05 18                    ora     facm+6
 6525  F855C8  05 1A                    ora     facm+8
 6526  F855CA  05 1C                    ora     facm+10
 6527  F855CC  05 1E                    ora     facm+12
 6528  F855CE  05 20                    ora     facm+14
 6529  F855D0  D0 0A                    bne     ?htst
 6530  F855D2  85 22                    sta     facexp          ; fac = 0
 6531  F855D4                           ACC08
 6532  F855D4  E2 20                    sep     #PMFLAG
 6533                                   .LONGA  off
 6534                                   .MNLIST
 6535  F855D6  A9 40                    lda     #$40
 6536  F855D8  85 25                    sta     facst
 6537  F855DA  18                       clc
 6538  F855DB  60                       rts
 6539  F855DC                   ?htst:  ACC16                   ; test inf/nan
 6540  F855DC  C2 20                    rep     #PMFLAG
 6541                                   .LONGA  on
 6542                                   .MNLIST
 6543  F855DE  A2 00                    ldx     #0
 6544  F855E0  A5 22                    lda     facexp
 6545  F855E2  C9 FF 7F                 cmp     #INFEXP
 6546  F855E5  90 0B                    bcc     ?ie2            ; valid float
 6547  F855E7  A2 C0                    ldx     #$C0            ; assume inf
 6548  F855E9  A5 20                    lda     facm+14         ; check type
 6549  F855EB  C9 00 80                 cmp     #INFSND
 6550  F855EE  F0 02                    beq     ?ie2            ; set inf in fac stastus
 6551  F855F0  A2 80                    ldx     #$80            ; set nan in fac status
 6552  F855F2  86 25            ?ie2:   stx     facst
 6553  F855F4                           ACC08
 6554  F855F4  E2 20                    sep     #PMFLAG
 6555                                   .LONGA  off
 6556                                   .MNLIST
 6557  F855F6  18                       clc
 6558  F855F7  60                       rts
 6559                           
 6560  F855F8  C9 49            ?ginf:  cmp     #'I'
 6561  F855FA  F0 0E                    beq     ?inf
 6562  F855FC  C9 69                    cmp     #'i'
 6563  F855FE  F0 0A                    beq     ?inf
 6564  F85600  C9 4E                    cmp     #'N'
 6565  F85602  F0 35                    beq     ?nan
  Tue Jul 17 11:00:18 2018                                                                                               Page   69




 6566  F85604  C9 6E                    cmp     #'n'
 6567  F85606  F0 31                    beq     ?nan
 6568  F85608  38                       sec                     ; invalid string
 6569  F85609  60                       rts
 6570  F8560A  C8               ?inf:   iny
 6571  F8560B  F0 29                    beq     ?inf3           ; string index overflow
 6572  F8560D  B7 4C                    lda     [tlp],y         ; get next char
 6573  F8560F  F0 26                    beq     ?inf4           ; end of string
 6574  F85611  09 20                    ora     #$20
 6575  F85613  C9 6E                    cmp     #'n'
 6576  F85615  D0 20                    bne     ?inf4
 6577  F85617  C8                       iny
 6578  F85618  F0 1C                    beq     ?inf3           ; string index overflow
 6579  F8561A  B7 4C                    lda     [tlp],y         ; get next char
 6580  F8561C  F0 19                    beq     ?inf4           ; end of string
 6581  F8561E  09 20                    ora     #$20
 6582  F85620  C9 66                    cmp     #'f'
 6583  F85622  D0 13                    bne     ?inf4
 6584  F85624  20 61 55                 jsr     ?hsep           ; terminator or separator
 6585  F85627  B0 0F                    bcs     ?inf5
 6586  F85629  84 4F                    sty     fpidx
 6587  F8562B  20 7D 4E                 jsr     fldinf
 6588  F8562E  18               ?inf0:  clc
 6589  F8562F  A5 B8                    lda     tmsgn
 6590  F85631  85 24                    sta     facsgn
 6591  F85633  E2 40                    sep     #PVFLAG
 6592  F85635  60                       rts
 6593  F85636  88               ?inf3:  dey                     ; string too long
 6594  F85637  38               ?inf4:  sec                     ; error
 6595  F85638  60               ?inf5:  rts
 6596                           
 6597  F85639  C8               ?nan:   iny
 6598  F8563A  F0 FA                    beq     ?inf3           ; string index overflow
 6599  F8563C  B7 4C                    lda     [tlp],y         ; get next char
 6600  F8563E  F0 F7                    beq     ?inf4           ; end of string
 6601  F85640  09 20                    ora     #$20
 6602  F85642  C9 61                    cmp     #'a'
 6603  F85644  D0 F1                    bne     ?inf4
 6604  F85646  C8                       iny
 6605  F85647  F0 ED                    beq     ?inf3           ; string index overflow
 6606  F85649  B7 4C                    lda     [tlp],y         ; get next char
 6607  F8564B  F0 EA                    beq     ?inf4           ; end of string
 6608  F8564D  09 20                    ora     #$20
 6609  F8564F  C9 6E                    cmp     #'n'
 6610  F85651  D0 E4                    bne     ?inf4
 6611  F85653  20 61 55                 jsr     ?hsep           ; terminator or separator
 6612  F85656  B0 E0                    bcs     ?inf5
 6613  F85658  84 4F                    sty     fpidx
 6614  F8565A  20 74 4E                 jsr     fldnan
 6615  F8565D  80 CF                    bra     ?inf0
 6616  F8565F                           
 6617                           ;---------------------------------------------------------------------------
 6618                           ; conversion from binary to decimal
 6619                           ;---------------------------------------------------------------------------    
 6620                           
 6621                           ; int2str - convert an integer to asciiz string (decimal or hexadecimal)
 6622                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page   70




 6623                           ; 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 flags
 6630                           ;                   <7>: alternate format
 6631                           ;                   <6>: group thousands
 6632                           ;                   <1>: emit a sign '+' rather than a blank (if bit0=1)
 6633                           ;                   <0>: take account of bit 1, otherwise no '+'/blank emitted
 6634                           ;
 6635                           ;               Y = format: x,X,p,P,d
 6636                           ;
 6637                           ;               X = precision (minimum number of digits)
 6638                           ;
 6639                           ;       exit:
 6640                           ;               X = pointer to ascii buffer
 6641                           ;               Y = size of buffer
 6642                           ;
 6643                           ; The integer parameter stored in facm will be converted, according to the
 6644                           ; format specifier and the requested precision, formatting the output ascii
 6645                           ; string null-terminated:
 6646                           ;
 6647                           ;       p,P format: the integer is interpreted as long pointer (24 bits) and
 6648                           ;                   formatted as 6 hexadecimal digits prepended by '$' or by
 6649                           ;                   '0x' or '0X' if alternate format was specified.
 6650                           ;                   Precision ignored.
 6651                           ;
 6652                           ;       x,X format: the integer is converted as unsigned and formatted as 
 6653                           ;                   sequence of hexadecimal digits prepended by '$' or by
 6654                           ;                   '0x' or '0X' if alternate format was specified.
 6655                           ;
 6656                           ;       d format:   the integer is converted according to the status byte
 6657                           ;                   (facst) either as signed or unsigned integer, and
 6658                           ;                   formatted as sequence of decimal digits. 
 6659                           ;                   If bit 6 of flags is 1, thousands are grouped
 6660                           ;                   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 left 
 6664                           ; with zeros (precision is ignored for pP format).
 6665                           ;
 6666                           ;-------
 6667  F8565F                   int2str:
 6668                           ;-------
 6669  F8565F  85 CF                    sta     fpaltf          ; alternate flag format
 6670  F85661  98                       tya                     ; A=format char
 6671  F85662  A0 00                    ldy     #0              ; upper case
 6672  F85664  C9 61                    cmp     #'a'
 6673  F85666  90 08                    bcc     ?nc
 6674  F85668  C9 7B                    cmp     #'z'+1
 6675  F8566A  B0 04                    bcs     ?nc
 6676  F8566C  29 DF                    and     #$DF            ; capitalize
 6677  F8566E  A0 20                    ldy     #$20            ; lower case
 6678  F85670  84 D0            ?nc:    sty     fpcap
 6679  F85672  C9 50                    cmp     #'P'
  Tue Jul 17 11:00:18 2018                                                                                               Page   71




 6680  F85674  F0 0A                    beq     ?stf
 6681  F85676  C9 58                    cmp     #'X'
 6682  F85678  F0 06                    beq     ?stf
 6683  F8567A  C9 44                    cmp     #'D'
 6684  F8567C  F0 02                    beq     ?stf    
 6685  F8567E  A9 44                    lda     #'D'            ; force 'D' format if unknow one        
 6686  F85680  85 CE            ?stf:   sta     fpfmt           ; format style
 6687  F85682  E0 50                    cpx     #XCVTMAX        ; limit the precision to the buffer size
 6688  F85684  90 02                    bcc     ?pr1
 6689  F85686  A2 50                    ldx     #XCVTMAX
 6690  F85688  C9 50            ?pr1:   cmp     #'P'            ; 'P' format?
 6691  F8568A  D0 02                    bne     ?pr2
 6692  F8568C  A2 06                    ldx     #6              ; fixed precision = 6 for 'P' format
 6693  F8568E  86 CC            ?pr2:   stx     fpprec          ; store wanted precision
 6694  F85690  C9 44                    cmp     #'D'
 6695  F85692  F0 24                    beq     ?dec            ; decimal conversion
 6696  F85694  A9 06                    lda     #$06            ; value to add for digits A..F
 6697  F85696  05 D0                    ora     fpcap
 6698  F85698  85 3E                    sta     wftmp
 6699  F8569A  A9 7F                    lda     #$7F            ; ignore all format bits but bit 7
 6700  F8569C  14 CF                    trb     fpaltf
 6701  F8569E  A2 0F                    ldx     #15             ; counter
 6702  F856A0  A0 00                    ldy     #0
 6703  F856A2  B5 12            ?hex:   lda     facm,x
 6704  F856A4  20 74 5A                 jsr     b2hex           ; convert to hexadecimal
 6705  F856A7  99 50 3F                 sta     !P0FPU+fpstr,y  ; store high digit
 6706  F856AA  C8                       iny
 6707  F856AB  EB                       xba
 6708  F856AC  99 50 3F                 sta     !P0FPU+fpstr,y  ; store low digit
 6709  F856AF  C8                       iny
 6710  F856B0  CA                       dex
 6711  F856B1  10 EF                    bpl     ?hex
 6712  F856B3  BB                       tyx
 6713  F856B4  74 50                    stz     fpstr,x         ; put terminator
 6714  F856B6  80 03                    bra     ?fmt            ; final formattation
 6715  F856B8  20 64 5B         ?dec:   jsr     int2dec         ; convert to decimal
 6716  F856BB  A2 50            ?fmt:   ldx     #fpstr          ; get pointer to first and last digits
 6717  F856BD  20 40 57                 jsr     ?frst           ; X -> first, Y->last, A=size
 6718  F856C0  20 1B 57                 jsr     ?thg            ; move (and group) to the xcvt
 6719  F856C3  BB                       tyx                     ; X = pointer to fisrt significative digit
 6720  F856C4  85 3E                    sta     wftmp           ; A = size of significative string
 6721  F856C6  A5 CC                    lda     fpprec
 6722  F856C8  38                       sec
 6723  F856C9  E5 3E                    sbc     wftmp
 6724  F856CB  F0 0C                    beq     ?nop            ; no padding needs
 6725  F856CD  90 0A                    bcc     ?nop            ; no padding needs
 6726  F856CF  A0 30                    ldy     #'0'
 6727  F856D1  CA               ?pad:   dex
 6728  F856D2  94 00                    sty     <0,x            ; padding string with '0'
 6729  F856D4  3A                       dec     a
 6730  F856D5  D0 FA                    bne     ?pad
 6731  F856D7  A5 CC                    lda     fpprec
 6732  F856D9  A8               ?nop:   tay                     ; Y = string size
 6733  F856DA  A5 CE                    lda     fpfmt
 6734  F856DC  C9 44                    cmp     #'D'
 6735  F856DE  F0 1D                    beq     ?sts            ; decimal formattation
 6736  F856E0  C9 50                    cmp     #'P'
  Tue Jul 17 11:00:18 2018                                                                                               Page   72




 6737  F856E2  D0 02                    bne     ?hx0
 6738  F856E4  A2 C5                    ldx     #XCVTEND-6
 6739  F856E6  24 CF            ?hx0:   bit     fpaltf
 6740  F856E8  10 0C                    bpl     ?hx1            ; '$' prefix
 6741  F856EA  CA                       dex
 6742  F856EB  A9 58                    lda     #'X'
 6743  F856ED  05 D0                    ora     fpcap           ; add lower case
 6744  F856EF  95 00                    sta     <0,x
 6745  F856F1  C8                       iny                     ; update size
 6746  F856F2  A9 30                    lda     #'0'             ; '0x' or '0X' prefix
 6747  F856F4  80 02                    bra     ?hx2
 6748  F856F6  A9 24            ?hx1:   lda     #'$'
 6749  F856F8  CA               ?hx2:   dex     
 6750  F856F9  95 00                    sta     <0,x
 6751  F856FB  C8                       iny                     ; update size
 6752  F856FC  60                       rts
 6753  F856FD  84 4F            ?sts:   sty     fpidx           ; store sign according format flags
 6754  F856FF  24 4A                    bit     dsgn            ; sign test
 6755  F85701  10 04                    bpl     ?sts1           ; positive
 6756  F85703  A0 2D                    ldy     #'-'            ; negative: store sign '-'
 6757  F85705  80 0C                    bra     ?sts2
 6758  F85707  A5 CF            ?sts1:  lda     fpaltf          ; check if should store sign/blank
 6759  F85709  4A                       lsr     a               ; fpaltf<0>: 1 if should store
 6760  F8570A  90 0C                    bcc     ?done           ; no store
 6761  F8570C  A0 2B                    ldy     #'+'
 6762  F8570E  4A                       lsr     a               ; fpaltf<1>: 1 if should store blank
 6763  F8570F  B0 02                    bcs     ?sts2           ; store '+' sign
 6764  F85711  A0 20                    ldy     #' '            ; store blank
 6765  F85713  CA               ?sts2:  dex     
 6766  F85714  94 00                    sty     <0,x
 6767  F85716  E6 4F                    inc     fpidx
 6768  F85718  A4 4F            ?done:  ldy     fpidx
 6769  F8571A  60                       rts
 6770                           
 6771                                   ; move digits from fpstr buffer to xcvt buffer and
 6772                                   ; group the digits in thousands (use comma as separator)
 6773                                   ; on entry: Y = index of first significative digit on fpstr
 6774                                   ;           X = pointer to last digit on fpstr
 6775                                   ; on exit:  Y = pointer to first significative digit
 6776                                   ;           A = size of string
 6777                                   ;           X = pointer to last digit
 6778  F8571B  84 3E            ?thg:   sty     wftmp           ; index of first significative digit
 6779  F8571D  9B                       txy                     ; Y = pointer to last digit
 6780  F8571E  A2 CB                    ldx     #XCVTEND        ; X = pointer to end of xcvt buffer
 6781  F85720  74 00                    stz     <0,x            ; put string terminator
 6782  F85722  CA                       dex                     ; bump pointer
 6783  F85723  A9 03            ?thg2:  lda     #3              ; goups 3 digits
 6784  F85725  EB               ?thg4:  xba                     ; B = digits counter
 6785  F85726  B9 00 3F                 lda     !P0FPU,y        ; A = current digit
 6786  F85729  95 00                    sta     <0,x            ; move digit
 6787  F8572B  88                       dey
 6788  F8572C  C4 3E                    cpy     wftmp           ; finish?
 6789  F8572E  90 10                    bcc     ?frst           ; yes
 6790  F85730  EB                       xba                     ; A = digits counter
 6791  F85731  CA                       dex
 6792  F85732  3A                       dec     a
 6793  F85733  D0 F0                    bne     ?thg4           ; groups 3 digits
  Tue Jul 17 11:00:18 2018                                                                                               Page   73




 6794  F85735  24 CF                    bit     fpaltf          ; check if should groups thousands
 6795  F85737  50 EA                    bvc     ?thg2           ; no groups
 6796  F85739  A9 2C                    lda     #','            ; thousands separator
 6797  F8573B  95 00                    sta     <0,x
 6798  F8573D  CA                       dex
 6799  F8573E  80 E3                    bra     ?thg2           ; repeat until end of source string
 6800                           
 6801                                   ; get the pointer to first significative digit (not '0')
 6802                                   ; on entry: X = pointer to first digit
 6803                                   ; on exit:  Y = pointer to first significative digit
 6804                                   ;           A = size of string
 6805                                   ;           X = pointer to last digit
 6806  F85740  86 3F            ?frst:  stx     wftmp+1
 6807  F85742  B5 00            ?fr0:   lda     <0,x
 6808  F85744  F0 07                    beq     ?fr1            ; end of string
 6809  F85746  C9 30                    cmp     #'0'
 6810  F85748  D0 04                    bne     ?fr2            ; first significative digit
 6811  F8574A  E8                       inx
 6812  F8574B  80 F5                    bra     ?fr0            ; search again
 6813  F8574D  CA               ?fr1:   dex                     ; X = pointer to last digit
 6814  F8574E  9B               ?fr2:   txy                     ; Y = pointer to first significative digit
 6815  F8574F  A6 3F                    ldx     wftmp+1         ; start of string
 6816  F85751  B5 00            ?fr3:   lda     <0,x            ; search end of string
 6817  F85753  F0 03                    beq     ?fr4
 6818  F85755  E8                       inx
 6819  F85756  80 F9                    bra     ?fr3
 6820  F85758  CA               ?fr4:   dex                     ; X = pointer to last digit
 6821  F85759  8A                       txa
 6822  F8575A  84 3E                    sty     wftmp
 6823  F8575C  38                       sec
 6824  F8575D  E5 3E                    sbc     wftmp
 6825  F8575F  1A                       inc     a               ; significative string size
 6826  F85760  60                       rts
 6827                           
 6828                           ; fp2str - convert a quadruple precision floating point to asciiz string
 6829                           ;
 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 argument
 6835                           ;
 6836                           ;               A = additional formattation flags
 6837                           ;                   <7>: alternate format
 6838                           ;                   <6>: not discriminate +0.0 from -0.0
 6839                           ;                   <1>: emit a sign '+' rather than a blank (if bit0=1)
 6840                           ;                   <0>: take account of bit 1, otherwise no '+'/blank emitted
 6841                           ;
 6842                           ;               Y = format: e,E,f,F,g,G,a,A,k,K
 6843                           ;
 6844                           ;               X = precision/count of decimal digits (after the '.')
 6845                           ;
 6846                           ;       exit:
 6847                           ;               X = pointer to ascii buffer
 6848                           ;               Y = size of buffer
 6849                           ;
 6850                           ; The formatted decimal string is either the f/F format:
  Tue Jul 17 11:00:18 2018                                                                                               Page   74




 6851                           ;       [sign]ddd.ddd
 6852                           ; or the e/E format:
 6853                           ;       [sign]d.ddde+|-[d][d]dd
 6854                           ; where the number of digits after the decimal-point character is equal to
 6855                           ; precision specification. The exponent in E format always contains at least
 6856                           ; two digits; if the value is zero, the exponent is 00.
 6857                           ; In the G format, precision specifies the number of significant digits: if
 6858                           ; it is zero, is teeated as 1. G format can format decimal string in E style
 6859                           ; or F style: style E is used if the exponent from its conversion is less 
 6860                           ; than MINGEXP or greater than or equal to the precision.
 6861                           ; Trailing decimal points are usually suppressed, as also are trailing 
 6862                           ; fraction zeroes in the G/g format. If bit 7 of additional flag is 1
 6863                           ; 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 hexadecimal
 6865                           ; digits (the content of the 128 bits mantissa), followed by the biased
 6866                           ; exponent (introduced by literal 'p' or 'P'), or-ed at bit 15 with sign of 
 6867                           ; 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 32
 6869                           ; 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 the
 6873                           ; requested format & precision cannot fit into this limit, the format is
 6874                           ; switched to 'E' and limited in size.
 6875                           ;
 6876                           ;------
 6877  F85761                   fp2str:
 6878                           ;------
 6879  F85761  85 CF                    sta     fpaltf          ; alternate flag format
 6880  F85763  64 D1                    stz     fpstyle         ; assume 'E' style
 6881  F85765  98                       tya                     ; A=format char
 6882  F85766  A0 00                    ldy     #0              ; upper case
 6883  F85768  C9 61                    cmp     #'a'
 6884  F8576A  90 08                    bcc     ?nc
 6885  F8576C  C9 7B                    cmp     #'z'+1
 6886  F8576E  B0 04                    bcs     ?nc
 6887  F85770  29 DF                    and     #$DF            ; capitalize
 6888  F85772  A0 20                    ldy     #$20            ; lower case
 6889  F85774  84 D0            ?nc:    sty     fpcap
 6890  F85776  C9 45                    cmp     #'E'
 6891  F85778  F0 0E                    beq     ?stf
 6892  F8577A  C9 46                    cmp     #'F'
 6893  F8577C  F0 0A                    beq     ?stf
 6894  F8577E  C9 41                    cmp     #'A'
 6895  F85780  F0 06                    beq     ?stf
 6896  F85782  C9 4B                    cmp     #'K'
 6897  F85784  F0 02                    beq     ?stf    
 6898  F85786  A9 47                    lda     #'G'            ; force 'G' format if unknow one        
 6899  F85788  85 CE            ?stf:   sta     fpfmt           ; format style
 6900  F8578A  E0 50                    cpx     #XCVTMAX        ; limit the precision to the buffer size
 6901  F8578C  90 02                    bcc     ?pr1
 6902  F8578E  A2 50                    ldx     #XCVTMAX
 6903  F85790  C9 47            ?pr1:   cmp     #'G'            ; 'G' format?
 6904  F85792  D0 05                    bne     ?pr2            ; no
 6905  F85794  9B                       txy                     ; if precision=0 and 'G' format...
 6906  F85795  F0 06                    beq     ?pr3            ; ...then set precision=1
 6907  F85797  D0 05                    bne     ?pr4            ; significant digits for 'G' format
  Tue Jul 17 11:00:18 2018                                                                                               Page   75




 6908  F85799  C9 45            ?pr2:   cmp     #'E'            ; 'E' format?
 6909  F8579B  D0 01                    bne     ?pr4            ; no
 6910  F8579D  E8               ?pr3:   inx                     ; 'E' format need one digit more        
 6911  F8579E  86 CC            ?pr4:   stx     fpprec          ; store wanted precision
 6912  F857A0  64 CD                    stz     fpprec+1        ; extend precision P to 16 bits
 6913                           
 6914                                   ; P=fpprec specifies significant digits for 'E' & 'G' format, 
 6915                                   ; and digit counts of fractional part for 'F' format
 6916  F857A2                           
 6917  F857A2  C9 41                    cmp     #'A'            ; 'A' format?
 6918  F857A4  D0 5B                    bne     ?kfmt           ; no
 6919  F857A6                           
 6920                                   ; format floating point as hexadecimal full mantissa
 6921                                   ; plus biased exponent (or-ed with mantissa sign)
 6922  F857A6  A0 00                    ldy     #0              ; string index
 6923  F857A8  24 CF                    bit     fpaltf
 6924  F857AA  10 0C                    bpl     ?a1             ; '$' prfix
 6925  F857AC  A2 30                    ldx     #'0'             ; '0x' or '0X' prefix
 6926  F857AE  96 78                    stx     xcvt,y
 6927  F857B0  C8                       iny
 6928  F857B1  A9 58                    lda     #'X'
 6929  F857B3  05 D0                    ora     fpcap           ; add lower case
 6930  F857B5  AA                       tax
 6931  F857B6  80 02                    bra     ?a2
 6932  F857B8  A2 24            ?a1:    ldx     #'$'
 6933  F857BA  96 78            ?a2:    stx     xcvt,y
 6934  F857BC  C8                       iny
 6935  F857BD  A9 06                    lda     #$06            ; value to add for digits A..F
 6936  F857BF  05 D0                    ora     fpcap
 6937  F857C1  85 3E                    sta     wftmp
 6938  F857C3  A2 0F                    ldx     #15             ; counter
 6939  F857C5  B5 12            ?a4:    lda     facm,x
 6940  F857C7  20 74 5A                 jsr     b2hex           ; convert
 6941  F857CA  99 78 3F                 sta     !P0FPU+xcvt,y   ; store high digit
 6942  F857CD  C8                       iny
 6943  F857CE  EB                       xba
 6944  F857CF  99 78 3F                 sta     !P0FPU+xcvt,y   ; store low digit
 6945  F857D2  C8                       iny
 6946  F857D3  CA                       dex
 6947  F857D4  10 EF                    bpl     ?a4
 6948  F857D6  A9 50                    lda     #'P'            ; exponent separator
 6949  F857D8  05 D0                    ora     fpcap
 6950  F857DA  AA                       tax
 6951  F857DB  96 78                    stx     xcvt,y
 6952  F857DD  C8                       iny
 6953  F857DE  A5 24                    lda     facsgn
 6954  F857E0  29 80                    and     #$80            ; mask sign
 6955  F857E2  05 23                    ora     facexp+1
 6956  F857E4  20 74 5A                 jsr     b2hex           ; convert high exponent + sign
 6957  F857E7  99 78 3F                 sta     !P0FPU+xcvt,y   ; store high digit
 6958  F857EA  C8                       iny
 6959  F857EB  EB                       xba
 6960  F857EC  99 78 3F                 sta     !P0FPU+xcvt,y   ; store low digit
 6961  F857EF  C8                       iny
 6962  F857F0  A5 22                    lda     facexp
 6963  F857F2  20 74 5A                 jsr     b2hex           ; convert low exponent
 6964  F857F5  99 78 3F                 sta     !P0FPU+xcvt,y   ; store high digit
  Tue Jul 17 11:00:18 2018                                                                                               Page   76




 6965  F857F8  C8                       iny
 6966  F857F9  EB                       xba
 6967  F857FA  99 78 3F                 sta     !P0FPU+xcvt,y   ; store low digit
 6968  F857FD  C8                       iny
 6969  F857FE  4C A7 58                 jmp     ?done
 6970                           
 6971  F85801  C9 4B            ?kfmt   cmp     #'K'            ; packed format?
 6972  F85803  D0 2B                    bne     ?cvt            ; no
 6973  F85805  A9 00                    lda     #tm
 6974  F85807  A2 3F                    ldx     #>P0FPU
 6975  F85809  A0 00                    ldy     #0
 6976  F8580B  20 54 4D                 jsr     fpack           ; pack to tm..tm+15
 6977  F8580E  A0 00                    ldy     #0
 6978  F85810  A2 23                    ldx     #'#'
 6979  F85812  96 78                    stx     xcvt,y
 6980  F85814  C8                       iny
 6981  F85815  A9 06                    lda     #$06            ; value to add for digits A..F
 6982  F85817  05 D0                    ora     fpcap
 6983  F85819  85 3E                    sta     wftmp
 6984  F8581B  A2 0F                    ldx     #15             ; counter
 6985  F8581D  B5 00            ?kl:    lda     tm,x
 6986  F8581F  20 74 5A                 jsr     b2hex           ; convert
 6987  F85822  99 78 3F                 sta     !P0FPU+xcvt,y   ; store high digit
 6988  F85825  C8                       iny
 6989  F85826  EB                       xba
 6990  F85827  99 78 3F                 sta     !P0FPU+xcvt,y   ; store low digit
 6991  F8582A  C8                       iny
 6992  F8582B  CA                       dex
 6993  F8582C  10 EF                    bpl     ?kl
 6994  F8582E  80 77                    bra     ?done
 6995  F85830                           
 6996                                   ; The basic conversion to a decimal string is done by fp2dec,
 6997                                   ; with this function responsible for "customizing" the simple
 6998                                   ; format which fp2dec returns. 
 6999  F85830  20 89 5A         ?cvt:   jsr     fp2dec          ; let E=dexp=decimal exponent
 7000  F85833  24 25                    bit     facst           ; fac is valid?
 7001  F85835  10 14                    bpl     ?vf             ; yes
 7002  F85837  20 E0 59                 jsr     ?sts            ; store sign
 7003  F8583A  A2 00                    ldx     #0              ; store string NAN or INF
 7004  F8583C  B5 50            ?inv:   lda     fpstr,x 
 7005  F8583E  05 D0                    ora     fpcap           ; add lower case
 7006  F85840  99 78 3F                 sta     !P0FPU+xcvt,y   ; store
 7007  F85843  C8                       iny
 7008  F85844  E8                       inx
 7009  F85845  E0 03                    cpx     #3
 7010  F85847  90 F3                    bcc     ?inv
 7011  F85849  80 5C                    bra     ?done           ; done
 7012  F8584B  20 FA 59         ?vf:    jsr     ?round10        ; round up decimal number
 7013  F8584E                           
 7014                                   ; Now that we have the basic string, decide what format the caller
 7015                                   ; wants it to be put into. Use the F format if either of the 
 7016                                   ; following is true:
 7017                                   ;       o+ the format is 'f' or 'F'
 7018                                   ;       o+ the format is 'g' or 'G' and the exponent
 7019                                   ;          is between MINGEXP and precision (fpprec)
 7020                                   ; and if overall digits count is less than XCVTMAX.
 7021  F8584E  A5 CE                    lda     fpfmt   
  Tue Jul 17 11:00:18 2018                                                                                               Page   77




 7022  F85850  C9 45                    cmp     #'E'
 7023  F85852  F0 42                    beq     ?end2           ; caller wants 'E' format
 7024  F85854  C9 47                    cmp     #'G'
 7025  F85856                           ACC16CLC
 7026  F85856  C2 21                    rep     #(PMFLAG.OR.PCFLAG)
 7027                                   .LONGA  on
 7028                                   .MNLIST
 7029  F85858  D0 1C                    bne     ?ff             ; caller wants 'F' format
 7030  F8585A  A5 48                    lda     dexp            ; if E < 0...
 7031  F8585C  30 08                    bmi     ?g1             ; ...compare vs. MINGEXP 
 7032  F8585E  C5 CC                    cmp     fpprec          ; ...else compare with P
 7033  F85860  B0 32                    bcs     ?end            ; if E >= P select 'E' style
 7034  F85862  A5 CC                    lda     fpprec          ; 'G' format, E>=0: overall digits count = P
 7035  F85864  80 0C                    bra     ?g2
 7036  F85866  C9 FC FF         ?g1:    cmp     #MINGEXP
 7037  F85869  90 29                    bcc     ?end            ; if E < MINGEXP select 'E' style
 7038  F8586B  49 FF FF                 eor     #$FFFF          ; complement decimal exponent
 7039  F8586E  1A                       inc     a
 7040  F8586F  18                       clc
 7041  F85870  65 CC                    adc     fpprec          ; 'G' format, E<0...
 7042  F85872  85 3E            ?g2:    sta     wftmp           ; ...overall digits count = |E|+P
 7043  F85874  80 0B                    bra     ?f2
 7044  F85876  A5 CC            ?ff:    lda     fpprec          ; 'F' format: P = P + 1
 7045  F85878  1A                       inc     a
 7046  F85879  A6 49                    ldx     dexp+1
 7047  F8587B  30 02                    bmi     ?f1             ; 'F', E<0: overall digits count = P+1
 7048  F8587D  65 48                    adc     dexp            ; 'F', E>=0: overall digits count = E+P+1
 7049  F8587F  85 3E            ?f1:    sta     wftmp
 7050  F85881  C9 50 00         ?f2:    cmp     #XCVTMAX        ; fit into buffer?
 7051  F85884                           ACC08
 7052  F85884  E2 20                    sep     #PMFLAG
 7053                                   .LONGA  off
 7054                                   .MNLIST
 7055  F85886  90 06                    bcc     ?f3             ; yes
 7056  F85888  A9 24                    lda     #MAXDIGITS
 7057  F8588A  85 CC                    sta     fpprec
 7058  F8588C  B0 08                    bcs     ?end2           ; force 'E' style
 7059  F8588E  A2 80            ?f3:    ldx     #$80
 7060  F85890  86 D1                    stx     fpstyle         ; select 'F' style
 7061  F85892  80 02                    bra     ?end2
 7062  F85894                   ?end:   ACC08   
 7063  F85894  E2 20                    sep     #PMFLAG
 7064                                   .LONGA  off
 7065                                   .MNLIST
 7066  F85896  20 E0 59         ?end2:  jsr     ?sts            ; emit sign
 7067  F85899  84 4F                    sty     fpidx           ; index of the first digit
 7068  F8589B  24 D1                    bit     fpstyle         ; 'F' format?
 7069  F8589D  10 05                    bpl     ?ee             ; no, 'E' format
 7070  F8589F  20 AE 58                 jsr     ?ffmt
 7071  F858A2  80 03                    bra     ?done
 7072  F858A4  20 33 59         ?ee:    jsr     ?efmt
 7073  F858A7  A2 00            ?done:  ldx     #0
 7074  F858A9  96 78                    stx     xcvt,y
 7075  F858AB  A2 78                    ldx     #xcvt
 7076  F858AD  60                       rts
 7077                           
 7078                                   ; If E<0, the 'F' format place a digit '0' followed by a decimal dot, 
  Tue Jul 17 11:00:18 2018                                                                                               Page   78




 7079                                   ; followed by |E|-1 leading zeroes. After, place all needs significant
 7080                                   ; digits.
 7081  F858AE  64 4B            ?ffmt:  stz     fpdot   
 7082  F858B0  A5 48                    lda     dexp            ; exponent E
 7083  F858B2  10 1A                    bpl     ?ffp            ; E>=0
 7084  F858B4  A2 30                    ldx     #'0'
 7085  F858B6  96 78                    stx     xcvt,y
 7086  F858B8  C8                       iny
 7087  F858B9  A2 2E                    ldx     #'.'
 7088  F858BB  96 78                    stx     xcvt,y
 7089  F858BD  C8                       iny
 7090  F858BE  C6 3E                    dec     wftmp           ; update digits count
 7091  F858C0  C6 4B                    dec     fpdot           ; decimal dot indicatr
 7092  F858C2  A2 30                    ldx     #'0'
 7093  F858C4  1A               ?ff0:   inc     a
 7094  F858C5  F0 08                    beq     ?ffr            ; when E=0 put significant...
 7095  F858C7  96 78                    stx     xcvt,y          ; put leading zeroes...
 7096  F858C9  C8                       iny
 7097  F858CA  C6 3E                    dec     wftmp
 7098  F858CC  80 F6                    bra     ?ff0            ; ...until E=0
 7099  F858CE  1A               ?ffp:   inc     a               ; we increment exponent for easily manage '.'
 7100  F858CF  A2 00            ?ffr:   ldx     #0              ; index
 7101  F858D1  85 46                    sta     scexp           ; save current exponent
 7102  F858D3                           
 7103                                   ; Now write the regular digits, inserting a '.' if it is somewhere
 7104                                   ; in the middle of the numeral.
 7105  F858D3  B5 50            ?ffl:   lda     fpstr,x         ; regular digit
 7106  F858D5  F0 15                    beq     ?ff2            ; end
 7107  F858D7  99 78 3F                 sta     !P0FPU+xcvt,y   ; store digit
 7108  F858DA  C8                       iny
 7109  F858DB  E8                       inx
 7110  F858DC  C6 3E                    dec     wftmp
 7111  F858DE  C6 46                    dec     scexp
 7112  F858E0  D0 F1                    bne     ?ffl            ; loop until last digit or E=0
 7113  F858E2  A9 2E                    lda     #'.'
 7114  F858E4  99 78 3F                 sta     !P0FPU+xcvt,y   ; store '.'
 7115  F858E7  C8                       iny
 7116  F858E8  C6 4B                    dec     fpdot           ; decimal dot indicatr  
 7117  F858EA  80 E7                    bra     ?ffl
 7118  F858EC  A6 48            ?ff2:   ldx     dexp
 7119  F858EE  30 19                    bmi     ?ff4            ; 0.dddd... form
 7120  F858F0  24 4B                    bit     fpdot
 7121  F858F2  30 15                    bmi     ?ff4            ; no more integral digits
 7122  F858F4  A5 46                    lda     scexp           ; ddd.ddd... form
 7123  F858F6  F0 11                    beq     ?ff4            ; no more integral digits
 7124  F858F8  A2 30                    ldx     #'0'             ; must complete an integral number padding it..
 7125  F858FA  96 78            ?ff3:   stx     xcvt,y          ; ...with zeroes
 7126  F858FC  C8                       iny
 7127  F858FD  C6 3E                    dec     wftmp
 7128  F858FF  3A                       dec     a       
 7129  F85900  D0 F8                    bne     ?ff3
 7130  F85902  A2 2E                    ldx     #'.'            ; put in a trailing decimal dot
 7131  F85904  96 78                    stx     xcvt,y
 7132  F85906  C8                       iny
 7133  F85907  C6 4B                    dec     fpdot           ; decimal dot indicator
 7134  F85909  A5 CE            ?ff4:   lda     fpfmt
 7135  F8590B  C9 47                    cmp     #'G'            ; 'G' format remove trailing zeroes...
  Tue Jul 17 11:00:18 2018                                                                                               Page   79




 7136  F8590D  D0 0B                    bne     ?ff5
 7137  F8590F  24 CF                    bit     fpaltf          ; ...if not alternate format
 7138  F85911  30 07                    bmi     ?ff5
 7139  F85913  24 4B                    bit     fpdot           ; ...and if was putted in a decimal dot
 7140  F85915  10 03                    bpl     ?ff5
 7141  F85917  4C CF 59                 jmp     ?trim           ; trim trailing zeroes
 7142  F8591A  A5 3E            ?ff5:   lda     wftmp           ; pad string with '0'
 7143  F8591C  F0 08                    beq     ?ff7
 7144  F8591E  A2 30                    ldx     #'0'
 7145  F85920  96 78            ?ff6:   stx     xcvt,y
 7146  F85922  C8                       iny
 7147  F85923  3A                       dec     a
 7148  F85924  D0 FA                    bne     ?ff6
 7149  F85926  24 CF            ?ff7:   bit     fpaltf          ; trim trailing '.' if any...
 7150  F85928  30 08                    bmi     ?ff8            ; ...and not alternate format
 7151  F8592A  88                       dey
 7152  F8592B  B6 78                    ldx     xcvt,y
 7153  F8592D  E0 2E                    cpx     #'.'
 7154  F8592F  F0 01                    beq     ?ff8
 7155  F85931  C8                       iny
 7156  F85932  60               ?ff8:   rts
 7157                           
 7158                                   ; The E format always places one digit to the left of the decimal
 7159                                   ; point, followed by fraction digits, and then an 'E' followed
 7160                                   ; by a decimal exponent.  The exponent is always 2 digits unless
 7161                                   ; it is of magnitude > 99.
 7162  F85933  A6 CC            ?efmt:  ldx     fpprec
 7163  F85935  E0 4A                    cpx     #XCVTMAX-6
 7164  F85937  90 02                    bcc     ?e0
 7165  F85939  A2 4A                    ldx     #XCVTMAX-6
 7166  F8593B  86 3E            ?e0:    stx     wftmp           ; overall digits count
 7167  F8593D  A2 00                    ldx     #0              ; decimal string index
 7168  F8593F  B5 50                    lda     fpstr,x
 7169  F85941  99 78 3F                 sta     !P0FPU+xcvt,y   ; store first digit
 7170  F85944  C6 3E                    dec     wftmp
 7171  F85946  E8                       inx
 7172  F85947  C8                       iny
 7173  F85948  A9 2E                    lda     #'.'            ; decimal dot
 7174  F8594A  EB                       xba                     ; B='.'
 7175  F8594B  B5 50                    lda     fpstr,x         ; follow a digit?
 7176  F8594D  D0 0B                    bne     ?e2             ; yes
 7177  F8594F  24 CF                    bit     fpaltf          ; if alternate format is false...
 7178  F85951  10 36                    bpl     ?exx            ; ...not emit trailing '.'
 7179  F85953  EB                       xba                     ; otherwise yes
 7180  F85954  99 78 3F                 sta     !P0FPU+xcvt,y   ; store '.'
 7181  F85957  C8                       iny
 7182  F85958  80 2F                    bra     ?exx            ; emit exponent
 7183  F8595A  E8               ?e2:    inx                     ; bump pointer
 7184  F8595B  EB                       xba
 7185  F8595C  99 78 3F                 sta     !P0FPU+xcvt,y   ; store '.'
 7186  F8595F  C8                       iny
 7187  F85960  EB                       xba                     ; 2nd digit
 7188  F85961  99 78 3F         ?e3:    sta     !P0FPU+xcvt,y   ; store following digits
 7189  F85964  C8                       iny
 7190  F85965  C6 3E                    dec     wftmp
 7191  F85967  B5 50                    lda     fpstr,x         ; next digit
 7192  F85969  F0 03                    beq     ?e4             ; no more digits
  Tue Jul 17 11:00:18 2018                                                                                               Page   80




 7193  F8596B  E8                       inx
 7194  F8596C  80 F3                    bra     ?e3
 7195  F8596E  A5 CE            ?e4:    lda     fpfmt
 7196  F85970  C9 47                    cmp     #'G'            ; 'G' format remove trailing zeroes...
 7197  F85972  D0 09                    bne     ?e5
 7198  F85974  24 CF                    bit     fpaltf          ; ...if not alternate format
 7199  F85976  30 05                    bmi     ?e5
 7200  F85978  20 CF 59                 jsr     ?trim           ; trim trailing zeroes
 7201  F8597B  80 0C                    bra     ?exx            ; emit exponent
 7202  F8597D  A5 3E            ?e5:    lda     wftmp           ; pad string with '0'
 7203  F8597F  F0 08                    beq     ?exx
 7204  F85981  A2 30                    ldx     #'0'
 7205  F85983  96 78            ?e6:    stx     xcvt,y
 7206  F85985  C8                       iny
 7207  F85986  3A                       dec     a
 7208  F85987  D0 FA                    bne     ?e6
 7209  F85989  A9 45            ?exx:   lda     #'E'            ; emit exponent
 7210  F8598B  05 D0                    ora     fpcap           ; add letter case
 7211  F8598D  99 78 3F                 sta     !P0FPU+xcvt,y
 7212  F85990  C8                       iny
 7213  F85991                           ACC16
 7214  F85991  C2 20                    rep     #PMFLAG
 7215                                   .LONGA  on
 7216                                   .MNLIST
 7217  F85993  A2 2B                    ldx     #'+'
 7218  F85995  A5 48                    lda     dexp
 7219  F85997  10 06                    bpl     ?exs            ; positive exponent
 7220  F85999  49 FF FF                 eor     #$FFFF
 7221  F8599C  1A                       inc     a
 7222  F8599D  A2 2D                    ldx     #'-'
 7223  F8599F  85 00            ?exs:   sta     tm              ; store unsigned exponent
 7224  F859A1  85 46                    sta     scexp
 7225  F859A3  96 78                    stx     xcvt,y          ; store exponent sign
 7226  F859A5  C8                       iny
 7227  F859A6  84 4F                    sty     fpidx           ; save string index
 7228  F859A8                           ACC08
 7229  F859A8  E2 20                    sep     #PMFLAG
 7230                                   .LONGA  off
 7231                                   .MNLIST
 7232  F859AA  20 15 5C                 jsr     w2dec           ; convert exponent to decimal
 7233  F859AD                           ACC16
 7234  F859AD  C2 20                    rep     #PMFLAG
 7235                                   .LONGA  on
 7236                                   .MNLIST
 7237  F859AF  A2 01                    ldx     #1              ; index if exp>=1000
 7238  F859B1  A5 46                    lda     scexp
 7239  F859B3  C9 E8 03                 cmp     #1000
 7240  F859B6  B0 07                    bcs     ?ex2
 7241  F859B8  E8                       inx                     ; 100 <= exp < 1000
 7242  F859B9  C9 64 00                 cmp     #100
 7243  F859BC  B0 01                    bcs     ?ex2
 7244  F859BE  E8                       inx                     ; exp < 100
 7245  F859BF                   ?ex2:   ACC08
 7246  F859BF  E2 20                    sep     #PMFLAG
 7247                                   .LONGA  off
 7248                                   .MNLIST
 7249  F859C1  A4 4F                    ldy     fpidx           ; string index
  Tue Jul 17 11:00:18 2018                                                                                               Page   81




 7250  F859C3  B5 50            ?ex3:   lda     fpstr,x
 7251  F859C5  F0 07                    beq     ?ex4
 7252  F859C7  99 78 3F                 sta     !P0FPU+xcvt,y
 7253  F859CA  C8                       iny
 7254  F859CB  E8                       inx
 7255  F859CC  80 F5                    bra     ?ex3
 7256  F859CE  60               ?ex4:   rts
 7257                           
 7258                                   ; trim trailing zeroes
 7259  F859CF  88               ?trim:  dey                     ; pointer to last character
 7260  F859D0  C4 4F                    cpy     fpidx           ; if it is the first digit...
 7261  F859D2  F0 0A                    beq     ?tr1            ; ...restore pointer and exit
 7262  F859D4  B6 78                    ldx     xcvt,y
 7263  F859D6  E0 30                    cpx     #'0'             ; trim trailing '0'...
 7264  F859D8  F0 F5                    beq     ?trim
 7265  F859DA  E0 2E                    cpx     #'.'            ; trim trailing '.' if any
 7266  F859DC  F0 01                    beq     ?tr2
 7267  F859DE  C8               ?tr1:   iny
 7268  F859DF  60               ?tr2:   rts
 7269                           
 7270  F859E0  A0 00            ?sts:   ldy     #0              ; store sign according format flags
 7271  F859E2  24 4A                    bit     dsgn            ; sign test
 7272  F859E4  10 04                    bpl     ?sts1           ; positive
 7273  F859E6  A2 2D                    ldx     #'-'            ; negative: store sign '-'
 7274  F859E8  80 0C                    bra     ?sts2
 7275  F859EA  A5 CF            ?sts1:  lda     fpaltf          ; check if should store sign/blank
 7276  F859EC  4A                       lsr     a               ; fpaltf<0>: 1 if should store
 7277  F859ED  90 0A                    bcc     ?sts3           ; no store
 7278  F859EF  A2 2B                    ldx     #'+'
 7279  F859F1  4A                       lsr     a               ; fpaltf<1>: 1 if should store blank
 7280  F859F2  B0 02                    bcs     ?sts2           ; store '+' sign
 7281  F859F4  A2 20                    ldx     #' '            ; store blank
 7282  F859F6  96 78            ?sts2:  stx     xcvt,y
 7283  F859F8  C8                       iny
 7284  F859F9  60               ?sts3:  rts
 7285                           
 7286  F859FA                   ?round10:
 7287                                   ; Round up the decimal string according to the wanted precision P
 7288                                   ; We round directly the decimal string at the N-th digit, where:
 7289                                   ;       o+  N=P if 'E' or 'G' format
 7290                                   ;       o+  N=E+P+1 if 'F' format
 7291                                   ; round up with usual decimal method: round to nearest away from zero
 7292                                   ;
 7293                                   ; on entry VF=1 if decimal float = 0.0
 7294                           
 7295  F859FA  A6 CC                    ldx     fpprec          ; X=P=precision (8 bit)
 7296  F859FC  A5 CE                    lda     fpfmt           ; A=wanted format
 7297  F859FE  70 60                    bvs     ?zz             ; number = 0
 7298  F85A00  C9 46                    cmp     #'F'
 7299  F85A02  D0 13                    bne     ?rnd            ; 'E'&'G' format: N=P
 7300  F85A04                           ACC16CLC                ; 'F' format: N=E+P+1
 7301  F85A04  C2 21                    rep     #(PMFLAG.OR.PCFLAG)
 7302                                   .LONGA  on
 7303                                   .MNLIST
 7304  F85A06  A5 48                    lda     dexp            ; signed addition
 7305  F85A08  65 CC                    adc     fpprec
 7306  F85A0A  1A                       inc     a               ; N=E+P+1
  Tue Jul 17 11:00:18 2018                                                                                               Page   82




 7307  F85A0B  30 40                    bmi     ?rtz            ; if N<0 we round to zero
 7308  F85A0D  C9 24 00                 cmp     #MAXDIGITS      ; we limit rounding to the max. possible
 7309  F85A10                           ACC08
 7310  F85A10  E2 20                    sep     #PMFLAG
 7311                                   .LONGA  off
 7312                                   .MNLIST
 7313  F85A12  90 02                    bcc     ?rnd0
 7314  F85A14  A9 24                    lda     #MAXDIGITS
 7315  F85A16  AA               ?rnd0:  tax
 7316  F85A17  E0 24            ?rnd:   cpx     #MAXDIGITS      ; limit the digit index to round up
 7317  F85A19  90 05                    bcc     ?rnd1           ; round up at N-th digit
 7318  F85A1B  A2 24                    ldx     #MAXDIGITS
 7319  F85A1D  74 50                    stz     fpstr,x         ; truncate??
 7320  F85A1F  60                       rts
 7321  F85A20  B5 50            ?rnd1:  lda     fpstr,x         ; last digit: can cause round up
 7322  F85A22  74 50                    stz     fpstr,x         ; truncate decimal string
 7323  F85A24  C9 35                    cmp     #'5'            ; if last digits < '5'...
 7324  F85A26  90 24                    bcc     ?rend           ; no round up
 7325  F85A28  9B                       txy                     ; X=0?
 7326  F85A29  D0 04                    bne     ?rnd2           ; no
 7327  F85A2B                           
 7328                                   ; special case for 'F' format when E<0: can happen that N=E+P+1=0
 7329                                   ; in this case we round up to '1' theb first digit and increment
 7330                                   ; decimal exponent
 7331  F85A2B  64 51                    stz     fpstr+1         ; string contain just one digits '1'...
 7332  F85A2D  80 13                    bra     ?rinc           ; ...and we increment exponent
 7333  F85A2F  A0 30            ?rnd2:  ldy     #'0'     
 7334  F85A31  CA               ?rndl:  dex                     ; previous digit index
 7335  F85A32  30 0E                    bmi     ?rinc           ; rounding up zeroes all digits...
 7336  F85A34  B5 50                    lda     fpstr,x 
 7337  F85A36  1A                       inc     a               ; round up digit
 7338  F85A37  C9 3A                    cmp     #'9'+1
 7339  F85A39  90 04                    bcc     ?rnd3           ; stop rounding up
 7340  F85A3B  94 50                    sty     fpstr,x         ; round digit to '0'...
 7341  F85A3D  B0 F2                    bcs     ?rndl           ; ...and repeat
 7342  F85A3F  95 50            ?rnd3:  sta     fpstr,x         ; store rounded digit
 7343  F85A41  60                       rts                     ; stop rounding up
 7344  F85A42                   ?rinc:  ACC16                   ; rounding generate a carry to first digit
 7345  F85A42  C2 20                    rep     #PMFLAG
 7346                                   .LONGA  on
 7347                                   .MNLIST
 7348  F85A44  E6 48                    inc     dexp            ; increment decimal exponent
 7349  F85A46                           ACC08
 7350  F85A46  E2 20                    sep     #PMFLAG
 7351                                   .LONGA  off
 7352                                   .MNLIST
 7353  F85A48  A9 31                    lda     #'1'            ; store '1' because rounding change a 999...
 7354  F85A4A  85 50                    sta     fpstr           ; ...to 1000...
 7355  F85A4C  60               ?rend:  rts
 7356  F85A4D                   ?rtz:   ACC08                   ; round to zero 
 7357  F85A4D  E2 20                    sep     #PMFLAG
 7358                                   .LONGA  off
 7359                                   .MNLIST
 7360  F85A4F  A9 30                    lda     #'0'
 7361  F85A51  A2 25                    ldx     #EXP10-1        ; zeroes all digits...
 7362  F85A53  74 51                    stz     fpstr+1,x
 7363  F85A55  95 50            ?zlp:   sta     fpstr,x
  Tue Jul 17 11:00:18 2018                                                                                               Page   83




 7364  F85A57  CA                       dex
 7365  F85A58  10 FB                    bpl     ?zlp
 7366  F85A5A  64 48                    stz     dexp            ; clear decimal exponent
 7367  F85A5C  A6 CC                    ldx     fpprec
 7368  F85A5E  A5 CE                    lda     fpfmt           ; A=wanted format
 7369  F85A60  C9 46            ?zz:    cmp     #'F'
 7370  F85A62  D0 01                    bne     ?z1
 7371  F85A64  E8                       inx                     ; 'F' format: one digit more for '0'
 7372  F85A65  E0 24            ?z1:    cpx     #MAXDIGITS      ; limit the digit index
 7373  F85A67  90 02                    bcc     ?z2
 7374  F85A69  A2 24                    ldx     #MAXDIGITS
 7375  F85A6B  74 50            ?z2:    stz     fpstr,x         ; truncate string
 7376  F85A6D  24 CF                    bit     fpaltf          ; check for a signed zero or not
 7377  F85A6F  50 02                    bvc     ?z3             ; standard signed zero
 7378  F85A71  64 4A                    stz     dsgn            ; force +0.0
 7379  F85A73  60               ?z3:    rts
 7380                           
 7381                           ; convert byte to 2 hex. digits
 7382                           ; return A=high digit, B=low digit
 7383  F85A74                   b2hex:
 7384  F85A74  48                       pha                     ; save value
 7385  F85A75  20 7E 5A                 jsr     ?hex
 7386  F85A78  EB                       xba                     ; B=low digit
 7387  F85A79  68                       pla                     ; restore value
 7388  F85A7A  4A                       lsr     a               ; divide by 16
 7389  F85A7B  4A                       lsr     a
 7390  F85A7C  4A                       lsr     a
 7391  F85A7D  4A                       lsr     a
 7392  F85A7E  29 0F            ?hex:   and     #$0F            ; mask nibble
 7393  F85A80  C9 0A                    cmp     #10
 7394  F85A82  90 02                    bcc     ?hex1
 7395  F85A84  65 3E                    adc     wftmp           ; add value for a..f/A..F
 7396  F85A86  69 30            ?hex1:  adc     #'0'
 7397  F85A88  60                       rts
 7398  F85A89                           
 7399                           
 7400                           ; fp2dec - convert the floating point fac to decimal ascii string
 7401                           ;
 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 significand
 7409                           ;               dexp = decimal exponent (2's complement)
 7410                           ;
 7411                           ;       If fac is not valid return either the string 'NAN' or 'INF' according
 7412                           ;       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 floating
 7419                           ;          point number, such that:
 7420                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page   84




 7421                           ;                                 N
 7422                           ;               |x| = d.ffff... 10      1<= d <=9, f=fractional part
 7423                           ;
 7424                           ;       o  scale |x| by a power of ten equal to M = 37 - N, such that:
 7425                           ;
 7426                           ;                         M                  N     37 - N                  37
 7427                           ;               y = x * 10   = d.ffff... * 10  * 10        = d.ffff... * 10
 7428                           ;
 7429                           ;          select 37 justified by the fact that the maximum decimal exponent
 7430                           ;          for a 128 bits number is 38.
 7431                           ;
 7432                           ;       o  this scaling give an y such that:
 7433                           ;
 7434                           ;                 37          38
 7435                           ;               10   <= y < 10   
 7436                           ;
 7437                           ;          and y can be regarded as 'integral' value with 38 significative digits
 7438                           ;          (first d digit, followed by 37 ffff... digits of the fractional part),
 7439                           ;          and can be converted to decimal string. The implicit decimal dot is
 7440                           ;          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     facsgn
 7448  F85A8B  64 24                    stz     facsgn          ; absolute fac
 7449  F85A8D  85 4A                    sta     dsgn            ; save sign of decimal float
 7450  F85A8F  64 48                    stz     dexp            ; clear decimal exponent
 7451  F85A91  64 49                    stz     dexp+1
 7452  F85A93  24 25                    bit     facst
 7453  F85A95  10 1B                    bpl     ?vf
 7454  F85A97                           ACC16
 7455  F85A97  C2 20                    rep     #PMFLAG
 7456                                   .LONGA  on
 7457                                   .MNLIST
 7458  F85A99  50 0A                    bvc     ?nan            ; fac=nan
 7459  F85A9B  A9 49 4E                 lda     #'NI'           ; fac=inf
 7460  F85A9E  85 50                    sta     fpstr
 7461  F85AA0  A9 46 00                 lda     #'F'            ; store 'INF'
 7462  F85AA3  80 08                    bra     ?end
 7463  F85AA5  A9 4E 41         ?nan:   lda     #'AN'
 7464  F85AA8  85 50                    sta     fpstr
 7465  F85AAA  A9 4E 00                 lda     #'N'            ; store 'NAN'
 7466  F85AAD  85 52            ?end:   sta     fpstr+2
 7467  F85AAF                           ACC08
 7468  F85AAF  E2 20                    sep     #PMFLAG
 7469                                   .LONGA  off
 7470                                   .MNLIST
 7471  F85AB1  60                       rts
 7472  F85AB2  50 0C            ?vf:    bvc     ?nz             ; fac <> 0
 7473  F85AB4  A9 30                    lda     #'0'
 7474  F85AB6  A2 25                    ldx     #37             ; store 38 digits '0'...
 7475  F85AB8  74 51                    stz     fpstr+1,x
 7476  F85ABA  95 50            ?z:     sta     fpstr,x
 7477  F85ABC  CA                       dex
  Tue Jul 17 11:00:18 2018                                                                                               Page   85




 7478  F85ABD  10 FB                    bpl     ?z
 7479  F85ABF  60                       rts                     ; ...and exit
 7480  F85AC0  A2 00            ?nz:    ldx     #0
 7481  F85AC2  A5 21                    lda     facm+15
 7482  F85AC4  30 09                    bmi     ?nf             ; normal float
 7483  F85AC6  A9 C5                    lda     #<fce64         ; pre-scale by 1e64 the subnormal float
 7484  F85AC8  A0 5F                    ldy     #>fce64
 7485  F85ACA  20 D5 49                 jsr     fcmult
 7486  F85ACD  A2 FF                    ldx     #$FF
 7487  F85ACF  86 10            ?nf:    stx     fsubnf          ; remember if we prescaled by 1e64
 7488  F85AD1  20 26 4D                 jsr     frndm           ; round mantissa to 113 bits
 7489  F85AD4                           
 7490                                   ; For a fast evaluation of the decimal exponent, we make a swift  
 7491                                   ; estimate of the log10 of the float, then check it later.
 7492                                   ; We can form the estimate by multiplying the binary exponent 
 7493                                   ; by a conversion factor Log10(2) with 16 bit accuracy, using
 7494                                   ; an integer signed multiplication 16x16 and taking the high
 7495                                   ; 16 bit of the result. The error is at most one digit up or
 7496                                   ; down.
 7497                           
 7498  F85AD4                           ACC16                   ; get an estimate of the decimal exponent
 7499  F85AD4  C2 20                    rep     #PMFLAG
 7500                                   .LONGA  on
 7501                                   .MNLIST
 7502  F85AD6  38                       sec
 7503  F85AD7  A5 22                    lda     facexp
 7504  F85AD9  E9 FF 3F                 sbc     #EBIAS
 7505  F85ADC  A2 10                    ldx     #<LOG2H         ; log(2)*$10000 (approximate to 16 bits)
 7506  F85ADE  A0 4D                    ldy     #>LOG2H
 7507  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     dexp
 7512  F85AEB                           ACC08
 7513  F85AEB  E2 20                    sep     #PMFLAG
 7514                                   .LONGA  off
 7515                                   .MNLIST
 7516  F85AED  20 2E 49                 jsr     scale10         ; scale fac by 37 - N
 7517  F85AF0                           
 7518                                   ; now check if we will divide by 10 or multiplies by 10 to get
 7519                                   ; the exact decimal exponent; should be: 1e37 <= fac < 1e38
 7520                           
 7521  F85AF0  A9 ED                    lda     #<fce38         ; now compare fac vs. 1e38
 7522  F85AF2  A0 5E                    ldy     #>fce38
 7523  F85AF4  20 5E 87                 jsr     fccmp           ; should be fac<1e38
 7524  F85AF7  30 0B                    bmi     ?tst            ; fac < 1e38, so go to check if fac>=1e37
 7525  F85AF9                           ACC16
 7526  F85AF9  C2 20                    rep     #PMFLAG
 7527                                   .LONGA  on
 7528                                   .MNLIST
 7529  F85AFB  E6 48                    inc     dexp            ; increment decimal exponent...
 7530  F85AFD                           ACC08                   ; ...because next division by 10
 7531  F85AFD  E2 20                    sep     #PMFLAG
 7532                                   .LONGA  off
 7533                                   .MNLIST
 7534  F85AFF  20 06 4A                 jsr     div10           ; fac=fac/10 so now fac<1e38
  Tue Jul 17 11:00:18 2018                                                                                               Page   86




 7535  F85B02  80 14                    bra     ?cvt            ; convert to decimal
 7536  F85B04  A9 DB            ?tst:   lda     #<fce37         ; now compare fac vs. 1e37
 7537  F85B06  A0 5E                    ldy     #>fce37
 7538  F85B08  20 5E 87                 jsr     fccmp
 7539  F85B0B  F0 0B                    beq     ?cvt            ; fac=1e37
 7540  F85B0D  10 09                    bpl     ?cvt            ; fac>1e37
 7541  F85B0F                           ACC16
 7542  F85B0F  C2 20                    rep     #PMFLAG
 7543                                   .LONGA  on
 7544                                   .MNLIST
 7545  F85B11  C6 48                    dec     dexp            ; decrement decimal exponent because...
 7546  F85B13                           ACC08
 7547  F85B13  E2 20                    sep     #PMFLAG
 7548                                   .LONGA  off
 7549                                   .MNLIST
 7550  F85B15  20 D1 49                 jsr     mult10          ; ...we mult x 10
 7551                           
 7552                                   ; now we have 1e37 <= fac < 1e38
 7553                                   ; note that we no round fac because we use all 128 bits mantissa
 7554                                   ; move fac mantissa (128 bits) to temporary mantissa tm
 7555  F85B18                   ?cvt:   ACC16
 7556  F85B18  C2 20                    rep     #PMFLAG
 7557                                   .LONGA  on
 7558                                   .MNLIST
 7559  F85B1A  A6 10                    ldx     fsubnf          ; we prescaled the float?
 7560  F85B1C  F0 08                    beq     ?cvt1           ; no
 7561  F85B1E  38                       sec
 7562  F85B1F  A5 48                    lda     dexp            ; adjust decimal exponent
 7563  F85B21  E9 40 00                 sbc     #64
 7564  F85B24  85 48                    sta     dexp
 7565  F85B26  A5 12            ?cvt1:  lda     facm            ; we use guard bits too in conversion
 7566  F85B28  85 00                    sta     tm
 7567  F85B2A  A5 14                    lda     facm+2
 7568  F85B2C  85 02                    sta     tm+2
 7569  F85B2E  A5 16                    lda     facm+4
 7570  F85B30  85 04                    sta     tm+4
 7571  F85B32  A5 18                    lda     facm+6
 7572  F85B34  85 06                    sta     tm+6
 7573  F85B36  A5 1A                    lda     facm+8
 7574  F85B38  85 08                    sta     tm+8
 7575  F85B3A  A5 1C                    lda     facm+10
 7576  F85B3C  85 0A                    sta     tm+10
 7577  F85B3E  A5 1E                    lda     facm+12
 7578  F85B40  85 0C                    sta     tm+12
 7579  F85B42  A5 20                    lda     facm+14
 7580  F85B44  85 0E                    sta     tm+14
 7581  F85B46  A5 22                    lda     facexp          ; get how many shift need to align tm...
 7582  F85B48  38                       sec                     ; ...to get the effective long integer
 7583  F85B49  E9 7E 40                 sbc     #EBIAS+MNTBITS-1
 7584  F85B4C                           ACC08                   ; negative or null, just 8 bits value
 7585  F85B4C  E2 20                    sep     #PMFLAG
 7586                                   .LONGA  off
 7587                                   .MNLIST
 7588  F85B4E  F0 05                    beq     ?cvt2           ; tm aligned, no shift
 7589  F85B50  A2 00                    ldx     #tm
 7590  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 digits
  Tue Jul 17 11:00:18 2018                                                                                               Page   87




 7592                           
 7593                                   ; first digit is always a leading '0', beacuse 1e37 <= fac < 1e38
 7594                                   ; max. integer is: 340282366920938463463374607431768211455 (> 1e38)
 7595  F85B58                           
 7596  F85B58  A2 00                    ldx     #0              ; we shift one digit to left (normalitation)
 7597  F85B5A  B5 51            ?sh:    lda     fpstr+1,x
 7598  F85B5C  95 50                    sta     fpstr,x
 7599  F85B5E  F0 03                    beq     ?done
 7600  F85B60  E8                       inx
 7601  F85B61  80 F7                    bra     ?sh
 7602  F85B63  60               ?done:  rts                     ; 38 digits + null terminator
 7603                           
 7604                           ; int2dec - convert a signed/unsigned 128 bits long integer to decimal ascii
 7605                           ;
 7606                           ;       entry:
 7607                           ;               facm..facm+15 = signed long integer
 7608                           ;
 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     dsgn
 7619  F85B66  A2 0F                    ldx     #15             ; move facm to tm
 7620  F85B68  B5 12            ?lp:    lda     facm,x
 7621  F85B6A  95 00                    sta     tm,x
 7622  F85B6C  CA                       dex
 7623  F85B6D  10 F9                    bpl     ?lp
 7624  F85B6F  24 25                    bit     facst
 7625  F85B71  10 28                    bpl     ui2dec          ; unsigned integer
 7626  F85B73  A5 0F                    lda     tm+15
 7627  F85B75  85 4A                    sta     dsgn            ; decimal sign
 7628  F85B77  10 22                    bpl     ui2dec          ; positive
 7629  F85B79                           ACC16
 7630  F85B79  C2 20                    rep     #PMFLAG
 7631                                   .LONGA  on
 7632                                   .MNLIST
 7633  F85B7B  A2 00                    ldx     #0
 7634  F85B7D  A0 08                    ldy     #8
 7635  F85B7F  38                       sec
 7636  F85B80  A9 00 00         ?lp2:   lda     #0              ; two's complement
 7637  F85B83  F5 00                    sbc     tm,x
 7638  F85B85  95 00                    sta     tm,x
 7639  F85B87  E8                       inx
 7640  F85B88  E8                       inx
 7641  F85B89  88                       dey
 7642  F85B8A  D0 F4                    bne     ?lp2
 7643  F85B8C                           ACC08
 7644  F85B8C  E2 20                    sep     #PMFLAG
 7645                                   .LONGA  off
 7646                                   .MNLIST
 7647  F85B8E  80 0B                    bra     ui2dec          ; negative
 7648                           
  Tue Jul 17 11:00:18 2018                                                                                               Page   88




 7649                           ; uint2dec - convert an unsigned 128 bits long integer to decimal ascii
 7650                           ;
 7651                           ;       entry:
 7652                           ;               facm..facm+15 = unsigned long integer
 7653                           ;
 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 tm
 7663  F85B92  B5 12            ?lp:    lda     facm,x
 7664  F85B94  95 00                    sta     tm,x
 7665  F85B96  CA                       dex
 7666  F85B97  10 F9                    bpl     ?lp
 7667  F85B99  64 4A                    stz     dsgn            ; clear decimal sign
 7668                           
 7669                           ; ui2dec - convert an unsigned 128 bits long integer to decimal ascii
 7670                           ;
 7671                           ;       entry:
 7672                           ;               tm..tm+15 = unsigned long integer
 7673                           ;
 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 dbr
 7685  F85B9C  4B                       phk
 7686  F85B9D  AB                       plb                     ; set current dbr=pbr
 7687  F85B9E  A2 00                    ldx     #0              ; index to decimal table
 7688  F85BA0  86 3F                    stx     wftmp+1         ; index to the destination ascii buffer
 7689  F85BA2  A0 80                    ldy     #$80            ; partial quotient (alternate positive/neg.)
 7690  F85BA4                   ?lp:    ACC16                   ; main loop
 7691  F85BA4  C2 20                    rep     #PMFLAG
 7692                                   .LONGA  on
 7693                                   .MNLIST
 7694  F85BA6  A5 00            ?sub:   lda     tm              ; repeated subtraction's
 7695  F85BA8  38                       sec
 7696  F85BA9  FD 6B 5C                 sbc     !dectbl0,x      ; low bytes 
 7697  F85BAC  85 00                    sta     tm
 7698  F85BAE  A5 02                    lda     tm+2
 7699  F85BB0  FD 6D 5C                 sbc     !dectbl0+2,x
 7700  F85BB3  85 02                    sta     tm+2
 7701  F85BB5  A5 04                    lda     tm+4
 7702  F85BB7  FD 07 5D                 sbc     !dectbl1,x
 7703  F85BBA  85 04                    sta     tm+4
 7704  F85BBC  A5 06                    lda     tm+6
 7705  F85BBE  FD 09 5D                 sbc     !dectbl1+2,x
  Tue Jul 17 11:00:18 2018                                                                                               Page   89




 7706  F85BC1  85 06                    sta     tm+6
 7707  F85BC3  A5 08                    lda     tm+8
 7708  F85BC5  FD A3 5D                 sbc     !dectbl2,x
 7709  F85BC8  85 08                    sta     tm+8
 7710  F85BCA  A5 0A                    lda     tm+10
 7711  F85BCC  FD A5 5D                 sbc     !dectbl2+2,x
 7712  F85BCF  85 0A                    sta     tm+10
 7713  F85BD1  A5 0C                    lda     tm+12
 7714  F85BD3  FD 3F 5E                 sbc     !dectbl3,x
 7715  F85BD6  85 0C                    sta     tm+12
 7716  F85BD8  A5 0E                    lda     tm+14
 7717  F85BDA  FD 41 5E                 sbc     !dectbl3+2,x
 7718  F85BDD  85 0E                    sta     tm+14           ; CF=0 if remainder is negative
 7719  F85BDF  C8                       iny                     ; increment partial quotient (N flag)
 7720  F85BE0  B0 04                    bcs     ?pr             ; remainder is positive
 7721  F85BE2  10 C2                    bpl     ?sub            ; neg. rem. & pos. quot.: repeat subtraction
 7722  F85BE4  30 02                    bmi     ?st             ; else store digit
 7723  F85BE6  30 BE            ?pr:    bmi     ?sub            ; pos. rem. & neg. quot.: repeat subtraction 
 7724                                                           ; else store digit
 7725  F85BE8                   ?st:    ACC08   
 7726  F85BE8  E2 20                    sep     #PMFLAG
 7727                                   .LONGA  off
 7728                                   .MNLIST
 7729  F85BEA  98                       tya
 7730  F85BEB  90 04                    bcc     ?nr             ; remainder is negative
 7731  F85BED  49 FF                    eor     #$FF            ; 10's complement of the quotient
 7732  F85BEF  69 0A                    adc     #10
 7733  F85BF1  69 2F            ?nr:    adc     #'0'-1           ; A is one more beacuse the 'iny'...
 7734  F85BF3  A8                       tay
 7735  F85BF4  86 3E                    stx     wftmp           ; save counter
 7736  F85BF6  A6 3F                    ldx     wftmp+1         ; current decimal string index
 7737  F85BF8  29 7F                    and     #$7F            ; strip off bit 7
 7738  F85BFA  95 50                    sta     fpstr,x         ; store digit
 7739  F85BFC  E8                       inx
 7740  F85BFD  86 3F                    stx     wftmp+1         ; update string index
 7741  F85BFF  98                       tya                     ; invert sign of the starting quotient
 7742  F85C00  49 FF                    eor     #$FF
 7743  F85C02  29 80                    and     #$80
 7744  F85C04  A8                       tay
 7745  F85C05  A5 3E                    lda     wftmp           ; update table index
 7746  F85C07  18                       clc
 7747  F85C08  69 04                    adc     #4
 7748  F85C0A  AA                       tax
 7749  F85C0B  E0 9C                    cpx     #DTBLSIZ
 7750  F85C0D  90 95                    bcc     ?lp             ; repeat until done
 7751  F85C0F  A6 3F                    ldx     wftmp+1         ; terminate decimal string...
 7752  F85C11  74 50                    stz     fpstr,x         ; ...with a null
 7753  F85C13  AB                       plb                     ; restore dbr
 7754  F85C14  60                       rts
 7755                           
 7756                           ; w2dec - convert an unsigned 16 bits integer to decimal ascii
 7757                           ;
 7758                           ;       entry:
 7759                           ;               C = unsigned 16 bits integer
 7760                           ;
 7761                           ;       exit:
 7762                           ;               fpstr = 5 bytes ascii decimal string (null terminated)
  Tue Jul 17 11:00:18 2018                                                                                               Page   90




 7763                           ;
 7764                           ; Note: this routine store leading not-significative digits '0'
 7765                           ;
 7766                           ;-----
 7767  F85C15                   w2dec:
 7768                           ;-----
 7769  F85C15  8B                       phb                     ; save dbr
 7770  F85C16  4B                       phk
 7771  F85C17  AB                       plb                     ; set current dbr=pbr
 7772  F85C18  A2 88                    ldx     #I16IDX         ; index to decimal table
 7773  F85C1A  64 3F                    stz     wftmp+1         ; decimal string index
 7774  F85C1C  A0 80                    ldy     #$80            ; partial quotient (alternate positive/neg.)
 7775  F85C1E                           ACC16
 7776  F85C1E  C2 20                    rep     #PMFLAG
 7777                                   .LONGA  on
 7778                                   .MNLIST
 7779  F85C20  85 00                    sta     tm              ; 16 bit value
 7780  F85C22  64 02                    stz     tm+2            ; sign extension
 7781  F85C24                   ?lp:    ACC16                   ; main loop
 7782  F85C24  C2 20                    rep     #PMFLAG
 7783                                   .LONGA  on
 7784                                   .MNLIST
 7785  F85C26  A5 00            ?sub:   lda     tm              ; repeated subtraction's
 7786  F85C28  38                       sec
 7787  F85C29  FD 6B 5C                 sbc     !dectbl0,x      ; low bytes 
 7788  F85C2C  85 00                    sta     tm
 7789  F85C2E  A5 02                    lda     tm+2
 7790  F85C30  FD 6D 5C                 sbc     !dectbl0+2,x
 7791  F85C33  85 02                    sta     tm+2            ; CF=0 if remainder is negative
 7792  F85C35  C8                       iny                     ; increment partial quotient
 7793  F85C36  B0 04                    bcs     ?pr             ; remainder is positive
 7794  F85C38  10 EC                    bpl     ?sub            ; neg. rem. & pos. quot.: repeat subtraction
 7795  F85C3A  30 02                    bmi     ?st             ; else store digit
 7796  F85C3C  30 E8            ?pr:    bmi     ?sub            ; pos. rem. & neg. quot.: repeat subtraction 
 7797                                                           ; else store digit
 7798  F85C3E                   ?st:    ACC08   
 7799  F85C3E  E2 20                    sep     #PMFLAG
 7800                                   .LONGA  off
 7801                                   .MNLIST
 7802  F85C40  98                       tya
 7803  F85C41  90 04                    bcc     ?nr             ; negative remainder
 7804  F85C43  49 FF                    eor     #$FF            ; complement
 7805  F85C45  69 0A                    adc     #10
 7806  F85C47  69 2F            ?nr:    adc     #'0'-1
 7807  F85C49  A8                       tay
 7808  F85C4A  86 3E                    stx     wftmp
 7809  F85C4C  A6 3F                    ldx     wftmp+1
 7810  F85C4E  29 7F                    and     #$7F
 7811  F85C50  95 50                    sta     fpstr,x
 7812  F85C52  E8                       inx
 7813  F85C53  86 3F                    stx     wftmp+1
 7814  F85C55  98                       tya
 7815  F85C56  49 FF                    eor     #$FF
 7816  F85C58  29 80                    and     #$80
 7817  F85C5A  A8                       tay
 7818  F85C5B  A5 3E                    lda     wftmp
 7819  F85C5D  18                       clc
  Tue Jul 17 11:00:18 2018                                                                                               Page   91




 7820  F85C5E  69 04                    adc     #4
 7821  F85C60  AA                       tax
 7822  F85C61  E0 9C                    cpx     #DTBLSIZ
 7823  F85C63  90 BF                    bcc     ?lp
 7824  F85C65  A6 3F                    ldx     wftmp+1
 7825  F85C67  74 50                    stz     fpstr,x
 7826  F85C69  AB                       plb
 7827  F85C6A  60                       rts
 7828                           
 7829                           ; table of decreasing powers of ten, from 1e38 down to 1e0, with
 7830                           ; alternating sign, used to convert 128 bits integer in decimal
 7831                           ; 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 31
 7834  F85C6B                   dectbl0:
 7835  F85C6B  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E38
 7836  F85C6F  00 00 00 00              .DB     $00,$00,$00,$00         ; -1E37
 7837  F85C73  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E36
 7838  F85C77  00 00 00 00              .DB     $00,$00,$00,$00         ; -1E35
 7839  F85C7B  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E34
 7840  F85C7F  00 00 00 00              .DB     $00,$00,$00,$00         ; -1E33
 7841  F85C83  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E32
 7842  F85C87  00 00 00 80              .DB     $00,$00,$00,$80         ; -1E31
 7843  F85C8B  00 00 00 40              .DB     $00,$00,$00,$40         ; +1E30
 7844  F85C8F  00 00 00 60              .DB     $00,$00,$00,$60         ; -1E29
 7845  F85C93  00 00 00 10              .DB     $00,$00,$00,$10         ; +1E28
 7846  F85C97  00 00 00 18              .DB     $00,$00,$00,$18         ; -1E27
 7847  F85C9B  00 00 00 E4              .DB     $00,$00,$00,$E4         ; +1E26
 7848  F85C9F  00 00 00 B6              .DB     $00,$00,$00,$B6         ; -1E25
 7849  F85CA3  00 00 00 A1              .DB     $00,$00,$00,$A1         ; +1E24
 7850  F85CA7  00 00 80 09              .DB     $00,$00,$80,$09         ; -1E23
 7851  F85CAB  00 00 40 B2              .DB     $00,$00,$40,$B2         ; +1E22
 7852  F85CAF  00 00 60 21              .DB     $00,$00,$60,$21         ; -1E21
 7853  F85CB3  00 00 10 63              .DB     $00,$00,$10,$63         ; +1E20
 7854  F85CB7  00 00 18 76              .DB     $00,$00,$18,$76         ; -1E19
 7855  F85CBB  00 00 64 A7              .DB     $00,$00,$64,$A7         ; +1E18
 7856  F85CBF  00 00 76 A2              .DB     $00,$00,$76,$A2         ; -1E17
 7857  F85CC3  00 00 C1 6F              .DB     $00,$00,$C1,$6F         ; +1E16
 7858  F85CC7  00 80 39 5B              .DB     $00,$80,$39,$5B         ; -1E15
 7859  F85CCB  00 40 7A 10              .DB     $00,$40,$7A,$10         ; +1E14
 7860  F85CCF  00 60 8D B1              .DB     $00,$60,$8D,$B1         ; -1E13
 7861  F85CD3  00 10 A5 D4              .DB     $00,$10,$A5,$D4         ; +1E12
 7862  F85CD7  00 18 89 B7              .DB     $00,$18,$89,$B7         ; -1E11
 7863  F85CDB  00 E4 0B 54              .DB     $00,$E4,$0B,$54         ; +1E10
 7864  F85CDF  00 36 65 C4              .DB     $00,$36,$65,$C4         ; -1E09
 7865  F85CE3  00 E1 F5 05              .DB     $00,$E1,$F5,$05         ; +1E08
 7866  F85CE7  80 69 67 FF              .DB     $80,$69,$67,$FF         ; -1E07
 7867  F85CEB  40 42 0F 00              .DB     $40,$42,$0F,$00         ; +1E06
 7868  F85CEF  60 79 FE FF              .DB     $60,$79,$FE,$FF         ; -1E05
 7869  F85CF3  10 27 00 00              .DB     $10,$27,$00,$00         ; +1E04
 7870  F85CF7  18 FC FF FF              .DB     $18,$FC,$FF,$FF         ; -1E03
 7871  F85CFB  64 00 00 00              .DB     $64,$00,$00,$00         ; +1E02
 7872  F85CFF  F6 FF FF FF              .DB     $F6,$FF,$FF,$FF         ; -1E01
 7873  F85D03  01 00 00 00              .DB     $01,$00,$00,$00         ; +1E00
 7874                           
 7875                           ; bits from 32 to 63
 7876  F85D07                   dectbl1:
  Tue Jul 17 11:00:18 2018                                                                                               Page   92




 7877  F85D07  40 22 8A 09              .DB     $40,$22,$8A,$09         ; +1E38
 7878  F85D0B  60 C9 0B FF              .DB     $60,$C9,$0B,$FF         ; -1E37
 7879  F85D0F  10 9F 4B B3              .DB     $10,$9F,$4B,$B3         ; +1E36
 7880  F85D13  18 70 78 D4              .DB     $18,$70,$78,$D4         ; -1E35
 7881  F85D17  64 8E 8D 37              .DB     $64,$8E,$8D,$37         ; +1E34
 7882  F85D1B  F6 A4 3E C7              .DB     $F6,$A4,$3E,$C7         ; -1E33
 7883  F85D1F  81 EF AC 85              .DB     $81,$EF,$AC,$85         ; +1E32
 7884  F85D23  D9 B4 6E 3F              .DB     $D9,$B4,$6E,$3F         ; -1E31
 7885  F85D27  EA ED 74 46              .DB     $EA,$ED,$74,$46         ; +1E30
 7886  F85D2B  35 E8 8D 92              .DB     $35,$E8,$8D,$92         ; -1E29
 7887  F85D2F  61 02 25 3E              .DB     $61,$02,$25,$3E         ; +1E28
 7888  F85D33  C3 7F 2F 60              .DB     $C3,$7F,$2F,$60         ; -1E27
 7889  F85D37  D2 0C C8 DC              .DB     $D2,$0C,$C8,$DC         ; +1E26
 7890  F85D3B  B7 FE EB E9              .DB     $B7,$FE,$EB,$E9         ; -1E25
 7891  F85D3F  ED CC CE 1B              .DB     $ED,$CC,$CE,$1B         ; +1E24
 7892  F85D43  B5 1E 38 FD              .DB     $B5,$1E,$38,$FD         ; -1E23
 7893  F85D47  BA C9 E0 19              .DB     $BA,$C9,$E0,$19         ; +1E22
 7894  F85D4B  3A 52 36 CA              .DB     $3A,$52,$36,$CA         ; -1E21
 7895  F85D4F  2D 5E C7 6B              .DB     $2D,$5E,$C7,$6B         ; +1E20
 7896  F85D53  FB DC 38 75              .DB     $FB,$DC,$38,$75         ; -1E19
 7897  F85D57  B3 B6 E0 0D              .DB     $B3,$B6,$E0,$0D         ; +1E18
 7898  F85D5B  87 BA 9C FE              .DB     $87,$BA,$9C,$FE         ; -1E17
 7899  F85D5F  F2 86 23 00              .DB     $F2,$86,$23,$00         ; +1E16
 7900  F85D63  81 72 FC FF              .DB     $81,$72,$FC,$FF         ; -1E15
 7901  F85D67  F3 5A 00 00              .DB     $F3,$5A,$00,$00         ; +1E14
 7902  F85D6B  E7 F6 FF FF              .DB     $E7,$F6,$FF,$FF         ; -1E13
 7903  F85D6F  E8 00 00 00              .DB     $E8,$00,$00,$00         ; +1E12
 7904  F85D73  E8 FF FF FF              .DB     $E8,$FF,$FF,$FF         ; -1E11
 7905  F85D77  02 00 00 00              .DB     $02,$00,$00,$00         ; +1E10
 7906  F85D7B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E09
 7907  F85D7F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E08
 7908  F85D83  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E07
 7909  F85D87  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E06
 7910  F85D8B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E05
 7911  F85D8F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E04
 7912  F85D93  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E03
 7913  F85D97  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E02
 7914  F85D9B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E01
 7915  F85D9F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E00
 7916                           
 7917                           ; bits from 64 to 95
 7918  F85DA3                   dectbl2:
 7919  F85DA3  7A C4 86 5A              .DB     $7A,$C4,$86,$5A         ; +1E38
 7920  F85DA7  26 B9 25 2A              .DB     $26,$B9,$25,$2A         ; -1E37
 7921  F85DAB  15 07 C9 7B              .DB     $15,$07,$C9,$7B         ; +1E36
 7922  F85DAF  7D B2 38 8D              .DB     $7D,$B2,$38,$8D         ; -1E35
 7923  F85DB3  C0 87 AD BE              .DB     $C0,$87,$AD,$BE         ; +1E34
 7924  F85DB7  6C 72 BB 39              .DB     $6C,$72,$BB,$39         ; -1E33
 7925  F85DBB  5B 41 6D 2D              .DB     $5B,$41,$6D,$2D         ; +1E32
 7926  F85DBF  DD DF 41 C8              .DB     $DD,$DF,$41,$C8         ; -1E31
 7927  F85DC3  D0 9C 2C 9F              .DB     $D0,$9C,$2C,$9F         ; +1E30
 7928  F85DC7  51 F0 E1 BC              .DB     $51,$F0,$E1,$BC         ; -1E29
 7929  F85DCB  5E CE 4F 20              .DB     $5E,$CE,$4F,$20         ; +1E28
 7930  F85DCF  C3 D1 C4 FC              .DB     $C3,$D1,$C4,$FC         ; -1E27
 7931  F85DD3  D2 B7 52 00              .DB     $D2,$B7,$52,$00         ; +1E26
 7932  F85DD7  6A BA F7 FF              .DB     $6A,$BA,$F7,$FF         ; -1E25
 7933  F85DDB  C2 D3 00 00              .DB     $C2,$D3,$00,$00         ; +1E24
  Tue Jul 17 11:00:18 2018                                                                                               Page   93




 7934  F85DDF  D2 EA FF FF              .DB     $D2,$EA,$FF,$FF         ; -1E23
 7935  F85DE3  1E 02 00 00              .DB     $1E,$02,$00,$00         ; +1E22
 7936  F85DE7  C9 FF FF FF              .DB     $C9,$FF,$FF,$FF         ; -1E21
 7937  F85DEB  05 00 00 00              .DB     $05,$00,$00,$00         ; +1E20
 7938  F85DEF  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E19
 7939  F85DF3  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E18
 7940  F85DF7  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E17
 7941  F85DFB  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E16
 7942  F85DFF  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E15
 7943  F85E03  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E14
 7944  F85E07  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E13
 7945  F85E0B  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E12
 7946  F85E0F  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E11
 7947  F85E13  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E10
 7948  F85E17  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E09
 7949  F85E1B  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E08
 7950  F85E1F  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E07
 7951  F85E23  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E06
 7952  F85E27  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E05
 7953  F85E2B  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E04
 7954  F85E2F  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E03
 7955  F85E33  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E02
 7956  F85E37  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E01
 7957  F85E3B  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E00
 7958                           
 7959                           ; bits from 96 to 127
 7960  F85E3F                   dectbl3:
 7961  F85E3F  A8 4C 3B 4B              .DB     $A8,$4C,$3B,$4B         ; +1E38
 7962  F85E43  EF 11 7A F8              .DB     $EF,$11,$7A,$F8         ; -1E37
 7963  F85E47  CE 97 C0 00              .DB     $CE,$97,$C0,$00         ; +1E36
 7964  F85E4B  9E BD EC FF              .DB     $9E,$BD,$EC,$FF         ; -1E35
 7965  F85E4F  09 ED 01 00              .DB     $09,$ED,$01,$00         ; +1E34
 7966  F85E53  B2 CE FF FF              .DB     $B2,$CE,$FF,$FF         ; -1E33
 7967  F85E57  EE 04 00 00              .DB     $EE,$04,$00,$00         ; +1E32
 7968  F85E5B  81 FF FF FF              .DB     $81,$FF,$FF,$FF         ; -1E31
 7969  F85E5F  0C 00 00 00              .DB     $0C,$00,$00,$00         ; +1E30
 7970  F85E63  FE FF FF FF              .DB     $FE,$FF,$FF,$FF         ; -1E29
 7971  F85E67  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E28
 7972  F85E6B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E27
 7973  F85E6F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E26
 7974  F85E73  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E25
 7975  F85E77  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E24
 7976  F85E7B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E23
 7977  F85E7F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E22
 7978  F85E83  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E21
 7979  F85E87  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E20
 7980  F85E8B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E19
 7981  F85E8F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E18
 7982  F85E93  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E17
 7983  F85E97  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E16
 7984  F85E9B  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E15
 7985  F85E9F  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E14
 7986  F85EA3  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E13
 7987  F85EA7  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E12
 7988  F85EAB  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E11
 7989  F85EAF  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E10
 7990  F85EB3  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E09
  Tue Jul 17 11:00:18 2018                                                                                               Page   94




 7991  F85EB7  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E08
 7992  F85EBB  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E07
 7993  F85EBF  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E06
 7994  F85EC3  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E05
 7995                           
 7996                           ; this portion is used by routine that convert 16 bits integer to decimal
 7997  F85EC7                   dec1e4:
 7998  F85EC7  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E04
 7999  F85ECB  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E03
 8000  F85ECF  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E02
 8001  F85ED3  FF FF FF FF              .DB     $FF,$FF,$FF,$FF         ; -1E01
 8002  F85ED7  00 00 00 00              .DB     $00,$00,$00,$00         ; +1E00
 8003                           
 8004          00009C           DTBLSIZ .EQU    $-dectbl3
 8005          000088           I16IDX  .EQU    dec1e4-dectbl3
 8006                           
 8007                           ; limits for conversion float-to-decimal
 8008  F85EDB  00 00 00 00 00   fce37:  .DB     $00,$00,$00,$00,$00,$D4,$86,$1E,$20
               D4 86 1E 20 
 8009  F85EE4  DB 48 BB 1A C2           .DB     $DB,$48,$BB,$1A,$C2,$BD,$F0,$79,$40     ; 1e37
               BD F0 79 40 
 8010  F85EED                           
 8011  F85EED  00 00 00 00 80   fce38:  .DB     $00,$00,$00,$00,$80,$44,$14,$13,$F4
               44 14 13 F4 
 8012  F85EF6  88 0D B5 50 99           .DB     $88,$0D,$B5,$50,$99,$76,$96,$7D,$40     ; 1e38
               76 96 7D 40 
 8013                           
 8014                           ; 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,$00
               00 00 00 00 
 8017  F85F08  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$80,$FF,$3F     ; 1
               00 80 FF 3F 
 8018  F85F11  00 00 00 00 00   fce1:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8019  F85F1A  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$A0,$02,$40     ; 10
               00 A0 02 40 
 8020  F85F23  00 00 00 00 00   fce2:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8021  F85F2C  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$C8,$05,$40     ; 100
               00 C8 05 40 
 8022  F85F35  00 00 00 00 00   fce3:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8023  F85F3E  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$FA,$08,$40     ; 1E3
               00 FA 08 40 
 8024  F85F47  00 00 00 00 00   fce4:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8025  F85F50  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$40,$9C,$0C,$40     ; 1E4
               40 9C 0C 40 
 8026  F85F59  00 00 00 00 00   fce5:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8027  F85F62  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$50,$C3,$0F,$40     ; 1E5
               50 C3 0F 40 
 8028  F85F6B  00 00 00 00 00   fce6:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8029  F85F74  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$24,$F4,$12,$40     ; 1E6
               24 F4 12 40 
  Tue Jul 17 11:00:18 2018                                                                                               Page   95




 8030  F85F7D  00 00 00 00 00   fce7:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8031  F85F86  00 00 00 00 80           .DB     $00,$00,$00,$00,$80,$96,$98,$16,$40     ; 1E7
               96 98 16 40 
 8032                           
 8033  F85F8F  00 00 00 00 00   fce8:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8034  F85F98  00 00 00 00 20           .DB     $00,$00,$00,$00,$20,$BC,$BE,$19,$40     ; 1E8
               BC BE 19 40 
 8035                           
 8036  F85FA1  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8037  F85FAA  00 00 04 BF C9           .DB     $00,$00,$04,$BF,$C9,$1B,$8E,$34,$40     ; 1E16
               1B 8E 34 40 
 8038                           
 8039  F85FB3  00 00 00 00 00   fce32:  .DB     $00,$00,$00,$00,$00,$00,$20,$F0,$9D
               00 20 F0 9D 
 8040  F85FBC  B5 70 2B A8 AD           .DB     $B5,$70,$2B,$A8,$AD,$C5,$9D,$69,$40     ; 1E32
               C5 9D 69 40 
 8041                           
 8042  F85FC5  FA 25 6B C7 71   fce64:  .DB     $FA,$25,$6B,$C7,$71,$6B,$BF,$3C,$D5
               6B BF 3C D5 
 8043  F85FCE  A6 CF FF 49 1F           .DB     $A6,$CF,$FF,$49,$1F,$78,$C2,$D3,$40     ; 1E64
               78 C2 D3 40 
 8044                           
 8045  F85FD7  35 01 B1 36 6C           .DB     $35,$01,$B1,$36,$6C,$33,$6F,$C6,$DF
               33 6F C6 DF 
 8046  F85FE0  8C E9 80 C9 47           .DB     $8C,$E9,$80,$C9,$47,$BA,$93,$A8,$41     ; 1E128
               BA 93 A8 41 
 8047                           
 8048  F85FE9  B2 EA FE 98 1B           .DB     $B2,$EA,$FE,$98,$1B,$90,$BB,$DD,$8D
               90 BB DD 8D 
 8049  F85FF2  DE F9 9D FB EB           .DB     $DE,$F9,$9D,$FB,$EB,$7E,$AA,$51,$43     ; 1E256
               7E AA 51 43 
 8050  F85FFB                           
 8051  F85FFB  E8 58 50 BC 54           .DB     $E8,$58,$50,$BC,$54,$5C,$65,$CC,$C6
               5C 65 CC C6 
 8052  F86004  91 0E A6 AE A0           .DB     $91,$0E,$A6,$AE,$A0,$19,$E3,$A3,$46     ; 1E512
               19 E3 A3 46 
 8053                           
 8054  F8600D  B0 50 8B F1 28           .DB     $B0,$50,$8B,$F1,$28,$3D,$0D,$65,$17
               3D 0D 65 17 
 8055  F86016  0C 75 81 86 75           .DB     $0C,$75,$81,$86,$75,$76,$C9,$48,$4D     ; 1E1024
               76 C9 48 4D 
 8056                           
 8057  F8601F  22 CE 9A 32 CE           .DB     $22,$CE,$9A,$32,$CE,$28,$4D,$A7,$E4
               28 4D A7 E4 
 8058  F86028  5D 3D C5 5D 3B           .DB     $5D,$3D,$C5,$5D,$3B,$8B,$9E,$92,$5A     ; 1E2048
               8B 9E 92 5A 
 8059                           
 8060  F86031                   fce4096:
 8061  F86031  1A 4A 4A 80 3F           .DB     $1A,$4A,$4A,$80,$3F,$15,$4C,$C9,$9A
               15 4C C9 9A 
 8062  F8603A  97 20 8A 02 52           .DB     $97,$20,$8A,$02,$52,$60,$C4,$25,$75     ; 1E4096
               60 C4 25 75 
 8063                           
 8064          000012           FCSIZ   .EQU    $-fce4096
  Tue Jul 17 11:00:18 2018                                                                                               Page   96




 8065                           
 8066                           ; constants address used by scxale10 routine
 8067  F86043                   fcaddr: 
 8068  F86043  FF5E 115F 235F           .DW     fce0, fce1, fce2, fce3, fce4, fce5, fce6, fce7
               355F 475F 595F 
               6B5F 7D5F 
 8069                           
 8070                           ;----------------------------------------------------------------------------
 8071                           ; square root & cube root
 8072                           ;----------------------------------------------------------------------------
 8073  F86053                           
 8074                           ; fsqrt - return the square root of the argument
 8075                           ;
 8076                           ;       entry:
 8077                           ;               fac = x
 8078                           ;
 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 the
 8085                           ;       argument and using a rational approximation to obtain
 8086                           ;       a rough value for the square root;  then Heron's (Newton) iteration
 8087                           ;       is used four times to converge to an accurate value.
 8088                           ;
 8089                           ;       1) range reduction is accomplished by separating the argument x
 8090                           ;          into an integer M and fraction z such that:
 8091                           ;
 8092                           ;                        2*M
 8093                           ;               x = z * 2       with: 0.25 <= z < 1
 8094                           ;
 8095                           ;       2) obtain a rough value w for the square root of z by a
 8096                           ;          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 = 3
 8103                           ;
 8104                           ;       4) finally, the square root of the x is obtained scaling back y:
 8105                           ;
 8106                           ;                                    M        M
 8107                           ;               sqrt(x) = sqrt(z) * 2  = y * 2 
 8108                           ;
 8109                           ;       computation mean time: 30ms at 4MHz
 8110                           ;
 8111                           ;-----
 8112  F86053                   fsqrt:
 8113                           ;-----
 8114  F86053  24 25                    bit     facst           ; fac is valid?
 8115  F86055  10 0B                    bpl     ?fv             ; yes
 8116  F86057  70 07                    bvs     ?er             ; fac=nan so return nan
 8117  F86059  24 24                    bit     facsgn          ; fac=inf so check sign
 8118  F8605B  10 03                    bpl     ?er             ; fac=+inf so return +inf
 8119  F8605D  4C 74 4E         ?nan:   jmp     fldnan          ; fac=-inf so return nan
  Tue Jul 17 11:00:18 2018                                                                                               Page   97




 8120  F86060  38               ?er:    sec
 8121  F86061  60                       rts
 8122  F86062  50 04            ?fv:    bvc     ?xp             ; fac is not zero
 8123  F86064  64 24                    stz     facsgn          ; fac=+/-0 return always +0
 8124  F86066  18                       clc
 8125  F86067  60                       rts
 8126  F86068  24 24            ?xp:    bit     facsgn          ; check if fac>0
 8127  F8606A  30 F1                    bmi     ?nan            ; fac<0 so return nan
 8128  F8606C  20 6E 48                 jsr     frexp           ; reduce argument to range [0.5,1)
 8129  F8606F                           CPU16
 8130  F8606F  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 8131                                   .LONGA  on
 8132                                   .LONGI  on
 8133                                   .MNLIST
 8134  F86071  A5 46                    lda     scexp           ; the true 2 exponent
 8135  F86073  AA                       tax
 8136  F86074  4A                       lsr     a               ; CF=0 if exponent is divisible by 2
 8137  F86075  8A                       txa                     ; C=exponent
 8138  F86076  90 03                    bcc     ?sgn            ; divisible by 2
 8139  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 sign
 8142  F8607C  90 01                    bcc     ?sgn2           ; positive
 8143  F8607E  1A                       inc     a               ; negative: put sign in bit 0
 8144  F8607F  6A               ?sgn2:  ror     a               ; restore exponent
 8145  F86080  6A                       ror     a               ; divide by 2 with sign extension
 8146  F86081  85 46                    sta     scexp           ; scexp = M, fac = z
 8147  F86083                           CPU08
 8148  F86083  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 8149                                   .LONGA  off
 8150                                   .LONGI  off
 8151                                   .MNLIST
 8152  F86085                           
 8153                                   ; 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 = z
 8156  F86088  20 67 45                 jsr     faddhalf        ; z + D (D=0.5) 
 8157  F8608B  A9 D0                    lda     #<sqc           ; C
 8158  F8608D  A0 61                    ldy     #>sqc
 8159  F8608F  20 01 4A                 jsr     fcdiv           ; C/(z + D)
 8160  F86092  A9 BE                    lda     #<sqb           ; B
 8161  F86094  A0 61                    ldy     #>sqb
 8162  F86096  20 5C 45                 jsr     fcsub           ; B - C/(z + D)
 8163  F86099  20 93 84                 jsr     mvf_t1
 8164  F8609C  20 47 85                 jsr     mvt0_f          ; z
 8165  F8609F  A9 AC                    lda     #<sqa           ; A
 8166  F860A1  A0 61                    ldy     #>sqa
 8167  F860A3  20 D5 49                 jsr     fcmult          ; A*z
 8168  F860A6  20 FB 85                 jsr     mvt1_a
 8169  F860A9  20 7D 45                 jsr     fpadd           ; A*z + B - C/(z + D)
 8170                           
 8171                                   ; Hero's iteration four times   
 8172  F860AC  20 BB 60                 jsr     ?nit
 8173  F860AF  20 BB 60                 jsr     ?nit
 8174  F860B2  20 BB 60                 jsr     ?nit
 8175  F860B5  20 BB 60                 jsr     ?nit            ; fac=sqrt(z)
 8176                           
  Tue Jul 17 11:00:18 2018                                                                                               Page   98




 8177  F860B8  4C B7 48                 jmp     fscale          ; fac=sqrt(z)*(2^M)=sqrt(x)
 8178                           
 8179                                   ; newton iteration for sqrt
 8180                                   ; y[n+1] = 0.5*(y[n] + z/y[n])
 8181                                   ; where y[0]=w is the initial seed value
 8182                                   ; note that is safe, when fac is normal and limited,
 8183                                   ; to multiplies by 2 simply incrementing the exponent
 8184  F860BB  20 93 84         ?nit:   jsr     mvf_t1          ; tfr1 = y[n]
 8185  F860BE  20 CE 85                 jsr     mvt0_a          ; arg = z
 8186  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                           ACC16
 8190  F860CA  C2 20                    rep     #PMFLAG
 8191                                   .LONGA  on
 8192                                   .MNLIST
 8193  F860CC  C6 22                    dec     facexp          ; y[n+1] = 0.5*(y[n] + z/y[n])
 8194  F860CE                           ACC08
 8195  F860CE  E2 20                    sep     #PMFLAG
 8196                                   .LONGA  off
 8197                                   .MNLIST
 8198  F860D0  60                       rts
 8199                           
 8200                           ; fcbrt - return the cube root of the argument
 8201                           ;
 8202                           ;       entry:
 8203                           ;               fac = x
 8204                           ;
 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 the
 8211                           ;       argument and using a rational approximation to obtain
 8212                           ;       a rough value for the cube root;  then one Newton iteration followed
 8213                           ;       by one Halley iteration is used to converge to an accurate value.
 8214                           ;
 8215                           ;       1) range reduction is accomplished by separating the argument x
 8216                           ;          into an integer M and fraction z such that:
 8217                           ;
 8218                           ;                        3*M
 8219                           ;               x = z * 2       with: 0.125 <= z < 1
 8220                           ;
 8221                           ;       2) obtain a rough value w for the square root of z by a
 8222                           ;          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   99




 8234                           ;       5) finally, the cube root of the x is obtained scaling back y:
 8235                           ;
 8236                           ;                                    M        M
 8237                           ;               cbrt(x) = cbrt(z) * 2  = y * 2 
 8238                           ;
 8239                           ;       computation mean time: 75/80ms at 4MHz
 8240                           ;
 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 zero
 8247  F860D7  18                       clc                     ; return fac=0
 8248  F860D8  60                       rts
 8249  F860D9  38               ?er:    sec
 8250  F860DA  60                       rts
 8251  F860DB  A5 24            ?ok:    lda     facsgn          ; save fac sign...
 8252  F860DD  85 4A                    sta     dsgn
 8253  F860DF  64 24                    stz     facsgn          ; ...and work with absolute value
 8254  F860E1  20 6E 48                 jsr     frexp           ; reduce argument to range [0.5,1)
 8255  F860E4                           CPU16
 8256  F860E4  C2 30                    rep     #(PMFLAG.OR.PXFLAG)
 8257                                   .LONGA  on
 8258                                   .LONGI  on
 8259                                   .MNLIST
 8260  F860E6  A2 03 00                 ldx     #3
 8261  F860E9  A5 48                    lda     dexp            ; absolute value of the exponent
 8262  F860EB  20 11 88                 jsr     udiv            ; C=quotient, Y=remainder (unsigned)
 8263  F860EE  BB                       tyx
 8264  F860EF  F0 2B                    beq     ?go             ; remainder=0, exponent is divisible by 3
 8265  F860F1  98                       tya                     ; C=remainder   
 8266  F860F2  A4 46                    ldy     scexp           ; check exponent sign
 8267  F860F4  30 06                    bmi     ?ne             ; handle negative exponent
 8268  F860F6  38                       sec                     ; C=remainder, compute remainder such that...
 8269  F860F7  E9 03 00                 sbc     #3              ; ...(exponent-C) is divisible by 3
 8270  F860FA  80 04                    bra     ?ne2
 8271  F860FC  49 FF FF         ?ne:    eor     #$FFFF          ; exponent is negative...
 8272  F860FF  1A                       inc     a               ; ...so change sign to remainder
 8273  F86100  85 3E            ?ne2:   sta     wftmp           ; save for later use    
 8274  F86102  18                       clc
 8275  F86103  65 22                    adc     facexp          ; reduce argument to range [0.125,1)
 8276  F86105  85 22                    sta     facexp
 8277  F86107  38                       sec
 8278  F86108  A5 46                    lda     scexp           ; find the new exponent after reduction
 8279  F8610A  E5 3E                    sbc     wftmp
 8280  F8610C  F0 16                    beq     ?go2            ; exponent=0
 8281  F8610E  85 46                    sta     scexp
 8282  F86110  10 04                    bpl     ?pe
 8283  F86112  49 FF FF                 eor     #$FFFF
 8284  F86115  1A                       inc     a
 8285  F86116  A2 03 00         ?pe:    ldx     #3              ; now exponent is divisible by 3
 8286  F86119  20 11 88                 jsr     udiv            ; C=new exponent        
 8287  F8611C  A6 46            ?go:    ldx     scexp           ; change sign if negative
 8288  F8611E  10 04                    bpl     ?go2
 8289  F86120  49 FF FF                 eor     #$FFFF
 8290  F86123  1A                       inc     a
  Tue Jul 17 11:00:18 2018                                                                                               Page  100




 8291  F86124  85 46            ?go2:   sta     scexp           ; scexp=M=exponent of cube root
 8292  F86126                           CPU08                   ; fac=z, range: [1/8, 1)
 8293  F86126  E2 30                    sep     #(PMFLAG.OR.PXFLAG)
 8294                                   .LONGA  off
 8295                                   .LONGI  off
 8296                                   .MNLIST
 8297                           
 8298                                   ; 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 = z              
 8301  F8612B  A9 F4                    lda     #<cbrn          ; evaluate numerator
 8302  F8612D  A0 61                    ldy     #>cbrn
 8303  F8612F  A2 04                    ldx     #4              ; degree=4
 8304  F86131  20 1C 87                 jsr     peval
 8305  F86134  20 93 84                 jsr     mvf_t1          ; tfr1=N(z)
 8306  F86137  A9 4E                    lda     #<cbrd          ; evaluate denominator
 8307  F86139  A0 62                    ldy     #>cbrd
 8308  F8613B  A2 04                    ldx     #4              ; degree=4
 8309  F8613D  20 1C 87                 jsr     peval
 8310  F86140  20 FB 85                 jsr     mvt1_a          ; arg=N(z)
 8311  F86143  20 10 4A                 jsr     fpdiv           ; w=N(z)/D(z)
 8312                           
 8313  F86146  20 54 61                 jsr     ?nit            ; Newton's iteration (evaluate p) 
 8314  F86149  20 73 61                 jsr     ?hit            ; Halley's iteration (evaluate y)
 8315  F8614C                           
 8316  F8614C  20 B7 48                 jsr     fscale          ; fac=cbrtt(z)*(2^M)=sqrt(x)
 8317  F8614F  A5 4A                    lda     dsgn            ; restore original argument sign
 8318  F86151  85 24                    sta     facsgn
 8319  F86153  60                       rts
 8320  F86154                           
 8321                           ?nit:   ; Newton's iteration
 8322                                   ; 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*w
 8325  F8615A  20 CE 85                 jsr     mvt0_a          ; arg=z
 8326  F8615D  20 10 4A                 jsr     fpdiv           ; z/(w*w)
 8327  F86160  20 FB 85                 jsr     mvt1_a          ; arg=w
 8328  F86163                           ACC16                   ; is safe here simply increment exponent
 8329  F86163  C2 20                    rep     #PMFLAG
 8330                                   .LONGA  on
 8331                                   .MNLIST
 8332  F86165  E6 3A                    inc     argexp          ; arg=2*w
 8333  F86167                           ACC08
 8334  F86167  E2 20                    sep     #PMFLAG
 8335                                   .LONGA  off
 8336                                   .MNLIST
 8337  F86169  20 7D 45                 jsr     fpadd           ; 2*w + z/(w*w)
 8338  F8616C  A9 E2                    lda     #<c13           ; 1/3
 8339  F8616E  A0 61                    ldy     #>c13
 8340  F86170  4C D5 49                 jmp     fcmult          ; p = (1/3)*((x/(w*w)) + 2*w)
 8341                           
 8342                           ?hit:   ; Halley's iteration
 8343                                   ; y = p*((p*p*p+2*z)/(2*p*p*p+z))
 8344  F86173  20 93 84                 jsr     mvf_t1          ; tfr1=p
 8345  F86176  20 CC 49                 jsr     fsquare         ; p*p
 8346  F86179  20 FB 85                 jsr     mvt1_a
 8347  F8617C  20 DD 49                 jsr     fpmult          ; p*p*p
  Tue Jul 17 11:00:18 2018                                                                                               Page  101




 8348  F8617F  20 C0 84                 jsr     mvf_t2          ; tfr2=p*p*p
 8349  F86182  20 CE 85                 jsr     mvt0_a          ; z
 8350  F86185                           ACC16                   ; is safe here simply increment exponent
 8351  F86185  C2 20                    rep     #PMFLAG
 8352                                   .LONGA  on
 8353                                   .MNLIST
 8354  F86187  E6 3A                    inc     argexp          ; 2*z
 8355  F86189                           ACC08
 8356  F86189  E2 20                    sep     #PMFLAG
 8357                                   .LONGA  off
 8358                                   .MNLIST
 8359  F8618B  20 7D 45                 jsr     fpadd
 8360  F8618E  20 ED 84                 jsr     mvf_t3          ; tfr3=p*p*p+2*X
 8361  F86191  20 28 86                 jsr     mvt2_a          ; p*p*p
 8362  F86194                           ACC16                   ; is safe here simply increment exponent
 8363  F86194  C2 20                    rep     #PMFLAG
 8364                                   .LONGA  on
 8365                                   .MNLIST
 8366  F86196  E6 3A                    inc     argexp          ; 2*p*p*p
 8367  F86198                           ACC08
 8368  F86198  E2 20                    sep     #PMFLAG
 8369                                   .LONGA  off
 8370                                   .MNLIST
 8371  F8619A  20 47 85                 jsr     mvt0_f          ; z
 8372  F8619D  20 7D 45                 jsr     fpadd           ; 2*p*p*p+z
 8373  F861A0  20 55 86                 jsr     mvt3_a          ; p*p*p+2*z
 8374  F861A3  20 10 4A                 jsr     fpdiv           ; (p*p*p+2*z)/(2*p*p*p+z)
 8375  F861A6  20 FB 85                 jsr     mvt1_a          ; p
 8376  F861A9  4C DD 49                 jmp     fpmult          ; p*((p*p*p+2*z)/(2*p*p*p+z))
 8377                           
 8378                           ; coefficients for initial rational approximation to square root
 8379                           ; 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,$F7
               52 B7 9F F7 
 8381  F861B5  6F 60 5B 7C 8C           .DB     $6F,$60,$5B,$7C,$8C,$BA,$AF,$FD,$3F     ; A=0.343220129185
               BA AF FD 3F 
 8382  F861BE  9E BA E5 B7 91   sqb:    .DB     $9E,$BA,$E5,$B7,$91,$09,$68,$DF,$B2
               09 68 DF B2 
 8383  F861C7  76 6E E6 E6 13           .DB     $76,$6E,$E6,$E6,$13,$52,$E6,$FE,$3F     ; B=0.899689906952
               52 E6 FE 3F 
 8384  F861D0  4C 28 D6 5D 7A   sqc:    .DB     $4C,$28,$D6,$5D,$7A,$85,$E9,$00,$81
               85 E9 00 81 
 8385  F861D9  17 23 D0 C7 70           .DB     $17,$23,$D0,$C7,$70,$63,$BA,$FD,$3F     ; C=0.364039921180
               63 BA FD 3F 
 8386                           
 8387  F861E2  AA AA AA AA AA   c13:    .DB     $AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA
               AA AA AA AA 
 8388  F861EB  AA AA AA AA AA           .DB     $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FD,$3F     ; 1/3
               AA AA FD 3F 
 8389                           
 8390                           ; coefficients for initial rational approximation to cube root (0.125 <= x < 1)
 8391                           cbrn:   ; numerator coefficients (degree 4)
 8392                           ; N[4] = 45.2548339756803022511987494
 8393  F861F4  3C 10 33 78 FE           .DB     $3C,$10,$33,$78,$FE,$76,$9E,$89,$D0
               76 9E 89 D0 
 8394  F861FD  83 D3 9D 32 F3           .DB     $83,$D3,$9D,$32,$F3,$04,$B5,$04,$40
               04 B5 04 40 
  Tue Jul 17 11:00:18 2018                                                                                               Page  102




 8395                           ; N[3] = 192.2798368355061050458134625
 8396  F86206  08 E3 5B 8C F2           .DB     $08,$E3,$5B,$8C,$F2,$49,$06,$80,$97
               49 06 80 97 
 8397  F8620F  00 B7 08 63 A3           .DB     $00,$B7,$08,$63,$A3,$47,$C0,$06,$40
               47 C0 06 40 
 8398                           ; N[2] = 119.1654824285581628956914143
 8399  F86218  42 D8 BC 63 FD           .DB     $42,$D8,$BC,$63,$FD,$2F,$EF,$90,$64
               2F EF 90 64 
 8400  F86221  9F 70 E5 1C BA           .DB     $9F,$70,$E5,$1C,$BA,$54,$EE,$05,$40
               54 EE 05 40 
 8401                           ; N[1] = 13.43250139086239872172837314
 8402  F8622A  AA 47 0C 1F 85           .DB     $AA,$47,$0C,$1F,$85,$FF,$A0,$76,$20
               FF A0 76 20 
 8403  F86233  00 A8 13 94 86           .DB     $00,$A8,$13,$94,$86,$EB,$D6,$02,$40
               EB D6 02 40 
 8404                           ; N[0] = 0.1636161226585754240958355063
 8405  F8623C  7B C3 D8 3A B4           .DB     $7B,$C3,$D8,$3A,$B4,$CC,$8B,$32,$6D
               CC 8B 32 6D 
 8406  F86245  69 E9 AA 1F FC           .DB     $69,$E9,$AA,$1F,$FC,$8A,$A7,$FC,$3F
               8A A7 FC 3F 
 8407                           
 8408                           cbrd:   ; denominator coefficients (degree 4)   
 8409                           ; D[4] = 14.80884093219134573786480845
 8410  F8624E  1A 8E 1C AB 2F           .DB     $1A,$8E,$1C,$AB,$2F,$1C,$FF,$A5,$49
               1C FF A5 49 
 8411  F86257  05 D9 76 30 03           .DB     $05,$D9,$76,$30,$03,$F1,$EC,$02,$40
               F1 EC 02 40 
 8412                           ; D[3] = 151.9714051044435648658557668
 8413  F86260  7A 6B 6B 1C FD           .DB     $7A,$6B,$6B,$1C,$FD,$4E,$DD,$A5,$C7
               4E DD A5 C7 
 8414  F86269  A8 C0 42 01 AE           .DB     $A8,$C0,$42,$01,$AE,$F8,$97,$06,$40
               F8 97 06 40 
 8415                           ; D[2] = 168.5254414101568283957668343
 8416  F86272  F6 AE F6 BD 0C           .DB     $F6,$AE,$F6,$BD,$0C,$B1,$C7,$0B,$85
               B1 C7 0B 85 
 8417  F8627B  73 96 08 54 83           .DB     $73,$96,$08,$54,$83,$86,$A8,$06,$40
               86 A8 06 40 
 8418                           ; D[1] = 33.9905941350215598754191872
 8419  F86284  9C 0A 30 D2 E7           .DB     $9C,$0A,$30,$D2,$E7,$F9,$A1,$D1,$F6
               F9 A1 D1 F6 
 8420  F8628D  A7 1B 16 4F 5E           .DB     $A7,$1B,$16,$4F,$5E,$F6,$87,$04,$40
               F6 87 04 40 
 8421                           ; D[0] = 1
 8422  F86296  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 8423  F8629F  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$80,$FF,$3F
               00 80 FF 3F 
 8424                           
 8425                           ;----------------------------------------------------------------------------
 8426                           ; logarithmic family functions
 8427                           ;----------------------------------------------------------------------------
 8428                           
 8429                           ; flogep1 - return natural logarithm (base e) of x + 1
 8430                           ;
 8431                           ;       entry:
 8432                           ;               fac = x
 8433                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page  103




 8434                           ;       exit:
 8435                           ;               fac = loge(1 + x)
 8436                           ;               CF = 1 if invalid result (nan, inf)
 8437                           ;
 8438                           ;       computation mean time: 75/125ms at 4MHz
 8439                           ;
 8440                           ;-------
 8441  F862A8                   flogep1:
 8442                           ;-------
 8443  F862A8  20 91 63                 jsr     cmnlogp1        ; return the logarithm of the fractional part
 8444  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 flag
 8448  F862B2  60                       rts
 8449                           
 8450                           ; floge - return natural logarithm (base e) of x
 8451                           ;
 8452                           ;       entry:
 8453                           ;               fac = x
 8454                           ;
 8455                           ;       exit:
 8456                           ;               fac = loge(x)
 8457                           ;               CF = 1 if invalid result (nan, inf)
 8458                           ;
 8459                           ;       computation mean time: 75/125ms at 4MHz
 8460                           ;
 8461                           ;-----
 8462  F862B3                   floge:
 8463                           ;-----
 8464  F862B3  20 DC 63                 jsr     cmnlog          ; return the logarithm of the fractional part
 8465  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 flag
 8469  F862BD  60                       rts
 8470                           
 8471                           ; lgem - evaluate loge(2)*M and add to logarithm of fractional part
 8472                           ;
 8473                           ;                    M
 8474                           ; 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     scexp
 8481  F862C3  A4 47                    ldy     scexp+1
 8482  F862C5  20 5B 4F                 jsr     fldu16          ; convert exponent M to float
 8483  F862C8  A5 45                    lda     scsgn
 8484  F862CA  85 24                    sta     facsgn          ; sign of the exponent M
 8485  F862CC  20 66 84                 jsr     mvf_t0
 8486  F862CF  A9 8D                    lda     #<ln2c1         ; now evaluate M * loge(2)... 
 8487  F862D1  A0 67                    ldy     #>ln2c1
 8488  F862D3  20 D5 49                 jsr     fcmult
 8489  F862D6  20 93 84                 jsr     mvf_t1          ; ...splitted in two
 8490  F862D9  20 47 85                 jsr     mvt0_f
  Tue Jul 17 11:00:18 2018                                                                                               Page  104




 8491  F862DC  A9 9F                    lda     #<ln2c2
 8492  F862DE  A0 67                    ldy     #>ln2c2
 8493  F862E0  20 D5 49                 jsr     fcmult
 8494  F862E3  20 28 86                 jsr     mvt2_a
 8495  F862E6  20 7D 45                 jsr     fpadd
 8496  F862E9  20 FB 85                 jsr     mvt1_a
 8497  F862EC  4C 7D 45                 jmp     fpadd
 8498  F862EF                           
 8499                           ; flog10p1 - return decimal logarithm (base 10) of x + 1
 8500                           ;
 8501                           ;       entry:
 8502                           ;               fac = x
 8503                           ;
 8504                           ;       exit:
 8505                           ;               fac = log10(1 + x)
 8506                           ;               CF = 1 if invalid result (nan, inf)
 8507                           ;
 8508                           ;       computation mean time: 85/140ms at 4MHz
 8509                           ;
 8510                           ;--------
 8511  F862EF                   flog10p1:
 8512                           ;--------
 8513  F862EF  20 91 63                 jsr     cmnlogp1        ; return the loge of the fractional part
 8514  F862F2  20 3C 63                 jsr     lg10            ; return the log10 of the fractional part       
 8515  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 flag
 8519  F862FC  60                       rts
 8520                           
 8521                           ; flog10 - return decimal logarithm (base 10) of x
 8522                           ;
 8523                           ;       entry:
 8524                           ;               fac = x
 8525                           ;
 8526                           ;       exit:
 8527                           ;               fac = log10(x)
 8528                           ;               CF = 1 if invalid result (nan, inf)
 8529                           ;
 8530                           ;       computation mean time: 85/140ms at 4MHz
 8531                           ;
 8532                           ;------
 8533  F862FD                   flog10:
 8534                           ;------
 8535  F862FD  20 DC 63                 jsr     cmnlog          ; return the loge of the fractional part
 8536  F86300  20 3C 63                 jsr     lg10            ; return the log10 of the fractional part               
 8537  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 flag
 8541  F8630A  60                       rts
 8542                           
 8543                           ; lg10m - evaluate log10(2)*M and add to logarithm of fractional part
 8544                           ;
 8545                           ;                   M
 8546                           ; log(x) = log(f * 2 ) = log10(f) + M * log10(2)
 8547                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page  105




 8548                           ;-----  
 8549  F8630B                   lg10m:
 8550                           ;-----
 8551  F8630B  20 C0 84                 jsr     mvf_t2          ; tfr2=log10(f)
 8552  F8630E  A5 46                    lda     scexp
 8553  F86310  A4 47                    ldy     scexp+1
 8554  F86312  20 5B 4F                 jsr     fldu16          ; convert exponent M to float
 8555  F86315  A5 45                    lda     scsgn
 8556  F86317  85 24                    sta     facsgn          ; sign of the exponent M
 8557  F86319  20 66 84                 jsr     mvf_t0
 8558  F8631C  A9 C3                    lda     #<l102a         ; now evaluate M * log10(2)... 
 8559  F8631E  A0 67                    ldy     #>l102a
 8560  F86320  20 D5 49                 jsr     fcmult
 8561  F86323  20 93 84                 jsr     mvf_t1          ; ...splitted in two
 8562  F86326  20 47 85                 jsr     mvt0_f
 8563  F86329  A9 D5                    lda     #<l102b
 8564  F8632B  A0 67                    ldy     #>l102b
 8565  F8632D  20 D5 49                 jsr     fcmult
 8566  F86330  20 28 86                 jsr     mvt2_a
 8567  F86333  20 7D 45                 jsr     fpadd
 8568  F86336  20 FB 85                 jsr     mvt1_a
 8569  F86339  4C 7D 45                 jmp     fpadd
 8570                           
 8571                           ; lg10 - convert the natural logarithm into decimal logarithm
 8572                           ;
 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     #<l10ea
 8580  F86341  A0 67                    ldy     #>l10ea
 8581  F86343  20 D5 49                 jsr     fcmult
 8582  F86346  20 93 84                 jsr     mvf_t1
 8583  F86349  20 47 85                 jsr     mvt0_f
 8584  F8634C  A9 F9                    lda     #<l10eb
 8585  F8634E  A0 67                    ldy     #>l10eb
 8586  F86350  20 D5 49                 jsr     fcmult
 8587  F86353  20 FB 85                 jsr     mvt1_a
 8588  F86356  4C 7D 45                 jmp     fpadd           
 8589                           
 8590                           ; flog2p1 - return the base 2 logarithm of x + 1
 8591                           ;
 8592                           ;       entry:
 8593                           ;               fac = x
 8594                           ;
 8595                           ;       exit:
 8596                           ;               fac = log2(1 + x)
 8597                           ;               CF = 1 if invalid result (nan, inf)
 8598                           ;
 8599                           ;       computation mean time: 80/130ms at 4MHz
 8600                           ;
 8601                           ;-------
 8602  F86359                   flog2p1:
 8603                           ;-------
 8604  F86359  20 91 63                 jsr     cmnlogp1        ; return the loge of the fractional part
  Tue Jul 17 11:00:18 2018                                                                                               Page  106




 8605  F8635C  A9 0B                    lda     #<lg2e          ; return the log2 of the fractional part
 8606  F8635E  A0 68                    ldy     #>lg2e
 8607  F86360  20 D5 49                 jsr     fcmult
 8608  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 M
 8611  F86369  18                       clc                     ; return valid flag
 8612  F8636A  60                       rts
 8613                           
 8614                           ; flog2 - return the base 2 logarithm of x
 8615                           ;
 8616                           ;       entry:
 8617                           ;               fac = x
 8618                           ;
 8619                           ;       exit:
 8620                           ;               fac = log2(x)
 8621                           ;               CF = 1 if invalid result (nan, inf)
 8622                           ;
 8623                           ;       computation mean time: 80/130ms at 4MHz
 8624                           ;
 8625                           ;-----
 8626  F8636B                   flog2:
 8627                           ;-----
 8628  F8636B  20 DC 63                 jsr     cmnlog          ; return the loge of the fractional part
 8629  F8636E  A9 0B                    lda     #<lg2e          ; return the log2 of the fractional part
 8630  F86370  A0 68                    ldy     #>lg2e
 8631  F86372  20 D5 49                 jsr     fcmult
 8632  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 M
 8635  F8637B  18                       clc                     ; return valid flag
 8636  F8637C  60                       rts
 8637                           
 8638                           ; lg2m - add exponent M to base 2 logarithm of fractional part
 8639                           ;
 8640                           ;                   M
 8641                           ; log(x) = log(f * 2 ) = log2(f) + M
 8642                           ;
 8643                           ;----   
 8644  F8637D                   lg2m:
 8645                           ;----
 8646  F8637D  20 C0 84                 jsr     mvf_t2          ; tfr2=log2(f)
 8647  F86380  A5 46                    lda     scexp
 8648  F86382  A4 47                    ldy     scexp+1
 8649  F86384  20 5B 4F                 jsr     fldu16          ; convert exponent M to float
 8650  F86387  A5 45                    lda     scsgn
 8651  F86389  85 24                    sta     facsgn          ; sign of the exponent M
 8652  F8638B  20 28 86                 jsr     mvt2_a
 8653  F8638E  4C 7D 45                 jmp     fpadd
 8654  F86391                           
 8655                           ; cmnlogp1 - common logarithm evaluation
 8656                           ; return the natural logarithm (base e) of the fraction of x + 1
 8657                           ;
 8658                           ; Note that when evaluate log(x) with x very close to one, cancellation
 8659                           ; 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 argument
 8661                           ; is very closed to one.
  Tue Jul 17 11:00:18 2018                                                                                               Page  107




 8662                           ;
 8663                           ;       entry:
 8664                           ;               fac = xm1 (xm1 = x - 1)
 8665                           ;
 8666                           ;       exit:
 8667                           ;               fac = loge(f), f = fraction of xm1 + 1
 8668                           ;               scexp = M = exponent of the argument
 8669                           ;
 8670                           ;       where:
 8671                           ;                            M
 8672                           ;               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    3
 8680                           ;       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                        2
 8685                           ;       loge(f) = y + y * R(z)/S(z), where z = y
 8686                           ;
 8687                           ;--------
 8688  F86391                   cmnlogp1:
 8689                           ;--------
 8690  F86391  24 25                    bit     facst
 8691  F86393  30 1C                    bmi     ?nv             ; invalid xm1
 8692  F86395  18                       clc
 8693  F86396  70 23                    bvs     ?ex             ; xm1=0 so return 0
 8694  F86398  20 93 84                 jsr     mvf_t1          ; tfr1=xm1
 8695  F8639B  20 6C 45                 jsr     faddone         ; x=1+xm1
 8696  F8639E  B0 1B                    bcs     ?ex             ; x=+inf so return +inf
 8697  F863A0  24 24                    bit     facsgn
 8698  F863A2  30 13                    bmi     ?nan            ; x<0 so return -nan
 8699  F863A4  24 25                    bit     facst
 8700  F863A6  50 16                    bvc     ?ok             ; ok, x > 0
 8701  F863A8  20 7D 4E                 jsr     fldinf          ; x=0 so return -inf
 8702  F863AB  A9 FF                    lda     #$FF
 8703  F863AD  85 24                    sta     facsgn
 8704  F863AF  80 09                    bra     ?er
 8705  F863B1  70 07            ?nv:    bvs     ?er             ; xm1=nan so return nan
 8706  F863B3  24 24                    bit     facsgn
 8707  F863B5  10 03                    bpl     ?er             ; xm1=+inf so return +inf
 8708  F863B7  20 74 4E         ?nan:   jsr     fldnan          ; xm1=-inf so return -nan
 8709  F863BA  38               ?er:    sec                     ; invalid fac
 8710  F863BB  68               ?ex:    pla                     ; skip return address
 8711  F863BC  68                       pla
 8712  F863BD  60                       rts
 8713  F863BE  20 A6 64         ?ok:    jsr     logscl          ; argument reduction & exponent extraction
 8714  F863C1  90 08                    bcc     ?tiny           ; |M| < 3
 8715  F863C3  20 66 84                 jsr     mvf_t0          ; tfr0=x
 8716  F863C6  20 71 45                 jsr     fsubone         ; x-1   
 8717  F863C9  80 40                    bra     lge             ; evaluation for |M| > 2        
 8718  F863CB  A5 46            ?tiny:  lda     scexp           ; if M=0... 
  Tue Jul 17 11:00:18 2018                                                                                               Page  108




 8719  F863CD  05 47                    ora     scexp+1
 8720  F863CF  F0 06                    beq     ?xm1            ; ...use argument xm1
 8721  F863D1  20 71 45                 jsr     fsubone         ; ...otherwise use x - 1 
 8722  F863D4  4C 5B 64                 jmp     lgep1
 8723  F863D7  20 74 85         ?xm1:   jsr     mvt1_f          ; use xm1
 8724  F863DA  80 7F                    bra     lgep1
 8725                           
 8726                           ; cmnlog - common logarithm evaluation
 8727                           ; return the natural logarithm (base e) of the fraction of the argument
 8728                           ;
 8729                           ;       entry:
 8730                           ;               fac = x
 8731                           ;
 8732                           ;       exit:
 8733                           ;               fac = loge(f)
 8734                           ;               scexp = M = exponent of the argument
 8735                           ;
 8736                           ;       where:
 8737                           ;                        M
 8738                           ;               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    3
 8746                           ;       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                        2
 8751                           ;       loge(f) = y + y * R(z)/S(z), where z = y
 8752                           ;
 8753                           ;------
 8754  F863DC                   cmnlog:
 8755                           ;------
 8756  F863DC  24 25                    bit     facst           ; fac must be valid and > 0
 8757  F863DE  10 08                    bpl     ?ckz
 8758  F863E0  70 18                    bvs     ?er             ; fac=nan so return nan
 8759  F863E2  24 24                    bit     facsgn          ; if fac=+inf...
 8760  F863E4  10 14                    bpl     ?er             ; ...return +inf...
 8761  F863E6  30 06                    bmi     ?nan            ; ...else return nan
 8762  F863E8  70 09            ?ckz:   bvs     ?inf            ; if fac=0 return -inf
 8763  F863EA  24 24                    bit     facsgn          ; if fac>0 go to evaluation...
 8764  F863EC  10 10                    bpl     ?go             ; ...else return nan
 8765  F863EE  20 74 4E         ?nan:   jsr     fldnan          ; return nan
 8766  F863F1  80 07                    bra     ?er
 8767  F863F3  A9 FF            ?inf:   lda     #$FF            ; return -inf
 8768  F863F5  85 24                    sta     facsgn
 8769  F863F7  20 7D 4E                 jsr     fldinf
 8770  F863FA  68               ?er:    pla                     ; skip return address
 8771  F863FB  68                       pla
 8772  F863FC  38                       sec                     ; return invalid result
 8773  F863FD  60                       rts
 8774  F863FE  20 A6 64         ?go:    jsr     logscl          ; argument reduction & exponent extraction
 8775  F86401  08                       php                     ; save carry (cf=0 if |exponent| < 3)
  Tue Jul 17 11:00:18 2018                                                                                               Page  109




 8776  F86402  20 66 84                 jsr     mvf_t0          ; tfr0=f
 8777  F86405  20 71 45                 jsr     fsubone         ; fac=y=f-1
 8778  F86408  28                       plp
 8779  F86409  90 50                    bcc     lgep1           ; if |exponent| < 3 evaluate for (1+f)
 8780                           
 8781                           ; lge - approximate loge(f)
 8782                           ;
 8783                           ;                      3                        2
 8784                           ;       loge(f) = y + y * R(z)/S(z), where z = y
 8785                           ;
 8786                           ;       y = 2(f - 1)/(f + 1)
 8787                           ;
 8788                           ;---
 8789  F8640B                   lge:
 8790                           ;---
 8791  F8640B  20 93 84                 jsr     mvf_t1          ; tfr1=y=f-1
 8792  F8640E  20 47 85                 jsr     mvt0_f          ; fac=f
 8793  F86411  20 6C 45                 jsr     faddone         ; fac=f+1
 8794  F86414  20 FB 85                 jsr     mvt1_a          ; arg=f-1
 8795  F86417  20 10 4A                 jsr     fpdiv           ; (f-1)/(f+1)
 8796  F8641A                           ACC16
 8797  F8641A  C2 20                    rep     #PMFLAG
 8798                                   .LONGA  on
 8799                                   .MNLIST
 8800  F8641C  A5 22                    lda     facexp
 8801  F8641E  F0 03                    beq     ?isz            ; y=0
 8802  F86420  1A                       inc     a               ; note that here y is always normal
 8803  F86421  E6 22                    inc     facexp          ; y=2*(x-1)/(x+1)
 8804  F86423                   ?isz:   ACC08
 8805  F86423  E2 20                    sep     #PMFLAG
 8806                                   .LONGA  off
 8807                                   .MNLIST
 8808  F86425  20 93 84                 jsr     mvf_t1          ; tfr1=y
 8809  F86428  20 CC 49                 jsr     fsquare         ; z=y*y
 8810  F8642B  20 66 84                 jsr     mvf_t0          ; tfr0=z
 8811  F8642E  A9 F3                    lda     #<clnr
 8812  F86430  A0 64                    ldy     #>clnr
 8813  F86432  A2 05                    ldx     #5
 8814  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     #<clns
 8817  F8643C  A0 65                    ldy     #>clns
 8818  F8643E  A2 05                    ldx     #5
 8819  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=z
 8823  F8644C  20 DD 49                 jsr     fpmult          ; z*R(z)/S(z)
 8824  F8644F  20 FB 85                 jsr     mvt1_a          ; arg=y
 8825  F86452  20 DD 49                 jsr     fpmult          ; y*z*R(z)/S(z)
 8826  F86455  20 FB 85                 jsr     mvt1_a          ; arg=y
 8827  F86458  4C 7D 45                 jmp     fpadd           ; loge(f)=y+y*z*R(z)/S(z)
 8828  F8645B                           
 8829                           ; lgep1 - approximate loge(1+y)
 8830                           ;
 8831                           ;                              2    3
 8832                           ;       loge(1+y) = y - 0.5 * y  + y * P(y)/Q(y) 
  Tue Jul 17 11:00:18 2018                                                                                               Page  110




 8833                           ;
 8834                           ;       y = f - 1
 8835                           ;
 8836                           ;-----
 8837  F8645B                   lgep1:
 8838                           ;-----
 8839  F8645B  20 66 84                 jsr     mvf_t0          ; tfr0=y=x-1            
 8840  F8645E  20 CC 49                 jsr     fsquare         ; z=y*y
 8841  F86461  20 93 84                 jsr     mvf_t1          ; tfr1=z
 8842  F86464  A9 CB                    lda     #<clnp
 8843  F86466  A0 65                    ldy     #>clnp
 8844  F86468  A2 0C                    ldx     #12
 8845  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     #<clnq
 8848  F86472  A0 66                    ldy     #>clnq
 8849  F86474  A2 0B                    ldx     #11
 8850  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          ; z
 8854  F86482  20 DD 49                 jsr     fpmult          ; z*P(y)/Q(y)
 8855  F86485  20 CE 85                 jsr     mvt0_a          ; y
 8856  F86488  20 DD 49                 jsr     fpmult          ; y*z*P(y)/Q(y)
 8857  F8648B  20 FB 85                 jsr     mvt1_a          ; z
 8858  F8648E                           ACC16
 8859  F8648E  C2 20                    rep     #PMFLAG
 8860                                   .LONGA  on
 8861                                   .MNLIST
 8862  F86490  A5 3A                    lda     argexp
 8863  F86492  F0 03                    beq     ?isz            ; z=0
 8864  F86494  3A                       dec     a
 8865  F86495  85 3A                    sta     argexp          ; z/2
 8866  F86497                   ?isz:   ACC08
 8867  F86497  E2 20                    sep     #PMFLAG
 8868                                   .LONGA  off
 8869                                   .MNLIST
 8870  F86499  A9 FF                    lda     #$FF
 8871  F8649B  85 3C                    sta     argsgn          ; arg=-z/2
 8872  F8649D  20 7D 45                 jsr     fpadd           ; y*z*(P(y)/Q(y)) - z/2 
 8873  F864A0  20 CE 85                 jsr     mvt0_a          ; arg=y
 8874  F864A3  4C 7D 45                 jmp     fpadd           ; loge(1+y)=y-z/2+y*z*(P(y)/Q(y))
 8875                           
 8876                           ; logscl - argument reduction for logarithm evaluation
 8877                           ;
 8878                           ;       entry:
 8879                           ;               fac = x, valid float
 8880                           ;
 8881                           ;       exit:
 8882                           ;               fac = f, reduced argument
 8883                           ;               scexp = |M|, exponent
 8884                           ;               scsgn = sign of M
 8885                           ;               CF = 0 if |M| < 3
 8886                           ;
 8887                           ;                        M
 8888                           ;               x = f * 2       sqrt(2)/2 <= f < sqrt(2)
 8889                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page  111




 8890                           ;------
 8891  F864A6                   logscl:
 8892                           ;------
 8893  F864A6  20 6E 48                 jsr     frexp           ; now 0.5 <= fac < 1
 8894  F864A9  A9 E1                    lda     #<rsqrt2h       ; now compare fac vs. 1/sqrt(2)
 8895  F864AB  A0 64                    ldy     #>rsqrt2h
 8896  F864AD  20 5E 87                 jsr     fccmp
 8897  F864B0                           ACC16
 8898  F864B0  C2 20                    rep     #PMFLAG
 8899                                   .LONGA  on
 8900                                   .MNLIST
 8901  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 exponent
 8905  F864BA  A2 00            ?gte:   ldx     #0              ; assume positive scaling exponent
 8906  F864BC  A5 46                    lda     scexp
 8907  F864BE  10 07                    bpl     ?mp             ; positive or null scaling
 8908  F864C0  CA                       dex                     ; negative scaling
 8909  F864C1  49 FF FF                 eor     #$FFFF          ; complement
 8910  F864C4  1A                       inc     a
 8911  F864C5  85 46                    sta     scexp           ; unsigned scaling exponent
 8912  F864C7  86 45            ?mp:    stx     scsgn           ; sign of scaling exponent
 8913  F864C9  C9 03 00                 cmp     #3              ; return CF = 0 if |exponent| < 3
 8914  F864CC                           ACC08
 8915  F864CC  E2 20                    sep     #PMFLAG
 8916                                   .LONGA  off
 8917                                   .MNLIST
 8918  F864CE  60                       rts
 8919                           
 8920                           ; unrounded 1/sqrt(2) - $B504F333F9DE6484597D89B3754ABE9FP3FFE
 8921  F864CF  9F BE 4A 75 B3   sqrth:  .DB     $9F,$BE,$4A,$75,$B3,$89,$7D,$59,$84
               89 7D 59 84 
 8922  F864D8  64 DE F9 33 F3           .DB     $64,$DE,$F9,$33,$F3,$04,$B5,$FE,$3F
               04 B5 FE 3F 
 8923                           
 8924                           ; 1/sqrt(2) rounded to 113 bits
 8925  F864E1                   rsqrt2h:
 8926  F864E1  00 80 4A 75 B3           .DB     $00,$80,$4A,$75,$B3,$89,$7D,$59,$84
               89 7D 59 84 
 8927  F864EA  64 DE F9 33 F3           .DB     $64,$DE,$F9,$33,$F3,$04,$B5,$FE,$3F
               04 B5 FE 3F 
 8928                           
 8929                           ; coefficients for log(x), rational function R()/S()
 8930  F864F3                   clnr:
 8931                           ; R[5] = -8.828896441624934385266096344596648080902E-1
 8932  F864F3  8E 15 84 6B 67           .DB     $8E,$15,$84,$6B,$67,$72,$AA,$CE,$23
               72 AA CE 23 
 8933  F864FC  34 AD A7 43 0E           .DB     $34,$AD,$A7,$43,$0E,$05,$E2,$FE,$BF
               05 E2 FE BF 
 8934                           ; R[4] =  8.057002716646055371965756206836056074715E1
 8935  F86505  14 20 14 FB 86           .DB     $14,$20,$14,$FB,$86,$D1,$08,$AB,$2D
               D1 08 AB 2D 
 8936  F8650E  2B 8F CB 99 DA           .DB     $2B,$8F,$CB,$99,$DA,$23,$A1,$05,$40
               23 A1 05 40 
 8937                           ; R[3] = -2.024301798136027039250415126250455056397E3
 8938  F86517  BC EF D7 01 BF           .DB     $BC,$EF,$D7,$01,$BF,$A2,$EE,$76,$48
  Tue Jul 17 11:00:18 2018                                                                                               Page  112




               A2 EE 76 48 
 8939  F86520  5B 87 90 54 A8           .DB     $5B,$87,$90,$54,$A8,$09,$FD,$09,$C0
               09 FD 09 C0 
 8940                           ; R[2] =  2.048819892795278657810231591630928516206E4
 8941  F86529  1C CC E3 20 15           .DB     $1C,$CC,$E3,$20,$15,$6E,$6A,$18,$09
               6E 6A 18 09 
 8942  F86532  F5 76 E2 D9 65           .DB     $F5,$76,$E2,$D9,$65,$10,$A0,$0D,$40
               10 A0 0D 40 
 8943                           ; R[1] = -8.977257995689735303686582344659576526998E4
 8944  F8653B  37 36 95 61 03           .DB     $37,$36,$95,$61,$03,$74,$9D,$2E,$47
               74 9D 2E 47 
 8945  F86544  9C 11 07 3C 4A           .DB     $9C,$11,$07,$3C,$4A,$56,$AF,$0F,$C0
               56 AF 0F C0 
 8946                           ; R[0] = 1.418134209872192732479751274970992665513E5
 8947  F8654D  A8 4A 7E 5A 28           .DB     $A8,$4A,$7E,$5A,$28,$99,$7D,$53,$01
               99 7D 53 01 
 8948  F86556  B4 60 74 F1 5A           .DB     $B4,$60,$74,$F1,$5A,$7D,$8A,$10,$40
               7D 8A 10 40 
 8949                           
 8950  F8655F                   clns:
 8951                           ; S[5] = -1.186359407982897997337150403816839480438E2
 8952  F8655F  3A 6E 31 96 EA           .DB     $3A,$6E,$31,$96,$EA,$56,$BE,$E6,$BA
               56 BE E6 BA 
 8953  F86568  92 B1 45 08 9A           .DB     $92,$B1,$45,$08,$9A,$45,$ED,$05,$C0
               45 ED 05 C0 
 8954                           ; S[4] =  3.998526750980007367835804959888064681098E3
 8955  F86571  C4 2A 76 05 E9           .DB     $C4,$2A,$76,$05,$E9,$F4,$A8,$5F,$11
               F4 A8 5F 11 
 8956  F8657A  48 84 6F 92 6D           .DB     $48,$84,$6F,$92,$6D,$E8,$F9,$0A,$40
               E8 F9 0A 40 
 8957                           ; S[3] = -5.748542087379434595104154610899551484314E4
 8958  F86583  36 79 3E 93 5D           .DB     $36,$79,$3E,$93,$5D,$19,$08,$FE,$93
               19 08 FE 93 
 8959  F8658C  75 8E 62 BE 6B           .DB     $75,$8E,$62,$BE,$6B,$8D,$E0,$0E,$C0
               8D E0 0E C0 
 8960                           ; S[2] =  4.001557694070773974936904547424676279307E5
 8961  F86595  36 7C 5E 8E 90           .DB     $36,$7C,$5E,$8E,$90,$52,$EB,$2D,$76
               52 EB 2D 76 
 8962  F8659E  57 97 FB 9E 78           .DB     $57,$97,$FB,$9E,$78,$63,$C3,$11,$40
               63 C3 11 40 
 8963                           ; S[1] = -1.332535117259762928288745111081235577029E6
 8964  F865A7  E8 C3 BB 00 81           .DB     $E8,$C3,$BB,$00,$81,$59,$F2,$48,$4F
               59 F2 48 4F 
 8965  F865B0  F7 E2 25 F0 B8           .DB     $F7,$E2,$25,$F0,$B8,$A9,$A2,$13,$C0
               A9 A2 13 C0 
 8966                           ; S[0] =  1.701761051846631278975701529965589676574E6
 8967  F865B9  68 05 98 8B BC           .DB     $68,$05,$98,$8B,$BC,$65,$3C,$FD,$01
               65 3C FD 01 
 8968  F865C2  0E 91 2E 6A 08           .DB     $0E,$91,$2E,$6A,$08,$BC,$CF,$13,$40
               BC CF 13 40 
 8969                           
 8970                           ; coefficients for log(1+x), rational function P()/Q()
 8971  F865CB                   clnp:   
 8972                           ; P[12] =  1.538612243596254322971797716843006400388E-6
 8973  F865CB  2A C3 7D B0 42           .DB     $2A,$C3,$7D,$B0,$42,$00,$91,$A4,$A1
               00 91 A4 A1 
 8974  F865D4  4A C1 76 6B 50           .DB     $4A,$C1,$76,$6B,$50,$82,$CE,$EB,$3F
  Tue Jul 17 11:00:18 2018                                                                                               Page  113




               82 CE EB 3F 
 8975                           ; P[11] =  4.998469661968096229986658302195402690910E-1
 8976  F865DD  6C FE CF 17 46           .DB     $6C,$FE,$CF,$17,$46,$8D,$F4,$5A,$4E
               8D F4 5A 4E 
 8977  F865E6  17 E6 A3 09 F1           .DB     $17,$E6,$A3,$09,$F1,$EB,$FF,$FD,$3F
               EB FF FD 3F 
 8978                           ; P[10] =  2.321125933898420063925789532045674660756E1
 8979  F865EF  DD 55 73 C9 52           .DB     $DD,$55,$73,$C9,$52,$31,$F5,$21,$A6
               31 F5 21 A6 
 8980  F865F8  33 4B 7F BC A8           .DB     $33,$4B,$7F,$BC,$A8,$B0,$B9,$03,$40
               B0 B9 03 40 
 8981                           ; P[09] =  4.114517881637811823002128927449878962058E2
 8982  F86601  62 F5 AF 82 FE           .DB     $62,$F5,$AF,$82,$FE,$EA,$8A,$CB,$29
               EA 8A CB 29 
 8983  F8660A  7D 14 CE 31 D4           .DB     $7D,$14,$CE,$31,$D4,$B9,$CD,$07,$40
               B9 CD 07 40 
 8984                           ; P[08] =  3.824952356185897735160588078446136783779E3
 8985  F86613  98 15 15 FD 5B           .DB     $98,$15,$15,$FD,$5B,$9C,$06,$E3,$62
               9C 06 E3 62 
 8986  F8661C  2F 09 D7 D9 3C           .DB     $2F,$09,$D7,$D9,$3C,$0F,$EF,$0A,$40
               0F EF 0A 40 
 8987                           ; P[07] =  2.128857716871515081352991964243375186031E4
 8988  F86625  61 2D 76 77 32           .DB     $61,$2D,$76,$77,$32,$6D,$65,$F8,$B4
               6D 65 F8 B4 
 8989  F8662E  B1 67 A8 82 27           .DB     $B1,$67,$A8,$82,$27,$51,$A6,$0D,$40
               51 A6 0D 40 
 8990                           ; P[06] =  7.594356839258970405033155585486712125861E4
 8991  F86637  F5 CF 31 FA 60           .DB     $F5,$CF,$31,$FA,$60,$22,$5B,$82,$A8
               22 5B 82 A8 
 8992  F86640  08 A0 16 C1 C8           .DB     $08,$A0,$16,$C1,$C8,$53,$94,$0F,$40
               53 94 0F 40 
 8993                           ; P[05] =  1.797628303815655343403735250238293741397E5
 8994  F86649  D2 08 FC D7 90           .DB     $D2,$08,$FC,$D7,$90,$40,$A4,$21,$F6
               40 A4 21 F6 
 8995  F86652  CA B8 F8 24 B5           .DB     $CA,$B8,$F8,$24,$B5,$8C,$AF,$10,$40
               8C AF 10 40 
 8996                           ; P[04] =  2.854829159639697837788887080758954924001E5
 8997  F8665B  98 EA 19 A8 D5           .DB     $98,$EA,$19,$A8,$D5,$B8,$B8,$25,$24
               B8 B8 25 24 
 8998  F86664  D1 AB 93 4F 5D           .DB     $D1,$AB,$93,$4F,$5D,$65,$8B,$11,$40
               65 8B 11 40 
 8999                           ; P[03] =  3.007007295140399532324943111654767187848E5
 9000  F8666D  96 EF 0E 45 35           .DB     $96,$EF,$0E,$45,$35,$32,$FC,$95,$4D
               32 FC 95 4D 
 9001  F86676  F2 D3 2D 58 97           .DB     $F2,$D3,$2D,$58,$97,$D3,$92,$11,$40
               D3 92 11 40 
 9002                           ; P[02] =  2.014652742082537582487669938141683759923E5
 9003  F8667F  5E E2 69 C5 8D           .DB     $5E,$E2,$69,$C5,$8D,$BE,$39,$2E,$D6
               BE 39 2E D6 
 9004  F86688  8B C6 A0 8C 51           .DB     $8B,$C6,$A0,$8C,$51,$BE,$C4,$10,$40
               BE C4 10 40 
 9005                           ; P[01] =  7.771154681358524243729929227226708890930E4
 9006  F86691  AE E9 03 6A 3B           .DB     $AE,$E9,$03,$6A,$3B,$ED,$92,$AC,$F8
               ED 92 AC F8 
 9007  F8669A  CF D0 FC FD C5           .DB     $CF,$D0,$FC,$FD,$C5,$C7,$97,$0F,$40
               C7 97 0F 40 
 9008                           ; P[00] =  1.313572404063446165910279910527789794488E4
  Tue Jul 17 11:00:18 2018                                                                                               Page  114




 9009  F866A3  35 07 BE 83 BC           .DB     $35,$07,$BE,$83,$BC,$26,$2A,$5C,$A0
               26 2A 5C A0 
 9010  F866AC  F3 77 E8 6A E5           .DB     $F3,$77,$E8,$6A,$E5,$3E,$CD,$0C,$40
               3E CD 0C 40 
 9011  F866B5                                   
 9012  F866B5                   clnq:
 9013                           ; Q[11] =  4.839208193348159620282142911143429644326E1
 9014  F866B5  19 97 D2 BF 46           .DB     $19,$97,$D2,$BF,$46,$56,$ED,$89,$10
               56 ED 89 10 
 9015  F866BE  A5 9F 26 ED 7D           .DB     $A5,$9F,$26,$ED,$7D,$91,$C1,$04,$40
               91 C1 04 40 
 9016                           ; Q[10] =  9.104928120962988414618126155557301584078E2
 9017  F866C7  C0 4E B7 7A BC           .DB     $C0,$4E,$B7,$7A,$BC,$63,$F1,$97,$7D
               63 F1 97 7D 
 9018  F866D0  4F 2B BF 3B 8A           .DB     $4F,$2B,$BF,$3B,$8A,$9F,$E3,$08,$40
               9F E3 08 40 
 9019                           ; Q[09] =  9.147150349299596453976674231612674085381E3
 9020  F866D9  E1 52 82 D3 69           .DB     $E1,$52,$82,$D3,$69,$1A,$6A,$4C,$1D
               1A 6A 4C 1D 
 9021  F866E2  F9 B2 2A F5 99           .DB     $F9,$B2,$2A,$F5,$99,$EC,$8E,$0C,$40
               EC 8E 0C 40 
 9022                           ; Q[08] =  5.605842085972455027590989944010492125825E4
 9023  F866EB  B8 65 30 7A BB           .DB     $B8,$65,$30,$7A,$BB,$1D,$CD,$02,$A2
               1D CD 02 A2 
 9024  F866F4  25 81 76 BD 6B           .DB     $25,$81,$76,$BD,$6B,$FA,$DA,$0E,$40
               FA DA 0E 40 
 9025                           ; Q[07] =  2.248234257620569139969141618556349415120E5
 9026  F866FD  A2 CA 5D F8 7F           .DB     $A2,$CA,$5D,$F8,$7F,$A4,$A6,$11,$B1
               A4 A6 11 B1 
 9027  F86706  94 7F AF 3F DB           .DB     $94,$7F,$AF,$3F,$DB,$8D,$DB,$10,$40
               8D DB 10 40 
 9028                           ; Q[06] =  6.132189329546557743179177159925690841200E5
 9029  F8670F  7A 44 71 27 79           .DB     $7A,$44,$71,$27,$79,$DE,$89,$E3,$39
               DE 89 E3 39 
 9030  F86718  73 DC 61 ED 2E           .DB     $73,$DC,$61,$ED,$2E,$B6,$95,$12,$40
               B6 95 12 40 
 9031                           ; Q[05] =  1.158019977462989115839826904108208787040E6
 9032  F86721  2A BB 38 BE F1           .DB     $2A,$BB,$38,$BE,$F1,$46,$B7,$69,$6C
               46 B7 69 6C 
 9033  F8672A  9A 1D D8 D1 1F           .DB     $9A,$1D,$D8,$D1,$1F,$5C,$8D,$13,$40
               5C 8D 13 40 
 9034                           ; Q[04] =  1.514882452993549494932585972882995548426E6
 9035  F86733  C0 3A 8A D9 4A           .DB     $C0,$3A,$8A,$D9,$4A,$87,$5D,$9C,$09
               87 5D 9C 09 
 9036  F8673C  03 15 BB 9F 13           .DB     $03,$15,$BB,$9F,$13,$EC,$B8,$13,$40
               EC B8 13 40 
 9037                           ; Q[03] =  1.347518538384329112529391120390701166528E6
 9038  F86745  70 CA B9 8E 83           .DB     $70,$CA,$B9,$8E,$83,$73,$EC,$DA,$BC
               73 EC DA BC 
 9039  F8674E  71 71 9C 4E F4           .DB     $71,$71,$9C,$4E,$F4,$7D,$A4,$13,$40
               7D A4 13 40 
 9040                           ; Q[02] =  7.777690340007566932935753241556479363645E5
 9041  F86757  10 A8 3B 99 11           .DB     $10,$A8,$3B,$99,$11,$F5,$D7,$57,$97
               F5 D7 57 97 
 9042  F86760  A0 60 44 8B 90           .DB     $A0,$60,$44,$8B,$90,$E2,$BD,$12,$40
               E2 BD 12 40 
 9043                           ; Q[01] =  2.626900195321832660448791748036714883242E5
  Tue Jul 17 11:00:18 2018                                                                                               Page  115




 9044  F86769  97 4B 94 D0 A5           .DB     $97,$4B,$94,$D0,$A5,$28,$E9,$C7,$1B
               28 E9 C7 1B 
 9045  F86772  0B F5 01 A0 40           .DB     $0B,$F5,$01,$A0,$40,$44,$80,$11,$40
               44 80 11 40 
 9046                           ; Q[00] =  3.940717212190338497730839731583397586124E4
 9047  F8677B  95 DD E4 62 0D           .DB     $95,$DD,$E4,$62,$0D,$9D,$1F,$45,$B8
               9D 1F 45 B8 
 9048  F86784  F6 59 2E 10 2C           .DB     $F6,$59,$2E,$10,$2C,$EF,$99,$0E,$40
               EF 99 0E 40 
 9049                           
 9050                           ; C1 + C2 = loge(2) (splitted in two)
 9051                           ; C1 = 6.93145751953125E-1
 9052  F8678D  00 00 00 00 00   ln2c1:  .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 9053  F86796  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$72,$B1,$FE,$3F
               72 B1 FE 3F 
 9054                           
 9055                           ; C2 = 1.428606820309417232121458176568075500134E-6
 9056  F8679F  98 07 7A B5 97   ln2c2:  .DB     $98,$07,$7A,$B5,$97,$1F,$C0,$9C,$1D
               1F C0 9C 1D 
 9057  F867A8  4F 5E CD 7B 8E           .DB     $4F,$5E,$CD,$7B,$8E,$BE,$BF,$EB,$3F
               BE BF EB 3F 
 9058                           
 9059                           ; ln(2) = 0.6931471805599453094172321214581765680755001
 9060  F867B1  AF F6 F2 03 98   cln2:   .DB     $AF,$F6,$F2,$03,$98,$B3,$E3,$C9,$AB
               B3 E3 C9 AB 
 9061  F867BA  79 CF D1 F7 17           .DB     $79,$CF,$D1,$F7,$17,$72,$B1,$FE,$3F
               72 B1 FE 3F 
 9062                           
 9063                           ; log10(2) = l102a + l102b (splitted in two)
 9064                           ; l102a = 0.3125
 9065  F867C3  00 00 00 00 00   l102a:  .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 9066  F867CC  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$A0,$FD,$3F
               00 A0 FD 3F 
 9067                           
 9068                           ; l102b = -1.14700043360188047862611052755069732318101185E-2
 9069  F867D5  F8 D0 6D 90 7E   l102b:  .DB     $F8,$D0,$6D,$90,$7E,$CA,$D4,$0E,$EE
               CA D4 0E EE 
 9070  F867DE  0C 01 86 60 AF           .DB     $0C,$01,$86,$60,$AF,$EC,$BB,$F8,$BF
               EC BB F8 BF 
 9071                           
 9072                           ; log10(e) = l10ea + l10eb (splitted in two)
 9073                           ; l10ea = 0.5
 9074  F867E7  00 00 00 00 00   l10ea:  .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
 9075  F867F0  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$80,$FE,$3F
               00 80 FE 3F 
 9076                           ; l10eb = -6.570551809674817234887108108339491770560299E-2
 9077  F867F9  36 8F 30 4B 41   l10eb:  .DB     $36,$8F,$30,$4B,$41,$55,$91,$2A,$AB
               55 91 2A AB 
 9078  F86802  39 5E 23 5B 9D           .DB     $39,$5E,$23,$5B,$9D,$90,$86,$FB,$BF
               90 86 FB BF 
 9079                           
 9080                           ; log2(e) = 1/loge(2)
 9081                           ; lg2e = 1.442695040888963407359924681001892137426646
 9082  F8680B  86 3E 1D 69 D0   lg2e:   .DB     $86,$3E,$1D,$69,$D0,$FE,$87,$BE,$BB
  Tue Jul 17 11:00:18 2018                                                                                               Page  116




               FE 87 BE BB 
 9083  F86814  F0 17 5C 29 3B           .DB     $F0,$17,$5C,$29,$3B,$AA,$B8,$FF,$3F
               AA B8 FF 3F 
 9084                           
 9085                           ;----------------------------------------------------------------------------
 9086                           ; exponential family functions
 9087                           ;----------------------------------------------------------------------------
 9088                           
 9089                           ; fexp2 - return 2 raised to the x power
 9090                           ;
 9091                           ;       entry:
 9092                           ;               fac = x
 9093                           ;
 9094                           ;       exit:          x
 9095                           ;               fac = 2
 9096                           ;               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     facst
 9104  F8681F  10 0D                    bpl     ?fv             ; fac is valid
 9105  F86821  50 09                    bvc     ?er             ; fac=nan so return nan
 9106  F86823  24 24                    bit     facsgn
 9107  F86825  10 05                    bpl     ?er             ; fac=+inf so return +inf
 9108  F86827  64 24            ?zz:    stz     facsgn          ; fac=-inf so return 0
 9109  F86829  4C 56 4E                 jmp     fldz
 9110  F8682C  38               ?er:    sec
 9111  F8682D  60                       rts
 9112  F8682E  20 26 4D         ?fv:    jsr     frndm
 9113  F86831  24 24                    bit     facsgn
 9114  F86833  30 0E                    bmi     ?xn             ; x is negative
 9115  F86835  A9 32                    lda     #<maxl2         ; check if argument can cause overflow
 9116  F86837  A0 71                    ldy     #>maxl2
 9117  F86839  20 5E 87                 jsr     fccmp
 9118  F8683C  30 0E                    bmi     ?ok             ; if x < maxl2 then no overflow
 9119  F8683E  F0 0C                    beq     ?ok
 9120  F86840  4C 7D 4E                 jmp     fldinf          ; overflow so return +inf
 9121  F86843  A9 44            ?xn:    lda     #<minl2         ; check if argument can cause underflow
 9122  F86845  A0 71                    ldy     #>minl2
 9123  F86847  20 5E 87                 jsr     fccmp
 9124  F8684A  30 DB                    bmi     ?zz             ; if x < minl2 then underflow
 9125  F8684C                   ?ok:    ACC16
 9126  F8684C  C2 20                    rep     #PMFLAG
 9127                                   .LONGA  on
 9128                                   .MNLIST
 9129  F8684E  64 B4                    stz     fcpc0           ; log2(2) = 1
 9130  F86850  64 B6                    stz     fcpc1
 9131  F86852  64 B8                    stz     fcpc2
 9132  F86854  A9 7E 70                 lda     #ce2p           ; P coefficients
 9133  F86857  85 BA                    sta     fcpp
 9134  F86859  A9 D8 70                 lda     #ce2q           ; Q coefficients
 9135  F8685C  85 BC                    sta     fcpq
 9136  F8685E  A2 04                    ldx     #4              ; P: degree 4
 9137  F86860  86 BE                    stx     fcpd
  Tue Jul 17 11:00:18 2018                                                                                               Page  117




 9138  F86862  86 BF                    stx     fcqd            ; Q: degree 4
 9139  F86864                           ACC08
 9140  F86864  E2 20                    sep     #PMFLAG
 9141                                   .LONGA  off
 9142                                   .MNLIST
 9143  F86866  A9 FF                    lda     #$FF            ; Q polynomial N+1
 9144  F86868  4C 18 69                 jmp     expev
 9145                           
 9146                           ; fexp - return e raised to the x power
 9147                           ;
 9148                           ;       entry:
 9149                           ;               fac = x
 9150                           ;
 9151                           ;       exit:          x
 9152                           ;               fac = e
 9153                           ;               CF = 1 if invalid result (nan, inf)
 9154                           ;
 9155                           ;       computation mean time: 60ms at 4MHz
 9156                           ;
 9157                           ;----
 9158  F8686B                   fexp:
 9159                           ;----
 9160  F8686B  24 25                    bit     facst
 9161  F8686D  24 25                    bit     facst
 9162  F8686F  10 0D                    bpl     ?fv             ; fac is valid
 9163  F86871  50 09                    bvc     ?er             ; fac=nan so return nan
 9164  F86873  24 24                    bit     facsgn
 9165  F86875  10 05                    bpl     ?er             ; fac=+inf so return +inf
 9166  F86877  64 24            ?zz:    stz     facsgn          ; fac=-inf so return 0
 9167  F86879  4C 56 4E                 jmp     fldz
 9168  F8687C  38               ?er:    sec
 9169  F8687D  60                       rts
 9170  F8687E  20 26 4D         ?fv:    jsr     frndm
 9171  F86881  24 24                    bit     facsgn
 9172  F86883  30 0E                    bmi     ?xn             ; x is negative
 9173  F86885  A9 04                    lda     #<maxln         ; check if argument can cause overflow
 9174  F86887  A0 6F                    ldy     #>maxln
 9175  F86889  20 5E 87                 jsr     fccmp
 9176  F8688C  30 0E                    bmi     ?ok             ; if x <= maxln then no overflow
 9177  F8688E  F0 0C                    beq     ?ok
 9178  F86890  4C 7D 4E                 jmp     fldinf          ; overflow so return +inf
 9179  F86893  A9 16            ?xn:    lda     #<minln         ; check if argument can cause underflow
 9180  F86895  A0 6F                    ldy     #>minln
 9181  F86897  20 5E 87                 jsr     fccmp
 9182  F8689A  30 DB                    bmi     ?zz             ; if x < minln then underflow
 9183  F8689C                   ?ok:    ACC16
 9184  F8689C  C2 20                    rep     #PMFLAG
 9185                                   .LONGA  on
 9186                                   .MNLIST
 9187  F8689E  A9 0B 68                 lda     #lg2e           ; log2(e)
 9188  F868A1  85 B4                    sta     fcpc0
 9189  F868A3  A9 8D 67                 lda     #ln2c1          ; loge(2) first piece
 9190  F868A6  85 B6                    sta     fcpc1
 9191  F868A8  A9 9F 67                 lda     #ln2c2          ; loge(2) 2nd piece
 9192  F868AB  85 B8                    sta     fcpc2
 9193  F868AD  A9 1E 6D                 lda     #ceep           ; P coefficients
 9194  F868B0  85 BA                    sta     fcpp
  Tue Jul 17 11:00:18 2018                                                                                               Page  118




 9195  F868B2  A9 78 6D                 lda     #ceeq           ; Q coefficients
 9196  F868B5  85 BC                    sta     fcpq
 9197  F868B7  A2 04                    ldx     #4              ; P: degree 4
 9198  F868B9  86 BE                    stx     fcpd
 9199  F868BB  E8                       inx
 9200  F868BC  86 BF                    stx     fcqd            ; Q: degree 5
 9201  F868BE                           ACC08
 9202  F868BE  E2 20                    sep     #PMFLAG
 9203                                   .LONGA  off
 9204                                   .MNLIST
 9205  F868C0  A9 00                    lda     #$00            ; Q polynomial N
 9206  F868C2  80 54                    bra     expev
 9207                           
 9208                           ; fexp10 - return 10 raised to the x power
 9209                           ;
 9210                           ;       entry:
 9211                           ;               fac = x
 9212                           ;
 9213                           ;       exit:           x
 9214                           ;               fac = 10
 9215                           ;               CF = 1 if invalid result (nan, inf)
 9216                           ;
 9217                           ;       computation mean time: 65ms at 4MHz
 9218                           ;
 9219                           ;------
 9220  F868C4                   fexp10:
 9221                           ;------
 9222  F868C4  24 25                    bit     facst
 9223  F868C6  10 0D                    bpl     ?fv             ; fac is valid
 9224  F868C8  50 09                    bvc     ?er             ; fac=nan so return nan
 9225  F868CA  24 24                    bit     facsgn
 9226  F868CC  10 05                    bpl     ?er             ; fac=+inf so return +inf
 9227  F868CE  64 24            ?zz:    stz     facsgn          ; fac=-inf so return 0
 9228  F868D0  4C 56 4E                 jmp     fldz
 9229  F868D3  38               ?er:    sec
 9230  F868D4  60                       rts
 9231  F868D5  20 26 4D         ?fv:    jsr     frndm
 9232  F868D8  24 24                    bit     facsgn
 9233  F868DA  30 0E                    bmi     ?xn             ; x is negative
 9234  F868DC  A9 5A                    lda     #<maxl10        ; check if argument can cause overflow
 9235  F868DE  A0 70                    ldy     #>maxl10
 9236  F868E0  20 5E 87                 jsr     fccmp
 9237  F868E3  30 0E                    bmi     ?ok             ; if x <= maxl10 then no overflow
 9238  F868E5  F0 0C                    beq     ?ok
 9239  F868E7  4C 7D 4E                 jmp     fldinf          ; overflow so return +inf
 9240  F868EA  A9 6C            ?xn:    lda     #<minl10        ; check if argument can cause underflow
 9241  F868EC  A0 70                    ldy     #>minl10
 9242  F868EE  20 5E 87                 jsr     fccmp
 9243  F868F1  30 DB                    bmi     ?zz             ; if x < minl10 then underflow
 9244  F868F3                   ?ok:    ACC16
 9245  F868F3  C2 20                    rep     #PMFLAG
 9246                                   .LONGA  on
 9247                                   .MNLIST
 9248  F868F5  A9 48 70                 lda     #lg210          ; log2(10)
 9249  F868F8  85 B4                    sta     fcpc0
 9250  F868FA  A9 24 70                 lda     #lg102a         ; log10(2) first piece
 9251  F868FD  85 B6                    sta     fcpc1
  Tue Jul 17 11:00:18 2018                                                                                               Page  119




 9252  F868FF  A9 36 70                 lda     #lg102b         ; log10(2) 2nd piece
 9253  F86902  85 B8                    sta     fcpc2
 9254  F86904  A9 4C 6F                 lda     #ce10p          ; P coefficients
 9255  F86907  85 BA                    sta     fcpp
 9256  F86909  A9 B8 6F                 lda     #ce10q          ; Q coefficients
 9257  F8690C  85 BC                    sta     fcpq
 9258  F8690E  A2 05                    ldx     #5              ; degree
 9259  F86910  86 BE                    stx     fcpd
 9260  F86912  86 BF                    stx     fcqd
 9261  F86914                           ACC08
 9262  F86914  E2 20                    sep     #PMFLAG
 9263                                   .LONGA  off
 9264                                   .MNLIST
 9265  F86916  A9 FF                    lda     #$FF            ; Q polynomial N+1
 9266  F86918                           
 9267                           ; expev - common exponential function evaluation
 9268                           ;
 9269                           ;       entry:
 9270                           ;               fac = x, valid argument
 9271                           ;               A = $00 if exp(x), otherwise A = $FF
 9272                           ;               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 coefficients
 9276                           ;               fcpq = pointer to Q polynomial coefficients
 9277                           ;               fcpd = P polynomial degree
 9278                           ;               fcqd = Q polynomial degree
 9279                           ;
 9280                           ;       exit:          x               
 9281                           ;               fac = b   , where b=e or b=10 or b=2
 9282                           ;
 9283                           ; strategy:
 9284                           ;
 9285                           ;       Range reduction is accomplished by separating the argument x into
 9286                           ;       an integer M and a fraction f such that:
 9287                           ;
 9288                           ;                x     f    M
 9289                           ;               b   = b  * 2    where |f| < 0.5 * log (2)
 9290                           ;                                                    b
 9291                           ;                                                                     f 
 9292                           ;       A rational function (Pade' form) is then used to approximate b   in
 9293                           ;       the basic range [-0.5 * log (2), +0.5 * log (2)]:
 9294                           ;                                  b               b
 9295                           ;
 9296                           ;                f               P(z)                    2
 9297                           ;               b   = 1 + 2f -------------    where z = f
 9298                           ;                             Q(z) - fP(Z)      
 9299                           ;
 9300                           ;       Finally, get the result scaling the approximate exponential of the
 9301                           ;       fraction by a power of two:
 9302                           ;
 9303                           ;                x     f    M
 9304                           ;               b   = b  * 2  
 9305                           ;
 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  120




 9309                           ; which shows that a 1 lsb error in representing x produces a relative error
 9310                           ; of x times 1 lsb in the function.
 9311                           ; While the routine gives an accurate result for arguments that are exactly 
 9312                           ; represented by a long double precision number, the result contains amplified 
 9313                           ; 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+1
 9319  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                       tax
 9322  F86920  05 B5                    ora     fcpc0+1         ; if b=2 skip this multiplication
 9323  F86922  F0 06                    beq     ?no2
 9324  F86924  8A                       txa
 9325  F86925  A4 B5                    ldy     fcpc0+1
 9326  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=w
 9330  F86933  20 78 4F                 jsr     uitrunc         ; convert w to integer 16 bit
 9331  F86936                           ACC16
 9332  F86936  C2 20                    rep     #PMFLAG
 9333                                   .LONGA  on
 9334                                   .MNLIST
 9335  F86938  A5 00                    lda     tm
 9336  F8693A  A6 24                    ldx     facsgn          ; sign of M
 9337  F8693C  10 04                    bpl     ?mp
 9338  F8693E  49 FF FF                 eor     #$FFFF
 9339  F86941  1A                       inc     a
 9340  F86942  85 46            ?mp:    sta     scexp           ; scexp=M (for final scaling)
 9341  F86944                           ACC08
 9342  F86944  E2 20                    sep     #PMFLAG
 9343                                   .LONGA  off
 9344                                   .MNLIST
 9345  F86946                           
 9346                                   ; now compute x - logb(2)*w, the remainder of x/w 
 9347  F86946  20 47 85                 jsr     mvt0_f          ; fac=w
 9348  F86949  A5 B6                    lda     fcpc1           ; pointer to first piece of splitted -logb(2)
 9349  F8694B  AA                       tax
 9350  F8694C  05 B7                    ora     fcpc1+1         ; if b=2 skip this multiplication
 9351  F8694E  F0 19                    beq     ?skp            ; if b=2 the remainder is: x-w
 9352  F86950  8A                       txa
 9353  F86951  A4 B7                    ldy     fcpc1+1         ; logb(2) is splitted in two pieces
 9354  F86953  20 D5 49                 jsr     fcmult          ; first piece
 9355  F86956  20 FB 85                 jsr     mvt1_a          ; arg=x
 9356  F86959  20 5F 45                 jsr     fpsub
 9357  F8695C  20 93 84                 jsr     mvf_t1          ; tfr1=x-c1
 9358  F8695F  20 47 85                 jsr     mvt0_f          ; fac=w 
 9359  F86962  A5 B8                    lda     fcpc2
 9360  F86964  A4 B9                    ldy     fcpc2+1
 9361  F86966  20 D5 49                 jsr     fcmult          ; 2nd piece
 9362  F86969  20 FB 85         ?skp:   jsr     mvt1_a          ; arg=x-c1
 9363  F8696C  20 5F 45                 jsr     fpsub           ; x-c1-c2 = x - logb(2)*w
 9364  F8696F                           
 9365                                   ; now we have fac = f = x - logb(2)*w, the fraction part
  Tue Jul 17 11:00:18 2018                                                                                               Page  121




 9366                                   ; where: |f| < 0.5*logb(2), and we approximate exponential of fraction
 9367  F8696F  20 93 84                 jsr     mvf_t1          ; tfr1=f
 9368  F86972  20 CC 49                 jsr     fsquare         ; z=f*f
 9369  F86975  20 66 84                 jsr     mvf_t0          ; tfr0=z
 9370  F86978  A5 BA                    lda     fcpp            ; pointer to P(z) coefficients
 9371  F8697A  A4 BB                    ldy     fcpp+1
 9372  F8697C  A6 BE                    ldx     fcpd            ; P(z) degree
 9373  F8697E  20 1C 87                 jsr     peval           ; evaluate P(z)
 9374  F86981  20 FB 85                 jsr     mvt1_a          ; arg=f
 9375  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) coefficients
 9378  F8698C  A4 BD                    ldy     fcpq+1
 9379  F8698E  A6 BF                    ldx     fcqd            ; Q(z) dregree
 9380  F86990  24 C0                    bit     fcpolf
 9381  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     ?dn2
 9384  F86999  20 1C 87         ?dn:    jsr     peval           ; evaluate Q(z) for exp(x)      
 9385  F8699C  20 28 86         ?dn2:   jsr     mvt2_a
 9386  F8699F  A5 3C                    lda     argsgn
 9387  F869A1  49 FF                    eor     #$FF
 9388  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=y
 9393  F869B1  20 6C 45                 jsr     faddone         ; 1+y
 9394  F869B4  20 CE 85                 jsr     mvt0_a
 9395  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 exponential
 9397                           
 9398                           ; fexpm1 - return e raised to the x power, minus 1
 9399                           ;
 9400                           ;       entry:
 9401                           ;               fac = x
 9402                           ;
 9403                           ;       exit:          x
 9404                           ;               fac = e  - 1
 9405                           ;               CF = 1 if invalid result (nan, inf)
 9406                           ;
 9407                           ; For small magnitude values of x, expm1 may be more accurate than exp(x) - 1
 9408                           ;
 9409                           ; strategy:
 9410                           ;
 9411                           ;       Range reduction is accomplished by separating the argument x into
 9412                           ;       an integer M and a fraction f such that:
 9413                           ;
 9414                           ;                x     f    M
 9415                           ;               e   = e  * 2    where |f| < 0.5 * log (2)
 9416                           ;                                                    e
 9417                           ;                                                        f
 9418                           ;       A rational function is then used to approximate e  - 1 in
 9419                           ;       the basic range [-0.5 * log (2), +0.5 * log (2)]:
 9420                           ;                                  e               e
 9421                           ;
 9422                           ;                f               2    3  P(f)        f
  Tue Jul 17 11:00:18 2018                                                                                               Page  122




 9423                           ;               e  - 1 = f + 0.5f  + f  ------ = y, e  = y + 1
 9424                           ;                                        Q(f)   
 9425                           ;
 9426                           ;       Finally, get the result scaling the approximate exponential of the
 9427                           ;       fraction by a power of two:
 9428                           ;
 9429                           ;                x    f    M             M
 9430                           ;               e  = e  * 2   = (y + 1)*2       so:
 9431                           ;
 9432                           ;                x             M    M
 9433                           ;               e  - 1 =  y * 2  + 2  - 1
 9434                           ;
 9435                           ;       computation mean time: 90ms at 4MHz
 9436                           ;
 9437                           ;------
 9438  F869BD                   fexpm1:
 9439                           ;------
 9440  F869BD  24 25                    bit     facst
 9441  F869BF  10 0B                    bpl     ?fv             ; fac is valid
 9442  F869C1  70 07                    bvs     ?er             ; fac=nan so return nan
 9443  F869C3  24 24                    bit     facsgn
 9444  F869C5  10 03                    bpl     ?er             ; fac=+inf so return +inf
 9445  F869C7  4C 32 4E         ?m1:    jmp     fldm1           ; fac=-inf so return -1
 9446  F869CA  38               ?er:    sec
 9447  F869CB  60                       rts
 9448  F869CC  20 26 4D         ?fv:    jsr     frndm
 9449  F869CF  24 24                    bit     facsgn
 9450  F869D1  30 0E                    bmi     ?xn             ; x is negative
 9451  F869D3  A9 04                    lda     #<maxln         ; check if argument can cause overflow
 9452  F869D5  A0 6F                    ldy     #>maxln
 9453  F869D7  20 5E 87                 jsr     fccmp
 9454  F869DA  30 0E                    bmi     ?ok             ; if x <= maxln then no overflow
 9455  F869DC  F0 0C                    beq     ?ok
 9456  F869DE  4C 7D 4E                 jmp     fldinf          ; overflow so return +inf
 9457  F869E1  A9 28            ?xn:    lda     #<mxm1          ; check if argument can cause underflow
 9458  F869E3  A0 6F                    ldy     #>mxm1
 9459  F869E5  20 5E 87                 jsr     fccmp
 9460  F869E8  30 DD                    bmi     ?m1             ; if x < mxm1 then underflow, return -1
 9461  F869EA  20 66 84         ?ok:    jsr     mvf_t0          ; tfr0=x
 9462  F869ED  A9 0B                    lda     #<lg2e          ; x*log2(e)
 9463  F869EF  A0 68                    ldy     #>lg2e
 9464  F869F1  20 D5 49                 jsr     fcmult
 9465  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 part
 9468  F869FD  20 78 4F                 jsr     uitrunc         ; convert to integer
 9469  F86A00                           ACC16
 9470  F86A00  C2 20                    rep     #PMFLAG
 9471                                   .LONGA  on
 9472                                   .MNLIST
 9473  F86A02  A5 00                    lda     tm
 9474  F86A04  A6 24                    ldx     facsgn          ; sign of M
 9475  F86A06  10 04                    bpl     ?mp
 9476  F86A08  49 FF FF                 eor     #$FFFF
 9477  F86A0B  1A                       inc     a
 9478  F86A0C  85 46            ?mp:    sta     scexp           ; scexp=M (for final scaling)
 9479  F86A0E                           ACC08
  Tue Jul 17 11:00:18 2018                                                                                               Page  123




 9480  F86A0E  E2 20                    sep     #PMFLAG
 9481                                   .LONGA  off
 9482                                   .MNLIST
 9483  F86A10  20 74 85                 jsr     mvt1_f          
 9484  F86A13  A9 8D                    lda     #<ln2c1         ; remainder times loge(2) 
 9485  F86A15  A0 67                    ldy     #>ln2c1
 9486  F86A17  20 D5 49                 jsr     fcmult
 9487  F86A1A  20 CE 85                 jsr     mvt0_a
 9488  F86A1D  20 5F 45                 jsr     fpsub
 9489  F86A20  20 66 84                 jsr     mvf_t0
 9490  F86A23  20 74 85                 jsr     mvt1_f  
 9491  F86A26  A9 9F                    lda     #<ln2c2
 9492  F86A28  A0 67                    ldy     #>ln2c2
 9493  F86A2A  20 D5 49                 jsr     fcmult
 9494  F86A2D  20 CE 85                 jsr     mvt0_a
 9495  F86A30  20 5F 45                 jsr     fpsub
 9496  F86A33  20 66 84                 jsr     mvf_t0          ; tfr0=f=fraction
 9497  F86A36  20 CC 49                 jsr     fsquare
 9498  F86A39  20 93 84                 jsr     mvf_t1          ; tfr1=f*f
 9499  F86A3C  A9 E4                    lda     #<cem1p
 9500  F86A3E  A0 6D                    ldy     #>cem1p
 9501  F86A40  A2 07                    ldx     #7
 9502  F86A42  20 1C 87                 jsr     peval           ; evaluate P(f)
 9503  F86A45  20 FB 85                 jsr     mvt1_a
 9504  F86A48  20 DD 49                 jsr     fpmult          ; f*f*P(f)
 9505  F86A4B  20 CE 85                 jsr     mvt0_a
 9506  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     #<cem1q
 9509  F86A56  A0 6E                    ldy     #>cem1q
 9510  F86A58  A2 07                    ldx     #7
 9511  F86A5A  20 3A 87                 jsr     pevalp1         ; evaluate Q(f)
 9512  F86A5D  20 28 86                 jsr     mvt2_a
 9513  F86A60  20 10 4A                 jsr     fpdiv           ; f*f*f*P(f)/Q(f)
 9514  F86A63  20 FB 85                 jsr     mvt1_a          ; f*f
 9515  F86A66                           ACC16
 9516  F86A66  C2 20                    rep     #PMFLAG
 9517                                   .LONGA  on
 9518                                   .MNLIST
 9519  F86A68  A5 3A                    lda     argexp
 9520  F86A6A  F0 03                    beq     ?isz
 9521  F86A6C  3A                       dec     a
 9522  F86A6D  85 3A                    sta     argexp          ; f*f/2
 9523  F86A6F                   ?isz:   ACC08
 9524  F86A6F  E2 20                    sep     #PMFLAG
 9525                                   .LONGA  off
 9526                                   .MNLIST
 9527  F86A71  20 7D 45                 jsr     fpadd
 9528  F86A74  20 CE 85                 jsr     mvt0_a          ; arg=f
 9529  F86A77  20 7D 45                 jsr     fpadd
 9530  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=+1
 9532  F86A80  20 B7 48                 jsr     fscale          ; 2^M   
 9533  F86A83  20 93 84                 jsr     mvf_t1          ; tfr1=2^M
 9534  F86A86  20 CE 85                 jsr     mvt0_a          ; tfr0=y
 9535  F86A89  20 DD 49                 jsr     fpmult          ; y*2^M
 9536  F86A8C  20 66 84                 jsr     mvf_t0
  Tue Jul 17 11:00:18 2018                                                                                               Page  124




 9537  F86A8F  20 74 85                 jsr     mvt1_f          ; 2^M
 9538  F86A92  20 71 45                 jsr     fsubone         ; 2^M - 1
 9539  F86A95  20 CE 85                 jsr     mvt0_a
 9540  F86A98  4C 7D 45                 jmp     fpadd           ; y*2^M + 2^M - 1
 9541                           
 9542                           ; fpown - return the argument x raised to the nth power
 9543                           ;
 9544                           ;       entry:
 9545                           ;               fac = x
 9546                           ;               C = N (signed integer)
 9547                           ;
 9548                           ;       exit:          N
 9549                           ;               fac = x
 9550                           ;               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) = 28
 9555                           ;
 9556                           ;       computation mean time: max. 30ms at 4MHz
 9557                           ;
 9558                           ;-----
 9559  F86A9B                   fpown:
 9560                           ;-----
 9561  F86A9B  64 45                    stz     scsgn           ; assume positive N
 9562  F86A9D                           ACC16
 9563  F86A9D  C2 20                    rep     #PMFLAG
 9564                                   .LONGA  on
 9565                                   .MNLIST
 9566  F86A9F  89 00 80                 bit     #$8000
 9567  F86AA2  F0 08                    beq     ?np             ; N>=0
 9568  F86AA4  49 FF FF                 eor     #$FFFF          ; two's complement
 9569  F86AA7  1A                       inc     a
 9570  F86AA8  A2 80                    ldx     #$80
 9571  F86AAA  86 45                    stx     scsgn           ; N<0
 9572  F86AAC  85 46            ?np:    sta     scexp           ; store N
 9573  F86AAE  09 00 00                 ora     #0
 9574  F86AB1                           ACC08
 9575  F86AB1  E2 20                    sep     #PMFLAG
 9576                                   .LONGA  off
 9577                                   .MNLIST
 9578  F86AB3  D0 04                    bne     ?nz
 9579  F86AB5  A9 40                    lda     #$40
 9580  F86AB7  04 45                    tsb     scsgn           ; flag: N=0
 9581  F86AB9  24 25            ?nz:    bit     facst           ; fac test
 9582  F86ABB  10 1B                    bpl     ?fv             ; fac is valid
 9583  F86ABD  70 11                    bvs     ?er             ; fac=nan, so return nan
 9584  F86ABF  24 45                    bit     scsgn
 9585  F86AC1  70 12                    bvs     ?p1             ; fac=inf: if N=0 return 1
 9586  F86AC3  30 0D                    bmi     ?zz             ; fac=inf, N<0, so return zero
 9587  F86AC5  24 24                    bit     facsgn
 9588  F86AC7  10 07                    bpl     ?er             ; +inf raised to +n, so return +inf
 9589  F86AC9  A5 46                    lda     scexp           ; test if N is odd
 9590  F86ACB  4A                       lsr     a
 9591  F86ACC  B0 02                    bcs     ?er             ; fac=-inf, N is odd, so return -inf
 9592  F86ACE  64 24                    stz     facsgn          ; fac=-inf, N is even, so return +inf
 9593  F86AD0  38               ?er:    sec                     ; exit with invalid flag (nar or inf)
  Tue Jul 17 11:00:18 2018                                                                                               Page  125




 9594  F86AD1  60               ?rts:   rts
 9595  F86AD2  4C 56 4E         ?zz:    jmp     fldz            ; set fac=0 and exit
 9596  F86AD5  4C 2E 4E         ?p1:    jmp     fldp1           ; set fac=1 and exit
 9597  F86AD8  24 45            ?fv:    bit     scsgn
 9598  F86ADA  70 F9                    bvs     ?p1             ; fac is valid, N=0, so return 1
 9599  F86ADC  A5 24                    lda     facsgn
 9600  F86ADE  85 4A                    sta     dsgn            ; save fac sign and result sign
 9601  F86AE0  64 24                    stz     facsgn          ; fac=|x|
 9602  F86AE2  20 66 84                 jsr     mvf_t0          ; tfr0=w=|x|
 9603  F86AE5  A5 46                    lda     scexp
 9604  F86AE7  4A                       lsr     a
 9605  F86AE8  B0 05                    bcs     ?go             ; N is odd, set y=|x|
 9606  F86AEA  20 2E 4E                 jsr     fldp1           ; N is even so set y=1
 9607  F86AED  64 4A                    stz     dsgn            ; N is even so result is positive 
 9608  F86AEF  20 93 84         ?go:    jsr     mvf_t1          ; tfro=y
 9609  F86AF2                   ?ll:    ACC16
 9610  F86AF2  C2 20                    rep     #PMFLAG
 9611                                   .LONGA  on
 9612                                   .MNLIST
 9613  F86AF4  46 46                    lsr     scexp           ; shift N
 9614  F86AF6                           ACC08
 9615  F86AF6  E2 20                    sep     #PMFLAG
 9616                                   .LONGA  off
 9617                                   .MNLIST
 9618  F86AF8  F0 1D                    beq     ?eol            ; end of loop
 9619  F86AFA  08                       php
 9620  F86AFB  20 47 85                 jsr     mvt0_f          ; w
 9621  F86AFE  20 CC 49                 jsr     fsquare         ; w=w*w, arg to the 2-to-the-kth power
 9622  F86B01  B0 13                    bcs     ?of             ; overflow
 9623  F86B03  20 66 84                 jsr     mvf_t0          ; tfr0=w
 9624  F86B06  28                       plp
 9625  F86B07  90 E9                    bcc     ?ll             ; loop
 9626  F86B09  20 FB 85                 jsr     mvt1_a          ; y (include in product if N odd)
 9627  F86B0C  20 DD 49                 jsr     fpmult
 9628  F86B0F  B0 05                    bcs     ?of             ; overflow
 9629  F86B11  20 93 84                 jsr     mvf_t1          ; tfr1=y
 9630  F86B14  80 DC                    bra     ?ll             ; loop
 9631  F86B16  28               ?of:    plp
 9632  F86B17  A5 4A            ?eol:   lda     dsgn            ; set fac sign
 9633  F86B19  85 24                    sta     facsgn
 9634  F86B1B  18                       clc
 9635  F86B1C  24 25                    bit     facst
 9636  F86B1E  10 01                    bpl     ?ok
 9637  F86B20  38                       sec                     ; fac=inf
 9638  F86B21  24 45            ?ok:    bit     scsgn
 9639  F86B23  10 AC                    bpl     ?rts            ; done if N>0
 9640  F86B25  B0 AB                    bcs     ?zz             ; y=inf so return 0
 9641  F86B27  20 A6 4E                 jsr     ldaone
 9642  F86B2A  4C 10 4A                 jmp     fpdiv           ; y=1/y
 9643                           
 9644                           ; frootn - return the nth root of the argument
 9645                           ;
 9646                           ;       entry:
 9647                           ;               fac = x
 9648                           ;               C = N (integer, N>0)
 9649                           ;
 9650                           ;       exit:                       1/N
  Tue Jul 17 11:00:18 2018                                                                                               Page  126




 9651                           ;               fac = nthroot(x) = x
 9652                           ;               CF = 1 if invalid result (nan, inf)
 9653                           ;
 9654                           ; method:
 9655                           ;
 9656                           ;        1/N      log2(x)/N
 9657                           ;       x     =  2
 9658                           ; 
 9659                           ;       computation mean time: 140ms at 4MHz
 9660                           ;
 9661                           ;------
 9662  F86B2D                   frootn:
 9663                           ;------
 9664  F86B2D  64 45                    stz     scsgn           ; assume N even
 9665  F86B2F                           ACC16
 9666  F86B2F  C2 20                    rep     #PMFLAG
 9667                                   .LONGA  on
 9668                                   .MNLIST
 9669  F86B31  89 00 80                 bit     #$8000
 9670  F86B34  F0 06                    beq     ?pos            ; N>=0
 9671  F86B36  49 FF FF                 eor     #$FFFF          ; two's complement
 9672  F86B39  1A                       inc     a
 9673  F86B3A  A2 FF                    ldx     #$FF            ; N<0
 9674  F86B3C  85 46            ?pos:   sta     scexp           ; store N
 9675  F86B3E  09 00 00                 ora     #0
 9676  F86B41                           ACC08
 9677  F86B41  E2 20                    sep     #PMFLAG
 9678                                   .LONGA  off
 9679                                   .MNLIST
 9680  F86B43  F0 03                    beq     ?nan            ; return nan if N=0
 9681  F86B45  E8                       inx                     ; return nan if N<0
 9682  F86B46  D0 03                    bne     ?ok
 9683  F86B48  4C 74 4E         ?nan:   jmp     fldnan          
 9684  F86B4B  4A               ?ok:    lsr     a               ; N odd?
 9685  F86B4C  90 04                    bcc     ?ev             ; no
 9686  F86B4E  A9 FF                    lda     #$FF
 9687  F86B50  85 45                    sta     scsgn           ; flag N odd
 9688  F86B52  24 25            ?ev:    bit     facst           ; fac test
 9689  F86B54  10 0C                    bpl     ?fv             ; fac is valid
 9690  F86B56  70 08                    bvs     ?er             ; fac=nan, so return nan
 9691  F86B58  24 24                    bit     facsgn
 9692  F86B5A  10 04                    bpl     ?er             ; fac=+inf so return +inf
 9693  F86B5C  24 45                    bit     scsgn           ; if N is even and fac=-inf...
 9694  F86B5E  50 E8                    bvc     ?nan            ; ...return nan
 9695  F86B60  38               ?er:    sec                     ; exit with invalid flag (nar or inf)
 9696  F86B61  60                       rts
 9697  F86B62  50 03            ?fv:    bvc     ?nz             ; fac <> 0
 9698  F86B64  4C 56 4E         ?z:     jmp     fldz            ; if fac=0 return 0     
 9699  F86B67  A5 24            ?nz:    lda     facsgn
 9700  F86B69  10 04                    bpl     ?gte0
 9701  F86B6B  24 45                    bit     scsgn           ; if fac<0 and N is even...
 9702  F86B6D  50 D9                    bvc     ?nan            ; ...return nan         
 9703  F86B6F  85 4A            ?gte0:  sta     dsgn
 9704  F86B71                           ACC16
 9705  F86B71  C2 20                    rep     #PMFLAG
 9706                                   .LONGA  on
 9707                                   .MNLIST
  Tue Jul 17 11:00:18 2018                                                                                               Page  127




 9708  F86B73  A5 46                    lda     scexp
 9709  F86B75  C9 01 00                 cmp     #1
 9710  F86B78                           ACC08
 9711  F86B78  E2 20                    sep     #PMFLAG
 9712                                   .LONGA  off
 9713                                   .MNLIST
 9714  F86B7A  18                       clc
 9715  F86B7B  F0 2E                    beq     ?rts    
 9716  F86B7D  64 24                    stz     facsgn          ; fac=|x|
 9717  F86B7F  A5 4A                    lda     dsgn
 9718  F86B81  48                       pha                     ; save fac sign and result sign
 9719  F86B82  A5 47                    lda     scexp+1
 9720  F86B84  48                       pha
 9721  F86B85  A5 46                    lda     scexp
 9722  F86B87  48                       pha
 9723  F86B88  20 6B 63                 jsr     flog2           ; log2(x)
 9724  F86B8B  90 06                    bcc     ?ok2
 9725  F86B8D  24 24                    bit     facsgn
 9726  F86B8F  10 1A                    bpl     ?rts
 9727  F86B91  30 D1                    bmi     ?z              ; returns zero
 9728  F86B93  20 C0 84         ?ok2:   jsr     mvf_t2
 9729  F86B96  68                       pla                     ; scexp low
 9730  F86B97  7A                       ply                     ; scexp high
 9731  F86B98  20 5B 4F                 jsr     fldu16          ; convert N to float
 9732  F86B9B  68                       pla
 9733  F86B9C  85 4A                    sta     dsgn            ; sign of the result
 9734  F86B9E  20 28 86                 jsr     mvt2_a          ; log2(x)
 9735  F86BA1  20 10 4A                 jsr     fpdiv           ; log2(x)/N
 9736  F86BA4  20 1D 68                 jsr     fexp2           ; exp2(...)
 9737  F86BA7  A5 4A                    lda     dsgn
 9738  F86BA9  85 24                    sta     facsgn
 9739  F86BAB  60               ?rts:   rts     
 9740                           
 9741                           ; fpowxy - return x raised to the yth power
 9742                           ;
 9743                           ;       entry:
 9744                           ;               fac = y
 9745                           ;               arg = x
 9746                           ;
 9747                           ;       exit:          y
 9748                           ;               fac = x
 9749                           ;               CF = 1 if invalid result (nan, inf)
 9750                           ;
 9751                           ; method:
 9752                           ;       1) for noninteger y or |y|>32767
 9753                           ;
 9754                           ;                y        y*log2(x)
 9755                           ;               x     =  2
 9756                           ;
 9757                           ;       2) for integer y, |y|<32768:
 9758                           ;
 9759                           ;                y
 9760                           ;               x     = fpown(x, y)
 9761                           ;
 9762                           ;       computation mean time: max 200ms at 4MHz
 9763                           ;
 9764                           ;------
  Tue Jul 17 11:00:18 2018                                                                                               Page  128




 9765  F86BAC                   fpowxy:
 9766                           ;------
 9767  F86BAC  A9 C0                    lda     #$C0            ; if x=nan or y=nan, return nan
 9768  F86BAE  C5 3D                    cmp     argst
 9769  F86BB0  F0 48                    beq     ?nan
 9770  F86BB2  C5 25                    cmp     facst
 9771  F86BB4  F0 44                    beq     ?nan
 9772  F86BB6  64 4B                    stz     powfg
 9773  F86BB8  24 25                    bit     facst
 9774  F86BBA  30 72                    bmi     ?yinf           ; y=+/-inf
 9775  F86BBC  70 3F                    bvs     ?1              ; if y=0 return +1
 9776  F86BBE                           
 9777                                   ; here y is valid and not zero
 9778  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&fac
 9780  F86BC3  A9 80                    lda     #$80
 9781  F86BC5  85 4B                    sta     powfg           ; powfg<7>: y is integer
 9782  F86BC7  20 78 4F                 jsr     uitrunc         ; get w as 128 bit integer
 9783  F86BCA                           ACC16
 9784  F86BCA  C2 20                    rep     #PMFLAG
 9785                                   .LONGA  on
 9786                                   .MNLIST
 9787  F86BCC  A5 0E                    lda     tm+14
 9788  F86BCE  05 0C                    ora     tm+12
 9789  F86BD0  05 0A                    ora     tm+10
 9790  F86BD2  05 08                    ora     tm+8
 9791  F86BD4  05 06                    ora     tm+6
 9792  F86BD6  05 04                    ora     tm+4
 9793  F86BD8  05 02                    ora     tm+2
 9794  F86BDA  D0 27                    bne     ?ibig           ; y is a big integer
 9795  F86BDC  A5 00                    lda     tm
 9796  F86BDE  C9 00 80                 cmp     #32768
 9797  F86BE1  B0 20                    bcs     ?ibig           ; |w|>=32768, is a big integer
 9798  F86BE3  A6 24                    ldx     facsgn          ; w sign
 9799  F86BE5  10 04                    bpl     ?pp             ; w>0
 9800  F86BE7  49 FF FF                 eor     #$FFFF          ; two's complement
 9801  F86BEA  1A                       inc     a
 9802  F86BEB  85 48            ?pp:    sta     dexp
 9803  F86BED                           ACC08
 9804  F86BED  E2 20                    sep     #PMFLAG
 9805                                   .LONGA  off
 9806                                   .MNLIST
 9807  F86BEF  20 47 85                 jsr     mvt0_f          ; fac=x
 9808  F86BF2  A5 49                    lda     dexp+1          ; y is integer and |y|<32768...
 9809  F86BF4  EB                       xba
 9810  F86BF5  A5 48                    lda     dexp
 9811  F86BF7  4C 9B 6A                 jmp     fpown           ; ...so call fpown
 9812  F86BFA  4C 74 4E         ?nan:   jmp     fldnan          ; return nan
 9813  F86BFD  4C 2E 4E         ?1:     jmp     fldp1           ; return +1
 9814  F86C00  4C 56 4E         ?z:     jmp     fldz            ; return 0
 9815  F86C03                   ?ibig:  ACC08                   ; y is a big integer and we check if... 
 9816  F86C03  E2 20                    sep     #PMFLAG
 9817                                   .LONGA  off
 9818                                   .MNLIST
 9819                                                           ; ...is odd or even
 9820  F86C05  20 74 85                 jsr     mvt1_f          ; restore fac=y
 9821  F86C08  A9 FF                    lda     #$FF
  Tue Jul 17 11:00:18 2018                                                                                               Page  129




 9822  F86C0A  85 46                    sta     scexp
 9823  F86C0C  85 47                    sta     scexp+1         ; scexp=-1
 9824  F86C0E  20 B7 48                 jsr     fscale          ; w=y/2
 9825  F86C11  20 27 50                 jsr     floor           ; w=floor(y/2)
 9826  F86C14  A9 01                    lda     #1
 9827  F86C16  85 46                    sta     scexp
 9828  F86C18  64 47                    stz     scexp+1         ; scexp=1
 9829  F86C1A  20 B7 48                 jsr     fscale          ; w*2 = 2*floor(y/2)
 9830  F86C1D                           
 9831                                   ; if 2*floor(y/2) != y then y is an odd integer
 9832  F86C1D  20 DF 6C                 jsr     ?cpy            ; compare y vs. 2*floor(y/2)
 9833  F86C20  F0 04                    beq     ?rst            ; y is an even integer
 9834  F86C22  A9 40                    lda     #$40
 9835  F86C24  04 4B                    tsb     powfg           ; powfg<6>: odd integer flag
 9836  F86C26  20 CE 85         ?rst:   jsr     mvt0_a          ; restore arg=x
 9837  F86C29  20 74 85                 jsr     mvt1_f          ; restore fac=y
 9838  F86C2C  80 30                    bra     ?xtst           ; go to check x
 9839                           
 9840                           ?yinf:  ; y=+/-inf so check x
 9841  F86C2E  24 3D                    bit     argst
 9842  F86C30  10 0D                    bpl     ?xv             ; x is valid
 9843  F86C32  24 3C                    bit     argsgn
 9844  F86C34  30 C4                    bmi     ?nan            ; if x=-inf and y=+-inf return nan
 9845  F86C36  24 24                    bit     facsgn
 9846  F86C38  30 C6                    bmi     ?z              ; if x=+inf and y=-inf return 0
 9847                                                           ; if x=+inf and y=inf return +inf
 9848  F86C3A  64 24            ?pi:    stz     facsgn          ; return +inf
 9849  F86C3C  4C 7D 4E                 jmp     fldinf
 9850                           
 9851                           ?xv:    ; y=+/-inf and valid x
 9852  F86C3F  50 06                    bvc     ?nz             ; x<>0
 9853  F86C41  24 24                    bit     facsgn
 9854  F86C43  10 BB                    bpl     ?z              ; if x=0 and y=+inf return zero 
 9855  F86C45  30 F3                    bmi     ?pi             ; if x=0 and y=-inf return zero 
 9856                           
 9857                           ?nz:    ; y=+/-inf and x<>0
 9858  F86C47  24 3C                    bit     argsgn
 9859  F86C49  30 AF                    bmi     ?nan            ; if x<0 and y=+-inf return nan
 9860  F86C4B  20 B5 6C                 jsr     ?is1            ; check if |x|=1
 9861  F86C4E  F0 AA                    beq     ?nan            ; if |x|=1 and y=+/-inf return nan
 9862  F86C50  90 06                    bcc     ?xm             ; |x|<1
 9863  F86C52  24 24                    bit     facsgn
 9864  F86C54  10 E4                    bpl     ?pi             ; if |x|>1 and y=+inf return +inf
 9865  F86C56  30 A8                    bmi     ?z              ; if |x|>1 and y=-inf return 0
 9866  F86C58  24 24            ?xm:    bit     facsgn
 9867  F86C5A  10 A4                    bpl     ?z              ; if |x|<1 and y=+inf return 0
 9868  F86C5C  30 DC                    bmi     ?pi             ; if |x|<1 and y=-inf return +inf
 9869                           
 9870                           ?xtst:  ; here y is valid and y <> 0 so we check x
 9871  F86C5E  24 3D                    bit     argst
 9872  F86C60  10 17                    bpl     ?xv2            ; x is valid
 9873  F86C62  24 3C                    bit     argsgn
 9874  F86C64  30 06                    bmi     ?xmi            ; x=-inf
 9875  F86C66  24 24                    bit     facsgn
 9876  F86C68  10 D0                    bpl     ?pi             ; if x=+inf and y>0 return +inf
 9877  F86C6A  30 94                    bmi     ?z              ; if x=+inf and y<0 return 0
 9878                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  130




 9879                           ?xmi:   ; x=-inf -- check if y is odd integer
 9880  F86C6C  A5 4B                    lda     powfg
 9881  F86C6E  C9 C0                    cmp     #$C0            ; y must be odd integer
 9882  F86C70  D0 88                    bne     ?nan
 9883  F86C72  A9 FF                    lda     #$FF            ; x=-inf and y is an odd integer...
 9884  F86C74  85 24                    sta     facsgn
 9885  F86C76  4C 7D 4E                 jmp     fldinf          ; ...so return -inf
 9886  F86C79                           
 9887                           ?xv2:   ; now both x and y are valid
 9888  F86C79  50 06                    bvc     ?xv3            ; x<>0
 9889  F86C7B  24 24                    bit     facsgn
 9890  F86C7D  10 81                    bpl     ?z              ; if x=0 and y>0 return 0
 9891  F86C7F  30 B9                    bmi     ?pi             ; if x=0 and y<0 return +inf
 9892  F86C81  24 3C            ?xv3:   bit     argsgn
 9893  F86C83  10 0F                    bpl     ?xv4            ; x>0
 9894  F86C85  A5 4B                    lda     powfg
 9895  F86C87  C9 C0                    cmp     #$C0            ; if x<0, y must be odd integer
 9896  F86C89  F0 03                    beq     ?xv30
 9897  F86C8B  4C 74 4E                 jmp     fldnan
 9898  F86C8E  A9 01            ?xv30:  lda     #1
 9899  F86C90  04 4B                    tsb     powfg           ; powfg<0>: x change sign
 9900  F86C92  64 3C                    stz     argsgn          ; |x|
 9901  F86C94  20 ED 84         ?xv4:   jsr     mvf_t3          ; tfr3=y
 9902  F86C97  20 0C 84                 jsr     mvatof          ; fac=x
 9903  F86C9A  20 6B 63                 jsr     flog2           ; log2(x)
 9904  F86C9D  B0 0B                    bcs     ?end
 9905  F86C9F  20 55 86                 jsr     mvt3_a          ; arg=y
 9906  F86CA2  20 DD 49                 jsr     fpmult          ; y*log2(x)
 9907  F86CA5  B0 03                    bcs     ?end
 9908  F86CA7  20 1D 68                 jsr     fexp2           ; 2^(y*log2(x))
 9909  F86CAA  46 4B            ?end:   lsr     powfg
 9910  F86CAC  90 06                    bcc     ?e2
 9911  F86CAE  A5 24                    lda     facsgn          ; change sign to result
 9912  F86CB0  49 FF                    eor     #$FF
 9913  F86CB2  85 24                    sta     facsgn
 9914  F86CB4  60               ?e2:    rts
 9915                           
 9916                           ?is1:   ; check if |arg|=1
 9917  F86CB5                           ACC16
 9918  F86CB5  C2 20                    rep     #PMFLAG
 9919                                   .LONGA  on
 9920                                   .MNLIST
 9921  F86CB7  A5 3A                    lda     argexp
 9922  F86CB9  C9 FF 3F                 cmp     #EBIAS
 9923  F86CBC  D0 15                    bne     ?is0            ; is not 1 (CF=1 if |arg|>=1)
 9924  F86CBE  A5 38                    lda     argm+14
 9925  F86CC0  C9 00 80                 cmp     #$8000
 9926  F86CC3  D0 0E                    bne     ?is0            ; is not 1
 9927  F86CC5  A5 2A                    lda     argm
 9928  F86CC7  05 2C                    ora     argm+2
 9929  F86CC9  05 2E                    ora     argm+4
 9930  F86CCB  05 30                    ora     argm+6
 9931  F86CCD  05 32                    ora     argm+8
 9932  F86CCF  05 34                    ora     argm+10
 9933  F86CD1  05 36                    ora     argm+12
 9934  F86CD3                   ?is0:   ACC08
 9935  F86CD3  E2 20                    sep     #PMFLAG
  Tue Jul 17 11:00:18 2018                                                                                               Page  131




 9936                                   .LONGA  off
 9937                                   .MNLIST
 9938  F86CD5  60                       rts                     ; ZF=1 if |arg|=1, CF=1 if |arg|>=1
 9939                           
 9940  F86CD6  20 1A 85         ?yint:  jsr     mva_t0          ; tfr0=x
 9941  F86CD9  20 93 84                 jsr     mvf_t1          ; tfr1=y
 9942  F86CDC  20 27 50                 jsr     floor           ; get the integral part of y
 9943  F86CDF                           
 9944                           ?cpy:   ; compare fac vs. y/tfr1 (just for equality)
 9945  F86CDF                           ACC16
 9946  F86CDF  C2 20                    rep     #PMFLAG
 9947                                   .LONGA  on
 9948                                   .MNLIST
 9949  F86CE1  A5 12                    lda     facm
 9950  F86CE3  C5 64                    cmp     tfr1
 9951  F86CE5  D0 34                    bne     ?cp0
 9952  F86CE7  A5 14                    lda     facm+2
 9953  F86CE9  C5 66                    cmp     tfr1+2
 9954  F86CEB  D0 2E                    bne     ?cp0
 9955  F86CED  A5 16                    lda     facm+4
 9956  F86CEF  C5 68                    cmp     tfr1+4
 9957  F86CF1  D0 28                    bne     ?cp0
 9958  F86CF3  A5 18                    lda     facm+6
 9959  F86CF5  C5 6A                    cmp     tfr1+6
 9960  F86CF7  D0 22                    bne     ?cp0
 9961  F86CF9  A5 1A                    lda     facm+8
 9962  F86CFB  C5 6C                    cmp     tfr1+8
 9963  F86CFD  D0 1C                    bne     ?cp0
 9964  F86CFF  A5 1C                    lda     facm+10
 9965  F86D01  C5 6E                    cmp     tfr1+10
 9966  F86D03  D0 16                    bne     ?cp0
 9967  F86D05  A5 1E                    lda     facm+12
 9968  F86D07  C5 70                    cmp     tfr1+12
 9969  F86D09  D0 10                    bne     ?cp0
 9970  F86D0B  A5 20                    lda     facm+14
 9971  F86D0D  C5 72                    cmp     tfr1+14
 9972  F86D0F  D0 0A                    bne     ?cp0
 9973  F86D11  A5 22                    lda     facm+16
 9974  F86D13  C5 74                    cmp     tfr1+16
 9975  F86D15  D0 04                    bne     ?cp0
 9976  F86D17  A5 24                    lda     facm+18
 9977  F86D19  C5 76                    cmp     tfr1+18
 9978  F86D1B                   ?cp0:   ACC08
 9979  F86D1B  E2 20                    sep     #PMFLAG
 9980                                   .LONGA  off
 9981                                   .MNLIST
 9982  F86D1D  60                       rts                     ; ZF=1 if equal
 9983                           
 9984                           ; coefficients for exp() evaluation
 9985  F86D1E                   ceep:
 9986                           ; P[4] = 3.279723985560247033712687707263393506266E-10
 9987  F86D1E  44 59 3A 65 81           .DB     $44,$59,$3A,$65,$81,$28,$53,$8A,$47
               28 53 8A 47 
 9988  F86D27  FE AA B3 F9 02           .DB     $FE,$AA,$B3,$F9,$02,$4E,$B4,$DF,$3F
               4E B4 DF 3F 
 9989                           ; P[3] =  6.141506007208645008909088812338454698548E-7
 9990  F86D30  B0 71 8E FB B2           .DB     $B0,$71,$8E,$FB,$B2,$D2,$28,$E7,$FF
  Tue Jul 17 11:00:18 2018                                                                                               Page  132




               D2 28 E7 FF 
 9991  F86D39  4A 4C 8E A0 1B           .DB     $4A,$4C,$8E,$A0,$1B,$DC,$A4,$EA,$3F
               DC A4 EA 3F 
 9992                           ; P[2] =  2.708775201978218837374512615596512792224E-4
 9993  F86D42  B6 9E 58 BA 61           .DB     $B6,$9E,$58,$BA,$61,$BA,$82,$D8,$A0
               BA 82 D8 A0 
 9994  F86D4B  31 FA 48 B9 90           .DB     $31,$FA,$48,$B9,$90,$04,$8E,$F3,$3F
               04 8E F3 3F 
 9995                           ; P[1] =  3.508710990737834361215404761139478627390E-2
 9996  F86D54  D4 0F B2 5C 74           .DB     $D4,$0F,$B2,$5C,$74,$7D,$79,$81,$28
               7D 79 81 28 
 9997  F86D5D  BF 78 03 59 80           .DB     $BF,$78,$03,$59,$80,$B7,$8F,$FA,$3F
               B7 8F FA 3F 
 9998                           ; P[0] =  1 
 9999  F86D66  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
10000  F86D6F  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$80,$FF,$3F
               00 80 FF 3F 
10001                           
10002  F86D78                   ceeq:
10003                           ; Q[5] =  2.980756652081995192255342779918052538681E-12
10004  F86D78  AA EB 58 3C C8           .DB     $AA,$EB,$58,$3C,$C8,$65,$82,$7C,$65
               65 82 7C 65 
10005  F86D81  FB 7E D8 C6 89           .DB     $FB,$7E,$D8,$C6,$89,$C0,$D1,$D8,$3F
               C0 D1 D8 3F 
10006                           ; Q[4] =  1.771372078166251484503904874657985291164E-8
10007  F86D8A  F5 58 96 76 83           .DB     $F5,$58,$96,$76,$83,$9C,$A6,$21,$0D
               9C A6 21 0D 
10008  F86D93  1B F5 F8 49 E2           .DB     $1B,$F5,$F8,$49,$E2,$28,$98,$E5,$3F
               28 98 E5 3F 
10009                           ; Q[3] =  1.504792651814944826817779302637284053660E-5
10010  F86D9C  AE 5F 82 3D 77           .DB     $AE,$5F,$82,$3D,$77,$DC,$F3,$E4,$70
               DC F3 E4 70 
10011  F86DA5  24 62 3D 2E 5A           .DB     $24,$62,$3D,$2E,$5A,$76,$FC,$EE,$3F
               76 FC EE 3F 
10012                           ; Q[2] =  3.611828913847589925056132680618007270344E-3
10013  F86DAE  68 61 9E E9 6E           .DB     $68,$61,$9E,$E9,$6E,$9C,$AE,$2E,$1E
               9C AE 2E 1E 
10014  F86DB7  D4 1F 50 10 6F           .DB     $D4,$1F,$50,$10,$6F,$B4,$EC,$F6,$3F
               B4 EC F6 3F 
10015                           ; Q[1] =  2.368408864814233538909747618894558968880E-1
10016  F86DC0  76 96 FC D8 64           .DB     $76,$96,$FC,$D8,$64,$69,$67,$EB,$3E
               69 67 EB 3E 
10017  F86DC9  0A 67 2C D7 6A           .DB     $0A,$67,$2C,$D7,$6A,$86,$F2,$FC,$3F
               86 F2 FC 3F 
10018                           ; Q[0] =  2
10019  F86DD2  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
10020  F86DDB  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$80,$00,$40
               00 80 00 40 
10021                           
10022                           ; coefficients for expm1() evaluation
10023  F86DE4                   cem1p:
10024                           ; MP[7] = -4.888737542888633647784737721812546636240E-1
10025  F86DE4  52 E5 66 71 85           .DB     $52,$E5,$66,$71,$85,$3C,$04,$05,$0D
               3C 04 05 0D 
10026  F86DED  8F 39 16 25 A9           .DB     $8F,$39,$16,$25,$A9,$4D,$FA,$FD,$BF
  Tue Jul 17 11:00:18 2018                                                                                               Page  133




               4D FA FD BF 
10027                           ; MP[6] = 4.401308817383362136048032038528753151144E1
10028  F86DF6  84 22 38 E7 E0           .DB     $84,$22,$38,$E7,$E0,$BC,$D7,$D9,$5B
               BC D7 D9 5B 
10029  F86DFF  AE 51 7A FC 66           .DB     $AE,$51,$7A,$FC,$66,$0D,$B0,$04,$40
               0D B0 04 40 
10030                           ; MP[5] = -1.716772506388927649032068540558788106762E3
10031  F86E08  44 3A 92 A3 59           .DB     $44,$3A,$92,$A3,$59,$97,$98,$46,$5F
               97 98 46 5F 
10032  F86E11  A6 8C 51 5F B8           .DB     $A6,$8C,$51,$5F,$B8,$98,$D6,$09,$C0
               98 D6 09 C0 
10033                           ; MP[4] = 4.578962475841642634225390068461943438441E4
10034  F86E1A  C3 21 E0 44 63           .DB     $C3,$21,$E0,$44,$63,$32,$45,$02,$AF
               32 45 02 AF 
10035  F86E23  73 E6 2A F0 9F           .DB     $73,$E6,$2A,$F0,$9F,$DD,$B2,$0E,$40
               DD B2 0E 40 
10036                           ; MP[3] = -7.212432713558031519943281748462837065308E5
10037  F86E2C  12 EA 50 4A 6C           .DB     $12,$EA,$50,$4A,$6C,$00,$52,$CF,$E1
               00 52 CF E1 
10038  F86E35  C1 2E 79 57 B4           .DB     $C1,$2E,$79,$57,$B4,$15,$B0,$12,$C0
               15 B0 12 C0 
10039                           ; MP[2] = 8.944630806357575461578107295909719817253E6
10040  F86E3E  20 48 52 E0 BA           .DB     $20,$48,$52,$E0,$BA,$5E,$BC,$44,$7D
               5E BC 44 7D 
10041  F86E47  37 73 6D CE F6           .DB     $37,$73,$6D,$CE,$F6,$7B,$88,$16,$40
               7B 88 16 40 
10042                           ; MP[1] = -5.722847283900608941516165725053359168840E7
10043  F86E50  7C BD E1 4B F3           .DB     $7C,$BD,$E1,$4B,$F3,$59,$CC,$B5,$CB
               59 CC B5 CB 
10044  F86E59  98 46 B2 35 2E           .DB     $98,$46,$B2,$35,$2E,$4F,$DA,$18,$C0
               4F DA 18 C0 
10045                           ; MP[0] = 2.943520915569954073888921213330863757240E8
10046  F86E62  12 F3 2E 3D 05           .DB     $12,$F3,$2E,$3D,$05,$16,$56,$0F,$16
               16 56 0F 16 
10047  F86E6B  02 BA 74 DC A6           .DB     $02,$BA,$74,$DC,$A6,$5B,$8C,$1B,$40
               5B 8C 1B 40 
10048                           
10049  F86E74                   cem1q:
10050                           ; MQ[7] = -8.802340681794263968892934703309274564037E1
10051  F86E74  5B 7E 65 0F E1           .DB     $5B,$7E,$65,$0F,$E1,$0C,$75,$92,$24
               0C 75 92 24 
10052  F86E7D  56 22 7B FA FB           .DB     $56,$22,$7B,$FA,$FB,$0B,$B0,$05,$C0
               0B B0 05 C0 
10053                           ; MQ[6] = 3.697714952261803935521187272204485251835E3
10054  F86E86  FE 14 1F B8 5A           .DB     $FE,$14,$1F,$B8,$5A,$2E,$44,$50,$D9
               2E 44 50 D9 
10055  F86E8F  62 6A C8 71 70           .DB     $62,$6A,$C8,$71,$70,$1B,$E7,$0A,$40
               1B E7 0A 40 
10056                           ; MQ[5] = -9.615511549171441430850103489315371768998E4
10057  F86E98  D6 13 D7 2D 65           .DB     $D6,$13,$D7,$2D,$65,$3A,$0E,$9C,$28
               3A 0E 9C 28 
10058  F86EA1  2F B8 6E C8 8E           .DB     $2F,$B8,$6E,$C8,$8E,$CD,$BB,$0F,$C0
               CD BB 0F C0 
10059                           ; MQ[4] = 1.682912729190313538934190635536631941751E6
10060  F86EAA  02 77 B9 68 7D           .DB     $02,$77,$B9,$68,$7D,$29,$95,$7B,$AD
               29 95 7B AD 
10061  F86EB3  29 BB 61 D5 05           .DB     $29,$BB,$61,$D5,$05,$6F,$CD,$13,$40
  Tue Jul 17 11:00:18 2018                                                                                               Page  134




               6F CD 13 40 
10062                           ; MQ[3] = -2.019684072836541751428967854947019415698E7
10063  F86EBC  CB B8 14 C8 CF           .DB     $CB,$B8,$14,$C8,$CF,$E5,$F5,$70,$E1
               E5 F5 70 E1 
10064  F86EC5  F7 13 3B 5D F4           .DB     $F7,$13,$3B,$5D,$F4,$16,$9A,$17,$C0
               16 9A 17 C0 
10065                           ; MQ[2] = 1.615869009634292424463780387327037251069E8
10066  F86ECE  1C 14 94 07 23           .DB     $1C,$14,$94,$07,$23,$62,$73,$13,$05
               62 73 13 05 
10067  F86ED7  C8 34 6A 4F ED           .DB     $C8,$34,$6A,$4F,$ED,$19,$9A,$1A,$40
               19 9A 1A 40 
10068                           ; MQ[1] = -7.848989743695296475743081255027098295771E8
10069  F86EE0  DC 5E 0D 28 3F           .DB     $DC,$5E,$0D,$28,$3F,$32,$AD,$EF,$DC
               32 AD EF DC 
10070  F86EE9  FA 65 7A 79 6E           .DB     $FA,$65,$7A,$79,$6E,$22,$BB,$1C,$C0
               22 BB 1C C0 
10071                           ; MQ[0] = 1.766112549341972444333352727998584753865E9
10072  F86EF2  D0 35 67 DC 07           .DB     $D0,$35,$67,$DC,$07,$21,$01,$17,$21
               21 01 17 21 
10073  F86EFB  03 17 AF 4A 7A           .DB     $03,$17,$AF,$4A,$7A,$89,$D2,$1D,$40
               89 D2 1D 40 
10074                           
10075                           ; maxln = 11356.523406294143949491931077970764
10076                           ; above this value, exp(x) overflow
10077  F86F04  00 80 F2 03 98   maxln:  .DB     $00,$80,$F2,$03,$98,$B3,$E3,$C9,$AB
               B3 E3 C9 AB 
10078  F86F0D  79 CF D1 F7 17           .DB     $79,$CF,$D1,$F7,$17,$72,$B1,$0C,$40
               72 B1 0C 40 
10079                           
10080                           ; minln = -1.143276959615573793352782661133116431383730e4
10081                           ; below this value, exp(x) underflow
10082  F86F16  45 C0 39 B1 F4   minln:  .DB     $45,$C0,$39,$B1,$F4,$B2,$26,$E9,$44
               B2 26 E9 44 
10083  F86F1F  16 C0 03 11 14           .DB     $16,$C0,$03,$11,$14,$A3,$B2,$0C,$C0
               A3 B2 0C C0 
10084                           
10085                           ; min. argument for expm1() -- below this value expm1() = -1 
10086                           ; mxm1 = loge(2^-114) = -7.9018778583833765273564461846232128760607E1
10087  F86F28  00 80 84 63 F3   mxm1:   .DB     $00,$80,$84,$63,$F3,$CB,$CE,$FF,$5C
               CB CE FF 5C 
10088  F86F31  C8 DC B6 58 9D           .DB     $C8,$DC,$B6,$58,$9D,$09,$9E,$05,$C0
               09 9E 05 C0 
10089                           
10090                           ; e = 2.7182818284590452353602874713526623  (35 digits)
10091  F86F3A  00 00 3D 27 20   ceul:   .DB     $00,$00,$3D,$27,$20,$56,$DC,$AF,$9A
               56 DC AF 9A 
10092  F86F43  4A BB A2 58 54           .DB     $4A,$BB,$A2,$58,$54,$F8,$AD,$00,$40
               F8 AD 00 40 
10093                           
10094                           ; coefficients for exp10() evaluation
10095  F86F4C                   ce10p:
10096                           ; P[5] = 6.781965388610215141646963666801877147888E1
10097  F86F4C  45 E4 3F 51 CF           .DB     $45,$E4,$3F,$51,$CF,$31,$82,$DB,$82
               31 82 DB 82 
10098  F86F55  33 B2 95 AC A9           .DB     $33,$B2,$95,$AC,$A9,$A3,$87,$05,$40
               A3 87 05 40 
10099                           ; P[4] = 4.930988843306627886355612005613845141123E4
  Tue Jul 17 11:00:18 2018                                                                                               Page  135




10100  F86F5E  D5 25 84 99 5A           .DB     $D5,$25,$84,$99,$5A,$EB,$62,$D1,$4B
               EB 62 D1 4B 
10101  F86F67  5A 74 59 70 E3           .DB     $5A,$74,$59,$70,$E3,$9D,$C0,$0E,$40
               9D C0 0E 40 
10102                           ; P[3] = 9.112966716416345527154611203937593471620E6
10103  F86F70  36 62 7E 7C 7A           .DB     $36,$62,$7E,$7C,$7A,$40,$20,$E5,$5B
               40 20 E5 5B 
10104  F86F79  C6 0F 67 B7 86           .DB     $C6,$0F,$67,$B7,$86,$0D,$8B,$16,$40
               0D 8B 16 40 
10105                           ; P[2] = 5.880306836049276068401249115246879608067E8
10106  F86F82  2E 0E F8 F9 5C           .DB     $2E,$0E,$F8,$F9,$5C,$1D,$B4,$4D,$7F
               1D B4 4D 7F 
10107  F86F8B  24 72 6B 6E 8B           .DB     $24,$72,$6B,$6E,$8B,$32,$8C,$1C,$40
               32 8C 1C 40 
10108                           ; P[1] = 1.294143447497151402129871056524193102276E10
10109  F86F94  63 CA AF 6C 10           .DB     $63,$CA,$AF,$6C,$10,$94,$56,$45,$25
               94 56 45 25 
10110  F86F9D  49 2D BE 9A A7           .DB     $49,$2D,$BE,$9A,$A7,$D7,$C0,$20,$40
               D7 C0 20 40 
10111                           ; P[0] = 6.737236378815985929063482575381049393067E10
10112  F86FA6  DC 96 E7 F7 15           .DB     $DC,$96,$E7,$F7,$15,$39,$D0,$93,$9D
               39 D0 93 9D 
10113  F86FAF  C8 8E C2 00 4B           .DB     $C8,$8E,$C2,$00,$4B,$FB,$FA,$22,$40
               FB FA 22 40 
10114                           
10115  F86FB8                   ce10q:
10116                           ; Q[5] = 2.269602544366008200564158516293459788943E3
10117  F86FB8  58 5C 11 75 0B           .DB     $58,$5C,$11,$75,$0B,$63,$2E,$D1,$F3
               63 2E D1 F3 
10118  F86FC1  4E A6 8F 05 A4           .DB     $4E,$A6,$8F,$05,$A4,$D9,$8D,$0A,$40
               D9 8D 0A 40 
10119                           ; Q[4] = 7.712352920905011963059413773034169405418E5
10120  F86FCA  18 FC B0 15 D1           .DB     $18,$FC,$B0,$15,$D1,$8B,$DA,$20,$C4
               8B DA 20 C4 
10121  F86FD3  E1 16 67 AC 34           .DB     $E1,$16,$67,$AC,$34,$4A,$BC,$12,$40
               4A BC 12 40 
10122                           ; Q[3] = 8.312829542416079818945631366865677745737E7
10123  F86FDC  22 3B 86 E2 A1           .DB     $22,$3B,$86,$E2,$A1,$37,$CF,$01,$8F
               37 CF 01 8F 
10124  F86FE5  AA B9 92 ED FC           .DB     $AA,$B9,$92,$ED,$FC,$8D,$9E,$19,$40
               8D 9E 19 40 
10125                           ; Q[2] = 3.192530874297321568824835872165913128965E9
10126  F86FEE  58 36 A6 B4 D3           .DB     $58,$36,$A6,$B4,$D3,$61,$82,$7F,$2E
               61 82 7F 2E 
10127  F86FF7  44 1D 4C BA 27           .DB     $44,$1D,$4C,$BA,$27,$4A,$BE,$1E,$40
               4A BE 1E 40 
10128                           ; Q[1] = 3.709588725051672862074295071447979432510E10
10129  F87000  D8 CE E2 0B 30           .DB     $D8,$CE,$E2,$0B,$30,$77,$F8,$EF,$3A
               77 F8 EF 3A 
10130  F87009  85 44 28 19 65           .DB     $85,$44,$28,$19,$65,$31,$8A,$22,$40
               31 8A 22 40 
10131                           ; Q[0] = 5.851889165195258152098281616369230806944E10
10132  F87012  58 7C 65 00 31           .DB     $58,$7C,$65,$00,$31,$77,$52,$F6,$1E
               77 52 F6 1E 
10133  F8701B  C6 3D 3F C8 F6           .DB     $C6,$3D,$3F,$C8,$F6,$FF,$D9,$22,$40
               FF D9 22 40 
10134                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  136




10135                           ; log10(2) = lg102a + lg102b = 3.0102999566398119521373889e-1
10136                           ; lg102a = 3.01025390625e-1
10137  F87024  00 00 00 00 00   lg102a: .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
10138  F8702D  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$20,$9A,$FD,$3F
               20 9A FD 3F 
10139                           ; lg102b = 4.6050389811952137388947244930267681898814621E-6
10140  F87036  AC 26 78 91 7C   lg102b: .DB     $AC,$26,$78,$91,$7C,$0B,$AC,$59,$89
               0B AC 59 89 
10141  F8703F  8F 98 F7 CF FB           .DB     $8F,$98,$F7,$CF,$FB,$84,$9A,$ED,$3F
               84 9A ED 3F 
10142                           
10143                           ; log2(10) = 3.321928094887362347870319429489390175864831
10144  F87048  4C DB AF 4D FF   lg210:  .DB     $4C,$DB,$AF,$4D,$FF,$F6,$2B,$49,$FE
               F6 2B 49 FE 
10145  F87051  8A 1B CD 4B 78           .DB     $8A,$1B,$CD,$4B,$78,$9A,$D4,$00,$40
               9A D4 00 40 
10146                           
10147                           ; maxl10 = 4.9320754489586679023818980511660936429E3
10148  F8705A  00 80 7C 0B AC   maxl10: .DB     $00,$80,$7C,$0B,$AC,$59,$89,$8F,$98
               59 89 8F 98 
10149  F87063  F7 CF FB 84 9A           .DB     $F7,$CF,$FB,$84,$9A,$20,$9A,$0B,$40
               20 9A 0B 40 
10150                           ; minl10 = -4.932075448958667902381898051166093750570023E3
10151  F8706C  77 91 7C 0B AC   minl10: .DB     $77,$91,$7C,$0B,$AC,$59,$89,$8F,$98
               59 89 8F 98 
10152  F87075  F7 CF FB 84 9A           .DB     $F7,$CF,$FB,$84,$9A,$20,$9A,$0B,$C0
               20 9A 0B C0 
10153                           
10154                           ; coefficients for exp2() evaluation
10155  F8707E                   ce2p:
10156                           ; P[4] = 1.587171580015525194694938306936721666031E2
10157  F8707E  72 92 38 9A 50           .DB     $72,$92,$38,$9A,$50,$06,$08,$65,$04
               06 08 65 04 
10158  F87087  98 BB B2 AA 97           .DB     $98,$BB,$B2,$AA,$97,$B7,$9E,$06,$40
               B7 9E 06 40 
10159                           ; P[3] = 6.185032670011643762127954396427045467506E5
10160  F87090  D2 BC B4 93 EB           .DB     $D2,$BC,$B4,$93,$EB,$21,$7F,$08,$D6
               21 7F 08 D6 
10161  F87099  4F 03 A3 45 74           .DB     $4F,$03,$A3,$45,$74,$00,$97,$12,$40
               00 97 12 40 
10162                           ; P[2] = 5.677513871931844661829755443994214173883E8
10163  F870A2  42 4D E3 47 3D           .DB     $42,$4D,$E3,$47,$3D,$36,$86,$67,$11
               36 86 67 11 
10164  F870AB  26 D2 C5 6C CB           .DB     $26,$D2,$C5,$6C,$CB,$5C,$87,$1C,$40
               5C 87 1C 40 
10165                           ; P[1] = 1.530625323728429161131811299626419117557E11
10166  F870B4  7D 20 45 D0 EE           .DB     $7D,$20,$45,$D0,$EE,$9C,$89,$CD,$66
               9C 89 CD 66 
10167  F870BD  25 5F 53 94 F3           .DB     $25,$5F,$53,$94,$F3,$8C,$8E,$24,$40
               8C 8E 24 40 
10168                           ; P[0] = 9.079594442980146270952372234833529694788E12
10169  F870C6  FF EB 3C 5D 44           .DB     $FF,$EB,$3C,$5D,$44,$B2,$CC,$35,$20
               B2 CC 35 20 
10170  F870CF  57 42 0E 06 20           .DB     $57,$42,$0E,$06,$20,$20,$84,$2A,$40
               20 84 2A 40 
10171                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  137




10172  F870D8                   ce2q:
10173                           ; Q[4] = 1.236602014442099053716561665053645270207E4
10174  F870D8  5F 7D C4 10 CE           .DB     $5F,$7D,$C4,$10,$CE,$91,$ED,$64,$A4
               91 ED 64 A4 
10175  F870E1  67 35 BD A0 14           .DB     $67,$35,$BD,$A0,$14,$38,$C1,$0C,$40
               38 C1 0C 40 
10176                           ; Q[3] = 2.186249607051644894762167991800811827835E7
10177  F870EA  15 9B 5C BC E3           .DB     $15,$9B,$5C,$BC,$E3,$D1,$FC,$B0,$07
               D1 FC B0 07 
10178  F870F3  D9 AE 06 09 30           .DB     $D9,$AE,$06,$09,$30,$CC,$A6,$17,$40
               CC A6 17 40 
10179                           ; Q[2] = 1.092141473886177435056423606755843616331E10
10180  F870FC  C8 3E E7 04 F9           .DB     $C8,$3E,$E7,$04,$F9,$42,$1F,$0D,$9B
               42 1F 0D 9B 
10181  F87105  4F 27 B7 14 E4           .DB     $4F,$27,$B7,$14,$E4,$BD,$A2,$20,$40
               BD A2 20 40 
10182                           ; Q[1] = 1.490560994263653042761789432690793026977E12
10183  F8710E  64 87 EE 32 85           .DB     $64,$87,$EE,$32,$85,$37,$63,$BC,$E7
               37 63 BC E7 
10184  F87117  96 D3 EB E5 2D           .DB     $96,$D3,$EB,$E5,$2D,$86,$AD,$27,$40
               86 AD 27 40 
10185                           ; Q[0] = 2.619817175234089411411070339065679229869E13
10186  F87120  68 99 1A 49 CE           .DB     $68,$99,$1A,$49,$CE,$E7,$82,$4C,$25
               E7 82 4C 25 
10187  F87129  27 A7 BC C4 E5           .DB     $27,$A7,$BC,$C4,$E5,$9D,$BE,$2B,$40
               9D BE 2B 40 
10188                           
10189                           ; maxl2 = 16384
10190  F87132  00 00 00 00 00   maxl2:  .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
10191  F8713B  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$80,$0D,$40
               00 80 0D 40 
10192                           ; minl2 = -16494
10193  F87144  00 00 00 00 00   minl2:  .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
10194  F8714D  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$DC,$80,$0D,$C0
               DC 80 0D C0 
10195                           
10196                           
10197                           ;---------------------------------------------------------------------------
10198                           ; circular functions & inverse circular functions
10199                           ;---------------------------------------------------------------------------
10200                           
10201                           ; fcos - returns the circular cosine of the radian argument x
10202                           ;
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 4MHz
10211                           ;
10212                           ;----
10213  F87156                   fcos:
10214                           ;----
  Tue Jul 17 11:00:18 2018                                                                                               Page  138




10215  F87156  64 CF                    stz     fpcsgn          ; positive sign
10216  F87158  64 24                    stz     facsgn          ; make argument positive
10217  F8715A  20 05 72                 jsr     modpi4          ; reduce argument: z = x - k*(pi/4)
10218  F8715D  A5 CE                    lda     fpoct           ; octant
10219  F8715F  C9 04                    cmp     #4
10220  F87161  90 0A                    bcc     ?ok             ; no change
10221  F87163  AA                       tax
10222  F87164  A5 CF                    lda     fpcsgn          ; invert sign
10223  F87166  49 FF                    eor     #$FF
10224  F87168  85 CF                    sta     fpcsgn
10225  F8716A  8A                       txa
10226  F8716B  E9 04                    sbc     #4              ; reflect in x axis
10227  F8716D  C9 02            ?ok:    cmp     #2
10228  F8716F  90 0A                    bcc     ?ok2
10229  F87171  AA                       tax
10230  F87172  A5 CF                    lda     fpcsgn          ; invert sign
10231  F87174  49 FF                    eor     #$FF
10232  F87176  85 CF                    sta     fpcsgn
10233  F87178  8A                       txa
10234  F87179  C9 02                    cmp     #2
10235  F8717B  F0 04            ?ok2:   beq     ?s0             ; octant = 2
10236  F8717D  C9 01                    cmp     #1
10237  F8717F  D0 05                    bne     ?s1
10238  F87181  20 C0 71         ?s0:    jsr     sinz            ; 1 & 2nd octant: sinz
10239  F87184  80 2E                    bra     sincos
10240  F87186  20 DB 71         ?s1:    jsr     cosz            ; 0 & 3nd octant: cosz 
10241  F87189  80 29                    bra     sincos
10242                           
10243                           ; fsin - returns the circular sine of the radian argument x
10244                           ;
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 4MHz
10253                           ;
10254                           ;----
10255  F8718B                   fsin:
10256                           ;----
10257  F8718B  A5 24                    lda     facsgn          ; save sign...
10258  F8718D  85 CF                    sta     fpcsgn
10259  F8718F  64 24                    stz     facsgn          ; ...and make argument positive
10260  F87191  20 05 72                 jsr     modpi4          ; reduce argument: z = x - k*(pi/4)
10261  F87194  A5 CE                    lda     fpoct           ; octant
10262  F87196  C9 04                    cmp     #4
10263  F87198  90 0A                    bcc     ?ok             ; no change
10264  F8719A  AA                       tax
10265  F8719B  A5 CF                    lda     fpcsgn          ; invert sign
10266  F8719D  49 FF                    eor     #$FF
10267  F8719F  85 CF                    sta     fpcsgn
10268  F871A1  8A                       txa
10269  F871A2  E9 04                    sbc     #4              ; reflect in x axis
10270  F871A4  C9 01            ?ok:    cmp     #1
10271  F871A6  F0 04                    beq     ?s0
  Tue Jul 17 11:00:18 2018                                                                                               Page  139




10272  F871A8  C9 02                    cmp     #2
10273  F871AA  D0 05                    bne     ?s1
10274  F871AC  20 DB 71         ?s0:    jsr     cosz            ; 1 & 2nd octant: cosz 
10275  F871AF  80 03                    bra     sincos
10276  F871B1  20 C0 71         ?s1:    jsr     sinz            ; 0 & 3nd octant: sinz
10277                           
10278  F871B4                   sincos:
10279  F871B4  24 CF                    bit     fpcsgn
10280  F871B6  10 06                    bpl     ?end
10281  F871B8  A5 24                    lda     facsgn          ; sign inversion
10282  F871BA  49 FF                    eor     #$FF
10283  F871BC  85 24                    sta     facsgn
10284  F871BE  18               ?end:   clc     
10285  F871BF  60                       rts
10286                           
10287                           ; sinz - evaluates the sine of the reduced argument
10288                           ;
10289                           ;                     3      2
10290                           ;       sin(z) = z + z  * P(z )
10291                           ;
10292                           ;----
10293  F871C0                   sinz:
10294                           ;----
10295  F871C0  A9 AD                    lda     #<psin
10296  F871C2  A0 75                    ldy     #>psin
10297  F871C4  A2 0B                    ldx     #11
10298  F871C6  20 1C 87                 jsr     peval           ; fac=P(z*z) 
10299  F871C9  20 CE 85                 jsr     mvt0_a          ; z*z
10300  F871CC  20 DD 49                 jsr     fpmult
10301  F871CF  20 FB 85                 jsr     mvt1_a          ; z
10302  F871D2  20 DD 49                 jsr     fpmult          ; (z^3) * P(z*z)
10303  F871D5  20 FB 85                 jsr     mvt1_a          ; z
10304  F871D8  4C 7D 45                 jmp     fpadd           ; z + (z^3) * P(z*z)
10305                           
10306                           ; cosz - evaluates cosine of reduced argument
10307                           ;
10308                           ;                     1     2     4     2
10309                           ;       cos(z) = 1 - --- * z   + z * P(z )
10310                           ;                     2
10311                           ;
10312                           ;----
10313  F871DB                   cosz:
10314                           ;----
10315  F871DB  A9 85                    lda     #<pcos
10316  F871DD  A0 76                    ldy     #>pcos
10317  F871DF  A2 0A                    ldx     #10
10318  F871E1  20 1C 87                 jsr     peval           ; fac=P(z*z)
10319  F871E4  20 CE 85                 jsr     mvt0_a          ; z*z
10320  F871E7  20 DD 49                 jsr     fpmult
10321  F871EA  20 CE 85                 jsr     mvt0_a          ; z*z
10322  F871ED  20 DD 49                 jsr     fpmult
10323  F871F0  20 6C 45                 jsr     faddone         ; 1 + (z^4) * P(z*z)
10324  F871F3  20 39 84                 jsr     mvftoa          ; move to arg
10325  F871F6  20 47 85                 jsr     mvt0_f          ; z*z
10326  F871F9  A9 FF                    lda     #$FF
10327  F871FB  85 46                    sta     scexp
10328  F871FD  85 47                    sta     scexp+1
  Tue Jul 17 11:00:18 2018                                                                                               Page  140




10329  F871FF  20 B7 48                 jsr     fscale          ; z*z/2
10330  F87202  4C 5F 45                 jmp     fpsub           ; 1 - (z*z/2) + (z^4) * P(z*z)
10331                           
10332                           ; modpi4 - argument reduction modulo pi/4
10333                           ;
10334                           ;       entry:
10335                           ;               fac = x
10336                           ;
10337                           ;       exit:
10338                           ;               tfr1 = z, reduced argument in interval [0, pi/4]
10339                           ;               fac = tfr0 = z*z
10340                           ;               fpoct = octant modulo 360 degrees (0..7)
10341                           ;
10342                           ;       If argument is invalid this function return CF=1 and skip the
10343                           ;       return address.
10344                           ;
10345                           ;       If |x| >= 2^56 the reduction fail due to a large precision loss
10346                           ;       computing the modulo pi/4 of the argument (returns nan)
10347                           ;
10348                           ;       The reduction error is nearly eliminated by contriving an extended 
10349                           ;       precision modular arithmetic
10350                           ;
10351                           ;------
10352  F87205                   modpi4:
10353                           ;------
10354  F87205  24 25                    bit     facst
10355  F87207  30 0B                    bmi     ?er             ; fac=nan or inf
10356  F87209                           ACC16
10357  F87209  C2 20                    rep     #PMFLAG
10358                                   .LONGA  on
10359                                   .MNLIST
10360  F8720B  A5 22                    lda     facexp
10361  F8720D  C9 37 40                 cmp     #BIAS56         ; compare vs. 2^56
10362  F87210                           ACC08
10363  F87210  E2 20                    sep     #PMFLAG
10364                                   .LONGA  off
10365                                   .MNLIST
10366  F87212  90 0B                    bcc     ?ok             ; if too large returns nan
10367  F87214  20 74 4E         ?er:    jsr     fldnan
10368  F87217  A5 CF                    lda     fpcsgn
10369  F87219  85 24                    sta     facsgn
10370  F8721B  68                       pla                     ; skip return address
10371  F8721C  68                       pla
10372  F8721D  38                       sec
10373  F8721E  60                       rts
10374  F8721F  20 93 84         ?ok:    jsr     mvf_t1          ; tfr1=x
10375  F87222  A9 81                    lda     #<cpio4
10376  F87224  A0 77                    ldy     #>cpio4
10377  F87226  20 0A 4A                 jsr     fcrdiv          ; y=x/(pi/4)
10378  F87229  20 27 50                 jsr     floor           ; integral part
10379  F8722C  20 78 4F                 jsr     uitrunc         ; convert to integer in tm
10380                                                           ; just 8 bit value we need here
10381  F8722F  A5 00                    lda     tm              ; map zeros to origin
10382  F87231  4A                       lsr     a
10383  F87232  90 05                    bcc     ?no
10384  F87234  E6 00                    inc     tm
10385  F87236  20 6C 45                 jsr     faddone         ; y=y+1
  Tue Jul 17 11:00:18 2018                                                                                               Page  141




10386  F87239  A5 00            ?no:    lda     tm
10387  F8723B  29 07                    and     #$07            ; octant modulo 360 degrees...
10388  F8723D  85 CE                    sta     fpoct           ; ...for tests on the phase angle
10389  F8723F  20 C0 84                 jsr     mvf_t2          ; tfr2=y
10390  F87242                           
10391                                   ; computes z = x - y*(pi/4) with extended precision modular arithmetic
10392  F87242  A9 4B                    lda     #<cdp1
10393  F87244  A0 77                    ldy     #>cdp1
10394  F87246  20 D5 49                 jsr     fcmult          ; y*cdp1
10395  F87249  20 FB 85                 jsr     mvt1_a          ; arg=x
10396  F8724C  20 5F 45                 jsr     fpsub           ; x=x-y*cdp1
10397  F8724F  20 93 84                 jsr     mvf_t1          ; tfr1=x
10398  F87252  20 A1 85                 jsr     mvt2_f          ; fac=y
10399  F87255  A9 5D                    lda     #<cdp2
10400  F87257  A0 77                    ldy     #>cdp2
10401  F87259  20 D5 49                 jsr     fcmult          ; y*cdp2
10402  F8725C  20 FB 85                 jsr     mvt1_a          ; arg=x
10403  F8725F  20 5F 45                 jsr     fpsub           ; x=x-y*cdp1-y*cdp2
10404  F87262  20 93 84                 jsr     mvf_t1          ; tfr1=x
10405  F87265  20 A1 85                 jsr     mvt2_f          ; fac=y
10406  F87268  A9 6F                    lda     #<cdp3
10407  F8726A  A0 77                    ldy     #>cdp3
10408  F8726C  20 D5 49                 jsr     fcmult          ; y*cdp3
10409  F8726F  20 FB 85                 jsr     mvt1_a          ; arg=x 
10410  F87272  20 5F 45                 jsr     fpsub           ; z=x-y*cdp3-y*cdp2-y*cdp1
10411  F87275  20 93 84                 jsr     mvf_t1          ; tfr1=z=x-k*(pi/4)
10412  F87278  20 CC 49                 jsr     fsquare         ; z*z
10413  F8727B  4C 66 84                 jmp     mvf_t0          ; tfr0=z*z
10414                           
10415                           ; ftan - returns the circular tangent of the radian argument x
10416                           ;
10417                           ;       entry:
10418                           ;               fac = x
10419                           ;
10420                           ;       exit:
10421                           ;               fac = tan(x)
10422                           ;               CF = 1 if invalid result (nan or inf)
10423                           ;
10424                           ; strategy
10425                           ;
10426                           ; Range reduction is modulo pi/4. A rational function
10427                           ;       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 4MHz
10431                           ;
10432                           ;----
10433  F8727E                   ftan:
10434                           ;----
10435  F8727E  A9 00                    lda     #0
10436  F87280  20 A0 72                 jsr     tancot          ; computes tan(x)
10437  F87283  B0 03                    bcs     ?end            ; returns nan
10438  F87285  10 01                    bpl     ?end            ; returns finite value (CF=0)
10439  F87287  38                       sec
10440  F87288  60               ?end:   rts
10441                           
10442                           ; fcotan - returns the circular cotangent of the radian argument x
  Tue Jul 17 11:00:18 2018                                                                                               Page  142




10443                           ;
10444                           ;       entry:
10445                           ;               fac = x
10446                           ;
10447                           ;       exit:
10448                           ;               fac = cotan(x)
10449                           ;               CF = 1 if invalid result (nan or inf)
10450                           ;
10451                           ; strategy
10452                           ;
10453                           ; Range reduction is modulo pi/4. A rational function
10454                           ;       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 4MHz
10458                           ;
10459                           ;------
10460  F87289                   fcotan:
10461                           ;------
10462  F87289  24 25                    bit     facst
10463  F8728B  30 0D                    bmi     ?nan
10464  F8728D  70 0E                    bvs     ?inf            ; x = 0
10465  F8728F  A9 FF                    lda     #$FF
10466  F87291  20 A0 72                 jsr     tancot          ; computes cotan(x)
10467  F87294  B0 03                    bcs     ?end            ; return nan
10468  F87296  10 01                    bpl     ?end            ; returns finite value (CF=0)
10469  F87298  38                       sec
10470  F87299  60               ?end:   rts
10471  F8729A  4C 74 4E         ?nan:   jmp     fldnan          ; returns nan
10472  F8729D  4C 7D 4E         ?inf:   jmp     fldinf          ; returns inf
10473  F872A0                           
10474                           ; tancot - common routine used computing tan(x) & cotan(x)
10475                           ;
10476                           ;       entry:
10477                           ;               fac = x
10478                           ;               A = cotangent flag
10479                           ;
10480                           ;       exit:
10481                           ;               fac = tan(x) or cotan(x)
10482                           ;               CF = 1 if returns nan
10483                           ;               NF = 1 if returns inf
10484                           ;
10485                           ;------
10486  F872A0                   tancot:
10487                           ;------
10488  F872A0  85 D0                    sta     fpcot           ; cotangent flag
10489  F872A2  A5 24                    lda     facsgn          ; save sign...
10490  F872A4  85 CF                    sta     fpcsgn
10491  F872A6  64 24                    stz     facsgn          ; ...and make argument positive
10492  F872A8  20 05 72                 jsr     modpi4          ; argument reduction: z = x - k*(pi/4)
10493                                                           ; fac=tfr0=z*z=w
10494  F872AB  A9 DB                    lda     #<ptan
10495  F872AD  A0 77                    ldy     #>ptan
10496  F872AF  A2 05                    ldx     #5
10497  F872B1  20 1C 87                 jsr     peval           ; evaluate P(w)
10498  F872B4  20 CE 85                 jsr     mvt0_a
10499  F872B7  20 DD 49                 jsr     fpmult          ; w*P(w)
  Tue Jul 17 11:00:18 2018                                                                                               Page  143




10500  F872BA  20 C0 84                 jsr     mvf_t2          ; tfr2=w*P(w)
10501  F872BD  A9 47                    lda     #<qtan
10502  F872BF  A0 78                    ldy     #>qtan
10503  F872C1  A2 05                    ldx     #5
10504  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=z
10508  F872CF  20 DD 49                 jsr     fpmult          ; z*w*R(w)
10509  F872D2  20 FB 85                 jsr     mvt1_a          ; arg=z
10510  F872D5  20 7D 45                 jsr     fpadd           ; z + z*w*R(w)
10511  F872D8  A5 CE            ?done:  lda     fpoct           ; octant
10512  F872DA  29 02                    and     #$02
10513  F872DC  F0 0C                    beq     ?cot
10514  F872DE  A5 24                    lda     facsgn
10515  F872E0  49 FF                    eor     #$FF
10516  F872E2  85 24                    sta     facsgn          ; sign inversion
10517  F872E4  24 D0                    bit     fpcot
10518  F872E6  30 09                    bmi     ?end            ; cotan(x)
10519  F872E8  80 04                    bra     ?rec            ; tan(x)
10520  F872EA  24 D0            ?cot:   bit     fpcot
10521  F872EC  10 03                    bpl     ?end            ; tan(x)
10522  F872EE  20 FD 49         ?rec:   jsr     frecip
10523  F872F1  24 CF            ?end:   bit     fpcsgn
10524  F872F3  10 06                    bpl     ?end2
10525  F872F5  A5 24                    lda     facsgn          ; sign inversion
10526  F872F7  49 FF                    eor     #$FF
10527  F872F9  85 24                    sta     facsgn
10528  F872FB  18               ?end2:  clc
10529  F872FC  24 25                    bit     facst           ; return N=1 if invalid
10530  F872FE  60                       rts
10531                           
10532                           ; fasin - inverse circular sine: returns radian angle 
10533                           ; between -pi/2 and +pi/2 whose sine is x
10534                           ;
10535                           ;       entry:
10536                           ;               fac = x
10537                           ;
10538                           ;       exit:
10539                           ;               fac = asin(x) in domain [-p1/2,+pi/2]
10540                           ;               CF = 1 if returns nan (|x| > 1)
10541                           ;
10542                           ; strategy
10543                           ;
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 is
10546                           ; transformed by the identity
10547                           ;
10548                           ;       asin(x) = pi/2 - 2*asin(sqrt((1-x)/2))
10549                           ;
10550                           ;       computation mean time: 100/130ms at 4MHz
10551                           ;
10552                           ;-----
10553  F872FF                   fasin:
10554                           ;-----
10555  F872FF  24 25                    bit     facst
10556  F87301  30 1C                    bmi     ?nan            ; if argument is invalid return nan
  Tue Jul 17 11:00:18 2018                                                                                               Page  144




10557  F87303  70 18                    bvs     ?ok             ; if x=0 return 0
10558  F87305  20 24 74                 jsr     cmpx1           ; compare |x| vs. 1
10559  F87308  B0 15                    bcs     ?nan            ; if |x|>1 return nan
10560  F8730A  08                       php
10561  F8730B  A5 24                    lda     facsgn
10562  F8730D  85 CF                    sta     fpcsgn          ; save sign(x)
10563  F8730F  28                       plp
10564  F87310  D0 10                    bne     ?do             ; |x|<1
10565  F87312  A9 93                    lda     #<cpio2         ; |x|=1 so return sgn(x)*pi/2
10566  F87314  A0 77                    ldy     #>cpio2
10567  F87316  20 82 86                 jsr     ldfac           ; x=pi/2
10568  F87319  A5 CF                    lda     fpcsgn
10569  F8731B  85 24                    sta     facsgn
10570  F8731D  18               ?ok:    clc
10571  F8731E  60                       rts
10572  F8731F  4C 74 4E         ?nan:   jmp     fldnan
10573  F87322  64 24            ?do:    stz     facsgn          ; |x|
10574  F87324  64 D0                    stz     fpasin          ; asin flag
10575  F87326  20 1B 74                 jsr     cmpxh           ; compare |x| vs. 0.5
10576  F87329  B0 08                    bcs     ?gt             ; |x|>0.5
10577  F8732B  20 93 84                 jsr     mvf_t1          ; tfr1=z=|x|
10578  F8732E  20 CC 49                 jsr     fsquare         ; w=z*z
10579  F87331  80 22                    bra     ?pp
10580  F87333  A9 FF            ?gt:    lda     #$FF
10581  F87335  85 D0                    sta     fpasin          ; |x| > 0.5 flag
10582  F87337  20 9F 4E                 jsr     ldahalf         ; arg=0.5
10583  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     #$FF
10586  F87342  85 46                    sta     scexp
10587  F87344  85 47                    sta     scexp+1         ; divive dy 2
10588  F87346  20 B7 48                 jsr     fscale          ; w=0.5*(1-|x|)
10589  F87349  20 C0 84                 jsr     mvf_t2          ; tfr2=w
10590  F8734C  20 53 60                 jsr     fsqrt           ; z=sqrt(w)
10591  F8734F  20 93 84                 jsr     mvf_t1          ; tfr1=z
10592  F87352  20 A1 85                 jsr     mvt2_f          ; fac=w
10593  F87355  20 66 84         ?pp:    jsr     mvf_t0          ; tfr0=w
10594  F87358  A9 B3                    lda     #<casp
10595  F8735A  A0 78                    ldy     #>casp
10596  F8735C  A2 09                    ldx     #9
10597  F8735E  20 1C 87                 jsr     peval           ; P(w)
10598  F87361  20 CE 85                 jsr     mvt0_a          ; w
10599  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     #<casq
10602  F8736C  A0 79                    ldy     #>casq
10603  F8736E  A2 09                    ldx     #9
10604  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=z
10608  F8737C  20 DD 49                 jsr     fpmult          ; z*w*R(w)
10609  F8737F  20 FB 85                 jsr     mvt1_a          ; arg=z
10610  F87382  20 7D 45                 jsr     fpadd           ; y=z+z*w*R(w)
10611  F87385  24 D0                    bit     fpasin
10612  F87387  10 10                    bpl     ?done           ; |x| <= 0.5
10613  F87389  20 39 84                 jsr     mvftoa
  Tue Jul 17 11:00:18 2018                                                                                               Page  145




10614  F8738C  20 7D 45                 jsr     fpadd           ; y+y
10615  F8738F  A9 93                    lda     #<cpio2
10616  F87391  A0 77                    ldy     #>cpio2
10617  F87393  20 CF 86                 jsr     ldarg           ; arg=pi/2
10618  F87396  20 5F 45                 jsr     fpsub           ; pi/2-2*asin(z)
10619  F87399  24 CF            ?done:  bit     fpcsgn
10620  F8739B  10 06                    bpl     ?end
10621  F8739D  A5 24                    lda     facsgn          ; sign inversion
10622  F8739F  49 FF                    eor     #$FF
10623  F873A1  85 24                    sta     facsgn
10624  F873A3  18               ?end:   clc
10625  F873A4  60                       rts
10626                           
10627                           ; facos - inverse circular cosine: returns radian angle 
10628                           ; between 0 and +pi whose cosine is x
10629                           ;
10630                           ;       entry:
10631                           ;               fac = x
10632                           ;
10633                           ;       exit:
10634                           ;               fac = acos(x) in domain [0,pi]
10635                           ;               CF = 1 if returns nan (|x| > 1)
10636                           ;
10637                           ; strategy
10638                           ;
10639                           ; Analytically, acos(x) = pi/2 - asin(x).  However if |x| is
10640                           ; 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 4MHz
10650                           ;
10651                           ;-----
10652  F873A5                   facos:
10653                           ;-----
10654  F873A5  24 25                    bit     facst
10655  F873A7  30 21                    bmi     ?nan            ; if argument is invalid return nan
10656  F873A9  70 22                    bvs     ?pi2            ; if x=0 return pi/2
10657  F873AB  20 24 74                 jsr     cmpx1           ; compare |x| vs. 1
10658  F873AE  B0 1A                    bcs     ?nan            ; if |x|>1 return nan
10659  F873B0  08                       php
10660  F873B1  A5 24                    lda     facsgn
10661  F873B3  85 CF                    sta     fpcsgn          ; save sign(x)
10662  F873B5  28                       plp
10663  F873B6  D0 20                    bne     ?do             ; |x|<1
10664  F873B8  64 24                    stz     facsgn          ; |x|=1
10665  F873BA  24 CF                    bit     fpcsgn
10666  F873BC  10 09                    bpl     ?z              ; x=1 so return 0
10667  F873BE  A9 A5                    lda     #<cpi           ; x=-1 so return pi
10668  F873C0  A0 77                    ldy     #>cpi
10669  F873C2  20 82 86                 jsr     ldfac           ; x=pi
10670  F873C5  18                       clc
  Tue Jul 17 11:00:18 2018                                                                                               Page  146




10671  F873C6  60                       rts
10672  F873C7  4C 56 4E         ?z:     jmp     fldz
10673  F873CA  4C 74 4E         ?nan:   jmp     fldnan
10674  F873CD  A9 93            ?pi2:   lda     #<cpio2         ; |x|=0 so return pi/2
10675  F873CF  A0 77                    ldy     #>cpio2
10676  F873D1  20 82 86                 jsr     ldfac           ; x=pi/2
10677  F873D4  64 24                    stz     facsgn
10678  F873D6  18               ?ok:    clc
10679  F873D7  60                       rts
10680  F873D8  20 1B 74         ?do:    jsr     cmpxh           ; compare |x| vs. 0.5
10681  F873DB  B0 0D                    bcs     ?gt             ; |x|>0.5
10682  F873DD  20 FF 72                 jsr     fasin           ; |x|<=0.5
10683  F873E0  A9 93                    lda     #<cpio2
10684  F873E2  A0 77                    ldy     #>cpio2
10685  F873E4  20 CF 86                 jsr     ldarg           ; arg=pi/2
10686  F873E7  4C 5F 45                 jmp     fpsub           ; pi/2-asin(x) if |x|<=0.5
10687  F873EA  A5 CF            ?gt:    lda     fpcsgn
10688  F873EC  30 04                    bmi     ?neg
10689  F873EE  A2 FF                    ldx     #$FF    
10690  F873F0  86 24                    stx     facsgn          ; x<-0.5 or x>0.5
10691  F873F2  48               ?neg:   pha                     ; save sign
10692  F873F3  20 6C 45                 jsr     faddone         ; y=1+x or y=1-x
10693  F873F6  A9 FF                    lda     #$FF
10694  F873F8  85 46                    sta     scexp
10695  F873FA  85 47                    sta     scexp+1
10696  F873FC  20 B7 48                 jsr     fscale          ; divide by 2
10697  F873FF  20 53 60                 jsr     fsqrt           ; w=sqrt(y/2)
10698  F87402  20 FF 72                 jsr     fasin
10699  F87405  A9 01                    lda     #1
10700  F87407  85 46                    sta     scexp
10701  F87409  64 47                    stz     scexp+1
10702  F8740B  20 B7 48                 jsr     fscale          ; multiplies by 2
10703  F8740E  68                       pla                     ; original sign
10704  F8740F  10 C5                    bpl     ?ok             ; done: acos(x)=2*asin(w)
10705  F87411  A9 A5                    lda     #<cpi
10706  F87413  A0 77                    ldy     #>cpi
10707  F87415  20 CF 86                 jsr     ldarg           ; arg=pi
10708  F87418  4C 5F 45                 jmp     fpsub           ; acos(x)=pi-2*asin(w)
10709  F8741B                           
10710                           
10711                           ; compare |x| vs. 0.5 - flag's affected
10712                           ;
10713                           ;       CF=0, ZF=0 if |x| < 0.5
10714                           ;       CF=0, ZF=1 if |x| = 0.5
10715                           ;       CF=1, ZF=0 if |x| > 0.5
10716  F8741B                   cmpxh:
10717  F8741B                           ACC16
10718  F8741B  C2 20                    rep     #PMFLAG
10719                                   .LONGA  on
10720                                   .MNLIST
10721  F8741D  A5 22                    lda     facexp
10722  F8741F  C9 FE 3F                 cmp     #EBIAS-1
10723  F87422  80 07                    bra     cmpx1h
10724  F87424                           
10725                           ; compare |x| vs. 1 - flag's affected
10726                           ;
10727                           ;       CF=0, ZF=0 if |x| < 1
  Tue Jul 17 11:00:18 2018                                                                                               Page  147




10728                           ;       CF=0, ZF=1 if |x| = 1
10729                           ;       CF=1, ZF=0 if |x| > 1
10730  F87424                   cmpx1:
10731  F87424                           ACC16
10732  F87424  C2 20                    rep     #PMFLAG
10733                                   .LONGA  on
10734                                   .MNLIST
10735  F87426  A5 22                    lda     facexp
10736  F87428  C9 FF 3F                 cmp     #EBIAS
10737  F8742B                   cmpx1h:
10738  F8742B  90 1C                    bcc     ?done           ; |x|<1, CF=0, ZF=0
10739  F8742D  F0 02                    beq     ?tst
10740  F8742F  B0 18                    bcs     ?done           ; |x|>1, CF=1, ZF=0
10741  F87431  A5 20            ?tst:   lda     facm+14         ; should be $8000
10742  F87433  C9 00 80                 cmp     #$8000          ; here always CF=1
10743  F87436  D0 11                    bne     ?done           ; |x|>1, CF=1, ZF=0
10744  F87438  A5 1E                    lda     facm+12
10745  F8743A  05 1C                    ora     facm+10
10746  F8743C  05 1A                    ora     facm+8
10747  F8743E  05 18                    ora     facm+6
10748  F87440  05 16                    ora     facm+4
10749  F87442  05 14                    ora     facm+2
10750  F87444  05 12                    ora     facm
10751  F87446  D0 01                    bne     ?done           ; |x|>1, CF=1, ZF=0             
10752  F87448  18                       clc                     ; |x|=1, CF=0, ZF=1
10753  F87449                   ?done:  ACC08
10754  F87449  E2 20                    sep     #PMFLAG
10755                                   .LONGA  off
10756                                   .MNLIST
10757  F8744B  60                       rts
10758                           
10759                           ; fatan - inverse circular tangent, returns radian angle
10760                           ; between -pi/2 and +pi/2 whose tangent is x
10761                           ;
10762                           ;       entry:
10763                           ;               fac = x
10764                           ;
10765                           ;       exit:
10766                           ;               fac = atan(x) in domain [-pi/2,pi/2]
10767                           ;               CF = 1 if returns nan
10768                           ;
10769                           ; strategy
10770                           ;
10771                           ; Range reduction is from four intervals into the interval
10772                           ; from zero to tan(pi/8). The approximant uses a rational
10773                           ; function of the form x + x^3 P(x)/Q(x).
10774                           ;
10775                           ;       computation mean time: 100ms at 4MHz
10776                           ;
10777                           ;-----
10778  F8744C                   fatan:
10779                           ;-----
10780  F8744C  24 25                    bit     facst
10781  F8744E  10 13                    bpl     ?fv             ; valid fac
10782  F87450  50 0F                    bvc     ?er             ; fac=nan so return nan
10783  F87452  A5 24                    lda     facsgn
10784  F87454  48                       pha
  Tue Jul 17 11:00:18 2018                                                                                               Page  148




10785  F87455  A9 93                    lda     #<cpio2
10786  F87457  A0 77                    ldy     #>cpio2
10787  F87459  20 82 86                 jsr     ldfac           ; x=pi/2
10788  F8745C  68                       pla
10789  F8745D  85 24                    sta     facsgn          ; return +/-pi/2
10790  F8745F  18               ?ok:    clc
10791  F87460  60                       rts
10792  F87461  38               ?er:    sec
10793  F87462  60                       rts
10794  F87463  70 FA            ?fv:    bvs     ?ok             ; if fac=0 return 0
10795  F87465  A5 24                    lda     facsgn          ; save sign...
10796  F87467  85 CF                    sta     fpcsgn
10797  F87469  64 24                    stz     facsgn          ; ...and make argument positive
10798  F8746B  A9 B7                    lda     #<ct3p8
10799  F8746D  A0 77                    ldy     #>ct3p8
10800  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     #<ctp8
10803  F87476  A0 77                    ldy     #>ctp8
10804  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=x
10807  F87480  20 56 4E                 jsr     fldz
10808  F87483  20 C0 84                 jsr     mvf_t2          ; tfr2=y=0
10809  F87486  80 3E                    bra     ?do
10810  F87488  20 66 84         ?gt8:   jsr     mvf_t0          ; tfr0=x
10811  F8748B  20 39 84                 jsr     mvftoa          ; arg=x
10812  F8748E  20 32 4E                 jsr     fldm1           ; fac=-1
10813  F87491  20 7D 45                 jsr     fpadd           ; x-1
10814  F87494  20 93 84                 jsr     mvf_t1          ; tfr1=x-1
10815  F87497  20 47 85                 jsr     mvt0_f          ; fac=x
10816  F8749A  20 6C 45                 jsr     faddone         ; x+1
10817  F8749D  20 FB 85                 jsr     mvt1_a          ; arg=x-1
10818  F874A0  20 10 4A                 jsr     fpdiv           ; w=(x-1)/(x+1)
10819  F874A3  20 93 84                 jsr     mvf_t1          ; tfr1=w
10820  F874A6  A9 81                    lda     #<cpio4
10821  F874A8  A0 77                    ldy     #>cpio4
10822  F874AA  20 82 86                 jsr     ldfac           ; pi/4
10823  F874AD  20 C0 84                 jsr     mvf_t2          ; tfr2=y=pi/4
10824  F874B0  80 14                    bra     ?do
10825  F874B2  20 FD 49         ?gt38:  jsr     frecip
10826  F874B5  A9 FF                    lda     #$FF
10827  F874B7  85 24                    sta     facsgn          ; w=-1/x
10828  F874B9  20 93 84                 jsr     mvf_t1          ; tfr1=w=-1/x
10829  F874BC  A9 93                    lda     #<cpio2
10830  F874BE  A0 77                    ldy     #>cpio2
10831  F874C0  20 82 86                 jsr     ldfac           ; pi/2
10832  F874C3  20 C0 84                 jsr     mvf_t2          ; tfr2=y=pi/2
10833  F874C6  20 74 85         ?do:    jsr     mvt1_f          ; fac=w
10834  F874C9  20 CC 49                 jsr     fsquare         ; z=w*w
10835  F874CC  20 66 84                 jsr     mvf_t0          ; tfr0=z
10836  F874CF  A9 1B                    lda     #<catp
10837  F874D1  A0 7A                    ldy     #>catp
10838  F874D3  A2 08                    ldx     #8
10839  F874D5  20 1C 87                 jsr     peval           ; P(z)
10840  F874D8  20 ED 84                 jsr     mvf_t3          ; tfr3=P(z)
10841  F874DB  A9 BD                    lda     #<catq
  Tue Jul 17 11:00:18 2018                                                                                               Page  149




10842  F874DD  A0 7A                    ldy     #>catq
10843  F874DF  A2 07                    ldx     #7
10844  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=z
10848  F874ED  20 DD 49                 jsr     fpmult          ; z*R(z)
10849  F874F0  20 FB 85                 jsr     mvt1_a          ; arg=w
10850  F874F3  20 DD 49                 jsr     fpmult          ; z*w*R(z)
10851  F874F6  20 FB 85                 jsr     mvt1_a          ; arg=w
10852  F874F9  20 7D 45                 jsr     fpadd           ; w+z*w*R(z)
10853  F874FC  20 28 86                 jsr     mvt2_a          ; arg=y
10854  F874FF  20 7D 45                 jsr     fpadd           ; y+w+z*w*R(z)
10855  F87502  24 CF                    bit     fpcsgn
10856  F87504  10 06                    bpl     ?end
10857  F87506  A5 24                    lda     facsgn
10858  F87508  49 FF                    eor     #$FF
10859  F8750A  85 24                    sta     facsgn
10860  F8750C  18               ?end:   clc
10861  F8750D  60                       rts
10862                           
10863                           ; fatanyx - inverse circular tangent, returns radian angle
10864                           ; between 0 and 2*pi whose tangent is y/x (computes the phase angle)
10865                           ;
10866                           ;       entry:
10867                           ;               fac = x
10868                           ;               arg = y
10869                           ;
10870                           ;       exit:
10871                           ;               fac = z = atan(y/x) in domain [0, 2pi]
10872                           ;               CF = 1 if returns nan
10873                           ;
10874                           ;       computation mean time: 100ms at 4MHz
10875                           ;
10876                           ;-------
10877  F8750E                   fatanyx:
10878                           ;-------
10879  F8750E  A2 00                    ldx     #0
10880  F87510  24 24                    bit     facsgn
10881  F87512  10 02                    bpl     ?xp             ; x >= 0
10882  F87514  A2 02                    ldx     #2
10883  F87516  24 3C            ?xp:    bit     argsgn
10884  F87518  10 01                    bpl     ?yp             ; y >= 0
10885  F8751A  E8                       inx
10886  F8751B  86 10            ?yp:    stx     atncode
10887  F8751D  A5 25                    lda     facst
10888  F8751F  29 C0                    and     #$C0
10889  F87521  C9 80                    cmp     #$80
10890  F87523  F0 10                    beq     ?nan            ; if x=nan return nan
10891  F87525  AA                       tax
10892  F87526  A5 3D                    lda     argst
10893  F87528  29 C0                    and     #$C0
10894  F8752A  C9 80                    cmp     #$80
10895  F8752C  F0 07                    beq     ?nan            ; if y=nan return nan
10896  F8752E  A8                       tay
10897  F8752F  25 25                    and     facst
10898  F87531  C9 C0                    cmp     #$C0            ; if x=inf and y=inf return nan
  Tue Jul 17 11:00:18 2018                                                                                               Page  150




10899  F87533  D0 03                    bne     ?x0
10900  F87535  4C 74 4E         ?nan:   jmp     fldnan  
10901  F87538  E0 40            ?x0:    cpx     #$40
10902  F8753A  D0 25                    bne     ?xx             ; x != 0
10903  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     #<cpio2
10906  F87542  A0 77                    ldy     #>cpio2
10907  F87544  20 82 86                 jsr     ldfac           ; z = pi/2 
10908  F87547  46 10                    lsr     atncode
10909  F87549  90 31                    bcc     ?ret            ; return z = pi/2
10910  F8754B  20 A6 4E                 jsr     ldaone
10911  F8754E                           ACC16
10912  F8754E  C2 20                    rep     #PMFLAG
10913                                   .LONGA  on
10914                                   .MNLIST
10915  F87550  E6 3A                    inc     argexp
10916  F87552  A9 00 C0                 lda     #$C000
10917  F87555  85 38                    sta     argm+14         ; arg = 3
10918  F87557                           ACC08
10919  F87557  E2 20                    sep     #PMFLAG
10920                                   .LONGA  off
10921                                   .MNLIST
10922  F87559  64 3C                    stz     argsgn
10923  F8755B  4C DD 49                 jmp     fpmult          ; return z = 3*pi/2
10924  F8755E  4C 56 4E         ?zz:    jmp     fldz            ; z = 0
10925  F87561  C0 40            ?xx:    cpy     #$40
10926  F87563  D0 19                    bne     ?yy             ; y != 0
10927  F87565  A5 10            ?pi:    lda     atncode
10928  F87567  F0 F5                    beq     ?zz             ; return z = 0
10929  F87569  A9 A5                    lda     #<cpi
10930  F8756B  A0 77                    ldy     #>cpi
10931  F8756D  20 82 86                 jsr     ldfac           ; z = pi 
10932  F87570  A9 02                    lda     #$02
10933  F87572  24 10                    bit     atncode
10934  F87574  D0 06                    bne     ?ret            ; return z = pi
10935  F87576                           ACC16
10936  F87576  C2 20                    rep     #PMFLAG
10937                                   .LONGA  on
10938                                   .MNLIST
10939  F87578  E6 22                    inc     facexp          ; return z = 2*pi
10940  F8757A                           ACC08
10941  F8757A  E2 20                    sep     #PMFLAG
10942                                   .LONGA  off
10943                                   .MNLIST
10944  F8757C  18               ?ret:   clc
10945  F8757D  60                       rts
10946  F8757E  C0 C0            ?yy:    cpy     #$C0
10947  F87580  F0 BE                    beq     ?pi2            ; if y = inf, x != 0, is like x = 0
10948  F87582  E0 C0                    cpx     #$C0
10949  F87584  F0 DF                    beq     ?pi             ; if x = inf, y != 0, is like y = 0
10950  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     atncode
10953  F8758E  F0 EC                    beq     ?ret            ; return z = atan(y/x) (first quadrant)
10954  F87590  20 39 84                 jsr     mvftoa          ; arg = z
10955  F87593  A9 A5                    lda     #<cpi
  Tue Jul 17 11:00:18 2018                                                                                               Page  151




10956  F87595  A0 77                    ldy     #>cpi
10957  F87597  20 82 86                 jsr     ldfac           ; fac = pi 
10958  F8759A  A5 10                    lda     atncode
10959  F8759C  C9 02                    cmp     #$02
10960  F8759E  F0 0A                    beq     ?done           ; 2nd quadrant: add pi (atan < 0)
10961  F875A0  C9 03                    cmp     #$03
10962  F875A2  F0 06                    beq     ?done           ; 3th quadrant: add pi (atan > 0)
10963  F875A4                           ACC16
10964  F875A4  C2 20                    rep     #PMFLAG
10965                                   .LONGA  on
10966                                   .MNLIST
10967  F875A6  E6 22                    inc     facexp          ; 4th quadrant: add 2*pi (atan < 0)
10968  F875A8                           ACC08
10969  F875A8  E2 20                    sep     #PMFLAG
10970                                   .LONGA  off
10971                                   .MNLIST
10972  F875AA  4C 7D 45         ?done:  jmp     fpadd   
10973  F875AD                           
10974                           
10975                           ; sin(x) coefficients
10976  F875AD                   psin:
10977                           ; PSIN[11] =  6.410290407010279602425714995528976754871E-26 
10978  F875AD  35 40 EA 6E 20           .DB     $35,$40,$EA,$6E,$20,$61,$06,$26,$A1
               61 06 26 A1 
10979  F875B6  83 C3 68 DB 0A           .DB     $83,$C3,$68,$DB,$0A,$B6,$9E,$AB,$3F
               B6 9E AB 3F 
10980                           
10981                           ; PSIN[10] = -3.868105354403065333804959405965295962871E-23  
10982  F875BF  D1 C3 E7 80 C9           .DB     $D1,$C3,$E7,$80,$C9,$32,$07,$3B,$A4
               32 07 3B A4 
10983  F875C8  87 F3 85 2F D3           .DB     $87,$F3,$85,$2F,$D3,$0C,$BB,$B4,$BF
               0C BB B4 BF 
10984                           
10985                           ; PSIN[09] =  1.957294039628045847156851410307133941611E-20 
10986  F875D1  44 DE C1 98 E0           .DB     $44,$DE,$C1,$98,$E0,$53,$C7,$8F,$BC
               53 C7 8F BC 
10987  F875DA  E5 70 32 4D 77           .DB     $E5,$70,$32,$4D,$77,$DC,$B8,$BD,$3F
               DC B8 BD 3F 
10988                           
10989                           ; PSIN[08] = -8.220635246181818130416407184286068307901E-18  
10990  F875E3  88 ED DD EC 5C           .DB     $88,$ED,$DD,$EC,$5C,$DF,$55,$07,$A1
               DF 55 07 A1 
10991  F875EC  85 FB E6 33 DA           .DB     $85,$FB,$E6,$33,$DA,$A4,$97,$C6,$BF
               A4 97 C6 BF 
10992                           
10993                           ; PSIN[07] =  2.811457254345322887443598804951004537784E-15  
10994  F875F5  22 B2 7C 77 2A           .DB     $22,$B2,$7C,$77,$2A,$20,$77,$86,$F3
               20 77 86 F3 
10995  F875FE  A5 5A 85 81 3B           .DB     $A5,$5A,$85,$81,$3B,$96,$CA,$CE,$3F
               96 CA CE 3F 
10996                           
10997                           ; PSIN[06] = -7.647163731819815869711749952353081768709E-13 
10998  F87607  72 92 40 E9 65           .DB     $72,$92,$40,$E9,$65,$9C,$A5,$43,$C1
               9C A5 43 C1 
10999  F87610  F3 C0 9D 39 9F           .DB     $F3,$C0,$9D,$39,$9F,$3F,$D7,$D6,$BF
               3F D7 D6 BF 
11000                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  152




11001                           ; PSIN[05] =  1.605904383682161459812515654720205050216E-10  
11002  F87619  80 06 BE F2 47           .DB     $80,$06,$BE,$F2,$47,$B3,$13,$1B,$E4
               B3 13 1B E4 
11003  F87622  4B 68 43 9D 30           .DB     $4B,$68,$43,$9D,$30,$92,$B0,$DE,$3F
               92 B0 DE 3F 
11004                           
11005                           ; PSIN[04] = -2.505210838544171877505034150892770940116E-8  
11006  F8762B  EC 90 66 4A 76           .DB     $EC,$90,$66,$4A,$76,$79,$F7,$39,$7F
               79 F7 39 7F 
11007  F87634  1C 27 AA 3F 2B           .DB     $1C,$27,$AA,$3F,$2B,$32,$D7,$E5,$BF
               32 D7 E5 BF 
11008                           
11009                           ; PSIN[03] =  2.755731922398589065255731765498970284004E-6  
11010  F8763D  84 F7 94 D2 B7           .DB     $84,$F7,$94,$D2,$B7,$37,$0E,$56,$7D
               37 0E 56 7D 
11011  F87646  9C 39 B6 2A 1D           .DB     $9C,$39,$B6,$2A,$1D,$EF,$B8,$EC,$3F
               EF B8 EC 3F 
11012                           
11013                           ; PSIN[02] = -1.984126984126984126984126984045294307281E-4  
11014  F8764F  7D F8 65 29 FE           .DB     $7D,$F8,$65,$29,$FE,$0C,$D0,$00,$0D
               0C D0 00 0D 
11015  F87658  D0 00 0D D0 00           .DB     $D0,$00,$0D,$D0,$00,$0D,$D0,$F2,$BF
               0D D0 F2 BF 
11016                           
11017                           ; PSIN[01] =  8.333333333333333333333333333333119885283E-3 
11018  F87661  62 9A 41 88 88           .DB     $62,$9A,$41,$88,$88,$88,$88,$88,$88
               88 88 88 88 
11019  F8766A  88 88 88 88 88           .DB     $88,$88,$88,$88,$88,$88,$88,$F8,$3F
               88 88 F8 3F 
11020                           
11021                           ; PSIN[00] = -1.666666666666666666666666666666666647199E-1 
11022  F87673  51 A0 AA AA AA           .DB     $51,$A0,$AA,$AA,$AA,$AA,$AA,$AA,$AA
               AA AA AA AA 
11023  F8767C  AA AA AA AA AA           .DB     $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FC,$BF
               AA AA FC BF 
11024                           
11025                           ; cos(x) coefficients 
11026  F87685                   pcos:
11027                           ; PCOS[10] =  1.601961934248327059668321782499768648351E-24  
11028  F87685  6F 42 59 D2 8A           .DB     $6F,$42,$59,$D2,$8A,$EF,$37,$CD,$48
               EF 37 CD 48 
11029  F8768E  C3 50 58 0F 40           .DB     $C3,$50,$58,$0F,$40,$E4,$F7,$AF,$3F
               E4 F7 AF 3F 
11030                           
11031                           ; PCOS[09] = -8.896621117922334603659240022184527001401E-22  
11032  F87697  EF E7 87 4A 0E           .DB     $EF,$E7,$87,$4A,$0E,$94,$D9,$B3,$11
               94 D9 B3 11 
11033  F876A0  C8 08 07 CC 22           .DB     $C8,$08,$07,$CC,$22,$71,$86,$B9,$BF
               71 86 B9 BF 
11034                           
11035                           ; PCOS[08] =  4.110317451243694098169570731967589555498E-19 
11036  F876A9  94 20 CD 9C D6           .DB     $94,$20,$CD,$9C,$D6,$21,$68,$81,$A8
               21 68 81 A8 
11037  F876B2  E7 86 A7 75 5C           .DB     $E7,$86,$A7,$75,$5C,$A1,$F2,$C1,$3F
               A1 F2 C1 3F 
11038                           
11039                           ; PCOS[07] = -1.561920696747074515985647487260202922160E-16  
  Tue Jul 17 11:00:18 2018                                                                                               Page  153




11040  F876BB  4C 88 FF 5A 9D           .DB     $4C,$88,$FF,$5A,$9D,$63,$B8,$94,$13
               63 B8 94 13 
11041  F876C4  54 B0 94 1D C3           .DB     $54,$B0,$94,$1D,$C3,$13,$B4,$CA,$BF
               13 B4 CA BF 
11042                           
11043                           ; PCOS[06] =  4.779477332386900932514186378501779328195E-14  
11044  F876CD  2B 3C A9 FD E8           .DB     $2B,$3C,$A9,$FD,$E8,$BA,$6D,$B7,$80
               BA 6D B7 80 
11045  F876D6  FC A8 9D 39 9F           .DB     $FC,$A8,$9D,$39,$9F,$3F,$D7,$D2,$3F
               3F D7 D2 3F 
11046                           
11047                           ; PCOS[05] = -1.147074559772972328629102981460088437917E-11  
11048  F876DF  C1 7C 8A 0F 0E           .DB     $C1,$7C,$8A,$0F,$0E,$46,$0C,$31,$F4
               46 0C 31 F4 
11049  F876E8  E1 E4 03 46 A5           .DB     $E1,$E4,$03,$46,$A5,$CB,$C9,$DA,$BF
               CB C9 DA BF 
11050                           
11051                           ; PCOS[04] =  2.087675698786809897637922200570559726116E-9  
11052  F876F1  93 84 CC C1 FA           .DB     $93,$84,$CC,$C1,$FA,$D5,$F9,$BF,$A8
               D5 F9 BF A8 
11053  F876FA  BD C4 C6 7F C7           .DB     $BD,$C4,$C6,$7F,$C7,$76,$8F,$E2,$3F
               76 8F E2 3F 
11054                           
11055                           ; PCOS[03] = -2.755731922398589065255365968070684102298E-7 
11056  F87703  0E 2B 2E FA 29           .DB     $0E,$2B,$2E,$FA,$29,$A2,$AE,$77,$97
               A2 AE 77 97 
11057  F8770C  E3 FA C4 BB 7D           .DB     $E3,$FA,$C4,$BB,$7D,$F2,$93,$E9,$BF
               F2 93 E9 BF 
11058                           
11059                           ; PCOS[02] =  2.480158730158730158730158440896461945271E-5 
11060  F87715  69 8F 86 22 AB           .DB     $69,$8F,$86,$22,$AB,$EF,$CF,$00,$0D
               EF CF 00 0D 
11061  F8771E  D0 00 0D D0 00           .DB     $D0,$00,$0D,$D0,$00,$0D,$D0,$EF,$3F
               0D D0 EF 3F 
11062                           
11063                           ; PCOS[01] = -1.388888888888888888888888888765724370132E-3 
11064  F87727  C8 EC 07 B7 5B           .DB     $C8,$EC,$07,$B7,$5B,$0B,$B6,$60,$0B
               0B B6 60 0B 
11065  F87730  B6 60 0B B6 60           .DB     $B6,$60,$0B,$B6,$60,$0B,$B6,$F5,$BF
               0B B6 F5 BF 
11066                           
11067                           ; PCOS[00] =  4.166666666666666666666666666666459301466E-2  
11068  F87739  F7 64 FE A9 AA           .DB     $F7,$64,$FE,$A9,$AA,$AA,$AA,$AA,$AA
               AA AA AA AA 
11069  F87742  AA AA AA AA AA           .DB     $AA,$AA,$AA,$AA,$AA,$AA,$AA,$FA,$3F
               AA AA FA 3F 
11070                           
11071                           ; DP1 + DP2 + DP3 = PI/4
11072                           ; DP1 =  7.853981633974483067550664827649598009884357452392578125E-1 
11073  F8774B  00 00 00 00 00   cdp1:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
11074  F87754  C2 68 21 A2 DA           .DB     $C2,$68,$21,$A2,$DA,$0F,$C9,$FE,$3F
               0F C9 FE 3F 
11075                           
11076                           ; DP2 =  2.8605943630549158983813312792950660807511260829685741796657E-18 
11077  F8775D  00 00 00 00 00   cdp2:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
  Tue Jul 17 11:00:18 2018                                                                                               Page  154




11078  F87766  70 03 2E 8A 19           .DB     $70,$03,$2E,$8A,$19,$13,$D3,$C4,$3F
               13 D3 C4 3F 
11079                           
11080                           ; DP3 =  2.1679525325309452561992610065108379921905808E-35 
11081  F8776F  00 00 32 F5 5D   cdp3:   .DB     $00,$00,$32,$F5,$5D,$10,$A0,$63,$3E
               10 A0 63 3E 
11082  F87778  53 44 70 12 48           .DB     $53,$44,$70,$12,$48,$89,$E6,$8B,$3F
               89 E6 8B 3F 
11083                           
11084                           ; PI/4 = 0.7853981633974483096156608458198757210492923
11085  F87781  D1 1C DC 80 8B   cpio4:  .DB     $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$34
               62 C6 C4 34 
11086  F8778A  C2 68 21 A2 DA           .DB     $C2,$68,$21,$A2,$DA,$0F,$C9,$FE,$3F
               0F C9 FE 3F 
11087                           
11088                           ; PI/2
11089  F87793  D1 1C DC 80 8B   cpio2:  .DB     $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$34
               62 C6 C4 34 
11090  F8779C  C2 68 21 A2 DA           .DB     $C2,$68,$21,$A2,$DA,$0F,$C9,$FF,$3F
               0F C9 FF 3F 
11091                           
11092                           ; PI
11093  F877A5  D1 1C DC 80 8B   cpi:    .DB     $D1,$1C,$DC,$80,$8B,$62,$C6,$C4,$34
               62 C6 C4 34 
11094  F877AE  C2 68 21 A2 DA           .DB     $C2,$68,$21,$A2,$DA,$0F,$C9,$00,$40
               0F C9 00 40 
11095                           
11096                           ; tan(3*pi/8) = sqrt(2)+1 
11097  F877B7  4F 5F A5 BA D9   ct3p8:  .DB     $4F,$5F,$A5,$BA,$D9,$C4,$BE,$2C,$42
               C4 BE 2C 42 
11098  F877C0  32 EF FC 99 79           .DB     $32,$EF,$FC,$99,$79,$82,$9A,$00,$40
               82 9A 00 40 
11099  F877C9                     
11100                           ; tan(pi/8) = sqrt(2)-1 
11101  F877C9  7C FA 2A D5 CD   ctp8:   .DB     $7C,$FA,$2A,$D5,$CD,$26,$F6,$65,$11
               26 F6 65 11 
11102  F877D2  92 79 E7 CF CC           .DB     $92,$79,$E7,$CF,$CC,$13,$D4,$FD,$3F
               13 D4 FD 3F 
11103                           
11104                           
11105                           ; tan(x) coefficients 
11106  F877DB                   ptan:
11107                           ; TP[5] = -9.889929415807650724957118893791829849557E-1 
11108  F877DB  58 BB A5 17 15           .DB     $58,$BB,$A5,$17,$15,$D7,$E3,$C6,$CB
               D7 E3 C6 CB 
11109  F877E4  04 71 10 34 A4           .DB     $04,$71,$10,$34,$A4,$2E,$FD,$FE,$BF
               2E FD FE BF 
11110                           
11111                           ; TP[4] =  1.272297782199996882828849455156962260810E3 
11112  F877ED  D1 56 CC 23 3E           .DB     $D1,$56,$CC,$23,$3E,$E5,$D8,$0B,$50
               E5 D8 0B 50 
11113  F877F6  29 4A 89 6E 87           .DB     $29,$4A,$89,$6E,$87,$09,$9F,$09,$40
               09 9F 09 40 
11114                           
11115                           ; TP[3] = -4.249691853501233575668486667664718192660E5 
11116  F877FF  94 A5 29 9E C5           .DB     $94,$A5,$29,$9E,$C5,$9C,$0D,$8B,$2B
               9C 0D 8B 2B 
  Tue Jul 17 11:00:18 2018                                                                                               Page  155




11117  F87808  C4 61 63 EE 25           .DB     $C4,$61,$63,$EE,$25,$81,$CF,$11,$C0
               81 CF 11 C0 
11118                           
11119                           ; TP[2] =  5.160188250214037865511600561074819366815E7 
11120  F87811  B4 52 C1 B5 30           .DB     $B4,$52,$C1,$B5,$30,$D3,$30,$C9,$14
               D3 30 C9 14 
11121  F8781A  66 11 23 A0 76           .DB     $66,$11,$23,$A0,$76,$D8,$C4,$18,$40
               D8 C4 18 40 
11122                           
11123                           ; TP[1] = -2.307030822693734879744223131873392503321E9 
11124  F87823  55 27 82 DF 66           .DB     $55,$27,$82,$DF,$66,$F2,$8E,$98,$EC
               F2 8E 98 EC 
11125  F8782C  9B 98 B1 26 7F           .DB     $9B,$98,$B1,$26,$7F,$82,$89,$1E,$C0
               82 89 1E C0 
11126                           
11127                           ; TP[0] =  2.883414728874239697964612246732416606301E10 
11128  F87835  16 C6 4C C5 B1           .DB     $16,$C6,$4C,$C5,$B1,$35,$56,$87,$4F
               35 56 87 4F 
11129  F8783E  B7 C1 17 7B C5           .DB     $B7,$C1,$17,$7B,$C5,$D4,$D6,$21,$40
               D4 D6 21 40 
11130                           
11131  F87847                   qtan:
11132                           ; TQ[5] = -1.317243702830553658702531997959756728291E3 
11133  F87847  FA D3 81 DD E9           .DB     $FA,$D3,$81,$DD,$E9,$7B,$94,$EB,$80
               7B 94 EB 80 
11134  F87850  75 E5 E0 69 CC           .DB     $75,$E5,$E0,$69,$CC,$A7,$A4,$09,$C0
               A7 A4 09 C0 
11135                           
11136                           ; TQ[4] =  4.529422062441341616231663543669583527923E5 
11137  F87859  E6 99 66 53 23           .DB     $E6,$99,$66,$53,$23,$56,$5A,$89,$E9
               56 5A 89 E9 
11138  F87862  66 4C 8D 99 C6           .DB     $66,$4C,$8D,$99,$C6,$29,$DD,$11,$40
               29 DD 11 40 
11139                           
11140                           ; TQ[3] = -5.733709132766856723608447733926138506824E7 
11141  F8786B  69 45 D0 B9 5E           .DB     $69,$45,$D0,$B9,$5E,$77,$B9,$31,$0D
               77 B9 31 0D 
11142  F87874  95 85 F8 D4 40           .DB     $95,$85,$F8,$D4,$40,$B9,$DA,$18,$C0
               B9 DA 18 C0 
11143                           
11144                           ; TQ[2] =  2.758476078803232151774723646710890525496E9 
11145  F8787D  25 48 F2 7D A4           .DB     $25,$48,$F2,$7D,$A4,$71,$D8,$F7,$4E
               71 D8 F7 4E 
11146  F87886  9F A0 CD 2E 01           .DB     $9F,$A0,$CD,$2E,$01,$6B,$A4,$1E,$40
               6B A4 1E 40 
11147                           
11148                           ; TQ[1] = -4.152206921457208101480801635640958361612E10 
11149  F8788F  45 68 68 C0 AA           .DB     $45,$68,$68,$C0,$AA,$ED,$34,$14,$6C
               ED 34 14 6C 
11150  F87898  3E 27 E9 ED 87           .DB     $3E,$27,$E9,$ED,$87,$AE,$9A,$22,$C0
               AE 9A 22 C0 
11151                           
11152                           ; TQ[0] =  8.650244186622719093893836740197250197602E10 
11153  F878A1  30 B9 F9 53 45           .DB     $30,$B9,$F9,$53,$45,$A8,$80,$A5,$7B
               A8 80 A5 7B 
11154  F878AA  49 D1 51 1C 94           .DB     $49,$D1,$51,$1C,$94,$1F,$A1,$23,$40
               1F A1 23 40 
  Tue Jul 17 11:00:18 2018                                                                                               Page  156




11155                           
11156                           ; asin(x) coefficients
11157  F878B3                   casp:
11158                           ; ASP[9] = -8.067112765482705313585175280952515549833E-1  
11159  F878B3  73 27 C0 8D 2C           .DB     $73,$27,$C0,$8D,$2C,$37,$96,$A8,$04
               37 96 A8 04 
11160  F878BC  05 D8 16 56 A1           .DB     $05,$D8,$16,$56,$A1,$84,$CE,$FE,$BF
               84 CE FE BF 
11161                           
11162                           ; ASP[8] =  4.845649797786849136525020822000172350977E1 
11163  F878C5  10 4E 72 84 A0           .DB     $10,$4E,$72,$84,$A0,$F4,$1C,$1D,$A9
               F4 1C 1D A9 
11164  F878CE  8C 8A B6 34 74           .DB     $8C,$8A,$B6,$34,$74,$D3,$C1,$04,$40
               D3 C1 04 40 
11165                           
11166                           ; ASP[7] = -8.510195404865297879959793548843395926847E2 
11167  F878D7  EB 4D 4D 8F C3           .DB     $EB,$4D,$4D,$8F,$C3,$B1,$24,$A9,$BD
               B1 24 A9 BD 
11168  F878E0  F9 A5 BD 26 40           .DB     $F9,$A5,$BD,$26,$40,$C1,$D4,$08,$C0
               C1 D4 08 C0 
11169                           
11170                           ; ASP[6] =  6.815196841370292688574521445731895826485E3 
11171  F878E9  AA 5E 2D 43 AA           .DB     $AA,$5E,$2D,$43,$AA,$66,$ED,$0A,$61
               66 ED 0A 61 
11172  F878F2  41 7F 91 21 93           .DB     $41,$7F,$91,$21,$93,$F9,$D4,$0B,$40
               F9 D4 0B 40 
11173                           
11174                           ; ASP[5] = -2.967135182120339728996157454994675519735E4 
11175  F878FB  F2 CA 89 AC E2           .DB     $F2,$CA,$89,$AC,$E2,$B3,$AC,$51,$EE
               B3 AC 51 EE 
11176  F87904  42 A5 E8 21 B4           .DB     $42,$A5,$E8,$21,$B4,$CE,$E7,$0D,$C0
               CE E7 0D C0 
11177                           
11178                           ; ASP[4] =  7.612250656518818109652985996692466409670E4 
11179  F8790D  4D 89 09 49 F6           .DB     $4D,$89,$09,$49,$F6,$5B,$21,$9C,$D3
               5B 21 9C D3 
11180  F87916  43 CA 20 D7 40           .DB     $43,$CA,$20,$D7,$40,$AD,$94,$0F,$40
               AD 94 0F 40 
11181                           
11182                           ; ASP[3] = -1.183360579752620455689557157684221905030E5 
11183  F8791F  C8 84 21 34 4B           .DB     $C8,$84,$21,$34,$4B,$51,$AB,$59,$3B
               51 AB 59 3B 
11184  F87928  3B BF BB 6B 07           .DB     $3B,$BF,$BB,$6B,$07,$20,$E7,$0F,$C0
               20 E7 0F C0 
11185                           
11186                           ; ASP[2] =  1.095432262510413338755837156377401348063E5 
11187  F87931  5C D5 0E A4 53           .DB     $5C,$D5,$0E,$A4,$53,$03,$23,$26,$83
               03 23 26 83 
11188  F8793A  9B 4B CB F5 9C           .DB     $9B,$4B,$CB,$F5,$9C,$F3,$D5,$0F,$40
               F3 D5 0F 40 
11189                           
11190                           ; ASP[1] = -5.554124580991113991999636773382495788705E4 
11191  F87943  A8 77 07 20 6B           .DB     $A8,$77,$07,$20,$6B,$5E,$DE,$66,$ED
               5E DE 66 ED 
11192  F8794C  60 F9 65 ED 3E           .DB     $60,$F9,$65,$ED,$3E,$F5,$D8,$0E,$C0
               F5 D8 0E C0 
11193                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  157




11194                           ; ASP[0] =  1.187132626694762543537732514905488896985E4 
11195  F87955  14 17 24 62 E1           .DB     $14,$17,$24,$62,$E1,$9B,$9A,$F9,$98
               9B 9A F9 98 
11196  F8795E  44 37 EC 18 4E           .DB     $44,$37,$EC,$18,$4E,$7D,$B9,$0C,$40
               7D B9 0C 40 
11197                           
11198  F87967                   casq: 
11199                           ; ASQ[9] = -8.005471061732009595694099899234272342478E1 
11200  F87967  AB CB 99 42 E0           .DB     $AB,$CB,$99,$42,$E0,$53,$D9,$98,$3E
               53 D9 98 3E 
11201  F87970  7F 44 B0 07 03           .DB     $7F,$44,$B0,$07,$03,$1C,$A0,$05,$C0
               1C A0 05 C0 
11202                           
11203                           ; ASQ[8] =  1.817324228942812880965069608562483918025E3 
11204  F87979  74 B0 9D 55 FC           .DB     $74,$B0,$9D,$55,$FC,$EE,$98,$24,$09
               EE 98 24 09 
11205  F87982  89 39 60 15 60           .DB     $89,$39,$60,$15,$60,$2A,$E3,$09,$40
               2A E3 09 40 
11206                           
11207                           ; ASQ[7] = -1.867017317425756524289537002141956583706E4 
11208  F8798B  CA 11 F0 E5 FC           .DB     $CA,$11,$F0,$E5,$FC,$8D,$72,$C6,$EB
               8D 72 C6 EB 
11209  F87994  80 D9 4B AA 58           .DB     $80,$D9,$4B,$AA,$58,$DC,$91,$0D,$C0
               DC 91 0D C0 
11210                           
11211                           ; ASQ[6] =  1.048196619402464497478959760337779705622E5 
11212  F8799D  EA F9 4B 5E 82           .DB     $EA,$F9,$4B,$5E,$82,$00,$4C,$57,$34
               00 4C 57 34 
11213  F879A6  34 3F 75 BA D4           .DB     $34,$3F,$75,$BA,$D4,$B9,$CC,$0F,$40
               B9 CC 0F 40 
11214                           
11215                           ; ASQ[5] = -3.527040897897253459022458866536165564103E5 
11216  F879AF  9E F0 E3 86 B9           .DB     $9E,$F0,$E3,$86,$B9,$BB,$11,$41,$14
               BB 11 41 14 
11217  F879B8  BC B3 8E DF 02           .DB     $BC,$B3,$8E,$DF,$02,$38,$AC,$11,$C0
               38 AC 11 C0 
11218                           
11219                           ; ASQ[4] =  7.426302422018858001691440351763370029242E5 
11220  F879C1  72 C6 78 BF 89           .DB     $72,$C6,$78,$BF,$89,$F9,$2E,$F9,$A8
               F9 2E F9 A8 
11221  F879CA  A8 15 0F E0 63           .DB     $A8,$15,$0F,$E0,$63,$4E,$B5,$12,$40
               4E B5 12 40 
11222                           
11223                           ; ASQ[3] = -9.863068411558756277454631976667880674474E5 
11224  F879D3  FF 38 2A 9B 42           .DB     $FF,$38,$2A,$9B,$42,$07,$BF,$F1,$8C
               07 BF F1 8C 
11225  F879DC  0A DD 5F 75 2D           .DB     $0A,$DD,$5F,$75,$2D,$CC,$F0,$12,$C0
               CC F0 12 C0 
11226                           
11227                           ; ASQ[2] =  8.025654653926121907774766642393757364326E5 
11228  F879E5  C1 3C 5A DF 8E           .DB     $C1,$3C,$5A,$DF,$8E,$AF,$32,$E7,$8C
               AF 32 E7 8C 
11229  F879EE  12 86 3F 72 57           .DB     $12,$86,$3F,$72,$57,$F0,$C3,$12,$40
               F0 C3 12 40 
11230                           
11231                           ; ASQ[1] = -3.653000557802254281954969843055623398839E5 
11232  F879F7  CA 1B 43 FC 90           .DB     $CA,$1B,$43,$FC,$90,$05,$03,$8F,$48
  Tue Jul 17 11:00:18 2018                                                                                               Page  158




               05 03 8F 48 
11233  F87A00  7F 9C F3 C8 81           .DB     $7F,$9C,$F3,$C8,$81,$5E,$B2,$11,$C0
               5E B2 11 C0 
11234                           
11235                           ; ASQ[0] =  7.122795760168575261226395089432959614179E4 
11236  F87A09  93 75 A5 09 E9           .DB     $93,$75,$A5,$09,$E9,$F4,$33,$BB,$72
               F4 33 BB 72 
11237  F87A12  73 29 B1 92 FA           .DB     $73,$29,$B1,$92,$FA,$1D,$8B,$0F,$40
               1D 8B 0F 40 
11238                           
11239                           ; atan(x) coefficients
11240  F87A1B                   catp:
11241                           ; ATP[08] = -6.635810778635296712545011270011752799963E-4 
11242  F87A1B  F1 6B 5F 23 D7           .DB     $F1,$6B,$5F,$23,$D7,$8E,$2D,$08,$F8
               8E 2D 08 F8 
11243  F87A24  79 13 55 1C 2C           .DB     $79,$13,$55,$1C,$2C,$F4,$AD,$F4,$BF
               F4 AD F4 BF 
11244                           
11245                           ; ATP[07] = -8.768423468036849091777415076702113400070E-1 
11246  F87A2D  0C 62 A5 C3 8A           .DB     $0C,$62,$A5,$C3,$8A,$2F,$F9,$15,$4D
               2F F9 15 4D 
11247  F87A36  29 0C 45 73 BD           .DB     $29,$0C,$45,$73,$BD,$78,$E0,$FE,$BF
               78 E0 FE BF 
11248                           
11249                           ; ATP[06] = -2.548067867495502632615671450650071218995E1 
11250  F87A3F  EA FC 2D 13 27           .DB     $EA,$FC,$2D,$13,$27,$8A,$73,$51,$2A
               8A 73 51 2A 
11251  F87A48  18 88 A6 0F 6E           .DB     $18,$88,$A6,$0F,$6E,$D8,$CB,$03,$C0
               D8 CB 03 C0 
11252                           
11253                           ; ATP[05] = -2.497759878476618348858065206895055957104E2 
11254  F87A51  F8 A0 32 CF E6           .DB     $F8,$A0,$32,$CF,$E6,$62,$5C,$EB,$0C
               62 5C EB 0C 
11255  F87A5A  0F CD BB 23 A7           .DB     $0F,$CD,$BB,$23,$A7,$C6,$F9,$06,$C0
               C6 F9 06 C0 
11256                           
11257                           ; ATP[04] = -1.148164399808514330375280133523543970854E3 
11258  F87A63  F0 5F EE 9D 20           .DB     $F0,$5F,$EE,$9D,$20,$0D,$F2,$58,$EE
               0D F2 58 EE 
11259  F87A6C  34 21 63 C3 42           .DB     $34,$21,$63,$C3,$42,$85,$8F,$09,$C0
               85 8F 09 C0 
11260                           
11261                           ; ATP[03] = -2.792272753241044941703278827346430350236E3 
11262  F87A75  9A CD A1 B3 A8           .DB     $9A,$CD,$A1,$B3,$A8,$AB,$A8,$87,$0E
               AB A8 87 0E 
11263  F87A7E  A8 A2 80 32 5D           .DB     $A8,$A2,$80,$32,$5D,$84,$AE,$0A,$C0
               84 AE 0A C0 
11264                           
11265                           ; ATP[02] = -3.696264445691821235400930243493001671932E3 
11266  F87A87  76 73 C3 5C DA           .DB     $76,$73,$C3,$5C,$DA,$FA,$F9,$C5,$78
               FA F9 C5 78 
11267  F87A90  0B DF 67 2B 3B           .DB     $0B,$DF,$67,$2B,$3B,$04,$E7,$0A,$C0
               04 E7 0A C0 
11268                           
11269                           ; ATP[01] = -2.514829758941713674909996882101723647996E3 
11270  F87A99  FF 23 4B CB 5F           .DB     $FF,$23,$4B,$CB,$5F,$46,$30,$6F,$B3
               46 30 6F B3 
  Tue Jul 17 11:00:18 2018                                                                                               Page  159




11271  F87AA2  94 E3 4F B1 46           .DB     $94,$E3,$4F,$B1,$46,$2D,$9D,$0A,$C0
               2D 9D 0A C0 
11272                           
11273                           ; ATP[00] = -6.880597774405940432145577545328795037141E2 
11274  F87AAB  02 27 91 66 97           .DB     $02,$27,$91,$66,$97,$AB,$B4,$ED,$BB
               AB B4 ED BB 
11275  F87AB4  F5 18 C2 64 D3           .DB     $F5,$18,$C2,$64,$D3,$03,$AC,$08,$C0
               03 AC 08 C0 
11276                           
11277  F87ABD                   catq:
11278                           ; ATQ[07] =  3.566239794444800849656497338030115886153E1  
11279  F87ABD  C0 AA A1 BA 09           .DB     $C0,$AA,$A1,$BA,$09,$B0,$53,$CA,$64
               B0 53 CA 64 
11280  F87AC6  06 5E 91 A5 4B           .DB     $06,$5E,$91,$A5,$4B,$A6,$8E,$04,$40
               A6 8E 04 40 
11281                           
11282                           ; ATQ[06] =  4.308348370818927353321556740027020068897E2  
11283  F87ACF  F3 26 2F 03 B5           .DB     $F3,$26,$2F,$03,$B5,$85,$60,$C3,$D8
               85 60 C3 D8 
11284  F87AD8  D2 1B 06 F1 DB           .DB     $D2,$1B,$06,$F1,$DB,$6A,$D7,$07,$40
               6A D7 07 40 
11285                           
11286                           ; ATQ[05] =  2.494680540950601626662048893678584497900E3  
11287  F87AE1  37 5A 94 B0 14           .DB     $37,$5A,$94,$B0,$14,$01,$F9,$F5,$88
               01 F9 F5 88 
11288  F87AEA  C3 66 E8 7E E3           .DB     $C3,$66,$E8,$7E,$E3,$EA,$9B,$0A,$40
               EA 9B 0A 40 
11289                           
11290                           ; ATQ[04] =  7.928572347062145288093560392463784743935E3 
11291  F87AF3  E8 83 10 77 27           .DB     $E8,$83,$10,$77,$27,$F7,$9C,$C9,$6A
               F7 9C C9 6A 
11292  F87AFC  01 4F B2 2A 94           .DB     $01,$4F,$B2,$2A,$94,$C4,$F7,$0B,$40
               C4 F7 0B 40 
11293                           
11294                           ; ATQ[03] =  1.458510242529987155225086911411015961174E4  
11295  F87B05  F4 89 D9 F7 87           .DB     $F4,$89,$D9,$F7,$87,$4A,$D8,$81,$DC
               4A D8 81 DC 
11296  F87B0E  EC 84 2D E2 68           .DB     $EC,$84,$2D,$E2,$68,$E4,$E3,$0C,$40
               E4 E3 0C 40 
11297                           
11298                           ; ATQ[02] =  1.547394317752562611786521896296215170819E4  
11299  F87B17  D6 33 A9 9B 41           .DB     $D6,$33,$A9,$9B,$41,$D7,$06,$B7,$A6
               D7 06 B7 A6 
11300  F87B20  8B 4B 54 D0 C5           .DB     $8B,$4B,$54,$D0,$C5,$C7,$F1,$0C,$40
               C7 F1 0C 40 
11301                           
11302                           ; ATQ[01] =  8.782996876218210302516194604424986107121E3 
11303  F87B29  F6 15 46 E3 7B           .DB     $F6,$15,$46,$E3,$7B,$EE,$EE,$EA,$5E
               EE EE EA 5E 
11304  F87B32  7E 8D 1E CD FC           .DB     $7E,$8D,$1E,$CD,$FC,$3B,$89,$0C,$40
               3B 89 0C 40 
11305                           
11306                           ; ATQ[00] =  2.064179332321782129643673263598686441900E3 
11307  F87B3B  AD 9F 29 8D B1           .DB     $AD,$9F,$29,$8D,$B1,$80,$47,$F2,$4C
               80 47 F2 4C 
11308  F87B44  B8 92 91 8B DE           .DB     $B8,$92,$91,$8B,$DE,$02,$81,$0A,$40
               02 81 0A 40 
  Tue Jul 17 11:00:18 2018                                                                                               Page  160




11309                           
11310                           ;---------------------------------------------------------------------------
11311                           ; hyperbolics functions & inverse hyperbolics functions
11312                           ;---------------------------------------------------------------------------
11313                           
11314                           ; fsinh - returns the hyperbolic sin of the argument
11315                           ;
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      -x
11324                           ;                             e   -  e
11325                           ; Mathematically sinh(x)  =  -----------
11326                           ;                                 2
11327                           ;
11328                           ;       1) if |x| <=1 sinh(x) is approximated by a rational function:
11329                           ;
11330                           ;                              3                P(z)        2
11331                           ;               sinh(x) = x + x * R(z), R(z) = ------, z = x
11332                           ;                                               Q(z)
11333                           ;
11334                           ;                                               E          |x|
11335                           ;       2) |x| > 1: sinh(x) = sgn(x)*0.5*(E + -----), E = e   - 1 = expm1(|x|)
11336                           ;                                              E+1
11337                           ;
11338                           ;       computation mean time: 65/100ms at 4MHz
11339                           ;
11340                           ;       Note: overflow if |x| >= 11356.25
11341                           ;
11342                           ;-----
11343  F87B4D                   fsinh:
11344                           ;-----
11345  F87B4D  38                       sec
11346  F87B4E  24 25                    bit     facst
11347  F87B50  30 03                    bmi     ?rts            ; fac=inf or inf
11348  F87B52  50 02                    bvc     ?nz             ; if fac=0 returns zero
11349  F87B54  18                       clc
11350  F87B55  60               ?rts:   rts
11351  F87B56  20 24 74         ?nz:    jsr     cmpx1           ; compare |x| vs. 1.0
11352  F87B59  F0 2E                    beq     rsinh           ; |x|=1
11353  F87B5B  90 2C                    bcc     rsinh           ; |x|<1
11354  F87B5D  A5 24                    lda     facsgn          ; sinh(-x)=-sinh(x)
11355  F87B5F  85 CF                    sta     fpcsgn          ; save sign
11356  F87B61  64 24                    stz     facsgn          ; |x|
11357  F87B63  20 BD 69                 jsr     fexpm1          ; E=exp(|x|)-1
11358  F87B66  B0 1C                    bcs     ?done           ; overflow
11359  F87B68  20 66 84                 jsr     mvf_t0
11360  F87B6B  20 6C 45                 jsr     faddone         ; E+1
11361  F87B6E  B0 14                    bcs     ?done           ; overflow
11362  F87B70  20 CE 85                 jsr     mvt0_a          ; arg=E
11363  F87B73  20 10 4A                 jsr     fpdiv           ; E/(E+1)
11364  F87B76  20 CE 85                 jsr     mvt0_a          ; arg=E
11365  F87B79  20 7D 45                 jsr     fpadd           ; E+E/(E+1)
  Tue Jul 17 11:00:18 2018                                                                                               Page  161




11366  F87B7C  B0 06                    bcs     ?done           ; overflow
11367  F87B7E                           ACC16                   ; for sure here fac is normal
11368  F87B7E  C2 20                    rep     #PMFLAG
11369                                   .LONGA  on
11370                                   .MNLIST
11371  F87B80  C6 22                    dec     facexp          ; divide by 2
11372  F87B82                           ACC08
11373  F87B82  E2 20                    sep     #PMFLAG
11374                                   .LONGA  off
11375                                   .MNLIST
11376  F87B84  A5 CF            ?done:  lda     fpcsgn
11377  F87B86  85 24                    sta     facsgn          ; set sign
11378  F87B88  60                       rts
11379                           
11380                           ; returns sinh(x) when |x|<=1 (approximated by rational function)       
11381  F87B89                   rsinh:  
11382  F87B89  20 93 84                 jsr     mvf_t1          ; tfr1=x
11383  F87B8C  20 CC 49                 jsr     fsquare         ; z=x*x
11384  F87B8F  20 66 84                 jsr     mvf_t0          ; tfr0=z
11385  F87B92  A9 6C                    lda     #<cshp
11386  F87B94  A0 7E                    ldy     #>cshp
11387  F87B96  A2 05                    ldx     #5
11388  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     #<cshq
11391  F87BA0  A0 7E                    ldy     #>cshq
11392  F87BA2  A2 05                    ldx     #5
11393  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     fpdiv
11396  F87BAD  20 CE 85                 jsr     mvt0_a          ; arg=z
11397  F87BB0  20 DD 49                 jsr     fpmult          ; z*R(z)
11398  F87BB3  20 FB 85                 jsr     mvt1_a          ; arg=x
11399  F87BB6  20 DD 49                 jsr     fpmult          ; x*z*R(z)
11400  F87BB9  20 FB 85                 jsr     mvt1_a          ; arg=x
11401  F87BBC  4C 7D 45                 jmp     fpadd           ; returns sinh(x)=x + x*z*R(z)
11402                           
11403                           ; fcosh - returns the hyperbolic cosin of the argument
11404                           ;
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      -x
11413                           ;                             e   +  e
11414                           ; Mathematically cosh(x)  =  -----------
11415                           ;                                 2
11416                           ;
11417                           ;       1) if |x| <=1 cosh(x) is approximated by a rational function
11418                           ;          that evaluates sinh(|x|):
11419                           ;
11420                           ;                              3                P(z)        2
11421                           ;               sinh(x) = x + x * R(z), R(z) = ------, z = x
11422                           ;                                               Q(z)
  Tue Jul 17 11:00:18 2018                                                                                               Page  162




11423                           ;                                          2
11424                           ;          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|) + 1
11428                           ;                                       E
11429                           ;
11430                           ;       computation mean time: 100ms at 4MHz
11431                           ;
11432                           ;       Note: overflow if |x| >= 11356.25
11433                           ;
11434                           ;-----
11435  F87BBF                   fcosh:
11436                           ;-----
11437  F87BBF  64 24                    stz     facsgn          ; cosh(-x) = cosh(x)
11438  F87BC1  38                       sec
11439  F87BC2  24 25                    bit     facst
11440  F87BC4  30 05                    bmi     ?rts            ; fac=inf or nan
11441  F87BC6  50 04                    bvc     ?nz             ; if fac=0 returns 1
11442  F87BC8  4C 2E 4E                 jmp     fldp1
11443  F87BCB  60               ?rts:   rts
11444  F87BCC  20 24 74         ?nz:    jsr     cmpx1           ; compare |x| vs. 1.0
11445  F87BCF  F0 02                    beq     ?le1            ; |x|=1
11446  F87BD1  B0 0C                    bcs     ?gt1            ; |x|>1
11447  F87BD3  20 89 7B         ?le1:   jsr     rsinh           ; sinh(|x|)
11448  F87BD6  20 CC 49                 jsr     fsquare         ; sinh(|x|)^2
11449  F87BD9  20 6C 45                 jsr     faddone         ; 1+sinh(|x|)^2
11450  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            ; overflow
11453  F87BE4  20 6C 45                 jsr     faddone
11454  F87BE7  B0 E2                    bcs     ?rts            ; overflow
11455  F87BE9  20 66 84                 jsr     mvf_t0
11456  F87BEC  20 9F 4E                 jsr     ldahalf
11457  F87BEF  20 10 4A                 jsr     fpdiv           ; 0.5/E
11458  F87BF2  20 CE 85                 jsr     mvt0_a          ; arg=E
11459  F87BF5                           ACC16
11460  F87BF5  C2 20                    rep     #PMFLAG
11461                                   .LONGA  on
11462                                   .MNLIST
11463  F87BF7  C6 3A                    dec     argexp          ; E/2
11464  F87BF9                           ACC08   
11465  F87BF9  E2 20                    sep     #PMFLAG
11466                                   .LONGA  off
11467                                   .MNLIST
11468  F87BFB  4C 7D 45                 jmp     fpadd
11469                           
11470                           ; ftanh - returns the hyperbolic tangent of the argument
11471                           ;
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      -x
  Tue Jul 17 11:00:18 2018                                                                                               Page  163




11480                           ;                             e   -  e
11481                           ; Mathematically cosh(x)  =  -----------
11482                           ;                              x      -x
11483                           ;                             e   +  e
11484                           ;
11485                           ; strategy
11486                           ;
11487                           ;       1) if |x| < 0.625 tanh(x) is approximated by a rational function:
11488                           ;
11489                           ;                              3                P(z)        2
11490                           ;               tanh(x) = x + x * R(z), R(z) = ------, z = x
11491                           ;                                               Q(z)
11492                           ;
11493                           ;                                        2            2|x|
11494                           ;       2) |x| > 0.625: tanh(x) = 1 - -------,   E = e 
11495                           ;                                      E + 1
11496                           ;
11497                           ;       computation mean time: 60/100ms at 4MHz
11498                           ;
11499                           ;       Note: if |x| >= 40 tanh(x) = +/-1
11500                           ;
11501                           ;-----
11502  F87BFE                   ftanh:
11503                           ;-----
11504  F87BFE  24 25                    bit     facst
11505  F87C00  10 07                    bpl     ?fv             ; valid
11506  F87C02  50 03                    bvc     ?er             ; fac=nan so returns nan
11507  F87C04  4C 36 4E                 jmp     fld1            ; if fac =+/-inf returns +/-1
11508  F87C07  38               ?er:    sec
11509  F87C08  60                       rts
11510  F87C09  70 47            ?fv:    bvs     ?ok             ; if fac=0 returns zero 
11511  F87C0B                           ACC16                   ; compare |x| vs. 0.625
11512  F87C0B  C2 20                    rep     #PMFLAG
11513                                   .LONGA  on
11514                                   .MNLIST
11515  F87C0D  A5 22                    lda     facexp
11516  F87C0F  C9 FE 3F                 cmp     #$3FFE
11517  F87C12  F0 02                    beq     ?tst
11518  F87C14  B0 05                    bcs     ?cc             ; |x| > 0.625
11519  F87C16  A5 20            ?tst:   lda     facm+14
11520  F87C18  C9 00 A0                 cmp     #$A000
11521  F87C1B                   ?cc:    ACC08
11522  F87C1B  E2 20                    sep     #PMFLAG
11523                                   .LONGA  off
11524                                   .MNLIST
11525  F87C1D  90 35                    bcc     ?pp             ; |x| < 0.625
11526  F87C1F  A5 24                    lda     facsgn
11527  F87C21  85 CF                    sta     fpcsgn          ; save sign
11528  F87C23  64 24                    stz     facsgn          ; |x|
11529  F87C25                           ACC16
11530  F87C25  C2 20                    rep     #PMFLAG
11531                                   .LONGA  on
11532                                   .MNLIST
11533  F87C27  A5 22                    lda     facexp
11534  F87C29  C9 FE 7F                 cmp     #MAXEXP
11535  F87C2C  B0 03                    bcs     ?cc2
11536  F87C2E  1A                       inc     a
  Tue Jul 17 11:00:18 2018                                                                                               Page  164




11537  F87C2F  85 22                    sta     facexp
11538  F87C31                   ?cc2:   ACC08
11539  F87C31  E2 20                    sep     #PMFLAG
11540                                   .LONGA  off
11541                                   .MNLIST
11542  F87C33  B0 16                    bcs     ?th1            ; overflow: return +1   
11543  F87C35  20 6B 68                 jsr     fexp            ; exp(|2x|)
11544  F87C38  B0 11                    bcs     ?th1            ; overflow
11545  F87C3A  20 6C 45                 jsr     faddone
11546  F87C3D  20 AD 4E                 jsr     ldatwo          ; arg=2.0
11547  F87C40  20 10 4A                 jsr     fpdiv           ; 2/(exp(|2x|)+1)
11548  F87C43  20 A6 4E                 jsr     ldaone
11549  F87C46  20 5F 45                 jsr     fpsub           ; 1 - 2/(exp(|2x|)+1)   
11550  F87C49  80 03                    bra     ?done
11551  F87C4B  20 36 4E         ?th1:   jsr     fld1            ; set fac=1
11552  F87C4E  A5 CF            ?done:  lda     fpcsgn
11553  F87C50  85 24                    sta     facsgn          ; set sign
11554  F87C52  18               ?ok:    clc
11555  F87C53  60                       rts
11556  F87C54  20 93 84         ?pp:    jsr     mvf_t1          ; tfr1=x
11557  F87C57  20 CC 49                 jsr     fsquare         ; z=x*x
11558  F87C5A  20 66 84                 jsr     mvf_t0          ; tfr0=z
11559  F87C5D  A9 44                    lda     #<cthp
11560  F87C5F  A0 7F                    ldy     #>cthp
11561  F87C61  A2 05                    ldx     #5
11562  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     #<cthq
11565  F87C6B  A0 7F                    ldy     #>cthq
11566  F87C6D  A2 04                    ldx     #4
11567  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=z
11571  F87C7B  20 DD 49                 jsr     fpmult          ; z*R(z)
11572  F87C7E  20 FB 85                 jsr     mvt1_a          ; arg=x
11573  F87C81  20 DD 49                 jsr     fpmult          ; x*z*R(z)
11574  F87C84  20 FB 85                 jsr     mvt1_a          ; arg=x
11575  F87C87  4C 7D 45                 jmp     fpadd           ; returns tanh(x)=x + x*z*R(z)
11576                           
11577                           ; fasinh - returns the inverse hyperbolic sine of the argument
11578                           ;
11579                           ;       entry:
11580                           ;               fac=x
11581                           ;
11582                           ;       exit:
11583                           ;               fac=asinh(x)
11584                           ;               CF = 1 if invalid result(inf or nan)
11585                           ;
11586                           ; strategy
11587                           ;
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)         2
11593                           ;               asinh(x) = x + x * R(z), R(z) = ------, z = x
  Tue Jul 17 11:00:18 2018                                                                                               Page  165




11594                           ;                                               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 overflow
11601                           ;
11602                           ;          or:
11603                           ;
11604                           ;               asinh(x) = sgn(x)*[ln(|x|) + ln(2)]  if 2*|x| overflow
11605                           ;
11606                           ;       computation mean time: 100/150ms at 4MHz
11607                           ;
11608                           ;------
11609  F87C8A                   fasinh:
11610                           ;------
11611  F87C8A  38                       sec
11612  F87C8B  24 25                    bit     facst           ; if fac=nan or fac=inf returns nan or inf
11613  F87C8D  30 03                    bmi     ?rts
11614  F87C8F  50 02                    bvc     ?fv
11615  F87C91  18                       clc                     ; if fac=0 returns zero
11616  F87C92  60               ?rts:   rts
11617  F87C93  A5 24            ?fv:    lda     facsgn          ; asinh(-x) = -asinh(x)
11618  F87C95  85 CF                    sta     fpcsgn          ; save sign
11619  F87C97  64 24                    stz     facsgn          ; |x|
11620  F87C99                           ACC16
11621  F87C99  C2 20                    rep     #PMFLAG
11622                                   .LONGA  on
11623                                   .MNLIST
11624  F87C9B  A5 22                    lda     facexp
11625  F87C9D  C9 FE 3F                 cmp     #$3FFE          ; 0.5
11626  F87CA0                           ACC08
11627  F87CA0  E2 20                    sep     #PMFLAG
11628                                   .LONGA  off
11629                                   .MNLIST
11630  F87CA2  08                       php
11631  F87CA3  20 C0 84                 jsr     mvf_t2          ; tfr2=|x|
11632  F87CA6  20 CC 49                 jsr     fsquare         ; z=x*x
11633  F87CA9  28                       plp
11634  F87CAA  90 34                    bcc     ?lt05           ; |x| < 0.5
11635  F87CAC  20 6C 45                 jsr     faddone         ; z+1
11636  F87CAF  B0 10                    bcs     ?big            ; x*x overflow
11637  F87CB1  20 53 60                 jsr     fsqrt           ; sqrt(z+1)
11638  F87CB4  20 28 86                 jsr     mvt2_a          ; arg=x
11639  F87CB7  20 7D 45                 jsr     fpadd           ; x+sqrt(z+1)   
11640  F87CBA  B0 05                    bcs     ?big            ; overflow
11641  F87CBC  20 B3 62                 jsr     floge           ; ln(x+sqrt(z+1))
11642  F87CBF  80 4F                    bra     ?done
11643  F87CC1  20 A1 85         ?big:   jsr     mvt2_f
11644  F87CC4  20 39 84                 jsr     mvftoa
11645  F87CC7  20 7D 45                 jsr     fpadd           ; try 2*|x|
11646  F87CCA  B0 05                    bcs     ?big1           ; overflow
11647  F87CCC  20 B3 62                 jsr     floge           ; asinh(x) = sgn(x)*(ln(2*|x|))
11648  F87CCF  80 3F                    bra     ?done
11649  F87CD1  20 A1 85         ?big1:  jsr     mvt2_f
11650  F87CD4  20 B3 62                 jsr     floge
  Tue Jul 17 11:00:18 2018                                                                                               Page  166




11651  F87CD7  A9 B1                    lda     #<cln2          ; asinh(x) = sgn(x)*(ln(|x|) + ln(2))
11652  F87CD9  A0 67                    ldy     #>cln2
11653  F87CDB  20 7A 45                 jsr     fcadd
11654  F87CDE  80 30                    bra     ?done
11655  F87CE0  20 66 84         ?lt05:  jsr     mvf_t0          ; tfr0=z
11656  F87CE3  A9 0A                    lda     #<cashp
11657  F87CE5  A0 80                    ldy     #>cashp
11658  F87CE7  A2 08                    ldx     #8
11659  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     #<cashq
11662  F87CF1  A0 80                    ldy     #>cashq
11663  F87CF3  A2 08                    ldx     #8
11664  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=z
11668  F87D01  20 DD 49                 jsr     fpmult          ; z*R(z)
11669  F87D04  20 28 86                 jsr     mvt2_a          ; arg=x
11670  F87D07  20 DD 49                 jsr     fpmult          ; x*z*R(z)
11671  F87D0A  20 28 86                 jsr     mvt2_a          ; arg=x
11672  F87D0D  20 7D 45                 jsr     fpadd           ; asinh(x)=x + x*z*R(z)
11673  F87D10  A5 CF            ?done:  lda     fpcsgn          ; set sign
11674  F87D12  85 24                    sta     facsgn
11675  F87D14  60                       rts
11676                           
11677                           ; facosh - returns the inverse hyperbolic cosine of the argument
11678                           ;
11679                           ;       entry:
11680                           ;               fac=x
11681                           ;
11682                           ;       exit:
11683                           ;               fac=acosh(x)
11684                           ;               CF = 1 if invalid result(inf or nan)
11685                           ;
11686                           ; strategy
11687                           ;
11688                           ; Mathematically acosh(x) = ln[x + sqrt(x*x - 1)], x >= 1
11689                           ;
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 - 1
11694                           ;                                                    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 overflow
11701                           ;
11702                           ;          or:
11703                           ;
11704                           ;               acosh(x) = ln(x) + ln(2)  if 2*x overflow
11705                           ;
11706                           ;       computation mean time: 75/150ms at 4MHz
11707                           ;
  Tue Jul 17 11:00:18 2018                                                                                               Page  167




11708                           ;------
11709  F87D15                   facosh:
11710                           ;------
11711  F87D15  A5 24                    lda     facsgn          ; acosh(x) defined only if x>=1
11712  F87D17  30 0B                    bmi     ?nan
11713  F87D19  24 25                    bit     facst
11714  F87D1B  30 0A                    bmi     ?er             ; nan or inf; returns nan or inf
11715  F87D1D  20 24 74                 jsr     cmpx1           ; compare x with 1.0
11716  F87D20  F0 07                    beq     ?z              ; acosh(1) = 0
11717  F87D22  B0 08                    bcs     ?ok             ; returns nan if |x|<1
11718  F87D24  4C 74 4E         ?nan:   jmp     fldnan
11719  F87D27  38               ?er:    sec
11720  F87D28  60                       rts
11721  F87D29  4C 56 4E         ?z:     jmp     fldz
11722  F87D2C  A9 5A            ?ok:    lda     #<c1h5
11723  F87D2E  A0 7E                    ldy     #>c1h5
11724  F87D30  20 5E 87                 jsr     fccmp           ; compare x vs. 1.5
11725  F87D33  F0 3B                    beq     ?gt             ; x = 1.5
11726  F87D35  10 39                    bpl     ?gt             ; x > 1.5
11727  F87D37  20 71 45                 jsr     fsubone         ; z = x - 1 (x < 1.5)
11728  F87D3A  20 66 84                 jsr     mvf_t0          ; tfr0=z
11729  F87D3D  20 39 84                 jsr     mvftoa
11730  F87D40  20 7D 45                 jsr     fpadd           ; 2*z
11731  F87D43  20 C0 84                 jsr     mvf_t2          ; tfr2 = 2*z
11732  F87D46  A9 4E                    lda     #<cachp
11733  F87D48  A0 81                    ldy     #>cachp
11734  F87D4A  A2 09                    ldx     #9
11735  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     #<cachq
11738  F87D54  A0 82                    ldy     #>cachq
11739  F87D56  A2 08                    ldx     #8
11740  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*z
11745  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 = x
11749  F87D73  20 CC 49                 jsr     fsquare
11750  F87D76  B0 11                    bcs     ?big            ; x*x overflow
11751  F87D78  20 71 45                 jsr     fsubone         ; x*x - 1
11752  F87D7B  20 53 60                 jsr     fsqrt
11753  F87D7E  20 28 86                 jsr     mvt2_a          ; x
11754  F87D81  20 7D 45                 jsr     fpadd
11755  F87D84  B0 03                    bcs     ?big            ; overflow
11756  F87D86  4C B3 62                 jmp     floge           ; acosh(x) = ln[x + sqrt(x*x - 1)]
11757  F87D89  20 A1 85         ?big:   jsr     mvt2_f          ; x
11758  F87D8C  20 39 84                 jsr     mvftoa
11759  F87D8F  20 7D 45                 jsr     fpadd           ; try 2*x
11760  F87D92  B0 03                    bcs     ?big1           ; overflow
11761  F87D94  4C B3 62                 jmp     floge           ; acosh(x) = ln(2*x)
11762  F87D97  20 A1 85         ?big1:  jsr     mvt2_f          ; x
11763  F87D9A  20 B3 62                 jsr     floge
11764  F87D9D  A9 B1                    lda     #<cln2          ; acosh(x) = ln(x) + ln(2)
  Tue Jul 17 11:00:18 2018                                                                                               Page  168




11765  F87D9F  A0 67                    ldy     #>cln2
11766  F87DA1  4C 7A 45                 jmp     fcadd
11767                           
11768                           ; fatanh - returns the inverse hyperbolic tangent of the argument
11769                           ;
11770                           ;       entry:
11771                           ;               fac=x
11772                           ;
11773                           ;       exit:
11774                           ;               fac=atanh(x)
11775                           ;               CF = 1 if invalid result(inf or nan)
11776                           ;
11777                           ; strategy
11778                           ;                             1        1 + x    
11779                           ; Mathematically atanh(x) =  --- * ln(-------)  , -1 < x < 1
11780                           ;                             2        1 - x
11781                           ;
11782                           ;       1) if |x| < 0.5 atanh(x) is approximated by a rational function:
11783                           ;
11784                           ;                               3               P(z)         2
11785                           ;               atanh(x) = x + x * R(z), R(z) = ------, z = x
11786                           ;                                               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 4MHz
11795                           ;
11796                           ;------
11797  F87DA4                   fatanh:
11798                           ;------
11799  F87DA4  24 25                    bit     facst           ; if fac=nan or fac=inf returns nan
11800  F87DA6  30 07                    bmi     ?nan
11801  F87DA8  50 08                    bvc     ?fv
11802  F87DAA  18                       clc                     ; if fac=0 returns zero
11803  F87DAB  60                       rts
11804  F87DAC  4C 7D 4E         ?inf:   jmp     fldinf
11805  F87DAF  4C 74 4E         ?nan:   jmp     fldnan          ; if |x| > 1 returns nan
11806  F87DB2  20 24 74         ?fv:    jsr     cmpx1           ; compare x vs. 1.0
11807  F87DB5  F0 F5                    beq     ?inf            ; atanh(+/-1) = +/-inf
11808  F87DB7  B0 F6                    bcs     ?nan            ; if |x| > 1 returns nan
11809  F87DB9                           ACC16
11810  F87DB9  C2 20                    rep     #PMFLAG
11811                                   .LONGA  on
11812                                   .MNLIST
11813  F87DBB  A5 22                    lda     facexp
11814  F87DBD  C9 FE 3F                 cmp     #$3FFE          ; compare x vs. 0.5
11815  F87DC0                           ACC08
11816  F87DC0  E2 20                    sep     #PMFLAG
11817                                   .LONGA  off
11818                                   .MNLIST
11819  F87DC2  B0 36                    bcs     ?gt             ; |x| >= 0.5
11820  F87DC4  20 C0 84                 jsr     mvf_t2          ; tfr2 = x
11821  F87DC7  20 CC 49                 jsr     fsquare         ; z=x*x
  Tue Jul 17 11:00:18 2018                                                                                               Page  169




11822  F87DCA  20 66 84                 jsr     mvf_t0          ; tfr0=z
11823  F87DCD  A9 A4                    lda     #<cathp
11824  F87DCF  A0 82                    ldy     #>cathp
11825  F87DD1  A2 09                    ldx     #9
11826  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     #<cathq
11829  F87DDB  A0 83                    ldy     #>cathq
11830  F87DDD  A2 09                    ldx     #9
11831  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=z
11835  F87DEB  20 DD 49                 jsr     fpmult          ; z*R(z)
11836  F87DEE  20 28 86                 jsr     mvt2_a          ; arg=x
11837  F87DF1  20 DD 49                 jsr     fpmult          ; x*z*R(z)
11838  F87DF4  20 28 86                 jsr     mvt2_a          ; arg=x
11839  F87DF7  4C 7D 45                 jmp     fpadd           ; atanh(x)=x + x*z*R(z)
11840  F87DFA  A5 24            ?gt:    lda     facsgn
11841  F87DFC  85 CF                    sta     fpcsgn          ; save x sign
11842  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 = y
11846  F87E09  20 47 85                 jsr     mvt0_f          ; |x|   
11847  F87E0C  A9 48                    lda     #<cthl
11848  F87E0E  A0 7E                    ldy     #>cthl
11849  F87E10  20 5E 87                 jsr     fccmp           ; compare |x| vs. 0.9990234375
11850  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 1e32
11853  F87E19  A0 5F                    ldy     #>fce32
11854  F87E1B  20 D5 49                 jsr     fcmult
11855  F87E1E  A9 B3                    lda     #<fce32         ; computes z = 1e32 - |x|*1e32
11856  F87E20  A0 5F                    ldy     #>fce32
11857  F87E22  20 5C 45                 jsr     fcsub
11858  F87E25  A9 B3                    lda     #<fce32         ; scale back
11859  F87E27  A0 5F                    ldy     #>fce32
11860  F87E29  20 0A 4A                 jsr     fcrdiv          ; z = 1 - |x|
11861  F87E2C  80 06                    bra     ?div
11862  F87E2E  20 A6 4E         ?dom1:  jsr     ldaone          ; arg=1
11863  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/z
11866  F87E3A  20 B3 62                 jsr     floge           ; ln(w) = ln[(1 + |x|)/(1 - |x|)]
11867  F87E3D                           ACC16
11868  F87E3D  C2 20                    rep     #PMFLAG
11869                                   .LONGA  on
11870                                   .MNLIST
11871  F87E3F  C6 22                    dec     facexp          ; divide by2
11872  F87E41                           ACC08
11873  F87E41  E2 20                    sep     #PMFLAG
11874                                   .LONGA  off
11875                                   .MNLIST
11876  F87E43  A5 CF                    lda     fpcsgn          ; restore sign
11877  F87E45  85 24                    sta     facsgn
11878  F87E47  60                       rts
  Tue Jul 17 11:00:18 2018                                                                                               Page  170




11879                           
11880                           ; 0.9990234375 = tanh(3.81206529283064476456228418624)
11881  F87E48  00 00 00 00 00   cthl:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
11882  F87E51  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$C0,$FF,$FE,$3F
               C0 FF FE 3F 
11883                           ; 1.5
11884  F87E5A  00 00 00 00 00   c1h5:   .DB     $00,$00,$00,$00,$00,$00,$00,$00,$00
               00 00 00 00 
11885  F87E63  00 00 00 00 00           .DB     $00,$00,$00,$00,$00,$00,$C0,$FF,$3F
               00 C0 FF 3F 
11886                           
11887                           ; sinh(x) coefficients
11888  F87E6C                   cshp:
11889                           ; SHP[5] =  1.622194395724068297909052717437740288268E3 
11890  F87E6C  17 69 DD D3 6C           .DB     $17,$69,$DD,$D3,$6C,$86,$A5,$72,$E8
               86 A5 72 E8 
11891  F87E75  60 AB 61 7D 38           .DB     $60,$AB,$61,$7D,$38,$C6,$CA,$09,$40
               C6 CA 09 40 
11892                           
11893                           ; SHP[4] =  1.124862584587770079742188354390171794549E6 
11894  F87E7E  1D 93 DF 58 C9           .DB     $1D,$93,$DF,$58,$C9,$1A,$0E,$8E,$12
               1A 0E 8E 12 
11895  F87E87  51 5A 3C AD F4           .DB     $51,$5A,$3C,$AD,$F4,$4F,$89,$13,$40
               4F 89 13 40 
11896                           
11897                           ; SHP[3] =  3.047548980769660162696832999871894196102E8 
11898  F87E90  9E C2 A9 C6 06           .DB     $9E,$C2,$A9,$C6,$06,$9F,$E8,$40,$D6
               9F E8 40 D6 
11899  F87E99  5B A0 9D 90 86           .DB     $5B,$A0,$9D,$90,$86,$51,$91,$1B,$40
               51 91 1B 40 
11900                           
11901                           ; SHP[2] =  3.966215348072348368191433063260384329745E10 
11902  F87EA2  2F 3F 63 A6 E4           .DB     $2F,$3F,$63,$A6,$E4,$FD,$2F,$10,$A0
               FD 2F 10 A0 
11903  F87EAB  63 93 8B F0 C6           .DB     $63,$93,$8B,$F0,$C6,$C0,$93,$22,$40
               C0 93 22 40 
11904                           
11905                           ; SHP[1] =  2.375869584584371194838551715348965605295E12 
11906  F87EB4  0E D1 C3 AC F2           .DB     $0E,$D1,$C3,$AC,$F2,$82,$01,$FF,$A7
               82 01 FF A7 
11907  F87EBD  C1 17 32 35 37           .DB     $C1,$17,$32,$35,$37,$4B,$8A,$28,$40
               4B 8A 28 40 
11908                           
11909                           ; SHP[0] =  6.482835792103233269752264509192030816323E13 
11910  F87EC6  6C 44 21 C8 30           .DB     $6C,$44,$21,$C8,$30,$E2,$CC,$A8,$AE
               E2 CC A8 AE 
11911  F87ECF  54 21 24 FB 1C           .DB     $54,$21,$24,$FB,$1C,$D8,$EB,$2C,$40
               D8 EB 2C 40 
11912                           
11913  F87ED8                   cshq:
11914                           ; SHQ[5] = -9.101683853129357776079049616394849086007E2 
11915  F87ED8  E1 53 03 04 33           .DB     $E1,$53,$03,$04,$33,$F5,$4A,$94,$A1
               F5 4A 94 A1 
11916  F87EE1  E5 0B 31 D3 C6           .DB     $E5,$0B,$31,$D3,$C6,$8A,$E3,$08,$C0
               8A E3 08 C0 
11917                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  171




11918                           ; SHQ[4] =  4.486400519836461218634448973793765123186E5 
11919  F87EEA  1B 10 39 12 99           .DB     $1B,$10,$39,$12,$99,$3F,$E1,$CF,$A5
               3F E1 CF A5 
11920  F87EF3  80 9B D9 A9 01           .DB     $80,$9B,$D9,$A9,$01,$10,$DB,$11,$40
               10 DB 11 40 
11921                           
11922                           ; SHQ[3] = -1.492531313030440305095318968983514314656E8 
11923  F87EFC  E3 FC 9D E6 6A           .DB     $E3,$FC,$9D,$E6,$6A,$12,$5D,$95,$84
               12 5D 95 84 
11924  F87F05  B2 44 D9 B4 C0           .DB     $B2,$44,$D9,$B4,$C0,$56,$8E,$1A,$C0
               56 8E 1A C0 
11925                           
11926                           ; SHQ[2] =  3.457771488856930054902696708717192082887E10 
11927  F87F0E  36 87 1A 50 C3           .DB     $36,$87,$1A,$50,$C3,$93,$A6,$7A,$E4
               93 A6 7A E4 
11928  F87F17  DA 1B 89 EC E0           .DB     $DA,$1B,$89,$EC,$E0,$CF,$80,$22,$40
               CF 80 22 40 
11929                           
11930                           ; SHQ[1] = -5.193289868803472640225483235513427062460E12 
11931  F87F20  DF 76 FE 54 9D           .DB     $DF,$76,$FE,$54,$9D,$2F,$E7,$64,$DE
               2F E7 64 DE 
11932  F87F29  1F 6F C0 54 06           .DB     $1F,$6F,$C0,$54,$06,$25,$97,$29,$C0
               25 97 29 C0 
11933                           
11934                           ; SHQ[0] =  3.889701475261939961851358705515223019890E14 
11935  F87F32  F5 20 1D 96 A4           .DB     $F5,$20,$1D,$96,$A4,$A9,$99,$FE,$82
               A9 99 FE 82 
11936  F87F3B  FF 18 5B BC 15           .DB     $FF,$18,$5B,$BC,$15,$E2,$B0,$2F,$40
               E2 B0 2F 40 
11937                           
11938                           ; tanh(x) coefficients
11939  F87F44                   cthp:
11940                           ; THP[5] = -6.505693197948351084912624750702492767503E-6  
11941  F87F44  A5 DE 0A CF 2E           .DB     $A5,$DE,$0A,$CF,$2E,$1F,$25,$59,$90
               1F 25 59 90 
11942  F87F4D  92 24 C2 A2 7A           .DB     $92,$24,$C2,$A2,$7A,$4B,$DA,$ED,$BF
               4B DA ED BF 
11943                           
11944                           ; THP[4] = -9.804083860188429726356968570322356183383E-1  
11945  F87F56  2F F3 D5 9C 7D           .DB     $2F,$F3,$D5,$9C,$7D,$E3,$C3,$6C,$CA
               E3 C3 6C CA 
11946  F87F5F  A9 D1 AC 42 0B           .DB     $A9,$D1,$AC,$42,$0B,$FC,$FA,$FE,$BF
               FC FA FE BF 
11947                           
11948                           ; THP[3] = -5.055287638900473250703725789725376004355E2  
11949  F87F68  74 6D 2D 35 A2           .DB     $74,$6D,$2D,$35,$A2,$58,$08,$D8,$58
               58 08 D8 58 
11950  F87F71  8D 87 FF 88 AE           .DB     $8D,$87,$FF,$88,$AE,$C3,$FC,$07,$C0
               C3 FC 07 C0 
11951                           
11952                           ; THP[2] = -7.307477148073823966594990496301416814519E4  
11953  F87F7A  96 63 D3 D4 55           .DB     $96,$63,$D3,$D4,$55,$B8,$E3,$D5,$DC
               B8 E3 D5 DC 
11954  F87F83  1D 7E E1 BF 62           .DB     $1D,$7E,$E1,$BF,$62,$B9,$8E,$0F,$C0
               B9 8E 0F C0 
11955                           
11956                           ; THP[1] = -3.531606586182691280701462523692471322688E6  
  Tue Jul 17 11:00:18 2018                                                                                               Page  172




11957  F87F8C  96 14 AC DD D7           .DB     $96,$14,$AC,$DD,$D7,$7B,$66,$A4,$20
               7B 66 A4 20 
11958  F87F95  82 46 40 58 5A           .DB     $82,$46,$40,$58,$5A,$8D,$D7,$14,$C0
               8D D7 14 C0 
11959                           
11960                           ; THP[0] = -4.551377146142783468144190926206842300707E7  
11961  F87F9E  E4 75 8D 86 22           .DB     $E4,$75,$8D,$86,$22,$74,$D2,$EF,$DA
               74 D2 EF DA 
11962  F87FA7  9C 08 88 DD 0A           .DB     $9C,$08,$88,$DD,$0A,$9F,$AD,$18,$C0
               9F AD 18 C0 
11963                           
11964  F87FB0                   cthq:
11965                           ; THQ[4] =  5.334865598460027935735737253027154828002E2  
11966  F87FB0  19 BD 0A 16 6E           .DB     $19,$BD,$0A,$16,$6E,$A3,$F1,$38,$2C
               A3 F1 38 2C 
11967  F87FB9  3E 88 E8 CB 23           .DB     $3E,$88,$E8,$CB,$23,$5F,$85,$08,$40
               5F 85 08 40 
11968                           
11969                           ; THQ[3] =  8.058475607422391042912151298751537172870E4 
11970  F87FC2  9F 9E F9 42 21           .DB     $9F,$9E,$F9,$42,$21,$C6,$63,$AC,$9D
               C6 63 AC 9D 
11971  F87FCB  85 48 0A C7 60           .DB     $85,$48,$0A,$C7,$60,$64,$9D,$0F,$40
               64 9D 0F 40 
11972                           
11973                           ; THQ[2] =  4.197073523796142343374222405869721575491E6 
11974  F87FD4  22 53 FB 45 7B           .DB     $22,$53,$FB,$45,$7B,$BE,$6D,$81,$45
               BE 6D 81 45 
11975  F87FDD  0A 02 2F 0C A3           .DB     $0A,$02,$2F,$0C,$A3,$15,$80,$15,$40
               15 80 15 40 
11976                           
11977                           ; THQ[1] =  6.521134551226147545983467868553677881771E7 
11978  F87FE6  95 2E 27 14 95           .DB     $95,$2E,$27,$14,$95,$C2,$CF,$71,$06
               C2 CF 71 06 
11979  F87FEF  5B E4 C8 60 F4           .DB     $5B,$E4,$C8,$60,$F4,$C2,$F8,$18,$40
               C2 F8 18 40 
11980                           
11981                           ; THQ[0] =  1.365413143842835040443257277862054198329E8 
11982  F87FF8  34 03 ED E4 19           .DB     $34,$03,$ED,$E4,$19,$D7,$DD,$33,$A4
               D7 DD 33 A4 
11983  F88001  75 06 26 26 48           .DB     $75,$06,$26,$26,$48,$37,$82,$1A,$40
               37 82 1A 40 
11984                           
11985                           ; asinh(x) coefficients
11986  F8800A                   cashp:
11987                           ; ASHP[8] = -8.104404283317298189545629468767571317688E-1  
11988  F8800A  D4 44 8A 29 62           .DB     $D4,$44,$8A,$29,$62,$9C,$61,$3B,$4F
               9C 61 3B 4F 
11989  F88013  B9 7F 0A 1F 06           .DB     $B9,$7F,$0A,$1F,$06,$79,$CF,$FE,$BF
               79 CF FE BF 
11990                           
11991                           ; ASHP[7] = -4.954206127425209147110732546633675599008E1  
11992  F8801C  4C 2A 14 A7 8C           .DB     $4C,$2A,$14,$A7,$8C,$5D,$7A,$C6,$D8
               5D 7A C6 D8 
11993  F88025  FF 5C 55 1C 12           .DB     $FF,$5C,$55,$1C,$12,$2B,$C6,$04,$C0
               2B C6 04 C0 
11994                           
11995                           ; ASHP[6] = -8.438175619831548439550086251740438689853E2  
  Tue Jul 17 11:00:18 2018                                                                                               Page  173




11996  F8802E  1F E6 69 54 E9           .DB     $1F,$E6,$69,$54,$E9,$DD,$A7,$DA,$DB
               DD A7 DA DB 
11997  F88037  96 06 7F EF 52           .DB     $96,$06,$7F,$EF,$52,$F4,$D2,$08,$C0
               F4 D2 08 C0 
11998                           
11999                           ; ASHP[5] = -6.269710069245210459536983820505214648057E3  
12000  F88040  4D 94 05 70 20           .DB     $4D,$94,$05,$70,$20,$FD,$0E,$76,$39
               FD 0E 76 39 
12001  F88049  98 D0 C8 38 AE           .DB     $98,$D0,$C8,$38,$AE,$ED,$C3,$0B,$C0
               ED C3 0B C0 
12002                           
12003                           ; ASHP[4] = -2.418935474493501382372711518024193326434E4  
12004  F88052  65 46 D1 97 6C           .DB     $65,$46,$D1,$97,$6C,$45,$6A,$6B,$AE
               45 6A 6B AE 
12005  F8805B  9C CC 20 A1 B5           .DB     $9C,$CC,$20,$A1,$B5,$FA,$BC,$0D,$C0
               FA BC 0D C0 
12006                           
12007                           ; ASHP[3] = -5.208121780431312783866941311277024486498E4  
12008  F88064  C1 0A 1C 9F EE           .DB     $C1,$0A,$1C,$9F,$EE,$A5,$FC,$D0,$D2
               A5 FC D0 D2 
12009  F8806D  CF 01 06 C2 37           .DB     $CF,$01,$06,$C2,$37,$71,$CB,$0E,$C0
               71 CB 0E C0 
12010                           
12011                           ; ASHP[2] = -6.302755086521614763280617114866439227971E4  
12012  F88076  27 92 3C F6 A2           .DB     $27,$92,$3C,$F6,$A2,$88,$78,$6D,$A9
               88 78 6D A9 
12013  F8807F  DB B7 80 05 8D           .DB     $DB,$B7,$80,$05,$8D,$33,$F6,$0E,$C0
               33 F6 0E C0 
12014                           
12015                           ; ASHP[1] = -4.003566436224198252093684987323233921339E4  
12016  F88088  3D 57 F5 E9 85           .DB     $3D,$57,$F5,$E9,$85,$D7,$5B,$49,$1D
               D7 5B 49 1D 
12017  F88091  03 D6 A4 13 AA           .DB     $03,$D6,$A4,$13,$AA,$63,$9C,$0E,$C0
               63 9C 0E C0 
12018                           
12019                           ; ASHP[0] = -1.037690841528359305134494613113086980551E4 
12020  F8809A  75 93 4B 3D 7C           .DB     $75,$93,$4B,$3D,$7C,$5E,$17,$5F,$F8
               5E 17 5F F8 
12021  F880A3  DF B8 9D 37 A2           .DB     $DF,$B8,$9D,$37,$A2,$23,$A2,$0C,$C0
               23 A2 0C C0 
12022                           
12023  F880AC                   cashq:
12024                           ; ASHQ[8] =  8.175806439951395194771977809279448392548E1 
12025  F880AC  2D 40 15 F1 2B           .DB     $2D,$40,$15,$F1,$2B,$46,$3A,$A0,$19
               46 3A A0 19 
12026  F880B5  3E 59 58 04 21           .DB     $3E,$59,$58,$04,$21,$84,$A3,$05,$40
               84 A3 05 40 
12027                           
12028                           ; ASHQ[7] =  1.822215299975696008284027212745010251320E3 
12029  F880BE  FC 15 F8 77 03           .DB     $FC,$15,$F8,$77,$03,$2B,$9A,$81,$D7
               2B 9A 81 D7 
12030  F880C7  34 4E C6 BC E3           .DB     $34,$4E,$C6,$BC,$E3,$C6,$E3,$09,$40
               C6 E3 09 40 
12031                           
12032                           ; ASHQ[6] =  1.772040003462901790853111853838978236828E4 
12033  F880D0  14 67 63 D4 3C           .DB     $14,$67,$63,$D4,$3C,$7C,$F1,$6E,$7F
               7C F1 6E 7F 
  Tue Jul 17 11:00:18 2018                                                                                               Page  174




12034  F880D9  CC C1 56 D1 CC           .DB     $CC,$C1,$56,$D1,$CC,$70,$8A,$0D,$40
               70 8A 0D 40 
12035                           
12036                           ; ASHQ[5] =  9.077625379864046240143413577745818879353E4 
12037  F880E2  C1 7C F0 4C 1A           .DB     $C1,$7C,$F0,$4C,$1A,$FC,$B2,$4C,$13
               FC B2 4C 13 
12038  F880EB  47 4E 79 7C 20           .DB     $47,$4E,$79,$7C,$20,$4C,$B1,$0F,$40
               4C B1 0F 40 
12039                           
12040                           ; ASHQ[4] =  2.675554475070211205153169988669677418808E5 
12041  F880F4  F5 4D 22 AF FB           .DB     $F5,$4D,$22,$AF,$FB,$11,$EE,$02,$2D
               11 EE 02 2D 
12042  F880FD  8E 3E FA 51 6E           .DB     $8E,$3E,$FA,$51,$6E,$A4,$82,$11,$40
               A4 82 11 40 
12043                           
12044                           ; ASHQ[3] =  4.689758557916492969463473819426544383586E5 
12045  F88106  9B B8 C0 1B 1D           .DB     $9B,$B8,$C0,$1B,$1D,$C9,$87,$FB,$72
               C9 87 FB 72 
12046  F8810F  3D 2B A5 62 FB           .DB     $3D,$2B,$A5,$62,$FB,$FD,$E4,$11,$40
               FD E4 11 40 
12047                           
12048                           ; ASHQ[2] =  4.821923684550711724710891114802924039911E5 
12049  F88118  77 20 49 F1 27           .DB     $77,$20,$49,$F1,$27,$60,$C2,$4C,$65
               60 C2 4C 65 
12050  F88121  17 4A 62 CA 0B           .DB     $17,$4A,$62,$CA,$0B,$72,$EB,$11,$40
               72 EB 11 40 
12051                           
12052                           ; ASHQ[1] =  2.682316388947175963642524537892687560973E5 
12053  F8812A  F4 0E 30 16 03           .DB     $F4,$0E,$30,$16,$03,$74,$A4,$B8,$3B
               74 A4 B8 3B 
12054  F88133  B5 55 D3 71 F4           .DB     $B5,$55,$D3,$71,$F4,$F8,$82,$11,$40
               F8 82 11 40 
12055                           
12056                           ; ASHQ[0] =  6.226145049170155830806967678679167550122E4 
12057  F8813C  F9 E9 F0 5D BA           .DB     $F9,$E9,$F0,$5D,$BA,$0D,$A3,$8E,$F4
               0D A3 8E F4 
12058  F88145  4F 95 6C 53 73           .DB     $4F,$95,$6C,$53,$73,$35,$F3,$0E,$40
               35 F3 0E 40 
12059                           
12060                           ; acosh(x) coefficients
12061  F8814E                   cachp:
12062                           ; ACHP[9] =  1.895467874386341763387398084072833727168E-1  
12063  F8814E  66 70 8A 32 3A           .DB     $66,$70,$8A,$32,$3A,$8B,$D0,$B4,$43
               8B D0 B4 43 
12064  F88157  DF 74 71 94 8D           .DB     $DF,$74,$71,$94,$8D,$18,$C2,$FC,$3F
               18 C2 FC 3F 
12065                           
12066                           ; ACHP[8] =  6.443902084393244878979969557171256604767E1 
12067  F88160  C5 F1 41 7D 6B           .DB     $C5,$F1,$41,$7D,$6B,$5B,$C4,$95,$21
               5B C4 95 21 
12068  F88169  85 E7 0D 57 C7           .DB     $85,$E7,$0D,$57,$C7,$E0,$80,$05,$40
               E0 80 05 40 
12069                           
12070                           ; ACHP[7] =  3.914593556594721458616408528941154205393E3 
12071  F88172  8E E9 6A AE 1F           .DB     $8E,$E9,$6A,$AE,$1F,$EF,$B1,$89,$ED
               EF B1 89 ED 
12072  F8817B  75 2A 33 35 7F           .DB     $75,$2A,$33,$35,$7F,$A9,$F4,$0A,$40
  Tue Jul 17 11:00:18 2018                                                                                               Page  175




               A9 F4 0A 40 
12073                           
12074                           ; ACHP[6] =  9.164040999602964494412169748897754668733E4 
12075  F88184  17 50 27 B4 1E           .DB     $17,$50,$27,$B4,$1E,$5D,$6C,$09,$4E
               5D 6C 09 4E 
12076  F8818D  68 F9 BF 7A 34           .DB     $68,$F9,$BF,$7A,$34,$FC,$B2,$0F,$40
               FC B2 0F 40 
12077                           
12078                           ; ACHP[5] =  1.065909694792026382660307834723001543839E6 
12079  F88196  33 4B 4E 96 02           .DB     $33,$4B,$4E,$96,$02,$E5,$64,$46,$AE
               E5 64 46 AE 
12080  F8819F  36 1F EF 8E AD           .DB     $36,$1F,$EF,$8E,$AD,$1D,$82,$13,$40
               1D 82 13 40 
12081                           
12082                           ; ACHP[4] =  6.899169896709615182428217047370629406305E6 
12083  F881A8  84 A4 A5 35 34           .DB     $84,$A4,$A5,$35,$34,$96,$92,$3E,$6F
               96 92 3E 6F 
12084  F881B1  CE 85 1D CB C3           .DB     $CE,$85,$1D,$CB,$C3,$8B,$D2,$15,$40
               8B D2 15 40 
12085                           
12086                           ; ACHP[3] =  2.599781868717579447900896150777162652518E7 
12087  F881BA  46 B9 30 2C 87           .DB     $46,$B9,$30,$2C,$87,$69,$CA,$F0,$F1
               69 CA F0 F1 
12088  F881C3  5D 60 F5 57 FD           .DB     $5D,$60,$F5,$57,$FD,$58,$C6,$17,$40
               58 C6 17 40 
12089                           
12090                           ; ACHP[2] =  5.663733059389964024656501196827345337766E7 
12091  F881CC  B6 97 B7 46 A7           .DB     $B6,$97,$B7,$46,$A7,$44,$37,$C5,$FD
               44 37 C5 FD 
12092  F881D5  A2 73 02 A6 E4           .DB     $A2,$73,$02,$A6,$E4,$0D,$D8,$18,$40
               0D D8 18 40 
12093                           
12094                           ; ACHP[1] =  6.606302846870644033621560858582696134512E7 
12095  F881DE  3C C5 80 74 46           .DB     $3C,$C5,$80,$74,$46,$EC,$B0,$CA,$2A
               EC B0 CA 2A 
12096  F881E7  4C 49 FF 1D AD           .DB     $4C,$49,$FF,$1D,$AD,$02,$FC,$18,$40
               02 FC 18 40 
12097                           
12098                           ; ACHP[0] =  3.190482951215438078279772140481195200593E7 
12099  F881F0  10 22 D8 A0 1A           .DB     $10,$22,$D8,$A0,$1A,$7C,$37,$8D,$FB
               7C 37 8D FB 
12100  F881F9  55 46 8E C1 1E           .DB     $55,$46,$8E,$C1,$1E,$6A,$F3,$17,$40
               6A F3 17 40 
12101                           
12102  F88202                   cachq:
12103                           ; ACHQ[8] =  1.635418024331924674147953764918262009321E2 
12104  F88202  5C C5 F5 4B 8C           .DB     $5C,$C5,$F5,$4B,$8C,$8D,$25,$D8,$84
               8D 25 D8 84 
12105  F8820B  72 74 73 90 B3           .DB     $72,$74,$73,$90,$B3,$8A,$A3,$06,$40
               8A A3 06 40 
12106                           
12107                           ; ACHQ[7] =  7.290983678312632723073455563799692165828E3 
12108  F88214  C3 9C 13 ED 77           .DB     $C3,$9C,$13,$ED,$77,$C1,$6B,$F3,$08
               C1 6B F3 08 
12109  F8821D  56 34 BC 92 DE           .DB     $56,$34,$BC,$92,$DE,$D7,$E3,$0B,$40
               D7 E3 0B 40 
12110                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  176




12111                           ; ACHQ[6] =  1.418207894088607063257675159183397062114E5 
12112  F88226  9E 1E 0F 35 24           .DB     $9E,$1E,$0F,$35,$24,$95,$08,$A2,$00
               95 08 A2 00 
12113  F8822F  FA BD AC 85 32           .DB     $FA,$BD,$AC,$85,$32,$7F,$8A,$10,$40
               7F 8A 10 40 
12114                           
12115                           ; ACHQ[5] =  1.453154285419072886840913424715826321357E6 
12116  F88238  A8 C8 CD DC 85           .DB     $A8,$C8,$CD,$DC,$85,$7E,$96,$04,$A1
               7E 96 04 A1 
12117  F88241  7D CB 89 48 12           .DB     $7D,$CB,$89,$48,$12,$63,$B1,$13,$40
               63 B1 13 40 
12118                           
12119                           ; ACHQ[4] =  8.566841438576725234955968880501739464425E6 
12120  F8824A  7A 0D 61 29 7E           .DB     $7A,$0D,$61,$29,$7E,$C7,$01,$C1,$AB
               C7 01 C1 AB 
12121  F88253  73 90 46 70 39           .DB     $73,$90,$46,$70,$39,$B8,$82,$16,$40
               B8 82 16 40 
12122                           
12123                           ; ACHQ[3] =  3.003448667795089562511136059766833630017E7 
12124  F8825C  5F BB CA 91 50           .DB     $5F,$BB,$CA,$91,$50,$67,$4C,$7B,$80
               67 4C 7B 80 
12125  F88265  4E 18 C7 56 1B           .DB     $4E,$18,$C7,$56,$1B,$25,$E5,$17,$40
               25 E5 17 40 
12126                           
12127                           ; ACHQ[2] =  6.176592872899557661256383958395266919654E7 
12128  F8826E  56 19 E7 C9 A7           .DB     $56,$19,$E7,$C9,$A7,$81,$29,$B2,$1E
               81 29 B2 1E 
12129  F88277  10 DD A7 2E 4A           .DB     $10,$DD,$A7,$2E,$4A,$9E,$EB,$18,$40
               9E EB 18 40 
12130                           
12131                           ; ACHQ[1] =  6.872176426138597206811541870289420510034E7 
12132  F88280  9F AE 34 C8 63           .DB     $9F,$AE,$34,$C8,$63,$F3,$9E,$4D,$35
               F3 9E 4D 35 
12133  F88289  1D 46 5D 88 8C           .DB     $1D,$46,$5D,$88,$8C,$13,$83,$19,$40
               13 83 19 40 
12134                           
12135                           ; ACHQ[0] =  3.190482951215438078279772140481195226621E7 
12136  F88292  60 2C D8 A0 1A           .DB     $60,$2C,$D8,$A0,$1A,$7C,$37,$8D,$FB
               7C 37 8D FB 
12137  F8829B  55 46 8E C1 1E           .DB     $55,$46,$8E,$C1,$1E,$6A,$F3,$17,$40
               6A F3 17 40 
12138                           
12139                           ; atanh(x) coefficients
12140  F882A4                   cathp:
12141                           ; ATHP[9] = -9.217569843805850417698565442251656375681E-1 
12142  F882A4  56 9C 44 93 0B           .DB     $56,$9C,$44,$93,$0B,$94,$F9,$5D,$55
               94 F9 5D 55 
12143  F882AD  AE 31 C6 06 44           .DB     $AE,$31,$C6,$06,$44,$F8,$EB,$FE,$BF
               F8 EB FE BF 
12144                           
12145                           ; ATHP[8] =  5.321929116410615470118183794063211260728E1 
12146  F882B6  00 73 D2 C8 AD           .DB     $00,$73,$D2,$C8,$AD,$50,$DA,$62,$26
               50 DA 62 26 
12147  F882BF  02 8D E8 DC 8D           .DB     $02,$8D,$E8,$DC,$8D,$E0,$D4,$04,$40
               E0 D4 04 40 
12148                           
12149                           ; ATHP[7] = -9.139522976807685333981548145417830690552E2 
  Tue Jul 17 11:00:18 2018                                                                                               Page  177




12150  F882C8  FF 0B FD 2D D9           .DB     $FF,$0B,$FD,$2D,$D9,$80,$67,$44,$AA
               80 67 44 AA 
12151  F882D1  47 BD F8 71 F2           .DB     $47,$BD,$F8,$71,$F2,$7C,$E4,$08,$C0
               7C E4 08 C0 
12152                           
12153                           ; ATHP[6] =  7.204314536952949779101646454146682033772E3 
12154  F882DA  B7 34 20 F1 AE           .DB     $B7,$34,$20,$F1,$AE,$B4,$89,$32,$1E
               B4 89 32 1E 
12155  F882E3  6C 32 F3 2B 84           .DB     $6C,$32,$F3,$2B,$84,$22,$E1,$0B,$40
               22 E1 0B 40 
12156                           
12157                           ; ATHP[5] = -3.097809640165146436529075324081668598891E4 
12158  F882EC  AB 05 FB 15 54           .DB     $AB,$05,$FB,$15,$54,$FB,$82,$FE,$C1
               FB 82 FE C1 
12159  F882F5  A3 A8 8E 5B 31           .DB     $A3,$A8,$8E,$5B,$31,$04,$F2,$0D,$C0
               04 F2 0D C0 
12160                           
12161                           ; ATHP[4] =  7.865376554210973897486215630898496100534E4 
12162  F882FE  D8 06 5E 71 61           .DB     $D8,$06,$5E,$71,$61,$54,$5E,$34,$16
               54 5E 34 16 
12163  F88307  85 AA 48 FD E1           .DB     $85,$AA,$48,$FD,$E1,$9E,$99,$0F,$40
               9E 99 0F 40 
12164                           
12165                           ; ATHP[3] = -1.211716814094785128366087489224821937203E5 
12166  F88310  4A 97 EA 1A 1E           .DB     $4A,$97,$EA,$1A,$1E,$BF,$9D,$77,$D2
               BF 9D 77 D2 
12167  F88319  B2 00 6D 38 D7           .DB     $B2,$00,$6D,$38,$D7,$A9,$EC,$0F,$C0
               A9 EC 0F C0 
12168                           
12169                           ; ATHP[2] =  1.112669508789123834670923967462068457013E5 
12170  F88322  4A 6F 5C D9 90           .DB     $4A,$6F,$5C,$D9,$90,$61,$4B,$27,$4F
               61 4B 27 4F 
12171  F8832B  92 73 66 B6 79           .DB     $92,$73,$66,$B6,$79,$51,$D9,$0F,$40
               51 D9 0F 40 
12172                           
12173                           ; ATHP[1] = -5.600242872292477863751728708249167956542E4 
12174  F88334  09 D6 41 CF B4           .DB     $09,$D6,$41,$CF,$B4,$1F,$BF,$51,$3F
               1F BF 51 3F 
12175  F8833D  F8 1C C9 C0 6D           .DB     $F8,$1C,$C9,$C0,$6D,$C2,$DA,$0E,$C0
               C2 DA 0E C0 
12176                           
12177                           ; ATHP[0] =  1.188901082233997739779618679364295772810E4 
12178  F88346  25 9B 90 FA 10           .DB     $25,$9B,$90,$FA,$10,$5E,$5E,$62,$93
               5E 5E 62 93 
12179  F8834F  13 F1 02 15 0B           .DB     $13,$F1,$02,$15,$0B,$C4,$B9,$0C,$40
               C4 B9 0C 40 
12180                           
12181  F88358                   cathq:
12182                           ; ATHQ[9] = -6.807348436010016270202879229504392062418E1 
12183  F88358  99 2F A4 39 46           .DB     $99,$2F,$A4,$39,$46,$E2,$E3,$D8,$82
               E2 E3 D8 82 
12184  F88361  9D CB F6 BD 9F           .DB     $9D,$CB,$F6,$BD,$9F,$25,$88,$05,$C0
               25 88 05 C0 
12185                           
12186                           ; ATHQ[8] =  1.386763299649315831625106608182196351693E3 
12187  F8836A  85 34 75 16 4D           .DB     $85,$34,$75,$16,$4D,$4C,$65,$28,$33
               4C 65 28 33 
  Tue Jul 17 11:00:18 2018                                                                                               Page  178




12188  F88373  83 DB 62 F3 6C           .DB     $83,$DB,$62,$F3,$6C,$58,$AD,$09,$40
               58 AD 09 40 
12189                           
12190                           ; ATHQ[7] = -1.310805752656879543134785263832907269320E4 
12191  F8837C  10 00 DF D6 BA           .DB     $10,$00,$DF,$D6,$BA,$52,$8D,$F4,$87
               52 8D F4 87 
12192  F88385  82 AE 3E E8 3A           .DB     $82,$AE,$3E,$E8,$3A,$D0,$CC,$0C,$C0
               D0 CC 0C C0 
12193                           
12194                           ; ATHQ[6] =  6.872174720355764193772953852564737816928E4 
12195  F8838E  6E FA BF B3 EC           .DB     $6E,$FA,$BF,$B3,$EC,$33,$80,$DD,$73
               33 80 DD 73 
12196  F88397  C3 BD 5D A4 DF           .DB     $C3,$BD,$5D,$A4,$DF,$38,$86,$0F,$40
               38 86 0F 40 
12197                           
12198                           ; ATHQ[5] = -2.181008360536226513009076189881617939380E5 
12199  F883A0  F5 02 E5 97 FF           .DB     $F5,$02,$E5,$97,$FF,$97,$2A,$A0,$56
               97 2A A0 56 
12200  F883A9  BF 0D E7 81 35           .DB     $BF,$0D,$E7,$81,$35,$FD,$D4,$10,$C0
               FD D4 10 C0 
12201                           
12202                           ; ATHQ[4] =  4.362736119602298592874941767284979857248E5 
12203  F883B2  61 1A B8 5B 6C           .DB     $61,$1A,$B8,$5B,$6C,$27,$7A,$54,$58
               27 7A 54 58 
12204  F883BB  B6 9E 2D 95 33           .DB     $B6,$9E,$2D,$95,$33,$06,$D5,$11,$40
               06 D5 11 40 
12205                           
12206                           ; ATHQ[3] = -5.535251007539393347687001489396152923502E5 
12207  F883C4  7F 3B 18 F4 58           .DB     $7F,$3B,$18,$F4,$58,$AC,$E0,$0D,$2D
               AC E0 0D 2D 
12208  F883CD  A6 29 B0 9C 51           .DB     $A6,$29,$B0,$9C,$51,$23,$87,$12,$C0
               23 87 12 C0 
12209                           
12210                           ; ATHQ[2] =  4.321594849688346708841188057241308805551E5 
12211  F883D6  4B 52 86 98 30           .DB     $4B,$52,$86,$98,$30,$13,$CC,$A2,$B3
               13 CC A2 B3 
12212  F883DF  8F 5C DD 84 EF           .DB     $8F,$5C,$DD,$84,$EF,$03,$D3,$11,$40
               03 D3 11 40 
12213                           
12214                           ; ATHQ[1] = -1.894075056489862952285849974761239845873E5 
12215  F883E8  03 9B EB F1 8F           .DB     $03,$9B,$EB,$F1,$8F,$F5,$F9,$11,$30
               F5 F9 11 30 
12216  F883F1  D9 90 8D 5C E0           .DB     $D9,$90,$8D,$5C,$E0,$F7,$B8,$10,$C0
               F7 B8 10 C0 
12217                           
12218                           ; ATHQ[0] =  3.566703246701993219338856038092901974725E4 
12219  F883FA  02 11 F8 BB 8C           .DB     $02,$11,$F8,$BB,$8C,$C6,$C6,$89,$AE
               C6 C6 89 AE 
12220  F88403  CE 34 C2 4F 08           .DB     $CE,$34,$C2,$4F,$08,$53,$8B,$0E,$40
               53 8B 0E 40 
12221                           
12222                           ;---------------------------------------------------------------------------
12223                           ; moving routines to/from fac/arg
12224                           ;---------------------------------------------------------------------------
12225                           
12226                           ; temporary registers tfr0..tfr5 are 20-bytes-sized register that can hold the
12227                           ; full size 128 bits mantissa, the exponent, the sign and the byte status
  Tue Jul 17 11:00:18 2018                                                                                               Page  179




12228                           
12229                           ; move arg to fac
12230                           ;------
12231  F8840C                   mvatof:
12232                           ;------
12233  F8840C                           INDEX16
12234  F8840C  C2 10                    rep     #PXFLAG
12235                                   .LONGI  on
12236                                   .MNLIST
12237  F8840E  A6 2A                    ldx     argm
12238  F88410  86 12                    stx     facm
12239  F88412  A6 2C                    ldx     argm+2
12240  F88414  86 14                    stx     facm+2
12241  F88416  A6 2E                    ldx     argm+4
12242  F88418  86 16                    stx     facm+4
12243  F8841A  A6 30                    ldx     argm+6
12244  F8841C  86 18                    stx     facm+6
12245  F8841E  A6 32                    ldx     argm+8
12246  F88420  86 1A                    stx     facm+8
12247  F88422  A6 34                    ldx     argm+10
12248  F88424  86 1C                    stx     facm+10
12249  F88426  A6 36                    ldx     argm+12
12250  F88428  86 1E                    stx     facm+12
12251  F8842A  A6 38                    ldx     argm+14
12252  F8842C  86 20                    stx     facm+14
12253  F8842E  A6 3A                    ldx     argexp
12254  F88430  86 22                    stx     facexp
12255  F88432  A6 3C                    ldx     argsgn
12256  F88434  86 24                    stx     facsgn
12257  F88436                           INDEX08
12258  F88436  E2 10                    sep     #PXFLAG
12259                                   .LONGI  off
12260                                   .MNLIST
12261  F88438  60                       rts
12262                           
12263                           ; move fac to arg
12264                           ;------
12265  F88439                   mvftoa:
12266                           ;------
12267  F88439                           INDEX16
12268  F88439  C2 10                    rep     #PXFLAG
12269                                   .LONGI  on
12270                                   .MNLIST
12271  F8843B  A6 12                    ldx     facm
12272  F8843D  86 2A                    stx     argm
12273  F8843F  A6 14                    ldx     facm+2
12274  F88441  86 2C                    stx     argm+2
12275  F88443  A6 16                    ldx     facm+4
12276  F88445  86 2E                    stx     argm+4
12277  F88447  A6 18                    ldx     facm+6
12278  F88449  86 30                    stx     argm+6
12279  F8844B  A6 1A                    ldx     facm+8
12280  F8844D  86 32                    stx     argm+8
12281  F8844F  A6 1C                    ldx     facm+10
12282  F88451  86 34                    stx     argm+10
12283  F88453  A6 1E                    ldx     facm+12
12284  F88455  86 36                    stx     argm+12
  Tue Jul 17 11:00:18 2018                                                                                               Page  180




12285  F88457  A6 20                    ldx     facm+14
12286  F88459  86 38                    stx     argm+14
12287  F8845B  A6 22                    ldx     facexp
12288  F8845D  86 3A                    stx     argexp
12289  F8845F  A6 24                    ldx     facsgn
12290  F88461  86 3C                    stx     argsgn
12291  F88463                           INDEX08
12292  F88463  E2 10                    sep     #PXFLAG
12293                                   .LONGI  off
12294                                   .MNLIST
12295  F88465  60                       rts
12296                           
12297                           ; move fac to temp. reg. tfr0
12298                           ;------
12299  F88466                   mvf_t0:
12300                           ;------
12301  F88466                           ACC16
12302  F88466  C2 20                    rep     #PMFLAG
12303                                   .LONGA  on
12304                                   .MNLIST
12305  F88468  A5 12                    lda     facm
12306  F8846A  85 50                    sta     tfr0
12307  F8846C  A5 14                    lda     facm+2
12308  F8846E  85 52                    sta     tfr0+2
12309  F88470  A5 16                    lda     facm+4
12310  F88472  85 54                    sta     tfr0+4
12311  F88474  A5 18                    lda     facm+6
12312  F88476  85 56                    sta     tfr0+6
12313  F88478  A5 1A                    lda     facm+8
12314  F8847A  85 58                    sta     tfr0+8
12315  F8847C  A5 1C                    lda     facm+10
12316  F8847E  85 5A                    sta     tfr0+10
12317  F88480  A5 1E                    lda     facm+12
12318  F88482  85 5C                    sta     tfr0+12
12319  F88484  A5 20                    lda     facm+14
12320  F88486  85 5E                    sta     tfr0+14
12321  F88488  A5 22                    lda     facexp
12322  F8848A  85 60                    sta     tfr0+16
12323  F8848C  A5 24                    lda     facsgn
12324  F8848E  85 62                    sta     tfr0+18
12325  F88490                           ACC08
12326  F88490  E2 20                    sep     #PMFLAG
12327                                   .LONGA  off
12328                                   .MNLIST
12329  F88492  60                       rts
12330                           
12331                           ; move fac to temp. reg. tfr1
12332                           ;------
12333  F88493                   mvf_t1:
12334                           ;------
12335  F88493                           ACC16
12336  F88493  C2 20                    rep     #PMFLAG
12337                                   .LONGA  on
12338                                   .MNLIST
12339  F88495  A5 12                    lda     facm
12340  F88497  85 64                    sta     tfr1
12341  F88499  A5 14                    lda     facm+2
  Tue Jul 17 11:00:18 2018                                                                                               Page  181




12342  F8849B  85 66                    sta     tfr1+2
12343  F8849D  A5 16                    lda     facm+4
12344  F8849F  85 68                    sta     tfr1+4
12345  F884A1  A5 18                    lda     facm+6
12346  F884A3  85 6A                    sta     tfr1+6
12347  F884A5  A5 1A                    lda     facm+8
12348  F884A7  85 6C                    sta     tfr1+8
12349  F884A9  A5 1C                    lda     facm+10
12350  F884AB  85 6E                    sta     tfr1+10
12351  F884AD  A5 1E                    lda     facm+12
12352  F884AF  85 70                    sta     tfr1+12
12353  F884B1  A5 20                    lda     facm+14
12354  F884B3  85 72                    sta     tfr1+14
12355  F884B5  A5 22                    lda     facexp
12356  F884B7  85 74                    sta     tfr1+16
12357  F884B9  A5 24                    lda     facsgn
12358  F884BB  85 76                    sta     tfr1+18
12359  F884BD                           ACC08
12360  F884BD  E2 20                    sep     #PMFLAG
12361                                   .LONGA  off
12362                                   .MNLIST
12363  F884BF  60                       rts
12364                           
12365                           ; move fac to temp. reg. tfr2
12366                           ;------
12367  F884C0                   mvf_t2:
12368                           ;------
12369  F884C0                           ACC16
12370  F884C0  C2 20                    rep     #PMFLAG
12371                                   .LONGA  on
12372                                   .MNLIST
12373  F884C2  A5 12                    lda     facm
12374  F884C4  85 78                    sta     tfr2
12375  F884C6  A5 14                    lda     facm+2
12376  F884C8  85 7A                    sta     tfr2+2
12377  F884CA  A5 16                    lda     facm+4
12378  F884CC  85 7C                    sta     tfr2+4
12379  F884CE  A5 18                    lda     facm+6
12380  F884D0  85 7E                    sta     tfr2+6
12381  F884D2  A5 1A                    lda     facm+8
12382  F884D4  85 80                    sta     tfr2+8
12383  F884D6  A5 1C                    lda     facm+10
12384  F884D8  85 82                    sta     tfr2+10
12385  F884DA  A5 1E                    lda     facm+12
12386  F884DC  85 84                    sta     tfr2+12
12387  F884DE  A5 20                    lda     facm+14
12388  F884E0  85 86                    sta     tfr2+14
12389  F884E2  A5 22                    lda     facexp
12390  F884E4  85 88                    sta     tfr2+16
12391  F884E6  A5 24                    lda     facsgn
12392  F884E8  85 8A                    sta     tfr2+18
12393  F884EA                           ACC08
12394  F884EA  E2 20                    sep     #PMFLAG
12395                                   .LONGA  off
12396                                   .MNLIST
12397  F884EC  60                       rts
12398                           
  Tue Jul 17 11:00:18 2018                                                                                               Page  182




12399                           ; move fac to temp. reg. tfr3
12400                           ;------
12401  F884ED                   mvf_t3:
12402                           ;------
12403  F884ED                           ACC16
12404  F884ED  C2 20                    rep     #PMFLAG
12405                                   .LONGA  on
12406                                   .MNLIST
12407  F884EF  A5 12                    lda     facm
12408  F884F1  85 8C                    sta     tfr3
12409  F884F3  A5 14                    lda     facm+2
12410  F884F5  85 8E                    sta     tfr3+2
12411  F884F7  A5 16                    lda     facm+4
12412  F884F9  85 90                    sta     tfr3+4
12413  F884FB  A5 18                    lda     facm+6
12414  F884FD  85 92                    sta     tfr3+6
12415  F884FF  A5 1A                    lda     facm+8
12416  F88501  85 94                    sta     tfr3+8
12417  F88503  A5 1C                    lda     facm+10
12418  F88505  85 96                    sta     tfr3+10
12419  F88507  A5 1E                    lda     facm+12
12420  F88509  85 98                    sta     tfr3+12
12421  F8850B  A5 20                    lda     facm+14
12422  F8850D  85 9A                    sta     tfr3+14
12423  F8850F  A5 22                    lda     facexp
12424  F88511  85 9C                    sta     tfr3+16
12425  F88513  A5 24                    lda     facsgn
12426  F88515  85 9E                    sta     tfr3+18
12427  F88517                           ACC08
12428  F88517  E2 20                    sep     #PMFLAG
12429                                   .LONGA  off
12430                                   .MNLIST
12431  F88519  60                       rts
12432                           
12433                           ; move arg to temp. reg. tfr0
12434                           ;------
12435  F8851A                   mva_t0:
12436                           ;------
12437  F8851A                           ACC16
12438  F8851A  C2 20                    rep     #PMFLAG
12439                                   .LONGA  on
12440                                   .MNLIST
12441  F8851C  A5 2A                    lda     argm
12442  F8851E  85 50                    sta     tfr0
12443  F88520  A5 2C                    lda     argm+2
12444  F88522  85 52                    sta     tfr0+2
12445  F88524  A5 2E                    lda     argm+4
12446  F88526  85 54                    sta     tfr0+4
12447  F88528  A5 30                    lda     argm+6
12448  F8852A  85 56                    sta     tfr0+6
12449  F8852C  A5 32                    lda     argm+8
12450  F8852E  85 58                    sta     tfr0+8
12451  F88530  A5 34                    lda     argm+10
12452  F88532  85 5A                    sta     tfr0+10
12453  F88534  A5 36                    lda     argm+12
12454  F88536  85 5C                    sta     tfr0+12
12455  F88538  A5 38                    lda     argm+14
  Tue Jul 17 11:00:18 2018                                                                                               Page  183




12456  F8853A  85 5E                    sta     tfr0+14
12457  F8853C  A5 3A                    lda     argexp
12458  F8853E  85 60                    sta     tfr0+16
12459  F88540  A5 3C                    lda     argsgn
12460  F88542  85 62                    sta     tfr0+18
12461  F88544                           ACC08
12462  F88544  E2 20                    sep     #PMFLAG
12463                                   .LONGA  off
12464                                   .MNLIST
12465  F88546  60                       rts
12466                           
12467                           ; move temp. reg. tfr0 to fac
12468                           ;------
12469  F88547                   mvt0_f:
12470                           ;------
12471  F88547                           ACC16
12472  F88547  C2 20                    rep     #PMFLAG
12473                                   .LONGA  on
12474                                   .MNLIST
12475  F88549  A5 50                    lda     tfr0
12476  F8854B  85 12                    sta     facm
12477  F8854D  A5 52                    lda     tfr0+2
12478  F8854F  85 14                    sta     facm+2
12479  F88551  A5 54                    lda     tfr0+4
12480  F88553  85 16                    sta     facm+4
12481  F88555  A5 56                    lda     tfr0+6
12482  F88557  85 18                    sta     facm+6
12483  F88559  A5 58                    lda     tfr0+8
12484  F8855B  85 1A                    sta     facm+8
12485  F8855D  A5 5A                    lda     tfr0+10
12486  F8855F  85 1C                    sta     facm+10
12487  F88561  A5 5C                    lda     tfr0+12
12488  F88563  85 1E                    sta     facm+12
12489  F88565  A5 5E                    lda     tfr0+14
12490  F88567  85 20                    sta     facm+14
12491  F88569  A5 60                    lda     tfr0+16
12492  F8856B  85 22                    sta     facexp
12493  F8856D  A5 62                    lda     tfr0+18
12494  F8856F  85 24                    sta     facsgn
12495  F88571                           ACC08
12496  F88571  E2 20                    sep     #PMFLAG
12497                                   .LONGA  off
12498                                   .MNLIST
12499  F88573  60                       rts
12500                           
12501                           ; move temp. reg. tfr1 to fac
12502                           ;------
12503  F88574                   mvt1_f:
12504                           ;------
12505  F88574                           ACC16
12506  F88574  C2 20                    rep     #PMFLAG
12507                                   .LONGA  on
12508                                   .MNLIST
12509  F88576  A5 64                    lda     tfr1
12510  F88578  85 12                    sta     facm
12511  F8857A  A5 66                    lda     tfr1+2
12512  F8857C  85 14                    sta     facm+2
  Tue Jul 17 11:00:18 2018                                                                                               Page  184




12513  F8857E  A5 68                    lda     tfr1+4
12514  F88580  85 16                    sta     facm+4
12515  F88582  A5 6A                    lda     tfr1+6
12516  F88584  85 18                    sta     facm+6
12517  F88586  A5 6C                    lda     tfr1+8
12518  F88588  85 1A                    sta     facm+8
12519  F8858A  A5 6E                    lda     tfr1+10
12520  F8858C  85 1C                    sta     facm+10
12521  F8858E  A5 70                    lda     tfr1+12
12522  F88590  85 1E                    sta     facm+12
12523  F88592  A5 72                    lda     tfr1+14
12524  F88594  85 20                    sta     facm+14
12525  F88596  A5 74                    lda     tfr1+16
12526  F88598  85 22                    sta     facexp
12527  F8859A  A5 76                    lda     tfr1+18
12528  F8859C  85 24                    sta     facsgn
12529  F8859E                           ACC08
12530  F8859E  E2 20                    sep     #PMFLAG
12531                                   .LONGA  off
12532                                   .MNLIST
12533  F885A0  60                       rts
12534                           
12535                           ; move temp. reg. tfr2 to fac
12536                           ;------
12537  F885A1                   mvt2_f:
12538                           ;------
12539  F885A1                           ACC16
12540  F885A1  C2 20                    rep     #PMFLAG
12541                                   .LONGA  on
12542                                   .MNLIST
12543  F885A3  A5 78                    lda     tfr2
12544  F885A5  85 12                    sta     facm
12545  F885A7  A5 7A                    lda     tfr2+2
12546  F885A9  85 14                    sta     facm+2
12547  F885AB  A5 7C                    lda     tfr2+4
12548  F885AD  85 16                    sta     facm+4
12549  F885AF  A5 7E                    lda     tfr2+6
12550  F885B1  85 18                    sta     facm+6
12551  F885B3  A5 80                    lda     tfr2+8
12552  F885B5  85 1A                    sta     facm+8
12553  F885B7  A5 82                    lda     tfr2+10
12554  F885B9  85 1C                    sta     facm+10
12555  F885BB  A5 84                    lda     tfr2+12
12556  F885BD  85 1E                    sta     facm+12
12557  F885BF  A5 86                    lda     tfr2+14
12558  F885C1  85 20                    sta     facm+14
12559  F885C3  A5 88                    lda     tfr2+16
12560  F885C5  85 22                    sta     facexp
12561  F885C7  A5 8A                    lda     tfr2+18
12562  F885C9  85 24                    sta     facsgn
12563  F885CB                           ACC08
12564  F885CB  E2 20                    sep     #PMFLAG
12565                                   .LONGA  off
12566                                   .MNLIST
12567  F885CD  60                       rts
12568  F885CE                           
12569                           ; move temp. reg. tfr0 to arg
  Tue Jul 17 11:00:18 2018                                                                                               Page  185




12570                           ;------
12571  F885CE                   mvt0_a:
12572                           ;------
12573  F885CE                           ACC16
12574  F885CE  C2 20                    rep     #PMFLAG
12575                                   .LONGA  on
12576                                   .MNLIST
12577  F885D0  A5 50                    lda     tfr0
12578  F885D2  85 2A                    sta     argm
12579  F885D4  A5 52                    lda     tfr0+2
12580  F885D6  85 2C                    sta     argm+2
12581  F885D8  A5 54                    lda     tfr0+4
12582  F885DA  85 2E                    sta     argm+4
12583  F885DC  A5 56                    lda     tfr0+6
12584  F885DE  85 30                    sta     argm+6
12585  F885E0  A5 58                    lda     tfr0+8
12586  F885E2  85 32                    sta     argm+8
12587  F885E4  A5 5A                    lda     tfr0+10
12588  F885E6  85 34                    sta     argm+10
12589  F885E8  A5 5C                    lda     tfr0+12
12590  F885EA  85 36                    sta     argm+12
12591  F885EC  A5 5E                    lda     tfr0+14
12592  F885EE  85 38                    sta     argm+14
12593  F885F0  A5 60                    lda     tfr0+16
12594  F885F2  85 3A                    sta     argexp
12595  F885F4  A5 62                    lda     tfr0+18
12596  F885F6  85 3C                    sta     argsgn
12597  F885F8                           ACC08
12598  F885F8  E2 20                    sep     #PMFLAG
12599                                   .LONGA  off
12600                                   .MNLIST
12601  F885FA  60                       rts
12602                           
12603                           ; move temp. reg. tfr1 to arg
12604                           ;------
12605  F885FB                   mvt1_a:
12606                           ;------
12607  F885FB                           ACC16
12608  F885FB  C2 20                    rep     #PMFLAG
12609                                   .LONGA  on
12610                                   .MNLIST
12611  F885FD  A5 64                    lda     tfr1
12612  F885FF  85 2A                    sta     argm
12613  F88601  A5 66                    lda     tfr1+2
12614  F88603  85 2C                    sta     argm+2
12615  F88605  A5 68                    lda     tfr1+4
12616  F88607  85 2E                    sta     argm+4
12617  F88609  A5 6A                    lda     tfr1+6
12618  F8860B  85 30                    sta     argm+6
12619  F8860D  A5 6C                    lda     tfr1+8
12620  F8860F  85 32                    sta     argm+8
12621  F88611  A5 6E                    lda     tfr1+10
12622  F88613  85 34                    sta     argm+10
12623  F88615  A5 70                    lda     tfr1+12
12624  F88617  85 36                    sta     argm+12
12625  F88619  A5 72                    lda     tfr1+14
12626  F8861B  85 38                    sta     argm+14
  Tue Jul 17 11:00:18 2018                                                                                               Page  186




12627  F8861D  A5 74                    lda     tfr1+16
12628  F8861F  85 3A                    sta     argexp
12629  F88621  A5 76                    lda     tfr1+18
12630  F88623  85 3C                    sta     argsgn
12631  F88625                           ACC08
12632  F88625  E2 20                    sep     #PMFLAG
12633                                   .LONGA  off
12634                                   .MNLIST
12635  F88627  60                       rts
12636                           
12637                           ; move temp. reg. tfr2 to arg
12638                           ;------
12639  F88628                   mvt2_a:
12640                           ;------
12641  F88628                           ACC16
12642  F88628  C2 20                    rep     #PMFLAG
12643                                   .LONGA  on
12644                                   .MNLIST
12645  F8862A  A5 78                    lda     tfr2
12646  F8862C  85 2A                    sta     argm
12647  F8862E  A5 7A                    lda     tfr2+2
12648  F88630  85 2C                    sta     argm+2
12649  F88632  A5 7C                    lda     tfr2+4
12650  F88634  85 2E                    sta     argm+4
12651  F88636  A5 7E                    lda     tfr2+6
12652  F88638  85 30                    sta     argm+6
12653  F8863A  A5 80                    lda     tfr2+8
12654  F8863C  85 32                    sta     argm+8
12655  F8863E  A5 82                    lda     tfr2+10
12656  F88640  85 34                    sta     argm+10
12657  F88642  A5 84                    lda     tfr2+12
12658  F88644  85 36                    sta     argm+12
12659  F88646  A5 86                    lda     tfr2+14
12660  F88648  85 38                    sta     argm+14
12661  F8864A  A5 88                    lda     tfr2+16
12662  F8864C  85 3A                    sta     argexp
12663  F8864E  A5 8A                    lda     tfr2+18
12664  F88650  85 3C                    sta     argsgn
12665  F88652                           ACC08
12666  F88652  E2 20                    sep     #PMFLAG
12667                                   .LONGA  off
12668                                   .MNLIST
12669  F88654  60                       rts
12670                           
12671                           ; move temp. reg. tfr3 to arg
12672                           ;------
12673  F88655                   mvt3_a:
12674                           ;------
12675  F88655                           ACC16
12676  F88655  C2 20                    rep     #PMFLAG
12677                                   .LONGA  on
12678                                   .MNLIST
12679  F88657  A5 8C                    lda     tfr3
12680  F88659  85 2A                    sta     argm
12681  F8865B  A5 8E                    lda     tfr3+2
12682  F8865D  85 2C                    sta     argm+2
12683  F8865F  A5 90                    lda     tfr3+4
  Tue Jul 17 11:00:18 2018                                                                                               Page  187




12684  F88661  85 2E                    sta     argm+4
12685  F88663  A5 92                    lda     tfr3+6
12686  F88665  85 30                    sta     argm+6
12687  F88667  A5 94                    lda     tfr3+8
12688  F88669  85 32                    sta     argm+8
12689  F8866B  A5 96                    lda     tfr3+10
12690  F8866D  85 34                    sta     argm+10
12691  F8866F  A5 98                    lda     tfr3+12
12692  F88671  85 36                    sta     argm+12
12693  F88673  A5 9A                    lda     tfr3+14
12694  F88675  85 38                    sta     argm+14
12695  F88677  A5 9C                    lda     tfr3+16
12696  F88679  85 3A                    sta     argexp
12697  F8867B  A5 9E                    lda     tfr3+18
12698  F8867D  85 3C                    sta     argsgn
12699  F8867F                           ACC08
12700  F8867F  E2 20                    sep     #PMFLAG
12701                                   .LONGA  off
12702                                   .MNLIST
12703  F88681  60                       rts
12704                           
12705                           ; ldfac - load fac with a constant K stored in program memory
12706                           ;
12707                           ;       entry:
12708                           ;               A = low  address of constant K
12709                           ;               Y = high address of constant K
12710                           ;
12711                           ;       exit:
12712                           ;               fac = K
12713                           ;
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 K
12722  F88684  84 43                    sty     fcp+1
12723  F88686  A9 F8                    lda     #.SEG.ldfac
12724  F88688  85 44                    sta     fcp+2
12725  F8868A  A2 00                    ldx     #0
12726  F8868C  86 25                    stx     facst           ; always assume valid K
12727  F8868E                           ACC16
12728  F8868E  C2 20                    rep     #PMFLAG
12729                                   .LONGA  on
12730                                   .MNLIST
12731  F88690  A7 42                    lda     [fcp]           ; set mantissa
12732  F88692  85 12                    sta     facm
12733  F88694  A0 02                    ldy     #2
12734  F88696  B7 42                    lda     [fcp],y
12735  F88698  85 14                    sta     facm+2
12736  F8869A  A0 04                    ldy     #4
12737  F8869C  B7 42                    lda     [fcp],y
12738  F8869E  85 16                    sta     facm+4
12739  F886A0  A0 06                    ldy     #6
12740  F886A2  B7 42                    lda     [fcp],y
  Tue Jul 17 11:00:18 2018                                                                                               Page  188




12741  F886A4  85 18                    sta     facm+6
12742  F886A6  A0 08                    ldy     #8
12743  F886A8  B7 42                    lda     [fcp],y
12744  F886AA  85 1A                    sta     facm+8
12745  F886AC  A0 0A                    ldy     #10
12746  F886AE  B7 42                    lda     [fcp],y
12747  F886B0  85 1C                    sta     facm+10
12748  F886B2  A0 0C                    ldy     #12
12749  F886B4  B7 42                    lda     [fcp],y
12750  F886B6  85 1E                    sta     facm+12
12751  F886B8  A0 0E                    ldy     #14
12752  F886BA  B7 42                    lda     [fcp],y
12753  F886BC  85 20                    sta     facm+14
12754  F886BE  A0 10                    ldy     #16
12755  F886C0  B7 42                    lda     [fcp],y
12756  F886C2  10 01                    bpl     ?p
12757  F886C4  CA                       dex
12758  F886C5  29 FF 7F         ?p:     and     #$7FFF
12759  F886C8  85 22                    sta     facexp          ; set exponent
12760  F886CA                           ACC08
12761  F886CA  E2 20                    sep     #PMFLAG
12762                                   .LONGA  off
12763                                   .MNLIST
12764  F886CC  86 24                    stx     facsgn          ; set sign
12765  F886CE  60                       rts
12766  F886CF                           
12767                           ; ldarg - load arg with a constant K stored in program memory
12768                           ;
12769                           ;       entry:
12770                           ;               A = low  address of constant K
12771                           ;               Y = high address of constant K
12772                           ;
12773                           ;       exit:
12774                           ;               arg = K
12775                           ;
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 K
12782  F886D1  84 43                    sty     fcp+1
12783  F886D3  A9 F8                    lda     #.SEG.ldarg
12784  F886D5  85 44                    sta     fcp+2
12785                           
12786                           ; ldarg2 - entry if long pointer fcp was already set
12787  F886D7                   ldarg2:
12788  F886D7  A2 00                    ldx     #0
12789  F886D9  86 3D                    stx     argst           ; always assume valid K
12790  F886DB                           ACC16
12791  F886DB  C2 20                    rep     #PMFLAG
12792                                   .LONGA  on
12793                                   .MNLIST
12794  F886DD  A7 42                    lda     [fcp]           ; set mantissa
12795  F886DF  85 2A                    sta     argm
12796  F886E1  A0 02                    ldy     #2
12797  F886E3  B7 42                    lda     [fcp],y
  Tue Jul 17 11:00:18 2018                                                                                               Page  189




12798  F886E5  85 2C                    sta     argm+2
12799  F886E7  A0 04                    ldy     #4
12800  F886E9  B7 42                    lda     [fcp],y
12801  F886EB  85 2E                    sta     argm+4
12802  F886ED  A0 06                    ldy     #6
12803  F886EF  B7 42                    lda     [fcp],y
12804  F886F1  85 30                    sta     argm+6
12805  F886F3  A0 08                    ldy     #8
12806  F886F5  B7 42                    lda     [fcp],y
12807  F886F7  85 32                    sta     argm+8
12808  F886F9  A0 0A                    ldy     #10
12809  F886FB  B7 42                    lda     [fcp],y
12810  F886FD  85 34                    sta     argm+10
12811  F886FF  A0 0C                    ldy     #12
12812  F88701  B7 42                    lda     [fcp],y
12813  F88703  85 36                    sta     argm+12
12814  F88705  A0 0E                    ldy     #14
12815  F88707  B7 42                    lda     [fcp],y
12816  F88709  85 38                    sta     argm+14
12817  F8870B  A0 10                    ldy     #16
12818  F8870D  B7 42                    lda     [fcp],y
12819  F8870F  10 01                    bpl     ?p
12820  F88711  CA                       dex
12821  F88712  29 FF 7F         ?p:     and     #$7FFF
12822  F88715  85 3A                    sta     argexp          ; set exponent
12823  F88717                           ACC08
12824  F88717  E2 20                    sep     #PMFLAG
12825                                   .LONGA  off
12826                                   .MNLIST
12827  F88719  86 3C                    stx     argsgn          ; set sign
12828  F8871B  60                       rts
12829                           
12830                           ;----------------------------------------------------------------------------
12831                           ; polynomial evaluatation
12832                           ;----------------------------------------------------------------------------
12833                           
12834                           ; peval - evaluate polynomial of degree N
12835                           ;
12836                           ;       entry:
12837                           ;               A       = low address of coefficient C
12838                           ;                                                     N
12839                           ;
12840                           ;               Y       = high address of coefficient C
12841                           ;                                                      N
12842                           ;               X       = degree (N)
12843                           ;               tfr0    = x (temp. register #0)
12844                           ;
12845                           ;       exit:                                 2          N
12846                           ;               fac     = y  =  C  + C x + C x  +...+ C x
12847                           ;                                0    1     2          N
12848                           ;
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), from
12851                           ; the highest order Cn to lowest order C0.
12852                           ;
12853                           ;-----
12854  F8871C                   peval:
  Tue Jul 17 11:00:18 2018                                                                                               Page  190




12855                           ;-----
12856  F8871C  86 4B                    stx     pdeg
12857  F8871E  20 82 86                 jsr     ldfac           ; fac=coefficient Cn
12858  F88721  20 CE 85         ?lp:    jsr     mvt0_a          ; arg=tfr0
12859  F88724  20 DD 49                 jsr     fpmult          ; multiplies by x
12860  F88727                           ACC16CLC
12861  F88727  C2 21                    rep     #(PMFLAG.OR.PCFLAG)
12862                                   .LONGA  on
12863                                   .MNLIST
12864  F88729  A5 42                    lda     fcp             ; next coefficient
12865  F8872B  69 12 00                 adc     #FCSIZ
12866  F8872E  85 42                    sta     fcp
12867  F88730                           ACC08
12868  F88730  E2 20                    sep     #PMFLAG
12869                                   .LONGA  off
12870                                   .MNLIST
12871  F88732  20 7A 45                 jsr     fcadd           ; add coefficient Ck
12872  F88735  C6 4B                    dec     pdeg
12873  F88737  D0 E8                    bne     ?lp
12874  F88739  60                       rts
12875                           
12876                           ; pevalp1 - evaluate polynomial of degree N+1
12877                           ;
12878                           ;       entry:
12879                           ;               A       = low address of coefficient C
12880                           ;                                                     N
12881                           ;
12882                           ;               Y       = high address of coefficient C
12883                           ;                                                      N
12884                           ;               X       = degree - 1 (N)
12885                           ;               tfr0    = x (temp. register #0)
12886                           ;
12887                           ;       exit:                                 2          N     N+1
12888                           ;               fac     = y  =  C  + C x + C x  +...+ C x  +  x
12889                           ;                                0    1     2          N
12890                           ;
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), from
12893                           ; the highest order Cn to lowest order C0.
12894                           ;
12895                           ;-------
12896  F8873A                   pevalp1:
12897                           ;-------
12898  F8873A  86 4B                    stx     pdeg
12899  F8873C  20 82 86                 jsr     ldfac           ; coefficient Cn
12900  F8873F  20 CE 85                 jsr     mvt0_a          ; arg=tfr0
12901  F88742  20 7D 45                 jsr     fpadd           ; x + Cn
12902  F88745  20 CE 85         ?lp:    jsr     mvt0_a          ; loop
12903  F88748  20 DD 49                 jsr     fpmult          ; multiplies by x
12904  F8874B                           ACC16CLC
12905  F8874B  C2 21                    rep     #(PMFLAG.OR.PCFLAG)
12906                                   .LONGA  on
12907                                   .MNLIST
12908  F8874D  A5 42                    lda     fcp             ; next coefficient
12909  F8874F  69 12 00                 adc     #FCSIZ
12910  F88752  85 42                    sta     fcp
12911  F88754                           ACC08
  Tue Jul 17 11:00:18 2018                                                                                               Page  191




12912  F88754  E2 20                    sep     #PMFLAG
12913                                   .LONGA  off
12914                                   .MNLIST
12915  F88756  20 7A 45                 jsr     fcadd           ; add coefficient Ck
12916  F88759  C6 4B                    dec     pdeg
12917  F8875B  D0 E8                    bne     ?lp
12918  F8875D  60                       rts
12919                           
12920                           ;----------------------------------------------------------------------------
12921                           ; utilities & helper routines
12922                           ;----------------------------------------------------------------------------
12923                           
12924                           ; fccmp - compare fac versus a constant stored in program memory
12925                           ;
12926                           ;       entry:
12927                           ;               fac = x
12928                           ;               A = low  address of constant K
12929                           ;               Y = high address of constant K
12930                           ;
12931                           ;       exit:
12932                           ;               if fac < K: ZF=0,NF=1
12933                           ;               if fac = K: ZF=1,NF=0
12934                           ;               if fac > K: ZF=0,NF=0
12935                           ;
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 K
12944  F88760  84 43                    sty     fcp+1
12945  F88762  A9 F8                    lda     #.SEG.fccmp
12946  F88764  85 44                    sta     fcp+2
12947  F88766  A0 11                    ldy     #17
12948  F88768  B7 42                    lda     [fcp],y         ; K sign
12949  F8876A  45 24                    eor     facsgn          ; compare with fac sign
12950  F8876C  10 04                    bpl     ?same           ; sign match
12951  F8876E  A5 24                    lda     facsgn          ; sign unmatch so return...
12952  F88770  80 54                    bra     ?sgn            ; ...fac sign
12953  F88772                   ?same:  ACC16
12954  F88772  C2 20                    rep     #PMFLAG
12955                                   .LONGA  on
12956                                   .MNLIST
12957  F88774  88                       dey
12958  F88775  B7 42                    lda     [fcp],y         ; biased exponent
12959  F88777  29 FF 7F                 and     #$7FFF          ; mask off sign
12960  F8877A  C5 22                    cmp     facexp
12961  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 mantissa
12964  F88782  B7 42                    lda     [fcp],y
12965  F88784  C5 20                    cmp     facm+14
12966  F88786  D0 34                    bne     ?chk            ; CF=0 if fac>K else CF=1 if fac<K
12967  F88788  A0 0C                    ldy     #12
12968  F8878A  B7 42                    lda     [fcp],y
  Tue Jul 17 11:00:18 2018                                                                                               Page  192




12969  F8878C  C5 1E                    cmp     facm+12
12970  F8878E  D0 2C                    bne     ?chk
12971  F88790  A0 0A                    ldy     #10
12972  F88792  B7 42                    lda     [fcp],y
12973  F88794  C5 1C                    cmp     facm+10
12974  F88796  D0 24                    bne     ?chk
12975  F88798  A0 08                    ldy     #8
12976  F8879A  B7 42                    lda     [fcp],y
12977  F8879C  C5 1A                    cmp     facm+8
12978  F8879E  D0 1C                    bne     ?chk
12979  F887A0  A0 06                    ldy     #6
12980  F887A2  B7 42                    lda     [fcp],y
12981  F887A4  C5 18                    cmp     facm+6
12982  F887A6  D0 14                    bne     ?chk
12983  F887A8  A0 04                    ldy     #4
12984  F887AA  B7 42                    lda     [fcp],y
12985  F887AC  C5 16                    cmp     facm+4
12986  F887AE  D0 0C                    bne     ?chk
12987  F887B0  A0 02                    ldy     #2
12988  F887B2  B7 42                    lda     [fcp],y
12989  F887B4  C5 14                    cmp     facm+2
12990  F887B6  D0 04                    bne     ?chk
12991  F887B8  A7 42                    lda     [fcp]
12992  F887BA  C5 12                    cmp     facm
12993  F887BC                   ?chk:   ACC08
12994  F887BC  E2 20                    sep     #PMFLAG
12995                                   .LONGA  off
12996                                   .MNLIST
12997  F887BE  F0 0D                    beq     ?done           ; fac=K so return ZF=1
12998  F887C0  A5 24                    lda     facsgn
12999  F887C2  90 02                    bcc     ?sgn            ; fac>K
13000  F887C4  49 FF                    eor     #$FF            ; invert sign (fac<K)
13001  F887C6  2A               ?sgn:   rol     a               ; CF=sign
13002  F887C7  A9 FF                    lda     #$FF            ; NF=1 if fac<K
13003  F887C9  B0 02                    bcs     ?done
13004  F887CB  A9 01                    lda     #1              ; NF=0 if fac>K
13005  F887CD  60               ?done:  rts
13006                           
13007                           ; signed multiplication 16 bit
13008                           ;
13009                           ;       entry:  C = multiplicand 1 16 bit
13010                           ;               X = multiplicand 2 low byte
13011                           ;               Y = multiplicand 2 high byte
13012                           ;
13013                           ;       exit:   C = result high word
13014                           ;               X = result low-low byte
13015                           ;               Y = result low-high byte
13016                           ;
13017                           ; call with A in 16 bit mode
13018                           ;
13019                           ;-----
13020  F887CE                   imult:
13021                           ;-----
13022                                   .LONGA  on
13023                                   .LONGI  off
13024                           
13025  F887CE  85 BC                    sta     mcand1          ; store mcand1&mcand2
  Tue Jul 17 11:00:18 2018                                                                                               Page  193




13026  F887D0  86 BE                    stx     mcand2
13027  F887D2  84 BF                    sty     mcand2+1
13028  F887D4  45 BE                    eor     mcand2          ; sign of the result
13029  F887D6  85 C0                    sta     mcsgn
13030  F887D8  A2 00                    ldx     #0
13031  F887DA  A4 BD                    ldy     mcand1+1
13032  F887DC  10 06                    bpl     ?p1             ; mcand1 is positive
13033  F887DE  38                       sec
13034  F887DF  8A                       txa
13035  F887E0  E5 BC                    sbc     mcand1          ; complement mcand1
13036  F887E2  85 BC                    sta     mcand1
13037  F887E4  A4 BF            ?p1:    ldy     mcand2+1
13038  F887E6  10 06                    bpl     ?p2             ; mcand2 is positive
13039  F887E8  38                       sec
13040  F887E9  8A                       txa
13041  F887EA  E5 BE                    sbc     mcand2          ; complement mcand2
13042  F887EC  85 BE                    sta     mcand2
13043  F887EE  8A               ?p2:    txa                     ; clear high word of result
13044  F887EF  A2 11                    ldx     #17             ; 17 bit loop
13045  F887F1  18                       clc
13046  F887F2  6A               ?shr:   ror     a               ; shift in any carry - high result
13047  F887F3  66 BC                    ror     mcand1          ; low result
13048  F887F5  90 03                    bcc     ?no             ; no add
13049  F887F7  18                       clc
13050  F887F8  65 BE                    adc     mcand2
13051  F887FA  CA               ?no:    dex
13052  F887FB  D0 F5                    bne     ?shr            ; repeat
13053  F887FD  85 BE                    sta     mcand2          ; store result high
13054  F887FF  24 C0                    bit     mcsgn           ; if result is positive...
13055  F88801  10 09                    bpl     ?done           ; ...done (C=result high)
13056  F88803  8A                       txa
13057  F88804  38                       sec                     ; else complement result
13058  F88805  E5 BC                    sbc     mcand1
13059  F88807  85 BC                    sta     mcand1
13060  F88809  8A                       txa
13061  F8880A  E5 BE                    sbc     mcand2          ; C=result high word
13062  F8880C  A6 BC            ?done:  ldx     mcand1          ; X=result low-low byte
13063  F8880E  A4 BD                    ldy     mcand1+1        ; Y=result low-high byte
13064  F88810  60                       rts
13065                           
13066                                   .LONGA  off
13067                           
13068                           ; unsigned division 16 bit
13069                           ;
13070                           ;       entry:  C = 16 bit dividend
13071                           ;               X = 16 bit divisor
13072                           ;
13073                           ;       exit:   C = 16 bit quotient
13074                           ;               Y = 16 bits remainder
13075                           ;
13076                           ;       use:    all
13077                           ;
13078                           ;       note:   no check for null divisor
13079                           ;
13080                           ;       call in 16 bit mode
13081                           ;-----
13082  F88811                   udiv:
  Tue Jul 17 11:00:18 2018                                                                                               Page  194




13083                           ;-----
13084                                   .LONGA  on
13085                                   .LONGI  on
13086                           
13087  F88811  86 C2                    stx     dvsor           ; divisor       
13088  F88813  A8                       tay                     ; Y=dividend
13089  F88814  64 C4                    stz     quot            ; init quotient
13090  F88816  8A                       txa                     ; C=divisor
13091  F88817  A2 01 00                 ldx     #1              ; bit counter
13092  F8881A  0A               ?shd:   asl     a               ; shift divisor: get leftmost bit
13093  F8881B  B0 06                    bcs     ?div            ; go to division
13094  F8881D  E8                       inx
13095  F8881E  E0 11 00                 cpx     #17             ; test all divisor bit's
13096  F88821  D0 F7                    bne     ?shd
13097  F88823  6A               ?div:   ror     a               ; put shifted-out bit back
13098  F88824  85 C2                    sta     dvsor
13099  F88826  98               ?sub:   tya                     ; get dividend
13100  F88827  38                       sec
13101  F88828  E5 C2                    sbc     dvsor
13102  F8882A  90 01                    bcc     ?no             ; can't subctract, retain old dividend
13103  F8882C  A8                       tay                     ; Y=new dividend
13104  F8882D  26 C4            ?no:    rol     quot            ; shift carry into quotient (1 if division)
13105  F8882F  46 C2                    lsr     dvsor           ; shift right divisor for next subtract
13106  F88831  CA                       dex
13107  F88832  D0 F2                    bne     ?sub            ; repeat
13108  F88834  84 C2                    sty     dvsor           ; store remainder
13109  F88836  A5 C4                    lda     quot            ; C=quotient
13110  F88838  60                       rts
13111                           
13112                                   .LONGA  off
13113                                   .LONGI  off
13114                           
13115          0042DE           CODESIZ .EQU    $ - fcsub +1
13116                           
13117                           ; end of file


             Lines Assembled : 12356                  Errors : 0