| blob | 7fd53389a2a4a0eb2d905eaeb127288773a632b5 |
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.
52 %make-structure-instance-allocator))
72 ;;; Delay looking for compiler-layout until the constructor is being
73 ;;; compiled, since it doesn't exist until after the EVAL-WHEN
74 ;;; (COMPILE) stuff is compiled. (Or, in the oddball case when
75 ;;; DEFSTRUCT is executing in a non-toplevel context, the
76 ;;; compiler-layout still doesn't exist at compilation time, and we
77 ;;; delay still further.)
81 ;; ordinary case: When the DEFSTRUCT is at top level,
82 ;; then EVAL-WHEN (COMPILE) stuff will have set up the
83 ;; layout for us to use.
88 ;; KLUDGE: In the case that DEFSTRUCT is not at top-level
89 ;; the layout doesn't exist at compile time. In that case
90 ;; we laboriously look it up at run time. This code will
91 ;; run on every constructor call and will likely be quite
92 ;; slow, so if anyone cares about performance of
93 ;; non-toplevel DEFSTRUCTs, it should be rewritten to be
94 ;; cleverer. -- WHN 2002-10-23
96 "implementation limitation: ~
104 ;;; re. %DELAYED-GET-COMPILER-LAYOUT and COMPILE-TIME-FIND-LAYOUT, above..
105 ;;;
106 ;;; FIXME: Perhaps both should be defined with SB!XC:DEFMACRO?
107 ;;; FIXME: Do we really need both? If so, their names and implementations
108 ;;; should probably be tweaked to be more parallel.
109 \f
110 ;;;; DEFSTRUCT-DESCRIPTION
112 ;;; The DEFSTRUCT-DESCRIPTION structure holds compile-time information
113 ;;; about a structure type.
114 ;;; Its definition occurs in 'early-classoid.lisp'
119 ;;; Does DD describe a structure with a class?
125 \f
126 ;;;; DEFSTRUCT-SLOT-DESCRIPTION
128 ;;; A DEFSTRUCT-SLOT-DESCRIPTION holds compile-time information about
129 ;;; a structure slot. These objects are immutable.
138 ;; Packed integer with 4 subfields.
139 ;; FIXNUM is ok for the host - it's guaranteed to be at least 16 signed bits
140 ;; and we don't have structures whose slot indices run into the thousands.
146 ;; Ensure that rsd-index is representable in 3 bits. (Can easily be changed)
149 ;; genesis needs to know how many bits are to the right of the 'index' field
150 ;; in the packed BITS slot of a DSD.
160 dsd-safe-p
161 ; dsd-read-only ; compilation order problem
162 ; dsd-index
163 ))
165 ;;; In general we type-check a slot when it is written, not when read.
166 ;;; There are cases where we must check each read though:
168 ;;; (1) a structure subtype can constrain a slot type more highly than the
169 ;;; parent type constrains it. This requires that each read via the subtype's
170 ;;; accessor be type-checked, because a write via the parent writer may
171 ;;; store a value that does not satisfy the more restrictive constraint.
172 ;;; These slots have SAFE-P = 0 in the dsd.
173 ;;; (2) If a BOA constructor leaves an ordinary (non-raw) slot uninitialized,
174 ;;; then the slot contains the unbound-marker which can be tested with just
175 ;;; an EQ comparison. Such slots have ALWAYS-BOUNDP = 0 in the dsd.
176 ;;; This does not apply to raw slots, which can not hold an unbound marker.
178 ;;; Note that inheritance in the presence of a BOA constructor can cause
179 ;;; the parent structure's notion of ALWAYS-BOUNDP to be wrong.
180 ;;; We don't try to deal with that.
181 ;;; FIXME: We could emit a style-warning if this happens, and/or if any code
182 ;;; was compiled under the assumption that the slot was safe.
184 ;;; Further note that MAKE-LOAD-FORM methods can do damage to type invariants
185 ;;; without any efficient means of detection, if MAKE-LOAD-FORM-SAVING-SLOTS
186 ;;; is used without specifying all slots.
188 ;; Index into *RAW-SLOT-DATA* vector of the RAW-SLOT-DATA for this slot.
189 ;; The index is -1 if this slot is not raw.
193 ;; Whether the slot is always bound. Slots are almost always bound,
194 ;; the exception being those which appear as an &AUX var with no value
195 ;; in a BOA constructor.
197 ;; Whether the slot is known to be always of the specified type
198 ;; A slot may be SAFE-P even if not always-boundp.
201 ;; its position in the implementation sequence
215 \f
216 ;;;; typed (non-class) structures
218 ;;; Return a type specifier we can use for testing :TYPE'd structures.
223 \f
224 ;;;; shared machinery for inline and out-of-line slot accessor functions
226 ;;; Classic comment preserved for entertainment value:
227 ;;;
228 ;;; "A lie can travel halfway round the world while the truth is
229 ;;; putting on its shoes." -- Mark Twain
231 ;;;; the legendary DEFSTRUCT macro itself (both CL:DEFSTRUCT and its
232 ;;;; close personal friend SB!XC:DEFSTRUCT)
235 ;; KLUDGE: If DEFSTRUCT is not at the top-level,
236 ;; (typep x 'name) and similar forms can't get optimized
237 ;; and produce style-warnings for unknown types.
240 forms
263 ;;; Special var used by autogenerated print functions.
266 ;;; shared logic for host macroexpansion for SB!XC:DEFSTRUCT and
267 ;;; cross-compiler macroexpansion for CL:DEFSTRUCT
268 ;;; This monster has exactly one inline use in the final image,
269 ;;; and we can drop the definition.
272 expanding-into-code-for)
284 ;; Quasi-bogus: not all the right effects on globaldb
285 ;; happen by defining functions this cheating way.
293 boa-constructors)))
301 ;; Giving empty :PRINT-OBJECT or :PRINT-FUNCTION options
302 ;; leaves FNAME eq to NIL. The user-level effect is
303 ;; to generate a PRINT-OBJECT method specialized for the type,
304 ;; implementing the default #S structure-printing behavior.
308 ;; Don't dump the source form into the DD constant;
309 ;; just indicate that there was an expression there.
314 ;; Return a list of forms and the DD-NAME.
318 ;; Note we intentionally enforce package locks, calling
319 ;; %DEFSTRUCT first. %DEFSTRUCT has the tests (and resulting
320 ;; CERROR) for collisions with LAYOUTs which already exist in
321 ;; the runtime. If there are collisions, we want the user's
322 ;; response to CERROR to control what happens. If the ABORT
323 ;; restart is chosen, %COMPILER-DEFSTRUCT should not modify
324 ;; the definition the class.
332 ,name
340 ;; This must be in the same lexical environment
341 ,@constructor-definitions
342 ,@print-method
343 ;; Various other operations only make sense on the target SBCL.
345 ;; Not DD-CLASS-P
346 ;; FIXME: missing package lock checks
356 ,@constructor-definitions
360 name)))
362 #+sb-xc-host
364 ;; All defstructs are toplevel in SBCL's own source code,
365 ;; so pass T for null-lexenv.
369 #+sb-xc
372 "DEFSTRUCT {Name | (Name Option*)} [Documentation] {Slot | (Slot [Default] {Key Value}*)}
373 Define the structure type Name. Instances are created by MAKE-<name>,
374 which takes &KEY arguments allowing initial slot values to the specified.
375 A SETF'able function <name>-<slot> is defined for each slot to read and
376 write slot values. <name>-p is a type predicate.
378 Popular DEFSTRUCT options (see manual for others):
380 (:CONSTRUCTOR Name)
381 (:PREDICATE Name)
382 Specify the name for the constructor or predicate.
384 (:CONSTRUCTOR Name Lambda-List)
385 Specify the name and arguments for a BOA constructor
386 (which is more efficient when keyword syntax isn't necessary.)
388 (:INCLUDE Supertype Slot-Spec*)
389 Make this type a subtype of the structure type Supertype. The optional
390 Slot-Specs override inherited slot options.
392 Slot options:
394 :TYPE Type-Spec
395 Asserts that the value of this slot is always of the specified type.
397 :READ-ONLY {T | NIL}
398 If true, no setter function is defined for this slot."
400 (!expander-for-defstruct
403 ;; a LOCALLY environment would be fine,
404 ;; but is not an important case to handle.
410 #+sb-xc-host
412 "Cause information about a target structure to be built into the
413 cross-compiler."
416 \f
417 ;;;; functions to generate code for various parts of DEFSTRUCT definitions
419 ;;; First, a helper to determine whether a name names an inherited
420 ;;; accessor.
424 ;;; Return a list of forms which create a predicate function for a
425 ;;; typed DEFSTRUCT.
447 ~/sb!impl:print-type-specifier/."
448 ltype))))))))))
450 ;;; Return a list of forms to create a copier function of a typed DEFSTRUCT.
456 ;;; Return a list of function definitions for accessing and setting
457 ;;; the slots of a typed DEFSTRUCT. The functions are proclaimed to be
458 ;;; inline, and the types of their arguments and results are declared
459 ;;; as well. We count on the compiler to do clever things with ELT.
484 slot with name ~S (accessing an inherited slot ~
487 \f
488 ;;;; parsing
490 ;;; CLHS says that
491 ;;; A defstruct option can be either a keyword or a list of a keyword
492 ;;; and arguments for that keyword; specifying the keyword by itself is
493 ;;; equivalent to specifying a list consisting of the keyword
494 ;;; and no arguments.
495 ;;; It is unclear whether that is meant to imply that any of the keywords
496 ;;; may be present in their atom form, or only if the grammar at the top
497 ;;; shows the atom form does <atom> have the meaning of (<atom>).
498 ;;; At least one other implementation accepts :NAMED as a singleton list.
499 ;; We take a more rigid view that the depicted grammar is exhaustive.
500 ;;;
502 ;; Each keyword, except :CONSTRUCTOR which may appear more than once,
503 ;; and :NAMED which is trivial, and unambiguous if present more than
504 ;; once, though possibly worth a style-warning.
516 ;;; Parse a single DEFSTRUCT option and store the results in DD.
540 (:conc-name
541 ;; unlike (:predicate) and (:copier) which mean "yes" if supplied
542 ;; without their argument, (:conc-name) and :conc-name mean no conc-name.
543 ;; Also note a subtle difference in :conc-name "" vs :conc-name NIL.
544 ;; The former re-interns each slot name into *PACKAGE* which might
545 ;; not be the same as using the given name directly as an accessor.
552 ;; Implementations disagree on the meaning of
553 ;; (:CONSTRUCTOR NIL (A B C)).
554 ;; The choices seem to be: don't define a constructor,
555 ;; define a constructor named NIL, signal a user error,
556 ;; or crash the system itself. The spec implies
557 ;; the behavior that we have, but at least a
558 ;; style-warning seems appropriate.
569 lambda-list
575 (:copier
577 (:predicate
579 (:include
586 (:type
594 (:named
596 (:initial-offset
598 (:pure
602 seen-options))
604 ;;; Parse OPTIONS into the given DD.
618 ;; FIXME: ugly message (defstruct (s :include) a)
619 ;; saying "unrecognized" when it means "bad syntax"
621 dd seen-options))))
626 #!-compact-instance-header
628 ;; FIXME: It'd be cleaner to treat no-:INCLUDE as defaulting
629 ;; to :INCLUDE STRUCTURE-OBJECT, and then let the general-case
630 ;; (INCF (DD-LENGTH DD) (DD-LENGTH included-DD)) logic take
631 ;; care of this. (Except that the :TYPE VECTOR and :TYPE
632 ;; LIST cases, with their :NAMED and un-:NAMED flavors,
633 ;; make that messy, alas.)
636 ;; In case we are here, :TYPE is specified.
638 ;; CLHS - "The structure can be :named only if the type SYMBOL
639 ;; is a subtype of the supplied element-type."
644 type ~/sb!impl:print-type-specifier/"
664 ;; Remove (NIL) and sort so that BOA constructors are last.
670 nil)
686 seen-options))
688 ;;; Given name and options and slot descriptions (and possibly doc
689 ;;; string at the head of slot descriptions) return a DD holding that
690 ;;; info.
705 #-sb-xc-host
716 classoid))))
717 ;; Bind *pending-defstruct-type* to this classoid, which fixes a problem
718 ;; when redefining a DEFTYPE which appeared to be a raw slot. e.g.
719 ;; (DEFTYPE X () 'SINGLE-FLOAT) and later (DEFSTRUCT X (A 0 :TYPE X)).
720 ;; This is probably undefined behavior, but at least we'll not crash.
721 ;; Also make self-referential definitions not signal PARSE-UNKNOWN-TYPE
722 ;; on slots whose :TYPE option allows an instance of itself
729 ;; It could be buried anywhere in a complicated type expression.
730 ;; There's no way to clear selectively, so just flush the cache.
736 \f
737 ;;;; stuff to parse slot descriptions
739 ;;; Parse a slot description for DEFSTRUCT, add it to the description
740 ;;; and return it. If supplied, INCLUDED-SLOT is used to get the default,
741 ;;; type, and read-only flag for the new slot.
744 rsd-index index)
754 spec)
759 spec
761 ;; the warning here is useful, but in principle we cannot
762 ;; distinguish between legitimate and erroneous use of
763 ;; these names when :CONC-NAME is NIL. In the common
764 ;; case (CONC-NAME non-NIL), there are alternative ways
765 ;; of writing code with the same effect, so a full
766 ;; warning is justified.
773 read-only ro-p)))
776 description."
781 ;; Todo: indicate whether name is a duplicate in the directly
782 ;; specified slots vs. exists in the ancestor and so should
783 ;; be in the (:include ...) clause instead of where it is.
788 name))
791 ;; Some adventurous soul has named a slot so that its accessor
792 ;; collides with the structure type predicate. ANSI doesn't
793 ;; specify what to do in this case. As of 2001-09-04, Martin
794 ;; Atzmueller reports that CLISP and Lispworks both give
795 ;; priority to the slot accessor, so that the predicate is
796 ;; overwritten. We might as well do the same (as well as
797 ;; signalling a warning).
799 "~@<The structure accessor name ~S is the same as the name of the ~
800 structure type predicate. ANSI doesn't specify what to do in ~
801 this case. We'll overwrite the type predicate with the slot ~
802 accessor, but you can't rely on this behavior, so it'd be wise to ~
803 remove the ambiguity in your code.~@:>"
804 accessor-name)
806 ;; FIXME: It would be good to check for name collisions here, but
807 ;; the easy check,
808 ;;x#-sb-xc-host
809 ;;x(when (and (fboundp accessor-name)
810 ;;x (not (accessor-inherited-data accessor-name defstruct)))
811 ;;x (style-warn "redefining ~/sb-impl::print-symbol-with-prefix/ ~
812 ;; in DEFSTRUCT" accessor-name)))
813 ;; which was done until sbcl-0.8.11.18 or so, is wrong: it causes
814 ;; a warning at MACROEXPAND time, when instead the warning should
815 ;; occur not just because the code was constructed, but because it
816 ;; is actually compiled or loaded.
817 )
831 be :READ-ONLY in subclass.~:@>"
832 name)))
842 ;; Compute the index of this DSD. First decide whether the slot is raw.
848 ;; If slot requires alignment of 2, then ensure that
849 ;; it has an odd (i.e. doubleword aligned) index.
858 ;; Check for existence of any BOA constructor that leaves the
859 ;; slot with an unspecified value, as when it's initialized
860 ;; by an &AUX binding with no value (CLHS 3.4.6)
863 ;; Keyword constructors store :DEFAULT in the cdr of the cell.
864 ;; BOA constructors store the parsed lambda list.
869 name)))
874 ;; FIXME: the :TYPE option should not preclude storing #<unbound>
875 ;; unless the storage is a specialized numeric vector.
881 always-boundp rsd-index)
882 default)))
884 dsd)))
886 ;;; When a value of type TYPE is stored in a structure, should it be
887 ;;; stored in a raw slot? Return the index of the matching RAW-SLOT-DATA
888 ;;; if TYPE should be stored in a raw slot, or NIL if not.
892 ;; (The extra test for FIXNUM-CERTAIN? here is intended for
893 ;; bootstrapping the system. In particular, in sbcl-0.6.2, we set up
894 ;; LAYOUT before FIXNUM is defined, and so could bogusly end up
895 ;; putting INDEX-typed values into raw slots if we didn't test
896 ;; FIXNUM-CERTAIN?.)
898 nil
908 ;;; Process any included slots pretty much like they were specified.
909 ;;; Also inherit various other attributes.
918 ;; checks on legality
926 ;; It's not particularly well-defined to :INCLUDE any of the
927 ;; CMU CL INSTANCE weirdosities like CONDITION or
928 ;; GENERIC-FUNCTION, and it's certainly not ANSI-compliant.
933 included-name)))))
935 ;; A few more sanity checks: every allegedly modified slot exists
936 ;; and no name appears more than once.
950 modified-slots))
954 ;; FIXME: This POSITION call should be foldable without read-time eval
955 ;; since literals are immutable, and +DD-OPTION-NAMES+ was initialized
956 ;; from a literal.
968 ;; We stash away an alist of accessors to parents' slots
969 ;; that have already been created to avoid conflicts later
970 ;; so that structures with :INCLUDE and :CONC-NAME (and
971 ;; other edge cases) can work as specified.
973 ;; the "oldest" (i.e. highest up the tree of inheritance)
974 ;; will prevail, so don't push new ones on if they
975 ;; conflict.
982 ;; XXX: notify?
983 )))))))
984 \f
985 ;;;; various helper functions for setting up DEFSTRUCTs
987 ;;; This function is called at macroexpand time to compute the INHERITS
988 ;;; vector for a structure type definition.
989 ;;; The cross-compiler is allowed to magically compute LAYOUT-INHERITS.
1002 ;; STREAM is an abstract class and you can't :include it,
1003 ;; so the inheritance has to be hardcoded.
1023 ;;; Do miscellaneous (LOAD EVAL) time actions for the structure
1024 ;;; described by DD. Create the class and LAYOUT, checking for
1025 ;;; incompatible redefinition.
1029 ;; We set up LAYOUTs even in the cross-compilation host.
1049 \f
1050 ;;; Return a form accessing the writable place used for the slot
1051 ;;; described by DD and DSD in the INSTANCE (a form).
1067 ;;; Return the transform of conceptual FUNCTION one of {:READ,:WRITE,:SETF}
1068 ;;; as applied to ARGS, given SLOT-KEY which is a cons of a DD and a DSD.
1069 ;;; Return NIL on failure.
1074 ;; optimistically compute PLACE before checking length of ARGS
1075 ;; because we expect success, and this unifies the three cases.
1076 ;; :SETF is like an invocation of the SETF macro - newval is
1077 ;; the second arg, but :WRITER is #'(SETF fn) - newval is first.
1079 (%accessor-place-form
1085 ;; There are 4 cases of {safe,unsafe} x {always-boundp,possibly-unbound}
1086 ;; If unsafe - which implies TYPE-SPEC other than type T - then we must
1087 ;; check the type on each read. Assuming that type-checks reject
1088 ;; the unbound-marker, then we needn't separately check for it.
1101 newval
1106 (:setf
1107 ;; Instance setters take newval last, which matches
1108 ;; the order in which a use of SETF has them.
1110 (:write
1111 ;; The call to #'(SETF fn) had newval first.
1112 ;; We need to preserve L-to-R evaluation.
1116 ;;; Return a LAMBDA form which can be used to set a slot
1122 ;;; Blow away all the compiler info for the structure CLASS. Iterate
1123 ;;; over this type, clearing the compiler structure type info, and
1124 ;;; undefining all the associated functions. If SUBCLASSES-P, also do
1125 ;;; the same for subclasses. FIXME: maybe rename UNDEFINE-FUN-NAME to
1126 ;;; UNDECLARE-FUNCTION-NAME?
1132 ;; FIXME: shouldn't this undeclare any constructors too?
1141 ;; Clear out the SPECIFIER-TYPE cache so that subsequent
1142 ;; references are unknown types.
1149 subclasses
1154 ;; Is it really necessary to warn about
1155 ;; undeclaring functions for subclasses?
1158 of ~S:~% ~S"
1162 ;;; core compile-time setup of any class with a LAYOUT, used even by
1163 ;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS weirdosities
1165 &optional
1166 ;; Several special cases
1167 ;; (STRUCTURE-OBJECT itself, and
1168 ;; structures with alternate
1169 ;; metaclasses) call this function
1170 ;; directly, and they're all at the
1171 ;; base of the instance class
1172 ;; structure, so this is a handy
1173 ;; default. (But note
1174 ;; FUNCALLABLE-STRUCTUREs need
1175 ;; assistance here)
1182 inherits
1184 "The most recently compiled"
1186 "the most recently loaded"
1193 ;; FIXME: it might be polite to hold onto old-layout and
1194 ;; restore it at the end of the file. -- RMK 2008-09-19
1195 ;; (International Talk Like a Pirate Day).
1197 classoid))
1203 ;; At this point the class should be set up in the INFO database.
1204 ;; But the logic that enforces this is a little tangled and
1205 ;; scattered, so it's not obvious, so let's check.
1216 ;;; Do (COMPILE LOAD EVAL)-time actions for the normal (not
1217 ;;; ALTERNATE-LAYOUT) DEFSTRUCT described by DD.
1218 ;;; This includes generation of a style-warning about previously compiled
1219 ;;; calls to the accessors and/or predicate that weren't inlined.
1225 ;; Why use the secondary result of INFO, not the primary?
1226 ;; Because when DEFSTRUCT is evaluated, not via the file-compiler,
1227 ;; the first thing to happen is %DEFSTRUCT, which sets up FIND-CLASS.
1228 ;; Due to :COMPILER-LAYOUT's defaulting expression in globaldb,
1229 ;; it has a value - the layout of the classoid - that we don't want.
1230 ;; Also, since structures are technically not redefineable,
1231 ;; I don't worry about failure to inline a function that was
1232 ;; formerly not known as an accessor but now is.
1251 ;; Why this WHEN guard here, if there is neither a standards-specified
1252 ;; nor implementation-specific way to skip defining an accessor? Dunno.
1253 ;; And furthermore, by ignoring a package lock, it's possible to name
1254 ;; an accessor NIL: (defstruct (x (:conc-name "N")) IL)
1255 ;; making this test kinda bogus in two different ways.
1265 slot-key)
1272 slot with name ~S (accessing an inherited slot ~
1273 instead).~:@>"
1274 accessor-name
1280 ;; This message omits the http://en.wikipedia.org/wiki/Serial_comma
1282 ~{~/sb!impl:print-symbol-with-prefix/~^~#[~; and~:;,~] ~} ~
1283 could not be inlined because the structure definition for ~
1284 ~/sb!impl:print-symbol-with-prefix/ was not yet seen. To avoid this warning, ~
1285 DEFSTRUCT should precede references to the affected functions, ~
1286 or they must be declared locally notinline at each call site.~@:>"
1288 \f
1289 ;;;; redefinition stuff
1291 ;;; Compare the slots of OLD and NEW, returning 3 lists of slot names:
1292 ;;; 1. Slots which have moved,
1293 ;;; 2. Slots whose type has changed,
1294 ;;; 3. Deleted slots.
1314 ;;; If we are redefining a structure with different slots than in the
1315 ;;; currently loaded version, give a warning and return true.
1324 "incompatibly redefining slots of structure class ~S~@
1325 Make sure any uses of affected accessors are recompiled:~@
1326 ~@[ These slots were moved to new positions:~% ~S~%~]~
1327 ~@[ These slots have new incompatible types:~% ~S~%~]~
1328 ~@[ These slots were deleted:~% ~S~%~]"
1329 name moved retyped deleted)
1330 t))))
1332 ;;; Return true if destructively modifying OLD-LAYOUT into NEW-LAYOUT
1333 ;;; would be possible in as much as it won't harm the garbage collector.
1334 ;;; Harm potentially results from turning a raw word into a tagged word.
1345 ;;; This function is called when we are incompatibly redefining a
1346 ;;; structure CLASS to have the specified NEW-LAYOUT. We signal an
1347 ;;; error with some proceed options and return the layout that should
1348 ;;; be used.
1355 'structure-object
1356 name)
1360 "~@<Use the new definition of ~S, invalidating ~
1361 already-loaded code and instances.~@:>"
1362 name))
1370 "~@<Use the new definition of ~S as if it were ~
1371 compatible, allowing old accessors to use new ~
1372 instances and allowing new accessors to use old ~
1373 instances.~@:>"
1374 name))
1375 ;; classic CMU CL warning: "Any old ~S instances will be in a bad way.
1376 ;; I hope you know what you're doing..."
1378 :invalidate nil
1382 ;;; Compute DD's bitmap, storing 1 for each tagged word.
1383 ;;; The bitmap should be stored as a negative fixnum in two cases:
1384 ;;; (1) if the positive value is a bignum but the negative is a fixnum.
1385 ;;; (2) if there are no raw slots at all.
1386 ;;; Example: given (DEFSTRUCT S A B C), the computed bitmap is #b11111 -
1387 ;;; one bit for the layout; one each for A, B, C; and one for padding.
1388 ;;; Whether this is stored as 31 or -1 is mostly immaterial,
1389 ;;; but -1 is preferable because GC has a special case for it.
1390 ;;; Suppose instead we have 1 untagged word followed by N tagged words
1391 ;;; for N > n-fixnum-bits. The computed bitmap is #b111...11101
1392 ;;; but the sign-extended value is -3, which is a fixnum.
1393 ;;; If both the + and - values are fixnums, and raw slots are present,
1394 ;;; we'll choose the positive value.
1396 ;; With compact instances, LAYOUT is not reflected in the bitmap.
1397 ;; Without compact instances, the 0th bitmap bit (for the LAYOUT) is always 1.
1398 ;; In neither case is the place for the layout represented in in DD-SLOTS.
1412 bitmap))
1414 ;;; This is called when we are about to define a structure class. It
1415 ;;; returns a (possibly new) class object and the layout which should
1416 ;;; be used for the new definition (may be the current layout, and
1417 ;;; also might be an uninstalled forward referenced layout.) The third
1418 ;;; value is true if this is an incompatible redefinition, in which
1419 ;;; case it is the old layout.
1439 fd-stream
1452 :%flags flags
1453 :inherits inherits
1456 :info info
1462 ;; The assignment of INFO here can almost be deleted,
1463 ;; except for a few magical types that don't d.t.r.t. in cold-init:
1464 ;; STRUCTURE-OBJECT, CONDITION, ALIEN-VALUE, INTERPRETED-FUNCTION
1468 ;; of classic CMU CL. I moved it out to here because it was only
1469 ;; exercised in this code path anyway. -- WHN 19990510
1473 old-layout
1474 new-context
1491 \f
1492 ;;; Return a list of pairs (name . index). Used for :TYPE'd
1493 ;;; constructors to find all the names that we have to splice in &
1494 ;;; where. Note that these types don't have a layout, so we can't look
1495 ;;; at LAYOUT-INHERITS.
1513 \f
1514 ;;; These functions are called to actually make a constructor after we
1515 ;;; have processed the arglist. The correct variant (according to the
1516 ;;; DD-TYPE) should be called. The function is defined with the
1517 ;;; specified name and arglist. VARS and TYPES are used for argument
1518 ;;; type declarations. VALUES are the values for the slots (in order.)
1519 ;;;
1520 ;;; This is split into two functions:
1521 ;;; * INSTANCE-CONSTRUCTOR-FORM has to deal with raw slots
1522 ;;; (there are two variations on this)
1523 ;;; * TYPED-CONSTRUCTOR-FORM deal with LIST & VECTOR
1524 ;;; which might have "name" symbols stuck in at various weird places.
1526 ;; The difference between the two implementations here is that on all
1527 ;; platforms we don't have the appropriate RAW-INSTANCE-INIT VOPS, which
1528 ;; must be able to deal with immediate values as well -- unlike
1529 ;; RAW-INSTANCE-SET VOPs, which never end up seeing immediate values. With
1530 ;; some additional cleverness we might manage without them and just a single
1531 ;; implementation here, though -- figure out a way to ensure that on those
1532 ;; platforms we always still get a non-immediate TN in every case...
1533 ;;
1534 ;; Until someone does that, this means that instances with raw slots can be
1535 ;; DX allocated only on platforms with those additional VOPs.
1538 #!+raw-instance-init-vops
1549 dd-slots values)
1551 #!-raw-instance-init-vops
1553 ;; Partition into non-raw and raw
1566 dd-slots values)
1573 ;; Transform to %RAW-INSTANCE-SET/foo, not SETF,
1574 ;; in case any slots are readonly.
1580 instance-form)))))
1582 ;;; A "typed" constructor prefers to use a single call to LIST or VECTOR
1583 ;;; if possible, but can't always do that for VECTOR because it might not
1584 ;;; be a (VECTOR T). If not, we fallback to MAKE-ARRAY and (SETF AREF).
1593 ;; Possibly the most useless feature ever: more than one name slot.
1597 ;; The initial-element provides values for slots that are skipped
1598 ;; due to :initial-offset, not slots that are skipped due to
1599 ;; &AUX variables with no initial value.
1604 ;; For both vectors and lists, .DO-NOT-INITIALIZE-SLOT.
1605 ;; becomes 0 even though lists otherwise use NIL for slots
1606 ;; that are skipped to due :initial-offset.
1608 ;; All VALs have been wrapped in THE if necessary.
1610 slots values)
1616 names)
1620 slots values)
1623 ;;; Return the FTYPE for a DD constructor.
1624 ;;; This is tricky in uses such as the following:
1625 ;;; (DEFSTRUCT (S (:CONSTRUCTOR MS (A &AUX (A (ABS A))))) (A 0 :TYPE (MOD 4)))
1626 ;;; The constructor accepts integers betweeen -3 and 3 because the &AUX binding
1627 ;;; hides the positional argument A, and we can't actually put any constraint
1628 ;;; on A unless we figure out what the action of ABS is.
1629 ;;;
1630 ;;; The FTYPE is actually not a strong enough constraint anyway, so when IR1
1631 ;;; tests for the call compatibility it will test for correctness *after*
1632 ;;; argument defaulting.
1646 aux)))
1651 ;; If no slot, the arg restriction is T,
1652 ;; because we don't know where it goes.
1658 opt)
1663 keys))))))
1681 foundp)))
1683 ;;; Given a DD and a constructor spec (a cons of name and pre-parsed
1684 ;;; BOA lambda list, or the symbol :DEFAULT), return the effective
1685 ;;; lambda list and the body of the lambda.
1704 var
1732 ;; If VAR initializes a slot and did not have a default in
1733 ;; the lambda list, and DSD-DEFAULT is not NIL,
1734 ;; then change the lambda-list's default for the variable.
1735 ;; Always prefer to insert (CAR ARG) if ARG was a list
1736 ;; so that (:KEY var) syntax is preserved.
1740 ;; Can we substitute symbols that are not EQ to symbols
1741 ;; naming slots, so we don't have to compare by STRING= later?
1742 ;; Probably not because other symbols could reference them.
1748 llks nil req opt rest keys
1749 ;; &AUX vars which do not initialize a slot are not mentioned
1750 ;; in the lambda list, though it's not clear what to do if
1751 ;; subsequent bindings refer to the deleted ones.
1752 ;; And worse, what if it's SETQd - is that even legal?
1756 creator dd
1760 ;; CLHS 3.4.6 Boa Lambda Lists
1761 '.do-not-initialize-slot.
1765 ;; We can ignore the DD-ELEMENT-TYPE
1766 ;; because the container itself will check.
1780 \f
1781 ;;;; instances with ALTERNATE-METACLASS
1782 ;;;;
1783 ;;;; The CMU CL support for structures with ALTERNATE-METACLASS was a
1784 ;;;; fairly general extension embedded in the main DEFSTRUCT code, and
1785 ;;;; the result was an fairly impressive mess as ALTERNATE-METACLASS
1786 ;;;; extension mixed with ANSI CL generality (e.g. :TYPE and :INCLUDE)
1787 ;;;; and CMU CL implementation hairiness (esp. raw slots). This SBCL
1788 ;;;; version is much less ambitious, noticing that ALTERNATE-METACLASS
1789 ;;;; is only used to implement CONDITION, STANDARD-INSTANCE, and
1790 ;;;; GENERIC-FUNCTION, and defining a simple specialized
1791 ;;;; separate-from-DEFSTRUCT macro to provide only enough
1792 ;;;; functionality to support those.
1793 ;;;;
1794 ;;;; KLUDGE: The defining macro here is so specialized that it's ugly
1795 ;;;; in its own way. It also violates once-and-only-once by knowing
1796 ;;;; much about structures and layouts that is already known by the
1797 ;;;; main DEFSTRUCT macro. Hopefully it will go away presently
1798 ;;;; (perhaps when CL:CLASS and SB-PCL:CLASS meet) as per FIXME below.
1799 ;;;; -- WHN 2001-10-28
1800 ;;;;
1801 ;;;; FIXME: There seems to be no good reason to shoehorn CONDITION,
1802 ;;;; STANDARD-INSTANCE, and GENERIC-FUNCTION into mutated structures
1803 ;;;; instead of just implementing them as primitive objects. (This
1804 ;;;; reduced-functionality macro seems pretty close to the
1805 ;;;; functionality of !DEFINE-PRIMITIVE-OBJECT..)
1807 ;;; The complete list of alternate-metaclass DEFSTRUCTs:
1808 ;;; CONDITION SB-EVAL:INTERPRETED-FUNCTION
1809 ;;; SB-PCL::STANDARD-INSTANCE SB-PCL::STANDARD-FUNCALLABLE-INSTANCE
1810 ;;; SB-PCL::CTOR SB-PCL::%METHOD-FUNCTION
1811 ;;;
1816 metaclass-constructor
1817 slot-names)
1820 ;; Without compact instance headers, the index starts at 1 for
1821 ;; named slots, because slot 0 is the LAYOUT.
1822 ;; This is the same in ordinary structures too: see (INCF DD-LENGTH)
1823 ;; in PARSE-DEFSTRUCT-NAME-AND-OPTIONS.
1824 ;; With compact instance headers, slot 0 is a data slot.
1826 ;; We do *not* fill in the COPIER-NAME and PREDICATE-NAME
1827 ;; because alternate-metaclass structures can not have either.
1829 ;; We don't support inheritance of alternate metaclass stuff,
1830 ;; and it's not a general-purpose facility, so sanity check our
1831 ;; own code.
1838 metaclass-name
1839 metaclass-constructor)
1844 nil t t nil)
1845 nil))
1846 slot-names)
1849 dd))
1851 ;;; make !DEFSTRUCT-WITH-ALTERNATE-METACLASS compilable by the host
1852 ;;; lisp, installing the information we need to reason about the
1853 ;;; structures (layouts and classoids).
1854 ;;;
1855 ;;; FIXME: we should share the parsing and the DD construction between
1856 ;;; this and the cross-compiler version, but my brain was too small to
1857 ;;; get that right. -- CSR, 2006-09-14
1858 #+sb-xc-host
1871 boa-constructor
1872 superclass-name
1873 metaclass-name
1874 metaclass-constructor))
1879 :class-name class-name
1880 :slot-names slot-names
1881 :superclass-name superclass-name
1882 :metaclass-name metaclass-name
1883 :metaclass-constructor metaclass-constructor
1902 boa-constructor
1903 superclass-name
1904 metaclass-name
1905 metaclass-constructor))
1909 :class-name class-name
1910 :slot-names slot-names
1911 :superclass-name superclass-name
1912 :metaclass-name metaclass-name
1913 :metaclass-constructor metaclass-constructor
1927 ;; TRULY-THE should not be needed. But it is, to avoid
1928 ;; a type check on the next SETF. Why???
1940 ;; slot readers and writers
1948 dd-slots)
1951 dd-slots)))
1960 dd-slots)
1962 ;; constructor
1971 slot-names)
1974 ;; Usually we AVER instead of ASSERT, but AVER isn't defined yet.
1975 ;; A naive reading of 'build-order' suggests it is,
1976 ;; but due to def!struct delay voodoo, it isn't.
1978 \f
1979 ;;;; finalizing bootstrapping
1981 ;;; Set up DD and LAYOUT for STRUCTURE-OBJECT class itself.
1982 ;;;
1983 ;;; Ordinary structure classes effectively :INCLUDE STRUCTURE-OBJECT
1984 ;;; when they have no explicit :INCLUDEs, so (1) it needs to be set up
1985 ;;; before we can define ordinary structure classes, and (2) it's
1986 ;;; special enough (and simple enough) that we just build it by hand
1987 ;;; instead of trying to generalize the ordinary DEFSTRUCT code.
2002 info)
2010 info)))
2017 ;;; These functions are required to emulate SBCL kernel functions
2018 ;;; in a vanilla ANSI Common Lisp cross-compilation host.
2019 ;;; The emulation doesn't need to be efficient, since it's needed
2020 ;;; only for object dumping.
2021 #+sb-xc-host
2026 ;; In the target, it is theoretically possible to have %INSTANCE-LENGTH
2027 ;; exceeed layout length, but in the cross-compiler they're the same.
2031 ;; with compact headers, 0 is an ordinary slot index.
2032 ;; without, it's the layout.
2036 ;; If data starts at 1, then subtract 1 from index.
2037 ;; otherwise use the index as-is.
2041 ;; Why AVER these: because it is slightly abstraction-breaking
2042 ;; to assume that the slot-index N is the NTH item in the DSDs.
2043 ;; The target Lisp never assumes that.
2051 ;; Setting with (FUNCALL `(SETF ,accessor) ...) is unportable because
2052 ;; "The mechanism by which defstruct arranges for slot accessors to be
2053 ;; usable with setf is implementation-dependent; for example, it may
2054 ;; use setf functions, setf expanders, or some other
2055 ;; implementation-dependent mechanism ..."
2056 ;; But such capability seems not to be needed.
2061 ;;; If LAMBDA-LIST and BODY constitute an auto-generated structure function
2062 ;;; (accessor or predicate) for NAME, return the kind of thing it is.
2075 null))))
2076 ;; extract dd-name from `(TYPEP OBJECT ',THING)
2088 ;;; It's easier for the compiler to recognize the output of M-L-F-S-S
2089 ;;; without extraneous QUOTE forms, so we define some trivial wrapper macros.
2094 ;;; We require that MAKE-LOAD-FORM-SAVING-SLOTS produce deterministic output
2095 ;;; and that its output take a particular recognizable form so that it can
2096 ;;; be optimized into a sequence of fasl ops. MAKE-LOAD-FORM no longer returns
2097 ;;; a magic keyword except for the special case of :IGNORE-IT.
2098 ;;; The cross-compiler depends critically on optimizing the resulting sexprs
2099 ;;; so that the host can load cold objects, which it could not do
2100 ;;; if constructed by machine code for the target.
2101 ;;; This ends up being a performance win for the target system as well.
2109 ;; Return T if (but not only-if) INITS came from M-L-F-S-S.
2131 ;; It is possible to produce instances of structure-object which violate
2132 ;; the assumption throughout the compiler that slot readers are safe
2133 ;; unless dictated otherwise by the SAFE-P flag in the DSD.
2134 ;; * (defstruct S a (b (error "Must supply me") :type symbol))
2135 ;; * (defmethod make-load-form ((x S) &optional e) (m-l-f-s-s x :slot-names '(a)))
2136 ;; After these definitions, a dumped S will have 0 in slot B.
2137 ;;
2139 environment)
2141 ;; If TYPE-OF isn't a symbol, the creation form probably can't be compiled
2142 ;; unless there is a MAKE-LOAD-FORM on the class without a proper-name.
2143 ;; This is better than returning a creation form that produces
2144 ;; something completely different.
2159 #-sb-xc-host
2165 collect name into names
2166 and
2173 ;; Call MAKE-LOAD-FORM inside a condition handler in case the method fails.
2174 ; If the resulting CREATION-FORM and INIT-FORM are equivalent to those
2175 ;; returned from MAKE-LOAD-FORM-SAVING-SLOTS, return 'SB-FASL::FOP-STRUCT.
2176 ;; If the object can be ignored, return :IGNORE-IT and NIL.
2190 constant))