math4

.PAG 'MATH4  1/4/84'
;   QUICK GREATEST INTEGER FUNCTION.
;   LEAVES INT(FAC) IN FACHO,MO,LO SIGNED.
;   ASSUMES FAC < 2**23 = 8388608.
QINT	LDA FACEXP
	BEQ CLRFAC
	SEC
	SBC #ADDPR8+$98
	BIT FACSGN
	BPL QISHFT
	TAX
	LDA #$FF
	STA BITS
	JSR NEGFCH
	TXA
QISHFT	LDX #FAC
	CMP #$F9
	BPL QINT1
	JSR SHIFTR
	STY BITS
QINTRT	RTS
QINT1	TAY
	LDA FACSGN
	AND #$80
	LSR FACHO
	ORA FACHO
	STA FACHO
	JSR ROLSHF
	STY BITS
	RTS
;
INT	LDA FACEXP
	CMP #ADDPR8+$98
	BCS INTRTS
	JSR QINT
	STY FACOV
	LDA FACSGN
	STY FACSGN
	EOR #$80
	ROL A
	LDA #$98+8
	STA FACEXP
	LDA FACLO
	STA INTEGR
	JMP FADFLT
CLRFAC	STA FACHO
	STA FACMOH
	STA FACMO
	STA FACLO
	TAY 
INTRTS	RTS
.PAG
;   NUMBER INPUT IS LEFT IN FAC.
;   AT ENTRY TXTPTR -> TO THE 1ST CHAR IN A TEXT BUF.
;   THE 1ST CHAR IS ALSO IN ACC.  FIN PACKS THE DIGITS
;  INTO THE FAC AS AN INTEGER AND KEEPS TRACK OF WHERE
;   THE DECIMAL POINT IS.  DPTFLG TELLS WHETHER A DP HAS
;   BEEN SEEN.  DCCNT IS THE NUMBER OF DIGITS AFTER THE
;   DP.  AT THE END DCCNT AND THE EXP ARE USED TO
;   DETERMINE HOW MANY TIMES TO MULT OR DIV BY 10 TO
;   GET THE CORRECT #.
FIN	LDY #$00
	LDX #SGNFLG-DECCNT
FINZLP	STY DECCNT,X
	DEX
	BPL FINZLP
	BCC FINDGQ
	CMP #'-
	BNE QPLUS
	STX SGNFLG
	BEQ FINC
QPLUS	CMP #'+
	BNE FIN1
FINC	JSR CHRGET
FINDGQ	BCC FINDIG
FIN1	CMP #'.
	BEQ FINDP
	CMP #'E
	BNE FINE
	JSR CHRGET
	BCC FNEDG1
	CMP #TKMINU
	BEQ FINEC1
	CMP #'-
	BEQ FINEC1
	CMP #TKPLUS
	BEQ FINEC
	CMP #'+
	BEQ FINEC
	BNE FINEC2
FINEC1	ROR EXPSGN
FINEC	JSR CHRGET
FNEDG1	BCC FINEDG
FINEC2	BIT EXPSGN
	BPL FINE
	LDA #0
	SEC
	SBC TENEXP
	JMP FINE1
FINDP	ROR DPTFLG
	BIT DPTFLG
	BVC FINC
FINE	LDA TENEXP
FINE1	SEC
	SBC DECCNT
	STA TENEXP
	BEQ FINQNG
	BPL FINMUL
FINDIV	JSR DIV10
	INC TENEXP
	BNE FINDIV
	BEQ FINQNG
FINMUL	JSR MUL10
	DEC TENEXP
	BNE FINMUL
FINQNG	LDA SGNFLG
	BMI NEGXQS
	RTS
NEGXQS	JMP NEGOP
FINDIG	PHA
	BIT DPTFLG
	BPL FINDG1
	INC DECCNT
FINDG1	JSR MUL10
	PLA
	SEC
	SBC #'0
	JSR FINLOG
	JMP FINC
FINLOG	PHA
	JSR MOVAF
	PLA
	JSR FLOAT
	LDA ARGSGN
	EOR FACSGN
	STA ARISGN
	LDX FACEXP
	JMP FADDT
;
FINEDG	LDA TENEXP
	CMP #$0A
	BCC MLEX10
	LDA #$64
	BIT EXPSGN
	BMI MLEXMI
	JMP OVERR
