09       .OPT NO LIST›10 ;  SAVE #D1:FLOAT2.M65›20 ;›30 ;›40 ;  LOAD #D1:CHARSET1.M65›50        LIST  ›056320 NORM LDX #0   for add norm  B›056322   STX FRE     shift in a 0›056324 NORM1 LDX #4›056326   LDA FR0     get exponent›056328   BEQ ?NDONE  done if 0›056330 ?NORM2 LDA FR0+1 get 1st mantissa›056332   BNE ?TSTBIG if not 0, no shift›056334   LDY #0›056336 ?NSH LDA FR0+2,Y›056339   STA FR0+1,Y›056342   INY ›056343   CPY #5›056345   BCC ?NSH›056347   DEC FR0     decr exponent›056349   DEX ›056350   BNE ?NORM2›056352   LDA FR0+1   mantissa still 0?›056354   BNE ?TSTBIG see if too big›056356   STA FR0     else clear exponent›056358   CLC ›056359   RTS ›056360 ?TSTBIG LDA FR0 get absolute›056362   AND #$7F    exponent›056364   CMP #49+$40 less than 49+64?›056366   BCC ?TSTUND Yes, test underflow›056368   RTS ›056369 ?TSTUND CMP #-49+$40 done if >=›056371   BCS ?NDONE  ; -49+$40›056373   JSR ZFR0    Else number = 0›056376 ?NDONE CLC ›056377   RTS ›056378 RSHFT0 LDX #FR0 Point to Fr0›056380   BNE ?RSH›056382 RSHFT1 LDX #FR1 Point to Fr1›056384 ?RSH STX ZTEMP3 Save fr pointer›056386   STA ZTEMP4  Save # bytes to shift›056388   STA ZTEMP4+1 save for later›056390 ?RSH2 LDY #4  Get # bytes to move›056392 ?RSH1 LDA 4,X Get char›056394   STA 5,X     Store char›056396   DEX         Point to next›056397   DEY         Dec loop control›056398   BNE ?RSH1   If more repeat›056400   LDA #0      Get first byte›056402   STA 5,X     store it›056404   LDX ZTEMP3  Get Fr pointer›056406   DEC ZTEMP4  Do we need to repeat?›056408   BNE ?RSH2   If yes do it›056410   LDA 0,X     Get exponent›056412   CLC ›056413   ADC ZTEMP4+1 Sub # of shifts›056415   STA 0,X     save new exponent›056417   RTS ›056418 RSHF0E LDX #5*2 Get loop control›056420 ?NXTB1 LDA FR0,X Get a byte›056422   STA FR0+1,X Move it over one›056424   DEX         Dec counter›056425   BPL ?NXTB1  Move next byte›056427   LDA #0      Get 0›056429   STA FR0     Shift it in›056431   RTS ›056432 ?CVFR0 STA ZTEMP4 Save decimal position›056434   LDX #0      Set index into mantissa›056436   LDY #0      Set index into output›056438 ?CVBYTE JSR ?TSTDP Put in DP now?›056441   SEC         Dec DP position›056442   SBC #1›056444   STA ZTEMP4  Save it›056446   LDA FR0+1,X Get from Fr0›056448   LSR A       Shift out low order bits›056449   LSR A       To get 1st digit›056450   LSR A›056451   LSR A›056452   JSR ?STNUM  Go put number in buffer›056455   LDA FR0+1,X Do second digit›056457   AND #$0F    Strip high bits›056459   JSR ?STNUM  Store in buffer›056462   INX         Incr pointer›056463   CPX #5      Done?›056465   BCC ?CVBYTE If not do more›056467 ?TSTDP LDA ZTEMP4 Get DP position›056469   BNE ?TST1   If not 0, return›056471   LDA #'.     Get ascii DP›056473   JSR ?STCHAR Put in buffer›056476 ?TST1 RTS ›056477 ?STNUM ORA #'0 Convert to ascii›056479 ?STCHAR STA LBUFF,Y Put in Lbuff›056482   INY         Incr. pointer›056483   RTS ›056484 ?FNZERO LDX #10 Point to last char in lbuff›056486 ?FN3 LDA LBUFF,X Get character›056489   CMP #'.     Is it a DP?›056491   BEQ ?FN1    If yes, go›056493   CMP #'0     Is it a 0?›056495   BNE ?FN2    Go if not›056497   DEX         Decr. index›056498   BNE ?FN3    Go always›056500 ?FN1 DEX      Decr. buffer index›056501   LDA LBUFF,X Get last char›056504 ?FN2 RTS ›056505 ?GETDIG JSR NIBSH0 Shift Fr0 left one nybble›056508   LDA FRX     Get byte containing shifted nybble›056510   AND #$0F    Strip high order bits›056512   RTS ›056513 ?DECINB SEC   Subtract one from inbuff›056514   LDA INBUFF›056516   SBC #1›056518   STA INBUFF›056520   LDA INBUFF+1›056522   SBC #0›056524   STA INBUFF+1›056526   RTS ›056527 MDESUP LDA FR0 Get FR0 exponent›056529   EOR FR1     Get Fr1 exponent›056531   AND #$80    Strip all but sign bit›056533   STA FRSIGN  Save sign›056535   ASL FR1     Shift out sign in Fr1 exponent›056537   LSR FR1     Restore Fr1 less sign›056539   LDA FR0     Get Fr0 exponent›056541   AND #$7F    Strip sign bit›056543   RTS ›056544 MDSUP ORA FRSIGN Or in sign bit›056546   STA EEXP    Save exponent›056548   LDA #0      Clear a›056550   STA FR0     and Fr0›056552   STA FR1     and Fr1›056554   JSR MVFR12  Move Fr1 to Fr2›056557   JSR NIBSH2  Shift Fr2 one nybble left›056560   LDA FRX     Get shifted nybble›056562   AND #$0F    Strip high order bits›056564   STA FR2     Store to finish shift›056566   LDA #5      Set loop control›056568   STA ZTEMP1›056570   JSR MVFR0E  Move Fr0 to Fre›056573   JSR ZFR0    Clear Fr0›056576   RTS ›056577 FRA10 LDX #FR0+5 Point to last byte of sum›056579   BNE ?F1›056581 FRA20 LDX #FR0+5›056583   BNE ?F2›056585 FRA1E LDX #FRE+5›056587 ?F1 LDY #FR1+5›056589   BNE ?FRA›056591 FRA2E LDX #FRE+5›056593 ?F2 LDY #FR2+5›056595 ?FRA LDA #5   Set loop control›056597   STA ZTEMP4›056599   CLC ›056600   SED         Decimal mode›056601 ?FRA1 LDA 0,X Get 1st byte›056603   ADC 0,Y     add›056606   STA 0,X     store›056608   DEX ›056609   DEY ›056610   DEC ZTEMP4  Decr loop control›056612   BPL ?FRA1   til done›056614   CLD         Clear decimal›056615   RTS ›056616 MVFR12 LDY #5 Move Fr1 to Fr2›056618 ?MV2 LDA FR1,Y›056621   STA FR2,Y›056624   DEY ›056625   BPL ?MV2›056627   RTS ›056628 MVFR0E LDY #5 Move Fr0 to Fre›056630 ?MV1 LDA FR0,Y›056633   STA FRE,Y›056636   DEY ›056637   BPL ?MV1›056639   RTS ›056640 PLYEVL STX FPTR2 save pointer to coefs B›056642   STY FPTR2+1›056644   STA PLYCNT›056646   LDX # <PLYARG›056648   LDY # >PLYARG›056650   JSR FST0R   Save arg›056653   JSR FMOVE   Arg->Fr1›056656   LDX FPTR2›056658   LDY FPTR2+1›056660   JSR FLD0R   Coeff->Fr0 (init sum)›056663   DEC PLYCNT  Done?›056665   BEQ ?PLYOUT›056667 ?PLYEV1 JSR FMUL sum*arg›056670   BCS ?PLYOUT Overflow›056672   CLC ›056673   LDA FPTR2   bump coeff pointer›056675   ADC #FPREC›056677   STA FPTR2›056679   BCC ?PLYEV2›056681   LDA FPTR2+1 across page›056683   ADC #0›056685   STA FPTR2+1›056687 ?PLYEV2 LDX FPTR2›056689   LDY FPTR2+1›056691   JSR FLD1R   Get next coeff›056694   JSR FADD    sum*arg+coef›056697   BCS ?PLYOUT overflow›056699   DEC PLYCNT›056701   BEQ ?PLYOUT›056703   LDX # <PLYARG›056705   LDY # >PLYARG›056707   JSR FLD1R   Get arg again›056710   BMI ?PLYEV1 Go always›056712 ?PLYOUT RTS ›056713 FLD0R STX FLPTR Set Flptr B›056715   STY FLPTR+1›056717 FLD0P LDY #5  ; # bytes›056719 FLD01 LDA (FLPTR),Y Move them›056721   STA FR0,Y›056724   DEY ›056725   BPL FLD01›056727   RTS ›056728 FLD1R STX FLPTR B›056730   STY FLPTR+1›056732 FLD1P LDY #5›056734 FLD11 LDA (FLPTR),Y Copy (Flptr)›056736   STA FR1,Y   to Fr1›056739   DEY ›056740   BPL FLD11›056742   RTS ›056743 FST0R STX FLPTR B›056745   STY FLPTR+1›056747 FST0P LDY #5›056749 FST01 LDA FR0,Y›056752   STA (FLPTR),Y›056754   DEY ›056755   BPL FST01›056757   RTS ›056758 FMOVE LDX #5  aka MV0TO1  B›056760 FMOVE1 LDA FR0,X Copy Fr0 to Fr1›056762   STA FR1,X›056764   DEX ›056765   BPL FMOVE1›056767   RTS ›056768 EXP LDX # <LOG10E e^x=10^(x^ln(10)) B›056770   LDY # >LOG10E›056772   JSR FLD1R›056775   JSR FMUL›056778   BCS EXPERR›056780 EXP10 LDA #0  ;10^x B›056782   STA XFMFLG  Clear transform flag›056784   LDA FR0›056786   STA SGNFLG  Remember arg sign›056788   AND #$7F    and make +ve›056790   STA FR0›056792   SEC ›056793   SBC #$40›056795   BMI EXP1    x<1 so use series directly›056797   CMP #4›056799   BPL EXPERR  arg to big›056801   LDX # <FPSCR›056803   LDY # >FPSCR›056805   JSR FST0R   save arg›056808   JSR FPI     make integer›056811   LDA FR0›056813   STA XFMFLG  save multiplier exponent›056815   LDA FR0+1   check msb›056817   BNE EXPERR  should be none›056819   JSR IFP     Back to floating point›056822   JSR FMOVE›056825   LDX # <FPSCR›056827   LDY # >FPSCR›056829   JSR FLD0R   Get arg back›056832   JSR FSUB    Arg-integer=fraction›056835 EXP1 LDA #NPCOEF coefficients›056837   LDX # <P10COF›056839   LDY # >P10COF›056841   JSR PLYEVL  p(x)›056844   JSR FMOVE›056847   JSR FMUL    p(x)*p(x)›056850   LDA XFMFLG  did we transform arg›056852   BEQ EXPSGN  No, leave result alone›056854   CLC         i/2›056855   ROR A›056856   STA FR1›056858   LDA #1      Get mantissa byte›056860   BCC EXP2    Check bit shifted out of a›056862   LDA #$10    i was odd, mantissa=10›056864 EXP2 STA FR1+1›056866   LDX #4›056868   LDA #0›056870 EXP3 STA FR1+2,X Clear rest of mantissa›056872   DEX ›056873   BPL EXP3›056875   LDA FR1     back to exponent›056877   CLC ›056878   ADC #$40    bias it›056880   BCS EXPERR  Too big›056882   BMI EXPERR›056884   STA FR1     Fr1=10^i›056886   JSR FMUL    (10^i)*(10^f)›056889 EXPSGN LDA SGNFLG arg<0?›056891   BPL EXPOUT  No, done›056893   JSR FMOVE   Yes, invert result›056896   LDX # <FONE›056898   LDY # >FONE›056900   JSR FLD0R›056903   JSR FDIV›056906 EXPOUT RTS    Done›056907 EXPERR SEC    Flag error›056908   RTS         Quit›056909 P10COF .BYTE $3D,$17,$94,$19,0,0›056910 ; .FLOAT 0.0000179419›056915   .BYTE $3D,$57,$33,$05,0,0›056916 ; .FLOAT 0.0000573305›056921   .BYTE $3E,$05,$54,$76,$62,0›056922 ; .FLOAT 0.0005547662›056927   .BYTE $3E,$32,$19,$62,$27,0›056928 ; .FLOAT 0.0032176227›056933   .BYTE $3F,$01,$68,$60,$30,$36›056934 ; .FLOAT 0.0168603036›056939   .BYTE $3F,$07,$32,$03,$27,$41›056940 ; .FLOAT 0.0732032741›056945   .BYTE $3F,$25,$43,$34,$56,$75›056946 ; .FLOAT 0.02543345675›056951   .BYTE $3F,$66,$27,$37,$30,$50›056952 ; .FLOAT 0.66273730505›056957   .BYTE $40,$01,$15,$12,$92,$55›056958 ; .FLOAT 1.15129255555›056963   .BYTE $3F,$99,$99,$99,$99,$99›056964 ; .FLOAT 0,99999999999›056965 NPCOEF = [*-P10COF]/6›056969 LOG10E .BYTE $3F,$43,$42,$94,$48,$19›056970 ; .FLOAT 0.43429448190 log(e)›056975 FONE .BYTE $40,1,0,0,0,0›056976 ; .FLOAT 1›056981 XFORM STX FPTR2 z=(x-c)/(x+c) B›056983   STY FPTR2+1›056985   LDX # <PLYARG›056987   LDY # >PLYARG›056989   JSR FST0R   x to plyarg›056992   LDX FPTR2›056994   LDY FPTR2+1›056996   JSR FLD1R›056999   JSR FADD    x+c›057002   LDX # <FPSCR›057004   LDY # >FPSCR›057006   JSR FST0R›057009   LDX # <PLYARG›057011   LDY # >PLYARG›057013   JSR FLD0R›057016   LDX FPTR2›057018   LDY FPTR2+1›057020   JSR FLD1R›057023   JSR FSUB    x-c›057026   LDX # <FPSCR›057028   LDY # >FPSCR›057030   JSR FLD1R›057033   JSR FDIV    (x-c)/(x+c)=z›057036   RTS ›057037 LOG LDA #1    ln(x) B›057039   BNE LOGBTH›057041 LOG10 LDA #0  log(x)  B›057043 LOGBTH STA SGNFLG Use sign to remember entry›057045   LDA FR0›057046 ; -----------›057047   BEQ LOGERR  different from›057049   BMI LOGERR  book›057051   JMP LOG1    jump patch›057052 ;›057054 LOGERR SEC    Address = book+5›057055   RTS         ;-----------›057056 ?XPATCH SBC #$40 Addreses match›057058   ASL A       book again›057059   STA XFMFLG  Remember y›057061   LDA FR0+1›057063   AND #$F0›057065   BNE LOG2›057067   LDA #1›057069   BNE LOG3›057071 LOG2 INC XFMFLG bump y›057073   LDA #$10›057075 LOG3 STA FR1+1 Set mantissa›057077   LDX #4      Clear rest›057079   LDA #0›057081 LOG4 STA FR1+2,X›057083   DEX ›057084   BPL LOG4›057086   JSR FDIV›057089 FLOG10 LDX # <SQR10 log(x) 1>=x<=10›057091   LDY # >SQR10›057093   JSR XFORM   z=(x-c)/(x+c) c*c=10›057096   LDX # <FPSCR›057098   LDY # >FPSCR›057100   JSR FST0R   save z›057103   JSR FMOVE›057106   JSR FMUL    z*z›057109   LDA #NLCOEF›057111   LDX # <LGCOEF›057113   LDY # >LGCOEF›057115   JSR PLYEVL  p(z*z)›057118   LDX # <FPSCR›057120   LDY # >FPSCR›057122   JSR FLD1R›057125   JSR FMUL    z*p(z*z)›057128   LDX # <FHALF›057130   LDY # >FHALF›057132   JSR FLD1R›057135   JSR FADD    0.5+z*p(z*z)›057138   JSR FMOVE›057141   LDA #0›057143   STA FR0+1›057145   LDA XFMFLG›057147   STA FR0›057149   BPL LOG6›057151   EOR #$FF    flip sign›057153   CLC ›057154   ADC #1›057156   STA FR0›057158 LOG6 JSR IFP  leaves Fr1 alone›057161   BIT XFMFLG›057163   BPL LOG7›057165   LDA #$80    Flip again›057167   ORA FR0›057169   STA FR0›057171 LOG7 JSR FADD ln(x)=ln(x)+y›057174 LOGOUT LDA SGNFLG›057176   BEQ LOGDON  was log, not ln›057178   LDX # <LOG10E ln(x)/log(e)›057180   LDY # >LOG10E›057181 ; .FLOAT 3.16227766  sqr(10)›057182   JSR FLD1R›057185   JSR FDIV›057188 LOGDON CLC ›057189   RTS ›057190 SQR10 .BYTE $40,$03,$16,$22,$77,$66›057196 FHALF .BYTE $3F,$50,0,0,0,0 B›057197 ; .FLOAT 0.5›057202 LGCOEF .BYTE $3F,$49,$15,$57,$11,$08›057203 ; .FLOAT 0.4915571108›057208   .BYTE $BF,$51,$70,$49,$47,$08›057209 ; .FLOAT -0.5170494708›057214   .BYTE $3F,$39,$20,$57,$61,$95›057215 ; .FLOAT 0.3920576195›057220   .BYTE $BF,$04,$39,$63,$03,$55›057221 ; .FLOAT -0.0439630355›057226   .BYTE $3F,$10,$09,$30,$12,$64›057227 ; .FLOAT 0.1009301264›057229 ; .FLOAT 0.7853981634›057230 ; pi/4=arctan(1.0)›057232   .BYTE $3F,$09,$39,$08,$04,$60›057233 ; .FLOAT 0.0939080460›057238   .BYTE $3F,$12,$42,$58,$47,$42›057239 ; .FLOAT 0.1242584742›057244   .BYTE $3F,$17,$37,$12,$06,$08›057245 ; .FLOAT 0.1737120608›057250   .BYTE $3F,$28,$95,$29,$71,$17›057251 ; .FLOAT 0.2895297117›057256   .BYTE $3F,$86,$85,$88,$96,$44›057257 ; .FLOAT 0.8685889644›057258 NLCOEF = [*-LGCOEF]/FPREC›057262 ATCOEF .BYTE $3E,$16,$05,$44,$49,$00 B›057263 ; .FLOAT 0.0016054449›057268   .BYTE $BE,$95,$68,$38,$45,$00›057269 ; .FLOAT -0.00956834500›057274   .BYTE $3F,$02,$68,$79,$94,$16›057275 ; .FLOAT 0.0268799416›057280   .BYTE $BF,$04,$92,$78,$90,$80›057281 ; .FLOAT -0.0492789080›057286   .BYTE $3F,$07,$03,$15,$20,$00›057287 ; .FLOAT 0.0703152000›057292   .BYTE $BF,$08,$92,$29,$12,$44›057293 ; .FLOAT -0.0892291244›057298   .BYTE $3F,$11,$08,$40,$09,$11›057299 ; .FLOAT 0.1108400911›057304   .BYTE $BF,$14,$28,$31,$56,$04›057305 ; .FLOAT -0.1428315604›057310   .BYTE $3F,$19,$99,$98,$77,$44›057311 ; .FLOAT 0.1999987744›057316   .BYTE $BF,$33,$33,$33,$31,$13›057317 ; .FLOAT -0.3333333113›057322 FP9S .BYTE $3F,$99,$99,$99,$99,$99 B›057323 ; .FLOAT 0.9999999999›057324 NATCF = [*-ATCOEF]/FPREC›057328 PIOV4 .BYTE $3F,$78,$53,$98,$16,$34 B›057334 LOG1 LDA FR0  Patch inserted›057336   STA FR1     to make space in›057338   SEC         log to check for›057339   JMP ?XPATCH log(0) or ln(0)›057342   .BYTE 0,0   unused›