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