mescc: Tinycc support: Char and short sign extend.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 18 May 2018 21:58:10 +0000 (23:58 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 18 May 2018 21:58:10 +0000 (23:58 +0200)
* module/mes/as-i386.mes (i386:accu*n->local, i386:byte-accu->local+n,
  i386:word-accu->local+n): Remove.
  (i386:byte-accu, i386:signed-byte-accu, i386:word-accu,
  i386:signed-word-accu): New function.
* module/mes/as-i386.scm: Export them.
* module/language/c99/compiler.mes (accu->local+n-text): Simplify.
  (mem->accu, convert-accu): New function.
  (expr->accu): Use them.
* stage0/x86.M1 (mov____%al,0x32(%ebp), mov____%al,0x8(%ebp),
  mov____%ax,0x32(%ebp), mov____%ax,0x8(%ebp), movzbl_0x32(%ebp),%eax,
  movzbl_0x8(%ebp),%eax, movzwl_0x32(%ebp),%eax,
  movzwl_0x8(%ebp),%eax): Deprecate.
* scaffold/tests/7r-sign-extend.c: Test it.
* build-aux/check-mescc.sh (tests): Run it.

build-aux/check-mescc.sh
module/language/c99/compiler.mes
module/language/c99/info.scm
module/mes/as-i386.mes
module/mes/as-i386.scm
scaffold/tests/7r-sign-extend.c [new file with mode: 0644]
stage0/x86.M1

index 4a607ec607c4ed983b64fb46ff4b48baf26dd617..2d05a0e1936875316400fc5497520558b1405df2 100755 (executable)
@@ -115,6 +115,7 @@ t
 7o-struct-pre-post
 7p-struct-cast
 7q-bit-field
+7r-sign-extend
 80-setjmp
 81-qsort
 82-define
index c14df62e4c606b1963d295fbd9f44d2b0e115d30..e30ebc5d9cf7e5b21cb7fd0e5061746cdb9861fa 100644 (file)
     (cons `(tag ,name) (make-type 'union size fields))))
 
 (define i386:type-alist
-  `(("char" . ,(make-type 'builtin 1 #f))
-    ("short" . ,(make-type 'builtin 2 #f))
-    ("int" . ,(make-type 'builtin 4 #f))
-    ("long" . ,(make-type 'builtin 4 #f))
-    ;;("long long" . ,(make-type 'builtin 8 #f))
-    ;;("long long int" . ,(make-type 'builtin 8 #f))
+  `(("char" . ,(make-type 'signed 1 #f))
+    ("short" . ,(make-type 'signed 2 #f))
+    ("int" . ,(make-type 'signed 4 #f))
+    ("long" . ,(make-type 'signed 4 #f))
+    ;;("long long" . ,(make-type 'signed 8 #f))
+    ;;("long long int" . ,(make-type 'signed 8 #f))
 
-    ("long long" . ,(make-type 'builtin 4 #f))  ;; FIXME
-    ("long long int" . ,(make-type 'builtin 4 #f))
+    ("long long" . ,(make-type 'signed 4 #f))  ;; FIXME
+    ("long long int" . ,(make-type 'signed 4 #f))
 
-    ("void" . ,(make-type 'builtin 1 #f))
+    ("void" . ,(make-type 'void 1 #f))
     ;; FIXME sign
-    ("unsigned char" . ,(make-type 'builtin 1 #f))
-    ("unsigned short" . ,(make-type 'builtin 2 #f))
-    ("unsigned short int" . ,(make-type 'builtin 2 #f))
-    ("unsigned" . ,(make-type 'builtin 4 #f))
-    ("unsigned int" . ,(make-type 'builtin 4 #f))
-    ("unsigned long" . ,(make-type 'builtin 4 #f))
+    ("unsigned char" . ,(make-type 'unsigned 1 #f))
+    ("unsigned short" . ,(make-type 'unsigned 2 #f))
+    ("unsigned short int" . ,(make-type 'unsigned 2 #f))
+    ("unsigned" . ,(make-type 'unsigned 4 #f))
+    ("unsigned int" . ,(make-type 'unsigned 4 #f))
+    ("unsigned long" . ,(make-type 'unsigned 4 #f))
 
     ;; ("unsigned long long" . ,(make-type 'builtin 8 #f))
     ;; ("unsigned long long int" . ,(make-type 'builtin 8 #f))
-    ("unsigned long long" . ,(make-type 'builtin 4 #f)) ;; FIXME
-    ("unsigned long long int" . ,(make-type 'builtin 4 #f))
+    ("unsigned long long" . ,(make-type 'unsigned 4 #f)) ;; FIXME
+    ("unsigned long long int" . ,(make-type 'unsigned 4 #f))
 
-    ("float" . ,(make-type 'builtin 4 #f))
-    ("double" . ,(make-type 'builtin 8 #f))
-    ("long double" . ,(make-type 'builtin 16 #f))))
+    ("float" . ,(make-type 'float 4 #f))
+    ("double" . ,(make-type 'float 8 #f))
+    ("long double" . ,(make-type 'float 16 #f))))
+
+(define (signed? o)
+  (eq? ((compose type:type ->type) o) 'signed))
+
+(define (unsigned? o)
+  (eq? ((compose type:type ->type) o) 'unsigned))
+
+(define (->size o)
+  (cond ((and (type? o) (eq? (type:type o) 'union))
+         (apply max (map (compose ->size cdr) (struct->fields o))))
+        ((type? o) (type:size o))
+        ((pointer? o) %pointer-size)
+        ((c-array? o) (* (c-array:count o) ((compose ->size c-array:type) o)))
+        ((local? o) ((compose ->size local:type) o))
+        ((global? o) ((compose ->size global:type) o))
+        ((bit-field? o) ((compose ->size bit-field:type) o))
+        ((and (pair? o) (pair? (car o)) (bit-field? (cdar o))) ((compose ->size cdar) o))
+        ;; FIXME
+        ;; (#t
+        ;;  (stderr "o=~s\n" o)
+        ;;  (format (current-error-port) "->size: not a <type>: ~s\n" o)
+        ;;  4)
+        (else (error "->size>: not a <type>:" o))))
 
 (define (ast->type o info)
   (define (type-helper o info)
   (let* ((type (local:type o)))
     (cond ((or (c-array? type)
                (structured-type? type)) (wrap-as (i386:local-ptr->accu (local:id o))))
-          (else (let ((size (->size o)))
-                  (wrap-as (case size
-                             ((1) (i386:byte-local->accu (local:id o)))
-                             ((2) (i386:word-local->accu (local:id o)))
-                             (else (i386:local->accu (local:id o))))))))))
+          (else (append (wrap-as (i386:local->accu (local:id o)))
+                        (convert-accu type))))))
 
 (define (global->accu o)
   (let ((type (global:type o)))
   (wrap-as (i386:value->accu v)))
 
 (define (accu->local+n-text local n)
-  (let* ((type (local:type local))
-         (ptr (->rank local))
-         (size (if (= ptr -1) ((compose type:size local:type) local)
-                   4))
-         (id (local:id local)))
-    (wrap-as (case size
-               ((1) (i386:byte-accu->local+n id n))
-               ((2) (i386:word-accu->local+n id n))
-               (else (i386:accu->local+n id n))))))
+  (let ((id (local:id local))) (wrap-as (i386:accu->local+n id n))))
 
 (define (accu->ident info)
   (lambda (o)
 
         ((array-ref ,index ,array)
          (let* ((info (expr->accu* o info))
-                (size (ast->size o info)))
-           (append-text info (wrap-as (case size
-                                        ((1) (i386:byte-mem->accu))
-                                        ((2) (i386:word-mem->accu))
-                                        ((4) (i386:mem->accu))
-                                        (else '()))))))
+                (type (ast->type o info)))
+           (append-text info (mem->accu type))))
 
         ((d-sel ,field ,struct)
          (let* ((info (expr->accu* o info))
                 (size (->size type))
                 (array? (c-array? type)))
            (if array? info
-               (append-text info (wrap-as (case size
-                                            ((1) (i386:byte-mem->accu))
-                                            ((2) (i386:word-mem->accu))
-                                            ((4) (i386:mem->accu))
-                                            (else '())))))))
+               (append-text info (mem->accu type)))))
 
         ((i-sel ,field ,struct)
          (let* ((info (expr->accu* o info))
                 (size (->size type))
                 (array? (c-array? type)))
            (if array? info
-               (append-text info (wrap-as (case size
-                                            ((1) (i386:byte-mem->accu))
-                                            ((2) (i386:word-mem->accu))
-                                            ((4) (i386:mem->accu))
-                                            (else '())))))))
+               (append-text info (mem->accu type)))))
 
         ((de-ref ,expr)
          (let* ((info (expr->accu expr info))
-                (size (ast->size o info)))
-           (append-text info (wrap-as (case size
-                                        ((1) (i386:byte-mem->accu))
-                                        ((2) (i386:word-mem->accu))
-                                        ((4) (i386:mem->accu))
-                                        (else '()))))))
+                (type (ast->type o info)))
+           (append-text info (mem->accu type))))
 
         ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
          (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
            info))
 
         ((cast ,type ,expr)
-         (expr->accu expr info))
+         (let ((info (expr->accu expr info))
+               (type (ast->type o info)))
+           (append-text info (convert-accu type))))
 
         ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
          (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
       (if (null? (.post info)) info
           (append-text (clone info #:post '()) (.post info))))))
 
+(define (mem->accu type)
+  (let ((size (->size type)))
+    (case size
+      ((1) (append (wrap-as (i386:byte-mem->accu)) (convert-accu type)))
+      ((2) (append (wrap-as (i386:word-mem->accu)) (convert-accu type)))
+      ((4) (wrap-as (i386:mem->accu)))
+      (else '()))))
+
+(define (convert-accu type)
+  (if (not (type? type)) '()
+      (let ((sign (signed? type))
+            (size (->size type)))
+        (cond ((and (= size 1) sign)
+               (wrap-as (i386:signed-byte-accu)))
+              ((= size 1)
+               (wrap-as (i386:byte-accu)))
+              ((and (= size 2) sign)
+               (wrap-as (i386:signed-word-accu)))
+              ((= size 1)
+               (wrap-as (i386:word-accu)))
+              (else '())))))
+
 (define (expr->base o info)
   (let* ((info (append-text info (wrap-as (i386:push-accu))))
          (info (expr->accu o info))
                    decls))
       (_ (error "struct-field: not supported: " o)))))
 
-(define (->size o)
-  (cond ((and (type? o) (eq? (type:type o) 'union))
-         (apply max (map (compose ->size cdr) (struct->fields o))))
-        ((type? o) (type:size o))
-        ((pointer? o) %pointer-size)
-        ((c-array? o) (* (c-array:count o) ((compose ->size c-array:type) o)))
-        ((local? o) ((compose ->size local:type) o))
-        ((global? o) ((compose ->size global:type) o))
-        ((bit-field? o) ((compose ->size bit-field:type) o))
-        ((and (pair? o) (pair? (car o)) (bit-field? (cdar o))) ((compose ->size cdar) o))
-        ;; FIXME
-        ;; (#t
-        ;;  (stderr "o=~s\n" o)
-        ;;  (format (current-error-port) "->size: not a <type>: ~s\n" o)
-        ;;  4)
-        (else (error "->size>: not a <type>:" o))))
-
 (define (local-var? o) ;; formals < 0, locals > 0
   (positive? (local:id o)))
 
index f1a432686d634bbfc375f58060df654fef7a26c2..84f1c3a9e66981c76d62c5ed4920f5a71d811aa2 100644 (file)
 (define (->type o)
   (cond ((type? o) o)
         ((bit-field? o) o)
-        ((pointer? o) (pointer:type o))
-        ((c-array? o) (c-array:type o))
+        ((pointer? o) ((compose ->type pointer:type) o))
+        ((c-array? o) ((compose ->type c-array:type) o))
         ((and (pair? o) (eq? (car o) 'tag)) o)
         ;; FIXME
         (#t
index f6d5ed53c4f6e4973d0c3a8db101aeca86f3e54d..fe2463a59915614ea9c2c0ce6a9169ea1c526fe1 100644 (file)
     `(,(if (< (abs n) #x80) `("mov____%eax,0x8(%ebp)" (#:immediate1 ,n))
            `("mov____%eax,0x32(%ebp)" (#:immediate ,n))))))
 
-(define (i386:byte-accu->local+n id n)
-  (let ((n (+ (- 0 (* 4 id)) n)))
-    `(,(if (< (abs n) #x80) `("mov____%al,0x8(%ebp)" (#:immediate1 ,n))
-           `("mov____%al,0x32(%ebp)" (#:immediate ,n))))))
-
-(define (i386:word-accu->local+n id n)
-  (let ((n (+ (- 0 (* 4 id)) n)))
-    `(,(if (< (abs n) #x80) `("mov____%ax,0x8(%ebp)" (#:immediate1 ,n))
-           `("mov____%ax,0x32(%ebp)" (#:immediate ,n))))))
-
 (define (i386:accu*n->local i n)
   (or n (error "invalid value: accu->local: " n))
   (let ((o (- 0 (* 4 i))))
     ,(if (< (abs n) #x80) `("add____$i8,%eax" (#:immediate1 ,n))
          `("add____$i32,%eax" (#:immediate ,n))))))
 
-(define (i386:byte-local->accu n)
-  (or n (error "invalid value: byte-local->accu: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("movzbl_0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("movzbl_0x32(%ebp),%eax" (#:immediate ,n))))))
-
-(define (i386:word-local->accu n)
-  (or n (error "invalid value: word-local->accu: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("movzwl_0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("movzwl_0x32(%ebp),%eax" (#:immediate ,n))))))
-
 (define (i386:byte-local->base n)
   (or n (error "invalid value: byte-local->base: " n))
   (let ((n (- 0 (* 4 n))))
 
 (define (i386:accu<->stack)
   '(("xchg___%eax,(%esp)")))            ; xchg   %eax,(%esp)
+
+(define (i386:byte-accu)
+  '(("movzbl_%al,%eax")))
+
+(define (i386:signed-byte-accu)
+  '(("movsbl_%al,%eax")))
+
+(define (i386:word-accu)
+  '(("movzwl_%ax,%eax")))
+
+(define (i386:signed-word-accu)
+  '(("movswl_%ax,%eax")))
index 30a34b2d00f805d57e14e025bd67ec4373824bc6..97773e2fb311ae07c5e94989912a82d6e2c2185d 100644 (file)
@@ -45,8 +45,6 @@
             i386:accu->label
             i386:accu->local
             i386:accu->local+n
-            i386:byte-accu->local+n
-            i386:word-accu->local+n
             i386:accu->local+n
             i386:accu-and
             i386:accu-and-base
@@ -81,8 +79,6 @@
             i386:byte-base->accu-mem+n
             i386:byte-base-mem->accu
             i386:byte-base-sub
-            i386:byte-local->accu
-            i386:word-local->accu
             i386:byte-local->base
             i386:byte-mem->accu
             i386:word-mem->accu
             i386:l?->accu
             i386:le?->accu
             i386:z->accu
+            i386:byte-accu
+            i386:signed-byte-accu
+            i386:word-accu
+            i386:signed-word-accu
             ))
 
 (cond-expand
diff --git a/scaffold/tests/7r-sign-extend.c b/scaffold/tests/7r-sign-extend.c
new file mode 100644 (file)
index 0000000..96b2fe2
--- /dev/null
@@ -0,0 +1,104 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * 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.
+ *
+ * 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+char global_c = -1;
+struct foo {char type;};
+int
+main ()
+{
+  {
+    char c = -1;
+    int i = c;
+    if (i != -1)
+      return 1;
+  }
+
+  {
+    int i = global_c;
+    if (i != -1)
+      return 2;
+  }
+
+  {
+    char c = -1;
+    int ints[2] = {c, 0};
+    if (ints[0] != -1)
+      return 3;
+  }
+
+  {
+    char c = -1;
+    int i = c;
+    if (i != -1)
+      return 4;
+  }
+
+  {
+    char c = -1;
+    int i = c;
+    if (i != -1)
+      return 5;
+  }
+
+  {
+    char a[2] = {-1, -129};
+    int i = a[0];
+    if (i != -1)
+      return 6;
+    if (a[0] != -1)
+      return 7;
+  }
+
+  {
+    struct foo f = {-1};
+    int i = f.type;
+    if (i != -1)
+      return 8;
+
+    struct foo *g = &f;
+    i = g->type;
+    if (i != -1)
+      return 9;
+  }
+
+  {
+    char c = -1;
+    char *p = &c;
+    int i = *p;
+    if (i != -1)
+      return 10;
+  }
+
+  {
+    int i = -129;
+    i = (char)i;
+    if (i != 127)
+      return 11;
+  }
+
+  {
+    unsigned char b = -129;
+    int i = b;
+    if (i != 127)
+      return 12;
+  }
+
+  return 0;
+}
index 84a92e2e0ac4ffa4b577c692011d07d947122420..672216e9398dc70331655fd9a913f7fec4760495 100644 (file)
@@ -79,13 +79,9 @@ DEFINE mov____$i32,0x32 c705
 DEFINE mov____$i32,0x8(%eax) c740
 DEFINE mov____$i32,0x8(%ebp) c745
 DEFINE mov____%al,(%edx) 8802
-DEFINE mov____%al,0x32(%ebp) 8885
-DEFINE mov____%al,0x8(%ebp) 8845
 DEFINE mov____%al,0x8(%edx) 8842
 DEFINE mov____%ax,(%edx) 668902
-DEFINE mov____%ax,0x32(%ebp) 668985
 DEFINE mov____%ax,0x32(%edx) 668982
-DEFINE mov____%ax,0x8(%ebp) 668945
 DEFINE mov____%ax,0x8(%edx) 668942
 DEFINE mov____%dl,(%eax) 8810
 DEFINE mov____%dl,0x8(%eax) 8850
@@ -141,21 +137,22 @@ DEFINE mov____0x8(%ebp),%ebx 8b5d
 DEFINE mov____0x8(%ebp),%ecx 8b4d
 DEFINE mov____0x8(%ebp),%edx 8b55
 DEFINE mov____0x8(%ebp),%esp 8b65
+DEFINE movsbl_%al,%eax 0fbec0
+DEFINE movswl_%ax,%eax 0fbfc0
+DEFINE movzbl_%al,%eax 0fb6c0
 DEFINE movzbl_%al,%eax 0fb6c0
 DEFINE movzbl_%dl,%edx 0fb6d2
 DEFINE movzbl_(%eax),%eax 0fb600
 DEFINE movzbl_(%eax),%edx 0fb610
 DEFINE movzbl_(%edx),%edx 0fb612
 DEFINE movzbl_0x32(%eax),%eax 0fb680
-DEFINE movzbl_0x32(%ebp),%eax 0fb685
 DEFINE movzbl_0x8(%eax),%eax 0fb640
 DEFINE movzbl_0x8(%ebp),%eax 0fb645
-DEFINE movzbl_0x8(%ebp),%edx 0fb655
+DEFINE movzwl_%ax,%eax 0fb7c0
 DEFINE movzwl_(%eax),%eax 0fb700
 DEFINE movzwl_0x32(%eax),%eax 0fb780
 DEFINE movzwl_0x32(%ebp),%eax 0fb785
 DEFINE movzwl_0x8(%eax),%eax 0fb740
-DEFINE movzwl_0x8(%ebp),%eax 0fb745
 DEFINE mul____%edx f7e2
 DEFINE nop 90
 DEFINE not____%eax f7d0
@@ -199,6 +196,16 @@ DEFINE xor____%ecx,%ecx 31c9
 DEFINE xor____%edx,%eax 31d0
 DEFINE xor____%edx,%edx 31d2
 
+# Deprecated.  Remove after 0.14 release.
+DEFINE mov____%al,0x32(%ebp) 8885
+DEFINE mov____%al,0x8(%ebp) 8845
+DEFINE mov____%ax,0x32(%ebp) 668985
+DEFINE mov____%ax,0x8(%ebp) 668945
+DEFINE movzbl_0x32(%ebp),%eax 0fb685
+DEFINE movzbl_0x8(%ebp),%edx 0fb655
+DEFINE movzwl_0x8(%ebp),%eax 0fb745
+DEFINE movzwl_0x8(%ebp),%eax 0fb745
+
 DEFINE SYS_exit   01000000
 DEFINE SYS_read   03000000
 DEFINE SYS_write  04000000