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.

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

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

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

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))))
+        (let ((alignment (- reg-size (modulo size reg-size))))
-          (when (> 4 alignment 0)
+          (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)))

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))
+           (lambda (global) (let* ((size (->size global info))
-                                  (r-size (->size "*" info)))
+                                   (reg-size (->size "*" info))
-                              (wrap-as (as info 'r->label global)) )))
+                                   (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))
+           (lambda (global) (let* ((size (->size global info))
-                                  (r-size (->size "*" info)))
+                                   (reg-size (->size "*" info))
-                              (wrap-as (as info 'r->label global))))))))
+                                   (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
+           (lambda (global)
-                                      (as info 'label-mem-add `(#:address ,o) n)))))
+             (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
+           (lambda (global)
-                                      (as info 'label-mem-add `(#:address ,global) n))))))))
+             (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))))

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)

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

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)

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

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

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]