| blob | 2dba2f678bee163bd6c3588ed76e675bbd79f048 |
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3 ;;;;
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
12 ;;;; This file implements abstract types which map globaldb Info-Number/Name
13 ;;;; pairs to data values. The database itself is defined in 'globaldb'.
15 ;;; Quasi-lockfree concurrent hashtable
16 ;;; ===================================
18 ;; References:
19 ;; http://trac.clozure.com/ccl/wiki/Internals/LockFreeHashTables
20 ;; https://github.com/boundary/high-scale-lib/blob/master/src/main/java/org/cliffc/high_scale_lib/NonBlockingHashMap.java
22 ;; The basic hashable is a lightweight one using prime number sizing strategy,
23 ;; and a secondary hash for re-probing that is not necessarily co-prime with
24 ;; the table size (as it would be, ideally), and no support for deletion.
26 ;; The lock-free logic differs from each of the preceding reference algorithms.
27 ;; The Java algorithm is truly lock-free: death of any thread will never impede
28 ;; progress in other threads. The CCL algorithm is only quasi-lock-free, as is
29 ;; ours. Were a rehashing thread to terminate abnormally while holding the
30 ;; rehash mutex, all other threads will likely starve at some point.
31 ;;
32 ;; Unlike the CCL algorithm, we allow reading/writing concurrently with rehash.
33 ;; Most operations will never notice that the rehasher has acquired a mutex,
34 ;; because the only case where writers compete for the mutex is in trying
35 ;; to claim a new cell in a storage vector that is being transported, and where
36 ;; the rehasher has already visited the desired cell. Since the rehasher will
37 ;; never re-visit a cell, it disallows updates that it could not perceive.
38 ;; The Java algorithm has additional complexity imposed upon it by the
39 ;; feature that rehashing work is parceling out fairly to threads,
40 ;; whereas we avoid that by having one rehasher transport all cells.
42 ;; A marker for cells that may be claimed by a writer
44 ;; A marker for cells that may NOT be claimed by a writer.
47 ;; We have a 24-bit cell index. This is generous,
48 ;; allowing for ~5 million Names assuming 60% load factor.
51 ;; An INFO-STORAGE is a vector of a 3-element header followed by all keys
52 ;; and then all values. This way we can simply use FILL to set all keys to 0
53 ;; and all values to NIL.
56 ;; Capacity refers to pairs of vector elements. The lower bound is to
57 ;; try (in vain) to elide a check for division by 0 in the secondary hash.
58 ;; The upper bound is harmlessly wrong by a factor of 2 because
59 ;; INFO-CELL-INDEX should be the max physical cell that can be addressed.
60 ;; No problem - you'll run out of memory before hitting the edge anyway.
62 ;; Make a new storage if count exceeds this
65 ;; keys ... data ...
66 )
70 primify))
72 ;; If you ask for 40 entries at 50% load, you get (PRIMIFY 80) entries.
77 ;; The threshold should be approximately the same as
78 ;; the number you asked for in the first place.
83 a))
86 globaldb-sxhashoid))
88 ;;; In the host, we use the host's sxhash, but ensure that the result
89 ;;; is a target fixnum. The definition for the target occurs later, as it
90 ;;; relies on MIX, which is inlined.
91 #+sb-xc-host
100 ;; COUNT is always at *least* as large as the key count.
101 ;; If no insertions are in progress, it is exactly right.
110 ;; We can't assume that the host lisp supports a CAS operation for info-gethash
111 ;; or info-puthash, but that's fine because there's only one thread.
113 #+sb-xc-host
115 #-sb-xc-host
118 ;; Similarly we need a way to atomically adjust the hashtable count.
121 #+sb-xc-host
123 #-sb-xc-host
124 ;; Inform the compiler that this is not possibly a bignum,
125 ;; since it's true upper bound is the info storage threshold.
129 info-forwarding-pointer-target
130 info-value-moved-p)
134 ;; Concurrent access relies on a forwarding pointer being placed into
135 ;; transported value cells. Since this is not a fully general hashtable,
136 ;; we can use fixnums as forwarding pointers, as they're otherwise
137 ;; never present as a value.
138 #+sb-xc-host
149 ;; However, here is a forwarding-pointer representation that allows fixnums
150 ;; as legal values in the table, so, since it's more general, ... why not?
151 #-sb-xc-host
162 ;; The common skeleton of {Get, Put, Rehash} operations. Probe key cells until
163 ;; either a hit occurs, in which case the :HIT form is executed and looping
164 ;; stops; or an empty slot is seen in which case the :MISS code is executed.
165 ;; :MISS should contain a GO or RETURN on success, otherwise probing continues.
166 ;; No precaution exists against probing forever, such as could happen if the
167 ;; probing strategy fails to visit all candidate free cells.
168 ;;
169 ;; Stepping is done by subtracting a secondary hash rather than adding,
170 ;; as this allows testing for wraparound by comparison to a constant
171 ;; instead of against storage capacity. Nonlinear probing jumps around in
172 ;; the L1 cache regardless, as they key space is a ring so the "direction"
173 ;; of probing is irrelevant. [In contrast, linear probing usually benefits
174 ;; from scanning physically forward, preferably within a cache line,
175 ;; but for practical purposes linear probing is worse.]
176 ;;
192 ;; Optimistically test for hit first, then markers
206 ;; only need the second hash if didn't hit on first try
208 :loop
212 next)))
218 ;; Wait for ENV's storage to change to something other than STORAGE, and
219 ;; return the new one. As long as rehash finishes in finite time, every thread
220 ;; makes progess. We don't protect against untimely death of the thread
221 ;; that holds the lock.
222 ;;
224 ;; kinda spin, except not quite that bad
227 ;; Grab and release the mutex for no other reason than to
228 ;; observe that a rehasher doesn't (for the moment) have it.
232 ;; Look in info-environment ENV for the name KEY. Arguments are like GETHASH.
233 ;;
234 ;; Invariant: any KEY's value is present in at most 1 storage.
235 ;; Uniqueness of the location ensures that when writing with CAS, the place is
236 ;; either current, or CAS fails in a way that informs the writer of a new place.
237 ;; At most one probing sequence occurs, in that hitting a key might entail
238 ;; more than one forwarding but never a re-probing.
239 ;; The same is not true on insert, for which probing restart is quite common.
240 ;; When chasing values, INFO-STORAGE-NEXT may or may not be EQ to what is in
241 ;; INFO-ENV-STORAGE, depending whether rehash is still running, has completed,
242 ;; or started all over again before the reader got a chance to chase one time.
243 ;;
247 ;; With 99% certainty the :READ barrier is needed for non-x86, and if not,
248 ;; it can't hurt. 'info-storage-next' can be empty until at least one cell
249 ;; has been forwarded, but in general an unsynchronized read might be
250 ;; perceived as executing before a conditional that guards whether the
251 ;; read should happen at all. 'storage-next' has the deceptive look of a
252 ;; data dependency but it's not - it's a control dependency which as per
253 ;; the 'memory-barriers.txt' document at kernel.org, demands a barrier.
254 ;; The subsequent ref to storage (if the loop iterates) has a
255 ;; data-dependency, and will never be reordered except on an Alpha :-(
256 ;; so we _don't_ need a barrier after resetting 'storage' and 'index'.
265 ;; ENV and KEY are as above. UPDATE-PROC is invoked with the old value stored
266 ;; for KEY and it should return the possibly-unchanged new value to put.
267 ;;
268 ;; Note a tiny problem of semantics on 'miss' - for an instant after winning
269 ;; CAS of a new key, that key appears to exist with the default value NIL,
270 ;; causing readers to think "FOUND-P" = T which might have a different sense
271 ;; from "not found". If a Name is transiently "found" despite having no data,
272 ;; nobody cares, at least for globaldb. Remedies, if desired, involve either:
273 ;; 1. Making a "no value" marker that is distinct from NIL.
274 ;; 2. Placing keys/value pairs in adjacent cells and using double-wide CAS.
275 ;; The reason we don't care about this anomaly is that we have to
276 ;; look in an Info-Vector [q.v.] anyway to get the whole picture.
277 ;;
288 ;; invariant: OLDVAL is not a forwarding pointer.
291 oldval ; forgo update
294 ;; Unlike above, this read of storage-next can not
295 ;; be perceived as having occurred prior to CAS.
296 ;; x86 synchronizes at every locked instruction, and our
297 ;; PPC CAS vops sync as a nececessity of performing CAS.
308 :miss
314 ;; any thread could have beaten us to rehashing
319 ;; Attempt to claim KEY-INDEX
322 ;; Optimistically assume that nobody else rewrote the value
325 ;; The fallthrough branch of this COND is ordinary CAS failure where
326 ;; somebody else wanted this slot, and won. Looping tries again.
330 ;; as preemptive check up above ensured no rehash needed.
334 ;; Rehash ENV to a larger storage. When writing a key into new storage,
335 ;; key cells are uniquely owned by this thread without contention.
336 ;; Other threads may not look in new storage without first observing that
337 ;; a key's value was definitely moved.
338 ;; The rehasher marks empty cells as unusable so that writers can't insert
339 ;; into the subsequence of storage already visited. The rehasher must of
340 ;; course vie for the cell it is trying to mark as unusable.
341 ;;
345 ;; the new storage begins life at ~50% capacity
355 ;; If the indexed cell is not in use, try once to prevent subsequent
356 ;; writes by changing the empty marker to 'unavailable'. The outcome
357 ;; determines whether to continue transporting the cell's value.
362 key))
373 ;; Copy the current value into the new storage,
374 ;; and CAS in a forwarding pointer. Repeat until successful.
376 ;; Force VALUE to memory before publishing relocated status
381 old-storage old-value-index value
387 ;; Typical of most lockfree algorithms, we've no idea when
388 ;; the old storage can be freed. GC will figure it out.
389 ;; No write barrier needed. Threads still looking at old storage
390 ;; will eventually find all cells unavailable or forwarded.
393 ;; This maphash implementation is not threadsafe.
394 ;; It can be made threadsafe by following forwarded values
395 ;; and skipping over unavailable keys.
396 ;;
409 ;; CAS is the primitive operation on an info hashtable,
410 ;; and SETF is implemented in terms of CAS. For the most part it is
411 ;; inadvisable to use this for anything other than tinkering at the REPL.
412 ;;
420 ;;;; Info-Vectors
421 ;;;; ============
423 ;;; Info for a Name (an arbitrary object) is stored in an Info-Vector,
424 ;;; which is like is a 2-level association list. Info-Vectors are stored in
425 ;;; symbols for most names, or in the global hashtable for "complicated" names.
427 ;;; Such vectors exists in two variations: packed and unpacked.
428 ;;; The representations are nearly equivalent for lookup, but the packed format
429 ;;; is more space-efficient, though difficult to manipulate except by unpacking.
431 ;;; Consider a family of Names whose "root" is SB-MOP:STANDARD-INSTANCE-ACCESS.
432 ;;; 1. SB-MOP:STANDARD-INSTANCE-ACCESS
433 ;;; 2. (SETF SB-MOP:STANDARD-INSTANCE-ACCESS)
434 ;;; 3. (CAS SB-MOP:STANDARD-INSTANCE-ACCESS)
435 ;;;
436 ;;; Those three names share one Info-Vector. Conceptually the outer alist key
437 ;;; is NIL for the first of those names, and SETF/CAS for the latter two.
438 ;;; The inner alist key is a number identifying a type of info.
439 ;;; If it were actually an alist, it would look like this:
440 ;;;
441 ;;; ((nil (63 . #<fdefn SB-MOP:STANDARD-INSTANCE-ACCESS>) (1 . :FUNCTION) ...)
442 ;;; (SETF (63 . #<fdefn (SETF SB-MOP:STANDARD-INSTANCE-ACCESS)>) ...)
443 ;;; (CAS (63 . #<fdefn (CAS SB-MOP:STANDARD-INSTANCE-ACCESS)>) ...)
444 ;;; ...)
445 ;;;
446 ;;; Note:
447 ;;; * The root name is exogenous to the vector - it is not stored.
448 ;;; * The info-number for (:FUNCTION :DEFINITION) is 63, :KIND is 1, etc.
449 ;;; * Names which are lists of length other than 2, or improper lists,
450 ;;; or whose elements are not both symbols, are disqualified.
452 ;;; Packed vector layout
453 ;;; --------------------
454 ;;; Because the keys to the inner lists are integers in the range 0 to 63,
455 ;;; either 5 or 10 keys will fit into a fixnum depending on word size.
456 ;;; This permits one memory read to retrieve a collection of keys. In packed
457 ;;; format, an ordered set of keys ("fields") is called a "descriptor".
458 ;;;
459 ;;; Descriptors are stored from element 0 upward in the packed vector,
460 ;;; and data are indexed downward from the last element of the vector.
461 ;;;
462 ;;; #(descriptor0 descriptor1 ... descriptorN valueN ... value1 value0)
463 ;;;
464 ;;; e.g. The field at absolute index 3 - vector element 0, bit position 18 -
465 ;;; will find its data at index (- END 3). In this manner, it doesn't matter
466 ;;; how many more descriptors exist.
468 ;;; A "group" comprises all the info for a particular Name, and its list
469 ;;; of types may may span descriptors, though rarely.
470 ;;; An "auxilliary key" is the first element of a 2-list Name. It is interposed
471 ;;; within the data portion of the vector after the preceding info group.
472 ;;; Descriptors are self-delimiting in that the first field in a group
473 ;;; indicates the number of additional fields in the group.
475 ;;; Unpacked vector layout
476 ;;; ----------------------
477 ;;; This representation is used transiently during insertion/deletion.
478 ;;; It is a concatenation of plists as a vector, interposing at the splice
479 ;;; points the auxilliary key for the group, except for the root name which
480 ;;; does not store an auxilliary key.
481 ;;;
482 ;;; Unpacked vector format looks like:
483 ;;;
484 ;;; /- next group starts here
485 ;;; v
486 ;;; #(length type val type val ... KEY length type val ... KEY length ...)
487 ;;; ^
488 ;;; info group for the primary Name, a/k/a "root symbol", starts here
489 ;;;
490 ;;; One can envision that the first info group stores its auxilliary key
491 ;;; at vector index -1 when thinking about the correctness of algorithms
492 ;;; that process unpacked info-vectors.
493 ;;; See !TEST-PACKIFY-INFOS for examples of each format.
495 ;;;;; Some stuff moved from 'globaldb.lisp':
499 ;; Using 6 bits per packed field, 5 infos can be described in a 30-bit fixnum,
500 ;; or 10 in a fixnum on 64-bit machines (regardless of n-fixnum-tag-bits).
501 ;; The eval-when seems to be necessary for building with CCL as host.
505 ;; Descriptors are target fixnums
508 ;; An empty info-vector. Its 0th field describes that there are no more fields.
511 ;; FDEFINITIONs have an info-number that admits slightly clever logic
512 ;; for INFO-VECTOR-FDEFN. Do not change this constant without
513 ;; careful examination of that function.
516 ;; Extract a field from a packed info descriptor.
517 ;; A field is either a count of info-numbers, or an info-number.
524 ;; Compute the number of elements needed to hold unpacked VECTOR after packing.
525 ;; This is not "compute-packed-info-size" since that could be misconstrued
526 ;; as expecting the vector to be already packed.
527 ;;
534 ;; 'length' is the number of vector elements in this info group,
535 ;; including itself but not including its auxilliary key.
537 ;; Divide by 2 because we only count one field for the entry, but the
538 ;; input vector had 2 cells per entry. Add 1 because the group's field
539 ;; count is accounted for in the total packed field count.
543 ;; The first info group lacks an aux-key, making n-fields 1 too high
544 ;; in terms of data cells used, but correct for packed fields.
547 ;; MAKE-INFO-DESCRIPTOR is basically ASH-LEFT-MODFX, shifting VAL by SHIFT.
548 ;; It is important that info descriptors be target fixnums, but 'cross-modular'
549 ;; isn't loaded early enough to use 'mask-signed-field'.
550 ;; It's not needed on 64-bit host/target combination because 10 fields (60 bits)
551 ;; never touch the sign bit.
552 ;; FIXME: figure out why the definition of ash-left-modfx is
553 ;; conditionalized out for platforms other than x86[-64].
554 ;; It looks like it ought to work whether or not there are vops.
561 ;; Convert unpacked vector to packed vector.
562 ;; 'pack-infos' would be a hypothetical accessor for the 'infos' of a 'pack'
563 ;; (whatever that is ...) so verbifying as such makes it more mnemonic to me.
564 ;;
575 field-shift)
583 ;; Truncating divide by 2: count = n-elements in the group @ 2 per entry,
584 ;; +1 for count itself but not including its aux-key.
596 output))
598 ;; Within the scope of BODY, bind GENERATOR to a local function which
599 ;; returns the next field from a descriptor in INPUT-VAR, a packed vector.
600 ;; The generator uses DESCRIPTOR-INDEX and updates it as a side-effect.
601 ;;
623 ;; Iterate over VECTOR, binding DATA-INDEX to the index of each aux-key in turn.
624 ;; TOTAL-N-FIELDS is deliberately exposed to invoking code.
625 ;;
636 ;; Loop through the descriptors in random-access fashion.
637 ;; Skip 1+ n-infos each time, because the 'n-infos' is itself a field
638 ;; that is not accounted for in its own value.
645 ;; Done when the ascending index and descending index meet
650 ;; Return all function names that are stored in SYMBOL's info-vector.
651 ;; As an example, (INFO-VECTOR-NAME-LIST 'SB-PCL::DIRECT-SUPERCLASSES) =>
652 ;; ((SB-PCL::SLOT-ACCESSOR :GLOBAL SB-PCL::DIRECT-SUPERCLASSES SB-PCL::READER)
653 ;; (SB-PCL::SLOT-ACCESSOR :GLOBAL SB-PCL::DIRECT-SUPERCLASSES BOUNDP)
654 ;; (SB-PCL::SLOT-ACCESSOR :GLOBAL SB-PCL::DIRECT-SUPERCLASSES SB-PCL::WRITER))
661 list))
665 ;; Compute the number of elements needed to hold packed VECTOR after unpacking.
666 ;; The unpacked size is the number of auxilliary keys plus the number of entries
667 ;; @ 2 cells per entry, plus the number of length cells which indicate the
668 ;; number of data cells used (including length cells but not aux key cells).
669 ;; Equivalently, it's the number of packed fields times 2 minus 1.
670 ;;
674 ;; off-by-one: the first info group's auxilliary key is imaginary
677 ;; Convert packed INPUT vector to unpacked.
678 ;; If optional OUTPUT is supplied, it is used, otherwise output is allocated.
679 ;; For efficiency the OUTPUT should be provided as a dynamic-extent array.
680 ;;
690 ;; store the info group length, including the length cell in the length
699 ;; Return the index of the 'length' item for an info group having
700 ;; auxilliary-key KEY in unpacked VECTOR bounded by END (exclusive),
701 ;; or NIL if not found.
702 ;;
710 ;; skip 'length' cells plus the next aux-key
714 ;; backward a cell is where the aux-key resides.
718 ;; In packed info VECTOR try to find the auxilliary key SYMBOL.
719 ;; If found, return indices of its data, info descriptor word, and field.
720 ;; If not found, the first value is NIL and the descriptor indices
721 ;; arbitrarily point to the next available descriptor field.
722 ;;
724 ;; explicit bounds checking is done by the code below
729 ;; On each iteration DATA-IDX points to an aux-key cell
730 ;; The first group's imaginary aux-key cell is past the end.
734 ;; Efficiently skip past N-INFOS infos. If decrementing the data index
735 ;; hits the descriptor index, we're done. Otherwise increment the field
736 ;; index and maybe descriptor index and check again for loop termination.
739 ;; descriptor-idx < data-idx, so potentially more data.
740 ;; If current descriptor has another field, continue.
748 ;; While this could compare aux-keys with #'EQUAL, it is not obvious how
749 ;; in general one would pick a symbol from the name as that which
750 ;; is delegated as the one to hold the info-vector.
752 ;; At least one aux key is present.
754 ;; aux-key order invariant allows early fail on SETF
759 field-idx)))
765 ;; Take a packed info-vector INPUT and insert (AUX-KEY,INFO-NUMBER,VALUE).
766 ;; Packed info-vectors are immutable. Any alteration must create a copy.
767 ;; This is done by unpacking/repacking - it's easy enough and fairly
768 ;; efficient since the temporary vector is stack-allocated.
769 ;;
773 ;; Test if the aux-key has been seen before or needs to be added.
790 ;; creating a new aux key. SETF immediately follows the data
791 ;; for the primary Name. All other aux-keys go to the end.
798 aux-key new old-size)))
799 ;; it had better be found - it was in the packed vector
801 ;; fdefn must be the first piece of info for any name.
802 ;; This facilitates implementing SYMBOL-FUNCTION without
803 ;; without completely decoding the vector.
806 info-number value)
807 ;; add 2 cells, and verify that re-packing won't
808 ;; overflow the 'count' for this info group.
813 ;; Return T if INFO-VECTOR admits quicker insertion logic - it must have
814 ;; exactly one descriptor for the root name, space for >= 1 more field,
815 ;; and no aux-keys.
819 ;; We can easily determine if the no-aux-keys constraint is satisfied,
820 ;; because a secondary name's info occupies at least two cells,
821 ;; one for its aux-key and >= 1 for info values.
825 ;; Take a packed info-vector INPUT and return a new one with INFO-NUMBER/VALUE
826 ;; added for the root name. The vector must satisfy INFO-QUICKLY-INSERTABLE-P.
827 ;; This code is separate from PACKED-INFO-INSERT to facilitate writing
828 ;; a unit test of this logic against the complete logic.
829 ;;
831 ;; Because INPUT contains 1 descriptor and its corresponding values,
832 ;; the current length is exactly NEW-N, the new number of fields.
836 ;; Two cases: we're either inserting info for the fdefn, or not.
838 ;; fdefn, if present, must remain the first packed field.
839 ;; Replace the lowest field (the count) with +fdefn-info-num+,
840 ;; shift everything left 6 bits, then OR in the new count.
845 ;; Packed vectors are indexed "backwards". The first
846 ;; field's info is in the highest numbered cell.
851 ;; Add a field on the high end and increment the count.
857 ;; Slide the old data up 1 cell.
860 new-vect))
869 ;; Search packed VECTOR for AUX-KEY and INFO-NUMBER, returning
870 ;; the index of the data if found, or NIL if not found.
871 ;;
882 ;; Fetch a descriptor and shift out trailing bits that won't be scanned.
886 ;; Compute n things in this descriptor after extracting one field. e.g.
887 ;; if starting index = 2, there's space for 7 more fields in 60 bits.
889 ;; Type inference on n-infos deems it to have no lower bound due to DECF.
893 ;; Repeatedly shift and mask, which is quicker than extracting a field at
894 ;; varying positions. Start by shifting out the n-infos field.
910 ;; Helper for CLEAR-INFO-VALUES when Name has the efficient form.
911 ;; Given packed info-vector INPUT and auxilliary key KEY2
912 ;; return a new vector in which TYPE-NUMS are absent.
913 ;; When none of TYPE-NUMs were present to begin with, return NIL.
914 ;;
915 ;; While this could determine whether it would do anything before unpacking,
916 ;; clearing does not happen often enough to warrant the pre-check.
917 ;;
937 return probe)))
938 ;; N.B. the early termination checks aren't just optimizations,
939 ;; they're requirements, because otherwise the loop could smash
940 ;; data that does not belong to this auxilliary key.
942 ;; Squash out 2 cells if deleting an info for primary name,
943 ;; or for secondary name with at least one more entry.
948 ;; the group is now comprised solely of its length cell
951 ;; Delete the sole entry for a secondary name
952 ;; by removing aux-key, length, and one entry (a cell pair).
958 ;; All empty info-vectors are equivalent, so if
959 ;; unpacked vector has no data, return a constant.
963 ;; We need a few magic constants to be shared between the next two functions.
968 ;; PCL names are physically 4-lists (see "pcl/slot-name")
969 ;; that get treated as 2-component names for globaldb's purposes.
970 ;; Return the kind of PCL slot accessor name that NAME is, if it is one.
971 ;; i.e. it matches (SLOT-ACCESSOR :GLOBAL <sym> READER|WRITER|BOUNDP)
972 ;; When called, NAME is already known to start with 'SLOT-ACCESSOR.
973 ;; This has to be defined before building PCL.
976 kind)
982 ;; Return symbols that can't conflict, in case somebody
983 ;; legitimates (BOUNDP <f>) via DEFINE-FUNCTION-NAME-SYNTAX.
984 ;; Especially important since BOUNDP is an external of CL.
989 ;; The first return value is what matters to WITH-GLOBALDB-NAME
990 ;; for deciding whether the name is "simple".
991 ;; Return the KIND first, just in case somehow we end up with
992 ;; (SLOT-ACCESSOR :GLOBAL NIL WRITER) as a name.
993 ;; [It "can't happen" since NIL is a constant though]
997 ;; Construct a name from its parts.
998 ;; For PCL global accessors, produce the real name, not the 2-part name.
999 ;; This operation is not invoked in normal use of globaldb.
1000 ;; It is only for mapping over all names.
1007 ;; Call FUNCTION with each piece of info in packed VECT using ROOT-SYMBOL
1008 ;; as the primary name. FUNCTION must accept 3 values (NAME INFO-NUMBER VALUE).
1022 #|
1028 =>
1035 Which is interpreted as:
1044 This is interpreted as
1048 |#
1050 ;; Reshape inputs per the above commented example to a packed vector.
1051 ;; The info for a symbol's fdefn must precede other info-numbers.
1052 ;; and SETF must be the first aux key if other aux keys are present.
1053 ;; The test function does not enforce these invariants.
1076 ;; Given a NAME naming a globaldb object, decide whether the NAME has
1077 ;; an efficient or "simple" form, versus a general or "hairy" form.
1078 ;; The efficient form is either a symbol, a (CONS SYMBOL (CONS SYMBOL NULL)),
1079 ;; or a PCL global slot {reader, writer, boundp} function name.
1080 ;;
1081 ;; If NAME is "simple", bind KEY2 and KEY1 to the elements
1082 ;; in that order, and execute the SIMPLE code, otherwise execute the HAIRY code.
1083 ;; If ALLOW-ATOM is T - the default - then NAME can be just a symbol
1084 ;; in which case its second component is +NO-AUXILLIARY-KEY+.
1085 ;;
1100 ,simple
1101 ;; The KEYs remain bound, but they should not be used for anything.
1104 ;; Given Info-Vector VECT, return the fdefn that it contains for its root name,
1105 ;; or nil if there is no value. NIL input is acceptable and will return NIL.
1109 ;; This is safe: Info-Vector invariant requires that it have length >= 1.
1111 ;; Test that the first info-number is +fdefn-info-num+ and its n-infos
1112 ;; field is nonzero. These conditions can be tested simultaneously
1113 ;; using a SIMD-in-a-register idea. The low 6 bits must be nonzero
1114 ;; and the next 6 must be exactly #b111111, so considered together
1115 ;; as a 12-bit unsigned integer it must be >= #b111111000001
1118 ;; DATA-REF-WITH-OFFSET doesn't know the info-vector length invariant,
1119 ;; so depite (safety 0) eliding bounds check, FOLD-INDEX-ADDRESSING
1120 ;; wasn't kicking in without (TRULY-THE (INTEGER 1 *)).
1123 ;;; Some of this stuff might belong in 'symbol.lisp', but can't be,
1124 ;;; because 'symbol.lisp' is :NOT-HOST in build-order.
1126 ;; In the target, UPDATE-SYMBOL-INFO is defined in 'symbol.lisp'.
1127 #+sb-xc-host
1129 ;; Never pass NIL to an update-fn. Pass the minimal info-vector instead,
1130 ;; a vector describing 0 infos and 0 auxilliary keys.
1137 ;;; The current *INFO-ENVIRONMENT*, a structure of type INFO-HASHTABLE.
1138 ;;; Cheat by setting to nil before the type is proclaimed
1139 ;;; so that we can then also proclaim ALWAYS-BOUND.
1141 #-sb-xc-host
1145 ;;; Update the INFO-NUMBER for NAME in the global environment,
1146 ;;; setting it to NEW-VALUE. This is thread-safe in the presence
1147 ;;; of multiple readers/writers. Threads simultaneously writing data
1148 ;;; for the same NAME will succeed if the info type numbers differ,
1149 ;;; and the winner is indeterminate if the type numbers are the same.
1150 ;;;
1151 ;;; It is not usually a good idea to think of globaldb as an arbitrary
1152 ;;; key-to-value map supporting rapid or frequent update for a key.
1153 ;;; This is because each update must shallow-copy any data that existed
1154 ;;; for NAME, as a consequence of the very minimal lockfree protocol.
1155 ;;;
1156 ;;; If, for example, you wanted to track how many times a full-call to
1157 ;;; each global function was emitted during compilation, you could create
1158 ;;; an info-type (:function :full-calls) and the value of that info-type
1159 ;;; could be a cons cell holding an integer. In this way incrementing
1160 ;;; the cell contents does not affecting the globaldb. In contrast,
1161 ;;; (INCF (INFO :function :full-calls myname)) would perform poorly.
1162 ;;;
1163 ;;; See also ATOMIC-SET-INFO-VALUE and GET-INFO-VALUE-INITIALIZING
1164 ;;; for atomic read/modify/write operations.
1165 ;;;
1166 ;;; Return the new value so that this can be conveniently used in a
1167 ;;; SETF function.
1172 ;; Storage of FAST-METHOD and SLOW-METHOD compiler info is largely pointless.
1173 ;; Why? Because the compiler can't even resolve the "name" of the function in
1174 ;; many cases. If there are EQL specializers involved, it's clearly impossible
1175 ;; because the form X in (EQL x) needs to be evaluated. So most of the data
1176 ;; can't be computed until the file defining the method is loaded. At that
1177 ;; point, you know that the :KIND is :FUNCTION, and :WHERE-FROM is :DEFINED
1178 ;; - they can't be anything else. And you also pretty much know the signature,
1179 ;; since it is based on the specializers, so storing again is a total waste.
1180 ;;
1181 ;; FIXME: figure out a way not to store these, or else have globaldb ignore
1182 ;; the calls to set-info-value, and mock any calls to get-info-value
1183 ;; so that it looks like the data were stored, if someone tries to read it.
1184 ;: Or store the data in the method object somehow so that at least dropping
1185 ;; a method can drop the data. This would work because as mentioned above,
1186 ;; there is mostly no such thing as purely compile-time info for methods.
1196 ;; If the INFO-NUMBER already exists in VECT, then copy it and
1197 ;; alter one cell; otherwise unpack it, grow the vector, and repack.
1206 copy)))))
1208 :simple
1209 ;; UPDATE-SYMBOL-INFO never supplies OLD-INFO as NIL.
1212 :hairy
1213 ;; INFO-PUTHASH supplies NIL for OLD-INFO if NAME was absent.
1218 new-value)
1220 ;; Instead of accepting a new-value, call NEW-VALUE-FUN to compute it
1221 ;; from the existing value. The function receives two arguments:
1222 ;; if there was already a value, that value and T; otherwise two NILs.
1223 ;; Return the newly-computed value. If NEW-VALUE-FUN returns the old value
1224 ;; (compared by EQ) when there was one, then no globaldb update is made.
1236 vect aux-key info-number
1241 vect ; return the old vector
1244 copy)))))))
1246 :simple
1247 ;; UPDATE-SYMBOL-INFO never supplies OLD-INFO as NIL.
1250 :hairy
1251 ;; INFO-PUTHASH supplies NIL for OLD-INFO if NAME was absent.
1256 new-value))
1258 ;; %GET-INFO-VALUE-INITIALIZING is provided as a low-level operation similar
1259 ;; to the above because it does not require info metadata for defaulting,
1260 ;; nor deal with the keyword-based info type designators at all.
1261 ;; In contrast, GET-INFO-VALUE requires metadata.
1262 ;; For this operation to make sense, the objects produced should be permanently
1263 ;; assigned to their name, such as are fdefns and classoid-cells.
1264 ;; Note also that we do not do an initial attempt to read once with INFO,
1265 ;; followed up by a double-checking get-or-set operation. It is assumed that
1266 ;; the user of this already did an initial check, if such is warranted.
1271 result)
1279 ;; Update conflicts possibly for unrelated info-number
1280 ;; can force re-execution. (UNLESS result ...) tries
1281 ;; to avoid calling the thunk more than once.
1285 result))))))
1287 :simple
1288 ;; UPDATE-SYMBOL-INFO never supplies OLD-INFO as NIL.
1291 :hairy
1292 ;; INFO-PUTHASH supplies NIL for OLD-INFO if NAME was absent.
1296 ;; Return OLD-INFO to elide writeback. Unlike for
1297 ;; UPDATE-SYMBOL-INFO, NIL is not a no-op marker.
1298 old-info)))
1300 result))