| blob | 01b212ddceae123b7b94ecf52d7f061cc7f35eb0 |
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 ;; Index into *RAW-SLOT-DATA* vector of the RAW-SLOT-DATA for this slot.
151 ;; The index is -1 if this slot is not raw.
165 \f
166 ;;;; typed (non-class) structures
168 ;;; Return a type specifier we can use for testing :TYPE'd structures.
173 \f
174 ;;;; shared machinery for inline and out-of-line slot accessor functions
176 ;;; Classic comment preserved for entertainment value:
177 ;;;
178 ;;; "A lie can travel halfway round the world while the truth is
179 ;;; putting on its shoes." -- Mark Twain
181 ;;;; the legendary DEFSTRUCT macro itself (both CL:DEFSTRUCT and its
182 ;;;; close personal friend SB!XC:DEFSTRUCT)
185 ;; KLUDGE: If DEFSTRUCT is not at the top-level,
186 ;; (typep x 'name) and similar forms can't get optimized
187 ;; and produce style-warnings for unknown types.
190 forms
213 ;;; shared logic for host macroexpansion for SB!XC:DEFSTRUCT and
214 ;;; cross-compiler macroexpansion for CL:DEFSTRUCT
215 ;;; This monster has exactly one inline use in the final image,
216 ;;; and we can drop the definition.
219 expanding-into-code-for)
225 #-sb-xc-host
238 ;; Quasi-bogus: not all the right effects on globaldb
239 ;; happen by defining functions this cheating way.
247 boa-constructors)))
254 ;; Giving empty :PRINT-OBJECT or :PRINT-FUNCTION options
255 ;; leaves FNAME eq to NIL. The user-level effect is
256 ;; to generate a PRINT-OBJECT method specialized for the type,
257 ;; implementing the default #S structure-printing behavior.
261 ;; Don't dump the source form into the DD constant;
262 ;; just indicate that there was an expression there.
267 ;; Return a list of forms and the DD-NAME.
271 ;; Note we intentionally enforce package locks, calling
272 ;; %DEFSTRUCT first. %DEFSTRUCT has the tests (and resulting
273 ;; CERROR) for collisions with LAYOUTs which already exist in
274 ;; the runtime. If there are collisions, we want the user's
275 ;; response to CERROR to control what happens. If the ABORT
276 ;; restart is chosen, %COMPILER-DEFSTRUCT should not modify
277 ;; the definition the class.
285 ,name
293 ;; This must be in the same lexical environment
294 ,@constructor-definitions
295 ,@print-method
296 ;; Various other operations only make sense on the target SBCL.
298 ;; Not DD-CLASS-P
299 ;; FIXME: missing package lock checks
309 ,@constructor-definitions
313 name)))
315 #+sb-xc-host
317 ;; All defstructs are toplevel in SBCL's own source code,
318 ;; so pass T for null-lexenv.
322 #+sb-xc
325 #!+sb-doc
326 "DEFSTRUCT {Name | (Name Option*)} [Documentation] {Slot | (Slot [Default] {Key Value}*)}
327 Define the structure type Name. Instances are created by MAKE-<name>,
328 which takes &KEY arguments allowing initial slot values to the specified.
329 A SETF'able function <name>-<slot> is defined for each slot to read and
330 write slot values. <name>-p is a type predicate.
332 Popular DEFSTRUCT options (see manual for others):
334 (:CONSTRUCTOR Name)
335 (:PREDICATE Name)
336 Specify the name for the constructor or predicate.
338 (:CONSTRUCTOR Name Lambda-List)
339 Specify the name and arguments for a BOA constructor
340 (which is more efficient when keyword syntax isn't necessary.)
342 (:INCLUDE Supertype Slot-Spec*)
343 Make this type a subtype of the structure type Supertype. The optional
344 Slot-Specs override inherited slot options.
346 Slot options:
348 :TYPE Type-Spec
349 Asserts that the value of this slot is always of the specified type.
351 :READ-ONLY {T | NIL}
352 If true, no setter function is defined for this slot."
354 (!expander-for-defstruct
357 ;; a LOCALLY environment would be fine,
358 ;; but is not an important case to handle.
364 #+sb-xc-host
366 #!+sb-doc
367 "Cause information about a target structure to be built into the
368 cross-compiler."
371 \f
372 ;;;; functions to generate code for various parts of DEFSTRUCT definitions
374 ;;; First, a helper to determine whether a name names an inherited
375 ;;; accessor.
379 ;;; Return a list of forms which create a predicate function for a
380 ;;; typed DEFSTRUCT.
402 ltype))))))))))
404 ;;; Return a list of forms to create a copier function of a typed DEFSTRUCT.
410 ;;; Return a list of function definitions for accessing and setting
411 ;;; the slots of a typed DEFSTRUCT. The functions are proclaimed to be
412 ;;; inline, and the types of their arguments and results are declared
413 ;;; as well. We count on the compiler to do clever things with ELT.
438 slot with name ~S (accessing an inherited slot ~
441 \f
442 ;;;; parsing
444 ;;; CLHS says that
445 ;;; A defstruct option can be either a keyword or a list of a keyword
446 ;;; and arguments for that keyword; specifying the keyword by itself is
447 ;;; equivalent to specifying a list consisting of the keyword
448 ;;; and no arguments.
449 ;;; It is unclear whether that is meant to imply that any of the keywords
450 ;;; may be present in their atom form, or only if the grammar at the top
451 ;;; shows the atom form does <atom> have the meaning of (<atom>).
452 ;;; At least one other implementation accepts :NAMED as a singleton list.
453 ;; We take a more rigid view that the depicted grammar is exhaustive.
454 ;;;
456 ;; Each keyword, except :CONSTRUCTOR which may appear more than once,
457 ;; and :NAMED which is trivial, and unambiguous if present more than
458 ;; once, though possibly worth a style-warning.
470 ;;; Parse a single DEFSTRUCT option and store the results in DD.
494 (:conc-name
495 ;; unlike (:predicate) and (:copier) which mean "yes" if supplied
496 ;; without their argument, (:conc-name) and :conc-name mean no conc-name.
497 ;; Also note a subtle difference in :conc-name "" vs :conc-name NIL.
498 ;; The former re-interns each slot name into *PACKAGE* which might
499 ;; not be the same as using the given name directly as an accessor.
506 ;; Implementations disagree on the meaning of
507 ;; (:CONSTRUCTOR NIL (A B C)).
508 ;; The choices seem to be: don't define a constructor,
509 ;; define a constructor named NIL, signal a user error,
510 ;; or crash the system itself. The spec implies
511 ;; the behavior that we have, but at least a
512 ;; style-warning seems appropriate.
523 lambda-list
529 (:copier
531 (:predicate
533 (:include
540 (:type
548 (:named
550 (:initial-offset
552 (:pure
556 seen-options))
558 ;;; Parse OPTIONS into the given DD.
572 ;; FIXME: ugly message (defstruct (s :include) a)
573 ;; saying "unrecognized" when it means "bad syntax"
575 dd seen-options))))
581 ;; FIXME: It'd be cleaner to treat no-:INCLUDE as defaulting
582 ;; to :INCLUDE STRUCTURE-OBJECT, and then let the general-case
583 ;; (INCF (DD-LENGTH DD) (DD-LENGTH included-DD)) logic take
584 ;; care of this. (Except that the :TYPE VECTOR and :TYPE
585 ;; LIST cases, with their :NAMED and un-:NAMED flavors,
586 ;; make that messy, alas.)
589 ;; In case we are here, :TYPE is specified.
591 ;; CLHS - "The structure can be :named only if the type SYMBOL
592 ;; is a subtype of the supplied element-type."
616 ;; Remove (NIL) and sort so that BOA constructors are last.
622 nil)
638 dd)
640 ;;; BOA constructors is (&aux x), i.e. without the default value, the
641 ;;; value of the slot is unspecified, but it should signal a type
642 ;;; error only when it's accessed. safe-p slot in dsd determines
643 ;;; whether to check the type after accessing the slot.
644 ;;;
645 ;;; This was performed during boa constructor creating, but the
646 ;;; constructors are created after this information is used to inform
647 ;;; the compiler how to treat such slots.
655 ;; FIXME: Not sure why this is #'EQ.
656 ;; Everywhere else we use STRING=.
661 ;;; Given name and options and slot descriptions (and possibly doc
662 ;;; string at the head of slot descriptions) return a DD holding that
663 ;;; info.
678 result))
679 \f
680 ;;;; stuff to parse slot descriptions
682 ;;; Parse a slot description for DEFSTRUCT, add it to the description
683 ;;; and return it. If supplied, SLOT is a pre-initialized DSD
684 ;;; that we modify to get the new slot. This is supplied when handling
685 ;;; included slots.
699 spec)
704 spec
706 ;; the warning here is useful, but in principle we cannot
707 ;; distinguish between legitimate and erroneous use of
708 ;; these names when :CONC-NAME is NIL. In the common
709 ;; case (CONC-NAME non-NIL), there are alternative ways
710 ;; of writing code with the same effect, so a full
711 ;; warning is justified.
718 read-only ro-p)))
721 description."
728 ;; Todo: indicate whether name is a duplicate in the directly
729 ;; specified slots vs. exists in the ancestor and so should
730 ;; be in the (:include ...) clause instead of where it is.
738 name))
742 ;; Some adventurous soul has named a slot so that its accessor
743 ;; collides with the structure type predicate. ANSI doesn't
744 ;; specify what to do in this case. As of 2001-09-04, Martin
745 ;; Atzmueller reports that CLISP and Lispworks both give
746 ;; priority to the slot accessor, so that the predicate is
747 ;; overwritten. We might as well do the same (as well as
748 ;; signalling a warning).
750 "~@<The structure accessor name ~S is the same as the name of the ~
751 structure type predicate. ANSI doesn't specify what to do in ~
752 this case. We'll overwrite the type predicate with the slot ~
753 accessor, but you can't rely on this behavior, so it'd be wise to ~
754 remove the ambiguity in your code.~@:>"
755 accessor-name)
757 ;; FIXME: It would be good to check for name collisions here, but
758 ;; the easy check,
759 ;;x#-sb-xc-host
760 ;;x(when (and (fboundp accessor-name)
761 ;;x (not (accessor-inherited-data accessor-name defstruct)))
762 ;;x (style-warn "redefining ~/sb-impl::print-symbol-with-prefix/ ~
763 ;; in DEFSTRUCT" accessor-name)))
764 ;; which was done until sbcl-0.8.11.18 or so, is wrong: it causes
765 ;; a warning at MACROEXPAND time, when instead the warning should
766 ;; occur not just because the code was constructed, but because it
767 ;; is actually compiled or loaded.
768 )
775 type
782 be :READ-ONLY in subclass.~:@>"
784 slot))
786 ;;; When a value of type TYPE is stored in a structure, should it be
787 ;;; stored in a raw slot? Return the index of the matching RAW-SLOT-DATA
788 ;;; if TYPE should be stored in a raw slot, or NIL if not.
792 ;; (The extra test for FIXNUM-CERTAIN? here is intended for
793 ;; bootstrapping the system. In particular, in sbcl-0.6.2, we set up
794 ;; LAYOUT before FIXNUM is defined, and so could bogusly end up
795 ;; putting INDEX-typed values into raw slots if we didn't test
796 ;; FIXNUM-CERTAIN?.)
798 nil
804 ;;; Allocate storage for a DSD in DD. This is where we decide whether
805 ;;; a slot is raw or not. Raw objects are aligned on the unit of their size.
809 nil)))
818 #!-interleaved-raw-slots
824 #!+interleaved-raw-slots
827 ;; this formula works but can it be made less unclear?
837 ;;; Process any included slots pretty much like they were specified.
838 ;;; Also inherit various other attributes.
847 ;; checks on legality
855 ;; It's not particularly well-defined to :INCLUDE any of the
856 ;; CMU CL INSTANCE weirdosities like CONDITION or
857 ;; GENERIC-FUNCTION, and it's certainly not ANSI-compliant.
862 included-name)))))
864 ;; A few more sanity checks: every allegedly modified slot exists
865 ;; and no name appears more than once.
879 modified-slots))
885 #!-interleaved-raw-slots
896 ;; We stash away an alist of accessors to parents' slots
897 ;; that have already been created to avoid conflicts later
898 ;; so that structures with :INCLUDE and :CONC-NAME (and
899 ;; other edge cases) can work as specified.
901 ;; the "oldest" (i.e. highest up the tree of inheritance)
902 ;; will prevail, so don't push new ones on if they
903 ;; conflict.
909 modified
916 ;; XXX: notify?
917 )))))))
918 \f
919 ;;;; various helper functions for setting up DEFSTRUCTs
921 ;;; This function is called at macroexpand time to compute the INHERITS
922 ;;; vector for a structure type definition.
923 ;;; The cross-compiler is allowed to magically compute LAYOUT-INHERITS.
936 ;; STREAM is an abstract class and you can't :include it,
937 ;; so the inheritance has to be hardcoded.
957 ;;; Do miscellaneous (LOAD EVAL) time actions for the structure
958 ;;; described by DD. Create the class and LAYOUT, checking for
959 ;;; incompatible redefinition.
963 ;; We set up LAYOUTs even in the cross-compilation host.
983 \f
984 ;;; Return a form accessing the writable place used for the slot
985 ;;; described by DD and DSD in the INSTANCE (a form).
999 ;;; Return the transform of conceptual FUNCTION one of {:READ,:WRITE,:SETF}
1000 ;;; as applied to ARGS, given SLOT-KEY which is a cons of a DD and a DSD.
1001 ;;; Return NIL on failure.
1006 ;; optimistically compute PLACE before checking length of ARGS
1007 ;; because we expect success, and this unifies the three cases.
1008 ;; :SETF is like an invocation of the SETF macro - newval is
1009 ;; the second arg, but :WRITER is #'(SETF fn) - newval is first.
1011 (%accessor-place-form
1018 place
1025 (:setf
1026 ;; Instance setters take newval last, which matches
1027 ;; the order in which a use of SETF has them.
1029 (:write
1030 ;; The call to #'(SETF fn) had newval first.
1031 ;; We need to preserve L-to-R evaluation.
1035 ;;; Return a LAMBDA form which can be used to set a slot
1040 ;;; Blow away all the compiler info for the structure CLASS. Iterate
1041 ;;; over this type, clearing the compiler structure type info, and
1042 ;;; undefining all the associated functions. If SUBCLASSES-P, also do
1043 ;;; the same for subclasses. FIXME: maybe rename UNDEFINE-FUN-NAME to
1044 ;;; UNDECLARE-FUNCTION-NAME?
1050 ;; FIXME: shouldn't this undeclare any constructors too?
1059 ;; Clear out the SPECIFIER-TYPE cache so that subsequent
1060 ;; references are unknown types.
1067 subclasses
1072 ;; Is it really necessary to warn about
1073 ;; undeclaring functions for subclasses?
1076 of ~S:~% ~S"
1080 ;;; core compile-time setup of any class with a LAYOUT, used even by
1081 ;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS weirdosities
1083 &optional
1084 ;; Several special cases
1085 ;; (STRUCTURE-OBJECT itself, and
1086 ;; structures with alternate
1087 ;; metaclasses) call this function
1088 ;; directly, and they're all at the
1089 ;; base of the instance class
1090 ;; structure, so this is a handy
1091 ;; default. (But note
1092 ;; FUNCALLABLE-STRUCTUREs need
1093 ;; assistance here)
1100 inherits
1102 "The most recently compiled"
1104 "the most recently loaded"
1111 ;; FIXME: it might be polite to hold onto old-layout and
1112 ;; restore it at the end of the file. -- RMK 2008-09-19
1113 ;; (International Talk Like a Pirate Day).
1115 classoid))
1121 ;; At this point the class should be set up in the INFO database.
1122 ;; But the logic that enforces this is a little tangled and
1123 ;; scattered, so it's not obvious, so let's check.
1134 ;;; Do (COMPILE LOAD EVAL)-time actions for the normal (not
1135 ;;; ALTERNATE-LAYOUT) DEFSTRUCT described by DD.
1136 ;;; This includes generation of a style-warning about previously compiled
1137 ;;; calls to the accessors and/or predicate that weren't inlined.
1143 ;; Why use the secondary result of INFO, not the primary?
1144 ;; Because when DEFSTRUCT is evaluated, not via the file-compiler,
1145 ;; the first thing to happen is %DEFSTRUCT, which sets up FIND-CLASS.
1146 ;; Due to :COMPILER-LAYOUT's defaulting expression in globaldb,
1147 ;; it has a value - the layout of the classoid - that we don't want.
1148 ;; Also, since structures are technically not redefineable,
1149 ;; I don't worry about failure to inline a function that was
1150 ;; formerly not known as an accessor but now is.
1169 ;; Why this WHEN guard here, if there is neither a standards-specified
1170 ;; nor implementation-specific way to skip defining an accessor? Dunno.
1171 ;; And furthermore, by ignoring a package lock, it's possible to name
1172 ;; an accessor NIL: (defstruct (x (:conc-name "N")) IL)
1173 ;; making this test kinda bogus in two different ways.
1183 slot-key)
1190 slot with name ~S (accessing an inherited slot ~
1191 instead).~:@>"
1192 accessor-name
1198 ;; This message omits the http://en.wikipedia.org/wiki/Serial_comma
1199 :format-control
1200 (!uncross-format-control
1201 "~@<Previously compiled call~P to ~
1202 ~{~/sb!impl:print-symbol-with-prefix/~^~#[~; and~:;,~] ~} ~
1203 could not be inlined because the structure definition for ~
1204 ~/sb!impl:print-symbol-with-prefix/ was not yet seen. To avoid this warning, ~
1205 DEFSTRUCT should precede references to the affected functions, ~
1208 \f
1209 ;;;; redefinition stuff
1211 ;;; Compare the slots of OLD and NEW, returning 3 lists of slot names:
1212 ;;; 1. Slots which have moved,
1213 ;;; 2. Slots whose type has changed,
1214 ;;; 3. Deleted slots.
1234 ;;; If we are redefining a structure with different slots than in the
1235 ;;; currently loaded version, give a warning and return true.
1244 "incompatibly redefining slots of structure class ~S~@
1245 Make sure any uses of affected accessors are recompiled:~@
1246 ~@[ These slots were moved to new positions:~% ~S~%~]~
1247 ~@[ These slots have new incompatible types:~% ~S~%~]~
1248 ~@[ These slots were deleted:~% ~S~%~]"
1249 name moved retyped deleted)
1250 t))))
1252 ;;; This function is called when we are incompatibly redefining a
1253 ;;; structure CLASS to have the specified NEW-LAYOUT. We signal an
1254 ;;; error with some proceed options and return the layout that should
1255 ;;; be used.
1262 'structure-object
1263 name)
1267 "~@<Use the new definition of ~S, invalidating ~
1268 already-loaded code and instances.~@:>"
1269 name))
1274 "~@<Use the new definition of ~S as if it were ~
1275 compatible, allowing old accessors to use new ~
1276 instances and allowing new accessors to use old ~
1277 instances.~@:>"
1278 name))
1279 ;; classic CMU CL warning: "Any old ~S instances will be in a bad way.
1280 ;; I hope you know what you're doing..."
1282 :invalidate nil
1285 ;; FIXME: deprecated 2002-10-16, and since it's only interactive
1286 ;; hackery instead of a supported feature, can probably be deleted
1287 ;; in early 2003
1290 :invalidate nil
1300 ;; Make sure the object ends at a two-word boundary. Note that this does
1301 ;; not affect the amount of memory used, since the allocator would add the
1302 ;; same padding anyway. However, raw slots are indexed from the length of
1303 ;; the object as indicated in the header, so the pad word needs to be
1304 ;; included in that length to guarantee proper alignment of raw double float
1305 ;; slots, necessary for (at least) the SPARC backend.
1306 ;; On backends with interleaved raw slots, the convention of having the
1307 ;; header possibly "lie" about an extra word is more of a bug than a feature.
1308 ;; Because the structure base is aligned, double-word raw slots are properly
1309 ;; aligned, and won't change alignment in descendant object types. It would
1310 ;; be correct to store the true instance length even though GC preserves
1311 ;; the extra data word (as it does for odd-length SIMPLE-VECTOR), treating
1312 ;; the total physical length as rounded-to-even. But having two different
1313 ;; conventions would be even more unnecessarily confusing, so we use
1314 ;; the not-sensible convention even when it does not make sense.
1318 ;; The bitmap stores a 1 for each untagged word,
1319 ;; including any internal padding words for alignment.
1320 ;; The 0th bit is initialized to 0 because the LAYOUT is a tagged
1321 ;; slot that is not present in DD-SLOTS.
1322 ;; All other bits start as 1 and are cleared if the word is tagged.
1323 ;; A final padding word, if any, is regarded as tagged.
1330 ;;; This is called when we are about to define a structure class. It
1331 ;;; returns a (possibly new) class object and the layout which should
1332 ;;; be used for the new definition (may be the current layout, and
1333 ;;; also might be an uninstalled forward referenced layout.) The third
1334 ;;; value is true if this is an incompatible redefinition, in which
1335 ;;; case it is the old layout.
1355 fd-stream
1367 :inherits inherits
1372 #!+interleaved-raw-slots
1378 ;; The assignment of INFO here can almost be deleted,
1379 ;; except for a few magical types that don't d.t.r.t. in cold-init:
1380 ;; STRUCTURE-OBJECT, CONDITION, ALIEN-VALUE, INTERPRETED-FUNCTION
1384 ;; of classic CMU CL. I moved it out to here because it was only
1385 ;; exercised in this code path anyway. -- WHN 19990510
1389 old-layout
1390 new-context
1407 \f
1408 ;;; Return a list of pairs (name . index). Used for :TYPE'd
1409 ;;; constructors to find all the names that we have to splice in &
1410 ;;; where. Note that these types don't have a layout, so we can't look
1411 ;;; at LAYOUT-INHERITS.
1429 \f
1430 ;;; These functions are called to actually make a constructor after we
1431 ;;; have processed the arglist. The correct variant (according to the
1432 ;;; DD-TYPE) should be called. The function is defined with the
1433 ;;; specified name and arglist. VARS and TYPES are used for argument
1434 ;;; type declarations. VALUES are the values for the slots (in order.)
1435 ;;;
1436 ;;; This is split into two functions:
1437 ;;; * INSTANCE-CONSTRUCTOR-FORM has to deal with raw slots
1438 ;;; (there are two variations on this)
1439 ;;; * TYPED-CONSTRUCTOR-FORM deal with LIST & VECTOR
1440 ;;; which might have "name" symbols stuck in at various weird places.
1442 ;; The difference between the two implementations here is that on all
1443 ;; platforms we don't have the appropriate RAW-INSTANCE-INIT VOPS, which
1444 ;; must be able to deal with immediate values as well -- unlike
1445 ;; RAW-INSTANCE-SET VOPs, which never end up seeing immediate values. With
1446 ;; some additional cleverness we might manage without them and just a single
1447 ;; implementation here, though -- figure out a way to ensure that on those
1448 ;; platforms we always still get a non-immediate TN in every case...
1449 ;;
1450 ;; Until someone does that, this means that instances with raw slots can be
1451 ;; DX allocated only on platforms with those additional VOPs.
1454 #!+raw-instance-init-vops
1460 dd-slots values)
1462 #!-raw-instance-init-vops
1464 ;; Partition into non-raw and raw
1474 dd-slots values)
1481 ;; Transform to %RAW-INSTANCE-SET/foo, not SETF,
1482 ;; in case any slots are readonly.
1488 instance-form)))))
1490 ;;; A "typed" constructors prefers to use a single call to LIST or VECTOR
1491 ;;; if possible, but can't always do that for VECTOR because it might not
1492 ;;; be a (VECTOR T). If not, we fallback to MAKE-ARRAY and (SETF AREF).
1501 ;; Possibly the most useless feature ever: more than one name slot.
1505 ;; The initial-element provides values for slots that are skipped
1506 ;; due to :initial-offset, not slots that are skipped due to
1507 ;; &AUX variables with no initial value.
1512 ;; For both vectors and lists, .DO-NOT-INITIALIZE-SLOT.
1513 ;; becomes 0 even though lists otherwise use NIL for slots
1514 ;; that are skipped to due :initial-offset.
1516 ;; All VALs have been wrapped in THE if necessary.
1518 slots values)
1524 names)
1528 slots values)
1531 ;;; Return the FTYPE for a DD constructor.
1532 ;;; This is tricky in uses such as the following:
1533 ;;; (DEFSTRUCT (S (:CONSTRUCTOR MS (A &AUX (A (ABS A))))) (A 0 :TYPE (MOD 4)))
1534 ;;; The constructor accepts integers betweeen -3 and 3 because the &AUX binding
1535 ;;; hides the positional argument A, and we can't actually put any constraint
1536 ;;; on A unless we figure out what the action of ABS is.
1537 ;;;
1538 ;;; The FTYPE is actually not a strong enough constraint anyway, so when IR1
1539 ;;; tests for the call compatibility it will test for correctness *after*
1540 ;;; argument defaulting.
1554 aux)))
1559 ;; If no slot, the arg restriction is T,
1560 ;; because we don't know where it goes.
1566 opt)
1571 keys))))))
1589 foundp)))
1591 ;;; Given a DD and a constructor spec (a cons of name and pre-parsed
1592 ;;; BOA lambda list, or the symbol :DEFAULT), return the effective
1593 ;;; lambda list and the body of the lambda.
1636 ;; If VAR initializes a slot and did not have a default in
1637 ;; the lambda list, and DSD-DEFAULT is not NIL,
1638 ;; then change the lambda-list's default for the variable.
1639 ;; Always prefer to insert (CAR ARG) if ARG was a list
1640 ;; so that (:KEY var) syntax is preserved.
1644 ;; Can we substitute symbols that are not EQ to symbols
1645 ;; naming slots, so we don't have to compare by STRING= later?
1646 ;; Probably not because other symbols could reference them.
1652 llks nil req opt rest keys
1653 ;; &AUX vars which do not initialize a slot are not mentioned
1654 ;; in the lambda list, though it's not clear what to do if
1655 ;; subsequent bindings refer to the deleted ones.
1656 ;; And worse, what if it's SETQd - is that even legal?
1660 creator dd
1664 ;; CLHS 3.4.6 Boa Lambda Lists
1665 '.do-not-initialize-slot.
1669 ;; We can ignore the DD-ELEMENT-TYPE
1670 ;; because the container itself will check.
1684 \f
1685 ;;;; instances with ALTERNATE-METACLASS
1686 ;;;;
1687 ;;;; The CMU CL support for structures with ALTERNATE-METACLASS was a
1688 ;;;; fairly general extension embedded in the main DEFSTRUCT code, and
1689 ;;;; the result was an fairly impressive mess as ALTERNATE-METACLASS
1690 ;;;; extension mixed with ANSI CL generality (e.g. :TYPE and :INCLUDE)
1691 ;;;; and CMU CL implementation hairiness (esp. raw slots). This SBCL
1692 ;;;; version is much less ambitious, noticing that ALTERNATE-METACLASS
1693 ;;;; is only used to implement CONDITION, STANDARD-INSTANCE, and
1694 ;;;; GENERIC-FUNCTION, and defining a simple specialized
1695 ;;;; separate-from-DEFSTRUCT macro to provide only enough
1696 ;;;; functionality to support those.
1697 ;;;;
1698 ;;;; KLUDGE: The defining macro here is so specialized that it's ugly
1699 ;;;; in its own way. It also violates once-and-only-once by knowing
1700 ;;;; much about structures and layouts that is already known by the
1701 ;;;; main DEFSTRUCT macro. Hopefully it will go away presently
1702 ;;;; (perhaps when CL:CLASS and SB-PCL:CLASS meet) as per FIXME below.
1703 ;;;; -- WHN 2001-10-28
1704 ;;;;
1705 ;;;; FIXME: There seems to be no good reason to shoehorn CONDITION,
1706 ;;;; STANDARD-INSTANCE, and GENERIC-FUNCTION into mutated structures
1707 ;;;; instead of just implementing them as primitive objects. (This
1708 ;;;; reduced-functionality macro seems pretty close to the
1709 ;;;; functionality of !DEFINE-PRIMITIVE-OBJECT..)
1711 ;;; The complete list of alternate-metaclass DEFSTRUCTs:
1712 ;;; CONDITION SB-EVAL:INTERPRETED-FUNCTION
1713 ;;; SB-PCL::STANDARD-INSTANCE SB-PCL::STANDARD-FUNCALLABLE-INSTANCE
1714 ;;; SB-PCL::CTOR SB-PCL::%METHOD-FUNCTION
1715 ;;;
1720 metaclass-constructor
1721 slot-names)
1725 ;; The index starts at 1 for ordinary named
1726 ;; slots because slot 0 is magical, used for
1727 ;; the LAYOUT in CONDITIONs and
1728 ;; FUNCALLABLE-INSTANCEs. (This is the same
1729 ;; in ordinary structures too: see (INCF
1730 ;; DD-LENGTH) in
1731 ;; PARSE-DEFSTRUCT-NAME-AND-OPTIONS).
1735 :name slot-name
1736 :index index
1738 reversed-result)
1741 ;; We do *not* fill in the COPIER-NAME and PREDICATE-NAME
1742 ;; because none of the magical alternate-metaclass structures
1743 ;; have copiers and predicates that "Just work"
1745 ;; We don't support inheritance of alternate metaclass stuff,
1746 ;; and it's not a general-purpose facility, so sanity check our
1747 ;; own code.
1754 metaclass-name
1755 metaclass-constructor)
1759 dd))
1761 ;;; make !DEFSTRUCT-WITH-ALTERNATE-METACLASS compilable by the host
1762 ;;; lisp, installing the information we need to reason about the
1763 ;;; structures (layouts and classoids).
1764 ;;;
1765 ;;; FIXME: we should share the parsing and the DD construction between
1766 ;;; this and the cross-compiler version, but my brain was too small to
1767 ;;; get that right. -- CSR, 2006-09-14
1768 #+sb-xc-host
1777 predicate
1782 boa-constructor
1783 superclass-name
1784 metaclass-name
1785 metaclass-constructor))
1791 :class-name class-name
1792 :slot-names slot-names
1793 :superclass-name superclass-name
1794 :metaclass-name metaclass-name
1795 :metaclass-constructor metaclass-constructor
1810 predicate
1815 boa-constructor
1816 superclass-name
1817 metaclass-name
1818 metaclass-constructor))
1823 :class-name class-name
1824 :slot-names slot-names
1825 :superclass-name superclass-name
1826 :metaclass-name metaclass-name
1827 :metaclass-constructor metaclass-constructor
1851 ;; slot readers and writers
1859 dd-slots)
1862 dd-slots)))
1871 dd-slots)
1873 ;; constructor
1882 slot-names)
1885 ;; predicate
1887 ;; Just delegate to the compiler's type optimization
1888 ;; code, which knows how to generate inline type tests
1889 ;; for the whole CMU CL INSTANCE menagerie.
1893 ;; Usually we AVER instead of ASSERT, but one alternate-metaclass
1894 ;; structure definition is cross-compiled before AVER is a known macro.
1895 ;; It could be a def!macro perhaps, but ASSERT works just fine here
1896 ;; without adding to image size, since these toplevel forms
1897 ;; belong to code that is discarded after cold-init.
1899 \f
1900 ;;;; finalizing bootstrapping
1902 ;;; Set up DD and LAYOUT for STRUCTURE-OBJECT class itself.
1903 ;;;
1904 ;;; Ordinary structure classes effectively :INCLUDE STRUCTURE-OBJECT
1905 ;;; when they have no explicit :INCLUDEs, so (1) it needs to be set up
1906 ;;; before we can define ordinary structure classes, and (2) it's
1907 ;;; special enough (and simple enough) that we just build it by hand
1908 ;;; instead of trying to generalize the ordinary DEFSTRUCT code.
1918 ;;; early structure predeclarations: Set up DD and LAYOUT for ordinary
1919 ;;; (non-ALTERNATE-METACLASS) structures which are needed early.
1932 info)
1940 info)))
1947 ;;; These functions are required to emulate SBCL kernel functions
1948 ;;; in a vanilla ANSI Common Lisp cross-compilation host.
1949 ;;; The emulation doesn't need to be efficient, since it's needed
1950 ;;; only for object dumping.
1951 #+sb-xc-host
1956 ;; Don't allow totally random structures, only ones that the
1957 ;; cross-compiler has been advised will work.
1959 ;; but we must also have cross-compiled it for real.
1961 ;; and I don't know anything about raw slots
1962 ;; Coincidentally, in either representation of
1963 ;; raw-slot-metadata, 0 represents no untagged slots.
1971 ;; INSTANCE-LENGTH tells you how many data words the backend is able to
1972 ;; physically access in this structure. Since every structure occupies
1973 ;; an even number of words, the storage slots comprise an odd number
1974 ;; of words after subtracting 1 for the header.
1975 ;; And in fact the fasl dumper / loader do write and read potentially
1976 ;; one cell beyond the instance's LAYOUT-LENGTH if it was not odd.
1977 ;; I'm not sure whether that is a good or bad thing.
1978 ;; But be that as it may, in the cross-compiler you must not access
1979 ;; more cells than there are in the declared structure because there
1980 ;; is no lower level storage that you can peek at.
1981 ;; So INSTANCE-LENGTH is exactly the same as LAYOUT-LENGTH on the host.
1985 ;; with compact headers, 0 is an ordinary slot index.
1986 ;; without, it's the layout.
1990 ;; If data starts at 1, then subtract 1 from index.
1991 ;; otherwise use the index as-is.
1995 ;; Why AVER these: because it is slightly abstraction-breaking
1996 ;; to assume that the slot-index N is the NTH item in the DSDs.
1997 ;; The target Lisp never assumes that.
2005 ;; Setting with (FUNCALL `(SETF ,accessor) ...) is unportable because
2006 ;; "The mechanism by which defstruct arranges for slot accessors to be
2007 ;; usable with setf is implementation-dependent; for example, it may
2008 ;; use setf functions, setf expanders, or some other
2009 ;; implementation-dependent mechanism ..."
2010 ;; But such capability seems not to be needed.
2015 ;;; If LAMBDA-LIST and BODY constitute an auto-generated structure function
2016 ;;; (accessor or predicate) for NAME, return the kind of thing it is.
2029 null))))
2030 ;; extract dd-name from `(TYPEP OBJECT ',THING)