 .OPT NO LIST›;  SAVE #D1:FLOAT1.M65›;›;›;  LOAD #D1:FLOAT2.M65›;› .PAGE "Floating Point"›  LIST  › .LOCAL ›; All inline labels commented›; with B are accessed by BASIC›; Others may be accessed by›; cartridges. ALL labels not shown›; as local (?) may be accessed›; by other programs.›;›FPREC    =   6       FP precision›FMPREC   =   5       Mantissa length›FR0M     =   FR0+1   fp reg 0 mantissa›FR1M     =   FR1+1   reg 1 mantissa›FRSIGN   =   NSIGN›PLYCNT   =   ESIGN›SGNFLG   =   FCHRFLG›XFMFLG   =   DIGRT›QTEMP    =   FR0+5›FSCR     =   FPSCR›FSCR1    =   FPSCR1›;›; *= $D800›;›;›AFP› JSR SKBLANK ; B› JSR ?TSTCHAR See if number› BCS ?NONUM  No exit› LDX #EEXP   zero 4 values› LDY #4› JSR ZXLY› LDX #$FF› STX DIGRT› JSR ZFR0    clear Fr0› BEQ ?IN2    go always›;›?IN1› LDA #$FF    set 1st char› STA FCHRFLG flag to non0›;›?IN2› JSR ?GETCHAR get input char› BCS ?NON1   go if not number› PHA         Save› LDX FR0+1   Get 1st byte› BNE ?INCE   incr exponent› JSR NIBSH0  move Fr0 nybble left› PLA         Get digit› ORA FR0+5   or into last byte› STA FR0+5› LDX DIGRT   chars after point?› BMI ?IN1    None› INX         Add in this char› STX DIGRT   and save› BNE ?IN1    Go get next›;›?INCE› PLA         Clear stack› LDX DIGRT   Have DP?› BPL ?INCE2  If so skip› INC EEXP    increment exponent›;›?INCE2› JMP ?IN1    Get next char›;›;›?NONUM› RTS         return fail›;›;›?NON1› CMP #'.     Decimal?› BEQ ?DP     Yes, process› CMP #'E     Exponent?› BEQ ?EXP    Yes› LDX FCHRFLG Is this 1st char?› BNE ?EXIT   if not, done› CMP #'+     If +› BEQ ?IN1    go for next› CMP #'-› BEQ ?MINUS›;›?MINUS› STA NSIGN   Save sign› BEQ ?IN1    go for next›;›?DP› LDX DIGRT   is Digrt still $FF?› BPL ?EXIT   If not have DP› INX         Else make it 0› STX DIGRT› BEQ ?IN1    go for next›;›?EXP› LDA CIX     Get index› STA FRX     save› JSR ?GETCHAR Get next char› BCS ?NON2   Go if nonnumeric›;›?EXP2› TAX         Save 1st char› LDA EEXP    Get # of char>9› PHA         Save it› STX EEXP    Save 1st exponent› JSR ?GETCHAR Get next› BCS ?EXP3   Go if not num› PHA         Save second› LDA EEXP    Get 1st digit› ASL A       multiply by 10› STA EEXP› ASL A› ASL A› ADC EEXP› STA EEXP› PLA         Get 2nd digit› CLC › ADC EEXP› STA EEXP    Save› LDY CIX     Inc to next char› JSR ?GCHR1›;›?EXP3› LDA ESIGN   Get sign› BEQ ?EXP1   if none is +› LDA EEXP    get exp entered› EOR #$FF    complement› CLC         to make› ADC #1      minus› STA EEXP    and save›;›?EXP1› PLA         Get #digits>9› CLC         add in exponent› ADC EEXP› STA EEXP    save it› BNE ?EXIT   go always›;›?NON2› CMP #'+     Go if +› BEQ ?EPLUS› CMP #'-     Go if not -› BNE ?NOTE› STA ESIGN   Save exponent sign›;›?EPLUS› JSR ?GETCHAR› BCC ?EXP2   If number process exp›;›?NOTE› LDA FRX     Point to one past E› STA CIX     restore Cix›;›?EXIT› DEC CIX     Back up 1 char› LDA EEXP    Get exponent› LDX DIGRT   Get # digits past .› BMI ?EXIT1  No DP› BEQ ?EXIT1› SEC         Get exponent-digits› SBC DIGRT   right›;›?EXIT1› PHA         Save› ROL A       Set carry with sign› PLA         Get exponent again› ROR A       Shift right› STA EEXP    Save power of 100› BCC ?EVEN   If number even› JSR NIBSH0  Else shift nybble l›;›?EVEN› LDA EEXP    Add $40 for exvess› CLC         ; 64 +4 for norm› ADC #$44› STA FR0     Save as exponent› JSR NORM    Normalize number› BCS ?IND2   Error if carry› LDX NSIGN   Set mantissa sign› BEQ ?INDON  go if +› LDA FR0› ORA #$80    Make minus› STA FR0›;›?INDON› CLC ›;›?IND2› RTS ›;›;›FASC› JSR INTLBF  Point inbuff B› LDA #'0     Stick '0 in front› STA LBPR2   of lbuff› LDA FR0     Get exponent› BEQ ?EXP0   If 0, so is number› AND #$7F    and out sign› CMP #$3F    If less than $3f› BCC ?EFORM  e format required› CMP #$45    also if >$44› BCS ?EFORM› SEC         Not e format, get DP› SBC #$3F    position› JSR ?CVFR0  Convert Fr0 to ascii› JSR ?FNZERO Find last non-0 char› ORA #$80    Set high bit› STA LBUFF,X Store in buffer› LDA LBUFF   Get first char› CMP #'.› BEQ ?FN6    Go if DP› JMP ?FN5›;›?FN6› JSR ?DECINB Decr inbuff› JMP ?FN4    Do final adjustment›;›?EXP0› LDA #$80+'0 Return› STA LBUFF   ascii 0 + hi bit› RTS ›;›?EFORM› LDA #1      Get decimal posit› JSR ?CVFR0  Convert to ascii› JSR ?FNZERO kill trailing 0's› INX         bump index› STX CIX     save index to last› LDA FR0     Get exponent› ASL A       times 2› SEC         subtract› SBC #$40*2  excess 64› LDX LBUFF   Get 1st char› CPX #'0     Go if '0› BEQ ?EF1› LDX LBUFF+1 Switch DP and 2nd› LDY LBUFF+2 digit› STX LBUFF+2› STY LBUFF+1› LDX CIX     If cix points to› CPX #2      DP then inc› BNE ?NOINC› INC CIX›;›?NOINC› CLC › ADC #1›;›?EF1› STA EEXP    save exponent› LDA #'E› LDY CIX     get pointer› JSR ?STCHAR› STY CIX     save index› LDA EEXP    Get exponent› BPL ?EPL    Go if +› LDA #0      Complement› SEC         exponent› SBC EEXP› STA EEXP› LDA #'-› BNE ?EF2›;›?EPL› LDA #'+›;›?EF2› JSR ?STCHAR Store char› LDX #0      Set counter for 10's› LDA EEXP    Get exponent›;›?EF3› SEC › SBC #10     sub 10› BCC ?EF4    go if < 0› INX         incr. 10's› BNE ?EF3    go always›;›?EF4› CLC         Add back in 10› ADC #10› PHA         save› TXA         get number of 10's› JSR ?STNUM  in exp to buffer› PLA         Get remainder› ORA #$80    set high bit› JSR ?STNUM  St in buffer›;›?FN5› LDA LBUFF   Get 1st output› CMP #'0     go if not '0› BNE ?FN4› CLC         Add one to inbuff› LDA INBUFF  to point to non-0› ADC #1› STA INBUFF› LDA INBUFF+1› ADC #0› STA INBUFF+1›;›?FN4› LDA FR0     Get exponent› BPL ?FADONE Done if +ve› JSR ?DECINB Decr inbuff› LDY #0      Put - in buffer› LDA #'-› STA (INBUFF),Y›;›?FADONE› RTS ›;›;›IFP› LDA FR0     Get lsb aka CVIFP B› STA ZTEMP4+1 save as high› LDA FR0+1   get msb› STA ZTEMP4  save s low› JSR ZFR0    clear Fr0› SED         decimal mode› LDY #16     bits in integer›;›?IFP1› ASL ZTEMP4+1 Shift lsb› ROL ZTEMP4  shift msb›; carry set if there was a bit› LDX #3      max is 3 bytes›;›?IFP2› LDA FR0,X   Double number› ADC FR0,X   and add 1 if› STA FR0,X   carry set› DEX         decr bytes to do› BNE ?IFP2   until done› DEY         decr bit count› BNE ?IFP1› CLD › LDA #$42    Indicate decimal› STA FR0     after last digit› JMP NORM    normalize›;›FPI› LDA #0      Clear result  B› STA ZTEMP4› STA ZTEMP4+1› LDA FR0     Get exponent› BMI ?ERVAL  error if -ve› CMP #$43    If too big› BCS ?ERVAL  also error› SEC › SBC #$40    If less than 1› BCC ?ROUND  go test for round› ADC #0      add in carry› ASL A       mult by 2 and› STA ZTEMP1  save as counter›;›?FPI1› JSR ILSHFT  Shift left once› BCS ?ERVAL  If carry, too big› LDA ZTEMP4  save integer*2› STA ZTEMP3› LDA ZTEMP4+1› STA ZTEMP3+1› JSR ILSHFT  mult by 2› BCS ?ERVAL› JSR ILSHFT  again so *8› BCS ?ERVAL› CLC › LDA ZTEMP4+1 add in *2› ADC ZTEMP3+1 so we have *10› STA ZTEMP4+1› LDA ZTEMP4› ADC ZTEMP3› STA ZTEMP4› BCS ?ERVAL› JSR ?GETDIG get next digit› CLC         add it in› ADC ZTEMP4+1› STA ZTEMP4+1› LDA ZTEMP4› ADC #0› BCS ?ERVAL  overflow!› STA ZTEMP4› DEC ZTEMP1  digits to do› BNE ?FPI1›;›?ROUND› JSR ?GETDIG get next› CMP #5      If less<5› BCC ?NR     don't round› CLC › LDA ZTEMP4+1 Else add 1› ADC #1      to round up› STA ZTEMP4+1› LDA ZTEMP4› ADC #0› STA ZTEMP4›;›?NR› LDA ZTEMP4+1 Move integer› STA FR0     to Fr0› LDA ZTEMP4› STA FR0+1› CLC         Flag success› RTS ›;›?ERVAL› SEC         Flag fail› RTS ›;›ZFR0› LDX #FR0    Pointer  B›ZF1      LDY #6      y=bytes B›;›ZXLY› LDA #0      Called B›;›?ZF2› STA 0,X› INX › DEY › BNE ?ZF2› RTS ›;›INTLBF› LDA # >LBUFF Init Lbuff B› STA INBUFF+1 intp Inbuff› LDA # <LBUFF› STA INBUFF› RTS ›;›ILSHFT› CLC         Shift integer in› ROL ZTEMP4+1 Ztemp4 left once› ROL ZTEMP4› RTS ›;›FSUB› LDA FR1     Get exponent Fr1 B› EOR #$80    change mantissa sign› STA FR1     and resave›;›FADD› LDA FR1     Get exponent  B› AND #$7F    kill sign bit› STA ZTEMP4  save temporarily› LDA FR0     get exponent Fr0› AND #$7F    kill sign› SEC         subtract exponents› SBC ZTEMP4  if exp(Fr0)>=exp(Fr1)› BPL ?NSWAP  then no swap› LDX #5›;›?SWAP› LDA FR0,X   Swap Fr0/Fr1› LDY FR1,X› STA FR1,X› TYA › STA FR0,X› DEX › BPL ?SWAP› BMI FADD    go always›;›?NSWAP› BEQ ?NALIGN If 0, aligned›;› CMP #5      difference < #bytes?› BCS ?ADDEND No, result in Fr0› JSR RSHFT1  Shift to align›;›?NALIGN› SED         Test for like sign› LDA FR0     of mantissa› EOR FR1     If different› BMI ?SUB    subtract› LDX #4      Pointer for last byte› CLC ›;›?ADD1› LDA FR0+1,X Add mantissas› ADC FR1+1,X› STA FR0+1,X› DEX › BPL ?ADD1› CLD › BCS ?ADD2   If carry, do it›;›?ADDEND› JMP NORM    normalize›;›;›?ADD2› LDA #1      Shift once› JSR RSHFT0  Go do it› LDA #1      Get carry› STA FR0+1   add in› JMP NORM    normalize›;›?SUB› LDX #4      point last byte› SEC ›;›?SUB1› LDA FR0+1,X› SBC FR1+1,X› STA FR0+1,X› DEX › BPL ?SUB1› BCC ?SUB2   If borrow, do it› CLD › JMP NORM›;›?SUB2› LDA FR0     Get exponent› EOR #$80    flip sign› STA FR0› SEC         Complement mantissa› LDX #4›;›?SUB3› LDA #0› SBC FR0+1,X› STA FR0+1,X› DEX › BPL ?SUB3› CLD › JMP NORM›;›FMUL› LDA FR0     Get exponent  B› BEQ MEND3› LDA FR1› BEQ MEND2› JSR MDESUP  Common set for exp› SEC › SBC #$40    remove excess 64› SEC         add 1+› ADC FR1     Fr1 exp to Fr0 exp› BMI ?EROV   if -ve overflow› JSR MDSUP   Common div setup›;›?FRM› LDA FRE+5   Get last byte Fre› AND #$0F    lsb only› STA ZTEMP2  for loop control›;›?FRM1› DEC ZTEMP2› BMI ?FRM2› JSR FRA10   Add Fr1 to Fr0› JMP ?FRM1   repeat›;›?FRM2› LDA FRE+5   Get last byte› LSR A       Take msb only› LSR A› LSR A› LSR A› STA ZTEMP2  or loop›;›?FRM3› DEC ZTEMP2› BMI ?NXTB› JSR FRA20   Add Fr2 to Fr0› JMP ?FRM3›;›?NXTB› JSR RSHF0E  shift right› DEC ZTEMP1  Test for shifts› BNE ?FRM›;›MDEND› LDA EEXP    Get exponent› STA FR0     to Fr0›;›MEND1› JMP NORM1›;›;›MEND2› JSR ZFR0›;›MEND3› CLC › RTS ›;›?EROV› SEC › RTS ›FDIV     LDA FR1     If exponent=0  B› BEQ ?EROV   overflow› LDA FR0     if 0› BEQ MEND3   then done› JSR MDESUP  Common setup› SEC › SBC FR1     subtract exponents› CLC › ADC #$40    add in excess 64› BMI ?EROV   overflow if -ve› JSR MDSUP   common mult setup› INC ZTEMP1  loop once more for /› JMP ?FRD1   skip 1st shift›;›?NXTQ› LDX #0      Shift fr0/fre left 1›;›?NXTQ1› LDA FR0+1,X get byte› STA FR0,X   move left one› INX › CPX #12› BNE ?NXTQ1  til done›;›?FRD1› LDY #5› SEC › SED ›;›?FRS2› LDA FRE,Y› SBC FR2,Y› STA FRE,Y› DEY › BPL ?FRS2› CLD › BCC ?FAIL   if Fre<Fr2 fail› INC QTEMP   inc #times sub (quot)› BNE ?FRD1›;›?FAIL› JSR FRA2E   Add Fr2 to Fr0› ASL QTEMP   shift last byte› ASL QTEMP   of quotient one› ASL QTEMP   nybble left› ASL QTEMP›;›?FRD2› LDY #5      subtract divisor› SEC         from dividend› SED ›;›?FRS1› LDA FRE,Y› SBC FR1,Y› STA FRE,Y› DEY › BPL ?FRS1› CLD › BCC ?FAIL2› INC QTEMP› BNE ?FRD2›;›?FAIL2› JSR FRA1E   add Fr1 to Fr0› DEC ZTEMP1  dec loop control› BNE ?NXTQ   next quotient byte› JSR RSHF0E  clear exponent› JMP MDEND   to common exit›;›?GETCHAR› JSR TSTNUM› LDY CIX› BCC ?GCHR1› LDA (INBUFF),Y›;›?GCHR1› INY › STY CIX› RTS ›;›SKBLANK› LDY CIX     aka SKBLANKS B› LDA #32›;›?SB1› CMP (INBUFF),Y› BNE ?SBRTS› INY › BNE ?SB1›;›?SBRTS› STY CIX     set nonblank index› RTS ›;›TSTNUM› LDY CIX     see if number B› LDA (INBUFF),Y› SEC › SBC #'0› BCC ?TSNFAIL› CMP #9+1› RTS ›;›?TSTCHAR› LDA CIX› PHA › JSR ?GETCHAR› BCC ?RTPASS› CMP #'.› BEQ ?TSTN› CMP #'+› BEQ ?TSTN1› CMP #'-› BEQ ?TSTN1›;›?RTFAIL› PLA ›;›?TSNFAIL› SEC › RTS ›;›?TSTN1› JSR ?GETCHAR› BCC ?RTPASS› CMP #'.› BNE ?RTFAIL›;›?TSTN› JSR ?GETCHAR› BCC ?RTPASS› BCS ?RTFAIL›;›?RTPASS› PLA › STA CIX› CLC › RTS ›;›NIBSH2› LDX #FR2+1› BNE ?NIB1›;›NIBSH0› LDX #FR0+1›;›?NIB1› LDY #4›;›?NIBS› CLC › ROL 4,X› ROL 3,X› ROL 2,X› ROL 1,X› ROL 0,X› ROL FRX     save shifted nybble› DEY › BNE ?NIBS› RTS ›