mescc: Small ELF tweaks allowing debugging with gdb.
[mes.git] / module / mes / elf.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; 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 (cond-expand
28  (guile)
29  (mes
30   (mes-use-module (srfi srfi-1))
31   (mes-use-module (mes bytevectors))
32   (mes-use-module (mes elf-util))))
33
34 (define (int->bv32 value)
35   (let ((bv (make-bytevector 4)))
36     (bytevector-u32-native-set! bv 0 value)
37     bv))
38
39 (define (int->bv16 value)
40   (let ((bv (make-bytevector 2)))
41     (bytevector-u16-native-set! bv 0 value)
42     bv))
43
44 (define elf32-addr int->bv32)
45 (define elf32-half int->bv16)
46 (define elf32-off int->bv32)
47 (define elf32-word int->bv32)
48
49 (define (make-elf functions globals)
50   (define vaddress #x08048000)
51
52   (define ei-magic `(#x7f ,@(string->list "ELF")))
53   (define ei-class '(#x01)) ;; 32 bit
54   (define ei-data '(#x01))  ;; little endian
55   (define ei-version '(#x01))
56   (define ei-osabi '(#x00))
57   (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0))
58   (define e-ident
59     (append
60      ei-magic
61      ei-class
62      ei-data
63      ei-version
64      ei-osabi
65      ei-pad))
66
67   (define ET-EXEC 2)
68   (define EM-386 3)
69   (define EV-CURRENT 1)
70
71   (define p-filesz (elf32-word 0))
72   (define p-memsz (elf32-word 0))
73   (define PF-X 1)
74   (define PF-W 2)
75   (define PF-R 4)
76   (define p-flags (elf32-word (logior PF-X PF-W PF-R)))
77   (define p-align (elf32-word 1))
78
79   (define (program-header type offset text)
80     (append
81      (elf32-word type)
82      (elf32-off offset)
83      (elf32-addr (+ vaddress offset))
84      (elf32-addr (+ vaddress offset))
85      (elf32-word (length text))
86      (elf32-word (length text))
87      p-flags
88      p-align
89      ))
90
91   (define (section-header name type flags offset text sh-link sh-info sh-entsize)
92     (append
93      (elf32-word name)
94      (elf32-word type)
95      ;;;;(elf32-word 3) ;; write/alloc must for data hmm
96      (elf32-word flags)
97      (elf32-addr (+ vaddress offset))
98      (elf32-off offset) 
99      (elf32-word (length text))
100      (elf32-word sh-link)
101      (elf32-word sh-info)
102      (elf32-word 1)
103      (elf32-word sh-entsize)))
104
105
106   (define e-type (elf32-half ET-EXEC))
107   (define e-machine (elf32-half EM-386))
108   (define e-version (elf32-word EV-CURRENT))
109   (define e-entry (elf32-addr 0))
110   ;;(define e-entry (elf32-addr (+ vaddress text-offset)))
111   ;;(define e-phoff (elf32-off 0))
112   (define e-shoff (elf32-off 0))
113   (define e-flags (elf32-word 0))
114   ;;(define e-ehsize (elf32-half 0))
115   (define e-phentsize (elf32-half (length (program-header 0 0 '()))))
116   (define e-phnum (elf32-half 1))
117   (define e-shentsize (elf32-half (length (section-header 0 0 0 0 '() 0 0 0))))
118   (define e-shnum (elf32-half 7))       ; sections: 7
119   (define e-shstrndx (elf32-half 4))
120
121   (define (elf-header size entry sections)
122     (append
123      e-ident
124      e-type
125      e-machine
126      e-version
127      (elf32-addr (+ vaddress entry)) ;; e-entry
128      (elf32-off size)                ;; e-phoff
129      (elf32-off sections)            ;; e-shoff
130      e-flags
131      (elf32-half size) ;; e-ehsize
132      e-phentsize
133      e-phnum
134      e-shentsize
135      e-shnum
136      e-shstrndx
137      ))
138
139   (define elf-header-size
140     (length (elf-header 0 0 0)))
141
142   (define program-header-size
143     (length (program-header 0 0 '())))
144
145   (define text-offset
146     (+ elf-header-size program-header-size))
147
148   (define (program-headers text)
149     (append
150      (program-header 1 text-offset text)))
151
152   (define comment
153     (string->list
154      (string-append
155       "MES"
156       ;;"Mes -- Maxwell Equations of Software\n"
157       ;;"https://gitlab.com/janneke/mes"
158       )
159      ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00
160      ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00
161      ))
162
163   (define shstr
164     `(
165       #x00                              ; 0
166       ,@(string->list ".text") #x00     ; 1
167       ,@(string->list ".data") #x00     ; 7
168       ,@(string->list ".comment") #x00     ; 13
169       ,@(string->list ".shstrtab") #x00 ; 22
170       ,@(string->list ".symtab") #x00  ; 32
171       ,@(string->list ".strtab") #x00   ; 40
172       ))
173
174   (define (str functions)
175     (cons
176      0
177      (append-map
178       (lambda (s) (append (string->list s) (list 0)))
179       (map car functions))))
180
181   (define text-length
182     (length (functions->text functions globals 0 0)))
183
184   (define data-offset
185     (+ text-offset text-length))
186
187   (define stt-func 2)
188   (define stt-global-func 18)
189   (define (symbol-table-entry st-name st-offset st-length st-info st-other st-shndx)
190     (append
191      (elf32-word st-name)
192      (elf32-addr st-offset)
193      (elf32-word st-length)
194      (list st-info)
195      (list st-other)
196      (elf32-half st-shndx)))
197
198   (define (sym functions globals)
199     (define (symbol->table-entry o)
200       (let* ((name (car o))
201              (offset (function-offset name functions))
202              (len (length (text->list (cddr o))))
203             (str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car functions))))))
204             (i (1+ (length str))))
205         (symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
206     (append
207      (symbol-table-entry 0 0 0 0 0 0)
208      (append-map symbol->table-entry functions)))
209
210   (define data-address (+ data-offset vaddress))
211   (define text-address (+ text-offset vaddress))
212
213   (define data-length
214     (length (globals->data globals)))
215
216   (define comment-length
217     (length comment))
218
219   (define comment-offset
220     (+ data-offset data-length))
221
222   (define shstr-offset
223     (+ comment-offset comment-length))
224
225   (define shstr-length
226     (length shstr))
227
228   (define sym-offset
229     (+ shstr-offset shstr-length))
230
231   (define SHT-PROGBITS 1)
232   (define SHT-SYMTAB 2)
233   (define SHT-STRTAB 3)
234   (define SHT-NOTE 7)
235
236   (define SHF-WRITE 1)
237   (define SHF-ALLOC 2)
238   (define SHF-EXEC 4)
239   (define SHF-STRINGS #x20)
240
241   (let* ((text (functions->text functions globals 0 data-address))
242          (data (globals->data globals))
243          (entry (+ text-offset (function-offset "_start" functions)))
244          (sym (sym functions globals))
245          (str (str functions)))
246
247     (define (section-headers)
248     (append
249      (section-header 0 0 0 0 '() 0 0 0)
250      (section-header 1 SHT-PROGBITS (logior SHF-ALLOC SHF-EXEC) text-offset text 0 0 0)
251      (section-header 7 SHT-PROGBITS (logior SHF-ALLOC SHF-WRITE) data-offset data 0 0 0)
252      (section-header 13 SHT-PROGBITS 0 comment-offset comment 0 0 0)
253      (section-header 22 SHT-STRTAB 0 shstr-offset shstr 0 0 0)
254      (section-header 32 SHT-SYMTAB 0 sym-offset sym 6 0 (length (symbol-table-entry 0 0 0 0 9 0)))
255      (section-header 40 SHT-STRTAB 0 str-offset str 0 0 0)))
256
257
258     (define sym-length
259       (length sym))
260     
261     (define str-offset
262       (+ sym-offset sym-length))
263     
264     (define str-length
265       (length str))
266
267     (define section-headers-offset
268       (+ str-offset str-length))
269
270     (format (current-error-port) "ELF text=~a\n" text)
271     ;;(format (current-error-port) "ELF data=~a\n" data)
272     (format (current-error-port) "text-offset=~a\n" text-offset)
273     (format (current-error-port) "data-offset=~a\n" data-offset)
274     (format (current-error-port) "_start=~a\n" (number->string entry 16))
275     (append
276      (elf-header elf-header-size entry section-headers-offset)
277      (program-headers text)
278      text
279      data
280      comment
281      shstr
282      sym
283      str
284      (section-headers))))