/FP,LIST,TAPE -- RMS.
/FLOATING POINT ARITHMETIC FUNCTION ROUTINES FOR ESI-X.  RMS -- 7/67.
/  
/FUNCTIONS -- SIN, COS, LN, LOG, EXP, SQRT, ARCTAN 
/	ALL FUNCTIONS EXCEPT SQRT USE HASTINGS APPROXIMATIONS.
/	SQRT USES NEWTON-RAPSON ITERATION
/ALL ROUTINES PRODUCE RESULTS WITH ERROR < 3*10**-7.
/  
/FLOATING NATURAL LOG GENERATOR. 
/RETURNS LN(FAC) IN FAC.
/  
	PAGE 35 
PRLN,	JMS FLN		/GET FLOATING NATURAL LOG OF FAC. 
	RETURN  
/FLOATING COMMON LOGARITHM GENERATOR.  
/  
PRLOG,	JMS FLOG	/GET LOGARITHM OF FAC, BASE 10  
	RETURN  
/NATURAL LOGARITHM ROUTINE.
/RETURNS LN(FAC) IN FAC.
/THE 8AC IS CLEAR AT ENTRY AND EXIT.
FLN,	0
	JMS FLOG	/GET COMMON LOG OF FAC IN FAC.  
	SWP		/NOTE:  LN X = LOG X * LN 10  
	GET (TENBASE)	/MULTIPLY FAC BY LN 10. 
	JMS FMU 
	JMP I FLN  
/FLOATING COMMON LOGARITHM ROUTINE. 
/RETUNRS LOG(FAC) IN FAC.  
/8AC IS CLEAR AT ENTRY AND EXIT. 
/  
FLOG,	0		/ENTRY.
	TAD ACS		/IS THE SIGN OF THE FAC -?  
	SZA CLA 
	JMP ERRARG	/YES, ERROR.
	TAD AC+PREC-1	/IS FAC ZERO? 
	SNA CLA 
	JMP ERRARG	/YES, ERROR.
	CLA CMA 
	TAD ACX 
	DCA SAVCS	/NO...SAVE ACX-1 FOR LATER SCALING.  
	CLA IAC 
	DCA ACX 
	STORE (X)	/SET FAC EXPONENT TO 1 AND STORE. 
	GET (SQRT10)  
	JMS CHGPAR	/SET X = X-SQRT(10)/X+SQRT(10)  
	GET (FPHALF)  
	TAD DECIMAL (-9) OCTAL /DO A FIVE TERM HASTINGS
	JMS HASTINGS  
	LOGCON		/APPROXIMATION. 
	SKP  
	TAD SAVCS	/GET FORMER ACX-1. 
	SNA		/IS IT ZERO?  
	JMP I FLOG	/YES, EXIT ...NO SCALING NEEDED. 
	SMA		/NOTE:  THE CHARACTERISTIC OF THE 
	CIA		/LOG IS THIS SCALING FACTOR.
	DCA ADVAC	/NO.  COMPLEMENT IT AND USE AS LOOP CONTROL.  
FLOGLP,	SWP		/X TO IR, 1 TO FAC.  
	GET (FP1)  
	TAD SAVCS	/WAS ACX-1 > 0?
	SPA CLA		/NO...SUBTRACT 1 FROM X.
	JMP FLSUBX 
	JMS FAD		/YES...ADD 1 TO X.
FLINDX,	ISZ ADVAC	/SCALING DONE?  
	JMP FLOGLP	/NO, CONTINUE. 
	JMP I FLOG	/YES, EXIT. 
/  
FLSUBX,	SWP		/SUBTRACT 1 FROM X.  
	JMS FSB 
	JMP FLINDX 
