mescc: Support negative divide.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Oct 2018 15:28:08 +0000 (17:28 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Oct 2018 15:28:08 +0000 (17:28 +0200)
* module/mescc/i386/as.scm (i386:r0/r1, i386:r0%r1): Support
negative divide.
* module/mescc/x86_64/as.scm (x86_64:r0/r1, x86_64:r0%r1): Likewise.
* lib/x86-mes/x86.M1: Likewise.
* lib/x86_64-mes/x86_64.M1: Likewise.
* scaffold/tests/a0-math-divide-signed-negative.c: Test it.
* build-aux/check-mescc.sh (tests): Run it.

build-aux/check-mescc.sh
lib/x86-mes/x86.M1
lib/x86_64-mes/x86_64.M1
module/mescc/compile.scm
module/mescc/i386/as.scm
module/mescc/x86_64/as.scm
scaffold/tests/a0-math-divide-signed-negative.c [new file with mode: 0644]

index a4ce7a53233c46f31206e0671488762d30ee347f..664c5cedd48124635bc03af4dcf30954d80b6f09 100755 (executable)
@@ -222,6 +222,7 @@ t
 a0-call-trunc-char
 a0-call-trunc-short
 a0-call-trunc-int
+a0-math-divide-signed-negative
 a1-global-no-align
 a1-global-no-clobber
 "
@@ -231,6 +232,7 @@ broken="$broken
 17-compare-unsigned-short-le
 66-local-char-array
 a0-call-trunc-int
+a0-math-divide-signed-negative
 "
 
 # gcc not supported
index 23d85f4fe1586e91c4613484fa49d8ef0e046d23..6c5bdad0dee9351bf789cc0d7f1300048c47d37a 100644 (file)
@@ -49,6 +49,7 @@ DEFINE and____%ebx,%eax 21d8
 DEFINE call32 e8
 DEFINE call___*%eax ffd0
 DEFINE call___*%ebx ffd3
+DEFINE cltd 99
 DEFINE cmp____$0x32,%eax 3d
 DEFINE cmp____$i32,%eax 3d
 DEFINE cmp____$i8,%eax 83f8
index 8b5a41cde359bc17e9c31db7a588c1acd41132c8..760fef3d14653fe332186e93877fc253095892a8 100644 (file)
@@ -56,6 +56,7 @@ DEFINE cmp____$i32,%rax 483d
 DEFINE cmp____$i8,%rax 4883f8
 DEFINE cmp____%r15,%rax 4c39f8
 DEFINE cmp____%r15,%rdi 4c39ff
+DEFINE cqto 4899
 DEFINE hlt f4
 DEFINE idiv___%rdi 48f7ff
 DEFINE ja32  0f87
index f04ffdeeacd8f21fc3a28cc3ed8d1f93848083cb..f708298b21c9da9dbb8df9b5c1c275eb29880dc4 100644 (file)
     (cons `(tag ,name) (make-type 'union size fields))))
 
 (define (signed? o)
-  (eq? ((compose type:type ->type) o) 'signed))
+  (let ((type (->type o)))
+    (cond ((type? type) (eq? (type:type type) 'signed))
+          (else #f))))
 
 (define (unsigned? o)
-  (eq? ((compose type:type ->type) o) 'unsigned))
+    (let ((type (->type o)))
+    (cond ((type? type) (eq? (type:type type) 'unsigned))
+          (else #t))))
 
 (define (->size o info)
   (cond ((and (type? o) (eq? (type:type o) 'union))
                         (info (append-text info (wrap-as (append
                                                           (as info 'value->r size)
                                                           (as info 'swap-r0-r1)
-                                                          (as info 'r0/r1)))))
+                                                          (as info 'r0/r1 #f)))))
                         (info (append-text info (wrap-as (append (as info 'swap-r0-r1)))))
                         (free-register info))
                    info)))
                      ;; FIXME: c&p 792
                      (let* ((info (allocate-register info))
                             (info (append-text info (wrap-as (append (as info 'value->r size)
-                                                                     (as info 'r0/r1)))))
+                                                                     (as info 'r0/r1 #f)))))
                             (info (free-register info)))
                        info)))
                (let* ((info (expr->register b info))
         ((bitwise-xor ,a ,b) ((binop->r info) a b 'r0-xor-r1))
         ((lshift ,a ,b) ((binop->r info) a b 'r0<<r1))
         ((rshift ,a ,b) ((binop->r info) a b 'r0>>r1))
-        ((div ,a ,b) ((binop->r info) a b 'r0/r1))
-        ((mod ,a ,b) ((binop->r info) a b 'r0%r1))
+        ((div ,a ,b)
+         ((binop->r info) a b 'r0/r1
+                      (or (signed? (ast->type a info)) (signed? (ast->type b info)))))
+        ((mod ,a ,b) ((binop->r info) a b 'r0%r1
+                      (or (signed? (ast->type a info)) (signed? (ast->type b info)))))
         ((mul ,a ,b) ((binop->r info) a b 'r0*r1))
 
         ((not ,expr)
                                              info)))
                                  (info (expr->register a info))
                                  (info (append-text info (wrap-as (as info 'swap-r0-r1))))
+                                 (signed? (or (signed? type) (signed? type-b)))
                                  (info (append-text info (cond ((equal? op "+=") (wrap-as (as info 'r0+r1)))
                                                                ((equal? op "-=") (wrap-as (as info 'r0-r1)))
                                                                ((equal? op "*=") (wrap-as (as info 'r0*r1)))
-                                                               ((equal? op "/=") (wrap-as (as info 'r0/r1)))
-                                                               ((equal? op "%=") (wrap-as (as info 'r0%r1)))
+                                                               ((equal? op "/=") (wrap-as (as info 'r0/r1 signed?)))
+                                                               ((equal? op "%=") (wrap-as (as info 'r0%r1 signed?)))
                                                                ((equal? op "&=") (wrap-as (as info 'r0-and-r1)))
                                                                ((equal? op "|=") (wrap-as (as info 'r0-or-r1)))
                                                                ((equal? op "^=") (wrap-as (as info 'r0-xor-r1)))
                             (cond ((not (and (= rank 1) (= rank-b 1))) info)
                                   ((equal? op "-=") (let* ((info (allocate-register info))
                                                            (info (append-text info (wrap-as (append (as info 'value->r size)
-                                                                                                    (as info 'r0/r1)))))
+                                                                                                    (as info 'r0/r1 signed?)))))
                                                            (info (free-register info)))
                                                       info))
                                   (else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
               (else '())))))
 
 (define (binop->r info)
-  (lambda (a b c)
+  (lambda (a b c . rest)
     (let* ((info (expr->register a info))
            (info (expr->register b info))
-           (info (append-text info (wrap-as (as info c)))))
+           (info (append-text info (wrap-as (apply as info (cons c rest))))))
       (free-register info))))
 
 (define (binop->r* info)
index e544a3b9025f7edfdf2c9886043aebf65fce531c..d3092e3a709261aa51e3db2daac5d9fc0f3edb33 100644 (file)
         (r1 (get-r1 info)))
     `((,(string-append "and____%" r1 ",%" r0)))))
 
