COMMENT ⊗   VALID 00015 PAGES VERSION 17-1(7)
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	HISTORY
C00004 00003	 NUMERICAL ROUTINES FOR SAIL
C00005 00004	ROUTINES FOR HANDLING UNDER/OVER FLOW.
C00013 00005	TENX<TENEX VERSION OF UNDER/OVER FLOW
C00019 00006	FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
C00025 00007	FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
C00029 00008	PSEUDO RANDOM NUMBER GENERATOR AND INITIALIZING ROUTINE
C00032 00009	FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
C00037 00010	FLOATING POINT SINGLE PRECISION ARCSINE FUNCTION
C00040 00011	FLOATING POINT SINGLE PRECISION ARCCOSINE FUNCTION
C00043 00012	FLOATING POINT SINGLE PRECISION ARCTANGENT OF TWO ARGUMENTS
C00047 00013	FLOATING POINT SINGLE PRECISION HYPERBOLIC TANGENT ROUTINE
C00051 00014	FLOATING POINT SINGLE PRECISION HYPERBOLIC COSINE FUNCTION.
C00054 00015	FLOATING POINT SINGLE PRECISION HYPERBOLIC SINE FUNCTION.
C00058 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000007  ⊗;


COMMENT ⊗
VERSION 17-1(7) 4-3-75 BY RHT BUG #UF# TYPO IN SINH
VERSION 17-1(6) 3-31-75 BY RLS TENEX UNDER/OVER HANDLER
VERSION 17-1(5) 3-31-75 
VERSION 17-1(4) 3-31-75 
VERSION 17-1(3) 12-12-73 BY RHT & RFS BUG #PW# NEED SEVERAL APR BIT ENABLINGS 
VERSION 17-1(2) 12-12-73 
VERSION 17-1(1) 12-11-73 BY JRL BUG #PV# KEEP STACK HEIGHT CONSISTENT WITHIN ATAN

⊗;
SUBTTL  NUMERICAL ROUTINES FOR SAIL


COMMENT ⊗

This set of routines requires that some pieces be in the low
segment.  We have decided (for this and other reasons) that
it shall not be part of the standard SAIL upper segment.
As a result, the switches UP, LOW, NOUP and NOLOW do not appear
in here; this file is just not included in the second segment
assembly.

When the file is used to make a library, the parameters to the
COMPIL macro (and RENSW, set before all) determine where the code
will lie.

⊗

;ROUTINES FOR HANDLING UNDER/OVER FLOW.
NOUP <

COMPIL(TGI,<TRIGINI>,<JOBTPC,JOBAPR,OVPCWD>
	,<TRIG ROUTINE INTERRUPT HANDLER>,<.RSEED>,INHIBIT)

BEGIN UNDER

;;#XC# CMU =F5= JFR 6-17-76 1 OF 4 NO NEED TO DEFINE THESE
IFN 0,<
;#DC#JAM 1 OF 5
CRY0←←200000
CRY1←←100000
;#DC#↑
>;IFN 0
;;#XC# ↑

NOTENX <;DEC VERSION OF UNDER/OVER FLOW CODE
OV←←400000
FOV←←40000
ZDV←←40
FXU←←100

IFE ALWAYS,<		;MORE EXTERNALS, CONDITIONALLY ASSEMBLED.
EXPO <
	EXTERNAL INTMAP,ENABLE
>;EXPO
	EXTERNAL APRACS,GOGTAB
NOEXPO <
	EXTERNAL INTTBL
>;NOEXPO
>

;The underflow processing is turned
;on with the call TRIGINIT( <rout-name> ).  This uses the
;INTMAP and ENABLE SAIL functions to set up interrupt
;traps (export); at Stanford, it turns on the APRENB system
;itself.
;If an interrupts happens, and it is
;not followed by a JFCL (indicating that overflow from this
;spot is ok), then the <rout-name> is called.
;It may peer around at things, change JOBTPC, etc., just
;as documented for any interrupt routine.  When it returns,
;the interrupt is dismissed.

;IF THIS CODE IS LOADED, INITIALIZE IT!

TRGIN:	0
	XWD 000000,TRGIQ	;SPECIAL INIT IN FIRST SYS PHASE
	0			;ONLY 1 ROUTINE TO CALL.
	LINK %INLNK,TRGIN

TRGIQ:	PUSH	P,[0]		;NO ROUTINE.
	PUSHJ	P,TRIGINI	;INITIALIZATION
	POPJ	P,		;RETURN.


HERE(TRIGINIT)
	JFCL	17,.+1		;CLEAR NUMERIC FLAGS.
EXPO <
	PUSH	P,[=32]		;ARM FOR FLOATING OVERFLOWS
	PUSH	P,[FLTOV]	;ROUTINE.
	PUSH	P,[0]		;NOT DEFERRED
	PUSHJ	P,INTMAP	;SET IT ALL UP.
	PUSH	P,[=32]
	PUSHJ	P,ENABLE	;AND ENABLE IT.
;;#PW# RHT SINCE APR DISPATCHER ASSUMES ONLY 1 BIT & DEC MAY SET SEVERAL
	PUSH	P,[=29]		;ARM FOR regular, too.
	PUSH	P,[FLTOV]	;ROUTINE.
	PUSH	P,[0]		;NOT DEFERRED
	PUSHJ	P,INTMAP	;SET IT ALL UP.
	PUSH	P,[=29]
	PUSHJ	P,ENABLE	;AND ENABLE IT.
;;#PW#
>;EXPO
NOEXPO <
	MOVE	USER,GOGTAB	;LOOK TO SEE IF SET UP FOR
	SKIPE	DISPAT(USER)	;INTERRUPTS YET; IF NOT,
	 JRST	 .+3
	PUSH	P,[=128]	;ENABLE THEM NOW.
	PUSHJ	P,INTTBL	;...
