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