\f
;;;; miscellaneous primitive stubs
-(macrolet ((frob (name &optional (args '(x)))
+(macrolet ((def-frob (name &optional (args '(x)))
`(defun ,name ,args (,name ,@args))))
- (frob %CODE-CODE-SIZE)
- (frob %CODE-DEBUG-INFO)
- (frob %CODE-ENTRY-POINTS)
- (frob %FUNCALLABLE-INSTANCE-FUNCTION)
- (frob %FUNCALLABLE-INSTANCE-LAYOUT)
- (frob %FUNCALLABLE-INSTANCE-LEXENV)
- (frob %FUNCTION-NEXT)
- (frob %FUNCTION-SELF)
- (frob %SET-FUNCALLABLE-INSTANCE-FUNCTION (fin new-val)))
+ (def-frob %code-code-size)
+ (def-frob %code-debug-info)
+ (def-frob %code-entry-points)
+ (def-frob %funcallable-instance-function)
+ (def-frob %funcallable-instance-layout)
+ (def-frob %funcallable-instance-lexenv)
+ (def-frob %function-next)
+ (def-frob %function-self)
+ (def-frob %set-funcallable-instance-function (fin new-val)))
\f
;;;; funny functions
long-float-p base-char-p %standard-char-p %instancep
array-header-p)
(t) boolean (movable foldable flushable))
+
+;;; REMOVEME
+#|
\f
;;;; miscellaneous "sub-primitives"
(simple-string index index simple-string index index)
(or index null)
(foldable flushable))
+|#
\ No newline at end of file
:lowtag function-pointer-type
:header funcallable-instance-header-type
:alloc-trans %make-funcallable-instance)
- #!-gengc
+ #!-(or gengc x86)
(function
:ref-known (flushable) :ref-trans %funcallable-instance-function
:set-known (unsafe) :set-trans (setf %funcallable-instance-function))
+ #!+x86
+ (function
+ :ref-known (flushable) :ref-trans %funcallable-instance-function
+ ;; KLUDGE: There's no :SET-KNOWN or :SET-TRANS in this case.
+ ;; Instead, later in compiler/x86/system.lisp there's a separate
+ ;; DEFKNOWN for (SETF %FUNCALLABLE-INSTANCE-FUNCTION), and a weird
+ ;; unexplained DEFTRANSFORM from (SETF %FUNCTION-INSTANCE-FUNCTION)
+ ;; into (SETF %FUNCTION-SELF). The #!+X86 wrapped around this case
+ ;; is a literal translation of the old CMU CL implementation into
+ ;; the new world of sbcl-0.6.12.63, where multiple DEFKNOWNs for
+ ;; the same operator cause an error (instead of silently deleting
+ ;; all information associated with the old DEFKNOWN, as before).
+ ;; It's definitely not very clean, with too many #!+ conditionals,
+ ;; too little documentation, and an implicit assumption that GENGC
+ ;; and X86 are mutually exclusive, but I have more urgent things to
+ ;; clean up right now, so I've just left it as a literal
+ ;; translation without trying to fix it. -- WHN 2001-08-02
+ )
#!+gengc (entry-point :c-type "char *")
(lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv
:set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv))
:optimizer optimizer))
(target-env (or *backend-info-environment* *info-environment*)))
(dolist (name names)
- (when (info :function :info name)
- ;; This is an error because it's generally a bad thing to blow
- ;; away all the old optimization stuff. It's also a potential
- ;; source of sneaky bugs:
- ;; DEFKNOWN FOO
- ;; DEFTRANSFORM FOO
- ;; DEFKNOWN FOO ; possibly hidden inside some macroexpansion
- ;; ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
- ;; However, it's continuable because it might be useful to do
- ;; it when testing new optimization stuff interactively.
- #+nil (cerror "Go ahead, overwrite it."
- "overwriting old FUNCTION-INFO for ~S" name)
- (warn "overwriting old FUNCTION-INFO for ~S" name))
+ (let ((old-function-info (info :function :info name)))
+ (when old-function-info
+ ;; This is an error because it's generally a bad thing to blow
+ ;; away all the old optimization stuff. It's also a potential
+ ;; source of sneaky bugs:
+ ;; DEFKNOWN FOO
+ ;; DEFTRANSFORM FOO
+ ;; DEFKNOWN FOO ; possibly hidden inside some macroexpansion
+ ;; ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
+ ;; However, it's continuable because it might be useful to do
+ ;; it when testing new optimization stuff interactively.
+ #+nil (cerror "Go ahead, overwrite it."
+ "overwriting old FUNCTION-INFO for ~S" name)
+ (warn "~@<overwriting old FUNCTION-INFO ~2I~_~S ~I~_for ~S~:>"
+ old-function-info name)))
(setf (info :function :type name target-env) ctype)
(setf (info :function :where-from name target-env) :declared)
(setf (info :function :kind name target-env) :function)
(storew temp function function-self-slot function-pointer-type)
(move result new-self)))
-;;; REMOVEME
+;;; KLUDGE: This seems to be some kind of weird override of the way
+;;; that the objdef.lisp code would ordinarily set up the slot
+;;; accessor. It's inherited from CMU CL, and it works, and naively
+;;; deleting it seemed to cause problems, but it's not obvious why
+;;; it's done this way. Any ideas? -- WHN 2001-08-02
(defknown ((setf %funcallable-instance-function)) (function function) function
- (unsafe))
-
+ (unsafe))
;;; CMU CL comment:
;;; We would have really liked to use a source-transform for this, but
;;; they don't work with SETF functions.
;;; four numeric fields, is used for versions which aren't released
;;; but correspond only to CVS tags or snapshots.
-"0.6.12.62"
+"0.6.12.63"
projects / sbcl.git / commitdiff