;;#UH# ! WAS A 10
	MOVEI	A,100		;TURN ON FLOATING OVERFLOWS
	CALL6	(A,APRENB)
	MOVEI	A,FLTOV
	MOVEM	A,JOBAPR	;...
>;NOEXPO
	POP	P,1		;RETURN ADDRESS
	POP	P,OVROUT	;USER'S ROUTINE.
	JRST	(1)		;RETURN.

FLTOV:				;HERE WHEN AN INTERRUPT HAPPENS
NOEXPO <
	MOVEM	1,SAVP		;GET AN ACCUMULATOR.
>;NOEXPO
	MOVE	1,JOBTPC	;COME HERE WITH AC'S SET UP.
	MOVEM	1,OVPCWD	;SAVE FOR LOOKING.
	TLNN	1,FXU		;WHAT KIND OF INTERRUPT
	 JRST	 NOFX		;NOT FLOATING UNDERFLOW.
	MOVE	1,-1(1)		;GET OPCODE.
	TLNN	1,40000		;CHECK FOR FSC
	TLZ	1,2000
	DPB	1,[POINT 29,SEW,35] ;CHANGE INSTRUCTION
EXPO <				;GET BACK INTRRUPT AC'S
	PUSH	P,16
	MOVEM	P,SAVP
	MOVE	17,[XWD APRACS,0]
	BLT	17,17		;RESTORE AC'S
>;EXPO
NOEXPO <
	MOVE	1,SAVP		;GET BACK SAVED AC.
>;NOEXPO
SEW:	SETZ	0,0		;MODIFIED!!!!
NOEXPO <
	MOVEM	1,SAVP		;SAVE AGAIN.
>;NOEXPO
EXPO <
	MOVEM	17,APRACS+17
	MOVEI	17,APRACS
	BLT	17,APRACS+16
	MOVE	P,SAVP
	POP	P,16
>;EXPO

NOFX:	HLRZ	1,@JOBTPC	;CHECK IF NEXT INSTR IS JFCL
	ANDCMI	1,777
	CAIE	1,(<JFCL>)	;CHECK.
	 JRST	 USRRT		;GO TO USER ROUTINE.
;#DC#JAM 2 OF 5
	LDB	1,[POINT 4,@JOBTPC,12]
;;#XC# 2! JFR 6-17-76 2 OF 4
;;;;;;;	MOVE	1,INTCOD(1)	; PICK UP MAPPING BETWN JFCL AC AND FLAGS
	ROT	1,-4		;ALIGN JFCL BITS WITH PC BITS
	TDNN	1,JOBTPC	; ARE ANY OF THEM ON?
	 JRST	 USRRT		; NO, JFCL IS NOT RELEVANT HERE
	TLO	1,OV!FXU	; ALWAYS CLEAR OVERFLOW FLAG
	ANDCAM	1,JOBTPC	; CLEAR ONLY THE APPROPRIATE BITS
	HRRZ	1,@JOBTPC	;GET EFFECTIVE ADDRESS
COMMENT $  Above instruction does not work if the JFCL is indexed or indirect.
	However, at some time in the past, Fortran (F40) (runtimes?) used
	JFCL x,0(y)  with  y  as a coded indication of what to do with the
	AC of the previous instruction (zero, +infinity, -infinity, error, etc.)
	when overflow happened.
$
	HRRM	1,JOBTPC
	JRST	XIT
;#DC#JAM↑


USRRT:	SKIPN	OVROUT
	 JRST	 RET		;NO USER ROUTINE.
NOEXPO <
	MOVEI	1,APRACS	;SAVE AC'S HERE FOR USER TO SEE
	BLT	1,APRACS+17
	MOVE	1,SAVP
	MOVEM	1,APRACS+1
	MOVE	USER,GOGTAB
	MOVE	P,IPDP(USER)
	MOVE	SP,ISPDP(USER)
>;NOEXPO
	PUSHJ	P,@OVROUT	;CALL USER'S ROUTINE.
NOEXPO <
	MOVE	1,APRACS+1	;RESTORE AC'S
	MOVEM	1,SAVP
	MOVSI	1,APRACS
	BLT	1,17		;AND RESTORE ALL OTHERS
>;NOEXPO
RET:	MOVSI	1,OV+FOV+FXU+ZDV
	ANDCAM	1,JOBTPC
XIT:
NOEXPO <
	MOVE	1,SAVP		;RESTORE THE ACCUMULATOR
	JRST	2,@JOBTPC
>;NOEXPO
EXPO <
	POPJ	P,		;RETURN TO INTERRUPT HANDLER.
>;EXPO

SAVP:	0
OVROUT:	0
>;NOTENX
;;#XC# JFR 6-17-76 3 OF 4 NO NEED FOR THIS TABLE; BESIDES, IT WAS BIT REVERSED!
IFN 0,<
;#DC#JAM 3 OF 5

INTCOD:	0		; THIS TABLE IS INDEXED BY THE AC FIELD OF A JFCL
	OV,,0		; IT GIVES THE CORRESPONDENCE BETWEEN SUCH AND
	CRY0,,0		;    THE ACTUAL FLAG BITS IN THE LH OF THE PC
	CRY0!OV,,0	;    SO THAT WE CAN EASILY COMPARE THE FLAGS
	CRY1,,0		;    WITH THE BITS THAT ARE TESTED IN THE JFCL
	CRY1!OV,,0	;    (THUS SIMULATING THE HARDWARE!)
	CRY1!CRY0,,0
	CRY1!CRY0!OV,,0
	FOV,,0
	FOV!OV,,0
	FOV!CRY0,,0
	FOV!CRY0!OV,,0
	FOV!CRY1,,0
	FOV!CRY1!OV,,0
	FOV!CRY1!CRY0,,0
	FOV!CRY1!CRY0!OV,,0
