| blob | fb0d53713d125a1705077e78cbe560420c0ba4fc |
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
37 (:constructor make-pv-table-internal
47 ;;; FIXME: The comment below seem to indicate that this was intended
48 ;;; to be actually used, however, it isn't anymore, and was commented
49 ;;; out at 0.9.13.47. Also removed was code in MAKE-PV-TABLE that
50 ;;; pushed each new PV-TABLE onto this list. --NS 2006-06-18
51 ;;;
52 ;;; help new slot-value-using-class methods affect fast iv access
53 ;;;
54 ;;; (defvar *all-pv-table-list* nil)
66 ;;; Entries in this are lists of (table . pv-offset-list).
94 pv-table))))
120 nil)
130 ref)
131 \f
167 nil)
168 elements)))))))
172 #||
176 call-list)
177 ||#
178 '#())
194 wrappers classes types
198 ||#
210 :value t
214 value
219 ;; This is safe: if another thread races us here the loser just
220 ;; misses the next time as well.
223 pv-cell)))))
260 nil)))
261 slot-names))
265 slot-name
285 cwrapper pv-size pv-map))
286 cache))))))
305 \f
315 ;;; FIXME: This looks like an internal helper function for
316 ;;; CAN-OPTIMIZE-ACCESS, and it is used that way, but it's also called
317 ;;; bare from several places in the code. Perhaps the two functions
318 ;;; should be renamed CAN-OPTIMIZE-ACCESS-FOR-FORM and
319 ;;; CAN-OPTIMIZE-ACCESS-FOR-VAR. If so, I'd just as soon use keyword
320 ;;; args instead of optional ones, too.
324 ;; FIXME: We should assert list of length 3 here. Or maybe we
325 ;; should just define EXTRACT-THE, replace the whole
326 ;; (WHEN ..)
327 ;; form with
328 ;; (AWHEN (EXTRACT-THE VAR)
329 ;; (SETF VAR IT))
330 ;; and then use EXTRACT-THE similarly to clean up the other tests
331 ;; against 'THE scattered through the PCL code.
336 required-parameters))))
339 parameter-or-nil
340 env)))
353 ;;; Check whether the binding of the named variable is modified in the
354 ;;; method body.
366 slot-name nil)))))
367 ;; We don't return the optimized form directly, since there's
368 ;; still a chance that we'll find out later on that the
369 ;; optimization should not have been done, for example due to
370 ;; the walker encountering a SETQ on SPARAMETER later on in
371 ;; the body [ see for example clos.impure.lisp test with :name
372 ;; ((:setq :method-parameter) slot-value)) ]. Instead we defer
373 ;; the decision until the compiler macroexpands
374 ;; OPTIMIZED-SLOT-VALUE.
375 ;;
376 ;; Note that we must still call OPTIMIZE-INSTANCE-ACCESS at
377 ;; this point (instead of when expanding
378 ;; OPTIMIZED-SLOT-VALUE), since it mutates the structure of
379 ;; SLOTS. If that mutation isn't done during the walking,
380 ;; MAKE-METHOD-LAMBDA-INTERNAL won't wrap a correct PV-BINDING
381 ;; form around the body, and compilation will fail. -- JES,
382 ;; 2006-09-18
388 ;; Either use OPTIMIZED-FORM or fall back to the safe
389 ;; ACCESSOR-SLOT-VALUE.
392 optimized-form))
401 :write
402 sparameter
403 slot-name
404 new-value)))))
405 ;; See OPTIMIZE-SLOT-VALUE
412 ;; Don't optimize slot value setting in safe code, since the
413 ;; optimized version will fail to catch some type errors
414 ;; (for example when a subclass declares a tighter type for
415 ;; the slot than a superclass).
420 optimized-form)))
426 ;; FIXME: In CMU CL ca. 19991205, this binding list
427 ;; had a fourth element in it, NEW-VALUE. It's hard
428 ;; to see how that could possibly be right, since
429 ;; SLOT-BOUNDP has no NEW-VALUE. Since it was
430 ;; causing a failure in building PCL for SBCL, so I
431 ;; changed it to match the definition of
432 ;; SLOT-BOUNDP (and also to match the list used in
433 ;; the similar OPTIMIZE-SLOT-VALUE,
434 ;; above). However, I'm weirded out by this, since
435 ;; this is old code which has worked for ages to
436 ;; build PCL for CMU CL, so it's hard to see why it
437 ;; should need a patch like this in order to build
438 ;; PCL for SBCL. I'd like to return to this and
439 ;; find a test case which exercises this function
440 ;; both in CMU CL, to see whether it's really a
441 ;; previously-unexercised bug or whether I've
442 ;; misunderstood something (and, presumably,
443 ;; patched it wrong).
445 form
449 :boundp
450 sparameter
451 slot-name
452 nil)))))
453 ;; See OPTIMIZE-SLOT-VALUE
461 optimized-form))
463 ;;; The SLOTS argument is an alist, the CAR of each entry is the name
464 ;;; of a required parameter to the function. The alist is in order, so
465 ;;; the position of an entry in the alist corresponds to the
466 ;;; argument's position in the lambda list.
468 read/write
469 sparameter
470 slot-name
471 new-value)
479 (:read
481 (:write
485 (:boundp
486 t)))
498 (:read
501 (:write
505 (:boundp
514 ;;; It is safe for these two functions to be wrong. They just try to
515 ;;; guess what the most likely case will be.
535 slot-name
536 type))))))
548 default
554 ;; FIXME: the line marked by KLUDGE below
555 ;; (and the analogous spot in
556 ;; INSTANCE-WRITE-INTERNAL) is there purely
557 ;; to suppress a type mismatch warning that
558 ;; propagates through to user code.
559 ;; Presumably SLOTS at this point can never
560 ;; actually be NIL, but the compiler seems
561 ;; to think it could, so we put this here
562 ;; to shut it up. (see also mail Rudi
563 ;; Schlatte sbcl-devel 2003-09-21) -- CSR,
564 ;; 2003-11-30
573 ,default
589 default
603 parameter
604 position
605 slot-name
606 class
607 new-value)
621 default
642 ;;; This magic function has quite a job to do indeed.
643 ;;;
644 ;;; The careful reader will recall that <slots> contains all of the
645 ;;; optimized slot access forms produced by OPTIMIZE-INSTANCE-ACCESS.
646 ;;; Each of these is a call to either INSTANCE-READ or INSTANCE-WRITE.
647 ;;;
648 ;;; At the time these calls were produced, the first argument was
649 ;;; specified as the symbol .PV-OFFSET.; what we have to do now is
650 ;;; convert those pv-offset arguments into the actual number that is
651 ;;; the correct offset into the pv.
652 ;;;
653 ;;; But first, oh but first, we sort <slots> a bit so that for each
654 ;;; argument we have the slots in alphabetical order. This
655 ;;; canonicalizes the PV-TABLE's a bit and will hopefully lead to
656 ;;; having fewer PV's floating around. Even if the gain is only
657 ;;; modest, it costs nothing.
663 slots))
673 slot-name-lists))
678 slot-name-lists)))))
684 arg))
686 call-list)))
708 ;;; FIXME: Because of the existence of UNINTERN and RENAME-PACKAGE,
709 ;;; the part of this ordering which is based on SYMBOL-PKG-NAME is not
710 ;;; stable. This ordering is only used in to
711 ;;; SLOT-NAME-LISTS-FROM-SLOTS, where it serves to "canonicalize the
712 ;;; PV-TABLE's a bit and will hopefully lead to having fewer PV's
713 ;;; floating around", so it sounds as though the instability won't
714 ;;; actually lead to bugs, just small inefficiency. But still, it
715 ;;; would be better to reimplement this function as a comparison based
716 ;;; on SYMBOL-HASH:
717 ;;; * stable comparison
718 ;;; * smaller code (here, and in being able to discard SYMBOL-PKG-NAME)
719 ;;; * faster code.
743 #'symbol-or-cons-lessp
745 slots))
749 \f
750 ;;;; This needs to work in terms of metatypes and also needs to work
751 ;;;; for automatically generated reader and writer functions.
752 ;;;; Automatically generated reader and writer functions use this
753 ;;;; stuff too.
759 for required-parameter in required-parameters
760 for i from 0
772 slot-vars pv-parameters))
776 ;;; This will only be visible in PV-ENV when the default MAKE-METHOD-LAMBDA is
777 ;;; overridden.
783 ;; Decide which expansion to use based on the state of the PV-ENV-ENVIRONMENT
784 ;; symbol-macrolet.
802 ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I
803 ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If
804 ;; SBCL doesn't have 'em, VALUES should probably be removed from
805 ;; this list.
807 %method-name
808 %method-lambda-list
809 optimize
810 ftype
811 muffle-conditions
812 inline
813 notinline))
816 '(%class
817 type))
821 ignorable special dynamic-extent
822 ;; FIXME: Possibly this entire list and variable could go away.
823 ;; If not, certainly we should remove all these built-in typenames
824 ;; from the list, and replace them with a test for "is it a type
825 ;; name?" (CLTL1 allowed only built-in type names as declarations,
826 ;; but ANSI CL allows any type name as a declaration.)
827 array atom base-char bignum bit bit-vector character compiled-function
828 complex cons double-float extended-char
829 fixnum float function hash-table integer
830 keyword list long-float nil null number package pathname random-state ratio
831 rational readtable sequence short-float signed-byte simple-array
832 simple-bit-vector simple-string simple-vector single-float standard-char
833 stream string symbol t unsigned-byte vector))
838 decl)
858 ;; FIXME: This warning, and perhaps the
859 ;; various *VAR-DECLARATIONS-FOO* and/or
860 ;; *NON-VAR-DECLARATIONS* variables,
861 ;; could probably go away now that we're not
862 ;; trying to be portable between different
863 ;; CLTL1 hosts the way PCL was. (Note that to
864 ;; do this right, we need to be able to handle
865 ;; user-defined (DECLAIM (DECLARATION FOO))
866 ;; stuff.)
868 Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
869 (Assuming it is a variable declaration without argument)."
870 declaration-name 'split-declarations
871 declaration-name
883 ;; Quietly remove IGNORE declarations
884 ;; on args when a next-method is
885 ;; involved, to prevent compiler
886 ;; warnings about ignored args being
887 ;; read.
897 inner-decls)))))))))
901 ;;; Pull a name out of the %METHOD-NAME declaration in the function
902 ;;; body given, or return NIL if no %METHOD-NAME declaration is found.
910 name)))))
912 ;;; Convert a lambda expression containing a SB-PCL::%METHOD-NAME
913 ;;; declaration (which is a naming style internal to PCL) into an
914 ;;; SB-INT:NAMED-LAMBDA expression (which is a naming style used
915 ;;; throughout SBCL, understood by the main compiler); or if there's
916 ;;; no SB-PCL::%METHOD-NAME declaration, then just return the original
917 ;;; lambda expression.
922 method-lambda)))
927 lmf ; becomes body of function
928 lmf-params)
957 ;; Given a valid lambda list, extract the parameter names.
959 with res = nil
964 ;; ... ((:BAR FOO) 1)
966 ;; ... (FOO 1)
968 ;; ... (... 1 FOO-P)
972 ;; ... FOO
980 ;; Names of the parameters that will be in the outermost lambda-list
981 ;; (and whose bound declarations thus need to be in OUTER-DECLS).
983 ;; The lambda-list used by BIND-ARGS
988 ;; Try to use the normal function call machinery instead of BIND-ARGS
989 ;; binding the arguments, unless:
991 ;; in any case.
993 ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a
994 ;; list of all non-required arguments.
995 call-next-method-p)
997 restp nil
998 ;; Get all the parameters for declaration parsing
1000 ;; Ensure that BIND-ARGS won't do anything (since
1001 ;; BIND-LIST won't contain any non-required parameters,
1002 ;; and REQ-ARGS will be of an equal length). We still want
1003 ;; to pass BIND-LIST to FAST-LEXICAL-METHOD-FUNCTIONS so
1004 ;; that BIND-FAST-LEXICAL-METHOD-FUNCTIONS can take care
1005 ;; of rebinding SETQd required arguments around the method
1006 ;; body.
1007 bind-list req-args))
1016 req-args
1017 lambda-list))))
1019 :function
1022 ;; function name
1024 ;; The lambda-list of the FMF
1026 ;; body of the function
1029 ,@outer-decls
1034 ,@inner-decls
1039 mf)
1042 ;;; Use arrays and hash tables and the fngen stuff to make this much
1043 ;;; better. It doesn't really matter, though, because a function
1044 ;;; returned by this will get called only when the user explicitly
1045 ;;; funcalls a result of method-function. BUT, this is needed to make
1046 ;;; early methods work.
1067 nm)
1070 ;; FIXME: this looks dangerous.
1074 method-function))
1076 ;;; this is similar to the above, only not quite. Only called when
1077 ;;; the MOP is heavily involved. Not quite parallel to
1078 ;;; METHOD-FUNCTION-FROM-FAST-METHOD-FUNCTION, because we can close
1079 ;;; over the actual PV-CELL in this case.
1093 nm)
1111 wrapper)
1112 wrappers)))))
1116 when snl
1120 ;;; Return the subset of WRAPPERS which is used in the cache
1121 ;;; of PV-TABLE.
1124 when snl
1125 collect w into result