/CHANGE PARAMTER SUBROUTINE.  
/PRODUCES X-FAC/X+FAC IN FAC.  
/  
CHGPAR,	0
	STORE (Y)	/SAVE FAC IN Y, 
	JMS GETX	/X TO FAC, Y TO IR. 
	JMS FSB		/ X-Y.
	JMS GETX	/ XO TO FAC, X-Y TO IR, AND REVERSE.  
	SWP  
	STORE (X)  
	GET (Y)		/Y TO FAC,  
	JMS FAD		/ X+Y TO FAC.
	JMS GETX	/ X-Y TO FAC, X+Y TO IR,
	JMS FDV		/ X-Y/X+Y IN FAC.  
	STORE (X)  
	JMP I CHGPAR  
/FLOATING ARCTANGENT GENERATOR.  
/PRODUCES ARCTAN(FAC) IN FAC. 
/8AC IS CLEAR AT ENTRY AND EXIT. 
/  
PRARC,	JMS SAVSGN	/SAVE SGN(FAC) AND GET ABS(X) IN FAC.  
	GET (FP1)  
	JMS CHGPAR	/SET X=X-1/X+1.  
	GET (PIBY4)	/INITIAL HASTINGS TERM OF PI/4. 
	TAD DECIMAL (-15) OCTAL	/DO AN 8 TERM HASTINGS APPROXIMATION  
	JMS HASTINGS  
	ARCCON  
	SKP  
	CPY SAVCS,ACS	/SIGN OF OUTPUT = SIGN OF INPUT.  
	RETURN  
/MINOR SUBROUTINES.  
/  
GETX,	0  
	SWP		/FAC TO IR,  
	GET (X)		/X TO FAC.  
	JMP I GETX 
/  
SAVSGN,	0
	CPY ACS,SAVCS	/SAVE FAC SIGN IN SAVCS.
	DCA ACS		/PUT ABS(FAC) IN X.  
	STORE (X)  
	JMP I SAVSGN  
/  
GETY,	0  
	SWP  
	GET (Y) 
	JMP I GETY 
/SCRATCH STORAGE AND A CONSTANT. 
SAVCS,	0 
	EP35=.
	LIT  
/FLOATING EXPONENTIAL GENERATOR. 
/RETURNS E**(FAC) IN FAC. 
/8AC IS CLEAR AT ENTRY AND EXIT. 
/  
	PAGE 37 
	LITBAS 7754
PREXP,	JMS SAVSGN	/SAVE SIGN OF INPUT, GET ABS(X) IN FAC.
	GET (TENBASE)	/DIVIDE INPUT BY LN 10. 
	JMS GETX	/NOTE:  E**X =
	JMS FDV		/    10**IP(X/LN 10) + E**(LN 10*FP(X/LN 10))
	STORE (X)  
	JMS IPS		/SAVE INTEGER PART (CONVERTED TO BINARY)  
	JMS FDTOB	/AS SCALING FACTOR.
	DCA EXPTMP 
	JMS GETX
	JMS FPS		/USE FRACTION PART*LN 10 AS BASIS FOR
	SWP		/HASTINGS APPROXIMATION. 
	GET (TENBASE) 
	JMS FMU 
	STORE (X)  
	GET (FP1)	/DO A 6 TERM HASTINGS APPROXIMATION. 
	TAD [-6]  
	JMS HASTINGS  
	EXPCON  
	NOP  
	STORE (X)	/RAISE RESULT TO THE FOURTH POWER.
	TAD (-4)
	JMS XPOWER 
	TAD ACS		/ADD SCALING FACTOR TO AC EXPONENT. 
	TAD EXPTMP	/I.E, MULTIPLY BY 10**EXPTMP.
	IAC  
	DCA ACX 
	JMS CHKEXP	/DID EXPONENT OVERFLOW?  
EXPVRT,	TAD SAVCS	/WAS ORIGINAL INPUT NEGATIVE?  
	SNA CLA 
	RETURN		/NO.
	SWP		/YES...OUTPUT IS INVERTED.  
	GET (FP1)  
	JMS FDV 
	RETURN  
