diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh
index e2fe6c7f..a4ce7a53 100755
--- 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
diff --git a/lib/x86-mes/x86.M1 b/lib/x86-mes/x86.M1
index 937191a3..23d85f4f 100644
--- a/lib/x86-mes/x86.M1
+++ b/lib/x86-mes/x86.M1
@@ -17,7 +17,8 @@
### along with GNU Mes. If not, see .
# 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
diff --git a/lib/x86_64-mes/x86_64.M1 b/lib/x86_64-mes/x86_64.M1
index ba80c46f..8b5a41cd 100644
--- 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
diff --git a/module/mescc/M1.scm b/module/mescc/M1.scm
index aa76f249..03a44e0c 100644
--- 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 ) 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)))
diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm
index aefa580d..f04ffdee 100644
--- a/module/mescc/compile.scm
+++ b/module/mescc/compile.scm
@@ -61,7 +61,8 @@
(define (clean-info o)
(make
#: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))))
diff --git a/module/mescc/i386/as.scm b/module/mescc/i386/as.scm
index 836789d3..e544a3b9 100644
--- 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)
diff --git a/module/mescc/mescc.scm b/module/mescc/mescc.scm
index 39f6c465..be06d943 100644
--- 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))))
diff --git a/module/mescc/x86_64/as.scm b/module/mescc/x86_64/as.scm
index ca1982a9..29109dca 100644
--- 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)
(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
index 00000000..1d40bf52
--- /dev/null
+++ 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
+ *
+ * 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 .
+ */
+
+#include
+
+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
index 00000000..8e58981e
--- /dev/null
+++ 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
+ *
+ * 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 .
+ */
+
+#include
+
+#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;
+}
diff --git a/scripts/mescc.in b/scripts/mescc.in
index 3a3157f1..050382ca 100755
--- 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]