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 $@ $^
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
(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
)
(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)
;;; -*-scheme-*-
-(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)
-
-(define (i386:puts data)
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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
#xcd #x80 ;; int $0x80
))
-(define (text data)
+(define data
+ (string->list "Hello, world!\n"))
+
+(define (text d)
(append
- (i386:puts data)
+ (i386:puts d (length data))
(i386:exit 0)
))
-(define data
- (string->list "Hello, world!\n"))
-
(define (write-any x) (write-char (if (char? x) x (integer->char x))))
(map write-any (make-elf text data))
-
--- /dev/null
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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)
int main ()
{
- return 0;
+ puts ("Hello, [messi] world!");
+ return 1;
}
(lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma
=
- Identifier NumericLiteral
+ Identifier NumericLiteral StringLiteral
break case continue goto label
return switch
if else
(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 { ; }
(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
;; ;
(unary-expression
- (primary-expression) : $1)
+ (postfix-expression) : $1
+ )
;; unary_expression: postfix_expression
;; | INCOP unary_expression { ; }
;; | DECOP unary_expression { ; }
;; | 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
(primary-expression
(Identifier): $1
- (NumericLiteral) : $1)
+ (NumericLiteral) : $1
+ (StringLiteral) : $1
+ )
;; primary_expression: Identifier
;; INT_LITERAL
;; CHAR_LITERAL
;; 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
(lambda ()
(c-parser (c-lexer errorp) errorp))))
-(display "program: " (current-error-port))
-(display (mescc) (current-error-port))
-(newline (current-error-port))
-
-(define (write-int x) (write-char (integer->char x)))
-(define elf-header '(#x7f #\E #\L #\F #x01))
-
-(define elf-header '(#x7f #x45 #x4c #x46 #x01))
-;;(map write-char elf-header)
-(map write-int elf-header)
-(newline)
+(define (write-any x) (write-char (if (char? x) x (integer->char x))))
+
+(define (ast:function? o)
+ (and (pair? o) (eq? (car o) 'function)))
+
+(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)))))))
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
+(define (cadddr x) (car (cdddr x)))
+
(define (list . rest) rest)
(define-macro (case val . args)
(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))
projects / mes.git / commitdiff