loadelf.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* loadsave.sol.c
3 /* load an euslisp source code file
4 /* load a binary object file
5 /* save current running image to a file
6 /*
7 /* (c) T.Matsui, 1986
8 /****************************************************************/
9 static char *rcsid="@(#)$Id$";
10 
11 #include <signal.h>
12 #include <ctype.h>
13 #include <sys/file.h>
14 #include <fcntl.h>
15 #include <dlfcn.h>
16 #if i86pc
17 #include <link.h>
18 #endif
19 
20 #if alpha
21 #undef MAX
22 #undef MIN
23 #undef VMAX
24 #undef VMIN
25 #endif
26 #include "../c/eus.h"
27 
28 extern int errno;
29 extern pointer openfile();
30 extern pointer makemodule(context *, int);
31 
32 /****************************************************************/
33 /* load eus source
34 /* Caution!!!
35 /* This function does not ensure closing the input file,
36 /* if an error occurs during load.
37 /* So, this function should be used only for bootstrapping.
38 /* Safer loader using with-open-file is defined in loader.l.
39 /****************************************************************/
40 
41 pointer SRCLOAD(ctx,n,argv)
42 register context *ctx;
43 int n;
44 pointer argv[];
45 { pointer in,form;
46  ckarg(1);
47  in=openfile(ctx,(char *)argv[0]->c.str.chars,O_RDONLY,0,256);
48  vpush(in);
49  if (in==0) error(E_OPENFILE);
50  form=reader(ctx,in,NIL);
51  while (form!=(pointer)EOF){
52  /* prinx(ctx,form,ERROUT); flushstream(ERROUT); terpri(ERROUT);*/
53  /*fprintf(stderr, "%x\n", form);*/
54  eval(ctx,form);
55  form=reader(ctx,in,NIL);
56  }
57  closestream(in);
58  vpop();
59  return(NIL);}
60 
61 /****************************************************************/
62 /* binload
63 /* dynamic shared object loader for EusLisp on Solaris
64 /* 1986-Jun-22
65 /* 1986-Oct-15 modified to accept compiled code
66 /* May/17/1994 reimplemetation using 'dl'
67 /****************************************************************
68 /* object module loader for Solaris 2.3
69 /* (system:binload
70 /* "object.o" "quote.q" "_entry")
71 /* 1987-April for sun3
72 /* 1987-December for vax ultrix
73 /* 1988-Nov nothing special for sony news
74 /* 1993-Jan Solaris 2.0 Elf... failed
75 /* 1994-May Solaris 2.3 dynamic linker (dl)
76 /****************************************************************/
77 
78 #define MAX_SYSTEM_MODULES 100
80 struct {
82  char *module_name;}
83  module_initializers[MAX_SYSTEM_MODULES];
84 
85 
86 void add_module_initializer(name, entry)
87 char *name;
88 pointer (*entry)();
89 {
90  /* printf("%s %x is added in the module_initializer list\n", name, entry); */
91  if (module_count>=MAX_SYSTEM_MODULES) error(E_USER,(pointer)"too many system modules");
92  module_initializers[module_count].module_name= name;
93  module_initializers[module_count].entry_func= entry;
94  module_count++;}
95 
96 /* exec_module_initializers is no longer called */
98 register context *ctx;
99 { eusinteger_t i, addr;
100  pointer (*initfunc)(context *, int, pointer *);
101  pointer mod;
102  for (i=0; i< module_count; i++) {
103  printf("executing init: %s at %p...",
106  fflush(stdout);
107  initfunc=module_initializers[i].entry_func;
108  mod=makemodule(ctx,0);
109  vpush(mod);
110  breakck;
111  if (initfunc) {
112  addr = (eusinteger_t)initfunc;
113  addr= addr>>2;
114  mod->c.ldmod.entry=makeint(addr);
115 #if ARM
116  mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
117 #endif
118  mod->c.ldmod.subrtype=SUBR_ENTRY;
119  (*initfunc)(ctx,1, &mod); }
120  vpop();
121  printf(" ok\n");}
122  module_count=0;}
123 
124 #if Solaris2 && !GCC
126 context *ctx;
127 pointer initnames;
128 { int i, addr;
129  pointer (*initfunc)(int, pointer *);
130  pointer mod, modname, p;
131  for (i=0; i<module_count; i++) {
132  initfunc=module_initializers[i].entry_func;
134  strlen(module_initializers[i].module_name));
135  vpush(modname);
136  addr= (int)initfunc; addr >>=2;
137  mod=makemodule(ctx,0);
138  mod->c.ldmod.codevec=makeint(0);
139  mod->c.ldmod.entry=makeint(addr);
140  mod->c.ldmod.subrtype=SUBR_FUNCTION;
141  if (debug)
142  printf("collecting init: %s at %x module at %x\n",
145  p=cons(ctx,mod, NIL);
146  p=cons(ctx,vpop(), p); /* (list modname mod) */
147  vpush(p);}
149  module_count=0;
150  return(p);}
151 
152 #else
154 context *ctx;
155 pointer initnames;
156 { int i;
157  eusinteger_t addr;
158  pointer (*initfunc)(int, pointer *);
159  pointer mod, modname, p;
160  void *dlhandle;
161  char namebuf[256];
162 
163  dlhandle=dlopen(0,RTLD_LAZY|RTLD_GLOBAL);
164  if (dlhandle==NULL) {
165  fprintf(stderr, "cannot dlopen self\n"); exit(2);}
166  module_count=0;
167  while (iscons(initnames)) {
168  /* printf("%s ", ccar(initnames)->c.str.chars); */
169  initfunc= dlsym(dlhandle, (char *)ccar(initnames)->c.str.chars);
170  if (initfunc==NULL) {
171  sprintf(namebuf,"___%s",ccar(initnames)->c.str.chars);
172  initfunc=dlsym(dlhandle, namebuf);}
173 
174  if (initfunc) {
175  /* printf(" ok\n"); */
176  modname=ccar(initnames);
177  vpush(modname);
178  addr= (eusinteger_t)initfunc; addr >>=2;/* ???? */
179  mod=makemodule(ctx,0);
180  mod->c.ldmod.codevec=makeint(0);
181  mod->c.ldmod.entry=makeint(addr);
182 #if ARM
183  mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
184 #endif
185  mod->c.ldmod.subrtype=SUBR_FUNCTION;
186  p=cons(ctx,mod, NIL);
187  p=cons(ctx,vpop(), p); /* (list modname mod) */
188  vpush(p); module_count++;
189  }
190 /* else {
191  printf("%s not loaded\n", ccar(initnames)->c.str.chars);}*/
192  initnames=ccdr(initnames); }
194  module_count=0;
195  return(p);}
196 
198 register context *ctx;
199 int n;
200 pointer *argv;
201 { int i;
202  eusinteger_t addr;
203  pointer (*initfunc)(int, pointer *);
204  pointer mod, modname, initnames, p;
205  void *dlhandle;
206  char namebuf[256];
207 
208  ckarg(2);
209  if (!isldmod(argv[0])) error(E_USER,(pointer)"not a LOAD-MODULE");
210  if (!iscons(argv[1])) error(E_NOLIST);
211 #if (WORD_SIZE == 64)
212  dlhandle=(void *)((eusinteger_t)(argv[0]->c.ldmod.handle) & ~3L);
213 #else
214  dlhandle=(void *)((eusinteger_t)(argv[0]->c.ldmod.handle) & ~3);
215 #endif
216  initnames=argv[1];
217  module_count=0;
218  if (dlhandle==NULL) error(E_USER,(pointer)"This module was not loaded");
219 
220  while (iscons(initnames)) {
221  initfunc= dlsym(dlhandle, (char *)ccar(initnames)->c.str.chars);
222  if (initfunc==NULL) {
223  sprintf(namebuf,"___%s",ccar(initnames)->c.str.chars);
224  initfunc=dlsym(dlhandle, namebuf);}
225 
226  if (initfunc) {
227  modname=ccar(initnames);
228  vpush(modname);
229  addr= (eusinteger_t)initfunc; addr >>=2;/* ???? */
230  mod=makemodule(ctx,0);
231  mod->c.ldmod.codevec=makeint(0);
232  mod->c.ldmod.entry=makeint(addr);
233 #if ARM
234  mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
235 #endif
236  mod->c.ldmod.subrtype=SUBR_FUNCTION;
237  p=cons(ctx,mod, NIL);
238  p=cons(ctx,vpop(), p); /* (list modname mod) */
239  vpush(p); module_count++;}
240  else {
241  printf("%s not loaded\n", ccar(initnames)->c.str.chars); }
242  initnames=ccdr(initnames); }
244  module_count=0;
245  return(p);}
246 #endif
247 
248 pointer build_quote_vector(ctx,size, strings)
249 register context *ctx;
250 int size;
251 char *strings[];
252 { pointer qvec, p, qstring, qstream;
253  int i, k;
254  qvec=makevector(C_VECTOR,size);
255  vpush(qvec);
256  qstream=(pointer)mkstream(ctx,K_IN,makestring("",0));
257  vpush(qstream);
258  for (i=0; i<size; i++) {
259  k=strlen((char *)strings[i]);
260  qstring=makestring(strings[i], k);
261  /*prinx(ctx,qstring, STDOUT); terpri(STDOUT); */
262  pointer_update(qstream->c.stream.buffer,qstring);
263  qstream->c.stream.count=makeint(0);
264  qstream->c.stream.tail=makeint(k);
265  pointer_update(qvec->c.vec.v[i],reader(ctx,qstream, NIL));}
266  vpop();
267  vpop();
268  /* prinx(ctx,qvec, STDOUT); */
269 #ifdef SAFETY
270  take_care(qvec);
271 #endif
272  return(qvec);}
273 
274 pointer eval_c_strings(ctx,size, strings)
275 register context *ctx;
276 int size;
277 const char *strings[];
278 { pointer p, qstream, qstring;
279  int i, k, total_length;
280  char *s;
281  byte *d;
282 
283  total_length=size;
284  for (i=0; i<size; i++) { total_length += strlen(strings[i]); }
285  qstring = makebuffer(total_length);
286  vpush(qstring);
287  d=qstring->c.str.chars;
288  for (i=0; i<size; i++) {
289  s=(char *)strings[i];
290  while (*s) *d++ = *s++;
291  *d++= '\n';} /* newline is needed to ensure the reader
292  to stop ignoring comments */
293  qstream=(pointer)mkstream(ctx,K_IN, qstring);
294  vpush(qstream);
295  qstream->c.stream.tail=makeint(total_length);
296  while ((p=reader(ctx,qstream, NIL))!= (pointer)(-1)) {
297  if (debug) { prinx(ctx,p,STDOUT); terpri(STDOUT); }
298  p=eval(ctx,p);}
299  vpop();
300  vpop();
301  return(p);}
302 
304 register context *ctx;
305 int n;
306 pointer argv[];
307 { pointer entry, mod;
308  char *entry_string;
309  extern pointer sysmod;
310 
311  ckarg2(1,2);
312  if (n==2) mod=argv[1];
313  else mod=sysmod;
314  if (!isldmod(mod)) error(E_USER,(pointer)"not a LOAD-MODULE");
315  entry_string=(char *)get_string(argv[0]);
316 #if (WORD_SIZE == 64)
317  entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3L), entry_string);
318 #else
319  entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3), entry_string);
320 #endif
321  if (entry==NULL) return(NIL);
322  else return(makeint((eusinteger_t)entry>>2));}
323 
325 register context *ctx;
326 int n;
327 pointer argv[];
328 { pointer entry, mod, e=NIL;
329  char *entry_string;
330  extern pointer sysmod;
331 
332  ckarg2(1,2);
333  if (n==2) mod=argv[1];
334  else mod=sysmod;
335  if (!isldmod(mod)) error(E_USER,(pointer)"not a LOAD-MODULE");
336  entry_string=(char *)get_string(argv[0]);
337 #if (WORD_SIZE == 64)
338  entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3L), entry_string);
339 #else
340  entry=(pointer)dlsym((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3), entry_string);
341 #endif
342  if (entry==NULL) return(NIL);
343  else {
344  e=cons(ctx,makeint((eusinteger_t)entry),e);
345  e=cons(ctx,makeint((eusinteger_t)entry>>2),e);
346  return(e);}}
347 
348 extern pointer sysmod;
349 
351 { return(sysmod);}
352 
353 pointer UNBINLOAD(ctx,n,argv)
354 register context *ctx;
355 int n;
356 pointer *argv;
357 { register pointer mod=argv[0];
358  register int stat;
359  ckarg(1);
360  if (!isldmod(mod)) error(E_USER,(pointer)"not a compiled-module");
361 #if (WORD_SIZE == 64)
362  stat=dlclose((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3L));
363 #else
364  stat=dlclose((void *)((eusinteger_t)(mod->c.ldmod.handle) & ~3));
365 #endif
366  if (stat) return(makeint(-errno));
367  else return(T);}
368 
369 pointer BINLOAD(ctx,n,argv)
370 register context *ctx;
371 int n;
372 pointer *argv;
373 { char *binfn, *quofn; /*binary and quote file names*/
374  char *entry;
375  int binfd,size,newsize,stat,i=0,l,s;
376  pointer mod,quostrm,qvec;
377  byte *loadaddress;
378  pointer (*initfunc)(context *, int, pointer *);
379  int data_align=0;
380  eusinteger_t dlhandle, addr;
381 
382  ckarg2(1,2);
383  binfn= (char *)get_string(argv[0]);
384  if (n==2) {
385  if (argv[1]==NIL) entry=NULL;
386  else entry=(char *)get_string(argv[1]);}
387  else entry=NULL;
388 
389  dlhandle=(eusinteger_t)dlopen(binfn, RTLD_LAZY|RTLD_GLOBAL);/* ???? */
390  if (dlhandle == 0) {
391  fprintf(stderr,"BINLOAD cannot dlopen: %s\n", dlerror());
392  return(NIL);}
393  initfunc=NULL;
394  if (entry) {
395  initfunc=(pointer (*)(context *, int, pointer *))dlsym((void *)dlhandle, entry);
396  if (initfunc==NULL)
397  initfunc=(pointer (*)(context *, int, pointer *))dlsym((void *)dlhandle, &entry[3]);
398 /* if (initfunc==NULL) fprintf(stderr, ";; entry not found\n");*/
399  }
400  mod=makemodule(ctx,0);
401  pointer_update(mod->c.ldmod.objname,argv[0]);
402  mod->c.ldmod.handle=makeint(dlhandle>>2);
403  vpush(mod);
404 
405  /*call initializer*/
406  breakck;
407  if (initfunc) {
408  addr=(eusinteger_t)initfunc; addr >>=2;/* ???? */
409  mod->c.ldmod.codevec=makeint(0);
410  mod->c.ldmod.entry=makeint(addr);
411 #if ARM
412  mod->c.ldmod.entry2=makeint(((eusinteger_t)initfunc)&0x3);
413 #endif
414  mod->c.ldmod.subrtype=SUBR_FUNCTION;
415  (*initfunc)(ctx, 1, &mod); }
416  else if (debug) fprintf(stderr,";; no initializer\n");
417  return(vpop()); /* return the module */
418  }
419 
420 
421 pointer SAVE(ctx,n,argv)
422 register context *ctx;
423 int n;
424 pointer argv[];
425 { error(E_USER,(pointer)"SAVE is not supported on Solaris");}
426 
427 
428 void loadsave(ctx,mod)
429 register context *ctx;
430 pointer mod;
431 { pointer p=Spevalof(PACKAGE);
432  pointer_update(Spevalof(PACKAGE),syspkg);
433  defun(ctx,"SRCLOAD",mod,SRCLOAD,NULL);
434 #if Solaris2 && !GCC
435  defun(ctx,"LIST-MODULE-INITIALIZERS",mod,list_module_initializers,NULL);
436 #else
437  defun(ctx,"LIST-MODULE-INITIALIZERS",mod,list_module_initializers2,NULL);
438 #endif
439  defun(ctx,"FIND-ENTRY", mod, FIND_ENTRY,NULL);
440  defun(ctx,"FIND-ENTRY2", mod, FIND_ENTRY2,NULL);
441  defun(ctx,"SYSMOD", mod, SYSMOD,NULL);
442  defun(ctx,"BINLOAD",mod,BINLOAD,NULL);
443  defun(ctx,"UNBINLOAD",mod,UNBINLOAD,NULL);
444  defun(ctx,"SAVE",mod,SAVE,NULL);
445  pointer_update(Spevalof(PACKAGE),p);}
446 
447 
ldmodule::subrtype
pointer subrtype
Definition: eus.h:252
FIND_ENTRY2
pointer FIND_ENTRY2(context *ctx, int n, argv)
Definition: loadelf.c:324
NIL
pointer NIL
Definition: eus.c:110
mkstream
pointer mkstream(context *, pointer, pointer)
Definition: makes.c:241
l
long l
Definition: structsize.c:3
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
BINLOAD
pointer BINLOAD(context *ctx, int n, pointer *argv)
Definition: loadelf.c:369
module_name
char * module_name
Definition: loadelf.c:82
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
s
short s
Definition: structsize.c:2
PACKAGE
pointer PACKAGE
Definition: eus.c:110
add_module_initializer
void add_module_initializer(char *name, pointer(*entry)())
Definition: loadelf.c:86
UNBINLOAD
pointer UNBINLOAD(context *ctx, int n, pointer *argv)
Definition: loadelf.c:353
makevector
pointer makevector(pointer, int)
Definition: makes.c:417
openfile
pointer openfile()
ldmodule::entry2
pointer entry2
Definition: eus.h:255
T
pointer T
Definition: eus.c:110
pointer
struct cell * pointer
Definition: eus.h:165
SAVE
pointer SAVE(context *ctx, int n, argv)
Definition: loadelf.c:421
makestring
pointer makestring(char *, int)
Definition: makes.c:147
exec_module_initializers
void exec_module_initializers(context *ctx)
Definition: loadelf.c:97
C_VECTOR
pointer C_VECTOR
Definition: eus.c:144
module_initializers
struct @15 module_initializers[MAX_SYSTEM_MODULES]
makebuffer
pointer makebuffer(int)
Definition: makes.c:140
string::chars
byte chars[1]
Definition: eus.h:212
cell::c
union cell::cellunion c
rcsid
static char * rcsid
Definition: loadelf.c:9
reader
pointer reader(context *, pointer, pointer)
Definition: reader.c:1016
cell::cellunion::ldmod
struct ldmodule ldmod
Definition: eus.h:410
FIND_ENTRY
pointer FIND_ENTRY(context *ctx, int n, argv)
Definition: loadelf.c:303
STDOUT
pointer STDOUT
Definition: eus.c:119
E_OPENFILE
@ E_OPENFILE
Definition: eus.h:958
NULL
#define NULL
Definition: transargv.c:8
stream::tail
pointer tail
Definition: eus.h:278
makemodule
pointer makemodule(context *, int)
Definition: makes.c:486
stream::count
pointer count
Definition: eus.h:277
vector::v
pointer v[1]
Definition: eus.h:301
list_module_initializers
pointer list_module_initializers(context *ctx, pointer initnames)
Definition: loadelf.c:125
d
d
syspkg
pointer syspkg
Definition: eus.c:109
SYSMOD
pointer SYSMOD()
Definition: loadelf.c:350
get_string
byte * get_string()
prinx
pointer prinx(context *, pointer, pointer)
Definition: printer.c:611
ldmodule::codevec
pointer codevec
Definition: eus.h:250
K_IN
pointer K_IN
Definition: eus.c:130
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
ldmodule::handle
pointer handle
Definition: eus.h:259
eval
pointer eval(context *, pointer)
Definition: eval.c:1622
ldmodule::entry
pointer entry
Definition: eus.h:253
cell::cellunion::stream
struct stream stream
Definition: eus.h:405
SRCLOAD
pointer SRCLOAD(context *ctx, int n, argv)
Definition: loadelf.c:41
E_NOLIST
@ E_NOLIST
Definition: eus.h:949
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
entry_func
pointer(* entry_func)()
Definition: loadelf.c:81
ldmodule::objname
pointer objname
Definition: eus.h:258
cell
Definition: eus.h:381
loadsave
void loadsave(context *ctx, pointer mod)
Definition: loadelf.c:428
list_module_initializers2
pointer list_module_initializers2(context *ctx, int n, pointer *argv)
Definition: loadelf.c:197
eusinteger_t
long eusinteger_t
Definition: eus.h:19
closestream
int closestream(pointer)
Definition: eusstream.c:53
stacknlist
pointer stacknlist(context *, int)
Definition: makes.c:129
stream::buffer
pointer buffer
Definition: eus.h:276
terpri
void terpri(pointer)
Definition: printer.c:637
E_USER
@ E_USER
Definition: eus.h:1006
module_count
int module_count
Definition: loadelf.c:79
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
errno
int errno
n
GLfloat n[6][3]
Definition: cube.c:15
sysmod
pointer sysmod
Definition: eus.c:184
eval_c_strings
pointer eval_c_strings(context *ctx, int size, strings)
Definition: loadelf.c:274
ckarg
ckarg(2)
cell::cellunion::str
struct string str
Definition: eus.h:402
build_quote_vector
pointer build_quote_vector(context *ctx, int size, strings)
Definition: loadelf.c:248


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43