mescc: Support --align, off by default.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Oct 2018 13:56:14 +0000 (15:56 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Oct 2018 13:56:14 +0000 (15:56 +0200)
* scripts/mescc.in (parse-opts): Add --align.
* module/mescc/mescc.scm (mescc:compile): Support --align, off by
default.
* module/mescc/M1.scm (infos->M1): Add #:align parameter.
(M1:merge-infos): Likewise.  Keep types.
(info->M1): Likewise.  Make alignment switchable.
* module/mescc/compile.scm (r->ident):  Do not clobber.
(ident-add): Likewise.
(clean-info): Keep types.
* module/mescc/i386/as.scm (i386:r->byte-label): New instruction.
* lib/x86-mes/x86.M1: Add instructions.
* lib/x86_64-mes/x86_64.M1: Add instructions.
* module/mescc/x86_64/as.scm (x86_64:r->byte-label,
x86_64:r->word-label, x86_64:r->long-label): New instruction.

build-aux/check-mescc.sh
lib/x86-mes/x86.M1
lib/x86_64-mes/x86_64.M1
module/mescc/M1.scm
module/mescc/compile.scm
module/mescc/i386/as.scm
module/mescc/mescc.scm
module/mescc/x86_64/as.scm
scaffold/tests/a1-global-no-align.c [new file with mode: 0644]
scaffold/tests/a1-global-no-clobber.c [new file with mode: 0644]
scripts/mescc.in

index e2fe6c7f04390d9cfab95748e748ae4be8bdb0bc..a4ce7a53233c46f31206e0671488762d30ee347f 100755 (executable)
@@ -222,12 +222,15 @@ t
 a0-call-trunc-char
 a0-call-trunc-short
 a0-call-trunc-int
+a1-global-no-align
+a1-global-no-clobber
 "
 
 broken="$broken
 17-compare-unsigned-char-le
 17-compare-unsigned-short-le
 66-local-char-array
+a0-call-trunc-int
 "
 
 # gcc not supported
index 937191a3d9649e559c722d4549391cdd57be9f78..23d85f4fe1586e91c4613484fa49d8ef0e046d23 100644 (file)
@@ -17,7 +17,8 @@
 ### along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 # reduced instruction set: eax, ebx (some ecx for shift, edx for mul, div)
-# 182 instructions
+# 185 instructions
+
 DEFINE add____$i32,%eax 05
 DEFINE add____$i32,%ebx 81c3
 DEFINE add____$i32,(%eax) 8100
@@ -120,18 +121,22 @@ DEFINE mov____0x8(%ebp),%edi 8b7d
 DEFINE mov____0x8(%ebp),%edx 8b55
 DEFINE mov____0x8(%ebp),%esi 8b75
 DEFINE mov____0x8(%ebp),%esp 8b65
+DEFINE movb___%al,0x32 a2
 DEFINE movsbl_%al,%eax 0fbec0
 DEFINE movsbl_%bl,%ebx 0fbedb
 DEFINE movswl_%ax,%eax 0fbfc0
 DEFINE movswl_%bx,%ebx 0fbfdb
+DEFINE movw___%ax,0x32 66a3
 DEFINE movzbl_%al,%eax 0fb6c0
 DEFINE movzbl_%bl,%ebx 0fb6db
+DEFINE movzbl_%bl,%ebx 0fb6db
 DEFINE movzbl_(%eax),%eax 0fb600
 DEFINE movzbl_(%ebx),%ebx 0fb61b
 DEFINE movzbl_0x32(%eax),%eax 0fb680
 DEFINE movzbl_0x8(%eax),%eax 0fb640
 DEFINE movzbl_0x8(%ebp),%eax 0fb645
 DEFINE movzwl_%ax,%eax 0fb7c0
+DEFINE movzwl_%bx,%ebx 0fb7db
 DEFINE movzwl_(%eax),%eax 0fb700
 DEFINE movzwl_(%ebx),%ebx 0fb71b
 DEFINE movzwl_0x32(%eax),%eax 0fb780
@@ -303,8 +308,6 @@ DEFINE xor____%edx,%edx 31d2
 #DEFINE xor____%edx,%eax 31d0
 
 
-
-
 # deprecated, remove after 0.18
 DEFINE sub____%esp,$i32 81ec
 DEFINE sub____%esp,$i8 83ec
index ba80c46f0709e76a8084bec340c82cf1eff9a7f3..8b5a41cde359bc17e9c31db7a588c1acd41132c8 100644 (file)
@@ -18,7 +18,8 @@
 
 # reduced instruction set: rax, rdi (some rcx for shift, rdx for mul, div)
 # and r10 as i64 immediate helper
-# 202 instructions
+# 206 instructions
+
 DEFINE add____$i32,%rax 4805
 DEFINE add____$i32,%rbp 4881c5
 DEFINE add____$i32,%rdi 4881c7
@@ -141,6 +142,8 @@ DEFINE mov____0x8(%rbp),%rsp 488b65
 DEFINE mov____0x8(%rdi),%rax 488b47
 DEFINE mov____0x8(%rdi),%rbp 488b6f
 DEFINE mov____0x8(%rdi),%rsp 488b67
+DEFINE movl___%eax,0x32 890425
+DEFINE movl___%edi,0x32 893c25
 DEFINE movsbq_%al,%rax 480fbec0
 DEFINE movsbq_%dil,%rdi 480fbeff
 DEFINE movsbq_(%rax),%rax 480fbe00
@@ -153,6 +156,8 @@ DEFINE movswq_%ax,%rax 480fbfc0
 DEFINE movswq_%di,%rdi 480fbfff
 DEFINE movswq_(%rax),%rax 480fbf00
 DEFINE movswq_(%rdi),%rdi 480fbf3f
+DEFINE movw___%ax,0x32 66890425
+DEFINE movw___%di,0x32 66893c25
 DEFINE movz___(%rax),%rax 480fb600
 DEFINE movzbq_%al,%rax 480fb6c0
 DEFINE movzbq_%dil,%rdi 480fb6ff
index aa76f24992310098ad5f0b4d4dfe30f7390efc00..03a44e0c6757923a5b7f398c6740579ae9130850 100644 (file)
             infos->M1
             M1:merge-infos))
 
