mescc.scm: first a.out produced from main.c.
This commit is contained in:
Jan Nieuwenhuizen
parent
85f3d40e71
commit
2c7f26dbe6
11
GNUmakefile
11
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
|
||||
|
|
|
|||
12
c-lexer.scm
12
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)
|
||||
|
|
|
|||
223
elf.mes
223
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 <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->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
|
||||
(define (i386:puts data length)
|
||||
`(
|
||||
#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)
|
||||
`(
|
||||
#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))
|
||||
|
||||
|
|
|
|||
209
lib/elf.mes
Normal file
209
lib/elf.mes
Normal file
|
|
@ -0,0 +1,209 @@
|
|||
;;; -*-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)
|
||||
3
main.c
3
main.c
|
|
@ -1,4 +1,5 @@
|
|||
int main ()
|
||||
{
|
||||
return 0;
|
||||
puts ("Hello, [messi] world!");
|
||||
return 1;
|
||||
}
|
||||
|
|
|
|||
122
mescc.scm
122
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)))))))
|
||||
|
|
|
|||
12
scm.mes
12
scm.mes
|
|
@ -18,6 +18,8 @@
|
|||
;;; 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)
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in a new issue