/  
EXPTMP,	0
/FLOATING EXPONENTIATION SECTION.
/GIVEN A IN FAC, B IN IR, RETURNS A**B.  
/THIS VERSION CHECKS FOR THE FOLLOWING SPECIAL CASES: 
/	A=0		RESULT IS 0
/	B INTEGRAL, NON-ZERO AND ABS(B) <9
/			EXPONENTIATION DONE BY MULTIPLYING.  
/  
DFEXP,	TAD AC+PREC-1	/DOES A (IN FAC) =0? 
	SNA CLA 
	RETURN		/YES, THEN A**B =0.
	STORE (X)	/SAVE A,  
	SWP		/SAVE B,  
	JMS PUSHAC	/GET FP(B). 
	TAD AC+PREC-1	/IS B ZERO?
	SNA CLA 
	JMP DFEXP2	/YES, THEN RETURN 1. 
	TAD ACX 
	TAD [-1]	/IS B BETWEEN 1 AND 10?
	SZA CLA 
	JMP DFEXP1	/NO, DO BY NORMAL METHODS. 
	JMS FPS 
	TAD AC+PREC-1	/S B AN INTEGER?  (I.E, FP(B)=0?) 
	SNA CLA 
	JMP DFIEXP	/YES, DO BY INTEGRAL EXPONENTIATION.
DFEXP1,	JMS GETX	/NO, RECOVER A. 
	JMS FLN		/NOTE:  A**B = EXP(B*LN(A)) 
	SWP  
	JMS POPAC	/RECOVER B.  
	JMS FMU		/B*LN A IN FAC. 
	JMP PREXP	/DO EXPONENTIATION.
/  
DFIEXP,	JMS POPAC	/POP B,  
	CPY ACS,SAVCS	/SAVE ITS SIGN AND CONVERT ITS
	DCA ACS		/MAGNITUDE TO A BINARY INTEGER.  
	JMS FDTOB  
	CIA  
	JMS XPOWER	/RAISE A TOTHE B POWER BY MULTIPLICATION. 
	JMP EXPVRT 
DFEXP2,	GET (FP1)	/RETURN 1.0 
	RETURN  
/XPOWER -- RAISE X TO POWER N.
/CALLING SEQUENCE... 
/	TAD (-POWER)
/	JMS XPOWER  
/  
XPOWER,	0
	DCA ADVAC	/SAVE COUNT. 
	GET (FP1)	/START OFF WITH X**0 IN FAC.  
XPLP,	JMS GETX	/X**(N-1) TO IR, X TO FAC.
	JMS FMU		/X**N IN FAC. 
	ISZ ADVAC	/DONE?  
	JMP XPLP	/NO. 
	JMP I XPOWER  
	EP37=.
	LIT  
/FLOATING SIN/COS GENERATOR.  
/RETURNS SINE OR COSINE OF FAC IN FAC. 
/8AC IS CLEAR AT ENTRY AND EXIT. 
/  
	PAGE 36 
PRCOS,	SWP  
	GET (PIBY2)	/ADD IN PI/2. 
	JMS FAD 
PRSIN,	SWP  
	GET (PIBY2)	/DIVIDE BY PI/2 TO REDUCE X TO PROPER RANGE 
	SWP  
	JMS FDV 
FSIN1,	STORE (X)	/SAVE RESULT IN X, 
	DCA ACS		/AND GET ABS(X) IN FAC. 
	SWP  
	GET (FP1)  
	JMS COMP	/COMPARE ABS(X) WITH 1.
	JMP FSINC2	/ABS(X) > 1. 
	NOP		/	= 1.  
FSIN2,	TAD (-PREC-2)	/	< 1. 
	JMS CLFACS	/SET INITIAL FAC TO ZERO.  
	TAD DECIMAL (-9) OCTAL /DO A FIVE TERM HASTINGS APPROX. 
	JMS HASTINGS  
	SINCON  
	SKP  
	RETURN  
