From 7ec42c3cc72ef30b5991ce3abb92b3f17b502eea Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 31 Dec 2016 09:03:07 +0100 Subject: [PATCH] mescc: Use Nyacc frontend. * module/language/c99/compiler.mes: New file. * module/language/c99/compiler.scm: Include it. * module/mes/elf.mes: Move (mes-use-module) into cond-expand. * module/mes/elf.scm: New file. * module/mes/libc-i386.scm: New file. * module/nyacc/lang/c99/parser.mes: Add missing module includes. * module/nyacc/lang/util.mes: Add missing module include. * scripts/mescc.mes: Use Nyacc. * guile/mescc.scm: New file. * GNUmakefile (guile-mescc): Run it. --- GNUmakefile | 11 +- doc/examples/main.c | 6 +- guile/language | 1 + guile/mes | 1 + guile/mes/nyacc | 1 - guile/mescc.scm | 44 ++++++++ guile/nyacc | 1 + guile/nyacc-calc.scm | 11 +- guile/nyacc.scm | 9 +- module/language/c99/compiler.mes | 145 +++++++++++++++++++++++++++ module/language/c99/compiler.scm | 40 ++++++++ module/{rnrs => mes}/bytevectors.mes | 0 module/mes/bytevectors.scm | 36 +++++++ module/mes/elf.mes | 5 +- module/mes/elf.scm | 37 +++++++ module/mes/libc-i386.scm | 39 +++++++ module/mes/pmatch.scm | 14 +++ module/nyacc/lang/c99/parser.mes | 2 + module/nyacc/lang/util.mes | 1 + scripts/mescc.mes | 21 ++-- 20 files changed, 403 insertions(+), 22 deletions(-) create mode 120000 guile/language create mode 120000 guile/mes delete mode 120000 guile/mes/nyacc create mode 100755 guile/mescc.scm create mode 120000 guile/nyacc create mode 100644 module/language/c99/compiler.mes create mode 100644 module/language/c99/compiler.scm rename module/{rnrs => mes}/bytevectors.mes (100%) create mode 100644 module/mes/bytevectors.scm create mode 100644 module/mes/elf.scm create mode 100644 module/mes/libc-i386.scm diff --git a/GNUmakefile b/GNUmakefile index 990e81e9..d7d4a146 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -96,17 +96,14 @@ guile-check: guile/nyacc-calc.scm MAIN_C:=doc/examples/main.c -mescc: all +mescc: all $(MAIN_C) rm -f a.out - scripts/mescc.mes $(MAIN_C) + scripts/mescc.mes $(MAIN_C) > a.out ./a.out; r=$$?; [ $$r = 42 ] -mescc.cat: all $(MES-0) module/rnrs/bytevectors.mes module/mes/elf.mes module/mes/libc-i386.mes module/language/c/lexer.mes module/language/c/parser.mes module/language/c/compiler.mes - echo '(compile)' | cat $(filter %.scm %.mes, $^) - > $@ - -guile-mescc: mescc.cat +guile-mescc: $(MAIN_C) rm -f a.out - cat $(MAIN_C) | $(GUILE) -s $^ > a.out + guile/mescc.scm $(MAIN_C) > a.out chmod +x a.out ./a.out; r=$$?; [ $$r = 42 ] diff --git a/doc/examples/main.c b/doc/examples/main.c index 722db580..912aaf57 100644 --- a/doc/examples/main.c +++ b/doc/examples/main.c @@ -1,8 +1,8 @@ -int main () +int +main () { - int i; // = 0; puts ("Hi Mes!\n"); - for (i = 0; i < 4; ++i) + for (int i = 0; i < 4; ++i) puts (" Hello, world!\n"); return 42; } diff --git a/guile/language b/guile/language new file mode 120000 index 00000000..4f52fd33 --- /dev/null +++ b/guile/language @@ -0,0 +1 @@ +../module/language \ No newline at end of file diff --git a/guile/mes b/guile/mes new file mode 120000 index 00000000..cd5c453d --- /dev/null +++ b/guile/mes @@ -0,0 +1 @@ +../module/mes \ No newline at end of file diff --git a/guile/mes/nyacc b/guile/mes/nyacc deleted file mode 120000 index dff38cc7..00000000 --- a/guile/mes/nyacc +++ /dev/null @@ -1 +0,0 @@ -../../module/nyacc \ No newline at end of file diff --git a/guile/mescc.scm b/guile/mescc.scm new file mode 100755 index 00000000..25fc9319 --- /dev/null +++ b/guile/mescc.scm @@ -0,0 +1,44 @@ +#! /bin/sh +# -*-scheme-*- +export GUILE_AUTO_COMPILE=0 +exec ${GUILE-guile} -L $(pwd)/guile -e '(mescc)' -s "$0" "$@" +!# + +;;; Mes --- The Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; This file is part of GNU Guix. +;;; +;;; 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 . + +;; The Maxwell Equations of Software -- John McCarthy page 13 +;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf + +#! +Run with Guile-1.8: +GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' guile/mescc.scm +!# + +(define-module (mescc) + #:use-module (language c99 compiler) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 pretty-print) + #:export (main)) + +(define (main arguments) + (let* ((files (cdr arguments)) + (file (if (null? files) "doc/examples/main.c" + (car files)))) + (with-input-from-file file + compile))) diff --git a/guile/nyacc b/guile/nyacc new file mode 120000 index 00000000..cb679136 --- /dev/null +++ b/guile/nyacc @@ -0,0 +1 @@ +../module/nyacc \ No newline at end of file diff --git a/guile/nyacc-calc.scm b/guile/nyacc-calc.scm index a906231c..b8a0a91c 100755 --- a/guile/nyacc-calc.scm +++ b/guile/nyacc-calc.scm @@ -1,6 +1,7 @@ #! /bin/sh # -*-scheme-*- -exec ${GUILE-guile} -L $(pwd)/guile/mes -e '(nyacc)' -s "$0" "$@" +export GUILE_AUTO_COMPILE=0 +exec ${GUILE-guile} -L $(pwd)/guile -e '(nyacc)' -s "$0" "$@" !# ;;; Mes --- The Maxwell Equations of Software @@ -38,9 +39,13 @@ GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' guile/nyacc.scm ;; notice and this notice are preserved. This file is offered as-is, ;; without any warranty. +(cond-expand + (guile-2) + (guile + (use-modules (ice-9 syncase)) + (use-modules (ice-9 optargs)))) + (define-module (nyacc) - #:use-module (ice-9 syncase) ;; guile-1.8 - #:use-module (ice-9 optargs) ;; guile-1.8 #:use-module (nyacc lalr) #:use-module (nyacc lex) #:use-module (nyacc parse) diff --git a/guile/nyacc.scm b/guile/nyacc.scm index ea227dcf..a695d749 100755 --- a/guile/nyacc.scm +++ b/guile/nyacc.scm @@ -1,6 +1,7 @@ #! /bin/sh # -*-scheme-*- -exec ${GUILE-guile} -L $(pwd)/guile/mes -e '(nyacc)' -s "$0" "$@" +export GUILE_AUTO_COMPILE=0 +exec ${GUILE-guile} -L $(pwd)/guile -e '(nyacc)' -s "$0" "$@" !# ;;; Mes --- The Maxwell Equations of Software @@ -29,6 +30,12 @@ Run with Guile-1.8: GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' guile/nyacc.scm !# +(cond-expand + (guile-2) + (guile + (use-modules (ice-9 syncase)) + (use-modules (ice-9 optargs)))) + (define-module (nyacc) #:use-module (nyacc lang c99 parser) #:use-module (ice-9 rdelim) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes new file mode 100644 index 00000000..d60332b5 --- /dev/null +++ b/module/language/c99/compiler.mes @@ -0,0 +1,145 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; This file is part of Mes. +;;; +;;; Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Mes. If not, see . + +;;; Commentary: + +;;; compiler.mes produces an i386 binary from the C produced by +;;; Nyacc c99. + +;;; Code: + +(cond-expand + (guile + (set-port-encoding! (current-output-port) "ISO-8859-1")) + (mes + (mes-use-module (nyacc lang c99 parser)) + (mes-use-module (mes pmatch)) + (mes-use-module (mes elf)) + (mes-use-module (mes libc-i386)))) + +(define (mescc) + (parse-c99 #:inc-dirs '())) + +(define (write-any x) + (write-char (if (char? x) x (integer->char (if (>= x 0) x (+ x 256)))))) + +(define (ast:function? o) + (and (pair? o) (eq? (car o) 'fctn-defn))) + +(define (.name o) + (pmatch o + ((fctn-defn _ (ftn-declr (ident ,name) _) _) name))) + +(define (.statements o) + (pmatch o + ((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements))) + +(define (statement->data o) + (pmatch o + ((expr-stmt (fctn-call (p-expr (ident ,name)) + (expr-list (p-expr (string ,string))))) + (string->list string)) + ((for (decl (decl-spec-list (type-spec (fixed-type ,type))) + (init-declr-list (init-declr (ident ,identifier) + (initzer (p-expr (fixed ,start)))))) + (lt (p-expr (ident _)) (p-expr (fixed ,test))) + ,step ;;(pre-inc (p-expr (ident i))) + ,statement) + (statement->data statement)) + (_ '()))) + +(define (statement->text data o) + (let ((offset (length data))) + (pmatch o + ((expr-stmt (fctn-call (p-expr (ident ,name)) + (expr-list (p-expr (string ,string))))) + (list (lambda (data) (i386:puts (+ data offset) (string-length string))))) + ((for (decl (decl-spec-list (type-spec (fixed-type ,type))) + (init-declr-list (init-declr (ident ,identifier) + (initzer (p-expr (fixed ,start)))))) + (lt (p-expr (ident _)) (p-expr (fixed ,test))) + ,step ;;(pre-inc (p-expr (ident i))) + ,statement) + (display "start:" (current-error-port)) + (display start (current-error-port)) + (newline (current-error-port)) + + (display "test:" (current-error-port)) + (display test (current-error-port)) + (newline (current-error-port)) + + ;; (display "step:" (current-error-port)) + ;; (display step (current-error-port)) + ;; (newline (current-error-port)) + ;; + (display "for-statement:" (current-error-port)) + (display statement (current-error-port)) + (newline (current-error-port)) + + (let ((start (string->number start)) + (test (string->number test)) + (step 1) + (statement (car (statement->text data statement)))) + + (display "2start:" (current-error-port)) + (display start (current-error-port)) + (newline (current-error-port)) + + (display "2for-statement:" (current-error-port)) + (display statement (current-error-port)) + (newline (current-error-port)) + + (list (lambda (d) (i386:for start test step (statement d)))))) + + ((return (p-expr (fixed ,value))) + (let ((value (string->number value))) + (list (lambda (data) (i386:exit value))))) + (_ '())))) + +(define (function->text+data o) + (let loop ((statements (.statements o)) (text '()) (data '())) + (display "text:" (current-error-port)) + (display text (current-error-port)) + (newline (current-error-port)) + (if (null? statements) (values text data) + (let* ((statement (car statements))) + (display "statement:" (current-error-port)) + (display statement (current-error-port)) + (newline (current-error-port)) + (loop (cdr statements) + (append text (statement->text data statement)) + (append data (statement->data statement))))))) + +(define (text+data->exe text data) + (display "dumping to a.out:\n" (current-error-port)) + (map write-any (make-elf (lambda (data) + (append-map (lambda (f) (f data)) text)) data))) + +(define (compile) + (let* ((ast (mescc)) + (functions (filter ast:function? (cdr ast))) + (main (find (lambda (x) (equal? (.name x) "main")) functions))) + (display "AST" (current-error-port)) + (pretty-print ast (current-error-port)) + (format (current-error-port) "functions~a\n" functions) + (format (current-error-port) "main~a\n" main) + (call-with-values + (lambda () (function->text+data main)) + text+data->exe))) diff --git a/module/language/c99/compiler.scm b/module/language/c99/compiler.scm new file mode 100644 index 00000000..ee52800d --- /dev/null +++ b/module/language/c99/compiler.scm @@ -0,0 +1,40 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; This file is part of Mes. +;;; +;;; Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Mes. If not, see . + +;;; Commentary: + +;;; Code: + +(define-module (language c99 compiler) + #:use-module (srfi srfi-1) + #:use-module (system base pmatch) + #:use-module (ice-9 pretty-print) + #:use-module (mes elf) + #:use-module (mes libc-i386) + #:use-module (nyacc lang c99 parser) + #:export (compile)) + +(cond-expand + (guile-2) + (guile + (use-modules (ice-9 syncase))) + (mes)) + +(include-from-path "language/c99/compiler.mes") diff --git a/module/rnrs/bytevectors.mes b/module/mes/bytevectors.mes similarity index 100% rename from module/rnrs/bytevectors.mes rename to module/mes/bytevectors.mes diff --git a/module/mes/bytevectors.scm b/module/mes/bytevectors.scm new file mode 100644 index 00000000..514276f4 --- /dev/null +++ b/module/mes/bytevectors.scm @@ -0,0 +1,36 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; This file is part of Mes. +;;; +;;; Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Mes. If not, see . + +;;; Commentary: + +;;; Code: + +(define-module (mes bytevectors) + #:export (bytevector-u32-native-set! + bytevector-u16-native-set! + make-bytevector)) + +(cond-expand + (guile-2) + (guile + (use-modules (ice-9 syncase))) + (mes)) + +(include-from-path "mes/bytevectors.mes") diff --git a/module/mes/elf.mes b/module/mes/elf.mes index c79a9a4b..8ea9b679 100644 --- a/module/mes/elf.mes +++ b/module/mes/elf.mes @@ -24,7 +24,10 @@ ;;; Code: -(mes-use-module (rnrs bytevectors)) +(cond-expand + (guile) + (mes + (mes-use-module (mes bytevectors)))) (define (int->bv32 value) (let ((bv (make-bytevector 4))) diff --git a/module/mes/elf.scm b/module/mes/elf.scm new file mode 100644 index 00000000..fe568e3c --- /dev/null +++ b/module/mes/elf.scm @@ -0,0 +1,37 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; This file is part of Mes. +;;; +;;; Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Mes. If not, see . + +;;; Commentary: + +;;; Code: + +(define-module (mes elf) + #:use-module (mes bytevectors) + #:export (int->bv16 + int->bv32 + make-elf)) + +(cond-expand + (guile-2) + (guile + (use-modules (ice-9 syncase))) + (mes)) + +(include-from-path "mes/elf.mes") diff --git a/module/mes/libc-i386.scm b/module/mes/libc-i386.scm new file mode 100644 index 00000000..f1f05a0d --- /dev/null +++ b/module/mes/libc-i386.scm @@ -0,0 +1,39 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; This file is part of Mes. +;;; +;;; Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Mes. If not, see . + +;;; Commentary: + +;;; libc-i386.mes defines C library routines + +;;; Code: + +(define-module (mes libc-i386) + #:use-module (mes elf) + #:export (i386:exit + i386:for + i386:puts)) + +(cond-expand + (guile-2) + (guile + (use-modules (ice-9 syncase))) + (mes)) + +(include-from-path "mes/libc-i386.mes") diff --git a/module/mes/pmatch.scm b/module/mes/pmatch.scm index e9b9eb20..ef782a8b 100644 --- a/module/mes/pmatch.scm +++ b/module/mes/pmatch.scm @@ -34,6 +34,20 @@ ;;; Code: +;; (pmatch exp ...[]) +;; ::= ( exp ...) +;; ::= (else exp ...) +;; ::= boolean exp | () +;; :: = +;; ,var -- matches always and binds the var +;; pattern must be linear! No check is done +;; _ -- matches always +;; 'exp -- comparison with exp (using equal?) REMOVED (August 8, 2012) +;; exp -- comparison with exp (using equal?) +;; ( ...) -- matches the list of patterns +;; ( . ) -- ditto +;; () -- matches the empty list + (define-module (system base pmatch) #:export-syntax (pmatch)) diff --git a/module/nyacc/lang/c99/parser.mes b/module/nyacc/lang/c99/parser.mes index 99227233..acfb9a9f 100644 --- a/module/nyacc/lang/c99/parser.mes +++ b/module/nyacc/lang/c99/parser.mes @@ -23,6 +23,8 @@ ;;; Code: (mes-use-module (mes guile)) +(mes-use-module (mes catch)) +(mes-use-module (mes fluids)) (mes-use-module (mes pretty-print)) (mes-use-module (mes optargs)) (mes-use-module (srfi srfi-9-psyntax)) diff --git a/module/nyacc/lang/util.mes b/module/nyacc/lang/util.mes index c5017bfb..b63485e2 100644 --- a/module/nyacc/lang/util.mes +++ b/module/nyacc/lang/util.mes @@ -23,6 +23,7 @@ ;;; Code: (mes-use-module (mes guile)) +(mes-use-module (mes fluids)) (mes-use-module (mes optargs)) (mes-use-module (srfi srfi-1)) (include-from-path "nyacc/lang/util.scm") diff --git a/scripts/mescc.mes b/scripts/mescc.mes index 76d2fb30..511f2009 100755 --- a/scripts/mescc.mes +++ b/scripts/mescc.mes @@ -1,7 +1,8 @@ #! /bin/sh # -*-scheme-*- prefix=module/ -cat ${1-$(dirname $(dirname $0))/share/doc/mes/examples/main.c} | cat $prefix/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" > a.out +echo '()' | cat $prefix/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" +#paredit:|| chmod +x a.out exit $? !# @@ -27,13 +28,21 @@ exit $? ;;; Commentary: ;;; mescc.mes is a proof-of-concept simplistic C compiler and linker -;;; -;;; Run with Guile: -;;; make guile-mescc ;;; Code: -(mes-use-module (language c compiler)) +;;LALR +;;(mes-use-module (language c compiler)) +;;Nyacc +(mes-use-module (mes guile)) +(mes-use-module (language c99 compiler)) -(compile) +(define (main arguments) + (let* ((files (cdr arguments)) + (file (if (null? files) "doc/examples/main.c" + (car files)))) + (with-input-from-file file + compile))) + +(main '("mes")) ()