;#DC#JAM↑
>;IFN 0
;;#XC# ↑
TENX<;TENEX VERSION OF UNDER/OVER FLOW
OV←←400000
;;#XC# JFR 6-17-76 1.5 OF 4
IFN 0,<
;#DC#JAM 1.5 OF 5 (fix to make TENEX version work)
CRY0←←200000
CRY1←←100000
;#DC#↑
>;IFN 0
;;#XC# ↑
FOV←←40000
ZDV←←40
FXU←←100

IFE ALWAYS,<		;MORE EXTERNALS, CONDITIONALLY ASSEMBLED.
	EXTERNAL INTMAP,ENABLE
	EXTERNAL GOGTAB,PS3ACS
>

;The underflow processing is turned
;on with the call TRIGINIT( <rout-name> ).  This uses the
;INTMAP and ENABLE SAIL functions to set up interrupt
;traps (export); at Stanford, it turns on the APRENB system
;itself.
;If an interrupts happens, and it is
;not followed by a JFCL (indicating that overflow from this
;spot is ok), then the <rout-name> is called.
;It may peer around at things, change JOBTPC, etc., just
;as documented for any interrupt routine.  When it returns,
;the interrupt is dismissed.

;IF THIS CODE IS LOADED, INITIALIZE IT!

TRGIN:	0
	XWD 000000,TRGIQ	;SPECIAL INIT IN FIRST SYS PHASE
	0			;ONLY 1 ROUTINE TO CALL.
	LINK %INLNK,TRGIN

TRGIQ:	PUSH	P,[0]		;NO ROUTINE.
	PUSHJ	P,TRIGINI	;INITIALIZATION
	POPJ	P,		;RETURN.


HERE(TRIGINIT)
	JFCL	17,.+1		;CLEAR NUMERIC FLAGS.
	PUSH	P,[=7]		;ARM FOR FLOATING OVERFLOWS
	PUSH	P,[FLTOV]	;ROUTINE.
	PUSH	P,[0]		;NOT DEFERRED
	PUSHJ	P,INTMAP	;SET IT ALL UP.
	PUSH	P,[=7]
	PUSHJ	P,ENABLE	;AND ENABLE IT.
	PUSH	P,[=6]		;ARM FOR regular, too.
	PUSH	P,[NOFLT]	;ROUTINE.
	PUSH	P,[0]		;NOT DEFERRED
	PUSHJ	P,INTMAP	;SET IT ALL UP.
	PUSH	P,[=6]
	PUSHJ	P,ENABLE	;AND ENABLE IT.
	POP	P,1		;RETURN ADDRESS
	POP	P,OVROUT	;USER'S ROUTINE.
	JRST	(1)		;RETURN.

;;#XE  need overflow bits on.  RLS June 22, 1976
GETADR:				
;GET PC WORD IN 1, STORE IN OVPCWD
	MOVEI	1,400000	;THIS FORK
	JSYS	RIR		;READ TABLES
	HLRZ	2,2		;LEVTAB ADDRESS
	MOVE	1,@2(2)		;LEVEL 3 PC WORD
	IOR	1,-1(P)		;TURN ON MARKED BITS
	MOVEM	1,OVPCWD	;SAVE FOR LOOKING.
	SUB	P,[XWD 2,2]
	JRST	@2(P)

NOFLT:
	PUSH	P,[XWD OV,0]
	PUSHJ	P,GETADR	
	JRST	NOFX		;NOT FLOATING

FLTOV:
	PUSH	P,[XWD OV+FOV,0];GET PCWORD AND SET FOR OVERFLOW AND 
;;#XE ↑↑
	PUSHJ	P,GETADR	;FLOATING OVERFLOW
	MOVE	1,-1(1)		;GET OPCODE.
	TLNN	1,40000		;CHECK FOR FSC
	TLZ	1,2000
	DPB	1,[POINT 29,SEW,35] ;CHANGE INSTRUCTION
	PUSH	P,16		;GET BACK INTERRUPT ACS
	MOVEM	P,SAVP
	MOVE	17,[XWD PS3ACS,0]
	BLT	17,17		;RESTORE AC'S
SEW:	SETZ	0,0		;MODIFIED!!!!
	MOVEM	17,PS3ACS+17
	MOVEI	17,PS3ACS
	BLT	17,PS3ACS+16
	MOVE	P,SAVP
	POP	P,16

;#DC#JAM 4 OF 5
NOFX:	HLRZ	1,@OVPCWD	;CHECK IF NEXT INSTR IS JFCL
;#DC#JAM↑
	ANDCMI	1,777
	CAIE	1,(<JFCL>)	;CHECK.
	 JRST	 USRRT		;GO TO USER ROUTINE.
;#DC#JAM 5 OF 5
	LDB	1,[POINT 4,@OVPCWD,12]
;;#XC# 2! JFR 6-17-76 4 OF 4
;;;;;;;	MOVE	1,INTCOD(1)	; PICK UP CORRESPONDING FLAG BITS
	ROT	1,-4		;ALIGN JFCL BITS WITH PC BITS
	TDNN	1,OVPCWD
	 JRST	 USRRT		; IF NO FLAGS ON, JFCL IS NOP
	TLO	1,OV!FXU	; ALWAYS CLEAR OVERFLOW
	ANDCAM	1,OVPCWD	; CLEAR THOSE FLAG BITS
	HRRZ	1,@OVPCWD	;GET EFFECTIVE ADDRESS
	HRRM	1,OVPCWD
	JRST	XIT
;#DC#JAM↑

RET:	MOVSI	1,OV+FOV+FXU+ZDV	;PROBABLY A NO-OP ON TENEX
	ANDCAM	1,OVPCWD	;BUT PROBABLY DOESNT HURT 
XIT: 	MOVEI	1,400000	;THIS FORK
	JSYS	RIR		;READ LEVTAB,CHNTAB
	HLRZ	2,2
	MOVE	1,OVPCWD
	MOVEM	1,@2(2)		;SAVE THE NEW PC WORD FOR LEVEL 3
	POPJ	P,		;RETURN TO INTERRUPT HANDLER.


