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

Diff of /gcl/o/fasldlsym.c

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

revision 1.10 by camm, Fri Jun 10 15:13:53 2005 UTC revision 1.11 by camm, Thu Sep 29 17:57:27 2005 UTC
# Line 36  Foundation, 675 Mass Ave, Cambridge, MA Line 36  Foundation, 675 Mass Ave, Cambridge, MA
36    
37  #include "ptable.h"  #include "ptable.h"
38    
39  /* cc -DVOL=volatile -G 0 -c foo.c ; ld  -shared foo.o -o jim.o ; cat foo.data >> jim.o */  struct name_list {
40  int did_a_dynamic_load;    struct name_list *next;
   
 struct name_list  
 { struct name_list *next;  
41    char name[1];    char name[1];
42  } ;  };
43  static struct name_list *loaded_files;  static struct name_list *loaded_files;
44    
45  /* void   */  int
46  /* get_init_name(faslfile,init_fun) */  fasload(object faslfile) {
 /*      object faslfile; */  
 /*      char *init_fun; */  
 /* { */  
 /*   object path = coerce_to_pathname(faslfile); */  
 /*   char *p; */  
 /*   strcpy(init_fun,"init_"); */  
 /*   coerce_to_filename(path->pn.pn_name,init_fun+5); */  
 /*   p = init_fun +5; */  
 /*   while(*p) */  
 /*     {if (*p == '-') *p = '_'; */  
 /*      p++;} */  
 /* } */  
   
 static void *  
 get_init_fptr(void *dlp,char *fn) {  
47    
48    static object inf;    void *dlp ;
49    struct string st;    int (*fptr)();
50      char buf[MAXPATHLEN],b[MAXPATHLEN],filename[MAXPATHLEN];
51      static int count;
52      object memory,data,faslstream;
53      struct name_list *nl;
54    object x;    object x;
   char ib[MAXPATHLEN+1];  
   void *v;  
   
   if (!inf) {  
   
     object x;  
     struct string st;  
     set_type_of(&st,t_string);  
     st.st_self="COMPILER";  
     st.st_dim=st.st_fillp=strlen(st.st_self);  
     if ((x=find_package((object)&st))==Cnil)  
       FEerror("Cannot find compiler package", 0);  
     st.st_self="INIT-NAME";  
     st.st_dim=st.st_fillp=strlen(st.st_self);  
     if ((inf=find_symbol((object)&st,x))==Cnil) {  
       inf=NULL;  
       FEerror("Cannot find function COMPILER::INIT-NAME", 0);  
     }  
       
   }  
   
   set_type_of(&st,t_string);  
   st.st_self=fn;  
   st.st_dim=st.st_fillp=strlen(st.st_self);  
   x=ifuncall1(inf,(object)&st);  
   if (type_of(x)!=t_string)  
     FEerror("INIT-NAME error", 0);  
   assert(snprintf(ib,sizeof(ib),"init_%-.*s",x->st.st_dim,x->st.st_self)>0);  
   
   if (!(v=dlsym(dlp, ib))) {  
     x=ifuncall2(inf,(object)&st,Ct);  
     if (type_of(x)!=t_string)  
       FEerror("INIT-NAME error", 0);  
     assert(snprintf(ib,sizeof(ib),"init_%-.*s",x->st.st_dim,x->st.st_self)>0);  
     if (!(v=dlsym(dlp, ib)))  
       FEerror("Cannot lookup init-name ~a",1,make_simple_string(ib));  
   }  
55    
56    return v;    bzero(buf,sizeof(buf)); /*GC partial stack hole closing*/
57      bzero(b,sizeof(b));
58      bzero(filename,sizeof(filename));
59    
 }  
   
 int  
 fasload(faslfile)  
      object faslfile;  
 { void *dlp ;  
   int (*fptr)();  
   char buf[200];  
   static int count=0;  
   object memory;  
   object data;  
   char filename[MAXPATHLEN];  
   object faslstream;  
   coerce_to_filename(truename(faslfile), filename);  
   if (count == 0)  
     count = time(0);  
   snprintf(buf,sizeof(buf),"/tmp/ufas%dxXXXXXX",count++);  
60    /* this is just to allow reloading in the same file twice.    /* this is just to allow reloading in the same file twice.
61     */     */
62    mkstemp(buf);    coerce_to_filename(truename(faslfile), filename);
63    symlink(filename,buf);    if (!count)
64    { struct name_list *nl=      count=time(0);
65        (void *) malloc(strlen(buf)+sizeof(struct name_list));    ASSERT(snprintf(buf,sizeof(buf),"/tmp/ufas%dxXXXXXX",count++)>0);
66      nl->next = loaded_files;    ASSERT(mkstemp(buf)>=0);
67      loaded_files = nl;  
68      strcpy(nl->name,buf);    ASSERT((nl=(void *) malloc(strlen(buf)+1+sizeof(nl))));
69    }    nl->next = loaded_files;
70    faslstream = open_stream(faslfile, smm_input, Cnil, sKerror);    loaded_files = nl;
71  /*  #define MAKE_SHARED_LIB   */    strcpy(nl->name,buf);
72  #undef MAKE_SHARED_LIB  
73  #ifdef MAKE_SHARED_LIB    ASSERT(snprintf(b,sizeof(b),"cc -shared %s -o %s",filename,buf)>0);
74    { struct filehdr fhdr;    ASSERT(!system(b));
     fread(&fhdr,1,sizeof(fhdr),faslstream->sm.sm_fp);  
     fseek(faslstream->sm.sm_fp,0,0);  
     if (IS_NOT_SHARED_OBJECT(fhdr,faslstream))  
       { char com[600];  
         unlink(buf);  
         LD_SHARED(filename,buf);  
         system(com);  
       }  
   }  
 #endif  
   {  
     char com[600];  
     snprintf(com,sizeof(com),"cc -shared %s -o %s",filename,buf);  
     system(com);  
   }  
75    
76    dlp = dlopen(buf,RTLD_NOW);    if (!(dlp = dlopen(buf,RTLD_NOW))) {
   if (dlp ==0) {  
77      fputs(dlerror(),stderr);      fputs(dlerror(),stderr);
78      FEerror("Cant open for dynamic link ~a",1,make_simple_string(faslfile));      FEerror("Cannot open for dynamic link ~a",1,make_simple_string(faslfile));
79    }    }
80        
81    fptr=get_init_fptr(dlp,filename);    x=find_init_name1(buf,0);
82  /*   fptr = (int (*)())dlsym(dlp, "init_code"); */    ASSERT(x->st.st_fillp+1<sizeof(b));
83  /*   if (fptr == 0) */    memcpy(b,x->st.st_self,x->st.st_fillp);
84  /*     { /\* maybe system-p compiled so init_filename *\/ */    b[x->st.st_fillp]=0;
85  /*       char init_fun[200]; */    if (!(fptr=dlsym(dlp,b))) {
86  /*       get_init_name(faslfile,init_fun); */      fputs(dlerror(),stderr);
87  /*       fptr = (int (*)())dlsym(dlp, init_fun); */      FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(faslfile));
88  /*       if (fptr == 0) */    }
89  /*       FEerror("Cant find init_code in ~a",1,make_simple_string(faslfile));} */  
90        faslstream = open_stream(faslfile, smm_input, Cnil, sKerror);
91    SEEK_TO_END_OFILE(faslstream->sm.sm_fp);    SEEK_TO_END_OFILE(faslstream->sm.sm_fp);
92    
93    data = read_fasl_vector(faslstream);    data = read_fasl_vector(faslstream);
94    memory = alloc_object(t_cfdata);    memory = alloc_object(t_cfdata);
95    memory->cfd.cfd_self = NULL;    memory->cfd.cfd_self = NULL;
96    memory->cfd.cfd_start = NULL;    memory->cfd.cfd_start = NULL;
97    memory->cfd.cfd_size = 0;    memory->cfd.cfd_size = 0;
98    
99    if(symbol_value(sLAload_verboseA)!=Cnil)          if(symbol_value(sLAload_verboseA)!=Cnil)      
100      printf(" start address (dynamic) %p ",fptr);      printf(" start address (dynamic) %p ",fptr);
101    
102    call_init(0,memory,data,fptr);    call_init(0,memory,data,fptr);
103    
104    unlink(buf);    unlink(buf);
105    close_stream(faslstream);    close_stream(faslstream);
106    did_a_dynamic_load = 1;  
107    return memory->cfd.cfd_size;    return memory->cfd.cfd_size;
108    
109  }  }
110    
111  void  void
112  unlink_loaded_files(void)  unlink_loaded_files(void) {
113  { while(loaded_files)  
114      { unlink(loaded_files->name);    while(loaded_files) {
115        loaded_files= loaded_files->next;      unlink(loaded_files->name);
116      }      loaded_files= loaded_files->next;
117      }
118    
119  }  }
120        
121  #include "sfasli.c"  #include "sfasli.c"

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

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