* 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.
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
### 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
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
#DEFINE xor____%edx,%eax 31d0
-
-
# deprecated, remove after 0.18
DEFINE sub____%esp,$i32 81ec
DEFINE sub____%esp,$i8 83ec
# 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
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
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
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)))
(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))))
(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)
(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))))
(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)
--- /dev/null
+/* -*-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;
+}
--- /dev/null
+/* -*-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;
+}
(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))
(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]
projects / mes.git / commitdiff