MLEX10	ASL A
	ASL A
	CLC
	ADC TENEXP
	ASL A
	CLC
	LDY #0
	STA TTTEMP
	LDA TXTPTR+2 
	STA I6509
	LDA (TXTPTR)Y
	JSR MAPTXT 
	ADC TTTEMP
	SEC
	SBC #'0
MLEXMI	STA TENEXP
	JMP FINEC
.PAG
N0999	.BYT $9B,$3E,$BC,$1F,$FD ;99,999,999.0499
N9999	.BYT $9E,$6E,$6B,$27,$FD ;999,999,999.499
NMIL	.BYT $9E,$6E,$6B,$28,0   ;10**9
.SKI 4
;   ENTRY   A= < OF NUMBER
;   X= >OF NUMBER
LINPRT	STA FACHO
	STX FACHO+1
	LDX #$90        ;EXPONENT IS 2**16
	SEC
	JSR FLOATC
OUTFAC	JSR FOUT
	LDX #FBPTR
;
;PRINT A MESSAGE
;CAN ALSO PRINT THE CONTENTS OF FBUFFR
;
;ENTRY:  .X =INDEX INTO EBASE, A TABLE OF START
;            ADDRESSES OF MESSAGES
;        DATA =SEQUENTIAL ASCII CHARACTERS
;            TERMINATED BY A ZERO BYTE
;CALLS:  LDAABS
;        OCHR
;
MSG	LDA EBASE,X
	LDY EBASE+1,X
	STA LDAADR
	STY LDAADR+1
;
MSGPRT	JSR LDAABS
	BEQ MSGRTS      ;ZERO BYTE TERMINATOR
	JSR OCHR
	INC LDAADR
	BNE MSGPRT
	INC LDAADR+1
	BNE MSGPRT
MSGRTS	RTS
.PAG
;
;   BUILD STRING FOR FORMULA RESULT.
;
FOUT	LDY #1
	LDA #$20        ;PRINT SPACE IF POSITIVE
	BIT FACSGN
	BPL FOUT1
	LDA #'-
FOUT1	STA FBUFFR-1,Y  ;STORE THE CHAR
	STA FACSGN      ;MAKE FAC POSITIVE OR QINT.
	STY FBUFPT      ;SAVE FOR LATER
	INY
	LDA #'0         ;GET ZERO TO TYPE IF FAC=0
	LDX FACEXP
	BNE *+5
	JMP FOUT19
	LDA #0
	CPX #$80
	BEQ FOUT37      ;IF NUMBER > 1.0
	BCS FOUT7
FOUT37	LDA #<NMIL
	LDY #>NMIL
	JSR FMULT       ;* 10**6
	LDA #250-ADDPR2-ADDPRC
FOUT7	STA DECCNT      ;SAVE COUNT OR ZERO IT
FOUT4	LDA #<N9999
	LDY #>N9999
	JSR FCOMP       ;IF NUM > 999,999.999
	BEQ BIGGES
	BPL FOUT9
FOUT3	LDA #<N0999
	LDY #>N0999
	JSR FCOMP
	BEQ FOUT38
	BPL FOUT5
FOUT38	JSR MUL10
	DEC DECCNT
	BNE FOUT3
FOUT9	JSR DIV10
	INC DECCNT
	BNE FOUT4
FOUT5	JSR FADDH
BIGGES	JSR QINT
	LDX #1
	LDA DECCNT
	CLC
	ADC #ADDPR2+ADDPRC+7
	BMI FOUTPI
	CMP #ADDPR2+ADDPRC+$08
	BCS FOUT6
	ADC #$FF
	TAX
	LDA #2
FOUTPI	SEC
FOUT6	SBC #2
	STA TENEXP
	STX DECCNT
	TXA
	BEQ FOUT39
	BPL FOUT8
FOUT39	LDY FBUFPT
	LDA #'.
	INY
	STA FBUFFR-1,Y
	TXA
	BEQ FOUT16
	LDA #'0
	INY
	STA FBUFFR-1,Y
FOUT16	STY FBUFPT
FOUT8	LDY #0
	LDX #$80
