syntax.lisp

   1
   2
   3
   4  ;; Lisp assembler syntax
   5
   6 ;; (MOV :EAX #0XFF)                                             ;; immediate
   7 ;; (MOV :EAX :EBX)                                                      ;; register
   8 ;; (MOV :EAX (:dword #X0FFF))                                   ;; direct
   9 ;; (MOX :EAX (:dword (+ :ES #X0FFF)))                           ;; direct based
  10 ;; (MOV :EAX (:dword (+ :ES (+ :EBX (* 2 :ESI) #0XFF)))         ;; indirect based scaled index offset
  11
  12
  13 ;; diss
  14 ;; (cond
  15 ;;   ((= mod 0)
  16 ;;    (cond
  17 ;;      ;; special cases
  18 ;;      ((= rm 5) (displacement 4))
  19 ;;      ((= rm 4)
  20 ;;       (let ((index (decode-register (extract-index sib)))
  21 ;;          (dislpacement 4)))
  22 ;;       (t (displacement 0)))))
  23 ;;   ((= mod 1)
  24 ;;    (displacement 1))
  25 ;;   ((= mod 2)
  26 ;;    (displacement 4))
  27 ;;   ((not (= r/m 4)
  28 ;;      (register (decode-register r/m))))
  29 ;;   ((= r/m 4) ;; sib is present
  30 ;;    (let
  31 ;;        ((base-reigster (decode-register (extract-base sib)))
  32 ;;      (index-register
  33 ;;        (if (not (= (extract-index sib) 4))
  34 ;;            (decode-register (extract-index sib))))
  35 ;;      (scale (nth '(1 2 4 8) (extract-scale sib)))))))
  36
  37 (in-package :cl-x86-asm)
  38
  39 ;;; ------- opcode and address decoding related things -----------------------------
  40
  41 (defparameter *operand-sizes* '(:dword :word :byte))
  42
  43 (defparameter *opcode-encodings* '(:|rw/rd| :|rb| :|ow/od| :OF :/2 :|+cc|
  44                                   :/7 :/3 :/1 :/4 :/5 :/0 :|+r| :/6 :|ib|
  45                                   :|iw| :|o16| :|id| :|o32| :|/r|))
  46
  47 (defparameter *operand-types* '(:|mm/mem64| :|xmm/mem128|
  48                                 :|xmm/mem64| :|xmm/mem32|
  49                                 :|xmm2/mem64| :|mem80| :|mem16|
  50                                 :|fpureg| :ST0 :|memory|
  51                                 :|imm:imm16| :|imm:imm32|
  52                                 :|mem32| :CX :ECX
  53                                 :|imm| :|memoffs8|
  54                                 :|memoffs16| :|memoffs32|
  55                                 :CR0/2/3/4 :DR0/1/2/3/6/7
  56                                 :TR3/4/5/6/7 :|xmm1/m128|
  57                                 :|m128| :|mm2| :|mm1/m64|
  58                                 :|xmm2/m64| :|xmm1/m64|
  59                                 :|xmm2/m32| :|xmm1/m32|
  60                                 :|xmm2| :|xmm1/mem128|
  61                                 :|xmm2/mem128| :|xmm2/mem32|
  62                                 :DX :|r/m64|
  63                                 :|r16/r32/m16| :|m64| :|mem64|
  64                                 :|mmxreg|
  65                                 :|mem8| :|m8| :|mm|
  66                                 :|xmm| :|mm2/m32| :CS
  67                                 :DS :ES :SS :FS :GS
  68                                 :|mm2/m64| :|mm1| :|mem|
  69                                 :|1| :CL :|m32| :|segreg|
  70                                 :|m80| :|reg8|
  71                                 :|reg16| :|reg32| :|r/m8|
  72                                 :|r/m16| :|r/m32|
  73                                 :|imm8| :AL :|imm16| :AX
  74                                 :|imm32| :EAX
  75                                 :|xmm2/m128| :|xmm1| :|none|))
  76
  77 (defconstant +LOCK-PREFIX+ #XF0)
  78 (defconstant +REPNE/REPNZ-PREFIX+ #XF2)
  79 (defconstant +REP-PREFIX+ #XF3)
  80 (defconstant +REPE/REPZ-PREFIX #XF3)
  81
  82 (defconstant +CS-SEGMENT-OVERRIDE-PREFIX+ #X2E)
  83 (defconstant +SS-SEGMENT-OVERRIDE-PREFIX  #X36)
  84 (defconstant +DS-SEGMENT-OVERRIDE-PREFIX  #X3E)
  85 (defconstant +ES-SEGMENT-OVERRIDE-PREFIX  #X26)
  86 (defconstant +FS-SEGMENT-OVERRIDE-PREFIX  #X64)
  87 (defconstant +GS-SEGMENT-OVERRIDE-PREFIX  #X65)
  88
  89 (defconstant +OPERAND-SIZE-OVERRIDE-PREFIX+ #X66)
  90 (defconstant +ADDRESS-SIZE-OVERRIDE-PREFIX+ #X67)
  91
  92 (defparameter *registers-32* (list :eax :ecx :edx :ebx :esp :ebp :esi :edi))
  93 (defparameter *registers-16* (list :ax  :cx :dx  :bx  :sp  :bi  :si  :di))
  94 (defparameter *registers-8* (list :al :cl :dl :bl :ah :ch :dh :bh))
  95 (defparameter *registers-mmx* (list :mm0 :mm1 :mm2 :mm3 :mm4 :mm5 :mm6 :mm7))
  96 (defparameter *registers-xmm* (list :xmm0 :xmm1 :xmm2 :xmm3 :xmm4 :xmm5 :xmm6 :xmm7))
  97
  98 (defparameter *registers-segment*
  99   (list :es :cs :ss :ds :fs :gs))
 100
 101 (defparameter *registers-fp*
 102   (list :st0 :st1 :st2 :st3 :st4 :st5 :st6 :st7))
 103
 104 (defparameter *registers-control*
 105   (list :cr0 :invalid :cr2 :cr3 :cr4))
 106
 107 (defparameter *registers-debug*
 108   (list :dr0 :dr1 :dr2 :dr3 :invalid :invalid :dr6 :dr7))
 109
 110 (defparameter *registers-test*
 111   (list :invalid :invalid :invalid :tr3 :tr4 :tr5 :tr6 :tr7))
 112
 113
 114 ;; 1 byte
 115 (defun byte-p (x) (and (numberp x)
 116                           (>= x  #X-7F)
 117                           (< x   #X100)))
 118
 119 ;; 2 bytes (16 bit)
 120 (defun word-p (x) (and (numberp x)
 121                           (>= x #X-7FFF)
 122                           (< x  #X10000)))
 123
 124 ;; 4 bytes (32 bit) == 1 float
 125 (defun dword-p (x) (and (numberp x)
 126                            (>= x #X-7FFFFFF)
 127                            (< x  #X100000000)))
 128
 129 ;; 8 bytes (64 bit) == 2 floats
 130 (defun qword-p (x) (and (numberp x)
 131                            (>= x #X-7FFFFFFFFFFFFFFF)
 132                            (< x  #X10000000000000000)))
 133
 134 ;; 16 bytes (128 bit) == 4 floats
 135 (defun oword-p (x) (and (numberp x)
 136                            (>= x #X-7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
 137                            (< x  #X100000000000000000000000000000000)))
 138
 139 (defun byte-register (x) (position x *registers-8*))
 140
 141 (defun word-register (x) (position x *registers-16*))
 142
 143 (defun fpu-register (x) (position x *registers-fp*))
 144
 145 (defun mmx-register (x) (position x *registers-mmx*))
 146
 147 (defun xmm-register (x) (position x *registers-xmm*))
 148
 149 (defun dword-register (x) (position x *registers-32*))
 150
 151 (defun segment-register (x) (position x *registers-segment*))
 152
 153 (defun control-register (x) (position x *registers-control*))
 154
 155 (defun debug-register (x) (position x *registers-debug*))
 156
 157 (defun test-register (x) (position x *registers-test*))
 158
 159
 160 (defparameter *operand-type-checkers*
 161   (list
 162    (cons :|mm/mem64|
 163          (list (function (lambda (opcode)
 164                  (eq :|mm/mem64| opcode)))))
 165    (cons :|xmm/mem128|
 166          (list (function (lambda (opcode)
 167                  (eq :|xmm/mem128| opcode)))))
 168    (cons :|xmm/mem64|
 169          (list (function (lambda (opcode)
 170                  (eq :|xmm/mem64| opcode)))))
 171    (cons :|xmm/mem32|
 172          (list (function (lambda (opcode)
 173                  (eq :|xmm/mem32| opcode)))))
 174    (cons :|xmm2/mem64|
 175          (list (function (lambda (opcode)
 176                  (eq :|xmm2/mem64| opcode)))))
 177    (cons :|mem80|
 178          (list (function
 179                 (lambda (opcode) (eq :|mem80| opcode)))))
 180    (cons :|mem16|
 181          (list (function
 182                 (lambda (opcode) (eq :|mem16| opcode)))))
 183    (cons :|fpureg|
 184          (list (function
 185                 (lambda (opcode) (fpu-register opcode)))))
 186    (cons :ST0
 187          (list (function
 188                 (lambda (opcode) (eq :ST0 opcode)))))
 189    (cons :|memory|
 190          (list (function
 191                 (lambda (opcode) (eq :|memory| opcode)))))
 192    (cons :|imm:imm16|
 193          (list (function
 194                 (lambda (opcode) (eq :|imm:imm16| opcode)))))
 195    (cons :|imm:imm32|
 196          (list (function
 197                 (lambda (opcode) (eq :|imm:imm32| opcode)))))
 198    (cons :|mem32|
 199          (list (function
 200                 (lambda (opcode) (eq :|mem32| opcode)))))
 201    (cons :CX
 202          (list (function
 203                 (lambda (opcode) (eq :CX opcode)))))
 204    (cons :ECX
 205          (list (function
 206                 (lambda (opcode) (eq :ECX opcode)))))
 207    (cons :|imm|
 208          (list (function
 209                 (lambda (opcode) (numberp opcode)))))
 210    (cons :|memoffs8|
 211          (list (function
 212                 (lambda (opcode) (eq :|memoffs8| opcode)))))
 213    (cons :|memoffs16|
 214          (list (function
 215                 (lambda (opcode) (eq :|memoffs16| opcode)))))
 216    (cons :|memoffs32|
 217          (list (function
 218                 (lambda (opcode) (eq :|memoffs32| opcode)))))
 219    (cons :CR0/2/3/4
 220          (list (function
 221                 (lambda (opcode) (control-register opcode)))))
 222    (cons :DR0/1/2/3/6/7
 223          (list (function
 224                 (lambda (opcode) (debug-register opcode)))))
 225    (cons :TR3/4/5/6/7
 226          (list (function
 227                 (lambda (opcode) (test-register opcode)))))
 228    (cons :|xmm1/m128|
 229          (list (function
 230                 (lambda (opcode) (eq :|xmm1/m128| opcode)))))
 231    (cons :|m128|
 232          (list (function
 233                 (lambda (opcode) (eq :|m128| opcode)))))
 234    (cons :|mm2|
 235          (list
 236           (function
 237            (lambda (opcode) (eq :|mm2| opcode)))))
 238    (cons :|mm1/m64|
 239          (list
 240           (function
 241            (lambda (opcode) (eq :|mm1/m64| opcode)))))
 242    (cons :|xmm2/m64|
 243          (list
 244           (function
 245            (lambda (opcode) (eq :|xmm2/m64| opcode)))))
 246    (cons :|xmm1/m64|
 247          (list
 248           (function
 249            (lambda (opcode) (eq :|xmm1/m64| opcode)))))
 250    (cons :|xmm2/m32|
 251          (list
 252           (function
 253            (lambda (opcode) (eq :|xmm2/m32| opcode)))))
 254    (cons :|xmm1/m32|
 255          (list
 256           (function
 257            (lambda (opcode) (eq :|xmm1/m32| opcode)))))
 258    (cons :|xmm2|
 259          (list
 260           (function
 261            (lambda (opcode) (eq :|xmm2| opcode)))))
 262    (cons :|xmm1/mem128|
 263          (list
 264           (function
 265            (lambda (opcode) (eq :|xmm1/mem128| opcode)))))
 266    (cons :|xmm2/mem128|
 267          (list
 268           (function
 269            (lambda (opcode) (eq :|xmm2/mem128| opcode)))))
 270    (cons :|xmm2/mem32|
 271          (list
 272           (function
 273            (lambda (opcode) (eq :|xmm2/mem32| opcode)))))
 274    (cons :DX
 275          (list
 276           (function
 277            (lambda (opcode) (eq :DX opcode)))))
 278    (cons :|r/m64|
 279          (list
 280           (function
 281            (lambda (opcode) (eq :|r/m64| opcode)))))
 282    (cons :|r16/r32/m16|
 283          (list
 284           (function (lambda (opcode) (eq :|r16/r32/m16| opcode)))))
 285    (cons :|m64|
 286          (list (function (lambda (opcode) (eq :|m64| opcode)))))
 287    (cons :|mem64|
 288          (list (function (lambda (opcode) (eq :|mem64| opcode)))))
 289    (cons :|mmxreg|
 290          (list (function (lambda (opcode) (mmx-register opcode)))))
 291    (cons :|mem8|
 292          (list (function (lambda (opcode) (eq :|mem8| opcode)))))
 293    (cons :|m8|
 294          (list (function (lambda (opcode) (eq :|m8| opcode)))))
 295    (cons :|mm|
 296          (list (function (lambda (opcode) (eq :|mm| opcode)))))
 297    (cons :|xmm|
 298          (list (function (lambda (opcode) (eq :|xmm| opcode)))))
 299    (cons :|mm2/m32|
 300          (list
 301           (function
 302            (lambda (opcode) (eq :|mm2/m32| opcode)))))
 303    (cons :CS
 304          (list
 305           (function
 306            (lambda (opcode) (eq :CS opcode)))))
 307    (cons :DS
 308          (list
 309           (function
 310            (lambda (opcode) (eq :DS opcode)))))
 311    (cons :ES
 312          (list
 313           (function
 314            (lambda (opcode) (eq :ES opcode)))))
 315    (cons :SS
 316          (list
 317           (function
 318            (lambda (opcode) (eq :SS opcode)))))
 319    (cons :FS
 320          (list
 321           (function
 322            (lambda (opcode) (eq :FS opcode)))))
 323    (cons :GS
 324          (list
 325           (function
 326            (lambda (opcode) (eq :GS opcode)))))
 327    (cons :|mm2/m64|
 328          (list
 329           (function
 330            (lambda (opcode) (eq :|mm2/m64| opcode)))))
 331    (cons :|mm1|
 332          (list
 333           (function
 334            (lambda (opcode) (eq :|mm1| opcode)))))
 335    (cons :|mem|
 336          (list
 337           (function
 338            (lambda (opcode) (eq :|mem| opcode)))))
 339    (cons :|1|
 340          (list
 341           (function
 342            (lambda (opcode) (eq :|1| opcode)))))
 343    (cons :CL
 344          (list
 345           (function
 346            (lambda (opcode) (eq :CL opcode)))))
 347    (cons :|m32|
 348          (list
 349           (function
 350            (lambda (opcode) (eq :|m32| opcode)))))
 351    (cons :|segreg|
 352          (list
 353           (function
 354            (lambda (opcode) (segment-register opcode)))))
 355    (cons :|m80|
 356          (list
 357           (function
 358            (lambda (opcode) (eq :|m80| opcode)))))
 359    (cons :|reg8|
 360          (list
 361           (function
 362            (lambda (opcode) (byte-register opcode)))))
 363    (cons :|reg16|
 364          (list
 365           (function
 366            (lambda (opcode) (word-register opcode)))))
 367    (cons :|reg32|
 368          (list
 369           (function
 370            (lambda (opcode) (dword-register opcode)))))
 371    (cons :|r/m8|
 372          (list
 373           (function
 374            (lambda (opcode)
 375             (or
 376              (byte-register opcode)
 377              (and (listp opcode)
 378                   (= (length opcode) 1)
 379                   (byte-register (first opcode)))
 380              (and (listp opcode)
 381                   (eq (first opcode) :byte)))))))
 382    (cons :|r/m16|
 383          (list
 384           (function
 385            (lambda (opcode)
 386             (or (word-register opcode)
 387                 (and (listp opcode)
 388                      (= (length opcode) 1)
 389                      (dword-register (first opcode)))
 390                 (and (listp opcode)
 391                      (eq (first opcode) :word)))))))
 392    (cons :|r/m32|
 393          (list
 394           (function
 395            (lambda (opcode)
 396             (or (dword-register opcode)
 397                 (and (listp opcode)
 398                      (= (length opcode) 1)
 399                      (dword-register (first opcode)))
 400                 (and (listp opcode)
 401                      (eq (first opcode) :dword)))))))
 402    (cons :|imm8|
 403          (list
 404           (function
 405            (lambda (opcode) (byte-p opcode)))))
 406    (cons :AL
 407          (list
 408           (function
 409            (lambda (opcode) (eq :AL opcode)))))
 410    (cons :|imm16|
 411          (list
 412           (function
 413            (lambda (opcode) (word-p opcode)))))
 414    (cons :AX
 415          (list
 416           (function
 417            (lambda (opcode) (eq :AX opcode)))))
 418    (cons :|imm32|
 419          (list
 420           (function
 421            (lambda (opcode) (dword-p opcode)))))
 422    (cons :EAX
 423          (list
 424           (function (lambda (opcode) (eq :EAX opcode)))))
 425    (cons :|xmm2/m128|
 426          (list
 427           (function
 428            (lambda (opcode) (eq :|xmm2/m128| opcode)))))
 429    (cons :|xmm1|
 430          (list
 431           (function
 432            (lambda (opcode) (eq :|xmm1| opcode)))))
 433    (cons :|none|
 434          (list
 435           (function
 436            (lambda (opcode) (eq nil opcode)))))))
 437
 438
 439 ;; our test effective address
 440 (defparameter *test-ea*
 441   '(:dword :ES (+ :EBX (* 2 :ESI) #XFF) #XFFFF))
 442
 443
 444 (defun find-size (effective-address)
 445   "(find-size ea) Identify the size of the thing addressed
 446 by the ea"
 447   (loop
 448      for element in effective-address
 449      thereis (and (not (listp element) )
 450                   (first (member element *operand-sizes*)))))
 451
 452
 453
 454 (defun find-segreg (effective-address)
 455   "(find-segreg ea) Given an effective address, find
 456 the segment register used to offset it"
 457   (loop
 458      for element in effective-address
 459      thereis (and (not (listp element))
 460                    (first
 461                     (member element *registers-segment*)))))
 462
 463 ;;
 464 ;; TO DO -- this needs to handle symbols
 465 ;;
 466 (defun find-numeric (effective-address)
 467   "(find-numeric ea) Given an effective adress component
 468 find the numeric portion of it"
 469   (loop
 470      for element in effective-address
 471       thereis (and
 472                (numberp element)
 473                element)))
 474
 475 (defun find-base-list (effective-address)
 476   "(find-base-list  ea) Given an effective address find
 477 the portion with the base register offset"
 478   (loop
 479      for element in effective-address
 480         thereis (and (listp element)
 481                      (eq (first element) '+)
 482                      element)))
 483
 484
 485
 486 (defun find-index-list (effective-address)
 487   "(find-index-list ea) - given an effective address,
 488 find the list which contains the indexing portion"
 489   (flet ((find-index-list-aux (candidate-list)
 490            (loop
 491               for element in candidate-list
 492               thereis (or (and (listp element)
 493                                (eq (first element) '*)
 494                                element)))))
 495     (or (find-index-list-aux effective-address)
 496         (find-index-list-aux
 497          (find-base-list effective-address)))))
 498
 499
 500
 501 (defun find-reg (base-list)
 502   "(find-reg base-list) - given a component of an
 503 effective address, find the register within it"
 504   (loop
 505      for element in base-list
 506      thereis (and (not (listp element))
 507                   (first (member element
 508                                  (append *registers-32*
 509                                          *registers-16*
 510                                          *registers-8*))))))
 511
 512
 513
 514 (defmacro with-effective-address  (symbols ea &body forms)
 515   "(with-effective-address ((size-sym segment-register-sym
 516                                              base-register-sym
 517                                              scale-sym
 518                                              index-register-sym
 519                                              displacement-sym
 520                                              immediate-sym)
 521                                              operand &body forms)
 522   Pick apart an  effective address of  the  form
 523     (:dword :ES (+ :EBX (*  2 :ESI) #0XFF))
 524   and assign components to  the correct  symbols in the body"
 525   (let ((ea-sym (gensym)))
 526     (destructuring-bind
 527            (size-sym segreg-sym basereg-sym
 528                       scale-sym indexreg-sym
 529                       displacement-sym immediate-sym)
 530          symbols
 531       `(declare (ignorable ,size-sym ,segreg-sym ,basereg-sym
 532                       ,scale-sym ,indexreg-sym
 533                       ,displacement-sym ,immediate-sym))
 534       `(let ((,ea-sym ,ea))
 535          (assert (listp ,ea-sym))
 536          (let*
 537              ((,size-sym (find-size ,ea-sym))
 538               (,segreg-sym (find-segreg ,ea-sym))
 539               (,immediate-sym (find-numeric ,ea-sym))
 540               (,basereg-sym (find-reg (find-base-list ,ea-sym)))
 541               (,displacement-sym (find-numeric (find-base-list ,ea-sym)))
 542               (,indexreg-sym (find-reg (find-index-list ,ea-sym)))
 543               (,scale-sym (find-numeric (find-index-list ,ea-sym))))
 544            ,@forms)))))
 545
 546
 547
 548 ;; test case
 549 ;;(with-effective-address (size seg-reg base-reg scale index-reg displacement immediate) *test-ea*
 550 ;;                       (format *debug-io* "Size ~A seg-reg ~A base-reg ~A scale ~A index-reg ~A displacement ~A immediate ~A "
 551 ;;                               size seg-reg base-reg scale index-reg displacement immediate))
 552
 553
 554
 555
 556
 557
 558
 559