| blob | 72c9a492f7284a0d141d3947458748ba21da4c74 |
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.
134 ;; name of slot
135 name
136 ;; its position in the implementation sequence
138 ;; the name of the accessor function
139 ;;
140 ;; (CMU CL had extra complexity here ("..or NIL if this accessor has
141 ;; the same name as an inherited accessor (which we don't want to
142 ;; shadow)") but that behavior doesn't seem to be specified by (or
143 ;; even particularly consistent with) ANSI, so it's gone in SBCL.)
145 default ; default value expression
148 ; always of the specified type
149 ;; Index into *RAW-SLOT-DATA* vector of the RAW-SLOT-DATA for this slot.
150 ;; 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 ;;; Special var used by autogenerated print functions.
216 ;;; shared logic for host macroexpansion for SB!XC:DEFSTRUCT and
217 ;;; cross-compiler macroexpansion for CL:DEFSTRUCT
218 ;;; This monster has exactly one inline use in the final image,
219 ;;; and we can drop the definition.
222 expanding-into-code-for)
234 ;; Quasi-bogus: not all the right effects on globaldb
235 ;; happen by defining functions this cheating way.
243 boa-constructors)))
251 ;; Giving empty :PRINT-OBJECT or :PRINT-FUNCTION options
252 ;; leaves FNAME eq to NIL. The user-level effect is
253 ;; to generate a PRINT-OBJECT method specialized for the type,
254 ;; implementing the default #S structure-printing behavior.
258 ;; Don't dump the source form into the DD constant;
259 ;; just indicate that there was an expression there.
264 ;; Return a list of forms and the DD-NAME.
268 ;; Note we intentionally enforce package locks, calling
269 ;; %DEFSTRUCT first. %DEFSTRUCT has the tests (and resulting
270 ;; CERROR) for collisions with LAYOUTs which already exist in
271 ;; the runtime. If there are collisions, we want the user's
272 ;; response to CERROR to control what happens. If the ABORT
273 ;; restart is chosen, %COMPILER-DEFSTRUCT should not modify
274 ;; the definition the class.
282 ,name
290 ;; This must be in the same lexical environment
291 ,@constructor-definitions
292 ,@print-method
293 ;; Various other operations only make sense on the target SBCL.
295 ;; Not DD-CLASS-P
296 ;; FIXME: missing package lock checks
306 ,@constructor-definitions
310 name)))
312 #+sb-xc-host
314 ;; All defstructs are toplevel in SBCL's own source code,
315 ;; so pass T for null-lexenv.
319 #+sb-xc
322 #!+sb-doc
323 "DEFSTRUCT {Name | (Name Option*)} [Documentation] {Slot | (Slot [Default] {Key Value}*)}
324 Define the structure type Name. Instances are created by MAKE-<name>,
325 which takes &KEY arguments allowing initial slot values to the specified.
326 A SETF'able function <name>-<slot> is defined for each slot to read and
327 write slot values. <name>-p is a type predicate.
329 Popular DEFSTRUCT options (see manual for others):
331 (:CONSTRUCTOR Name)
332 (:PREDICATE Name)
333 Specify the name for the constructor or predicate.
335 (:CONSTRUCTOR Name Lambda-List)
336 Specify the name and arguments for a BOA constructor
337 (which is more efficient when keyword syntax isn't necessary.)
339 (:INCLUDE Supertype Slot-Spec*)
340 Make this type a subtype of the structure type Supertype. The optional
341 Slot-Specs override inherited slot options.
343 Slot options:
345 :TYPE Type-Spec
346 Asserts that the value of this slot is always of the specified type.
348 :READ-ONLY {T | NIL}
349 If true, no setter function is defined for this slot."
351 (!expander-for-defstruct
354 ;; a LOCALLY environment would be fine,
355 ;; but is not an important case to handle.
361 #+sb-xc-host
363 #!+sb-doc
364 "Cause information about a target structure to be built into the
365 cross-compiler."
368 \f
369 ;;;; functions to generate code for various parts of DEFSTRUCT definitions
371 ;;; First, a helper to determine whether a name names an inherited
372 ;;; accessor.
376 ;;; Return a list of forms which create a predicate function for a
377 ;;; typed DEFSTRUCT.
399 ~/sb!impl:print-type-specifier/."
400 ltype))))))))))
402 ;;; Return a list of forms to create a copier function of a typed DEFSTRUCT.
408 ;;; Return a list of function definitions for accessing and setting
409 ;;; the slots of a typed DEFSTRUCT. The functions are proclaimed to be
410 ;;; inline, and the types of their arguments and results are declared
411 ;;; as well. We count on the compiler to do clever things with ELT.
436 slot with name ~S (accessing an inherited slot ~
439 \f
440 ;;;; parsing
442 ;;; CLHS says that
443 ;;; A defstruct option can be either a keyword or a list of a keyword
444 ;;; and arguments for that keyword; specifying the keyword by itself is
445 ;;; equivalent to specifying a list consisting of the keyword
446 ;;; and no arguments.
447 ;;; It is unclear whether that is meant to imply that any of the keywords
448 ;;; may be present in their atom form, or only if the grammar at the top
449 ;;; shows the atom form does <atom> have the meaning of (<atom>).
450 ;;; At least one other implementation accepts :NAMED as a singleton list.
451 ;; We take a more rigid view that the depicted grammar is exhaustive.
452 ;;;
454 ;; Each keyword, except :CONSTRUCTOR which may appear more than once,
455 ;; and :NAMED which is trivial, and unambiguous if present more than
456 ;; once, though possibly worth a style-warning.
468 ;;; Parse a single DEFSTRUCT option and store the results in DD.
492 (:conc-name
493 ;; unlike (:predicate) and (:copier) which mean "yes" if supplied
494 ;; without their argument, (:conc-name) and :conc-name mean no conc-name.
495 ;; Also note a subtle difference in :conc-name "" vs :conc-name NIL.
496 ;; The former re-interns each slot name into *PACKAGE* which might
497 ;; not be the same as using the given name directly as an accessor.
504 ;; Implementations disagree on the meaning of
505 ;; (:CONSTRUCTOR NIL (A B C)).
506 ;; The choices seem to be: don't define a constructor,
507 ;; define a constructor named NIL, signal a user error,
508 ;; or crash the system itself. The spec implies
509 ;; the behavior that we have, but at least a
510 ;; style-warning seems appropriate.
521 lambda-list
527 (:copier
529 (:predicate
531 (:include
538 (:type
546 (:named
548 (:initial-offset
550 (:pure
554 seen-options))
556 ;;; Parse OPTIONS into the given DD.
570 ;; FIXME: ugly message (defstruct (s :include) a)
571 ;; saying "unrecognized" when it means "bad syntax"
573 dd seen-options))))
578 #!-compact-instance-header
580 ;; FIXME: It'd be cleaner to treat no-:INCLUDE as defaulting
581 ;; to :INCLUDE STRUCTURE-OBJECT, and then let the general-case
582 ;; (INCF (DD-LENGTH DD) (DD-LENGTH included-DD)) logic take
583 ;; care of this. (Except that the :TYPE VECTOR and :TYPE
584 ;; LIST cases, with their :NAMED and un-:NAMED flavors,
585 ;; make that messy, alas.)
588 ;; In case we are here, :TYPE is specified.
590 ;; CLHS - "The structure can be :named only if the type SYMBOL
591 ;; is a subtype of the supplied element-type."
596 type ~/sb!impl:print-type-specifier/"
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 #-sb-xc-host
689 classoid))))
690 ;; Bind *pending-defstruct-type* to this classoid, which fixes a problem
691 ;; when redefining a DEFTYPE which appeared to be a raw slot. e.g.
692 ;; (DEFTYPE X () 'SINGLE-FLOAT) and later (DEFSTRUCT X (A 0 :TYPE X)).
693 ;; This is probably undefined behavior, but at least we'll not crash.
694 ;; Also make self-referential definitions not signal PARSE-UNKNOWN-TYPE
695 ;; on slots whose :TYPE option allows an instance of itself
702 ;; It could be buried anywhere in a complicated type expression.
703 ;; There's no way to clear selectively, so just flush the cache.
710 \f
711 ;;;; stuff to parse slot descriptions
713 ;;; Parse a slot description for DEFSTRUCT, add it to the description
714 ;;; and return it. If supplied, SLOT is a pre-initialized DSD
715 ;;; that we modify to get the new slot. This is supplied when handling
716 ;;; included slots.
730 spec)
735 spec
737 ;; the warning here is useful, but in principle we cannot
738 ;; distinguish between legitimate and erroneous use of
739 ;; these names when :CONC-NAME is NIL. In the common
740 ;; case (CONC-NAME non-NIL), there are alternative ways
741 ;; of writing code with the same effect, so a full
742 ;; warning is justified.
749 read-only ro-p)))
752 description."
759 ;; Todo: indicate whether name is a duplicate in the directly
760 ;; specified slots vs. exists in the ancestor and so should
761 ;; be in the (:include ...) clause instead of where it is.
769 name))
773 ;; Some adventurous soul has named a slot so that its accessor
774 ;; collides with the structure type predicate. ANSI doesn't
775 ;; specify what to do in this case. As of 2001-09-04, Martin
776 ;; Atzmueller reports that CLISP and Lispworks both give
777 ;; priority to the slot accessor, so that the predicate is
778 ;; overwritten. We might as well do the same (as well as
779 ;; signalling a warning).
781 "~@<The structure accessor name ~S is the same as the name of the ~
782 structure type predicate. ANSI doesn't specify what to do in ~
783 this case. We'll overwrite the type predicate with the slot ~
784 accessor, but you can't rely on this behavior, so it'd be wise to ~
785 remove the ambiguity in your code.~@:>"
786 accessor-name)
788 ;; FIXME: It would be good to check for name collisions here, but
789 ;; the easy check,
790 ;;x#-sb-xc-host
791 ;;x(when (and (fboundp accessor-name)
792 ;;x (not (accessor-inherited-data accessor-name defstruct)))
793 ;;x (style-warn "redefining ~/sb-impl::print-symbol-with-prefix/ ~
794 ;; in DEFSTRUCT" accessor-name)))
795 ;; which was done until sbcl-0.8.11.18 or so, is wrong: it causes
796 ;; a warning at MACROEXPAND time, when instead the warning should
797 ;; occur not just because the code was constructed, but because it
798 ;; is actually compiled or loaded.
799 )
806 type
813 be :READ-ONLY in subclass.~:@>"
815 slot))
817 ;;; When a value of type TYPE is stored in a structure, should it be
818 ;;; stored in a raw slot? Return the index of the matching RAW-SLOT-DATA
819 ;;; if TYPE should be stored in a raw slot, or NIL if not.
823 ;; (The extra test for FIXNUM-CERTAIN? here is intended for
824 ;; bootstrapping the system. In particular, in sbcl-0.6.2, we set up
825 ;; LAYOUT before FIXNUM is defined, and so could bogusly end up
826 ;; putting INDEX-typed values into raw slots if we didn't test
827 ;; FIXNUM-CERTAIN?.)
829 nil
835 ;;; Allocate storage for a DSD in DD. This is where we decide whether
836 ;;; a slot is raw or not. Raw objects are aligned on the unit of their size.
840 nil)))
851 ;; this formula works but can it be made less unclear?
861 ;;; Process any included slots pretty much like they were specified.
862 ;;; Also inherit various other attributes.
871 ;; checks on legality
879 ;; It's not particularly well-defined to :INCLUDE any of the
880 ;; CMU CL INSTANCE weirdosities like CONDITION or
881 ;; GENERIC-FUNCTION, and it's certainly not ANSI-compliant.
886 included-name)))))
888 ;; A few more sanity checks: every allegedly modified slot exists
889 ;; and no name appears more than once.
903 modified-slots))
918 ;; We stash away an alist of accessors to parents' slots
919 ;; that have already been created to avoid conflicts later
920 ;; so that structures with :INCLUDE and :CONC-NAME (and
921 ;; other edge cases) can work as specified.
923 ;; the "oldest" (i.e. highest up the tree of inheritance)
924 ;; will prevail, so don't push new ones on if they
925 ;; conflict.
931 modified
938 ;; XXX: notify?
939 )))))))
940 \f
941 ;;;; various helper functions for setting up DEFSTRUCTs
943 ;;; This function is called at macroexpand time to compute the INHERITS
944 ;;; vector for a structure type definition.
945 ;;; The cross-compiler is allowed to magically compute LAYOUT-INHERITS.
958 ;; STREAM is an abstract class and you can't :include it,
959 ;; so the inheritance has to be hardcoded.
979 ;;; Do miscellaneous (LOAD EVAL) time actions for the structure
980 ;;; described by DD. Create the class and LAYOUT, checking for
981 ;;; incompatible redefinition.
985 ;; We set up LAYOUTs even in the cross-compilation host.
1005 \f
1006 ;;; Return a form accessing the writable place used for the slot
1007 ;;; described by DD and DSD in the INSTANCE (a form).
1021 ;;; Return the transform of conceptual FUNCTION one of {:READ,:WRITE,:SETF}
1022 ;;; as applied to ARGS, given SLOT-KEY which is a cons of a DD and a DSD.
1023 ;;; Return NIL on failure.
1028 ;; optimistically compute PLACE before checking length of ARGS
1029 ;; because we expect success, and this unifies the three cases.
1030 ;; :SETF is like an invocation of the SETF macro - newval is
1031 ;; the second arg, but :WRITER is #'(SETF fn) - newval is first.
1033 (%accessor-place-form
1040 place
1047 (:setf
1048 ;; Instance setters take newval last, which matches
1049 ;; the order in which a use of SETF has them.
1051 (:write
1052 ;; The call to #'(SETF fn) had newval first.
1053 ;; We need to preserve L-to-R evaluation.
1057 ;;; Return a LAMBDA form which can be used to set a slot
1062 ;;; Blow away all the compiler info for the structure CLASS. Iterate
1063 ;;; over this type, clearing the compiler structure type info, and
1064 ;;; undefining all the associated functions. If SUBCLASSES-P, also do
1065 ;;; the same for subclasses. FIXME: maybe rename UNDEFINE-FUN-NAME to
1066 ;;; UNDECLARE-FUNCTION-NAME?
1072 ;; FIXME: shouldn't this undeclare any constructors too?
1081 ;; Clear out the SPECIFIER-TYPE cache so that subsequent
1082 ;; references are unknown types.
1089 subclasses
1094 ;; Is it really necessary to warn about
1095 ;; undeclaring functions for subclasses?
1098 of ~S:~% ~S"
1102 ;;; core compile-time setup of any class with a LAYOUT, used even by
1103 ;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS weirdosities
1105 &optional
1106 ;; Several special cases
1107 ;; (STRUCTURE-OBJECT itself, and
1108 ;; structures with alternate
1109 ;; metaclasses) call this function
1110 ;; directly, and they're all at the
1111 ;; base of the instance class
1112 ;; structure, so this is a handy
1113 ;; default. (But note
1114 ;; FUNCALLABLE-STRUCTUREs need
1115 ;; assistance here)
1122 inherits
1124 "The most recently compiled"
1126 "the most recently loaded"
1133 ;; FIXME: it might be polite to hold onto old-layout and
1134 ;; restore it at the end of the file. -- RMK 2008-09-19
1135 ;; (International Talk Like a Pirate Day).
1137 classoid))
1143 ;; At this point the class should be set up in the INFO database.
1144 ;; But the logic that enforces this is a little tangled and
1145 ;; scattered, so it's not obvious, so let's check.
1156 ;;; Do (COMPILE LOAD EVAL)-time actions for the normal (not
1157 ;;; ALTERNATE-LAYOUT) DEFSTRUCT described by DD.
1158 ;;; This includes generation of a style-warning about previously compiled
1159 ;;; calls to the accessors and/or predicate that weren't inlined.
1165 ;; Why use the secondary result of INFO, not the primary?
1166 ;; Because when DEFSTRUCT is evaluated, not via the file-compiler,
1167 ;; the first thing to happen is %DEFSTRUCT, which sets up FIND-CLASS.
1168 ;; Due to :COMPILER-LAYOUT's defaulting expression in globaldb,
1169 ;; it has a value - the layout of the classoid - that we don't want.
1170 ;; Also, since structures are technically not redefineable,
1171 ;; I don't worry about failure to inline a function that was
1172 ;; formerly not known as an accessor but now is.
1191 ;; Why this WHEN guard here, if there is neither a standards-specified
1192 ;; nor implementation-specific way to skip defining an accessor? Dunno.
1193 ;; And furthermore, by ignoring a package lock, it's possible to name
1194 ;; an accessor NIL: (defstruct (x (:conc-name "N")) IL)
1195 ;; making this test kinda bogus in two different ways.
1205 slot-key)
1212 slot with name ~S (accessing an inherited slot ~
1213 instead).~:@>"
1214 accessor-name
1220 ;; This message omits the http://en.wikipedia.org/wiki/Serial_comma
1222 ~{~/sb!impl:print-symbol-with-prefix/~^~#[~; and~:;,~] ~} ~
1223 could not be inlined because the structure definition for ~
1224 ~/sb!impl:print-symbol-with-prefix/ was not yet seen. To avoid this warning, ~
1225 DEFSTRUCT should precede references to the affected functions, ~
1226 or they must be declared locally notinline at each call site.~@:>"
1228 \f
1229 ;;;; redefinition stuff
1231 ;;; Compare the slots of OLD and NEW, returning 3 lists of slot names:
1232 ;;; 1. Slots which have moved,
1233 ;;; 2. Slots whose type has changed,
1234 ;;; 3. Deleted slots.
1254 ;;; If we are redefining a structure with different slots than in the
1255 ;;; currently loaded version, give a warning and return true.
1264 "incompatibly redefining slots of structure class ~S~@
1265 Make sure any uses of affected accessors are recompiled:~@
1266 ~@[ These slots were moved to new positions:~% ~S~%~]~
1267 ~@[ These slots have new incompatible types:~% ~S~%~]~
1268 ~@[ These slots were deleted:~% ~S~%~]"
1269 name moved retyped deleted)
1270 t))))
1272 ;;; This function is called when we are incompatibly redefining a
1273 ;;; structure CLASS to have the specified NEW-LAYOUT. We signal an
1274 ;;; error with some proceed options and return the layout that should
1275 ;;; be used.
1282 'structure-object
1283 name)
1287 "~@<Use the new definition of ~S, invalidating ~
1288 already-loaded code and instances.~@:>"
1289 name))
1294 "~@<Use the new definition of ~S as if it were ~
1295 compatible, allowing old accessors to use new ~
1296 instances and allowing new accessors to use old ~
1297 instances.~@:>"
1298 name))
1299 ;; classic CMU CL warning: "Any old ~S instances will be in a bad way.
1300 ;; I hope you know what you're doing..."
1302 :invalidate nil
1305 ;; FIXME: deprecated 2002-10-16, and since it's only interactive
1306 ;; hackery instead of a supported feature, can probably be deleted
1307 ;; in early 2003
1310 :invalidate nil
1314 ;;; Compute DD's bitmap, storing 1 for each tagged word.
1315 ;;; The bitmap should be stored as a negative fixnum in two cases:
1316 ;;; (1) if the positive value is a bignum but the negative is a fixnum.
1317 ;;; (2) if there are no raw slots at all.
1318 ;;; Example: given (DEFSTRUCT S A B C), the computed bitmap is #b11111 -
1319 ;;; one bit for the layout; one each for A, B, C; and one for padding.
1320 ;;; Whether this is stored as 31 or -1 is mostly immaterial,
1321 ;;; but -1 is preferable because GC has a special case for it.
1322 ;;; Suppose instead we have 1 untagged word followed by N tagged words
1323 ;;; for N > n-fixnum-bits. The computed bitmap is #b111...11101
1324 ;;; but the sign-extended value is -3, which is a fixnum.
1325 ;;; If both the + and - values are fixnums, and raw slots are present,
1326 ;;; we'll choose the positive value.
1328 ;; Without compact instances, the 0th bit is always 1.
1329 ;; LAYOUT is tagged but not reflected in DD-SLOTS
1343 bitmap))
1345 ;;; This is called when we are about to define a structure class. It
1346 ;;; returns a (possibly new) class object and the layout which should
1347 ;;; be used for the new definition (may be the current layout, and
1348 ;;; also might be an uninstalled forward referenced layout.) The third
1349 ;;; value is true if this is an incompatible redefinition, in which
1350 ;;; case it is the old layout.
1370 fd-stream
1382 :inherits inherits
1385 :info info
1391 ;; The assignment of INFO here can almost be deleted,
1392 ;; except for a few magical types that don't d.t.r.t. in cold-init:
1393 ;; STRUCTURE-OBJECT, CONDITION, ALIEN-VALUE, INTERPRETED-FUNCTION
1397 ;; of classic CMU CL. I moved it out to here because it was only
1398 ;; exercised in this code path anyway. -- WHN 19990510
1402 old-layout
1403 new-context
1420 \f
1421 ;;; Return a list of pairs (name . index). Used for :TYPE'd
1422 ;;; constructors to find all the names that we have to splice in &
1423 ;;; where. Note that these types don't have a layout, so we can't look
1424 ;;; at LAYOUT-INHERITS.
1442 \f
1443 ;;; These functions are called to actually make a constructor after we
1444 ;;; have processed the arglist. The correct variant (according to the
1445 ;;; DD-TYPE) should be called. The function is defined with the
1446 ;;; specified name and arglist. VARS and TYPES are used for argument
1447 ;;; type declarations. VALUES are the values for the slots (in order.)
1448 ;;;
1449 ;;; This is split into two functions:
1450 ;;; * INSTANCE-CONSTRUCTOR-FORM has to deal with raw slots
1451 ;;; (there are two variations on this)
1452 ;;; * TYPED-CONSTRUCTOR-FORM deal with LIST & VECTOR
1453 ;;; which might have "name" symbols stuck in at various weird places.
1455 ;; The difference between the two implementations here is that on all
1456 ;; platforms we don't have the appropriate RAW-INSTANCE-INIT VOPS, which
1457 ;; must be able to deal with immediate values as well -- unlike
1458 ;; RAW-INSTANCE-SET VOPs, which never end up seeing immediate values. With
1459 ;; some additional cleverness we might manage without them and just a single
1460 ;; implementation here, though -- figure out a way to ensure that on those
1461 ;; platforms we always still get a non-immediate TN in every case...
1462 ;;
1463 ;; Until someone does that, this means that instances with raw slots can be
1464 ;; DX allocated only on platforms with those additional VOPs.
1467 #!+raw-instance-init-vops
1473 dd-slots values)
1475 #!-raw-instance-init-vops
1477 ;; Partition into non-raw and raw
1487 dd-slots values)
1494 ;; Transform to %RAW-INSTANCE-SET/foo, not SETF,
1495 ;; in case any slots are readonly.
1501 instance-form)))))
1503 ;;; A "typed" constructors prefers to use a single call to LIST or VECTOR
1504 ;;; if possible, but can't always do that for VECTOR because it might not
1505 ;;; be a (VECTOR T). If not, we fallback to MAKE-ARRAY and (SETF AREF).
1514 ;; Possibly the most useless feature ever: more than one name slot.
1518 ;; The initial-element provides values for slots that are skipped
1519 ;; due to :initial-offset, not slots that are skipped due to
1520 ;; &AUX variables with no initial value.
1525 ;; For both vectors and lists, .DO-NOT-INITIALIZE-SLOT.
1526 ;; becomes 0 even though lists otherwise use NIL for slots
1527 ;; that are skipped to due :initial-offset.
1529 ;; All VALs have been wrapped in THE if necessary.
1531 slots values)
1537 names)
1541 slots values)
1544 ;;; Return the FTYPE for a DD constructor.
1545 ;;; This is tricky in uses such as the following:
1546 ;;; (DEFSTRUCT (S (:CONSTRUCTOR MS (A &AUX (A (ABS A))))) (A 0 :TYPE (MOD 4)))
1547 ;;; The constructor accepts integers betweeen -3 and 3 because the &AUX binding
1548 ;;; hides the positional argument A, and we can't actually put any constraint
1549 ;;; on A unless we figure out what the action of ABS is.
1550 ;;;
1551 ;;; The FTYPE is actually not a strong enough constraint anyway, so when IR1
1552 ;;; tests for the call compatibility it will test for correctness *after*
1553 ;;; argument defaulting.
1567 aux)))
1572 ;; If no slot, the arg restriction is T,
1573 ;; because we don't know where it goes.
1579 opt)
1584 keys))))))
1602 foundp)))
1604 ;;; Given a DD and a constructor spec (a cons of name and pre-parsed
1605 ;;; BOA lambda list, or the symbol :DEFAULT), return the effective
1606 ;;; lambda list and the body of the lambda.
1649 ;; If VAR initializes a slot and did not have a default in
1650 ;; the lambda list, and DSD-DEFAULT is not NIL,
1651 ;; then change the lambda-list's default for the variable.
1652 ;; Always prefer to insert (CAR ARG) if ARG was a list
1653 ;; so that (:KEY var) syntax is preserved.
1657 ;; Can we substitute symbols that are not EQ to symbols
1658 ;; naming slots, so we don't have to compare by STRING= later?
1659 ;; Probably not because other symbols could reference them.
1665 llks nil req opt rest keys
1666 ;; &AUX vars which do not initialize a slot are not mentioned
1667 ;; in the lambda list, though it's not clear what to do if
1668 ;; subsequent bindings refer to the deleted ones.
1669 ;; And worse, what if it's SETQd - is that even legal?
1673 creator dd
1677 ;; CLHS 3.4.6 Boa Lambda Lists
1678 '.do-not-initialize-slot.
1682 ;; We can ignore the DD-ELEMENT-TYPE
1683 ;; because the container itself will check.
1697 \f
1698 ;;;; instances with ALTERNATE-METACLASS
1699 ;;;;
1700 ;;;; The CMU CL support for structures with ALTERNATE-METACLASS was a
1701 ;;;; fairly general extension embedded in the main DEFSTRUCT code, and
1702 ;;;; the result was an fairly impressive mess as ALTERNATE-METACLASS
1703 ;;;; extension mixed with ANSI CL generality (e.g. :TYPE and :INCLUDE)
1704 ;;;; and CMU CL implementation hairiness (esp. raw slots). This SBCL
1705 ;;;; version is much less ambitious, noticing that ALTERNATE-METACLASS
1706 ;;;; is only used to implement CONDITION, STANDARD-INSTANCE, and
1707 ;;;; GENERIC-FUNCTION, and defining a simple specialized
1708 ;;;; separate-from-DEFSTRUCT macro to provide only enough
1709 ;;;; functionality to support those.
1710 ;;;;
1711 ;;;; KLUDGE: The defining macro here is so specialized that it's ugly
1712 ;;;; in its own way. It also violates once-and-only-once by knowing
1713 ;;;; much about structures and layouts that is already known by the
1714 ;;;; main DEFSTRUCT macro. Hopefully it will go away presently
1715 ;;;; (perhaps when CL:CLASS and SB-PCL:CLASS meet) as per FIXME below.
1716 ;;;; -- WHN 2001-10-28
1717 ;;;;
1718 ;;;; FIXME: There seems to be no good reason to shoehorn CONDITION,
1719 ;;;; STANDARD-INSTANCE, and GENERIC-FUNCTION into mutated structures
1720 ;;;; instead of just implementing them as primitive objects. (This
1721 ;;;; reduced-functionality macro seems pretty close to the
1722 ;;;; functionality of !DEFINE-PRIMITIVE-OBJECT..)
1724 ;;; The complete list of alternate-metaclass DEFSTRUCTs:
1725 ;;; CONDITION SB-EVAL:INTERPRETED-FUNCTION
1726 ;;; SB-PCL::STANDARD-INSTANCE SB-PCL::STANDARD-FUNCALLABLE-INSTANCE
1727 ;;; SB-PCL::CTOR SB-PCL::%METHOD-FUNCTION
1728 ;;;
1733 metaclass-constructor
1734 slot-names)
1738 ;; The index starts at 1 for ordinary named
1739 ;; slots because slot 0 is magical, used for
1740 ;; the LAYOUT in CONDITIONs and
1741 ;; FUNCALLABLE-INSTANCEs. (This is the same
1742 ;; in ordinary structures too: see (INCF
1743 ;; DD-LENGTH) in
1744 ;; PARSE-DEFSTRUCT-NAME-AND-OPTIONS).
1748 :name slot-name
1749 :index index
1751 reversed-result)
1754 ;; We do *not* fill in the COPIER-NAME and PREDICATE-NAME
1755 ;; because none of the magical alternate-metaclass structures
1756 ;; have copiers and predicates that "Just work"
1758 ;; We don't support inheritance of alternate metaclass stuff,
1759 ;; and it's not a general-purpose facility, so sanity check our
1760 ;; own code.
1767 metaclass-name
1768 metaclass-constructor)
1772 dd))
1774 ;;; make !DEFSTRUCT-WITH-ALTERNATE-METACLASS compilable by the host
1775 ;;; lisp, installing the information we need to reason about the
1776 ;;; structures (layouts and classoids).
1777 ;;;
1778 ;;; FIXME: we should share the parsing and the DD construction between
1779 ;;; this and the cross-compiler version, but my brain was too small to
1780 ;;; get that right. -- CSR, 2006-09-14
1781 #+sb-xc-host
1790 predicate
1795 boa-constructor
1796 superclass-name
1797 metaclass-name
1798 metaclass-constructor))
1804 :class-name class-name
1805 :slot-names slot-names
1806 :superclass-name superclass-name
1807 :metaclass-name metaclass-name
1808 :metaclass-constructor metaclass-constructor
1823 predicate
1828 boa-constructor
1829 superclass-name
1830 metaclass-name
1831 metaclass-constructor))
1836 :class-name class-name
1837 :slot-names slot-names
1838 :superclass-name superclass-name
1839 :metaclass-name metaclass-name
1840 :metaclass-constructor metaclass-constructor
1864 ;; slot readers and writers
1872 dd-slots)
1875 dd-slots)))
1884 dd-slots)
1886 ;; constructor
1895 slot-names)
1898 ;; predicate
1900 ;; Just delegate to the compiler's type optimization
1901 ;; code, which knows how to generate inline type tests
1902 ;; for the whole CMU CL INSTANCE menagerie.
1906 ;; Usually we AVER instead of ASSERT, but AVER isn't defined yet.
1907 ;; A naive reading of 'build-order' suggests it is,
1908 ;; but due to def!struct delay voodoo, it isn't.
1910 \f
1911 ;;;; finalizing bootstrapping
1913 ;;; Set up DD and LAYOUT for STRUCTURE-OBJECT class itself.
1914 ;;;
1915 ;;; Ordinary structure classes effectively :INCLUDE STRUCTURE-OBJECT
1916 ;;; when they have no explicit :INCLUDEs, so (1) it needs to be set up
1917 ;;; before we can define ordinary structure classes, and (2) it's
1918 ;;; special enough (and simple enough) that we just build it by hand
1919 ;;; instead of trying to generalize the ordinary DEFSTRUCT code.
1934 info)
1942 info)))
1949 ;;; These functions are required to emulate SBCL kernel functions
1950 ;;; in a vanilla ANSI Common Lisp cross-compilation host.
1951 ;;; The emulation doesn't need to be efficient, since it's needed
1952 ;;; only for object dumping.
1953 #+sb-xc-host
1958 ;; In the target, it is theoretically possible to have %INSTANCE-LENGTH
1959 ;; exceeed layout length, but in the cross-compiler they're the same.
1963 ;; with compact headers, 0 is an ordinary slot index.
1964 ;; without, it's the layout.
1968 ;; If data starts at 1, then subtract 1 from index.
1969 ;; otherwise use the index as-is.
1973 ;; Why AVER these: because it is slightly abstraction-breaking
1974 ;; to assume that the slot-index N is the NTH item in the DSDs.
1975 ;; The target Lisp never assumes that.
1983 ;; Setting with (FUNCALL `(SETF ,accessor) ...) is unportable because
1984 ;; "The mechanism by which defstruct arranges for slot accessors to be
1985 ;; usable with setf is implementation-dependent; for example, it may
1986 ;; use setf functions, setf expanders, or some other
1987 ;; implementation-dependent mechanism ..."
1988 ;; But such capability seems not to be needed.
1993 ;;; If LAMBDA-LIST and BODY constitute an auto-generated structure function
1994 ;;; (accessor or predicate) for NAME, return the kind of thing it is.
2007 null))))
2008 ;; extract dd-name from `(TYPEP OBJECT ',THING)
2020 ;;; It's easier for the compiler to recognize the output of M-L-F-S-S
2021 ;;; without extraneous QUOTE forms, so we define some trivial wrapper macros.
2026 ;;; We require that MAKE-LOAD-FORM-SAVING-SLOTS produce deterministic output
2027 ;;; and that its output take a particular recognizable form so that it can
2028 ;;; be optimized into a sequence of fasl ops. MAKE-LOAD-FORM no longer returns
2029 ;;; a magic keyword except for the special case of :IGNORE-IT.
2030 ;;; The cross-compiler depends critically on optimizing the resulting sexprs
2031 ;;; so that the host can load cold objects, which it could not do
2032 ;;; if constructed by machine code for the target.
2033 ;;; This ends up being a performance win for the target system as well.
2041 ;; Return T if (but not only-if) INITS came from M-L-F-S-S.
2063 ;; It is possible to produce instances of structure-object which violate
2064 ;; the assumption throughout the compiler that slot readers are safe
2065 ;; unless dictated otherwise by the SAFE-P flag in the DSD.
2066 ;; * (defstruct S a (b (error "Must supply me") :type symbol))
2067 ;; * (defmethod make-load-form ((x S) &optional e) (m-l-f-s-s x :slot-names '(a)))
2068 ;; After these definitions, a dumped S will have 0 in slot B.
2069 ;;
2071 environment)
2073 ;; If TYPE-OF isn't a symbol, the creation form probably can't be compiled
2074 ;; unless there is a MAKE-LOAD-FORM on the class without a proper-name.
2075 ;; This is better than returning a creation form that produces
2076 ;; something completely different.
2091 #-sb-xc-host
2097 collect name into names
2098 and
2105 ;; Call MAKE-LOAD-FORM inside a condition handler in case the method fails.
2106 ; If the resulting CREATION-FORM and INIT-FORM are equivalent to those
2107 ;; returned from MAKE-LOAD-FORM-SAVING-SLOTS, return 'SB-FASL::FOP-STRUCT.
2108 ;; If the object can be ignored, return :IGNORE-IT and NIL.
2122 constant))