;FLOATING POINT ACCUMULATOR $B0-$B5
FAC=$B0
;WORK $B6-$C9
WORK=$B6
;THE EXPONENT FOR THE VALUE "1" USED BY COMMODORE WAS 129
;THE IEEE STANDARD IS NOW 127
BIAS=129
BIAS1=BIAS-1
BIASM=256-BIAS
BIAS31=BIAS+31
FLOAT LDA #$00
STA FAC+5 ;SIGN "+" HARDCODED
LDA #BIAS31
STA FAC ;EXPONENT IF INTEGER LARGER THEN $80000000
LDA FAC+1
BMI FLOAT1 ;BRANCH IF NO SHIFTING NEEDED
LDX #$1F
FLOAT0 DEC FAC
ASL FAC+4
ROL FAC+3
ROL FAC+2
ROL FAC+1
BMI FLOAT1 ;BRANCH IF READY
DEX
BNE FLOAT0
;IT WAS ZERO! THE VALUE IN FAC (WHICH IS "BIAS") IS IRRELEVANT!
FLOAT1 RTS
;
;SUBROUTINE TO MOVE FLOATING POINT ACC TO ARG
;
TOARG LDX #$FA
TOARG0 LDA FAC+6,X
STA WORK+6,X
INX
BNE TOARG0
RTS
;
;SUBROUTINE TO SUBTRACT THE VALUE IN "FAC" FROM THE VALUE IN "ARG"
;I.E. "ARG" - "FAC" => "FAC"
;
FSUB LDA FAC+5 ;CHANGE SIGN
EOR #$FF
STA FAC+5
;
;SUBROUTINE TO ADD THE VALUE IN "FAC" TO THE VALUE IN "ARG"
;I.E. "ARG" + "FAC" => "FAC"
;
FADD LDA WORK+1
;
;CHECK IF WE ARE ADDING ZERO
BNE FADD0
JMP FADDH
;
;CHECK IF WE ARE ADDING SOMETHING TO ZERO
FADD0 LDA FAC+1
BNE FADD1
JMP FADDF
;
;COMPARE THE EXPONENTS
FADD1 LDA WORK
SEC
SBC FAC
BEQ FADD5 ;BRANCH IF MANTISSAS ALREADY OK
TAY ;THE DIFFERENCE IN EXPONENTS
BCS FADD3 ;BRANCH IF THE EXPONENT IN "WORK" IS LARGER
;
;IT IS THE MANTISSA OF "WORK" THAT SHALL BE SHIFTED
FADD2 LSR WORK+1 ;RIGHT SHIFT THE MANTISSA
ROR WORK+2
ROR WORK+3
ROR WORK+4
INY
BNE FADD2
BEQ FADD5 ;THE MANTISSA NOW OK!
;
;IT IS THE MANTISSA OF "FAC" THAT SHALL BE SHIFTED
FADD3 LDA WORK ;THE PRELIMINARY EXPONENT OF THE RESULT
STA FAC
FADD4 LSR FAC+1 ;RIGHT SHIFT THE MANTISSA
ROR FAC+2
ROR FAC+3
ROR FAC+4
DEY
BNE FADD4
;
;THE MANTISSAS NOW ALIGNED
;
;CHECK IF THE NUMBERS HAVE THE SAME SIGN
FADD5 LDA WORK+5
CMP FAC+5
BEQ FADDD ;BRANCH IF EQUAL SIGN
;
;DIFFERENT SIGNS
;
;WHICH NUMBER HAS THE LARGEST ABSOLUTE VALUE?
LDX #$FC
FADD6 LDA FAC+5,X
CMP WORK+5,X
BCC FADD9 ;BRANCH IF THE VALUE IN "WORK" IS LARGER
BNE FADD7 ;BRANCH IF THE VALUE IN "FAC" IS LARGER
INX
BNE FADD6 ;BRANCH IF THE THE NEXT MOST SIGNIFICANT BYTE
; SHOULD BE COMPARED
;ALL BYTES WERE EQUAL, THE SUM IS ZERO
LDA #$00
STA FAC+1
BEQ FADDH
;
;THE VALUE IN "FAC" IS LARGER (THE SIGN IS OK!)
FADD7 LDX #$04
FADD8 LDA FAC,X
SBC WORK,X
STA FAC,X
DEX
BNE FADD8
BEQ FADDB ;POSSIBLY SHOULD THE MANTISSA LEFT BE SHIFTED LEFT
;
;THE VALUE IN "WORK" IS LARGER (THE SIGN MUST BE CHANGED!)
FADD9 LDA FAC+5
EOR #$FF
STA FAC+5 ;CHANGE SIGN
LDX #$04
SEC
FADDA LDA WORK,X
SBC FAC,X
STA FAC,X
DEX
BNE FADDA
;
;SHALL THE MANTISSA BE SHIFTED LEFT?
;(IT IS CERTAIN THAT AT LEAST ONE BIT IS SET!)
FADDB LDA FAC+1
FADDC BMI FADDH ;BRANCH IF DONE
DEC FAC
BEQ FADDJ ;UNDERFLOW
ROL FAC+4
ROL FAC+3
ROL FAC+2
ROL FAC+1
JMP FADDC
;
;SAME SIGN
FADDD LDX #$04
CLC
FADDE LDA FAC,X
ADC WORK,X
STA FAC,X
DEX
BNE FADDE
BCC FADDH ;BRANCH IF NO RIGHT SHIFT IS NEEDED
;
;SHIFT THE MANTISSA ONE STEP TO THE RIGHT
INC FAC
BEQ FADDI
ROR FAC+1
ROR FAC+2
ROR FAC+3
ROR FAC+4
JMP FADDH ;DONE!
;
;THE VALUE IN "FAC" WAS ZERO, I.E. THE SUM IS THE VALUE IN "WORK"
FADDF LDX #$06
FADDG LDA WORK-1,X
STA FAC-1,X
DEX
BNE FADDG
FADDH RTS
FADDI DEC FAC ;OVERFLOW, SET "FAC" TO $FF
RTS
FADDJ LDA #$00 ;UNDERFLOW, SET TO ZERO
STA FAC+1
RTS
;
;SUBROUTINE TO DIVIDE THE VALUE IN "ARG" WITH THE VALUE IN "FAC"
;I.E. "ARG" / "FAC" => "FAC"
;
FDIV LDX #$00 ;THE SIGN "+"
LDA WORK+5 ;THE SIGN OF THE DIVIDEND
CMP FAC+5 ;THE SIGN OF THE DIVISOR
BEQ FDIV0
DEX ;THE SIGN "-"
FDIV0 STX FAC+5 ;SET THE SIGN OF THE RATIO
LDA FAC+1 ;IS THE DIVIDEND ZERO?
BEQ FDIVD
LDA WORK+1 ;IS THE DIVISOR ZERO?
BNE FDIV1
STA FAC+1
JMP FDIVB
FDIV1 LDA #$00
LDX #$0C
FDIV2 STA WORK+4,X ;SET WORK AREA TO ZERO
DEX
BNE FDIV2
;
;GET THE MANTISSA OF THE DIVIDEND
LDX #$04
FDIV3 LDA FAC,X
STA WORK+8,X
DEX
BNE FDIV3
LDY #$20 ;NUMBER OF BITS IN 4 BYTES
FDIV4 LDX #$F8
FDIV5 LDA WORK+9,X
CMP WORK+17,X
BCC FDIV8
BNE FDIV6
INX
BNE FDIV5
FDIV6 LDX #$08
;
; CARRY IS SET AT THIS POINT!
FDIV7 LDA WORK,X
SBC WORK+8,X
STA WORK,X
DEX
BNE FDIV7
FDIV8 ROL FAC+4 ;ROLL IN BINARY DIGIT
ROL FAC+3
ROL FAC+2
ROL FAC+1
LDX #$F8 ;ROLL RIGHT 8 BYTES
CLC
FDIV9 ROR WORK+17,X
INX
BNE FDIV9
DEY
BNE FDIV4
;
;THE EXPONENT OF THE PRODUCT, 2 BYTE WORD
;BIAS+1 OR BIAS+2 TO BE SUBTRACTED LATER
SEC
LDA WORK
SBC FAC
STA WORK+19
LDA #$01
SBC #$00
STA WORK+18
LDA #BIASM
STA WORK+17
;
;POSSIBLY A SHIFT ONE STEP TO THE LEFT
LDA FAC+1
BMI FDIVA
ASL FAC+4
ROL FAC+3
ROL FAC+2
ROL FAC+1
INC WORK+17
FDIVA SEC
LDA WORK+19
SBC WORK+17
STA FAC
LDA WORK+18
SBC #$00
BNE FDIVD
BCC FDIVC
FDIVB RTS
;
;UNDERFLOW, SET RESULT TO ZERO
FDIVC LDA #$00
STA FAC+1
RTS
;
;OVERFLOW, "INF" MARKED ACCORDING TO IEEE
FDIVD LDA #$FF
STA FAC
STA FAC+1 ;ANY NON-ZERO VALUE!
RTS
;
;SUBROUTINE TO MULTIPLY THE VALUE IN "ARG" WITH THE VALUE IN "FAC"
;I.E. "ARG" * "FAC" => "FAC"
;
FMUL LDX #$00 ;THE SIGN "+"
LDA FAC+5 ;THE SIGN OF THE FIRST FACTOR
CMP WORK+5 ;THE SIGN OF THE SECOND FACTOR
BEQ FMUL0
DEX ;THE SIGN "-"
FMUL0 STX FAC+5 ;SET THE SIGN OF THE PRODUCT
LDA WORK+1 ;IS THE SECOND FACTOR ZERO
BNE FMUL1
STA FAC+1 ;SET THE FIRST FACTOR ZERO
FMUL1 LDA FAC+1 ;IS THE FIRST FACTOR ZERO
BEQ FMULD ;THE NUMBER IN FAC - FAC+5 WHICH SHOULD BE THE PRODUCT IS ALREADY ZERO
;
;NONE OF THE FACTORS ZERO
LDA #$00
LDX #$0C ;PREPARE WORKING AREA
FMUL2 STA WORK+4,X
DEX
BNE FMUL2
LDY #$20 ;NUMBER OF BITS IN 4 BYTES
FMUL3 LDX #$F8 ;ROLL RIGHT 8 BYTES
CLC
FMUL4 ROR WORK+9,X
INX
BNE FMUL4
ASL FAC+4
ROL FAC+3
ROL FAC+2
ROL FAC+1
BCC FMUL6
;
;ADD CONTRIBUTION
LDX #$08
CLC
FMUL5 LDA WORK+8,X
ADC WORK,X
STA WORK+8,X
DEX
BNE FMUL5
FMUL6 DEY
BNE FMUL3
;
;THE EXPONENT OF THE PRODUCT, 2 BYTE WORD
;BIAS+1 OR BIAS+2 TO BE SUBTRACTED LATER
CLC
LDA FAC
ADC WORK
STA WORK+19
LDA #$00
ADC #$00
STA WORK+18
LDA #BIAS1
STA WORK+17
FMUL7 LDA WORK+9
BMI FMUL8
;
;THE MSB BIT IS NOT SET, SHIFT LEFT
ASL WORK+13
ROL WORK+12
ROL WORK+11
ROL WORK+10
ROL WORK+9
INC WORK+17
;
;COMPUTE THE EXPONENT
FMUL8 SEC
LDA WORK+19
SBC WORK+17
STA FAC
LDA WORK+18
SBC #$00
BCC FMUL9
BNE FMULA
BEQ FMULB
;
;UNDERFLOW, SET RESULT TO ZERO
FMUL9 LDA #$00
STA WORK+9
BEQ FMULB
;
;OVERFLOW, "INF" MARKED ACCORDING TO IEEE
FMULA LDA #$FF
STA FAC
;
;MOVE THE RESULT TO FAC
FMULB LDX #$04
FMULC LDA WORK+8,X
STA FAC,X
DEX
BNE FMULC
FMULD RTS
;SUBROUTINE TO CONVERT A FLOATING POINT VALUE
;TO A 4-BYTE UN-SIGNED INTEGER VALUE
;
;ONLY POSSIBLE IF THE EXPONENT IS SMALLER OR EQUAL TO "BIAS"+31
;IF THIS IS NOT THE CASE NOTHING IS DONE (OVERFLOW)!
;
;IF THE EXPONENT IS SMALLER THEN BIAS+31 AND THE SIGN OF THE FLOATING NUMBER IS "-"
;A NEGATIVE SIGNED INTEGER RESULTS
;
FIX LDA FAC
SEC
SBC #BIAS31
BCS FIX2
TAY
FIX0 INC FAC
LSR FAC+1
ROR FAC+2
ROR FAC+3
ROR FAC+4
INY
BNE FIX0
LDA FAC+5
BPL FIX2
;NEGATIVE NUMBER
SEC
LDX #$04
FIX1 LDA #$00
SBC FAC,X
STA FAC,X
DEX
BNE FIX1
FIX2 RTS