mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-02-24 15:50:36 -08:00
Code Issues Projects Releases Packages Wiki Activity

Bunch of fixes to allow loaded files to be garbage collected. New file naming conventions.

Browse source
This commit is contained in:
jjgarcia 2003-10-06 09:40:32 +00:00
parent b9259ebf6c
commit e3473825d2
22 changed files with 278 additions and 443 deletions
Download patch file Download diff file Expand all files Collapse all files

274
src/CHANGELOG
View file

@ -1162,266 +1162,6 @@ ECL 0.8
operator. Complain when user tries to redefine a special operator
as a function.
ECLS 0.9
========
* Errors fixed:
- The PCL relied on the compiler to optimize certain method
combinations. However, the native compiler is not always present,
and therefore it is safer to use interpreted functions instead.
- The compiler had wrong type information about CHAR-NAME &
NAME-CHAR.
- DOTIMES fails with negative bignums and floats.
- LOAD-TIME-VALUE should be a special operator.
- COPY-SYMBOL fails with uninterned symbols.
- GENSYM and GENTEMP failed if the suffix becomes a bignum.
- COMPILE has to generate libraries with different names for each
function. Otherwise, when compiling a second function, the
dlopen() loader will not load the library because it thinks it has
it already in memory.
- When a compound form consists only of a string, this string should
not be interpreted as a documentation string, but as a form.
- SYMBOL-MACROLET definitions were ignored by GET-SETF-EXPANSION.
- DESTRUCTURING-BIND fails to interpret &WHOLE arguments.
- The compiler might get into an infinite loop when dealing with
compiler-macros.
- When the functions/macros in a DLL are no longer used, and the
garbage collector notices this, the library is properly deallocated.
- BIT-* fails when the input is made of arrays with rank <> 1.
- A few leaks from ECL's original garbage collector have been
fixed. Thus, the option "--disable-boehm" at configuration time is
again active.
- When returning from a function, the values are stored in the
VALUES() array. This process has to be "atomic", in the sense that
no lisp function (cl_*, si_*, bytecodes) may be called, because
they also try to overwrite these values. This requirement was not
accomplished by the previous inliner.
- CCASE forms would output no value.
- Tags in TAGBODY should be compared with EQL so that a bignums may
tags (Two bignums which are EQL may be not EQ!).
- Various errors in STRING-TRIM* and *CAPITALIZE.
- Wrong type information about NAME-CHAR, CHAR-NAME and DIGIT-CHAR
lead to compilation errors.
- DEFPACKAGE would ignore the value of :INTERN and, would replace
empty :USE statements with (:USE "CL").
- :CONC-NAME alone is not interpreted as a lack of prefix in
structures. Furthermore, when no prefix is given, the package of
the slot name is not honored.
- MAP-INTO did not recognize strings and bit-vectors as vectors.
- In WITH-PACKAGE-ITERATOR, only symbols which are accessible in the
current package should be output, and the accesibility type returned
should correspond to that of FIND-SYMBOL.
- The expansion of DO/DO* would not enclose the body in a TAGBODY.
- SLOT-EXISTS-P outputted OBJNULL when the slot did not exist.
* Errors of the interpreter:
- CASE should use EQL to compare objects, not EQ.
- Empty PROGN and implicit PROGNs (LAMBDA, etc) should output NIL
instead of (VALUES). Similarly, a CASE with no matching clause
should also output NIL.
- A NIL in the keys position of a CASE clause can never match
anything: (CASE () (NIL 'A) (T 'B)) => B
- SETQ can only output one value
- User could not have a keyword variable with name ALLOW-OTHER-KEYS,
as in (LAMBDA (&KEY ALLOW-OTHER-KEYS) (PRINT ALLOW-OTHER-KEYS)).
- Excesive arguments to NOT or NULL were not detected.
- Under some circumstances, FUNCALL would not signal an error when
a symbol naming a macro is passed as a first argument.
- When &ALLOW-OTHER-KEYS was present in the lambda list, any
occurrence of :ALLOW-OTHER-KEYS is ignored.
* Visible changes:
- No "Bye" message in QUIT.
- Function definitions from the interpreter are now remembered by
default. This means you can now type
(DEFUN MY-FUNCTION (X) (COS X))
and later on
(COMPILE 'MY-FUNCTION)
If you want to save memory, use this to forget these definitions
(SETQ SI::*KEEP-DEFINITIONS* NIL)
- New function SI:MKSTEMP creates an totally new empty file by
appending a 6-characters prefix to a template supplied by the
user.
- COMPILE now creates all temporary files in the directory pointed
to by the environment variable TMPDIR (Or /tmp if none). It also
uses MKSTEMP to produce unique file names, and solve the problem
that dlopen() cannot reload two libraries with the same name.
- The interpreter now detects syntax errors in function calls: such
as in (setq a ("foo")).
- Functions remf(), remprop() and putprop() removed. Use si_rem_f,
cl_remprop and cl_putprop instead.
- A small optimization allows the compiler to produce smaller code
when two functions share the same keywords (Like FIND, POSITION,
etc).
* ANSI compatibility:
- WITH-HASH-TABLE-ITERATOR implemented.
- In DEFGENERIC, only SPACE and SPEED declarations were allowed.
- The bytecodes compiler did not contemplate the possibility of
a lambda list with &key and no keyword variables.
- In MAKE-PATHNAME, values which are supplied (even if NIL), are not
overwritten by the :DEFAULTS. For instance, (MAKE-PATHNAME :TYPE
NIL :DEFAULTS "FOO.LISP") => #P"FOO"
- INVOKE-DEBUGGER now uses the value of *DEBUGGER-HOOK*.
- Implemented LEAST-*-NORMALIZED-*-FLOAT.
- WITH-PACKAGE-ITERATOR implemented. LOOP clauses which iterate over
the symbols of a package now work. Furthermore, LOOP... FOR
PRESENT-SYMBOL... now iterates both over internal and external
symbols, just to be conformant with other implementations.
- COMPILE should output three values: the function itself, plus two
flags indicating the existence of errors.
- CONSTANTP takes two arguments, the second being an environment.
- Implemented FUNCTION-LAMBDA-EXPRESSION (Replaces non-standard
SI::COMPILED-FUNCTION-SOURCE).
- Right evaluation order enforced in PUSH, PUSHNEW, PSETQ.
- In FUNCALL, the interpreter evaluated the function form *after*
the arguments.
- (SETF #:GXXX), where #:GXXX is any uninterned symbol, should be a
valid function name.
- Symbol GC moved from the COMMON-LISP package, to SI and CL-USER.
- DELETE-PACKAGE turns a package into an illegal object. Thus, if a
reference to the package is around, this may cause problems.
- *CASE and *TYPECASE now use condition & restarts for signaling errors.
- Restarts may be associated to conditions. WITH-CONDITION-RESTART
implemented.
- *COMPILE-FILE-{PATHNAME,TRUENAME}* defined and used.
- All package function now signal errors of type
PACKAGE-ERROR. Also, when trying to operate on a locked package
(See SI::PACKAGE-LOCK), a correctable error is signaled.
- Errors in LOOP macro are signaled as PROGRAM-ERROR.
- When a LOOP has a NAMED sentence, no enclosing NIL block is
produced. Furthermore, the blocks always surround the whole of the
code, so that (LOOP FOR A IN (RETURN :GOOD)) works.
- Character names ("Return", "Tab", etc) now have the right case.
- CHAR/= and CHAR-NOT-EQUAL require at least one character.
- Implemented *PRINT-READABLY*, and the condition PRINT-NOT-READABLY.
- Implemented type EXTENDED-CHAR.
- Property lists are no longer used to store vital
information. Things like SETF expansions, DEFTYPEs, etc, are now
stored and retrieved using SI::{GET,PUT,REM}-SYSPROP. The current
implementation is based on a hash table, which means that some
symbols may not be garbage collected.
- New condition types PARSE-ERROR, SIMPLE-READER-ERROR and READER-ERROR. The
errors from the reader correspond to this later type.
- LOOP macro now accepts LOOP-FOR-BY forms, and it better supports
destructuring (Thanks to the CMUCL team for maintaining a reasonably
portable LOOP!).
- SLOT-UNBOUND now effectively signals an UNBOUND-SLOT condition.
- In structure constructors, lambda variables should not have the
name of slot names. This avoids problems with slots that whose
name is also a special variable or a constant.
- MAKE-SEQUENCE, CONCATENATE, etc (All sequence functions), now
recognize more sequence types and also signal errors when the type
denotes a length and the sequence does not match it.
- COERCE recognizes more types, and also signals an error in most
cases in which the output does not match the required type (For
instance, (COERCE 1 '(INTEGER 2 3)).
- Implemented ARRAY-DISPLACEMENT.
- BOA-constructors for structures should now work as expected (Among
other things, they now support &KEY arguments).
- DELETE and REMOVE now accept negative values of :COUNT.
- SHADOW should work with strings/lists of strings, instead of only
with symbols.
- STRUCTURE-OBJECT is now a STRUCTURE-CLASS.
- DELETE-PACKAGE and MAKE-PACKAGE now signal the right type of errors.
- When a handler refuses to process a condition, the remaining
handlers are processed.
- Both the compiler and the interpreter now properly handle function
names of the form (SETF fname). Instead of creating an uninterened
a symbol with the name "SETF fname", the function definition is
stored directly as a property list.
- In destructuring lambda lists, &WHOLE may be accompanied by a
destructuring form.
- In DEF{CLASS,CONDITION}, arguments to the :INITFORM option, or to
the :DEFAULT-INITARGS option, are now properly evaluated in the
lexical environment corresponding to the DEF{CLASS,CONDITION} form.
- Structures may now have :TYPE (VECTOR BIT), (VECTOR CHARACTER),
etc. That sequence type is used, rather than the general one
(VECTOR T). (:TYPE option from slots is not used, though).
ECL 0.9
=======
@ -1852,6 +1592,15 @@ ECL 0.9c
from pure lists, to lisp structures, and the routines for handling
them have now more meaningful names.
- In different systems, dlopen() handles files with name "lib*.so"
differently, causing ECL to crash. To avoid this problem, compiled
code that can be dynamically loaded has the extension "fas".
- COMPILE-FILE-PATHNAME now acquires the functionality of
SHARED-LIBRARY-PATHNAME and STATIC-LIBRARY-PATHNAME, and it
provides information about the usual name conventions for
executables, libraries, object files, C files, etc.
* Errors fixed:
- The compiler was too eager when replacing variables, so that
@ -1867,6 +1616,11 @@ ECL 0.9c
- Fix a bug that prevented ECL from compiling under CYGWIN.
- Remove spurious references that prevented loaded libraries to be
garbage collected. Unfortunately, this also means that the
Boehm-Weiser garbage collector cannot scan the data sections of
any libraries, and that register_root must be used everywhere.
TODO:
=====

15
src/aclocal.m4 vendored
View file

@ -108,9 +108,19 @@ MACHINE_INSTANCE="${host_cpu}"
MACHINE_VERSION="unknown"
ARCHITECTURE=`echo "${host_cpu}" | tr a-z A-Z` # i386 -> I386
### Sometimes the path for finding DLLs must be hardcoded.
AC_SUBST(LDRPATH)dnl Sometimes the path for finding DLLs must be hardcoded.
AC_SUBST(LIBPREFIX)dnl Name components of a statically linked library
AC_SUBST(LIBEXT)
AC_SUBST(SHAREDEXT)dnl Name components of a dynamically linked library
AC_SUBST(SHAREDPREFIX)
AC_SUBST(OBJEXT)dnl These are set by autoconf
AC_SUBST(EXEEXT)
LDRPATH='~*'
AC_SUBST(LDRPATH)
SHAREDEXT='so'
SHAREDPREFIX='lib'
LIBPREFIX='lib'
LIBEXT='a'
case "${host_os}" in
# libdir may have a dollar expression inside
linux*)
@ -142,6 +152,7 @@ case "${host_os}" in
cygwin*)
thehost="cygwin"
shared="no"
SHAREDEXT='dll'
;;
darwin*)
thehost="darwin"

1
src/c/alloc.d
View file

@ -386,6 +386,7 @@ ONCE_MORE:
obj->cblock.data_size = 0;
obj->cblock.data_text = NULL;
obj->cblock.data_text_size = 0;
obj->cblock.links = OBJNULL;
break;
#ifdef ECL_FFI
case t_foreign:

24
src/c/alloc_2.d
View file

@ -35,19 +35,15 @@ finalize(cl_object o, cl_object data)
switch (type_of(o)) {
#ifdef ENABLE_DLOPEN
case t_codeblock:
AGAIN:
/*
printf("\n;;; Freeing library %s \n", o->cblock.name?
o->cblock.name->string.self : "<anonymous>");
*/
cl_mapc(2, @'si::unlink-symbol', o->cblock.links);
if (o->cblock.handle != NULL) {
printf("\n;;; Freeing library %s\n", o->cblock.name?
o->cblock.name->string.self : "<anonymous>");
dlclose(o->cblock.handle);
GC_free(o->cblock.data);
} else {
o = o->cblock.next;
if (o != NULL && o->cblock.handle != NULL)
goto AGAIN;
}
#ifdef ECL_DYNAMIC_VV
/* GC_free(o->cblock.data); */
#endif
break;
#endif
case t_stream:
@ -139,7 +135,7 @@ init_alloc(void)
if (alloc_initialized) return;
alloc_initialized = TRUE;
/* GC_no_dls = 1; */
GC_no_dls = 1;
#if 0
GC_init_explicit_typing();
#endif
@ -196,14 +192,16 @@ stacks_scanner(void)
GC_push_conditional(cl_stack, cl_stack_top,1);
GC_set_mark_bit(cl_stack);
}
if (frs_top && (frs_top >= frs_org)) {
if (frs_top) {
GC_push_conditional(frs_org, frs_top+1,1);
GC_set_mark_bit(frs_org);
}
if (bds_top && (bds_top >= bds_org)) {
if (bds_top) {
GC_push_conditional(bds_org, bds_top+1,1);
GC_set_mark_bit(bds_org);
}
GC_push_all(cl_symbols, cl_symbols + cl_num_symbols_in_core);
GC_push_all(&lex_env, (&lex_env)+1);
#endif
if (NValues)
GC_push_all(Values, Values+NValues+1);

14
src/c/eval.d
View file

@ -107,7 +107,7 @@ cl_apply_from_stack(cl_index narg, cl_object x)
*----------------------------------------------------------------------*/
cl_object
link_call(cl_object sym, cl_objectfn *pLK, int narg, cl_va_list args)
link_call(cl_object sym, cl_objectfn *pLK, cl_object cblock, int narg, cl_va_list args)
{
cl_index sp;
cl_object out, fun = ecl_fdefinition(sym);
@ -134,6 +134,8 @@ link_call(cl_object sym, cl_objectfn *pLK, int narg, cl_va_list args)
make_unsigned_integer((cl_index)*pLK)),
si_get_sysprop(sym, @'si::link-from')));
*pLK = fun->cfun.entry;
cblock->cblock.links =
CONS(sym, cblock->cblock.links);
}
out = APPLY(narg, fun->cfun.entry, cl_stack + sp);
}
@ -169,9 +171,13 @@ si_unlink_symbol(cl_object s)
FEtype_error_symbol(s);
pl = si_get_sysprop(s, @'si::link-from');
if (!endp(pl)) {
for (; !endp(pl); pl = CDR(pl))
*(void **)(fixnnint(CAAR(pl))) = (void *)fixnnint(CDAR(pl));
cl_remprop(s, @'si::link-from');
for (; !endp(pl); pl = CDR(pl)) {
cl_object record = CAR(pl);
void **location = (void **)fixnnint(CAR(record));
void *original = (void *)fixnnint(CDR(record));
*location = original;
}
si_rem_sysprop(s, @'si::link-from');
}
@(return)
}

