mescc: Fix clobbering of struct by value assign.

[mes.git] / module / mescc / x86_64 / as.scm

diff --git a/module/mescc/x86_64/as.scm b/module/mescc/x86_64/as.scm
index 9e3f525832edc08735228caf12ce564d5ad73a88..968d7c4beb2a218597df27189aeeef86abf71b27 100644 (file)
--- a/module/mescc/x86_64/as.scm
+++ b/module/mescc/x86_64/as.scm
@@ -48,7 +48,6 @@
 
 ;; AMD
 (define (x86_64:function-preamble info . rest)
-  (format (current-error-port) "rest=~s\n" rest)
   `(("push___%rbp")
     ("mov____%rsp,%rbp")
     ("sub____$i32,%rbp" "%0x80")
@@ -63,7 +62,6 @@
 
 ;; traditional
 (define (x86_64:function-preamble info . rest)
-  (format (current-error-port) "rest=~s\n" rest)
   `(("push___%rbp")
     ("mov____%rsp,%rbp")))
 
@@ -76,13 +74,17 @@
 (define (x86_64:r->local info n)
   (let ((r (get-r info))
         (n (- 0 (* 8 n))))
-    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
+    `(,(if (< (abs n) #x80)
+           `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
            `(,(string-append "mov____%" r ",0x32(%rbp)") (#:immediate ,n))))))
 
 (define (x86_64:value->r info v)
   (or v (error "invalid value: x86_64:value->r: " v))
   (let ((r (get-r info)))
-    `((,(string-append "mov____$i32,%" r) (#:immediate ,v)))))
+    (if (and (>= v 0)
+             (< v #xffffffff))
+     `((,(string-append "mov____$i32,%" r) (#:immediate ,v)))
+     `((,(string-append "mov____$i64,%" r) (#:immediate8 ,v))))))
 
 ;; AMD
 (define (x86_64:ret . rest)
@@ -122,7 +124,9 @@
 
 (define (x86_64:label->arg info label i)
   (let ((r0 (list-ref x86_64:registers (1+ i))))
-    `((,(string-append "mov____$i32,%" r0) (#:address ,label))))) ;; FIXME: 64 bits
+    (if (< (label v) #x80000000)
+        `((,(string-append "mov____$i32,%" r0) (#:address ,label)))
+        `((,(string-append "mov____$i64,%" r0) (#:address8 ,label))))))
 
 ;; traditional
 (define (x86_64:r->arg info i)
@@ -132,6 +136,11 @@
 (define (x86_64:label->arg info label i)
   `(("push___$i32" (#:address ,label))))
 
+;; FIXME?
+;; (define (x86_64:label->arg info label i)
+;;   `((,(string-append "mov____$i64,%r15") (#:address8 ,label))
+;;     ("push___%r15" (#:address ,label))))
+
 (define (x86_64:r0+r1 info)
   (let ((r1 (get-r1 info))
         (r0 (get-r0 info)))
@@ -168,7 +177,7 @@
 (define (x86_64:r-mem-add info v)
   (let ((r (get-r info)))
     `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,(%" r ")") (#:immediate1 ,v))
-           `(,(string-append "add____$i32,(%" r ")") (#:immediate ,v))))))
+           `(,(string-append "add____$i32,(%" r ")") (#:immediate ,v)))))) ;; FIXME 64bit
 
 (define (x86_64:r-byte-mem-add info v)
   (let ((r (get-r info)))
@@ -183,11 +192,11 @@
     (let ((n (- 0 (* 8 n))))
       `((,(string-append "mov____%rbp,%" r))
         ,(if (< (abs n) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,n))
-             `(,(string-append "add____$i32,%" r)  (#:immediate ,n)))))))
+             `(,(string-append "add____$i32,%" r)  (#:immediate ,n))))))) ;; FIXME 64bit
 
 (define (x86_64:label->r info label)
   (let ((r (get-r info)))
-    `((,(string-append "mov____$i32,%" r) (#:address ,label)))))
+    `((,(string-append "mov____$i64,%" r) (#:address8 ,label)))))
 
 (define (x86_64:r0->r1 info)
   (let ((r0 (get-r0 info))
@@ -293,11 +302,11 @@
   (let ((n (- 0 (* 8 n))))
     `(,(if (and (< (abs n) #x80)
                 (< (abs v) #x80)) `("add____$i8,0x8(%rbp)" (#:immediate1 ,n) (#:immediate1 ,v))
-                `("add____$i32,0x32(%rbp)" (#:immediate ,n) (#:immediate ,v))))))
+                `("add____$i32,0x32(%rbp)" (#:immediate ,n) (#:immediate ,v)))))) ;; FIXME: 64b
 
 (define (x86_64:label-mem-add info label v)
   `(,(if (< (abs v) #x80) `("add____$i8,0x32" (#:address ,label) (#:immediate1 ,v))
-         `("add____$i32,0x32" (#:address ,label) (#:immediate ,v)))))
+         `("add____$i32,0x32" (#:address ,label) (#:immediate ,v))))) ;; FIXME: 64b
 
 (define (x86_64:nop info)
   '(("nop")))
@@ -365,6 +374,21 @@
   (let ((r (get-r info)))
     `((,(string-append "mov____%" r ",0x32") (#:address ,label))))) ;; FIXME: 64 bits
 
+(define (x86_64:r->byte-label info label)
+  (let* ((r (get-r info))
+         (l (r->l r)))
+    `((,(string-append "movb___%" l ",0x32") (#:address ,label)))))
+
+(define (x86_64:r->word-label info label)
+  (let* ((r (get-r info))
+        (x (r->x r)))
+    `((,(string-append "movw___%" x ",0x32") (#:address ,label)))))
+
+(define (x86_64:r->long-label info label)
+  (let* ((r (get-r info))
+        (e (r->e r)))
+    `((,(string-append "movl___%" e ",0x32") (#:address ,label)))))
+
 (define (x86_64:call-r info n)
   (let ((r (get-r info)))
     `((,(string-append "call___*%" r))
@@ -410,7 +434,7 @@
         (r1 (get-r1 info)))
     `((,(string-append "and____%" r1 ",%" r0)))))
 
-(define (x86_64:r0/r1 info)
+(define (x86_64:r0/r1 info signed?)
   (let ((allocated (.allocated info))
         (r0 (get-r0 info))
         (r1 (get-r1 info)))
@@ -418,7 +442,7 @@
         `(,@(if (equal? r0 "rax") '()
                 `(("push___%rax")
                   (,(string-append "mov____%" r0 ",%rax"))))
-          ("xor____%rdx,%rdx")
+          ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
           (,(string-append "idiv___%" r1))
           ,@(if (equal? r0 "rax") '()
                 `((,(string-append "mov____%rax,%" r0))
@@ -428,14 +452,14 @@
           ("push___%rdx")
           (,(string-append "mov____%" r1 ",%rdi"))
           (,(string-append "mov____%" r0 ",%rax"))
-          ("xor____%rdx,%rdx")
+          ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
           (,(string-append "idiv___%rdi"))
           ("pop____%rdx")
           ("pop____%rdi")
           (,(string-append "mov____%rax,%" r0))
           ("pop____%rax")))))
 
-(define (x86_64:r0%r1 info)
+(define (x86_64:r0%r1 info signed?)
   (let ((allocated (.allocated info))
         (r0 (get-r0 info))
         (r1 (get-r1 info)))
@@ -443,7 +467,7 @@
         `(,@(if (equal? r0 "rax") '()
                 `(("push___%rax")
                   (,(string-append "mov____%" r0 ",%rax"))))
-          ("xor____%rdx,%rdx")
+          ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
           (,(string-append "idiv___%" r1))
           (,(string-append "mov____%rdx,%" r0)))
         `(("push___%rax")
@@ -451,7 +475,7 @@
           ("push___%rdx")
           (,(string-append "mov____%" r1 ",%rdi"))
           (,(string-append "mov____%" r0 ",%rax"))
-          ("xor____%rdx,%rdx")
+          ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
           (,(string-append "idiv___%rdi"))
           ("pop____%rdx")
           ("pop____%rdi")
@@ -460,8 +484,13 @@
 
 (define (x86_64:r+value info v)
   (let ((r (get-r info)))
-    `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,v))
-           `(,(string-append "add____$i32,%" r) (#:immediate ,v))))))
+    (cond ((< (abs v) #x80)
+           `((,(string-append "add____$i8,%" r) (#:immediate1 ,v))))
+          ((< (abs v) #x80000000)
+           `((,(string-append "add____$i32,%" r) (#:immediate ,v))))
+          (else
+           `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
+             (,(string-append "add____%r15,%" r)))))))
 
 (define (x86_64:r0->r1-mem info)
   (let ((r0 (get-r0 info))
@@ -488,8 +517,14 @@
 
 (define (x86_64:r-cmp-value info v)
   (let ((r (get-r info)))
-    `(,(if (< (abs v) #x80) `(,(string-append "cmp____$i8,%" r) (#:immediate1 ,v))
-           `(,(string-append "cmp____$i32,%" r) (#:immediate ,v))))))
+    (cond ((< (abs v) #x80)
+           `((,(string-append "cmp____$i8,%" r) (#:immediate1 ,v))))
+          ((and (>= v 0)
+                (< v #xffffffff))
+           `((,(string-append "cmp____$i32,%" r) (#:immediate ,v))))
+          (else
+           `(,(string-append "mov____$i64,%r15") (#:immediate8 ,v)
+             ,(string-append "cmp____%r15,%" r))))))
 
 (define (x86_64:push-register info r)
   `((,(string-append "push___%" r))))
@@ -532,10 +567,37 @@
     `((,(string-append "mov____(%" r0 "),%" r2))
       (,(string-append "mov____%" r2 ",(%" r1 ")")))))
 
+(define (x86_64:byte-r0-mem->r1-mem info)
+  (let* ((registers (.registers info))
+         (r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (r2 (car registers))
+         (l2 (r->l r2)))
+    `((,(string-append "mov____(%" r0 "),%" l2))
+      (,(string-append "mov____%" l2 ",(%" r1 ")")))))
+
+(define (x86_64:word-r0-mem->r1-mem info)
+  (let* ((registers (.registers info))
+         (r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (r2 (car registers))
+         (x2 (r->x r2)))
+    `((,(string-append "mov____(%" r0 "),%" x2))
+      (,(string-append "mov____%" x2 ",(%" r1 ")")))))
+
+(define (x86_64:long-r0-mem->r1-mem info)
+  (let* ((registers (.registers info))
+         (r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (r2 (car registers))
+         (e2 (r->e r2)))
+    `((,(string-append "mov____(%" r0 "),%" e2))
+      (,(string-append "mov____%" e2 ",(%" r1 ")")))))
+
 (define (x86_64:r0+value info v)
   (let ((r0 (get-r0 info)))
     `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r0) (#:immediate1 ,v))
-           `(,(string-append "add____$i32,%" r0) (#:immediate ,v))))))
+           `(,(string-append "add____$i32,%" r0) (#:immediate ,v)))))) ; FIXME: 64bit
 
 (define (x86_64:value->r0 info v)
   (let ((r0 (get-r0 info)))
@@ -543,8 +605,14 @@
 
 (define (x86_64:r-long-mem-add info v)
   (let ((r (get-r info)))
-    `(,(if (< (abs v) #x80) `(,(string-append "addl___$i8,(%" r ")") (#:immediate1 ,v))
-           `(,(string-append "addl___$i32,(%" r ")") (#:immediate ,v))))))
+    (cond  ((< (abs v) #x80)
+            `((,(string-append "addl___$i8,(%" r ")") (#:immediate1 ,v))))
+           ((and (>= v 0)
+                 (< v #xffffffff))
+            `((,(string-append "addl___$i32,(%" r ")") (#:immediate ,v))))
+           (else
+            `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
+              (,(string-append "add____%r15,(%" r ")")))))))
 
 (define (x86_64:byte-r->local+n info id n)
   (let* ((n (+ (- 0 (* 8 id)) n))
@@ -569,7 +637,11 @@
 
 (define (x86_64:r-and info v)
   (let ((r (get-r info)))
-    `((,(string-append "and____$i32,%" r) (#:immediate ,v)))))
+    (if (and (>= v 0)
+             (< v #xffffffff))
+        `((,(string-append "and____$i32,%" r) (#:immediate ,v)))
+        `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
+          (,(string-append "and____%r15,%" r))))))
 
 (define (x86_64:push-r0 info)
   (let ((r0 (get-r0 info)))
@@ -603,7 +675,6 @@
 
 (define x86_64:instructions
   `(
-    (r2->r0 . ,x86_64:r2->r0)
     (a?->r . ,x86_64:a?->r)
     (ae?->r . ,x86_64:ae?->r)
     (b?->r . ,x86_64:b?->r)
@@ -612,7 +683,7 @@
     (byte-r . ,x86_64:byte-r)
     (byte-r->local+n . ,x86_64:byte-r->local+n)
     (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
-    (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
+    (byte-r0-mem->r1-mem . ,x86_64:byte-r0-mem->r1-mem)
     (byte-signed-r . ,x86_64:byte-signed-r)
     (call-label . ,x86_64:call-label)
     (call-r . ,x86_64:call-r)
@@ -645,6 +716,7 @@
     (long-r . ,x86_64:long-r)
     (long-r->local+n . ,x86_64:long-r->local+n)
     (long-r0->r1-mem . ,x86_64:long-r0->r1-mem)
+    (long-r0-mem->r1-mem . ,x86_64:long-r0-mem->r1-mem)
     (long-signed-r . ,x86_64:long-signed-r)
     (mem->r . ,x86_64:mem->r)
     (nop . ,x86_64:nop)
@@ -657,9 +729,12 @@
     (r+r . ,x86_64:r+r)
     (r+value . ,x86_64:r+value)
     (r->arg . ,x86_64:r->arg)
+    (r->byte-label . ,x86_64:r->byte-label)
     (r->label . ,x86_64:r->label)
     (r->local . ,x86_64:r->local)
     (r->local+n . ,x86_64:r->local+n)
+    (r->long-label . ,x86_64:r->long-label)
+    (r->word-label . ,x86_64:r->word-label)
     (r-and . ,x86_64:r-and)
     (r-byte-mem-add . ,x86_64:r-byte-mem-add)
     (r-cmp-value . ,x86_64:r-cmp-value)
@@ -683,6 +758,7 @@
     (r0<<r1 . ,x86_64:r0<<r1)
     (r0>>r1 . ,x86_64:r0>>r1)
     (r1->r0 . ,x86_64:r1->r0)
+    (r2->r0 . ,x86_64:r2->r0)
     (ret . ,x86_64:ret)
     (return->r . ,x86_64:return->r)
     (shl-r . ,x86_64:shl-r)
@@ -696,6 +772,7 @@
     (word-r . ,x86_64:word-r)
     (word-r->local+n . ,x86_64:word-r->local+n)
     (word-r0->r1-mem . ,x86_64:word-r0->r1-mem)
+    (word-r0-mem->r1-mem . ,x86_64:word-r0-mem->r1-mem)
     (word-signed-r . ,x86_64:word-signed-r)
     (xor-zf . ,x86_64:xor-zf)
     (zf->r . ,x86_64:zf->r)