home *** CD-ROM | disk | FTP | other *** search
/ Serious Magazine 11 / Serious_Magazine_11_2002_Dial_pl_Disk_2_of_2_Side_B.atr / rom_01.lzh / FLOAT2.TXT < prev    next >
Text File  |  2002-05-26  |  14KB  |  1 lines
  1. 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¢