mescc: Support 64-bit immediates.
[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   (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     ))