normalizing_fraction = input_fract * 16
If normalizing_fraction = 1 Then Leave
input_fract = normalizing_fraction
exponent = exponent - 1
End
/*---+
* compute amount to normalize |
*---+
*/
If exponent 0 Then Do
amount_to_normalize = 0
End
Else Do
amount_to_normalize = exponent
End
/*---+
* Normalize the build float value. |
*---+
*/
remainder = input_fract
Do i = 1 To (14 - amount_to_normalize)
normalizing_value = remainder * 16
quotient = normalizing_value % 1
remainder = normalizing_value // 1
float_value = float_value || D2x(quotient)
End
/*---+
* Convert integer portion directly |
*---+
*/
sign_and_exponent = C2x(Bitor(X2c(D2x(exponent+64)),Sign))
result_value = Substr(C2x(X2c(sign_and_exponent||float_value)),1,16)
Say Resulting floating value: result_value
/*---+
* Now begin conversion back out to decimal display. |
*---+
*/
internal_float = X2c(result_value)
/*---+
* Extract the sign and exponent byte|
*---+
*/
sign_and_exponent = Substr(internal_float,1,1)
/*---+
* Compute the true exponent |
*---+
*/
x_exponent= Bitand(sign_and_exponent,7fx)
excess_64_exp = C2d(x_exponent)
true_exponent = excess_64_exp - 65
/*---+
* Create a factor of +1 or -1 from the sign bit |
*---+
*/
sign_factor = ((Bitand(sign_and_exponent,80x)=00x)-.5)*2
/*---+
* Extract the fraction part of the number |
*---+
*/
fraction = Substr(internal_float,2)
hex_fraction = C2x(fraction)
result_value = 0
/*---+
* Sum the result value by processing each hex digit |
*---+
*/
Do i = 1 To Length(hex_fraction)
hex_digit = X2d(Substr(hex_fraction,i,1))
result_value = result_value + (hex_digit * (16**true_exponent))
true_exponent = true_exponent - 1
End
/*---+
* Factor in the sign|
*---+
*/
result_value = result_value * sign_factor
/*---+
* Format the result |
*---+
*/
print_value = Strip(Strip(Format(result_value,,14),T,0),T,.)
If print_value = 0 Then /* Maybe we stripped too much */
print_value = Format(result_value,2,14,2,0)
Say Floating value converted back: print_value
say
say 'Press Enter to continue'
pull
return
--
Robert AH Prins
robert(a)prino(d)org
--
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
