| blob | 1a6f79f83a70195bbdf0eb09efaf0ba4e5cbf6b5 |
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
314 ;; FIXME: We should assert list of length 3 here. Or maybe we
315 ;; should just define EXTRACT-THE, replace the whole (WHEN ..)
316 ;; form with (AWHEN (EXTRACT-THE VAR) (SETF VAR IT)) and then
317 ;; use EXTRACT-THE similarly to clean up the other tests against
318 ;; 'THE scattered through the PCL code.
323 required-parameters))))
326 parameter-or-nil
327 env)))
340 ;;; Check whether the binding of the named variable is modified in the
341 ;;; method body.
353 slot-name nil)))))
354 ;; We don't return the optimized form directly, since there's
355 ;; still a chance that we'll find out later on that the
356 ;; optimization should not have been done, for example due to
357 ;; the walker encountering a SETQ on SPARAMETER later on in
358 ;; the body [ see for example clos.impure.lisp test with :name
359 ;; ((:setq :method-parameter) slot-value)) ]. Instead we defer
360 ;; the decision until the compiler macroexpands
361 ;; OPTIMIZED-SLOT-VALUE.
362 ;;
363 ;; Note that we must still call OPTIMIZE-INSTANCE-ACCESS at
364 ;; this point (instead of when expanding
365 ;; OPTIMIZED-SLOT-VALUE), since it mutates the structure of
366 ;; SLOTS. If that mutation isn't done during the walking,
367 ;; MAKE-METHOD-LAMBDA-INTERNAL won't wrap a correct PV-BINDING
368 ;; form around the body, and compilation will fail. -- JES,
369 ;; 2006-09-18
375 ;; Either use OPTIMIZED-FORM or fall back to the safe
376 ;; ACCESSOR-SLOT-VALUE.
379 optimized-form))
388 :write
389 sparameter
390 slot-name
391 new-value)))))
392 ;; See OPTIMIZE-SLOT-VALUE
399 ;; Don't optimize slot value setting in safe code, since the
400 ;; optimized version will fail to catch some type errors
401 ;; (for example when a subclass declares a tighter type for
402 ;; the slot than a superclass).
407 optimized-form)))
413 ;; FIXME: In CMU CL ca. 19991205, this binding list
414 ;; had a fourth element in it, NEW-VALUE. It's hard
415 ;; to see how that could possibly be right, since
416 ;; SLOT-BOUNDP has no NEW-VALUE. Since it was
417 ;; causing a failure in building PCL for SBCL, so I
418 ;; changed it to match the definition of
419 ;; SLOT-BOUNDP (and also to match the list used in
420 ;; the similar OPTIMIZE-SLOT-VALUE,
421 ;; above). However, I'm weirded out by this, since
422 ;; this is old code which has worked for ages to
423 ;; build PCL for CMU CL, so it's hard to see why it
424 ;; should need a patch like this in order to build
425 ;; PCL for SBCL. I'd like to return to this and
426 ;; find a test case which exercises this function
427 ;; both in CMU CL, to see whether it's really a
428 ;; previously-unexercised bug or whether I've
429 ;; misunderstood something (and, presumably,
430 ;; patched it wrong).
432 form
436 :boundp
437 sparameter
438 slot-name
439 nil)))))
440 ;; See OPTIMIZE-SLOT-VALUE
448 optimized-form))
450 ;;; The SLOTS argument is an alist, the CAR of each entry is the name
451 ;;; of a required parameter to the function. The alist is in order, so
452 ;;; the position of an entry in the alist corresponds to the
453 ;;; argument's position in the lambda list.
455 read/write
456 sparameter
457 slot-name
458 new-value)
466 (:read
468 (:write
472 (:boundp
473 t)))
485 (:read
488 (:write
492 (:boundp
501 ;;; It is safe for these two functions to be wrong. They just try to
502 ;;; guess what the most likely case will be.
522 slot-name
523 type))))))
535 default
541 ;; FIXME: the line marked by KLUDGE below
542 ;; (and the analogous spot in
543 ;; INSTANCE-WRITE-INTERNAL) is there purely
544 ;; to suppress a type mismatch warning that
545 ;; propagates through to user code.
546 ;; Presumably SLOTS at this point can never
547 ;; actually be NIL, but the compiler seems
548 ;; to think it could, so we put this here
549 ;; to shut it up. (see also mail Rudi
550 ;; Schlatte sbcl-devel 2003-09-21) -- CSR,
551 ;; 2003-11-30
560 ,default
576 default
590 parameter
591 position
592 slot-name
593 class
594 new-value)
608 default
629 ;;; This magic function has quite a job to do indeed.
630 ;;;
631 ;;; The careful reader will recall that <slots> contains all of the
632 ;;; optimized slot access forms produced by OPTIMIZE-INSTANCE-ACCESS.
633 ;;; Each of these is a call to either INSTANCE-READ or INSTANCE-WRITE.
634 ;;;
635 ;;; At the time these calls were produced, the first argument was
636 ;;; specified as the symbol .PV-OFFSET.; what we have to do now is
637 ;;; convert those pv-offset arguments into the actual number that is
638 ;;; the correct offset into the pv.
639 ;;;
640 ;;; But first, oh but first, we sort <slots> a bit so that for each
641 ;;; argument we have the slots in alphabetical order. This
642 ;;; canonicalizes the PV-TABLE's a bit and will hopefully lead to
643 ;;; having fewer PV's floating around. Even if the gain is only
644 ;;; modest, it costs nothing.
650 slots))
660 slot-name-lists))
665 slot-name-lists)))))
671 arg))
673 call-list)))
695 ;;; FIXME: Because of the existence of UNINTERN and RENAME-PACKAGE,
696 ;;; the part of this ordering which is based on SYMBOL-PKG-NAME is not
697 ;;; stable. This ordering is only used in to
698 ;;; SLOT-NAME-LISTS-FROM-SLOTS, where it serves to "canonicalize the
699 ;;; PV-TABLE's a bit and will hopefully lead to having fewer PV's
700 ;;; floating around", so it sounds as though the instability won't
701 ;;; actually lead to bugs, just small inefficiency. But still, it
702 ;;; would be better to reimplement this function as a comparison based
703 ;;; on SYMBOL-HASH:
704 ;;; * stable comparison
705 ;;; * smaller code (here, and in being able to discard SYMBOL-PKG-NAME)
706 ;;; * faster code.
730 #'symbol-or-cons-lessp
732 slots))
736 \f
737 ;;;; This needs to work in terms of metatypes and also needs to work
738 ;;;; for automatically generated reader and writer functions.
739 ;;;; Automatically generated reader and writer functions use this
740 ;;;; stuff too.
746 for required-parameter in required-parameters
747 for i from 0
759 slot-vars pv-parameters))
763 ;;; This will only be visible in PV-ENV when the default MAKE-METHOD-LAMBDA is
764 ;;; overridden.
770 ;; Decide which expansion to use based on the state of the PV-ENV-ENVIRONMENT
771 ;; symbol-macrolet.
789 ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I
790 ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If
791 ;; SBCL doesn't have 'em, VALUES should probably be removed from
792 ;; this list.
794 %method-name
795 %method-lambda-list
796 optimize
797 ftype
798 muffle-conditions
799 inline
800 notinline))
803 '(%class
804 type))
808 ignorable special dynamic-extent
809 ;; FIXME: Possibly this entire list and variable could go away.
810 ;; If not, certainly we should remove all these built-in typenames
811 ;; from the list, and replace them with a test for "is it a type
812 ;; name?" (CLTL1 allowed only built-in type names as declarations,
813 ;; but ANSI CL allows any type name as a declaration.)
814 array atom base-char bignum bit bit-vector character compiled-function
815 complex cons double-float extended-char
816 fixnum float function hash-table integer
817 keyword list long-float nil null number package pathname random-state ratio
818 rational readtable sequence short-float signed-byte simple-array
819 simple-bit-vector simple-string simple-vector single-float standard-char
820 stream string symbol t unsigned-byte vector))
825 decl)
845 ;; FIXME: This warning, and perhaps the
846 ;; various *VAR-DECLARATIONS-FOO* and/or
847 ;; *NON-VAR-DECLARATIONS* variables,
848 ;; could probably go away now that we're not
849 ;; trying to be portable between different
850 ;; CLTL1 hosts the way PCL was. (Note that to
851 ;; do this right, we need to be able to handle
852 ;; user-defined (DECLAIM (DECLARATION FOO))
853 ;; stuff.)
855 Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
856 (Assuming it is a variable declaration without argument)."
857 declaration-name 'split-declarations
858 declaration-name
870 ;; Quietly remove IGNORE declarations
871 ;; on args when a next-method is
872 ;; involved, to prevent compiler
873 ;; warnings about ignored args being
874 ;; read.
884 inner-decls)))))))))
888 ;;; Pull a name out of the %METHOD-NAME declaration in the function
889 ;;; body given, or return NIL if no %METHOD-NAME declaration is found.
897 name)))))
899 ;;; Convert a lambda expression containing a SB-PCL::%METHOD-NAME
900 ;;; declaration (which is a naming style internal to PCL) into an
901 ;;; SB-INT:NAMED-LAMBDA expression (which is a naming style used
902 ;;; throughout SBCL, understood by the main compiler); or if there's
903 ;;; no SB-PCL::%METHOD-NAME declaration, then just return the original
904 ;;; lambda expression.
909 method-lambda)))
914 lmf ; becomes body of function
915 lmf-params)
944 ;; Given a valid lambda list, extract the parameter names.
946 with res = nil
951 ;; ... ((:BAR FOO) 1)
953 ;; ... (FOO 1)
955 ;; ... (... 1 FOO-P)
959 ;; ... FOO
967 ;; Names of the parameters that will be in the outermost lambda-list
968 ;; (and whose bound declarations thus need to be in OUTER-DECLS).
970 ;; The lambda-list used by BIND-ARGS
975 ;; Try to use the normal function call machinery instead of BIND-ARGS
976 ;; binding the arguments, unless:
978 ;; in any case.
980 ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a
981 ;; list of all non-required arguments.
982 call-next-method-p)
984 restp nil
985 ;; Get all the parameters for declaration parsing
987 ;; Ensure that BIND-ARGS won't do anything (since
988 ;; BIND-LIST won't contain any non-required parameters,
989 ;; and REQ-ARGS will be of an equal length). We still want
990 ;; to pass BIND-LIST to FAST-LEXICAL-METHOD-FUNCTIONS so
991 ;; that BIND-FAST-LEXICAL-METHOD-FUNCTIONS can take care
992 ;; of rebinding SETQd required arguments around the method
993 ;; body.
994 bind-list req-args))
1003 req-args
1004 lambda-list))))
1006 :function
1009 ;; function name
1011 ;; The lambda-list of the FMF
1013 ;; body of the function
1016 ,@outer-decls
1021 ,@inner-decls
1026 mf)
1029 ;;; Use arrays and hash tables and the fngen stuff to make this much
1030 ;;; better. It doesn't really matter, though, because a function
1031 ;;; returned by this will get called only when the user explicitly
1032 ;;; funcalls a result of method-function. BUT, this is needed to make
1033 ;;; early methods work.
1054 nm)
1057 ;; FIXME: this looks dangerous.
1061 method-function))
1063 ;;; this is similar to the above, only not quite. Only called when
1064 ;;; the MOP is heavily involved. Not quite parallel to
1065 ;;; METHOD-FUNCTION-FROM-FAST-METHOD-FUNCTION, because we can close
1066 ;;; over the actual PV-CELL in this case.
1080 nm)
1098 wrapper)
1099 wrappers)))))
1103 when snl
1107 ;;; Return the subset of WRAPPERS which is used in the cache
1108 ;;; of PV-TABLE.
1111 when snl
1112 collect w into result