/[gcl]/gcl/o/sfaslmacosx.c
ViewVC logotype

Diff of /gcl/o/sfaslmacosx.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by rlbk, Mon Sep 1 05:53:03 2003 UTC revision 1.2 by camm, Thu Sep 4 15:13:35 2003 UTC
# Line 0  Line 1 
1    /*
2    
3    This file is part of GNU Common Lisp, herein referred to as GCL
4    
5    GCL is free software; you can redistribute it and/or modify it under
6    the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
7    the Free Software Foundation; either version 2, or (at your option)
8    any later version.
9    
10    GCL is distributed in the hope that it will be useful, but WITHOUT
11    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
12    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
13    License for more details.
14    
15    You should have received a copy of the GNU Library General Public License
16    along with GCL; see the file COPYING.  If not, write to the Free Software
17    Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
18    
19    */
20    
21    /* Kinda primitive and temporary support for fasloading on Mac OS X
22       Aurelien Chanudet (aurelienDOTchanudetATm4xDOTorg) */
23    
24    #include <string.h>
25    #include <stdlib.h>
26    #include <stdio.h>
27    #include <fcntl.h>
28    #include <sys/stat.h>
29    #include <sys/param.h>
30    #include <time.h>
31    
32    #include <mach/mach.h>
33    #include <mach-o/loader.h>
34    #include <mach-o/dyld.h>
35    #include <mach-o/nlist.h>
36    
37    #include "ptable.h"
38    
39    static void sfasl_error (char *format, ...)
40    {
41        va_list ap;
42        
43        va_start (ap, format);
44        fprintf (stderr, "fasload: ");
45        vfprintf (stderr, format, ap);
46        fprintf (stderr, "\n");
47        va_end (ap);
48        exit (1);
49    }
50    
51    /* TODO : update to reflect the improvements of Mach-O */
52    
53    int seek_to_end_ofile (FILE *fp)
54    {
55        struct mach_header mach_header;
56        char *hdrbuf;
57        struct load_command *load_command;
58        struct segment_command *segment_command;
59        struct section *section;
60        struct symtab_command *symtab_command;
61        struct symseg_command *symseg_command;
62        int len, cmd, seg;
63        int end_sec, end_ofile;
64        
65      #ifdef DEBUG
66        fprintf(stderr,"seeking to end of Mach-O file\n");
67      #endif
68        
69        end_ofile = 0;
70        fseek(fp, 0L, 0);
71        len = fread((char *)&mach_header, sizeof(struct mach_header), 1, fp);
72        if (len == 1 && mach_header.magic == MH_MAGIC) {
73         /* hdrbuf = (char *)malloc(mach_header.sizeofcmds); */
74            hdrbuf = (char *)alloca(mach_header.sizeofcmds);
75            len = fread(hdrbuf, mach_header.sizeofcmds, 1, fp);
76            if (len != 1) {
77                fprintf(stderr, "seek_to_end_ofile(): failure reading Mach-O load commands\n");
78                return 0;
79            }
80            load_command = (struct load_command *) hdrbuf;
81            for (cmd = 0; cmd < mach_header.ncmds; ++cmd) {
82                switch (load_command->cmd) {
83                case LC_SEGMENT:
84                    segment_command = (struct segment_command *) load_command;
85                    section = (struct section *) ((char *)(segment_command + 1));
86                    for (seg = 0; seg < segment_command->nsects; ++seg, ++section) {
87                        end_sec = section->offset + section->size;
88                        if (end_sec > end_ofile)
89                            end_ofile = end_sec;
90                    }
91                    break;
92                case LC_SYMTAB:
93                    symtab_command = (struct symtab_command *) load_command;
94                    end_sec = symtab_command->symoff + symtab_command->nsyms * sizeof(struct nlist);
95                    if (end_sec > end_ofile)
96                        end_ofile = end_sec;
97                    end_sec = symtab_command->stroff + symtab_command->strsize;
98                    if (end_sec > end_ofile)
99                        end_ofile = end_sec;
100                    break;
101                case LC_SYMSEG:
102                    symseg_command = (struct symseg_command *) load_command;
103                    end_sec = symseg_command->offset + symseg_command->size;
104                    if (end_sec > end_ofile)
105                        end_ofile = end_sec;
106                    break;
107                }
108                load_command = (struct load_command *)
109                  ((char *)load_command + load_command->cmdsize);
110            }
111         /* free(hdrbuf); */
112            fseek(fp, end_ofile, 0);
113            return 1;
114        }
115        return 0;
116    }
117    
118    void get_init_name (object faslfile, char *init_fun)
119    {
120        object path = coerce_to_pathname (faslfile);
121        char *p;
122      
123        strcpy (init_fun,"init_");
124        coerce_to_filename (path->pn.pn_name,init_fun+5);
125      
126        p = init_fun +5;
127      
128        while(*p) {
129            if (*p == '-') *p = '_';
130            p++;
131        }
132    }
133    
134    typedef int (*func) ();
135    
136    func prepare_bundle (object faslfile, char *filename)
137    {
138        NSObjectFileImage image;
139        NSModule module;
140        NSSymbol nssym;
141        int (*fptr) ();
142        
143        unsigned long i, n, image_count;
144        unsigned long vmaddr_slide;
145        struct mach_header *header;
146        unsigned long vmsize = 0;
147        struct load_command *lc;
148        
149        extern void mark_region (unsigned long address, unsigned long size);
150        
151        if (NSCreateObjectFileImageFromFile (filename , &image) != NSObjectFileImageSuccess) {
152            sfasl_error ("cannot create object file image\n");
153        }
154        
155        if (!(module = NSLinkModule (image, filename, NSLINKMODULE_OPTION_RETURN_ON_ERROR))) {
156            sfasl_error ("cannot link bundle\n");
157        }
158        
159        if (!(nssym = NSLookupSymbolInModule (module, "_init_code")))
160        {
161            char init_fun [201];
162            
163            init_fun[0] = '_';
164            get_init_name (faslfile, &init_fun[1]);
165            
166            if (!(nssym = NSLookupSymbolInModule (module, init_fun))) {
167                sfasl_error ("cannot retrieve entry point symbol in bundle\n");
168            }
169        }
170        
171        if (!(fptr = (int (*) ()) NSAddressOfSymbol(nssym))) {
172            sfasl_error ("cannot retrieve entry point address\n");
173        }
174        
175        if (!_dyld_present ()) {
176            sfasl_error ("how can _dyld_present return false at this point !?\n");
177        }
178        
179        image_count = _dyld_image_count ();
180        
181        for (n=0 ; n < image_count ; n++) {
182            if (strstr (filename, _dyld_get_image_name (n)))
183            {
184                vmaddr_slide = _dyld_get_image_vmaddr_slide (n);
185                header = _dyld_get_image_header (n);
186                
187                lc = (struct load_command *) (header + 1);
188                
189                for (i=0 ; i < header->ncmds ; i++) {
190                    if (lc->cmd == LC_SEGMENT) {
191                        vmsize += ((struct segment_command *) lc)->vmsize;
192                    }
193                    lc = (struct load_command *) ((char *) lc + lc->cmdsize);
194                }
195                
196                break;
197            }
198        }
199        
200        mark_region (vmaddr_slide, vmsize);
201        
202        return (fptr);
203    }
204    
205    int fasload (object faslfile)
206    {
207        object faslstream;
208        object memory;
209        object data;
210        
211        int (*fptr) ();
212        
213        char filename [MAXPATHLEN];
214        char tmpfile [MAXPATHLEN];
215        
216        char cmd [256];
217        
218        coerce_to_filename (truename (faslfile), filename);
219        
220        snprintf (tmpfile, sizeof(tmpfile), "/tmp/fasload%lx.so", time(0));
221    
222        mkstemp (tmpfile);
223        symlink (filename, tmpfile);
224        
225        faslstream = open_stream (faslfile, smm_input, Cnil, sKerror);
226        
227        /* we could do a -flat_namespace build */
228        snprintf (cmd, sizeof(cmd),
229            "gcc -bind_at_load -bundle -bundle_loader %s %s -o %s", kcl_self, filename, tmpfile);
230        
231        if (system (cmd) != 0) {
232            sfasl_error ("cannot execute command: `%s'\n", cmd);
233        }
234        
235        fptr = prepare_bundle (faslfile, tmpfile);
236        
237        seek_to_end_ofile (faslstream->sm.sm_fp);
238        data = read_fasl_vector(faslstream);
239        
240        memory = alloc_object(t_cfdata);
241        memory->cfd.cfd_self = NULL;
242        memory->cfd.cfd_start = NULL;
243        memory->cfd.cfd_size = 0;
244        
245        if (symbol_value (sLAload_verboseA) != Cnil)        
246            printf (" start address (dynamic) %p ",fptr);
247        
248        call_init (0, memory, data, fptr);
249        
250        unlink (tmpfile);
251        
252        return memory->cfd.cfd_size;
253    }
254    
255    void unlink_loaded_files () {
256    
257    }
258    
259    #include "sfasli.c"

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26