968d7c4beb2a218597df27189aeeef86abf71b27
[mes.git] / 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     ))