Move package-locks interface to contrib/

CHANGELOG

@@ -37,6 +37,11 @@ Introduced functions:
 =ext:without-package-locks=
 =ext:with-unlocked-package=
 
+To use these functions user has to require the module
+#+BEGIN_SRC lisp
+  (require '#:package-locks)
+#+END_SRC
+
 =defpackage= accepts new option =lock= to allow locking package on
 creation:
 

contrib/package-locks/package-locks.lisp

@@ -0,0 +1,58 @@
+;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
+;;;;
+;;;;  Copyright (c) 2016 Daniel Kochmańskin
+;;;;
+;;;;    See file 'LICENSE' for the copyright details.
+
+;;;; PACKAGE-LOCKS Convenient interface for package-locks mechanism.
+
+(in-package "EXT")
+
+
+;;; Package locks
+(pushnew :package-locks *features*)
+
+(defun lock-package (package &aux (package (si:coerce-to-package package)))
+  (ffi:c-inline (package) (:object) :void
+                "(#0)->pack.locked = 1"
+                :side-effects t
+                :one-liner t)
+  T)
+
+(defun unlock-package (package &aux (package (si:coerce-to-package package)))
+  (ffi:c-inline (package) (:object) :void
+                "(#0)->pack.locked = 0"
+                :side-effects t
+                :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."
+  `(let ((si::*ignore-package-locks* t)) ,@body))
+
+(defmacro with-unlocked-packages ((&rest packages) &body forms)
+  "Unlocks PACKAGES for the dynamic scope of the body. Signals an
+error if any of PACKAGES is not a valid package designator."
+  (with-unique-names (unlocked-packages)
+    `(let (,unlocked-packages)
+      (unwind-protect
+           (progn
+             (dolist (p ',packages)
+               (when (package-locked-p p)
+                 (push p ,unlocked-packages)
+                 (unlock-package p)))
+             ,@forms)
+        (dolist (p ,unlocked-packages)
+          (when (find-package p)
+            (lock-package p)))))))
+
+(provide '#:package-locks)

src/compile.lsp.in

@@ -316,6 +316,15 @@
 #+UNICODE
 (load "ext:encodings;generate.lisp")
 
+;;;
+;;; * Package locks
+;;;
+(build-module "package-locks"
+              '("ext:package-locks;package-locks.lisp")
+              :dir "build:ext;"
+              :prefix "EXT"
+              :builtin nil)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; THE FINAL EXECUTABLE

src/doc/new-doc/extensions/packages.txi

@@ -22,7 +22,12 @@
 ECL borrows parts of the protocol and documentation from SBCL for
 compatibility. Interface is the same except that the home package for
 locking is ext and that ECL doesn't implement Implementation Packages
-and a few constructs.
+and a few constructs. To load the extension you need to require
+@code{package-locks}:
+
+@lisp
+(require '#:package-locks)
+@end lisp
 
 Package locks protect against unintentional modifications of a package:
 they provide similar protection to user packages as is mandated to

src/lsp/packlib.lsp

@@ -285,49 +285,3 @@ If PACKAGE is non-NIL, then only the specified PACKAGE is searched."
           (when (and prefix (or recurse (not (find #\. package-name :start prefix))))
             (pushnew package res)))))))
 
-
-;;; Package locks
-(pushnew :package-locks *features*)
-
-(defun lock-package (package &aux (package (si:coerce-to-package package)))
-  (ffi:c-inline (package) (:object) :void
-                "(#0)->pack.locked = 1"
-                :side-effects t
-                :one-liner t)
-  T)
-
-(defun unlock-package (package &aux (package (si:coerce-to-package package)))
-  (ffi:c-inline (package) (:object) :void
-                "(#0)->pack.locked = 0"
-                :side-effects t
-                :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."
-  `(let ((si::*ignore-package-locks* t)) ,@body))
-
-(defmacro with-unlocked-packages ((&rest packages) &body forms)
-  "Unlocks PACKAGES for the dynamic scope of the body. Signals an
-error if any of PACKAGES is not a valid package designator."
-  (with-unique-names (unlocked-packages)
-    `(let (,unlocked-packages)
-      (unwind-protect
-           (progn
-             (dolist (p ',packages)
-               (when (package-locked-p p)
-                 (push p ,unlocked-packages)
-                 (unlock-package p)))
-             ,@forms)
-        (dolist (p ,unlocked-packages)
-          (when (find-package p)
-            (lock-package p)))))))