/[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.5.6.2.10.1 by camm, Fri May 6 21:56:55 2005 UTC revision 1.5.6.2.10.1.2.1 by camm, Fri Sep 30 02:17:21 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   */  #define massert(a_) if (!(a_)) FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4,\
46  /* get_init_name(faslfile,init_fun) */                      make_simple_string(#a_),make_fixnum(__LINE__),\
47  /*      object faslfile; */                      make_simple_string(__FILE__),make_simple_string(__FUNCTION__))
 /*      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++;} */  
 /* } */  
48    
49  static void *  int
50  get_init_fptr(void *dlp,char *fn) {  fasload(object faslfile) {
51    
52    static object inf;    void *dlp ;
53    struct string st;    int (*fptr)();
54      char buf[MAXPATHLEN],b[MAXPATHLEN],filename[MAXPATHLEN];
55      static int count;
56      object memory,data,faslstream;
57      struct name_list *nl;
58    object x;    object x;
   char ib[MAXPATHLEN+1];  
   void *v;  
   
   if (!inf) {  
   
     object x;  
     struct string st;  
     st.t=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);  
     }  
       
   }  
   
   st.t=t_string;  
   st.st_self=fn;  
   st.st_dim=st.st_fillp=strlen(st.st_self);  
   x=ifuncall1(inf,(object)&st);  
   if (x->d.t!=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 (x->d.t!=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));  
   }  
59    
60    return v;    bzero(buf,sizeof(buf)); /*GC partial stack hole closing*/
61      bzero(b,sizeof(b));
62      bzero(filename,sizeof(filename));
63    
 }  
   
 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++);  
64    /* this is just to allow reloading in the same file twice.    /* this is just to allow reloading in the same file twice.
65     */     */
66    mkstemp(buf);    coerce_to_filename(truename(faslfile), filename);
67    symlink(filename,buf);    if (!count)
68    { struct name_list *nl=      count=time(0);
69        (void *) malloc(strlen(buf)+sizeof(struct name_list));    massert(snprintf(buf,sizeof(buf),"/tmp/ufas%dxXXXXXX",count++)>0);
70      nl->next = loaded_files;    massert(mkstemp(buf)>=0);
71      loaded_files = nl;  
72      strcpy(nl->name,buf);    massert((nl=(void *) malloc(strlen(buf)+1+sizeof(nl))));
73    }    nl->next = loaded_files;
74      loaded_files = nl;
75      strcpy(nl->name,buf);
76    
77    faslstream = open_stream(faslfile, smm_input, Cnil, sKerror);    faslstream = open_stream(faslfile, smm_input, Cnil, sKerror);
78  /*  #define MAKE_SHARED_LIB   */    massert(snprintf(b,sizeof(b),"cc -shared %s -o %s",filename,buf)>0);
79  #undef MAKE_SHARED_LIB    massert(!system(b));
 #ifdef MAKE_SHARED_LIB  
   { struct filehdr fhdr;  
     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);  
   }  
80    
81    dlp = dlopen(buf,RTLD_NOW);    if (!(dlp = dlopen(buf,RTLD_NOW))) {
   if (dlp ==0) {  
82      fputs(dlerror(),stderr);      fputs(dlerror(),stderr);
83      FEerror("Cant open for dynamic link ~a",1,make_simple_string(faslfile));      FEerror("Cannot open for dynamic link ~a",1,make_simple_string(faslfile));
84    }    }
85        
86    fptr=get_init_fptr(dlp,filename);  
87  /*   fptr = (int (*)())dlsym(dlp, "init_code"); */    x=find_init_name1(buf,0);
88  /*   if (fptr == 0) */    massert(x->st.st_fillp+1<sizeof(b));
89  /*     { /\* maybe system-p compiled so init_filename *\/ */    memcpy(b,x->st.st_self,x->st.st_fillp);
90  /*       char init_fun[200]; */    b[x->st.st_fillp]=0;
91  /*       get_init_name(faslfile,init_fun); */    if (!(fptr=dlsym(dlp,b))) {
92  /*       fptr = (int (*)())dlsym(dlp, init_fun); */      fputs(dlerror(),stderr);
93  /*       if (fptr == 0) */      FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(faslfile));
94  /*       FEerror("Cant find init_code in ~a",1,make_simple_string(faslfile));} */    }
95      
96    SEEK_TO_END_OFILE(faslstream->sm.sm_fp);    SEEK_TO_END_OFILE(faslstream->sm.sm_fp);
97    
98    data = read_fasl_vector(faslstream);    data = read_fasl_vector(faslstream);
99    memory = alloc_object(t_cfdata);    memory = alloc_object(t_cfdata);
100    memory->cfd.cfd_self = NULL;    memory->cfd.cfd_self = NULL;
101    memory->cfd.cfd_start = NULL;    memory->cfd.cfd_start = NULL;
102    memory->cfd.cfd_size = 0;    memory->cfd.cfd_size = 0;
103    
104    if(symbol_value(sLAload_verboseA)!=Cnil)          if(symbol_value(sLAload_verboseA)!=Cnil)      
105      printf(" start address (dynamic) %p ",fptr);      printf(" start address (dynamic) %p ",fptr);
106    
107    call_init(0,memory,data,fptr);    call_init(0,memory,data,fptr);
108    
109    unlink(buf);    unlink(buf);
110    close_stream(faslstream);    close_stream(faslstream);
111    did_a_dynamic_load = 1;  
112    return memory->cfd.cfd_size;    return memory->cfd.cfd_size;
113    
114  }  }
115    
116  void  void
117  unlink_loaded_files(void)  unlink_loaded_files(void) {
118  { while(loaded_files)  
119      { unlink(loaded_files->name);    while(loaded_files) {
120        loaded_files= loaded_files->next;      unlink(loaded_files->name);
121      }      loaded_files= loaded_files->next;
122      }
123    
124  }  }
125        
126  #include "sfasli.c"  #include "sfasli.c"

Legend:
Removed from v.1.5.6.2.10.1  
changed lines
  Added in v.1.5.6.2.10.1.2.1

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