loadelf.c
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* loadsave.sol.c
00003 /*      load an euslisp source code file
00004 /*      load a binary object file
00005 /*      save current running image to a file
00006 /*
00007 /*      (c) T.Matsui, 1986
00008 /****************************************************************/
00009 static char *rcsid="@(#)$Id$";
00010 
00011 #include <signal.h>
00012 #include <ctype.h>
00013 #include <sys/file.h>
00014 #include <fcntl.h>
00015 #include <dlfcn.h>
00016 #if i86pc
00017 #include <link.h>
00018 #endif
00019 
00020 #if alpha
00021 #undef MAX
00022 #undef MIN
00023 #undef VMAX
00024 #undef VMIN
00025 #endif
00026 #include "../c/eus.h"
00027 
00028 extern int errno;
00029 extern pointer openfile();
00030 extern pointer makemodule(context *, int);
00031 
00032 /****************************************************************/
00033 /* load eus source
00034 /*      Caution!!!
00035 /*      This function does not ensure closing the input file,
00036 /*      if an error occurs during load.
00037 /*      So, this function should be used only for bootstrapping.
00038 /*      Safer loader using with-open-file is defined in loader.l.
00039 /****************************************************************/
00040 
00041 pointer SRCLOAD(ctx,n,argv)
00042 register context *ctx;
00043 int n;
00044 pointer argv[];
00045 { pointer in,form;
00046   ckarg(1);
00047   in=openfile(ctx,(char *)argv[0]->c.str.chars,O_RDONLY,0,256);
00048   vpush(in);
00049   if (in==0) error(E_OPENFILE);
00050   form=reader(ctx,in,NIL);
00051   while (form!=(pointer)EOF){
00052     /* prinx(ctx,form,ERROUT); flushstream(ERROUT); terpri(ERROUT);*/
00053     /*fprintf(stderr, "%x\n", form);*/
00054     eval(ctx,form);
00055     form=reader(ctx,in,NIL);
00056     }
00057   closestream(in);
00058   vpop();
00059   return(NIL);}
00060 
00061 /****************************************************************/
00062 /* binload
00063 /*      dynamic shared object loader for EusLisp on Solaris
00064 /*      1986-Jun-22
00065 /*      1986-Oct-15     modified to accept compiled code
00066 /*      May/17/1994     reimplemetation using 'dl'
00067 /****************************************************************
00068 /* object module loader for Solaris 2.3
00069 /* (system:binload
00070 /*      "object.o" "quote.q" "_entry")
00071 /*      1987-April      for sun3
00072 /*      1987-December   for vax ultrix
00073 /*      1988-Nov        nothing special for sony news
00074 /*      1993-Jan        Solaris 2.0 Elf... failed
00075 /*      1994-May        Solaris 2.3 dynamic linker (dl)
00076 /****************************************************************/
00077 
00078 #define MAX_SYSTEM_MODULES 100
00079 int module_count=0;
00080 struct {
00081     pointer (*entry_func)();
00082     char *module_name;}
00083   module_initializers[MAX_SYSTEM_MODULES];
00084 
00085 
00086 void add_module_initializer(name, entry)
00087 char *name;
00088 pointer (*entry)();
00089 { 
00090   /* printf("%s %x is added in the module_initializer list\n", name, entry); */
00091   if (module_count>=MAX_SYSTEM_MODULES)  error(E_USER,(pointer)"too many system modules");
00092   module_initializers[module_count].module_name= name;
00093   module_initializers[module_count].entry_func=  entry;
00094   module_count++;}
00095 
00096 /* exec_module_initializers is no longer called */
00097 void exec_module_initializers(ctx)
00098 register context *ctx;
00099 { eusinteger_t i, addr;
00100   pointer (*initfunc)(context *, int, pointer *);
00101   pointer mod;
00102   for (i=0; i< module_count; i++) {
00103     printf("executing init: %s at %p...",
00104          module_initializers[i].module_name,
00105          module_initializers[i].entry_func);
00106     fflush(stdout);
00107     initfunc=module_initializers[i].entry_func;
00108     mod=makemodule(ctx,0);
00109     vpush(mod);
00110     breakck;
00111     if (initfunc) { 
00112       addr = (eusinteger_t)initfunc;
00113       addr= addr>>2;
00114       mod->c.ldmod.entry=makeint(addr);
00115 #if ARM
00116       mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
00117 #endif
00118       mod->c.ldmod.subrtype=SUBR_ENTRY;
00119       (*initfunc)(ctx,1, &mod); }
00120     vpop();
00121     printf(" ok\n");}
00122   module_count=0;}
00123 
00124 #if Solaris2 && !GCC
00125 pointer list_module_initializers(ctx,initnames)
00126 context *ctx;
00127 pointer initnames;
00128 { int i, addr;
00129   pointer (*initfunc)(int, pointer *);
00130   pointer mod, modname, p;
00131   for (i=0; i<module_count; i++) {
00132     initfunc=module_initializers[i].entry_func;
00133     modname=makestring(module_initializers[i].module_name,
00134                         strlen(module_initializers[i].module_name));
00135     vpush(modname);
00136     addr= (int)initfunc; addr >>=2;
00137     mod=makemodule(ctx,0);
00138     mod->c.ldmod.codevec=makeint(0);
00139     mod->c.ldmod.entry=makeint(addr);
00140     mod->c.ldmod.subrtype=SUBR_FUNCTION;
00141     if (debug)  
00142       printf("collecting init: %s at %x module at %x\n",
00143          module_initializers[i].module_name,
00144          module_initializers[i].entry_func, mod);
00145     p=cons(ctx,mod, NIL);
00146     p=cons(ctx,vpop(), p);      /* (list modname mod) */
00147     vpush(p);}
00148   p=(pointer)stacknlist(ctx,module_count);
00149   module_count=0;
00150   return(p);}
00151 
00152 #else
00153 pointer list_module_initializers(ctx, initnames)
00154 context *ctx;
00155 pointer initnames;
00156 { int i;
00157   eusinteger_t addr;
00158   pointer (*initfunc)(int, pointer *);
00159   pointer mod, modname, p;
00160   void *dlhandle;
00161   char namebuf[256];
00162 
00163   dlhandle=dlopen(0,RTLD_LAZY);
00164   if (dlhandle==NULL) { 
00165     fprintf(stderr, "cannot dlopen self\n"); exit(2);}
00166   module_count=0;
00167   while (iscons(initnames)) {
00168     /* printf("%s ", ccar(initnames)->c.str.chars); */
00169     initfunc= dlsym(dlhandle, (char *)ccar(initnames)->c.str.chars);
00170     if (initfunc==NULL) {
00171       sprintf(namebuf,"___%s",ccar(initnames)->c.str.chars);
00172       initfunc=dlsym(dlhandle, namebuf);}
00173 
00174     if (initfunc) {
00175       /* printf(" ok\n"); */
00176       modname=ccar(initnames);
00177       vpush(modname);
00178       addr= (eusinteger_t)initfunc; addr >>=2;/* ???? */
00179       mod=makemodule(ctx,0);
00180       mod->c.ldmod.codevec=makeint(0);
00181       mod->c.ldmod.entry=makeint(addr);
00182 #if ARM
00183       mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
00184 #endif
00185       mod->c.ldmod.subrtype=SUBR_FUNCTION;
00186       p=cons(ctx,mod, NIL);
00187       p=cons(ctx,vpop(), p);    /* (list modname mod) */
00188       vpush(p); module_count++;
00189     }
00190 /*    else {
00191      printf("%s not loaded\n", ccar(initnames)->c.str.chars);}*/
00192     initnames=ccdr(initnames); }
00193   p=(pointer)stacknlist(ctx,module_count);
00194   module_count=0;
00195   return(p);}
00196 
00197 pointer list_module_initializers2(ctx, n, argv)
00198 register context *ctx;
00199 int n;
00200 pointer *argv;
00201 { int i;
00202   eusinteger_t addr;
00203   pointer (*initfunc)(int, pointer *);
00204   pointer mod, modname, initnames, p;
00205   void *dlhandle;
00206   char namebuf[256];
00207 
00208   ckarg(2);
00209   if (!isldmod(argv[0])) error(E_USER,(pointer)"not a LOAD-MODULE");
00210   if (!iscons(argv[1])) error(E_NOLIST);
00211 #if (WORD_SIZE == 64)
00212   dlhandle=(void *)((eusinteger_t)(argv[0]->c.ldmod.handle) & ~3L);
00213 #else
00214   dlhandle=(void *)((eusinteger_t)(argv[0]->c.ldmod.handle) & ~3);
00215 #endif
00216   initnames=argv[1];
00217   module_count=0;
00218   if (dlhandle==NULL) error(E_USER,(pointer)"This module was not loaded");
00219 
00220   while (iscons(initnames)) {
00221     initfunc= dlsym(dlhandle, (char *)ccar(initnames)->c.str.chars);
00222     if (initfunc==NULL) {
00223       sprintf(namebuf,"___%s",ccar(initnames)->c.str.chars);
00224       initfunc=dlsym(dlhandle, namebuf);}
00225 
00226     if (initfunc) {
00227       modname=ccar(initnames);
00228       vpush(modname);
00229       addr= (eusinteger_t)initfunc; addr >>=2;/* ???? */
00230       mod=makemodule(ctx,0);
00231       mod->c.ldmod.codevec=makeint(0);
00232       mod->c.ldmod.entry=makeint(addr);
00233 #if ARM
00234       mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
00235 #endif
00236       mod->c.ldmod.subrtype=SUBR_FUNCTION;
00237       p=cons(ctx,mod, NIL);
00238       p=cons(ctx,vpop(), p);    /* (list modname mod) */
00239       vpush(p); module_count++;}
00240     else {
00241      printf("%s not loaded\n", ccar(initnames)->c.str.chars); }
00242     initnames=ccdr(initnames); }
00243   p=(pointer)stacknlist(ctx,module_count);
00244   module_count=0;
00245   return(p);}
00246 #endif
00247 
00248 pointer build_quote_vector(ctx,size, strings)
00249 register context *ctx;
00250 int size;
00251 char *strings[];
00252 { pointer qvec, p, qstring, qstream;
00253   int i, k;
00254   qvec=makevector(C_VECTOR,size);
00255   vpush(qvec);
00256   qstream=(pointer)mkstream(ctx,K_IN,makestring("",0));
00257   vpush(qstream);
00258   for (i=0; i<size; i++) {
00259     k=strlen((char *)strings[i]);
00260     qstring=makestring(strings[i], k);
00261     /*prinx(ctx,qstring, STDOUT); terpri(STDOUT); */
00262     pointer_update(qstream->c.stream.buffer,qstring);
00263     qstream->c.stream.count=makeint(0);
00264     qstream->c.stream.tail=makeint(k);
00265     pointer_update(qvec->c.vec.v[i],reader(ctx,qstream, NIL));}
00266   vpop();
00267   vpop();
00268   /* prinx(ctx,qvec, STDOUT); */
00269 #ifdef SAFETY
00270   take_care(qvec);
00271 #endif
00272   return(qvec);}
00273 
00274 pointer eval_c_strings(ctx,size, strings)
00275 register context *ctx;
00276 int size;
00277 const char *strings[];
00278 { pointer p, qstream, qstring;
00279   int i, k, total_length;
00280   char *s;
00281   byte *d;
00282 
00283   total_length=size;
00284   for (i=0; i<size; i++) { total_length += strlen(strings[i]); }
00285   qstring = makebuffer(total_length);
00286   vpush(qstring);
00287   d=qstring->c.str.chars;
00288   for (i=0; i<size; i++) {
00289     s=(char *)strings[i];
00290     while (*s) *d++ = *s++;
00291     *d++= '\n';}        /* newline is needed to ensure the reader
00292                            to stop ignoring comments */
00293   qstream=(pointer)mkstream(ctx,K_IN, qstring);
00294   vpush(qstream);
00295   qstream->c.stream.tail=makeint(total_length);
00296   while ((p=reader(ctx,qstream, NIL))!= (pointer)(-1))  {
00297      if (debug) { prinx(ctx,p,STDOUT); terpri(STDOUT);  }
00298      p=eval(ctx,p);}
00299   vpop();
00300   vpop();
00301   return(p);}
00302 
00303 pointer FIND_ENTRY(ctx,n,argv)
00304 register context *ctx;
00305 int n;
00306 pointer argv[];
00307 { pointer entry, mod;
00308   char *entry_string;
00309   extern pointer sysmod;
00310 
00311   ckarg2(1,2);
00312   if (n==2) mod=argv[1];
00313   else mod=sysmod;
00314   if (!isldmod(mod)) error(E_USER,(pointer)"not a LOAD-MODULE");
00315   entry_string=(char *)get_string(argv[0]);
00316 #if (WORD_SIZE == 64)
00317   entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3L), entry_string);
00318 #else
00319   entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3), entry_string);
00320 #endif
00321   if (entry==NULL) return(NIL);
00322   else return(makeint((eusinteger_t)entry>>2));}
00323 
00324 pointer FIND_ENTRY2(ctx,n,argv)
00325 register context *ctx;
00326 int n;
00327 pointer argv[];
00328 { pointer entry, mod, e=NIL;
00329   char *entry_string;
00330   extern pointer sysmod;
00331 
00332   ckarg2(1,2);
00333   if (n==2) mod=argv[1];
00334   else mod=sysmod;
00335   if (!isldmod(mod)) error(E_USER,(pointer)"not a LOAD-MODULE");
00336   entry_string=(char *)get_string(argv[0]);
00337 #if (WORD_SIZE == 64)
00338   entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3L), entry_string);
00339 #else
00340   entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3), entry_string);
00341 #endif
00342   if (entry==NULL) return(NIL);
00343   else {
00344     e=cons(ctx,makeint((eusinteger_t)entry),e);
00345     e=cons(ctx,makeint((eusinteger_t)entry>>2),e);
00346     return(e);}}
00347 
00348 extern pointer sysmod;
00349 
00350 pointer SYSMOD()
00351 { return(sysmod);}
00352 
00353 pointer UNBINLOAD(ctx,n,argv)
00354 register context *ctx;
00355 int n;
00356 pointer *argv;
00357 { register pointer mod=argv[0];
00358   register int stat;
00359   ckarg(1);
00360   if (!isldmod(mod)) error(E_USER,(pointer)"not a compiled-module");
00361 #if (WORD_SIZE == 64)
00362   stat=dlclose((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3L));
00363 #else
00364   stat=dlclose((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3));
00365 #endif
00366   if (stat) return(makeint(-errno));
00367   else return(T);}
00368 
00369 pointer BINLOAD(ctx,n,argv)
00370 register context *ctx;
00371 int n;
00372 pointer *argv;
00373 { char *binfn, *quofn;  /*binary and quote file names*/
00374   char *entry;
00375   int binfd,size,newsize,stat,i=0,l,s;
00376   pointer mod,quostrm,qvec;
00377   byte *loadaddress;
00378   pointer (*initfunc)(context *, int, pointer *);
00379   int data_align=0;
00380   eusinteger_t dlhandle, addr;
00381 
00382   ckarg2(1,2);
00383   binfn= (char *)get_string(argv[0]);
00384   if (n==2) {
00385     if (argv[1]==NIL) entry=NULL;
00386     else entry=(char *)get_string(argv[1]);}
00387   else entry=NULL;
00388 
00389   dlhandle=(eusinteger_t)dlopen(binfn, RTLD_LAZY);/* ???? */
00390   if (dlhandle == 0) {
00391     fprintf(stderr,"BINLOAD cannot dlopen: %s\n", dlerror());
00392     return(NIL);}
00393   initfunc=NULL;
00394   if (entry) {
00395     initfunc=(pointer (*)(context *, int, pointer *))dlsym((void *)dlhandle, entry);
00396     if (initfunc==NULL)
00397       initfunc=(pointer (*)(context *, int, pointer *))dlsym((void *)dlhandle, &entry[3]);
00398 /*    if (initfunc==NULL) fprintf(stderr, ";; entry not found\n");*/
00399   }
00400   mod=makemodule(ctx,0);
00401   pointer_update(mod->c.ldmod.objname,argv[0]);
00402   mod->c.ldmod.handle=makeint(dlhandle>>2);
00403   vpush(mod);
00404 
00405   /*call initializer*/
00406   breakck;
00407   if (initfunc) { 
00408     addr=(eusinteger_t)initfunc; addr >>=2;/* ???? */
00409     mod->c.ldmod.codevec=makeint(0);
00410     mod->c.ldmod.entry=makeint(addr);
00411 #if ARM
00412     mod->c.ldmod.entry2=makeint((eusinteger_t)initfunc);
00413 #endif
00414     mod->c.ldmod.subrtype=SUBR_FUNCTION;
00415     (*initfunc)(ctx, 1, &mod); }
00416   else if (debug) fprintf(stderr,";; no initializer\n");
00417   return(vpop());       /* return the module */
00418   }
00419 
00420 
00421 pointer SAVE(ctx,n,argv)
00422 register context *ctx;
00423 int n;
00424 pointer argv[];
00425 { error(E_USER,(pointer)"SAVE is not supported on Solaris");}
00426 
00427 
00428 void loadsave(ctx,mod)
00429 register context *ctx;
00430 pointer mod;
00431 { pointer p=Spevalof(PACKAGE);
00432   pointer_update(Spevalof(PACKAGE),syspkg);
00433   defun(ctx,"SRCLOAD",mod,SRCLOAD,NULL);
00434 #if Solaris2 && !GCC
00435   defun(ctx,"LIST-MODULE-INITIALIZERS",mod,list_module_initializers,NULL);
00436 #else
00437   defun(ctx,"LIST-MODULE-INITIALIZERS",mod,list_module_initializers2,NULL);
00438 #endif
00439   defun(ctx,"FIND-ENTRY", mod, FIND_ENTRY,NULL);
00440   defun(ctx,"FIND-ENTRY2", mod, FIND_ENTRY2,NULL);
00441   defun(ctx,"SYSMOD", mod, SYSMOD,NULL);
00442   defun(ctx,"BINLOAD",mod,BINLOAD,NULL);
00443   defun(ctx,"UNBINLOAD",mod,UNBINLOAD,NULL);
00444   defun(ctx,"SAVE",mod,SAVE,NULL);
00445   pointer_update(Spevalof(PACKAGE),p);}
00446 
00447 


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 18:05:53