/27-BIT EXTENDED FUNCTIONS

/5-23-72       R BEAN

/COPYRIGHT     1972 DIGITAL EQUIPMENT CORPORATION,MAYNARD, MASS. 01754

/DEC-08-NFPEA-A	VERSION 1

	EXP=44
	HORD=45
	LORD=46

FIXFLT=5500
	*FIXFLT

	/******FIX******
/ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO
/A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44)

FFIX,	0
	JMS I SPLITA	/SPLIT UP FAC (UNPACK IT)
	DCA I SPLTFK	/CLEAR SPLIT FLAG!!
	TAD EXP		/FETCH EXPONENT
	TAD FTRPRT	/SUBTRACT THE BIAS
	SZA SMA		/IS NUMBER <1?
	 JMP .+3	/NO-CONTINUE ON
FTRPRT,	7600		/CLA=-200
	JMP FIXDNE	/YES-FIX IT TO ZERO
	TAD M13		/SET BINARY POINT AT 11 PLACES TO
	SMA SZA		/RIGHT OF CURRENT POINT IS # TOO BIG?
	 JMP I OTRAPA	/YES-TAKE OVERFLOW TRAP
	TAD M4		/NO-ADD 4 SINCE AC1 HAS SOME BITS
	DCA EXP		/SET SCALE COUNT
FIXLP,	JMS I AR1A	/SHIFT FAC RIGHT 1 PLACE
	DCA LORD	/ZERO LORD SO OV WILL BE 0
	ISZ EXP		/DONE YET?
	 JMP FIXLP	/NO
	TAD TM		/YES-PUT SIGN OF MANTISSA
	CLL RAL		/IN LINK
	TAD HORD	/GET HIGH ORDER MANTISSA
	SZL		/WAS ORIGINAL # NEGATIVE?
	  CLL CMA IAC	/YES-NEGATE THIS AND CLR. LINK
FIXDNE,	DCA EXP		/RETURN WITH ANSWER IN 44
	JMP I FFIX	/RETURN

M4,	-4		/-4 DECIMAL
M13,	-13		/-11 DECIMAL

/******FLOAT******
/ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC

FFLOAT,	0
	CLL
	TAD EXP
	SPA 		/IS IT NEGATIVE?
	  CML CMA IAC	/YES-MAKE POSITIVE AND SET LINK
	DCA HORD	/PUT NUMBER IN HI MANTISSA
	DCA LORD	/CLEAR LOW MANTISSA
	RAR		/ROTATE SIGN FROM LINK
	TAD C2170	/15(10)+ SIGN INTO EXPONENT
	DCA EXP
	JMS I FNORL	/NORMALIZE
	JMP I FFLOAT	/RETURN
FNORL,	FFNOR		/LINK TO NORMALIZE ROUTINE
C2170,	2170		/15 DECIMAL
OTRAPA,	FTRP1		/ADDRESS OF VECTOR FOR OVERFLOW TRAP

LOGC5,	2004		/.59897865
	6253
	2522
LN2,	2005		/.69314718
	4271
	0300
TOVPI,	2005		/.6366198 = 2/PI
	0574
	6033
TEMP1,	0
	0
	0
TEMP2,	0		/TWO TEMP STORAGE BLOCKS FOR FUNCTIONS
	0
	0
SPLTFK,	SPLTFG
SPLITA,	SPLIT
AR1A,	AR1
*FIXFLT-500

/******SINE******

SIN,	0
	JMS NHNDLE	/IF X<0,NEGATE X AND SET NFLAG
	JMS I FMPYL	/X*2/PI
	  TOVPI
	JMS FRACT	/SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC
	TAD NUM		/GET INTEGER PART OF (2/PI)*X
	AND C3		/ISOLATE BITS 10,11
	TAD JMPI
	DCA .+1		/MAKE JUMP TO ARGUMENT REDUCING ROUTINE
	JMP .		/AND ADJUST ARG ACCORDING TO QUADRANT OF X
JMPI,	JMP I QDTBL

QUAD2,	JMS I FSUB1L	/1-X
	  ONE
	JMP POLYSN	/CALCULATE SIN(1-X)
QUAD3,	JMS I FNEGL	/-X
	JMP POLYSN	/CALCULATE SIN(-X)
QUAD4,	JMS I FSUBL	/X-1
	  ONE
POLYSN,	JMS I FPUTL	/SAVE X
	  TEMP1
	JMS I FSQRL	/U=X**2
	JMS I FPUTL	/SAVE U
	  TEMP2
	JMS I FMPYL	/A9(U)
	  SINA9
	JMS I FADDL	/A7+A9(U)
	  SINA7
	JMS I FMPYL	/A7(U)+A9(U**2)
	  TEMP2
	JMS I FADDL	/A5+A7(U)+A9(U**2)
	  SINA5
	JMS I FMPYL	/A5(U)+A7(U**2)+A9(U**3)
	  TEMP2
	JMS I FADDL	/A3+A5(U)+A7(U**2)+A9(U**3)
	  SINA3
	JMS I FMPYL	/A3(U)+A5(U**2)+A7(U**3)+A9(U**4)
	  TEMP2
	JMS I FADDL	/A1+A3(U)+A5(U**2)+A7(U**3)+A9(U**4)
	  PIOV2
	JMS I FMPYL	/A1(X)+A3(X**3)+A5(X**5)+A7(X**7)+A9(X**9)
	  TEMP1
	JMS NCHK	/IF NFLAG IS SET,SET SIN(X)=-SIN(X)
	JMP I SIN	/FAC=SIN(X)


/******COSINE******
/USES SIN ROUTINE TO CALCULATE COS(X)

COS,	0
	JMS I FADDL	/COS(X)=SIN(PI/2+X)
	  PIOV2
	JMS SIN
	JMP I COS	/RETURN

QDTBL,	POLYSN		/X IN QUAD1,SIN(X)=SIN(X)
	QUAD2		/X IN QUAD2,SIN(X)=SIN(1-X)
	QUAD3		/X IN QUAD3,SIN(X)=SIN(-X)
	QUAD4		/X IN QUAD4,SIN(X)=SIN(X-1)
FGETL,	FFGET
FADDL,	FFADD
FMPYL,	FFMPY
FPUTL,	FFPUT
FDIVL,	FFDIV
FSUB1L,	FFSUB1
FNEGL,	FFNEG
FSUBL,	FFSUB
FSQRL,	FFSQ
FIXL,	FFIX
FLOATL,	FFLOAT
FDIV1L,	FFDIV1
C3,	3
/ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC
/ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS
/SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC

FRACT,	0
	JMS I FPUTL	/SAVE X
	  TEMP1
	JMS I FIXL	/INTEGER PORTION OF X
	TAD EXP
	DCA NUM		/SAVE FIXED FORTION OF X
	JMS I FLOATL	/FAC=FLOAT(FIX(X))
	JMS I FSUB1L	/FAC=X-INT(X)=FRACTION (X)
	  TEMP1
	JMP I FRACT	/RETURN

/ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS
/SET TO 1

NHNDLE,	0
	TAD EXP		/GET SIGN OF MANTISSA
	SMA CLA		/IS IT <0?
	 JMP NFLGST	/NO-CLEAR NFLAG
	JMS I FNEGL	/YES-NEGATE FAC
	IAC		/AND SET NFLAG
NFLGST,	DCA NFLAG
	JMP I NHNDLE

/ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0

NCHK,	0		/LOC ALSO USED FOR TEMP STORAGE
	TAD NFLAG
	SZA CLA		/IS NFLAG=0?
	 JMS I FNEGL	/NO-NEGATE FAC
	JMP I NCHK	/YES-RETURN

	NUM=NCHK
SPLITZ,	SPLIT
STICKZ,	STICK
KK10,	10
*SIN+135

/******EXPONENTIAL******

EXPON,	0		/LOC USED FOR TEMP STORAGE BY SIN,ARCTAN
	JMS I FMPYL	/Y=XLOG2(E)
	  LOG2E
	JMS FRACT	/GET FRACTIONAL PART OF Y
	JMS I FMPYL	/(FRACTION(Y))*(LN2/2)
	  LN2OV2
	JMS I FPUTL	/SAVE Y
	  TEMP1
	JMS I FSQRL	/Y**2
	JMS I FADDL	/B1+Y**2
	  EXPB1
	JMS I FDIV1L	/A1/(B1+Y**2)
	  EXPA1
	JMS I FADDL	/A0+A1/(B1+Y**2)
	  EXPA0
	JMS I FSUBL	/A0-Y+A1/(B1+Y**2)
	  TEMP1
	JMS I FPUTL	/SAVE
	  TEMP2
	JMS I FGETL	/GET Y
	  TEMP1
	TAD KK10	/MULT BY 2=2Y
	TAD EXP
	DCA EXP		/(DONE BY ADDING 1 TO EXP.)
	JMS I FDIVL	/2Y/(A0-Y+A1/(B1+Y**2))
	  TEMP2
	JMS I FADDL	/1+2Y/(AO-Y+A1/(B1+Y**2))
	  ONE
	JMS I FSQRL	/[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y)
	JMS I SPLITZ	/SPLIT FAC
	TAD NUM
	TAD EXP		/EXP(X)=(2**N)(EXPY)
	DCA EXP
	JMS I STICKZ	/REPACK FAC
	JMP I EXPON	/FAC=EXPON(X)

	NFLAG=EXPON

	*SIN+200

/******ARC TANGENT******

ATAN,	0
	JMS I NHNDLL	/IF X<0,SET NFLAG AND NEGATE
	JMS I FPUTM	/SAVE X
	  TEMP1
	JMS I FSUBM	/X-1
	  ONE
	TAD EXP		/GET SIGN OF MANTISSA
	SPA CLA		/WAS X>1?
	 JMP ARGPOL	/NO-CLEAR GT1FLG
	JMS I FGETM	/YES-ATAN(X)=PI/2-ATAN(1/X)
	  ONE
	JMS I FDIVM	/1/X
	  TEMP1
	JMS I FPUTM
	  TEMP1
	IAC		/SET GT1FLG
ARGPOL,	DCA GT1FLG
	JMS I FGETM	/GET X OR 1/X
	  TEMP1
	JMS I FSQRM	/Y**2
	JMS I FPUTM	/SAVE
	  TEMP2
	JMS I FADDM	/Y**2+B3
	  ATANB3
	JMS I FDIV1M	/A3/(Y**2+B3)
	  ATANA3
	JMS I FADDM	/B2+A3/(Y**2+B3)
	  ATANB2
	JMS I FADDM	/Y**2+B2+A3/(Y**2+B3)
	  TEMP2
	JMS I FDIV1M	/A2/(Y**2+B2+A3/(Y**2+B3))
	  ATANA2
	JMS I FADDM	/B1+A2/(Y**2+B2+A3/(Y**2+B3))
	  ATANB1
	JMS I FADDM	/Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))
	  TEMP2
	JMS I FDIV1M	/A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
	  ATANA1
	JMS I FADDM	/B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
	  ATANB0
	JMS I FMPYM	/ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))))
	  TEMP1
	TAD GT1FLG	/WAS X>1?
	SNA CLA
	 JMP NGT	/NO-TEST IF X<0?
	JMS I FSUB1M	/ATAN(X)=PI/2-ATAN(1/X)
	  PIOV2
NGT,	JMS I NCHKL	/IF NFLAG SET,NEGATE FAC
	JMP I ATAN	/FAC=ATAN(X)
NHNDLL,	NHNDLE
NCHKL,	NCHK
/******NAPERIAN LOGARITHM******

	GTFLG=ATAN

LOG,	0
	TAD EXP
	SPA SNA		/X<0 OR X=0?
	 JMP I ARTRAP	/YES-TAKE ILLEGAL ARGUMENT TRAP
	TAD M2014	/IS EXP=2014?
	SNA
	TAD HORD	/YES-IS HORD=0?
	SNA
	TAD LORD	/YES-LORD=0?
	SZA CLA
	 JMP POLYNL	/NO-ARG IS LEGAL AND NOT 1
LTRPRT,	DCA EXP	
	JMP I LOG	/YES-LOG(1)=0
POLYNL,	JMS I SPLITS	/SPLIT UP FAC
	TAD EXP		/GET TRUE EXPONENT
	TAD M200
	DCA GTFLG	/SAVE EXPONENT FOR LATER
	TAD KK200
	DCA EXP		/ISOLATE MANTISSA IN FAC
	JMS I STICKS	/REPACK FAC
	JMS I FPUTM	/SAVE F
	  TEMP1
	JMS I FADDM	/F+SQR(.5)
	  SQRP5
	JMS I FPUTM	/SAVE
	  TEMP2
	JMS I FGETM
	  TEMP1
	JMS I FSUBM	/F-SQR(.5)
	  SQRP5
	JMS I FDIVM	/Z=F+SQR(.5)/F-SQR(.5)
	  TEMP2
	JMS I FPUTM
	  TEMP1
	JMS I FSQRM	/Z**2
	JMS I FPUTM
	  TEMP2
	JMS I FMPYM	/C5(Z**2)
	  LOGC5
	JMS I FADDM	/C3+C5(Z**2)
	  LOGC3
	JMS I FMPYM	/C3(Z**2)+C5(Z**4)
	  TEMP2
	JMS I FADDM	/C1+C3(Z**2)+C5(Z**4)
	  LOGC1
	JMS I FMPYM	/C1(Z)+C3(Z**3)+C5(Z**5)
	  TEMP1
	JMS I FSUBM	/C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F)
	  ONEHAF
	JMS I FPUTM	/SAVE LOG2(F)
	  TEMP2
	TAD GTFLG	/I
	DCA EXP		/SET UP FLOAT
	JMS I FLOATM
	JMS I FADDM	/I+LOG2(F)
	  TEMP2
	JMS I FMPYM	/[I+LOG2(F)]*LOGE(2)=LOGE(X)
	  LN2
	JMP I LOG	/FAC=LN(X)

	GT1FLG=LOG
FPUTM,	FFPUT
FMPYM,	FFMPY
FADDM,	FFADD
FDIVM,	FFDIV
FDIV1M,	FFDIV1
FSUBM,	FFSUB
FSUB1M,	FFSUB1
FSQRM,	FFSQ
FLOATM,	FFLOAT
FGETM,	FFGET
ARTRAP,	FTRP3
M2014,	-2014
SPLITS,	SPLIT
M200,	-200
KK200,	200
STICKS,	STICK

/CONSTANTS USED BY VARIOUS FUNCTIONS

PIOV2,	2016		/1.57079633
	2207
	7325
SINA3,	6005		/-0.645963711
	1256
	7405
SINA5,	1755		/.079689679
	0632
	1276
SINA7,	5714		/-.00467376557
	6223
	1430
SINA9,	1644		/.00015148419
	7553
	6723
LOG2E,	2015		/1.442695
	6125
	0731
LN2OV2,	1775		/.34657359027
	4271
	0300
EXPB1,	2067		/60.0901907
	4056
	1326
EXPA1,	6124		/-601.804267
	5471
	5711
EXPA0,	2046		/12.01501675
	0036
	6021
ATANB0,	1765		/.174655439
	4554
	3400
ATANA1,	2027		/3.70925626
	3262
	1643
ATANB1,	2036		/6.7621392
	6061
	5620
ATANA2,	6037		/-7.10676005
	0665
	2236
ATANB2,	2026		/3.31633543
	5037
	3266
ATANA3,	5774		/-.264768620
	1707
	7005
ATANB3,	2015		/1.44863154	
	6266
	3017

SQRP5,	2005		/.707106781
	5202
	3630
LOGC1,	2025		/2.88539129
	6125
	1002
LOGC3,	2007		/.961470632
	5421
	3603
ONE,	2014		/1
	0
	0
ONEHAF,	2004		/.5
	0
	0

	FFSIN=SIN
	FFCOS=COS
	FFATN=ATAN
	FFLOG=LOG
	FFEXP=EXPON
PAUSE