         Edinburgh IMP77 Compiler - Version 8.4

    1  %begin
    2  
    3  %ROUTINESPEC ERCC PRINTFL (%LONGREAL X, %INTEGER N)
    4  
    5  %ROUTINE ERCC PRINT (%LONGREAL X, %INTEGER N,M)
    6  !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*
    7  !*       PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
    8  !*       POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES     *
    9  !*       UNLESS (M=0) WHEN  (N+1) PLACES ARE REQUIRED.                 *
   10  !*                                                                     *
   11  !*       A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
   12  !*       AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS    *
   13  %CONSTLONGREAL DZ=0
   14  !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*
   15  %LONGREAL Y,Z,ROUND,FACTOR
   16  %INTEGER I,J,L,MORIG
   17  %BYTEINTEGER SIGN
   18        M=M&63;                           ! DEAL WITH STUPID PARAMS
   19        MORIG=M
   20        %IF N<0 %THEN N=1; N=N&31;        ! DEAL WITH STUPID PARAMS
   21        X=X+DZ;                           ! NORMALISE
   22        SIGN=' ';                         ! '+' IMPLIED
   23        %IF X<0 %THEN SIGN='-'
   24        Y=MOD(X);                         ! ALL WORK DONE WITH Y
   25        ROUND=0.5/10^M;                  ! ROUNDING FACTOR
   26        %IF Y>1.0*10^16 %OR N=0 %THENSTART;    ! MEANINGLESS FIGURES GENERATED
   27           %IF N>M %THEN M=N;             ! FOR FIXED POINT PRINTING
   28           ERCC PRINTFL(X,M);             ! OF ENORMOUS NUMBERS
   29           %RETURN;                       ! SO PRINT IN FLOATING FORM
   30        %FINISH
   31        I=0; Z=1; Y=Y+ROUND
   32        {%UNTIL Z>Y} %CYCLE;                ! COUNT LEADING PLACES
   33           I=I+1; Z=10*Z;                 ! NO DANGER OF OVERFLOW HERE
   34        %REPEAT %UNTIL Z>Y
   35        PRINTSYMBOL(SIGN)
   36        J=I-1; Z=10^J
   37        FACTOR=1/10
   38        %CYCLE
   39           {%UNTIL J<0} %CYCLE
   40              L=INT PT(Y/Z);              ! OBTAIN NEXT DIGIT
   41              Y=Y-L*Z; Z=Z*FACTOR;        ! AND REDUCE TOTAL
   42              PRINTSYMBOL(L+'0')
   43              J=J-1
   44           %REPEAT %UNTIL J<0
   45           %IF M=0 %THEN %EXIT;           ! NO DECIMAL PART TO BE O/P
   46           PRINTSTRING(".")
   47           J=M-1; Z=10^(J-1); M=0
   48           Y=10*Y*Z
   49        %REPEAT
   50  !!      %if MORIG>0 %start          { Chop any redundant trailing 0s}
   51  !!         opline_length=opline_length-1 %while %c
   52  !!           opline_l(opline_length-1)='0' %and opline_l(opline_length-2)#'.'
   53  !!      %finish
   54  %END;                                   ! OF ROUTINE PRINT
   55  
   56  %ROUTINE ERCC PRINTFL (%LONGREAL X, %INTEGER N)
   57  !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*
   58  !*       PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE       *
   59  !*       DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS.           *
   60  !*       CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X                  *
   61  !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*
   62  %LONGREAL SIGN,ROUND,FACTOR,LB,UB
   63  %CONSTLONGREAL DZ=0
   64  %INTEGER COUNT,INC
   65        inc=integer(addr(x))
   66        %if inc>>20&x'7ff'=x'7ff' %start
   67  !!         outstring("NAN {");
   68  !!         outhex(inc);
   69  !!         outhex(integer(addr(x)+4))
   70  !!         outsym('}'); %return
   71        %finish
   72        ROUND=0.5/10^N;                  ! TO ROUND SCALED NO
   73        LB=1-ROUND; UB=10-ROUND
   74        SIGN=1
   75        X=X+DZ;                           ! NORMALISE
   76        %IF X=0 %THEN COUNT=0 %ELSESTART
   77           %IF X<0 %THEN X=-X %AND SIGN=-SIGN
   78           INC=1; COUNT=0
   79           FACTOR=1/10
   80           %IF X<=1 %THEN FACTOR=10 %AND INC=-1
   81                                          ! FORCE INTO RANGE 1->10
   82           %WHILE X<LB %OR X>=UB %CYCLE
   83              X=X*FACTOR; COUNT=COUNT+INC
   84           %REPEAT
   85        %FINISH
   86        ERCC PRINT(SIGN*X,1,N)
   87        %if count#0 %start
   88           PRINTSTRING("E")
   89           WRITE(COUNT,0)
   90        %finish
   91  %END;                                   ! OF ROUTINE PRINTFL
   92  
   93  %endofprogram

   78 Statements compiled