USRRT:	SKIPN	OVROUT
	  JRST	 RET		;NO USER ROUTINE.
	PUSHJ	P,@OVROUT	;CALL USER'S ROUTINE.
	POPJ	P,		;JUST RETURN

SAVP:	0
OVROUT:	0
>;TENX  -- END OF TENEX VERSION OF UNDER/OVER FLOW HANDLER

BEND UNDER

.RSEED:	=524287

ENDCOM (TGI)

>;NOUP
NOLOW <				;REST IS REENTRANT
COMPIL(TG1,<SIN$,COS$,SIND$,COSD$,SQRT$,RAN$>,<TRIGINI,X22,.RSEED>,<SIN, SQRT ROUTINES>)

;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;--------------------------------------------------------

;IF THE ARGUMENT IS IN DEGREES, THE PROPER ENTRY POINTS ARE
;SIND$ AND COSD$, WHILE IF THE ARGUMENT IS IN RADIANS, THE
;PROPER ENTRY POINTS ARE SIN$ AND COS$.
;COSD$ CALLS SIND$ TO CALCULATE SIND(PI/2+X)
;COS$ CALLS SIN$ TO CALCULATE SIN (PI/2+X)
;SIND$ CALLS SIN$ AFTER A CONVERSION FROM DEGREES TO RADIANS.

;THIS ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT.
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT
;010 - 3RD QUADRANT
;011 - 4TH QUADRANT
;THE ALGORITHM USES A MODIFIED TAYLOR SERIES TO CALCULATE 
;THE SINE OF THE NORMALIZED ARGUMENT.

;THE ROUTINES ARE CALLED IN THE FOLLOWING MANNER:
;	PUSH	P,ARG
;	PUSHJ	P,SIN$		(OR COS$,SIND$, OR COSD$)
;THE ANSWER IS RETURNED IN ACCUMULATOR 1
BEGIN SIN$

AA←13
BB←14
CC←15

HERE(COSD$)			;ENTRY TO COSINE DEGREES ROUTINE.
	MOVE	BB,-1(P)	;PICK UP THE ARG.
	FADR	BB,CD1		;ADD 90 DEGREES.
	JRST	CONVER		;CONVERT TO RADIANS
				;THEN GO TO SIN ROUTINE

HERE(SIND$)			;ENTRY TO SINE DEGREES ROUTINE.
	MOVE	BB,-1(P)	;PICK UP THE ARG.
CONVER:	FDVR	BB,SCD1		;CONVERT TO RADIANS
	JFOV	.+1		;SUPPRESS ERROR MESSAGE ON UNDERFLOW.
				;SPECIAL INTERRUPT CODE WILL SET
				; BB TO 0 ON UNDERFLOW
	JRST	S1		;ENTER SINE ROUTINE.

HERE(COS$) 			;ENTRY TO COSINE RADIANS ROUTINE.
	MOVE	BB,-1(P)	;PICK UP THE ARG.
	FADR	BB,PIOT		;ADD PI/2.
	JRST	S1		;ENTER SINE ROUTINE.


HERE(SIN$)			;ENTRY TO SINE RADIANS ROUTINE.
	MOVE	BB,-1(P)	;PICK UP THE ARG.
S1:	MOVEM	BB,-1(P)	;SAVE THE ARG.
	MOVMS	BB		;GET ABS OF ARG.
	CAMG	BB,SP2		;SIN(X)=X IF X LESS THAN 2↑-9.
	JRST	S3A		;EXIT WITH ARG. IN B.
	FDV	BB,PIOT		;DIVIDE X BY PI/2.
	CAMG	BB,ONE		;IS X/(PI/2) LESS THAN 1.0 ?
	JRST	S2		;YES,ARG IN 1ST QUADRANT ALREADY.
	MULI	BB,400		;NO,SEPARATE FRACTION AND EXP.
	ASH	CC,-202(BB)	;GET X MODULO 2PI.
	JFOV	.+1		;SUPRESS ERROR MESSAGE FROM OVTRAP.
				;SPECIAL INTERRUPT CODE WILL
				;RETURN WITHOUT ATTEMPTING A
				;FIXUP
	MOVEI	BB,200		;PREPARE FLOATING FRACTION.
	ROT	CC,3		;SAVE THREE BITS TO DETERMINE QUADRANT.
	LSHC	BB,33		;ARGUMENT NOW IN THE RANGE (-1,1).
	FAD	BB,SP3		;NORMALIZE THE ARGUMENT.
	JUMPE	CC,S2		;REDUCED TO 1ST QUAD IF BITS 000.
	TLCE	CC,1000		;SUBTRACT 1.0 FROM ARG IF BITS ARE
	FSB	BB,ONE		;001 OR 011.
	TLCE	CC,3000		;CHECK FOR FIRST QUADRANT, 001.
	TLNN	CC,3000		;CHECK FOR THIRD QUADRANT, 010.
	MOVNS	BB		;001,010.
S2:	SKIPGE	-1(P)		;CHECK SIGN OF ORIGINAL ARG.
	MOVNS	BB		;SIN(-X)=-SIN(X).
	MOVEM	BB,-1(P)	;STORE REDUCED ARG.
	FMPR	BB,BB		;CALCULATE X↑X
	MOVE	AA,SC9		;GET 1ST CONSTANT.
	FMP	AA,BB		;MULTIPLY BY X↑2
	FAD	AA,SC7		;ADD IN NEXT CONSTANT.
	FMP	AA,BB		;MULTIPLY BY X↑2.
	FAD	AA,SC5		;ADD IN NEXT CONSTANT.
	FMP	AA,BB		;MULTIPLY BY X↑2.
	FAD	AA,SC3		;ADD IN NEXT CONSTANT.
	FMP	AA,BB		;MULTIPLY BY X↑2.
	FAD	AA,PIOT		;ADD IN LAST CONSTANT.
