Changeset 6184

Timestamp:

Apr 8, 2007, 3:04:23 AM (14 years ago)

Author:

gb

Message:

%INSERT-SYMBOL might call pkg.intern-hook.
Handle maintenance of auto-export packages differently.
$fasl-timm just needs an :int, not a :long.

File:

• trunk/ccl/level-0/nfasload.lisp (modified) (4 diffs)

trunk/ccl/level-0/nfasload.lisp

@@ -477 +477 @@
 
 (deffaslop $fasl-timm (s)
-  (rlet ((p :long))
+  (rlet ((p :int))
     (setf (%get-long p) (%fasl-read-long s))
     (%epushval s (%get-unboxed-ptr p))))
@@ -985 +985 @@
 
 
-(let* ((force-export-packages (list *keyword-package*)))
+(let* ((force-export-packages (list *keyword-package*))
+       (force-export-packages-lock (make-lock)))
   (defun force-export-packages ()
-    force-export-packages)
+    (with-lock-grabbed (force-export-packages-lock)
+      (copy-list force-export-packages)))
   (defun package-force-export (p)
     (let* ((pkg (pkg-arg p)))
-    (pushnew pkg force-export-packages)
-    pkg)))
+      (with-lock-grabbed (force-export-packages-lock)
+        (pushnew pkg force-export-packages))
+    pkg))
+  (defun force-export-package-p (pkg)
+    (with-lock-grabbed (force-export-packages-lock)
+      (if (memq pkg force-export-packages)
+        t))))
 
 
@@ -1003 +1010 @@
         (unless (%car package-predicate) (%rplaca package-predicate package)))
       (setf (%svref symvec target::symbol.package-predicate-cell) package))
-    (if (or force-export (memq package (force-export-packages)))
+    (if (or force-export (force-export-package-p package))
       (progn
         (%htab-add-symbol symbol (pkg.etab package) external-idx)
@@ -1015 +1022 @@
                                   (the fixnum (%symbol-bits symbol)))))))
       (%htab-add-symbol symbol (pkg.itab package) internal-idx))
+    (let* ((hook (pkg.intern-hook package)))
+      (when hook (funcall hook symbol)))
     symbol))