%EXTERNALINTEGERMAPSPEC COMREG %ALIAS "S#COMREGMAP"(%INTEGER N) %CONSTLONGREAL LOG10A=2.3025850929940456840179914546843642076011 %CONSTLONGREAL PI=3.141592653589793238462643 %CONSTLONGREAL R1= 1.2595802263029547@ 1{R'41C98867F42983DF'} %CONSTLONGREAL R2=-8.6186317517509520@ 1{R'C2562FB2813C6014'} %CONSTLONGREAL R3=-1.2766919133361079@ 0{R'C1146D547FED8A3D'} %CONSTLONGREAL R4=-8.3921038065840512@ -2{R'C0157BD961F06C89'} %CONSTLONGREAL S1= 2.7096164294378656@ 1{R'421B189E39236635'} %CONSTLONGREAL S2= 6.5581320451487386@ 0{R'4168EE1BDE0C3700'} %CONSTLONGREAL S3= 2.1441643116703661@ 0{R'41224E7F3CBDFE41'} %CONSTLONGREAL S4= 1.2676256708212610@ 0{R'41144831DAFBF542'} %CONSTLONGREAL RT3= 1.7320508075688772@ 0{R'411BB67AE8584CAA'} %CONSTLONGREAL PIBY6= 5.2359877559829887@ -1{R'40860A91C16B9B2C'} %CONSTLONGREAL PIBY2M1= 5.7079632679489661@ -1{R'40921FB54442D184'} %CONSTLONGREAL RT3M1=7.3205080756887728@ -1{R'40BB67AE8584CAA7'} %CONSTLONGREAL TANPIBY12= 2.6794919243112271@ -1{R'404498517A7B3559'} %CONSTLONGREAL PIBY4= 7.8539816339744816@ -1{R'40C90FDAA22168C2'} %CONSTLONGREAL A1= 7.5000000000000000@ -1{R'40C0000000000000'} %CONSTLONGREAL A2= 3.5398163397448309@ -2{R'3F90FDAA22168C23'} %CONSTLONGREAL SQRTHALF= 7.0710678118654753@ -1{R'40B504F333F9DE65'} %CONSTLONGREAL DEFALLT=SQRTHALF %CONSTLONGREAL MAX= 3.5371188760142201@ 15{R'4DC90FDAA22168C2'} %CONSTLONGREAL GREATEST= 7.2370055773322608@ 75{R'7FFFFFFFFFFFFFFF'} !* %CONSTLONGREAL half= 0.5 %CONSTINTEGER ExpExcess= 1023 %CONSTLONGREAL rteps= 1.49 @-8 ! If mod(x) < rteps, the exponent field of x is less than ExpExcess-26. ! ERROR ROUTINE %ROUTINE MLIBERR(%INTEGER N) %INTEGER I %SIGNALEVENT 10,N %END; ! MLIBERR %comment simple Functions; %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 %comment ENTIER can be obtained by call IMPs INTPT alias "S#INTPT" %comment Mathematical Functions %comment sqrt can be obtained from IMPS SQRT %alias "S#ISQRT" %comment Mathematical Functions %comment sqrt can be obtained from IMPS SQRT %alias "S#ISQRT" %comment SIN can be obtained from IMPS SIN %alias "S#ISIN" %comment COS can be obtained from IMPS COS %alias "S#ICOS" %EXTERNALLONGREALFN AARCTAN %ALIAS "S#AARCTAN"(%LONGREAL X1) !*********************************************************************** !* ALGOL TYPE ONE PARAMETER ARCTANGENT * !*********************************************************************** %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' %THEN XX1=1.0/XX1 %AND INV=1 %ELSE INV=0 %IF XX1>TANPIBY12 %THEN %C XX1=(RT3M1*XX1-1.0+XX1)/(XX1+RT3) %AND CONSTANT=PIBY6 XSQ=XX1*XX1 XX1=XX1*(R1/(XSQ+S1+(R2/(XSQ+S2+(R3/(XSQ+S3+(R4/(XSQ+S4))))))))+CONSTANT %IF INV=1 %THEN XX1=1.0-XX1+PIBY2M1 %IF SIGN=1 %THEN XX1=-XX1 %RESULT=XX1 %END %comment LN can be obtained from IMPS LOG %alias "S#ILOG" %comment EXP can be obtained from IMPS EXP %alias "S#IEXP" %comment terminating procedures %comment STOP can be obtained by call IMP's S#STOP %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 %comment Input-Output procedures %EXTERNALROUTINE INCHAR %ALIAS "S#INCHAR"(%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 OUTCHAR %ALIAS "S#OUTCHAR"(%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 %EXTERNALINTEGERFN LENGTH %ALIAS "S#LENGTH"(%STRINGNAME S) %RESULT=BYTEINTEGER(ADDR(S)) %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 OUTSTRING %ALIAS "S#OUTSTRING"(%INTEGER CH, %STRINGNAME S) %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH) PRSTNG(S) %END %EXTERNALROUTINE OUTTERMINATOR %ALIAS "S#OUTTERMINATOR"(%INTEGER CH) %IF CH#COMREG(23) %THEN SELECT OUTPUT(CH) PRINTSTRING("; ") %END %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 %comment environmental enquiries %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 %comment some extra procedures that may be useful %EXTERNALROUTINE ALGMON %ALIAS "S#ALGMON" %MONITOR %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 %EXTERNALLONGREALFN ALREAD %ALIAS "S#ALREAD" %LONGREAL X READ(X) SKIP SYMBOL %RESULT=X %END %endoffile