ba0dd5f6f9aa35659ace4dd1522683f2a98140b0
[mes.git] / module / mes / elf.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; elf.mes: This file is part of Mes.
7 ;;;
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; elf.mes - produce a i386 elf executable.
24
25 ;;; Code:
26
27 (define (int->bv32 value)
28   (let ((bv (make-bytevector 4)))
29     (bytevector-u32-native-set! bv 0 value)
30     bv))
31
32 (define (int->bv16 value)
33   (let ((bv (make-bytevector 2)))
34     (bytevector-u16-native-set! bv 0 value)
35     bv))
36
37 (define elf32-addr int->bv32)
38 (define elf32-half int->bv16)
39 (define elf32-off int->bv32)
40 (define elf32-word int->bv32)
41
42 (define (make-elf text data)
43  (define vaddress #x08048000)
44
45  (define ei-magic `(#x7f ,@(string->list "ELF")))
46  (define ei-class '(#x01)) ;; 32 bit
47  (define ei-data '(#x01)) ;; little endian
48  (define ei-version '(#x01))
49  (define ei-osabi '(#x00))
50  (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0))
51  (define e-ident
52    (append
53     ei-magic
54     ei-class
55     ei-data
56     ei-version
57     ei-osabi
58     ei-pad))
59
60  (define ET-EXEC 2)
61  (define EM-386 3)
62  (define EV-CURRENT 1)
63
64  (define p-filesz (elf32-word 0))
65  (define p-memsz (elf32-word 0))
66  (define PF-X 1)
67  (define PF-W 2)
68  (define PF-R 4)
69  (define p-flags (elf32-word (logior PF-X PF-W PF-R)))
70  (define p-align (elf32-word 1))
71
72  (define (program-header type offset text)
73    (append
74     (elf32-word type)
75     (elf32-off offset)
76     (elf32-addr (+ vaddress offset))
77     (elf32-addr (+ vaddress offset))
78     (elf32-word (length text))
79     (elf32-word (length text))
80     p-flags
81     p-align
82     ))
83
84  (define (section-header name type offset text)
85    (append
86     (elf32-word name)
87     (elf32-word type)
88     (elf32-word 3) ;; write/alloc must for data hmm
89     (elf32-addr (+ vaddress offset))
90     (elf32-off offset) 
91     (elf32-word (length text))
92     (elf32-word 0)
93     (elf32-word 0)
94     (elf32-word 1)
95     (elf32-word 0)))
96
97
98  (define e-type (elf32-half ET-EXEC))
99  (define e-machine (elf32-half EM-386))
100  (define e-version (elf32-word EV-CURRENT))
101  (define e-entry (elf32-addr 0))
102  ;;(define e-entry (elf32-addr (+ vaddress text-offset)))
103  ;;(define e-phoff (elf32-off 0))
104  (define e-shoff (elf32-off 0))
105  (define e-flags (elf32-word 0))
106  ;;(define e-ehsize (elf32-half 0))
107  (define e-phentsize (elf32-half (length (program-header 0 0 '()))))
108  (define e-phnum (elf32-half 1))
109  (define e-shentsize (elf32-half (length (section-header 0 0 0 '()))))
110  (define e-shnum (elf32-half 5))
111  (define e-shstrndx (elf32-half 4))
112
113  (define (elf-header size entry sections)
114    (append
115     e-ident
116     e-type
117     e-machine
118     e-version
119     (elf32-addr (+ vaddress entry)) ;; e-entry
120     (elf32-off size) ;; e-phoff
121     (elf32-off sections) ;; e-shoff
122     e-flags
123     (elf32-half size) ;; e-ehsize
124     e-phentsize
125     e-phnum
126     e-shentsize
127     e-shnum
128     e-shstrndx
129     ))
130
131  (define elf-header-size
132    (length (elf-header 0 0 0)))
133
134  (define program-header-size
135    (length (program-header 0 0 '())))
136
137  (define text-offset
138    (+ elf-header-size program-header-size))
139
140  (define (program-headers)
141    (append
142     (program-header 1 text-offset (text 0))
143     ))
144
145
146  (define note
147    (string->list
148     (string-append
149      "MES"
150      ;;"Mes -- Maxwell Equations of Software\n"
151      ;;"https://gitlab.com/janneke/mes"
152      )
153     ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00
154     ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00
155     ))
156
157  (define tab
158    `(
159      #x00 ,@(string->list ".shstrtab")
160           #x00 ,@(string->list ".text")
161           #x00 ,@(string->list ".data")
162           #x00 ,@(string->list ".note")
163           #x00 #x00 #x00 #x00
164           ))
165
166  (define text-length
167    (length (text 0)))
168
169  (define data-offset
170    (+ text-offset text-length))
171
172  (define data-address (+ data-offset vaddress))
173
174  (define data-length
175    (length data))
176
177  (define note-length
178    (length note))
179
180  (define note-offset
181    (+ data-offset data-length))
182
183  (define tab-offset
184    (+ note-offset note-length))
185
186  (define tab-length
187    (length tab))
188
189  (define section-headers-offset
190    (+ tab-offset tab-length))
191
192
193  (define SHT-PROGBITS 1)
194  (define SHT-STRTAB 3)
195  (define SHT-NOTE 7)
196  (define (section-headers)
197    (append
198     (section-header 0 0 0 '())
199     (section-header 11 SHT-PROGBITS text-offset (text 0))
200     (section-header 17 SHT-PROGBITS data-offset data)
201     (section-header 23 SHT-NOTE note-offset note)
202     (section-header 1 SHT-STRTAB tab-offset tab)
203     ))
204
205  (define exe
206    (append
207     (elf-header elf-header-size text-offset section-headers-offset)
208     (program-headers)
209     (text data-address)
210     data
211     note
212     tab
213     (section-headers)
214     ))
215  exe)