diff --git a/CHANGELOG b/CHANGELOG index ad2632a56..9394a870f 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -27,7 +27,20 @@ install ECL on the preferred destination (specified with "--prefix" parameter given to configure script). -* Pending changes since 26.3.27 +* Pending changes since 26.5.5 + +* 26.5.5 changes since 26.3.27 + +- bugfix: MAKE-PACKAGE destructively modified defining form's cons cells of + the package local nicknames, breaking package literals in bytecmp (#839) + +- bugfix: the first environment is now always page-aligned by using the + same allocation mechanism as all subsequent envs (#828) + +- bugfix: allow loading concatenated fasc files (#842) + +- bugfix: defclass does not redefine existing classes at compile time with + forward-referenced classes (#843) * 26.3.27 changes since 24.5.10 diff --git a/src/c/load.d b/src/c/load.d index 3862c9857..cca9bb54f 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -157,21 +157,22 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec cl_index bds_ndx = ecl_progv(env, ECL_CONS_CAR(progv_list), ECL_CONS_CDR(progv_list)); forms = read_forms(strm, ECL_T); - ecl_bds_unwind(env, bds_ndx); - } - while (!Null(forms)) { - if (ECL_LISTP(forms)) { - cl_object x = ECL_CONS_CAR(forms); - forms = ECL_CONS_CDR(forms); - if (ecl_t_of(x) == t_bytecodes) { - _ecl_funcall1(x); - if (Null(forms)) { - forms = read_forms(strm, ECL_NIL); + + while (!Null(forms)) { + if (ECL_LISTP(forms)) { + cl_object x = ECL_CONS_CAR(forms); + forms = ECL_CONS_CDR(forms); + if (ecl_t_of(x) == t_bytecodes) { + _ecl_funcall1(x); + if (Null(forms)) { + forms = read_forms(strm, ECL_NIL); + } + continue; } - continue; } + FEerror("Corrupt bytecodes file ~S", 1, source); } - FEerror("Corrupt bytecodes file ~S", 1, source); + ecl_bds_unwind(env, bds_ndx); } { cl_object x; diff --git a/src/c/main.d b/src/c/main.d index 7f06fe6a7..f00464c1e 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -49,7 +49,6 @@ /******************************* EXPORTS ******************************/ const char *ecl_self; -static struct cl_env_struct first_env; /************************ GLOBAL INITIALIZATION ***********************/ @@ -419,7 +418,7 @@ struct cl_core_struct cl_core = { .system_properties = ECL_NIL, - .first_env = &first_env, + .first_env = NULL, #ifdef ECL_THREADS .processes = ECL_NIL, #endif @@ -498,6 +497,9 @@ cl_boot(int argc, char **argv) setbuf(stdin, stdin_buf); setbuf(stdout, stdout_buf); #endif + + /* The first environment must be available at all times. */ + cl_core.first_env = _ecl_alloc_env(NULL); init_process(); ARGC = argc; diff --git a/src/c/package.d b/src/c/package.d index e6d6e3238..1d89dba28 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -203,10 +203,10 @@ process_package_list(cl_object packages) } static cl_object -process_local_nicknames_list(cl_object local_nicknames) +process_local_nicknames_tree(cl_object local_nicknames) { cl_object l, nl; - local_nicknames = cl_copy_list(local_nicknames); + local_nicknames = cl_copy_tree(local_nicknames); for (l = local_nicknames; l != ECL_NIL; l = ECL_CONS_CDR(l)) { nl = ECL_CONS_CAR(l); ECL_RPLACA(nl, cl_string(ECL_CONS_CAR(nl))); @@ -227,7 +227,7 @@ ecl_make_package(cl_object name, cl_object nicknames, name = cl_string(name); nicknames = process_nicknames(nicknames); use_list = process_package_list(use_list); - local_nicknames = process_local_nicknames_list(local_nicknames); + local_nicknames = process_local_nicknames_tree(local_nicknames); ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(env) { if (ecl_option_values[ECL_OPT_BOOTED]) { @@ -833,7 +833,8 @@ ecl_shadow(cl_object s, cl_object p) p->pack.internal = _ecl_sethash(s, p->pack.internal, x); x->symbol.hpack = p; } - p->pack.shadowings = CONS(x, p->pack.shadowings); + if (!ecl_member_eq(x, p->pack.shadowings)) + p->pack.shadowings = CONS(x, p->pack.shadowings); } ECL_WITH_GLOBAL_ENV_WRLOCK_END; } diff --git a/src/c/stacks.d b/src/c/stacks.d index ef52372c6..08d49aeb4 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -281,7 +281,7 @@ ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size) /* Some clang versions miscompile the following function on x86_64. * Temporarily turn off optimizations here. */ -#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 19 && defined(__x86_64__) +#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 22 && defined(__x86_64__) [[clang::optnone]] #endif void @@ -341,7 +341,7 @@ ecl_stack_frame_push_values(cl_object f) /* Some clang versions miscompile the following function on x86_64. * Temporarily turn off optimizations here. */ -#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 19 && defined(__x86_64__) +#if defined(__clang__) && __clang_major__ >= 17 && __clang_major__ <= 22 && defined(__x86_64__) [[clang::optnone]] #endif cl_object diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index ff77ac41c..2a6992e8e 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -2043,6 +2043,7 @@ cl_symbols[] = { {EXT_ "ALLOW-WITH-INTERRUPTS" ECL_FUN(NULL, NULL, -1) ECL_VAR(MP_CONSTANT, OBJNULL)}, {SYS_ "*QUIT-TAG*" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_SPECIAL, OBJNULL)}, +{SYS_ "*BREAK-LOCALS*" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_SPECIAL, ECL_NIL)}, {EXT_ "ARRAY-RAW-DATA" ECL_FUN("si_array_raw_data", si_array_raw_data, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, diff --git a/src/clos/boot.lsp b/src/clos/boot.lsp index 51291f1d1..9d2d31426 100644 --- a/src/clos/boot.lsp +++ b/src/clos/boot.lsp @@ -18,13 +18,15 @@ ;;; We cannot use the functions CREATE-STANDARD-CLASS and others because SLOTS, ;;; DIRECT-SLOTS, etc are empty and therefore SLOT-VALUE does not work. -(defun make-empty-standard-class (name &key (metaclass 'standard-class) - direct-superclasses direct-slots index) +(defun make-empty-standard-class + (name &key (metaclass 'standard-class) + direct-superclasses direct-slots index + (size #.(length +standard-class-slots+))) (declare (optimize speed (safety 0))) - (let* ((the-metaclass (and metaclass (gethash metaclass si::*class-name-hash-table*))) + (let* ((the-metaclass + (and metaclass (gethash metaclass si::*class-name-hash-table*))) (class (or (gethash name si::*class-name-hash-table*) - (si:allocate-raw-instance nil the-metaclass - #.(length +standard-class-slots+))))) + (si:allocate-raw-instance nil the-metaclass size)))) (with-early-accessors (+standard-class-slots+) (when (eq name 'standard-class) (defconstant +the-standard-class+ class) diff --git a/src/clos/hierarchy.lsp b/src/clos/hierarchy.lsp index 33b5c4ca4..51538cef3 100644 --- a/src/clos/hierarchy.lsp +++ b/src/clos/hierarchy.lsp @@ -377,6 +377,7 @@ :direct-slots #.+structure-class-slots+) (structure-object :metaclass structure-class - :direct-superclasses (t)) + :direct-superclasses (t) + :size #.(length +structure-class-slots+)) ))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp index 5f2c9074b..bf3c0fd03 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp @@ -636,7 +636,8 @@ (def-inline cl:integerp :always (t) :bool "@0;ECL_FIXNUMP(#0)||ECL_BIGNUMP(#0)") (def-inline cl:floatp :always (t) :bool "floatp(#0)") (def-inline cl:characterp :always (t) :bool "ECL_CHARACTERP(#0)") - (def-inline si:base-char-p :always (character) :bool "ECL_BASE_CHAR_P(#0)") + (def-inline si:base-char-p :always (t) :bool "ECL_BASE_CHAR_P(#0)") + (def-inline si:base-char-p :always (character) :bool "ECL_BASE_CHAR_CODE_P(#0)") (def-inline cl:stringp :always (t) :bool "@0;ECL_STRINGP(#0)") (def-inline si:base-string-p :always (t) :bool "@0;ECL_BASE_STRING_P(#0)") (def-inline cl:bit-vector-p :always (t) :bool "@0;ECL_BIT_VECTOR_P(#0)") diff --git a/src/cmp/cmpenv-proclaim.lsp b/src/cmp/cmpenv-proclaim.lsp index 6394b4502..9bdd63b19 100644 --- a/src/cmp/cmpenv-proclaim.lsp +++ b/src/cmp/cmpenv-proclaim.lsp @@ -121,9 +121,12 @@ (si:put-sysprop var 'CMP-TYPE type1)) (warn "The variable name ~s is not a symbol." var)))) +;;; FIXME implement file-local global compiler environment for BCMP compiler and +;;; unify compiler environment functions with CCMP. (defun si:proclaim-class (name class &optional (env c::*cmp-env-root*)) "Add a class definition to the global compiler environment." (si:create-type-name name) - (ext:with-backend - :c/c++ (cmp-env-register-type name class c::*cmp-env-root*) - #-ecl-min :bytecodes #-ecl-min (setf (find-class name) class))) + (if *compiler-in-use* + (cmp-env-register-type name class c::*cmp-env-root*) + (or (find-class name nil) + (setf (find-class name) class)))) diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 1e8c86195..79a28fc93 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -206,7 +206,7 @@ after compilation." ((typep (setf def (fdefinition name)) 'standard-generic-function) (warn "COMPILE can not compile generic functions yet") (return-from compile (values def t nil))) - ((null (setq form (function-lambda-expression def))) + ((null (multiple-value-setq (form lexenv) (function-lambda-expression def))) (warn "We have lost the original function definition for ~s. Compilation to C failed" name) (return-from compile (values def t nil))) diff --git a/src/configure b/src/configure index dc0be976a..e197ef240 100755 --- a/src/configure +++ b/src/configure @@ -1,7 +1,7 @@ #! /bin/sh # From configure.ac Revision. # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.72 for ecl 26.3.27. +# Generated by GNU Autoconf 2.72 for ecl 26.5.5. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, @@ -602,8 +602,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='ecl' PACKAGE_TARNAME='ecl' -PACKAGE_VERSION='26.3.27' -PACKAGE_STRING='ecl 26.3.27' +PACKAGE_VERSION='26.5.5' +PACKAGE_STRING='ecl 26.5.5' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1404,7 +1404,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -'configure' configures ecl 26.3.27 to adapt to many kinds of systems. +'configure' configures ecl 26.5.5 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1474,7 +1474,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of ecl 26.3.27:";; + short | recursive ) echo "Configuration of ecl 26.5.5:";; esac cat <<\_ACEOF @@ -1656,7 +1656,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -ecl configure 26.3.27 +ecl configure 26.5.5 generated by GNU Autoconf 2.72 Copyright (C) 2023 Free Software Foundation, Inc. @@ -2258,7 +2258,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by ecl $as_me 26.3.27, which was +It was created by ecl $as_me 26.5.5, which was generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw @@ -12386,7 +12386,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by ecl $as_me 26.3.27, which was +This file was extended by ecl $as_me 26.5.5, which was generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -12450,7 +12450,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -ecl config.status 26.3.27 +ecl config.status 26.5.5 configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" diff --git a/src/configure.ac b/src/configure.ac index 5eff9a037..af6f149c7 100644 --- a/src/configure.ac +++ b/src/configure.ac @@ -8,7 +8,7 @@ dnl AUTOCONF configuration for ECL dnl Giuseppe Attardi 25.1.1994 dnl -AC_INIT([ecl],[26.3.27],[]) +AC_INIT([ecl],[26.5.5],[]) AC_REVISION([$Revision$]) AC_CONFIG_SRCDIR([bare.lsp.in]) AC_CONFIG_AUX_DIR([gmp]) diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index ac2b2c550..36226eb17 100644 --- a/src/lsp/predlib.lsp +++ b/src/lsp/predlib.lsp @@ -36,13 +36,16 @@ Builds a new function which accepts any number of arguments but always outputs N (ext:fill-array-with-elt *subtypep-cache* nil 0 nil) (ext:fill-array-with-elt *upgraded-array-element-type-cache* nil 0 nil)) +;;; FIXME implement file-local global compiler environment for BCMP compiler and +;;; unify compiler environment functions with CCMP. (defun proclaim-class (name class &optional env) "Add a class definition to the global compiler environment." (declare (ignore env)) - ;; Default implementation for the bytecodes compiler which doesn't - ;; have a separate file-local compiler environment. + ;; Default implementation for the bytecodes compiler which doesn't have a + ;; separate file-local compiler environment. (si:create-type-name name) - (setf (find-class name) class)) + (or (find-class name nil) + (setf (find-class name) class))) (defun create-type-name (name) (when (member name *alien-declarations*) diff --git a/src/tests/ecl-tests.asd b/src/tests/ecl-tests.asd index ec7b9963b..6872dca17 100644 --- a/src/tests/ecl-tests.asd +++ b/src/tests/ecl-tests.asd @@ -24,8 +24,8 @@ (:file "foreign-interface" :if-feature :ffi) (:file "metaobject-protocol" :if-feature :clos) (:file "ieee-fp" :if-feature :ieee-floating-point) - (:file "package-extensions") - (:file "hash-tables") + (:file "packages") + (:file "hash-tables") (:file "external-formats" :if-feature :unicode) (:file "unicode" :if-feature :unicode) (:file "complex") diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index 1f471aa9b..cb950bd01 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -21,7 +21,7 @@ ;;;; Declare the suites (suite 'make-check - '(executable ieee-fp eprocess package-ext hash-tables ansi+ mixed + '(executable ieee-fp eprocess packages hash-tables ansi+ mixed cmp emb ffi mop run-program mp complex wscl #+unicode unicode #+clos clos)) diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index d425602c6..98d276573 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -2712,3 +2712,15 @@ (with-compiler ("empty-file-0115.lsp" :load t)))) (delete-file "empty-file-0115.lsp") (delete-file ofile))) + +;;; Date 2026-04-16 +;;; Description +;;; +;;; Bytecodes compiler has problems with storing local packages nicknames. +;;; Error: "Cannot print object # readably." +;;; +(deftest cmp.0116.local-nicknames () + (with-compiler ("local-nicknames-0116.lsp") + `(defpackage "ZET" + (:use) + (:local-nicknames ("E" "EXT"))))) diff --git a/src/tests/normal-tests/package-extensions.lsp b/src/tests/normal-tests/packages.lsp similarity index 91% rename from src/tests/normal-tests/package-extensions.lsp rename to src/tests/normal-tests/packages.lsp index 8ea249536..4444c4d33 100644 --- a/src/tests/normal-tests/package-extensions.lsp +++ b/src/tests/normal-tests/packages.lsp @@ -3,12 +3,13 @@ ;;;; Author: Daniel Kochmański ;;;; Created: 2016-11-09 -;;;; Contains: PACKAGE extension tests -;;;; Easter: Trump won the election today, we're doomed... +;;;; Contains: PACKAGE tests +;;;; Easter: Trump won the election today, we're screwed... +;;;; ([2026-03-30] told you so :-) (in-package :cl-test) -(suite 'package-ext) +(suite 'packages) (defmacro with-fresh-package (name &body body) `(progn @@ -198,3 +199,20 @@ (ignore-errors (delete-package :eu.turtleware.pack2)) (ignore-errors (delete-package :eu.turtle.pack1)) (ignore-errors (delete-package :eu.turtle.pack2))) + +;;; Reported by: Gábor Melis +;;; Created: 2026-03-30 +;;; Description +;;; +;;; :shadow option may lead to duplicates in package-shadowing-symbols +(deftest packages.0001.shadow-duplicates () + (dotimes (x 3) + (defpackage "PACKAGES.0001.TTT" + (:shadow "CONS") + (:shadowing-import-from "EXT" "GC") + (:use "CL"))) + (let ((shadowed-symbols (package-shadowing-symbols "PACKAGES.0001.TTT")) + (expected-symbols (list 'ext::gc + (find-symbol "CONS" "PACKAGES.0001.TTT")))) + (is (= 2 (length shadowed-symbols))) + (is (null (set-difference shadowed-symbols expected-symbols)))))