55
src/c/gbc.d
View file

@ -200,18 +200,9 @@ BEGIN:
switch ((cl_elttype)x->array.elttype) {
case aet_object:
if (x->array.displaced == Cnil || CAR(x->array.displaced) == Cnil) {
if (x->array.t == t_vector && x->vector.hasfillp)
i = x->vector.fillp;
else
i = x->vector.dim;
i = x->vector.dim;
p = x->array.self.t;
MARK_DATA:
if (p >= heap_start && p < data_end) {
mark_contblock(p, i * sizeof(cl_object));
while (i-- > 0)
mark_object(p[i]);
}
return;
goto MARK_DATA;
}
j = sizeof(cl_object)*x->array.dim;
break;
@ -263,12 +254,8 @@ BEGIN:
case t_structure:
mark_object(x->str.name);
p = x->str.self;
if (p == NULL)
break;
for (i = 0, j = x->str.length; i < j; i++)
mark_object(p[i]);
mark_contblock(p, j*sizeof(cl_object));
break;
i = x->str.length;
goto MARK_DATA;
#endif /* CLOS */
case t_stream:
@ -281,9 +268,9 @@ BEGIN:
case smm_output:
case smm_io:
case smm_probe:
mark_object(x->stream.object0);
mark_object(x->stream.object1);
mark_contblock(x->stream.buffer, BUFSIZ);
mark_object(x->stream.object0);
mark_next(x->stream.object1);
break;
case smm_synonym:
@ -333,10 +320,10 @@ BEGIN:
case t_pathname:
mark_object(x->pathname.host);
mark_object(x->pathname.device);
mark_object(x->pathname.directory);
mark_object(x->pathname.version);
mark_object(x->pathname.name);
mark_object(x->pathname.type);
mark_object(x->pathname.version);
mark_next(x->pathname.directory);
break;
case t_bytecodes:
@ -391,6 +378,13 @@ BEGIN:
mark_next(x->foreign.tag);
break;
#endif ECL_FFI
MARK_DATA:
if (p) {
mark_contblock(p, i * sizeof(cl_object));
while (i-- > 0)
mark_object(p[i]);
}
return;
default:
if (debug)
printf("\ttype = %d\n", type_of(x));
@ -578,11 +572,26 @@ sweep_phase(void)
if (x->d.m == FREE)
continue;
else if (x->d.m) {
/* FIXME!!! Here should come a finalization
procedure for streams */
x->d.m = FALSE;
continue;
}
/* INV: Make sure this is the same as in alloc_2.d */
switch (x->d.t) {
#ifdef ENABLE_DLOPEN
case t_codeblock:
cl_mapc(2, @'si::unlink-symbol', o->cblock.links);
if (o->cblock.handle != NULL) {
printf("\n;;; Freeing library %s\n", o->cblock.name?
o->cblock.name->string.self : "<anonymous>");
dlclose(o->cblock.handle);
}
break;
#endif
case t_stream:
if (o->stream.file != NULL)
fclose(o->stream.file);
o->stream.file = NULL;
}
((struct freelist *)x)->f_link = f;
x->d.m = FREE;
f = x;

6
src/c/load.d
View file

@ -35,6 +35,10 @@ si_load_binary(cl_object filename, cl_object verbose, cl_object print)
cl_object basename;
cl_object prefix;
/* A full garbage collection enables us to detect unused code
and leave space for the library to be loaded. */
si_gc(Ct);
/* We need the full pathname */
filename = coerce_to_filename(cl_truename(filename));
@ -209,7 +213,7 @@ init_load(void)
{
SYM_VAL(@'si::*load-hooks*') = cl_list(
#ifdef ENABLE_DLOPEN
4,CONS(make_simple_string("so"), @'si::load-binary'),
4,CONS(make_simple_string("fas"), @'si::load-binary'),
#else
3,

1
src/c/read.d
View file

@ -1825,6 +1825,7 @@ read_VV(cl_object block, void *entry)
if (block == NULL)
block = cl_alloc_object(t_codeblock);
block->cblock.links = Cnil;
in = OBJNULL;
CL_UNWIND_PROTECT_BEGIN {

17
src/cmp/cmpcfg.lsp.in
View file

@ -3,9 +3,18 @@
;; to the directory with our header files.
;;
(in-package "COMPILER")
(setq compiler::*cc* "@ECL_CC@")
(setq compiler::*cc-flags* "@CFLAGS@ @LSPCFLAGS@")
(setq compiler::*ld-flags* "@LDRPATH@ -lecl @LDFLAGS@ @CLIBS@")
(setq *cc* "@ECL_CC@")
(setq *cc-flags* "@CFLAGS@ @LSPCFLAGS@")
(setq *ld-flags* "@LDRPATH@ -lecl @LDFLAGS@ @CLIBS@")
#+dlopen
(setq compiler::*ld-shared-flags* "@SHARED_LDFLAGS@")
(setq *ld-shared-flags* "@SHARED_LDFLAGS@")
(eval-when (eval)
(setq +shared-library-prefix+ "@SHAREDPREFIX@"
+shared-library-extension+ "@SHAREDEXT@"
+shared-library-format+ "@SHAREDPREFIX@~a.@SHAREDEXT@"
+static-library-prefix+ "@LIBPREFIX@"
+static-library-extension+ "@LIBEXT@"
+static-library-format+ "@LIBPREFIX@~a.@LIBEXT@"
+object-file-extension+ "@OBJEXT@"
+executable-file-format+ "~a@EXEEXT@"))
(load "sys:sysfun.lsp" :verbose nil :print nil)

2
src/cmp/cmpdefs.lsp
View file

@ -23,8 +23,6 @@
"BUILD-PROGRAM"
"BUILD-STATIC-LIBRARY"
"BUILD-SHARED-LIBRARY"
"SHARED-LIBRARY-PATHNAME"
"STATIC-LIBRARY-PATHNAME"
"*SUPPRESS-COMPILER-WARNINGS*"
"*SUPPRESS-COMPILER-NOTES*")
(:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP"))

136
src/cmp/cmpmain.lsp
View file

@ -41,15 +41,6 @@ coprocessor).")
#+dlopen
(defvar *ld-shared-format* "~A ~A -o ~A -L~A ~{~A ~} ~@?")
(eval-when (compile eval)
(defmacro get-output-pathname (file ext)
`(make-pathname
:directory (or (and (or (stringp ,file) (pathnamep ,file))
(pathname-directory ,file))
directory)
:name (if (or (null ,file) (eq ,file T)) name (pathname-name ,file))
:type ,ext)))
(defun safe-system (string)
(print string)
(let ((result (si:system string)))
@ -59,25 +50,22 @@ coprocessor).")
string result))
result))
(defun static-library-pathname (output-file)
(let* ((real-name (format nil "lib~A.a" (pathname-name output-file))))
(merge-pathnames real-name output-file)))
(defun shared-library-pathname (output-file)
#-dlopen
(error "Dynamically loadable libraries not supported in this system.")
#+dlopen
(let* ((real-name (format nil "~A.so" (pathname-name output-file))))
(merge-pathnames real-name output-file)))
(defun compile-file-pathname (name &key output-file system-p)
(let ((extension "o"))
(unless system-p
#+dlopen
(setq extension "so")
#-dlopen
(error "This platform only supports compiling files with :SYSTEM-P T"))
(make-pathname :type extension :defaults (or output-file name))))
(defun compile-file-pathname (name &key (output-file name) (type :fasl))
(let ((format '())
(extension '()))
(case type
((:shared-library :dll) (setf format #.+shared-library-format+))
((:static-library :library :lib) (setf format #.+static-library-format+))
(:data (setf extension "data"))
(:c (setf extension "c"))
(:h (setf extension "h"))
(:object (setf extension #.+object-file-extension+))
(:program (setf format #.+executable-file-format+))
(:fasl (setf extension "fas")))
(if format
(merge-pathnames (format nil format (pathname-name output-file))
output-file)
(make-pathname :type extension :defaults output-file))))
(defun linker-cc (o-pathname &rest options)
(safe-system
@ -137,7 +125,7 @@ extern \"C\"
#endif
int init_~A(cl_object cblock)
{
cl_object next;
cl_object subblock;
if (FIXNUMP(cblock))
return;
cblock->cblock.data = NULL;
@ -145,7 +133,7 @@ int init_~A(cl_object cblock)
cblock->cblock.data_text = \"\";
cblock->cblock.data_text_size = 0;
~A
~{ next = read_VV(OBJNULL,init_~A); next->cblock.next = cblock; cblock = next; ~%~}
~{ subblock = read_VV(OBJNULL,init_~A); subblock->cblock.next = cblock; ~%~}
~A
}")
@ -178,11 +166,11 @@ int init_~A(cl_object cblock)
(push (format nil "-l~A" (string-downcase item)) ld-flags)
(push (init-function-name item) init-name))
(t
(push (namestring (make-pathname :type "o" :defaults item)) ld-flags)
(push (namestring (compile-file-pathname item :type :object)) ld-flags)
(setq item (pathname-name item))
(push (init-function-name item) init-name))))
(setq c-name (namestring (make-pathname :type "c" :defaults output-name))
o-name (namestring (make-pathname :type "o" :defaults output-name)))
(setq c-name (namestring (compile-file-pathname output-name :type :c))
o-name (namestring (compile-file-pathname output-name :type :object)))
(ecase target
(:program
(setq output-name (namestring output-name))
@ -193,26 +181,40 @@ int init_~A(cl_object cblock)
epilogue-code))
(compiler-cc c-name o-name)
(apply #'linker-cc output-name (namestring o-name) ld-flags))
(:static-library
(when (symbolp output-name)
(setq output-name (static-library-pathname output-name)))
((:library :static-library :lib)
(print "***")
(print output-name)
(when (or (symbolp output-name) (stringp output-name))
(print (compile-file-pathname output-name :type :lib))
(setq output-name (compile-file-pathname output-name :type :lib)))
(let ((library-name (string-upcase (pathname-name output-name))))
(unless (equalp (subseq library-name 0 3) "LIB")
(error "Filename ~A is not a valid library name."
output-name))
(print library-name)
(print output-name)
(with-open-file (c-file c-name :direction :output)
(format c-file +lisp-library-main+ init-name
;; Remove the leading "lib"
(subseq library-name 3)
(subseq library-name #.(length +static-library-prefix+))
prologue-code init-name epilogue-code)))
(compiler-cc c-name o-name)
(safe-system (format nil "ar cr ~A ~A ~{~A ~}"
output-name o-name ld-flags))
(safe-system (format nil "ranlib ~A" output-name)))
#+dlopen
(:shared-library
(when (or (symbolp output-name) (not (pathname-type output-name)))
(setq output-name (shared-library-pathname output-name)))
((:shared-library :dll)
(when (or (symbolp output-name) (stringp output-name))
(setq output-name (compile-file-pathname output-name :type :dll)))
(let ((library-name (string-upcase (pathname-name output-name))))
(with-open-file (c-file c-name :direction :output)
(format c-file +lisp-library-main+
init-name
;; Remove the leading lib
(subseq library-name #.(length +shared-library-prefix+))
prologue-code init-name epilogue-code)))
(compiler-cc c-name o-name)
(apply #'shared-cc output-name o-name ld-flags))
(:fasl
(when (or (symbolp output-name) (stringp output-name))
(setq output-name (compile-file-pathname output-name :type :fasl)))
(with-open-file (c-file c-name :direction :output)
(format c-file +lisp-library-main+
init-name "CODE" prologue-code init-name epilogue-code))
@ -225,6 +227,9 @@ int init_~A(cl_object cblock)
(defun build-program (&rest args)
(apply #'builder :program args))
(defun build-module (&rest args)
(apply #'builder :fasl args))
(defun build-static-library (&rest args)
(apply #'builder :static-library args))
@ -234,6 +239,12 @@ int init_~A(cl_object cblock)
#+dlopen
(apply #'builder :shared-library args))
(eval-when (compile eval)
(defmacro get-output-pathname (input-file output-file ext)
`(compile-file-pathname ,input-file
:output-file (if (member ,output-file '(T NIL)) ,input-file ,output-file)
:type ,ext)))
(defun compile-file (input-pathname
&key (output-file 'T)
(verbose *compile-verbose*)
@ -250,7 +261,7 @@ int init_~A(cl_object cblock)
(*print-pretty* nil)
(*error-count* 0)
(*compile-file-pathname* nil)
(*compile-file-trueame* nil)
(*compile-file-truename* nil)
#+PDE sys:*source-pathname*)
(declare (notinline compiler-cc))
@ -292,19 +303,12 @@ Cannot compile ~a."
(let* ((eof '(NIL))
(*load-time-values* nil) ;; Load time values are compiled
(output-default (if (or (eq output-file 'T)
(null output-file))
input-pathname
output-file))
(directory (pathname-directory output-default))
(name (pathname-name output-default))
(o-pathname (get-output-pathname output-file "o"))
(o-pathname (get-output-pathname input-pathname output-file :object))
#+dlopen
(so-pathname (if system-p o-pathname
(get-output-pathname output-file "so")))
(c-pathname (get-output-pathname c-file "c"))
(h-pathname (get-output-pathname h-file "h"))
(data-pathname (get-output-pathname data-file "data")))
(so-pathname (unless system-p (compile-file-pathname o-pathname)))
(c-pathname (get-output-pathname o-pathname c-file :c))
(h-pathname (get-output-pathname o-pathname h-file :h))
(data-pathname (get-output-pathname o-pathname data-file :data)))
(init-env)
@ -435,10 +439,10 @@ Cannot compile ~a."
(return-from compile (values nil t t))))
(let ((*load-time-values* 'values) ;; Only the value is kept
(c-pathname (make-pathname :type "c" :defaults data-pathname))
(h-pathname (make-pathname :type "h" :defaults data-pathname))
(o-pathname (make-pathname :type "o" :defaults data-pathname))
(so-pathname (make-pathname :type "so" :defaults data-pathname)))
(c-pathname (compile-file-pathname data-pathname :type :c))
(h-pathname (compile-file-pathname data-pathname :type :h))
(o-pathname (compile-file-pathname data-pathname :type :object))
(so-pathname (compile-file-pathname data-pathname)))
(init-env)
@ -461,6 +465,7 @@ Cannot compile ~a."
(progn
(when *compile-verbose*
(format t "~&;;; Calling the C compiler... "))
;;(si::system (format nil "cat ~A" (namestring c-pathname)))
(compiler-cc c-pathname o-pathname)
(shared-cc so-pathname o-pathname)
(delete-file c-pathname)
@ -471,7 +476,12 @@ Cannot compile ~a."
(when *compile-verbose* (print-compiler-info))
(delete-file so-pathname)
(delete-file data-pathname)
(values (or name (symbol-value 'GAZONK)) nil nil))
(setf name (or name (symbol-value 'GAZONK)))
;; By unsetting GAZONK we avoid spurious references to the
;; loaded code.
(set 'GAZONK nil)
(si::gc t)
(values name nil nil))
(t (delete-file data-pathname)
(format t "~&;;; The C compiler failed to compile~
~the intermediate code for ~s.~%" name)
@ -588,7 +598,7 @@ Cannot compile ~a."
#+dlopen
(defun load-o-file (file verbose print)
(let ((tmp (make-pathname :type "so" :defaults file)))
(let ((tmp (compile-file-pathname file)))
(shared-cc tmp file)
(when (probe-file tmp)
(load tmp :verbose nil :print nil)
@ -596,7 +606,7 @@ Cannot compile ~a."
nil)))
#+dlopen
(push (cons "o" #'load-o-file) si::*load-hooks*)
(push (cons #.+object-file-extension+ #'load-o-file) si::*load-hooks*)
(defmacro with-compilation-unit (options &rest body)
`(progn ,@body))

2
src/cmp/cmptop.lsp
View file

@ -160,7 +160,7 @@
(dolist (x *linking-calls*)
(let ((i (second x)))
(wt-nl1 "static cl_object LKF" i
"(int narg, ...) {TRAMPOLINK(narg," (third x) ",&LK" i ");}")))
"(int narg, ...) {TRAMPOLINK(narg," (third x) ",&LK" i ",Cblock);}")))
(wt-h "#define compiler_data_text_size " *wt-string-size*)

3
src/cmp/load.lsp.in
View file

@ -1,4 +1,3 @@
(load "@abs_srcdir@/cmpdefs" :verbose nil)
(load "@abs_srcdir@/cmpmac" :verbose nil)
(load "@abs_srcdir@/cmpinline" :verbose nil)
@ -25,6 +24,6 @@
(load "@abs_srcdir@/cmpvar" :verbose nil)
(load "@abs_srcdir@/cmpwt" :verbose nil)
(load "@abs_srcdir@/cmpffi" :verbose nil)
(load "@abs_builddir@/cmpcfg.lsp" :verbose nil)
(load "@abs_srcdir@/cmpmain" :verbose nil)
(load "@abs_srcdir@/sysfun" :verbose nil)
(load "@abs_builddir@/cmpcfg.lsp" :verbose nil)

2
src/compile.lsp.in
View file

@ -69,7 +69,7 @@ cd ..; rm -rf tmp/* liblsp* libclos* "))
(progn
(load "cmp/defsys.lsp")
(proclaim '(optimize (safety 2) (space 3)))
(sbt::operate-on-system cmp #-dlopen :library #+dlopen :shared-library)
(sbt::operate-on-system cmp #-dlopen :library #+dlopen :fasl)
;(sbt::operate-on-system cmp :load)
)

43
src/configure vendored
View file

@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS ECL_VERSION build build_cpu build_vendor build_os host host_cpu host_vendor host_os builddir top_srcdir CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CXX CXXFLAGS ac_ct_CXX CPP RANLIB ac_ct_RANLIB INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA LN_S ECL_CC LSPCFLAGS CLIBS SHARED_LDFLAGS SHORT_SITE_NAME LONG_SITE_NAME EXTRA_OBJS TARGETS TKLIBS SUBDIR LIBRARIES LSP_LIBRARIES BOEHM_HEADERS EGREP CP RM MV EXE_SUFFIX ARCHITECTURE SOFTWARE_TYPE SOFTWARE_VERSION MACHINE_INSTANCE MACHINE_VERSION LDRPATH ECL_SETJMP ECL_LONGJMP CL_FIXNUM_TYPE CL_FIXNUM_BITS CL_FIXNUM_MAX CL_FIXNUM_MIN X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS XINCLUDES XLIBS LIBOBJS LTLIBOBJS'
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS ECL_VERSION build build_cpu build_vendor build_os host host_cpu host_vendor host_os builddir top_srcdir CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CXX CXXFLAGS ac_ct_CXX CPP RANLIB ac_ct_RANLIB INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA LN_S ECL_CC LSPCFLAGS CLIBS SHARED_LDFLAGS SHORT_SITE_NAME LONG_SITE_NAME EXTRA_OBJS TARGETS TKLIBS SUBDIR LIBRARIES LSP_LIBRARIES BOEHM_HEADERS EGREP CP RM MV EXE_SUFFIX ARCHITECTURE SOFTWARE_TYPE SOFTWARE_VERSION MACHINE_INSTANCE MACHINE_VERSION LDRPATH LIBPREFIX LIBEXT SHAREDEXT SHAREDPREFIX ECL_SETJMP ECL_LONGJMP CL_FIXNUM_TYPE CL_FIXNUM_BITS CL_FIXNUM_MAX CL_FIXNUM_MIN X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS XINCLUDES XLIBS LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@ -1303,7 +1303,7 @@ echo "***"
exit 2;
fi
ECL_VERSION=0.9b
ECL_VERSION=0.9c
ac_aux_dir=
@ -3827,9 +3827,15 @@ MACHINE_INSTANCE="${host_cpu}"
MACHINE_VERSION="unknown"
ARCHITECTURE=`echo "${host_cpu}" | tr a-z A-Z` # i386 -> I386
### Sometimes the path for finding DLLs must be hardcoded.
LDRPATH='~*'
LDRPATH='~*'
SHAREDEXT='so'
SHAREDPREFIX='lib'
LIBPREFIX='lib'
LIBEXT='a'
case "${host_os}" in
# libdir may have a dollar expression inside
linux*)
@ -3861,6 +3867,7 @@ case "${host_os}" in
cygwin*)
thehost="cygwin"
shared="no"
SHAREDEXT='dll'
;;
darwin*)
thehost="darwin"
@ -4074,20 +4081,20 @@ mandir="${prefix}/man/man1"
infodir="${prefix}/info"
TARGETS="ecl${EXEEXT}"
LIBRARIES=""
LSP_LIBRARIES="libecl.a"
LSP_LIBRARIES="${LIBPREFIX}ecl.${LIBEXT}"
SUBDIR=c
CLIBS="${CLIBS} -lgmp -lm"
if test ${boehm} = "no" ; then
EXTRA_OBJS="${EXTRA_OBJS} alloc.o gbc.o"
EXTRA_OBJS="${EXTRA_OBJS} alloc.${OBJEXT} gbc.${OBJEXT}"
else
if test ${local_boehm} = "no"; then
LIBRARIES="${LIBRARIES} libgc.a"
LIBRARIES="${LIBRARIES} ${LIBPREFIX}gc.${LIBEXT}"
SUBDIR="${SUBDIR} gc"
BOEHM_HEADERS="-I\$(top_srcdir)/gc/include"
else
BOEHM_HEADERS=""
fi
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.o"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
cat >>confdefs.h <<\_ACEOF
#define GBC_BOEHM 1
_ACEOF
@ -4103,7 +4110,7 @@ else
LDRPATH='~*'
fi
if test ${local_gmp} = "no" ; then
LIBRARIES="${LIBRARIES} libgmp.a"
LIBRARIES="${LIBRARIES} ${LIBPREFIX}gmp.${LIBEXT}"
SUBDIR="${SUBDIR} gmp"
fi
if test ${runtime} ; then
@ -4113,9 +4120,9 @@ _ACEOF
else
if test ${shared} = "yes" ; then
LSP_LIBRARIES="${LSP_LIBRARIES} cmp.so sysfun.lsp"
LSP_LIBRARIES="${LSP_LIBRARIES} cmp.fas sysfun.lsp"
else
LSP_LIBRARIES="${LSP_LIBRARIES} libcmp.a sysfun.lsp"
LSP_LIBRARIES="${LSP_LIBRARIES} ${LIBPREFIX}cmp.${LIBEXT} sysfun.lsp"
fi
fi
if test ${tk} ; then
@ -4127,7 +4134,7 @@ _ACEOF
fi
if test ${clx} ; then
TARGETS="${TARGETS} eclx${EXEEXT}"
LSP_LIBRARIES="${LSP_LIBRARIES} libclx.a"
LSP_LIBRARIES="${LSP_LIBRARIES} ${LIBPREFIX}clx.${LIBEXT}"
cat >>confdefs.h <<\_ACEOF
#define CLX 1
_ACEOF
@ -4138,7 +4145,7 @@ if test "${tcp}" -o "${clx}"; then
#define TCP 1
_ACEOF
EXTRA_OBJS="${EXTRA_OBJS} tcp.o"
EXTRA_OBJS="${EXTRA_OBJS} tcp.${OBJEXT}"
CLIBS="${CLIBS} ${TCPLIBS}"
fi
if test "${oldloop}"; then
@ -4164,10 +4171,10 @@ if test "${ffi}"; then
#define ECL_FFI 1
_ACEOF
EXTRA_OBJS="${EXTRA_OBJS} ffi.o"
EXTRA_OBJS="${EXTRA_OBJS} ffi.${OBJEXT}"
fi
if test "${locative}" ; then
EXTRA_OBJS="${EXTRA_OBJS} unify.o"
EXTRA_OBJS="${EXTRA_OBJS} unify.${OBJEXT}"
cat >>confdefs.h <<\_ACEOF
#define LOCATIVE 1
_ACEOF
@ -4176,7 +4183,7 @@ fi
echo "$as_me:$LINENO: checking Checking for threads support" >&5
echo $ECHO_N "checking Checking for threads support... $ECHO_C" >&6
if test "${threads}" ; then
EXTRA_OBJS="${EXTRA_OBJS} lwp.o"
EXTRA_OBJS="${EXTRA_OBJS} lwp.${OBJEXT}"
cat >>confdefs.h <<\_ACEOF
#define THREADS 1
_ACEOF
@ -6494,6 +6501,10 @@ s,@SOFTWARE_VERSION@,$SOFTWARE_VERSION,;t t
s,@MACHINE_INSTANCE@,$MACHINE_INSTANCE,;t t
s,@MACHINE_VERSION@,$MACHINE_VERSION,;t t
s,@LDRPATH@,$LDRPATH,;t t
s,@LIBPREFIX@,$LIBPREFIX,;t t
s,@LIBEXT@,$LIBEXT,;t t
s,@SHAREDEXT@,$SHAREDEXT,;t t
s,@SHAREDPREFIX@,$SHAREDPREFIX,;t t
s,@ECL_SETJMP@,$ECL_SETJMP,;t t
s,@ECL_LONGJMP@,$ECL_LONGJMP,;t t
s,@CL_FIXNUM_TYPE@,$CL_FIXNUM_TYPE,;t t

26
src/configure.in
View file

@ -31,7 +31,7 @@ exit 2;
fi
dnl Set the version number. This seems the best place to keep it.
ECL_VERSION=0.9b
ECL_VERSION=0.9c
AC_SUBST(ECL_VERSION)
dnl Guess operating system of host. We do not allow cross-compiling.
@ -161,20 +161,20 @@ mandir="${prefix}/man/man1"
infodir="${prefix}/info"
TARGETS="ecl${EXEEXT}"
LIBRARIES=""
LSP_LIBRARIES="libecl.a"
LSP_LIBRARIES="${LIBPREFIX}ecl.${LIBEXT}"
SUBDIR=c
CLIBS="${CLIBS} -lgmp -lm"
if test ${boehm} = "no" ; then
EXTRA_OBJS="${EXTRA_OBJS} alloc.o gbc.o"
EXTRA_OBJS="${EXTRA_OBJS} alloc.${OBJEXT} gbc.${OBJEXT}"
else
if test ${local_boehm} = "no"; then
LIBRARIES="${LIBRARIES} libgc.a"
LIBRARIES="${LIBRARIES} ${LIBPREFIX}gc.${LIBEXT}"
SUBDIR="${SUBDIR} gc"
BOEHM_HEADERS="-I\$(top_srcdir)/gc/include"
else
BOEHM_HEADERS=""
fi
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.o"
EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}"
AC_DEFINE(GBC_BOEHM)
fi
if test ${shared} = "yes"; then
@ -184,16 +184,16 @@ else
LDRPATH='~*'
fi
if test ${local_gmp} = "no" ; then
LIBRARIES="${LIBRARIES} libgmp.a"
LIBRARIES="${LIBRARIES} ${LIBPREFIX}gmp.${LIBEXT}"
SUBDIR="${SUBDIR} gmp"
fi
if test ${runtime} ; then
AC_DEFINE(RUNTIME)
else
if test ${shared} = "yes" ; then
LSP_LIBRARIES="${LSP_LIBRARIES} cmp.so sysfun.lsp"
LSP_LIBRARIES="${LSP_LIBRARIES} cmp.fas sysfun.lsp"
else
LSP_LIBRARIES="${LSP_LIBRARIES} libcmp.a sysfun.lsp"
LSP_LIBRARIES="${LSP_LIBRARIES} ${LIBPREFIX}cmp.${LIBEXT} sysfun.lsp"
fi
fi
if test ${tk} ; then
@ -202,12 +202,12 @@ if test ${tk} ; then
fi
if test ${clx} ; then
TARGETS="${TARGETS} eclx${EXEEXT}"
LSP_LIBRARIES="${LSP_LIBRARIES} libclx.a"
LSP_LIBRARIES="${LSP_LIBRARIES} ${LIBPREFIX}clx.${LIBEXT}"
AC_DEFINE(CLX)
fi
if test "${tcp}" -o "${clx}"; then
AC_DEFINE(TCP)
EXTRA_OBJS="${EXTRA_OBJS} tcp.o"
EXTRA_OBJS="${EXTRA_OBJS} tcp.${OBJEXT}"
CLIBS="${CLIBS} ${TCPLIBS}"
fi
if test "${oldloop}"; then
@ -221,15 +221,15 @@ if test "${closstreams}"; then
fi
if test "${ffi}"; then
AC_DEFINE(ECL_FFI)
EXTRA_OBJS="${EXTRA_OBJS} ffi.o"
EXTRA_OBJS="${EXTRA_OBJS} ffi.${OBJEXT}"
fi
if test "${locative}" ; then
EXTRA_OBJS="${EXTRA_OBJS} unify.o"
EXTRA_OBJS="${EXTRA_OBJS} unify.${OBJEXT}"
AC_DEFINE(LOCATIVE)
fi
AC_MSG_CHECKING(Checking for threads support)
if test "${threads}" ; then
EXTRA_OBJS="${EXTRA_OBJS} lwp.o"
EXTRA_OBJS="${EXTRA_OBJS} lwp.${OBJEXT}"
AC_DEFINE(THREADS)
AC_MSG_RESULT(userland threads)
else

74
src/doc/devel.txi
View file

@ -92,6 +92,7 @@ loadable extensions that you can later on distribute to other people.
* Compiling files::
* Building standalone executables::
* Building libraries::
* File names::
* Compiler examples::
@end menu
@ -111,12 +112,12 @@ portable way, but not the fastest one.
You translate all your lisp code to C using the @ecl{} compiler. The final
object files can be linked against other C/C++ libraries to obtain a standalone
executable.
@item You can build statically linked libraries.
@item You can build statically and dynamically linked libraries.
You translate all your lisp code to C and combine the resulting object files
into a single library with @file{.a} extension. You can distribute this library
to other people and the final users can utilize these libraries to build
standalone programs.
@item You can build dynamically loadable libraries.
@item You can build dynamically loadable files.
This is the most flexible way. You translate all lisp code to C and link it
against possibly other C/C++ libraries to obtain a dynamically loadable library
(file type @file{.so} under unix). This library can be loaded a startup time to
@ -158,18 +159,18 @@ intermediate file is later compiled using a C compiler. The result is an object
file which may have different purposes.
@table @sc
@item dynamically loadable object files
@item Dynamically loadable files or FASL (FASt Loadable) files
These are produced in a @ecl{} built with support for dynamically loadable
libraries (Feature @kwd{DLOPEN} is in @var{*features*}), when no extra
arguments are passed to @code{compile-file}. These object files typically have
the @file{.so} extension, and can be loaded with @code{load}. They cannot be used
the @file{.fas} extension, and can be loaded with @code{load}. They cannot be used
to build libraries nor standalone executable programs.
@item linkable object files
These are produced when invoking @code{compile-file} with the keyword argument
@kwd{system-p} set to true. The object file typically has the @file{.o}
extension. It cannot be loaded with @code{load}, but it can be used to build
libraries or standalone executable programs.
libraries, standalone executable programs, or larger FASL files.
@end table
@c ---------------------------------------------------------------------
@ -205,12 +206,12 @@ empty string, while @var{epilogue-code} invokes the classical lisp
@c ---------------------------------------------------------------------
@node Building libraries, Compiler examples, Building standalone executables, Building programs
@node Building libraries, File names, Building standalone executables, Building programs
@section Building libraries
To build a library you proceed more or less the same way as with standalone
executables. There are two different functions depending on whether you need
to build static or dynamically loadable libraries.
to build static or shared libraries.
@defun {c:build-static-library} {@var{library-name} @keys{} @var{lisp-files} @var{prologue-code} @var{epilogue-code}}
@defunx {c:build-shared-library} {@var{library-name} @keys{} @var{lisp-files} @var{prologue-code} @var{epilogue-code} @var{ld-flags}}
@ -221,8 +222,8 @@ object file produced with @code{compile-file}.
@var{library-name} is the physical pathname corresponding to the library. The
value of @var{library-name} must follow some system-specific conventions. To
make your program portable, @var{library-name} should be built using the output
of @code{c:library-pathname}.
make your program portable, @var{library-name} should be built using the
output of @code{compile-file-pathname}.
@var{prologue-code} and @var{epilogue-code} are strings with C code to be
executed before and after initializing the library, respectively. For
@ -231,25 +232,48 @@ dynamically linked libraries you can also provide a list of strings in
their purpose is to link C/C++ extensions into the library.
@end defun
@defun {c:static-library-pathname} {@var{filename-base}}
@defunx {c:shared-library-pathname} {@var{filename-base}}
@c ----------------------------------------------------------------------
@node File names, Compiler examples, Building libraries, Building programs
@section File names
These function outputs a valid library pathname built using @var{filename-base}
to extract the directory and part of the file name, and using the type of
library to determine the right file type.
@defun {compile-file-pathname} {@var{filename-base} @keys{} @var{output-file} @var{type}}
When compiling lisp files, creating libraries, etc, a number of files are
produced which are of interest for the user or programmer. However, the name
of these files will change from system to system. The purpose of the function
@code{compile-file-pathname} is to query the compiler about the name of the
different files that it can produce. Possible values of the @var{type}
argument include:
@table @sc
@item :fas (default)
Standard compiled files that can be loaded with @code{load}.
@item :c, :data, :h
Intermediate files produced by the Lisp-to-C translator.
@item :o
Linkable object files.
@item :lib, :static-library
A normal library produced with @code{c:build-static-library}.
@item :dll, :shared-library
A dynamically linked librariy produced with @code{c:build-shared-library}.
@item :program
An executable produced with @code{c:build-program}.
@end table
The output of this function is system specific. For example, under FreeBSD
@example
> (c:static-library-pathname "/this/path/mylib")
> (compile-file-pathname "/this/path/mylib" :type :lib)
#P"/this/path/libmylib.a"
> (c:shared-library-pathname "/this/path/mylib")
#P"/this/path/mylib.so"
> (compile-file-pathname "/this/path/mylib" :type :dll)
#P"/this/path/libmylib.so"
> (compile-file-pathname "/this/path/mycode")
#P"/this/path/mycode.fas"
@end example
@end defun
@c ---------------------------------------------------------------------
@node Compiler examples, , Building libraries, Building programs
@node Compiler examples, , File names, Building programs
@section Compiler examples
@subsection The @file{hello.lsp} file
@ -351,7 +375,7 @@ Hello world!
Bye.
@end example
@subsection Example of loadable library
@subsection Combining files into a larger FASL
You can only perform the example in this section if your @ecl{} image supports
dynamically loading of object files. In this example we build a loadable
library which prints the @code{"Hello world!"} message and does nothing
@ -377,18 +401,18 @@ Type :h for Help. Top level.
The final step is to build the library using the @code{c:build-shared-library}
instruction.
@example
> @b{(c:build-shared-library (c:shared-library-pathname "myecl") :lisp-files '("hello.o"))}
> @b{(c:build-fasl "myecl" :lisp-files '("hello.o"))}
"gcc -g -O2 -Dfreebsd -O -I/home/worm/lib/ecl//h -w -c myecl.c -o myecl.o"
"gcc -w -o myecl.so -L/home/worm/lib/ecl/ myecl.o hello.o -lecl -lclos -llsp -lgmp -Wl,--export-dynamic -lgc -lcompat -lgmp -lm"
"myecl.so"
"gcc -w -o myecl.fas -L/home/worm/lib/ecl/ myecl.o hello.o -lecl -lclos -llsp -lgmp -Wl,--export-dynamic -lgc -lcompat -lgmp -lm"
"myecl.fas"
@end example
@noindent
Now you can load this extension from any @ecl{} image, even those you produce
with @code{c:build-program}
with @code{c:build-program}.
@example
> (load (c:shared-library-pathname "myecl"))
;;; Loading myecl.so
> (load "myecl")
;;; Loading myecl.fas
Hello world!
Bye.
@end example

3
src/h/config.h.in
View file

@ -21,6 +21,9 @@
/* Use Boehm's garbage collector */
#undef GBC_BOEHM
#ifdef GBC_BOEHM
#define ECL_DYNAMIC_VV
#endif
/* Userland threads? */
#undef THREADS

4
src/h/ecl-cmp.h
View file

@ -43,6 +43,6 @@
if ((int *)(&narg) < cs_limit) \
cs_overflow()
#define TRAMPOLINK(narg, vv, lk) \
#define TRAMPOLINK(narg, vv, lk, cblock) \
cl_va_list args; cl_va_start(args, narg, narg, 0); \
return(link_call(vv, (cl_objectfn *)lk, narg, args))
return(link_call(vv, (cl_objectfn *)lk, cblock, narg, args))

4
src/h/external.h
View file

@ -36,7 +36,7 @@ extern void GC_free(void *);
#define cl_alloc_align(s,d) GC_malloc(s)
#define cl_alloc_atomic_align(s,d) GC_malloc_atomic_ignore_off_page(s)
#define cl_dealloc(p,s)
#define ecl_register_static_root(x)
#define ecl_register_static_root(x) ecl_register_root(x)
#else
extern cl_object si_room_report _ARGS((int narg));
extern cl_object si_allocate _ARGS((int narg, cl_object type, cl_object qty, ...));
@ -313,7 +313,7 @@ extern cl_object cl_constantp(int narg, cl_object arg, ...);
#define funcall cl_funcall
extern cl_object cl_apply_from_stack(cl_index narg, cl_object fun);
extern cl_object link_call(cl_object sym, cl_objectfn *pLK, int narg, cl_va_list args);
extern cl_object link_call(cl_object sym, cl_objectfn *pLK, cl_object cblock, int narg, cl_va_list args);
extern cl_object cl_safe_eval(cl_object form, cl_object env, cl_object err_value);
/* ffi.c */

1
src/h/object.h
View file

@ -353,6 +353,7 @@ struct codeblock {
int source_pathname;
#endif
cl_object name;
cl_object links; /* list of symbols with linking calls */
};
struct bytecodes {

14
src/util/system.lsp
View file

@ -83,12 +83,11 @@
:type (system-fasl-extension system)
:defaults (system-fasl-directory system)))
(defun make-library-pathname (system shared)
(defun make-library-pathname (system target)
(let* ((name (string-downcase (system-name system)))
(directory (system-library-directory system))
(output-name (merge-pathnames name directory)))
(funcall (if shared #'c:shared-library-pathname #'c:static-library-pathname)
output-name)))
(compile-file-pathname output-name :type target)))
;;; ----------------------------------------------------------------------
;;; Operations on modules
@ -207,19 +206,16 @@
(setq transformations
(ecase mode
((:LIBRARY :SHARED-LIBRARY)
((:STATIC-LIBRARY :LIBRARY :SHARED-LIBRARY :FASL)
(let* ((transforms (make-transformations system
#'true
#'make-load-transformation))
(objects (mapcar #'(lambda (x) (make-binary-pathname (module-name (cadr x)) system))
(remove-if-not #'(lambda (x) (eq (car x) :LOAD))
transforms)))
(shared (eq mode :shared-library))
(library (make-library-pathname system shared)))
(library (make-library-pathname system mode)))
(operate-on-system system :COMPILE)
(funcall (if shared #'c::build-shared-library
#'c::build-static-library)
library :lisp-files objects))
(c::builder mode library :lisp-files objects))
nil)
(:COMPILE
(make-transformations system