!***********************************************************************
!*    NOTE WELL                                                        *
!*    AFTER COMPILING THIS FILE THE FOLLOWING ALIASES MUST BE ADDED    *
!*    S#PRINT1900=ICL9CEPRINT1900 & S#READ1900=ICL9CEREAD1900          *
!***********************************************************************
!* 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)
%SYSTEMROUTINESPEC SSERR(%INTEGER I)
%SYSTEMINTEGERFNSPEC IOCP(%INTEGER A,B)
%SYSTEMINTEGERMAPSPEC COMREG(%INTEGER N)
%SYSTEMROUTINESPEC MLIBERR(%INTEGER N)
%CONSTBYTEINTEGERARRAY ITOETAB(0 : 255) =       %C
            X'00',X'01',X'02',X'03',   X'37',X'2D',X'2E',X'2F',
            X'16',X'05',X'25',X'0B',   X'0C',X'0D',X'0E',X'0F',
            X'10',X'11',X'12',X'13',   X'3C',X'3D',X'32',X'26',
            X'18',X'19',X'3F',X'27',   X'1C',X'1D',X'1E',X'1F',
            X'40',X'4F',X'7F',X'7B',   X'5B',X'6C',X'50',X'7D',
            X'4D',X'5D',X'5C',X'4E',   X'6B',X'60',X'4B',X'61',
            X'F0',X'F1',X'F2',X'F3',   X'F4',X'F5',X'F6',X'F7',
            X'F8',X'F9',X'7A',X'5E',   X'4C',X'7E',X'6E',X'6F',
            X'7C',X'C1',X'C2',X'C3',   X'C4',X'C5',X'C6',X'C7',
            X'C8',X'C9',X'D1',X'D2',   X'D3',X'D4',X'D5',X'D6',
            X'D7',X'D8',X'D9',X'E2',   X'E3',X'E4',X'E5',X'E6',
            X'E7',X'E8',X'E9',X'4A',   X'E0',X'5A',X'5F',X'6D',
            X'79',X'81',X'82',X'83',   X'84',X'85',X'86',X'87',
            X'88',X'89',X'91',X'92',   X'93',X'94',X'95',X'96',
            X'97',X'98',X'99',X'A2',   X'A3',X'A4',X'A5',X'A6',
            X'A7',X'A8',X'A9',X'C0',   X'6A',X'D0',X'A1',X'07',
            X'20',X'21',X'22',X'23',   X'24',X'15',X'06',X'17',
            X'28',X'29',X'2A',X'2B',   X'2C',X'09',X'0A',X'1B',
            X'30',X'31',X'1A',X'33',   X'34',X'35',X'36',X'08',
            X'38',X'39',X'3A',X'3B',   X'04',X'14',X'3E',X'E1',
            X'41',X'42',X'43',X'44',   X'45',X'46',X'47',X'48',
            X'49',X'51',X'52',X'53',   X'54',X'55',X'56',X'57',
            X'58',X'59',X'62',X'63',   X'64',X'65',X'66',X'67',
            X'68',X'69',X'70',X'71',   X'72',X'73',X'74',X'75',
            X'76',X'77',X'78',X'80',   X'8A',X'8B',X'8C',X'8D',
            X'8E',X'8F',X'90',X'9A',   X'9B',X'9C',X'9D',X'9E',
            X'9F',X'A0',X'AA',X'AB',   X'AC',X'AD',X'AE',X'AF',
            X'B0',X'B1',X'B2',X'B3',   X'B4',X'B5',X'B6',X'B7',
            X'B8',X'B9',X'BA',X'BB',   X'BC',X'BD',X'BE',X'BF',
            X'CA',X'CB',X'CC',X'CD',   X'CE',X'CF',X'DA',X'DB',
            X'DC',X'DD',X'DE',X'DF',   X'EA',X'EB',X'EC',X'ED',
            X'EE',X'EF',X'FA',X'FB',   X'FC',X'FD',X'FE',X'FF'