S2B:	FMPR	AA,-1(P)	;MULTIPLY BY X.
	SKIPA	1,AA		;ANSWER IN 1
S3A:	MOVE	1,-1(P)		;ANSWER IN 1.
	SUB	P,X22
	JRST	@2(P)

SC3:	577265210372
SC5:	175506321276
SC7:	606315546346
SC9:	164475536722

SP2:	170000000000
SP3:	0
CD1:	90.0
SCD1:	206712273406
PIOT:	201622077325
ONE:	1.0


BEND SIN$
;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
;--------------------------------------------------------
;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS
;CALCULATED. THE ARGUMENT IS WRITTEN IN THE FORM
;	X=	F*(2**2B)	WHERE 0 LESS THAN F LESS THAN 1
;SQRT(X) IS THEN CALCULATED AS (SQRT(F))*(2**B)
;SQRT(F) IS CALCULATED BY A LINEAR APPROXIMATION, THE NATURE
;OF WHICH DEPENDS ON WHETHER 1/4 LESS THAN F LESS THAN 1/2 OR 1/2 LESS THAN F LESS THAN 1,
;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.

;THE CALLING SEQUENCE FOR THE SQUARE ROOT IS AS FOLLOWS:
;	PUSH	17,ARG
;	PUSHJ	17,$SQRT
;THE ANSWER IS RETURNED IN ACCUMULATOR 1.

BEGIN SQRT$

	AA←13
	BB←14
	F←15


HERE(SQRT$)			;ENTRY TO SQUARE ROOT ROUTINE
	SKIPG	BB,-1(P)	;PICK UP ARG. CHECK IF GREATER THAN 0
	JRST	SQRT4		;NO, HANDLE NON-POSITIVE ARGUMENT

	MOVEI	AA,0		;GET EXPONENT TO AA
	LSHC	AA,=9
	SUBI	AA,201		;GET TRUE EXPONENT + 1
	ROT	AA,-1		;DIVIDE BY 2
				;AA HAS SCAL FACTOR.
	JUMPL	AA,SQRT3	;JUMP IF FRACTION GREATER THAN .5

				;FRACTION LESS THAN .5
	;;%##% ! USED TO BE =-
	LSH	BB,-=9		;RESTORE POSITION OF FRACTION IN BB
	FSC	BB,177		;AND FIX UP EXPONENT .25 LESS THAN F LESS THAN .5
	MOVEM	BB,F		;SAVE FRACTION
				;COMPUTE LINEAR APPROX #1
	FMPRI	BB,200640
	FADRI	BB,177465

SQRT1:	MOVE	1,F		;1ST ITERATION OF NEWTON
	FDV	1,BB		; F/APPROX
	FAD	BB,1		; APPROX  +  F/APPROX
	FSC	BB,-1		; .5*( APPROX  +  F/APPROX)
	MOVE 	1,F		;2ND ITERATION OF NEWTON
	FDV	1,BB		; F/APPROX
	FADR	1,BB		; APPROX + F/APPROX
	FSC	1,(AA)		;HALVE AND SCALE EXPONENT
EXIT:	SUB	P,X22
	JRST	@2(P)

				;HERE ON F GREATER THAN= .5
	;;%##% ! USED TO BE =-
SQRT3:	LSH	BB,-=9		;RESTORE POSITION OF FRACTION IN BB
	FSC	BB,200		;AND FIX UP EXPONENT .5 LESS THAN= F LESS THAN 1
	MOVEM	BB,F		;SAVE FRACTION
				;COMPUTE LINEAR APPROX #2
	FMPRI	BB,200450
	FADRI	BB,177660
	JRST	SQRT1		;NOW GO ITERATE

SQRT4:	JUMPE	BB,ZERO
	ERR <SQRT: Negative argument - 0 returned>,1
ZERO:	MOVEI	1,0		;HERE ON NON-POSITIVE ARG. RETURN ZERO
	JRST	EXIT


BEND SQRT$

;PSEUDO RANDOM NUMBER GENERATOR AND INITIALIZING ROUTINE
;METHOD SUGGESTED BY D. H. LEHMER


;CALLING SEQUENCE FOR FUNCTION RAN:

;PUSH	17,ARG
;PUSHJ	17,$RAN
;IF ARG NEQ 0, ARG IS USED AS PREVIOUS RANDOM NO.
;(I.E. AS THE STARTING VALUE), OTHERWISE THE PREVIOUS
;VALUE (WHICH WAS STORED LOCALLY) IS USED.
;ANSWER IS RETURNED IN ACCUMULATOR 1 AS A SINGLE
;PRECISION FLOATING POINT NUMBER IN THE RANGE
;0 LESS THAN X LESS THAN 1


BEGIN RAN$

       AA←13
       BB←14

INTERNAL RAN$

RAN$:
	MOVE	AA,-1(P)		;IF ARG = 0 THEN
	JUMPE	AA,R1		;USE PREVIOUS RANDOM NO.
	TLZ	AA,760000	;OTHERWISE MASK 5 BITS
	MOVEM	AA,.RSEED	;AND STORE NEW NO.
R1:	MOVE	AA,K		;GET K [14**29(MOD2**31 -1)]
	MUL	AA,.RSEED	;MULTIPLY WITH LAST RANDOM NUMBER
	ASHC	AA,4		;SEPARATE RESULT IN TWO 31 BIT WORDS
	LSH	BB,-4
	ADD	AA,BB		;ADD THEM TOGETHER
	TLZE	AA,760000	;SKIP IF RESULT LESS THAN 31 BITS
	ADDI	AA,1
	MOVEM	AA,.RSEED	;STORE NEW RN IN INTEGER MODE
	HLRZ	1,AA		;CONVERT TO FP IN TWO STEPS IN
	FSC	1,216		;ORDER TO LOOSE NO LOW ORDER
	HRLI	AA,0		;BITS
	FSC	AA,174
	FAD	1,AA
	SUB	P,X22
	JRST	@2(P)		;EXIT