FOUT2	LDA FACLO
	CLC
	ADC FOUTBL+2+ADDPRC,Y
	STA FACLO
	LDA FACMO
	ADC FOUTBL+1+ADDPRC,Y
	STA FACMO
	LDA FACMOH
	ADC FOUTBL+1,Y
	STA FACMOH
	LDA FACHO
	ADC FOUTBL,Y
	STA FACHO
	INX
	BCS FOUT41
	BPL FOUT2
	.BYTE $2C       ;HOP
FOUT41	BMI FOUT2
FOUT40	TXA
	BCC FOUTYP
	EOR #$FF
	ADC #$0A
FOUTYP	ADC #$2F
	INY
	INY
	INY
	INY
	STY FDECPT
	LDY FBUFPT
	INY
	TAX
	AND #$7F
	STA FBUFFR-1,Y
	DEC DECCNT
	BNE STXBUF
	LDA #'.
	INY
	STA FBUFFR-1,Y
STXBUF	STY FBUFPT
	LDY FDECPT
	TXA
	EOR #$FF
	AND #$80
	TAX
	CPY #FDCEND-FOUTBL
	BNE FOUT2
FOULDY	LDY FBUFPT
FOUT11	LDA FBUFFR-1,Y
	DEY
	CMP #'0'
	BEQ FOUT11
	CMP #'.
	BEQ FOUT12
	INY
FOUT12	LDA #'+
	LDX TENEXP
	BEQ FOUT17
	BPL FOUT14
	LDA #0
	SEC
	SBC TENEXP
	TAX
	LDA #'-
FOUT14	STA FBUFFR+1,Y
	LDA #'E
	STA FBUFFR,Y
	TXA
	LDX #$2F
	SEC
FOUT15	INX
	SBC #$0A
	BCS FOUT15
	ADC #$3A
	STA FBUFFR+3,Y
	TXA
	STA FBUFFR+2,Y
	LDA #0
	STA FBUFFR+4,Y
	BEQ FOUT20
FOUT19	STA FBUFFR-1,Y
FOUT17	LDA #0
	STA FBUFFR,Y
FOUT20	RTS
.SKI 4
N32768	.BYT $90         ;MUST STAY WITH FHALF AND ZERO
FHALF	.BYT $80,0
ZERO	.BYT 0,0,0
;
;   POWER OF TEN TABLE
FOUTBL
	.BYT $FA,$0A,$1F,$00     ;-100,000,000
	.BYT $00,$98,$96,$80     ;10,000,000
	.BYT $FF,$F0,$BD,$C0     ;-1,000,000
	.BYT $00,$01,$86,$A0     ;100,000
	.BYT $FF,$FF,$D8,$F0     ;-10,000
	.BYT $00,$00,$03,$E8     ;1000
	.BYT $FF,$FF,$FF,$9C     ;-100
	.BYT $00,$00,$00,$0A     ;10
	.BYT $FF,$FF,$FF,$FF     ;-1
;
FDCEND
; .BYT $FF,$DF,$0A,$80     ;-216,000 FOR TIME CONVERTER
; .BYT $00,$03,$4B,$C0     ;216,000
; .BYT $FF,$FF,$73,$60     ;-36000
; .BYT $00,$00,$0E,$10     ;3600
; .BYT $FF,$FF,$FD,$A8     ;-600
; .BYT $00,$00,$00,$3C     ;60
;TIMEND
.PAG
SQR	;SQUARE ROOT FUNCTION  SQR(A)
;   USES SQR(A) == A**0.5
	JSR MOVAF
	LDA #<FHALF
	LDY #>FHALF
	JSR MOVFM
