/* hex.p
**
** Written by Greg Higgins 
** PEG Holdings, Inc.
** 6/30/98
**
** Most conversion functions use an integer value. This is too
** small for an 8 character hex field, so we use decimals.
**
** Yes, the functions are recursive. You're welcome to test the
** speed against your favorite iterative routines.
**
** 
** Usage  C = dec2hex(d) . C a character field, D a decimal.
** Usage  D = hex2dec(c) . C a character field, D a decimal.
**
** If the functions return ?, an error occurred.
** 
** The functions accept and return hexstrings with prepended
** "0x", but hex2dec does not require it.
** 
** 
*/

{hex.i}

&SCOP HEX_LIST "0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F"
&SCOP HEX_STR  "0123456789abcdef"
&SCOP MAX_POS_INT 2147483647.0


/* PRIVATE */
FUNCTION itoh RETURNS character ( INPUT intnum AS INTEGER ) :
  return (if intnum gt 15 then itoh(integer(trunc( intnum / 16, 0 ))) 
                          else "" )
       + entry( intnum mod 16 + 1, {&HEX_LIST} ).
END FUNCTION /* itoh */ .


/* PRIVATE */
FUNCTION dtoh RETURNS character ( INPUT decnum AS DECIMAL)  :
  define variable td as decimal decimals 0 no-undo.
  
  if decnum le {&MAX_POS_INT} then
    return (if decnum gt 15.0 then itoh(integer(trunc(decnum / 16.0 , 0))) 
                               else "" ) 
          + entry( decnum mod 16  + 1, {&HEX_LIST} ).
  else 
    assign td = trunc(decnum / 16.0, 0 ) .
    return dtoh(td) + (entry(integer((decnum - (td * 16.0))) + 1,{&HEX_LIST})). 
END FUNCTION /* dtoh */.

/* PRIVATE */
FUNCTION htoi RETURNS integer (INPUT hexstr AS character):
  define variable fc as character no-undo.
  define variable ix as integer no-undo.
  
  assign
    fc = substr(hexstr,1,1)
    ix = index({&HEX_STR}, fc ) - 1.
    
    if fc eq "" then return 0.
    else  if ix lt 0 then return error.
    else return
       ( ix * integer( entry(length(hexstr),
            "1,16,256,4096,65536,1048576,16777216,268435456" )) )
       + htoi ( substr(hexstr,2) ).
END FUNCTION /* htoi */.            

/* PRIVATE */
FUNCTION pow16 RETURNS decimal (INPUT i AS integer) :

  case i :
when     0 then return                                                   1.0 .
when     1 then return                                                  16.0 .
when     2 then return                                                 256.0 .
when     3 then return                                                4096.0 .
when     4 then return                                               65536.0 .
when     5 then return                                             1048576.0 .
when     6 then return                                            16777216.0 .
when     7 then return                                           268435456.0 .
when     8 then return                                          4294967296.0 .
when     9 then return                                         68719476736.0 .
when    10 then return                                       1099511627776.0 .
when    11 then return                                      17592186044416.0 .
when    12 then return                                     281474976710656.0 .
when    13 then return                                    4503599627370496.0 .
when    14 then return                                   72057594037927936.0 .
when    15 then return                                 1152921504606846976.0 .
when    16 then return                                18446744073709551616.0 .
when    17 then return                               295147905179352825856.0 .
when    18 then return                              4722366482869645213696.0 .
when    19 then return                             75557863725914323419136.0 .
when    20 then return                           1208925819614629174706176.0 .
when    21 then return                          19342813113834066795298816.0 .
when    22 then return                         309485009821345068724781056.0 .
when    23 then return                        4951760157141521099596496896.0 .
when    24 then return                       79228162514264337593543950336.0 .
when    25 then return                     1267650600228229401496703205376.0 .
when    26 then return                    20282409603651670423947251286016.0 .
when    27 then return                   324518553658426726783156020576256.0 .
when    28 then return                  5192296858534827628530496329220096.0 .
when    29 then return                 83076749736557242056487941267521536.0 .
when    30 then return               1329227995784915872903807060280344576.0 .
when    31 then return              21267647932558653966460912964485513216.0 .
when    32 then return             340282366920938463463374607431768211456.0 .
when    33 then return            5444517870735015415413993718908291383296.0 .
when    34 then return           87112285931760246646623899502532662132736.0 .
when    35 then return         1393796574908163946345982392040522594123776.0 .
when    36 then return        22300745198530623141535718272648361505980416.0 .
when    37 then return       356811923176489970264571492362373784095686656.0 .
when    38 then return      5708990770823839524233143877797980545530986496.0 .
when    39 then return     91343852333181432387730302044767688728495783936.0 .
when    40 then return   1461501637330902918203684832716283019655932542976.0 .
when    41 then return  23384026197294446691258957323460528314494920687616.0 .
otherwise  return error.
  end.
END FUNCTION /* pow16 */.
    
/* PRIVATE */
FUNCTION htod RETURNS decimal ( INPUT hexstr AS character ):                 
  define variable fc as character no-undo.
  define variable ix as integer no-undo.
  
  assign
    fc = substr(hexstr,1,1)
    ix = index({&HEX_STR}, fc ) - 1.
  if fc eq "" then return 0.0 .
  else  if ix lt 0 then return error.
  else return  decimal( ix * pow16( length(hexstr) - 1))
                            +  htod(substr(hexstr,2)).
END FUNCTION /* htod */.


/* PUBLIC */
FUNCTION dec2hex RETURNS character:
  if (decnum lt 0.0) or (trunc(decnum,0) ne decnum) then return error.
  else if decnum eq 0.0 then return "0x0" .
  else return "0x" + 
    if decnum lt {&MAX_POS_INT} then itoh ( integer(decnum) )
                                else dtoh ( decnum ).
END FUNCTION /* dec2hex */.


/* PUBLIC */
FUNCTION hex2dec RETURNS decimal:
  define variable ws as character no-undo.
  assign 
    ws = if hexstr begins "0x" 
         then substr(hexstr,3) 
         else hexstr.
  if ws eq "" then return error.
  if length( ws ) lt 6 then  return ( decimal ( htoi (ws) ) ).
  else return ( htod(ws) ).
END FUNCTION /* hex2dec */.