Commit 9096514c authored by Daniel Kochmański's avatar Daniel Kochmański

extensions: put ext:package-locked-p in core module.

parent 21909743
......@@ -26,14 +26,6 @@
:one-liner t)
T)
(defun package-locked-p (package &aux (package (si:coerce-to-package package)))
"Returns T when PACKAGE is locked, NIL otherwise. Signals an error
if PACKAGE doesn't designate a valid package."
(ffi:c-inline (package) (:object) :object
"(#0)->pack.locked ? ECL_T : ECL_NIL"
:side-effects nil
:one-liner t))
(defmacro without-package-locks (&body body)
"Ignores all runtime package lock violations during the execution of
body. Body can begin with declarations."
......
......@@ -563,7 +563,7 @@ void
cl_export2(cl_object s, cl_object p)
{
int intern_flag, error;
cl_object other_p, name = ecl_symbol_name(s);
cl_object other_p = ECL_NIL, name = ecl_symbol_name(s);
p = si_coerce_to_package(p);
if (p->pack.locked
&& ECL_SYM_VAL(ecl_process_env(),
......@@ -966,6 +966,13 @@ si_package_lock(cl_object p, cl_object t)
@(return (previous? ECL_T : ECL_NIL));
}
cl_object
si_package_locked_p (cl_object p)
{
p = si_coerce_to_package(p);
@return (p->pack.locked ? ECL_T : ECL_NIL);
}
/* --- local nicknames ---------------------------------------------------- */
cl_object
si_package_local_nicknames(cl_object p)
......
......@@ -1207,9 +1207,9 @@ cl_symbols[] = {
/* package extensions */
{SYS_ "*IGNORE-PACKAGE-LOCKS*", SI_SPECIAL, NULL, -1, ECL_NIL},
{EXT_ "PACKAGE-LOCK", EXT_ORDINARY, si_package_lock, 2, OBJNULL},
{EXT_ "PACKAGE-LOCKED-P", EXT_ORDINARY, si_package_locked_p, 1, OBJNULL},
{SYS_ "LOCK-PACKAGE", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "UNLOCK-PACKAGE", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "PACKAGE-LOCKED-P", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "WITHOUT-PACKAGE-LOCKS", EXT_ORDINARY, NULL, 1, OBJNULL},
{SYS_ "WITH-UNLOCKED-PACKAGES", EXT_ORDINARY, NULL, 1, OBJNULL},
{EXT_ "PACKAGE-LOCAL-NICKNAMES", EXT_ORDINARY, si_package_local_nicknames, 1, OBJNULL},
......
......@@ -1207,9 +1207,9 @@ cl_symbols[] = {
/* package extensions */
{SYS_ "*IGNORE-PACKAGE-LOCKS*",NULL},
{EXT_ "PACKAGE-LOCK","si_package_lock"},
{EXT_ "PACKAGE-LOCKED-P","si_package_locked_p"},
{SYS_ "LOCK-PACKAGE",NULL},
{SYS_ "UNLOCK-PACKAGE",NULL},
{SYS_ "PACKAGE-LOCKED-P",NULL},
{SYS_ "WITHOUT-PACKAGE-LOCKS",NULL},
{SYS_ "WITH-UNLOCKED-PACKAGES",NULL},
{EXT_ "PACKAGE-LOCAL-NICKNAMES","si_package_local_nicknames"},
......
......@@ -453,6 +453,7 @@
(proclamation si:package-hash-tables (package-designator)
(values hash-table hash-table list) :reader)
(proclamation ext:package-lock (package-designator gen-bool) package)
(proclamation ext:package-locked-p (package-designator) boolean :no-side-effects)
(proclamation ext:package-local-nicknames
(package-designator) list :no-side-effects)
(proclamation ext:package-locally-nicknamed-by-list
......
......@@ -2295,6 +2295,14 @@ built-in packages:
system system internal symbols. Has nicknames SYS and SI.
compiler system internal symbols for the ECL compiler.")
(docfun ext:package-lock function
(package-designator lock) "
Sets package's lock to LOCK. Returns previous lock value.")
(docfun ext:package-locked-p function
(package-designator) "
Returns T when PACKAGE is locked, NIL otherwise.")
(docfun ext:package-local-nicknames function
(package-designator) "
Returns an alist of (LOCAL-NICKNAME . ACTUAL-PACKAGE)
......
......@@ -1313,6 +1313,7 @@ extern ECL_API cl_object si_remove_package_local_nickname(cl_object n, cl_object
extern ECL_API cl_object cl_list_all_packages(void);
extern ECL_API cl_object si_package_hash_tables(cl_object p);
extern ECL_API cl_object si_package_lock(cl_object p, cl_object t);
extern ECL_API cl_object si_package_locked_p(cl_object p);
extern ECL_API cl_object cl_delete_package(cl_object p);
extern ECL_API cl_object cl_make_package _ECL_ARGS((cl_narg narg, cl_object pack_name, ...));
extern ECL_API cl_object cl_intern _ECL_ARGS((cl_narg narg, cl_object strng, ...));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment