x86opcodes.lisp

   1
   2 (in-package :cl-x86-asm)
   3
   4 ;; -- instruction encoding -----------------------------------------------------
   5
   6 (defun encode-32-bit-register-address (ea instruction)
   7   "(ecode-32-bit-register-address ea instruction) Handle the case in
   8 which our ea is just a register"
   9   (let*
  10       ((mod 3)
  11        (|r/m| (or (byte-register ea)
  12                   (dword-register ea)))
  13        (spare
  14         (get-mod-rm-field :spare
  15                           (zero-when-null
  16                            (get instruction :|mod-rm|)))))
  17          (setf (get instruction :|mod-r/m|)
  18                (make-mod-rm-byte mod |r/m| spare))))
  19
  20
  21 (defun encode-32-bit-memory-address (ea instruction)
  22   "(ecode-32-bit-register-address ea instruction) Handle the case in
  23 which our ea is not a register but some indirect formulation of
  24 base, index, scale, displacement etc.."
  25   (with-effective-address
  26       (size segment-reg base-reg scale index-reg
  27              displacement immediate)
  28               ea
  29        (flet
  30            ((displacement-only-p ()
  31               (and (not (zerop displacement))
  32                    (zerop scale)
  33                    (null index-reg)
  34                    (null base-reg)))
  35             (base-and-displacement-only-p ()
  36               (and (not (zerop displacement))
  37                    (not (null base-reg))
  38                    (null index-reg)
  39                    (zerop scale)))
  40             (encode-mod ()
  41               (cond
  42                 ((displacement-only-p) 0)
  43                 ((zerop displacement) 0)
  44                 ((is-byte displacement) 1)
  45                 ((is-dword displacement) 2)
  46                 (t
  47                  (error "Displacement ~X out of range"
  48                         displacement))))
  49             (encode-rm ()
  50               (cond
  51                 ((displacement-only-p) 5)
  52                 ((not (base-and-displacement-only-p)) 4)
  53                 (t (byte-register base-reg)
  54                    (dword-register base-reg)))))
  55        (let*
  56            ((mod (encode-mod))
  57             (|r/m| (encode-rm))
  58             (base
  59              (when (and (not (displacement-only-p))
  60                         (not (base-and-displacement-only-p)))
  61                (or (byte-register base-reg)
  62                    (dword-register base-reg))))
  63             (index
  64              (when (and (not (displacement-only-p))
  65                         (not (base-and-displacement-only-p)))
  66                (or (byte-register index-reg)
  67                    (dword-register index-reg))))
  68             (scale
  69              (case scale
  70                (0 nil)
  71                (1 0)
  72                (2 1)
  73                (4 2)
  74                (8 3))))
  75          ;; body of let
  76          (setf (get instruction :|mod-r/m|)
  77                (make-mod-rm-byte mod |r/m| 0))
  78          (setf (get instruction :sib)
  79                (make-sib-byte scale index base))
  80                instruction))))
  81
  82 (defun encode-16-bit-ea (instruction)
  83   (declare (ignore instruction))
  84   (error "Cannot handle 16 bit addressing yet"))
  85
  86 ;; to do -- what about 16 bits and segment displacement and word sizes?
  87 (defun encode-effective-address (operand instruction)
  88   (ccase *current-bits-size*
  89     ;; In 32-bit addressing mode ..
  90     ;; (either BITS 16 with a 67 prefix, or BITS 32 with no 67 prefix)
  91     ;; the general rules (again, there are exceptions) for mod and r/m are:
  92     (32
  93      (cond
  94        ((or (byte-register operand)
  95              (dword-register operand))
  96         (encode-32-bit-register-address operand instruction))
  97        ((word-register operand)
  98         (error "Can't handle word registers in 32 bit mode yet"))
  99        (t
 100         (progn
 101           (assert (listp operand))
 102           (encode-32-bit-memory-address operand instruction)))))
 103     ;; to be done..
 104     (16 (encode-16-bit-ea instruction))))
 105
 106 ;; -- encoding method lookup table ---------------------------------------------------
 107
 108 (defparameter *opcode-encodings* '(:|rw/rd| :|rb| :|ow/od| :OF :/2 :|+cc|
 109                                   :/7 :/3 :/1 :/4 :/5 :/0 :|+r| :/6 :|ib|
 110                                   :|iw| :|o16| :|id| :|o32| :|/r|))
 111
 112 (defparameter *opcode-encoder-table* (make-hash-table))
 113
 114 (defun def-opcode-encoder (encoding function)
 115   (assert (member encoding *opcode-encodings*))
 116   (setf (gethash encoding *opcode-encoder-table*) function))
 117
 118 (defun find-operand-index (types valid-types)
 119   "(find-operand-types types valid-types) types is a list of
 120 operand types in operand order, and valid-types is a list of
 121 operand types allowed for a given encoding. Returns the index of
 122 the operand we need to encode."
 123   (loop
 124      for operand-index = 0 then (1+ operand-index)
 125      for operand-type in types
 126      thereis (and (member operand-type valid-types)
 127                   operand-index)))
 128
 129 ;; :|+r| - one of the operands is a register and the register value
 130 ;; should be added to the appropiate opcode to produce the byte
 131 (defun register-opcode-encoder (insn-name operands types encoding instruction)
 132   "(register-opcode-endoder isnn-name operands types ecoding instruction) Handles
 133 the effect of a :|+r| encoding on an instruction."
 134   (declare (ignore insn-name))
 135   (assert (eql (first (last encoding)) :|+r|))
 136   (flet ((add-register-value-to-opcodes (opcodes reg-value)
 137            (append
 138             (subseq opcodes 0 (1- (length opcodes)))
 139             (list (+ reg-value (nth (1- (length opcodes)) opcodes))))))
 140     (let* ((register-types '(:|reg32| :|reg16| :|reg8|))
 141            (operand-index (find-operand-index types register-types))
 142            (register-value (or (byte-register (nth operand-index operands))
 143                              (word-register (nth operand-index operands))
 144                              (dword-register (nth operand-index operands))))
 145            (opcodes (get instruction :opcodes)))
 146       (when (null operand-index)
 147         (error  "Unable to identify operand to encode among ~A " operands))
 148       (setf (get instruction :opcodes)
 149             (add-register-value-to-opcodes opcodes register-value)))))
 150
 151 ;; :|+cc| condition code should be added to opcode byte - placeholder
 152 ;; that does nothing as this was expanded manually in our instruction table
 153 (defun condition-code-opcode-encoder (insn-name operands types encoding instruction)
 154   (declare (ignore insn-name operands types encoding))
 155  instruction)
 156
 157 (defmacro def-slash-opcode-encoder (n &key name)
 158   `(defun ,name (insn-name operands types encoding instruction)
 159      (declare (ignore insn-name encoding))
 160      (let* ((ea-types
 161              '(:|mm| :|m80| :|m8| :|mem80| :|mem64| :|mem32| :|mem16| :|mem8|
 162                :|mem| :|r/m8| :|r/m16| :|r/m32| :|xmm2/m128|))
 163             (operand-index (find-operand-index types ea-types))
 164             (mod-rm (zero-when-null (get instruction :|mod-r/m|))))
 165        (when (not (numberp operand-index))
 166          (error
 167           "Unable to identify operand to encode among ~A " operands))
 168        (encode-effective-address (nth operand-index operands) instruction)
 169        (setf (get instruction :|mod-r/m|)
 170                   (make-mod-rm-byte
 171                    (get-mod-rm-field :mod mod-rm)
 172                    ,n
 173                    (get-mod-rm-field :|r/m| mod-rm))))))
 174
 175 (def-slash-opcode-encoder 0 :name slash-zero-opcode-encoder)
 176 (def-slash-opcode-encoder 1 :name slash-one-opcode-encoder)
 177 (def-slash-opcode-encoder 2 :name slash-two-opcode-encoder)
 178 (def-slash-opcode-encoder 3 :name slash-three-opcode-encoder)
 179 (def-slash-opcode-encoder 4 :name slash-four-opcode-encoder)
 180 (def-slash-opcode-encoder 5 :name slash-five-opcode-encoder)
 181 (def-slash-opcode-encoder 6 :name slash-six-opcode-encoder)
 182 (def-slash-opcode-encoder 7 :name slash-seven-opcode-encoder)
 183
 184 (defun slash-r-opcode-encoder (insn-name operands types encoding instruction)
 185   (declare (ignore insn-name encoding))
 186   (let* ((register-types
 187           '(:|xmm1| :|mm1| :|reg32| :|reg16| :|reg8| :|mmxreg| :|xmm| :|mm|))
 188          (ea-types
 189           '(:|mm| :|m80| :|m8| :|mem80| :|mem64| :|mem32| :|mem16| :|mem8|
 190             :|mem| :|r/m8| :|r/m16| :|r/m32| :|xmm2/m128|))
 191          (register-operand-index
 192            (find-operand-index types register-types))
 193          (ea-operand-index
 194           (find-operand-index types ea-types))
 195          (register-value
 196           (or (byte-register
 197                (nth register-operand-index operands))
 198               (dword-register
 199                (nth register-operand-index operands))))
 200          (mod-rm (zero-when-null (get instruction :|mod-r/m|))))
 201     (when (not (and (numberp register-operand-index) (numberp ea-operand-index)))
 202       (error
 203            "Unable to identify operand to encode among ~A " operands))
 204     (when (not (numberp register-value))
 205         (error
 206          "Unable to encode register ~A " (nth register-operand-index operands)))
 207     (encode-effective-address (nth ea-operand-index operands) instruction)
 208     (setf (get instruction :|mod-r/m|)
 209                (make-mod-rm-byte
 210                 (get-mod-rm-field :mod mod-rm)
 211                 register-value
 212                 (get-mod-rm-field :|r/m| mod-rm)))))
 213
 214 (defun o32-opcode-encoder (insn-name operands
 215                            types encoding instruction)
 216   (declare (ignore insn-name operands types))
 217   (when (member :|o32| encoding)
 218      (when (= *current-bits-size* 16)
 219        (setf (get instruction :prefix)
 220              (list +OPERAND-SIZE-OVERRIDE-PREFIX+)))))
 221
 222 (defun o16-opcode-encoder (insn-name operands
 223                            types encoding instruction)
 224   (declare (ignore insn-name operands types))
 225   (when (member :|o16| encoding)
 226     (when (= *current-bits-size* 32)
 227       (setf (get instruction :prefix)
 228             (list +OPERAND-SIZE-OVERRIDE-PREFIX+)))))
 229
 230 ;; to do -- must understand symbols
 231 (defun ib-opcode-encoder (insn-name operands
 232                           types encoding instruction)
 233   (declare (ignore insn-name type encoding))
 234   (let ((operand-index (find-operand-index types '(:|imm8|))))
 235     (assert (not (null operand-index)))
 236     (setf (get instruction :immediate-data)
 237                (decompose-to-n-bytes
 238                 (nth operand-index operands) 1))))
 239
 240 ;; to do -- must understand symbols
 241 (defun iw-opcode-encoder (insn-name operands
 242                           types encoding instruction)
 243   (declare (ignore insn-name type encoding))
 244   (let ((operand-index
 245          (find-operand-index  types '(:|imm16|))))
 246     (assert (not (null operand-index)))
 247     (setf (get instruction :immediate-data)
 248                (decompose-to-n-bytes
 249                 (nth operand-index operands) 2))))
 250
 251 ;; to do -- must understand symbols
 252 (defun id-opcode-encoder (insn-name operands
 253                           types encoding instruction)
 254   (declare (ignore insn-name type encoding))
 255   (let ((operand-index
 256          (find-operand-index types '(:|imm32|))))
 257     (assert (not (null operand-index)))
 258     (setf (get instruction :immediate-data)
 259           (decompose-to-n-bytes
 260            (nth operand-index operands) 4))))
 261
 262 ;; to do
 263
 264 ;; # The codes rb, rw and rd indicate that one of the operands
 265 ;; to the instruction is an immediate value, and that the difference
 266 ;; between this value and the address of the end of the instruction is
 267 ;; to be encoded as a byte, word or doubleword respectively. Where the
 268 ;; form rw/rd appears, it indicates that either rw or rd should be
 269 ;; used according to whether assembly is being performed in BITS 16 or
 270 ;; BITS 32 state respectively.
 271
 272 ;; # The codes ow and od indicate that one of the operands to the
 273 ;; # instruction is a reference to the contents of a memory address
 274 ;; # specified as an immediate value: this encoding is used in some
 275 ;; # forms of the MOV instruction in place of the standard
 276 ;; # effective-address mechanism. The displacement is encoded as a
 277 ;; # word or doubleword. Again, ow/od denotes that ow or od should be
 278 ;; # chosen according to the BITS setting.
 279
 280 ;; # The codes o16 and o32 indicate that the given form of the
 281 ;; # instruction should be assembled with operand size 16 or 32
 282 ;; # bits. In other words, o16 indicates a 66 prefix in BITS 32 state,
 283 ;; # but generates no code in BITS 16 state; and o32 indicates a 66
 284 ;; # prefix in BITS 16 state but generates nothing in BITS 32.
 285
 286 ;; # The codes a16 and a32, similarly to o16 and o32, indicate the
 287 ;; # address size of the given form of the instruction. Where this
 288 ;; # does not match the BITS setting, a 67 prefix is required.
 289
 290 (def-opcode-encoder :|+r| #'register-opcode-encoder)
 291 (def-opcode-encoder :|+cc| #'condition-code-opcode-encoder)
 292 (def-opcode-encoder :/0 #'slash-zero-opcode-encoder)
 293 (def-opcode-encoder :/1 #'slash-one-opcode-encoder)
 294 (def-opcode-encoder :/2 #'slash-two-opcode-encoder)
 295 (def-opcode-encoder :/3 #'slash-three-opcode-encoder)
 296 (def-opcode-encoder :/4 #'slash-four-opcode-encoder)
 297 (def-opcode-encoder :/5 #'slash-five-opcode-encoder)
 298 (def-opcode-encoder :/6 #'slash-six-opcode-encoder)
 299 (def-opcode-encoder :/7 #'slash-seven-opcode-encoder)
 300 (def-opcode-encoder :|/r| #'slash-r-opcode-encoder)
 301 (def-opcode-encoder :|ib| #'ib-opcode-encoder)
 302 (def-opcode-encoder :|iw| #'iw-opcode-encoder)
 303 (def-opcode-encoder :|id| #'id-opcode-encoder)
 304 (def-opcode-encoder :|o32| #'o32-opcode-encoder)
 305 (def-opcode-encoder :|o16| #'o16-opcode-encoder)