mescc: Support --align, off by default.

* 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.
2018-10-06 15:56:14 +02:00 · 2018-10-06 15:56:14 +02:00 · d862f1eceb
parent 3584f45056
commit d862f1eceb
11 changed files with 182 additions and 29 deletions
--- a/build-aux/check-mescc.sh
+++ b/build-aux/check-mescc.sh
@ -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
--- a/lib/x86-mes/x86.M1
+++ b/lib/x86-mes/x86.M1
@ -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
--- a/lib/x86_64-mes/x86_64.M1
+++ b/lib/x86_64-mes/x86_64.M1
@ -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
--- a/module/mescc/M1.scm
+++ b/module/mescc/M1.scm
@ -35,14 +35,15 @@
            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))
@ -96,12 +97,13 @@
          (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
@ -194,10 +196,11 @@
                    ((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)))
--- a/module/mescc/compile.scm
+++ b/module/mescc/compile.scm
@ -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))
@ -520,14 +521,26 @@
                             (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)
@ -536,12 +549,28 @@
           (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))))
--- a/module/mescc/i386/as.scm
+++ b/module/mescc/i386/as.scm
@ -299,6 +299,16 @@
  (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))
@ -567,9 +577,11 @@
    (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)
--- a/module/mescc/mescc.scm
+++ b/module/mescc/mescc.scm
@ -69,11 +69,12 @@
                                   (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)
@ -153,11 +154,12 @@
         (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))))

--- a/module/mescc/x86_64/as.scm
+++ b/module/mescc/x86_64/as.scm
@ -376,6 +376,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))
@ -635,7 +650,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)
@ -689,9 +703,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)
@ -715,6 +732,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)
--- a/scaffold/tests/a1-global-no-align.c
+++ b/scaffold/tests/a1-global-no-align.c
@ -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;
+}
--- a/scaffold/tests/a1-global-no-clobber.c
+++ b/scaffold/tests/a1-global-no-clobber.c
@ -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;
+}
--- a/scripts/mescc.in
+++ b/scripts/mescc.in
@ -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]