/EXTENDED FUNCTION PACKAGE FOR FOCAL 5/69
/E.A.TAFT, 6/10/69
/
/FSIN:	SIN(X)		X IN RADIANS
/FCOS:	COS(X)		X IN RADIANS
/FATN:	ARC TAN(X)	RESULT IN RADIANS
/FEXP:	EXP(X)
/FLOG:	LN(X)
/////
/DEFINITIONS
FIXMRI FAD=1000
FIXMRI FSB=2000
FIXMRI FMY=3000
FIXMRI FDV=4000
FIXMRI FGT=5000
FIXMRI FPT=6000
FNR=7000
FENT=4407
FEXT=0
	FIXTAB
/////
NEGATE=	4450
GETSGN=	1045
RETURN=	5500
SN=	10
FIX=	4452
PUSHA=	4503
POPA=	1413
FLAC=	44
FLTEMP=	7545
FLTONE=	1573
PDLXR=	13
ERROR=	4526
FLOAT=	4430
FNTABF=	571
BOTTOM=	27
COMGO=	1164
SORTJ=	4510
M5=	67
CNTR=	132
AXIN=	10
TSTERM=	4565
PROC=	616
ERROR5=	2735
DBCONV=	5600
*BOTTOM
	FCOS-1		/TOP OF TEXT
*FNTABF+7
	FATN		/POINTERS TO EXTENDED FUNCTIONS
	FEXP
	FLOG
	FSIN
	FCOS
/////
/ENABLE A "LIBRARY DELETE" COMMAND
/WHICH WILL DELETE THE EXTENDED FUNCTIONS AND
/FREE MORE FOR USER AREA.
*COMGO+10
	LIBRARY
*6555
LIBLST,	"D
/////
LIBRARY,SORTJ		/"LIBRARY" - EXPANDABLE COMMAND
		LIBLST-1
		LIBGO-LIBLST
	ERROR		/ILLEGAL LIBRARY COMMAND
/////
LIBD,	TAD M5		/DELETE THE EXTENDED FUNCTIONS
	DCA CNTR
	TAD EXTAB
	DCA AXIN
	TAD PERROR
	DCA I AXIN	/SET ERROR5 POINTERS
	ISZ CNTR
	JMP .-3
	TAD DTOP
	DCA BOTTOM	/MOVE TOP POINTER UP
	JMP 6461	/OPTRET (TO REACH END OF COMMAND)
/////
EXTAB,	FNTABF+6
DTOP,	DBCONV-1
LIBGO,	LIBD
*175
PERROR,	ERROR5
/FOCAL EXTENDED FUNCTIONS
*5113
/	COSINE
FCOS,	NEGATE		/COS(X)=SIN(PI/2-X)
	FENT
	FAD I PI2
	FEXT
/////
/	SINE
FSIN,	GETSGN
	SNA
	RETURN		/SIN(0)=0
	SPA CLA
	JMS I NEG2	/SIN(-X)=-SIN(X)
	DCA SN
	FENT
	FDV TWOPI	/REDUCE MODULO 2 PI
	FPT I X2
	FEXT
	FIX
	NEGATE
	FENT
	FNR
	FAD I X2
	FMY TWOPI
	FPT I X2
	FSB PI
	FEXT
	GETSGN		/X<PI?
	SPA CLA
	JMP PCHECK	/YES
	FENT		/NO, SIN(X-PI)=-SIN(X)
	FPT I X2
	FEXT
	TAD SN
	CMA
	DCA SN
PCHECK,	FENT		/X<PI/2?
	FGT I X2
	FSB I PI2
	FEXT
	GETSGN
	SPA CLA
	JMP PALGO	/YES
	FENT		/NO, SIN(X)=SIN(PI-X)
	FGT PI
	FSB I X2
	FPT I X2
	FEXT
PALGO,	JMP I .+1	/PERFORM POWER SERIES EXPANSION
		PALG

NEG2,	FNEG
PI2,	PIOT
X2,	X
TWOPI,	0003
	3110
	3761
PI,	0002
	3110
	3761
/	EXPONENTIAL
FEXP,	GETSGN		/TAKE ABSOLUTE VALUE
	SPA CLA
	JMS FNEG
	DCA SN
	FENT
	FMY LG2E
	FPT X
	FEXT
	FIX
	PUSHA		/SAVE INTEGER PART
	NEGATE
	FENT
	FNR
	FAD X		/RETAIN FRACTIONAL PART
	FPT X
	FMY X
	FPT XSQR
	FAD DF
	FPT I TP
	FGT CF
	FDV I TP
	FSB X
	FAD AF
	FPT I TP
	FGT BF
	FMY XSQR
	FAD I TP
	FPT I TP
	FGT X
	FDV I TP
	FMY TWO
	FAD I ONEPT
	FEXT
	POPA
	TAD FLAC
	DCA FLAC
	ISZ SN		/EXP(-X)=1/EXP(X)
	RETURN
	FENT
	FPT X
	FGT I ONEPT
	FDV X
	FEXT
	RETURN
