Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / mach-o.c
1 /*
2  *
3  * This code was written by Raymond Toy as part of CMU Common Lisp and
4  * has been placed in the public domain.
5  *
6  * Mach-O support for generating executable images on Mac OS X (aka
7  * Darwin).  This only knows enough of the Mach-O format to be able to
8  * write out very simple object files for the Lisp spaces and to read
9  * just enough of a Mach-O executable to find the segments containing
10  * the Lisp spaces.
11  *
12  * For details of the file format see " Mac OS X ABI Mach-O File
13  * Format Reference",
14  * http://developer.apple.com/mac/library/documentation/DeveloperTools/Conceptual/MachORuntime/Reference/reference.html
15  *
16  * 
17  */
18
19 #include <stdio.h>
20 #include <stdlib.h>
21 #include <string.h>
22 #include <fcntl.h>
23 #include <sys/stat.h>
24 #include <sys/types.h>
25 #include <unistd.h>
26
27 #include "os.h"
28 #include "core.h"
29 #include "internals.h"
30 #include "globals.h"
31 #include "validate.h"
32
33 #include "elf.h"
34
35 typedef struct mach_header MachO_hdr;
36
37 /* Uncomment to enable debugging prints */
38 /* #define DEBUG_MACH_O */
39
40 /*
41  * Names of the Lisp image sections. These names must be the same as
42  * the corresponding names found in the linker script.
43  */
44
45 static char *section_names[] = {"CORDYN", "CORSTA", "CORRO"};
46
47 /*
48  * Starting addresses of the various spaces.  Must be in the same
49  * order as section_names
50  */
51 static os_vm_address_t section_addr[] =
52 {
53     (os_vm_address_t) DYNAMIC_0_SPACE_START,
54     (os_vm_address_t) STATIC_SPACE_START,
55     (os_vm_address_t) READ_ONLY_SPACE_START
56 };
57
58 /* Note: write errors are not fatal. */
59 static int
60 ewrite(int fd, const void *buf, size_t nbytes, const char *func)
61 {
62     if (write(fd, buf, nbytes) < nbytes) {
63         perror(func);
64         return -1;      /* Simple way to indicate error. */
65     }
66     return 0;
67 }
68
69 /*
70   Read errors are fatal, because these reads have to succeed for lisp to
71   get off the ground.
72  */
73 static void
74 eread(int d, void *buf, size_t nbytes, const char *func)
75 {
76     int res = read(d, buf, nbytes);
77
78     if (res == -1) {
79         perror(func);
80         exit(-1);
81     }
82
83     if (res < nbytes) {
84         fprintf(stderr, "Short read in %s!\n", func);
85         exit(-1);
86     }
87 }
88
89 static void
90 elseek(int d, off_t o, int whence, const char *func)
91 {
92     if (lseek(d, o, whence) == -1) {
93         perror(func);
94         exit(-1);
95     }
96 }
97
98 /*
99  * Create a file for the specified Lisp space in the specified
100  * directory.
101  */
102 static int
103 create_mach_o_file (const char *dir, int id)
104 {
105     char outfilename[FILENAME_MAX + 1];
106     int out;
107
108     /* Note: the space id will be either 1, 2 or 3.  Subtract one to index
109        the name array. */
110     snprintf(outfilename, FILENAME_MAX, "%s/%s.o", dir, section_names[id - 1]);
111     out = open(outfilename, O_WRONLY | O_CREAT | O_TRUNC, 0666);
112
113     if(!out) {
114         perror("create_mach_o_file: can't open file");
115         fprintf(stderr, "%s\n", outfilename);
116     }
117
118     return out;
119 }
120
121 /*
122  * Write the Mach-O header.  We only handle what we need for our
123  * purposes.
124  */
125 static int
126 write_mach_o_header(int fd)
127 {
128     MachO_hdr eh;
129
130     /* Ident array. */
131     eh.magic = MH_MAGIC;
132 #if defined(__ppc__)
133     eh.cputype = CPU_TYPE_POWERPC;
134     eh.cpusubtype = CPU_SUBTYPE_POWERPC_ALL;
135 #else
136     eh.cputype = CPU_TYPE_I386;
137     /*
138      * Support any kind x86.  Should we be more specific?  We need at
139      * least a pentium to run x87.  For SSE2 we need at least a
140      * Pentium 4 chip.  So if the core is SSE2, should we set this to
141      * Pentium 4?
142      */
143     eh.cpusubtype = CPU_SUBTYPE_I386_ALL;
144 #endif
145
146     eh.filetype = MH_OBJECT;
147
148     /* We only have 1 load command in our object */
149     eh.ncmds = 1;
150     /* Size of 1 segment command plus size of 1 section */
151     eh.sizeofcmds = sizeof(struct segment_command) + sizeof(struct section);
152     eh.flags = MH_NOUNDEFS | MH_NOMULTIDEFS;
153
154     return ewrite(fd, &eh, sizeof(MachO_hdr), __func__);
155 }
156
157 /*
158  * Write one segment (load) command to the object file in fd.  The
159  * name of the segment is in name.  We also need to specify the
160  * starting VM address (start) and the VM size (length) of the section
161  * of memory that we want this to map to.
162  */
163 static int
164 write_load_command(int fd, char* name, int length, os_vm_address_t start)
165 {
166     struct segment_command lc;
167
168     lc.cmd = LC_SEGMENT;
169     /* Size is 1 segment command + 1 section command */
170     lc.cmdsize = sizeof(lc) + sizeof(struct section);
171     /*
172      * Set the segment name.  This is very important because
173      * map_core_sections looks for segment command whose segment name
174      * matches a Lisp section name.
175      */
176     strncpy(lc.segname, name, sizeof(lc.segname));
177     lc.vmaddr = (uint32_t) start;
178     /*
179      * The size is very important.  map_core_sections uses this to
180      * determine how much to map.
181      */
182     lc.vmsize = length;
183     /*
184      * Offset where the data is.  It's the header, the segment
185      * command, and one section.
186      */
187     lc.fileoff = lc.cmdsize + sizeof(struct mach_header);
188     lc.filesize = length;
189     lc.maxprot = VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE;
190     lc.initprot = lc.maxprot;
191     /* There's only one section for this segment command. */
192     lc.nsects = 1;
193     lc.flags = 0;
194
195     return ewrite(fd, &lc, sizeof(lc), __func__);
196 }
197
198 /*
199  * Write the section info to the object file, fd.  Again, we need the
200  * object name (object_name) which is used as both the section name
201  * and the segment name.  The starting VM address (start) and the VM
202  * length (length) is needed for the section.
203  */
204 static int
205 write_section(int fd, int length, os_vm_address_t start, char* object_name)
206 {
207     struct section sc;
208
209     /*
210      * sectname and segname are the same for our purposes.  However,
211      * map_core_sections never looks here; it looks for the segment
212      * name from the segment commands.
213      */
214     strncpy(sc.sectname, object_name, sizeof(sc.sectname));
215     strncpy(sc.segname, object_name, sizeof(sc.segname));
216     sc.addr = (uint32_t) start;
217     sc.size = length;
218     /*
219      * Offset of the data.  We have one header, one segment and one
220      * section
221      */
222     sc.offset = sizeof(struct mach_header) + sizeof(struct segment_command) +
223         sizeof(struct section);
224     sc.align = 12;              /* Align on 2^12 = 4096 boundary */
225     sc.reloff = 0;
226     sc.nreloc = 0;
227     sc.flags = 0;
228     sc.reserved1 = 0;
229     sc.reserved2 = 0;
230
231     return ewrite(fd, &sc, sizeof(sc), __func__);
232 }
233
234 /*
235  * Write the actual data for the specific Lisp space to the object
236  * file.  The data is read from memory starting at real_addr and
237  * consists of length bytes.
238  */
239
240 static int
241 write_section_data(int fd, long length, os_vm_address_t real_addr)
242 {
243     return ewrite(fd, (void *)real_addr, length, __func__);
244 }
245
246 /*
247  * Write out an object file containing the data for our Lisp space.
248  * The object file is written to the directory dir.  The selected
249  * space is specified by id, and the starting address of the space is
250  * start, and goes to the address end.
251  */
252 int
253 write_space_object(const char *dir, int id, os_vm_address_t start, os_vm_address_t end)
254 {
255     int out = create_mach_o_file(dir, id);
256     int ret = 0;
257     /* The length should be a multiple of the page size. */
258     size_t length = end - start + (os_vm_page_size -
259                                    ((end - start) % os_vm_page_size));
260     static char *names[] = { "Dynamic", "Static", "Read-Only" };
261
262     if(id < 1 || id > 3) {
263         fprintf(stderr, "Invalid space id in %s: %d\n", __func__, id);
264         fprintf(stderr, "Executable not built.\n");
265         ret = -1;
266     }
267
268     /* Make id be 0-based to match array. */
269     id--;
270
271     printf("\t %s: %d bytes...\n", names[id], (end - start));
272     fflush(stdout);
273
274     if ((write_mach_o_header(out) == -1)
275         || (write_load_command(out, section_names[id], length, start) == -1)
276         || (write_section(out, length, start, section_names[id]) == -1)
277         || (write_section_data(out, length, start) == -1)) {
278         fprintf(stderr, "Executable not built.\n");
279         ret = -1;
280     }
281
282     close(out);
283     return ret;
284 }
285
286 /*
287  * Link everything together to create the executable.
288  */
289 int
290 obj_run_linker(long init_func_address, char *file)
291 {
292     lispobj libstring = SymbolValue(CMUCL_LIB);     /* Get library: */
293     struct vector *vec = (struct vector *)PTR(libstring);
294     char *paths;
295     char command[FILENAME_MAX + 1];
296     char command_line[FILENAME_MAX + FILENAME_MAX + 10];
297     char *strptr;
298     struct stat st;
299     int ret;
300     extern int debug_lisp_search;
301 #ifndef UNICODE
302     paths = strdup((char *)vec->data);
303 #else
304     /*
305      * What should we do here with 16-bit characters?  For now we just
306      * take the low 8-bits.
307      */
308     paths = malloc(vec->length);
309     {
310         int k;
311         unsigned short *data;
312         data = (unsigned short*) vec->data;
313         
314         for (k = 0; k < vec->length; ++k) {
315             paths[k] = data[k] & 0xff;
316         }
317     }
318 #endif
319     strptr = strtok(paths, ":");
320
321     if (debug_lisp_search) {
322         printf("Searching for %s script\n", LINKER_SCRIPT);
323     }
324
325     while(strptr != NULL) {
326         
327         sprintf(command, "%s/%s", strptr, LINKER_SCRIPT);
328
329         if (debug_lisp_search) {
330             printf("  %s\n", command);
331         }
332         
333         if (stat(command, &st) == 0) {
334             free(paths);
335             printf("\t[%s: linking %s... \n", command, file);
336             fflush(stdout);
337             sprintf(command_line, "%s %s 0x%lx '%s' 0x%lx 0x%lx 0x%lx", command,
338                     C_COMPILER, init_func_address, file,
339                     (unsigned long) READ_ONLY_SPACE_START,
340                     (unsigned long) STATIC_SPACE_START,
341                     (unsigned long) DYNAMIC_0_SPACE_START);
342             ret = system(command_line);
343             if (ret == -1) {
344                 perror("Can't run link script");
345             } else {
346                 printf("\tdone]\n");
347                 fflush(stdout);
348             }
349             return ret;
350         }
351         strptr = strtok(NULL, ":");
352     }
353
354     fprintf(stderr,
355             "Can't find %s script in CMUCL library directory list.\n", LINKER_SCRIPT);
356     free(paths);
357     return -1;
358 }
359
360
361 /*
362  * Read the Mach-O header from a file descriptor and stuff it into a
363  * structure.  Make sure it is really a Mach-O header etc.
364  */
365 static void
366 read_mach_o_header(int fd, MachO_hdr *ehp)
367 {
368     eread(fd, ehp, sizeof(MachO_hdr), __func__);
369
370     if (ehp->magic != MH_MAGIC) {
371         fprintf(stderr,
372                 "Bad Mach-O magic number --- not a Mach-O file. Exiting in %s.\n",
373                 __func__);
374         exit(-1);
375     }
376 }
377
378
379 /*
380  * Map the built-in lisp core sections.
381  *
382  * NOTE!  We need to do this without using malloc because the memory
383  * layout is not set until some time after this is done.
384  */
385 void
386 map_core_sections(const char *exec_name)
387 {
388     MachO_hdr eh;
389     int exec_fd;
390     int sections_remaining = 3;
391     int i;
392     int j;
393     extern int image_dynamic_space_size;
394     extern int image_static_space_size;
395     extern int image_read_only_space_size;
396
397     if (!(exec_fd = open(exec_name, O_RDONLY))) {
398         perror("Can't open executable!");
399         exit(-1);
400     }
401
402     read_mach_o_header(exec_fd, &eh);
403
404     for (i = 0; i < eh.ncmds && sections_remaining > 0; i++) {
405         struct load_command lc;
406         struct segment_command sc;
407         
408         /*
409          * Read the load command to see what kind of command it is and
410          * how big it is.
411          */
412         
413         eread(exec_fd, &lc, sizeof(lc), __func__);
414 #ifdef DEBUG_MACH_O
415         fprintf(stderr, "Load %d:  cmd = %d, cmdsize = %d\n", i, lc.cmd, lc.cmdsize);
416 #endif
417
418         if (lc.cmd == LC_SEGMENT) {
419           /*
420            * Got a segment command, so read the rest of the command so
421            * we can see if it's the segment for one of our Lisp
422            * spaces.
423            */
424 #ifdef DEBUG_MACH_O
425             fprintf(stderr, "Reading next %ld bytes for SEGMENT\n", sizeof(sc) - sizeof(lc));
426 #endif
427
428             eread(exec_fd, &sc.segname, sizeof(sc) - sizeof(lc), __func__);
429
430 #ifdef DEBUG_MACH_O
431             fprintf(stderr, "LC_SEGMENT: name = %s\n", sc.segname);
432 #endif
433
434             /* See if the segment name matches any of our section names */
435             for (j = 0; j < 3; ++j) {
436                 if (strncmp(sc.segname, section_names[j], sizeof(sc.segname)) == 0) {
437                     os_vm_address_t addr;
438
439                     /* Found a core segment.  Map it! */
440 #ifdef DEBUG_MACH_O
441                     fprintf(stderr, "Matched!\n");
442                     fprintf(stderr, " Fileoff = %u\n", sc.fileoff);
443                     fprintf(stderr, " vmaddr  = 0x%x\n", sc.vmaddr);
444                     fprintf(stderr, " vmsize  = 0x%x\n", sc.vmsize);
445 #endif
446                     /*
447                      * We don't care what address the segment has.  We
448                      * will map it where want it to go.
449                      */
450                     
451                     addr = section_addr[j];
452                     
453                     if ((os_vm_address_t) os_map(exec_fd, sc.fileoff,
454                                                  (os_vm_address_t) addr,
455                                                  sc.vmsize)
456                         == (os_vm_address_t) -1) {
457                         fprintf(stderr, "%s: Can't map section %s\n", __func__, section_names[j]);
458                         exit(-1);
459                     }
460                     switch (j) {
461                       case 0:
462                           /* Dynamic space */
463                           image_dynamic_space_size = sc.vmsize;
464                           break;
465                       case 1:
466                           /* Static space */
467                           image_static_space_size = sc.vmsize;
468                           break;
469                       case 2:
470                           /* Read only */
471                           image_read_only_space_size = sc.vmsize;
472                           break;
473                       default:
474                           /* Shouldn't happen! */
475                           abort();
476                     }
477                     --sections_remaining;
478                     break;
479                 }
480             }
481 #ifdef DEBUG_MACH_O
482             fprintf(stderr, "Skipping %ld remainder bytes left in command\n",
483                     lc.cmdsize - sizeof(sc));
484 #endif
485             elseek(exec_fd, lc.cmdsize - sizeof(sc), SEEK_CUR, __func__);
486         } else {
487             /* Not a segment command, so seek to the next command */
488 #ifdef DEBUG_MACH_O
489             fprintf(stderr, "Seeking by %ld bytes\n", lc.cmdsize - sizeof(lc));
490 #endif
491             elseek(exec_fd, lc.cmdsize - sizeof(lc), SEEK_CUR, __func__);
492         }
493     }
494
495     close(exec_fd);
496
497     if (sections_remaining != 0) {
498         fprintf(stderr, "Couldn't map all core sections!        Exiting!\n");
499         exit(-1);
500     }
501 }