         Edinburgh IMP77 Compiler - Version 8.4

    1  %begin ;! force an extra scope since top-level routines like printsymbol were clashing with perms version.
    2  
    3  %reals %long
    4  
    5  ! This program shows explicitly the results of write(m,n) for each significant
    6  ! size of m and n, and tests the extreme cases of MIN and MAX INT.
    7  
    8  ! First, we replace the standard output calls with local versions which
    9  ! keep track of 'outpos', to help with formatting output into columns:
   10  
   11  ! In order to do this for the in-built 'write' etc, we have reimplemented local copies
   12  ! of the current library versions which have been tested and confirmed to be identical.
   13  
   14  ! The output table is rather wide and may need to be viewed using a small font.
   15  
   16  %own %integer outpos = 0
   17  
   18  %routine intrinsic printsymbol(%integer ch)
   19     printsymbol(ch)
   20  %end
   21  
   22  %routine printsymbol(%integer ch)
   23     intrinsic printsymbol(ch)
   24     %if ch = 'J'&31 %or ch = 'M'&31 %or ch = 'L'&31 %start ;! nl cr ff
   25        outpos = 0
   26     %else %if ch = 'H'&31 ;! bs
   27        outpos = outpos - 1 %if outpos > 0
   28     %else %if ch = 'I'&31 ;! tab
   29        outpos = (outpos + 8) & (\7)  ;! at least on linux
   30     %else
   31        outpos = outpos + 1
   32     %finish
   33  %end
   34  
   35  %routine newline
   36     printsymbol(nl)
   37  %end
   38  
   39  %routine newlines(%integer n)
   40     %integer i
   41     %return %if n <= 0
   42     newline %for i = 1, 1, n
   43  %end
   44  
   45  %routine space
   46     printsymbol(' ')
   47  %end
   48  
   49  %routine spaces(%integer n)
   50     %integer i
   51     %return %if n <= 0
   52     space %for i = 1, 1, n
   53  %end
   54  
   55  %routine printstring(%string (255) s)
   56     %integer i
   57     printsymbol(charno(s, i)) %for i = 1, 1, length(s)
   58  %end
   59  
   60  %routine write(%integer m, n)
   61    printstring("Please don't ever use plain 'write' in this program.  Use write68k for now."); newline
   62    printstring("The implementation in the current Imp77 is severely broken w.r.t. formatting."); newline
   63    %stop
   64  %end
?N unused
?M unused
   65  
   66  !%begin ; ! Sorry, all original comments {in brackets} were lost in an unfortunate reformatting.
   67  
   68  
   69  ! -----------------------------------------------------------------------------------------
   70  
   71     %routine write3l(%integer n, places);! Same as current Imp library
   72     
   73       ! Write an integer on the current output stream, to
   74       ! occupy PLACES character spaces on the page.
   75       ! Nominally based on PrintString(I to S(n, places))
   76       ! This version doesn't use strings though, and is
   77       ! therefore smaller and quicker.  It builds the
   78       ! characters "backwards" in an array
   79     
   80        %routine decimal(%integer n, %integer %name places, digits, vec)
   81           %integer p, sign, d, x
   82           vec = vec + 15
   83           sign = '-'
   84           %if n >= 0 %start
   85              n = -n
   86              sign = ' '
   87              sign = 0 %if places <= 0
   88           %finish
   89           %if places <= 0 %then places = -places %else places = places + 1
   90           p = vec
   91           %cycle 
   92              x = n // 10
   93              d = n - x * 10
   94              n = x
   95              vec = vec - 1
   96              byteinteger(vec) = '0' - d
   97           %repeat %until n = 0
   98           %if sign # 0 %start
   99              vec = vec - 1
  100              byteinteger(vec) = sign
  101           %finish
  102           digits = p - vec
  103        %end
  104        %string (32) ch
  105        ! Enough room for a 32 bit integer, plus sign
  106        %integer new, digit, sign, i
  107        length(ch) = 0
  108        ! First collect the digits
  109        %if n = 0 %start
  110           length(ch) = length(ch) + 1
  111           charno(ch, length(ch)) = '0'
  112           sign = 0
  113        %else
  114           sign = 1
  115           ! we make everything negative to avoid the -ve MaxInt wrap problem
  116           %if n > 0 %start
  117              sign = 0
  118              n = -n
  119           %finish
  120           %while n # 0 %cycle
  121              new = n // 10
  122              digit = (new * 10) - n
  123              length(ch) = length(ch) + 1
  124              charno(ch, length(ch)) = digit + '0'
  125              n = new
  126           %repeat
  127        %finish
  128        ! Now deal with the sign, taking into account the slightly
  129        ! idiosyncratic behaviour on positive numbers
  130        %if sign # 0 %start
  131           length(ch) = length(ch) + 1
  132           charno(ch, length(ch)) = '-'
  133        %else
  134           %if places > 0 %start
  135              length(ch) = length(ch) + 1
  136              charno(ch, length(ch)) = ' '
  137           %finish
  138        %finish
  139        ! Now we adjust Places, also slightly mysteriously
  140        %if places <= 0 %then places = -places %else places = places + 1
  141        ! The array at CH now contains the characters (backwards)
  142        ! and the character count is in NEXT
  143        %while places > length(ch) %cycle
  144           length(ch) = length(ch) + 1
  145           charno(ch, length(ch)) = ' '
  146           places = places - 1
  147        %repeat
  148        %for i = length(ch), -1, 1 %cycle
  149           printsymbol(charno(ch, i))
  150        %repeat
  151     %end
