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