2016-08-14 00:44:42 +01:00
|
|
|
;;; -*-scheme-*-
|
|
|
|
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
2017-01-03 11:43:00 +00:00
|
|
|
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
|
2016-08-14 00:44:42 +01:00
|
|
|
;;;
|
2016-12-07 19:26:41 +00:00
|
|
|
;;; This file is part of Mes.
|
2016-08-14 00:44:42 +01:00
|
|
|
;;;
|
|
|
|
;;; 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/>.
|
|
|
|
|
2016-10-12 22:40:11 +01:00
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;;; elf.mes - produce a i386 elf executable.
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
2016-12-31 08:03:07 +00:00
|
|
|
(cond-expand
|
|
|
|
(guile)
|
|
|
|
(mes
|
2017-04-02 10:55:37 +01:00
|
|
|
(mes-use-module (srfi srfi-1))
|
|
|
|
(mes-use-module (mes bytevectors))
|
|
|
|
(mes-use-module (mes elf-util))))
|
2016-12-07 19:26:41 +00:00
|
|
|
|
2016-08-14 00:44:42 +01:00
|
|
|
(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)
|
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(define (make-elf functions globals init)
|
2017-04-02 10:55:37 +01:00
|
|
|
(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 flags offset text sh-link sh-info sh-entsize)
|
|
|
|
(append
|
|
|
|
(elf32-word name)
|
|
|
|
(elf32-word type)
|
|
|
|
;;;;(elf32-word 3) ;; write/alloc must for data hmm
|
|
|
|
(elf32-word flags)
|
|
|
|
(elf32-addr (+ vaddress offset))
|
|
|
|
(elf32-off offset)
|
|
|
|
(elf32-word (length text))
|
|
|
|
(elf32-word sh-link)
|
|
|
|
(elf32-word sh-info)
|
|
|
|
(elf32-word 1)
|
|
|
|
(elf32-word sh-entsize)))
|
|
|
|
|
|
|
|
|
|
|
|
(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 '()))))
|
2017-01-17 17:48:54 +00:00
|
|
|
(define e-phnum (elf32-half 2)) ; text+data
|
2017-04-02 10:55:37 +01:00
|
|
|
(define e-shentsize (elf32-half (length (section-header 0 0 0 0 '() 0 0 0))))
|
|
|
|
(define e-shnum (elf32-half 7)) ; sections: 7
|
|
|
|
(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
|
2017-01-17 17:48:54 +00:00
|
|
|
(* 2 (length (program-header 0 0 '()))))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
|
|
|
(define text-offset
|
|
|
|
(+ elf-header-size program-header-size))
|
|
|
|
|
2017-01-17 17:48:54 +00:00
|
|
|
(define PT-LOAD 1)
|
|
|
|
(define (program-headers text data)
|
2017-04-02 10:55:37 +01:00
|
|
|
(append
|
2017-01-17 17:48:54 +00:00
|
|
|
(program-header PT-LOAD text-offset text)
|
|
|
|
(program-header PT-LOAD data-offset data)))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
2017-01-09 19:06:32 +00:00
|
|
|
(define comment
|
2017-04-02 10:55:37 +01:00
|
|
|
(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 shstr
|
|
|
|
`(
|
|
|
|
#x00 ; 0
|
|
|
|
,@(string->list ".text") #x00 ; 1
|
|
|
|
,@(string->list ".data") #x00 ; 7
|
2017-01-09 19:06:32 +00:00
|
|
|
,@(string->list ".comment") #x00 ; 13
|
|
|
|
,@(string->list ".shstrtab") #x00 ; 22
|
|
|
|
,@(string->list ".symtab") #x00 ; 32
|
|
|
|
,@(string->list ".strtab") #x00 ; 40
|
2017-04-02 10:55:37 +01:00
|
|
|
))
|
|
|
|
|
2017-01-04 23:55:46 +00:00
|
|
|
(define (str functions)
|
2017-04-02 10:55:37 +01:00
|
|
|
(cons
|
|
|
|
0
|
|
|
|
(append-map
|
|
|
|
(lambda (s) (append (string->list s) (list 0)))
|
2017-01-04 23:55:46 +00:00
|
|
|
(map car functions))))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
|
|
|
(define text-length
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(length (functions->text functions globals 0 0 0)))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
|
|
|
(define data-offset
|
|
|
|
(+ text-offset text-length))
|
|
|
|
|
|
|
|
(define stt-func 2)
|
|
|
|
(define stt-global-func 18)
|
|
|
|
(define (symbol-table-entry st-name st-offset st-length st-info st-other st-shndx)
|
|
|
|
(append
|
|
|
|
(elf32-word st-name)
|
|
|
|
(elf32-addr st-offset)
|
|
|
|
(elf32-word st-length)
|
|
|
|
(list st-info)
|
|
|
|
(list st-other)
|
|
|
|
(elf32-half st-shndx)))
|
|
|
|
|
2017-01-04 23:55:46 +00:00
|
|
|
(define (sym functions globals)
|
2017-04-02 10:55:37 +01:00
|
|
|
(define (symbol->table-entry o)
|
|
|
|
(let* ((name (car o))
|
2017-01-04 23:55:46 +00:00
|
|
|
(offset (function-offset name functions))
|
mescc: Beginning of expression and test template.
* scaffold/t.c: New file.
* GNUmakefile (mescc-check, t-check): New targets.
* module/language/c99/compiler.mes (write-any): Catch weirdness.
(make): Add <function> slot.
(.function): New accessor.
(clone): Handle it.
(function->info): Set it.
(ast->info): Make tests generic in if, for, while. Add goto, label,
!, ==, !=, -, &&.
* module/mes/elf-util.mes (lambda/label->list): New function.
(text->list): Use it.
(functions->text, function-prefix): New function.
(function-offset): Use it.
(label-offset): New function.
* module/mes/elf-util.scm (mes): Export them.
* module/mes/elf.mes (make-elf): Use text->list.
* module/mes/libc-i386.mes (eputs, puts): Remove.
(i386:byte-base-sub): Rename from sub-byte-base.
(i386:byte-jump-z): Rename from i386:Xjump-byte-z.
(i386:byte-mem->accu): Rename from i386:Xmem-byte->accu.
(i386:byte-mem->base): Rename from i386:Xmem-byte->base.
(i386:accu->local, i386:accu-non-zero?, i386:accu-zero?,
i386:base-sub, i386:byte-sub-base, i386:jump-c, i386:jump-cz,
i386:jump-nc, i386:jump-ncz, i386:byte-mem->base, i386:sub-base,
i386:test-accu, i386:test-base, i386:test-jump-z, i386:value->base,
i386:xor-zf): New functions.
2017-04-02 11:23:00 +01:00
|
|
|
(len (length (text->list (cddr o))))
|
2017-03-06 06:14:15 +00:00
|
|
|
(str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car functions))))))
|
|
|
|
(i (1+ (length str))))
|
2017-04-02 10:55:37 +01:00
|
|
|
(symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
|
|
|
|
(append
|
|
|
|
(symbol-table-entry 0 0 0 0 0 0)
|
2017-01-04 23:55:46 +00:00
|
|
|
(append-map symbol->table-entry functions)))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
|
|
|
(define data-address (+ data-offset vaddress))
|
|
|
|
(define text-address (+ text-offset vaddress))
|
|
|
|
|
|
|
|
(define data-length
|
2017-01-03 17:34:49 +00:00
|
|
|
(length (globals->data globals)))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
2017-01-09 19:06:32 +00:00
|
|
|
(define comment-length
|
|
|
|
(length comment))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
2017-01-09 19:06:32 +00:00
|
|
|
(define comment-offset
|
2017-04-02 10:55:37 +01:00
|
|
|
(+ data-offset data-length))
|
|
|
|
|
|
|
|
(define shstr-offset
|
2017-01-09 19:06:32 +00:00
|
|
|
(+ comment-offset comment-length))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
|
|
|
(define shstr-length
|
|
|
|
(length shstr))
|
|
|
|
|
|
|
|
(define sym-offset
|
|
|
|
(+ shstr-offset shstr-length))
|
|
|
|
|
|
|
|
(define SHT-PROGBITS 1)
|
|
|
|
(define SHT-SYMTAB 2)
|
|
|
|
(define SHT-STRTAB 3)
|
|
|
|
(define SHT-NOTE 7)
|
|
|
|
|
|
|
|
(define SHF-WRITE 1)
|
2017-01-03 11:43:00 +00:00
|
|
|
(define SHF-ALLOC 2)
|
2017-04-02 10:55:37 +01:00
|
|
|
(define SHF-EXEC 4)
|
|
|
|
(define SHF-STRINGS #x20)
|
|
|
|
|
mescc: Run mini-mes.
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
(test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
(lambda/label->list): Add text-address parameter. Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
(.init): New function.
(ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
i386:byte-accu->base-ref, i386:accu->base-ref+n,
i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
i386:global-add, i386:global->accu):, i386:local-ref->accu,
i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.
2017-01-29 14:22:39 +00:00
|
|
|
(let* ((text (functions->text functions globals text-address 0 data-address))
|
|
|
|
(raw-data (globals->data globals))
|
|
|
|
(data (let loop ((data raw-data) (init init))
|
|
|
|
(if (null? init) data
|
|
|
|
(loop ((car init) functions globals text-address 0 data-address data) (cdr init)))))
|
2017-01-04 23:55:46 +00:00
|
|
|
(entry (+ text-offset (function-offset "_start" functions)))
|
|
|
|
(sym (sym functions globals))
|
2017-04-02 10:55:37 +01:00
|
|
|
(str (str functions)))
|
|
|
|
|
|
|
|
(define (section-headers)
|
|
|
|
(append
|
|
|
|
(section-header 0 0 0 0 '() 0 0 0)
|
2017-01-09 19:06:32 +00:00
|
|
|
(section-header 1 SHT-PROGBITS (logior SHF-ALLOC SHF-EXEC) text-offset text 0 0 0)
|
|
|
|
(section-header 7 SHT-PROGBITS (logior SHF-ALLOC SHF-WRITE) data-offset data 0 0 0)
|
|
|
|
(section-header 13 SHT-PROGBITS 0 comment-offset comment 0 0 0)
|
|
|
|
(section-header 22 SHT-STRTAB 0 shstr-offset shstr 0 0 0)
|
|
|
|
(section-header 32 SHT-SYMTAB 0 sym-offset sym 6 0 (length (symbol-table-entry 0 0 0 0 9 0)))
|
|
|
|
(section-header 40 SHT-STRTAB 0 str-offset str 0 0 0)))
|
2017-04-02 10:55:37 +01:00
|
|
|
|
|
|
|
|
|
|
|
(define sym-length
|
|
|
|
(length sym))
|
|
|
|
|
|
|
|
(define str-offset
|
|
|
|
(+ sym-offset sym-length))
|
|
|
|
|
|
|
|
(define str-length
|
|
|
|
(length str))
|
|
|
|
|
|
|
|
(define section-headers-offset
|
|
|
|
(+ str-offset str-length))
|
|
|
|
|
2017-03-12 11:02:12 +00:00
|
|
|
(if (< (length text) 2000)
|
|
|
|
(format (current-error-port) "ELF text=~a\n" (map dec->hex text)))
|
2017-03-07 21:33:59 +00:00
|
|
|
(if (< (length raw-data) 200)
|
|
|
|
(format (current-error-port) "ELF raw-data=~a\n" (map dec->hex raw-data)))
|
|
|
|
(if (< (length data) 200)
|
|
|
|
(format (current-error-port) "ELF data=~a\n" (map dec->hex data)))
|
2017-04-02 10:55:37 +01:00
|
|
|
(format (current-error-port) "text-offset=~a\n" text-offset)
|
|
|
|
(format (current-error-port) "data-offset=~a\n" data-offset)
|
|
|
|
(format (current-error-port) "_start=~a\n" (number->string entry 16))
|
|
|
|
(append
|
|
|
|
(elf-header elf-header-size entry section-headers-offset)
|
2017-01-17 17:48:54 +00:00
|
|
|
(program-headers text data)
|
2017-04-02 10:55:37 +01:00
|
|
|
text
|
|
|
|
data
|
2017-01-09 19:06:32 +00:00
|
|
|
comment
|
2017-04-02 10:55:37 +01:00
|
|
|
shstr
|
|
|
|
sym
|
|
|
|
str
|
|
|
|
(section-headers))))
|