?DECIMAL unused
  152     
  153  ! -----------------------------------------------------------------------------------------
  154  
  155  %routine vax write(%integer n, p)
  156  %string(63)%fn itos(%integer n, p)
  157     %string(255) answer
  158     %byteintegerarray a(0:64)
  159     %integer sign, sym, pt, val
  160     val = p
  161     %if p > 0 %then p = p+1 %else p = -p
  162     p = 63 %if p > 63
  163     sign = ' '
  164     sign = 0 %if val <= 0
  165     pt = 0
  166     %if n < 0 %start
  167        sign = '-'
  168        %if n = 16_80000000 %start
  169           string(addr(a(pt))) = "8463847412"
  170           pt = pt + 10
  171           -> set
  172           %finish
  173        n = -n
  174        %finish
  175     %cycle
  176        sym = n-n//10*10
  177        pt = pt+1
  178        a(pt) = sym+'0'
  179        n = n//10
  180     %repeat %until n = 0
  181    set:
  182     %if sign # 0 %start
  183        pt = pt+1;  a(pt) = sign
  184     %finish
  185     %while pt < p %cycle
  186        pt = pt+1;  a(pt) = ' '
  187     %repeat
  188     answer = ""
  189     %cycle
  190        answer = answer.tostring(a(pt))
  191        pt = pt-1
  192     %repeat %until pt = 0
  193     %result = answer
  194  %end
  195     space %and p = p-1 %while p > 62
  196     printstring(itos(n, p))
  197  %end
  198  
  199  ! -----------------------------------------------------------------------------------------
  200     
  201     %routine write68k(%integer v, p)
  202        %integer vv, q, pos
  203        %byte %integer %array store(0 : 15)
  204        vv = v
  205        vv = -vv %if vv > 0
  206        pos = 15
  207        %while vv <= -10 %cycle
  208           q = vv // 10
  209           store(pos) = q * 10 - vv + '0'
  210           pos = pos - 1
  211           vv = q
  212        %repeat
  213        store(pos) = '0' - vv
  214        %if p <= 0 %start
  215           spaces(pos - 16 - p) %if p < 0
  216        %finish %else %start
  217           spaces(pos - 16 + p)
  218           printsymbol(' ') %if v >= 0
  219        %finish
  220        printsymbol('-') %if v < 0
  221        printsymbol(store(pos)) %and pos = pos + 1 %until pos = 16
  222     %end
  223  
  224  ! -----------------------------------------------------------------------------------------
  225     
  226  %routine emaswrite(%integer value, places)
  227     !***********************************************************************
  228     !*    SIMPLE MINDED ALL IMP VERSION NOT USING STRINGS                  *
  229     !***********************************************************************
  230     %string (15) %fn swrite %alias "S#SWRITE"(%integer value, places)
  231        !***********************************************************************
  232        !*    SIMPLE MINDED ALL IMP VERSION                                    *
  233        !***********************************************************************
  234        %string (1) sign
  235        %string (255{15}) res
  236        %integer work, ptr
  237        %string (1) %array ch(0 : 15)
  238        res = ""
  239        sign = " "
  240        %if value = X'80000000' %then %start
  241           res = "-2147483548"
  242           !res = " " . res %for ptr = 1, 1, places - 10   ;! causes run-time string overflow
  243           %if places <= 0 %start
  244              places = -15 %if places < -15
  245              res = " " . res %while length(res) < |places|
  246           %else
  247              places = 14 %if places > 14
  248              res = " " . res %while length(res) < places
  249              res = " " . res
  250           %finish
  251           %result = res
  252        %finish
  253        %if value = X'80000000' %then %result = "-2147483648"
  254        %if value < 0 %then sign = "-" %and value = -value
  255        ptr = 0
  256        %cycle 
  257           work = value // 10
  258           ch(ptr) = tostring(value - 10 * work + '0')
  259           value = work
  260           ptr = ptr + 1
  261        %repeat %until value = 0
  262        res = res . " " %for work = ptr, 1, places - 1
  263        work = ptr - 1
  264        res = res . sign
  265        res = res . ch(ptr) %for ptr = work, -1, 0
  266        %result = res
  267     %end
  268     %integer sign, work, ptr
  269     %byte %integer %array ch(0 : 15)
  270     sign = ' '
  271     %if value = X'80000000' %then printstring(swrite(value, places)) %and %return
  272     %if value < 0 %then sign = '-' %and value = -value
  273     ptr = 0
  274     %cycle 
  275        work = value // 10
  276        ch(ptr) = value - 10 * work
  277        value = work
  278        ptr = ptr + 1
  279     %repeat %until value = 0
  280     %if places > ptr %then spaces(places - ptr)
  281     work = ptr - 1
  282     printsymbol(sign)
  283     printsymbol(ch(ptr) + '0') %for ptr = work, -1, 0
  284  %end
  285  
  286  ! -----------------------------------------------------------------------------------------
  287     
  288     %routine emasi77write(%integer num, pl)
  289        %string (63) %function itos(%integer n, places)
  290           !
  291           ! ITOS0
  292           !
  293           ! Returns a string representing the argument as
  294           ! a decimal number, without any space justification
  295           ! or padding.
  296           !
  297           %const %integer maxdigits = 255 - 64
  298           %const %integer maxint = 16_7FFFFFFF
  299           %const %integer minint = 16_80000000
  300           %const %integer minintlastdigit = '8'
  301           %string (maxdigits) %function itos0(%integer n)
  302              %string (maxdigits) res
  303              %integer s, p, e
  304              s = 0
  305              %if n < 0 %start
  306                 s = -1
  307                 ! mark -ve
  308                 %if n = minint %start
  309                    ! special case
  310                    n = maxint
  311                    ! rely on  "max int = (-min int) - 1"
  312                    s = 1
  313                    ! mark special
  314                 %finish %else %start
  315                    n = -n
  316                 %finish
  317              %finish
  318              p = addr(res) + maxdigits
  319              e = p
  320              ! end point
  321              byteinteger(p) = rem(n, 10) + '0' %and n = n // 10 %and p = p - 1 %until n = 0
  322              %if s # 0 %start
  323                 ! negative
  324                 byteinteger(p) = '-'
  325                 p = p - 1
  326                 %if s > 0 %start
  327                    ! min int
  328                    charno(res, maxdigits) = minintlastdigit
  329                 %finish
  330              %finish
  331              byteinteger(p) = e - p
  332              ! length byte
  333              %result = string(p)
  334           %end
  335           %string (63 + maxdigits) res
  336           %integer p, slen
  337           p = addr(res) + 62
  338           ! digit string right justified
  339           string(p) = itos0(n)
  340           slen = byteinteger(p)
  341           %if n > 0 %and places > 0 %start
  342              byteinteger(p) = ' '
  343              p = p - 1
  344              slen = slen + 1
  345           %finish
  346           %if places <= 0 %start
  347              places = -places
  348           %finish %else %start
  349              places = places + 1
  350           %finish
  351           places = 63 %if places > 63
  352           %while slen < places %cycle
  353              byteinteger(p) = ' '
  354              p = p - 1
  355              slen = slen + 1
  356           %repeat
  357           byteinteger(p) = slen
  358           %result = string(p)
  359        %end
  360        %string (63) res
  361        res = itos(num, pl)
  362        pl = \pl %if pl < 0
  363        spaces(pl - 62)
  364        printstring(res)
  365     %end
  366  
  367  ! -----------------------------------------------------------------------------------------
  368  
  369     %routine mouseswrite(%integer n, p)
  370        %string (72) %fn itos(%integer n, p)
  371           %byte %array s(0 : 72)
  372           %integer x, sign
  373           x = 73
  374           sign = 0
  375           %if p > 0 %start
  376              sign = ' '
  377              p = 72 - p
  378           %else
  379              p = p + 73
  380           %finish
  381           p = 1 %if p <= 0
  382           %if n < 0 %start
  383              sign = '-'
  384              n = -n
  385              %if n < 0 %start
  386                 !max int
  387                 n = n // (-10)
  388                 x = x - 1
  389                 s(x) = '8'
  390              %finish
  391           %finish
  392           %cycle 
  393              x = x - 1
  394              s(x) = rem(n, 10) + '0'
  395              n = n // 10
  396           %repeat %until n = 0
  397           %if sign # 0 %start
  398              x = x - 1
  399              s(x) = sign
  400           %finish
  401           %while x > p %cycle
  402              x = x - 1
  403              s(x) = ' '
  404           %repeat
  405           x = x - 1
  406           s(x) = 72 - x
  407           %result = string(addr(s(x)))
  408        %end
  409        printstring(itos(n, p))
  410     %end
  411  
  412  ! -----------------------------------------------------------------------------------------
  413  
  414  %ROUTINE DEC10 WRITE(%INTEGER N, S)
  415     %ROUTINESPEC P(%INTEGER N)
  416     %INTEGER SIGN
  417     %IF S<=0 %THEN SIGN=S %ELSE SIGN = ' ';  !GIVE NO SIGN FOR WRITE(N,0)
  418     S=|S|; S=63 %IF S>63
  419     %IF N < 0 %START         ;! doesn't use negative trick but could be easily modified to.
  420        N = -N
  421        SIGN = '-'
  422     %FINISH
  423     P(N)
  424     %ROUTINE P(%INTEGER N)
  425        S = S-1
  426        P(N//10) %IF N >= 10
  427        %IF SIGN > 0 %START
  428           SPACES(S-1)
  429           PRINTSYMBOL(SIGN);  SIGN = 0
  430        %FINISH %ELSE %IF SIGN<0 %THEN SPACES(S) %AND SIGN=0;   !FOR -VE S
  431        PRINTSYMBOL(REM(N,10)+'0')
  432     %END
  433  %END
  434  
  435  ! -----------------------------------------------------------------------------------------
  436  
  437  ! #########################################################################################
  438  
  439  %ROUTINESPEC EMAS PRINTFL (%LONGREAL X, %INTEGER N)
  440  
  441  %ROUTINE EMAS PRINT(%LONGREAL X, %INTEGER N,M)
  442  !***********************************************************************
  443  !*       PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
  444  !*       POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES     *
  445  !*       UNLESS (M=0) WHEN  (N+1) PLACES ARE REQUIRED.                 *
  446  !*                                                                     *
  447  !*       A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
  448  !*       AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS    *
  449  !***********************************************************************
  450  %CONSTLONGREAL DZ=0
  451  %LONGREAL Y,Z,ROUND,FACTOR
  452  %INTEGER I,J,L,MORIG
  453  %BYTEINTEGER SIGN
  454        M=M&63;                           ! DEAL WITH STUPID PARAMS
  455        MORIG=M
  456        %IF N<0 %THEN N=1; N=N&31;        ! DEAL WITH STUPID PARAMS
  457        X=X+DZ;                           ! NORMALISE
  458        SIGN=' ';                         ! '+' IMPLIED
  459        %IF X<0 %THEN SIGN='-'
  460        Y=|X|;                            ! ALL WORK DONE WITH Y
  461        ROUND=0.5/10^M;                  ! ROUNDING FACTOR
  462        %IF Y>1.0*10^16 %OR N=0 %THENSTART;    ! MEANINGLESS FIGURES GENERATED
  463           %IF N>M %THEN M=N;             ! FOR FIXED POINT PRINTING
  464           EMAS PRINTFL(X,M);             ! OF ENORMOUS NUMBERS
  465           %RETURN;                       ! SO PRINT IN FLOATING FORM
  466        %FINISH
  467        I=0; Z=1; Y=Y+ROUND
  468        %CYCLE;                ! COUNT LEADING PLACES
  469           I=I+1; Z=10*Z;                 ! NO DANGER OF OVERFLOW HERE
  470        %REPEAT %UNTIL Z>Y
  471        PRINTSYMBOL(SIGN)
  472        J=I-1; Z=10^J
  473        FACTOR=1/10
  474        %CYCLE
  475           %CYCLE
  476              L=INT PT(Y/Z);              ! OBTAIN NEXT DIGIT
  477              Y=Y-L*Z; Z=Z*FACTOR;        ! AND REDUCE TOTAL
  478              PRINTSYMBOL(L+'0')
  479              J=J-1
  480           %REPEAT %UNTIL J<0
  481           %IF M=0 %THEN %EXIT;           ! NO DECIMAL PART TO BE O/P
  482           PRINTSTRING(".")
  483           J=M-1; Z=10^(J-1); M=0
  484           Y=10*Y*Z
  485        %REPEAT
  486        %if MORIG>0 %start          { Chop any redundant trailing 0s}
  487           !opline_length=opline_length-1 %while %c
  488           !  opline_l(opline_length-1)='0' %and opline_l(opline_length-2)#'.'
  489        %finish
  490  %END;                                   ! OF ROUTINE PRINT
  491  
  492  %ROUTINE EMAS PRINTFL (%LONGREAL X, %INTEGER N)
  493  !***********************************************************************
  494  !*       PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE       *
  495  !*       DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS.           *
  496  !*       CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X                  *
  497  !***********************************************************************
  498  %LONGREAL SIGN,ROUND,FACTOR,LB,UB
  499  %CONSTLONGREAL DZ=0
  500  %INTEGER COUNT,INC
  501        inc=integer(addr(x))
  502        %if inc>>20&x'7ff'=x'7ff' %start
  503           printstring("NAN");
  504           !outhex(inc);
  505           !outhex(integer(addr(x)+4))
  506           !outsym('}');
  507           %return
  508        %finish
  509        ROUND=0.5/10^N;                  ! TO ROUND SCALED NO
  510        LB=1-ROUND; UB=10-ROUND
  511        SIGN=1
  512        X=X+DZ;                           ! NORMALISE
  513        %IF X=0 %THEN COUNT=0 %ELSESTART
  514           %IF X<0 %THEN X=-X %AND SIGN=-SIGN
  515           INC=1; COUNT=0
  516           FACTOR=1/10
  517           %IF X<=1 %THEN FACTOR=10 %AND INC=-1
  518                                          ! FORCE INTO RANGE 1->10
  519           %WHILE X<LB %OR X>=UB %CYCLE
  520              X=X*FACTOR; COUNT=COUNT+INC
  521           %REPEAT
  522        %FINISH
  523        EMAS PRINT(SIGN*X,1,N)
  524        %if count#0 %start
  525           PRINTSTRING("@")  ;! original had 'E' - was that correct?
  526           WRITE68K(COUNT,0)
  527        %finish
  528  %END;                                   ! OF ROUTINE PRINTFL
  529  
  530  ! -----------------------------------------------------------------------------------------
  531  %ROUTINESPEC ERCC PRINTFL(%LONGREAL X, %INTEGER N)
  532  %ROUTINE ERCC PRINT(%LONGREAL X, %INTEGER N,M)
  533  !***********************************************************************
  534  !*       PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
  535  !*       POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES     *
  536  !*       UNLESS (M=0) WHEN  (N+1) PLACES ARE REQUIRED.                 *
  537  !*                                                                     *
  538  !*       A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
  539  !*       AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS    *
  540  !***********************************************************************
  541  %CONSTLONGREAL PMAX= 1@16
  542  %CONSTLONGREAL DZ=0
  543  %LONGREAL Y,Z,ROUND,FACTOR
  544  %INTEGER I,J,L
  545  %BYTEINTEGER SIGN
  546        M=M&63;                           ! DEAL WITH STUPID PARAMS
  547        %IF N<0 %THEN N=1; N=N&31;        ! DEAL WITH STUPID PARAMS
  548        X=X+DZ;                           ! NORMALISE
  549        SIGN=' ';                         ! '+' IMPLIED
  550        %IF X<0 %THEN SIGN='-'
  551        Y=|X|;                            ! ALL WORK DONE WITH Y
  552        ROUND=0.5/10^M;                   ! ROUNDING FACTOR
  553        %IF Y>PMAX %OR N=0 %THENSTART;    ! MEANINGLESS FIGURES GENERATED
  554           %IF N>M %THEN M=N;             ! FOR FIXED POINT PRINTING
  555           ERCC PRINTFL(X,M);             ! OF ENORMOUS NUMBERS
  556           %RETURN;                       ! SO PRINT IN FLOATING FORM
  557        %FINISH
  558        I=0; Z=1; Y=Y+ROUND
  559        %CYCLE;                           ! COUNT LEADING PLACES
  560           I=I+1; Z=10*Z;                 ! NO DANGER OF OVERFLOW HERE
  561        %REPEAT %UNTIL Z>Y
  562        SPACES(N-I);                      ! O.K FOR ZERO OR -VE SPACES
  563        PRINT SYMBOL(SIGN)
  564        J=I-1; Z=10^J
  565        FACTOR=1/10
  566        %CYCLE
  567           %CYCLE
  568              L=INT PT(Y/Z);              ! OBTAIN NEXT DIGIT
  569              Y=Y-L*Z; Z=Z*FACTOR;        ! AND REDUCE TOTAL
  570              PRINT SYMBOL(L+'0')
  571              J=J-1
  572           %REPEAT %UNTIL J<0
  573           %IF M=0 %THENRETURN;           ! NO DECIMAL PART TO BE O/P
  574           PRINTSTRING(".")
  575           J=M-1; Z=10^(J-1); M=0
  576           Y=10*Y*Z
  577        %REPEAT
  578  %END;                                   ! OF ROUTINE PRINT
  579  
  580  %ROUTINE ERCC PRINTFL(%LONGREAL X, %INTEGER N)
  581  !***********************************************************************
  582  !*       PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE       *
  583  !*       DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS.           *
  584  !*       CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X                  *
  585  !***********************************************************************
  586  %CONSTLONGREAL DZ=0
  587  %LONGREAL SIGN,ROUND,FACTOR,LB,UB
  588  %INTEGER COUNT,INC
  589        ROUND=0.5/10^N;                   ! TO ROUND SCALED NO
  590        LB=1-ROUND; UB=10-ROUND
  591        SIGN=1
  592        X=X+DZ;                           ! NORMALISE
  593        %IF X=0 %THEN COUNT=-99 %ELSESTART
  594           %IF X<0 %THEN X=-X %AND SIGN=-SIGN
  595           INC=1; COUNT=0
  596           FACTOR=1/10
  597           %IF X<=1 %THEN FACTOR=10 %AND INC=-1
  598                                          ! FORCE INTO RANGE 1->10
  599           %WHILE X<LB %OR X>=UB %CYCLE
  600              X=X*FACTOR; COUNT=COUNT+INC
  601           %REPEAT
  602        %FINISH
  603        ERCC PRINT(SIGN*X,1,N)
  604        PRINTSTRING("@")
  605        emasWRITE(COUNT,2)
  606  %END;                                   ! OF ROUTINE PRINTFL
  607  ! -----------------------------------------------------------------------------------------
  608  
  609  %routine vax printfl(%long %real r, %integer places)
  610     %string (63) %fn ftos(%long %real r, %integer p)
  611        %routine vax fraction(%long %real r, %integer places, %string (*) %name s)
  612           %long %real %fn fracpt(%long %real x)
  613              %long %real z
  614              z = x - intpt(x)
  615              z = z + 1.0 %if z < 0
  616              %result = z
  617           %end
  618           %return %if places <= 0
  619           s = s . "."
  620           %while places > 0 %cycle
  621              places = places - 1
  622              r = fracpt(r) * 10
  623              s = s . tostring(intpt(r) + '0')
  624           %repeat
  625        %end
  626        %routine round(%long %real %name v, %integer p)
  627           %long %real x
  628           %return %if v = 0
  629           %if v < 0 %then x = -0.5 %else x = 0.5
  630           %cycle 
  631              p = p - 1
  632              %exit %if p < 0
  633              x = x / 10
  634           %repeat
  635           v = v + x
  636        %end
  637        {XOWN}%string (63) s = ""
  638        %integer exp, sym
  639        !p = 7 %if p > 7                                                  ;! WHY??????????????????????????    p = 7 %if p > 7
  640                                                                           ! removing the p<=7 constraint makes this behave the same as EMAS PRINTFL
  641        %if r < 0 %then sym = '-' %and r = -r %else sym = ' '
  642        %if r = 0 %start
  643           exp = -99
  644        %else
  645           exp = 0
  646           exp = exp + 1 %and r = r / 10 %while r >= 10
  647           exp = exp - 1 %and r = r * 10 %while r < 1
  648        %finish
  649        round(r, p)
  650        exp = exp + 1 %and r = r / 10 %if r >= 10
  651        s = s . tostring(intpt(r) + '0')
  652        vax fraction(r, p, s)
  653        %result = tostring(sym) . s . "@" . itos(exp, 0)
  654     %end
  655     places = \places %if places < 0
  656     spaces(places - 62)
  657     printstring(ftos(r, places))
  658  %end
  659  
  660  ! -----------------------------------------------------------------------------------------
  661  
  662  %long %real %fn dec10 fracpt(%long %real x)
  663     %long %real z
  664     z = x - intpt(x)
  665     z = z + 1.0 %if z < 0
  666     %result = x - intpt(x)
  667     
  668  %end
  669           
  670  %ROUTINE DEC10 FRACTION(%LONG %REAL R, %INTEGER PLACES)
  671     %RETURN %IF PLACES <= 0
  672     PRINTSYMBOL('.')
  673     %WHILE PLACES>0 %CYCLE
  674        R = dec10 FRACPT(R)*10.0   ; ! first digit after the point of a 0.xxxxxxx positive number.
  675        PLACES = PLACES-1
  676        PRINTSYMBOL(INTPT(R)+'0')
  677     %REPEAT
  678  %END
  679  
  680  %ROUTINE DEC10 PRINTFL(%LONG %REAL R, %INTEGER P)
  681     %INTEGER EXP,SIGN, pp
  682     %real roundup
  683     SIGN=' '
  684     SIGN='-' %AND R = -R %IF R < 0
  685     PRINTSYMBOL(SIGN)
  686     %IF R = 0 %START
  687        EXP = 0   ;! Was EXP = 99 for completely unknown reasons.
  688     %ELSE
  689        ! Normalise:
  690        EXP = 0
  691        EXP = EXP + 1 %AND R = R*0.1 %WHILE R >= 10.0
  692        EXP = EXP - 1 %AND R = R*10.0 %WHILE R < 1.0
  693        ! R should now be a single digit followed by a decimal part, with the exponent adjusted appropriately
  694        ! Round to P places:
  695        roundup = 0.5
  696        %IF P <= 0 %START
  697           !R = R+0.5 ;! round to an int?
  698           pp = 0
  699        %ELSE
  700           ! This was just not working so I've replaced it with the 'pp' code below.  I suspect faulty exponentiation?
  701           !R = R + 0.5*10\(-P)
  702           !R = R + 0.5*10^(-P)
  703           pp = p
  704        %FINISH
  705        %while pp > 0 %then roundup = roundup / 10 %and pp = pp - 1
  706        R = R + roundup
  707     %FINISH
  708     PRINTSYMBOL(INT PT(R)+'0')
  709     DEC10 FRACTION(R,P)
  710     PRINTSYMBOL('@'); WRITE68K(EXP,1)
  711  %END
  712  
  713  %ROUTINE DEC10 PRINT(%LONG %REAL R, %INTEGER B,A)
  714     %LONG %REAL RM
  715     %CONSTINTEGER MAX INT=16_7FFFFFFF
  716     %INTEGER SIGN
  717     %ROUTINE P(%INTEGER N)
  718        B = B-1
  719        P(N//10) %IF N >= 10
  720        %IF SIGN # 0 %START
  721           SPACES(B-1)
  722           PRINTSYMBOL(SIGN);  SIGN = 0
  723        %FINISH
  724        PRINTSYMBOL(REM(N,10)+'0')
  725     %END
  726     RM=|R|
  727     DEC10 PRINTFL(R, B+A) %AND %RETURN %IF RM> MAX INT
  728     %IF A<=0 %START
  729        RM=RM+0.5
  730     %ELSE
  731        !RM=RM+0.5*10\(-A)
  732        RM=RM+0.5*10^(-A)
  733     %FINISH
  734     %IF B<=0 %THEN SIGN=0 %ELSE SIGN=' '
  735     %IF R<0 %THEN SIGN='-'
  736     P(INT PT(RM));  !THUS ALLOWING FOR -0.1 ETC.
  737     DEC10 FRACTION(RM,A)
  738  %END
  739  
  740  ! -----------------------------------------------------------------------------------------
  741  
  742  %routine print 68k(%long %real x, %integer n,m)
  743  %constreal pmax = 2147483647.0
  744  %long %real y,z,POW
  745  %integer i=0,l,count=0,sign
  746    sign = ' '
  747    sign = '-' %if x < 0
  748    !y = |x|+0.5/10.0\{^}m;  !modulus, rounded
  749    POW = 10.0^|m|
  750    POW = 0.5/POW
  751    y = |x|
  752    y = y+POW;  !modulus, rounded
  753    %if y > pmax %start
  754      count = count+1 %and y = y/10.0 %until y < 10.0
  755    %finish
  756    z = 1.0
  757    %cycle
  758      i = i+1;  z = z*10.0
  759    %repeat %until z > y
  760    spaces(n-i)
  761    printsymbol(sign) %unless sign = ' ' %and n <= 0            ;! n < 0 just makes a difference of one space character
  762    %cycle
  763      z = z/10.0
  764      l = int pt(y/z)
  765      y = y-l*z
  766      printsymbol(l+'0')
  767      i = i-1
  768      %exit %if i+m <= 0
  769      print symbol('.') %if i = 0
  770    %repeat
  771    printsymbol('@') %and write 68k(count,0) %if count # 0
  772  %end;  !print
  773  
  774  %routine printfl 68k(%long %real x, %integer n)
  775  %long %real y,round
  776  %integer count=-99,sign=0
  777    %if x # 0 %start
  778      x = -x %and sign = 1 %if x < 0
  779      !Adjust X so that 1.0 <= rounded(X) < 10.0
  780      !count = 0;  round = 0.5\{^}n
  781      count = 0;  round = 0.5^|n|
  782      y = 1.0-round
  783      %if x < y %start;  !ie rounded(X) < 1.0
  784        count = count-1 %and x = x*10.0 %until x >= y
  785      %finish %else %start
  786        y = 10.0-round
  787        %while x >= y %cycle;  !ie rounded(X) > 10.0
  788          count = count+1;  x = x/10.0
  789        %repeat
  790      %finish
  791      x = -x %if sign # 0
  792    %finish
  793    print 68k(x,1,n)
  794    printsymbol('@')
  795    write 68k(count,0)
  796  %end;  !printfl
  797  
  798  ! -----------------------------------------------------------------------------------------
  799  %routine mousesprintfl(%real r, %integer places)
  800     %routine round(%real %name v, %integer p)
  801        %real x
  802        %return %if v = 0
  803        %if v < 0 %then x = -0.5 %else x = 0.5
  804        %cycle 
  805           p = p - 1
  806           %exit %if p < 0
  807           x = x / 10
  808        %repeat
  809        v = v + x
  810     %end
  811     %routine fraction(%real r, %integer places, %string (*) %name s)
  812        %long %real %fn fracpt(%long %real x)
  813           %long %real z
  814           z = x - intpt(x)
  815           z = z + 1.0 %if z < 0
  816           %result = z
  817        %end
  818        !%realfn MOUSES FRACPT(%real r)   ;! dependent on machine representation of floating point.
  819        !   %integer m,x,z
  820        !   %if |R| >= 1.0 %start
  821        !      x = integer(addr(r))
  822        !      z = x>>24&b'01111111'
  823        !      %result = 0 %if z > x'46'
  824        !      m = -1
  825        !      m = m<<4 %and z = z+1 %while z < x'46'
  826        !      x = x&(m!x'FF000000')
  827        !      r = r-real(addr(x))
  828        !   %finish
  829        !   r = r+1 %if r < 0
  830        !   %result = r
  831        !%end
  832                                                           
  833        %return %if places <= 0
  834        s = s . "."
  835        %while places > 0 %cycle
  836           places = places - 1
  837           r = fracpt(r) * 10
  838           s = s . tostring(intpt(r) + '0')
  839        %repeat
  840     %end
  841     %string (64) %fn ftos(%real r, %integer p)
  842        {XOWN}%string (64) s = ""
  843        %integer exp, sym
  844        p = 7 %if p > 7
  845        %if r < 0 %then sym = '-' %and r = -r %else sym = ' '
  846        %if r = 0 %start
  847           exp = -99
  848        %else
  849           exp = 0
  850           exp = exp + 1 %and r = r / 10 %while r >= 10
  851           exp = exp - 1 %and r = r * 10 %while r < 1
  852        %finish
  853        round(r, p)
  854        exp = exp + 1 %and r = r / 10 %if r >= 10
  855        s = s . tostring(intpt(r) + '0')
  856        fraction(r, p, s)
  857        s = s . "@" . itos(exp, 0)
  858        %result = s
  859     %end
  860     printstring(ftos(r, places))
  861  %end
  862  ! -----------------------------------------------------------------------------------------
  863  
  864      ! Convert a floating point number to a string, along the lines of
  865      ! +/-nnn.nnn@+/-nn, to occupy Places character spaces
  866      !                        with sf significant figures.
  867      ! Rounding/truncation will occur to ensure sf limits
  868      !
  869      ! %longreal f = floating point number to convert to a string
  870      ! %integer sf = number of significant figures required
  871      !      places = number of characters in converted string
  872      !
  873      ! N.B. sf must be in the range of accuracy of %longreal (<15)
  874      !  places must be slightly greater than sf
  875      !         (to allow for sign and scientific notation)
  876      !         sign uses 1 character (+ is omitted)
  877      !         decimal point uses 1 character
  878      !         scientific notation could use :
  879      !                1 char for "@" ndicating scientific notation
  880      !                1 char for sign of exponent (sign always present)
  881      !                1+ char for integer exponent
  882      !
  883      ! N.B. scientific notation is only used if the decimal string could
  884      !      not fit in the places required
  885      !
  886      ! eg. F to S (0.003999, 3, 7) -> " 0.004 " (note rounding creates zeros after the 4)
  887      ! or
  888      ! eg. F to S (0.003999, 3, 4) -> " 4.00@-3" (converted to scientific notation to fit)
  889      ! eg. F to S (0.003999, 3, 6) -> " 0.004" (fits exactly)
  890      !
  891      %string(255) %function imp77 F to S( %longreal f, %integer sf, places)
  892          %string(255) s,sx
  893          %string(15) science
  894          %integer dc,carry
  895          %integer sign,exponent, digit, point
  896  
  897          %if (sf > 14) %then sf = 14
  898  
  899          %begin
  900              %integer i
  901              %integerarray digits(1:sf+1)
  902  
  903              sign = 0
  904  
  905              %for i = 1,1,sf+1 %cycle
  906                  digits(i) = 0
  907              %repeat
  908  
  909              %if (f < 0) %then sign = 1 %and f = -f
  910  
  911              ! clear the floating point string
  912              length(s) = 0
  913  
  914              %if (f = 0) %start
  915                  ! convert to positive zero
  916                  sign = 0
  917                  dc = 2
  918                  sf = 2
  919                  exponent = 0
  920                  point = 1
  921              %finish %else %start
  922                  ! prepare the exponent, point values for (f # 0)
  923                  ! evaluate the exponent value
  924                  exponent = 0
  925                  %while f < 1 %cycle
  926                      f = f * 10
  927                      exponent = exponent - 1
  928                  %repeat
  929  
  930                  %while f >= 10 %cycle
  931                      f = f / 10
  932                      exponent = exponent + 1
  933                  %repeat
  934  
  935                  ! locate the decimal point
  936                  point = 1
  937                  ! zero the digit count
  938                  dc = 0
  939  
  940                  ! Loop to get the significant figure digits with an extra digit
  941                  ! so we can use it to round the the required sig figs
  942                  ! Rounding as we go through this loop can "oversize" the digit.
  943                  ! The next stage does the rounding to the correct sig fig.
  944                  %for i = 1,1,sf + 1 %cycle
  945                      digit = int pt(f)
  946                      %if (digit > 9) %then digit = 9
  947                      dc = dc + 1
  948                      digits(dc) = digit
  949                      f = (f - digit)*10
  950                  %repeat
  951  
  952                  ! do the rounding to the sf significant figures
  953                  %if (digits(dc) > 4) %start
  954                      ! we need to possibly round up the digits sequence
  955                      carry = 1
  956                      %for i = dc - 1,-1,1 %cycle
  957                          digits(i) = digits(i) + carry
  958                          %if (digits(i) > 9) %start
  959                              carry = 1
  960                              digits(i) = 0
  961                          %finish %else %start
  962                              carry = 0
  963                          %finish
  964                      %repeat
  965                  %finish
  966                  ! ignore the rounding digit
  967                  dc = dc - 1
  968  
  969                  ! Now eliminate any trailing zeros
  970                  ! We assume that rounding has created
  971                  ! a sequence of trailing zeros
  972                  %while (digits(dc) = 0) %and (dc > 1) %cycle
  973                      dc = dc - 1
  974                  %repeat
  975                  sf = dc
  976              %finish
  977  
  978              length(s) = 0
  979              point = 1
  980              %for i = 1,1,sf %cycle
  981                  s = s.tostring(digits(i) + '0')
  982                  %if (point = i) %then s = s."."
  983              %repeat
  984              %if (sf = point) %then s = s."0"
  985              %if (exponent < 0) %then s=s."@-".itos(-exponent,0)
  986              %if (exponent > 0) %then s=s."@+".itos(exponent,0)
  987              science = s
  988  
  989              ! So, now for the other floating point layouts
  990              ! we should see which version will fit into the places allowed
  991              ! 1) 0.00000nnnn (point <= 0)
  992              ! OR
  993              ! 2) nnnn.0 (point = sf)
  994              ! OR
  995              ! 3) nnnn00000.0 (point > sf)
  996              !
  997              length(s) = 0
  998              point = exponent + 1
  999              ! First form the sig fig digit string
 1000              ! possibly including a decimal point
 1001              %for i = 1,1,sf %cycle
 1002                  s = s.tostring(digits(i) + '0')
 1003                  %if (point = i) %then s = s."."
 1004              %repeat
 1005  
 1006              ! Checking for format (1)
 1007              ! 1) 0.00000nnnn (point <= 0)
 1008              %if (point <= 0) %start
 1009                  %for i=1,1,-point %cycle
 1010                      s = "0".s
 1011                  %repeat
 1012                  s = "0.".s
 1013              %finish
 1014  
 1015              ! Checking for format (2)
 1016              ! 2) nnnn.0 (point = sf)
 1017              %if (point = sf) %start
 1018                  s = s."0"
 1019              %finish
 1020  
 1021              ! Checking for format (3)
 1022              ! 3) nnnn00000.0 (point > sf)
 1023              %if (point > sf) %start
 1024                  %for i = 1,1,(point - sf) %cycle
 1025                      s = s."0"
 1026                  %repeat
 1027                  s = s.".0"
 1028              %finish
 1029  
 1030              ! Check to see which fits scientific v decimal notation
 1031              ! Preference is for the decimal notation
 1032              %if (length(s) > places) %start
 1033                  s = science
 1034              %finish
 1035  
 1036              %if (sign # 0) %start
 1037                  s = "-".s
 1038              %finish %else %start
 1039                  s = " ".s
 1040              %finish
 1041  
 1042              %if (length(s) < places) %start
 1043                  %while (length(s) < places) %cycle
 1044                      s = s." "
 1045                  %repeat
 1046              %finish
 1047          %end
 1048  
 1049          %result = s
 1050      %end
?SX unused
 1051  
 1052      %routine imp77 print(%longreal f, %integer sf,places)
 1053          printstring( imp77 F to S( f, sf, places ) )
 1054      %end
 1055  
 1056      ! Print a floating point number out, along the lines of
 1057      ! +/-nnn.nnn@+/-nn, to occupy Places character spaces.
 1058      ! Note - there's a bug in this code such that it does not
 1059      ! round the number properly.  EG 3.999999999 to 4 places
 1060      ! should be 4.00 but we print 3.99
 1061  
 1062      %routine imp77 printfl(%longreal x, %integer places)
 1063          %integer exponent, digit, point, printexpo
 1064  
 1065          %if x = 0 %start
 1066              printsymbol('0')
 1067              printsymbol('.')
 1068              printsymbol('0')
 1069              %while places > 3 %cycle
 1070                  printsymbol('0')
 1071                  places = places - 1
 1072              %repeat
 1073              %return
 1074          %finish
 1075  
 1076          %if x < 0 %then printsymbol('-') %and x = -x %and places = places - 1
 1077  
 1078          %if places < 3 %then places = 3
 1079     
 1080          exponent = 0
 1081          printexpo = 0
 1082  
 1083          %while x < 1 %cycle
 1084              x = x * 10
 1085              exponent = exponent - 1
 1086          %repeat
 1087  
 1088          %while x >= 10 %cycle
 1089              x = x / 10
 1090              exponent = exponent + 1
 1091          %repeat
 1092  
 1093          ! Now X is between 1.0 and 9.99 and exponent is set accordingly
 1094          ! If the exponent is "large" we will use scientific notation
 1095          point = places - 2;     ! for useful digits after the "0."
 1096          %if exponent >= places %or exponent < -point %start
 1097              printexpo = exponent
 1098              exponent = 0
 1099              places = places - 2
 1100          %finish
 1101  
 1102          ! Now the exponent is small-ish
 1103          %if exponent < 0 %start;      ! 0.nnnn
 1104              printsymbol('0')
 1105              printsymbol('.')
 1106              places = places - 2
 1107  
 1108              %while exponent < -1 %cycle
 1109                  printsymbol('0')
 1110                  exponent = exponent + 1
 1111                  places = places - 1
 1112              %repeat
 1113  
 1114              point = -1; ! because we've already passed that
 1115          %else;          ! nnn.nnn
 1116              point = exponent
 1117          %finish
 1118  
 1119          %while places > 0 %cycle
 1120              digit = int pt(x)
 1121              ! Rounding as we go through this loop can "oversize" the digit.  This
 1122              ! of course tells us that we should have printed (eg) 40000 but we
 1123              ! are now stuck with printing 39999
 1124              %if digit > 9 %then digit = 9
 1125              printsymbol(digit + '0')
 1126              x = (x - digit)*10
 1127              %if point = 0 %then printsymbol('.') %and places = places - 1
 1128              point = point - 1
 1129              places = places - 1
 1130          %repeat
 1131  
 1132          %if printexpo # 0 %start
 1133              printsymbol('@')
 1134              write68k(printexpo, 1)
 1135          %finish
 1136      %end
 1137  
 1138  ! #########################################################################################
 1139  
 1140     %routine writetest(%string (255) procname, %routine testedwrite(%integer n, p))
 1141        %const %integer GAP = 15   ;! allow for largest int (+ or -) plus manditory spaces
 1142        %const %integer COLS = 13  ;! 1 beyond what is an exact fit
 1143        %integer n, m, shift, startpos, ALIGN
 1144        %for ALIGN = 1, -2, -1 %cycle
 1145        n = 1
 1146        printstring(procname)
 1147        printstring(": ")
 1148        newlines(2)
 1149        %if ALIGN < 0 %then %start
 1150          printstring("In IMP77, the total number of print positions to be used is defined"); newline
 1151          printstring("by the modulus of the second parameter (n).  If this parameter is"); newline
 1152          printstring("negative, no space character should output before a positive value:"); newline
 1153          newlines(2)
 1154        %finish
 1155        printstring("  \ n |  write(m,n):"); newline
 1156        printstring("   \  |"); newline
 1157        printstring("    \ |"); newline
 1158        printstring("  m  \|"); newline
 1159        printstring("  ----+   ")
 1160        %for m = 0, 1, cols %cycle
 1161          startpos = outpos
 1162          write68k(ALIGN*m,0)
 1163          spaces(GAP-(outpos-startpos))
 1164        %repeat
 1165        newline
 1166        printstring("MIN INT  ")
 1167        %for m = 0, 1, cols %cycle
 1168           startpos = outpos
 1169           printsymbol('[')
 1170           !tested write(-2147483648, m)
 1171           testedwrite(16_80000000, ALIGN*m)
 1172           printsymbol(']')
 1173           spaces(gap - (outpos - startpos))
 1174        %repeat
 1175        newline
 1176        n = 1000000000
 1177        shift = 9
 1178        %cycle 
 1179           printstring("  -10^")
 1180           write68k(shift, 0)
 1181           spaces(2)
 1182           %for m = cols, -1, 0 %cycle
 1183              ! examine the number of characters between the [] brackets
 1184              startpos = outpos
 1185              printsymbol('[')
 1186              testedwrite(-n, ALIGN*(cols - m))
 1187              printsymbol(']')
 1188              spaces(gap - (outpos - startpos))
 1189           %repeat
 1190           newline
 1191           n = n // 10
 1192           shift = shift - 1
 1193        %repeat %until n = 0
 1194        printstring("      0  ")
 1195        %for m = 0, 1, cols %cycle
 1196           startpos = outpos
 1197           printsymbol('[')
 1198           testedwrite(0, ALIGN*m)
 1199           printsymbol(']')
 1200           spaces(gap - (outpos - startpos))
 1201        %repeat
 1202        newline
 1203        n = 1
 1204        shift = 1
 1205        %cycle 
 1206           printstring("   10^")
 1207           write68k(shift - 1, 0)
 1208           spaces(2)
 1209           %for m = 0, 1, cols %cycle
 1210              ! examine the number of characters between the [] brackets
 1211              startpos = outpos
 1212              printsymbol('[')
 1213              testedwrite(n, ALIGN*m)
 1214              printsymbol(']')
 1215              spaces(gap - (outpos - startpos))
 1216           %repeat
 1217           newline
 1218           %exit %if n = 1000000000
 1219           n = n * 10
 1220           shift = shift + 1
 1221        %repeat
 1222        printstring("MAX INT  ")
 1223        %for m = 0, 1, cols %cycle
 1224           startpos = outpos
 1225           printsymbol('[')
 1226           testedwrite(2147483647, ALIGN*m)
 1227           printsymbol(']')
 1228           spaces(gap - (outpos - startpos))
 1229        %repeat
 1230        newlines(3)
 1231        %repeat
 1232     %end
 1233  
 1234  ! #########################################################################################
 1235  
 1236     %routine printfltest(%string (255) procname, %routine testedprintfl(%longreal n, %integer p))
 1237        %const %integer GAP = 26   ;! allow for accuracy of long reals
 1238        %const %integer COLS = 17
 1239        %long %real n, k
 1240        %integer m, exponent, startpos, ALIGN
 1241        %for ALIGN = 1, 1, 1 %cycle ; ! %for ALIGN = 1, -2, -1 %cycle
 1242        n = 1
 1243        %if ALIGN < 0 %then printstring("Possibly left-justified ")
 1244        printstring(procname)
 1245        !%if neg < 0 %then printstring(" with negative numbers")
 1246        printstring(": ")
 1247        newlines(2)
 1248  
 1249        printstring("  \ n |  printfl(m,n):"); newline
 1250        printstring("   \  |"); newline
 1251        printstring("    \ |"); newline
 1252        printstring("  m  \|"); newline
 1253        printstring("  ----+ ")
 1254        %for m = 0, 1, cols %cycle
 1255          startpos = outpos
 1256          write68k(m,0)
 1257          spaces(GAP-(outpos-startpos))
 1258          %if REM(m, 6)=5 %then newline %and print string("        ");
 1259        %repeat
 1260        newline
 1261        n = 1.23456789012345678901234567890
 1262        
 1263        k = 1@100; exponent = 100
 1264        %cycle 
 1265           printstring("-1@")
 1266           write68k(exponent, 0)
 1267           space %while outpos < 8
 1268           %for m = cols, -1, 0 %cycle
 1269              ! examine the number of characters between the [] brackets
 1270              startpos = outpos
 1271              printsymbol('[')
 1272              testedprintfl(-k*n, ALIGN*(cols - m))
 1273              printsymbol(']')
 1274              spaces(gap - (outpos - startpos))
 1275              %if REM(cols-m, 6)=5 %then newline %and print string("        "); 
 1276           %repeat
 1277           newline
 1278           %if exponent = 100 %start
 1279             k = 1@10; exponent = 10
 1280           %else %if exponent = 10
 1281             k = 1@1; exponent = 1
 1282           %else %if exponent = 1
 1283             k = 1@0; exponent = 0
 1284           %else %if exponent = 0
 1285             k = 1@-1; exponent = -1
 1286           %else %if exponent = -1
 1287             k = 1@-10; exponent = -10
 1288           %else %if exponent = -10
 1289             k = 1@-100; exponent = -100
 1290           %finish %else %exit
 1291        %repeat
 1292        
 1293        printstring(" 0@0    ")
 1294        %for m = 0, 1, cols %cycle
 1295           startpos = outpos
 1296           printsymbol('[')
 1297           testedprintfl(0, ALIGN*m)
 1298           printsymbol(']')
 1299           spaces(gap - (outpos - startpos))
 1300           %if  REM(m, 6)=5 %then newline %and print string("        "); 
 1301        %repeat
 1302        newline
 1303  
 1304        k = 1@100; exponent = 100
 1305        %cycle 
 1306           printstring(" 1@")
 1307           write68k(exponent, 0)
 1308           space %while outpos < 8
 1309           %for m = cols, -1, 0 %cycle
 1310              ! examine the number of characters between the [] brackets
 1311              startpos = outpos
 1312              printsymbol('[')
 1313              testedprintfl(k*n, ALIGN*(cols - m))
 1314              printsymbol(']')
 1315              spaces(gap - (outpos - startpos))
 1316              %if REM(cols-m, 6)=5 %then newline %and print string("        "); 
 1317           %repeat
 1318           newline
 1319           %if exponent = 100 %start
 1320             k = 1@10; exponent = 10
 1321           %else %if exponent = 10
 1322             k = 1@1; exponent = 1
 1323           %else %if exponent = 1
 1324             k = 1; exponent = 0
 1325           %else %if exponent = 0
 1326             k = 0.1; exponent = -1
 1327           %else %if exponent = -1
 1328             k = 1@-10; exponent = -10
 1329           %else %if exponent = -10
 1330             k = 1@-100; exponent = -100
 1331           %finish %else %exit
 1332        %repeat
 1333        
 1334        newlines(3)
 1335        %repeat
 1336     %end
 1337  
 1338  
 1339     ! WRITE TESTS   write(num, places)
 1340     
 1341     writetest("Copy of current (imp2024) write", write3l)
 1342     writetest("EMAS write", emaswrite)
 1343     writetest("EMAS write (from imp77 compatibility library)", emasi77write)
 1344     writetest("Vax write", vaxwrite)
 1345     writetest("Dec10 (imp77) write", dec10 write)
 1346     writetest("Mouses (imp77) write", mouseswrite)
 1347     writetest("APM (imp68k) write", write68k)
 1348  
 1349     ! PRINTFL TESTS   printfl(num, places)
 1350  
 1351     ! Current imp77 library uses some weird names.  I've extracted the equivalents of
 1352     ! the standard printfl and print, and renamed them to avoid confusion.
 1353     ! Their output is not compatible with the ercc, vax, or dec10 versions :-(
 1354  
 1355     ! As with write, I had to provide a local copy in order to support 'outpos'
 1356     ! which is necessary to handle padding correctly when the spacing of the
 1357     ! routine under test is unknown.
 1358  
 1359     printfltest("copy of current (imp2024) printfl (called 'print' in the imp2024 library)", imp77 printfl)
 1360     printfltest("EMAS (imp9) printfl", emas printfl)
 1361     printfltest("ERCC (imp80) printfl", ercc printfl)
 1362     printfltest("Vax (imp77) printfl", vax printfl)
 1363     printfltest("Dec10 (imp77) printfl", dec10 printfl)
 1364     printfltest("Mouses (imp77) printfl", mouses printfl)
 1365     printfltest("APM (imp68k) printfl", dec10 printfl)
 1366  
 1367     ! TO DO: PRINT TESTS   print(num, iplaces, dplaces)
 1368  
 1369  
 1370  %end %of %programm
?IMP77PRINT unused
?PRINTFL68K unused
?DEC10PRINT unused
?WRITE unused

 1110 Statements compiled
