/* --------------------------------------------------------------- */ /* toDPD -- convert number to canonical IEEE 754 decimal-encoding */ /* --------------------------------------------------------------- */ /* */ /* Copyright (c) Mike Cowlishaw, 2000-2012. All rights reserved. */ /* Parts Copyright (c) IBM, 2000-2008. */ /* */ /* Permission to use, copy, modify, and distribute this software */ /* for any non-commercial purpose without fee is hereby granted, */ /* provided that the above copyright notice and this permission */ /* notice appear in all copies, and that notice and the date of */ /* any modifications be added to the software. */ /* */ /* This software is provided "as is". No warranties, whether */ /* express, implied, or statutory, including, but not limited to, */ /* implied warranties of merchantability and fitness for a */ /* particular purpose apply to this software. The author shall */ /* not, in any circumstances, be liable for special, incidental, */ /* or consequential damages, for any reason whatsoever. */ /* */ /* --------------------------------------------------------------- */ /* Argument words: */ /* num -- the finite number to be encoded, or a special (one */ /* of: NAN[payload], SNAN[payload], INF[INITY]) */ /* specials may have a leading + or - sign */ /* */ /* bits -- count of target bits (default 64) */ /* */ /* returns the hex string for the number, or displays it if */ /* called as a command */ /* --------------------------------------------------------------- */ numeric digits 100 arg num bits . if num='' then do say 'Please supply a number to convert to IEEE 754 format' exit; end if bits='' then bits=64 select when bits=32 then do precision=7 emax=96 emin=-95 econl=6 bias=101 end when bits=64 then do precision=16 emax=384 emin=-383 econl=8 bias=398 end when bits=128 then do precision=34 emax=6144 emin=-6143 econl=12 bias=6176 end when bits=256 then do -- decOct precision=70 emax=1572864 emin=-1572863 econl=20 bias=1572932 end otherwise do say 'Bits must be 32, 64, 128, or 256' exit; end end -- select clamped=0 -- indicator flag -- detect and remove sign; set bit neg=0 if left(num, 1)='-' then do num=substr(num, 2) neg=1 end if left(num, 1)='+' then num=substr(num, 2) bneg=neg -- sign as a bit if \datatype(num, 'n') then do -- could be NaN or infinite -- set up: bcomb and becon select when left(num, 3)='NAN' | left(num, 4)='SNAN' then do parse var num pre 'NAN' payload bcomb='11111' if pre='S' then becon='1'copies(0, econl-1) else becon=copies(0, econl) if payload='' then payload=0 if \datatype(payload, 'n') | length(payload)>=precision then do say 'NaN payload is not a number (or is too long):' payload exit; end if (payload%1)\==payload then do say 'NaN payload is not an integer:' payload exit; end num=right(payload, precision-1, 0) if pre='S' then special='sNaN' else special='qNaN' if num>0 then special=special 'pay='||(num+0) end when left(num, 3)='INF' then do bcomb='11110' becon=copies(0, econl) parse var num 4 rest if left(rest, 5)='INITY' then parse var rest 6 rest if rest\='' then do say 'Invalid Infinity string:' num exit; end num=copies(0, precision-1) special='Infinity' end otherwise say 'This cannot be converted to a 754' bits'-bit number:' num exit end end else do -- finite number -- extract exponent, and make coefficient an integer e=pos('E', num) if e=0 then exp=0 else parse var num num 'E' exp -- num is now just coefficient d=pos('.', num) if d>0 then do parse var num int '.' frac exp=exp-length(frac) num=int||frac end len=length(num) if len>precision then do say 'Coefficient is too long ['len']:' num exit; end -- now bias and check the exponent; clamp the coefficient or -- zero-exponent if need be exp=exp+bias if exp<0 then do if num!=0 then do exp=exp-bias -- back to unbiased say 'Exponent is too small for the' bits'-bit format:' exp exit; end exp=0 clamped=1 end topexp=3*2**econl-1 if exp>topexp then do -- at top end; may be able to retrieve by fold-down or clamp 0 if num=0 then exp=emax-(precision-1)+bias else do excess=exp-topexp -- padding needed if excess>(precision-len) then do -- hopeless exp=exp-bias -- back to unbiased say 'Exponent is out of range for the' bits'-bit format:' exp exit; end num=num||copies('0', excess) -- folddown len=len+excess exp=exp-excess -- clamped end clamped=1 end msd=0 if len