!***********************************************************************
!*    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 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)
%EXTERNALINTEGERFUNCTIONSPEC IOCP %ALIAS "S#IOCP"(%INTEGER EP,PARM)
%EXTERNALINTEGERMAPSPEC COMREG %ALIAS "S#COMREGMAP"(%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'
!*
%EXTERNALROUTINE ININTEGER %ALIAS "S#ININTEGER"(%INTEGER CH, %INTEGERNAME VAL)
%LONGREAL X
      %IF CH#COMREG(22) %THEN SELECT INPUT(CH)
      READ(X)
      SKIP SYMBOL
      VAL=INT(X)
%END
%EXTERNALROUTINE INREAL %ALIAS "S#INREAL"(%INTEGER CH, %LONGREALNAME VAL)
%LONGREAL X
      %IF CH#COMREG(22) %THEN SELECT INPUT(CH)
      READ(X)
      SKIP SYMBOL
      VAL=X
%END
%EXTERNALROUTINE OUTINTEGER %ALIAS "S#OUTINTEGER"(%INTEGER CH,VALUE)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      WRITE(VALUE,10)
      PRINTSTRING(";
")
%END
%EXTERNALROUTINE OUTREAL %ALIAS "S#OUTREAL"(%INTEGER CH, %LONGREAL VALUE)
!%externalroutinespec phex %alias "EMAS3PHEX"(%integername i)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      PRINTFL(VALUE,17)
!      phex(integer(addr(value))); phex(Integer(addr(value)+4))
      PRINTSTRING(";
")
%END
%EXTERNALROUTINE OUTTERMINATOR %ALIAS "S#OUTTERMINATOR"(%INTEGER CH)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      PRINTSTRING(";
")
%END
%EXTERNALLONGREALFN ABS %ALIAS "S#ABS"(%LONGREAL VALUE)
      %RESULT=MOD(VALUE)
%END
%EXTERNALINTEGERFN IABS %ALIAS "S#IABS"(%INTEGER VALUE)
      %RESULT=IMOD(VALUE)
%END
!%EXTERNALINTEGERFN SIGN %ALIAS "S#SIGN"(%LONGREAL VALUE)
!      %IF VALUE>0 %THENRESULT=1
!      %IF VALUE<0 %THENRESULT=-1
!      %RESULT=0
!%END
!%EXTERNALLONGREALFN MAXREAL %ALIAS "S#MAXREAL"
!      %RESULT=GREATEST
!%END
!%EXTERNALLONGREALFN MINREAL %ALIAS "S#MINREAL"
!      %RESULT=R'0010000000000000'
!%END
!%EXTERNALINTEGERFN MAXINT %ALIAS "S#MAXINT"
!      %RESULT=X'7FFFFFFF'
!%END
!%EXTERNALLONGREALFN EPSILON %ALIAS "S#EPSILON"
!      %RESULT=R'3410000000000000'
!%END
%EXTERNALLONGREALFN ALREAD %ALIAS "S#ALREAD"
%LONGREAL X
      READ(X)
      SKIP SYMBOL
      %RESULT=X
%END
%EXTERNALINTEGERFN ANXTSY %ALIAS "S#ANXTSY"
      %RESULT=NEXT SYMBOL
%END
%EXTERNALINTEGERFN EANXTSY %ALIAS "S#EANXTSY"
      %RESULT=ITOETAB(NEXT SYMBOL)
%END
%EXTERNALROUTINE APRSYM %ALIAS "S#APRSYM"(%INTEGER SYM)
      PRINTSYMBOL(SYM)
%END
%EXTERNALROUTINE EAPRSYM %ALIAS "S#EAPRSYM"(%INTEGER SYM)
      PRINTSYMBOL(ETOITAB(SYM&255))
%END
%EXTERNALROUTINE ARDSYM %ALIAS "S#ARDSYM"(%INTEGERNAME SYM)
%INTEGER S
      READSYMBOL(S)
      SYM=S
%END
%EXTERNALROUTINE EARDSYM %ALIAS "S#EARDSYM"(%INTEGERNAME SYM)
%INTEGER S
      READSYMBOL(S)
      S=ITOETAB(S)
      SYM=S
%END
%EXTERNALROUTINE ALGPTH %ALIAS "S#ALGPTH"
      NEWPAGE
%END
%EXTERNALROUTINE PRSTNG %ALIAS "S#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
%EXTERNALROUTINE EPRSTNG %ALIAS "S#EPRSTNG"(%LONGINTEGER EBSTRING)
%INTEGER I,J,L,AD
      L=EBSTRING>>32&X'FFFF'
      AD<-EBSTRING
      %RETURNIF 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
%EXTERNALROUTINE ASELIN %ALIAS "S#ASELIN"(%INTEGER CH)
      SELECT INPUT(CH)
%END
%EXTERNALROUTINE ASELOU %ALIAS "S#ASELOU"(%INTEGER CH)
      SELECT OUTPUT(CH)
%END
%EXTERNALROUTINE ALGNWL %ALIAS "S#ALGNWL"
      NEWLINE
%END
%EXTERNALROUTINE ALGSPC %ALIAS "S#ALGSPC"
      SPACE
%END
%EXTERNALROUTINE ALGNLS %ALIAS "S#ALGNLS"(%INTEGER N)
      NEWLINES(N)
%END
%EXTERNALROUTINE ALGSPS %ALIAS "S#ALGSPS"(%INTEGER N)
      SPACES(N)
%END
%EXTERNALINTEGERFN LENGTH %ALIAS "S#LENGTH"(%STRINGNAME S)
      %RESULT=BYTEINTEGER(ADDR(S))
%END
%EXTERNALINTEGERFN ELENGTH %ALIAS "S#ELENGTH"(%LONGINTEGER EBSTRING)
%INTEGER I
      I=EBSTRING>>32&X'FFFF'
      %RESULT=I
%END
%EXTERNALROUTINE INSYMBOL %ALIAS "S#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 I=10 %THEN CHAR=-I %ELSE %C
         CHAR=0
%END
%EXTERNALROUTINE EINSYMBOL %ALIAS "S#EINSYMBOL"(%INTEGER CH, %LONGINTEGER EBSTRING,
   %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 %ANDRETURN
         I=I+1
      %REPEAT
      %IF (' '<=ITEM<='Z' %AND ITEM#34) %OR ITEM=92 %OR ITEM=95 %OR ITEM=126 %OR %C
         ITEM=10 %THEN CHAR=-EITEM %ELSE CHAR=0
%END
%EXTERNALROUTINE OUTSYMBOL %ALIAS "S#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)) %ELSE PRINTSYMBOL(-CHAR)
%END
%EXTERNALROUTINE EOUTSYMBOL %ALIAS "S#EOUTSYMBOL"(%INTEGER CH, %LONGINTEGER EBSTRING,
   %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
%EXTERNALINTEGERFN AICODE %ALIAS "S#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
%EXTERNALINTEGERFN EAICODE %ALIAS "S#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'_' %THENRESULT=C' '
      %IF I=C'\' %OR (L=2 %AND I=C'E' %AND J=C'L') %THENRESULT=ITOETAB(NL)
      %IF L=2 %AND I=J=C'S' %THENRESULT=C'%'
      %RESULT=I
%END
%EXTERNALROUTINE OUTSTRING %ALIAS "S#OUTSTRING"(%INTEGER CH, %STRINGNAME S)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      PRSTNG(S)
%END
%EXTERNALROUTINE EOUTSTRING %ALIAS "S#EOUTSTRING"(%INTEGER CH, %LONGINTEGER EBSTRING)
      %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH)
      EPRSTNG(EBSTRING)
%END
%EXTERNALROUTINE WRITE TEXT %ALIAS "S#WRITETEXT"(%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 %THENSTART
            R=10*R+SYM-'0'
         %FINISHELSESTART
            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

%EXTERNALROUTINE EWRITE TEXT %ALIAS "S#EWRITETEXT"(%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
%EXTERNALLONGREALFN READ1900 %ALIAS "S#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='-' %OR CURSYM='.' %OR %C
               CURSYM='@' %OR CURSYM='&' %OR CURSYM=''''
            CURSYM=NEXT
         %REPEAT
      %FINISHELSESTART
         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 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
%EXTERNALROUTINE PRINT1900 %ALIAS "S#PRINT1900"(%LONGREAL X, %INTEGER M,N)
      PRINT(X,M,N); SPACES(2)
%END
%EXTERNALROUTINE OUTPUT %ALIAS "S#OUTPUT"(%LONGREAL X)
      PRINT(X,0,10)
      PRINTSYMBOL(';')
      NEWLINE
%END
%EXTERNALINTEGERFN READ BOOLEAN %ALIAS "S#READBOOLEAN"
%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
%EXTERNALROUTINE WRITE BOOLEAN %ALIAS "S#WRITEBOOLEAN"(%INTEGER B)
      %IF B#0 %THEN PRINTSTRING("'TRUE'  ") %ELSE PRINTSTRING("'FALSE' ")
%END
%EXTERNALROUTINE COPYTEXT %ALIAS "S#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

%EXTERNALROUTINE ECOPY TEXT %ALIAS "S#ECOPYTEXT"(%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
%EXTERNALINTEGERFN ALRDCH %ALIAS "S#ALRDCH"
%INTEGER CH
      READCH(CH)
      %RESULT=CH
%END
%EXTERNALINTEGERFN ALNXCH %ALIAS "S#ALNXCH"
      %RESULT=IOCP(18,0)
%END
%EXTERNALROUTINE ALPRCH %ALIAS "S#ALPRCH"(%INTEGER CH)
      PRINTCH(CH)
%END
%EXTERNALROUTINE ALSKCH %ALIAS "S#ALSKCH"
%INTEGER CH
      READCH(CH)
%END

%EXTERNALINTEGERFN EALRDCH %ALIAS "S#EALRDCH"
%INTEGER CH
      READCH(CH)
      %RESULT=ITOETAB(CH)
%END
%EXTERNALINTEGERFN EALNXCH %ALIAS "S#EALNXCH"
      %RESULT=ITOETAB(IOCP(18,0))
%END
%EXTERNALROUTINE EALPRCH %ALIAS "S#EALPRCH"(%INTEGER EBCH)
      PRINTCH(ETOITAB(EBCH))
%END
%EXTERNALROUTINE ALGMON %ALIAS "S#ALGMON"
      %MONITOR
%END
!*
%EXTERNALROUTINE AFAULT %ALIAS "S#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
!

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