mescc: Support negative divide.

* 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

@@ -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

lib/x86-mes/x86.M1

@@ -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

lib/x86_64-mes/x86_64.M1

@@ -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

module/mescc/compile.scm

@@ -79,10 +79,14 @@
     (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))
@@ -792,7 +796,7 @@
                         (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)))
@@ -1177,7 +1181,7 @@
                      ;; 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))
@@ -1199,8 +1203,11 @@
         ((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))
+        ((div ,a ,b)
-        ((mod ,a ,b) ((binop->r info) a b 'r0%r1))
+         ((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)
@@ -1334,11 +1341,12 @@
                                              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 signed?)))
-                                                               ((equal? op "%=") (wrap-as (as info 'r0%r1)))
+                                                               ((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)))
@@ -1349,7 +1357,7 @@
                             (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)))))))))
@@ -1446,10 +1454,10 @@
               (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)

module/mescc/i386/as.scm

@@ -354,7 +354,7 @@
         (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)))
@@ -362,7 +362,7 @@
         `(,@(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))
@@ -372,14 +372,14 @@
           ("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)))
@@ -387,7 +387,7 @@
         `(,@(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")
@@ -395,7 +395,7 @@
           ("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")

module/mescc/x86_64/as.scm

@@ -436,7 +436,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)))
@@ -444,7 +444,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))
@@ -454,14 +454,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)))
@@ -469,7 +469,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")
@@ -477,7 +477,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")

scaffold/tests/a0-math-divide-signed-negative.c

@@ -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;
+}