module/mescc/x86_64/as.scm

   1 ;;; GNU Mes --- Maxwell Equations of Software
   2 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Mes.
   5 ;;;
   6 ;;; GNU Mes is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Mes is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 ;;; Commentary:
  20
  21 ;;; Define x86_64 M1 assembly
  22
  23 ;;; Code:
  24
  25 (define-module (mescc x86_64 as)
  26   #:use-module (mes guile)
  27   #:use-module (mescc as)
  28   #:use-module (mescc info)
  29   #:use-module (mescc x86_64 info)
  30   #:export (
  31             x86_64:instructions
  32             ))
  33
  34 (define (r->e o)
  35   (string-append "e" (string-drop o 1)))
  36 (define (r->x o)
  37   (string-drop o 1))
  38 (define (r->l o)
  39   (assoc-ref
  40    '(("rax" . "al")
  41      ("rdi" . "dil")
  42      ("rsi" . "sil")
  43      ("rdx" . "dl")
  44      ("rcx" . "cl")
  45      ("r8" . "r8b")
  46      ("r9" . "r9b"))
  47    o))
  48
  49 ;; AMD
  50 (define (x86_64:function-preamble info . rest)
  51   (format (current-error-port) "rest=~s\n" rest)
  52   `(("push___%rbp")
  53     ("mov____%rsp,%rbp")
  54     ("sub____$i32,%rbp" "%0x80")
  55     ,@(list-head
  56        '(("mov____%rdi,0x8(%rbp)" "!0x10")
  57          ("mov____%rsi,0x8(%rbp)" "!0x18")
  58          ("mov____%rdx,0x8(%rbp)" "!0x20")
  59          ("mov____%rcx,0x8(%rbp)" "!0x28")
  60          ("mov____%r8,0x8(%rbp)" "!0x30")
  61          ("mov____%r9,0x8(%rbp)" "!0x38"))
  62        (length (car rest)))))
  63
  64 ;; traditional
  65 (define (x86_64:function-preamble info . rest)
  66   (format (current-error-port) "rest=~s\n" rest)
  67   `(("push___%rbp")
  68     ("mov____%rsp,%rbp")))
  69
  70 (define (x86_64:function-locals . rest)
  71   `(
  72     ;; FIXME: how on x86_64?
  73     ("sub____$i32,%rsp" (#:immediate ,(+ (* 4 1025) (* 20 8))))
  74     )) ; 4*1024 buf, 20 local vars
  75
  76 (define (x86_64:r->local info n)
  77   (let ((r (get-r info))
  78         (n (- 0 (* 8 n))))
  79     `(,(if (< (abs n) #x80)
  80            `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
  81            `(,(string-append "mov____%" r ",0x32(%rbp)") (#:immediate ,n))))))
  82
  83 (define (x86_64:value->r info v)
  84   (or v (error "invalid value: x86_64:value->r: " v))
  85   (let ((r (get-r info)))
  86     (if (and (>= v 0)
  87              (< v #xffffffff))
  88      `((,(string-append "mov____$i32,%" r) (#:immediate ,v)))
  89      `((,(string-append "mov____$i64,%" r) (#:immediate8 ,v))))))
  90
  91 ;; AMD
  92 (define (x86_64:ret . rest)
  93   '(("add____$i32,%rbp" "%0x80")
  94     ("mov____%rbp,%rsp")
  95     ("pop____%rbp")
  96     ("ret")))
  97
  98 ;; traditional
  99 (define (x86_64:ret . rest)
 100   '(("mov____%rbp,%rsp")
 101     ("pop____%rbp")
 102     ("ret")))
 103
 104 (define (x86_64:r-zero? info)
 105   (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
 106     `((,(string-append "test___%" r "," "%" r)))))
 107
 108 (define (x86_64:local->r info n)
 109   (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
 110         (n (- 0 (* 8 n))))
 111     `(,(if (< (abs n) #x80) `(,(string-append "mov____0x8(%rbp),%" r) (#:immediate1 ,n))
 112            `(,(string-append "mov____0x32(%rbp),%" r) (#:immediate ,n))))))
 113
 114 (define (x86_64:call-label info label n)
 115   `((call32 (#:offset ,label))
 116     ("add____$i8,%rsp" (#:immediate1 ,(* n 8)))  ;; NOT AMD
 117     ))
 118
 119 (define x86_64:calling-convention-registers '("rax" "rdi" "rsi" "rdx" "rcx" "r8" "r9"))
 120
 121 ;; AMD
 122 (define (x86_64:r->arg info i)
 123   (let ((r (get-r info))
 124         (r1 (list-ref x86_64:calling-convention-registers (1+ i))))
 125     `((,(string-append "mov____%" r ",%" r1))))) ; debug fail-safe check
 126
 127 (define (x86_64:label->arg info label i)
 128   (let ((r0 (list-ref x86_64:registers (1+ i))))
 129     (if (< (label v) #x80000000)
 130         `((,(string-append "mov____$i32,%" r0) (#:address ,label)))
 131         `((,(string-append "mov____$i64,%" r0) (#:address8 ,label))))))
 132
 133 ;; traditional
 134 (define (x86_64:r->arg info i)
 135   (let ((r (get-r info)))
 136     `((,(string-append "push___%" r)))))
 137
 138 (define (x86_64:label->arg info label i)
 139   `(("push___$i32" (#:address ,label))))
 140
 141 ;; FIXME?
 142 ;; (define (x86_64:label->arg info label i)
 143 ;;   `((,(string-append "mov____$i64,%r15") (#:address8 ,label))
 144 ;;     ("push___%r15" (#:address ,label))))
 145
 146 (define (x86_64:r0+r1 info)
 147   (let ((r1 (get-r1 info))
 148         (r0 (get-r0 info)))
 149     `((,(string-append "add____%" r1 ",%" r0)))))
 150
 151 (define (x86_64:r-negate info)
 152   (let* ((r (get-r info))
 153          (l (r->l r)))
 154     `((,(string-append "sete___%" l))
 155       (,(string-append "movzbq_%" l ",%" r)))))
 156
 157 (define (x86_64:r0-r1 info)
 158   (let ((r0 (get-r0 info))
 159         (r1 (get-r1 info)))
 160     `((,(string-append "sub____%" r1 ",%" r0)))))
 161
 162 (define (x86_64:zf->r info)
 163   (let* ((r (get-r info))
 164          (l (r->l r)))
 165     `((,(string-append "sete___%" l))
 166       (,(string-append "movzbq_%" l ",%" r)))))
 167
 168 (define (x86_64:xor-zf info)
 169   '(("lahf")
 170     ("xor____$i8,%ah" (#:immediate1 #x40))
 171     ("sahf")))
 172
 173 (define (x86_64:r->local+n info id n)
 174   (let ((n (+ (- 0 (* 8 id)) n))
 175         (r (get-r info)))
 176     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
 177            `(,(string-append "mov____%" r ",0x32(%rbp)") (#:immediate ,n))))))
 178
 179 (define (x86_64:r-mem-add info v)
 180   (let ((r (get-r info)))
 181     `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,(%" r ")") (#:immediate1 ,v))
 182            `(,(string-append "add____$i32,(%" r ")") (#:immediate ,v)))))) ;; FIXME 64bit
 183
 184 (define (x86_64:r-byte-mem-add info v)
 185   (let ((r (get-r info)))
 186     `((,(string-append "addb___$i8,(%" r ")") (#:immediate1 ,v)))))
 187
 188 (define (x86_64:r-word-mem-add info v)
 189   (let ((r (get-r info)))
 190     `((,(string-append "addw___$i8,(%" r ")") (#:immediate2 ,v)))))
 191
 192 (define (x86_64:local-ptr->r info n)
 193   (let ((r (get-r info)))
 194     (let ((n (- 0 (* 8 n))))
 195       `((,(string-append "mov____%rbp,%" r))
 196         ,(if (< (abs n) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,n))
 197              `(,(string-append "add____$i32,%" r)  (#:immediate ,n))))))) ;; FIXME 64bit
 198
 199 (define (x86_64:label->r info label)
 200   (let ((r (get-r info)))
 201     `((,(string-append "mov____$i64,%" r) (#:address8 ,label)))))
 202
 203 (define (x86_64:r0->r1 info)
 204   (let ((r0 (get-r0 info))
 205         (r1 (get-r1 info)))
 206     `((,(string-append  "mov____%" r0 ",%" r1)))))
 207
 208 (define (x86_64:byte-mem->r info)
 209   (let ((r (get-r info)))
 210     `((,(string-append "movzbq_(%" r "),%" r)))))
 211
 212 (define (x86_64:byte-r info)
 213   (let* ((r (get-r info))
 214          (l (r->l r)))
 215     `((,(string-append "movzbq_%" l ",%" r)))))
 216
 217 (define (x86_64:byte-signed-r info)
 218   (let* ((r (get-r info))
 219          (l (r->l r)))
 220     `((,(string-append "movsbq_%" l ",%" r)))))
 221
 222 (define (x86_64:word-r info)
 223   (let* ((r (get-r info))
 224          (x (r->x r)))
 225     `((,(string-append "movzwq_%" x ",%" r)))))
 226
 227 (define (x86_64:word-signed-r info)
 228   (let* ((r (get-r info))
 229          (x (r->x r)))
 230     `((,(string-append "movswq_%" x ",%" r)))))
 231
 232 (define (x86_64:long-r info)
 233   (let* ((r (get-r info))
 234          (e (r->e r)))
 235     `((,(string-append "movzlq_%" e ",%" r)))))
 236
 237 (define (x86_64:long-signed-r info)
 238   (let* ((r (get-r info))
 239          (e (r->e r)))
 240     `((,(string-append "movslq_%" e ",%" r)))))
 241
 242 (define (x86_64:jump info label)
 243   `(("jmp32 " (#:offset ,label))))
 244
 245 (define (x86_64:jump-nz info label)
 246   `(("jne32 " (#:offset ,label))))
 247
 248 (define (x86_64:jump-z info label)
 249   `(("je32  " (#:offset ,label))))
 250
 251 (define (x86_64:jump-byte-z info label)
 252   `(("test___%al,%al")
 253     ("je32  " (#:offset ,label))))
 254
 255 ;; signed
 256 (define (x86_64:jump-g info label)
 257   `(("jg32  " (#:offset ,label))))
 258
 259 (define (x86_64:jump-ge info  label)
 260   `(("jge32 " (#:offset ,label))))
 261
 262 (define (x86_64:jump-l info label)
 263   `(("jl32  " (#:offset ,label))))
 264
 265 (define (x86_64:jump-le info label)
 266   `(("jle32 " (#:offset ,label))))
 267
 268 ;; unsigned
 269 (define (x86_64:jump-a info label)
 270   `(("ja32  " (#:offset ,label))))
 271
 272 (define (x86_64:jump-ae info label)
 273   `(("jae32 " (#:offset ,label))))
 274
 275 (define (x86_64:jump-b info label)
 276   `(("jb32  " (#:offset ,label))))
 277
 278 (define (x86_64:jump-be info label)
 279   `(("jbe32 " (#:offset ,label))))
 280
 281 (define (x86_64:byte-r0->r1-mem info)
 282   (let* ((r0 (get-r0 info))
 283          (r1 (get-r1 info))
 284          (l0 (r->l r0)))
 285     `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
 286
 287 (define (x86_64:label-mem->r info label)
 288   (let ((r (get-r info)))
 289     `((,(string-append "mov____0x32,%" r) (#:address ,label)))))
 290
 291 (define (x86_64:word-mem->r info)
 292   (let ((r (get-r info)))
 293     `((,(string-append "movzwq_(%" r "),%" r)))))
 294
 295 (define (x86_64:long-mem->r info)
 296   (let ((r (get-r info)))
 297     `((,(string-append "movzlq_(%" r "),%" r)))))
 298
 299 (define (x86_64:mem->r info)
 300   (let ((r (get-r info)))
 301     `((,(string-append "mov____(%" r "),%" r)))))
 302
 303 (define (x86_64:local-add info n v)
 304   (let ((n (- 0 (* 8 n))))
 305     `(,(if (and (< (abs n) #x80)
 306                 (< (abs v) #x80)) `("add____$i8,0x8(%rbp)" (#:immediate1 ,n) (#:immediate1 ,v))
 307                 `("add____$i32,0x32(%rbp)" (#:immediate ,n) (#:immediate ,v)))))) ;; FIXME: 64b
 308
 309 (define (x86_64:label-mem-add info label v)
 310   `(,(if (< (abs v) #x80) `("add____$i8,0x32" (#:address ,label) (#:immediate1 ,v))
 311          `("add____$i32,0x32" (#:address ,label) (#:immediate ,v))))) ;; FIXME: 64b
 312
 313 (define (x86_64:nop info)
 314   '(("nop")))
 315
 316 (define (x86_64:swap-r0-r1 info)
 317   (let ((r0 (get-r0 info))
 318         (r1 (get-r1 info)))
 319     `((,(string-append "xchg___%" r0 ",%" r1)))))
 320
 321 ;; signed
 322 (define (x86_64:g?->r info)
 323   (let* ((r (get-r info))
 324          (l (r->l r)))
 325     `((,(string-append "setg___%" l))
 326       (,(string-append "movzbq_%" l ",%" r)))))
 327
 328 (define (x86_64:ge?->r info)
 329   (let* ((r (get-r info))
 330          (l (r->l r)))
 331     `((,(string-append "setge__%" l))
 332       (,(string-append "movzbq_%" l ",%" r)))))
 333
 334 (define (x86_64:l?->r info)
 335   (let* ((r (get-r info))
 336          (l (r->l r)))
 337     `((,(string-append "setl___%" l))
 338       (,(string-append "movzbq_%" l ",%" r)))))
 339
 340 (define (x86_64:le?->r info)
 341   (let* ((r (get-r info))
 342          (l (r->l r)))
 343     `((,(string-append "setle__%" l))
 344       (,(string-append "movzbq_%" l ",%" r)))))
 345
 346 ;; unsigned
 347 (define (x86_64:a?->r info)
 348   (let* ((r (get-r info))
 349          (l (r->l r)))
 350     `((,(string-append "seta___%" l))
 351       (,(string-append "movzbq_%" l ",%" r)))))
 352
 353 (define (x86_64:ae?->r info)
 354   (let* ((r (get-r info))
 355          (l (r->l r)))
 356     `((,(string-append "setae__%" l))
 357       (,(string-append "movzbq_%" l ",%" r)))))
 358
 359 (define (x86_64:b?->r info)
 360   (let* ((r (get-r info))
 361          (l (r->l r)))
 362     `((,(string-append "setb___%" l))
 363       (,(string-append "movzbq_%" l ",%" r)))))
 364
 365 (define (x86_64:be?->r info)
 366   (let* ((r (get-r info))
 367          (l (r->l r)))
 368     `((,(string-append "setbe__%" l))
 369       (,(string-append "movzbq_%" l ",%" r)))))
 370
 371 (define (x86_64:test-r info)
 372   (let ((r (get-r info)))
 373     `((,(string-append "test___%" r ",%" r)))))
 374
 375 (define (x86_64:r->label info label)
 376   (let ((r (get-r info)))
 377     `((,(string-append "mov____%" r ",0x32") (#:address ,label))))) ;; FIXME: 64 bits
 378
 379 (define (x86_64:r->byte-label info label)
 380   (let* ((r (get-r info))
 381          (l (r->l r)))
 382     `((,(string-append "movb___%" l ",0x32") (#:address ,label)))))
 383
 384 (define (x86_64:r->word-label info label)
 385   (let* ((r (get-r info))
 386         (x (r->x r)))
 387     `((,(string-append "movw___%" x ",0x32") (#:address ,label)))))
 388
 389 (define (x86_64:r->long-label info label)
 390   (let* ((r (get-r info))
 391         (e (r->e r)))
 392     `((,(string-append "movl___%" e ",0x32") (#:address ,label)))))
 393
 394 (define (x86_64:call-r info n)
 395   (let ((r (get-r info)))
 396     `((,(string-append "call___*%" r))
 397       ("add____$i8,%rsp" (#:immediate1  ,(* n 8)))))) ;; NOT AMD
 398
 399 (define (x86_64:r0*r1 info)
 400   (let ((allocated (.allocated info))
 401         (r0 (get-r0 info))
 402         (r1 (get-r1 info)))
 403     (if (not (member "rdx" allocated))
 404         `(,@(if (equal? r0 "rax") '()
 405                 `(("push___%rax"
 406                    ,(string-append "mov____%" r0 ",%rax"))))
 407           (,(string-append "mul____%" r1))
 408           ,@(if (equal? r0 "rax") '()
 409                 `((,(string-append "mov____%rax,%" r0)
 410                    "pop____%rax"))))
 411         `(("push___%rax")
 412           ("push___%rdi")
 413           ("push___%rdx")
 414           (,(string-append "mov____%" r1 ",%rdi"))
 415           (,(string-append "mov____%" r0 ",%rax"))
 416           (,(string-append "mul____%" r1))
 417           ("pop____%rdx")
 418           ("pop____%rdi")
 419           (,(string-append "mov____%rax,%" r0))
 420           ("pop____%rax")))))
 421
 422 (define (x86_64:r0<<r1 info)
 423   (let ((r0 (get-r0 info))
 424         (r1 (get-r1 info)))
 425     `((,(string-append "mov____%" r1 ",%rcx"))
 426       (,(string-append "shl____%cl,%" r0)))))
 427
 428 (define (x86_64:r0>>r1 info)
 429   (let ((r0 (get-r0 info))
 430         (r1 (get-r1 info)))
 431     `((,(string-append "mov____%" r1 ",%rcx"))
 432       (,(string-append "shr____%cl,%" r0)))))
 433
 434 (define (x86_64:r0-and-r1 info)
 435   (let ((r0 (get-r0 info))
 436         (r1 (get-r1 info)))
 437     `((,(string-append "and____%" r1 ",%" r0)))))
 438
 439 (define (x86_64:r0/r1 info signed?)
 440   (let ((allocated (.allocated info))
 441         (r0 (get-r0 info))
 442         (r1 (get-r1 info)))
 443     (if (not (member "rdx" allocated))
 444         `(,@(if (equal? r0 "rax") '()
 445                 `(("push___%rax")
 446                   (,(string-append "mov____%" r0 ",%rax"))))
 447           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
 448           (,(string-append "idiv___%" r1))
 449           ,@(if (equal? r0 "rax") '()
 450                 `((,(string-append "mov____%rax,%" r0))
 451                   ("pop____%rax"))))
 452         `(("push___%rax")
 453           ("push___%rdi")
 454           ("push___%rdx")
 455           (,(string-append "mov____%" r1 ",%rdi"))
 456           (,(string-append "mov____%" r0 ",%rax"))
 457           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
 458           (,(string-append "idiv___%rdi"))
 459           ("pop____%rdx")
 460           ("pop____%rdi")
 461           (,(string-append "mov____%rax,%" r0))
 462           ("pop____%rax")))))
 463
 464 (define (x86_64:r0%r1 info signed?)
 465   (let ((allocated (.allocated info))
 466         (r0 (get-r0 info))
 467         (r1 (get-r1 info)))
 468     (if (not (member "rdx" allocated))
 469         `(,@(if (equal? r0 "rax") '()
 470                 `(("push___%rax")
 471                   (,(string-append "mov____%" r0 ",%rax"))))
 472           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
 473           (,(string-append "idiv___%" r1))
 474           (,(string-append "mov____%rdx,%" r0)))
 475         `(("push___%rax")
 476           ("push___%rdi")
 477           ("push___%rdx")
 478           (,(string-append "mov____%" r1 ",%rdi"))
 479           (,(string-append "mov____%" r0 ",%rax"))
 480           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
 481           (,(string-append "idiv___%rdi"))
 482           ("pop____%rdx")
 483           ("pop____%rdi")
 484           (,(string-append "mov____%rdx,%" r0))
 485           ("pop____%rax")))))
 486
 487 (define (x86_64:r+value info v)
 488   (let ((r (get-r info)))
 489     (cond ((< (abs v) #x80)
 490            `((,(string-append "add____$i8,%" r) (#:immediate1 ,v))))
 491           ((< (abs v) #x80000000)
 492            `((,(string-append "add____$i32,%" r) (#:immediate ,v))))
 493           (else
 494            `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
 495              (,(string-append "add____%r15,%" r)))))))
 496
 497 (define (x86_64:r0->r1-mem info)
 498   (let ((r0 (get-r0 info))
 499         (r1 (get-r1 info)))
 500     `((,(string-append "mov____%" r0 ",(%" r1 ")")))))
 501
 502 (define (x86_64:byte-r0->r1-mem info)
 503   (let* ((r0 (get-r0 info))
 504          (r1 (get-r1 info))
 505          (l0 (r->l r0)))
 506     `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
 507
 508 (define (x86_64:word-r0->r1-mem info)
 509   (let* ((r0 (get-r0 info))
 510          (r1 (get-r1 info))
 511          (x0 (r->x r0)))
 512     `((,(string-append "mov____%" x0 ",(%" r1 ")")))))
 513
 514 (define (x86_64:long-r0->r1-mem info)
 515   (let* ((r0 (get-r0 info))
 516          (r1 (get-r1 info))
 517          (e0 (r->e r0)))
 518     `((,(string-append "mov____%" e0 ",(%" r1 ")")))))
 519
 520 (define (x86_64:r-cmp-value info v)
 521   (let ((r (get-r info)))
 522     (cond ((< (abs v) #x80)
 523            `((,(string-append "cmp____$i8,%" r) (#:immediate1 ,v))))
 524           ((and (>= v 0)
 525                 (< v #xffffffff))
 526            `((,(string-append "cmp____$i32,%" r) (#:immediate ,v))))
 527           (else
 528            `(,(string-append "mov____$i64,%r15") (#:immediate8 ,v)
 529              ,(string-append "cmp____%r15,%" r))))))
 530
 531 (define (x86_64:push-register info r)
 532   `((,(string-append "push___%" r))))
 533
 534 (define (x86_64:pop-register info r)
 535   `((,(string-append "pop____%" r))))
 536
 537 (define (x86_64:return->r info)
 538   (let ((r (car (.allocated info))))
 539     (if (equal? r "rax") '()
 540         `((,(string-append "mov____%rax,%" r))))))
 541
 542 (define (x86_64:r0-or-r1 info)
 543   (let ((r0 (get-r0 info))
 544         (r1 (get-r1 info)))
 545     `((,(string-append "or_____%" r1 ",%" r0)))))
 546
 547 (define (x86_64:shl-r info n)
 548   (let ((r (get-r info)))
 549     `((,(string-append "shl____$i8,%" r) (#:immediate1 ,n)))))
 550
 551 (define (x86_64:r+r info)
 552   (let ((r (get-r info)))
 553     `((,(string-append "add____%" r ",%" r)))))
 554
 555 (define (x86_64:not-r info)
 556   (let ((r (get-r info)))
 557     `((,(string-append "not____%" r)))))
 558
 559 (define (x86_64:r0-xor-r1 info)
 560   (let ((r0 (get-r0 info))
 561         (r1 (get-r1 info)))
 562     `((,(string-append "xor____%" r1 ",%" r0)))))
 563
 564 (define (x86_64:r0-mem->r1-mem info)
 565   (let* ((registers (.registers info))
 566          (r0 (get-r0 info))
 567          (r1 (get-r1 info))
 568          (r2 (car registers)))
 569     `((,(string-append "mov____(%" r0 "),%" r2))
 570       (,(string-append "mov____%" r2 ",(%" r1 ")")))))
 571
 572 (define (x86_64:r0+value info v)
 573   (let ((r0 (get-r0 info)))
 574     `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r0) (#:immediate1 ,v))
 575            `(,(string-append "add____$i32,%" r0) (#:immediate ,v)))))) ; FIXME: 64bit
 576
 577 (define (x86_64:value->r0 info v)
 578   (let ((r0 (get-r0 info)))
 579     `((,(string-append "mov____$i32,%" r0) (#:immediate ,v)))))
 580
 581 (define (x86_64:r-long-mem-add info v)
 582   (let ((r (get-r info)))
 583     (cond  ((< (abs v) #x80)
 584             `((,(string-append "addl___$i8,(%" r ")") (#:immediate1 ,v))))
 585            ((and (>= v 0)
 586                  (< v #xffffffff))
 587             `((,(string-append "addl___$i32,(%" r ")") (#:immediate ,v))))
 588            (else
 589             `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
 590               (,(string-append "add____%r15,(%" r ")")))))))
 591
 592 (define (x86_64:byte-r->local+n info id n)
 593   (let* ((n (+ (- 0 (* 8 id)) n))
 594          (r (get-r info))
 595          (l (r->l r) ))
 596     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" l ",0x8(%rbp)") (#:immediate1 ,n))
 597            `(,(string-append "mov____%" l ",0x32(%rbp)") (#:immediate ,n))))))
 598
 599 (define (x86_64:word-r->local+n info id n)
 600   (let* ((n (+ (- 0 (* 8 id)) n))
 601          (r (get-r info))
 602          (x (r->x r) ))
 603     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" x ",0x8(%rbp)") (#:immediate1 ,n))
 604            `(,(string-append "mov____%" x ",0x32(%rbp)") (#:immediate ,n))))))
 605
 606 (define (x86_64:long-r->local+n info id n)
 607   (let* ((n (+ (- 0 (* 8 id)) n))
 608          (r (get-r info))
 609          (e (r->e r)))
 610     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" e ",0x8(%rbp)") (#:immediate1 ,n))
 611            `(,(string-append "mov____%" e ",0x32(%rbp)") (#:immediate ,n))))))
 612
 613 (define (x86_64:r-and info v)
 614   (let ((r (get-r info)))
 615     (if (and (>= v 0)
 616              (< v #xffffffff))
 617         `((,(string-append "and____$i32,%" r) (#:immediate ,v)))
 618         `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
 619           (,(string-append "and____%r15,%" r))))))
 620
 621 (define (x86_64:push-r0 info)
 622   (let ((r0 (get-r0 info)))
 623     `((,(string-append "push___%" r0)))))
 624
 625 (define (x86_64:r1->r0 info)
 626   (let ((r0 (get-r0 info))
 627         (r1 (get-r1 info)))
 628     `((,(string-append  "mov____%" r1 ",%" r0)))))
 629
 630 (define (x86_64:pop-r0 info)
 631   (let ((r0 (get-r0 info)))
 632     `((,(string-append "pop____%" r0)))))
 633
 634 (define (x86_64:swap-r-stack info)
 635   (let ((r (get-r info)))
 636     `((,(string-append "xchg___%" r ",(%rsp)")))))
 637
 638 (define (x86_64:swap-r1-stack info)
 639   (let ((r0 (get-r0 info)))
 640     `((,(string-append "xchg___%" r0 ",(%rsp)")))))
 641
 642 (define (x86_64:r2->r0 info)
 643   (let ((r0 (get-r0 info))
 644         (allocated (.allocated info)))
 645     (if (> (length allocated) 2)
 646         (let ((r2 (cadddr allocated)))
 647           `((,(string-append  "mov____%" r2 ",%" r1))))
 648         `((,(string-append  "pop____%" r0))
 649           (,(string-append  "push___%" r0))))))
 650
 651 (define x86_64:instructions
 652   `(
 653     (a?->r . ,x86_64:a?->r)
 654     (ae?->r . ,x86_64:ae?->r)
 655     (b?->r . ,x86_64:b?->r)
 656     (be?->r . ,x86_64:be?->r)
 657     (byte-mem->r . ,x86_64:byte-mem->r)
 658     (byte-r . ,x86_64:byte-r)
 659     (byte-r->local+n . ,x86_64:byte-r->local+n)
 660     (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
 661     (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
 662     (byte-signed-r . ,x86_64:byte-signed-r)
 663     (call-label . ,x86_64:call-label)
 664     (call-r . ,x86_64:call-r)
 665     (function-locals . ,x86_64:function-locals)
 666     (function-preamble . ,x86_64:function-preamble)
 667     (g?->r . ,x86_64:g?->r)
 668     (ge?->r . ,x86_64:ge?->r)
 669     (jump . ,x86_64:jump)
 670     (jump-a . ,x86_64:jump-a)
 671     (jump-ae . ,x86_64:jump-ae)
 672     (jump-b . ,x86_64:jump-b)
 673     (jump-be . ,x86_64:jump-be)
 674     (jump-byte-z . ,x86_64:jump-byte-z)
 675     (jump-g . , x86_64:jump-g)
 676     (jump-ge . , x86_64:jump-ge)
 677     (jump-l . ,x86_64:jump-l)
 678     (jump-le . ,x86_64:jump-le)
 679     (jump-nz . ,x86_64:jump-nz)
 680     (jump-z . ,x86_64:jump-z)
 681     (l?->r . ,x86_64:l?->r)
 682     (label->arg . ,x86_64:label->arg)
 683     (label->r . ,x86_64:label->r)
 684     (label-mem->r . ,x86_64:label-mem->r)
 685     (label-mem-add . ,x86_64:label-mem-add)
 686     (le?->r . ,x86_64:le?->r)
 687     (local->r . ,x86_64:local->r)
 688     (local-add . ,x86_64:local-add)
 689     (local-ptr->r . ,x86_64:local-ptr->r)
 690     (long-mem->r . ,x86_64:long-mem->r)
 691     (long-r . ,x86_64:long-r)
 692     (long-r->local+n . ,x86_64:long-r->local+n)
 693     (long-r0->r1-mem . ,x86_64:long-r0->r1-mem)
 694     (long-signed-r . ,x86_64:long-signed-r)
 695     (mem->r . ,x86_64:mem->r)
 696     (nop . ,x86_64:nop)
 697     (not-r . ,x86_64:not-r)
 698     (pop-r0 . ,x86_64:pop-r0)
 699     (pop-register . ,x86_64:pop-register)
 700     (push-r0 . ,x86_64:push-r0)
 701     (push-register . ,x86_64:push-register)
 702     (quad-r0->r1-mem . ,x86_64:r0->r1-mem)
 703     (r+r . ,x86_64:r+r)
 704     (r+value . ,x86_64:r+value)
 705     (r->arg . ,x86_64:r->arg)
 706     (r->byte-label . ,x86_64:r->byte-label)
 707     (r->label . ,x86_64:r->label)
 708     (r->local . ,x86_64:r->local)
 709     (r->local+n . ,x86_64:r->local+n)
 710     (r->long-label . ,x86_64:r->long-label)
 711     (r->word-label . ,x86_64:r->word-label)
 712     (r-and . ,x86_64:r-and)
 713     (r-byte-mem-add . ,x86_64:r-byte-mem-add)
 714     (r-cmp-value . ,x86_64:r-cmp-value)
 715     (r-long-mem-add . ,x86_64:r-long-mem-add)
 716     (r-mem-add . ,x86_64:r-mem-add)
 717     (r-negate . ,x86_64:r-negate)
 718     (r-word-mem-add . ,x86_64:r-word-mem-add)
 719     (r-zero? . ,x86_64:r-zero?)
 720     (r0%r1 . ,x86_64:r0%r1)
 721     (r0*r1 . ,x86_64:r0*r1)
 722     (r0+r1 . ,x86_64:r0+r1)
 723     (r0+value . ,x86_64:r0+value)
 724     (r0->r1 . ,x86_64:r0->r1)
 725     (r0->r1-mem . ,x86_64:r0->r1-mem)
 726     (r0-and-r1 . ,x86_64:r0-and-r1)
 727     (r0-mem->r1-mem . ,x86_64:r0-mem->r1-mem)
 728     (r0-or-r1 . ,x86_64:r0-or-r1)
 729     (r0-r1 . ,x86_64:r0-r1)
 730     (r0-xor-r1 . ,x86_64:r0-xor-r1)
 731     (r0/r1 . ,x86_64:r0/r1)
 732     (r0<<r1 . ,x86_64:r0<<r1)
 733     (r0>>r1 . ,x86_64:r0>>r1)
 734     (r1->r0 . ,x86_64:r1->r0)
 735     (r2->r0 . ,x86_64:r2->r0)
 736     (ret . ,x86_64:ret)
 737     (return->r . ,x86_64:return->r)
 738     (shl-r . ,x86_64:shl-r)
 739     (swap-r-stack . ,x86_64:swap-r-stack)
 740     (swap-r0-r1 . ,x86_64:swap-r0-r1)
 741     (swap-r1-stack . ,x86_64:swap-r1-stack)
 742     (test-r . ,x86_64:test-r)
 743     (value->r . ,x86_64:value->r)
 744     (value->r0 . ,x86_64:value->r0)
 745     (word-mem->r . ,x86_64:word-mem->r)
 746     (word-r . ,x86_64:word-r)
 747     (word-r->local+n . ,x86_64:word-r->local+n)
 748     (word-r0->r1-mem . ,x86_64:word-r0->r1-mem)
 749     (word-signed-r . ,x86_64:word-signed-r)
 750     (xor-zf . ,x86_64:xor-zf)
 751     (zf->r . ,x86_64:zf->r)
 752     ))