;   JMP FPWRT   ;LAST THING FETCHED IS FACEXP INTO ACCX
;
;   EXPONENTATION X**Y
;   IF Y = 0 THEN RESULTS = 1.
;   IF X = 0 THEN RESULTS = 0.
;   IF X > 0, IF NOT CHECK THAT Y IS AN INTEGER.
;   IF SO, NEGATE X, SO THAT LOG DOESN'T GIVE FCERR.
;   IF X IS NEGATIVE AND Y IS ODD, NEGATE THE RESULT.
;   RETURNED BY EXP.
;   TO COMPUTE THE USE X**Y=EXP((Y*LOG(X)).
;
FPWRT	BEQ EXP         ;IF FAC=0, JUST EXPONENTIAAATE THAT
	LDA ARGEXP
	BNE FPWRT1      ;IF X <> 0
	JMP ZEROF1
;
FPWRT1	LDX #<TEMPF3
	LDY #>TEMPF3
	JSR MOVMF
;
;   Y=0 ALREADY.  GOOD IN CASE NO ONE CALLS INT.
	LDA ARGSGN
	BPL FPWR1       ;NO PROBLEMS IF X > 0
	JSR INT         ;INTEGERIZE THE FAC
	LDA #<TEMPF3    ;GET COMPERAND ADR
	LDY #>TEMPF3
	JSR FCOMP
	BNE FPWR1
	TYA
	LDY INTEGR
FPWR1	JSR MOVFA1
	TYA
	PHA
	JSR LOG
	LDA #<TEMPF3
	LDY #>TEMPF3
	JSR FMULT
	JSR EXP
	PLA
	LSR A
	BCC NEGRTS
NEGOP	LDA FACEXP
	BEQ NEGRTS
SAV41	LDA FACSGN
	EOR #$FF
	STA FACSGN
NEGRTS	RTS
.PAG
LOGEB2	.BYT $81,$38,$AA,$3B,$29 ;LOG(E) BASE 2
EXPCON	.BYT 7,$71,$34,$58,$3E
	.BYT $56,$74,$16,$7E
	.BYT $B3,$1B,$77,$2F
	.BYT $EE,$E3,$85,$7A
	.BYT $1D,$84,$1C,$2A
	.BYT $7C,$63,$59,$58
	.BYT $0A,$7E,$75,$FD
	.BYT $E7,$C6,$80,$31
	.BYT $72,$18,$10,$81
	.BYT 0,0,0,0
.SKI 4
;   MULTIPLY BY LOG(E) BASE 2.
EXP	LDA #<LOGEB2
	LDY #>LOGEB2
	JSR FMULT
	LDA FACOV
	ADC #$50
	BCC STOLD
	JSR INCRND
.SKI 4
STOLD	STA OLDOV
	JSR MOVEF
	LDA FACEXP
	CMP #$88
	BCC EXP1
GOMLDV	JSR MLDVEX
EXP1	JSR INT
	LDA INTEGR
	CLC
	ADC #$81
	BEQ GOMLDV
	SEC
	SBC #1
	PHA
	LDX #4+ADDPRC
SWAPLP	LDA ARGEXP,X
	LDY FACEXP,X
	STA FACEXP,X
	STY ARGEXP,X
	DEX
	BPL SWAPLP
	LDA OLDOV
	STA FACOV
	JSR FSUBT
	JSR NEGOP
	LDA #<EXPCON
	LDY #>EXPCON
	JSR POLY
	LDA #0
	STA ARISGN
	PLA
      JMP PCH402 ;PATCH REV4: FIXES .11**40 ************
      .PAG
;   EVALUATE P(X**Y)*X
;   POINTER TO DEGREE IS IN Y,A
;   THE CONSTANTS FOLLOW THE DEGREE
;   FOR X=FAC, COMPUTE
;    C0*X+C1*X**3+C2*X**5+C3*X**7... CN*X**(2*N-1)
POLYX	STA POLYPT
	STY POLYPT+1
	JSR MOV1F
	LDA #TEMPF1
	JSR FMULT
	JSR POLY1
	LDA #<TEMPF1
	LDY #>TEMPF1
	JMP FMULT
;
;
;   POLYNOMIAL EVALUATOR
;   POINTER TO DEGREE IS IN Y,A
POLY	STA POLYPT
	STY POLYPT+1
POLY1	JSR MOV2F
	LDA #0
	ORA (POLYPT)Y   ; READ SYSTEM MEM
	STA DEGREE
	LDY POLYPT
	INY
	TYA
	BNE POLY3
	INC POLYPT+1
POLY3	STA POLYPT
	LDY POLYPT+1
POLY2	JSR FMULT
	LDA POLYPT
	LDY POLYPT+1
	CLC
	ADC #4+ADDPRC
	BCC POLY4
	INY
POLY4	STA POLYPT
	STY POLYPT+1
	JSR FADD
	LDA #<TEMPF2
	LDY #>TEMPF2
	DEC DEGREE
	BNE POLY2
	RTS
RMULC	.BYT $98,$35,$44,$7A
RADDC	.BYT $68,$28,$B1,$46
.SKI 4
;   PSEUDO-RANDOM NUMBER GENERATOR.
RND
	JSR SIGN
	BMI RND1
	LDX SEEDPT
	LDY SEEDPT+1
	INX
	BNE RND10
	INY
RND10
	TXA
	LDX #STRBNK     ;ALWAYS IN STR BANK
	JSR MOVFUM
	LDA #<RMULC
	LDY #>RMULC
	JSR FMULT
	LDA #<RADDC
	LDY #>RADDC
	JSR FADD
RND1	LDX FACLO
	LDA FACHO
	STA FACLO
	STX FACHO
	LDX FACMOH
	LDA FACMO
	STA FACMOH
	STX FACMO
STRNEX	LDA #0
	STA FACSGN
	LDA FACEXP
	STA FACOV
	LDA #$80
	STA FACEXP
	JSR NORMAL
	LDX SEEDPT
	LDY SEEDPT+1
	LDA #STRBNK 
	INX
	BNE RND20       ;IF NO CARRY
	INY
RND20	JMP MOVUMF
.PAG
COS	LDA #<PI2
	LDY #>PI2
	JSR FADD
.SKI 4
;   SIN FUNCTION
SIN	JSR MOVAF
	LDA #<TWOPI
	LDY #>TWOPI
	LDX ARGSGN
	JSR FDIVF
	JSR MOVAF
	JSR INT
	LDA #0
	STA ARISGN
	JSR FSUBT
	LDA #<FR4
	LDY #>FR4
	JSR FSUB
	LDA FACSGN
	PHA
	BPL SIN1
	JSR FADDH
	LDA FACSGN
	BMI SIN2
	LDA TANSGN
	EOR #$FF
	STA TANSGN
SIN1	JSR NEGOP
SIN2	LDA #<FR4
	LDY #>FR4
	JSR FADD
	PLA
	BPL SIN3
	JSR NEGOP
SIN3	LDA #<SINCON
	LDY #>SINCON
	JMP POLYX
.SKI 4
;   TANGENT FUNCTION
TAN	JSR MOV1F
	LDA #0
	STA TANSGN
	JSR SIN
	LDX #<TEMPF3
	LDY #>TEMPF3
	JSR MOVMF
	LDA #<TEMPF1
	LDY #>TEMPF1
	JSR MOVFM
	LDA #0
	STA FACSGN
	LDA TANSGN
	JSR COSC
	LDA #<TEMPF3
	LDY #>TEMPF3
	JMP FDIV
;
COSC
	PHA
	JMP SIN1
;
PI2	.BYT $81,$49,$0F,$DA,$A2
TWOPI	.BYT $83,$49,$0F,$DA,$A2
FR4	.BYT $7F,0,0,0,0
SINCON	.BYT 5,$84,$E6,$1A,$2D
	.BYT $1B,$86,$28,$07,$F6
	.BYT $F8,$87,$99,$68,$89
	.BYT 1,$87,$23,$35,$DF,$E1
	.BYT $86,$A5,$5D,$E7,$28,$83
	.BYT $49,$0F,$DA,$A2
.PAG
ATNCON	.BYT $0B,$76,$B3,$83
	.BYT $BD,$D3,$79,$1E,$F4
	.BYT $A6,$F5,$7B,$83,$FC
	.BYT $B0,$10
	.BYT $7C,$0C,$1F,$67,$CA
	.BYT $7C,$DE,$53,$CB,$C1
	.BYT $7D,$14,$64,$70,$4C
	.BYT $7D,$B7,$EA,$51,$7A
	.BYT $7D,$63,$30,$88,$7E
	.BYT $7E,$92,$44,$99,$3A
	.BYT $7E,$4C,$CC,$91,$C7
	.BYT $7F,$AA,$AA,$AA,$13
	.BYT $81,0,0,0,0
ATN	LDA FACSGN
	PHA
	BPL ATN1
	JSR NEGOP
ATN1	LDA FACEXP
	PHA
	CMP #$81
	BCC ATN2
	LDA #<FONE
	LDY #>FONE
	JSR FDIV
ATN2	LDA #<ATNCON
	LDY #>ATNCON
	JSR POLYX
	PLA
	CMP #$81
	BCC ATN3
	LDA #<PI2
	LDY #>PI2
	JSR FSUB
ATN3	PLA
	BPL ATN4
	JMP NEGOP
.END