# Macros to display signed decimal numbers in two's complement hexadecimal
# notation.  Because the code underlying most of Kermit's arithmetic and
# numeric comparison functions uses machine arithmetic, it is necessary to 
# employ string operations and lexical comparisons to handle edge cases.
# Works in both C-Kermit (8.0 and later) and K95 (2.0 and later).
#
# F. da Cruz, Columbia University, 19 November 2007

# Macro BINTOHEX converts a binary string to hex.
#   \%1 = binary number (string)
#   \%2 = word size in bits
# 
# \fradix() is constrained by machine integer word length
# so we do it in pieces in case the number is too big.
#
define BINTOHEX {
    undef \%6                                # Result accumulator
    for \%9 1 \%2 4 {                        # Do four bits at at a time
        .\%8 := \fsubstr(\%1,\%9,4)          # Get chunk of 4
        if not def \%8 break                 # Make sure we have one
        .\%7 := \fradix(\%8,2,16)            # Convert to Hex digit
        .\%6 := \%6\%7                       # Accumulate
    }
    return \%6
}
# Macro DECTOHEX converts a signed decimal number to 2's complement hex.
#   \%1 = decimal number string (default 0)
#   \%2 = word size in bits (must be a power of two, 4 or greater, default 32)
#
# Because of how \fradix() works, this function operates correctly only
# for numbers whose absolute value fits in the machine's integer word.
#
define DECTOHEX {
    local m1
    if not def \%1 .\%1 = 0                  # Supply default if no arg given
    if not numeric \%1 return NOT_A_NUMBER:\%1  # Check that arg is a number
    if not def \%2 .\%2 := 32                   # Use 32 bits if no second arg
    (setq m1 (truncate (- (^ 2 (- \%2 1)) 1)))  # Largest positive number
    if eq "\fsubstr(\%1,1,1)" "+" .\%1 := \fsubstr(\%1,2) # strip any + sign
    if not eq "\fsubstr(\%1,1,1)" "-" {         # Argument is signed?
        .\%1 := \flpad(\%1,\flen(\v(svalue)),0) # No - check magnitude
        if lgt \%1 \v(svalue) return OVERFLOW 
        return \flpad(\fradix(\%1,10,16),(\%2 / 4),0) # Convert to hex and pad
    }
    .\%1 := \fsubstr(\%1,2)                  # Negative number - remove sign
    .\%1 := \flpad(\%1,\flen(\m(m1)),0)      # Must use lexical comparison
    (++ m1)                                  # Avoid fencepost error
    if llt \m(m1) \%1 return UNDERFLOW       # Check magnitude
    .\%9 := \flpad(\fradix(\%1,10,2),\%2,0)  # Convert to binary and pad
    .\%8 ::= \frindex(1,\%9) - 1             # Find first 1 on the right
    if == \%8 -1 {                           # Watch out for negative 0
         return \frepeat(0,\%2 / 4)
    }
    .\%7 := \fsubstr(\%9,1,\%8)              # Split string here
    .\%6 := \fsubstitute(\%7,01,10)          # Complement bits in left part
    .\%5 := \%6\fsubstr(\%9,\%8+1)           # Put back with right part
    .\%4 := \fexec(bintohex \%5 \%2)         # Convert to hex
    return \%4
}
# Test the functions...

set take echo on
echo \fexec(dectohex  7)          # No word size specified
echo \fexec(dectohex)

echo \fexec(dectohex  7 4)        # 4-bit word
echo \fexec(dectohex  8 4)
echo \fexec(dectohex -8 4)
echo \fexec(dectohex -9 4)
echo \fexec(dectohex 99 4)

echo \fexec(dectohex  0 8)        # 8-bit word
echo \fexec(dectohex -0 8)
echo \fexec(dectohex  1 8)
echo \fexec(dectohex +1 8)
echo \fexec(dectohex  2 8)
echo \fexec(dectohex  3 8)
echo \fexec(dectohex  4 8)
echo \fexec(dectohex  5 8)
echo \fexec(dectohex  6 8)
echo \fexec(dectohex  7 8)
echo \fexec(dectohex -1 8)
echo \fexec(dectohex -2 8)
echo \fexec(dectohex -3 8)
echo \fexec(dectohex -4 8)
echo \fexec(dectohex -5 8)
echo \fexec(dectohex -6 8)
echo \fexec(dectohex -7 8)
echo \fexec(dectohex -8 8)
echo \fexec(dectohex 64 8)
echo \fexec(dectohex 65 8)
echo \fexec(dectohex -128 8)

echo \fexec(dectohex 0 16)       # 16-bit word
echo \fexec(dectohex 64 16)
echo \fexec(dectohex 65 16)
echo \fexec(dectohex -128 16)
echo \fexec(dectohex -32768 16)
echo \fexec(dectohex 99999 16)
echo \fexec(dectohex -99999 16)

echo \fexec(dectohex 0 32)       # 32-bit word
echo \fexec(dectohex 1 32)
echo \fexec(dectohex 16383 32)
echo \fexec(dectohex 2147483647 32)
echo \fexec(dectohex -1 32)
echo \fexec(dectohex -2 32)
echo \fexec(dectohex -2147483647 32)
echo \fexec(dectohex -2147483648 32)

echo \fexec(dectohex 0 64)       # 64-bit word
echo \fexec(dectohex 2147483647 64)
echo \fexec(dectohex -1 64)
echo \fexec(dectohex -2 64)
echo \fexec(dectohex -2147483647 64)
echo \fexec(dectohex -2147483648 64)

echo \fexec(dectohex 0 128)      # 128-bit word
echo \fexec(dectohex 1 128)
echo \fexec(dectohex -1 128)
echo \fexec(dectohex -2 128)

set take echo off
if c-kermit exit