* scaffold/t.c: New file.
* GNUmakefile (mescc-check, t-check): New targets.
* module/language/c99/compiler.mes (write-any): Catch weirdness.
(make): Add <function> slot.
(.function): New accessor.
(clone): Handle it.
(function->info): Set it.
(ast->info): Make tests generic in if, for, while. Add goto, label,
!, ==, !=, -, &&.
* module/mes/elf-util.mes (lambda/label->list): New function.
(text->list): Use it.
(functions->text, function-prefix): New function.
(function-offset): Use it.
(label-offset): New function.
* module/mes/elf-util.scm (mes): Export them.
* module/mes/elf.mes (make-elf): Use text->list.
* module/mes/libc-i386.mes (eputs, puts): Remove.
(i386:byte-base-sub): Rename from sub-byte-base.
(i386:byte-jump-z): Rename from i386:Xjump-byte-z.
(i386:byte-mem->accu): Rename from i386:Xmem-byte->accu.
(i386:byte-mem->base): Rename from i386:Xmem-byte->base.
(i386:accu->local, i386:accu-non-zero?, i386:accu-zero?,
i386:base-sub, i386:byte-sub-base, i386:jump-c, i386:jump-cz,
i386:jump-nc, i386:jump-ncz, i386:byte-mem->base, i386:sub-base,
i386:test-accu, i386:test-base, i386:test-jump-z, i386:value->base,
i386:xor-zf): New functions.
mes.o: posix.c posix.h posix.i posix.environment.i
mes.o: reader.c reader.h reader.i reader.environment.i
-mini-mes: doc/examples/mini-mes.c GNUmakefile
- rm -f $@
- gcc -nostdlib --std=gnu99 -m32 -g -o mini-mes '-DVERSION="0.4"' $<
- chmod +x $@
-
-micro-mes: doc/examples/micro-mes.c GNUmakefile
- rm -f $@
- gcc -nostdlib --std=gnu99 -m32 -o micro-mes '-DVERSION="0.4"' $<
- chmod +x $@
-
-main: doc/examples/main.c GNUmakefile
- rm -f $@
- gcc -nostdlib --std=gnu99 -m32 -o main '-DVERSION="0.4"' $<
- chmod +x $@
-
clean:
rm -f mes mes.o *.environment.i *.symbols.i *.environment.h *.cat a.out
%.h %.i %.environment.i %.symbols.i: %.c build-aux/mes-snarf.scm
build-aux/mes-snarf.scm $<
-check: all guile-check mes-check
+check: all guile-check mes-check mescc-check
TESTS:=\
tests/read.test\
mes-check: all
set -e; for i in $(TESTS); do ./$$i; done
+
+mes-check-nyacc: all
scripts/nyacc.mes
scripts/nyacc-calc.mes
set -e; for i in $(TESTS); do\
$(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\
done
- guile/nyacc.scm
guile/nyacc-calc.scm
+t-check: t
+ ./t
+
+mescc-check: t-check
+ rm -f a.out
+ guile/mescc.scm scaffold/t.c > a.out
+ chmod +x a.out
+ ./a.out
+
+mini-mes: scaffold/mini-mes.c GNUmakefile
+ rm -f $@
+ gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+ chmod +x $@
+
+micro-mes: scaffold/micro-mes.c GNUmakefile
+ rm -f $@
+ gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+ chmod +x $@
+
+main: doc/examples/main.c GNUmakefile
+ rm -f $@
+ gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+ chmod +x $@
+
+t: scaffold/t.c GNUmakefile
+ rm -f $@
+ gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+ chmod +x $@
+
MAIN_C:=doc/examples/main.c
mescc: all $(MAIN_C)
rm -f a.out
-#if __GNUC__
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * 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.
+ *
+ * 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 Mes. If not, see <http://www.gnu.org/licenses/>.
+ */
+#if __GNUC__
void
write (int fd, char const* s, int n)
{
write (1, s, i);
return 0;
}
+
+int
+strcmp (char const* a, char const* b)
+{
+ while (*a && *b && *a == *b) {a++;b++;}
+ return *a - *b;
+}
#endif
int
-main ()
+//main ()
+main (int argc, char *argv[])
{
+ int i = 0;
+ if (argc > 1 && !strcmp (argv[1], "--help")) puts ("argc > 1 && --help\n");
puts ("Hi Mes!\n");
- for (int i = 0; i < 4; ++i)
- puts (" Hello, world!\n");
return 42;
}
void
_start ()
{
- int r=main ();
+ // int r=main ();
+ // exit (r);
+ int r;
+ asm (
+ "mov %%ebp,%%eax\n\t"
+ "addl $8,%%eax\n\t"
+ "push %%eax\n\t"
+
+ "mov %%ebp,%%eax\n\t"
+ "addl $4,%%eax\n\t"
+ "movzbl (%%eax),%%eax\n\t"
+ "push %%eax\n\t"
+
+ "call main\n\t"
+ "movl %%eax,%0\n\t"
+ : "=r" (r)
+ : //no inputs "" (&main)
+ );
exit (r);
}
#endif
(define (write-any x)
(write-char (cond ((char? x) x)
+ ((and (number? x) (< (+ x 256) 0)) (format (current-error-port) "***BROKEN*** x=~a\n" x) (integer->char #xaa))
((number? x) (integer->char (if (>= x 0) x (+ x 256))))
(else (stderr "write-any: ~a\n" x) barf))))
(define <functions> '<functions>)
(define <globals> '<globals>)
(define <locals> '<locals>)
+(define <function> '<function>)
(define <text> '<text>)
-(define* (make o #:key (functions '()) (globals '()) (locals '()) (text '()))
+(define* (make o #:key (functions '()) (globals '()) (locals '()) (function #f) (text '()))
(pmatch o
(<info> (list <info>
(cons <functions> functions)
(cons <globals> globals)
(cons <locals> locals)
+ (cons <function> function)
(cons <text> text)))))
(define (.functions o)
(pmatch o
((<info> . ,alist) (assq-ref alist <locals>))))
+(define (.function o)
+ (pmatch o
+ ((<info> . ,alist) (assq-ref alist <function>))))
+
(define (.text o)
(pmatch o
((<info> . ,alist) (assq-ref alist <text>))))
(let ((functions (.functions o))
(globals (.globals o))
(locals (.locals o))
+ (function (.function o))
(text (.text o)))
(let-keywords rest
#f
((functions functions)
(globals globals)
(locals locals)
+ (function function)
(text text))
- (make <info> #:functions functions #:globals globals #:locals locals #:text text))))))
+ (make <info> #:functions functions #:globals globals #:locals locals #:function function #:text text))))))
(define (ref-local locals)
(lambda (o)
(define (add-local name)
(acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))
- ;; (stderr "S=~a\n" o)
+ ;; (stderr "\nS=~a\n" o)
+ ;; (stderr " text=~a\n" text)
;; (stderr " info=~a\n" info)
;; (stderr " globals=~a\n" globals)
(pmatch o
((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
- ((expr-stmt (fctn-call (p-expr (ident ,name))
- (expr-list (p-expr (string ,string)))))
- ;;(stderr "S1 string=~a\n" string)
- (if (equal? name "asm") (clone info #:text (append text (list (lambda (f g t d) (asm->hex string)))))
- (let ((globals (append globals (list (string->global string)))))
+ ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
+ (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
+ (clone info #:text (append text (list (lambda (f g t d) (asm->hex arg0))))))
+ (let* ((globals (append globals (filter-map expr->global expr-list)))
+ (args (map (expr->arg globals locals) expr-list)))
(clone info #:text
(append text (list (lambda (f g t d)
- (i386:call f g t d
- (+ t (function-offset name f))
- (+ d (data-offset string g))))))
+ (apply i386:call (cons* f g t d
+ (+ t (function-offset name f)) args)))))
#:globals globals))))
-
- ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
- ;;(stderr "S1 expr-list=~a\n" expr-list)
- (let* ((globals (append globals (filter-map expr->global expr-list)))
- (args (map (expr->arg globals locals) expr-list)))
- (clone info #:text
- (append text (list (lambda (f g t d)
- (apply i386:call (cons* f g t d
- (+ t (function-offset name f)) args)))))
- #:globals globals)))
- ((if (gt (p-expr (ident ,name)) (p-expr (fixed ,value))) ,body)
- (let* ((value (string->number value))
- (info (clone info #:text '()))
- (body-info ((ast->info info) body))
- (body-text (.text body-info))
+ ((if ,test ,body)
+ (let* ((jump (pmatch test
+ ((lt ,a ,b) i386:jump-nc)
+ ((gt ,a ,b) i386:jump-nc)
+ (_ i386:jump-z)))
+ (jump-text (lambda (body-length)
+ (list (lambda (f g t d) (jump body-length)))))
+ (test-info ((ast->info info) test))
+ (test+jump-info (clone test-info #:text (append (.text test-info)
+ (jump-text 0))))
+ (text-length (length (.text test+jump-info)))
+ (body-info ((ast->info test+jump-info) body))
+ (body-text (list-tail (.text body-info) text-length))
(body-length (length (text->list body-text))))
(clone info #:text
- (append text
- (list (lambda (f g t d)
- (append
- (i386:local-test (assoc-ref locals name) value)
- (i386:jump-le body-length))))
+ (append (.text test-info)
+ (jump-text body-length)
body-text)
#:globals (.globals body-info))))
- ((if (not (fctn-call . ,call)) ,body)
- (let* ((call-info ((ast->info info) `(expr-stmt (fctn-call . ,call))))
- (info (clone info #:text '()))
- (body-info ((ast->info info) body))
- (body-text (.text body-info))
- (body-length (length (text->list body-text))))
+ ((for ,init ,test ,step ,body)
+ (let* ((jump (pmatch test
+ ((lt ,a ,b) i386:jump-c)
+ ((gt ,a ,b) i386:jump-c)
+ (_ i386:jump-nz)))
+ (jump-text (lambda (body-length)
+ (list (lambda (f g t d) (jump body-length)))))
- (clone info #:text
- (append (.text call-info)
- (list (lambda (f g t d)
- (append
- ;;(i386:local-test (assoc-ref locals name) 0)
- ;;(i386:accu-test (assoc-ref locals name) 0)
- (i386:jump-nz body-length))))
- body-text)
- #:globals (append (.globals call-info)
- (.globals body-info)))))
-
- (;;(for ,init ,test ,step ,body)
- (for ,init
- ;; FIXME: ,test
- (lt (p-expr (ident ,name)) (p-expr (fixed ,value)))
- ,step ,body)
- (let* ((value (string->number value))
(info (clone info #:text '()))
(info ((ast->info info) init))
(step-text (.text step-info))
(step-length (length (text->list step-text)))
- ;; (test-info ((ast->info info) test))
- ;; (test-text (.text test-info))
- ;; (test-length (length (text->list test-text)))
- )
+ (test-info ((ast->info info) test))
+ (test-text (.text test-info))
+ (test-length (length (text->list test-text))))
(clone info #:text
(append text
init-text
- (list (lambda (f g t d) (i386:jump body-length)))
+ (list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2
body-text
step-text
- ;;test-text
- ;;(list (lambda (f g t d) (i386:jump-byte-nz (- (+ body-length test-length)))))
- (list (lambda (f g t d)
- (append
- (i386:local-test (assoc-ref init-locals name) value)
- (i386:jump-le (- (+ body-length step-length 2) ;;test-length
- )))))
- )
- #:globals (append globals (.globals body-info))
+ test-text
+ (jump-text (- (+ body-length step-length test-length))))
+ #:globals (append globals (.globals body-info)) ;; FIXME
#:locals locals)))
((while ,test ,body)
- (let* ((info (clone info #:text '()))
+ (let* ((jump (pmatch test
+ ((lt ,a ,b) i386:jump-c)
+ ((gt ,a ,b) i386:jump-c)
+ ;;(_ i386:jump-nz)
+ (_ i386:jump-byte-nz) ;; FIXME
+ ))
+ (jump-text (lambda (body-length)
+ (list (lambda (f g t d) (jump body-length)))))
+
+ (info (clone info #:text '()))
(body-info ((ast->info info) body))
(body-text (.text body-info))
(body-length (length (text->list body-text)))
(clone info #:text
(append text
- (list (lambda (f g t d) (i386:jump body-length)))
+ (list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2
body-text
test-text
- (list (lambda (f g t d) (i386:jump-byte-nz (- (+ body-length test-length))))))
- #:globals (append globals (.globals body-info)))))
+ (jump-text (- (+ body-length test-length))))
+ #:globals (.globals body-info))))
+
+ ((labeled-stmt (ident ,label) ,statement)
+ (let ((info (clone info #:text (append text (list label)))))
+ ((ast->info info) statement)))
+
+ ((goto (ident ,label))
+ (let ((offset (length (text->list text))))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (i386:jump (- (label-offset (.function info) label f) offset))))))))
+
+ ((p-expr (ident ,name))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (append
+ (i386:local->accu (assoc-ref locals name))
+ (i386:accu-zero?)))))))
+
+ ((p-expr (fixed ,value))
+ (let ((value (string->number value)))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (append (i386:value->accu value)
+ (i386:accu-zero?))))))))
- ;;(and (and (de-ref (p-expr (ident "a"))) (de-ref (p-expr (ident "b")))) (eq (de-ref (p-expr (ident "a"))) (de-ref (p-expr (ident "b")))))
-
((de-ref (p-expr (ident ,name)))
(clone info #:text
(append text
(list (lambda (f g t d)
(append (i386:local->accu (assoc-ref locals name))
- (i386:Xmem-byte->accu)))))))
+ (i386:byte-mem->accu)))))))
+
+ ((fctn-call . ,call)
+ (let ((info ((ast->info info) `(expr-stmt ,o))))
+ (clone info #:text
+ (append (.text info)
+ (list (lambda (f g t d)
+ (i386:accu-zero?)))))))
+
+ ;; i++
+ ((expr-stmt (post-inc (p-expr (ident ,name))))
+ (clone info #:text
+ (append text (list (lambda (f g t d)
+ (i386:local-add (assoc-ref locals name) 1))))))
+
+ ;; ++i -- same for now FIXME
+ ((expr-stmt (pre-inc (p-expr (ident ,name))))
+ (clone info #:text
+ (append text (list (lambda (f g t d)
+ (i386:local-add (assoc-ref locals name) 1))))))
+
+ ((not ,expr)
+ (let* ((test-info ((ast->info info) expr)))
+ (clone info #:text
+ (append (.text test-info)
+ (list (lambda (f g t d)
+ (i386:xor-zf))))
+ #:globals (.globals test-info))))
((and ,a ,b)
(let* ((info (clone info #:text '()))
2)))) ;; FIXME: need jump after last test
b-text))))
+ ;; FIXME and, gt
((eq (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
(clone info #:text
(append text
(list (lambda (f g t d)
(append
(append (i386:local->accu (assoc-ref locals a))
- (i386:Xmem-byte->base)
+ (i386:byte-mem->base)
(i386:local->accu (assoc-ref locals b))
- (i386:Xmem-byte->accu)
- (i386:test-byte-base))))))))
+ (i386:byte-mem->accu)
+ (i386:byte-test-base))))))))
+
+ ((gt (p-expr (ident ,a)) (p-expr (fixed ,b)))
+ ;; (stderr "GT: ~a > ~a\n" a b)
+ (let ((b (string->number b)))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (append
+ (i386:local->base (assoc-ref locals a))
+ (i386:value->accu b)
+ (i386:sub-base))))))))
+
+
+ ((eq (p-expr (ident ,a)) (p-expr (fixed ,b)))
+ ;;(stderr "EQ: ~a > ~a\n" a b)
+ (let ((b (string->number b)))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (append
+ (i386:local->base (assoc-ref locals a))
+ (i386:value->accu b)
+ (i386:sub-base)
+ (i386:xor-zf))))))))
+
+
+ ((ne (p-expr (ident ,a)) (p-expr (fixed ,b)))
+ ;;(stderr "NE: ~a > ~a\n" a b)
+ (let ((b (string->number b)))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (append
+ (i386:local->base (assoc-ref locals a))
+ (i386:value->accu b)
+ (i386:sub-base))))))))
+
+ ((lt (p-expr (ident ,a)) (p-expr (fixed ,b)))
+ ;;(stderr "LT: ~a < ~a\n" a b)
+ (let ((b (string->number b)))
+ (clone info #:text
+ (append text
+ (list (lambda (f g t d)
+ (append
+ (i386:local->base (assoc-ref locals a))
+ (i386:value->accu b)
+ (i386:base-sub))))))))
((sub (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
(clone info #:text
(append text
(list (lambda (f g t d)
(append (i386:local->accu (assoc-ref locals a))
- (i386:Xmem-byte->base)
+ (i386:byte-mem->base)
(i386:local->accu (assoc-ref locals b))
- (i386:Xmem-byte->accu)
- (i386:sub-byte-base)))))))
+ (i386:byte-mem->accu)
+ (i386:byte-sub-base)))))))
((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
(let ((value (string->number value)))
(append
((ident->base locals) name)
(i386:value->accu value)
- (i386:mem-byte->accu)))))))) ; FIXME: type: char
+ (i386:byte-mem->accu)))))))) ; FIXME: type: char
((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
(clone info #:text
(append
((ident->base locals) name)
((ident->accu locals) index)
- (i386:mem-byte->accu))))))) ; FIXME: type: char
+ (i386:byte-mem->accu))))))) ; FIXME: type: char
- ;; i++
- ((expr-stmt (post-inc (p-expr (ident ,name))))
- (clone info #:text
- (append text (list (lambda (f g t d)
- (i386:local-add (assoc-ref locals name) 1))))))
-
- ;; ++i -- same for now FIXME
- ((expr-stmt (pre-inc (p-expr (ident ,name))))
- (clone info #:text
- (append text (list (lambda (f g t d)
- (i386:local-add (assoc-ref locals name) 1))))))
-
((return ,expr)
(let ((accu ((expr->accu info) expr)))
(if (info? accu)
;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
(let ((value (string->number value)))
(clone info #:text (append text (list (lambda (f g t d) (i386:local-assign (assoc-ref locals name) value)))))))
+
+ ;; i = 0; ...from for init FIXME
+ ((assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value)))
+ (let ((value (string->number value)))
+ (clone info #:text (append text (list (lambda (f g t d) (i386:local-assign (assoc-ref locals name) value)))))))
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
(let* ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
(define (function->info info)
(lambda (o)
;;(stderr "\n")
- (format (current-error-port) "compiling ~a\n" (.name o))
;;(stderr "formals=~a\n" (.formals o))
- (let* ((text (formals->text (.formals o)))
+ (let* ((name (.name o))
+ (text (formals->text (.formals o)))
(locals (formals->locals (.formals o))))
+ (format (current-error-port) "compiling ~a\n" name)
;;(stderr "locals=~a\n" locals)
(let loop ((statements (.statements o))
- (info (clone info #:locals locals #:text text)))
+ (info (clone info #:locals locals #:function name #:text text)))
(if (null? statements) (clone info
+ #:function #f
#:functions (append (.functions info) (list (cons (.name o) (.text info)))))
(let* ((statement (car statements)))
- (loop (cdr statements) ((ast->info info) (car statements)))))))))
+ (loop (cdr statements)
+ ((ast->info info) (car statements)))))))))
(define (ast-list->info info)
(lambda (elements)
(define (functions->lambdas functions)
(append-map cdr functions))
+(define (lambda/label->list f g t d)
+ (lambda (l/l)
+ (if (not (procedure? l/l)) '() (l/l f g t d))))
+
(define (text->list o)
- (append-map (lambda (f) (f '() '() 0 0)) o))
+ (append-map (lambda/label->list '() '() 0 0) o))
(define (functions->text functions globals t d)
- (let loop ((lambdas (functions->lambdas functions)) (text '()))
- (if (null? lambdas) text
- (loop (cdr lambdas)
- (append text ((car lambdas) functions globals (- (length text)) d))))))
+ (let loop ((lambdas/labels (functions->lambdas functions)) (text '()))
+ (if (null? lambdas/labels) text
+ (loop (cdr lambdas/labels)
+ (append text ((lambda/label->list functions globals (- (length text)) d) (car lambdas/labels)))))))
+
+(define (function-prefix name functions)
+ (member name (reverse functions) (lambda (a b) (equal? (car b) name))))
(define (function-offset name functions)
- (let* ((prefix (member name (reverse functions)
- (lambda (a b)
- (equal? (car b) name)))))
+ (let ((prefix (function-prefix name functions)))
(if prefix (length (functions->text (cdr prefix) '() 0 0))
0)))
+(define (label-offset function label functions)
+ (let ((prefix (function-prefix function functions)))
+ (if (not prefix) 0
+ (let ((function-entry (car prefix)))
+ (let loop ((text (cdr function-entry)))
+ (if (or (equal? (car text) label) (null? text)) 0
+ (let* ((l/l (car text))
+ (t ((lambda/label->list '() '() 0 0) l/l))
+ (n (length t)))
+ (+ (loop (cdr text)) n))))))))
+
(define (globals->data globals)
(append-map cdr globals))
#:use-module (srfi srfi-1)
#:export (data-offset
function-offset
+ label-offset
functions->lambdas
functions->text
+ lambda/label->list
text->list
globals->data))
(define (symbol->table-entry o)
(let* ((name (car o))
(offset (function-offset name functions))
- (len (length (append-map (lambda (f) (f functions globals 0 0)) (cddr o))))
+ (len (length (text->list (cddr o))))
(str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car functions))))))
(i (1+ (length str))))
(symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
(define (i386:function-locals)
'(#x83 #xec #x10)) ; sub $0x10,%esp -- 4 local vars
-;; (define (i386:formal i n)
-;; (case i
-;; ((0) (list #x8b #x5d (* (- n 2) 4))) ; mov $00(%ebp),%ebx
-;; ((1) (list #x8b #x4d (* (- n 3) 4))) ; mov $00(%ebp),%ecx
-;; ((2) (list #x8b #x55 (* (- n 4) 4))) ; mov $00(%ebp),%edx
-;; ((3) (list #x8b #x45 (* (- n 5) 4))))) ; mov $00(%ebp),%eax FIXME
-
(define (i386:ref-global o)
`(#x68 ,@(int->bv32 o))) ; push $0x<o>
(define (i386:push-arg f g t d)
(lambda (o)
(cond ((number? o)
- `(#x68 ,@(int->bv32 o))) ; push $<o>
+ `(#x68 ,@(int->bv32 o))) ; push $<o>
((pair? o) o)
- ((procedure? o) (o f g t d)))))
+ ((procedure? o) (o f g t d))
+ (_ barf))))
(define (i386:ret . rest)
(lambda (f g t d)
(define (i386:accu-zero?)
`(#x85 #xc0)) ; cmpl %eax,%eax
+(define (i386:accu-non-zero?)
+ (append '(#x85 #xc0) ; cmpl %eax,%eax
+ (i386:xor-zf)))
+
(define (i386:local->accu n)
(or n la)
`(#x8b #x45 ,(- 0 (* 4 n)))) ; mov -<0xn>(%ebp),%eax
(or n lb)
`(#x8b #x55 ,(- 0 (* 4 n)))) ; mov -<0xn>(%ebp),%edx
-(define (i386:mem-byte->accu)
+(define (i386:byte-mem->accu)
'(#x01 #xd0 ; add %edx,%eax
#x0f #xb6 #x00)) ; movzbl (%eax),%eax
-(define (i386:Xmem-byte->accu)
- '(#x0f #xb6 #x00)) ; movzbl (%eax),%eax
-
-(define (i386:Xmem-byte->base)
+(define (i386:byte-mem->base)
'(#x0f #xb6 #x10)) ; movzbl (%eax),%edx
(define (i386:mem->accu)
(define (i386:value->accu v)
`(#xb8 ,@(int->bv32 v))) ; mov $<v>,%eax
+(define (i386:value->base v)
+ `(#xba ,@(int->bv32 v))) ; mov $<v>,%edx
+
(define (i386:local-add n v)
(or n ladd)
`(#x83 #x45 ,(- 0 (* 4 n)) ,v)) ; addl $<v>,0x<n>(%ebp)
#x83 #xc4 ,(* n 4) ; add $00,%esp
)))
+(define (i386:xor-zf)
+ '(#x9f ; lahf
+ #x80 #xf4 #x40 ; xor $0x40,%ah
+ #x9e)) ; sahf
+
+(define (i386:test-accu)
+ '(#x85 #xc0)) ; test %eax,%eax
+
+(define (i386:jump n)
+ `(#xeb ,(if (>= n 0) (- n 2) (- n 2)))) ; jmp <n>
+
+(define (i386:jump-c n)
+ `(#x72 ,(if (>= n 0) n (- n 2)))) ; jc <n>
+
+(define (i386:jump-cz n)
+ `(#x76 ,(if (>= n 0) n (- n 2)))) ; jna <n>
+
+(define (i386:jump-ncz n)
+ `(#x77 ,(if (>= n 0) n (- n 2)))) ; ja <n>
+
+(define (i386:jump-nc n)
+ `(#x73 ,(if (>= n 0) n (- n 2)))) ; jnc <n>
+
+(define (i386:jump-z n)
+ `(#x74 ,(if (>= n 0) n (- n 2)))) ; jz <n>
+
+(define (i386:jump-nz n)
+ `(#x75 ,(if (>= n 0) n (- n 2)))) ; jnz <n>
+
+(define (i386:test-jump-z n)
+ `(#x85 #xc0 ; test %eax,%eax
+ #x74 ,(if (>= n 0) n (- n 4)))) ; jz <n>
+
+(define (i386:jump-byte-nz n)
+ `(#x84 #xc0 ; test %al,%al
+ #x75 ,(if (>= n 0) n (- n 4)))) ; jne <n>
+
+(define (i386:jump-byte-z n)
+ `(#x84 #xc0 ; test %al,%al
+ #x74 ,(if (>= n 0) n (- n 4)))) ; jne <n>
+
+(define (i386:byte-test-base)
+ `(#x38 #xc2)) ; cmp %al,%dl
+
+(define (i386:test-base)
+ `(#x39 #xd0)) ; cmp %edx,%eax
+
+(define (i386:byte-sub-base)
+ `(#x28 #xd0)) ; sub %dl,%al
+
+(define (i386:byte-base-sub)
+ `(#x28 #xd0)) ; sub %al,%dl
+
+(define (i386:sub-base)
+ `(#x29 #xd0)) ; sub %edx,%eax
+
+(define (i386:base-sub)
+ `(#x29 #xc2)) ; sub %eax,%edx
+
+;;;\f libc bits
(define (i386:exit f g t d)
`(
#x5b ; pop %ebx
#xcd #x80 ; int $0x80
))
-;; (define (i386:_start f g t d)
-;; (let* ((prefix
-;; `(
-;; #x55 ; push %ebp
-;; #x89 #xe5 ; mov %esp,%ebp
-
-;; ;;#x83 #xec #x10 ; sub $0x10,%esp -- 4 local vars
-
-;; #xe8 ,@(int->bv32 (- address 5 s)) ; call relative
-
-;; #xb8 #x04 #x00 #x00 #x00 ; mov $0x4,%eax
-;; #xcd #x80 ; int $0x80
-
-;; #xc9 ; leave
-;; #xc3 ; ret
-;; ))
-;; (text-list (text->list t))
-;; (statement-offset (- (+ (length prefix) (length text-list))))
-;; (address (+ t (function-offset "main" s))))))
-
(define (i386:write f g t d)
`(
#x55 ; push %ebp
#xc9 ; leave
#xc3 ; ret
))
-
-(define (i386:jump n)
- `(#xeb ,(if (>= n 0) n (- n 2)))) ; jmp <n>
-
-(define (i386:jump-le n)
- `(#x7e ,(if (>= n 0) n (- n 4)))) ; jle <n>
-
-(define (i386:jump-byte-nz n)
- `(#x84 #xc0 ; test %al,%al
- #x75 ,(if (>= n 0) n (- n 4)))) ; jne <n>
-
-(define (i386:jump-nz n)
- `(#x85 #xc0 ; test %eax,%eax
- #x75 ,(if (>= n 0) n (- n 4)))) ; jne <n>
-
-(define (i386:jump-byte-z n)
- `(#x84 #xc0 ; test %al,%al
- #x74 ,(if (>= n 0) n (- n 4)))) ; jne <n>
-
-(define (i386:test-byte-base)
- `(#x38 #xc2)) ; cmp %al,%dl
-
-(define (i386:Xjump-byte-z n)
- `(#x74 ,(if (>= n 0) n (- n 2)))) ; je <n>
-
-(define (i386:sub-byte-base)
- `(#x28 #xd0)) ; sub %dl,%al
-
-;;28 d0 sub %dl,%al
-;;28 c2 sub %al,%dl
-;;29 d0 sub %edx,%eax
-;;29 c2 sub %eax,%edx
-
-#!
-int
-strcmp (char const* a, char const* b)
-{
- while (*a && *b && *a == *b)
- {
- a++;b++;
- }
- return *a == *b;
-}
-08048150 <strcmp>:
- 8048150: 55 push %ebp
- 8048151: 89 e5 mov %esp,%ebp
-
- 8048153: eb 08 jmp 804815d <strcmp+0xd>
-
-<body>
- 8048155: 83 45 08 01 addl $0x1,0x8(%ebp)
- 8048159: 83 45 0c 01 addl $0x1,0xc(%ebp)
-
-<test>
- 804815d: 8b 45 08 mov 0x8(%ebp),%eax
- 8048160: 0f b6 00 movzbl (%eax),%eax
- 8048163: 84 c0 test %al,%al
- 8048165: 74 1a je 8048181 <strcmp+0x31>
-
- 8048167: 8b 45 0c mov 0xc(%ebp),%eax
- 804816a: 0f b6 00 movzbl (%eax),%eax
- 804816d: 84 c0 test %al,%al
- 804816f: 74 10 je 8048181 <strcmp+0x31>
-
- 8048171: 8b 45 08 mov 0x8(%ebp),%eax
- 8048174: 0f b6 10 movzbl (%eax),%edx
- 8048177: 8b 45 0c mov 0xc(%ebp),%eax
- 804817a: 0f b6 00 movzbl (%eax),%eax
- 804817d: 38 c2 cmp %al,%dl
- 804817f: 74 d4 je 8048155 <strcmp+0x5>
-
-<exit>
- 8048181: 8b 45 08 mov 0x8(%ebp),%eax
- 8048184: 0f b6 00 movzbl (%eax),%eax
- 8048187: 0f be d0 movsbl %al,%edx
-
- 804818a: 8b 45 0c mov 0xc(%ebp),%eax
- 804818d: 0f b6 00 movzbl (%eax),%eax
- 8048190: 0f be c0 movsbl %al,%eax
-
- 8048193: 29 c2 sub %eax,%edx
- 8048195: 89 d0 mov %edx,%eax
-
- 8048197: 5d pop %ebp
- 8048198: c3 ret
-!#
(define-module (mes libc-i386)
#:use-module (srfi srfi-1)
#:use-module (mes elf)
- #:export (i386:accu->local
+ #:export (
+ i386:accu->local
+ i386:accu-non-zero?
+ i386:accu-zero?
+ i386:base-sub
+ i386:byte-base-sub
+ i386:byte-mem->accu
+ i386:byte-mem->base
+ i386:byte-test-base
+ i386:byte-sub-base
i386:call
- i386:exit
i386:formal
- i386:function-preamble
i386:function-locals
- i386:eputs
+ i386:function-preamble
+ i386:jump
i386:jump
i386:jump-byte-nz
i386:jump-byte-z
- i386:jump-nz
+ i386:jump-c
+ i386:jump-cz
i386:jump-le
- i386:local-add
- i386:local-assign
+ i386:jump-nc
+ i386:jump-ncz
+ i386:jump-nz
+ i386:jump-z
i386:local->accu
i386:local->base
+ i386:local-add
+ i386:local-assign
i386:local-test
i386:mem->accu
- i386:mem-byte->accu
- i386:Xmem-byte->accu
i386:push-accu
- i386:puts
i386:ref-global
i386:ref-local
i386:ret
i386:ret-local
+ i386:sub-base
+ i386:test-accu
+ i386:test-base
+ i386:test-jump-z
i386:value->accu
- i386:write
+ i386:value->base
+ i386:xor-zf
- i386:test-byte-base
- i386:Xmem-byte->base
- i386:Xjump-byte-z
- i386:sub-byte-base
+ ;; libc
+ i386:exit
+ i386:write
))
(cond-expand
exit (int code)
{
asm (
- "movl %0, %%ebx\n\t"
- "movl $1, %%eax\n\t"
+ "movl $0,%%ebx\n\t"
+ "movl $1,%%eax\n\t"
"int $0x80"
: // no outputs "=" (r)
: "" (code)
int r;
//syscall (SYS_write, fd, s, n));
asm (
- "mov %0, %%ebx\n\t"
- "mov %1, %%ecx\n\t"
- "mov %2, %%edx\n\t"
-
- "mov $0x4, %%eax\n\t"
+ "mov %0,%%ebx\n\t"
+ "mov %1,%%ecx\n\t"
+ "mov %2,%%edx\n\t"
+ "mov $0x4,%%eax\n\t"
"int $0x80\n\t"
: // no outputs "=" (r)
: "" (fd), "" (s), "" (n)
return 0;
}
-int g_a;
-int g_b;
-
-#if 0
-void
-eputs2 (char const* s, int a)
-{
- g_a = a;
- write (STDERR, s, strlen (s));
- //return 0;
-}
-
-void
-eputs3 (char const* s, int a, int b)
-{
- g_a = a;
- g_b = b;
- write (STDERR, s, strlen (s));
- //return 0;
-}
-
+#if __GNUC__
char const*
itoa (int x)
{
eputs ("\n");
*((int*)0) = 0;
}
-
#endif
#define assert(x) ((x) ? (void)0 : assert_fail(#x))
#define true 1
typedef int bool;
+typedef int SCM;
+
+#if __GNUC__
+bool g_debug = false;
+#endif
+
+int g_free = 0;
+
+SCM g_symbols = 0;
+SCM g_stack = 0;
+SCM r0 = 0; // a/env
+SCM r1 = 0; // param 1
+SCM r2 = 0; // save 2+load/dump
+SCM r3 = 0; // continuation
+
+SCM
+mes_environment ()
+{
+ return 0;
+}
+
+SCM
+bload_env (SCM a) ///((internal))
+{
+ eputs ("bload_env\n");
+ return 0;
+}
+
int
main (int argc, char *argv[])
{
{
puts ("\narg1=");
puts (argv[1]);
- if (!strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
+ if (!strcmp (argv[1], "--help")) /*return*/ puts ("XXUsage: mes [--dump|--load] < FILE");
}
puts ("\n");
- eputs ("Strlen...\n");
- puts ("Bye micro\n");
+
+#if __GNUC__
+ //g_debug = getenv ("MES_DEBUG");
+#endif
+ //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
+
+ if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
+ if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
+
+#if __GNUC__
+ g_stdin = STDIN;
+ r0 = mes_environment ();
+#endif
+
+#if MES_MINI
+ SCM program = bload_env (r0);
+ puts ("Hello micro-mes!\n");
+#else
+ SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
+ ? bload_env (r0) : load_env (r0);
+ if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
+
+ push_cc (r2, cell_unspecified, r0, cell_unspecified);
+ r3 = cell_vm_begin;
+ r1 = eval_apply ();
+ stderr_ (r1);
+
+ eputs ("\n");
+ gc (g_stack);
+#endif
int i = argc;
//int i = strcmp (argv[1], "1");
return i;
+#if __GNUC__
+ if (g_debug)
+ {
+ eputs ("\nstats: [");
+ eputs (itoa (g_free));
+ eputs ("]\n");
+ }
+#endif
+ return 0;
}
#if __GNUC__
return 0;
}
+#if __GNUC__
void
_start ()
{
- /* main body of program: call main(), etc */
-
- /* exit system call */
+ int r;
asm (
- "movl $1,%eax;"
- "xorl %ebx,%ebx;"
- "int $0x80"
+ "mov %%ebp,%%eax\n\t"
+ "addl $8,%%eax\n\t"
+ "push %%eax\n\t"
+
+ "mov %%ebp,%%eax\n\t"
+ "addl $4,%%eax\n\t"
+ "movzbl (%%eax),%%eax\n\t"
+ "push %%eax\n\t"
+
+ "call main\n\t"
+ "movl %%eax,%0\n\t"
+ : "=r" (r)
+ : //no inputs "" (&main)
);
+ exit (r);
}
+#endif
--- /dev/null
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * 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.
+ *
+ * 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 Mes. If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#if __GNUC__
+void
+exit (int code)
+{
+ asm (
+ "movl %0,%%ebx\n\t"
+ "movl $1,%%eax\n\t"
+ "int $0x80"
+ : // no outputs "=" (r)
+ : "" (code)
+ );
+ // not reached
+ exit (0);
+}
+
+void
+write (int fd, char const* s, int n)
+{
+ int r;
+ //syscall (SYS_write, fd, s, n));
+ asm (
+ "mov %0,%%ebx\n\t"
+ "mov %1,%%ecx\n\t"
+ "mov %2,%%edx\n\t"
+
+ "mov $0x4,%%eax\n\t"
+ "int $0x80\n\t"
+ : // no outputs "=" (r)
+ : "" (fd), "" (s), "" (n)
+ : "eax", "ebx", "ecx", "edx"
+ );
+}
+
+#define STDOUT 1
+
+typedef long size_t;
+size_t
+strlen (char const* s)
+{
+ int i = 0;
+ while (s[i]) i++;
+ return i;
+}
+
+int
+puts (char const* s)
+{
+ //write (STDOUT, s, strlen (s));
+ //int i = write (STDOUT, s, strlen (s));
+ int i = strlen (s);
+ write (1, s, i);
+ return 0;
+}
+
+int
+strcmp (char const* a, char const* b)
+{
+ while (*a && *b && *a == *b) {a++;b++;}
+ return *a - *b;
+}
+int test ();
+#endif
+
+int
+main (int argc, char *argv[])
+{
+ puts ("t.c\n");
+ return test ();
+}
+
+int
+test ()
+{
+ int f = 0;
+ int t = 1;
+ int one = 1;
+
+ puts ("t: if (0)\n");
+ if (0) return 1;
+
+ puts ("t: if (f)\n");
+ if (f) return 1;
+
+ puts ("t: if (one > 1)\n");
+ if (one > 1) return 1;
+
+ puts ("t: if (one < 0)\n");
+ if (one < 0) return 1;
+
+ puts ("t: stlrlen (\"\")\n");
+ if (strlen ("")) return 1;
+
+ puts ("t: if (!1)\n");
+ if (!1) return 1;
+
+ puts ("t: if (one == 0)\n");
+ if (one == 0) return 1;
+
+ puts ("t: if (f != 0)\n");
+ if (one != 1) return 1;
+
+ puts ("t: if (1 && 0)\n");
+ if (1 && 0) return 1;
+
+ puts ("t: if (1)\n");
+ if (1) goto ok0;
+ return 1;
+ ok0:
+
+ puts ("t: if (t)\n");
+ if (t) goto ok1;
+ return 1;
+ ok1:
+
+ puts ("t: if (one > 0)\n");
+ if (one > 0) goto ok2;
+ return 1;
+ ok2:
+
+ puts ("t: if (one < 2)\n");
+ if (one < 2) goto ok3;
+ return 1;
+ ok3:
+
+ puts ("t: if (strlen (\".\"))\n");
+ if (strlen (".")) goto ok4;
+ return 1;
+ ok4:
+
+ puts ("t: if (!0)\n");
+ if (!0) goto ok5;
+ return 1;
+ ok5:
+
+ puts ("t: if (one == 1)\n");
+ if (one == 1) goto ok6;
+ return 1;
+ ok6:
+
+ puts ("t: if (one != 0)\n");
+ if (one != 0) goto ok7;
+ return 1;
+ ok7:
+
+ puts ("t: if (1 && !0)\n");
+ if (1 && !0) goto ok8;
+ return 1;
+ ok8:
+
+ puts ("t: for (i=0; i<4; ++i)\n");
+ int i;
+ for (i=0; i<4; ++i);
+ if (i != 4) return i;
+
+ return 0;
+}
+
+#if __GNUC__
+void
+_start ()
+{
+ // int r=main ();
+ // exit (r);
+ int r;
+ asm (
+ "mov %%ebp,%%eax\n\t"
+ "addl $8,%%eax\n\t"
+ "push %%eax\n\t"
+
+ "mov %%ebp,%%eax\n\t"
+ "addl $4,%%eax\n\t"
+ "movzbl (%%eax),%%eax\n\t"
+ "push %%eax\n\t"
+
+ "call main\n\t"
+
+ "movl %%eax,%0\n\t"
+ : "=r" (r)
+ : //no inputs "" (&main)
+ );
+ exit (r);
+}
+#endif
(pass-if "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t))
(pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo)))
-(mes-use-module (mes pmatch))
+(cond-expand
+ (guile (use-modules (system base pmatch)
+ (ice-9 optargs)))
+ (mes (mes-use-module (mes pmatch))))
(define <info> '<info>)
(define <functions> '<functions>)
projects / mes.git / commitdiff