-(define (infos->M1 file-name infos)
+(define* (infos->M1 file-name infos #:key align?)
   (let ((info (fold M1:merge-infos (make <info>) infos)))
-    (info->M1 file-name info)))
+    (info->M1 file-name info #:align? align?)))
 
 (define (M1:merge-infos o info)
   (clone info
          #:functions (alist-add (.functions info) (.functions o))
-         #:globals (alist-add (.globals info) (.globals o))))
+         #:globals (alist-add (.globals info) (.globals o))
+         #:types (.types o)))
 
 (define (alist-add a b)
   (let* ((b-keys (map car b))
           (display sep))
       (loop (cdr o)))))
 
-(define (info->M1 file-name o)
+(define* (info->M1 file-name o #:key align?)
   (let* ((functions (.functions o))
          (function-names (map car functions))
          (globals (.globals o))
          (global-names (map car globals))
-         (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)))
+         (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names))
+         (reg-size (type:size (assoc-ref (.types o) "*"))))
     (define (string->label o)
       (let ((index (list-index (lambda (s) (equal? s o)) strings)))
         (if index
                     ((equal? string-label "%0") o) ;; FIXME: 64b
                     (else (string-append "&" label))))))
       (define (display-align size)
-        (let ((alignment (- 4 (modulo size 4))))
-          (when (> 4 alignment 0)
+        (let ((alignment (- reg-size (modulo size reg-size))))
+          (when (and align? (> reg-size alignment 0))
             (display " ")
-            (display-join (map text->M1 (map (const 0) (iota alignment))) " "))))
+            (display-join (map text->M1 (map (const 0) (iota alignment))) " "))
+          #t))
       (let* ((label (cond
                      ((and (pair? (car o)) (eq? (caar o) #:string))
                       (string->label (car o)))
index aefa580d2e68f91e0f0ff23964601842dd3b0e21..f04ffdeeacd8f21fc3a28cc3ed8d1f93848083cb 100644 (file)
@@ -61,7 +61,8 @@
 (define (clean-info o)
   (make <info>
     #:functions (filter (compose pair? function:text cdr) (.functions o))
-    #:globals (.globals o)))
+    #:globals (.globals o)
+    #:types (.types o)))
 
 (define (ident->constant name value)
   (cons name value))
                              (wrap-as (as info 'r->local (local:id local))))))
           ((assoc-ref (.statics info) o)
            =>
-           (lambda (global) (let ((size (->size global info))
-                                  (r-size (->size "*" info)))
-                              (wrap-as (as info 'r->label global)) )))
+           (lambda (global) (let* ((size (->size global info))
+                                   (reg-size (->size "*" info))
+                                   (size (if (= size reg-size) 0 size)))
+                              (case size
+                                ((0) (wrap-as (as info 'r->label global)))
+                                ((1) (wrap-as (as info 'r->byte-label global)))
+                                ((2) (wrap-as (as info 'r->word-label global)))
+                                ((4) (wrap-as (as info 'r->long-label global)))
+                                (else (wrap-as (as info 'r->label global)))))))
           ((assoc-ref (filter (negate static-global?) (.globals info)) o)
            =>
-           (lambda (global) (let ((size (->size global info))
-                                  (r-size (->size "*" info)))
-                              (wrap-as (as info 'r->label global))))))))
+           (lambda (global) (let* ((size (->size global info))
+                                   (reg-size (->size "*" info))
+                                   (size (if (= size reg-size) 0 size)))
+                              (case size
+                                ((0) (wrap-as (as info 'r->label global)))
+                                ((1) (wrap-as (as info 'r->byte-label global)))
+                                ((2) (wrap-as (as info 'r->word-label global)))
+                                ((4) (wrap-as (as info 'r->long-label global)))
+                                (else (wrap-as (as info 'r->label global))))))))))
 
 (define (ident-add info)
   (lambda (o n)
            (lambda (local) (wrap-as (as info 'local-add (local:id local) n))))
           ((assoc-ref (.statics info) o)
            =>
-           (lambda (global) (wrap-as (append
-                                      (as info 'label-mem-add `(#:address ,o) n)))))
+           (lambda (global)
+             (let* ((size (->size global info))
+                    (reg-size (->size "*" info))
+                    (size (if (= size reg-size) 0 size)))
+               (case size
+                 ((0) (wrap-as (as info 'label-mem-add `(#:address ,o) n)))
+                 ((1) (wrap-as (as info 'byte-label-mem-add `(#:address ,o) n)))
+                 ((2) (wrap-as (as info 'word-label-mem-add `(#:address ,o) n)))
+                 ((4) (wrap-as (as info 'long-mem-add `(#:address ,o) n)))
+                 (else (as info 'label-mem-add `(#:address ,o) n))))))
           ((assoc-ref (filter (negate static-global?) (.globals info)) o)
            =>
-           (lambda (global) (wrap-as (append
-                                      (as info 'label-mem-add `(#:address ,global) n))))))))
+           (lambda (global)
+             (let* ((size (->size global info))
+                    (reg-size (->size "*" info))
+                    (size (if (= size reg-size) 0 size)))
+               (case size
+                 ((0) (wrap-as (as info 'label-mem-add `(#:address ,o) n)))
+                 ((1) (wrap-as (as info 'byte-label-mem-add `(#:address ,o) n)))
+                 ((2) (wrap-as (as info 'word-label-mem-add `(#:address ,o) n)))
+                 ((4) (wrap-as (as info 'long-mem-add `(#:address ,o) n)))
+                 (else (as info 'label-mem-add `(#:address ,o) n)))))))))
 
 (define (make-comment o)
   (wrap-as `((#:comment ,o))))
index 836789d3b69e79126718cf28e891710653f2717a..e544a3b9025f7edfdf2c9886043aebf65fce531c 100644 (file)
   (let ((r (get-r info)))
     `((,(string-append "mov____%" r ",0x32") (#:address ,label)))))
 
+(define (i386:r->byte-label info label)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "movb___%" l ",0x32") (#:address ,label)))))
+
+(define (i386:r->word-label info label)
+  (let* ((r (get-r info))
+        (x (e->x r)))
+    `((,(string-append "movw___%" x ",0x32") (#:address ,label)))))
+
 (define (i386:call-r info n)
   (let ((r (get-r info)))
     `((,(string-append "call___*%" r))
     (r+r . ,i386:r+r)
     (r+value . ,i386:r+value)
     (r->arg . ,i386:r->arg)
+    (r->byte-label . ,i386:r->byte-label)
     (r->label . ,i386:r->label)
     (r->local . ,i386:r->local)
     (r->local+n . ,i386:r->local+n)
+    (r->word-label . ,i386:r->word-label)
     (r-and . ,i386:r-and)
     (r-byte-mem-add . ,i386:r-byte-mem-add)
     (r-cmp-value . ,i386:r-cmp-value)
index 39f6c46570eec7f983febf39d46a952ffeaeb8fe..be06d943feed9f09e9558bfe097d9685669b50b9 100644 (file)
                                    (option-ref options 'output #f)))
                              (else (replace-suffix input-file-name ".S"))))
          (infos (map (cut file->info options <>) files))
-         (verbose? (option-ref options 'verbose #f)))
+         (verbose? (option-ref options 'verbose #f))
+         (align? (option-ref options 'align #f)))
     (when verbose?
       (stderr "dumping: ~a\n" M1-file-name))
     (with-output-to-file M1-file-name
-      (cut infos->M1 M1-file-name infos))
+      (cut infos->M1 M1-file-name infos #:align? align?))
     M1-file-name))
 
 (define (file->info options file-name)
          (M1-file-name (replace-suffix hex2-file-name ".S"))
          (options (acons 'compile #t options)) ; ugh
          (options (acons 'output hex2-file-name options))
-         (verbose? (option-ref options 'verbose #f)))
+         (verbose? (option-ref options 'verbose #f))
+         (align? (option-ref options 'align #f)))
     (when verbose?
       (stderr "dumping: ~a\n" M1-file-name))
     (with-output-to-file M1-file-name
-      (cut infos->M1 M1-file-name infos))
+      (cut infos->M1 M1-file-name infos #:align? align?))
     (or (M1->hex2 options (list M1-file-name))
         (exit 1))))
 
index ca1982a9eb2bcbbaf0bba0da96395453ce09b5fd..29109dcaf471dab09cd8e82426a891b312afeb2b 100644 (file)
   (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))
 
 (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)
     (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)
     (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)
diff --git a/scaffold/tests/a1-global-no-align.c b/scaffold/tests/a1-global-no-align.c
new file mode 100644 (file)
index 0000000..1d40bf5
--- /dev/null
@@ -0,0 +1,34 @@
+/* -*-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/>.
+ */
+
+#include <libmes.h>
+
+short foo;
+short bar;
+int *baz = &foo;
+
+int
+main ()
+{
+  *baz = -1;
+  if (!bar)
+    return 1;
+  return 0;
+}
diff --git a/scaffold/tests/a1-global-no-clobber.c b/scaffold/tests/a1-global-no-clobber.c
new file mode 100644 (file)
index 0000000..8e58981
--- /dev/null
@@ -0,0 +1,42 @@
+/* -*-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/>.
+ */
+
+#include <libmes.h>
+
+#if __i386__
+short foo;
+short bar;
+#else
+// more interesting test for x86_64
+int foo;
+int bar;
+#endif
+
+int
+main ()
+{
+  foo = -1;
+  if (bar)
+    return 1;
+  foo += -1;
+  if (bar)
+    return 1;
+  return 0;
+}
index 3a3157f1612ef9791f1111daeac23c46da288181..050382caf78911cf32e51b6f71613bdd1eca5738 100755 (executable)
@@ -72,7 +72,8 @@ fi
 
 (define (parse-opts args)
   (let* ((option-spec
-          '((assemble (single-char #\c))
+          '((align)
+            (assemble (single-char #\c))
             (base-address (value #t))
             (compile (single-char #\S))
             (define (single-char #\D) (value #t))
@@ -98,6 +99,7 @@ fi
      (and (or help? usage?)
           (format (or (and usage? (current-error-port)) (current-output-port)) "\
 Usage: mescc [OPTION]... FILE...
+  --align            align globals
   -c                 preprocess, compile and assemble only; do not link
   --base-address=ADRRESS
                      use BaseAddress ADDRESS [0x1000000]