| blob | cc5ef22cfe3f0e8c096c8d97977e0b295f43a609 |
1 ;;;; permutation vectors
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
6 ;;;; This software is derived from software originally released by Xerox
7 ;;;; Corporation. Copyright and release statements follow. Later modifications
8 ;;;; to the software are in the public domain and are provided with
9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
10 ;;;; information.
12 ;;;; copyright information from original PCL sources:
13 ;;;;
14 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
15 ;;;; All rights reserved.
16 ;;;;
17 ;;;; Use and copying of this software and preparation of derivative works based
18 ;;;; upon this software are permitted. Any distribution of this software or
19 ;;;; derivative works must comply with all applicable United States export
20 ;;;; control laws.
21 ;;;;
22 ;;;; This software is made available AS IS, and Xerox Corporation makes no
23 ;;;; warranty about the software, its performance or its conformity to any
24 ;;;; specification.
27 \f
35 \f
40 (:constructor make-pv-table-internal
50 ;;; FIXME: The comment below seem to indicate that this was intended
51 ;;; to be actually used, however, it isn't anymore, and was commented
52 ;;; out at 0.9.13.47. Also removed was code in MAKE-PV-TABLE that
53 ;;; pushed each new PV-TABLE onto this list. --NS 2006-06-18
54 ;;;
55 ;;; help new slot-value-using-class methods affect fast iv access
56 ;;;
57 ;;; (defvar *all-pv-table-list* nil)
69 ;;; Entries in this are lists of (table . pv-offset-list).
97 pv-table))))
123 nil)
133 ref)
134 \f
170 nil)
171 elements)))))))
175 #||
179 call-list)
180 ||#
181 '#())
197 wrappers classes types
201 ||#
213 t
214 #'pv-cache-limit-fn
223 pv-cell))))
263 nil)))
264 slot-names))
268 slot-name
288 cwrapper pv-size pv-map))
289 cache))))))
308 \f
318 ;;; FIXME: This looks like an internal helper function for
319 ;;; CAN-OPTIMIZE-ACCESS, and it is used that way, but it's also called
320 ;;; bare from several places in the code. Perhaps the two functions
321 ;;; should be renamed CAN-OPTIMIZE-ACCESS-FOR-FORM and
322 ;;; CAN-OPTIMIZE-ACCESS-FOR-VAR. If so, I'd just as soon use keyword
323 ;;; args instead of optional ones, too.
327 ;; FIXME: We should assert list of length 3 here. Or maybe we
328 ;; should just define EXTRACT-THE, replace the whole
329 ;; (WHEN ..)
330 ;; form with
331 ;; (AWHEN (EXTRACT-THE VAR)
332 ;; (SETF VAR IT))
333 ;; and then use EXTRACT-THE similarly to clean up the other tests
334 ;; against 'THE scattered through the PCL code.
339 required-parameters))))
342 parameter-or-nil
343 env)))
356 ;;; Check whether the binding of the named variable is modified in the
357 ;;; method body.
369 slot-name nil)))))
370 ;; We don't return the optimized form directly, since there's
371 ;; still a chance that we'll find out later on that the
372 ;; optimization should not have been done, for example due to
373 ;; the walker encountering a SETQ on SPARAMETER later on in
374 ;; the body [ see for example clos.impure.lisp test with :name
375 ;; ((:setq :method-parameter) slot-value)) ]. Instead we defer
376 ;; the decision until the compiler macroexpands
377 ;; OPTIMIZED-SLOT-VALUE.
378 ;;
379 ;; Note that we must still call OPTIMIZE-INSTANCE-ACCESS at
380 ;; this point (instead of when expanding
381 ;; OPTIMIZED-SLOT-VALUE), since it mutates the structure of
382 ;; SLOTS. If that mutation isn't done during the walking,
383 ;; MAKE-METHOD-LAMBDA-INTERNAL won't wrap a correct PV-BINDING
384 ;; form around the body, and compilation will fail. -- JES,
385 ;; 2006-09-18
391 ;; Either use OPTIMIZED-FORM or fall back to the safe
392 ;; ACCESSOR-SLOT-VALUE.
395 optimized-form))
404 :write
405 sparameter
406 slot-name
407 new-value)))))
408 ;; See OPTIMIZE-SLOT-VALUE
415 ;; Don't optimize slot value setting in safe code, since the
416 ;; optimized version will fail to catch some type errors
417 ;; (for example when a subclass declares a tighter type for
418 ;; the slot than a superclass).
423 optimized-form)))
429 ;; FIXME: In CMU CL ca. 19991205, this binding list
430 ;; had a fourth element in it, NEW-VALUE. It's hard
431 ;; to see how that could possibly be right, since
432 ;; SLOT-BOUNDP has no NEW-VALUE. Since it was
433 ;; causing a failure in building PCL for SBCL, so I
434 ;; changed it to match the definition of
435 ;; SLOT-BOUNDP (and also to match the list used in
436 ;; the similar OPTIMIZE-SLOT-VALUE,
437 ;; above). However, I'm weirded out by this, since
438 ;; this is old code which has worked for ages to
439 ;; build PCL for CMU CL, so it's hard to see why it
440 ;; should need a patch like this in order to build
441 ;; PCL for SBCL. I'd like to return to this and
442 ;; find a test case which exercises this function
443 ;; both in CMU CL, to see whether it's really a
444 ;; previously-unexercised bug or whether I've
445 ;; misunderstood something (and, presumably,
446 ;; patched it wrong).
448 form
452 :boundp
453 sparameter
454 slot-name
455 nil)))))
456 ;; See OPTIMIZE-SLOT-VALUE
464 optimized-form))
466 ;;; The SLOTS argument is an alist, the CAR of each entry is the name
467 ;;; of a required parameter to the function. The alist is in order, so
468 ;;; the position of an entry in the alist corresponds to the
469 ;;; argument's position in the lambda list.
471 read/write
472 sparameter
473 slot-name
474 new-value)
482 (:read
484 (:write
488 (:boundp
489 t)))
501 (:read
504 (:write
508 (:boundp
517 ;;; It is safe for these two functions to be wrong. They just try to
518 ;;; guess what the most likely case will be.
538 slot-name
539 type))))))
551 default
557 ;; FIXME: the line marked by KLUDGE below
558 ;; (and the analogous spot in
559 ;; INSTANCE-WRITE-INTERNAL) is there purely
560 ;; to suppress a type mismatch warning that
561 ;; propagates through to user code.
562 ;; Presumably SLOTS at this point can never
563 ;; actually be NIL, but the compiler seems
564 ;; to think it could, so we put this here
565 ;; to shut it up. (see also mail Rudi
566 ;; Schlatte sbcl-devel 2003-09-21) -- CSR,
567 ;; 2003-11-30
576 ,default
592 default
606 parameter
607 position
608 slot-name
609 class
610 new-value)
624 default
645 ;;; This magic function has quite a job to do indeed.
646 ;;;
647 ;;; The careful reader will recall that <slots> contains all of the
648 ;;; optimized slot access forms produced by OPTIMIZE-INSTANCE-ACCESS.
649 ;;; Each of these is a call to either INSTANCE-READ or INSTANCE-WRITE.
650 ;;;
651 ;;; At the time these calls were produced, the first argument was
652 ;;; specified as the symbol .PV-OFFSET.; what we have to do now is
653 ;;; convert those pv-offset arguments into the actual number that is
654 ;;; the correct offset into the pv.
655 ;;;
656 ;;; But first, oh but first, we sort <slots> a bit so that for each
657 ;;; argument we have the slots in alphabetical order. This
658 ;;; canonicalizes the PV-TABLE's a bit and will hopefully lead to
659 ;;; having fewer PV's floating around. Even if the gain is only
660 ;;; modest, it costs nothing.
666 slots))
676 slot-name-lists))
681 slot-name-lists)))))
687 arg))
689 call-list)))
711 ;;; FIXME: Because of the existence of UNINTERN and RENAME-PACKAGE,
712 ;;; the part of this ordering which is based on SYMBOL-PKG-NAME is not
713 ;;; stable. This ordering is only used in to
714 ;;; SLOT-NAME-LISTS-FROM-SLOTS, where it serves to "canonicalize the
715 ;;; PV-TABLE's a bit and will hopefully lead to having fewer PV's
716 ;;; floating around", so it sounds as though the instability won't
717 ;;; actually lead to bugs, just small inefficiency. But still, it
718 ;;; would be better to reimplement this function as a comparison based
719 ;;; on SYMBOL-HASH:
720 ;;; * stable comparison
721 ;;; * smaller code (here, and in being able to discard SYMBOL-PKG-NAME)
722 ;;; * faster code.
746 #'symbol-or-cons-lessp
748 slots))
752 \f
753 ;;;; This needs to work in terms of metatypes and also needs to work
754 ;;;; for automatically generated reader and writer functions.
755 ;;;; Automatically generated reader and writer functions use this
756 ;;;; stuff too.
762 for required-parameter in required-parameters
763 for i from 0
775 slot-vars pv-parameters))
779 ;;; This will only be visible in PV-ENV when the default MAKE-METHOD-LAMBDA is
780 ;;; overridden.
786 ;; Decide which expansion to use based on the state of the PV-ENV-ENVIRONMENT
787 ;; symbol-macrolet.
805 ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I
806 ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If
807 ;; SBCL doesn't have 'em, VALUES should probably be removed from
808 ;; this list.
810 %method-name
811 %method-lambda-list
812 optimize
813 ftype
814 muffle-conditions
815 inline
816 notinline))
819 '(%class
820 type))
824 ignorable special dynamic-extent
825 ;; FIXME: Possibly this entire list and variable could go away.
826 ;; If not, certainly we should remove all these built-in typenames
827 ;; from the list, and replace them with a test for "is it a type
828 ;; name?" (CLTL1 allowed only built-in type names as declarations,
829 ;; but ANSI CL allows any type name as a declaration.)
830 array atom base-char bignum bit bit-vector character compiled-function
831 complex cons double-float extended-char
832 fixnum float function hash-table integer
833 keyword list long-float nil null number package pathname random-state ratio
834 rational readtable sequence short-float signed-byte simple-array
835 simple-bit-vector simple-string simple-vector single-float standard-char
836 stream string symbol t unsigned-byte vector))
841 decl)
861 ;; FIXME: This warning, and perhaps the
862 ;; various *VAR-DECLARATIONS-FOO* and/or
863 ;; *NON-VAR-DECLARATIONS* variables,
864 ;; could probably go away now that we're not
865 ;; trying to be portable between different
866 ;; CLTL1 hosts the way PCL was. (Note that to
867 ;; do this right, we need to be able to handle
868 ;; user-defined (DECLAIM (DECLARATION FOO))
869 ;; stuff.)
871 Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
872 (Assuming it is a variable declaration without argument)."
873 declaration-name 'split-declarations
874 declaration-name
886 ;; Quietly remove IGNORE declarations
887 ;; on args when a next-method is
888 ;; involved, to prevent compiler
889 ;; warnings about ignored args being
890 ;; read.
900 inner-decls)))))))))
904 ;;; Pull a name out of the %METHOD-NAME declaration in the function
905 ;;; body given, or return NIL if no %METHOD-NAME declaration is found.
913 name)))))
915 ;;; Convert a lambda expression containing a SB-PCL::%METHOD-NAME
916 ;;; declaration (which is a naming style internal to PCL) into an
917 ;;; SB-INT:NAMED-LAMBDA expression (which is a naming style used
918 ;;; throughout SBCL, understood by the main compiler); or if there's
919 ;;; no SB-PCL::%METHOD-NAME declaration, then just return the original
920 ;;; lambda expression.
925 method-lambda)))
930 lmf ; becomes body of function
931 lmf-params)
960 ;; Given a valid lambda list, extract the parameter names.
962 with res = nil
967 ;; ... ((:BAR FOO) 1)
969 ;; ... (FOO 1)
971 ;; ... (... 1 FOO-P)
975 ;; ... FOO
983 ;; Names of the parameters that will be in the outermost lambda-list
984 ;; (and whose bound declarations thus need to be in OUTER-DECLS).
986 ;; The lambda-list used by BIND-ARGS
991 ;; Try to use the normal function call machinery instead of BIND-ARGS
992 ;; binding the arguments, unless:
994 ;; in any case.
996 ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a
997 ;; list of all non-required arguments.
998 call-next-method-p)
1000 restp nil
1001 ;; Get all the parameters for declaration parsing
1003 ;; Ensure that BIND-ARGS won't do anything (since
1004 ;; BIND-LIST won't contain any non-required parameters,
1005 ;; and REQ-ARGS will be of an equal length). We still want
1006 ;; to pass BIND-LIST to FAST-LEXICAL-METHOD-FUNCTIONS so
1007 ;; that BIND-FAST-LEXICAL-METHOD-FUNCTIONS can take care
1008 ;; of rebinding SETQd required arguments around the method
1009 ;; body.
1010 bind-list req-args))
1019 req-args
1020 lambda-list))))
1022 :function
1025 ;; function name
1027 ;; The lambda-list of the FMF
1029 ;; body of the function
1032 ,@outer-decls
1037 ,@inner-decls
1042 mf)
1045 ;;; Use arrays and hash tables and the fngen stuff to make this much
1046 ;;; better. It doesn't really matter, though, because a function
1047 ;;; returned by this will get called only when the user explicitly
1048 ;;; funcalls a result of method-function. BUT, this is needed to make
1049 ;;; early methods work.
1070 nm)
1073 ;; FIXME: this looks dangerous.
1077 method-function))
1079 ;;; this is similar to the above, only not quite. Only called when
1080 ;;; the MOP is heavily involved. Not quite parallel to
1081 ;;; METHOD-FUNCTION-FROM-FAST-METHOD-FUNCTION, because we can close
1082 ;;; over the actual PV-CELL in this case.
1096 nm)
1114 wrapper)
1115 wrappers)))))
1119 when snl
1123 ;;; Return the subset of WRAPPERS which is used in the cache
1124 ;;; of PV-TABLE.
1127 when snl
1128 collect w into result