mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2025-12-15 15:21:03 -08:00
Rewrite the binary code loader to work with dlopen() instead of dld()
This commit is contained in:
jjgarcia
parent
da1c522cbc
commit
35a9b11d37
9 changed files with 72 additions and 287 deletions
|
|
@ -131,9 +131,6 @@ const struct symbol_info all_symbols[] = {
|
|||
#ifdef PDE
|
||||
{&siVsource_pathname, "*SOURCE-PATHNAME*", CL_SPECIAL},
|
||||
#endif
|
||||
#ifdef RSYM
|
||||
{&siVsymbol_table, "*SYMBOL-TABLE*", CL_SPECIAL},
|
||||
#endif
|
||||
|
||||
/* lwp.c */
|
||||
#ifdef THREADS
|
||||
|
|
|
|||
|
|
@ -322,8 +322,8 @@ ONCE_MORE:
|
|||
#endif CLOS
|
||||
case t_codeblock:
|
||||
obj->cblock.name = Cnil;
|
||||
obj->cblock.start = NULL;
|
||||
obj->cblock.size = 0;
|
||||
obj->cblock.handle = NULL;
|
||||
obj->cblock.entry = NULL;
|
||||
obj->cblock.data = NULL;
|
||||
obj->cblock.data_size = 0;
|
||||
obj->cblock.data_text = NULL;
|
||||
|
|
|
|||
|
|
@ -46,8 +46,5 @@ init_lisp_libs(void)
|
|||
{
|
||||
SYM_VAL(@'*package*') = system_package;
|
||||
SYM_VAL(@'*features*') = CONS(make_keyword("ECLS-MIN"), SYM_VAL(@'*features*'));
|
||||
#ifdef RSYM
|
||||
SYM_VAL(@'si::*symbol_table*') = make_simple_string("SYS:ecls_min.sym");
|
||||
#endif
|
||||
make_si_function("TOP-LEVEL", @si::simple-toplevel);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -403,7 +403,6 @@ BEGIN:
|
|||
#endif CLOS
|
||||
case t_codeblock:
|
||||
mark_object(x->cblock.name);
|
||||
mark_contblock(x->cblock.start, x->cblock.size);
|
||||
if (x->cblock.data) {
|
||||
cl_index i = x->cblock.data_size;
|
||||
cl_object *p = x->cblock.data;
|
||||
|
|
|
|||
90
src/c/load.d
90
src/c/load.d
|
|
@ -29,34 +29,57 @@ cl_object @'si::*load-hooks*';
|
|||
#ifdef PDE
|
||||
cl_object @'si::*source-pathname*';
|
||||
#endif PDE
|
||||
#ifdef RSYM
|
||||
cl_object @'si::*symbol-table*';
|
||||
#endif
|
||||
|
||||
/******************************* ------- ******************************/
|
||||
|
||||
@(defun si::load_binary (filename verbose print)
|
||||
cl_object block;
|
||||
cl_object basename;
|
||||
@
|
||||
/* We need the full pathname */
|
||||
filename = coerce_to_filename(truename(filename));
|
||||
|
||||
/* Try to load shared object file */
|
||||
block = alloc_object(t_codeblock);
|
||||
block->cblock.name = filename;
|
||||
dld(filename->string.self, &block->cblock.start, &block->cblock.size);
|
||||
block->cblock.handle = dlopen(filename->string.self, RTLD_NOW|RTLD_GLOBAL);
|
||||
if (block->cblock.handle == NULL)
|
||||
@(return make_string_copy(dlerror()))
|
||||
|
||||
if (!Null(verbose)) {
|
||||
/* Fist try to call "init_CODE()" */
|
||||
block->cblock.entry = dlsym(block->cblock.handle, "init_CODE");
|
||||
if (block->cblock.entry != NULL)
|
||||
goto GO_ON;
|
||||
|
||||
/* Next try to call "init_FILE()" where FILE is the file name */
|
||||
basename = coerce_to_pathname(filename);
|
||||
basename = @pathname-name(1,basename);
|
||||
basename = @si::string-concatenate(2,
|
||||
make_simple_string("init_"),
|
||||
@string-upcase(1,basename));
|
||||
block->cblock.entry = dlsym(block->cblock.handle, basename->string.self);
|
||||
if (block->cblock.entry == "NULL") {
|
||||
dlclose(block->cblock.handle);
|
||||
@(return make_string_copy(dlerror()))
|
||||
}
|
||||
if (1 || !Null(verbose)) {
|
||||
extern char * heap_start, * heap_end;
|
||||
setupPRINT(filename, symbol_value(@'*standard-output*'));
|
||||
write_str(";;; Address = ");
|
||||
PRINTescape = FALSE;
|
||||
write_addr(block->cblock.start);
|
||||
write_addr(block->cblock.handle);
|
||||
write_str(", heap = ");
|
||||
write_addr(heap_start);
|
||||
write_str(", heap end = ");
|
||||
write_addr(heap_end);
|
||||
write_str("\n");
|
||||
cleanupPRINT();
|
||||
flush_stream(PRINTstream);
|
||||
}
|
||||
/* call the init_code function */
|
||||
#ifdef __mips
|
||||
cacheflush(block->cblock.start, block->cblock.size, BCACHE);
|
||||
#endif __mips
|
||||
#ifdef __NeXT__
|
||||
asm("trap #2"); /* MC68040-specific */
|
||||
#endif __NeXT__
|
||||
read_VV(block, block->cblock.start);
|
||||
@(return Ct)
|
||||
/* Finally, perform initialization */
|
||||
GO_ON:
|
||||
read_VV(block, block->cblock.entry);
|
||||
@(return Cnil)
|
||||
@)
|
||||
|
||||
@(defun si::load_source (filename verbose print)
|
||||
|
|
@ -98,13 +121,14 @@ cl_object @'si::*symbol-table*';
|
|||
}
|
||||
close_stream(strm, TRUE);
|
||||
frs_pop();
|
||||
@(return Cnil)
|
||||
@)
|
||||
|
||||
@(defun load (pathname
|
||||
&key (verbose symbol_value(@'*load-verbose*'))
|
||||
(print symbol_value(@'*load-print*'))
|
||||
(if_does_not_exist @':error')
|
||||
&aux pntype hooks filename function defaults)
|
||||
&aux pntype hooks filename function defaults ok)
|
||||
bds_ptr old_bds_top;
|
||||
@
|
||||
pathname = coerce_to_physical_pathname(pathname);
|
||||
|
|
@ -162,9 +186,12 @@ cl_object @'si::*symbol-table*';
|
|||
unwind(nlj_fr, nlj_tag);
|
||||
}
|
||||
if (Null(function))
|
||||
@si::load-source(3, filename, verbose, print);
|
||||
ok = @si::load-source(3, filename, verbose, print);
|
||||
else
|
||||
funcall(4, function, filename, verbose, print);
|
||||
ok = funcall(4, function, filename, verbose, print);
|
||||
if (!Null(ok))
|
||||
FEerror("LOAD: Could not load file ~S (Error: ~S)",
|
||||
2, filename, ok);
|
||||
frs_pop();
|
||||
bds_unwind(old_bds_top);
|
||||
if (print != Cnil) {
|
||||
|
|
@ -182,26 +209,6 @@ cl_object @'si::*symbol-table*';
|
|||
@)
|
||||
|
||||
|
||||
/* ----------------------------------------------------------------------
|
||||
* Binary file loader utilities
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
#ifdef RSYM
|
||||
static int symbol_table_built = 0;
|
||||
extern int read_special_symbols(const char *);
|
||||
void
|
||||
build_symbol_table()
|
||||
{
|
||||
cl_object file;
|
||||
const char *tmpfile;
|
||||
file = coerce_to_filename(SYM_VAL(@'si::*symbol-table*'));
|
||||
tmpfile = file->string.self;
|
||||
if (!symbol_table_built)
|
||||
if (read_special_symbols(tmpfile) < 0)
|
||||
FEerror("Could not read symbol table from ~A", 1, make_string_copy(tmpfile));
|
||||
}
|
||||
#endif
|
||||
|
||||
/* ---------------------------------------------------------------------- */
|
||||
#if 0
|
||||
|
||||
|
|
@ -237,12 +244,11 @@ init_load(void)
|
|||
load_source = make_si_ordinary("LOAD-SOURCE");
|
||||
load_binary = make_si_ordinary("LOAD-BINARY");
|
||||
SYM_VAL(@'si::*load-hooks*') = list(4,
|
||||
CONS(make_simple_string("o"), load_binary),
|
||||
CONS(make_simple_string("so"), load_binary),
|
||||
CONS(make_simple_string("lsp"), load_source),
|
||||
CONS(make_simple_string("lisp"), load_source),
|
||||
CONS(Cnil, load_source));
|
||||
|
||||
#ifdef RSYM
|
||||
SYM_VAL(@'si::*symbol-table*') = make_simple_string("SYS:ecls.sym");
|
||||
#endif
|
||||
if (dlopen(NULL, RTLD_NOW|RTLD_GLOBAL) == NULL)
|
||||
printf(";;; Error dlopening self file\n;;; Error: %s\n", dlerror());
|
||||
}
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ static cl_object SVinterrupt_enable;
|
|||
|
||||
#ifndef THREADS
|
||||
|
||||
void
|
||||
static void
|
||||
sigalrm(void)
|
||||
{
|
||||
if (interrupt_flag) {
|
||||
|
|
@ -92,7 +92,7 @@ sigint()
|
|||
|
||||
#endif /*THREADS */
|
||||
|
||||
void
|
||||
static void
|
||||
sigfpe(void)
|
||||
{
|
||||
signal(SIGFPE, sigfpe);
|
||||
|
|
|
|||
|
|
@ -429,7 +429,6 @@ extern cl_object clLrassoc_if_not _ARGS((int narg, cl_object pred, cl_object arg
|
|||
|
||||
extern cl_object Kverbose;
|
||||
extern cl_object clVload_verbose, clVload_print;
|
||||
extern cl_object siVsymbol_table;
|
||||
extern cl_object siVload_hooks;
|
||||
extern cl_object clLload _ARGS((int narg, cl_object pathname, ...));
|
||||
extern cl_object siLload_source _ARGS((int narg, cl_object file, cl_object verbose,
|
||||
|
|
|
|||
245
src/h/machines.h
245
src/h/machines.h
|
|
@ -71,12 +71,6 @@
|
|||
# define unix
|
||||
#endif
|
||||
|
||||
#ifdef MSDOS
|
||||
# define RSYM rsym.exe
|
||||
#elif !defined(__NeXT) && !defined(NeXT) /* cpp (configure) only defines NeXT */
|
||||
# define RSYM rsym
|
||||
#endif
|
||||
|
||||
#if defined(unix) && !defined(__MACH__)
|
||||
# define NEED_MALLOC
|
||||
#endif
|
||||
|
|
@ -154,39 +148,27 @@
|
|||
|
||||
/***********************************************************************/
|
||||
|
||||
#ifdef apollo
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 3
|
||||
#define BSD
|
||||
#define COFF
|
||||
#define BRAND "HP"
|
||||
#endif apollo
|
||||
|
||||
#ifdef __FreeBSD__
|
||||
#include <dlfcn.h>
|
||||
#define IEEEFLOAT
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 4
|
||||
#ifdef __ELF__
|
||||
# define ELF
|
||||
# define UNEXEC unexelf
|
||||
# define DATA_START 0x8000000
|
||||
# define LDFLAGS -static
|
||||
#else
|
||||
# define DATA_START 0
|
||||
# define AOUT <a.out.h>
|
||||
#endif
|
||||
#define BRAND "IBM-PC"
|
||||
#define CLIBS -lcompat
|
||||
#define LDFLAGS -static
|
||||
#define LDFLAGS -Wl,--export-dynamic
|
||||
#define HAVE_ISOC99
|
||||
#ifdef __ELF__
|
||||
# define DATA_START 0x8000000
|
||||
#else
|
||||
# define DATA_START 0
|
||||
#endif
|
||||
#ifndef unix
|
||||
#define unix
|
||||
#endif
|
||||
#endif __FreeBSD__
|
||||
|
||||
#ifdef __NetBSD__
|
||||
#include <dlfcn.h>
|
||||
#define IEEEFLOAT
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 4
|
||||
|
|
@ -197,228 +179,33 @@
|
|||
# define unix
|
||||
#endif
|
||||
#ifdef __ELF__
|
||||
# define ELF
|
||||
# define DATA_START 0x8000000
|
||||
#else
|
||||
#error "A.out not yet supported in NetBSD"
|
||||
# define AOUT <a.out.h>
|
||||
# define DATA_START 0
|
||||
#endif
|
||||
#define BRAND "IBM-PC"
|
||||
#define CLIBS -lcompat
|
||||
#define LDFLAGS -static
|
||||
#define LDFLAGS
|
||||
#endif __NetBSD__
|
||||
|
||||
#ifdef hp9000s300
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 14
|
||||
#define SYSV
|
||||
#define AOUT <a.out.h>
|
||||
#define BRAND "HP"
|
||||
#define CFLAGS +Ns2000 +Nd2000
|
||||
#endif hp9000s300
|
||||
|
||||
#ifdef hp9000s800
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0x40000000
|
||||
#undef DOWN_STACK
|
||||
#define JB_SP 14
|
||||
#define SYSV
|
||||
#define COFF
|
||||
#define UNEXEC unexhp9k800
|
||||
#define BRAND "HP"
|
||||
#endif hp9000s800
|
||||
|
||||
#ifdef IBMRT
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0x20000000
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 0
|
||||
#define BSD
|
||||
#define AOUT <a.out.h>
|
||||
#define BRAND "IBM"
|
||||
#endif IBMRT
|
||||
|
||||
#ifdef __linux__
|
||||
#define IEEEFLOAT
|
||||
#define DOWN_STACK
|
||||
#define BSD
|
||||
#ifdef __ELF__
|
||||
# define ELF
|
||||
# define UNEXEC unexelf
|
||||
# define DATA_START 0x8000000
|
||||
# define LDFLAGS -static
|
||||
#else
|
||||
# define DATA_START 0
|
||||
# define AOUT <a.out.h>
|
||||
#endif
|
||||
#define BRAND "IBM-PC"
|
||||
#define HAVE_ISOC99
|
||||
#define HAVE_POSIX
|
||||
#ifndef unix
|
||||
#define unix
|
||||
#endif
|
||||
#endif linux
|
||||
|
||||
#ifdef mips_dec
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0xA00000 /* normally 0x10000000 */
|
||||
#define DOWN_STACK
|
||||
/* #define JB_SP 32 */
|
||||
#define BSD
|
||||
#define COFF
|
||||
#define ECOFF
|
||||
#define UNEXEC unexelf
|
||||
#define BRAND "DEC"
|
||||
#define LDFLAGS -Wl,-D -Wl,A00000
|
||||
#define ILDFLAGS -T 0 -d -N
|
||||
#define LSPCFLAGS -G 0
|
||||
#endif mips_dec
|
||||
|
||||
#ifdef NEWS
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define BSD
|
||||
#define AOUT <a.out.h>
|
||||
#define BRAND "SONY"
|
||||
#endif NEWS
|
||||
|
||||
#ifdef __NeXT
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
/* #define JB_SP 2 in <setjmp.h> */
|
||||
/* #define BSD is in <param.h> */
|
||||
#define UNEXEC unexnext
|
||||
#define DLD dldNeXT
|
||||
#define BRAND "NeXT"
|
||||
#define LDFLAGS -seglinkedit -segprot __TEXT rwx rwx
|
||||
#define CLIBS -lsys_s
|
||||
#undef AOUT
|
||||
#endif
|
||||
|
||||
#ifdef MSDOS
|
||||
#include "dos.h"
|
||||
#define IEEEFLOAT
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 3
|
||||
#define BSD
|
||||
#ifdef __GO32__
|
||||
# define DATA_START 0
|
||||
# define COFF
|
||||
#else /* __EMX__ */
|
||||
# define DATA_START 0x20000 /* 2 * SEGMENT_SIZE */
|
||||
# define AOUT <a_out.h>
|
||||
# define LDFLAGS -Zbsd-signals
|
||||
#endif __GO32__
|
||||
#define BRAND "IBM-PC"
|
||||
#endif MSDOS
|
||||
|
||||
#ifdef OMRON
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define SYSV
|
||||
#define COFF
|
||||
#define BRAND "OMRON"
|
||||
#endif OMRON
|
||||
|
||||
#ifdef SEQ
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define BSD
|
||||
#define AOUT <a.out.h>
|
||||
#define BRAND "SEQUENT"
|
||||
#endif SEQ
|
||||
|
||||
#ifdef sgi
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0xA00000 /* normally 0x10000000 */
|
||||
#define DOWN_STACK
|
||||
/* #define JB_SP 32 */
|
||||
#define BSD
|
||||
#define BRAND "SGI"
|
||||
#define _BSD_SIGNALS
|
||||
#define LDFLAGS -Wl,-D -Wl,A00000
|
||||
#define ILDFLAGS -T 0 -d -N
|
||||
#define LSPCFLAGS -G 0
|
||||
# ifdef SVR3 /* Irix Release 4 */
|
||||
#define COFF
|
||||
#define ECOFF
|
||||
#define UNEXEC unexmips
|
||||
# else
|
||||
#define ELF
|
||||
#define UNEXEC unexelfsgi
|
||||
# endif
|
||||
#endif sgi
|
||||
|
||||
#ifdef sun
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define BSD
|
||||
#define BRAND "SUN"
|
||||
#define LDFLAGS -Wl,-Bstatic
|
||||
#define LDFLAGS
|
||||
|
||||
#ifdef sun4sol2
|
||||
# define ELF
|
||||
# define UNEXEC unexelf
|
||||
#elif defined(sun386)
|
||||
# define COFF
|
||||
# include <dlfcn.h>
|
||||
# include <link.h>
|
||||
#ifdef TCP
|
||||
# define CLIBS -lsocket -lnsl -lintl -ldl
|
||||
#else
|
||||
# define AOUT <a.out.h>
|
||||
# define CLIBS -ldl
|
||||
#endif
|
||||
|
||||
#ifdef mc68000
|
||||
# define JB_SP 14
|
||||
#elif defined(sparc)
|
||||
# define JB_SP 1
|
||||
# define JB_FP 3
|
||||
#elif defined(i386)
|
||||
# define JB_SP 2
|
||||
#endif
|
||||
|
||||
#ifdef sun4
|
||||
# define SETJMP setjmpsparc.s
|
||||
# define sigsetjmp(x,y) _setjmp(x)
|
||||
# define siglongjmp(x,y) _longjmp(x,y)
|
||||
#endif
|
||||
|
||||
#if defined(TCP) && defined(sun4sol2)
|
||||
# define CLIBS -lsocket -lnsl -lintl -Wl,-Bdynamic -ldl -Wl,-Bstatic
|
||||
#endif
|
||||
|
||||
#endif sun4sol2
|
||||
#endif sun
|
||||
|
||||
#ifdef TAHOE
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define BSD
|
||||
#define AOUT <a.out.h>
|
||||
#define BRAND "TAHOE"
|
||||
#endif TAHOE
|
||||
|
||||
#ifdef vax
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define JB_SP 13
|
||||
#define BSD
|
||||
#define AOUT <a.out.h>
|
||||
#define BRAND "DEC"
|
||||
#endif vax
|
||||
|
||||
#ifdef __WIN32__
|
||||
#define IEEEFLOAT
|
||||
#define DATA_START 0
|
||||
#define DOWN_STACK
|
||||
#define BSD
|
||||
# define PFI
|
||||
# define UNEXEC unexec
|
||||
#define BRAND "IBM-PC"
|
||||
#endif __WIN32__
|
||||
|
||||
/**********************************************************************/
|
||||
|
|
|
|||
|
|
@ -395,11 +395,11 @@ struct pathname {
|
|||
|
||||
struct codeblock {
|
||||
HEADER;
|
||||
char *start; /* start address of the code */
|
||||
size_t size; /* code size */
|
||||
cl_object *data; /* data vector */
|
||||
void *handle; /* handle returned by dlopen */
|
||||
void *entry; /* entry point */
|
||||
cl_object *data; /* data vector */
|
||||
int data_size;
|
||||
const char *data_text;
|
||||
const char *data_text; /* string with objects to be defined */
|
||||
int data_text_size;
|
||||
#ifdef PDE
|
||||
int source_pathname;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue