| blob | 18323416572c021a8145be9ac1ed4272ce213dd9 |
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 DEFMACRO-MUNDANELY?
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.
135 ;; name of slot
136 name
137 ;; its position in the implementation sequence
139 ;; the name of the accessor function
140 ;;
141 ;; (CMU CL had extra complexity here ("..or NIL if this accessor has
142 ;; the same name as an inherited accessor (which we don't want to
143 ;; shadow)") but that behavior doesn't seem to be specified by (or
144 ;; even particularly consistent with) ANSI, so it's gone in SBCL.)
146 default ; default value expression
149 ; always of the specified type
150 ;; If this object does not describe a raw slot, this value is T.
151 ;;
152 ;; If this object describes a raw slot, this value is the type of the
153 ;; value that the raw slot holds.
154 ;; Note: if there were more than about 5 raw types - and there aren't -
155 ;; this could be made more efficient by storing either a raw-type-id
156 ;; as an integer index to a vector of the raw types (presently a list,
157 ;; but easily a vector), or actually just the RSD object (raw-slot-data).
158 ;; Doing so would avoid some frequent re-scanning of the RSD list.
160 #!+long-float long-float
161 complex-single-float complex-double-float
162 #!+long-float complex-long-float
169 \f
170 ;;;; typed (non-class) structures
172 ;;; Return a type specifier we can use for testing :TYPE'd structures.
177 \f
178 ;;;; shared machinery for inline and out-of-line slot accessor functions
180 ;;; Classic comment preserved for entertainment value:
181 ;;;
182 ;;; "A lie can travel halfway round the world while the truth is
183 ;;; putting on its shoes." -- Mark Twain
185 ;;;; the legendary DEFSTRUCT macro itself (both CL:DEFSTRUCT and its
186 ;;;; close personal friend SB!XC:DEFSTRUCT)
189 ;; KLUDGE: If DEFSTRUCT is not at the top-level,
190 ;; (typep x 'name) and similar forms can't get optimized
191 ;; and produce style-warnings for unknown types.
193 forms
216 ;;; shared logic for host macroexpansion for SB!XC:DEFSTRUCT and
217 ;;; cross-compiler macroexpansion for CL:DEFSTRUCT
219 expanding-into-code-for)
220 ;; The host's version of this allows three choices for 'expanding-into'
221 ;; up until such time as the DEFMACRO is seen (again) for DEFSTRUCT,
222 ;; at which point things are ok because 'early-package' will have been
223 ;; processed. The target has only one possibility.
228 name-and-options slot-descriptions))
233 #-sb-xc-host
244 ;; Giving empty :PRINT-OBJECT or :PRINT-FUNCTION options
245 ;; leaves FNAME eq to NIL. The user-level effect is
246 ;; to generate a PRINT-OBJECT method specialized for the type,
247 ;; implementing the default #S structure-printing behavior.
251 ;; Don't dump the source form into the DD constant;
252 ;; just indicate that there was an expression there.
261 ;; Note we intentionally enforce package locks and
262 ;; call %DEFSTRUCT first, and especially before
263 ;; %COMPILER-DEFSTRUCT. %DEFSTRUCT has the tests (and
264 ;; resulting CERROR) for collisions with LAYOUTs which
265 ;; already exist in the runtime. If there are any
266 ;; collisions, we want the user's response to CERROR
267 ;; to control what happens. Especially, if the user
268 ;; responds to the collision with ABORT, we don't want
269 ;; %COMPILER-DEFSTRUCT to modify the definition of the
270 ;; class.
277 ,name
281 ;; This must be in the same lexical environment
283 ,@print-method
284 ;; Various other operations only make sense on the target SBCL.
300 #+sb-xc-host
304 #+sb-xc
306 #!+sb-doc
307 "DEFSTRUCT {Name | (Name Option*)} [Documentation] {Slot | (Slot [Default] {Key Value}*)}
308 Define the structure type Name. Instances are created by MAKE-<name>,
309 which takes &KEY arguments allowing initial slot values to the specified.
310 A SETF'able function <name>-<slot> is defined for each slot to read and
311 write slot values. <name>-p is a type predicate.
313 Popular DEFSTRUCT options (see manual for others):
315 (:CONSTRUCTOR Name)
316 (:PREDICATE Name)
317 Specify the name for the constructor or predicate.
319 (:CONSTRUCTOR Name Lambda-List)
320 Specify the name and arguments for a BOA constructor
321 (which is more efficient when keyword syntax isn't necessary.)
323 (:INCLUDE Supertype Slot-Spec*)
324 Make this type a subtype of the structure type Supertype. The optional
325 Slot-Specs override inherited slot options.
327 Slot options:
329 :TYPE Type-Spec
330 Asserts that the value of this slot is always of the specified type.
332 :READ-ONLY {T | NIL}
333 If true, no setter function is defined for this slot."
335 #+sb-xc-host
337 #!+sb-doc
338 "Cause information about a target structure to be built into the
339 cross-compiler."
341 \f
342 ;;;; functions to generate code for various parts of DEFSTRUCT definitions
344 ;;; First, a helper to determine whether a name names an inherited
345 ;;; accessor.
349 ;;; Return a list of forms which create a predicate function for a
350 ;;; typed DEFSTRUCT.
372 ltype))))))))))
374 ;;; Return a list of forms to create a copier function of a typed DEFSTRUCT.
380 ;;; Return a list of function definitions for accessing and setting
381 ;;; the slots of a typed DEFSTRUCT. The functions are proclaimed to be
382 ;;; inline, and the types of their arguments and results are declared
383 ;;; as well. We count on the compiler to do clever things with ELT.
408 slot with name ~S (accessing an inherited slot ~
411 \f
412 ;;;; parsing
414 ;;; CLHS says that
415 ;;; A defstruct option can be either a keyword or a list of a keyword
416 ;;; and arguments for that keyword; specifying the keyword by itself is
417 ;;; equivalent to specifying a list consisting of the keyword
418 ;;; and no arguments.
419 ;;; It is unclear whether that is meant to imply that any of the keywords
420 ;;; may be present in their atom form, or only if the grammar at the top
421 ;;; shows the atom form does <atom> have the meaning of (<atom>).
422 ;;; At least one other implementation accepts :NAMED as a singleton list.
423 ;; We take a more rigid view that the depicted grammar is exhaustive.
424 ;;;
426 ;; Each keyword, except :CONSTRUCTOR which may appear more than once,
427 ;; and :NAMED which is trivial, and unambiguous if present more than
428 ;; once, though possibly worth a style-warning.
440 ;;; Parse a single DEFSTRUCT option and store the results in DD.
464 (:conc-name
465 ;; unlike (:predicate) and (:copier) which mean "yes" if supplied
466 ;; without their argument, (:conc-name) and :conc-name mean no conc-name.
467 ;; Also note a subtle difference in :conc-name "" vs :conc-name NIL.
468 ;; The former re-interns each slot name into *PACKAGE* which might
469 ;; not be the same as using the given name directly as an accessor.
473 lambda-list) args
476 (:copier
478 (:predicate
480 (:include
487 (:type
495 (:named
497 (:initial-offset
499 (:pure
503 seen-options))
505 ;;; Given name and options, return a DD holding that info.
520 ;; FIXME: ugly message (defstruct (s :include) a)
521 ;; saying "unrecognized" when it means "bad syntax"
523 dd seen-options))))
529 ;; FIXME: It'd be cleaner to treat no-:INCLUDE as defaulting
530 ;; to :INCLUDE STRUCTURE-OBJECT, and then let the general-case
531 ;; (INCF (DD-LENGTH DD) (DD-LENGTH included-DD)) logic take
532 ;; care of this. (Except that the :TYPE VECTOR and :TYPE
533 ;; LIST cases, with their :NAMED and un-:NAMED flavors,
534 ;; make that messy, alas.)
537 ;; In case we are here, :TYPE is specified.
539 ;; CLHS - "The structure can be :named only if the type SYMBOL
540 ;; is a subtype of the supplied element-type."
569 dd)))
571 ;;; BOA constructors is (&aux x), i.e. without the default value, the
572 ;;; value of the slot is unspecified, but it should signal a type
573 ;;; error only when it's accessed. safe-p slot in dsd determines
574 ;;; whether to check the type after accessing the slot.
575 ;;;
576 ;;; This was performed during boa constructor creating, but the
577 ;;; constructors are created after this information is used to inform
578 ;;; the compiler how to treat such slots.
582 do
584 for slot in &aux
588 t)
590 t))
597 ;;; Given name and options and slot descriptions (and possibly doc
598 ;;; string at the head of slot descriptions) return a DD holding that
599 ;;; info.
604 name-and-options))))
610 result))
611 \f
612 ;;;; stuff to parse slot descriptions
614 ;;; Parse a slot description for DEFSTRUCT, add it to the description
615 ;;; and return it. If supplied, SLOT is a pre-initialized DSD
616 ;;; that we modify to get the new slot. This is supplied when handling
617 ;;; included slots.
630 spec)
635 spec
637 ;; the warning here is useful, but in principle we cannot
638 ;; distinguish between legitimate and erroneous use of
639 ;; these names when :CONC-NAME is NIL. In the common
640 ;; case (CONC-NAME non-NIL), there are alternative ways
641 ;; of writing code with the same effect, so a full
642 ;; warning is justified.
649 read-only ro-p)))
652 description."
659 ;; Todo: indicate whether name is a duplicate in the directly
660 ;; specified slots vs. exists in the ancestor and so should
661 ;; be in the (:include ...) clause instead of where it is.
669 name))
673 ;; Some adventurous soul has named a slot so that its accessor
674 ;; collides with the structure type predicate. ANSI doesn't
675 ;; specify what to do in this case. As of 2001-09-04, Martin
676 ;; Atzmueller reports that CLISP and Lispworks both give
677 ;; priority to the slot accessor, so that the predicate is
678 ;; overwritten. We might as well do the same (as well as
679 ;; signalling a warning).
681 "~@<The structure accessor name ~S is the same as the name of the ~
682 structure type predicate. ANSI doesn't specify what to do in ~
683 this case. We'll overwrite the type predicate with the slot ~
684 accessor, but you can't rely on this behavior, so it'd be wise to ~
685 remove the ambiguity in your code.~@:>"
686 accessor-name)
688 ;; FIXME: It would be good to check for name collisions here, but
689 ;; the easy check,
690 ;;x#-sb-xc-host
691 ;;x(when (and (fboundp accessor-name)
692 ;;x (not (accessor-inherited-data accessor-name defstruct)))
693 ;;x (style-warn "redefining ~/sb-impl::print-symbol-with-prefix/ ~
694 ;; in DEFSTRUCT" accessor-name)))
695 ;; which was done until sbcl-0.8.11.18 or so, is wrong: it causes
696 ;; a warning at MACROEXPAND time, when instead the warning should
697 ;; occur not just because the code was constructed, but because it
698 ;; is actually compiled or loaded.
699 )
706 type
713 be :READ-ONLY in subclass.~:@>"
715 slot))
717 ;;; When a value of type TYPE is stored in a structure, should it be
718 ;;; stored in a raw slot? Return the matching RAW-SLOT-DATA structure
719 ;; if TYPE should be stored in a raw slot, or NIL if not.
723 ;; (The extra test for FIXNUM-CERTAIN? here is intended for
724 ;; bootstrapping the system. In particular, in sbcl-0.6.2, we set up
725 ;; LAYOUT before FIXNUM is defined, and so could bogusly end up
726 ;; putting INDEX-typed values into raw slots if we didn't test
727 ;; FIXNUM-CERTAIN?.)
729 nil
734 ;;; Allocate storage for a DSD in DD. This is where we decide whether
735 ;;; a slot is raw or not. Raw objects are aligned on the unit of their size.
739 nil)))
747 #!-interleaved-raw-slots
753 #!+interleaved-raw-slots
756 ;; this formula works but can it be made less unclear?
766 ;;; Process any included slots pretty much like they were specified.
767 ;;; Also inherit various other attributes.
776 ;; checks on legality
784 ;; It's not particularly well-defined to :INCLUDE any of the
785 ;; CMU CL INSTANCE weirdosities like CONDITION or
786 ;; GENERIC-FUNCTION, and it's certainly not ANSI-compliant.
791 included-name)))))
793 ;; A few more sanity checks: every allegedly modified slot exists
794 ;; and no name appears more than once.
808 modified-slots))
814 #!-interleaved-raw-slots
825 ;; We stash away an alist of accessors to parents' slots
826 ;; that have already been created to avoid conflicts later
827 ;; so that structures with :INCLUDE and :CONC-NAME (and
828 ;; other edge cases) can work as specified.
830 ;; the "oldest" (i.e. highest up the tree of inheritance)
831 ;; will prevail, so don't push new ones on if they
832 ;; conflict.
838 modified
845 ;; XXX: notify?
846 )))))))
847 \f
848 ;;;; various helper functions for setting up DEFSTRUCTs
850 ;;; This function is called at macroexpand time to compute the INHERITS
851 ;;; vector for a structure type definition.
852 ;;; The cross-compiler is allowed to magically compute LAYOUT-INHERITS.
865 ;; STREAM is an abstract class and you can't :include it,
866 ;; so the inheritance has to be hardcoded.
886 ;;; Do miscellaneous (LOAD EVAL) time actions for the structure
887 ;;; described by DD. Create the class and LAYOUT, checking for
888 ;;; incompatible redefinition.
892 ;; We set up LAYOUTs even in the cross-compilation host.
912 \f
913 ;;; Return a form describing the writable place used for this slot
914 ;;; in the instance named INSTANCE-NAME.
927 ;;; Return the transformation of conceptual FUNCTION (either :READ or :WRITE)
928 ;;; applied to ARGS, given SLOT-KEY which is a cons of a DD and a DSD.
929 ;;; Return NIL on failure.
934 ;; optimistically compute PLACE before checking length of ARGS
935 ;; because we expect success, and this unifies the two cases.
936 ;; :WRITE has the arg order of (SETF fn), i.e. newval is first,
937 ;; so if more than one arg exists, take the second as the INSTANCE.
939 (%accessor-place-form
944 (:read
947 place
949 (:write
952 ;; instance setters take newval last.
956 ;;; Return a LAMBDA form which can be used to set a slot
961 ;;; Blow away all the compiler info for the structure CLASS. Iterate
962 ;;; over this type, clearing the compiler structure type info, and
963 ;;; undefining all the associated functions. If SUBCLASSES-P, also do
964 ;;; the same for subclasses. FIXME: maybe rename UNDEFINE-FUN-NAME to
965 ;;; UNDECLARE-FUNCTION-NAME?
979 ;; Clear out the SPECIFIER-TYPE cache so that subsequent
980 ;; references are unknown types.
987 subclasses
992 ;; Is it really necessary to warn about
993 ;; undeclaring functions for subclasses?
996 of ~S:~% ~S"
1000 ;;; core compile-time setup of any class with a LAYOUT, used even by
1001 ;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS weirdosities
1003 &optional
1004 ;; Several special cases
1005 ;; (STRUCTURE-OBJECT itself, and
1006 ;; structures with alternate
1007 ;; metaclasses) call this function
1008 ;; directly, and they're all at the
1009 ;; base of the instance class
1010 ;; structure, so this is a handy
1011 ;; default. (But note
1012 ;; FUNCALLABLE-STRUCTUREs need
1013 ;; assistance here)
1020 inherits
1022 "The most recently compiled"
1024 "the most recently loaded"
1031 ;; FIXME: it might be polite to hold onto old-layout and
1032 ;; restore it at the end of the file. -- RMK 2008-09-19
1033 ;; (International Talk Like a Pirate Day).
1035 classoid))
1041 ;; At this point the class should be set up in the INFO database.
1042 ;; But the logic that enforces this is a little tangled and
1043 ;; scattered, so it's not obvious, so let's check.
1049 ;;; Do (COMPILE LOAD EVAL)-time actions for the normal (not
1050 ;;; ALTERNATE-LAYOUT) DEFSTRUCT described by DD.
1051 ;;; This includes generation of a style-warning about previously compiled
1052 ;;; calls to the accessors and/or predicate that weren't inlined.
1058 ;; Why use the secondary result of INFO, not the primary?
1059 ;; Because when DEFSTRUCT is evaluated, not via the file-compiler,
1060 ;; the first thing to happen is %DEFSTRUCT, which sets up FIND-CLASS.
1061 ;; Due to :COMPILER-LAYOUT's defaulting expression in globaldb,
1062 ;; it has a value - the layout of the classoid - that we don't want.
1063 ;; Also, since structures are technically not redefineable,
1064 ;; I don't worry about failure to inline a function that was
1065 ;; formerly not known as an accessor but now is.
1083 ;; Why this WHEN guard here, if there is neither a standards-specified
1084 ;; nor implementation-specific way to skip defining an accessor? Dunno.
1085 ;; And furthermore, by ignoring a package lock, it's possible to name
1086 ;; an accessor NIL: (defstruct (x (:conc-name "N")) IL)
1087 ;; making this test kinda bogus in two different ways.
1097 slot-key)
1104 slot with name ~S (accessing an inherited slot ~
1105 instead).~:@>"
1106 accessor-name
1112 ;; This message omits the http://en.wikipedia.org/wiki/Serial_comma
1113 :format-control
1114 (!uncross-format-control
1115 "~@<Previously compiled call~P to ~
1116 ~{~/sb!impl:print-symbol-with-prefix/~^~#[~; and~:;,~] ~} ~
1117 could not be inlined because the structure definition for ~
1118 ~/sb!impl:print-symbol-with-prefix/ was not yet seen. To avoid this warning, ~
1119 DEFSTRUCT should precede references to the affected functions, ~
1122 \f
1123 ;;;; redefinition stuff
1125 ;;; Compare the slots of OLD and NEW, returning 3 lists of slot names:
1126 ;;; 1. Slots which have moved,
1127 ;;; 2. Slots whose type has changed,
1128 ;;; 3. Deleted slots.
1148 ;;; If we are redefining a structure with different slots than in the
1149 ;;; currently loaded version, give a warning and return true.
1158 "incompatibly redefining slots of structure class ~S~@
1159 Make sure any uses of affected accessors are recompiled:~@
1160 ~@[ These slots were moved to new positions:~% ~S~%~]~
1161 ~@[ These slots have new incompatible types:~% ~S~%~]~
1162 ~@[ These slots were deleted:~% ~S~%~]"
1163 name moved retyped deleted)
1164 t))))
1166 ;;; This function is called when we are incompatibly redefining a
1167 ;;; structure CLASS to have the specified NEW-LAYOUT. We signal an
1168 ;;; error with some proceed options and return the layout that should
1169 ;;; be used.
1176 'structure-object
1177 name)
1181 "~@<Use the new definition of ~S, invalidating ~
1182 already-loaded code and instances.~@:>"
1183 name))
1188 "~@<Use the new definition of ~S as if it were ~
1189 compatible, allowing old accessors to use new ~
1190 instances and allowing new accessors to use old ~
1191 instances.~@:>"
1192 name))
1193 ;; classic CMU CL warning: "Any old ~S instances will be in a bad way.
1194 ;; I hope you know what you're doing..."
1196 :invalidate nil
1199 ;; FIXME: deprecated 2002-10-16, and since it's only interactive
1200 ;; hackery instead of a supported feature, can probably be deleted
1201 ;; in early 2003
1204 :invalidate nil
1214 ;; Make sure the object ends at a two-word boundary. Note that this does
1215 ;; not affect the amount of memory used, since the allocator would add the
1216 ;; same padding anyway. However, raw slots are indexed from the length of
1217 ;; the object as indicated in the header, so the pad word needs to be
1218 ;; included in that length to guarantee proper alignment of raw double float
1219 ;; slots, necessary for (at least) the SPARC backend.
1220 ;; On backends with interleaved raw slots, the convention of having the
1221 ;; header possibly "lie" about an extra word is more of a bug than a feature.
1222 ;; Because the structure base is aligned, double-word raw slots are properly
1223 ;; aligned, and won't change alignment in descendant object types. It would
1224 ;; be correct to store the true instance length even though GC preserves
1225 ;; the extra data word (as it does for odd-length SIMPLE-VECTOR), treating
1226 ;; the total physical length as rounded-to-even. But having two different
1227 ;; conventions would be even more unnecessarily confusing, so we use
1228 ;; the not-sensible convention even when it does not make sense.
1232 ;; The bitmap stores a 1 for each untagged word,
1233 ;; including any internal padding words for alignment.
1234 ;; The 0th bit is initialized to 0 because the LAYOUT is a tagged
1235 ;; slot that is not present in DD-SLOTS.
1236 ;; All other bits start as 1 and are cleared if the word is tagged.
1237 ;; A final padding word, if any, is regarded as tagged.
1244 ;;; This is called when we are about to define a structure class. It
1245 ;;; returns a (possibly new) class object and the layout which should
1246 ;;; be used for the new definition (may be the current layout, and
1247 ;;; also might be an uninstalled forward referenced layout.) The third
1248 ;;; value is true if this is an incompatible redefinition, in which
1249 ;;; case it is the old layout.
1269 fd-stream
1281 :inherits inherits
1286 #!+interleaved-raw-slots
1292 ;; The assignment of INFO here can almost be deleted,
1293 ;; except for a few magical types that don't d.t.r.t. in cold-init:
1294 ;; STRUCTURE-OBJECT, CONDITION, ALIEN-VALUE, INTERPRETED-FUNCTION
1298 ;; of classic CMU CL. I moved it out to here because it was only
1299 ;; exercised in this code path anyway. -- WHN 19990510
1303 old-layout
1304 new-context
1321 \f
1322 ;;; Return a list of pairs (name . index). Used for :TYPE'd
1323 ;;; constructors to find all the names that we have to splice in &
1324 ;;; where. Note that these types don't have a layout, so we can't look
1325 ;;; at LAYOUT-INHERITS.
1343 \f
1344 ;;; These functions are called to actually make a constructor after we
1345 ;;; have processed the arglist. The correct variant (according to the
1346 ;;; DD-TYPE) should be called. The function is defined with the
1347 ;;; specified name and arglist. VARS and TYPES are used for argument
1348 ;;; type declarations. VALUES are the values for the slots (in order.)
1349 ;;;
1350 ;;; This is split three ways because:
1351 ;;; * LIST & VECTOR structures need "name" symbols stuck in at
1352 ;;; various weird places, whereas STRUCTURE structures have
1353 ;;; a LAYOUT slot.
1354 ;;; * We really want to use LIST to make list structures, instead of
1355 ;;; MAKE-LIST/(SETF ELT). (We can't in general use VECTOR in an
1356 ;;; analogous way, since VECTOR makes a SIMPLE-VECTOR and vector-typed
1357 ;;; structures can have arbitrary subtypes of VECTOR, not necessarily
1358 ;;; SIMPLE-VECTOR.)
1359 ;;; * STRUCTURE structures can have raw slots that must also be
1360 ;;; allocated and indirectly referenced.
1392 ;; The difference between the two implementations here is that on all
1393 ;; platforms we don't have the appropriate RAW-INSTANCE-INIT VOPS, which
1394 ;; must be able to deal with immediate values as well -- unlike
1395 ;; RAW-INSTANCE-SET VOPs, which never end up seeing immediate values. With
1396 ;; some additional cleverness we might manage without them and just a single
1397 ;; implementation here, though -- figure out a way to ensure that on those
1398 ;; platforms we always still get a non-immediate TN in every case...
1399 ;;
1400 ;; Until someone does that, this means that instances with raw slots can be
1401 ;; DX allocated only on platforms with those additional VOPs.
1402 #!+raw-instance-init-vops
1410 values)))
1414 #!-raw-instance-init-vops
1426 values)
1432 ;; (Note that we can't in general use the
1433 ;; ordinary named slot setter function here
1434 ;; because the slot might be :READ-ONLY, so we
1435 ;; whip up new LAMBDA representations of slot
1436 ;; setters for the occasion.)
1438 raw-slots
1439 raw-values)
1444 ;;; Create a default (non-BOA) keyword constructor.
1453 t)))
1459 ;; Canonicalize the type for a prettier macro-expansion
1460 ;; but leave it as is if there is a conflict.
1462 specfied-type)))
1465 ;; KLUDGE: we need a separate type declaration for for
1466 ;; keyword arguments, since default values bypass the
1467 ;; checking provided by the FTYPE.
1475 ;;; Given a structure and a BOA constructor spec, call CREATOR with
1476 ;;; the appropriate args to make a constructor.
1481 :accept
1491 t)))
1500 t))))))
1511 ;; KLUDGE: see comment in CREATE-KEYWORD-CONSTRUCTOR.
1528 ;; FIXME: this shares some logic (though not
1529 ;; code) with the &key case below (and it
1530 ;; looks confusing) -- factor out the logic
1531 ;; if possible. - CSR, 2002-04-19
1533 &optional
1536 arg
1559 &optional
1562 key
1582 ;; PARSE-LAMBDA-LIST doesn't distinguish between &AUX with nothing
1583 ;; after it, and absence of &AUX. They mean the same thing, even as
1584 ;; "interesting" as &AUX can be in a BOA lambda list [CLHS 3.4.6]
1595 ;; (&AUX X) and (&AUX (X)) both skip the slot
1603 ;; CLHS 3.4.6 Boa Lambda Lists
1611 ;;; Grovel the constructor options, and decide what constructors (if
1612 ;;; any) to create.
1660 collect
1663 place-form)
1669 collect
1683 \f
1684 ;;;; instances with ALTERNATE-METACLASS
1685 ;;;;
1686 ;;;; The CMU CL support for structures with ALTERNATE-METACLASS was a
1687 ;;;; fairly general extension embedded in the main DEFSTRUCT code, and
1688 ;;;; the result was an fairly impressive mess as ALTERNATE-METACLASS
1689 ;;;; extension mixed with ANSI CL generality (e.g. :TYPE and :INCLUDE)
1690 ;;;; and CMU CL implementation hairiness (esp. raw slots). This SBCL
1691 ;;;; version is much less ambitious, noticing that ALTERNATE-METACLASS
1692 ;;;; is only used to implement CONDITION, STANDARD-INSTANCE, and
1693 ;;;; GENERIC-FUNCTION, and defining a simple specialized
1694 ;;;; separate-from-DEFSTRUCT macro to provide only enough
1695 ;;;; functionality to support those.
1696 ;;;;
1697 ;;;; KLUDGE: The defining macro here is so specialized that it's ugly
1698 ;;;; in its own way. It also violates once-and-only-once by knowing
1699 ;;;; much about structures and layouts that is already known by the
1700 ;;;; main DEFSTRUCT macro. Hopefully it will go away presently
1701 ;;;; (perhaps when CL:CLASS and SB-PCL:CLASS meet) as per FIXME below.
1702 ;;;; -- WHN 2001-10-28
1703 ;;;;
1704 ;;;; FIXME: There seems to be no good reason to shoehorn CONDITION,
1705 ;;;; STANDARD-INSTANCE, and GENERIC-FUNCTION into mutated structures
1706 ;;;; instead of just implementing them as primitive objects. (This
1707 ;;;; reduced-functionality macro seems pretty close to the
1708 ;;;; functionality of !DEFINE-PRIMITIVE-OBJECT..)
1710 ;;; The complete list of alternate-metaclass DEFSTRUCTs:
1711 ;;; CONDITION SB-EVAL:INTERPRETED-FUNCTION
1712 ;;; SB-PCL::STANDARD-INSTANCE SB-PCL::STANDARD-FUNCALLABLE-INSTANCE
1713 ;;; SB-PCL::CTOR SB-PCL::%METHOD-FUNCTION
1714 ;;;
1719 metaclass-constructor
1720 slot-names)
1724 ;; The index starts at 1 for ordinary named
1725 ;; slots because slot 0 is magical, used for
1726 ;; the LAYOUT in CONDITIONs and
1727 ;; FUNCALLABLE-INSTANCEs. (This is the same
1728 ;; in ordinary structures too: see (INCF
1729 ;; DD-LENGTH) in
1730 ;; PARSE-DEFSTRUCT-NAME-AND-OPTIONS).
1734 :name slot-name
1735 :index index
1737 reversed-result)
1740 ;; We do *not* fill in the COPIER-NAME and PREDICATE-NAME
1741 ;; because none of the magical alternate-metaclass structures
1742 ;; have copiers and predicates that "Just work"
1744 ;; We don't support inheritance of alternate metaclass stuff,
1745 ;; and it's not a general-purpose facility, so sanity check our
1746 ;; own code.
1753 metaclass-name
1754 metaclass-constructor)
1758 dd))
1760 ;;; make !DEFSTRUCT-WITH-ALTERNATE-METACLASS compilable by the host
1761 ;;; lisp, installing the information we need to reason about the
1762 ;;; structures (layouts and classoids).
1763 ;;;
1764 ;;; FIXME: we should share the parsing and the DD construction between
1765 ;;; this and the cross-compiler version, but my brain was too small to
1766 ;;; get that right. -- CSR, 2006-09-14
1767 #+sb-xc-host
1776 predicate
1781 boa-constructor
1782 superclass-name
1783 metaclass-name
1784 metaclass-constructor))
1790 :class-name class-name
1791 :slot-names slot-names
1792 :superclass-name superclass-name
1793 :metaclass-name metaclass-name
1794 :metaclass-constructor metaclass-constructor
1811 predicate
1816 boa-constructor
1817 superclass-name
1818 metaclass-name
1819 metaclass-constructor))
1824 :class-name class-name
1825 :slot-names slot-names
1826 :superclass-name superclass-name
1827 :metaclass-name metaclass-name
1828 :metaclass-constructor metaclass-constructor
1852 ;; slot readers and writers
1860 dd-slots)
1863 dd-slots)))
1872 dd-slots)
1874 ;; constructor
1883 slot-names)
1886 ;; predicate
1888 ;; Just delegate to the compiler's type optimization
1889 ;; code, which knows how to generate inline type tests
1890 ;; for the whole CMU CL INSTANCE menagerie.
1894 ;; Usually we AVER instead of ASSERT, but one alternate-metaclass
1895 ;; structure definition is cross-compiled before AVER is a known macro.
1896 ;; It could be a def!macro perhaps, but ASSERT works just fine here
1897 ;; without adding to image size, since these toplevel forms
1898 ;; belong to code that is discarded after cold-init.
1900 \f
1901 ;;;; finalizing bootstrapping
1903 ;;; Set up DD and LAYOUT for STRUCTURE-OBJECT class itself.
1904 ;;;
1905 ;;; Ordinary structure classes effectively :INCLUDE STRUCTURE-OBJECT
1906 ;;; when they have no explicit :INCLUDEs, so (1) it needs to be set up
1907 ;;; before we can define ordinary structure classes, and (2) it's
1908 ;;; special enough (and simple enough) that we just build it by hand
1909 ;;; instead of trying to generalize the ordinary DEFSTRUCT code.
1919 ;;; early structure predeclarations: Set up DD and LAYOUT for ordinary
1920 ;;; (non-ALTERNATE-METACLASS) structures which are needed early.
1935 info)
1943 info)))
1945 ;;; These functions are required to emulate SBCL kernel functions
1946 ;;; in a vanilla ANSI Common Lisp cross-compilation host.
1947 ;;; The emulation doesn't need to be efficient, since it's needed
1948 ;;; only for object dumping.
1949 #+sb-xc-host
1954 ;; Don't allow totally random structures, only ones that the
1955 ;; cross-compiler has been advised will work.
1957 ;; but we must also have cross-compiled it for real.
1959 ;; and I don't know anything about raw slots
1960 ;; Coincidentally, in either representation of
1961 ;; raw-slot-metadata, 0 represents no untagged slots.
1969 ;; INSTANCE-LENGTH tells you how many data words the backend is able to
1970 ;; physically access in this structure. Since every structure occupies
1971 ;; an even number of words, the storage slots comprise an odd number
1972 ;; of words after subtracting 1 for the header.
1973 ;; And in fact the fasl dumper / loader do write and read potentially
1974 ;; one cell beyond the instance's LAYOUT-LENGTH if it was not odd.
1975 ;; I'm not sure whether that is a good or bad thing.
1976 ;; But be that as it may, in the cross-compiler you must not access
1977 ;; more cells than there are in the declared structure because there
1978 ;; is no lower level storage that you can peek at.
1979 ;; So INSTANCE-LENGTH is exactly the same as LAYOUT-LENGTH on the host.
1983 ;; with compact headers, 0 is an ordinary slot index.
1984 ;; without, it's the layout.
1988 ;; If data starts at 1, then subtract 1 from index.
1989 ;; otherwise use the index as-is.
1993 ;; Why AVER these: because it is slightly abstraction-breaking
1994 ;; to assume that the slot-index N is the NTH item in the DSDs.
1995 ;; The target Lisp never assumes that.
1998 ;; Setting with (FUNCALL `(SETF ,accessor) ...) is unportable because
1999 ;; "The mechanism by which defstruct arranges for slot accessors to be
2000 ;; usable with setf is implementation-dependent; for example, it may
2001 ;; use setf functions, setf expanders, or some other
2002 ;; implementation-dependent mechanism ..."
2003 ;; But such capability seems not to be needed.