%string(36) %fn FPTOS (%integer REAL ADDR{ess}, REAL MODE {3 for REAL* 4}) ! {4 for REAL* 8} ! ! ! A Procedure to print the value of either a single ! ! or double or extended precision Real ! ! for the FORTRAN77 Optimising Compiler. ! ! !Note: This version does not handle extended precision (REAL*16) reals ! ! %longrealfnspec into range (%longreal a) %routine copy (%integer length, from adr, from inc, to adr, to inc) ! ! from adr=from adr<< 1 %andc to adr= to adr<< 1 %if target= perqpnx %while length>0 %cycle ! byteinteger(to adr + to inc)= byteinteger(from adr + from inc) to inc = to inc + 1 from inc = from inc + 1 length = length - 1 %repeat ! %end; !of copy ! ! ! Floating-Point Constants ! ! %constlongrealarray rounding factor(0:1)= 5.0@-7 , 5.0@-7 %if HOST= PERQPNX %thenstart ! ! Define Real Constants in IEEE Standard ! %constlongreal point one = r'3fb999999999999a' {1.0@-1 } %constlongreal ten to the max= r'7fe1ccf385ebc8a0' {1.0@+308} %constlongreal ten to the min= r'0066789e3750f791' {1.0@-306} %constinteger maximum power= 308 %constinteger minimum power= -306 %finishelsestart ! HOST=ICL2900 %if TARGET=ICL2900 %thenstart ! ! Define Real Constants in ICL2900 Standard for EMAS ! %constlongreal ten to the max= r'7f235fadd81c2823' %constlongreal ten to the min= r'0273cac65c39c961' %constinteger maximum power= 75 %constinteger minimum power= -75 %finishelsestart ! ! Define Real Constants in IEEE Standard on EMAS ! %constintegerarray pnx ten to the max (0:1)= x'7fe1ccf3' , x'85ebc8a0' %constintegerarray pnx ten to the min (0:1)= x'0066789e' , x'3750f791' %longrealname ten to the max {to be mapped onto PNX TEN TO THE MAX} %longrealname ten to the min {to be mapped onto PNX TEN TO THE MIN} %constinteger maximum power= 308 %constinteger minimum power= -306 %finish %constlongreal point one = r'401999999999999a' %finish ! ! Work-Areas ! %byteintegerarray work area (0:30) {---used while formatting} %byteintegerarray text (0:37) {---used to construct the formatted value} %integer workarea addr {address of work-area(0)} %integer text addr {address of text (0)} ! ! Locals ! %integer decs ; !set to number of significant digits required %integer exp ; !set to number of digits to the left of the '.' %integer sign ; !set to either '+' or '-' or nothing %integer exponent ; !set to the value of a floating-point exponent %integer format ; !set to 'F' if using fixed-point format, else set to 'E' %integer chars reqd; !set to the number of digits to produce %integer area ptr ; !ptr into WORK AREA %integer ptr ; !ptr into TEXT %integer i ; !work variable %integer n ; !work variable %longreal a; !the real value to be formatted %longreal x; !the real value in the range 10.0> a>= 1.0 %if HOST=ICL2900 %and TARGET=PERQPNX %thenstart ! ! Initialise Real Constants ! ten to the max==longreal(addr(pnx ten to the max(0))) ten to the min==longreal(addr(pnx ten to the min(0))) %finish ! ! Initialise Variables ! workarea addr= addr(work area(0)) text addr= addr( text(0)) real mode= real mode-3 %if real mode= 0 %then a= real(real addr{ess}) %and decs=7 %c %else a= longreal(real addr{ess}) %and decs=7 exp= 1 ! ! Pick Up the REAL ! %if a<0.0 %then a=-a %and sign='-' %c %else sign= 0 !Scale the REAL into the range: 10.0> a >=1.0 ! %if a = 0.0 %then x= 0.0 %and exp= 0 %c %elsestart x =into range(a) + rounding factor(real mode) %if x>=10.0 %thenstart x= x/10.0; !apply correction if rounding exp=exp+1 ; ! put the value back out of range %finish %finish %if 0<= exp< decs %thenstart ! ! ! Output the REAL in Fixed-Point Format ! ! decs= decs-exp; !reduce DECS by digits reqd to the left of the '.' format='F' {Fixed-Point} %finishelsestart ! ! ! Output the REAL in Floating-Point Format ! ! exponent= exp-1 %and exp= 1; !one digit reqd to the left of '.' decs= decs-1 ; ! and reduce digits right of '.' accordingly format='E' %finish !Analyse Form of the Number Required: ! ! chars reqd= decs + exp %if exp= 0 %then workarea(0)= '0' %and area ptr= 1 %and exp= 1 %c %else area ptr= 0 !Acquire the Digits in Character Form: ! ! %while chars reqd\= 0 %cycle chars reqd = chars reqd - 1 n = int pt (x) x = 10.0*(x - n) workarea(area ptr)= '0' + n area ptr = area ptr + 1 ! %repeat !Produce the Formatted Number: ! ! ptr = 1 %unless sign = 0 %then text(ptr)= sign %c %and ptr = ptr+1 ! ! Write out Digits to the LEFT of the Decimal Point ! copy (exp, workarea addr, 0, text addr, ptr) ! area ptr= exp ptr= ptr + exp text(ptr)= '.' {write out } ptr = ptr + 1 { the decimal point} ! ! Write Out the Digits to the RIGHT of the Decimal Point ! copy (decs,workarea addr,area ptr,text addr,ptr) ptr= decs+ptr %if format='E' %thenstart ! ! ! Now Format the Exponent ! ! %if exponent< 0 %then exponent=-exponent %and sign='-' %c %else sign='+' text(ptr )= 'E' text(ptr+1)= sign ptr = ptr+2 i = exponent//10 text(ptr )= i + '0' text(ptr+1)= exponent- (i*10) + '0' ptr = ptr+2 %finish !Return the Formatted Value: ! ! text(0)= ptr-1 %andresult= string(addr(text(0))) %longrealfn INTO RANGE (%longreal x) ! ! ! ! A Procedure which brings the Value of the given ! ! Parameter into the Range 10.0> X >=1.0 ! ! !Additionally, the variable EXP is changed to reflect the ! magnitude (scale of 10) of the parameter. ! ! %longreal y %longreal z ! %integer i; !a work variable %if x>=10.0 %thenstart ! ! The value is too large ! %if x< ten to the max %thenstart ! ! Find the scale of the number and bring it into range ! i= 1; z= 10.0 y=100.0 ! z=y %and y=z*10.0 %and i=i+1 %while x>=y ! x=x/z %and exp=exp+ i %finishelse exp=exp+ maximum power %and x=x/ten to the max %finish %if x<1.0 %thenstart ! ! The value is too small ! x=x*10.0 %and exp=exp-1 %while x