K:     =630360016        ;14**29(MOD 2**31 -1)
;.RSEED:=524287           ;STARTING VALUE

BEND RAN$

ENDCOM(TG1)

;; #PV# ! (1 OF 3) INCLUDE X11 IN COMPIL
COMPIL(TG2,<ATAN$,ASIN$,ACOS$,ATAN2$>,<OVPCWD,TRIGINI,X33,SQRT$,X22,X11>
	,<ARC-TRIG ROUTINES>)

;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
;---------------------------------------------------------
;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B2-A3(Z+B3)**-1)**-1)**-1)
;WHERE Z=X↑2, IF  0 LESS THAN X LESS THAN= 1

;IF X GREATER THAN 1, THEN ATAN(X) = PI/2 - ATAN(1/X)
;AC DD IS USED INTERNALLY TO KEEP TRACK OF CASES
;IF X GREATER THAN 1, THEN RH(DD) =-1, AND LH(DD) = -SGN(X)
;IF X LESS THAN 1, THEN RH(DD) = 0, AND LH(DD) =  SGN(X)

;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
;	PUSH	17,ARG
;	PUSHJ	17,$ATAN
;THE ANSWER IS RETURNED IN ACCUMULATOR 1

BEGIN ATAN$

	AA←1
	BB←13
	CC←14
	DD←15

HERE(ATAN$) 			;ENTRY TO ARCTANGENT ROUTINE
	MOVE	AA,-1(P)	;PICK UP THE ARGUMENT IN AA
ATAN1:	MOVM	BB, AA		;GET ABSF OF ARGUMENT
	CAMG	BB, A1		;IF X LESS THAN 2↑-33, THEN RETURN WITH...
	JRST	EXIT		;ATAN(X) = X
	HLLO	DD, AA		;SAVE SIGN, SET RH(DD) = -1
	CAML	BB, A2		;IF AA GREATER THAN 2↑33, THEN RETURN WITH
	JRST	AT4		;ATAN(X) = PI/2
	MOVSI	CC, (1.0)	;FORM 1.0 IN CC
	CAMG	BB, CC		;IS ABSF(X) GREATER THAN 1.0?
	TRZA	DD, -1		;IF BB .LE. 1.0, THEN RH(DD) = 0
	FDVM	CC, BB		;BB IS REPLACED BY 1.0/BB
	TLC	DD, (DD)	;XOR SIGN WITH .G. 1.0 INDICATOR
	PUSH	P,BB		;SAVE THE ARGUMENT
	FMP	BB, BB		;GET BB↑2
	MOVE	CC, KB3		;PICK UP A CONSTANT
	FAD	CC, BB		;ADD BB↑2
	MOVE	AA, KA3		;ADD IN NEXT CONSTANT
	FDVM	AA, CC		;FORM -A3/(B↑2 + B3)
	FAD	CC, BB		;ADD BB↑2 TO PARTIAL SUM
	FAD	CC, KB2		;ADD B2 TO PARTIAL SUM
	MOVE	AA, KA2		;PICK UP -A2
	FDVM	AA, CC		;DIVIDE PARTIAL SUM BY -A2
	FAD	CC, BB		;ADD BB↑2 TO PARTIAL SUM
	FAD	CC, KB1		;ADD  B1 TO PARTIAL SUM
	MOVE	AA, KA1		;PICK UP A1
	FDV	AA, CC		;DIVIDE PARTIAL SUM BY A1
	FAD	AA, KB0		;ADD B0
	FMP	AA,(P)		;MULTIPLY BY ORIGINAL ARGUMENT
	TRNE	DD, -1		;CHECK .G. 1.0 INDICATOR
	FSB	AA, PIOT	;ATAN(AA) = -(ATAN(1/AA)-PI/2)
;; #PV# ! (2 OF 3) JRL BOTH PATHS TO AT4 SHOULD LEAVE STACK SAME HEIGHT
	SUB	P,X11
	SKIPA	0,0		;SKIP
AT4:	MOVE	AA, PIOT	;GET PI/2 AS ANSWER
	SKIPGE	DD		;LH(DD) = -SGN(BB) IF BB GREATER THAN 1.0
	MOVNS	AA		;NEGATE ANSWER
;; #PV# ! (3 OF 3) USED TO BE SUB P,X33 BUT NOW STACK DECREMENTED EARLIER
EXIT:	SUB	P,X22
	JRST	@2(P)

A1:	145000000000		;2**-33
A2:	233000000000		;2**33
KB0:	176545543401		;0.1746554388
KB1:	203660615617		;6.762139240
KB2:	202650373270		;3.316335425
KB3:	201562663021		;1.448631538
KA1:	202732621643		;3.709256262
KA2:	574071125540		;-7.106760045
KA3:	600360700773		;-0.2647686202
PIOT:	201622077325		;PI/2


BEND ATAN$
;FLOATING POINT SINGLE PRECISION ARCSINE FUNCTION
;---------------------------------------------------------
;THE ARCSINE IS CALCULATED WITH THE FOLLOWING ALGORITHM:

;	ASIN(X) = ATAN(X/SQRT(1-X↑2))

;THE RANGE OF DEFINITION FOR ASIN IS (-1.0,1.0)
;OTHER ARGUMENTS WILL CAUSE AN ERROR MESSAGE TO BE
;TYPED AND AN ANSWER OF ZERO TO BE RETURNED.
;CALLING SEQUENCE:
;	PUSH	P,ARG
;	PUSHJ	P,$ASIN
;
;RESULT RETURNED IN AC 1.
;
;
BEGIN ASIN$

	AA←13
	BB←1