/  
/IF ABS(X) > 1, WE MUST FOLD X SO THAT  
/	-1 < X < 1.
/  
FSINC2,	JMS GETX  
	DCA ACS 
	SWP  
	GET (FP2)  
	JMS COMP	/COMPARE ABS(X) WITH 2.
	JMP FSINC4	/ABS(X) > 2. 
	NOP		/	= 2.  
	JMS GETX	/ABS(X) < 2.
	SWP  
	GET (FP2)  
	CPY IRS,ACS	/SET FAC TO 2*SGN(X),
	JMS FSB		/AND THEN TO 2*SGN(X) - X.  
	STORE (X)	/STORE NEW VALUE OF X.
	JMP FSIN2  
/  
FSINC4,	GET (FP4) 
	TAD X		/GET FIRST WORD OF X,  
	AND [0020]
	DCA ACS		/AND 4*SGN(X)IN FAC.  
	JMS GETX	/RECOVER X,
	JMS FSB		/X-4*SGN(X). 
	JMP FSIN1  
/PROCESS SQRT GENERATOR.
/RETURNS SQRT(FAC) IN FAC. 
/8AC IS CLEAR AT ENTRY AND EXIT. 
/  
PRSQRT,	TAD ACS		/IS FAC > OR = 0?
	SZA CLA 
	JMP ERRARG	/NO, ERROR. 
	STORE (X)	/YES, SAVE INITIAL VALUE.
	TAD ACX		/IF X = Y*10**N 
	IAC		/INITIAL APPROXIMATION IS Y*10**(N+1)/2  
	CLL  
	SPA  
	CML  
	RAR  
	DCA ACX 
SQRTL,	STORE (Y)	/SAVE CURRENT APPROXIMATION IN Y. 
	JMS GETX
	JMS FDV		/X/Y. 
	JMS GETY
	JMS FAD		/X/Y+Y.
	SWP  
	GET (FPHALF)  
	JMS FMU		/ (X/Y+Y)*0.5.
	CPY ACX,ADVAC	/SAVE NEW APPROXIMATION ON STACK 
	JMS PUSHAC	/AND NEW AC EXPONENT IN ADVAC.
	JMS GETY
	JMS FSB		/OLD APPROXIMATION - NEW APPROXIMATION 
	TAD AC+PREC-1	/IS AC=0?
	SNA CLA 
	JMP SQRTX	/YES...DONE  
	TAD ACX		/ OLD EXPONENT - NEW EXPONENT 
	CIA  
	TAD ADVAC  
	TAD (-5)	/IS CHANGE OVER ITERATION LESS THAN 10**-5? 
	SMA CLA 
	JMP SQRTX	/YES. DONE
	JMS POPAC	/NO, RECOVER NEW APPROXIMATION 
	JMP SQRTL	/AND ITERATE.
/  
SQRTX,	JMS POPAC	/RECOVER ANSWER.
	RETURN		/AND EXIT 
/  
ERRARG,	JMS ERRG	/ARGUMENT ERROR.
	TEXT /ARG/ 
	EP36=.
	LIT  
/GENERAL HASTINGS APPROXIMATION CALCULATOR.  
/INPUT:	FAC -- INITIAL TERM  
/	X -- VALUE FOR SERIES
/	RETURN+1 -- ADDRESS OF HASTINGS CONSTANTS IN BANK 1 
/	RETURN+2 -- SERIES INDEX DECREMENT: -1, -2, ETC. 
/	8AC -- NUMBER OF TERMS IN SERIES.
/  
/OUTPUT: FAC -- RESULT. 
/	8AC -- 0.
/  
	*EP33 
HASTINGS, 0 
	DCA QADVC	/SAVE NUMBER OF TERMS IN SERIES.  
	TAD I HASTINGS	/PICK UP POINTER TO CONSTANTS AND SAVE.  
	ISZ HASTINGS  
	DCA ADVAC  
	TAD I HASTINGS	/PICK UP SERIES DECREMENT SWITCH.  
	ISZ HASTINGS  
	DCA HSWTCH 
	JMS PUSHAC	/SAVE INITIAL TERM OF SERIES ON STACK. 
	CPY [IR-1],AX0	/CLEAR THE INPUT REGISTER.  
	CPY (-PREC-2),TMP
	DCA I AX0  
	ISZ TMP 
	JMP .-2 
