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:call-r info n)
 380   (let ((r (get-r info)))
 381     `((,(string-append "call___*%" r))
 382       ("add____$i8,%rsp" (#:immediate1  ,(* n 8)))))) ;; NOT AMD
 383
 384 (define (x86_64:r0*r1 info)
 385   (let ((allocated (.allocated info))
 386         (r0 (get-r0 info))
 387         (r1 (get-r1 info)))
 388     (if (not (member "rdx" allocated))
 389         `(,@(if (equal? r0 "rax") '()
 390                 `(("push___%rax"
 391                    ,(string-append "mov____%" r0 ",%rax"))))
 392           (,(string-append "mul____%" r1))
 393           ,@(if (equal? r0 "rax") '()
 394                 `((,(string-append "mov____%rax,%" r0)
 395                    "pop____%rax"))))
 396         `(("push___%rax")
 397           ("push___%rdi")
 398           ("push___%rdx")
 399           (,(string-append "mov____%" r1 ",%rdi"))
 400           (,(string-append "mov____%" r0 ",%rax"))
 401           (,(string-append "mul____%" r1))
 402           ("pop____%rdx")
 403           ("pop____%rdi")
 404           (,(string-append "mov____%rax,%" r0))
 405           ("pop____%rax")))))
 406
 407 (define (x86_64:r0<<r1 info)
 408   (let ((r0 (get-r0 info))
 409         (r1 (get-r1 info)))
 410     `((,(string-append "mov____%" r1 ",%rcx"))
 411       (,(string-append "shl____%cl,%" r0)))))
 412
 413 (define (x86_64:r0>>r1 info)
 414   (let ((r0 (get-r0 info))
 415         (r1 (get-r1 info)))
 416     `((,(string-append "mov____%" r1 ",%rcx"))
 417       (,(string-append "shr____%cl,%" r0)))))
 418
 419 (define (x86_64:r0-and-r1 info)
 420   (let ((r0 (get-r0 info))
 421         (r1 (get-r1 info)))
 422     `((,(string-append "and____%" r1 ",%" r0)))))
 423
 424 (define (x86_64:r0/r1 info)
 425   (let ((allocated (.allocated info))
 426         (r0 (get-r0 info))
 427         (r1 (get-r1 info)))
 428     (if (not (member "rdx" allocated))
 429         `(,@(if (equal? r0 "rax") '()
 430                 `(("push___%rax")
 431                   (,(string-append "mov____%" r0 ",%rax"))))
 432           ("xor____%rdx,%rdx")
 433           (,(string-append "idiv___%" r1))
 434           ,@(if (equal? r0 "rax") '()
 435                 `((,(string-append "mov____%rax,%" r0))
 436                   ("pop____%rax"))))
 437         `(("push___%rax")
 438           ("push___%rdi")
 439           ("push___%rdx")
 440           (,(string-append "mov____%" r1 ",%rdi"))
 441           (,(string-append "mov____%" r0 ",%rax"))
 442           ("xor____%rdx,%rdx")
 443           (,(string-append "idiv___%rdi"))
 444           ("pop____%rdx")
 445           ("pop____%rdi")
 446           (,(string-append "mov____%rax,%" r0))
 447           ("pop____%rax")))))
 448
 449 (define (x86_64:r0%r1 info)
 450   (let ((allocated (.allocated info))
 451         (r0 (get-r0 info))
 452         (r1 (get-r1 info)))
 453     (if (not (member "rdx" allocated))
 454         `(,@(if (equal? r0 "rax") '()
 455                 `(("push___%rax")
 456                   (,(string-append "mov____%" r0 ",%rax"))))
 457           ("xor____%rdx,%rdx")
 458           (,(string-append "idiv___%" r1))
 459           (,(string-append "mov____%rdx,%" r0)))
 460         `(("push___%rax")
 461           ("push___%rdi")
 462           ("push___%rdx")
 463           (,(string-append "mov____%" r1 ",%rdi"))
 464           (,(string-append "mov____%" r0 ",%rax"))
 465           ("xor____%rdx,%rdx")
 466           (,(string-append "idiv___%rdi"))
 467           ("pop____%rdx")
 468           ("pop____%rdi")
 469           (,(string-append "mov____%rdx,%" r0))
 470           ("pop____%rax")))))
 471
 472 (define (x86_64:r+value info v)
 473   (let ((r (get-r info)))
 474     (cond ((< (abs v) #x80)
 475            `((,(string-append "add____$i8,%" r) (#:immediate1 ,v))))
 476           ((< (abs v) #x80000000)
 477            `((,(string-append "add____$i32,%" r) (#:immediate ,v))))
 478           (else
 479            `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
 480              (,(string-append "add____%r15,%" r)))))))
 481
 482 (define (x86_64:r0->r1-mem info)
 483   (let ((r0 (get-r0 info))
 484         (r1 (get-r1 info)))
 485     `((,(string-append "mov____%" r0 ",(%" r1 ")")))))
 486
 487 (define (x86_64:byte-r0->r1-mem info)
 488   (let* ((r0 (get-r0 info))
 489          (r1 (get-r1 info))
 490          (l0 (r->l r0)))
 491     `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
 492
 493 (define (x86_64:word-r0->r1-mem info)
 494   (let* ((r0 (get-r0 info))
 495          (r1 (get-r1 info))
 496          (x0 (r->x r0)))
 497     `((,(string-append "mov____%" x0 ",(%" r1 ")")))))
 498
 499 (define (x86_64:long-r0->r1-mem info)
 500   (let* ((r0 (get-r0 info))
 501          (r1 (get-r1 info))
 502          (e0 (r->e r0)))
 503     `((,(string-append "mov____%" e0 ",(%" r1 ")")))))
 504
 505 (define (x86_64:r-cmp-value info v)
 506   (let ((r (get-r info)))
 507     (cond ((< (abs v) #x80)
 508            `((,(string-append "cmp____$i8,%" r) (#:immediate1 ,v))))
 509           ((and (>= v 0)
 510                 (< v #xffffffff))
 511            `((,(string-append "cmp____$i32,%" r) (#:immediate ,v))))
 512           (else
 513            `(,(string-append "mov____$i64,%r15") (#:immediate8 ,v)
 514              ,(string-append "cmp____%r15,%" r))))))
 515
 516 (define (x86_64:push-register info r)
 517   `((,(string-append "push___%" r))))
 518
 519 (define (x86_64:pop-register info r)
 520   `((,(string-append "pop____%" r))))
 521
 522 (define (x86_64:return->r info)
 523   (let ((r (car (.allocated info))))
 524     (if (equal? r "rax") '()
 525         `((,(string-append "mov____%rax,%" r))))))
 526
 527 (define (x86_64:r0-or-r1 info)
 528   (let ((r0 (get-r0 info))
 529         (r1 (get-r1 info)))
 530     `((,(string-append "or_____%" r1 ",%" r0)))))
 531
 532 (define (x86_64:shl-r info n)
 533   (let ((r (get-r info)))
 534     `((,(string-append "shl____$i8,%" r) (#:immediate1 ,n)))))
 535
 536 (define (x86_64:r+r info)
 537   (let ((r (get-r info)))
 538     `((,(string-append "add____%" r ",%" r)))))
 539
 540 (define (x86_64:not-r info)
 541   (let ((r (get-r info)))
 542     `((,(string-append "not____%" r)))))
 543
 544 (define (x86_64:r0-xor-r1 info)
 545   (let ((r0 (get-r0 info))
 546         (r1 (get-r1 info)))
 547     `((,(string-append "xor____%" r1 ",%" r0)))))
 548
 549 (define (x86_64:r0-mem->r1-mem info)
 550   (let* ((registers (.registers info))
 551          (r0 (get-r0 info))
 552          (r1 (get-r1 info))
 553          (r2 (car registers)))
 554     `((,(string-append "mov____(%" r0 "),%" r2))
 555       (,(string-append "mov____%" r2 ",(%" r1 ")")))))
 556
 557 (define (x86_64:r0+value info v)
 558   (let ((r0 (get-r0 info)))
 559     `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r0) (#:immediate1 ,v))
 560            `(,(string-append "add____$i32,%" r0) (#:immediate ,v)))))) ; FIXME: 64bit
 561
 562 (define (x86_64:value->r0 info v)
 563   (let ((r0 (get-r0 info)))
 564     `((,(string-append "mov____$i32,%" r0) (#:immediate ,v)))))
 565
 566 (define (x86_64:r-long-mem-add info v)
 567   (let ((r (get-r info)))
 568     (cond  ((< (abs v) #x80)
 569             `((,(string-append "addl___$i8,(%" r ")") (#:immediate1 ,v))))
 570            ((and (>= v 0)
 571                  (< v #xffffffff))
 572             `((,(string-append "addl___$i32,(%" r ")") (#:immediate ,v))))
 573            (else
 574             `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
 575               (,(string-append "add____%r15,(%" r ")")))))))
 576
 577 (define (x86_64:byte-r->local+n info id n)
 578   (let* ((n (+ (- 0 (* 8 id)) n))
 579          (r (get-r info))
 580          (l (r->l r) ))
 581     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" l ",0x8(%rbp)") (#:immediate1 ,n))
 582            `(,(string-append "mov____%" l ",0x32(%rbp)") (#:immediate ,n))))))
 583
 584 (define (x86_64:word-r->local+n info id n)
 585   (let* ((n (+ (- 0 (* 8 id)) n))
 586          (r (get-r info))
 587          (x (r->x r) ))
 588     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" x ",0x8(%rbp)") (#:immediate1 ,n))
 589            `(,(string-append "mov____%" x ",0x32(%rbp)") (#:immediate ,n))))))
 590
 591 (define (x86_64:long-r->local+n info id n)
 592   (let* ((n (+ (- 0 (* 8 id)) n))
 593          (r (get-r info))
 594          (e (r->e r)))
 595     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" e ",0x8(%rbp)") (#:immediate1 ,n))
 596            `(,(string-append "mov____%" e ",0x32(%rbp)") (#:immediate ,n))))))
 597
 598 (define (x86_64:r-and info v)
 599   (let ((r (get-r info)))
 600     (if (and (>= v 0)
 601              (< v #xffffffff))
 602         `((,(string-append "and____$i32,%" r) (#:immediate ,v)))
 603         `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
 604           (,(string-append "and____%r15,%" r))))))
 605
 606 (define (x86_64:push-r0 info)
 607   (let ((r0 (get-r0 info)))
 608     `((,(string-append "push___%" r0)))))
 609
 610 (define (x86_64:r1->r0 info)
 611   (let ((r0 (get-r0 info))
 612         (r1 (get-r1 info)))
 613     `((,(string-append  "mov____%" r1 ",%" r0)))))
 614
 615 (define (x86_64:pop-r0 info)
 616   (let ((r0 (get-r0 info)))
 617     `((,(string-append "pop____%" r0)))))
 618
 619 (define (x86_64:swap-r-stack info)
 620   (let ((r (get-r info)))
 621     `((,(string-append "xchg___%" r ",(%rsp)")))))
 622
 623 (define (x86_64:swap-r1-stack info)
 624   (let ((r0 (get-r0 info)))
 625     `((,(string-append "xchg___%" r0 ",(%rsp)")))))
 626
 627 (define (x86_64:r2->r0 info)
 628   (let ((r0 (get-r0 info))
 629         (allocated (.allocated info)))
 630     (if (> (length allocated) 2)
 631         (let ((r2 (cadddr allocated)))
 632           `((,(string-append  "mov____%" r2 ",%" r1))))
 633         `((,(string-append  "pop____%" r0))
 634           (,(string-append  "push___%" r0))))))
 635
 636 (define x86_64:instructions
 637   `(
 638     (r2->r0 . ,x86_64:r2->r0)
 639     (a?->r . ,x86_64:a?->r)
 640     (ae?->r . ,x86_64:ae?->r)
 641     (b?->r . ,x86_64:b?->r)
 642     (be?->r . ,x86_64:be?->r)
 643     (byte-mem->r . ,x86_64:byte-mem->r)
 644     (byte-r . ,x86_64:byte-r)
 645     (byte-r->local+n . ,x86_64:byte-r->local+n)
 646     (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
 647     (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
 648     (byte-signed-r . ,x86_64:byte-signed-r)
 649     (call-label . ,x86_64:call-label)
 650     (call-r . ,x86_64:call-r)
 651     (function-locals . ,x86_64:function-locals)
 652     (function-preamble . ,x86_64:function-preamble)
 653     (g?->r . ,x86_64:g?->r)
 654     (ge?->r . ,x86_64:ge?->r)
 655     (jump . ,x86_64:jump)
 656     (jump-a . ,x86_64:jump-a)
 657     (jump-ae . ,x86_64:jump-ae)
 658     (jump-b . ,x86_64:jump-b)
 659     (jump-be . ,x86_64:jump-be)
 660     (jump-byte-z . ,x86_64:jump-byte-z)
 661     (jump-g . , x86_64:jump-g)
 662     (jump-ge . , x86_64:jump-ge)
 663     (jump-l . ,x86_64:jump-l)
 664     (jump-le . ,x86_64:jump-le)
 665     (jump-nz . ,x86_64:jump-nz)
 666     (jump-z . ,x86_64:jump-z)
 667     (l?->r . ,x86_64:l?->r)
 668     (label->arg . ,x86_64:label->arg)
 669     (label->r . ,x86_64:label->r)
 670     (label-mem->r . ,x86_64:label-mem->r)
 671     (label-mem-add . ,x86_64:label-mem-add)
 672     (le?->r . ,x86_64:le?->r)
 673     (local->r . ,x86_64:local->r)
 674     (local-add . ,x86_64:local-add)
 675     (local-ptr->r . ,x86_64:local-ptr->r)
 676     (long-mem->r . ,x86_64:long-mem->r)
 677     (long-r . ,x86_64:long-r)
 678     (long-r->local+n . ,x86_64:long-r->local+n)
 679     (long-r0->r1-mem . ,x86_64:long-r0->r1-mem)
 680     (long-signed-r . ,x86_64:long-signed-r)
 681     (mem->r . ,x86_64:mem->r)
 682     (nop . ,x86_64:nop)
 683     (not-r . ,x86_64:not-r)
 684     (pop-r0 . ,x86_64:pop-r0)
 685     (pop-register . ,x86_64:pop-register)
 686     (push-r0 . ,x86_64:push-r0)
 687     (push-register . ,x86_64:push-register)
 688     (quad-r0->r1-mem . ,x86_64:r0->r1-mem)
 689     (r+r . ,x86_64:r+r)
 690     (r+value . ,x86_64:r+value)
 691     (r->arg . ,x86_64:r->arg)
 692     (r->label . ,x86_64:r->label)
 693     (r->local . ,x86_64:r->local)
 694     (r->local+n . ,x86_64:r->local+n)
 695     (r-and . ,x86_64:r-and)
 696     (r-byte-mem-add . ,x86_64:r-byte-mem-add)
 697     (r-cmp-value . ,x86_64:r-cmp-value)
 698     (r-long-mem-add . ,x86_64:r-long-mem-add)
 699     (r-mem-add . ,x86_64:r-mem-add)
 700     (r-negate . ,x86_64:r-negate)
 701     (r-word-mem-add . ,x86_64:r-word-mem-add)
 702     (r-zero? . ,x86_64:r-zero?)
 703     (r0%r1 . ,x86_64:r0%r1)
 704     (r0*r1 . ,x86_64:r0*r1)
 705     (r0+r1 . ,x86_64:r0+r1)
 706     (r0+value . ,x86_64:r0+value)
 707     (r0->r1 . ,x86_64:r0->r1)
 708     (r0->r1-mem . ,x86_64:r0->r1-mem)
 709     (r0-and-r1 . ,x86_64:r0-and-r1)
 710     (r0-mem->r1-mem . ,x86_64:r0-mem->r1-mem)
 711     (r0-or-r1 . ,x86_64:r0-or-r1)
 712     (r0-r1 . ,x86_64:r0-r1)
 713     (r0-xor-r1 . ,x86_64:r0-xor-r1)
 714     (r0/r1 . ,x86_64:r0/r1)
 715     (r0<<r1 . ,x86_64:r0<<r1)
 716     (r0>>r1 . ,x86_64:r0>>r1)
 717     (r1->r0 . ,x86_64:r1->r0)
 718     (ret . ,x86_64:ret)
 719     (return->r . ,x86_64:return->r)
 720     (shl-r . ,x86_64:shl-r)
 721     (swap-r-stack . ,x86_64:swap-r-stack)
 722     (swap-r0-r1 . ,x86_64:swap-r0-r1)
 723     (swap-r1-stack . ,x86_64:swap-r1-stack)
 724     (test-r . ,x86_64:test-r)
 725     (value->r . ,x86_64:value->r)
 726     (value->r0 . ,x86_64:value->r0)
 727     (word-mem->r . ,x86_64:word-mem->r)
 728     (word-r . ,x86_64:word-r)
 729     (word-r->local+n . ,x86_64:word-r->local+n)
 730     (word-r0->r1-mem . ,x86_64:word-r0->r1-mem)
 731     (word-signed-r . ,x86_64:word-signed-r)
 732     (xor-zf . ,x86_64:xor-zf)
 733     (zf->r . ,x86_64:zf->r)
 734     ))