artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

build: compile crt1.c, libc-mesc.c and <input>.c separately.

Browse source 
* mlibc/crt1.c: New file.
* mlibc/libc-mes.c (_start): Remove.
* mlibc/libc-gcc.c (_start): Remove.
* make.scm (LINK.hex2, bin.mescc): Move from guile/guix/make.scm.
* guile/guix/make.scm (LINK.hex2, bin.mescc): Remove.
This commit is contained in:
Jan Nieuwenhuizen 2017-09-10 16:59:43 +02:00
parent 29acdfa2a7
commit 7619190d5c
8 changed files with 265 additions and 212 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

157
guile/guix/make.scm
View file

@ -39,7 +39,8 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix shell-utils) #:use-module (guix shell-utils)
#:export (build #:export (base-name
build
check check
clean clean
group group
@ -50,15 +51,18 @@
cpp.mescc cpp.mescc
compile.mescc compile.mescc
compile.gcc
ld ld
bin.mescc bin.mescc
bin.gcc bin.gcc
snarf snarf
m1.as
crt1.mlibc-o
libc-gcc.mlibc-o
libc-gcc+tcc.mlibc-o
libc-mes.E
libc-mes+tcc.E
mini-libc-mes.E
add-target add-target
get-target get-target
@ -66,7 +70,19 @@
system** system**
target-file-name target-file-name
method
target target
store
target-inputs
method-name
assert-gulp-pipe*
PATH-search-path
%MESCC
%HEX2
%M1
%targets %targets
%status %status
@ -324,19 +340,19 @@
"-D" "-D"
"POSIX=1" "POSIX=1"
"-I" "src" "-I" "src"
"-I" "mlibc"
"-I" "mlibc/include" "-I" "mlibc/include"
"--include=mlibc/libc-gcc.c" "--include=mlibc/libc-gcc.c"))
))
(define %C32-FLAGS (define %C32-FLAGS
'("--std=gnu99" '("--std=gnu99"
"-O0" "-O0"
"-g" "-g"
"-I" "src" "-I" "src"
"-I" "mlibc/include" "-I" "mlibc"
"--include=mlibc/libc-gcc.c" "-I" "mlibc/include"))
))
(define* (CC.gcc #:key (libc #t) (cc (if libc %CC %CC32)) (c-flags (if libc %C-FLAGS %C32-FLAGS)) (defines '()) (includes '())) (define* (CC.gcc #:key (libc #t) (cc (if (eq? libc #t) %CC %CC32)) (c-flags (if (eq? libc #t) %C-FLAGS %C32-FLAGS)) (defines '()) (includes '()))
(method (name "CC.gcc") (method (name "CC.gcc")
(build (lambda (o t) (build (lambda (o t)
(let* ((input-files (map target-file-name (target-inputs t))) (let* ((input-files (map target-file-name (target-inputs t)))
@ -344,13 +360,12 @@
"-c" "-c"
,@(append-map (cut list "-D" <>) defines) ,@(append-map (cut list "-D" <>) defines)
,@(append-map (cut list "-I" <>) includes) ,@(append-map (cut list "-I" <>) includes)
,@(if libc '() '("-nostdinc" "-fno-builtin")) ,@(if (eq? libc #t) '() '("-nostdinc" "-fno-builtin"))
,@c-flags ,@c-flags
"-o" ,(target-file-name t) "-o" ,(target-file-name t)
,@(filter (cut string-suffix? ".c" <>) input-files)))) ,@(filter (cut string-suffix? ".c" <>) input-files))))
(format (current-error-port) " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t)) (format (current-error-port) " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(apply system** command)))) (apply system** command))))))
(inputs (list (store #:add-file "mlibc/libc-gcc.c"))))) ;; FIXME: FLAGS
(define* (CPP.mescc #:key (cc %MESCC) (defines '()) (includes '())) (define* (CPP.mescc #:key (cc %MESCC) (defines '()) (includes '()))
(method (name "CPP.mescc") (method (name "CPP.mescc")
@ -375,12 +390,14 @@
`("guile/mescc.scm" "-c" `("guile/mescc.scm" "-c"
"-o" ,(target-file-name t) "-o" ,(target-file-name t)
,@input-files))))) ,@input-files)))))
(inputs (list (store #:add-file "guile/language/c99/compiler.go") (inputs (list (store #:add-file "guile/language/c99/info.go")
(store #:add-file "guile/language/c99/info.go") (store #:add-file "guile/language/c99/compiler.go")
(store #:add-file "guile/mes/as.go")
(store #:add-file "guile/mes/as-i386.go") (store #:add-file "guile/mes/as-i386.go")
(store #:add-file "guile/mes/as.go")
(store #:add-file "guile/mes/elf.go")
(store #:add-file "guile/mes/bytevectors.go") (store #:add-file "guile/mes/bytevectors.go")
(store #:add-file "guile/mes/M1.go"))))) (store #:add-file "guile/mes/M1.go")
(store #:add-file "guile/mes/guile.go")))))
(define %M1 (or (PATH-search-path "M1" #:default #f) (define %M1 (or (PATH-search-path "M1" #:default #f)
(PATH-search-path "M0" #:default #f) ; M1 is in unreleased mescc-tools 0.2 (PATH-search-path "M0" #:default #f) ; M1 is in unreleased mescc-tools 0.2
@ -394,7 +411,7 @@
(if (equal? (basename %M1) "M0") (if (equal? (basename %M1) "M0")
(set! %M1-FLAGS %M0-FLAGS)) (set! %M1-FLAGS %M0-FLAGS))
(define* (M1.asm #:key (m1 %M1) (m1-flags %M1-FLAGS)) (define* (M1.as #:key (m1 %M1) (m1-flags %M1-FLAGS))
(method (name "M1") (method (name "M1")
(build (lambda (o t) (build (lambda (o t)
(let* ((input-files (map target-file-name (target-inputs t))) (let* ((input-files (map target-file-name (target-inputs t)))
@ -413,48 +430,20 @@
(newline)))))) (newline))))))
(inputs (list (store #:add-file "stage0/x86.M1"))))) (inputs (list (store #:add-file "stage0/x86.M1")))))
(define %HEX2-FLAGS (define* (LINK.gcc #:key (cc %CC) (c-flags %C-FLAGS) (libc #t) (crt1 #f))
'("--LittleEndian"
"--Architecture=1"
"--BaseAddress=0x1000000"))
(define %HEX2 (PATH-search-path "hex2"))
(define* (LINK.hex2 #:key (hex2 %HEX2) (hex2-flags %HEX2-FLAGS) debug?)
(method (name "LINK.hex2")
(build (lambda (o t)
(let* ((input-files (map target-file-name (target-inputs t)))
;; FIXME: snarf inputs
(input-files (filter (lambda (f) (string-suffix? "hex2" f))
input-files)))
(format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(with-output-to-file (target-file-name t)
(lambda _
(set-port-encoding! (current-output-port) "ISO-8859-1")
(display
(apply assert-gulp-pipe*
`(,hex2
,@hex2-flags
"-f"
,(if (not debug?) "stage0/elf32-0header.hex2"
"stage0/elf32-header.hex2")
,@(append-map (cut list "-f" <>) input-files)
"-f"
,(if (not debug?) "stage0/elf-0footer.hex2"
"stage0/elf32-footer-single-main.hex2"))))))
(chmod (target-file-name t) #o755))))
(inputs (list (store #:add-file "stage0/elf32-0header.hex2")
(store #:add-file "stage0/elf-0footer.hex2")))))
(define* (LINK.gcc #:key (cc %CC) (c-flags %C-FLAGS) (libc #t))
(method (name "LINK.gcc") (method (name "LINK.gcc")
(build (lambda (o t) (build (lambda (o t)
(let* ((input-files (map target-file-name (target-inputs t))) (let* ((input-files (map target-file-name (target-inputs t)))
(command `(,cc (command `(,cc
,@c-flags ,@c-flags
,@(if libc '() '("-nostdlib")) ,@(if (eq? libc #t) '() '("-nostdlib"))
"-o" "-o"
,(target-file-name t) ,(target-file-name t)
,@input-files))) ,@(if crt1 (list (target-file-name crt1))'())
,@input-files
,@(cond ((eq? libc #t) '())
(libc (list (target-file-name libc)))
(else '())))))
(format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t)) (format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(apply system** command)))))) (apply system** command))))))
@ -478,13 +467,9 @@
(inputs (cons c-target dependencies)) (inputs (cons c-target dependencies))
(method (CPP.mescc #:cc cc #:defines defines #:includes includes))))) (method (CPP.mescc #:cc cc #:defines defines #:includes includes)))))
(define mini-libc-mes.E (cpp.mescc "mlibc/mini-libc-mes.c")) (define* (compile.gcc input-file-name #:key (libc #t) (cc (if (eq? libc #t) %CC %CC32)) (defines '()) (includes '()) (dependencies '()))
(define libc-mes.E (cpp.mescc "mlibc/libc-mes.c"))
(define libc-mes+tcc.E (cpp.mescc "mlibc/libc-mes+tcc.c"))
(define* (compile.gcc input-file-name #:key (libc #t) (cc (if libc %CC %CC32)) (defines '()) (includes '()) (dependencies '()))
(let* ((base-name (base-name input-file-name ".c")) (let* ((base-name (base-name input-file-name ".c"))
(cross (if libc "" "mlibc-")) (cross (if (eq? libc #t) "" "mlibc-"))
(suffix (string-append "." cross "o")) (suffix (string-append "." cross "o"))
(target-file-name (string-append base-name suffix)) (target-file-name (string-append base-name suffix))
(c-target (target (file-name input-file-name)))) (c-target (target (file-name input-file-name))))
@ -492,62 +477,34 @@
(inputs (cons c-target dependencies)) (inputs (cons c-target dependencies))
(method (CC.gcc #:cc cc #:libc libc #:defines defines #:includes includes))))) (method (CC.gcc #:cc cc #:libc libc #:defines defines #:includes includes)))))
(define* (compile.mescc input-file-name #:key (cc %MESCC) (libc libc-mes.E) (defines '()) (includes '()) (dependencies '())) (define* (compile.mescc input-file-name #:key (cc %MESCC) (defines '()) (includes '()) (dependencies '()))
(let* ((base-name (base-name input-file-name ".c")) (let* ((base-name (base-name input-file-name ".c"))
;;(foo (format (current-error-port) "COMPILE[~s .c] base=~s\n" input-file-name base-name)) (suffix ".M1")
(suffix (cond ((not libc) ".0-M1")
((eq? libc libc-mes.E) ".M1")
((eq? libc libc-mes+tcc.E) ".tcc-M1")
(else ".mini-M1")))
(target-file-name (string-append base-name suffix)) (target-file-name (string-append base-name suffix))
(E-target (cpp.mescc input-file-name #:cc cc #:defines defines #:includes includes #:dependencies dependencies))) (E-target (cpp.mescc input-file-name #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
(target (file-name target-file-name) (target (file-name target-file-name)
(inputs `(,@(if libc (list libc) '()) ,E-target)) (inputs `(,E-target))
(method (CC.mescc #:cc cc))))) (method (CC.mescc #:cc cc)))))
(define* (m1-asm input-file-name #:key (cc %MESCC) (m1 %M1) (libc libc-mes.E) (defines '()) (includes '()) (dependencies '())) (define* (m1.as input-file-name #:key (cc %MESCC) (m1 %M1) (defines '()) (includes '()) (dependencies '()))
(let* ((base-name (base-name input-file-name ".c")) (let* ((base-name (base-name input-file-name ".c"))
;;(foo (format (current-error-port) "m1-asm[~s .m1] base=~s\n" input-file-name base-name)) ;;(foo (format (current-error-port) "m1.as[~s .m1] base=~s\n" input-file-name base-name))
(suffix (cond ((not libc) ".0-hex2") (suffix ".hex2")
((eq? libc libc-mes.E) ".hex2")
((eq? libc libc-mes+tcc.E) ".tcc-hex2")
(else ".mini-hex2")))
(target-file-name (string-append base-name suffix)) (target-file-name (string-append base-name suffix))
(m1-target (compile.mescc input-file-name #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies)) (m1-target (compile.mescc input-file-name #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
(libc.m1 (cond ((eq? libc libc-mes.E)
(compile.mescc "mlibc/libc-mes.c" #:libc #f #:defines defines #:includes includes))
((eq? libc mini-libc-mes.E)
(compile.mescc "mlibc/mini-libc-mes.c" #:libc #f #:defines defines #:includes includes))
((eq? libc libc-mes+tcc.E)
(compile.mescc "mlibc/libc-mes+tcc.c" #:libc #f #:defines defines #:includes includes))
(else #f))))
(target (file-name target-file-name) (target (file-name target-file-name)
;;(inputs `(,@(if libc (list libc.m1) '()) ,m1-target))
(inputs `(,m1-target)) (inputs `(,m1-target))
(method (M1.asm #:m1 m1))))) (method (M1.as #:m1 m1)))))
(define* (bin.mescc input-file-name #:key (cc %MESCC) (hex2 %HEX2) (m1 %M1) (libc libc-mes.E) (dependencies '()) (defines '()) (includes '())) (define* (bin.gcc input-file-name #:key (libc #t) (crt1 (if (eq? libc #t) #f crt1.mlibc-o)) (cc (if (eq? libc #t) %CC %CC32)) (dependencies '()) (defines '()) (includes '()))
(let* ((base-name (base-name input-file-name ".c"))
;;(foo (format (current-error-port) "bin[~s .c] base=~s\n" input-file-name base-name))
(suffix (cond ((not libc) ".0-guile")
((eq? libc libc-mes.E) ".guile")
((eq? libc libc-mes+tcc.E) ".tcc-guile")
(else ".mini-guile")))
(target-file-name (string-append base-name suffix))
(hex2-target (m1-asm input-file-name #:m1 m1 #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies)))
(target (file-name target-file-name)
(inputs (list hex2-target))
(method (LINK.hex2 #:hex2 hex2 #:debug? (eq? libc libc-mes.E))))))
(define* (bin.gcc input-file-name #:key (libc #t) (cc (if libc %CC %CC32)) (dependencies '()) (defines '()) (includes '()))
(and cc (and cc
(let* ((base-name (base-name input-file-name ".c")) (let* ((base-name (base-name input-file-name ".c"))
(suffix (if libc ".gcc" ".mlibc-gcc")) (suffix (if (eq? libc #t) ".gcc" ".mlibc-gcc"))
(target-file-name (string-append base-name suffix)) (target-file-name (string-append base-name suffix))
(o-target (compile.gcc input-file-name #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies))) (o-target (compile.gcc input-file-name #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies)))
(target (file-name target-file-name) (target (file-name target-file-name)
(inputs (list o-target)) (inputs (list o-target))
(method (LINK.gcc #:cc cc #:libc libc)))))) (method (LINK.gcc #:cc cc #:libc libc #:crt1 crt1))))))
(define* (snarf input-file-name #:key (dependencies '()) (mes? #t)) (define* (snarf input-file-name #:key (dependencies '()) (mes? #t))
(let* ((base-name (base-name input-file-name ".c")) (let* ((base-name (base-name input-file-name ".c"))
@ -576,3 +533,7 @@
(define (get-target o) (define (get-target o)
(if (target? o) o (if (target? o) o
(find (lambda (t) (equal? (target-file-name t) o)) %targets))) (find (lambda (t) (equal? (target-file-name t) o)) %targets)))
(define crt1.mlibc-o (compile.gcc "mlibc/crt1.c" #:libc #f))
(define libc-gcc.mlibc-o (compile.gcc "mlibc/libc-gcc.c" #:libc #f))
(define libc-gcc+tcc.mlibc-o (compile.gcc "mlibc/libc-gcc+tcc.c" #:libc #f))

121
make.scm
View file

@ -38,13 +38,81 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(ice-9 match) (ice-9 match)
(guix make)) (guix make))
(define crt1.hex2 (m1.as "mlibc/crt1.c"))
(add-target crt1.hex2)
(add-target crt1.mlibc-o)
(define %HEX2-FLAGS
'("--LittleEndian"
"--Architecture=1"
"--BaseAddress=0x1000000"))
(define %HEX2 (PATH-search-path "hex2"))
(define* (LINK.hex2 #:key (hex2 %HEX2) (hex2-flags %HEX2-FLAGS) (crt1 crt1.hex2) (libc libc-mes.hex2) debug?)
(method (name "LINK.hex2")
(build (lambda (o t)
(let* ((input-files (map target-file-name (target-inputs t)))
;; FIXME: snarf inputs
(input-files (filter (lambda (f) (and (string-suffix? "hex2" f)
(not (member f (cdr input-files)))))
input-files)))
(format #t " ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
(with-output-to-file (target-file-name t)
(lambda _
(set-port-encoding! (current-output-port) "ISO-8859-1")
(display
(apply assert-gulp-pipe*
`(,hex2
,@hex2-flags
"-f"
,(if (not debug?) "stage0/elf32-0header.hex2"
"stage0/elf32-header.hex2")
,@(if crt1 `("-f" ,(target-file-name crt1)) '())
,@(if libc `("-f" ,(target-file-name libc)) '())
,@(append-map (cut list "-f" <>) input-files)
"-f"
,(if (not debug?) "stage0/elf-0footer.hex2"
"stage0/elf32-footer-single-main.hex2"))))))
(chmod (target-file-name t) #o755))))
(inputs `(,(store #:add-file "stage0/elf32-0header.hex2")
,@(if crt1 (target-inputs crt1) '())
,@(if libc (target-inputs libc) '())
,(store #:add-file "stage0/elf-0footer.hex2")))))
(define* (bin.mescc input-file-name #:key (cc %MESCC) (hex2 %HEX2) (m1 %M1) (crt1 crt1.hex2) (libc libc-mes.hex2) (dependencies '()) (defines '()) (includes '()))
(let* ((base-name (base-name input-file-name ".c"))
;;(foo (format (current-error-port) "bin[~s .c] base=~s\n" input-file-name base-name))
(suffix (cond ((not libc) ".0-guile")
((eq? libc libc-mes.hex2) ".guile")
((eq? libc libc-mes+tcc.hex2) ".tcc-guile")
(else ".mini-guile")))
(target-file-name (string-append base-name suffix))
(hex2-target (m1.as input-file-name #:m1 m1 #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
(target (file-name target-file-name)
(inputs `(,hex2-target
,@(if crt1 (list crt1) '())
,@(if libc (list libc) '())))
(method (LINK.hex2 #:hex2 hex2 #:crt1 crt1 #:libc libc #:debug? (eq? libc libc-mes.hex2))))))
;;(define mini-libc-mes.E (m1.as "mlibc/mini-libc-mes.c"))
(define libc-mes.hex2 (m1.as "mlibc/libc-mes.c"))
(add-target libc-mes.hex2)
(define mini-libc-mes.hex2 (m1.as "mlibc/mini-libc-mes.c"))
(add-target mini-libc-mes.hex2)
(define libc-mes+tcc.hex2 (m1.as "mlibc/libc-mes+tcc.c"))
(add-target libc-mes+tcc.hex2)
(add-target (bin.mescc "stage0/exit-42.c" #:libc #f)) (add-target (bin.mescc "stage0/exit-42.c" #:libc #f))
(add-target (check "stage0/exit-42.0-guile" #:signal 11)) ; FIXME: segfault (add-target (check "stage0/exit-42.0-guile" #:exit 42))
(add-target (cpp.mescc "mlibc/mini-libc-mes.c")) (add-target (cpp.mescc "mlibc/mini-libc-mes.c"))
(add-target (compile.mescc "mlibc/mini-libc-mes.c")) (add-target (compile.mescc "mlibc/mini-libc-mes.c"))
(add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.E)) (add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.hex2))
(add-target (check "stage0/exit-42.mini-guile" #:exit 42)) (add-target (check "stage0/exit-42.mini-guile" #:exit 42))
(add-target (cpp.mescc "mlibc/libc-mes.c")) (add-target (cpp.mescc "mlibc/libc-mes.c"))
@ -53,17 +121,21 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(add-target (bin.mescc "stage0/exit-42.c")) (add-target (bin.mescc "stage0/exit-42.c"))
(add-target (check "stage0/exit-42.guile" #:exit 42)) (add-target (check "stage0/exit-42.guile" #:exit 42))
(define* (add-scaffold-test name #:key (exit 0) (libc libc-mes.E)) (define* (add-scaffold-test name #:key (exit 0) (libc libc-mes.hex2) (libc-gcc libc-gcc.mlibc-o))
(add-target (bin.gcc (string-append "scaffold/tests/" name ".c") #:libc #f)) (add-target (bin.gcc (string-append "scaffold/tests/" name ".c") #:libc libc-gcc))
(add-target (check (string-append "scaffold/tests/" name ".mlibc-gcc") #:exit exit)) (add-target (check (string-append "scaffold/tests/" name ".mlibc-gcc") #:exit exit))
(add-target (bin.mescc (string-append "scaffold/tests/" name ".c") #:libc libc)) (add-target (bin.mescc (string-append "scaffold/tests/" name ".c") #:libc libc))
(add-target (check (string-append "scaffold/tests/" name "." (cond ((not libc) "0-") (add-target (check (string-append "scaffold/tests/" name "." (cond ((not libc) "0-")
((eq? libc mini-libc-mes.E) "mini-") ((eq? libc mini-libc-mes.hex2) "mini-")
(else "")) "guile") #:exit exit))) (else "")) "guile") #:exit exit)))
(add-scaffold-test "t" #:libc mini-libc-mes.E) (add-target (compile.gcc "mlibc/crt1.c" #:libc #f))
;;(add-scaffold-test "t" #:libc libc-mes+tcc.E) (add-target (compile.gcc "mlibc/libc-gcc.c" #:libc #f))
(add-target (compile.gcc "mlibc/libc-gcc+tcc.c" #:libc #f))
;;(add-scaffold-test "t" #:libc mini-libc-mes.hex2)
;;(add-scaffold-test "t" #:libc libc-mes+tcc.hex2)
;; tests/00: exit, functions without libc ;; tests/00: exit, functions without libc
(add-scaffold-test "00-exit-0" #:libc #f) (add-scaffold-test "00-exit-0" #:libc #f)
@ -101,7 +173,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
;; tests/30: call, compare: mini-libc-mes.c ;; tests/30: call, compare: mini-libc-mes.c
(for-each (for-each
(cut add-scaffold-test <> #:libc mini-libc-mes.E) (cut add-scaffold-test <> #:libc mini-libc-mes.hex2)
'("30-strlen" '("30-strlen"
"31-eputs" "31-eputs"
"32-compare" "32-compare"
@ -116,7 +188,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
;; tests/40: control: mini-libc-mes.c ;; tests/40: control: mini-libc-mes.c
(for-each (for-each
(cut add-scaffold-test <> #:libc mini-libc-mes.E) (cut add-scaffold-test <> #:libc mini-libc-mes.hex2)
'("40-if-else" '("40-if-else"
"41-?" "41-?"
"42-goto-label" "42-goto-label"
@ -181,7 +253,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(add-target (compile.mescc "mlibc/libc-mes+tcc.c")) (add-target (compile.mescc "mlibc/libc-mes+tcc.c"))
(define* (add-tcc-test name) (define* (add-tcc-test name)
(add-target (bin.gcc (string-append "scaffold/tinycc/" name ".c") #:libc #f #:includes '("scaffold/tinycc"))) (add-target (bin.gcc (string-append "scaffold/tinycc/" name ".c") #:libc libc-gcc.mlibc-o #:includes '("scaffold/tinycc")))
(add-target (check (string-append "scaffold/tinycc/" name ".mlibc-gcc") #:baseline (string-append "scaffold/tinycc/" name ".expect"))) (add-target (check (string-append "scaffold/tinycc/" name ".mlibc-gcc") #:baseline (string-append "scaffold/tinycc/" name ".expect")))
(add-target (bin.mescc (string-append "scaffold/tinycc/" name ".c") #:includes '("scaffold/tinycc"))) (add-target (bin.mescc (string-append "scaffold/tinycc/" name ".c") #:includes '("scaffold/tinycc")))
@ -259,7 +331,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
;; (add-target (bin.gcc "scaffold/main.c" #:libc #f)) ;; (add-target (bin.gcc "scaffold/main.c" #:libc #f))
;; (add-target (check "scaffold/main.mlibc-gcc" #:exit 42)) ;; (add-target (check "scaffold/main.mlibc-gcc" #:exit 42))
;; (add-target (bin.mescc "scaffold/main.c" #:libc mini-libc-mes.E)) ;; (add-target (bin.mescc "scaffold/main.c" #:libc mini-libc-mes.hex2))
;; (add-target (check "scaffold/main.mini-guile" #:exit 42)) ;; (add-target (check "scaffold/main.mini-guile" #:exit 42))
;; (add-target (bin.mescc "scaffold/main.c")) ;; (add-target (bin.mescc "scaffold/main.c"))
@ -269,10 +341,10 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(add-target (bin.gcc "scaffold/hello.c")) (add-target (bin.gcc "scaffold/hello.c"))
(add-target (check "scaffold/hello.gcc" #:exit 42)) (add-target (check "scaffold/hello.gcc" #:exit 42))
(add-target (bin.gcc "scaffold/hello.c" #:libc #f)) (add-target (bin.gcc "scaffold/hello.c" #:libc libc-gcc.mlibc-o))
(add-target (check "scaffold/hello.mlibc-gcc" #:exit 42)) (add-target (check "scaffold/hello.mlibc-gcc" #:exit 42))
(add-target (bin.mescc "scaffold/hello.c" #:libc mini-libc-mes.E)) (add-target (bin.mescc "scaffold/hello.c" #:libc mini-libc-mes.hex2))
(add-target (check "scaffold/hello.mini-guile" #:exit 42)) (add-target (check "scaffold/hello.mini-guile" #:exit 42))
(add-target (bin.mescc "scaffold/hello.c")) (add-target (bin.mescc "scaffold/hello.c"))
@ -282,13 +354,13 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
(add-target (bin.gcc "scaffold/m.c")) (add-target (bin.gcc "scaffold/m.c"))
(add-target (check "scaffold/m.gcc" #:exit 255)) (add-target (check "scaffold/m.gcc" #:exit 255))
(add-target (bin.gcc "scaffold/m.c" #:libc #f)) (add-target (bin.gcc "scaffold/m.c" #:libc libc-gcc.mlibc-o))
(add-target (check "scaffold/m.mlibc-gcc" #:exit 255)) (add-target (check "scaffold/m.mlibc-gcc" #:exit 255))
(add-target (bin.mescc "scaffold/m.c")) (add-target (bin.mescc "scaffold/m.c"))
(add-target (check "scaffold/m.guile" #:exit 255)) (add-target (check "scaffold/m.guile" #:exit 255))
(add-target (bin.gcc "scaffold/micro-mes.c" #:libc #f)) (add-target (bin.gcc "scaffold/micro-mes.c" #:libc libc-gcc.mlibc-o))
(add-target (check "scaffold/micro-mes.mlibc-gcc" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5 (add-target (check "scaffold/micro-mes.mlibc-gcc" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
(add-target (bin.mescc "scaffold/micro-mes.c")) (add-target (bin.mescc "scaffold/micro-mes.c"))
@ -334,7 +406,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
,(string-append "PREFIX=\"" %prefix "\"")) ,(string-append "PREFIX=\"" %prefix "\""))
#:includes '("src"))) #:includes '("src")))
(add-target (bin.gcc "src/mes.c" #:libc #f (add-target (bin.gcc "src/mes.c" #:libc libc-gcc.mlibc-o
#:dependencies mes-snarf-targets #:dependencies mes-snarf-targets
#:defines `("FIXED_PRIMITIVES=1" #:defines `("FIXED_PRIMITIVES=1"
"MES_FULL=1" "MES_FULL=1"
@ -510,12 +582,17 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
((install-guile-dir #:dir (string-append %godir)) f)) ((install-guile-dir #:dir (string-append %godir)) f))
%go-files) %go-files)
(add-target (install "mlibc/libc-mes.E" #:dir "lib")) (add-target (install "mlibc/crt1.hex2" #:dir "lib"))
(add-target (install "mlibc/libc-mes.M1" #:dir "lib")) (add-target (install "mlibc/libc-mes.M1" #:dir "lib"))
(add-target (install "mlibc/libc-mes+tcc.E" #:dir "lib")) (add-target (install "mlibc/libc-mes.hex2" #:dir "lib"))
(add-target (install "mlibc/libc-mes+tcc.M1" #:dir "lib")) (add-target (install "mlibc/libc-mes+tcc.M1" #:dir "lib"))
(add-target (install "mlibc/mini-libc-mes.E" #:dir "lib")) (add-target (install "mlibc/libc-mes+tcc.hex2" #:dir "lib"))
(add-target (install "mlibc/mini-libc-mes.M1" #:dir "lib")) (add-target (install "mlibc/mini-libc-mes.M1" #:dir "lib"))
(add-target (install "mlibc/mini-libc-mes.hex2" #:dir "lib"))
(add-target (install "mlibc/crt1.mlibc-o" #:dir "lib"))
(add-target (install "mlibc/libc-gcc.mlibc-o" #:dir "lib"))
(add-target (install "mlibc/libc-gcc+tcc.mlibc-o" #:dir "lib"))
(for-each (for-each
(lambda (f) (lambda (f)
@ -587,15 +664,17 @@ Targets:
(string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n " 'prefix))) (string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n " 'prefix)))
(else (else
(let ((targets (match args (let ((targets (match args
(() (filter (negate check-target?) %targets)) (() (filter (conjoin (negate install-target?)
(negate check-target?))
%targets))
((? (cut member "all" <>)) (filter (conjoin (negate install-target?) ((? (cut member "all" <>)) (filter (conjoin (negate install-target?)
(negate check-target?)) (negate check-target?))
%targets)) %targets))
((? (cut member "check" <>)) (filter check-target? %targets)) ((? (cut member "check" <>)) (filter check-target? %targets))
((? (cut member "install" <>)) (filter install-target? %targets)) ((? (cut member "install" <>)) (filter install-target? %targets))
(_ (filter-map (cut get-target <>) args))))) (_ (filter-map (cut get-target <>) args)))))
;;((@@ (guix make) store) #:print 0)
(for-each build targets) (for-each build targets)
;;((@@ (mes make) store) #:print 0)
(exit %status))))) (exit %status)))))
(main (cdr (command-line))) (main (cdr (command-line)))

92
mlibc/crt1.c Normal file
View file

@ -0,0 +1,92 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
*
* 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/>.
*/
char **g_environment = 0;
int main (int,char*[]);
#if __GNUC__ && !POSIX
void
_start ()
{
asm (
"mov %%ebp,%%eax\n\t"
"addl $4,%%eax\n\t"
"movzbl (%%eax),%%eax\n\t"
"addl $3,%%eax\n\t"
"shl $2,%%eax\n\t"
"add %%ebp,%%eax\n\t"
"movl %%eax,%0\n\t"
: "=g_environment" (g_environment)
: //no inputs ""
);
asm (
"mov %%ebp,%%eax\n\t"
"addl $8,%%eax\n\t"
"push %%eax\n\t"
"mov %%ebp,%%eax\n\t"
"addl $4,%%eax\n\t"
"movzbl (%%eax),%%eax\n\t"
"push %%eax\n\t"
"call main\n\t"
"mov %%eax,%%ebx\n\t"
"mov $1,%%eax\n\t"
"int $0x80\n\t"
"hlt \n\t"
:
);
}
#elif __MESC__
int
_start ()
{
asm ("mov____%ebp,%eax");
asm ("add____$i8,%eax !4");
asm ("movzbl_(%eax),%eax");
asm ("add____$i8,%eax !3");
asm ("shl____$i8,%eax !0x02");
asm ("add____%ebp,%eax");
asm ("mov____%eax,0x32 &g_environment");
asm ("mov____%ebp,%eax");
asm ("add____$i8,%eax !8");
asm ("push___%eax");
asm ("mov____%ebp,%eax");
asm ("add____$i8,%eax !4");
asm ("movzbl_(%eax),%eax");
asm ("push___%eax");
main ();
asm ("mov____%eax,%ebx");
asm ("mov____$i32,%eax %1");
asm ("int____$0x80");
asm ("hlt");
}
#endif

39
mlibc/libc-gcc.c
View file

@ -18,7 +18,6 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>. * along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
char **g_environment = 0;
int g_stdin = 0; int g_stdin = 0;
#include <stdio.h> #include <stdio.h>
@ -558,41 +557,3 @@ fdungetc (int c, int fd)
} }
#endif // POSIX #endif // POSIX
#if __GNUC__ && !POSIX
void
_start ()
{
// char **;
asm (
"mov %%ebp,%%eax\n\t"
"addl $4,%%eax\n\t"
"movzbl (%%eax),%%eax\n\t"
"addl $3,%%eax\n\t"
"shl $2,%%eax\n\t"
"add %%ebp,%%eax\n\t"
"movl %%eax,%0\n\t"
: "=g_environment" (g_environment)
: //no inputs ""
);
int r;
asm (
"mov %%ebp,%%eax\n\t"
"addl $8,%%eax\n\t"
"push %%eax\n\t"
"mov %%ebp,%%eax\n\t"
"addl $4,%%eax\n\t"
"movzbl (%%eax),%%eax\n\t"
"push %%eax\n\t"
"call main\n\t"
"movl %%eax,%0\n\t"
: "=r" (r)
: //no inputs ""
);
exit (r);
}
#endif // __GNUC__ && !POSIX

33
mlibc/libc-mes.c
View file

@ -21,39 +21,10 @@
#include <stdarg.h> #include <stdarg.h>
#include <stdlib.h> #include <stdlib.h>
char **g_environment = 0; // FIXME: todo extern
int g_stdin = 0; int g_stdin = 0;
char **g_environment;
int main (int,char*[]);
int void _env ();
_start ()
{
asm ("mov____%ebp,%eax");
asm ("add____$i8,%eax !4");
asm ("movzbl_(%eax),%eax");
asm ("add____$i8,%eax !3");
asm ("shl____$i8,%eax !0x02");
asm ("add____%ebp,%eax");
asm ("mov____%eax,0x32 &g_environment");
asm ("mov____%ebp,%eax");
asm ("add____$i8,%eax !8");
asm ("push___%eax");
asm ("mov____%ebp,%eax");
asm ("add____$i8,%eax !4");
asm ("movzbl_(%eax),%eax");
asm ("push___%eax");
main ();
asm ("mov____%eax,%ebx");
asm ("mov____$i32,%eax %1");
asm ("int____$0x80");
asm ("hlt");
}
void void
exit () exit ()

26
mlibc/mini-libc-mes.c
View file

@ -18,34 +18,24 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>. * along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
int exit ();
int main(int,char*[]);
int
_start ()
{
int r = main ();
exit (r);
}
void void
exit () exit ()
{ {
asm ("mov____0x8(%ebp),%ebx !8"); // mov 0x8(%ebp),%ebx asm ("mov____0x8(%ebp),%ebx !8");
asm ("mov____$i32,%eax SYS_exit"); // mov $0x1,%eax asm ("mov____$i32,%eax SYS_exit");
asm ("int____$0x80"); // int $0x80 asm ("int____$0x80");
} }
void void
write () write ()
{ {
asm ("mov____0x8(%ebp),%ebx !8"); // mov 0x8(%ebp),%ebx asm ("mov____0x8(%ebp),%ebx !8");
asm ("mov____0x8(%ebp),%ecx !12"); // mov 0x8(%ebp),%ecx asm ("mov____0x8(%ebp),%ecx !12");
asm ("mov____0x8(%ebp),%edx !16"); // mov 0x8(%ebp),%edx asm ("mov____0x8(%ebp),%edx !16");
asm ("mov____$i32,%eax SYS_write"); // mov $0x4,%eax asm ("mov____$i32,%eax SYS_write");
asm ("int____$0x80"); // int $0x80 asm ("int____$0x80");
} }
int int

4
module/mes/M1.mes
View file

@ -155,8 +155,8 @@
(format #t "\"~a\"" (list->string (list-head data (1- (length data)))))) (format #t "\"~a\"" (list->string (list-head data (1- (length data))))))
(else (format #t "~a" (string-join (map text->M1 data) " ")))) (else (format #t "~a" (string-join (map text->M1 data) " "))))
(newline))) (newline)))
(display "\n:HEX2_text")
(for-each write-function (filter cdr functions)) (for-each write-function (filter cdr functions))
(when (assoc-ref functions "main")
(display "\n\n:ELF_data\n") ;; FIXME (display "\n\n:ELF_data\n") ;; FIXME
(display "\n\n:HEX2_data\n") (display "\n\n:HEX2_data\n"))
(for-each write-global globals))) (for-each write-global globals)))

3
stage0/x86.M1
View file

@ -52,6 +52,7 @@ DEFINE cmp____%edx,%eax 39d0
DEFINE hlt f4 DEFINE hlt f4
DEFINE idiv___%ebx f7fb DEFINE idiv___%ebx f7fb
DEFINE int____$0x80 cd80 DEFINE int____$0x80 cd80
DEFINE int cd
DEFINE je32 0f84 DEFINE je32 0f84
DEFINE je8 74 DEFINE je8 74
DEFINE jg32 0f8f DEFINE jg32 0f8f
@ -185,8 +186,6 @@ DEFINE xor____%ecx,%ecx 31c9
DEFINE xor____%edx,%eax 31d0 DEFINE xor____%edx,%eax 31d0
DEFINE xor____%edx,%edx 31d2 DEFINE xor____%edx,%edx 31d2
DEFINE SYS_exit 01000000 DEFINE SYS_exit 01000000
DEFINE SYS_read 03000000 DEFINE SYS_read 03000000
DEFINE SYS_write 04000000 DEFINE SYS_write 04000000