!Modified RRM 24/6/82 so that this file now contains only functions
!which are common to ALGOL and IMP
!* MODIFIED 28.4.80 TO ALLOW FOR EBCDIC STRINGS
!* MODIFIED 10.3.80 TO REMOVE SQ AND DA
!* MODIFIED 6.3.80 BY LCG WITH PDS'S READ1900 AND WRITETEXT ROUTINES
!* MODIFIED 03/05/79 MLIBERR INSERTED
!* MODIFIED 16/04/79 LENGTH CHANGED
!* MODIFIED 17/01/79 NEW VERSION OF WRITETEXT
!* MODIFIED 20/02/78 ERROR MESSAGE VALUES
!* MODIFIED 8/11/77 READ1900 IGNORES MULTIPLE SP & NL AFTER EXP CHAR
!* MODIFIED 13/01/77 SET MARGINS
!* MODIFIED 03/12/76 NEW VERSIONS OF READ1900,WRITETEXT
!******** MODIFIED 02:07:76 15.15 LCG (ALGLRTS,MATHFNS CONCATONATED
! ,COMPLEX ROUTINES
! & DUPLICATES FOR FORTRAN)
SYSTEMINTEGERFNSPEC IOCP(INTEGER A,B)
SYSTEMROUTINESPEC MLIBERR(INTEGER N)
CONSTLONGREAL R1=R'41C98867F42983DF'
CONSTLONGREAL R2=R'C2562FB2813C6014'
CONSTLONGREAL R3=R'C1146D547FED8A3D'
CONSTLONGREAL R4=R'C0157BD961F06C89'
CONSTLONGREAL S1=R'421B189E39236635'
CONSTLONGREAL S2=R'4168EE1BDE0C3700'
CONSTLONGREAL S3=R'41224E7F3CBDFE41'
CONSTLONGREAL S4=R'41144831DAFBF542'
CONSTLONGREAL RT3=R'411BB67AE8584CAA'
CONSTLONGREAL PIBY6=R'40860A91C16B9B2C'
CONSTLONGREAL PIBY2M1=R'40921FB54442D184'
CONSTLONGREAL RT3M1=R'40BB67AE8584CAA7'
CONSTLONGREAL TANPIBY12=R'404498517A7B3559'
CONSTLONGREAL PIBY4=R'40C90FDAA22168C2'
CONSTLONGREAL A1=R'40C0000000000000'
CONSTLONGREAL A2=R'3F90FDAA22168C23'
CONSTLONGREAL DEFALLT=R'40B504F333F9DE65'
CONSTLONGREAL MAX=R'4DC90FDAA22168C2'
CONSTLONGREAL GREATEST=R'7FFFFFFFFFFFFFFF'
!*
SYSTEMLONGREALFN ISIN(LONGREAL INARG)
INTEGER N, N1, N0
LONGREAL ARG, DIV, REM, RES
LONGREAL R1, R2, APPROX
CONSTLONGREAL S0=0.785398163397448307
CONSTLONGREAL S1=-0.0807455121882805396;!@-1
CONSTLONGREAL S2=0.00249039457018884507;!@-2
CONSTLONGREAL S3=-0.0000365762041589190506;!@-4
CONSTLONGREAL S4=0.000000313361622553306939;!@-6
CONSTLONGREAL S5=-0.00000000175715008354919024;!@-8
CONSTLONGREAL S6=0.00000000000687736352204187372;!@-11
CONSTLONGREAL C0=1.0
CONSTLONGREAL C1=-0.308425137534042457
CONSTLONGREAL C2=0.0158543442438154890;!@-1
CONSTLONGREAL C3=-0.000325991886927199623;!@-3
CONSTLONGREAL C4=0.00000359086044744883857;!@-5
CONSTLONGREAL C5=-0.0000000246113662387505408;!@-7
CONSTLONGREAL C6=0.000000000115006797403238400;!@-9
CONSTLONGREAL C7=-0.000000000000386315826585600000;!@-12
CONSTLONGREAL MDEFALLT=R'C0B504F333F9DE65'
N1=0
*LSD_INARG; *LB_4; *JAF_2,<NN>
*STB_N1; *AND_X'7FFFFFFFFFFFFFFF'
NN: *ST_ARG; *ICP_MAX; *JCC_4,<CALC>
MLIBERR(54); ! ERROR(1, 2, 1, 0, 1, 0)
IF N1=4 THEN RESULT =MDEFALLT ELSE RESULT =DEFALLT
CALC:
! DIV=ARG/PIBY4
! N=INTPT(DIV)
! REM=(ARG-N*A1-N*A2)/PIBY4
! N0=(N+N1)&7
! %IF N0&1=0 %THEN R1=REM %ELSE R1=1.0-REM
! R2=R1*R1
! %IF N0=0 %OR N0=3 %OR N0=4 %OR N0=7 %THEN APPROX=((((( %C
! (S6*R2+S5)*R2+S4)*R2+S3)*R2+S2)*R2+S1)*R2+S0)*R1 %ELSE %C
! APPROX=((((((C7*R2+C6)*R2+C5)*R2+C4)*R2+C3)*R2+C2)*R2+C1)*R2+C0
! %IF N0>3 %THENRESULT =-APPROX %ELSERESULT =APPROX
*RDV_PIBY4; *FIX_B ; *MYB_4
*CPB_-64; *JCC_10,<NTS>; *LB_-64
NTS: *ISH_B ; *STUH_B ; *ST_N
*FLT_0; *SLSD_A1; *RAD_A2; *RMY_TOS ; *RRSB_ARG; *RDV_PIBY4
*ST_REM; *LSS_N; *IAD_N1; *AND_7; *ST_B
*AND_1; *JAF_4,<EL>; *LSD_REM; *J_<BTH>
EL: *LSD_1.0; *RSB_REM
BTH: *ST_R1; *RMY_R1; *ST_R2; *JAT_12,<SWAY>
*CPB_3; *JCC_8,<SWAY>; *CPB_4; *JCC_8,<SWAY>
*CPB_7; *JCC_7,<CWAY>
SWAY: *RMY_S6; *RAD_S5; *RMY_R2; *RAD_S4
*RMY_R2; *RAD_S3; *RMY_R2; *RAD_S2
*RMY_R2; *RAD_S1; *RMY_R2; *RAD_S0
*RMY_R1; *J_<BWAY>
CWAY: *RMY_C7; *RAD_C6; *RMY_R2; *RAD_C5
*RMY_R2; *RAD_C4; *RMY_R2; *RAD_C3
*RMY_R2; *RAD_C2; *RMY_R2; *RAD_C1
*RMY_R2; *RAD_C0
BWAY: *CPB_3; *JCC_2,<NRG>; *EXIT_-64
NRG: *RRSB_0; *EXIT_-64
END
SYSTEMLONGREALFN ICOS(LONGREAL INARG)
INTEGER N
LONGREAL R1, R2, APPROX
LONGREAL ARG, DIV, REM, RES
INTEGER N0
CONSTLONGREAL S0=0.785398163397448307
CONSTLONGREAL S1=-0.0807455121882805396;!@-1
CONSTLONGREAL S2=0.00249039457018884507;!@-2
CONSTLONGREAL S3=-0.0000365762041589190506;!@-4
CONSTLONGREAL S4=0.000000313361622553306939;!@-6
CONSTLONGREAL S5=-0.00000000175715008354919024;!@-8
CONSTLONGREAL S6=0.00000000000687736352204187372;!@-11
CONSTLONGREAL C0=1.0
CONSTLONGREAL C1=-0.308425137534042457
CONSTLONGREAL C2=0.0158543442438154890;!@-1
CONSTLONGREAL C3=-0.000325991886927199623;!@-3
CONSTLONGREAL C4=0.00000359086044744883857;!@-5
CONSTLONGREAL C5=-0.0000000246113662387505408;!@-7
CONSTLONGREAL C6=0.000000000115006797403238400;!@-9
CONSTLONGREAL C7=-0.000000000000386315826585600000;!@-12
*LSD_INARG; *AND_X'7FFFFFFFFFFFFFFF'
*ST_ARG; *ICP_MAX; *JCC_4,<CALC>
MLIBERR(55); ! ERROR(1, 5, 1, 0, 1, 0)
RESULT =DEFALLT
CALC:
! DIV=ARG/PIBY4
! N=INTPT(DIV)
! REM=(ARG-N*A1-N*A2)/PIBY4
! N0=(N+2)&7
! %IF N0&1=0 %THEN R1=REM %ELSE R1=1.0-REM
! R2=R1*R1
! %IF N0=0 %OR N0=3 %OR N0=4 %OR N0=7 %THEN APPROX=((((( %C
! (S6*R2+S5)*R2+S4)*R2+S3)*R2+S2)*R2+S1)*R2+S0)*R1 %ELSE %C
! APPROX=((((((C7*R2+C6)*R2+C5)*R2+C4)*R2+C3)*R2+C2)*R2+C1)*R2+C0
! %IF N0>3 %THENRESULT =-APPROX %ELSERESULT =APPROX
*RDV_PIBY4; *FIX_B ; *MYB_4
*CPB_-64; *JCC_10,<NTS>; *LB_-64
NTS: *ISH_B ; *STUH_B ; *ST_N
*FLT_0; *SLSD_A1; *RAD_A2; *RMY_TOS ; *RRSB_ARG; *RDV_PIBY4
*ST_REM; *LSS_N; *IAD_2; *AND_7; *ST_B
*AND_1; *JAF_4,<EL>; *LSD_REM; *J_<BTH>
EL: *LSD_1.0; *RSB_REM
BTH: *ST_R1; *RMY_R1; *ST_R2; *JAT_12,<SWAY>
*CPB_3; *JCC_8,<SWAY>; *CPB_4; *JCC_8,<SWAY>
*CPB_7; *JCC_7,<CWAY>
SWAY: *RMY_S6; *RAD_S5; *RMY_R2; *RAD_S4
*RMY_R2; *RAD_S3; *RMY_R2; *RAD_S2
*RMY_R2; *RAD_S1; *RMY_R2; *RAD_S0
*RMY_R1; *J_<BWAY>
CWAY: *RMY_C7; *RAD_C6; *RMY_R2; *RAD_C5
*RMY_R2; *RAD_C4; *RMY_R2; *RAD_C3
*RMY_R2; *RAD_C2; *RMY_R2; *RAD_C1
*RMY_R2; *RAD_C0
BWAY: *CPB_3; *JCC_2,<NRG>; *EXIT_-64
NRG: *RRSB_0; *EXIT_-64
END
SYSTEMLONGREALFN ILOG(LONGREAL IN)
INTEGER P, Q, SHORTF
LONGREAL PRESULT, INARG2
CONSTLONGREAL MIN=R'FFFFFFFFFFFFFFFF'
CONSTLONGREAL SQRTHALF=R'40B504F333F9DE65'
CONSTLONGREAL A1=0.594603557501360533
CONSTLONGREAL A2=0.840896415253714543
CONSTLONGREAL B1=R'40C0000000000000'
CONSTLONGREAL B2=R'4040000000000000'
CONSTLONGREAL LOGE2=R'40B17217F7D1CF7A'
CONSTLONGREAL R0=-0.184416657749370267@2
CONSTLONGREAL R1=-0.234508372303045254@2
CONSTLONGREAL R2=-0.244294581969260792
CONSTLONGREAL S0=-0.157942837832759265@2
CONSTLONGREAL S1=-0.374252034640387355@1
CONSTLONGREAL S2=-0.139586882716355509@1
IF IN<=0 START
IF IN<0 START
MLIBERR(51); ! ERROR(1, PROCNO, 1, 0, 1, 0)
IN=-IN
FINISHELSESTART
MLIBERR(52); ! ERROR(1, PROCNO, 2, 0, 1, 0)
RESULT =MIN
FINISH
FINISH
! P=BYTEINTEGER(ADDR(IN))-64
! BYTEINTEGER(ADDR(IN))=0
! SHORTF=INTEGER(ADDR(IN))
! %IF SHORTF>=X'00400000' %START
! %IF SHORTF>=X'00800000' %THEN Q=0 %ELSE Q=1
! %FINISHELSESTART
! %IF SHORTF>=X'00200000' %THEN Q=2 %ELSE Q=3
! %FINISH
*LSS_IN; *LUH_0
*USH_8; *ISB_X'4000000000'
*STUH_P; *USH_-8; *ST_IN
*USH_-21; *USH_2; *IRSB_0; *SLSS_X'00001123'
*USH_TOS ; *AND_15; *ST_Q
! INTEGER(ADDR(IN))=(INTEGER(ADDR(IN))<<Q)!(INTEGER(ADDR(IN)+4 %C
)>>(32-Q))
! INTEGER(ADDR(IN)+4)=INTEGER(ADDR(IN)+4)<<Q
! BYTEINTEGER(ADDR(IN))=X'40'
*LSD_IN; *USH_Q
*OR_X'4000000000000000'
*ST_IN
IF IN>0 AND IN<SQRTHALF START
IN=(IN-A1)/(IN+A1)
PRESULT=((4*P-Q)-B1)*LOGE2
FINISHELSESTART
IN=(IN-A2)/(IN+A2)
PRESULT=((4*P-Q)-B2)*LOGE2
FINISH
INARG2=IN*IN
RESULT =R0/(INARG2+S0+(R1/(INARG2+S1+(R2/(INARG2+S2)))) C
)*IN+PRESULT
END
SYSTEMLONGREALFN ISQRT(LONGREAL ARG)
CONSTINTEGERARRAY A(0:7)=C
X'2112E2AC',X'20D5AA18',X'20971564',X'206AD50C',
X'204B8AB2',X'20356A86',X'2025C559',X'201AB543'
LONGREAL X,Z
*LSD_ARG
*ASF_4
*ST_X
*JAF_5,<NOTPOS>
MAINPATH:*LSS_X
*USH_-1
*ROT_8
*ST_B
*USH_1
*SHZ_TOS
*USH_-12
*ST_TOS
*UAD_X'410B504F'
*RRDV_X'C1207B4E'
*LD_A
*JAT_14,<EXPODD>
*INCA_16
EXPODD:*RAD_X'41393FED'
*UAD_TOS
*RMYD_(DR +TOS )
*RSC_B
*ST_Z
*RRDV_X
*RAD_Z
*RMY_X'4080000000000000'
*ST_Z
*RRDV_X
*RSB_Z
*RMY_X'4080000000000000'
*RAD_Z
DONE: *EXIT_-64
NOTPOS:*JAT_4,<DONE>
MLIBERR(50)
ARG=-ARG
-> MAINPATH
END
SYSTEMLONGREALFN IEXP(LONGREAL INARG)
LONGREAL W
LONGREAL Y,FY
CONSTLONGREAL LOG2E=R'41171547652B82FE'
INTEGER B, YINT, P, NEGQ
CONSTLONGREAL UE=R'C2B437DF00000000'
CONSTLONGREAL E=R'42AEAC4D00000000'
CONSTLONGREAL RMAX=R'7FFFFFFFFFFFFFFF'
CONSTLONGREAL C0=0.999999999999999993
CONSTLONGREAL C1=-0.693147180559934648
CONSTLONGREAL C2=0.240226506956369776
CONSTLONGREAL C3=-0.0555041084024485261;!@-1
CONSTLONGREAL C4=0.00961811709948153328;!@-2
CONSTLONGREAL C5=-0.00133307347698115810;!@-2
CONSTLONGREAL C6=0.000150737171272758723;!@-3
CONSTLONGREALARRAY EXP2(0:15)=1.0,
0.957603280698573647,
0.917004043204671232,
0.878126080186649742,
0.840896415253714543,
0.805245165974627154,
0.771105412703970412,
0.738413072969749656,
0.707106781186547524,
0.677127773468446364,
0.648419777325504833,
0.620928906036742024,
0.594603557501360533,
0.569394317378345827,
0.545253866332628830,
0.522136891213706920
IF INARG<=UE THEN RESULT =0
IF INARG>=E THEN MLIBERR(53) AND RESULT =RMAX;! ERROR(1,98,1,0,1,0)
! Y=INARG*R'41171547652B82FE001777D0FFDA0D24'
! %IF INARG>0 %START
! YINT=INTPT(Y)+1
! Y=YINT-Y
! %UNLESS Y<1.0 %START
! YINT=YINT-1
! Y=0
! %FINISH
! %IF YINT&3=0 %THEN P=YINT>>2 %AND NEGQ=0 %ELSE %C
! P=YINT>>2+1 %AND NEGQ=-(P<<2)+YINT
! %FINISHELSESTART
! %IF INARG<0 %THEN YINT=-INTPT(-Y) %ELSE YINT=INTPT(Y)
! Y=YINT-Y
! B=-YINT
! P=-(B>>2)
! %IF B&3=0 %THEN NEGQ=0 %ELSE NEGQ=(-P<<2)-B
! %FINISH
*LSD_INARG; *RMY_LOG2E; *ST_Y
*RAD_R'4F00000000000000'; *ST_FY
*FIX_B ; *MYB_4; *ISH_B ; *STUH_B ; *ST_B
*LSD_INARG; *JAF_1,<ZORNEG>
*ADB_1; *STB_YINT; *LSS_B
*FLT_0; *RSB_Y; *ST_Y
*RCP_1.0; *JCC_4,<L1>
*LSS_YINT; *ISB_1; *ST_YINT; *LSD_0; *ST_Y
L1: *LSS_YINT; *AND_3; *JAF_4,<L2>
*ST_NEGQ; *LSS_YINT; *USH_-2; *ST_P
*J_<BOTH>
L2: *LSS_YINT; *USH_-2; *IAD_1; *ST_P
*USH_2; *IRSB_YINT; *ST_NEGQ; *J_<BOTH>
ZORNEG: *STB_YINT; *LSD_FY;
*RSB_Y; *ST_Y
*LSS_YINT; *IRSB_0; *ST_B
*USH_-2; *IRSB_0; *ST_P
*LSS_B; *AND_3; *JAT_4,<L3>
*LSS_P; *USH_2; *IRSB_0; *ISB_B
L3: *ST_NEGQ
BOTH:
! W=Y
! %IF W<R'4010000000000000' %THEN B=0 %ELSESTART
! LONGINTEGER(ADDR(W))=LONGINTEGER(ADDR(W))<<4
! B=INTEGER(ADDR(W))>>24
! BYTEINTEGER(ADDR(W))=X'3F'
! INTEGER(ADDR(W)+4)=INTEGER(ADDR(W)+4) %C
! !(INTEGER(ADDR(Y)+8)>>20)&15
! %FINISH
*LSD_Y; *ST_W; *LB_0
*RCP_R'4010000000000000'; *JCC_4,<EVAL>
*USH_4;
*OR_8; *ST_W; *USH_-24; *STUH_B
*LUH_X'3F'; *USH_24; *STUH_W
EVAL:
! W=((((((C6*W+C5)*W+C4)*W+C3)*W+C2)*W+C1)*W+C0)*EXP2(B)
*LSD_C6; *RMY_W; *RAD_C5; *RMY_W
*RAD_C4; *RMY_W; *RAD_C3; *RMY_W
*RAD_C2; *RMY_W; *RAD_C1; *RMY_W
*RAD_C0; *RMY_(EXP2+B ); *ST_W
! %IF BYTEINTEGER(ADDR(W))=X'41' %START
! %IF NEGQ#0 %THEN NEGQ=NEGQ+4 %ELSE P=P+1 %AND ->NOSHIFT
! %FINISH
! LONGINTEGER(ADDR(W))=LONGINTEGER(ADDR(W))<<NEGQ
*LSS_W; *USH_-24; *ICP_X'41'; *JCC_7,<SHIFT>
*LB_NEGQ; *JAT_12,<NEGZ>
*ADB_4; *STB_NEGQ; *J_<SHIFT>
NEGZ: *LB_P; *ADB_1; *LSD_W; *J_<NOSHIFT>
SHIFT: *LSD_W; *USH_NEGQ; *LB_P
NOSHIFT:
! BYTEINTEGER(ADDR(W))=P+64
! %RESULT =W
*ADB_64
*AND_X'00FFFFFFFFFFFFFF'; *RSC_B
*EXIT_-64
END
SYSTEMLONGREALFN ITAN(LONGREAL ARG)
CONSTLONGREAL P0=0.108886004372816875@8
CONSTLONGREAL P1=-0.895888440067680411@6
CONSTLONGREAL P2=0.141898542527617784@5
CONSTLONGREAL P3=-0.456493194386656319@2
CONSTLONGREAL Q0=0.138637966635676292@8
CONSTLONGREAL Q1=-0.399130951803516515@7
CONSTLONGREAL Q2=0.135382712805119094@6
CONSTLONGREAL Q3=-0.101465619025288534@4
CONSTLONGREAL LEASTDIV=R'0210000000000000'
INTEGER SIGN, Q, QM
LONGREAL DIV, REM, RES, W2
SIGN=0
IF ARG<0 THEN SIGN=1 AND ARG=-ARG
IF ARG>MAX START
MLIBERR(56); ! ERROR(1, 14, 1, 0, 1, 0)
RES=1
FINISHELSESTART
DIV=ARG/PIBY4
Q=INTPT(DIV)
REM=(ARG-Q*A1-Q*A2)/PIBY4
IF Q&1#0 THEN REM=1.0-REM
W2=REM*REM
RES=(((P3*W2+P2)*W2+P1)*W2+P0)/((((W2+Q3)*W2+Q2)*W2+Q1)*W2+Q0)*REM
QM=Q&3
IF QM=1 OR QM=2 START
IF RES<=LEASTDIV START
! ERROR(1, 14, 2, 0, 1, 0)
RES=GREATEST
FINISHELSE RES=1.0/RES
FINISH
IF QM>1 START
IF SIGN=0 THEN RES=-RES
FINISHELSESTART
IF SIGN=1 THEN RES=-RES
FINISH
FINISH
RESULT =RES
END
ENDOFFILE