%CONSTBYTEINTEGERARRAY ETOITAB(0 : 255) =     0,
     1,     2,     3,   156,     9,   134,   127,   151,   141,   142,
    11,    12,    13,    14,    15,    16,    17,    18,    19,   157,
   133,     8,   135,    24,    25,   146,   143,    28,    29,    30,
    31,   128,   129,   130,   131,   132,    10,    23,    27,   136,
   137,   138,   139,   140,     5,     6,     7,   144,   145,    22,
   147,   148,   149,   150,     4,   152,   153,   154,   155,    20,
    21,   158,    26,    32,   160,   161,   162,   163,   164,   165,
   166,   167,   168,    91,    46,    60,    40,    43,    33,    38,
   169,   170,   171,   172,   173,   174,   175,   176,   177,    93,
    36,    42,    41,    59,    94,    45,    47,   178,   179,   180,
   181,   182,   183,   184,   185,   124,    44,    37,    95,    62,
    63,   186,   187,   188,   189,   190,   191,   192,   193,   194,
    96,    58,    35,    64,    39,    61,    34,   195,    97,    98,
    99,   100,   101,   102,   103,   104,   105,   196,   197,   198,
   199,   200,   201,   202,   106,   107,   108,   109,   110,   111,
   112,   113,   114,   203,   204,   205,   206,   207,   208,   209,
   126,   115,   116,   117,   118,   119,   120,   121,   122,   210,
   211,   212,   213,   214,   215,   216,   217,   218,   219,   220,
   221,   222,   223,   224,   225,   226,   227,   228,   229,   230,
   231,   123,    65,    66,    67,    68,    69,    70,    71,    72,
    73,   232,   233,   234,   235,   236,   237,   125,    74,    75,
    76,    77,    78,    79,    80,    81,    82,   238,   239,   240,
   241,   242,   243,    92,   159,    83,    84,    85,    86,    87,
    88,    89,    90,   244,   245,   246,   247,   248,   249,    48,
    49,    50,    51,    52,    53,    54,    55,    56,    57,   250,
   251,   252,   253,   254,   255;
%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'
!*
%ROUTINE SELECTINPUT(%INTEGER CH)
%INTEGER I
      I=IOCP(21,CH)
%END
%ROUTINE SELECTOUTPUT(%INTEGER CH)
%INTEGER I
     I=IOCP(22,CH)
%END
%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 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 
%SYSTEMLONGREALFN AARCTAN(%LONGREAL X1)
%LONGREAL XX1, XSQ, CONSTANT
%INTEGER SIGN, INV
!      CONSTANT=0
!      %IF X1<0 %THEN SIGN=1 %AND XX1=-X1 %ELSE SIGN=0 %AND XX1=X1
!      %IF XX1>R'4110000000000000' %C
!        %THEN XX1=1.0/XX1 %AND INV=1 %ELSE INV=0
!      %IF XX1>TANPIBY12 %THEN XX1=(RT3M1*XX1-1.0+XX1)/(XX1+RT3) %AND %C
!        CONSTANT=PIBY6
!      XSQ=XX1*XX1
!      XX1=XX1*(R1/(XSQ+S1+(R2/(XSQ+S2+(R3/(XSQ+S3+(R4/(XSQ+S4))))))) %C
!        )+CONSTANT
!      %IF INV=1 %THEN XX1=1.0-XX1+PIBY2M1
!      %IF SIGN=1 %THEN XX1=-XX1
!      %RESULT =XX1
         *LSD_0; *ST_CONSTANT; *ST_SIGN
         *LB_1; *LSD_X1; *JAF_6,<POS>
         *STB_SIGN; *AND_X'7FFFFFFFFFFFFFFF'
POS:     *RCP_R'4110000000000000'; *JCC_12,<NOTGZ>
         *STB_INV; *RRDV_R'4110000000000000'
NOTGZ:   *RCP_TANPIBY12; *JCC_12,<NTP>
         *LD_PIBY6; *STD_CONSTANT;      ! USE DR SO XX1 STAYS IN ACC
         *ST_XX1; *RMY_RT3M1; *RSB_1.0; *RAD_XX1
         *SLSD_XX1; *RAD_RT3; *RRDV_%TOS
NTP:     *ST_XX1; *RMY_XX1; *ST_XSQ
         *RAD_S4; *RRDV_R4; *RAD_S3; *RAD_XSQ
         *RRDV_R3; *RAD_S2; *RAD_XSQ
         *RRDV_R2; *RAD_S1; *RAD_XSQ
         *RRDV_R1; *RMY_XX1; *RAD_CONSTANT
         *LB_INV; *JAT_12,<INVZ>; *RRSB_1.0; *RAD_PIBY2M1
