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