Changeset 14327


Ignore:
Timestamp:
Oct 5, 2010, 3:02:48 AM (9 years ago)
Author:
gb
Message:

Make ADD-FEATURE try to do so in a thread-safe way; define REMOVE-FEATURE.
Export ADD-FEATURE and REMOVE-FEATURE.

Location:
trunk/source/lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/ccl-export-syms.lisp

    r13973 r14327  
    732732     external-process-creation-failure
    733733     object-direct-size
     734     add-feature
     735     remove-feature
    734736
    735737     ) "CCL"
  • trunk/source/lib/misc.lisp

    r14119 r14327  
    530530
    531531
    532 ;;; site names and machine-instance is in the init file.
    533 
    534 (defun add-feature (symbol)
    535   "Not CL but should be."
    536   (if (symbolp symbol)
    537       (if (not (memq symbol *features*))
    538           (setq *features* (cons symbol *features*)))))
    539 
    540 ;;; (dotimes (i 5000) (declare (fixnum i)) (add-feature 'junk))
     532
     533(defun add-feature (thing)
     534  (when (typep thing 'symbol)
     535    (let* ((gvector-or-fixnum (%symptr-binding-address '*features*)))
     536      (if (typep gvector-or-fixnum 'fixnum)
     537        ;; Thread-local binding of *FEATURES*.
     538        (if (not (member thing *features* :test #'eq))
     539          (setq *features* (cons thing *features*)))
     540        (loop
     541          (let* ((old (%svref gvector-or-fixnum target::symbol.vcell-cell)))
     542            (when (member thing old :test #'eq)
     543              (return))
     544            (let* ((new (cons thing old)))
     545              (when (store-gvector-conditional target::symbol.vcell-cell
     546                                               gvector-or-fixnum
     547                                               old
     548                                               new)
     549                (return)))))))
     550    thing))
     551
     552(defun remove-feature (thing)
     553  (let* ((gvector-or-fixnum (%symptr-binding-address '*features*)))
     554    (if (typep gvector-or-fixnum 'fixnum)
     555      ;; Thread-local binding of *FEATURES*.
     556      (setq *features* (delete thing *features*))
     557      (loop
     558        (let* ((old (%svref gvector-or-fixnum target::symbol.vcell-cell)))
     559          (unless (member thing old :test #'eq)
     560            (return))
     561          (let* ((new (remove thing old)))
     562            (when (store-gvector-conditional target::symbol.vcell-cell
     563                                           gvector-or-fixnum
     564                                           old
     565                                           new)
     566              (return))))))
     567    thing))
     568 
     569
    541570
    542571
Note: See TracChangeset for help on using the changeset viewer.