mescc: Another attempt at divide.
[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 ((signed? #f)              ; nobody knows, -- all advice are belong to us?
439         (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           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
447           ,(if signed? `(,(string-append "idiv___%" r1)) `(,(string-append "div___%" r1)))
448           ,@(if (equal? r0 "rax") '()
449                 `((,(string-append "mov____%rax,%" r0))
450                   ("pop____%rax"))))
451         `(("push___%rax")
452           ("push___%rdi")
453           ("push___%rdx")
454           (,(string-append "mov____%" r1 ",%rdi"))
455           (,(string-append "mov____%" r0 ",%rax"))
456           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
457           ,(if signed? `(,(string-append "idiv___%rdi")) `(,(string-append "div___%rdi")))
458           ("pop____%rdx")
459           ("pop____%rdi")
460           (,(string-append "mov____%rax,%" r0))
461           ("pop____%rax")))))
462
463 (define (x86_64:r0%r1 info signed?)
464   (let ((signed? #f)              ; nobody knows, -- all advice are belong to us?
465         (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           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
473           ,(if signed? `(,(string-append "idiv___%" r1)) `(,(string-append "div___%" 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           ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
481           ,(if signed? `(,(string-append "idiv___%rdi")) `(,(string-append "div___%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:byte-r0-mem->r1-mem info)
573   (let* ((registers (.registers info))
574          (r0 (get-r0 info))
575          (r1 (get-r1 info))
576          (r2 (car registers))
577          (l2 (r->l r2)))
578     `((,(string-append "mov____(%" r0 "),%" l2))
579       (,(string-append "mov____%" l2 ",(%" r1 ")")))))
580
581 (define (x86_64:word-r0-mem->r1-mem info)
582   (let* ((registers (.registers info))
583          (r0 (get-r0 info))
584          (r1 (get-r1 info))
585          (r2 (car registers))
586          (x2 (r->x r2)))
587     `((,(string-append "mov____(%" r0 "),%" x2))
588       (,(string-append "mov____%" x2 ",(%" r1 ")")))))
589
590 (define (x86_64:long-r0-mem->r1-mem info)
591   (let* ((registers (.registers info))
592          (r0 (get-r0 info))
593          (r1 (get-r1 info))
594          (r2 (car registers))
595          (e2 (r->e r2)))
596     `((,(string-append "mov____(%" r0 "),%" e2))
597       (,(string-append "mov____%" e2 ",(%" r1 ")")))))
598
599 (define (x86_64:r0+value info v)
600   (let ((r0 (get-r0 info)))
601     `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r0) (#:immediate1 ,v))
602            `(,(string-append "add____$i32,%" r0) (#:immediate ,v)))))) ; FIXME: 64bit
603
604 (define (x86_64:value->r0 info v)
605   (let ((r0 (get-r0 info)))
606     `((,(string-append "mov____$i32,%" r0) (#:immediate ,v)))))
607
608 (define (x86_64:r-long-mem-add info v)
609   (let ((r (get-r info)))
610     (cond  ((< (abs v) #x80)
611             `((,(string-append "addl___$i8,(%" r ")") (#:immediate1 ,v))))
612            ((and (>= v 0)
613                  (< v #xffffffff))
614             `((,(string-append "addl___$i32,(%" r ")") (#:immediate ,v))))
615            (else
616             `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
617               (,(string-append "add____%r15,(%" r ")")))))))
618
619 (define (x86_64:byte-r->local+n info id n)
620   (let* ((n (+ (- 0 (* 8 id)) n))
621          (r (get-r info))
622          (l (r->l r) ))
623     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" l ",0x8(%rbp)") (#:immediate1 ,n))
624            `(,(string-append "mov____%" l ",0x32(%rbp)") (#:immediate ,n))))))
625
626 (define (x86_64:word-r->local+n info id n)
627   (let* ((n (+ (- 0 (* 8 id)) n))
628          (r (get-r info))
629          (x (r->x r) ))
630     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" x ",0x8(%rbp)") (#:immediate1 ,n))
631            `(,(string-append "mov____%" x ",0x32(%rbp)") (#:immediate ,n))))))
632
633 (define (x86_64:long-r->local+n info id n)
634   (let* ((n (+ (- 0 (* 8 id)) n))
635          (r (get-r info))
636          (e (r->e r)))
637     `(,(if (< (abs n) #x80) `(,(string-append "mov____%" e ",0x8(%rbp)") (#:immediate1 ,n))
638            `(,(string-append "mov____%" e ",0x32(%rbp)") (#:immediate ,n))))))
639
640 (define (x86_64:r-and info v)
641   (let ((r (get-r info)))
642     (if (and (>= v 0)
643              (< v #xffffffff))
644         `((,(string-append "and____$i32,%" r) (#:immediate ,v)))
645         `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
646           (,(string-append "and____%r15,%" r))))))
647
648 (define (x86_64:push-r0 info)
649   (let ((r0 (get-r0 info)))
650     `((,(string-append "push___%" r0)))))
651
652 (define (x86_64:r1->r0 info)
653   (let ((r0 (get-r0 info))
654         (r1 (get-r1 info)))
655     `((,(string-append  "mov____%" r1 ",%" r0)))))
656
657 (define (x86_64:pop-r0 info)
658   (let ((r0 (get-r0 info)))
659     `((,(string-append "pop____%" r0)))))
660
661 (define (x86_64:swap-r-stack info)
662   (let ((r (get-r info)))
663     `((,(string-append "xchg___%" r ",(%rsp)")))))
664
665 (define (x86_64:swap-r1-stack info)
666   (let ((r0 (get-r0 info)))
667     `((,(string-append "xchg___%" r0 ",(%rsp)")))))
668
669 (define (x86_64:r2->r0 info)
670   (let ((r0 (get-r0 info))
671         (allocated (.allocated info)))
672     (if (> (length allocated) 2)
673         (let ((r2 (cadddr allocated)))
674           `((,(string-append  "mov____%" r2 ",%" r1))))
675         `((,(string-append  "pop____%" r0))
676           (,(string-append  "push___%" r0))))))
677
678 (define x86_64:instructions
679   `(
680     (a?->r . ,x86_64:a?->r)
681     (ae?->r . ,x86_64:ae?->r)
682     (b?->r . ,x86_64:b?->r)
683     (be?->r . ,x86_64:be?->r)
684     (byte-mem->r . ,x86_64:byte-mem->r)
685     (byte-r . ,x86_64:byte-r)
686     (byte-r->local+n . ,x86_64:byte-r->local+n)
687     (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
688     (byte-r0-mem->r1-mem . ,x86_64:byte-r0-mem->r1-mem)
689     (byte-signed-r . ,x86_64:byte-signed-r)
690     (call-label . ,x86_64:call-label)
691     (call-r . ,x86_64:call-r)
692     (function-locals . ,x86_64:function-locals)
693     (function-preamble . ,x86_64:function-preamble)
694     (g?->r . ,x86_64:g?->r)
695     (ge?->r . ,x86_64:ge?->r)
696     (jump . ,x86_64:jump)
697     (jump-a . ,x86_64:jump-a)
698     (jump-ae . ,x86_64:jump-ae)
699     (jump-b . ,x86_64:jump-b)
700     (jump-be . ,x86_64:jump-be)
701     (jump-byte-z . ,x86_64:jump-byte-z)
702     (jump-g . , x86_64:jump-g)
703     (jump-ge . , x86_64:jump-ge)
704     (jump-l . ,x86_64:jump-l)
705     (jump-le . ,x86_64:jump-le)
706     (jump-nz . ,x86_64:jump-nz)
707     (jump-z . ,x86_64:jump-z)
708     (l?->r . ,x86_64:l?->r)
709     (label->arg . ,x86_64:label->arg)
710     (label->r . ,x86_64:label->r)
711     (label-mem->r . ,x86_64:label-mem->r)
712     (label-mem-add . ,x86_64:label-mem-add)
713     (le?->r . ,x86_64:le?->r)
714     (local->r . ,x86_64:local->r)
715     (local-add . ,x86_64:local-add)
716     (local-ptr->r . ,x86_64:local-ptr->r)
717     (long-mem->r . ,x86_64:long-mem->r)
718     (long-r . ,x86_64:long-r)
719     (long-r->local+n . ,x86_64:long-r->local+n)
720     (long-r0->r1-mem . ,x86_64:long-r0->r1-mem)
721     (long-r0-mem->r1-mem . ,x86_64:long-r0-mem->r1-mem)
722     (long-signed-r . ,x86_64:long-signed-r)
723     (mem->r . ,x86_64:mem->r)
724     (nop . ,x86_64:nop)
725     (not-r . ,x86_64:not-r)
726     (pop-r0 . ,x86_64:pop-r0)
727     (pop-register . ,x86_64:pop-register)
728     (push-r0 . ,x86_64:push-r0)
729     (push-register . ,x86_64:push-register)
730     (quad-r0->r1-mem . ,x86_64:r0->r1-mem)
731     (r+r . ,x86_64:r+r)
732     (r+value . ,x86_64:r+value)
733     (r->arg . ,x86_64:r->arg)
734     (r->byte-label . ,x86_64:r->byte-label)
735     (r->label . ,x86_64:r->label)
736     (r->local . ,x86_64:r->local)
737     (r->local+n . ,x86_64:r->local+n)
738     (r->long-label . ,x86_64:r->long-label)
739     (r->word-label . ,x86_64:r->word-label)
740     (r-and . ,x86_64:r-and)
741     (r-byte-mem-add . ,x86_64:r-byte-mem-add)
742     (r-cmp-value . ,x86_64:r-cmp-value)
743     (r-long-mem-add . ,x86_64:r-long-mem-add)
744     (r-mem-add . ,x86_64:r-mem-add)
745     (r-negate . ,x86_64:r-negate)
746     (r-word-mem-add . ,x86_64:r-word-mem-add)
747     (r-zero? . ,x86_64:r-zero?)
748     (r0%r1 . ,x86_64:r0%r1)
749     (r0*r1 . ,x86_64:r0*r1)
750     (r0+r1 . ,x86_64:r0+r1)
751     (r0+value . ,x86_64:r0+value)
752     (r0->r1 . ,x86_64:r0->r1)
753     (r0->r1-mem . ,x86_64:r0->r1-mem)
754     (r0-and-r1 . ,x86_64:r0-and-r1)
755     (r0-mem->r1-mem . ,x86_64:r0-mem->r1-mem)
756     (r0-or-r1 . ,x86_64:r0-or-r1)
757     (r0-r1 . ,x86_64:r0-r1)
758     (r0-xor-r1 . ,x86_64:r0-xor-r1)
759     (r0/r1 . ,x86_64:r0/r1)
760     (r0<<r1 . ,x86_64:r0<<r1)
761     (r0>>r1 . ,x86_64:r0>>r1)
762     (r1->r0 . ,x86_64:r1->r0)
763     (r2->r0 . ,x86_64:r2->r0)
764     (ret . ,x86_64:ret)
765     (return->r . ,x86_64:return->r)
766     (shl-r . ,x86_64:shl-r)
767     (swap-r-stack . ,x86_64:swap-r-stack)
768     (swap-r0-r1 . ,x86_64:swap-r0-r1)
769     (swap-r1-stack . ,x86_64:swap-r1-stack)
770     (test-r . ,x86_64:test-r)
771     (value->r . ,x86_64:value->r)
772     (value->r0 . ,x86_64:value->r0)
773     (word-mem->r . ,x86_64:word-mem->r)
774     (word-r . ,x86_64:word-r)
775     (word-r->local+n . ,x86_64:word-r->local+n)
776     (word-r0->r1-mem . ,x86_64:word-r0->r1-mem)
777     (word-r0-mem->r1-mem . ,x86_64:word-r0-mem->r1-mem)
778     (word-signed-r . ,x86_64:word-signed-r)
779     (xor-zf . ,x86_64:xor-zf)
780     (zf->r . ,x86_64:zf->r)
781     ))