; ************************************* ; ** ** ; ** FLOATING POINT ROM: D800-DFFF ** ; ** ** ; ************************************* .org $D800 .segment "D800DFFF" .include "atari.inc" .export AFP,FASC,IFP,FPI,ZFR0,ZF1 .export FSUB,FADD,FMUL,FDIV .export PLYEVL,FLD0R,FLD0P,FLD1R,FLD1P,FSTOR,FSTOP,FMOVE .export EXP,EXP10,LOG,LOG10 .export DA48,DA51,DBA1,DBAF,DC00,DE95,DF6C,DFAE,DFEA ; ****************************************** ; ** ASCII -> Floating Point conversion ** ; ****************************************** AFP: jsr DBA1 ; lees spaties aan begin van buffer weg. jsr DBBB ; bekijk getal tot 1e cijfer bcs @5 ; 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 DB94 ; check first digit bcs @6 ; not a digit pha ldx FR0+1 bne @3 jsr DBEB 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 @5: 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 DB94 bcs @13 @10: tax lda EEXP pha stx EEXP jsr DB94 bcs @11 pha lda EEXP asl A sta EEXP asl A asl A adc EEXP sta EEXP pla clc adc EEXP sta EEXP ldy CIX jsr DB9D @11: lda ESIGN beq @12 lda EEXP eor #$FF clc adc #1 sta EEXP @12: pla clc adc EEXP sta EEXP bne @16 @13: cmp #'+' beq @14 cmp #'-' bne @15 sta ESIGN @14: jsr DB94 bcc @10 @15: lda FRX sta CIX @16: dec CIX lda EEXP ldx DIGRT bmi @17 beq @17 sec sbc DIGRT @17: pha rol A pla ror A sta EEXP bcc @18 jsr DBEB @18: lda EEXP clc adc #'D' sta FR0 jsr DC00 bcs @20 ldx NSIGN beq @19 lda FR0 ora #%10000000 sta FR0 @19: clc @20: rts ; **************************************** ; ** Floating Point -> ASCII conversion ** ; **************************************** FASC: jsr DA51 lda #'0' sta $057F lda FR0 beq @2 and #%01111111 cmp #$3F bcc @3 cmp #$45 bcs @3 sec sbc #$3F jsr DC70 jsr DCA4 ora #$80 sta LBUFF,X lda LBUFF cmp #$2E beq @1 jmp @10 @1: jsr DCC1 jmp @11 @2: lda #$B0 sta LBUFF rts @3: lda #1 jsr DC70 jsr DCA4 inx stx CIX lda FR0 asl A 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 $ED lda #'E' ldy CIX jsr DC9F sty CIX lda $ED bpl @6 lda #0 sec sbc $ED sta $ED lda #$2D bne @7 @6: lda #$2B @7: jsr DC9F ldx #0 lda $ED @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 @12 jsr DCC1 ldy #0 lda #$2D sta (INBUFF),Y @12: rts ; ****************************************** ; ** Integer -> Floating Point conversion ** ; ****************************************** IFP: lda FR0 sta $F8 lda FR0+1 sta $F7 jsr ZFR0 ; clear ZFR0 sed ldy #$10 @1: asl $F8 rol $F7 ldx #3 @2: lda FR0,X adc FR0,X sta FR0,X dex bne @2 dey bne @1 cld lda #$42 sta FR0 jmp DC00 ; ****************************************** ; ** Floating Point -> Integer conversion ** ; ****************************************** FPI: lda #0 sta $F7 sta $F8 lda FR0 bmi @4 cmp #$43 bcs @4 sec sbc #$40 bcc @2 adc #0 asl A sta $F5 @1: jsr DA5A bcs @4 lda $F7 sta $F9 lda $F8 sta $FA jsr DA5A bcs @4 jsr DA5A bcs @4 clc lda $F8 adc $FA sta $F8 lda $F7 adc $F9 sta $F7 bcs @4 jsr DCB9 clc adc $F8 sta $F8 lda $F7 adc #0 bcs @4 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 lda $F7 sta FR0+1 clc rts @4: sec rts ZFR0: ldx #FR0 ; clear FR0 ZF1: ldy #6 DA48: lda #0 @1: sta 0,X inx dey bne @1 rts DA51: lda #5 sta INBUFF+1 lda #$80 sta INBUFF rts DA5A: clc rol $F8 rol $F7 rts FSUB: lda FR1 eor #$80 sta FR1 FADD: lda FR1 and #%01111111 sta $F7 lda FR0 and #%01111111 sec sbc $F7 bpl @2 ldx #5 @1: lda FR0,X ldy FR1,X sta FR1,X tya sta FR0,X dex bpl @1 bmi FADD @2: beq @3 cmp #5 bcs @5 jsr DC3E @3: sed lda FR0 eor FR1 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 eor #$80 sta FR0 sec ldx #4 @10: lda #0 sbc FR0+1,X sta FR0+1,X dex bpl @10 cld jmp DC00 FMUL: lda FR0 beq DB24 ; CLC/RTS lda FR1 beq DB21 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 DD01 jmp @2 @3: lda $DF lsr A lsr A lsr A lsr A sta $F6 @4: dec $F6 bmi @5 jsr DD05 jmp @4 @5: jsr DC62 dec $F5 bne @1 DB1A: lda $ED sta FR0 jmp DC04 DB21: jsr ZFR0 ; clear ZFR0 DB24: clc rts DB26: sec rts 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 $D9 bne @3 @5: jsr DD0F asl $D9 asl $D9 asl $D9 asl $D9 @6: ldy #5 sec sed @7: lda FRE,Y sbc FR1,Y sta FRE,Y dey bpl @7 cld bcc @8 inc $D9 bne @6 @8: jsr DD09 dec $F5 bne @1 jsr DC62 jmp DB1A DB94: jsr DBAF ; load A with 0.@9 OR first char of INBUFF ldy CIX bcc DB9D lda (INBUFF),Y DB9D: iny ; wijs naar volgende character sty CIX rts DBA1: ldy CIX ; lees spaties aan begin van buffer weg. lda #' ' @1: cmp (INBUFF),Y bne @2 iny bne @1 @2: sty CIX rts DBAF: ldy CIX ; load A with 0.@9 from INBUFF; SEC if failed. lda (INBUFF),Y sec sbc #'0' bcc DBD0 ; SEC/RTS cmp #10 rts DBBB: lda CIX ; check digits up to 1st '0123456789' pha jsr DB94 ; laad eerste karakter; check '0123456789.+-' bcc isdigit ; 't is een cijfer! cmp #'.' beq ispoint ; 't is een PUNT cmp #'+' beq issign ; 't is een PLUS cmp #'-' beq issign ; 't is een MIN err: pla DBD0: sec ; signaleer ERROR rts issign: jsr DB94 ; buffer starts with PLUS of MIN: next char bcc isdigit ; cijfer? --> @4 cmp #'.' bne err ispoint: jsr DB94 bcc isdigit bcs err isdigit: pla sta CIX clc rts DBE7: ldx #$E7 bne xe7 DBEB: ldx #$D5 xe7: ldy #4 @2: clc rol 4,X rol 3,X rol 2,X rol 1,X rol 0,X rol FRX dey bne @2 rts DC00: ldx #0 stx FRE DC04: ldx #4 lda FR0 beq @5 @1: lda FR0+1 bne @3 ldy #0 @2: lda FR0+2,Y sta FR0+1,Y iny cpy #5 bcc @2 dec FR0 dex bne @1 lda FR0+1 bne @3 sta FR0 clc rts @3: lda FR0 and #$7F cmp #$71 bcc @4 rts @4: cmp #15 bcs @5 jsr ZFR0 ; clear ZFR0 @5: clc rts DC3A: ldx #FR0 bne xfr0 DC3E: ldx #FR1 xfr0: stx $F9 sta $F7 sta $F8 @1: ldy #4 @2: lda 4,X sta 5,X dex dey bne @2 lda #0 sta 5,X ldx $F9 dec $F7 bne @1 lda 0,X clc adc $F8 sta 0,X rts DC62: ldx #10 @1: lda FR0,X sta FR0+1,X dex bpl @1 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 A lsr A lsr A lsr A jsr DC9D lda FR0+1,X and #%00001111 jsr DC9D inx cpx #5 bcc @1 @2: lda $F7 bne @3 lda #$2E jsr DC9F @3: rts DC9D: ora #'0' DC9F: sta LBUFF,Y iny rts DCA4: ldx #10 @1: lda LBUFF,X cmp #$2E beq @2 cmp #'0' bne @3 dex bne @1 @2: dex lda LBUFF,X @3: rts DCB9: jsr DBEB lda FRX and #%00001111 rts DCC1: sec lda INBUFF sbc #1 sta INBUFF lda INBUFF+1 sbc #0 sta INBUFF+1 rts DCCF: lda FR0 eor FR1 and #%10000000 sta $EE asl FR1 lsr FR1 lda FR0 and #%01111111 rts DCE0: ora $EE sta $ED lda #0 sta FR0 sta FR1 jsr DD28 jsr DBE7 lda FRX and #%00001111 sta FR2 lda #5 sta $F5 jsr DD34 jsr ZFR0 ; clear ZFR0 rts DD01: ldx #$D9 bne xd9_1 DD05: ldx #$D9 bne xd8_2 DD09: ldx #$DF xd9_1: ldy #$E5 bne xydfe5 DD0F: ldx #$DF xd8_2: ldy #$EB xydfe5: lda #5 sta $F7 clc sed @4: lda 0,X adc 0,Y sta 0,X dex dey dec $F7 bpl @4 cld rts DD28: ldy #5 ; copy FR1 --> FR2 @1: lda FR1,Y sta FR2,Y dey bpl @1 rts DD34: ldy #5 ; copy FR0 --> FRE @1: lda FR0,Y sta FRE,Y dey bpl @1 rts PLYEVL: stx $FE sty $FF sta $EF ldx #FR1 ldy #5 jsr FSTOR jsr FMOVE ldx $FE ldy $FF jsr FLD0R dec $EF beq DD88 @1: jsr FMUL bcs DD88 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 DD88 dec $EF beq DD88 ldx #FR1 ldy #5 jsr FLD1R bmi @1 DD88: rts FLD0R: stx $FC sty $FD FLD0P: ldy #5 @1: lda ($FC),Y sta FR0,Y dey bpl @1 rts FLD1R: stx $FC sty $FD FLD1P: ldy #5 @1: lda ($FC),Y sta $E0,Y dey bpl @1 rts FSTOR: stx $FC sty $FD FSTOP: ldy #5 @1: lda FR0,Y sta ($FC),Y dey bpl @1 rts ; ### FMOVE: FR1 := FR0 ### FMOVE: ldx #5 @1: lda FR0,X sta FR1,X dex bpl @1 rts EXP: ldx #DE89 jsr FLD1R jsr FMUL bcs err2 ; signal error (SEC/RTS) EXP10: lda #0 sta $F1 lda FR0 sta $F0 and #%01111111 sta FR0 sec sbc #$40 bmi @1 cmp #4 bpl err2 ldx #FR2 ldy #5 jsr FSTOR jsr FPI lda FR0 sta $F1 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 $F1 beq @4 clc ror A sta FR1 lda #1 bcc @2 lda #$10 @2: sta $E1 ldx #4 lda #0 @3: sta $E2,X dex bpl @3 lda FR1 clc adc #$40 bcs err2 bmi err2 sta FR1 jsr FMUL @4: lda $F0 bpl @5 jsr FMOVE ldx #DE8F jsr FLD0R jsr FDIV @5: 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 ] 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 LOG: lda #1 bne log_e LOG10: lda #0 log_e: sta $F0 ; A=0: base-10; A=1: base-e lda FR0 beq @1 ; error if FR0 <= 0 bmi @1 jmp DFF6 ; LDA FR0 / STA FR1 / SEC / JMP DEE0 @1: sec ; signal logarithm error! rts DEE0: sbc #$40 asl A sta $F1 lda FR0+1 and #$F0 bne @1 lda #1 bne @2 @1: inc $F1 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 $F1 sta FR0 bpl @4 eor #$FF clc adc #1 sta FR0 @4: jsr IFP bit $F1 bpl @5 lda #%10000000 ora FR0 sta FR0 @5: jsr FADD lda $F0 beq @6 ldx #DE89 jsr FLD1R jsr FDIV @6: clc rts DF66: .BYTE $40,$03,$16,$22,$77,$66 ; 3.16227766 DF6C: .BYTE $3F,$50,$00,$00,$00,$00 ; 0.5000000000 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 TABLE: 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 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