294 lines
8.3 KiB
Scheme
294 lines
8.3 KiB
Scheme
;;; -*-scheme-*-
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
|
;;; Copyright © 2016,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/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; elf.mes - produce a i386 elf executable.
|
|
|
|
;;; Code:
|
|
|
|
(cond-expand
|
|
(guile)
|
|
(mes
|
|
(mes-use-module (srfi srfi-1))
|
|
(mes-use-module (mes bytevectors))
|
|
(mes-use-module (mes elf-util))))
|
|
|
|
(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 functions globals init)
|
|
(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 '()))))
|
|
(define e-phnum (elf32-half 2)) ; text+data
|
|
(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
|
|
(* 2 (length (program-header 0 0 '()))))
|
|
|
|
(define text-offset
|
|
(+ elf-header-size program-header-size))
|
|
|
|
(define PT-LOAD 1)
|
|
(define (program-headers text data)
|
|
(append
|
|
(program-header PT-LOAD text-offset text)
|
|
(program-header PT-LOAD data-offset data)))
|
|
|
|
(define comment
|
|
(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
|
|
,@(string->list ".comment") #x00 ; 13
|
|
,@(string->list ".shstrtab") #x00 ; 22
|
|
,@(string->list ".symtab") #x00 ; 32
|
|
,@(string->list ".strtab") #x00 ; 40
|
|
))
|
|
|
|
(define (str functions)
|
|
(cons
|
|
0
|
|
(append-map
|
|
(lambda (s) (append (string->list s) (list 0)))
|
|
(map car functions))))
|
|
|
|
(define text-length
|
|
(length (functions->text functions globals 0 0 0)))
|
|
|
|
(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)))
|
|
|
|
(define (sym functions globals)
|
|
(define (symbol->table-entry o)
|
|
(let* ((name (car o))
|
|
(offset (function-offset name functions))
|
|
(len (length (text->list (cddr o))))
|
|
(str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car functions))))))
|
|
(i (1+ (length str))))
|
|
(symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
|
|
(append
|
|
(symbol-table-entry 0 0 0 0 0 0)
|
|
(append-map symbol->table-entry functions)))
|
|
|
|
(define data-address (+ data-offset vaddress))
|
|
(define text-address (+ text-offset vaddress))
|
|
|
|
(define data-length
|
|
(length (globals->data globals)))
|
|
|
|
(define comment-length
|
|
(length comment))
|
|
|
|
(define comment-offset
|
|
(+ data-offset data-length))
|
|
|
|
(define shstr-offset
|
|
(+ comment-offset comment-length))
|
|
|
|
(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)
|
|
(define SHF-ALLOC 2)
|
|
(define SHF-EXEC 4)
|
|
(define SHF-STRINGS #x20)
|
|
|
|
(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)))))
|
|
(entry (+ text-offset (function-offset "_start" functions)))
|
|
(sym (sym functions globals))
|
|
(str (str functions)))
|
|
|
|
(define (section-headers)
|
|
(append
|
|
(section-header 0 0 0 0 '() 0 0 0)
|
|
(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)))
|
|
|
|
|
|
(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))
|
|
|
|
(if (< (length text) 2000)
|
|
(format (current-error-port) "ELF text=~a\n" (map dec->hex text)))
|
|
(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)))
|
|
(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)
|
|
(program-headers text data)
|
|
text
|
|
data
|
|
comment
|
|
shstr
|
|
sym
|
|
str
|
|
(section-headers))))
|