INVZ:    *LB_SIGN; *JAT_12,<SIGNZ>; *RRSB_0
SIGNZ:   *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 
%SYSTEMROUTINE ININTEGER(%INTEGER CH, %INTEGERNAME VAL)
%LONGREAL X
      %IF CH#COMREG(22) %THEN SELECT INPUT(CH)
      READ(X)
      SKIP SYMBOL
      VAL=INT(X)
%END 
%SYSTEMROUTINE INREAL(%INTEGER CH, %LONGREALNAME VAL)
%LONGREAL X
      %IF CH#COMREG(22) %THEN SELECT INPUT(CH)
      READ(X)
      SKIP SYMBOL
      VAL=X
%END 
%SYSTEMROUTINE OUTINTEGER(%INTEGER CH, VALUE)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      WRITE(VALUE, 10)
      PRINTSTRING(";
")
%END 
%SYSTEMROUTINE OUTREAL(%INTEGER CH, %LONGREAL VALUE)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      PRINTFL(VALUE, 15)
      PRINTSTRING(";
")
%END 
%SYSTEMROUTINE OUTTERMINATOR(%INTEGER CH)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      PRINTSTRING(";
")
%END 
%SYSTEMLONGREALFN ABS(%LONGREAL VALUE)
      %RESULT =MOD(VALUE)
%END 
%SYSTEMINTEGERFN IABS(%INTEGER VALUE)
      %RESULT =IMOD(VALUE)
%END 
%SYSTEMINTEGERFN SIGN(%LONGREAL VALUE)
      %IF VALUE>0 %THENRESULT =1
      %IF VALUE<0 %THENRESULT =-1
      %RESULT =0
%END 
%SYSTEMLONGREALFN MAXREAL
      %RESULT =GREATEST
%END 
%SYSTEMLONGREALFN MINREAL
      %RESULT =R'0010000000000000'
%END 
%SYSTEMINTEGERFN MAXINT
      %RESULT =X'7FFFFFFF'
%END 
%SYSTEMLONGREALFN EPSILON
      %RESULT =R'3410000000000000'
%END 
%SYSTEMLONGREALFN ALREAD
%LONGREAL X
      READ(X)
      SKIP SYMBOL
      %RESULT =X
%END 
%SYSTEMINTEGERFN ANXTSY
      %RESULT =NEXT SYMBOL
%END 
%SYSTEMINTEGERFN EANXTSY
      %RESULT=ITOETAB(NEXT SYMBOL)
%END
%SYSTEMROUTINE APRSYM(%INTEGER SYM)
      PRINTSYMBOL(SYM)
%END 
%SYSTEMROUTINE EAPRSYM(%INTEGER SYM)
      PRINTSYMBOL(ETOITAB(SYM&255))
%END
%SYSTEMROUTINE ARDSYM(%INTEGERNAME SYM)
%INTEGER S
      READSYMBOL(S)
      *LSS_S; *LD_SYM; *ST_(%DR);
%END 
%SYSTEMROUTINE EARDSYM(%INTEGERNAME SYM)
%INTEGER S
      READSYMBOL(S)
      S=ITOETAB(S)
      *LSS_S; *LD_SYM; *ST_(%DR)
%END
%SYSTEMROUTINE ALGPTH
      NEWPAGE
%END 
%SYSTEMROUTINE PRSTNG(%STRINGNAME S)
%STRING (255)P, Q
      P=S
      P=P." ".Q %WHILE P->P.("_").Q
      P=P."
".Q %WHILE P->P.("\").Q
      PRINTSTRING(P)
%END 
%SYSTEMROUTINE EPRSTNG(%LONGINTEGER EBSTRING)
%INTEGER I,J,L,AD
      L=EBSTRING>>32&X'FFFF'
      AD<-EBSTRING
      %RETURN %IF L=0
      %CYCLE I=0,1,L-1
         J=ETOITAB(BYTEINTEGER(AD+I))
         %IF J='_' %THEN J=' '
         %IF J='\' %THEN J=NL
         PRINTCH(J)
      %REPEAT
%END
%SYSTEMROUTINE ASELIN(%INTEGER CH)
      SELECT INPUT(CH)
%END 
%SYSTEMROUTINE ASELOU(%INTEGER CH)
      SELECT OUTPUT(CH)
%END 
%SYSTEMROUTINE ALGNWL
      NEWLINE
%END 
%SYSTEMROUTINE ALGSPC
      SPACE
%END 
%SYSTEMROUTINE ALGNLS(%INTEGER N)
      NEWLINES(N)
%END 
%SYSTEMROUTINE ALGSPS(%INTEGER N)
      SPACES(N)
%END 
%SYSTEMINTEGERFN LENGTH(%STRINGNAME S)
      %RESULT = BYTEINTEGER(ADDR(S))
%END 
%SYSTEMINTEGERFN ELENGTH(%LONGINTEGER EBSTRING)
%INTEGER I
      I=EBSTRING>>32&X'FFFF'
      %RESULT=I
%END
%SYSTEMROUTINE INSYMBOL(%INTEGER CH,%STRINGNAME S, %INTEGERNAME CHAR)
%STRING (1)ITEM
%STRING (65)S1, S2
%INTEGER I
      %IF CH#COMREG(22) %THEN SELECT INPUT(CH)
      READ ITEM(ITEM)
      %IF S->S1.(ITEM).S2 %THEN CHAR=LENGTH(S1)+1 %ANDRETURN 
      I=CHARNO(ITEM, 1)
      %IF (' '<=I<='Z' %AND I#34) %OR I=92 %OR I=95 %OR I=126 %OR %C
        I=10 %THEN CHAR=-I %ELSE CHAR=0
%END 
%SYSTEMROUTINE EINSYMBOL(%INTEGER CH,%LONGINTEGER EBSTRING, %C
         %INTEGERNAME CHAR)
%INTEGER I,L,ITEM,EITEM,AD
      %IF CH#COMREG(22) %THEN SELECT INPUT(CH)
      READ SYMBOL(ITEM)
      EITEM=ITOETAB(ITEM)
      L=EBSTRING>>32&X'FFFF'
      I=0; AD<-EBSTRING
      %WHILE I<L %CYCLE
         %IF EITEM=BYTEINTEGER(AD+I) %THEN CHAR=I+1 %AND %RETURN
         I=I+1
      %REPEAT
      %IF (' '<=ITEM<='Z' %AND ITEM#34) %OR ITEM=92 %OR ITEM=95 %OR %C
         ITEM=126 %OR ITEM=10 %THEN CHAR=-EITEM %ELSE CHAR=0
%END
%SYSTEMROUTINE OUTSYMBOL(%INTEGER CH,%STRINGNAME S, %INTEGER CHAR)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      %IF 1<=CHAR<=LENGTH(S) %THEN PRINTSYMBOL(CHARNO(S, CHAR)) %C
        %ELSE PRINTSYMBOL(-CHAR)
%END 
%SYSTEMROUTINE EOUTSYMBOL(%INTEGER CH,%LONGINTEGER EBSTRING, %C
      %INTEGER CHAR)
%INTEGER L,AD,J
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      L=EBSTRING>>32&X'FFFF'
      AD<-EBSTRING
      %IF 1<=CHAR<=L %THEN J=BYTEINTEGER(AD+CHAR-1) %ELSE J=(-CHAR)&255
      PRINTSYMBOL(ETOITAB(J))
%END
%SYSTEMINTEGERFN AICODE(%STRINGNAME S)
%INTEGER I
      I=CHARNO(S, 1)
      %IF I='_' %THEN I=' '
      %IF I='\' %OR S="EL" %THEN I=NL
      %IF S="SS" %THEN I='%'
      %RESULT =I
%END 
%SYSTEMINTEGERFN EAICODE(%LONGINTEGER EBSTRING)
%INTEGER I,J,L,AD
      L=EBSTRING>>32&X'FFFF'
      AD<-EBSTRING
      I=BYTEINTEGER(AD)
      J=BYTEINTEGER(AD+1)
      %IF I=C'_' %THEN %RESULT=C' '
      %IF I=C'\' %OR (L=2 %AND I=C'E' %AND J=C'L') %THEN %C
         %RESULT=ITOETAB(NL)
      %IF L=2 %AND I=J=C'S' %THEN %RESULT=C'%'
      %RESULT=I
%END
%SYSTEMROUTINE OUTSTRING(%INTEGER CH,%STRINGNAME S)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      PRSTNG(S)
%END 
%SYSTEMROUTINE EOUTSTRING(%INTEGER CH,%LONGINTEGER EBSTRING)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      EPRSTNG(EBSTRING)
%END
%SYSTEMROUTINE WRITE TEXT(%STRINGNAME TEXT)
%CONSTBYTEINTEGERARRAY SUBSTRCH(0:127)=0(48),1(10),0(6),
                  0(3),2,0(12),3,4,0,5,0,6,0,0,7,8,0(6),
                  0(3),2,0(12),3,4,0,5,0,6,0,0,7,8,0(6);
%CONSTSTRING(3)%ARRAY OCHAR(2:8)="
","","'('"," ","')'","{","}";
                                        ! C==NEWLINE (CODE=2)
                                        ! P==NEWPAGE (CODE=3)
                                        ! Q==OPENQUOTE '(' (CODE=4)
                                        ! S==SPACE (CODE=5)
                                        ! U==UNQUOTE ')' (CODE=6)
                                        ! X==OPENQUOTE { (CODE=7)
                                        ! Y==CLOSEQUOTE } (CODE=8)
%INTEGER I, R, SUCCESS, SYM, TRSYM
%BYTEINTEGERARRAY SA(0:255)
%STRING (255)S, S1, S3
%STRING (3)QU
%STRINGNAME S2
%STRING (1)BR1, BR2
      BR1="{"
      BR2="}"
      SUCCESS=0
START:
      S=TEXT
      SA(0)=0
      S2==STRING(ADDR(SA(0)))
NEXT: 
      %UNLESS S->S1.(BR1).S2.(BR2).S3 %THEN ->FAIL 
      %UNLESS 0<SA(0)<=7 %THEN ->ILLEGAL
      %CYCLE I=1,1,SA(0)
         SYM=SA(I); TRSYM=SUBSTRCH(SYM)
         ->ILLEGAL %IF TRSYM=0
      %REPEAT
      SUCCESS=1
      PRINTSTRING(S1)
      S=S3
      R=0
      %CYCLE I=1, 1, SA(0)
         SYM=SA(I); TRSYM=SUBSTRCH(SYM)
         %IF TRSYM=1 %THEN %START
            R=10*R+SYM-'0'
         %FINISH %ELSE %START
            QU=OCHAR(TRSYM)
            %UNTIL R<=0 %CYCLE 
               R=R-1
               %IF QU="" %THEN NEWPAGE %ELSE PRINTSTRING(QU)
            %REPEAT 
            R=0
         %FINISH 
      %REPEAT 
      ->NEXT
ILLEGAL:                                ! SUBSTRING HAS ILLEGAL CONTENTS
      PRINTSTRING(S1.BR1.S2.BR2)
      S=S3; SUCCESS=1; ->NEXT
FAIL:
      %IF SUCCESS=1 %THEN PRINTSTRING(S) %ELSESTART 
         BR1="<"
         BR2=">"
         SUCCESS=1
         ->START
      %FINISH 
%END 

%SYSTEMROUTINE EWRITE TEXT(%LONGINTEGER EBSTRING)
%INTEGER L,AD,I,LL
%STRING(255)S
      AD<-EBSTRING
      L=EBSTRING>>32&X'FFFF'
AGN:
      LL=L
      %IF LL>255 %THEN LL=255
      %CYCLE I=1,1,LL
         CHARNO(S,I)=ETOITAB(BYTEINTEGER(AD+I-1))
      %REPEAT
      CHARNO(S,0)=LL
      WRITE TEXT(S)
      L=L-LL
      AD=AD+LL
      ->AGN %IF L>0
%END
%SYSTEMLONGREALFN READ1900
!***********************************************************************
!*       THIS ROUTINE IS THE 1900 IMPLICITLY SPECIFIED ROUTINE         *
!*                                                                     *
!*       THE METHOD USED IS SIMPLE REPEATED MULTIPLICATION USING LONG  *
!*       REAL VARIABLES. SOME ROUNDING ERRORS ARE INTRODUCED WHICH     *
!*       COULD BE AVOIDED BY USING PACKED DECIMAL INSTNS WITH NECESSARY*
!*       SCALING.                                                      *
!***********************************************************************
%INTEGERFNSPEC NEXT
%INTEGERFNSPEC CHECK EXP
%LONGREALFNSPEC GET(%INTEGER LEVEL)
%INTEGER CURSYM
      %RESULT=GET(1)
%LONGREALFN GET(%INTEGER LEVEL)
%INTEGER TYPE, IVALUE, FLAG
                                       ! FLAG= 0FOR'-',1 FOR '+'
%LONGREAL RWORK, SCALE
      FLAG=1;  TYPE=0
START:CURSYM=NEXT;                      ! CARE NOT TO READ TERMINATOR
                                        ! NOW IGNORE LEADING SPACES
      %UNLESS LEVEL>1 %START
         %CYCLE 
            %EXITIF '0'<=CURSYM<='9' %OR CURSYM='+' %OR CURSYM='-' %C
              %OR CURSYM='.' %OR CURSYM='@' %OR CURSYM='&' %C
            %OR CURSYM=''''
            CURSYM=NEXT
         %REPEAT 
      %FINISH %ELSE %START
         CURSYM = NEXT %WHILE CURSYM = NL %OR CURSYM = ' '
      %FINISH
                                       ! RECORD INITIAL MINUS
      %IF CURSYM='-' %THEN FLAG=0 %AND CURSYM='+'
                                       ! MOVE OVER SIGN ONCE IT HAS
                                       ! BEEN RECORDED IN FLAG
      %IF CURSYM='+' %THEN CURSYM=NEXT
      CURSYM=NEXT %WHILE CURSYM=' '
      %IF '0'<=CURSYM %AND CURSYM<='9' %THENSTART 
         RWORK=CURSYM-'0';             ! KEEP TOTAL IN RWORK
         TYPE=1;                       ! VALID DIGIT
         %CYCLE 
            CURSYM=NEXT
            %EXITUNLESS '0'<=CURSYM %AND CURSYM<='9'
            RWORK=10*RWORK+(CURSYM-'0')
                                       ! CONTINUE EVALUATING
         %REPEAT 
      %FINISHELSE RWORK=0
      %IF LEVEL>1 %THEN ->RETEXP
      %IF CURSYM='.' %THENSTART 
         SCALE=10
         %CYCLE 
            CURSYM=NEXT
            %EXITUNLESS '0'<=CURSYM %AND CURSYM<='9'
            TYPE=1
            RWORK=RWORK+(CURSYM-'0')/SCALE
            SCALE=10*SCALE
         %REPEAT 
      %FINISH 
                                       !
                                       ! THE VALUE HAS NOW BEEN READ
                                       ! INTO RWORK. THERE MIGHT BE
                                       ! AN EXPONENT
                                       ! E.G. '1.7@ 10'  IS VALID
                                       ! DATA FOR READ
                                       !
      %IF CHECKEXP#0 %THENSTART 
         %IF TYPE=0 %AND RWORK=0 %THEN RWORK=1
         IVALUE=INT(GET(2));                   ! CALL TO FIND EXPONENT
         %IF IVALUE = -99 %THEN RWORK = 0 %ELSE %C
         RWORK=RWORK*10.0**IVALUE
         TYPE=1
      %FINISH 
      %IF TYPE=0 %THEN ->START
RETEXP:
      %IF FLAG=0 %THEN RWORK=-RWORK
      %RESULT =RWORK
%END
%INTEGERFN NEXT
   %INTEGER S
         READ SYMBOL(S)
         %IF S=' ' %THEN READ SYMBOL(S)
         %RESULT =S
      %END 
%INTEGERFN CHECKEXP
   %INTEGER S
         %RESULT =1 %IF CURSYM='@' %OR CURSYM='&' %OR CURSYM='E'
         %RESULT =0 %UNLESS CURSYM='''' %AND NEXTSYMBOL='1'
         SKIP SYMBOL;  READ SYMBOL(S)
         %RESULT =0 %UNLESS S='0' %AND NEXT SYMBOL=''''
         SKIP SYMBOL
         %RESULT =1
      %END 
%END 
%SYSTEMROUTINE PRINT1900(%LONGREAL X, %INTEGER M, N)
      PRINT(X, M, N);  SPACES(2)
%END 
%SYSTEMROUTINE OUTPUT(%LONGREAL X)
      PRINT(X, 0, 10)
      PRINTSYMBOL(';')
      NEWLINE
%END 
%SYSTEMINTEGERFN READ BOOLEAN
%BYTEINTEGERARRAY TORF(0:6)
%STRINGNAME S
%INTEGER I
      S==STRING(ADDR(TORF(0)))
FINDQ:
      READSYMBOL(I) %UNTIL I=''''
FOUNDQ:
      %CYCLE I=1, 1, 6
         READSYMBOL(TORF(I))
         ->OUT %IF TORF(I)=''''
      %REPEAT 
OUT:  
      TORF(0)=I
      %RESULT =-1 %IF S="TRUE'"
      %RESULT =0 %IF S="FALSE'"
      %IF TORF(I)='''' %THEN ->FOUNDQ %ELSE ->FINDQ
%END 
%SYSTEMROUTINE WRITE BOOLEAN(%INTEGER B)
      %IF B#0 %THEN PRINTSTRING("'TRUE'  ") %ELSE PRINTSTRING("'FALSE' ")
%END 
%SYSTEMROUTINE COPYTEXT(%STRINGNAME TEXT)
%INTEGER I, J, K, L
      L=LENGTH(TEXT)
      %BEGIN 
%BYTEINTEGERARRAY T(1:L*2), T1(0:L)
%STRINGNAME S
         S==STRING(ADDR(T1(0)))
         S=TEXT
         %CYCLE I=1, 2, L*2-1
            T(I)=I+2
            READSYMBOL(T(I+1))
         %REPEAT 
         T(I)=1
         I=1
         J=1
NEXT:    
         %CYCLE K=1, 1, L
            %IF T1(K)#T(I+1) %THEN ->OUT
            I=T(I)
         %REPEAT 
         ->RET
OUT:     
         I=T(J)
         PRINTSYMBOL(T(J+1))
         READSYMBOL(T(J+1))
         J=I
         ->NEXT
RET:     
      %END 
      %RETURN 
%END 

%SYSTEMROUTINE ECOPY TEXT(%LONGINTEGER EBSTRING)
%INTEGER I,AD,L
%STRING(255)S
      AD<-EBSTRING
      L=EBSTRING>>32&X'FFFF'
      L=255 %IF L>255
      %CYCLE I=1,1,L
         CHARNO(S,I)=ETOITAB(BYTEINTEGER(AD+I-1))
      %REPEAT
      CHARNO(S,0)=L
      COPY TEXT(S)
%END
%SYSTEMINTEGERFN ALRDCH
%INTEGER CH
      READCH(CH)
      %RESULT =CH
%END 
%SYSTEMINTEGERFN ALNXCH
      %RESULT =IOCP(18, 0)
%END 
%SYSTEMROUTINE ALPRCH(%INTEGER CH)
      PRINTCH(CH)
%END 
%SYSTEMROUTINE ALSKCH
%INTEGER CH
      READCH(CH)
%END 

%SYSTEMINTEGERFN EALRDCH
%INTEGER CH
      READCH(CH)
      %RESULT=ITOETAB(CH)
%END
%SYSTEMINTEGERFN EALNXCH
      %RESULT=ITOETAB(IOCP(18,0))
%END
%SYSTEMROUTINE EALPRCH(%INTEGER EBCH)
      PRINTCH(ETOITAB(EBCH))
%END
%SYSTEMROUTINE ALGMON
      %MONITOR 
%END 
%SYSTEMROUTINE CLOSE STREAM(%INTEGER STREAM)
%INTEGER I
   %IF STREAM > 98 %OR STREAM < 1 %OR COMREG(22) = STREAM %C
      %OR COMREG(23) = STREAM %THEN SSERR(29)
   I=IOCP(16,STREAM)
%END
!*
%SYSTEMROUTINE AFAULT(%STRINGNAME MESSAGE,%LONGREAL VALUE)
!*
!*THIS ENABLES AN ALGOL PROGRAM TO TERMINATE WITH A MESSAGE
!* AND DIAGNOSIS AS PER ALGOL 60M REPORT
!*
      SELECT OUTPUT(107)
      PRINTSTRING("
ALGOL FAULT  ".MESSAGE."
PARAMETER = ")
      PRINTFL(VALUE,15)
      NEWLINE
      %MONITOR
      %STOP
%END
!

%SYSTEMROUTINE EAFAULT(%LONGINTEGER EBSTRING,%LONGREAL VALUE)
      SELECT OUTPUT(107)
      PRINTSTRING("
ALGOL FAULT  ")
      EPRSTNG(EBSTRING)
      PRINTSTRING("
PARAMETER = ")
      PRINTFL(VALUE,15)
      NEWLINE
      %MONITOR
      %STOP
%END
%ENDOFFILE