HASLP,	TAD ADVAC	/PICK UP C(N)
	CDF 10
	JMS I [GETNUM]  
	JMS FAD		/ C(N) + PARTIAL SUM IN AC. 
	TAD ADVAC  
	TAD [NUMWD]	/ADVANCE POINTER IN HASTINGS CONSTANTS. 
	DCA ADVAC  
	JMS GETX
	JMS FMU		/PRODUCE C(N)+PARTIAL SUM  *X
	ISZ QADVC	/WAS THAT THE LAST TERM?  
	JMP HSWTCH	/NO, CONTINUE LOOP.  
	SWP		/YES, ADD IN INITIAL TEMR.  
	JMS POPAC  
	JMS FAD 
	JMP I HASTINGS	/EXIT TO CALLER. 
HSWTCH,	HLT		/MULTIPLY BY X OR X**2 SWITCH.  
	JMP NOSQR	/NO SQUARING, GO TO NEXT LOOP CYCLE. 
	JMS GETX	/MULTIPLY AGAIN BY X.  
	JMS FMU 
	ISZ QADVC	/THIS CAN NEVER OVERFLOW! 
NOSQR,	SWP		/SWAP PARTIAL SUM INTO IR,  
	JMP HASLP	/AND ITERATE.
	EP33=.
	LIT  
/CONSTANTS FOR FLOATING POINT ROUTINES.
/  
	*EP33 
X,	0000  
	*X+NUMWD  
FPHALF,	0000
	0000 
	0005 
Y,	0000  
	*Y+NUMWD  
	*EP35 
TENBASE, 0045	/LN 10 = 2.30258509 
	4122 
	0062 
PIBY2,	0046	/PI/2 = 1.570796326
	4560 
	3521 
PIBY4,	0002	/PI/4 = .7853981633
	4223 
	2607 
	*EP36 
SQRT10,	0050	/SQRT(10) = 3.16227766  
	3442 
	3023 
FP1,	0040	/1.0 
	0000 
	0001 
FP2,	0040	/2.0 
	0000 
	0002 
	*EP37 
FP4,	0040	/4.0 
	0000 
	0004 
/HASTINGS CONSTANTS FOR FP FUNCTIONS.  
/  
	BANK 1  
	*HASCON  
/SIN/COS CONSTANTS.  
/  
SINCON,	7642	/0.00015148419
	2204 
	0521 
	7726	/-.00467376557 
	3163 
	3544 
	7750	/.07968967928  
	3230 
	3227 
	0027	/-.645963711
	1551 
	2506 
	0046	/1.570796318
	4560 
	3521 
/LOGARITHM CONSTANTS.
/  
LOGCON,	0007	/.191337714
	3463 
	0621 
	7750	/.094376476 
	2147 
	1511 
	0001	/.177522071 
	1045 
	3561 
	0005	/.289335524 
	2463 
	4602 
	0011	/.868591918 
	0625 
	4150 
/EXPONENTIAL CONSTANTS  
/  
EXPCON,	7500	/69906E-7  
	0006 
	0226 
	7540	/5.4302E-6  
	0040 
	1505 
	7640	/1.71562E-J 
	1145 
	0561 
	7701	/.0025913712
	3461 
	4522 
	7750	/.0312575832
	2565 
	1023 
	0007	/.24999868  
	4231 
	4502 
/ARCTANGENT CONSTANTS.  
/  
ARCCON,	7730	/-.004054058  
	2404 
	2404 
	7743	/.0218612288
	1026 
	4022 
	7771	/-.0559098861  
	4220 
	4525 
	7744	/.096420041 
	0002 
	2151 
	0023	/-.1390853351  
	2600 
	4461 
	0004	/-.1994653599
	2544 
	4621 
	0026	/-.33329856  
	4222 
	1463 
	0003	/.9999993329
	4631 
	4631 
/  
/EJECTION SEQUENCE
JEQSEQ,	212; 212; 212; 212; 337; 337; 337; 337; 337  
CRLF3,	215  
LF3,	212; 212
JLF,	212; 0000  
$