reals long
! This program shows explicitly the results of write(m,n) for each significant
! size of m and n, and tests the extreme cases of MIN and MAX INT.
! First, we replace the standard output calls with local versions which
! keep track of 'outpos', to help with formatting output into columns:
! In order to do this for the in-built 'write' etc, we have reimplemented local copies
! of the current library versions which have been tested and confirmed to be identical.
! The output table is rather wide and may need to be viewed using a small font.
! When translated to C we do get some warnings from GCC of constants being out of range.
! The approximate range of a standard float is:
! Maximum positive value:
! ¬(¬approx 3.402823 ¬times 10^{38}¬)
! Minimum positive normalized value:
! ¬(¬approx 1.175494 ¬times 10^{-38}¬)
! Because floating-point numbers can represent both positive and negative values,
! the full operational range is roughly ¬(-3.4 ¬times 10^{38}¬) to ¬(+3.4 ¬times 10^{38}¬).
! It can also represent values infinitely close to zero, with a precision of about 6 to 7 decimal digits.
! On most modern systems, the range of a double in C is approximately
! ¬(¬pm 1.7 ¬times 10^{-308}¬) to ¬(¬pm 1.7 ¬times 10^{308}¬).
! Maximum Finite Value: The largest absolute value a double can hold is
! approximately 1.7976931348623157E+308. Going beyond this result triggers
! an overflow, resulting in positive or negative infinity (INF)
! Minimum Positive Normal Value: The smallest positive number that can be
! represented with full precision is approximately 2.2250738585072014E-308.
! Numbers smaller than this enter the subnormal range or round down to zero (underflow).
own integer outpos = 0
routine intrinsic printsymbol(integer ch)
printsymbol(ch)
end
routine printsymbol(integer ch)
intrinsic printsymbol(ch)
if ch = 'J'&31 or ch = 'M'&31 or ch = 'L'&31 start ; ! nl cr ff
outpos = 0
else if ch = 'H'&31 ; ! bs
outpos = outpos - 1 if outpos > 0
else if ch = 'I'&31 ; ! tab
outpos = (outpos + 8) & (¬7) ;! at least on linux
else
outpos = outpos + 1
finish
end
routine newline
printsymbol(nl)
end
routine newlines(integer n)
integer i
return if n <= 0
newline for i = 1, 1, n
end
routine space
printsymbol(' ')
end
routine spaces(integer n)
integer i
return if n <= 0
space for i = 1, 1, n
end
routine printstring(string (255) s)
integer i
printsymbol(charno(s, i)) for i = 1, 1, length(s)
end
routine write(integer m, n)
printstring("Please don't ever use plain 'write' in this program. Use write68k for now."); newline
printstring("The implementation in the current Imp77 is severely broken w.r.t. formatting."); newline
stop
end
begin ; ! Sorry, all original comments {in brackets} were lost in an unfortunate reformatting.
! -----------------------------------------------------------------------------------------
routine write3l(integer n, places); ! Same as current Imp library
! Write an integer on the current output stream, to
! occupy PLACES character spaces on the page.
! Nominally based on PrintString(I to S(n, places))
! This version doesn't use strings though, and is
! therefore smaller and quicker. It builds the
! characters "backwards" in an array
routine decimal(integer n, integer name places, digits, vec)
integer p, sign, d, x
vec = vec + 15
sign = '-'
if n >= 0 start
n = -n
sign = ' '
sign = 0 if places <= 0
finish
if places <= 0 then places = -places else places = places + 1
p = vec
cycle
x = n // 10
d = n - x * 10
n = x
vec = vec - 1
byteinteger(vec) = '0' - d
repeat until n = 0
if sign # 0 start
vec = vec - 1
byteinteger(vec) = sign
finish
digits = p - vec
end
string (32) ch
! Enough room for a 32 bit integer, plus sign
integer new, digit, sign, i
length(ch) = 0
! First collect the digits
if n = 0 start
length(ch) = length(ch) + 1
charno(ch, length(ch)) = '0'
sign = 0
else
sign = 1
! we make everything negative to avoid the -ve MaxInt wrap problem
if n > 0 start
sign = 0
n = -n
finish
while n # 0 cycle
new = n // 10
digit = (new * 10) - n
length(ch) = length(ch) + 1
charno(ch, length(ch)) = digit + '0'
n = new
repeat
finish
! Now deal with the sign, taking into account the slightly
! idiosyncratic behaviour on positive numbers
if sign # 0 start
length(ch) = length(ch) + 1
charno(ch, length(ch)) = '-'
else
if places > 0 start
length(ch) = length(ch) + 1
charno(ch, length(ch)) = ' '
finish
finish
! Now we adjust Places, also slightly mysteriously
if places <= 0 then places = -places else places = places + 1
! The array at CH now contains the characters (backwards)
! and the character count is in NEXT
while places > length(ch) cycle
length(ch) = length(ch) + 1
charno(ch, length(ch)) = ' '
places = places - 1
repeat
for i = length(ch), -1, 1 cycle
printsymbol(charno(ch, i))
repeat
end
! -----------------------------------------------------------------------------------------
routine vax write(integer n, p)
string(63)fn itos(integer n, p)
string(255) answer
byteintegerarray a(0:64)
integer sign, sym, pt, val
val = p
if p > 0 then p = p+1 else p = -p
p = 63 if p > 63
sign = ' '
sign = 0 if val <= 0
pt = 0
if n < 0 start
sign = '-'
if n = 16_80000000 start
string(addr(a(pt))) = "8463847412"
pt = pt + 10
-> set
finish
n = -n
finish
cycle
sym = n-n//10*10
pt = pt+1
a(pt) = sym+'0'
n = n//10
repeat until n = 0
set:
if sign # 0 start
pt = pt+1; a(pt) = sign
finish
while pt < p cycle
pt = pt+1; a(pt) = ' '
repeat
answer = ""
cycle
answer = answer.tostring(a(pt))
pt = pt-1
repeat until pt = 0
result = answer
end
space and p = p-1 while p > 62
printstring(itos(n, p))
end
! -----------------------------------------------------------------------------------------
routine write68k(integer v, p)
integer vv, q, pos
byte integer array store(0 : 15)
vv = v
vv = -vv if vv > 0
pos = 15
while vv <= -10 cycle
q = vv // 10
store(pos) = q * 10 - vv + '0'
pos = pos - 1
vv = q
repeat
store(pos) = '0' - vv
if p <= 0 start
spaces(pos - 16 - p) if p < 0
finish else start
spaces(pos - 16 + p)
printsymbol(' ') if v >= 0
finish
printsymbol('-') if v < 0
printsymbol(store(pos)) and pos = pos + 1 until pos = 16
end
! -----------------------------------------------------------------------------------------
routine emaswrite(integer value, places)
!***********************************************************************
!* SIMPLE MINDED ALL IMP VERSION NOT USING STRINGS *
!***********************************************************************
string (15) fn swrite alias "S#SWRITE"(integer value, places)
!***********************************************************************
!* SIMPLE MINDED ALL IMP VERSION *
!***********************************************************************
string (1) sign
string (255{15}) res
integer work, ptr
string (1) array ch(0 : 15)
res = ""
sign = " "
if value = X'80000000' then start
res = "-2147483548"
!res = " " . res %for ptr = 1, 1, places - 10 ;! causes run-time string overflow
if places <= 0 start
places = -15 if places < -15
res = " " . res while length(res) < |places|
else
places = 14 if places > 14
res = " " . res while length(res) < places
res = " " . res
finish
result = res
finish
if value = X'80000000' then result = "-2147483648"
if value < 0 then sign = "-" and value = -value
ptr = 0
cycle
work = value // 10
ch(ptr) = tostring(value - 10 * work + '0')
value = work
ptr = ptr + 1
repeat until value = 0
res = res . " " for work = ptr, 1, places - 1
work = ptr - 1
res = res . sign
res = res . ch(ptr) for ptr = work, -1, 0
result = res
end
integer sign, work, ptr
byte integer array ch(0 : 15)
sign = ' '
if value = X'80000000' then printstring(swrite(value, places)) and return
if value < 0 then sign = '-' and value = -value
ptr = 0
cycle
work = value // 10
ch(ptr) = value - 10 * work
value = work
ptr = ptr + 1
repeat until value = 0
if places > ptr then spaces(places - ptr)
work = ptr - 1
printsymbol(sign)
printsymbol(ch(ptr) + '0') for ptr = work, -1, 0
end
! -----------------------------------------------------------------------------------------
routine emasi77write(integer num, pl)
string (63) function itos(integer n, places)
!
! ITOS0
!
! Returns a string representing the argument as
! a decimal number, without any space justification
! or padding.
!
const integer maxdigits = 255 - 64
const integer maxint = 16_7FFFFFFF
const integer minint = 16_80000000
const integer minintlastdigit = '8'
string (maxdigits) function itos0(integer n)
string (maxdigits) res
integer s, p, e
s = 0
if n < 0 start
s = -1
! mark -ve
if n = minint start
! special case
n = maxint
! rely on "max int = (-min int) - 1"
s = 1
! mark special
finish else start
n = -n
finish
finish
p = addr(res) + maxdigits
e = p
! end point
byteinteger(p) = rem(n, 10) + '0' and n = n // 10 and p = p - 1 until n = 0
if s # 0 start
! negative
byteinteger(p) = '-'
p = p - 1
if s > 0 start
! min int
charno(res, maxdigits) = minintlastdigit
finish
finish
byteinteger(p) = e - p
! length byte
result = string(p)
end
string (63 + maxdigits) res
integer p, slen
p = addr(res) + 62
! digit string right justified
string(p) = itos0(n)
slen = byteinteger(p)
if n > 0 and places > 0 start
byteinteger(p) = ' '
p = p - 1
slen = slen + 1
finish
if places <= 0 start
places = -places
finish else start
places = places + 1
finish
places = 63 if places > 63
while slen < places cycle
byteinteger(p) = ' '
p = p - 1
slen = slen + 1
repeat
byteinteger(p) = slen
result = string(p)
end
string (63) res
res = itos(num, pl)
pl = ¬pl if pl < 0
spaces(pl - 62)
printstring(res)
end
! -----------------------------------------------------------------------------------------
routine mouseswrite(integer n, p)
string (72) fn itos(integer n, p)
byte array s(0 : 72)
integer x, sign
x = 73
sign = 0
if p > 0 start
sign = ' '
p = 72 - p
else
p = p + 73
finish
p = 1 if p <= 0
if n < 0 start
sign = '-'
n = -n
if n < 0 start
!max int
n = n // (-10)
x = x - 1
s(x) = '8'
finish
finish
cycle
x = x - 1
s(x) = rem(n, 10) + '0'
n = n // 10
repeat until n = 0
if sign # 0 start
x = x - 1
s(x) = sign
finish
while x > p cycle
x = x - 1
s(x) = ' '
repeat
x = x - 1
s(x) = 72 - x
result = string(addr(s(x)))
end
printstring(itos(n, p))
end
! -----------------------------------------------------------------------------------------
ROUTINE DEC10 WRITE(INTEGER N, S)
ROUTINESPEC P(INTEGER N)
INTEGER SIGN
IF S<=0 THEN SIGN=S ELSE SIGN = ' '; !GIVE NO SIGN FOR WRITE(N,0)
S=|S|; S=63 IF S>63
IF N < 0 START ; ! doesn't use negative trick but could be easily modified to.
N = -N
SIGN = '-'
FINISH
P(N)
ROUTINE P(INTEGER N)
S = S-1
P(N//10) IF N >= 10
IF SIGN > 0 START
SPACES(S-1)
PRINTSYMBOL(SIGN); SIGN = 0
FINISH ELSE IF SIGN<0 THEN SPACES(S) AND SIGN=0; !FOR -VE S
PRINTSYMBOL(REM(N,10)+'0')
END
END
! -----------------------------------------------------------------------------------------
! #########################################################################################
ROUTINESPEC EMAS PRINTFL (LONGREAL X, INTEGER N)
ROUTINE EMAS PRINT(LONGREAL X, INTEGER N,M)
!***********************************************************************
!* PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
!* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES *
!* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. *
!* *
!* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
!* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS *
!***********************************************************************
CONSTLONGREAL DZ=0
LONGREAL Y,Z,ROUND,FACTOR
INTEGER I,J,L,MORIG
BYTEINTEGER SIGN
M=M&63; ! DEAL WITH STUPID PARAMS
MORIG=M
IF N<0 THEN N=1; N=N&31; ! DEAL WITH STUPID PARAMS
X=X+DZ; ! NORMALISE
SIGN=' '; ! '+' IMPLIED
IF X<0 THEN SIGN='-'
Y=|X|; ! ALL WORK DONE WITH Y
ROUND=0.5/10^M; ! ROUNDING FACTOR
IF Y>1.0*10^16 OR N=0 THENSTART; ! MEANINGLESS FIGURES GENERATED
IF N>M THEN M=N; ! FOR FIXED POINT PRINTING
EMAS PRINTFL(X,M); ! OF ENORMOUS NUMBERS
RETURN; ! SO PRINT IN FLOATING FORM
FINISH
I=0; Z=1; Y=Y+ROUND
CYCLE; ! COUNT LEADING PLACES
I=I+1; Z=10*Z; ! NO DANGER OF OVERFLOW HERE
REPEAT UNTIL Z>Y
PRINTSYMBOL(SIGN)
J=I-1; Z=10^J
FACTOR=1/10
CYCLE
CYCLE
L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT
Y=Y-L*Z; Z=Z*FACTOR; ! AND REDUCE TOTAL
PRINTSYMBOL(L+'0')
J=J-1
REPEAT UNTIL J<0
IF M=0 THEN EXIT; ! NO DECIMAL PART TO BE O/P
PRINTSTRING(".")
J=M-1; Z=10^(J-1); M=0
Y=10*Y*Z
REPEAT
if MORIG>0 start { Chop any redundant trailing 0s}
!opline_length=opline_length-1 %while %c
! opline_l(opline_length-1)='0' %and opline_l(opline_length-2)#'.'
finish
END; ! OF ROUTINE PRINT
ROUTINE EMAS PRINTFL (LONGREAL X, INTEGER N)
!***********************************************************************
!* PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE *
!* DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS. *
!* CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X *
!***********************************************************************
LONGREAL SIGN,ROUND,FACTOR,LB,UB
CONSTLONGREAL DZ=0
INTEGER COUNT,INC
inc=integer(addr(x))
if inc>>20&x'7ff'=x'7ff' start
printstring("NAN");
!outhex(inc);
!outhex(integer(addr(x)+4))
!outsym('}');
return
finish
ROUND=0.5/10^N; ! TO ROUND SCALED NO
LB=1-ROUND; UB=10-ROUND
SIGN=1
X=X+DZ; ! NORMALISE
IF X=0 THEN COUNT=0 ELSESTART
IF X<0 THEN X=-X AND SIGN=-SIGN
INC=1; COUNT=0
FACTOR=1/10
IF X<=1 THEN FACTOR=10 AND INC=-1
! FORCE INTO RANGE 1->10
WHILE X<LB OR X>=UB CYCLE
X=X*FACTOR; COUNT=COUNT+INC
REPEAT
FINISH
EMAS PRINT(SIGN*X,1,N)
if count#0 start
PRINTSTRING("@") ;! original had 'E' - was that correct?
WRITE68K(COUNT,0)
finish
END; ! OF ROUTINE PRINTFL
! -----------------------------------------------------------------------------------------
ROUTINESPEC ERCC PRINTFL(LONGREAL X, INTEGER N)
ROUTINE ERCC PRINT(LONGREAL X, INTEGER N,M)
!***********************************************************************
!* PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
!* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES *
!* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. *
!* *
!* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
!* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS *
!***********************************************************************
CONSTLONGREAL PMAX= 1@16
CONSTLONGREAL DZ=0
LONGREAL Y,Z,ROUND,FACTOR
INTEGER I,J,L
BYTEINTEGER SIGN
M=M&63; ! DEAL WITH STUPID PARAMS
IF N<0 THEN N=1; N=N&31; ! DEAL WITH STUPID PARAMS
X=X+DZ; ! NORMALISE
SIGN=' '; ! '+' IMPLIED
IF X<0 THEN SIGN='-'
Y=|X|; ! ALL WORK DONE WITH Y
ROUND=0.5/10^M; ! ROUNDING FACTOR
IF Y>PMAX OR N=0 THENSTART; ! MEANINGLESS FIGURES GENERATED
IF N>M THEN M=N; ! FOR FIXED POINT PRINTING
ERCC PRINTFL(X,M); ! OF ENORMOUS NUMBERS
RETURN; ! SO PRINT IN FLOATING FORM
FINISH
I=0; Z=1; Y=Y+ROUND
CYCLE; ! COUNT LEADING PLACES
I=I+1; Z=10*Z; ! NO DANGER OF OVERFLOW HERE
REPEAT UNTIL Z>Y
SPACES(N-I); ! O.K FOR ZERO OR -VE SPACES
PRINT SYMBOL(SIGN)
J=I-1; Z=10^J
FACTOR=1/10
CYCLE
CYCLE
L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT
Y=Y-L*Z; Z=Z*FACTOR; ! AND REDUCE TOTAL
PRINT SYMBOL(L+'0')
J=J-1
REPEAT UNTIL J<0
IF M=0 THENRETURN; ! NO DECIMAL PART TO BE O/P
PRINTSTRING(".")
J=M-1; Z=10^(J-1); M=0
Y=10*Y*Z
REPEAT
END; ! OF ROUTINE PRINT
ROUTINE ERCC PRINTFL(LONGREAL X, INTEGER N)
!***********************************************************************
!* PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE *
!* DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS. *
!* CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X *
!***********************************************************************
CONSTLONGREAL DZ=0
LONGREAL SIGN,ROUND,FACTOR,LB,UB
INTEGER COUNT,INC
ROUND=0.5/10^N; ! TO ROUND SCALED NO
LB=1-ROUND; UB=10-ROUND
SIGN=1
X=X+DZ; ! NORMALISE
IF X=0 THEN COUNT=-99 ELSESTART
IF X<0 THEN X=-X AND SIGN=-SIGN
INC=1; COUNT=0
FACTOR=1/10
IF X<=1 THEN FACTOR=10 AND INC=-1
! FORCE INTO RANGE 1->10
WHILE X<LB OR X>=UB CYCLE
X=X*FACTOR; COUNT=COUNT+INC
REPEAT
FINISH
ERCC PRINT(SIGN*X,1,N)
PRINTSTRING("@")
emasWRITE(COUNT,2)
END; ! OF ROUTINE PRINTFL
! -----------------------------------------------------------------------------------------
routine vax printfl(long real r, integer places)
string (63) fn ftos(long real r, integer p)
routine vax fraction(long real r, integer places, string (*) name s)
long real fn fracpt(long real x)
long real z
z = x - intpt(x)
z = z + 1.0 if z < 0
result = z
end
return if places <= 0
s = s . "."
while places > 0 cycle
places = places - 1
r = fracpt(r) * 10
s = s . tostring(intpt(r) + '0')
repeat
end
routine round(long real name v, integer p)
long real x
return if v = 0
if v < 0 then x = -0.5 else x = 0.5
cycle
p = p - 1
exit if p < 0
x = x / 10
repeat
v = v + x
end
{XOWN}string (63) s = ""
integer exp, sym
!p = 7 %if p > 7 ;! WHY?????????????????????????? p = 7 %if p > 7
! removing the p<=7 constraint makes this behave the same as EMAS PRINTFL
if r < 0 then sym = '-' and r = -r else sym = ' '
if r = 0 start
exp = -99
else
exp = 0
exp = exp + 1 and r = r / 10 while r >= 10
exp = exp - 1 and r = r * 10 while r < 1
finish
round(r, p)
exp = exp + 1 and r = r / 10 if r >= 10
s = s . tostring(intpt(r) + '0')
vax fraction(r, p, s)
result = tostring(sym) . s . "@" . itos(exp, 0)
end
places = ¬places if places < 0
spaces(places - 62)
printstring(ftos(r, places))
end
! -----------------------------------------------------------------------------------------
long real fn dec10 fracpt(long real x)
long real z
z = x - intpt(x)
z = z + 1.0 if z < 0
result = x - intpt(x)
end
ROUTINE DEC10 FRACTION(LONG REAL R, INTEGER PLACES)
RETURN IF PLACES <= 0
PRINTSYMBOL('.')
WHILE PLACES>0 CYCLE
R = dec10 FRACPT(R)*10.0 ; ! first digit after the point of a 0.xxxxxxx positive number.
PLACES = PLACES-1
PRINTSYMBOL(INTPT(R)+'0')
REPEAT
END
ROUTINE DEC10 PRINTFL(LONG REAL R, INTEGER P)
INTEGER EXP,SIGN, pp
real roundup
SIGN=' '
SIGN='-' AND R = -R IF R < 0
PRINTSYMBOL(SIGN)
IF R = 0 START
EXP = 0 ;! Was EXP = 99 for completely unknown reasons.
ELSE
! Normalise:
EXP = 0
EXP = EXP + 1 AND R = R*0.1 WHILE R >= 10.0
EXP = EXP - 1 AND R = R*10.0 WHILE R < 1.0
! R should now be a single digit followed by a decimal part, with the exponent adjusted appropriately
! Round to P places:
roundup = 0.5
IF P <= 0 START
!R = R+0.5 ;! round to an int?
pp = 0
ELSE
! This was just not working so I've replaced it with the 'pp' code below. I suspect faulty exponentiation?
!R = R + 0.5*10¬(-P)
!R = R + 0.5*10^(-P)
pp = p
FINISH
while pp > 0 then roundup = roundup / 10 and pp = pp - 1
R = R + roundup
FINISH
PRINTSYMBOL(INT PT(R)+'0')
DEC10 FRACTION(R,P)
PRINTSYMBOL('@'); WRITE68K(EXP,1)
END
ROUTINE DEC10 PRINT(LONG REAL R, INTEGER B,A)
LONG REAL RM
CONSTINTEGER MAX INT=16_7FFFFFFF
INTEGER SIGN
ROUTINE P(INTEGER N)
B = B-1
P(N//10) IF N >= 10
IF SIGN # 0 START
SPACES(B-1)
PRINTSYMBOL(SIGN); SIGN = 0
FINISH
PRINTSYMBOL(REM(N,10)+'0')
END
RM=|R|
DEC10 PRINTFL(R, B+A) AND RETURN IF RM> MAX INT
IF A<=0 START
RM=RM+0.5
ELSE
!RM=RM+0.5*10¬(-A)
RM=RM+0.5*10^(-A)
FINISH
IF B<=0 THEN SIGN=0 ELSE SIGN=' '
IF R<0 THEN SIGN='-'
P(INT PT(RM)); !THUS ALLOWING FOR -0.1 ETC.
DEC10 FRACTION(RM,A)
END
! -----------------------------------------------------------------------------------------
routine print 68k(long real x, integer n,m)
constreal pmax = 2147483647.0
long real y,z,POW
integer i=0,l,count=0,sign
sign = ' '
sign = '-' if x < 0
!y = |x|+0.5/10.0¬{^}m; !modulus, rounded
POW = 10.0^|m|
POW = 0.5/POW
y = |x|
y = y+POW; !modulus, rounded
if y > pmax start
count = count+1 and y = y/10.0 until y < 10.0
finish
z = 1.0
cycle
i = i+1; z = z*10.0
repeat until z > y
spaces(n-i)
printsymbol(sign) unless sign = ' ' and n <= 0 ; ! n < 0 just makes a difference of one space character
cycle
z = z/10.0
l = int pt(y/z)
y = y-l*z
printsymbol(l+'0')
i = i-1
exit if i+m <= 0
print symbol('.') if i = 0
repeat
printsymbol('@') and write 68k(count,0) if count # 0
end; !print
routine printfl 68k(long real x, integer n)
long real y,round
integer count=-99,sign=0
if x # 0 start
x = -x and sign = 1 if x < 0
!Adjust X so that 1.0 <= rounded(X) < 10.0
!count = 0; round = 0.5¬{^}n
count = 0; round = 0.5^|n|
y = 1.0-round
if x < y start; !ie rounded(X) < 1.0
count = count-1 and x = x*10.0 until x >= y
finish else start
y = 10.0-round
while x >= y cycle; !ie rounded(X) > 10.0
count = count+1; x = x/10.0
repeat
finish
x = -x if sign # 0
finish
print 68k(x,1,n)
printsymbol('@')
write 68k(count,0)
end; !printfl
! -----------------------------------------------------------------------------------------
routine mousesprintfl(real r, integer places)
routine round(real name v, integer p)
real x
return if v = 0
if v < 0 then x = -0.5 else x = 0.5
cycle
p = p - 1
exit if p < 0
x = x / 10
repeat
v = v + x
end
routine fraction(real r, integer places, string (*) name s)
long real fn fracpt(long real x)
long real z
z = x - intpt(x)
z = z + 1.0 if z < 0
result = z
end
!%realfn MOUSES FRACPT(%real r) ;! dependent on machine representation of floating point.
! %integer m,x,z
! %if |R| >= 1.0 %start
! x = integer(addr(r))
! z = x>>24&b'01111111'
! %result = 0 %if z > x'46'
! m = -1
! m = m<<4 %and z = z+1 %while z < x'46'
! x = x&(m!x'FF000000')
! r = r-real(addr(x))
! %finish
! r = r+1 %if r < 0
! %result = r
!%end
return if places <= 0
s = s . "."
while places > 0 cycle
places = places - 1
r = fracpt(r) * 10
s = s . tostring(intpt(r) + '0')
repeat
end
string (64) fn ftos(real r, integer p)
{XOWN}string (64) s = ""
integer exp, sym
p = 7 if p > 7
if r < 0 then sym = '-' and r = -r else sym = ' '
if r = 0 start
exp = -99
else
exp = 0
exp = exp + 1 and r = r / 10 while r >= 10
exp = exp - 1 and r = r * 10 while r < 1
finish
round(r, p)
exp = exp + 1 and r = r / 10 if r >= 10
s = s . tostring(intpt(r) + '0')
fraction(r, p, s)
s = s . "@" . itos(exp, 0)
result = s
end
printstring(ftos(r, places))
end
! -----------------------------------------------------------------------------------------
! Convert a floating point number to a string, along the lines of
! +/-nnn.nnn@+/-nn, to occupy Places character spaces
! with sf significant figures.
! Rounding/truncation will occur to ensure sf limits
!
! %longreal f = floating point number to convert to a string
! %integer sf = number of significant figures required
! places = number of characters in converted string
!
! N.B. sf must be in the range of accuracy of %longreal (<15)
! places must be slightly greater than sf
! (to allow for sign and scientific notation)
! sign uses 1 character (+ is omitted)
! decimal point uses 1 character
! scientific notation could use :
! 1 char for "@" ndicating scientific notation
! 1 char for sign of exponent (sign always present)
! 1+ char for integer exponent
!
! N.B. scientific notation is only used if the decimal string could
! not fit in the places required
!
! eg. F to S (0.003999, 3, 7) -> " 0.004 " (note rounding creates zeros after the 4)
! or
! eg. F to S (0.003999, 3, 4) -> " 4.00@-3" (converted to scientific notation to fit)
! eg. F to S (0.003999, 3, 6) -> " 0.004" (fits exactly)
!
string(255) function imp77 F to S( longreal f, integer sf, places)
string(255) s,sx
string(15) science
integer dc,carry
integer sign,exponent, digit, point
if (sf > 14) then sf = 14
begin
integer i
integerarray digits(1:sf+1)
sign = 0
for i = 1,1,sf+1 cycle
digits(i) = 0
repeat
if (f < 0) then sign = 1 and f = -f
! clear the floating point string
length(s) = 0
if (f = 0) start
! convert to positive zero
sign = 0
dc = 2
sf = 2
exponent = 0
point = 1
finish else start
! prepare the exponent, point values for (f # 0)
! evaluate the exponent value
exponent = 0
while f < 1 cycle
f = f * 10
exponent = exponent - 1
repeat
while f >= 10 cycle
f = f / 10
exponent = exponent + 1
repeat
! locate the decimal point
point = 1
! zero the digit count
dc = 0
! Loop to get the significant figure digits with an extra digit
! so we can use it to round the the required sig figs
! Rounding as we go through this loop can "oversize" the digit.
! The next stage does the rounding to the correct sig fig.
for i = 1,1,sf + 1 cycle
digit = int pt(f)
if (digit > 9) then digit = 9
dc = dc + 1
digits(dc) = digit
f = (f - digit)*10
repeat
! do the rounding to the sf significant figures
if (digits(dc) > 4) start
! we need to possibly round up the digits sequence
carry = 1
for i = dc - 1,-1,1 cycle
digits(i) = digits(i) + carry
if (digits(i) > 9) start
carry = 1
digits(i) = 0
finish else start
carry = 0
finish
repeat
finish
! ignore the rounding digit
dc = dc - 1
! Now eliminate any trailing zeros
! We assume that rounding has created
! a sequence of trailing zeros
while (digits(dc) = 0) and (dc > 1) cycle
dc = dc - 1
repeat
sf = dc
finish
length(s) = 0
point = 1
for i = 1,1,sf cycle
s = s.tostring(digits(i) + '0')
if (point = i) then s = s."."
repeat
if (sf = point) then s = s."0"
if (exponent < 0) then s=s."@-".itos(-exponent,0)
if (exponent > 0) then s=s."@+".itos(exponent,0)
science = s
! So, now for the other floating point layouts
! we should see which version will fit into the places allowed
! 1) 0.00000nnnn (point <= 0)
! OR
! 2) nnnn.0 (point = sf)
! OR
! 3) nnnn00000.0 (point > sf)
!
length(s) = 0
point = exponent + 1
! First form the sig fig digit string
! possibly including a decimal point
for i = 1,1,sf cycle
s = s.tostring(digits(i) + '0')
if (point = i) then s = s."."
repeat
! Checking for format (1)
! 1) 0.00000nnnn (point <= 0)
if (point <= 0) start
for i=1,1,-point cycle
s = "0".s
repeat
s = "0.".s
finish
! Checking for format (2)
! 2) nnnn.0 (point = sf)
if (point = sf) start
s = s."0"
finish
! Checking for format (3)
! 3) nnnn00000.0 (point > sf)
if (point > sf) start
for i = 1,1,(point - sf) cycle
s = s."0"
repeat
s = s.".0"
finish
! Check to see which fits scientific v decimal notation
! Preference is for the decimal notation
if (length(s) > places) start
s = science
finish
if (sign # 0) start
s = "-".s
finish else start
s = " ".s
finish
if (length(s) < places) start
while (length(s) < places) cycle
s = s." "
repeat
finish
end
result = s
end
routine imp77 print(longreal f, integer sf,places)
printstring( imp77 F to S( f, sf, places ) )
end
! Print a floating point number out, along the lines of
! +/-nnn.nnn@+/-nn, to occupy Places character spaces.
! Note - there's a bug in this code such that it does not
! round the number properly. EG 3.999999999 to 4 places
! should be 4.00 but we print 3.99
routine imp77 printfl(longreal x, integer places)
integer exponent, digit, point, printexpo
if x = 0 start
printsymbol('0')
printsymbol('.')
printsymbol('0')
while places > 3 cycle
printsymbol('0')
places = places - 1
repeat
return
finish
if x < 0 then printsymbol('-') and x = -x and places = places - 1
if places < 3 then places = 3
exponent = 0
printexpo = 0
while x < 1 cycle
x = x * 10
exponent = exponent - 1
repeat
while x >= 10 cycle
x = x / 10
exponent = exponent + 1
repeat
! Now X is between 1.0 and 9.99 and exponent is set accordingly
! If the exponent is "large" we will use scientific notation
point = places - 2; ! for useful digits after the "0."
if exponent >= places or exponent < -point start
printexpo = exponent
exponent = 0
places = places - 2
finish
! Now the exponent is small-ish
if exponent < 0 start; ! 0.nnnn
printsymbol('0')
printsymbol('.')
places = places - 2
while exponent < -1 cycle
printsymbol('0')
exponent = exponent + 1
places = places - 1
repeat
point = -1; ! because we've already passed that
else; ! nnn.nnn
point = exponent
finish
while places > 0 cycle
digit = int pt(x)
! Rounding as we go through this loop can "oversize" the digit. This
! of course tells us that we should have printed (eg) 40000 but we
! are now stuck with printing 39999
if digit > 9 then digit = 9
printsymbol(digit + '0')
x = (x - digit)*10
if point = 0 then printsymbol('.') and places = places - 1
point = point - 1
places = places - 1
repeat
if printexpo # 0 start
printsymbol('@')
write68k(printexpo, 1)
finish
end
! #########################################################################################
routine writetest(string (255) procname, routine testedwrite(integer n, p))
const integer GAP = 15 ; ! allow for largest int (+ or -) plus manditory spaces
const integer COLS = 13 ; ! 1 beyond what is an exact fit
integer n, m, shift, startpos, ALIGN
for ALIGN = 1, -2, -1 cycle
n = 1
printstring(procname)
printstring(": ")
newlines(2)
if ALIGN < 0 then start
printstring("In IMP77, the total number of print positions to be used is defined"); newline
printstring("by the modulus of the second parameter (n). If this parameter is"); newline
printstring("negative, no space character should output before a positive value:"); newline
newlines(2)
finish
printstring(" ¬ n | write(m,n):"); newline
printstring(" ¬ |"); newline
printstring(" ¬ |"); newline
printstring(" m ¬|"); newline
printstring(" ----+ ")
for m = 0, 1, cols cycle
startpos = outpos
write68k(ALIGN*m,0)
spaces(GAP-(outpos-startpos))
repeat
newline
printstring("MIN INT ")
for m = 0, 1, cols cycle
startpos = outpos
printsymbol('[')
!tested write(-2147483648, m)
testedwrite(16_80000000, ALIGN*m)
printsymbol(']')
spaces(gap - (outpos - startpos))
repeat
newline
n = 1000000000
shift = 9
cycle
printstring(" -10^")
write68k(shift, 0)
spaces(2)
for m = cols, -1, 0 cycle
! examine the number of characters between the [] brackets
startpos = outpos
printsymbol('[')
testedwrite(-n, ALIGN*(cols - m))
printsymbol(']')
spaces(gap - (outpos - startpos))
repeat
newline
n = n // 10
shift = shift - 1
repeat until n = 0
printstring(" 0 ")
for m = 0, 1, cols cycle
startpos = outpos
printsymbol('[')
testedwrite(0, ALIGN*m)
printsymbol(']')
spaces(gap - (outpos - startpos))
repeat
newline
n = 1
shift = 1
cycle
printstring(" 10^")
write68k(shift - 1, 0)
spaces(2)
for m = 0, 1, cols cycle
! examine the number of characters between the [] brackets
startpos = outpos
printsymbol('[')
testedwrite(n, ALIGN*m)
printsymbol(']')
spaces(gap - (outpos - startpos))
repeat
newline
exit if n = 1000000000
n = n * 10
shift = shift + 1
repeat
printstring("MAX INT ")
for m = 0, 1, cols cycle
startpos = outpos
printsymbol('[')
testedwrite(2147483647, ALIGN*m)
printsymbol(']')
spaces(gap - (outpos - startpos))
repeat
newlines(3)
repeat
end
! #########################################################################################
routine printfltest(string (255) procname, routine testedprintfl(longreal n, integer p))
const integer GAP = 26 ; ! allow for accuracy of long reals
const integer COLS = 17
long real n, k
integer m, exponent, startpos, ALIGN
for ALIGN = 1, 1, 1 cycle ; ! %for ALIGN = 1, -2, -1 %cycle
n = 1
if ALIGN < 0 then printstring("Possibly left-justified ")
printstring(procname)
!%if neg < 0 %then printstring(" with negative numbers")
printstring(": ")
newlines(2)
printstring(" ¬ n | printfl(m,n):"); newline
printstring(" ¬ |"); newline
printstring(" ¬ |"); newline
printstring(" m ¬|"); newline
printstring(" ----+ ")
for m = 0, 1, cols cycle
startpos = outpos
write68k(m,0)
spaces(GAP-(outpos-startpos))
if REM(m, 6)=5 then newline and print string(" ");
repeat
newline
n = 1.23456789012345678901234567890
k = 1@100; exponent = 100
cycle
printstring("-1@")
write68k(exponent, 0)
space while outpos < 8
for m = cols, -1, 0 cycle
! examine the number of characters between the [] brackets
startpos = outpos
printsymbol('[')
testedprintfl(-k*n, ALIGN*(cols - m))
printsymbol(']')
spaces(gap - (outpos - startpos))
if REM(cols-m, 6)=5 then newline and print string(" ");
repeat
newline
if exponent = 100 start
k = 1@10; exponent = 10
else if exponent = 10
k = 1@1; exponent = 1
else if exponent = 1
k = 1@0; exponent = 0
else if exponent = 0
k = 1@-1; exponent = -1
else if exponent = -1
k = 1@-10; exponent = -10
else if exponent = -10
k = 1@-100; exponent = -100
finish else exit
repeat
printstring(" 0@0 ")
for m = 0, 1, cols cycle
startpos = outpos
printsymbol('[')
testedprintfl(0, ALIGN*m)
printsymbol(']')
spaces(gap - (outpos - startpos))
if REM(m, 6)=5 then newline and print string(" ");
repeat
newline
k = 1@100; exponent = 100
cycle
printstring(" 1@")
write68k(exponent, 0)
space while outpos < 8
for m = cols, -1, 0 cycle
! examine the number of characters between the [] brackets
startpos = outpos
printsymbol('[')
testedprintfl(k*n, ALIGN*(cols - m))
printsymbol(']')
spaces(gap - (outpos - startpos))
if REM(cols-m, 6)=5 then newline and print string(" ");
repeat
newline
if exponent = 100 start
k = 1@10; exponent = 10
else if exponent = 10
k = 1@1; exponent = 1
else if exponent = 1
k = 1; exponent = 0
else if exponent = 0
k = 0.1; exponent = -1
else if exponent = -1
k = 1@-10; exponent = -10
else if exponent = -10
k = 1@-100; exponent = -100
finish else exit
repeat
newlines(3)
repeat
end
! WRITE TESTS write(num, places)
writetest("Copy of current (imp2024) write", write3l)
writetest("EMAS write", emaswrite)
writetest("EMAS write (from imp77 compatibility library)", emasi77write)
writetest("Vax write", vaxwrite)
writetest("Dec10 (imp77) write", dec10 write)
writetest("Mouses (imp77) write", mouseswrite)
writetest("APM (imp68k) write", write68k)
! PRINTFL TESTS printfl(num, places)
! Current imp77 library uses some weird names. I've extracted the equivalents of
! the standard printfl and print, and renamed them to avoid confusion.
! Their output is not compatible with the ercc, vax, or dec10 versions :-(
! As with write, I had to provide a local copy in order to support 'outpos'
! which is necessary to handle padding correctly when the spacing of the
! routine under test is unknown.
printfltest("copy of current (imp2024) printfl (called 'print' in the imp2024 library)", imp77 printfl)
printfltest("EMAS (imp9) printfl", emas printfl)
printfltest("ERCC (imp80) printfl", ercc printfl)
printfltest("Vax (imp77) printfl", vax printfl)
printfltest("Dec10 (imp77) printfl", dec10 printfl)
printfltest("Mouses (imp77) printfl", mouses printfl)
printfltest("APM (imp68k) printfl", dec10 printfl)
! TO DO: PRINT TESTS print(num, iplaces, dplaces)
end of programme