-(define (i386:r0/r1 info)
+(define (i386:r0/r1 info signed?)
   (let ((allocated (.allocated info))
         (r0 (get-r0 info))
         (r1 (get-r1 info)))
         `(,@(if (equal? r0 "eax") '()
                 `(("push___%eax")
                   (,(string-append "mov____%" r0 ",%eax"))))
-          ("xor____%edx,%edx")
+          ,(if signed? '("cltd") '("xor____%edx,%edx"))
           (,(string-append "idiv___%" r1))
           ,@(if (equal? r0 "eax") '()
                 `((,(string-append "mov____%eax,%" r0))
           ("push___%edx")
           (,(string-append "mov____%" r1 ",%ebx"))
           (,(string-append "mov____%" r0 ",%eax"))
-          ("xor____%edx,%edx")
+          ,(if signed? '("cltd") '("xor____%edx,%edx"))
           (,(string-append "idiv___%ebx"))
           ("pop____%edx")
           ("pop____%ebx")
           (,(string-append "mov____%eax,%" r0))
           ("pop____%eax")))))
 
-(define (i386:r0%r1 info)
+(define (i386:r0%r1 info signed?)
   (let ((allocated (.allocated info))
         (r0 (get-r0 info))
         (r1 (get-r1 info)))
         `(,@(if (equal? r0 "eax") '()
                 `(("push___%eax")
                   (,(string-append "mov____%" r0 ",%eax"))))
-          ("xor____%edx,%edx")
+          ,(if signed? '("cltd") '("xor____%edx,%edx"))
           (,(string-append "idiv___%" r1))
           (,(string-append "mov____%edx,%" r0)))
         `(("push___%eax")
           ("push___%edx")
           (,(string-append "mov____%" r1 ",%ebx"))
           (,(string-append "mov____%" r0 ",%eax"))
-          ("xor____%edx,%edx")
+          ,(if signed? '("cltd") '("xor____%edx,%edx"))
           (,(string-append "idiv___%ebx"))
           ("pop____%edx")
           ("pop____%ebx")
index 29109dcaf471dab09cd8e82426a891b312afeb2b..301dd59108552a089edcadddc25c1816ca40f849 100644 (file)
         (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)))
         `(,@(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))
           ("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)))
         `(,@(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")
           ("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")
diff --git a/scaffold/tests/a0-math-divide-signed-negative.c b/scaffold/tests/a0-math-divide-signed-negative.c
new file mode 100644 (file)
index 0000000..aeefc82
--- /dev/null
@@ -0,0 +1,28 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+int
+main ()
+{
+  int i = -2 / 1;
+  if (i != -2)
+    return 1;
+  return 0;
+}