From 2c7f26dbe6956020d27fe5af3f48b03c1ccfaba7 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 14 Aug 2016 01:44:42 +0200 Subject: [PATCH] mescc.scm: first a.out produced from main.c. --- GNUmakefile | 11 +-- c-lexer.scm | 12 ++- elf.mes | 223 ++++++---------------------------------------------- lib/elf.mes | 209 ++++++++++++++++++++++++++++++++++++++++++++++++ main.c | 3 +- mescc.scm | 124 ++++++++++++++++++++++++----- scm.mes | 12 +-- 7 files changed, 365 insertions(+), 229 deletions(-) create mode 100644 lib/elf.mes diff --git a/GNUmakefile b/GNUmakefile index a6ac9155..62b48d9c 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -118,14 +118,15 @@ guile-paren: paren.test echo '___P((()))' | guile -s $^ mescc: all - echo ' EOF ' | cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax-cond.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm c-lexer.scm mescc.scm - main.c | ./mes > a.out + echo ' EOF ' | cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax-cond.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm - main.c | ./mes > a.out chmod +x a.out -mescc.test: lib/lalr.scm c-lexer.scm mescc.scm +mescc.test: lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm cat $^ > $@ guile-mescc: mescc.test - cat main.c | guile -s $^ + cat main.c | guile -s $^ > a.out + chmod +x a.out hello.o: hello.S as --32 -march=i386 -o $@ $^ @@ -134,6 +135,6 @@ hello: hello.o ld -A i386 -m elf_i386 -nostdlib -nodefaultlibs -A i386 -o $@ $^ # ld -A i386 -m elf_i386 -A i386 -o $@ $^ -a.out: elf.mes GNUmakefile - cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes lib/rnrs/bytevectors.scm elf.mes | ./mes > a.out +a.out: lib/elf.mes elf.mes GNUmakefile + cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes lib/rnrs/bytevectors.scm lib/elf.mes elf.mes | ./mes > a.out chmod +x a.out diff --git a/c-lexer.scm b/c-lexer.scm index 3ad1c94e..6c57fb3c 100644 --- a/c-lexer.scm +++ b/c-lexer.scm @@ -26,7 +26,7 @@ (cond-expand (guile - (use-modules ((ice-9 rdelim))) + ;;(use-modules ((ice-9 rdelim))) (define (syntax-error what loc form . args) (throw 'syntax-error #f what @@ -37,9 +37,19 @@ ) (mes + ) ) +(define (read-delimited delims port handle-delim) + (let ((stop (string->list delims))) + (let loop ((c (peek-char)) (lst '())) + (if (member c stop) + (list->string lst) + (begin + (read-char) + (loop (peek-char) (append lst (list c)))))))) + (define (port-source-location port) (make-source-location (port-filename port) (port-line port) diff --git a/elf.mes b/elf.mes index ae1e44ab..8ee88758 100644 --- a/elf.mes +++ b/elf.mes @@ -1,198 +1,26 @@ ;;; -*-scheme-*- -(define (int->bv32 value) - (let ((bv (make-bytevector 4))) - (bytevector-u32-native-set! bv 0 value) - bv)) +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; scm.mes: 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 . -(define (int->bv16 value) - (let ((bv (make-bytevector 2))) - (bytevector-u16-native-set! bv 0 value) - bv)) - -(define elf32-addr int->bv32) -(define elf32-half int->bv16) -(define elf32-off int->bv32) -(define elf32-word int->bv32) - -(define (make-elf text data) - (define vaddress #x08048000) - - (define ei-magic `(#x7f ,@(string->list "ELF"))) - (define ei-class '(#x01)) ;; 32 bit - (define ei-data '(#x01)) ;; little endian - (define ei-version '(#x01)) - (define ei-osabi '(#x00)) - (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0)) - (define e-ident - (append - ei-magic - ei-class - ei-data - ei-version - ei-osabi - ei-pad)) - - (define ET-EXEC 2) - (define EM-386 3) - (define EV-CURRENT 1) - - (define p-filesz (elf32-word 0)) - (define p-memsz (elf32-word 0)) - (define PF-X 1) - (define PF-W 2) - (define PF-R 4) - (define p-flags (elf32-word (logior PF-X PF-W PF-R))) - (define p-align (elf32-word 1)) - - (define (program-header type offset text) - (append - (elf32-word type) - (elf32-off offset) - (elf32-addr (+ vaddress offset)) - (elf32-addr (+ vaddress offset)) - (elf32-word (length text)) - (elf32-word (length text)) - p-flags - p-align - )) - - (define (section-header name type offset text) - (append - (elf32-word name) - (elf32-word type) - (elf32-word 3) ;; write/alloc must for data hmm - (elf32-addr (+ vaddress offset)) - (elf32-off offset) - (elf32-word (length text)) - (elf32-word 0) - (elf32-word 0) - (elf32-word 1) - (elf32-word 0))) - - - (define e-type (elf32-half ET-EXEC)) - (define e-machine (elf32-half EM-386)) - (define e-version (elf32-word EV-CURRENT)) - (define e-entry (elf32-addr 0)) - ;;(define e-entry (elf32-addr (+ vaddress text-offset))) - ;;(define e-phoff (elf32-off 0)) - (define e-shoff (elf32-off 0)) - (define e-flags (elf32-word 0)) - ;;(define e-ehsize (elf32-half 0)) - (define e-phentsize (elf32-half (length (program-header 0 0 '())))) - (define e-phnum (elf32-half 1)) - (define e-shentsize (elf32-half (length (section-header 0 0 0 '())))) - (define e-shnum (elf32-half 5)) - (define e-shstrndx (elf32-half 4)) - - (define (elf-header size entry sections) - (append - e-ident - e-type - e-machine - e-version - (elf32-addr (+ vaddress entry)) ;; e-entry - (elf32-off size) ;; e-phoff - (elf32-off sections) ;; e-shoff - e-flags - (elf32-half size) ;; e-ehsize - e-phentsize - e-phnum - e-shentsize - e-shnum - e-shstrndx - )) - - (define elf-header-size - (length (elf-header 0 0 0))) - - (define program-header-size - (length (program-header 0 0 '()))) - - (define text-offset - (+ elf-header-size program-header-size)) - - (define (program-headers) - (append - (program-header 1 text-offset (text 0)) - )) - - - (define note - (string->list - (string-append - "MES" - ;;"Mes -- Maxwell Equations of Software\n" - ;;"https://gitlab.com/janneke/mes" - ) - ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00 - ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00 - )) - - (define tab - `( - #x00 ,@(string->list ".shstrtab") - #x00 ,@(string->list ".text") - #x00 ,@(string->list ".data") - #x00 ,@(string->list ".note") - #x00 #x00 #x00 #x00 - )) - - (define text-length - (length (text 0))) - - (define data-offset - (+ text-offset text-length)) - - (define data-address (+ data-offset vaddress)) - - (define data-length - (length data)) - - (define note-length - (length note)) - - (define note-offset - (+ data-offset data-length)) - - (define tab-offset - (+ note-offset note-length)) - - (define tab-length - (length tab)) - - (define section-headers-offset - (+ tab-offset tab-length)) - - - (define SHT-PROGBITS 1) - (define SHT-STRTAB 3) - (define SHT-NOTE 7) - (define (section-headers) - (append - (section-header 0 0 0 '()) - (section-header 11 SHT-PROGBITS text-offset (text 0)) - (section-header 17 SHT-PROGBITS data-offset data) - (section-header 23 SHT-NOTE note-offset note) - (section-header 1 SHT-STRTAB tab-offset tab) - )) - - (define exe - (append - (elf-header elf-header-size text-offset section-headers-offset) - (program-headers) - (text data-address) - data - note - tab - (section-headers) - )) - exe) - -(define (i386:puts data) +(define (i386:puts data length) `( - #xba #x0e #x00 #x00 #x00 ;; mov $0xe,%edx + #xba ,@(int->bv32 length) ;; mov $0xe,%edx #xb9 ,@(int->bv32 data) ;; mov $data,%ecx #xbb #x01 #x00 #x00 #x00 ;; mov $0x1,%ebx #xb8 #x04 #x00 #x00 #x00 ;; mov $0x4,%eax @@ -206,15 +34,14 @@ #xcd #x80 ;; int $0x80 )) -(define (text data) - (append - (i386:puts data) - (i386:exit 0) - )) - (define data (string->list "Hello, world!\n")) +(define (text d) + (append + (i386:puts d (length data)) + (i386:exit 0) + )) + (define (write-any x) (write-char (if (char? x) x (integer->char x)))) (map write-any (make-elf text data)) - diff --git a/lib/elf.mes b/lib/elf.mes new file mode 100644 index 00000000..5ce0126d --- /dev/null +++ b/lib/elf.mes @@ -0,0 +1,209 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; scm.mes: 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 . + +(define (int->bv32 value) + (let ((bv (make-bytevector 4))) + (bytevector-u32-native-set! bv 0 value) + bv)) + +(define (int->bv16 value) + (let ((bv (make-bytevector 2))) + (bytevector-u16-native-set! bv 0 value) + bv)) + +(define elf32-addr int->bv32) +(define elf32-half int->bv16) +(define elf32-off int->bv32) +(define elf32-word int->bv32) + +(define (make-elf text data) + (define vaddress #x08048000) + + (define ei-magic `(#x7f ,@(string->list "ELF"))) + (define ei-class '(#x01)) ;; 32 bit + (define ei-data '(#x01)) ;; little endian + (define ei-version '(#x01)) + (define ei-osabi '(#x00)) + (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0)) + (define e-ident + (append + ei-magic + ei-class + ei-data + ei-version + ei-osabi + ei-pad)) + + (define ET-EXEC 2) + (define EM-386 3) + (define EV-CURRENT 1) + + (define p-filesz (elf32-word 0)) + (define p-memsz (elf32-word 0)) + (define PF-X 1) + (define PF-W 2) + (define PF-R 4) + (define p-flags (elf32-word (logior PF-X PF-W PF-R))) + (define p-align (elf32-word 1)) + + (define (program-header type offset text) + (append + (elf32-word type) + (elf32-off offset) + (elf32-addr (+ vaddress offset)) + (elf32-addr (+ vaddress offset)) + (elf32-word (length text)) + (elf32-word (length text)) + p-flags + p-align + )) + + (define (section-header name type offset text) + (append + (elf32-word name) + (elf32-word type) + (elf32-word 3) ;; write/alloc must for data hmm + (elf32-addr (+ vaddress offset)) + (elf32-off offset) + (elf32-word (length text)) + (elf32-word 0) + (elf32-word 0) + (elf32-word 1) + (elf32-word 0))) + + + (define e-type (elf32-half ET-EXEC)) + (define e-machine (elf32-half EM-386)) + (define e-version (elf32-word EV-CURRENT)) + (define e-entry (elf32-addr 0)) + ;;(define e-entry (elf32-addr (+ vaddress text-offset))) + ;;(define e-phoff (elf32-off 0)) + (define e-shoff (elf32-off 0)) + (define e-flags (elf32-word 0)) + ;;(define e-ehsize (elf32-half 0)) + (define e-phentsize (elf32-half (length (program-header 0 0 '())))) + (define e-phnum (elf32-half 1)) + (define e-shentsize (elf32-half (length (section-header 0 0 0 '())))) + (define e-shnum (elf32-half 5)) + (define e-shstrndx (elf32-half 4)) + + (define (elf-header size entry sections) + (append + e-ident + e-type + e-machine + e-version + (elf32-addr (+ vaddress entry)) ;; e-entry + (elf32-off size) ;; e-phoff + (elf32-off sections) ;; e-shoff + e-flags + (elf32-half size) ;; e-ehsize + e-phentsize + e-phnum + e-shentsize + e-shnum + e-shstrndx + )) + + (define elf-header-size + (length (elf-header 0 0 0))) + + (define program-header-size + (length (program-header 0 0 '()))) + + (define text-offset + (+ elf-header-size program-header-size)) + + (define (program-headers) + (append + (program-header 1 text-offset (text 0)) + )) + + + (define note + (string->list + (string-append + "MES" + ;;"Mes -- Maxwell Equations of Software\n" + ;;"https://gitlab.com/janneke/mes" + ) + ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00 + ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00 + )) + + (define tab + `( + #x00 ,@(string->list ".shstrtab") + #x00 ,@(string->list ".text") + #x00 ,@(string->list ".data") + #x00 ,@(string->list ".note") + #x00 #x00 #x00 #x00 + )) + + (define text-length + (length (text 0))) + + (define data-offset + (+ text-offset text-length)) + + (define data-address (+ data-offset vaddress)) + + (define data-length + (length data)) + + (define note-length + (length note)) + + (define note-offset + (+ data-offset data-length)) + + (define tab-offset + (+ note-offset note-length)) + + (define tab-length + (length tab)) + + (define section-headers-offset + (+ tab-offset tab-length)) + + + (define SHT-PROGBITS 1) + (define SHT-STRTAB 3) + (define SHT-NOTE 7) + (define (section-headers) + (append + (section-header 0 0 0 '()) + (section-header 11 SHT-PROGBITS text-offset (text 0)) + (section-header 17 SHT-PROGBITS data-offset data) + (section-header 23 SHT-NOTE note-offset note) + (section-header 1 SHT-STRTAB tab-offset tab) + )) + + (define exe + (append + (elf-header elf-header-size text-offset section-headers-offset) + (program-headers) + (text data-address) + data + note + tab + (section-headers) + )) + exe) diff --git a/main.c b/main.c index 1482f27e..417964a2 100644 --- a/main.c +++ b/main.c @@ -1,4 +1,5 @@ int main () { - return 0; + puts ("Hello, [messi] world!"); + return 1; } diff --git a/mescc.scm b/mescc.scm index 68872f63..bed39304 100644 --- a/mescc.scm +++ b/mescc.scm @@ -10,7 +10,7 @@ (lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma = - Identifier NumericLiteral + Identifier NumericLiteral StringLiteral break case continue goto label return switch if else @@ -237,11 +237,11 @@ (lbrace rbrace) : '(compound) (lbrace declaration-list rbrace) : `(compound ,@$2) (lbrace statement-list rbrace) : `(compound ,@$2) - (lbrace declaration-list statement-list rbrace) : `(compound ,@$2 ,@$3)) + (lbrace declaration-list statement-list rbrace) : `(compound ,@$2 ,$3)) (statement-list (statement) : `(,$1) - (statement-list statement) : `(,@$1 ,@$2)) + (statement-list statement) : `(,@$1 ,$2)) ;; selection_statement: ;; IF lparen x rparen statement { ; } @@ -277,7 +277,9 @@ (x comma assignment-expression) : `($1 ,@$2)) (assignment-expression - (primary-expression) : $1 ;;(conditional-expression) + ;;(conditional-expression) + ;;(primary-expression) : $1 + (postfix-expression) : $1 (unary-expression assignment-operator assignment-expression) : `(,$2 ,$1 ,$3)) (assignment-operator @@ -355,7 +357,8 @@ ;; ; (unary-expression - (primary-expression) : $1) + (postfix-expression) : $1 + ) ;; unary_expression: postfix_expression ;; | INCOP unary_expression { ; } ;; | DECOP unary_expression { ; } @@ -369,6 +372,11 @@ ;; | NOT cast_expression { ; } ;; ; + (postfix-expression + (primary-expression) : $1 + (postfix-expression lparen rparen) : `(call ,$1 (arguments)) + (postfix-expression lparen argument-expression-list rparen) : `(call ,$1 ,$3)) + ;; postfix_expression: primary_expression ;; | postfix_expression lbracket x rbracket ;; | postfix_expression lparen rparen @@ -381,7 +389,9 @@ (primary-expression (Identifier): $1 - (NumericLiteral) : $1) + (NumericLiteral) : $1 + (StringLiteral) : $1 + ) ;; primary_expression: Identifier ;; INT_LITERAL ;; CHAR_LITERAL @@ -390,12 +400,34 @@ ;; lparen x rparen ;; - ;; argument_expression_list: assignment_expression - ;; | argument_expression_list comma assignment_expression - ;; ; + (argument-expression-list + (assignment-expression) : `(arguments ,$1) + (argument-expression-list comma assignment-expression): `(,@$1 ,@(cdr $2))))) - )) +(define (i386:puts data) + `( + #xba #x0e #x00 #x00 #x00 ;; mov $0xe,%edx + #xb9 ,@(int->bv32 data) ;; mov $data,%ecx + #xbb #x01 #x00 #x00 #x00 ;; mov $0x1,%ebx + #xb8 #x04 #x00 #x00 #x00 ;; mov $0x4,%eax + #xcd #x80 ;; int $0x80 + )) +(define (i386:exit code) + `( + #xbb ,@(int->bv32 code) ;; mov $code,%ebx + #xb8 #x01 #x00 #x00 #x00 ;; mov $0x1,%eax + #xcd #x80 ;; int $0x80 + )) + +(define (i386:puts data length) + `( + #xba ,@(int->bv32 length) ;; mov $length,%edx + #xb9 ,@(int->bv32 data) ;; mov $data,%ecx + #xbb #x01 #x00 #x00 #x00 ;; mov $0x1,%ebx + #xb8 #x04 #x00 #x00 #x00 ;; mov $0x4,%eax + #xcd #x80 ;; int $0x80 + )) (define mescc (let ((errorp @@ -405,14 +437,68 @@ (lambda () (c-parser (c-lexer errorp) errorp)))) -(display "program: " (current-error-port)) -(display (mescc) (current-error-port)) -(newline (current-error-port)) +(define (write-any x) (write-char (if (char? x) x (integer->char x)))) -(define (write-int x) (write-char (integer->char x))) -(define elf-header '(#x7f #\E #\L #\F #x01)) +(define (ast:function? o) + (and (pair? o) (eq? (car o) 'function))) -(define elf-header '(#x7f #x45 #x4c #x46 #x01)) -;;(map write-char elf-header) -(map write-int elf-header) -(newline) +(define (.name o) + (cadr o)) + +;; (define (.statement o) +;; (match o +;; (('function name signature statement) statement) +;; (_ #f))) + +;; (define (statement->data o) +;; (match o +;; (('call 'puts ('arguments string)) (string->list string)) +;; (_ '()))) + +;; (define (statement->text o) +;; (match o +;; (('call 'puts ('arguments string)) (list (lambda (data) (i386:puts data (string-length string))))) +;; (('return code) (list (lambda (data) (i386:exit code)))) +;; (_ '()))) + +(define (.statement o) + (and (pair? o) + (eq? (car o) 'function) + (cadddr o))) + +(define (statement->data o) + (or (and (pair? o) + (eq? (car o) 'call) + (string->list (cadr (caddr o)))) + '())) + +(define (statement->text o) + (cond + ((and (pair? o) (eq? (car o) 'call)) + (let ((string (cadr (caddr o)))) + (list (lambda (data) (i386:puts data (string-length string)))))) + ((and (pair? o) (eq? (car o) 'return)) + (list (lambda (data) (i386:exit (cadr o))))) + (else '()))) + +(let* ((ast (mescc)) + (functions (filter ast:function? (cdr ast))) + (main (find (lambda (x) (eq? (.name x) 'main)) functions)) + (statements (cdr (.statement main)))) + (display "program: " (current-error-port)) + (display ast (current-error-port)) + (newline (current-error-port)) + (let loop ((statements statements) (text '()) (data '())) + (display "text:" (current-error-port)) + (display text (current-error-port)) + (newline (current-error-port)) + (if (null? statements) + (map write-any (make-elf (lambda (data) + (append-map (lambda (f) (f data)) 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 statement)) + (append data (statement->data statement))))))) diff --git a/scm.mes b/scm.mes index 19d79f4b..45666395 100755 --- a/scm.mes +++ b/scm.mes @@ -18,6 +18,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . +(define (cadddr x) (car (cdddr x))) + (define (list . rest) rest) (define-macro (case val . args) @@ -186,11 +188,11 @@ (display newline)) (define (syntax-error message . rest) - (display "syntax-error:") - (display message) - (display ":") - (display rest) - (newline)) + (display "syntax-error:" (current-error-port)) + (display message (current-error-port)) + (display ":" (current-error-port)) + (display rest (current-error-port)) + (newline (current-error-port))) (define (list-ref lst k) (let loop ((lst lst) (k k))