HERE(ASIN$) 			;ENTRY TO ASIN ROUTINE
	MOVM	BB,-1(P)	;GET MAGNITUDE OF ARG. IN BB
	CAMLE	BB,ONE		;IS THE MAGNITUDE OF THE ARG. LE 1.0?
	JRST	TOOLRG		;NO, GO TO ERROR RETURN.
	MOVN	AA,-1(P)	;GET THE NEGATIVE OF ARG
	FMP	AA,-1(P)	;CALCULATE -(X↑2)
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP
				;ON UNDERFLOW, THE SPECIAL INTERRUPT
				;CODE SETS AA TO 0
	FAD	AA, ONE		;CALCULATE 1-(X↑2)
	JUMPE	AA, ASIN1	;WAS X EITHER -1.0 OR 1.0?
	PUSH	P,AA		;NO,
	PUSHJ	P,SQRT$		;CALCULATE SQRT(1-X↑2)
	MOVE	AA,-1(P)	;GET THE ARGUMENT BACK AGAIN
	FDV	AA,BB		;CALCULATE X/SQRT(1-X↑2)
	PUSH	P,AA		;THEN
	PUSHJ	P,ATAN$		;CALCULATE ATAN(X/SQRT(1-X↑2)),.
EXIT:	SUB	P,X22
	JRST	@2(P)

TOOLRG:	ERR <ASIN: Argument mangitude greater than 1.0; 0 returned>,1
	TDZA	BB,BB
ASIN1:	MOVE	BB, PIOT	;ANSWER IS EITHER PI/2 OR-PI/2
	SKIPG	-1(P)		;WAS ORIGINAL ARGUMENT POSITIVE?
	MOVNS	BB		;NO, GET -PI/2
	JRST	EXIT

PIOT:	201622077325		;PI/2
ONE:	1.0

BEND ASIN$
;FLOATING POINT SINGLE PRECISION ARCCOSINE FUNCTION

;ACOS(X) IS CALCULATED IN THE FOLLOWING MANNER:
;	IF X GREATER THAN 0,	ACOS(X)=ATAN((SQRT(1-X↑2))/X)
;	IF X LESS THAN 0,	ACOS(X)=PI + ATAN((SQRT(1-X↑2))/X)
;	IF X = 0,	ACOS(X)=PI/2

;THE RANGE OF DEFINITION FOR ACOS IS -1.0 TO +1.0.
;ARGUMENTS OUTSIDE OF THIS RANGE WILL CAUSE AN ERROR MESSAGE
;TO BE TYPED AND WILL RETURN AN ANSWER OF ZERO.

;THE CALLING SEQUENCE FOR ACOS IS:

;	PUSH	17,ARG
;	PUSHJ	17,$ACOS
;THE RESULT IS RETURNED IN AC 1


BEGIN ACOS$

HERE(ACOS$)			;ENTRY TO ACOS ROUTINE.
	MOVM	1,-1(P)		;GET /ARG./ IN AC 1.
	CAMLE	1,ONE		;IS MAGNITUDE OF ARG. GT 1.0?
	JRST	TOOLRG		;YES, GO TO ERROR RETURN.
	JUMPE	1,ZERARG	;IF ARG=0, GO TO ZERARG.
	FMPR	1,1		;X↑2 IN AC 1.
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP
				;ON UNDERFLOW THE SPECIAL
				;INTERRUPT CODE WILL SET
				;AC 1 TO 0
	MOVNS	1		;-X↑2 IN AC 1.
	FAD	1,ONE		;1.0-X↑2 IN AC 1.
	PUSH	P,1
	PUSHJ	P,SQRT$		;CALC. $SQRT(1.0-X↑2).
	FDVR	1,-1(P)		;($SQRT(1.0-X↑2))/X IS IN AC 1.
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP
				;ON UNDERFLOW THE SPECIAL INTERRUPT
				;CODE WILL SET AC 1 TO 0
				;ON OVERFLOW AC 1 WILL BE SET
				;TO LARGEST MAGNITUDE WITH
				;CORRECT SIGN
	PUSH	P,1
	PUSHJ	P,ATAN$		;FIND $ATAN($SQRT(1.0-X↑2)/X).
	SKIPL	-1(P)		;SKIP IF ORIGINAL ARG LESS THAN 0.
	JRST	EXIT		;RETURN.
	FAD	1,PII		;ANSWER IS PI + ANSWER IN AC 1.
EXIT:	SUB	P,X22
	JRST	@2(P)

TOOLRG:	ERR <ACOS: Argument magnitude greater than 1.0;  0 returned>,1
	TDZA	1,1		;RETURN ZERO.
ZERARG:	MOVE	1,PI2		;ANSWER IS PI/2
	JRST	EXIT

ONE:	1.0
PI2:	201622077325
PII:	202622077325


BEND ACOS$
;FLOATING POINT SINGLE PRECISION ARCTANGENT OF TWO ARGUMENTS
;---------------------------------------------------------
;RETURNS ARCTANGENT OF A/B
;IF ARGUMENT IS IN 2ND QUADRANT, ATAN2(A/B) = PI + ATAN(A/B)
;IF ARGUMENT IS IN 3RD QUADRANT, ATAN2(A/B) = ATAN(A/B) - PI
;IF A/B OVERFLOWS (OR DIVIDE CHECK), THEN RETURN
;	+PI/2 IF A GREATER THAN= 0, AND
;	-PI/2 IF A LESS THAN 0.
;IF A/B UNDERFLOWS, THEN RETURN
;	0 IF B GREATER THAN= 0, AND
;	+PI IF B LESS THAN 0 AND A GREATER THAN= 0,
;	-PI IF B LESS THAN 0 AND A LESS THAN 0.

;THERE IS NO RESTRICTION ON THE ARGUMENTS

;THE ROUTINE IS CALLED  IN THE FOLLOWING MANNER:
;	PUSH	17,ARG1
;	PUSH	17,ARG2
;	PUSHJ	17,$ATAN2
;THE ANSWER IS RETURNED IN ACCUMULATOR 1.

BEGIN ATAN2$

	AA←13
	BB←1

