← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/load.d

  • Committer: Bazaar Package Importer
  • Author(s): Albin Tonnerre
  • Date: 2008-06-20 18:00:19 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080620180019-7fbz1ln5444vtkkr
Tags: 0.9j-20080306-2ubuntu1
* Enabled unicode support. (Closes: LP #123530)
* Modify Maintainer value to match the DebianMaintainerField specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/load.d
 
1
/* -*- mode: c; c-basic-offset: 8 -*- */
1
2
/*
2
3
    load.d -- Binary loader (contains also open_fasl_data).
3
4
*/
47
48
# endif
48
49
#endif
49
50
 
 
51
#ifndef HAVE_LSTAT
 
52
static void
 
53
symlink(const char *orig, const char *dest)
 
54
{
 
55
}
 
56
#endif
 
57
 
 
58
static cl_object
 
59
copy_object_file(cl_object original)
 
60
{
 
61
        int err;
 
62
        cl_object s, copy = make_constant_base_string("TMP:ECL");
 
63
        copy = si_coerce_to_filename(si_mkstemp(copy));
 
64
#ifdef HAVE_LSTAT
 
65
        err = unlink(copy->base_string.self) ||
 
66
              symlink(original->base_string.self, copy->base_string.self);
 
67
#else
 
68
#if defined(mingw32) || defined(_MSC_VER)
 
69
        err = !CopyFile(original->base_string.self, copy->base_string.self, 0);
 
70
#else
 
71
        err = 1;
 
72
#endif
 
73
#endif
 
74
        if (err) {
 
75
                FEerror("Unable to copy file ~A to ~A", 2, original, copy);
 
76
        }
 
77
        return copy;
 
78
}
 
79
 
50
80
#ifdef ENABLE_DLOPEN
51
81
cl_object
52
 
ecl_library_open(cl_object filename) {
 
82
ecl_library_find(cl_object filename)
 
83
{
 
84
        cl_object libraries = cl_core.libraries;
 
85
        cl_index i;
 
86
        for (i = 0; i < libraries->vector.fillp; i++) {
 
87
                if (ecl_string_eq(libraries->vector.self.t[i]->cblock.name,
 
88
                                  filename))
 
89
                {
 
90
                        return libraries->vector.self.t[i];
 
91
                }
 
92
        }
 
93
        return Cnil;
 
94
}
 
95
 
 
96
cl_object
 
97
ecl_library_open(cl_object filename, bool force_reload) {
53
98
        cl_object block;
54
99
        cl_object libraries = cl_core.libraries;
55
100
        bool self_destruct = 0;
56
101
        cl_index i;
57
 
#ifdef HAVE_LSTAT
58
 
        for (i = 0; i < libraries->vector.fillp; i++) {
59
 
                if (ecl_string_eq(libraries->vector.self.t[i]->cblock.name, filename)) {
60
 
                        cl_object copy = make_constant_base_string("TMP:ECL");
61
 
                        copy = si_coerce_to_filename(si_mkstemp(copy));
62
 
                        unlink(copy->base_string.self);
63
 
                        symlink(filename->base_string.self, copy->base_string.self);
64
 
                        filename = copy;
 
102
        if (!force_reload) {
 
103
                /* When loading a foreign library, such as a dll or a
 
104
                 * so, it cannot contain any executable top level
 
105
                 * code. In that case force_reload=0 and there is no
 
106
                 * need to reload it if it has already been loaded. */
 
107
                block = ecl_library_find(filename);
 
108
                if (!Null(block)) {
 
109
                        return block;
 
110
                }
 
111
        } else {
 
112
                /* We are using shared libraries as modules and
 
113
                 * force_reload=1.  Here we have to face the problem
 
114
                 * that many operating systems do not allow to load a
 
115
                 * shared library twice, even if it has changed. Hence
 
116
                 * we have to make a unique copy to be able to load
 
117
                 * the same FASL twice. In Windows this copy is
 
118
                 * _always_ made because otherwise it cannot be
 
119
                 * overwritten. In Unix we need only do that when the
 
120
                 * file has been previously loaded. */
 
121
#if defined(mingw32) || defined(_MSC_VER)
 
122
                filename = copy_object_file(filename);
 
123
#else
 
124
                block = ecl_library_find(filename);
 
125
                if (!Null(block)) {
 
126
                        filename = copy_object_file(filename);
65
127
                        self_destruct = 1;
66
128
                }
 
129
#endif
67
130
        }
68
 
#endif
69
131
        block = cl_alloc_object(t_codeblock);
70
132
        block->cblock.self_destruct = self_destruct;
71
133
        block->cblock.name = filename;
268
330
        CL_UNWIND_PROTECT_BEGIN {
269
331
#endif
270
332
        /* Try to load shared object file */
271
 
        block = ecl_library_open(filename);
 
333
        block = ecl_library_open(filename, 1);
272
334
        if (block->cblock.handle == NULL) {
273
335
                output = ecl_library_error(block);
274
336
                goto OUTPUT;
427
489
        if (!Null(function)) {
428
490
                ok = funcall(4, function, filename, verbose, print);
429
491
        } else {
430
 
#ifdef ENABLE_DLOPEN
 
492
#if 0 /* defined(ENABLE_DLOPEN) && !defined(mingw32) && !defined(_MSC_VER)*/
 
493
                /*
 
494
                 * DISABLED BECAUSE OF SECURITY ISSUES!
 
495
                 * In systems where we can do this, we try to load the file
 
496
                 * as a binary. When it fails, we will revert to source
 
497
                 * loading below. Is this safe? Well, it depends on whether
 
498
                 * your op.sys. checks integrity of binary exectables or
 
499
                 * just loads _anything_.
 
500
                 */
431
501
                if (not_a_filename) {
432
502
                        ok = Ct;
433
503
                } else {