TITLE 'LIB-B00,08/22/73,DWG702985' PAGE * * * E X T E R N A L C O M M U N I C A T I O N * * * DEFINITIONS * DEF CIRCULAR 'CIRCULAR' FUNCTION EVAL DEF FEXP FLOT EXPONENTIAL EVAL DEF FFLOG FLOT DYADIC LOGARITHM DEF FFPOWER FLOT BASE TO FLOT POWER EVAL DEF FIPOWER FLOT BASE TO INTG POWER EVAL DEF FLOG FLOT MONADIC LOGARITHM DEF FSQRT FLOT SQUARE ROOT DEF IIPOWER INTG BASE TO INTG POWER EVAL DEF LIB@ START OF PROCEDURE * * REFERENCES * REF ERDOMAIN DOMAIN ERROR REF F2I CONVERT FLOATING TO INTEGER REF INTGOVFL INTEGER OVERFLOW (DOMAIN CHANGE) REF LIBTEMPS TEMPS ARE IN WINDOW IN APLUTSI U07-0004 PAGE * * * A S S E M B L Y P A R A M E T E R S * * SYSTEM SIG5F PROGSECT CSECT 1 * * REGISTERS * N EQU 3 INDEX REG LX EQU 5 INDEX LINK REG AI EQU 7 LEFT ARG INTG BI EQU 9 RIGHT ARG INTG CI EQU 13 EXTRA INTG AF EQU 6 LEFT ARG FLOT AF1 EQU 7 * BF EQU 8 RIGHT ARG FLOT BF1 EQU 9 * CF EQU 12 EXTRA FLOT CF1 EQU 13 * FL EQU 14 FLAG REG PAGE * * * P R O C S * * TLOC SET 0 U07-0006 * TEMP CNAME 1 DTEMP CNAME 2 PROC DO1 NAME=2 TLOC SET TLOC+(TLOC&1) U07-0009 DISP TLOC U07-0010 LF EQU LIBTEMPS+TLOC U07-0011 TLOC SET TLOC+NAME U07-0012 PEND * * EVEN CNAME 0 ODD CNAME 1 PROC LF EQU % ERROR,1,(CF(2)+NAME)&1 'REGISTER HAS WRONG PARITY' PEND * * EQUAL CNAME PROC LF EQU % ERROR,1,1-(CF(2)=CF(3)) 'REGISTERS MUST BE EQUAL' PEND PAGE * * * F U N C T I O N E V A L U A T O R S * * * THE FUNCTION EVALUATION SUBROUTINES MUST NOT CLOBBER * REGISTERS 1, 2, 4, 10, 11 (KNOWN BY XSEG-GENERATING * MODULES AS N, K, N1, N2, AND N3). * * USECT PROGSECT LIB@ RES 0 START OF PROCEDURE * * * CIRCULAR FUNCTION JUMP TABLE * * CALLED BY 'BAL,LX CIRCULAR,X' WITH LEFT ARG (INTEGER * BETWEEN -7 AND +7) IN X AND RIGHT ARG IN AF/AF1. * RESULT RETURNED IN AF/AF1. * CIRCULAR EQU %+7 B FARCTANH -7 B FARCCOSH -6 B FARCSINH -5 B FCIRCM4 -4 B FARCTAN -3 B FARCCOS -2 B FARCSIN -1 B FCIRC0 0 B FSIN +1 B FCOS +2 B FTAN +3 B FCIRC4 +4 B FSINH +5 B FCOSH +6 B FTANH +7 PAGE * * * DOUBLE PRECISION SINE FSIN * DOUBLE PRECISION COSINE FCOS * * CONSTANTS * BOUND 8 C0MC0 DATA X'3A27311C',-X'3A27311C' +-RT(6/16**14)=0.9125056E-8 S5 DATA X'C3C39FF1',X'C5110D64' -0.359864337061349258D-5 S4 DATA X'3DA83C17',X'ED1FC206' 0.160441150747149909D-3 S3 DATA X'C0ECD2D3',X'31D1A201' -0.468175413234161887D-2 S2 DATA X'401466BC',X'677587FA' 0.796926262460430410D-1 S1 DATA X'BF5AA218',X'CED20DF6' -0.645964097506244317 S0 DATA X'411921FB',X'54442D18' 1.57079632679489662 C5 DATA X'C2E59363',X'E0BB8C31' -0.252001354549174792D-4 C4 DATA X'3E3C3E9F',X'6C141B84' 0.919259950095279119D-3 C3 DATA X'C0AA8B0E',X'09009BCE' -0.208634807349535199D-1 C2 DATA X'4040F07C',X'206C1E1C' 0.253669507899865139 C1 DATA X'BEEC42C3',X'3641BA75' -1.23370055013615135 C0 DATA X'40FFFFFF',X'FFFFFFFD' 0.999999999999999953 MASK DATA X'3FFFFFF' MC6 DATA X'C4830908' -C6 C6 DATA X'3B7CF6F8' 0.465529873E-6 S6 DATA X'3AF1F9C8' 0.563393613E-7 SPACE 3 FSIN RES 0 SINE ENTRY CLM,AF C0MC0 CHECK FOR VERY SMALL X BCS,2 2A3 BRANCH IF LARGE POSITIVE BCS,4 2A1 BRANCH IF LARGE NEGATIVE B 0,LX RETURN X FOR SIN(SMALL X) SPACE 3 FCOS RES 0 COSINE ENTRY LI,FL X'100' INDICATE COSINE - ROTATE 1 QUADRANT CLM,AF C0MC0 CHECK FOR VERY SMALL X BCS,2 2A4 BRANCH IF LARGE POSITIVE BCS,4 2A2 BRANCH IF LARGE NEGATIVE LD,AF ONE RETURN 1.0D0 B 0,LX FOR COS(SMALL X) 2A1 LW,FL ONE INDICATE SIN(NEGATIVE) 2A2 FML,AF M2OPI CONVERT TO QUADRANTS, CHANGE SIGN B 3A1 PROCEED 2A3 LI,FL 0 INDICATE SIN(POSITIVE) 2A4 FML,AF 2OPI CONVERT TO QUADRANTS 3A1 LB,N AF BIASED EXPONENT AI,N -X'4E' CHECK FOR SIGNIFICANCE BLZ 3A3 BRANCH IF OK B ERDOMAIN ERROR 3A3 AI,N X'E' UNBIASED EXPONENT BLZ 3A7 BRANCH IF < 1/16 QUADRANT SLS,N 2 MULTIPLY BY 4 SLD,AF 0,N SCALE B7 AND,AF MASK MOD 4 NUMBER OF QUADRANTS AH,FL AF NUMBER OF QUADRANTS WITH COS MOD CI,FL X'200' CHECK UPPER/LOWER SEMICIRCLE BAZ %+2 SKIP IF UPPER EOR,FL ONE INVERT SIGN CHANGE FLAG CI,FL X'80' FRACTION : 0.5 BAZ 3A6 BRANCH IF < 0.5 LI,N X'BF' INSERT STB,N AF EXPONENT CI,FL X'4100' CHECK SIGN CHANGE AND EVEN/ODD QUAD. BL 3A4 BRANCH IF NO SIGN CHANGE BANZ 4A6 BRANCH IF ODD QUADRANT 4A1 FML,AF AF H=F*F 4A3 STD,AF TEMP0 COPY H 4A4 FMS,AF MC6 NEGATIVE FSL,AF C5 COSINE FML,AF TEMP0 *H,-C(I) FSL,AF C4 FML,AF TEMP0 FSL,AF C3 FML,AF TEMP0 FSL,AF C2 FML,AF TEMP0 FSL,AF C1 FML,AF TEMP0 FSL,AF C0 B 0,LX RETURN 3A4 BAZ 4A11 BRANCH IF EVEN QUADRANT 3A5 LCD,AF AF NEGATIVE FOR SINE EXPANSION 4A6 RES 0 PLACE 4A8 STD,AF TEMP0 COPY F FML,AF TEMP0 H=F*F STD,AF TEMP2 COPY H 4A9 FMS,AF S6 SINE FAL,AF S5 POLYNOMIAL FML,AF TEMP2 *H,+S(I) FAL,AF S4 FML,AF TEMP2 FAL,AF S3 FML,AF TEMP2 FAL,AF S2 FML,AF TEMP2 FAL,AF S1 FML,AF TEMP2 FAL,AF S0 FML,AF TEMP0 *F B 0,LX RETURN 3A6 LI,N X'40' INSERT STB,N AF EXPONENT 3A7 CI,FL X'4100' CHECK SIGN CHANGE AND ODD/EVEN QUAD. BL 3A8 BRANCH IF NO SIGN CHANGE BANZ 4A1 BRANCH IF ODD QUADRANT OR,AF1 =1 FORCE NON-ZERO MANTISSA B 3A5 NEGATIVE RESULT, USE SIN EXPANSION 3A8 BAZ 4A6 BRANCH IF EVEN QUADRANT 4A11 FML,AF AF H=F*F 4A13 STD,AF TEMP0 COPY H 4A14 FMS,AF C6 POSITIVE FAL,AF C5 COSINE FML,AF TEMP0 *H,+C(I) FAL,AF C4 FML,AF TEMP0 FAL,AF C3 FML,AF TEMP0 FAL,AF C2 FML,AF TEMP0 FAL,AF C1 FML,AF TEMP0 FAL,AF C0 B 0,LX RETURN PAGE * * DOUBLE PRECISION TANGENT FTAN * * CONSTANTS * OPEN C0MC0 BOUND 8 X4140 DATA X'41000000',FS'0.25' 1,.25 A9 DATA,8 FL'1.75402692800053906' A8 DATA,8 FL'1.20545135789649175' A7 DATA,8 FL'1.27837471033592976' A6 DATA,8 FL'1.27300750870003719' A5 DATA,8 FL'1.27324841140728890' A4 DATA,8 FL'1.27326113329539502' A3 DATA,8 FL'1.27343712586329919' A2 DATA,8 FL'1.27508201993348727' A1 DATA,8 FL'1.29192819501250237' A0 DATA,8 FL'1.57079632679489662' C0MC0 DATA X'3A1BB67B',-X'3A1BB67B' +-RT(3)/16**7=0.64523921E-8 2OPI DATA X'40A2F983',X'6E4E4415' 2/PI=.636619772367581343 M2OPI DATA X'BF5D067C',X'91B1BBEB' -2/PI SPACE 3 FTAN RES 0 ENTRY CLM,AF C0MC0 CHECK FOR VERY SMALL X BCS,2 2B1 BRANCH IF LARGE POSITIVE BCS,4 1B1 BRANCH IF LARGE NEGATIVE B 0,LX TAN(SMALL X)=X 1B1 LI,FL 1 INDICATE NEGATIVE X FML,AF M2OPI CONVERT TO QUADRANTS, CHANGE SIGN B 3B1 PROCEED 2B1 LI,FL 0 INDICATE POSITIVE X FML,AF 2OPI CONVERT TO QUADRANTS 3B1 LB,N AF EXPONENT TO INDEX CLM,AF X4140 X : 1.0,0.25 BCS,4 6B1 BRANCH IF X<0.25 BCR,2 5B1 BRANCH IF X<1.0 CI,N X'4E' CHECK MAGNITUDE BL 4B1 BRANCH IF OK B ERDOMAIN ERROR 4B1 SLS,N 2 MULTIPLY BY 4 SLD,AF 0,N SCALE B7 CW,AF =X'01000000' CHECK ODD/EVEN QUADRANT BAZ %+2 SKIP IF EVEN AI,FL 9 ODD QUAD - INVERT SIGN CHANGE 5B1 CW,AF =X'00800000' : 0.5 BAZ %+3 SKIP IF < 0.5 LCD,AF AF 1-FRACTION EOR,FL =8 INVERT QUADRANT INDICATOR LI,N X'40' INSERT STB,N AF EXPONENT 6B1 RES 0 PLACE 6B3 CW,AF X4140+1 :0.25 BLE %+3 BRANCH IF OK LI,N -1 INDICATE > 0.25 FSL,AF HALF F-0.5 STD,AF TEMP0 COPY X FML,AF TEMP0 Z=X*X STD,AF TEMP2 COPY Z FML,AF A9 POLY- FAL,AF A8 NOMIAL FML,AF TEMP2 OF ODD POWERS FAL,AF A7 FML,AF TEMP2 FAL,AF A6 FML,AF TEMP2 FAL,AF A5 FML,AF TEMP2 FAL,AF A4 FML,AF TEMP2 FAL,AF A3 FML,AF TEMP2 FAL,AF A2 FML,AF TEMP2 FAL,AF A1 FML,AF TEMP2 FAL,AF A0 FML,AF TEMP0 X AI,N 0 CHECK FOR 0.5 BGEZ 6B5 BRANCH IF NOT LCD,BF AF -V (POSITIVE) FAL,BF ONE 1-V FAL,AF HALF ADD FAL,AF HALF 1.0D0 FDL,AF BF (1-V)/(1+V) 6B5 RES 0 PLACE 6B7 CI,FL 5 IFLAG : 5 BL 8B1 BRANCH IF ABS(RESULT)<1 BAZ 7B1 BRANCH IF NON-NEGATIVE RESULT LCD,BF AF -P B 7B2 PROCEED 7B1 LD,BF AF P 7B2 LD,AF ONE FDL,AF BF RESULT B 0,LX RETURN 8B1 BAZ 0,LX RETURN IF POSITIVE LCD,AF AF CHANGE SIGN B 0,LX RETURN PAGE * * DOUBLE PRECISION ARCSINE FARCSIN * DOUBLE PRECISION ARCCOSINE FARCCOS * * CONSTANTS * BOUND 8 X40 DATA X'40000000' BIAS BIT X208 DATA FX'32.5B7' TO CORRECT BIAS AND ADD 1/2 ONEM DATA X'40FFFFFF',-1 1-2**(-56) SPACE 3 FARCCOS RES 0 ARCCOSINE ENTRY OR,LX X40 INDICATE ARCCOSINE SPACE 3 FARCSIN RES 0 ARCSINE ENTRY 1C2 STD,AF TEMP6 COPY X LCD,BF TEMP6 -X 1C3 BLEZ 1C5 BRANCH IF X>=0.0D0 CD,BF ONE ABS(X) : 1.0D0 BL 5C1 BRANCH IF LESS BE 3C1 BRANCH IF EQUAL B ERDOMAIN ERROR 1C5 CD,AF ONE X : 1.0D0 BL 6C1 BRANCH IF LESS BG ERDOMAIN ERROR IF GREATER CW,LX X40 CHECK FN. IND. BAZ 2C1 BRANCH IF ASIN LI,AF 0 ACOS(1)=0, LSH ALREADY 0 B 0,LX RETURN 2C1 LD,AF PI2 ASIN(1)=PI/2 B 0,LX RETURN 3C1 CW,LX X40 CHECK FN. IND. BAZ 4C1 BRANCH IF ASIN LD,AF PI ACOS(-1)=PI B 0,LX RETURN 4C1 LCD,AF PI2 ASIN(-1)=-PI/2 B 0,LX RETURN 5C1 CW,BF X40 ABS(X) : 1/16 BAZ 7C1 BRANCH IF LESS SLD,BF -1 OBTAIN AW,BF X208 (1+ABS(X))/2 LI,N X'40' AND STB,N AF 1-ABS(X) B 8C2 PROCEED 6C1 CW,AF X40 X : 1/16 BANZ 8C1 BRANCH IF NOT LESS 7C1 EQU % FML,AF BF -X*X FAL,AF ONEM 1-X*X B 9C1 PROCEED 8C1 SLD,AF -1 OBTAIN AW,AF X208 (1+X)/2 LI,N X'40' AND STB,N BF 1-X 8C2 FML,AF BF (1-X*X)/2 FAL,AF AF 1-X*X 9C1 RES 0 PLACE 9C3 STW,LX TEMP5 SAVE LINK 9C4 BAL,LX FSQRT Y=RT(1-X*X) 10A2 LW,LX TEMP5 RESTORE LINK CW,LX X40 CHECK FUNCTION INDICATOR BANZ 10C3 BRANCH IF ACOS LD,BF AF 2ND ARG= Y LD,AF TEMP6 1ST ARG = X 10C5 B FARCTAN2 OBTAIN RESULT FOR ASIN 10C3 LD,BF TEMP6 2ND ARG =X 10C4 B FARCTAN2 OBTAIN RESULT FOR ACOS PAGE * * DOUBLE PRECISION ARCTANGENT-1 ARGUMENT, 2 QUADRANT RESOLUTN. FARCTAN * DOUBLE PRECISION ARCTANGENT-2 ARGUMENTS, 4 QUADRNT RESOLUTN. FARCTAN2 * * CONSTANTS - DO NOT REORDER CONSTANTS * OPEN MASK,A4,A3,A2,A1,A0 BOUND 8 TABLE DATA,8 0 0.0D0 ATAN(0) ONE DATA,8 FL'1.0' 1.0D0 DATA X'401FD5BA',X'9AAC2F6E' .124354994546761435=ATAN(1/8) PI2 DATA X'411921FB',X'54442D18' 1.57079632679489656=PI/2 DATA X'403EB6EB',X'F25901BB' .244978663126864154=ATAN(1/4) PI DATA X'413243F6',X'A8885A30' 3.14159265358979312 DATA X'405BD865',X'07937BC2' .358770670270572220=ATAN(3/8) A4 DATA X'401C37E9',X'6B3C1CDF' .110228146248221286 DATA X'4076B19C',X'1586ED3E' .463647609000806116=ATAN(1/2) A3 DATA X'BFDB6DE9',X'65E1CA41' -.142854130388704964 DATA X'408F005D',X'5EF7F5A0' .558599315343562436=ATAN(5/8) A2 DATA X'40333333',X'212A84EB' .199999995801153276 DATA X'40A4BC7D',X'1934F709' .643501108793284387=ATAN(3/4) A1 DATA X'BFAAAAAA',X'AAACEB70' -.333333333331284232 DATA X'40B8053E',X'2BC2319E' .718829999621624505=ATAN(7/8) A0 DATA X'40FFFFFF',X'FFFFFFF5' .999999999999999840 DATA X'40C90FDA',X'A22168C2' .785398163397448310=ATAN(1) MASK DATA X'FFFE0000' MODULO 1/8 SPACE 3 FARCTAN RES 0 1 ARGUMENT ENTRY LD,BF ONE X=1.0D0 SPACE 3 FARCTAN2 RES 0 2 ARGUMENT ENTRY - USED BY * FARCSIN, FARCCOS 1D1 AI,AF 0 Y : 0.0 BG 10D1 BRANCH IF Y>0 BL 6D1 BRANCH IF Y<0 2D1 AI,BF 0 X : 0.0 4D1 BG 0,LX Y=0, X>0, ATAN(Y/X)=0.0D0 BL 12D1 BRANCH IF X<0 B ERDOMAIN ERROR 6D1 AI,BF 0 X:0 BGEZ 9D1 BRANCH IF X>=0 LI,FL 3 INDICATE 3RD QUADRANT CW,AF BF MSH(Y) : MSH(X) B 13D2 PROCEED 9D1 LCD,AF AF ABS(Y) LI,FL 1 INDICATE 4TH QUADRANT B 13D1 PROCEED 10D1 LI,FL 0 ASSUME 1ST QUADRANT AI,BF 0 X : 0.0 BGEZ 13D1 BRANCH IF X>=0 12D1 LI,FL 2 INDICATE 2ND QUADRANT LCD,BF BF ABS(X) 13D1 CW,BF AF MSH(X) : MSH(Y) 13D2 BGE 14D2 BRANCH IF FORMER >= LATTER 13D22 AI,FL 8 INDICATE NORTH/SOUTH OCTANT FDL,BF AF U=X/Y STD,BF TEMP0 COPY U LW,AF TEMP0 COPY MSH(U) B 15D1 PROCEED 14D2 FDL,AF BF U=Y/X STD,AF TEMP0 COPY U 15D1 FAS,AF ONE SCALE U AI,AF X'10000' ROUND TO AND,AF MASK NEAREST EIGHTH LH,N AF INDEX TO TABLE FSS,AF ONE V LI,AF1 0 CLEAR LSH LCD,BF AF -V FML,BF TEMP0 -V*U FSL,AF TEMP0 V-U FSL,BF ONE DENOMINATOR FDL,AF BF (U-V)/(U*V+1.0D0)=Z STD,AF TEMP0 COPY Z FML,AF TEMP0 U=Z*Z STD,AF TEMP2 COPY U 13D23 FML,AF A4 POLYNOMIAL FAL,AF A3 EXPANSION FML,AF TEMP2 *U+A(I) FAL,AF A2 FML,AF TEMP2 FAL,AF A1 FML,AF TEMP2 FAL,AF A0 FML,AF TEMP0 *Z 16D1 FAL,AF TABLE-X'4110'-X'4110',N DATAN=TABLE(J)+DATAN(Z) * ABOVE HEX CORRECTIONS COMPENSATE FOR 1.0 ADDED TO INDEX ABOVE 16D12 CI,FL 6 CHECK OCTANT AND SIGN OF X BL 16D3 BRANCH IF EAST/WEST OCTANT BAZ 16D2 BRANCH IF X POSITIVE FAL,AF PI2 +PI/2 16D14 AI,FL -10 BGZ 16D5 BRANCH IF Y NEGATIVE 16D15 B 0,LX RETURN 16D2 FSL,AF PI2 -PI/2 16D22 AI,FL -8 BEZ 16D5 BRANCH IF Y POSITIVE 16D23 B 0,LX RETURN 16D3 BAZ 16D4 BRANCH IF X POSITIVE FSL,AF PI -PI 16D32 AI,FL -2 BEZ 16D5 BRANCH IF Y POSITIVE 16D33 B 0,LX RETURN 16D4 RES 0 PLACE 16D42 AI,FL 0 BEZ 0,LX RETURN IF Y POSITIVE 16D5 LCD,AF AF CHANGE SIGN B 0,LX RETURN PAGE * * DOUBLE PRECISION HYPERBOLIC SINE FSINH * DOUBLE PRECISION HYPERBOLIC COSINE FCOSH * * CONSTANTS * OPEN A4,A3,A2,A1,A0 BOUND 8 C1MC1 DATA X'42AF5DC3',-X'42AF5DC3' +-175.36628- MCC DATA -X'404285FC',X'404285FC' -+ 0.26 A4 DATA X'3C2E4DF9',X'BDA9EEDB' .275996875723123788D-5 A3 DATA X'3DD00CEF',X'963E69E9' .198412447744192579D-3 A2 DATA X'3F222222',X'228C9C82' .833333333938590834D-2 A1 DATA X'402AAAAA',X'AAAA9C45' .166666666666615519 A0 DATA,8 FL'1.0' 1.0D0 TWENTY8 DATA FS'28.0' 28.0 SPACE 3 FSINH RES 0 HYPERBOLIC SINE ENTRY CLM,AF C1MC1 ABS(X) : 175.36628- BCR,6 2E1 BRANCH IF OK B ERDOMAIN ERROR 2E1 CLM,AF MCC ABS(X) : 0.26 2E3 BCS,8 7E1 BRANCH IF X > 0.26 BCS,1 4E1 BRANCH IF X < -0.26 STD,AF TEMP4 COPY X FML,AF TEMP4 Z=X*X STD,AF TEMP6 COPY Z 2E4 FML,AF A4 POLYNOMIAL FAL,AF A3 OF FML,AF TEMP6 ODD POWERS OF X FAL,AF A2 FML,AF TEMP6 FAL,AF A1 FML,AF TEMP6 FAL,AF A0 FML,AF TEMP4 FINAL FACTOR B 0,LX RETURN 4E1 FML,AF MLN2INV X=X/LN(2) STW,LX TEMP4 SAVE LINK 4E2 CW,AF TWENTY8 X : 28.0 BL 6E1 BRANCH IF RECIPROCAL IS SIGNIFICANT FSL,AF ONE TO DIVIDE RESULT BY 2.0D0 5E1 BAL,LX FEXP1 OBTAIN ABS(RESULT) LCD,AF AF SET NEGATIVE SIGN 5E3 B *TEMP4 RETURN 6E1 BAL,LX FEXP1 OBTAIN 2**X LCD,BF ONE -1.0 FDL,BF AF -1.0/2**X FAL,AF BF 2**X-1.0/2**X FML,AF MHALF RESULT 6E3 B *TEMP4 RETURN 7E1 FML,AF LN2INV X=X/LN(2) 7E2 CW,AF TWENTY8 X : 28.0 BL 8E1 BRANCH IF RECIPROCAL IS SIGNIFICANT 7E3 FSL,AF ONE TO DIVIDE RESULT BY 2.0D0 7E4 B FEXP1 OBTAIN RESULT 8E1 RES 0 PLACE 8E3 STW,LX TEMP4 SAVE LINK 8E4 BAL,LX FEXP1 OBTAIN 2**X LCD,BF ONE -1.0 9E7 FDL,BF AF -1.0/2**X FAL,AF BF 2**X-1.0/2**X FML,AF HALF RESULT 8E6 B *TEMP4 RETURN SPACE 3 FCOSH RES 0 HYPERBOLIC COSINE ENTRY LAD,AF AF ABS(X) CW,AF C1MC1 X : 175.36628- BG ERDOMAIN BRANCH IF RESULT OVERFLOWS FML,AF LN2INV X=X/LN(2) 9E2 CW,AF TWENTY8 X : 28.0 BGE 7E3 BRANCH IF X >= 28.0 9E5 STW,LX TEMP4 SAVE LINK 9E6 BAL,LX FEXP1 OBTAIN 2**X LD,BF ONE 1.0 B 9E7 PROCEED PAGE * * DOUBLE PRECISION HYPERBOLIC TANGENT FTANH * * CONSTANTS * OPEN AA,BB,CC,DD,EE BOUND 8 KMK DATA X'4213687B',-X'4213687B' +-28LN(2)=19.408121 CMC DATA X'4058B90C',-X'4058B90C' +-LN(2)/2=0.34657359 2OLN2 DATA X'412E2A8E',X'CA5705FC' 2/LN(2)=2.88539008177792682 M2OLN2 DATA X'BED1D571',X'35A8FA04' -2/LN(2) AA DATA,8 FL'3465.0' 3465.0D0 BB DATA,8 FL'189.0' 189.0D0 CC DATA,8 FL'10395.0' 10395.0D0 DD DATA,8 FL'1260.0' 1260.0D0 EE DATA,8 FL'21.0' 21.0D0 SPACE 3 FTANH RES 0 ENTRY CLM,AF KMK ABS(X) : 28LN(2) BCR,6 2F1 BRANCH IF LESS BCS,2 1F1 BRANCH IF X IS POSITIVE LCD,AF ONE X<-28LN(2), RESULT=-1.0D0 B 0,LX RETURN 1F1 LD,AF ONE X>28LN(2), RESULT=1.0D0 B 0,LX RETURN 2F1 CLM,AF CMC ABS(X) : LN(2)/2 BCS,2 4F1 BRANCH IF X>LN(2)/2 BCS,4 5F1 BRANCH IF X<-LN(2)/2 3F2 STD,AF TEMP4 COPY X FML,AF TEMP4 Y=X*X STD,AF TEMP6 COPY Y FML,AF EE FAL,AF DD FML,AF TEMP6 FAL,AF CC Q = C+Y*(D+Y*E) LD,BF TEMP6 FAL,BF BB FML,BF TEMP6 FAL,BF AA FML,BF TEMP6 P=Y*(A+Y*(B+Y)) FAL,BF AF P+Q FML,AF TEMP4 X*Q FDL,AF BF RESULT 3F4 B 0,LX RETURN 4F1 FML,AF 2OLN2 Y=2*X/LN(2) 4F3 STW,LX TEMP4 SAVE LINK 4F4 BAL,LX FEXP1 OBTAIN 2**Y = EXP(2*X) FAL,AF ONE Y=EXP(2*X)+1.0D0 LCD,BF ONE FDL,BF AF -1.0D0/Y LD,AF HALF FAL,AF BF 0.5D0-1.0D0/Y FAL,AF AF RESULT 4F6 B *TEMP4 RETURN 5F1 FML,AF M2OLN2 Y=2*X/LN(2) 5F3 STW,LX TEMP4 SAVE LINK 5F4 BAL,LX FEXP1 OBRAIN 2**Y = EXP(-2*X) FAL,AF ONE Y=EXP(-2*X)+1.0D0 LD,BF ONE FDL,BF AF 1.0D0/Y LCD,AF HALF FAL,AF BF 1.0D0/Y-0.5D0 FAL,AF AF RESULT 5F6 B *TEMP4 RETURN PAGE * * DOUBLE PRECISION INVERSE HYPERBOLIC SIN FARCSINH * DOUBLE PRECISION INVERSE HYPERBOLIC COSINE FARCCOSH * DOUBLE PRECISION INVERSE HYPERBOLIC TANGENT FARCTANH * * FARCSINH EQU % INVERSE SINH ENTRY STW,LX LINKTEMP SAVE LINK STD,AF TEMP6 SAVE X BAL,LX FCIRC4 SQRT(X**2+1) FAL,AF TEMP6 X+SQRT(X**2+1) >=0 BGZ 1Z1 IF X+SQRT(X**2+1) IS NEAR 0, LCD,AF TEMP6 (AS IT WOULD BE FOR X<<0), FSL,AF TEMP6 THEN ARCSINH(X)=-LOG(-2*X). BAL,LX FLOG LCD,AF AF B *LINKTEMP 1Z1 BAL,LX FLOG ARCSINH(X) B *LINKTEMP RETURN * FARCCOSH EQU % INVERSE COSH ENTRY STW,LX LINKTEMP SAVE LINK STD,AF TEMP6 SAVE X BAL,LX FCIRCM4 SQRT(X**2-1), ABS(X)>=1 FAL,AF TEMP6 X+SQRT(X**2-1) >=1 OR <=-1 BAL,LX FLOG ARCCOSH(X) >=0 (OR DOMAIN ERR) B *LINKTEMP * FARCTANH EQU % INVERSE TANH ENTRY STW,LX LINKTEMP SAVE LINK FSL,AF ONE X-1 STD,AF TEMP6 FAL,AF TWO X+1 FDL,AF TEMP6 (X+1)/(X-1) (NEGATIVE) LCD,AF AF (1+X)/(1-X) BAL,LX FLOG 2*ARCTANH(X) FML,AF HALF ARCTANH(X) B *LINKTEMP RETURN PAGE * * SPECIAL CIRCULAR FUNCTIONS: * * SQRT(X**2 -1) FCIRCM4 * SQRT(X**2 +1) FCIRC4 * SQRT(1- X**2) FCIRC0 * FCIRCM4 EQU % SQRT(X**2-1) ENTRY CLM,AF HIGHSQ BCR,9 2Z1 IF ABS(X) LARGE ENOUGH, LAD,AF AF USE F(X)=ABS(X). B 0,LX 2Z1 FML,AF AF X**2 FSL,AF ONE X**2-1 B FSQRT COMPUTE SQRT AND RETURN * FCIRC4 EQU % SQRT(X**2+1) ENTRY CLM,AF HIGHSQ BCR,9 2Z2 IF ABS(X) LARGE ENOUGH, LAD,AF AF USE F(X)=ABS(X). B 0,LX 2Z2 FML,AF AF X**2 FAL,AF ONE X**2+1 B FSQRT COMPUTE SQRT AND RETURN * FCIRC0 EQU % SQRT(1-X**2) ENTRY FML,AF AF X**2 LCD,AF AF -X**2 FAL,AF ONE 1-X**2 B FSQRT COMPUTE SQRT AND RETURN * BOUND 8 HIGHSQ DATA -X'47100000',+X'47100000' PAGE * * DOUBLE PRECISION EXPONENTIAL FEXP * DOUBLE PRECISION NEGATIVE POWER OF TWO FEXP2 * DOUBLE PRECISION POSITIVE POWER OF TWO FEXP1 * * CONSTANTS * OPEN TABLE BOUND 8 TABLE DATA,8 FL'2',FL'4',FL'8',FL'16' DATA,8 FL'-2',FL'-1',FL'-.5',FL'-.25' BIG DATA X'46100000',X'80000000' TO SCALE INTEGER & ROUND C1MC2 DATA X'42AEAC4F',X'BD4C20D9' 174.67308,-179.87169 LN2INV DATA X'41171547',X'652B82FE' 1.44269504088896341=1/LN(2) MLN2INV DATA X'BEE8EAB8',X'9AD47D02' -1/LN(2) P00 DATA,8 FL'1513.9067990543389159' P01 DATA,8 FL'20.202065651286927228' P02 DATA,8 FL'-0.023093347753750233624' Q00 DATA,8 FL'4368.2116627275584985' Q01 DATA,8 FL'233.18421142748162379' MHALF DATA,8 FL'-.5' HALF DATA,8 FL'0.5' SPACE 3 FEXP RES 0 MAIN ENTRY CLM,AF C1MC2 CHECK RANGE BCR,6 2G1 BRANCH IF OK BCS,4 1G1 UNDERFLOW B ERDOMAIN ERROR 1G1 SD,AF AF SET UNDERFLOW RESULT TO 0.0D0 B 0,LX RETURN 2G1 RES 0 PLACE 2G3 AI,AF 0 X : 0.0 BGEZ 4G1 BRANCH IF X NON-NEGATIVE FML,AF MLN2INV X=-X/LN(2) SPACE 3 FEXP2 RES 0 NEGATIVE POWER OF 2.0 ENTRY * USED BY FFPOWER 3G1 LI,N 1 INDICATE NEGATIVE X B 6G1 PROCEED 4G1 FML,AF LN2INV X=X/LN(2.) SPACE 3 FEXP1 RES 0 POSITIVE POWER OF 2.0 ENTRY * USED BY FSINH, FFPOWER 5G1 LI,N 0 INDICATE POSITIVE X 6G1 STD,AF TEMP0 COPY X FAL,AF BIG SCALE INTEGER LI,AF1 0 CLEAR FRACTION LD,CF AF COPY J FSS,AF BIG NORMALIZE J FSL,AF TEMP0 -U, POST SHIFTS STD,AF TEMP0 COPY -U 7G1 FML,AF TEMP0 V=U*U STD,AF TEMP2 COPY V LD,BF TEMP2 COPY V FAL,BF Q01 RATIONAL FML,BF TEMP2 FAL,BF Q00 FML,AF P02 FSL,AF P01 APPROXIMATION FML,AF TEMP2 FSL,AF P00 FML,AF TEMP0 8G1 EXU OPN,N -+ U FDL,AF BF +- (2.0 ** (+-U) )/2.0 -+ 0.5 FSL,AF HALF-2,N +- (2.0 ** (+-U) )/2.0 SLD,CF -2 J/4 SLS,CF 24 POSITION J/4 TO EXPONENT AW,AF CF 16**( +- J/4) OR,N CF1 SCS,N 2 MOD(J/4) 9G1 FML,AF TABLE,N FINAL FACTOR 9G3 B 0,LX RETURN OPN FSL,BF AF FAL,BF AF PAGE * * DOUBLE PRECISION NATURAL LOGARITHM FLOG * DOUBLE PRECISION BASE 2 LOGARITHM FLOG2 * * CONSTANTS * OPEN C6,C5,C4,C3,C2,C1,C0,D4,D3,D2,D1,MASK BOUND 8 FOURRT2 DATA X'415A8279',X'99FCEF32' 5.65685424949238019=4RT(2) C6 DATA X'437C60DA',X'FF254B2A' 1990.05346598213023 C5 DATA X'432176F9',X'A61B2FED' 535.435949426841753 C4 DATA X'42A427D5',X'CF33479E' 164.155606222171279 C3 DATA X'4234C2EA',X'CF2396D6' 52.7613954030883501 C2 DATA X'4212776C',X'516A782D' 18.4664965519843255 C1 DATA X'417B1C27',X'70E727E0' 7.69437355139461230 C0 DATA X'415C551D',X'94AE0BFD' 5.77078016355585460 D4 DATA X'403920FC',X'72219AEB' .223159578193740481 D3 DATA X'40492475',X'F6A71ECB' .285712597578022078 D2 DATA X'40666666',X'6BBA27A8' .400000001240327858 D1 DATA X'40AAAAAA',X'AAAA50E8' .666666666666347771 TWO DATA,8 FL'2.0' LN2 DATA X'40B17217',X'F7D1CF7A' .693147180559945309=LN(2) C0C1 DATA X'411185F1',X'40E9CA3B' 1.095,1/1.095=0.913242 MASK DATA X'80FFFFFF' MANTISSA X44 DATA X'44000000' EXPONENT QTR DATA X'400000' 0.25B7 SPACE 3 FLOG2 RES 0 LOG BASE 2.0 ENTRY * USED BY FFPOWER AI,LX X'80000' INDICATE LOG BASE 2 FLOG RES 0 1H3 LFI 0 SET FF=0, POST SHIFTS POSSIBLE CLM,AF C0C1 X:1.095,1/1.095 BCS,6 3H1 BRANCH IF OUTSIDE INTERVAL FSL,AF HALF X-1.0D0 FSL,AF HALF RETAINING SIGNIFICANCE LD,BF AF COPY X-1 FAL,BF TWO X+1 FDL,AF BF Z=(X-1)/(X+1) STD,AF TEMP0 COPY Z 2H1 FML,AF TEMP0 Y=Z*Z STD,AF TEMP2 COPY Y FML,AF D4 P FAL,AF D3 O FML,AF TEMP2 LY- FAL,AF D2 NOMIAL FML,AF TEMP2 OF FAL,AF D1 ODD FML,AF TEMP2 POWERS FAL,AF TWO OF FML,AF TEMP0 Z 2H3 BDR,LX 0,LX RETURN IF NATURAL LOGARITHM FML,AF LN2INV CONVERT TO BASE 2.0 B 1,LX RETURN, BDR HAS REDUCED LX BY 1 3H1 LB,CF AF EN=EXPONENT SLS,CF 10 SCALE B21 AND,AF MASK EM=MANTISSA 3H2 BGZ 3H3 B ERDOMAIN ERROR 3H3 RES 0 PLACE CW,AF HALF EM:0.5 BANZ 6H1 BRANCH IF 0.5<=EM<1 AI,CF -X'10180' REMOVE BIAS, SUBTRACT 1.5 CW,AF QTR EM:0.25 BANZ 7H1 BRANCH IF 0.25<=EM<0.5 CW,AF TWO EM:0.125 BANZ 4H1 BRANCH IF 0.125<=EM<0.25 SLD,AF 2 EM=EM*4.0D0 AI,CF X'10180'-X'10380' SUBTRACT 3.5 B 7H1 PROCEED 4H1 SLD,AF 1 EM=EM*2.0D0 AI,CF X'10180'-X'10280' SUBTRACT 2.5 B 7H1 PROCEED 6H1 SLD,AF -1 EM=EM*0.5D0 AI,CF -X'10080' REMOVE BIAS, SUBTRACT 0.5 7H1 EOR,CF X44 INSERT EXPONENT SFS,CF 5 NORMALIZE LI,CF1 0 CLEAR LSH OF EN AD,AF FOURRT2 EM+4*SQRT(2.) LCD,BF FOURRT2 -4*SQRT(2.) FDL,BF AF Y-0.5D0 FAL,BF HALF Y STD,BF TEMP0 COPY Y FML,BF TEMP0 Z=Y*Y STD,BF TEMP2 COPY Z LD,AF C6 POLYNOMIAL FML,AF TEMP2 FAL,AF C5 FML,AF TEMP2 FAL,AF C4 FML,AF TEMP2 FAL,AF C3 FML,AF TEMP2 FAL,AF C2 FML,AF TEMP2 FAL,AF C1 FML,AF TEMP2 FAL,AF C0 FML,AF TEMP0 FAL,AF CF DLOG2(X) 7H3 BIR,LX 0,LX RETURN IF LOG BASE 2 FML,AF LN2 CONVERT TO NATURAL LOGARITHM B -1,LX RETURN, BIR HAS INCREASED R6 BY 1 PAGE * * * DYADIC LOGARITHM FFLOG * * CALLED WITH LEFT ARG IN AF/AF1 AND RIGHT ARG IN BF/BF1. * RESULT IS RETURNED IN AF/AF1. LINK IS LX. * FFLOG EQU % DYADIC LOG ENTRY STD,BF TEMP6 SAVE B STW,LX LINKTEMP BAL,LX FLOG LOG(A) XW,AF TEMP6 SAVE IT, RESTORE B XW,AF1 TEMP7 BAL,LX FLOG LOG(B) FDL,AF TEMP6 LOG(B)/LOG(A) = LOG BASE A OF B B *LINKTEMP RETURN PAGE * * DOUBLE PRECISION SQUARE ROOT FSQRT * * CONSTANTS * OPEN AA,BB,CC,DD X80F DATA X'80FFFFFF' AA DATA X'1BE10000' .108902 BB DATA X'907C0' .03527451 CC DATA X'12E20000' .07376 DD DATA X'D5A80' .05216 SPACE 3 FSQRT RES 0 ENTRY, USED BY FARCSIN, FARCCOS LI,N 2 RESET FLAG LB,BF AF COPY EXPONENT AND,AF X80F EXTRACT MANTISSA BGZ 2K7 BRANCH IF OK BEZ 0,LX RETURN 0 FOR DSQRT(0) B ERDOMAIN ERROR 2K7 CW,AF =X'00C00000' BRANCH IF BANZ 2K5 HI SCALE STD,AF TEMP2 LO SCALE SLD,AF 2 *4 STD,AF TEMP0 HI SCALE LW,AF TEMP2 RESTORE LO BDR,N 2K6 SET FLAG AND JOIN 2K5 STD,AF TEMP0 HI SCALE SLD,AF -2 /4 STD,AF TEMP2 LO SCALE 2K6 LH,AF1 TEMP0 HI SCALE MSQTR CI,AF1 X'80' BRANCH IF BANZ 2K3 HIEST SCALE MH,AF1 AA LINEAR AW,AF1 BB APPROXIMATION B 2K4 JOIN 2K3 MH,AF1 CC LINEAR AW,AF1 DD APPROXIMATION 2K4 STW,AF1 TEMP4 SQRT/8 FDS,AF TEMP4 FIRST AW,AF TEMP4 NEWTON XW,AF TEMP0 SQRT LW,AF1 TEMP1 /4 FDL,AF TEMP0 SECOND AD,AF TEMP0 NEWTON XW,AF TEMP2 SQRT XW,AF1 TEMP3 /2 OR,AF =X'10000000' FOR EXPONENT GARBAGE FDL,AF TEMP2 THIRD AD,AF TEMP2 NEWTON SCS,BF -1 HALVE EXPONENT,REMAINDER TO BIT 0 AI,BF X'20' FIX BIAS, CHECK REMAINDER BGEZ 2K1 BRANCH IF NO REMAINDER SLD,AF -4,N MULTIPLY BY BIR,BF 2K2 2 OR 4 AND JOIN 2K1 SLD,AF -2,N NOP OR DIVIDE BY 2 2K2 STB,BF AF INSERT EXPONENT B 0,LX RETURN PAGE * * DOUBLE PRECISION RAISED TO A DOUBLE PRECISION POWER FFPOWER * * CONSTANTS * MEXPOV DATA X'43103800' 259.5 EXPOV DATA X'42FC0000' 252.0 SPACE 3 FFPOWER RES 0 ENTRY STW,LX LINKTEMP SAVE LINK STD,BF TEMP6 COPY Y AI,AF 0 X : 0.0 BGZ 4L1 BRANCH IF X > 0.0 BLZ 2L1 BRANCH IF X < 0.0 1L1 AI,BF 0 Y : 0.0 BGZ 0,LX RETURN 0.0D0 FOR 0**POSITIVE BEZ 2M1 X=Y=0, X**Y=1 B ERDOMAIN ERROR 2L1 STD,AF TEMP4 SAVE X LD,AF BF Y HAD BETTER BE AN INTEGER BAL,LX F2I B ERDOMAIN (ERROR IF NOT) CI,AI 1 CHECK Y FOR ODD/EVEN = FNEG STCF LINKTEMP SAVE FNEG LCD,AF TEMP4 ABS(X) 4L1 RES 0 PLACE 4L5 BAL,LX FLOG2 OBTAIN LOG BASE 2 OF X LI,LX WA(7L2) FORCE RETURNS BELOW 4L6 FML,AF TEMP6 Y*LOG2(X) BGEZ 6L1 BRANCH IF RESULT >= 1.0D0 LCD,AF AF ABS(Y*LOG2(X)) CW,AF MEXPOV CHECK FOR UNDER FLOW 5L1 BL FEXP2 BRANCH IF OK SD,AF AF UNDERFLOW RESULT = 0.0D0 5L2 B *LINKTEMP RETURN 6L1 CW,AF EXPOV CHECK FOR OVERFLOW 7L1 BL FEXP1 BRANCH IF OK B ERDOMAIN ERROR 7L2 RES 0 PLACE 7L4 LC LINKTEMP FNEG BAZ *LINKTEMP RETURN IF RESULT IS POSITIVE LCD,AF AF SET RESULT NEGATIVE B *LINKTEMP RETURN PAGE * * DOUBLE PRECISION RAISED TO AN INTEGER POWER FIPOWER * FIPOWER RES 0 ENTRY AI,AF 0 X : 0 BNEZ 1M1 BRANCH IF X NE 0 AI,BI 0 J : 0 BGZ 0,LX RETURN 0 IF J<0 BEZ 2M1 X=J=0, X**J=1 B ERDOMAIN ERROR 1M1 AI,BI 0 J : 0 BGZ 5M1 BRANCH IF J>0 BLZ 3M1 BRANCH IF J<0 2M1 LD,AF ONE RESULT = 1.0D0 B 0,LX RETURN 3M1 STD,AF TEMP0 LD,AF ONE X= FDL,AF TEMP0 1.0 LCW,BI BI J=-J B 5M1 ENTER LOOP 4M1 SLS,BI -1 J=J/2 FML,AF AF X=X*X 5M1 CI,BI 1 CHECK J FOR ODD/EVEN BAZ 4M1 LOOP IF EVEN BE 0,LX RETURN IF J=1 LD,CF AF COPY X B 7M1 ENTER LOOP 6M1 FML,AF CF CURRENT POWER IS A FACTOR 7M1 SLS,BI -1 J=J/2 FML,CF CF X=X*X CI,BI 1 CHECK J FOR ODD/EVEN BAZ 7M1 LOOP IF EVEN - NO FACTOR THIS TIME BNE 6M1 LOOP IF J>1 FML,AF CF FINAL FACTOR B 0,LX RETURN PAGE * * INTEGER RAISED TO AN INTEGER POWER IIPOWER * * CONSTANTS * BOUND 8 ONEM1 DATA 1,-1 +- 1 SPACE 3 IIPOWER RES 0 ENTRY CLM,AI ONEM1 ABS(I) : 1 BCS,6 3N1 BRANCH IF GREATER BCR,3 0,LX RETURN 1 IF I=1 BCS,8 2N1 BRANCH IF I=0 CI,BI 1 CHECK POWER FOR ODD/EVEN BANZ 0,LX RETURN -1 IF ODD 1N1 LI,AI 1 RESULT = 1 B 0,LX RETURN 2N1 AI,BI 0 J : 0 BGZ 0,LX RETURN 0 FOR 0**POSITIVE BEZ 1N1 I=J=0, I**J=1 B ERDOMAIN ERROR 3N1 AI,BI 0 J : 0 BGZ 6N1 BRANCH IF J>0 BEZ 1N1 BRANCH IF J=0 B INTGOVFL WONT FIT AS INTEGER 5N1 SLS,BI -1 J=J/2 MW,AI AI I=I*I BOV INTGOVFL CHECK FOR OVERFLOW 6N1 CI,BI 1 CHECK J FOR ODD/EVEN BAZ 5N1 LOOP IF EVEN BE 0,LX RETURN IF J=1 LW,N BI MOVE J LW,BI AI COPY I B 8N1 ENTER LOOP 7N1 MW,AI BI CURRENT POWER IS A FACTOR BOV INTGOVFL CHECK FOR OVERFLOW 8N1 SLS,N -1 J=J/2 MW,BI BI I=I*I BOV INTGOVFL CHECK FOR OVERFLOW CI,N 1 CHECK J FOR ODD/EVEN BAZ 8N1 LOOP IF EVEN - NO FACTOR THIS TIME BNE 7N1 LOOP IF J>1 MW,AI BI FINAL FACTOR BOV INTGOVFL CHECK FOR OVERFLOW B 0,LX RETURN PAGE * * * TEMPS * TEMP0 TEMP TEMP1 TEMP TEMP2 TEMP TEMP3 TEMP TEMP4 TEMP TEMP5 TEMP TEMP6 TEMP TEMP7 TEMP LINKTEMP TEMP LINK TEMP * * ERROR,X'F',TLOC>9 'TOO MANY TEMPS' U07-0014 NTEMPS SET TLOC U07-0015 2Z END