diff --git a/make.scm b/make.scm index 4e94f636..faca76c7 100755 --- a/make.scm +++ b/make.scm @@ -61,6 +61,9 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$ ((eq? libc mini-libc-mes.E) "mini-") (else "")) "guile") #:exit exit))) + +(add-scaffold-test "t" #:libc mini-libc-mes.E) + ;; tests/00: exit, functions without libc (add-scaffold-test "00-exit-0" #:libc #f) (add-scaffold-test "01-return-0" #:libc #f) @@ -90,7 +93,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$ (cut add-scaffold-test <> #:libc #f) '("20-while" "21-char[]" - "22-while-char[]")) + "22-while-char[]" + "23-pointer")) (add-target (group "check-scaffold-tests/2" #:dependencies (filter (target-prefix? "check-scaffold/tests/2") %targets))) diff --git a/mlibc/libc-mes.c b/mlibc/libc-mes.c index d9018b8a..ddc71ce3 100644 --- a/mlibc/libc-mes.c +++ b/mlibc/libc-mes.c @@ -338,8 +338,7 @@ char **g_environment; char * getenv (char const* s) { - char **p = g_environment; - p = *g_environment; + char **p = *g_environment; int length = strlen (s); while (*p) { diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 4d15b89c..9d9df094 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -325,13 +325,37 @@ (size (if (= ptr 1) (type->size info type) 4))) (case ptr + ((-2) (list (i386:label->accu `(#:address ,o)))) ((-1) (list (i386:label->accu `(#:address ,o)))) - ((1) (list (i386:label-mem->accu `(#:address ,o)))) - ((2) (list (i386:label->accu `(#:address ,o)))) (else (list (i386:label-mem->accu `(#:address ,o)))))) (if constant (wrap-as (i386:value->accu constant)) (list (i386:label->accu `(#:address ,o))))))))) +(define (ident->base info) + (lambda (o) + (let ((local (assoc-ref (.locals info) o))) + (if local + (let* ((ptr (local:pointer local)) + (type (ident->type info o)) + (size (if (and type (= ptr 1)) (type->size info type) + 4))) + (case ptr + ((-1) (wrap-as (i386:local-ptr->base (local:id local)))) + ((0) (wrap-as (if (= size 1) (i386:byte-local->base (local:id local)) + (i386:local->base (local:id local))))) + ;; WTF? + (else (wrap-as (i386:local->base (local:id local)))))) + (let ((global (assoc-ref (.globals info) o) )) + (if global + (let ((ptr (ident->pointer info o))) + (case ptr + ((-2) (list (i386:label->base `(#:address ,o)))) + ((-1) (list (i386:label->base `(#:address ,o)))) + (else (list (i386:label-mem->base `(#:address ,o)))))) + (let ((constant (assoc-ref (.constants info) o))) + (if constant (wrap-as (i386:value->base constant)) + (list (i386:label->base `(#:address ,o))))))))))) + (define (ident-address->accu info) (lambda (o) (let ((local (assoc-ref (.locals info) o)) @@ -357,7 +381,7 @@ 4))) (wrap-as (i386:local-ptr->base (local:id local)))) (if global (list (i386:label->base `(#:address ,o))) - (list (i386:label->accu `(#:address ,o)))))))) + (list (i386:label->base `(#:address ,o)))))))) (define (value->accu v) (wrap-as (i386:value->accu v))) @@ -412,32 +436,6 @@ (i386:accu-mem-add n) (i386:pop-accu)))))))) -;; FIXME: see ident->accu -(define (ident->base info) - (lambda (o) - (let ((local (assoc-ref (.locals info) o))) - (if local - (let* ((ptr (local:pointer local)) - (type (ident->type info o)) - (size (if (and type (= ptr 1)) (type->size info type) - 4))) - (case ptr - ((-1) (wrap-as (i386:local-ptr->base (local:id local)))) - ((1) (wrap-as (i386:local->base (local:id local)))) - (else - (wrap-as (if (= size 1) (i386:byte-local->base (local:id local)) - (i386:local->base (local:id local))))))) - (let ((global (assoc-ref (.globals info) o) )) - (if global - (let ((ptr (ident->pointer info o))) - (case ptr - ((-1) (list (i386:label->base `(#:address ,o)))) - ((2) (list (i386:label->base `(#:address ,o)))) - (else (list (i386:label-mem->base `(#:address ,o)))))) - (let ((constant (assoc-ref (.constants info) o))) - (if constant (wrap-as (i386:value->base constant)) - (list (i386:label->base `(#:address ,o))))))))))) - (define (expr->accu info) (lambda (o) (let ((locals (.locals info)) @@ -456,15 +454,23 @@ (info (clone info #:globals globals))) (append-text info (list (i386:label->accu `(#:string ,string)))))) + ;;; FIXME: FROM INFO ...only zero?! + ((p-expr (fixed ,value)) + (let ((value (cstring->number value))) + (append-text info (wrap-as (i386:value->accu value))))) + + ((p-expr (char ,char)) + (let ((char (char->integer (car (string->list char))))) + (append-text info (wrap-as (i386:value->accu char))))) + ((p-expr (string . ,strings)) (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings)))))) - ((p-expr (fixed ,value)) - (append-text info (value->accu (cstring->number value)))) ((p-expr (ident ,name)) (append-text info ((ident->accu info) name))) - ((initzer ,initzer) ((expr->accu info) initzer)) + ((initzer ,initzer) + ((expr->accu info) initzer)) ;; &foo ((ref-to (p-expr (ident ,name))) @@ -511,7 +517,7 @@ ((array-ref ,index (p-expr (ident ,array))) (let* ((type (ident->type info array)) (ptr (ident->pointer info array)) - (size (if (< ptr 2) (type->size info type) + (size (if (or (= ptr 1) (= ptr -1)) (type->size info type) 4)) (info ((expr->accu* info) o))) (append-text info (wrap-as (append (case size @@ -556,24 +562,13 @@ (wrap-as (i386:mem->accu)) (wrap-as (i386:mem+n->accu offset)))))) - ;;; FIXME: FROM INFO ...only zero?! - ((p-expr (fixed ,value)) - (let ((value (cstring->number value))) - (append-text info (wrap-as (i386:value->accu value))))) - - ((p-expr (char ,char)) - (let ((char (char->integer (car (string->list char))))) - (append-text info (wrap-as (i386:value->accu char))))) - - ((p-expr (ident ,name)) - (append-text info ((ident->accu info) name))) - ((de-ref (p-expr (ident ,name))) (let* ((type (ident->type info name)) (ptr (ident->pointer info name)) (size (if (= ptr 1) (type->size info type) 4))) - (append-text info (append ((ident->accu info) name) + (append-text info (append (if (or #t (assoc-ref locals name)) ((ident->accu info) name) + ((ident-address->accu info) name)) (wrap-as (if (= size 1) (i386:byte-mem->accu) (i386:mem->accu))))))) @@ -746,13 +741,13 @@ (info ((expr->accu* info) a)) (info (append-text info (wrap-as (i386:pop-base))))) (append-text info (wrap-as (i386:base->accu-address))))) ; FIXME: size - ;; FIXME: c&p above - ((de-ref (p-expr (ident ,array))) - (let* ((type (ident->type info array)) - (ptr (ident->pointer info array)) - (size (if (> ptr 1) 4 1))) + ((de-ref (p-expr (ident ,name))) + (let* ((type (ident->type info name)) + (ptr (ident->pointer info name)) + (size (if (= ptr 1) (type->size info type) + 4))) (append-text info (append (wrap-as (i386:accu->base)) - ((base->ident-address info) array))))) + ((base->ident-address info) name))))) ((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct)))) (let* ((info (append-text info (wrap-as (i386:push-accu)))) (info ((expr->accu* info) a)) @@ -816,7 +811,7 @@ (let* ((info ((expr->accu info) index)) (type (ident->type info array)) (ptr (ident->pointer info array)) - (size (if (< ptr 2) (type->size info type) + (size (if (or (= ptr 1) (= ptr -1)) (type->size info type) 4))) (append-text info (append (wrap-as (append (i386:accu->base) (if (eq? size 1) '() @@ -1173,12 +1168,14 @@ (pmatch o ((ident ,name) name) ((ptr-declr ,pointer (ident ,name)) name) + ((array-of (ident ,name) ,index) name) (_ (error "init-declr->name unsupported: " o)))) (define (init-declr->pointer o) (pmatch o ((ident ,name) 0) ((ptr-declr ,pointer (ident ,name)) (ptr-declr->pointer pointer)) + ((array-of (ident ,name) ,index) 1) (_ (error "init-declr->pointer unsupported: " o)))) (define (statements->clauses statements) @@ -1346,31 +1343,11 @@ (type-entry (cons name type))) (clone info #:types (cons type-entry types)))) - - ;; struct foo* bar = expr; - ((decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (ref-to (p-expr (ident ,value))))))) - (if (.function info) (let* ((locals (add-local locals name (list "struct" type) 1)) - (info (clone info #:locals locals))) - (append-text info (append ((ident-address->accu info) value) - ((accu->ident info) name)))) - (error "ast->info: unsupported global:" o))) - ;; END FIXME -- dupe of the below - - ;; struct ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields))))) (let ((type-entry (struct->type-entry name (map struct-field fields)))) (clone info #:types (cons type-entry types)))) - ;; ;; struct foo {} bar; - ((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields)))) - (init-declr-list (init-declr (ident ,name)))) - (let ((info ((ast->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields)))))))) - ((ast->info info) - `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))))) - - - ;; TODO ;; enum e i; ((decl (decl-spec-list (type-spec (enum-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))) (let ((type "int")) ;; FIXME @@ -1386,6 +1363,18 @@ (let ((globals (append globals (list (ident->global-entry name type 2 0))))) (clone info #:globals globals)))) + ;; char **p = *x; + ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)) (initzer (de-ref (p-expr (ident ,value))))))) + (let ((type (decl->type type)) + (info (append-text info (ast->comment o)))) + (if (.function info) + (let* ((locals (add-local locals name type 2)) + (info (clone info #:locals locals))) + (append-text info (append ((ident-address->accu info) value) + (wrap-as (i386:mem->accu)) + ((accu->ident info) name)))) + (error "TODO" o)))) + ;; struct foo bar[2]; ;; char arena[20000]; ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,count)))))) @@ -1405,23 +1394,15 @@ (globals (append globals (list array)))) (clone info #:globals globals))))) - ;; char* a[10]; - ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name) (p-expr (fixed ,count))))))) - (let ((type (ast->type type))) - (if (.function info) - (let* ((local (car (add-local locals name type -1))) - (count (string->number count)) - (size (type->size info type)) - (local (make-local-entry name type 1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4)))) - (locals (cons local locals)) - (info (clone info #:locals locals))) - info) - (let* ((globals (.globals info)) - (count (cstring->number count)) - (size (type->size info type)) - (array (make-global-entry name type 1 (string->list (make-string (* count size) #\nul)))) - (globals (append globals (list array)))) - (clone info #:globals globals))))) + ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,array) (p-expr (fixed ,size))) (initzer (p-expr (string ,string)))))) + (if (.function info) + (error "TODO: " o) + (let* ((globals (.globals info)) + ;; (count (cstring->number count)) + ;; (size (type->size info type)) + (array (make-global-entry array type -1 (string->list string))) + (globals (append globals (list array)))) + (clone info #:globals globals)))) ;; int (*function) (void) = g_functions[g_cells[fn].cdr].function; ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)) (initzer ,initzer)))) @@ -1440,7 +1421,8 @@ ;; char *p = g_cells; ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value)))))) - (let ((type (decl->type type))) + (let ((info (append-text info (ast->comment o))) + (type (decl->type type))) (if (.function info) (let* ((locals (add-local locals name type 1)) (info (clone info #:locals locals))) @@ -1510,18 +1492,10 @@ (global-names (map car globals)) (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals)) (globals (append globals initzer-globals)) - (global (make-global-entry name type 2 (append-map (initzer->data info) initzers))) + (global (make-global-entry name type -1 (append-map (initzer->data info) initzers))) (globals (append globals (list global)))) (clone info #:globals globals))))) - ;; char *foo[0], *bar; - ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,name) ,index)) . ,rest)) - (let loop ((inits `((init-declr (array-of (ident ,name) ,index)) ,@rest)) (info info)) - (if (null? inits) info - (loop (cdr inits) - ((ast->info info) - `(decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list ,(car inits)))))))) - ;; DECL ;; char *bla[] = {"a", "b"}; ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers))))) @@ -1532,24 +1506,12 @@ (initzers (map (initzer->non-const info) initzers))) (if (.function info) (error "TODO: x[] = {};" o) - (let* ( ;;(global (make-global-entry name type 2 (string->list (make-string size #\nul)))) - (global (make-global-entry name type 2 (append-map (initzer->data info) initzers))) + (let* ((global (make-global-entry name type -2 (append-map (initzer->data info) initzers))) (global-names (map car globals)) (entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries)) (globals (append globals entries (list global)))) (clone info #:globals globals))))) - ;; SCM tmp; - ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name)))) - (if (.function info) - (let ((size (type->size info type))) - (if (<= size 4) (clone info #:locals (add-local locals name type 0)) - (let* ((local (car (add-local locals name type 1))) - (local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4)))) - (locals (cons local locals))) - (clone info #:locals locals)))) - (clone info #:globals (append globals (list (ident->global-entry name type 0 0)))))) - ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer))) (let* ((info (type->info info type)) (type (decl->type type)) @@ -1563,15 +1525,19 @@ (info (append-text info (ast->comment o))) (globals (append globals initzer-globals)) (info (clone info #:globals globals)) - (size (type->size info type))) + (pointer (if (and (pair? type) (equal? (car type) "struct")) -1 pointer)) + (size (if (zero? pointer) (type->size info type) + 4))) (if (.function info) - (let* ((locals (add-local locals name type pointer)) + (let* ((locals (if (or (not (= pointer 0)) (<= size 4)) (add-local locals name type pointer) + (let* ((local (car (add-local locals name type 1))) + (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))) + (cons local locals)))) (info (clone info #:locals locals)) (info (if (null? initzer) info ((initzer->accu info) (car initzer)))) (info (if (null? initzer) info (append-text info ((accu->ident info) name))))) info) - (let* ((pointer (if (and (pair? type) (equal? (car type) "struct")) 2 pointer)) - (global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul)) + (let* ((global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul)) (append-map (initzer->data info) initzer)))) (globals (append globals (list global)))) (clone info #:globals globals))))) diff --git a/module/mes/as-i386.mes b/module/mes/as-i386.mes index eaaaf483..06c12b7f 100644 --- a/module/mes/as-i386.mes +++ b/module/mes/as-i386.mes @@ -30,6 +30,9 @@ (mes (mes-use-module (mes as)))) +(define (i386:nop) + '(("nop"))) ; nop + (define (i386:function-preamble) '(("push___%ebp") ; push %ebp ("mov____%esp,%ebp"))) ; mov %esp,%ebp; @@ -229,7 +232,7 @@ '(("movzbl_(%eax),%eax"))) ; movzbl (%eax),%eax (define (i386:byte-mem->base) - '(("movzbl_(%eax),%edx"))) ; movzbl (%eax),%edx + '(("movzbl_(%edx),%edx"))) ; movzbl (%edx),%edx (define (i386:base-mem->accu) '(("add___%edx,%eax") ; add %edx,%eax @@ -238,6 +241,9 @@ (define (i386:mem->accu) '(("mov____(%eax),%eax"))) ; mov (%eax),%eax +(define (i386:mem->base) + '(("mov____(%edx),%edx"))) ; mov (%edx),%edx + (define (i386:mem+n->accu n) `(("mov____0x8(%eax),%eax" (#:immediate1 ,n)))) ; mov 0x(%eax),%eax diff --git a/module/mes/as-i386.scm b/module/mes/as-i386.scm index cf8066a4..ea6e573a 100644 --- a/module/mes/as-i386.scm +++ b/module/mes/as-i386.scm @@ -35,6 +35,7 @@ i386:accu->base-address+n i386:accu->label i386:accu->local + i386:accu-mem-add i386:accu-test i386:accu-zero? i386:accu+accu @@ -94,9 +95,10 @@ i386:local-ptr->base i386:local-address->base i386:local-test - i386:accu-mem-add i386:mem->accu + i386:mem->base i386:mem+n->accu + i386:nop i386:pop-accu i386:push-accu i386:pop-base diff --git a/scaffold/tests/23-pointer.c b/scaffold/tests/23-pointer.c new file mode 100644 index 00000000..3cc19a33 --- /dev/null +++ b/scaffold/tests/23-pointer.c @@ -0,0 +1,37 @@ +/* -*-comment-start: "//";comment-end:""-*- + * Mes --- Maxwell Equations of Software + * Copyright © 2017 Jan Nieuwenhuizen + * + * 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 . + */ + +#include "00-test.i" + +char g_arena[4] = "XXX"; +char *g_chars = g_arena; + +int +test () +{ + if (*g_chars != 'X') return 1; + g_arena[0] = 'A'; + if (*g_chars != 'A') return 1; + char *x = g_arena; + if (*x++ != 'A') return 1; + *x++ = 'C'; + if (g_chars[1] != 'C') return 1; + return 0; +} diff --git a/scaffold/tests/t.c b/scaffold/tests/t.c new file mode 100644 index 00000000..a9479400 --- /dev/null +++ b/scaffold/tests/t.c @@ -0,0 +1,47 @@ +/* -*-comment-start: "//";comment-end:""-*- + * Mes --- Maxwell Equations of Software + * Copyright © 2017 Jan Nieuwenhuizen + * + * 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 . + */ + +#include "30-test.i" + +char g_arena[4] = "XXX"; +char *g_chars = g_arena; + +int +test () +{ + puts ("X\n"); + if (*g_chars != 'X') return 1; + g_arena[0] = 'A'; + puts ("A\n"); + if (*g_chars != 'A') return 1; + + puts ("*x A\n"); + char *x = g_arena; + if (*x != 'A') return 1; + + puts ("*x++ A\n"); + if (*x++ != 'A') return 1; + + puts ("t: *x++ != 'C'\n"); + *x++ = 'C'; + if (g_chars[1] != 'C') return 1; + + return 0; +} diff --git a/stage0/x86.M1 b/stage0/x86.M1 index 32bf4ee8..d8d55115 100644 --- a/stage0/x86.M1 +++ b/stage0/x86.M1 @@ -47,6 +47,7 @@ DEFINE lahf 9f DEFINE lea____0x8(%ebp),%eax 8d45 DEFINE lea____0x8(%ebp),%edx 8d55 DEFINE leave c9 +DEFINE nop 90 DEFINE mov____$i32,%eax b8 DEFINE mov____$i32,%ebx bb DEFINE mov____$i32,%ecx b9 @@ -74,6 +75,7 @@ DEFINE mov____%edx,%ecx 89d1 DEFINE mov____%edx,0x8(%ebp) 8955 DEFINE mov____%esp,%ebp 89e5 DEFINE mov____(%eax),%eax 8b00 +DEFINE mov____(%edx),%edx 8b12 DEFINE mov____(%edx),%ecx 8b0a DEFINE mov____0x32,%eax a1 DEFINE mov____0x32,%edx 8b15 @@ -85,6 +87,7 @@ DEFINE mov____0x8(%ebp),%edx 8b55 DEFINE movzbl_%al,%eax 0fb6c0 DEFINE movzbl_(%eax),%eax 0fb600 DEFINE movzbl_(%eax),%edx 0fb610 +DEFINE movzbl_(%edx),%edx 0fb612 DEFINE movzbl_0x8(%ebp),%eax 0fb645 DEFINE movzbl_0x8(%ebp),%edx 0fb655 DEFINE mul____%edx f7e2