; ************************************* ; ** ** ; ** FLOATING POINT ROM: D800-DFFF ** ; ** ** ; ************************************* .segment "FLTPOINT" .org $D800 .include "../include/atari.inc" ; ****************************************** ; ** ASCII -> Floating Point conversion ** ; ****************************************** EntryPoint(AFP) _AFP: jsr SKIP_SPACES jsr DBBB ; bekijk getal tot 1e cijfer bcs @rts1 ; begint NIET met '.+-', '+.', '-.', cijfer ldx #$ED ; clear EEXP,NSIGN,ESIGN,FCHRFLG ldy #4 jsr DA48 ldx #$FF stx DIGRT jsr ZFR0 ; clear FR0 beq @2 @1: lda #$FF sta FCHRFLG @2: jsr load_char ; check first digit bcs @6 ; not a digit pha ldx FR0+1 bne @3 jsr rol_FR0 pla ora FR0+5 sta FR0+5 ldx DIGRT bmi @1 inx stx DIGRT bne @1 @3: pla ldx DIGRT bpl @4 inc EEXP @4: jmp @1 @rts1: rts @6: cmp #'.' beq @8 cmp #'E' beq @9 ldx FCHRFLG bne @16 cmp #'+' beq @1 cmp #'-' beq @7 ; ehhhhh!? @7: sta NSIGN beq @1 @8: ldx DIGRT bpl @16 inx stx DIGRT beq @1 @9: lda CIX sta FRX jsr load_char bcs @13 @10: tax lda EEXP pha stx EEXP jsr load_char bcs @neg_exp pha lda EEXP asl sta EEXP asl asl adc EEXP sta EEXP pla clc adc EEXP sta EEXP ldy CIX jsr DB9D @neg_exp: lda ESIGN beq @no_neg_exp lda EEXP ; negate EEXP eor #%11111111 clc adc #1 sta EEXP @no_neg_exp: pla clc adc EEXP sta EEXP bne @16 @13: cmp #'+' beq @14 cmp #'-' bne @15 sta ESIGN @14: jsr load_char bcc @10 @15: lda FRX sta CIX @16: dec CIX lda EEXP ldx DIGRT bmi @17 beq @17 sec sbc DIGRT @17: pha rol pla ror sta EEXP bcc @18 jsr rol_FR0 @18: lda EEXP clc adc #$44 sta FR0+0 jsr DC00 bcs @rts2 ldx NSIGN ; if (NSIGN!=0) beq @clc_rts lda FR0+0 ; force FR0 negative ora #%10000000 sta FR0+0 @clc_rts: clc @rts2: rts ; **************************************** ; ** Floating Point -> ASCII conversion ** ; **************************************** EntryPoint(FASC) _FASC: jsr DA51 lda #'0' sta $57F lda FR0 beq @2 and #%01111111 cmp #$3F bcc @3 cmp #$45 bcs @3 sec sbc #$3F jsr DC70 jsr DCA4 ora #%10000000 sta LBUFF,X lda LBUFF cmp #'.' beq @1 jmp @10 @1: jsr dec_INBUFF jmp @11 @2: lda #$B0 sta LBUFF rts @3: lda #1 jsr DC70 jsr DCA4 inx stx CIX lda FR0 asl sec sbc #$80 ldx LBUFF cpx #'0' beq @5 ldx $0581 ldy $0582 stx $0582 sty $0581 ldx CIX cpx #2 bne @4 inc CIX @4: clc adc #1 @5: sta EEXP lda #'E' ldy CIX jsr DC9F sty CIX lda EEXP bpl @6 lda #0 sec sbc EEXP sta EEXP lda #$2D bne @7 @6: lda #$2B @7: jsr DC9F ldx #0 lda EEXP @8: sec sbc #10 bcc @9 inx bne @8 @9: clc adc #10 pha txa jsr DC9D pla ora #$80 jsr DC9D @10: lda LBUFF cmp #'0' bne @11 clc lda INBUFF adc #1 sta INBUFF lda INBUFF+1 adc #0 sta INBUFF+1 @11: lda FR0 bpl @rts jsr dec_INBUFF ldy #0 lda #$2D sta (INBUFF),Y @rts: rts ; ****************************************** ; ** Integer -> Floating Point conversion ** ; ****************************************** EntryPoint(IFP) _IFP: lda FR0 sta $F8 lda FR0+1 sta $F7 jsr ZFR0 ; clear ZFR0 sed ldy #$10 @loop_y: asl $F8 rol $F7 ldx #3 @loop_x: lda FR0,X adc FR0,X sta FR0,X dex bne @loop_x dey bne @loop_y cld lda #$42 sta FR0 jmp DC00 ; ****************************************** ; ** Floating Point -> Integer conversion ** ; ****************************************** EntryPoint(FPI) _FPI: lda #0 sta $F7 sta $F8 lda FR0 bmi @sec_rts cmp #$43 bcs @sec_rts sec sbc #$40 bcc @2 adc #0 asl sta $F5 @1: jsr DA5A bcs @sec_rts lda $F7 sta $F9 lda $F8 sta $FA jsr DA5A bcs @sec_rts jsr DA5A bcs @sec_rts clc lda $F8 adc $FA sta $F8 lda $F7 adc $F9 sta $F7 bcs @sec_rts jsr DCB9 clc adc $F8 sta $F8 lda $F7 adc #0 bcs @sec_rts sta $F7 dec $F5 bne @1 @2: jsr DCB9 cmp #5 bcc @3 clc lda $F8 adc #1 sta $F8 lda $F7 adc #0 sta $F7 @3: lda $F8 sta FR0+0 lda $F7 sta FR0+1 clc rts @sec_rts: sec rts EntryPoint(ZFR0) _ZFR0: ldx #FR0 ; clear FR0 EntryPoint(ZF1) _ZF1: ldy #6 EntryPoint(__DA48) DA48: lda #0 @loop_y: sta 0,X inx dey bne @loop_y rts EntryPoint(__DA51) DA51: lda #5 sta INBUFF+1 lda #$80 sta INBUFF rts DA5A: clc rol $F8 rol $F7 rts EntryPoint(FSUB) _FSUB: lda FR1 eor #%10000000 sta FR1 EntryPoint(FADD) _FADD: lda FR1+0 and #%01111111 sta $F7 lda FR0+0 and #%01111111 sec sbc $F7 bpl @else ldx #5 @loop_x1: lda FR0,X ldy FR1,X sta FR1,X tya sta FR0,X dex bpl @loop_x1 bmi _FADD @else: beq @3 cmp #5 bcs @5 jsr DC3E @3: sed lda FR0+0 ; signs are not equal? eor FR1+0 bmi @7 ldx #4 clc @4: lda FR0+1,X adc FR1+1,X sta FR0+1,X dex bpl @4 cld bcs @6 ; bcc DC00 @5: jmp DC00 @6: lda #1 jsr DC3A lda #1 sta FR0+1 jmp DC00 @7: ldx #4 sec @8: lda FR0+1,X sbc FR1+1,X sta FR0+1,X dex bpl @8 bcc @9 cld jmp DC00 @9: lda FR0 ; negate FR0 eor #%10000000 sta FR0 sec ldx #4 @10: lda #0 sbc FR0+1,X sta FR0+1,X dex bpl @10 cld jmp DC00 EntryPoint(FMUL) _FMUL: lda FR0+0 ; if (FR0==0.0) beq DB24 ; clc, rts lda FR1+0 ; if (FR1==0.0) beq DB21 ; FR0=0.0, clc, rts jsr DCCF sec sbc #$40 sec adc FR1 bmi DB26 ; sec, rts jsr DCE0 @1: lda $DF and #15 sta $F6 @2: dec $F6 bmi @3 jsr add_FR0_FR1 jmp @2 @3: lda $DF lsr lsr lsr lsr sta $F6 @4: dec $F6 bmi @5 jsr add_FR0_FR2 jmp @4 @5: jsr DC62 dec $F5 bne @1 DB1A: lda EEXP sta FR0+0 jmp DC04 DB21: jsr ZFR0 ; clear ZFR0 DB24: clc rts DB26: sec rts EntryPoint(FDIV) _FDIV: lda FR1 beq DB26 ; sec, rts lda FR0 beq DB24 ; clc, rts jsr DCCF sec sbc FR1 clc adc #$40 bmi DB26 ; sec, rts jsr DCE0 inc $F5 jmp @3 @1: ldx #0 @2: lda FR0+1,X sta FR0,X inx cpx #12 bne @2 @3: ldy #5 sec sed @4: lda FRE,Y sbc FR2,Y sta FRE,Y dey bpl @4 cld bcc @5 inc FR0+5 bne @3 @5: jsr add_FRE_FR2 asl FR0+5 asl FR0+5 asl FR0+5 asl FR0+5 @6: ldy #5 sec sed @7: lda FRE,Y sbc FR1,Y sta FRE,Y dey bpl @7 cld bcc @8 inc FR0+5 bne @6 @8: jsr add_FRE_FR1 dec $F5 bne @1 jsr DC62 jmp DB1A ; ********************************************** ; * * ; * ACCU = INBUFF[CIX]-'0' * ; * if ((ACCU<0) || (ACCU>9)) * ; * ACCU = INBUF[CIX] * ; * ++CIX; ; * * ; ********************************************** load_char: jsr load_digit ; load A with 0..9 from INBUFF[CIX] ldy CIX bcc DB9D lda (INBUFF),Y DB9D: iny sty CIX rts ; ********************************************** ; * * ; * while(INBUFF[CIX]==' ') * ; * ++CIX; * ; * * ; ********************************************** EntryPoint(SKIP_SPACES) ldy CIX lda #' ' @loop_y: cmp (INBUFF),Y bne @no_space iny bne @loop_y @no_space: sty CIX rts ; ********************************************** ; * * ; * ACCU = INBUFF[CIX]-'0' * ; * carry = (ACCU<0) || (ACCU>9) * ; * * ; ********************************************** load_digit: ldy CIX lda (INBUFF),Y sec sbc #'0' bcc sec_rts cmp #10 rts ;save CIX ;load_char ;if (is_digit) --> restore CIX, clc, rts ;if (is_point) --> load-next-character ; if (no-err) DBBB: lda CIX ; check digits up to 1st '0123456789' pha jsr load_char ; load digit or character bcc is_digit ; it's a digit cmp #'.' beq is_point ; it's a DECIMAL POINT cmp #'+' beq is_sign ; it's a PLUS sign cmp #'-' beq is_sign ; it's a MINUS sign pla_sec_rts: pla sec_rts: sec rts is_sign: jsr load_char ; buffer starts with PLUS of MINUS bcc is_digit cmp #'.' bne pla_sec_rts is_point: jsr load_char bcc is_digit bcs pla_sec_rts is_digit: pla sta CIX clc rts ; ; ; rol_FR2: ldx #FR2+1 bne rol_FR rol_FR0: ldx #FR0+1 rol_FR: ldy #4 loop_y: clc rol 4,X rol 3,X rol 2,X rol 1,X rol 0,X rol FRX dey bne loop_y rts EntryPoint(__DC00) DC00: ldx #0 stx FRE DC04: ldx #4 lda FR0 beq @clc_rts @loop_x: lda FR0+1 bne @3 ldy #0 @loop_y: lda FR0+2,Y sta FR0+1,Y iny cpy #5 bcc @loop_y dec FR0 dex bne @loop_x lda FR0+1 bne @3 sta FR0 clc rts @3: lda FR0 and #$7F cmp #$71 bcc @4 rts @4: cmp #15 bcs @clc_rts jsr ZFR0 ; clear ZFR0 @clc_rts: clc rts DC3A: ldx #FR0 bne xfr0 DC3E: ldx #FR1 xfr0: stx $F9 sta $F7 sta $F8 @loop_f7: ldy #4 @loop_y: lda 4,X sta 5,X dex dey bne @loop_y lda #0 sta 5,X ldx $F9 dec $F7 bne @loop_f7 lda 0,X clc adc $F8 sta 0,X rts DC62: ldx #10 @loop_x: lda FR0,X sta FR0+1,X dex bpl @loop_x lda #0 sta FR0 rts DC70: sta $F7 ldx #0 ldy #0 @1: jsr @2 sec sbc #1 sta $F7 lda FR0+1,X lsr lsr lsr lsr jsr DC9D lda FR0+1,X and #%00001111 jsr DC9D inx cpx #5 bcc @1 @2: lda $F7 bne @rts lda #'.' jsr DC9F @rts: rts DC9D: ora #'0' DC9F: sta LBUFF,Y iny rts DCA4: ldx #10 @loop_x: lda LBUFF,X cmp #'.' beq @point cmp #'0' bne @rts dex bne @loop_x @point: dex lda LBUFF,X @rts: rts DCB9: jsr rol_FR0 lda FRX and #%00001111 rts dec_INBUFF: sec lda INBUFF sbc #1 sta INBUFF lda INBUFF+1 sbc #0 sta INBUFF+1 rts DCCF: lda FR0+0 ; NSIGN = sign(FR0)^sign(FR1) eor FR1+0 and #%10000000 sta NSIGN asl FR1+0 ; carry = sign(FR1) lsr FR1+0 ; force FR1 positive lda FR0+0 ; ACCU = pos. exponent(FR0) and #%01111111 rts DCE0: ora NSIGN sta EEXP lda #0 sta FR0+0 sta FR1+0 jsr FR1toFR2 jsr rol_FR2 lda FRX and #%00001111 sta FR2+0 lda #5 sta $F5 jsr FR0toFRE jsr ZFR0 ; clear ZFR0 rts add_FR0_FR1: ldx #FR0+5 ; FR0+=FR1 bne ldy_FR1 add_FR0_FR2: ldx #FR0+5 ; FR0+=FR2 bne ldy_FR2 add_FRE_FR1: ldx #FRE+5 ; FRE+=FR1 ldy_FR1: ldy #FR1+5 bne add_FR_FR add_FRE_FR2: ldx #FRE+5 ; FRE+=FR2 ldy_FR2: ldy #FR2+5 add_FR_FR: lda #5 sta $F7 clc sed @loop: lda 0,X adc 0,Y sta 0,X dex dey dec $F7 bpl @loop cld rts FR1toFR2: ldy #5 ; copy FR1 --> FR2 @loop_y: lda FR1,Y sta FR2,Y dey bpl @loop_y rts FR0toFRE: ldy #5 ; copy FR0 --> FRE @loop_y: lda FR0,Y sta FRE,Y dey bpl @loop_y rts EntryPoint(PLYEVL) _PLYEVL: stx $FE sty $FF sta $EF ldx #FR1 ldy #5 jsr FSTOR jsr FMOVE ldx $FE ldy $FF jsr FLD0R dec $EF beq @rts @1: jsr FMUL bcs @rts clc lda $FE adc #6 sta $FE bcc @2 lda $FF adc #0 sta $FF @2: ldx $FE ldy $FF jsr FLD1R jsr FADD bcs @rts dec $EF beq @rts ldx #FR1 ldy #5 jsr FLD1R bmi @1 @rts: rts EntryPoint(FLD0R) _FLD0R: stx $FC sty $FD _FLD0P: ldy #5 @loop_y: lda ($FC),Y sta FR0,Y dey bpl @loop_y rts EntryPoint(FLD1R) _FLD1R: stx $FC sty $FD _FLD1P: ldy #5 @loop_y: lda ($FC),Y sta FR1,Y dey bpl @loop_y rts EntryPoint(FSTOR) _FSTOR: stx $FC sty $FD _FSTOP: ldy #5 @loop_y: lda FR0,Y sta ($FC),Y dey bpl @loop_y rts ; ### FMOVE: FR1 := FR0 ### EntryPoint(FMOVE) _FMOVE: ldx #5 @loop_x: lda FR0,X sta FR1,X dex bpl @loop_x rts EntryPoint(EXP) _EXP: ldx #DE89 jsr FLD1R jsr FMUL bcs err2 ; signal error (SEC/RTS) EntryPoint(EXP10) _EXP10: lda #0 sta DIGRT lda FR0 sta FCHRFLG and #%01111111 sta FR0 sec sbc #$40 bmi @1 cmp #4 bpl err2 ldx #FR2 ldy #5 jsr FSTOR jsr FPI lda FR0 sta DIGRT lda FR0+1 bne err2 jsr IFP jsr FMOVE ldx #FR2 ldy #5 jsr FLD0R jsr FSUB @1: lda #10 ldx #DE4D jsr PLYEVL jsr FMOVE jsr FMUL lda DIGRT beq @4 clc ror sta FR1 lda #1 bcc @2 lda #$10 @2: sta $E1 ldx #4 lda #0 @loop_x: sta $E2,X dex bpl @loop_x lda FR1 clc adc #$40 bcs err2 bmi err2 sta FR1 jsr FMUL @4: lda FCHRFLG bpl @rts jsr FMOVE ldx #DE8F jsr FLD0R jsr FDIV @rts: rts err2: sec ; signal EXP / EXP10 error rts ; ### EXP10 ### DE4D: .byte $3D,$17,$94,$19,$00,$00 ; 0.00001794190000 .byte $3D,$57,$33,$05,$00,$00 ; 0.00005733050000 .byte $3E,$05,$54,$76,$62,$00 ; 0.000554766200 .byte $3E,$32,$19,$62,$27,$00 ; 0.003219622700 .byte $3F,$01,$68,$60,$30,$36 ; 0.0168603036 .byte $3F,$07,$32,$03,$27,$41 ; 0.0732032741 .byte $3F,$25,$43,$34,$56,$75 ; 0.2543345675 .byte $3F,$66,$27,$37,$30,$50 ; 0.6627373050 .byte $40,$01,$15,$12,$92,$55 ; 1.15129255 .byte $3F,$99,$99,$99,$99,$99 ; 0.9999999999 DE89: .byte $3F,$43,$42,$94,$48,$19 ; 0.4342944819 [ 1/ln(10) ] DE8F: .byte $40,$01,$00,$00,$00,$00 ; 1.00000000 [ 1 ] EntryPoint(__DE95) DE95: stx $FE sty $FF ldx #FR1 ldy #5 jsr FSTOR ldx $FE ldy $FF jsr FLD1R jsr FADD ldx #FR2 ldy #5 jsr FSTOR ldx #FR1 ldy #5 jsr FLD0R ldx $FE ldy $FF jsr FLD1R jsr FSUB ldx #FR2 ldy #5 jsr FLD1R jsr FDIV rts EntryPoint(LOG) _LOG: lda #1 bne log_e EntryPoint(LOG10) _LOG10: lda #0 log_e: sta FCHRFLG ; A=0: base-10; A=1: base-e lda FR0 beq @sec_rts ; error if FR0 <= 0 bmi @sec_rts jmp DFF6 ; LDA FR0 / STA FR1 / SEC / JMP DEE0 @sec_rts: sec ; signal logarithm error! rts DEE0: sbc #$40 asl sta DIGRT lda FR0+1 and #$F0 bne @1 lda #1 bne @2 @1: inc DIGRT lda #$10 @2: sta $E1 ldx #4 lda #0 @3: sta $E2,X dex bpl @3 jsr FDIV ldx #DF66 jsr DE95 ldx #FR2 ldy #5 jsr FSTOR jsr FMOVE jsr FMUL lda #10 ldx #DF72 jsr PLYEVL ldx #FR2 ldy #5 jsr FLD1R jsr FMUL ldx #DF6C jsr FLD1R jsr FADD jsr FMOVE lda #0 sta FR0+1 lda DIGRT sta FR0 bpl @4 eor #%11111111 clc adc #1 sta FR0 @4: jsr IFP bit DIGRT bpl @5 lda #%10000000 ora FR0 sta FR0 @5: jsr FADD lda FCHRFLG beq @clc_rts ldx #DE89 jsr FLD1R jsr FDIV @clc_rts: clc rts DF66: .byte $40,$03,$16,$22,$77,$66 ; 3.16227766 EntryPoint(__DF6C) DF6C: .byte $3F,$50,$00,$00,$00,$00 ; 0.5000000000 ; logarithm coefficients DF72: .byte $3F,$49,$15,$57,$11,$08 ; 0.4915571108 .byte $BF,$51,$70,$49,$47,$08 ; -0.5170494708 .byte $3F,$39,$20,$57,$61,$95 ; 0.3920576195 .byte $BF,$04,$39,$63,$03,$55 ; -0.0439630355 .byte $3F,$10,$09,$30,$12,$64 ; 0.1009301264 .byte $3F,$09,$39,$08,$04,$60 ; 0.0939080460 .byte $3F,$12,$42,$58,$47,$42 ; 0.1242584742 .byte $3F,$17,$37,$12,$06,$08 ; 0.1737120608 .byte $3F,$28,$95,$29,$71,$17 ; 0.2895297117 .byte $3F,$86,$85,$88,$96,$44 ; 0.8685889644 ; arctan coefficients: EntryPoint(__DFAE) DFAE: .byte $3E,$16,$05,$44,$49,$00 ; 0.001605444900 .byte $BE,$95,$68,$38,$45,$00 ; -0.009568384500 .byte $3F,$02,$68,$79,$94,$16 ; 0.0268799416 .byte $BF,$04,$92,$78,$90,$80 ; -0.0492789080 .byte $3F,$07,$03,$15,$20,$00 ; 0.0703152000 .byte $BF,$08,$92,$29,$12,$44 ; -0.0892291244 .byte $3F,$11,$08,$40,$09,$11 ; 0.1108400911 .byte $BF,$14,$28,$31,$56,$04 ; -0.1428315604 .byte $3F,$19,$99,$98,$77,$44 ; 0.1999987744 .byte $BF,$33,$33,$33,$31,$13 ; -0.3333333113 EntryPoint(__DFEA) DFEA: .byte $3F,$99,$99,$99,$99,$99 ; 0.9999999999 .byte $3F,$78,$53,$98,$16,$34 ; 0.7853981634 [ arctan(1) ] DFF6: lda FR0 sta FR1 sec jmp DEE0 .byte 0,0 .end