home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / scripts / ckermit / twoscomplement < prev    next >
Lisp/Scheme  |  2020-01-01  |  5KB  |  125 lines
  1. # Macros to display signed decimal numbers in two's complement hexadecimal
  2. # notation.  Because the code underlying most of Kermit's arithmetic and
  3. # numeric comparison functions uses machine arithmetic, it is necessary to 
  4. # employ string operations and lexical comparisons to handle edge cases.
  5. # Works in both C-Kermit (8.0 and later) and K95 (2.0 and later).
  6. #
  7. # F. da Cruz, Columbia University, 19 November 2007
  8.  
  9. # Macro BINTOHEX converts a binary string to hex.
  10. #   \%1 = binary number (string)
  11. #   \%2 = word size in bits
  12. # 
  13. # \fradix() is constrained by machine integer word length
  14. # so we do it in pieces in case the number is too big.
  15. #
  16. define BINTOHEX {
  17.     undef \%6                                # Result accumulator
  18.     for \%9 1 \%2 4 {                        # Do four bits at at a time
  19.         .\%8 := \fsubstr(\%1,\%9,4)          # Get chunk of 4
  20.         if not def \%8 break                 # Make sure we have one
  21.         .\%7 := \fradix(\%8,2,16)            # Convert to Hex digit
  22.         .\%6 := \%6\%7                       # Accumulate
  23.     }
  24.     return \%6
  25. }
  26. # Macro DECTOHEX converts a signed decimal number to 2's complement hex.
  27. #   \%1 = decimal number string (default 0)
  28. #   \%2 = word size in bits (must be a power of two, 4 or greater, default 32)
  29. #
  30. # Because of how \fradix() works, this function operates correctly only
  31. # for numbers whose absolute value fits in the machine's integer word.
  32. #
  33. define DECTOHEX {
  34.     local m1
  35.     if not def \%1 .\%1 = 0                  # Supply default if no arg given
  36.     if not numeric \%1 return NOT_A_NUMBER:\%1  # Check that arg is a number
  37.     if not def \%2 .\%2 := 32                   # Use 32 bits if no second arg
  38.     (setq m1 (truncate (- (^ 2 (- \%2 1)) 1)))  # Largest positive number
  39.     if eq "\fsubstr(\%1,1,1)" "+" .\%1 := \fsubstr(\%1,2) # strip any + sign
  40.     if not eq "\fsubstr(\%1,1,1)" "-" {         # Argument is signed?
  41.         .\%1 := \flpad(\%1,\flen(\v(svalue)),0) # No - check magnitude
  42.         if lgt \%1 \v(svalue) return OVERFLOW 
  43.         return \flpad(\fradix(\%1,10,16),(\%2 / 4),0) # Convert to hex and pad
  44.     }
  45.     .\%1 := \fsubstr(\%1,2)                  # Negative number - remove sign
  46.     .\%1 := \flpad(\%1,\flen(\m(m1)),0)      # Must use lexical comparison
  47.     (++ m1)                                  # Avoid fencepost error
  48.     if llt \m(m1) \%1 return UNDERFLOW       # Check magnitude
  49.     .\%9 := \flpad(\fradix(\%1,10,2),\%2,0)  # Convert to binary and pad
  50.     .\%8 ::= \frindex(1,\%9) - 1             # Find first 1 on the right
  51.     if == \%8 -1 {                           # Watch out for negative 0
  52.          return \frepeat(0,\%2 / 4)
  53.     }
  54.     .\%7 := \fsubstr(\%9,1,\%8)              # Split string here
  55.     .\%6 := \fsubstitute(\%7,01,10)          # Complement bits in left part
  56.     .\%5 := \%6\fsubstr(\%9,\%8+1)           # Put back with right part
  57.     .\%4 := \fexec(bintohex \%5 \%2)         # Convert to hex
  58.     return \%4
  59. }
  60. # Test the functions...
  61.  
  62. set take echo on
  63. echo \fexec(dectohex  7)          # No word size specified
  64. echo \fexec(dectohex)
  65.  
  66. echo \fexec(dectohex  7 4)        # 4-bit word
  67. echo \fexec(dectohex  8 4)
  68. echo \fexec(dectohex -8 4)
  69. echo \fexec(dectohex -9 4)
  70. echo \fexec(dectohex 99 4)
  71.  
  72. echo \fexec(dectohex  0 8)        # 8-bit word
  73. echo \fexec(dectohex -0 8)
  74. echo \fexec(dectohex  1 8)
  75. echo \fexec(dectohex +1 8)
  76. echo \fexec(dectohex  2 8)
  77. echo \fexec(dectohex  3 8)
  78. echo \fexec(dectohex  4 8)
  79. echo \fexec(dectohex  5 8)
  80. echo \fexec(dectohex  6 8)
  81. echo \fexec(dectohex  7 8)
  82. echo \fexec(dectohex -1 8)
  83. echo \fexec(dectohex -2 8)
  84. echo \fexec(dectohex -3 8)
  85. echo \fexec(dectohex -4 8)
  86. echo \fexec(dectohex -5 8)
  87. echo \fexec(dectohex -6 8)
  88. echo \fexec(dectohex -7 8)
  89. echo \fexec(dectohex -8 8)
  90. echo \fexec(dectohex 64 8)
  91. echo \fexec(dectohex 65 8)
  92. echo \fexec(dectohex -128 8)
  93.  
  94. echo \fexec(dectohex 0 16)       # 16-bit word
  95. echo \fexec(dectohex 64 16)
  96. echo \fexec(dectohex 65 16)
  97. echo \fexec(dectohex -128 16)
  98. echo \fexec(dectohex -32768 16)
  99. echo \fexec(dectohex 99999 16)
  100. echo \fexec(dectohex -99999 16)
  101.  
  102. echo \fexec(dectohex 0 32)       # 32-bit word
  103. echo \fexec(dectohex 1 32)
  104. echo \fexec(dectohex 16383 32)
  105. echo \fexec(dectohex 2147483647 32)
  106. echo \fexec(dectohex -1 32)
  107. echo \fexec(dectohex -2 32)
  108. echo \fexec(dectohex -2147483647 32)
  109. echo \fexec(dectohex -2147483648 32)
  110.  
  111. echo \fexec(dectohex 0 64)       # 64-bit word
  112. echo \fexec(dectohex 2147483647 64)
  113. echo \fexec(dectohex -1 64)
  114. echo \fexec(dectohex -2 64)
  115. echo \fexec(dectohex -2147483647 64)
  116. echo \fexec(dectohex -2147483648 64)
  117.  
  118. echo \fexec(dectohex 0 128)      # 128-bit word
  119. echo \fexec(dectohex 1 128)
  120. echo \fexec(dectohex -1 128)
  121. echo \fexec(dectohex -2 128)
  122.  
  123. set take echo off
  124. if c-kermit exit
  125.