/EXP AND ARCTANGENT CONSTANTS
AF,	0004
	2372
	1402
BF,	7774
	2157
	5157
CF,	0012
	5454
	0343
DF,	0007
	2566
	5341
LG2E,	0001
	2705
	2435
TWO,	0002
	2000
BET1,	0000
	2427
	2323
BET2,	7775
	3427
	7052
BETZ,	0000
	2437
	1646
ALF2,	7773
	3306
	5454
ALF1,	7777
	3304
	4434
ALFZ,	0000
	2437
	1643
/////
/ROUTINE TO NEGATE FLAC AND RETURN WITH AC=7777
FNEG,	0
	NEGATE
	CMA
	JMP I FNEG
/VARIABLES
X,	0
	0
	0
XSQR,	0
	0
	0
/POINTERS
TP,	FLTEMP
ONEPT,	FLTONE
/	ARC TANGENT
FATN,	GETSGN		/TAKE ABSOLUTE VALUE
	SPA CLA
	JMS FNEG
	DCA SN
	FENT
	FPT X
	FGT X
	FSB I ONEPT
	FEXT
	GETSGN
	SPA CLA
	JMP GO
	FENT
	FGT I ONEPT
	FDV X
	FPT X
	FEXT
	CMA
GO,	PUSHA		/SIGN FLAG
	FENT
	FGT X
	FMY X
	FPT XSQR
	FMY BET2
	FAD BET1
	FMY XSQR
	FAD BETZ
	FPT I TP
	FGT ALF2
	FMY XSQR
	FAD ALF1
	FMY XSQR
	FAD ALFZ
	FMY X
	FDV I TP
	FEXT
	ISZ I PDLXR	/CHECK SIGN FLAG
	JMP EXIT2
	NEGATE		/SUBTRACT FROM PI/2
	FENT
	FAD PIOT
	FEXT
EXIT2,	ISZ SN		/ARC TAN(-X)=-ARC TAN(X)
	RETURN
	NEGATE
	RETURN
/ARCTANGENT AND LOG CONSTANTS AND POINTERS
PIOT,	0001	/PI/2
	3110
	3761
L8,	7771
	4544
	1735
L7,	7774
	2236
	4304
L6,	7775
	4746
	0771
L5,	7776
	2535
	3301
L4,	7776
	4113
	7211
L3,	7777
	2517
	0307
L2,	7777
	4000
	4100
L1,	0000
	3777
	7742
LOGE2,	0000
	2613
	4414
TP1,	FLTEMP
ONEP2,	FLTONE
X1,	X
/	LOGARITHM
FLOG,	GETSGN
	SPA SNA
	ERROR		/ZERO OR NEGATIVE ARGUMENT
	FENT
	FPT I TP1
	FSB I ONEP2
	FEXT
	GETSGN
	SNA
	JMP ZERGO	/LOG(1)=0
	SMA CLA
	JMP STARTL
	FENT		/LOG(X)=-LOG(1/X)
	FGT I ONEP2
	FDV I TP1
	FPT I TP1
	FEXT
	CMA
STARTL,	DCA SN
	CMA
	TAD I TP1
	FLOAT
	FENT
	FMY LOGE2
	FPT I X1
	FEXT
	IAC
	DCA I TP1
	FENT
	FGT I TP1
	FSB I ONEP2
	FPT I TP1
	FMY L8
	FAD L7
	FMY I TP1
	FAD L6
	FMY I TP1
	FAD L5
	FMY I TP1
	FAD L4
	FMY I TP1
	FAD L3
	FMY I TP1
	FAD L2
	FMY I TP1
	FAD L1
	FMY I TP1
	FAD I X1
	FEXT
	JMP EXIT2
ZERGO,	FLOAT
	RETURN
/CONTINUATION OF SINE ROUTINE
PALG,	FENT
	FGT I X1
	FDV PIOT
	FPT I X1
	FMY I X1
	FPT I TP1
	FMY C9
	FAD C7
	FMY I TP1
	FAD C5
	FMY I TP1
	FAD C3
	FMY I TP1
	FAD PIOT
	FMY I X1
	FEXT
	JMP EXIT2
/SINE CONSTANTS
C9,	7764
	2366
	5735
C7,	7771
	5466
	6317
C5,	7775
	2431
	5053
C3,	0000
	5325
	0420
$