mirror of https://github.com/mist64/msbasic.git
1891 lines
45 KiB
ArmAsm
1891 lines
45 KiB
ArmAsm
.segment "CODE"
|
|
|
|
TEMP1X = TEMP1+(5-BYTES_FP)
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ADD 0.5 TO FAC
|
|
; ----------------------------------------------------------------------------
|
|
FADDH:
|
|
lda #<CON_HALF
|
|
ldy #>CON_HALF
|
|
jmp FADD
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = (Y,A) - FAC
|
|
; ----------------------------------------------------------------------------
|
|
FSUB:
|
|
jsr LOAD_ARG_FROM_YA
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = ARG - FAC
|
|
; ----------------------------------------------------------------------------
|
|
FSUBT:
|
|
lda FACSIGN
|
|
eor #$FF
|
|
sta FACSIGN
|
|
eor ARGSIGN
|
|
sta SGNCPR
|
|
lda FAC
|
|
jmp FADDT
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; Commodore BASIC V2 Easter Egg
|
|
; ----------------------------------------------------------------------------
|
|
.ifdef CONFIG_EASTER_EGG
|
|
EASTER_EGG:
|
|
lda LINNUM
|
|
cmp #<6502
|
|
bne L3628
|
|
lda LINNUM+1
|
|
sbc #>6502
|
|
bne L3628
|
|
sta LINNUM
|
|
tay
|
|
lda #$80
|
|
sta LINNUM+1
|
|
LD758:
|
|
ldx #$0A
|
|
LD75A:
|
|
lda MICROSOFT-1,x
|
|
and #$3F
|
|
sta (LINNUM),y
|
|
iny
|
|
bne LD766
|
|
inc LINNUM+1
|
|
LD766:
|
|
dex
|
|
bne LD75A
|
|
dec FORPNT
|
|
bne LD758
|
|
rts
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; SHIFT SMALLER ARGUMENT MORE THAN 7 BITS
|
|
; ----------------------------------------------------------------------------
|
|
FADD1:
|
|
jsr SHIFT_RIGHT
|
|
bcc FADD3
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = (Y,A) + FAC
|
|
; ----------------------------------------------------------------------------
|
|
FADD:
|
|
jsr LOAD_ARG_FROM_YA
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = ARG + FAC
|
|
; ----------------------------------------------------------------------------
|
|
FADDT:
|
|
bne L365B
|
|
jmp COPY_ARG_TO_FAC
|
|
L365B:
|
|
ldx FACEXTENSION
|
|
stx ARGEXTENSION
|
|
ldx #ARG
|
|
lda ARG
|
|
FADD2:
|
|
tay
|
|
.ifdef KBD
|
|
beq RTS4
|
|
.else
|
|
beq RTS3
|
|
.endif
|
|
sec
|
|
sbc FAC
|
|
beq FADD3
|
|
bcc L367F
|
|
sty FAC
|
|
ldy ARGSIGN
|
|
sty FACSIGN
|
|
eor #$FF
|
|
adc #$00
|
|
ldy #$00
|
|
sty ARGEXTENSION
|
|
ldx #FAC
|
|
bne L3683
|
|
L367F:
|
|
ldy #$00
|
|
sty FACEXTENSION
|
|
L3683:
|
|
cmp #$F9
|
|
bmi FADD1
|
|
tay
|
|
lda FACEXTENSION
|
|
lsr 1,x
|
|
jsr SHIFT_RIGHT4
|
|
FADD3:
|
|
bit SGNCPR
|
|
bpl FADD4
|
|
ldy #FAC
|
|
cpx #ARG
|
|
beq L369B
|
|
ldy #ARG
|
|
L369B:
|
|
sec
|
|
eor #$FF
|
|
adc ARGEXTENSION
|
|
sta FACEXTENSION
|
|
.ifndef CONFIG_SMALL
|
|
lda 4,y
|
|
sbc 4,x
|
|
sta FAC+4
|
|
.endif
|
|
lda 3,y
|
|
sbc 3,x
|
|
sta FAC+3
|
|
lda 2,y
|
|
sbc 2,x
|
|
sta FAC+2
|
|
lda 1,y
|
|
sbc 1,x
|
|
sta FAC+1
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; NORMALIZE VALUE IN FAC
|
|
; ----------------------------------------------------------------------------
|
|
NORMALIZE_FAC1:
|
|
bcs NORMALIZE_FAC2
|
|
jsr COMPLEMENT_FAC
|
|
NORMALIZE_FAC2:
|
|
ldy #$00
|
|
tya
|
|
clc
|
|
L36C7:
|
|
ldx FAC+1
|
|
bne NORMALIZE_FAC4
|
|
ldx FAC+2
|
|
stx FAC+1
|
|
ldx FAC+3
|
|
stx FAC+2
|
|
.ifdef CONFIG_SMALL
|
|
ldx FACEXTENSION
|
|
stx FAC+3
|
|
.else
|
|
ldx FAC+4
|
|
stx FAC+3
|
|
ldx FACEXTENSION
|
|
stx FAC+4
|
|
.endif
|
|
sty FACEXTENSION
|
|
adc #$08
|
|
.ifdef CONFIG_2B
|
|
; bugfix?
|
|
; fix does not exist on AppleSoft 2
|
|
cmp #(MANTISSA_BYTES+1)*8
|
|
.else
|
|
cmp #MANTISSA_BYTES*8
|
|
.endif
|
|
bne L36C7
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; SET FAC = 0
|
|
; (ONLY NECESSARY TO ZERO EXPONENT AND SIGN CELLS)
|
|
; ----------------------------------------------------------------------------
|
|
ZERO_FAC:
|
|
lda #$00
|
|
STA_IN_FAC_SIGN_AND_EXP:
|
|
sta FAC
|
|
STA_IN_FAC_SIGN:
|
|
sta FACSIGN
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ADD MANTISSAS OF FAC AND ARG INTO FAC
|
|
; ----------------------------------------------------------------------------
|
|
FADD4:
|
|
adc ARGEXTENSION
|
|
sta FACEXTENSION
|
|
.ifndef CONFIG_SMALL
|
|
lda FAC+4
|
|
adc ARG+4
|
|
sta FAC+4
|
|
.endif
|
|
lda FAC+3
|
|
adc ARG+3
|
|
sta FAC+3
|
|
lda FAC+2
|
|
adc ARG+2
|
|
sta FAC+2
|
|
lda FAC+1
|
|
adc ARG+1
|
|
sta FAC+1
|
|
jmp NORMALIZE_FAC5
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FINISH NORMALIZING FAC
|
|
; ----------------------------------------------------------------------------
|
|
NORMALIZE_FAC3:
|
|
adc #$01
|
|
asl FACEXTENSION
|
|
.ifndef CONFIG_SMALL
|
|
rol FAC+4
|
|
.endif
|
|
rol FAC+3
|
|
rol FAC+2
|
|
rol FAC+1
|
|
NORMALIZE_FAC4:
|
|
bpl NORMALIZE_FAC3
|
|
sec
|
|
sbc FAC
|
|
bcs ZERO_FAC
|
|
eor #$FF
|
|
adc #$01
|
|
sta FAC
|
|
NORMALIZE_FAC5:
|
|
bcc L3764
|
|
NORMALIZE_FAC6:
|
|
inc FAC
|
|
beq OVERFLOW
|
|
.ifndef CONFIG_ROR_WORKAROUND
|
|
ror FAC+1
|
|
ror FAC+2
|
|
ror FAC+3
|
|
.ifndef CONFIG_SMALL
|
|
ror FAC+4
|
|
.endif
|
|
ror FACEXTENSION
|
|
.else
|
|
lda #$00
|
|
bcc L372E
|
|
lda #$80
|
|
L372E:
|
|
lsr FAC+1
|
|
ora FAC+1
|
|
sta FAC+1
|
|
lda #$00
|
|
bcc L373A
|
|
lda #$80
|
|
L373A:
|
|
lsr FAC+2
|
|
ora FAC+2
|
|
sta FAC+2
|
|
lda #$00
|
|
bcc L3746
|
|
lda #$80
|
|
L3746:
|
|
lsr FAC+3
|
|
ora FAC+3
|
|
sta FAC+3
|
|
lda #$00
|
|
bcc L3752
|
|
lda #$80
|
|
L3752:
|
|
lsr FAC+4
|
|
ora FAC+4
|
|
sta FAC+4
|
|
lda #$00
|
|
bcc L375E
|
|
lda #$80
|
|
L375E:
|
|
lsr FACEXTENSION
|
|
ora FACEXTENSION
|
|
sta FACEXTENSION
|
|
.endif
|
|
L3764:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; 2'S COMPLEMENT OF FAC
|
|
; ----------------------------------------------------------------------------
|
|
COMPLEMENT_FAC:
|
|
lda FACSIGN
|
|
eor #$FF
|
|
sta FACSIGN
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; 2'S COMPLEMENT OF FAC MANTISSA ONLY
|
|
; ----------------------------------------------------------------------------
|
|
COMPLEMENT_FAC_MANTISSA:
|
|
lda FAC+1
|
|
eor #$FF
|
|
sta FAC+1
|
|
lda FAC+2
|
|
eor #$FF
|
|
sta FAC+2
|
|
lda FAC+3
|
|
eor #$FF
|
|
sta FAC+3
|
|
.ifndef CONFIG_SMALL
|
|
lda FAC+4
|
|
eor #$FF
|
|
sta FAC+4
|
|
.endif
|
|
lda FACEXTENSION
|
|
eor #$FF
|
|
sta FACEXTENSION
|
|
inc FACEXTENSION
|
|
bne RTS12
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; INCREMENT FAC MANTISSA
|
|
; ----------------------------------------------------------------------------
|
|
INCREMENT_FAC_MANTISSA:
|
|
.ifndef CONFIG_SMALL
|
|
inc FAC+4
|
|
bne RTS12
|
|
.endif
|
|
inc FAC+3
|
|
bne RTS12
|
|
inc FAC+2
|
|
bne RTS12
|
|
inc FAC+1
|
|
RTS12:
|
|
rts
|
|
OVERFLOW:
|
|
ldx #ERR_OVERFLOW
|
|
jmp ERROR
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; SHIFT 1,X THRU 5,X RIGHT
|
|
; (A) = NEGATIVE OF SHIFT COUNT
|
|
; (X) = POINTER TO BYTES TO BE SHIFTED
|
|
;
|
|
; RETURN WITH (Y)=0, CARRY=0, EXTENSION BITS IN A-REG
|
|
; ----------------------------------------------------------------------------
|
|
SHIFT_RIGHT1:
|
|
ldx #RESULT-1
|
|
SHIFT_RIGHT2:
|
|
.ifdef CONFIG_SMALL
|
|
ldy 3,x
|
|
.else
|
|
ldy 4,x
|
|
.endif
|
|
sty FACEXTENSION
|
|
.ifndef CONFIG_SMALL
|
|
ldy 3,x
|
|
sty 4,x
|
|
.endif
|
|
ldy 2,x
|
|
sty 3,x
|
|
ldy 1,x
|
|
sty 2,x
|
|
ldy SHIFTSIGNEXT
|
|
sty 1,x
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; MAIN ENTRY TO RIGHT SHIFT SUBROUTINE
|
|
; ----------------------------------------------------------------------------
|
|
SHIFT_RIGHT:
|
|
adc #$08
|
|
bmi SHIFT_RIGHT2
|
|
beq SHIFT_RIGHT2
|
|
sbc #$08
|
|
tay
|
|
lda FACEXTENSION
|
|
bcs SHIFT_RIGHT5
|
|
.ifndef CONFIG_ROR_WORKAROUND
|
|
LB588:
|
|
asl 1,x
|
|
bcc LB58E
|
|
inc 1,x
|
|
LB58E:
|
|
ror 1,x
|
|
ror 1,x
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ENTER HERE FOR SHORT SHIFTS WITH NO SIGN EXTENSION
|
|
; ----------------------------------------------------------------------------
|
|
SHIFT_RIGHT4:
|
|
ror 2,x
|
|
ror 3,x
|
|
.ifndef CONFIG_SMALL
|
|
ror 4,x
|
|
.endif
|
|
ror a
|
|
iny
|
|
bne LB588
|
|
.else
|
|
L37C4:
|
|
pha
|
|
lda 1,x
|
|
and #$80
|
|
lsr 1,x
|
|
ora 1,x
|
|
sta 1,x
|
|
.byte $24
|
|
SHIFT_RIGHT4:
|
|
pha
|
|
lda #$00
|
|
bcc L37D7
|
|
lda #$80
|
|
L37D7:
|
|
lsr 2,x
|
|
ora 2,x
|
|
sta 2,x
|
|
lda #$00
|
|
bcc L37E3
|
|
lda #$80
|
|
L37E3:
|
|
lsr 3,x
|
|
ora 3,x
|
|
sta 3,x
|
|
lda #$00
|
|
bcc L37EF
|
|
lda #$80
|
|
L37EF:
|
|
lsr 4,x
|
|
ora 4,x
|
|
sta 4,x
|
|
pla
|
|
php
|
|
lsr a
|
|
plp
|
|
bcc L37FD
|
|
ora #$80
|
|
L37FD:
|
|
iny
|
|
bne L37C4
|
|
.endif
|
|
SHIFT_RIGHT5:
|
|
clc
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
.ifdef CONFIG_SMALL
|
|
CON_ONE:
|
|
.byte $81,$00,$00,$00
|
|
POLY_LOG:
|
|
.byte $02
|
|
.byte $80,$19,$56,$62
|
|
.byte $80,$76,$22,$F3
|
|
.byte $82,$38,$AA,$40
|
|
CON_SQR_HALF:
|
|
.byte $80,$35,$04,$F3
|
|
CON_SQR_TWO:
|
|
.byte $81,$35,$04,$F3
|
|
CON_NEG_HALF:
|
|
.byte $80,$80,$00,$00
|
|
CON_LOG_TWO:
|
|
.byte $80,$31,$72,$18
|
|
.else
|
|
CON_ONE:
|
|
.byte $81,$00,$00,$00,$00
|
|
POLY_LOG:
|
|
.byte $03
|
|
.byte $7F,$5E,$56,$CB,$79
|
|
.byte $80,$13,$9B,$0B,$64
|
|
.byte $80,$76,$38,$93,$16
|
|
.byte $82,$38,$AA,$3B,$20
|
|
CON_SQR_HALF:
|
|
.byte $80,$35,$04,$F3,$34
|
|
CON_SQR_TWO:
|
|
.byte $81,$35,$04,$F3,$34
|
|
CON_NEG_HALF:
|
|
.byte $80,$80,$00,$00,$00
|
|
CON_LOG_TWO:
|
|
.byte $80,$31,$72,$17,$F8
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "LOG" FUNCTION
|
|
; ----------------------------------------------------------------------------
|
|
LOG:
|
|
jsr SIGN
|
|
beq GIQ
|
|
bpl LOG2
|
|
GIQ:
|
|
jmp IQERR
|
|
LOG2:
|
|
lda FAC
|
|
sbc #$7F
|
|
pha
|
|
lda #$80
|
|
sta FAC
|
|
lda #<CON_SQR_HALF
|
|
ldy #>CON_SQR_HALF
|
|
jsr FADD
|
|
lda #<CON_SQR_TWO
|
|
ldy #>CON_SQR_TWO
|
|
jsr FDIV
|
|
lda #<CON_ONE
|
|
ldy #>CON_ONE
|
|
jsr FSUB
|
|
lda #<POLY_LOG
|
|
ldy #>POLY_LOG
|
|
jsr POLYNOMIAL_ODD
|
|
lda #<CON_NEG_HALF
|
|
ldy #>CON_NEG_HALF
|
|
jsr FADD
|
|
pla
|
|
jsr ADDACC
|
|
lda #<CON_LOG_TWO
|
|
ldy #>CON_LOG_TWO
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = (Y,A) * FAC
|
|
; ----------------------------------------------------------------------------
|
|
FMULT:
|
|
jsr LOAD_ARG_FROM_YA
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = ARG * FAC
|
|
; ----------------------------------------------------------------------------
|
|
FMULTT:
|
|
.ifndef CONFIG_11
|
|
beq L3903
|
|
.else
|
|
jeq L3903
|
|
.endif
|
|
jsr ADD_EXPONENTS
|
|
lda #$00
|
|
sta RESULT
|
|
sta RESULT+1
|
|
sta RESULT+2
|
|
.ifndef CONFIG_SMALL
|
|
sta RESULT+3
|
|
.endif
|
|
lda FACEXTENSION
|
|
jsr MULTIPLY1
|
|
.ifndef CONFIG_SMALL
|
|
lda FAC+4
|
|
jsr MULTIPLY1
|
|
.endif
|
|
lda FAC+3
|
|
jsr MULTIPLY1
|
|
lda FAC+2
|
|
jsr MULTIPLY1
|
|
lda FAC+1
|
|
jsr MULTIPLY2
|
|
jmp COPY_RESULT_INTO_FAC
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; MULTIPLY ARG BY (A) INTO RESULT
|
|
; ----------------------------------------------------------------------------
|
|
MULTIPLY1:
|
|
bne MULTIPLY2
|
|
jmp SHIFT_RIGHT1
|
|
MULTIPLY2:
|
|
lsr a
|
|
ora #$80
|
|
L38A7:
|
|
tay
|
|
bcc L38C3
|
|
clc
|
|
.ifndef CONFIG_SMALL
|
|
lda RESULT+3
|
|
adc ARG+4
|
|
sta RESULT+3
|
|
.endif
|
|
lda RESULT+2
|
|
adc ARG+3
|
|
sta RESULT+2
|
|
lda RESULT+1
|
|
adc ARG+2
|
|
sta RESULT+1
|
|
lda RESULT
|
|
adc ARG+1
|
|
sta RESULT
|
|
L38C3:
|
|
.ifndef CONFIG_ROR_WORKAROUND
|
|
ror RESULT
|
|
ror RESULT+1
|
|
.ifdef APPLE_BAD_BYTE
|
|
; this seems to be a bad byte in the dump
|
|
.byte RESULT+2,RESULT+2 ; XXX BUG!
|
|
.else
|
|
ror RESULT+2
|
|
.endif
|
|
.ifndef CONFIG_SMALL
|
|
ror RESULT+3
|
|
.endif
|
|
ror FACEXTENSION
|
|
.else
|
|
lda #$00
|
|
bcc L38C9
|
|
lda #$80
|
|
L38C9:
|
|
lsr RESULT
|
|
ora RESULT
|
|
sta RESULT
|
|
lda #$00
|
|
bcc L38D5
|
|
lda #$80
|
|
L38D5:
|
|
lsr RESULT+1
|
|
ora RESULT+1
|
|
sta RESULT+1
|
|
lda #$00
|
|
bcc L38E1
|
|
lda #$80
|
|
L38E1:
|
|
lsr RESULT+2
|
|
ora RESULT+2
|
|
sta RESULT+2
|
|
lda #$00
|
|
bcc L38ED
|
|
lda #$80
|
|
L38ED:
|
|
lsr RESULT+3
|
|
ora RESULT+3
|
|
sta RESULT+3
|
|
lda #$00
|
|
bcc L38F9
|
|
lda #$80
|
|
L38F9:
|
|
lsr FACEXTENSION
|
|
ora FACEXTENSION
|
|
sta FACEXTENSION
|
|
.endif
|
|
tya
|
|
lsr a
|
|
bne L38A7
|
|
L3903:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; UNPACK NUMBER AT (Y,A) INTO ARG
|
|
; ----------------------------------------------------------------------------
|
|
LOAD_ARG_FROM_YA:
|
|
sta INDEX
|
|
sty INDEX+1
|
|
ldy #BYTES_FP-1
|
|
.ifndef CONFIG_SMALL
|
|
lda (INDEX),y
|
|
sta ARG+4
|
|
dey
|
|
.endif
|
|
lda (INDEX),y
|
|
sta ARG+3
|
|
dey
|
|
lda (INDEX),y
|
|
sta ARG+2
|
|
dey
|
|
lda (INDEX),y
|
|
sta ARGSIGN
|
|
eor FACSIGN
|
|
sta SGNCPR
|
|
lda ARGSIGN
|
|
ora #$80
|
|
sta ARG+1
|
|
dey
|
|
lda (INDEX),y
|
|
sta ARG
|
|
lda FAC
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ADD EXPONENTS OF ARG AND FAC
|
|
; (CALLED BY FMULT AND FDIV)
|
|
;
|
|
; ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN
|
|
; ----------------------------------------------------------------------------
|
|
ADD_EXPONENTS:
|
|
lda ARG
|
|
ADD_EXPONENTS1:
|
|
beq ZERO
|
|
clc
|
|
adc FAC
|
|
bcc L393C
|
|
bmi JOV
|
|
clc
|
|
.byte $2C
|
|
L393C:
|
|
bpl ZERO
|
|
adc #$80
|
|
sta FAC
|
|
bne L3947
|
|
jmp STA_IN_FAC_SIGN
|
|
L3947:
|
|
lda SGNCPR
|
|
sta FACSIGN
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR
|
|
; IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS
|
|
; CALLED FROM "EXP" FUNCTION
|
|
; ----------------------------------------------------------------------------
|
|
OUTOFRNG:
|
|
lda FACSIGN
|
|
eor #$FF
|
|
bmi JOV
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; POP RETURN ADDRESS AND SET FAC=0
|
|
; ----------------------------------------------------------------------------
|
|
ZERO:
|
|
pla
|
|
pla
|
|
jmp ZERO_FAC
|
|
JOV:
|
|
jmp OVERFLOW
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; MULTIPLY FAC BY 10
|
|
; ----------------------------------------------------------------------------
|
|
MUL10:
|
|
jsr COPY_FAC_TO_ARG_ROUNDED
|
|
tax
|
|
beq L3970
|
|
clc
|
|
adc #$02
|
|
bcs JOV
|
|
LD9BF:
|
|
ldx #$00
|
|
stx SGNCPR
|
|
jsr FADD2
|
|
inc FAC
|
|
beq JOV
|
|
L3970:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
CONTEN:
|
|
.ifdef CONFIG_SMALL
|
|
.byte $84,$20,$00,$00
|
|
.else
|
|
.byte $84,$20,$00,$00,$00
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; DIVIDE FAC BY 10
|
|
; ----------------------------------------------------------------------------
|
|
DIV10:
|
|
jsr COPY_FAC_TO_ARG_ROUNDED
|
|
lda #<CONTEN
|
|
ldy #>CONTEN
|
|
ldx #$00
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = ARG / (Y,A)
|
|
; ----------------------------------------------------------------------------
|
|
DIV:
|
|
stx SGNCPR
|
|
jsr LOAD_FAC_FROM_YA
|
|
jmp FDIVT
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = (Y,A) / FAC
|
|
; ----------------------------------------------------------------------------
|
|
FDIV:
|
|
jsr LOAD_ARG_FROM_YA
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FAC = ARG / FAC
|
|
; ----------------------------------------------------------------------------
|
|
FDIVT:
|
|
beq L3A02
|
|
jsr ROUND_FAC
|
|
lda #$00
|
|
sec
|
|
sbc FAC
|
|
sta FAC
|
|
jsr ADD_EXPONENTS
|
|
inc FAC
|
|
beq JOV
|
|
ldx #-MANTISSA_BYTES
|
|
lda #$01
|
|
L39A1:
|
|
ldy ARG+1
|
|
cpy FAC+1
|
|
bne L39B7
|
|
ldy ARG+2
|
|
cpy FAC+2
|
|
bne L39B7
|
|
ldy ARG+3
|
|
cpy FAC+3
|
|
.ifndef CONFIG_SMALL
|
|
bne L39B7
|
|
ldy ARG+4
|
|
cpy FAC+4
|
|
.endif
|
|
L39B7:
|
|
php
|
|
rol a
|
|
bcc L39C4
|
|
inx
|
|
sta RESULT_LAST-1,x
|
|
beq L39F2
|
|
bpl L39F6
|
|
lda #$01
|
|
L39C4:
|
|
plp
|
|
bcs L39D5
|
|
L39C7:
|
|
asl ARG_LAST
|
|
.ifndef CONFIG_SMALL
|
|
rol ARG+3
|
|
.endif
|
|
rol ARG+2
|
|
rol ARG+1
|
|
bcs L39B7
|
|
bmi L39A1
|
|
bpl L39B7
|
|
L39D5:
|
|
tay
|
|
.ifndef CONFIG_SMALL
|
|
lda ARG+4
|
|
sbc FAC+4
|
|
sta ARG+4
|
|
.endif
|
|
lda ARG+3
|
|
sbc FAC+3
|
|
sta ARG+3
|
|
lda ARG+2
|
|
sbc FAC+2
|
|
sta ARG+2
|
|
lda ARG+1
|
|
sbc FAC+1
|
|
sta ARG+1
|
|
tya
|
|
jmp L39C7
|
|
L39F2:
|
|
lda #$40
|
|
bne L39C4
|
|
L39F6:
|
|
asl a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
asl a
|
|
sta FACEXTENSION
|
|
plp
|
|
jmp COPY_RESULT_INTO_FAC
|
|
L3A02:
|
|
ldx #ERR_ZERODIV
|
|
jmp ERROR
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; COPY RESULT INTO FAC MANTISSA, AND NORMALIZE
|
|
; ----------------------------------------------------------------------------
|
|
COPY_RESULT_INTO_FAC:
|
|
lda RESULT
|
|
sta FAC+1
|
|
lda RESULT+1
|
|
sta FAC+2
|
|
lda RESULT+2
|
|
sta FAC+3
|
|
.ifndef CONFIG_SMALL
|
|
lda RESULT+3
|
|
sta FAC+4
|
|
.endif
|
|
jmp NORMALIZE_FAC2
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; UNPACK (Y,A) INTO FAC
|
|
; ----------------------------------------------------------------------------
|
|
LOAD_FAC_FROM_YA:
|
|
sta INDEX
|
|
sty INDEX+1
|
|
ldy #MANTISSA_BYTES
|
|
.ifndef CONFIG_SMALL
|
|
lda (INDEX),y
|
|
sta FAC+4
|
|
dey
|
|
.endif
|
|
lda (INDEX),y
|
|
sta FAC+3
|
|
dey
|
|
lda (INDEX),y
|
|
sta FAC+2
|
|
dey
|
|
lda (INDEX),y
|
|
sta FACSIGN
|
|
ora #$80
|
|
sta FAC+1
|
|
dey
|
|
lda (INDEX),y
|
|
sta FAC
|
|
sty FACEXTENSION
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ROUND FAC, STORE IN TEMP2
|
|
; ----------------------------------------------------------------------------
|
|
STORE_FAC_IN_TEMP2_ROUNDED:
|
|
ldx #TEMP2
|
|
.byte $2C
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ROUND FAC, STORE IN TEMP1
|
|
; ----------------------------------------------------------------------------
|
|
STORE_FAC_IN_TEMP1_ROUNDED:
|
|
ldx #TEMP1X
|
|
ldy #$00
|
|
beq STORE_FAC_AT_YX_ROUNDED
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ROUND FAC, AND STORE WHERE FORPNT POINTS
|
|
; ----------------------------------------------------------------------------
|
|
SETFOR:
|
|
ldx FORPNT
|
|
ldy FORPNT+1
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ROUND FAC, AND STORE AT (Y,X)
|
|
; ----------------------------------------------------------------------------
|
|
STORE_FAC_AT_YX_ROUNDED:
|
|
jsr ROUND_FAC
|
|
stx INDEX
|
|
sty INDEX+1
|
|
ldy #MANTISSA_BYTES
|
|
.ifndef CONFIG_SMALL
|
|
lda FAC+4
|
|
sta (INDEX),y
|
|
dey
|
|
.endif
|
|
lda FAC+3
|
|
sta (INDEX),y
|
|
dey
|
|
lda FAC+2
|
|
sta (INDEX),y
|
|
dey
|
|
lda FACSIGN
|
|
ora #$7F
|
|
and FAC+1
|
|
sta (INDEX),y
|
|
dey
|
|
lda FAC
|
|
sta (INDEX),y
|
|
sty FACEXTENSION
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; COPY ARG INTO FAC
|
|
; ----------------------------------------------------------------------------
|
|
COPY_ARG_TO_FAC:
|
|
lda ARGSIGN
|
|
MFA:
|
|
sta FACSIGN
|
|
ldx #BYTES_FP
|
|
L3A7A:
|
|
lda SHIFTSIGNEXT,x
|
|
sta EXPSGN,x
|
|
dex
|
|
bne L3A7A
|
|
stx FACEXTENSION
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ROUND FAC AND COPY TO ARG
|
|
; ----------------------------------------------------------------------------
|
|
COPY_FAC_TO_ARG_ROUNDED:
|
|
jsr ROUND_FAC
|
|
MAF:
|
|
ldx #BYTES_FP+1
|
|
L3A89:
|
|
lda EXPSGN,x
|
|
sta SHIFTSIGNEXT,x
|
|
dex
|
|
bne L3A89
|
|
stx FACEXTENSION
|
|
RTS14:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ROUND FAC USING EXTENSION BYTE
|
|
; ----------------------------------------------------------------------------
|
|
ROUND_FAC:
|
|
lda FAC
|
|
beq RTS14
|
|
asl FACEXTENSION
|
|
bcc RTS14
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
|
|
; ----------------------------------------------------------------------------
|
|
INCREMENT_MANTISSA:
|
|
jsr INCREMENT_FAC_MANTISSA
|
|
bne RTS14
|
|
jmp NORMALIZE_FAC6
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; TEST FAC FOR ZERO AND SIGN
|
|
;
|
|
; FAC > 0, RETURN +1
|
|
; FAC = 0, RETURN 0
|
|
; FAC < 0, RETURN -1
|
|
; ----------------------------------------------------------------------------
|
|
SIGN:
|
|
lda FAC
|
|
beq RTS15
|
|
L3AA7:
|
|
lda FACSIGN
|
|
SIGN2:
|
|
rol a
|
|
lda #$FF
|
|
bcs RTS15
|
|
lda #$01
|
|
RTS15:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "SGN" FUNCTION
|
|
; ----------------------------------------------------------------------------
|
|
SGN:
|
|
jsr SIGN
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
|
|
; ----------------------------------------------------------------------------
|
|
FLOAT:
|
|
sta FAC+1
|
|
lda #$00
|
|
sta FAC+2
|
|
ldx #$88
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FLOAT UNSIGNED VALUE IN FAC+1,2
|
|
; (X) = EXPONENT
|
|
; ----------------------------------------------------------------------------
|
|
FLOAT1:
|
|
lda FAC+1
|
|
eor #$FF
|
|
rol a
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FLOAT UNSIGNED VALUE IN FAC+1,2
|
|
; (X) = EXPONENT
|
|
; C=0 TO MAKE VALUE NEGATIVE
|
|
; C=1 TO MAKE VALUE POSITIVE
|
|
; ----------------------------------------------------------------------------
|
|
FLOAT2:
|
|
lda #$00
|
|
.ifndef CONFIG_SMALL
|
|
sta FAC+4
|
|
.endif
|
|
sta FAC+3
|
|
LDB21:
|
|
stx FAC
|
|
sta FACEXTENSION
|
|
sta FACSIGN
|
|
jmp NORMALIZE_FAC1
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "ABS" FUNCTION
|
|
; ----------------------------------------------------------------------------
|
|
ABS:
|
|
lsr FACSIGN
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; COMPARE FAC WITH PACKED # AT (Y,A)
|
|
; RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
|
|
; ----------------------------------------------------------------------------
|
|
FCOMP:
|
|
sta DEST
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; SPECIAL ENTRY FROM "NEXT" PROCESSOR
|
|
; "DEST" ALREADY SET UP
|
|
; ----------------------------------------------------------------------------
|
|
FCOMP2:
|
|
sty DEST+1
|
|
ldy #$00
|
|
lda (DEST),y
|
|
iny
|
|
tax
|
|
beq SIGN
|
|
lda (DEST),y
|
|
eor FACSIGN
|
|
bmi L3AA7
|
|
cpx FAC
|
|
bne L3B0A
|
|
lda (DEST),y
|
|
ora #$80
|
|
cmp FAC+1
|
|
bne L3B0A
|
|
iny
|
|
lda (DEST),y
|
|
cmp FAC+2
|
|
bne L3B0A
|
|
iny
|
|
.ifndef CONFIG_SMALL
|
|
lda (DEST),y
|
|
cmp FAC+3
|
|
bne L3B0A
|
|
iny
|
|
.endif
|
|
lda #$7F
|
|
cmp FACEXTENSION
|
|
lda (DEST),y
|
|
sbc FAC_LAST
|
|
beq L3B32
|
|
L3B0A:
|
|
lda FACSIGN
|
|
bcc L3B10
|
|
eor #$FF
|
|
L3B10:
|
|
jmp SIGN2
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; QUICK INTEGER FUNCTION
|
|
;
|
|
; CONVERTS FP VALUE IN FAC TO INTEGER VALUE
|
|
; IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN
|
|
; EXTENSION UNTIL FRACTIONAL BITS ARE OUT.
|
|
;
|
|
; THIS SUBROUTINE ASSUMES THE EXPONENT < 32.
|
|
; ----------------------------------------------------------------------------
|
|
QINT:
|
|
lda FAC
|
|
beq QINT3
|
|
sec
|
|
sbc #120+8*BYTES_FP
|
|
bit FACSIGN
|
|
bpl L3B27
|
|
tax
|
|
lda #$FF
|
|
sta SHIFTSIGNEXT
|
|
jsr COMPLEMENT_FAC_MANTISSA
|
|
txa
|
|
L3B27:
|
|
ldx #FAC
|
|
cmp #$F9
|
|
bpl QINT2
|
|
jsr SHIFT_RIGHT
|
|
sty SHIFTSIGNEXT
|
|
L3B32:
|
|
rts
|
|
QINT2:
|
|
tay
|
|
lda FACSIGN
|
|
and #$80
|
|
lsr FAC+1
|
|
ora FAC+1
|
|
sta FAC+1
|
|
jsr SHIFT_RIGHT4
|
|
sty SHIFTSIGNEXT
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "INT" FUNCTION
|
|
;
|
|
; USES QINT TO CONVERT (FAC) TO INTEGER FORM,
|
|
; AND THEN REFLOATS THE INTEGER.
|
|
; ----------------------------------------------------------------------------
|
|
INT:
|
|
lda FAC
|
|
cmp #120+8*BYTES_FP
|
|
bcs RTS17
|
|
jsr QINT
|
|
sty FACEXTENSION
|
|
lda FACSIGN
|
|
sty FACSIGN
|
|
eor #$80
|
|
rol a
|
|
lda #120+8*BYTES_FP
|
|
sta FAC
|
|
lda FAC_LAST
|
|
sta CHARAC
|
|
jmp NORMALIZE_FAC1
|
|
QINT3:
|
|
sta FAC+1
|
|
sta FAC+2
|
|
sta FAC+3
|
|
.ifndef CONFIG_SMALL
|
|
sta FAC+4
|
|
.endif
|
|
tay
|
|
RTS17:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; CONVERT STRING TO FP VALUE IN FAC
|
|
;
|
|
; STRING POINTED TO BY TXTPTR
|
|
; FIRST CHAR ALREADY SCANNED BY CHRGET
|
|
; (A) = FIRST CHAR, C=0 IF DIGIT.
|
|
; ----------------------------------------------------------------------------
|
|
FIN:
|
|
ldy #$00
|
|
ldx #SERLEN-TMPEXP
|
|
L3B6F:
|
|
sty TMPEXP,x
|
|
dex
|
|
bpl L3B6F
|
|
bcc FIN2
|
|
.ifdef SYM1
|
|
cmp #$26
|
|
bne LDABB
|
|
jmp LCDFE
|
|
LDABB:
|
|
.endif
|
|
cmp #$2D
|
|
bne L3B7E
|
|
stx SERLEN
|
|
beq FIN1
|
|
L3B7E:
|
|
cmp #$2B
|
|
bne FIN3
|
|
FIN1:
|
|
jsr CHRGET
|
|
FIN2:
|
|
bcc FIN9
|
|
FIN3:
|
|
cmp #$2E
|
|
beq FIN10
|
|
cmp #$45
|
|
bne FIN7
|
|
jsr CHRGET
|
|
bcc FIN5
|
|
cmp #TOKEN_MINUS
|
|
beq L3BA6
|
|
cmp #$2D
|
|
beq L3BA6
|
|
cmp #TOKEN_PLUS
|
|
beq FIN4
|
|
cmp #$2B
|
|
beq FIN4
|
|
bne FIN6
|
|
L3BA6:
|
|
.ifndef CONFIG_ROR_WORKAROUND
|
|
ror EXPSGN
|
|
.else
|
|
lda #$00
|
|
bcc L3BAC
|
|
lda #$80
|
|
L3BAC:
|
|
lsr EXPSGN
|
|
ora EXPSGN
|
|
sta EXPSGN
|
|
.endif
|
|
FIN4:
|
|
jsr CHRGET
|
|
FIN5:
|
|
bcc GETEXP
|
|
FIN6:
|
|
bit EXPSGN
|
|
bpl FIN7
|
|
lda #$00
|
|
sec
|
|
sbc EXPON
|
|
jmp FIN8
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; FOUND A DECIMAL POINT
|
|
; ----------------------------------------------------------------------------
|
|
FIN10:
|
|
.ifndef CONFIG_ROR_WORKAROUND
|
|
ror LOWTR
|
|
.else
|
|
lda #$00
|
|
bcc L3BC9
|
|
lda #$80
|
|
L3BC9:
|
|
lsr LOWTR
|
|
ora LOWTR
|
|
sta LOWTR
|
|
.endif
|
|
bit LOWTR
|
|
bvc FIN1
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; NUMBER TERMINATED, ADJUST EXPONENT NOW
|
|
; ----------------------------------------------------------------------------
|
|
FIN7:
|
|
lda EXPON
|
|
FIN8:
|
|
sec
|
|
sbc INDX
|
|
sta EXPON
|
|
beq L3BEE
|
|
bpl L3BE7
|
|
L3BDE:
|
|
jsr DIV10
|
|
inc EXPON
|
|
bne L3BDE
|
|
beq L3BEE
|
|
L3BE7:
|
|
jsr MUL10
|
|
dec EXPON
|
|
bne L3BE7
|
|
L3BEE:
|
|
lda SERLEN
|
|
bmi L3BF3
|
|
rts
|
|
L3BF3:
|
|
jmp NEGOP
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ACCUMULATE A DIGIT INTO FAC
|
|
; ----------------------------------------------------------------------------
|
|
FIN9:
|
|
pha
|
|
bit LOWTR
|
|
bpl L3BFD
|
|
inc INDX
|
|
L3BFD:
|
|
jsr MUL10
|
|
pla
|
|
sec
|
|
sbc #$30
|
|
jsr ADDACC
|
|
jmp FIN1
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ADD (A) TO FAC
|
|
; ----------------------------------------------------------------------------
|
|
ADDACC:
|
|
pha
|
|
jsr COPY_FAC_TO_ARG_ROUNDED
|
|
pla
|
|
jsr FLOAT
|
|
lda ARGSIGN
|
|
eor FACSIGN
|
|
sta SGNCPR
|
|
ldx FAC
|
|
jmp FADDT
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ACCUMULATE DIGIT OF EXPONENT
|
|
; ----------------------------------------------------------------------------
|
|
GETEXP:
|
|
lda EXPON
|
|
cmp #MAX_EXPON
|
|
bcc L3C2C
|
|
.ifdef CONFIG_10A
|
|
lda #$64
|
|
.endif
|
|
bit EXPSGN
|
|
.ifdef CONFIG_10A
|
|
bmi L3C3A
|
|
.else
|
|
bmi LDC70
|
|
.endif
|
|
jmp OVERFLOW
|
|
LDC70:
|
|
.ifndef CONFIG_10A
|
|
lda #$0B
|
|
.endif
|
|
L3C2C:
|
|
asl a
|
|
asl a
|
|
clc
|
|
adc EXPON
|
|
asl a
|
|
clc
|
|
ldy #$00
|
|
adc (TXTPTR),y
|
|
sec
|
|
sbc #$30
|
|
L3C3A:
|
|
sta EXPON
|
|
jmp FIN4
|
|
|
|
; ----------------------------------------------------------------------------
|
|
.ifdef CONFIG_SMALL
|
|
; these values are /1000 of what the labels say
|
|
CON_99999999_9:
|
|
.byte $91,$43,$4F,$F8
|
|
CON_999999999:
|
|
.byte $94,$74,$23,$F7
|
|
CON_BILLION:
|
|
.byte $94,$74,$24,$00
|
|
.else
|
|
CON_99999999_9:
|
|
.byte $9B,$3E,$BC,$1F,$FD
|
|
CON_999999999:
|
|
.ifndef CONFIG_10A
|
|
.byte $9E,$6E,$6B,$27,$FE
|
|
.else
|
|
.byte $9E,$6E,$6B,$27,$FD
|
|
.endif
|
|
CON_BILLION:
|
|
.byte $9E,$6E,$6B,$28,$00
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; PRINT "IN <LINE #>"
|
|
; ----------------------------------------------------------------------------
|
|
INPRT:
|
|
.ifdef KBD
|
|
jsr LFE0B
|
|
.byte " in"
|
|
.byte 0
|
|
.else
|
|
lda #<QT_IN
|
|
ldy #>QT_IN
|
|
jsr GOSTROUT2
|
|
.endif
|
|
lda CURLIN+1
|
|
ldx CURLIN
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; PRINT A,X AS DECIMAL INTEGER
|
|
; ----------------------------------------------------------------------------
|
|
LINPRT:
|
|
sta FAC+1
|
|
stx FAC+2
|
|
ldx #$90
|
|
sec
|
|
jsr FLOAT2
|
|
jsr FOUT
|
|
GOSTROUT2:
|
|
jmp STROUT
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; CONVERT (FAC) TO STRING STARTING AT STACK
|
|
; RETURN WITH (Y,A) POINTING AT STRING
|
|
; ----------------------------------------------------------------------------
|
|
FOUT:
|
|
ldy #$01
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "STR$" FUNCTION ENTERS HERE, WITH (Y)=0
|
|
; SO THAT RESULT STRING STARTS AT STACK-1
|
|
; (THIS IS USED AS A FLAG)
|
|
; ----------------------------------------------------------------------------
|
|
FOUT1:
|
|
lda #$20
|
|
bit FACSIGN
|
|
bpl L3C73
|
|
lda #$2D
|
|
L3C73:
|
|
sta STACK2-1,y
|
|
sta FACSIGN
|
|
sty STRNG2
|
|
iny
|
|
lda #$30
|
|
ldx FAC
|
|
bne L3C84
|
|
jmp FOUT4
|
|
L3C84:
|
|
lda #$00
|
|
cpx #$80
|
|
beq L3C8C
|
|
bcs L3C95
|
|
L3C8C:
|
|
lda #<CON_BILLION
|
|
ldy #>CON_BILLION
|
|
jsr FMULT
|
|
.ifdef CONFIG_SMALL
|
|
lda #-6 ; exponent adjustment
|
|
.else
|
|
lda #-9
|
|
.endif
|
|
L3C95:
|
|
sta INDX
|
|
; ----------------------------------------------------------------------------
|
|
; ADJUST UNTIL 1E8 <= (FAC) <1E9
|
|
; ----------------------------------------------------------------------------
|
|
L3C97:
|
|
lda #<CON_999999999
|
|
ldy #>CON_999999999
|
|
jsr FCOMP
|
|
beq L3CBE
|
|
bpl L3CB4
|
|
L3CA2:
|
|
lda #<CON_99999999_9
|
|
ldy #>CON_99999999_9
|
|
jsr FCOMP
|
|
beq L3CAD
|
|
bpl L3CBB
|
|
L3CAD:
|
|
jsr MUL10
|
|
dec INDX
|
|
bne L3CA2
|
|
L3CB4:
|
|
jsr DIV10
|
|
inc INDX
|
|
bne L3C97
|
|
L3CBB:
|
|
jsr FADDH
|
|
L3CBE:
|
|
jsr QINT
|
|
; ----------------------------------------------------------------------------
|
|
; FAC+1...FAC+4 IS NOW IN INTEGER FORM
|
|
; WITH POWER OF TEN ADJUSTMENT IN TMPEXP
|
|
;
|
|
; IF -10 < TMPEXP > 1, PRINT IN DECIMAL FORM
|
|
; OTHERWISE, PRINT IN EXPONENTIAL FORM
|
|
; ----------------------------------------------------------------------------
|
|
ldx #$01
|
|
lda INDX
|
|
clc
|
|
adc #3*BYTES_FP-5
|
|
bmi L3CD3
|
|
cmp #3*BYTES_FP-4
|
|
bcs L3CD4
|
|
adc #$FF
|
|
tax
|
|
lda #$02
|
|
L3CD3:
|
|
sec
|
|
L3CD4:
|
|
sbc #$02
|
|
sta EXPON
|
|
stx INDX
|
|
txa
|
|
beq L3CDF
|
|
bpl L3CF2
|
|
L3CDF:
|
|
ldy STRNG2
|
|
lda #$2E
|
|
iny
|
|
sta STACK2-1,y
|
|
txa
|
|
beq L3CF0
|
|
lda #$30
|
|
iny
|
|
sta STACK2-1,y
|
|
L3CF0:
|
|
sty STRNG2
|
|
; ----------------------------------------------------------------------------
|
|
; NOW DIVIDE BY POWERS OF TEN TO GET SUCCESSIVE DIGITS
|
|
; ----------------------------------------------------------------------------
|
|
L3CF2:
|
|
ldy #$00
|
|
LDD3A:
|
|
ldx #$80
|
|
L3CF6:
|
|
lda FAC_LAST
|
|
clc
|
|
.ifndef CONFIG_SMALL
|
|
adc DECTBL+3,y
|
|
sta FAC+4
|
|
lda FAC+3
|
|
.endif
|
|
adc DECTBL+2,y
|
|
sta FAC+3
|
|
lda FAC+2
|
|
adc DECTBL+1,y
|
|
sta FAC+2
|
|
lda FAC+1
|
|
adc DECTBL,y
|
|
sta FAC+1
|
|
inx
|
|
bcs L3D1A
|
|
bpl L3CF6
|
|
bmi L3D1C
|
|
L3D1A:
|
|
bmi L3CF6
|
|
L3D1C:
|
|
txa
|
|
bcc L3D23
|
|
eor #$FF
|
|
adc #$0A
|
|
L3D23:
|
|
adc #$2F
|
|
iny
|
|
iny
|
|
iny
|
|
.ifndef CONFIG_SMALL
|
|
iny
|
|
.endif
|
|
sty VARPNT
|
|
ldy STRNG2
|
|
iny
|
|
tax
|
|
and #$7F
|
|
sta STACK2-1,y
|
|
dec INDX
|
|
bne L3D3E
|
|
lda #$2E
|
|
iny
|
|
sta STACK2-1,y
|
|
L3D3E:
|
|
sty STRNG2
|
|
ldy VARPNT
|
|
txa
|
|
eor #$FF
|
|
and #$80
|
|
tax
|
|
cpy #DECTBL_END-DECTBL
|
|
.ifdef CONFIG_CBM_ALL
|
|
beq LDD96
|
|
cpy #$3C ; XXX
|
|
.endif
|
|
bne L3CF6
|
|
; ----------------------------------------------------------------------------
|
|
; NINE DIGITS HAVE BEEN STORED IN STRING. NOW LOOK
|
|
; BACK AND LOP OFF TRAILING ZEROES AND A TRAILING
|
|
; DECIMAL POINT.
|
|
; ----------------------------------------------------------------------------
|
|
LDD96:
|
|
ldy STRNG2
|
|
L3D4E:
|
|
lda STACK2-1,y
|
|
dey
|
|
cmp #$30
|
|
beq L3D4E
|
|
cmp #$2E
|
|
beq L3D5B
|
|
iny
|
|
L3D5B:
|
|
lda #$2B
|
|
ldx EXPON
|
|
beq L3D8F
|
|
bpl L3D6B
|
|
lda #$00
|
|
sec
|
|
sbc EXPON
|
|
tax
|
|
lda #$2D
|
|
L3D6B:
|
|
sta STACK2+1,y
|
|
lda #$45
|
|
sta STACK2,y
|
|
txa
|
|
ldx #$2F
|
|
sec
|
|
L3D77:
|
|
inx
|
|
sbc #$0A
|
|
bcs L3D77
|
|
adc #$3A
|
|
sta STACK2+3,y
|
|
txa
|
|
sta STACK2+2,y
|
|
lda #$00
|
|
sta STACK2+4,y
|
|
beq L3D94
|
|
FOUT4:
|
|
sta STACK2-1,y
|
|
L3D8F:
|
|
lda #$00
|
|
sta STACK2,y
|
|
L3D94:
|
|
lda #<STACK2
|
|
ldy #>STACK2
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
CON_HALF:
|
|
.ifdef CONFIG_SMALL
|
|
.byte $80,$00,$00,$00
|
|
.else
|
|
.byte $80,$00,$00,$00,$00
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; POWERS OF 10 FROM 1E8 DOWN TO 1,
|
|
; AS 32-BIT INTEGERS, WITH ALTERNATING SIGNS
|
|
; ----------------------------------------------------------------------------
|
|
DECTBL:
|
|
.ifdef CONFIG_SMALL
|
|
.byte $FE,$79,$60 ; -100000
|
|
.byte $00,$27,$10 ; 10000
|
|
.byte $FF,$FC,$18 ; -1000
|
|
.byte $00,$00,$64 ; 100
|
|
.byte $FF,$FF,$F6 ; -10
|
|
.byte $00,$00,$01 ; 1
|
|
.else
|
|
.byte $FA,$0A,$1F,$00 ; -100000000
|
|
.byte $00,$98,$96,$80 ; 10000000
|
|
.byte $FF,$F0,$BD,$C0 ; -1000000
|
|
.byte $00,$01,$86,$A0 ; 100000
|
|
.byte $FF,$FF,$D8,$F0 ; -10000
|
|
.byte $00,$00,$03,$E8 ; 1000
|
|
.byte $FF,$FF,$FF,$9C ; -100
|
|
.byte $00,$00,$00,$0A ; 10
|
|
.byte $FF,$FF,$FF,$FF ; -1
|
|
.endif
|
|
DECTBL_END:
|
|
.ifdef CONFIG_CBM_ALL
|
|
.byte $FF,$DF,$0A,$80 ; TI$
|
|
.byte $00,$03,$4B,$C0
|
|
.byte $FF,$FF,$73,$60
|
|
.byte $00,$00,$0E,$10
|
|
.byte $FF,$FF,$FD,$A8
|
|
.byte $00,$00,$00,$3C
|
|
.endif
|
|
.ifdef CONFIG_2
|
|
C_ZERO = CON_HALF + 2
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "SQR" FUNCTION
|
|
; ----------------------------------------------------------------------------
|
|
SQR:
|
|
jsr COPY_FAC_TO_ARG_ROUNDED
|
|
lda #<CON_HALF
|
|
ldy #>CON_HALF
|
|
jsr LOAD_FAC_FROM_YA
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; EXPONENTIATION OPERATION
|
|
;
|
|
; ARG ^ FAC = EXP( LOG(ARG) * FAC )
|
|
; ----------------------------------------------------------------------------
|
|
FPWRT:
|
|
beq EXP
|
|
lda ARG
|
|
bne L3DD5
|
|
jmp STA_IN_FAC_SIGN_AND_EXP
|
|
L3DD5:
|
|
ldx #TEMP3
|
|
ldy #$00
|
|
jsr STORE_FAC_AT_YX_ROUNDED
|
|
lda ARGSIGN
|
|
bpl L3DEF
|
|
jsr INT
|
|
lda #TEMP3
|
|
ldy #$00
|
|
jsr FCOMP
|
|
bne L3DEF
|
|
tya
|
|
ldy CHARAC
|
|
L3DEF:
|
|
jsr MFA
|
|
tya
|
|
pha
|
|
jsr LOG
|
|
lda #TEMP3
|
|
ldy #$00
|
|
jsr FMULT
|
|
jsr EXP
|
|
pla
|
|
lsr a
|
|
bcc L3E0F
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; NEGATE VALUE IN FAC
|
|
; ----------------------------------------------------------------------------
|
|
NEGOP:
|
|
lda FAC
|
|
beq L3E0F
|
|
lda FACSIGN
|
|
eor #$FF
|
|
sta FACSIGN
|
|
L3E0F:
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
.ifdef CONFIG_SMALL
|
|
CON_LOG_E:
|
|
.byte $81,$38,$AA,$3B
|
|
POLY_EXP:
|
|
.byte $06
|
|
.byte $74,$63,$90,$8C
|
|
.byte $77,$23,$0C,$AB
|
|
.byte $7A,$1E,$94,$00
|
|
.byte $7C,$63,$42,$80
|
|
.byte $7E,$75,$FE,$D0
|
|
.byte $80,$31,$72,$15
|
|
.byte $81,$00,$00,$00
|
|
.else
|
|
CON_LOG_E:
|
|
.byte $81,$38,$AA,$3B,$29
|
|
POLY_EXP:
|
|
.byte $07
|
|
.byte $71,$34,$58,$3E,$56
|
|
.byte $74,$16,$7E,$B3,$1B
|
|
.byte $77,$2F,$EE,$E3,$85
|
|
.byte $7A,$1D,$84,$1C,$2A
|
|
.byte $7C,$63,$59,$58,$0A
|
|
.byte $7E,$75,$FD,$E7,$C6
|
|
.byte $80,$31,$72,$18,$10
|
|
.byte $81,$00,$00,$00,$00
|
|
.endif
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; "EXP" FUNCTION
|
|
;
|
|
; FAC = E ^ FAC
|
|
; ----------------------------------------------------------------------------
|
|
EXP:
|
|
lda #<CON_LOG_E
|
|
ldy #>CON_LOG_E
|
|
jsr FMULT
|
|
lda FACEXTENSION
|
|
adc #$50
|
|
bcc L3E4E
|
|
jsr INCREMENT_MANTISSA
|
|
L3E4E:
|
|
sta ARGEXTENSION
|
|
jsr MAF
|
|
lda FAC
|
|
cmp #$88
|
|
bcc L3E5C
|
|
L3E59:
|
|
jsr OUTOFRNG
|
|
L3E5C:
|
|
jsr INT
|
|
lda CHARAC
|
|
clc
|
|
adc #$81
|
|
beq L3E59
|
|
sec
|
|
sbc #$01
|
|
pha
|
|
ldx #BYTES_FP
|
|
L3E6C:
|
|
lda ARG,x
|
|
ldy FAC,x
|
|
sta FAC,x
|
|
sty ARG,x
|
|
dex
|
|
bpl L3E6C
|
|
lda ARGEXTENSION
|
|
sta FACEXTENSION
|
|
jsr FSUBT
|
|
jsr NEGOP
|
|
lda #<POLY_EXP
|
|
ldy #>POLY_EXP
|
|
jsr POLYNOMIAL
|
|
lda #$00
|
|
sta SGNCPR
|
|
pla
|
|
jsr ADD_EXPONENTS1
|
|
rts
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; ODD POLYNOMIAL SUBROUTINE
|
|
;
|
|
; F(X) = X * P(X^2)
|
|
;
|
|
; WHERE: X IS VALUE IN FAC
|
|
; Y,A POINTS AT COEFFICIENT TABLE
|
|
; FIRST BYTE OF COEFF. TABLE IS N
|
|
; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
|
|
;
|
|
; P(X^2) COMPUTED USING NORMAL POLYNOMIAL SUBROUTINE
|
|
; ----------------------------------------------------------------------------
|
|
POLYNOMIAL_ODD:
|
|
sta STRNG2
|
|
sty STRNG2+1
|
|
jsr STORE_FAC_IN_TEMP1_ROUNDED
|
|
lda #TEMP1X
|
|
jsr FMULT
|
|
jsr SERMAIN
|
|
lda #TEMP1X
|
|
ldy #$00
|
|
jmp FMULT
|
|
|
|
; ----------------------------------------------------------------------------
|
|
; NORMAL POLYNOMIAL SUBROUTINE
|
|
;
|
|
; P(X) = C(0)*X^N + C(1)*X^(N-1) + ... + C(N)
|
|
;
|
|
; WHERE: X IS VALUE IN FAC
|
|
; Y,A POINTS AT COEFFICIENT TABLE
|
|
; FIRST BYTE OF COEFF. TABLE IS N
|
|
; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
|
|
; ----------------------------------------------------------------------------
|
|
POLYNOMIAL:
|
|
sta STRNG2
|
|
sty STRNG2+1
|
|
SERMAIN:
|
|
jsr STORE_FAC_IN_TEMP2_ROUNDED
|
|
lda (STRNG2),y
|
|
sta SERLEN
|
|
ldy STRNG2
|
|
iny
|
|
tya
|
|
bne L3EBA
|
|
inc STRNG2+1
|
|
L3EBA:
|
|
sta STRNG2
|
|
ldy STRNG2+1
|
|
L3EBE:
|
|
jsr FMULT
|
|
lda STRNG2
|
|
ldy STRNG2+1
|
|
clc
|
|
adc #BYTES_FP
|
|
bcc L3ECB
|
|
iny
|
|
L3ECB:
|
|
sta STRNG2
|
|
sty STRNG2+1
|
|
jsr FADD
|
|
lda #TEMP2
|
|
ldy #$00
|
|
dec SERLEN
|
|
bne L3EBE
|
|
RTS19:
|
|
rts
|