mescc: Beginning of expression and test template.
* 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.
This commit is contained in:
Jan Nieuwenhuizen
parent
8d1e001ab2
commit
c83ef66265
49
GNUmakefile
49
GNUmakefile
|
|
@ -35,21 +35,6 @@ mes.o: math.c math.h math.i math.environment.i
|
|||
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
|
||||
|
||||
|
|
@ -59,7 +44,7 @@ distclean: clean
|
|||
%.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\
|
||||
|
|
@ -95,6 +80,8 @@ MES_DEBUG:=1
|
|||
|
||||
mes-check: all
|
||||
set -e; for i in $(TESTS); do ./$$i; done
|
||||
|
||||
mes-check-nyacc: all
|
||||
scripts/nyacc.mes
|
||||
scripts/nyacc-calc.mes
|
||||
|
||||
|
|
@ -107,9 +94,37 @@ guile-check:
|
|||
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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,24 @@
|
|||
#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)
|
||||
{
|
||||
|
|
@ -52,14 +71,22 @@ puts (char const* 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;
|
||||
}
|
||||
#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;
|
||||
}
|
||||
|
||||
|
|
@ -67,7 +94,24 @@ main ()
|
|||
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
|
||||
|
|
|
|||
|
|
@ -62,6 +62,7 @@
|
|||
|
||||
(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))))
|
||||
|
||||
|
|
@ -87,13 +88,15 @@
|
|||
(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)
|
||||
|
|
@ -108,6 +111,10 @@
|
|||
(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>))))
|
||||
|
|
@ -120,14 +127,16 @@
|
|||
(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)
|
||||
|
|
@ -214,7 +223,8 @@
|
|||
(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
|
||||
|
|
@ -228,68 +238,46 @@
|
|||
|
||||
((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))
|
||||
|
|
@ -306,30 +294,32 @@
|
|||
(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)))
|
||||
|
|
@ -340,20 +330,72 @@
|
|||
|
||||
(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 '()))
|
||||
|
|
@ -372,26 +414,74 @@
|
|||
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)))
|
||||
|
|
@ -400,7 +490,7 @@
|
|||
(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
|
||||
|
|
@ -408,20 +498,8 @@
|
|||
(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)
|
||||
|
|
@ -479,6 +557,11 @@
|
|||
;;(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)))))
|
||||
|
|
@ -529,17 +612,20 @@
|
|||
(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)
|
||||
|
|
|
|||
|
|
@ -34,22 +34,38 @@
|
|||
(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))
|
||||
|
||||
|
|
|
|||
|
|
@ -26,8 +26,10 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:export (data-offset
|
||||
function-offset
|
||||
label-offset
|
||||
functions->lambdas
|
||||
functions->text
|
||||
lambda/label->list
|
||||
text->list
|
||||
globals->data))
|
||||
|
||||
|
|
|
|||
|
|
@ -199,7 +199,7 @@
|
|||
(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)))
|
||||
|
|
|
|||
|
|
@ -31,13 +31,6 @@
|
|||
(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>
|
||||
|
||||
|
|
@ -51,9 +44,10 @@
|
|||
(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)
|
||||
|
|
@ -76,6 +70,10 @@
|
|||
(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
|
||||
|
|
@ -84,14 +82,11 @@
|
|||
(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)
|
||||
|
|
@ -101,6 +96,9 @@
|
|||
(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)
|
||||
|
|
@ -130,6 +128,66 @@
|
|||
#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
|
||||
|
||||
;;; libc bits
|
||||
(define (i386:exit f g t d)
|
||||
`(
|
||||
#x5b ; pop %ebx
|
||||
|
|
@ -138,26 +196,6 @@
|
|||
#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
|
||||
|
|
@ -173,89 +211,3 @@
|
|||
#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
|
||||
!#
|
||||
|
|
|
|||
|
|
@ -27,39 +27,53 @@
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -41,8 +41,8 @@ void
|
|||
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)
|
||||
|
|
@ -71,11 +71,10 @@ 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"
|
||||
"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)
|
||||
|
|
@ -152,27 +151,7 @@ eputs (char const* s)
|
|||
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)
|
||||
{
|
||||
|
|
@ -205,7 +184,6 @@ assert_fail (char* s)
|
|||
eputs ("\n");
|
||||
*((int*)0) = 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#define assert(x) ((x) ? (void)0 : assert_fail(#x))
|
||||
|
|
@ -213,6 +191,34 @@ assert_fail (char* s)
|
|||
#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[])
|
||||
{
|
||||
|
|
@ -222,14 +228,51 @@ 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__
|
||||
|
|
|
|||
|
|
@ -763,15 +763,26 @@ main (int argc, char *argv[])
|
|||
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
|
||||
|
|
|
|||
203
scaffold/t.c
Normal file
203
scaffold/t.c
Normal file
|
|
@ -0,0 +1,203 @@
|
|||
/* -*-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
|
||||
|
|
@ -56,7 +56,10 @@ exit $?
|
|||
(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>)
|
||||
|
|
|
|||
Loading…
Reference in a new issue