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 2017-04-02 12:23:00 +02:00
parent 8d1e001ab2
commit c83ef66265
12 changed files with 693 additions and 304 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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
!#

View File

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

View File

@ -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__

View File

@ -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
View 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

View File

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