| blob | 7721b717cc6fe83c2b283b08a9c0529484c12849 |
1 ;;;; that part of DEFSTRUCT implementation which is needed not just
2 ;;;; in the target Lisp but also in the cross-compilation host
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
16 \f
17 ;;;; getting LAYOUTs
19 ;;; Return the compiler layout for NAME. (The class referred to by
20 ;;; NAME must be a structure-like class.)
29 res))))
39 ;; Non-toplevel defstructs don't have a layout at compile time,
40 ;; so we need to construct the actual function at runtime -- but
41 ;; we cache it at the call site, so that we don't perform quite
42 ;; so horribly.
57 i))
65 i))
68 %make-structure-instance-allocator))
74 var))
86 object)))))
87 \f
88 ;;;; DEFSTRUCT-DESCRIPTION
90 ;;; The DEFSTRUCT-DESCRIPTION structure holds compile-time information
91 ;;; about a structure type.
92 ;;; Its definition occurs in 'early-classoid.lisp'
97 ;;; Does DD describe a structure with a class?
109 \f
110 ;;;; DEFSTRUCT-SLOT-DESCRIPTION
112 ;;; A DEFSTRUCT-SLOT-DESCRIPTION holds compile-time information about
113 ;;; a structure slot. These objects are immutable.
122 ;; Packed integer with 4 subfields.
123 ;; FIXNUM is ok for the host - it's guaranteed to be at least 16 signed bits
124 ;; and we don't have structures whose slot indices run into the thousands.
130 ;; Ensure that rsd-index is representable in 3 bits. (Can easily be changed)
139 ;; (ash 1 7) meaning DEFAULT doesn't match TYPE is set during compilation of the constructor.
147 dsd-safe-p
148 dsd-gc-ignorable
149 ; dsd-read-only ; compilation order problem
150 ))
152 ;;; In general we type-check a slot when it is written, not when read.
153 ;;; There are cases where we must check each read though:
155 ;;; (1) a structure subtype can constrain a slot type more highly than the
156 ;;; parent type constrains it. This requires that each read via the subtype's
157 ;;; accessor be type-checked, because a write via the parent writer may
158 ;;; store a value that does not satisfy the more restrictive constraint.
159 ;;; These slots have SAFE-P = 0 in the dsd.
160 ;;; (2) If a BOA constructor leaves an ordinary (non-raw) slot uninitialized,
161 ;;; then the slot contains the unbound-marker which can be tested with just
162 ;;; an EQ comparison. Such slots have ALWAYS-BOUNDP = 0 in the dsd.
163 ;;; This does not apply to raw slots, which can not hold an unbound marker.
165 ;;; Note that inheritance in the presence of a BOA constructor can cause
166 ;;; the parent structure's notion of ALWAYS-BOUNDP to be wrong.
167 ;;; We don't try to deal with that.
168 ;;; FIXME: We could emit a style-warning if this happens, and/or if any code
169 ;;; was compiled under the assumption that the slot was safe.
171 ;;; Further note that MAKE-LOAD-FORM methods can do damage to type invariants
172 ;;; without any efficient means of detection, if MAKE-LOAD-FORM-SAVING-SLOTS
173 ;;; is used without specifying all slots.
175 ;; Index into *RAW-SLOT-DATA* vector of the RAW-SLOT-DATA for this slot.
176 ;; The index is NIL if this slot is not raw.
180 ;;; GC-ignorable slots are a superset of raw slots.
183 ;; Whether the slot is always bound. Slots are almost always bound,
184 ;; the exception being those which appear as an &AUX var with no value
185 ;; in a BOA constructor.
187 ;; Whether the slot is known to be always of the specified type
188 ;; A slot may be SAFE-P even if not always-boundp.
191 ;; its position in the implementation sequence
218 \f
219 ;;;; typed (non-class) structures
221 ;;; Return a type specifier we can use for testing :TYPE'd structures.
226 \f
227 ;;;; shared machinery for inline and out-of-line slot accessor functions
229 ;;; Classic comment preserved for entertainment value:
230 ;;;
231 ;;; "A lie can travel halfway round the world while the truth is
232 ;;; putting on its shoes." -- Mark Twain
234 ;;;; the legendary DEFSTRUCT macro itself (both CL:DEFSTRUCT and its
235 ;;;; close personal friend SB-XC:DEFSTRUCT)
239 #-sb-xc-host
257 ;;; Since DSDs live a long time for inheritance purposes don't attach
258 ;;; the source form to them directly.
263 ;; Return the ordinary toplevel (usually, anyway) defuns
275 ;; Return fragements of code that CLOS can use. We don't return
276 ;; the toplevel DEFUNs because those generally perform an
277 ;; unneeded type-check unless in safety 0. These CLOS-related
278 ;; lambdas don't need to check the type of the instance because
279 ;; it was already subject to type-based dispatch, and must let
280 ;; unbound markers through for the CLOS machinery to handle.
281 ;;
282 ;; FIXME: it seems like all these fragments should be packed
283 ;; into a single codebob which will have less overhead than
284 ;; separate blobs. Afaict, the only way to do that is to return
285 ;; one lambda that returns all the lambdas.
290 ;; reader and writer are the primitive operations
292 ;; accessor is the global defun
298 ;; no typecheck
306 ;; Most slots are safe-p (type-safe for reading),
307 ;; so we can be concise rather than use SLOT-ACCESS-TRANSFORM
308 ;; plus a rebinding of X with TRULY-THE.
310 ;; Don't check X, but do check the the fetched value.
315 ;;; shared logic for host macroexpansion for SB-XC:DEFSTRUCT and
316 ;;; cross-compiler macroexpansion for CL:DEFSTRUCT
317 ;;; This monster has exactly one inline use in the final image,
318 ;;; and we can drop the definition.
319 ;;;
320 ;;; The DELAYP argument deserves some explanation - Because :COMPILE-TOPLEVEL effects
321 ;;; of non-toplevel DEFSTRUCT forms don't happen, the compiler is unable to produce
322 ;;; good accessor code. By delaying compilation until the DEFSTRUCT happens, whenever
323 ;;; or if ever that may be, we can produce better code. DELAY, if true, says to defer
324 ;;; compilation, ignoring the original lexical environment. This approach produces a
325 ;;; nicer expansion in general, versus macroexpanding to yet another macro whose sole
326 ;;; purpose is to sense that earlier compile-time effects have happened.
327 ;;;
328 ;;; Some caveats: (1) a non-toplevel defstruct compiled after already seeing
329 ;;; the same, due to repeated compilation of a file perhaps, will use the known
330 ;;; definition, since technically structures must not be incompatibly redefined.
331 ;;; (2) delayed DEFUNS don't get the right TLF index in their debug info.
332 ;;; We could expand into the internal expansion of DEFUN with an extra argument
333 ;;; for the source location, which would get whatever "here" is instead of random.
334 ;;; In other words: `(progn (sb-impl::%defun struct-slot (...) ... ,(source-location))
335 ;;; and then use that to stuff in the correct info at delayed-compile time.
336 ;;;
337 ;;; Note also that sb-fasteval has some hairy logic to JIT-compile slot accessors.
338 ;;; It might be a lot nicer to pull out that junk, and have this expander know that
339 ;;; it is producing code for fasteval, and explicitly compile much the same way
340 ;;; that delayed accessor compilation happens. Here's a REPL session:
341 ;;; * (defstruct foo val) => FOO
342 ;;; * #'foo-val => #<INTERPRETED-FUNCTION FOO-VAL>
343 ;;; * (defun foovalx (afoo) (* (foo-val afoo) 2)) => FOOVALX
344 ;;; * (foovalx (make-foo :val 9)) => 18
345 ;;; * #'foo-val => #<FUNCTION FOO-VAL>
346 ;;; So FOO-VAL got compiled on demand.
347 ;;;
350 slot-descriptions expanding-into-code-for)
357 ;; Rather than hit MAKE-DEFSTRUCT-DESCRIPTION's type-check
358 ;; on the NAME slot, we can be a little more clear.
368 :constructor
369 nil
378 ;; Giving empty :PRINT-OBJECT or :PRINT-FUNCTION options
379 ;; leaves FNAME eq to NIL. The user-level effect is
380 ;; to generate a PRINT-OBJECT method specialized for the type,
381 ;; implementing the default #S structure-printing behavior.
385 ;; Don't dump the source form into the DD constant;
386 ;; just indicate that there was an expression there.
391 ;; Return a list of forms
394 ;; Note we intentionally enforce package locks, calling
395 ;; %DEFSTRUCT first. %DEFSTRUCT has the tests (and resulting
396 ;; CERROR) for collisions with LAYOUTs which already exist in
397 ;; the runtime. If there are collisions, we want the user's
398 ;; response to CERROR to control what happens. If the ABORT
399 ;; restart is chosen, %COMPILER-DEFSTRUCT should not modify
400 ;; the definition the class.
418 defuns))
419 ;; This must be in the same lexical environment
420 ,@constructor-definitions
421 ,@print-method
422 ;; Various other operations only make sense on the target SBCL.
423 ;; %TARGET-DEFSTRUCT returns NAME
428 ;; Not DD-CLASS-P
429 ;; FIXME: missing package lock checks
439 ,@constructor-definitions
446 ;; Process the easiest slots first.
447 ;; TODO: consecutive word-sized slots should try to use instructions
448 ;; that compare more than one word at a time.
456 ;; unbounded but not recursive. Try EQ first though
462 comparators)
463 ;; use a string for the name since it's not a global function
469 #+sb-xc-host
471 ;; When compiling and loading the cross-compiler, SB-XC:DEFSTRUCT gets
472 ;; a bootstrap definition from src/code/defbangstruct.
473 ;; The old definition has to be uninstalled to avoid a redefinition warning here.
477 "Cause information about a target structure to be built into the
478 cross-compiler."
484 "DEFSTRUCT {Name | (Name Option*)} [Documentation] {Slot | (Slot [Default] {Key Value}*)}
485 Define the structure type Name. Instances are created by MAKE-<name>,
486 which takes &KEY arguments allowing initial slot values to the specified.
487 A SETF'able function <name>-<slot> is defined for each slot to read and
488 write slot values. <name>-p is a type predicate.
490 Popular DEFSTRUCT options (see manual for others):
492 (:CONSTRUCTOR Name)
493 (:PREDICATE Name)
494 Specify the name for the constructor or predicate.
496 (:CONSTRUCTOR Name Lambda-List)
497 Specify the name and arguments for a BOA constructor
498 (which is more efficient when keyword syntax isn't necessary.)
500 (:INCLUDE Supertype Slot-Spec*)
501 Make this type a subtype of the structure type Supertype. The optional
502 Slot-Specs override inherited slot options.
504 Slot options:
506 :TYPE Type-Spec
507 Asserts that the value of this slot is always of the specified type.
509 :READ-ONLY {T | NIL}
510 If true, no setter function is defined for this slot."
514 ;; a LOCALLY environment would be fine,
515 ;; but is not an important case to handle.
518 ;; Decide whether the expansion should delay reference
519 ;; to this structure type. (See explanation up above).
520 ;; This is about performance, not semantics. Non-toplevel
521 ;; effects happen when they should even if this were to
522 ;; produce the preferred expansion for toplevel.
527 ,@(!expander-for-defstruct null-env-p optimize-speed delayp
528 name-and-options slot-descriptions
530 \f
531 ;;;; functions to generate code for various parts of DEFSTRUCT definitions
533 ;;; First, a helper to determine whether a name names an inherited
534 ;;; accessor.
538 ;;; Return a list of forms which create a predicate function for a
539 ;;; typed DEFSTRUCT.
561 ~/sb-impl:print-type-specifier/."
562 ltype))))))))))
564 ;;; Return a list of forms to create a copier function of a typed DEFSTRUCT.
570 ;;; Return a list of function definitions for accessing and setting
571 ;;; the slots of a typed DEFSTRUCT. The functions are proclaimed to be
572 ;;; inline, and the types of their arguments and results are declared
573 ;;; as well. We count on the compiler to do clever things with ELT.
599 slot with name ~S (accessing an inherited slot ~
602 \f
603 ;;;; parsing
605 ;;; CLHS says that
606 ;;; A defstruct option can be either a keyword or a list of a keyword
607 ;;; and arguments for that keyword; specifying the keyword by itself is
608 ;;; equivalent to specifying a list consisting of the keyword
609 ;;; and no arguments.
610 ;;; It is unclear whether that is meant to imply that any of the keywords
611 ;;; may be present in their atom form, or only if the grammar at the top
612 ;;; shows the atom form does <atom> have the meaning of (<atom>).
613 ;;; At least one other implementation accepts :NAMED as a singleton list.
614 ;; We take a more rigid view that the depicted grammar is exhaustive.
615 ;;;
617 ;; Each keyword, except :CONSTRUCTOR which may appear more than once,
618 ;; and :NAMED which is trivial, and unambiguous if present more than
619 ;; once, though possibly worth a style-warning.
631 ;;; Parse a single DEFSTRUCT option and store the results in DD.
656 (:conc-name
657 ;; unlike (:predicate) and (:copier) which mean "yes" if supplied
658 ;; without their argument, (:conc-name) and :conc-name mean no conc-name.
659 ;; Also note a subtle difference in :conc-name "" vs :conc-name NIL.
660 ;; The former re-interns each slot name into *PACKAGE* which might
661 ;; not be the same as using the given name directly as an accessor.
668 ;; Implementations disagree on the meaning of
669 ;; (:CONSTRUCTOR NIL (A B C)).
670 ;; The choices seem to be: don't define a constructor,
671 ;; define a constructor named NIL, signal a user error,
672 ;; or crash the system itself. The spec implies
673 ;; the behavior that we have, but at least a
674 ;; style-warning seems appropriate.
685 lambda-list
691 (:copier
693 (:predicate
695 (:include
704 (:type
708 ;; The spec is self-contradictory about this!
709 ;; It defines:
710 ;; type-option::= (:type type)
711 ;; type --- one of the type specifiers list, vector, or (vector size),
712 ;; or some other type specifier defined by the implementation to be appropriate.
713 ;; However the description of the keyword makes it pretty clear that
714 ;; the option's syntax is (vector /element-type/).
715 ;; I'm not sure if it's valid to specify (VECTOR *) as the representation.
716 ;; CLISP thinks it is not, but only signals an error when the constructor
717 ;; is called. So at minimum it's unportable, if not illegal.
722 (:named
724 (:initial-offset
726 (:pure
731 seen-options))
733 ;;; Parse OPTIONS into the given DD.
749 ;; FIXME: ugly message (defstruct (s :include) a)
750 ;; saying "unrecognized" when it means "bad syntax"
752 dd seen-options))))
757 #-compact-instance-header
759 ;; FIXME: It'd be cleaner to treat no-:INCLUDE as defaulting
760 ;; to :INCLUDE STRUCTURE-OBJECT, and then let the general-case
761 ;; (INCF (DD-LENGTH DD) (DD-LENGTH included-DD)) logic take
762 ;; care of this. (Except that the :TYPE VECTOR and :TYPE
763 ;; LIST cases, with their :NAMED and un-:NAMED flavors,
764 ;; make that messy, alas.)
767 ;; In case we are here, :TYPE is specified.
769 ;; CLHS - "The structure can be :named only if the type SYMBOL
770 ;; is a subtype of the supplied element-type."
775 type ~/sb-impl:print-type-specifier/"
795 ;; Remove (NIL) and sort so that BOA constructors are last.
801 nil)
807 ;; POSITION is constant-foldable, but folding happens _after_ transforming to
808 ;; a CASE expression which is surprising. CASE could invoke either POINTERP
809 ;; or NON-NULL-SYMBOL-P would would need to be emulated in the cross-compiler.
810 ;; That's easy to do, but it's even easier to reduce to a constant via macro
811 ;; as it doesn't require the extra support functions.
821 seen-options))
823 ;;; Given name and options and slot descriptions (and possibly doc
824 ;;; string at the head of slot descriptions) return a DD holding that
825 ;;; info.
832 #-sb-xc-host
839 ;; The classoid needs a layout whereby to convey inheritance.
840 ;; Classoids only store a *direct* superclass list.
841 ;; Both the layout and classoid are throwaway objects.
842 ;; It's probably too dangerous to stack-allocate, because references
843 ;; could leak from the type cache machinery.
846 classoid inherits)))
848 classoid)))
850 #+sb-xc-host
853 ;; Type parsing should be done assuming that prototype classoid
854 ;; exists, which fixes a problem when redefining a DEFTYPE which
855 ;; appeared to be a raw slot. e.g.
856 ;; (DEFTYPE X () 'SINGLE-FLOAT) and later (DEFSTRUCT X (A 0 :TYPE X)).
857 ;; This is probably undefined behavior, but at least we'll not crash.
858 ;; Also make self-referential definitions not signal PARSE-UNKNOWN-TYPE
859 ;; on slots whose :TYPE option allows an instance of itself
877 \f
878 ;;;; stuff to parse slot descriptions
880 ;;; Decide whether TYPE as stored in a structure can be a raw slot.
881 ;;; Return the index of the matching RAW-SLOT-DATA if it should be, NIL if not.
883 ;; If TYPE isn't a subtype of NUMBER, it can't go in a raw slot.
884 ;; In the negative case (which is most often), doing 1 SUBTYPEP test
885 ;; beats doing 5 or 6.
887 ;; FIXNUMs and smaller go in tagged slots, not raw slots
894 ;;; Parse a slot description for DEFSTRUCT, add it to the description
895 ;;; and return it. If supplied, INCLUDED-SLOT is used to get the default,
896 ;;; type, and read-only flag for the new slot.
899 ctype rsd-index index)
909 spec)
914 spec
916 ;; the warning here is useful, but in principle we cannot
917 ;; distinguish between legitimate and erroneous use of
918 ;; these names when :CONC-NAME is NIL. In the common
919 ;; case (CONC-NAME non-NIL), there are alternative ways
920 ;; of writing code with the same effect, so a full
921 ;; warning is justified.
928 read-only ro-p)))
930 spec)))
941 name
947 name))
950 ;; Some adventurous soul has named a slot so that its accessor
951 ;; collides with the structure type predicate. ANSI doesn't
952 ;; specify what to do in this case. As of 2001-09-04, Martin
953 ;; Atzmueller reports that CLISP and Lispworks both give
954 ;; priority to the slot accessor, so that the predicate is
955 ;; overwritten. We might as well do the same (as well as
956 ;; signalling a warning).
958 "~@<The structure accessor name ~S is the same as the name of the ~
959 structure type predicate. ANSI doesn't specify what to do in ~
960 this case. We'll overwrite the type predicate with the slot ~
961 accessor, but you can't rely on this behavior, so it'd be wise to ~
962 remove the ambiguity in your code.~@:>"
963 accessor-name)
965 ;; FIXME: It would be good to check for name collisions here, but
966 ;; the easy check,
967 ;;x#-sb-xc-host
968 ;;x(when (and (fboundp accessor-name)
969 ;;x (not (accessor-inherited-data accessor-name defstruct)))
970 ;;x (style-warn "redefining ~/sb-ext:print-symbol-with-prefix/ ~
971 ;; in DEFSTRUCT" accessor-name))
972 ;; which was done until sbcl-0.8.11.18 or so, is wrong: it causes
973 ;; a warning at MACROEXPAND time, when instead the warning should
974 ;; occur not just because the code was constructed, but because it
975 ;; is actually compiled or loaded.
976 )
986 #+sb-xc-host
987 ;; Test whether the type can hold NIL. This avoids a bootstrapping
988 ;; problem involving forward references to undefined types,
989 ;; because we want never to pass unknown types into CROSS-TYPEP.
990 ;; But also, don't call SB-XC:TYPEP on a type-specifier because it does
991 ;; not receive a type-context which specifies the proto-classoid.
1005 be :READ-ONLY in subclass.~:@>"
1006 name)))
1016 ;; Compute the index of this DSD. First decide whether the slot is raw.
1022 ;; If slot requires alignment of 2, then ensure that
1023 ;; it has an odd (i.e. doubleword aligned) index.
1034 ;; Check for existence of any BOA constructor that leaves the
1035 ;; slot with an unspecified value, as when it's initialized
1036 ;; by an &AUX binding with no value (CLHS 3.4.6)
1039 ;; Keyword constructors store :DEFAULT in the cdr of the cell.
1040 ;; BOA constructors store the parsed lambda list.
1045 name)))
1050 ;; FIXME: the :TYPE option should not preclude storing #<unbound>
1051 ;; unless the storage is a specialized numeric vector.
1055 ;; Check for writable slots in pure structures
1056 #+nil
1067 always-boundp gc-ignorable
1068 rsd-index)
1069 default)))
1073 ;; this is enough specialization for now
1087 ;; %ELEMENT-TYPE might actually be * which is weird
1088 ;; but seems to mostly work. I suspect that it should not.
1091 ;; In theory we have the ability to represent that all slots
1092 ;; of a classoid structure are of type SB-VM:WORD (for example),
1093 ;; but in practice that is not useful.
1094 ;; Just don't return * which is not a type specifier.
1095 t)))
1097 ;;; Process any included slots pretty much like they were specified.
1098 ;;; Also inherit various other attributes.
1107 ;; checks on legality
1115 ;; It's not particularly well-defined to :INCLUDE any of the
1116 ;; CMU CL INSTANCE weirdosities like CONDITION or
1117 ;; GENERIC-FUNCTION, and it's certainly not ANSI-compliant.
1122 included-name)))))
1124 ;; A few more sanity checks: every allegedly modified slot exists
1125 ;; and no name appears more than once.
1132 name))
1136 name)))
1137 modified-slots))
1141 ;; FIXME: This POSITION call should be foldable without read-time eval
1142 ;; since literals are immutable, and +DD-OPTION-NAMES+ was initialized
1143 ;; from a literal.
1158 ;; We stash away an alist of accessors to parents' slots
1159 ;; that have already been created to avoid conflicts later
1160 ;; so that structures with :INCLUDE and :CONC-NAME (and
1161 ;; other edge cases) can work as specified.
1163 ;; the "oldest" (i.e. highest up the tree of inheritance)
1164 ;; will prevail, so don't push new ones on if they
1165 ;; conflict.
1174 ;; XXX: notify?
1175 ))))))))
1176 \f
1177 ;;;; various helper functions for setting up DEFSTRUCTs
1179 ;;; This function is called at macroexpand time to compute the INHERITS
1180 ;;; vector for a structure type definition.
1181 ;;; The cross-compiler is allowed to magically compute LAYOUT-INHERITS.
1194 ;; STREAM is an abstract class and you can't :include it,
1195 ;; so the inheritance has to be hardcoded.
1205 sb-impl::string-output-stream
1217 ;;; Do miscellaneous (LOAD EVAL) time actions for the structure
1218 ;;; described by DD. Create the class and LAYOUT, checking for
1219 ;;; incompatible redefinition.
1223 ;; We set up LAYOUTs even in the cross-compilation host.
1238 ;; Don't want to (setf find-classoid) on a a built-in-classoid
1246 \f
1247 ;;; Return the transform of OPERATION which is either :READ or :SETF.
1248 ;;; as applied to ARGS, given SLOT-KEY which is a cons of a DD and a DSD.
1249 ;;; FUN-OR-MACRO, which is used only for the :SETF operation,
1250 ;;; indicates whether the argument order corresponds to
1251 ;;; (funcall #'(setf mystruct-myslot) newval s) ; :FUNCTION
1252 ;;; versus
1253 ;;; (setf (mystruct-myslot s) newval) ; :MACRO
1254 ;;; Return NIL on failure.
1256 &optional
1265 (:read
1269 ;; There are 4 cases of {safe,unsafe} x {always-boundp,possibly-unbound}
1270 ;; If unsafe - which implies TYPE-SPEC other than type T - then we must
1271 ;; check the type on each read. Assuming that type-checks reject
1272 ;; the unbound-marker, then we needn't separately check for it, but if
1273 ;; we're generating code fragments for CLOS (which does its own
1274 ;; EXTERNAL-UNBOUND-HANDLING) we need to let it through explicitly.
1280 ;; unless the slot is always bound, or unbound handling is external,
1281 ;; check here for unbound marker.
1293 (:setf
1294 ;; The primitive object slot setting vops take newval last, which matches
1295 ;; the order in which a use of SETF has them, but because the vops
1296 ;; do not return anything, we have to bind both arguments.
1303 ;; This used only for source-transforming (funcall #'(setf myslot) ...).
1304 ;; (SETF x) writer functions have been defined as source-transforms instead of
1305 ;; inline functions, which improved the semantics around clobbering defstruct
1306 ;; writers with random DEFUNs either deliberately or accidentally.
1307 ;; Since users can't define source-transforms (not portably anyway),
1308 ;; we can easily discern which functions were system-generated.
1322 ;;; Apply TRANSFORM - a special indicator stored in :SOURCE-TRANSFORM
1323 ;;; for a DEFSTRUCT copier, accessor, or predicate - to SEXPR.
1324 ;;; NAME is needed to select between the reader and writer transform.
1329 ;; All defstruct-defined things use the :source-transform as
1330 ;; an indicator of magic-ness, but actually doing the transform
1331 ;; for constructors could cause inadvertent variable capture.
1332 nil)
1345 ;;; Blow away all the compiler info for the structure CLASS. Iterate
1346 ;;; over this type, clearing the compiler structure type info, and
1347 ;;; undefining all the associated functions. If SUBCLASSES-P, also do
1348 ;;; the same for subclasses. FIXME: maybe rename UNDEFINE-FUN-NAME to
1349 ;;; UNDECLARE-FUNCTION-NAME?
1355 ;; FIXME: shouldn't this undeclare any constructors too?
1364 ;; Clear out the SPECIFIER-TYPE cache so that subsequent
1365 ;; references are unknown types.
1373 ;; Is it really necessary to warn about
1374 ;; undeclaring functions for subclasses?
1379 ;;; core compile-time setup of any class with a LAYOUT, used even by
1380 ;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS weirdosities
1386 inherits
1388 "The most recently compiled"
1390 "the most recently loaded"
1397 ;; FIXME: it might be polite to hold onto old-layout and
1398 ;; restore it at the end of the file. -- RMK 2008-09-19
1399 ;; (International Talk Like a Pirate Day).
1401 classoid))
1405 ;; Don't want to (setf find-classoid) on a a built-in-classoid
1410 ;; At this point the class should be set up in the INFO database.
1411 ;; But the logic that enforces this is a little tangled and
1412 ;; scattered, so it's not obvious, so let's check.
1424 ;;; Do (COMPILE LOAD EVAL)-time actions for the structure described by DD
1425 ;;; which may be a "normal" defstruct or an alternate-metaclass struct.
1426 ;;; This includes generation of a style-warning about previously compiled
1427 ;;; calls to the accessors and/or predicate that weren't inlined.
1433 ;; Why use the secondary result of INFO, not the primary?
1434 ;; Because when DEFSTRUCT is evaluated, not via the file-compiler,
1435 ;; the first thing to happen is %DEFSTRUCT, which sets up FIND-CLASS.
1436 ;; Due to :COMPILER-LAYOUT's defaulting expression in globaldb,
1437 ;; it has a value - the layout of the classoid - that we don't want.
1438 ;; Also, since structures are technically not redefineable,
1439 ;; I don't worry about failure to inline a function that was
1440 ;; formerly not known as an accessor but now is.
1446 ;; Don't check-inlining because ctors aren't always inlined
1457 ;; Why this WHEN guard here, if there is neither a standards-specified
1458 ;; nor implementation-specific way to skip defining an accessor? Dunno.
1459 ;; And furthermore, by ignoring a package lock, it's possible to name
1460 ;; an accessor NIL: (defstruct (x (:conc-name "N")) IL)
1461 ;; making this test kinda bogus in two different ways.
1471 slot-key)
1478 slot with name ~S (accessing an inherited slot ~
1479 instead).~:@>"
1480 accessor-name
1486 ;; This message omits the http://en.wikipedia.org/wiki/Serial_comma
1488 ~{~/sb-ext:print-symbol-with-prefix/~^~#[~; and~:;,~] ~} ~
1489 could not be inlined because the structure definition for ~
1490 ~/sb-ext:print-symbol-with-prefix/ was not yet seen. To avoid this warning, ~
1491 DEFSTRUCT should precede references to the affected functions, ~
1492 or they must be declared locally notinline at each call site.~@:>"
1494 \f
1495 ;;;; redefinition stuff
1497 ;;; Compare the slots of OLD and NEW, returning 3 lists of slot names:
1498 ;;; 1. Slots which have moved,
1499 ;;; 2. Slots whose type has changed,
1500 ;;; 3. Deleted slots.
1520 ;;; If we are redefining a structure with different slots than in the
1521 ;;; currently loaded version, give a warning and return true.
1530 "incompatibly redefining slots of structure class ~S~@
1531 Make sure any uses of affected accessors are recompiled:~@
1532 ~@[ These slots were moved to new positions:~% ~S~%~]~
1533 ~@[ These slots have new incompatible types:~% ~S~%~]~
1534 ~@[ These slots were deleted:~% ~S~%~]"
1535 name moved retyped deleted)
1536 t))))
1538 ;;; Return true if destructively modifying OLD-LAYOUT into NEW-LAYOUT
1539 ;;; would be possible in as much as it won't harm the garbage collector.
1540 ;;; Harm potentially results from turning a raw word into a tagged word.
1541 ;;; There are additional mutations which would be permissible but don't
1542 ;;; strike me as important - e.g. permitting a fixnum slot to become type T
1543 ;;; is permissible, but the fixnum may or may not be marked as tagged
1544 ;;; in the bitmap, depending on whether any raw slot exists.
1545 ;;; I can't imagine that many users will complain that they can no longer
1546 ;;; incompatibly redefine defstructs involving raw slots.
1547 ;;; Additionally, it is no longer possible to RECKLESSLY-CONTINUE on a defstruct
1548 ;;; if the number of words in the layout would differ due to extra ID words,
1549 ;;; but given that it was already not possible if the bitmaps differ,
1550 ;;; it does not seem a big sacrifice to disallow redefining structures
1551 ;;; at depthoids in excess of 7 (LAYOUT-ID-VECTOR-FIXED-CAPACITY) unless
1552 ;;; both the old and new structure are at the same depthoid.
1553 #-sb-xc-host
1559 ;; The number of extra ID words has to match, as does the number of bitmap
1560 ;; words, or else GC will croak when parsing the bitmap.
1569 t))
1571 ;;; This function is called when we are incompatibly redefining a
1572 ;;; structure CLASS to have the specified NEW-LAYOUT. We signal an
1573 ;;; error with some proceed options and return the layout that should
1574 ;;; be used.
1582 'structure-object
1583 name)
1587 "~@<Use the new definition of ~S, invalidating ~
1588 already-loaded code and instances.~@:>"
1589 name))
1591 #-sb-xc-host
1598 "~@<Use the new definition of ~S as if it were ~
1599 compatible, allowing old accessors to use new ~
1600 instances and allowing new accessors to use old ~
1601 instances.~@:>"
1602 name))
1603 ;; classic CMU CL warning: "Any old ~S instances will be in a bad way.
1604 ;; I hope you know what you're doing..."
1606 :invalidate nil
1616 ;;; Compute DD's bitmap, storing 1 for each tagged word.
1617 ;;; The GC can parse signed fixnums and bignums, with which we can
1618 ;;; represent an unlimited number of "&rest" slots all with the same
1619 ;;; nature - tagged or raw. If REST is :TAGGED or :UNTAGGED, it
1620 ;;; specifies a particular nature. If :UNSPECIFIC, then we sign-extend
1621 ;;; from the last specified slot which tends to reduce the bitmap to
1622 ;;; -1 in the case of everything being tagged, (or -2 if non-compact
1623 ;;; header), or a small positive fixnum if the last is untagged.
1624 ;;;
1625 ;;; Bit indices correspond to physical word indices excluding
1626 ;;; the header word. So the least-significant bit of a bitmap is
1627 ;;; always the word just after the instance header word.
1628 ;;;
1629 ;;; Examples: (Legend: u=untaggged slot, t=tagged slot)
1630 ;;;
1631 ;;; logical arithmetic
1632 ;;; bitmap value
1633 ;;; Funcallable object:
1634 ;;; Executable w/ standard header: #b.101000 -24
1635 ;;; word0: header
1636 ;;; word1: (*) entry address
1637 ;;; word2: (u) machine instructions
1638 ;;; word3: (u) machine instructions
1639 ;;; word4: (t) implementation-fun
1640 ;;; word5: (u) layout
1641 ;;; word6: (t) tagged slots ...
1642 ;;; Executable w/ compact header: #b...1000 -8
1643 ;;; word0: header/layout
1644 ;;; word1: (*) entry address
1645 ;;; word2: (u) machine instructions
1646 ;;; word3: (u) machine instructions
1647 ;;; word4: (t) implementation-fun
1648 ;;; word5: (t) tagged slots ...
1649 ;;; Non-executable: #b...1010 -6
1650 ;;; word0: header
1651 ;;; word1: (*) entry address
1652 ;;; word2: (t) implementation-fun
1653 ;;; word3: (u) layout
1654 ;;; word4: (t) tagged slots ...
1655 ;;; (*) entry address can be treated as either tagged or raw.
1656 ;;; For some architectures it has a lowtag, but points to
1657 ;;; read-only space. For others it is a fixnum.
1658 ;;; In either case the GC need not observe the value.
1664 ;;;
1665 ;;; Ordinary instance with only tagged slots:
1666 ;;; Non-compact header: #b...1110 -2
1667 ;;; word0: header
1668 ;;; word1: (u) layout
1669 ;;; word2: (t) tagged slots ...
1670 ;;; Compact header: #b...1111 -1
1671 ;;; word0: header/layout
1672 ;;; word1: (t) tagged slots ...
1673 ;;; Ordinary instance with only raw slots slots:
1674 ;;; [this also includes objects whose slots all have types
1675 ;;; ignorable by GC such as fixum/character]
1676 ;;; Non-compact header: #b...0000 0
1677 ;;; word0: header
1678 ;;; word1: (u) layout
1679 ;;; word2: (u) raw slots ...
1680 ;;; Compact header: #b...0000 0
1681 ;;; word0: header/layout
1682 ;;; word1: (u) raw slots ...
1683 ;;;
1684 ;;; Notes:
1685 ;;; 1. LAYOUT has to be scanned separately regardless of where stored.
1686 ;;; (compact header or not). Hence it is regarded as an untagged slot.
1687 ;;; 2. For funcallable objects these examples are exhaustive of all
1688 ;;; possible bitmaps. The instance length can be anything,
1689 ;;; but untagged slots are not generally supported.
1690 ;;; For ordinary instance the examples are merely illustrative.
1691 ;;;
1694 #+sb-xc-host
1699 ;; Compute two masks with a 1 bit for each dsd-index which contains a descriptor.
1700 ;; The "mininal" bitmap contains a 1 for each slot which *must* be scanned in GC,
1701 ;; and the "maximal" bitmap contains a 1 for each which *may* be scanned.
1702 ;; If a non-raw slot type can be ignored - such as (OR FIXNUM NULL), then it
1703 ;; sets a 1 in the maximal bitmap but not in the minimal bitmap.
1704 ;; Note that the GC can always add one slot for a stable hash, but that slot
1705 ;; can only hold a fixnum, so need not be traced even though it is a descriptor.
1719 ;; If the structure has a custom GC scavenging method then always return
1720 ;; the minimal bitmap, and disallow arbitrary trailing slots.
1721 ;; The optimization for all-tagged (avoiding use of the bitmap)
1722 ;; indicates in addition to no raw slots, no custom GC method either.
1723 ;; As of now this only pertains to lockfree-singly-linked-list nodes
1724 ;; and descendant types. (The lockfree list uses one pointer bit
1725 ;; as a pending-deletion flag. See "src/code/target-lflist.lisp")
1728 ;; Pretend there are raw slots so that the layout
1729 ;; does not get the STRICTLY-BOXED flag set.
1732 ;; The minimal bitmap will have the least number of bits set, and the maximal
1733 ;; will have the most, but it is not always a performance improvement to prefer
1734 ;; fewer bits. If the total number of bits is large, and there are no raw slots,
1735 ;; then the "all tagged" treatment may be better because it does not need to
1736 ;; parse the bitmap. But if there are any raw slots, the minimal bitmap is best.
1739 any-raw ; must use a bitmap
1740 ;; for other cases, it is not clear-cut
1744 minimal-bitmap
1745 maximal-bitmap)))
1747 ;; If the trailing slots have tagged nature, extend bitmap with
1748 ;; an infinite sequence of 1 bits. If :UNSPECIFIC, replicate
1749 ;; the most-significant-bit whether it be 0 or 1.
1756 bitmap))
1757 any-raw))))
1759 ;;; This is called when we are about to define a structure class. It
1760 ;;; returns a (possibly new) class object and the layout which should
1761 ;;; be used for the new definition (may be the current layout, and
1762 ;;; also might be an uninstalled forward referenced layout.) The third
1763 ;;; value is true if this is an incompatible redefinition, in which
1764 ;;; case it is the old layout.
1766 &key compiler-layout
1781 constructor))
1784 ;; Argh, could this case be any more opaque???
1785 ;; It's ostensibly the set of types whose superclasse would come out wrong
1786 ;; if we didn't fudge them manually. But the computation of the superclass
1787 ;; list is obfuscated. I think we have assertions about this somewhere.
1788 ;; But ideally we remove this junky case from the target image somehow
1789 ;; while leaving it in for self-build.
1791 fd-stream
1805 ;; FIXME: explain why this is #-sb-xc-host.
1806 #-sb-xc-host
1812 flags)))
1817 classoid
1818 :flags flags
1819 :inherits inherits
1827 ;; The assignment of INFO here can almost be deleted,
1828 ;; except for a few magical types that don't d.t.r.t. in cold-init:
1829 ;; STRUCTURE-OBJECT, CONDITION, ALIEN-VALUE, INTERPRETED-FUNCTION
1833 ;; of classic CMU CL. I moved it out to here because it was only
1834 ;; exercised in this code path anyway. -- WHN 19990510
1838 old-layout
1839 new-context
1856 \f
1857 ;;; Return a list of pairs (name . index). Used for :TYPE'd
1858 ;;; constructors to find all the names that we have to splice in &
1859 ;;; where. Note that these types don't have a layout, so we can't look
1860 ;;; at LAYOUT-INHERITS.
1878 \f
1879 ;;; These functions are called to actually make a constructor after we
1880 ;;; have processed the arglist. The correct variant (according to the
1881 ;;; DD-TYPE) should be called. The function is defined with the
1882 ;;; specified name and arglist. VARS and TYPES are used for argument
1883 ;;; type declarations. VALUES are the values for the slots (in order.)
1884 ;;;
1885 ;;; This is split into two functions:
1886 ;;; * INSTANCE-CONSTRUCTOR-FORM has to deal with raw slots
1887 ;;; * TYPED-CONSTRUCTOR-FORM deal with LIST & VECTOR
1888 ;;; which might have "name" symbols stuck in at various weird places.
1901 dd-slots values)
1903 )
1905 ;;; A "typed" constructor prefers to use a single call to LIST or VECTOR
1906 ;;; if possible, but can't always do that for VECTOR because it might not
1907 ;;; be a (VECTOR T). If not, we fallback to MAKE-ARRAY and (SETF AREF).
1916 ;; Possibly the most useless feature ever: more than one name slot.
1920 ;; The initial-element provides values for slots that are skipped
1921 ;; due to :initial-offset, not slots that are skipped due to
1922 ;; &AUX variables with no initial value.
1927 ;; For both vectors and lists, .DO-NOT-INITIALIZE-SLOT.
1928 ;; becomes 0 even though lists otherwise use NIL for slots
1929 ;; that are skipped to due :initial-offset.
1931 ;; All VALs have been wrapped in THE if necessary.
1933 slots values)
1939 names)
1943 slots values)
1946 ;;; Return the FTYPE for a DD constructor.
1947 ;;; This is tricky in uses such as the following:
1948 ;;; (DEFSTRUCT (S (:CONSTRUCTOR MS (A &AUX (A (ABS A))))) (A 0 :TYPE (MOD 4)))
1949 ;;; The constructor accepts integers betweeen -3 and 3 because the &AUX binding
1950 ;;; hides the positional argument A, and we can't actually put any constraint
1951 ;;; on A unless we figure out what the action of ABS is.
1952 ;;;
1953 ;;; The FTYPE is actually not a strong enough constraint anyway, so when IR1
1954 ;;; tests for the call compatibility it will test for correctness *after*
1955 ;;; argument defaulting.
1969 aux)))
1974 ;; If no slot, the arg restriction is T,
1975 ;; because we don't know where it goes.
1981 opt)
1986 keys))))))
1992 ;;; Return the ftype of global function NAME.
1999 ;; This case is used only for DEFKNOWN. It allows some out-of-order
2000 ;; definitions during bootstrap while avoiding the "uncertainty in typep"
2001 ;; error. It would work for user code as well, but users shouldn't write
2002 ;; out-of-order type definitions. In any case, it's not wrong to leave
2003 ;; this case in.
2007 ctype))
2008 ;; In the absence of global info for a defstruct snippet, get the compiler's
2009 ;; opinion based on the defstruct definition, rather than reflecting on the
2010 ;; current function (as defined "now") which is what globaldb would get in
2011 ;; effect by calling FTYPE-FROM-FDEFN, that being less precise.
2020 (:constructor
2032 type))))
2034 ;;; Given a DD and a constructor spec (a cons of name and pre-parsed
2035 ;;; BOA lambda list, or the symbol :DEFAULT), return the effective
2036 ;;; lambda list and the body of the lambda.
2057 default))))
2076 var
2104 ;; If VAR initializes a slot and did not have a default in
2105 ;; the lambda list, and DSD-DEFAULT is not NIL,
2106 ;; then change the lambda-list's default for the variable.
2107 ;; Always prefer to insert (CAR ARG) if ARG was a list
2108 ;; so that (:KEY var) syntax is preserved.
2110 default)
2116 ;; Can we substitute symbols that are not EQ to symbols
2117 ;; naming slots, so we don't have to compare by STRING= later?
2118 ;; Probably not because other symbols could reference them.
2125 llks nil req opt rest keys
2126 ;; &AUX vars which do not initialize a slot are not mentioned
2127 ;; in the lambda list, though it's not clear what to do if
2128 ;; subsequent bindings refer to the deleted ones.
2129 ;; And worse, what if it's SETQd - is that even legal?
2135 creator dd
2139 ;; CLHS 3.4.6 Boa Lambda Lists
2140 '.do-not-initialize-slot.
2144 ;; We can ignore the DD-ELEMENT-TYPE
2145 ;; because the container itself will check.
2148 \f
2149 ;;;; instances with ALTERNATE-METACLASS
2150 ;;;;
2151 ;;;; The CMU CL support for structures with ALTERNATE-METACLASS was a
2152 ;;;; fairly general extension embedded in the main DEFSTRUCT code, and
2153 ;;;; the result was an fairly impressive mess as ALTERNATE-METACLASS
2154 ;;;; extension mixed with ANSI CL generality (e.g. :TYPE and :INCLUDE)
2155 ;;;; and CMU CL implementation hairiness (esp. raw slots). This SBCL
2156 ;;;; version is much less ambitious, noticing that ALTERNATE-METACLASS
2157 ;;;; is only used to implement CONDITION, STANDARD-INSTANCE, and
2158 ;;;; GENERIC-FUNCTION, and defining a simple specialized
2159 ;;;; separate-from-DEFSTRUCT macro to provide only enough
2160 ;;;; functionality to support those.
2161 ;;;;
2162 ;;;; KLUDGE: The defining macro here is so specialized that it's ugly
2163 ;;;; in its own way. It also violates once-and-only-once by knowing
2164 ;;;; much about structures and layouts that is already known by the
2165 ;;;; main DEFSTRUCT macro. Hopefully it will go away presently
2166 ;;;; (perhaps when CL:CLASS and SB-PCL:CLASS meet) as per FIXME below.
2167 ;;;; -- WHN 2001-10-28
2168 ;;;;
2169 ;;;; FIXME: There seems to be no good reason to shoehorn CONDITION,
2170 ;;;; STANDARD-INSTANCE, and GENERIC-FUNCTION into mutated structures
2171 ;;;; instead of just implementing them as primitive objects. (This
2172 ;;;; reduced-functionality macro seems pretty close to the
2173 ;;;; functionality of !DEFINE-PRIMITIVE-OBJECT..)
2175 ;;; The complete list of alternate-metaclass DEFSTRUCTs:
2176 ;;; CONDITION SB-KERNEL:INTERPRETED-FUNCTION
2177 ;;; SB-PCL::STANDARD-INSTANCE SB-PCL::STANDARD-FUNCALLABLE-INSTANCE
2178 ;;; SB-PCL::CTOR SB-PCL::%METHOD-FUNCTION
2179 ;;;
2184 metaclass-constructor
2185 slot-names)
2189 ;; We do *not* fill in the COPIER-NAME and PREDICATE-NAME
2190 ;; because alternate-metaclass structures can not have either.
2192 ;; We don't fully support inheritance of alternate metaclass stuff,
2193 ;; so sanity check our own code.
2196 ;; Without compact instance headers, the index starts at 1 for
2197 ;; named slots, because slot 0 is the LAYOUT.
2198 ;; This is the same in ordinary structures too: see (INCF DD-LENGTH)
2199 ;; in PARSE-DEFSTRUCT-NAME-AND-OPTIONS.
2200 ;; With compact instance headers, slot 0 is a data slot.
2207 metaclass-name
2208 metaclass-constructor)
2217 nil t t nil nil)
2218 nil)))
2219 slot-names)
2222 dd))
2235 superclass-name
2236 metaclass-name
2237 metaclass-constructor))
2242 :class-name class-name
2243 :slot-names slot-names
2244 :superclass-name superclass-name
2245 :metaclass-name metaclass-name
2246 :metaclass-constructor metaclass-constructor
2260 ;; I think the only nonfuncallable alternate-metaclass structure
2261 ;; is CONDITION, which has its own fancy constructor.
2262 ;; Maybe this should be (bug "Can't happen") ?
2273 x))
2275 ,@set-layout
2277 ;; fmt-control is not an executable function
2283 object))))
2285 #+sb-xc-host
2288 \f
2289 ;;;; finalizing bootstrapping
2291 ;;; Set up DD and LAYOUT for STRUCTURE-OBJECT class itself.
2292 ;;;
2293 ;;; Ordinary structure classes effectively :INCLUDE STRUCTURE-OBJECT
2294 ;;; when they have no explicit :INCLUDEs, so (1) it needs to be set up
2295 ;;; before we can define ordinary structure classes, and (2) it's
2296 ;;; special enough (and simple enough) that we just build it by hand
2297 ;;; instead of trying to generalize the ordinary DEFSTRUCT code.
2308 info)
2316 info)))
2323 #+sb-xc-host
2336 #+sb-xc-host
2339 ;;; It is possible to produce instances of structure-object which violate
2340 ;;; the assumption throughout the compiler that slot readers are safe
2341 ;;; unless dictated otherwise by the SAFE-P flag in the DSD.
2342 ;;; * (defstruct S a (b (error "Must supply me") :type symbol))
2343 ;;; * (defmethod make-load-form ((x S) &optional e) (m-l-f-s-s x :slot-names '(a)))
2344 ;;; After these definitions, a dumped S will have #<unbound> in slot B.
2346 environment)
2362 #-sb-xc-host
2377 ;;; Compute a SAP to the specified slot in INSTANCE.
2378 ;;; This looks mildly redundant with DEFINE-STRUCTURE-SLOT-ADDRESSOR,
2379 ;;; but that one returns an integer, not a SAP.
2386 #+sb-xc-host
2392 subclassoids
2400 #'pred
2401 ;; pair = (#<classoid> . #<layout>)
2412 classoid-name