HERE(ATAN2$) 			;ENTRY POINT TO ATAN2 ROUTINE
	JFOV	.+1		;CLEAR FLAGS FOR GOOD MEASURE (JAM)
	MOVE	AA,-2(P)	;PICK UP FIRST ARGUMENT
	MOVE	BB,-1(P)	;PICK UP SECOND ARGUMENT
	FDVR	AA, BB		;FORM AA/BB
	JFOV	OVUNFO		;EXTRA JFCL BECAUSE OF FDV HARDWARE BUG
	JFOV	OVUNFO		;SUPPRESS ERROR MESSAGE FROM
				;OVTRAP IF NECESSARY AND GO TO
				;OVUNFO IF AN EXCEPTION OCCURRED
				;SPECIAL INTERRUPT CODE SETS
				;OVPCWD AND RETURNS BEST VALUE
				;IT CAN IN A.
	PUSH	P,AA		;CALCULATE ATAN(AA/BB)
	PUSHJ	P,ATAN$
	SKIPL	-1(P)		;IF BB GREATER THAN 0, SGN(ATAN2)=SGN(A)
	JRST	EXIT		;EXIT
	JUMPGE	BB, ATAN2A	;IS BB POSITIVE?
	FADR	BB, PII		;NO, SECOND QUADRANT, ADD PI
EXIT:	SUB	P,X33
	JRST	@3(P)

ATAN2A:	FSBR	BB, PII		;YES,3RD QUADRANT, SUBTRACT PI
	JRST	EXIT		;EXIT
OVUNFO:	SKIPN	AA,OVPCWD	;PICK UP FLAGS.
	JSP	AA,.+1
	TLNE	AA,100		;SKIP IF OVERFLOW
	 JRST	 UNDER
	MOVE	BB,HALFPI	;ANSWER TO PI OVER 2
	SKIPGE	-2(P)		;SKIP IF ANS IS TO BE +
	 MOVNS	 BB
	JRST	EXIT

UNDER:	JUMPL	BB,BNEG
	MOVEI	BB,0
	JRST	EXIT		;RETURN 0
BNEG:	MOVE	BB,PII
	SKIPGE	-2(P)
	 MOVNS	 BB
	JRST	EXIT

PII:	202622077325		;PII
HALFPI:	201622077325		;PII/2

BEND ATAN2$

ENDCOM(TG2)

COMPIL(TG3,<TANH$,COSH$,SINH$>,<EXP$,X22,TRIGINI>,<HYPERBOLIC FUNCTIONS>)
;FLOATING POINT SINGLE PRECISION HYPERBOLIC TANGENT ROUTINE
;---------------------------------------------------------

;THIS ROUTINE CALCULATES THE TANH BY THE FOLLOWING ALGORITHM:
;IF ABSF(X) LESS THAN .00034, THEN TANH(X) = X
;IF ABSF(X) GREATER THAN 12.0, THEN TANH(X) = 1.0*SIGN(X)
;IF 0.17 LESS THAN= X LESS THAN 12.0, THEN TANH IS CALCULATED AS
;	TANH(X) = 1.0 - 2(1.0 + EXP(2*X))**-1
;IF .00034 LESS THAN= X LESS THAN 0.17, THEN TANH IS CALCULATED AS
;TANH(X) = F(A+F↑2(B+C(D+F↑2)**-1))**-1
;WHERE X = 4*LOG(E)  (BASE 2)

;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
;	PUSH	17,ARG
;	PUSHJ	17,$TANH
;THE ANSWER IS RETURNED IN ACCUMULATOR 1

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$
;FLOATING POINT SINGLE PRECISION HYPERBOLIC COSINE FUNCTION.
;---------------------------------------------------------

;COSH(X) IS CALCULATED AS FOLLOWS:
;	IF ABS(X) LESS THAN= 88.029,
;		COSH(X) = 1/2(EXP(X) + 1.0/EXP(X))
;	IF ABS(X) GREATER THAN 88.029 AND (ABS(X)-LN(2)) LESS THAN= 88.029,
;		COSH(X) = EXP(ABS(X)-LN(2))
;	IF (ABS(X)-LN(2)) GREATER THAN 88.029,
;		COSH(X)=377777777777
;		AND AN ERROR MESSAGE IS RETURNED.

;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
;	PUSH	17,ARG
;	PUSHJ	17,$COSH
;THE ANSWER IS RETURNED IN AC 1.

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$

;FLOATING POINT SINGLE PRECISION HYPERBOLIC SINE FUNCTION.
;---------------------------------------------------------

;SINH IS CALCULATED AS FOLLOWS:
;	IF ABS(X) GREATER THAN 88.029,
;		SINH(X)=(EXP[ABS(X)-LN(2)])*SIGN(X)
;	IF ABS(X) LESS THAN= 0.10,
;		SINH(X)=X+(X**3)/6+(X**5)/120
;	FOR ALL OTHER VALUES OF X,
;		SINH(X)=1/2[EXP(X)-1/EXP(X)]

;THE CALLING SEQUENCE IS:
;	PUSH	17,ARG
;	PUSHJ	17,$SINH

;THE ANSWER IS RETURNED IN AC 1.

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.
				;ON UNDERFLOW, SPECIAL INTERRUPT
				;CODE RETURNS 0.
	MOVEM	AA,SX2		;SAVE X↑2 IN SX2.
;#UF# ! USED TO BE FDVR 2,ONE120
	FDVR	AA,ONE120	;CALC.X↑2/120
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP.
				;ON UNDERFLOW, SPECIAL INTERRUPT
				;CODE RETURNS 0.
	FADR	AA,ONESIX	;CALC. (X↑2/120)+1/6
	FMPR	AA,SX2		;MULTIPLY IT BY X↑2.
	JFOV	.+1		;SUPPRESS ERROR MESSAGE FROM OVTRAP.
				;ON UNDERFLOW SPECIAL INTERRUPT
				;CODE RETURNS 0.
	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)
>;NOLOW