mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'develop' of gitlab.com:embeddable-common-lisp/ecl into develop

Browse source
This commit is contained in:
MatthewRock 2016-06-11 16:26:24 +02:00
commit 1caef56e2c
16 changed files with 127 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

3
CHANGELOG
View file

@ -78,6 +78,9 @@ handler so the thread wakeup wasn't working because the handler is not more vali
- import thread wasn't set upping a proper environment: on some case
the thread was mistakenly thinking that the thread was already registered.
- ECL_HANDLER_CASE and ECL_RESTART_CASE didn't work as expected
Bug identified and fixed by Vadim Penzin.
* 16.1.2 changes since 16.0.0
** API changes

10
doc/ref_c_conditions.xml
View file

@ -30,14 +30,14 @@
<para>The following example shows how to establish a handler for <symbol>ERROR</symbol> conditions. Note how the first value to <function>ECL_HANDLER_CASE</function> matches the position of the restart name in the list:</para>
<programlisting>
cl_object error = ecl_make_symbol("ERROR","CL");
ECL_RESTART_BEGIN(the_env, ecl_list1(error)) {
ECL_HANDLER_CASE_BEGIN(the_env, ecl_list1(error)) {
/* This form is evaluated with bound handlers */
output = cl_eval(1, form);
} ECL_HANDLER_CASE(1, condition) {
/* This code is executed when an error happens */
/* We just return the error that took place */
output = condition;
} ECL_RESTART_END;
} ECL_HANDLER_CASE_END;
</programlisting>
</refsect1>
</refentry>
@ -65,7 +65,7 @@ ECL_RESTART_BEGIN(the_env, ecl_list1(error)) {
<programlisting>
cl_object abort = ecl_make_symbol("ABORT","CL");
cl_object use_value = ecl_make_symbol("USE-VALUE","CL");
ECL_RESTART_BEGIN(the_env, cl_list(2, abort, use_value)) {
ECL_RESTART_CASE_BEGIN(the_env, cl_list(2, abort, use_value)) {
/* This form is evaluated with bound restarts */
output = cl_eval(1, form);
} ECL_RESTART_CASE(1, args) {
@ -74,7 +74,7 @@ ECL_RESTART_BEGIN(the_env, cl_list(2, abort, use_value)) {
} ECL_RESTART_CASE(2, args) {
/* This code is executed when the 2nd restart (ABORT) is invoked */
output = ECL_CAR(args);
} ECL_RESTART_END;
} ECL_RESTART_CASE_END;
</programlisting>
</refsect1>
</refentry>
@ -171,4 +171,4 @@ ECL_RESTART_BEGIN(the_env, cl_list(2, abort, use_value)) {
</refentry>
</section>
</chapter>
</book>
</book>

3
src/Makefile.in
View file

@ -6,6 +6,7 @@
#
top_srcdir= @top_srcdir@
srcdir = @srcdir@
datarootdir = @datarootdir@
mandir=@mandir@
manext=1
@ -269,7 +270,7 @@ selfbuild:
# like "@si::foo" and "@(defun si::foo".
# This rule is allowed to fail when etags does not exist.
.git/tags:
cd $(srcdir)/../.git && ctags -o tags -R --langmap=c:+.d ../src || true
( cd $(srcdir)/../.git && ctags -o tags -R --langmap=c:+.d ../src ) || true
TAGS:
-if test "x$(ETAGS)" != "x"; then \
srcfiles=`find $(srcdir)/c $(srcdir)/h -name '*.[chd]'` && \

11
src/aclocal.m4 vendored
View file

@ -6,7 +6,7 @@ AC_DEFUN([ECL_LONG_DOUBLE],[
if test "$enable_longdouble" != "no" ; then
AC_CHECK_TYPES([long double],[enable_longdouble=yes],[enable_longdouble=no])
if test "$enable_longdouble" != "no" ; then
AC_CHECK_FUNCS([sinl cosl tanl logl expl],[],[enable_longdouble=no; break])
AC_CHECK_FUNCS([sinl cosl tanl logl expl ldexpl frexpl],[],[enable_longdouble=no; break])
if test "$enable_longdouble" != "no" ; then
AC_DEFINE([ECL_LONG_FLOAT], [], [ECL_LONG_FLOAT])
fi
@ -443,9 +443,14 @@ case "${host_os}" in
clibs="-Wld=-lrld"
;;
aix*)
PICFLAG=''
PICFLAG='-DPIC'
thehost="aix"
shared="no"
THREAD_LIBS='-lpthread'
SHARED_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}"
BUNDLE_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}"
ECL_LDRPATH="-Wl,-R~A"
SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
SONAME_LDFLAGS="-bsvr4 -brtl"
;;
*)
thehost="$host_os"

2
src/c/ecl_features.h
View file

@ -35,7 +35,7 @@ ecl_def_string_array(feature_names,static,const) = {
#endif
ecl_def_string_array_elt("ECL-PDE"),
#if defined(unix) || defined(netbsd) || defined(openbsd) || defined(linux) || defined(darwin) || \
defined(freebsd) || defined(dragonfly) || defined(kfreebsd) || defined(gnu) || defined(nsk)
defined(freebsd) || defined(dragonfly) || defined(kfreebsd) || defined(gnu) || defined(nsk) || defined(aix)
ecl_def_string_array_elt("UNIX"),
#endif
#ifdef BSD

23
src/c/stacks.d
View file

@ -28,16 +28,16 @@ cs_set_size(cl_env_ptr env, cl_index new_size)
{
volatile char foo = 0;
cl_index margin = ecl_option_values[ECL_OPT_C_STACK_SAFETY_AREA];
env->cs_limit_size = new_size - 2*margin;
env->cs_limit_size = new_size - (2*margin);
#ifdef ECL_DOWN_STACK
if (&foo > env->cs_org - new_size + 16) {
env->cs_limit = env->cs_org - new_size + 2*margin;
if (&foo > (env->cs_org - new_size) + 16) {
env->cs_limit = (env->cs_org - new_size) + (2*margin);
if (env->cs_limit < env->cs_barrier)
env->cs_barrier = env->cs_limit;
}
#else
if (&foo < env->cs_org + new_size - 16) {
env->cs_limit = env->cs_org + new_size - 2*margin;
if (&foo < (env->cs_org + new_size) - 16) {
env->cs_limit = (env->cs_org + new_size) - (2*margin);
if (env->cs_limit > env->cs_barrier)
env->cs_barrier = env->cs_limit;
}
@ -96,16 +96,19 @@ ecl_cs_set_org(cl_env_ptr env)
{
struct rlimit rl;
cl_index size;
getrlimit(RLIMIT_STACK, &rl);
if (rl.rlim_cur != RLIM_INFINITY) {
if (!getrlimit(RLIMIT_STACK, &rl) &&
( rl.rlim_cur != RLIM_INFINITY
|| rl.rlim_cur !=RLIM_SAVED_MAX
|| rl.rlim_cur != RLIM_SAVED_CUR) ) {
env->cs_max_size = rl.rlim_cur;
size = rl.rlim_cur / 2;
if (size > (cl_index)ecl_option_values[ECL_OPT_C_STACK_SIZE])
if (size < (cl_index)ecl_option_values[ECL_OPT_C_STACK_SIZE])
ecl_set_option(ECL_OPT_C_STACK_SIZE, size);
#ifdef ECL_DOWN_STACK
env->cs_barrier = env->cs_org - rl.rlim_cur - 1024;
env->cs_barrier = (env->cs_org - rl.rlim_cur) - 1024;
#else
env->cs_barrier = env->cs_org + rl.rlim_cur + 1024;
env->cs_barrier = (env->cs_org + rl.rlim_cur) + 1024;
#endif
}
}

4
src/clos/conditions.lsp
View file

@ -180,7 +180,9 @@
(name (first expression2)))
(case name
(SIGNAL
(setq condition-form (second expression2)))
(setq condition-form `(coerce-to-condition ,(second expression2)
(list ,@ (cddr expression2))
'simple-condition 'signal)))
(ERROR
(setq condition-form `(coerce-to-condition ,(second expression2)
(list ,@(cddr expression2))

13
src/configure vendored
View file

@ -5054,9 +5054,14 @@ LSP_FEATURES="(cons :android ${LSP_FEATURES})"
clibs="-Wld=-lrld"
;;
aix*)
PICFLAG=''
PICFLAG='-DPIC'
thehost="aix"
shared="no"
THREAD_LIBS='-lpthread'
SHARED_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}"
BUNDLE_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}"
ECL_LDRPATH="-Wl,-R~A"
SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION"
SONAME_LDFLAGS="-bsvr4 -brtl"
;;
*)
thehost="$host_os"
@ -8050,7 +8055,7 @@ else
fi
if test "$enable_longdouble" != "no" ; then
for ac_func in sinl cosl tanl logl expl
for ac_func in sinl cosl tanl logl expl ldexpl frexpl
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
@ -10267,7 +10272,7 @@ ecl config.status 16.1.2
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
Copyright (C) 2012 Free Software Foundation, Inc.
Copyright (C) Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

2
src/configure.ac
View file

@ -428,6 +428,8 @@ if test "x${with_system_gmp}" = "xno" ; then
else
GMP_ABI="ABI=$ABI"
fi
# Crosscompilation for Android on Darwin requires replacing 'NM=nm'
# below with 'NM=$PLATFORM_PREFIX/bin/arm-linux-androideabi-nm'.
mkdir gmp
dnl Notice we need -DPIC to force the assembler to generate PIC code
(destdir=`${PWDCMD}`; cd gmp && CC="${CC} ${PICFLAG}" \

1
src/doc/Makefile.in
View file

@ -6,6 +6,7 @@ exec_prefix=@exec_prefix@
infodir = @infodir@
mandir=@mandir@
docdir=@docdir@
datarootdir = @datarootdir@
manext=1
INFOEXT = @INFOEXT@

6
src/ecl/configpre.h
View file

@ -150,6 +150,9 @@
/* Define to 1 if you have the `frexpf' function. */
#undef HAVE_FREXPF
/* Define to 1 if you have the `frexpl' function. */
#undef HAVE_FREXPL
/* Define to 1 if you have the `fseeko' function. */
#undef HAVE_FSEEKO
@ -183,6 +186,9 @@
/* Define to 1 if you have the `ldexpf' function. */
#undef HAVE_LDEXPF
/* Define to 1 if you have the `ldexpl' function. */
#undef HAVE_LDEXPL
/* HAVE_LIBFFI */
#undef HAVE_LIBFFI

2
src/h/internal.h
View file

@ -488,7 +488,7 @@ extern cl_fixnum ecl_runtime(void);
#ifdef ECL_THREADS
extern void ecl_process_yield(void);
extern void print_lock(char *s, cl_object lock, ...);
#define print_lock(a,b,...) ((void)0)
#define print_lock(...) ((void)0)
extern void ecl_get_spinlock(cl_env_ptr env, cl_object *lock);
extern void ecl_giveup_spinlock(cl_object *lock);
extern cl_object ecl_wait_on(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object), cl_object o);

10
src/h/stacks.h
View file

@ -423,9 +423,8 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
if (ecl_frs_push(__the_env,__ecl_tag) == 0) {
#define ECL_RESTART_CASE(code, args) \
} else if (__the_env->values[1] == ecl_make_fixnum(code)) { \
const cl_object args = __the_env->values[0];
} else if (__the_env->values[0] == ecl_make_fixnum(code)) { \
const cl_object args = __the_env->values[1];
#define ECL_RESTART_CASE_END } \
ecl_frs_pop(__the_env); \
@ -440,9 +439,8 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
if (ecl_frs_push(__the_env,__ecl_tag) == 0) {
#define ECL_HANDLER_CASE(code, args) \
} else if (__the_env->values[1] == ecl_make_fixnum(code)) { \
const cl_object args = __the_env->values[0];
} else if (__the_env->values[0] == ecl_make_fixnum(code)) { \
const cl_object args = __the_env->values[1];
#define ECL_HANDLER_CASE_END } \
ecl_frs_pop(__the_env); \

3
src/tests/regressions/tests/compiler.lsp
View file

@ -1170,7 +1170,10 @@
;;; Date 2016-04-21
;;; Fixed: Daniel Kochmański
;;; Description
;;; typep didn't recognize * as a t abberv
;;;
(deftest compiler.0051.ftype-args*
(progn
(declaim (ftype (function (*) (values T)) ce))

54
src/tests/regressions/tests/embedding.lsp
View file

@ -14,10 +14,10 @@
(princ c-code s))
(c::compiler-cc "tmp/aux.c" "tmp/aux.o")
(c::linker-cc "tmp/aux.exe" '("tmp/aux.o"))
(case capture-output
(nil
(ecase capture-output
((nil)
(return-from test-C-program (zerop (si::system "tmp/aux.exe"))))
(STRING
((string :string)
(with-output-to-string (s)
(let ((in (si::run-program "tmp/aux.exe" '() :output :stream))
line)
@ -25,7 +25,7 @@
(setf line (read-line in nil))
(unless line (return))
(write-line line s)))))
(T
((t forms :forms)
(do* ((all '())
(x t)
(in (si::run-program "tmp/aux.exe" '() :output :stream)))
@ -57,6 +57,50 @@ int main (int argc, char **argv) {
}")
(form '(push (lambda () (print :shutdown)) si::*exit-hooks*))
(c-code (format nil skeleton (format nil "~S" form)))
(data (test-C-program (print c-code) :capture-output t)))
(data (test-C-program c-code :capture-output t)))
data)
(:shutdown))
;;; Date: 2016-05-25 (Vadim Penzin)
;;; Date: 2016-05-27 (Vadim Penzin)
;;; Description:
;;;
;;; ECL_HANDLER_CASE C macro misses condition handlers because the
;;; macro looks up handler tags in env->values[1] instead of
;;; env->values[0] and copies the condition object from
;;; env->values[0] instead of env->values[1].
;;;
;;; Case study: http://penzin.net/ecl-handler-case.html
;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/248
;;; Notes:
;;;
;;; ECL_RESTART_CASE is very similar, but testing would require
;;; user interaction (ie picking the restart), hence we only test
;;; the ECL_HANDLER_CASE.
;;;
(deftest embedding.0002.handlers
(let* ((c-code "
#include <stdio.h>
#include <ecl/ecl.h>
int
main ( const int argc, const char * const argv [] )
{
cl_boot ( argc, (char **) argv );
int result = 1;
cl_env_ptr const environment = ecl_process_env ();
const cl_object const conditions =
ecl_list1 ( ecl_make_symbol ( \"DIVISION-BY-ZERO\", \"CL\" ) );
ECL_HANDLER_CASE_BEGIN ( environment, conditions ) {
ecl_divide ( ecl_make_fixnum ( 1 ), ecl_make_fixnum ( 0 ) );
} ECL_HANDLER_CASE ( 1, condition ) {
result = 0;
} ECL_HANDLER_CASE_END;
return result;
}
"))
(test-C-program c-code))
T)

17
src/tests/regressions/tests/mixed.lsp
View file

@ -106,3 +106,20 @@
nil)
;;; Date: 2016-05-21 (Masataro Asai)
;;; Description:
;;;
;;; RESTART-CASE investigates the body in an incorrect manner,
;;; then remove the arguments to SIGNAL, which cause the slots of
;;; the conditions to be not set properly.
;;;
;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/247
;;;
(ext:with-clean-symbols (x)
(define-condition x () ((y :initarg :y)))
(deftest mixed.0009.restart-case-body
(handler-bind ((x (lambda (c) (slot-value c 'y))))
(restart-case
(signal 'x :y 1)))
nil))