perm filename SAITG3.FAI[S,AIL]1 blob sn#102559 filedate 1974-05-22 generic text, type T, neo UTF8
COMPIL(TG3,<TANH$,COSH$,SINH$>,<EXP$,X22,TRIGINI>,<HYPERBOLIC FUNCTIONS>)
BEGIN TANH$
	AA← 1
	BB←13
	TM1←14
	TM2←15
HERE(TANH$) 			;ENTRY TO TANH ROUTINE
	MOVE	AA,-1(P)	;PICK UP THE ARGUMENT
	MOVM	BB, AA		;GET ABSF(ARGUMENT)
	CAMGE	BB, TA		;RETURN TANH(X)=X IF 
	JRST	EXIT		;ABSF(X) .LE. .00034
	CAMLE	BB, T2		;RETURN TANH(X) = 1.0*SIGN(X)  IF
	JRST	TH5		;ARGUMENT GREATER THAN 12.0
	CAMGE	BB, T3		;USE RATIONAL APPROXIMATION IF
	JRST	TH3		;ARGUMENT IS LESS THAN 0.17
	FMPRI	BB,202400	;GET 2*ARG.
	PUSH	P,BB		;CALCULATE EXP(2X)
	PUSHJ	P,EXP$
	MOVSI	BB, (1.0)	;FORM 1.0
	FAD	AA, BB		;1 + EXP(2X)
	FDVM	BB, AA		;(1 + EXP(2X))**-1
	FMPRI	AA,202400	;2*(1 + EXP(2X))**-1
	FSBRM	BB, AA		;1 - 2*(1 + EXP(2X))**-1
	SKIPGE	-1(P)		;SKIP AHEAD IF ARG WAS GREATER THAN= 0.
	MOVNS	AA		;OTHERWISE,NEGATE THE ANSWER.
EXIT:	SUB	P,X22
	JRST	@2(P)
TH3:	FMP	AA, T7		;FORM 4*X*LOG(E) BASE 2
	MOVEM	AA, TM1		;SAVE IT IN TM1
	FMP	AA, AA		;SQUARE IT
	MOVEM	AA, TM2		;SAVE IT
	FAD	AA, T4		;FORM F↑2 + T4
	MOVE	BB, T5		;GET T5 IN ACCUMULATOR BB
	FDV	BB, AA		;T5/(F↑2 + T4)
	FAD	BB, T6		;T6 + T5/(F↑2 + T4)
	FMP	BB, TM2		;MULTIPLY BY F↑2
	FAD	BB, T7		;ADD T7 (4*LOG(E) BASE 2)
	MOVE	AA, TM1		;GET F IN ACCUMULATOR AA
TH5:	FDV	AA, BB		;DIVIDE F BY PARTIAL SUM
	JRST	EXIT		;EXIT
TA:	165544410070		;0.00034
T2:	204600000000		;12.0
T3:	176534121727		;0.17
T4:	211535527022		;349.6699888
T5:	204704333567		;14.1384514018
T6:	173433723376		;0.01732867951
T7:	203561250731		;5.7707801636
BEND TANH$
BEGIN COSH$
	AA←13
HERE(COSH$) 			;ENTRY TO HYPERBOLIC COSINE ROUTINE.
	MOVE	1,-1(P)		;PICK UP THE ARGUMENT.
	MOVM	AA,1		;PUT ABS(X) IN AA
	CAMLE	2,EIGHT8	;IF ABS(X) GREATER THAN 88.029,
	JRST	OV88		;GO TO OV88.
	PUSH	P,AA		;O'E, CALC. EXP(ABS(X))
	PUSHJ	P,EXP$
	MOVSI	AA,(1.0)	;PUT 1.0 IN AA
	FDVR	AA,1		;CALC. 1.0/EXP(ABS(X)).
	FADR	1,AA		;CALC. EXP(ABS(X)) + EXP(-ABS(X)).
	FDVRI	1,202400	;DIVIDE THIS BY 2.0.
EXIT:	SUB	P,X22		;RETURN.
	JRST	@2(P)
OV88:	FSBR	AA,LN2BE	;FORM ABS(X)-LN(2).
	CAMG	AA,EIGHT8	;OVERFLOW?
	JRST	EXPP		;NO,GO AHEAD.
	ERR <COSH: Result too large - largest positive number returned>,1
	HRLOI	1,377777	;ANSWER = +INFINITY.
	JRST	EXIT		;RETURN
EXPP:	PUSH	P,AA		;CALC. EXP(ABS(X)-LN(2)).
	PUSHJ	P,EXP$
	JRST	EXIT		;RETURN.
EIGHT8:	207540074636		;88.029
LN2BE:	200542710300		;LOG(2) BASE E.
BEND COSH$
BEGIN SINH$
	AA←13
	BB←14
	SX2←15
HERE(SINH$) 			;ENTRY TO HYPERBOLIC SINE ROUTINE.
	MOVE	1,-1(P)		;PICK UP THE ARG.
	MOVM	AA,1		;GET MAGNITUDE OF ARG IN AA
	CAMLE	AA,EIGHT8	;IF ABS(X) GREATER THAN 88.029,
	JRST	OV88		;THEN GO TO OV88.
	CAMG	AA,ONE10T	;IF ABS(X) LESS THAN= 0.10,
	JRST	SERIES		;THEN GO TO SERIES.
	PUSH	P,AA		;CALCULATE EXP(ABS(X)).
	PUSHJ	P,EXP$		;ABS(X) IS IN AA
	HRLZI	BB,576400	;PUT -1.0 IN BB
	FDVR	BB,1		;CALC. -EXP(-ABS(X)).
	FADR	1,BB		;CALC. EXP(ABS(X))-EXP(-ABS(X)).
	FDVRI	1,202400	;CALC. THIS/2.0
	SKIPGE	-1(P)		;ANSWER IS POSITIVE.
	MOVNS	1,1		;ANSWER IS NEGATIVE.
EXIT:	SUB	P,X22
	JRST	@2(P)
SERIES:	FMPR	AA,AA		;CALC. X↑2.
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP.
	MOVEM	AA,SX2		;SAVE X↑2 IN SX2.
	FDVR	2,ONE120	;CALC.X↑2/120
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP.
	FADR	AA,ONESIX	;CALC. (X↑2/120)+1/6
	FMPR	AA,SX2		;MULTIPLY IT BY X↑2.
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP.
	FADRI	AA,(1.0)	;ADD 1.0.
	FMPR	1,AA		;MULTIPLY BY X.
	JRST	EXIT		;RETURN.
OV88:	FSBR	AA,LN2BE	;CALC.ABS(X)-LN(2)
	CAMG	AA,EIGHT8	;OVERFLOW?
	JRST	EXPP		;NO,GO TO CALC.
	ERR <SINH: Result too large - largest positive number returned>,1
	HRLOI	1,377777	;SET ANS.=INFINITY.
	JRST	EXPP+2		;GO TO SET SIGN OF ANS.
EXPP:	PUSH	P,AA		;CALC. EXP
	PUSHJ	P,EXP$
	SKIPGE	-1(P)		;RETURN ANS. GREATER THAN 0 IF X GREATER THAN 0.
	MOVNS	1,1		;O'E, ANS. LESS THAN 0.
	JRST	EXIT		;RETURN.
LN2BE:	200542710300		;LN(2)
EIGHT8:	207540074636		;88.029
ONE10T:	0.10
ONE120:	207740000000		;120.0
ONESIX:	0.16666667
BEND SINH$
ENDCOM(TG3)