2016-12-31 08:03:07 +00:00
|
|
|
;;; -*-scheme-*-
|
|
|
|
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
2017-01-02 06:41:56 +00:00
|
|
|
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
|
2016-12-31 08:03:07 +00:00
|
|
|
;;;
|
|
|
|
;;; 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/>.
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;;; compiler.mes produces an i386 binary from the C produced by
|
|
|
|
;;; Nyacc c99.
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
(cond-expand
|
2017-06-11 11:11:40 +00:00
|
|
|
(guile-2)
|
2017-04-02 09:55:37 +00:00
|
|
|
(guile)
|
|
|
|
(mes
|
mescc: Use records for Guile: preparation.
* module/language/c99/info.mes: New file.
* module/mes/M1.mes: Use it.
* scripts/mescc.mes: Use it.
* module/language/c99/compiler.mes: Use it. (<info>, <types>,
<constants>, <functions>, <globals>, <locals>, <function>, <text>,
<break>, <continue>, make, info?, .info, .types, .constants,
.functions, .globals, .locals, .function, .text, .break, .continue):
Remove.
* module/language/c99/info.scm: New file.
* module/language/c99/compiler.scm: Use it.
* guile/mescc.scm: Use it.
* module/mes/M1.scm: Use it.
2017-07-14 18:42:26 +00:00
|
|
|
(mes-use-module (srfi srfi-1))
|
2017-06-20 17:06:19 +00:00
|
|
|
(mes-use-module (srfi srfi-26))
|
2017-04-02 15:01:22 +00:00
|
|
|
(mes-use-module (mes pmatch))
|
2017-04-02 09:55:37 +00:00
|
|
|
(mes-use-module (nyacc lang c99 parser))
|
2017-06-11 11:11:40 +00:00
|
|
|
(mes-use-module (nyacc lang c99 pprint))
|
mescc: Remove ELF creation, handled by hex2 now.
* module/language/c99/compiler.scm (make-global, global:type,
global:pointer, global:value): Move from elf-util.mes
* module/mes/as.mes: New file.
* module/mes/as-i386.mes: Use it.
* module/mes/as-i386.scm: Use it.
* module/mes/elf-util.mes: Remove.
* module/mes/elf.mes (elf32-addr, elf32-half, elf32-off, elf32-word,
make-elf, write-any, object->elf): Remove
(hex2->elf): New function with dummy implementation.
* module/mes/elf.scm: Update exports.
* module/mes/hex2.mes (object->elf): New function.
* module/mes/hex2.scm: Export it.
2017-06-25 07:26:25 +00:00
|
|
|
(mes-use-module (mes as))
|
2017-04-02 10:29:09 +00:00
|
|
|
(mes-use-module (mes as-i386))
|
2017-07-02 14:25:14 +00:00
|
|
|
(mes-use-module (mes M1))
|
mescc: Use records for Guile: preparation.
* module/language/c99/info.mes: New file.
* module/mes/M1.mes: Use it.
* scripts/mescc.mes: Use it.
* module/language/c99/compiler.mes: Use it. (<info>, <types>,
<constants>, <functions>, <globals>, <locals>, <function>, <text>,
<break>, <continue>, make, info?, .info, .types, .constants,
.functions, .globals, .locals, .function, .text, .break, .continue):
Remove.
* module/language/c99/info.scm: New file.
* module/language/c99/compiler.scm: Use it.
* guile/mescc.scm: Use it.
* module/mes/M1.scm: Use it.
2017-07-14 18:42:26 +00:00
|
|
|
(mes-use-module (mes optargs))
|
|
|
|
(mes-use-module (language c99 info))))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(define (logf port string . rest)
|
|
|
|
(apply format (cons* port string rest))
|
|
|
|
(force-output port)
|
|
|
|
#t)
|
|
|
|
|
|
|
|
(define (stderr string . rest)
|
|
|
|
(apply logf (cons* (current-error-port) string rest)))
|
|
|
|
|
2017-07-26 13:42:44 +00:00
|
|
|
(define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "PREFIX") "") "@PREFIX@"))
|
2017-04-12 19:27:59 +00:00
|
|
|
|
|
|
|
(define mes? (pair? (current-module)))
|
|
|
|
|
2017-05-25 17:48:26 +00:00
|
|
|
(define* (c99-input->full-ast #:key (defines '()) (includes '()))
|
2017-06-03 10:11:57 +00:00
|
|
|
(let ((include (if (equal? %prefix "") "mlibc/include" (string-append %prefix "/share/mlibc/include"))))
|
2017-05-23 05:16:08 +00:00
|
|
|
(parse-c99
|
2017-07-26 13:42:44 +00:00
|
|
|
#:inc-dirs (append includes (cons* include "mlibc/include" "mlibc" (or (and=> (getenv "C_INCLUDE_PATH") (cut string-split <> #\:)) '())))
|
2017-05-23 05:16:08 +00:00
|
|
|
#:cpp-defs `(
|
2017-07-28 06:07:41 +00:00
|
|
|
"__i386__=1"
|
2017-05-23 05:16:08 +00:00
|
|
|
"POSIX=0"
|
|
|
|
"_POSIX_SOURCE=0"
|
|
|
|
"__MESC__=1"
|
|
|
|
,(if mes? "__MESC_MES__=1" "__MESC_MES__=0")
|
2017-07-26 13:42:44 +00:00
|
|
|
,@defines)
|
2017-05-23 05:16:08 +00:00
|
|
|
#:mode 'code)))
|
2016-12-31 08:03:07 +00:00
|
|
|
|
2017-05-25 17:48:26 +00:00
|
|
|
(define (ast-strip-comment o)
|
|
|
|
(pmatch o
|
|
|
|
((comment . ,comment) #f)
|
|
|
|
(((comment . ,comment) . ,t) (filter-map ast-strip-comment t))
|
|
|
|
(((comment . ,comment) . ,cdr) cdr)
|
|
|
|
((,car . (comment . ,comment)) car)
|
|
|
|
((,h . ,t) (if (list? o) (filter-map ast-strip-comment o)
|
|
|
|
(cons (ast-strip-comment h) (ast-strip-comment t))))
|
|
|
|
(_ o)))
|
|
|
|
|
2017-06-02 11:12:56 +00:00
|
|
|
(define (ast-strip-const o)
|
|
|
|
(pmatch o
|
|
|
|
((type-qual ,qual) (if (equal? qual "const") #f o))
|
|
|
|
((decl-spec-list (type-qual ,qual) . ,rest)
|
|
|
|
(if (equal? qual "const") `(decl-spec-list ,@rest)
|
|
|
|
`(decl-spec-list (type-qual ,qual) ,@(map ast-strip-const rest))))
|
|
|
|
((,h . ,t) (if (list? o) (filter-map ast-strip-const o)
|
|
|
|
(cons (ast-strip-const h) (ast-strip-const t))))
|
|
|
|
(_ o)))
|
|
|
|
|
2017-05-25 17:48:26 +00:00
|
|
|
(define* (c99-input->ast #:key (defines '()) (includes '()))
|
2017-06-02 11:12:56 +00:00
|
|
|
((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:defines defines #:includes includes)))
|
2017-05-25 17:48:26 +00:00
|
|
|
|
2016-12-31 08:03:07 +00:00
|
|
|
(define (ast:function? o)
|
|
|
|
(and (pair? o) (eq? (car o) 'fctn-defn)))
|
|
|
|
|
|
|
|
(define (.name o)
|
|
|
|
(pmatch o
|
2017-01-02 06:41:56 +00:00
|
|
|
((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) _) name)
|
2017-04-17 00:15:11 +00:00
|
|
|
((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr (ident ,name) _)) _) name)
|
2017-07-23 21:40:23 +00:00
|
|
|
((ellipsis) #f)
|
|
|
|
((param-decl (decl-spec-list (type-spec (void)))) #f)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
((param-decl _ (param-declr (ident ,name))) name)
|
|
|
|
((param-decl _ (param-declr (ptr-declr (pointer) (ident ,name)))) name)
|
|
|
|
((param-decl _ (param-declr (ptr-declr (pointer) (array-of (ident ,name))))) name)
|
2017-04-17 00:15:11 +00:00
|
|
|
((param-decl _ (param-declr (ptr-declr (pointer (pointer)) (ident ,name)))) name)
|
2017-07-20 23:02:17 +00:00
|
|
|
((param-decl _ (param-declr (ptr-declr (pointer (pointer (pointer))) (ident ,name)))) name)
|
2017-07-24 17:15:54 +00:00
|
|
|
((param-decl _ (param-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,params)))) name)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(_
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(format (current-error-port) "SKIP: .name =~a\n" o))))
|
|
|
|
|
|
|
|
(define (.type o)
|
|
|
|
(pmatch o
|
2017-07-23 21:40:23 +00:00
|
|
|
((ellipsis) #f)
|
|
|
|
((param-decl (decl-spec-list (type-spec (void)))) #f)
|
2017-07-16 18:54:59 +00:00
|
|
|
((param-decl (decl-spec-list (type-spec ,type)) _) (decl->ast-type type))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((param-decl ,type _) type)
|
|
|
|
(_
|
|
|
|
(format (current-error-port) "SKIP: .type =~a\n" o))))
|
2016-12-31 08:03:07 +00:00
|
|
|
|
|
|
|
(define (.statements o)
|
|
|
|
(pmatch o
|
2017-01-02 06:41:56 +00:00
|
|
|
((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)
|
2017-04-17 00:15:11 +00:00
|
|
|
((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)
|
|
|
|
((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)
|
|
|
|
(_ (error ".statements: unsupported: " o))))
|
2016-12-31 08:03:07 +00:00
|
|
|
|
2017-01-04 23:55:46 +00:00
|
|
|
(define (clone o . rest)
|
|
|
|
(cond ((info? o)
|
2017-01-10 21:44:01 +00:00
|
|
|
(let ((types (.types o))
|
|
|
|
(constants (.constants o))
|
|
|
|
(functions (.functions o))
|
2017-01-04 23:55:46 +00:00
|
|
|
(globals (.globals o))
|
|
|
|
(locals (.locals o))
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
(function (.function o))
|
2017-04-10 04:59:50 +00:00
|
|
|
(text (.text o))
|
2017-06-12 15:10:29 +00:00
|
|
|
(break (.break o))
|
|
|
|
(continue (.continue o)))
|
2017-01-04 23:55:46 +00:00
|
|
|
(let-keywords rest
|
|
|
|
#f
|
2017-01-10 21:44:01 +00:00
|
|
|
((types types)
|
|
|
|
(constants constants)
|
|
|
|
(functions functions)
|
2017-01-04 23:55:46 +00:00
|
|
|
(globals globals)
|
|
|
|
(locals locals)
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
(function function)
|
2017-04-10 04:59:50 +00:00
|
|
|
(text text)
|
2017-06-12 15:10:29 +00:00
|
|
|
(break break)
|
|
|
|
(continue continue))
|
|
|
|
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:function function #:text text #:break break #:continue continue))))))
|
2017-01-04 23:55:46 +00:00
|
|
|
|
mescc: Use records for Guile: preparation.
* module/language/c99/info.mes: New file.
* module/mes/M1.mes: Use it.
* scripts/mescc.mes: Use it.
* module/language/c99/compiler.mes: Use it. (<info>, <types>,
<constants>, <functions>, <globals>, <locals>, <function>, <text>,
<break>, <continue>, make, info?, .info, .types, .constants,
.functions, .globals, .locals, .function, .text, .break, .continue):
Remove.
* module/language/c99/info.scm: New file.
* module/language/c99/compiler.scm: Use it.
* guile/mescc.scm: Use it.
* module/mes/M1.scm: Use it.
2017-07-14 18:42:26 +00:00
|
|
|
(define (append-text info text)
|
|
|
|
(clone info #:text (append (.text info) text)))
|
|
|
|
|
2017-07-28 16:04:39 +00:00
|
|
|
(define (push-global info)
|
2017-02-27 06:50:33 +00:00
|
|
|
(lambda (o)
|
2017-07-28 16:04:39 +00:00
|
|
|
(let ((ptr (ident->pointer info o)))
|
|
|
|
(case ptr
|
|
|
|
((-2) (list (i386:push-label `(#:address ,o))))
|
|
|
|
((-1) (list (i386:push-label `(#:address ,o))))
|
|
|
|
(else (list (i386:push-label-mem `(#:address ,o))))))))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
|
|
|
(define (push-local locals)
|
|
|
|
(lambda (o)
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (i386:push-local (local:id o)))))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
2017-07-28 16:04:39 +00:00
|
|
|
(define (push-global-address info)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(lambda (o)
|
2017-06-11 11:11:40 +00:00
|
|
|
(list (i386:push-label o))))
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
|
2017-02-27 06:50:33 +00:00
|
|
|
(define (push-local-address locals)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(lambda (o)
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (i386:push-local-address (local:id o)))))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
2017-01-17 18:03:08 +00:00
|
|
|
(define push-global-de-ref push-global)
|
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
(define (push-local-de-ref info)
|
2017-02-27 06:50:33 +00:00
|
|
|
(lambda (o)
|
2017-04-17 00:15:11 +00:00
|
|
|
(let* ((local o)
|
|
|
|
(ptr (local:pointer local))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info (local:type o))
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
|
|
|
(if (= size 1)
|
|
|
|
(wrap-as (i386:push-byte-local-de-ref (local:id o)))
|
|
|
|
(wrap-as (i386:push-local-de-ref (local:id o)))))))
|
|
|
|
|
|
|
|
|
|
|
|
(define (push-local-de-de-ref info)
|
|
|
|
(lambda (o)
|
|
|
|
(let* ((local o)
|
|
|
|
(ptr (local:pointer local))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 2) (ast-type->size info (local:type o));; URG
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
|
|
|
(if (= size 1)
|
|
|
|
(wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
|
|
|
|
(error "TODO int-de-de-ref")))))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
2017-07-15 09:24:14 +00:00
|
|
|
(define (make-global-entry key type pointer value)
|
|
|
|
(cons key (make-global type pointer value)))
|
mescc: Remove ELF creation, handled by hex2 now.
* module/language/c99/compiler.scm (make-global, global:type,
global:pointer, global:value): Move from elf-util.mes
* module/mes/as.mes: New file.
* module/mes/as-i386.mes: Use it.
* module/mes/as-i386.scm: Use it.
* module/mes/elf-util.mes: Remove.
* module/mes/elf.mes (elf32-addr, elf32-half, elf32-off, elf32-word,
make-elf, write-any, object->elf): Remove
(hex2->elf): New function with dummy implementation.
* module/mes/elf.scm: Update exports.
* module/mes/hex2.mes (object->elf): New function.
* module/mes/hex2.scm: Export it.
2017-06-25 07:26:25 +00:00
|
|
|
|
2017-07-15 09:24:14 +00:00
|
|
|
(define (string->global-entry string)
|
|
|
|
(make-global-entry `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
|
mescc: Remove ELF creation, handled by hex2 now.
* module/language/c99/compiler.scm (make-global, global:type,
global:pointer, global:value): Move from elf-util.mes
* module/mes/as.mes: New file.
* module/mes/as-i386.mes: Use it.
* module/mes/as-i386.scm: Use it.
* module/mes/elf-util.mes: Remove.
* module/mes/elf.mes (elf32-addr, elf32-half, elf32-off, elf32-word,
make-elf, write-any, object->elf): Remove
(hex2->elf): New function with dummy implementation.
* module/mes/elf.scm: Update exports.
* module/mes/hex2.mes (object->elf): New function.
* module/mes/hex2.scm: Export it.
2017-06-25 07:26:25 +00:00
|
|
|
|
2017-07-15 09:24:14 +00:00
|
|
|
(define (int->global-entry value)
|
|
|
|
(make-global-entry (number->string value) "int" 0 (int->bv32 value)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-15 09:24:14 +00:00
|
|
|
(define (ident->global-entry name type pointer value)
|
|
|
|
(make-global-entry name type pointer (if (pair? value) value (int->bv32 value))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-15 09:46:13 +00:00
|
|
|
(define (make-local-entry name type pointer id)
|
|
|
|
(cons name (make-local type pointer id)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
|
|
|
(define (push-ident info)
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(lambda (o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-05-07 05:36:44 +00:00
|
|
|
(if local
|
|
|
|
(begin
|
|
|
|
(let* ((ptr (local:pointer local))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info (local:type local))
|
2017-05-07 05:36:44 +00:00
|
|
|
4)))
|
|
|
|
(if (= ptr -1) ((push-local-address (.locals info)) local)
|
|
|
|
((push-local (.locals info)) local))))
|
2017-03-17 07:37:45 +00:00
|
|
|
(let ((global (assoc-ref (.globals info) o)))
|
|
|
|
(if global
|
2017-07-28 16:04:39 +00:00
|
|
|
((push-global info) o) ;; FIXME: char*/int
|
2017-03-17 07:37:45 +00:00
|
|
|
(let ((constant (assoc-ref (.constants info) o)))
|
|
|
|
(if constant
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (append (i386:value->accu constant)
|
2017-04-07 12:31:35 +00:00
|
|
|
(i386:push-accu)))
|
2017-06-11 16:05:56 +00:00
|
|
|
((push-global-address #f) `(#:address ,o))))))))))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (push-ident-address info)
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(lambda (o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-02-27 06:50:33 +00:00
|
|
|
(if local ((push-local-address (.locals info)) local)
|
2017-06-11 11:11:40 +00:00
|
|
|
(let ((global (assoc-ref (.globals info) o)))
|
|
|
|
(if global
|
2017-07-28 16:04:39 +00:00
|
|
|
((push-global-address info) o)
|
2017-06-11 16:05:56 +00:00
|
|
|
((push-global-address #f) `(#:address ,o))))))))
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (push-ident-de-ref info)
|
2017-01-17 18:03:08 +00:00
|
|
|
(lambda (o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-04-17 00:15:11 +00:00
|
|
|
(if local ((push-local-de-ref info) local)
|
2017-07-28 16:04:39 +00:00
|
|
|
((push-global-de-ref info) o)))))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
(define (push-ident-de-de-ref info)
|
|
|
|
(lambda (o)
|
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
|
|
|
(if local ((push-local-de-de-ref info) local)
|
|
|
|
(error "TODO: global push-local-de-de-ref")))))
|
|
|
|
|
2017-04-04 12:37:17 +00:00
|
|
|
(define (expr->arg info)
|
|
|
|
(lambda (o)
|
|
|
|
(let ((info ((expr->accu info) o)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info (wrap-as (i386:push-accu))))))
|
2017-04-04 12:37:17 +00:00
|
|
|
|
2017-04-23 11:53:36 +00:00
|
|
|
(define (globals:add-string globals)
|
|
|
|
(lambda (o)
|
2017-06-11 16:05:56 +00:00
|
|
|
(let ((string `(#:string ,o)))
|
2017-04-23 11:53:36 +00:00
|
|
|
(if (assoc-ref globals string) globals
|
2017-07-15 09:24:14 +00:00
|
|
|
(append globals (list (string->global-entry o)))))))
|
2017-04-23 11:53:36 +00:00
|
|
|
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(define (expr->arg info) ;; FIXME: get Mes curried-definitions
|
2017-04-02 09:55:37 +00:00
|
|
|
(lambda (o)
|
2017-02-27 06:50:33 +00:00
|
|
|
(let ((text (.text info)))
|
|
|
|
(pmatch o
|
|
|
|
|
|
|
|
((p-expr (string ,string))
|
2017-04-23 11:53:36 +00:00
|
|
|
(let* ((globals ((globals:add-string (.globals info)) string))
|
|
|
|
(info (clone info #:globals globals)))
|
2017-06-11 16:05:56 +00:00
|
|
|
(append-text info ((push-global-address info) `(#:string ,string)))))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
|
|
|
((p-expr (ident ,name))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info ((push-ident info) name)))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
2017-04-04 12:37:17 +00:00
|
|
|
((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
|
|
|
|
(abs-declr (pointer)))
|
|
|
|
,cast)
|
|
|
|
((expr->arg info) cast))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
((cast (type-name (decl-spec-list (type-spec (fixed-type ,type)))) ,cast)
|
|
|
|
((expr->arg info) cast))
|
|
|
|
|
2017-02-27 06:50:33 +00:00
|
|
|
((de-ref (p-expr (ident ,name)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info ((push-ident-de-ref info) name)))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
((de-ref (de-ref (p-expr (ident ,name))))
|
|
|
|
(append-text info ((push-ident-de-de-ref info) name)))
|
|
|
|
|
2017-02-27 06:50:33 +00:00
|
|
|
((ref-to (p-expr (ident ,name)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info ((push-ident-address info) name)))
|
2017-02-27 06:50:33 +00:00
|
|
|
|
2017-04-07 07:53:56 +00:00
|
|
|
(_ (append-text ((expr->accu info) o)
|
|
|
|
(wrap-as (i386:push-accu))))))))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
;; FIXME: see ident->base
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(define (ident->accu info)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(lambda (o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o))
|
|
|
|
(global (assoc-ref (.globals info) o))
|
|
|
|
(constant (assoc-ref (.constants info) o)))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(if local
|
2017-03-17 16:32:23 +00:00
|
|
|
(let* ((ptr (local:pointer local))
|
|
|
|
(type (ident->type info o))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 0) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
2017-03-17 16:32:23 +00:00
|
|
|
(case ptr
|
2017-04-07 07:36:30 +00:00
|
|
|
((-1) (wrap-as (i386:local-ptr->accu (local:id local))))
|
|
|
|
((1) (wrap-as (i386:local->accu (local:id local))))
|
2017-03-17 16:32:23 +00:00
|
|
|
(else
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (if (= size 1) (i386:byte-local->accu (local:id local))
|
2017-04-07 12:31:35 +00:00
|
|
|
(i386:local->accu (local:id local)))))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(if global
|
2017-04-17 00:15:11 +00:00
|
|
|
(let* ((ptr (ident->pointer info o))
|
|
|
|
(type (ident->type info o))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(case ptr
|
2017-07-20 08:05:48 +00:00
|
|
|
((-2) (list (i386:label->accu `(#:address ,o))))
|
2017-06-11 16:05:56 +00:00
|
|
|
((-1) (list (i386:label->accu `(#:address ,o))))
|
|
|
|
(else (list (i386:label-mem->accu `(#:address ,o))))))
|
2017-04-07 07:36:30 +00:00
|
|
|
(if constant (wrap-as (i386:value->accu constant))
|
2017-06-11 16:05:56 +00:00
|
|
|
(list (i386:label->accu `(#:address ,o)))))))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-20 08:05:48 +00:00
|
|
|
(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))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (and type (= ptr 1)) (ast-type->size info type)
|
2017-07-20 08:05:48 +00:00
|
|
|
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)))))))))))
|
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
(define (ident-address->accu info)
|
|
|
|
(lambda (o)
|
|
|
|
(let ((local (assoc-ref (.locals info) o))
|
|
|
|
(global (assoc-ref (.globals info) o))
|
|
|
|
(constant (assoc-ref (.constants info) o)))
|
2017-06-11 11:11:40 +00:00
|
|
|
(if local (let* ((ptr (local:pointer local))
|
|
|
|
(type (ident->type info o))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-06-11 11:11:40 +00:00
|
|
|
4)))
|
2017-04-17 00:15:11 +00:00
|
|
|
(wrap-as (i386:local-ptr->accu (local:id local))))
|
2017-06-11 16:05:56 +00:00
|
|
|
(if global (list (i386:label->accu `(#:address ,o)))
|
|
|
|
(list (i386:label->accu `(#:address ,o))))))))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
|
|
|
(define (ident-address->base info)
|
|
|
|
(lambda (o)
|
|
|
|
(let ((local (assoc-ref (.locals info) o))
|
|
|
|
(global (assoc-ref (.globals info) o))
|
|
|
|
(constant (assoc-ref (.constants info) o)))
|
|
|
|
(if local
|
|
|
|
(let* ((ptr (local:pointer local))
|
|
|
|
(type (ident->type info o))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
|
|
|
(wrap-as (i386:local-ptr->base (local:id local))))
|
2017-06-11 16:05:56 +00:00
|
|
|
(if global (list (i386:label->base `(#:address ,o)))
|
2017-07-20 08:05:48 +00:00
|
|
|
(list (i386:label->base `(#:address ,o))))))))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (value->accu v)
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (i386:value->accu v)))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
|
|
|
(define (accu->ident info)
|
2017-01-03 11:52:59 +00:00
|
|
|
(lambda (o)
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-06-11 11:11:40 +00:00
|
|
|
(if local (wrap-as (i386:accu->local (local:id local)))
|
2017-04-17 00:15:11 +00:00
|
|
|
(let ((ptr (ident->pointer info o)))
|
2017-06-11 16:05:56 +00:00
|
|
|
(list (i386:accu->label `(#:address ,o))))))))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (base->ident info)
|
2017-01-17 17:57:41 +00:00
|
|
|
(lambda (o)
|
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-04-07 07:36:30 +00:00
|
|
|
(if local (wrap-as (i386:base->local (local:id local)))
|
2017-06-11 16:05:56 +00:00
|
|
|
(list (i386:base->label `(#:address ,o)))))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
|
|
|
(define (base->ident-address info)
|
|
|
|
(lambda (o)
|
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-04-17 00:15:11 +00:00
|
|
|
(if local
|
|
|
|
(let* ((ptr (local:pointer local))
|
|
|
|
(type (ident->type info o))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
2017-07-28 16:04:39 +00:00
|
|
|
- (wrap-as (append (i386:local->accu (local:id local))
|
2017-04-17 00:15:11 +00:00
|
|
|
(if (= size 1) (i386:byte-base->accu-address)
|
2017-07-28 13:45:22 +00:00
|
|
|
(i386:base->accu-address)))))
|
2017-07-28 16:04:39 +00:00
|
|
|
(let ((ptr (ident->pointer info o))
|
|
|
|
(size 4)) ;; FIXME size
|
|
|
|
(case ptr
|
|
|
|
((-2) (wrap-as (append (i386:label->accu `(#:address ,o))
|
|
|
|
(if (= size 1) (i386:byte-base->accu-address)
|
|
|
|
(i386:base->accu-address)))))
|
|
|
|
((-1) (wrap-as (append (i386:label->accu `(#:address ,o))
|
|
|
|
(if (= size 1) (i386:byte-base->accu-address)
|
|
|
|
(i386:base->accu-address)))))
|
|
|
|
(else (wrap-as (append (i386:label-mem->accu `(#:address ,o))
|
|
|
|
(if (= size 1) (i386:byte-base->accu-address)
|
|
|
|
(i386:base->accu-address)))))))))))
|
2017-01-17 17:57:41 +00:00
|
|
|
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(define (value->ident info)
|
|
|
|
(lambda (o value)
|
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-04-07 07:36:30 +00:00
|
|
|
(if local (wrap-as (i386:value->local (local:id local) value))
|
2017-06-11 16:05:56 +00:00
|
|
|
(list (i386:value->label `(#:address ,o) value))))))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (ident-add info)
|
|
|
|
(lambda (o n)
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
2017-04-07 07:36:30 +00:00
|
|
|
(if local (wrap-as (i386:local-add (local:id local) n))
|
2017-06-11 16:05:56 +00:00
|
|
|
(list (i386:label-mem-add `(#:address ,o) n))))))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
2017-07-17 05:33:38 +00:00
|
|
|
(define (expr-add info)
|
|
|
|
(lambda (o n)
|
|
|
|
(let* ((info ((expr->accu* info) o))
|
|
|
|
(info (append-text info (wrap-as (i386:accu-mem-add n)))))
|
|
|
|
info)))
|
|
|
|
|
|
|
|
(define (expr->pointer info o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (ident ,name)) (ident->pointer info name)) ;; FIXME
|
|
|
|
(_ 0)))
|
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
(define (ident-address-add info)
|
|
|
|
(lambda (o n)
|
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
|
|
|
(if local (wrap-as (append (i386:push-accu)
|
|
|
|
(i386:local->accu (local:id local))
|
|
|
|
(i386:accu-mem-add n)
|
|
|
|
(i386:pop-accu)))
|
2017-06-11 11:11:40 +00:00
|
|
|
(list (wrap-as (append (i386:push-accu)
|
2017-06-11 16:05:56 +00:00
|
|
|
(i386:label->accu `(#:address ,o))
|
2017-06-11 11:11:40 +00:00
|
|
|
(i386:accu-mem-add n)
|
|
|
|
(i386:pop-accu))))))))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
2017-01-04 23:55:46 +00:00
|
|
|
(define (expr->accu info)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(lambda (o)
|
2017-04-05 18:11:13 +00:00
|
|
|
(let ((locals (.locals info))
|
|
|
|
(constants (.constants info))
|
|
|
|
(text (.text info))
|
2017-03-09 07:14:27 +00:00
|
|
|
(globals (.globals info)))
|
2017-04-05 18:11:13 +00:00
|
|
|
(define (add-local locals name type pointer)
|
2017-07-15 09:46:13 +00:00
|
|
|
(let* ((id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
|
2017-05-04 17:39:23 +00:00
|
|
|
(1+ (local:id (cdar locals)))))
|
2017-07-15 09:46:13 +00:00
|
|
|
(locals (cons (make-local-entry name type pointer id) locals)))
|
2017-04-05 18:11:13 +00:00
|
|
|
locals))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(pmatch o
|
2017-05-08 19:32:32 +00:00
|
|
|
((expr) info)
|
2017-07-16 22:29:18 +00:00
|
|
|
|
|
|
|
((comma-expr) info)
|
|
|
|
|
|
|
|
((comma-expr ,a . ,rest)
|
|
|
|
(let ((info ((expr->accu info) a)))
|
|
|
|
((expr->accu info) `(comma-expr ,@rest))))
|
|
|
|
|
2017-03-09 07:14:27 +00:00
|
|
|
((p-expr (string ,string))
|
2017-06-12 08:49:31 +00:00
|
|
|
(let* ((globals ((globals:add-string globals) string))
|
2017-04-17 00:15:11 +00:00
|
|
|
(info (clone info #:globals globals)))
|
2017-06-11 16:05:56 +00:00
|
|
|
(append-text info (list (i386:label->accu `(#:string ,string))))))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
2017-07-20 08:05:48 +00:00
|
|
|
;;; 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)))))
|
|
|
|
|
2017-04-12 19:27:59 +00:00
|
|
|
((p-expr (string . ,strings))
|
2017-06-11 16:05:56 +00:00
|
|
|
(append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((p-expr (ident ,name))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info ((ident->accu info) name)))
|
2017-04-06 07:12:50 +00:00
|
|
|
|
2017-07-20 08:05:48 +00:00
|
|
|
((initzer ,initzer)
|
|
|
|
((expr->accu info) initzer))
|
2017-05-06 09:01:58 +00:00
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
;; offsetoff
|
|
|
|
((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
|
|
|
|
(let* ((type (decl->ast-type struct))
|
|
|
|
(offset (field-offset info type field))
|
|
|
|
(base (cstring->number base)))
|
|
|
|
(append-text info (wrap-as (i386:value->accu (+ base offset))))))
|
|
|
|
|
2017-05-06 09:01:58 +00:00
|
|
|
;; &foo
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((ref-to (p-expr (ident ,name)))
|
2017-05-06 09:01:58 +00:00
|
|
|
(append-text info ((ident-address->accu info) name)))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
;; &*foo
|
|
|
|
((ref-to (de-ref ,expr))
|
|
|
|
((expr->accu info) expr))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
((ref-to ,expr)
|
|
|
|
((expr->accu* info) expr))
|
2017-05-07 05:36:44 +00:00
|
|
|
|
2017-05-08 19:32:32 +00:00
|
|
|
((sizeof-expr (p-expr (ident ,name)))
|
|
|
|
(let* ((type (ident->type info name))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (ast-type->size info type)))
|
2017-05-08 19:32:32 +00:00
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
|
|
|
|
2017-07-23 11:56:38 +00:00
|
|
|
((sizeof-expr (p-expr (string ,string)))
|
|
|
|
(append-text info (wrap-as (i386:value->accu (1+ (string-length string))))))
|
|
|
|
|
2017-07-17 05:54:48 +00:00
|
|
|
((sizeof-expr (i-sel (ident ,field) (p-expr (ident ,array))))
|
|
|
|
(let* ((type (ident->type info array))
|
|
|
|
(size (field-size info type field)))
|
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
2017-07-23 12:18:00 +00:00
|
|
|
|
|
|
|
((sizeof-expr (d-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let* ((type (ident->type info struct))
|
|
|
|
(size (field-size info type field)))
|
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
2017-07-17 05:54:48 +00:00
|
|
|
|
2017-05-08 19:32:32 +00:00
|
|
|
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,name)))))
|
|
|
|
(let* ((type name)
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (ast-type->size info type)))
|
2017-05-08 19:32:32 +00:00
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
|
|
|
|
2017-07-23 16:56:07 +00:00
|
|
|
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident (,type)))))))
|
|
|
|
(let* ((type `("tag" ,type))
|
2017-07-16 17:00:01 +00:00
|
|
|
(size (ast-type->size info type)))
|
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
|
|
|
|
2017-07-23 16:56:07 +00:00
|
|
|
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,type))))))
|
|
|
|
(let* ((type `("tag" ,type))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (ast-type->size info type)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
2017-05-08 19:32:32 +00:00
|
|
|
|
2017-07-17 05:37:03 +00:00
|
|
|
((sizeof-type (type-name (decl-spec-list (type-spec (typename ,type)))))
|
|
|
|
(let ((size (ast-type->size info type)))
|
2017-05-25 05:32:29 +00:00
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
((sizeof-type (type-name (decl-spec-list ,type) (abs-declr (pointer))))
|
2017-07-05 16:48:08 +00:00
|
|
|
(let ((size 4))
|
|
|
|
(append-text info (wrap-as (i386:value->accu size)))))
|
|
|
|
|
2017-03-13 18:38:38 +00:00
|
|
|
;; c+p expr->arg
|
2017-04-05 12:24:34 +00:00
|
|
|
;; g_cells[<expr>]
|
|
|
|
((array-ref ,index (p-expr (ident ,array)))
|
2017-04-07 21:06:09 +00:00
|
|
|
(let* ((type (ident->type info array))
|
2017-04-17 00:15:11 +00:00
|
|
|
(ptr (ident->pointer info array))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (or (= ptr 1) (= ptr -1)) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4))
|
2017-04-07 21:06:09 +00:00
|
|
|
(info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (append (case size
|
|
|
|
((1) (i386:byte-mem->accu))
|
|
|
|
((4) (i386:mem->accu))
|
|
|
|
(else '())))))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-05-31 18:52:48 +00:00
|
|
|
;; foo.bar[baz])
|
|
|
|
((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
|
|
|
;; foo->bar[baz])
|
|
|
|
((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
2017-07-05 16:48:08 +00:00
|
|
|
;; <expr>[baz]
|
|
|
|
((array-ref ,index ,array)
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
;; bar.f.i
|
|
|
|
((d-sel (ident ,field1) (d-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
|
|
|
;; bar.poo->i
|
|
|
|
((i-sel (ident ,field1) (d-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
|
|
|
;; bar->foo.i
|
|
|
|
((d-sel (ident ,field1) (i-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
|
|
|
;;(i-sel (ident "i") (i-sel (ident "p") (p-expr (ident "p"))))
|
|
|
|
((i-sel (ident ,field1) (i-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
|
|
|
;; (*pp)->bar.foo
|
|
|
|
((d-sel (ident ,field1) (i-sel (ident ,field0) (de-ref (p-expr (ident ,struct0)))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
2017-07-25 23:13:33 +00:00
|
|
|
;; foo.bar
|
2017-07-18 18:22:44 +00:00
|
|
|
((d-sel (ident ,field) (p-expr (ident ,struct)))
|
|
|
|
(let* ((type (ident->type info struct))
|
2017-07-25 23:13:33 +00:00
|
|
|
(offset (field-offset info type field))
|
|
|
|
(ptr (field-pointer info type field)))
|
|
|
|
(if (= ptr -1)
|
|
|
|
(append-text info (append ((ident->accu info) struct)
|
|
|
|
(wrap-as (i386:accu+value offset))))
|
|
|
|
(append-text info (append ((ident->accu info) struct)
|
|
|
|
(wrap-as (i386:mem+n->accu offset)))))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
|
|
|
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
|
2017-04-07 21:06:09 +00:00
|
|
|
(let* ((type (ident->type info array))
|
2017-05-31 18:52:48 +00:00
|
|
|
(offset (field-offset info type field))
|
2017-04-07 21:06:09 +00:00
|
|
|
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
|
|
|
|
(append-text info (wrap-as (i386:mem+n->accu offset)))))
|
|
|
|
|
2017-05-06 09:01:58 +00:00
|
|
|
((i-sel (ident ,field) (p-expr (ident ,array)))
|
|
|
|
(let* ((type (ident->type info array))
|
2017-07-25 23:13:33 +00:00
|
|
|
(offset (field-offset info type field))
|
|
|
|
(ptr (field-pointer info type field)))
|
|
|
|
(if (= ptr -1)
|
|
|
|
(append-text info (append ((ident-address->accu info) array)
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset))))
|
|
|
|
(append-text info (append ((ident-address->accu info) array)
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:mem+n->accu offset)))))))
|
2017-05-06 09:01:58 +00:00
|
|
|
|
2017-07-16 21:39:59 +00:00
|
|
|
((i-sel (ident ,field) (de-ref (p-expr (ident ,array))))
|
|
|
|
(let* ((type (ident->type info array))
|
2017-07-18 18:22:44 +00:00
|
|
|
(offset (field-offset info type field)))
|
2017-07-16 21:39:59 +00:00
|
|
|
(append-text info (append ((ident-address->accu info) array)
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:mem+n->accu offset))))))
|
|
|
|
|
2017-07-22 21:39:39 +00:00
|
|
|
;; foo[i].bar.baz
|
|
|
|
((d-sel (ident ,field1) (d-sel (ident ,field0) (array-ref ,index (p-expr (ident ,array)))))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
;;foo[index]->bar
|
|
|
|
((i-sel (ident ,field) (array-ref ,index ,array))
|
|
|
|
(let ((info ((expr->accu* info) o)))
|
|
|
|
(append-text info (wrap-as (i386:mem->accu)))))
|
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((de-ref (p-expr (ident ,name)))
|
2017-03-17 16:32:23 +00:00
|
|
|
(let* ((type (ident->type info name))
|
2017-04-17 00:15:11 +00:00
|
|
|
(ptr (ident->pointer info name))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
2017-07-20 08:05:48 +00:00
|
|
|
(append-text info (append (if (or #t (assoc-ref locals name)) ((ident->accu info) name)
|
|
|
|
((ident-address->accu info) name))
|
2017-04-07 07:53:56 +00:00
|
|
|
(wrap-as (if (= size 1) (i386:byte-mem->accu)
|
|
|
|
(i386:mem->accu)))))))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-04-17 00:15:11 +00:00
|
|
|
((de-ref (post-inc (p-expr (ident ,name))))
|
|
|
|
(let* ((info ((expr->accu info) `(de-ref (p-expr (ident ,name)))))
|
|
|
|
(type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-05-07 05:36:44 +00:00
|
|
|
4)))
|
2017-04-17 00:15:11 +00:00
|
|
|
(append-text info ((ident-add info) name size))))
|
|
|
|
|
|
|
|
((de-ref ,expr)
|
2017-07-28 16:00:46 +00:00
|
|
|
(let* ((info ((expr->accu info) expr))
|
|
|
|
(ptr (expr->pointer info expr))
|
|
|
|
(size (if (= ptr 1) (expr->size info expr)
|
|
|
|
4)))
|
|
|
|
(append-text info (wrap-as (if (= size 1) (i386:byte-mem->accu)
|
|
|
|
(i386:mem->accu))))))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
2017-04-05 18:11:13 +00:00
|
|
|
((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
|
|
|
|
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
|
2017-07-02 14:25:14 +00:00
|
|
|
(append-text info (wrap-as (asm->m1 arg0))))
|
2017-04-23 11:53:36 +00:00
|
|
|
(let* ((text-length (length text))
|
2017-04-05 18:11:13 +00:00
|
|
|
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
|
|
|
(if (null? expressions) info
|
|
|
|
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
|
|
|
(n (length expr-list)))
|
2017-06-11 11:11:40 +00:00
|
|
|
(if (not (assoc-ref locals name))
|
|
|
|
(begin
|
|
|
|
(if (and (not (assoc name (.functions info)))
|
2017-07-09 09:01:30 +00:00
|
|
|
(not (assoc name globals))
|
|
|
|
(not (equal? name (.function info))))
|
2017-06-11 11:11:40 +00:00
|
|
|
(stderr "warning: undeclared function: ~a\n" name))
|
2017-06-25 07:33:55 +00:00
|
|
|
(append-text args-info (list (i386:call-label name n))))
|
2017-04-05 18:11:13 +00:00
|
|
|
(let* ((empty (clone info #:text '()))
|
|
|
|
(accu ((expr->accu empty) `(p-expr (ident ,name)))))
|
2017-04-23 11:53:36 +00:00
|
|
|
(append-text args-info (append (.text accu)
|
2017-06-11 11:11:40 +00:00
|
|
|
(list (i386:call-accu n)))))))))
|
2017-04-05 18:11:13 +00:00
|
|
|
|
|
|
|
((fctn-call ,function (expr-list . ,expr-list))
|
2017-04-23 11:53:36 +00:00
|
|
|
(let* ((text-length (length text))
|
2017-04-05 18:11:13 +00:00
|
|
|
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
|
|
|
(if (null? expressions) info
|
|
|
|
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
|
|
|
(n (length expr-list))
|
|
|
|
(empty (clone info #:text '()))
|
|
|
|
(accu ((expr->accu empty) function)))
|
2017-04-23 11:53:36 +00:00
|
|
|
(append-text args-info (append (.text accu)
|
2017-06-11 11:11:40 +00:00
|
|
|
(list (i386:call-accu n))))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
|
|
|
((cond-expr . ,cond-expr)
|
|
|
|
((ast->info info) `(expr-stmt ,o)))
|
|
|
|
|
|
|
|
((post-inc (p-expr (ident ,name)))
|
2017-04-17 00:15:11 +00:00
|
|
|
(let* ((type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
2017-07-28 08:40:30 +00:00
|
|
|
(size (cond ((= ptr 1) (ident->size info name))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1))))
|
2017-04-17 00:15:11 +00:00
|
|
|
(append-text info (append ((ident->accu info) name)
|
|
|
|
((ident-add info) name size)))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-04-05 21:05:16 +00:00
|
|
|
((post-dec (p-expr (ident ,name)))
|
2017-07-28 08:40:30 +00:00
|
|
|
(let* ((type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
|
|
|
(size (cond ((= ptr 1) (ident->size info name))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1))))
|
|
|
|
(append-text info (append ((ident->accu info) name)
|
|
|
|
((ident-add info) name (- size))))))
|
2017-04-05 21:05:16 +00:00
|
|
|
|
|
|
|
((pre-inc (p-expr (ident ,name)))
|
2017-07-28 08:40:30 +00:00
|
|
|
(let* ((type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
|
|
|
(size (cond ((= ptr 1) (ident->size info name))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1))))
|
|
|
|
(append-text info (append ((ident-add info) name size)
|
|
|
|
((ident->accu info) name)))))
|
2017-04-05 21:05:16 +00:00
|
|
|
|
|
|
|
((pre-dec (p-expr (ident ,name)))
|
2017-07-28 08:40:30 +00:00
|
|
|
(let* ((type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
|
|
|
(size (cond ((= ptr 1) (ident->size info name))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1))))
|
|
|
|
(append-text info (append ((ident-add info) name (- size))
|
|
|
|
((ident->accu info) name)))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-17 05:33:38 +00:00
|
|
|
((post-inc ,expr)
|
|
|
|
(let* ((info (append ((expr->accu info) expr)))
|
|
|
|
(info (append-text info (wrap-as (i386:push-accu))))
|
|
|
|
(ptr (expr->pointer info expr))
|
2017-07-28 08:40:30 +00:00
|
|
|
(size (cond ((= ptr 1) (expr->size info expr))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1)))
|
2017-07-17 05:33:38 +00:00
|
|
|
(info ((expr-add info) expr size))
|
|
|
|
(info (append-text info (wrap-as (i386:pop-accu)))))
|
|
|
|
info))
|
|
|
|
|
|
|
|
((post-dec ,expr)
|
|
|
|
(let* ((info (append ((expr->accu info) expr)))
|
|
|
|
(info (append-text info (wrap-as (i386:push-accu))))
|
|
|
|
(ptr (expr->pointer info expr))
|
2017-07-28 08:40:30 +00:00
|
|
|
(size (cond ((= ptr 1) (expr->size info expr))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1)))
|
2017-07-17 05:33:38 +00:00
|
|
|
(info ((expr-add info) expr (- size)))
|
|
|
|
(info (append-text info (wrap-as (i386:pop-accu)))))
|
|
|
|
info))
|
|
|
|
|
|
|
|
((pre-inc ,expr)
|
|
|
|
(let* ((ptr (expr->pointer info expr))
|
2017-07-28 08:40:30 +00:00
|
|
|
(size (cond ((= ptr 1) (expr->size info expr))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1)))
|
2017-07-17 05:33:38 +00:00
|
|
|
(info ((expr-add info) expr size))
|
|
|
|
(info (append ((expr->accu info) expr))))
|
|
|
|
info))
|
|
|
|
|
|
|
|
((pre-dec ,expr)
|
|
|
|
(let* ((ptr (expr->pointer info expr))
|
2017-07-28 08:40:30 +00:00
|
|
|
(size (cond ((= ptr 1) (expr->size info expr))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1)))
|
2017-07-17 05:33:38 +00:00
|
|
|
(info ((expr-add info) expr (- size)))
|
|
|
|
(info (append ((expr->accu info) expr))))
|
|
|
|
info))
|
|
|
|
|
2017-07-28 08:40:30 +00:00
|
|
|
((add ,a (p-expr (fixed ,value)))
|
|
|
|
(let* ((ptr (expr->pointer info a))
|
|
|
|
(size (cond ((= ptr 1) (expr->size info a))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1)))
|
|
|
|
(info ((expr->accu info) a))
|
|
|
|
(value (cstring->number value))
|
|
|
|
(value (* size value)))
|
|
|
|
(append-text info (wrap-as (i386:accu+value value)))))
|
|
|
|
|
|
|
|
((add ,a ,b)
|
|
|
|
(let* ((ptr (expr->pointer info a))
|
|
|
|
(size (cond ((= ptr 1) (expr->size info a))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1))))
|
|
|
|
(if (not (= size 1))
|
|
|
|
(warn (format #f "TODO: pointer arithmetic: ~s\n" o))))
|
|
|
|
((binop->accu info) a b (i386:accu+base)))
|
|
|
|
|
|
|
|
((sub ,a (p-expr (fixed ,value)))
|
|
|
|
(let* ((ptr (expr->pointer info a))
|
|
|
|
(size (cond ((= ptr 1) (expr->size info a))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1)))
|
|
|
|
(info ((expr->accu info) a))
|
|
|
|
(value (cstring->number value))
|
|
|
|
(value (* size value)))
|
|
|
|
(stderr "sub[~s]: ~s + ~s\n" size a value)
|
|
|
|
(append-text info (wrap-as (i386:accu+value (- value))))))
|
|
|
|
|
|
|
|
((sub ,a ,b)
|
|
|
|
(let* ((ptr (expr->pointer info a))
|
|
|
|
(size (cond ((= ptr 1) (expr->size info a))
|
|
|
|
((> ptr 1) 4)
|
|
|
|
(else 1))))
|
|
|
|
(if (not (= size 1))
|
|
|
|
(warn (format #f "TODO: pointer arithmetic: ~s\n" o))))
|
|
|
|
((binop->accu info) a b (i386:accu-base)))
|
|
|
|
|
2017-05-06 12:57:39 +00:00
|
|
|
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
|
2017-07-21 08:39:04 +00:00
|
|
|
((bitwise-not ,expr)
|
|
|
|
(let ((info ((ast->info info) expr)))
|
|
|
|
(append-text info (wrap-as (i386:accu-not)))))
|
|
|
|
((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
|
2017-05-06 12:57:39 +00:00
|
|
|
((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
|
2017-04-07 12:31:35 +00:00
|
|
|
((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
|
|
|
|
((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
|
|
|
|
((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
|
|
|
|
((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
|
|
|
|
((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
|
mescc: Mini-mes (gcc-compiled) runs read-0.mes.
* module/language/c99/compiler.mes (expr->accu): Add mul.
(test->jump->info): Add le, ge.
(ast->info): Support int and char* initialization at top level.
* module/mes/as-i386.mes (i386:accu*base, i386:Xjump-cz,
i386:Xjump-ncz): New function.
* module/mes/as-i386.scm: Export them.
* doc/examples/t.c (test): Test them.
* module/mes/libc.mes (ungetc): New function.
(getchar): Support it.
(assert_fail, isdigit): New functions.
(libc): Export them.
* module/mes/mini-0.mes: Load full reader.
* mlibc.c (ungetc): New function.
(getchar): Support it.
(assert_fail, isdigit): New functions.
* mes.c (list length error lookup_ getchar ungetchar peekchar
peek_byte read_byte unread_byte greater_p less_p): Move functions
needed to run read-0.mes into core.
* doc/examples/mini-mes.c: Likewise.
* lib.c (length, error): Comment-out.
* math.c (greater_p, less_p): Comment-out.
* posix.c: (getchar, ungetchar, peekchar, peek_byte, read_byte,
unread_byte): Comment-out.
* reader.c (lookup_): Comment-out.
2017-03-22 05:39:24 +00:00
|
|
|
|
2017-04-06 07:12:50 +00:00
|
|
|
((not ,expr)
|
|
|
|
(let* ((test-info ((ast->info info) expr)))
|
|
|
|
(clone info #:text
|
|
|
|
(append (.text test-info)
|
2017-07-21 08:39:04 +00:00
|
|
|
(wrap-as (i386:accu-negate)))
|
2017-04-06 07:12:50 +00:00
|
|
|
#:globals (.globals test-info))))
|
|
|
|
|
2017-07-23 07:18:36 +00:00
|
|
|
((neg ,expr)
|
|
|
|
(let ((info ((expr->base info) expr)))
|
|
|
|
(append-text info (append (wrap-as (i386:value->accu 0))
|
|
|
|
(wrap-as (i386:sub-base))))))
|
2017-04-06 07:12:50 +00:00
|
|
|
|
2017-05-06 15:30:14 +00:00
|
|
|
((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
|
2017-04-07 12:31:35 +00:00
|
|
|
((ge ,a ,b) ((binop->accu info) b a (i386:sub-base)))
|
|
|
|
((gt ,a ,b) ((binop->accu info) b a (i386:sub-base)))
|
2017-05-06 15:30:14 +00:00
|
|
|
|
|
|
|
;; FIXME: set accu *and* flags
|
|
|
|
((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
|
|
|
|
(i386:sub-base)
|
|
|
|
(i386:nz->accu)
|
|
|
|
(i386:accu<->stack)
|
|
|
|
(i386:sub-base)
|
|
|
|
(i386:xor-zf)
|
|
|
|
(i386:pop-accu))))
|
|
|
|
|
|
|
|
((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
|
2017-04-07 12:31:35 +00:00
|
|
|
((le ,a ,b) ((binop->accu info) b a (i386:base-sub)))
|
|
|
|
((lt ,a ,b) ((binop->accu info) b a (i386:base-sub)))
|
2017-03-12 10:05:20 +00:00
|
|
|
|
2017-05-06 12:57:39 +00:00
|
|
|
((or ,a ,b)
|
2017-06-25 07:33:55 +00:00
|
|
|
(let* ((info ((expr->accu info) a))
|
|
|
|
(here (number->string (length (.text info))))
|
|
|
|
(skip-b-label (string-append (.function info) "_" here "_or_skip_b"))
|
2017-05-06 12:57:39 +00:00
|
|
|
(info (append-text info (wrap-as (i386:accu-test))))
|
2017-06-25 07:33:55 +00:00
|
|
|
(info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
|
2017-06-12 20:11:19 +00:00
|
|
|
(info (append-text info (wrap-as (i386:accu-test))))
|
2017-05-06 12:57:39 +00:00
|
|
|
(info ((expr->accu info) b))
|
2017-06-12 20:11:19 +00:00
|
|
|
(info (append-text info (wrap-as (i386:accu-test))))
|
2017-07-02 14:25:14 +00:00
|
|
|
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
2017-05-06 12:57:39 +00:00
|
|
|
info))
|
|
|
|
|
|
|
|
((and ,a ,b)
|
2017-06-25 07:33:55 +00:00
|
|
|
(let* ((info ((expr->accu info) a))
|
|
|
|
(here (number->string (length (.text info))))
|
|
|
|
(skip-b-label (string-append (.function info) "_" here "_and_skip_b"))
|
2017-05-06 12:57:39 +00:00
|
|
|
(info (append-text info (wrap-as (i386:accu-test))))
|
2017-06-25 07:33:55 +00:00
|
|
|
(info (append-text info (wrap-as (i386:jump-z skip-b-label))))
|
2017-06-12 20:11:19 +00:00
|
|
|
(info (append-text info (wrap-as (i386:accu-test))))
|
2017-05-06 12:57:39 +00:00
|
|
|
(info ((expr->accu info) b))
|
2017-06-12 20:11:19 +00:00
|
|
|
(info (append-text info (wrap-as (i386:accu-test))))
|
2017-07-02 14:25:14 +00:00
|
|
|
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
2017-05-06 12:57:39 +00:00
|
|
|
info))
|
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((cast ,cast ,o)
|
|
|
|
((expr->accu info) o))
|
|
|
|
|
2017-05-07 05:36:44 +00:00
|
|
|
((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
|
2017-07-17 05:33:38 +00:00
|
|
|
(let* ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b)))
|
|
|
|
(type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
|
|
|
(size (if (> ptr 1) 4 1)))
|
|
|
|
(append-text info ((ident-add info) name size)))) ;; FIXME: size
|
2017-05-07 05:36:44 +00:00
|
|
|
|
|
|
|
((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
|
2017-07-17 05:33:38 +00:00
|
|
|
(let* ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b)))
|
|
|
|
(type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
|
|
|
(size (if (> ptr 1) 4 1)))
|
|
|
|
(append-text info ((ident-add info) name (- size))))) ;; FIXME: size
|
2017-05-07 05:36:44 +00:00
|
|
|
|
2017-04-08 04:31:12 +00:00
|
|
|
((assn-expr ,a (op ,op) ,b)
|
2017-06-25 07:33:55 +00:00
|
|
|
(let* ((info (append-text info (ast->comment o)))
|
|
|
|
(info ((expr->accu info) b))
|
2017-04-08 04:31:12 +00:00
|
|
|
(info (if (equal? op "=") info
|
|
|
|
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
|
|
|
(info ((expr->accu info) a))
|
|
|
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
|
|
|
(append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
|
|
|
|
((equal? op "-=") (wrap-as (i386:accu-base)))
|
|
|
|
((equal? op "*=") (wrap-as (i386:accu*base)))
|
|
|
|
((equal? op "/=") (wrap-as (i386:accu/base)))
|
|
|
|
((equal? op "%=") (wrap-as (i386:accu%base)))
|
2017-07-18 18:22:44 +00:00
|
|
|
((equal? op "&=") (wrap-as (i386:accu-and-base)))
|
2017-07-21 08:39:04 +00:00
|
|
|
((equal? op "|=") (wrap-as (i386:accu-or-base)))
|
|
|
|
((equal? op "^=") (wrap-as (i386:accu-xor-base)))
|
2017-07-23 06:51:42 +00:00
|
|
|
((equal? op ">>=") (wrap-as (i386:accu>>base)))
|
|
|
|
((equal? op "<<=") (wrap-as (i386:accu<<base)))
|
2017-07-21 08:39:04 +00:00
|
|
|
(else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))))
|
2017-04-08 04:31:12 +00:00
|
|
|
(pmatch a
|
|
|
|
((p-expr (ident ,name)) (append-text info ((accu->ident info) name)))
|
2017-05-04 17:39:23 +00:00
|
|
|
((d-sel (ident ,field) ,p-expr)
|
|
|
|
(let* ((type (p-expr->type info p-expr))
|
2017-07-23 16:56:07 +00:00
|
|
|
(offset (field-offset info type field))
|
2017-04-08 04:31:12 +00:00
|
|
|
(info (append-text info (wrap-as (i386:push-accu))))
|
|
|
|
(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
|
2017-07-20 08:05:48 +00:00
|
|
|
((de-ref (p-expr (ident ,name)))
|
|
|
|
(let* ((type (ident->type info name))
|
|
|
|
(ptr (ident->pointer info name))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (= ptr 1) (ast-type->size info type)
|
2017-07-28 16:04:39 +00:00
|
|
|
4)))
|
2017-05-07 05:36:44 +00:00
|
|
|
(append-text info (append (wrap-as (i386:accu->base))
|
2017-07-28 13:27:25 +00:00
|
|
|
((base->ident-address info) name))))) ; FIXME: size
|
2017-07-18 18:22:44 +00:00
|
|
|
((de-ref ,expr)
|
2017-07-28 13:27:25 +00:00
|
|
|
(let* ((info ((expr->base info) expr))
|
|
|
|
(ptr (expr->pointer info expr))
|
|
|
|
(size (expr->size info expr)))
|
|
|
|
(append-text info (wrap-as (i386:accu->base-address)))))
|
2017-05-31 18:52:48 +00:00
|
|
|
((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))
|
|
|
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
|
|
|
(append-text info (wrap-as (i386:base->accu-address)))))
|
|
|
|
((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
|
|
|
(info ((expr->accu* info) a))
|
|
|
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
|
|
|
(append-text info (wrap-as (i386:base->accu-address)))))
|
2017-04-08 04:31:12 +00:00
|
|
|
((array-ref ,index (p-expr (ident ,array)))
|
|
|
|
(let* ((type (ident->type info array))
|
2017-07-28 16:00:46 +00:00
|
|
|
(ptr (ident->pointer info array))
|
|
|
|
(size (if (or (= ptr 1) (= ptr -1)) (ast-type->size info type)
|
|
|
|
4))
|
2017-06-11 11:11:40 +00:00
|
|
|
(info (append-text info (wrap-as (i386:push-accu))))
|
2017-04-08 04:31:12 +00:00
|
|
|
(info ((expr->accu* info) a))
|
2017-06-11 11:11:40 +00:00
|
|
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
2017-04-08 04:31:12 +00:00
|
|
|
(append-text info
|
|
|
|
(append (if (eq? size 1) (wrap-as (i386:byte-base->accu-address))
|
2017-05-05 07:24:19 +00:00
|
|
|
(if (<= size 4) (wrap-as (i386:base->accu-address))
|
|
|
|
(append
|
|
|
|
(wrap-as (i386:base-address->accu-address))
|
2017-07-24 06:36:43 +00:00
|
|
|
(wrap-as (append (i386:accu+value 4)
|
|
|
|
(i386:base+value 4)
|
2017-05-05 07:24:19 +00:00
|
|
|
(i386:base-address->accu-address)))
|
|
|
|
(if (<= size 8) '()
|
2017-07-24 06:36:43 +00:00
|
|
|
(wrap-as (append (i386:accu+value 4)
|
|
|
|
(i386:base+value 4)
|
2017-05-05 07:24:19 +00:00
|
|
|
(i386:base-address->accu-address)))))))))))
|
2017-07-16 21:39:59 +00:00
|
|
|
|
|
|
|
((i-sel (ident ,field) ,array)
|
|
|
|
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
|
|
|
(info ((expr->accu* info) a))
|
|
|
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
|
|
|
(append-text info (wrap-as (i386:base->accu-address)))))
|
|
|
|
|
2017-04-12 19:27:59 +00:00
|
|
|
(_ (error "expr->accu: unsupported assign: " a)))))
|
2017-04-06 07:12:50 +00:00
|
|
|
|
2017-04-12 19:27:59 +00:00
|
|
|
(_ (error "expr->accu: unsupported: " o))))))
|
2017-04-06 07:12:50 +00:00
|
|
|
|
2017-04-07 12:41:47 +00:00
|
|
|
(define (expr->base info)
|
2017-04-06 21:05:44 +00:00
|
|
|
(lambda (o)
|
2017-04-07 07:36:30 +00:00
|
|
|
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
2017-04-06 21:05:44 +00:00
|
|
|
(info ((expr->accu info) o))
|
2017-04-07 07:36:30 +00:00
|
|
|
(info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu))))))
|
2017-04-06 21:05:44 +00:00
|
|
|
info)))
|
|
|
|
|
2017-04-07 12:31:35 +00:00
|
|
|
(define (binop->accu info)
|
2017-04-07 05:06:35 +00:00
|
|
|
(lambda (a b c)
|
|
|
|
(let* ((info ((expr->accu info) a))
|
2017-04-07 12:41:47 +00:00
|
|
|
(info ((expr->base info) b)))
|
2017-04-07 07:36:30 +00:00
|
|
|
(append-text info (wrap-as c)))))
|
2017-04-07 05:06:35 +00:00
|
|
|
|
2017-06-11 11:11:40 +00:00
|
|
|
(define (wrap-as o . annotation)
|
|
|
|
`(,@annotation ,o))
|
2017-04-07 05:06:35 +00:00
|
|
|
|
2017-06-25 07:33:55 +00:00
|
|
|
(define (make-comment o)
|
2017-07-02 14:25:14 +00:00
|
|
|
(wrap-as `((#:comment ,o))))
|
2017-06-25 07:33:55 +00:00
|
|
|
|
|
|
|
(define (ast->comment o)
|
|
|
|
(let ((source (with-output-to-string (lambda () (pretty-print-c99 o)))))
|
|
|
|
(make-comment (string-join (string-split source #\newline) " "))))
|
|
|
|
|
2017-04-06 07:12:50 +00:00
|
|
|
(define (expr->accu* info)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
2017-04-06 21:05:44 +00:00
|
|
|
;; g_cells[<expr>]
|
|
|
|
((array-ref ,index (p-expr (ident ,array)))
|
|
|
|
(let* ((info ((expr->accu info) index))
|
|
|
|
(type (ident->type info array))
|
2017-04-17 00:15:11 +00:00
|
|
|
(ptr (ident->pointer info array))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (if (or (= ptr 1) (= ptr -1)) (ast-type->size info type)
|
2017-04-17 00:15:11 +00:00
|
|
|
4)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info (append (wrap-as (append (i386:accu->base)
|
|
|
|
(if (eq? size 1) '()
|
|
|
|
(append
|
|
|
|
(if (<= size 4) '()
|
|
|
|
(i386:accu+accu))
|
|
|
|
(if (<= size 8) '()
|
|
|
|
(i386:accu+base))
|
|
|
|
(i386:accu-shl 2)))))
|
|
|
|
((ident->base info) array)
|
|
|
|
(wrap-as (i386:accu+base))))))
|
2017-04-06 21:05:44 +00:00
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
;; bar.foo.i
|
|
|
|
((d-sel (ident ,field1) (d-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let* ((type0 (ident->type info struct0))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset (+ (field-offset info type0 field0)
|
|
|
|
(field-offset info type1 field1))))
|
2017-07-18 18:22:44 +00:00
|
|
|
(append-text info (append ((ident->accu info) struct0)
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
|
|
|
;; bar.poo->i
|
|
|
|
((i-sel (ident ,field1) (d-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let* ((type0 (ident->type info struct0))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset0 (field-offset info type0 field0))
|
|
|
|
(offset1 (field-offset info type1 field1)))
|
2017-07-18 18:22:44 +00:00
|
|
|
(append-text info (append ((ident->accu info) struct0)
|
|
|
|
(wrap-as (i386:accu+value offset0))
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset1))))))
|
|
|
|
|
|
|
|
;; bar->foo.i
|
|
|
|
((d-sel (ident ,field1) (i-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let* ((type0 (ident->type info struct0))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset (+ (field-offset info type0 field0)
|
|
|
|
(field-offset info type1 field1))))
|
2017-07-18 18:22:44 +00:00
|
|
|
(append-text info (append ((ident-address->accu info) struct0)
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
|
|
|
;; bar->foo.i
|
|
|
|
((d-sel (ident ,field1) (d-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let* ((type0 (ident->type info struct0))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset (+ (field-offset info type0 field0)
|
|
|
|
(field-offset info type1 field1))))
|
2017-07-18 18:22:44 +00:00
|
|
|
(append-text info (append ((ident->accu info) struct0)
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
|
|
|
;;(i-sel (ident "i") (i-sel (ident "p") (p-expr (ident "p"))))
|
|
|
|
((i-sel (ident ,field1) (i-sel (ident ,field0) (p-expr (ident ,struct0))))
|
|
|
|
(let* ((type0 (ident->type info struct0))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset0 (field-offset info type0 field0))
|
|
|
|
(offset1 (field-offset info type1 field1)))
|
2017-07-18 18:22:44 +00:00
|
|
|
(append-text info (append ((ident->accu info) struct0)
|
|
|
|
(wrap-as (i386:accu+value offset0))
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset1))))))
|
|
|
|
|
|
|
|
;; (*pp)->bar.foo
|
|
|
|
((d-sel (ident ,field1) (i-sel (ident ,field0) (de-ref (p-expr (ident ,struct0)))))
|
|
|
|
(let* ((type0 (ident->type info struct0))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset (+ (field-offset info type0 field0)
|
|
|
|
(field-offset info type1 field1))))
|
2017-07-18 18:22:44 +00:00
|
|
|
(append-text info (append ((ident->accu info) struct0)
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
2017-04-07 21:06:09 +00:00
|
|
|
;; g_cells[<expr>].type
|
|
|
|
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
|
2017-04-06 07:12:50 +00:00
|
|
|
(let* ((type (ident->type info array))
|
2017-05-31 18:52:48 +00:00
|
|
|
(offset (field-offset info type field))
|
2017-04-07 21:06:09 +00:00
|
|
|
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
|
2017-06-11 11:11:40 +00:00
|
|
|
(append-text info (wrap-as (i386:accu+value offset)))))
|
2017-04-06 07:12:50 +00:00
|
|
|
|
2017-07-25 23:13:33 +00:00
|
|
|
;; foo.bar
|
2017-07-18 18:22:44 +00:00
|
|
|
((d-sel (ident ,field) (p-expr (ident ,struct)))
|
|
|
|
(let* ((type (ident->type info struct))
|
2017-05-31 18:52:48 +00:00
|
|
|
(offset (field-offset info type field))
|
2017-07-25 23:13:33 +00:00
|
|
|
(text (.text info))
|
|
|
|
(ptr (field-pointer info type field)))
|
|
|
|
(if (= ptr -1)
|
|
|
|
(append-text info (append ((ident-address->accu info) struct)
|
|
|
|
(wrap-as (i386:accu+value offset))))
|
|
|
|
(append-text info (append ((ident->accu info) struct)
|
|
|
|
(wrap-as (i386:accu+value offset)))))))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-05-31 18:52:48 +00:00
|
|
|
;; foo.bar[baz]
|
2017-07-18 18:22:44 +00:00
|
|
|
((array-ref ,index (d-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let* ((type (ident->type info struct))
|
2017-05-31 18:52:48 +00:00
|
|
|
(offset (field-offset info type field))
|
|
|
|
(info ((expr->accu info) index)))
|
|
|
|
(append-text info (append (wrap-as (append (i386:accu-shl 2) ;; FIXME: assume size=4
|
|
|
|
(i386:push-accu)))
|
2017-07-18 18:22:44 +00:00
|
|
|
((ident-address->accu info) struct)
|
2017-05-31 18:52:48 +00:00
|
|
|
(wrap-as (append (i386:accu+value offset)
|
|
|
|
(i386:pop-base)
|
|
|
|
(i386:accu+base)))))))
|
|
|
|
|
|
|
|
;; foo->bar[baz]
|
2017-07-18 18:22:44 +00:00
|
|
|
((array-ref ,index (i-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let* ((type (ident->type info struct))
|
2017-05-31 18:52:48 +00:00
|
|
|
(offset (field-offset info type field))
|
|
|
|
(info ((expr->accu info) index)))
|
|
|
|
(append-text info (append (wrap-as (append (i386:accu-shl 2) ;; FIXME: assume size=4
|
|
|
|
(i386:push-accu)))
|
2017-07-18 18:22:44 +00:00
|
|
|
((ident->accu info) struct)
|
2017-05-31 18:52:48 +00:00
|
|
|
(wrap-as (append (i386:accu+value offset)
|
|
|
|
(i386:pop-base)
|
|
|
|
(i386:accu+base)))))))
|
|
|
|
|
2017-07-05 16:48:08 +00:00
|
|
|
((array-ref ,index ,array)
|
|
|
|
(let* ((info ((expr->accu info) index))
|
|
|
|
(size 4) ;; FIXME
|
|
|
|
(info (append-text info (wrap-as (append (i386:accu->base)
|
|
|
|
(if (eq? size 1) '()
|
|
|
|
(append
|
|
|
|
(if (<= size 4) '()
|
|
|
|
(i386:accu+accu))
|
|
|
|
(if (<= size 8) '()
|
|
|
|
(i386:accu+base))
|
|
|
|
(i386:accu-shl 2)))))))
|
|
|
|
(info ((expr->base info) array)))
|
|
|
|
(append-text info (wrap-as (i386:accu+base)))))
|
|
|
|
|
2017-07-16 21:39:59 +00:00
|
|
|
((i-sel (ident ,field) (p-expr (ident ,array)))
|
|
|
|
(let* ((type (ident->type info array))
|
2017-07-18 18:22:44 +00:00
|
|
|
(offset (field-offset info type field)))
|
2017-07-16 21:39:59 +00:00
|
|
|
(append-text info (append ((ident-address->accu info) array)
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
|
|
|
((i-sel (ident ,field) (de-ref (p-expr (ident ,array))))
|
|
|
|
(let* ((type (ident->type info array))
|
2017-07-18 18:22:44 +00:00
|
|
|
(offset (field-offset info type field)))
|
2017-07-16 21:39:59 +00:00
|
|
|
(append-text info (append ((ident-address->accu info) array)
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
2017-07-22 21:39:39 +00:00
|
|
|
;; foo[i].bar.baz
|
|
|
|
((d-sel (ident ,field1) (d-sel (ident ,field0) (array-ref ,index (p-expr (ident ,array)))))
|
|
|
|
(let* ((type0 (ident->type info array))
|
2017-07-23 11:41:38 +00:00
|
|
|
(type1 (field-type info type0 field0))
|
|
|
|
(offset (+ (field-offset info type0 field0)
|
|
|
|
(field-offset info type1 field1)))
|
2017-07-22 21:39:39 +00:00
|
|
|
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
|
|
|
|
(append-text info (wrap-as (i386:accu+value offset)))))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
;;foo[index]->bar
|
|
|
|
((i-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
|
|
|
|
(let* ((type (ident->type info array))
|
|
|
|
(offset (field-offset info type field))
|
|
|
|
(info ((expr->accu* info) `(array-ref ,index (p-expr (ident ,array))))))
|
|
|
|
(append-text info (append (wrap-as (i386:mem->accu))
|
|
|
|
(wrap-as (i386:accu+value offset))))))
|
|
|
|
|
2017-04-12 19:27:59 +00:00
|
|
|
(_ (error "expr->accu*: unsupported: " o)))))
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
|
2017-01-10 21:44:01 +00:00
|
|
|
(define (ident->constant name value)
|
|
|
|
(cons name value))
|
|
|
|
|
2017-07-15 08:40:31 +00:00
|
|
|
(define (enum->type-entry name fields)
|
2017-07-23 16:56:07 +00:00
|
|
|
(cons `("tag" ,name) (make-type 'enum 4 0 fields)))
|
2017-07-05 16:48:08 +00:00
|
|
|
|
2017-07-15 08:40:31 +00:00
|
|
|
(define (struct->type-entry name fields)
|
2017-07-23 16:56:07 +00:00
|
|
|
(cons `("tag" ,name) (make-type 'struct (apply + (map field:size fields)) 0 fields)))
|
2017-05-31 18:52:48 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
(define (union->type-entry name fields)
|
2017-07-23 16:56:07 +00:00
|
|
|
(cons `("tag" ,name) (make-type 'union (apply + (map field:size fields)) 0 fields)))
|
2017-07-16 18:54:59 +00:00
|
|
|
|
2017-05-31 18:52:48 +00:00
|
|
|
(define i386:type-alist
|
2017-07-15 08:40:31 +00:00
|
|
|
`(("char" . ,(make-type 'builtin 1 0 #f))
|
|
|
|
("short" . ,(make-type 'builtin 2 0 #f))
|
|
|
|
("int" . ,(make-type 'builtin 4 0 #f))
|
|
|
|
("long" . ,(make-type 'builtin 4 0 #f))
|
|
|
|
("long long" . ,(make-type 'builtin 8 0 #f))
|
2017-07-28 06:07:41 +00:00
|
|
|
("long long int" . ,(make-type 'builtin 8 0 #f))
|
2017-07-28 08:40:30 +00:00
|
|
|
("void" . ,(make-type 'builtin 1 0 #f))
|
2017-05-31 18:52:48 +00:00
|
|
|
;; FIXME sign
|
2017-07-15 08:40:31 +00:00
|
|
|
("unsigned char" . ,(make-type 'builtin 1 0 #f))
|
|
|
|
("unsigned short" . ,(make-type 'builtin 2 0 #f))
|
2017-07-28 06:07:41 +00:00
|
|
|
("unsigned short int" . ,(make-type 'builtin 2 0 #f))
|
2017-07-15 08:40:31 +00:00
|
|
|
("unsigned" . ,(make-type 'builtin 4 0 #f))
|
|
|
|
("unsigned int" . ,(make-type 'builtin 4 0 #f))
|
|
|
|
("unsigned long" . ,(make-type 'builtin 4 0 #f))
|
2017-07-28 06:07:41 +00:00
|
|
|
("unsigned long long" . ,(make-type 'builtin 8 0 #f))
|
|
|
|
("unsigned long long int" . ,(make-type 'builtin 8 0 #f))))
|
2017-05-31 18:52:48 +00:00
|
|
|
|
2017-07-22 18:40:41 +00:00
|
|
|
(define (field:name o)
|
|
|
|
(pmatch o
|
|
|
|
((union (,name ,type ,size ,pointer) . ,rest) name)
|
2017-07-25 23:13:33 +00:00
|
|
|
;;((union (,name ,type ,size) . ,rest) name)
|
2017-07-22 18:40:41 +00:00
|
|
|
((,name ,type ,size ,pointer) name)
|
2017-07-25 23:13:33 +00:00
|
|
|
;;((,name ,type ,size) name)
|
|
|
|
(_ (error "field:name not supported:" o))))
|
|
|
|
|
|
|
|
(define (field:pointer o)
|
|
|
|
(pmatch o
|
|
|
|
((union (,name ,type ,size ,pointer) . ,rest) pointer)
|
|
|
|
((,name ,type ,size ,pointer) pointer)
|
2017-07-22 18:40:41 +00:00
|
|
|
(_ (error "field:name not supported:" o))))
|
|
|
|
|
2017-05-31 18:52:48 +00:00
|
|
|
(define (field:size o)
|
|
|
|
(pmatch o
|
2017-07-22 18:40:41 +00:00
|
|
|
((union . ,fields) 4) ;; FIXME
|
2017-05-31 18:52:48 +00:00
|
|
|
((,name ,type ,size ,pointer) size)
|
2017-07-25 23:13:33 +00:00
|
|
|
;;((,name ,type ,size) size)
|
2017-05-31 18:52:48 +00:00
|
|
|
(_ 4)))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
(define (field:type o)
|
|
|
|
(pmatch o
|
|
|
|
((,name ,type ,size ,pointer) type)
|
2017-07-25 23:13:33 +00:00
|
|
|
;;((,name ,type ,size) type)
|
2017-07-18 18:22:44 +00:00
|
|
|
(_ (error "field:type:" o))))
|
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
(define (get-type types o)
|
|
|
|
(let ((t (assoc-ref types o)))
|
|
|
|
(pmatch t
|
|
|
|
((typedef ,next) (get-type types next))
|
|
|
|
(_ t))))
|
|
|
|
|
|
|
|
(define (ast-type->type info o)
|
2017-05-31 18:52:48 +00:00
|
|
|
(pmatch o
|
2017-07-23 06:44:48 +00:00
|
|
|
((p-expr ,expr) (ast-type->type info (p-expr->type info o)))
|
2017-05-31 18:52:48 +00:00
|
|
|
((decl-spec-list (type-spec (fixed-type ,type)))
|
2017-07-16 18:54:59 +00:00
|
|
|
(ast-type->type info type))
|
2017-05-31 18:52:48 +00:00
|
|
|
((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
|
2017-07-16 18:54:59 +00:00
|
|
|
(ast-type->type info type))
|
2017-07-16 17:00:01 +00:00
|
|
|
((struct-ref (ident (,type)))
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((struct (if (pair? type) type `("tag" ,type))))
|
2017-07-23 11:41:38 +00:00
|
|
|
(ast-type->type info struct)))
|
2017-05-31 18:52:48 +00:00
|
|
|
((struct-ref (ident ,type))
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((struct (if (pair? type) type `("tag" ,type))))
|
2017-07-23 11:41:38 +00:00
|
|
|
(ast-type->type info struct)))
|
2017-07-16 18:54:59 +00:00
|
|
|
((union-ref (ident ,type))
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((struct (if (pair? type) type `("tag" ,type))))
|
2017-07-23 11:41:38 +00:00
|
|
|
(ast-type->type info struct)))
|
2017-07-16 18:54:59 +00:00
|
|
|
((void) (ast-type->type info "void"))
|
2017-07-25 23:13:33 +00:00
|
|
|
((type-spec ,type) (ast-type->type info type))
|
|
|
|
((fixed-type ,type) (ast-type->type info type))
|
|
|
|
((typename ,type) (ast-type->type info type))
|
2017-05-31 18:52:48 +00:00
|
|
|
(_ (let ((type (get-type (.types info) o)))
|
2017-07-16 18:54:59 +00:00
|
|
|
(if type type
|
|
|
|
(begin
|
|
|
|
(stderr "types: ~s\n" (.types info))
|
|
|
|
(error "ast-type->type: unsupported: " o)))))))
|
|
|
|
|
|
|
|
(define (ast-type->description info o)
|
|
|
|
(let ((type (ast-type->type info o)))
|
|
|
|
(type:description type)))
|
|
|
|
|
|
|
|
(define (ast-type->size info o)
|
|
|
|
(let ((type (ast-type->type info o)))
|
|
|
|
(type:size type)))
|
2017-05-31 18:52:48 +00:00
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
(define (field-field info struct field)
|
2017-07-23 16:56:07 +00:00
|
|
|
(let* ((xtype (ast-type->type info struct))
|
2017-07-18 18:22:44 +00:00
|
|
|
(fields (type:description xtype)))
|
2017-07-22 18:40:41 +00:00
|
|
|
(let loop ((fields fields))
|
|
|
|
(if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
|
|
|
|
(let ((f (car fields)))
|
|
|
|
(cond ((equal? (car f) field) f)
|
|
|
|
((and (eq? (car f) 'union)
|
|
|
|
(find (lambda (x) (equal? (car x) field)) (cdr f))))
|
|
|
|
(else (loop (cdr fields)))))))))
|
2017-07-18 18:22:44 +00:00
|
|
|
|
2017-05-31 18:52:48 +00:00
|
|
|
(define (field-offset info struct field)
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((xtype (ast-type->type info struct)))
|
2017-07-16 18:54:59 +00:00
|
|
|
(if (eq? (type:type xtype) 'union) 0
|
2017-07-22 18:40:41 +00:00
|
|
|
(let ((fields (type:description xtype)))
|
|
|
|
(let loop ((fields fields) (offset 0))
|
|
|
|
(if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
|
|
|
|
(let ((f (car fields)))
|
|
|
|
(cond ((equal? (car f) field) offset)
|
|
|
|
((and (eq? (car f) 'union)
|
|
|
|
(find (lambda (x) (equal? (car x) field)) (cdr f))
|
|
|
|
offset))
|
|
|
|
(else (loop (cdr fields) (+ offset (field:size f))))))))))))
|
2017-05-31 18:52:48 +00:00
|
|
|
|
2017-07-25 23:13:33 +00:00
|
|
|
(define (field-pointer info struct field)
|
|
|
|
(let ((xtype (ast-type->type info struct)))
|
|
|
|
(let ((field (field-field info struct field)))
|
|
|
|
(field:pointer field))))
|
|
|
|
|
2017-07-17 05:54:48 +00:00
|
|
|
(define (field-size info struct field)
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((xtype (ast-type->type info struct)))
|
2017-07-17 05:54:48 +00:00
|
|
|
(if (eq? (type:type xtype) 'union) 0
|
2017-07-18 18:22:44 +00:00
|
|
|
(let ((field (field-field info struct field)))
|
2017-07-17 05:54:48 +00:00
|
|
|
(field:size field)))))
|
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
(define (field-type info struct field)
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((xtype (ast-type->type info struct)))
|
2017-07-23 11:41:38 +00:00
|
|
|
(let ((field (field-field info struct field)))
|
|
|
|
(field:type field))))
|
2017-07-18 18:22:44 +00:00
|
|
|
|
2017-05-31 18:52:48 +00:00
|
|
|
(define (ast->type o)
|
|
|
|
(pmatch o
|
|
|
|
((fixed-type ,type)
|
|
|
|
type)
|
2017-07-16 17:00:01 +00:00
|
|
|
((typename ,type)
|
|
|
|
type)
|
|
|
|
((struct-ref (ident (,type)))
|
2017-07-23 16:56:07 +00:00
|
|
|
`("tag" ,type))
|
2017-05-31 18:52:48 +00:00
|
|
|
((struct-ref (ident ,type))
|
2017-07-23 16:56:07 +00:00
|
|
|
`("tag" ,type))
|
2017-05-31 18:52:48 +00:00
|
|
|
(_ (stderr "SKIP: type=~s\n" o)
|
|
|
|
"int")))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
(define (decl->ast-type o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(pmatch o
|
|
|
|
((fixed-type ,type) type)
|
2017-07-23 16:56:07 +00:00
|
|
|
((struct-ref (ident (,name))) `("tag" ,name))
|
|
|
|
((struct-ref (ident ,name)) `("tag" ,name))
|
|
|
|
((struct-def (ident ,name) . ,fields) `("tag" ,name))
|
2017-05-25 05:32:29 +00:00
|
|
|
((decl (decl-spec-list (type-spec (struct-ref (ident ,name))))) ;; "scm"
|
2017-07-23 16:56:07 +00:00
|
|
|
`("tag" ,name)) ;; FIXME
|
2017-03-17 16:32:23 +00:00
|
|
|
((typename ,name) name)
|
2017-04-17 00:15:11 +00:00
|
|
|
(,name name)
|
2017-07-16 18:54:59 +00:00
|
|
|
(_ (error "decl->ast-type: unsupported: " o))))
|
2017-01-10 21:44:01 +00:00
|
|
|
|
2017-07-02 14:25:14 +00:00
|
|
|
(define (byte->hex.m1 o)
|
|
|
|
(string-drop o 2))
|
2017-01-03 11:45:47 +00:00
|
|
|
|
2017-07-02 14:25:14 +00:00
|
|
|
(define (asm->m1 o)
|
2017-01-03 11:45:47 +00:00
|
|
|
(let ((prefix ".byte "))
|
2017-07-02 14:25:14 +00:00
|
|
|
(if (not (string-prefix? prefix o)) (map (cut string-split <> #\space) (string-split o #\newline))
|
2017-01-04 23:55:46 +00:00
|
|
|
(let ((s (string-drop o (string-length prefix))))
|
2017-07-02 14:25:14 +00:00
|
|
|
(list (format #f "'~a'" (string-join (map byte->hex.m1 (cdr (string-split o #\space))) " ")))))))
|
2017-01-03 11:45:47 +00:00
|
|
|
|
2017-06-13 18:20:38 +00:00
|
|
|
(define (clause->info info i label last?)
|
|
|
|
(define clause-label
|
|
|
|
(string-append label "clause" (number->string i)))
|
|
|
|
(define body-label
|
|
|
|
(string-append label "body" (number->string i)))
|
|
|
|
(define (jump label)
|
2017-06-25 07:33:55 +00:00
|
|
|
(wrap-as (i386:jump label)))
|
2017-06-13 18:20:38 +00:00
|
|
|
(define (jump-nz label)
|
2017-06-25 07:33:55 +00:00
|
|
|
(wrap-as (i386:jump-nz label)))
|
2017-06-13 18:20:38 +00:00
|
|
|
(define (jump-z label)
|
2017-06-25 07:33:55 +00:00
|
|
|
(wrap-as (i386:jump-z label)))
|
2017-04-09 04:52:39 +00:00
|
|
|
(define (test->text test)
|
|
|
|
(let ((value (pmatch test
|
|
|
|
(0 0)
|
2017-05-02 15:00:07 +00:00
|
|
|
((p-expr (char ,value)) (char->integer (car (string->list value))))
|
2017-04-09 04:52:39 +00:00
|
|
|
((p-expr (ident ,constant)) (assoc-ref (.constants info) constant))
|
|
|
|
((p-expr (fixed ,value)) (cstring->number value))
|
2017-05-02 15:00:07 +00:00
|
|
|
((neg (p-expr (fixed ,value))) (- (cstring->number value)))
|
|
|
|
(_ (error "case test: unsupported: " test)))))
|
2017-06-13 18:20:38 +00:00
|
|
|
(append (wrap-as (i386:accu-cmp-value value))
|
|
|
|
(jump-z body-label))))
|
|
|
|
(define (cases+jump info cases)
|
2017-07-02 14:25:14 +00:00
|
|
|
(let* ((info (append-text info (wrap-as `((#:label ,clause-label)))))
|
2017-06-25 07:33:55 +00:00
|
|
|
(next-clause-label (if last? (string-append label "break")
|
|
|
|
(string-append label "clause" (number->string (1+ i)))))
|
2017-06-13 18:20:38 +00:00
|
|
|
(info (append-text info (apply append cases)))
|
|
|
|
(info (if (null? cases) info
|
|
|
|
(append-text info (jump next-clause-label))))
|
2017-07-02 14:25:14 +00:00
|
|
|
(info (append-text info (wrap-as `((#:label ,body-label))))))
|
2017-06-13 18:20:38 +00:00
|
|
|
info))
|
|
|
|
|
2017-01-17 18:03:08 +00:00
|
|
|
(lambda (o)
|
2017-06-13 18:20:38 +00:00
|
|
|
(let loop ((o o) (cases '()) (clause #f))
|
|
|
|
(pmatch o
|
|
|
|
((case ,test ,statement)
|
|
|
|
(loop statement (append cases (list (test->text test))) clause))
|
|
|
|
((default ,statement)
|
|
|
|
(loop statement cases clause))
|
2017-07-23 21:04:00 +00:00
|
|
|
((default . ,statements)
|
|
|
|
(loop `(compd-stmt (block-item-list ,@statements)) cases clause))
|
2017-06-13 18:20:38 +00:00
|
|
|
((compd-stmt (block-item-list))
|
|
|
|
(loop '() cases clause))
|
|
|
|
((compd-stmt (block-item-list . ,elements))
|
|
|
|
(let ((clause (or clause (cases+jump info cases))))
|
|
|
|
(loop `(compd-stmt (block-item-list ,@(cdr elements))) cases
|
|
|
|
((ast->info clause) (car elements)))))
|
|
|
|
(()
|
|
|
|
(let ((clause (or clause (cases+jump info cases))))
|
|
|
|
(if last? clause
|
|
|
|
(let ((next-body-label (string-append label "body"
|
|
|
|
(number->string (1+ i)))))
|
2017-06-25 07:33:55 +00:00
|
|
|
(append-text clause (wrap-as (i386:jump next-body-label)))))))
|
2017-06-13 18:20:38 +00:00
|
|
|
(_
|
|
|
|
(let ((clause (or clause (cases+jump info cases))))
|
|
|
|
(loop '() cases
|
|
|
|
((ast->info clause) o))))))))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-06-12 19:00:50 +00:00
|
|
|
(define (test-jump-label->info info label)
|
|
|
|
(define (jump type . test)
|
|
|
|
(lambda (o)
|
|
|
|
(let* ((info ((ast->info info) o))
|
2017-06-25 07:33:55 +00:00
|
|
|
(info (append-text info (make-comment "jmp test LABEL")))
|
|
|
|
(jump-text (wrap-as (type label))))
|
2017-06-12 19:00:50 +00:00
|
|
|
(append-text info (append (if (null? test) '() (car test))
|
|
|
|
jump-text)))))
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
|
|
|
;; unsigned
|
2017-06-13 18:31:03 +00:00
|
|
|
;; ((le ,a ,b) ((jump i386:jump-ncz) o)) ; ja
|
|
|
|
;; ((lt ,a ,b) ((jump i386:jump-nc) o)) ; jae
|
|
|
|
;; ((ge ,a ,b) ((jump i386:jump-ncz) o))
|
|
|
|
;; ((gt ,a ,b) ((jump i386:jump-nc) o))
|
2017-06-12 19:00:50 +00:00
|
|
|
|
2017-06-13 18:31:03 +00:00
|
|
|
((le ,a ,b) ((jump i386:jump-g) o))
|
|
|
|
((lt ,a ,b) ((jump i386:jump-ge) o))
|
|
|
|
((ge ,a ,b) ((jump i386:jump-g) o))
|
|
|
|
((gt ,a ,b) ((jump i386:jump-ge) o))
|
2017-06-12 19:00:50 +00:00
|
|
|
|
2017-06-13 18:31:03 +00:00
|
|
|
((ne ,a ,b) ((jump i386:jump-nz) o))
|
|
|
|
((eq ,a ,b) ((jump i386:jump-nz) o))
|
|
|
|
((not _) ((jump i386:jump-z) o))
|
2017-06-12 19:00:50 +00:00
|
|
|
|
|
|
|
((and ,a ,b)
|
|
|
|
(let* ((info ((test-jump-label->info info label) a))
|
|
|
|
(info ((test-jump-label->info info label) b)))
|
|
|
|
info))
|
|
|
|
|
|
|
|
((or ,a ,b)
|
|
|
|
(let* ((here (number->string (length (.text info))))
|
|
|
|
(skip-b-label (string-append label "_skip_b_" here))
|
|
|
|
(b-label (string-append label "_b_" here))
|
|
|
|
(info ((test-jump-label->info info b-label) a))
|
2017-06-25 07:33:55 +00:00
|
|
|
(info (append-text info (wrap-as (i386:jump skip-b-label))))
|
2017-07-02 14:25:14 +00:00
|
|
|
(info (append-text info (wrap-as `((#:label ,b-label)))))
|
2017-06-12 19:00:50 +00:00
|
|
|
(info ((test-jump-label->info info label) b))
|
2017-07-02 14:25:14 +00:00
|
|
|
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
2017-06-12 19:00:50 +00:00
|
|
|
info))
|
|
|
|
|
2017-07-23 06:44:48 +00:00
|
|
|
((array-ref ,index ,expr) (let* ((ptr (expr->pointer info expr))
|
|
|
|
(size (if (= ptr 1) (ast-type->size info expr)
|
|
|
|
4)))
|
|
|
|
((jump (if (= size 1) i386:jump-byte-z
|
|
|
|
i386:jump-z)
|
|
|
|
(wrap-as (i386:accu-zero?))) o)))
|
2017-06-12 19:00:50 +00:00
|
|
|
|
2017-07-23 06:44:48 +00:00
|
|
|
((de-ref ,expr) (let* ((ptr (expr->pointer info expr))
|
|
|
|
(size (if (= ptr 1) (ast-type->size info expr)
|
|
|
|
4)))
|
|
|
|
((jump (if (= size 1) i386:jump-byte-z
|
|
|
|
i386:jump-z)
|
|
|
|
(wrap-as (i386:accu-zero?))) o)))
|
2017-06-12 19:00:50 +00:00
|
|
|
|
|
|
|
((assn-expr (p-expr (ident ,name)) ,op ,expr)
|
2017-06-13 18:31:03 +00:00
|
|
|
((jump i386:jump-z
|
2017-06-12 19:00:50 +00:00
|
|
|
(append ((ident->accu info) name)
|
|
|
|
(wrap-as (i386:accu-zero?)))) o))
|
|
|
|
|
2017-06-13 18:31:03 +00:00
|
|
|
(_ ((jump i386:jump-z (wrap-as (i386:accu-zero?))) o)))))
|
2017-06-12 19:00:50 +00:00
|
|
|
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
(define (cstring->number s)
|
2017-07-21 19:43:18 +00:00
|
|
|
(let ((s (cond ((string-suffix? "ULL" s) (string-drop-right s 3))
|
|
|
|
((string-suffix? "UL" s) (string-drop-right s 2))
|
|
|
|
((string-suffix? "LL" s) (string-drop-right s 2))
|
|
|
|
((string-suffix? "L" s) (string-drop-right s 1))
|
|
|
|
(else s))))
|
|
|
|
(cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16))
|
|
|
|
((string-prefix? "0b" s) (string->number (string-drop s 2) 2))
|
|
|
|
((string-prefix? "0" s) (string->number s 8))
|
|
|
|
(else (string->number s)))))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-07-23 19:58:34 +00:00
|
|
|
(define (p-expr->number info o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (fixed ,a))
|
|
|
|
(cstring->number a))
|
|
|
|
((neg ,a)
|
|
|
|
(- (p-expr->number info a)))
|
|
|
|
((add ,a ,b)
|
|
|
|
(+ (p-expr->number info a) (p-expr->number info b)))
|
2017-07-24 13:22:51 +00:00
|
|
|
((bitwise-or ,a ,b)
|
|
|
|
(logior (p-expr->number info a) (p-expr->number info b)))
|
2017-07-23 19:58:34 +00:00
|
|
|
((div ,a ,b)
|
|
|
|
(quotient (p-expr->number info a) (p-expr->number info b)))
|
|
|
|
((mul ,a ,b)
|
|
|
|
(* (p-expr->number info a) (p-expr->number info b)))
|
|
|
|
((sub ,a ,b)
|
|
|
|
(- (p-expr->number info a) (p-expr->number info b)))
|
2017-07-25 23:13:33 +00:00
|
|
|
((sizeof-type (type-name (decl-spec-list (type-spec ,type))))
|
|
|
|
(ast-type->size info type))
|
2017-07-23 19:58:34 +00:00
|
|
|
((sizeof-expr (i-sel (ident ,field) (p-expr (ident ,struct))))
|
|
|
|
(let ((type (ident->type info struct)))
|
|
|
|
(field-size info type field)))
|
2017-07-24 13:22:51 +00:00
|
|
|
((p-expr (ident ,name))
|
|
|
|
(let ((value (assoc-ref (.constants info) name)))
|
|
|
|
(or value
|
|
|
|
(error (format #f "p-expr->number: undeclared identifier: ~s\n" o)))))
|
2017-07-23 19:58:34 +00:00
|
|
|
(_ (error (format #f "p-expr->number: not supported: ~s\n" o)))))
|
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
(define (struct-field info)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
|
|
|
((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
|
|
|
|
(comp-declr-list (comp-declr (ident ,name))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name `("tag" ,type) 4 0))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 0))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 0))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 2))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 1))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 1))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 2))
|
2017-07-28 06:07:41 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
|
|
|
(list name "void" 4 2))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
|
2017-07-28 06:07:41 +00:00
|
|
|
(list name "void" 4 1))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
|
2017-07-28 06:07:41 +00:00
|
|
|
(list name "void" 4 1))
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type 4 1))
|
2017-07-23 19:58:34 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) ,count)))))
|
2017-07-16 17:00:01 +00:00
|
|
|
(let ((size 4)
|
2017-07-23 19:58:34 +00:00
|
|
|
(count (p-expr->number info count)))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type (* count size) -1)))
|
|
|
|
((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
|
|
|
|
(let ((size (ast-type->size info type))
|
2017-07-23 19:58:34 +00:00
|
|
|
(count (p-expr->number info count)))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name type (* count size) -1)))
|
2017-07-18 18:22:44 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name `("tag" ,type) 4 2))
|
2017-07-18 18:22:44 +00:00
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name `("tag" ,type) 4 2))
|
2017-07-18 18:22:44 +00:00
|
|
|
|
|
|
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name `("tag" ,type) 4 1))
|
2017-07-16 17:00:01 +00:00
|
|
|
|
2017-07-18 18:22:44 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
|
2017-07-25 23:13:33 +00:00
|
|
|
(list name `("tag" ,type) 4 1))
|
2017-07-18 18:22:44 +00:00
|
|
|
|
|
|
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (comp-declr-list (comp-declr (ident ,name))))
|
|
|
|
((struct-field info) `(comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))))
|
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((size (ast-type->size info `("tag" ,type))))
|
|
|
|
(list name `("tag" ,type) size 0)))
|
2017-07-23 11:41:38 +00:00
|
|
|
|
|
|
|
((comp-decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
|
2017-07-23 16:56:07 +00:00
|
|
|
(let ((size (ast-type->size info `("tag" ,type))))
|
|
|
|
(list name `("tag" ,type) size 0)))
|
2017-07-16 17:00:01 +00:00
|
|
|
|
2017-07-22 18:40:41 +00:00
|
|
|
((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
|
|
|
|
`(union ,@(map (struct-field info) fields)))
|
|
|
|
|
2017-07-25 23:13:33 +00:00
|
|
|
(_ (error "struct-field: unsupported: " o)))))
|
mescc: Support globals.
* module/language/c99/compiler.mes (write-any): Catch writing of
procedure and give more debug information.
(ref-local, ref-global): Remove.
(push-global-ref, push-global, push-ident-ref): New functions.
(push-ident): New function.
(expr->arg): Use them.
(ident->accu, ident->accu, accu->ident, value->ident, ident->base):
Take info parameter, also handle globals.
(ident-address->accu, ident->global, cstring->number): New functions.
(ast->info): Update.
* module/mes/libc-i386.mes (i386:ret-local): Remove.
(i386:push-global-ref): Rename from i386:ref-global.
(i386:push-local): Rename from i386:ref-local.
(i386:value->local): Rename from i386:local-assign.
(i386:push-global, i386:push-local-ref, i386:value->global,
i386:local-address->accu): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-10 19:12:06 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (ident->decl info o)
|
|
|
|
(or (assoc-ref (.locals info) o)
|
|
|
|
(assoc-ref (.globals info) o)
|
2017-07-28 08:40:30 +00:00
|
|
|
(assoc-ref (.constants info) o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(begin
|
2017-05-21 20:25:02 +00:00
|
|
|
(stderr "NO IDENT: ~a\n" o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(assoc-ref (.functions info) o))))
|
|
|
|
|
|
|
|
(define (ident->type info o)
|
2017-07-15 09:24:14 +00:00
|
|
|
(let ((type (ident->decl info o)))
|
|
|
|
(cond ((global? type) (global:type type))
|
2017-07-15 09:46:13 +00:00
|
|
|
((local? type) (local:type type))
|
2017-07-28 08:40:30 +00:00
|
|
|
((assoc-ref (.constants info) o) "int")
|
2017-07-15 09:46:13 +00:00
|
|
|
(else (stderr "ident->type ~s => ~s\n" o type)
|
|
|
|
(car type)))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
|
|
|
(define (ident->pointer info o)
|
2017-03-02 19:26:13 +00:00
|
|
|
(let ((local (assoc-ref (.locals info) o)))
|
|
|
|
(if local (local:pointer local)
|
2017-07-28 08:40:30 +00:00
|
|
|
(let ((global (assoc-ref (.globals info) o)))
|
|
|
|
(if global
|
|
|
|
(global:pointer (ident->decl info o))
|
|
|
|
0)))))
|
|
|
|
|
|
|
|
(define (ident->size info o)
|
|
|
|
(let* ((type (ident->type info o))
|
|
|
|
(xtype (ast-type->type info type)))
|
|
|
|
(type:size xtype)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-23 06:44:48 +00:00
|
|
|
(define (expr->pointer info o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (ident ,name)) (ident->pointer info name))
|
2017-07-28 16:00:46 +00:00
|
|
|
((de-ref ,expr) (1- (expr->pointer info expr)))
|
|
|
|
((add ,a ,b) (expr->pointer info a))
|
|
|
|
((sub ,a ,b) (expr->pointer info a))
|
2017-07-23 06:44:48 +00:00
|
|
|
(_ (stderr "expr->pointer: unsupported: ~s\n" o) 0)))
|
|
|
|
|
2017-07-28 08:40:30 +00:00
|
|
|
(define (expr->size info o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (ident ,name)) (ident->size info name))
|
2017-07-28 16:00:46 +00:00
|
|
|
((de-ref ,expr) (expr->size info expr))
|
|
|
|
((add ,a ,b) (expr->size info a))
|
|
|
|
((sub ,a ,b) (expr->size info a))
|
2017-07-28 08:40:30 +00:00
|
|
|
(_ (stderr "expr->size: unsupported: ~s\n" o) 4)))
|
|
|
|
|
2017-05-04 17:39:23 +00:00
|
|
|
(define (p-expr->type info o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (ident ,name)) (ident->type info name))
|
2017-07-18 18:22:44 +00:00
|
|
|
((array-ref ,index (p-expr (ident ,array))) (ident->type info array))
|
|
|
|
((i-sel (ident ,field) (p-expr (ident ,struct)))
|
|
|
|
(let ((type0 (ident->type info struct)))
|
2017-07-23 16:56:07 +00:00
|
|
|
(field-type info `("tag" ,type0) field)))
|
2017-07-18 18:22:44 +00:00
|
|
|
((d-sel (ident ,field) (p-expr (ident ,struct)))
|
|
|
|
(let ((type0 (ident->type info struct)))
|
2017-07-23 16:56:07 +00:00
|
|
|
(field-type info `("tag" ,type0) field)))
|
2017-07-22 21:39:39 +00:00
|
|
|
((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
|
|
|
|
(let ((type0 (ident->type info array)))
|
2017-07-23 16:56:07 +00:00
|
|
|
(field-type info `("tag" ,type0) field)))
|
2017-05-04 17:39:23 +00:00
|
|
|
(_ (error "p-expr->type: unsupported: " o))))
|
|
|
|
|
2017-07-15 09:46:13 +00:00
|
|
|
(define (local-var? o) ;; formals < 0, locals > 0
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(positive? (local:id o)))
|
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
(define (ptr-declr->pointer o)
|
|
|
|
(pmatch o
|
|
|
|
((pointer) 1)
|
|
|
|
((pointer (pointer)) 2)
|
2017-07-25 09:11:26 +00:00
|
|
|
((pointer (pointer (pointer))) 3)
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ (error "ptr-declr->pointer unsupported: " o))))
|
|
|
|
|
|
|
|
(define (init-declr->name o)
|
|
|
|
(pmatch o
|
|
|
|
((ident ,name) name)
|
|
|
|
((ptr-declr ,pointer (ident ,name)) name)
|
2017-07-18 06:04:50 +00:00
|
|
|
((array-of (ident ,name)) name)
|
2017-07-20 08:05:48 +00:00
|
|
|
((array-of (ident ,name) ,index) name)
|
2017-07-28 06:07:41 +00:00
|
|
|
((ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,params)) name)
|
2017-07-22 21:39:39 +00:00
|
|
|
((ptr-declr (pointer) (array-of (ident ,name))) name)
|
2017-07-18 06:04:50 +00:00
|
|
|
((ptr-declr (pointer) (array-of (ident ,name) (p-expr ,size))) name)
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ (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))
|
2017-07-22 21:39:39 +00:00
|
|
|
((array-of (ident ,name) ,index) -1)
|
|
|
|
((array-of (ident ,name)) -1)
|
2017-07-28 06:07:41 +00:00
|
|
|
((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) (param-list . ,params)) (ptr-declr->pointer pointer))
|
2017-07-22 21:39:39 +00:00
|
|
|
((ptr-declr (pointer) (array-of (ident ,name))) -2)
|
2017-07-18 06:04:50 +00:00
|
|
|
((ptr-declr (pointer) (array-of (ident ,name) (p-expr ,size))) -2)
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ (error "init-declr->pointer unsupported: " o))))
|
|
|
|
|
2017-05-06 06:39:04 +00:00
|
|
|
(define (statements->clauses statements)
|
|
|
|
(let loop ((statements statements) (clauses '()))
|
|
|
|
(if (null? statements) clauses
|
|
|
|
(let ((s (car statements)))
|
|
|
|
(pmatch s
|
|
|
|
((case ,test (compd-stmt (block-item-list . _)))
|
|
|
|
(loop (cdr statements) (append clauses (list s))))
|
|
|
|
((case ,test (break))
|
|
|
|
(loop (cdr statements) (append clauses (list s))))
|
|
|
|
((case ,test) (loop (cdr statements) (append clauses (list s))))
|
|
|
|
|
|
|
|
((case ,test ,statement)
|
|
|
|
(let loop2 ((statement statement) (heads `((case ,test))))
|
|
|
|
(define (heads->case heads statement)
|
|
|
|
(if (null? heads) statement
|
|
|
|
(append (car heads) (list (heads->case (cdr heads) statement)))))
|
|
|
|
(pmatch statement
|
|
|
|
((case ,t2 ,s2) (loop2 s2 (append heads `((case ,t2)))))
|
|
|
|
((default ,s2) (loop2 s2 (append heads `((default)))))
|
|
|
|
((compd-stmt (block-item-list . _)) (loop (cdr statements) (append clauses (list (heads->case heads statement)))))
|
|
|
|
(_ (let loop3 ((statements (cdr statements)) (c (list statement)))
|
|
|
|
(if (null? statements) (loop statements (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@c))))))
|
|
|
|
(let ((s (car statements)))
|
|
|
|
(pmatch s
|
|
|
|
((case . _) (loop statements (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@c)))))))
|
|
|
|
((default _) (loop statements (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@c)))))))
|
|
|
|
((break) (loop (cdr statements) (append clauses (list (heads->case heads `(compd-stmt (block-item-list ,@(append c (list s)))))))))
|
|
|
|
(_ (loop3 (cdr statements) (append c (list s))))))))))))
|
|
|
|
((default (compd-stmt (block-item-list _)))
|
|
|
|
(loop (cdr statements) (append clauses (list s))))
|
|
|
|
((default . ,statement)
|
|
|
|
(let loop2 ((statements (cdr statements)) (c statement))
|
|
|
|
(if (null? statements) (loop statements (append clauses (list `(default ,@c))))
|
|
|
|
(let ((s (car statements)))
|
|
|
|
(pmatch s
|
|
|
|
((compd-stmt (block-item-list . _)) (loop (cdr statements) (append clauses (list `(default ,s)))))
|
|
|
|
((case . _) (loop statements (append clauses (list `(default (compd-stmt (block-item-list ,@c)))))))
|
|
|
|
((default _) (loop statements (append clauses (list `(default (compd-stmt (block-item-list ,@c)))))))
|
|
|
|
((break) (loop (cdr statements) (append clauses (list `(default (compd-stmt (block-item-list ,@(append c (list s)))))))))
|
|
|
|
|
|
|
|
(_ (loop2 (cdr statements) (append c (list s)))))))))
|
|
|
|
(_ (error "statements->clauses: unsupported:" s)))))))
|
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
(define (decl->info info)
|
2017-04-02 09:55:37 +00:00
|
|
|
(lambda (o)
|
2017-05-17 11:56:25 +00:00
|
|
|
(let ((functions (.functions info))
|
|
|
|
(globals (.globals info))
|
2017-01-04 23:55:46 +00:00
|
|
|
(locals (.locals info))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(constants (.constants info))
|
2017-05-25 05:32:29 +00:00
|
|
|
(types (.types info))
|
2017-01-04 23:55:46 +00:00
|
|
|
(text (.text info)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (add-local locals name type pointer)
|
2017-07-15 09:46:13 +00:00
|
|
|
(let* ((id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
|
2017-05-04 17:39:23 +00:00
|
|
|
(1+ (local:id (cdar locals)))))
|
2017-07-15 09:46:13 +00:00
|
|
|
(locals (cons (make-local-entry name type pointer id) locals)))
|
2017-01-07 20:53:12 +00:00
|
|
|
locals))
|
2017-05-17 11:56:25 +00:00
|
|
|
(define (declare name)
|
|
|
|
(if (member name functions) info
|
|
|
|
(clone info #:functions (cons (cons name #f) functions))))
|
2017-04-02 09:55:37 +00:00
|
|
|
(pmatch o
|
2017-01-04 23:55:46 +00:00
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
;; FIXME: Nyacc sometimes produces extra parens: (ident (<struct-name>))
|
|
|
|
((decl (decl-spec-list (stor-spec ,spec) (type-spec (struct-ref (ident (,type))))) ,init)
|
|
|
|
((decl->info info) `(decl (decl-spec-list (stor-spec ,spec) (type-spec (struct-ref (ident ,type)))) ,init)))
|
|
|
|
((decl (decl-spec-list (type-spec (struct-ref (ident (,type))))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))))
|
|
|
|
|
|
|
|
((decl (decl-spec-list (type-spec (struct-def (ident (,type)) ,field-list))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
|
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (stor-spec ,spec) (type-spec (union-ref (ident (,type))))) ,init)
|
|
|
|
((decl->info info) `(decl (decl-spec-list (stor-spec ,spec) (type-spec (union-ref (ident ,type)))) ,init)))
|
|
|
|
((decl (decl-spec-list (type-spec (union-def (ident (,type)) ,field-list))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,field-list))))))
|
|
|
|
|
|
|
|
((decl (decl-spec-list (type-spec (union-ref (ident (,type))))) (init-declr-list (init-declr (ident ,name) ,initzer)))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name) ,initzer)))))
|
2017-07-16 17:00:01 +00:00
|
|
|
|
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
|
|
|
|
(declare name))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
(clone info #:types (cons (cons name (get-type types type)) types)))
|
2017-04-10 04:59:50 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; int foo ();
|
|
|
|
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
|
|
|
|
(declare name))
|
2017-06-12 15:10:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; void foo ();
|
|
|
|
((decl (decl-spec-list (type-spec (void))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
|
|
|
|
(declare name))
|
2017-01-08 16:51:40 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; void foo (*);
|
|
|
|
((decl (decl-spec-list (type-spec (void))) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
|
|
|
|
(declare name))
|
2017-05-21 20:25:02 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; char *strcpy ();
|
|
|
|
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
|
|
|
|
(declare name))
|
2017-01-03 17:22:56 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; printf (char const* format, ...)
|
|
|
|
((decl (decl-spec-list ,type) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list ,param-list . (ellipsis))))))
|
|
|
|
(declare name))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; <name> tcc_new
|
|
|
|
((decl (decl-spec-list ,type) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
|
|
|
|
(declare name))
|
2017-01-10 19:27:44 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; extern type foo ()
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
|
|
|
|
(declare name))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; struct TCCState;
|
|
|
|
((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))))
|
|
|
|
info)
|
2017-01-05 20:24:56 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; extern type global;
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
info)
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (static)) ,type) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list ,type) (init-declr-list (init-declr (ident ,name)))))
|
2017-07-12 04:55:05 +00:00
|
|
|
info)
|
2017-03-12 10:05:00 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
;; extern foo *bar;
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
|
2017-07-12 04:55:05 +00:00
|
|
|
info)
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (static)) ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))))
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
;; ST_DATA int ch, tok; -- TCC, why oh why so difficult?
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
|
2017-07-12 04:55:05 +00:00
|
|
|
info)
|
mescc: Have micro-mes use strcmp to print help.
* doc/examples/micro-mes.c (main): Add --help.
* module/language/c99/compiler.mes (info?): New function.
(expr->accu): Handle function call and sub.
(ast->info): Handle if not, and, de-ref, eq, sub, return f ().
* module/mes/libc-i386.mes (i386:accu-zero?, i386:Xmem-byte->accu,
i386:Xmem-byte->base, i386:jump-byte-nz, i386:jump-byte-z,
i386:test-byte-base, i386:Xjump-byte-z, i386:sub-byte-base): New
functions.
* module/mes/libc-i386.scm: Export them.
2017-01-05 23:20:05 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; ST_DATA Section *text_section, *data_section, *bss_section; /* predefined sections */
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name))) . ,rest))
|
|
|
|
info)
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; ST_DATA CType char_pointer_type, func_old_type, int_type, size_type;
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
|
|
|
|
info)
|
2017-05-06 17:31:00 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; ST_DATA SValue __vstack[1+/*to make bcheck happy*/ VSTACK_SIZE], *vtop;
|
|
|
|
;; Yay, let's hear it for the T-for Tiny in TCC!?
|
|
|
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (array-of (ident ,name) (add (p-expr (fixed ,a)) (p-expr (fixed ,b))))) (init-declr (ptr-declr (pointer) (ident ,name2)))))
|
|
|
|
info)
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
|
2017-07-23 16:56:07 +00:00
|
|
|
(clone info #:types (cons (cons name (or (get-type types type) `(typedef ("tag" ,type)))) types)))
|
2017-04-17 00:15:11 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
|
2017-07-23 16:56:07 +00:00
|
|
|
(clone info #:types (cons (cons name (or (get-type types type) `(typedef ("tag" ,type)))) types)))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
(clone info #:types (cons (cons name (or (get-type types type) `(typedef ,type))) types)))
|
|
|
|
|
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
2017-07-16 17:00:01 +00:00
|
|
|
((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
|
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
|
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
(let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
|
|
|
|
(types (.types info)))
|
2017-07-23 16:56:07 +00:00
|
|
|
(clone info #:types (cons (cons name (or (get-type types `("tag" ,type)) `(typedef ,type))) types))))
|
2017-07-16 17:00:01 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
(let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,field-list))))))
|
|
|
|
(types (.types info)))
|
2017-07-23 16:56:07 +00:00
|
|
|
(clone info #:types (cons (cons name (or (get-type types `("tag" ,type)) `(typedef ,type))) types))))
|
2017-07-12 04:55:05 +00:00
|
|
|
|
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
|
|
|
(let* ((type (get-type types type))
|
2017-07-15 08:40:31 +00:00
|
|
|
(type (make-type (type:type type)
|
2017-07-12 04:55:05 +00:00
|
|
|
(type:size type)
|
|
|
|
(1+ (type:pointer type))
|
2017-07-15 08:40:31 +00:00
|
|
|
(type:description type)))
|
|
|
|
(type-entry (cons name type)))
|
|
|
|
(clone info #:types (cons type-entry types))))
|
2017-07-12 04:55:05 +00:00
|
|
|
|
|
|
|
;; struct
|
|
|
|
((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
|
2017-07-16 17:00:01 +00:00
|
|
|
(let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
|
2017-07-15 08:40:31 +00:00
|
|
|
(clone info #:types (cons type-entry types))))
|
2017-07-12 04:55:05 +00:00
|
|
|
|
|
|
|
;; enum e i;
|
|
|
|
((decl (decl-spec-list (type-spec (enum-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
(let ((type "int")) ;; FIXME
|
2017-05-25 05:32:29 +00:00
|
|
|
(if (.function info)
|
2017-07-12 04:55:05 +00:00
|
|
|
(clone info #:locals (add-local locals name type 0))
|
2017-07-15 09:24:14 +00:00
|
|
|
(clone info #:globals (append globals (list (ident->global-entry name type 0 0)))))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-05-04 17:39:23 +00:00
|
|
|
;; struct foo bar[2];
|
2017-05-05 07:24:19 +00:00
|
|
|
;; char arena[20000];
|
2017-07-23 19:58:34 +00:00
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) ,count))))
|
2017-05-05 07:24:19 +00:00
|
|
|
(let ((type (ast->type type)))
|
2017-05-04 17:39:23 +00:00
|
|
|
(if (.function info)
|
|
|
|
(let* ((local (car (add-local locals name type -1)))
|
2017-07-23 19:58:34 +00:00
|
|
|
(count (p-expr->number info count))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (ast-type->size info type))
|
2017-07-15 09:46:13 +00:00
|
|
|
(local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
|
2017-05-04 17:39:23 +00:00
|
|
|
(locals (cons local locals))
|
|
|
|
(info (clone info #:locals locals)))
|
|
|
|
info)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let* ((globals (.globals info))
|
2017-07-23 19:58:34 +00:00
|
|
|
(count (p-expr->number info count))
|
2017-07-16 18:54:59 +00:00
|
|
|
(size (ast-type->size info type))
|
2017-07-15 09:24:14 +00:00
|
|
|
(array (make-global-entry name type -1 (string->list (make-string (* count size) #\nul))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(globals (append globals (list array))))
|
2017-04-07 07:53:56 +00:00
|
|
|
(clone info #:globals globals)))))
|
2017-01-17 17:57:41 +00:00
|
|
|
|
2017-07-28 16:04:39 +00:00
|
|
|
;; struct foo *bar[2];
|
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name) ,count)))))
|
|
|
|
(let ((type (ast->type type)))
|
|
|
|
(if (.function info)
|
|
|
|
(let* ((local (car (add-local locals name type -1)))
|
|
|
|
(count (p-expr->number info count))
|
|
|
|
(size 4)
|
|
|
|
(local (make-local-entry name type -2 (+ (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 (p-expr->number info count))
|
|
|
|
(size 4)
|
|
|
|
(global (make-global-entry name type -2 (string->list (make-string (* count size) #\nul))))
|
|
|
|
(globals (append globals (list global))))
|
|
|
|
(clone info #:globals globals)))))
|
|
|
|
|
2017-07-20 08:05:48 +00:00
|
|
|
((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))
|
2017-07-16 18:54:59 +00:00
|
|
|
;; (size (ast-type->size info type))
|
2017-07-20 08:05:48 +00:00
|
|
|
(array (make-global-entry array type -1 (string->list string)))
|
|
|
|
(globals (append globals (list array))))
|
|
|
|
(clone info #:globals globals))))
|
2017-05-04 17:39:23 +00:00
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
;; int (*function) (void) = g_functions[g_cells[fn].cdr].function;
|
2017-03-02 19:26:13 +00:00
|
|
|
((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))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let* ((locals (add-local locals name type 1))
|
|
|
|
(info (clone info #:locals locals))
|
|
|
|
(empty (clone info #:text '()))
|
|
|
|
(accu ((expr->accu empty) initzer)))
|
|
|
|
(clone info
|
|
|
|
#:text
|
|
|
|
(append text
|
|
|
|
(.text accu)
|
|
|
|
((accu->ident info) name)
|
2017-06-11 16:05:56 +00:00
|
|
|
(wrap-as (append (i386:label->base `(#:address "_start"))
|
2017-06-11 11:11:40 +00:00
|
|
|
(i386:accu+base))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
#:locals locals)))
|
|
|
|
|
2017-01-17 18:03:08 +00:00
|
|
|
;; char *p = g_cells;
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
|
2017-07-20 08:05:48 +00:00
|
|
|
(let ((info (append-text info (ast->comment o)))
|
2017-07-16 18:54:59 +00:00
|
|
|
(type (decl->ast-type type)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(if (.function info)
|
|
|
|
(let* ((locals (add-local locals name type 1))
|
|
|
|
(info (clone info #:locals locals)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info (append ((ident->accu info) value)
|
|
|
|
((accu->ident info) name))))
|
2017-07-15 09:24:14 +00:00
|
|
|
(let ((globals (append globals (list (ident->global-entry name type 1 `(,value #f #f #f))))))
|
2017-06-11 11:11:40 +00:00
|
|
|
(clone info #:globals globals)))))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-05-25 05:57:26 +00:00
|
|
|
;; enum foo { };
|
2017-01-10 21:44:01 +00:00
|
|
|
((decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))))
|
2017-07-15 08:40:31 +00:00
|
|
|
(let ((type-entry (enum->type-entry name fields))
|
2017-05-25 05:57:26 +00:00
|
|
|
(constants (enum-def-list->constants constants fields)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(clone info
|
2017-07-15 08:40:31 +00:00
|
|
|
#:types (cons type-entry types)
|
2017-01-10 21:44:01 +00:00
|
|
|
#:constants (append constants (.constants info)))))
|
|
|
|
|
2017-05-25 05:57:26 +00:00
|
|
|
;; enum {};
|
|
|
|
((decl (decl-spec-list (type-spec (enum-def (enum-def-list . ,fields)))))
|
|
|
|
(let ((constants (enum-def-list->constants constants fields)))
|
|
|
|
(clone info
|
|
|
|
#:constants (append constants (.constants info)))))
|
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
|
|
|
|
(let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
|
2017-07-15 08:40:31 +00:00
|
|
|
(clone info #:types (cons type-entry types))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (type-spec (union-def (ident ,name) (field-list . ,fields)))))
|
|
|
|
(let ((type-entry (union->type-entry name (map (struct-field info) fields))))
|
|
|
|
(clone info #:types (cons type-entry types))))
|
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
|
2017-05-25 05:32:29 +00:00
|
|
|
(init-declr-list (init-declr (ident ,name))))
|
2017-07-16 17:00:01 +00:00
|
|
|
(let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-16 18:54:59 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,fields))) (init-declr-list (init-declr (ident ,name))))
|
|
|
|
(let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,fields)))))))
|
|
|
|
((decl->info info) `(decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
|
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
;; struct f = {...};
|
2017-07-12 04:55:05 +00:00
|
|
|
;; LOCALS!
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
|
2017-06-25 07:33:55 +00:00
|
|
|
(let* ((info (append-text info (ast->comment o)))
|
2017-07-16 18:54:59 +00:00
|
|
|
(type (decl->ast-type type))
|
|
|
|
(fields (ast-type->description info type))
|
|
|
|
(xtype (ast-type->type info type))
|
|
|
|
(fields (if (not (eq? (type:type xtype) 'union)) fields
|
|
|
|
(list-head fields 1)))
|
|
|
|
(size (ast-type->size info type))
|
2017-05-17 11:56:25 +00:00
|
|
|
(initzers (map (initzer->non-const info) initzers)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(if (.function info)
|
2017-07-12 04:55:05 +00:00
|
|
|
(let* ((initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
|
2017-06-12 08:49:31 +00:00
|
|
|
(global-names (map car globals))
|
2017-07-02 14:25:14 +00:00
|
|
|
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
|
2017-06-12 08:49:31 +00:00
|
|
|
(globals (append globals initzer-globals))
|
2017-07-25 23:13:33 +00:00
|
|
|
(local (car (add-local locals name type -1)))
|
|
|
|
(local (make-local-entry name type -1 (+ (local:id (cdr local)) (quotient (+ size 3) 4))))
|
|
|
|
(locals (cons local locals))
|
2017-03-09 07:14:27 +00:00
|
|
|
(info (clone info #:locals locals #:globals globals))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(empty (clone info #:text '())))
|
2017-05-31 18:52:48 +00:00
|
|
|
(let loop ((fields fields) (initzers initzers) (info info))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(if (null? fields) info
|
2017-07-22 18:40:41 +00:00
|
|
|
(let ((offset (field-offset info type (field:name (car fields))))
|
2017-07-23 08:44:17 +00:00
|
|
|
(initzer (if (null? initzers) '(p-expr (fixed "0")) (car initzers))))
|
|
|
|
(loop (cdr fields) (if (null? initzers) '() (cdr initzers))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(clone info #:text
|
|
|
|
(append
|
|
|
|
(.text info)
|
|
|
|
((ident->accu info) name)
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (append (i386:accu->base)))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(.text ((expr->accu empty) initzer))
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (i386:accu->base-address+n offset)))))))))
|
2017-07-12 04:55:05 +00:00
|
|
|
(let* ((initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
|
2017-06-12 08:49:31 +00:00
|
|
|
(global-names (map car globals))
|
2017-07-02 14:25:14 +00:00
|
|
|
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
|
2017-06-12 08:49:31 +00:00
|
|
|
(globals (append globals initzer-globals))
|
2017-07-20 08:05:48 +00:00
|
|
|
(global (make-global-entry name type -1 (append-map (initzer->data info) initzers)))
|
2017-06-11 11:11:40 +00:00
|
|
|
(globals (append globals (list global))))
|
|
|
|
(clone info #:globals globals)))))
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; DECL
|
|
|
|
;; char *bla[] = {"a", "b"};
|
2017-07-18 06:04:50 +00:00
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
|
2017-07-16 18:54:59 +00:00
|
|
|
(let* ((type (decl->ast-type type))
|
2017-07-12 04:55:05 +00:00
|
|
|
(entries (filter identity (append-map (initzer->globals globals) initzers)))
|
2017-07-20 22:09:18 +00:00
|
|
|
(global-names (map car globals))
|
|
|
|
(entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries))
|
|
|
|
(globals (append globals entries))
|
2017-07-12 04:55:05 +00:00
|
|
|
(entry-size 4)
|
|
|
|
(size (* (length entries) entry-size))
|
|
|
|
(initzers (map (initzer->non-const info) initzers)))
|
2017-03-17 16:54:37 +00:00
|
|
|
(if (.function info)
|
2017-07-25 23:13:33 +00:00
|
|
|
(let* ((count (length initzers))
|
|
|
|
(local (car (add-local locals name type -1)))
|
2017-07-20 22:09:18 +00:00
|
|
|
(local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (1+ count))))
|
|
|
|
(locals (cons local locals))
|
|
|
|
(info (clone info #:locals locals))
|
|
|
|
(info (clone info #:globals globals))
|
|
|
|
(empty (clone info #:text '())))
|
|
|
|
(let loop ((index 0) (initzers initzers) (info info))
|
|
|
|
(if (null? initzers) info
|
|
|
|
(let ((offset (* index 4))
|
|
|
|
(initzer (car initzers)))
|
|
|
|
(loop (1+ index) (cdr initzers)
|
|
|
|
(clone info #:text
|
|
|
|
(append
|
|
|
|
(.text info)
|
|
|
|
((ident->accu info) name)
|
|
|
|
(wrap-as (append (i386:accu->base)))
|
|
|
|
(.text ((expr->accu empty) initzer))
|
|
|
|
(wrap-as (i386:accu->base-address+n offset)))))))))
|
2017-07-20 08:05:48 +00:00
|
|
|
(let* ((global (make-global-entry name type -2 (append-map (initzer->data info) initzers)))
|
2017-07-20 22:09:18 +00:00
|
|
|
(globals (append globals (list global))))
|
2017-06-11 11:11:40 +00:00
|
|
|
(clone info #:globals globals)))))
|
2017-03-17 16:54:37 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
|
|
|
|
(let* ((info (type->info info type))
|
2017-07-25 23:13:33 +00:00
|
|
|
(xtype type)
|
2017-07-16 18:54:59 +00:00
|
|
|
(type (decl->ast-type type))
|
2017-07-12 04:55:05 +00:00
|
|
|
(name (init-declr->name init))
|
|
|
|
(pointer (init-declr->pointer init))
|
|
|
|
(initzer-globals (if (null? initzer) '()
|
|
|
|
(filter identity (append-map (initzer->globals globals) initzer))))
|
|
|
|
(global-names (map car globals))
|
|
|
|
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
|
|
|
|
(initzer (if (null? initzer) '() ((initzer->non-const info) initzer)))
|
|
|
|
(info (append-text info (ast->comment o)))
|
|
|
|
(globals (append globals initzer-globals))
|
|
|
|
(info (clone info #:globals globals))
|
2017-07-25 23:13:33 +00:00
|
|
|
(struct? (and (zero? pointer)
|
|
|
|
(or (and (pair? type) (equal? (car type) "tag"))
|
|
|
|
(eq? (type:type (ast-type->type info xtype)) 'struct))))
|
|
|
|
(pointer (if struct? -1 pointer))
|
|
|
|
(size (if (<= pointer 0) (ast-type->size info type)
|
2017-07-20 08:05:48 +00:00
|
|
|
4)))
|
2017-07-12 04:55:05 +00:00
|
|
|
(if (.function info)
|
2017-07-25 23:13:33 +00:00
|
|
|
(let* ((locals (if (or (> pointer 0) (<= size 4)) (add-local locals name type pointer)
|
2017-07-20 08:05:48 +00:00
|
|
|
(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))))
|
2017-07-12 04:55:05 +00:00
|
|
|
(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)
|
2017-07-20 08:05:48 +00:00
|
|
|
(let* ((global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul))
|
2017-07-15 09:24:14 +00:00
|
|
|
(append-map (initzer->data info) initzer))))
|
2017-07-12 04:55:05 +00:00
|
|
|
(globals (append globals (list global))))
|
|
|
|
(clone info #:globals globals)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; int i = 0, j = 0;
|
2017-07-18 06:04:50 +00:00
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) . ,initzer) . ,rest))
|
2017-07-12 04:55:05 +00:00
|
|
|
(let loop ((inits `((init-declr (ident ,name) ,@initzer) ,@rest)) (info info))
|
|
|
|
(if (null? inits) info
|
|
|
|
(loop (cdr inits)
|
2017-07-16 17:00:01 +00:00
|
|
|
((decl->info info)
|
2017-07-18 06:04:50 +00:00
|
|
|
`(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,(car inits))))))))
|
|
|
|
|
|
|
|
;; int *i = 0, j ..;
|
|
|
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)) . ,initzer) . ,rest))
|
|
|
|
(let loop ((inits `((init-declr (ptr-declr ,pointer (ident ,name)) ,@initzer) ,@rest)) (info info))
|
|
|
|
(if (null? inits) info
|
|
|
|
(loop (cdr inits)
|
|
|
|
((decl->info info)
|
|
|
|
`(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,(car inits))))))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
|
|
|
|
(format (current-error-port) "SKIP: typedef=~s\n" o)
|
|
|
|
info)
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl (@ ,at))
|
|
|
|
(format (current-error-port) "SKIP: at=~s\n" o)
|
2017-05-25 05:32:29 +00:00
|
|
|
info)
|
|
|
|
|
2017-07-16 17:00:01 +00:00
|
|
|
((decl . _) (error "decl->info: unsupported: " o))))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
(define (ast->info info)
|
|
|
|
(lambda (o)
|
|
|
|
(let ((functions (.functions info))
|
|
|
|
(globals (.globals info))
|
|
|
|
(locals (.locals info))
|
|
|
|
(constants (.constants info))
|
|
|
|
(types (.types info))
|
|
|
|
(text (.text info)))
|
|
|
|
(pmatch o
|
|
|
|
(((trans-unit . _) . _)
|
|
|
|
((ast-list->info info) o))
|
|
|
|
((trans-unit . ,elements)
|
|
|
|
((ast-list->info info) elements))
|
|
|
|
((fctn-defn . _) ((function->info info) o))
|
|
|
|
((cpp-stmt (define (name ,name) (repl ,value)))
|
2017-05-25 05:32:29 +00:00
|
|
|
info)
|
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((cast (type-name (decl-spec-list (type-spec (void)))) _)
|
2017-05-25 05:32:29 +00:00
|
|
|
info)
|
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((break)
|
|
|
|
(let ((label (car (.break info))))
|
|
|
|
(append-text info (wrap-as (i386:jump label)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((continue)
|
|
|
|
(let ((label (car (.continue info))))
|
|
|
|
(append-text info (wrap-as (i386:jump label)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; FIXME: expr-stmt wrapper?
|
|
|
|
(trans-unit info)
|
|
|
|
((expr-stmt) info)
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
|
|
|
|
|
|
|
|
((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
|
|
|
|
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list))))
|
|
|
|
(append-text info (wrap-as (asm->m1 arg0))))
|
|
|
|
(let* ((info (append-text info (ast->comment o)))
|
|
|
|
(info ((expr->accu info) `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))))
|
|
|
|
(append-text info (wrap-as (i386:accu-zero?))))))
|
2017-05-03 06:09:19 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((if ,test ,then)
|
|
|
|
(let* ((info (append-text info (ast->comment `(if ,test (ellipsis)))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(else-label (string-append label "else"))
|
|
|
|
(info ((test-jump-label->info info break-label) test))
|
|
|
|
(info ((ast->info info) then))
|
|
|
|
(info (append-text info (wrap-as (i386:jump break-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
(clone info
|
|
|
|
#:locals locals)))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((if ,test ,then ,else)
|
|
|
|
(let* ((info (append-text info (ast->comment `(if ,test (ellipsis) (ellipsis)))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(else-label (string-append label "else"))
|
|
|
|
(info ((test-jump-label->info info else-label) test))
|
|
|
|
(info ((ast->info info) then))
|
|
|
|
(info (append-text info (wrap-as (i386:jump break-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,else-label)))))
|
|
|
|
(info ((ast->info info) else))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
(clone info
|
|
|
|
#:locals locals)))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
;; Hmm?
|
|
|
|
((expr-stmt (cond-expr ,test ,then ,else))
|
|
|
|
(let* ((info (append-text info (ast->comment `(cond-expr ,test (ellipsis) (ellipsis)))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(else-label (string-append label "else"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(info ((test-jump-label->info info else-label) test))
|
|
|
|
(info ((ast->info info) then))
|
|
|
|
(info (append-text info (wrap-as (i386:jump break-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,else-label)))))
|
|
|
|
(info ((ast->info info) else))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
info))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((switch ,expr (compd-stmt (block-item-list . ,statements)))
|
|
|
|
(let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis)))))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(clauses (statements->clauses statements))
|
|
|
|
(info ((expr->accu info) expr))
|
|
|
|
(info (clone info #:break (cons break-label (.break info))))
|
|
|
|
(info (let loop ((clauses clauses) (i 0) (info info))
|
|
|
|
(if (null? clauses) info
|
|
|
|
(loop (cdr clauses) (1+ i) ((clause->info info i label (null? (cdr clauses))) (car clauses))))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
(clone info
|
|
|
|
#:locals locals
|
|
|
|
#:break (cdr (.break info)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((for ,init ,test ,step ,body)
|
|
|
|
(let* ((info (append-text info (ast->comment `(for ,init ,test ,step (ellipsis)))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(loop-label (string-append label "loop"))
|
|
|
|
(continue-label (string-append label "continue"))
|
|
|
|
(initial-skip-label (string-append label "initial_skip"))
|
|
|
|
(info ((ast->info info) init))
|
|
|
|
(info (clone info #:break (cons break-label (.break info))))
|
|
|
|
(info (clone info #:continue (cons continue-label (.continue info))))
|
|
|
|
(info (append-text info (wrap-as (i386:jump initial-skip-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,loop-label)))))
|
|
|
|
(info ((ast->info info) body))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,continue-label)))))
|
|
|
|
(info ((expr->accu info) step))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,initial-skip-label)))))
|
|
|
|
(info ((test-jump-label->info info break-label) test))
|
|
|
|
(info (append-text info (wrap-as (i386:jump loop-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
(clone info
|
|
|
|
#:locals locals
|
|
|
|
#:break (cdr (.break info))
|
|
|
|
#:continue (cdr (.continue info)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((while ,test ,body)
|
|
|
|
(let* ((info (append-text info (ast->comment `(while ,test (ellipsis)))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(loop-label (string-append label "loop"))
|
|
|
|
(continue-label (string-append label "continue"))
|
|
|
|
(info (append-text info (wrap-as (i386:jump continue-label))))
|
|
|
|
(info (clone info #:break (cons break-label (.break info))))
|
|
|
|
(info (clone info #:continue (cons continue-label (.continue info))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,loop-label)))))
|
|
|
|
(info ((ast->info info) body))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,continue-label)))))
|
|
|
|
(info ((test-jump-label->info info break-label) test))
|
|
|
|
(info (append-text info (wrap-as (i386:jump loop-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
(clone info
|
|
|
|
#:locals locals
|
|
|
|
#:break (cdr (.break info))
|
|
|
|
#:continue (cdr (.continue info)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((do-while ,body ,test)
|
|
|
|
(let* ((info (append-text info (ast->comment `(do-while ,test (ellipsis)))))
|
|
|
|
(here (number->string (length text)))
|
|
|
|
(label (string-append (.function info) "_" here "_"))
|
|
|
|
(break-label (string-append label "break"))
|
|
|
|
(loop-label (string-append label "loop"))
|
|
|
|
(continue-label (string-append label "continue"))
|
|
|
|
(info (clone info #:break (cons break-label (.break info))))
|
|
|
|
(info (clone info #:continue (cons continue-label (.continue info))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,loop-label)))))
|
|
|
|
(info ((ast->info info) body))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,continue-label)))))
|
|
|
|
(info ((test-jump-label->info info break-label) test))
|
|
|
|
(info (append-text info (wrap-as (i386:jump loop-label))))
|
|
|
|
(info (append-text info (wrap-as `((#:label ,break-label))))))
|
|
|
|
(clone info
|
|
|
|
#:locals locals
|
|
|
|
#:break (cdr (.break info))
|
|
|
|
#:continue (cdr (.continue info)))))
|
2017-05-25 05:32:29 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((labeled-stmt (ident ,label) ,statement)
|
|
|
|
(let ((info (append-text info `(((#:label ,(string-append (.function info) "_label_" label)))))))
|
|
|
|
((ast->info info) statement)))
|
2017-07-05 16:48:08 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((goto (ident ,label))
|
|
|
|
(append-text info (wrap-as (i386:jump (string-append (.function info) "_label_" label)))))
|
2017-03-12 11:02:12 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((return ,expr)
|
|
|
|
(let ((info ((expr->accu info) expr)))
|
|
|
|
(append-text info (append (wrap-as (i386:ret))))))
|
2017-03-12 11:02:12 +00:00
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
((decl . ,decl)
|
|
|
|
((decl->info info) o))
|
2017-01-17 18:03:08 +00:00
|
|
|
|
2017-04-06 07:12:50 +00:00
|
|
|
;; ...
|
|
|
|
((gt . _) ((expr->accu info) o))
|
|
|
|
((ge . _) ((expr->accu info) o))
|
|
|
|
((ne . _) ((expr->accu info) o))
|
|
|
|
((eq . _) ((expr->accu info) o))
|
|
|
|
((le . _) ((expr->accu info) o))
|
|
|
|
((lt . _) ((expr->accu info) o))
|
|
|
|
((lshift . _) ((expr->accu info) o))
|
|
|
|
((rshift . _) ((expr->accu info) o))
|
|
|
|
|
|
|
|
;; EXPR
|
2017-04-05 21:05:16 +00:00
|
|
|
((expr-stmt ,expression)
|
|
|
|
(let ((info ((expr->accu info) expression)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info (wrap-as (i386:accu-zero?)))))
|
2017-04-05 21:05:16 +00:00
|
|
|
|
|
|
|
;; FIXME: why do we get (post-inc ...) here
|
2017-04-06 07:12:50 +00:00
|
|
|
;; (array-ref
|
2017-04-05 21:05:16 +00:00
|
|
|
(_ (let ((info ((expr->accu info) o)))
|
2017-04-07 07:53:56 +00:00
|
|
|
(append-text info (wrap-as (i386:accu-zero?)))))))))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
2017-05-25 05:57:26 +00:00
|
|
|
(define (enum-def-list->constants constants fields)
|
|
|
|
(let loop ((fields fields) (i 0) (constants constants))
|
|
|
|
(if (null? fields) constants
|
|
|
|
(let* ((field (car fields))
|
|
|
|
(name (pmatch field
|
|
|
|
((enum-defn (ident ,name) . _) name)))
|
|
|
|
(i (pmatch field
|
|
|
|
((enum-defn ,name (p-expr (fixed ,value))) (cstring->number value))
|
2017-05-25 05:32:29 +00:00
|
|
|
((enum-defn ,name) i)
|
|
|
|
((enum-defn ,name (add (p-expr (fixed ,a)) (p-expr (fixed ,b))))
|
|
|
|
(+ (cstring->number a) (cstring->number b)))
|
|
|
|
((enum-defn ,name (sub (p-expr (fixed ,a)) (p-expr (fixed ,b))))
|
|
|
|
(- (cstring->number a) (cstring->number b)))
|
|
|
|
(_ (error "not supported enum field=~s\n" field)))))
|
2017-05-25 05:57:26 +00:00
|
|
|
(loop (cdr fields)
|
|
|
|
(1+ i)
|
|
|
|
(append constants (list (ident->constant name i))))))))
|
|
|
|
|
2017-05-17 11:56:25 +00:00
|
|
|
(define (initzer->non-const info)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
|
|
|
((initzer (p-expr (ident ,name)))
|
|
|
|
(let ((value (assoc-ref (.constants info) name)))
|
|
|
|
`(initzer (p-expr (fixed ,(number->string value))))))
|
|
|
|
(_ o))))
|
|
|
|
|
2017-07-20 22:21:31 +00:00
|
|
|
(define (initzer->value info)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (fixed ,value)) (cstring->number value))
|
|
|
|
(_ (error "initzer->value: " o)))))
|
|
|
|
|
2017-07-28 19:39:39 +00:00
|
|
|
(define (fix-null o)
|
|
|
|
(if (equal? o "\nul") (make-string 1 #\nul) o))
|
|
|
|
|
2017-07-12 04:55:05 +00:00
|
|
|
(define (initzer->data info)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
2017-07-18 06:04:50 +00:00
|
|
|
((initzer (p-expr (char ,char))) (int->bv32 (char->integer (string-ref char 0))))
|
2017-07-12 04:55:05 +00:00
|
|
|
((initzer (p-expr (string ,string))) `((#:string ,string) #f #f #f))
|
2017-07-28 19:39:39 +00:00
|
|
|
((initzer (p-expr (string . ,strings))) `((#:string ,(string-join (map fix-null strings) "")) #f #f #f))
|
2017-07-12 04:55:05 +00:00
|
|
|
((initzer (initzer-list . ,initzers)) (append-map (initzer->data info) initzers))
|
2017-07-24 13:22:51 +00:00
|
|
|
((initzer (ref-to (p-expr (ident ,name)))) `(,name #f #f #f))
|
2017-07-18 18:22:44 +00:00
|
|
|
((initzer (ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base))))))
|
|
|
|
(let* ((type (decl->ast-type struct))
|
|
|
|
(offset (field-offset info type field))
|
|
|
|
(base (cstring->number base)))
|
|
|
|
(int->bv32 (+ base offset))))
|
2017-07-12 04:55:05 +00:00
|
|
|
(() (int->bv32 0))
|
2017-07-24 13:22:51 +00:00
|
|
|
((initzer ,p-expr)
|
|
|
|
(int->bv32 (p-expr->number info p-expr)))
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ (error "initzer->data: unsupported: " o)))))
|
|
|
|
|
|
|
|
(define (initzer->accu info)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
2017-07-22 21:39:39 +00:00
|
|
|
((initzer-list . ,initzers) (fold (lambda (i info) ((expr->accu info) i)) info initzers))
|
|
|
|
((initzer (initzer-list . ,initzers)) (fold (lambda (i info) ((expr->accu info) i)) info initzers))
|
2017-07-12 04:55:05 +00:00
|
|
|
((initzer ,initzer) ((expr->accu info) o))
|
|
|
|
(() (append-text info (wrap-as (i386:value->accu 0))))
|
|
|
|
(_ (error "initzer->accu: " o)))))
|
|
|
|
|
|
|
|
(define (expr->global globals)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
|
|
|
((p-expr (string ,string))
|
|
|
|
(let ((g `(#:string ,string)))
|
|
|
|
(or (assoc g globals)
|
2017-07-15 09:24:14 +00:00
|
|
|
(string->global-entry string))))
|
2017-07-16 20:59:07 +00:00
|
|
|
((p-expr (string . ,strings))
|
2017-07-28 19:39:39 +00:00
|
|
|
(let* ((string (string-join (map fix-null strings) ""))
|
2017-07-16 20:59:07 +00:00
|
|
|
(g `(#:string ,string)))
|
|
|
|
(or (assoc g globals)
|
|
|
|
(string->global-entry string))))
|
2017-07-15 09:24:14 +00:00
|
|
|
;;((p-expr (fixed ,value)) (int->global-entry (cstring->number value)))
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ #f))))
|
|
|
|
|
|
|
|
(define (initzer->globals globals)
|
|
|
|
(lambda (o)
|
|
|
|
(pmatch o
|
|
|
|
((initzer (initzer-list . ,initzers)) (append-map (initzer->globals globals) initzers))
|
|
|
|
((initzer ,initzer) (list ((expr->global globals) initzer)))
|
|
|
|
(_ '(#f)))))
|
|
|
|
|
|
|
|
(define (type->info info o)
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(pmatch o
|
2017-07-12 04:55:05 +00:00
|
|
|
((struct-def (ident ,name) (field-list . ,fields))
|
2017-07-16 17:00:01 +00:00
|
|
|
(let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
|
2017-07-15 08:40:31 +00:00
|
|
|
(clone info #:types (cons type-entry (.types info)))))
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ info)))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
|
|
|
(define (.formals o)
|
|
|
|
(pmatch o
|
|
|
|
((fctn-defn _ (ftn-declr _ ,formals) _) formals)
|
2017-01-02 06:41:56 +00:00
|
|
|
((fctn-defn _ (ptr-declr (pointer) (ftn-declr _ ,formals)) _) formals)
|
2017-04-17 00:15:11 +00:00
|
|
|
((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr _ ,formals)) _) formals)
|
2017-07-20 23:02:17 +00:00
|
|
|
((fctn-defn _ (ptr-declr (pointer (pointer (pointer))) (ftn-declr _ ,formals)) _) formals)
|
2017-04-12 19:27:59 +00:00
|
|
|
(_ (error ".formals: " o))))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
2017-01-02 06:41:56 +00:00
|
|
|
(define (formal->text n)
|
|
|
|
(lambda (o i)
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
;;(i386:formal i n)
|
|
|
|
'()
|
|
|
|
))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
|
|
|
(define (formals->text o)
|
|
|
|
(pmatch o
|
|
|
|
((param-list . ,formals)
|
2017-01-02 06:41:56 +00:00
|
|
|
(let ((n (length formals)))
|
2017-04-07 07:36:30 +00:00
|
|
|
(wrap-as (append (i386:function-preamble)
|
|
|
|
(append-map (formal->text n) formals (iota n))
|
|
|
|
(i386:function-locals)))))
|
2017-04-12 19:27:59 +00:00
|
|
|
(_ (error "formals->text: unsupported: " o))))
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
|
2017-03-17 16:32:23 +00:00
|
|
|
(define (formal:ptr o)
|
|
|
|
(pmatch o
|
|
|
|
((param-decl (decl-spec-list . ,decl) (param-declr (ident ,name)))
|
|
|
|
0)
|
2017-04-17 00:15:11 +00:00
|
|
|
((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) (array-of (ident ,name)))))
|
|
|
|
2)
|
|
|
|
((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) (ident ,name))))
|
|
|
|
1)
|
|
|
|
((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) . _)))
|
|
|
|
1)
|
|
|
|
((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer (pointer)) (ident ,name))))
|
|
|
|
2)
|
2017-07-20 23:02:17 +00:00
|
|
|
((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer (pointer (pointer))) (ident ,name))))
|
|
|
|
3)
|
2017-07-12 04:55:05 +00:00
|
|
|
(_ 0)))
|
2017-03-17 16:32:23 +00:00
|
|
|
|
mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals):
Rename from statement->text+symbols. Handle locals.
(formals->text): Add proper function preamble.
(formals->locals): Add formals as locals.
(expr->accu, ident->accu, ident->base, ident-ref, global-ref): New
functions.
(strlen, eputs, fputs, puts): New functions.
(libc): New variable.
(i386:libc): Rename from libc. Remove eputs and puts.
* module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove.
(i386:call, i386:ret): Handle locals as argument.
(i386:function-locals, i386:function-preamble, i386:jump,
i386:local->accu, i386:local-add, i386:local-assign,
i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local,
i386:mem-byte->accu, i386:test-jump, i386:write): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-02 22:21:33 +00:00
|
|
|
(define (formals->locals o)
|
|
|
|
(pmatch o
|
|
|
|
((param-list . ,formals)
|
|
|
|
(let ((n (length formals)))
|
2017-07-15 09:46:13 +00:00
|
|
|
(map make-local-entry (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
|
2017-04-12 19:27:59 +00:00
|
|
|
(_ (error "formals->locals: unsupported: " o))))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
2017-01-04 23:55:46 +00:00
|
|
|
(define (function->info info)
|
2017-04-02 09:55:37 +00:00
|
|
|
(lambda (o)
|
2017-05-06 07:11:42 +00:00
|
|
|
(define (assert-return text)
|
|
|
|
(let ((return (wrap-as (i386:ret))))
|
|
|
|
(if (equal? (list-tail text (- (length text) (length return))) return) text
|
2017-05-17 11:56:25 +00:00
|
|
|
(append text return))))
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
(let* ((name (.name o))
|
2017-04-02 15:01:22 +00:00
|
|
|
(formals (.formals o))
|
|
|
|
(text (formals->text formals))
|
|
|
|
(locals (formals->locals formals)))
|
2017-06-25 07:33:55 +00:00
|
|
|
(format (current-error-port) " :~a\n" name)
|
2017-04-02 09:55:37 +00:00
|
|
|
(let loop ((statements (.statements o))
|
2017-03-09 07:14:27 +00:00
|
|
|
(info (clone info #:locals locals #:function (.name o) #:text text)))
|
2017-07-25 08:01:12 +00:00
|
|
|
(if (null? statements) (let* ((locals (.locals info))
|
|
|
|
(local (and (pair? locals) (car locals)))
|
|
|
|
(count (and=> local (compose local:id cdr)))
|
|
|
|
(stack (and count (* count 4))))
|
|
|
|
(if (and stack (getenv "MESC_DEBUG")) (stderr " stack: ~a\n" stack))
|
|
|
|
(clone info
|
|
|
|
#:function #f
|
|
|
|
#:functions (append (.functions info) (list (cons name (assert-return (.text info)))))))
|
2017-04-02 09:55:37 +00:00
|
|
|
(let* ((statement (car statements)))
|
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.
2017-04-02 10:23:00 +00:00
|
|
|
(loop (cdr statements)
|
|
|
|
((ast->info info) (car statements)))))))))
|
2017-01-04 23:55:46 +00:00
|
|
|
|
|
|
|
(define (ast-list->info info)
|
|
|
|
(lambda (elements)
|
|
|
|
(let loop ((elements elements) (info info))
|
|
|
|
(if (null? elements) info
|
|
|
|
(loop (cdr elements) ((ast->info info) (car elements)))))))
|
2017-04-02 09:55:37 +00:00
|
|
|
|
2017-05-17 11:56:25 +00:00
|
|
|
(define* (c99-input->info #:key (defines '()) (includes '()))
|
|
|
|
(lambda ()
|
2017-05-21 20:25:02 +00:00
|
|
|
(let* ((info (make <info> #:types i386:type-alist))
|
2017-05-17 11:56:25 +00:00
|
|
|
(foo (stderr "parsing: input\n"))
|
|
|
|
(ast (c99-input->ast #:defines defines #:includes includes))
|
|
|
|
(foo (stderr "compiling: input\n"))
|
|
|
|
(info ((ast->info info) ast))
|
|
|
|
(info (clone info #:text '() #:locals '())))
|
|
|
|
info)))
|
2017-04-12 19:27:59 +00:00
|
|
|
|
2017-06-11 11:11:40 +00:00
|
|
|
(define* (info->object o)
|
|
|
|
`((functions . ,(.functions o))
|
|
|
|
(globals . ,(map (lambda (g) (cons (car g) (global:value (cdr g)))) (.globals o)))))
|
2017-05-17 11:56:25 +00:00
|
|
|
|
2017-05-22 17:22:18 +00:00
|
|
|
(define* (c99-ast->info ast)
|
|
|
|
((ast->info (make <info> #:types i386:type-alist)) ast))
|
|
|
|
|
2017-05-17 11:56:25 +00:00
|
|
|
(define* (c99-input->elf #:key (defines '()) (includes '()))
|
2017-06-11 11:11:40 +00:00
|
|
|
((compose object->elf info->object (c99-input->info #:defines defines #:includes includes))))
|
2017-05-17 11:56:25 +00:00
|
|
|
|
|
|
|
(define* (c99-input->object #:key (defines '()) (includes '()))
|
2017-07-02 14:25:14 +00:00
|
|
|
((compose object->M1 info->object (c99-input->info #:defines defines #:includes includes))))
|